Skip to content

Commit

Permalink
get rid of all warnings
Browse files Browse the repository at this point in the history
  • Loading branch information
@vidsinghal
vidsinghal committed Nov 19, 2024
1 parent e9c3f64 commit 6251fe8
Show file tree
Hide file tree
Showing 5 changed files with 121 additions and 2 deletions.
11 changes: 11 additions & 0 deletions gibbon-compiler/src/Gibbon/L1/Syntax.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -114,6 +114,17 @@ instance Typeable (E1Ext () (UrTy ())) where
Just (PackedTy{}) -> CursorTy
ty -> error $ "StartOfPkdCursor: got " ++ show ty

gRecoverTypeLoc _ddefs env2 ext =
case ext of
BenchE fn _ _ _ -> outTy $ fEnv env2 # (singleLocVar fn)
AddFixed v _i -> if M.member (singleLocVar v) (vEnv env2)
then CursorTy
else error $ "AddFixed: unbound variable " ++ show v
StartOfPkdCursor cur ->
case M.lookup (singleLocVar cur) (vEnv env2) of
Just (PackedTy{}) -> CursorTy
ty -> error $ "StartOfPkdCursor: got " ++ show ty

instance Renamable () where
gRename _ () = ()

Expand Down
5 changes: 5 additions & 0 deletions gibbon-compiler/src/Gibbon/L3/Syntax.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -156,6 +156,11 @@ instance (Out l, Show l, Typeable (PreExp E3Ext l (UrTy l))) => Typeable (E3Ext
gRecoverType ddfs env2 (RetE ls) = ProdTy $ L.map (gRecoverType ddfs env2) ls
gRecoverType _ _ _ = error "L3.gRecoverType"


gRecoverTypeLoc _ddfs _env2 NullCursor = CursorTy
gRecoverTypeLoc ddfs env2 (RetE ls) = ProdTy $ L.map (gRecoverTypeLoc ddfs env2) ls
gRecoverTypeLoc _ _ _ = error "L3.gRecoverTypeLoc"

instance (Show l, Out l) => Flattenable (E3Ext l (UrTy l)) where
gFlattenGatherBinds _ddfs _env ex = return ([], ex)
gFlattenExp _ddfs _env ex = return ex
Expand Down
36 changes: 36 additions & 0 deletions gibbon-compiler/src/Gibbon/Language.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -151,6 +151,42 @@ instance (Show (), Out (),
args' = L.map fst args
in gRecoverType ddfs (extendsVEnv (M.fromList (zip args' (lookupDataCon ddfs c))) env2) e

gRecoverTypeLoc ddfs env2 ex =
case ex of
VarE v -> M.findWithDefault (error $ "Cannot find type of variable " ++ show v ++ " in " ++ show (vEnv env2)) (singleLocVar v) (vEnv env2)
LitE _ -> IntTy
CharE _ -> CharTy
FloatE{} -> FloatTy
LitSymE _ -> SymTy
AppE v _ _ -> outTy $ fEnv env2 # (singleLocVar v)
PrimAppE (DictInsertP ty) ((VarE v):_) -> SymDictTy (Just v) $ stripTyLocs ty
PrimAppE (DictEmptyP ty) ((VarE v):_) -> SymDictTy (Just v) $ stripTyLocs ty
PrimAppE p _ -> primRetTy p

LetE (v,_,t,_) e -> gRecoverTypeLoc ddfs (extendVEnvLocVar (singleLocVar v) t env2) e
IfE _ e _ -> gRecoverTypeLoc ddfs env2 e
MkProdE es -> ProdTy $ L.map (gRecoverTypeLoc ddfs env2) es
DataConE loc c _ -> PackedTy (getTyOfDataCon ddfs c) loc
TimeIt e _ _ -> gRecoverTypeLoc ddfs env2 e
MapE _ e -> gRecoverTypeLoc ddfs env2 e
FoldE _ _ e -> gRecoverTypeLoc ddfs env2 e
Ext ext -> gRecoverTypeLoc ddfs env2 ext
ProjE i e ->
case gRecoverTypeLoc ddfs env2 e of
(ProdTy tys) -> tys !! i
oth -> error$ "typeExp: Cannot project fields from this type: "++show oth
++"\nExpression:\n "++ sdoc ex
++"\nEnvironment:\n "++sdoc (vEnv env2)
WithArenaE _v e -> gRecoverTypeLoc ddfs env2 e
SpawnE v _ _ -> outTy $ fEnv env2 # (singleLocVar v)
SyncE -> voidTy
CaseE _ mp ->
let

(c,args,e) = Sf.headErr mp
args' = L.map (singleLocVar . fst) args
in gRecoverTypeLoc ddfs (extendsVEnvLocVar (M.fromList (zip args' (lookupDataCon ddfs c))) env2) e


instance Renamable Var where
gRename env v = M.findWithDefault v v env
Expand Down
2 changes: 0 additions & 2 deletions gibbon-compiler/src/Gibbon/Language/Syntax.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -606,8 +606,6 @@ data UrTy loc
class FreeVars a where
-- | Return a set of free TERM variables. Does not return location variables.
gFreeVars :: a -> S.Set Var
gFreeVars' :: a -> S.Set LocVar


-- | A generic interface to expressions found in different phases of
-- the compiler.
Expand Down
69 changes: 69 additions & 0 deletions gibbon-compiler/src/Gibbon/NewL2/Syntax.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -164,6 +164,28 @@ instance Typeable (Old.E2Ext LocArg Ty2) where
Old.SSPush{} -> MkTy2 $ ProdTy []
Old.SSPop{} -> MkTy2 $ ProdTy []

gRecoverTypeLoc ddfs env2 ex =
case ex of
Old.LetRegionE _r _ _ bod -> gRecoverTypeLoc ddfs env2 bod
Old.LetParRegionE _r _ _ bod -> gRecoverTypeLoc ddfs env2 bod
Old.StartOfPkdCursor{} -> MkTy2 $ CursorTy
Old.TagCursor{} -> MkTy2 $ CursorTy
Old.LetLocE _l _rhs bod -> gRecoverTypeLoc ddfs env2 bod
Old.RetE _loc var -> case M.lookup (singleLocVar var) (vEnv env2) of
Just ty -> ty
Nothing -> error $ "gRecoverType: unbound variable " ++ sdoc var
Old.FromEndE _loc -> error "Shouldn't enconter FromEndE in tail position"
Old.BoundsCheck{} -> error "Shouldn't enconter BoundsCheck in tail position"
Old.IndirectionE tycon _ _ (to,_) _ -> MkTy2 $ PackedTy tycon (toLocVar to)
Old.AddFixed{} -> error "Shouldn't enconter AddFixed in tail position"
Old.GetCilkWorkerNum -> MkTy2 $ IntTy
Old.LetAvail _ bod -> gRecoverTypeLoc ddfs env2 bod
Old.AllocateTagHere{} -> MkTy2 $ ProdTy []
Old.AllocateScalarsHere{} -> MkTy2 $ ProdTy []
Old.SSPush{} -> MkTy2 $ ProdTy []
Old.SSPop{} -> MkTy2 $ ProdTy []



-- | The 'gRecoverType' instance defined in Language.Syntax is incorrect for L2.
-- For the AppE case, it'll just return the type with with the function was
Expand Down Expand Up @@ -225,6 +247,53 @@ instance Out (Old.E2Ext LocArg Ty2) => Typeable (PreExp Old.E2Ext LocArg Ty2) wh
env2' = extendPatternMatchEnv c ddfs vars locs env2
in gRecoverType ddfs env2' e


gRecoverTypeLoc ddfs env2 ex =
case ex of
VarE v -> M.findWithDefault (error $ "Cannot find type of variable " ++ show v ++ " in " ++ show (vEnv env2)) (singleLocVar v) (vEnv env2)
LitE _ -> MkTy2 $ IntTy
CharE _ -> MkTy2 $ CharTy
FloatE{} -> MkTy2 $ FloatTy
LitSymE _ -> MkTy2 $ SymTy
AppE v locargs _ ->
let fnty = fEnv env2 # (singleLocVar v)
outty = Old.arrOut fnty
mp = M.fromList $ zip (Old.allLocVars fnty) (map toLocVar locargs)
in substLoc mp outty

PrimAppE (DictInsertP ty) ((VarE v):_) -> MkTy2 $ SymDictTy (Just v) $ stripTyLocs (unTy2 ty)
PrimAppE (DictEmptyP ty) ((VarE v):_) -> MkTy2 $ SymDictTy (Just v) $ stripTyLocs (unTy2 ty)
PrimAppE p _ -> MkTy2 $ primRetTy (fmap unTy2 p)

LetE (v,_,t,_) e -> gRecoverTypeLoc ddfs (extendVEnvLocVar (singleLocVar v) t env2) e
IfE _ e _ -> gRecoverTypeLoc ddfs env2 e
MkProdE es -> MkTy2 $ ProdTy $ L.map (unTy2 . gRecoverTypeLoc ddfs env2) es
DataConE loc c _ -> MkTy2 $ PackedTy (getTyOfDataCon ddfs c) (toLocVar loc)
TimeIt e _ _ -> gRecoverTypeLoc ddfs env2 e
MapE _ e -> gRecoverTypeLoc ddfs env2 e
FoldE _ _ e -> gRecoverTypeLoc ddfs env2 e
Ext ext -> gRecoverTypeLoc ddfs env2 ext
ProjE i e ->
case unTy2 $ gRecoverTypeLoc ddfs env2 e of
(ProdTy tys) -> MkTy2 $ (tys !! i)
oth -> error$ "typeExp: Cannot project fields from this type: "++show oth
++"\nExpression:\n "++ sdoc ex
++"\nEnvironment:\n "++sdoc (vEnv env2)
SpawnE v locargs _ ->
let fnty = fEnv env2 # (singleLocVar v)
outty = Old.arrOut fnty
mp = M.fromList $ zip (Old.allLocVars fnty) (map toLocVar locargs)
in substLoc mp outty
SyncE -> MkTy2 $ voidTy
WithArenaE _v e -> gRecoverTypeLoc ddfs env2 e
CaseE _ mp ->
let (c,vlocargs,e) = Sf.headErr mp
(vars,locargs) = unzip vlocargs
locs = map toLocVar locargs

env2' = extendPatternMatchEnvLocVar c ddfs vars locs env2
in gRecoverTypeLoc ddfs env2' e

-------------------------------------------------------------------------------
-- Need to redefine the following because of the Ty2 newtype:

Expand Down

0 comments on commit 6251fe8

Please sign in to comment.