we fucking did it gamers (negation)
This commit is contained in:
48
src/TI.hs
48
src/TI.hs
@@ -183,11 +183,10 @@ step st =
|
|||||||
apStep f _ (TiState (ap:s) d h g sts) =
|
apStep f _ (TiState (ap:s) d h g sts) =
|
||||||
case hLookupUnsafe ap h of
|
case hLookupUnsafe ap h of
|
||||||
-- rule 2.8
|
-- rule 2.8
|
||||||
NAp f (hViewUnsafe h -> NInd x') ->
|
NAp f (hViewUnsafe h -> NInd a) ->
|
||||||
TiState (ap:s) d h' g sts
|
TiState (ap:s) d h' g 666
|
||||||
where
|
where
|
||||||
h' = (update h x $ NAp f x')
|
h' = (update h ap $ NAp f a)
|
||||||
NAp _ x = hLookupUnsafe ap h
|
|
||||||
-- this is bad rewrite later :3
|
-- this is bad rewrite later :3
|
||||||
|
|
||||||
_ ->
|
_ ->
|
||||||
@@ -210,42 +209,35 @@ step st =
|
|||||||
TiState (a:s) d h g sts
|
TiState (a:s) d h g sts
|
||||||
|
|
||||||
primStep :: Name -> Prim -> TiState -> TiState
|
primStep :: Name -> Prim -> TiState -> TiState
|
||||||
primStep n IntNegP (TiState (a:s) d h g sts) =
|
primStep n IntNegP (TiState s d h g sts) =
|
||||||
case s of
|
case isDataNode arg of
|
||||||
-- (rule 2.5)
|
True -> TiState s'' d h' g sts
|
||||||
[hViewUnsafe h -> NAp _ (hViewUnsafe h -> NNum b)] ->
|
|
||||||
TiState s' d h' g sts
|
|
||||||
where
|
where
|
||||||
h' = update h a1 (NNum (-b))
|
h' = update h rootAddr (NNum $ negate n)
|
||||||
s' = [a1]
|
s'' = rootAddr : s'
|
||||||
a1 = head s
|
(_:rootAddr:s') = s
|
||||||
|
NNum n = arg
|
||||||
|
|
||||||
-- (rule 2.6)
|
False -> TiState s'' d' h g sts
|
||||||
[hViewUnsafe h -> NAp a1@(hViewUnsafe h -> NPrim _ IntNegP) b] ->
|
|
||||||
TiState s' d' h g sts
|
|
||||||
where
|
where
|
||||||
s' = [b]
|
s'' = b : s'
|
||||||
|
NAp _ b = hLookupUnsafe a1 h
|
||||||
|
-- a1 is an NAp
|
||||||
|
(_:a1:s') = s
|
||||||
d' = [a1] : d
|
d' = [a1] : d
|
||||||
|
where
|
||||||
x -> error $ show x
|
[argAddr] = getArgs h s
|
||||||
|
arg = hLookupUnsafe argAddr h
|
||||||
-- -- (rule 2.6)
|
|
||||||
-- [view -> NAp (view -> NPrim _ IntNegP) b] ->
|
|
||||||
-- TiState s' d' h g sts
|
|
||||||
-- where
|
|
||||||
-- d' = [a,a1] : d
|
|
||||||
-- s' = [b]
|
|
||||||
-- a1 = head s
|
|
||||||
|
|
||||||
getArgs :: TiHeap -> [Addr] -> [Addr]
|
getArgs :: TiHeap -> [Addr] -> [Addr]
|
||||||
getArgs h (_:s) = fmap f s
|
getArgs h (_:s) = fmap f s
|
||||||
where
|
where
|
||||||
f addr = case hLookupUnsafe addr h of
|
f addr = case hLookupUnsafe addr h of
|
||||||
NAp _ arg -> arg
|
NAp _ arg -> arg
|
||||||
_ -> error "glados yuri"
|
_ -> error $ "major uh-oh: " ++ show addr
|
||||||
|
|
||||||
isFinal :: TiState -> Bool
|
isFinal :: TiState -> Bool
|
||||||
isFinal (TiState [addr] _ h _ _) =
|
isFinal (TiState [addr] [] h _ _) =
|
||||||
case hLookup addr h of
|
case hLookup addr h of
|
||||||
Just a -> isDataNode a
|
Just a -> isDataNode a
|
||||||
_ -> error "isFinal: segfault!"
|
_ -> error "isFinal: segfault!"
|
||||||
|
|||||||
Reference in New Issue
Block a user