diff options
| -rw-r--r-- | app/Main.hs | 115 | ||||
| -rw-r--r-- | birb.cabal | 20 | ||||
| -rw-r--r-- | package.yaml | 1 | ||||
| -rw-r--r-- | readme.md | 1 | ||||
| -rw-r--r-- | samples/biology.birb | 1 |
5 files changed, 126 insertions, 12 deletions
diff --git a/app/Main.hs b/app/Main.hs index 4c6b30f..656247d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,115 @@ -module Main (main) where +module Main + ( main + ) where -import Lib +import Data.Bifunctor ( first + , second + ) +import Data.Char ( digitToInt + , isDigit + ) +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 + deriving (Eq, Ord) + +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 + +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 + | (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 + +shift :: Int -> Term -> Term +shift i (Idx j) | i <= j = Idx $ j + 1 + | otherwise = Idx j +shift i (App a b) = App (shift i a) (shift i b) +shift i (Abs a ) = Abs (shift (i + 1) a) + +subst :: Int -> Term -> Term -> Term +subst i (Idx j) c | i == j = c + | j > i = Idx $ j - 1 + | otherwise = Idx j +subst i (App a b) c = App (subst i a c) (subst i b c) +subst i (Abs a ) c = Abs (subst (i + 1) a (shift 0 c)) + +nf :: Term -> Term +nf (App l r) = case nf l of + Abs t -> nf (subst 0 t r) + t -> App t (nf r) +nf (Abs t) = Abs (nf t) +nf t = t + +fromBirbs :: String -> Term +fromBirbs s = + let birbsies = Map.fromList $ second read <$> trace (show birbs) birbs + filtered = filter (`Map.member` birbsies) s + term = termify filtered birbsies + in nf term + +fromTerm :: Term -> String +fromTerm t = + let flipped = (\(a, b) -> (b, a)) <$> birbs + termsies = Map.fromList $ first read <$> trace (show flipped) flipped + in birbify t termsies main :: IO () -main = someFunc +main = do + args <- getArgs + file <- readFile (head args) + let reduced = fromBirbs file + print reduced + let duced = fromTerm reduced + print duced + return () + +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") -- + ] @@ -7,20 +7,19 @@ cabal-version: 1.12 name: birb version: 0.1.0.0 description: Please see the README on GitHub at <https://github.com/githubuser/birb#readme> -homepage: https://github.com/githubuser/birb#readme -bug-reports: https://github.com/githubuser/birb/issues -author: Author name here -maintainer: example@example.com -copyright: 2023 Author name here -license: BSD3 +homepage: https://github.com/marvinborner/birb#readme +bug-reports: https://github.com/marvinborner/birb/issues +author: Marvin Borner +maintainer: git@marvinborner.de +copyright: 2023 Marvin Borner +license: MIT build-type: Simple extra-source-files: - README.md - CHANGELOG.md + readme.md source-repository head type: git - location: https://github.com/githubuser/birb + location: https://github.com/marvinborner/birb library exposed-modules: @@ -32,6 +31,7 @@ library ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 + , containers default-language: Haskell2010 executable birb-exe @@ -44,6 +44,7 @@ executable birb-exe build-depends: base >=4.7 && <5 , birb + , containers default-language: Haskell2010 test-suite birb-test @@ -57,4 +58,5 @@ test-suite birb-test build-depends: base >=4.7 && <5 , birb + , containers default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index eebef40..62fc230 100644 --- a/package.yaml +++ b/package.yaml @@ -20,6 +20,7 @@ description: Please see the README on GitHub at <https://github.com/gith dependencies: - base >= 4.7 && < 5 +- containers ghc-options: - -Wall @@ -42,6 +42,7 @@ a PR to improve biological accuracy. - π¦’π¦π¦ $\rightsquigarrow$ π - π¦π€ $\rightsquigarrow$ π₯ - π¦π¦ $\rightsquigarrow$ ποΈ +- π§π§ $\rightsquigarrow$ π¦ ## Arithmetic diff --git a/samples/biology.birb b/samples/biology.birb new file mode 100644 index 0000000..732f4ee --- /dev/null +++ b/samples/biology.birb @@ -0,0 +1 @@ +πͺΆπ¦ |