a316590 · rowtype-yoga/purescript-native

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

on golang help sign in

Merge pull request #537 from purescript/tcocase

a316590Phil Freeman12 years ago

examples/passing/TCOCase.pursnew file+10

compare with golang

unifiedsplit

@@ -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

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

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

318bindersToJs opts m e binders vals = do

319 valNames <- replicateM (length vals) freshName

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

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

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

321 ret <- valueToJs opts m e result

322 ret <- valueToJs opts m e result

322 go valNames [JSReturn ret] bs grd

323 go valNames [JSReturn ret] bs grd

323− return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow $ JSUnary JSNew $ JSApp (JSVar "Error") $ [(JSStringLiteral "Failed pattern match")]])))

324+ return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ JSUnary JSNew $ JSApp (JSVar "Error") $ [JSStringLiteral "Failed pattern match"]])))

324− vals

325+ []

325 where

326 where

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

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

327 go _ done [] Nothing = return done

328 go _ done [] Nothing = return done