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

dyadic arith primitives work for unevaluated args

Browse Source 
sloppy code! rewrite this lol..
This commit is contained in:
crumbtoo
2023-11-13 21:51:41 -07:00
parent c0021937c5
commit 6f19d112e3
1 changed files with 13 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
src/TI.hs
View File

@@ -184,7 +184,7 @@ step st =
case hLookupUnsafe ap h of case hLookupUnsafe ap h of
-- rule 2.8 -- rule 2.8
NAp f (hViewUnsafe h -> NInd a) -> NAp f (hViewUnsafe h -> NInd a) ->
TiState (ap:s) d h' g 666 TiState (ap:s) d h' g sts
where where
h' = (update h ap $ NAp f a) h' = (update h ap $ NAp f a)
-- this is bad rewrite later :3 -- this is bad rewrite later :3
@@ -237,14 +237,23 @@ primBinOp f (TiState s d h g sts) =
True -> case isDataNode yarg of True -> case isDataNode yarg of
True -> TiState s' d h' g sts True -> TiState s' d h' g sts
where where
h' = update h rootAddr (NNum $ x+y) h' = update h rootAddr (NNum $ x `f` y)
rootAddr = head s' rootAddr = head s'
-- number of arguments -- number of arguments
s' = drop 2 s s' = drop 2 s
NNum x = xarg NNum x = xarg
NNum y = xarg NNum y = yarg
False -> TiState s' d' h g sts
where
d' = drop 2 s : d
s' = [yAddr]
False -> TiState s' d' h g sts
where
d' = drop 1 s : d
s' = [xAddr]
where where
[xAddr,yAddr] = getArgs h s [xAddr,yAddr] = getArgs h s
xarg = hLookupUnsafe xAddr h xarg = hLookupUnsafe xAddr h
@@ -357,6 +366,7 @@ instance Pretty TiState where
<> sheap <> IBreak <> sheap <> IBreak
where where
showAddr a = IStr (show a) <> ": " <> pnode (hLookupUnsafe a h) 0 showAddr a = IStr (show a) <> ": " <> pnode (hLookupUnsafe a h) 0
-- showAddr a = IStr (show a) <> ": " <> IStr (show (hLookupUnsafe a h))
sheap = mconcat $ ((<>IBreak) . showAddr) <$> addresses h sheap = mconcat $ ((<>IBreak) . showAddr) <$> addresses h
pnode :: Node -> Int -> ISeq pnode :: Node -> Int -> ISeq
@@ -377,17 +387,3 @@ instance Pretty TiState where
pnode (NPrim n _) _ = IStr n pnode (NPrim n _) _ = IStr n
-- pnoderef :: Addr -> Int -> ISeq
-- pnoderef a p = bracketPrec 0 p $
-- IStr (show a) <> " -> " <> pnode (hLookupUnsafe a h) 0
-- pnode :: Node -> Int -> ISeq
-- pnode (NAp f x) p = bracketPrec 0 p $
-- "NAp " <> pnoderef f (succ p) <> pnoderef x (succ p)
-- pnode (NSupercomb n _ _) p = bracketPrec 0 p $
-- "NSupercomb " <> IStr n
-- pnode (NNum n) p = bracketPrec 0 p $
-- "NNum " <> IStr (show n)
-- pnode (NInd a) p = bracketPrec 0 p $
-- "NInd " <> pnoderef a p