c6ce20b · rowtype-yoga/purescript-native

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

on golang help sign in

Revert "Merge branch 'tco-case'"

c6ce20bPhil Freeman12 years ago

examples/passing/TCOCase.pursdeleted−10

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

1−module Main where

2−

3−data Data = One | More Data

4−

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+2−3

@@ -273,12 +273,11 @@ 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)

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

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

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

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

279 go valNames [JSReturn ret] bs grd

278 go valNames [JSReturn ret] bs grd

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

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

281− []

280+ vals

282 where

281 where

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

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

284 go _ done [] Nothing = return done

283 go _ done [] Nothing = return done