diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # dickinson +## 0.1.1.1 + + * Run typechecker before evaluator in executable/REPL + * Add location info to type errors + * `emd FILE` now runs file (for use in shell shebangs) + ## 0.1.1.0 * Export renamer in `Language.Dickinson` diff --git a/examples/catherineOfSienaBot.dck b/examples/catherineOfSienaBot.dck --- a/examples/catherineOfSienaBot.dck +++ b/examples/catherineOfSienaBot.dck @@ -18,6 +18,8 @@ (| "You like a perverse beast find your pleasure in delicate foods, and make a god of your belly?") (| "You loved us before we existed.") (| "By your mercy we were created.") + (| "There is no sin that does not touch others.") + (| "Sin is both in the mind and in the act.") (| "If you follow this truth you will have the life of grace and never die of hunger.") (| "If you have conceived the virtue of courage within you, you will always be strong and constant.") (| @@ -37,6 +39,17 @@ ''') (| "You should build your foundation by slaying and annhilating your self-will.") (| "Humility comes from knowledge and holy hatred of oneself.") + (| "All the sufferings the soul bears or can bear in this life are not enough to punish one smallest sin.") + (| "Suffering atones for sin not by reason of the finite pain but by reason of perfect contrition of the heart.") + (| "Suffering and sorrow increase in proportion to love.") + (| "Everywhere, on all levels of society, all are giving birth to sin.") + (| "All virtues are bound together.") + (| + ''' + Just as you can better see the blemish on your face when you look at yourself in a mirror, so the soul who + in true self-knowledge rises up with desire to look at herself in the gentle mirror of God with the eye of + understanding sees all the more clearly her own defects because of the purity she sees in him. + ''') (| ''' Memory is beleagured by the body's imperfection; understanding is blocked and fettered by the heaviness diff --git a/language-dickinson.cabal b/language-dickinson.cabal --- a/language-dickinson.cabal +++ b/language-dickinson.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: language-dickinson -version: 0.1.1.0 +version: 0.1.1.1 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2020 Vanessa McHale diff --git a/run/Main.hs b/run/Main.hs --- a/run/Main.hs +++ b/run/Main.hs @@ -15,7 +15,6 @@ | REPL ![FilePath] | Check !FilePath ![FilePath] | Lint !FilePath - | Typecheck !FilePath ![FilePath] | Format !FilePath | Man @@ -28,10 +27,9 @@ <> command "repl" (info replP (progDesc "Start a REPL")) <> command "check" (info checkP (progDesc "Check that some code is valid.")) <> command "lint" (info lintP (progDesc "Examine a file for common errors.")) - <> command "typecheck" (info typecheckP (progDesc "Type information for a program (for debugging)")) <> command "fmt" (info formatP (progDesc "Format Dickinson code")) <> command "man" (info (pure Man) (progDesc "Dump path to manpages")) - ) + ) <|> runP formatP :: Parser Act formatP = Format <$> dckFile @@ -48,9 +46,6 @@ lintP :: Parser Act lintP = Lint <$> dckFile -typecheckP :: Parser Act -typecheckP = Typecheck <$> dckFile <*> includes - dckFile :: Parser FilePath dckFile = argument str (metavar "FILE" @@ -80,10 +75,9 @@ versionMod = infoOption dickinsonVersionString (short 'V' <> long "version" <> help "Show version") run :: Act -> IO () -run (Run fp is) = do { pGo <- defaultLibPath ; TIO.putStrLn =<< pipeline (pGo is) fp } -run (REPL _) = dickinsonRepl -run (Check f i) = do { pathMod <- defaultLibPath ; checkFile (pathMod i) f } -run (Lint f) = warnFile f -run (Typecheck f i) = do { pathMod <- defaultLibPath ; tcFile (pathMod i) f } -run (Format fp) = fmtFile fp -run Man = putStrLn =<< ( "emd.1") . ( "man") <$> getDataDir +run (Run fp is) = do { pGo <- defaultLibPath ; TIO.putStrLn =<< pipeline (pGo is) fp } +run (REPL _) = dickinsonRepl +run (Check f i) = do { pathMod <- defaultLibPath ; validateFile (pathMod i) f } -- FIXME: reuse +run (Lint f) = warnFile f +run (Format fp) = fmtFile fp +run Man = putStrLn =<< ( "emd.1") . ( "man") <$> getDataDir diff --git a/run/REPL.hs b/run/REPL.hs --- a/run/REPL.hs +++ b/run/REPL.hs @@ -5,6 +5,7 @@ module REPL ( dickinsonRepl ) where +import Control.Monad (void) import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.IO.Class (liftIO) import Control.Monad.State.Lazy (StateT, evalStateT, get, gets, lift, put) @@ -167,6 +168,7 @@ mErr <- lift $ runExceptT $ do e' <- resolveExpressionM =<< renameExpressionM e checkScopeExpr e' + void $ typeOf e' -- TODO: typeOf e but context? evalExpressionAsTextM e' lift balanceMax putErr mErr (liftIO . TIO.putStrLn) @@ -174,6 +176,8 @@ mErr <- lift $ runExceptT $ do d <- renameDeclarationM decl checkScopeDecl =<< resolveDeclarationM d + tyAddDecl d + tyAdd d addDecl' d lift balanceMax putErr mErr (const $ pure ()) @@ -192,6 +196,7 @@ mErr <- lift $ runExceptT $ do d <- amalgamateRenameM (pathMod ["."]) fp maybeThrow $ checkScope d + tyTraverse d loadDickinson d lift balanceMax putErr mErr (const $ pure ()) diff --git a/src/Language/Dickinson/Error.hs b/src/Language/Dickinson/Error.hs --- a/src/Language/Dickinson/Error.hs +++ b/src/Language/Dickinson/Error.hs @@ -46,9 +46,9 @@ pretty (UnfoundName l n) = pretty l <+> pretty n <+> "is not in scope." pretty (NoText t) = squotes (pretty t) <+> "not defined" pretty (ParseErr _ e) = pretty e - pretty (TypeMismatch e ty ty') = "Expected" <+> pretty e <+> "to have type" <+> squotes (pretty ty) <> ", found type" <+> squotes (pretty ty') + pretty (TypeMismatch e ty ty') = pretty (exprAnn e) <+> "Expected" <+> pretty e <+> "to have type" <+> squotes (pretty ty) <> ", found type" <+> squotes (pretty ty') pretty (ModuleNotFound l n) = pretty l <+> "Module" <+> pretty n <+> "not found" - pretty (ExpectedLambda e ty) = "Expected" <+> squotes (pretty e) <+> "to be of function type, found type" <+> pretty ty + pretty (ExpectedLambda e ty) = pretty (exprAnn e) <+> "Expected" <+> squotes (pretty e) <+> "to be of function type, found type" <+> pretty ty pretty (MultiBind l n p) = pretty l <+> "Name" <+> pretty n <+> "is bound more than once in" <+> pretty p pretty (MalformedTuple l) = pretty l <+> "Malformed tuple" pretty (UnfoundConstructor l tn) = pretty l <+> "Constructor" <+> pretty tn <+> "not found" diff --git a/src/Language/Dickinson/File.hs b/src/Language/Dickinson/File.hs --- a/src/Language/Dickinson/File.hs +++ b/src/Language/Dickinson/File.hs @@ -3,6 +3,7 @@ module Language.Dickinson.File ( evalIO , evalFile , checkFile + , validateFile , warnFile , tcFile , amalgamateRename @@ -79,6 +80,13 @@ checkFile :: [FilePath] -> FilePath -> IO () checkFile = ioChecker checkScope +-- | Check scoping and types +validateFile :: [FilePath] -> FilePath -> IO () +validateFile is fp = do + d <- amalgamateRename is fp + maybeThrowIO $ checkScope d + eitherThrowIO $ tyRun d + -- | Run some lints warnFile :: FilePath -> IO () warnFile = maybeThrowIO . (\x -> checkDuplicates x <|> checkMultiple x) . (\(Dickinson _ d) -> d) @@ -101,4 +109,5 @@ pipeline is fp = fmap eitherThrow $ evalIO $ do ds <- amalgamateRenameM is fp maybeThrow $ checkScope ds + tyTraverse ds evalDickinsonAsMain ds diff --git a/src/Language/Dickinson/TypeCheck.hs b/src/Language/Dickinson/TypeCheck.hs --- a/src/Language/Dickinson/TypeCheck.hs +++ b/src/Language/Dickinson/TypeCheck.hs @@ -4,6 +4,7 @@ module Language.Dickinson.TypeCheck ( typeOf , tyAdd + , tyAddDecl , tyTraverse , tyRun , emptyTyEnv diff --git a/test/data/illTyped.dck b/test/data/illTyped.dck new file mode 100644 --- /dev/null +++ b/test/data/illTyped.dck @@ -0,0 +1,9 @@ +(:include cowsay) + +%- + +(:def someText + "Hello") + +(:def main + $ someText cowsay)