module Nock.Eval ( nock , eval ) where import Nock.Language data Error = Error Noun deriving Show type Possibly = Either Error nock :: Noun -> Possibly Noun nock = tar eval :: Expr -> Possibly Noun eval expr = case expr of Noun noun -> return noun Wut e -> wut e Lus e -> lus e Tis e -> tis e Net e -> net e Hax e -> hax e Tar e -> tar e wut :: Noun -> Possibly Noun wut noun = return $ case noun of Cell {} -> Atom 0 Atom {} -> Atom 1 lus :: Noun -> Possibly Noun lus noun = case noun of Cell {} -> Left (Error noun) Atom m -> return (Atom (1 + m)) tis :: Noun -> Possibly Noun tis noun = case noun of Atom {} -> Left (Error noun) Cell m n -> return $ if m == n then Atom 0 else Atom 1 net :: Noun -> Possibly Noun net noun = case noun of Cell (Atom 1) a -> return a Cell (Atom 2) (Cell a _) -> return a Cell (Atom 3) (Cell _ b) -> return b Cell (Atom a) b -> if even a then do inner <- net (Cell (Atom (a `div` 2)) b) net (Cell (Atom 2) inner) else do inner <- net (Cell (Atom ((a - 1) `div` 2)) b) net (Cell (Atom 3) inner) _ -> Left (Error noun) hax :: Noun -> Possibly Noun hax noun = case noun of Cell (Atom 1) (Cell a _) -> return a Cell (Atom a) (Cell b c) -> if even a then do let e = a `div` 2 inner <- net (Cell (Atom (e + e + 1)) c) hax (Cell (Atom e) (Cell (Cell b inner) c)) else do let o = (a - 1) `div` 2 inner <- net (Cell (Atom (o + o)) c) hax (Cell (Atom o) (Cell (Cell inner b) c)) _ -> Left (Error noun) tar :: Noun -> Possibly Noun tar noun = case noun of Cell a (Cell (Cell b c) d) -> do inner0 <- tar (Cell a (Cell b c)) inner1 <- tar (Cell a d) return (Cell inner0 inner1) Cell a (Cell (Atom 0) b) -> net (Cell b a) Cell _ (Cell (Atom 1) b) -> return b Cell a (Cell (Atom 2) (Cell b c)) -> do inner0 <- tar (Cell a b) inner1 <- tar (Cell a c) tar (Cell inner0 inner1) Cell a (Cell (Atom 3) b) -> do tard <- tar (Cell a b) wut tard Cell a (Cell (Atom 4) b) -> do tard <- tar (Cell a b) lus tard Cell a (Cell (Atom 5) (Cell b c)) -> do tard0 <- tar (Cell a b) tard1 <- tar (Cell a c) tis (Cell tard0 tard1) Cell a (Cell (Atom 6) (Cell b (Cell c d))) -> do tard0 <- tar (Cell a (Cell (Atom 4) (Cell (Atom 4) b))) tard1 <- tar (Cell (Cell (Atom 2) (Atom 3)) (Cell (Atom 0) tard0)) tard2 <- tar (Cell (Cell c d) (Cell (Atom 0) tard1)) tar (Cell a tard2) Cell a (Cell (Atom 7) (Cell b c)) -> do tard <- tar (Cell a b) tar (Cell tard c) Cell a (Cell (Atom 8) (Cell b c)) -> do tard <- tar (Cell a b) tar (Cell (Cell tard a) c) Cell a (Cell (Atom 9) (Cell b c)) -> do tard <- tar (Cell a c) tar (Cell tard (Cell (Atom 2) (Cell (Cell (Atom 0) (Atom 1)) (Cell (Atom 0) b)))) Cell a (Cell (Atom 10) (Cell (Cell b c) d)) -> do tard0 <- tar (Cell a c) tard1 <- tar (Cell a d) hax (Cell b (Cell tard0 tard1)) Cell a (Cell (Atom 11) (Cell (Cell _ c) d)) -> do tard0 <- tar (Cell a c) tard1 <- tar (Cell a d) tar (Cell (Cell tard0 tard1) (Cell (Atom 0) (Atom 3))) Cell a (Cell (Atom 11) (Cell _ c)) -> tar (Cell a c) _ -> Left (Error noun)