diff options
| -rw-r--r-- | src/Eval.hs | 26 | ||||
| -rw-r--r-- | src/Helper.hs | 23 |
2 files changed, 27 insertions, 22 deletions
diff --git a/src/Eval.hs b/src/Eval.hs index 6f8a0a5..d248b98 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -281,17 +281,15 @@ evalCommand inp s@(EnvState env@(Environment envDefs) conf cache) = \case pure s -- TODO: Reduce redundancy -showResult :: Expression -> Expression -> Environment -> IO () -showResult orig reduced env = - putStrLn - $ "<> " - <> (show orig) - <> "\n*> " - <> (show reduced) - <> "\n?> " - <> (humanifyExpression reduced) - <> "\n#> " - <> (matchingFunctions reduced env) +showResult :: Expression -> Environment -> IO () +showResult reduced env = + let matching = matchingFunctions reduced env + humanified = humanifyExpression reduced + in putStrLn + $ "*> " + <> (show reduced) + <> (if null humanified then "" else "\n?> " <> humanified) + <> (if null matching then "" else "\n#> " <> matching) evalInstruction :: Instruction -> EnvState -> (EnvState -> IO EnvState) -> IO EnvState @@ -313,7 +311,7 @@ evalInstruction (ContextualInstruction instr inp) s@(EnvState env conf _) rec = Left err -> print err >> rec s Right e' -> do red <- reduce e' - showResult e' red env + showResult red env rec s ) Commands cs -> yeet (pure s) cs >>= rec @@ -362,7 +360,7 @@ evalFileConf path conf = do $ ContextualError (UndefinedIdentifier entryFunction) (Context "" path) Just EnvDef { _exp = e } -> do red <- reduce $ Application e arg - showResult e red (Environment env) + showResult red (Environment env) evalFile :: String -> IO () evalFile path = evalFileConf path (defaultConf path) @@ -379,7 +377,7 @@ exec path rd conv = do Left exception -> print (exception :: IOError) Right f' -> do red <- reduce $ Application e arg - showResult e red (Environment M.empty) + showResult red (Environment M.empty) where e = fromBinary $ conv f' repl :: EnvState -> InputT M () diff --git a/src/Helper.hs b/src/Helper.hs index 7c49815..9bc2fb0 100644 --- a/src/Helper.hs +++ b/src/Helper.hs @@ -260,19 +260,26 @@ matchingFunctions e (Environment env) = (\EnvDef { _exp = e' } -> e == e') env --- TODO: Expression -> Maybe Char is missing +-- TODO: Show binary as char if in ascii range (=> + humanify strings) maybeHumanifyExpression :: Expression -> Maybe String maybeHumanifyExpression e = - binaryToDecimal e + unaryToDecimal e + <|> binaryToDecimal e <|> ternaryToDecimal e - <|> unaryToDecimal e - <|> decodeStdout e + <|> humanifyList e humanifyExpression :: Expression -> String humanifyExpression e = case maybeHumanifyExpression e of - Nothing -> show e + Nothing -> "" Just h -> h +humanifyList :: Expression -> Maybe String +humanifyList e = do + es <- unlistify e + let conv x = maybe (show x) id (maybeHumanifyExpression x) + m = map conv es + pure $ "{" <> intercalate ", " m <> "}" + --- -- Dec to Bal3 in Bruijn encoding: reversed application with 0=>0; 1=>1; T=>2; end=>3 @@ -304,7 +311,7 @@ decimalToUnary n | otherwise = Abstraction $ Abstraction $ gen n unaryToDecimal :: Expression -> Maybe String unaryToDecimal e = do res <- resolve e - return $ show $ (sum res :: Integer) + return $ show (sum res :: Integer) <> "u" where multiplier (Bruijn 1) = Just 1 multiplier _ = Nothing @@ -320,7 +327,7 @@ unaryToDecimal e = do binaryToDecimal :: Expression -> Maybe String binaryToDecimal e = do res <- resolve e - return $ show $ (sum $ zipWith (*) res (iterate (* 2) 1) :: Integer) + return $ show (sum $ zipWith (*) res (iterate (* 2) 1) :: Integer) <> "b" where multiplier (Bruijn 0) = Just 0 multiplier (Bruijn 1) = Just 1 @@ -337,7 +344,7 @@ binaryToDecimal e = do ternaryToDecimal :: Expression -> Maybe String ternaryToDecimal e = do res <- resolve e - return $ show $ (sum $ zipWith (*) res (iterate (* 3) 1) :: Integer) + return $ show (sum $ zipWith (*) res (iterate (* 3) 1) :: Integer) <> "t" where multiplier (Bruijn 0) = Just 0 multiplier (Bruijn 1) = Just 1 |