git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix #570
4d31abbPhil Freeman
examples/passing/DeepArrayBinder.pursnew file+16
compare with golang
unifiedsplit
@@ -0,0 +1,16 @@
1+module Main where
2+
3+import Control.Monad.Eff
4+
5+match2 :: [Number] -> Number
6+match2 (x : y : xs) = x * y + match2 xs
7+match2 _ = 0
8+
9+foreign import explode
10+ "function explode() {\
11+ \ throw new Error('Incorrect result');\
12+ \}" :: forall eff a. Eff eff a
13+
14+main = case match2 [1, 2, 3, 4, 5, 6, 7, 8, 9] of
15+ 100 -> Debug.Trace.trace "Done"
16+ _ -> explode
src/Language/PureScript/CodeGen/JS.hs+16−7
@@ -27,7 +27,7 @@ import Data.Maybe (catMaybes, fromJust)
27import Data.Function (on)
27import Data.Function (on)
28import Data.List (nub, (\\), delete, sortBy)
28import Data.List (nub, (\\), delete, sortBy)
29
29
30−import Control.Monad (replicateM, forM)
30+import Control.Monad (foldM, replicateM, forM)
31import Control.Applicative
31import Control.Applicative
32
32
33import Language.PureScript.Names
33import Language.PureScript.Names
@@ -392,18 +392,27 @@ binderToJs m e varName done (ArrayBinder bs) = do
392 done'' <- go done' (index + 1) bs'
392 done'' <- go done' (index + 1) bs'
393 js <- binderToJs m e elVar done'' binder
393 js <- binderToJs m e elVar done'' binder
394 return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
394 return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
395−binderToJs m e varName done (ConsBinder headBinder tailBinder) = do
395+binderToJs m e varName done binder@(ConsBinder _ _) = do
396+ let (headBinders, tailBinder) = uncons [] binder
397+ numberOfHeadBinders = fromIntegral $ length headBinders
398+ js1 <- foldM (\done' (headBinder, index) -> do
396− headVar <- freshName
399+ headVar <- freshName
400+ jss <- binderToJs m e headVar done' headBinder
401+ return (JSVariableIntroduction headVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : jss)) done (zip headBinders [0..])
397 tailVar <- freshName
402 tailVar <- freshName
398− js1 <- binderToJs m e headVar done headBinder
399 js2 <- binderToJs m e tailVar js1 tailBinder
403 js2 <- binderToJs m e tailVar js1 tailBinder
400− return [JSIfElse (JSBinary GreaterThan (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left 0))) (JSBlock
404+ return [JSIfElse (JSBinary GreaterThanOrEqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left numberOfHeadBinders))) (JSBlock
401− ( JSVariableIntroduction headVar (Just (JSIndexer (JSNumericLiteral (Left 0)) (JSVar varName))) :
402− JSVariableIntroduction tailVar (Just (JSApp (JSAccessor "slice" (JSVar varName)) [JSNumericLiteral (Left 1)])) :
405+ ( JSVariableIntroduction tailVar (Just (JSApp (JSAccessor "slice" (JSVar varName)) [JSNumericLiteral (Left numberOfHeadBinders)])) :
403 js2
406 js2
404 )) Nothing]
407 )) Nothing]
408+ where
409+ uncons :: [Binder] -> Binder -> ([Binder], Binder)
410+ uncons acc (ConsBinder h t) = uncons (h : acc) t
411+ uncons acc (PositionedBinder _ b) = uncons acc b
412+ uncons acc tailBinder = (reverse acc, tailBinder)
405binderToJs m e varName done (NamedBinder ident binder) = do
413binderToJs m e varName done (NamedBinder ident binder) = do
406 js <- binderToJs m e varName done binder
414 js <- binderToJs m e varName done binder
407 return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
415 return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
408binderToJs m e varName done (PositionedBinder _ binder) =
416binderToJs m e varName done (PositionedBinder _ binder) =
409 binderToJs m e varName done binder
417 binderToJs m e varName done binder
418+