Support stack_ fun

lib/Ast.ml

@@ -191,6 +191,20 @@ module Exp = struct
         true
     | _ -> false
 
+  let is_uminus_constant {pconst_desc; _} =
+    match pconst_desc with
+    | Pconst_integer (n, _) | Pconst_float (n, _) ->
+        Char.(String.get n 0 = '-')
+    | Pconst_unboxed_integer (s, _, _) | Pconst_unboxed_float (s, _, _) -> (
+      match s with Negative -> true | Positive -> false )
+    | _ -> false
+
+  let is_uminus_op {Location.txt; _} =
+    match txt with "~-" | "~-." -> true | _ -> false
+
+  let is_uplus_op {Location.txt; _} =
+    match txt with "~+" | "~+." -> true | _ -> false
+
   (* Jane Street: This is meant to be true if the expression can be parsed by
      the [simple_expr] production in the parser.
 
@@ -200,18 +214,17 @@ module Exp = struct
   let rec is_simple_in_parser exp =
     match exp.pexp_desc with
     | Pexp_indexop_access {pia_rhs= None; _}
-     |Pexp_new _ | Pexp_object _ | Pexp_ident _ | Pexp_constant _
+     |Pexp_new _ | Pexp_object _ | Pexp_ident _
      |Pexp_construct (_, None)
      |Pexp_variant (_, None)
      |Pexp_override _ | Pexp_open _ | Pexp_extension _ | Pexp_hole
      |Pexp_record _ | Pexp_record_unboxed_product _ | Pexp_array _
      |Pexp_list _ | Pexp_list_comprehension _ | Pexp_array_comprehension _
      |Pexp_unboxed_tuple _ ->
         true
-    | Pexp_prefix (_, e)
-     |Pexp_field (e, _)
-     |Pexp_unboxed_field (e, _)
-     |Pexp_send (e, _) ->
+    | Pexp_constant c -> not (is_uminus_constant c)
+    | Pexp_prefix (op, _) -> not (is_uminus_op op || is_uplus_op op)
+    | Pexp_field (e, _) | Pexp_unboxed_field (e, _) | Pexp_send (e, _) ->
         is_simple_in_parser e
     | Pexp_infix ({txt; _}, e1, e2) ->
         String.length txt > 0
@@ -2493,16 +2506,12 @@ end = struct
                    ~test:extension_local ) ->
         true
     | ( Exp {pexp_desc= Pexp_stack _; _}
-      , { pexp_desc=
-            ( Pexp_apply _ | Pexp_fun _ | Pexp_function _ | Pexp_lazy _
-            | Pexp_new _ | Pexp_tuple _
-            | Pexp_construct (_, Some _)
-            | Pexp_cons _ | Pexp_infix _ | Pexp_prefix _ | Pexp_stack _
-            | Pexp_let _ | Pexp_letop _ | Pexp_letopen _ | Pexp_letmodule _
-            | Pexp_send _ | Pexp_setfield _ | Pexp_ifthenelse _
-            | Pexp_variant (_, Some _) )
-        ; _ } ) ->
-        true
+      , {pexp_desc= Pexp_fun _ | Pexp_function _ | Pexp_construct _; _} ) ->
+        false
+    | Exp {pexp_desc= Pexp_stack _; _}, expr
+      when Exp.is_simple_in_parser expr ->
+        false
+    | Exp {pexp_desc= Pexp_stack _; _}, _ -> true
     | ( Exp {pexp_desc= Pexp_apply _ | Pexp_construct _; _}
       , {pexp_desc= Pexp_stack _; _} ) ->
         true

test/passing/tests/stack-erased.ml.js-ref

@@ -1,11 +1,11 @@
 (* These tests from the campiler test suite *)
 
-let f = ref (stack_ (fun x -> x))
+let f = ref (stack_ fun x -> x)
 let f = ref (stack_ (2, 3))
 let f = ignore_local (stack_ (2, 3))
 let f = ref (stack_ Foo)
-let f = ref (stack_ (Bar 42))
-let f = ignore_local (stack_ (Bar 42))
+let f = ref (stack_ Bar 42)
+let f = ignore_local (stack_ Bar 42)
 let f = ref (stack_ `Foo)
 let f = ref (stack_ (`Bar 42))
 let f = ignore_local (stack_ (`Bar 42))
@@ -21,15 +21,15 @@ let f () = stack_ (3, 5)
 let f () = exclave_ stack_ (3, 5)
 
 let f () =
-  let g = stack_ (fun x -> x) in
+  let g = stack_ fun x -> x in
   g 42
 ;;
 
-let f () = (stack_ (fun x -> x)) 42
+let f () = (stack_ fun x -> x) 42
 let f () = List.length (stack_ [ 1; 2; 3 ])
 let f () = stack_ [ i for i = 0 to 9 ]
 let f () = stack_ [| i for i = 0 to 9 |]
-let f () = stack_ (new cla)
+let f () = stack_ new cla
 
 class foo cla =
   object
@@ -72,16 +72,16 @@ let mk () =
 let f =
   ref
     (stack_
-      (function
-        | x -> x))
+      function
+      | x -> x)
 ;;
 
 let f =
   ref
     (stack_
-      (function
-        | x -> x
-        | y -> y))
+      function
+      | x -> x
+      | y -> y)
 ;;
 
 let f =
@@ -91,13 +91,13 @@ let f =
     (stack_
       (* 3 *)
       (* 4 *)
-      (function
-        (* 5 *)
-        (* 6 *)
-        | x -> x))
+      function
+      (* 5 *)
+      (* 6 *)
+      | x -> x)
 ;;
 
-let x = stack_ (stack_ (2, stack_ "hello"), ~x:(stack_ (Foo x)))
+let x = stack_ (stack_ (2, stack_ "hello"), ~x:(stack_ Foo x))
 
 let x =
   (* 1 *)
@@ -108,7 +108,7 @@ let x =
     ~x:(stack_
          (* 11 *)
          (* 12 *)
-         (Foo x)) )
+         Foo x) )
 ;;
 
 (* Constructor precedence *)
@@ -126,14 +126,19 @@ let x = stack_ (~x:1, ~y:2)
 
 let x = stack_ (x + y)
 let x = stack_ (-x)
-let x = stack_ (stack_ (Foo x))
+let x = stack_ (-42)
+let x = stack_ (+x)
+let x = stack_ 42
+let x = stack_ (- (-x))
+let x = stack_ 42
+let x = stack_ (stack_ Foo x)
 
 let x =
   stack_
     (let y = 1 in
      Some y)
 ;;
 
-let x = stack_ (c#x)
+let x = stack_ c#x
 let x = stack_ (r.x <- x)
 let x = stack_ (if x then y else z)

test/passing/tests/stack-erased.ml.ref

@@ -134,6 +134,16 @@ let x = x + y
 
 let x = -x
 
+let x = -42
+
+let x = +x
+
+let x = 42
+
+let x = - (-x)
+
+let x = 42
+
 let x = Foo x
 
 let x =

test/passing/tests/stack.ml

@@ -116,6 +116,17 @@ let x = stack_ (x + y)
 
 let x = stack_ (-x)
 
+let x = stack_ (-42)
+
+let x = stack_ (+x)
+
+let x = stack_ (+42)
+
+let x = stack_ (-(-x))
+
+let x = stack_ (-(-42))
+
+
 let x = stack_ (stack_ (Foo x))
 
 let x = stack_ (let y = 1 in Some y)

test/passing/tests/stack.ml.js-ref

@@ -1,11 +1,11 @@
 (* These tests from the campiler test suite *)
 
-let f = ref (stack_ (fun x -> x))
+let f = ref (stack_ fun x -> x)
 let f = ref (stack_ (2, 3))
 let f = ignore_local (stack_ (2, 3))
 let f = ref (stack_ Foo)
-let f = ref (stack_ (Bar 42))
-let f = ignore_local (stack_ (Bar 42))
+let f = ref (stack_ Bar 42)
+let f = ignore_local (stack_ Bar 42)
 let f = ref (stack_ `Foo)
 let f = ref (stack_ (`Bar 42))
 let f = ignore_local (stack_ (`Bar 42))
@@ -21,15 +21,15 @@ let f () = stack_ (3, 5)
 let f () = exclave_ stack_ (3, 5)
 
 let f () =
-  let g = stack_ (fun x -> x) in
+  let g = stack_ fun x -> x in
   g 42
 ;;
 
-let f () = (stack_ (fun x -> x)) 42
+let f () = (stack_ fun x -> x) 42
 let f () = List.length (stack_ [ 1; 2; 3 ])
 let f () = stack_ [ i for i = 0 to 9 ]
 let f () = stack_ [| i for i = 0 to 9 |]
-let f () = stack_ (new cla)
+let f () = stack_ new cla
 
 class foo cla =
   object
@@ -72,16 +72,16 @@ let mk () =
 let f =
   ref
     (stack_
-      (function
-        | x -> x))
+      function
+      | x -> x)
 ;;
 
 let f =
   ref
     (stack_
-      (function
-        | x -> x
-        | y -> y))
+      function
+      | x -> x
+      | y -> y)
 ;;
 
 let f =
@@ -91,13 +91,13 @@ let f =
     (stack_
       (* 3 *)
       (* 4 *)
-      (function
-        (* 5 *)
-        (* 6 *)
-        | x -> x))
+      function
+      (* 5 *)
+      (* 6 *)
+      | x -> x)
 ;;
 
-let x = stack_ (stack_ (2, stack_ "hello"), ~x:(stack_ (Foo x)))
+let x = stack_ (stack_ (2, stack_ "hello"), ~x:(stack_ Foo x))
 
 let x =
   (* 1 *)
@@ -108,7 +108,7 @@ let x =
     ~x:(stack_
          (* 11 *)
          (* 12 *)
-         (Foo x)) )
+         Foo x) )
 ;;
 
 (* Constructor precedence *)
@@ -126,14 +126,19 @@ let x = stack_ (~x:1, ~y:2)
 
 let x = stack_ (x + y)
 let x = stack_ (-x)
-let x = stack_ (stack_ (Foo x))
+let x = stack_ (-42)
+let x = stack_ (+x)
+let x = stack_ 42
+let x = stack_ (- (-x))
+let x = stack_ 42
+let x = stack_ (stack_ Foo x)
 
 let x =
   stack_
     (let y = 1 in
      Some y)
 ;;
 
-let x = stack_ (c#x)
+let x = stack_ c#x
 let x = stack_ (r.x <- x)
 let x = stack_ (if x then y else z)