Literal -> Lit, LitE -> Lit

This commit is contained in:
crumbtoo
2023-12-18 15:36:17 -07:00
parent 585130cfac
commit 136e3687b0
5 changed files with 12 additions and 12 deletions

View File

@@ -123,7 +123,7 @@ Alter :: { Alter Name }
Alter : litint ParList '->' Expr { Alter (AltData $1) $2 $4 } Alter : litint ParList '->' Expr { Alter (AltData $1) $2 $4 }
Expr1 :: { Expr Name } Expr1 :: { Expr Name }
Expr1 : litint { LitE $ IntL $1 } Expr1 : litint { Lit $ IntL $1 }
| Id { Var $1 } | Id { Var $1 }
| PackCon { $1 } | PackCon { $1 }
| ExprPragma { $1 } | ExprPragma { $1 }

View File

@@ -7,7 +7,7 @@ Description : Core ASTs and the like
module Core.Syntax module Core.Syntax
( Expr(..) ( Expr(..)
, Type(..) , Type(..)
, Literal(..) , Lit(..)
, pattern (:$) , pattern (:$)
, Binding(..) , Binding(..)
, AltCon(..) , AltCon(..)
@@ -47,7 +47,7 @@ data Expr b = Var Name
| Lam [b] (Expr b) | Lam [b] (Expr b)
| Let Rec [Binding b] (Expr b) | Let Rec [Binding b] (Expr b)
| App (Expr b) (Expr b) | App (Expr b) (Expr b)
| LitE Literal | Lit Lit
| Type Type | Type Type
deriving (Show, Read, Lift) deriving (Show, Read, Lift)
@@ -87,11 +87,11 @@ data Rec = Rec
deriving (Show, Read, Eq, Lift) deriving (Show, Read, Eq, Lift)
data AltCon = AltData Tag data AltCon = AltData Tag
| AltLiteral Literal | AltLit Lit
| Default | Default
deriving (Show, Read, Eq, Lift) deriving (Show, Read, Eq, Lift)
data Literal = IntL Int data Lit = IntL Int
deriving (Show, Read, Eq, Lift) deriving (Show, Read, Eq, Lift)
type Name = String type Name = String

View File

@@ -32,7 +32,7 @@ rhssOf = fromList . fmap f
isAtomic :: Expr b -> Bool isAtomic :: Expr b -> Bool
isAtomic (Var _) = True isAtomic (Var _) = True
isAtomic (LitE _) = True isAtomic (Lit _) = True
isAtomic _ = False isAtomic _ = False
---------------------------------------------------------------------------------- ----------------------------------------------------------------------------------

View File

@@ -55,7 +55,7 @@ floatNonStrictCases g = goE
where where
goE :: Expr' -> Floater Expr' goE :: Expr' -> Floater Expr'
goE (Var k) = pure (Var k) goE (Var k) = pure (Var k)
goE (LitE l) = pure (LitE l) goE (Lit l) = pure (Lit l)
goE (Case e as) = pure (Case e as) goE (Case e as) = pure (Case e as)
goE (Let Rec bs e) = Let Rec <$> bs' <*> goE e goE (Let Rec bs e) = Let Rec <$> bs' <*> goE e
where bs' = travBs goE bs where bs' = travBs goE bs
@@ -77,7 +77,7 @@ floatNonStrictCases g = goE
goC (f :$ x) = (:$) <$> goC f <*> goC x goC (f :$ x) = (:$) <$> goC f <*> goC x
goC (Let r bs e) = Let r <$> bs' <*> goE e goC (Let r bs e) = Let r <$> bs' <*> goE e
where bs' = travBs goC bs where bs' = travBs goC bs
goC (LitE l) = pure (LitE l) goC (Lit l) = pure (Lit l)
goC (Var k) = pure (Var k) goC (Var k) = pure (Var k)
goC (Con t as) = pure (Con t as) goC (Con t as) = pure (Con t as)

View File

@@ -617,7 +617,7 @@ buildInitialHeap (Program ss) = mapAccumL allocateSc mempty compiledScs
f (NameKey n, _) = Just n f (NameKey n, _) = Just n
f _ = Nothing f _ = Nothing
compileC _ (LitE l) = compileCL l compileC _ (Lit l) = compileCL l
-- >> [ref/compileC] -- >> [ref/compileC]
compileC g (App f x) = compileC g x compileC g (App f x) = compileC g x
@@ -661,16 +661,16 @@ buildInitialHeap (Program ss) = mapAccumL allocateSc mempty compiledScs
compileC _ _ = error "yet to be implemented!" compileC _ _ = error "yet to be implemented!"
compileCL :: Literal -> Code compileCL :: Lit -> Code
compileCL (IntL n) = [PushInt n] compileCL (IntL n) = [PushInt n]
compileEL :: Literal -> Code compileEL :: Lit -> Code
compileEL (IntL n) = [PushInt n] compileEL (IntL n) = [PushInt n]
-- compile an expression in a strict context such that a pointer to the -- compile an expression in a strict context such that a pointer to the
-- expression is left on top of the stack in WHNF -- expression is left on top of the stack in WHNF
compileE :: Env -> Expr' -> Code compileE :: Env -> Expr' -> Code
compileE _ (LitE l) = compileEL l compileE _ (Lit l) = compileEL l
compileE g (Let NonRec bs e) = compileE g (Let NonRec bs e) =
-- we use compileE instead of compileC -- we use compileE instead of compileC
mconcat binders <> compileE g' e <> [Slide d] mconcat binders <> compileE g' e <> [Slide d]