From 50a62f6182c71de7135df70d64462d92335b61f6 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Fri, 9 Feb 2024 14:59:42 +0100 Subject: [PATCH] Fix bugs in the Nockma prettyprinter and parser (#2632) This pr addresses a number of problems. 1. It fixes a bug where paths were annotated as operations rather than paths in the parser. 2. It fixes a bug that happened when unfolding cells in the pretty printer in order to minimize delimiters. It caused the stdlibcall hints to be ignored for the unfolded arguments. 3. In order to properly test this, we can't ignore the hints for the Eq instance, so I've changed that. 4. I've introduced the class NockmaEq for nockma semantic equality. This is used in the evaluator as well as in the semantic tests. 5. I've added a bigger test. I found these bugs while working with this file. --- package.yaml | 1 + src/Juvix/Compiler/Nockma/Evaluator.hs | 4 +- src/Juvix/Compiler/Nockma/Language.hs | 68 +- src/Juvix/Compiler/Nockma/Pretty/Base.hs | 14 +- .../Nockma/Translation/FromSource/Base.hs | 41 +- test/Nockma/Compile/Tree/Positive.hs | 2 +- test/Nockma/Eval/Positive.hs | 4 +- test/Nockma/Parse/Positive.hs | 3 +- tests/nockma/positive/Compiled.pnock | 1737 +++++++++++++++++ 9 files changed, 1823 insertions(+), 51 deletions(-) create mode 100644 tests/nockma/positive/Compiled.pnock diff --git a/package.yaml b/package.yaml index 065d2d54b..c4b3126ec 100644 --- a/package.yaml +++ b/package.yaml @@ -122,6 +122,7 @@ ghc-options: # Warnings - -Weverything - -Wno-all-missed-specialisations + - -Wno-missed-specialisations - -Wno-missing-export-lists - -Wno-missing-import-lists - -Wno-missing-kind-signatures diff --git a/src/Juvix/Compiler/Nockma/Evaluator.hs b/src/Juvix/Compiler/Nockma/Evaluator.hs index 3c77d86ea..bd523c982 100644 --- a/src/Juvix/Compiler/Nockma/Evaluator.hs +++ b/src/Juvix/Compiler/Nockma/Evaluator.hs @@ -23,7 +23,7 @@ asCell = \case asBool :: (Members '[Reader EvalCtx, Error (NockEvalError a)] r, NockNatural a) => Term a -> Sem r Bool asBool t = do a <- asAtom t - return (a == nockTrue) + return (nockmaEq a nockTrue) asPath :: (Members '[Reader EvalCtx, Error (NockEvalError a), Error (ErrNockNatural a)] r, NockNatural a) => @@ -302,7 +302,7 @@ eval inistack initerm = r <- evalArg crumbEvalSecond stack (cellTerm ^. cellRight) return . TermAtom $ if - | l == r -> nockTrue + | nockmaEq l r -> nockTrue | otherwise -> nockFalse goOpCall :: Sem r (Term a) diff --git a/src/Juvix/Compiler/Nockma/Language.hs b/src/Juvix/Compiler/Nockma/Language.hs index 14a581db9..657d894c4 100644 --- a/src/Juvix/Compiler/Nockma/Language.hs +++ b/src/Juvix/Compiler/Nockma/Language.hs @@ -53,31 +53,30 @@ data StdlibCall a = StdlibCall { _stdlibCallFunction :: StdlibFunction, _stdlibCallArgs :: Term a } - -deriving stock instance (Lift a) => Lift (StdlibCall a) + deriving stock (Show, Eq, Lift) data CellInfo a = CellInfo - { _cellInfoLoc :: Maybe Interval, + { _cellInfoLoc :: Irrelevant (Maybe Interval), _cellInfoCall :: Maybe (StdlibCall a) } - deriving stock (Lift) + deriving stock (Show, Eq, Lift) data Cell a = Cell' { _cellLeft :: Term a, _cellRight :: Term a, - _cellInfo :: Irrelevant (CellInfo a) + _cellInfo :: CellInfo a } deriving stock (Show, Eq, Lift) data AtomInfo = AtomInfo { _atomInfoHint :: Maybe AtomHint, - _atomInfoLoc :: Maybe Interval + _atomInfoLoc :: Irrelevant (Maybe Interval) } deriving stock (Show, Eq, Lift) data Atom a = Atom { _atom :: a, - _atomInfo :: Irrelevant AtomInfo + _atomInfo :: AtomInfo } deriving stock (Show, Eq, Lift) @@ -176,7 +175,7 @@ makeLenses ''AtomInfo makeLenses ''CellInfo atomHint :: Lens' (Atom a) (Maybe AtomHint) -atomHint = atomInfo . unIrrelevant . atomInfoHint +atomHint = atomInfo . atomInfoHint termLoc :: Lens' (Term a) (Maybe Interval) termLoc f = \case @@ -184,13 +183,13 @@ termLoc f = \case TermCell a -> TermCell <$> cellLoc f a cellLoc :: Lens' (Cell a) (Maybe Interval) -cellLoc = cellInfo . unIrrelevant . cellInfoLoc +cellLoc = cellInfo . cellInfoLoc . unIrrelevant cellCall :: Lens' (Cell a) (Maybe (StdlibCall a)) -cellCall = cellInfo . unIrrelevant . cellInfoCall +cellCall = cellInfo . cellInfoCall atomLoc :: Lens' (Atom a) (Maybe Interval) -atomLoc = atomInfo . unIrrelevant . atomInfoLoc +atomLoc = atomInfo . atomInfoLoc . unIrrelevant naturalNockOps :: HashMap Natural NockOp naturalNockOps = HashMap.fromList [(serializeOp op, op) | op <- allElements] @@ -217,7 +216,7 @@ serializeOp = \case OpHint -> 11 OpTrace -> 100 -class (Eq a) => NockNatural a where +class (NockmaEq a) => NockNatural a where type ErrNockNatural a :: Type nockNatural :: (Member (Error (ErrNockNatural a)) r) => Atom a -> Sem r Natural serializeNockOp :: NockOp -> a @@ -267,11 +266,11 @@ nockBoolLiteral b instance NockNatural Natural where type ErrNockNatural Natural = NockNaturalNaturalError nockNatural a = return (a ^. atom) - nockTrue = Atom 0 (Irrelevant (atomHintInfo AtomHintBool)) - nockFalse = Atom 1 (Irrelevant (atomHintInfo AtomHintBool)) - nockNil = Atom 0 (Irrelevant (atomHintInfo AtomHintNil)) + nockTrue = Atom 0 (atomHintInfo AtomHintBool) + nockFalse = Atom 1 (atomHintInfo AtomHintBool) + nockNil = Atom 0 (atomHintInfo AtomHintNil) nockSucc = over atom succ - nockVoid = Atom 0 (Irrelevant (atomHintInfo AtomHintVoid)) + nockVoid = Atom 0 (atomHintInfo AtomHintVoid) errInvalidOp atm = NaturalInvalidOp atm errInvalidPath atm = NaturalInvalidPath atm serializeNockOp = serializeOp @@ -299,7 +298,7 @@ instance IsNock Natural where toNock = TAtom instance IsNock NockOp where - toNock op = toNock (Atom (serializeOp op) (Irrelevant (atomHintInfo AtomHintOp))) + toNock op = toNock (Atom (serializeOp op) (atomHintInfo AtomHintOp)) instance IsNock Bool where toNock = \case @@ -307,7 +306,7 @@ instance IsNock Bool where True -> toNock (nockTrue @Natural) instance IsNock Path where - toNock pos = TermAtom (Atom (encodePath pos ^. encodedPath) (Irrelevant (atomHintInfo AtomHintPath))) + toNock pos = TermAtom (Atom (encodePath pos ^. encodedPath) (atomHintInfo AtomHintPath)) instance IsNock EncodedPath where toNock = toNock . decodePath' @@ -337,7 +336,7 @@ a >># b = TermCell (a >>#. b) pattern Cell :: Term a -> Term a -> Cell a pattern Cell {_cellLeft', _cellRight'} <- Cell' _cellLeft' _cellRight' _ where - Cell a b = Cell' a b (Irrelevant emptyCellInfo) + Cell a b = Cell' a b emptyCellInfo {-# COMPLETE TCell, TAtom #-} @@ -349,18 +348,43 @@ pattern TCell l r <- TermCell (Cell' l r _) pattern TAtom :: a -> Term a pattern TAtom a <- TermAtom (Atom a _) where - TAtom a = TermAtom (Atom a (Irrelevant emptyAtomInfo)) + TAtom a = TermAtom (Atom a emptyAtomInfo) emptyCellInfo :: CellInfo a emptyCellInfo = CellInfo { _cellInfoCall = Nothing, - _cellInfoLoc = Nothing + _cellInfoLoc = Irrelevant Nothing } emptyAtomInfo :: AtomInfo emptyAtomInfo = AtomInfo { _atomInfoHint = Nothing, - _atomInfoLoc = Nothing + _atomInfoLoc = Irrelevant Nothing } + +class NockmaEq a where + nockmaEq :: a -> a -> Bool + +instance NockmaEq Natural where + nockmaEq a b = a == b + +instance (NockmaEq a) => NockmaEq [a] where + nockmaEq a b = + case zipExactMay a b of + Nothing -> False + Just z -> all (uncurry nockmaEq) z + +instance (NockmaEq a) => NockmaEq (Atom a) where + nockmaEq = nockmaEq `on` (^. atom) + +instance (NockmaEq a) => NockmaEq (Term a) where + nockmaEq = \cases + (TermAtom a) (TermAtom b) -> nockmaEq a b + (TermCell a) (TermCell b) -> nockmaEq a b + TermCell {} TermAtom {} -> False + TermAtom {} TermCell {} -> False + +instance (NockmaEq a) => NockmaEq (Cell a) where + nockmaEq (Cell l r) (Cell l' r') = nockmaEq l l' && nockmaEq r r' diff --git a/src/Juvix/Compiler/Nockma/Pretty/Base.hs b/src/Juvix/Compiler/Nockma/Pretty/Base.hs index 76d1eff75..cb5e916bb 100644 --- a/src/Juvix/Compiler/Nockma/Pretty/Base.hs +++ b/src/Juvix/Compiler/Nockma/Pretty/Base.hs @@ -33,8 +33,8 @@ instance (PrettyCode a, NockNatural a) => PrettyCode (Atom a) where AtomHintOp -> nockOp atm >>= ppCode AtomHintPath -> nockPath atm >>= ppCode AtomHintBool - | atm == nockTrue -> return (annotate (AnnKind KNameInductive) "true") - | atm == nockFalse -> return (annotate (AnnKind KNameAxiom) "false") + | nockmaEq atm nockTrue -> return (annotate (AnnKind KNameInductive) "true") + | nockmaEq atm nockFalse -> return (annotate (AnnKind KNameAxiom) "false") | otherwise -> fail AtomHintNil -> return (annotate (AnnKind KNameConstructor) "nil") AtomHintVoid -> return (annotate (AnnKind KNameAxiom) "void") @@ -85,12 +85,14 @@ instance (PrettyCode a, NockNatural a) => PrettyCode (Cell a) where return (oneLineOrNextBrackets inside) unfoldCell :: Cell a -> NonEmpty (Term a) -unfoldCell c = c ^. cellLeft :| go [] (c ^. cellRight) +unfoldCell c = c ^. cellLeft :| reverse (go [] (c ^. cellRight)) where go :: [Term a] -> Term a -> [Term a] - go acc = \case - t@TermAtom {} -> reverse (t : acc) - TermCell (Cell l r) -> go (l : acc) r + go acc t = case t of + TermAtom {} -> t : acc + TermCell (Cell' l r i) -> case i ^. cellInfoCall of + Nothing -> go (l : acc) r + Just {} -> t : acc instance (PrettyCode a, NockNatural a) => PrettyCode (Term a) where ppCode = \case diff --git a/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs b/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs index 1b3da524b..8ed058b29 100644 --- a/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs +++ b/src/Juvix/Compiler/Nockma/Translation/FromSource/Base.hs @@ -7,7 +7,7 @@ import Juvix.Compiler.Nockma.Language import Juvix.Extra.Strings qualified as Str import Juvix.Parser.Error import Juvix.Parser.Lexer (onlyInterval, withLoc) -import Juvix.Prelude hiding (Atom, many, some) +import Juvix.Prelude hiding (Atom, Path, many, some) import Juvix.Prelude.Parsing hiding (runParser) import Text.Megaparsec qualified as P import Text.Megaparsec.Char.Lexer qualified as L @@ -82,22 +82,29 @@ atomOp = do let info = AtomInfo { _atomInfoHint = Just AtomHintOp, - _atomInfoLoc = Just loc + _atomInfoLoc = Irrelevant (Just loc) } - return (Atom (serializeNockOp op') (Irrelevant info)) + return (Atom (serializeNockOp op') info) -atomDirection :: Parser (Atom Natural) -atomDirection = do - WithLoc loc dirs <- - withLoc $ - symbol "S" $> [] - <|> NonEmpty.toList <$> some (choice [symbol "L" $> L, symbol "R" $> R]) +atomPath :: Parser (Atom Natural) +atomPath = do + WithLoc loc path <- withLoc pPath let info = AtomInfo - { _atomInfoHint = Just AtomHintOp, - _atomInfoLoc = Just loc + { _atomInfoHint = Just AtomHintPath, + _atomInfoLoc = Irrelevant (Just loc) } - return (Atom (serializePath dirs) (Irrelevant info)) + return (Atom (serializePath path) info) + +direction :: Parser Direction +direction = + symbol "L" $> L + <|> symbol "R" $> R + +pPath :: Parser Path +pPath = + symbol "S" $> [] + <|> NonEmpty.toList <$> some direction atomNat :: Parser (Atom Natural) atomNat = do @@ -105,9 +112,9 @@ atomNat = do let info = AtomInfo { _atomInfoHint = Nothing, - _atomInfoLoc = Just loc + _atomInfoLoc = Irrelevant (Just loc) } - return (Atom n (Irrelevant info)) + return (Atom n info) atomBool :: Parser (Atom Natural) atomBool = @@ -131,7 +138,7 @@ patom :: Parser (Atom Natural) patom = atomOp <|> atomNat - <|> atomDirection + <|> atomPath <|> atomBool <|> atomNil <|> atomVoid @@ -150,9 +157,9 @@ cell = do info = CellInfo { _cellInfoCall = c, - _cellInfoLoc = Just (lloc <> rloc) + _cellInfoLoc = Irrelevant (Just (lloc <> rloc)) } - return (set cellInfo (Irrelevant info) r) + return (set cellInfo info r) where stdlibCall :: Parser (StdlibCall Natural) stdlibCall = do diff --git a/test/Nockma/Compile/Tree/Positive.hs b/test/Nockma/Compile/Tree/Positive.hs index 0929eac66..0b781996a 100644 --- a/test/Nockma/Compile/Tree/Positive.hs +++ b/test/Nockma/Compile/Tree/Positive.hs @@ -37,7 +37,7 @@ runNockmaAssertion hout _main tab = do getReturn :: Term Natural -> Maybe (Term Natural) getReturn = \case TermAtom Nockma.Atom {..} - | _atomInfo ^. unIrrelevant . atomInfoHint == Just AtomHintVoid -> Nothing + | _atomInfo ^. atomInfoHint == Just AtomHintVoid -> Nothing t -> Just t testDescr :: Tree.PosTest -> TestDescr diff --git a/test/Nockma/Eval/Positive.hs b/test/Nockma/Eval/Positive.hs index 016ced615..edadcecd1 100644 --- a/test/Nockma/Eval/Positive.hs +++ b/test/Nockma/Eval/Positive.hs @@ -42,7 +42,7 @@ allTests = testGroup "Nockma eval unit positive" (map mk tests) eqNock :: Term Natural -> Check () eqNock expected = do actual <- ask - unless (expected == actual) (err actual) + unless (nockmaEq expected actual) (err actual) where err :: Term Natural -> Check () err actual = do @@ -56,7 +56,7 @@ eqNock expected = do eqTraces :: [Term Natural] -> Check () eqTraces expected = do ts <- ask - unless (ts == expected) (err ts) + unless (nockmaEq ts expected) (err ts) where err :: [Term Natural] -> Check () err ts = do diff --git a/test/Nockma/Parse/Positive.hs b/test/Nockma/Parse/Positive.hs index 654e53d34..c62b56b36 100644 --- a/test/Nockma/Parse/Positive.hs +++ b/test/Nockma/Parse/Positive.hs @@ -53,5 +53,6 @@ tests = [ PosTest "Identity" $(mkRelDir ".") $(mkRelFile "Identity.nock"), PosTest "Identity Pretty" $(mkRelDir ".") $(mkRelFile "IdentityPretty.pnock"), PosTest "StdlibCall" $(mkRelDir ".") $(mkRelFile "StdlibCall.pnock"), - PosTest "Stdlib" $(mkRelDir ".") $(mkRelFile "Stdlib.nock") + PosTest "Stdlib" $(mkRelDir ".") $(mkRelFile "Stdlib.nock"), + PosTest "Compiled Tree program" $(mkRelDir ".") $(mkRelFile "Compiled.pnock") ] diff --git a/tests/nockma/positive/Compiled.pnock b/tests/nockma/positive/Compiled.pnock new file mode 100644 index 000000000..8f830ac7b --- /dev/null +++ b/tests/nockma/positive/Compiled.pnock @@ -0,0 +1,1737 @@ +[ + [ + nil + nil + [ + [ + [ + 8 + [1 0] + [ + 1 + 6 + [5 [1 0] 0 6] + [1 1] + 8 + [9 4 0 63] + 9 + 2 + 10 + [ + 6 + [7 [0 3] 1 2] + 7 + [0 3] + 9 + 2 + 10 + [6 8 [9 342 0 63] 9 2 10 [6 0 14] 0 2] + 0 + 1 + ] + 0 + 2 + ] + 0 + 1 + ] + [ + 8 + [1 0] + [ + 1 + [ + 8 + [1 0 0] + [ + 1 + 8 + [9 20 0 255] + 9 + 2 + 10 + [ + 6 + [ + 7 + [0 3] + 8 + [9 90 0 7] + 9 + 2 + 10 + [6 [7 [0 3] 8 [9 190 0 7] 9 2 10 [6 0 28] 0 2] 0 29] + 0 + 2 + ] + 0 + 28 + ] + 0 + 2 + ] + 0 + 1 + ] + [ + 8 + [1 0] + [1 8 [9 367 0 7] 9 2 10 [6 [7 [0 3] 1 1] 0 14] 0 2] + 0 + 1 + ] + [ + [ + 8 + [1 0 0] + [ + 1 + 8 + [1 0] + 7 + [10 [29 8 [9 10 0 15] 9 2 10 [6 0 61] 0 2] 0 1] + 8 + [0 29] + 8 + [ + 1 + 6 + [5 [0 14] 0 124] + [8 [9 767 0 63] 9 2 10 [6 [7 [0 3] 1 1] 0 14] 0 2] + 9 + 2 + 10 + [14 4 0 14] + 10 + [ + 6 + 8 + [9 20 0 2047] + 9 + 2 + 10 + [ + 6 + [0 253] + 7 + [0 3] + 8 + [9 90 0 63] + 9 + 2 + 10 + [6 [7 [0 3] 1 1] 0 14] + 0 + 2 + ] + 0 + 2 + ] + 0 + 1 + ] + 9 + 2 + 0 + 1 + ] + 0 + 1 + ] + [ + 8 + [1 0 0] + [ + 1 + 8 + [9 4 0 255] + 9 + 2 + 10 + [ + 6 + [0 29] + 7 + [0 3] + 8 + [9 4 0 31] + 9 + 2 + 10 + [ + 6 + 7 + [0 3] + 8 + [9 4 0 255] + 9 + 2 + 10 + [6 [7 [0 3] 9 182 0 7] 0 28] + 0 + 2 + ] + 0 + 2 + ] + 0 + 2 + ] + 0 + 1 + ] + [8 [9 4 0 7] 9 2 10 [6 0 14] 0 2] + [ + 8 + [1 0] + [ + 1 + 8 + [9 47 0 255] + 9 + 2 + 10 + [ + 6 + [7 [0 3] 8 [9 342 0 255] 9 2 10 [6 7 [0 3] 9 382 0 7] 0 2] + 7 + [0 3] + 8 + [9 10 0 7] + 9 + 2 + 10 + [6 0 14] + 0 + 2 + ] + 0 + 2 + ] + 0 + 1 + ] + 8 + [1 0 0] + [ + 1 + 8 + [9 46 0 255] + 9 + 2 + 10 + [ + 6 + [0 29] + 7 + [0 3] + 8 + [9 4 0 31] + 9 + 2 + 10 + [ + 6 + 7 + [0 3] + 8 + [9 4 0 255] + 9 + 2 + 10 + [6 [7 [0 3] 9 182 0 7] 0 28] + 0 + 2 + ] + 0 + 2 + ] + 0 + 2 + ] + 0 + 1 + ] + [ + 8 + [1 0 0] + [ + 1 + 8 + [9 10 0 7] + 9 + 2 + 10 + [6 7 [0 3] 8 [9 20 0 255] 9 2 10 [6 [0 28] 0 29] 0 2] + 0 + 2 + ] + 0 + 1 + ] + [ + 8 + [1 [0 0] 0] + [ + 1 + 8 + [9 367 0 7] + 9 + 2 + 10 + [6 [0 57] 7 [0 3] 8 [9 767 0 7] 9 2 10 [6 [0 56] 0 29] 0 2] + 0 + 2 + ] + 0 + 1 + ] + [ + 8 + [1 0] + [ + 1 + 8 + [1 0] + 8 + [ + 1 + 6 + [5 [1 0] 0 30] + [0 6] + 9 + 2 + 10 + [30 8 [9 767 0 31] 9 2 10 [6 [7 [0 3] 1 1] 0 62] 0 2] + 10 + [6 4 0 6] + 0 + 1 + ] + 9 + 2 + 0 + 1 + ] + 0 + 1 + ] + [ + 8 + [9 4 0 7] + 9 + 2 + 10 + [6 7 [0 3] 8 [9 4 0 7] 9 2 10 [6 0 14] 0 2] + 0 + 2 + ] + [ + 8 + [1 0] + [ + 1 + 8 + [9 46 0 7] + 9 + 2 + 10 + [6 [7 [0 3] 8 [9 366 0 7] 9 2 10 [6 0 14] 0 2] 7 [0 3] 1 1] + 0 + 2 + ] + 0 + 1 + ] + 8 + [1 0 0] + [ + 1 + 8 + [9 170 0 255] + 9 + 2 + 10 + [ + 6 + [0 29] + 7 + [0 3] + 8 + [9 4 0 31] + 9 + 2 + 10 + [ + 6 + 7 + [0 3] + 8 + [9 4 0 255] + 9 + 2 + 10 + [6 [7 [0 3] 9 182 0 7] 0 28] + 0 + 2 + ] + 0 + 2 + ] + 0 + 2 + ] + 0 + 1 + ] + 0 + 1 + ] + 8 + [1 0] + [ + 1 + 8 + [8 [9 10 0 7] 9 190 10 [6 7 [0 3] 1 0] 0 2] + 9 + 2 + 10 + [6 0 14] + 0 + 2 + ] + 0 + 1 + ] + [ + [ + 7 + [ + 8 + [1 0 0] + [ + 1 + 6 + [5 [1 0] 0 13] + [1 1] + 8 + [9 4 0 31] + 9 + 2 + 10 + [ + 6 + [0 28] + 7 + [0 3] + 9 + 2 + 10 + [13 8 [9 342 0 31] 9 2 10 [6 0 29] 0 2] + 0 + 1 + ] + 0 + 2 + ] + 0 + 1 + ] + 11 + [1953718630 1 7827312 [0 7] 0] + 0 + 1 + ] + 8 + [1 0] + [ + 1 + [ + 8 + [1 1 1] + [ + 1 + 8 + [9 42 0 7] + 9 + 2 + 10 + [6 7 [0 3] 8 [9 4 0 127] 9 2 10 [6 [0 28] 0 29] 0 2] + 0 + 2 + ] + 0 + 1 + ] + [ + [ + 8 + [1 0 0] + [ + 1 + 8 + [9 42 0 7] + 9 + 2 + 10 + [6 7 [0 3] 8 [9 20 0 127] 9 2 10 [6 [0 28] 0 29] 0 2] + 0 + 2 + ] + 0 + 1 + ] + [8 [1 0] [1 8 [9 46 0 127] 9 2 10 [6 [0 14] 0 62] 0 2] 0 1] + [ + 8 + [1 1 1] + [ + 1 + 8 + [9 4 0 7] + 9 + 2 + 10 + [6 [0 28] 7 [0 3] 8 [9 174 0 7] 9 2 10 [6 0 29] 0 2] + 0 + 2 + ] + 0 + 1 + ] + [8 [1 0] [1 0 0] 0 1] + 8 + [1 0] + [ + 1 + 8 + [9 47 0 127] + 9 + 2 + 10 + [6 [0 62] 7 [0 3] 8 [9 42 0 7] 9 2 10 [6 0 14] 0 2] + 0 + 2 + ] + 0 + 1 + ] + [ + 8 + [1 0 0] + [ + 1 + 5 + [8 [9 42 0 7] 9 2 10 [6 0 28] 0 2] + 8 + [9 42 0 7] + 9 + 2 + 10 + [6 0 29] + 0 + 2 + ] + 0 + 1 + ] + [ + 8 + [1 0 0] + [ + 1 + 8 + [9 42 0 7] + 9 + 2 + 10 + [6 7 [0 3] 8 [9 4 0 31] 9 2 10 [6 [0 28] 0 29] 0 2] + 0 + 2 + ] + 0 + 1 + ] + 8 + [1 0 0] + [ + 1 + 8 + [9 42 0 7] + 9 + 2 + 10 + [ + 6 + 7 + [0 3] + 8 + [9 47 0 127] + 9 + 2 + 10 + [ + 6 + [7 [0 3] 8 [9 20 0 127] 9 2 10 [6 [0 62] 0 28] 0 2] + 7 + [0 3] + 8 + [9 42 0 7] + 9 + 2 + 10 + [6 0 29] + 0 + 2 + ] + 0 + 2 + ] + 0 + 2 + ] + 0 + 1 + ] + 0 + 1 + ] + [ + [ + 8 + [1 [[0 15] [0 0] [0 0] 0] 0] + [1 8 [0 101] [1 8 [0 60] 9 2 10 [6 [0 125] 0 14] 0 2] 0 1] + 0 + 1 + ] + [ + [ + 8 + [8 [1 0] [1 8 [0 6] 8 [5 [0 14] 0 2] 0 6] 0 1] + [ + 1 + 8 + [1 0] + [ + 1 + 8 + [7 [0 7] [1 7 [0 14] 9 2 0 1] 0 1] + 8 + [5 [0 14] 0 2] + 0 + 6 + ] + 0 + 1 + ] + 0 + 1 + ] + [ + 8 + [8 [1 0] [1 8 [0 6] 8 [5 [0 14] 0 2] 0 6] 0 1] + [ + 1 + 8 + [1 0] + [ + 1 + 8 + [ + 6 + [3 0 6] + [[6 [5 [1 0] 0 12] [1 0] 0 0] 8 [0 30] 9 2 10 [6 0 29] 0 2] + 6 + [5 [1 0] 0 6] + [1 0] + 0 + 0 + ] + 8 + [5 [0 14] 0 2] + 0 + 6 + ] + 0 + 1 + ] + 0 + 1 + ] + [ + 8 + [8 [1 0] [1 8 [0 6] 8 [5 [0 14] 0 2] 0 6] 0 1] + [ + 1 + 8 + [[0 26] 7 [8 [9 47 0 7] 9 2 10 [6 0 14] 0 2] 0 6] + [ + 1 + 8 + [ + [8 [0 30] 9 2 10 [6 0 28] 0 2] + 8 + [7 [0 7] 8 [9 47 0 7] 9 2 10 [6 0 14] 0 2] + 9 + 2 + 10 + [6 0 29] + 0 + 2 + ] + 8 + [5 [0 14] 0 2] + 0 + 6 + ] + 0 + 1 + ] + 0 + 1 + ] + [ + 8 + [1 0] + [1 8 [7 [1 0 0] 8 [0 2] [1 0 15] 0 1] 8 [5 [0 14] 0 2] 0 6] + 0 + 1 + ] + [ + 8 + [ + [8 [1 0] [1 8 [0 6] 8 [5 [0 14] 0 2] 0 6] 0 1] + 8 + [1 0] + [1 8 [0 6] 8 [5 [0 14] 0 2] 0 6] + 0 + 1 + ] + [ + 1 + 8 + [[1 0] 0 54] + [ + 1 + 8 + [ + 6 + [5 [1 1] 0 12] + [[6 [5 [0 12] 1 1] [1 1] 0 0] 8 [0 60] 9 2 10 [6 0 29] 0 2] + [6 [5 [0 12] 1 0] [1 0] 0 0] + 8 + [0 61] + 9 + 2 + 10 + [6 0 29] + 0 + 2 + ] + 8 + [5 [0 14] 0 2] + 0 + 6 + ] + 0 + 1 + ] + 0 + 1 + ] + [ + 8 + [8 [1 0] [1 8 [0 6] 8 [5 [0 14] 0 2] 0 6] 0 1] + [ + 1 + 8 + [1 0] + [ + 1 + 8 + [ + 6 + [3 0 6] + [ + [8 [0 30] 9 2 10 [6 0 28] 0 2] + [ + 8 + [7 [0 7] 8 [9 702 0 7] 9 2 10 [6 0 14] 0 2] + 9 + 2 + 10 + [6 0 58] + 0 + 2 + ] + 8 + [7 [0 7] 8 [9 702 0 7] 9 2 10 [6 0 14] 0 2] + 9 + 2 + 10 + [6 0 59] + 0 + 2 + ] + 6 + [5 [1 0] 0 6] + [1 0] + 0 + 0 + ] + 8 + [5 [0 14] 0 2] + 0 + 6 + ] + 0 + 1 + ] + 0 + 1 + ] + [ + 8 + [1 0] + [1 6 [5 [1 0] 0 6] [1 0] 4 9 2 10 [6 0 13] 0 1] + 0 + 1 + ] + 8 + [8 [1 0] [1 8 [0 6] 8 [5 [0 14] 0 2] 0 6] 0 1] + [ + 1 + 8 + [8 [1 0] [1 8 [0 6] 8 [5 [0 14] 0 2] 0 6] 0 1] + 8 + [5 [0 14] 0 2] + 0 + 6 + ] + 0 + 1 + ] + [ + 8 + [1 0 [0 15] 0 0 0] + [ + 1 + 8 + [ + 1 + 6 + [5 [1 0] 0 28] + [1 0] + [8 [0 29] 9 2 10 [6 0 120] 0 2] + 9 + 2 + 10 + [28 0 57] + 0 + 1 + ] + 9 + 2 + 0 + 1 + ] + 0 + 1 + ] + [ + 8 + [1 0 [0 13] [0 0] 0] + [ + 1 + 8 + [ + 1 + 6 + [5 [1 0] 0 28] + [0 237] + 8 + [0 29] + 9 + 2 + 10 + [6 [0 120] 7 [0 3] 9 2 10 [28 0 57] 0 1] + 0 + 2 + ] + 9 + 2 + 0 + 1 + ] + 0 + 1 + ] + 8 + [8 [1 0] [1 8 [0 6] 8 [5 [0 14] 0 2] 0 6] 0 1] + [ + 1 + 8 + [1 0] + [ + 1 + 8 + [ + 6 + [3 0 6] + [ + [8 [0 30] 9 2 10 [6 0 28] 0 2] + 8 + [7 [0 7] 8 [9 47 0 7] 9 2 10 [6 0 14] 0 2] + 9 + 2 + 10 + [6 0 29] + 0 + 2 + ] + 6 + [5 [1 0] 0 6] + [1 0] + 0 + 0 + ] + 8 + [5 [0 14] 0 2] + 0 + 6 + ] + 0 + 1 + ] + 0 + 1 + ] + [ + [ + 7 + [ + 8 + [1 1 1] + [ + 1 + 8 + [1 0] + 8 + [ + 1 + 6 + [5 [1 0] 0 60] + [0 6] + 9 + 2 + 10 + [60 8 [9 342 0 31] 9 2 10 [6 0 124] 0 2] + 10 + [6 8 [9 20 0 31] 9 2 10 [6 [0 125] 0 14] 0 2] + 0 + 1 + ] + 9 + 2 + 0 + 1 + ] + 0 + 1 + ] + 11 + [1953718630 1 7107949 [0 7] 0] + 0 + 1 + ] + [ + [ + 7 + [ + 8 + [1 0 0] + [ + 1 + 6 + [5 [1 0] 0 12] + [0 13] + 9 + 2 + 10 + [6 [8 [9 342 0 7] 9 2 10 [6 0 28] 0 2] 4 0 13] + 0 + 1 + ] + 0 + 1 + ] + 11 + [1953718630 1 6579297 [0 7] 0] + 0 + 1 + ] + [ + [ + 7 + [ + 8 + [1 0 0] + [ + 1 + 6 + [5 [0 12] 0 13] + [1 0] + 6 + [8 [9 343 0 7] 9 2 10 [6 [0 28] 0 29] 0 2] + [1 0] + 1 + 1 + ] + 0 + 1 + ] + 11 + [1953718630 1 6648940 [0 7] 0] + 0 + 1 + ] + [ + 7 + [ + 8 + [1 1 1] + [ + 1 + 6 + [5 [1 0] 0 13] + [0 0] + 8 + [1 0] + 8 + [ + 1 + 6 + [8 [9 343 0 31] 9 2 10 [6 [0 124] 0 125] 0 2] + [0 6] + 9 + 2 + 10 + [60 8 [9 47 0 31] 9 2 10 [6 [0 124] 0 125] 0 2] + 10 + [6 4 0 6] + 0 + 1 + ] + 9 + 2 + 0 + 1 + ] + 0 + 1 + ] + 11 + [1953718630 1 7760228 [0 7] 0] + 0 + 1 + ] + [ + 7 + [ + 8 + [1 0] + [ + 1 + 6 + [5 [1 0] 0 6] + [0 0] + 8 + [1 0] + 8 + [1 6 [5 [0 30] 4 0 6] [0 6] 9 2 10 [6 4 0 6] 0 1] + 9 + 2 + 0 + 1 + ] + 0 + 1 + ] + 11 + [1953718630 1 6514020 [0 7] 0] + 0 + 1 + ] + 7 + [ + 8 + [1 0 0] + [ + 1 + 6 + [6 [5 [0 12] 0 13] [1 1] 1 0] + [ + 6 + [ + 8 + [ + 1 + 6 + [5 [1 0] 0 28] + [1 0] + 6 + [ + 6 + [6 [5 [1 0] 0 29] [1 1] 1 0] + [ + 6 + [ + 9 + 2 + 10 + [ + 14 + [8 [9 342 0 15] 9 2 10 [6 0 60] 0 2] + 8 + [9 342 0 15] + 9 + 2 + 10 + [6 0 61] + 0 + 2 + ] + 0 + 1 + ] + [1 0] + 1 + 1 + ] + 1 + 1 + ] + [1 0] + 1 + 1 + ] + 9 + 2 + 0 + 1 + ] + [1 0] + 1 + 1 + ] + 1 + 1 + ] + 0 + 1 + ] + 11 + [1953718630 1 6845548 [0 7] 0] + 0 + 1 + ] + 7 + [ + 8 + [1 0 0] + [1 6 [8 [9 84 0 7] 9 2 10 [6 [0 28] 0 29] 0 2] [1 1] 1 0] + 0 + 1 + ] + 11 + [1953718630 1 6845543 [0 7] 0] + 0 + 1 + ] + [ + 7 + [ + 8 + [1 0 0] + [1 6 [8 [9 343 0 7] 9 2 10 [6 [0 28] 0 29] 0 2] [1 1] 1 0] + 0 + 1 + ] + 11 + [1953718630 1 6648935 [0 7] 0] + 0 + 1 + ] + [ + 7 + [ + 8 + [1 1 1] + [ + 1 + 6 + [5 [1 0] 0 13] + [0 0] + 8 + [9 47 0 7] + 9 + 2 + 10 + [ + 6 + [0 28] + 7 + [0 3] + 8 + [9 4 0 7] + 9 + 2 + 10 + [6 [0 29] 7 [0 3] 8 [9 170 0 7] 9 2 10 [6 [0 28] 0 29] 0 2] + 0 + 2 + ] + 0 + 2 + ] + 0 + 1 + ] + 11 + [1953718630 1 6582125 [0 7] 0] + 0 + 1 + ] + 7 + [ + 8 + [1 0 0] + [ + 1 + 6 + [5 [1 0] 0 13] + [0 12] + 9 + 2 + 10 + [ + 6 + [8 [9 342 0 7] 9 2 10 [6 0 28] 0 2] + 8 + [9 342 0 7] + 9 + 2 + 10 + [6 0 29] + 0 + 2 + ] + 0 + 1 + ] + 0 + 1 + ] + 11 + [1953718630 1 6452595 [0 7] 0] + 0 + 1 + ] + [0 3] + 909 + ] + [ + [ + call + RRRLRRRL + [ + [quote 10] + [ + call + RRRLRRRRRRRL + [quote nil] + [@ RL] + [@ RRL] + [@ RRRL] + quote + nil + ] + quote + nil + ] + [@ RL] + [@ RRL] + [@ RRRL] + quote + nil + ] + [ + apply + [ + [ + apply + [@ S] + [quote replace] + [ + [ + stdlib@dec args@[ + stdlib@mul args@[ + [ + stdlib@pow2 args@[seq [@ LL] @ RRL] push + [seq [@ RRL] 9 4 0 1] + call + L + replace + [RL seq [@ R] seq [@ LL] @ RRL] + @ + L + ] + suc + quote + S + ] push + [seq [@ RRL] 9 4 0 15] + call + L + replace + [ + RL + seq + [@ R] + [ + stdlib@pow2 args@[seq [@ LL] @ RRL] push + [seq [@ RRL] 9 4 0 1] + call + L + replace + [RL seq [@ R] seq [@ LL] @ RRL] + @ + L + ] + suc + quote + S + ] + @ + L + ] push + [seq [@ RRL] 9 342 0 15] + call + L + replace + [ + RL + seq + [@ R] + [ + stdlib@mul args@[ + [ + stdlib@pow2 args@[seq [@ LL] @ RRL] push + [seq [@ RRL] 9 4 0 1] + call + L + replace + [RL seq [@ R] seq [@ LL] @ RRL] + @ + L + ] + suc + quote + S + ] push + [seq [@ RRL] 9 4 0 15] + call + L + replace + [ + RL + seq + [@ R] + [ + stdlib@pow2 args@[seq [@ LL] @ RRL] push + [seq [@ RRL] 9 4 0 1] + call + L + replace + [RL seq [@ R] seq [@ LL] @ RRL] + @ + L + ] + suc + quote + S + ] + @ + L + ] + ] + @ + L + ] + quote + [quote void] + quote + nil + ] + quote + seq + [@ LL] + @ + RRRL + ] + [@ RL] + [@ RRL] + [@ RRRL] + quote + nil + ] + seq + [@ LL] + @ + L + ] + [ + seq + [ + [@ L] + [ + [ + call + RRRLRL + [[@ LRL] quote nil] + [@ RL] + [@ RRL] + [@ RRRL] + quote + nil + ] + @ + RL + ] + [@ RRL] + [@ RRRL] + quote + nil + ] + if + [ + apply + [ + [ + apply + [@ S] + [quote replace] + [ + [ + stdlib@dec args@[ + stdlib@mul args@[ + [ + stdlib@pow2 args@[seq [@ LL] @ RRL] push + [seq [@ RRL] 9 4 0 1] + call + L + replace + [RL seq [@ R] seq [@ LL] @ RRL] + @ + L + ] + suc + quote + S + ] push + [seq [@ RRL] 9 4 0 15] + call + L + replace + [ + RL + seq + [@ R] + [ + stdlib@pow2 args@[seq [@ LL] @ RRL] push + [seq [@ RRL] 9 4 0 1] + call + L + replace + [RL seq [@ R] seq [@ LL] @ RRL] + @ + L + ] + suc + quote + S + ] + @ + L + ] push + [seq [@ RRL] 9 342 0 15] + call + L + replace + [ + RL + seq + [@ R] + [ + stdlib@mul args@[ + [ + stdlib@pow2 args@[seq [@ LL] @ RRL] push + [seq [@ RRL] 9 4 0 1] + call + L + replace + [RL seq [@ R] seq [@ LL] @ RRL] + @ + L + ] + suc + quote + S + ] push + [seq [@ RRL] 9 4 0 15] + call + L + replace + [ + RL + seq + [@ R] + [ + stdlib@pow2 args@[seq [@ LL] @ RRL] push + [seq [@ RRL] 9 4 0 1] + call + L + replace + [RL seq [@ R] seq [@ LL] @ RRL] + @ + L + ] + suc + quote + S + ] + @ + L + ] + ] + @ + L + ] + quote + [@ RLLL] + quote + nil + ] + quote + seq + [@ LL] + @ + RRRL + ] + [@ RL] + [@ RRL] + [@ RRRL] + quote + nil + ] + seq + [@ LL] + @ + L + ] + [ + [@ RLLL] + [@ RRRLRRL] + [quote 3] + [quote 2] + [[@ LL] [@ RLLR] quote nil] + quote + nil + ] + call + RRRLRRL + [[@ LL] [@ RLLR] [quote void] quote nil] + [@ RL] + [@ RRL] + [@ RRRL] + quote + nil + ] + [ + seq + [ + [@ L] + [ + [ + call + RRRLRL + [[@ LRL] quote nil] + [@ RL] + [@ RRL] + [@ RRRL] + quote + nil + ] + @ + RL + ] + [@ RRL] + [@ RRRL] + quote + nil + ] + if + [= [quote 0] @ LL] + [@ RLLL] + call + RRRLRRRL + [ + [ + stdlib@sub args@[[@ LL] quote 1] push + [seq [@ RRL] 9 47 0 15] + call + L + replace + [RL seq [@ R] [@ LL] quote 1] + @ + L + ] + [@ RLLR] + quote + nil + ] + [@ RL] + [@ RRL] + [@ RRRL] + quote + nil + ] + [ + [@ LL] + [@ RRRLRRRRL] + [quote 2] + [quote 1] + [ + [ + stdlib@add args@[[quote 1] @ LL] push + [seq [@ RRL] 9 20 0 15] + call + L + replace + [RL seq [@ R] [quote 1] @ LL] + @ + L + ] + quote + nil + ] + quote + nil + ] + [ + if + [ + = + [quote 0] + [ + stdlib@mod args@[[@ LRL] @ LL] push + [seq [@ RRL] 9 46 0 15] + call + L + replace + [RL seq [@ R] [@ LRL] @ LL] + @ + L + ] + ] + [quote false] + quote + true + ] + [ + seq + [ + [@ L] + [ + [ + call + RRRLRL + [[@ LL] quote nil] + [@ RL] + [@ RRL] + [@ RRRL] + quote + nil + ] + @ + RL + ] + [@ RRL] + [@ RRRL] + quote + nil + ] + [@ RLLL] + [@ RRRLRRRRRRL] + [quote 2] + [quote 1] + [ + [ + [@ RRRLRRL] + [quote 3] + [quote 2] + [ + [ + [@ RRRLRRRRRL] + [quote 2] + [quote 1] + [[@ RLLL] quote nil] + quote + nil + ] + [@ RLLR] + quote + nil + ] + quote + nil + ] + quote + nil + ] + quote + nil + ] + [ + [@ RRRLRRRRRRL] + [quote 2] + [quote 1] + [ + [ + [@ RRRLRRRRL] + [quote 2] + [quote 1] + [[quote 2] quote nil] + quote + nil + ] + quote + nil + ] + quote + nil + ] + [@ @ @] + nil + ] + nil + ] + call + RRRLL + [quote nil] + [@ RL] + [@ RRL] + [@ RRRL] + quote + nil +] \ No newline at end of file