Move js Case logic from serialize to imperativize

bowtie-js/src/Bowtie/JS/AST.hs

@@ -13,7 +13,12 @@ data AST
   | Return AST
 
   | Array [AST]
-  | Case AST [Alt]
+  | IndexArray AST Natural
+  | IfThen AST AST
+  | Else AST
+  | Throw Text
+  | Equal AST AST
+  | LambdaUnit AST -- ^ @(() => { " <> ast <> "})()@
 
   | JSInt Integer
   | JSString Text

bowtie-js/src/Bowtie/JS/Imperativize.hs

@@ -1,4 +1,6 @@
-module Bowtie.JS.Imperativize where
+module Bowtie.JS.Imperativize
+  ( makeImp
+  ) where
 
 import Bowtie.JS.AST
 import Bowtie.Lib.Environment
@@ -47,27 +49,46 @@ coreToImp topExpr =
         f (id, (expr, _)) =
           Assignment (Var id) (coreToImp expr)
       in
-        Block
-          (  fmap f (hashmapToSortedList bindings)
-          <> [coreToImp body] -- PERFORMANCE
-          )
+        LambdaUnit
+          (Block
+            (addReturn
+              (  fmap f (hashmapToSortedList bindings)
+              <> [coreToImp body] -- PERFORMANCE
+              )))
 
     Core.Construct id ->
       Var id
 
     Core.Case expr alts ->
-      Case (coreToImp expr) (fmap altToImp alts)
+      let
+        mkAssign :: (Natural, Id) -> AST
+        mkAssign (n, id) =
+          Assignment (Var id) (IndexArray (Var (Id "$1")) n)
+
+        altToImp :: Core.Alt -> AST
+        altToImp (Core.Alt id args body) =
+          IfThen
+            (Equal
+              (IndexArray (Var (Id "$1")) 0)
+              (conToString id))
+            (Block $ addReturn
+              (  fmap mkAssign (zip [1..] args)
+              <> [coreToImp body] -- PERFORMANCE
+              ))
+      in
+        LambdaUnit
+          (Block
+            (  Assignment (Var (Id "$1")) (coreToImp expr)
+             : fmap altToImp alts
+            <> [Else (Throw "no match")]
+            ))
 
     Core.EInt n ->
       JSInt n
 
     Core.EOp op ->
       JSOp (coreOperationToImp op)
 
-altToImp :: Core.Alt -> Alt
-altToImp (Core.Alt id bindings body) =
-  Alt id bindings (coreToImp body)
-
 coreOperationToImp :: Core.Operation -> JS.Operation
 coreOperationToImp op =
   case op of
@@ -86,17 +107,17 @@ coreOperationToImp op =
     Core.Panic expr ->
       Panic (coreToImp expr)
 
+-- eg ["Maybe", 5], not [Maybe, 5]
+conToString :: Id -> JS.AST
+conToString =
+  JSString . unId
+
 conTypeToFunction :: (Id, TypeScheme) -> JS.AST
 conTypeToFunction (id, TypeScheme _ tsType) =
   Assignment
     (Var id)
-    (addLambdas args (Array (conAsString : fmap Var args)))
+    (addLambdas args (Array (conToString id : fmap Var args)))
   where
-    -- eg ["Maybe", 5], not [Maybe, 5]
-    conAsString :: JS.AST
-    conAsString =
-      JSString (unId id)
-
     addLambdas :: [Id] -> JS.AST -> JS.AST
     addLambdas [] ast = ast
     addLambdas (y:ys) ast = Lam y (addLambdas ys ast)
@@ -120,6 +141,15 @@ conTypeToFunction (id, TypeScheme _ tsType) =
         TypeApp _ _ -> -- eg List a
           []
 
+addReturn :: [JS.AST] -> [JS.AST]
+addReturn ys =
+  case reverse ys of
+    y:rest ->
+      reverse rest <> [Return y] -- PERFORMANCE
+
+    _ ->
+      ys
+
 -- | I initially though packageUp's purpose would be to make sure
 -- it's being passed a full program, which should be a Let,
 -- and it would return Nothing otherwise.

bowtie-js/src/Bowtie/JS/Serialize.hs

@@ -2,7 +2,6 @@ module Bowtie.JS.Serialize
   ( serializeTop
   , serialize
   , serializeOperation
-  , experize
   ) where
 
 import Bowtie.JS.AST
@@ -35,39 +34,31 @@ serialize topAst =
       "const " <> serialize a1 <> " = " <> serialize a2 <> ";"
 
     Block asts ->
-      let
-        addReturn ys =
-          case reverse ys of
-            y:rest ->
-              reverse rest <> [Return y]
-
-            _ ->
-              ys
-      in
-        experize (Text.intercalate "\n" (fmap serialize (addReturn asts)))
+      Text.intercalate "\n" (fmap serialize asts)
 
     Return ast ->
       "return " <> serialize ast
 
     Array asts ->
       "[" <> Text.intercalate ", " (fmap serialize asts) <> "]"
 
-    Case ast alts ->
-      let
-        mkAssign :: (Natural, Id) -> Text
-        mkAssign (n, id) =
-          "const " <> serializeId id <> " = $1[" <> show n <> "];\n"
-
-        f :: Alt -> Text
-        f (Alt id bindings expr) =
-           -- unId not serializeId because it's ["Unit"] not [Unit].
-          "if ($1[0] === \"" <> unId id <> "\") {"
-            <> foldMap mkAssign (zip [1..] bindings)
-            <> "return " <> serialize expr <> "} else "
-      in
-        "(() => { const $1 = " <> serialize ast <> ";\n"
-          <> foldMap f alts
-          <> " {throw \"no match\";} })()"
+    IndexArray ast index ->
+      serialize ast <> "[" <> show index <> "]"
+
+    IfThen a1 a2 ->
+      "if (" <> serialize a1 <> ") { " <> serialize a2 <> "}"
+
+    Else ast ->
+      " else { " <> serialize ast <> " }"
+
+    Throw t ->
+      "throw \"" <> t <> "\""
+
+    Equal a1 a2 ->
+      serialize a1 <> " === " <> serialize a2
+
+    LambdaUnit ast ->
+      "(() => { " <> serialize ast <> "})()"
 
     JSInt n ->
       show n
@@ -78,10 +69,6 @@ serialize topAst =
     JSOp op ->
       serializeOperation op
 
-experize :: Text -> Text
-experize t =
-  "(() => { " <> t <> "})()"
-
 serializeOperation :: Operation -> Text
 serializeOperation op =
   case op of
@@ -97,8 +84,8 @@ serializeOperation op =
     ShowInt ast ->
       "$unicodeListizeBuiltin(" <> serialize ast <> ".toString())"
 
-    Panic expr -> -- Only works on Text
-      experize ("throw " <> serialize expr)
+    Panic expr -> -- Will only be used with Text
+      "(() => { throw " <> serialize expr <> "})()"
 
 serializeId :: Id -> Text
 serializeId (Id t) =

bowtie-js/test/well-typed-golden-files/006-case-statement.bowtie

@@ -26,8 +26,10 @@ function $compareBuiltin(a, b) {
 
 const _False = ["False"];
 const _True = ["True"];
-const _result = (() => { const $1 = _True;
-if ($1[0] === "False") {return 0} else if ($1[0] === "True") {return 1} else  {throw "no match";} })();
+const _result = (() => { const _$1 = _True;
+if (_$1[0] === "False") { return 0}
+if (_$1[0] === "True") { return 1}
+ else { throw "no match" }})();
 
 console.log(_result);
 */

bowtie-js/test/well-typed-golden-files/case-statement-binding.bowtie

@@ -25,9 +25,10 @@ function $compareBuiltin(a, b) {
 }
 
 const _IdentityInt = _arg1 => ["IdentityInt", _arg1];
-const _result = (() => { const $1 = _IdentityInt(1);
-if ($1[0] === "IdentityInt") {const _n = $1[1];
-return _n} else  {throw "no match";} })();
+const _result = (() => { const _$1 = _IdentityInt(1);
+if (_$1[0] === "IdentityInt") { const _n = _$1[1];
+return _n}
+ else { throw "no match" }})();
 
 console.log(_result);
 */

bowtie-js/test/well-typed-golden-files/case-statement-multiple-bindings.bowtie

@@ -29,10 +29,11 @@ const _Na = ["Na"];
 const _Unit = ["Unit"];
 const _Ya = ["Ya"];
 const _foo = _b => _n => _Unit;
-const _result = (() => { const $1 = _BoolInt(_Ya)(1);
-if ($1[0] === "BoolInt") {const _b = $1[1];
-const _n = $1[2];
-return _foo(_b)(_n)} else  {throw "no match";} })();
+const _result = (() => { const _$1 = _BoolInt(_Ya)(1);
+if (_$1[0] === "BoolInt") { const _b = _$1[1];
+const _n = _$1[2];
+return _foo(_b)(_n)}
+ else { throw "no match" }})();
 
 console.log(_result);
 */

bowtie-js/test/well-typed-golden-files/let-recursive-function.bowtie

@@ -26,8 +26,10 @@ function $compareBuiltin(a, b) {
 
 const _False = ["False"];
 const _True = ["True"];
-const _foo = _b => (() => { const $1 = _b;
-if ($1[0] === "True") {return 1} else if ($1[0] === "False") {return _foo(_True)} else  {throw "no match";} })();
+const _foo = _b => (() => { const _$1 = _b;
+if (_$1[0] === "True") { return 1}
+if (_$1[0] === "False") { return _foo(_True)}
+ else { throw "no match" }})();
 const _result = _foo(_False);
 
 console.log(_result);

bowtie-js/test/well-typed-golden-files/polymorphic-data-type.bowtie

@@ -27,10 +27,13 @@ function $compareBuiltin(a, b) {
 const _Just = _arg1 => ["Just", _arg1];
 const _Nothing = ["Nothing"];
 const _Unit = ["Unit"];
-const _result = (() => { const $1 = _Just(1);
-if ($1[0] === "Just") {const _n = $1[1];
-return _n} else if ($1[0] === "Nothing") {return (() => { const $1 = _Just(_Unit);
-if ($1[0] === "Unit") {return 0} else  {throw "no match";} })()} else  {throw "no match";} })();
+const _result = (() => { const _$1 = _Just(1);
+if (_$1[0] === "Just") { const _n = _$1[1];
+return _n}
+if (_$1[0] === "Nothing") { return (() => { const _$1 = _Just(_Unit);
+if (_$1[0] === "Unit") { return 0}
+ else { throw "no match" }})()}
+ else { throw "no match" }})();
 
 console.log(_result);
 */

bowtie-js/test/well-typed-golden-files/polymorphic-function.bowtie

@@ -26,8 +26,9 @@ function $compareBuiltin(a, b) {
 
 const _Unit = ["Unit"];
 const _identity = _a => _a;
-const _result = (() => { const $1 = _identity(_Unit);
-if ($1[0] === "Unit") {return _identity(0)} else  {throw "no match";} })();
+const _result = (() => { const _$1 = _identity(_Unit);
+if (_$1[0] === "Unit") { return _identity(0)}
+ else { throw "no match" }})();
 
 console.log(_result);
 */

bowtie-js/test/well-typed-golden-files/recursive-polymorphic-data-type.bowtie

@@ -27,13 +27,17 @@ function $compareBuiltin(a, b) {
 const _Cons = _arg1 => _arg2 => ["Cons", _arg1, _arg2];
 const _Nil = ["Nil"];
 const _Unit = ["Unit"];
-const _result = (() => { const $1 = _Cons(1)(_Nil);
-if ($1[0] === "Cons") {const _n = $1[1];
-const _rest = $1[2];
-return _n} else if ($1[0] === "Nil") {return (() => { const $1 = _Cons(_Unit)(_Nil);
-if ($1[0] === "Cons") {const _u = $1[1];
-const _rest = $1[2];
-return 2} else if ($1[0] === "Nil") {return 3} else  {throw "no match";} })()} else  {throw "no match";} })();
+const _result = (() => { const _$1 = _Cons(1)(_Nil);
+if (_$1[0] === "Cons") { const _n = _$1[1];
+const _rest = _$1[2];
+return _n}
+if (_$1[0] === "Nil") { return (() => { const _$1 = _Cons(_Unit)(_Nil);
+if (_$1[0] === "Cons") { const _u = _$1[1];
+const _rest = _$1[2];
+return 2}
+if (_$1[0] === "Nil") { return 3}
+ else { throw "no match" }})()}
+ else { throw "no match" }})();
 
 console.log(_result);
 */