diff options
| -rw-r--r-- | ChangeLog.md | 3 | ||||
| -rw-r--r-- | README.md | 8 | ||||
| -rw-r--r-- | bruijn.cabal | 2 | ||||
| -rw-r--r-- | config | 15 | ||||
| -rw-r--r-- | package.yaml | 3 | ||||
| -rw-r--r-- | src/Eval.hs | 160 | ||||
| -rw-r--r-- | src/Helper.hs | 9 | ||||
| -rw-r--r-- | stack.yaml.lock | 20 |
8 files changed, 154 insertions, 66 deletions
diff --git a/ChangeLog.md b/ChangeLog.md deleted file mode 100644 index dd254c3..0000000 --- a/ChangeLog.md +++ /dev/null @@ -1,3 +0,0 @@ -# Changelog for bruijn - -## Unreleased changes @@ -137,6 +137,14 @@ of your operating system. Using Haskell Stack, run `stack run -- [args]` to play around and use `stack install` to install bruijn into your path. +## REPL config + +You can configure the REPL by editing the `config` file. `stack install` +or `stack run` will move the file into a data directory. + +More options can be found +[here](https://github.com/judah/haskeline/wiki/UserPreferences). + ## Usage Please read the usage information in the executable by using the `-h` diff --git a/bruijn.cabal b/bruijn.cabal index 67239d3..e257734 100644 --- a/bruijn.cabal +++ b/bruijn.cabal @@ -17,6 +17,8 @@ build-type: Simple extra-source-files: README.md ChangeLog.md +data-files: + config source-repository head type: git @@ -0,0 +1,15 @@ +bellStyle: NoBell +maxHistorySize: Just 1000 +editMode: Vi +completionType: MenuCompletion +completionPaging: True +completionPromptLimit: Just 100 +listCompletionsImmediately: True +historyDuplicates: IgnoreConsecutive + +bind: { { } left +bind: ( ( ) left +bind: [ [ ] left +bind: } right +bind: ] right +bind: ) right diff --git a/package.yaml b/package.yaml index 3be1804..b3390e0 100644 --- a/package.yaml +++ b/package.yaml @@ -10,6 +10,9 @@ extra-source-files: - README.md - ChangeLog.md +data-files: +- config + # Metadata used when publishing your package # synopsis: Short description of your package # category: Web diff --git a/src/Eval.hs b/src/Eval.hs index 74bed01..5744e21 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -5,13 +5,17 @@ module Eval import Binary import Control.Exception import Control.Monad.State +import qualified Control.Monad.State.Strict as StrictState import qualified Data.BitString as Bit import qualified Data.ByteString as Byte +import Data.List import Debug.Trace import Helper import Parser +import Paths_bruijn import Reducer import System.Console.Haskeline +import System.Console.Haskeline.Completion import System.Environment import System.Exit import System.IO @@ -19,12 +23,17 @@ import Text.Megaparsec hiding ( State , try ) -loadFile :: String -> IO Environment +data EnvState = EnvState + { _env :: Environment + } +type M = StrictState.StateT EnvState IO + +loadFile :: String -> IO EnvState loadFile path = do file <- try $ readFile path :: IO (Either IOError String) case file of - Left exception -> print (exception :: IOError) >> pure [] - Right file -> eval (filter (not . null) $ lines file) [] False + Left exception -> print (exception :: IOError) >> pure (EnvState []) + Right file -> eval (filter (not . null) $ lines file) (EnvState []) False evalVar :: String -> Program (Failable Expression) evalVar var = state $ \e -> @@ -48,7 +57,6 @@ evalExp ( Variable var) = evalVar var evalExp ( Abstraction exp) = evalExp exp >>= pure . fmap Abstraction evalExp ( Application f g) = evalApp f g --- TODO: Duplicate function error evalDefine :: String -> Expression -> Program (Failable Expression) evalDefine name exp = evalExp exp @@ -65,50 +73,55 @@ evalTest exp1 exp2 = Right exp1 -> fmap (Test exp1) <$> evalExp exp2 ) -eval :: [String] -> Environment -> Bool -> IO Environment -eval [] env _ = pure env -eval (line : ls) env isRepl = case parse lineParser "BRUIJN" line of - Left err -> putStrLn (errorBundlePretty err) >> pure env - Right instr -> case instr of - Define name exp -> - let (res, env') = evalDefine name exp `runState` env - in case res of - Left err -> putStrLn (show err) >> eval ls env' isRepl - Right _ -> if isRepl - then (putStrLn $ name <> " = " <> show exp) >> pure env' - else eval ls env' isRepl - Import path -> loadFile 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 env isRepl - Test exp1 exp2 -> - let (res, _) = evalTest exp1 exp2 `runState` env - in case res of - Left err -> putStrLn (show err) >> pure env - Right (Test exp1' exp2') -> - when - (reduce exp1' /= reduce exp2') - ( putStrLn - $ "ERROR: test failed: " - <> (show exp1) - <> " != " - <> (show exp2) - ) - >> eval ls env isRepl - _ -> eval ls env isRepl +eval :: [String] -> EnvState -> Bool -> IO EnvState +eval [] state@(EnvState env) _ = return state +eval [""] state@(EnvState env) _ = return state +eval (line : ls) state@(EnvState env) isRepl = + handleInterrupt (putStrLn "<aborted>" >> return state) + $ case parse lineParser "" line of + Left err -> putStrLn (errorBundlePretty err) >> eval ls state isRepl + Right instr -> case instr of + Define name exp -> + let (res, env') = evalDefine name exp `runState` env + in case res of + Left err -> + putStrLn (show err) >> eval ls (EnvState env') isRepl + Right _ -> if isRepl + then (putStrLn $ name <> " = " <> show exp) + >> return (EnvState env') + else eval ls (EnvState env') isRepl + Import path -> loadFile 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 + Test exp1 exp2 -> + let (res, _) = evalTest exp1 exp2 `runState` env + in case res of + Left err -> putStrLn (show err) >> pure state + Right (Test exp1' exp2') -> + when + (reduce exp1' /= reduce exp2') + ( putStrLn + $ "ERROR: test failed: " + <> (show exp1) + <> " != " + <> (show exp2) + ) + >> eval ls state isRepl + _ -> eval ls state isRepl where lineParser = if isRepl then parseReplLine else parseLine evalFunc :: String -> Environment -> Maybe Expression @@ -116,17 +129,9 @@ evalFunc func env = do exp <- lookup func env pure $ reduce exp -repl :: Environment -> InputT IO () -repl env = - getInputLine "λ " - >>= (\case - Nothing -> pure () - Just line -> (lift $ eval [line] env True) >>= repl - ) - evalFile :: String -> (a -> IO ()) -> (Expression -> a) -> IO () evalFile path write conv = do - env <- loadFile path + EnvState env <- loadFile path case evalFunc "main" env of Nothing -> putStrLn $ "ERROR: main function not found" Just exp -> write $ conv exp @@ -138,6 +143,44 @@ exec path read conv = do Left exception -> print (exception :: IOError) Right file -> print $ reduce $ fromBinary $ conv file +repl :: EnvState -> InputT M () +repl state = + (handleInterrupt (return $ Just "") $ withInterrupt $ getInputLine + "\ESC[36mλ\ESC[0m " + ) + >>= (\case + Nothing -> return () + Just line -> do + state <- (liftIO $ eval [line] state True) + lift (StrictState.put state) + repl state + ) + +lookupCompletion :: String -> M [Completion] +lookupCompletion str = do + (EnvState env) <- StrictState.get + return $ map (\(s, _) -> Completion s s False) $ filter + (\(s, _) -> str `isPrefixOf` s) + env + +completionSettings :: String -> Settings M +completionSettings history = Settings + { complete = completeWord Nothing " \n" lookupCompletion + , historyFile = Just history + , autoAddHistory = True + } + +runRepl :: IO () +runRepl = do + config <- getDataFileName "config" + history <- getDataFileName "history" + prefs <- readPrefs config + let looper = runInputTWithPrefs prefs + (completionSettings history) + (withInterrupt $ repl (EnvState [])) + code <- StrictState.evalStateT looper (EnvState []) + return code + usage :: IO () usage = putStrLn "Invalid arguments. Use 'bruijn [file]' instead" @@ -145,8 +188,7 @@ evalMain :: IO () evalMain = do args <- getArgs case args of - [] -> runInputT defaultSettings { historyFile = Just ".bruijn-history" } - $ repl [] + [] -> runRepl ["-c", path] -> evalFile path (Byte.putStr . Bit.realizeBitStringStrict) (toBitString . toBinary) diff --git a/src/Helper.hs b/src/Helper.hs index 0045bd1..d45a02b 100644 --- a/src/Helper.hs +++ b/src/Helper.hs @@ -15,10 +15,11 @@ data Expression = Bruijn Int | Variable String | Abstraction Expression | Applic data Instruction = Define String Expression | Evaluate Expression | Comment String | Import String | Test Expression Expression deriving (Show) instance Show Expression where - show (Bruijn x ) = show x - show (Variable var ) = var - show (Abstraction exp ) = "[" <> show exp <> "]" - show (Application exp1 exp2) = "(" <> show exp1 <> " " <> show exp2 <> ")" + show (Bruijn x ) = "\ESC[31m" <> show x <> "\ESC[0m" + show (Variable var) = "\ESC[35m" <> var <> "\ESC[0m" + show (Abstraction exp) = "\ESC[36m[\ESC[0m" <> show exp <> "\ESC[36m]\ESC[0m" + show (Application exp1 exp2) = + "\ESC[33m(\ESC[0m" <> show exp1 <> " " <> show exp2 <> "\ESC[33m)\ESC[0m" type Environment = [(String, Expression)] type Program = State Environment diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..77b8576 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,20 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: bitstring-0.0.0@sha256:7638c1c515d728a84507e33c830854cfd141a5bcabec6963e68f52baf27979e9,1248 + pantry-tree: + size: 284 + sha256: 2006295f9a9943177952b9b0bfee7de96d5f86d8f989de7dd154159705fa2572 + original: + hackage: bitstring-0.0.0@sha256:7638c1c515d728a84507e33c830854cfd141a5bcabec6963e68f52baf27979e9,1248 +snapshots: +- completed: + size: 617368 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/3.yaml + sha256: a209d3455279ee76eb45f01f73bbb960ceaaa8dfad8891435384689df4dcb653 + original: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/3.yaml |