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

@@ -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`;
+You may run the Ivo interpreter (`ivo`)
-the interpreter does not take any arguments.
+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 <on/off> <always/decls/off>`:
+* `:printTypes <both/decls/exprs/off>`:
 
-  * If the first argument is `on`,
+  Print to STDERR the inferred types of top-level declarations,
-    then expressions will only be evaluated and definitions will only be added
+  of expressions entered into the interpreters,
-    only if typechecking succeeds.
+  of both, or of neither.
 
-  * If the second argument is `always`, then inferred types will always be printed;
+  This setting defaults to `off`.
-    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`.
 
 * `:trace <off/local/global>`:
 

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"

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

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, zipWithM)
-import Control.Monad (when)
+import Control.Monad.Except (throwError, liftEither)
-import Control.Monad.Catch (MonadMask)
+import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Except (MonadError, ExceptT, runExceptT, throwError, liftEither)
-import Control.Monad.IO.Class (MonadIO, 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
+import Data.Text.IO (readFile)
-  ( InputT, runInputT, defaultSettings
+import Prelude hiding (readFile)
-  , outputStrLn, getInputLine, handleInterrupt, withInterrupt
+import System.Console.Haskeline (getInputLine)
-  )
-import Text.Parsec
-import Text.Parsec.Text (Parser)
 
-outputTextLn :: MonadIO m => Text -> InputT m ()
+main :: IO ()
-outputTextLn = outputStrLn . T.unpack
+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
+        files <- zipWithM parseProgramHandleErrors loadFiles filesContents
--- without performing any additional actions.
+        -- and only finally interpret
--- (Without this, it will print an extra newline for some reason.)
+        mapM_ loadFile files
-justDie :: (MonadIO m, MonadMask m) => InputT m () -> InputT m ()
+        maybe repl runProgram mMain
-justDie = handleInterrupt (pure ()) . withInterrupt
 
-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
+    -- | When reading the file contents of a file passed as an argument,
-      try $ string "trace "
+    -- we want to print usage information and exit if the file can't be opened.
-      try traceOff <|> try traceLocal <|> try traceGlobal
+    readArgFile :: FilePath -> IO Text
-    traceOff = TraceOff <$ string "off"
+    readArgFile file = readFile file `catch` handleException
-    traceLocal = TraceLocal <$ string "local"
+      where
-    traceGlobal = TraceGlobal <$ string "global"
+        handleException :: IOException -> IO a
+        handleException _ = ioError $ userError $
+          "Could not open file: " ++ file ++ "\n" ++ usageMessage
 
-    check = Check <$> do
+repl :: AppM ()
-      try $ string "check "
+repl = lift $ whileJust_ (fmap T.pack <$> lift (getInputLine ">> ")) \inputText ->
-      spaces
+  handleErrors do
-      tc <- (True <$ try (string "on ")) <|> (False <$ try (string "off "))
+    input <- parseCommandOrTopLevel inputText
-      spaces
+    either runCommand runTopLevel input
-      pr <- try printAlways <|> try printDecls <|> try printOff
-      pure $ CheckOptions tc pr
-    printAlways = PrintAlways <$ string "always"
-    printDecls = PrintDecls <$ string "decls"
-    printOff = PrintOff <$ string "off"
 
-    load = Load <$> do
+parseCommandOrTopLevel :: Text -> AppM (Either Command TopLevelAST)
-      try $ string "load "
+parseCommandOrTopLevel input = do
-      spaces
+  mCmd <- liftParseError $ parseCommand input
-      filename <- many1 (noneOf " ")
+  case mCmd of
-      spaces
+    Nothing -> Right <$> liftParseError (parseTopLevel input)
-      pure filename
+    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
+liftParseError :: Either ParseError a -> AppM a
-  parsed        :: Either ParseError a -> m a
+liftParseError result = case result of
-  typecheckDecl :: Maybe Type -> Text -> CheckExpr -> m (Maybe Scheme)
+  Left err -> throwError $ T.pack $ show err
-  typecheckExpr ::                       CheckExpr -> m (Maybe Scheme)
+  Right x -> pure x
-  execute       :: CheckExpr -> m EvalExpr
 
-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
+loadFile :: ProgramAST -> AppM ()
-liftInput = lift . lift
+loadFile = mapM_ (\(name, ty, e) -> define name ty $ ast2check e)
 
-instance MonadApp AppM where
+runTopLevel :: TopLevelAST -> AppM ()
-  parsed (Left err) = throwError $ T.pack $ show err
+runTopLevel = mapM_ runDeclOrExpr
-  parsed (Right ok) = pure ok
 
-  typecheckDecl ty = typecheck ty    . Just
+runDeclOrExpr :: Either Declaration AST -> AppM ()
-  typecheckExpr    = typecheck Nothing Nothing
+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
+typecheckDecl :: Maybe Type -> Text -> CheckExpr -> AppM Scheme
-    defs <- gets definitions
+typecheckDecl ty = typecheck ty . Just
-    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
 
-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
+  case type_ of
-  if shouldTypecheck checkOpts
+    Left err -> throwError $ "Typecheck error: " <> err
-    then case type_ of
+    Right t -> do
-      Left err -> throwError $ "Typecheck error: " <> err
+      printTypeB <- gets $ shouldPrintType isDecl . interpreterOpts
-      Right t -> do
+      when printTypeB $ outputStderrLn $ prefix <> unparseScheme t
-        printType checkOpts t
+      pure 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
   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 ()
+execute :: CheckExpr -> AppM EvalExpr
-define name expr = modify \appState ->
+execute checkExpr = do
-  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
   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
+  modify' \appState ->
-runDeclOrExpr (Right exprAST) = do
+    let expr' = substitute (definitions appState) expr
-  defs <- gets definitions
+    in appState { definitions = HM.insert name expr' $ definitions appState }
-  let expr = substitute defs $ ast2check exprAST
-  _ <- typecheckExpr expr
-  _ <- execute expr
-  pure ()
 
-runProgram :: MonadApp m => ProgramAST -> m ()
+modifyInterpreterOpts :: (InterpreterOpts -> InterpreterOpts) -> AppM ()
-runProgram = mapM_ runDeclOrExpr
+modifyInterpreterOpts f =
+  modify' \app -> app { interpreterOpts = f (interpreterOpts app) }
 
-runCommand :: forall m. (MonadApp m, MonadIO m, MonadError Text m) => Command -> m ()
+runCommand :: Command -> AppM ()
-runCommand (Trace traceOpts) = modify \app -> app { traceOptions = traceOpts }
+runCommand (Trace traceOpts) =
-runCommand (Check checkOpts) = modify \app -> app { checkOptions = checkOpts }
+  modifyInterpreterOpts \opts -> opts { traceOpts }
-runCommand Clear = modify \app -> app { definitions = HM.empty }
+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 ()

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

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
+let countToTen : [Nat] =
-in countTo 10;
+  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)
+let threePlusTwo : Nat =
-  ; plus = \x. x Sf
+  let Sf   = \n f x. f (n f x)
-in plus (\f x. f (f (f x))) (\f x. f (f x)) S Z;
+    ; 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
+// pack all of the examples into tuples so the main function can print them
-// (you can run them using `:check off off`:
+let main =
-/*
+  ( countToTen
-let D = \x. x x; F = \f. f (f y) in D (F \x. x);
+  , ( reverseReverse
-// y y
+    , ( callccSaves
-let T = \f x. f (f x) in (\f x. T (T (T (T T))) f x) (\x. x) y;
+      , charB
-// y
+      )))
-(\x y z. x y) y;
-// λy' z. y y'
-*/

package.yaml

@@ -12,30 +12,6 @@ description:         Please see the README on GitHub at <https://github.com/ivol
 extra-source-files:
 - README.md
 
-default-extensions:
-- BlockArguments
-- ConstraintKinds
-- DefaultSignatures
-- EmptyCase
-- EmptyDataDeriving
-- FlexibleContexts
-- FlexibleInstances
-- ImportQualifiedPost
-- InstanceSigs
-- LambdaCase
-- OverloadedStrings
-- PatternSynonyms
-- ScopedTypeVariables
-- StandaloneDeriving
-- ViewPatterns
-# Required for use of the 'trees that grow' pattern
-- MultiParamTypeClasses
-- TypeFamilies
-# Used by recursion-schemes when using template haskell
-- DeriveFoldable
-- DeriveFunctor
-- DeriveTraversable
-
 dependencies:
 - base >= 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:

src/Ivo/Syntax/Parser.hs

@@ -1,8 +1,8 @@
 module Ivo.Syntax.Parser
   ( ParseError, parse
-  , Declaration, DeclOrExprAST, ProgramAST
+  , Declaration, TopLevelAST, ProgramAST
-  , parseAST, parseDeclOrExpr, parseProgram
+  , parseAST, parseTopLevel, parseProgram
-  , typeParser, schemeParser, astParser, declOrExprParser, programParser
+  , 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 ProgramAST = [Declaration]
-type DeclOrExprAST = Either Declaration AST
+type TopLevelAST = [Either Declaration AST]
 
-declOrExprParser :: Parser DeclOrExprAST
+topLevel :: Parser (Either Declaration AST)
-declOrExprParser = try (Left <$> declaration) <|> (Right <$> ambiguous)
+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
+parseTopLevel :: Text -> Either ParseError TopLevelAST
-parseDeclOrExpr = parse declOrExprParser "input"
+parseTopLevel = parse topLevelParser "input"
 
 parseProgram :: Text -> Either ParseError ProgramAST
 parseProgram = parse programParser "input"