Commit cb45b8f7 authored by gilmi's avatar gilmi
Browse files

Warnings on variable shadowing

parent 831d06d6
Pipeline #299799920 passed with stages
in 16 minutes and 16 seconds
......@@ -6,7 +6,7 @@ Giml is a strict, statically typed, purely functional language with emphasis on
The compiler currently targets JavaScript, but more backends are planned in the future.
This project is streamed on [twitch.tv/suppipi](https://twitch.tv/suppipi), and past sessions are avaiable on [Youtube](https://www.youtube.com/watch?list=PLhMOOgDOKD4IkQM75GkAnXI-fpIrDAnsu&v=khAKcFgziWU).
This project is streamed on [twitch.tv/suppipi](https://twitch.tv/suppipi), and past sessions are available on [Youtube](https://www.youtube.com/watch?list=PLhMOOgDOKD4IkQM75GkAnXI-fpIrDAnsu&v=khAKcFgziWU).
For more information, visit the [website](https://giml-lang.org).
......
......@@ -34,6 +34,7 @@ library
DeriveFoldable
DeriveTraversable
DeriveGeneric
MonoLocalBinds
default-language: Haskell2010
......
......@@ -45,6 +45,7 @@ library
DeriveFoldable
DeriveTraversable
DeriveGeneric
MonoLocalBinds
default-language: Haskell2010
......@@ -75,6 +76,7 @@ test-suite giml-compiler-test
, process
, raw-strings-qq
, uniplate
, mtl
ghc-options: -O -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010
......
......@@ -14,16 +14,26 @@ import Control.Monad.Except
-- | Compile a Giml source file to JS
compile
:: FilePath -- ^ Name of the source file
:: Giml.MonadBase b b
=> Giml.LogAction b Giml.LogMsg -- ^ logging
-> FilePath -- ^ Name of the source file
-> T.Text -- ^ Content of the source file
-> Either T.Text T.Text
compile file src = runExcept $ do
ast <- Giml.parseInferPipeline Giml.noLogging file src
-> b (Either T.Text T.Text)
compile logact file src = runExceptT $ do
ast <- Giml.parseInferPipeline logact file src
pure $
( JS.pp JS.ppFile
. translate translateFile Giml.builtins
) ast
{-
let
logact =
maybe
Giml.noLoggingIO
(Giml.logAction . flip Giml.mkCompileInfoIO file)
mv
-}
translate' :: Giml.File Giml.Ann -> T.Text
translate' = JS.pp JS.ppFile . translate translateFile Giml.builtins
......
......@@ -158,13 +158,14 @@ replCommands =
let
mv = case T.toLower (T.pack e) of
"none" -> Just $ Nothing
"warning" -> Just $ Just Giml.Warning
"concise" -> Just $ Just Giml.Concise
"detailed" -> Just $ Just Giml.Detailed
"general" -> Just $ Just Giml.General
_ -> Nothing
case mv of
Nothing ->
liftIO $ hPutStrLn stderr "Choose one of: none, general, concise, detailed"
liftIO $ hPutStrLn stderr "Choose one of: none, warning, general, concise, detailed"
Just v ->
lift $ liftIO . flip modifyIORef (\s -> s { rsLogMode = v }) =<< ask
repl
......@@ -384,7 +385,7 @@ settings dir = do
H.listFiles word
":log" ->
pure (map H.simpleCompletion ["none", "general", "concise", "detailed"])
pure (map H.simpleCompletion ["none", "warning", "general", "concise", "detailed"])
[]
| (':' : cmd) <- word ->
......
......@@ -23,6 +23,7 @@ data Command w
= Compile
{ input :: w ::: FilePath <?> "input file"
, output :: w ::: Maybe FilePath <?> "output file"
, warn :: w ::: Bool <?> "emit warnings"
}
| Parse
{ input :: w ::: FilePath <?> "input file"
......@@ -31,6 +32,7 @@ data Command w
| Infer
{ input :: w ::: FilePath <?> "input file"
, output :: w ::: Maybe FilePath <?> "output file"
, warn :: w ::: Bool <?> "emit warnings"
}
| Interactive
{ load :: w ::: Maybe FilePath <?> "input file"
......@@ -45,19 +47,28 @@ run :: IO ()
run = do
arguments <- unwrapRecord "gimlc"
case arguments of
Compile inputFile outputFile -> do
process compile inputFile outputFile
Compile inputFile outputFile w -> do
process
(compile $ logact inputFile (if w then Just Giml.Warning else Nothing))
inputFile
outputFile
Parse inputFile outputFile -> do
process
(fmap (fmap pShow . Giml.runWithoutLogger) . Giml.parse)
( \i o ->
pure
. fmap pShow
. Giml.runWithoutLogger
$ Giml.parse i o
)
inputFile
outputFile
Infer inputFile outputFile -> do
Infer inputFile outputFile w -> do
process
( fmap (runExcept . fmap (pShow . fmap Giml.printAnn))
. Giml.parseInferPipeline Giml.noLogging
( \i o -> do
runExceptT . fmap (pShow . fmap Giml.printAnn)
$ Giml.parseInferPipeline (logact i $ if w then Just Giml.Warning else Nothing) i o
)
inputFile
outputFile
......@@ -65,16 +76,21 @@ run = do
Interactive mInputFile -> do
runRepl mInputFile
logact :: FilePath -> Maybe Giml.Verbosity -> Giml.LogAction IO Giml.LogMsg
logact i =
maybe
Giml.noLoggingIO
(Giml.logAction . flip Giml.mkCompileInfoIO i)
-- | Takes a processing function, an input file and optionally an output file
process
:: (FilePath -> T.Text -> Either T.Text T.Text)
:: (FilePath -> T.Text -> IO (Either T.Text T.Text))
-> FilePath
-> Maybe FilePath
-> IO ()
process func inputFile outputFile = do
file <- T.readFile inputFile
let
result = func inputFile file
result <- func inputFile file
case result of
Left err -> do
T.hPutStrLn stderr err
......
......@@ -6,11 +6,13 @@ module Utils
)
where
import GHC.Generics as Export (Generic)
import Data.Bifunctor as Export
import Data.Maybe as Export
import Data.Functor as Export
import Data.Foldable as Export
import Data.Traversable as Export
import Control.Monad as Export
import Data.Data as Export (Data)
import Data.Text as Export (Text)
import Data.Set as Export (Set)
......
......@@ -4,10 +4,12 @@
module Tests.CompileSpec where
import Language.Giml.Compiler.Compile
import Language.Giml as Giml
import Test.Hspec
import Text.RawString.QQ
import qualified Data.Text as T
import Control.Monad.Identity
import System.Process (readProcess)
......@@ -444,6 +446,6 @@ data Check
check :: Check -> IO ()
check (Check prog expect) = do
prog' <- either (error . T.unpack) pure $ compile "test" prog
prog' <- either (error . T.unpack) pure $ runIdentity $ compile Giml.noLogging "test" prog
result <- readProcess "nodejs" [] (T.unpack prog')
shouldBe result (expect <> "\n")
......@@ -34,6 +34,7 @@ library
Language.Giml.Rewrites.PostInfer
Language.Giml.Rewrites.PostInfer.RemoveAnn
Language.Giml.Rewrites.PostInfer.Shadowing
Language.Giml.Syntax.Ast
Language.Giml.Syntax.Parser
......
......@@ -70,8 +70,7 @@ inferPipeline' logact parsed = do
inferred <-
withExceptT TypeError $ do
infer logact rewritten
pure inferred
runLog logact $ postInferRewrites inferred
-- * Errors
......
......@@ -23,7 +23,6 @@ module Language.Giml.Logging
)
where
import GHC.Generics (Generic)
import Utils
import System.IO
import Control.Monad.Identity
......@@ -60,6 +59,12 @@ runLog = flip runReaderT . CompileInfo
withLogAction :: MonadBase b m => Colog.LogAction b LogMsg -> ReaderT (CompileInfo b) m () -> m ()
withLogAction logact m = runReaderT m (CompileInfo logact)
warn :: HasLog' LogMsg env b m => Text -> m ()
warn msg = logMsg $ emptyLogMsg
{ _lmVerbosity = Warning
, _lmMessage = msg
}
logGeneral :: HasLog' LogMsg env b m => Text -> m ()
logGeneral msg = logMsg $ emptyLogMsg
{ _lmVerbosity = General
......@@ -161,7 +166,8 @@ data Stage
-- | Verbose level from least detailed to most detailed
data Verbosity
= General
= Warning
| General
| Concise
| Detailed
deriving (Show, Read, Eq, Ord)
......
......@@ -19,11 +19,15 @@ import qualified Language.Giml.Rewrites.PostInfer as PostInfer
-- | Rewrites that should run before type inference
preInferRewrites
:: CompilePhase PreInfer.PreInferError env b m
=> MonadBase b b
=> ParsedFile Parser.Ann -> m (File Parser.Ann)
preInferRewrites = PreInfer.rewrites
preInferRewrites =
setStage PreInfer . PreInfer.rewrites
-- | Rewrites that should run after type inference
postInferRewrites
:: HasLog' LogMsg env b m
=> MonadBase b b
=> File Infer.Ann -> m (File Infer.Ann)
postInferRewrites = PostInfer.rewrites
postInferRewrites =
setStage PostInfer . PostInfer.rewrites
......@@ -7,13 +7,20 @@ module Language.Giml.Rewrites.PostInfer where
-- import Utils
import Language.Giml.Logging
import Language.Giml.Syntax.Ast
import qualified Language.Giml.Rewrites.PostInfer.Shadowing as Shadowing
import qualified Language.Giml.Types.Infer as Infer
-- | Rewrites that should run after type inference
rewrites
:: HasLog' LogMsg env b m
=> MonadBase b b
=> File Infer.Ann -> m (File Infer.Ann)
rewrites = pure
rewrites =
( \file -> do
logact <- getLogAction
liftBase $ Shadowing.check logact file
)
-- ( RemoveAnn.rewrite
-- . ltrace "after-inference"
-- )
{- | Warn about variable shadowing
-}
{-# language FlexibleContexts #-}
{-# language OverloadedStrings #-}
{-# language TypeApplications #-}
{-# language ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Giml.Rewrites.PostInfer.Shadowing where
import qualified Data.Generics.Uniplate.Data as U
import qualified Data.Map as M
import qualified Data.Text as T
import Control.Monad.Reader
import Utils
import Language.Giml.Logging
import Language.Giml.Syntax.Ast
import Language.Giml.Pretty
import Language.Giml.Types.Infer (Ann, annInput)
data Env b
= Env
{ logAction :: LogAction b LogMsg
, varEnv :: Map Var Ann
}
deriving Generic
-- | Check for variable shadowing in a File.
check
:: MonadBase b b
=> LogAction b LogMsg -> File Ann -> b (File Ann)
check logact file = do
checkFile logact file
pure file
checkFile
:: MonadBase b b
=> LogAction b LogMsg -> File Ann -> b ()
checkFile logact (File _ (concat -> termdefs)) =
let
toplevel = M.fromList $
map (\t -> (getTermName t, getTermAnn t)) termdefs
in
flip runReaderT (Env logact toplevel) $
mapM_ checkTermDef termdefs
checkTermDef
:: HasLog' LogMsg (Env b) b m
=> TermDef Ann -> m ()
checkTermDef = \case
Variable ann _ e ->
checkExpr ann e
Function ann _ args e ->
withVars
(M.fromList $ map (flip (,) ann) (catMaybes args))
(checkExpr ann e)
checkExpr
:: HasLog' LogMsg (Env b) b m
=> Ann -> Expr Ann -> m ()
checkExpr ann = \case
EAnnotated ann' e ->
checkExpr ann' e
ELet def e -> do
checkTermDef def
let
name = getTermName def
withVars (M.singleton name ann) (checkExpr ann e)
EFun args e -> do
withVars
(M.fromList $ map (flip (,) ann) (catMaybes args))
(checkExpr ann e)
ECase e pats -> do
checkExpr ann e
mapM_ (uncurry $ checkPattern ann) pats
EBlock block ->
checkBlock block
e ->
mapM_ (checkExpr ann) (U.children e)
checkBlock
:: HasLog' LogMsg (Env b) b m
=> Block Ann -> m ()
checkBlock = \case
[] -> pure ()
SExpr ann e : rest -> do
checkExpr ann e
checkBlock rest
SBind ann v e : rest -> do
checkExpr ann e
withVars (M.singleton v ann) (checkBlock rest)
SDef ann def : rest -> do
checkTermDef def
let
name = getTermName def
withVars (M.singleton name ann) (checkBlock rest)
checkPattern
:: HasLog' LogMsg (Env b) b m
=> Ann -> Pattern -> Expr Ann -> m ()
checkPattern ann pat body = do
let
captures = getCaptures ann pat
withVars captures (checkExpr ann body)
getCaptures :: Ann -> Pattern -> Map Var Ann
getCaptures ann pat =
M.fromList [ (v, ann) | PVar v <- U.universeBi pat ]
withVars
:: HasLog' LogMsg (Env b) b m
=> Map Var Ann -> m () -> m ()
withVars vars m = do
env <- asks varEnv
let
shadowings = M.intersectionWith (,) vars env
mapM_ (uncurry warnShadowing) (M.toList shadowings)
flip local m $ \(Env l e) ->
Env l (M.union vars e)
warnShadowing
:: HasLog' LogMsg (Env b) b m
=> Var -> (Ann, Ann) -> m ()
warnShadowing name (new, old) =
warn $ T.unwords
[ "The variable '" <> name <> "'"
, "defined in location " <> printSourcePos (annInput new)
, "shadows a variable previously defined in location: "
<> printSourcePos (annInput old) <> "."
]
......@@ -8,7 +8,7 @@ module Language.Giml.Rewrites.PreInfer
)
where
-- import Utils
import Utils
import Language.Giml.Logging
import Language.Giml.Syntax.Ast
import qualified Language.Giml.Syntax.Parser as Parser
......@@ -20,10 +20,10 @@ import Language.Giml.Rewrites.PreInfer.Errors as Export
-- | Rewrites that should run before type inference
rewrites
:: CompilePhase PreInferError env b m
=> MonadBase b b
=> ParsedFile Parser.Ann -> m (File Parser.Ann)
rewrites =
( fmap Currying.rewrite
. fmap Group.rewrite
. Dups.rewrite
-- . ltrace "after-parsing"
( Dups.rewrite
>=> pure . Group.rewrite
>=> pure . Currying.rewrite
)
......@@ -26,7 +26,6 @@ import Control.Monad.Reader
import Control.Monad.Except
import Data.List (sort)
import GHC.Generics (Generic)
import qualified Data.Text as T
import qualified Data.Map as M
import qualified Data.Map.Merge.Strict as M
......
......@@ -6,11 +6,13 @@ module Utils
)
where
import GHC.Generics as Export (Generic)
import Data.Bifunctor as Export
import Data.Maybe as Export
import Data.Functor as Export
import Data.Foldable as Export
import Data.Traversable as Export
import Control.Monad as Export
import Data.Data as Export (Data)
import Data.Text as Export (Text)
import Data.Set as Export (Set)
......
......@@ -37,6 +37,7 @@ in { -age | r } -- ==> { name = "Giml" }
I think this still needs to be fleshed out wrt syntax and semantics!
** Rewrites
- Shadowing warnings
- Warning on unused variables
- Exhaustive case expressions checks
- Constant folding
- Avoid unnecessary function calls
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment