git.iko.soy/elk
on master help sign in
Begin making canonical variables explicit in AST
368e33eEvan Czaplicki
compiler/AST/Expression/Canonical.hsnew file+30
compare with master
unifiedsplit
@@ -0,0 +1,30 @@
1+{-# OPTIONS_GHC -Wall #-}
2+
3+module AST.Expression.Canonical where
4+
5+import SourceSyntax.PrettyPrint
6+import Text.PrettyPrint as P
7+import qualified AST.Expression.General as General
8+import AST.Type (Type)
9+import qualified AST.Variable as Var
10+import qualified SourceSyntax.Annotation as Annotation
11+import qualified SourceSyntax.Pattern as Pattern
12+
13+
14+{-| Canonicalized expressions. All variables are fully resolved to the module
15+they came from.
16+-}
17+type Expr = General.Expr Annotation.Region Def Var.Canonical
18+type Expr' = General.Expr' Annotation.Region Def Var.Canonical
19+
20+data Def = Definition (Pattern.Pattern Var.Canonical) Expr (Maybe (Type Var.Canonical))
21+ deriving (Show)
22+
23+instance Pretty Def where
24+ pretty (Definition pattern expr maybeTipe) =
25+ P.vcat [ annotation, definition ]
26+ where
27+ definition = pretty pattern <+> P.equals <+> pretty expr
28+ annotation = case maybeTipe of
29+ Nothing -> P.empty
30+ Just tipe -> pretty pattern <+> P.colon <+> pretty tipe
compiler/AST/Expression/General.hsnew file+191
@@ -0,0 +1,191 @@
1+{-# OPTIONS_GHC -Wall #-}
2+
3+{-| The Abstract Syntax Tree (AST) for expressions comes in a couple formats.
4+The first is the fully general version and is labeled with a prime (Expr').
5+The others are specialized versions of the AST that represent specific phases
6+of the compilation process. I expect there to be more phases as we begin to
7+enrich the AST with more information.
8+-}
9+module AST.Expression.General where
10+
11+import SourceSyntax.PrettyPrint
12+import Text.PrettyPrint as P
13+import AST.Type (Type)
14+import qualified AST.Variable as Var
15+import qualified SourceSyntax.Helpers as Help
16+import qualified SourceSyntax.Annotation as Annotation
17+import qualified SourceSyntax.Pattern as Pattern
18+import qualified SourceSyntax.Literal as Literal
19+
20+---- GENERAL AST ----
21+
22+{-| This is a fully general Abstract Syntax Tree (AST) for expressions. It has
23+"type holes" that allow us to enrich the AST with additional information as we
24+move through the compilation process. The type holes are used to represent:
25+
26+ ann: Annotations for arbitrary expressions. Allows you to add information
27+ to the AST like position in source code or inferred types.
28+
29+ def: Definition style. The source syntax separates type annotations and
30+ definitions, but after parsing we check that they are well formed and
31+ collapse them.
32+
33+ var: Representation of variables. Starts as strings, but is later enriched
34+ with information about what module a variable came from.
35+
36+-}
37+type Expr annotation definition variable =
38+ Annotation.Annotated annotation (Expr' annotation definition variable)
39+
40+data Expr' ann def var
41+ = Literal Literal.Literal
42+ | Var var
43+ | Range (Expr ann def var) (Expr ann def var)
44+ | ExplicitList [Expr ann def var]
45+ | Binop var (Expr ann def var) (Expr ann def var)
46+ | Lambda (Pattern.Pattern var) (Expr ann def var)
47+ | App (Expr ann def var) (Expr ann def var)
48+ | MultiIf [(Expr ann def var,Expr ann def var)]
49+ | Let [def] (Expr ann def var)
50+ | Case (Expr ann def var) [(Pattern.Pattern var, Expr ann def var)]
51+ | Data String [Expr ann def var]
52+ | Access (Expr ann def var) String
53+ | Remove (Expr ann def var) String
54+ | Insert (Expr ann def var) String (Expr ann def var)
55+ | Modify (Expr ann def var) [(String, Expr ann def var)]
56+ | Record [(String, Expr ann def var)]
57+ | Markdown String String [Expr ann def var]
58+ -- for type checking and code gen only
59+ | PortIn String (Type var)
60+ | PortOut String (Type var) (Expr ann def var)
61+ deriving (Show)
62+
63+
64+---- UTILITIES ----
65+
66+rawVar :: String -> Expr' ann def Var.Raw
67+rawVar x = Var (Var.Raw x)
68+
69+localVar :: String -> Expr' ann def Var.Canonical
70+localVar x = Var (Var.Canonical Var.Local x)
71+
72+tuple :: [Expr ann def var] -> Expr' ann def var
73+tuple es = Data ("_Tuple" ++ show (length es)) es
74+
75+delist :: Expr ann def var -> [Expr ann def var]
76+delist (Annotation.A _ (Data "::" [h,t])) = h : delist t
77+delist _ = []
78+
79+saveEnvName :: String
80+saveEnvName = "_save_the_environment!!!"
81+
82+dummyLet :: (Pretty def) => [def] -> Expr Annotation.Region def Var.Canonical
83+dummyLet defs =
84+ Annotation.none $ Let defs (Annotation.none $ localVar saveEnvName)
85+
86+instance (Pretty def, Pretty var, Var.ToString var) => Pretty (Expr' ann def var) where
87+ pretty expr =
88+ case expr of
89+ Literal lit -> pretty lit
90+
91+ Var x -> pretty x
92+
93+ Range e1 e2 -> P.brackets (pretty e1 <> P.text ".." <> pretty e2)
94+
95+ ExplicitList es -> P.brackets (commaCat (map pretty es))
96+
97+ Binop op (Annotation.A _ (Literal (Literal.IntNum 0))) e
98+ | Var.toString op == "-" ->
99+ P.text "-" <> prettyParens e
100+
101+ Binop op e1 e2 -> P.sep [ prettyParens e1 <+> P.text op'', prettyParens e2 ]
102+ where
103+ op' = Var.toString op
104+ op'' = if Help.isOp op' then op' else "`" ++ op' ++ "`"
105+
106+ Lambda p e -> P.text "\\" <> args <+> P.text "->" <+> pretty body
107+ where
108+ (ps,body) = collectLambdas (Annotation.A undefined $ Lambda p e)
109+ args = P.sep (map Pattern.prettyParens ps)
110+
111+ App _ _ -> P.hang func 2 (P.sep args)
112+ where
113+ func:args = map prettyParens (collectApps (Annotation.A undefined expr))
114+
115+ MultiIf branches -> P.text "if" $$ nest 3 (vcat $ map iff branches)
116+ where
117+ iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
118+
119+ Let defs e ->
120+ P.sep [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
121+ , P.text "in" <+> pretty e ]
122+
123+ Case e pats ->
124+ P.hang pexpr 2 (P.vcat (map pretty' pats))
125+ where
126+ pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
127+ pretty' (p,b) = pretty p <+> P.text "->" <+> pretty b
128+
129+ Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
130+ Data "[]" [] -> P.text "[]"
131+ Data name es
132+ | Help.isTuple name -> P.parens (commaCat (map pretty es))
133+ | otherwise -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
134+
135+ Access e x -> prettyParens e <> P.text "." <> variable x
136+
137+ Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
138+
139+ Insert (Annotation.A _ (Remove e y)) x v ->
140+ P.braces $ P.hsep [ pretty e, P.text "-", variable y, P.text "|"
141+ , variable x, P.equals, pretty v ]
142+
143+ Insert e x v ->
144+ P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
145+
146+ Modify e fs ->
147+ P.braces $ P.hang (pretty e <+> P.text "|")
148+ 4
149+ (commaSep $ map field fs)
150+ where
151+ field (k,v) = variable k <+> P.text "<-" <+> pretty v
152+
153+ Record fs ->
154+ P.braces $ P.nest 2 (commaSep $ map field fs)
155+ where
156+ field (x,e) = variable x <+> P.equals <+> pretty e
157+
158+ Markdown _ _ _ -> P.text "[markdown| ... |]"
159+
160+ PortIn name _ -> P.text $ "<port:" ++ name ++ ">"
161+
162+ PortOut _ _ signal -> pretty signal
163+
164+collectApps :: Expr ann def var -> [Expr ann def var]
165+collectApps annExpr@(Annotation.A _ expr) =
166+ case expr of
167+ App a b -> collectApps a ++ [b]
168+ _ -> [annExpr]
169+
170+collectLambdas :: Expr ann def var -> ([Pattern.Pattern var], Expr ann def var)
171+collectLambdas lexpr@(Annotation.A _ expr) =
172+ case expr of
173+ Lambda pattern body ->
174+ let (ps, body') = collectLambdas body
175+ in (pattern : ps, body')
176+
177+ _ -> ([], lexpr)
178+
179+prettyParens :: (Pretty def, Pretty var, Var.ToString var) => Expr ann def var -> Doc
180+prettyParens (Annotation.A _ expr) = parensIf needed (pretty expr)
181+ where
182+ needed =
183+ case expr of
184+ Binop _ _ _ -> True
185+ Lambda _ _ -> True
186+ App _ _ -> True
187+ MultiIf _ -> True
188+ Let _ _ -> True
189+ Case _ _ -> True
190+ Data name (_:_) -> name /= "::"
191+ _ -> False
compiler/AST/Expression/Source.hsnew file+32
@@ -0,0 +1,32 @@
1+{-# OPTIONS_GHC -Wall #-}
2+
3+module AST.Expression.Source where
4+
5+import SourceSyntax.PrettyPrint
6+import Text.PrettyPrint as P
7+import qualified AST.Expression.General as General
8+import AST.Type (Type)
9+import qualified AST.Variable as Var
10+import qualified SourceSyntax.Annotation as Annotation
11+import qualified SourceSyntax.Pattern as Pattern
12+
13+
14+{-| Expressions created by the parser. These use a split representation of type
15+annotations and definitions, which is how they appear in source code and how
16+they are parsed.
17+-}
18+type Expr = General.Expr Annotation.Region Def Var.Raw
19+type Expr' = General.Expr' Annotation.Region Def Var.Raw
20+
21+data Def
22+ = Definition (Pattern.Pattern Var.Raw) Expr
23+ | TypeAnnotation String (Type Var.Raw)
24+ deriving (Show)
25+
26+instance Pretty Def where
27+ pretty def =
28+ case def of
29+ TypeAnnotation name tipe ->
30+ variable name <+> P.colon <+> pretty tipe
31+ Definition pattern expr ->
32+ pretty pattern <+> P.equals <+> pretty expr
compiler/AST/Expression/Valid.hsnew file+31
@@ -0,0 +1,31 @@
1+{-# OPTIONS_GHC -Wall #-}
2+
3+module AST.Expression.Valid where
4+
5+import SourceSyntax.PrettyPrint
6+import Text.PrettyPrint as P
7+import qualified AST.Expression.General as General
8+import AST.Type (Type)
9+import qualified AST.Variable as Var
10+import qualified SourceSyntax.Annotation as Annotation
11+import qualified SourceSyntax.Pattern as Pattern
12+
13+
14+{-| "Normal" expressions. When the compiler checks that type annotations and
15+ports are all paired with definitions in the appropriate order, it collapses
16+them into a Def that is easier to work with in later phases of compilation.
17+-}
18+type Expr = General.Expr Annotation.Region Def Var.Raw
19+type Expr' = General.Expr' Annotation.Region Def Var.Raw
20+
21+data Def = Definition (Pattern.Pattern Var.Raw) Expr (Maybe (Type Var.Raw))
22+ deriving (Show)
23+
24+instance Pretty Def where
25+ pretty (Definition pattern expr maybeTipe) =
26+ P.vcat [ annotation, definition ]
27+ where
28+ definition = pretty pattern <+> P.equals <+> pretty expr
29+ annotation = case maybeTipe of
30+ Nothing -> P.empty
31+ Just tipe -> pretty pattern <+> P.colon <+> pretty tipe
compiler/AST/Module.hsnew file+131
@@ -0,0 +1,131 @@
1+{-# OPTIONS_GHC -W #-}
2+module AST.Module where
3+
4+import Data.Binary
5+import qualified Data.Map as Map
6+import Control.Applicative ((<$>),(<*>))
7+
8+import qualified AST.Expression.Canonical as Canonical
9+import qualified AST.Type as Type
10+import qualified AST.Variable as Var
11+import qualified SourceSyntax.Declaration as Decl
12+
13+import qualified Elm.Internal.Version as Version
14+
15+data Module exs body = Module
16+ { names :: [String]
17+ , path :: FilePath
18+ , exports :: exs
19+ , imports :: [(String, ImportMethod)]
20+ , body :: body
21+ }
22+
23+data CanonicalBody = CanonicalBody
24+ { program :: Canonical.Expr
25+ , types :: Types
26+ , fixities :: [(Decl.Assoc, Int, String)]
27+ , aliases :: [Alias]
28+ , datatypes :: [ADT]
29+ , ports :: [String]
30+ }
31+
32+type SourceModule = Module (Var.Listing Var.Value) [Decl.SourceDecl]
33+type ValidModule = Module (Var.Listing Var.Value) [Decl.ValidDecl]
34+type CanonicalModule = Module [Var.Value] CanonicalBody
35+
36+type Interfaces = Map.Map String Interface
37+
38+type Types = Map.Map String (Type.Type Var.Canonical)
39+type ADT = ( String, [String], [(String, [Type.Type Var.Canonical])] )
40+type Alias = (String, [String], Type.Type Var.Canonical )
41+
42+data Interface = Interface
43+ { iVersion :: Version.Version
44+ , iTypes :: Types
45+ , iImports :: [(String, ImportMethod)]
46+ , iAdts :: [ADT]
47+ , iAliases :: [Alias]
48+ , iFixities :: [(Decl.Assoc, Int, String)]
49+ , iPorts :: [String]
50+ }
51+
52+toInterface :: CanonicalModule -> Interface
53+toInterface modul =
54+ let body' = body modul in
55+ Interface
56+ { iVersion = Version.elmVersion
57+ , iTypes = types body'
58+ , iImports = imports modul
59+ , iAdts = datatypes body'
60+ , iAliases = aliases body'
61+ , iFixities = fixities body'
62+ , iPorts = ports body'
63+ }
64+
65+instance Binary Interface where
66+ get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get
67+ put modul = do
68+ put (iVersion modul)
69+ put (iTypes modul)
70+ put (iImports modul)
71+ put (iAdts modul)
72+ put (iAliases modul)
73+ put (iFixities modul)
74+ put (iPorts modul)
75+
76+data ImportMethod
77+ = As !String
78+ | Open !(Var.Listing Var.Value)
79+
80+open :: ImportMethod
81+open = Open (Var.openListing)
82+
83+importing :: [String] -> ImportMethod
84+importing xs = Open (Var.Listing (map Var.Value xs) False)
85+
86+instance Binary ImportMethod where
87+ put method =
88+ let put' n info = putWord8 n >> put info in
89+ case method of
90+ As alias -> put' 0 alias
91+ Open listing -> put' 1 listing
92+
93+ get = do tag <- getWord8
94+ case tag of
95+ 0 -> As <$> get
96+ 1 -> Open <$> get
97+ _ -> error "Error reading valid ImportMethod type from serialized string"
98+
99+{-
100+data Module port def = Module
101+ { name :: [String]
102+ , exports :: Var.Listing Var.Value
103+ , imports :: [(String, ImportMethod)]
104+ , decls :: [Declaration' port def]
105+ }
106+
107+instance (Pretty port, Pretty def) => Pretty (Module port def) where
108+ pretty (Module names exs ims decls) =
109+ P.vcat [modul, P.text "", prettyImports, P.text "", prettyDecls]
110+ where
111+ modul = P.text "module" <+> name <+> prettyExports <+> P.text "where"
112+ name = P.text (List.intercalate "." names)
113+
114+ prettyExports
115+ | Var._open exs = P.empty
116+ | otherwise = pretty exs
117+
118+ prettyImports = P.vcat $ map prettyMethod ims
119+
120+ prettyDecls = P.sep $ map pretty decls
121+
122+prettyMethod :: (String, ImportMethod) -> Doc
123+prettyMethod (name, method) =
124+ case method of
125+ As alias
126+ | name == alias -> P.empty
127+ | otherwise -> P.text "as" <+> P.text alias
128+
129+ Open listing -> pretty listing
130+
131+-}
compiler/AST/Type.hsnew file+122
@@ -0,0 +1,122 @@
1+{-# OPTIONS_GHC -W #-}
2+module AST.Type where
3+
4+import Control.Applicative ((<$>), (<*>))
5+import Data.Binary
6+import qualified Data.Map as Map
7+
8+import AST.Variable (Raw(Raw))
9+import qualified AST.Variable as Var
10+import SourceSyntax.PrettyPrint
11+import qualified SourceSyntax.Helpers as Help
12+import Text.PrettyPrint as P
13+
14+data Type var
15+ = Lambda (Type var) (Type var)
16+ | Var String
17+ | Data var [Type var]
18+ | Record [(String, Type var)] (Maybe (Type var))
19+ | Aliased Var.Canonical (Type var)
20+ deriving (Eq,Show)
21+
22+fieldMap :: [(String,a)] -> Map.Map String [a]
23+fieldMap fields =
24+ foldl (\r (x,t) -> Map.insertWith (++) x [t] r) Map.empty fields
25+
26+recordOf :: [(String, Type var)] -> Type var
27+recordOf fields = Record fields Nothing
28+
29+listOf :: Type Raw -> Type Raw
30+listOf t = Data (Raw "_List") [t]
31+
32+tupleOf :: [Type Raw] -> Type Raw
33+tupleOf ts = Data (Raw $ "_Tuple" ++ show (length ts)) ts
34+
35+instance (Var.ToString var, Pretty var) => Pretty (Type var) where
36+ pretty tipe =
37+ case tipe of
38+ Lambda _ _ -> P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]
39+ where
40+ t:ts = map prettyLambda (collectLambdas tipe)
41+ prettyLambda t = case t of
42+ Lambda _ _ -> P.parens (pretty t)
43+ _ -> pretty t
44+
45+ Var x -> P.text x
46+
47+ Data name [t] | Var.toString name == "_List" ->
48+ P.brackets (pretty t)
49+
50+ Data name tipes
51+ | Help.isTuple (Var.toString name) ->
52+ P.parens . P.sep . P.punctuate P.comma $ map pretty tipes
53+ | otherwise ->
54+ P.hang (P.text (Var.toString name)) 2 (P.sep $ map prettyParens tipes)
55+
56+ Record _ _ ->
57+ P.braces $ case flattenRecord tipe of
58+ (fields, Nothing) -> prettyFields fields
59+ (fields, Just x) ->
60+ P.hang (P.text x <+> P.text "|") 4 (prettyFields fields)
61+ where
62+ prettyField (f,t) = P.text f <+> P.text ":" <+> pretty t
63+ prettyFields fields = commaSep (map prettyField fields)
64+
65+ Aliased name _ -> pretty name
66+
67+collectLambdas :: Type var -> [Type var]
68+collectLambdas tipe =
69+ case tipe of
70+ Lambda arg body -> arg : collectLambdas body
71+ _ -> [tipe]
72+
73+prettyParens :: (Var.ToString var, Pretty var) => Type var -> Doc
74+prettyParens tipe = parensIf (needed tipe) (pretty tipe)
75+ where
76+ needed t =
77+ case t of
78+ Aliased _ t' -> needed t'
79+ Lambda _ _ -> True
80+ Data name [_] | Var.toString name == "_List" -> False
81+ Data _ [] -> False
82+ Data _ _ -> True
83+ _ -> False
84+
85+flattenRecord :: Type var -> ( [(String, Type var)], Maybe String )
86+flattenRecord tipe =
87+ case tipe of
88+ Var x -> ([], Just x)
89+
90+ Record fields Nothing -> (fields, Nothing)
91+
92+ Record fields (Just ext) ->
93+ let (fields',ext') = flattenRecord ext
94+ in (fields' ++ fields, ext')
95+
96+ Aliased _ tipe' -> flattenRecord tipe'
97+
98+ _ -> error "Trying to flatten ill-formed record."
99+
100+instance Binary var => Binary (Type var) where
101+ put tipe =
102+ case tipe of
103+ Lambda t1 t2 ->
104+ putWord8 0 >> put t1 >> put t2
105+ Var x ->
106+ putWord8 1 >> put x
107+ Data ctor tipes ->
108+ putWord8 2 >> put ctor >> put tipes
109+ Record fs ext ->
110+ putWord8 3 >> put fs >> put ext
111+ Aliased var t ->
112+ putWord8 4 >> put var >> put t
113+
114+ get = do
115+ n <- getWord8
116+ case n of
117+ 0 -> Lambda <$> get <*> get
118+ 1 -> Var <$> get
119+ 2 -> Data <$> get <*> get
120+ 3 -> Record <$> get <*> get
121+ 4 -> Aliased <$> get <*> get
122+ _ -> error "Error reading a valid type from serialized string"
compiler/AST/Variable.hsnew file+114
@@ -0,0 +1,114 @@
1+
2+module AST.Variable where
3+
4+import Data.Binary
5+import Control.Applicative ((<$>), (<*>))
6+import Text.PrettyPrint as P
7+import SourceSyntax.PrettyPrint
8+
9+import qualified Data.List as List
10+import qualified Text.PrettyPrint as P
11+import SourceSyntax.PrettyPrint
12+
13+newtype Raw = Raw String
14+ deriving (Eq,Ord,Show)
15+
16+data Home
17+ = Local
18+ | Module !String
19+ deriving (Eq,Ord,Show)
20+
21+data Canonical = Canonical
22+ { home :: !Home
23+ , name :: !String
24+ } deriving (Eq,Ord,Show)
25+
26+local :: String -> Canonical
27+local x = Canonical Local x
28+
29+class ToString a where
30+ toString :: a -> String
31+
32+instance ToString Raw where
33+ toString (Raw x) = x
34+
35+instance ToString Canonical where
36+ toString (Canonical home name) =
37+ case home of
38+ Local -> name
39+ Module path -> path ++ "." ++ name
40+
41+-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
42+data Listing a = Listing
43+ { _explicits :: [a]
44+ , _open :: Bool
45+ }
46+
47+openListing :: Listing a
48+openListing = Listing [] True
49+
50+-- | A value that can be imported or exported
51+data Value
52+ = Value !String
53+ | Alias !String
54+ | ADT !String !(Listing String)
55+
56+
57+instance Pretty Raw where
58+ pretty (Raw var) = variable var
59+
60+instance Pretty Canonical where
61+ pretty (Canonical home name) =
62+ P.text (home' ++ name)
63+ where
64+ home' = case home of
65+ Local -> ""
66+ Module name -> name ++ "."
67+
68+instance Pretty a => Pretty (Listing a) where
69+ pretty (Listing explicits open) =
70+ P.parens (commaCat (map pretty explicits ++ dots))
71+ where
72+ dots = [if open then P.text ".." else P.empty]
73+
74+instance Pretty Value where
75+ pretty portable =
76+ case portable of
77+ Value name -> P.text name
78+ Alias name -> P.text name
79+ ADT name ctors ->
80+ P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
81+
82+instance Binary Canonical where
83+ put (Canonical home name) =
84+ case home of
85+ Local -> putWord8 0 >> put name
86+ Module path -> putWord8 1 >> put path >> put name
87+
88+ get = do tag <- getWord8
89+ case tag of
90+ 0 -> Canonical Local <$> get
91+ 1 -> Canonical . Module <$> get <*> get
92+ _ -> error "Unexpected tag when deserializing canonical variable"
93+
94+instance Binary Value where
95+ put portable =
96+ let put' n info = putWord8 n >> put info in
97+ case portable of
98+ Value name -> put' 0 name
99+ ADT name ctors ->
100+ do put' 1 name
101+ put ctors
102+
103+ get = do tag <- getWord8
104+ case tag of
105+ 0 -> Value <$> get
106+ 1 -> ADT <$> get <*> get
107+ _ -> error "Error reading valid import/export information from serialized string"
108+
109+instance (Binary a) => Binary (Listing a) where
110+ put (Listing explicits open) =
111+ do put explicits
112+ put open
113+
114+ get = Listing <$> get <*> get
compiler/SourceSyntax/Declaration.hs+25−18
@@ -2,15 +2,18 @@
2module SourceSyntax.Declaration where
2module SourceSyntax.Declaration where
3
3
4import Data.Binary
4import Data.Binary
5−import qualified SourceSyntax.Expression as Expr
5+import qualified AST.Expression.Source as Source
6+import qualified AST.Expression.Valid as Valid
7+import qualified AST.Expression.Canonical as Canonical
6−import qualified SourceSyntax.Type as T
8+import qualified AST.Type as T
9+import qualified AST.Variable as Var
7import SourceSyntax.PrettyPrint
10import SourceSyntax.PrettyPrint
8import Text.PrettyPrint as P
11import Text.PrettyPrint as P
9
12
10−data Declaration' port def
13+data Declaration' port def var
11 = Definition def
14 = Definition def
12− | Datatype String [String] [(String,[T.Type])]
15+ | Datatype String [String] [(String, [T.Type var])]
13− | TypeAlias String [String] T.Type
16+ | TypeAlias String [String] (T.Type var)
14 | Port port
17 | Port port
15 | Fixity Assoc Int String
18 | Fixity Assoc Int String
16 deriving (Show)
19 deriving (Show)
@@ -18,25 +21,28 @@ data Declaration' port def
18data Assoc = L | N | R
21data Assoc = L | N | R
19 deriving (Eq)
22 deriving (Eq)
20
23
21−data ParsePort
24+data RawPort
22− = PPAnnotation String T.Type
25+ = PPAnnotation String (T.Type Var.Raw)
23− | PPDef String Expr.ParseExpr
26+ | PPDef String Source.Expr
24 deriving (Show)
27 deriving (Show)
25
28
26−data Port
29+data Port expr var
27− = Out String Expr.Expr T.Type
30+ = Out String expr (T.Type var)
28− | In String T.Type
31+ | In String (T.Type var)
29 deriving (Show)
32 deriving (Show)
30
33
34+type SourceDecl = Declaration' RawPort Source.Def Var.Raw
35+type ValidDecl = Declaration' (Port Valid.Expr Var.Raw) Valid.Def Var.Raw
36+type CanonicalDecl = Declaration' (Port Canonical.Expr Var.Canonical)
37+ Canonical.Def
38+ Var.Canonical
39+
31−portName :: Port -> String
40+portName :: Port expr var -> String
32portName port =
41portName port =
33 case port of
42 case port of
34 Out name _ _ -> name
43 Out name _ _ -> name
35 In name _ -> name
44 In name _ -> name
36
45
37−type ParseDeclaration = Declaration' ParsePort Expr.ParseDef
38−type Declaration = Declaration' Port Expr.Def
39−
40instance Show Assoc where
46instance Show Assoc where
41 show assoc =
47 show assoc =
42 case assoc of
48 case assoc of
@@ -54,7 +60,8 @@ instance Binary Assoc where
54
60
55 put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }
61 put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }
56
62
63+instance (Pretty port, Pretty def, Pretty var, Var.ToString var) =>
57−instance (Pretty port, Pretty def) => Pretty (Declaration' port def) where
64+ Pretty (Declaration' port def var) where
58 pretty decl =
65 pretty decl =
59 case decl of
66 case decl of
60 Definition def -> pretty def
67 Definition def -> pretty def
@@ -81,13 +88,13 @@ instance (Pretty port, Pretty def) => Pretty (Declaration' port def) where
81 N -> P.empty
88 N -> P.empty
82 R -> P.text "r"
89 R -> P.text "r"
83
90
84−instance Pretty ParsePort where
91+instance Pretty RawPort where
85 pretty port =
92 pretty port =
86 case port of
93 case port of
87 PPAnnotation name tipe -> prettyPort name ":" tipe
94 PPAnnotation name tipe -> prettyPort name ":" tipe
88 PPDef name expr -> prettyPort name "=" expr
95 PPDef name expr -> prettyPort name "=" expr
89
96
90−instance Pretty Port where
97+instance (Pretty expr, Pretty var, Var.ToString var) => Pretty (Port expr var) where
91 pretty port =
98 pretty port =
92 case port of
99 case port of
93 In name tipe -> prettyPort name ":" tipe
100 In name tipe -> prettyPort name ":" tipe
compiler/SourceSyntax/Pattern.hs+35−25
@@ -5,33 +5,38 @@ import qualified SourceSyntax.Helpers as Help
5import SourceSyntax.PrettyPrint
5import SourceSyntax.PrettyPrint
6import Text.PrettyPrint as PP
6import Text.PrettyPrint as PP
7import qualified Data.Set as Set
7import qualified Data.Set as Set
8+
9+import qualified AST.Variable as Var
8import SourceSyntax.Literal as Literal
10import SourceSyntax.Literal as Literal
9
11
10−data Pattern
12+data Pattern var
11− = Data String [Pattern]
13+ = Data var [Pattern var]
12 | Record [String]
14 | Record [String]
13− | Alias String Pattern
15+ | Alias String (Pattern var)
14 | Var String
16 | Var String
15 | Anything
17 | Anything
16 | Literal Literal.Literal
18 | Literal Literal.Literal
17 deriving (Eq, Ord, Show)
19 deriving (Eq, Ord, Show)
18
20
19−cons :: Pattern -> Pattern -> Pattern
21+type RawPattern = Pattern Var.Raw
22+type CanonicalPattern = Pattern Var.Canonical
23+
24+cons :: RawPattern -> RawPattern -> RawPattern
20−cons h t = Data "::" [h,t]
25+cons h t = Data (Var.Raw "::") [h,t]
21
26
22−nil :: Pattern
27+nil :: RawPattern
23−nil = Data "[]" []
28+nil = Data (Var.Raw "[]") []
24
29
25−list :: [Pattern] -> Pattern
30+list :: [RawPattern] -> RawPattern
26−list = foldr cons nil
31+list = foldr cons nil
27
32
28−tuple :: [Pattern] -> Pattern
33+tuple :: [RawPattern] -> RawPattern
29−tuple es = Data ("_Tuple" ++ show (length es)) es
34+tuple es = Data (Var.Raw ("_Tuple" ++ show (length es))) es
30
35
31−boundVarList :: Pattern -> [String]
36+boundVarList :: Pattern var -> [String]
32boundVarList = Set.toList . boundVars
37boundVarList = Set.toList . boundVars
33
38
34−boundVars :: Pattern -> Set.Set String
39+boundVars :: Pattern var -> Set.Set String
35boundVars pattern =
40boundVars pattern =
36 case pattern of
41 case pattern of
37 Var x -> Set.singleton x
42 Var x -> Set.singleton x
@@ -42,7 +47,7 @@ boundVars pattern =
42 Literal _ -> Set.empty
47 Literal _ -> Set.empty
43
48
44
49
45−instance Pretty Pattern where
50+instance Var.ToString var => Pretty (Pattern var) where
46 pretty pattern =
51 pretty pattern =
47 case pattern of
52 case pattern of
48 Var x -> variable x
53 Var x -> variable x
@@ -50,20 +55,25 @@ instance Pretty Pattern where
50 Record fs -> PP.braces (commaCat $ map variable fs)
55 Record fs -> PP.braces (commaCat $ map variable fs)
51 Alias x p -> prettyParens p <+> PP.text "as" <+> variable x
56 Alias x p -> prettyParens p <+> PP.text "as" <+> variable x
52 Anything -> PP.text "_"
57 Anything -> PP.text "_"
58+ Data name [hd,tl] | Var.toString name == "::" ->
53− Data "::" [hd,tl] -> parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
59+ parensIf isCons (pretty hd) <+> PP.text "::" <+> pretty tl
60+ where
54− where isCons = case hd of
61+ isCons = case hd of
55− Data "::" _ -> True
62+ Data ctor _ -> Var.toString ctor == "::"
56− _ -> False
63+ _ -> False
64+
57− Data name ps ->
65+ Data name ps
58− if Help.isTuple name then
59− PP.parens . commaCat $ map pretty ps
66+ | Help.isTuple name' -> PP.parens . commaCat $ map pretty ps
60− else hsep (PP.text name : map prettyParens ps)
67+ | otherwise -> hsep (PP.text name' : map prettyParens ps)
68+ where
69+ name' = Var.toString name
61
70
62−prettyParens :: Pattern -> Doc
71+prettyParens :: Var.ToString var => Pattern var -> Doc
72+prettyParens pattern =
63−prettyParens pattern = parensIf needsThem (pretty pattern)
73+ parensIf needsThem (pretty pattern)
64 where
74 where
65 needsThem =
75 needsThem =
66 case pattern of
76 case pattern of
67− Data name (_:_) | not (Help.isTuple name) -> True
77+ Data name (_:_) | not (Help.isTuple (Var.toString name)) -> True
68 Alias _ _ -> True
78 Alias _ _ -> True
69 _ -> False
79 _ -> False
compiler/SourceSyntax/PrettyPrint.hs+7−4
@@ -1,14 +1,17 @@
1−
1+{-# LANGUAGE FlexibleInstances #-}
2module SourceSyntax.PrettyPrint where
2module SourceSyntax.PrettyPrint where
3
3
4−import Text.PrettyPrint
4+import Text.PrettyPrint as P
5import qualified SourceSyntax.Helpers as Help
5import qualified SourceSyntax.Helpers as Help
6
6
7class Pretty a where
7class Pretty a where
8 pretty :: a -> Doc
8 pretty :: a -> Doc
9
9
10−instance Pretty () where
10+instance Pretty Doc where
11− pretty () = empty
11+ pretty doc = doc
12+
13+instance Pretty String where
14+ pretty = P.text
12
15
13renderPretty :: (Pretty a) => a -> String
16renderPretty :: (Pretty a) => a -> String
14renderPretty e = render (pretty e)
17renderPretty e = render (pretty e)