git.iko.soy/elk
on master help sign in
Add record constructors, begin using lists to represent fields in record types to maintain ordering from the source program
commit760ad905cf4a89bdcc94446cab4e2b1db0995ba5 authorEvan Czaplicki <info@elm-lang.org> dateFri 26 Jul 2013, 18:20 (13 years ago) parent7d00618
5 files changed+35−14
compare with master
unifiedsplit
compiler/Parse/Type.hs+1−1 compiler/SourceSyntax/Module.hs+1−1 compiler/SourceSyntax/Type.hs+4−4 compiler/Type/Constrain/Declaration.hs+28−7 compiler/Type/Environment.hs+1−1
compiler/Parse/Type.hs+1−1
@@ -29,7 +29,7 @@ record =
2929 ext <- extend
3030 fs <- fields
3131 dumbWhitespace ; char '}'
32− return (T.Record (fieldMap fs) ext)
32+ return (T.Record fs ext)
3333 where
3434 extend = option T.EmptyRecord . try $ do
3535 t <- tvar
compiler/SourceSyntax/Module.hs+1−1
@@ -98,4 +98,4 @@ renameType find tipe =
9898 Var x -> Var x
9999 Data name ts -> Data (find name) (map rnm ts)
100100 EmptyRecord -> EmptyRecord
101− Record fields ext -> Record (Map.map (map rnm) fields) (rnm ext)
101+ Record fields ext -> Record (map (second rnm) fields) (rnm ext)
compiler/SourceSyntax/Type.hs+4−4
@@ -13,7 +13,7 @@ data Type = Lambda Type Type
1313 | Var String
1414 | Data String [Type]
1515 | EmptyRecord
16− | Record (Map.Map String [Type]) Type
16+ | Record [(String,Type)] Type
1717 deriving (Eq, Show, Data, Typeable)
1818
1919fieldMap :: [(String,Type)] -> Map.Map String [Type]
@@ -21,7 +21,7 @@ fieldMap fields =
2121 foldl (\r (x,t) -> Map.insertWith (++) x [t] r) Map.empty fields
2222
2323recordOf :: [(String,Type)] -> Type
24−recordOf fields = Record (fieldMap fields) EmptyRecord
24+recordOf fields = Record fields EmptyRecord
2525
2626listOf :: Type -> Type
2727listOf t = Data "_List" [t]
@@ -43,8 +43,8 @@ instance Pretty Type where
4343 EmptyRecord -> P.braces P.empty
4444 Record fields ext -> P.braces $ P.hang (pretty ext <+> P.text "|") 4 prettyFields
4545 where
46− prettyField (f,ts) = map (\t -> P.text f <+> P.text ":" <+> pretty t) ts
47− prettyFields = commaSep . concatMap prettyField $ Map.toList fields
46+ prettyField (f,t) = P.text f <+> P.text ":" <+> pretty t
47+ prettyFields = commaSep . map prettyField $ fields
4848
4949collectLambdas tipe =
5050 case tipe of
compiler/Type/Constrain/Declaration.hs+28−7
@@ -23,15 +23,29 @@ toDefs decl =
2323 Datatype name tvars constructors -> concatMap toDefs constructors
2424 where
2525 toDefs (ctor, tipes) =
26− let vars = take (length tipes) $ map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]
27− loc = Src.none
28− body = loc . Src.Data ctor $ map (loc . Src.Var) vars
29− in [ Src.TypeAnnotation ctor $
30− foldr Type.Lambda (Type.Data name $ map Type.Var tvars) tipes
31− , Src.Def (Src.PVar ctor) $
32− foldr (\p e -> loc $ Src.Lambda p e) body (map Src.PVar vars)
26+ let vars = take (length tipes) arguments
27+ tbody = Type.Data name $ map Type.Var tvars
28+ body = Src.none . Src.Data ctor $ map (Src.none . Src.Var) vars
29+ in [ Src.TypeAnnotation ctor $ foldr Type.Lambda tbody tipes
30+ , Src.Def (Src.PVar ctor) $ buildFunction body vars
3331 ]
3432
33+ TypeAlias name tvars tipe@(Type.Record fields ext) ->
34+ [ Src.TypeAnnotation name $ foldr Type.Lambda tipe args
35+ , Src.Def (Src.PVar name) $ buildFunction record vars ]
36+ where
37+ args = case ext of
38+ Type.EmptyRecord -> map snd fields
39+ _ -> map snd fields ++ [ext]
40+
41+ var = Src.none . Src.Var
42+ vars = take (length args) arguments
43+
44+ efields = zip (map fst fields) (map var vars)
45+ record = Src.none $ case ext of
46+ Type.EmptyRecord -> Src.Record efields
47+ _ -> Src.Modify (var $ last vars) efields
48+
3549 -- Type aliases must be added to an extended equality dictionary,
3650 -- but they do not require any basic constraints.
3751 TypeAlias _ _ _ -> []
@@ -45,3 +59,10 @@ toDefs decl =
4559
4660 -- no constraints are needed for fixity declarations
4761 Fixity _ _ _ -> []
62+
63+
64+arguments :: [String]
65+arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]
66+
67+buildFunction body vars =
68+ foldr (\p e -> Src.none (Src.Lambda p e)) body (map Src.PVar vars)
compiler/Type/Environment.hs+1−1
@@ -160,4 +160,4 @@ instantiator env sourceType = go sourceType
160160 Src.EmptyRecord -> return (TermN EmptyRecord1)
161161
162162 Src.Record fields ext ->
163− TermN <$> (Record1 <$> Traverse.traverse (mapM go) fields <*> go ext)
163+ TermN <$> (Record1 <$> Traverse.traverse (mapM go) (Src.fieldMap fields) <*> go ext)