git.iko.soy/elk
on master help sign in
Fix type signature for record constructors
4953132Evan Czaplicki
src/AST/Canonical.hs+1−1
compare with master
unifiedsplit
@@ -211,7 +211,7 @@ data Module =
211 }
211 }
212
212
213
213
214−data Alias = Alias [N.Name] Type (Maybe [N.Name])
214+data Alias = Alias [N.Name] Type (Maybe [(N.Name,Type)])
215data Binop = Binop_ Binop.Associativity Binop.Precedence N.Name
215data Binop = Binop_ Binop.Associativity Binop.Precedence N.Name
216
216
217
217
src/Canonicalize/Environment/Foreign.hs+12−4
@@ -140,16 +140,24 @@ unionToType home name union@(Can.Union vars ctors _ _) =
140
140
141
141
142aliasToType :: ModuleName.Canonical -> N.Name -> Can.Alias -> (Env.Type, Env.Exposed Env.Ctor)
142aliasToType :: ModuleName.Canonical -> N.Name -> Can.Alias -> (Env.Type, Env.Exposed Env.Ctor)
143−aliasToType home name (Can.Alias vars tipe maybeRecordArgs) =
143+aliasToType home name (Can.Alias vars tipe maybeRecordFields) =
144 (
144 (
145 Env.Alias (length vars) home vars tipe
145 Env.Alias (length vars) home vars tipe
146 ,
146 ,
147− case maybeRecordArgs of
147+ case maybeRecordFields of
148 Nothing ->
148 Nothing ->
149 Map.empty
149 Map.empty
150
150
151− Just _ ->
151+ Just fields ->
152+ let
153+ avars = map (\var -> (var, Can.TVar var)) vars
154+ alias =
155+ foldr
156+ (\(_,t1) t2 -> Can.TLambda t1 t2)
157+ (Can.TAlias home name avars (Can.Filled tipe))
158+ fields
159+ in
152− Map.singleton name (Map.singleton home (Env.RecordCtor home vars tipe))
160+ Map.singleton name (Map.singleton home (Env.RecordCtor home vars alias))
153 )
161 )
154
162
155
163
src/Canonicalize/Environment/Local.hs+2−1
@@ -6,6 +6,7 @@ module Canonicalize.Environment.Local
6 where
6 where
7
7
8
8
9+import Control.Arrow (first)
9import Control.Monad (foldM)
10import Control.Monad (foldM)
10import qualified Data.Graph as Graph
11import qualified Data.Graph as Graph
11import qualified Data.List as List
12import qualified Data.List as List
@@ -299,7 +300,7 @@ canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (Valid.Alias (A.At region nam
299 let recordType = Can.TRecord fieldDict Nothing
300 let recordType = Can.TRecord fieldDict Nothing
300 let ctorType = foldr (Can.TLambda . snd) recordType cfields
301 let ctorType = foldr (Can.TLambda . snd) recordType cfields
301 let vars = map A.toValue args
302 let vars = map A.toValue args
302− let alias = Can.Alias vars recordType (Just (map (A.toValue . fst) fields))
303+ let alias = Can.Alias vars recordType (Just (map (first A.toValue) cfields))
303 let ctor = Env.RecordCtor home vars ctorType
304 let ctor = Env.RecordCtor home vars ctorType
304
305
305 Result.ok
306 Result.ok
src/Optimize/Module.hs+6−6
@@ -91,7 +91,7 @@ addAlias home name (Can.Alias _ _ maybeFields) graph@(Opt.Graph mains nodes fiel
91 Just fields ->
91 Just fields ->
92 let
92 let
93 function =
93 function =
94− Opt.Function fields $ Opt.Record $
94+ Opt.Function (map fst fields) $ Opt.Record $
95 Map.fromList $ map toPair fields
95 Map.fromList $ map toPair fields
96
96
97 node =
97 node =
@@ -100,16 +100,16 @@ addAlias home name (Can.Alias _ _ maybeFields) graph@(Opt.Graph mains nodes fiel
100 Opt.Graph
100 Opt.Graph
101 mains
101 mains
102 (Map.insert (Opt.Global home name) node nodes)
102 (Map.insert (Opt.Global home name) node nodes)
103− (foldr addOne fieldCounts fields)
103+ (foldr addRecordCtorField fieldCounts fields)
104
104
105
105
106−toPair :: N.Name -> (N.Name, Opt.Expr)
106+toPair :: (N.Name, Can.Type) -> (N.Name, Opt.Expr)
107−toPair field =
107+toPair (field, _) =
108 ( field, Opt.VarLocal field )
108 ( field, Opt.VarLocal field )
109
109
110
110
111−addOne :: N.Name -> Map.Map N.Name Int -> Map.Map N.Name Int
111+addRecordCtorField :: (N.Name, Can.Type) -> Map.Map N.Name Int -> Map.Map N.Name Int
112−addOne name fields =
112+addRecordCtorField (name, _) fields =
113 Map.insertWith (+) name 1 fields
113 Map.insertWith (+) name 1 fields
114
114
115
115