@@ -17,7 +17,7 @@ module Type.State
1717 where
1818
1919
20−import Control.Monad (forM_, liftM, liftM2)
20+import Control.Monad (forM_, liftM, liftM2, liftM3)
2121import Control.Monad.Trans (MonadIO, liftIO)
2222import qualified Data.Map.Strict as Map
2323import Data.Map.Strict ((!))
@@ -143,17 +143,17 @@ flattenHelp maxRank pools aliasDict tipe =
143143 PlaceHolder name ->
144144 return (aliasDict ! name)
145145
146− AliasN name args realType ->
146+ AliasN home name args realType ->
147147 do flatArgs <- mapM (traverse (flattenHelp maxRank pools aliasDict)) args
148148 flatVar <- flattenHelp maxRank pools (Map.fromList flatArgs) realType
149− registerFlatType maxRank pools (Alias name flatArgs flatVar)
149+ registerFlatType maxRank pools (Alias home name flatArgs flatVar)
150150
151151 VarN v ->
152152 return v
153153
154− AppN name args ->
154+ AppN home name args ->
155155 do flatArgs <- traverse (flattenHelp maxRank pools aliasDict) args
156− registerFlatType maxRank pools (Structure (App1 name flatArgs))
156+ registerFlatType maxRank pools (Structure (App1 home name flatArgs))
157157
158158 FunN a b ->
159159 do flatA <- flattenHelp maxRank pools aliasDict a
@@ -168,6 +168,15 @@ flattenHelp maxRank pools aliasDict tipe =
168168 flatExt <- flattenHelp maxRank pools aliasDict ext
169169 registerFlatType maxRank pools (Structure (Record1 flatFields flatExt))
170170
171+ UnitN ->
172+ registerFlatType maxRank pools (Structure Unit1)
173+
174+ TupleN a b cs ->
175+ do flatA <- flattenHelp maxRank pools aliasDict a
176+ flatB <- flattenHelp maxRank pools aliasDict b
177+ flatCs <- traverse (flattenHelp maxRank pools aliasDict) cs
178+ registerFlatType maxRank pools (Structure (Tuple1 flatA flatB flatCs))
179+
171180
172181registerFlatType :: Int -> Pools -> Content -> IO Variable
173182registerFlatType maxRank pools content =
@@ -233,10 +242,10 @@ copyHelp maxRank pools variable =
233242 RigidSuper super name ->
234243 UF.setDescriptor newVar $ mkCopyDesc $ FlexSuper super (Just name)
235244
236− Alias name args realType ->
245+ Alias home name args realType ->
237246 do newArgs <- mapM (traverse (copyHelp maxRank pools)) args
238247 newRealType <- copyHelp maxRank pools realType
239− UF.setDescriptor newVar $ mkCopyDesc (Alias name newArgs newRealType)
248+ UF.setDescriptor newVar $ mkCopyDesc (Alias home name newArgs newRealType)
240249
241250 Error _ ->
242251 return ()
@@ -280,8 +289,8 @@ restoreContent content =
280289 Structure term ->
281290 Structure <$> traverseFlatType restore term
282291
283− Alias name args var ->
284− Alias name
292+ Alias home name args var ->
293+ Alias home name
285294 <$> mapM (traverse restore) args
286295 <*> restore var
287296
@@ -296,8 +305,8 @@ restoreContent content =
296305traverseFlatType :: (Variable -> IO Variable) -> FlatType -> IO FlatType
297306traverseFlatType f flatType =
298307 case flatType of
299− App1 name args ->
300− liftM (App1 name) (traverse f args)
308+ App1 home name args ->
309+ liftM (App1 home name) (traverse f args)
301310
302311 Fun1 a b ->
303312 liftM2 Fun1 (f a) (f b)
@@ -308,6 +317,12 @@ traverseFlatType f flatType =
308317 Record1 fields ext ->
309318 liftM2 Record1 (traverse f fields) (f ext)
310319
320+ Unit1 ->
321+ pure Unit1
322+
323+ Tuple1 a b cs ->
324+ liftM3 Tuple1 (f a) (f b) (traverse f cs)
325+
311326
312327
313328-- INSTANCES