aabb9d3 · rowtype-yoga/purescript-native

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

For Each

commitaabb9d33f8d94af4a685f4b745f70d8a166d7860 authorPhil Freeman <paf31@cantab.net> dateSun 20 Oct 2013, 17:30 (13 years ago) parenteec09d8

9 files changed+65−29

compare with golang

unifiedsplit

examples/Assign.ps+4−4 examples/Foreach.js+1 examples/Foreach.ps+5 examples/runAll.test+8 src/PureScript/CodeGen/JS.hs+8−5 src/PureScript/Parser/Common.hs+4−1 src/PureScript/Parser/Values.hs+9−5 src/PureScript/TypeChecker/Types.hs+24−13 src/PureScript/Values.hs+2−1

examples/Assign.ps+4−4

@@ -1,5 +1,5 @@

1−test = \ -> do

2− var x = []

3− for (var i = 0; i < 10; i = i + 1):

4− x[i] = i

1+sum = \n -> do

2+ var x = 0

3+ for i <- 0 until n:

4+ x = x + i

55 return x

examples/Foreach.jsnew file+1

@@ -0,0 +1 @@

1+console.log(sum([1,2,3,4,5]));

examples/Foreach.psnew file+5

@@ -0,0 +1,5 @@

1+sum = \ns -> do

2+ var total = 0

3+ foreach n in ns:

4+ total = total + n

5+ return total

examples/runAll.test+8

@@ -13,3 +13,11 @@ mkdir -p tests && ../dist/build/psc/psc List.ps -o tests/List.js && cat tests/L

1313[ 1, 2 ]

1414>>>2

1515>>>= 0

16+

17+# Foreach

18+mkdir -p tests && ../dist/build/psc/psc Foreach.ps -o tests/Foreach.js && cat tests/Foreach.js Foreach.js | node

19+<<<

20+>>>

21+15

22+>>>2

23+>>>= 0

src/PureScript/CodeGen/JS.hs+8−5

@@ -223,11 +223,14 @@ statementToJs (Assignment target value) = assignmentTargetToJs target ++ " = " +

223223statementToJs (While cond sts) = "while ("

224224 ++ valueToJs cond ++ ") {"

225225 ++ intercalate ";" (map statementToJs sts) ++ "}"

226−statementToJs (For (init, cond, done) sts) = "for (" ++

227− statementToJs init

228− ++ "; " ++ valueToJs cond

229− ++ "; " ++ statementToJs done

230− ++ ") {" ++ intercalate ";" (map statementToJs sts) ++ "}"

226+statementToJs (For ident start end sts) = "for (" ++

227+ identToJs ident ++ " = " ++ valueToJs start ++ ";"

228+ ++ identToJs ident ++ " < " ++ valueToJs end ++ ";"

229+ ++ identToJs ident ++ "++) {"

230+ ++ intercalate ";" (map statementToJs sts) ++ "}"

231+statementToJs (ForEach ident arr sts) = valueToJs arr

232+ ++ ".forEach(function(" ++ identToJs ident ++ ") {"

233+ ++ intercalate ";" (map statementToJs sts) ++ "})"

231234statementToJs (If ifst) = ifStatementToJs ifst

232235statementToJs (Return value) = "return " ++ valueToJs value

233236

src/PureScript/Parser/Common.hs+4−1

@@ -34,6 +34,7 @@ reservedNames = [ "case"

3434 , "val"

3535 , "while"

3636 , "for"

37+ , "foreach"

3738 , "if"

3839 , "then"

3940 , "else"

@@ -42,7 +43,9 @@ reservedNames = [ "case"

4243 , "false"

4344 , "extern"

4445 , "forall"

45− , "do" ]

46+ , "do"

47+ , "until"

48+ , "in" ]

4649

4750reservedOpNames :: [String]

4851reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"

src/PureScript/Parser/Values.hs+9−5

@@ -148,12 +148,15 @@ parseWhile = While <$> (C.reserved "while" *> C.indented *> parseValue <* C.inde

148148 <*> parseManyStatements

149149

150150parseFor :: P.Parsec String P.Column Statement

151−parseFor = For <$> (C.reserved "for" *> C.indented *> C.parens forIntro <* C.indented <* C.colon)

151+parseFor = For <$> (C.reserved "for" *> C.indented *> C.parseIdent)

152+ <*> (C.indented *> C.lexeme (P.string "<-") *> parseValue)

153+ <*> (C.indented *> C.reserved "until" *> parseValue <* C.colon)

152154 <*> parseManyStatements

153− where

154− forIntro = (,,) <$> (C.indented *> parseStatement)

155− <*> (C.indented *> C.semi *> C.indented *> parseValue)

156− <*> (C.indented *> C.semi *> C.indented *> parseStatement)

155+

156+parseForEach :: P.Parsec String P.Column Statement

157+parseForEach = ForEach <$> (C.reserved "foreach" *> C.indented *> C.parseIdent)

158+ <*> (C.indented *> C.reserved "in" *> parseValue <* C.colon)

159+ <*> parseManyStatements

157160

158161parseIf :: P.Parsec String P.Column Statement

159162parseIf = If <$> parseIfStatement

@@ -177,6 +180,7 @@ parseStatement = P.choice (map P.try

177180 , parseAssignment

178181 , parseWhile

179182 , parseFor

183+ , parseForEach

180184 , parseIf

181185 , parseReturn ])

182186

src/PureScript/TypeChecker/Types.hs+24−13

@@ -368,13 +368,17 @@ typeConstraintsForBinders m nval ret ((binder, val):bs) = do

368368 cs3 <- typeConstraintsForBinders m nval ret bs

369369 return ((TypeConstraint n2 (TUnknown ret)) : cs1 ++ cs2 ++ cs3)

370370

371+assignVariable :: Ident -> M.Map Ident Int -> Check ()

372+assignVariable name m =

373+ case M.lookup name m of

374+ Nothing -> return ()

375+ Just _ -> throwError $ "Variable with name " ++ show name ++ " already exists."

376+

371377typeConstraintsForStatement :: M.Map Ident Int -> M.Map Ident Int -> Int -> Statement -> Check ([TypeConstraint], Bool, M.Map Ident Int)

372378typeConstraintsForStatement m mass ret (VariableIntroduction name val) = do

373− case M.lookup name (m `M.union` mass) of

374− Nothing -> do

375− (cs1, n1) <- typeConstraints m val

376− return $ (cs1, False, M.insert name n1 mass)

377− Just ty -> throwError $ "Variable with name " ++ show name ++ " already exists."

379+ assignVariable name (m `M.union` mass)

380+ (cs1, n1) <- typeConstraints m val

381+ return $ (cs1, False, M.insert name n1 mass)

378382typeConstraintsForStatement m mass ret (Assignment tgt val) = do

379383 (cs1, n1) <- typeConstraints m val

380384 cs2 <- typeConstraintsForAssignmentTarget m mass n1 tgt

@@ -386,14 +390,21 @@ typeConstraintsForStatement m mass ret (While val inner) = do

386390typeConstraintsForStatement m mass ret (If ifst) = do

387391 (cs, allCodePathsReturn) <- typeConstraintsForIfStatement m mass ret ifst

388392 return $ (cs, allCodePathsReturn, mass)

389−typeConstraintsForStatement m mass ret (For (init, cond, cont) inner) = do

390− (cs1, b1, mass1) <- typeConstraintsForStatement m mass ret init

391− guardWith "Cannot return from inside for" $ not b1

392− (cs2, n1) <- typeConstraints (m `M.union` mass1) cond

393− (cs3, b2, mass2) <- typeConstraintsForStatement (m `M.union` mass1) mass1 ret cont

394− guardWith "Cannot return from inside for" $ not b2

395− (cs4, allCodePathsReturn, _) <- typeConstraintsForBlock (m `M.union` mass2) mass2 ret inner

396− return $ ((TypeConstraint n1 Boolean) : cs1 ++ cs2 ++ cs3 ++ cs4, allCodePathsReturn, mass)

393+typeConstraintsForStatement m mass ret (For ident start end inner) = do

394+ assignVariable ident (m `M.union` mass)

395+ (cs1, n1) <- typeConstraints (m `M.union` mass) start

396+ (cs2, n2) <- typeConstraints (m `M.union` mass) end

397+ let mass1 = M.insert ident n1 mass

398+ (cs3, allCodePathsReturn, _) <- typeConstraintsForBlock (m `M.union` mass1) mass1 ret inner

399+ return $ ((TypeConstraint n1 Number) : (TypeConstraint n2 Number) : cs1 ++ cs2 ++ cs3, allCodePathsReturn, mass)

400+typeConstraintsForStatement m mass ret (ForEach ident vals inner) = do

401+ assignVariable ident (m `M.union` mass)

402+ val <- fresh

403+ (cs1, n1) <- typeConstraints (m `M.union` mass) vals

404+ let mass1 = M.insert ident val mass

405+ (cs2, allCodePathsReturn, _) <- typeConstraintsForBlock (m `M.union` mass1) mass1 ret inner

406+ guardWith "Cannot return from within a foreach block" $ not allCodePathsReturn

407+ return $ ((TypeConstraint n1 (Array (TUnknown val))) : cs1 ++ cs2, False, mass)

397408typeConstraintsForStatement m mass ret (Return val) = do

398409 (cs1, n1) <- typeConstraints (m `M.union` mass) val

399410 return ((TypeConstraint n1 (TUnknown ret)) : cs1, True, mass)

src/PureScript/Values.hs+2−1

@@ -70,7 +70,8 @@ data Statement

7070 = VariableIntroduction Ident Value

7171 | Assignment AssignmentTarget Value

7272 | While Value [Statement]

73− | For (Statement, Value, Statement) [Statement]

73+ | For Ident Value Value [Statement]

74+ | ForEach Ident Value [Statement]

7475 | If IfStatement

7576 | Return Value deriving (Show, Data, Typeable)

7677