@@ -4,7 +4,10 @@ module Nock (tar, hax, fas, cell, atom, Annotation (..), Noun, RawNoun (..)) whe
5import Control.DeepSeq (NFData)
5import Control.DeepSeq (NFData)
6import Data.Hashable
6import Data.Hashable
7+import Data.MemoTrie (memo)
8+import Debug.Trace (traceShowId)
7import GHC.Generics (Generic)
9import GHC.Generics (Generic)
10+import GHC.Word (Word64)
8import Numeric.Natural
11import Numeric.Natural
10data Annotation = Annotation
13data Annotation = Annotation
@@ -80,29 +83,34 @@ lus ~(Atom nat _) = atom (nat + 1)
80tis :: Noun -> Noun -> Noun
83tis :: Noun -> Noun -> Noun
81tis lhs rhs = if hashEq lhs rhs then sig else one
84tis lhs rhs = if hashEq lhs rhs then sig else one
83−fas :: Natural -> Noun -> Noun
86+fas' :: Word64 -> Noun -> Noun
84−fas lhs rhs =
87+fas' n = case (traceShowId n) of
85− case lhs of
88+ 1 -> id
88− ~(Cell lhs' _ _) -> lhs'
89+ 2 -> \ ~(Cell x _ _) -> x
90− ~(Cell _ rhs' _) -> rhs'
90+ 3 -> \ ~(Cell _ x _) -> x
93− let (d, m) = divMod n 2
92+ let (d, m) = divMod n 2
94− in if m == 0
94+ in if m == 0
95− then fas 2 (fas d rhs)
95+ then \x ->
96− else fas 3 (fas d rhs)
99+ else \x ->
97− _ -> undefined
100+ ( case next x of
104+fas :: Word64 -> Noun -> Noun
99hax :: Natural -> Noun -> Noun -> Noun
107hax :: Natural -> Noun -> Noun -> Noun
100hax n b c =
108hax n b c =
101 let (a, m) = divMod n 2
109 let (a, m) = divMod n 2
102 in case n of
110 in case n of
104− _ | m == 0 -> hax a (cell b (fas (a + a + 1) c)) c
112+ _ | m == 0 -> hax a (cell b (fas (fromIntegral $ a + a + 1) c)) c
105− _ -> hax a (cell (fas (a + a) c) b) c
113+ _ -> hax a (cell (fas (fromIntegral $ a + a) c) b) c
107tar :: Noun -> Noun
115tar :: Noun -> Noun
108tar ~(Cell subject ~(Cell a b _) _) = tar' a b subject
116tar ~(Cell subject ~(Cell a b _) _) = tar' a b subject
@@ -113,7 +121,7 @@ tar' b c subject = case b of
113 ~(Cell l k _) -> cell (tar' x y subject) (tar' l k subject)
121 ~(Cell l k _) -> cell (tar' x y subject) (tar' l k subject)
114 Atom n _ -> case n of
122 Atom n _ -> case n of
115 0 -> case c of
123 0 -> case c of
116− ~(Atom nat _) -> fas nat subject
124+ ~(Atom nat _) -> fas (fromIntegral nat) subject
118 3 -> case c of
126 3 -> case c of
119 ~(Cell l k _) -> wut $ tar' l k subject
127 ~(Cell l k _) -> wut $ tar' l k subject