Merge pull request #617 from HigherOrderCO/small-changes-for-bend

Small fixes for bend

src/Kind/CompileJS.hs

@@ -672,7 +672,7 @@ fnToJS book fnName ct@(getArguments -> (fnArgs, fnBody)) = do
             return $ concat [cmdStmt, retStmt]
           "IO_ARGS" -> do
             let [_] = appArgs
-            retStmt  <- set var "process.argv.slice(2).map(x => JLIST_TO_LIST(x, JSTR_TO_LIST))"
+            retStmt  <- set var "JARRAY_TO_LIST(process.argv.slice(2), JSTR_TO_LIST)"
             return retStmt
           _ -> error $ "Unknown IO operation: " ++ name
       -- Normal Application
@@ -790,7 +790,7 @@ fnToJS book fnName ct@(getArguments -> (fnArgs, fnBody)) = do
     go (CVar nam _) =
       set var nam
     go (CTxt txt) =
-      set var $ "JSTR_TO_LIST(`" ++ txt ++ "`)"
+      set var $ "JSTR_TO_LIST(`" ++ (concatMap (\c -> if c == '`' then "\\`" else [c]) txt) ++ "`)"
     go (CLst lst) =
       let cons = \x acc -> CCon "Cons" [("head", x), ("tail", acc)]
           nil  = CCon "Nil" []
@@ -828,7 +828,7 @@ prelude = unlines [
   "  return list;",
   "}",
   "",
-  "function LIST_TO_JLIST(list, decode) {",
+  "function LIST_TO_JARRAY(list, decode) {",
   "  try {",
   "    let result = [];",
   "    let current = list;",
@@ -843,7 +843,7 @@ prelude = unlines [
   "  return list;",
   "}",
   "",
-  "function JLIST_TO_LIST(inp, encode) {",
+  "function JARRAY_TO_LIST(inp, encode) {",
   "  let out = {$: 'Nil'};",
   "  for (let i = inp.length - 1; i >= 0; i--) {",
   "    out = {$: 'Cons', head: encode(inp[i]), tail: out};",

src/Kind/Parse.hs

@@ -672,8 +672,10 @@ parseDef = guardChoice
 
 parseDefADT :: Parser (String, Term)
 parseDefADT = do
+  (_, _, uses) <- P.getState
   P.try $ string_skp "data "
   name <- name_skp
+  let nameA = expandUses uses name
   params <- P.many $ do
     P.try $ char_skp '('
     pname <- name_skp
@@ -702,15 +704,15 @@ parseDefADT = do
   let paramNames = map fst params
   let indexNames = map fst indices
   let allParams  = params ++ indices
-  let selfType   = foldl (\ acc arg -> App acc (Ref arg)) (Ref name) (paramNames ++ indexNames)
+  let selfType   = foldl (\ acc arg -> App acc (Ref arg)) (Ref nameA) (paramNames ++ indexNames)
   let typeBody   = foldr (\ (pname, ptype) acc -> All pname ptype (\_ -> acc)) Set allParams
   let newCtrs    = map (fillCtrRet selfType) ctrs -- fill ctr type when omitted
   let dataBody   = ADT (map (\ (iNam,iTyp) -> Ref iNam) indices) newCtrs selfType
   let fullBody   = foldr (\ (pname, _) acc -> Lam pname (\_ -> acc)) dataBody allParams
   let term       = bind (genMetas (Ann False fullBody typeBody)) []
   return $
-    -- trace ("parsed " ++ name ++ " = " ++ (showTermGo False term 0))
-    (name, term)
+    -- trace ("parsed " ++ nameA ++ " = " ++ (showTermGo False term 0))
+    (nameA, term)
   where fillCtrRet  ret (Ctr nm tele)    = Ctr nm (fillTeleRet ret tele)
         fillTeleRet ret (TRet (Met _ _)) = TRet ret
         fillTeleRet _   (TRet ret)       = TRet ret
@@ -1054,7 +1056,8 @@ parseIf = withSrc $ do
           string_skp "do "
           monad <- name_skp
           char_skp '{'
-          t <- parseStmt monad
+          (_, _, uses) <- P.getState
+          t <- parseStmt (expandUses uses monad)
           if isIf then char_skp '}' else char '}'
           return t
       , do
@@ -1231,7 +1234,8 @@ makeNumCase col mat bods depth num =
 makeSucCase :: [Pattern] -> [[Pattern]] -> [Term] -> Int -> Word64 -> String -> Term
 makeSucCase col mat bods depth suc var =
   let (mat', bods') = foldr go ([], []) (zip3 col mat bods)
-      bod           = (flattenRules mat' bods' (depth + 1))
+      bod           = if null bods' then error $ "missing case for " ++ show suc ++ "+" ++ var
+                      else (flattenRules mat' bods' (depth + 1))
   in Lam var (\x -> bod)
   where go ((PSuc _ _), pats, bod) (mat, bods) = (pats:mat, bod:bods)
         go ((PVar "_"), pats, bod) (mat, bods) = (pats:mat, bod:bods)