Add some mapreduce visitors to Pure

1 files changed, 64 insertions, 11 deletions

diff --git a/src/Pure.ml b/src/Pure.ml
index aeb02fe2..6c9a6f67 100644
--- a/src/Pure.ml
+++ b/src/Pure.ml
@@ -196,22 +196,24 @@ class virtual ['self] reduce_value_base =
     method visit_ty : 'env -> ty -> 'a = fun _ _ -> self#zero
   end
 
-(*(** Ancestor for [mapreduce_var_or_dummy] visitor *)
-  class virtual ['self] mapreduce_value_base =
-    object (self : 'self)
-      inherit [_] VisitorsRuntime.mapreduce
+(** Ancestor for [mapreduce_var_or_dummy] visitor *)
+class virtual ['self] mapreduce_value_base =
+  object (self : 'self)
+    inherit [_] VisitorsRuntime.mapreduce
 
-      method visit_constant_value : 'env -> constant_value -> constant_vlaue * 'a =
-        fun _ _ -> self#zero
+    method visit_constant_value : 'env -> constant_value -> constant_value * 'a
+        =
+      fun _ x -> (x, self#zero)
 
-      method visit_var : 'env -> var -> va * 'a = fun _ _ -> self#zero
+    method visit_var : 'env -> var -> var * 'a = fun _ x -> (x, self#zero)
 
-      method visit_place : 'env -> place -> place * 'a = fun _ _ -> self#zero
+    method visit_place : 'env -> place -> place * 'a = fun _ x -> (x, self#zero)
 
-      method visit_mplace : 'env -> mplace -> mplace * 'a = fun _ _ -> self#zero
+    method visit_mplace : 'env -> mplace -> mplace * 'a =
+      fun _ x -> (x, self#zero)
 
-      method visit_ty : 'env -> ty -> ty * 'a = fun _ _ -> self#zero
-  end*)
+    method visit_ty : 'env -> ty -> ty * 'a = fun _ x -> (x, self#zero)
+  end
 
 type var_or_dummy =
   | Var of var * mplace option
@@ -242,6 +244,14 @@ type var_or_dummy =
         ancestors = [ "reduce_value_base" ];
         nude = true (* Don't inherit [VisitorsRuntime.reduce] *);
         polymorphic = false;
+      },
+    visitors
+      {
+        name = "mapreduce_var_or_dummy";
+        variety = "mapreduce";
+        ancestors = [ "mapreduce_value_base" ];
+        nude = true (* Don't inherit [VisitorsRuntime.reduce] *);
+        polymorphic = false;
       }]
 
 (** A left value (which appears on the left of assignments *)
@@ -279,6 +289,14 @@ and typed_lvalue = { value : lvalue; ty : ty }
         ancestors = [ "reduce_var_or_dummy" ];
         nude = true (* Don't inherit [VisitorsRuntime.iter] *);
         polymorphic = false;
+      },
+    visitors
+      {
+        name = "mapreduce_typed_lvalue";
+        variety = "mapreduce";
+        ancestors = [ "mapreduce_var_or_dummy" ];
+        nude = true (* Don't inherit [VisitorsRuntime.iter] *);
+        polymorphic = false;
       }]
 
 type rvalue =
@@ -318,6 +336,14 @@ and typed_rvalue = { value : rvalue; ty : ty }
         ancestors = [ "reduce_typed_lvalue" ];
         nude = true (* Don't inherit [VisitorsRuntime.iter] *);
         polymorphic = false;
+      },
+    visitors
+      {
+        name = "mapreduce_typed_rvalue";
+        variety = "mapreduce";
+        ancestors = [ "mapreduce_typed_lvalue" ];
+        nude = true (* Don't inherit [VisitorsRuntime.iter] *);
+        polymorphic = false;
       }]
 
 type unop = Not | Neg of T.integer_type
@@ -384,6 +410,26 @@ class virtual ['self] reduce_expression_base =
     method visit_fun_id : 'env -> fun_id -> 'a = fun _ _ -> self#zero
   end
 
+(** Ancestor for [mapreduce_expression] visitor *)
+class virtual ['self] mapreduce_expression_base =
+  object (self : 'self)
+    inherit [_] mapreduce_typed_rvalue
+
+    method visit_meta : 'env -> meta -> meta * 'a = fun _ x -> (x, self#zero)
+
+    method visit_integer_type : 'env -> T.integer_type -> T.integer_type * 'a =
+      fun _ x -> (x, self#zero)
+
+    method visit_scalar_value : 'env -> scalar_value -> scalar_value * 'a =
+      fun _ x -> (x, self#zero)
+
+    method visit_id : 'env -> VariantId.id -> VariantId.id * 'a =
+      fun _ x -> (x, self#zero)
+
+    method visit_fun_id : 'env -> fun_id -> fun_id * 'a =
+      fun _ x -> (x, self#zero)
+  end
+
 (** **Rk.:** here, [expression] is not at all equivalent to the expressions
     used in CFIM. They are lambda-calculus expressions, and are thus actually
     more general than the CFIM statements, in a sense.
@@ -477,6 +523,13 @@ and match_branch = { pat : typed_lvalue; branch : expression }
         variety = "reduce";
         ancestors = [ "reduce_expression_base" ];
         nude = true (* Don't inherit [VisitorsRuntime.iter] *);
+      },
+    visitors
+      {
+        name = "mapreduce_expression";
+        variety = "mapreduce";
+        ancestors = [ "mapreduce_expression_base" ];
+        nude = true (* Don't inherit [VisitorsRuntime.iter] *);
       }]
 
 type fun_sig = {