{-| Module : Language.Rust.Pretty.Resolve Copyright : (c) Alec Theriault, 2017-2018 License : BSD-style Maintainer : alec.theriault@gmail.com Stability : experimental Portability : portable /NOTE:/ the following uses hithero unimplemented antiquoting syntax An AST and its text form /should/ be completely isomorphic, with @parse@ and @pretty@ being the functions allowing you to go back and forth between these forms. Unfortunately, this cannot really be the case. The AST form can express programs which cannot be literally pretty printed and still make sense. Sometimes, extra parens or semicolons need to be added. == Simple example For example, consider the following interaction >>> import Language.Rust.Quote >>> import Language.Rust.Pretty >>> :set -XQuasiQuotes >>> x = [expr| 2 + 3 |] >>> y = [expr| 1 * $x |] >>> pretty y 0 * 1 + 2 The problem is that we haven't introduced the paren AST node (which we would have gotten had we parsed @1 * (2 + 3)@. This is where 'resolve' steps in. >>> Right y' = resolve y >>> pretty y' 0 * (1 + 2) == More involved example From the above, it is tempting to say: your pretty printer should be smarter! However, things are not always so simple. Consider the less obvious example: >>> fnBody = [expr| { let y = x; x += 1; y } + x |] >>> fn = [item| fn foo(mut x: i32) -> i32 { $fnBody } |] >>> pretty fn fn foo(mut x: i32) -> i32 { { let y = x; x += 1; y } + x } This is clearly not the desired output - this won't compile with @rustc@ because of an invariant in blocks: if the block ends in an expression, that expression cannot start with a block. To fix this, we call 'resolve' on the AST before pretty printing it. >>> Right fn' = resolve fn >>> pretty fn' fn foo(mut x: i32) -> i32 { ({ let y = x; x += 1; y }) + x } And now we have generated valid code. -} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE OverloadedLists #-} module Language.Rust.Pretty.Resolve ( Resolve(resolve, resolve', resolveVerbose), Issue(..), Severity(..), ResolveFail(..), ) where import Language.Rust.Syntax import Language.Rust.Data.Ident ( Ident(..), mkIdent, IdentName(..) ) import Language.Rust.Data.InputStream ( inputStreamFromString ) import Language.Rust.Data.Position ( initPos, Spanned(..) ) import Language.Rust.Parser.Lexer ( lexTokens, lexToken ) import Language.Rust.Parser.ParseMonad ( execParser ) import Control.Exception ( throw, Exception ) import Control.Monad ( when ) import Control.Monad.Trans.RWS import Data.Dynamic ( Dynamic, toDyn, Typeable ) import Data.List ( find ) import Language.Rust.Parser.NonEmpty ( NonEmpty(..) ) import qualified Language.Rust.Parser.NonEmpty as N import qualified Data.List.NonEmpty as N2 ( NonEmpty(..) ) import Data.Maybe ( fromJust ) import Data.Semigroup ( (<>) ) {-# ANN module "HLint: ignore Reduce duplication" #-} -- TODO: -- * See where attributes are not allowed -- * resolve in a better monad (`type ResolveM a = ReaderT [Doc] (Except ErrorType a)`) -- | Diagnostic for how severe an 'Issue' is. data Severity = Clean -- ^ Everything is normal (this variant is returned when there was nothing to resolve) | Warning -- ^ There is something fishy looking (AST is valid, but may not be what you expect) | Correction -- ^ The AST was invalid, but in a way that could be corrected | Error -- ^ The AST was invalid in some way that could not be automatically fixed deriving (Eq, Ord, Enum, Bounded, Show) -- | Localized information about an issue in a syntax tree. data Issue = Issue { description :: String -- ^ Description of the issue , severity :: !Severity -- ^ Severity of the issue , location :: [Dynamic] -- ^ The first element in this list is the syntax tree where the issue occurs. The next elements -- are increasingly zoomed out syntax trees centered on the first element. In lieu of positional -- information, this provides a next best way of debugging exactly where the problem is. } deriving (Show) -- | Monad in which to resolve a syntax tree. -- -- * Reader is @['Dynamic']@ storing the path from root to the current syntax tree node -- * Writer is @['Issue']@ accumulating issues met through the traversal -- * State is 'Severity' accumulating the most severe 'Issue' found so far in the traversal -- type ResolveM = RWS [Dynamic] [Issue] Severity -- | Log an 'Issue' logIssue :: String -- ^ description of the issue -> Severity -- ^ severity of the issue -> ResolveM () logIssue desc sev = do loc <- ask tell [Issue desc sev loc] modify (max sev) -- | Log a 'Warning' warn :: String -> ResolveM () warn desc = desc `logIssue` Warning -- | Log a 'Correction' correct :: String -> ResolveM () correct desc = desc `logIssue` Correction -- | Log an 'Error' err :: a -> String -> ResolveM a err x desc = (desc `logIssue` Error) *> pure x -- | Enter a new syntax tree scope :: Typeable a => a -> ResolveM b -> ResolveM b scope x = local (toDyn x :) -- | Exceptions that occur during resolving. Unlike parse errors, we don't have positional -- information. Instead, we try to provide some context via a list of syntax trees which -- let you "zoom out" from the problematic node. data ResolveFail = ResolveFail [Dynamic] String deriving (Typeable) -- | Does not show context information instance Show ResolveFail where showsPrec p (ResolveFail _ msg) = showParen (p >= 11) (showString expl) where expl = unwords [ "invalid AST", "(" ++ msg ++ ")" ] instance Exception ResolveFail -- | Since it is possible to have well-typed Haskell expressions which represent invalid Rust ASTs, -- it is convenient to fix, warn, or fail ASTs before printing them. The 'Resolve' typeclass -- provides such a facility. -- -- A non-exhaustive list of the more obvious issues it covers: -- -- * missing parens -- * invalid identifiers -- * invalid paths (for example, generic arguments on a module path) -- * inner attributes on things that support only outer attributes (and vice-versa) -- class Resolve a where -- | Convert some value to its /resolved/ form. Informally, resolving a value involves checking -- that its invariants hold and, if they don't, report an error message or adjust the value so -- that the invariant holds. -- -- A value of a type satsifying 'Language.Rust.Parser.Parse' and 'Language.Rust.Pretty.Pretty' -- is resolved if @'Language.Rust.Parser.parse' . 'Language.Rust.Pretty.pretty'@ is an identity -- operation on it. We further expect that 'resolve' be an identity operation on any output of -- 'Language.Rust.Parser.parse'. resolve :: a -> Either ResolveFail a resolve x = case runRWS (resolveM x) [] Clean of (_, Error, issues) -> let Issue desc _ locs = fromJust (find (\i -> severity i == Error) issues) in Left (ResolveFail locs desc) (t, _, _) -> Right t -- | Same as 'resolve', but throws a 'ResolveFail' exception if it cannot resolve. Although -- this function should not be used, it summarizes nicely the laws around 'Resolve': -- -- prop> parse' . pretty' . resolve' == id -- prop> resolve' . parse' = parse' -- resolve' :: a -> a resolve' = either throw id . resolve -- | Run resolution and get back the altered syntax tree, the highest 'Severity' of issues, and -- the list of issues found. This allows you to see what corrections were applied to the tree. -- If the output severity is 'Error', the syntax tree returned will still be invalid. resolveVerbose :: a -> (a, Severity, [Issue]) resolveVerbose x = runRWS (resolveM x) [] Clean -- | Internal recursive helper resolveM :: a -> ResolveM a -- | A valid sourcefile needs -- -- * the shebang to be one-line not conflicting with attributes -- * the attributes to be inner -- * the items to be 'ModItems' -- resolveSourceFile :: (Typeable a, Monoid a) => SourceFile a -> ResolveM (SourceFile a) resolveSourceFile s@(SourceFile sh as is) = scope s $ do sh' <- case sh of Just ('[':_) -> err sh "shebang cannot start with `['" Just s' | '\n' `elem` s' -> err sh "shebang cannot contain newlines" _ -> pure sh as' <- traverse (resolveAttr InnerAttr) as is' <- traverse (resolveItem ModItem) is pure (SourceFile sh' as' is') instance (Typeable a, Monoid a) => Resolve (SourceFile a) where resolveM = resolveSourceFile -- | An identifier can be invalid if -- -- * it does not lex into an identifier -- * it is a keyword -- resolveIdent :: Ident -> ResolveM Ident resolveIdent i@(Ident (Name s) r _) = scope i $ case toks of Right [Spanned (IdentTok i') _] | i /= i' -> err i ("identifier `" ++ s ++ "' does not lex properly") | i `elem` keywords && not r -> do correct ("identifier `" ++ s ++ "' is a keyword") pure i{ raw = True } | otherwise -> pure i _ -> err i ("identifier `" ++ s ++ "' does not lex properly") where keywords = map mkIdent $ words "as box break const continue crate else enum extern false fn for\ \ if impl in let loop match mod move mut pub ref return Self self\ \ static struct super trait true type unsafe use where while\ \ abstract alignof become do final macro offsetof override priv\ \ proc pure sizeof typeof unsized virtual yield" s' = (if r then "r#" else "") ++ s toks = execParser (lexTokens lexToken) (inputStreamFromString s') initPos resolveIdent i@(Ident (HaskellName _) _ _) = pure i instance Resolve Ident where resolveM = resolveIdent ---------------- -- Attributes -- ---------------- -- | Attribute type to against which to resolve data AttrType = EitherAttr -- ^ inner or outer attribute | InnerAttr -- ^ only innner attribute | OuterAttr -- ^ only outer attribute -- | A sugared doc is invalid if -- -- * the expected attribute style does not match the actual one -- * its content starts with a '/' / '*' when it is an outer line / inline comment -- * it is a line comment whose content spans multiple lines -- -- A regular attribute is invalid if -- -- * the expected attribute style does not match the actual one -- * the underlying path / tokenstream are invalid -- * the tokenstream starts with a '::' -- resolveAttr :: (Typeable a, Monoid a) => AttrType -> Attribute a -> ResolveM (Attribute a) resolveAttr typ s@(SugaredDoc sty inl con x) = scope s $ do sty' <- case (typ, sty) of (OuterAttr, Inner) -> correct "inner attribute was turned into outer attribute" *> pure Outer (InnerAttr, Outer) -> correct "outer attribute was turned into inner attribute" *> pure Inner (_, sty' ) -> pure sty' con' <- case (con, inl, sty') of ('/':_, False, Outer) -> correct "the content of an outer (line) doc comment cannot start with a `/'" *> pure (' ':con) ('*':_, True, Outer) -> correct "the contents of an outer (inline) doc comment cannot start with a a`*'" *> pure (' ':con) (_, False, _) | '\n' `elem` con -> err con "a doc comment that is not inline cannot have multiple lines" _ -> pure con pure (SugaredDoc sty' inl con' x) resolveAttr typ a@(Attribute sty p ts x) = scope a $ do sty' <- case (typ, sty) of (OuterAttr, Inner) -> correct "inner attribute was turned into outer attribute" *> pure Outer (InnerAttr, Outer) -> correct "outer attribute was turned into inner attribute" *> pure Inner (_, sty' ) -> pure sty' p' <- resolvePath ModPath p ts' <- resolveTokenStream ts case nextTok ts' of Just ModSep -> err () "the first token in the token stream `::' will be considered part of the path" _ -> pure () pure (Attribute sty' p' ts' x) where nextTok :: TokenStream -> Maybe Token nextTok (Tree (Token _ t)) = Just t nextTok (Tree (Delimited _ d _)) = Just (OpenDelim d) nextTok (Stream (s:_)) = nextTok s nextTok (Stream []) = Nothing instance (Typeable a, Monoid a) => Resolve (Attribute a) where resolveM = resolveAttr EitherAttr -------------- -- Literals -- -------------- -- | A literal cannot be invalid resolveLit :: Lit a -> ResolveM (Lit a) resolveLit = pure instance Resolve (Lit a) where resolveM = resolveLit ----------- -- Paths -- ----------- -- | Recall that paths are reused for expressions, modules, and types. However, these paths have -- different underlying invariants. data PathType = ModPath | UsePath -- ^ similar to 'ModPath', but can have no segments | TypePath | ExprPath deriving (Eq) instance Show PathType where show ModPath = "mod path" show UsePath = "use tree path" show TypePath = "type path" show ExprPath = "expression path" -- | A path can be invalid if -- -- * it has path parameters of the wrong type -- * it has identifiers not meant for paths -- -- TODO: guard against no path segments... resolvePath :: (Typeable a, Monoid a) => PathType -> Path a -> ResolveM (Path a) resolvePath t p@(Path _ [] _) | t /= UsePath = scope p $ err p "path must have at least one segment" resolvePath t p@(Path g segs x) = scope p $ if null [ () | PathSegment _ (Just a) _ <- segs, not (isParamsForPath t a) ] then Path g <$> traverse resolveSeg segs <*> pure x else err p "path parameter is not valid for this type of path" where resolveSeg :: (Typeable a, Monoid a) => PathSegment a -> ResolveM (PathSegment a) resolveSeg (PathSegment i a x') = do i' <- case i of Ident (Name "self") False _ -> pure i Ident (Name "Self") False _ -> pure i Ident (Name "super") False _ -> pure i Ident (Name "crate") False _ -> pure i _ -> resolveIdent i a' <- traverse resolvePathParameters a pure (PathSegment i' a' x') isParamsForPath :: PathType -> PathParameters a -> Bool isParamsForPath t' AngleBracketed{} = t' `elem` ([TypePath, ExprPath] :: [PathType]) isParamsForPath t' Parenthesized{} = t' `elem` ([TypePath] :: [PathType]) -- | There are three potential instances for resolving a path (depending on what type it is). The -- 'Resolve' instance for 'Path' will let through any path. instance (Typeable a, Monoid a) => Resolve (Path a) where resolveM = resolvePath TypePath -- | A path parameter can be invalid if any of its constituent components are invalid resolvePathParameters :: (Typeable a, Monoid a) => PathParameters a -> ResolveM (PathParameters a) resolvePathParameters p@(AngleBracketed lts tys bds x) = scope p $ do lts' <- traverse resolveLifetime lts tys' <- traverse (resolveTy AnyType) tys bds' <- traverse (\(i,t) -> (,) <$> resolveIdent i <*> resolveTy NoSumType t) bds pure (AngleBracketed lts' tys' bds' x) resolvePathParameters p@(Parenthesized tys tym x) = scope p $ do tys' <- traverse (resolveTy AnyType) tys tym' <- traverse (resolveTy NoSumType) tym pure (Parenthesized tys' tym' x) instance (Typeable a, Monoid a) => Resolve (PathParameters a) where resolveM = resolvePathParameters -- | A QSelf by itself is only invalid when the underlying type is resolveQSelf :: (Typeable a, Monoid a) => QSelf a -> ResolveM (QSelf a) resolveQSelf q@(QSelf t p) = scope q (QSelf <$> resolveTy AnyType t <*> pure p) instance (Typeable a, Monoid a) => Resolve (QSelf a) where resolveM = resolveQSelf ----------- -- Types -- ----------- -- | A lifetime can only be invalid if the underlying identifier is. Note that lifetimes cannot use -- keywords. resolveLifetime :: Typeable a => Lifetime a -> ResolveM (Lifetime a) resolveLifetime l@(Lifetime n _) | n == "static" = pure l | n == "_" = pure l | otherwise = scope l (resolveIdent (mkIdent n) *> pure l) instance Typeable a => Resolve (Lifetime a) where resolveM = resolveLifetime -- | A trait ref is invalid if the underlying type path is. resolveTraitRef :: (Typeable a, Monoid a) => TraitRef a -> ResolveM (TraitRef a) resolveTraitRef t@(TraitRef p) = scope t (TraitRef <$> resolvePath TypePath p) instance (Typeable a, Monoid a) => Resolve (TraitRef a) where resolveM = resolveTraitRef -- | There a a variety of constraints imposed on types, representing different invariants data TyType = AnyType -- ^ No restrictions | NoSumType -- ^ Any type except for 'TraitObject' with a '+' | PrimParenType -- ^ Types not starting with '<' or '(', or paren types with no sum types inside | NoForType -- ^ Non-sum types not starting with a 'for' -- | Resolve a given type, and a constraint on it (see the parser 'Internal.y' for more details on -- these cases). resolveTy :: (Typeable a, Monoid a) => TyType -> Ty a -> ResolveM (Ty a) -- TraitObject resolveTy NoSumType o@(TraitObject b _) | length b > 1 = scope o (correct "added parens around trait object type" *> resolveTy NoSumType (ParenTy o mempty)) resolveTy NoForType o@TraitObject{} = scope o (correct "added parens around trait object type" *> resolveTy NoForType (ParenTy o mempty)) resolveTy _ o@(TraitObject bds@(NonEmpty (TraitTyParamBound{} N2.:| _)) x) = scope o (TraitObject <$> traverse (resolveTyParamBound ModBound) bds <*> pure x) resolveTy _ o@TraitObject{} = scope o (err o "first bound in trait object should be a trait bound") -- ParenTy resolveTy PrimParenType p@(ParenTy ty' x) = scope p (ParenTy <$> resolveTy NoSumType ty' <*> pure x) resolveTy _ p@(ParenTy ty' x) = scope p (ParenTy <$> resolveTy AnyType ty' <*> pure x) -- TupTy resolveTy PrimParenType t@TupTy{} = scope t (correct "added parens around tuple type" *> resolveTy PrimParenType (ParenTy t mempty)) resolveTy _ t@(TupTy tys x) = scope t (TupTy <$> traverse (resolveTy AnyType) tys <*> pure x) -- ImplTrait resolveTy _ i@(ImplTrait bds x) = scope i (ImplTrait <$> traverse (resolveTyParamBound ModBound) bds <*> pure x) -- PathTy resolveTy PrimParenType p@(PathTy (Just _) _ _) = scope p (correct "added parents around path type" *> resolveTy PrimParenType (ParenTy p mempty)) resolveTy _ p@(PathTy q p'@(Path _ s _) x) = scope p $ case q of Just (QSelf _ i) | 0 <= i && i < length s -> PathTy <$> traverse resolveQSelf q <*> resolvePath TypePath p' <*> pure x | otherwise -> err p "index given by QSelf is outside the possible range" Nothing -> PathTy Nothing <$> resolvePath TypePath p' <*> pure x -- BareFn resolveTy NoForType f@(BareFn _ _ (_:_) _ _) = scope f (correct "added parens around `for' function type" *> resolveTy NoForType (ParenTy f mempty)) resolveTy _ f@(BareFn u a lts fd x) = scope f (BareFn u a <$> traverse resolveLifetimeDef lts <*> resolveFnDecl declTy GeneralArg fd <*> pure x) where declTy = if a == C then VarNoSelf else NoSelf -- Other types (don't care about the context) resolveTy _ (Never x) = pure (Never x) resolveTy _ p@(Ptr mut ty' x) = scope p (Ptr mut <$> resolveTy NoSumType ty' <*> pure x) resolveTy _ r@(Rptr lt mut ty' x) = scope r (Rptr <$> traverse resolveLifetime lt <*> pure mut <*> resolveTy NoSumType ty' <*> pure x) resolveTy _ t@(Typeof e x) = scope t (Typeof <$> resolveExpr AnyExpr e <*> pure x) resolveTy _ (Infer x) = pure (Infer x) resolveTy _ s@(Slice ty' x) = scope s (Slice <$> resolveTy AnyType ty' <*> pure x) resolveTy _ a@(Array ty' e x) = scope a (Array <$> resolveTy AnyType ty' <*> resolveExpr AnyExpr e <*> pure x) resolveTy _ m@(MacTy (Mac p t x) x') = scope m $ do p' <- resolvePath TypePath p MacTy <$> resolveMac TypePath (Mac p' t x) <*> pure x' instance (Typeable a, Monoid a) => Resolve (Ty a) where resolveM = resolveTy AnyType -- In some cases, the first argument of a function declaration may be a 'self' data FnDeclType = NoSelf -- ^ the first argument cannot be self | VarNoSelf -- ^ the first argument cannot be self, and the function can be variadic | AllowSelf -- ^ the first argument can be self deriving (Eq) -- | A function declaration can be invalid if it has self arguments in the wrong places (or when it -- shouldn't) resolveFnDecl :: (Typeable a, Monoid a) => FnDeclType -> ArgType -> FnDecl a -> ResolveM (FnDecl a) resolveFnDecl fn _ f@(FnDecl (s : _) _ _ _) | isSelfArg s && fn /= AllowSelf = scope f (err f "self argument is not allowed in this function declaration") resolveFnDecl _ _ f@(FnDecl (_ : as) _ _ _) | any isSelfArg as = scope f (err f "self arguments must always be the first arguments") resolveFnDecl fn _ f@(FnDecl _ _ True _) | fn /= VarNoSelf = scope f (err f "this function declaration cannot be variadic") resolveFnDecl _ at f@(FnDecl as o v x) = scope f (FnDecl <$> traverse (resolveArg at) as <*> traverse (resolveTy AnyType) o <*> pure v <*> pure x) -- | Check whether an argument is one of the "self" forms isSelfArg :: Arg a -> Bool isSelfArg Arg{} = False isSelfArg _ = True instance (Typeable a, Monoid a) => Resolve (FnDecl a) where resolveM = resolveFnDecl AllowSelf NamedArg -- | Only some type parameter bounds allow trait bounds to start with ? data TyParamBoundType = NoneBound -- ^ Don't allow '? poly_trait_ref' | ModBound -- ^ Allow '? poly_trait_ref' -- | A type parameter bound is invalid if -- -- * an underlying lifetime or traitref is -- * it is 'NoneBound' but is a trait bound with a '?' (as in 'ObjectTrait') -- resolveTyParamBound :: (Typeable a, Monoid a) => TyParamBoundType -> TyParamBound a -> ResolveM (TyParamBound a) resolveTyParamBound _ b@(RegionTyParamBound lt x) = scope b (RegionTyParamBound <$> resolveLifetime lt <*> pure x) resolveTyParamBound NoneBound b@(TraitTyParamBound _ Maybe _) = scope b (err b "? trait is not allowed in this type param bound") resolveTyParamBound _ b@(TraitTyParamBound p t x) = scope b (TraitTyParamBound <$> resolvePolyTraitRef p <*> pure t <*> pure x) instance (Typeable a, Monoid a) => Resolve (TyParamBound a) where resolveM = resolveTyParamBound ModBound -- | There are several restricted forms of arguments allowed data ArgType = GeneralArg -- ^ Arguments allowed in places without implementation (optional limited pattern followed by a type) | NamedArg -- ^ Arguments allowed in most places (any pattern followed by any type) -- This includes lambda arguments -- | The only types of patterns supported by arguments are wild or identifiers resolveArg :: (Typeable a, Monoid a) => ArgType -> Arg a -> ResolveM (Arg a) resolveArg _ s@SelfValue{} = pure s resolveArg _ a@(SelfRegion lt m x) = scope a (SelfRegion <$> traverse resolveLifetime lt <*> pure m <*> pure x) resolveArg _ a@(SelfExplicit t m x) = scope a (SelfExplicit <$> resolveTy AnyType t <*> pure m <*> pure x) resolveArg NamedArg a@(Arg Nothing _ _) = scope a (err a "named arguments must have patterns") resolveArg NamedArg a@(Arg p t x) = scope a $ do when (isSelfAlike a) $ warn "argument looks like a self argument - did you mean to use 'SelfValue', 'SelfRegion', or 'SelfExplicit'?" p' <- traverse resolvePat p t' <- resolveTy AnyType t pure (Arg p' t' x) resolveArg GeneralArg a@(Arg p t x) = scope a $ do when (isSelfAlike a) $ warn "argument looks like a self argument - did you mean to use 'SelfValue', 'SelfRegion', or 'SelfExplicit'?" p' <- case p of Nothing -> pure Nothing Just WildP{} -> traverse resolvePat p Just IdentP{} -> traverse resolvePat p Just (RefP WildP{} Immutable _) -> traverse resolvePat p Just (RefP (IdentP (ByValue Immutable) _ _ _) Immutable _) -> traverse resolvePat p Just (RefP (RefP WildP{} Immutable _) Immutable _) -> traverse resolvePat p Just (RefP (RefP (IdentP (ByValue Immutable) _ _ _) Immutable _) Immutable _) -> traverse resolvePat p _ -> scope p (err p "this pattern is not allowed for this type of argument") t' <- resolveTy AnyType t pure (Arg p' t' x) -- | Check whether an argument is one of the "self"-alike forms isSelfAlike :: Arg a -> Bool isSelfAlike (Arg Nothing (PathTy Nothing (Path False [PathSegment (Ident (Name "self") False _) Nothing _] _) _) _) = True isSelfAlike (Arg Nothing (Rptr _ _ (PathTy Nothing (Path False [PathSegment (Ident (Name "self") False _) Nothing _] _) _) _) _) = True isSelfAlike _ = False instance (Typeable a, Monoid a) => Resolve (Arg a) where resolveM = resolveArg NamedArg -- | A Poly trait ref is valid whenever the underlying trait ref is. resolvePolyTraitRef :: (Typeable a, Monoid a) => PolyTraitRef a -> ResolveM (PolyTraitRef a) resolvePolyTraitRef p@(PolyTraitRef lts t x) = scope p $ do lts' <- traverse resolveLifetimeDef lts t' <- resolveTraitRef t pure (PolyTraitRef lts' t' x) instance (Typeable a, Monoid a) => Resolve (PolyTraitRef a) where resolveM = resolvePolyTraitRef -- | A lifetime def is invalid if it has non-outer attributes resolveLifetimeDef :: (Typeable a, Monoid a) => LifetimeDef a -> ResolveM (LifetimeDef a) resolveLifetimeDef lts@(LifetimeDef as l bds x) = scope lts $ do as' <- traverse (resolveAttr OuterAttr) as l' <- resolveLifetime l bds' <- traverse resolveLifetime bds pure (LifetimeDef as' l' bds' x) instance (Typeable a, Monoid a) => Resolve (LifetimeDef a) where resolveM = resolveLifetimeDef -------------- -- Patterns -- -------------- -- | A pattern can be invalid of -- -- * the index of the '...' in the tuple/tuple-struct is out of range -- * the index of the qself path is out of range -- * any underlying component is invalid -- resolvePat :: (Typeable a, Monoid a) => Pat a -> ResolveM (Pat a) -- TupleStruct resolvePat t@(TupleStructP p fs im x) = scope t $ do p' <- resolvePath ExprPath p fs' <- traverse resolvePat fs im' <- case im of Nothing -> pure Nothing Just i | 0 <= i && i <= length fs -> pure (Just i) _ -> err im "index of ... in tuple struct pattern is outside of field range" pure (TupleStructP p' fs' im' x) -- PathP resolvePat p@(PathP Nothing a x) = scope p (PathP Nothing <$> resolvePath ExprPath a <*> pure x) resolvePat p@(PathP q@(Just (QSelf _ i)) p'@(Path g s x) x') | i < 0 || i >= length s = scope p (err p "index given by QSelf is outside the possible range") | i == 0 = scope p (PathP <$> traverse resolveQSelf q <*> resolvePath ExprPath p' <*> pure x) | otherwise = scope p $ do Path _ tyPSegs _ <- resolvePath TypePath $ Path g (take i s) mempty Path _ exprPSegs _ <- resolvePath ExprPath $ Path False (drop i s) x q' <- traverse resolveQSelf q pure (PathP q' (Path g (tyPSegs <> exprPSegs) x) x') -- TupleP resolvePat p@(TupleP ps i x) = scope p $ do ps' <- traverse resolvePat ps i' <- case i of Nothing -> pure Nothing Just j | 0 <= j && j <= length ps -> pure i | otherwise -> err i "index of ... in tuple pattern is outside of range" pure (TupleP ps' i' x) -- Everything else... resolvePat p@(LitP e x) = scope p (LitP <$> resolveExpr LitExpr e <*> pure x) resolvePat p@(RangeP l h x) = scope p (RangeP <$> resolveExpr LitOrPathExpr l <*> resolveExpr LitOrPathExpr h <*> pure x) resolvePat p@(WildP x) = scope p (pure (WildP x)) resolvePat p@(IdentP m i p' x) = scope p (IdentP m <$> resolveIdent i <*> traverse resolvePat p' <*> pure x) resolvePat p@(StructP p' fs b x) = scope p (StructP <$> resolvePath ExprPath p' <*> traverse resolveFieldPat fs <*> pure b <*> pure x) resolvePat p@(BoxP p' x) = scope p (BoxP <$> resolvePat p' <*> pure x) resolvePat p@(RefP p' m x) = scope p (RefP <$> resolvePat p' <*> pure m <*> pure x) resolvePat p@(SliceP b m a x) = scope p (SliceP <$> traverse resolvePat b <*> traverse resolvePat m <*> traverse resolvePat a <*> pure x) resolvePat p@(MacP m x) = scope p (MacP <$> resolveMac ExprPath m <*> pure x) instance (Typeable a, Monoid a) => Resolve (Pat a) where resolveM = resolvePat -- | Field patterns are only invalid if the underlying pattern / identifier is resolveFieldPat :: (Typeable a, Monoid a) => FieldPat a -> ResolveM (FieldPat a) resolveFieldPat f@(FieldPat Nothing p x) = scope f $ case p of (IdentP _ _ Nothing _) -> FieldPat Nothing <$> resolvePat p <*> pure x (BoxP (IdentP _ _ Nothing _) _) -> FieldPat Nothing <$> resolvePat p <*> pure x _ -> err f "patterns for fields without an identifier must be (possibly box) identifiers" resolveFieldPat f@(FieldPat i p x) = scope f (FieldPat <$> traverse resolveIdent i <*> resolvePat p <*> pure x) instance (Typeable a, Monoid a) => Resolve (FieldPat a) where resolveM = resolveFieldPat ----------------- -- Expressions -- ----------------- -- Invariants on expressions data ExprType = AnyExpr -- ^ Any expression, no restrictions | LitExpr -- ^ Either an immediate literal, or a negated literal | LitOrPathExpr -- ^ A literal, negated literal, expression path, or qualified expression path | NoStructExpr -- ^ No struct literals are allowed | NoStructBlockExpr -- ^ No struct literals or block expressions (block-like things like 'if' are fine) | SemiExpr -- ^ Forbids expressions starting with blocks (things like '{ 1 } + 2') unless -- the leading block has a postfix expression, allows expressions that are -- just one big block. Forbids '{ 1 }[0]' since it is treated as '{ 1 }; [0]' -- and '{ 1 }(0)' since it is treated as '{ 1 }; (0)' {- -- Check if an expression has the form of a "postfix" (if that's the case, then you don't worry -- about what is inside). -- -- ie: `if i[0] == j[0] { i } else { j } [1]` lhsSemiExpr :: (Typeable a, Monoid a) => Int -> Expr a -> ResolveM (Expr a) lhsSemiExpr p t@(Try _ e _) = resolveExprP p AnyExpr lhsSemiExpr p (FieldAccess _ e _ _) | isBlockLike e = lhsSemiExpr p (Try _ e _) lhsSemiExpr p (Try _ e _) -} resolveLhsExprP :: (Typeable a, Monoid a) => Int -> ExprType -> Expr a -> ResolveM (Expr a) resolveLhsExprP p SemiExpr l@Try{} = resolveExprP p AnyExpr l resolveLhsExprP p SemiExpr l@FieldAccess{} = resolveExprP p AnyExpr l resolveLhsExprP p SemiExpr l@MethodCall{} = resolveExprP p AnyExpr l resolveLhsExprP p SemiExpr l@TupField{} = resolveExprP p AnyExpr l resolveLhsExprP _ SemiExpr l | isBlockLike l = parenthesize l resolveLhsExprP p t l = resolveExprP p (lhs t) l where -- | Given the type of expression, what type of expression is allowed on the LHS lhs :: ExprType -> ExprType lhs LitExpr = error "literal expressions never have a left hand side" lhs LitOrPathExpr = error "literal or path expressions never have a left hand side" lhs AnyExpr = AnyExpr lhs NoStructExpr = NoStructExpr lhs NoStructBlockExpr = NoStructBlockExpr lhs SemiExpr = AnyExpr -- | Given the type of expression, what type of expression is allowed on the RHS rhs :: ExprType -> ExprType rhs LitExpr = error "literal expressions never have a right hand side" rhs LitOrPathExpr = error "literal or path expressions never have a right hand side" rhs AnyExpr = AnyExpr rhs NoStructExpr = NoStructExpr rhs NoStructBlockExpr = NoStructExpr rhs SemiExpr = AnyExpr -- | Given the type of expression, what type of expression is allowed on the RHS (after '..'/'...') rhs2 :: ExprType -> ExprType rhs2 LitExpr = error "literal expressions never have a right hand side (2)" rhs2 LitOrPathExpr = error "literal or path expressions never have a right hand side (2)" rhs2 AnyExpr = AnyExpr rhs2 NoStructExpr = NoStructBlockExpr rhs2 NoStructBlockExpr = NoStructBlockExpr rhs2 SemiExpr = AnyExpr -- | Resolve an expression of the given type in a general context resolveExpr :: (Typeable a, Monoid a) => ExprType -> Expr a -> ResolveM (Expr a) resolveExpr = resolveExprP 0 instance (Typeable a, Monoid a) => Resolve (Expr a) where resolveM = resolveExpr AnyExpr parenthesize :: (Typeable a, Monoid a) => Expr a -> ResolveM (Expr a) parenthesize e = do correct "added parens around expression" e' <- resolveExprP 0 AnyExpr e pure (ParenExpr [] e' mempty) {- Precedences (from 'Internal.y') =============================== 0 %nonassoc box return break continue LAMBDA 1 %right '=' '>>=' '<<=' '-=' '+=' '*=' '/=' '^=' '|=' '&=' '%=' 2 %right '<-' %nonassoc SINGLERNG -- '..' 3 %nonassoc INFIXRNG -- e1 '..' e2 4 %nonassoc POSTFIXRNG -- e1 '..' 5 %nonassoc PREFIXRNG -- '..' e2 6 %left '||' 7 %left '&&' 8 %left '==' '!=' '<' '>' '<=' '>=' 9 %left '|' 10 %left '^' 11 %left '&' 12 %left '<<' '>>' 13 %left '+' '-' 14 %left '*' '/' '%' 15 %left ':' as 16 %nonassoc UNARY -- 'UNARY' is introduced here for '*', '!', '-', '&' 17 %nonassoc POSTFIX -- 'POSTFIX' is introduced here for things like '?' -} -- | This has a double role: to resolve the expression and keep track of precedences resolveExprP :: (Typeable a, Monoid a) => Int -> ExprType -> Expr a -> ResolveM (Expr a) -- Cover the 'LitExpr' type of expression resolveExprP p LitExpr l@Lit{} = resolveExprP p AnyExpr l resolveExprP p LitExpr n@(Unary _ Neg Lit{} _) = resolveExprP p AnyExpr n resolveExprP _ LitExpr l = scope l (err l "expression is not literal or negated literal") -- Cover the 'LitOrPathExpr' type of expression resolveExprP p LitOrPathExpr l@Lit{} = resolveExprP p AnyExpr l resolveExprP p LitOrPathExpr n@(Unary _ Neg Lit{} _) = resolveExprP p AnyExpr n resolveExprP p LitOrPathExpr p'@PathExpr{} = resolveExprP p AnyExpr p' resolveExprP _ LitOrPathExpr l = scope l (err l "expression is not literal, negated literal, path, or qualified path") -- The following group of expression variants work in all of the remaining contexts (see -- 'gen_expression' in the parser) resolveExprP p c b@(Box as e x) = scope b $ parenE (p > 0) $ do as' <- traverse (resolveAttr OuterAttr) as e' <- resolveExprP 0 (rhs c) e pure (Box as' e' x) resolveExprP p c r@(Ret as me x) = scope r $ parenE (p > 0) $ do as' <- traverse (resolveAttr OuterAttr) as me' <- traverse (resolveExprP 0 (rhs c)) me pure (Ret as' me' x) resolveExprP p c r@(Yield as me x) = scope r $ parenE (p > 0) $ do as' <- traverse (resolveAttr OuterAttr) as me' <- traverse (resolveExprP 0 (rhs c)) me pure (Yield as' me' x) resolveExprP p c b@(Break as ml me x) = scope b $ parenE (p > 0) $ do as' <- traverse (resolveAttr OuterAttr) as ml' <- traverse resolveLbl ml me' <- traverse (resolveExprP 0 (rhs c)) me pure (Break as' ml' me' x) resolveExprP p _ c@(Continue as ml x) = scope c $ parenE (p > 0) $ do as' <- traverse (resolveAttr OuterAttr) as ml' <- traverse resolveLbl ml pure (Continue as' ml' x) -- Closures resolveExprP _ _ c@(Closure _ _ _ (FnDecl _ _ True _) _ _) = scope c (err c "closures can never be variadic") resolveExprP p c e@(Closure as m cb fn@(FnDecl _ ret _ _) b x) = scope c $ case (c, ret, b) of (NoStructExpr, Just _, BlockExpr{}) -> parenthesize e (NoStructBlockExpr, Just _, BlockExpr{}) -> parenthesize e (NoStructExpr, Just _, _ ) -> parenthesize (Closure as m cb fn (asBlock b) x) (NoStructBlockExpr, Just _, _ ) -> parenthesize (Closure as m cb fn (asBlock b) x) (_, Just _, BlockExpr{}) -> resolved AnyExpr (_, Just _, _ ) -> parenthesize (Closure as m cb fn (asBlock b) x) _ -> resolved (rhs c) where asBlock ex = BlockExpr [] (Block [NoSemi ex mempty] Normal mempty) mempty resolved c' = parenE (p > 0) $ do as' <- traverse (resolveAttr OuterAttr) as fn' <- resolveFnDecl NoSelf NamedArg fn b' <- resolveExprP 0 c' b pure (Closure as' m cb fn' b' x) -- Assignment/in-place expressions resolveExprP p c a@(Assign as l r x) = scope a $ parenE (p > 1) $ do as' <- traverse (resolveAttr OuterAttr) as --l' <- resolveExprP 2 (lhs c) l l' <- resolveLhsExprP 2 c l r' <- resolveExprP 1 (rhs c) r pure (Assign as' l' r' x) resolveExprP p c a@(AssignOp as o l r x) = scope a $ parenE (p > 1) $ do as' <- traverse (resolveAttr OuterAttr) as --l' <- resolveExprP 2 (lhs c) l l' <- resolveLhsExprP 2 c l r' <- resolveExprP 1 (rhs c) r pure (AssignOp as' o l' r' x) resolveExprP p c i@(InPlace as l r x) = scope i $ parenE (p > 2) $ do as' <- traverse (resolveAttr OuterAttr) as --l' <- resolveExprP 3 (lhs c) l l' <- resolveLhsExprP 3 c l r' <- resolveExprP 2 (rhs c) r pure (InPlace as' l' r' x) -- Range expressions resolveExprP _ _ r@(Range _ _ Nothing Closed _) = scope r (err r "inclusive ranges must be bounded at the end") resolveExprP _ _ r@(Range as Nothing Nothing rl x) = scope r $ do as' <- traverse (resolveAttr OuterAttr) as pure (Range as' Nothing Nothing rl x) resolveExprP p c a@(Range as (Just l) (Just r) rl x) = scope a $ parenE (p > 3) $ do as' <- traverse (resolveAttr OuterAttr) as -- l' <- resolveExprP 4 (lhs c) l l' <- resolveLhsExprP 4 c l r' <- resolveExprP 4 (rhs2 c) r pure (Range as' (Just l') (Just r') rl x) resolveExprP p c r@(Range as (Just l) Nothing rl x) = scope r $ parenE (p > 4) $ do as' <- traverse (resolveAttr OuterAttr) as -- l' <- resolveExprP 4 (lhs c) l l' <- resolveLhsExprP 4 c l pure (Range as' (Just l') Nothing rl x) resolveExprP p c a@(Range as Nothing (Just r) rl x) = scope a $ parenE (p > 5) $ do as' <- traverse (resolveAttr OuterAttr) as r' <- resolveExprP 5 (rhs2 c) r pure (Range as' Nothing (Just r') rl x) -- Binary expressions resolveExprP p c b@(Binary as o l r x) = scope b $ parenE (p > p') $ do as' <- traverse (resolveAttr OuterAttr) as -- l' <- resolveExprP p' (lhs c) l l' <- resolveLhsExprP p' c l r' <- resolveExprP (p' + 1) (rhs c) r pure (Binary as' o l' r' x) where p' = opPrec o opPrec :: BinOp -> Int opPrec AddOp = 13 opPrec SubOp = 13 opPrec MulOp = 14 opPrec DivOp = 14 opPrec RemOp = 14 opPrec AndOp = 7 opPrec OrOp = 6 opPrec BitXorOp = 10 opPrec BitAndOp = 11 opPrec BitOrOp = 9 opPrec ShlOp = 12 opPrec ShrOp = 12 opPrec EqOp = 8 opPrec LtOp = 8 opPrec LeOp = 8 opPrec NeOp = 8 opPrec GeOp = 8 opPrec GtOp = 8 -- Cast and type ascriptions expressions resolveExprP p c a@(Cast as e t x) = scope a $ parenE (p > 15) $ do as' <- traverse (resolveAttr OuterAttr) as --e' <- resolveExprP 15 (lhs c) e e' <- resolveLhsExprP 15 c e t' <- resolveTy NoSumType t pure (Cast as' e' t' x) resolveExprP p c a@(TypeAscription as e t x) = scope a $ parenE (p > 15) $ do as' <- traverse (resolveAttr OuterAttr) as --e' <- resolveExprP 15 (lhs c) e e' <- resolveLhsExprP 15 c e t' <- resolveTy NoSumType t pure (TypeAscription as' e' t' x) -- Unary expressions resolveExprP p c u@(Unary as o e x) = scope u $ parenE (p > 16) $ do as' <- traverse (resolveAttr OuterAttr) as e' <- resolveExprP 16 (rhs c) e pure (Unary as' o e' x) resolveExprP p c a@(AddrOf as m e x) = scope a $ parenE (p > 16) $ do as' <- traverse (resolveAttr OuterAttr) as e' <- resolveExprP 16 (rhs c) e pure (AddrOf as' m e' x) -- Postfix expressions resolveExprP p c a@(Index as e i x) = scope a $ parenE (p > 17) $ do as' <- traverse (resolveAttr OuterAttr) as --e' <- resolveExprP 17 (lhs c) e e' <- resolveLhsExprP 17 c e i' <- resolveExprP 0 AnyExpr i pure (Index as' e' i' x) resolveExprP p SemiExpr t@Try{} = resolveExprP p AnyExpr t resolveExprP p c t@(Try as e x) = scope t $ parenE (p > 17) $ do as' <- traverse (resolveAttr OuterAttr) as --e' <- resolveExprP 17 (lhs c) e e' <- resolveLhsExprP 17 c e pure (Try as' e' x) resolveExprP p c a@(Call as f xs x) = scope a $ parenE (p > 17) $ do as' <- traverse (resolveAttr OuterAttr) as --f' <- resolveExprP 17 (lhs c) f f' <- resolveLhsExprP 17 c f xs' <- traverse (resolveExprP 0 AnyExpr) xs pure (Call as' f' xs' x) resolveExprP p SemiExpr m@MethodCall{} = resolveExprP p AnyExpr m resolveExprP p c m@(MethodCall as e i mt es x) = scope m $ parenE (p > 17) $ do as' <- traverse (resolveAttr OuterAttr) as --e' <- resolveExprP 17 (lhs c) e e' <- resolveLhsExprP 17 c e i' <- resolveIdent i mt' <- case mt of Just t -> Just <$> traverse (resolveTy AnyType) t Nothing -> pure Nothing es' <- traverse (resolveExprP 0 AnyExpr) es pure (MethodCall as' e' i' mt' es' x) resolveExprP p SemiExpr t@TupField{} = resolveExprP p AnyExpr t resolveExprP p c t@(TupField as e i x) = scope t $ parenE (p > 17) $ do as' <- traverse (resolveAttr OuterAttr) as --e' <- resolveExprP 17 (lhs c) e e' <- resolveLhsExprP 17 c e pure (TupField as' e' i x) resolveExprP p SemiExpr f@FieldAccess{} = resolveExprP p AnyExpr f resolveExprP p c f@(FieldAccess as e i x) = scope f $ parenE (p > 17) $ do as' <- traverse (resolveAttr OuterAttr) as --e' <- resolveExprP 17 (lhs c) e e' <- resolveLhsExprP 17 c e i' <- resolveIdent i pure (FieldAccess as' e' i' x) -- Immediate expressions resolveExprP _ _ v@(Vec as es x) = scope v $ do as' <- traverse (resolveAttr EitherAttr) as es' <- traverse (resolveExprP 0 AnyExpr) es pure (Vec as' es' x) resolveExprP _ _ p@(PathExpr as Nothing p' x) = scope p $ do as' <- traverse (resolveAttr OuterAttr) as p'' <- resolvePath ExprPath p' pure (PathExpr as' Nothing p'' x) resolveExprP _ _ p@(PathExpr as q@(Just (QSelf _ i)) p'@(Path g s x) x') | i < 0 || i >= length s = scope p (err p "index given by QSelf is outside the possible range") | i == 0 = scope p $ do as' <- traverse (resolveAttr OuterAttr) as q' <- traverse resolveQSelf q p'' <- resolvePath ExprPath p' pure (PathExpr as' q' p'' x) | otherwise = scope p $ do as' <- traverse (resolveAttr OuterAttr) as Path _ tyPSegs _ <- resolvePath TypePath $ Path g (take i s) mempty Path _ exprPSegs _ <- resolvePath ExprPath $ Path False (drop i s) x q' <- traverse resolveQSelf q pure (PathExpr as' q' (Path g (tyPSegs <> exprPSegs) x) x') resolveExprP _ _ i@(Lit as l x) = scope i $ do as' <- traverse (resolveAttr OuterAttr) as l' <- resolveLit l pure (Lit as' l' x) resolveExprP _ _ a@(Repeat as e r x) = scope a $ do as' <- traverse (resolveAttr OuterAttr) as e' <- resolveExprP 0 AnyExpr e r' <- resolveExprP 0 AnyExpr r pure (Repeat as' e' r' x) -- Macro expressions resolveExprP _ _ a@(MacExpr as m x) = scope a $ do as' <- traverse (resolveAttr OuterAttr) as m' <- resolveMac ExprPath m pure (MacExpr as' m' x) -- Paren expressions resolveExprP _ _ p@(ParenExpr as e x) = scope p $ do as' <- traverse (resolveAttr EitherAttr) as e' <- resolveExprP 0 AnyExpr e pure (ParenExpr as' e' x) resolveExprP _ _ t@(TupExpr as es x) = scope t $ do as' <- traverse (resolveAttr EitherAttr) as es' <- traverse (resolveExprP 0 AnyExpr) es pure (TupExpr as' es' x) -- Block expressions resolveExprP _ NoStructBlockExpr e@BlockExpr{} = parenthesize e resolveExprP _ _ l@(BlockExpr as b x) = scope l $ do as' <- traverse (resolveAttr EitherAttr) as b' <- resolveBlock b pure (BlockExpr as' b' x) -- Struct expressions resolveExprP _ NoStructExpr e@Struct{} = parenthesize e resolveExprP _ NoStructBlockExpr e@Struct{} = parenthesize e resolveExprP _ _ s@(Struct as p' fs e x) = scope s $ do as' <- traverse (resolveAttr OuterAttr) as p'' <- resolvePath ExprPath p' fs' <- traverse resolveField fs e' <- traverse (resolveExprP 0 AnyExpr) e pure (Struct as' p'' fs' e' x) -- Block-like expressions resolveExprP p c i@(If as e b es x) = scope i $ do as' <- traverse (resolveAttr OuterAttr) as e' <- resolveExprP 0 NoStructExpr e b' <- resolveBlock b es' <- case es of Nothing -> pure Nothing (Just If{}) -> traverse (resolveExprP p c) es (Just IfLet{}) -> traverse (resolveExprP p c) es (Just BlockExpr{}) -> traverse (resolveExprP p c) es (Just e'') -> Just <$> resolveExprP p c (BlockExpr [] (Block [NoSemi e'' mempty] Normal mempty) mempty) pure (If as' e' b' es' x) resolveExprP p c i@(IfLet as p' e b es x) = scope i $ do as' <- traverse (resolveAttr OuterAttr) as p'' <- traverse resolvePat p' e' <- resolveExprP 0 NoStructExpr e b' <- resolveBlock b es' <- case es of Nothing -> pure Nothing (Just If{}) -> traverse (resolveExprP p c) es (Just IfLet{}) -> traverse (resolveExprP p c) es (Just BlockExpr{}) -> traverse (resolveExprP p c) es (Just e'') -> Just <$> resolveExprP p c (BlockExpr [] (Block [NoSemi e'' mempty] Normal mempty) mempty) pure (IfLet as' p'' e' b' es' x) resolveExprP _ _ w@(While as e b l x) = scope w $ do as' <- traverse (resolveAttr EitherAttr) as e' <- resolveExprP 0 NoStructExpr e b' <- resolveBlock b l' <- traverse resolveLbl l pure (While as' e' b' l' x) resolveExprP _ _ w@(WhileLet as p' e b l x) = scope w $ do as' <- traverse (resolveAttr EitherAttr) as p'' <- traverse resolvePat p' e' <- resolveExprP 0 NoStructExpr e b' <- resolveBlock b l' <- traverse resolveLbl l pure (WhileLet as' p'' e' b' l' x) resolveExprP _ _ f@(ForLoop as p' e b l x) = scope f $ do as' <- traverse (resolveAttr EitherAttr) as p'' <- resolvePat p' e' <- resolveExprP 0 NoStructExpr e b' <- resolveBlock b l' <- traverse resolveLbl l pure (ForLoop as' p'' e' b' l' x) resolveExprP _ _ o@(Loop as b l x) = scope o $ do as' <- traverse (resolveAttr EitherAttr) as b' <- resolveBlock b l' <- traverse resolveLbl l pure (Loop as' b' l' x) resolveExprP _ _ m@(Match as e ar x) = scope m $ do as' <- traverse (resolveAttr EitherAttr) as e' <- resolveExprP 0 AnyExpr e ar' <- traverse resolveArm ar pure (Match as' e' ar' x) resolveExprP _ _ c@(Catch as b x) = scope c $ do as' <- traverse (resolveAttr EitherAttr) as b' <- resolveBlock b pure (Catch as' b' x) resolveExprP _ _ e@(EmbeddedExpr as code x) = scope e $ do as' <- traverse (resolveAttr EitherAttr) as pure (EmbeddedExpr as' code x) isBlockLike :: Expr a -> Bool isBlockLike If{} = True isBlockLike IfLet{} = True isBlockLike Loop{} = True isBlockLike ForLoop{} = True isBlockLike While{} = True isBlockLike WhileLet{} = True isBlockLike Match{} = True isBlockLike BlockExpr{} = True isBlockLike _ = False resolveLbl :: Typeable a => Label a -> ResolveM (Label a) resolveLbl l@(Label n _) = scope l (resolveIdent (mkIdent n) *> pure l) -- | Wrap an expression in parens if the condition given holds parenE :: (Typeable a, Monoid a) => Bool -> ResolveM (Expr a) -> ResolveM (Expr a) parenE True e = ParenExpr [] <$> e <*> pure mempty parenE False e = e -- | A field just requires the identifier and expression to be valid resolveField :: (Typeable a, Monoid a) => Field a -> ResolveM (Field a) resolveField f@(Field i e x) = scope f $ do i' <- resolveIdent i e' <- traverse (resolveExpr AnyExpr) e pure (Field i' e' x) instance (Typeable a, Monoid a) => Resolve (Field a) where resolveM = resolveField -- | Arms are invalid only if the underlying consitutents are resolveArm :: (Typeable a, Monoid a) => Arm a -> ResolveM (Arm a) resolveArm a@(Arm as ps g b x) = scope a $ do as' <- traverse (resolveAttr OuterAttr) as ps' <- traverse resolvePat ps g' <- traverse (resolveExpr AnyExpr) g b' <- resolveExpr SemiExpr b pure (Arm as' ps' g' b' x) instance (Typeable a, Monoid a) => Resolve (Arm a) where resolveM = resolveArm ---------------- -- Statements -- ---------------- -- Invariants on statements data StmtType = TermStmt -- ^ require a statement be terminated (so another statement can follow it)? | AnyStmt -- ^ any statement -- | Statements are invalid only when the underlying components are. resolveStmt :: (Typeable a, Monoid a) => StmtType -> Stmt a -> ResolveM (Stmt a) resolveStmt _ l@(Local p t i as x) = scope l $ do p' <- resolvePat p t' <- traverse (resolveTy AnyType) t i' <- traverse (resolveExpr AnyExpr) i as' <- traverse (resolveAttr OuterAttr) as pure (Local p' t' i' as' x) resolveStmt _ s@(ItemStmt i x) = scope s (ItemStmt <$> resolveItem StmtItem i <*> pure x) resolveStmt _ s@(Semi e x) | isBlockLike e = scope s (Semi <$> resolveExpr AnyExpr e <*> pure x) resolveStmt _ s@(Semi e x) = scope s (Semi <$> resolveExpr SemiExpr e <*> pure x) resolveStmt _ n@(NoSemi e x) | isBlockLike e = scope n (NoSemi <$> resolveExpr AnyExpr e <*> pure x) resolveStmt AnyStmt n@(NoSemi e x) = scope n (NoSemi <$> resolveExpr SemiExpr e <*> pure x) resolveStmt TermStmt n@(NoSemi e x) = scope n (NoSemi <$> resolveExpr AnyExpr (BlockExpr [] (Block [NoSemi e mempty] Normal mempty) mempty) <*> pure x) resolveStmt _ a@(MacStmt m s as x) = scope a $ do m' <- resolveMac ExprPath m as' <- traverse (resolveAttr OuterAttr) as pure (MacStmt m' s as' x) instance (Typeable a, Monoid a) => Resolve (Stmt a) where resolveM = resolveStmt AnyStmt -- | A block must a a series of terminated statements ended by one possibly unterminated one resolveBlock :: (Typeable a, Monoid a) => Block a -> ResolveM (Block a) resolveBlock b@(Block [] _ _) = pure b resolveBlock b@(Block (s:ss) r x) = scope b $ do ss' <- traverse (resolveStmt TermStmt) (N.init $ NonEmpty (s N2.:| ss)) s' <- resolveStmt AnyStmt (N.last $ NonEmpty (s N2.:| ss)) pure (Block (ss' ++ [s']) r x) instance (Typeable a, Monoid a) => Resolve (Block a) where resolveM = resolveBlock ----------- -- Items -- ----------- -- Whether the item is a statement item, or a general item data ItemType = StmtItem -- ^ Corresponds to 'stmt_item' - basically limited visbility and no macros | ModItem -- ^ General item resolveVisibility' :: Typeable a => ItemType -> Visibility a -> ResolveM (Visibility a) resolveVisibility' StmtItem PublicV = pure PublicV resolveVisibility' StmtItem InheritedV = pure InheritedV resolveVisibility' StmtItem v = scope v $ err v "statement items can only have public or inherited visibility" resolveVisibility' ModItem v = pure v -- | An item can be invalid if -- -- * it is a macro but has 'StmtItem' restriction -- * it has visibility other than public/inherited but has 'StmtItem' restriction -- * an underlying component is invalid -- resolveItem :: (Typeable a, Monoid a) => ItemType -> Item a -> ResolveM (Item a) resolveItem t e@(ExternCrate as v i r x) = scope e $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i r' <- traverse resolveIdent r pure (ExternCrate as' v' i' r' x) resolveItem t u@(Use as v p x) = scope u $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility' t v p' <- resolveUseTree p pure (Use as' v' p' x) resolveItem t s@(Static as v i t' m e x) = scope s $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i t'' <- resolveTy AnyType t' e' <- resolveExpr AnyExpr e pure (Static as' v' i' t'' m e' x) resolveItem t c@(ConstItem as v i t' e x) = scope c $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i t'' <- resolveTy AnyType t' e' <- resolveExpr AnyExpr e pure (ConstItem as' v' i' t'' e' x) resolveItem t f@(Fn as v i d u c a g b x) = scope f $ do as' <- traverse (resolveAttr EitherAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i d' <- resolveFnDecl NoSelf NamedArg d g' <- resolveGenerics g b' <- resolveBlock b pure (Fn as' v' i' d' u c a g' b' x) resolveItem t m@(Mod as v i (Just is) x) = scope m $ do as' <- traverse (resolveAttr EitherAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i is' <- traverse (resolveItem ModItem) is pure (Mod as' v' i' (Just is') x) resolveItem t m@(Mod as v i Nothing x) = scope m $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i pure (Mod as' v' i' Nothing x) resolveItem t m@(ForeignMod as v a is x) = scope m $ do as' <- traverse (resolveAttr EitherAttr) as v' <- resolveVisibility' t v is' <- traverse (resolveForeignItem a) is pure (ForeignMod as' v' a is' x) resolveItem t a@(TyAlias as v i t' g x) = scope a $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i t'' <- resolveTy AnyType t' g' <- resolveGenerics g pure (TyAlias as' v' i' t'' g' x) resolveItem t e@(Enum as v i vs g x) = scope e $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i vs' <- traverse resolveVariant vs g' <- resolveGenerics g pure (Enum as' v' i' vs' g' x) resolveItem t s@(StructItem as v i vd g x) = scope s $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i vd' <- resolveVariantData vd g' <- resolveGenerics g pure (StructItem as' v' i' vd' g' x) resolveItem t u@(Union as v i vd g x) = scope u $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i vd' <- resolveVariantData vd g' <- resolveGenerics g pure (Union as' v' i' vd' g' x) resolveItem t r@(Trait as v i a u g bd is x) = scope r $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i g' <- resolveGenerics g bd' <- traverse (resolveTyParamBound NoneBound) bd is' <- traverse resolveTraitItem is pure (Trait as' v' i' a u g' bd' is' x) resolveItem t r@(TraitAlias as v i g bd x) = scope r $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility' t v i' <- resolveIdent i g' <- resolveGenerics g bd' <- traverse (resolveTyParamBound NoneBound) bd pure (TraitAlias as' v' i' g' bd' x) resolveItem t i'@(Impl as v d u i g mt t' is x) = scope i' $ do as' <- traverse (resolveAttr EitherAttr) as v' <- resolveVisibility' t v g' <- resolveGenerics g mt' <- traverse resolveTraitRef mt t'' <- case mt of Nothing -> resolveTy PrimParenType t' Just _ -> resolveTy AnyType t' is' <- traverse resolveImplItem is pure (Impl as' v' d u i g' mt' t'' is' x) resolveItem StmtItem m@MacItem{} = scope m (err m "macro items cannot be in statement items") resolveItem _ a@(MacItem as i m x) = scope a $ do as' <- traverse (resolveAttr OuterAttr) as i' <- traverse resolveIdent i m' <- resolveMac ExprPath m pure (MacItem as' i' m' x) resolveItem _ m@(MacroDef as i ts x) = scope m $ do as' <- traverse (resolveAttr OuterAttr) as i' <- resolveIdent i ts' <- resolveTokenStream ts pure (MacroDef as' i' ts' x) instance (Typeable a, Monoid a) => Resolve (Item a) where resolveM = resolveItem ModItem -- | A foreign item is invalid only if any of its underlying constituents are resolveForeignItem :: (Typeable a, Monoid a) => Abi -> ForeignItem a -> ResolveM (ForeignItem a) resolveForeignItem a f@(ForeignFn as v i fn g x) = scope f $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility v i' <- resolveIdent i fn' <- resolveFnDecl (case a of { C -> VarNoSelf; _ -> NoSelf }) NamedArg fn g' <- resolveGenerics g pure (ForeignFn as' v' i' fn' g' x) resolveForeignItem _ f@(ForeignStatic as v i t m x) = scope f $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility v i' <- resolveIdent i t' <- resolveTy AnyType t pure (ForeignStatic as' v' i' t' m x) resolveForeignItem _ f@(ForeignTy as v i x) = scope f $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility v i' <- resolveIdent i pure (ForeignTy as' v' i' x) instance (Typeable a, Monoid a) => Resolve (ForeignItem a) where resolveM = resolveForeignItem C -- | A where clause is valid only if the underlying predicates are resolveWhereClause :: (Typeable a, Monoid a) => WhereClause a -> ResolveM (WhereClause a) resolveWhereClause w@(WhereClause p x) = scope w (WhereClause <$> traverse resolveWherePredicate p <*> pure x) instance (Typeable a, Monoid a) => Resolve (WhereClause a) where resolveM = resolveWhereClause -- | Generics are only invalid if the underlying lifetimes or type parameters are resolveGenerics :: (Typeable a, Monoid a) => Generics a -> ResolveM (Generics a) resolveGenerics g@(Generics lts typ wc x) = scope g $ do lts' <- traverse resolveLifetimeDef lts typ' <- traverse resolveTyParam typ wc' <- resolveWhereClause wc pure (Generics lts' typ' wc' x) instance (Typeable a, Monoid a) => Resolve (Generics a) where resolveM = resolveGenerics -- | A type parameter is invalid only when the underlying components are resolveTyParam :: (Typeable a, Monoid a) => TyParam a -> ResolveM (TyParam a) resolveTyParam p@(TyParam as i bds t x) = scope p $ do as' <- traverse (resolveAttr OuterAttr) as i' <- resolveIdent i bds' <- traverse (resolveTyParamBound ModBound) bds t' <- traverse (resolveTy AnyType) t pure (TyParam as' i' bds' t' x) instance (Typeable a, Monoid a) => Resolve (TyParam a) where resolveM = resolveTyParam -- Invariants for struct fields data StructFieldType = IdentStructField -- ^ struct style field | BareStructField -- ^ tuple-struct style field -- | A variant is valid if the underlying components are resolveVariant :: (Typeable a, Monoid a) => Variant a -> ResolveM (Variant a) resolveVariant v@(Variant i as n e x) = scope v $ do i' <- resolveIdent i as' <- traverse (resolveAttr OuterAttr) as n' <- resolveVariantData n e' <- traverse (resolveExpr AnyExpr) e pure (Variant i' as' n' e' x) instance (Typeable a, Monoid a) => Resolve (Variant a) where resolveM = resolveVariant -- | A variant data is valid if the underlying components are resolveVariantData :: (Typeable a, Monoid a) => VariantData a -> ResolveM (VariantData a) resolveVariantData v@(StructD fs x) = scope v (StructD <$> traverse (resolveStructField IdentStructField) fs <*> pure x) resolveVariantData v@(TupleD fs x) = scope v (TupleD <$> traverse (resolveStructField BareStructField) fs <*> pure x) resolveVariantData (UnitD x) = pure (UnitD x) instance (Typeable a, Monoid a) => Resolve (VariantData a) where resolveM = resolveVariantData -- | A struct field is invalid if -- -- * it has the invariant that it needs an identifier, but it doesn't have one -- * it has the invariant that should not have an identifier, but it doe have one -- * any of the underlying components are invalid -- resolveStructField :: (Typeable a, Monoid a) => StructFieldType -> StructField a -> ResolveM (StructField a) resolveStructField IdentStructField s@(StructField Nothing _ _ _ _) = scope s $ err s "struct field needs an identifier" resolveStructField IdentStructField s@(StructField (Just i) v t as x) = scope s $ do i' <- resolveIdent i v' <- resolveVisibility v t' <- resolveTy AnyType t as' <- traverse (resolveAttr OuterAttr) as pure (StructField (Just i') v' t' as' x) resolveStructField BareStructField s@(StructField (Just _) _ _ _ _) = scope s $ err s "tuple-struct field cannot have an identifier" resolveStructField BareStructField s@(StructField Nothing v t as x) = scope s $ do v' <- resolveVisibility v t' <- resolveTy AnyType t as' <- traverse (resolveAttr OuterAttr) as pure (StructField Nothing v' t' as' x) instance (Typeable a, Monoid a) => Resolve (StructField a) where resolveM = resolveStructField IdentStructField -- | A where predicate is invalid only if the underlying lifetimes are resolveWherePredicate :: (Typeable a, Monoid a) => WherePredicate a -> ResolveM (WherePredicate a) resolveWherePredicate p@(EqPredicate t1 t2 x) = scope p (EqPredicate <$> resolveTy NoForType t1 <*> resolveTy AnyType t2 <*> pure x) resolveWherePredicate p@(RegionPredicate l ls x) = scope p $ do l' <- resolveLifetime l ls' <- traverse resolveLifetime ls pure (RegionPredicate l' ls' x) resolveWherePredicate p@(BoundPredicate lts t bds x) = scope p $ do lts' <- traverse resolveLifetimeDef lts t' <- resolveTy NoForType t bds' <- traverse (resolveTyParamBound ModBound) bds pure (BoundPredicate lts' t' bds' x) instance (Typeable a, Monoid a) => Resolve (WherePredicate a) where resolveM = resolveWherePredicate -- | A trait item is valid if the underlying components are resolveTraitItem :: (Typeable a, Monoid a) => TraitItem a -> ResolveM (TraitItem a) resolveTraitItem n@(ConstT as i t e x) = scope n $ do as' <- traverse (resolveAttr OuterAttr) as i' <- resolveIdent i t' <- resolveTy AnyType t e' <- traverse (resolveExpr AnyExpr) e pure (ConstT as' i' t' e' x) resolveTraitItem n@(MethodT as i g m b x) = scope n $ do as' <- traverse (resolveAttr OuterAttr) as i' <- resolveIdent i g' <- resolveGenerics g m' <- resolveMethodSig GeneralArg m b' <- traverse resolveBlock b pure (MethodT as' i' g' m' b' x) resolveTraitItem n@(TypeT as i bd t x) = scope n $ do as' <- traverse (resolveAttr OuterAttr) as i' <- resolveIdent i bd' <- traverse (resolveTyParamBound ModBound) bd t' <- traverse (resolveTy AnyType) t pure (TypeT as' i' bd' t' x) resolveTraitItem n@(MacroT as m x) = scope n $ do as' <- traverse (resolveAttr OuterAttr) as m' <- resolveMac ModPath m pure (MacroT as' m' x) instance (Typeable a, Monoid a) => Resolve (TraitItem a) where resolveM = resolveTraitItem -- | An impl item is valid if the underlying components are resolveImplItem :: (Typeable a, Monoid a) => ImplItem a -> ResolveM (ImplItem a) resolveImplItem n@(ConstI as v d i t e x) = scope n $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility v i' <- resolveIdent i t' <- resolveTy AnyType t e' <- resolveExpr AnyExpr e pure (ConstI as' v' d i' t' e' x) resolveImplItem n@(MethodI as v d i g m b x) = scope n $ do as' <- traverse (resolveAttr EitherAttr) as v' <- resolveVisibility v i' <- resolveIdent i g' <- resolveGenerics g m' <- resolveMethodSig NamedArg m b' <- resolveBlock b pure (MethodI as' v' d i' g' m' b' x) resolveImplItem n@(TypeI as v d i t x) = scope n $ do as' <- traverse (resolveAttr OuterAttr) as v' <- resolveVisibility v i' <- resolveIdent i t' <- resolveTy AnyType t pure (TypeI as' v' d i' t' x) resolveImplItem n@(MacroI as d m x) = scope n $ do as' <- traverse (resolveAttr OuterAttr) as m' <- resolveMac ModPath m pure (MacroI as' d m' x) instance (Typeable a, Monoid a) => Resolve (ImplItem a) where resolveM = resolveImplItem -- | The 'Monoid' constraint is theoretically not necessary - restricted visibility paths are mod paths, -- so they should never have generics. resolveVisibility :: (Typeable a, Monoid a) => Visibility a -> ResolveM (Visibility a) resolveVisibility PublicV = pure PublicV resolveVisibility InheritedV = pure InheritedV resolveVisibility CrateV = pure CrateV resolveVisibility v@(RestrictedV p) = scope v (RestrictedV <$> resolvePath ModPath p) instance (Typeable a, Monoid a) => Resolve (Visibility a) where resolveM = resolveVisibility -- | A method signature is valid if the underlying components are resolveMethodSig :: (Typeable a, Monoid a) => ArgType -> MethodSig a -> ResolveM (MethodSig a) resolveMethodSig at m@(MethodSig u c a f) = scope m (MethodSig u c a <$> resolveFnDecl AllowSelf at f) instance (Typeable a, Monoid a) => Resolve (MethodSig a) where resolveM = resolveMethodSig NamedArg -- | A view path is valid if the underlying components are resolveUseTree :: (Typeable a, Monoid a) => UseTree a -> ResolveM (UseTree a) resolveUseTree v@(UseTreeSimple p i x) = scope v $ do p' <- resolvePath ModPath p i' <- traverse resolveIdent i pure (UseTreeSimple p' i' x) resolveUseTree v@(UseTreeGlob p x) = scope v $ do p' <- resolvePath UsePath p pure (UseTreeGlob p' x) resolveUseTree v@(UseTreeNested p ns x) = scope v $ do p' <- resolvePath UsePath p ns' <- traverse resolveUseTree ns pure (UseTreeNested p' ns' x) instance (Typeable a, Monoid a) => Resolve (UseTree a) where resolveM = resolveUseTree ------------------- -- Macro related -- ------------------- -- | A macro call is only invalid if any of the underlying components are resolveMac :: (Typeable a, Monoid a) => PathType -> Mac a -> ResolveM (Mac a) resolveMac t m@(Mac p ts x) = scope m (Mac <$> resolvePath t p <*> resolveTokenStream ts <*> pure x) instance (Typeable a, Monoid a) => Resolve (Mac a) where resolveM m@(Mac p ts x) = scope m (Mac <$> resolveM p <*> resolveTokenStream ts <*> pure x) -- | A token tree is invalid when -- -- * there is an open or close delim token (those should be balanced and in 'Delimited') -- * the underlying token trees are invalid -- resolveTt :: TokenTree -> ResolveM TokenTree resolveTt t@(Token _ (OpenDelim _)) = scope t (err t "open delimiter is not allowed as a token in a token tree") resolveTt t@(Token _ (CloseDelim _)) = scope t (err t "close delimiter is not allowed as a token in a token tree") resolveTt t@Token{} = pure t resolveTt t@(Delimited s d ts) = scope t (Delimited s d <$> resolveTokenStream ts) instance Resolve TokenTree where resolveM = resolveTt resolveTokenStream :: TokenStream -> ResolveM TokenStream resolveTokenStream s@(Tree tt) = scope s (Tree <$> resolveTt tt) resolveTokenStream s@(Stream ts) = scope s (Stream <$> mapM resolveTokenStream ts) instance Resolve TokenStream where resolveM = resolveTokenStream