packages feed

purescript 0.1.5 → 0.1.6

raw patch · 10 files changed

+38/−16 lines, 10 files

Files

purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.1.5+version: 0.1.6 cabal-version: >=1.8 build-type: Simple license: MIT
src/Language/PureScript/CodeGen/Externs.hs view
@@ -25,11 +25,11 @@ externToPs :: Environment -> Declaration -> Maybe String externToPs env (ValueDeclaration name _) = do   (ty, _) <- M.lookup name $ names env-  return $ "extern " ++ show name ++ " :: " ++ prettyPrintPolyType ty-externToPs env (ExternDeclaration name ty) =-  return $ "extern " ++ show name ++ " :: " ++ prettyPrintPolyType ty+  return $ "foreign import " ++ show name ++ " :: " ++ prettyPrintPolyType ty+externToPs env (ExternMemberDeclaration member name ty) =+  return $ "foreign import member " ++ show member ++ " " ++ show name ++ " :: " ++ prettyPrintPolyType ty externToPs env (ExternDataDeclaration name kind) =-  return $ "extern data " ++ name ++ " :: " ++ prettyPrintKind kind+  return $ "foreign import data " ++ name ++ " :: " ++ prettyPrintKind kind externToPs env (TypeSynonymDeclaration name args ty) =   return $ "type " ++ name ++ " " ++ unwords args ++ " = " ++ prettyPrintType ty externToPs _ _ = Nothing
src/Language/PureScript/CodeGen/JS.hs view
@@ -36,6 +36,8 @@ declToJs :: Declaration -> Maybe [JS] declToJs (ValueDeclaration ident (Abs args ret)) = Just [JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs ret)])] declToJs (ValueDeclaration ident val) = Just [JSVariableIntroduction ident (valueToJs val)]+declToJs (ExternMemberDeclaration member ident _) =+  Just [JSFunction (Just ident) [Ident "value"] (JSBlock [JSReturn (JSAccessor member (JSVar (Ident "value")))])] declToJs (DataDeclaration _ _ ctors) =   Just $ flip map ctors $ \(ctor, maybeTy) ->     case maybeTy of
src/Language/PureScript/Declarations.hs view
@@ -35,5 +35,6 @@   | TypeDeclaration Ident PolyType   | ValueDeclaration Ident Value   | ExternDeclaration Ident PolyType+  | ExternMemberDeclaration String Ident PolyType   | ExternDataDeclaration String Kind   | FixityDeclaration Fixity String deriving (Show, D.Data, D.Typeable)
src/Language/PureScript/Parser/Common.hs view
@@ -44,7 +44,9 @@                 , "return"                 , "true"                 , "false"-                , "extern"+                , "foreign"+                , "import"+                , "member"                 , "forall"                 , "do"                 , "until"@@ -74,7 +76,7 @@  reservedOpNames :: [String] reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"-                  , "==", "!=", "&", "^", "|", "&&", "||", "->" ]+                  , "==", "!=", "&", "^", "|", "&&", "||", "->", "!" ]  identStart :: P.Parsec String u Char identStart = P.lower <|> P.oneOf "_$"
src/Language/PureScript/Parser/Declarations.hs view
@@ -63,10 +63,13 @@                    <*> parseValue  parseExternDeclaration :: P.Parsec String ParseState Declaration-parseExternDeclaration = P.try (reserved "extern") *> indented *>-  (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)-                        <*> (lexeme (indented *> P.string "::") *> parseKind)+parseExternDeclaration = P.try (reserved "foreign") *> indented *> (reserved "import") *> indented *>+   (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)+                             <*> (lexeme (indented *> P.string "::") *> parseKind)    <|> ExternDeclaration <$> parseIdent+                        <*> (lexeme (indented *> P.string "::") *> parsePolyType)+   <|> ExternMemberDeclaration <$> (P.try (reserved "member") *> indented *> stringLiteral)+                        <*> (indented *> parseIdent)                         <*> (lexeme (indented *> P.string "::") *> parsePolyType))  parseAssociativity :: P.Parsec String ParseState Associativity
src/Language/PureScript/Parser/Values.hs view
@@ -125,7 +125,6 @@   where   indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom   postfixTable1 = [ Accessor <$> (C.indented *> C.dot *> C.indented *> C.identifier)-                  , P.try $ Indexer <$> (C.indented *> C.squares parseValue)                   , P.try $ flip ObjectUpdate <$> (C.indented *> C.braces ((C.indented *> parsePropertyUpdate) `P.sepBy1` (C.indented *> C.comma))) ]   postfixTable2 = [ P.try (C.indented *> indexersAndAccessors >>= \t2 -> return (\t1 -> App t1 [t2]))                   , P.try $ flip App <$> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))@@ -137,6 +136,7 @@                 , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "+") >> return id ]               ] ++ customOperatorTable user ++               [ [ Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident -> return $ \t1 t2 -> App (App (Var ident) [t1]) [t2])) AssocLeft ]+              , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (flip Indexer)) AssocRight ]               , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<=") >> return (Binary LessThanOrEqualTo)) AssocRight                 , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">=") >> return (Binary GreaterThanOrEqualTo)) AssocRight ]               , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<") >> return (Binary LessThan)) AssocRight
src/Language/PureScript/Pretty/Values.hs view
@@ -59,10 +59,10 @@   match (Accessor prop val) = Just (prop, val)   match _ = Nothing -indexer :: Pattern Value (String, Value)+indexer :: Pattern Value (Value, Value) indexer = Pattern $ A.Kleisli match   where-  match (Indexer index val) = Just (prettyPrintValue index, val)+  match (Indexer index val) = Just (index, val)   match _ = Nothing  objectUpdate :: Pattern Value ([String], Value)@@ -109,11 +109,11 @@   operators :: OperatorTable Value String   operators =     OperatorTable [ [ Wrap accessor $ \prop val -> val ++ "." ++ prop ]-                  , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]                   , [ Wrap objectUpdate $ \ps val -> val ++ "{ " ++ intercalate ", " ps ++ " }" ]                   , [ Wrap app $ \args val -> val ++ "(" ++ args ++ ")" ]                   , [ Split lam $ \args val -> "\\" ++ intercalate ", " args ++ " -> " ++ prettyPrintValue val ]                   , [ Wrap ifThenElse $ \(th, el) cond -> cond ++ " ? " ++ prettyPrintValue th ++ " : " ++ prettyPrintValue el ]+                  , [ AssocR indexer (\index val -> val ++ " ! " ++ index) ]                   , [ binary    LessThan             "<" ]                   , [ binary    LessThanOrEqualTo    "<=" ]                   , [ binary    GreaterThan          ">" ]
src/Language/PureScript/TypeChecker.hs view
@@ -81,8 +81,21 @@   guardWith (name ++ " is already defined") $ not $ M.member name (types env)   putEnv $ env { types = M.insert name (kind, TypeSynonym) (types env) }   typeCheckAll rest+typeCheckAll (ExternMemberDeclaration member name ty : rest) = do+  rethrow (("Error in foreign import member declaration " ++ show name ++ ": ") ++) $ do+    env <- getEnv+    kind <- kindOf ty+    guardWith "Expected kind *" $ kind == Star+    case M.lookup name (names env) of+      Just _ -> throwError $ show name ++ " is already defined"+      Nothing -> case ty of+        (PolyType _ (Function [_] _)) -> do+          putEnv (env { names = M.insert name (ty, Extern) (names env)+                      , members = M.insert name member (members env) })+        _ -> throwError "Foreign member declarations must have function types, with an single argument."+  typeCheckAll rest typeCheckAll (ExternDeclaration name ty : rest) = do-  rethrow (("Error in extern declaration " ++ show name ++ ": ") ++) $ do+  rethrow (("Error in foreign import declaration " ++ show name ++ ": ") ++) $ do     env <- getEnv     kind <- kindOf ty     guardWith "Expected kind *" $ kind == Star
src/Language/PureScript/TypeChecker/Monad.hs view
@@ -37,10 +37,11 @@   , types :: M.Map String (Kind, TypeDeclarationKind)   , dataConstructors :: M.Map String PolyType   , typeSynonyms :: M.Map String ([String], Type)+  , members :: M.Map Ident String   }  emptyEnvironment :: Environment-emptyEnvironment = Environment M.empty M.empty M.empty M.empty+emptyEnvironment = Environment M.empty M.empty M.empty M.empty M.empty  newtype Check a = Check { unCheck :: StateT (Environment, Int) (Either String) a } deriving (Functor, Monad, Applicative, MonadPlus, MonadState (Environment, Int), MonadError String)