on master help sign in
Chenge representation of Expr, add ports representation

Get rid of the unused t and v type variables. Add the def type variable, which models the fact that type annotations and definitions start separate, but need to be combined before most stuff goes down. Ports have the same structure as definitions in that annotations and definitions are separate at the source level and need to be combined. The same technique used in Expr is now used in Decl as well.

commitbd4d76ecaea66b50730c2499b2870b08dc495ce3 authorEvan Czaplicki <info@elm-lang.org> dateThu 2 Jan 2014, 23:18 (13 years ago) parent600e65c
3 files changed+127−55
compiler/SourceSyntax/Declaration.hs+43−14 compiler/SourceSyntax/Expression.hs+68−27 compiler/SourceSyntax/Module.hs+16−14
compiler/SourceSyntax/Declaration.hs+43−14
@@ -3,15 +3,15 @@ module SourceSyntax.Declaration where
33
44import Data.Binary
55import qualified SourceSyntax.Expression as Expr
6−import SourceSyntax.Type
6+import qualified SourceSyntax.Type as T
77import SourceSyntax.PrettyPrint
88import Text.PrettyPrint as P
99
10−data Declaration tipe var
11− = Definition (Expr.Def tipe var)
12− | Datatype String [String] [(String,[Type])] [Derivation]
13− | TypeAlias String [String] Type [Derivation]
14− | Port String Type (Maybe (Expr.LExpr tipe var))
10+data Declaration' port def
11+ = Definition def
12+ | Datatype String [String] [(String,[T.Type])] [Derivation]
13+ | TypeAlias String [String] T.Type [Derivation]
14+ | Port port
1515 | Fixity Assoc Int String
1616 deriving (Eq, Show)
1717
@@ -21,6 +21,19 @@ data Assoc = L | N | R
2121data Derivation = Json | JS | Binary | New
2222 deriving (Eq, Show)
2323
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+
2437instance Binary Derivation where
2538 get = do n <- getWord8
2639 return $ case n of
@@ -45,7 +58,7 @@ instance Show Assoc where
4558 N -> "non"
4659 R -> "right"
4760
48−instance Pretty (Declaration t v) where
61+instance (Pretty port, Pretty def) => Pretty (Declaration' port def) where
4962 pretty decl =
5063 case decl of
5164 Definition def -> pretty def
@@ -56,7 +69,7 @@ instance Pretty (Declaration t v) where
5669 where
5770 join c ctor = P.text c <+> prettyCtor ctor
5871 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))
6073
6174 TypeAlias name tvars tipe deriveables ->
6275 alias <+> prettyDeriving deriveables
@@ -64,11 +77,7 @@ instance Pretty (Declaration t v) where
6477 name' = P.text name <+> P.hsep (map P.text tvars)
6578 alias = P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
6679
67− Port name tipe maybeExpr ->
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− ]
80+ Port port -> pretty port
7281
7382 Fixity assoc prec op -> P.text "infix" <> assoc' <+> P.int prec <+> P.text op
7483 where
@@ -77,10 +86,30 @@ instance Pretty (Declaration t v) where
7786 N -> P.empty
7887 R -> P.text "r"
7988
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+
80109prettyDeriving :: [Derivation] -> Doc
81110prettyDeriving deriveables =
82111 case deriveables of
83112 [] -> P.empty
84113 [d] -> P.text "deriving" <+> P.text (show d)
85114 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
99import qualified SourceSyntax.Type as Type
1010import qualified SourceSyntax.Literal as Literal
1111
12−type LExpr tipe var = Location.Located (Expr tipe var)
13−data Expr t v
12+{-| This is a located expression. -}
13+type LExpr' def = Location.Located (Expr' def)
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
1431 = Literal Literal.Literal
1532 | Var String
16− | Range (LExpr t v) (LExpr t v)
17− | ExplicitList [LExpr t v]
18− | Binop String (LExpr t v) (LExpr t v)
19− | Lambda Pattern.Pattern (LExpr t v)
20− | App (LExpr t v) (LExpr t v)
21− | MultiIf [(LExpr t v,LExpr t v)]
22− | Let [Def t v] (LExpr t v)
23− | Case (LExpr t v) [(Pattern.Pattern, LExpr t v)]
24− | Data String [LExpr t v]
25− | Access (LExpr t v) String
26− | Remove (LExpr t v) String
27− | Insert (LExpr t v) String (LExpr t v)
28− | Modify (LExpr t v) [(String, LExpr t v)]
29− | Record [(String, LExpr t v)]
30− | Markdown String String [LExpr t v]
33+ | Range (LExpr' def) (LExpr' def)
34+ | ExplicitList [LExpr' def]
35+ | Binop String (LExpr' def) (LExpr' def)
36+ | Lambda Pattern.Pattern (LExpr' def)
37+ | App (LExpr' def) (LExpr' def)
38+ | MultiIf [(LExpr' def,LExpr' def)]
39+ | Let [def] (LExpr' def)
40+ | Case (LExpr' def) [(Pattern.Pattern, LExpr' def)]
41+ | Data String [LExpr' def]
42+ | Access (LExpr' def) String
43+ | Remove (LExpr' def) String
44+ | Insert (LExpr' def) String (LExpr' def)
45+ | Modify (LExpr' def) [(String, LExpr' def)]
46+ | Record [(String, LExpr' def)]
47+ | Markdown String String [LExpr' def]
3148 deriving (Eq)
3249
33−data Def tipe var
34− = Def Pattern.Pattern (LExpr 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
59+ = Def Pattern.Pattern LParseExpr
3560 | TypeAnnotation String Type.Type
3661 deriving (Eq, Show)
3762
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+
3870tuple es = Data ("_Tuple" ++ show (length es)) es
3971
4072delist (Location.L _ (Data "::" [h,t])) = h : delist t
@@ -45,10 +77,10 @@ saveEnvName = "_save_the_environment!!!"
4577dummyLet defs =
4678 Location.none $ Let defs (Location.none $ Var saveEnvName)
4779
48−instance Show (Expr t v) where
80+instance Pretty def => Show (Expr' def) where
4981 show = render . pretty
5082
51−instance Pretty (Expr t v) where
83+instance Pretty def => Pretty (Expr' def) where
5284 pretty expr =
5385 case expr of
5486 Literal lit -> pretty lit
@@ -80,9 +112,9 @@ instance Pretty (Expr t v) where
80112 Access e x -> prettyParens e <> P.text "." <> variable x
81113 Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
82114 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)
84116 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)
86118
87119 Modify e fs ->
88120 P.braces $ P.hang (pretty e <+> P.text "|")
@@ -94,17 +126,26 @@ instance Pretty (Expr t v) where
94126 Record fs ->
95127 P.braces $ P.nest 2 (commaSep $ map field fs)
96128 where
97− field (x,e) = variable x <+> P.text "=" <+> pretty e
129+ field (x,e) = variable x <+> P.equals <+> pretty e
98130
99131 Markdown _ _ _ -> P.text "[markdown| ... |]"
100132
101−instance Pretty (Def t v) where
133+instance Pretty ParseDef where
102134 pretty def =
103135 case def of
104136 TypeAnnotation name tipe ->
105− variable name <+> P.text ":" <+> pretty tipe
137+ variable name <+> P.colon <+> pretty tipe
106138 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
108149
109150collectApps lexpr@(Location.L _ expr) =
110151 case expr of
compiler/SourceSyntax/Module.hs+16−14
@@ -13,8 +13,8 @@ import System.FilePath (joinPath)
1313
1414import qualified Elm.Internal.Version as Version
1515
16−data Module tipe var =
17− Module [String] Exports Imports [Declaration tipe var]
16+data Module def =
17+ Module [String] Exports Imports [def]
1818 deriving (Show)
1919
2020type Exports = [String]
@@ -38,18 +38,20 @@ instance Binary ImportMethod where
3838 2 -> Hiding <$> get
3939 _ -> error "Error reading valid ImportMethod type from serialized string"
4040
41−data MetadataModule t v = MetadataModule {
42− names :: [String],
43− path :: FilePath,
44− exports :: [String],
45− imports :: [(String, ImportMethod)],
46− program :: LExpr t v,
47− types :: Map.Map String Type,
48− fixities :: [(Assoc, Int, String)],
49− aliases :: [Alias],
50− datatypes :: [ADT],
51− ports :: [(String, Type, Maybe (LExpr t v))]
52−} deriving Show
41+data MetadataModule =
42+ MetadataModule
43+ { names :: [String]
44+ , path :: FilePath
45+ , exports :: [String]
46+ , imports :: [(String, ImportMethod)]
47+ , program :: LExpr
48+ , types :: Map.Map String Type
49+ , fixities :: [(Assoc, Int, String)]
50+ , aliases :: [Alias]
51+ , datatypes :: [ADT]
52+ , sendPorts :: [(String, LExpr, Type)]
53+ , recvPorts :: [(String, LExpr, Type)]
54+ } deriving Show
5355
5456type Interfaces = Map.Map String ModuleInterface
5557type ADT = (String, [String], [(String,[Type])], [Derivation])