git.iko.soy/elk
on master help sign in
Chenge representation of Expr, add ports representation
bd4d76eEvan Czaplicki
compiler/SourceSyntax/Declaration.hs+43−14
compare with master
unifiedsplit
@@ -3,15 +3,15 @@ module SourceSyntax.Declaration where
3
3
4import Data.Binary
4import Data.Binary
5import qualified SourceSyntax.Expression as Expr
5import qualified SourceSyntax.Expression as Expr
6−import SourceSyntax.Type
6+import qualified SourceSyntax.Type as T
7import SourceSyntax.PrettyPrint
7import SourceSyntax.PrettyPrint
8import Text.PrettyPrint as P
8import Text.PrettyPrint as P
9
9
10−data Declaration tipe var
10+data Declaration' port def
11− = Definition (Expr.Def tipe var)
11+ = Definition def
12− | Datatype String [String] [(String,[Type])] [Derivation]
12+ | Datatype String [String] [(String,[T.Type])] [Derivation]
13− | TypeAlias String [String] Type [Derivation]
13+ | TypeAlias String [String] T.Type [Derivation]
14− | Port String Type (Maybe (Expr.LExpr tipe var))
14+ | Port port
15 | Fixity Assoc Int String
15 | Fixity Assoc Int String
16 deriving (Eq, Show)
16 deriving (Eq, Show)
17
17
@@ -21,6 +21,19 @@ data Assoc = L | N | R
21data Derivation = Json | JS | Binary | New
21data Derivation = Json | JS | Binary | New
22 deriving (Eq, Show)
22 deriving (Eq, Show)
23
23
24+data ParsePort
25+ = PortAnnotation String T.Type
26+ | SendDefinition String Expr.LParseExpr
27+ | RecvDefinition String Expr.LParseExpr
28+
29+data Port
30+ = Send String Expr.LExpr T.Type
31+ | Recv String Expr.LExpr T.Type
32+ deriving (Eq,Show)
33+
34+type ParseDeclaration = Declaration' ParsePort Expr.ParseDef
35+type Declaration = Declaration' Port Expr.Def
36+
24instance Binary Derivation where
37instance Binary Derivation where
25 get = do n <- getWord8
38 get = do n <- getWord8
26 return $ case n of
39 return $ case n of
@@ -45,7 +58,7 @@ instance Show Assoc where
45 N -> "non"
58 N -> "non"
46 R -> "right"
59 R -> "right"
47
60
48−instance Pretty (Declaration t v) where
61+instance (Pretty port, Pretty def) => Pretty (Declaration' port def) where
49 pretty decl =
62 pretty decl =
50 case decl of
63 case decl of
51 Definition def -> pretty def
64 Definition def -> pretty def
@@ -56,7 +69,7 @@ instance Pretty (Declaration t v) where
56 where
69 where
57 join c ctor = P.text c <+> prettyCtor ctor
70 join c ctor = P.text c <+> prettyCtor ctor
58 prettyCtor (name, tipes) =
71 prettyCtor (name, tipes) =
59− P.hang (P.text name) 2 (P.sep (map prettyParens tipes))
72+ P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
60
73
61 TypeAlias name tvars tipe deriveables ->
74 TypeAlias name tvars tipe deriveables ->
62 alias <+> prettyDeriving deriveables
75 alias <+> prettyDeriving deriveables
@@ -64,11 +77,7 @@ instance Pretty (Declaration t v) where
64 name' = P.text name <+> P.hsep (map P.text tvars)
77 name' = P.text name <+> P.hsep (map P.text tvars)
65 alias = P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
78 alias = P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
66
79
67− Port name tipe maybeExpr ->
80+ Port port -> pretty port
68− let port = P.text "port" <+> P.text name in
69− P.vcat [ port <+> P.colon <+> pretty tipe
70− , maybe P.empty (\expr -> port <+> P.equals <+> pretty expr) maybeExpr
71− ]
72
81
73 Fixity assoc prec op -> P.text "infix" <> assoc' <+> P.int prec <+> P.text op
82 Fixity assoc prec op -> P.text "infix" <> assoc' <+> P.int prec <+> P.text op
74 where
83 where
@@ -77,10 +86,30 @@ instance Pretty (Declaration t v) where
77 N -> P.empty
86 N -> P.empty
78 R -> P.text "r"
87 R -> P.text "r"
79
88
89+instance Pretty ParsePort where
90+ pretty port =
91+ case port of
92+ PortAnnotation name tipe -> prettyPort name ":" tipe
93+ SendDefinition name expr -> prettyPort name "<-" expr
94+ RecvDefinition name expr -> prettyPort name "->" expr
95+
96+instance Pretty Port where
97+ pretty port =
98+ case port of
99+ Send name expr tipe -> mkPort "<-" name expr tipe
100+ Recv name expr tipe -> mkPort "->" name expr tipe
101+ where
102+ mkPort arrow name expr tipe =
103+ P.vcat [ prettyPort name ":" tipe
104+ , prettyPort name arrow expr ]
105+
106+prettyPort :: (Pretty a) => String -> String -> a -> Doc
107+prettyPort name op e = P.text "port" <+> P.text name <+> P.text op <+> pretty e
108+
80prettyDeriving :: [Derivation] -> Doc
109prettyDeriving :: [Derivation] -> Doc
81prettyDeriving deriveables =
110prettyDeriving deriveables =
82 case deriveables of
111 case deriveables of
83 [] -> P.empty
112 [] -> P.empty
84 [d] -> P.text "deriving" <+> P.text (show d)
113 [d] -> P.text "deriving" <+> P.text (show d)
85 ds -> P.text "deriving" <+>
114 ds -> P.text "deriving" <+>
86− P.parens (P.hsep $ P.punctuate P.comma $ map (P.text . show) ds)
115+ P.parens (P.hsep $ P.punctuate P.comma $ map (P.text . show) ds)
compiler/SourceSyntax/Expression.hs+68−27
@@ -9,32 +9,64 @@ import qualified SourceSyntax.Pattern as Pattern
9import qualified SourceSyntax.Type as Type
9import qualified SourceSyntax.Type as Type
10import qualified SourceSyntax.Literal as Literal
10import qualified SourceSyntax.Literal as Literal
11
11
12+{-| This is a located expression. -}
12−type LExpr tipe var = Location.Located (Expr tipe var)
13+type LExpr' def = Location.Located (Expr' def)
13−data Expr t v
14+
15+{-| This is a fully general expression. The compilation process will enrich
16+this data structure with additional information after the initial parse.
17+The type holes let us reflect these structural changes in the types.
18+
19+ def: Parsing allows two kinds of definitions (type annotations or definitions),
20+ but later checks will see that they are well formed and combine them.
21+
22+ t: for adding type information, currently unused
23+
24+ v: for enriching variables with information like provenonce, currently unused
25+
26+Please don't get on my case to take the unused ones out. I have considered it.
27+It's a huge pain to add and remove, it will get used eventually, and it's not
28+hurting anything as it is.
29+-}
30+data Expr' def
14 = Literal Literal.Literal
31 = Literal Literal.Literal
15 | Var String
32 | Var String
16− | Range (LExpr t v) (LExpr t v)
33+ | Range (LExpr' def) (LExpr' def)
17− | ExplicitList [LExpr t v]
34+ | ExplicitList [LExpr' def]
18− | Binop String (LExpr t v) (LExpr t v)
35+ | Binop String (LExpr' def) (LExpr' def)
19− | Lambda Pattern.Pattern (LExpr t v)
36+ | Lambda Pattern.Pattern (LExpr' def)
20− | App (LExpr t v) (LExpr t v)
37+ | App (LExpr' def) (LExpr' def)
21− | MultiIf [(LExpr t v,LExpr t v)]
38+ | MultiIf [(LExpr' def,LExpr' def)]
22− | Let [Def t v] (LExpr t v)
39+ | Let [def] (LExpr' def)
23− | Case (LExpr t v) [(Pattern.Pattern, LExpr t v)]
40+ | Case (LExpr' def) [(Pattern.Pattern, LExpr' def)]
24− | Data String [LExpr t v]
41+ | Data String [LExpr' def]
25− | Access (LExpr t v) String
42+ | Access (LExpr' def) String
26− | Remove (LExpr t v) String
43+ | Remove (LExpr' def) String
27− | Insert (LExpr t v) String (LExpr t v)
44+ | Insert (LExpr' def) String (LExpr' def)
28− | Modify (LExpr t v) [(String, LExpr t v)]
45+ | Modify (LExpr' def) [(String, LExpr' def)]
29− | Record [(String, LExpr t v)]
46+ | Record [(String, LExpr' def)]
30− | Markdown String String [LExpr t v]
47+ | Markdown String String [LExpr' def]
31 deriving (Eq)
48 deriving (Eq)
32
49
33−data Def tipe var
50+type ParseExpr = Expr' ParseDef
51+type LParseExpr = LExpr' ParseDef
52+type LExpr = LExpr' Def
53+type Expr = Expr' Def
54+
55+{-| Style of definitions as they are parsed. Users specify them
56+separately, and other checks will make sure they can be combined.
57+-}
58+data ParseDef
34− = Def Pattern.Pattern (LExpr tipe var)
59+ = Def Pattern.Pattern LParseExpr
35 | TypeAnnotation String Type.Type
60 | TypeAnnotation String Type.Type
36 deriving (Eq, Show)
61 deriving (Eq, Show)
37
62
63+{-| After checking that type annotations and definitions are all
64+valid, they can be combined.
65+-}
66+data Def
67+ = Definition Pattern.Pattern (LExpr' Def) (Maybe Type.Type)
68+ deriving (Eq, Show)
69+
38tuple es = Data ("_Tuple" ++ show (length es)) es
70tuple es = Data ("_Tuple" ++ show (length es)) es
39
71
40delist (Location.L _ (Data "::" [h,t])) = h : delist t
72delist (Location.L _ (Data "::" [h,t])) = h : delist t
@@ -45,10 +77,10 @@ saveEnvName = "_save_the_environment!!!"
45dummyLet defs =
77dummyLet defs =
46 Location.none $ Let defs (Location.none $ Var saveEnvName)
78 Location.none $ Let defs (Location.none $ Var saveEnvName)
47
79
48−instance Show (Expr t v) where
80+instance Pretty def => Show (Expr' def) where
49 show = render . pretty
81 show = render . pretty
50
82
51−instance Pretty (Expr t v) where
83+instance Pretty def => Pretty (Expr' def) where
52 pretty expr =
84 pretty expr =
53 case expr of
85 case expr of
54 Literal lit -> pretty lit
86 Literal lit -> pretty lit
@@ -80,9 +112,9 @@ instance Pretty (Expr t v) where
80 Access e x -> prettyParens e <> P.text "." <> variable x
112 Access e x -> prettyParens e <> P.text "." <> variable x
81 Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
113 Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
82 Insert (Location.L _ (Remove e y)) x v ->
114 Insert (Location.L _ (Remove e y)) x v ->
83− P.braces (pretty e <+> P.text "-" <+> variable y <+> P.text "|" <+> variable x <+> P.text "=" <+> pretty v)
115+ P.braces (pretty e <+> P.text "-" <+> variable y <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
84 Insert e x v ->
116 Insert e x v ->
85− P.braces (pretty e <+> P.text "|" <+> variable x <+> P.text "=" <+> pretty v)
117+ P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
86
118
87 Modify e fs ->
119 Modify e fs ->
88 P.braces $ P.hang (pretty e <+> P.text "|")
120 P.braces $ P.hang (pretty e <+> P.text "|")
@@ -94,17 +126,26 @@ instance Pretty (Expr t v) where
94 Record fs ->
126 Record fs ->
95 P.braces $ P.nest 2 (commaSep $ map field fs)
127 P.braces $ P.nest 2 (commaSep $ map field fs)
96 where
128 where
97− field (x,e) = variable x <+> P.text "=" <+> pretty e
129+ field (x,e) = variable x <+> P.equals <+> pretty e
98
130
99 Markdown _ _ _ -> P.text "[markdown| ... |]"
131 Markdown _ _ _ -> P.text "[markdown| ... |]"
100
132
101−instance Pretty (Def t v) where
133+instance Pretty ParseDef where
102 pretty def =
134 pretty def =
103 case def of
135 case def of
104 TypeAnnotation name tipe ->
136 TypeAnnotation name tipe ->
105− variable name <+> P.text ":" <+> pretty tipe
137+ variable name <+> P.colon <+> pretty tipe
106 Def pattern expr ->
138 Def pattern expr ->
107− pretty pattern <+> P.text "=" <+> pretty expr
139+ pretty pattern <+> P.equals <+> pretty expr
140+
141+instance Pretty Def where
142+ pretty (Definition pattern expr maybeTipe) =
143+ P.vcat [ annotation, definition ]
144+ where
145+ definition = pretty pattern <+> P.equals <+> pretty expr
146+ annotation = case maybeTipe of
147+ Nothing -> P.empty
148+ Just tipe -> pretty pattern <+> P.colon <+> pretty tipe
108
149
109collectApps lexpr@(Location.L _ expr) =
150collectApps lexpr@(Location.L _ expr) =
110 case expr of
151 case expr of
compiler/SourceSyntax/Module.hs+16−14
@@ -13,8 +13,8 @@ import System.FilePath (joinPath)
13
13
14import qualified Elm.Internal.Version as Version
14import qualified Elm.Internal.Version as Version
15
15
16−data Module tipe var =
16+data Module def =
17− Module [String] Exports Imports [Declaration tipe var]
17+ Module [String] Exports Imports [def]
18 deriving (Show)
18 deriving (Show)
19
19
20type Exports = [String]
20type Exports = [String]
@@ -38,18 +38,20 @@ instance Binary ImportMethod where
38 2 -> Hiding <$> get
38 2 -> Hiding <$> get
39 _ -> error "Error reading valid ImportMethod type from serialized string"
39 _ -> error "Error reading valid ImportMethod type from serialized string"
40
40
41−data MetadataModule t v = MetadataModule {
41+data MetadataModule =
42+ MetadataModule
42− names :: [String],
43+ { names :: [String]
43− path :: FilePath,
44+ , path :: FilePath
44− exports :: [String],
45+ , exports :: [String]
45− imports :: [(String, ImportMethod)],
46+ , imports :: [(String, ImportMethod)]
46− program :: LExpr t v,
47+ , program :: LExpr
47− types :: Map.Map String Type,
48+ , types :: Map.Map String Type
48− fixities :: [(Assoc, Int, String)],
49+ , fixities :: [(Assoc, Int, String)]
49− aliases :: [Alias],
50+ , aliases :: [Alias]
50− datatypes :: [ADT],
51+ , datatypes :: [ADT]
51− ports :: [(String, Type, Maybe (LExpr t v))]
52+ , sendPorts :: [(String, LExpr, Type)]
53+ , recvPorts :: [(String, LExpr, Type)]
52−} deriving Show
54+ } deriving Show
53
55
54type Interfaces = Map.Map String ModuleInterface
56type Interfaces = Map.Map String ModuleInterface
55type ADT = (String, [String], [(String,[Type])], [Derivation])
57type ADT = (String, [String], [(String,[Type])], [Derivation])