From 4d31abb5351d7466b8cb7d540ca13e31b680ba3c Mon Sep 17 00:00:00 2001
From: Phil Freeman <paf31@cantab.net>
Date: Sun, 24 Aug 2014 21:18:46 -0700
Subject: [PATCH] Fix #570

---
 examples/passing/DeepArrayBinder.purs | 16 ++++++++++++++++
 src/Language/PureScript/CodeGen/JS.hs | 23 ++++++++++++++++-------
 2 files changed, 32 insertions(+), 7 deletions(-)
 create mode 100644 examples/passing/DeepArrayBinder.purs

diff --git a/examples/passing/DeepArrayBinder.purs b/examples/passing/DeepArrayBinder.purs
new file mode 100644
index 0000000000..5ed57269ba
--- /dev/null
+++ b/examples/passing/DeepArrayBinder.purs
@@ -0,0 +1,16 @@
+module Main where
+
+import Control.Monad.Eff
+
+match2 :: [Number] -> Number
+match2 (x : y : xs) = x * y + match2 xs
+match2 _ = 0
+
+foreign import explode 
+  "function explode() {\
+  \  throw new Error('Incorrect result');\
+  \}" :: forall eff a. Eff eff a
+
+main = case match2 [1, 2, 3, 4, 5, 6, 7, 8, 9] of
+  100 -> Debug.Trace.trace "Done"
+  _ -> explode
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index 7f1d2ae71f..5faf3e8a6a 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -27,7 +27,7 @@ import Data.Maybe (catMaybes, fromJust)
 import Data.Function (on)
 import Data.List (nub, (\\), delete, sortBy)
 
-import Control.Monad (replicateM, forM)
+import Control.Monad (foldM, replicateM, forM)
 import Control.Applicative
 
 import Language.PureScript.Names
@@ -392,18 +392,27 @@ binderToJs m e varName done (ArrayBinder bs) = do
     done'' <- go done' (index + 1) bs'
     js <- binderToJs m e elVar done'' binder
     return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
-binderToJs m e varName done (ConsBinder headBinder tailBinder) = do
-  headVar <- freshName
+binderToJs m e varName done binder@(ConsBinder _ _) = do
+  let (headBinders, tailBinder) = uncons [] binder
+      numberOfHeadBinders = fromIntegral $ length headBinders
+  js1 <- foldM (\done' (headBinder, index) -> do
+    headVar <- freshName
+    jss <- binderToJs m e headVar done' headBinder
+    return (JSVariableIntroduction headVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : jss)) done (zip headBinders [0..])
   tailVar <- freshName
-  js1 <- binderToJs m e headVar done headBinder
   js2 <- binderToJs m e tailVar js1 tailBinder
-  return [JSIfElse (JSBinary GreaterThan (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left 0))) (JSBlock
-    ( JSVariableIntroduction headVar (Just (JSIndexer (JSNumericLiteral (Left 0)) (JSVar varName))) :
-      JSVariableIntroduction tailVar (Just (JSApp (JSAccessor "slice" (JSVar varName)) [JSNumericLiteral (Left 1)])) :
+  return [JSIfElse (JSBinary GreaterThanOrEqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left numberOfHeadBinders))) (JSBlock
+    ( JSVariableIntroduction tailVar (Just (JSApp (JSAccessor "slice" (JSVar varName)) [JSNumericLiteral (Left numberOfHeadBinders)])) :
       js2
     )) Nothing]
+  where 
+  uncons :: [Binder] -> Binder -> ([Binder], Binder)
+  uncons acc (ConsBinder h t) = uncons (h : acc) t
+  uncons acc (PositionedBinder _ b) = uncons acc b
+  uncons acc tailBinder = (reverse acc, tailBinder)
 binderToJs m e varName done (NamedBinder ident binder) = do
   js <- binderToJs m e varName done binder
   return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
 binderToJs m e varName done (PositionedBinder _ binder) =
   binderToJs m e varName done binder
+