Define an AST with no currying semantics and translate to it

src/lang/codegen/ClosureConversion.ml

@@ -16,9 +16,8 @@
 *)
 
 open Syntax
-open ExplicitAnnotationSyntax
 open Core
-open FlatPatternSyntax
+open UncurriedSyntax
 open ClosuredSyntax
 open MonadUtil
 open Result.Let_syntax
@@ -29,10 +28,10 @@ open Result.Let_syntax
  *)
 module ScillaCG_CloCnv = struct
 
-  module FPS = FlatPatSyntax
+  module UCS = Uncurried_Syntax
   module CS = CloCnvSyntax
 
-  open FPS
+  open UCS
 
   let translate_payload = function
     | MLit l -> CS.MLit l
@@ -69,22 +68,8 @@ module ScillaCG_CloCnv = struct
       let s = (CS.Bind(dstvar, (CS.Builtin (i, il), erep)), erep) in
       pure [s]
     | App (a, al) ->
-      (* Make each partial application explicit, by generating |al| App statements.
-       * TODO: Modify `FunType` on the closure converted AST to be [typ] -> typ. *)
-      let%bind (temp, _, sl_rev) = foldM al ~init:(a, (get_rep a).ea_tp, []) ~f:(fun (prev_temp, t, sacc) arg ->
-        match t with
-        | Some (FunType (_, rty)) ->
-          let temprep = {erep with ea_tp = Some rty } in
-          let temp = newname (get_id a) temprep in
-          let s' = (CS.Bind(temp, (CS.App (prev_temp, [arg]), temprep)), temprep) in
-          pure (temp, Some rty, (s' :: sacc))
-        | _ -> fail1 (sprintf "ClosureConversion: expected function type at type application %s" (get_id a))
-                (get_rep a).ea_loc
-      ) in
-      let temp_rep = get_rep temp in
-      let sl'_rev = (CS.Bind (dstvar, (CS.Var temp, temp_rep)), erep) :: sl_rev in
-      let sl =  List.rev sl'_rev in
-      pure sl
+      let s = (CS.Bind(dstvar, (CS.App (a, al), erep)), erep) in
+      pure [s]
     | TFunSel (i, tl) ->
       let s = (CS.Bind(dstvar, (CS.TFunSel (i, tl), erep)), erep) in
       pure [s]
@@ -112,9 +97,9 @@ module ScillaCG_CloCnv = struct
     | JumpExpr jlbl ->
       let s = CS.JumpStmt jlbl, erep in
       pure [s]
-    | Fun (i, t, body)
-    | Fixpoint (i, t, body) ->
-      let%bind (f : CS.fundef) = create_fundef body [(i, t)] erep in
+    | Fun (args, body)
+    | Fixpoint (args, body) ->
+      let%bind (f : CS.fundef) = create_fundef body args erep in
       (* 5. Store variables into the closure environment. *)
       let envstmts =
         if List.is_empty (snd f.fclo.envvars) then [] else
@@ -132,7 +117,7 @@ module ScillaCG_CloCnv = struct
         (* We need to create a () -> brep.ea_tp type for the function. *)
         let erep' = {
           ea_loc = brep.ea_loc;
-          ea_tp = Option.map brep.ea_tp ~f:(fun t -> FunType(Unit, t)) 
+          ea_tp = Option.map brep.ea_tp ~f:(fun t -> FunType([Unit], t)) 
         } in
         let%bind (f : CS.fundef) = create_fundef body [] erep' in
         pure (t, f.fclo)

src/lang/codegen/ClosuredSyntax.ml

@@ -16,10 +16,10 @@
 *)
 
 open Syntax
-open ExplicitAnnotationSyntax
+open UncurriedSyntax.Uncurried_Syntax
 
 (* Scilla AST after closure-conversion.
- * This AST is lowered from MmphSyntax to be imperative
+ * This AST is lowered from UncurriedSyntax to be imperative
  * (which mostly means that we flatten out let-rec expressions).
  *)
 module CloCnvSyntax = struct
@@ -161,9 +161,6 @@ module CloCnvSyntax = struct
     let compcls = List.concat @@ List.map (fun c -> gather_closures c.comp_body) cmod.contr.ccomps in
     libcls @ fieldcls @ compcls
 
-  (* PrettyPrinters for the AST. *)
-  open PrettyPrinters
-
   let pp_eannot_ident i =
     match (get_rep i).ea_tp with
     | Some t -> "(" ^ get_id i ^ " : " ^ (pp_typ t) ^ ")"

src/lang/codegen/CodegenUtils.ml

@@ -34,5 +34,11 @@ let newname_creator () =
     name_counter := (!name_counter+1);
     asIdL n rep)
 
-let global_newnamer = newname_creator ()
-
+let global_name_counter = ref 0
+let global_newnamer =
+  (* Cannot just call newname_creator() because of OCaml's weak type limitation. *)
+  (fun base rep ->
+    (* system generated names will begin with "$" for uniqueness. *)
+    let n = newname_prefix_char ^ base ^ "_" ^ (Int.to_string !global_name_counter) in
+    global_name_counter := (!global_name_counter+1);
+    asIdL n rep)

src/lang/codegen/CodegenUtils.mli

@@ -16,16 +16,15 @@
 *)
 
 open Syntax
-open ExplicitAnnotationSyntax
 
 (* Create a closure for creating new variable names.
  * The closure maintains a state for incremental numbering. 
  * Do not use this directly as it will provide a namer with
  * count beginning from 0 (potential name clashes if used as such
  * from different passes. Use it only if you're sure of providing
  * a uniqe base name. Otherwise use the global_newnamer next. *)
-val newname_creator : unit -> (string -> eannot -> eannot ident)
+val newname_creator : unit -> (string -> 'a -> 'a ident)
 
 (* A newnamer that keeps a global counter and assures unique
  * names throughout the compiler pipeline. *)
-val global_newnamer : string -> eannot -> eannot ident
+val global_newnamer : string -> 'a -> 'a ident