Prettify Scalc

compiler/lcalc/optimizations.ml

@@ -149,6 +149,15 @@ let rec peephole_expr (_ : unit) (e : expr Pos.marked) :
       | EApp ((EOp (Unop (Log _)), _), [ (ELit (LBool false), _) ]) ->
           e3
       | _ -> default_mark @@ EIfThenElse (e1, e2, e3))
+  | ECatch (e1, except, e2) -> (
+      let+ e1 = peephole_expr () e1 and+ e2 = peephole_expr () e2 in
+      match (Pos.unmark e1, Pos.unmark e2) with
+      | ERaise except', ERaise except''
+        when except' = except && except = except'' ->
+          default_mark @@ ERaise except
+      | ERaise except', _ when except' = except -> e2
+      | _, ERaise except' when except' = except -> e1
+      | _ -> default_mark @@ ECatch (e1, except, e2))
   | _ -> visitor_map peephole_expr () e
 
 let peephole_optimizations (p : program) : program =

compiler/scalc/compile_from_lambda.ml

@@ -24,6 +24,7 @@ type ctxt = {
   decl_ctx : D.decl_ctx;
   var_dict : A.LocalName.t L.VarMap.t;
   inside_definition_of : A.LocalName.t option;
+  context_name : string;
 }
 
 (* Expressions can spill out side effect, hence this function also returns a
@@ -94,8 +95,24 @@ let rec translate_expr (ctxt : ctxt) (expr : L.expr Pos.marked) :
   | L.EOp op -> ([], (A.EOp op, Pos.get_position expr))
   | L.ELit l -> ([], (A.ELit l, Pos.get_position expr))
   | _ ->
-      let tmp_var = A.LocalName.fresh ("local_var", Pos.get_position expr) in
-      let ctxt = { ctxt with inside_definition_of = Some tmp_var } in
+      let tmp_var =
+        A.LocalName.fresh
+          ( (*This piece of logic is used to make the code more readable *)
+            (match ctxt.inside_definition_of with
+            | None -> ctxt.context_name
+            | Some v ->
+                let v = Pos.unmark (A.LocalName.get_info v) in
+                let tmp_rex = Re.Pcre.regexp "^temp_" in
+                if Re.Pcre.pmatch ~rex:tmp_rex v then v else "temp_" ^ v),
+            Pos.get_position expr )
+      in
+      let ctxt =
+        {
+          ctxt with
+          inside_definition_of = Some tmp_var;
+          context_name = Pos.unmark (A.LocalName.get_info tmp_var);
+        }
+      in
       let tmp_stmts = translate_statements ctxt expr in
       ( ( A.SLocalDecl
             ((tmp_var, Pos.get_position expr), (D.TAny, Pos.get_position expr)),
@@ -150,7 +167,11 @@ and translate_statements (ctxt : ctxt) (block_expr : L.expr Pos.marked) :
         List.map
           (fun (x, _tau, arg) ->
             let ctxt =
-              { ctxt with inside_definition_of = Some (Pos.unmark x) }
+              {
+                ctxt with
+                inside_definition_of = Some (Pos.unmark x);
+                context_name = Pos.unmark (A.LocalName.get_info (Pos.unmark x));
+              }
             in
             let arg_stmts, new_arg = translate_expr ctxt arg in
             arg_stmts @ [ (A.SLocalDef (x, new_arg), binder_pos) ])
@@ -165,7 +186,8 @@ and translate_statements (ctxt : ctxt) (block_expr : L.expr Pos.marked) :
       in
       let closure_name =
         match ctxt.inside_definition_of with
-        | None -> A.LocalName.fresh ("closure", Pos.get_position block_expr)
+        | None ->
+            A.LocalName.fresh (ctxt.context_name, Pos.get_position block_expr)
         | Some x -> x
       in
       let ctxt =
@@ -258,6 +280,7 @@ and translate_statements (ctxt : ctxt) (block_expr : L.expr Pos.marked) :
           ])
 
 let translate_scope
+    (scope_name : D.ScopeName.t)
     (decl_ctx : D.decl_ctx)
     (func_dict : A.TopLevelName.t L.VarMap.t)
     (scope_expr : L.expr Pos.marked) :
@@ -280,7 +303,13 @@ let translate_scope
       in
       let new_body =
         translate_statements
-          { decl_ctx; func_dict; var_dict; inside_definition_of = None }
+          {
+            decl_ctx;
+            func_dict;
+            var_dict;
+            inside_definition_of = None;
+            context_name = Pos.unmark (D.ScopeName.get_info scope_name);
+          }
           body
       in
       (param_list, new_body)
@@ -295,8 +324,8 @@ let translate_program (p : L.program) : A.program =
          List.fold_left
            (fun (func_dict, new_scopes) body ->
              let new_scope_params, new_scope_body =
-               translate_scope p.decl_ctx func_dict
-                 body.Lcalc.Ast.scope_body_expr
+               translate_scope body.L.scope_body_name p.decl_ctx func_dict
+                 body.L.scope_body_expr
              in
              let func_id =
                A.TopLevelName.fresh

compiler/scalc/to_python.ml

@@ -191,10 +191,45 @@ let format_name_cleaned (fmt : Format.formatter) (s : string) : unit =
   let lowercase_name = avoid_keywords (to_ascii lowercase_name) in
   Format.fprintf fmt "%s" lowercase_name
 
+module StringMap = Map.Make (String)
+module IntMap = Map.Make (Int)
+
+(** For each `LocalName.t` defined by its string and then by its hash, we keep
+    track of which local integer id we've given it. This is used to keep
+    variable naming with low indices rather than one global counter for all
+    variables. *)
+let string_counter_map : int IntMap.t StringMap.t ref = ref StringMap.empty
+
 let format_var (fmt : Format.formatter) (v : LocalName.t) : unit =
   let v_str = Pos.unmark (LocalName.get_info v) in
+  let hash = LocalName.hash v in
+  let local_id =
+    match StringMap.find_opt v_str !string_counter_map with
+    | Some ids -> (
+        match IntMap.find_opt hash ids with
+        | None ->
+            let max_id =
+              snd
+                (List.hd
+                   (List.fast_sort
+                      (fun (_, x) (_, y) -> Int.compare y x)
+                      (IntMap.bindings ids)))
+            in
+            string_counter_map :=
+              StringMap.add v_str
+                (IntMap.add hash (max_id + 1) ids)
+                !string_counter_map;
+            max_id + 1
+        | Some local_id -> local_id)
+    | None ->
+        string_counter_map :=
+          StringMap.add v_str (IntMap.singleton hash 0) !string_counter_map;
+        0
+  in
   if v_str = "_" then Format.fprintf fmt "_"
-  else Format.fprintf fmt "%a_%d" format_name_cleaned v_str (LocalName.hash v)
+    (* special case for the unit pattern *)
+  else if local_id = 0 then format_name_cleaned fmt v_str
+  else Format.fprintf fmt "%a_%d" format_name_cleaned v_str local_id
 
 let format_toplevel_name (fmt : Format.formatter) (v : TopLevelName.t) : unit =
   let v_str = Pos.unmark (TopLevelName.get_info v) in