bb83e53 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Merge branch 'tco-case'

bb83e53Phil Freeman12 years ago

examples/passing/TCOCase.pursnew file+10

@@ -0,0 +1,10 @@

1+module Main where

3+data Data = One | More Data

5+main = Debug.Trace.trace (from (to 10000 One))

6+ where

7+ to 0 a = a

8+ to n a = to (n - 1) (More a)

9+ from One = "Done"

10+ from (More d) = from d

src/Language/PureScript/CodeGen/JS.hs+3−2

@@ -273,11 +273,12 @@ qualifiedToJS _ f (Qualified _ a) = JSVar $ identToJs (f a)

273bindersToJs :: (Functor m, Applicative m, Monad m) => Options -> ModuleName -> Environment -> [CaseAlternative] -> [JS] -> SupplyT m JS

274bindersToJs opts m e binders vals = do

275 valNames <- replicateM (length vals) freshName

276+ let assignments = zipWith JSVariableIntroduction valNames (map Just vals)

276 jss <- forM binders $ \(CaseAlternative bs grd result) -> do

277 jss <- forM binders $ \(CaseAlternative bs grd result) -> do

277 ret <- valueToJs opts m (bindNames m (concatMap binderNames bs) e) result

278 ret <- valueToJs opts m (bindNames m (concatMap binderNames bs) e) result

278 go valNames [JSReturn ret] bs grd

279 go valNames [JSReturn ret] bs grd

279− return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))

280+ return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))

280− vals

281+ []

281 where

282 where

282 go :: (Functor m, Applicative m, Monad m) => [String] -> [JS] -> [Binder] -> Maybe Guard -> SupplyT m [JS]

283 go :: (Functor m, Applicative m, Monad m) => [String] -> [JS] -> [Binder] -> Maybe Guard -> SupplyT m [JS]

283 go _ done [] Nothing = return done

284 go _ done [] Nothing = return done