add recursive function

lib/concrete_domains.ml

@@ -10,7 +10,7 @@ module M : Domains.S = struct
     type st_store = St_store.t [@@deriving sexp_of]
     type job_q = Job_q.t [@@deriving sexp_of]
 
-    type clos = { param : Id.t; body : Expr.hook_free_t; env : env }
+    type clos = { self : Id.t option; param : Id.t; body : Expr.hook_free_t; env : env }
     [@@deriving sexp_of]
 
     type value =

lib/domains.ml

@@ -8,7 +8,7 @@ module type T = sig
   type obj
   type st_store
   type job_q
-  type clos = { param : Id.t; body : Expr.hook_free_t; env : env }
+  type clos = { self : Id.t option; param : Id.t; body : Expr.hook_free_t; env : env }
   type set_clos = { label : Label.t; path : path }
   type comp_clos = { comp : Prog.comp; env : env }
 

lib/interp.ml

@@ -288,6 +288,20 @@ module Report_box = struct
     }
 end
 
+let build_app_env (clos_value : clos) (arg : value) : Env.t =
+  (*
+  The function name is bound before the parameters,
+  according to js semantics (ECMA-262 14th edition, p.347, "15.2.5 Runtime Semantics: InstantiateOrdinaryFunctionExpression":
+  "5. Perform ! funcEnv.CreateImmutableBinding(name, false).").
+   *)
+  let { self; param; body = _; env } = clos_value in
+  let env = match self with
+  | None -> env
+  | Some self -> Env.extend env ~id:self ~value:(Clos clos_value)
+  in
+  let env = Env.extend env ~id:param ~value:(arg) in
+  env
+
 let rec eval : type a. a Expr.t -> value =
  fun expr ->
   Logger.eval expr;
@@ -303,11 +317,11 @@ let rec eval : type a. a Expr.t -> value =
   | Cond { pred; con; alt } ->
       let p = eval pred |> bool_of_value_exn in
       if p then eval con else eval alt
-  | Fn { param; body } -> Clos { param; body; env = perform Rd_env }
+  | Fn { self; param; body } -> Clos { self; param; body; env = perform Rd_env }
   | App { fn; arg } -> (
       match eval fn with
-      | Clos { param; body; env } ->
-          let env = Env.extend env ~id:param ~value:(eval arg) in
+      | Clos ({ body; _ } as clos_value) ->
+          let env = build_app_env clos_value (eval arg) in
           perform (In_env env) eval body
       | Comp_clos { comp; env } -> Comp_spec { comp; env; arg = eval arg }
       | Set_clos { label; path } ->
@@ -350,8 +364,9 @@ let rec eval : type a. a Expr.t -> value =
           let v_old, q = perform (Lookup_st (path, label)) in
           (* Run the setting thunks in the set queue *)
           let v =
-            Job_q.fold q ~init:v_old ~f:(fun value { param; body; env } ->
-                let env = Env.extend env ~id:param ~value in
+            Job_q.fold q ~init:v_old ~f:(fun value clos ->
+                let { body; _ } = clos in
+                let env = build_app_env clos value in
                 perform (In_env env) eval body)
           in
 
@@ -369,7 +384,7 @@ let rec eval : type a. a Expr.t -> value =
       and phase = perform Rd_ph
       and env = perform Rd_env in
       (match phase with P_effect -> raise Invalid_phase | _ -> ());
-      perform (Enq_eff (path, { param = Id.unit; body = e; env }));
+      perform (Enq_eff (path, { self = None; param = Id.unit; body = e; env }));
       Unit
   | Seq (e1, e2) ->
       eval e1 |> ignore;

lib/js_syntax.ml

@@ -213,6 +213,10 @@ let convert_seq ((e1, cpl1) : Syntax.Expr.hook_free_t * completion)
       (* e2 is never executed *)
       (e1, cpl1)
 
+let convert_repeat ((_body, _cpl) : Syntax.Expr.hook_free_t * completion) :
+    Syntax.Expr.hook_free_t * completion =
+  raise NotImplemented (* TODAY TODO *)
+
 let rec convert_stat_list (body : (Loc.t, Loc.t) Flow_ast.Statement.t list) :
     Syntax.Expr.hook_free_t * completion =
   let open Syntax.Expr in
@@ -237,7 +241,8 @@ let rec convert_stat_list (body : (Loc.t, Loc.t) Flow_ast.Statement.t list) :
     | DeclareTypeAlias _ | DeclareOpaqueType _ | DeclareVariable _ ->
         (* flow statements starting with 'declare' *)
         (tail, tail_cpl)
-    | DoWhile _ -> raise NotImplemented
+    | DoWhile _ ->
+        raise NotImplemented (* TODAY TODO *)
     | Empty _ -> (tail, tail_cpl)
     | EnumDeclaration _ -> raise NotImplemented
     | ExportDefaultDeclaration { declaration; _ } -> (
@@ -313,7 +318,7 @@ let rec convert_stat_list (body : (Loc.t, Loc.t) Flow_ast.Statement.t list) :
           |> List.fold ~init:tail ~f:(fun tail (name, expr) ->
                  Let { id = name; bound = expr; body = tail }),
           tail_cpl )
-    | While _ -> raise NotImplemented
+    | While _ -> raise NotImplemented (* TODAY TODO *)
     | With _ -> raise NotImplemented
     in
     (*
@@ -332,10 +337,10 @@ let rec convert_stat_list (body : (Loc.t, Loc.t) Flow_ast.Statement.t list) :
   *)
   res
 
-and convert_func ({ params; body; _ } : (Loc.t, Loc.t) Flow_ast.Function.t) :
+and convert_func ({ id; params; body; _ } : (Loc.t, Loc.t) Flow_ast.Function.t) :
     Syntax.Expr.hook_free_t =
-  (* TODO: handle recursive binding *)
   let open Syntax.Expr in
+  let self = Option.map id ~f:(fun (_, { name; _ }) -> name) in
   let param =
     match params with
     | _, { params = [ (_, { argument; default = None }) ]; _ } -> argument
@@ -362,15 +367,20 @@ and convert_func ({ params; body; _ } : (Loc.t, Loc.t) Flow_ast.Function.t) :
            Let { id = name; bound = expr; body = last_expr })
   in
   match cpl with
-  | CDet CNormal -> Fn { param = param_name; body =
-    Seq (body, Const Unit) }
-  | CDet (CBreak _ | CReturn) -> Fn { param = param_name; body }
+  | CDet CNormal ->
+      (* TODO: is this correct? *)
+      let (body', _) = convert_seq (body, cpl) (Const Unit, CDet CReturn) in
+      Fn {
+    self;
+    param = param_name; body = body' }
+  | CDet (CBreak _ | CReturn) -> Fn { self; param = param_name; body }
   | CIndet cpls ->
       (* λx. let r = body in if r.tag = "RET" then r.value else () *)
       let ret_var = fresh () in
       if List.exists cpls ~f:(fun cpl -> equal_flat_completion cpl CNormal) then
       Fn
         {
+          self;
           param = param_name;
           body =
             Let
@@ -398,7 +408,7 @@ and convert_func ({ params; body; _ } : (Loc.t, Loc.t) Flow_ast.Function.t) :
                     };
               };
         }
-      else Fn { param = param_name; body }
+      else Fn { self; param = param_name; body }
 
 and convert_call (callee : Syntax.Expr.hook_free_t)
     ((_, { arguments; _ }) : (Loc.t, Loc.t) Flow_ast.Expression.ArgList.t) :

lib/lexer.mll

@@ -14,6 +14,7 @@ let keywords =
       ("not", NOT);
       ("view", VIEW);
       ("fun", FUN);
+      ("rec", REC);
       ("if", IF);
       ("then", THEN);
       ("else", ELSE);
@@ -59,7 +60,6 @@ rule read =
   | id as s   { match Hashtbl.find_opt keywords s with Some s -> s | None -> ID s }
   | str as s  { STRING (String.sub s 1 (String.length s - 2) |> unescape_string) }
   | "{}"      { RECORD }
-  | '.'       { DOT }
   | ":="      { ASSIGN }
   | '#'       { comment lexbuf }
   | "->"      { RARROW }

lib/parser.mly

@@ -18,9 +18,9 @@ and label_stts_expr label = function
 %token <int> INT
 %token <string> ID
 %token <string> STRING
-%token RECORD DOT ASSIGN
+%token RECORD ASSIGN
 %token VIEW
-%token FUN LET STT IN EFF
+%token FUN REC LET STT IN EFF
 %token IF THEN ELSE
 %token NOT EQ LT GT NE LE GE
 %token AND OR
@@ -58,7 +58,9 @@ comp_expr:
     | LET; name = var; param = var; EQ; body = expr_ { { name; param; body = hook_full body } }
 expr_:
     | apply { $1 }
-    | FUN; param = var; RARROW; body = expr_ { Ex (Fn { param; body = hook_free_exn body }) }
+    | FUN; param = var; RARROW; body = expr_ { Ex (Fn { self = None; param; body = hook_free_exn body }) }
+    | REC; name = var; EQ; FUN; param = var; RARROW; body = expr_
+      { Ex (Fn { self = Some name; param; body = hook_free_exn body }) }
     | LET; id = var; EQ; bound = expr_; IN; body = expr_
       { let Ex body = body in
         Ex (Let { id; bound = hook_free_exn bound; body })

lib/syntax.ml

@@ -20,7 +20,7 @@ module Expr = struct
     | Var : Id.t -> _ t
     | View : hook_free t list -> _ t
     | Cond : { pred : hook_free t; con : hook_free t; alt : hook_free t } -> _ t
-    | Fn : { param : Id.t; body : hook_free t } -> _ t
+    | Fn : { self : Id.t option; param : Id.t; body : hook_free t } -> _ t
     | App : { fn : hook_free t; arg : hook_free t } -> _ t
     | Let : { id : Id.t; bound : hook_free t; body : 'a t } -> 'a t
     | Stt : {
@@ -121,7 +121,7 @@ module Expr = struct
     | View es -> l (a "View" :: List.map ~f:sexp_of_t es)
     | Cond { pred; con; alt } ->
         l [ a "Cond"; sexp_of_t pred; sexp_of_t con; sexp_of_t alt ]
-    | Fn { param; body } -> l [ a "Fn"; Id.sexp_of_t param; sexp_of_t body ]
+    | Fn { self; param; body } -> l [ a "Fn"; Option.sexp_of_t Id.sexp_of_t self; Id.sexp_of_t param; sexp_of_t body ]
     | App { fn; arg } -> l [ a "App"; sexp_of_t fn; sexp_of_t arg ]
     | Let { id; bound; body } ->
         l [ a "Let"; Id.sexp_of_t id; sexp_of_t bound; sexp_of_t body ]

test/test_react_trace.ml

@@ -32,8 +32,8 @@ let rec alpha_conv_expr_blind :
             con = alpha_conv_expr_blind bindings con;
             alt = alpha_conv_expr_blind bindings alt;
           }
-    | Fn { param; body } ->
-        Fn { param; body = alpha_conv_expr_blind bindings body }
+    | Fn { self; param; body } ->
+        Fn { self = Option.map ~f:bindings self; param; body = alpha_conv_expr_blind bindings body }
     | App { fn; arg } ->
         App
           {
@@ -109,9 +109,23 @@ let rec alpha_conv_expr :
             con = alpha_conv_expr bindings con con';
             alt = alpha_conv_expr bindings alt alt';
           }
-    | Fn { param; body }, Fn { param = param'; body = body' } ->
-        let bindings' x = if String.(x = param') then param else bindings x in
-        Fn { param; body = alpha_conv_expr bindings' body body' }
+    | Fn { self = None; param; body }, Fn { self = None; param = param'; body = body' } ->
+        let bindings' x =
+          if String.(x = param') then param else
+          bindings x in
+        Fn { self = None; param; body = alpha_conv_expr bindings' body body' }
+    | Fn { self = Some self; param; body }, Fn { self = Some self'; param = param'; body = body' } ->
+        (*
+  The function name is bound before the parameters
+  according to js semantics (ECMA-262 14th edition, p.347, "15.2.5 Runtime Semantics: InstantiateOrdinaryFunctionExpression":
+    "5. Perform ! funcEnv.CreateImmutableBinding(name, false).").
+    Thus param takes precedence over self.
+   *)
+        let bindings' x =
+          if String.(x = param') then param else
+          if String.(x = self') then self else
+          bindings x in
+        Fn { self = Some self; param; body = alpha_conv_expr bindings' body body' }
     | App { fn; arg }, App { fn = fn'; arg = arg' } ->
         App
           {
@@ -292,21 +306,38 @@ let parse_fn () =
   let open Syntax in
   let (Ex expr) = parse_expr "fun x -> fun y -> x + y" in
   Alcotest.(check' (of_pp Sexp.pp_hum))
-    ~msg:"parse closed cond" ~expected:(Expr.sexp_of_t expr)
+    ~msg:"parse function" ~expected:(Expr.sexp_of_t expr)
     ~actual:
       Expr.(
         sexp_of_t
           (Fn
              {
+               self = None;
                param = "x";
                body =
                  Fn
                    {
+                     self = None;
                      param = "y";
                      body = Bop { op = Plus; left = Var "x"; right = Var "y" };
                    };
              }))
 
+let parse_rec () =
+  let open Syntax in
+  let (Ex expr) = parse_expr "rec f = fun x -> f x" in
+  Alcotest.(check' (of_pp Sexp.pp_hum))
+    ~msg:"parse recursive function" ~actual:(Expr.sexp_of_t expr)
+    ~expected:
+      Expr.(
+        sexp_of_t
+          (Fn
+             {
+               self = Some "f";
+               param = "x";
+               body = App { fn = Var "f"; arg = Var "x" };
+             }))
+
 let parse_app () =
   let open Syntax in
   let (Ex expr) = parse_expr "a b c" in
@@ -494,6 +525,22 @@ let js_var () =
     ~msg:"convert var" ~actual:(Prog.sexp_of_t prog)
     ~expected:(parse_prog "x" |> Prog.sexp_of_t)
 
+let js_fn () =
+  let open Syntax in
+  let js, _ = parse_js "let t = (function(x) {})" in
+  let prog = Js_syntax.convert js in
+  Alcotest.(check' (of_pp Sexp.pp_hum))
+    ~msg:"convert function" ~actual:(Prog.sexp_of_t prog)
+    ~expected:(parse_prog "let t = fun x -> () in ()" |> Prog.sexp_of_t)
+
+let js_rec () =
+  let open Syntax in
+  let js, _ = parse_js "let f = (function(x) { return f(x); })" in
+  let prog = Js_syntax.convert js in
+  Alcotest.(check' (of_pp Sexp.pp_hum))
+    ~msg:"convert recursive function" ~actual:(Prog.sexp_of_t prog)
+    ~expected:(parse_prog "let f = fun x -> f x in ()" |> Prog.sexp_of_t)
+
 let js_literal () =
   let open Syntax in
   let js, _ = parse_js "42; true; null" in
@@ -981,6 +1028,7 @@ let () =
           test_case "open cond" `Quick parse_open_cond;
           test_case "closed cond" `Quick parse_closed_cond;
           test_case "fn" `Quick parse_fn;
+          test_case "rec" `Quick parse_rec;
           test_case "app" `Quick parse_app;
           test_case "let" `Quick parse_let;
           test_case "stt" `Quick parse_stt;
@@ -994,6 +1042,8 @@ let () =
       ( "convert",
         [
           test_case "var" `Quick js_var;
+          test_case "function" `Quick js_fn;
+          test_case "recursive function" `Quick js_rec;
           test_case "literal" `Quick js_literal;
           test_case "jsx" `Quick js_jsx;
           test_case "binop" `Quick js_op;