Literal -> Lit, LitE -> Lit
This commit is contained in:
@@ -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 }
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
----------------------------------------------------------------------------------
|
----------------------------------------------------------------------------------
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|
||||||
|
|||||||
@@ -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]
|
||||||
|
|||||||
Reference in New Issue
Block a user