Barry Schwartz avatar Barry Schwartz committed 1d39b6f

A new way of doing Fortran types; now there is an extensible wrapper around c-interoperable data.

Comments (0)

Files changed (3)

examples/c3ga.xml

          fortran-options="real-kind=c_double,
                           integer-kind=c_int,
                           mv-type=mv,
-                          mv-bindc=true,
+                          bindc=true,
                           fortran-fold">
   
   <!-- If the basis is given a ‘metric’ attribute, this attribute
   </diagonalized-basis>
 
   <mvslices>
+    <mvslice name="scalar"> 1 </mvslice>
+
     <mvslice name="point_at_origin"> no </mvslice>
     <mvslice name="point_at_infinity"> ni </mvslice>
 
     <mvslice name="vector_e3ga"> e1, e2, e3 </mvslice>
-    <mvslice name="mv_grade1"> &grade1; </mvslice>
+    <mvslice name="grade1"> &grade1; </mvslice>
 
     <mvslice name="bivector_e3ga"> e1⋀e2, e2⋀e3, e1⋀e3 </mvslice>
     <mvslice name="free_vector"> &free-vector; </mvslice>
-    <mvslice name="mv_grade2"> &grade2; </mvslice>
+    <mvslice name="grade2"> &grade2; </mvslice>
 
     <mvslice name="trivector_e3ga"> e1⋀e2⋀e3 </mvslice>
     <mvslice name="free_bivector"> &free-bivector; </mvslice>
-    <mvslice name="mv_grade3"> &grade3; </mvslice>
+    <mvslice name="grade3"> &grade3; </mvslice>
 
     <mvslice name="translator"> &translator; </mvslice>
 
-    <mvslice name="mv_grade4"> &grade4; </mvslice>
-    <mvslice name="mv_grade5"> &grade5; </mvslice>
+    <mvslice name="grade4"> &grade4; </mvslice>
+    <mvslice name="grade5"> &grade5; </mvslice>
+
+    <mvslice name="multivector"> &basis-blades; </mvslice>
   </mvslices>
 
   <constant name="no"> no </constant>
     use, intrinsic :: iso_c_binding
     implicit none
 
+    <generate key="mvslice-types"/>
     <generate key="mv-type"/>
-    <generate key="mvslice-types"/>
-    <generate key="constants"/>
+    <xxxgenerate key="constants"/>
 
     end module c3ga
   </template>

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) $$
+     xml::set_node_attr (parent_nodes!0) "slice-sizes" (str slice_sizes) $$
      xml::set_node_attr (parent_nodes!0) "names-to-indices" (str names_to_indices) $$
      xml::set_node_attr (parent_nodes!0) "indices-to-names" (str indices_to_names) $$
      my_root
 
          blade_groups = get_blade_groups my_root nodes;
          bitmap_groups = [sort (<) $ map multiblade::bitmap B | B = blade_groups];
+         slice_sizes = [#g | g = blade_groups];
          names_to_indices =
            [xml::node_attr n "name" => val (xml::node_attr n "slice-index") |
             n = xml::select my_root "mvslices/mvslice[@name]"];
 
 get_mvslices_blade_groups = get_mvslices_augmentation "blade-groups";
 get_mvslices_bitmap_groups = get_mvslices_augmentation "bitmap-groups";
-get_mvslices_names_to_indices = get_mvslices_augmentation "names_to_indices";
-get_mvslices_indices_to_names = get_mvslices_augmentation "indices_to_names";
+get_mvslices_slice_sizes = get_mvslices_augmentation "slice-sizes";
+get_mvslices_names_to_indices = get_mvslices_augmentation "names-to-indices";
+get_mvslices_indices_to_names = get_mvslices_augmentation "indices-to-names";
 
 register_augmenter ('augment_mvslices);
 

geomalg/markup_generate.pure

 
 //-------------------------------------------------------------------------
 
-fortran_real_kind node = fortran_real_kind (options "fortran" [] node)
-  if xml::nodep node;
+define_option_wrapper language func =
+  add_fundef $
+  '[func node --> func (options language [] node) __if__ xml::nodep node];
+
+//-------------------------------------------------------------------------
+
+fortran_option_wrappers funcs =
+  void [define_option_wrapper "fortran" f | f = funcs];
+
+fortran_option_wrappers [fortran_mv_type,
+                         fortran_real_kind,
+                         fortran_integer_kind,
+                         fortran_comma_bindc];
+
+fortran_mv_type opts = catch (cst "mv") (opts!"mv-type");
+
 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_comma_bindc opts = if bindc then ", bind(c)" else ""
+  when bindc = catch (cst false) (eval (opts!"bindc")) end;
+
 //-------------------------------------------------------------------------
 
-fortran_mv_type_generator my_root generate_node =
-  [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]
+fortran_mvslice_types_generator my_root generate_node =
+  [[sprintf "type%s :: %s\n" (fortran_comma_bindc opts, slice_name),
+    "! components:\n",
+    sprintf "real(%s), dimension(0:%d) :: c\n"
+      (fortran_real_kind opts, slice_size - 1),
+    sprintf "end type %s\n\n" slice_name] |
+   slice_name, slice_size = slice_data]
   when
     opts = options "fortran" [] generate_node;
-    real_kind = fortran_real_kind opts;
-    integer_kind = fortran_integer_kind opts;
-    mv_type = catch (cst "mv") (opts!"mv-type");
-    mv_bindc = catch (cst false) (eval (opts!"mv-bindc"));
-    bindc = if mv_bindc then ", bind(c)" else "";
-    basis_blade_count = get_basis_blade_count my_root;
+    slice_sizes = get_mvslices_slice_sizes my_root;
+    n2i = get_mvslices_names_to_indices my_root;
+    slice_data = [name, slice_sizes!i | name=>i = n2i; i ~= 0];
   end;
 
-// FIXME: Implement this.
-fortran_mvslice_types_generator my_root generate_node =
-  ["! FIXME: IMPLEMENT mvslice-types.\n"]
+fortran_mv_type_generator my_root generate_node =
+  [sprintf "type :: %s\n" mv_name,
+   "! Empty type.\n",
+   sprintf "end type %s\n\n" mv_name] +
+  [sprintf "type, extends(%s) :: %s\n" (mv_name, subtype_name scalar_name),
+   sprintf "real(%s) :: x\n" (fortran_real_kind opts),
+   sprintf "end type %s\n\n" (subtype_name scalar_name)] +
+  [[sprintf "type, extends(%s) :: %s\n" (mv_name, subtype_name n),
+    sprintf "type(%s) :: x\n" n,
+    sprintf "end type %s\n\n" (subtype_name n)] | n = slice_names]
+  with
+    subtype_name n = mv_name + "_" + n;
+  end
   when
     opts = options "fortran" [] generate_node;
-    real_kind = fortran_real_kind opts;
-    integer_kind = fortran_integer_kind opts;
+    mv_name = fortran_mv_type opts;
+    slice_count = #(get_mvslices_slice_sizes my_root);
+    i2n = orddict (get_mvslices_indices_to_names my_root);
+    slice_names = [catch (cst $ "UNSPECIFIED_SLICE" + str i) (i2n!i) |
+                   i = 1..slice_count - 1];
+    scalar_name = catch (cst "UNSPECIFIED_SCALAR") (i2n!0);
   end;
 
+register_generator (("fortran","mvslice-types")=>fortran_mvslice_types_generator);
 register_generator (("fortran","mv-type")=>fortran_mv_type_generator);
-register_generator (("fortran","mvslice-types")=>fortran_mvslice_types_generator);
 
 //-------------------------------------------------------------------------
 
   // FIXME: Maybe set the precision differently.
   str (mpfr (x,150)) + "_" + real_kind;
 
+// FIXME: THIS HAS TO BE UPDATED FOR THE NEW GENERATED DATA TYPES.
 fortran_constants_generator my_root generate_node =
   [sprintf "type(%s), parameter :: %s = %s(%d,[%s])\n" v | v = settings]
   when
   end;
 
 register_generator (("pure","constants")=>pure_constants_generator);
+
+// FIXME: THIS HAS TO BE UPDATED FOR THE NEW GENERATED DATA TYPES.
 register_generator (("fortran","constants")=>fortran_constants_generator);
 
 //-------------------------------------------------------------------------
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.