Commits

Barry Schwartz committed be5ffed

Now options and LANGUAGE-options should do inheritance properly. Also, some Fortran implementation.

  • Participants
  • Parent commits 49234f4

Comments (0)

Files changed (3)

examples/c3ga.xml

                        mv-symbol=mv,
                        scalar=scalar,
                        scalar-matrix=matrix"
-         fortran-options="scalar=c_double,
+         fortran-options="real-kind=c_double,
+                          integer-kind=c_int,
                           mv-type=mv,
                           mv-allocatable=false,
-                          mv-bindc=true">
+                          mv-bindc=true,
+                          fortran-fold">
   
   <!-- If the basis is given a ‘metric’ attribute, this attribute
        specifies an orthonormal euclidean metric for the basis. -->
       pure-options="-exclude,exclude-scalar"
       metric="conformal"/>
 
-
   <!--
   <operation name="sp" metric="conformal"/>
   <operation name="sp" output-name="sp_em" metric="euclidean"/>
 
   </template>
 
-  <template language="fortran" fortran-options="fortran-fold">
+  <template language="fortran">
     module c3ga
     use, intrinsic :: iso_c_binding
     implicit none
 
+    <generate key="mv-type"/>
+
     end module c3ga
   </template>
 

geomalg/markup.pure

   end
   if xml::nodep node && node_kind node === 'xml::element;
 
-search_toward_root f::function node =
+search_toward_root f node =
   if stringp s then s else search_toward_root f (xml::parent node)
   when s = catch (cst ()) (f node) end
   if xml::nodep node;
 option_entries _ = [];
 
 options language::string defaults node =
-  foldl adopt_opt (orddict defaults) (opts + lang_opts)
-  when
-    opts = (option_entries $
-            search_toward_root (flip xml::node_attr "options") node);
-    lang_opts =
-      if language == "" then
-        []
-      else
-        option_entries $
-        search_toward_root (flip xml::node_attr (language + "-options")) node;
-  end
+  foldl adopt_opt (orddict defaults) (collect_opts node)  
   with
     adopt_opt opt_set opt::string =
       if key!0 == "-" then
             _ = #parts!0, join "=" (drop 1 parts);
           end;
       end;
+
+    collect_opts doc = [] if xml::docp doc;
+    collect_opts node =
+      parent_opt_entries + opt_entries + lang_opt_entries
+      when
+        parent_opt_entries = collect_opts (xml::parent node);
+        _ _ a = xml::node_info node;
+        attr = record a;
+        opt_entries = if member attr general_opts then
+                        option_entries (attr!general_opts) else [];
+        lang_opt_entries = if member attr lang_opts then
+                             option_entries (attr!lang_opts) else [];
+      end;
+  end
+  when
+    general_opts = "options";
+    lang_opts = language + "-options";
   end;
 
 //-------------------------------------------------------------------------

geomalg/markup_generate.pure

 
 //-------------------------------------------------------------------------
 
+fortran_mv_type_generator my_root generate_node =
+  [[sprintf "type%s :: %s\n" (bindc, mv_type)],
+   [sprintf "integer(%s) :: slice_index\n" integer_kind],
+   [sprintf "real(%s), dimension(0:%d)%s :: components\n"
+    (real_kind, basis_blade_count - 1, allocatable)],
+   [sprintf "end type %s\n" mv_type]]
+  when
+    opts = options "fortran" [] generate_node;
+    real_kind = catch (cst "REAL_KIND_NOT_SPECIFIED") (opts!"real-kind");
+    integer_kind = catch (cst "INTEGER_KIND_NOT_SPECIFIED") (opts!"integer-kind");
+    mv_type = catch (cst "mv") (opts!"mv-type");
+    mv_allocatable = catch (cst false) (eval (opts!"mv-allocatable"));
+    mv_bindc = catch (cst false) (eval (opts!"mv-bindc"));
+    allocatable = if mv_allocatable then ", allocatable" else "";
+    bindc = if mv_bindc then ", bind(c)" else "";
+    basis_blade_count = get_basis_blade_count my_root;
+  end;
+
+register_generator (("fortran","mv-type")=>fortran_mv_type_generator);
+
+//-------------------------------------------------------------------------
+
 pure_constants_generator my_root generate_node =
   [sprintf "const %s = %s;\n" v | v = names_vals]
   when
       when
         language = search_toward_root (flip xml::node_attr "language") node;
         opts = options language [] node;
-        fold = if member opts "fortran-fold" then
+        fold = if ~member opts "fortran-fold" then
+                 id
+               else if opts!"fortran-fold" == "" then
                  text_tree::text_tree_fortran_fold 132
                else
-                 id;
+                 text_tree::text_tree_fortran_fold (eval (opts!"fortran-fold"));
       end;
   end;