diff --git a/bruijn.cabal b/bruijn.cabal index 20cd3cd..97d1a7a 100644 --- a/bruijn.cabal +++ b/bruijn.cabal @@ -25,6 +25,7 @@ data-files: std/IO.bruijn std/List.bruijn std/Logic.bruijn + std/Map.bruijn std/Math.bruijn std/Meta.bruijn std/Monad.bruijn @@ -58,8 +59,8 @@ data-files: std/Number/Ternary.bruijn std/Number/Unary.bruijn std/Number/Wadsworth.bruijn - std/Set/NumberSet.bruijn - std/Set/StringSet.bruijn + std/Set/Number.bruijn + std/Set/String.bruijn std/Tree/Balanced.bruijn std/Tree/Finger.bruijn std/Tree/Rose.bruijn diff --git a/samples/fun/minibruijn.bruijn b/samples/fun/minibruijn.bruijn index 1364983..43dd4a1 100644 --- a/samples/fun/minibruijn.bruijn +++ b/samples/fun/minibruijn.bruijn @@ -1,4 +1,14 @@ # MIT License, Copyright (c) 2024 Marvin Borner +# usage: +# write a file test.bruijn +# ``` +# zero [[0]] +# inc [[[1 (2 1 0)]]] +# two inc (inc zero) +# four two two +# main four four +# ``` +# run `cat test.bruijn | bruijn minibruijn.bruijn` :import std/Char C :import std/Combinator . @@ -6,12 +16,14 @@ :import std/Meta M :import std/Monad/Parser . :import std/Number/Conversion O +:import std/Map H :import std/Result R +:import std/String S # meta encoding uses Church numerals instead of binary! char→number (\C.sub '0') → O.binary→unary -identifier satisfy (c ∘ C.space?) +identifier some (satisfy C.alpha?) spaces many (satisfy C.space?) @@ -21,13 +33,26 @@ parens between (char '(') (char ')') number char→number <$> (satisfy C.numeric?) -term y [(foldl1 M.app) <$> (some (spaces *> singleton <* spaces))] - singleton abs <|> idx <|> (parens 0) +# T := [T] # Abstraction +# | T..T # Application +# | (T) # Parenthesised +# | 0-9 # de Bruijn index +# identifiers ([a-z]*) just get looked up in the hashmap! +term [y [(foldl1 M.app) <$> (some (spaces *> singleton <* spaces))]] + singleton abs <|> idx <|> def <|> (parens 0) abs M.abs <$> (between (char '[') (char ']') 0) idx M.idx <$> number + def [S.#H.lookup 0 2 i i] <$> identifier -block identifier <*> term +:test (term H.empty "()") (R.err (error-compose (error-unexpected "(") (error-unexpected ")"))) +:test (term H.empty "[[0 1]]") (R.ok [0 `[[(0 1)]] empty]) +:test (term (S.#H.insert "foo" `[[1]] H.empty) "[foo 0]") (R.ok [0 `[[[1]] 0] empty]) -program block >>= newlines +block [[[S.#H.insert 1 0 2]] <$> identifier <*> (term 0) <* newlines] -main (M.eval <$> term) → [0 i i] +:test (block H.empty "main [0]\n") (R.ok [0 (S.#H.insert "main" `[0] H.empty) empty]) +:test (block H.empty "main ()\n") (R.err (error-compose (error-unexpected "(") (error-unexpected ")"))) + +program y [[[(R.apply (block 1 0) [3 ^0 ~0])] <|> (eof *> (pure 0))]] H.empty + +main M.eval <$> ([S.#H.lookup "main" 0 i i] <$> program) → [0 i i] diff --git a/src/Parser.hs b/src/Parser.hs index 83f03aa..01dda6e 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -426,7 +426,7 @@ parseCommandBlock = do parseDefBlock :: Int -> Parser Instruction parseDefBlock lvl = - sepEndBy parseComment newline *> string (replicate lvl '\t') *> try + sepEndBy (try parseComment) newline *> string (replicate lvl '\t') *> try (parseDefine lvl) parseBlock :: Int -> Parser Instruction diff --git a/std/Logic/Binary.bruijn b/std/Logic/Binary.bruijn index b16595c..b5eec13 100644 --- a/std/Logic/Binary.bruijn +++ b/std/Logic/Binary.bruijn @@ -56,6 +56,8 @@ nor? [[1 1 0 false true]] ⧗ Boolean → Boolean → Boolean # true if args are not same bools xor? [[0 (1 false 0) 1]] ⧗ Boolean → Boolean → Boolean +…^?… xor? + :test (xor? true true) (false) :test (xor? true false) (true) :test (xor? false true) (true) diff --git a/std/Map.bruijn b/std/Map.bruijn new file mode 100644 index 0000000..c9acf5a --- /dev/null +++ b/std/Map.bruijn @@ -0,0 +1,34 @@ +# MIT License, Copyright (c) 2024 Marvin Borner +# Generic map implementation using AVL trees +# the key-value pair is stored in the tree as a Church pair +# some functions require a hash function! +# TODO: what about hash collisions?? + +:import std/Tree/Balanced T +:import std/Option O +:import std/Number N +:import std/Combinator . +:import std/List . + +‣ &[[[[[N.compare-case 4 3 2 ^1 ^0]]]]] ⧗ (Compare Number) + +# key to element (for searching) +↑‣ [0 : i] ⧗ k → (Pair k v) + +# empty map +empty T.empty ⧗ (Map k v) + +# returns true if a value is in a map +has? [[T.has? ↑(1 0)]] ⧗ (k → Number) → k → (Map k v) → Boolean + +# counts the key-value pairs in a map +size T.size ⧗ (Map k v) → Number + +# returns the value of a key (or none) +lookup (O.map &ki) ∘∘∘ [[T.find ↑(1 0)]] ⧗ (k → Number) → k → (Map k v) → (Option v) + +# inserts (or replaces) a key with a value in a map +insert [[[T.insert ((2 1) : 0)]]] ⧗ (k → Number) → k → v → (Map k v) → (Map k v) + +:test (has? i (+2) (insert i (+2) "two" empty)) ([[1]]) +:test (lookup i (+2) (insert i (+2) "two" empty)) (O.some "two") diff --git a/std/Monad/Parser.bruijn b/std/Monad/Parser.bruijn index b32eb78..2201aec 100644 --- a/std/Monad/Parser.bruijn +++ b/std/Monad/Parser.bruijn @@ -1,5 +1,6 @@ # MIT License, Copyright (c) 2024 Marvin Borner # see samples/fun/minibruijn for example usage +# TODO: also support line/char offset :import std/List . :import std/Combinator . @@ -12,7 +13,11 @@ error-unexpected ["unexpected symbol " ++ 0] ⧗ Error error-end-of-input "end of input" ⧗ Error -compose [[C.?eq? 1 0 0 (1 ++ " or " ++ 0)]] ⧗ Error → Error → Error +error-expected-end "expected end of input" ⧗ Error + +error-custom [0] ⧗ Error + +error-compose [[C.?eq? 1 0 0 (1 ++ " or " ++ 0)]] ⧗ Error → Error → Error satisfy [[0 [[[go]]] end]] ⧗ (a → Boolean) → (Parser a) go 4 2 (R.ok (2 : 1)) (R.err (error-unexpected {}2)) @@ -52,14 +57,18 @@ bind [[[R.apply ok (2 0)]]] ⧗ (Parser a) → (a → (Parser b)) → (Parser a) alt [[[2 0 R.ok err]]] ⧗ (Parser a) → (Parser a) → (Parser a) err [2 1 R.ok err] - err [R.err (compose 1 0)] + err [R.err (error-compose 1 0)] …<|>… alt :test ((string "ab") <|> (string "cd") "abc") (R.ok ("ab" : "c")) :test ((string "ab") <|> (string "cd") "cde") (R.ok ("cd" : "e")) -:test ((string "ab") <|> (string "cd") "acd") (R.err (compose (error-unexpected "c") (error-unexpected "a"))) -:test ((string "ab") <|> (string "cd") "cbe") (R.err (compose (error-unexpected "c") (error-unexpected "b"))) +:test ((string "ab") <|> (string "cd") "acd") (R.err (error-compose (error-unexpected "c") (error-unexpected "a"))) +:test ((string "ab") <|> (string "cd") "cbe") (R.err (error-compose (error-unexpected "c") (error-unexpected "b"))) + +eof [0 [[[go]]] end] ⧗ (Parser a) + go R.err error-expected-end + end R.ok ([[0]] : [[0]]) # =========================================================================== # # most relevant functions are defined - we can now derive from Generic/Monad! # diff --git a/std/Number/Binary.bruijn b/std/Number/Binary.bruijn index c778890..3dc6b18 100644 --- a/std/Number/Binary.bruijn +++ b/std/Number/Binary.bruijn @@ -200,9 +200,9 @@ and! binary! ∘∘ (ψ* zip-with …⋀?… list!) ⧗ Binary → Binary → Bi …⋀!… and! -:test (and! (+1b) (+0b)) ((+0b)) -:test (and! (+5b) (+4b)) ((+4b)) -:test (and! (+10b) (+12b)) ((+8b)) +:test ((+1b) ⋀! (+0b)) ((+0b)) +:test ((+5b) ⋀! (+4b)) ((+4b)) +:test ((+10b) ⋀! (+12b)) ((+8b)) # logical or on two binary numbers # TODO: Fix for numbers with different length (→ zero padding?) @@ -210,11 +210,19 @@ or! binary! ∘∘ (ψ* zip-with …⋁?… list!) ⧗ Binary → Binary → Bin …⋁!… or! -:test (or! (+10b) (+12b)) ((+14b)) +:test ((+10b) ⋁! (+12b)) ((+14b)) # :test (or! (+1b) (+0b)) ((+1b)) # :test (or! (+5b) (+3b)) ((+7b)) +# logical or on two binary numbers +# TODO: Fix for numbers with different length (→ zero padding?) +xor! binary! ∘∘ (ψ* zip-with …^?… list!) ⧗ Binary → Binary → Binary + +…^!… xor! + +:test (((+10b) ^! (+12b)) =? (+6b)) (true) + # adds 1 to a binary number (can introduce leading 0s) inc [~(0 z a¹ a⁰)] ⧗ Binary → Binary z (+0b) : (+1b) diff --git a/std/Number/Ternary.bruijn b/std/Number/Ternary.bruijn index e00bbc5..f4e031d 100644 --- a/std/Number/Ternary.bruijn +++ b/std/Number/Ternary.bruijn @@ -482,3 +482,9 @@ mod ~‣ ∘∘ quot-rem ⧗ Number → Number → Number :test ((-5) % (-3) =? (-2)) (true) :test ((-5) % (+3) =? (+1)) (true) :test ((+5) % (-3) =? (-1)) (true) + +# hash function :) +# (useful for std/Map) +hash [0] ⧗ Number → Number + +#‣ &hash diff --git a/std/Set/NumberSet.bruijn b/std/Set/Number.bruijn similarity index 100% rename from std/Set/NumberSet.bruijn rename to std/Set/Number.bruijn diff --git a/std/Set/StringSet.bruijn b/std/Set/String.bruijn similarity index 100% rename from std/Set/StringSet.bruijn rename to std/Set/String.bruijn diff --git a/std/String.bruijn b/std/String.bruijn index 4ee002b..567635b 100644 --- a/std/String.bruijn +++ b/std/String.bruijn @@ -3,6 +3,7 @@ :import std/Char C :import std/Math . :import std/Number/Binary B +:import std/Number/Conversion O :input std/List @@ -129,3 +130,9 @@ lines z [[rec]] ⧗ String → (List String) unlines concat-map (\(…;…) '\n') ⧗ (List String) → String :test (unlines ("ab" : {}"cd")) ("ab\ncd\n") + +# slightly stretched DJB2 +# WARNING: this may give weird results with/without padded zeros due to bad xor +hash O.²³‣ ∘ (foldl [[B.xor! (B.mul (+33b) 1) (B.mul 0 (+208121b))]] (+5381b)) ⧗ String → Number + +#‣ &hash diff --git a/std/Tree/Balanced.bruijn b/std/Tree/Balanced.bruijn index 70e749e..853abc7 100644 --- a/std/Tree/Balanced.bruijn +++ b/std/Tree/Balanced.bruijn @@ -13,36 +13,36 @@ error Ω # unwraps tree from option (only use if not empty!) -unwrap unwrap-or error ⧗ (Option BalancedTree) → BalancedTree +unwrap unwrap-or error ⧗ (Option (BalancedTree a)) → (BalancedTree a) !‣ unwrap # empty tree -empty none ⧗ (Option BalancedTree) +empty none ⧗ (Option (BalancedTree a)) # returns height of tree -height map-or (-1) ^‣ ⧗ (Option BalancedTree) → Number +height map-or (-1) ^‣ ⧗ (Option (BalancedTree a)) → Number :test (height empty) ((-1)) :test (height (some ((+5) : ((+42) : (none : none))))) ((+5)) # constructs a tree with a label and no branches -node [[[(max (height 0) ++(height 2)) : (2 : (1 : 0))]]] ⧗ (Option BalancedTree) → Number → (Option BalancedTree) → BalancedTree +node [[[(max (height 0) ++(height 2)) : (2 : (1 : 0))]]] ⧗ (Option (BalancedTree a)) → a → (Option (BalancedTree a)) → (BalancedTree a) # constructs a leaf node -leaf [node none 0 none] ⧗ Number → BalancedTree +leaf [node none 0 none] ⧗ a → (BalancedTree a) :test (leaf (+42)) (++(-1) : (none : ((+42) : none))) # returns the label of a tree -label [^(~(~0))] ⧗ BalancedTree → Number +label [^(~(~0))] ⧗ (BalancedTree a) → a ?‣ label :test (?(leaf (+42))) ((+42)) # returns the left branch of a tree -left [^(~0)] ⧗ BalancedTree → (Option BalancedTree) +left [^(~0)] ⧗ (BalancedTree a) → (Option (BalancedTree a)) //‣ left @@ -50,7 +50,7 @@ left [^(~0)] ⧗ BalancedTree → (Option BalancedTree) :test (//(node (some (leaf (+3))) (+0) none)) (some (leaf (+3))) # returns the right branch of a tree -right [~(~(~0))] ⧗ BalancedTree → (Option BalancedTree) +right [~(~(~0))] ⧗ (BalancedTree a) → (Option (BalancedTree a)) \\‣ right @@ -58,53 +58,62 @@ right [~(~(~0))] ⧗ BalancedTree → (Option BalancedTree) :test (\\(node none (+0) (some (leaf (+3))))) (some (leaf (+3))) # returns the balancing factor of a tree -factor map-or (+0) d ⧗ (Option BalancedTree) → Number +factor map-or (+0) d ⧗ (Option (BalancedTree a)) → Number d [(height //0) - (height \\0)] :test (factor (some (leaf (+42)))) (++(-1)) -rotate-ll [node //(!(//0)) ?(!(//0)) (some (node \\(!(//0)) ?0 \\0))] ⧗ BalancedTree → BalancedTree +rotate-ll [node //(!(//0)) ?(!(//0)) (some (node \\(!(//0)) ?0 \\0))] ⧗ (BalancedTree a) → (BalancedTree a) -rotate-rr [node (some (node //0 ?0 //(!(\\0)))) ?(!(\\0)) \\(!(\\0))] ⧗ BalancedTree → BalancedTree +rotate-rr [node (some (node //0 ?0 //(!(\\0)))) ?(!(\\0)) \\(!(\\0))] ⧗ (BalancedTree a) → (BalancedTree a) -rotate-lr [rotate-ll (node (some (rotate-rr !(//0))) ?0 \\0)] ⧗ BalancedTree → BalancedTree +rotate-lr [rotate-ll (node (some (rotate-rr !(//0))) ?0 \\0)] ⧗ (BalancedTree a) → (BalancedTree a) -rotate-rl [rotate-rr (node //0 ?0 (some (rotate-ll !(\\0))))] ⧗ BalancedTree → BalancedTree +rotate-rl [rotate-rr (node //0 ?0 (some (rotate-ll !(\\0))))] ⧗ (BalancedTree a) → (BalancedTree a) # balances a tree -balance [go (factor 0)] ⧗ (Option BalancedTree) → (Option BalancedTree) +balance [go (factor 0)] ⧗ (Option (BalancedTree a)) → (Option (BalancedTree a)) go [=?0 else (0 >? (+1) left (0 has? (+42) empty) (false) + +# returns the value in a tree +# could have more information with a clever comparison function +find [z [[[rec]]]] ⧗ (Compare a) → a → (Option (BalancedTree a)) → (Option a) + rec none? 0 0 (3 eq gt lt 1 ?(!0)) + eq some ?(!0) + gt 2 1 \\(!0) + lt 2 1 //(!0) + +:test (find (+42) empty) (none) +:test (find (+42) (insert (+42) empty)) (some (+42)) # number of elements in tree (slow) -size z [[rec]] ⧗ (Option BalancedTree) → Number +size z [[rec]] ⧗ (Option (BalancedTree a)) → Number rec none? 0 case-empty case-full case-full ++((1 //(!0)) + (1 \\(!0))) case-empty (+0) # converts a tree to a list -tree→list z [[map-or L.empty go 0]] ⧗ (Option BalancedTree) → (List Number) +tree→list z [[map-or L.empty go 0]] ⧗ (Option (BalancedTree a)) → (List a) go [L.append (L.append (2 //0) L.{}(?0)) (2 \\0)] # converts a list to a tree -list→tree [L.foldr (insert 0) empty] ⧗ Compare → (List Number) → (Option BalancedTree) +list→tree [L.foldr (insert 0) empty] ⧗ (Compare a) → (List a) → (Option (BalancedTree a))