git.iko.soy/elk
on master help sign in
Create a Parse.Declaration file for all declarations. Get rid of special
d29ca3bEvan Czaplicki
compiler/Parse/Declaration.hs+97−3
compare with master
unifiedsplit
@@ -2,24 +2,27 @@
2module Parse.Declaration where
2module Parse.Declaration where
3
3
4import Control.Applicative ((<$>), (<*>))
4import Control.Applicative ((<$>), (<*>))
5−import Data.List (foldl')
5+import qualified Data.List as List
6import Text.Parsec hiding (newline,spaces)
6import Text.Parsec hiding (newline,spaces)
7import Text.Parsec.Indent
7import Text.Parsec.Indent
8import qualified Text.Pandoc as Pan
8import qualified Text.Pandoc as Pan
9
9
10import Parse.Helpers
10import Parse.Helpers
11import qualified Parse.Expression as Expr
11import qualified Parse.Expression as Expr
12+import qualified SourceSyntax.Type as T
12import qualified Parse.Type as Type
13import qualified Parse.Type as Type
13
14
14import SourceSyntax.Declaration (Declaration(..))
15import SourceSyntax.Declaration (Declaration(..))
15
16
16import Unique
17import Unique
17
18
19+declaration :: IParser (Declaration t v)
20+declaration = definition <|> alias <|> datatype <|> foreignDef
18
21
19definition :: IParser (Declaration t v)
22definition :: IParser (Declaration t v)
20definition = Definition <$> Expr.def
23definition = Definition <$> Expr.def
21
24
22−alias :: IParser [Declaration t v]
25+alias :: IParser (Declaration t v)
23alias = do
26alias = do
24 start <- getPosition
27 start <- getPosition
25 reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"
28 reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"
@@ -29,4 +32,95 @@ alias = do
29 whitespace ; string "=" ; whitespace
32 whitespace ; string "=" ; whitespace
30 tipe <- Type.expr
33 tipe <- Type.expr
31 end <- getPosition
34 end <- getPosition
32− return [TypeAlias alias args tipe]
35+ return (TypeAlias alias args tipe)
36+
37+datatype :: IParser (Declaration t v)
38+datatype = do
39+ reserved "data" <?> "datatype definition (data T = A | B | ...)"
40+ forcedWS
41+ name <- capVar <?> "name of data-type"
42+ args <- spacePrefix lowVar
43+ whitespace ; string "=" ; whitespace
44+ tcs <- pipeSep1 Type.constructor
45+ return $ Datatype name args tcs
46+
47+
48+foreignDef :: IParser (Declaration t v)
49+foreignDef = do
50+ try (reserved "foreign")
51+ whitespace
52+ importEvent <|> exportEvent
53+
54+exportEvent :: IParser (Declaration t v)
55+exportEvent = do
56+ try (reserved "export") >> whitespace >> reserved "jsevent" >> whitespace
57+ eventName <- jsVar
58+ whitespace
59+ elmVar <- lowVar
60+ whitespace ; hasType ; whitespace
61+ tipe <- Type.expr
62+ case tipe of
63+ T.Data "Signal" [t] ->
64+ case isExportable t of
65+ Nothing -> return (ExportEvent eventName elmVar tipe)
66+ Just err -> error err
67+ _ -> error "When importing foreign events, the imported value must have type Signal."
68+
69+importEvent :: IParser (Declaration t v)
70+importEvent = do
71+ try (reserved "import") >> whitespace >> reserved "jsevent" >> whitespace
72+ eventName <- jsVar
73+ whitespace
74+ baseValue <- Expr.term <?> "Base case for imported signal (signals cannot be undefined)"
75+ whitespace
76+ elmVar <- lowVar <?> "Name of imported signal"
77+ whitespace ; hasType ; whitespace
78+ tipe <- Type.expr
79+ case tipe of
80+ T.Data "Signal" [t] ->
81+ case isExportable t of
82+ Nothing -> return (ImportEvent eventName baseValue elmVar tipe)
83+ Just err -> error err
84+ _ -> error "When importing foreign events, the imported value must have type Signal."
85+
86+jsVar :: IParser String
87+jsVar = betwixt '"' '"' $ do
88+ v <- (:) <$> (letter <|> char '_') <*> many (alphaNum <|> char '_')
89+ if v `notElem` jsReserveds then return v else
90+ error $ "'" ++ v ++
91+ "' is not a good name for a importing or exporting JS values."
92+
93+jsReserveds :: [String]
94+jsReserveds =
95+ [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"
96+ , "arguments", "int", "byte", "char", "goto", "long", "final", "float"
97+ , "short", "double", "native", "throws", "boolean", "abstract", "volatile"
98+ , "transient", "synchronized", "function", "break", "case", "catch"
99+ , "continue", "debugger", "default", "delete", "do", "else", "finally"
100+ , "for", "function", "if", "in", "instanceof", "new", "return", "switch"
101+ , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"
102+ , "const", "enum", "export", "extends", "import", "super", "implements"
103+ , "interface", "let", "package", "private", "protected", "public"
104+ , "static", "yield"
105+ ]
106+
107+isExportable tipe =
108+ case tipe of
109+ T.Lambda _ _ ->
110+ Just $ "Elm's JavaScript event interface does not yet handle functions. " ++
111+ "Only simple values can be imported and exported in this release."
112+
113+ T.Data "JSArray" [t] -> isExportable t
114+
115+ T.Data name []
116+ | name `elem` jsTypes -> Nothing
117+ | otherwise -> Just $ "'" ++ name ++ "' is not an exportable type." ++ msg
118+
119+ T.Data name _ ->
120+ Just $ "'" ++ name ++ "' is not an exportable type " ++
121+ "constructor. Only 'JSArray' is an exportable container."
122+
123+ T.Var _ -> Just $ "Cannot export type variables." ++ msg
124+ where
125+ msg = " The following types are exportable: " ++ List.intercalate ", " jsTypes
126+ jsTypes = ["JSString","JSNumber","JSDomNode","JSBool","JSObject"]
compiler/Parse/Foreign.hsdeleted−63
@@ -1,63 +0,0 @@
1−
2−module Parse.Foreign (foreignDef) where
3−
4−import Control.Applicative ((<$>), (<*>))
5−import Text.Parsec hiding (newline,spaces)
6−
7−import SourceSyntax.Declaration (Declaration(ExportEvent,ImportEvent))
8−import Parse.Helpers
9−import Parse.Expression (term)
10−import Parse.Type
11−import Types.Types (signalOf)
12−
13−foreignDef :: IParser (Declaration t v)
14−foreignDef = do try (reserved "foreign") ; whitespace
15− importEvent <|> exportEvent
16−
17−exportEvent :: IParser (Declaration t v)
18−exportEvent = do
19− try (reserved "export") >> whitespace >> reserved "jsevent" >> whitespace
20− js <- jsVar ; whitespace
21− elm <- lowVar ; whitespace
22− hasType ; whitespace
23− tipe <- typeExpr
24− case tipe of
25− ADTPT "Signal" [pt] ->
26− either error (return . ExportEvent js elm . signalOf) (toForeignType pt)
27− _ -> error "When exporting events, the exported value must be a Signal."
28−
29−importEvent :: IParser (Declaration t v)
30−importEvent = do
31− try (reserved "import") >> whitespace >> reserved "jsevent" >> whitespace
32− js <- jsVar ; whitespace
33− base <- term <?> "Base case for imported signal (signals cannot be undefined)"
34− whitespace
35− elm <- lowVar <?> "Name of imported signal"
36− whitespace ; hasType ; whitespace
37− tipe <- typeExpr
38− case tipe of
39− ADTPT "Signal" [pt] ->
40− either error (return . ImportEvent js base elm . signalOf) (toForeignType pt)
41− _ -> error "When importing events, the imported value must be a Signal."
42−
43−
44−jsVar :: IParser String
45−jsVar = betwixt '"' '"' $ do
46− v <- (:) <$> (letter <|> char '_') <*> many (alphaNum <|> char '_')
47− if v `notElem` jsReserveds then return v else
48− error $ "'" ++ v ++
49− "' is not a good name for a importing or exporting JS values."
50−
51−jsReserveds :: [String]
52−jsReserveds =
53− [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"
54− , "arguments", "int", "byte", "char", "goto", "long", "final", "float"
55− , "short", "double", "native", "throws", "boolean", "abstract", "volatile"
56− , "transient", "synchronized", "function", "break", "case", "catch"
57− , "continue", "debugger", "default", "delete", "do", "else", "finally"
58− , "for", "function", "if", "in", "instanceof", "new", "return", "switch"
59− , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"
60− , "const", "enum", "export", "extends", "import", "super", "implements"
61− , "interface", "let", "package", "private", "protected", "public"
62− , "static", "yield"
63− ]
compiler/Parse/Module.hs+16−18
@@ -25,22 +25,20 @@ moduleDef = do
25imports :: IParser Imports
25imports :: IParser Imports
26imports = option [] ((:) <$> import' <*> many (try (freshLine >> import')))
26imports = option [] ((:) <$> import' <*> many (try (freshLine >> import')))
27
27
28−
29import' :: IParser (String, ImportMethod)
28import' :: IParser (String, ImportMethod)
30−import' = do
29+import' =
31− reserved "import"
30+ do reserved "import"
32− whitespace
31+ whitespace
33− open <- optionMaybe (reserved "open")
32+ open <- optionMaybe (reserved "open")
34− whitespace
33+ whitespace
35− name <- intercalate "." <$> dotSep1 capVar
34+ name <- intercalate "." <$> dotSep1 capVar
36− case open of
35+ case open of
37− Just _ -> return (name, Hiding [])
36+ Just _ -> return (name, Hiding [])
38− Nothing -> let how = try (whitespace >> (as' <|> importing'))
37+ Nothing -> let how = try (whitespace >> (as' <|> importing'))
39− in (,) name <$> option (Importing []) how
38+ in (,) name <$> option (Importing []) how
40−
39+ where
41−
42−as' :: IParser ImportMethod
40+ as' :: IParser ImportMethod
43−as' = reserved "as" >> whitespace >> As <$> capVar <?> "alias for module"
41+ as' = reserved "as" >> whitespace >> As <$> capVar <?> "alias for module"
44−
42+
45−importing' :: IParser ImportMethod
43+ importing' :: IParser ImportMethod
46−importing' = Importing <$> varList <?> "listing of imported values (x,y,z)"
44+ importing' = Importing <$> varList <?> "listing of imported values (x,y,z)"
compiler/Parse/Type.hs−71
@@ -69,74 +69,3 @@ expr =
69constructor :: IParser (String, [T.Type])
69constructor :: IParser (String, [T.Type])
70constructor = (,) <$> (capVar <?> "another type constructor")
70constructor = (,) <$> (capVar <?> "another type constructor")
71 <*> spacePrefix term
71 <*> spacePrefix term
72−
73−{--
74−datatype :: IParser (Declaration t v)
75−datatype = do
76− reserved "data" <?> "datatype definition (data T = A | B | ...)"
77− forcedWS ; name <- capVar <?> "name of data-type" ; args <- spacePrefix lowVar
78− whitespace ; string "=" ; whitespace
79− tcs <- pipeSep1 typeConstructor
80− case toDatatype name args tcs of
81− Right dt -> return dt
82− Left msg -> fail msg
83−
84−beta = liftM T.Var guid
85−
86−toType :: T.Type -> Type
87−toType pt =
88− let frees :: T.Type -> [String]
89− frees pt = case pt of
90− LambdaPT a b -> frees a ++ frees b
91− ADTPT _ ts -> concatMap frees ts
92− RecordPT t fs -> maybe [] frees t ++ concatMap (frees . snd) fs
93− VarPT (c:cs) | isLower c -> [c:cs]
94− | otherwise -> []
95− in case toTypeWith "" (zip (frees pt) ['a'..]) pt of
96− Right t -> t
97− Left _ -> T.Var 0
98−
99−toTypeWith :: String -> [(String,String)] -> T.Type -> Either String Type
100−toTypeWith name tvarDict pt =
101− let msg x = "Type variable '" ++ x ++ "' is unbound in type '" ++ name ++ "'."
102− toT = toTypeWith name tvarDict
103− in case pt of
104− LambdaPT t1 t2 -> T.Lambda <$> toT t1 <*> toT t2
105− ADTPT name args -> T.Data name <$> mapM toT args
106− RecordPT t fs -> do fs' <- mapM (\(x,pt) -> (,) x <$> toT pt) fs
107− ext <- maybe (return T.EmptyRecord) toT t
108− return (T.Record (T.record fs') ext)
109− VarPT x@(c:_)
110− | not (isLower c) -> return $ T.Data x []
111− | otherwise -> T.Var <$> case lookup x tvarDict of
112− Just v -> Right v
113− Nothing -> Left (msg x)
114−
115−
116−toDatatype name args tcs = Datatype name [1..n] <$> mapM toC tcs
117− where n = length args
118− toType = toTypeWith name (zip args (map (:[]) ['a'..]))
119− toC (name,pt) = (,) name <$> mapM toType pt
120−
121−
122−toForeignType (LambdaPT t1 t2) =
123− fail $ "Elm's JavaScript event interface does not yet handle functions. " ++
124− "Only simple values can be imported and exported in this release."
125−
126−toForeignType (ADTPT "JSArray" args) =
127− T.Data "JSArray" <$> mapM toForeignType args
128−
129−toForeignType (ADTPT name _) =
130− Left $ "'" ++ name ++ "' is not an exportable type " ++
131− "constructor. Only 'JSArray' is exportable."
132−
133−toForeignType (VarPT x@(c:_))
134− | x `elem` jsTypes = Right (T.Data x [])
135− | isLower c =
136− Left $ "All exported types must be concrete types." ++ msg
137− | otherwise =
138− Left $ "'" ++ x ++ "' is not an exportable type." ++ msg
139− where
140− msg = " The following types are exportable: " ++ intercalate ", " jsTypes
141− jsTypes = ["JSString","JSNumber","JSDomNode","JSBool","JSObject"]
142−--}