diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Eval.hs | 12 | ||||
| -rw-r--r-- | src/Helper.hs | 28 | ||||
| -rw-r--r-- | src/Parser.hs | 26 | ||||
| -rw-r--r-- | src/Reducer.hs | 2 |
4 files changed, 60 insertions, 8 deletions
diff --git a/src/Eval.hs b/src/Eval.hs index c40a118..47ca4ca 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -78,8 +78,16 @@ evalRepl line env = case parse parseReplLine "REPL" line of let (res, env') = evalExp exp `runState` env in outputStrLn (case res of - Left err -> show err - Right exp -> (show exp) <> "\n-> " <> (show $ reduce exp) + Left err -> show err + Right exp -> + "<> " + <> (show exp) + <> "\n*> " + <> (show reduced) + <> "\t(" + <> (show $ ternaryToDecimal reduced) + <> ")" + where reduced = reduce exp ) >> pure env Load path -> diff --git a/src/Helper.hs b/src/Helper.hs index a8e393e..5e02a94 100644 --- a/src/Helper.hs +++ b/src/Helper.hs @@ -18,9 +18,35 @@ data Instruction = Define String Expression | Evaluate Expression | Comment Stri deriving (Show) instance Show Expression where show (Bruijn x ) = show x - show (Variable var ) = show var + show (Variable var ) = var show (Abstraction exp ) = "[" <> show exp <> "]" show (Application exp1 exp2) = "(" <> show exp1 <> " " <> show exp2 <> ")" type Environment = [(String, Expression)] type Program = State Environment + +-- Dec to Bal3 in Bruijn encoding: reversed application with 1=>0; 0=>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 -- TODO: Consider switching 0 and 1 for better readability + fix 0 = 1 + fix 1 = 0 + fix 2 = 2 + gen 0 = Bruijn 3 + gen n = Application (Bruijn $ fix $ mod n 3) (gen $ div (n + 1) 3) + +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) + resolve' (Application x@(Bruijn _) (Bruijn 3)) = [multiplier x] + resolve' (Application fst@(Bruijn _) rst@(Application _ _)) = + (multiplier fst) : (resolve' rst) + resolve' _ = [0] + resolve (Abstraction (Abstraction (Abstraction (Abstraction n)))) = + resolve' n + resolve _ = [0] diff --git a/src/Parser.hs b/src/Parser.hs index 1669bcd..6fbeca4 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -1,5 +1,9 @@ -module Parser where +module Parser + ( parseLine + , parseReplLine + ) where +import Control.Monad ( ap ) import Data.Functor.Identity import Helper import Text.Parsec @@ -8,8 +12,8 @@ import qualified Text.Parsec.Token as Token languageDef :: GenLanguageDef String u Identity languageDef = emptyDef { Token.commentLine = "#" - , Token.identStart = letter - , Token.identLetter = alphaNum <|> char '?' + , Token.identStart = letter <|> char '_' + , Token.identLetter = alphaNum <|> oneOf "?!'_" , Token.reservedOpNames = ["[", "]", "="] } @@ -49,6 +53,16 @@ parseBruijn = do spaces pure $ Bruijn $ (read . pure) idx +parseNumeral :: Parser Expression +parseNumeral = do + num <- number + spaces + pure $ decimalToTernary num + where + sign = (char '-' >> return negate) <|> (char '+' >> return id) + nat = read <$> many1 digit + number = ap sign nat + parseVariable :: Parser Expression parseVariable = do var <- identifier @@ -57,7 +71,11 @@ parseVariable = do parseSingleton :: Parser Expression parseSingleton = - parseBruijn <|> parseAbstraction <|> parens parseApplication <|> parseVariable + parseBruijn + <|> parseNumeral + <|> parseAbstraction + <|> parens parseApplication + <|> parseVariable parseExpression :: Parser Expression parseExpression = do diff --git a/src/Reducer.hs b/src/Reducer.hs index 0760a82..809687b 100644 --- a/src/Reducer.hs +++ b/src/Reducer.hs @@ -4,7 +4,7 @@ module Reducer import Helper --- TODO: Reduce variable -> later: only reduce main in non-repl +-- TODO: Research interaction nets and optimal reduction (<+>) :: Expression -> Int -> Expression (<+>) (Bruijn x ) n = if x > n then Bruijn (pred x) else Bruijn x |