Refactor locvar dtype

gibbon-compiler/src/Gibbon/Common.hs

@@ -8,7 +8,8 @@
 module Gibbon.Common
        (
          -- * Variables
-         Var(..), LocVar, RegVar, fromVar, toVar, varAppend, toEndV, toSeqV, cleanFunName
+         Var(..), LocVar(..), Location
+       , RegVar, fromVar, toVar, varAppend, toEndV, toEndVLoc, toSeqV, cleanFunName
        , TyVar(..), isUserTv
        , Symbol, intern, unintern
 
@@ -29,7 +30,8 @@ module Gibbon.Common
 
          -- * Debugging/logging:
        , dbgLvl, dbgPrint, dbgPrintLn, dbgTrace, dbgTraceIt, minChatLvl
-       , internalError, dumpIfSet
+       , internalError, dumpIfSet, unwrapLocVar, singleLocVar
+
 
          -- * Establish conventions for the output of #lang gibbon:
        , truePrinted, falsePrinted
@@ -123,14 +125,22 @@ cleanFunName f =
           then c
           else '_'
         | c <- fromVar f ]
+
 toEndV :: Var -> Var
 toEndV = varAppend "end_"
 
+toEndVLoc :: LocVar -> LocVar 
+toEndVLoc loc = case loc of 
+                    Single v -> Single (toEndV v)
+
 toSeqV :: Var -> Var
 toSeqV v = varAppend v (toVar "_seq")
 
--- | Abstract location variables.
-type LocVar = Var
+-- | A location variable stores the abstract location. 
+type Location = Var
+
+data LocVar = Single Location
+  deriving (Show, Ord, Eq, Read, Generic, NFData, Out)
 
 -- | Abstract region variables.
 type RegVar = Var
@@ -491,3 +501,10 @@ truePrinted = "#t"
 
 falsePrinted :: String
 falsePrinted = "#f"
+
+unwrapLocVar :: LocVar -> Var
+unwrapLocVar locvar = case locvar of 
+                            Single loc -> loc
+
+singleLocVar :: Location -> LocVar 
+singleLocVar loc = Single loc 

gibbon-compiler/src/Gibbon/HaskellFrontend.hs

@@ -154,7 +154,7 @@ data TopLevel
   | HInline Var
   deriving (Show, Eq)
 
-type TopTyEnv = TyEnv TyScheme
+type TopTyEnv = TyEnv Var TyScheme
 type TypeSynEnv = M.Map TyCon Ty0
 
 desugarModule :: (Show a,  Pretty a)

gibbon-compiler/src/Gibbon/L0/Syntax.hs

@@ -497,7 +497,7 @@ isValidListElemTy0 ty
 -- Or we can have a special function just for L0, which is what recoverType is.
 -- ¯\_(ツ)_/¯
 --
-recoverType :: DDefs0 -> Env2 Ty0 -> Exp0 -> Ty0
+recoverType :: DDefs0 -> Env2 Var Ty0 -> Exp0 -> Ty0
 recoverType ddfs env2 ex =
   case ex of
     VarE v       -> M.findWithDefault (error $ "recoverType: Unbound variable " ++ show v) v (vEnv env2)

gibbon-compiler/src/Gibbon/L0/Typecheck.hs

@@ -846,9 +846,9 @@ instDataConTy ddefs dcon = do
 -- We can't directly use Env2 because of the way it's tied together with
 -- PreExp and the Expression class. We want to annotate L0 expressions
 -- with 'Ty0' but Gamma should store 'TyScheme's.
-type Gamma = TyEnv TyScheme
+type Gamma = TyEnv Var TyScheme
 
-instance FreeVars a => FreeVars (TyEnv a) where
+instance FreeVars a => FreeVars (TyEnv Var a) where
   gFreeVars env = foldr (S.union . gFreeVars) S.empty (M.elems env)
 
 --------------------------------------------------------------------------------

gibbon-compiler/src/Gibbon/L1/Syntax.hs

@@ -39,16 +39,16 @@ instance FunctionTy Ty1 where
 type Exp1 = PreExp E1Ext () Ty1
 
 -- | An L1 program.
-type Prog1 = Prog Exp1
+type Prog1 = Prog Var Exp1
 
 -- | Datatypes
 type DDefs1 = DDefs Ty1
 type DDef1  = DDef Ty1
 
 -- | Function definition used in L1 programs.
-type FunDef1 = FunDef Exp1
+type FunDef1 = FunDef Var Exp1
 
-type FunDefs1 = FunDefs Exp1
+type FunDefs1 = FunDefs Var Exp1
 
 -- | The type rperesentation used in L1.
 type Ty1 = UrTy ()

gibbon-compiler/src/Gibbon/L1/Typecheck.hs

@@ -31,7 +31,7 @@ import Prelude hiding (exp)
 
 -- | Typecheck a L1 expression
 --
-tcExp :: DDefs1 -> Env2 Ty1 -> Exp1 -> TcM Ty1 Exp1
+tcExp :: DDefs1 -> Env2 Var Ty1 -> Exp1 -> TcM Ty1 Exp1
 tcExp ddfs env exp =
   case exp of
     VarE v    -> lookupVar env v exp
@@ -799,12 +799,12 @@ instance (Out exp) => Out (TCError exp) where
 
 type TcM a exp =  Except (TCError exp) a
 
-extendEnv :: Env2 (UrTy l) -> [(Var, (UrTy l))] -> Env2 (UrTy l)
+extendEnv :: Env2 Var (UrTy l) -> [(Var, (UrTy l))] -> Env2 Var (UrTy l)
 extendEnv (Env2 vEnv fEnv) ((v,ty):rest) = extendEnv (Env2 (M.insert v ty vEnv) fEnv) rest
 extendEnv env [] = env
 
 
-lookupVar :: Env2 (UrTy l) -> Var -> PreExp e () (UrTy ()) -> TcM (UrTy l) (PreExp e () (UrTy ()))
+lookupVar :: Env2 Var (UrTy l) -> Var -> PreExp e () (UrTy ()) -> TcM (UrTy l) (PreExp e () (UrTy ()))
 lookupVar env var exp =
     case M.lookup var $ vEnv env of
       Nothing -> throwError $ VarNotFoundTC var exp
@@ -816,7 +816,7 @@ tcProj _ i (ProdTy tys) = return $ tys !!! i
 tcProj e _i ty = throwError $ GenericTC ("Projection from non-tuple type " ++ (sdoc ty)) e
 
 
-tcCases :: DDefs Ty1 -> Env2 Ty1 -> [(DataCon, [(Var, ())], Exp1)] -> TcM Ty1 Exp1
+tcCases :: DDefs Ty1 -> Env2 Var Ty1 -> [(DataCon, [(Var, ())], Exp1)] -> TcM Ty1 Exp1
 tcCases ddfs env cs = do
   tys <- forM cs $ \(c,args',rhs) -> do
            let args  = L.map fst args'
@@ -861,7 +861,7 @@ ensureEqualTy _exp IntTy CursorTy = return CursorTy
 ensureEqualTy exp a b = ensureEqual exp ("Expected these types to be the same: "
                                          ++ (sdoc a) ++ ", " ++ (sdoc b)) a b
 
-ensureArenaScope :: MonadError (TCError exp) m => exp -> Env2 a -> Maybe Var -> m ()
+ensureArenaScope :: MonadError (TCError exp) m => exp -> Env2 Var a -> Maybe Var -> m ()
 ensureArenaScope exp env ar =
     case ar of
       Nothing -> throwError $ GenericTC "Expected arena annotation" exp