msyds/rlp
1
0
Fork 0
Code Issues 4 Pull Requests Actions Packages Projects Releases 2 Wiki Activity

lt

Browse Source
This commit is contained in:
crumbtoo
2024-02-12 07:34:16 -07:00
parent f53d42bf84
commit dfad80b163
1 changed files with 6 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
src/GM.hs
View File

@@ -89,7 +89,7 @@ data Instr = Unwind
-- arith -- arith
| Neg | Add | Sub | Mul | Div | Neg | Add | Sub | Mul | Div
-- comparison -- comparison
| Equals | Equals | Lesser
| Pack Tag Int -- Pack Tag Arity | Pack Tag Int -- Pack Tag Arity
| CaseJump [(Tag, Code)] | CaseJump [(Tag, Code)]
| Split Int | Split Int
@@ -212,6 +212,7 @@ step st = case head (st ^. gmCode) of
Mul -> mulI Mul -> mulI
Div -> divI Div -> divI
Equals -> equalsI Equals -> equalsI
Lesser -> lesserI
Split n -> splitI n Split n -> splitI n
Pack t n -> packI t n Pack t n -> packI t n
CaseJump as -> caseJumpI as CaseJump as -> caseJumpI as
@@ -411,8 +412,9 @@ step st = case head (st ^. gmCode) of
mulI = primitive2 boxInt unboxInt (*) st mulI = primitive2 boxInt unboxInt (*) st
divI = primitive2 boxInt unboxInt div st divI = primitive2 boxInt unboxInt div st
equalsI :: GmState lesserI, equalsI :: GmState
equalsI = primitive2 boxBool unboxInt (==) st equalsI = primitive2 boxBool unboxInt (==) st
lesserI = primitive2 boxBool unboxInt (<) st
splitI :: Int -> GmState splitI :: Int -> GmState
splitI n = st splitI n = st
@@ -595,6 +597,7 @@ compiledPrims =
, binop "*#" Mul , binop "*#" Mul
, binop "/#" Div , binop "/#" Div
, binop "==#" Equals , binop "==#" Equals
, binop "<#" Lesser
] ]
where where
unop k i = (k, 1, [Push 0, Eval, i, Update 1, Pop 1, Unwind]) unop k i = (k, 1, [Push 0, Eval, i, Update 1, Pop 1, Unwind])
@@ -733,6 +736,7 @@ buildInitialHeap (view programScDefs -> ss) = mapAccumL allocateSc mempty compil
compileE g ("*#" :$ a :$ b) = inlineOp2 g Mul a b compileE g ("*#" :$ a :$ b) = inlineOp2 g Mul a b
compileE g ("/#" :$ a :$ b) = inlineOp2 g Div a b compileE g ("/#" :$ a :$ b) = inlineOp2 g Div a b
compileE g ("==#" :$ a :$ b) = inlineOp2 g Equals a b compileE g ("==#" :$ a :$ b) = inlineOp2 g Equals a b
compileE g ("<#" :$ a :$ b) = inlineOp2 g Lesser a b
compileE g (Case e as) = compileE g e <> [CaseJump (compileD g as)] compileE g (Case e as) = compileE g e <> [CaseJump (compileD g as)]