Improvements in maps, sets, and parsing

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

samples/fun/minibruijn.bruijn

@@ -1,17 +1,29 @@
 # 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 .
 :import std/List .
 :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]

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

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)

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")

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! #

std/Number/Binary.bruijn

@@ -200,21 +200,29 @@ 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?)
 or! binary! ∘∘ (ψ* zip-with …⋁?… list!) ⧗ Binary → Binary → Binary
 
 …⋁!… 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)

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

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

std/Tree/Balanced.bruijn

@@ -13,98 +13,107 @@
 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 
 
 :test (//(node none (+0) none)) (none)
 :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 
 
 :test (\\(node none (+0) none)) (none)
 :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 <? (-1) right else))]
 		left some (((factor //(!1)) =? (-1)) rotate-lr rotate-ll !1)
 		right some (((factor \\(!1)) =? (+1)) rotate-rl rotate-rr !1)
 		else 1
 
-# inserts a number into a tree
-insert [z [[[rec]]]] ⧗ Compare → Number → (Option BalancedTree) → (Option BalancedTree)
-	rec none? 0 (some (leaf 1)) (balance (u 1 ?(!0)))
-		u 3 eq gt lt
-			eq 0
-			gt some (node //(!0) ?(!0) (2 1 \\(!0)))
-			lt some (node (2 1 //(!0)) ?(!0) \\(!0))
-
-# returns true if a number is in a tree
-has? [z [[[rec]]]] ⧗ Compare → Number → (Option BalancedTree) → Boolean
-	rec none? 0 false (u 1 ?(!0))
-		u 3 eq gt lt
-			eq true
-			gt 2 1 \\(!0)
-			lt 2 1 //(!0)
-
-:test (has? compare-case (+42) empty) (false)
+# inserts a value into a tree
+insert [z [[[rec]]]] ⧗ (Compare a) → a → (Option (BalancedTree a)) → (Option (BalancedTree a))
+	rec none? 0 (some (leaf 1)) (balance (3 eq gt lt 1 ?(!0)))
+		eq 0
+		gt some (node //(!0) ?(!0) (2 1 \\(!0)))
+		lt some (node (2 1 //(!0)) ?(!0) \\(!0))
+
+# returns true if an element is in a tree
+has? [z [[[rec]]]] ⧗ (Compare a) → a → (Option (BalancedTree a)) → Boolean
+	rec none? 0 false (3 eq gt lt 1 ?(!0))
+		eq true
+		gt 2 1 \\(!0)
+		lt 2 1 //(!0)
+
+:test (<?>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))