Oof

8 files changed, 171 insertions, 81 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 656247d..29f864e 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -10,7 +10,6 @@ import           Data.Char                      ( digitToInt
                                                 )
 import           Data.Map                       ( Map )
 import qualified Data.Map                      as Map
-import           Debug.Trace
 import           System.Environment             ( getArgs )
 
 data Term = Abs Term | App Term Term | Idx Int
@@ -21,32 +20,33 @@ type Birb = Char
 invalid :: a
 invalid = error "invalid program state"
 
-instance Read Term where
-  readsPrec _ s
-    | c : s' <- s, isDigit c
-    = [(Idx (digitToInt c), s')]
-    | '!' : s' <- s, [(t, s'')] <- reads s'
-    = [(Abs t, s'')]
-    | '@' : s' <- s, [(t, s'')] <- reads s', [(u, s''')] <- reads s''
-    = [(App t u, s''')]
-    | otherwise
-    = invalid
-
 instance Show Term where
-  showsPrec _ (Abs body   ) = showString "\\" . shows body
-  showsPrec _ (App lhs rhs) = showString "@" . shows lhs . shows rhs
-  showsPrec _ (Idx i      ) = shows i
+  showsPrec _ (Abs body) = showString "[" . shows body . showString "]"
+  showsPrec _ (App lhs rhs) =
+    showString "(" . shows lhs . showString " " . shows rhs . showString ")"
+  showsPrec _ (Idx i) = shows i
 
 birbify :: Term -> Map Term Birb -> String
 birbify t m | t `Map.member` m = [Map.findWithDefault invalid t m]
-            | (Abs a) <- t     = "\\" ++ birbify a m
-            | (App l r) <- t   = "@" ++ birbify l m ++ birbify r m
+            | (Abs a) <- t     = "[" ++ birbify a m ++ "]"
+            | (App l r) <- t   = "(" ++ birbify l m ++ " " ++ birbify r m ++ ")"
             | (Idx i) <- t     = show i
 
 termify :: String -> Map Birb Term -> Term
-termify [c     ] m = Map.findWithDefault invalid c m
-termify (c : cs) m = App (termify [c] m) (termify cs m)
-termify _        _ = invalid
+termify s m = foldlr (odd $ length lst) lst
+ where
+  go [c     ] = [Map.findWithDefault invalid c m]
+  go (c : cs) = go [c] ++ go cs
+  go _        = invalid
+  lst = go s
+
+  -- TODO: Rewrite so last/init aren't needed
+  foldlr :: Bool -> [Term] -> Term
+  foldlr _     [x]      = x
+  foldlr _     [x, y]   = App x y
+  foldlr True  xs       = let t = foldlr False (init xs) in App t (last xs)
+  foldlr False (x : xs) = let t = foldlr True xs in App x t
+  foldlr _     _        = invalid
 
 shift :: Int -> Term -> Term
 shift i (Idx j) | i <= j    = Idx $ j + 1
@@ -70,7 +70,7 @@ nf t       = t
 
 fromBirbs :: String -> Term
 fromBirbs s =
-  let birbsies = Map.fromList $ second read <$> trace (show birbs) birbs
+  let birbsies = Map.fromList $ second parse <$> birbs
       filtered = filter (`Map.member` birbsies) s
       term     = termify filtered birbsies
   in  nf term
@@ -78,7 +78,7 @@ fromBirbs s =
 fromTerm :: Term -> String
 fromTerm t =
   let flipped  = (\(a, b) -> (b, a)) <$> birbs
-      termsies = Map.fromList $ first read <$> trace (show flipped) flipped
+      termsies = Map.fromList $ first parse <$> flipped
   in  birbify t termsies
 
 main :: IO ()
@@ -86,30 +86,41 @@ main = do
   args <- getArgs
   file <- readFile (head args)
   let reduced = fromBirbs file
-  print reduced
-  let duced = fromTerm reduced
-  print duced
+  let duced   = fromTerm reduced
+  putStrLn duced
   return ()
 
+-- this isn't really relevant but I'm too lazy to type the terms manually
+parse :: String -> Term
+parse = fst . go
+ where
+  go ('!' : cs) = let (t, cs') = go cs in (Abs t, cs')
+  go ('@' : cs) =
+    let (l, cs' ) = go cs
+        (r, cs'') = go cs'
+    in  (App l r, cs'')
+  go (i : cs) | isDigit i = (Idx $ digitToInt i, cs)
+  go _                    = invalid
+
 birbs :: [(Birb, String)]
 birbs =
-  [ ('\x1FAB6', "!!!@@201")
-  , ('\x1F426', "!0")
-  , ('\x1F54A', "!!!!@@32@10")
-  , ('\x1F424', "!!@0@@110")
-  , ('\x1F425', "!!!@0@12")
-  -- , ('\x1F423', "!@00!@00") --
-  , ('\x1F989', "!!@0@10")
-  , ('\x1F414', "!@00")
-  , ('\x1F986', "!!1")
-  , ('\x1F9A4', "!!@01")
-  -- , ('\x1F9A9', "!!@1@00!@1@00") --
-  , ('\x1F9A2', "!!!@@20@10")
-  , ('\x1FABD', "!!!!@@3@20@10")
-  , ('\x1F983', "!!@@100")
-  , ('\x1F413', "!!!@@012")
-  , ('\x1F99A', "!!!@1@20")
-  , ('\x1F99C', "!!!@2@10")
-  , ('\x1F985', "!!!!!@@43@@210")
-  -- , ('\x1F427', "!0!!!@@20@10!!1") --
+  [ ('\x1F426', "!0") -- bird
+  , ('\x1F54A', "!!!!@@32@10") -- dove
+  , ('\x1F424', "!!@0@@110") -- chick
+  , ('\x1F425', "!!1") -- front chick
+  , ('\x1F423', "!!!@0@21") -- hatching chick
+  , ('\x1F989', "!!@0@10") -- owl
+  , ('\x1F986', "!!@0@12") -- duck
+  , ('\x1F9A4', "!!@01") -- dodo
+  , ('\x1F9A9', "!!!@@201") -- flamingo
+  , ('\x1F9A2', "!!!@@20@10") -- swan
+  , ('\x1FABD', "!!!!@@3@20@10") -- wing
+  , ('\x1F99A', "!!!@1@20") -- peacock
+  , ('\x1F99C', "!@00") -- parrot
+  , ('\x1F985', "!!!!!@@43@@210") -- eagle
+  , ('\x1F427', "!!!@2@10") -- penguin
+-- , ('\x1FAB6', "") -- feather
+-- , ('\x1F413', "") -- rooster
+-- , ('\x1F414', "") -- chicken
+-- , ('\x1F983', "") -- turkey
   ]
diff --git a/birb.cabal b/birb.cabal
index 53a2eab..e78c3dd 100644
--- a/birb.cabal
+++ b/birb.cabal
@@ -34,7 +34,7 @@ library
     , containers
   default-language: Haskell2010
 
-executable birb-exe
+executable birb
   main-is: Main.hs
   other-modules:
       Paths_birb
diff --git a/package.yaml b/package.yaml
index 62fc230..5ea0704 100644
--- a/package.yaml
+++ b/package.yaml
@@ -37,7 +37,7 @@ library:
   source-dirs: src
 
 executables:
-  birb-exe:
+  birb:
     main:                Main.hs
     source-dirs:         app
     ghc-options:
diff --git a/readme.md b/readme.md
index 400ab77..c64fd84 100644
--- a/readme.md
+++ b/readme.md
@@ -1,55 +1,112 @@
 # Birb
 
-| bird | term                      | birb        | bird             |
-|:-----|:--------------------------|:------------|------------------|
-| 🪶   | c `[[[2 0 1]]]`           | cardinal    | feather          |
-| 🐦   | i `[0]`                   | idiot       | bird             |
-| 🕊️   | d `[[[[3 2 (1 0)]]]]`     | dove        | dove             |
-| 🐤   | t `[[0 (1 1 0)]]`         | turing      | baby chick       |
-| 🐥   | q’’’ `[[[0 (1 2)]]]`      | quacky      | front baby chick |
-| 🐣   | Ω `[0 0] [0 0]`           | omega       | hatching chick   |
-| 🦉   | o `[[0 (1 0)]]`           | owl         | owl              |
-| 🐔   | m `[0 0]`                 | mockingbird | chicken          |
-| 🦆   | k `[[1]]`                 | kestrel     | duck             |
-| 🦤   | t `[[0 1]]`               | thrush      | dodo             |
-| 🦩   | y `[[1 (0 0)] [1 (0 0)]]` | sage        | flamingo         |
-| 🦢   | s `[[[2 0 (1 0)]]]`       | starling    | swan             |
-| 🪽   | φ `[[[[3 (2 0) (1 0)]]]]` | phoenix     | wing             |
-| 🦃   | w `[[1 0 0]]`             | warbler     | turkey           |
-| 🐓   | f `[[[0 1 2]]]`           | finch       | rooster          |
-| 🦚   | q `[[[1 (2 0)]]]`         | queer       | peacock          |
-| 🦜   | b `[[[2 (1 0)]]]`         | bluebird    | parrot           |
-| 🦅   | e `[[[[[4 3 (2 1 0)]]]]]` | eagle       | eagle            |
-| 🐧   | ι `[0 s k]`               | iota        | penguin          |
-
-The mappings and their paired reduction are *not* biologically accurate!
-Unfortunately the Unicode team does not have enough bird emojis. Create
-a PR to improve biological accuracy.
+Birb is an *advanced* programming language that only consists of bird
+emojis 🐣. Each emoji gets substituted by a [*combinator
+bird*](https://www.angelfire.com/tx4/cus/combinator/birds.html) of pure
+lambda calculus.
+
+## Birbs
+
+Unfortunately, the Unicode standard does not yet have many
+(single-character) birds. These are the ones currently mapped/supported:
+
+| emoji | animal         | combinator   | bruijn              | term                               |
+|:-----:|----------------|--------------|---------------------|------------------------------------|
+|  🦉   | owl            | owl          | `[[0(10)]]`         | $\lambda ab.b(ab)$                 |
+|  🦅   | eagle          | eagle        | `[[[[[43(210)]]]]]` | $\lambda abcde.ab(cde)$            |
+|  🪽   | wing           | phoenix      | `[[[[3(20)(10)]]]]` | $\lambda abcd.a(bd)(cd)$           |
+|  🕊️   | dove           | dove         | `[[[[32(10)]]]]`    | $\lambda abcd.ab(cd)$              |
+|  🦜   | parrot         | mockingbird  | `[00]`              | $\lambda a.aa$                     |
+|  🦆   | duck           | quacky       | `[[[0(12)]]]`       | $\lambda abc.c(ba)$                |
+|  🐤   | touring chick  | turing       | `[[0(110)]]`        | $\lambda ab.b(aab)$                |
+|  🐥   | kool chick     | kestrel      | `[[1]]`             | $\lambda ab.a$                     |
+|  🐣   | hatching chick | quirky       | `[[[0(21)]]]`       | $\lambda abc.c(ab)$                |
+|  🐦   | simple bird    | identity     | `[0]`               | $\lambda a.a$                      |
+|  🦚   | peacock        | queer        | `[[[1(20)]]]`       | $\lambda abc.b(ac)$                |
+|  🦤   | dodo           | sage         | `[[0(11)][0(11)]]`  | $\lambda ab.b(aa)\lambda ab.b(aa)$ |
+|  🐧   | penguin        | blackbird    | `[[[2(10)]]]`       | $\lambda abc.a(bc)$                |
+|  🦢   | swan           | substitution | `[[[20(10)]]]`      | $\lambda abc.ac(bc)$               |
+|  🦩   | flamingo       | cardinal     | `[[[201]]]`         | $\lambda abc.acb$                  |
+
+Lonely/unmatched birbs: 🐔🦃🐓
 
 # Syntax
 
-- `[birb]+`: Birb (left-associative)
+- `[birb]+`: Birb
 - everything else: Comment
 
+# Semantics
+
+Birbs stagger as they walk: they are reduced in alternating associative
+order, starting with birb index $\lfloor\frac{\texttt{len}}{2}\rfloor$:
+
+    🐦🐦 -> (🐦🐦)
+    🐦🐦🐦 -> ((🐦🐦)🐦)
+    🐦🐦🐦🐦 -> (🐦((🐦🐦)🐦))
+    🐦🐦🐦🐦🐦 -> ((🐦((🐦🐦)🐦))🐦)
+    🐦🐦🐦🐦🐦🐦 -> (🐦((🐦((🐦🐦)🐦))🐦))
+    🐦🐦🐦🐦🐦🐦🐦 -> ((🐦((🐦((🐦🐦)🐦))🐦))🐦)
+
 # Examples
 
-## Biology
+You can find more examples in the `samples/` directory.
+
+## Relationships
 
-- 🐔🐔 $\rightsquigarrow$ 🐣
-- 🪶🦜 $\rightsquigarrow$ 🦚
+- 🦉🐦 $\rightsquigarrow$ 🦜
 - 🦢🐦 $\rightsquigarrow$ 🦉
-- 🦢🦆🦆 $\rightsquigarrow$ 🐦
-- 🦢🐦🐦 $\rightsquigarrow$ 🐔
-- 🦜🐤 $\rightsquigarrow$ 🐥
-- 🦜🦜 $\rightsquigarrow$ 🕊️
-- 🐧🐧 $\rightsquigarrow$ 🐦
+- 🐧🐧 $\rightsquigarrow$ 🕊️
+- 🦩🐧 $\rightsquigarrow$ 🦚
+- 🦩🦚 $\rightsquigarrow$ 🐧
+
+One can only imagine what happens if two parrots repeat each other: 🦜🦜
+$\rightsquigarrow$ 💥
 
 ## Arithmetic
 
+For this example I use the Church numerals. Zero would then be encoded
+as 🐥🐦. The successor function can be written as 🦢🐧:
+
+- 🐦🐧🐦🦢🐧🐥🐦 $\rightsquigarrow$ λλ(10) – (Church numeral 1)
+- 🐦🐧🐦🐧🕊️🦢🐧🦢🐧🐥🐦 $\rightsquigarrow$ λλ(1(10)) – (Church numeral
+  2)  
+
+Similarly, one can very obviously translate the Church addition function
+to 🐧🦢🐥🦢🕊️. Now, to calculate $1+2$ based on their increments from
+zero:
+
+- 🦢🐧🦢🐧🐥🐦
+
+Also: 🐧 is $a\cdot b$, 🦜 is $n^n$ and 🦚🐦 $a^b$.
+
+Note that there are many alternative ways to do arithmetic. Try writing
+the functions above with other birbs!
+
 ## Busy ~~beavers~~ birbs
 
+- The touring eagle: 🐦🐦🐦🦅🐤🦅🐤🦅🐤 (~20M BLC bits)
+- more? PR!
+
+# Usage
+
+Install [Haskell’s
+stack](https://docs.haskellstack.org/en/stable/install_and_upgrade/).
+Then,
+
+- `stack run -- file.birb` or `stack run <(echo 🐧🐧)`
+- `stack install` so you can enjoy `birb` from anywhere
+
+If the output cannot be translated to birbs, the raw lambda calculus
+term (with De Bruijn indices) is printed. For the examples above I
+sometimes manually converted the term back to birbs.
+
 # Turing-completeness
 
 The language is probably Turing complete. If the language supported
 left- *and* right-associativity, 🐧 would be enough to prove its
 completeness.
+
+------------------------------------------------------------------------
+
+The idea of the language was originally proposed in 2021 by an
+unknown(?) author on [Esolang](https://esolangs.org/wiki/Birb).
diff --git a/samples/add.birb b/samples/add.birb
new file mode 100644
index 0000000..fc11d4f
--- /dev/null
+++ b/samples/add.birb
@@ -0,0 +1,7 @@
+
+
+🐦🐦🐦🐧🦢🐥🦢🕊️ add ...
+  🐦🐧🐦🐧🕊️ wrapper for two
+    🦢🐧 inc
+      🦢🐧 inc
+        🐥🐦 zero
diff --git a/samples/biology.birb b/samples/biology.birb
index 732f4ee..fa2259a 100644
--- a/samples/biology.birb
+++ b/samples/biology.birb
@@ -1 +1,2 @@
-🪶🦜
+construct list
+🦩🦚
diff --git a/samples/inc0.birb b/samples/inc0.birb
new file mode 100644
index 0000000..d9d227c
--- /dev/null
+++ b/samples/inc0.birb
@@ -0,0 +1,6 @@
+   (s b) (k i)
+-> ((i ((b ((i s) b)) k)) i)
+
+🐦🐧🐦 wrapper
+  🦢🐧 inc
+    🐥🐦 zero
diff --git a/samples/inc1.birb b/samples/inc1.birb
new file mode 100644
index 0000000..656250c
--- /dev/null
+++ b/samples/inc1.birb
@@ -0,0 +1,8 @@
+   b (s b) (s b) (k i)
+-> (i ((i ((b ((d s) b)) s)) b)) (k i)
+-> ((i ((b ((i ((b ((d s) b)) s)) b)) k)) i)
+
+🐦🐧🐦🐧🕊️ wrapper
+  🦢🐧 inc
+    🦢🐧 inc
+      🐥🐦 zero