packages feed

purescript 0.1.15 → 0.2.0

raw patch · 8 files changed

+112/−59 lines, 8 files

Files

purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.1.15+version: 0.2.0 cabal-version: >=1.8 build-type: Simple license: MIT
src/Language/PureScript/CodeGen/JS.hs view
@@ -128,23 +128,27 @@     done'' <- go done' bs'     js <- binderToJs m e propVar done'' binder     return (JSVariableIntroduction (Ident propVar) (Just (JSAccessor prop (JSVar (Ident varName)))) : js)-binderToJs m e varName done (ArrayBinder bs rest) = do-  js <- go done rest 0 bs-  return [JSIfElse (JSBinary cmp (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]+binderToJs m e varName done (ArrayBinder bs) = do+  js <- go done 0 bs+  return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]   where-  cmp :: BinaryOperator-  cmp = maybe EqualTo (const GreaterThanOrEqualTo) rest-  go :: [JS] -> Maybe Binder -> Integer -> [Binder] -> Gen [JS]-  go done' Nothing _ [] = return done'-  go done' (Just binder) index [] = do-    restVar <- fresh-    js <- binderToJs m e restVar done' binder-    return (JSVariableIntroduction (Ident restVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left index)])) : js)-  go done' rest' index (binder:bs') = do+  go :: [JS] -> Integer -> [Binder] -> Gen [JS]+  go done' _ [] = return done'+  go done' index (binder:bs') = do     elVar <- fresh-    done'' <- go done' rest' (index + 1) bs'+    done'' <- go done' (index + 1) bs'     js <- binderToJs m e elVar done'' binder     return (JSVariableIntroduction (Ident elVar) (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar (Ident varName)))) : js)+binderToJs m e varName done (ConsBinder headBinder tailBinder) = do+  headVar <- fresh+  tailVar <- fresh+  js1 <- binderToJs m e headVar done headBinder+  js2 <- binderToJs m e tailVar js1 tailBinder+  return [JSIfElse (JSBinary GreaterThan (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left 0))) (JSBlock+    ( JSVariableIntroduction (Ident headVar) (Just (JSIndexer (JSNumericLiteral (Left 0)) (JSVar (Ident varName)))) :+      JSVariableIntroduction (Ident tailVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left 1)])) :+      js2+    )) Nothing] binderToJs m e varName done (NamedBinder ident binder) = do   js <- binderToJs m e varName done binder   return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : js)@@ -165,4 +169,5 @@   elseToJs :: ElseStatement -> JS   elseToJs (Else sts) = JSBlock (map (statementToJs m e) sts)   elseToJs (ElseIf elif) = ifToJs elif+statementToJs m e (ValueStatement val) = valueToJs m e val statementToJs m e (Return value) = JSReturn (valueToJs m e value)
src/Language/PureScript/Parser/Common.hs view
@@ -74,7 +74,7 @@  builtInOperators :: [String] builtInOperators = [ "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"-                  , "==", "!=", "&&", "||", "&", "^", "|", "!!", "!" ]+                  , "==", "!=", "&&", "||", "&", "^", "|", "!!", "!", "." ]  reservedOpNames :: [String] reservedOpNames = builtInOperators ++ [ "->" ]@@ -89,10 +89,10 @@ identLetter = P.alphaNum <|> P.oneOf "_'"  opStart :: P.Parsec String u Char-opStart = P.oneOf "!#%&*+/<=>?@^|~"+opStart = P.oneOf ":.!#%&*+/<=>?@^|~"  opLetter :: P.Parsec String u Char-opLetter = P.oneOf ":#$%&*+./<=>?@^|"+opLetter = P.oneOf ":.#$%&*+./<=>?@^|"  langDef :: PT.GenLanguageDef String u Identity langDef = PT.LanguageDef
src/Language/PureScript/Parser/Values.hs view
@@ -86,18 +86,23 @@                              <*> (C.indented *> C.reserved "else" *> C.indented *> parseValue)  parseBlock :: P.Parsec String ParseState Value-parseBlock = Block <$> (P.try (C.reserved "do") *> parseManyStatements)+parseBlock = Block <$> parseManyStatements  parseManyStatements :: P.Parsec String ParseState [Statement]-parseManyStatements = C.indented *> C.mark (P.many (C.same *> C.mark parseStatement)) P.<?> "block"+parseManyStatements = (do+  C.lexeme $ P.char '{'+  C.indented+  sts <- C.mark (P.many (C.same *> C.mark parseStatement))+  C.lexeme (P.char '}')+  return sts) P.<?> "block"  parseValueAtom :: P.Parsec String ParseState Value-parseValueAtom = C.indented *> P.choice+parseValueAtom = P.choice             [ P.try parseNumericLiteral             , P.try parseStringLiteral             , P.try parseBooleanLiteral             , parseArrayLiteral-            , parseObjectLiteral+            , P.try parseObjectLiteral             , parseAbs             , P.try parseConstructor             , P.try parseVar@@ -115,7 +120,7 @@  parseAccessor :: Value -> P.Parsec String ParseState Value parseAccessor (Constructor _) = P.unexpected "constructor"-parseAccessor obj = Accessor <$> (C.indented *> C.dot *> C.indented *> C.identifier) <*> pure obj+parseAccessor obj = P.try $ Accessor <$> (C.indented *> C.dot *> P.notFollowedBy C.opLetter *> C.indented *> C.identifier) <*> pure obj  parseValue :: P.Parsec String ParseState Value parseValue =@@ -143,28 +148,32 @@   name <- C.indented *> C.parseIdent   C.lexeme $ C.indented *> P.char '='   value <- parseValue+  C.indented *> C.semi   return $ VariableIntroduction name value  parseAssignment :: P.Parsec String ParseState Statement parseAssignment = do-  tgt <- C.parseIdent-  C.lexeme $ C.indented *> P.char '='+  tgt <- P.try $ do+    tgt <- C.parseIdent+    C.lexeme $ C.indented *> P.char '='+    return tgt   value <- parseValue+  C.indented *> C.semi   return $ Assignment tgt value  parseWhile :: P.Parsec String ParseState Statement-parseWhile = While <$> (C.reserved "while" *> C.indented *> parseValue <* C.indented <* C.colon)-                   <*> parseManyStatements+parseWhile = While <$> (C.reserved "while" *> C.indented *> C.parens parseValue)+                   <*> (C.indented *> parseManyStatements)  parseFor :: P.Parsec String ParseState Statement-parseFor = For <$> (C.reserved "for" *> C.indented *> C.parseIdent)+parseFor = For <$> (C.reserved "for" *> C.indented *> C.lexeme (P.char '(') *> C.indented *> C.parseIdent)                <*> (C.indented *> C.lexeme (P.string "<-") *> parseValue)-               <*> (C.indented *> C.reserved "until" *> parseValue <* C.indented <* C.colon)+               <*> (C.indented *> C.reserved "until" *> parseValue <* C.indented <* C.lexeme (P.char ')'))                <*> parseManyStatements  parseForEach :: P.Parsec String ParseState Statement-parseForEach = ForEach <$> (C.reserved "foreach" *> C.indented *> C.parseIdent)-                       <*> (C.indented *> C.reserved "in" *> parseValue <* C.indented <* C.colon)+parseForEach = ForEach <$> (C.reserved "foreach" *> C.indented *> C.lexeme (P.char '(') *> C.indented *> C.parseIdent)+                       <*> (C.indented *> C.reserved "in" *> parseValue <* C.lexeme (P.char ')'))                        <*> parseManyStatements  parseIf :: P.Parsec String ParseState Statement@@ -172,26 +181,30 @@  parseIfStatement :: P.Parsec String ParseState IfStatement parseIfStatement =-  IfStatement <$> (C.reserved "if" *> C.indented *> parseValue <* C.indented <* C.colon)+  IfStatement <$> (C.reserved "if" *> C.indented *> C.parens parseValue)               <*> parseManyStatements-              <*> P.optionMaybe (C.same *> parseElseStatement)+              <*> P.optionMaybe parseElseStatement  parseElseStatement :: P.Parsec String ParseState ElseStatement-parseElseStatement = C.reserved "else" >> (ElseIf <$> (C.indented *> parseIfStatement)-                                           <|> Else <$> (C.indented *> C.colon *> parseManyStatements))+parseElseStatement = C.reserved "else" >> (ElseIf <$> parseIfStatement+                                           <|> Else <$> parseManyStatements) +parseValueStatement :: P.Parsec String ParseState Statement+parseValueStatement = ValueStatement <$> (parseValue <* C.semi)+ parseReturn :: P.Parsec String ParseState Statement-parseReturn = Return <$> (C.reserved "return" *> parseValue)+parseReturn = Return <$> (C.reserved "return" *> parseValue <* C.indented <* C.semi)  parseStatement :: P.Parsec String ParseState Statement-parseStatement = P.choice (map P.try+parseStatement = P.choice                  [ parseVariableIntroduction                  , parseAssignment                  , parseWhile                  , parseFor                  , parseForEach                  , parseIf-                 , parseReturn ]) P.<?> "statement"+                 , parseValueStatement+                 , parseReturn ] P.<?> "statement"  parseStringBinder :: P.Parsec String ParseState Binder parseStringBinder = StringBinder <$> C.stringLiteral@@ -216,7 +229,6 @@  parseArrayBinder :: P.Parsec String ParseState Binder parseArrayBinder = C.squares $ ArrayBinder <$> (C.commaSep (C.indented *> parseBinder))-                                           <*> P.optionMaybe (C.indented *> C.colon *> C.indented *> parseBinder)  parseNamedBinder :: P.Parsec String ParseState Binder parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* C.lexeme (P.char '@'))@@ -232,8 +244,8 @@   binder <- C.indented *> parseBinder   return (name, binder) -parseBinder :: P.Parsec String ParseState Binder-parseBinder = P.choice (map P.try+parseBinderAtom :: P.Parsec String ParseState Binder+parseBinderAtom = P.choice (map P.try                   [ parseNullBinder                   , parseStringBinder                   , parseBooleanBinder@@ -246,5 +258,11 @@                   , parseArrayBinder                   , C.parens parseBinder ]) P.<?> "binder" +parseBinder :: P.Parsec String ParseState Binder+parseBinder = (buildExpressionParser operators parseBinderAtom) P.<?> "expression"+  where+  operators = [ [ Infix ( C.lexeme (P.try $ C.indented *> C.reservedOp ":") >> return ConsBinder) AssocRight ] ]+ parseGuardedBinder :: P.Parsec String ParseState Binder parseGuardedBinder = flip ($) <$> parseBinder <*> P.option id (GuardedBinder <$> (C.indented *> C.lexeme (P.char '|') *> C.indented *> parseValue))+
src/Language/PureScript/Pretty/Values.hs view
@@ -143,20 +143,39 @@                   , [ binary    Or                   "||" ]                   ] +prettyPrintBinderAtom :: Pattern () Binder String+prettyPrintBinderAtom = mkPattern match+  where+  match :: Binder -> Maybe String+  match NullBinder = Just "_"+  match (StringBinder str) = Just $ show str+  match (NumberBinder num) = Just $ either show show num+  match (BooleanBinder True) = Just "true"+  match (BooleanBinder False) = Just "false"+  match (VarBinder ident) = Just $ show ident+  match (NullaryBinder ctor) = Just $ show ctor+  match (UnaryBinder ctor b) = Just $ show ctor ++ " " ++ prettyPrintBinder b+  match (ObjectBinder bs) = Just $ "{ " ++ intercalate ", " (map (uncurry prettyPrintObjectPropertyBinder) bs) ++ " }"+  match (ArrayBinder bs) = Just $ "[ " ++ intercalate ", " (map prettyPrintBinder bs) ++ " ]"+  match (NamedBinder ident binder) = Just $ show ident ++ "@" ++ prettyPrintBinder binder+  match (GuardedBinder cond binder) = Just $ prettyPrintBinder binder ++ " | " ++ prettyPrintValue cond+  match _ = Nothing+ prettyPrintBinder :: Binder -> String-prettyPrintBinder NullBinder = "_"-prettyPrintBinder (StringBinder str) = show str-prettyPrintBinder (NumberBinder num) = either show show num-prettyPrintBinder (BooleanBinder True) = "true"-prettyPrintBinder (BooleanBinder False) = "false"-prettyPrintBinder (VarBinder ident) = show ident-prettyPrintBinder (NullaryBinder ctor) = show ctor-prettyPrintBinder (UnaryBinder ctor b) = show ctor ++ " " ++ prettyPrintBinder b-prettyPrintBinder (ObjectBinder bs) = "{ " ++ intercalate ", " (map (uncurry prettyPrintObjectPropertyBinder) bs) ++ " }"-prettyPrintBinder (ArrayBinder bs rest) = "[ " ++ intercalate ", " (map prettyPrintBinder bs) ++ maybe "" (("; " ++) . prettyPrintBinder) rest ++ " ]"-prettyPrintBinder (NamedBinder ident binder) = show ident ++ "@" ++ prettyPrintBinder binder-prettyPrintBinder (GuardedBinder cond binder) = prettyPrintBinder binder ++ " | " ++ prettyPrintValue cond+prettyPrintBinder = fromMaybe (error "Incomplete pattern") . pattern matchBinder ()+  where+  matchBinder :: Pattern () Binder String+  matchBinder = buildPrettyPrinter operators (prettyPrintBinderAtom <+> fmap parens matchBinder)+  operators :: OperatorTable () Binder String+  operators =+    OperatorTable [ [ AssocR matchConsBinder (\b1 b2 -> b1 ++ " : " ++ b2) ] ] +matchConsBinder :: Pattern () Binder (Binder, Binder)+matchConsBinder = mkPattern match'+  where+  match' (ConsBinder b1 b2) = Just (b1, b2)+  match' _ = Nothing+ prettyPrintObjectPropertyBinder :: String -> Binder -> String prettyPrintObjectPropertyBinder key binder = key ++ ": " ++ prettyPrintBinder binder @@ -175,6 +194,7 @@   ++ " in " ++ prettyPrintValue arr ++ ": {"   ++ intercalate "; " (map prettyPrintStatement sts) ++ " }" prettyPrintStatement (If ifst) = prettyPrintIfStatement ifst+prettyPrintStatement (ValueStatement val) = prettyPrintValue val prettyPrintStatement (Return value) = "return " ++ prettyPrintValue value  prettyPrintIfStatement :: IfStatement -> String
src/Language/PureScript/TypeChecker/Types.hs view
@@ -469,15 +469,17 @@     m1 <- inferBinder propTy binder     m2 <- inferRowProperties nrow (RCons name propTy row) binders     return $ m1 `M.union` m2-inferBinder val (ArrayBinder binders rest) = do+inferBinder val (ArrayBinder binders) = do   el <- fresh   m1 <- M.unions <$> mapM (inferBinder el) binders   val ~~ Array el-  case rest of-    Nothing -> return m1-    Just binder -> do-      m2 <- inferBinder val binder-      return $ m1 `M.union` m2+  return m1+inferBinder val (ConsBinder headBinder tailBinder) = do+  el <- fresh+  m1 <- inferBinder el headBinder+  m2 <- inferBinder val tailBinder+  val ~~ Array el+  return $ m1 `M.union` m2 inferBinder val (NamedBinder name binder) = do   m <- inferBinder val binder   return $ M.insert name val m@@ -535,6 +537,9 @@   check vals (Array val)   (allCodePathsReturn, _) <- bindLocalVariables [(ident, val)] $ checkBlock mass ret inner   guardWith "Cannot return from within a foreach block" $ not allCodePathsReturn+  return (False, mass)+checkStatement mass _ (ValueStatement val) = do+  check val unit   return (False, mass) checkStatement mass ret (Return val) = do   check val ret
src/Language/PureScript/Types.hs view
@@ -68,3 +68,6 @@  mkForAll :: [String] -> Type -> Type mkForAll = flip . foldl . flip $ ForAll++unit :: Type+unit = Object REmpty
src/Language/PureScript/Values.hs view
@@ -77,6 +77,7 @@   | For Ident Value Value [Statement]   | ForEach Ident Value [Statement]   | If IfStatement+  | ValueStatement Value   | Return Value deriving (Show, Data, Typeable)  data IfStatement = IfStatement Value [Statement] (Maybe ElseStatement) deriving (Show, Data, Typeable)@@ -94,6 +95,7 @@   | NullaryBinder (Qualified ProperName)   | UnaryBinder (Qualified ProperName) Binder   | ObjectBinder [(String, Binder)]-  | ArrayBinder [Binder] (Maybe Binder)+  | ArrayBinder [Binder]+  | ConsBinder Binder Binder   | NamedBinder Ident Binder   | GuardedBinder Value Binder deriving (Show, Data, Typeable)