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

constants for bool tags

Browse Source
This commit is contained in:
crumbtoo
2024-02-12 09:47:16 -07:00
parent 941f228c6c
commit 8ac301aa48
1 changed files with 20 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
src/GM.hs
View File

@@ -40,6 +40,12 @@ import Core2Core
import Core import Core
---------------------------------------------------------------------------------- ----------------------------------------------------------------------------------
tag_Bool_True :: Int
tag_Bool_True = 1
tag_Bool_False :: Int
tag_Bool_False = 0
{-} {-}
hdbgProg = undefined hdbgProg = undefined
@@ -195,24 +201,24 @@ isFinal st = null $ st ^. gmCode
step :: GmState -> GmState step :: GmState -> GmState
step st = case head (st ^. gmCode) of step st = case head (st ^. gmCode) of
Unwind -> unwindI Unwind -> unwindI
PushGlobal n -> pushGlobalI n PushGlobal n -> pushGlobalI n
PushConstr t n -> pushConstrI t n PushConstr t n -> pushConstrI t n
PushInt n -> pushIntI n PushInt n -> pushIntI n
Push n -> pushI n Push n -> pushI n
MkAp -> mkApI MkAp -> mkApI
Slide n -> slideI n Slide n -> slideI n
Pop n -> popI n Pop n -> popI n
Update n -> updateI n Update n -> updateI n
Alloc n -> allocI n Alloc n -> allocI n
Eval -> evalI Eval -> evalI
Neg -> negI Neg -> negI
Add -> addI Add -> addI
Sub -> subI Sub -> subI
Mul -> mulI Mul -> mulI
Div -> divI Div -> divI
Equals -> equalsI Equals -> equalsI
Lesser -> lesserI 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
@@ -556,12 +562,13 @@ boxBool st p = st
where where
h = st ^. gmHeap h = st ^. gmHeap
(h',a) = alloc h (NConstr p' []) (h',a) = alloc h (NConstr p' [])
p' = if p then 1 else 0 p' = if p then tag_Bool_True else tag_Bool_False
unboxBool :: Addr -> GmState -> Bool unboxBool :: Addr -> GmState -> Bool
unboxBool a st = case hLookup a h of unboxBool a st = case hLookup a h of
Just (NConstr 1 []) -> True Just (NConstr t [])
Just (NConstr 0 []) -> False | t == tag_Bool_True -> True
| t == tag_Bool_False -> False
Just _ -> error "unboxInt received a non-int" Just _ -> error "unboxInt received a non-int"
Nothing -> error "unboxInt received an invalid address" Nothing -> error "unboxInt received an invalid address"
where h = st ^. gmHeap where h = st ^. gmHeap