diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Binary.hs | 16 | ||||
| -rw-r--r-- | src/Eval.hs | 35 | ||||
| -rw-r--r-- | src/Helper.hs | 30 | ||||
| -rw-r--r-- | src/Parser.hs | 2 |
4 files changed, 37 insertions, 46 deletions
diff --git a/src/Binary.hs b/src/Binary.hs index 974bf8d..2a1c891 100644 --- a/src/Binary.hs +++ b/src/Binary.hs @@ -20,24 +20,8 @@ toBinary (Bruijn x ) = (replicate (x + 1) '1') ++ "0" toBinary (Abstraction exp ) = "00" ++ toBinary exp toBinary (Application exp1 exp2) = "01" ++ (toBinary exp1) ++ (toBinary exp2) --- Stolen from John Tromp --- fromBinary :: String -> Expression --- fromBinary = foldr --- (\x -> Abstraction . (Application . Application (Bruijn 0) . code $ x)) --- nil --- where --- nil = code '1' --- code '0' = Abstraction (Abstraction (Bruijn 1)) --- code '1' = Abstraction (Abstraction (Bruijn 0)) --- code x = fromBinary (showsBin 8 (ord x) "") --- showsBin n x = if n == 0 --- then id --- else let (x', b) = divMod x 2 in showsBin (n - 1) x' . (intToDigit b :) - --- https://github.com/ljedrz/blc/blob/master/src/encoding/binary.rs fromBinary' :: String -> (Expression, String) fromBinary' = \case - -- "" -> (Bruijn 0, "") '0' : '0' : rst -> let (exp, rst) = fromBinary' rst in (Abstraction exp, rst) '0' : '1' : rst -> diff --git a/src/Eval.hs b/src/Eval.hs index ebca545..1c33fa2 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -16,6 +16,7 @@ import Paths_bruijn import Reducer import System.Console.Haskeline import System.Console.Haskeline.Completion +import System.Directory import System.Environment import System.Exit import System.IO @@ -92,24 +93,27 @@ eval (line : ls) state@(EnvState env) isRepl = else eval ls (EnvState env') isRepl Import path -> do lib <- getDataFileName path -- TODO: Use actual lib directory - exists <- doesFileExist lib + exists <- pure False -- doesFileExist lib loadFile $ if exists then lib else path Evaluate exp -> let (res, env') = evalExp exp `runState` env - in putStrLn - (case res of - Left err -> show err - Right exp -> - "<> " - <> (show exp) - <> "\n*> " - <> (show reduced) - <> "\t(" - <> (show $ binaryToDecimal reduced) - <> ")" - where reduced = reduce exp - ) - >> eval ls state isRepl + in + putStrLn + (case res of + Left err -> show err + Right exp -> + "<> " + <> (show exp) + <> "\n*> " + <> (show reduced) + <> (if likeTernary reduced + then + "\t(" <> (show $ ternaryToDecimal reduced) <> ")" + else "" + ) + where reduced = reduce exp + ) + >> eval ls state isRepl Test exp1 exp2 -> let (res, _) = evalTest exp1 exp2 `runState` env in case res of @@ -201,3 +205,4 @@ evalMain = do ["-E", path] -> exec path (try . readFile) id ['-' : _] -> usage [path ] -> evalFile path print id + _ -> usage diff --git a/src/Helper.hs b/src/Helper.hs index d45a02b..76a1f83 100644 --- a/src/Helper.hs +++ b/src/Helper.hs @@ -24,23 +24,25 @@ instance Show Expression where type Environment = [(String, Expression)] type Program = State Environment -decimalToBinary :: Integer -> Expression -decimalToBinary n = Abstraction $ Abstraction $ Abstraction $ Abstraction $ gen - n - where -- TODO: Consider switching 0 and 1 for better readability - fix 0 = 1 - fix 1 = 0 +likeTernary :: Expression -> Bool +likeTernary (Abstraction (Abstraction (Abstraction (Abstraction _)))) = True +likeTernary _ = False + +-- Dec to Bal3 in Bruijn encoding: reversed application with 0=>0; 1=>1; T=>2; end=>3 +-- e.g. 0=0=[[[[3]]]]; 2=1T=[[[[2 (0 3)]]]] -5=T11=[[[[0 (0 (2 3))]]]] +decimalToTernary :: Integer -> Expression +decimalToTernary n = + Abstraction $ Abstraction $ Abstraction $ Abstraction $ gen n + where gen 0 = Bruijn 3 - gen 1 = Application (Bruijn 0) (gen 0) - gen n | n < 0 = Application (Bruijn 2) (gen (-n)) - | otherwise = Application (Bruijn $ fix $ mod n 2) (gen $ div n 2) + gen n = Application (Bruijn $ fromIntegral $ mod n 3) (gen $ div (n + 1) 3) -binaryToDecimal :: Expression -> Integer -binaryToDecimal exp = sum $ zipWith (*) (resolve exp) (iterate (* 2) 1) +ternaryToDecimal :: Expression -> Integer +ternaryToDecimal exp = sum $ zipWith (*) (resolve exp) (iterate (* 3) 1) where - multiplier (Bruijn 0) = 1 - multiplier (Bruijn 1) = 0 - multiplier (Bruijn 2) = -1 -- TODO + multiplier (Bruijn 0) = 0 + multiplier (Bruijn 1) = 1 + multiplier (Bruijn 2) = (-1) resolve' (Application x@(Bruijn _) (Bruijn 3)) = [multiplier x] resolve' (Application fst@(Bruijn _) rst@(Application _ _)) = (multiplier fst) : (resolve' rst) diff --git a/src/Parser.hs b/src/Parser.hs index 16f4202..29f40b9 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -58,7 +58,7 @@ parseNumeral :: Parser Expression parseNumeral = do num <- number space - pure $ decimalToBinary num + pure $ decimalToTernary num where sign :: Parser (Integer -> Integer) sign = (char '-' >> return negate) <|> (char '+' >> return id) |