Commits

Barry Schwartz  committed bba5230

Making changes to help Fortran generation.

  • Participants
  • Parent commits be5ffed

Comments (0)

Files changed (3)

File examples/c3ga.xml

          fortran-options="real-kind=c_double,
                           integer-kind=c_int,
                           mv-type=mv,
-                          mv-allocatable=false,
                           mv-bindc=true,
                           fortran-fold">
   
 
     <mvslice name="mv_grade4"> &grade4; </mvslice>
     <mvslice name="mv_grade5"> &grade5; </mvslice>
+
+    <mvslice name="mv_general"> &basis-blades; </mvslice>
   </mvslices>
 
   <constant name="no"> no </constant>
     implicit none
 
     <generate key="mv-type"/>
+    <generate key="mvslice-types"/>
+    <generate key="constants"/>
 
     end module c3ga
   </template>

File geomalg/markup_augment.pure

   else
     (xml::set_node_attr (parent_nodes!0) "blade-groups" (str blade_groups) $$
      xml::set_node_attr (parent_nodes!0) "bitmap-groups" (str bitmap_groups) $$
+     void [xml::set_node_attr (nodes!i) "slice-index" (str (i + 1)) |
+           i = 0..#nodes - 1] $$
      my_root
        when
          parent_nodes = xml::select my_root "mvslices";
          blade_group_strings = [extract_list (xml::node_content n) |
                                 n = nodes];
          blade_groups = [[1]] +
-           [map (eval_multiblade_expr my_root.val) slist | slist = blade_group_strings] +
-           [get_basis_blades my_root];
+           [map (eval_multiblade_expr my_root.val) slist | slist = blade_group_strings];
          bitmap_groups = [sort (<) $ map multiblade::bitmap B | B = blade_groups];
        end);
 

File geomalg/markup_generate.pure

 
 //-------------------------------------------------------------------------
 
-using hashdict, markup, text_tree;
+using hashdict, math, mpfr;
+using markup, text_tree;
 
 namespace geomalg;
 namespace geomalg::markup;
 
 //-------------------------------------------------------------------------
 
+fortran_real_kind node = fortran_real_kind (options "fortran" [] node)
+  if xml::nodep node;
+fortran_real_kind opts =
+  catch (cst "REAL_KIND_NOT_SPECIFIED") (opts!"real-kind");
+
+fortran_integer_kind node = fortran_integer_kind (options "fortran" [] node)
+  if xml::nodep node;
+fortran_integer_kind opts =
+  catch (cst "INTEGER_KIND_NOT_SPECIFIED") (opts!"integer-kind");
+
+//-------------------------------------------------------------------------
+
 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]]
+  [sprintf "type%s :: %s\n" (bindc, mv_type),
+   "! slice index:\n",
+   sprintf "integer(%s) :: i\n" integer_kind,
+   "! components:\n",
+   sprintf "real(%s), dimension(0:%d) :: c\n"
+     (real_kind, basis_blade_count - 1),
+   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");
+    real_kind = fortran_real_kind opts;
+    integer_kind = fortran_integer_kind opts;
     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;
 
+// FIXME: Implement this.
+fortran_mvslice_types_generator my_root generate_node =
+  ["! FIXME: IMPLEMENT mvslice-types.\n"]
+  when
+    opts = options "fortran" [] generate_node;
+    real_kind = fortran_real_kind opts;
+    integer_kind = fortran_integer_kind opts;
+  end;
+
 register_generator (("fortran","mv-type")=>fortran_mv_type_generator);
+register_generator (("fortran","mvslice-types")=>fortran_mvslice_types_generator);
 
 //-------------------------------------------------------------------------
 
                   end | n = constant_nodes];
   end;
 
+fortran_val real_kind x::rational =
+  "(" + fortran_val real_kind (num x) +
+  "/" + fortran_val real_kind (den x) + ")";
+
+fortran_val real_kind x::bigint =
+  fortran_val real_kind (filter (~= "L") (str x));
+
+fortran_val real_kind x::real =
+  fortran_val real_kind (str x);
+
+fortran_val real_kind x::string =
+  // FIXME: Maybe set the precision differently.
+  str (mpfr (x,150)) + "_" + real_kind;
+
+fortran_constants_generator my_root generate_node =
+  [sprintf "type(%s), parameter :: %s = %s(%d,[%s])\n" v | v = settings]
+  when
+    opts = options "fortran" [] generate_node;
+    real_kind = fortran_real_kind opts;
+    mv_type = catch (cst "mv") (opts!"mv-type");
+    constant_nodes = xml::select my_root "constant[@name][@mv]";
+    settings =
+      [(mv_type,
+        xml::node_attr n "name",
+        mv_type,
+        slice_index,
+        make_csv [fortran_val real_kind x | x = components])
+       when
+         _ slice_index components = val (xml::node_attr n "mv");
+       end | n = constant_nodes];
+  end;
+
 register_generator (("pure","constants")=>pure_constants_generator);
+register_generator (("fortran","constants")=>fortran_constants_generator);
 
 //-------------------------------------------------------------------------