rc #13
13
src/GM.hs
13
src/GM.hs
@@ -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
|
||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user