From b337ecb0944e3f33dcf17032369ea086f39c64e2 Mon Sep 17 00:00:00 2001 From: James Martin Date: Fri, 26 Mar 2021 22:58:45 -0700 Subject: [PATCH] Add arguments to the Ivo interpreter (and shebang support). The supported options are `-h`, `-V`, `-t`, `-T`, and `-c`. Additional arguments are files to be loaded. In the process, these additional changes have been made: * `:check` has been replaced with `:printTypes`; disabling typechecking is no longer possible. * Ivo programs no longer allow top-level expressions; a `main` definition must be used instead. * Traces and type information are now printed to `STDERR`. * The interpreter code underwent /some/ cleanup, but more is still needed. --- README.md | 21 ++- app/Command.hs | 51 +++++++ app/Flags.hs | 115 ++++++++++++++ app/Main.hs | 317 ++++++++++++++++----------------------- app/MonadApp.hs | 97 ++++++++++++ examples/examples.ivo | 36 ++--- package.yaml | 47 +++--- src/Ivo/Syntax/Parser.hs | 29 ++-- 8 files changed, 459 insertions(+), 254 deletions(-) create mode 100644 app/Command.hs create mode 100644 app/Flags.hs create mode 100644 app/MonadApp.hs mode change 100644 => 100755 examples/examples.ivo diff --git a/README.md b/README.md index cfe570d..e7e2d91 100644 --- a/README.md +++ b/README.md @@ -9,8 +9,11 @@ This README serves to document the language as it currently stands, not what the language one day hopes to be. ## Using the Ivo interpreter -You may run the Ivo interpreter using `stack run`; -the interpreter does not take any arguments. +You may run the Ivo interpreter (`ivo`) +by installing it to your local path using `stack install`, +or equivalently, using `stack run [-- args...]`. +For information about `ivo`'s command line arguments, please refer to `ivo --help` +(or `stack run -- --help`). Type in your command, definition, or expression at the prompt: `>> `. Expressions will be typechecked, evaluated using call-by-value, and then printed. @@ -30,17 +33,13 @@ These commands are available: The filename may contain spaces, but trailing whitespace will be trimmed. -* `:check `: +* `:printTypes `: - * If the first argument is `on`, - then expressions will only be evaluated and definitions will only be added - only if typechecking succeeds. + Print to STDERR the inferred types of top-level declarations, + of expressions entered into the interpreters, + of both, or of neither. - * If the second argument is `always`, then inferred types will always be printed; - if it is `decls`, then only the inferred types of declarations will be printed; - otherwise, the type of expressions are never printed.' - - * The default values are `on` `decls`. + This setting defaults to `off`. * `:trace `: diff --git a/app/Command.hs b/app/Command.hs new file mode 100644 index 0000000..15d5aec --- /dev/null +++ b/app/Command.hs @@ -0,0 +1,51 @@ +module Command where + +import MonadApp + +import Data.Text (Text) +import Text.Parsec hiding (label) +import Text.Parsec.Text (Parser) + +data Command + = Trace TraceOpts + | PrintType PrintTypeOpts + | Load FilePath + | Clear + +commandParser :: Parser Command +commandParser = do + char ':' + clear <|> printType <|> trace <|> load + where + trace = Trace <$> do + try $ string "trace" + spaces + try traceOff <|> try traceLocal <|> try traceGlobal + traceOff = TraceOff <$ string "off" + traceLocal = TraceLocal <$ string "local" + traceGlobal = TraceGlobal <$ string "global" + + printType = PrintType <$> do + try $ string "printType" + spaces + try printBoth <|> try printDecls <|> printExprs <|> try printOff + printBoth = PrintBoth <$ string "both" + printDecls = PrintDecls <$ string "decls" + printExprs = PrintExprs <$ string "exprs" + printOff = PrintOff <$ string "off" + + load = Load <$> do + try $ string "load" + spaces + many1 (noneOf " ") + + clear = Clear <$ try (string "clear") + +-- | If the text is not command (i.e. starts with `:`), parse nothing; +-- otherwise, parse the command or return a parse error. +-- +-- This allows attempting to parse a command and then falling back +-- to the expression interpreter if the input is not a command, +-- without forgetting about command parse errors. +parseCommand :: Text -> Either ParseError (Maybe Command) +parseCommand = parse ((Just <$> commandParser <* spaces <* eof) <|> pure Nothing) "input" diff --git a/app/Flags.hs b/app/Flags.hs new file mode 100644 index 0000000..ecb0d58 --- /dev/null +++ b/app/Flags.hs @@ -0,0 +1,115 @@ +module Flags where + +import MonadApp + +import Data.Foldable (foldlM) +import Data.Maybe (isJust) +import System.Console.GetOpt + ( OptDescr (Option), ArgDescr (NoArg, OptArg, ReqArg), ArgOrder (Permute) + , getOpt, usageInfo + ) +import System.Environment (getArgs) + +data Flag + = FlagHelp + | FlagVersion + | FlagProgram String + | FlagPrintTypes (Maybe String) + | FlagTrace (Maybe String) + +flagDescrs :: [OptDescr Flag] +flagDescrs = + [ Option ['h'] ["help"] (NoArg FlagHelp) + "Print to STDOUT this help message and exit." + , Option ['V'] ["version"] (NoArg FlagVersion) + "Print to STDOUT the Ivo version number and exit." + , Option ['c'] [] (ReqArg FlagProgram "FILE") + "After loading all other files, execute the `main` function of this file and exit." + , Option ['T'] ["print-types"] (OptArg FlagPrintTypes "decls|exprs|both") + "Print to STDERR the inferred types for top-level declarations and/or expressions." + , Option ['t'] ["trace"] (OptArg FlagTrace "local|global") + "Print to STDERR each evaluation step, either the analyzed portion of, or the entire, expression." + ] + +data ProgramAction + = PrintHelp + | PrintVersion + | Interpreter ProgramOpts + +defaultProgramAction :: ProgramAction +defaultProgramAction = Interpreter defaultProgramOpts + +data ProgramOpts = ProgramOpts + { pInterpreterOpts :: InterpreterOpts + -- | The files which will be interpreted. + , loadFiles :: [FilePath] + -- | The file whose `main` function will be executed. + , mainFile :: Maybe FilePath + } + +defaultProgramOpts :: ProgramOpts +defaultProgramOpts = ProgramOpts + { pInterpreterOpts = defaultInterpreterOpts + , loadFiles = [] + , mainFile = Nothing + } + +-- | Take all the flags and files passed to the program, +-- and determine what action the program should take based on them. +foldFlags :: [Flag] -> [String] -> Either String ProgramAction +foldFlags flags files = + foldlM applyFlag (Interpreter (defaultProgramOpts { loadFiles = files })) flags + where + applyFlag :: ProgramAction -> Flag -> Either String ProgramAction + applyFlag PrintHelp _ = Right PrintHelp + applyFlag _ FlagHelp = Right PrintHelp + applyFlag PrintVersion _ = Right PrintVersion + applyFlag _ FlagVersion = Right PrintVersion + applyFlag (Interpreter opts) flag = Interpreter <$> applyInterpreterFlag flag + where + applyInterpreterFlag :: Flag -> Either String ProgramOpts + applyInterpreterFlag (FlagProgram file) + | isJust (mainFile opts) = Left "-c can only be specified once" + | otherwise = Right $ opts { mainFile = Just file } + applyInterpreterFlag (FlagPrintTypes mOpt) = case readPrintTypeOpt mOpt of + Left opt -> Left $ "unknown --print-types option: " ++ opt ++ "\n" + Right opt -> Right + opts { pInterpreterOpts = (pInterpreterOpts opts) { printTypeOpts = opt } } + applyInterpreterFlag (FlagTrace mOpt) = case readTraceOpt mOpt of + Left opt -> Left $ "unknown --trace option: " ++ opt ++ "\n" + Right opt -> Right + opts { pInterpreterOpts = (pInterpreterOpts opts) { traceOpts = opt } } + applyInterpreterFlag _ = error "Illegal flag" + + readPrintTypeOpt :: Maybe String -> Either String PrintTypeOpts + readPrintTypeOpt Nothing = Right PrintDecls + readPrintTypeOpt (Just "decls") = Right PrintDecls + readPrintTypeOpt (Just "exprs") = Right PrintExprs + readPrintTypeOpt (Just "both") = Right PrintBoth + readPrintTypeOpt (Just opt) = Left opt + + readTraceOpt :: Maybe String -> Either String TraceOpts + readTraceOpt Nothing = Right TraceLocal + readTraceOpt (Just "local") = Right TraceLocal + readTraceOpt (Just "global") = Right TraceGlobal + readTraceOpt (Just opt) = Left opt + +-- | Given a list of arguments as raw strings, determine what the program should do. +decideAction :: [String] -> Either [String] ProgramAction +decideAction args = case getOpt Permute flagDescrs args of + (flags, files, errs) -> case foldFlags flags files of + Left err -> Left $ err : errs + Right action + | not (null errs) -> Left errs + | otherwise -> Right action + +usageMessage :: String +usageMessage = usageInfo "Usage: ivo [OPTION...] [files...]" flagDescrs + +-- | Read the program's arguments and decide what to do. +getAction :: IO ProgramAction +getAction = do + mAction <- decideAction <$> getArgs + case mAction of + Left errs -> ioError $ userError $ concat errs ++ usageMessage + Right action -> pure action diff --git a/app/Main.hs b/app/Main.hs index 670646e..c9f687c 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,237 +1,172 @@ module Main (main) where +import Command +import Flags +import MonadApp + import Ivo import Control.Exception (IOException, catch) -import Data.Maybe (isJust) -import Control.Monad (when) -import Control.Monad.Catch (MonadMask) -import Control.Monad.Except (MonadError, ExceptT, runExceptT, throwError, liftEither) -import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad (when, zipWithM) +import Control.Monad.Except (throwError, liftEither) +import Control.Monad.IO.Class (liftIO) import Control.Monad.Loops (whileJust_) -import Control.Monad.State (MonadState, StateT, evalStateT, gets, modify) +import Control.Monad.State (gets, modify') import Control.Monad.Trans (lift) -import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict qualified as HM +import Data.Maybe (isJust, fromJust) import Data.Text qualified as T -import System.Console.Haskeline - ( InputT, runInputT, defaultSettings - , outputStrLn, getInputLine, handleInterrupt, withInterrupt - ) -import Text.Parsec -import Text.Parsec.Text (Parser) +import Data.Text.IO (readFile) +import Prelude hiding (readFile) +import System.Console.Haskeline (getInputLine) -outputTextLn :: MonadIO m => Text -> InputT m () -outputTextLn = outputStrLn . T.unpack +main :: IO () +main = do + action <- getAction + case action of + PrintHelp -> putStrLn usageMessage + PrintVersion -> putStrLn "Ivo 0.1.0.0" + Interpreter ProgramOpts { pInterpreterOpts, loadFiles, mainFile } -> do + -- read the file contents first so we can print errors right away + mMainContents <- mapM readArgFile mainFile + filesContents <- mapM readArgFile loadFiles + runAppM pInterpreterOpts do + -- then parse + mMain <- mapM (parseProgramHandleErrors $ fromJust mainFile) mMainContents + case mMain of + Just mainAST + | any (\(name, _, _) -> name == "main") mainAST -> pure () + | otherwise -> throwError "File passed to `-c` does not contain a main function." + Nothing -> pure () --- | Immediately quit the program when interrupted --- without performing any additional actions. --- (Without this, it will print an extra newline for some reason.) -justDie :: (MonadIO m, MonadMask m) => InputT m () -> InputT m () -justDie = handleInterrupt (pure ()) . withInterrupt + files <- zipWithM parseProgramHandleErrors loadFiles filesContents + -- and only finally interpret + mapM_ loadFile files + maybe repl runProgram mMain -data AppState = AppState - { traceOptions :: TraceOptions - , checkOptions :: CheckOptions - , definitions :: HashMap Text CheckExpr - } - -data TraceOptions - -- | Print the entire expression in traces. - = TraceGlobal - -- | Print only the modified part of the expression in traces. - | TraceLocal - -- | Do not trace evaluation. - | TraceOff - -data CheckOptions = CheckOptions - -- | Require that an expression typechecks to run it. - { shouldTypecheck :: Bool - -- | Print the inferred type of an expressions. - , shouldPrintType :: CheckPrintOptions - } - -data CheckPrintOptions = PrintAlways | PrintDecls | PrintOff - deriving Eq - -shouldPrintTypeErrorsQ :: Bool -> CheckOptions -> Bool -shouldPrintTypeErrorsQ isDecl opts - = shouldTypecheck opts - || shouldPrintTypeQ isDecl opts - -shouldPrintTypeQ :: Bool -> CheckOptions -> Bool -shouldPrintTypeQ isDecl opts - = shouldPrintType opts == PrintAlways - || shouldPrintType opts == PrintDecls && isDecl - -defaultAppState :: AppState -defaultAppState = AppState - { traceOptions = TraceOff - , checkOptions = CheckOptions - { shouldTypecheck = True - , shouldPrintType = PrintDecls - } - , definitions = HM.empty - } - -data Command - = Trace TraceOptions - | Check CheckOptions - | Load FilePath - | Clear - -commandParser :: Parser Command -commandParser = do - char ':' - trace <|> check <|> load <|> clear where - trace = Trace <$> do - try $ string "trace " - try traceOff <|> try traceLocal <|> try traceGlobal - traceOff = TraceOff <$ string "off" - traceLocal = TraceLocal <$ string "local" - traceGlobal = TraceGlobal <$ string "global" + -- | When reading the file contents of a file passed as an argument, + -- we want to print usage information and exit if the file can't be opened. + readArgFile :: FilePath -> IO Text + readArgFile file = readFile file `catch` handleException + where + handleException :: IOException -> IO a + handleException _ = ioError $ userError $ + "Could not open file: " ++ file ++ "\n" ++ usageMessage - check = Check <$> do - try $ string "check " - spaces - tc <- (True <$ try (string "on ")) <|> (False <$ try (string "off ")) - spaces - pr <- try printAlways <|> try printDecls <|> try printOff - pure $ CheckOptions tc pr - printAlways = PrintAlways <$ string "always" - printDecls = PrintDecls <$ string "decls" - printOff = PrintOff <$ string "off" +repl :: AppM () +repl = lift $ whileJust_ (fmap T.pack <$> lift (getInputLine ">> ")) \inputText -> + handleErrors do + input <- parseCommandOrTopLevel inputText + either runCommand runTopLevel input - load = Load <$> do - try $ string "load " - spaces - filename <- many1 (noneOf " ") - spaces - pure filename +parseCommandOrTopLevel :: Text -> AppM (Either Command TopLevelAST) +parseCommandOrTopLevel input = do + mCmd <- liftParseError $ parseCommand input + case mCmd of + Nothing -> Right <$> liftParseError (parseTopLevel input) + Just cmd -> pure $ Left cmd - clear = Clear <$ try (string "clear") +parseProgramHandleErrors :: FilePath -> Text -> AppM ProgramAST +parseProgramHandleErrors filename = liftParseError . parse programParser filename -class MonadState AppState m => MonadApp m where - parsed :: Either ParseError a -> m a - typecheckDecl :: Maybe Type -> Text -> CheckExpr -> m (Maybe Scheme) - typecheckExpr :: CheckExpr -> m (Maybe Scheme) - execute :: CheckExpr -> m EvalExpr +liftParseError :: Either ParseError a -> AppM a +liftParseError result = case result of + Left err -> throwError $ T.pack $ show err + Right x -> pure x -type AppM = ExceptT Text (StateT AppState (InputT IO)) +runProgram :: ProgramAST -> AppM () +runProgram program = do + loadFile program + runDeclOrExpr (Right (Var "main")) -liftInput :: InputT IO a -> AppM a -liftInput = lift . lift +loadFile :: ProgramAST -> AppM () +loadFile = mapM_ (\(name, ty, e) -> define name ty $ ast2check e) -instance MonadApp AppM where - parsed (Left err) = throwError $ T.pack $ show err - parsed (Right ok) = pure ok +runTopLevel :: TopLevelAST -> AppM () +runTopLevel = mapM_ runDeclOrExpr - typecheckDecl ty = typecheck ty . Just - typecheckExpr = typecheck Nothing Nothing +runDeclOrExpr :: Either Declaration AST -> AppM () +runDeclOrExpr (Left (name, ty, exprAST)) = do + defs <- gets definitions + let expr = substitute defs $ ast2check exprAST + _ <- typecheckDecl ty name expr + define name ty expr +runDeclOrExpr (Right exprAST) = do + defs <- gets definitions + let expr = substitute defs $ ast2check exprAST + _ <- typecheckExpr expr + value <- execute expr + liftInput $ outputTextLn $ unparseEval value + pure () - execute checkExpr = do - defs <- gets definitions - let expr = check2eval $ substitute defs checkExpr - traceOpts <- gets traceOptions - case traceOpts of - TraceOff -> do - let value = eval expr - liftInput $ outputTextLn $ unparseEval value - pure value - TraceLocal -> do - let (value, trace) = evalTrace expr - liftInput $ mapM_ (outputTextLn . unparseEval) trace - pure value - TraceGlobal -> do - let (value, trace) = evalTraceGlobal expr - liftInput $ mapM_ (outputTextLn . unparseEval) trace - pure value +typecheckDecl :: Maybe Type -> Text -> CheckExpr -> AppM Scheme +typecheckDecl ty = typecheck ty . Just -typecheck :: Maybe Type -> Maybe Text -> CheckExpr -> AppM (Maybe Scheme) +typecheckExpr :: CheckExpr-> AppM Scheme +typecheckExpr = typecheck Nothing Nothing + +typecheck :: Maybe Type -> Maybe Text -> CheckExpr -> AppM Scheme typecheck tann decl expr = do defs <- gets definitions let type_ = maybe infer check tann $ substitute defs expr - checkOpts <- gets checkOptions - if shouldTypecheck checkOpts - then case type_ of - Left err -> throwError $ "Typecheck error: " <> err - Right t -> do - printType checkOpts t - pure $ Just t - else do - case type_ of - Left err -> - when (shouldPrintTypeErrorsQ isDecl checkOpts) $ - liftInput $ outputStrLn $ "Typecheck error: " <> T.unpack err - Right t -> printType checkOpts t - - pure Nothing + case type_ of + Left err -> throwError $ "Typecheck error: " <> err + Right t -> do + printTypeB <- gets $ shouldPrintType isDecl . interpreterOpts + when printTypeB $ outputStderrLn $ prefix <> unparseScheme t + pure t where isDecl = isJust decl - printType opts t = - when (shouldPrintTypeQ isDecl opts) $ - liftInput $ outputTextLn $ prefix <> unparseScheme t - prefix = case decl of Just name -> name <> " : " Nothing -> ": " -define :: MonadApp m => Text -> CheckExpr -> m () -define name expr = modify \appState -> - let expr' = substitute (definitions appState) expr - in appState { definitions = HM.insert name expr' $ definitions appState } - -runDeclOrExpr :: MonadApp m => DeclOrExprAST -> m () -runDeclOrExpr (Left (name, ty, exprAST)) = do +execute :: CheckExpr -> AppM EvalExpr +execute checkExpr = do defs <- gets definitions - let expr = substitute defs $ ast2check exprAST + let expr = check2eval $ substitute defs checkExpr + traceOpts <- gets (traceOpts . interpreterOpts) + case traceOpts of + TraceOff -> do + let value = eval expr + pure value + TraceLocal -> do + let (value, trace) = evalTrace expr + mapM_ (outputStderrLn . unparseEval) trace + pure value + TraceGlobal -> do + let (value, trace) = evalTraceGlobal expr + mapM_ (outputStderrLn . unparseEval) trace + pure value + +define :: Text -> Maybe Type -> CheckExpr -> AppM () +define name ty expr = do _ <- typecheckDecl ty name expr - define name expr -runDeclOrExpr (Right exprAST) = do - defs <- gets definitions - let expr = substitute defs $ ast2check exprAST - _ <- typecheckExpr expr - _ <- execute expr - pure () + modify' \appState -> + let expr' = substitute (definitions appState) expr + in appState { definitions = HM.insert name expr' $ definitions appState } -runProgram :: MonadApp m => ProgramAST -> m () -runProgram = mapM_ runDeclOrExpr +modifyInterpreterOpts :: (InterpreterOpts -> InterpreterOpts) -> AppM () +modifyInterpreterOpts f = + modify' \app -> app { interpreterOpts = f (interpreterOpts app) } -runCommand :: forall m. (MonadApp m, MonadIO m, MonadError Text m) => Command -> m () -runCommand (Trace traceOpts) = modify \app -> app { traceOptions = traceOpts } -runCommand (Check checkOpts) = modify \app -> app { checkOptions = checkOpts } -runCommand Clear = modify \app -> app { definitions = HM.empty } +runCommand :: Command -> AppM () +runCommand (Trace traceOpts) = + modifyInterpreterOpts \opts -> opts { traceOpts } +runCommand (PrintType printTypeOpts) = + modifyInterpreterOpts \opts -> opts { printTypeOpts } +runCommand Clear = modify' \app -> app { definitions = HM.empty } runCommand (Load filePath) = do input <- safeReadFile - program <- parsed $ parse programParser filePath input + program <- liftParseError $ parse programParser filePath input runProgram program where - safeReadFile :: m Text + safeReadFile :: AppM Text safeReadFile = liftEither =<< liftIO ( - (Right . T.pack <$> readFile filePath) + (Right <$> readFile filePath) `catch` handleException) handleException :: IOException -> IO (Either Text Text) handleException = pure . Left . T.pack . show - -parseCommandOrDeclOrExpr :: MonadApp m => Text -> m (Either Command DeclOrExprAST) -parseCommandOrDeclOrExpr input = parsed $ parse commandOrDeclOrExprParser "input" input - where - commandOrDeclOrExprParser = - (Left <$> try commandParser) <|> (Right <$> declOrExprParser) <* spaces <* eof - -main :: IO () -main = runInputT defaultSettings $ justDie $ flip evalStateT defaultAppState $ - whileJust_ (fmap T.pack <$> lift (getInputLine ">> ")) \inputText -> - handleErrors do - input <- parseCommandOrDeclOrExpr inputText - either runCommand runDeclOrExpr input - where - handleErrors :: ExceptT Text (StateT AppState (InputT IO)) () -> StateT AppState (InputT IO) () - handleErrors m = do - result <- runExceptT m - case result of - Left err -> lift $ outputTextLn err - Right _ -> pure () diff --git a/app/MonadApp.hs b/app/MonadApp.hs new file mode 100644 index 0000000..e61092d --- /dev/null +++ b/app/MonadApp.hs @@ -0,0 +1,97 @@ +module MonadApp where + +import Ivo + +import Control.Monad.Catch (MonadMask) +import Control.Monad.Except (ExceptT, runExceptT) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.State (StateT, evalStateT) +import Control.Monad.Trans (lift) +import Data.HashMap.Strict (HashMap) +import Data.Text qualified as T +import Data.Text.IO (hPutStrLn) +import System.Console.Haskeline + ( InputT, runInputT, defaultSettings + , outputStrLn, handleInterrupt, withInterrupt + ) +import System.IO (stderr) + +type AppM = ExceptT Text (StateT AppState (InputT IO)) + +runAppM :: InterpreterOpts -> AppM () -> IO () +runAppM opts = + runInputT defaultSettings . justDie . flip evalStateT appState . handleErrors + where + appState :: AppState + appState = defaultAppState { interpreterOpts = opts } + + -- | Immediately quit the program when interrupted + -- without performing any additional actions. + -- (Without this, it will print an extra newline for some reason.) + justDie :: (MonadIO m, MonadMask m) => InputT m () -> InputT m () + justDie = handleInterrupt (pure ()) . withInterrupt + +handleErrors :: AppM () -> StateT AppState (InputT IO) () +handleErrors m = do + result <- runExceptT m + case result of + Left err -> liftIO $ hPutStrLn stderr err + Right _ -> pure () + +liftInput :: InputT IO a -> AppM a +liftInput = lift . lift + +outputTextLn :: MonadIO m => Text -> InputT m () +outputTextLn = outputStrLn . T.unpack + +outputStderrLn :: Text -> AppM () +outputStderrLn = liftIO . hPutStrLn stderr + +data AppState = AppState + { interpreterOpts :: InterpreterOpts + , definitions :: HashMap Text CheckExpr + } + +defaultAppState :: AppState +defaultAppState = AppState + { interpreterOpts = defaultInterpreterOpts + , definitions = mempty + } + +data InterpreterOpts = InterpreterOpts + { traceOpts :: TraceOpts + , printTypeOpts :: PrintTypeOpts + } + +defaultInterpreterOpts :: InterpreterOpts +defaultInterpreterOpts = InterpreterOpts + { traceOpts = TraceOff + , printTypeOpts = PrintOff + } + +data TraceOpts + -- | Print the entire expression in traces. + = TraceGlobal + -- | Print only the modified part of the expression in traces. + | TraceLocal + -- | Do not trace evaluation. + | TraceOff + +data PrintTypeOpts + -- | Do not print the inferred type of any expressions. + = PrintOff + -- | Print the inferred type of top-level declarations. + | PrintDecls + -- | Print the inferred type of top-level expressions. + | PrintExprs + -- | Print to STDERR the inferred types of + -- both top-level declarations and top-level expressions. + | PrintBoth + deriving Eq + +shouldPrintType :: Bool -> InterpreterOpts -> Bool +shouldPrintType isDecl opts = case printTypeOpts opts of + PrintBoth -> True + PrintDecls -> isDecl + PrintExprs -> not isDecl + PrintOff -> False diff --git a/examples/examples.ivo b/examples/examples.ivo old mode 100644 new mode 100755 index 1045551..c809d61 --- a/examples/examples.ivo +++ b/examples/examples.ivo @@ -1,3 +1,4 @@ +#!/usr/bin/env -S ivo -c // Create a list by iterating `f` `n` times: letrec iterate = \f x. { Z -> [] @@ -5,8 +6,9 @@ letrec iterate = \f x. }; // Use the iterate function to count to 10: -let countTo = iterate S 1 -in countTo 10; +let countToTen : [Nat] = + let countTo = iterate S 1 + in countTo 10; // Append two lists together: letrec append = \xs ys. @@ -21,29 +23,27 @@ letrec reverse = }; // Now we can reverse `"reverse"`: -reverse "reverse"; +let reverseReverse : [Char] = reverse "reverse"; // Calculating `3 + 2` with the help of Church-encoded numerals: -let Sf = \n f x. f (n f x) - ; plus = \x. x Sf -in plus (\f x. f (f (f x))) (\f x. f (f x)) S Z; +let threePlusTwo : Nat = + let Sf = \n f x. f (n f x) + ; plus = \x. x Sf + in plus (\f x. f (f (f x))) (\f x. f (f x)) S Z; letrec undefined = undefined; // This expression would loop forever, but `callcc` saves the day! -S (callcc \k. undefined (k Z)); +let callccSaves : Nat = S (callcc \k. undefined (k Z)); // And if it wasn't clear, this is what the `Char` constructor does: -{ Char c -> Char (S c) } 'a; +let charB : Char = { Char c -> Char (S c) } 'a; // (it outputs `'b`) -// Here are a few expressions which don't typecheck but are handy for debugging the evaluator -// (you can run them using `:check off off`: -/* -let D = \x. x x; F = \f. f (f y) in D (F \x. x); -// y y -let T = \f x. f (f x) in (\f x. T (T (T (T T))) f x) (\x. x) y; -// y -(\x y z. x y) y; -// λy' z. y y' -*/ +// pack all of the examples into tuples so the main function can print them +let main = + ( countToTen + , ( reverseReverse + , ( callccSaves + , charB + ))) diff --git a/package.yaml b/package.yaml index 6f6cf8c..c59e485 100644 --- a/package.yaml +++ b/package.yaml @@ -12,30 +12,6 @@ description: Please see the README on GitHub at = 4.14 && < 5 - monad-loops >= 0.4.3 && < 0.5 @@ -45,6 +21,29 @@ dependencies: - text >= 1.2 && < 2 - unordered-containers >= 0.2.13 && < 0.3 +default-extensions: +- BlockArguments +- ConstraintKinds +- DefaultSignatures +- DeriveFoldable +- DeriveFunctor +- DeriveTraversable +- EmptyCase +- EmptyDataDeriving +- FlexibleContexts +- FlexibleInstances +- ImportQualifiedPost +- InstanceSigs +- LambdaCase +- MultiParamTypeClasses +- NamedFieldPuns +- OverloadedStrings +- PatternSynonyms +- ScopedTypeVariables +- StandaloneDeriving +- TypeFamilies +- ViewPatterns + library: source-dirs: src ghc-options: diff --git a/src/Ivo/Syntax/Parser.hs b/src/Ivo/Syntax/Parser.hs index 9727bfa..1d21c15 100644 --- a/src/Ivo/Syntax/Parser.hs +++ b/src/Ivo/Syntax/Parser.hs @@ -1,8 +1,8 @@ module Ivo.Syntax.Parser ( ParseError, parse - , Declaration, DeclOrExprAST, ProgramAST - , parseAST, parseDeclOrExpr, parseProgram - , typeParser, schemeParser, astParser, declOrExprParser, programParser + , Declaration, TopLevelAST, ProgramAST + , parseAST, parseTopLevel, parseProgram + , typeParser, schemeParser, astParser, topLevelParser, programParser ) where import Ivo.Syntax.Base @@ -280,17 +280,26 @@ declaration = notFollowedBy (try let_) >> (declrec <|> decl) definitionAnn -- | A program is a series of declarations and expressions to execute. -type ProgramAST = [DeclOrExprAST] -type DeclOrExprAST = Either Declaration AST +type ProgramAST = [Declaration] +type TopLevelAST = [Either Declaration AST] -declOrExprParser :: Parser DeclOrExprAST -declOrExprParser = try (Left <$> declaration) <|> (Right <$> ambiguous) +topLevel :: Parser (Either Declaration AST) +topLevel = try (Left <$> declaration) <|> (Right <$> ambiguous) + +topLevelParser :: Parser TopLevelAST +topLevelParser = spaces *> sepEndBy topLevel (token ';') <* eof + +shebang :: Parser () +shebang = do + try $ keyword "#!" + skipMany (noneOf "\n") + spaces programParser :: Parser ProgramAST -programParser = spaces *> sepEndBy declOrExprParser (token ';') <* eof +programParser = shebang *> sepEndBy declaration (token ';') <* eof -parseDeclOrExpr :: Text -> Either ParseError DeclOrExprAST -parseDeclOrExpr = parse declOrExprParser "input" +parseTopLevel :: Text -> Either ParseError TopLevelAST +parseTopLevel = parse topLevelParser "input" parseProgram :: Text -> Either ParseError ProgramAST parseProgram = parse programParser "input"