@@ -108,31 +108,24 @@ constrain env (L _ _ expr) tipe =
109 Modify e fields ->
109 Modify e fields ->
110 exists $ \t -> do
110 exists $ \t -> do
111− dummyFields <- Map.fromList <$> mapM dummyField fields
111+ oldVars <- forM fields $ \_ -> var Flexible
112+ let oldFields = SrcT.fieldMap (zip (map fst fields) (map VarN oldVars))
112− cOld <- constrain env e (record dummyFields t)
113+ cOld <- ex oldVars <$> constrain env e (record oldFields t)
113− (fieldTypes, constraints) <- unzip <$> mapM field fields
114+
115+ newVars <- forM fields $ \_ -> var Flexible
116+ let newFields = SrcT.fieldMap (zip (map fst fields) (map VarN newVars))
114− let cNew = tipe === record (Map.fromList fieldTypes) t
117+ let cNew = tipe === record newFields t
115− return (CAnd (cOld : cNew : constraints))
117− dummyField (label, _) = do
118− v <- var Flexible -- needs an ex
119− return (label, [VarN v])
121− field (label, value) = do
122− v <- var Flexible -- needs an ex
123− c <- ex [v] <$> constrain env value (VarN v)
119+ cs <- zipWithM (constrain env) (map snd fields) (map VarN newVars)
124− return ((label, [VarN v]), c)
120+
121+ return $ cOld /\ ex newVars (CAnd (cNew : cs))
126 Record fields ->
123 Record fields ->
127− do (pairs, cs) <- unzip <$> mapM field fields
124+ do vars <- forM fields $ \_ -> var Flexible
128− let fieldTypes = Map.fromList (map (second (\t -> [VarN t])) pairs)
125+ cs <- zipWithM (constrain env) (map snd fields) (map VarN vars)
126+ let fields' = SrcT.fieldMap (zip (map fst fields) (map VarN vars))
129− recordType = record fieldTypes (TermN EmptyRecord1)
127+ recordType = record fields' (TermN EmptyRecord1)
130− return $ ex (map snd pairs) (CAnd (tipe === recordType : cs))
128+ return . ex vars $ CAnd (tipe === recordType : cs)
132− field (name, body) = do
133− v <- var Flexible -- needs an ex
134− c <- constrain env body (VarN v)
135− return ((name, v), c)
137 Markdown _ ->
130 Markdown _ ->
138 return $ tipe === Env.get env Env.types "Element"
131 return $ tipe === Env.get env Env.types "Element"