Made I'.id qualified for codegen, Fut<A> has invariant subtyping for …

…now, see #10
abstools · Apr 3, 2017 · b2c025a · b2c025a
1 parent 5e36f0f
commit b2c025a
Show file tree

Hide file tree

Showing 2 changed files with 3 additions and 2 deletions.
diff --git a/src/ABS/Compiler/Codegen/Mod.hs b/src/ABS/Compiler/Codegen/Mod.hs
@@ -108,7 +108,7 @@ tModul (ABS.Module thisModuleQU exports imports decls maybeMain) allSymbolTables
                   , HS.importQualified = True
                   , HS.importAs = Just (HS.ModuleName "I'")
                   -- Ord and Show have to be IThingAll, so we can define custom instances
-                  , HS.importSpecs = Just (False,[HS.IVar $ HS.Ident "IO", HS.IVar $ HS.Ident "Eq", HS.IThingAll $ HS.Ident "Ord", HS.IThingAll $ HS.Ident "Show", HS.IVar $ HS.Ident "undefined", HS.IVar $ HS.Ident "error", HS.IVar $ HS.Ident "negate", HS.IVar $ HS.Ident "fromIntegral", HS.IVar $ HS.Ident "mapM_"])
+                  , HS.importSpecs = Just (False,[HS.IVar $ HS.Ident "IO", HS.IVar $ HS.Ident "Eq", HS.IThingAll $ HS.Ident "Ord", HS.IThingAll $ HS.Ident "Show", HS.IVar $ HS.Ident "undefined", HS.IVar $ HS.Ident "error", HS.IVar $ HS.Ident "negate", HS.IVar $ HS.Ident "fromIntegral", HS.IVar $ HS.Ident "mapM_", HS.IVar $ HS.Ident "id"])
                   , HS.importLoc = noLoc', HS.importSrc = False, HS.importSafe = False, HS.importPkg = Nothing
                   }
   , HS.ImportDecl { HS.importModule = HS.ModuleName "Unsafe.Coerce" 

diff --git a/src/ABS/Compiler/Utils.hs b/src/ABS/Compiler/Utils.hs
@@ -108,6 +108,7 @@ data Info = Up
 
 buildInfo :: (?st :: SymbolTable) => ABS.T -> Maybe Info
 buildInfo ABS.TInfer = todo
+buildInfo (ABS.TPoly (ABS.U_ (ABS.U (_,"Fut"))) _) = Nothing -- TODO: Fut<A> should be covariant, but for implementation reasons (MVar a) it is invariant
 buildInfo (ABS.TPoly qu ts) = let (l, buildArgs) = foldl (\ (i,acc) t -> maybe (i+1,acc) (\x -> (i+1,(i,x):acc)) (buildInfo t) ) (0,[]) ts
                               in if null buildArgs
                                  then Nothing
@@ -135,6 +136,6 @@ buildInfo t@(ABS.TSimple _) = if isInterface t
 putUp :: Info -> HS.Exp
 putUp Up = [hs|up'|]
 putUp (Deep functorName functorWidth deeps) = foldl 
-                                              (\ acc i -> HS.App acc $ maybe [hs|id|] (HS.Paren . putUp) (lookup i deeps))
+                                              (\ acc i -> HS.App acc $ maybe [hs|I'.id|] (HS.Paren . putUp) (lookup i deeps))
                                               (HS.Var $ HS.UnQual $ HS.Ident $ "fmap'" ++ functorName)
                                               [0..functorWidth-1]