@@ -1,6 +1,6 @@
11{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
22
3−module Nock (tar, hax, fas, cell, atom, Annotation (..), Noun, RawNoun (..), pretty) where
3+module Nock (tar, hax, fas, cell, atom, Annotation (..), Noun, RawNoun (..)) where
44
55import Control.DeepSeq (NFData, force)
66import Data.Bits
@@ -13,24 +13,8 @@ import GHC.Base
1313import GHC.Conc (par)
1414import GHC.Generics (Generic)
1515import GHC.Num
16−
17−newtype Annotation = Annotation
18− { hash :: Int
19− }
20− deriving stock (Show, Generic)
21− deriving anyclass (NFData)
22−
23−atom :: Natural -> Noun
24−atom nat = Atom nat Annotation {hash = hash nat}
25−
26−cell :: Noun -> Noun -> Noun
27−cell lhs rhs =
28− Cell
29− lhs
30− rhs
31− Annotation
32− { hash = hash ((annotation lhs).hash, (annotation rhs).hash)
33− }
16+import Nock.Jets
17+import Nock.Types
3418
3519sig :: Noun
3620sig = atom 0
@@ -53,37 +37,6 @@ twoThree = cell two three
5337sigOne :: Noun
5438sigOne = cell sig one
5539
56−annotation :: RawNoun ann -> ann
57−annotation (Atom _ ann) = ann
58−annotation (Cell _ _ ann) = ann
59−
60−data RawNoun ann
61− = Atom !Natural ann
62− | Cell (RawNoun ann) (RawNoun ann) ann
63− deriving stock (Generic)
64− deriving anyclass (NFData)
65−
66−instance Show (RawNoun ann) where
67− show = TL.unpack . pretty
68−
69−instance Eq (RawNoun ann) where
70− (Atom lhs _) == (Atom rhs _) = lhs == rhs
71− (Cell lhslhs lhsrhs _) == (Cell rhslhs rhsrhs _) =
72− let rhsRes = lhsrhs == rhsrhs
73− in (force rhsRes `par` lhslhs == rhslhs) && rhsRes
74− _ == _ = False
75−
76−hashEq :: Noun -> Noun -> Bool
77−hashEq (Atom lhsNat lhsAnn) (Atom rhsNat rhsAnn) =
78− let normalEq = lhsNat == rhsNat
79− in (force normalEq `par` lhsAnn.hash == rhsAnn.hash) && normalEq
80−hashEq (Cell lhslhs lhsrhs lhsAnn) (Cell rhslhs rhsrhs rhsAnn) =
81− let normalEq = hashEq lhslhs rhslhs && hashEq lhsrhs rhsrhs
82− in (force normalEq `par` lhsAnn.hash == rhsAnn.hash) && normalEq
83−hashEq _ _ = False
84−
85−type Noun = RawNoun Annotation
86−
8740wut :: Noun -> Noun
8841wut Cell {} = sig
8942wut Atom {} = one
@@ -149,9 +102,14 @@ tar' b c subject = case b of
149102 4## -> case c of
150103 ~(Cell l k _) -> lus $ tar' l k subject
151104 _ -> case c of
152− ~(Cell x ~formula@(Cell h j _) _) -> case n of
153− 2## -> case (tar' h j subject, x) of
154− ~(~(Cell u v _), ~(Cell l k _)) -> tar' u v (tar' l k subject)
105+ ~(Cell x ~(Cell h j _) _) -> case n of
106+ 2## -> case x of
107+ ~(Cell l k _) -> case tar' l k subject of
108+ ~(formula@(Cell battery ~(Cell sample _ _) _)) ->
109+ if battery == Nock.Jets.dec
110+ then error "Found it!"
111+ else case (tar' h j subject) of
112+ ~(Cell u v _) -> tar' u v formula
155113 5## -> case x of
156114 ~(Cell l k _) -> tis (tar' h j subject) (tar' l k subject)
157115 7## -> case x of
@@ -164,14 +122,6 @@ tar' b c subject = case b of
164122 10## -> case x of
165123 ~(Cell ~(Atom b' _) ~(Cell u v _) _) -> hax b' (tar' u v subject) (tar' h j subject)
166124 11## -> case x of
167− Cell _ ~(Cell u v _) _ -> traceShow (formula, subject) $ tar' h j subject
125+ Cell _ ~(Cell u v _) _ -> tar' h j subject
168126 Atom _ _ -> tar' h j subject
169127 _ -> undefined
170−
171−pretty :: RawNoun ann -> TL.Text
172−pretty noun = TLB.toLazyText $ pretty' noun False
173−
174−pretty' :: RawNoun ann -> Bool -> TLB.Builder
175−pretty' (Atom a _) _ = TLB.decimal a
176−pretty' (Cell lhs rhs _) True = pretty' lhs False <> " " <> pretty' rhs True
177−pretty' (Cell lhs rhs _) False = "[" <> pretty' lhs False <> " " <> pretty' rhs True <> "]"