@@ -64,6 +64,7 @@ import Data.Generics.Extras.Schemes
6464import Data.Data (Data ,Typeable )
6565import Data.List (find ,sort ,sortBy ,nub ,foldl' ,nubBy ,deleteFirstsBy )
6666import qualified Data.Map as M
67+ import qualified Data.Set as DS
6768import Data.Maybe (isJust ,isNothing )
6869import Language.Lsl.Internal.Util (ctx ,findM ,lookupM ,filtMap ,throwStrError )
6970import Control.Monad (when ,foldM ,MonadPlus (.. ))
@@ -288,7 +289,7 @@ data ValidationState = ValidationState {
288289 vsFuncs :: ! [Ctx Func ],
289290 vsErr :: ! CodeErrs ,
290291 vsWarn :: ! CodeErrs ,
291- vsNamesUsed :: [ String ] ,
292+ vsNamesUsed :: ! ( DS. Set String ) ,
292293 vsGVs :: ! [Var ],
293294 vsGFs :: ! [FuncDec ],
294295 vsStateNames :: ! [String ],
@@ -298,7 +299,7 @@ data ValidationState = ValidationState {
298299 vsImports :: ! [(String ,[(String ,String )],String )],
299300 vsContext :: [Maybe SourceContext ]
300301 }
301-
302+
302303emptyValidationState = ValidationState {
303304 vsLib = [] ,
304305 vsGlobalRegistry = M. empty,
@@ -312,7 +313,7 @@ emptyValidationState = ValidationState {
312313 vsFuncs = [] ,
313314 vsErr = CodeErrs [] ,
314315 vsWarn = CodeErrs [] ,
315- vsNamesUsed = [] ,
316+ vsNamesUsed = DS. fromList ( map ( \ (name, t, ts) -> name) funcSigs) ,
316317 vsGVs = [] ,
317318 vsGFs = [] ,
318319 vsStateNames = [] ,
@@ -395,7 +396,7 @@ vsmAddLocal ctx v@(Var name _) = do
395396vsmAddImport imp = get'vsImports >>= put'vsImports . (imp: )
396397
397398vsmAddToNamesUsed :: String -> VState ()
398- vsmAddToNamesUsed name = get'vsNamesUsed >>= put'vsNamesUsed . (name : )
399+ vsmAddToNamesUsed name = get'vsNamesUsed >>= put'vsNamesUsed . (DS. insert name )
399400
400401vsmWithNewScope :: VState a -> VState a
401402vsmWithNewScope action = do
@@ -535,7 +536,7 @@ compileGlob (GV v mexpr) = do
535536 when (isConstant $ varName v') (vsmAddErr (srcCtx v, varName v' ++ " is a predefined constant" ))
536537 namesUsed <- get'vsNamesUsed
537538 gvs <- get'vsGVs
538- when (varName v' `elem ` namesUsed) (vsmAddErr (srcCtx v, varName v' ++ " is already defined" ))
539+ when (varName v' `DS.member ` namesUsed) (vsmAddErr (srcCtx v, varName v' ++ " is already defined" ))
539540 whenJust mexpr $ \ expr -> do
540541 let (_,gvs') = break (\ var -> varName var == varName v') gvs
541542 mt <- compileCtxSimple (drop 1 gvs') expr
@@ -547,7 +548,7 @@ compileGlob (GF cf@(Ctx ctx f@(Func (FuncDec name t params) statements))) =
547548 vsmWithNewScope $ do
548549 compileParams params
549550 vsmInEntryPoint t False $ do
550- whenM ((return elem ) `ap` (return $ ctxItem name) `ap` get'vsNamesUsed) (vsmAddErr (srcCtx name, ctxItem name ++ " is already defined" ))
551+ whenM ((return DS. member ) `ap` (return $ ctxItem name) `ap` get'vsNamesUsed) (vsmAddErr (srcCtx name, ctxItem name ++ " is already defined" ))
551552 returns <- compileStatements statements
552553 when (not returns && t /= LLVoid ) (vsmAddErr (srcCtx name, ctxItem name ++ " : not all code paths return a value" ))
553554 vsmRegisterFunc f
@@ -576,9 +577,9 @@ rewriteGlob' prefix renames vars (GF (Ctx ctx (Func (FuncDec name t params) stat
576577 Nothing -> vsmAddErr (srcCtx name, " can't rename " ++ ctxItem name ++ " : not found" )
577578 Just name' -> do
578579 namesUsed <- get'vsNamesUsed
579- if name' `elem ` namesUsed
580+ if name' `DS.member ` namesUsed
580581 then vsmAddErr (srcCtx name, name' ++ " imported from module is already defined" )
581- else let rewrittenFunc = (Func (FuncDec (Ctx (srcCtx name) name') t params) $ rewriteStatements 0 renames statements)
582+ else let rewrittenFunc = (Func (FuncDec (Ctx (srcCtx name) name') t params) $ rewriteStatements 0 (removeLocals params renames) statements)
582583 in do vsmAddToNamesUsed name'
583584 vsmRegisterFunc rewrittenFunc
584585 vsmAddFunc (Ctx ctx rewrittenFunc)
@@ -587,7 +588,7 @@ rewriteGlob' prefix renames vars (GV (Ctx ctx (Var name t)) mexpr) =
587588 Nothing -> vsmAddErr (ctx, " can't rename " ++ name ++ " : not found" )
588589 Just name' -> do
589590 namesUsed <- get'vsNamesUsed
590- if name' `elem ` namesUsed
591+ if name' `DS.member ` namesUsed
591592 then vsmAddErr (ctx, name' ++ " imported from module is already defined" )
592593 else let rewrittenGlobVar = GDecl (nullCtx (Var name' t)) (fmap (ctxItem . (rewriteCtxExpr renames)) mexpr)
593594 in do vsmAddToNamesUsed name'
@@ -613,6 +614,10 @@ rewriteGlob' prefix0 renames vars (GI (Ctx ctx mName) bindings prefix) =
613614 Nothing -> vsmAddErr (ctx, rn ++ " : not found" ) >> return (fv,rn)
614615 Just rn' -> return (fv,rn')
615616
617+ removeLocals :: [CtxVar ] -> [(String , String )] -> [(String , String )]
618+ removeLocals locals globals =
619+ filter (\ (gName, _) -> (all (\ (Ctx _ (Var localName _)) -> localName /= gName)) locals) globals
620+
616621compileState :: Ctx State -> VState ()
617622compileState state@ (Ctx _ (State nm handlers)) =
618623 vsmWithinState $ do
@@ -693,22 +698,22 @@ compileStatement (Ctx ctx (Decl var@(Var name t) expr)) = do
693698 get'vsBranchReturns
694699compileStatement (Ctx ctx (While expr statement)) = do
695700 t <- compileCtxExpr expr
696- vsmInBranch $ compileStatement statement
701+ compileBranchStatement statement
697702 get'vsBranchReturns
698703compileStatement (Ctx ctx(DoWhile statement expr)) = do
699704 t <- compileCtxExpr expr
700- vsmInBranch $ compileStatement statement
705+ compileBranchStatement statement
701706 get'vsBranchReturns
702707compileStatement (Ctx ctx (For mexpr1 mexpr2 mexpr3 statement)) = do
703708 compileExpressions mexpr1
704709 compileExpressions mexpr3
705710 t <- compileMExpression mexpr2
706- vsmInBranch $ compileStatement statement
711+ compileBranchStatement statement
707712 get'vsBranchReturns
708713compileStatement (Ctx ctx (If expr thenStmt elseStmt)) = do
709714 t <- compileCtxExpr expr
710- ret1 <- vsmInBranch $ compileStatement thenStmt
711- ret2 <- vsmInBranch $ compileStatement elseStmt
715+ ret1 <- compileBranchStatement thenStmt
716+ ret2 <- compileBranchStatement elseStmt
712717 returns <- get'vsBranchReturns
713718 put'vsBranchReturns (returns || (ret1 && ret2))
714719 get'vsBranchReturns
@@ -744,6 +749,13 @@ compileStatement (Ctx ctx (Jump s)) = do
744749 when (s `notElem` concat labels) $ vsmAddErr (ctx, " no such label to jump to: " ++ s)
745750 get'vsBranchReturns
746751
752+ compileBranchStatement :: CtxStmt -> VState Bool
753+ compileBranchStatement ctxStmt@ (Ctx _ (Decl _ _)) = do
754+ vsmAddErr (srcCtx ctxStmt, " Declaration requires a new scope - - use { and }" )
755+ return False
756+ -- get'vsBranchReturns
757+ compileBranchStatement ctxStmt = vsmInBranch $ compileStatement ctxStmt
758+
747759
748760compileStatements :: [CtxStmt ] -> VState Bool
749761compileStatements stmts = do
0 commit comments