89d1b86 · rowtype-yoga/purescript-native

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

Remove blocks

commit89d1b86667cb5e6316e3ddbde3e7318ff7dfb249 authorPhil Freeman <paf31@cantab.net> dateTue 11 Feb 2014, 15:27 (13 years ago) parent3c22697

13 files changed+15−384

compare with golang

unifiedsplit

examples/passing/Assign.purs−38 examples/passing/IfThenElse.purs−42 examples/passing/JSReserved.purs+4−26 examples/passing/TypeDecl.purs+4−10 examples/passing/TypeSynonyms.purs+2−7 prelude/prelude.purs+2−7 prelude/tests/Eff.purs+2−2 src/Language/PureScript/CodeGen/JS.hs−19 src/Language/PureScript/Parser/Values.hs−70 src/Language/PureScript/Pretty/Values.hs−23 src/Language/PureScript/Scope.hs+1−5 src/Language/PureScript/TypeChecker/Types.hs−80 src/Language/PureScript/Values.hs−55

examples/passing/Assign.pursdeleted−38

@@ -1,38 +0,0 @@

1−module Assign where

2−

3− import Prelude

4−

5− sum = \n -> {

6− var x = 0;

7− for (i <- 0 until n) {

8− x = x + i;

9− }

10− return x;

11− }

12−

13− arr = [1, 2]

14−

15− foo = {

16− var x = 0; -- mutable

17− var y = 1; -- immutable

18−

19− -- x should not be inlined since x is mutable

20− while (x < 10) {

21− x = x + 1;

22− }

23−

24− var z1 = arr !! x; -- immutable

25− var b = (\x -> z1) 2; -- z1 should not be inlined since x is bound

26−

27− var z2 = arr !! x; -- immutable

28− var z3 = arr !! x; -- immutable

29− var a = (\z2 -> z2) 2; -- z3 should not be inlined since z2 is bound

30−

31− -- y should be inlined

32− -- z3 should be inlined

33− return x + y + z1 + z2 + z3 + a + b;

34− }

35−

36−module Main where

37−

38−main = Trace.trace "Done"

examples/passing/IfThenElse.pursdeleted−42

@@ -1,42 +0,0 @@

1−module IfThenElse where

2−

3− import Prelude

4−

5− testIf =

6− {

7− var x = 0;

8− if (x == 0) {

9− x = x + 1;

10− }

11− return x;

12− }

13−

14− testIfElse =

15− {

16− var x = 0;

17− if (x == 0) {

18− x = x + 1;

19− } else {

20− x = x - 1;

21− }

22− return x;

23− }

24−

25− testIfElseIf = \x ->

26− {

27− var y = x;

28− while (y > 1) {

29− if (y % 3 == 0) {

30− y = y / 3;

31− } else if (y % 3 == 1) {

32− y = (y - 1) % 3;

33− } else {

34− y = y * 4 + 1;

35− }

36− }

37− return y;

38− }

39−

40−module Main where

41−

42−main = Trace.trace "Done"

examples/passing/JSReserved.purs+4−26

@@ -5,30 +5,10 @@ module JSReserved where

55 yield = 0

66 member = 1

8− this = {

9− var function = 0;

10− for (i <- 0 until 10) {

11− function = function + i;

12− }

13− return function;

14− }

15−

16− catch = {

17− var for = 0;

18− while (for > 0) {

19− for = for - 1;

20− }

21− return for;

22− }

23−

24− instanceof = {

25− var var = 1;

26− var = var + 1;

27− return var;

28− }

29−

308 public = \return -> return

319

10+ this catch = catch

11+

3212module Main where

3313

3414 import Prelude

@@ -37,7 +17,5 @@ module Main where

3717

3818 main = Trace.print [ yield

3919 , member

40− , this

41− , catch

42− , instanceof

43− , public 1 ]

20+ , this 1

21+ , public 1 ]

examples/passing/TypeDecl.purs+4−10

@@ -1,19 +1,13 @@

11module TypeDecl where

3− id :: forall a. (a) -> a

4− id = \x -> x

3+ import Prelude

65 k :: String -> Number -> String

7− k = \x -> \y -> x

6+ k x y = x

98 iterate :: forall a. Number -> (a -> a) -> a -> a

10− iterate = \n -> \f -> \a -> {

11− var result = a;

12− for (i <- 0 until n) {

13− result = f result;

14− }

15− return result;

16− }

9+ iterate 0 f a = a

10+ iterate n f a = iterate (n - 1) f (f a)

1711

1812module Main where

1913

examples/passing/TypeSynonyms.purs+2−7

@@ -8,12 +8,7 @@ module TypeSynonyms where

88 composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c

99 composeLenses = \l1 -> \l2 ->

1010 { get: \a -> l2.get (l1.get a)

11− , set: \a -> \c ->

12− {

13− var b = l1.get a;

14− var b1 = l2.set b c;

15− return l1.set a b1;

16− }

11+ , set: \a c -> l1.set a (l2.set (l1.get a) c)

1712 }

1813

1914 type Pair a b = { fst :: a, snd :: b }

@@ -21,7 +16,7 @@ module TypeSynonyms where

2116 fst :: forall a b. Lens (Pair a b) a

2217 fst =

2318 { get: \p -> p.fst

24− , set: \p -> \a -> { fst: a, snd: p.snd }

19+ , set: \p a -> { fst: a, snd: p.snd }

2520 }

2621

2722 test1 :: forall a b c. Lens (Pair (Pair a b) c) a

prelude/prelude.purs+2−7

@@ -614,13 +614,8 @@ module Arrays where

614614 isEmpty _ = false

615615

616616 range :: Number -> Number -> [Number]

617− range lo hi = {

618− var ns = [];

619− for (n <- lo until hi) {

620− ns = push ns n;

621− }

622− return ns;

623− }

617+ range lo hi | lo > hi = []

618+ range lo hi = lo : range (lo + 1) hi

624619

625620 zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]

626621 zipWith f (a:as) (b:bs) = f a b : zipWith f as bs

prelude/tests/Eff.purs+2−2

@@ -27,9 +27,9 @@ test4 = do

2727 trace "Hello World!"

2828 return 0

2929

30−test5 = do

30+test5 _ = do

3131 trace "Hello World!"

32− test5

32+ test5 {}

3333

3434test6 s = do

3535 trace s

src/Language/PureScript/CodeGen/JS.hs−19

@@ -126,7 +126,6 @@ valueToJs _ m e (Constructor (Qualified Nothing name)) =

126126 Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS m id (Qualified (Just aliasModule) aliasIdent)

127127 _ -> JSVar . runProperName $ name

128128valueToJs _ m _ (Constructor name) = qualifiedToJS m (Ident . runProperName) name

129−valueToJs opts m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs opts m e) sts))) []

130129valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (valueToJs opts m e) values)

131130valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)

132131valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)

@@ -324,24 +323,6 @@ isOnlyConstructor m e ctor =

324323 typeConstructor (TypeApp ty _) = typeConstructor ty

325324 typeConstructor fn = error $ "Invalid arguments to typeConstructor: " ++ show fn

326325

327−-- |

328−-- Generate code in the simplified Javascript intermediate representation for a statement in a

329−-- PureScript block.

330−--

331−statementToJs :: Options -> ModuleName -> Environment -> Statement -> JS

332−statementToJs opts m e (VariableIntroduction ident value) = JSVariableIntroduction (identToJs ident) (Just (valueToJs opts m e value))

333−statementToJs opts m e (Assignment target value) = JSAssignment (JSVar (identToJs target)) (valueToJs opts m e value)

334−statementToJs opts m e (While cond sts) = JSWhile (valueToJs opts m e cond) (JSBlock (map (statementToJs opts m e) sts))

335−statementToJs opts m e (For ident start end sts) = JSFor (identToJs ident) (valueToJs opts m e start) (valueToJs opts m e end) (JSBlock (map (statementToJs opts m e) sts))

336−statementToJs opts m e (If ifst) = ifToJs ifst

337− where

338− ifToJs :: IfStatement -> JS

339− ifToJs (IfStatement cond thens elses) = JSIfElse (valueToJs opts m e cond) (JSBlock (map (statementToJs opts m e) thens)) (fmap elseToJs elses)

340− elseToJs :: ElseStatement -> JS

341− elseToJs (Else sts) = JSBlock (map (statementToJs opts m e) sts)

342− elseToJs (ElseIf elif) = ifToJs elif

343−statementToJs opts m e (Return value) = JSReturn (valueToJs opts m e value)

344−

345326wrapExportsContainer :: Options -> [JS] -> JS

346327wrapExportsContainer opts modules = JSApp (JSFunction Nothing ["_ps"] $ JSBlock $ (JSStringLiteral "use strict") : modules) [exportSelector]

347328 where

src/Language/PureScript/Parser/Values.hs−70

@@ -15,7 +15,6 @@

1515

1616module Language.PureScript.Parser.Values (

1717 parseValue,

18− parseStatement,

1918 parseGuard,

2019 parseBinder,

2120 parseBinderNoParens,

@@ -83,17 +82,6 @@ parseIfThenElse = IfThenElse <$> (P.try (C.reserved "if") *> C.indented *> parse

8382 <*> (C.indented *> C.reserved "then" *> C.indented *> parseValue)

8483 <*> (C.indented *> C.reserved "else" *> C.indented *> parseValue)

8584

86−parseBlock :: P.Parsec String ParseState Value

87−parseBlock = Block <$> parseManyStatements

88−

89−parseManyStatements :: P.Parsec String ParseState [Statement]

90−parseManyStatements = (do

91− _ <- C.lexeme $ P.char '{'

92− C.indented

93− sts <- C.mark (P.many (C.same *> C.mark parseStatement))

94− _ <- C.lexeme (P.char '}')

95− return sts) P.<?> "block"

96−

9785parseValueAtom :: P.Parsec String ParseState Value

9886parseValueAtom = P.choice

9987 [ P.try parseNumericLiteral

@@ -104,7 +92,6 @@ parseValueAtom = P.choice

10492 , parseAbs

10593 , P.try parseConstructor

10694 , P.try parseVar

107− , parseBlock

10895 , parseCase

10996 , parseIfThenElse

11097 , parseDo

@@ -159,63 +146,6 @@ parseValue =

159146 return (BinaryNoParens ident))) AssocRight ]

160147 ]

161148

162−parseVariableIntroduction :: P.Parsec String ParseState Statement

163−parseVariableIntroduction = do

164− C.reserved "var"

165− name <- C.indented *> C.parseIdent

166− _ <- C.lexeme $ C.indented *> P.char '='

167− value <- parseValue

168− _ <- C.indented *> C.semi

169− return $ VariableIntroduction name value

170−

171−parseAssignment :: P.Parsec String ParseState Statement

172−parseAssignment = do

173− tgt <- P.try $ do

174− tgt <- C.parseIdent

175− _ <- C.lexeme $ C.indented *> P.char '='

176− return tgt

177− value <- parseValue

178− _ <- C.indented *> C.semi

179− return $ Assignment tgt value

180−

181−parseWhile :: P.Parsec String ParseState Statement

182−parseWhile = While <$> (C.reserved "while" *> C.indented *> C.parens parseValue)

183− <*> (C.indented *> parseManyStatements)

184−

185−parseFor :: P.Parsec String ParseState Statement

186−parseFor = For <$> (C.reserved "for" *> C.indented *> C.lexeme (P.char '(') *> C.indented *> C.parseIdent)

187− <*> (C.indented *> C.lexeme (P.string "<-") *> parseValue)

188− <*> (C.indented *> C.reserved "until" *> parseValue <* C.indented <* C.lexeme (P.char ')'))

189− <*> parseManyStatements

190−

191−parseIf :: P.Parsec String ParseState Statement

192−parseIf = If <$> parseIfStatement

193−

194−parseIfStatement :: P.Parsec String ParseState IfStatement

195−parseIfStatement =

196− IfStatement <$> (C.reserved "if" *> C.indented *> C.parens parseValue)

197− <*> parseManyStatements

198− <*> P.optionMaybe parseElseStatement

199−

200−parseElseStatement :: P.Parsec String ParseState ElseStatement

201−parseElseStatement = C.reserved "else" >> (ElseIf <$> parseIfStatement

202− <|> Else <$> parseManyStatements)

203−

204−parseReturn :: P.Parsec String ParseState Statement

205−parseReturn = Return <$> (C.reserved "return" *> parseValue <* C.indented <* C.semi)

206−

207−-- |

208−-- Parse a statement

209−--

210−parseStatement :: P.Parsec String ParseState Statement

211−parseStatement = P.choice

212− [ parseAssignment

213− , parseVariableIntroduction

214− , parseWhile

215− , parseFor

216− , parseIf

217− , parseReturn ] P.<?> "statement"

218−

219149parseStringBinder :: P.Parsec String ParseState Binder

220150parseStringBinder = StringBinder <$> C.stringLiteral

221151

src/Language/PureScript/Pretty/Values.hs−23

@@ -38,7 +38,6 @@ literals = mkPattern match

3838 match (ArrayLiteral xs) = Just $ "[" ++ intercalate ", " (map prettyPrintValue xs) ++ "]"

3939 match (ObjectLiteral ps) = Just $ "{" ++ intercalate ", " (map (uncurry prettyPrintObjectProperty) ps) ++ "}"

4040 match (Constructor name) = Just $ show name

41− match (Block sts) = Just $ "do { " ++ intercalate " ; " (map prettyPrintStatement sts) ++ " }"

4241 match (Case values binders) = Just $ "case " ++ intercalate " " (map prettyPrintValue values) ++

4342 " of { " ++ intercalate " ; " (map prettyPrintCaseAlternative binders) ++ " }"

4443 match (Var ident) = Just $ show ident

@@ -148,25 +147,3 @@ prettyPrintObjectPropertyBinder key binder = key ++ ": " ++ prettyPrintBinder bi

148147

149148prettyPrintObjectProperty :: String -> Value -> String

150149prettyPrintObjectProperty key value = key ++ ": " ++ prettyPrintValue value

151−

152−prettyPrintStatement :: Statement -> String

153−prettyPrintStatement (VariableIntroduction ident value) = "var " ++ show ident ++ " = " ++ prettyPrintValue value

154−prettyPrintStatement (Assignment target value) = show target ++ " = " ++ prettyPrintValue value

155−prettyPrintStatement (While cond sts) = "while " ++ prettyPrintValue cond ++ ": {" ++ intercalate ";" (map prettyPrintStatement sts) ++ " }"

156−prettyPrintStatement (For ident start end sts) = "for " ++ show ident

157− ++ " <- " ++ prettyPrintValue start

158− ++ " until " ++ prettyPrintValue end ++ ": {"

159− ++ intercalate "; " (map prettyPrintStatement sts) ++ " }"

160−prettyPrintStatement (If ifst) = prettyPrintIfStatement ifst

161−prettyPrintStatement (Return value) = "return " ++ prettyPrintValue value

162−

163−prettyPrintIfStatement :: IfStatement -> String

164−prettyPrintIfStatement (IfStatement cond thens elst) =

165− "if "

166− ++ prettyPrintValue cond ++ ": {"

167− ++ intercalate "; " (map prettyPrintStatement thens) ++ " }"

168− ++ maybe "" prettyPrintElseStatement elst

169−

170−prettyPrintElseStatement :: ElseStatement -> String

171−prettyPrintElseStatement (Else sts) = "else: {" ++ intercalate "; " (map prettyPrintStatement sts) ++ " }"

172−prettyPrintElseStatement (ElseIf ifst) = "else " ++ prettyPrintIfStatement ifst

src/Language/PureScript/Scope.hs+1−5

@@ -30,16 +30,12 @@ import Language.PureScript.CodeGen.JS.AST

3030-- Gather all used names appearing inside a value

3131--

3232usedNames :: (Data d) => d -> [Ident]

33−usedNames val = nub $ everything (++) (mkQ [] namesV `extQ` namesS `extQ` namesB `extQ` namesJS) val

33+usedNames val = nub $ everything (++) (mkQ [] namesV `extQ` namesB `extQ` namesJS) val

3434 where

3535 namesV :: Value -> [Ident]

3636 namesV (Abs arg _) = [arg]

3737 namesV (Var (Qualified Nothing name)) = [name]

3838 namesV _ = []

39− namesS :: Statement -> [Ident]

40− namesS (VariableIntroduction name _) = [name]

41− namesS (For name _ _ _) = [name]

42− namesS _ = []

4339 namesB :: Binder -> [Ident]

4440 namesB (VarBinder name) = [name]

4541 namesB _ = []

src/Language/PureScript/TypeChecker/Types.hs−80

@@ -541,11 +541,6 @@ infer' (Var var) = do

541541 dicts <- getTypeClassDictionaries

542542 return $ TypedValue True (foldl App (Var var) (map (flip TypeClassDictionary dicts) (qualifyAllUnqualifiedNames moduleName env constraints))) ty'

543543 _ -> return $ TypedValue True (Var var) ty

544−infer' (Block ss) = do

545− ret <- fresh

546− (allCodePathsReturn, _, ss') <- checkBlock M.empty ret ss

547− guardWith "Block is missing a return statement" allCodePathsReturn

548− return $ TypedValue True (Block ss') ret

549544infer' v@(Constructor c) = do

550545 env <- getEnv

551546 Just moduleName <- checkCurrentModule <$> get

@@ -670,77 +665,6 @@ assignVariable name = do

670665 Just _ -> UnifyT . lift . throwError $ "Variable with name " ++ show name ++ " already exists."

671666 _ -> return ()

672667

673−-- |

674−-- Check the type of the return values of a statement, returning whether or not the statement returns on

675−-- all code paths

676−--

677−checkStatement :: M.Map Ident Type -> Type -> Statement -> UnifyT Type Check (Bool, M.Map Ident Type, Statement)

678−checkStatement mass _ (VariableIntroduction name val) = do

679− assignVariable name

680− val'@(TypedValue _ _ t) <- infer val

681− return (False, M.insert name t mass, VariableIntroduction name val')

682−checkStatement mass _ (Assignment ident val) = do

683− val'@(TypedValue _ _ t) <- infer val

684− case M.lookup ident mass of

685− Nothing -> throwError $ "No local variable with name " ++ show ident

686− Just ty -> do t =?= ty

687− return (False, mass, Assignment ident val')

688−checkStatement mass ret (While val inner) = do

689− val' <- check val tyBoolean

690− (allCodePathsReturn, _, inner') <- checkBlock mass ret inner

691− return (allCodePathsReturn, mass, While val' inner')

692−checkStatement mass ret (If ifst) = do

693− (allCodePathsReturn, ifst') <- checkIfStatement mass ret ifst

694− return (allCodePathsReturn, mass, If ifst')

695−checkStatement mass ret (For ident start end inner) = do

696− Just moduleName <- checkCurrentModule <$> get

697− assignVariable ident

698− start' <- check start tyNumber

699− end' <- check end tyNumber

700− (allCodePathsReturn, _, inner') <- bindLocalVariables moduleName [(ident, tyNumber)] $ checkBlock mass ret inner

701− return (allCodePathsReturn, mass, For ident start' end' inner')

702−checkStatement mass ret (Return val) = do

703− val' <- check val ret

704− return (True, mass, Return (TypedValue True val' ret))

705−

706−-- |

707−-- Check the type of an if-then-else statement

708−--

709−checkIfStatement :: M.Map Ident Type -> Type -> IfStatement -> UnifyT Type Check (Bool, IfStatement)

710−checkIfStatement mass ret (IfStatement val thens Nothing) = do

711− val' <- check val tyBoolean

712− (_, _, thens') <- checkBlock mass ret thens

713− return (False, IfStatement val' thens' Nothing)

714−checkIfStatement mass ret (IfStatement val thens (Just elses)) = do

715− val' <- check val tyBoolean

716− (allCodePathsReturn1, _, thens') <- checkBlock mass ret thens

717− (allCodePathsReturn2, elses') <- checkElseStatement mass ret elses

718− return (allCodePathsReturn1 && allCodePathsReturn2, IfStatement val' thens' (Just elses'))

719−

720−-- |

721−-- Check the type of an else statement

722−--

723−checkElseStatement :: M.Map Ident Type -> Type -> ElseStatement -> UnifyT Type Check (Bool, ElseStatement)

724−checkElseStatement mass ret (Else elses) = do

725− (allCodePathsReturn, _, elses') <- checkBlock mass ret elses

726− return (allCodePathsReturn, Else elses')

727−checkElseStatement mass ret (ElseIf ifst) = (id *** ElseIf) <$> checkIfStatement mass ret ifst

728−

729−-- |

730−-- Check the type of the return value of a block of statements

731−--

732−checkBlock :: M.Map Ident Type -> Type -> [Statement] -> UnifyT Type Check (Bool, M.Map Ident Type, [Statement])

733−checkBlock mass _ [] = return (False, mass, [])

734−checkBlock mass ret (s:ss) = do

735− Just moduleName <- checkCurrentModule <$> get

736− (b1, mass1, s') <- checkStatement mass ret s

737− bindLocalVariables moduleName (M.toList mass1) $ case (b1, ss) of

738− (True, []) -> return (True, mass1, [s'])

739− (True, _) -> throwError "Unreachable code"

740− (False, ss') -> do

741− (b, m, ss'') <- checkBlock mass1 ret ss'

742− return (b, m, s':ss'')

743−

744668-- |

745669-- Generate a new skolem constant

746670--

@@ -876,10 +800,6 @@ check' (Accessor prop val) ty = do

876800 rest <- fresh

877801 val' <- check val (Object (RCons prop ty rest))

878802 return $ TypedValue True (Accessor prop val') ty

879−check' (Block ss) ret = do

880− (allCodePathsReturn, _, ss') <- checkBlock M.empty ret ss

881− guardWith "Block is missing a return statement" allCodePathsReturn

882− return $ TypedValue True (Block ss') ret

883803check' (Constructor c) ty = do

884804 env <- getEnv

885805 Just moduleName <- checkCurrentModule <$> get

src/Language/PureScript/Values.hs−55

@@ -86,10 +86,6 @@ data Value

8686 --

8787 | IfThenElse Value Value Value

8888 -- |

89− -- A \"Block\" i.e. a collection of statements which evaluate to a value

90− --

91− | Block [Statement]

92− -- |

9389 -- A data constructor

9490 --

9591 | Constructor (Qualified ProperName)

@@ -171,57 +167,6 @@ data DoNotationElement

171167 --

172168 | DoNotationLet Binder Value deriving (Show, Data, Typeable)

173169

174−-- |

175−-- Data type for statements which can appear inside a @Block@ expression

176−--

177−data Statement

178− -- |

179− -- A variable introduction and initial assignment

180− --

181− = VariableIntroduction Ident Value

182− -- |

183− -- A variable reassignment

184− --

185− | Assignment Ident Value

186− -- |

187− -- A while loop

188− --

189− | While Value [Statement]

190− -- |

191− -- A for loop

192− --

193− | For Ident Value Value [Statement]

194− -- |

195− -- An if-then-else statement

196− --

197− | If IfStatement

198− -- |

199− -- A return statement

200− --

201− | Return Value deriving (Show, Data, Typeable)

202−

203−-- |

204−-- Data type for if-statements

205−--

206−data IfStatement

207− -- |

208− -- An if statement. Arguments are (in order): boolean condition, true branch, optional else branch.

209− --

210− = IfStatement Value [Statement] (Maybe ElseStatement) deriving (Show, Data, Typeable)

211−

212−-- |

213−-- Data type for the else branch in an if-statement

214−--

215−data ElseStatement

216− -- |

217− -- An else branch

218− --

219− = Else [Statement]

220− -- |

221− -- An else-if branch

222− --

223− | ElseIf IfStatement deriving (Show, Data, Typeable)

224−

225170-- |

226171-- Data type for binders

227172--