hpython 0.2 → 0.3

raw patch · 9 files changed

+352/−223 lines, 9 filesdep ~thesePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: these

API changes (from Hackage documentation)

Files

• ChangeLog.md +34/−0
• hpython.cabal +3/−3
• src/Data/Validate/Monadic.hs +8/−3
• src/Language/Python/Syntax/Ann.hs +3/−0
• src/Language/Python/Syntax/CommaSep.hs +17/−0
• src/Language/Python/Syntax/Statement.hs +24/−2
• src/Language/Python/Validate/Scope.hs +204/−200
• src/Language/Python/Validate/Syntax.hs +15/−15
• test/Scope.hs +44/−0

@@ -1,6 +1,40 @@ # Revision history for hpython +## 0.3++* Changed the sigature of `Data.Validation.Monadic.bindVM` to have the same form as+  `(>>=)`+  +* Added `HasAnn` instance for `Language.Python.Syntax.Ann.Ann`++* Reworked scope checking (`Language.Python.Validate.Scope`)++  Instead of the old triplicate `ScopeContext`, we now keep a single context+  and mark each entry with its 'occurrence path'. This is much simpler to manage,+  but just as expressive as the old version.+  +* Improved scope checking of compound statements++  Compound statements like+  +  ```+  if ...:+      x = 1+  else:+      y = x+  ```+  +  were succeeding in scope checking because the variables from each block were+  added to the scope sequentially. Now, the multiple blocks are checked in the+  same scope, and their final scopes are combined at the end of the process.+  +* Added `Foldable1`/`Traversable1` instances for `CommaSep1` and `CommaSep1'`++* Added `HasStatements1` with instances for `Statement` and `Block`+ ## 0.2++*2019-01-10*  * Improved Plated instance for exprs 

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                hpython-version:             0.2+version:             0.3 synopsis:            Python language tools description:   `hpython` provides an abstract syntax tree for Python 3.5, along with a parser,@@ -64,7 +64,7 @@ tested-with:           GHC == 8.0.2                      , GHC == 8.2.2                      , GHC == 8.4.4-                     , GHC == 8.6.1+                     , GHC == 8.6.4   source-repository    head@@ -136,7 +136,7 @@                      , deriving-compat >=0.4 && <0.6                      , semigroupoids >=5.2.2 && <5.4                      , text >=1.2 && <1.3-                     , these >=0.7.4 && <0.8+                     , these >=0.7.4 && <0.9                      , validation >= 1 && < 1.1                      , parsers-megaparsec >=0.1 && <0.2   hs-source-dirs:      src

@@ -38,9 +38,14 @@ runValidateM :: ValidateM e m a -> m (Validation e a) runValidateM = getCompose . unValidateM --- | Bind into a 'ValidateM'. Note that the first parameter is @m a@, not @ValidateM e m a@.-bindVM :: Monad m => m a -> (a -> ValidateM e m b) -> ValidateM e m b-bindVM m f = ValidateM . Compose $ m >>= getCompose . unValidateM . f+-- | Bind into a 'ValidateM'+bindVM :: Monad m => ValidateM e m a -> (a -> ValidateM e m b) -> ValidateM e m b+bindVM m f =+  ValidateM . Compose $ do+    res <- getCompose $ unValidateM m+    case res of+      Failure err -> pure $ Failure err+      Success a -> getCompose . unValidateM $ f a  -- | Lift into a succeeding validation liftVM0 :: (Functor m, Semigroup e) => m a -> ValidateM e m a

@@ -34,6 +34,9 @@ class HasAnn s where   annot :: Lens' (s a) (Ann a) +instance HasAnn Ann where+  annot = id+ -- | Get an annotation and forget the wrapper annot_ :: HasAnn s => Lens' (s a) a annot_ = annot._Wrapped

@@ -29,9 +29,12 @@ import Data.Coerce (coerce) import Data.Function ((&)) import Data.Functor (($>))+import Data.Functor.Apply ((<.>)) import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (fromMaybe) import Data.Semigroup (Semigroup(..))+import Data.Semigroup.Foldable (Foldable1(..))+import Data.Semigroup.Traversable (Traversable1(..), foldMap1Default) import GHC.Generics (Generic)  import Language.Python.Syntax.Punctuation@@ -94,6 +97,13 @@   | CommaSepMany1 a Comma (CommaSep1 a)   deriving (Eq, Show, Functor, Foldable, Traversable, Generic) +instance Foldable1 CommaSep1 where; foldMap1 = foldMap1Default+instance Traversable1 CommaSep1 where+  traverse1 f = go+    where+      go (CommaSepOne1 a) = CommaSepOne1 <$> f a+      go (CommaSepMany1 a b c) = (\a' c' -> CommaSepMany1 a' b c') <$> f a <.> go c+ -- | Get the first element of a 'CommaSep1' commaSep1Head :: CommaSep1 a -> a commaSep1Head (CommaSepOne1 a) = a@@ -141,6 +151,13 @@   = CommaSepOne1' a (Maybe Comma)   | CommaSepMany1' a Comma (CommaSep1' a)   deriving (Eq, Show, Functor, Foldable, Traversable, Generic)++instance Foldable1 CommaSep1' where; foldMap1 = foldMap1Default+instance Traversable1 CommaSep1' where+  traverse1 f = go+    where+      go (CommaSepOne1' a b) = (\a' -> CommaSepOne1' a' b) <$> f a+      go (CommaSepMany1' a b c) = (\a' c' -> CommaSepMany1' a' b c') <$> f a <.> go c  -- | Iso to unpack a 'CommaSep' _CommaSep

@@ -21,6 +21,7 @@     Statement(..)     -- ** Traversals   , HasStatements(..)+  , HasStatements1(..)     -- * Decorators   , Decorator(..)     -- ** Compound statements@@ -62,14 +63,15 @@ import Control.Lens.Prism (_Right) import Control.Lens.Setter ((.~), over, mapped) import Control.Lens.TH (makeLenses)-import Control.Lens.Traversal (Traversal, traverseOf)+import Control.Lens.Traversal (Traversal, Traversal1, traverseOf) import Control.Lens.Tuple (_1, _2, _3, _4) import Data.Bifoldable (bifoldMap) import Data.Bifunctor (bimap) import Data.Bitraversable (bitraverse) import Data.Coerce (coerce)+import Data.Functor.Apply ((<.>)) import Data.Generics.Product.Typed (typed)-import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (isNothing) import Data.Monoid ((<>)) import GHC.Generics (Generic)@@ -104,6 +106,9 @@ class HasStatements s where   _Statements :: Traversal (s v a) (s '[] a) (Statement v a) (Statement '[] a) +class HasStatements s => HasStatements1 s where+  _Statements1 :: Traversal1 (s v a) (s '[] a) (Statement v a) (Statement '[] a)+ -- | A 'Block' is an indented multi-line chunk of code, forming part of a -- 'Suite'. data Block (v :: [*]) a@@ -186,6 +191,20 @@   _Statements f (Block a b c) =     Block a <$> f b <*> (traverse._Right) f c +instance HasStatements1 Block  where+  _Statements1 f (Block a l m) = uncurry (Block a) <$> go l m+    where+      go b [] = (\b' -> (b', [])) <$> f b+      go b (Left c:cs) =+        (\(b', cs') -> (b', Left c:cs')) <$>+        go b cs+      go b (Right c:cs) =+        (,) <$>+        f b <.>+        fmap+          (\(c', cs') -> Right c' : cs')+          (go c cs)+ instance HasStatements Suite where   _Statements _ (SuiteOne a b c) = pure $ SuiteOne a b (c ^. unvalidated)   _Statements f (SuiteMany a b c d e) = SuiteMany a b c d <$> _Statements f e@@ -211,6 +230,9 @@  instance HasStatements Statement where   _Statements = id++instance HasStatements1 Statement where+  _Statements1 = id  instance HasExprs SmallStatement where   _Exprs f (MkSmallStatement s ss a b c) =

@@ -1,10 +1,11 @@ {-# language DataKinds, TypeOperators #-}-{-# language GeneralizedNewtypeDeriving #-}-{-# language TemplateHaskell, TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-}+{-# language DeriveFunctor #-} {-# language FlexibleContexts #-} {-# language RankNTypes #-} {-# language LambdaCase #-}+{-# language OverloadedLists #-} {-# language ScopedTypeVariables, TypeApplications #-}+{-# language MultiParamTypeClasses #-}  {-| Module      : Language.Python.Validate.Scope@@ -25,15 +26,15 @@   , validateExprScope     -- * Miscellany     -- ** Extra types-  , ScopeContext(..), scGlobalScope, scLocalScope, scImmediateScope-  , runValidateScope'-  , initialScopeContext-  , Binding(..)+  , Level(..), Entry(..)     -- ** Extra functions+  , runValidateScope'+  , definitionScope+  , controlScope   , inScope+  , lookupScope+  , localScope   , extendScope-  , locallyOver-  , locallyExtendOver     -- ** Validation functions   , validateArgScope   , validateAssignExprScope@@ -56,34 +57,34 @@  import Data.Validation -import Control.Arrow ((&&&))-import Control.Applicative ((<|>)) import Control.Lens.Cons (snoc) import Control.Lens.Fold ((^..), toListOf, folded)-import Control.Lens.Getter ((^.), view, to, getting, use)-import Control.Lens.Lens (Lens')+import Control.Lens.Getter ((^.), to, getting) import Control.Lens.Plated (cosmos) import Control.Lens.Prism (_Right, _Just) import Control.Lens.Review ((#))-import Control.Lens.Setter ((%~), (.~), Setter', mapped, over)-import Control.Lens.TH (makeLenses)+import Control.Lens.Setter (mapped, over) import Control.Lens.Tuple (_2, _3) import Control.Lens.Traversal (traverseOf)-import Control.Monad.State (MonadState, State, evalState, modify)+import Control.Monad.State (State, evalState, modify, get, put)+import Control.Monad.Reader (ReaderT, runReaderT, ask, local) import Data.Bitraversable (bitraverse) import Data.ByteString (ByteString) import Data.Coerce (coerce)-import Data.Foldable (traverse_)-import Data.Functor.Compose (Compose(..))+import Data.Foldable (toList, traverse_) import Data.List.NonEmpty (NonEmpty(..)) import Data.Map.Strict (Map)+import Data.Maybe (isJust)+import Data.Sequence ((|>), Seq) import Data.String (fromString) import Data.Type.Set (Nub)-import Data.Validate.Monadic (ValidateM(..), runValidateM, bindVM, liftVM0, errorVM1)+import Data.Validate.Monadic+  (ValidateM(..), runValidateM, bindVM, liftVM0, liftVM1, errorVM1) import Unsafe.Coerce (unsafeCoerce)  import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map.Strict as Map+import Data.Sequence as Seq  import Language.Python.Optics import Language.Python.Optics.Validated (unvalidated)@@ -96,87 +97,67 @@  data Scope -data Binding = Clean | Dirty-  deriving (Eq, Ord, Show)--data ScopeContext a-  = ScopeContext-  { _scGlobalScope :: !(Map ByteString a)-  , _scLocalScope :: !(Map ByteString a)-  , _scImmediateScope :: !(Map ByteString a)-  }+data Level+  = Toplevel+  | Definition+  | Control   deriving (Eq, Show)-makeLenses ''ScopeContext -initialScopeContext :: ScopeContext a-initialScopeContext = ScopeContext Map.empty Map.empty Map.empty+data Entry a+  = Entry+  { _entryValue :: a+  , _entryPath :: !(Seq Level)+  } deriving (Eq, Show, Functor) -type ValidateScope ann e = ValidateM (NonEmpty e) (State (ScopeContext ann))+type ValidateScope ann e+  = ValidateM+      (NonEmpty e)+      (ReaderT (Seq Level) (State (Map ByteString (Entry ann))))  runValidateScope :: ValidateScope ann e a -> Validation (NonEmpty e) a-runValidateScope = runValidateScope' initialScopeContext+runValidateScope = runValidateScope' [Toplevel] mempty -runValidateScope' :: ScopeContext ann -> ValidateScope ann e a -> Validation (NonEmpty e) a-runValidateScope' s = flip evalState s . runValidateM+runValidateScope' ::+  Seq Level {- ^ Path -} ->+  Map ByteString (Entry ann) {- ^ Context -} ->+  ValidateScope ann e a {- ^ Validation action -} ->+  Validation (NonEmpty e) a+runValidateScope' path s = flip evalState s . flip runReaderT path . runValidateM -extendScope-  :: Setter' (ScopeContext ann) (Map ByteString ann)-  -> [(ann, String)]-  -> ValidateScope ann e ()-extendScope l s =-  liftVM0 $ do-    gs <- use scGlobalScope-    let t = buildMap gs Map.empty-    modify (over l (t `unionL`))-  where-    buildMap gs t =-      foldr-      (\(ann, a) b ->-          let-            a' = fromString a-          in-            if Map.member a' gs-            then b-            else Map.insert a' ann b)-      t-      s+localScope ::+  (Map ByteString (Entry ann) -> Map ByteString (Entry ann)) ->+  ValidateScope ann e a ->+  ValidateScope ann e a+localScope f m =+  liftVM0 get `bindVM` \s ->+  liftVM0 (modify f) *>+  m <* liftVM0 (put s) -locallyOver-  :: Lens' (ScopeContext ann) b-  -> (b -> b)-  -> ValidateScope ann e a-  -> ValidateScope ann e a-locallyOver l f m =-  ValidateM . Compose $ do-    before <- use l-    modify (l %~ f)-    getCompose (unValidateM m) <* modify (l .~ before)+-- | Run a validation action for a definition block+definitionScope :: ValidateScope ann e a -> ValidateScope ann e a+definitionScope = liftVM1 (local (|> Definition)) . localScope id -locallyExtendOver-  :: Lens' (ScopeContext ann) (Map ByteString ann)-  -> [(ann, String)]-  -> ValidateScope ann e a-  -> ValidateScope ann e a-locallyExtendOver l s m = locallyOver l id $ extendScope l s *> m+-- | Run a validation action for a flow control block+controlScope :: ValidateScope ann e a -> ValidateScope ann e a+controlScope = liftVM1 (local (|> Control)) -inScope-  :: MonadState (ScopeContext ann) m-  => String-  -> m (Maybe (Binding, ann))-inScope s = do-  gs <- use scGlobalScope-  ls <- use scLocalScope-  is <- use scImmediateScope-  let-    s' = fromString s-    inls = Map.lookup s' ls-    ings = Map.lookup s' gs-  pure $-    ((,) Clean <$> Map.lookup s' is) <|>-    (ings *> ((,) Clean <$> inls)) <|>-    ((,) Clean <$> ings) <|>-    ((,) Dirty <$> inls)+-- | Add some entries to the context, using the current depth and level+extendScope :: [Ident v ann] -> ValidateScope ann e ()+extendScope entries =+  liftVM0 ask `bindVM` \path ->+  liftVM0 . modify $ \scope ->+    foldr+      (\ident ->+         Map.insert (fromString $ _identValue ident) (Entry (ident ^. annot_) path))+      scope+      entries +inScope :: String -> ValidateScope ann e Bool+inScope = fmap isJust . lookupScope++lookupScope :: String -> ValidateScope ann e (Maybe (Entry ann))+lookupScope s = Map.lookup (fromString s) <$> liftVM0 get + validateExceptAsScope   :: AsScopeError e a   => ExceptAs v a@@ -202,122 +183,147 @@   (\d' -> Decorator a b c d' e f g) <$>   validateExprScope d +parallel2 ::+  ValidateScope a e x ->+  ValidateScope a e y ->+  ValidateScope a e (x, y)+parallel2 a b =+  liftVM0 get `bindVM` \st ->+  ((,) <$>+   ((,) <$ liftVM0 (put st) <*> a <*> liftVM0 get) <*>+   ((,) <$ liftVM0 (put st) <*> b <*> liftVM0 get)) `bindVM`+  \((ares, ast), (bres, bst)) ->+  (ares, bres) <$+    liftVM0+    (put $+     Map.unionWith+       (\e1 e2 ->+          if Seq.length (_entryPath e1) < Seq.length (_entryPath e2)+          then e2+          else e1)+       ast+       bst)++parallelList ::+  (x -> ValidateScope a e y) ->+  [x] ->+  ValidateScope a e [y]+parallelList _ [] = pure []+parallelList f (x:xs) = uncurry (:) <$> parallel2 (f x) (parallelList f xs)++parallelNonEmpty ::+  (x -> ValidateScope a e y) ->+  NonEmpty x ->+  ValidateScope a e (NonEmpty y)+parallelNonEmpty f (x:|xs) = uncurry (:|) <$> parallel2 (f x) (parallelList f xs)++parallel3 ::+  ValidateScope a e x1 ->+  ValidateScope a e x2 ->+  ValidateScope a e x3 ->+  ValidateScope a e (x1, x2, x3)+parallel3 a b c = (\(a', (b', c')) -> (a', b', c')) <$> parallel2 a (parallel2 b c)++parallel4 ::+  ValidateScope a e x1 ->+  ValidateScope a e x2 ->+  ValidateScope a e x3 ->+  ValidateScope a e x4 ->+  ValidateScope a e (x1, x2, x3, x4)+parallel4 a b c d =+  (\(a', (b', c', d')) -> (a', b', c', d')) <$> parallel2 a (parallel3 b c d)+ validateCompoundStatementScope   :: forall e v a    . AsScopeError e a   => CompoundStatement v a   -> ValidateScope a e (CompoundStatement (Nub (Scope ': v)) a) validateCompoundStatementScope (Fundef a decos idnts asyncWs ws1 name ws2 params ws3 mty s) =-  (locallyOver scLocalScope (const Map.empty) $-   locallyOver scImmediateScope (const Map.empty) $-     (\decos' -> Fundef a decos' idnts asyncWs ws1 (coerce name) ws2) <$>-     traverse validateDecoratorScope decos <*>-     traverse validateParamScope params <*>-     pure ws3 <*>-     traverseOf (traverse._2) validateExprScope mty <*>-     locallyExtendOver-       scGlobalScope-       ((view annot_ &&& _identValue) name :-         toListOf (folded.getting paramName.to (view annot_ &&& _identValue)) params)-       (validateSuiteScope s)) <*-  extendScope scLocalScope [(view annot_ &&& _identValue) name] <*-  extendScope scImmediateScope [(view annot_ &&& _identValue) name]+  (\decos' -> Fundef a decos' idnts asyncWs ws1 (coerce name) ws2) <$>+  traverse validateDecoratorScope decos <*>+  traverse validateParamScope params <*>+  pure ws3 <*>+  traverseOf (traverse._2) validateExprScope mty <*>+  definitionScope+    (extendScope (name : toListOf (folded.getting paramName) params) *>+     validateSuiteScope s) <*+  extendScope [name] validateCompoundStatementScope (If idnts a ws1 e b elifs melse) =-  use scLocalScope `bindVM` (\ls ->-  use scImmediateScope `bindVM` (\is ->-  locallyOver scGlobalScope (`unionR` unionR ls is) $-  locallyOver scImmediateScope (const Map.empty)-    (If idnts a ws1 <$>-     validateExprScope e <*>-     validateSuiteScope b <*>-     traverse-       (\(a, b, c, d) ->-          (\c' -> (,,,) a b c') <$>-          validateExprScope c <*>-          validateSuiteScope d)-       elifs <*>-     traverseOf (traverse._3) validateSuiteScope melse)))+  (\e' (b', elifs', melse') -> If idnts a ws1 e' b' elifs' melse') <$>+  validateExprScope e <*>+  parallel3+    (controlScope $ validateSuiteScope b)+    (parallelList+     (\(a, b, c, d) ->+       (,,,) a b <$>+       validateExprScope c <*>+       controlScope (validateSuiteScope d))+     elifs)+    (traverseOf (traverse._3) (controlScope . validateSuiteScope) melse) validateCompoundStatementScope (While idnts a ws1 e b els) =-  use scLocalScope `bindVM` (\ls ->-  use scImmediateScope `bindVM` (\is ->-  locallyOver scGlobalScope (`unionR` unionR ls is) $-  locallyOver scImmediateScope (const Map.empty)-    (While idnts a ws1 <$>-     validateExprScope e <*>-     validateSuiteScope b <*>-     traverseOf (traverse._3) validateSuiteScope els)))+  While idnts a ws1 <$>+  validateExprScope e <*>+  controlScope (validateSuiteScope b) <*>+  traverseOf (traverse._3) (controlScope . validateSuiteScope) els validateCompoundStatementScope (TryExcept idnts a b e f k l) =-  use scLocalScope `bindVM` (\ls ->-  use scImmediateScope `bindVM` (\is ->-  locallyOver scGlobalScope (`unionR` unionR ls is) $-  locallyOver scImmediateScope (const Map.empty)-    (TryExcept idnts a b <$>-     validateSuiteScope e <*>-     traverse+  (\(e', f', k', l') -> TryExcept idnts a b e' f' k' l') <$>+  parallel4+    (controlScope $ validateSuiteScope e)+    (parallelNonEmpty        (\(idnts, ws, g, h) ->-          (,,,) idnts ws <$>-          traverse validateExceptAsScope g <*>-          locallyExtendOver-            scGlobalScope-            (toListOf (folded.exceptAsName._Just._2.to (view annot_ &&& _identValue)) g)-            (validateSuiteScope h))-       f <*>-     traverseOf (traverse._3) validateSuiteScope k <*>-     traverseOf (traverse._3) validateSuiteScope l)))+         (,,,) idnts ws <$>+         traverse validateExceptAsScope g <*>+         controlScope+         (extendScope (toListOf (folded.exceptAsName._Just._2) g) *>+          validateSuiteScope h))+       f)+    (traverseOf (traverse._3) (controlScope . validateSuiteScope) k)+    (traverseOf (traverse._3) (controlScope . validateSuiteScope) l) validateCompoundStatementScope (TryFinally idnts a b e idnts2 f i) =-  use scLocalScope `bindVM` (\ls ->-  use scImmediateScope `bindVM` (\is ->-  locallyOver scGlobalScope (`unionR` unionR ls is) $-  locallyOver scImmediateScope (const Map.empty)-    (TryFinally idnts a b <$>-     validateSuiteScope e <*>-     pure idnts2 <*>-     pure f <*>-     validateSuiteScope i)))+  (\(e', i') -> TryFinally idnts a b e' idnts2 f i') <$>+  parallel2+    (controlScope $ validateSuiteScope e)+    (controlScope $ validateSuiteScope i) validateCompoundStatementScope (For idnts a asyncWs b c d e h i) =-  use scLocalScope `bindVM` (\ls ->-  use scImmediateScope `bindVM` (\is ->-  locallyOver scGlobalScope (`unionR` unionR ls is) $-  locallyOver scImmediateScope (const Map.empty) $-    For @(Nub (Scope ': v)) idnts a asyncWs b <$>+  let+    cs = c ^.. unvalidated.cosmos._Ident+  in+    (\c' d' e' (h', i') -> For idnts a asyncWs b c' d' e' h' i') <$>     (unsafeCoerce c <$      traverse        (\s ->-          inScope (s ^. identValue) `bindVM` \res ->-          maybe (pure ()) (\_ -> errorVM1 (_BadShadowing # coerce s)) res)-       (c ^.. unvalidated.cosmos._Ident)) <*>+         inScope (s ^. identValue) `bindVM` \res ->+         if res then errorVM1 (_BadShadowing # coerce s) else pure ())+       cs) <*>     pure d <*>     traverse validateExprScope e <*>-    (let-       ls = c ^.. unvalidated.cosmos._Ident.to (view annot_ &&& _identValue)-     in-       extendScope scLocalScope ls *>-       extendScope scImmediateScope ls *>-       validateSuiteScope h) <*>-    traverseOf (traverse._3) validateSuiteScope i))+    parallel2+      (controlScope $+       extendScope (toList cs) *>+       validateSuiteScope h)+      (traverseOf (traverse._3) (controlScope . validateSuiteScope) i) validateCompoundStatementScope (ClassDef a decos idnts b c d g) =-  (\decos' -> ClassDef @(Nub (Scope ': v)) a decos' idnts b (coerce c)) <$>+  (\decos' -> ClassDef a decos' idnts b (coerce c)) <$>   traverse validateDecoratorScope decos <*>   traverseOf (traverse._2.traverse.traverse) validateArgScope d <*>-  validateSuiteScope g <*-  extendScope scImmediateScope [c ^. to (view annot_ &&& _identValue)]+  definitionScope (validateSuiteScope g) <*+  extendScope [c] validateCompoundStatementScope (With a b asyncWs c d e) =   let     names =       d ^..       folded.unvalidated.to _withItemBinder.folded._2.-      assignTargets.to (view annot_ &&& _identValue)+      assignTargets   in-    With @(Nub (Scope ': v)) a b asyncWs c <$>+    With a b asyncWs c <$>     traverse       (\(WithItem a b c) ->          WithItem @(Nub (Scope ': v)) a <$>          validateExprScope b <*>          traverseOf (traverse._2) validateAssignExprScope c)       d <*-    extendScope scLocalScope names <*-    extendScope scImmediateScope names <*>-    validateSuiteScope e+    extendScope names <*>+    controlScope (validateSuiteScope e)  validateSimpleStatementScope   :: AsScopeError e a@@ -338,18 +344,11 @@ validateSimpleStatementScope (Return a ws e) = Return a ws <$> traverse validateExprScope e validateSimpleStatementScope (Expr a e) = Expr a <$> validateExprScope e validateSimpleStatementScope (Assign a l rs) =-  let-    ls =-      (l : (snd <$> NonEmpty.init rs)) ^..-      folded.unvalidated.assignTargets.to (view annot_ &&& _identValue)-  in   Assign a <$>   validateAssignExprScope l <*>   ((\a b -> case a of; [] -> b :| []; a : as -> a :| snoc as b) <$>    traverseOf (traverse._2) validateAssignExprScope (NonEmpty.init rs) <*>-   (\(ws, b) -> (,) ws <$> validateExprScope b) (NonEmpty.last rs)) <*-  extendScope scLocalScope ls <*-  extendScope scImmediateScope ls+   (\(ws, b) -> (,) ws <$> validateExprScope b) (NonEmpty.last rs)) validateSimpleStatementScope (AugAssign a l aa r) =   (\l' -> AugAssign a l' aa) <$>   validateExprScope l <*>@@ -391,12 +390,15 @@   => Ident v a   -> ValidateScope a e (Ident (Nub (Scope ': v)) a) validateIdentScope i =-  inScope (_identValue i) `bindVM`-  \context ->-  case context of-    Just (Clean, _) -> pure $ coerce i-    Just (Dirty, ann)-> errorVM1 (_FoundDynamic # (ann, i ^. unvalidated))-    Nothing -> errorVM1 (_NotInScope # (i ^. unvalidated))+  lookupScope (_identValue i) `bindVM` \res ->+  liftVM0 ask `bindVM` \curPath ->+    case res of+      Nothing -> errorVM1 (_NotInScope # (i ^. unvalidated))+      Just (Entry ann path) ->+        coerce i <$+        if Seq.length curPath < Seq.length path+        then errorVM1 (_FoundDynamic # (ann, i ^. unvalidated))+        else pure ()  validateArgScope   :: AsScopeError e a@@ -446,11 +448,11 @@   -> Comprehension ex v a   -> ValidateScope a e (Comprehension ex (Nub (Scope ': v)) a) validateComprehensionScope f (Comprehension a b c d) =-  locallyOver scGlobalScope id $-    (\c' d' b' -> Comprehension a b' c' d') <$>-    validateCompForScope c <*>-    traverse (bitraverse validateCompForScope validateCompIfScope) d <*>-    f b+  controlScope $+  (\c' d' b' -> Comprehension a b' c' d') <$>+  validateCompForScope c <*>+  traverse (bitraverse validateCompForScope validateCompIfScope) d <*>+  f b   where     validateCompForScope       :: AsScopeError e a@@ -460,8 +462,7 @@       (\c' -> CompFor a b c' d) <$>       validateAssignExprScope c <*>       validateExprScope e <*-      extendScope scGlobalScope-        (c ^.. unvalidated.assignTargets.to (view annot_ &&& _identValue))+      extendScope (c ^.. unvalidated.assignTargets)      validateCompIfScope       :: AsScopeError e a@@ -502,6 +503,16 @@   where     tupleItem (TupleItem a b) = TupleItem a <$> validateAssignExprScope b     tupleItem (TupleUnpack a b c d) = TupleUnpack a b c <$> validateAssignExprScope d+validateAssignExprScope (Ident a (MkIdent b c d)) =+  lookupScope c `bindVM` \res ->+  liftVM0 ask `bindVM` \curPath ->+  Ident a (MkIdent b c d) <$+  case res of+    Nothing -> extendScope [MkIdent b c d]+    Just (Entry _ path)->+      if Seq.length curPath < Seq.length path+      then extendScope [MkIdent b c d]+      else pure () validateAssignExprScope e@Unit{} = pure $ unsafeCoerce e validateAssignExprScope e@Lambda{} = pure $ unsafeCoerce e validateAssignExprScope e@Yield{} = pure $ unsafeCoerce e@@ -511,7 +522,6 @@ validateAssignExprScope e@Call{} = pure $ unsafeCoerce e validateAssignExprScope e@UnOp{} = pure $ unsafeCoerce e validateAssignExprScope e@BinOp{} = pure $ unsafeCoerce e-validateAssignExprScope e@Ident{} = pure $ unsafeCoerce e validateAssignExprScope e@None{} = pure $ unsafeCoerce e validateAssignExprScope e@Ellipsis{} = pure $ unsafeCoerce e validateAssignExprScope e@Int{} = pure $ unsafeCoerce e@@ -668,9 +678,3 @@      ModuleStatement <$>      validateStatementScope a <*>      validateModuleScope b--unionL :: Ord k => Map k v -> Map k v -> Map k v-unionL = Map.unionWith const--unionR :: Ord k => Map k v -> Map k v -> Map k v-unionR = Map.unionWith (const id)

@@ -212,7 +212,7 @@   | not (all isAscii name) = errorVM1 (_BadCharacter # (getAnn a, name))   | null name = errorVM1 (_EmptyIdentifier # getAnn a)   | otherwise =-      bindVM (view inFunction) $ \fi ->+      bindVM (liftVM0 $ view inFunction) $ \fi ->         let           reserved =             reservedWords <>@@ -230,7 +230,7 @@   -> f Whitespace   -> ValidateSyntax e (f Whitespace) validateWhitespace ann ws =-  ask `bindVM` \ctxt ->+  liftVM0 ask `bindVM` \ctxt ->   if _inParens ctxt   then pure ws   else if@@ -492,7 +492,7 @@ validateExprSyntax (Yield a b c) =   Yield a <$>   validateWhitespace (getAnn a) b <*-  (ask `bindVM` \ctxt ->+  (liftVM0 ask `bindVM` \ctxt ->       case _inFunction ctxt of         Nothing           | _inGenerator ctxt -> pure ()@@ -506,7 +506,7 @@   YieldFrom a <$>   validateWhitespace (getAnn a) b <*>   validateWhitespace (getAnn a) c <*-  (ask `bindVM` \ctxt ->+  (liftVM0 ask `bindVM` \ctxt ->       case _inFunction ctxt of         Nothing           | _inGenerator ctxt -> pure ()@@ -574,7 +574,7 @@ validateExprSyntax (Generator a comp) =   Generator a <$> validateComprehensionSyntax validateExprSyntax comp validateExprSyntax (Await a ws expr) =-  bindVM ask $ \ctxt ->+  bindVM (liftVM0 ask) $ \ctxt ->   Await a <$>   validateWhitespace (getAnn a) ws <*   (if not $ fromMaybe False (ctxt ^? inFunction._Just.asyncFunction)@@ -792,7 +792,7 @@     (local $ (inClass .~ True) . (inFunction .~ Nothing))     (validateSuiteSyntax g) validateCompoundStatementSyntax (For a idnts asyncWs b c d e h i) =-  bindVM ask $ \ctxt ->+  bindVM (liftVM0 ask) $ \ctxt ->   For a idnts <$   (if isJust asyncWs && not (fromMaybe False $ ctxt ^? inFunction._Just.asyncFunction)    then errorVM1 (_AsyncForOutsideCoroutine # getAnn a)@@ -812,7 +812,7 @@        validateSuiteSyntax w)     i validateCompoundStatementSyntax (With a b asyncWs c d e) =-  bindVM ask $ \ctxt ->+  bindVM (liftVM0 ask) $ \ctxt ->   With a b <$   (if isJust asyncWs && not (fromMaybe False $ ctxt ^? inFunction._Just.asyncFunction)    then errorVM1 (_AsyncWithOutsideCoroutine # getAnn a)@@ -872,7 +872,7 @@   => ImportTargets v a   -> ValidateSyntax e (ImportTargets (Nub (Syntax ': v)) a) validateImportTargetsSyntax (ImportAll a ws) =-  bindVM ask $ \ctxt ->+  bindVM (liftVM0 ask) $ \ctxt ->   if ctxt ^. inClass || has (inFunction._Just) ctxt     then errorVM1 $ _WildcardImportInDefinition # getAnn a     else ImportAll a <$> validateWhitespace (getAnn a) ws@@ -943,7 +943,7 @@          c)     f validateSimpleStatementSyntax (Return a ws expr) =-  ask `bindVM` \sctxt ->+  liftVM0 ask `bindVM` \sctxt ->     case _inFunction sctxt of       Just{} ->         Return a <$>@@ -954,7 +954,7 @@   Expr a <$>   validateExprSyntax expr validateSimpleStatementSyntax (Assign a lvalue rs) =-  ask `bindVM` \sctxt ->+  liftVM0 ask `bindVM` \sctxt ->     let       assigns =         if isJust (_inFunction sctxt)@@ -990,14 +990,14 @@   Pass a <$> validateWhitespace (getAnn a) ws validateSimpleStatementSyntax (Break a ws) =   Break a <$-  (ask `bindVM` \sctxt ->+  (liftVM0 ask `bindVM` \sctxt ->      if _inLoop sctxt      then pure ()      else errorVM1 (_BreakOutsideLoop # getAnn a)) <*>   validateWhitespace (getAnn a) ws validateSimpleStatementSyntax (Continue a ws) =   Continue a <$-  (ask `bindVM` \sctxt ->+  (liftVM0 ask `bindVM` \sctxt ->      (if _inLoop sctxt       then pure ()       else errorVM1 (_ContinueOutsideLoop # getAnn a)) *>@@ -1006,7 +1006,7 @@       else pure ())) <*>   validateWhitespace (getAnn a) ws validateSimpleStatementSyntax (Global a ws ids) =-  ask `bindVM` \ctx ->+  liftVM0 ask `bindVM` \ctx ->   let     params = ctx ^.. inFunction.folded.functionParams.folded   in@@ -1022,8 +1022,8 @@          validateIdentSyntax i)       ids validateSimpleStatementSyntax (Nonlocal a ws ids) =-  ask `bindVM` \sctxt ->-  get `bindVM` \nls ->+  liftVM0 ask `bindVM` \sctxt ->+  liftVM0 get `bindVM` \nls ->   (case deleteFirstsBy' (\a -> (==) (a ^. unvalidated.identValue)) (ids ^.. folded.unvalidated) nls of      [] -> pure ()      ids -> traverse_ (\e -> errorVM1 (_NoBindingNonlocal # e)) ids) *>

@@ -191,3 +191,47 @@     res <- fullyValidate st     annotateShow res     res === Failure (BadShadowing (MkIdent (Ann ()) "x" [Space]) :| [])++prop_scope_12 :: Property+prop_scope_12 =+  withTests 1 . property $ do+    let+      st =+        _If #+        (if_ none_ [line_ (var_ "x" .= 2)] &+         else_ [line_ (var_ "y" .= var_ "x")])+    res <- fullyValidate st+    annotateShow res+    res === Failure (NotInScope (MkIdent (Ann ()) "x" []) :| [])++prop_scope_13 :: Property+prop_scope_13 =+  withTests 1 . property $ do+    let+      st =+        _Fundef #+        def_ "test" []+        [ line_ $+          if_ none_ [line_ (var_ "x" .= 1)] &+          else_ [line_ (var_ "y" .= 2)]+        , line_ $ var_ "x"+        ]+    res <- fullyValidate st+    annotateShow res+    res === Failure (FoundDynamic () (MkIdent (Ann ()) "x" []) :| [])++prop_scope_14 :: Property+prop_scope_14 =+  withTests 1 . property $ do+    let+      st =+        _Fundef #+        def_ "test" []+        [ line_ $+          if_ none_ [line_ (var_ "x" .= 1)] &+          else_ [line_ (var_ "y" .= 2)]+        , line_ $ var_ "y"+        ]+    res <- fullyValidate st+    annotateShow res+    res === Failure (FoundDynamic () (MkIdent (Ann ()) "y" []) :| [])