diff --git a/Database/HsSqlPpp/Ast/Ast.lhs b/Database/HsSqlPpp/Ast/Ast.lhs --- a/Database/HsSqlPpp/Ast/Ast.lhs +++ b/Database/HsSqlPpp/Ast/Ast.lhs @@ -4,8 +4,12 @@ > {- | This module contains the ast node data types. They are very > permissive, in that they allow a lot of invalid SQL to be -> represented. The type checking process should catch -> all invalid trees, but doesn't quite manage at the moment. -} +> represented. The type checking process should catch all invalid +> trees, but doesn't quite manage at the moment. Sorry about all +> the seemingly pointless type synonyms below, they are an +> artefact of using UUAGC. +> -} + > module Database.HsSqlPpp.Ast.Ast > ( > -- * Main nodes @@ -61,7 +65,7 @@ > ,CaseExpressionListExpressionPairList > ,MaybeExpression > ,MaybeBoolExpression -> ,MaybeTableRef +> ,TableRefList > ,ExpressionListList > ,SelectItemList > ,OnExpr @@ -70,6 +74,8 @@ > ,ExpressionStatementListPair > ,CaseExpressionListExpressionPair > ,CaseExpressionList +> ,ExpressionDirectionPair +> ,ExpressionDirectionPairList > ) where > import Database.HsSqlPpp.AstInternals.AstInternal diff --git a/Database/HsSqlPpp/AstInternals/AstInternal.ag b/Database/HsSqlPpp/AstInternals/AstInternal.ag --- a/Database/HsSqlPpp/AstInternals/AstInternal.ag +++ b/Database/HsSqlPpp/AstInternals/AstInternal.ag @@ -84,7 +84,7 @@ ,SetClauseList ,CaseExpressionListExpressionPairList ,MaybeExpression - ,MaybeTableRef + ,TableRefList ,ExpressionListList ,SelectItemList ,OnExpr @@ -93,6 +93,8 @@ ,ExpressionStatementListPair ,CaseExpressionListExpressionPair ,CaseExpressionList + ,ExpressionDirectionPair + ,ExpressionDirectionPairList ,MaybeBoolExpression -- annotations ,annotateAst @@ -262,12 +264,11 @@ | Select ann:Annotation selDistinct : Distinct selSelectList : SelectList - selTref : MaybeTableRef + selTref : TableRefList selWhere : MaybeBoolExpression selGroupBy : ExpressionList selHaving : MaybeBoolExpression - selOrderBy : ExpressionList - selDir : Direction + selOrderBy : ExpressionDirectionPairList selLimit : MaybeExpression selOffset : MaybeExpression | CombineSelect ann:Annotation @@ -277,7 +278,7 @@ | Values ann:Annotation vll:ExpressionListList -TYPE MaybeTableRef = MAYBE TableRef +TYPE TableRefList = [TableRef] TYPE MaybeExpression = MAYBE Expression TYPE MaybeBoolExpression = MAYBE Expression @@ -537,6 +538,8 @@ TYPE CaseExpressionList = [Expression] TYPE CaseExpressionListExpressionPairList = [CaseExpressionListExpressionPair] TYPE StatementList = [Statement] +TYPE ExpressionDirectionPair = (Expression,Direction) +TYPE ExpressionDirectionPairList = [ExpressionDirectionPair] -- Add a root data type so we can put initial values for inherited -- attributes in the section which defines and uses those attributes @@ -574,7 +577,8 @@ ExpressionStatementListPairList VarDefList SelectItemList RowConstraintList CaseExpressionListExpressionPair CaseExpressionListExpressionPairList CaseExpressionList - MaybeTableRef TableRef OnExpr + TableRefList TableRef OnExpr ExpressionDirectionPair + ExpressionDirectionPairList DERIVING AllNodes: Show,Eq,Typeable,Data diff --git a/Database/HsSqlPpp/AstInternals/AstInternal.hs b/Database/HsSqlPpp/AstInternals/AstInternal.hs --- a/Database/HsSqlPpp/AstInternals/AstInternal.hs +++ b/Database/HsSqlPpp/AstInternals/AstInternal.hs @@ -1,8793 +1,9201 @@ {-# OPTIONS_HADDOCK hide #-} --- UUAGC 0.9.10 (AstInternal.ag) -module Database.HsSqlPpp.AstInternals.AstInternal( - -- {-# LANGUAGE DeriveDataTypeable,RankNTypes,ScopedTypeVariables #-} - -- {-# OPTIONS_HADDOCK hide #-} - --from the ag files: - --ast nodes - Statement (..) - ,SelectExpression (..) - ,FnBody (..) - ,SetClause (..) - ,TableRef (..) - ,JoinExpression (..) - ,JoinType (..) - ,SelectList (..) - ,SelectItem (..) - ,CopySource (..) - ,AttributeDef (..) - ,RowConstraint (..) - ,Constraint (..) - ,TypeAttributeDef (..) - ,ParamDef (..) - ,VarDef (..) - ,RaiseType (..) - ,CombineType (..) - ,Volatility (..) - ,Language (..) - ,TypeName (..) - ,DropType (..) - ,Cascade (..) - ,Direction (..) - ,Distinct (..) - ,Natural (..) - ,IfExists (..) - ,RestartIdentity (..) - ,Expression (..) - ,InList (..) - ,StatementList - ,ExpressionListStatementListPairList - ,ExpressionListStatementListPair - ,ExpressionList - ,StringList - ,ParamDefList - ,AttributeDefList - ,ConstraintList - ,TypeAttributeDefList - ,StringStringListPairList - ,StringStringListPair - ,ExpressionStatementListPairList - ,SetClauseList - ,CaseExpressionListExpressionPairList - ,MaybeExpression - ,MaybeTableRef - ,ExpressionListList - ,SelectItemList - ,OnExpr - ,RowConstraintList - ,VarDefList - ,ExpressionStatementListPair - ,CaseExpressionListExpressionPair - ,CaseExpressionList - ,MaybeBoolExpression - -- annotations - ,annotateAst - ,annotateAstEnv - ,annotateExpression - ,annotateAstsEnv - ,annotateAstEnvEnv -) where - -import Data.Maybe -import Data.List -import Debug.Trace -import Control.Monad.Error -import Control.Arrow -import Data.Either -import Control.Applicative -import Data.Generics - -import Database.HsSqlPpp.AstInternals.TypeType -import Database.HsSqlPpp.AstInternals.TypeConversion -import Database.HsSqlPpp.AstInternals.TypeCheckingH -import Database.HsSqlPpp.AstInternals.AstAnnotation -import Database.HsSqlPpp.AstInternals.EnvironmentInternal -import Database.HsSqlPpp.AstInternals.DefaultTemplate1Environment -import Database.HsSqlPpp.Utils - -{-# LINE 603 "AstInternal.ag" #-} - --- | Takes an ast, and adds annotations, including types, type errors, --- and statement info. Type checks against defaultEnv. -annotateAst :: StatementList -> StatementList -annotateAst = annotateAstEnv defaultTemplate1Environment - - --- | As annotateAst but you supply an environment to check --- against. See Environment module for how to read an Environment from --- an existing database so you can type check against it. -annotateAstEnv :: Environment -> StatementList -> StatementList -annotateAstEnv env sts = - let t = sem_Root (Root sts) - ta = wrap_Root t Inh_Root {env_Inh_Root = env} - tl = annotatedTree_Syn_Root ta - in case tl of - Root r -> r - --- | Type check multiple asts, allowing type checking references in later --- files to definitions in earlier files. -annotateAstsEnv :: Environment -> [StatementList] -> [StatementList] -annotateAstsEnv env sts = - annInt env sts [] - where - annInt e (s:ss) ress = - let (e1,res) = annotateAstEnvEnv e s - in annInt e1 ss (res:ress) - annInt _ [] ress = reverse ress - --- | Type check an ast, and return the resultant Environment as well --- as the annotated ast. -annotateAstEnvEnv :: Environment -> StatementList -> (Environment,StatementList) -annotateAstEnvEnv env sts = - let t = sem_Root (Root sts) - ta = wrap_Root t Inh_Root {env_Inh_Root = env} - tl = annotatedTree_Syn_Root ta - env1 = producedEnv_Syn_Root ta - in case tl of - Root r -> (env1,r) - --- | Testing utility, mainly used to check an expression for type errors --- or to get its type. -annotateExpression :: Environment -> Expression -> Expression -annotateExpression env ex = - let t = sem_ExpressionRoot (ExpressionRoot ex) - rt = (annotatedTree_Syn_ExpressionRoot - (wrap_ExpressionRoot t Inh_ExpressionRoot {env_Inh_ExpressionRoot = env})) - in case rt of - ExpressionRoot e -> e - -{-# LINE 141 "AstInternal.hs" #-} - -{-# LINE 68 "./TypeChecking.ag" #-} - -annTypesAndErrors :: Data a => a -> Type -> [TypeError] - -> Maybe [AnnotationElement] -> a -annTypesAndErrors item nt errs add = - updateAnnotation modifier item - where - modifier = (([TypeAnnotation nt] ++ fromMaybe [] add ++ - map TypeErrorA errs) ++) - -{-# LINE 153 "AstInternal.hs" #-} - -{-# LINE 421 "./TypeChecking.ag" #-} - -getTbCols c = unwrapSetOfComposite (getTypeAnnotation c) -{-# LINE 158 "AstInternal.hs" #-} - -{-# LINE 496 "./TypeChecking.ag" #-} - - -getFnType :: Environment -> String -> Expression -> Either [TypeError] Type -getFnType env alias = - either Left (Right . snd) . getFunIdens env alias - -getFunIdens :: Environment -> String -> Expression -> Either [TypeError] (String,Type) -getFunIdens env alias fnVal = - case fnVal of - FunCall _ f _ -> - let correlationName = if alias /= "" - then alias - else f - in Right (correlationName, case getTypeAnnotation fnVal of - SetOfType (CompositeType t) -> getCompositeType t - SetOfType x -> UnnamedCompositeType [(correlationName,x)] - y -> UnnamedCompositeType [(correlationName,y)]) - x -> Left [ContextError "FunCall"] - where - getCompositeType t = - case getAttrs env [Composite - ,TableComposite - ,ViewComposite] t of - Just (_,_,a@(UnnamedCompositeType _), _) -> a - _ -> UnnamedCompositeType [] -{-# LINE 186 "AstInternal.hs" #-} - -{-# LINE 547 "./TypeChecking.ag" #-} - - -fixStar :: Expression -> Expression -fixStar = - everywhere (mkT fixStar') - where - fixStar' :: Annotation -> Annotation - fixStar' a = - if TypeAnnotation TypeCheckFailed `elem` a - && any (\an -> - case an of - TypeErrorA (UnrecognisedIdentifier x) | - let (_,iden) = splitIdentifier x - in iden == "*" -> True - _ -> False) a - then filter (\an -> case an of - TypeAnnotation TypeCheckFailed -> False - TypeErrorA (UnrecognisedIdentifier _) -> False - _ -> True) a - else a -{-# LINE 209 "AstInternal.hs" #-} - -{-# LINE 633 "./TypeChecking.ag" #-} - -fixedValue :: a -> a -> a -> a -fixedValue a _ _ = a -{-# LINE 215 "AstInternal.hs" #-} - -{-# LINE 667 "./TypeChecking.ag" #-} - -getCAtts t = - case t of - SetOfType (UnnamedCompositeType t) -> t - _ -> [] -{-# LINE 223 "AstInternal.hs" #-} - -{-# LINE 746 "./TypeChecking.ag" #-} - -getRowTypes :: [Type] -> [Type] -getRowTypes [RowCtor ts] = ts -getRowTypes ts = ts -{-# LINE 230 "AstInternal.hs" #-} --- AttributeDef ------------------------------------------------ -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - attrName : String - namedType : Type - alternatives: - alternative AttributeDef: - child ann : {Annotation} - child name : {String} - child typ : TypeName - child def : MaybeExpression - child cons : RowConstraintList - visit 0: - local annotatedTree : _ --} -data AttributeDef = AttributeDef (Annotation) (String) (TypeName) (MaybeExpression) (RowConstraintList) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_AttributeDef :: AttributeDef -> - T_AttributeDef -sem_AttributeDef (AttributeDef _ann _name _typ _def _cons ) = - (sem_AttributeDef_AttributeDef _ann _name (sem_TypeName _typ ) (sem_MaybeExpression _def ) (sem_RowConstraintList _cons ) ) --- semantic domain -type T_AttributeDef = Environment -> - ( AttributeDef,String,Type) -data Inh_AttributeDef = Inh_AttributeDef {env_Inh_AttributeDef :: Environment} -data Syn_AttributeDef = Syn_AttributeDef {annotatedTree_Syn_AttributeDef :: AttributeDef,attrName_Syn_AttributeDef :: String,namedType_Syn_AttributeDef :: Type} -wrap_AttributeDef :: T_AttributeDef -> - Inh_AttributeDef -> - Syn_AttributeDef -wrap_AttributeDef sem (Inh_AttributeDef _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOattrName,_lhsOnamedType) = - (sem _lhsIenv ) - in (Syn_AttributeDef _lhsOannotatedTree _lhsOattrName _lhsOnamedType )) -sem_AttributeDef_AttributeDef :: Annotation -> - String -> - T_TypeName -> - T_MaybeExpression -> - T_RowConstraintList -> - T_AttributeDef -sem_AttributeDef_AttributeDef ann_ name_ typ_ def_ cons_ = - (\ _lhsIenv -> - (let _consOenv :: Environment - _defOenv :: Environment - _typOenv :: Environment - _consIannotatedTree :: RowConstraintList - _defIannotatedTree :: MaybeExpression - _defIexprType :: (Maybe Type) - _typIannotatedTree :: TypeName - _typInamedType :: Type - _lhsOannotatedTree :: AttributeDef - _lhsOattrName :: String - _lhsOnamedType :: Type - -- copy rule (down) - _consOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 292 "AstInternal.hs" #-} - -- copy rule (down) - _defOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 297 "AstInternal.hs" #-} - -- copy rule (down) - _typOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 302 "AstInternal.hs" #-} - ( _consIannotatedTree) = - (cons_ _consOenv ) - ( _defIannotatedTree,_defIexprType) = - (def_ _defOenv ) - ( _typIannotatedTree,_typInamedType) = - (typ_ _typOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - AttributeDef ann_ name_ _typIannotatedTree _defIannotatedTree _consIannotatedTree - {-# LINE 313 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 318 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 784, column 7) - _lhsOattrName = - {-# LINE 784 "./TypeChecking.ag" #-} - name_ - {-# LINE 323 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 785, column 7) - _lhsOnamedType = - {-# LINE 785 "./TypeChecking.ag" #-} - _typInamedType - {-# LINE 328 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOattrName,_lhsOnamedType))) --- AttributeDefList -------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - attrs : [(String, Type)] - alternatives: - alternative Cons: - child hd : AttributeDef - child tl : AttributeDefList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type AttributeDefList = [(AttributeDef)] --- cata -sem_AttributeDefList :: AttributeDefList -> - T_AttributeDefList -sem_AttributeDefList list = - (Prelude.foldr sem_AttributeDefList_Cons sem_AttributeDefList_Nil (Prelude.map sem_AttributeDef list) ) --- semantic domain -type T_AttributeDefList = Environment -> - ( AttributeDefList,([(String, Type)])) -data Inh_AttributeDefList = Inh_AttributeDefList {env_Inh_AttributeDefList :: Environment} -data Syn_AttributeDefList = Syn_AttributeDefList {annotatedTree_Syn_AttributeDefList :: AttributeDefList,attrs_Syn_AttributeDefList :: [(String, Type)]} -wrap_AttributeDefList :: T_AttributeDefList -> - Inh_AttributeDefList -> - Syn_AttributeDefList -wrap_AttributeDefList sem (Inh_AttributeDefList _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOattrs) = - (sem _lhsIenv ) - in (Syn_AttributeDefList _lhsOannotatedTree _lhsOattrs )) -sem_AttributeDefList_Cons :: T_AttributeDef -> - T_AttributeDefList -> - T_AttributeDefList -sem_AttributeDefList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: AttributeDefList - _tlIattrs :: ([(String, Type)]) - _hdIannotatedTree :: AttributeDef - _hdIattrName :: String - _hdInamedType :: Type - _lhsOannotatedTree :: AttributeDefList - _lhsOattrs :: ([(String, Type)]) - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 384 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 389 "AstInternal.hs" #-} - ( _tlIannotatedTree,_tlIattrs) = - (tl_ _tlOenv ) - ( _hdIannotatedTree,_hdIattrName,_hdInamedType) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 398 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 403 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 790, column 12) - _lhsOattrs = - {-# LINE 790 "./TypeChecking.ag" #-} - (_hdIattrName, _hdInamedType) : _tlIattrs - {-# LINE 408 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOattrs))) -sem_AttributeDefList_Nil :: T_AttributeDefList -sem_AttributeDefList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: AttributeDefList - _lhsOattrs :: ([(String, Type)]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 419 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 424 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 791, column 11) - _lhsOattrs = - {-# LINE 791 "./TypeChecking.ag" #-} - [] - {-# LINE 429 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOattrs))) --- Cascade ----------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Cascade: - visit 0: - local annotatedTree : _ - alternative Restrict: - visit 0: - local annotatedTree : _ --} -data Cascade = Cascade - | Restrict - deriving ( Data,Eq,Show,Typeable) --- cata -sem_Cascade :: Cascade -> - T_Cascade -sem_Cascade (Cascade ) = - (sem_Cascade_Cascade ) -sem_Cascade (Restrict ) = - (sem_Cascade_Restrict ) --- semantic domain -type T_Cascade = Environment -> - ( Cascade) -data Inh_Cascade = Inh_Cascade {env_Inh_Cascade :: Environment} -data Syn_Cascade = Syn_Cascade {annotatedTree_Syn_Cascade :: Cascade} -wrap_Cascade :: T_Cascade -> - Inh_Cascade -> - Syn_Cascade -wrap_Cascade sem (Inh_Cascade _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_Cascade _lhsOannotatedTree )) -sem_Cascade_Cascade :: T_Cascade -sem_Cascade_Cascade = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Cascade - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Cascade - {-# LINE 476 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 481 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_Cascade_Restrict :: T_Cascade -sem_Cascade_Restrict = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Cascade - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Restrict - {-# LINE 491 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 496 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- CaseExpressionList ------------------------------------------ -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Cons: - child hd : Expression - child tl : CaseExpressionList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type CaseExpressionList = [(Expression)] --- cata -sem_CaseExpressionList :: CaseExpressionList -> - T_CaseExpressionList -sem_CaseExpressionList list = - (Prelude.foldr sem_CaseExpressionList_Cons sem_CaseExpressionList_Nil (Prelude.map sem_Expression list) ) --- semantic domain -type T_CaseExpressionList = Environment -> - ( CaseExpressionList) -data Inh_CaseExpressionList = Inh_CaseExpressionList {env_Inh_CaseExpressionList :: Environment} -data Syn_CaseExpressionList = Syn_CaseExpressionList {annotatedTree_Syn_CaseExpressionList :: CaseExpressionList} -wrap_CaseExpressionList :: T_CaseExpressionList -> - Inh_CaseExpressionList -> - Syn_CaseExpressionList -wrap_CaseExpressionList sem (Inh_CaseExpressionList _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_CaseExpressionList _lhsOannotatedTree )) -sem_CaseExpressionList_Cons :: T_Expression -> - T_CaseExpressionList -> - T_CaseExpressionList -sem_CaseExpressionList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: CaseExpressionList - _hdIannotatedTree :: Expression - _hdIliftedColumnName :: String - _lhsOannotatedTree :: CaseExpressionList - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 548 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 553 "AstInternal.hs" #-} - ( _tlIannotatedTree) = - (tl_ _tlOenv ) - ( _hdIannotatedTree,_hdIliftedColumnName) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 562 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 567 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_CaseExpressionList_Nil :: T_CaseExpressionList -sem_CaseExpressionList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: CaseExpressionList - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 577 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 582 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- CaseExpressionListExpressionPair ---------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Tuple: - child x1 : CaseExpressionList - child x2 : Expression - visit 0: - local annotatedTree : _ --} -type CaseExpressionListExpressionPair = ( (CaseExpressionList),(Expression)) --- cata -sem_CaseExpressionListExpressionPair :: CaseExpressionListExpressionPair -> - T_CaseExpressionListExpressionPair -sem_CaseExpressionListExpressionPair ( x1,x2) = - (sem_CaseExpressionListExpressionPair_Tuple (sem_CaseExpressionList x1 ) (sem_Expression x2 ) ) --- semantic domain -type T_CaseExpressionListExpressionPair = Environment -> - ( CaseExpressionListExpressionPair) -data Inh_CaseExpressionListExpressionPair = Inh_CaseExpressionListExpressionPair {env_Inh_CaseExpressionListExpressionPair :: Environment} -data Syn_CaseExpressionListExpressionPair = Syn_CaseExpressionListExpressionPair {annotatedTree_Syn_CaseExpressionListExpressionPair :: CaseExpressionListExpressionPair} -wrap_CaseExpressionListExpressionPair :: T_CaseExpressionListExpressionPair -> - Inh_CaseExpressionListExpressionPair -> - Syn_CaseExpressionListExpressionPair -wrap_CaseExpressionListExpressionPair sem (Inh_CaseExpressionListExpressionPair _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_CaseExpressionListExpressionPair _lhsOannotatedTree )) -sem_CaseExpressionListExpressionPair_Tuple :: T_CaseExpressionList -> - T_Expression -> - T_CaseExpressionListExpressionPair -sem_CaseExpressionListExpressionPair_Tuple x1_ x2_ = - (\ _lhsIenv -> - (let _x2Oenv :: Environment - _x1Oenv :: Environment - _x2IannotatedTree :: Expression - _x2IliftedColumnName :: String - _x1IannotatedTree :: CaseExpressionList - _lhsOannotatedTree :: CaseExpressionListExpressionPair - -- copy rule (down) - _x2Oenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 631 "AstInternal.hs" #-} - -- copy rule (down) - _x1Oenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 636 "AstInternal.hs" #-} - ( _x2IannotatedTree,_x2IliftedColumnName) = - (x2_ _x2Oenv ) - ( _x1IannotatedTree) = - (x1_ _x1Oenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (_x1IannotatedTree,_x2IannotatedTree) - {-# LINE 645 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 650 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- CaseExpressionListExpressionPairList ------------------------ -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Cons: - child hd : CaseExpressionListExpressionPair - child tl : CaseExpressionListExpressionPairList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type CaseExpressionListExpressionPairList = [(CaseExpressionListExpressionPair)] --- cata -sem_CaseExpressionListExpressionPairList :: CaseExpressionListExpressionPairList -> - T_CaseExpressionListExpressionPairList -sem_CaseExpressionListExpressionPairList list = - (Prelude.foldr sem_CaseExpressionListExpressionPairList_Cons sem_CaseExpressionListExpressionPairList_Nil (Prelude.map sem_CaseExpressionListExpressionPair list) ) --- semantic domain -type T_CaseExpressionListExpressionPairList = Environment -> - ( CaseExpressionListExpressionPairList) -data Inh_CaseExpressionListExpressionPairList = Inh_CaseExpressionListExpressionPairList {env_Inh_CaseExpressionListExpressionPairList :: Environment} -data Syn_CaseExpressionListExpressionPairList = Syn_CaseExpressionListExpressionPairList {annotatedTree_Syn_CaseExpressionListExpressionPairList :: CaseExpressionListExpressionPairList} -wrap_CaseExpressionListExpressionPairList :: T_CaseExpressionListExpressionPairList -> - Inh_CaseExpressionListExpressionPairList -> - Syn_CaseExpressionListExpressionPairList -wrap_CaseExpressionListExpressionPairList sem (Inh_CaseExpressionListExpressionPairList _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_CaseExpressionListExpressionPairList _lhsOannotatedTree )) -sem_CaseExpressionListExpressionPairList_Cons :: T_CaseExpressionListExpressionPair -> - T_CaseExpressionListExpressionPairList -> - T_CaseExpressionListExpressionPairList -sem_CaseExpressionListExpressionPairList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: CaseExpressionListExpressionPairList - _hdIannotatedTree :: CaseExpressionListExpressionPair - _lhsOannotatedTree :: CaseExpressionListExpressionPairList - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 701 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 706 "AstInternal.hs" #-} - ( _tlIannotatedTree) = - (tl_ _tlOenv ) - ( _hdIannotatedTree) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 715 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 720 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_CaseExpressionListExpressionPairList_Nil :: T_CaseExpressionListExpressionPairList -sem_CaseExpressionListExpressionPairList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: CaseExpressionListExpressionPairList - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 730 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 735 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- CombineType ------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Except: - visit 0: - local annotatedTree : _ - alternative Intersect: - visit 0: - local annotatedTree : _ - alternative Union: - visit 0: - local annotatedTree : _ - alternative UnionAll: - visit 0: - local annotatedTree : _ --} -data CombineType = Except - | Intersect - | Union - | UnionAll - deriving ( Data,Eq,Show,Typeable) --- cata -sem_CombineType :: CombineType -> - T_CombineType -sem_CombineType (Except ) = - (sem_CombineType_Except ) -sem_CombineType (Intersect ) = - (sem_CombineType_Intersect ) -sem_CombineType (Union ) = - (sem_CombineType_Union ) -sem_CombineType (UnionAll ) = - (sem_CombineType_UnionAll ) --- semantic domain -type T_CombineType = Environment -> - ( CombineType) -data Inh_CombineType = Inh_CombineType {env_Inh_CombineType :: Environment} -data Syn_CombineType = Syn_CombineType {annotatedTree_Syn_CombineType :: CombineType} -wrap_CombineType :: T_CombineType -> - Inh_CombineType -> - Syn_CombineType -wrap_CombineType sem (Inh_CombineType _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_CombineType _lhsOannotatedTree )) -sem_CombineType_Except :: T_CombineType -sem_CombineType_Except = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: CombineType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Except - {-# LINE 794 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 799 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_CombineType_Intersect :: T_CombineType -sem_CombineType_Intersect = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: CombineType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Intersect - {-# LINE 809 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 814 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_CombineType_Union :: T_CombineType -sem_CombineType_Union = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: CombineType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Union - {-# LINE 824 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 829 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_CombineType_UnionAll :: T_CombineType -sem_CombineType_UnionAll = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: CombineType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - UnionAll - {-# LINE 839 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 844 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- Constraint -------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative CheckConstraint: - child ann : {Annotation} - child expression : Expression - visit 0: - local annotatedTree : _ - alternative PrimaryKeyConstraint: - child ann : {Annotation} - child stringList : StringList - visit 0: - local annotatedTree : _ - alternative ReferenceConstraint: - child ann : {Annotation} - child atts : StringList - child table : {String} - child tableAtts : StringList - child onUpdate : Cascade - child onDelete : Cascade - visit 0: - local annotatedTree : _ - alternative UniqueConstraint: - child ann : {Annotation} - child stringList : StringList - visit 0: - local annotatedTree : _ --} -data Constraint = CheckConstraint (Annotation) (Expression) - | PrimaryKeyConstraint (Annotation) (StringList) - | ReferenceConstraint (Annotation) (StringList) (String) (StringList) (Cascade) (Cascade) - | UniqueConstraint (Annotation) (StringList) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_Constraint :: Constraint -> - T_Constraint -sem_Constraint (CheckConstraint _ann _expression ) = - (sem_Constraint_CheckConstraint _ann (sem_Expression _expression ) ) -sem_Constraint (PrimaryKeyConstraint _ann _stringList ) = - (sem_Constraint_PrimaryKeyConstraint _ann (sem_StringList _stringList ) ) -sem_Constraint (ReferenceConstraint _ann _atts _table _tableAtts _onUpdate _onDelete ) = - (sem_Constraint_ReferenceConstraint _ann (sem_StringList _atts ) _table (sem_StringList _tableAtts ) (sem_Cascade _onUpdate ) (sem_Cascade _onDelete ) ) -sem_Constraint (UniqueConstraint _ann _stringList ) = - (sem_Constraint_UniqueConstraint _ann (sem_StringList _stringList ) ) --- semantic domain -type T_Constraint = Environment -> - ( Constraint) -data Inh_Constraint = Inh_Constraint {env_Inh_Constraint :: Environment} -data Syn_Constraint = Syn_Constraint {annotatedTree_Syn_Constraint :: Constraint} -wrap_Constraint :: T_Constraint -> - Inh_Constraint -> - Syn_Constraint -wrap_Constraint sem (Inh_Constraint _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_Constraint _lhsOannotatedTree )) -sem_Constraint_CheckConstraint :: Annotation -> - T_Expression -> - T_Constraint -sem_Constraint_CheckConstraint ann_ expression_ = - (\ _lhsIenv -> - (let _expressionOenv :: Environment - _expressionIannotatedTree :: Expression - _expressionIliftedColumnName :: String - _lhsOannotatedTree :: Constraint - -- copy rule (down) - _expressionOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 920 "AstInternal.hs" #-} - ( _expressionIannotatedTree,_expressionIliftedColumnName) = - (expression_ _expressionOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - CheckConstraint ann_ _expressionIannotatedTree - {-# LINE 927 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 932 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_Constraint_PrimaryKeyConstraint :: Annotation -> - T_StringList -> - T_Constraint -sem_Constraint_PrimaryKeyConstraint ann_ stringList_ = - (\ _lhsIenv -> - (let _stringListOenv :: Environment - _stringListIannotatedTree :: StringList - _stringListIstrings :: ([String]) - _lhsOannotatedTree :: Constraint - -- copy rule (down) - _stringListOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 947 "AstInternal.hs" #-} - ( _stringListIannotatedTree,_stringListIstrings) = - (stringList_ _stringListOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - PrimaryKeyConstraint ann_ _stringListIannotatedTree - {-# LINE 954 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 959 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_Constraint_ReferenceConstraint :: Annotation -> - T_StringList -> - String -> - T_StringList -> - T_Cascade -> - T_Cascade -> - T_Constraint -sem_Constraint_ReferenceConstraint ann_ atts_ table_ tableAtts_ onUpdate_ onDelete_ = - (\ _lhsIenv -> - (let _onDeleteOenv :: Environment - _onDeleteIannotatedTree :: Cascade - _onUpdateOenv :: Environment - _onUpdateIannotatedTree :: Cascade - _tableAttsOenv :: Environment - _tableAttsIannotatedTree :: StringList - _tableAttsIstrings :: ([String]) - _attsOenv :: Environment - _attsIannotatedTree :: StringList - _attsIstrings :: ([String]) - _lhsOannotatedTree :: Constraint - -- copy rule (down) - _onDeleteOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 985 "AstInternal.hs" #-} - ( _onDeleteIannotatedTree) = - (onDelete_ _onDeleteOenv ) - -- copy rule (down) - _onUpdateOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 992 "AstInternal.hs" #-} - ( _onUpdateIannotatedTree) = - (onUpdate_ _onUpdateOenv ) - -- copy rule (down) - _tableAttsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 999 "AstInternal.hs" #-} - ( _tableAttsIannotatedTree,_tableAttsIstrings) = - (tableAtts_ _tableAttsOenv ) - -- copy rule (down) - _attsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1006 "AstInternal.hs" #-} - ( _attsIannotatedTree,_attsIstrings) = - (atts_ _attsOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - ReferenceConstraint ann_ _attsIannotatedTree table_ _tableAttsIannotatedTree _onUpdateIannotatedTree _onDeleteIannotatedTree - {-# LINE 1013 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1018 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_Constraint_UniqueConstraint :: Annotation -> - T_StringList -> - T_Constraint -sem_Constraint_UniqueConstraint ann_ stringList_ = - (\ _lhsIenv -> - (let _stringListOenv :: Environment - _stringListIannotatedTree :: StringList - _stringListIstrings :: ([String]) - _lhsOannotatedTree :: Constraint - -- copy rule (down) - _stringListOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1033 "AstInternal.hs" #-} - ( _stringListIannotatedTree,_stringListIstrings) = - (stringList_ _stringListOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - UniqueConstraint ann_ _stringListIannotatedTree - {-# LINE 1040 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1045 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- ConstraintList ---------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Cons: - child hd : Constraint - child tl : ConstraintList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type ConstraintList = [(Constraint)] --- cata -sem_ConstraintList :: ConstraintList -> - T_ConstraintList -sem_ConstraintList list = - (Prelude.foldr sem_ConstraintList_Cons sem_ConstraintList_Nil (Prelude.map sem_Constraint list) ) --- semantic domain -type T_ConstraintList = Environment -> - ( ConstraintList) -data Inh_ConstraintList = Inh_ConstraintList {env_Inh_ConstraintList :: Environment} -data Syn_ConstraintList = Syn_ConstraintList {annotatedTree_Syn_ConstraintList :: ConstraintList} -wrap_ConstraintList :: T_ConstraintList -> - Inh_ConstraintList -> - Syn_ConstraintList -wrap_ConstraintList sem (Inh_ConstraintList _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_ConstraintList _lhsOannotatedTree )) -sem_ConstraintList_Cons :: T_Constraint -> - T_ConstraintList -> - T_ConstraintList -sem_ConstraintList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: ConstraintList - _hdIannotatedTree :: Constraint - _lhsOannotatedTree :: ConstraintList - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1096 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1101 "AstInternal.hs" #-} - ( _tlIannotatedTree) = - (tl_ _tlOenv ) - ( _hdIannotatedTree) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 1110 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1115 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_ConstraintList_Nil :: T_ConstraintList -sem_ConstraintList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: ConstraintList - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 1125 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1130 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- CopySource -------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative CopyFilename: - child string : {String} - visit 0: - local annotatedTree : _ - alternative Stdin: - visit 0: - local annotatedTree : _ --} -data CopySource = CopyFilename (String) - | Stdin - deriving ( Data,Eq,Show,Typeable) --- cata -sem_CopySource :: CopySource -> - T_CopySource -sem_CopySource (CopyFilename _string ) = - (sem_CopySource_CopyFilename _string ) -sem_CopySource (Stdin ) = - (sem_CopySource_Stdin ) --- semantic domain -type T_CopySource = Environment -> - ( CopySource) -data Inh_CopySource = Inh_CopySource {env_Inh_CopySource :: Environment} -data Syn_CopySource = Syn_CopySource {annotatedTree_Syn_CopySource :: CopySource} -wrap_CopySource :: T_CopySource -> - Inh_CopySource -> - Syn_CopySource -wrap_CopySource sem (Inh_CopySource _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_CopySource _lhsOannotatedTree )) -sem_CopySource_CopyFilename :: String -> - T_CopySource -sem_CopySource_CopyFilename string_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: CopySource - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - CopyFilename string_ - {-# LINE 1179 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1184 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_CopySource_Stdin :: T_CopySource -sem_CopySource_Stdin = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: CopySource - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Stdin - {-# LINE 1194 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1199 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- Direction --------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Asc: - visit 0: - local annotatedTree : _ - alternative Desc: - visit 0: - local annotatedTree : _ --} -data Direction = Asc - | Desc - deriving ( Data,Eq,Show,Typeable) --- cata -sem_Direction :: Direction -> - T_Direction -sem_Direction (Asc ) = - (sem_Direction_Asc ) -sem_Direction (Desc ) = - (sem_Direction_Desc ) --- semantic domain -type T_Direction = Environment -> - ( Direction) -data Inh_Direction = Inh_Direction {env_Inh_Direction :: Environment} -data Syn_Direction = Syn_Direction {annotatedTree_Syn_Direction :: Direction} -wrap_Direction :: T_Direction -> - Inh_Direction -> - Syn_Direction -wrap_Direction sem (Inh_Direction _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_Direction _lhsOannotatedTree )) -sem_Direction_Asc :: T_Direction -sem_Direction_Asc = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Direction - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Asc - {-# LINE 1246 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1251 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_Direction_Desc :: T_Direction -sem_Direction_Desc = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Direction - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Desc - {-# LINE 1261 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1266 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- Distinct ---------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Distinct: - visit 0: - local annotatedTree : _ - alternative Dupes: - visit 0: - local annotatedTree : _ --} -data Distinct = Distinct - | Dupes - deriving ( Data,Eq,Show,Typeable) --- cata -sem_Distinct :: Distinct -> - T_Distinct -sem_Distinct (Distinct ) = - (sem_Distinct_Distinct ) -sem_Distinct (Dupes ) = - (sem_Distinct_Dupes ) --- semantic domain -type T_Distinct = Environment -> - ( Distinct) -data Inh_Distinct = Inh_Distinct {env_Inh_Distinct :: Environment} -data Syn_Distinct = Syn_Distinct {annotatedTree_Syn_Distinct :: Distinct} -wrap_Distinct :: T_Distinct -> - Inh_Distinct -> - Syn_Distinct -wrap_Distinct sem (Inh_Distinct _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_Distinct _lhsOannotatedTree )) -sem_Distinct_Distinct :: T_Distinct -sem_Distinct_Distinct = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Distinct - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Distinct - {-# LINE 1313 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1318 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_Distinct_Dupes :: T_Distinct -sem_Distinct_Dupes = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Distinct - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Dupes - {-# LINE 1328 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1333 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- DropType ---------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Domain: - visit 0: - local annotatedTree : _ - alternative Table: - visit 0: - local annotatedTree : _ - alternative Type: - visit 0: - local annotatedTree : _ - alternative View: - visit 0: - local annotatedTree : _ --} -data DropType = Domain - | Table - | Type - | View - deriving ( Data,Eq,Show,Typeable) --- cata -sem_DropType :: DropType -> - T_DropType -sem_DropType (Domain ) = - (sem_DropType_Domain ) -sem_DropType (Table ) = - (sem_DropType_Table ) -sem_DropType (Type ) = - (sem_DropType_Type ) -sem_DropType (View ) = - (sem_DropType_View ) --- semantic domain -type T_DropType = Environment -> - ( DropType) -data Inh_DropType = Inh_DropType {env_Inh_DropType :: Environment} -data Syn_DropType = Syn_DropType {annotatedTree_Syn_DropType :: DropType} -wrap_DropType :: T_DropType -> - Inh_DropType -> - Syn_DropType -wrap_DropType sem (Inh_DropType _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_DropType _lhsOannotatedTree )) -sem_DropType_Domain :: T_DropType -sem_DropType_Domain = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: DropType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Domain - {-# LINE 1392 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1397 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_DropType_Table :: T_DropType -sem_DropType_Table = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: DropType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Table - {-# LINE 1407 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1412 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_DropType_Type :: T_DropType -sem_DropType_Type = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: DropType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Type - {-# LINE 1422 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1427 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_DropType_View :: T_DropType -sem_DropType_View = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: DropType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - View - {-# LINE 1437 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 1442 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- Expression -------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - liftedColumnName : String - alternatives: - alternative BooleanLit: - child ann : {Annotation} - child b : {Bool} - visit 0: - local tpe : _ - local backTree : _ - alternative Case: - child ann : {Annotation} - child cases : CaseExpressionListExpressionPairList - child els : MaybeExpression - visit 0: - local backTree : _ - local thenTypes : _ - local whenTypes : _ - local tpe : _ - alternative CaseSimple: - child ann : {Annotation} - child value : Expression - child cases : CaseExpressionListExpressionPairList - child els : MaybeExpression - visit 0: - local backTree : _ - local thenTypes : _ - local whenTypes : _ - local tpe : _ - alternative Cast: - child ann : {Annotation} - child expr : Expression - child tn : TypeName - visit 0: - local backTree : _ - local tpe : _ - alternative Exists: - child ann : {Annotation} - child sel : SelectExpression - visit 0: - local backTree : _ - local tpe : _ - alternative FloatLit: - child ann : {Annotation} - child d : {Double} - visit 0: - local tpe : _ - local backTree : _ - alternative FunCall: - child ann : {Annotation} - child funName : {String} - child args : ExpressionList - visit 0: - local backTree : _ - local tpe : _ - alternative Identifier: - child ann : {Annotation} - child i : {String} - visit 0: - local backTree : _ - local tpe : _ - alternative InPredicate: - child ann : {Annotation} - child expr : Expression - child i : {Bool} - child list : InList - visit 0: - local backTree : _ - local tpe : _ - alternative IntegerLit: - child ann : {Annotation} - child i : {Integer} - visit 0: - local tpe : _ - local backTree : _ - alternative NullLit: - child ann : {Annotation} - visit 0: - local tpe : _ - local backTree : _ - alternative PositionalArg: - child ann : {Annotation} - child p : {Integer} - visit 0: - local annotatedTree : _ - alternative ScalarSubQuery: - child ann : {Annotation} - child sel : SelectExpression - visit 0: - local backTree : _ - local tpe : _ - alternative StringLit: - child ann : {Annotation} - child quote : {String} - child value : {String} - visit 0: - local tpe : _ - local backTree : _ - alternative WindowFn: - child ann : {Annotation} - child fn : Expression - child partitionBy : ExpressionList - child orderBy : ExpressionList - child dir : Direction - visit 0: - local annotatedTree : _ --} -data Expression = BooleanLit (Annotation) (Bool) - | Case (Annotation) (CaseExpressionListExpressionPairList) (MaybeExpression) - | CaseSimple (Annotation) (Expression) (CaseExpressionListExpressionPairList) (MaybeExpression) - | Cast (Annotation) (Expression) (TypeName) - | Exists (Annotation) (SelectExpression) - | FloatLit (Annotation) (Double) - | FunCall (Annotation) (String) (ExpressionList) - | Identifier (Annotation) (String) - | InPredicate (Annotation) (Expression) (Bool) (InList) - | IntegerLit (Annotation) (Integer) - | NullLit (Annotation) - | PositionalArg (Annotation) (Integer) - | ScalarSubQuery (Annotation) (SelectExpression) - | StringLit (Annotation) (String) (String) - | WindowFn (Annotation) (Expression) (ExpressionList) (ExpressionList) (Direction) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_Expression :: Expression -> - T_Expression -sem_Expression (BooleanLit _ann _b ) = - (sem_Expression_BooleanLit _ann _b ) -sem_Expression (Case _ann _cases _els ) = - (sem_Expression_Case _ann (sem_CaseExpressionListExpressionPairList _cases ) (sem_MaybeExpression _els ) ) -sem_Expression (CaseSimple _ann _value _cases _els ) = - (sem_Expression_CaseSimple _ann (sem_Expression _value ) (sem_CaseExpressionListExpressionPairList _cases ) (sem_MaybeExpression _els ) ) -sem_Expression (Cast _ann _expr _tn ) = - (sem_Expression_Cast _ann (sem_Expression _expr ) (sem_TypeName _tn ) ) -sem_Expression (Exists _ann _sel ) = - (sem_Expression_Exists _ann (sem_SelectExpression _sel ) ) -sem_Expression (FloatLit _ann _d ) = - (sem_Expression_FloatLit _ann _d ) -sem_Expression (FunCall _ann _funName _args ) = - (sem_Expression_FunCall _ann _funName (sem_ExpressionList _args ) ) -sem_Expression (Identifier _ann _i ) = - (sem_Expression_Identifier _ann _i ) -sem_Expression (InPredicate _ann _expr _i _list ) = - (sem_Expression_InPredicate _ann (sem_Expression _expr ) _i (sem_InList _list ) ) -sem_Expression (IntegerLit _ann _i ) = - (sem_Expression_IntegerLit _ann _i ) -sem_Expression (NullLit _ann ) = - (sem_Expression_NullLit _ann ) -sem_Expression (PositionalArg _ann _p ) = - (sem_Expression_PositionalArg _ann _p ) -sem_Expression (ScalarSubQuery _ann _sel ) = - (sem_Expression_ScalarSubQuery _ann (sem_SelectExpression _sel ) ) -sem_Expression (StringLit _ann _quote _value ) = - (sem_Expression_StringLit _ann _quote _value ) -sem_Expression (WindowFn _ann _fn _partitionBy _orderBy _dir ) = - (sem_Expression_WindowFn _ann (sem_Expression _fn ) (sem_ExpressionList _partitionBy ) (sem_ExpressionList _orderBy ) (sem_Direction _dir ) ) --- semantic domain -type T_Expression = Environment -> - ( Expression,String) -data Inh_Expression = Inh_Expression {env_Inh_Expression :: Environment} -data Syn_Expression = Syn_Expression {annotatedTree_Syn_Expression :: Expression,liftedColumnName_Syn_Expression :: String} -wrap_Expression :: T_Expression -> - Inh_Expression -> - Syn_Expression -wrap_Expression sem (Inh_Expression _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOliftedColumnName) = - (sem _lhsIenv ) - in (Syn_Expression _lhsOannotatedTree _lhsOliftedColumnName )) -sem_Expression_BooleanLit :: Annotation -> - Bool -> - T_Expression -sem_Expression_BooleanLit ann_ b_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- "./TypeChecking.ag"(line 108, column 19) - _tpe = - {-# LINE 108 "./TypeChecking.ag" #-} - Right typeBool - {-# LINE 1628 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 100, column 9) - _backTree = - {-# LINE 100 "./TypeChecking.ag" #-} - BooleanLit ann_ b_ - {-# LINE 1633 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 1641 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - "" - {-# LINE 1646 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_Case :: Annotation -> - T_CaseExpressionListExpressionPairList -> - T_MaybeExpression -> - T_Expression -sem_Expression_Case ann_ cases_ els_ = - (\ _lhsIenv -> - (let _elsOenv :: Environment - _casesOenv :: Environment - _elsIannotatedTree :: MaybeExpression - _elsIexprType :: (Maybe Type) - _casesIannotatedTree :: CaseExpressionListExpressionPairList - _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- copy rule (down) - _elsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1665 "AstInternal.hs" #-} - -- copy rule (down) - _casesOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1670 "AstInternal.hs" #-} - ( _elsIannotatedTree,_elsIexprType) = - (els_ _elsOenv ) - ( _casesIannotatedTree) = - (cases_ _casesOenv ) - -- "./TypeChecking.ag"(line 198, column 9) - _backTree = - {-# LINE 198 "./TypeChecking.ag" #-} - Case ann_ _casesIannotatedTree _elsIannotatedTree - {-# LINE 1679 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 184, column 9) - _thenTypes = - {-# LINE 184 "./TypeChecking.ag" #-} - map getTypeAnnotation $ - (map snd $ _casesIannotatedTree) ++ - maybeToList _elsIannotatedTree - {-# LINE 1686 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 182, column 9) - _whenTypes = - {-# LINE 182 "./TypeChecking.ag" #-} - map getTypeAnnotation $ concatMap fst $ - _casesIannotatedTree - {-# LINE 1692 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 190, column 9) - _tpe = - {-# LINE 190 "./TypeChecking.ag" #-} - chainTypeCheckFailed _whenTypes $ do - when (any (/= typeBool) _whenTypes ) $ - Left [WrongTypes typeBool _whenTypes ] - chainTypeCheckFailed _thenTypes $ - resolveResultSetType - _lhsIenv - _thenTypes - {-# LINE 1703 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 1711 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - "" - {-# LINE 1716 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_CaseSimple :: Annotation -> - T_Expression -> - T_CaseExpressionListExpressionPairList -> - T_MaybeExpression -> - T_Expression -sem_Expression_CaseSimple ann_ value_ cases_ els_ = - (\ _lhsIenv -> - (let _elsOenv :: Environment - _casesOenv :: Environment - _valueOenv :: Environment - _elsIannotatedTree :: MaybeExpression - _elsIexprType :: (Maybe Type) - _casesIannotatedTree :: CaseExpressionListExpressionPairList - _valueIannotatedTree :: Expression - _valueIliftedColumnName :: String - _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- copy rule (down) - _elsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1739 "AstInternal.hs" #-} - -- copy rule (down) - _casesOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1744 "AstInternal.hs" #-} - -- copy rule (down) - _valueOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1749 "AstInternal.hs" #-} - ( _elsIannotatedTree,_elsIexprType) = - (els_ _elsOenv ) - ( _casesIannotatedTree) = - (cases_ _casesOenv ) - ( _valueIannotatedTree,_valueIliftedColumnName) = - (value_ _valueOenv ) - -- "./TypeChecking.ag"(line 212, column 9) - _backTree = - {-# LINE 212 "./TypeChecking.ag" #-} - CaseSimple ann_ _valueIannotatedTree _casesIannotatedTree _elsIannotatedTree - {-# LINE 1760 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 184, column 9) - _thenTypes = - {-# LINE 184 "./TypeChecking.ag" #-} - map getTypeAnnotation $ - (map snd $ _casesIannotatedTree) ++ - maybeToList _elsIannotatedTree - {-# LINE 1767 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 182, column 9) - _whenTypes = - {-# LINE 182 "./TypeChecking.ag" #-} - map getTypeAnnotation $ concatMap fst $ - _casesIannotatedTree - {-# LINE 1773 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 203, column 9) - _tpe = - {-# LINE 203 "./TypeChecking.ag" #-} - chainTypeCheckFailed _whenTypes $ do - checkWhenTypes <- resolveResultSetType - _lhsIenv - (getTypeAnnotation _valueIannotatedTree: _whenTypes ) - chainTypeCheckFailed _thenTypes $ - resolveResultSetType - _lhsIenv - _thenTypes - {-# LINE 1785 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 1793 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - _valueIliftedColumnName - {-# LINE 1798 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_Cast :: Annotation -> - T_Expression -> - T_TypeName -> - T_Expression -sem_Expression_Cast ann_ expr_ tn_ = - (\ _lhsIenv -> - (let _tnOenv :: Environment - _exprOenv :: Environment - _tnIannotatedTree :: TypeName - _tnInamedType :: Type - _exprIannotatedTree :: Expression - _exprIliftedColumnName :: String - _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- copy rule (down) - _tnOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1818 "AstInternal.hs" #-} - -- copy rule (down) - _exprOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1823 "AstInternal.hs" #-} - ( _tnIannotatedTree,_tnInamedType) = - (tn_ _tnOenv ) - ( _exprIannotatedTree,_exprIliftedColumnName) = - (expr_ _exprOenv ) - -- "./TypeChecking.ag"(line 121, column 12) - _backTree = - {-# LINE 121 "./TypeChecking.ag" #-} - Cast ann_ _exprIannotatedTree _tnIannotatedTree - {-# LINE 1832 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 120, column 12) - _tpe = - {-# LINE 120 "./TypeChecking.ag" #-} - Right $ _tnInamedType - {-# LINE 1837 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 1845 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 649, column 10) - _lhsOliftedColumnName = - {-# LINE 649 "./TypeChecking.ag" #-} - case _tnIannotatedTree of - SimpleTypeName _ tn -> tn - _ -> "" - {-# LINE 1852 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_Exists :: Annotation -> - T_SelectExpression -> - T_Expression -sem_Expression_Exists ann_ sel_ = - (\ _lhsIenv -> - (let _selOenv :: Environment - _selIannotatedTree :: SelectExpression - _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- copy rule (down) - _selOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1867 "AstInternal.hs" #-} - ( _selIannotatedTree) = - (sel_ _selOenv ) - -- "./TypeChecking.ag"(line 229, column 9) - _backTree = - {-# LINE 229 "./TypeChecking.ag" #-} - Exists ann_ _selIannotatedTree - {-# LINE 1874 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 228, column 9) - _tpe = - {-# LINE 228 "./TypeChecking.ag" #-} - Right typeBool - {-# LINE 1879 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 1887 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - "" - {-# LINE 1892 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_FloatLit :: Annotation -> - Double -> - T_Expression -sem_Expression_FloatLit ann_ d_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- "./TypeChecking.ag"(line 107, column 17) - _tpe = - {-# LINE 107 "./TypeChecking.ag" #-} - Right typeNumeric - {-# LINE 1905 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 98, column 9) - _backTree = - {-# LINE 98 "./TypeChecking.ag" #-} - FloatLit ann_ d_ - {-# LINE 1910 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 1918 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - "" - {-# LINE 1923 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_FunCall :: Annotation -> - String -> - T_ExpressionList -> - T_Expression -sem_Expression_FunCall ann_ funName_ args_ = - (\ _lhsIenv -> - (let _argsOenv :: Environment - _argsIannotatedTree :: ExpressionList - _argsItypeList :: ([Type]) - _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- copy rule (down) - _argsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 1940 "AstInternal.hs" #-} - ( _argsIannotatedTree,_argsItypeList) = - (args_ _argsOenv ) - -- "./TypeChecking.ag"(line 166, column 9) - _backTree = - {-# LINE 166 "./TypeChecking.ag" #-} - FunCall ann_ funName_ _argsIannotatedTree - {-# LINE 1947 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 161, column 9) - _tpe = - {-# LINE 161 "./TypeChecking.ag" #-} - chainTypeCheckFailed _argsItypeList $ - typeCheckFunCall - _lhsIenv - funName_ - _argsItypeList - {-# LINE 1956 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 1964 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 645, column 13) - _lhsOliftedColumnName = - {-# LINE 645 "./TypeChecking.ag" #-} - if isOperatorName funName_ - then "" - else funName_ - {-# LINE 1971 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_Identifier :: Annotation -> - String -> - T_Expression -sem_Expression_Identifier ann_ i_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- "./TypeChecking.ag"(line 224, column 9) - _backTree = - {-# LINE 224 "./TypeChecking.ag" #-} - Identifier ann_ i_ - {-# LINE 1984 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 222, column 9) - _tpe = - {-# LINE 222 "./TypeChecking.ag" #-} - let (correlationName,iden) = splitIdentifier i_ - in envLookupID _lhsIenv correlationName iden - {-# LINE 1990 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 1998 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 644, column 16) - _lhsOliftedColumnName = - {-# LINE 644 "./TypeChecking.ag" #-} - i_ - {-# LINE 2003 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_InPredicate :: Annotation -> - T_Expression -> - Bool -> - T_InList -> - T_Expression -sem_Expression_InPredicate ann_ expr_ i_ list_ = - (\ _lhsIenv -> - (let _listOenv :: Environment - _exprOenv :: Environment - _listIannotatedTree :: InList - _listIlistType :: (Either [TypeError] Type) - _exprIannotatedTree :: Expression - _exprIliftedColumnName :: String - _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- copy rule (down) - _listOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2024 "AstInternal.hs" #-} - -- copy rule (down) - _exprOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2029 "AstInternal.hs" #-} - ( _listIannotatedTree,_listIlistType) = - (list_ _listOenv ) - ( _exprIannotatedTree,_exprIliftedColumnName) = - (expr_ _exprOenv ) - -- "./TypeChecking.ag"(line 262, column 9) - _backTree = - {-# LINE 262 "./TypeChecking.ag" #-} - InPredicate ann_ _exprIannotatedTree i_ _listIannotatedTree - {-# LINE 2038 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 256, column 9) - _tpe = - {-# LINE 256 "./TypeChecking.ag" #-} - do - lt <- _listIlistType - ty <- resolveResultSetType - _lhsIenv - [getTypeAnnotation _exprIannotatedTree, lt] - return typeBool - {-# LINE 2048 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 2056 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - _exprIliftedColumnName - {-# LINE 2061 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_IntegerLit :: Annotation -> - Integer -> - T_Expression -sem_Expression_IntegerLit ann_ i_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- "./TypeChecking.ag"(line 105, column 19) - _tpe = - {-# LINE 105 "./TypeChecking.ag" #-} - Right typeInt - {-# LINE 2074 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 94, column 9) - _backTree = - {-# LINE 94 "./TypeChecking.ag" #-} - IntegerLit ann_ i_ - {-# LINE 2079 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 2087 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - "" - {-# LINE 2092 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_NullLit :: Annotation -> - T_Expression -sem_Expression_NullLit ann_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- "./TypeChecking.ag"(line 110, column 16) - _tpe = - {-# LINE 110 "./TypeChecking.ag" #-} - Right UnknownStringLit - {-# LINE 2104 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 102, column 9) - _backTree = - {-# LINE 102 "./TypeChecking.ag" #-} - NullLit ann_ - {-# LINE 2109 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 2117 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - "" - {-# LINE 2122 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_PositionalArg :: Annotation -> - Integer -> - T_Expression -sem_Expression_PositionalArg ann_ p_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - PositionalArg ann_ p_ - {-# LINE 2135 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2140 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - "" - {-# LINE 2145 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_ScalarSubQuery :: Annotation -> - T_SelectExpression -> - T_Expression -sem_Expression_ScalarSubQuery ann_ sel_ = - (\ _lhsIenv -> - (let _selOenv :: Environment - _selIannotatedTree :: SelectExpression - _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- copy rule (down) - _selOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2160 "AstInternal.hs" #-} - ( _selIannotatedTree) = - (sel_ _selOenv ) - -- "./TypeChecking.ag"(line 249, column 9) - _backTree = - {-# LINE 249 "./TypeChecking.ag" #-} - ScalarSubQuery ann_ _selIannotatedTree - {-# LINE 2167 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 240, column 9) - _tpe = - {-# LINE 240 "./TypeChecking.ag" #-} - let selType = getTypeAnnotation _selIannotatedTree - in chainTypeCheckFailed [selType] - $ do - f <- map snd <$> unwrapSetOfComposite selType - case length f of - 0 -> Left [InternalError "no columns in scalar subquery?"] - 1 -> Right $ head f - _ -> Right $ RowCtor f - {-# LINE 2179 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 2187 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - "" - {-# LINE 2192 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_StringLit :: Annotation -> - String -> - String -> - T_Expression -sem_Expression_StringLit ann_ quote_ value_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- "./TypeChecking.ag"(line 106, column 18) - _tpe = - {-# LINE 106 "./TypeChecking.ag" #-} - Right UnknownStringLit - {-# LINE 2206 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 96, column 9) - _backTree = - {-# LINE 96 "./TypeChecking.ag" #-} - StringLit ann_ quote_ value_ - {-# LINE 2211 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 83, column 9) - _lhsOannotatedTree = - {-# LINE 83 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 2219 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - "" - {-# LINE 2224 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) -sem_Expression_WindowFn :: Annotation -> - T_Expression -> - T_ExpressionList -> - T_ExpressionList -> - T_Direction -> - T_Expression -sem_Expression_WindowFn ann_ fn_ partitionBy_ orderBy_ dir_ = - (\ _lhsIenv -> - (let _orderByOenv :: Environment - _partitionByOenv :: Environment - _fnOenv :: Environment - _dirOenv :: Environment - _dirIannotatedTree :: Direction - _orderByIannotatedTree :: ExpressionList - _orderByItypeList :: ([Type]) - _partitionByIannotatedTree :: ExpressionList - _partitionByItypeList :: ([Type]) - _fnIannotatedTree :: Expression - _fnIliftedColumnName :: String - _lhsOannotatedTree :: Expression - _lhsOliftedColumnName :: String - -- copy rule (down) - _orderByOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2251 "AstInternal.hs" #-} - -- copy rule (down) - _partitionByOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2256 "AstInternal.hs" #-} - -- copy rule (down) - _fnOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2261 "AstInternal.hs" #-} - -- copy rule (down) - _dirOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2266 "AstInternal.hs" #-} - ( _dirIannotatedTree) = - (dir_ _dirOenv ) - ( _orderByIannotatedTree,_orderByItypeList) = - (orderBy_ _orderByOenv ) - ( _partitionByIannotatedTree,_partitionByItypeList) = - (partitionBy_ _partitionByOenv ) - ( _fnIannotatedTree,_fnIliftedColumnName) = - (fn_ _fnOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - WindowFn ann_ _fnIannotatedTree _partitionByIannotatedTree _orderByIannotatedTree _dirIannotatedTree - {-# LINE 2279 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2284 "AstInternal.hs" #-} - -- use rule "./TypeChecking.ag"(line 631, column 37) - _lhsOliftedColumnName = - {-# LINE 631 "./TypeChecking.ag" #-} - _fnIliftedColumnName - {-# LINE 2289 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOliftedColumnName))) --- ExpressionList ---------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - typeList : [Type] - alternatives: - alternative Cons: - child hd : Expression - child tl : ExpressionList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type ExpressionList = [(Expression)] --- cata -sem_ExpressionList :: ExpressionList -> - T_ExpressionList -sem_ExpressionList list = - (Prelude.foldr sem_ExpressionList_Cons sem_ExpressionList_Nil (Prelude.map sem_Expression list) ) --- semantic domain -type T_ExpressionList = Environment -> - ( ExpressionList,([Type])) -data Inh_ExpressionList = Inh_ExpressionList {env_Inh_ExpressionList :: Environment} -data Syn_ExpressionList = Syn_ExpressionList {annotatedTree_Syn_ExpressionList :: ExpressionList,typeList_Syn_ExpressionList :: [Type]} -wrap_ExpressionList :: T_ExpressionList -> - Inh_ExpressionList -> - Syn_ExpressionList -wrap_ExpressionList sem (Inh_ExpressionList _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOtypeList) = - (sem _lhsIenv ) - in (Syn_ExpressionList _lhsOannotatedTree _lhsOtypeList )) -sem_ExpressionList_Cons :: T_Expression -> - T_ExpressionList -> - T_ExpressionList -sem_ExpressionList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: ExpressionList - _tlItypeList :: ([Type]) - _hdIannotatedTree :: Expression - _hdIliftedColumnName :: String - _lhsOannotatedTree :: ExpressionList - _lhsOtypeList :: ([Type]) - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2344 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2349 "AstInternal.hs" #-} - ( _tlIannotatedTree,_tlItypeList) = - (tl_ _tlOenv ) - ( _hdIannotatedTree,_hdIliftedColumnName) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 2358 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2363 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 289, column 12) - _lhsOtypeList = - {-# LINE 289 "./TypeChecking.ag" #-} - getTypeAnnotation _hdIannotatedTree : _tlItypeList - {-# LINE 2368 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOtypeList))) -sem_ExpressionList_Nil :: T_ExpressionList -sem_ExpressionList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: ExpressionList - _lhsOtypeList :: ([Type]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 2379 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2384 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 290, column 11) - _lhsOtypeList = - {-# LINE 290 "./TypeChecking.ag" #-} - [] - {-# LINE 2389 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOtypeList))) --- ExpressionListList ------------------------------------------ -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - typeListList : [[Type]] - alternatives: - alternative Cons: - child hd : ExpressionList - child tl : ExpressionListList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type ExpressionListList = [(ExpressionList)] --- cata -sem_ExpressionListList :: ExpressionListList -> - T_ExpressionListList -sem_ExpressionListList list = - (Prelude.foldr sem_ExpressionListList_Cons sem_ExpressionListList_Nil (Prelude.map sem_ExpressionList list) ) --- semantic domain -type T_ExpressionListList = Environment -> - ( ExpressionListList,([[Type]])) -data Inh_ExpressionListList = Inh_ExpressionListList {env_Inh_ExpressionListList :: Environment} -data Syn_ExpressionListList = Syn_ExpressionListList {annotatedTree_Syn_ExpressionListList :: ExpressionListList,typeListList_Syn_ExpressionListList :: [[Type]]} -wrap_ExpressionListList :: T_ExpressionListList -> - Inh_ExpressionListList -> - Syn_ExpressionListList -wrap_ExpressionListList sem (Inh_ExpressionListList _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOtypeListList) = - (sem _lhsIenv ) - in (Syn_ExpressionListList _lhsOannotatedTree _lhsOtypeListList )) -sem_ExpressionListList_Cons :: T_ExpressionList -> - T_ExpressionListList -> - T_ExpressionListList -sem_ExpressionListList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: ExpressionListList - _tlItypeListList :: ([[Type]]) - _hdIannotatedTree :: ExpressionList - _hdItypeList :: ([Type]) - _lhsOannotatedTree :: ExpressionListList - _lhsOtypeListList :: ([[Type]]) - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2444 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2449 "AstInternal.hs" #-} - ( _tlIannotatedTree,_tlItypeListList) = - (tl_ _tlOenv ) - ( _hdIannotatedTree,_hdItypeList) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 2458 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2463 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 296, column 12) - _lhsOtypeListList = - {-# LINE 296 "./TypeChecking.ag" #-} - _hdItypeList : _tlItypeListList - {-# LINE 2468 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOtypeListList))) -sem_ExpressionListList_Nil :: T_ExpressionListList -sem_ExpressionListList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: ExpressionListList - _lhsOtypeListList :: ([[Type]]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 2479 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2484 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 297, column 11) - _lhsOtypeListList = - {-# LINE 297 "./TypeChecking.ag" #-} - [] - {-# LINE 2489 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOtypeListList))) --- ExpressionListStatementListPair ----------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Tuple: - child x1 : ExpressionList - child x2 : StatementList - visit 0: - local annotatedTree : _ --} -type ExpressionListStatementListPair = ( (ExpressionList),(StatementList)) --- cata -sem_ExpressionListStatementListPair :: ExpressionListStatementListPair -> - T_ExpressionListStatementListPair -sem_ExpressionListStatementListPair ( x1,x2) = - (sem_ExpressionListStatementListPair_Tuple (sem_ExpressionList x1 ) (sem_StatementList x2 ) ) --- semantic domain -type T_ExpressionListStatementListPair = Environment -> - ( ExpressionListStatementListPair) -data Inh_ExpressionListStatementListPair = Inh_ExpressionListStatementListPair {env_Inh_ExpressionListStatementListPair :: Environment} -data Syn_ExpressionListStatementListPair = Syn_ExpressionListStatementListPair {annotatedTree_Syn_ExpressionListStatementListPair :: ExpressionListStatementListPair} -wrap_ExpressionListStatementListPair :: T_ExpressionListStatementListPair -> - Inh_ExpressionListStatementListPair -> - Syn_ExpressionListStatementListPair -wrap_ExpressionListStatementListPair sem (Inh_ExpressionListStatementListPair _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_ExpressionListStatementListPair _lhsOannotatedTree )) -sem_ExpressionListStatementListPair_Tuple :: T_ExpressionList -> - T_StatementList -> - T_ExpressionListStatementListPair -sem_ExpressionListStatementListPair_Tuple x1_ x2_ = - (\ _lhsIenv -> - (let _x2Oenv :: Environment - _x1Oenv :: Environment - _x2OenvUpdates :: ([EnvironmentUpdate]) - _x2IannotatedTree :: StatementList - _x2IproducedEnv :: Environment - _x1IannotatedTree :: ExpressionList - _x1ItypeList :: ([Type]) - _lhsOannotatedTree :: ExpressionListStatementListPair - -- copy rule (down) - _x2Oenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2540 "AstInternal.hs" #-} - -- copy rule (down) - _x1Oenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2545 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 346, column 13) - _x2OenvUpdates = - {-# LINE 346 "./TypeChecking.ag" #-} - [] - {-# LINE 2550 "AstInternal.hs" #-} - ( _x2IannotatedTree,_x2IproducedEnv) = - (x2_ _x2Oenv _x2OenvUpdates ) - ( _x1IannotatedTree,_x1ItypeList) = - (x1_ _x1Oenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (_x1IannotatedTree,_x2IannotatedTree) - {-# LINE 2559 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2564 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- ExpressionListStatementListPairList ------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Cons: - child hd : ExpressionListStatementListPair - child tl : ExpressionListStatementListPairList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type ExpressionListStatementListPairList = [(ExpressionListStatementListPair)] --- cata -sem_ExpressionListStatementListPairList :: ExpressionListStatementListPairList -> - T_ExpressionListStatementListPairList -sem_ExpressionListStatementListPairList list = - (Prelude.foldr sem_ExpressionListStatementListPairList_Cons sem_ExpressionListStatementListPairList_Nil (Prelude.map sem_ExpressionListStatementListPair list) ) --- semantic domain -type T_ExpressionListStatementListPairList = Environment -> - ( ExpressionListStatementListPairList) -data Inh_ExpressionListStatementListPairList = Inh_ExpressionListStatementListPairList {env_Inh_ExpressionListStatementListPairList :: Environment} -data Syn_ExpressionListStatementListPairList = Syn_ExpressionListStatementListPairList {annotatedTree_Syn_ExpressionListStatementListPairList :: ExpressionListStatementListPairList} -wrap_ExpressionListStatementListPairList :: T_ExpressionListStatementListPairList -> - Inh_ExpressionListStatementListPairList -> - Syn_ExpressionListStatementListPairList -wrap_ExpressionListStatementListPairList sem (Inh_ExpressionListStatementListPairList _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_ExpressionListStatementListPairList _lhsOannotatedTree )) -sem_ExpressionListStatementListPairList_Cons :: T_ExpressionListStatementListPair -> - T_ExpressionListStatementListPairList -> - T_ExpressionListStatementListPairList -sem_ExpressionListStatementListPairList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: ExpressionListStatementListPairList - _hdIannotatedTree :: ExpressionListStatementListPair - _lhsOannotatedTree :: ExpressionListStatementListPairList - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2615 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2620 "AstInternal.hs" #-} - ( _tlIannotatedTree) = - (tl_ _tlOenv ) - ( _hdIannotatedTree) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 2629 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2634 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_ExpressionListStatementListPairList_Nil :: T_ExpressionListStatementListPairList -sem_ExpressionListStatementListPairList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: ExpressionListStatementListPairList - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 2644 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2649 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- ExpressionRoot ---------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative ExpressionRoot: - child expr : Expression - visit 0: - local annotatedTree : _ --} -data ExpressionRoot = ExpressionRoot (Expression) - deriving ( Show) --- cata -sem_ExpressionRoot :: ExpressionRoot -> - T_ExpressionRoot -sem_ExpressionRoot (ExpressionRoot _expr ) = - (sem_ExpressionRoot_ExpressionRoot (sem_Expression _expr ) ) --- semantic domain -type T_ExpressionRoot = Environment -> - ( ExpressionRoot) -data Inh_ExpressionRoot = Inh_ExpressionRoot {env_Inh_ExpressionRoot :: Environment} -data Syn_ExpressionRoot = Syn_ExpressionRoot {annotatedTree_Syn_ExpressionRoot :: ExpressionRoot} -wrap_ExpressionRoot :: T_ExpressionRoot -> - Inh_ExpressionRoot -> - Syn_ExpressionRoot -wrap_ExpressionRoot sem (Inh_ExpressionRoot _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_ExpressionRoot _lhsOannotatedTree )) -sem_ExpressionRoot_ExpressionRoot :: T_Expression -> - T_ExpressionRoot -sem_ExpressionRoot_ExpressionRoot expr_ = - (\ _lhsIenv -> - (let _exprOenv :: Environment - _exprIannotatedTree :: Expression - _exprIliftedColumnName :: String - _lhsOannotatedTree :: ExpressionRoot - -- copy rule (down) - _exprOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2695 "AstInternal.hs" #-} - ( _exprIannotatedTree,_exprIliftedColumnName) = - (expr_ _exprOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - ExpressionRoot _exprIannotatedTree - {-# LINE 2702 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2707 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- ExpressionStatementListPair --------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Tuple: - child x1 : Expression - child x2 : StatementList - visit 0: - local annotatedTree : _ --} -type ExpressionStatementListPair = ( (Expression),(StatementList)) --- cata -sem_ExpressionStatementListPair :: ExpressionStatementListPair -> - T_ExpressionStatementListPair -sem_ExpressionStatementListPair ( x1,x2) = - (sem_ExpressionStatementListPair_Tuple (sem_Expression x1 ) (sem_StatementList x2 ) ) --- semantic domain -type T_ExpressionStatementListPair = Environment -> - ( ExpressionStatementListPair) -data Inh_ExpressionStatementListPair = Inh_ExpressionStatementListPair {env_Inh_ExpressionStatementListPair :: Environment} -data Syn_ExpressionStatementListPair = Syn_ExpressionStatementListPair {annotatedTree_Syn_ExpressionStatementListPair :: ExpressionStatementListPair} -wrap_ExpressionStatementListPair :: T_ExpressionStatementListPair -> - Inh_ExpressionStatementListPair -> - Syn_ExpressionStatementListPair -wrap_ExpressionStatementListPair sem (Inh_ExpressionStatementListPair _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_ExpressionStatementListPair _lhsOannotatedTree )) -sem_ExpressionStatementListPair_Tuple :: T_Expression -> - T_StatementList -> - T_ExpressionStatementListPair -sem_ExpressionStatementListPair_Tuple x1_ x2_ = - (\ _lhsIenv -> - (let _x2Oenv :: Environment - _x1Oenv :: Environment - _x2OenvUpdates :: ([EnvironmentUpdate]) - _x2IannotatedTree :: StatementList - _x2IproducedEnv :: Environment - _x1IannotatedTree :: Expression - _x1IliftedColumnName :: String - _lhsOannotatedTree :: ExpressionStatementListPair - -- copy rule (down) - _x2Oenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2758 "AstInternal.hs" #-} - -- copy rule (down) - _x1Oenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2763 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 348, column 13) - _x2OenvUpdates = - {-# LINE 348 "./TypeChecking.ag" #-} - [] - {-# LINE 2768 "AstInternal.hs" #-} - ( _x2IannotatedTree,_x2IproducedEnv) = - (x2_ _x2Oenv _x2OenvUpdates ) - ( _x1IannotatedTree,_x1IliftedColumnName) = - (x1_ _x1Oenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (_x1IannotatedTree,_x2IannotatedTree) - {-# LINE 2777 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2782 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- ExpressionStatementListPairList ----------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Cons: - child hd : ExpressionStatementListPair - child tl : ExpressionStatementListPairList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type ExpressionStatementListPairList = [(ExpressionStatementListPair)] --- cata -sem_ExpressionStatementListPairList :: ExpressionStatementListPairList -> - T_ExpressionStatementListPairList -sem_ExpressionStatementListPairList list = - (Prelude.foldr sem_ExpressionStatementListPairList_Cons sem_ExpressionStatementListPairList_Nil (Prelude.map sem_ExpressionStatementListPair list) ) --- semantic domain -type T_ExpressionStatementListPairList = Environment -> - ( ExpressionStatementListPairList) -data Inh_ExpressionStatementListPairList = Inh_ExpressionStatementListPairList {env_Inh_ExpressionStatementListPairList :: Environment} -data Syn_ExpressionStatementListPairList = Syn_ExpressionStatementListPairList {annotatedTree_Syn_ExpressionStatementListPairList :: ExpressionStatementListPairList} -wrap_ExpressionStatementListPairList :: T_ExpressionStatementListPairList -> - Inh_ExpressionStatementListPairList -> - Syn_ExpressionStatementListPairList -wrap_ExpressionStatementListPairList sem (Inh_ExpressionStatementListPairList _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_ExpressionStatementListPairList _lhsOannotatedTree )) -sem_ExpressionStatementListPairList_Cons :: T_ExpressionStatementListPair -> - T_ExpressionStatementListPairList -> - T_ExpressionStatementListPairList -sem_ExpressionStatementListPairList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: ExpressionStatementListPairList - _hdIannotatedTree :: ExpressionStatementListPair - _lhsOannotatedTree :: ExpressionStatementListPairList - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2833 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2838 "AstInternal.hs" #-} - ( _tlIannotatedTree) = - (tl_ _tlOenv ) - ( _hdIannotatedTree) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 2847 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2852 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_ExpressionStatementListPairList_Nil :: T_ExpressionStatementListPairList -sem_ExpressionStatementListPairList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: ExpressionStatementListPairList - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 2862 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2867 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- FnBody ------------------------------------------------------ -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative PlpgsqlFnBody: - child ann : {Annotation} - child vars : VarDefList - child sts : StatementList - visit 0: - local annotatedTree : _ - alternative SqlFnBody: - child ann : {Annotation} - child sts : StatementList - visit 0: - local annotatedTree : _ --} -data FnBody = PlpgsqlFnBody (Annotation) (VarDefList) (StatementList) - | SqlFnBody (Annotation) (StatementList) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_FnBody :: FnBody -> - T_FnBody -sem_FnBody (PlpgsqlFnBody _ann _vars _sts ) = - (sem_FnBody_PlpgsqlFnBody _ann (sem_VarDefList _vars ) (sem_StatementList _sts ) ) -sem_FnBody (SqlFnBody _ann _sts ) = - (sem_FnBody_SqlFnBody _ann (sem_StatementList _sts ) ) --- semantic domain -type T_FnBody = Environment -> - ( FnBody) -data Inh_FnBody = Inh_FnBody {env_Inh_FnBody :: Environment} -data Syn_FnBody = Syn_FnBody {annotatedTree_Syn_FnBody :: FnBody} -wrap_FnBody :: T_FnBody -> - Inh_FnBody -> - Syn_FnBody -wrap_FnBody sem (Inh_FnBody _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_FnBody _lhsOannotatedTree )) -sem_FnBody_PlpgsqlFnBody :: Annotation -> - T_VarDefList -> - T_StatementList -> - T_FnBody -sem_FnBody_PlpgsqlFnBody ann_ vars_ sts_ = - (\ _lhsIenv -> - (let _varsOenv :: Environment - _varsIannotatedTree :: VarDefList - _varsIdefs :: ([(String,Type)]) - _stsOenv :: Environment - _stsOenvUpdates :: ([EnvironmentUpdate]) - _stsIannotatedTree :: StatementList - _stsIproducedEnv :: Environment - _lhsOannotatedTree :: FnBody - -- copy rule (down) - _varsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2929 "AstInternal.hs" #-} - ( _varsIannotatedTree,_varsIdefs) = - (vars_ _varsOenv ) - -- "./TypeChecking.ag"(line 938, column 9) - _stsOenv = - {-# LINE 938 "./TypeChecking.ag" #-} - fromRight _lhsIenv $ updateEnvironment _lhsIenv [EnvStackIDs [("", _varsIdefs)]] - {-# LINE 2936 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 350, column 31) - _stsOenvUpdates = - {-# LINE 350 "./TypeChecking.ag" #-} - [] - {-# LINE 2941 "AstInternal.hs" #-} - ( _stsIannotatedTree,_stsIproducedEnv) = - (sts_ _stsOenv _stsOenvUpdates ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - PlpgsqlFnBody ann_ _varsIannotatedTree _stsIannotatedTree - {-# LINE 2948 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2953 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_FnBody_SqlFnBody :: Annotation -> - T_StatementList -> - T_FnBody -sem_FnBody_SqlFnBody ann_ sts_ = - (\ _lhsIenv -> - (let _stsOenv :: Environment - _stsOenvUpdates :: ([EnvironmentUpdate]) - _stsIannotatedTree :: StatementList - _stsIproducedEnv :: Environment - _lhsOannotatedTree :: FnBody - -- copy rule (down) - _stsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 2969 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 350, column 31) - _stsOenvUpdates = - {-# LINE 350 "./TypeChecking.ag" #-} - [] - {-# LINE 2974 "AstInternal.hs" #-} - ( _stsIannotatedTree,_stsIproducedEnv) = - (sts_ _stsOenv _stsOenvUpdates ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - SqlFnBody ann_ _stsIannotatedTree - {-# LINE 2981 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 2986 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- IfExists ---------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative IfExists: - visit 0: - local annotatedTree : _ - alternative Require: - visit 0: - local annotatedTree : _ --} -data IfExists = IfExists - | Require - deriving ( Data,Eq,Show,Typeable) --- cata -sem_IfExists :: IfExists -> - T_IfExists -sem_IfExists (IfExists ) = - (sem_IfExists_IfExists ) -sem_IfExists (Require ) = - (sem_IfExists_Require ) --- semantic domain -type T_IfExists = Environment -> - ( IfExists) -data Inh_IfExists = Inh_IfExists {env_Inh_IfExists :: Environment} -data Syn_IfExists = Syn_IfExists {annotatedTree_Syn_IfExists :: IfExists} -wrap_IfExists :: T_IfExists -> - Inh_IfExists -> - Syn_IfExists -wrap_IfExists sem (Inh_IfExists _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_IfExists _lhsOannotatedTree )) -sem_IfExists_IfExists :: T_IfExists -sem_IfExists_IfExists = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: IfExists - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - IfExists - {-# LINE 3033 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3038 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_IfExists_Require :: T_IfExists -sem_IfExists_Require = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: IfExists - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Require - {-# LINE 3048 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3053 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- InList ------------------------------------------------------ -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - listType : Either [TypeError] Type - alternatives: - alternative InList: - child ann : {Annotation} - child exprs : ExpressionList - visit 0: - local annotatedTree : _ - alternative InSelect: - child ann : {Annotation} - child sel : SelectExpression - visit 0: - local annotatedTree : _ --} -data InList = InList (Annotation) (ExpressionList) - | InSelect (Annotation) (SelectExpression) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_InList :: InList -> - T_InList -sem_InList (InList _ann _exprs ) = - (sem_InList_InList _ann (sem_ExpressionList _exprs ) ) -sem_InList (InSelect _ann _sel ) = - (sem_InList_InSelect _ann (sem_SelectExpression _sel ) ) --- semantic domain -type T_InList = Environment -> - ( InList,(Either [TypeError] Type)) -data Inh_InList = Inh_InList {env_Inh_InList :: Environment} -data Syn_InList = Syn_InList {annotatedTree_Syn_InList :: InList,listType_Syn_InList :: Either [TypeError] Type} -wrap_InList :: T_InList -> - Inh_InList -> - Syn_InList -wrap_InList sem (Inh_InList _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOlistType) = - (sem _lhsIenv ) - in (Syn_InList _lhsOannotatedTree _lhsOlistType )) -sem_InList_InList :: Annotation -> - T_ExpressionList -> - T_InList -sem_InList_InList ann_ exprs_ = - (\ _lhsIenv -> - (let _exprsOenv :: Environment - _exprsIannotatedTree :: ExpressionList - _exprsItypeList :: ([Type]) - _lhsOannotatedTree :: InList - _lhsOlistType :: (Either [TypeError] Type) - -- copy rule (down) - _exprsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 3111 "AstInternal.hs" #-} - ( _exprsIannotatedTree,_exprsItypeList) = - (exprs_ _exprsOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - InList ann_ _exprsIannotatedTree - {-# LINE 3118 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3123 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 269, column 9) - _lhsOlistType = - {-# LINE 269 "./TypeChecking.ag" #-} - resolveResultSetType - _lhsIenv - _exprsItypeList - {-# LINE 3130 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOlistType))) -sem_InList_InSelect :: Annotation -> - T_SelectExpression -> - T_InList -sem_InList_InSelect ann_ sel_ = - (\ _lhsIenv -> - (let _selOenv :: Environment - _selIannotatedTree :: SelectExpression - _lhsOannotatedTree :: InList - _lhsOlistType :: (Either [TypeError] Type) - -- copy rule (down) - _selOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 3145 "AstInternal.hs" #-} - ( _selIannotatedTree) = - (sel_ _selOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - InSelect ann_ _selIannotatedTree - {-# LINE 3152 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3157 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 273, column 9) - _lhsOlistType = - {-# LINE 273 "./TypeChecking.ag" #-} - do - attrs <- map snd <$> (unwrapSetOfComposite $ - let a = getTypeAnnotation _selIannotatedTree - in a) - typ <- case length attrs of - 0 -> Left [InternalError "got subquery with no columns? in inselect"] - 1 -> Right $ head attrs - _ -> Right $ RowCtor attrs - chainTypeCheckFailed attrs $ Right typ - {-# LINE 3170 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOlistType))) --- JoinExpression ---------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative JoinOn: - child ann : {Annotation} - child expression : Expression - visit 0: - local annotatedTree : _ - alternative JoinUsing: - child ann : {Annotation} - child stringList : StringList - visit 0: - local annotatedTree : _ --} -data JoinExpression = JoinOn (Annotation) (Expression) - | JoinUsing (Annotation) (StringList) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_JoinExpression :: JoinExpression -> - T_JoinExpression -sem_JoinExpression (JoinOn _ann _expression ) = - (sem_JoinExpression_JoinOn _ann (sem_Expression _expression ) ) -sem_JoinExpression (JoinUsing _ann _stringList ) = - (sem_JoinExpression_JoinUsing _ann (sem_StringList _stringList ) ) --- semantic domain -type T_JoinExpression = Environment -> - ( JoinExpression) -data Inh_JoinExpression = Inh_JoinExpression {env_Inh_JoinExpression :: Environment} -data Syn_JoinExpression = Syn_JoinExpression {annotatedTree_Syn_JoinExpression :: JoinExpression} -wrap_JoinExpression :: T_JoinExpression -> - Inh_JoinExpression -> - Syn_JoinExpression -wrap_JoinExpression sem (Inh_JoinExpression _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_JoinExpression _lhsOannotatedTree )) -sem_JoinExpression_JoinOn :: Annotation -> - T_Expression -> - T_JoinExpression -sem_JoinExpression_JoinOn ann_ expression_ = - (\ _lhsIenv -> - (let _expressionOenv :: Environment - _expressionIannotatedTree :: Expression - _expressionIliftedColumnName :: String - _lhsOannotatedTree :: JoinExpression - -- copy rule (down) - _expressionOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 3226 "AstInternal.hs" #-} - ( _expressionIannotatedTree,_expressionIliftedColumnName) = - (expression_ _expressionOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - JoinOn ann_ _expressionIannotatedTree - {-# LINE 3233 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3238 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_JoinExpression_JoinUsing :: Annotation -> - T_StringList -> - T_JoinExpression -sem_JoinExpression_JoinUsing ann_ stringList_ = - (\ _lhsIenv -> - (let _stringListOenv :: Environment - _stringListIannotatedTree :: StringList - _stringListIstrings :: ([String]) - _lhsOannotatedTree :: JoinExpression - -- copy rule (down) - _stringListOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 3253 "AstInternal.hs" #-} - ( _stringListIannotatedTree,_stringListIstrings) = - (stringList_ _stringListOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - JoinUsing ann_ _stringListIannotatedTree - {-# LINE 3260 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3265 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- JoinType ---------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Cross: - visit 0: - local annotatedTree : _ - alternative FullOuter: - visit 0: - local annotatedTree : _ - alternative Inner: - visit 0: - local annotatedTree : _ - alternative LeftOuter: - visit 0: - local annotatedTree : _ - alternative RightOuter: - visit 0: - local annotatedTree : _ --} -data JoinType = Cross - | FullOuter - | Inner - | LeftOuter - | RightOuter - deriving ( Data,Eq,Show,Typeable) --- cata -sem_JoinType :: JoinType -> - T_JoinType -sem_JoinType (Cross ) = - (sem_JoinType_Cross ) -sem_JoinType (FullOuter ) = - (sem_JoinType_FullOuter ) -sem_JoinType (Inner ) = - (sem_JoinType_Inner ) -sem_JoinType (LeftOuter ) = - (sem_JoinType_LeftOuter ) -sem_JoinType (RightOuter ) = - (sem_JoinType_RightOuter ) --- semantic domain -type T_JoinType = Environment -> - ( JoinType) -data Inh_JoinType = Inh_JoinType {env_Inh_JoinType :: Environment} -data Syn_JoinType = Syn_JoinType {annotatedTree_Syn_JoinType :: JoinType} -wrap_JoinType :: T_JoinType -> - Inh_JoinType -> - Syn_JoinType -wrap_JoinType sem (Inh_JoinType _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_JoinType _lhsOannotatedTree )) -sem_JoinType_Cross :: T_JoinType -sem_JoinType_Cross = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: JoinType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Cross - {-# LINE 3330 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3335 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_JoinType_FullOuter :: T_JoinType -sem_JoinType_FullOuter = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: JoinType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - FullOuter - {-# LINE 3345 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3350 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_JoinType_Inner :: T_JoinType -sem_JoinType_Inner = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: JoinType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Inner - {-# LINE 3360 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3365 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_JoinType_LeftOuter :: T_JoinType -sem_JoinType_LeftOuter = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: JoinType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - LeftOuter - {-# LINE 3375 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3380 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_JoinType_RightOuter :: T_JoinType -sem_JoinType_RightOuter = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: JoinType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - RightOuter - {-# LINE 3390 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3395 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- Language ---------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Plpgsql: - visit 0: - local annotatedTree : _ - alternative Sql: - visit 0: - local annotatedTree : _ --} -data Language = Plpgsql - | Sql - deriving ( Data,Eq,Show,Typeable) --- cata -sem_Language :: Language -> - T_Language -sem_Language (Plpgsql ) = - (sem_Language_Plpgsql ) -sem_Language (Sql ) = - (sem_Language_Sql ) --- semantic domain -type T_Language = Environment -> - ( Language) -data Inh_Language = Inh_Language {env_Inh_Language :: Environment} -data Syn_Language = Syn_Language {annotatedTree_Syn_Language :: Language} -wrap_Language :: T_Language -> - Inh_Language -> - Syn_Language -wrap_Language sem (Inh_Language _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_Language _lhsOannotatedTree )) -sem_Language_Plpgsql :: T_Language -sem_Language_Plpgsql = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Language - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Plpgsql - {-# LINE 3442 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3447 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_Language_Sql :: T_Language -sem_Language_Sql = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Language - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Sql - {-# LINE 3457 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3462 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- MaybeBoolExpression ----------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Just: - child just : Expression - alternative Nothing: - visit 0: - local annotatedTree : _ --} -type MaybeBoolExpression = (Maybe (Expression)) --- cata -sem_MaybeBoolExpression :: MaybeBoolExpression -> - T_MaybeBoolExpression -sem_MaybeBoolExpression (Prelude.Just x ) = - (sem_MaybeBoolExpression_Just (sem_Expression x ) ) -sem_MaybeBoolExpression Prelude.Nothing = - sem_MaybeBoolExpression_Nothing --- semantic domain -type T_MaybeBoolExpression = Environment -> - ( MaybeBoolExpression) -data Inh_MaybeBoolExpression = Inh_MaybeBoolExpression {env_Inh_MaybeBoolExpression :: Environment} -data Syn_MaybeBoolExpression = Syn_MaybeBoolExpression {annotatedTree_Syn_MaybeBoolExpression :: MaybeBoolExpression} -wrap_MaybeBoolExpression :: T_MaybeBoolExpression -> - Inh_MaybeBoolExpression -> - Syn_MaybeBoolExpression -wrap_MaybeBoolExpression sem (Inh_MaybeBoolExpression _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_MaybeBoolExpression _lhsOannotatedTree )) -sem_MaybeBoolExpression_Just :: T_Expression -> - T_MaybeBoolExpression -sem_MaybeBoolExpression_Just just_ = - (\ _lhsIenv -> - (let _justOenv :: Environment - _justIannotatedTree :: Expression - _justIliftedColumnName :: String - _lhsOannotatedTree :: MaybeBoolExpression - -- copy rule (down) - _justOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 3510 "AstInternal.hs" #-} - ( _justIannotatedTree,_justIliftedColumnName) = - (just_ _justOenv ) - -- "./TypeChecking.ag"(line 960, column 9) - _lhsOannotatedTree = - {-# LINE 960 "./TypeChecking.ag" #-} - if getTypeAnnotation _justIannotatedTree `notElem` [typeBool, TypeCheckFailed] - then Just $ updateAnnotation ((TypeErrorA ExpressionMustBeBool) :) - _justIannotatedTree - else Just $ _justIannotatedTree - {-# LINE 3520 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_MaybeBoolExpression_Nothing :: T_MaybeBoolExpression -sem_MaybeBoolExpression_Nothing = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: MaybeBoolExpression - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Nothing - {-# LINE 3530 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3535 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- MaybeExpression --------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - exprType : Maybe Type - alternatives: - alternative Just: - child just : Expression - visit 0: - local annotatedTree : _ - alternative Nothing: - visit 0: - local annotatedTree : _ --} -type MaybeExpression = (Maybe (Expression)) --- cata -sem_MaybeExpression :: MaybeExpression -> - T_MaybeExpression -sem_MaybeExpression (Prelude.Just x ) = - (sem_MaybeExpression_Just (sem_Expression x ) ) -sem_MaybeExpression Prelude.Nothing = - sem_MaybeExpression_Nothing --- semantic domain -type T_MaybeExpression = Environment -> - ( MaybeExpression,(Maybe Type)) -data Inh_MaybeExpression = Inh_MaybeExpression {env_Inh_MaybeExpression :: Environment} -data Syn_MaybeExpression = Syn_MaybeExpression {annotatedTree_Syn_MaybeExpression :: MaybeExpression,exprType_Syn_MaybeExpression :: Maybe Type} -wrap_MaybeExpression :: T_MaybeExpression -> - Inh_MaybeExpression -> - Syn_MaybeExpression -wrap_MaybeExpression sem (Inh_MaybeExpression _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOexprType) = - (sem _lhsIenv ) - in (Syn_MaybeExpression _lhsOannotatedTree _lhsOexprType )) -sem_MaybeExpression_Just :: T_Expression -> - T_MaybeExpression -sem_MaybeExpression_Just just_ = - (\ _lhsIenv -> - (let _justOenv :: Environment - _justIannotatedTree :: Expression - _justIliftedColumnName :: String - _lhsOannotatedTree :: MaybeExpression - _lhsOexprType :: (Maybe Type) - -- copy rule (down) - _justOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 3587 "AstInternal.hs" #-} - ( _justIannotatedTree,_justIliftedColumnName) = - (just_ _justOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Just _justIannotatedTree - {-# LINE 3594 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3599 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 969, column 12) - _lhsOexprType = - {-# LINE 969 "./TypeChecking.ag" #-} - Just $ getTypeAnnotation _justIannotatedTree - {-# LINE 3604 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOexprType))) -sem_MaybeExpression_Nothing :: T_MaybeExpression -sem_MaybeExpression_Nothing = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: MaybeExpression - _lhsOexprType :: (Maybe Type) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Nothing - {-# LINE 3615 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3620 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 970, column 15) - _lhsOexprType = - {-# LINE 970 "./TypeChecking.ag" #-} - Nothing - {-# LINE 3625 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOexprType))) --- MaybeTableRef ----------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - idens : [(String,([(String,Type)],[(String,Type)]))] - joinIdens : [String] - alternatives: - alternative Just: - child just : TableRef - visit 0: - local annotatedTree : _ - alternative Nothing: - visit 0: - local annotatedTree : _ --} -type MaybeTableRef = (Maybe (TableRef)) --- cata -sem_MaybeTableRef :: MaybeTableRef -> - T_MaybeTableRef -sem_MaybeTableRef (Prelude.Just x ) = - (sem_MaybeTableRef_Just (sem_TableRef x ) ) -sem_MaybeTableRef Prelude.Nothing = - sem_MaybeTableRef_Nothing --- semantic domain -type T_MaybeTableRef = Environment -> - ( MaybeTableRef,([(String,([(String,Type)],[(String,Type)]))]),([String])) -data Inh_MaybeTableRef = Inh_MaybeTableRef {env_Inh_MaybeTableRef :: Environment} -data Syn_MaybeTableRef = Syn_MaybeTableRef {annotatedTree_Syn_MaybeTableRef :: MaybeTableRef,idens_Syn_MaybeTableRef :: [(String,([(String,Type)],[(String,Type)]))],joinIdens_Syn_MaybeTableRef :: [String]} -wrap_MaybeTableRef :: T_MaybeTableRef -> - Inh_MaybeTableRef -> - Syn_MaybeTableRef -wrap_MaybeTableRef sem (Inh_MaybeTableRef _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens) = - (sem _lhsIenv ) - in (Syn_MaybeTableRef _lhsOannotatedTree _lhsOidens _lhsOjoinIdens )) -sem_MaybeTableRef_Just :: T_TableRef -> - T_MaybeTableRef -sem_MaybeTableRef_Just just_ = - (\ _lhsIenv -> - (let _justOenv :: Environment - _justIannotatedTree :: TableRef - _justIidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _justIjoinIdens :: ([String]) - _lhsOannotatedTree :: MaybeTableRef - _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _lhsOjoinIdens :: ([String]) - -- copy rule (down) - _justOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 3680 "AstInternal.hs" #-} - ( _justIannotatedTree,_justIidens,_justIjoinIdens) = - (just_ _justOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Just _justIannotatedTree - {-# LINE 3687 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3692 "AstInternal.hs" #-} - -- copy rule (up) - _lhsOidens = - {-# LINE 425 "./TypeChecking.ag" #-} - _justIidens - {-# LINE 3697 "AstInternal.hs" #-} - -- copy rule (up) - _lhsOjoinIdens = - {-# LINE 426 "./TypeChecking.ag" #-} - _justIjoinIdens - {-# LINE 3702 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) -sem_MaybeTableRef_Nothing :: T_MaybeTableRef -sem_MaybeTableRef_Nothing = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: MaybeTableRef - _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _lhsOjoinIdens :: ([String]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Nothing - {-# LINE 3714 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3719 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 525, column 9) - _lhsOidens = - {-# LINE 525 "./TypeChecking.ag" #-} - [] - {-# LINE 3724 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 526, column 9) - _lhsOjoinIdens = - {-# LINE 526 "./TypeChecking.ag" #-} - [] - {-# LINE 3729 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) --- Natural ----------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Natural: - visit 0: - local annotatedTree : _ - alternative Unnatural: - visit 0: - local annotatedTree : _ --} -data Natural = Natural - | Unnatural - deriving ( Data,Eq,Show,Typeable) --- cata -sem_Natural :: Natural -> - T_Natural -sem_Natural (Natural ) = - (sem_Natural_Natural ) -sem_Natural (Unnatural ) = - (sem_Natural_Unnatural ) --- semantic domain -type T_Natural = Environment -> - ( Natural) -data Inh_Natural = Inh_Natural {env_Inh_Natural :: Environment} -data Syn_Natural = Syn_Natural {annotatedTree_Syn_Natural :: Natural} -wrap_Natural :: T_Natural -> - Inh_Natural -> - Syn_Natural -wrap_Natural sem (Inh_Natural _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_Natural _lhsOannotatedTree )) -sem_Natural_Natural :: T_Natural -sem_Natural_Natural = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Natural - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Natural - {-# LINE 3776 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3781 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_Natural_Unnatural :: T_Natural -sem_Natural_Unnatural = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Natural - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Unnatural - {-# LINE 3791 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3796 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- OnExpr ------------------------------------------------------ -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Just: - child just : JoinExpression - visit 0: - local annotatedTree : _ - alternative Nothing: - visit 0: - local annotatedTree : _ --} -type OnExpr = (Maybe (JoinExpression)) --- cata -sem_OnExpr :: OnExpr -> - T_OnExpr -sem_OnExpr (Prelude.Just x ) = - (sem_OnExpr_Just (sem_JoinExpression x ) ) -sem_OnExpr Prelude.Nothing = - sem_OnExpr_Nothing --- semantic domain -type T_OnExpr = Environment -> - ( OnExpr) -data Inh_OnExpr = Inh_OnExpr {env_Inh_OnExpr :: Environment} -data Syn_OnExpr = Syn_OnExpr {annotatedTree_Syn_OnExpr :: OnExpr} -wrap_OnExpr :: T_OnExpr -> - Inh_OnExpr -> - Syn_OnExpr -wrap_OnExpr sem (Inh_OnExpr _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_OnExpr _lhsOannotatedTree )) -sem_OnExpr_Just :: T_JoinExpression -> - T_OnExpr -sem_OnExpr_Just just_ = - (\ _lhsIenv -> - (let _justOenv :: Environment - _justIannotatedTree :: JoinExpression - _lhsOannotatedTree :: OnExpr - -- copy rule (down) - _justOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 3845 "AstInternal.hs" #-} - ( _justIannotatedTree) = - (just_ _justOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Just _justIannotatedTree - {-# LINE 3852 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3857 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_OnExpr_Nothing :: T_OnExpr -sem_OnExpr_Nothing = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: OnExpr - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Nothing - {-# LINE 3867 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3872 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- ParamDef ---------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - namedType : Type - paramName : String - alternatives: - alternative ParamDef: - child ann : {Annotation} - child name : {String} - child typ : TypeName - visit 0: - local annotatedTree : _ - alternative ParamDefTp: - child ann : {Annotation} - child typ : TypeName - visit 0: - local annotatedTree : _ --} -data ParamDef = ParamDef (Annotation) (String) (TypeName) - | ParamDefTp (Annotation) (TypeName) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_ParamDef :: ParamDef -> - T_ParamDef -sem_ParamDef (ParamDef _ann _name _typ ) = - (sem_ParamDef_ParamDef _ann _name (sem_TypeName _typ ) ) -sem_ParamDef (ParamDefTp _ann _typ ) = - (sem_ParamDef_ParamDefTp _ann (sem_TypeName _typ ) ) --- semantic domain -type T_ParamDef = Environment -> - ( ParamDef,Type,String) -data Inh_ParamDef = Inh_ParamDef {env_Inh_ParamDef :: Environment} -data Syn_ParamDef = Syn_ParamDef {annotatedTree_Syn_ParamDef :: ParamDef,namedType_Syn_ParamDef :: Type,paramName_Syn_ParamDef :: String} -wrap_ParamDef :: T_ParamDef -> - Inh_ParamDef -> - Syn_ParamDef -wrap_ParamDef sem (Inh_ParamDef _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOnamedType,_lhsOparamName) = - (sem _lhsIenv ) - in (Syn_ParamDef _lhsOannotatedTree _lhsOnamedType _lhsOparamName )) -sem_ParamDef_ParamDef :: Annotation -> - String -> - T_TypeName -> - T_ParamDef -sem_ParamDef_ParamDef ann_ name_ typ_ = - (\ _lhsIenv -> - (let _typOenv :: Environment - _typIannotatedTree :: TypeName - _typInamedType :: Type - _lhsOannotatedTree :: ParamDef - _lhsOnamedType :: Type - _lhsOparamName :: String - -- copy rule (down) - _typOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 3934 "AstInternal.hs" #-} - ( _typIannotatedTree,_typInamedType) = - (typ_ _typOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - ParamDef ann_ name_ _typIannotatedTree - {-# LINE 3941 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3946 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 908, column 9) - _lhsOnamedType = - {-# LINE 908 "./TypeChecking.ag" #-} - _typInamedType - {-# LINE 3951 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 910, column 9) - _lhsOparamName = - {-# LINE 910 "./TypeChecking.ag" #-} - name_ - {-# LINE 3956 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOnamedType,_lhsOparamName))) -sem_ParamDef_ParamDefTp :: Annotation -> - T_TypeName -> - T_ParamDef -sem_ParamDef_ParamDefTp ann_ typ_ = - (\ _lhsIenv -> - (let _typOenv :: Environment - _typIannotatedTree :: TypeName - _typInamedType :: Type - _lhsOannotatedTree :: ParamDef - _lhsOnamedType :: Type - _lhsOparamName :: String - -- copy rule (down) - _typOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 3973 "AstInternal.hs" #-} - ( _typIannotatedTree,_typInamedType) = - (typ_ _typOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - ParamDefTp ann_ _typIannotatedTree - {-# LINE 3980 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 3985 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 908, column 9) - _lhsOnamedType = - {-# LINE 908 "./TypeChecking.ag" #-} - _typInamedType - {-# LINE 3990 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 912, column 9) - _lhsOparamName = - {-# LINE 912 "./TypeChecking.ag" #-} - "" - {-# LINE 3995 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOnamedType,_lhsOparamName))) --- ParamDefList ------------------------------------------------ -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - params : [(String, Type)] - alternatives: - alternative Cons: - child hd : ParamDef - child tl : ParamDefList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type ParamDefList = [(ParamDef)] --- cata -sem_ParamDefList :: ParamDefList -> - T_ParamDefList -sem_ParamDefList list = - (Prelude.foldr sem_ParamDefList_Cons sem_ParamDefList_Nil (Prelude.map sem_ParamDef list) ) --- semantic domain -type T_ParamDefList = Environment -> - ( ParamDefList,([(String, Type)])) -data Inh_ParamDefList = Inh_ParamDefList {env_Inh_ParamDefList :: Environment} -data Syn_ParamDefList = Syn_ParamDefList {annotatedTree_Syn_ParamDefList :: ParamDefList,params_Syn_ParamDefList :: [(String, Type)]} -wrap_ParamDefList :: T_ParamDefList -> - Inh_ParamDefList -> - Syn_ParamDefList -wrap_ParamDefList sem (Inh_ParamDefList _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOparams) = - (sem _lhsIenv ) - in (Syn_ParamDefList _lhsOannotatedTree _lhsOparams )) -sem_ParamDefList_Cons :: T_ParamDef -> - T_ParamDefList -> - T_ParamDefList -sem_ParamDefList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: ParamDefList - _tlIparams :: ([(String, Type)]) - _hdIannotatedTree :: ParamDef - _hdInamedType :: Type - _hdIparamName :: String - _lhsOannotatedTree :: ParamDefList - _lhsOparams :: ([(String, Type)]) - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4051 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4056 "AstInternal.hs" #-} - ( _tlIannotatedTree,_tlIparams) = - (tl_ _tlOenv ) - ( _hdIannotatedTree,_hdInamedType,_hdIparamName) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 4065 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4070 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 916, column 13) - _lhsOparams = - {-# LINE 916 "./TypeChecking.ag" #-} - ((_hdIparamName, _hdInamedType) : _tlIparams) - {-# LINE 4075 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOparams))) -sem_ParamDefList_Nil :: T_ParamDefList -sem_ParamDefList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: ParamDefList - _lhsOparams :: ([(String, Type)]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 4086 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4091 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 915, column 12) - _lhsOparams = - {-# LINE 915 "./TypeChecking.ag" #-} - [] - {-# LINE 4096 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOparams))) --- RaiseType --------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative RError: - visit 0: - local annotatedTree : _ - alternative RException: - visit 0: - local annotatedTree : _ - alternative RNotice: - visit 0: - local annotatedTree : _ --} -data RaiseType = RError - | RException - | RNotice - deriving ( Data,Eq,Show,Typeable) --- cata -sem_RaiseType :: RaiseType -> - T_RaiseType -sem_RaiseType (RError ) = - (sem_RaiseType_RError ) -sem_RaiseType (RException ) = - (sem_RaiseType_RException ) -sem_RaiseType (RNotice ) = - (sem_RaiseType_RNotice ) --- semantic domain -type T_RaiseType = Environment -> - ( RaiseType) -data Inh_RaiseType = Inh_RaiseType {env_Inh_RaiseType :: Environment} -data Syn_RaiseType = Syn_RaiseType {annotatedTree_Syn_RaiseType :: RaiseType} -wrap_RaiseType :: T_RaiseType -> - Inh_RaiseType -> - Syn_RaiseType -wrap_RaiseType sem (Inh_RaiseType _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_RaiseType _lhsOannotatedTree )) -sem_RaiseType_RError :: T_RaiseType -sem_RaiseType_RError = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: RaiseType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - RError - {-# LINE 4149 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4154 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_RaiseType_RException :: T_RaiseType -sem_RaiseType_RException = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: RaiseType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - RException - {-# LINE 4164 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4169 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_RaiseType_RNotice :: T_RaiseType -sem_RaiseType_RNotice = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: RaiseType - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - RNotice - {-# LINE 4179 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4184 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- RestartIdentity --------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative ContinueIdentity: - visit 0: - local annotatedTree : _ - alternative RestartIdentity: - visit 0: - local annotatedTree : _ --} -data RestartIdentity = ContinueIdentity - | RestartIdentity - deriving ( Data,Eq,Show,Typeable) --- cata -sem_RestartIdentity :: RestartIdentity -> - T_RestartIdentity -sem_RestartIdentity (ContinueIdentity ) = - (sem_RestartIdentity_ContinueIdentity ) -sem_RestartIdentity (RestartIdentity ) = - (sem_RestartIdentity_RestartIdentity ) --- semantic domain -type T_RestartIdentity = Environment -> - ( RestartIdentity) -data Inh_RestartIdentity = Inh_RestartIdentity {env_Inh_RestartIdentity :: Environment} -data Syn_RestartIdentity = Syn_RestartIdentity {annotatedTree_Syn_RestartIdentity :: RestartIdentity} -wrap_RestartIdentity :: T_RestartIdentity -> - Inh_RestartIdentity -> - Syn_RestartIdentity -wrap_RestartIdentity sem (Inh_RestartIdentity _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_RestartIdentity _lhsOannotatedTree )) -sem_RestartIdentity_ContinueIdentity :: T_RestartIdentity -sem_RestartIdentity_ContinueIdentity = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: RestartIdentity - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - ContinueIdentity - {-# LINE 4231 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4236 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_RestartIdentity_RestartIdentity :: T_RestartIdentity -sem_RestartIdentity_RestartIdentity = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: RestartIdentity - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - RestartIdentity - {-# LINE 4246 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4251 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- Root -------------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - producedEnv : Environment - alternatives: - alternative Root: - child statements : StatementList - visit 0: - local annotatedTree : _ --} -data Root = Root (StatementList) - deriving ( Show) --- cata -sem_Root :: Root -> - T_Root -sem_Root (Root _statements ) = - (sem_Root_Root (sem_StatementList _statements ) ) --- semantic domain -type T_Root = Environment -> - ( Root,Environment) -data Inh_Root = Inh_Root {env_Inh_Root :: Environment} -data Syn_Root = Syn_Root {annotatedTree_Syn_Root :: Root,producedEnv_Syn_Root :: Environment} -wrap_Root :: T_Root -> - Inh_Root -> - Syn_Root -wrap_Root sem (Inh_Root _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOproducedEnv) = - (sem _lhsIenv ) - in (Syn_Root _lhsOannotatedTree _lhsOproducedEnv )) -sem_Root_Root :: T_StatementList -> - T_Root -sem_Root_Root statements_ = - (\ _lhsIenv -> - (let _statementsOenv :: Environment - _statementsOenvUpdates :: ([EnvironmentUpdate]) - _statementsIannotatedTree :: StatementList - _statementsIproducedEnv :: Environment - _lhsOannotatedTree :: Root - _lhsOproducedEnv :: Environment - -- copy rule (down) - _statementsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4300 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 330, column 12) - _statementsOenvUpdates = - {-# LINE 330 "./TypeChecking.ag" #-} - [] - {-# LINE 4305 "AstInternal.hs" #-} - ( _statementsIannotatedTree,_statementsIproducedEnv) = - (statements_ _statementsOenv _statementsOenvUpdates ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Root _statementsIannotatedTree - {-# LINE 4312 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4317 "AstInternal.hs" #-} - -- copy rule (up) - _lhsOproducedEnv = - {-# LINE 59 "./TypeChecking.ag" #-} - _statementsIproducedEnv - {-# LINE 4322 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOproducedEnv))) --- RowConstraint ----------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative NotNullConstraint: - child ann : {Annotation} - visit 0: - local annotatedTree : _ - alternative NullConstraint: - child ann : {Annotation} - visit 0: - local annotatedTree : _ - alternative RowCheckConstraint: - child ann : {Annotation} - child expression : Expression - visit 0: - local annotatedTree : _ - alternative RowPrimaryKeyConstraint: - child ann : {Annotation} - visit 0: - local annotatedTree : _ - alternative RowReferenceConstraint: - child ann : {Annotation} - child table : {String} - child att : {Maybe String} - child onUpdate : Cascade - child onDelete : Cascade - visit 0: - local annotatedTree : _ - alternative RowUniqueConstraint: - child ann : {Annotation} - visit 0: - local annotatedTree : _ --} -data RowConstraint = NotNullConstraint (Annotation) - | NullConstraint (Annotation) - | RowCheckConstraint (Annotation) (Expression) - | RowPrimaryKeyConstraint (Annotation) - | RowReferenceConstraint (Annotation) (String) (Maybe String) (Cascade) (Cascade) - | RowUniqueConstraint (Annotation) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_RowConstraint :: RowConstraint -> - T_RowConstraint -sem_RowConstraint (NotNullConstraint _ann ) = - (sem_RowConstraint_NotNullConstraint _ann ) -sem_RowConstraint (NullConstraint _ann ) = - (sem_RowConstraint_NullConstraint _ann ) -sem_RowConstraint (RowCheckConstraint _ann _expression ) = - (sem_RowConstraint_RowCheckConstraint _ann (sem_Expression _expression ) ) -sem_RowConstraint (RowPrimaryKeyConstraint _ann ) = - (sem_RowConstraint_RowPrimaryKeyConstraint _ann ) -sem_RowConstraint (RowReferenceConstraint _ann _table _att _onUpdate _onDelete ) = - (sem_RowConstraint_RowReferenceConstraint _ann _table _att (sem_Cascade _onUpdate ) (sem_Cascade _onDelete ) ) -sem_RowConstraint (RowUniqueConstraint _ann ) = - (sem_RowConstraint_RowUniqueConstraint _ann ) --- semantic domain -type T_RowConstraint = Environment -> - ( RowConstraint) -data Inh_RowConstraint = Inh_RowConstraint {env_Inh_RowConstraint :: Environment} -data Syn_RowConstraint = Syn_RowConstraint {annotatedTree_Syn_RowConstraint :: RowConstraint} -wrap_RowConstraint :: T_RowConstraint -> - Inh_RowConstraint -> - Syn_RowConstraint -wrap_RowConstraint sem (Inh_RowConstraint _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_RowConstraint _lhsOannotatedTree )) -sem_RowConstraint_NotNullConstraint :: Annotation -> - T_RowConstraint -sem_RowConstraint_NotNullConstraint ann_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: RowConstraint - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - NotNullConstraint ann_ - {-# LINE 4405 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4410 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_RowConstraint_NullConstraint :: Annotation -> - T_RowConstraint -sem_RowConstraint_NullConstraint ann_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: RowConstraint - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - NullConstraint ann_ - {-# LINE 4421 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4426 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_RowConstraint_RowCheckConstraint :: Annotation -> - T_Expression -> - T_RowConstraint -sem_RowConstraint_RowCheckConstraint ann_ expression_ = - (\ _lhsIenv -> - (let _expressionOenv :: Environment - _expressionIannotatedTree :: Expression - _expressionIliftedColumnName :: String - _lhsOannotatedTree :: RowConstraint - -- copy rule (down) - _expressionOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4441 "AstInternal.hs" #-} - ( _expressionIannotatedTree,_expressionIliftedColumnName) = - (expression_ _expressionOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - RowCheckConstraint ann_ _expressionIannotatedTree - {-# LINE 4448 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4453 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_RowConstraint_RowPrimaryKeyConstraint :: Annotation -> - T_RowConstraint -sem_RowConstraint_RowPrimaryKeyConstraint ann_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: RowConstraint - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - RowPrimaryKeyConstraint ann_ - {-# LINE 4464 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4469 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_RowConstraint_RowReferenceConstraint :: Annotation -> - String -> - (Maybe String) -> - T_Cascade -> - T_Cascade -> - T_RowConstraint -sem_RowConstraint_RowReferenceConstraint ann_ table_ att_ onUpdate_ onDelete_ = - (\ _lhsIenv -> - (let _onDeleteOenv :: Environment - _onDeleteIannotatedTree :: Cascade - _onUpdateOenv :: Environment - _onUpdateIannotatedTree :: Cascade - _lhsOannotatedTree :: RowConstraint - -- copy rule (down) - _onDeleteOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4488 "AstInternal.hs" #-} - ( _onDeleteIannotatedTree) = - (onDelete_ _onDeleteOenv ) - -- copy rule (down) - _onUpdateOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4495 "AstInternal.hs" #-} - ( _onUpdateIannotatedTree) = - (onUpdate_ _onUpdateOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - RowReferenceConstraint ann_ table_ att_ _onUpdateIannotatedTree _onDeleteIannotatedTree - {-# LINE 4502 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4507 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_RowConstraint_RowUniqueConstraint :: Annotation -> - T_RowConstraint -sem_RowConstraint_RowUniqueConstraint ann_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: RowConstraint - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - RowUniqueConstraint ann_ - {-# LINE 4518 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4523 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- RowConstraintList ------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Cons: - child hd : RowConstraint - child tl : RowConstraintList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type RowConstraintList = [(RowConstraint)] --- cata -sem_RowConstraintList :: RowConstraintList -> - T_RowConstraintList -sem_RowConstraintList list = - (Prelude.foldr sem_RowConstraintList_Cons sem_RowConstraintList_Nil (Prelude.map sem_RowConstraint list) ) --- semantic domain -type T_RowConstraintList = Environment -> - ( RowConstraintList) -data Inh_RowConstraintList = Inh_RowConstraintList {env_Inh_RowConstraintList :: Environment} -data Syn_RowConstraintList = Syn_RowConstraintList {annotatedTree_Syn_RowConstraintList :: RowConstraintList} -wrap_RowConstraintList :: T_RowConstraintList -> - Inh_RowConstraintList -> - Syn_RowConstraintList -wrap_RowConstraintList sem (Inh_RowConstraintList _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_RowConstraintList _lhsOannotatedTree )) -sem_RowConstraintList_Cons :: T_RowConstraint -> - T_RowConstraintList -> - T_RowConstraintList -sem_RowConstraintList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: RowConstraintList - _hdIannotatedTree :: RowConstraint - _lhsOannotatedTree :: RowConstraintList - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4574 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4579 "AstInternal.hs" #-} - ( _tlIannotatedTree) = - (tl_ _tlOenv ) - ( _hdIannotatedTree) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 4588 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4593 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_RowConstraintList_Nil :: T_RowConstraintList -sem_RowConstraintList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: RowConstraintList - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 4603 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4608 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- SelectExpression -------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative CombineSelect: - child ann : {Annotation} - child ctype : CombineType - child sel1 : SelectExpression - child sel2 : SelectExpression - visit 0: - local backTree : _ - local tpe : _ - alternative Select: - child ann : {Annotation} - child selDistinct : Distinct - child selSelectList : SelectList - child selTref : MaybeTableRef - child selWhere : MaybeBoolExpression - child selGroupBy : ExpressionList - child selHaving : MaybeBoolExpression - child selOrderBy : ExpressionList - child selDir : Direction - child selLimit : MaybeExpression - child selOffset : MaybeExpression - visit 0: - local newEnv : _ - local backTree : _ - local tpe : _ - alternative Values: - child ann : {Annotation} - child vll : ExpressionListList - visit 0: - local backTree : _ - local tpe : _ --} -data SelectExpression = CombineSelect (Annotation) (CombineType) (SelectExpression) (SelectExpression) - | Select (Annotation) (Distinct) (SelectList) (MaybeTableRef) (MaybeBoolExpression) (ExpressionList) (MaybeBoolExpression) (ExpressionList) (Direction) (MaybeExpression) (MaybeExpression) - | Values (Annotation) (ExpressionListList) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_SelectExpression :: SelectExpression -> - T_SelectExpression -sem_SelectExpression (CombineSelect _ann _ctype _sel1 _sel2 ) = - (sem_SelectExpression_CombineSelect _ann (sem_CombineType _ctype ) (sem_SelectExpression _sel1 ) (sem_SelectExpression _sel2 ) ) -sem_SelectExpression (Select _ann _selDistinct _selSelectList _selTref _selWhere _selGroupBy _selHaving _selOrderBy _selDir _selLimit _selOffset ) = - (sem_SelectExpression_Select _ann (sem_Distinct _selDistinct ) (sem_SelectList _selSelectList ) (sem_MaybeTableRef _selTref ) (sem_MaybeBoolExpression _selWhere ) (sem_ExpressionList _selGroupBy ) (sem_MaybeBoolExpression _selHaving ) (sem_ExpressionList _selOrderBy ) (sem_Direction _selDir ) (sem_MaybeExpression _selLimit ) (sem_MaybeExpression _selOffset ) ) -sem_SelectExpression (Values _ann _vll ) = - (sem_SelectExpression_Values _ann (sem_ExpressionListList _vll ) ) --- semantic domain -type T_SelectExpression = Environment -> - ( SelectExpression) -data Inh_SelectExpression = Inh_SelectExpression {env_Inh_SelectExpression :: Environment} -data Syn_SelectExpression = Syn_SelectExpression {annotatedTree_Syn_SelectExpression :: SelectExpression} -wrap_SelectExpression :: T_SelectExpression -> - Inh_SelectExpression -> - Syn_SelectExpression -wrap_SelectExpression sem (Inh_SelectExpression _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_SelectExpression _lhsOannotatedTree )) -sem_SelectExpression_CombineSelect :: Annotation -> - T_CombineType -> - T_SelectExpression -> - T_SelectExpression -> - T_SelectExpression -sem_SelectExpression_CombineSelect ann_ ctype_ sel1_ sel2_ = - (\ _lhsIenv -> - (let _sel2Oenv :: Environment - _sel1Oenv :: Environment - _sel2IannotatedTree :: SelectExpression - _sel1IannotatedTree :: SelectExpression - _ctypeOenv :: Environment - _ctypeIannotatedTree :: CombineType - _lhsOannotatedTree :: SelectExpression - -- copy rule (down) - _sel2Oenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4692 "AstInternal.hs" #-} - -- copy rule (down) - _sel1Oenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4697 "AstInternal.hs" #-} - ( _sel2IannotatedTree) = - (sel2_ _sel2Oenv ) - ( _sel1IannotatedTree) = - (sel1_ _sel1Oenv ) - -- copy rule (down) - _ctypeOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4706 "AstInternal.hs" #-} - ( _ctypeIannotatedTree) = - (ctype_ _ctypeOenv ) - -- "./TypeChecking.ag"(line 417, column 9) - _backTree = - {-# LINE 417 "./TypeChecking.ag" #-} - CombineSelect ann_ _ctypeIannotatedTree - _sel1IannotatedTree - _sel2IannotatedTree - {-# LINE 4715 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 412, column 9) - _tpe = - {-# LINE 412 "./TypeChecking.ag" #-} - let sel1t = getTypeAnnotation _sel1IannotatedTree - sel2t = getTypeAnnotation _sel2IannotatedTree - in chainTypeCheckFailed [sel1t, sel2t] $ - typeCheckCombineSelect _lhsIenv sel1t sel2t - {-# LINE 4723 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 379, column 9) - _lhsOannotatedTree = - {-# LINE 379 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 4731 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_SelectExpression_Select :: Annotation -> - T_Distinct -> - T_SelectList -> - T_MaybeTableRef -> - T_MaybeBoolExpression -> - T_ExpressionList -> - T_MaybeBoolExpression -> - T_ExpressionList -> - T_Direction -> - T_MaybeExpression -> - T_MaybeExpression -> - T_SelectExpression -sem_SelectExpression_Select ann_ selDistinct_ selSelectList_ selTref_ selWhere_ selGroupBy_ selHaving_ selOrderBy_ selDir_ selLimit_ selOffset_ = - (\ _lhsIenv -> - (let _selOffsetOenv :: Environment - _selLimitOenv :: Environment - _selOrderByOenv :: Environment - _selHavingOenv :: Environment - _selGroupByOenv :: Environment - _selTrefOenv :: Environment - _selTrefIannotatedTree :: MaybeTableRef - _selTrefIidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _selTrefIjoinIdens :: ([String]) - _selWhereOenv :: Environment - _selSelectListOenv :: Environment - _selOffsetIannotatedTree :: MaybeExpression - _selOffsetIexprType :: (Maybe Type) - _selLimitIannotatedTree :: MaybeExpression - _selLimitIexprType :: (Maybe Type) - _selDirOenv :: Environment - _selDirIannotatedTree :: Direction - _selOrderByIannotatedTree :: ExpressionList - _selOrderByItypeList :: ([Type]) - _selHavingIannotatedTree :: MaybeBoolExpression - _selGroupByIannotatedTree :: ExpressionList - _selGroupByItypeList :: ([Type]) - _selWhereIannotatedTree :: MaybeBoolExpression - _selSelectListIannotatedTree :: SelectList - _selSelectListIlistType :: Type - _selDistinctOenv :: Environment - _selDistinctIannotatedTree :: Distinct - _lhsOannotatedTree :: SelectExpression - -- copy rule (down) - _selOffsetOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4779 "AstInternal.hs" #-} - -- copy rule (down) - _selLimitOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4784 "AstInternal.hs" #-} - -- copy rule (down) - _selOrderByOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4789 "AstInternal.hs" #-} - -- copy rule (down) - _selHavingOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4794 "AstInternal.hs" #-} - -- copy rule (down) - _selGroupByOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4799 "AstInternal.hs" #-} - -- copy rule (down) - _selTrefOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4804 "AstInternal.hs" #-} - ( _selTrefIannotatedTree,_selTrefIidens,_selTrefIjoinIdens) = - (selTref_ _selTrefOenv ) - -- "./TypeChecking.ag"(line 597, column 10) - _newEnv = - {-# LINE 597 "./TypeChecking.ag" #-} - case updateEnvironment _lhsIenv - (convertToNewStyleUpdates _selTrefIidens _selTrefIjoinIdens) of - Left x -> error $ show x - Right e -> e - {-# LINE 4814 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 602, column 10) - _selWhereOenv = - {-# LINE 602 "./TypeChecking.ag" #-} - _newEnv - {-# LINE 4819 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 601, column 10) - _selSelectListOenv = - {-# LINE 601 "./TypeChecking.ag" #-} - _newEnv - {-# LINE 4824 "AstInternal.hs" #-} - ( _selOffsetIannotatedTree,_selOffsetIexprType) = - (selOffset_ _selOffsetOenv ) - ( _selLimitIannotatedTree,_selLimitIexprType) = - (selLimit_ _selLimitOenv ) - -- copy rule (down) - _selDirOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4833 "AstInternal.hs" #-} - ( _selDirIannotatedTree) = - (selDir_ _selDirOenv ) - ( _selOrderByIannotatedTree,_selOrderByItypeList) = - (selOrderBy_ _selOrderByOenv ) - ( _selHavingIannotatedTree) = - (selHaving_ _selHavingOenv ) - ( _selGroupByIannotatedTree,_selGroupByItypeList) = - (selGroupBy_ _selGroupByOenv ) - ( _selWhereIannotatedTree) = - (selWhere_ _selWhereOenv ) - ( _selSelectListIannotatedTree,_selSelectListIlistType) = - (selSelectList_ _selSelectListOenv ) - -- copy rule (down) - _selDistinctOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4850 "AstInternal.hs" #-} - ( _selDistinctIannotatedTree) = - (selDistinct_ _selDistinctOenv ) - -- "./TypeChecking.ag"(line 400, column 9) - _backTree = - {-# LINE 400 "./TypeChecking.ag" #-} - Select ann_ - _selDistinctIannotatedTree - _selSelectListIannotatedTree - _selTrefIannotatedTree - _selWhereIannotatedTree - _selGroupByIannotatedTree - _selHavingIannotatedTree - _selOrderByIannotatedTree - _selDirIannotatedTree - _selLimitIannotatedTree - _selOffsetIannotatedTree - {-# LINE 4867 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 391, column 9) - _tpe = - {-# LINE 391 "./TypeChecking.ag" #-} - do - let trefType = fromMaybe typeBool $ fmap getTypeAnnotation - _selTrefIannotatedTree - slType = _selSelectListIlistType - chainTypeCheckFailed [trefType, slType] $ - Right $ case slType of - UnnamedCompositeType [(_,Pseudo Void)] -> Pseudo Void - _ -> SetOfType slType - {-# LINE 4879 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 379, column 9) - _lhsOannotatedTree = - {-# LINE 379 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 4887 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_SelectExpression_Values :: Annotation -> - T_ExpressionListList -> - T_SelectExpression -sem_SelectExpression_Values ann_ vll_ = - (\ _lhsIenv -> - (let _vllOenv :: Environment - _vllIannotatedTree :: ExpressionListList - _vllItypeListList :: ([[Type]]) - _lhsOannotatedTree :: SelectExpression - -- copy rule (down) - _vllOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4902 "AstInternal.hs" #-} - ( _vllIannotatedTree,_vllItypeListList) = - (vll_ _vllOenv ) - -- "./TypeChecking.ag"(line 389, column 9) - _backTree = - {-# LINE 389 "./TypeChecking.ag" #-} - Values ann_ _vllIannotatedTree - {-# LINE 4909 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 386, column 9) - _tpe = - {-# LINE 386 "./TypeChecking.ag" #-} - typeCheckValuesExpr - _lhsIenv - _vllItypeListList - {-# LINE 4916 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 379, column 9) - _lhsOannotatedTree = - {-# LINE 379 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 4924 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- SelectItem -------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - columnName : String - itemType : Type - alternatives: - alternative SelExp: - child ann : {Annotation} - child ex : Expression - visit 0: - local annotatedTree : _ - alternative SelectItem: - child ann : {Annotation} - child ex : Expression - child name : {String} - visit 0: - local annotatedTree : _ --} -data SelectItem = SelExp (Annotation) (Expression) - | SelectItem (Annotation) (Expression) (String) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_SelectItem :: SelectItem -> - T_SelectItem -sem_SelectItem (SelExp _ann _ex ) = - (sem_SelectItem_SelExp _ann (sem_Expression _ex ) ) -sem_SelectItem (SelectItem _ann _ex _name ) = - (sem_SelectItem_SelectItem _ann (sem_Expression _ex ) _name ) --- semantic domain -type T_SelectItem = Environment -> - ( SelectItem,String,Type) -data Inh_SelectItem = Inh_SelectItem {env_Inh_SelectItem :: Environment} -data Syn_SelectItem = Syn_SelectItem {annotatedTree_Syn_SelectItem :: SelectItem,columnName_Syn_SelectItem :: String,itemType_Syn_SelectItem :: Type} -wrap_SelectItem :: T_SelectItem -> - Inh_SelectItem -> - Syn_SelectItem -wrap_SelectItem sem (Inh_SelectItem _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOcolumnName,_lhsOitemType) = - (sem _lhsIenv ) - in (Syn_SelectItem _lhsOannotatedTree _lhsOcolumnName _lhsOitemType )) -sem_SelectItem_SelExp :: Annotation -> - T_Expression -> - T_SelectItem -sem_SelectItem_SelExp ann_ ex_ = - (\ _lhsIenv -> - (let _exOenv :: Environment - _exIannotatedTree :: Expression - _exIliftedColumnName :: String - _lhsOannotatedTree :: SelectItem - _lhsOcolumnName :: String - _lhsOitemType :: Type - -- copy rule (down) - _exOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 4985 "AstInternal.hs" #-} - ( _exIannotatedTree,_exIliftedColumnName) = - (ex_ _exOenv ) - -- "./TypeChecking.ag"(line 543, column 9) - _annotatedTree = - {-# LINE 543 "./TypeChecking.ag" #-} - SelExp ann_ $ fixStar _exIannotatedTree - {-# LINE 4992 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 4997 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 655, column 14) - _lhsOcolumnName = - {-# LINE 655 "./TypeChecking.ag" #-} - case _exIliftedColumnName of - "" -> "?column?" - s -> s - {-# LINE 5004 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 538, column 9) - _lhsOitemType = - {-# LINE 538 "./TypeChecking.ag" #-} - getTypeAnnotation _exIannotatedTree - {-# LINE 5009 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOcolumnName,_lhsOitemType))) -sem_SelectItem_SelectItem :: Annotation -> - T_Expression -> - String -> - T_SelectItem -sem_SelectItem_SelectItem ann_ ex_ name_ = - (\ _lhsIenv -> - (let _exOenv :: Environment - _exIannotatedTree :: Expression - _exIliftedColumnName :: String - _lhsOannotatedTree :: SelectItem - _lhsOcolumnName :: String - _lhsOitemType :: Type - -- copy rule (down) - _exOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5027 "AstInternal.hs" #-} - ( _exIannotatedTree,_exIliftedColumnName) = - (ex_ _exOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - SelectItem ann_ _exIannotatedTree name_ - {-# LINE 5034 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5039 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 658, column 18) - _lhsOcolumnName = - {-# LINE 658 "./TypeChecking.ag" #-} - name_ - {-# LINE 5044 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 538, column 9) - _lhsOitemType = - {-# LINE 538 "./TypeChecking.ag" #-} - getTypeAnnotation _exIannotatedTree - {-# LINE 5049 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOcolumnName,_lhsOitemType))) --- SelectItemList ---------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - listType : Type - alternatives: - alternative Cons: - child hd : SelectItem - child tl : SelectItemList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type SelectItemList = [(SelectItem)] --- cata -sem_SelectItemList :: SelectItemList -> - T_SelectItemList -sem_SelectItemList list = - (Prelude.foldr sem_SelectItemList_Cons sem_SelectItemList_Nil (Prelude.map sem_SelectItem list) ) --- semantic domain -type T_SelectItemList = Environment -> - ( SelectItemList,Type) -data Inh_SelectItemList = Inh_SelectItemList {env_Inh_SelectItemList :: Environment} -data Syn_SelectItemList = Syn_SelectItemList {annotatedTree_Syn_SelectItemList :: SelectItemList,listType_Syn_SelectItemList :: Type} -wrap_SelectItemList :: T_SelectItemList -> - Inh_SelectItemList -> - Syn_SelectItemList -wrap_SelectItemList sem (Inh_SelectItemList _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOlistType) = - (sem _lhsIenv ) - in (Syn_SelectItemList _lhsOannotatedTree _lhsOlistType )) -sem_SelectItemList_Cons :: T_SelectItem -> - T_SelectItemList -> - T_SelectItemList -sem_SelectItemList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: SelectItemList - _tlIlistType :: Type - _hdIannotatedTree :: SelectItem - _hdIcolumnName :: String - _hdIitemType :: Type - _lhsOannotatedTree :: SelectItemList - _lhsOlistType :: Type - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5105 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5110 "AstInternal.hs" #-} - ( _tlIannotatedTree,_tlIlistType) = - (tl_ _tlOenv ) - ( _hdIannotatedTree,_hdIcolumnName,_hdIitemType) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 5119 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5124 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 531, column 12) - _lhsOlistType = - {-# LINE 531 "./TypeChecking.ag" #-} - doSelectItemListTpe _lhsIenv _hdIcolumnName _hdIitemType _tlIlistType - {-# LINE 5129 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOlistType))) -sem_SelectItemList_Nil :: T_SelectItemList -sem_SelectItemList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: SelectItemList - _lhsOlistType :: Type - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 5140 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5145 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 532, column 11) - _lhsOlistType = - {-# LINE 532 "./TypeChecking.ag" #-} - UnnamedCompositeType [] - {-# LINE 5150 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOlistType))) --- SelectList -------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - listType : Type - alternatives: - alternative SelectList: - child ann : {Annotation} - child items : SelectItemList - child stringList : StringList - visit 0: - local annotatedTree : _ --} -data SelectList = SelectList (Annotation) (SelectItemList) (StringList) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_SelectList :: SelectList -> - T_SelectList -sem_SelectList (SelectList _ann _items _stringList ) = - (sem_SelectList_SelectList _ann (sem_SelectItemList _items ) (sem_StringList _stringList ) ) --- semantic domain -type T_SelectList = Environment -> - ( SelectList,Type) -data Inh_SelectList = Inh_SelectList {env_Inh_SelectList :: Environment} -data Syn_SelectList = Syn_SelectList {annotatedTree_Syn_SelectList :: SelectList,listType_Syn_SelectList :: Type} -wrap_SelectList :: T_SelectList -> - Inh_SelectList -> - Syn_SelectList -wrap_SelectList sem (Inh_SelectList _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOlistType) = - (sem _lhsIenv ) - in (Syn_SelectList _lhsOannotatedTree _lhsOlistType )) -sem_SelectList_SelectList :: Annotation -> - T_SelectItemList -> - T_StringList -> - T_SelectList -sem_SelectList_SelectList ann_ items_ stringList_ = - (\ _lhsIenv -> - (let _itemsOenv :: Environment - _stringListOenv :: Environment - _stringListIannotatedTree :: StringList - _stringListIstrings :: ([String]) - _itemsIannotatedTree :: SelectItemList - _itemsIlistType :: Type - _lhsOannotatedTree :: SelectList - _lhsOlistType :: Type - -- copy rule (down) - _itemsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5205 "AstInternal.hs" #-} - -- copy rule (down) - _stringListOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5210 "AstInternal.hs" #-} - ( _stringListIannotatedTree,_stringListIstrings) = - (stringList_ _stringListOenv ) - ( _itemsIannotatedTree,_itemsIlistType) = - (items_ _itemsOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - SelectList ann_ _itemsIannotatedTree _stringListIannotatedTree - {-# LINE 5219 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5224 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 571, column 9) - _lhsOlistType = - {-# LINE 571 "./TypeChecking.ag" #-} - _itemsIlistType - {-# LINE 5229 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOlistType))) --- SetClause --------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - pairs : [(String,Type)] - rowSetError : Maybe TypeError - alternatives: - alternative RowSetClause: - child ann : {Annotation} - child atts : StringList - child vals : ExpressionList - visit 0: - local annotatedTree : _ - local rowSetError : _ - alternative SetClause: - child ann : {Annotation} - child att : {String} - child val : Expression - visit 0: - local annotatedTree : _ --} -data SetClause = RowSetClause (Annotation) (StringList) (ExpressionList) - | SetClause (Annotation) (String) (Expression) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_SetClause :: SetClause -> - T_SetClause -sem_SetClause (RowSetClause _ann _atts _vals ) = - (sem_SetClause_RowSetClause _ann (sem_StringList _atts ) (sem_ExpressionList _vals ) ) -sem_SetClause (SetClause _ann _att _val ) = - (sem_SetClause_SetClause _ann _att (sem_Expression _val ) ) --- semantic domain -type T_SetClause = Environment -> - ( SetClause,([(String,Type)]),(Maybe TypeError)) -data Inh_SetClause = Inh_SetClause {env_Inh_SetClause :: Environment} -data Syn_SetClause = Syn_SetClause {annotatedTree_Syn_SetClause :: SetClause,pairs_Syn_SetClause :: [(String,Type)],rowSetError_Syn_SetClause :: Maybe TypeError} -wrap_SetClause :: T_SetClause -> - Inh_SetClause -> - Syn_SetClause -wrap_SetClause sem (Inh_SetClause _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetError) = - (sem _lhsIenv ) - in (Syn_SetClause _lhsOannotatedTree _lhsOpairs _lhsOrowSetError )) -sem_SetClause_RowSetClause :: Annotation -> - T_StringList -> - T_ExpressionList -> - T_SetClause -sem_SetClause_RowSetClause ann_ atts_ vals_ = - (\ _lhsIenv -> - (let _valsOenv :: Environment - _valsIannotatedTree :: ExpressionList - _valsItypeList :: ([Type]) - _attsOenv :: Environment - _attsIannotatedTree :: StringList - _attsIstrings :: ([String]) - _lhsOannotatedTree :: SetClause - _lhsOpairs :: ([(String,Type)]) - _lhsOrowSetError :: (Maybe TypeError) - -- copy rule (down) - _valsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5296 "AstInternal.hs" #-} - ( _valsIannotatedTree,_valsItypeList) = - (vals_ _valsOenv ) - -- copy rule (down) - _attsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5303 "AstInternal.hs" #-} - ( _attsIannotatedTree,_attsIstrings) = - (atts_ _attsOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - RowSetClause ann_ _attsIannotatedTree _valsIannotatedTree - {-# LINE 5310 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5315 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 744, column 9) - _lhsOpairs = - {-# LINE 744 "./TypeChecking.ag" #-} - zip _attsIstrings $ getRowTypes _valsItypeList - {-# LINE 5320 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 738, column 9) - _rowSetError = - {-# LINE 738 "./TypeChecking.ag" #-} - let atts = _attsIstrings - types = getRowTypes _valsItypeList - in if length atts /= length types - then Just WrongNumberOfColumns - else Nothing - {-# LINE 5329 "AstInternal.hs" #-} - -- copy rule (from local) - _lhsOrowSetError = - {-# LINE 731 "./TypeChecking.ag" #-} - _rowSetError - {-# LINE 5334 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetError))) -sem_SetClause_SetClause :: Annotation -> - String -> - T_Expression -> - T_SetClause -sem_SetClause_SetClause ann_ att_ val_ = - (\ _lhsIenv -> - (let _valOenv :: Environment - _valIannotatedTree :: Expression - _valIliftedColumnName :: String - _lhsOannotatedTree :: SetClause - _lhsOpairs :: ([(String,Type)]) - _lhsOrowSetError :: (Maybe TypeError) - -- copy rule (down) - _valOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5352 "AstInternal.hs" #-} - ( _valIannotatedTree,_valIliftedColumnName) = - (val_ _valOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - SetClause ann_ att_ _valIannotatedTree - {-# LINE 5359 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5364 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 735, column 9) - _lhsOpairs = - {-# LINE 735 "./TypeChecking.ag" #-} - [(att_, getTypeAnnotation _valIannotatedTree)] - {-# LINE 5369 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 736, column 9) - _lhsOrowSetError = - {-# LINE 736 "./TypeChecking.ag" #-} - Nothing - {-# LINE 5374 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetError))) --- SetClauseList ----------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - pairs : [(String,Type)] - rowSetErrors : [TypeError] - alternatives: - alternative Cons: - child hd : SetClause - child tl : SetClauseList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type SetClauseList = [(SetClause)] --- cata -sem_SetClauseList :: SetClauseList -> - T_SetClauseList -sem_SetClauseList list = - (Prelude.foldr sem_SetClauseList_Cons sem_SetClauseList_Nil (Prelude.map sem_SetClause list) ) --- semantic domain -type T_SetClauseList = Environment -> - ( SetClauseList,([(String,Type)]),([TypeError])) -data Inh_SetClauseList = Inh_SetClauseList {env_Inh_SetClauseList :: Environment} -data Syn_SetClauseList = Syn_SetClauseList {annotatedTree_Syn_SetClauseList :: SetClauseList,pairs_Syn_SetClauseList :: [(String,Type)],rowSetErrors_Syn_SetClauseList :: [TypeError]} -wrap_SetClauseList :: T_SetClauseList -> - Inh_SetClauseList -> - Syn_SetClauseList -wrap_SetClauseList sem (Inh_SetClauseList _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetErrors) = - (sem _lhsIenv ) - in (Syn_SetClauseList _lhsOannotatedTree _lhsOpairs _lhsOrowSetErrors )) -sem_SetClauseList_Cons :: T_SetClause -> - T_SetClauseList -> - T_SetClauseList -sem_SetClauseList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: SetClauseList - _tlIpairs :: ([(String,Type)]) - _tlIrowSetErrors :: ([TypeError]) - _hdIannotatedTree :: SetClause - _hdIpairs :: ([(String,Type)]) - _hdIrowSetError :: (Maybe TypeError) - _lhsOannotatedTree :: SetClauseList - _lhsOpairs :: ([(String,Type)]) - _lhsOrowSetErrors :: ([TypeError]) - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5433 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5438 "AstInternal.hs" #-} - ( _tlIannotatedTree,_tlIpairs,_tlIrowSetErrors) = - (tl_ _tlOenv ) - ( _hdIannotatedTree,_hdIpairs,_hdIrowSetError) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 5447 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5452 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 725, column 10) - _lhsOpairs = - {-# LINE 725 "./TypeChecking.ag" #-} - _hdIpairs ++ _tlIpairs - {-# LINE 5457 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 726, column 10) - _lhsOrowSetErrors = - {-# LINE 726 "./TypeChecking.ag" #-} - maybeToList _hdIrowSetError ++ _tlIrowSetErrors - {-# LINE 5462 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetErrors))) -sem_SetClauseList_Nil :: T_SetClauseList -sem_SetClauseList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: SetClauseList - _lhsOpairs :: ([(String,Type)]) - _lhsOrowSetErrors :: ([TypeError]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 5474 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5479 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 727, column 9) - _lhsOpairs = - {-# LINE 727 "./TypeChecking.ag" #-} - [] - {-# LINE 5484 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 728, column 9) - _lhsOrowSetErrors = - {-# LINE 728 "./TypeChecking.ag" #-} - [] - {-# LINE 5489 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetErrors))) --- Statement --------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - envUpdates : [EnvironmentUpdate] - alternatives: - alternative Assignment: - child ann : {Annotation} - child target : {String} - child value : Expression - visit 0: - local annotatedTree : _ - alternative CaseStatement: - child ann : {Annotation} - child val : Expression - child cases : ExpressionListStatementListPairList - child els : StatementList - visit 0: - local annotatedTree : _ - alternative ContinueStatement: - child ann : {Annotation} - visit 0: - local annotatedTree : _ - alternative Copy: - child ann : {Annotation} - child table : {String} - child targetCols : StringList - child source : CopySource - visit 0: - local annotatedTree : _ - alternative CopyData: - child ann : {Annotation} - child insData : {String} - visit 0: - local annotatedTree : _ - alternative CreateDomain: - child ann : {Annotation} - child name : {String} - child typ : TypeName - child check : MaybeBoolExpression - visit 0: - local envUpdates : _ - local statementInfo : _ - local backTree : _ - local tpe : _ - alternative CreateFunction: - child ann : {Annotation} - child lang : Language - child name : {String} - child params : ParamDefList - child rettype : TypeName - child bodyQuote : {String} - child body : FnBody - child vol : Volatility - visit 0: - local envUpdates : _ - local statementInfo : _ - local backTree : _ - local tpe : _ - alternative CreateTable: - child ann : {Annotation} - child name : {String} - child atts : AttributeDefList - child cons : ConstraintList - visit 0: - local envUpdates : _ - local statementInfo : _ - local backTree : _ - local tpe : _ - alternative CreateTableAs: - child ann : {Annotation} - child name : {String} - child expr : SelectExpression - visit 0: - local annotatedTree : _ - local selType : _ - local attrs : _ - local envUpdates : _ - alternative CreateType: - child ann : {Annotation} - child name : {String} - child atts : TypeAttributeDefList - visit 0: - local envUpdates : _ - local statementInfo : _ - local backTree : _ - local tpe : _ - alternative CreateView: - child ann : {Annotation} - child name : {String} - child expr : SelectExpression - visit 0: - local attrs : _ - local envUpdates : _ - local statementInfo : _ - local backTree : _ - local tpe : _ - alternative Delete: - child ann : {Annotation} - child table : {String} - child whr : MaybeBoolExpression - child returning : {Maybe SelectList} - visit 0: - local envUpdates : _ - local backTree : _ - local statementInfo : _ - local tpe : _ - alternative DropFunction: - child ann : {Annotation} - child ifE : IfExists - child sigs : StringStringListPairList - child cascade : Cascade - visit 0: - local annotatedTree : _ - alternative DropSomething: - child ann : {Annotation} - child dropType : DropType - child ifE : IfExists - child names : StringList - child cascade : Cascade - visit 0: - local annotatedTree : _ - alternative Execute: - child ann : {Annotation} - child expr : Expression - visit 0: - local annotatedTree : _ - alternative ExecuteInto: - child ann : {Annotation} - child expr : Expression - child targets : StringList - visit 0: - local annotatedTree : _ - alternative ForIntegerStatement: - child ann : {Annotation} - child var : {String} - child from : Expression - child to : Expression - child sts : StatementList - visit 0: - local annotatedTree : _ - alternative ForSelectStatement: - child ann : {Annotation} - child var : {String} - child sel : SelectExpression - child sts : StatementList - visit 0: - local annotatedTree : _ - alternative If: - child ann : {Annotation} - child cases : ExpressionStatementListPairList - child els : StatementList - visit 0: - local annotatedTree : _ - alternative Insert: - child ann : {Annotation} - child table : {String} - child targetCols : StringList - child insData : SelectExpression - child returning : {Maybe SelectList} - visit 0: - local envUpdates : _ - local backTree : _ - local columnStuff : _ - local statementInfo : _ - local tpe : _ - alternative NullStatement: - child ann : {Annotation} - visit 0: - local annotatedTree : _ - alternative Perform: - child ann : {Annotation} - child expr : Expression - visit 0: - local annotatedTree : _ - alternative Raise: - child ann : {Annotation} - child level : RaiseType - child message : {String} - child args : ExpressionList - visit 0: - local annotatedTree : _ - alternative Return: - child ann : {Annotation} - child value : MaybeExpression - visit 0: - local statementInfo : _ - local envUpdates : _ - local backTree : _ - local tpe : _ - alternative ReturnNext: - child ann : {Annotation} - child expr : Expression - visit 0: - local annotatedTree : _ - alternative ReturnQuery: - child ann : {Annotation} - child sel : SelectExpression - visit 0: - local annotatedTree : _ - alternative SelectStatement: - child ann : {Annotation} - child ex : SelectExpression - visit 0: - local envUpdates : _ - local backTree : _ - local statementInfo : _ - local tpe : _ - alternative Truncate: - child ann : {Annotation} - child tables : StringList - child restartIdentity : RestartIdentity - child cascade : Cascade - visit 0: - local annotatedTree : _ - alternative Update: - child ann : {Annotation} - child table : {String} - child assigns : SetClauseList - child whr : MaybeBoolExpression - child returning : {Maybe SelectList} - visit 0: - local envUpdates : _ - local backTree : _ - local columnsConsistent : _ - local statementInfo : _ - local tpe : _ - alternative WhileStatement: - child ann : {Annotation} - child expr : Expression - child sts : StatementList - visit 0: - local annotatedTree : _ --} -data Statement = Assignment (Annotation) (String) (Expression) - | CaseStatement (Annotation) (Expression) (ExpressionListStatementListPairList) (StatementList) - | ContinueStatement (Annotation) - | Copy (Annotation) (String) (StringList) (CopySource) - | CopyData (Annotation) (String) - | CreateDomain (Annotation) (String) (TypeName) (MaybeBoolExpression) - | CreateFunction (Annotation) (Language) (String) (ParamDefList) (TypeName) (String) (FnBody) (Volatility) - | CreateTable (Annotation) (String) (AttributeDefList) (ConstraintList) - | CreateTableAs (Annotation) (String) (SelectExpression) - | CreateType (Annotation) (String) (TypeAttributeDefList) - | CreateView (Annotation) (String) (SelectExpression) - | Delete (Annotation) (String) (MaybeBoolExpression) (Maybe SelectList) - | DropFunction (Annotation) (IfExists) (StringStringListPairList) (Cascade) - | DropSomething (Annotation) (DropType) (IfExists) (StringList) (Cascade) - | Execute (Annotation) (Expression) - | ExecuteInto (Annotation) (Expression) (StringList) - | ForIntegerStatement (Annotation) (String) (Expression) (Expression) (StatementList) - | ForSelectStatement (Annotation) (String) (SelectExpression) (StatementList) - | If (Annotation) (ExpressionStatementListPairList) (StatementList) - | Insert (Annotation) (String) (StringList) (SelectExpression) (Maybe SelectList) - | NullStatement (Annotation) - | Perform (Annotation) (Expression) - | Raise (Annotation) (RaiseType) (String) (ExpressionList) - | Return (Annotation) (MaybeExpression) - | ReturnNext (Annotation) (Expression) - | ReturnQuery (Annotation) (SelectExpression) - | SelectStatement (Annotation) (SelectExpression) - | Truncate (Annotation) (StringList) (RestartIdentity) (Cascade) - | Update (Annotation) (String) (SetClauseList) (MaybeBoolExpression) (Maybe SelectList) - | WhileStatement (Annotation) (Expression) (StatementList) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_Statement :: Statement -> - T_Statement -sem_Statement (Assignment _ann _target _value ) = - (sem_Statement_Assignment _ann _target (sem_Expression _value ) ) -sem_Statement (CaseStatement _ann _val _cases _els ) = - (sem_Statement_CaseStatement _ann (sem_Expression _val ) (sem_ExpressionListStatementListPairList _cases ) (sem_StatementList _els ) ) -sem_Statement (ContinueStatement _ann ) = - (sem_Statement_ContinueStatement _ann ) -sem_Statement (Copy _ann _table _targetCols _source ) = - (sem_Statement_Copy _ann _table (sem_StringList _targetCols ) (sem_CopySource _source ) ) -sem_Statement (CopyData _ann _insData ) = - (sem_Statement_CopyData _ann _insData ) -sem_Statement (CreateDomain _ann _name _typ _check ) = - (sem_Statement_CreateDomain _ann _name (sem_TypeName _typ ) (sem_MaybeBoolExpression _check ) ) -sem_Statement (CreateFunction _ann _lang _name _params _rettype _bodyQuote _body _vol ) = - (sem_Statement_CreateFunction _ann (sem_Language _lang ) _name (sem_ParamDefList _params ) (sem_TypeName _rettype ) _bodyQuote (sem_FnBody _body ) (sem_Volatility _vol ) ) -sem_Statement (CreateTable _ann _name _atts _cons ) = - (sem_Statement_CreateTable _ann _name (sem_AttributeDefList _atts ) (sem_ConstraintList _cons ) ) -sem_Statement (CreateTableAs _ann _name _expr ) = - (sem_Statement_CreateTableAs _ann _name (sem_SelectExpression _expr ) ) -sem_Statement (CreateType _ann _name _atts ) = - (sem_Statement_CreateType _ann _name (sem_TypeAttributeDefList _atts ) ) -sem_Statement (CreateView _ann _name _expr ) = - (sem_Statement_CreateView _ann _name (sem_SelectExpression _expr ) ) -sem_Statement (Delete _ann _table _whr _returning ) = - (sem_Statement_Delete _ann _table (sem_MaybeBoolExpression _whr ) _returning ) -sem_Statement (DropFunction _ann _ifE _sigs _cascade ) = - (sem_Statement_DropFunction _ann (sem_IfExists _ifE ) (sem_StringStringListPairList _sigs ) (sem_Cascade _cascade ) ) -sem_Statement (DropSomething _ann _dropType _ifE _names _cascade ) = - (sem_Statement_DropSomething _ann (sem_DropType _dropType ) (sem_IfExists _ifE ) (sem_StringList _names ) (sem_Cascade _cascade ) ) -sem_Statement (Execute _ann _expr ) = - (sem_Statement_Execute _ann (sem_Expression _expr ) ) -sem_Statement (ExecuteInto _ann _expr _targets ) = - (sem_Statement_ExecuteInto _ann (sem_Expression _expr ) (sem_StringList _targets ) ) -sem_Statement (ForIntegerStatement _ann _var _from _to _sts ) = - (sem_Statement_ForIntegerStatement _ann _var (sem_Expression _from ) (sem_Expression _to ) (sem_StatementList _sts ) ) -sem_Statement (ForSelectStatement _ann _var _sel _sts ) = - (sem_Statement_ForSelectStatement _ann _var (sem_SelectExpression _sel ) (sem_StatementList _sts ) ) -sem_Statement (If _ann _cases _els ) = - (sem_Statement_If _ann (sem_ExpressionStatementListPairList _cases ) (sem_StatementList _els ) ) -sem_Statement (Insert _ann _table _targetCols _insData _returning ) = - (sem_Statement_Insert _ann _table (sem_StringList _targetCols ) (sem_SelectExpression _insData ) _returning ) -sem_Statement (NullStatement _ann ) = - (sem_Statement_NullStatement _ann ) -sem_Statement (Perform _ann _expr ) = - (sem_Statement_Perform _ann (sem_Expression _expr ) ) -sem_Statement (Raise _ann _level _message _args ) = - (sem_Statement_Raise _ann (sem_RaiseType _level ) _message (sem_ExpressionList _args ) ) -sem_Statement (Return _ann _value ) = - (sem_Statement_Return _ann (sem_MaybeExpression _value ) ) -sem_Statement (ReturnNext _ann _expr ) = - (sem_Statement_ReturnNext _ann (sem_Expression _expr ) ) -sem_Statement (ReturnQuery _ann _sel ) = - (sem_Statement_ReturnQuery _ann (sem_SelectExpression _sel ) ) -sem_Statement (SelectStatement _ann _ex ) = - (sem_Statement_SelectStatement _ann (sem_SelectExpression _ex ) ) -sem_Statement (Truncate _ann _tables _restartIdentity _cascade ) = - (sem_Statement_Truncate _ann (sem_StringList _tables ) (sem_RestartIdentity _restartIdentity ) (sem_Cascade _cascade ) ) -sem_Statement (Update _ann _table _assigns _whr _returning ) = - (sem_Statement_Update _ann _table (sem_SetClauseList _assigns ) (sem_MaybeBoolExpression _whr ) _returning ) -sem_Statement (WhileStatement _ann _expr _sts ) = - (sem_Statement_WhileStatement _ann (sem_Expression _expr ) (sem_StatementList _sts ) ) --- semantic domain -type T_Statement = Environment -> - ( Statement,([EnvironmentUpdate])) -data Inh_Statement = Inh_Statement {env_Inh_Statement :: Environment} -data Syn_Statement = Syn_Statement {annotatedTree_Syn_Statement :: Statement,envUpdates_Syn_Statement :: [EnvironmentUpdate]} -wrap_Statement :: T_Statement -> - Inh_Statement -> - Syn_Statement -wrap_Statement sem (Inh_Statement _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOenvUpdates) = - (sem _lhsIenv ) - in (Syn_Statement _lhsOannotatedTree _lhsOenvUpdates )) -sem_Statement_Assignment :: Annotation -> - String -> - T_Expression -> - T_Statement -sem_Statement_Assignment ann_ target_ value_ = - (\ _lhsIenv -> - (let _valueOenv :: Environment - _valueIannotatedTree :: Expression - _valueIliftedColumnName :: String - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _valueOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5849 "AstInternal.hs" #-} - ( _valueIannotatedTree,_valueIliftedColumnName) = - (value_ _valueOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Assignment ann_ target_ _valueIannotatedTree - {-# LINE 5856 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5861 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 5866 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_CaseStatement :: Annotation -> - T_Expression -> - T_ExpressionListStatementListPairList -> - T_StatementList -> - T_Statement -sem_Statement_CaseStatement ann_ val_ cases_ els_ = - (\ _lhsIenv -> - (let _elsOenv :: Environment - _casesOenv :: Environment - _valOenv :: Environment - _elsOenvUpdates :: ([EnvironmentUpdate]) - _elsIannotatedTree :: StatementList - _elsIproducedEnv :: Environment - _casesIannotatedTree :: ExpressionListStatementListPairList - _valIannotatedTree :: Expression - _valIliftedColumnName :: String - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _elsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5890 "AstInternal.hs" #-} - -- copy rule (down) - _casesOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5895 "AstInternal.hs" #-} - -- copy rule (down) - _valOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5900 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 352, column 24) - _elsOenvUpdates = - {-# LINE 352 "./TypeChecking.ag" #-} - [] - {-# LINE 5905 "AstInternal.hs" #-} - ( _elsIannotatedTree,_elsIproducedEnv) = - (els_ _elsOenv _elsOenvUpdates ) - ( _casesIannotatedTree) = - (cases_ _casesOenv ) - ( _valIannotatedTree,_valIliftedColumnName) = - (val_ _valOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - CaseStatement ann_ _valIannotatedTree _casesIannotatedTree _elsIannotatedTree - {-# LINE 5916 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5921 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 5926 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_ContinueStatement :: Annotation -> - T_Statement -sem_Statement_ContinueStatement ann_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - ContinueStatement ann_ - {-# LINE 5938 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5943 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 5948 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_Copy :: Annotation -> - String -> - T_StringList -> - T_CopySource -> - T_Statement -sem_Statement_Copy ann_ table_ targetCols_ source_ = - (\ _lhsIenv -> - (let _sourceOenv :: Environment - _sourceIannotatedTree :: CopySource - _targetColsOenv :: Environment - _targetColsIannotatedTree :: StringList - _targetColsIstrings :: ([String]) - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _sourceOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5968 "AstInternal.hs" #-} - ( _sourceIannotatedTree) = - (source_ _sourceOenv ) - -- copy rule (down) - _targetColsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 5975 "AstInternal.hs" #-} - ( _targetColsIannotatedTree,_targetColsIstrings) = - (targetCols_ _targetColsOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Copy ann_ table_ _targetColsIannotatedTree _sourceIannotatedTree - {-# LINE 5982 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 5987 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 5992 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_CopyData :: Annotation -> - String -> - T_Statement -sem_Statement_CopyData ann_ insData_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - CopyData ann_ insData_ - {-# LINE 6005 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6010 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 6015 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_CreateDomain :: Annotation -> - String -> - T_TypeName -> - T_MaybeBoolExpression -> - T_Statement -sem_Statement_CreateDomain ann_ name_ typ_ check_ = - (\ _lhsIenv -> - (let _checkOenv :: Environment - _typOenv :: Environment - _typIannotatedTree :: TypeName - _typInamedType :: Type - _checkIannotatedTree :: MaybeBoolExpression - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _checkOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6035 "AstInternal.hs" #-} - -- copy rule (down) - _typOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6040 "AstInternal.hs" #-} - ( _typIannotatedTree,_typInamedType) = - (typ_ _typOenv ) - -- "./TypeChecking.ag"(line 870, column 9) - _envUpdates = - {-# LINE 870 "./TypeChecking.ag" #-} - [EnvCreateDomain (ScalarType name_) _typInamedType] - {-# LINE 6047 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 869, column 9) - _statementInfo = - {-# LINE 869 "./TypeChecking.ag" #-} - [] - {-# LINE 6052 "AstInternal.hs" #-} - ( _checkIannotatedTree) = - (check_ _checkOenv ) - -- "./TypeChecking.ag"(line 868, column 9) - _backTree = - {-# LINE 868 "./TypeChecking.ag" #-} - CreateDomain ann_ name_ _typIannotatedTree _checkIannotatedTree - {-# LINE 6059 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 867, column 9) - _tpe = - {-# LINE 867 "./TypeChecking.ag" #-} - Right $ Pseudo Void - {-# LINE 6064 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 310, column 9) - _lhsOannotatedTree = - {-# LINE 310 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - $ Just (map StatementInfoA _statementInfo ++ - [EnvUpdates _envUpdates ]) - {-# LINE 6073 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 315, column 9) - _lhsOenvUpdates = - {-# LINE 315 "./TypeChecking.ag" #-} - _envUpdates - {-# LINE 6078 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_CreateFunction :: Annotation -> - T_Language -> - String -> - T_ParamDefList -> - T_TypeName -> - String -> - T_FnBody -> - T_Volatility -> - T_Statement -sem_Statement_CreateFunction ann_ lang_ name_ params_ rettype_ bodyQuote_ body_ vol_ = - (\ _lhsIenv -> - (let _rettypeOenv :: Environment - _paramsOenv :: Environment - _paramsIannotatedTree :: ParamDefList - _paramsIparams :: ([(String, Type)]) - _bodyOenv :: Environment - _rettypeIannotatedTree :: TypeName - _rettypeInamedType :: Type - _volOenv :: Environment - _volIannotatedTree :: Volatility - _bodyIannotatedTree :: FnBody - _langOenv :: Environment - _langIannotatedTree :: Language - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _rettypeOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6109 "AstInternal.hs" #-} - -- copy rule (down) - _paramsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6114 "AstInternal.hs" #-} - ( _paramsIannotatedTree,_paramsIparams) = - (params_ _paramsOenv ) - -- "./TypeChecking.ag"(line 932, column 9) - _bodyOenv = - {-# LINE 932 "./TypeChecking.ag" #-} - fromRight _lhsIenv $ - updateEnvironment _lhsIenv [EnvStackIDs [("", _paramsIparams) - ,(name_, _paramsIparams)]] - {-# LINE 6123 "AstInternal.hs" #-} - ( _rettypeIannotatedTree,_rettypeInamedType) = - (rettype_ _rettypeOenv ) - -- "./TypeChecking.ag"(line 930, column 9) - _envUpdates = - {-# LINE 930 "./TypeChecking.ag" #-} - [EnvCreateFunction FunName name_ (map snd _paramsIparams) _rettypeInamedType] - {-# LINE 6130 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 929, column 9) - _statementInfo = - {-# LINE 929 "./TypeChecking.ag" #-} - [] - {-# LINE 6135 "AstInternal.hs" #-} - -- copy rule (down) - _volOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6140 "AstInternal.hs" #-} - ( _volIannotatedTree) = - (vol_ _volOenv ) - ( _bodyIannotatedTree) = - (body_ _bodyOenv ) - -- copy rule (down) - _langOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6149 "AstInternal.hs" #-} - ( _langIannotatedTree) = - (lang_ _langOenv ) - -- "./TypeChecking.ag"(line 921, column 9) - _backTree = - {-# LINE 921 "./TypeChecking.ag" #-} - CreateFunction ann_ - _langIannotatedTree - name_ - _paramsIannotatedTree - _rettypeIannotatedTree - bodyQuote_ - _bodyIannotatedTree - _volIannotatedTree - {-# LINE 6163 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 920, column 9) - _tpe = - {-# LINE 920 "./TypeChecking.ag" #-} - Right $ Pseudo Void - {-# LINE 6168 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 310, column 9) - _lhsOannotatedTree = - {-# LINE 310 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - $ Just (map StatementInfoA _statementInfo ++ - [EnvUpdates _envUpdates ]) - {-# LINE 6177 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 315, column 9) - _lhsOenvUpdates = - {-# LINE 315 "./TypeChecking.ag" #-} - _envUpdates - {-# LINE 6182 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_CreateTable :: Annotation -> - String -> - T_AttributeDefList -> - T_ConstraintList -> - T_Statement -sem_Statement_CreateTable ann_ name_ atts_ cons_ = - (\ _lhsIenv -> - (let _consOenv :: Environment - _attsOenv :: Environment - _attsIannotatedTree :: AttributeDefList - _attsIattrs :: ([(String, Type)]) - _consIannotatedTree :: ConstraintList - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _consOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6202 "AstInternal.hs" #-} - -- copy rule (down) - _attsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6207 "AstInternal.hs" #-} - ( _attsIannotatedTree,_attsIattrs) = - (atts_ _attsOenv ) - -- "./TypeChecking.ag"(line 799, column 9) - _envUpdates = - {-# LINE 799 "./TypeChecking.ag" #-} - [EnvCreateTable name_ _attsIattrs []] - {-# LINE 6214 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 798, column 9) - _statementInfo = - {-# LINE 798 "./TypeChecking.ag" #-} - [] - {-# LINE 6219 "AstInternal.hs" #-} - ( _consIannotatedTree) = - (cons_ _consOenv ) - -- "./TypeChecking.ag"(line 797, column 9) - _backTree = - {-# LINE 797 "./TypeChecking.ag" #-} - CreateTable ann_ name_ _attsIannotatedTree _consIannotatedTree - {-# LINE 6226 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 796, column 9) - _tpe = - {-# LINE 796 "./TypeChecking.ag" #-} - Right $ Pseudo Void - {-# LINE 6231 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 310, column 9) - _lhsOannotatedTree = - {-# LINE 310 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - $ Just (map StatementInfoA _statementInfo ++ - [EnvUpdates _envUpdates ]) - {-# LINE 6240 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 315, column 9) - _lhsOenvUpdates = - {-# LINE 315 "./TypeChecking.ag" #-} - _envUpdates - {-# LINE 6245 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_CreateTableAs :: Annotation -> - String -> - T_SelectExpression -> - T_Statement -sem_Statement_CreateTableAs ann_ name_ expr_ = - (\ _lhsIenv -> - (let _exprOenv :: Environment - _exprIannotatedTree :: SelectExpression - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _exprOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6261 "AstInternal.hs" #-} - ( _exprIannotatedTree) = - (expr_ _exprOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - CreateTableAs ann_ name_ _exprIannotatedTree - {-# LINE 6268 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6273 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 803, column 9) - _selType = - {-# LINE 803 "./TypeChecking.ag" #-} - getTypeAnnotation _exprIannotatedTree - {-# LINE 6278 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 807, column 9) - _attrs = - {-# LINE 807 "./TypeChecking.ag" #-} - case _selType of - UnnamedCompositeType c -> c - _-> [] - {-# LINE 6285 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 810, column 9) - _envUpdates = - {-# LINE 810 "./TypeChecking.ag" #-} - [EnvCreateTable name_ _attrs []] - {-# LINE 6290 "AstInternal.hs" #-} - -- copy rule (from local) - _lhsOenvUpdates = - {-# LINE 317 "./TypeChecking.ag" #-} - _envUpdates - {-# LINE 6295 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_CreateType :: Annotation -> - String -> - T_TypeAttributeDefList -> - T_Statement -sem_Statement_CreateType ann_ name_ atts_ = - (\ _lhsIenv -> - (let _attsOenv :: Environment - _attsIannotatedTree :: TypeAttributeDefList - _attsIattrs :: ([(String, Type)]) - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _attsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6312 "AstInternal.hs" #-} - ( _attsIannotatedTree,_attsIattrs) = - (atts_ _attsOenv ) - -- "./TypeChecking.ag"(line 855, column 9) - _envUpdates = - {-# LINE 855 "./TypeChecking.ag" #-} - [EnvCreateComposite name_ _attsIattrs] - {-# LINE 6319 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 854, column 9) - _statementInfo = - {-# LINE 854 "./TypeChecking.ag" #-} - [] - {-# LINE 6324 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 853, column 9) - _backTree = - {-# LINE 853 "./TypeChecking.ag" #-} - CreateType ann_ name_ _attsIannotatedTree - {-# LINE 6329 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 852, column 9) - _tpe = - {-# LINE 852 "./TypeChecking.ag" #-} - Right $ Pseudo Void - {-# LINE 6334 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 310, column 9) - _lhsOannotatedTree = - {-# LINE 310 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - $ Just (map StatementInfoA _statementInfo ++ - [EnvUpdates _envUpdates ]) - {-# LINE 6343 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 315, column 9) - _lhsOenvUpdates = - {-# LINE 315 "./TypeChecking.ag" #-} - _envUpdates - {-# LINE 6348 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_CreateView :: Annotation -> - String -> - T_SelectExpression -> - T_Statement -sem_Statement_CreateView ann_ name_ expr_ = - (\ _lhsIenv -> - (let _exprOenv :: Environment - _exprIannotatedTree :: SelectExpression - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _exprOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6364 "AstInternal.hs" #-} - ( _exprIannotatedTree) = - (expr_ _exprOenv ) - -- "./TypeChecking.ag"(line 823, column 9) - _attrs = - {-# LINE 823 "./TypeChecking.ag" #-} - case getTypeAnnotation _exprIannotatedTree of - SetOfType (UnnamedCompositeType c) -> c - _ -> [] - {-# LINE 6373 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 826, column 9) - _envUpdates = - {-# LINE 826 "./TypeChecking.ag" #-} - [EnvCreateView name_ _attrs ] - {-# LINE 6378 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 822, column 9) - _statementInfo = - {-# LINE 822 "./TypeChecking.ag" #-} - [] - {-# LINE 6383 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 821, column 9) - _backTree = - {-# LINE 821 "./TypeChecking.ag" #-} - CreateView ann_ name_ _exprIannotatedTree - {-# LINE 6388 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 820, column 9) - _tpe = - {-# LINE 820 "./TypeChecking.ag" #-} - chainTypeCheckFailed [getTypeAnnotation _exprIannotatedTree] $ Right $ Pseudo Void - {-# LINE 6393 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 310, column 9) - _lhsOannotatedTree = - {-# LINE 310 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - $ Just (map StatementInfoA _statementInfo ++ - [EnvUpdates _envUpdates ]) - {-# LINE 6402 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 315, column 9) - _lhsOenvUpdates = - {-# LINE 315 "./TypeChecking.ag" #-} - _envUpdates - {-# LINE 6407 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_Delete :: Annotation -> - String -> - T_MaybeBoolExpression -> - (Maybe SelectList) -> - T_Statement -sem_Statement_Delete ann_ table_ whr_ returning_ = - (\ _lhsIenv -> - (let _whrOenv :: Environment - _whrIannotatedTree :: MaybeBoolExpression - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _whrOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6424 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 766, column 9) - _envUpdates = - {-# LINE 766 "./TypeChecking.ag" #-} - [] - {-# LINE 6429 "AstInternal.hs" #-} - ( _whrIannotatedTree) = - (whr_ _whrOenv ) - -- "./TypeChecking.ag"(line 765, column 9) - _backTree = - {-# LINE 765 "./TypeChecking.ag" #-} - Delete ann_ table_ _whrIannotatedTree returning_ - {-# LINE 6436 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 764, column 9) - _statementInfo = - {-# LINE 764 "./TypeChecking.ag" #-} - [DeleteInfo table_] - {-# LINE 6441 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 760, column 9) - _tpe = - {-# LINE 760 "./TypeChecking.ag" #-} - case checkRelationExists _lhsIenv table_ of - Just e -> Left [e] - Nothing -> Right $ Pseudo Void - {-# LINE 6448 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 310, column 9) - _lhsOannotatedTree = - {-# LINE 310 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - $ Just (map StatementInfoA _statementInfo ++ - [EnvUpdates _envUpdates ]) - {-# LINE 6457 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 315, column 9) - _lhsOenvUpdates = - {-# LINE 315 "./TypeChecking.ag" #-} - _envUpdates - {-# LINE 6462 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_DropFunction :: Annotation -> - T_IfExists -> - T_StringStringListPairList -> - T_Cascade -> - T_Statement -sem_Statement_DropFunction ann_ ifE_ sigs_ cascade_ = - (\ _lhsIenv -> - (let _cascadeOenv :: Environment - _cascadeIannotatedTree :: Cascade - _sigsOenv :: Environment - _sigsIannotatedTree :: StringStringListPairList - _ifEOenv :: Environment - _ifEIannotatedTree :: IfExists - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _cascadeOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6483 "AstInternal.hs" #-} - ( _cascadeIannotatedTree) = - (cascade_ _cascadeOenv ) - -- copy rule (down) - _sigsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6490 "AstInternal.hs" #-} - ( _sigsIannotatedTree) = - (sigs_ _sigsOenv ) - -- copy rule (down) - _ifEOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6497 "AstInternal.hs" #-} - ( _ifEIannotatedTree) = - (ifE_ _ifEOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - DropFunction ann_ _ifEIannotatedTree _sigsIannotatedTree _cascadeIannotatedTree - {-# LINE 6504 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6509 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 6514 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_DropSomething :: Annotation -> - T_DropType -> - T_IfExists -> - T_StringList -> - T_Cascade -> - T_Statement -sem_Statement_DropSomething ann_ dropType_ ifE_ names_ cascade_ = - (\ _lhsIenv -> - (let _cascadeOenv :: Environment - _cascadeIannotatedTree :: Cascade - _namesOenv :: Environment - _namesIannotatedTree :: StringList - _namesIstrings :: ([String]) - _ifEOenv :: Environment - _ifEIannotatedTree :: IfExists - _dropTypeOenv :: Environment - _dropTypeIannotatedTree :: DropType - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _cascadeOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6539 "AstInternal.hs" #-} - ( _cascadeIannotatedTree) = - (cascade_ _cascadeOenv ) - -- copy rule (down) - _namesOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6546 "AstInternal.hs" #-} - ( _namesIannotatedTree,_namesIstrings) = - (names_ _namesOenv ) - -- copy rule (down) - _ifEOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6553 "AstInternal.hs" #-} - ( _ifEIannotatedTree) = - (ifE_ _ifEOenv ) - -- copy rule (down) - _dropTypeOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6560 "AstInternal.hs" #-} - ( _dropTypeIannotatedTree) = - (dropType_ _dropTypeOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - DropSomething ann_ _dropTypeIannotatedTree _ifEIannotatedTree _namesIannotatedTree _cascadeIannotatedTree - {-# LINE 6567 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6572 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 6577 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_Execute :: Annotation -> - T_Expression -> - T_Statement -sem_Statement_Execute ann_ expr_ = - (\ _lhsIenv -> - (let _exprOenv :: Environment - _exprIannotatedTree :: Expression - _exprIliftedColumnName :: String - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _exprOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6593 "AstInternal.hs" #-} - ( _exprIannotatedTree,_exprIliftedColumnName) = - (expr_ _exprOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Execute ann_ _exprIannotatedTree - {-# LINE 6600 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6605 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 6610 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_ExecuteInto :: Annotation -> - T_Expression -> - T_StringList -> - T_Statement -sem_Statement_ExecuteInto ann_ expr_ targets_ = - (\ _lhsIenv -> - (let _exprOenv :: Environment - _targetsOenv :: Environment - _targetsIannotatedTree :: StringList - _targetsIstrings :: ([String]) - _exprIannotatedTree :: Expression - _exprIliftedColumnName :: String - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _exprOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6630 "AstInternal.hs" #-} - -- copy rule (down) - _targetsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6635 "AstInternal.hs" #-} - ( _targetsIannotatedTree,_targetsIstrings) = - (targets_ _targetsOenv ) - ( _exprIannotatedTree,_exprIliftedColumnName) = - (expr_ _exprOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - ExecuteInto ann_ _exprIannotatedTree _targetsIannotatedTree - {-# LINE 6644 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6649 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 6654 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_ForIntegerStatement :: Annotation -> - String -> - T_Expression -> - T_Expression -> - T_StatementList -> - T_Statement -sem_Statement_ForIntegerStatement ann_ var_ from_ to_ sts_ = - (\ _lhsIenv -> - (let _stsOenv :: Environment - _toOenv :: Environment - _fromOenv :: Environment - _stsOenvUpdates :: ([EnvironmentUpdate]) - _stsIannotatedTree :: StatementList - _stsIproducedEnv :: Environment - _toIannotatedTree :: Expression - _toIliftedColumnName :: String - _fromIannotatedTree :: Expression - _fromIliftedColumnName :: String - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _stsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6680 "AstInternal.hs" #-} - -- copy rule (down) - _toOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6685 "AstInternal.hs" #-} - -- copy rule (down) - _fromOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6690 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 355, column 10) - _stsOenvUpdates = - {-# LINE 355 "./TypeChecking.ag" #-} - [] - {-# LINE 6695 "AstInternal.hs" #-} - ( _stsIannotatedTree,_stsIproducedEnv) = - (sts_ _stsOenv _stsOenvUpdates ) - ( _toIannotatedTree,_toIliftedColumnName) = - (to_ _toOenv ) - ( _fromIannotatedTree,_fromIliftedColumnName) = - (from_ _fromOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - ForIntegerStatement ann_ var_ _fromIannotatedTree _toIannotatedTree _stsIannotatedTree - {-# LINE 6706 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6711 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 6716 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_ForSelectStatement :: Annotation -> - String -> - T_SelectExpression -> - T_StatementList -> - T_Statement -sem_Statement_ForSelectStatement ann_ var_ sel_ sts_ = - (\ _lhsIenv -> - (let _stsOenv :: Environment - _selOenv :: Environment - _stsOenvUpdates :: ([EnvironmentUpdate]) - _stsIannotatedTree :: StatementList - _stsIproducedEnv :: Environment - _selIannotatedTree :: SelectExpression - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _stsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6737 "AstInternal.hs" #-} - -- copy rule (down) - _selOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6742 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 355, column 10) - _stsOenvUpdates = - {-# LINE 355 "./TypeChecking.ag" #-} - [] - {-# LINE 6747 "AstInternal.hs" #-} - ( _stsIannotatedTree,_stsIproducedEnv) = - (sts_ _stsOenv _stsOenvUpdates ) - ( _selIannotatedTree) = - (sel_ _selOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - ForSelectStatement ann_ var_ _selIannotatedTree _stsIannotatedTree - {-# LINE 6756 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6761 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 6766 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_If :: Annotation -> - T_ExpressionStatementListPairList -> - T_StatementList -> - T_Statement -sem_Statement_If ann_ cases_ els_ = - (\ _lhsIenv -> - (let _elsOenv :: Environment - _casesOenv :: Environment - _elsOenvUpdates :: ([EnvironmentUpdate]) - _elsIannotatedTree :: StatementList - _elsIproducedEnv :: Environment - _casesIannotatedTree :: ExpressionStatementListPairList - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _elsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6786 "AstInternal.hs" #-} - -- copy rule (down) - _casesOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6791 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 352, column 24) - _elsOenvUpdates = - {-# LINE 352 "./TypeChecking.ag" #-} - [] - {-# LINE 6796 "AstInternal.hs" #-} - ( _elsIannotatedTree,_elsIproducedEnv) = - (els_ _elsOenv _elsOenvUpdates ) - ( _casesIannotatedTree) = - (cases_ _casesOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - If ann_ _casesIannotatedTree _elsIannotatedTree - {-# LINE 6805 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6810 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 6815 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_Insert :: Annotation -> - String -> - T_StringList -> - T_SelectExpression -> - (Maybe SelectList) -> - T_Statement -sem_Statement_Insert ann_ table_ targetCols_ insData_ returning_ = - (\ _lhsIenv -> - (let _insDataOenv :: Environment - _insDataIannotatedTree :: SelectExpression - _targetColsOenv :: Environment - _targetColsIannotatedTree :: StringList - _targetColsIstrings :: ([String]) - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _insDataOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6836 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 689, column 9) - _envUpdates = - {-# LINE 689 "./TypeChecking.ag" #-} - [] - {-# LINE 6841 "AstInternal.hs" #-} - ( _insDataIannotatedTree) = - (insData_ _insDataOenv ) - -- copy rule (down) - _targetColsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6848 "AstInternal.hs" #-} - ( _targetColsIannotatedTree,_targetColsIstrings) = - (targetCols_ _targetColsOenv ) - -- "./TypeChecking.ag"(line 687, column 9) - _backTree = - {-# LINE 687 "./TypeChecking.ag" #-} - Insert ann_ table_ _targetColsIannotatedTree - _insDataIannotatedTree returning_ - {-# LINE 6856 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 676, column 9) - _columnStuff = - {-# LINE 676 "./TypeChecking.ag" #-} - checkColumnConsistency _lhsIenv - table_ - _targetColsIstrings - (getCAtts $ getTypeAnnotation _insDataIannotatedTree) - {-# LINE 6864 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 685, column 9) - _statementInfo = - {-# LINE 685 "./TypeChecking.ag" #-} - [InsertInfo table_ $ errorToTypeFailF UnnamedCompositeType _columnStuff ] - {-# LINE 6869 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 681, column 9) - _tpe = - {-# LINE 681 "./TypeChecking.ag" #-} - chainTypeCheckFailed [getTypeAnnotation _insDataIannotatedTree] $ do - _columnStuff - Right $ Pseudo Void - {-# LINE 6876 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 310, column 9) - _lhsOannotatedTree = - {-# LINE 310 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - $ Just (map StatementInfoA _statementInfo ++ - [EnvUpdates _envUpdates ]) - {-# LINE 6885 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 315, column 9) - _lhsOenvUpdates = - {-# LINE 315 "./TypeChecking.ag" #-} - _envUpdates - {-# LINE 6890 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_NullStatement :: Annotation -> - T_Statement -sem_Statement_NullStatement ann_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - NullStatement ann_ - {-# LINE 6902 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6907 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 6912 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_Perform :: Annotation -> - T_Expression -> - T_Statement -sem_Statement_Perform ann_ expr_ = - (\ _lhsIenv -> - (let _exprOenv :: Environment - _exprIannotatedTree :: Expression - _exprIliftedColumnName :: String - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _exprOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6928 "AstInternal.hs" #-} - ( _exprIannotatedTree,_exprIliftedColumnName) = - (expr_ _exprOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Perform ann_ _exprIannotatedTree - {-# LINE 6935 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6940 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 6945 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_Raise :: Annotation -> - T_RaiseType -> - String -> - T_ExpressionList -> - T_Statement -sem_Statement_Raise ann_ level_ message_ args_ = - (\ _lhsIenv -> - (let _argsOenv :: Environment - _argsIannotatedTree :: ExpressionList - _argsItypeList :: ([Type]) - _levelOenv :: Environment - _levelIannotatedTree :: RaiseType - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _argsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6965 "AstInternal.hs" #-} - ( _argsIannotatedTree,_argsItypeList) = - (args_ _argsOenv ) - -- copy rule (down) - _levelOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 6972 "AstInternal.hs" #-} - ( _levelIannotatedTree) = - (level_ _levelOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Raise ann_ _levelIannotatedTree message_ _argsIannotatedTree - {-# LINE 6979 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 6984 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 6989 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_Return :: Annotation -> - T_MaybeExpression -> - T_Statement -sem_Statement_Return ann_ value_ = - (\ _lhsIenv -> - (let _valueOenv :: Environment - _valueIannotatedTree :: MaybeExpression - _valueIexprType :: (Maybe Type) - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _valueOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7005 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 987, column 9) - _statementInfo = - {-# LINE 987 "./TypeChecking.ag" #-} - [] - {-# LINE 7010 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 986, column 9) - _envUpdates = - {-# LINE 986 "./TypeChecking.ag" #-} - [] - {-# LINE 7015 "AstInternal.hs" #-} - ( _valueIannotatedTree,_valueIexprType) = - (value_ _valueOenv ) - -- "./TypeChecking.ag"(line 985, column 9) - _backTree = - {-# LINE 985 "./TypeChecking.ag" #-} - Return ann_ _valueIannotatedTree - {-# LINE 7022 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 984, column 9) - _tpe = - {-# LINE 984 "./TypeChecking.ag" #-} - chainTypeCheckFailed [fromMaybe typeBool _valueIexprType] $ Right $ Pseudo Void - {-# LINE 7027 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 310, column 9) - _lhsOannotatedTree = - {-# LINE 310 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - $ Just (map StatementInfoA _statementInfo ++ - [EnvUpdates _envUpdates ]) - {-# LINE 7036 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 315, column 9) - _lhsOenvUpdates = - {-# LINE 315 "./TypeChecking.ag" #-} - _envUpdates - {-# LINE 7041 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_ReturnNext :: Annotation -> - T_Expression -> - T_Statement -sem_Statement_ReturnNext ann_ expr_ = - (\ _lhsIenv -> - (let _exprOenv :: Environment - _exprIannotatedTree :: Expression - _exprIliftedColumnName :: String - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _exprOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7057 "AstInternal.hs" #-} - ( _exprIannotatedTree,_exprIliftedColumnName) = - (expr_ _exprOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - ReturnNext ann_ _exprIannotatedTree - {-# LINE 7064 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 7069 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 7074 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_ReturnQuery :: Annotation -> - T_SelectExpression -> - T_Statement -sem_Statement_ReturnQuery ann_ sel_ = - (\ _lhsIenv -> - (let _selOenv :: Environment - _selIannotatedTree :: SelectExpression - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _selOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7089 "AstInternal.hs" #-} - ( _selIannotatedTree) = - (sel_ _selOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - ReturnQuery ann_ _selIannotatedTree - {-# LINE 7096 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 7101 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 7106 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_SelectStatement :: Annotation -> - T_SelectExpression -> - T_Statement -sem_Statement_SelectStatement ann_ ex_ = - (\ _lhsIenv -> - (let _exOenv :: Environment - _exIannotatedTree :: SelectExpression - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _exOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7121 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 374, column 9) - _envUpdates = - {-# LINE 374 "./TypeChecking.ag" #-} - [] - {-# LINE 7126 "AstInternal.hs" #-} - ( _exIannotatedTree) = - (ex_ _exOenv ) - -- "./TypeChecking.ag"(line 373, column 9) - _backTree = - {-# LINE 373 "./TypeChecking.ag" #-} - SelectStatement ann_ _exIannotatedTree - {-# LINE 7133 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 372, column 9) - _statementInfo = - {-# LINE 372 "./TypeChecking.ag" #-} - [SelectInfo $ getTypeAnnotation _exIannotatedTree] - {-# LINE 7138 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 371, column 9) - _tpe = - {-# LINE 371 "./TypeChecking.ag" #-} - chainTypeCheckFailed [getTypeAnnotation _exIannotatedTree] $ Right $ Pseudo Void - {-# LINE 7143 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 310, column 9) - _lhsOannotatedTree = - {-# LINE 310 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - $ Just (map StatementInfoA _statementInfo ++ - [EnvUpdates _envUpdates ]) - {-# LINE 7152 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 315, column 9) - _lhsOenvUpdates = - {-# LINE 315 "./TypeChecking.ag" #-} - _envUpdates - {-# LINE 7157 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_Truncate :: Annotation -> - T_StringList -> - T_RestartIdentity -> - T_Cascade -> - T_Statement -sem_Statement_Truncate ann_ tables_ restartIdentity_ cascade_ = - (\ _lhsIenv -> - (let _cascadeOenv :: Environment - _cascadeIannotatedTree :: Cascade - _restartIdentityOenv :: Environment - _restartIdentityIannotatedTree :: RestartIdentity - _tablesOenv :: Environment - _tablesIannotatedTree :: StringList - _tablesIstrings :: ([String]) - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _cascadeOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7179 "AstInternal.hs" #-} - ( _cascadeIannotatedTree) = - (cascade_ _cascadeOenv ) - -- copy rule (down) - _restartIdentityOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7186 "AstInternal.hs" #-} - ( _restartIdentityIannotatedTree) = - (restartIdentity_ _restartIdentityOenv ) - -- copy rule (down) - _tablesOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7193 "AstInternal.hs" #-} - ( _tablesIannotatedTree,_tablesIstrings) = - (tables_ _tablesOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Truncate ann_ _tablesIannotatedTree _restartIdentityIannotatedTree _cascadeIannotatedTree - {-# LINE 7200 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 7205 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 7210 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_Update :: Annotation -> - String -> - T_SetClauseList -> - T_MaybeBoolExpression -> - (Maybe SelectList) -> - T_Statement -sem_Statement_Update ann_ table_ assigns_ whr_ returning_ = - (\ _lhsIenv -> - (let _whrOenv :: Environment - _assignsOenv :: Environment - _whrIannotatedTree :: MaybeBoolExpression - _assignsIannotatedTree :: SetClauseList - _assignsIpairs :: ([(String,Type)]) - _assignsIrowSetErrors :: ([TypeError]) - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _whrOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7232 "AstInternal.hs" #-} - -- copy rule (down) - _assignsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7237 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 719, column 9) - _envUpdates = - {-# LINE 719 "./TypeChecking.ag" #-} - [] - {-# LINE 7242 "AstInternal.hs" #-} - ( _whrIannotatedTree) = - (whr_ _whrOenv ) - ( _assignsIannotatedTree,_assignsIpairs,_assignsIrowSetErrors) = - (assigns_ _assignsOenv ) - -- "./TypeChecking.ag"(line 718, column 9) - _backTree = - {-# LINE 718 "./TypeChecking.ag" #-} - Update ann_ table_ _assignsIannotatedTree _whrIannotatedTree returning_ - {-# LINE 7251 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 714, column 9) - _columnsConsistent = - {-# LINE 714 "./TypeChecking.ag" #-} - checkColumnConsistency _lhsIenv table_ (map fst _assignsIpairs) _assignsIpairs - {-# LINE 7256 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 716, column 9) - _statementInfo = - {-# LINE 716 "./TypeChecking.ag" #-} - [UpdateInfo table_ $ errorToTypeFailF UnnamedCompositeType _columnsConsistent ] - {-# LINE 7261 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 706, column 9) - _tpe = - {-# LINE 706 "./TypeChecking.ag" #-} - do - let re = checkRelationExists _lhsIenv table_ - when (isJust re) $ - Left [fromJust $ re] - chainTypeCheckFailed (map snd _assignsIpairs) $ do - _columnsConsistent - checkErrorList _assignsIrowSetErrors $ Pseudo Void - {-# LINE 7272 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 310, column 9) - _lhsOannotatedTree = - {-# LINE 310 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - $ Just (map StatementInfoA _statementInfo ++ - [EnvUpdates _envUpdates ]) - {-# LINE 7281 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 315, column 9) - _lhsOenvUpdates = - {-# LINE 315 "./TypeChecking.ag" #-} - _envUpdates - {-# LINE 7286 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) -sem_Statement_WhileStatement :: Annotation -> - T_Expression -> - T_StatementList -> - T_Statement -sem_Statement_WhileStatement ann_ expr_ sts_ = - (\ _lhsIenv -> - (let _stsOenv :: Environment - _exprOenv :: Environment - _stsOenvUpdates :: ([EnvironmentUpdate]) - _stsIannotatedTree :: StatementList - _stsIproducedEnv :: Environment - _exprIannotatedTree :: Expression - _exprIliftedColumnName :: String - _lhsOannotatedTree :: Statement - _lhsOenvUpdates :: ([EnvironmentUpdate]) - -- copy rule (down) - _stsOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7307 "AstInternal.hs" #-} - -- copy rule (down) - _exprOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7312 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 355, column 10) - _stsOenvUpdates = - {-# LINE 355 "./TypeChecking.ag" #-} - [] - {-# LINE 7317 "AstInternal.hs" #-} - ( _stsIannotatedTree,_stsIproducedEnv) = - (sts_ _stsOenv _stsOenvUpdates ) - ( _exprIannotatedTree,_exprIliftedColumnName) = - (expr_ _exprOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - WhileStatement ann_ _exprIannotatedTree _stsIannotatedTree - {-# LINE 7326 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 7331 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 324, column 9) - _lhsOenvUpdates = - {-# LINE 324 "./TypeChecking.ag" #-} - [] - {-# LINE 7336 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOenvUpdates))) --- StatementList ----------------------------------------------- -{- - visit 0: - inherited attributes: - env : Environment - envUpdates : [EnvironmentUpdate] - synthesized attributes: - annotatedTree : SELF - producedEnv : Environment - alternatives: - alternative Cons: - child hd : Statement - child tl : StatementList - visit 0: - local newEnv : _ - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type StatementList = [(Statement)] --- cata -sem_StatementList :: StatementList -> - T_StatementList -sem_StatementList list = - (Prelude.foldr sem_StatementList_Cons sem_StatementList_Nil (Prelude.map sem_Statement list) ) --- semantic domain -type T_StatementList = Environment -> - ([EnvironmentUpdate]) -> - ( StatementList,Environment) -data Inh_StatementList = Inh_StatementList {env_Inh_StatementList :: Environment,envUpdates_Inh_StatementList :: [EnvironmentUpdate]} -data Syn_StatementList = Syn_StatementList {annotatedTree_Syn_StatementList :: StatementList,producedEnv_Syn_StatementList :: Environment} -wrap_StatementList :: T_StatementList -> - Inh_StatementList -> - Syn_StatementList -wrap_StatementList sem (Inh_StatementList _lhsIenv _lhsIenvUpdates ) = - (let ( _lhsOannotatedTree,_lhsOproducedEnv) = - (sem _lhsIenv _lhsIenvUpdates ) - in (Syn_StatementList _lhsOannotatedTree _lhsOproducedEnv )) -sem_StatementList_Cons :: T_Statement -> - T_StatementList -> - T_StatementList -sem_StatementList_Cons hd_ tl_ = - (\ _lhsIenv - _lhsIenvUpdates -> - (let _hdOenv :: Environment - _hdIannotatedTree :: Statement - _hdIenvUpdates :: ([EnvironmentUpdate]) - _tlOenvUpdates :: ([EnvironmentUpdate]) - _tlOenv :: Environment - _tlIannotatedTree :: StatementList - _tlIproducedEnv :: Environment - _lhsOannotatedTree :: StatementList - _lhsOproducedEnv :: Environment - -- "./TypeChecking.ag"(line 334, column 9) - _newEnv = - {-# LINE 334 "./TypeChecking.ag" #-} - fromRight _lhsIenv $ updateEnvironment _lhsIenv _lhsIenvUpdates - {-# LINE 7396 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 335, column 9) - _hdOenv = - {-# LINE 335 "./TypeChecking.ag" #-} - _newEnv - {-# LINE 7401 "AstInternal.hs" #-} - ( _hdIannotatedTree,_hdIenvUpdates) = - (hd_ _hdOenv ) - -- "./TypeChecking.ag"(line 340, column 9) - _tlOenvUpdates = - {-# LINE 340 "./TypeChecking.ag" #-} - _hdIenvUpdates - {-# LINE 7408 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 336, column 9) - _tlOenv = - {-# LINE 336 "./TypeChecking.ag" #-} - _newEnv - {-# LINE 7413 "AstInternal.hs" #-} - ( _tlIannotatedTree,_tlIproducedEnv) = - (tl_ _tlOenv _tlOenvUpdates ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 7420 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 7425 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 337, column 9) - _lhsOproducedEnv = - {-# LINE 337 "./TypeChecking.ag" #-} - case _tlIannotatedTree of - [] -> _newEnv - _ -> _tlIproducedEnv - {-# LINE 7432 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOproducedEnv))) -sem_StatementList_Nil :: T_StatementList -sem_StatementList_Nil = - (\ _lhsIenv - _lhsIenvUpdates -> - (let _lhsOannotatedTree :: StatementList - _lhsOproducedEnv :: Environment - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 7444 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 7449 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 342, column 9) - _lhsOproducedEnv = - {-# LINE 342 "./TypeChecking.ag" #-} - emptyEnvironment - {-# LINE 7454 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOproducedEnv))) --- StringList -------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - strings : [String] - alternatives: - alternative Cons: - child hd : {String} - child tl : StringList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type StringList = [(String)] --- cata -sem_StringList :: StringList -> - T_StringList -sem_StringList list = - (Prelude.foldr sem_StringList_Cons sem_StringList_Nil list ) --- semantic domain -type T_StringList = Environment -> - ( StringList,([String])) -data Inh_StringList = Inh_StringList {env_Inh_StringList :: Environment} -data Syn_StringList = Syn_StringList {annotatedTree_Syn_StringList :: StringList,strings_Syn_StringList :: [String]} -wrap_StringList :: T_StringList -> - Inh_StringList -> - Syn_StringList -wrap_StringList sem (Inh_StringList _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOstrings) = - (sem _lhsIenv ) - in (Syn_StringList _lhsOannotatedTree _lhsOstrings )) -sem_StringList_Cons :: String -> - T_StringList -> - T_StringList -sem_StringList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _tlIannotatedTree :: StringList - _tlIstrings :: ([String]) - _lhsOannotatedTree :: StringList - _lhsOstrings :: ([String]) - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7506 "AstInternal.hs" #-} - ( _tlIannotatedTree,_tlIstrings) = - (tl_ _tlOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) hd_ _tlIannotatedTree - {-# LINE 7513 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 7518 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 694, column 10) - _lhsOstrings = - {-# LINE 694 "./TypeChecking.ag" #-} - hd_ : _tlIstrings - {-# LINE 7523 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOstrings))) -sem_StringList_Nil :: T_StringList -sem_StringList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: StringList - _lhsOstrings :: ([String]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 7534 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 7539 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 695, column 9) - _lhsOstrings = - {-# LINE 695 "./TypeChecking.ag" #-} - [] - {-# LINE 7544 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOstrings))) --- StringStringListPair ---------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Tuple: - child x1 : {String} - child x2 : StringList - visit 0: - local annotatedTree : _ --} -type StringStringListPair = ( (String),(StringList)) --- cata -sem_StringStringListPair :: StringStringListPair -> - T_StringStringListPair -sem_StringStringListPair ( x1,x2) = - (sem_StringStringListPair_Tuple x1 (sem_StringList x2 ) ) --- semantic domain -type T_StringStringListPair = Environment -> - ( StringStringListPair) -data Inh_StringStringListPair = Inh_StringStringListPair {env_Inh_StringStringListPair :: Environment} -data Syn_StringStringListPair = Syn_StringStringListPair {annotatedTree_Syn_StringStringListPair :: StringStringListPair} -wrap_StringStringListPair :: T_StringStringListPair -> - Inh_StringStringListPair -> - Syn_StringStringListPair -wrap_StringStringListPair sem (Inh_StringStringListPair _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_StringStringListPair _lhsOannotatedTree )) -sem_StringStringListPair_Tuple :: String -> - T_StringList -> - T_StringStringListPair -sem_StringStringListPair_Tuple x1_ x2_ = - (\ _lhsIenv -> - (let _x2Oenv :: Environment - _x2IannotatedTree :: StringList - _x2Istrings :: ([String]) - _lhsOannotatedTree :: StringStringListPair - -- copy rule (down) - _x2Oenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7591 "AstInternal.hs" #-} - ( _x2IannotatedTree,_x2Istrings) = - (x2_ _x2Oenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (x1_,_x2IannotatedTree) - {-# LINE 7598 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 7603 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- StringStringListPairList ------------------------------------ -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Cons: - child hd : StringStringListPair - child tl : StringStringListPairList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type StringStringListPairList = [(StringStringListPair)] --- cata -sem_StringStringListPairList :: StringStringListPairList -> - T_StringStringListPairList -sem_StringStringListPairList list = - (Prelude.foldr sem_StringStringListPairList_Cons sem_StringStringListPairList_Nil (Prelude.map sem_StringStringListPair list) ) --- semantic domain -type T_StringStringListPairList = Environment -> - ( StringStringListPairList) -data Inh_StringStringListPairList = Inh_StringStringListPairList {env_Inh_StringStringListPairList :: Environment} -data Syn_StringStringListPairList = Syn_StringStringListPairList {annotatedTree_Syn_StringStringListPairList :: StringStringListPairList} -wrap_StringStringListPairList :: T_StringStringListPairList -> - Inh_StringStringListPairList -> - Syn_StringStringListPairList -wrap_StringStringListPairList sem (Inh_StringStringListPairList _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_StringStringListPairList _lhsOannotatedTree )) -sem_StringStringListPairList_Cons :: T_StringStringListPair -> - T_StringStringListPairList -> - T_StringStringListPairList -sem_StringStringListPairList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _tlIannotatedTree :: StringStringListPairList - _hdOenv :: Environment - _hdIannotatedTree :: StringStringListPair - _lhsOannotatedTree :: StringStringListPairList - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7654 "AstInternal.hs" #-} - ( _tlIannotatedTree) = - (tl_ _tlOenv ) - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7661 "AstInternal.hs" #-} - ( _hdIannotatedTree) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 7668 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 7673 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_StringStringListPairList_Nil :: T_StringStringListPairList -sem_StringStringListPairList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: StringStringListPairList - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 7683 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 7688 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) --- TableRef ---------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - idens : [(String,([(String,Type)],[(String,Type)]))] - joinIdens : [String] - alternatives: - alternative JoinedTref: - child ann : {Annotation} - child tbl : TableRef - child nat : Natural - child joinType : JoinType - child tbl1 : TableRef - child onExpr : OnExpr - visit 0: - local backTree : _ - local tpe : _ - alternative SubTref: - child ann : {Annotation} - child sel : SelectExpression - child alias : {String} - visit 0: - local backTree : _ - local tpe : _ - alternative Tref: - child ann : {Annotation} - child tbl : {String} - visit 0: - local backTree : _ - local relType : _ - local tpe : _ - local unwrappedRelType : _ - alternative TrefAlias: - child ann : {Annotation} - child tbl : {String} - child alias : {String} - visit 0: - local backTree : _ - local relType : _ - local tpe : _ - local unwrappedRelType : _ - alternative TrefFun: - child ann : {Annotation} - child fn : Expression - visit 0: - local backTree : _ - local alias1 : _ - local tpe : _ - alternative TrefFunAlias: - child ann : {Annotation} - child fn : Expression - child alias : {String} - visit 0: - local backTree : _ - local alias1 : _ - local tpe : _ --} -data TableRef = JoinedTref (Annotation) (TableRef) (Natural) (JoinType) (TableRef) (OnExpr) - | SubTref (Annotation) (SelectExpression) (String) - | Tref (Annotation) (String) - | TrefAlias (Annotation) (String) (String) - | TrefFun (Annotation) (Expression) - | TrefFunAlias (Annotation) (Expression) (String) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_TableRef :: TableRef -> - T_TableRef -sem_TableRef (JoinedTref _ann _tbl _nat _joinType _tbl1 _onExpr ) = - (sem_TableRef_JoinedTref _ann (sem_TableRef _tbl ) (sem_Natural _nat ) (sem_JoinType _joinType ) (sem_TableRef _tbl1 ) (sem_OnExpr _onExpr ) ) -sem_TableRef (SubTref _ann _sel _alias ) = - (sem_TableRef_SubTref _ann (sem_SelectExpression _sel ) _alias ) -sem_TableRef (Tref _ann _tbl ) = - (sem_TableRef_Tref _ann _tbl ) -sem_TableRef (TrefAlias _ann _tbl _alias ) = - (sem_TableRef_TrefAlias _ann _tbl _alias ) -sem_TableRef (TrefFun _ann _fn ) = - (sem_TableRef_TrefFun _ann (sem_Expression _fn ) ) -sem_TableRef (TrefFunAlias _ann _fn _alias ) = - (sem_TableRef_TrefFunAlias _ann (sem_Expression _fn ) _alias ) --- semantic domain -type T_TableRef = Environment -> - ( TableRef,([(String,([(String,Type)],[(String,Type)]))]),([String])) -data Inh_TableRef = Inh_TableRef {env_Inh_TableRef :: Environment} -data Syn_TableRef = Syn_TableRef {annotatedTree_Syn_TableRef :: TableRef,idens_Syn_TableRef :: [(String,([(String,Type)],[(String,Type)]))],joinIdens_Syn_TableRef :: [String]} -wrap_TableRef :: T_TableRef -> - Inh_TableRef -> - Syn_TableRef -wrap_TableRef sem (Inh_TableRef _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens) = - (sem _lhsIenv ) - in (Syn_TableRef _lhsOannotatedTree _lhsOidens _lhsOjoinIdens )) -sem_TableRef_JoinedTref :: Annotation -> - T_TableRef -> - T_Natural -> - T_JoinType -> - T_TableRef -> - T_OnExpr -> - T_TableRef -sem_TableRef_JoinedTref ann_ tbl_ nat_ joinType_ tbl1_ onExpr_ = - (\ _lhsIenv -> - (let _onExprOenv :: Environment - _tbl1Oenv :: Environment - _tblOenv :: Environment - _onExprIannotatedTree :: OnExpr - _tbl1IannotatedTree :: TableRef - _tbl1Iidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _tbl1IjoinIdens :: ([String]) - _joinTypeOenv :: Environment - _joinTypeIannotatedTree :: JoinType - _natOenv :: Environment - _natIannotatedTree :: Natural - _tblIannotatedTree :: TableRef - _tblIidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _tblIjoinIdens :: ([String]) - _lhsOannotatedTree :: TableRef - _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _lhsOjoinIdens :: ([String]) - -- copy rule (down) - _onExprOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7814 "AstInternal.hs" #-} - -- copy rule (down) - _tbl1Oenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7819 "AstInternal.hs" #-} - -- copy rule (down) - _tblOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7824 "AstInternal.hs" #-} - ( _onExprIannotatedTree) = - (onExpr_ _onExprOenv ) - ( _tbl1IannotatedTree,_tbl1Iidens,_tbl1IjoinIdens) = - (tbl1_ _tbl1Oenv ) - -- copy rule (down) - _joinTypeOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7833 "AstInternal.hs" #-} - ( _joinTypeIannotatedTree) = - (joinType_ _joinTypeOenv ) - -- copy rule (down) - _natOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7840 "AstInternal.hs" #-} - ( _natIannotatedTree) = - (nat_ _natOenv ) - ( _tblIannotatedTree,_tblIidens,_tblIjoinIdens) = - (tbl_ _tblOenv ) - -- "./TypeChecking.ag"(line 489, column 9) - _backTree = - {-# LINE 489 "./TypeChecking.ag" #-} - JoinedTref ann_ - _tblIannotatedTree - _natIannotatedTree - _joinTypeIannotatedTree - _tbl1IannotatedTree - _onExprIannotatedTree - {-# LINE 7854 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 473, column 9) - _tpe = - {-# LINE 473 "./TypeChecking.ag" #-} - chainTypeCheckFailed [tblt - ,tbl1t] $ - case (_natIannotatedTree, _onExprIannotatedTree) of - (Natural, _) -> unionJoinList $ - commonFieldNames tblt tbl1t - (_,Just (JoinUsing _ s)) -> unionJoinList s - _ -> unionJoinList [] - where - tblt = getTypeAnnotation _tblIannotatedTree - tbl1t = getTypeAnnotation _tbl1IannotatedTree - unionJoinList s = - combineTableTypesWithUsingList _lhsIenv s tblt tbl1t - {-# LINE 7870 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 430, column 9) - _lhsOannotatedTree = - {-# LINE 430 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 7878 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 486, column 9) - _lhsOidens = - {-# LINE 486 "./TypeChecking.ag" #-} - _tblIidens ++ _tbl1Iidens - {-# LINE 7883 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 487, column 9) - _lhsOjoinIdens = - {-# LINE 487 "./TypeChecking.ag" #-} - commonFieldNames (getTypeAnnotation _tblIannotatedTree) - (getTypeAnnotation _tbl1IannotatedTree) - {-# LINE 7889 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) -sem_TableRef_SubTref :: Annotation -> - T_SelectExpression -> - String -> - T_TableRef -sem_TableRef_SubTref ann_ sel_ alias_ = - (\ _lhsIenv -> - (let _selOenv :: Environment - _selIannotatedTree :: SelectExpression - _lhsOannotatedTree :: TableRef - _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _lhsOjoinIdens :: ([String]) - -- copy rule (down) - _selOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 7906 "AstInternal.hs" #-} - ( _selIannotatedTree) = - (sel_ _selOenv ) - -- "./TypeChecking.ag"(line 439, column 15) - _backTree = - {-# LINE 439 "./TypeChecking.ag" #-} - SubTref ann_ _selIannotatedTree alias_ - {-# LINE 7913 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 437, column 15) - _tpe = - {-# LINE 437 "./TypeChecking.ag" #-} - chainTypeCheckFailed [getTypeAnnotation _selIannotatedTree] <$> - unwrapSetOfWhenComposite $ getTypeAnnotation _selIannotatedTree - {-# LINE 7919 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 430, column 9) - _lhsOannotatedTree = - {-# LINE 430 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 7927 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 440, column 15) - _lhsOidens = - {-# LINE 440 "./TypeChecking.ag" #-} - [(alias_, (fromRight [] $ getTbCols _selIannotatedTree, []))] - {-# LINE 7932 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 441, column 15) - _lhsOjoinIdens = - {-# LINE 441 "./TypeChecking.ag" #-} - [] - {-# LINE 7937 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) -sem_TableRef_Tref :: Annotation -> - String -> - T_TableRef -sem_TableRef_Tref ann_ tbl_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: TableRef - _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _lhsOjoinIdens :: ([String]) - -- "./TypeChecking.ag"(line 454, column 9) - _backTree = - {-# LINE 454 "./TypeChecking.ag" #-} - Tref ann_ tbl_ - {-# LINE 7951 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 445, column 9) - _relType = - {-# LINE 445 "./TypeChecking.ag" #-} - getRelationType _lhsIenv tbl_ - {-# LINE 7956 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 443, column 9) - _tpe = - {-# LINE 443 "./TypeChecking.ag" #-} - either Left (Right . fst) _relType - {-# LINE 7961 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 430, column 9) - _lhsOannotatedTree = - {-# LINE 430 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 7969 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 446, column 9) - _unwrappedRelType = - {-# LINE 446 "./TypeChecking.ag" #-} - fromRight ([],[]) $ - do - lrt <- _relType - let (UnnamedCompositeType a,UnnamedCompositeType b) = lrt - return (a,b) - {-# LINE 7978 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 453, column 9) - _lhsOidens = - {-# LINE 453 "./TypeChecking.ag" #-} - [(tbl_, _unwrappedRelType )] - {-# LINE 7983 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 444, column 9) - _lhsOjoinIdens = - {-# LINE 444 "./TypeChecking.ag" #-} - [] - {-# LINE 7988 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) -sem_TableRef_TrefAlias :: Annotation -> - String -> - String -> - T_TableRef -sem_TableRef_TrefAlias ann_ tbl_ alias_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: TableRef - _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _lhsOjoinIdens :: ([String]) - -- "./TypeChecking.ag"(line 457, column 9) - _backTree = - {-# LINE 457 "./TypeChecking.ag" #-} - TrefAlias ann_ tbl_ alias_ - {-# LINE 8003 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 445, column 9) - _relType = - {-# LINE 445 "./TypeChecking.ag" #-} - getRelationType _lhsIenv tbl_ - {-# LINE 8008 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 443, column 9) - _tpe = - {-# LINE 443 "./TypeChecking.ag" #-} - either Left (Right . fst) _relType - {-# LINE 8013 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 430, column 9) - _lhsOannotatedTree = - {-# LINE 430 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 8021 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 446, column 9) - _unwrappedRelType = - {-# LINE 446 "./TypeChecking.ag" #-} - fromRight ([],[]) $ - do - lrt <- _relType - let (UnnamedCompositeType a,UnnamedCompositeType b) = lrt - return (a,b) - {-# LINE 8030 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 456, column 9) - _lhsOidens = - {-# LINE 456 "./TypeChecking.ag" #-} - [(alias_, _unwrappedRelType )] - {-# LINE 8035 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 444, column 9) - _lhsOjoinIdens = - {-# LINE 444 "./TypeChecking.ag" #-} - [] - {-# LINE 8040 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) -sem_TableRef_TrefFun :: Annotation -> - T_Expression -> - T_TableRef -sem_TableRef_TrefFun ann_ fn_ = - (\ _lhsIenv -> - (let _fnOenv :: Environment - _fnIannotatedTree :: Expression - _fnIliftedColumnName :: String - _lhsOannotatedTree :: TableRef - _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _lhsOjoinIdens :: ([String]) - -- copy rule (down) - _fnOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 8057 "AstInternal.hs" #-} - ( _fnIannotatedTree,_fnIliftedColumnName) = - (fn_ _fnOenv ) - -- "./TypeChecking.ag"(line 468, column 9) - _backTree = - {-# LINE 468 "./TypeChecking.ag" #-} - TrefFun ann_ _fnIannotatedTree - {-# LINE 8064 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 467, column 9) - _alias1 = - {-# LINE 467 "./TypeChecking.ag" #-} - "" - {-# LINE 8069 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 459, column 9) - _tpe = - {-# LINE 459 "./TypeChecking.ag" #-} - getFnType _lhsIenv _alias1 _fnIannotatedTree - {-# LINE 8074 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 430, column 9) - _lhsOannotatedTree = - {-# LINE 430 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 8082 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 461, column 9) - _lhsOidens = - {-# LINE 461 "./TypeChecking.ag" #-} - case getFunIdens - _lhsIenv _alias1 - _fnIannotatedTree of - Right (s, UnnamedCompositeType c) -> [(s,(c,[]))] - _ -> [] - {-# LINE 8091 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 460, column 9) - _lhsOjoinIdens = - {-# LINE 460 "./TypeChecking.ag" #-} - [] - {-# LINE 8096 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) -sem_TableRef_TrefFunAlias :: Annotation -> - T_Expression -> - String -> - T_TableRef -sem_TableRef_TrefFunAlias ann_ fn_ alias_ = - (\ _lhsIenv -> - (let _fnOenv :: Environment - _fnIannotatedTree :: Expression - _fnIliftedColumnName :: String - _lhsOannotatedTree :: TableRef - _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) - _lhsOjoinIdens :: ([String]) - -- copy rule (down) - _fnOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 8114 "AstInternal.hs" #-} - ( _fnIannotatedTree,_fnIliftedColumnName) = - (fn_ _fnOenv ) - -- "./TypeChecking.ag"(line 471, column 9) - _backTree = - {-# LINE 471 "./TypeChecking.ag" #-} - TrefFunAlias ann_ _fnIannotatedTree alias_ - {-# LINE 8121 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 470, column 9) - _alias1 = - {-# LINE 470 "./TypeChecking.ag" #-} - alias_ - {-# LINE 8126 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 459, column 9) - _tpe = - {-# LINE 459 "./TypeChecking.ag" #-} - getFnType _lhsIenv _alias1 _fnIannotatedTree - {-# LINE 8131 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 430, column 9) - _lhsOannotatedTree = - {-# LINE 430 "./TypeChecking.ag" #-} - annTypesAndErrors _backTree - (errorToTypeFail _tpe ) - (getErrors _tpe ) - Nothing - {-# LINE 8139 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 461, column 9) - _lhsOidens = - {-# LINE 461 "./TypeChecking.ag" #-} - case getFunIdens - _lhsIenv _alias1 - _fnIannotatedTree of - Right (s, UnnamedCompositeType c) -> [(s,(c,[]))] - _ -> [] - {-# LINE 8148 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 460, column 9) - _lhsOjoinIdens = - {-# LINE 460 "./TypeChecking.ag" #-} - [] - {-# LINE 8153 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) --- TypeAttributeDef -------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - attrName : String - namedType : Type - alternatives: - alternative TypeAttDef: - child ann : {Annotation} - child name : {String} - child typ : TypeName - visit 0: - local annotatedTree : _ --} -data TypeAttributeDef = TypeAttDef (Annotation) (String) (TypeName) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_TypeAttributeDef :: TypeAttributeDef -> - T_TypeAttributeDef -sem_TypeAttributeDef (TypeAttDef _ann _name _typ ) = - (sem_TypeAttributeDef_TypeAttDef _ann _name (sem_TypeName _typ ) ) --- semantic domain -type T_TypeAttributeDef = Environment -> - ( TypeAttributeDef,String,Type) -data Inh_TypeAttributeDef = Inh_TypeAttributeDef {env_Inh_TypeAttributeDef :: Environment} -data Syn_TypeAttributeDef = Syn_TypeAttributeDef {annotatedTree_Syn_TypeAttributeDef :: TypeAttributeDef,attrName_Syn_TypeAttributeDef :: String,namedType_Syn_TypeAttributeDef :: Type} -wrap_TypeAttributeDef :: T_TypeAttributeDef -> - Inh_TypeAttributeDef -> - Syn_TypeAttributeDef -wrap_TypeAttributeDef sem (Inh_TypeAttributeDef _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOattrName,_lhsOnamedType) = - (sem _lhsIenv ) - in (Syn_TypeAttributeDef _lhsOannotatedTree _lhsOattrName _lhsOnamedType )) -sem_TypeAttributeDef_TypeAttDef :: Annotation -> - String -> - T_TypeName -> - T_TypeAttributeDef -sem_TypeAttributeDef_TypeAttDef ann_ name_ typ_ = - (\ _lhsIenv -> - (let _typOenv :: Environment - _typIannotatedTree :: TypeName - _typInamedType :: Type - _lhsOannotatedTree :: TypeAttributeDef - _lhsOattrName :: String - _lhsOnamedType :: Type - -- copy rule (down) - _typOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 8207 "AstInternal.hs" #-} - ( _typIannotatedTree,_typInamedType) = - (typ_ _typOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - TypeAttDef ann_ name_ _typIannotatedTree - {-# LINE 8214 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 8219 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 841, column 9) - _lhsOattrName = - {-# LINE 841 "./TypeChecking.ag" #-} - name_ - {-# LINE 8224 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 842, column 9) - _lhsOnamedType = - {-# LINE 842 "./TypeChecking.ag" #-} - _typInamedType - {-# LINE 8229 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOattrName,_lhsOnamedType))) --- TypeAttributeDefList ---------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - attrs : [(String, Type)] - alternatives: - alternative Cons: - child hd : TypeAttributeDef - child tl : TypeAttributeDefList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type TypeAttributeDefList = [(TypeAttributeDef)] --- cata -sem_TypeAttributeDefList :: TypeAttributeDefList -> - T_TypeAttributeDefList -sem_TypeAttributeDefList list = - (Prelude.foldr sem_TypeAttributeDefList_Cons sem_TypeAttributeDefList_Nil (Prelude.map sem_TypeAttributeDef list) ) --- semantic domain -type T_TypeAttributeDefList = Environment -> - ( TypeAttributeDefList,([(String, Type)])) -data Inh_TypeAttributeDefList = Inh_TypeAttributeDefList {env_Inh_TypeAttributeDefList :: Environment} -data Syn_TypeAttributeDefList = Syn_TypeAttributeDefList {annotatedTree_Syn_TypeAttributeDefList :: TypeAttributeDefList,attrs_Syn_TypeAttributeDefList :: [(String, Type)]} -wrap_TypeAttributeDefList :: T_TypeAttributeDefList -> - Inh_TypeAttributeDefList -> - Syn_TypeAttributeDefList -wrap_TypeAttributeDefList sem (Inh_TypeAttributeDefList _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOattrs) = - (sem _lhsIenv ) - in (Syn_TypeAttributeDefList _lhsOannotatedTree _lhsOattrs )) -sem_TypeAttributeDefList_Cons :: T_TypeAttributeDef -> - T_TypeAttributeDefList -> - T_TypeAttributeDefList -sem_TypeAttributeDefList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: TypeAttributeDefList - _tlIattrs :: ([(String, Type)]) - _hdIannotatedTree :: TypeAttributeDef - _hdIattrName :: String - _hdInamedType :: Type - _lhsOannotatedTree :: TypeAttributeDefList - _lhsOattrs :: ([(String, Type)]) - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 8285 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 8290 "AstInternal.hs" #-} - ( _tlIannotatedTree,_tlIattrs) = - (tl_ _tlOenv ) - ( _hdIannotatedTree,_hdIattrName,_hdInamedType) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 8299 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 8304 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 847, column 12) - _lhsOattrs = - {-# LINE 847 "./TypeChecking.ag" #-} - (_hdIattrName, _hdInamedType) : _tlIattrs - {-# LINE 8309 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOattrs))) -sem_TypeAttributeDefList_Nil :: T_TypeAttributeDefList -sem_TypeAttributeDefList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: TypeAttributeDefList - _lhsOattrs :: ([(String, Type)]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 8320 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 8325 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 848, column 11) - _lhsOattrs = - {-# LINE 848 "./TypeChecking.ag" #-} - [] - {-# LINE 8330 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOattrs))) --- TypeName ---------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - namedType : Type - alternatives: - alternative ArrayTypeName: - child ann : {Annotation} - child typ : TypeName - visit 0: - local backTree : _ - local tpe : _ - alternative PrecTypeName: - child ann : {Annotation} - child tn : {String} - child prec : {Integer} - visit 0: - local backTree : _ - local tpe : _ - alternative SetOfTypeName: - child ann : {Annotation} - child typ : TypeName - visit 0: - local backTree : _ - local tpe : _ - alternative SimpleTypeName: - child ann : {Annotation} - child tn : {String} - visit 0: - local backTree : _ - local tpe : _ --} -data TypeName = ArrayTypeName (Annotation) (TypeName) - | PrecTypeName (Annotation) (String) (Integer) - | SetOfTypeName (Annotation) (TypeName) - | SimpleTypeName (Annotation) (String) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_TypeName :: TypeName -> - T_TypeName -sem_TypeName (ArrayTypeName _ann _typ ) = - (sem_TypeName_ArrayTypeName _ann (sem_TypeName _typ ) ) -sem_TypeName (PrecTypeName _ann _tn _prec ) = - (sem_TypeName_PrecTypeName _ann _tn _prec ) -sem_TypeName (SetOfTypeName _ann _typ ) = - (sem_TypeName_SetOfTypeName _ann (sem_TypeName _typ ) ) -sem_TypeName (SimpleTypeName _ann _tn ) = - (sem_TypeName_SimpleTypeName _ann _tn ) --- semantic domain -type T_TypeName = Environment -> - ( TypeName,Type) -data Inh_TypeName = Inh_TypeName {env_Inh_TypeName :: Environment} -data Syn_TypeName = Syn_TypeName {annotatedTree_Syn_TypeName :: TypeName,namedType_Syn_TypeName :: Type} -wrap_TypeName :: T_TypeName -> - Inh_TypeName -> - Syn_TypeName -wrap_TypeName sem (Inh_TypeName _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOnamedType) = - (sem _lhsIenv ) - in (Syn_TypeName _lhsOannotatedTree _lhsOnamedType )) -sem_TypeName_ArrayTypeName :: Annotation -> - T_TypeName -> - T_TypeName -sem_TypeName_ArrayTypeName ann_ typ_ = - (\ _lhsIenv -> - (let _typOenv :: Environment - _typIannotatedTree :: TypeName - _typInamedType :: Type - _lhsOannotatedTree :: TypeName - _lhsOnamedType :: Type - -- copy rule (down) - _typOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 8409 "AstInternal.hs" #-} - ( _typIannotatedTree,_typInamedType) = - (typ_ _typOenv ) - -- "./TypeChecking.ag"(line 148, column 9) - _backTree = - {-# LINE 148 "./TypeChecking.ag" #-} - ArrayTypeName ann_ _typIannotatedTree - {-# LINE 8416 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 147, column 9) - _tpe = - {-# LINE 147 "./TypeChecking.ag" #-} - chainTypeCheckFailed [_typInamedType] $ Right $ ArrayType _typInamedType - {-# LINE 8421 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 137, column 10) - _lhsOannotatedTree = - {-# LINE 137 "./TypeChecking.ag" #-} - updateAnnotation - ((map TypeErrorA $ getErrors _tpe ) ++) - _backTree - {-# LINE 8428 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 136, column 10) - _lhsOnamedType = - {-# LINE 136 "./TypeChecking.ag" #-} - errorToTypeFail _tpe - {-# LINE 8433 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOnamedType))) -sem_TypeName_PrecTypeName :: Annotation -> - String -> - Integer -> - T_TypeName -sem_TypeName_PrecTypeName ann_ tn_ prec_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: TypeName - _lhsOnamedType :: Type - -- "./TypeChecking.ag"(line 154, column 9) - _backTree = - {-# LINE 154 "./TypeChecking.ag" #-} - PrecTypeName ann_ tn_ prec_ - {-# LINE 8447 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 153, column 9) - _tpe = - {-# LINE 153 "./TypeChecking.ag" #-} - Right TypeCheckFailed - {-# LINE 8452 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 137, column 10) - _lhsOannotatedTree = - {-# LINE 137 "./TypeChecking.ag" #-} - updateAnnotation - ((map TypeErrorA $ getErrors _tpe ) ++) - _backTree - {-# LINE 8459 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 136, column 10) - _lhsOnamedType = - {-# LINE 136 "./TypeChecking.ag" #-} - errorToTypeFail _tpe - {-# LINE 8464 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOnamedType))) -sem_TypeName_SetOfTypeName :: Annotation -> - T_TypeName -> - T_TypeName -sem_TypeName_SetOfTypeName ann_ typ_ = - (\ _lhsIenv -> - (let _typOenv :: Environment - _typIannotatedTree :: TypeName - _typInamedType :: Type - _lhsOannotatedTree :: TypeName - _lhsOnamedType :: Type - -- copy rule (down) - _typOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 8480 "AstInternal.hs" #-} - ( _typIannotatedTree,_typInamedType) = - (typ_ _typOenv ) - -- "./TypeChecking.ag"(line 151, column 9) - _backTree = - {-# LINE 151 "./TypeChecking.ag" #-} - SetOfTypeName ann_ _typIannotatedTree - {-# LINE 8487 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 150, column 9) - _tpe = - {-# LINE 150 "./TypeChecking.ag" #-} - chainTypeCheckFailed [_typInamedType] $ Right $ SetOfType _typInamedType - {-# LINE 8492 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 137, column 10) - _lhsOannotatedTree = - {-# LINE 137 "./TypeChecking.ag" #-} - updateAnnotation - ((map TypeErrorA $ getErrors _tpe ) ++) - _backTree - {-# LINE 8499 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 136, column 10) - _lhsOnamedType = - {-# LINE 136 "./TypeChecking.ag" #-} - errorToTypeFail _tpe - {-# LINE 8504 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOnamedType))) -sem_TypeName_SimpleTypeName :: Annotation -> - String -> - T_TypeName -sem_TypeName_SimpleTypeName ann_ tn_ = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: TypeName - _lhsOnamedType :: Type - -- "./TypeChecking.ag"(line 145, column 9) - _backTree = - {-# LINE 145 "./TypeChecking.ag" #-} - SimpleTypeName ann_ tn_ - {-# LINE 8517 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 144, column 9) - _tpe = - {-# LINE 144 "./TypeChecking.ag" #-} - envLookupType _lhsIenv $ canonicalizeTypeName tn_ - {-# LINE 8522 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 137, column 10) - _lhsOannotatedTree = - {-# LINE 137 "./TypeChecking.ag" #-} - updateAnnotation - ((map TypeErrorA $ getErrors _tpe ) ++) - _backTree - {-# LINE 8529 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 136, column 10) - _lhsOnamedType = - {-# LINE 136 "./TypeChecking.ag" #-} - errorToTypeFail _tpe - {-# LINE 8534 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOnamedType))) --- VarDef ------------------------------------------------------ -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - def : (String,Type) - alternatives: - alternative VarDef: - child ann : {Annotation} - child name : {String} - child typ : TypeName - child value : {Maybe Expression} - visit 0: - local annotatedTree : _ --} -data VarDef = VarDef (Annotation) (String) (TypeName) (Maybe Expression) - deriving ( Data,Eq,Show,Typeable) --- cata -sem_VarDef :: VarDef -> - T_VarDef -sem_VarDef (VarDef _ann _name _typ _value ) = - (sem_VarDef_VarDef _ann _name (sem_TypeName _typ ) _value ) --- semantic domain -type T_VarDef = Environment -> - ( VarDef,((String,Type))) -data Inh_VarDef = Inh_VarDef {env_Inh_VarDef :: Environment} -data Syn_VarDef = Syn_VarDef {annotatedTree_Syn_VarDef :: VarDef,def_Syn_VarDef :: (String,Type)} -wrap_VarDef :: T_VarDef -> - Inh_VarDef -> - Syn_VarDef -wrap_VarDef sem (Inh_VarDef _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOdef) = - (sem _lhsIenv ) - in (Syn_VarDef _lhsOannotatedTree _lhsOdef )) -sem_VarDef_VarDef :: Annotation -> - String -> - T_TypeName -> - (Maybe Expression) -> - T_VarDef -sem_VarDef_VarDef ann_ name_ typ_ value_ = - (\ _lhsIenv -> - (let _typOenv :: Environment - _typIannotatedTree :: TypeName - _typInamedType :: Type - _lhsOannotatedTree :: VarDef - _lhsOdef :: ((String,Type)) - -- copy rule (down) - _typOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 8588 "AstInternal.hs" #-} - ( _typIannotatedTree,_typInamedType) = - (typ_ _typOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - VarDef ann_ name_ _typIannotatedTree value_ - {-# LINE 8595 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 8600 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 945, column 14) - _lhsOdef = - {-# LINE 945 "./TypeChecking.ag" #-} - (name_, _typInamedType) - {-# LINE 8605 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOdef))) --- VarDefList -------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attributes: - annotatedTree : SELF - defs : [(String,Type)] - alternatives: - alternative Cons: - child hd : VarDef - child tl : VarDefList - visit 0: - local annotatedTree : _ - alternative Nil: - visit 0: - local annotatedTree : _ --} -type VarDefList = [(VarDef)] --- cata -sem_VarDefList :: VarDefList -> - T_VarDefList -sem_VarDefList list = - (Prelude.foldr sem_VarDefList_Cons sem_VarDefList_Nil (Prelude.map sem_VarDef list) ) --- semantic domain -type T_VarDefList = Environment -> - ( VarDefList,([(String,Type)])) -data Inh_VarDefList = Inh_VarDefList {env_Inh_VarDefList :: Environment} -data Syn_VarDefList = Syn_VarDefList {annotatedTree_Syn_VarDefList :: VarDefList,defs_Syn_VarDefList :: [(String,Type)]} -wrap_VarDefList :: T_VarDefList -> - Inh_VarDefList -> - Syn_VarDefList -wrap_VarDefList sem (Inh_VarDefList _lhsIenv ) = - (let ( _lhsOannotatedTree,_lhsOdefs) = - (sem _lhsIenv ) - in (Syn_VarDefList _lhsOannotatedTree _lhsOdefs )) -sem_VarDefList_Cons :: T_VarDef -> - T_VarDefList -> - T_VarDefList -sem_VarDefList_Cons hd_ tl_ = - (\ _lhsIenv -> - (let _tlOenv :: Environment - _hdOenv :: Environment - _tlIannotatedTree :: VarDefList - _tlIdefs :: ([(String,Type)]) - _hdIannotatedTree :: VarDef - _hdIdef :: ((String,Type)) - _lhsOannotatedTree :: VarDefList - _lhsOdefs :: ([(String,Type)]) - -- copy rule (down) - _tlOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 8660 "AstInternal.hs" #-} - -- copy rule (down) - _hdOenv = - {-# LINE 56 "./TypeChecking.ag" #-} - _lhsIenv - {-# LINE 8665 "AstInternal.hs" #-} - ( _tlIannotatedTree,_tlIdefs) = - (tl_ _tlOenv ) - ( _hdIannotatedTree,_hdIdef) = - (hd_ _hdOenv ) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - (:) _hdIannotatedTree _tlIannotatedTree - {-# LINE 8674 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 8679 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 948, column 12) - _lhsOdefs = - {-# LINE 948 "./TypeChecking.ag" #-} - _hdIdef : _tlIdefs - {-# LINE 8684 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOdefs))) -sem_VarDefList_Nil :: T_VarDefList -sem_VarDefList_Nil = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: VarDefList - _lhsOdefs :: ([(String,Type)]) - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - [] - {-# LINE 8695 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 8700 "AstInternal.hs" #-} - -- "./TypeChecking.ag"(line 949, column 11) - _lhsOdefs = - {-# LINE 949 "./TypeChecking.ag" #-} - [] - {-# LINE 8705 "AstInternal.hs" #-} - in ( _lhsOannotatedTree,_lhsOdefs))) --- Volatility -------------------------------------------------- -{- - visit 0: - inherited attribute: - env : Environment - synthesized attribute: - annotatedTree : SELF - alternatives: - alternative Immutable: - visit 0: - local annotatedTree : _ - alternative Stable: - visit 0: - local annotatedTree : _ - alternative Volatile: - visit 0: - local annotatedTree : _ --} -data Volatility = Immutable - | Stable - | Volatile - deriving ( Data,Eq,Show,Typeable) --- cata -sem_Volatility :: Volatility -> - T_Volatility -sem_Volatility (Immutable ) = - (sem_Volatility_Immutable ) -sem_Volatility (Stable ) = - (sem_Volatility_Stable ) -sem_Volatility (Volatile ) = - (sem_Volatility_Volatile ) --- semantic domain -type T_Volatility = Environment -> - ( Volatility) -data Inh_Volatility = Inh_Volatility {env_Inh_Volatility :: Environment} -data Syn_Volatility = Syn_Volatility {annotatedTree_Syn_Volatility :: Volatility} -wrap_Volatility :: T_Volatility -> - Inh_Volatility -> - Syn_Volatility -wrap_Volatility sem (Inh_Volatility _lhsIenv ) = - (let ( _lhsOannotatedTree) = - (sem _lhsIenv ) - in (Syn_Volatility _lhsOannotatedTree )) -sem_Volatility_Immutable :: T_Volatility -sem_Volatility_Immutable = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Volatility - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Immutable - {-# LINE 8758 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 8763 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_Volatility_Stable :: T_Volatility -sem_Volatility_Stable = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Volatility - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Stable - {-# LINE 8773 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 8778 "AstInternal.hs" #-} - in ( _lhsOannotatedTree))) -sem_Volatility_Volatile :: T_Volatility -sem_Volatility_Volatile = - (\ _lhsIenv -> - (let _lhsOannotatedTree :: Volatility - -- self rule - _annotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - Volatile - {-# LINE 8788 "AstInternal.hs" #-} - -- self rule - _lhsOannotatedTree = - {-# LINE 56 "./TypeChecking.ag" #-} - _annotatedTree - {-# LINE 8793 "AstInternal.hs" #-} +-- UUAGC 0.9.11 (AstInternal.ag) +module Database.HsSqlPpp.AstInternals.AstInternal( + -- {-# LANGUAGE DeriveDataTypeable,RankNTypes,ScopedTypeVariables #-} + -- {-# OPTIONS_HADDOCK hide #-} + --from the ag files: + --ast nodes + Statement (..) + ,SelectExpression (..) + ,FnBody (..) + ,SetClause (..) + ,TableRef (..) + ,JoinExpression (..) + ,JoinType (..) + ,SelectList (..) + ,SelectItem (..) + ,CopySource (..) + ,AttributeDef (..) + ,RowConstraint (..) + ,Constraint (..) + ,TypeAttributeDef (..) + ,ParamDef (..) + ,VarDef (..) + ,RaiseType (..) + ,CombineType (..) + ,Volatility (..) + ,Language (..) + ,TypeName (..) + ,DropType (..) + ,Cascade (..) + ,Direction (..) + ,Distinct (..) + ,Natural (..) + ,IfExists (..) + ,RestartIdentity (..) + ,Expression (..) + ,InList (..) + ,StatementList + ,ExpressionListStatementListPairList + ,ExpressionListStatementListPair + ,ExpressionList + ,StringList + ,ParamDefList + ,AttributeDefList + ,ConstraintList + ,TypeAttributeDefList + ,StringStringListPairList + ,StringStringListPair + ,ExpressionStatementListPairList + ,SetClauseList + ,CaseExpressionListExpressionPairList + ,MaybeExpression + ,TableRefList + ,ExpressionListList + ,SelectItemList + ,OnExpr + ,RowConstraintList + ,VarDefList + ,ExpressionStatementListPair + ,CaseExpressionListExpressionPair + ,CaseExpressionList + ,ExpressionDirectionPair + ,ExpressionDirectionPairList + ,MaybeBoolExpression + -- annotations + ,annotateAst + ,annotateAstEnv + ,annotateExpression + ,annotateAstsEnv + ,annotateAstEnvEnv +) where + +import Data.Maybe +import Data.List +import Debug.Trace +import Control.Monad.Error +import Control.Arrow +import Data.Either +import Control.Applicative +import Data.Generics + +import Database.HsSqlPpp.AstInternals.TypeType +import Database.HsSqlPpp.AstInternals.TypeConversion +import Database.HsSqlPpp.AstInternals.TypeCheckingH +import Database.HsSqlPpp.AstInternals.AstAnnotation +import Database.HsSqlPpp.AstInternals.EnvironmentInternal +import Database.HsSqlPpp.AstInternals.DefaultTemplate1Environment +import Database.HsSqlPpp.Utils + +{-# LINE 607 "AstInternal.ag" #-} + +-- | Takes an ast, and adds annotations, including types, type errors, +-- and statement info. Type checks against defaultEnv. +annotateAst :: StatementList -> StatementList +annotateAst = annotateAstEnv defaultTemplate1Environment + + +-- | As annotateAst but you supply an environment to check +-- against. See Environment module for how to read an Environment from +-- an existing database so you can type check against it. +annotateAstEnv :: Environment -> StatementList -> StatementList +annotateAstEnv env sts = + let t = sem_Root (Root sts) + ta = wrap_Root t Inh_Root {env_Inh_Root = env} + tl = annotatedTree_Syn_Root ta + in case tl of + Root r -> r + +-- | Type check multiple asts, allowing type checking references in later +-- files to definitions in earlier files. +annotateAstsEnv :: Environment -> [StatementList] -> [StatementList] +annotateAstsEnv env sts = + annInt env sts [] + where + annInt e (s:ss) ress = + let (e1,res) = annotateAstEnvEnv e s + in annInt e1 ss (res:ress) + annInt _ [] ress = reverse ress + +-- | Type check an ast, and return the resultant Environment as well +-- as the annotated ast. +annotateAstEnvEnv :: Environment -> StatementList -> (Environment,StatementList) +annotateAstEnvEnv env sts = + let t = sem_Root (Root sts) + ta = wrap_Root t Inh_Root {env_Inh_Root = env} + tl = annotatedTree_Syn_Root ta + env1 = producedEnv_Syn_Root ta + in case tl of + Root r -> (env1,r) + +-- | Testing utility, mainly used to check an expression for type errors +-- or to get its type. +annotateExpression :: Environment -> Expression -> Expression +annotateExpression env ex = + let t = sem_ExpressionRoot (ExpressionRoot ex) + rt = (annotatedTree_Syn_ExpressionRoot + (wrap_ExpressionRoot t Inh_ExpressionRoot {env_Inh_ExpressionRoot = env})) + in case rt of + ExpressionRoot e -> e + +{-# LINE 143 "AstInternal.hs" #-} + +{-# LINE 68 "./TypeChecking.ag" #-} + +annTypesAndErrors :: Data a => a -> Type -> [TypeError] + -> Maybe [AnnotationElement] -> a +annTypesAndErrors item nt errs add = + updateAnnotation modifier item + where + modifier = (([TypeAnnotation nt] ++ fromMaybe [] add ++ + map TypeErrorA errs) ++) + +{-# LINE 155 "AstInternal.hs" #-} + +{-# LINE 424 "./TypeChecking.ag" #-} + +getTbCols c = unwrapSetOfComposite (getTypeAnnotation c) +{-# LINE 160 "AstInternal.hs" #-} + +{-# LINE 499 "./TypeChecking.ag" #-} + + +getFnType :: Environment -> String -> Expression -> Either [TypeError] Type +getFnType env alias = + either Left (Right . snd) . getFunIdens env alias + +getFunIdens :: Environment -> String -> Expression -> Either [TypeError] (String,Type) +getFunIdens env alias fnVal = + case fnVal of + FunCall _ f _ -> + let correlationName = if alias /= "" + then alias + else f + in Right (correlationName, case getTypeAnnotation fnVal of + SetOfType (CompositeType t) -> getCompositeType t + SetOfType x -> UnnamedCompositeType [(correlationName,x)] + y -> UnnamedCompositeType [(correlationName,y)]) + x -> Left [ContextError "FunCall"] + where + getCompositeType t = + case getAttrs env [Composite + ,TableComposite + ,ViewComposite] t of + Just (_,_,a@(UnnamedCompositeType _), _) -> a + _ -> UnnamedCompositeType [] +{-# LINE 188 "AstInternal.hs" #-} + +{-# LINE 552 "./TypeChecking.ag" #-} + + +fixStar :: Expression -> Expression +fixStar = + everywhere (mkT fixStar') + where + fixStar' :: Annotation -> Annotation + fixStar' a = + if TypeAnnotation TypeCheckFailed `elem` a + && any (\an -> + case an of + TypeErrorA (UnrecognisedIdentifier x) | + let (_,iden) = splitIdentifier x + in iden == "*" -> True + _ -> False) a + then filter (\an -> case an of + TypeAnnotation TypeCheckFailed -> False + TypeErrorA (UnrecognisedIdentifier _) -> False + _ -> True) a + else a +{-# LINE 211 "AstInternal.hs" #-} + +{-# LINE 638 "./TypeChecking.ag" #-} + +fixedValue :: a -> a -> a -> a +fixedValue a _ _ = a +{-# LINE 217 "AstInternal.hs" #-} + +{-# LINE 672 "./TypeChecking.ag" #-} + +getCAtts t = + case t of + SetOfType (UnnamedCompositeType t) -> t + _ -> [] +{-# LINE 225 "AstInternal.hs" #-} + +{-# LINE 751 "./TypeChecking.ag" #-} + +getRowTypes :: [Type] -> [Type] +getRowTypes [RowCtor ts] = ts +getRowTypes ts = ts +{-# LINE 232 "AstInternal.hs" #-} +-- AttributeDef ------------------------------------------------ +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + attrName : String + namedType : Type + alternatives: + alternative AttributeDef: + child ann : {Annotation} + child name : {String} + child typ : TypeName + child def : MaybeExpression + child cons : RowConstraintList + visit 0: + local annotatedTree : _ +-} +data AttributeDef = AttributeDef (Annotation) (String) (TypeName) (MaybeExpression) (RowConstraintList) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_AttributeDef :: AttributeDef -> + T_AttributeDef +sem_AttributeDef (AttributeDef _ann _name _typ _def _cons ) = + (sem_AttributeDef_AttributeDef _ann _name (sem_TypeName _typ ) (sem_MaybeExpression _def ) (sem_RowConstraintList _cons ) ) +-- semantic domain +type T_AttributeDef = Environment -> + ( AttributeDef,String,Type) +data Inh_AttributeDef = Inh_AttributeDef {env_Inh_AttributeDef :: Environment} +data Syn_AttributeDef = Syn_AttributeDef {annotatedTree_Syn_AttributeDef :: AttributeDef,attrName_Syn_AttributeDef :: String,namedType_Syn_AttributeDef :: Type} +wrap_AttributeDef :: T_AttributeDef -> + Inh_AttributeDef -> + Syn_AttributeDef +wrap_AttributeDef sem (Inh_AttributeDef _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOattrName,_lhsOnamedType) = + (sem _lhsIenv ) + in (Syn_AttributeDef _lhsOannotatedTree _lhsOattrName _lhsOnamedType )) +sem_AttributeDef_AttributeDef :: Annotation -> + String -> + T_TypeName -> + T_MaybeExpression -> + T_RowConstraintList -> + T_AttributeDef +sem_AttributeDef_AttributeDef ann_ name_ typ_ def_ cons_ = + (\ _lhsIenv -> + (let _lhsOattrName :: String + _lhsOnamedType :: Type + _lhsOannotatedTree :: AttributeDef + _typOenv :: Environment + _defOenv :: Environment + _consOenv :: Environment + _typIannotatedTree :: TypeName + _typInamedType :: Type + _defIannotatedTree :: MaybeExpression + _defIexprType :: (Maybe Type) + _consIannotatedTree :: RowConstraintList + -- "./TypeChecking.ag"(line 789, column 7) + _lhsOattrName = + {-# LINE 789 "./TypeChecking.ag" #-} + name_ + {-# LINE 294 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 790, column 7) + _lhsOnamedType = + {-# LINE 790 "./TypeChecking.ag" #-} + _typInamedType + {-# LINE 299 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + AttributeDef ann_ name_ _typIannotatedTree _defIannotatedTree _consIannotatedTree + {-# LINE 304 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 309 "AstInternal.hs" #-} + -- copy rule (down) + _typOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 314 "AstInternal.hs" #-} + -- copy rule (down) + _defOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 319 "AstInternal.hs" #-} + -- copy rule (down) + _consOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 324 "AstInternal.hs" #-} + ( _typIannotatedTree,_typInamedType) = + (typ_ _typOenv ) + ( _defIannotatedTree,_defIexprType) = + (def_ _defOenv ) + ( _consIannotatedTree) = + (cons_ _consOenv ) + in ( _lhsOannotatedTree,_lhsOattrName,_lhsOnamedType))) +-- AttributeDefList -------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + attrs : [(String, Type)] + alternatives: + alternative Cons: + child hd : AttributeDef + child tl : AttributeDefList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type AttributeDefList = [(AttributeDef)] +-- cata +sem_AttributeDefList :: AttributeDefList -> + T_AttributeDefList +sem_AttributeDefList list = + (Prelude.foldr sem_AttributeDefList_Cons sem_AttributeDefList_Nil (Prelude.map sem_AttributeDef list) ) +-- semantic domain +type T_AttributeDefList = Environment -> + ( AttributeDefList,([(String, Type)])) +data Inh_AttributeDefList = Inh_AttributeDefList {env_Inh_AttributeDefList :: Environment} +data Syn_AttributeDefList = Syn_AttributeDefList {annotatedTree_Syn_AttributeDefList :: AttributeDefList,attrs_Syn_AttributeDefList :: [(String, Type)]} +wrap_AttributeDefList :: T_AttributeDefList -> + Inh_AttributeDefList -> + Syn_AttributeDefList +wrap_AttributeDefList sem (Inh_AttributeDefList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOattrs) = + (sem _lhsIenv ) + in (Syn_AttributeDefList _lhsOannotatedTree _lhsOattrs )) +sem_AttributeDefList_Cons :: T_AttributeDef -> + T_AttributeDefList -> + T_AttributeDefList +sem_AttributeDefList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOattrs :: ([(String, Type)]) + _lhsOannotatedTree :: AttributeDefList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: AttributeDef + _hdIattrName :: String + _hdInamedType :: Type + _tlIannotatedTree :: AttributeDefList + _tlIattrs :: ([(String, Type)]) + -- "./TypeChecking.ag"(line 795, column 12) + _lhsOattrs = + {-# LINE 795 "./TypeChecking.ag" #-} + (_hdIattrName, _hdInamedType) : _tlIattrs + {-# LINE 386 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 391 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 396 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 401 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 406 "AstInternal.hs" #-} + ( _hdIannotatedTree,_hdIattrName,_hdInamedType) = + (hd_ _hdOenv ) + ( _tlIannotatedTree,_tlIattrs) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree,_lhsOattrs))) +sem_AttributeDefList_Nil :: T_AttributeDefList +sem_AttributeDefList_Nil = + (\ _lhsIenv -> + (let _lhsOattrs :: ([(String, Type)]) + _lhsOannotatedTree :: AttributeDefList + -- "./TypeChecking.ag"(line 796, column 11) + _lhsOattrs = + {-# LINE 796 "./TypeChecking.ag" #-} + [] + {-# LINE 421 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 426 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 431 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOattrs))) +-- Cascade ----------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Cascade: + visit 0: + local annotatedTree : _ + alternative Restrict: + visit 0: + local annotatedTree : _ +-} +data Cascade = Cascade + | Restrict + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_Cascade :: Cascade -> + T_Cascade +sem_Cascade (Cascade ) = + (sem_Cascade_Cascade ) +sem_Cascade (Restrict ) = + (sem_Cascade_Restrict ) +-- semantic domain +type T_Cascade = Environment -> + ( Cascade) +data Inh_Cascade = Inh_Cascade {env_Inh_Cascade :: Environment} +data Syn_Cascade = Syn_Cascade {annotatedTree_Syn_Cascade :: Cascade} +wrap_Cascade :: T_Cascade -> + Inh_Cascade -> + Syn_Cascade +wrap_Cascade sem (Inh_Cascade _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_Cascade _lhsOannotatedTree )) +sem_Cascade_Cascade :: T_Cascade +sem_Cascade_Cascade = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Cascade + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Cascade + {-# LINE 478 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 483 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_Cascade_Restrict :: T_Cascade +sem_Cascade_Restrict = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Cascade + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Restrict + {-# LINE 493 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 498 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- CaseExpressionList ------------------------------------------ +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Cons: + child hd : Expression + child tl : CaseExpressionList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type CaseExpressionList = [(Expression)] +-- cata +sem_CaseExpressionList :: CaseExpressionList -> + T_CaseExpressionList +sem_CaseExpressionList list = + (Prelude.foldr sem_CaseExpressionList_Cons sem_CaseExpressionList_Nil (Prelude.map sem_Expression list) ) +-- semantic domain +type T_CaseExpressionList = Environment -> + ( CaseExpressionList) +data Inh_CaseExpressionList = Inh_CaseExpressionList {env_Inh_CaseExpressionList :: Environment} +data Syn_CaseExpressionList = Syn_CaseExpressionList {annotatedTree_Syn_CaseExpressionList :: CaseExpressionList} +wrap_CaseExpressionList :: T_CaseExpressionList -> + Inh_CaseExpressionList -> + Syn_CaseExpressionList +wrap_CaseExpressionList sem (Inh_CaseExpressionList _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_CaseExpressionList _lhsOannotatedTree )) +sem_CaseExpressionList_Cons :: T_Expression -> + T_CaseExpressionList -> + T_CaseExpressionList +sem_CaseExpressionList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: CaseExpressionList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: Expression + _hdIliftedColumnName :: String + _tlIannotatedTree :: CaseExpressionList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 550 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 555 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 560 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 565 "AstInternal.hs" #-} + ( _hdIannotatedTree,_hdIliftedColumnName) = + (hd_ _hdOenv ) + ( _tlIannotatedTree) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree))) +sem_CaseExpressionList_Nil :: T_CaseExpressionList +sem_CaseExpressionList_Nil = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: CaseExpressionList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 579 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 584 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- CaseExpressionListExpressionPair ---------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Tuple: + child x1 : CaseExpressionList + child x2 : Expression + visit 0: + local annotatedTree : _ +-} +type CaseExpressionListExpressionPair = ( (CaseExpressionList),(Expression)) +-- cata +sem_CaseExpressionListExpressionPair :: CaseExpressionListExpressionPair -> + T_CaseExpressionListExpressionPair +sem_CaseExpressionListExpressionPair ( x1,x2) = + (sem_CaseExpressionListExpressionPair_Tuple (sem_CaseExpressionList x1 ) (sem_Expression x2 ) ) +-- semantic domain +type T_CaseExpressionListExpressionPair = Environment -> + ( CaseExpressionListExpressionPair) +data Inh_CaseExpressionListExpressionPair = Inh_CaseExpressionListExpressionPair {env_Inh_CaseExpressionListExpressionPair :: Environment} +data Syn_CaseExpressionListExpressionPair = Syn_CaseExpressionListExpressionPair {annotatedTree_Syn_CaseExpressionListExpressionPair :: CaseExpressionListExpressionPair} +wrap_CaseExpressionListExpressionPair :: T_CaseExpressionListExpressionPair -> + Inh_CaseExpressionListExpressionPair -> + Syn_CaseExpressionListExpressionPair +wrap_CaseExpressionListExpressionPair sem (Inh_CaseExpressionListExpressionPair _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_CaseExpressionListExpressionPair _lhsOannotatedTree )) +sem_CaseExpressionListExpressionPair_Tuple :: T_CaseExpressionList -> + T_Expression -> + T_CaseExpressionListExpressionPair +sem_CaseExpressionListExpressionPair_Tuple x1_ x2_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: CaseExpressionListExpressionPair + _x1Oenv :: Environment + _x2Oenv :: Environment + _x1IannotatedTree :: CaseExpressionList + _x2IannotatedTree :: Expression + _x2IliftedColumnName :: String + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (_x1IannotatedTree,_x2IannotatedTree) + {-# LINE 633 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 638 "AstInternal.hs" #-} + -- copy rule (down) + _x1Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 643 "AstInternal.hs" #-} + -- copy rule (down) + _x2Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 648 "AstInternal.hs" #-} + ( _x1IannotatedTree) = + (x1_ _x1Oenv ) + ( _x2IannotatedTree,_x2IliftedColumnName) = + (x2_ _x2Oenv ) + in ( _lhsOannotatedTree))) +-- CaseExpressionListExpressionPairList ------------------------ +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Cons: + child hd : CaseExpressionListExpressionPair + child tl : CaseExpressionListExpressionPairList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type CaseExpressionListExpressionPairList = [(CaseExpressionListExpressionPair)] +-- cata +sem_CaseExpressionListExpressionPairList :: CaseExpressionListExpressionPairList -> + T_CaseExpressionListExpressionPairList +sem_CaseExpressionListExpressionPairList list = + (Prelude.foldr sem_CaseExpressionListExpressionPairList_Cons sem_CaseExpressionListExpressionPairList_Nil (Prelude.map sem_CaseExpressionListExpressionPair list) ) +-- semantic domain +type T_CaseExpressionListExpressionPairList = Environment -> + ( CaseExpressionListExpressionPairList) +data Inh_CaseExpressionListExpressionPairList = Inh_CaseExpressionListExpressionPairList {env_Inh_CaseExpressionListExpressionPairList :: Environment} +data Syn_CaseExpressionListExpressionPairList = Syn_CaseExpressionListExpressionPairList {annotatedTree_Syn_CaseExpressionListExpressionPairList :: CaseExpressionListExpressionPairList} +wrap_CaseExpressionListExpressionPairList :: T_CaseExpressionListExpressionPairList -> + Inh_CaseExpressionListExpressionPairList -> + Syn_CaseExpressionListExpressionPairList +wrap_CaseExpressionListExpressionPairList sem (Inh_CaseExpressionListExpressionPairList _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_CaseExpressionListExpressionPairList _lhsOannotatedTree )) +sem_CaseExpressionListExpressionPairList_Cons :: T_CaseExpressionListExpressionPair -> + T_CaseExpressionListExpressionPairList -> + T_CaseExpressionListExpressionPairList +sem_CaseExpressionListExpressionPairList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: CaseExpressionListExpressionPairList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: CaseExpressionListExpressionPair + _tlIannotatedTree :: CaseExpressionListExpressionPairList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 703 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 708 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 713 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 718 "AstInternal.hs" #-} + ( _hdIannotatedTree) = + (hd_ _hdOenv ) + ( _tlIannotatedTree) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree))) +sem_CaseExpressionListExpressionPairList_Nil :: T_CaseExpressionListExpressionPairList +sem_CaseExpressionListExpressionPairList_Nil = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: CaseExpressionListExpressionPairList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 732 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 737 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- CombineType ------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Except: + visit 0: + local annotatedTree : _ + alternative Intersect: + visit 0: + local annotatedTree : _ + alternative Union: + visit 0: + local annotatedTree : _ + alternative UnionAll: + visit 0: + local annotatedTree : _ +-} +data CombineType = Except + | Intersect + | Union + | UnionAll + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_CombineType :: CombineType -> + T_CombineType +sem_CombineType (Except ) = + (sem_CombineType_Except ) +sem_CombineType (Intersect ) = + (sem_CombineType_Intersect ) +sem_CombineType (Union ) = + (sem_CombineType_Union ) +sem_CombineType (UnionAll ) = + (sem_CombineType_UnionAll ) +-- semantic domain +type T_CombineType = Environment -> + ( CombineType) +data Inh_CombineType = Inh_CombineType {env_Inh_CombineType :: Environment} +data Syn_CombineType = Syn_CombineType {annotatedTree_Syn_CombineType :: CombineType} +wrap_CombineType :: T_CombineType -> + Inh_CombineType -> + Syn_CombineType +wrap_CombineType sem (Inh_CombineType _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_CombineType _lhsOannotatedTree )) +sem_CombineType_Except :: T_CombineType +sem_CombineType_Except = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: CombineType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Except + {-# LINE 796 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 801 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_CombineType_Intersect :: T_CombineType +sem_CombineType_Intersect = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: CombineType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Intersect + {-# LINE 811 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 816 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_CombineType_Union :: T_CombineType +sem_CombineType_Union = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: CombineType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Union + {-# LINE 826 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 831 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_CombineType_UnionAll :: T_CombineType +sem_CombineType_UnionAll = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: CombineType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + UnionAll + {-# LINE 841 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 846 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- Constraint -------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative CheckConstraint: + child ann : {Annotation} + child expression : Expression + visit 0: + local annotatedTree : _ + alternative PrimaryKeyConstraint: + child ann : {Annotation} + child stringList : StringList + visit 0: + local annotatedTree : _ + alternative ReferenceConstraint: + child ann : {Annotation} + child atts : StringList + child table : {String} + child tableAtts : StringList + child onUpdate : Cascade + child onDelete : Cascade + visit 0: + local annotatedTree : _ + alternative UniqueConstraint: + child ann : {Annotation} + child stringList : StringList + visit 0: + local annotatedTree : _ +-} +data Constraint = CheckConstraint (Annotation) (Expression) + | PrimaryKeyConstraint (Annotation) (StringList) + | ReferenceConstraint (Annotation) (StringList) (String) (StringList) (Cascade) (Cascade) + | UniqueConstraint (Annotation) (StringList) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_Constraint :: Constraint -> + T_Constraint +sem_Constraint (CheckConstraint _ann _expression ) = + (sem_Constraint_CheckConstraint _ann (sem_Expression _expression ) ) +sem_Constraint (PrimaryKeyConstraint _ann _stringList ) = + (sem_Constraint_PrimaryKeyConstraint _ann (sem_StringList _stringList ) ) +sem_Constraint (ReferenceConstraint _ann _atts _table _tableAtts _onUpdate _onDelete ) = + (sem_Constraint_ReferenceConstraint _ann (sem_StringList _atts ) _table (sem_StringList _tableAtts ) (sem_Cascade _onUpdate ) (sem_Cascade _onDelete ) ) +sem_Constraint (UniqueConstraint _ann _stringList ) = + (sem_Constraint_UniqueConstraint _ann (sem_StringList _stringList ) ) +-- semantic domain +type T_Constraint = Environment -> + ( Constraint) +data Inh_Constraint = Inh_Constraint {env_Inh_Constraint :: Environment} +data Syn_Constraint = Syn_Constraint {annotatedTree_Syn_Constraint :: Constraint} +wrap_Constraint :: T_Constraint -> + Inh_Constraint -> + Syn_Constraint +wrap_Constraint sem (Inh_Constraint _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_Constraint _lhsOannotatedTree )) +sem_Constraint_CheckConstraint :: Annotation -> + T_Expression -> + T_Constraint +sem_Constraint_CheckConstraint ann_ expression_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Constraint + _expressionOenv :: Environment + _expressionIannotatedTree :: Expression + _expressionIliftedColumnName :: String + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CheckConstraint ann_ _expressionIannotatedTree + {-# LINE 922 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 927 "AstInternal.hs" #-} + -- copy rule (down) + _expressionOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 932 "AstInternal.hs" #-} + ( _expressionIannotatedTree,_expressionIliftedColumnName) = + (expression_ _expressionOenv ) + in ( _lhsOannotatedTree))) +sem_Constraint_PrimaryKeyConstraint :: Annotation -> + T_StringList -> + T_Constraint +sem_Constraint_PrimaryKeyConstraint ann_ stringList_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Constraint + _stringListOenv :: Environment + _stringListIannotatedTree :: StringList + _stringListIstrings :: ([String]) + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + PrimaryKeyConstraint ann_ _stringListIannotatedTree + {-# LINE 949 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 954 "AstInternal.hs" #-} + -- copy rule (down) + _stringListOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 959 "AstInternal.hs" #-} + ( _stringListIannotatedTree,_stringListIstrings) = + (stringList_ _stringListOenv ) + in ( _lhsOannotatedTree))) +sem_Constraint_ReferenceConstraint :: Annotation -> + T_StringList -> + String -> + T_StringList -> + T_Cascade -> + T_Cascade -> + T_Constraint +sem_Constraint_ReferenceConstraint ann_ atts_ table_ tableAtts_ onUpdate_ onDelete_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Constraint + _attsOenv :: Environment + _tableAttsOenv :: Environment + _onUpdateOenv :: Environment + _onDeleteOenv :: Environment + _attsIannotatedTree :: StringList + _attsIstrings :: ([String]) + _tableAttsIannotatedTree :: StringList + _tableAttsIstrings :: ([String]) + _onUpdateIannotatedTree :: Cascade + _onDeleteIannotatedTree :: Cascade + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ReferenceConstraint ann_ _attsIannotatedTree table_ _tableAttsIannotatedTree _onUpdateIannotatedTree _onDeleteIannotatedTree + {-# LINE 987 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 992 "AstInternal.hs" #-} + -- copy rule (down) + _attsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 997 "AstInternal.hs" #-} + -- copy rule (down) + _tableAttsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1002 "AstInternal.hs" #-} + -- copy rule (down) + _onUpdateOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1007 "AstInternal.hs" #-} + -- copy rule (down) + _onDeleteOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1012 "AstInternal.hs" #-} + ( _attsIannotatedTree,_attsIstrings) = + (atts_ _attsOenv ) + ( _tableAttsIannotatedTree,_tableAttsIstrings) = + (tableAtts_ _tableAttsOenv ) + ( _onUpdateIannotatedTree) = + (onUpdate_ _onUpdateOenv ) + ( _onDeleteIannotatedTree) = + (onDelete_ _onDeleteOenv ) + in ( _lhsOannotatedTree))) +sem_Constraint_UniqueConstraint :: Annotation -> + T_StringList -> + T_Constraint +sem_Constraint_UniqueConstraint ann_ stringList_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Constraint + _stringListOenv :: Environment + _stringListIannotatedTree :: StringList + _stringListIstrings :: ([String]) + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + UniqueConstraint ann_ _stringListIannotatedTree + {-# LINE 1035 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1040 "AstInternal.hs" #-} + -- copy rule (down) + _stringListOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1045 "AstInternal.hs" #-} + ( _stringListIannotatedTree,_stringListIstrings) = + (stringList_ _stringListOenv ) + in ( _lhsOannotatedTree))) +-- ConstraintList ---------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Cons: + child hd : Constraint + child tl : ConstraintList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type ConstraintList = [(Constraint)] +-- cata +sem_ConstraintList :: ConstraintList -> + T_ConstraintList +sem_ConstraintList list = + (Prelude.foldr sem_ConstraintList_Cons sem_ConstraintList_Nil (Prelude.map sem_Constraint list) ) +-- semantic domain +type T_ConstraintList = Environment -> + ( ConstraintList) +data Inh_ConstraintList = Inh_ConstraintList {env_Inh_ConstraintList :: Environment} +data Syn_ConstraintList = Syn_ConstraintList {annotatedTree_Syn_ConstraintList :: ConstraintList} +wrap_ConstraintList :: T_ConstraintList -> + Inh_ConstraintList -> + Syn_ConstraintList +wrap_ConstraintList sem (Inh_ConstraintList _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_ConstraintList _lhsOannotatedTree )) +sem_ConstraintList_Cons :: T_Constraint -> + T_ConstraintList -> + T_ConstraintList +sem_ConstraintList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: ConstraintList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: Constraint + _tlIannotatedTree :: ConstraintList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 1098 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1103 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1108 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1113 "AstInternal.hs" #-} + ( _hdIannotatedTree) = + (hd_ _hdOenv ) + ( _tlIannotatedTree) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree))) +sem_ConstraintList_Nil :: T_ConstraintList +sem_ConstraintList_Nil = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: ConstraintList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 1127 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1132 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- CopySource -------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative CopyFilename: + child string : {String} + visit 0: + local annotatedTree : _ + alternative Stdin: + visit 0: + local annotatedTree : _ +-} +data CopySource = CopyFilename (String) + | Stdin + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_CopySource :: CopySource -> + T_CopySource +sem_CopySource (CopyFilename _string ) = + (sem_CopySource_CopyFilename _string ) +sem_CopySource (Stdin ) = + (sem_CopySource_Stdin ) +-- semantic domain +type T_CopySource = Environment -> + ( CopySource) +data Inh_CopySource = Inh_CopySource {env_Inh_CopySource :: Environment} +data Syn_CopySource = Syn_CopySource {annotatedTree_Syn_CopySource :: CopySource} +wrap_CopySource :: T_CopySource -> + Inh_CopySource -> + Syn_CopySource +wrap_CopySource sem (Inh_CopySource _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_CopySource _lhsOannotatedTree )) +sem_CopySource_CopyFilename :: String -> + T_CopySource +sem_CopySource_CopyFilename string_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: CopySource + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CopyFilename string_ + {-# LINE 1181 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1186 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_CopySource_Stdin :: T_CopySource +sem_CopySource_Stdin = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: CopySource + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Stdin + {-# LINE 1196 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1201 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- Direction --------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Asc: + visit 0: + local annotatedTree : _ + alternative Desc: + visit 0: + local annotatedTree : _ +-} +data Direction = Asc + | Desc + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_Direction :: Direction -> + T_Direction +sem_Direction (Asc ) = + (sem_Direction_Asc ) +sem_Direction (Desc ) = + (sem_Direction_Desc ) +-- semantic domain +type T_Direction = Environment -> + ( Direction) +data Inh_Direction = Inh_Direction {env_Inh_Direction :: Environment} +data Syn_Direction = Syn_Direction {annotatedTree_Syn_Direction :: Direction} +wrap_Direction :: T_Direction -> + Inh_Direction -> + Syn_Direction +wrap_Direction sem (Inh_Direction _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_Direction _lhsOannotatedTree )) +sem_Direction_Asc :: T_Direction +sem_Direction_Asc = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Direction + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Asc + {-# LINE 1248 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1253 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_Direction_Desc :: T_Direction +sem_Direction_Desc = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Direction + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Desc + {-# LINE 1263 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1268 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- Distinct ---------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Distinct: + visit 0: + local annotatedTree : _ + alternative Dupes: + visit 0: + local annotatedTree : _ +-} +data Distinct = Distinct + | Dupes + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_Distinct :: Distinct -> + T_Distinct +sem_Distinct (Distinct ) = + (sem_Distinct_Distinct ) +sem_Distinct (Dupes ) = + (sem_Distinct_Dupes ) +-- semantic domain +type T_Distinct = Environment -> + ( Distinct) +data Inh_Distinct = Inh_Distinct {env_Inh_Distinct :: Environment} +data Syn_Distinct = Syn_Distinct {annotatedTree_Syn_Distinct :: Distinct} +wrap_Distinct :: T_Distinct -> + Inh_Distinct -> + Syn_Distinct +wrap_Distinct sem (Inh_Distinct _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_Distinct _lhsOannotatedTree )) +sem_Distinct_Distinct :: T_Distinct +sem_Distinct_Distinct = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Distinct + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Distinct + {-# LINE 1315 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1320 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_Distinct_Dupes :: T_Distinct +sem_Distinct_Dupes = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Distinct + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Dupes + {-# LINE 1330 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1335 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- DropType ---------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Domain: + visit 0: + local annotatedTree : _ + alternative Table: + visit 0: + local annotatedTree : _ + alternative Type: + visit 0: + local annotatedTree : _ + alternative View: + visit 0: + local annotatedTree : _ +-} +data DropType = Domain + | Table + | Type + | View + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_DropType :: DropType -> + T_DropType +sem_DropType (Domain ) = + (sem_DropType_Domain ) +sem_DropType (Table ) = + (sem_DropType_Table ) +sem_DropType (Type ) = + (sem_DropType_Type ) +sem_DropType (View ) = + (sem_DropType_View ) +-- semantic domain +type T_DropType = Environment -> + ( DropType) +data Inh_DropType = Inh_DropType {env_Inh_DropType :: Environment} +data Syn_DropType = Syn_DropType {annotatedTree_Syn_DropType :: DropType} +wrap_DropType :: T_DropType -> + Inh_DropType -> + Syn_DropType +wrap_DropType sem (Inh_DropType _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_DropType _lhsOannotatedTree )) +sem_DropType_Domain :: T_DropType +sem_DropType_Domain = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: DropType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Domain + {-# LINE 1394 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1399 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_DropType_Table :: T_DropType +sem_DropType_Table = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: DropType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Table + {-# LINE 1409 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1414 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_DropType_Type :: T_DropType +sem_DropType_Type = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: DropType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Type + {-# LINE 1424 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1429 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_DropType_View :: T_DropType +sem_DropType_View = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: DropType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + View + {-# LINE 1439 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 1444 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- Expression -------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + liftedColumnName : String + alternatives: + alternative BooleanLit: + child ann : {Annotation} + child b : {Bool} + visit 0: + local backTree : _ + local tpe : _ + local annotatedTree : _ + alternative Case: + child ann : {Annotation} + child cases : CaseExpressionListExpressionPairList + child els : MaybeExpression + visit 0: + local whenTypes : _ + local thenTypes : _ + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative CaseSimple: + child ann : {Annotation} + child value : Expression + child cases : CaseExpressionListExpressionPairList + child els : MaybeExpression + visit 0: + local whenTypes : _ + local thenTypes : _ + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative Cast: + child ann : {Annotation} + child expr : Expression + child tn : TypeName + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative Exists: + child ann : {Annotation} + child sel : SelectExpression + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative FloatLit: + child ann : {Annotation} + child d : {Double} + visit 0: + local backTree : _ + local tpe : _ + local annotatedTree : _ + alternative FunCall: + child ann : {Annotation} + child funName : {String} + child args : ExpressionList + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative Identifier: + child ann : {Annotation} + child i : {String} + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative InPredicate: + child ann : {Annotation} + child expr : Expression + child i : {Bool} + child list : InList + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative IntegerLit: + child ann : {Annotation} + child i : {Integer} + visit 0: + local backTree : _ + local tpe : _ + local annotatedTree : _ + alternative NullLit: + child ann : {Annotation} + visit 0: + local backTree : _ + local tpe : _ + local annotatedTree : _ + alternative PositionalArg: + child ann : {Annotation} + child p : {Integer} + visit 0: + local annotatedTree : _ + alternative ScalarSubQuery: + child ann : {Annotation} + child sel : SelectExpression + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative StringLit: + child ann : {Annotation} + child quote : {String} + child value : {String} + visit 0: + local backTree : _ + local tpe : _ + local annotatedTree : _ + alternative WindowFn: + child ann : {Annotation} + child fn : Expression + child partitionBy : ExpressionList + child orderBy : ExpressionList + child dir : Direction + visit 0: + local annotatedTree : _ +-} +data Expression = BooleanLit (Annotation) (Bool) + | Case (Annotation) (CaseExpressionListExpressionPairList) (MaybeExpression) + | CaseSimple (Annotation) (Expression) (CaseExpressionListExpressionPairList) (MaybeExpression) + | Cast (Annotation) (Expression) (TypeName) + | Exists (Annotation) (SelectExpression) + | FloatLit (Annotation) (Double) + | FunCall (Annotation) (String) (ExpressionList) + | Identifier (Annotation) (String) + | InPredicate (Annotation) (Expression) (Bool) (InList) + | IntegerLit (Annotation) (Integer) + | NullLit (Annotation) + | PositionalArg (Annotation) (Integer) + | ScalarSubQuery (Annotation) (SelectExpression) + | StringLit (Annotation) (String) (String) + | WindowFn (Annotation) (Expression) (ExpressionList) (ExpressionList) (Direction) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (BooleanLit _ann _b ) = + (sem_Expression_BooleanLit _ann _b ) +sem_Expression (Case _ann _cases _els ) = + (sem_Expression_Case _ann (sem_CaseExpressionListExpressionPairList _cases ) (sem_MaybeExpression _els ) ) +sem_Expression (CaseSimple _ann _value _cases _els ) = + (sem_Expression_CaseSimple _ann (sem_Expression _value ) (sem_CaseExpressionListExpressionPairList _cases ) (sem_MaybeExpression _els ) ) +sem_Expression (Cast _ann _expr _tn ) = + (sem_Expression_Cast _ann (sem_Expression _expr ) (sem_TypeName _tn ) ) +sem_Expression (Exists _ann _sel ) = + (sem_Expression_Exists _ann (sem_SelectExpression _sel ) ) +sem_Expression (FloatLit _ann _d ) = + (sem_Expression_FloatLit _ann _d ) +sem_Expression (FunCall _ann _funName _args ) = + (sem_Expression_FunCall _ann _funName (sem_ExpressionList _args ) ) +sem_Expression (Identifier _ann _i ) = + (sem_Expression_Identifier _ann _i ) +sem_Expression (InPredicate _ann _expr _i _list ) = + (sem_Expression_InPredicate _ann (sem_Expression _expr ) _i (sem_InList _list ) ) +sem_Expression (IntegerLit _ann _i ) = + (sem_Expression_IntegerLit _ann _i ) +sem_Expression (NullLit _ann ) = + (sem_Expression_NullLit _ann ) +sem_Expression (PositionalArg _ann _p ) = + (sem_Expression_PositionalArg _ann _p ) +sem_Expression (ScalarSubQuery _ann _sel ) = + (sem_Expression_ScalarSubQuery _ann (sem_SelectExpression _sel ) ) +sem_Expression (StringLit _ann _quote _value ) = + (sem_Expression_StringLit _ann _quote _value ) +sem_Expression (WindowFn _ann _fn _partitionBy _orderBy _dir ) = + (sem_Expression_WindowFn _ann (sem_Expression _fn ) (sem_ExpressionList _partitionBy ) (sem_ExpressionList _orderBy ) (sem_Direction _dir ) ) +-- semantic domain +type T_Expression = Environment -> + ( Expression,String) +data Inh_Expression = Inh_Expression {env_Inh_Expression :: Environment} +data Syn_Expression = Syn_Expression {annotatedTree_Syn_Expression :: Expression,liftedColumnName_Syn_Expression :: String} +wrap_Expression :: T_Expression -> + Inh_Expression -> + Syn_Expression +wrap_Expression sem (Inh_Expression _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOliftedColumnName) = + (sem _lhsIenv ) + in (Syn_Expression _lhsOannotatedTree _lhsOliftedColumnName )) +sem_Expression_BooleanLit :: Annotation -> + Bool -> + T_Expression +sem_Expression_BooleanLit ann_ b_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 1646 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 100, column 9) + _backTree = + {-# LINE 100 "./TypeChecking.ag" #-} + BooleanLit ann_ b_ + {-# LINE 1651 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 108, column 19) + _tpe = + {-# LINE 108 "./TypeChecking.ag" #-} + Right typeBool + {-# LINE 1656 "AstInternal.hs" #-} + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + "" + {-# LINE 1661 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + BooleanLit ann_ b_ + {-# LINE 1666 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_Case :: Annotation -> + T_CaseExpressionListExpressionPairList -> + T_MaybeExpression -> + T_Expression +sem_Expression_Case ann_ cases_ els_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + _casesOenv :: Environment + _elsOenv :: Environment + _casesIannotatedTree :: CaseExpressionListExpressionPairList + _elsIannotatedTree :: MaybeExpression + _elsIexprType :: (Maybe Type) + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 1688 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 182, column 9) + _whenTypes = + {-# LINE 182 "./TypeChecking.ag" #-} + map getTypeAnnotation $ concatMap fst $ + _casesIannotatedTree + {-# LINE 1694 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 184, column 9) + _thenTypes = + {-# LINE 184 "./TypeChecking.ag" #-} + map getTypeAnnotation $ + (map snd $ _casesIannotatedTree) ++ + maybeToList _elsIannotatedTree + {-# LINE 1701 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 190, column 9) + _tpe = + {-# LINE 190 "./TypeChecking.ag" #-} + chainTypeCheckFailed _whenTypes $ do + when (any (/= typeBool) _whenTypes ) $ + Left [WrongTypes typeBool _whenTypes ] + chainTypeCheckFailed _thenTypes $ + resolveResultSetType + _lhsIenv + _thenTypes + {-# LINE 1712 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 198, column 9) + _backTree = + {-# LINE 198 "./TypeChecking.ag" #-} + Case ann_ _casesIannotatedTree _elsIannotatedTree + {-# LINE 1717 "AstInternal.hs" #-} + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + "" + {-# LINE 1722 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Case ann_ _casesIannotatedTree _elsIannotatedTree + {-# LINE 1727 "AstInternal.hs" #-} + -- copy rule (down) + _casesOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1732 "AstInternal.hs" #-} + -- copy rule (down) + _elsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1737 "AstInternal.hs" #-} + ( _casesIannotatedTree) = + (cases_ _casesOenv ) + ( _elsIannotatedTree,_elsIexprType) = + (els_ _elsOenv ) + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_CaseSimple :: Annotation -> + T_Expression -> + T_CaseExpressionListExpressionPairList -> + T_MaybeExpression -> + T_Expression +sem_Expression_CaseSimple ann_ value_ cases_ els_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + _valueOenv :: Environment + _casesOenv :: Environment + _elsOenv :: Environment + _valueIannotatedTree :: Expression + _valueIliftedColumnName :: String + _casesIannotatedTree :: CaseExpressionListExpressionPairList + _elsIannotatedTree :: MaybeExpression + _elsIexprType :: (Maybe Type) + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 1767 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 182, column 9) + _whenTypes = + {-# LINE 182 "./TypeChecking.ag" #-} + map getTypeAnnotation $ concatMap fst $ + _casesIannotatedTree + {-# LINE 1773 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 184, column 9) + _thenTypes = + {-# LINE 184 "./TypeChecking.ag" #-} + map getTypeAnnotation $ + (map snd $ _casesIannotatedTree) ++ + maybeToList _elsIannotatedTree + {-# LINE 1780 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 203, column 9) + _tpe = + {-# LINE 203 "./TypeChecking.ag" #-} + chainTypeCheckFailed _whenTypes $ do + checkWhenTypes <- resolveResultSetType + _lhsIenv + (getTypeAnnotation _valueIannotatedTree: _whenTypes ) + chainTypeCheckFailed _thenTypes $ + resolveResultSetType + _lhsIenv + _thenTypes + {-# LINE 1792 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 212, column 9) + _backTree = + {-# LINE 212 "./TypeChecking.ag" #-} + CaseSimple ann_ _valueIannotatedTree _casesIannotatedTree _elsIannotatedTree + {-# LINE 1797 "AstInternal.hs" #-} + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + _valueIliftedColumnName + {-# LINE 1802 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CaseSimple ann_ _valueIannotatedTree _casesIannotatedTree _elsIannotatedTree + {-# LINE 1807 "AstInternal.hs" #-} + -- copy rule (down) + _valueOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1812 "AstInternal.hs" #-} + -- copy rule (down) + _casesOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1817 "AstInternal.hs" #-} + -- copy rule (down) + _elsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1822 "AstInternal.hs" #-} + ( _valueIannotatedTree,_valueIliftedColumnName) = + (value_ _valueOenv ) + ( _casesIannotatedTree) = + (cases_ _casesOenv ) + ( _elsIannotatedTree,_elsIexprType) = + (els_ _elsOenv ) + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_Cast :: Annotation -> + T_Expression -> + T_TypeName -> + T_Expression +sem_Expression_Cast ann_ expr_ tn_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + _exprOenv :: Environment + _tnOenv :: Environment + _exprIannotatedTree :: Expression + _exprIliftedColumnName :: String + _tnIannotatedTree :: TypeName + _tnInamedType :: Type + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 1851 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 120, column 12) + _tpe = + {-# LINE 120 "./TypeChecking.ag" #-} + Right $ _tnInamedType + {-# LINE 1856 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 121, column 12) + _backTree = + {-# LINE 121 "./TypeChecking.ag" #-} + Cast ann_ _exprIannotatedTree _tnIannotatedTree + {-# LINE 1861 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 654, column 10) + _lhsOliftedColumnName = + {-# LINE 654 "./TypeChecking.ag" #-} + case _tnIannotatedTree of + SimpleTypeName _ tn -> tn + _ -> "" + {-# LINE 1868 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Cast ann_ _exprIannotatedTree _tnIannotatedTree + {-# LINE 1873 "AstInternal.hs" #-} + -- copy rule (down) + _exprOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1878 "AstInternal.hs" #-} + -- copy rule (down) + _tnOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1883 "AstInternal.hs" #-} + ( _exprIannotatedTree,_exprIliftedColumnName) = + (expr_ _exprOenv ) + ( _tnIannotatedTree,_tnInamedType) = + (tn_ _tnOenv ) + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_Exists :: Annotation -> + T_SelectExpression -> + T_Expression +sem_Expression_Exists ann_ sel_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + _selOenv :: Environment + _selIannotatedTree :: SelectExpression + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 1905 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 228, column 9) + _tpe = + {-# LINE 228 "./TypeChecking.ag" #-} + Right typeBool + {-# LINE 1910 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 229, column 9) + _backTree = + {-# LINE 229 "./TypeChecking.ag" #-} + Exists ann_ _selIannotatedTree + {-# LINE 1915 "AstInternal.hs" #-} + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + "" + {-# LINE 1920 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Exists ann_ _selIannotatedTree + {-# LINE 1925 "AstInternal.hs" #-} + -- copy rule (down) + _selOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 1930 "AstInternal.hs" #-} + ( _selIannotatedTree) = + (sel_ _selOenv ) + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_FloatLit :: Annotation -> + Double -> + T_Expression +sem_Expression_FloatLit ann_ d_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 1948 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 98, column 9) + _backTree = + {-# LINE 98 "./TypeChecking.ag" #-} + FloatLit ann_ d_ + {-# LINE 1953 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 107, column 17) + _tpe = + {-# LINE 107 "./TypeChecking.ag" #-} + Right typeNumeric + {-# LINE 1958 "AstInternal.hs" #-} + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + "" + {-# LINE 1963 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + FloatLit ann_ d_ + {-# LINE 1968 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_FunCall :: Annotation -> + String -> + T_ExpressionList -> + T_Expression +sem_Expression_FunCall ann_ funName_ args_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + _argsOenv :: Environment + _argsIannotatedTree :: ExpressionList + _argsItypeList :: ([Type]) + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 1988 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 161, column 9) + _tpe = + {-# LINE 161 "./TypeChecking.ag" #-} + chainTypeCheckFailed _argsItypeList $ + typeCheckFunCall + _lhsIenv + funName_ + _argsItypeList + {-# LINE 1997 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 166, column 9) + _backTree = + {-# LINE 166 "./TypeChecking.ag" #-} + FunCall ann_ funName_ _argsIannotatedTree + {-# LINE 2002 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 650, column 13) + _lhsOliftedColumnName = + {-# LINE 650 "./TypeChecking.ag" #-} + if isOperatorName funName_ + then "" + else funName_ + {-# LINE 2009 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + FunCall ann_ funName_ _argsIannotatedTree + {-# LINE 2014 "AstInternal.hs" #-} + -- copy rule (down) + _argsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2019 "AstInternal.hs" #-} + ( _argsIannotatedTree,_argsItypeList) = + (args_ _argsOenv ) + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_Identifier :: Annotation -> + String -> + T_Expression +sem_Expression_Identifier ann_ i_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 2037 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 222, column 9) + _tpe = + {-# LINE 222 "./TypeChecking.ag" #-} + let (correlationName,iden) = splitIdentifier i_ + in envLookupID _lhsIenv correlationName iden + {-# LINE 2043 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 224, column 9) + _backTree = + {-# LINE 224 "./TypeChecking.ag" #-} + Identifier ann_ i_ + {-# LINE 2048 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 649, column 16) + _lhsOliftedColumnName = + {-# LINE 649 "./TypeChecking.ag" #-} + i_ + {-# LINE 2053 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Identifier ann_ i_ + {-# LINE 2058 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_InPredicate :: Annotation -> + T_Expression -> + Bool -> + T_InList -> + T_Expression +sem_Expression_InPredicate ann_ expr_ i_ list_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + _exprOenv :: Environment + _listOenv :: Environment + _exprIannotatedTree :: Expression + _exprIliftedColumnName :: String + _listIannotatedTree :: InList + _listIlistType :: (Either [TypeError] Type) + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 2082 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 256, column 9) + _tpe = + {-# LINE 256 "./TypeChecking.ag" #-} + do + lt <- _listIlistType + ty <- resolveResultSetType + _lhsIenv + [getTypeAnnotation _exprIannotatedTree, lt] + return typeBool + {-# LINE 2092 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 262, column 9) + _backTree = + {-# LINE 262 "./TypeChecking.ag" #-} + InPredicate ann_ _exprIannotatedTree i_ _listIannotatedTree + {-# LINE 2097 "AstInternal.hs" #-} + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + _exprIliftedColumnName + {-# LINE 2102 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + InPredicate ann_ _exprIannotatedTree i_ _listIannotatedTree + {-# LINE 2107 "AstInternal.hs" #-} + -- copy rule (down) + _exprOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2112 "AstInternal.hs" #-} + -- copy rule (down) + _listOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2117 "AstInternal.hs" #-} + ( _exprIannotatedTree,_exprIliftedColumnName) = + (expr_ _exprOenv ) + ( _listIannotatedTree,_listIlistType) = + (list_ _listOenv ) + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_IntegerLit :: Annotation -> + Integer -> + T_Expression +sem_Expression_IntegerLit ann_ i_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 2137 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 94, column 9) + _backTree = + {-# LINE 94 "./TypeChecking.ag" #-} + IntegerLit ann_ i_ + {-# LINE 2142 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 105, column 19) + _tpe = + {-# LINE 105 "./TypeChecking.ag" #-} + Right typeInt + {-# LINE 2147 "AstInternal.hs" #-} + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + "" + {-# LINE 2152 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + IntegerLit ann_ i_ + {-# LINE 2157 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_NullLit :: Annotation -> + T_Expression +sem_Expression_NullLit ann_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 2172 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 102, column 9) + _backTree = + {-# LINE 102 "./TypeChecking.ag" #-} + NullLit ann_ + {-# LINE 2177 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 110, column 16) + _tpe = + {-# LINE 110 "./TypeChecking.ag" #-} + Right UnknownStringLit + {-# LINE 2182 "AstInternal.hs" #-} + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + "" + {-# LINE 2187 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + NullLit ann_ + {-# LINE 2192 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_PositionalArg :: Annotation -> + Integer -> + T_Expression +sem_Expression_PositionalArg ann_ p_ = + (\ _lhsIenv -> + (let _lhsOliftedColumnName :: String + _lhsOannotatedTree :: Expression + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + "" + {-# LINE 2205 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + PositionalArg ann_ p_ + {-# LINE 2210 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2215 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_ScalarSubQuery :: Annotation -> + T_SelectExpression -> + T_Expression +sem_Expression_ScalarSubQuery ann_ sel_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + _selOenv :: Environment + _selIannotatedTree :: SelectExpression + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 2233 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 240, column 9) + _tpe = + {-# LINE 240 "./TypeChecking.ag" #-} + let selType = getTypeAnnotation _selIannotatedTree + in chainTypeCheckFailed [selType] + $ do + f <- map snd <$> unwrapSetOfComposite selType + case length f of + 0 -> Left [InternalError "no columns in scalar subquery?"] + 1 -> Right $ head f + _ -> Right $ RowCtor f + {-# LINE 2245 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 249, column 9) + _backTree = + {-# LINE 249 "./TypeChecking.ag" #-} + ScalarSubQuery ann_ _selIannotatedTree + {-# LINE 2250 "AstInternal.hs" #-} + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + "" + {-# LINE 2255 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ScalarSubQuery ann_ _selIannotatedTree + {-# LINE 2260 "AstInternal.hs" #-} + -- copy rule (down) + _selOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2265 "AstInternal.hs" #-} + ( _selIannotatedTree) = + (sel_ _selOenv ) + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_StringLit :: Annotation -> + String -> + String -> + T_Expression +sem_Expression_StringLit ann_ quote_ value_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Expression + _lhsOliftedColumnName :: String + -- "./TypeChecking.ag"(line 83, column 9) + _lhsOannotatedTree = + {-# LINE 83 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 2284 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 96, column 9) + _backTree = + {-# LINE 96 "./TypeChecking.ag" #-} + StringLit ann_ quote_ value_ + {-# LINE 2289 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 106, column 18) + _tpe = + {-# LINE 106 "./TypeChecking.ag" #-} + Right UnknownStringLit + {-# LINE 2294 "AstInternal.hs" #-} + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + "" + {-# LINE 2299 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + StringLit ann_ quote_ value_ + {-# LINE 2304 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +sem_Expression_WindowFn :: Annotation -> + T_Expression -> + T_ExpressionList -> + T_ExpressionList -> + T_Direction -> + T_Expression +sem_Expression_WindowFn ann_ fn_ partitionBy_ orderBy_ dir_ = + (\ _lhsIenv -> + (let _lhsOliftedColumnName :: String + _lhsOannotatedTree :: Expression + _fnOenv :: Environment + _partitionByOenv :: Environment + _orderByOenv :: Environment + _dirOenv :: Environment + _fnIannotatedTree :: Expression + _fnIliftedColumnName :: String + _partitionByIannotatedTree :: ExpressionList + _partitionByItypeList :: ([Type]) + _orderByIannotatedTree :: ExpressionList + _orderByItypeList :: ([Type]) + _dirIannotatedTree :: Direction + -- use rule "./TypeChecking.ag"(line 636, column 37) + _lhsOliftedColumnName = + {-# LINE 636 "./TypeChecking.ag" #-} + _fnIliftedColumnName + {-# LINE 2331 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + WindowFn ann_ _fnIannotatedTree _partitionByIannotatedTree _orderByIannotatedTree _dirIannotatedTree + {-# LINE 2336 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2341 "AstInternal.hs" #-} + -- copy rule (down) + _fnOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2346 "AstInternal.hs" #-} + -- copy rule (down) + _partitionByOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2351 "AstInternal.hs" #-} + -- copy rule (down) + _orderByOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2356 "AstInternal.hs" #-} + -- copy rule (down) + _dirOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2361 "AstInternal.hs" #-} + ( _fnIannotatedTree,_fnIliftedColumnName) = + (fn_ _fnOenv ) + ( _partitionByIannotatedTree,_partitionByItypeList) = + (partitionBy_ _partitionByOenv ) + ( _orderByIannotatedTree,_orderByItypeList) = + (orderBy_ _orderByOenv ) + ( _dirIannotatedTree) = + (dir_ _dirOenv ) + in ( _lhsOannotatedTree,_lhsOliftedColumnName))) +-- ExpressionDirectionPair ------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Tuple: + child x1 : Expression + child x2 : Direction + visit 0: + local annotatedTree : _ +-} +type ExpressionDirectionPair = ( (Expression),(Direction)) +-- cata +sem_ExpressionDirectionPair :: ExpressionDirectionPair -> + T_ExpressionDirectionPair +sem_ExpressionDirectionPair ( x1,x2) = + (sem_ExpressionDirectionPair_Tuple (sem_Expression x1 ) (sem_Direction x2 ) ) +-- semantic domain +type T_ExpressionDirectionPair = Environment -> + ( ExpressionDirectionPair) +data Inh_ExpressionDirectionPair = Inh_ExpressionDirectionPair {env_Inh_ExpressionDirectionPair :: Environment} +data Syn_ExpressionDirectionPair = Syn_ExpressionDirectionPair {annotatedTree_Syn_ExpressionDirectionPair :: ExpressionDirectionPair} +wrap_ExpressionDirectionPair :: T_ExpressionDirectionPair -> + Inh_ExpressionDirectionPair -> + Syn_ExpressionDirectionPair +wrap_ExpressionDirectionPair sem (Inh_ExpressionDirectionPair _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_ExpressionDirectionPair _lhsOannotatedTree )) +sem_ExpressionDirectionPair_Tuple :: T_Expression -> + T_Direction -> + T_ExpressionDirectionPair +sem_ExpressionDirectionPair_Tuple x1_ x2_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: ExpressionDirectionPair + _x1Oenv :: Environment + _x2Oenv :: Environment + _x1IannotatedTree :: Expression + _x1IliftedColumnName :: String + _x2IannotatedTree :: Direction + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (_x1IannotatedTree,_x2IannotatedTree) + {-# LINE 2418 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2423 "AstInternal.hs" #-} + -- copy rule (down) + _x1Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2428 "AstInternal.hs" #-} + -- copy rule (down) + _x2Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2433 "AstInternal.hs" #-} + ( _x1IannotatedTree,_x1IliftedColumnName) = + (x1_ _x1Oenv ) + ( _x2IannotatedTree) = + (x2_ _x2Oenv ) + in ( _lhsOannotatedTree))) +-- ExpressionDirectionPairList --------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Cons: + child hd : ExpressionDirectionPair + child tl : ExpressionDirectionPairList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type ExpressionDirectionPairList = [(ExpressionDirectionPair)] +-- cata +sem_ExpressionDirectionPairList :: ExpressionDirectionPairList -> + T_ExpressionDirectionPairList +sem_ExpressionDirectionPairList list = + (Prelude.foldr sem_ExpressionDirectionPairList_Cons sem_ExpressionDirectionPairList_Nil (Prelude.map sem_ExpressionDirectionPair list) ) +-- semantic domain +type T_ExpressionDirectionPairList = Environment -> + ( ExpressionDirectionPairList) +data Inh_ExpressionDirectionPairList = Inh_ExpressionDirectionPairList {env_Inh_ExpressionDirectionPairList :: Environment} +data Syn_ExpressionDirectionPairList = Syn_ExpressionDirectionPairList {annotatedTree_Syn_ExpressionDirectionPairList :: ExpressionDirectionPairList} +wrap_ExpressionDirectionPairList :: T_ExpressionDirectionPairList -> + Inh_ExpressionDirectionPairList -> + Syn_ExpressionDirectionPairList +wrap_ExpressionDirectionPairList sem (Inh_ExpressionDirectionPairList _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_ExpressionDirectionPairList _lhsOannotatedTree )) +sem_ExpressionDirectionPairList_Cons :: T_ExpressionDirectionPair -> + T_ExpressionDirectionPairList -> + T_ExpressionDirectionPairList +sem_ExpressionDirectionPairList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: ExpressionDirectionPairList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: ExpressionDirectionPair + _tlIannotatedTree :: ExpressionDirectionPairList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 2488 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2493 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2498 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2503 "AstInternal.hs" #-} + ( _hdIannotatedTree) = + (hd_ _hdOenv ) + ( _tlIannotatedTree) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree))) +sem_ExpressionDirectionPairList_Nil :: T_ExpressionDirectionPairList +sem_ExpressionDirectionPairList_Nil = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: ExpressionDirectionPairList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 2517 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2522 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- ExpressionList ---------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + typeList : [Type] + alternatives: + alternative Cons: + child hd : Expression + child tl : ExpressionList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type ExpressionList = [(Expression)] +-- cata +sem_ExpressionList :: ExpressionList -> + T_ExpressionList +sem_ExpressionList list = + (Prelude.foldr sem_ExpressionList_Cons sem_ExpressionList_Nil (Prelude.map sem_Expression list) ) +-- semantic domain +type T_ExpressionList = Environment -> + ( ExpressionList,([Type])) +data Inh_ExpressionList = Inh_ExpressionList {env_Inh_ExpressionList :: Environment} +data Syn_ExpressionList = Syn_ExpressionList {annotatedTree_Syn_ExpressionList :: ExpressionList,typeList_Syn_ExpressionList :: [Type]} +wrap_ExpressionList :: T_ExpressionList -> + Inh_ExpressionList -> + Syn_ExpressionList +wrap_ExpressionList sem (Inh_ExpressionList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOtypeList) = + (sem _lhsIenv ) + in (Syn_ExpressionList _lhsOannotatedTree _lhsOtypeList )) +sem_ExpressionList_Cons :: T_Expression -> + T_ExpressionList -> + T_ExpressionList +sem_ExpressionList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOtypeList :: ([Type]) + _lhsOannotatedTree :: ExpressionList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: Expression + _hdIliftedColumnName :: String + _tlIannotatedTree :: ExpressionList + _tlItypeList :: ([Type]) + -- "./TypeChecking.ag"(line 289, column 12) + _lhsOtypeList = + {-# LINE 289 "./TypeChecking.ag" #-} + getTypeAnnotation _hdIannotatedTree : _tlItypeList + {-# LINE 2577 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 2582 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2587 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2592 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2597 "AstInternal.hs" #-} + ( _hdIannotatedTree,_hdIliftedColumnName) = + (hd_ _hdOenv ) + ( _tlIannotatedTree,_tlItypeList) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree,_lhsOtypeList))) +sem_ExpressionList_Nil :: T_ExpressionList +sem_ExpressionList_Nil = + (\ _lhsIenv -> + (let _lhsOtypeList :: ([Type]) + _lhsOannotatedTree :: ExpressionList + -- "./TypeChecking.ag"(line 290, column 11) + _lhsOtypeList = + {-# LINE 290 "./TypeChecking.ag" #-} + [] + {-# LINE 2612 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 2617 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2622 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOtypeList))) +-- ExpressionListList ------------------------------------------ +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + typeListList : [[Type]] + alternatives: + alternative Cons: + child hd : ExpressionList + child tl : ExpressionListList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type ExpressionListList = [(ExpressionList)] +-- cata +sem_ExpressionListList :: ExpressionListList -> + T_ExpressionListList +sem_ExpressionListList list = + (Prelude.foldr sem_ExpressionListList_Cons sem_ExpressionListList_Nil (Prelude.map sem_ExpressionList list) ) +-- semantic domain +type T_ExpressionListList = Environment -> + ( ExpressionListList,([[Type]])) +data Inh_ExpressionListList = Inh_ExpressionListList {env_Inh_ExpressionListList :: Environment} +data Syn_ExpressionListList = Syn_ExpressionListList {annotatedTree_Syn_ExpressionListList :: ExpressionListList,typeListList_Syn_ExpressionListList :: [[Type]]} +wrap_ExpressionListList :: T_ExpressionListList -> + Inh_ExpressionListList -> + Syn_ExpressionListList +wrap_ExpressionListList sem (Inh_ExpressionListList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOtypeListList) = + (sem _lhsIenv ) + in (Syn_ExpressionListList _lhsOannotatedTree _lhsOtypeListList )) +sem_ExpressionListList_Cons :: T_ExpressionList -> + T_ExpressionListList -> + T_ExpressionListList +sem_ExpressionListList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOtypeListList :: ([[Type]]) + _lhsOannotatedTree :: ExpressionListList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: ExpressionList + _hdItypeList :: ([Type]) + _tlIannotatedTree :: ExpressionListList + _tlItypeListList :: ([[Type]]) + -- "./TypeChecking.ag"(line 296, column 12) + _lhsOtypeListList = + {-# LINE 296 "./TypeChecking.ag" #-} + _hdItypeList : _tlItypeListList + {-# LINE 2677 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 2682 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2687 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2692 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2697 "AstInternal.hs" #-} + ( _hdIannotatedTree,_hdItypeList) = + (hd_ _hdOenv ) + ( _tlIannotatedTree,_tlItypeListList) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree,_lhsOtypeListList))) +sem_ExpressionListList_Nil :: T_ExpressionListList +sem_ExpressionListList_Nil = + (\ _lhsIenv -> + (let _lhsOtypeListList :: ([[Type]]) + _lhsOannotatedTree :: ExpressionListList + -- "./TypeChecking.ag"(line 297, column 11) + _lhsOtypeListList = + {-# LINE 297 "./TypeChecking.ag" #-} + [] + {-# LINE 2712 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 2717 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2722 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOtypeListList))) +-- ExpressionListStatementListPair ----------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Tuple: + child x1 : ExpressionList + child x2 : StatementList + visit 0: + local annotatedTree : _ +-} +type ExpressionListStatementListPair = ( (ExpressionList),(StatementList)) +-- cata +sem_ExpressionListStatementListPair :: ExpressionListStatementListPair -> + T_ExpressionListStatementListPair +sem_ExpressionListStatementListPair ( x1,x2) = + (sem_ExpressionListStatementListPair_Tuple (sem_ExpressionList x1 ) (sem_StatementList x2 ) ) +-- semantic domain +type T_ExpressionListStatementListPair = Environment -> + ( ExpressionListStatementListPair) +data Inh_ExpressionListStatementListPair = Inh_ExpressionListStatementListPair {env_Inh_ExpressionListStatementListPair :: Environment} +data Syn_ExpressionListStatementListPair = Syn_ExpressionListStatementListPair {annotatedTree_Syn_ExpressionListStatementListPair :: ExpressionListStatementListPair} +wrap_ExpressionListStatementListPair :: T_ExpressionListStatementListPair -> + Inh_ExpressionListStatementListPair -> + Syn_ExpressionListStatementListPair +wrap_ExpressionListStatementListPair sem (Inh_ExpressionListStatementListPair _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_ExpressionListStatementListPair _lhsOannotatedTree )) +sem_ExpressionListStatementListPair_Tuple :: T_ExpressionList -> + T_StatementList -> + T_ExpressionListStatementListPair +sem_ExpressionListStatementListPair_Tuple x1_ x2_ = + (\ _lhsIenv -> + (let _x2OenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: ExpressionListStatementListPair + _x1Oenv :: Environment + _x2Oenv :: Environment + _x1IannotatedTree :: ExpressionList + _x1ItypeList :: ([Type]) + _x2IannotatedTree :: StatementList + _x2IproducedEnv :: Environment + -- "./TypeChecking.ag"(line 346, column 13) + _x2OenvUpdates = + {-# LINE 346 "./TypeChecking.ag" #-} + [] + {-# LINE 2773 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (_x1IannotatedTree,_x2IannotatedTree) + {-# LINE 2778 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2783 "AstInternal.hs" #-} + -- copy rule (down) + _x1Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2788 "AstInternal.hs" #-} + -- copy rule (down) + _x2Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2793 "AstInternal.hs" #-} + ( _x1IannotatedTree,_x1ItypeList) = + (x1_ _x1Oenv ) + ( _x2IannotatedTree,_x2IproducedEnv) = + (x2_ _x2Oenv _x2OenvUpdates ) + in ( _lhsOannotatedTree))) +-- ExpressionListStatementListPairList ------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Cons: + child hd : ExpressionListStatementListPair + child tl : ExpressionListStatementListPairList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type ExpressionListStatementListPairList = [(ExpressionListStatementListPair)] +-- cata +sem_ExpressionListStatementListPairList :: ExpressionListStatementListPairList -> + T_ExpressionListStatementListPairList +sem_ExpressionListStatementListPairList list = + (Prelude.foldr sem_ExpressionListStatementListPairList_Cons sem_ExpressionListStatementListPairList_Nil (Prelude.map sem_ExpressionListStatementListPair list) ) +-- semantic domain +type T_ExpressionListStatementListPairList = Environment -> + ( ExpressionListStatementListPairList) +data Inh_ExpressionListStatementListPairList = Inh_ExpressionListStatementListPairList {env_Inh_ExpressionListStatementListPairList :: Environment} +data Syn_ExpressionListStatementListPairList = Syn_ExpressionListStatementListPairList {annotatedTree_Syn_ExpressionListStatementListPairList :: ExpressionListStatementListPairList} +wrap_ExpressionListStatementListPairList :: T_ExpressionListStatementListPairList -> + Inh_ExpressionListStatementListPairList -> + Syn_ExpressionListStatementListPairList +wrap_ExpressionListStatementListPairList sem (Inh_ExpressionListStatementListPairList _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_ExpressionListStatementListPairList _lhsOannotatedTree )) +sem_ExpressionListStatementListPairList_Cons :: T_ExpressionListStatementListPair -> + T_ExpressionListStatementListPairList -> + T_ExpressionListStatementListPairList +sem_ExpressionListStatementListPairList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: ExpressionListStatementListPairList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: ExpressionListStatementListPair + _tlIannotatedTree :: ExpressionListStatementListPairList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 2848 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2853 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2858 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2863 "AstInternal.hs" #-} + ( _hdIannotatedTree) = + (hd_ _hdOenv ) + ( _tlIannotatedTree) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree))) +sem_ExpressionListStatementListPairList_Nil :: T_ExpressionListStatementListPairList +sem_ExpressionListStatementListPairList_Nil = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: ExpressionListStatementListPairList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 2877 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2882 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- ExpressionRoot ---------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative ExpressionRoot: + child expr : Expression + visit 0: + local annotatedTree : _ +-} +data ExpressionRoot = ExpressionRoot (Expression) + deriving ( Show) +-- cata +sem_ExpressionRoot :: ExpressionRoot -> + T_ExpressionRoot +sem_ExpressionRoot (ExpressionRoot _expr ) = + (sem_ExpressionRoot_ExpressionRoot (sem_Expression _expr ) ) +-- semantic domain +type T_ExpressionRoot = Environment -> + ( ExpressionRoot) +data Inh_ExpressionRoot = Inh_ExpressionRoot {env_Inh_ExpressionRoot :: Environment} +data Syn_ExpressionRoot = Syn_ExpressionRoot {annotatedTree_Syn_ExpressionRoot :: ExpressionRoot} +wrap_ExpressionRoot :: T_ExpressionRoot -> + Inh_ExpressionRoot -> + Syn_ExpressionRoot +wrap_ExpressionRoot sem (Inh_ExpressionRoot _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_ExpressionRoot _lhsOannotatedTree )) +sem_ExpressionRoot_ExpressionRoot :: T_Expression -> + T_ExpressionRoot +sem_ExpressionRoot_ExpressionRoot expr_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: ExpressionRoot + _exprOenv :: Environment + _exprIannotatedTree :: Expression + _exprIliftedColumnName :: String + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ExpressionRoot _exprIannotatedTree + {-# LINE 2928 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 2933 "AstInternal.hs" #-} + -- copy rule (down) + _exprOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 2938 "AstInternal.hs" #-} + ( _exprIannotatedTree,_exprIliftedColumnName) = + (expr_ _exprOenv ) + in ( _lhsOannotatedTree))) +-- ExpressionStatementListPair --------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Tuple: + child x1 : Expression + child x2 : StatementList + visit 0: + local annotatedTree : _ +-} +type ExpressionStatementListPair = ( (Expression),(StatementList)) +-- cata +sem_ExpressionStatementListPair :: ExpressionStatementListPair -> + T_ExpressionStatementListPair +sem_ExpressionStatementListPair ( x1,x2) = + (sem_ExpressionStatementListPair_Tuple (sem_Expression x1 ) (sem_StatementList x2 ) ) +-- semantic domain +type T_ExpressionStatementListPair = Environment -> + ( ExpressionStatementListPair) +data Inh_ExpressionStatementListPair = Inh_ExpressionStatementListPair {env_Inh_ExpressionStatementListPair :: Environment} +data Syn_ExpressionStatementListPair = Syn_ExpressionStatementListPair {annotatedTree_Syn_ExpressionStatementListPair :: ExpressionStatementListPair} +wrap_ExpressionStatementListPair :: T_ExpressionStatementListPair -> + Inh_ExpressionStatementListPair -> + Syn_ExpressionStatementListPair +wrap_ExpressionStatementListPair sem (Inh_ExpressionStatementListPair _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_ExpressionStatementListPair _lhsOannotatedTree )) +sem_ExpressionStatementListPair_Tuple :: T_Expression -> + T_StatementList -> + T_ExpressionStatementListPair +sem_ExpressionStatementListPair_Tuple x1_ x2_ = + (\ _lhsIenv -> + (let _x2OenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: ExpressionStatementListPair + _x1Oenv :: Environment + _x2Oenv :: Environment + _x1IannotatedTree :: Expression + _x1IliftedColumnName :: String + _x2IannotatedTree :: StatementList + _x2IproducedEnv :: Environment + -- "./TypeChecking.ag"(line 348, column 13) + _x2OenvUpdates = + {-# LINE 348 "./TypeChecking.ag" #-} + [] + {-# LINE 2991 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (_x1IannotatedTree,_x2IannotatedTree) + {-# LINE 2996 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3001 "AstInternal.hs" #-} + -- copy rule (down) + _x1Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3006 "AstInternal.hs" #-} + -- copy rule (down) + _x2Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3011 "AstInternal.hs" #-} + ( _x1IannotatedTree,_x1IliftedColumnName) = + (x1_ _x1Oenv ) + ( _x2IannotatedTree,_x2IproducedEnv) = + (x2_ _x2Oenv _x2OenvUpdates ) + in ( _lhsOannotatedTree))) +-- ExpressionStatementListPairList ----------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Cons: + child hd : ExpressionStatementListPair + child tl : ExpressionStatementListPairList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type ExpressionStatementListPairList = [(ExpressionStatementListPair)] +-- cata +sem_ExpressionStatementListPairList :: ExpressionStatementListPairList -> + T_ExpressionStatementListPairList +sem_ExpressionStatementListPairList list = + (Prelude.foldr sem_ExpressionStatementListPairList_Cons sem_ExpressionStatementListPairList_Nil (Prelude.map sem_ExpressionStatementListPair list) ) +-- semantic domain +type T_ExpressionStatementListPairList = Environment -> + ( ExpressionStatementListPairList) +data Inh_ExpressionStatementListPairList = Inh_ExpressionStatementListPairList {env_Inh_ExpressionStatementListPairList :: Environment} +data Syn_ExpressionStatementListPairList = Syn_ExpressionStatementListPairList {annotatedTree_Syn_ExpressionStatementListPairList :: ExpressionStatementListPairList} +wrap_ExpressionStatementListPairList :: T_ExpressionStatementListPairList -> + Inh_ExpressionStatementListPairList -> + Syn_ExpressionStatementListPairList +wrap_ExpressionStatementListPairList sem (Inh_ExpressionStatementListPairList _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_ExpressionStatementListPairList _lhsOannotatedTree )) +sem_ExpressionStatementListPairList_Cons :: T_ExpressionStatementListPair -> + T_ExpressionStatementListPairList -> + T_ExpressionStatementListPairList +sem_ExpressionStatementListPairList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: ExpressionStatementListPairList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: ExpressionStatementListPair + _tlIannotatedTree :: ExpressionStatementListPairList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 3066 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3071 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3076 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3081 "AstInternal.hs" #-} + ( _hdIannotatedTree) = + (hd_ _hdOenv ) + ( _tlIannotatedTree) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree))) +sem_ExpressionStatementListPairList_Nil :: T_ExpressionStatementListPairList +sem_ExpressionStatementListPairList_Nil = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: ExpressionStatementListPairList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 3095 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3100 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- FnBody ------------------------------------------------------ +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative PlpgsqlFnBody: + child ann : {Annotation} + child vars : VarDefList + child sts : StatementList + visit 0: + local annotatedTree : _ + alternative SqlFnBody: + child ann : {Annotation} + child sts : StatementList + visit 0: + local annotatedTree : _ +-} +data FnBody = PlpgsqlFnBody (Annotation) (VarDefList) (StatementList) + | SqlFnBody (Annotation) (StatementList) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_FnBody :: FnBody -> + T_FnBody +sem_FnBody (PlpgsqlFnBody _ann _vars _sts ) = + (sem_FnBody_PlpgsqlFnBody _ann (sem_VarDefList _vars ) (sem_StatementList _sts ) ) +sem_FnBody (SqlFnBody _ann _sts ) = + (sem_FnBody_SqlFnBody _ann (sem_StatementList _sts ) ) +-- semantic domain +type T_FnBody = Environment -> + ( FnBody) +data Inh_FnBody = Inh_FnBody {env_Inh_FnBody :: Environment} +data Syn_FnBody = Syn_FnBody {annotatedTree_Syn_FnBody :: FnBody} +wrap_FnBody :: T_FnBody -> + Inh_FnBody -> + Syn_FnBody +wrap_FnBody sem (Inh_FnBody _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_FnBody _lhsOannotatedTree )) +sem_FnBody_PlpgsqlFnBody :: Annotation -> + T_VarDefList -> + T_StatementList -> + T_FnBody +sem_FnBody_PlpgsqlFnBody ann_ vars_ sts_ = + (\ _lhsIenv -> + (let _stsOenvUpdates :: ([EnvironmentUpdate]) + _stsOenv :: Environment + _lhsOannotatedTree :: FnBody + _varsOenv :: Environment + _varsIannotatedTree :: VarDefList + _varsIdefs :: ([(String,Type)]) + _stsIannotatedTree :: StatementList + _stsIproducedEnv :: Environment + -- "./TypeChecking.ag"(line 350, column 31) + _stsOenvUpdates = + {-# LINE 350 "./TypeChecking.ag" #-} + [] + {-# LINE 3162 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 943, column 9) + _stsOenv = + {-# LINE 943 "./TypeChecking.ag" #-} + fromRight _lhsIenv $ updateEnvironment _lhsIenv [EnvStackIDs [("", _varsIdefs)]] + {-# LINE 3167 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + PlpgsqlFnBody ann_ _varsIannotatedTree _stsIannotatedTree + {-# LINE 3172 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3177 "AstInternal.hs" #-} + -- copy rule (down) + _varsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3182 "AstInternal.hs" #-} + ( _varsIannotatedTree,_varsIdefs) = + (vars_ _varsOenv ) + ( _stsIannotatedTree,_stsIproducedEnv) = + (sts_ _stsOenv _stsOenvUpdates ) + in ( _lhsOannotatedTree))) +sem_FnBody_SqlFnBody :: Annotation -> + T_StatementList -> + T_FnBody +sem_FnBody_SqlFnBody ann_ sts_ = + (\ _lhsIenv -> + (let _stsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: FnBody + _stsOenv :: Environment + _stsIannotatedTree :: StatementList + _stsIproducedEnv :: Environment + -- "./TypeChecking.ag"(line 350, column 31) + _stsOenvUpdates = + {-# LINE 350 "./TypeChecking.ag" #-} + [] + {-# LINE 3202 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + SqlFnBody ann_ _stsIannotatedTree + {-# LINE 3207 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3212 "AstInternal.hs" #-} + -- copy rule (down) + _stsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3217 "AstInternal.hs" #-} + ( _stsIannotatedTree,_stsIproducedEnv) = + (sts_ _stsOenv _stsOenvUpdates ) + in ( _lhsOannotatedTree))) +-- IfExists ---------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative IfExists: + visit 0: + local annotatedTree : _ + alternative Require: + visit 0: + local annotatedTree : _ +-} +data IfExists = IfExists + | Require + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_IfExists :: IfExists -> + T_IfExists +sem_IfExists (IfExists ) = + (sem_IfExists_IfExists ) +sem_IfExists (Require ) = + (sem_IfExists_Require ) +-- semantic domain +type T_IfExists = Environment -> + ( IfExists) +data Inh_IfExists = Inh_IfExists {env_Inh_IfExists :: Environment} +data Syn_IfExists = Syn_IfExists {annotatedTree_Syn_IfExists :: IfExists} +wrap_IfExists :: T_IfExists -> + Inh_IfExists -> + Syn_IfExists +wrap_IfExists sem (Inh_IfExists _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_IfExists _lhsOannotatedTree )) +sem_IfExists_IfExists :: T_IfExists +sem_IfExists_IfExists = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: IfExists + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + IfExists + {-# LINE 3266 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3271 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_IfExists_Require :: T_IfExists +sem_IfExists_Require = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: IfExists + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Require + {-# LINE 3281 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3286 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- InList ------------------------------------------------------ +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + listType : Either [TypeError] Type + alternatives: + alternative InList: + child ann : {Annotation} + child exprs : ExpressionList + visit 0: + local annotatedTree : _ + alternative InSelect: + child ann : {Annotation} + child sel : SelectExpression + visit 0: + local annotatedTree : _ +-} +data InList = InList (Annotation) (ExpressionList) + | InSelect (Annotation) (SelectExpression) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_InList :: InList -> + T_InList +sem_InList (InList _ann _exprs ) = + (sem_InList_InList _ann (sem_ExpressionList _exprs ) ) +sem_InList (InSelect _ann _sel ) = + (sem_InList_InSelect _ann (sem_SelectExpression _sel ) ) +-- semantic domain +type T_InList = Environment -> + ( InList,(Either [TypeError] Type)) +data Inh_InList = Inh_InList {env_Inh_InList :: Environment} +data Syn_InList = Syn_InList {annotatedTree_Syn_InList :: InList,listType_Syn_InList :: Either [TypeError] Type} +wrap_InList :: T_InList -> + Inh_InList -> + Syn_InList +wrap_InList sem (Inh_InList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOlistType) = + (sem _lhsIenv ) + in (Syn_InList _lhsOannotatedTree _lhsOlistType )) +sem_InList_InList :: Annotation -> + T_ExpressionList -> + T_InList +sem_InList_InList ann_ exprs_ = + (\ _lhsIenv -> + (let _lhsOlistType :: (Either [TypeError] Type) + _lhsOannotatedTree :: InList + _exprsOenv :: Environment + _exprsIannotatedTree :: ExpressionList + _exprsItypeList :: ([Type]) + -- "./TypeChecking.ag"(line 269, column 9) + _lhsOlistType = + {-# LINE 269 "./TypeChecking.ag" #-} + resolveResultSetType + _lhsIenv + _exprsItypeList + {-# LINE 3346 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + InList ann_ _exprsIannotatedTree + {-# LINE 3351 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3356 "AstInternal.hs" #-} + -- copy rule (down) + _exprsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3361 "AstInternal.hs" #-} + ( _exprsIannotatedTree,_exprsItypeList) = + (exprs_ _exprsOenv ) + in ( _lhsOannotatedTree,_lhsOlistType))) +sem_InList_InSelect :: Annotation -> + T_SelectExpression -> + T_InList +sem_InList_InSelect ann_ sel_ = + (\ _lhsIenv -> + (let _lhsOlistType :: (Either [TypeError] Type) + _lhsOannotatedTree :: InList + _selOenv :: Environment + _selIannotatedTree :: SelectExpression + -- "./TypeChecking.ag"(line 273, column 9) + _lhsOlistType = + {-# LINE 273 "./TypeChecking.ag" #-} + do + attrs <- map snd <$> (unwrapSetOfComposite $ + let a = getTypeAnnotation _selIannotatedTree + in a) + typ <- case length attrs of + 0 -> Left [InternalError "got subquery with no columns? in inselect"] + 1 -> Right $ head attrs + _ -> Right $ RowCtor attrs + chainTypeCheckFailed attrs $ Right typ + {-# LINE 3386 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + InSelect ann_ _selIannotatedTree + {-# LINE 3391 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3396 "AstInternal.hs" #-} + -- copy rule (down) + _selOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3401 "AstInternal.hs" #-} + ( _selIannotatedTree) = + (sel_ _selOenv ) + in ( _lhsOannotatedTree,_lhsOlistType))) +-- JoinExpression ---------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative JoinOn: + child ann : {Annotation} + child expression : Expression + visit 0: + local annotatedTree : _ + alternative JoinUsing: + child ann : {Annotation} + child stringList : StringList + visit 0: + local annotatedTree : _ +-} +data JoinExpression = JoinOn (Annotation) (Expression) + | JoinUsing (Annotation) (StringList) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_JoinExpression :: JoinExpression -> + T_JoinExpression +sem_JoinExpression (JoinOn _ann _expression ) = + (sem_JoinExpression_JoinOn _ann (sem_Expression _expression ) ) +sem_JoinExpression (JoinUsing _ann _stringList ) = + (sem_JoinExpression_JoinUsing _ann (sem_StringList _stringList ) ) +-- semantic domain +type T_JoinExpression = Environment -> + ( JoinExpression) +data Inh_JoinExpression = Inh_JoinExpression {env_Inh_JoinExpression :: Environment} +data Syn_JoinExpression = Syn_JoinExpression {annotatedTree_Syn_JoinExpression :: JoinExpression} +wrap_JoinExpression :: T_JoinExpression -> + Inh_JoinExpression -> + Syn_JoinExpression +wrap_JoinExpression sem (Inh_JoinExpression _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_JoinExpression _lhsOannotatedTree )) +sem_JoinExpression_JoinOn :: Annotation -> + T_Expression -> + T_JoinExpression +sem_JoinExpression_JoinOn ann_ expression_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: JoinExpression + _expressionOenv :: Environment + _expressionIannotatedTree :: Expression + _expressionIliftedColumnName :: String + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + JoinOn ann_ _expressionIannotatedTree + {-# LINE 3459 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3464 "AstInternal.hs" #-} + -- copy rule (down) + _expressionOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3469 "AstInternal.hs" #-} + ( _expressionIannotatedTree,_expressionIliftedColumnName) = + (expression_ _expressionOenv ) + in ( _lhsOannotatedTree))) +sem_JoinExpression_JoinUsing :: Annotation -> + T_StringList -> + T_JoinExpression +sem_JoinExpression_JoinUsing ann_ stringList_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: JoinExpression + _stringListOenv :: Environment + _stringListIannotatedTree :: StringList + _stringListIstrings :: ([String]) + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + JoinUsing ann_ _stringListIannotatedTree + {-# LINE 3486 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3491 "AstInternal.hs" #-} + -- copy rule (down) + _stringListOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3496 "AstInternal.hs" #-} + ( _stringListIannotatedTree,_stringListIstrings) = + (stringList_ _stringListOenv ) + in ( _lhsOannotatedTree))) +-- JoinType ---------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Cross: + visit 0: + local annotatedTree : _ + alternative FullOuter: + visit 0: + local annotatedTree : _ + alternative Inner: + visit 0: + local annotatedTree : _ + alternative LeftOuter: + visit 0: + local annotatedTree : _ + alternative RightOuter: + visit 0: + local annotatedTree : _ +-} +data JoinType = Cross + | FullOuter + | Inner + | LeftOuter + | RightOuter + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_JoinType :: JoinType -> + T_JoinType +sem_JoinType (Cross ) = + (sem_JoinType_Cross ) +sem_JoinType (FullOuter ) = + (sem_JoinType_FullOuter ) +sem_JoinType (Inner ) = + (sem_JoinType_Inner ) +sem_JoinType (LeftOuter ) = + (sem_JoinType_LeftOuter ) +sem_JoinType (RightOuter ) = + (sem_JoinType_RightOuter ) +-- semantic domain +type T_JoinType = Environment -> + ( JoinType) +data Inh_JoinType = Inh_JoinType {env_Inh_JoinType :: Environment} +data Syn_JoinType = Syn_JoinType {annotatedTree_Syn_JoinType :: JoinType} +wrap_JoinType :: T_JoinType -> + Inh_JoinType -> + Syn_JoinType +wrap_JoinType sem (Inh_JoinType _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_JoinType _lhsOannotatedTree )) +sem_JoinType_Cross :: T_JoinType +sem_JoinType_Cross = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: JoinType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Cross + {-# LINE 3563 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3568 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_JoinType_FullOuter :: T_JoinType +sem_JoinType_FullOuter = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: JoinType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + FullOuter + {-# LINE 3578 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3583 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_JoinType_Inner :: T_JoinType +sem_JoinType_Inner = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: JoinType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Inner + {-# LINE 3593 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3598 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_JoinType_LeftOuter :: T_JoinType +sem_JoinType_LeftOuter = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: JoinType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + LeftOuter + {-# LINE 3608 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3613 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_JoinType_RightOuter :: T_JoinType +sem_JoinType_RightOuter = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: JoinType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + RightOuter + {-# LINE 3623 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3628 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- Language ---------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Plpgsql: + visit 0: + local annotatedTree : _ + alternative Sql: + visit 0: + local annotatedTree : _ +-} +data Language = Plpgsql + | Sql + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_Language :: Language -> + T_Language +sem_Language (Plpgsql ) = + (sem_Language_Plpgsql ) +sem_Language (Sql ) = + (sem_Language_Sql ) +-- semantic domain +type T_Language = Environment -> + ( Language) +data Inh_Language = Inh_Language {env_Inh_Language :: Environment} +data Syn_Language = Syn_Language {annotatedTree_Syn_Language :: Language} +wrap_Language :: T_Language -> + Inh_Language -> + Syn_Language +wrap_Language sem (Inh_Language _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_Language _lhsOannotatedTree )) +sem_Language_Plpgsql :: T_Language +sem_Language_Plpgsql = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Language + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Plpgsql + {-# LINE 3675 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3680 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_Language_Sql :: T_Language +sem_Language_Sql = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Language + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Sql + {-# LINE 3690 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3695 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- MaybeBoolExpression ----------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Just: + child just : Expression + visit 0: + local annotatedTree : _ + alternative Nothing: + visit 0: + local annotatedTree : _ +-} +type MaybeBoolExpression = (Maybe (Expression)) +-- cata +sem_MaybeBoolExpression :: MaybeBoolExpression -> + T_MaybeBoolExpression +sem_MaybeBoolExpression (Prelude.Just x ) = + (sem_MaybeBoolExpression_Just (sem_Expression x ) ) +sem_MaybeBoolExpression Prelude.Nothing = + sem_MaybeBoolExpression_Nothing +-- semantic domain +type T_MaybeBoolExpression = Environment -> + ( MaybeBoolExpression) +data Inh_MaybeBoolExpression = Inh_MaybeBoolExpression {env_Inh_MaybeBoolExpression :: Environment} +data Syn_MaybeBoolExpression = Syn_MaybeBoolExpression {annotatedTree_Syn_MaybeBoolExpression :: MaybeBoolExpression} +wrap_MaybeBoolExpression :: T_MaybeBoolExpression -> + Inh_MaybeBoolExpression -> + Syn_MaybeBoolExpression +wrap_MaybeBoolExpression sem (Inh_MaybeBoolExpression _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_MaybeBoolExpression _lhsOannotatedTree )) +sem_MaybeBoolExpression_Just :: T_Expression -> + T_MaybeBoolExpression +sem_MaybeBoolExpression_Just just_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: MaybeBoolExpression + _justOenv :: Environment + _justIannotatedTree :: Expression + _justIliftedColumnName :: String + -- "./TypeChecking.ag"(line 965, column 9) + _lhsOannotatedTree = + {-# LINE 965 "./TypeChecking.ag" #-} + if getTypeAnnotation _justIannotatedTree `notElem` [typeBool, TypeCheckFailed] + then Just $ updateAnnotation ((TypeErrorA ExpressionMustBeBool) :) + _justIannotatedTree + else Just $ _justIannotatedTree + {-# LINE 3748 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Just _justIannotatedTree + {-# LINE 3753 "AstInternal.hs" #-} + -- copy rule (down) + _justOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3758 "AstInternal.hs" #-} + ( _justIannotatedTree,_justIliftedColumnName) = + (just_ _justOenv ) + in ( _lhsOannotatedTree))) +sem_MaybeBoolExpression_Nothing :: T_MaybeBoolExpression +sem_MaybeBoolExpression_Nothing = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: MaybeBoolExpression + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Nothing + {-# LINE 3770 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3775 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- MaybeExpression --------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + exprType : Maybe Type + alternatives: + alternative Just: + child just : Expression + visit 0: + local annotatedTree : _ + alternative Nothing: + visit 0: + local annotatedTree : _ +-} +type MaybeExpression = (Maybe (Expression)) +-- cata +sem_MaybeExpression :: MaybeExpression -> + T_MaybeExpression +sem_MaybeExpression (Prelude.Just x ) = + (sem_MaybeExpression_Just (sem_Expression x ) ) +sem_MaybeExpression Prelude.Nothing = + sem_MaybeExpression_Nothing +-- semantic domain +type T_MaybeExpression = Environment -> + ( MaybeExpression,(Maybe Type)) +data Inh_MaybeExpression = Inh_MaybeExpression {env_Inh_MaybeExpression :: Environment} +data Syn_MaybeExpression = Syn_MaybeExpression {annotatedTree_Syn_MaybeExpression :: MaybeExpression,exprType_Syn_MaybeExpression :: Maybe Type} +wrap_MaybeExpression :: T_MaybeExpression -> + Inh_MaybeExpression -> + Syn_MaybeExpression +wrap_MaybeExpression sem (Inh_MaybeExpression _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOexprType) = + (sem _lhsIenv ) + in (Syn_MaybeExpression _lhsOannotatedTree _lhsOexprType )) +sem_MaybeExpression_Just :: T_Expression -> + T_MaybeExpression +sem_MaybeExpression_Just just_ = + (\ _lhsIenv -> + (let _lhsOexprType :: (Maybe Type) + _lhsOannotatedTree :: MaybeExpression + _justOenv :: Environment + _justIannotatedTree :: Expression + _justIliftedColumnName :: String + -- "./TypeChecking.ag"(line 974, column 12) + _lhsOexprType = + {-# LINE 974 "./TypeChecking.ag" #-} + Just $ getTypeAnnotation _justIannotatedTree + {-# LINE 3827 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Just _justIannotatedTree + {-# LINE 3832 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3837 "AstInternal.hs" #-} + -- copy rule (down) + _justOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3842 "AstInternal.hs" #-} + ( _justIannotatedTree,_justIliftedColumnName) = + (just_ _justOenv ) + in ( _lhsOannotatedTree,_lhsOexprType))) +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = + (\ _lhsIenv -> + (let _lhsOexprType :: (Maybe Type) + _lhsOannotatedTree :: MaybeExpression + -- "./TypeChecking.ag"(line 975, column 15) + _lhsOexprType = + {-# LINE 975 "./TypeChecking.ag" #-} + Nothing + {-# LINE 3855 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Nothing + {-# LINE 3860 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3865 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOexprType))) +-- Natural ----------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Natural: + visit 0: + local annotatedTree : _ + alternative Unnatural: + visit 0: + local annotatedTree : _ +-} +data Natural = Natural + | Unnatural + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_Natural :: Natural -> + T_Natural +sem_Natural (Natural ) = + (sem_Natural_Natural ) +sem_Natural (Unnatural ) = + (sem_Natural_Unnatural ) +-- semantic domain +type T_Natural = Environment -> + ( Natural) +data Inh_Natural = Inh_Natural {env_Inh_Natural :: Environment} +data Syn_Natural = Syn_Natural {annotatedTree_Syn_Natural :: Natural} +wrap_Natural :: T_Natural -> + Inh_Natural -> + Syn_Natural +wrap_Natural sem (Inh_Natural _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_Natural _lhsOannotatedTree )) +sem_Natural_Natural :: T_Natural +sem_Natural_Natural = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Natural + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Natural + {-# LINE 3912 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3917 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_Natural_Unnatural :: T_Natural +sem_Natural_Unnatural = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Natural + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Unnatural + {-# LINE 3927 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3932 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- OnExpr ------------------------------------------------------ +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Just: + child just : JoinExpression + visit 0: + local annotatedTree : _ + alternative Nothing: + visit 0: + local annotatedTree : _ +-} +type OnExpr = (Maybe (JoinExpression)) +-- cata +sem_OnExpr :: OnExpr -> + T_OnExpr +sem_OnExpr (Prelude.Just x ) = + (sem_OnExpr_Just (sem_JoinExpression x ) ) +sem_OnExpr Prelude.Nothing = + sem_OnExpr_Nothing +-- semantic domain +type T_OnExpr = Environment -> + ( OnExpr) +data Inh_OnExpr = Inh_OnExpr {env_Inh_OnExpr :: Environment} +data Syn_OnExpr = Syn_OnExpr {annotatedTree_Syn_OnExpr :: OnExpr} +wrap_OnExpr :: T_OnExpr -> + Inh_OnExpr -> + Syn_OnExpr +wrap_OnExpr sem (Inh_OnExpr _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_OnExpr _lhsOannotatedTree )) +sem_OnExpr_Just :: T_JoinExpression -> + T_OnExpr +sem_OnExpr_Just just_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: OnExpr + _justOenv :: Environment + _justIannotatedTree :: JoinExpression + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Just _justIannotatedTree + {-# LINE 3981 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 3986 "AstInternal.hs" #-} + -- copy rule (down) + _justOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 3991 "AstInternal.hs" #-} + ( _justIannotatedTree) = + (just_ _justOenv ) + in ( _lhsOannotatedTree))) +sem_OnExpr_Nothing :: T_OnExpr +sem_OnExpr_Nothing = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: OnExpr + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Nothing + {-# LINE 4003 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4008 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- ParamDef ---------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + namedType : Type + paramName : String + alternatives: + alternative ParamDef: + child ann : {Annotation} + child name : {String} + child typ : TypeName + visit 0: + local annotatedTree : _ + alternative ParamDefTp: + child ann : {Annotation} + child typ : TypeName + visit 0: + local annotatedTree : _ +-} +data ParamDef = ParamDef (Annotation) (String) (TypeName) + | ParamDefTp (Annotation) (TypeName) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_ParamDef :: ParamDef -> + T_ParamDef +sem_ParamDef (ParamDef _ann _name _typ ) = + (sem_ParamDef_ParamDef _ann _name (sem_TypeName _typ ) ) +sem_ParamDef (ParamDefTp _ann _typ ) = + (sem_ParamDef_ParamDefTp _ann (sem_TypeName _typ ) ) +-- semantic domain +type T_ParamDef = Environment -> + ( ParamDef,Type,String) +data Inh_ParamDef = Inh_ParamDef {env_Inh_ParamDef :: Environment} +data Syn_ParamDef = Syn_ParamDef {annotatedTree_Syn_ParamDef :: ParamDef,namedType_Syn_ParamDef :: Type,paramName_Syn_ParamDef :: String} +wrap_ParamDef :: T_ParamDef -> + Inh_ParamDef -> + Syn_ParamDef +wrap_ParamDef sem (Inh_ParamDef _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOnamedType,_lhsOparamName) = + (sem _lhsIenv ) + in (Syn_ParamDef _lhsOannotatedTree _lhsOnamedType _lhsOparamName )) +sem_ParamDef_ParamDef :: Annotation -> + String -> + T_TypeName -> + T_ParamDef +sem_ParamDef_ParamDef ann_ name_ typ_ = + (\ _lhsIenv -> + (let _lhsOnamedType :: Type + _lhsOparamName :: String + _lhsOannotatedTree :: ParamDef + _typOenv :: Environment + _typIannotatedTree :: TypeName + _typInamedType :: Type + -- "./TypeChecking.ag"(line 913, column 9) + _lhsOnamedType = + {-# LINE 913 "./TypeChecking.ag" #-} + _typInamedType + {-# LINE 4070 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 915, column 9) + _lhsOparamName = + {-# LINE 915 "./TypeChecking.ag" #-} + name_ + {-# LINE 4075 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ParamDef ann_ name_ _typIannotatedTree + {-# LINE 4080 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4085 "AstInternal.hs" #-} + -- copy rule (down) + _typOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4090 "AstInternal.hs" #-} + ( _typIannotatedTree,_typInamedType) = + (typ_ _typOenv ) + in ( _lhsOannotatedTree,_lhsOnamedType,_lhsOparamName))) +sem_ParamDef_ParamDefTp :: Annotation -> + T_TypeName -> + T_ParamDef +sem_ParamDef_ParamDefTp ann_ typ_ = + (\ _lhsIenv -> + (let _lhsOnamedType :: Type + _lhsOparamName :: String + _lhsOannotatedTree :: ParamDef + _typOenv :: Environment + _typIannotatedTree :: TypeName + _typInamedType :: Type + -- "./TypeChecking.ag"(line 913, column 9) + _lhsOnamedType = + {-# LINE 913 "./TypeChecking.ag" #-} + _typInamedType + {-# LINE 4109 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 917, column 9) + _lhsOparamName = + {-# LINE 917 "./TypeChecking.ag" #-} + "" + {-# LINE 4114 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ParamDefTp ann_ _typIannotatedTree + {-# LINE 4119 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4124 "AstInternal.hs" #-} + -- copy rule (down) + _typOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4129 "AstInternal.hs" #-} + ( _typIannotatedTree,_typInamedType) = + (typ_ _typOenv ) + in ( _lhsOannotatedTree,_lhsOnamedType,_lhsOparamName))) +-- ParamDefList ------------------------------------------------ +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + params : [(String, Type)] + alternatives: + alternative Cons: + child hd : ParamDef + child tl : ParamDefList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type ParamDefList = [(ParamDef)] +-- cata +sem_ParamDefList :: ParamDefList -> + T_ParamDefList +sem_ParamDefList list = + (Prelude.foldr sem_ParamDefList_Cons sem_ParamDefList_Nil (Prelude.map sem_ParamDef list) ) +-- semantic domain +type T_ParamDefList = Environment -> + ( ParamDefList,([(String, Type)])) +data Inh_ParamDefList = Inh_ParamDefList {env_Inh_ParamDefList :: Environment} +data Syn_ParamDefList = Syn_ParamDefList {annotatedTree_Syn_ParamDefList :: ParamDefList,params_Syn_ParamDefList :: [(String, Type)]} +wrap_ParamDefList :: T_ParamDefList -> + Inh_ParamDefList -> + Syn_ParamDefList +wrap_ParamDefList sem (Inh_ParamDefList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOparams) = + (sem _lhsIenv ) + in (Syn_ParamDefList _lhsOannotatedTree _lhsOparams )) +sem_ParamDefList_Cons :: T_ParamDef -> + T_ParamDefList -> + T_ParamDefList +sem_ParamDefList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOparams :: ([(String, Type)]) + _lhsOannotatedTree :: ParamDefList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: ParamDef + _hdInamedType :: Type + _hdIparamName :: String + _tlIannotatedTree :: ParamDefList + _tlIparams :: ([(String, Type)]) + -- "./TypeChecking.ag"(line 921, column 13) + _lhsOparams = + {-# LINE 921 "./TypeChecking.ag" #-} + ((_hdIparamName, _hdInamedType) : _tlIparams) + {-# LINE 4187 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 4192 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4197 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4202 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4207 "AstInternal.hs" #-} + ( _hdIannotatedTree,_hdInamedType,_hdIparamName) = + (hd_ _hdOenv ) + ( _tlIannotatedTree,_tlIparams) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree,_lhsOparams))) +sem_ParamDefList_Nil :: T_ParamDefList +sem_ParamDefList_Nil = + (\ _lhsIenv -> + (let _lhsOparams :: ([(String, Type)]) + _lhsOannotatedTree :: ParamDefList + -- "./TypeChecking.ag"(line 920, column 12) + _lhsOparams = + {-# LINE 920 "./TypeChecking.ag" #-} + [] + {-# LINE 4222 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 4227 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4232 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOparams))) +-- RaiseType --------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative RError: + visit 0: + local annotatedTree : _ + alternative RException: + visit 0: + local annotatedTree : _ + alternative RNotice: + visit 0: + local annotatedTree : _ +-} +data RaiseType = RError + | RException + | RNotice + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_RaiseType :: RaiseType -> + T_RaiseType +sem_RaiseType (RError ) = + (sem_RaiseType_RError ) +sem_RaiseType (RException ) = + (sem_RaiseType_RException ) +sem_RaiseType (RNotice ) = + (sem_RaiseType_RNotice ) +-- semantic domain +type T_RaiseType = Environment -> + ( RaiseType) +data Inh_RaiseType = Inh_RaiseType {env_Inh_RaiseType :: Environment} +data Syn_RaiseType = Syn_RaiseType {annotatedTree_Syn_RaiseType :: RaiseType} +wrap_RaiseType :: T_RaiseType -> + Inh_RaiseType -> + Syn_RaiseType +wrap_RaiseType sem (Inh_RaiseType _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_RaiseType _lhsOannotatedTree )) +sem_RaiseType_RError :: T_RaiseType +sem_RaiseType_RError = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RaiseType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + RError + {-# LINE 4285 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4290 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_RaiseType_RException :: T_RaiseType +sem_RaiseType_RException = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RaiseType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + RException + {-# LINE 4300 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4305 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_RaiseType_RNotice :: T_RaiseType +sem_RaiseType_RNotice = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RaiseType + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + RNotice + {-# LINE 4315 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4320 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- RestartIdentity --------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative ContinueIdentity: + visit 0: + local annotatedTree : _ + alternative RestartIdentity: + visit 0: + local annotatedTree : _ +-} +data RestartIdentity = ContinueIdentity + | RestartIdentity + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_RestartIdentity :: RestartIdentity -> + T_RestartIdentity +sem_RestartIdentity (ContinueIdentity ) = + (sem_RestartIdentity_ContinueIdentity ) +sem_RestartIdentity (RestartIdentity ) = + (sem_RestartIdentity_RestartIdentity ) +-- semantic domain +type T_RestartIdentity = Environment -> + ( RestartIdentity) +data Inh_RestartIdentity = Inh_RestartIdentity {env_Inh_RestartIdentity :: Environment} +data Syn_RestartIdentity = Syn_RestartIdentity {annotatedTree_Syn_RestartIdentity :: RestartIdentity} +wrap_RestartIdentity :: T_RestartIdentity -> + Inh_RestartIdentity -> + Syn_RestartIdentity +wrap_RestartIdentity sem (Inh_RestartIdentity _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_RestartIdentity _lhsOannotatedTree )) +sem_RestartIdentity_ContinueIdentity :: T_RestartIdentity +sem_RestartIdentity_ContinueIdentity = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RestartIdentity + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ContinueIdentity + {-# LINE 4367 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4372 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_RestartIdentity_RestartIdentity :: T_RestartIdentity +sem_RestartIdentity_RestartIdentity = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RestartIdentity + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + RestartIdentity + {-# LINE 4382 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4387 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- Root -------------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + producedEnv : Environment + alternatives: + alternative Root: + child statements : StatementList + visit 0: + local annotatedTree : _ +-} +data Root = Root (StatementList) + deriving ( Show) +-- cata +sem_Root :: Root -> + T_Root +sem_Root (Root _statements ) = + (sem_Root_Root (sem_StatementList _statements ) ) +-- semantic domain +type T_Root = Environment -> + ( Root,Environment) +data Inh_Root = Inh_Root {env_Inh_Root :: Environment} +data Syn_Root = Syn_Root {annotatedTree_Syn_Root :: Root,producedEnv_Syn_Root :: Environment} +wrap_Root :: T_Root -> + Inh_Root -> + Syn_Root +wrap_Root sem (Inh_Root _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOproducedEnv) = + (sem _lhsIenv ) + in (Syn_Root _lhsOannotatedTree _lhsOproducedEnv )) +sem_Root_Root :: T_StatementList -> + T_Root +sem_Root_Root statements_ = + (\ _lhsIenv -> + (let _statementsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Root + _lhsOproducedEnv :: Environment + _statementsOenv :: Environment + _statementsIannotatedTree :: StatementList + _statementsIproducedEnv :: Environment + -- "./TypeChecking.ag"(line 330, column 12) + _statementsOenvUpdates = + {-# LINE 330 "./TypeChecking.ag" #-} + [] + {-# LINE 4436 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Root _statementsIannotatedTree + {-# LINE 4441 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4446 "AstInternal.hs" #-} + -- copy rule (up) + _lhsOproducedEnv = + {-# LINE 59 "./TypeChecking.ag" #-} + _statementsIproducedEnv + {-# LINE 4451 "AstInternal.hs" #-} + -- copy rule (down) + _statementsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4456 "AstInternal.hs" #-} + ( _statementsIannotatedTree,_statementsIproducedEnv) = + (statements_ _statementsOenv _statementsOenvUpdates ) + in ( _lhsOannotatedTree,_lhsOproducedEnv))) +-- RowConstraint ----------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative NotNullConstraint: + child ann : {Annotation} + visit 0: + local annotatedTree : _ + alternative NullConstraint: + child ann : {Annotation} + visit 0: + local annotatedTree : _ + alternative RowCheckConstraint: + child ann : {Annotation} + child expression : Expression + visit 0: + local annotatedTree : _ + alternative RowPrimaryKeyConstraint: + child ann : {Annotation} + visit 0: + local annotatedTree : _ + alternative RowReferenceConstraint: + child ann : {Annotation} + child table : {String} + child att : {Maybe String} + child onUpdate : Cascade + child onDelete : Cascade + visit 0: + local annotatedTree : _ + alternative RowUniqueConstraint: + child ann : {Annotation} + visit 0: + local annotatedTree : _ +-} +data RowConstraint = NotNullConstraint (Annotation) + | NullConstraint (Annotation) + | RowCheckConstraint (Annotation) (Expression) + | RowPrimaryKeyConstraint (Annotation) + | RowReferenceConstraint (Annotation) (String) (Maybe String) (Cascade) (Cascade) + | RowUniqueConstraint (Annotation) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_RowConstraint :: RowConstraint -> + T_RowConstraint +sem_RowConstraint (NotNullConstraint _ann ) = + (sem_RowConstraint_NotNullConstraint _ann ) +sem_RowConstraint (NullConstraint _ann ) = + (sem_RowConstraint_NullConstraint _ann ) +sem_RowConstraint (RowCheckConstraint _ann _expression ) = + (sem_RowConstraint_RowCheckConstraint _ann (sem_Expression _expression ) ) +sem_RowConstraint (RowPrimaryKeyConstraint _ann ) = + (sem_RowConstraint_RowPrimaryKeyConstraint _ann ) +sem_RowConstraint (RowReferenceConstraint _ann _table _att _onUpdate _onDelete ) = + (sem_RowConstraint_RowReferenceConstraint _ann _table _att (sem_Cascade _onUpdate ) (sem_Cascade _onDelete ) ) +sem_RowConstraint (RowUniqueConstraint _ann ) = + (sem_RowConstraint_RowUniqueConstraint _ann ) +-- semantic domain +type T_RowConstraint = Environment -> + ( RowConstraint) +data Inh_RowConstraint = Inh_RowConstraint {env_Inh_RowConstraint :: Environment} +data Syn_RowConstraint = Syn_RowConstraint {annotatedTree_Syn_RowConstraint :: RowConstraint} +wrap_RowConstraint :: T_RowConstraint -> + Inh_RowConstraint -> + Syn_RowConstraint +wrap_RowConstraint sem (Inh_RowConstraint _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_RowConstraint _lhsOannotatedTree )) +sem_RowConstraint_NotNullConstraint :: Annotation -> + T_RowConstraint +sem_RowConstraint_NotNullConstraint ann_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RowConstraint + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + NotNullConstraint ann_ + {-# LINE 4541 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4546 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_RowConstraint_NullConstraint :: Annotation -> + T_RowConstraint +sem_RowConstraint_NullConstraint ann_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RowConstraint + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + NullConstraint ann_ + {-# LINE 4557 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4562 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_RowConstraint_RowCheckConstraint :: Annotation -> + T_Expression -> + T_RowConstraint +sem_RowConstraint_RowCheckConstraint ann_ expression_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RowConstraint + _expressionOenv :: Environment + _expressionIannotatedTree :: Expression + _expressionIliftedColumnName :: String + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + RowCheckConstraint ann_ _expressionIannotatedTree + {-# LINE 4577 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4582 "AstInternal.hs" #-} + -- copy rule (down) + _expressionOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4587 "AstInternal.hs" #-} + ( _expressionIannotatedTree,_expressionIliftedColumnName) = + (expression_ _expressionOenv ) + in ( _lhsOannotatedTree))) +sem_RowConstraint_RowPrimaryKeyConstraint :: Annotation -> + T_RowConstraint +sem_RowConstraint_RowPrimaryKeyConstraint ann_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RowConstraint + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + RowPrimaryKeyConstraint ann_ + {-# LINE 4600 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4605 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_RowConstraint_RowReferenceConstraint :: Annotation -> + String -> + (Maybe String) -> + T_Cascade -> + T_Cascade -> + T_RowConstraint +sem_RowConstraint_RowReferenceConstraint ann_ table_ att_ onUpdate_ onDelete_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RowConstraint + _onUpdateOenv :: Environment + _onDeleteOenv :: Environment + _onUpdateIannotatedTree :: Cascade + _onDeleteIannotatedTree :: Cascade + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + RowReferenceConstraint ann_ table_ att_ _onUpdateIannotatedTree _onDeleteIannotatedTree + {-# LINE 4624 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4629 "AstInternal.hs" #-} + -- copy rule (down) + _onUpdateOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4634 "AstInternal.hs" #-} + -- copy rule (down) + _onDeleteOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4639 "AstInternal.hs" #-} + ( _onUpdateIannotatedTree) = + (onUpdate_ _onUpdateOenv ) + ( _onDeleteIannotatedTree) = + (onDelete_ _onDeleteOenv ) + in ( _lhsOannotatedTree))) +sem_RowConstraint_RowUniqueConstraint :: Annotation -> + T_RowConstraint +sem_RowConstraint_RowUniqueConstraint ann_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RowConstraint + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + RowUniqueConstraint ann_ + {-# LINE 4654 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4659 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- RowConstraintList ------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Cons: + child hd : RowConstraint + child tl : RowConstraintList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type RowConstraintList = [(RowConstraint)] +-- cata +sem_RowConstraintList :: RowConstraintList -> + T_RowConstraintList +sem_RowConstraintList list = + (Prelude.foldr sem_RowConstraintList_Cons sem_RowConstraintList_Nil (Prelude.map sem_RowConstraint list) ) +-- semantic domain +type T_RowConstraintList = Environment -> + ( RowConstraintList) +data Inh_RowConstraintList = Inh_RowConstraintList {env_Inh_RowConstraintList :: Environment} +data Syn_RowConstraintList = Syn_RowConstraintList {annotatedTree_Syn_RowConstraintList :: RowConstraintList} +wrap_RowConstraintList :: T_RowConstraintList -> + Inh_RowConstraintList -> + Syn_RowConstraintList +wrap_RowConstraintList sem (Inh_RowConstraintList _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_RowConstraintList _lhsOannotatedTree )) +sem_RowConstraintList_Cons :: T_RowConstraint -> + T_RowConstraintList -> + T_RowConstraintList +sem_RowConstraintList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RowConstraintList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: RowConstraint + _tlIannotatedTree :: RowConstraintList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 4710 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4715 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4720 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4725 "AstInternal.hs" #-} + ( _hdIannotatedTree) = + (hd_ _hdOenv ) + ( _tlIannotatedTree) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree))) +sem_RowConstraintList_Nil :: T_RowConstraintList +sem_RowConstraintList_Nil = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: RowConstraintList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 4739 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 4744 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- SelectExpression -------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative CombineSelect: + child ann : {Annotation} + child ctype : CombineType + child sel1 : SelectExpression + child sel2 : SelectExpression + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative Select: + child ann : {Annotation} + child selDistinct : Distinct + child selSelectList : SelectList + child selTref : TableRefList + child selWhere : MaybeBoolExpression + child selGroupBy : ExpressionList + child selHaving : MaybeBoolExpression + child selOrderBy : ExpressionDirectionPairList + child selLimit : MaybeExpression + child selOffset : MaybeExpression + visit 0: + local tpe : _ + local backTree : _ + local newEnv : _ + local annotatedTree : _ + alternative Values: + child ann : {Annotation} + child vll : ExpressionListList + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ +-} +data SelectExpression = CombineSelect (Annotation) (CombineType) (SelectExpression) (SelectExpression) + | Select (Annotation) (Distinct) (SelectList) (TableRefList) (MaybeBoolExpression) (ExpressionList) (MaybeBoolExpression) (ExpressionDirectionPairList) (MaybeExpression) (MaybeExpression) + | Values (Annotation) (ExpressionListList) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_SelectExpression :: SelectExpression -> + T_SelectExpression +sem_SelectExpression (CombineSelect _ann _ctype _sel1 _sel2 ) = + (sem_SelectExpression_CombineSelect _ann (sem_CombineType _ctype ) (sem_SelectExpression _sel1 ) (sem_SelectExpression _sel2 ) ) +sem_SelectExpression (Select _ann _selDistinct _selSelectList _selTref _selWhere _selGroupBy _selHaving _selOrderBy _selLimit _selOffset ) = + (sem_SelectExpression_Select _ann (sem_Distinct _selDistinct ) (sem_SelectList _selSelectList ) (sem_TableRefList _selTref ) (sem_MaybeBoolExpression _selWhere ) (sem_ExpressionList _selGroupBy ) (sem_MaybeBoolExpression _selHaving ) (sem_ExpressionDirectionPairList _selOrderBy ) (sem_MaybeExpression _selLimit ) (sem_MaybeExpression _selOffset ) ) +sem_SelectExpression (Values _ann _vll ) = + (sem_SelectExpression_Values _ann (sem_ExpressionListList _vll ) ) +-- semantic domain +type T_SelectExpression = Environment -> + ( SelectExpression) +data Inh_SelectExpression = Inh_SelectExpression {env_Inh_SelectExpression :: Environment} +data Syn_SelectExpression = Syn_SelectExpression {annotatedTree_Syn_SelectExpression :: SelectExpression} +wrap_SelectExpression :: T_SelectExpression -> + Inh_SelectExpression -> + Syn_SelectExpression +wrap_SelectExpression sem (Inh_SelectExpression _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_SelectExpression _lhsOannotatedTree )) +sem_SelectExpression_CombineSelect :: Annotation -> + T_CombineType -> + T_SelectExpression -> + T_SelectExpression -> + T_SelectExpression +sem_SelectExpression_CombineSelect ann_ ctype_ sel1_ sel2_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: SelectExpression + _ctypeOenv :: Environment + _sel1Oenv :: Environment + _sel2Oenv :: Environment + _ctypeIannotatedTree :: CombineType + _sel1IannotatedTree :: SelectExpression + _sel2IannotatedTree :: SelectExpression + -- "./TypeChecking.ag"(line 379, column 9) + _lhsOannotatedTree = + {-# LINE 379 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 4833 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 415, column 9) + _tpe = + {-# LINE 415 "./TypeChecking.ag" #-} + let sel1t = getTypeAnnotation _sel1IannotatedTree + sel2t = getTypeAnnotation _sel2IannotatedTree + in chainTypeCheckFailed [sel1t, sel2t] $ + typeCheckCombineSelect _lhsIenv sel1t sel2t + {-# LINE 4841 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 420, column 9) + _backTree = + {-# LINE 420 "./TypeChecking.ag" #-} + CombineSelect ann_ _ctypeIannotatedTree + _sel1IannotatedTree + _sel2IannotatedTree + {-# LINE 4848 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CombineSelect ann_ _ctypeIannotatedTree _sel1IannotatedTree _sel2IannotatedTree + {-# LINE 4853 "AstInternal.hs" #-} + -- copy rule (down) + _ctypeOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4858 "AstInternal.hs" #-} + -- copy rule (down) + _sel1Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4863 "AstInternal.hs" #-} + -- copy rule (down) + _sel2Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4868 "AstInternal.hs" #-} + ( _ctypeIannotatedTree) = + (ctype_ _ctypeOenv ) + ( _sel1IannotatedTree) = + (sel1_ _sel1Oenv ) + ( _sel2IannotatedTree) = + (sel2_ _sel2Oenv ) + in ( _lhsOannotatedTree))) +sem_SelectExpression_Select :: Annotation -> + T_Distinct -> + T_SelectList -> + T_TableRefList -> + T_MaybeBoolExpression -> + T_ExpressionList -> + T_MaybeBoolExpression -> + T_ExpressionDirectionPairList -> + T_MaybeExpression -> + T_MaybeExpression -> + T_SelectExpression +sem_SelectExpression_Select ann_ selDistinct_ selSelectList_ selTref_ selWhere_ selGroupBy_ selHaving_ selOrderBy_ selLimit_ selOffset_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: SelectExpression + _selSelectListOenv :: Environment + _selWhereOenv :: Environment + _selDistinctOenv :: Environment + _selTrefOenv :: Environment + _selGroupByOenv :: Environment + _selHavingOenv :: Environment + _selOrderByOenv :: Environment + _selLimitOenv :: Environment + _selOffsetOenv :: Environment + _selDistinctIannotatedTree :: Distinct + _selSelectListIannotatedTree :: SelectList + _selSelectListIlistType :: Type + _selTrefIannotatedTree :: TableRefList + _selTrefIidens :: ([(String,([(String,Type)],[(String,Type)]))]) + _selTrefIjoinIdens :: ([String]) + _selWhereIannotatedTree :: MaybeBoolExpression + _selGroupByIannotatedTree :: ExpressionList + _selGroupByItypeList :: ([Type]) + _selHavingIannotatedTree :: MaybeBoolExpression + _selOrderByIannotatedTree :: ExpressionDirectionPairList + _selLimitIannotatedTree :: MaybeExpression + _selLimitIexprType :: (Maybe Type) + _selOffsetIannotatedTree :: MaybeExpression + _selOffsetIexprType :: (Maybe Type) + -- "./TypeChecking.ag"(line 379, column 9) + _lhsOannotatedTree = + {-# LINE 379 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 4921 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 391, column 9) + _tpe = + {-# LINE 391 "./TypeChecking.ag" #-} + do + let trefType = let ts = _selTrefIannotatedTree + in case null ts of + True -> typeBool + _ -> getTypeAnnotation $ head ts + slType = _selSelectListIlistType + chainTypeCheckFailed [trefType, slType] $ + Right $ case slType of + UnnamedCompositeType [(_,Pseudo Void)] -> Pseudo Void + _ -> SetOfType slType + {-# LINE 4935 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 404, column 9) + _backTree = + {-# LINE 404 "./TypeChecking.ag" #-} + Select ann_ + _selDistinctIannotatedTree + _selSelectListIannotatedTree + _selTrefIannotatedTree + _selWhereIannotatedTree + _selGroupByIannotatedTree + _selHavingIannotatedTree + _selOrderByIannotatedTree + _selLimitIannotatedTree + _selOffsetIannotatedTree + {-# LINE 4949 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 602, column 10) + _newEnv = + {-# LINE 602 "./TypeChecking.ag" #-} + case updateEnvironment _lhsIenv + (convertToNewStyleUpdates _selTrefIidens _selTrefIjoinIdens) of + Left x -> error $ show x + Right e -> e + {-# LINE 4957 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 606, column 10) + _selSelectListOenv = + {-# LINE 606 "./TypeChecking.ag" #-} + _newEnv + {-# LINE 4962 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 607, column 10) + _selWhereOenv = + {-# LINE 607 "./TypeChecking.ag" #-} + _newEnv + {-# LINE 4967 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Select ann_ _selDistinctIannotatedTree _selSelectListIannotatedTree _selTrefIannotatedTree _selWhereIannotatedTree _selGroupByIannotatedTree _selHavingIannotatedTree _selOrderByIannotatedTree _selLimitIannotatedTree _selOffsetIannotatedTree + {-# LINE 4972 "AstInternal.hs" #-} + -- copy rule (down) + _selDistinctOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4977 "AstInternal.hs" #-} + -- copy rule (down) + _selTrefOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4982 "AstInternal.hs" #-} + -- copy rule (down) + _selGroupByOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4987 "AstInternal.hs" #-} + -- copy rule (down) + _selHavingOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4992 "AstInternal.hs" #-} + -- copy rule (down) + _selOrderByOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 4997 "AstInternal.hs" #-} + -- copy rule (down) + _selLimitOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5002 "AstInternal.hs" #-} + -- copy rule (down) + _selOffsetOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5007 "AstInternal.hs" #-} + ( _selDistinctIannotatedTree) = + (selDistinct_ _selDistinctOenv ) + ( _selSelectListIannotatedTree,_selSelectListIlistType) = + (selSelectList_ _selSelectListOenv ) + ( _selTrefIannotatedTree,_selTrefIidens,_selTrefIjoinIdens) = + (selTref_ _selTrefOenv ) + ( _selWhereIannotatedTree) = + (selWhere_ _selWhereOenv ) + ( _selGroupByIannotatedTree,_selGroupByItypeList) = + (selGroupBy_ _selGroupByOenv ) + ( _selHavingIannotatedTree) = + (selHaving_ _selHavingOenv ) + ( _selOrderByIannotatedTree) = + (selOrderBy_ _selOrderByOenv ) + ( _selLimitIannotatedTree,_selLimitIexprType) = + (selLimit_ _selLimitOenv ) + ( _selOffsetIannotatedTree,_selOffsetIexprType) = + (selOffset_ _selOffsetOenv ) + in ( _lhsOannotatedTree))) +sem_SelectExpression_Values :: Annotation -> + T_ExpressionListList -> + T_SelectExpression +sem_SelectExpression_Values ann_ vll_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: SelectExpression + _vllOenv :: Environment + _vllIannotatedTree :: ExpressionListList + _vllItypeListList :: ([[Type]]) + -- "./TypeChecking.ag"(line 379, column 9) + _lhsOannotatedTree = + {-# LINE 379 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 5043 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 386, column 9) + _tpe = + {-# LINE 386 "./TypeChecking.ag" #-} + typeCheckValuesExpr + _lhsIenv + _vllItypeListList + {-# LINE 5050 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 389, column 9) + _backTree = + {-# LINE 389 "./TypeChecking.ag" #-} + Values ann_ _vllIannotatedTree + {-# LINE 5055 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Values ann_ _vllIannotatedTree + {-# LINE 5060 "AstInternal.hs" #-} + -- copy rule (down) + _vllOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5065 "AstInternal.hs" #-} + ( _vllIannotatedTree,_vllItypeListList) = + (vll_ _vllOenv ) + in ( _lhsOannotatedTree))) +-- SelectItem -------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + columnName : String + itemType : Type + alternatives: + alternative SelExp: + child ann : {Annotation} + child ex : Expression + visit 0: + local annotatedTree : _ + alternative SelectItem: + child ann : {Annotation} + child ex : Expression + child name : {String} + visit 0: + local backTree : _ + local annotatedTree : _ +-} +data SelectItem = SelExp (Annotation) (Expression) + | SelectItem (Annotation) (Expression) (String) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_SelectItem :: SelectItem -> + T_SelectItem +sem_SelectItem (SelExp _ann _ex ) = + (sem_SelectItem_SelExp _ann (sem_Expression _ex ) ) +sem_SelectItem (SelectItem _ann _ex _name ) = + (sem_SelectItem_SelectItem _ann (sem_Expression _ex ) _name ) +-- semantic domain +type T_SelectItem = Environment -> + ( SelectItem,String,Type) +data Inh_SelectItem = Inh_SelectItem {env_Inh_SelectItem :: Environment} +data Syn_SelectItem = Syn_SelectItem {annotatedTree_Syn_SelectItem :: SelectItem,columnName_Syn_SelectItem :: String,itemType_Syn_SelectItem :: Type} +wrap_SelectItem :: T_SelectItem -> + Inh_SelectItem -> + Syn_SelectItem +wrap_SelectItem sem (Inh_SelectItem _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOcolumnName,_lhsOitemType) = + (sem _lhsIenv ) + in (Syn_SelectItem _lhsOannotatedTree _lhsOcolumnName _lhsOitemType )) +sem_SelectItem_SelExp :: Annotation -> + T_Expression -> + T_SelectItem +sem_SelectItem_SelExp ann_ ex_ = + (\ _lhsIenv -> + (let _lhsOitemType :: Type + _lhsOcolumnName :: String + _lhsOannotatedTree :: SelectItem + _exOenv :: Environment + _exIannotatedTree :: Expression + _exIliftedColumnName :: String + -- "./TypeChecking.ag"(line 543, column 9) + _lhsOitemType = + {-# LINE 543 "./TypeChecking.ag" #-} + getTypeAnnotation _exIannotatedTree + {-# LINE 5129 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 548, column 9) + _annotatedTree = + {-# LINE 548 "./TypeChecking.ag" #-} + SelExp ann_ $ fixStar _exIannotatedTree + {-# LINE 5134 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 660, column 14) + _lhsOcolumnName = + {-# LINE 660 "./TypeChecking.ag" #-} + case _exIliftedColumnName of + "" -> "?column?" + s -> s + {-# LINE 5141 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 5146 "AstInternal.hs" #-} + -- copy rule (down) + _exOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5151 "AstInternal.hs" #-} + ( _exIannotatedTree,_exIliftedColumnName) = + (ex_ _exOenv ) + in ( _lhsOannotatedTree,_lhsOcolumnName,_lhsOitemType))) +sem_SelectItem_SelectItem :: Annotation -> + T_Expression -> + String -> + T_SelectItem +sem_SelectItem_SelectItem ann_ ex_ name_ = + (\ _lhsIenv -> + (let _lhsOitemType :: Type + _lhsOcolumnName :: String + _lhsOannotatedTree :: SelectItem + _exOenv :: Environment + _exIannotatedTree :: Expression + _exIliftedColumnName :: String + -- "./TypeChecking.ag"(line 543, column 9) + _lhsOitemType = + {-# LINE 543 "./TypeChecking.ag" #-} + getTypeAnnotation _exIannotatedTree + {-# LINE 5171 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 550, column 9) + _backTree = + {-# LINE 550 "./TypeChecking.ag" #-} + SelectItem ann_ (fixStar _exIannotatedTree) name_ + {-# LINE 5176 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 663, column 18) + _lhsOcolumnName = + {-# LINE 663 "./TypeChecking.ag" #-} + name_ + {-# LINE 5181 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + SelectItem ann_ _exIannotatedTree name_ + {-# LINE 5186 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 5191 "AstInternal.hs" #-} + -- copy rule (down) + _exOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5196 "AstInternal.hs" #-} + ( _exIannotatedTree,_exIliftedColumnName) = + (ex_ _exOenv ) + in ( _lhsOannotatedTree,_lhsOcolumnName,_lhsOitemType))) +-- SelectItemList ---------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + listType : Type + alternatives: + alternative Cons: + child hd : SelectItem + child tl : SelectItemList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type SelectItemList = [(SelectItem)] +-- cata +sem_SelectItemList :: SelectItemList -> + T_SelectItemList +sem_SelectItemList list = + (Prelude.foldr sem_SelectItemList_Cons sem_SelectItemList_Nil (Prelude.map sem_SelectItem list) ) +-- semantic domain +type T_SelectItemList = Environment -> + ( SelectItemList,Type) +data Inh_SelectItemList = Inh_SelectItemList {env_Inh_SelectItemList :: Environment} +data Syn_SelectItemList = Syn_SelectItemList {annotatedTree_Syn_SelectItemList :: SelectItemList,listType_Syn_SelectItemList :: Type} +wrap_SelectItemList :: T_SelectItemList -> + Inh_SelectItemList -> + Syn_SelectItemList +wrap_SelectItemList sem (Inh_SelectItemList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOlistType) = + (sem _lhsIenv ) + in (Syn_SelectItemList _lhsOannotatedTree _lhsOlistType )) +sem_SelectItemList_Cons :: T_SelectItem -> + T_SelectItemList -> + T_SelectItemList +sem_SelectItemList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOlistType :: Type + _lhsOannotatedTree :: SelectItemList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: SelectItem + _hdIcolumnName :: String + _hdIitemType :: Type + _tlIannotatedTree :: SelectItemList + _tlIlistType :: Type + -- "./TypeChecking.ag"(line 536, column 12) + _lhsOlistType = + {-# LINE 536 "./TypeChecking.ag" #-} + doSelectItemListTpe _lhsIenv _hdIcolumnName _hdIitemType _tlIlistType + {-# LINE 5254 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 5259 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 5264 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5269 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5274 "AstInternal.hs" #-} + ( _hdIannotatedTree,_hdIcolumnName,_hdIitemType) = + (hd_ _hdOenv ) + ( _tlIannotatedTree,_tlIlistType) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree,_lhsOlistType))) +sem_SelectItemList_Nil :: T_SelectItemList +sem_SelectItemList_Nil = + (\ _lhsIenv -> + (let _lhsOlistType :: Type + _lhsOannotatedTree :: SelectItemList + -- "./TypeChecking.ag"(line 537, column 11) + _lhsOlistType = + {-# LINE 537 "./TypeChecking.ag" #-} + UnnamedCompositeType [] + {-# LINE 5289 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 5294 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 5299 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOlistType))) +-- SelectList -------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + listType : Type + alternatives: + alternative SelectList: + child ann : {Annotation} + child items : SelectItemList + child stringList : StringList + visit 0: + local annotatedTree : _ +-} +data SelectList = SelectList (Annotation) (SelectItemList) (StringList) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_SelectList :: SelectList -> + T_SelectList +sem_SelectList (SelectList _ann _items _stringList ) = + (sem_SelectList_SelectList _ann (sem_SelectItemList _items ) (sem_StringList _stringList ) ) +-- semantic domain +type T_SelectList = Environment -> + ( SelectList,Type) +data Inh_SelectList = Inh_SelectList {env_Inh_SelectList :: Environment} +data Syn_SelectList = Syn_SelectList {annotatedTree_Syn_SelectList :: SelectList,listType_Syn_SelectList :: Type} +wrap_SelectList :: T_SelectList -> + Inh_SelectList -> + Syn_SelectList +wrap_SelectList sem (Inh_SelectList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOlistType) = + (sem _lhsIenv ) + in (Syn_SelectList _lhsOannotatedTree _lhsOlistType )) +sem_SelectList_SelectList :: Annotation -> + T_SelectItemList -> + T_StringList -> + T_SelectList +sem_SelectList_SelectList ann_ items_ stringList_ = + (\ _lhsIenv -> + (let _lhsOlistType :: Type + _lhsOannotatedTree :: SelectList + _itemsOenv :: Environment + _stringListOenv :: Environment + _itemsIannotatedTree :: SelectItemList + _itemsIlistType :: Type + _stringListIannotatedTree :: StringList + _stringListIstrings :: ([String]) + -- "./TypeChecking.ag"(line 576, column 9) + _lhsOlistType = + {-# LINE 576 "./TypeChecking.ag" #-} + _itemsIlistType + {-# LINE 5354 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + SelectList ann_ _itemsIannotatedTree _stringListIannotatedTree + {-# LINE 5359 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 5364 "AstInternal.hs" #-} + -- copy rule (down) + _itemsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5369 "AstInternal.hs" #-} + -- copy rule (down) + _stringListOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5374 "AstInternal.hs" #-} + ( _itemsIannotatedTree,_itemsIlistType) = + (items_ _itemsOenv ) + ( _stringListIannotatedTree,_stringListIstrings) = + (stringList_ _stringListOenv ) + in ( _lhsOannotatedTree,_lhsOlistType))) +-- SetClause --------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + pairs : [(String,Type)] + rowSetError : Maybe TypeError + alternatives: + alternative RowSetClause: + child ann : {Annotation} + child atts : StringList + child vals : ExpressionList + visit 0: + local rowSetError : _ + local annotatedTree : _ + alternative SetClause: + child ann : {Annotation} + child att : {String} + child val : Expression + visit 0: + local annotatedTree : _ +-} +data SetClause = RowSetClause (Annotation) (StringList) (ExpressionList) + | SetClause (Annotation) (String) (Expression) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_SetClause :: SetClause -> + T_SetClause +sem_SetClause (RowSetClause _ann _atts _vals ) = + (sem_SetClause_RowSetClause _ann (sem_StringList _atts ) (sem_ExpressionList _vals ) ) +sem_SetClause (SetClause _ann _att _val ) = + (sem_SetClause_SetClause _ann _att (sem_Expression _val ) ) +-- semantic domain +type T_SetClause = Environment -> + ( SetClause,([(String,Type)]),(Maybe TypeError)) +data Inh_SetClause = Inh_SetClause {env_Inh_SetClause :: Environment} +data Syn_SetClause = Syn_SetClause {annotatedTree_Syn_SetClause :: SetClause,pairs_Syn_SetClause :: [(String,Type)],rowSetError_Syn_SetClause :: Maybe TypeError} +wrap_SetClause :: T_SetClause -> + Inh_SetClause -> + Syn_SetClause +wrap_SetClause sem (Inh_SetClause _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetError) = + (sem _lhsIenv ) + in (Syn_SetClause _lhsOannotatedTree _lhsOpairs _lhsOrowSetError )) +sem_SetClause_RowSetClause :: Annotation -> + T_StringList -> + T_ExpressionList -> + T_SetClause +sem_SetClause_RowSetClause ann_ atts_ vals_ = + (\ _lhsIenv -> + (let _lhsOpairs :: ([(String,Type)]) + _lhsOannotatedTree :: SetClause + _lhsOrowSetError :: (Maybe TypeError) + _attsOenv :: Environment + _valsOenv :: Environment + _attsIannotatedTree :: StringList + _attsIstrings :: ([String]) + _valsIannotatedTree :: ExpressionList + _valsItypeList :: ([Type]) + -- "./TypeChecking.ag"(line 743, column 9) + _rowSetError = + {-# LINE 743 "./TypeChecking.ag" #-} + let atts = _attsIstrings + types = getRowTypes _valsItypeList + in if length atts /= length types + then Just WrongNumberOfColumns + else Nothing + {-# LINE 5449 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 749, column 9) + _lhsOpairs = + {-# LINE 749 "./TypeChecking.ag" #-} + zip _attsIstrings $ getRowTypes _valsItypeList + {-# LINE 5454 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + RowSetClause ann_ _attsIannotatedTree _valsIannotatedTree + {-# LINE 5459 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 5464 "AstInternal.hs" #-} + -- copy rule (from local) + _lhsOrowSetError = + {-# LINE 736 "./TypeChecking.ag" #-} + _rowSetError + {-# LINE 5469 "AstInternal.hs" #-} + -- copy rule (down) + _attsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5474 "AstInternal.hs" #-} + -- copy rule (down) + _valsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5479 "AstInternal.hs" #-} + ( _attsIannotatedTree,_attsIstrings) = + (atts_ _attsOenv ) + ( _valsIannotatedTree,_valsItypeList) = + (vals_ _valsOenv ) + in ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetError))) +sem_SetClause_SetClause :: Annotation -> + String -> + T_Expression -> + T_SetClause +sem_SetClause_SetClause ann_ att_ val_ = + (\ _lhsIenv -> + (let _lhsOpairs :: ([(String,Type)]) + _lhsOrowSetError :: (Maybe TypeError) + _lhsOannotatedTree :: SetClause + _valOenv :: Environment + _valIannotatedTree :: Expression + _valIliftedColumnName :: String + -- "./TypeChecking.ag"(line 740, column 9) + _lhsOpairs = + {-# LINE 740 "./TypeChecking.ag" #-} + [(att_, getTypeAnnotation _valIannotatedTree)] + {-# LINE 5501 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 741, column 9) + _lhsOrowSetError = + {-# LINE 741 "./TypeChecking.ag" #-} + Nothing + {-# LINE 5506 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + SetClause ann_ att_ _valIannotatedTree + {-# LINE 5511 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 5516 "AstInternal.hs" #-} + -- copy rule (down) + _valOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5521 "AstInternal.hs" #-} + ( _valIannotatedTree,_valIliftedColumnName) = + (val_ _valOenv ) + in ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetError))) +-- SetClauseList ----------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + pairs : [(String,Type)] + rowSetErrors : [TypeError] + alternatives: + alternative Cons: + child hd : SetClause + child tl : SetClauseList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type SetClauseList = [(SetClause)] +-- cata +sem_SetClauseList :: SetClauseList -> + T_SetClauseList +sem_SetClauseList list = + (Prelude.foldr sem_SetClauseList_Cons sem_SetClauseList_Nil (Prelude.map sem_SetClause list) ) +-- semantic domain +type T_SetClauseList = Environment -> + ( SetClauseList,([(String,Type)]),([TypeError])) +data Inh_SetClauseList = Inh_SetClauseList {env_Inh_SetClauseList :: Environment} +data Syn_SetClauseList = Syn_SetClauseList {annotatedTree_Syn_SetClauseList :: SetClauseList,pairs_Syn_SetClauseList :: [(String,Type)],rowSetErrors_Syn_SetClauseList :: [TypeError]} +wrap_SetClauseList :: T_SetClauseList -> + Inh_SetClauseList -> + Syn_SetClauseList +wrap_SetClauseList sem (Inh_SetClauseList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetErrors) = + (sem _lhsIenv ) + in (Syn_SetClauseList _lhsOannotatedTree _lhsOpairs _lhsOrowSetErrors )) +sem_SetClauseList_Cons :: T_SetClause -> + T_SetClauseList -> + T_SetClauseList +sem_SetClauseList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOpairs :: ([(String,Type)]) + _lhsOrowSetErrors :: ([TypeError]) + _lhsOannotatedTree :: SetClauseList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: SetClause + _hdIpairs :: ([(String,Type)]) + _hdIrowSetError :: (Maybe TypeError) + _tlIannotatedTree :: SetClauseList + _tlIpairs :: ([(String,Type)]) + _tlIrowSetErrors :: ([TypeError]) + -- "./TypeChecking.ag"(line 730, column 10) + _lhsOpairs = + {-# LINE 730 "./TypeChecking.ag" #-} + _hdIpairs ++ _tlIpairs + {-# LINE 5582 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 731, column 10) + _lhsOrowSetErrors = + {-# LINE 731 "./TypeChecking.ag" #-} + maybeToList _hdIrowSetError ++ _tlIrowSetErrors + {-# LINE 5587 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 5592 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 5597 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5602 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 5607 "AstInternal.hs" #-} + ( _hdIannotatedTree,_hdIpairs,_hdIrowSetError) = + (hd_ _hdOenv ) + ( _tlIannotatedTree,_tlIpairs,_tlIrowSetErrors) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetErrors))) +sem_SetClauseList_Nil :: T_SetClauseList +sem_SetClauseList_Nil = + (\ _lhsIenv -> + (let _lhsOpairs :: ([(String,Type)]) + _lhsOrowSetErrors :: ([TypeError]) + _lhsOannotatedTree :: SetClauseList + -- "./TypeChecking.ag"(line 732, column 9) + _lhsOpairs = + {-# LINE 732 "./TypeChecking.ag" #-} + [] + {-# LINE 5623 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 733, column 9) + _lhsOrowSetErrors = + {-# LINE 733 "./TypeChecking.ag" #-} + [] + {-# LINE 5628 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 5633 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 5638 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOpairs,_lhsOrowSetErrors))) +-- Statement --------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + envUpdates : [EnvironmentUpdate] + alternatives: + alternative Assignment: + child ann : {Annotation} + child target : {String} + child value : Expression + visit 0: + local annotatedTree : _ + alternative CaseStatement: + child ann : {Annotation} + child val : Expression + child cases : ExpressionListStatementListPairList + child els : StatementList + visit 0: + local annotatedTree : _ + alternative ContinueStatement: + child ann : {Annotation} + visit 0: + local annotatedTree : _ + alternative Copy: + child ann : {Annotation} + child table : {String} + child targetCols : StringList + child source : CopySource + visit 0: + local annotatedTree : _ + alternative CopyData: + child ann : {Annotation} + child insData : {String} + visit 0: + local annotatedTree : _ + alternative CreateDomain: + child ann : {Annotation} + child name : {String} + child typ : TypeName + child check : MaybeBoolExpression + visit 0: + local tpe : _ + local backTree : _ + local statementInfo : _ + local envUpdates : _ + local annotatedTree : _ + alternative CreateFunction: + child ann : {Annotation} + child lang : Language + child name : {String} + child params : ParamDefList + child rettype : TypeName + child bodyQuote : {String} + child body : FnBody + child vol : Volatility + visit 0: + local tpe : _ + local backTree : _ + local statementInfo : _ + local envUpdates : _ + local annotatedTree : _ + alternative CreateTable: + child ann : {Annotation} + child name : {String} + child atts : AttributeDefList + child cons : ConstraintList + visit 0: + local attrTypes : _ + local tpe : _ + local backTree : _ + local statementInfo : _ + local envUpdates : _ + local annotatedTree : _ + alternative CreateTableAs: + child ann : {Annotation} + child name : {String} + child expr : SelectExpression + visit 0: + local selType : _ + local tpe : _ + local backTree : _ + local statementInfo : _ + local attrs : _ + local envUpdates : _ + local annotatedTree : _ + alternative CreateType: + child ann : {Annotation} + child name : {String} + child atts : TypeAttributeDefList + visit 0: + local tpe : _ + local backTree : _ + local statementInfo : _ + local envUpdates : _ + local annotatedTree : _ + alternative CreateView: + child ann : {Annotation} + child name : {String} + child expr : SelectExpression + visit 0: + local tpe : _ + local backTree : _ + local statementInfo : _ + local attrs : _ + local envUpdates : _ + local annotatedTree : _ + alternative Delete: + child ann : {Annotation} + child table : {String} + child whr : MaybeBoolExpression + child returning : {Maybe SelectList} + visit 0: + local tpe : _ + local statementInfo : _ + local backTree : _ + local envUpdates : _ + local annotatedTree : _ + alternative DropFunction: + child ann : {Annotation} + child ifE : IfExists + child sigs : StringStringListPairList + child cascade : Cascade + visit 0: + local annotatedTree : _ + alternative DropSomething: + child ann : {Annotation} + child dropType : DropType + child ifE : IfExists + child names : StringList + child cascade : Cascade + visit 0: + local annotatedTree : _ + alternative Execute: + child ann : {Annotation} + child expr : Expression + visit 0: + local annotatedTree : _ + alternative ExecuteInto: + child ann : {Annotation} + child expr : Expression + child targets : StringList + visit 0: + local annotatedTree : _ + alternative ForIntegerStatement: + child ann : {Annotation} + child var : {String} + child from : Expression + child to : Expression + child sts : StatementList + visit 0: + local annotatedTree : _ + alternative ForSelectStatement: + child ann : {Annotation} + child var : {String} + child sel : SelectExpression + child sts : StatementList + visit 0: + local annotatedTree : _ + alternative If: + child ann : {Annotation} + child cases : ExpressionStatementListPairList + child els : StatementList + visit 0: + local annotatedTree : _ + alternative Insert: + child ann : {Annotation} + child table : {String} + child targetCols : StringList + child insData : SelectExpression + child returning : {Maybe SelectList} + visit 0: + local columnStuff : _ + local tpe : _ + local statementInfo : _ + local backTree : _ + local envUpdates : _ + local annotatedTree : _ + alternative NullStatement: + child ann : {Annotation} + visit 0: + local annotatedTree : _ + alternative Perform: + child ann : {Annotation} + child expr : Expression + visit 0: + local annotatedTree : _ + alternative Raise: + child ann : {Annotation} + child level : RaiseType + child message : {String} + child args : ExpressionList + visit 0: + local annotatedTree : _ + alternative Return: + child ann : {Annotation} + child value : MaybeExpression + visit 0: + local tpe : _ + local backTree : _ + local envUpdates : _ + local statementInfo : _ + local annotatedTree : _ + alternative ReturnNext: + child ann : {Annotation} + child expr : Expression + visit 0: + local annotatedTree : _ + alternative ReturnQuery: + child ann : {Annotation} + child sel : SelectExpression + visit 0: + local annotatedTree : _ + alternative SelectStatement: + child ann : {Annotation} + child ex : SelectExpression + visit 0: + local tpe : _ + local statementInfo : _ + local backTree : _ + local envUpdates : _ + local annotatedTree : _ + alternative Truncate: + child ann : {Annotation} + child tables : StringList + child restartIdentity : RestartIdentity + child cascade : Cascade + visit 0: + local annotatedTree : _ + alternative Update: + child ann : {Annotation} + child table : {String} + child assigns : SetClauseList + child whr : MaybeBoolExpression + child returning : {Maybe SelectList} + visit 0: + local tpe : _ + local columnsConsistent : _ + local statementInfo : _ + local backTree : _ + local envUpdates : _ + local annotatedTree : _ + alternative WhileStatement: + child ann : {Annotation} + child expr : Expression + child sts : StatementList + visit 0: + local annotatedTree : _ +-} +data Statement = Assignment (Annotation) (String) (Expression) + | CaseStatement (Annotation) (Expression) (ExpressionListStatementListPairList) (StatementList) + | ContinueStatement (Annotation) + | Copy (Annotation) (String) (StringList) (CopySource) + | CopyData (Annotation) (String) + | CreateDomain (Annotation) (String) (TypeName) (MaybeBoolExpression) + | CreateFunction (Annotation) (Language) (String) (ParamDefList) (TypeName) (String) (FnBody) (Volatility) + | CreateTable (Annotation) (String) (AttributeDefList) (ConstraintList) + | CreateTableAs (Annotation) (String) (SelectExpression) + | CreateType (Annotation) (String) (TypeAttributeDefList) + | CreateView (Annotation) (String) (SelectExpression) + | Delete (Annotation) (String) (MaybeBoolExpression) (Maybe SelectList) + | DropFunction (Annotation) (IfExists) (StringStringListPairList) (Cascade) + | DropSomething (Annotation) (DropType) (IfExists) (StringList) (Cascade) + | Execute (Annotation) (Expression) + | ExecuteInto (Annotation) (Expression) (StringList) + | ForIntegerStatement (Annotation) (String) (Expression) (Expression) (StatementList) + | ForSelectStatement (Annotation) (String) (SelectExpression) (StatementList) + | If (Annotation) (ExpressionStatementListPairList) (StatementList) + | Insert (Annotation) (String) (StringList) (SelectExpression) (Maybe SelectList) + | NullStatement (Annotation) + | Perform (Annotation) (Expression) + | Raise (Annotation) (RaiseType) (String) (ExpressionList) + | Return (Annotation) (MaybeExpression) + | ReturnNext (Annotation) (Expression) + | ReturnQuery (Annotation) (SelectExpression) + | SelectStatement (Annotation) (SelectExpression) + | Truncate (Annotation) (StringList) (RestartIdentity) (Cascade) + | Update (Annotation) (String) (SetClauseList) (MaybeBoolExpression) (Maybe SelectList) + | WhileStatement (Annotation) (Expression) (StatementList) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_Statement :: Statement -> + T_Statement +sem_Statement (Assignment _ann _target _value ) = + (sem_Statement_Assignment _ann _target (sem_Expression _value ) ) +sem_Statement (CaseStatement _ann _val _cases _els ) = + (sem_Statement_CaseStatement _ann (sem_Expression _val ) (sem_ExpressionListStatementListPairList _cases ) (sem_StatementList _els ) ) +sem_Statement (ContinueStatement _ann ) = + (sem_Statement_ContinueStatement _ann ) +sem_Statement (Copy _ann _table _targetCols _source ) = + (sem_Statement_Copy _ann _table (sem_StringList _targetCols ) (sem_CopySource _source ) ) +sem_Statement (CopyData _ann _insData ) = + (sem_Statement_CopyData _ann _insData ) +sem_Statement (CreateDomain _ann _name _typ _check ) = + (sem_Statement_CreateDomain _ann _name (sem_TypeName _typ ) (sem_MaybeBoolExpression _check ) ) +sem_Statement (CreateFunction _ann _lang _name _params _rettype _bodyQuote _body _vol ) = + (sem_Statement_CreateFunction _ann (sem_Language _lang ) _name (sem_ParamDefList _params ) (sem_TypeName _rettype ) _bodyQuote (sem_FnBody _body ) (sem_Volatility _vol ) ) +sem_Statement (CreateTable _ann _name _atts _cons ) = + (sem_Statement_CreateTable _ann _name (sem_AttributeDefList _atts ) (sem_ConstraintList _cons ) ) +sem_Statement (CreateTableAs _ann _name _expr ) = + (sem_Statement_CreateTableAs _ann _name (sem_SelectExpression _expr ) ) +sem_Statement (CreateType _ann _name _atts ) = + (sem_Statement_CreateType _ann _name (sem_TypeAttributeDefList _atts ) ) +sem_Statement (CreateView _ann _name _expr ) = + (sem_Statement_CreateView _ann _name (sem_SelectExpression _expr ) ) +sem_Statement (Delete _ann _table _whr _returning ) = + (sem_Statement_Delete _ann _table (sem_MaybeBoolExpression _whr ) _returning ) +sem_Statement (DropFunction _ann _ifE _sigs _cascade ) = + (sem_Statement_DropFunction _ann (sem_IfExists _ifE ) (sem_StringStringListPairList _sigs ) (sem_Cascade _cascade ) ) +sem_Statement (DropSomething _ann _dropType _ifE _names _cascade ) = + (sem_Statement_DropSomething _ann (sem_DropType _dropType ) (sem_IfExists _ifE ) (sem_StringList _names ) (sem_Cascade _cascade ) ) +sem_Statement (Execute _ann _expr ) = + (sem_Statement_Execute _ann (sem_Expression _expr ) ) +sem_Statement (ExecuteInto _ann _expr _targets ) = + (sem_Statement_ExecuteInto _ann (sem_Expression _expr ) (sem_StringList _targets ) ) +sem_Statement (ForIntegerStatement _ann _var _from _to _sts ) = + (sem_Statement_ForIntegerStatement _ann _var (sem_Expression _from ) (sem_Expression _to ) (sem_StatementList _sts ) ) +sem_Statement (ForSelectStatement _ann _var _sel _sts ) = + (sem_Statement_ForSelectStatement _ann _var (sem_SelectExpression _sel ) (sem_StatementList _sts ) ) +sem_Statement (If _ann _cases _els ) = + (sem_Statement_If _ann (sem_ExpressionStatementListPairList _cases ) (sem_StatementList _els ) ) +sem_Statement (Insert _ann _table _targetCols _insData _returning ) = + (sem_Statement_Insert _ann _table (sem_StringList _targetCols ) (sem_SelectExpression _insData ) _returning ) +sem_Statement (NullStatement _ann ) = + (sem_Statement_NullStatement _ann ) +sem_Statement (Perform _ann _expr ) = + (sem_Statement_Perform _ann (sem_Expression _expr ) ) +sem_Statement (Raise _ann _level _message _args ) = + (sem_Statement_Raise _ann (sem_RaiseType _level ) _message (sem_ExpressionList _args ) ) +sem_Statement (Return _ann _value ) = + (sem_Statement_Return _ann (sem_MaybeExpression _value ) ) +sem_Statement (ReturnNext _ann _expr ) = + (sem_Statement_ReturnNext _ann (sem_Expression _expr ) ) +sem_Statement (ReturnQuery _ann _sel ) = + (sem_Statement_ReturnQuery _ann (sem_SelectExpression _sel ) ) +sem_Statement (SelectStatement _ann _ex ) = + (sem_Statement_SelectStatement _ann (sem_SelectExpression _ex ) ) +sem_Statement (Truncate _ann _tables _restartIdentity _cascade ) = + (sem_Statement_Truncate _ann (sem_StringList _tables ) (sem_RestartIdentity _restartIdentity ) (sem_Cascade _cascade ) ) +sem_Statement (Update _ann _table _assigns _whr _returning ) = + (sem_Statement_Update _ann _table (sem_SetClauseList _assigns ) (sem_MaybeBoolExpression _whr ) _returning ) +sem_Statement (WhileStatement _ann _expr _sts ) = + (sem_Statement_WhileStatement _ann (sem_Expression _expr ) (sem_StatementList _sts ) ) +-- semantic domain +type T_Statement = Environment -> + ( Statement,([EnvironmentUpdate])) +data Inh_Statement = Inh_Statement {env_Inh_Statement :: Environment} +data Syn_Statement = Syn_Statement {annotatedTree_Syn_Statement :: Statement,envUpdates_Syn_Statement :: [EnvironmentUpdate]} +wrap_Statement :: T_Statement -> + Inh_Statement -> + Syn_Statement +wrap_Statement sem (Inh_Statement _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOenvUpdates) = + (sem _lhsIenv ) + in (Syn_Statement _lhsOannotatedTree _lhsOenvUpdates )) +sem_Statement_Assignment :: Annotation -> + String -> + T_Expression -> + T_Statement +sem_Statement_Assignment ann_ target_ value_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _valueOenv :: Environment + _valueIannotatedTree :: Expression + _valueIliftedColumnName :: String + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6012 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Assignment ann_ target_ _valueIannotatedTree + {-# LINE 6017 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6022 "AstInternal.hs" #-} + -- copy rule (down) + _valueOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6027 "AstInternal.hs" #-} + ( _valueIannotatedTree,_valueIliftedColumnName) = + (value_ _valueOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_CaseStatement :: Annotation -> + T_Expression -> + T_ExpressionListStatementListPairList -> + T_StatementList -> + T_Statement +sem_Statement_CaseStatement ann_ val_ cases_ els_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _elsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _valOenv :: Environment + _casesOenv :: Environment + _elsOenv :: Environment + _valIannotatedTree :: Expression + _valIliftedColumnName :: String + _casesIannotatedTree :: ExpressionListStatementListPairList + _elsIannotatedTree :: StatementList + _elsIproducedEnv :: Environment + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6053 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 352, column 24) + _elsOenvUpdates = + {-# LINE 352 "./TypeChecking.ag" #-} + [] + {-# LINE 6058 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CaseStatement ann_ _valIannotatedTree _casesIannotatedTree _elsIannotatedTree + {-# LINE 6063 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6068 "AstInternal.hs" #-} + -- copy rule (down) + _valOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6073 "AstInternal.hs" #-} + -- copy rule (down) + _casesOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6078 "AstInternal.hs" #-} + -- copy rule (down) + _elsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6083 "AstInternal.hs" #-} + ( _valIannotatedTree,_valIliftedColumnName) = + (val_ _valOenv ) + ( _casesIannotatedTree) = + (cases_ _casesOenv ) + ( _elsIannotatedTree,_elsIproducedEnv) = + (els_ _elsOenv _elsOenvUpdates ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_ContinueStatement :: Annotation -> + T_Statement +sem_Statement_ContinueStatement ann_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6101 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ContinueStatement ann_ + {-# LINE 6106 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6111 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_Copy :: Annotation -> + String -> + T_StringList -> + T_CopySource -> + T_Statement +sem_Statement_Copy ann_ table_ targetCols_ source_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _targetColsOenv :: Environment + _sourceOenv :: Environment + _targetColsIannotatedTree :: StringList + _targetColsIstrings :: ([String]) + _sourceIannotatedTree :: CopySource + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6131 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Copy ann_ table_ _targetColsIannotatedTree _sourceIannotatedTree + {-# LINE 6136 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6141 "AstInternal.hs" #-} + -- copy rule (down) + _targetColsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6146 "AstInternal.hs" #-} + -- copy rule (down) + _sourceOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6151 "AstInternal.hs" #-} + ( _targetColsIannotatedTree,_targetColsIstrings) = + (targetCols_ _targetColsOenv ) + ( _sourceIannotatedTree) = + (source_ _sourceOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_CopyData :: Annotation -> + String -> + T_Statement +sem_Statement_CopyData ann_ insData_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6168 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CopyData ann_ insData_ + {-# LINE 6173 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6178 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_CreateDomain :: Annotation -> + String -> + T_TypeName -> + T_MaybeBoolExpression -> + T_Statement +sem_Statement_CreateDomain ann_ name_ typ_ check_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Statement + _lhsOenvUpdates :: ([EnvironmentUpdate]) + _typOenv :: Environment + _checkOenv :: Environment + _typIannotatedTree :: TypeName + _typInamedType :: Type + _checkIannotatedTree :: MaybeBoolExpression + -- "./TypeChecking.ag"(line 310, column 9) + _lhsOannotatedTree = + {-# LINE 310 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + $ Just (map StatementInfoA _statementInfo ++ + [EnvUpdates _envUpdates ]) + {-# LINE 6202 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 315, column 9) + _lhsOenvUpdates = + {-# LINE 315 "./TypeChecking.ag" #-} + _envUpdates + {-# LINE 6207 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 872, column 9) + _tpe = + {-# LINE 872 "./TypeChecking.ag" #-} + Right $ Pseudo Void + {-# LINE 6212 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 873, column 9) + _backTree = + {-# LINE 873 "./TypeChecking.ag" #-} + CreateDomain ann_ name_ _typIannotatedTree _checkIannotatedTree + {-# LINE 6217 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 874, column 9) + _statementInfo = + {-# LINE 874 "./TypeChecking.ag" #-} + [] + {-# LINE 6222 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 875, column 9) + _envUpdates = + {-# LINE 875 "./TypeChecking.ag" #-} + [EnvCreateDomain (ScalarType name_) _typInamedType] + {-# LINE 6227 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CreateDomain ann_ name_ _typIannotatedTree _checkIannotatedTree + {-# LINE 6232 "AstInternal.hs" #-} + -- copy rule (down) + _typOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6237 "AstInternal.hs" #-} + -- copy rule (down) + _checkOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6242 "AstInternal.hs" #-} + ( _typIannotatedTree,_typInamedType) = + (typ_ _typOenv ) + ( _checkIannotatedTree) = + (check_ _checkOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_CreateFunction :: Annotation -> + T_Language -> + String -> + T_ParamDefList -> + T_TypeName -> + String -> + T_FnBody -> + T_Volatility -> + T_Statement +sem_Statement_CreateFunction ann_ lang_ name_ params_ rettype_ bodyQuote_ body_ vol_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Statement + _lhsOenvUpdates :: ([EnvironmentUpdate]) + _bodyOenv :: Environment + _langOenv :: Environment + _paramsOenv :: Environment + _rettypeOenv :: Environment + _volOenv :: Environment + _langIannotatedTree :: Language + _paramsIannotatedTree :: ParamDefList + _paramsIparams :: ([(String, Type)]) + _rettypeIannotatedTree :: TypeName + _rettypeInamedType :: Type + _bodyIannotatedTree :: FnBody + _volIannotatedTree :: Volatility + -- "./TypeChecking.ag"(line 310, column 9) + _lhsOannotatedTree = + {-# LINE 310 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + $ Just (map StatementInfoA _statementInfo ++ + [EnvUpdates _envUpdates ]) + {-# LINE 6281 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 315, column 9) + _lhsOenvUpdates = + {-# LINE 315 "./TypeChecking.ag" #-} + _envUpdates + {-# LINE 6286 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 925, column 9) + _tpe = + {-# LINE 925 "./TypeChecking.ag" #-} + Right $ Pseudo Void + {-# LINE 6291 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 926, column 9) + _backTree = + {-# LINE 926 "./TypeChecking.ag" #-} + CreateFunction ann_ + _langIannotatedTree + name_ + _paramsIannotatedTree + _rettypeIannotatedTree + bodyQuote_ + _bodyIannotatedTree + _volIannotatedTree + {-# LINE 6303 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 934, column 9) + _statementInfo = + {-# LINE 934 "./TypeChecking.ag" #-} + [] + {-# LINE 6308 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 935, column 9) + _envUpdates = + {-# LINE 935 "./TypeChecking.ag" #-} + [EnvCreateFunction FunName name_ (map snd _paramsIparams) _rettypeInamedType] + {-# LINE 6313 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 937, column 9) + _bodyOenv = + {-# LINE 937 "./TypeChecking.ag" #-} + fromRight _lhsIenv $ + updateEnvironment _lhsIenv [EnvStackIDs [("", _paramsIparams) + ,(name_, _paramsIparams)]] + {-# LINE 6320 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CreateFunction ann_ _langIannotatedTree name_ _paramsIannotatedTree _rettypeIannotatedTree bodyQuote_ _bodyIannotatedTree _volIannotatedTree + {-# LINE 6325 "AstInternal.hs" #-} + -- copy rule (down) + _langOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6330 "AstInternal.hs" #-} + -- copy rule (down) + _paramsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6335 "AstInternal.hs" #-} + -- copy rule (down) + _rettypeOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6340 "AstInternal.hs" #-} + -- copy rule (down) + _volOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6345 "AstInternal.hs" #-} + ( _langIannotatedTree) = + (lang_ _langOenv ) + ( _paramsIannotatedTree,_paramsIparams) = + (params_ _paramsOenv ) + ( _rettypeIannotatedTree,_rettypeInamedType) = + (rettype_ _rettypeOenv ) + ( _bodyIannotatedTree) = + (body_ _bodyOenv ) + ( _volIannotatedTree) = + (vol_ _volOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_CreateTable :: Annotation -> + String -> + T_AttributeDefList -> + T_ConstraintList -> + T_Statement +sem_Statement_CreateTable ann_ name_ atts_ cons_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Statement + _lhsOenvUpdates :: ([EnvironmentUpdate]) + _attsOenv :: Environment + _consOenv :: Environment + _attsIannotatedTree :: AttributeDefList + _attsIattrs :: ([(String, Type)]) + _consIannotatedTree :: ConstraintList + -- "./TypeChecking.ag"(line 310, column 9) + _lhsOannotatedTree = + {-# LINE 310 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + $ Just (map StatementInfoA _statementInfo ++ + [EnvUpdates _envUpdates ]) + {-# LINE 6379 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 315, column 9) + _lhsOenvUpdates = + {-# LINE 315 "./TypeChecking.ag" #-} + _envUpdates + {-# LINE 6384 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 800, column 9) + _attrTypes = + {-# LINE 800 "./TypeChecking.ag" #-} + map snd _attsIattrs + {-# LINE 6389 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 801, column 9) + _tpe = + {-# LINE 801 "./TypeChecking.ag" #-} + Right $ Pseudo Void + {-# LINE 6394 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 802, column 9) + _backTree = + {-# LINE 802 "./TypeChecking.ag" #-} + CreateTable ann_ name_ _attsIannotatedTree _consIannotatedTree + {-# LINE 6399 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 803, column 9) + _statementInfo = + {-# LINE 803 "./TypeChecking.ag" #-} + [] + {-# LINE 6404 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 804, column 9) + _envUpdates = + {-# LINE 804 "./TypeChecking.ag" #-} + [EnvCreateTable name_ _attsIattrs []] + {-# LINE 6409 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CreateTable ann_ name_ _attsIannotatedTree _consIannotatedTree + {-# LINE 6414 "AstInternal.hs" #-} + -- copy rule (down) + _attsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6419 "AstInternal.hs" #-} + -- copy rule (down) + _consOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6424 "AstInternal.hs" #-} + ( _attsIannotatedTree,_attsIattrs) = + (atts_ _attsOenv ) + ( _consIannotatedTree) = + (cons_ _consOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_CreateTableAs :: Annotation -> + String -> + T_SelectExpression -> + T_Statement +sem_Statement_CreateTableAs ann_ name_ expr_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Statement + _lhsOenvUpdates :: ([EnvironmentUpdate]) + _exprOenv :: Environment + _exprIannotatedTree :: SelectExpression + -- "./TypeChecking.ag"(line 808, column 9) + _selType = + {-# LINE 808 "./TypeChecking.ag" #-} + getTypeAnnotation _exprIannotatedTree + {-# LINE 6444 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 809, column 9) + _tpe = + {-# LINE 809 "./TypeChecking.ag" #-} + Right _selType + {-# LINE 6449 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 810, column 9) + _backTree = + {-# LINE 810 "./TypeChecking.ag" #-} + CreateTableAs ann_ name_ _exprIannotatedTree + {-# LINE 6454 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 811, column 9) + _statementInfo = + {-# LINE 811 "./TypeChecking.ag" #-} + [] + {-# LINE 6459 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 812, column 9) + _attrs = + {-# LINE 812 "./TypeChecking.ag" #-} + case _selType of + UnnamedCompositeType c -> c + _-> [] + {-# LINE 6466 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 815, column 9) + _envUpdates = + {-# LINE 815 "./TypeChecking.ag" #-} + [EnvCreateTable name_ _attrs []] + {-# LINE 6471 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CreateTableAs ann_ name_ _exprIannotatedTree + {-# LINE 6476 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6481 "AstInternal.hs" #-} + -- copy rule (from local) + _lhsOenvUpdates = + {-# LINE 317 "./TypeChecking.ag" #-} + _envUpdates + {-# LINE 6486 "AstInternal.hs" #-} + -- copy rule (down) + _exprOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6491 "AstInternal.hs" #-} + ( _exprIannotatedTree) = + (expr_ _exprOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_CreateType :: Annotation -> + String -> + T_TypeAttributeDefList -> + T_Statement +sem_Statement_CreateType ann_ name_ atts_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Statement + _lhsOenvUpdates :: ([EnvironmentUpdate]) + _attsOenv :: Environment + _attsIannotatedTree :: TypeAttributeDefList + _attsIattrs :: ([(String, Type)]) + -- "./TypeChecking.ag"(line 310, column 9) + _lhsOannotatedTree = + {-# LINE 310 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + $ Just (map StatementInfoA _statementInfo ++ + [EnvUpdates _envUpdates ]) + {-# LINE 6514 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 315, column 9) + _lhsOenvUpdates = + {-# LINE 315 "./TypeChecking.ag" #-} + _envUpdates + {-# LINE 6519 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 857, column 9) + _tpe = + {-# LINE 857 "./TypeChecking.ag" #-} + Right $ Pseudo Void + {-# LINE 6524 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 858, column 9) + _backTree = + {-# LINE 858 "./TypeChecking.ag" #-} + CreateType ann_ name_ _attsIannotatedTree + {-# LINE 6529 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 859, column 9) + _statementInfo = + {-# LINE 859 "./TypeChecking.ag" #-} + [] + {-# LINE 6534 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 860, column 9) + _envUpdates = + {-# LINE 860 "./TypeChecking.ag" #-} + [EnvCreateComposite name_ _attsIattrs] + {-# LINE 6539 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CreateType ann_ name_ _attsIannotatedTree + {-# LINE 6544 "AstInternal.hs" #-} + -- copy rule (down) + _attsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6549 "AstInternal.hs" #-} + ( _attsIannotatedTree,_attsIattrs) = + (atts_ _attsOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_CreateView :: Annotation -> + String -> + T_SelectExpression -> + T_Statement +sem_Statement_CreateView ann_ name_ expr_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Statement + _lhsOenvUpdates :: ([EnvironmentUpdate]) + _exprOenv :: Environment + _exprIannotatedTree :: SelectExpression + -- "./TypeChecking.ag"(line 310, column 9) + _lhsOannotatedTree = + {-# LINE 310 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + $ Just (map StatementInfoA _statementInfo ++ + [EnvUpdates _envUpdates ]) + {-# LINE 6571 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 315, column 9) + _lhsOenvUpdates = + {-# LINE 315 "./TypeChecking.ag" #-} + _envUpdates + {-# LINE 6576 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 825, column 9) + _tpe = + {-# LINE 825 "./TypeChecking.ag" #-} + chainTypeCheckFailed [getTypeAnnotation _exprIannotatedTree] $ Right $ Pseudo Void + {-# LINE 6581 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 826, column 9) + _backTree = + {-# LINE 826 "./TypeChecking.ag" #-} + CreateView ann_ name_ _exprIannotatedTree + {-# LINE 6586 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 827, column 9) + _statementInfo = + {-# LINE 827 "./TypeChecking.ag" #-} + [] + {-# LINE 6591 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 828, column 9) + _attrs = + {-# LINE 828 "./TypeChecking.ag" #-} + case getTypeAnnotation _exprIannotatedTree of + SetOfType (UnnamedCompositeType c) -> c + _ -> [] + {-# LINE 6598 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 831, column 9) + _envUpdates = + {-# LINE 831 "./TypeChecking.ag" #-} + [EnvCreateView name_ _attrs ] + {-# LINE 6603 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + CreateView ann_ name_ _exprIannotatedTree + {-# LINE 6608 "AstInternal.hs" #-} + -- copy rule (down) + _exprOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6613 "AstInternal.hs" #-} + ( _exprIannotatedTree) = + (expr_ _exprOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_Delete :: Annotation -> + String -> + T_MaybeBoolExpression -> + (Maybe SelectList) -> + T_Statement +sem_Statement_Delete ann_ table_ whr_ returning_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Statement + _lhsOenvUpdates :: ([EnvironmentUpdate]) + _whrOenv :: Environment + _whrIannotatedTree :: MaybeBoolExpression + -- "./TypeChecking.ag"(line 310, column 9) + _lhsOannotatedTree = + {-# LINE 310 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + $ Just (map StatementInfoA _statementInfo ++ + [EnvUpdates _envUpdates ]) + {-# LINE 6636 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 315, column 9) + _lhsOenvUpdates = + {-# LINE 315 "./TypeChecking.ag" #-} + _envUpdates + {-# LINE 6641 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 765, column 9) + _tpe = + {-# LINE 765 "./TypeChecking.ag" #-} + case checkRelationExists _lhsIenv table_ of + Just e -> Left [e] + Nothing -> Right $ Pseudo Void + {-# LINE 6648 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 769, column 9) + _statementInfo = + {-# LINE 769 "./TypeChecking.ag" #-} + [DeleteInfo table_] + {-# LINE 6653 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 770, column 9) + _backTree = + {-# LINE 770 "./TypeChecking.ag" #-} + Delete ann_ table_ _whrIannotatedTree returning_ + {-# LINE 6658 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 771, column 9) + _envUpdates = + {-# LINE 771 "./TypeChecking.ag" #-} + [] + {-# LINE 6663 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Delete ann_ table_ _whrIannotatedTree returning_ + {-# LINE 6668 "AstInternal.hs" #-} + -- copy rule (down) + _whrOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6673 "AstInternal.hs" #-} + ( _whrIannotatedTree) = + (whr_ _whrOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_DropFunction :: Annotation -> + T_IfExists -> + T_StringStringListPairList -> + T_Cascade -> + T_Statement +sem_Statement_DropFunction ann_ ifE_ sigs_ cascade_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _ifEOenv :: Environment + _sigsOenv :: Environment + _cascadeOenv :: Environment + _ifEIannotatedTree :: IfExists + _sigsIannotatedTree :: StringStringListPairList + _cascadeIannotatedTree :: Cascade + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6696 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + DropFunction ann_ _ifEIannotatedTree _sigsIannotatedTree _cascadeIannotatedTree + {-# LINE 6701 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6706 "AstInternal.hs" #-} + -- copy rule (down) + _ifEOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6711 "AstInternal.hs" #-} + -- copy rule (down) + _sigsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6716 "AstInternal.hs" #-} + -- copy rule (down) + _cascadeOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6721 "AstInternal.hs" #-} + ( _ifEIannotatedTree) = + (ifE_ _ifEOenv ) + ( _sigsIannotatedTree) = + (sigs_ _sigsOenv ) + ( _cascadeIannotatedTree) = + (cascade_ _cascadeOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_DropSomething :: Annotation -> + T_DropType -> + T_IfExists -> + T_StringList -> + T_Cascade -> + T_Statement +sem_Statement_DropSomething ann_ dropType_ ifE_ names_ cascade_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _dropTypeOenv :: Environment + _ifEOenv :: Environment + _namesOenv :: Environment + _cascadeOenv :: Environment + _dropTypeIannotatedTree :: DropType + _ifEIannotatedTree :: IfExists + _namesIannotatedTree :: StringList + _namesIstrings :: ([String]) + _cascadeIannotatedTree :: Cascade + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6752 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + DropSomething ann_ _dropTypeIannotatedTree _ifEIannotatedTree _namesIannotatedTree _cascadeIannotatedTree + {-# LINE 6757 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6762 "AstInternal.hs" #-} + -- copy rule (down) + _dropTypeOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6767 "AstInternal.hs" #-} + -- copy rule (down) + _ifEOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6772 "AstInternal.hs" #-} + -- copy rule (down) + _namesOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6777 "AstInternal.hs" #-} + -- copy rule (down) + _cascadeOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6782 "AstInternal.hs" #-} + ( _dropTypeIannotatedTree) = + (dropType_ _dropTypeOenv ) + ( _ifEIannotatedTree) = + (ifE_ _ifEOenv ) + ( _namesIannotatedTree,_namesIstrings) = + (names_ _namesOenv ) + ( _cascadeIannotatedTree) = + (cascade_ _cascadeOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_Execute :: Annotation -> + T_Expression -> + T_Statement +sem_Statement_Execute ann_ expr_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _exprOenv :: Environment + _exprIannotatedTree :: Expression + _exprIliftedColumnName :: String + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6806 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Execute ann_ _exprIannotatedTree + {-# LINE 6811 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6816 "AstInternal.hs" #-} + -- copy rule (down) + _exprOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6821 "AstInternal.hs" #-} + ( _exprIannotatedTree,_exprIliftedColumnName) = + (expr_ _exprOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_ExecuteInto :: Annotation -> + T_Expression -> + T_StringList -> + T_Statement +sem_Statement_ExecuteInto ann_ expr_ targets_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _exprOenv :: Environment + _targetsOenv :: Environment + _exprIannotatedTree :: Expression + _exprIliftedColumnName :: String + _targetsIannotatedTree :: StringList + _targetsIstrings :: ([String]) + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6843 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ExecuteInto ann_ _exprIannotatedTree _targetsIannotatedTree + {-# LINE 6848 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6853 "AstInternal.hs" #-} + -- copy rule (down) + _exprOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6858 "AstInternal.hs" #-} + -- copy rule (down) + _targetsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6863 "AstInternal.hs" #-} + ( _exprIannotatedTree,_exprIliftedColumnName) = + (expr_ _exprOenv ) + ( _targetsIannotatedTree,_targetsIstrings) = + (targets_ _targetsOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_ForIntegerStatement :: Annotation -> + String -> + T_Expression -> + T_Expression -> + T_StatementList -> + T_Statement +sem_Statement_ForIntegerStatement ann_ var_ from_ to_ sts_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _stsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _fromOenv :: Environment + _toOenv :: Environment + _stsOenv :: Environment + _fromIannotatedTree :: Expression + _fromIliftedColumnName :: String + _toIannotatedTree :: Expression + _toIliftedColumnName :: String + _stsIannotatedTree :: StatementList + _stsIproducedEnv :: Environment + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6893 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 355, column 10) + _stsOenvUpdates = + {-# LINE 355 "./TypeChecking.ag" #-} + [] + {-# LINE 6898 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ForIntegerStatement ann_ var_ _fromIannotatedTree _toIannotatedTree _stsIannotatedTree + {-# LINE 6903 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6908 "AstInternal.hs" #-} + -- copy rule (down) + _fromOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6913 "AstInternal.hs" #-} + -- copy rule (down) + _toOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6918 "AstInternal.hs" #-} + -- copy rule (down) + _stsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6923 "AstInternal.hs" #-} + ( _fromIannotatedTree,_fromIliftedColumnName) = + (from_ _fromOenv ) + ( _toIannotatedTree,_toIliftedColumnName) = + (to_ _toOenv ) + ( _stsIannotatedTree,_stsIproducedEnv) = + (sts_ _stsOenv _stsOenvUpdates ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_ForSelectStatement :: Annotation -> + String -> + T_SelectExpression -> + T_StatementList -> + T_Statement +sem_Statement_ForSelectStatement ann_ var_ sel_ sts_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _stsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _selOenv :: Environment + _stsOenv :: Environment + _selIannotatedTree :: SelectExpression + _stsIannotatedTree :: StatementList + _stsIproducedEnv :: Environment + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6950 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 355, column 10) + _stsOenvUpdates = + {-# LINE 355 "./TypeChecking.ag" #-} + [] + {-# LINE 6955 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ForSelectStatement ann_ var_ _selIannotatedTree _stsIannotatedTree + {-# LINE 6960 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 6965 "AstInternal.hs" #-} + -- copy rule (down) + _selOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6970 "AstInternal.hs" #-} + -- copy rule (down) + _stsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 6975 "AstInternal.hs" #-} + ( _selIannotatedTree) = + (sel_ _selOenv ) + ( _stsIannotatedTree,_stsIproducedEnv) = + (sts_ _stsOenv _stsOenvUpdates ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_If :: Annotation -> + T_ExpressionStatementListPairList -> + T_StatementList -> + T_Statement +sem_Statement_If ann_ cases_ els_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _elsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _casesOenv :: Environment + _elsOenv :: Environment + _casesIannotatedTree :: ExpressionStatementListPairList + _elsIannotatedTree :: StatementList + _elsIproducedEnv :: Environment + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 6999 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 352, column 24) + _elsOenvUpdates = + {-# LINE 352 "./TypeChecking.ag" #-} + [] + {-# LINE 7004 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + If ann_ _casesIannotatedTree _elsIannotatedTree + {-# LINE 7009 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7014 "AstInternal.hs" #-} + -- copy rule (down) + _casesOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7019 "AstInternal.hs" #-} + -- copy rule (down) + _elsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7024 "AstInternal.hs" #-} + ( _casesIannotatedTree) = + (cases_ _casesOenv ) + ( _elsIannotatedTree,_elsIproducedEnv) = + (els_ _elsOenv _elsOenvUpdates ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_Insert :: Annotation -> + String -> + T_StringList -> + T_SelectExpression -> + (Maybe SelectList) -> + T_Statement +sem_Statement_Insert ann_ table_ targetCols_ insData_ returning_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Statement + _lhsOenvUpdates :: ([EnvironmentUpdate]) + _targetColsOenv :: Environment + _insDataOenv :: Environment + _targetColsIannotatedTree :: StringList + _targetColsIstrings :: ([String]) + _insDataIannotatedTree :: SelectExpression + -- "./TypeChecking.ag"(line 310, column 9) + _lhsOannotatedTree = + {-# LINE 310 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + $ Just (map StatementInfoA _statementInfo ++ + [EnvUpdates _envUpdates ]) + {-# LINE 7053 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 315, column 9) + _lhsOenvUpdates = + {-# LINE 315 "./TypeChecking.ag" #-} + _envUpdates + {-# LINE 7058 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 681, column 9) + _columnStuff = + {-# LINE 681 "./TypeChecking.ag" #-} + checkColumnConsistency _lhsIenv + table_ + _targetColsIstrings + (getCAtts $ getTypeAnnotation _insDataIannotatedTree) + {-# LINE 7066 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 686, column 9) + _tpe = + {-# LINE 686 "./TypeChecking.ag" #-} + chainTypeCheckFailed [getTypeAnnotation _insDataIannotatedTree] $ do + _columnStuff + Right $ Pseudo Void + {-# LINE 7073 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 690, column 9) + _statementInfo = + {-# LINE 690 "./TypeChecking.ag" #-} + [InsertInfo table_ $ errorToTypeFailF UnnamedCompositeType _columnStuff ] + {-# LINE 7078 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 692, column 9) + _backTree = + {-# LINE 692 "./TypeChecking.ag" #-} + Insert ann_ table_ _targetColsIannotatedTree + _insDataIannotatedTree returning_ + {-# LINE 7084 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 694, column 9) + _envUpdates = + {-# LINE 694 "./TypeChecking.ag" #-} + [] + {-# LINE 7089 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Insert ann_ table_ _targetColsIannotatedTree _insDataIannotatedTree returning_ + {-# LINE 7094 "AstInternal.hs" #-} + -- copy rule (down) + _targetColsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7099 "AstInternal.hs" #-} + -- copy rule (down) + _insDataOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7104 "AstInternal.hs" #-} + ( _targetColsIannotatedTree,_targetColsIstrings) = + (targetCols_ _targetColsOenv ) + ( _insDataIannotatedTree) = + (insData_ _insDataOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_NullStatement :: Annotation -> + T_Statement +sem_Statement_NullStatement ann_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 7120 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + NullStatement ann_ + {-# LINE 7125 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7130 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_Perform :: Annotation -> + T_Expression -> + T_Statement +sem_Statement_Perform ann_ expr_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _exprOenv :: Environment + _exprIannotatedTree :: Expression + _exprIliftedColumnName :: String + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 7146 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Perform ann_ _exprIannotatedTree + {-# LINE 7151 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7156 "AstInternal.hs" #-} + -- copy rule (down) + _exprOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7161 "AstInternal.hs" #-} + ( _exprIannotatedTree,_exprIliftedColumnName) = + (expr_ _exprOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_Raise :: Annotation -> + T_RaiseType -> + String -> + T_ExpressionList -> + T_Statement +sem_Statement_Raise ann_ level_ message_ args_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _levelOenv :: Environment + _argsOenv :: Environment + _levelIannotatedTree :: RaiseType + _argsIannotatedTree :: ExpressionList + _argsItypeList :: ([Type]) + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 7183 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Raise ann_ _levelIannotatedTree message_ _argsIannotatedTree + {-# LINE 7188 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7193 "AstInternal.hs" #-} + -- copy rule (down) + _levelOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7198 "AstInternal.hs" #-} + -- copy rule (down) + _argsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7203 "AstInternal.hs" #-} + ( _levelIannotatedTree) = + (level_ _levelOenv ) + ( _argsIannotatedTree,_argsItypeList) = + (args_ _argsOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_Return :: Annotation -> + T_MaybeExpression -> + T_Statement +sem_Statement_Return ann_ value_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Statement + _lhsOenvUpdates :: ([EnvironmentUpdate]) + _valueOenv :: Environment + _valueIannotatedTree :: MaybeExpression + _valueIexprType :: (Maybe Type) + -- "./TypeChecking.ag"(line 310, column 9) + _lhsOannotatedTree = + {-# LINE 310 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + $ Just (map StatementInfoA _statementInfo ++ + [EnvUpdates _envUpdates ]) + {-# LINE 7227 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 315, column 9) + _lhsOenvUpdates = + {-# LINE 315 "./TypeChecking.ag" #-} + _envUpdates + {-# LINE 7232 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 989, column 9) + _tpe = + {-# LINE 989 "./TypeChecking.ag" #-} + chainTypeCheckFailed [fromMaybe typeBool _valueIexprType] $ Right $ Pseudo Void + {-# LINE 7237 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 990, column 9) + _backTree = + {-# LINE 990 "./TypeChecking.ag" #-} + Return ann_ _valueIannotatedTree + {-# LINE 7242 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 991, column 9) + _envUpdates = + {-# LINE 991 "./TypeChecking.ag" #-} + [] + {-# LINE 7247 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 992, column 9) + _statementInfo = + {-# LINE 992 "./TypeChecking.ag" #-} + [] + {-# LINE 7252 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Return ann_ _valueIannotatedTree + {-# LINE 7257 "AstInternal.hs" #-} + -- copy rule (down) + _valueOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7262 "AstInternal.hs" #-} + ( _valueIannotatedTree,_valueIexprType) = + (value_ _valueOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_ReturnNext :: Annotation -> + T_Expression -> + T_Statement +sem_Statement_ReturnNext ann_ expr_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _exprOenv :: Environment + _exprIannotatedTree :: Expression + _exprIliftedColumnName :: String + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 7280 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ReturnNext ann_ _exprIannotatedTree + {-# LINE 7285 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7290 "AstInternal.hs" #-} + -- copy rule (down) + _exprOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7295 "AstInternal.hs" #-} + ( _exprIannotatedTree,_exprIliftedColumnName) = + (expr_ _exprOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_ReturnQuery :: Annotation -> + T_SelectExpression -> + T_Statement +sem_Statement_ReturnQuery ann_ sel_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _selOenv :: Environment + _selIannotatedTree :: SelectExpression + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 7312 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ReturnQuery ann_ _selIannotatedTree + {-# LINE 7317 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7322 "AstInternal.hs" #-} + -- copy rule (down) + _selOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7327 "AstInternal.hs" #-} + ( _selIannotatedTree) = + (sel_ _selOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_SelectStatement :: Annotation -> + T_SelectExpression -> + T_Statement +sem_Statement_SelectStatement ann_ ex_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Statement + _lhsOenvUpdates :: ([EnvironmentUpdate]) + _exOenv :: Environment + _exIannotatedTree :: SelectExpression + -- "./TypeChecking.ag"(line 310, column 9) + _lhsOannotatedTree = + {-# LINE 310 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + $ Just (map StatementInfoA _statementInfo ++ + [EnvUpdates _envUpdates ]) + {-# LINE 7348 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 315, column 9) + _lhsOenvUpdates = + {-# LINE 315 "./TypeChecking.ag" #-} + _envUpdates + {-# LINE 7353 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 371, column 9) + _tpe = + {-# LINE 371 "./TypeChecking.ag" #-} + chainTypeCheckFailed [getTypeAnnotation _exIannotatedTree] $ Right $ Pseudo Void + {-# LINE 7358 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 372, column 9) + _statementInfo = + {-# LINE 372 "./TypeChecking.ag" #-} + [SelectInfo $ getTypeAnnotation _exIannotatedTree] + {-# LINE 7363 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 373, column 9) + _backTree = + {-# LINE 373 "./TypeChecking.ag" #-} + SelectStatement ann_ _exIannotatedTree + {-# LINE 7368 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 374, column 9) + _envUpdates = + {-# LINE 374 "./TypeChecking.ag" #-} + [] + {-# LINE 7373 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + SelectStatement ann_ _exIannotatedTree + {-# LINE 7378 "AstInternal.hs" #-} + -- copy rule (down) + _exOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7383 "AstInternal.hs" #-} + ( _exIannotatedTree) = + (ex_ _exOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_Truncate :: Annotation -> + T_StringList -> + T_RestartIdentity -> + T_Cascade -> + T_Statement +sem_Statement_Truncate ann_ tables_ restartIdentity_ cascade_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _tablesOenv :: Environment + _restartIdentityOenv :: Environment + _cascadeOenv :: Environment + _tablesIannotatedTree :: StringList + _tablesIstrings :: ([String]) + _restartIdentityIannotatedTree :: RestartIdentity + _cascadeIannotatedTree :: Cascade + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 7407 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Truncate ann_ _tablesIannotatedTree _restartIdentityIannotatedTree _cascadeIannotatedTree + {-# LINE 7412 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7417 "AstInternal.hs" #-} + -- copy rule (down) + _tablesOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7422 "AstInternal.hs" #-} + -- copy rule (down) + _restartIdentityOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7427 "AstInternal.hs" #-} + -- copy rule (down) + _cascadeOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7432 "AstInternal.hs" #-} + ( _tablesIannotatedTree,_tablesIstrings) = + (tables_ _tablesOenv ) + ( _restartIdentityIannotatedTree) = + (restartIdentity_ _restartIdentityOenv ) + ( _cascadeIannotatedTree) = + (cascade_ _cascadeOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_Update :: Annotation -> + String -> + T_SetClauseList -> + T_MaybeBoolExpression -> + (Maybe SelectList) -> + T_Statement +sem_Statement_Update ann_ table_ assigns_ whr_ returning_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Statement + _lhsOenvUpdates :: ([EnvironmentUpdate]) + _assignsOenv :: Environment + _whrOenv :: Environment + _assignsIannotatedTree :: SetClauseList + _assignsIpairs :: ([(String,Type)]) + _assignsIrowSetErrors :: ([TypeError]) + _whrIannotatedTree :: MaybeBoolExpression + -- "./TypeChecking.ag"(line 310, column 9) + _lhsOannotatedTree = + {-# LINE 310 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + $ Just (map StatementInfoA _statementInfo ++ + [EnvUpdates _envUpdates ]) + {-# LINE 7464 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 315, column 9) + _lhsOenvUpdates = + {-# LINE 315 "./TypeChecking.ag" #-} + _envUpdates + {-# LINE 7469 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 711, column 9) + _tpe = + {-# LINE 711 "./TypeChecking.ag" #-} + do + let re = checkRelationExists _lhsIenv table_ + when (isJust re) $ + Left [fromJust $ re] + chainTypeCheckFailed (map snd _assignsIpairs) $ do + _columnsConsistent + checkErrorList _assignsIrowSetErrors $ Pseudo Void + {-# LINE 7480 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 719, column 9) + _columnsConsistent = + {-# LINE 719 "./TypeChecking.ag" #-} + checkColumnConsistency _lhsIenv table_ (map fst _assignsIpairs) _assignsIpairs + {-# LINE 7485 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 721, column 9) + _statementInfo = + {-# LINE 721 "./TypeChecking.ag" #-} + [UpdateInfo table_ $ errorToTypeFailF UnnamedCompositeType _columnsConsistent ] + {-# LINE 7490 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 723, column 9) + _backTree = + {-# LINE 723 "./TypeChecking.ag" #-} + Update ann_ table_ _assignsIannotatedTree _whrIannotatedTree returning_ + {-# LINE 7495 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 724, column 9) + _envUpdates = + {-# LINE 724 "./TypeChecking.ag" #-} + [] + {-# LINE 7500 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Update ann_ table_ _assignsIannotatedTree _whrIannotatedTree returning_ + {-# LINE 7505 "AstInternal.hs" #-} + -- copy rule (down) + _assignsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7510 "AstInternal.hs" #-} + -- copy rule (down) + _whrOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7515 "AstInternal.hs" #-} + ( _assignsIannotatedTree,_assignsIpairs,_assignsIrowSetErrors) = + (assigns_ _assignsOenv ) + ( _whrIannotatedTree) = + (whr_ _whrOenv ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +sem_Statement_WhileStatement :: Annotation -> + T_Expression -> + T_StatementList -> + T_Statement +sem_Statement_WhileStatement ann_ expr_ sts_ = + (\ _lhsIenv -> + (let _lhsOenvUpdates :: ([EnvironmentUpdate]) + _stsOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: Statement + _exprOenv :: Environment + _stsOenv :: Environment + _exprIannotatedTree :: Expression + _exprIliftedColumnName :: String + _stsIannotatedTree :: StatementList + _stsIproducedEnv :: Environment + -- "./TypeChecking.ag"(line 324, column 9) + _lhsOenvUpdates = + {-# LINE 324 "./TypeChecking.ag" #-} + [] + {-# LINE 7540 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 355, column 10) + _stsOenvUpdates = + {-# LINE 355 "./TypeChecking.ag" #-} + [] + {-# LINE 7545 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + WhileStatement ann_ _exprIannotatedTree _stsIannotatedTree + {-# LINE 7550 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7555 "AstInternal.hs" #-} + -- copy rule (down) + _exprOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7560 "AstInternal.hs" #-} + -- copy rule (down) + _stsOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7565 "AstInternal.hs" #-} + ( _exprIannotatedTree,_exprIliftedColumnName) = + (expr_ _exprOenv ) + ( _stsIannotatedTree,_stsIproducedEnv) = + (sts_ _stsOenv _stsOenvUpdates ) + in ( _lhsOannotatedTree,_lhsOenvUpdates))) +-- StatementList ----------------------------------------------- +{- + visit 0: + inherited attributes: + env : Environment + envUpdates : [EnvironmentUpdate] + synthesized attributes: + annotatedTree : SELF + producedEnv : Environment + alternatives: + alternative Cons: + child hd : Statement + child tl : StatementList + visit 0: + local newEnv : _ + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type StatementList = [(Statement)] +-- cata +sem_StatementList :: StatementList -> + T_StatementList +sem_StatementList list = + (Prelude.foldr sem_StatementList_Cons sem_StatementList_Nil (Prelude.map sem_Statement list) ) +-- semantic domain +type T_StatementList = Environment -> + ([EnvironmentUpdate]) -> + ( StatementList,Environment) +data Inh_StatementList = Inh_StatementList {env_Inh_StatementList :: Environment,envUpdates_Inh_StatementList :: [EnvironmentUpdate]} +data Syn_StatementList = Syn_StatementList {annotatedTree_Syn_StatementList :: StatementList,producedEnv_Syn_StatementList :: Environment} +wrap_StatementList :: T_StatementList -> + Inh_StatementList -> + Syn_StatementList +wrap_StatementList sem (Inh_StatementList _lhsIenv _lhsIenvUpdates ) = + (let ( _lhsOannotatedTree,_lhsOproducedEnv) = + (sem _lhsIenv _lhsIenvUpdates ) + in (Syn_StatementList _lhsOannotatedTree _lhsOproducedEnv )) +sem_StatementList_Cons :: T_Statement -> + T_StatementList -> + T_StatementList +sem_StatementList_Cons hd_ tl_ = + (\ _lhsIenv + _lhsIenvUpdates -> + (let _hdOenv :: Environment + _tlOenv :: Environment + _lhsOproducedEnv :: Environment + _tlOenvUpdates :: ([EnvironmentUpdate]) + _lhsOannotatedTree :: StatementList + _hdIannotatedTree :: Statement + _hdIenvUpdates :: ([EnvironmentUpdate]) + _tlIannotatedTree :: StatementList + _tlIproducedEnv :: Environment + -- "./TypeChecking.ag"(line 334, column 9) + _newEnv = + {-# LINE 334 "./TypeChecking.ag" #-} + fromRight _lhsIenv $ updateEnvironment _lhsIenv _lhsIenvUpdates + {-# LINE 7629 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 335, column 9) + _hdOenv = + {-# LINE 335 "./TypeChecking.ag" #-} + _newEnv + {-# LINE 7634 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 336, column 9) + _tlOenv = + {-# LINE 336 "./TypeChecking.ag" #-} + _newEnv + {-# LINE 7639 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 337, column 9) + _lhsOproducedEnv = + {-# LINE 337 "./TypeChecking.ag" #-} + case _tlIannotatedTree of + [] -> _newEnv + _ -> _tlIproducedEnv + {-# LINE 7646 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 340, column 9) + _tlOenvUpdates = + {-# LINE 340 "./TypeChecking.ag" #-} + _hdIenvUpdates + {-# LINE 7651 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 7656 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7661 "AstInternal.hs" #-} + ( _hdIannotatedTree,_hdIenvUpdates) = + (hd_ _hdOenv ) + ( _tlIannotatedTree,_tlIproducedEnv) = + (tl_ _tlOenv _tlOenvUpdates ) + in ( _lhsOannotatedTree,_lhsOproducedEnv))) +sem_StatementList_Nil :: T_StatementList +sem_StatementList_Nil = + (\ _lhsIenv + _lhsIenvUpdates -> + (let _lhsOproducedEnv :: Environment + _lhsOannotatedTree :: StatementList + -- "./TypeChecking.ag"(line 342, column 9) + _lhsOproducedEnv = + {-# LINE 342 "./TypeChecking.ag" #-} + emptyEnvironment + {-# LINE 7677 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 7682 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7687 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOproducedEnv))) +-- StringList -------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + strings : [String] + alternatives: + alternative Cons: + child hd : {String} + child tl : StringList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type StringList = [(String)] +-- cata +sem_StringList :: StringList -> + T_StringList +sem_StringList list = + (Prelude.foldr sem_StringList_Cons sem_StringList_Nil list ) +-- semantic domain +type T_StringList = Environment -> + ( StringList,([String])) +data Inh_StringList = Inh_StringList {env_Inh_StringList :: Environment} +data Syn_StringList = Syn_StringList {annotatedTree_Syn_StringList :: StringList,strings_Syn_StringList :: [String]} +wrap_StringList :: T_StringList -> + Inh_StringList -> + Syn_StringList +wrap_StringList sem (Inh_StringList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOstrings) = + (sem _lhsIenv ) + in (Syn_StringList _lhsOannotatedTree _lhsOstrings )) +sem_StringList_Cons :: String -> + T_StringList -> + T_StringList +sem_StringList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOstrings :: ([String]) + _lhsOannotatedTree :: StringList + _tlOenv :: Environment + _tlIannotatedTree :: StringList + _tlIstrings :: ([String]) + -- "./TypeChecking.ag"(line 699, column 10) + _lhsOstrings = + {-# LINE 699 "./TypeChecking.ag" #-} + hd_ : _tlIstrings + {-# LINE 7739 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) hd_ _tlIannotatedTree + {-# LINE 7744 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7749 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7754 "AstInternal.hs" #-} + ( _tlIannotatedTree,_tlIstrings) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree,_lhsOstrings))) +sem_StringList_Nil :: T_StringList +sem_StringList_Nil = + (\ _lhsIenv -> + (let _lhsOstrings :: ([String]) + _lhsOannotatedTree :: StringList + -- "./TypeChecking.ag"(line 700, column 9) + _lhsOstrings = + {-# LINE 700 "./TypeChecking.ag" #-} + [] + {-# LINE 7767 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 7772 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7777 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOstrings))) +-- StringStringListPair ---------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Tuple: + child x1 : {String} + child x2 : StringList + visit 0: + local annotatedTree : _ +-} +type StringStringListPair = ( (String),(StringList)) +-- cata +sem_StringStringListPair :: StringStringListPair -> + T_StringStringListPair +sem_StringStringListPair ( x1,x2) = + (sem_StringStringListPair_Tuple x1 (sem_StringList x2 ) ) +-- semantic domain +type T_StringStringListPair = Environment -> + ( StringStringListPair) +data Inh_StringStringListPair = Inh_StringStringListPair {env_Inh_StringStringListPair :: Environment} +data Syn_StringStringListPair = Syn_StringStringListPair {annotatedTree_Syn_StringStringListPair :: StringStringListPair} +wrap_StringStringListPair :: T_StringStringListPair -> + Inh_StringStringListPair -> + Syn_StringStringListPair +wrap_StringStringListPair sem (Inh_StringStringListPair _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_StringStringListPair _lhsOannotatedTree )) +sem_StringStringListPair_Tuple :: String -> + T_StringList -> + T_StringStringListPair +sem_StringStringListPair_Tuple x1_ x2_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: StringStringListPair + _x2Oenv :: Environment + _x2IannotatedTree :: StringList + _x2Istrings :: ([String]) + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (x1_,_x2IannotatedTree) + {-# LINE 7824 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7829 "AstInternal.hs" #-} + -- copy rule (down) + _x2Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7834 "AstInternal.hs" #-} + ( _x2IannotatedTree,_x2Istrings) = + (x2_ _x2Oenv ) + in ( _lhsOannotatedTree))) +-- StringStringListPairList ------------------------------------ +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Cons: + child hd : StringStringListPair + child tl : StringStringListPairList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type StringStringListPairList = [(StringStringListPair)] +-- cata +sem_StringStringListPairList :: StringStringListPairList -> + T_StringStringListPairList +sem_StringStringListPairList list = + (Prelude.foldr sem_StringStringListPairList_Cons sem_StringStringListPairList_Nil (Prelude.map sem_StringStringListPair list) ) +-- semantic domain +type T_StringStringListPairList = Environment -> + ( StringStringListPairList) +data Inh_StringStringListPairList = Inh_StringStringListPairList {env_Inh_StringStringListPairList :: Environment} +data Syn_StringStringListPairList = Syn_StringStringListPairList {annotatedTree_Syn_StringStringListPairList :: StringStringListPairList} +wrap_StringStringListPairList :: T_StringStringListPairList -> + Inh_StringStringListPairList -> + Syn_StringStringListPairList +wrap_StringStringListPairList sem (Inh_StringStringListPairList _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_StringStringListPairList _lhsOannotatedTree )) +sem_StringStringListPairList_Cons :: T_StringStringListPair -> + T_StringStringListPairList -> + T_StringStringListPairList +sem_StringStringListPairList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: StringStringListPairList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: StringStringListPair + _tlIannotatedTree :: StringStringListPairList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 7887 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7892 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7897 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 7902 "AstInternal.hs" #-} + ( _hdIannotatedTree) = + (hd_ _hdOenv ) + ( _tlIannotatedTree) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree))) +sem_StringStringListPairList_Nil :: T_StringStringListPairList +sem_StringStringListPairList_Nil = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: StringStringListPairList + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 7916 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 7921 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +-- TableRef ---------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + idens : [(String,([(String,Type)],[(String,Type)]))] + joinIdens : [String] + alternatives: + alternative JoinedTref: + child ann : {Annotation} + child tbl : TableRef + child nat : Natural + child joinType : JoinType + child tbl1 : TableRef + child onExpr : OnExpr + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative SubTref: + child ann : {Annotation} + child sel : SelectExpression + child alias : {String} + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative Tref: + child ann : {Annotation} + child tbl : {String} + visit 0: + local tpe : _ + local relType : _ + local unwrappedRelType : _ + local backTree : _ + local annotatedTree : _ + alternative TrefAlias: + child ann : {Annotation} + child tbl : {String} + child alias : {String} + visit 0: + local tpe : _ + local relType : _ + local unwrappedRelType : _ + local backTree : _ + local annotatedTree : _ + alternative TrefFun: + child ann : {Annotation} + child fn : Expression + visit 0: + local tpe : _ + local alias1 : _ + local backTree : _ + local annotatedTree : _ + alternative TrefFunAlias: + child ann : {Annotation} + child fn : Expression + child alias : {String} + visit 0: + local tpe : _ + local alias1 : _ + local backTree : _ + local annotatedTree : _ +-} +data TableRef = JoinedTref (Annotation) (TableRef) (Natural) (JoinType) (TableRef) (OnExpr) + | SubTref (Annotation) (SelectExpression) (String) + | Tref (Annotation) (String) + | TrefAlias (Annotation) (String) (String) + | TrefFun (Annotation) (Expression) + | TrefFunAlias (Annotation) (Expression) (String) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_TableRef :: TableRef -> + T_TableRef +sem_TableRef (JoinedTref _ann _tbl _nat _joinType _tbl1 _onExpr ) = + (sem_TableRef_JoinedTref _ann (sem_TableRef _tbl ) (sem_Natural _nat ) (sem_JoinType _joinType ) (sem_TableRef _tbl1 ) (sem_OnExpr _onExpr ) ) +sem_TableRef (SubTref _ann _sel _alias ) = + (sem_TableRef_SubTref _ann (sem_SelectExpression _sel ) _alias ) +sem_TableRef (Tref _ann _tbl ) = + (sem_TableRef_Tref _ann _tbl ) +sem_TableRef (TrefAlias _ann _tbl _alias ) = + (sem_TableRef_TrefAlias _ann _tbl _alias ) +sem_TableRef (TrefFun _ann _fn ) = + (sem_TableRef_TrefFun _ann (sem_Expression _fn ) ) +sem_TableRef (TrefFunAlias _ann _fn _alias ) = + (sem_TableRef_TrefFunAlias _ann (sem_Expression _fn ) _alias ) +-- semantic domain +type T_TableRef = Environment -> + ( TableRef,([(String,([(String,Type)],[(String,Type)]))]),([String])) +data Inh_TableRef = Inh_TableRef {env_Inh_TableRef :: Environment} +data Syn_TableRef = Syn_TableRef {annotatedTree_Syn_TableRef :: TableRef,idens_Syn_TableRef :: [(String,([(String,Type)],[(String,Type)]))],joinIdens_Syn_TableRef :: [String]} +wrap_TableRef :: T_TableRef -> + Inh_TableRef -> + Syn_TableRef +wrap_TableRef sem (Inh_TableRef _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens) = + (sem _lhsIenv ) + in (Syn_TableRef _lhsOannotatedTree _lhsOidens _lhsOjoinIdens )) +sem_TableRef_JoinedTref :: Annotation -> + T_TableRef -> + T_Natural -> + T_JoinType -> + T_TableRef -> + T_OnExpr -> + T_TableRef +sem_TableRef_JoinedTref ann_ tbl_ nat_ joinType_ tbl1_ onExpr_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: TableRef + _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) + _lhsOjoinIdens :: ([String]) + _tblOenv :: Environment + _natOenv :: Environment + _joinTypeOenv :: Environment + _tbl1Oenv :: Environment + _onExprOenv :: Environment + _tblIannotatedTree :: TableRef + _tblIidens :: ([(String,([(String,Type)],[(String,Type)]))]) + _tblIjoinIdens :: ([String]) + _natIannotatedTree :: Natural + _joinTypeIannotatedTree :: JoinType + _tbl1IannotatedTree :: TableRef + _tbl1Iidens :: ([(String,([(String,Type)],[(String,Type)]))]) + _tbl1IjoinIdens :: ([String]) + _onExprIannotatedTree :: OnExpr + -- "./TypeChecking.ag"(line 433, column 9) + _lhsOannotatedTree = + {-# LINE 433 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 8056 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 476, column 9) + _tpe = + {-# LINE 476 "./TypeChecking.ag" #-} + chainTypeCheckFailed [tblt + ,tbl1t] $ + case (_natIannotatedTree, _onExprIannotatedTree) of + (Natural, _) -> unionJoinList $ + commonFieldNames tblt tbl1t + (_,Just (JoinUsing _ s)) -> unionJoinList s + _ -> unionJoinList [] + where + tblt = getTypeAnnotation _tblIannotatedTree + tbl1t = getTypeAnnotation _tbl1IannotatedTree + unionJoinList s = + combineTableTypesWithUsingList _lhsIenv s tblt tbl1t + {-# LINE 8072 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 489, column 9) + _lhsOidens = + {-# LINE 489 "./TypeChecking.ag" #-} + _tblIidens ++ _tbl1Iidens + {-# LINE 8077 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 490, column 9) + _lhsOjoinIdens = + {-# LINE 490 "./TypeChecking.ag" #-} + commonFieldNames (getTypeAnnotation _tblIannotatedTree) + (getTypeAnnotation _tbl1IannotatedTree) + {-# LINE 8083 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 492, column 9) + _backTree = + {-# LINE 492 "./TypeChecking.ag" #-} + JoinedTref ann_ + _tblIannotatedTree + _natIannotatedTree + _joinTypeIannotatedTree + _tbl1IannotatedTree + _onExprIannotatedTree + {-# LINE 8093 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + JoinedTref ann_ _tblIannotatedTree _natIannotatedTree _joinTypeIannotatedTree _tbl1IannotatedTree _onExprIannotatedTree + {-# LINE 8098 "AstInternal.hs" #-} + -- copy rule (down) + _tblOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8103 "AstInternal.hs" #-} + -- copy rule (down) + _natOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8108 "AstInternal.hs" #-} + -- copy rule (down) + _joinTypeOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8113 "AstInternal.hs" #-} + -- copy rule (down) + _tbl1Oenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8118 "AstInternal.hs" #-} + -- copy rule (down) + _onExprOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8123 "AstInternal.hs" #-} + ( _tblIannotatedTree,_tblIidens,_tblIjoinIdens) = + (tbl_ _tblOenv ) + ( _natIannotatedTree) = + (nat_ _natOenv ) + ( _joinTypeIannotatedTree) = + (joinType_ _joinTypeOenv ) + ( _tbl1IannotatedTree,_tbl1Iidens,_tbl1IjoinIdens) = + (tbl1_ _tbl1Oenv ) + ( _onExprIannotatedTree) = + (onExpr_ _onExprOenv ) + in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) +sem_TableRef_SubTref :: Annotation -> + T_SelectExpression -> + String -> + T_TableRef +sem_TableRef_SubTref ann_ sel_ alias_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: TableRef + _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) + _lhsOjoinIdens :: ([String]) + _selOenv :: Environment + _selIannotatedTree :: SelectExpression + -- "./TypeChecking.ag"(line 433, column 9) + _lhsOannotatedTree = + {-# LINE 433 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 8153 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 440, column 15) + _tpe = + {-# LINE 440 "./TypeChecking.ag" #-} + chainTypeCheckFailed [getTypeAnnotation _selIannotatedTree] <$> + unwrapSetOfWhenComposite $ getTypeAnnotation _selIannotatedTree + {-# LINE 8159 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 442, column 15) + _backTree = + {-# LINE 442 "./TypeChecking.ag" #-} + SubTref ann_ _selIannotatedTree alias_ + {-# LINE 8164 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 443, column 15) + _lhsOidens = + {-# LINE 443 "./TypeChecking.ag" #-} + [(alias_, (fromRight [] $ getTbCols _selIannotatedTree, []))] + {-# LINE 8169 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 444, column 15) + _lhsOjoinIdens = + {-# LINE 444 "./TypeChecking.ag" #-} + [] + {-# LINE 8174 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + SubTref ann_ _selIannotatedTree alias_ + {-# LINE 8179 "AstInternal.hs" #-} + -- copy rule (down) + _selOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8184 "AstInternal.hs" #-} + ( _selIannotatedTree) = + (sel_ _selOenv ) + in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) +sem_TableRef_Tref :: Annotation -> + String -> + T_TableRef +sem_TableRef_Tref ann_ tbl_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: TableRef + _lhsOjoinIdens :: ([String]) + _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) + -- "./TypeChecking.ag"(line 433, column 9) + _lhsOannotatedTree = + {-# LINE 433 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 8203 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 446, column 9) + _tpe = + {-# LINE 446 "./TypeChecking.ag" #-} + either Left (Right . fst) _relType + {-# LINE 8208 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 447, column 9) + _lhsOjoinIdens = + {-# LINE 447 "./TypeChecking.ag" #-} + [] + {-# LINE 8213 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 448, column 9) + _relType = + {-# LINE 448 "./TypeChecking.ag" #-} + getRelationType _lhsIenv tbl_ + {-# LINE 8218 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 449, column 9) + _unwrappedRelType = + {-# LINE 449 "./TypeChecking.ag" #-} + fromRight ([],[]) $ + do + lrt <- _relType + let (UnnamedCompositeType a,UnnamedCompositeType b) = lrt + return (a,b) + {-# LINE 8227 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 456, column 9) + _lhsOidens = + {-# LINE 456 "./TypeChecking.ag" #-} + [(tbl_, _unwrappedRelType )] + {-# LINE 8232 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 457, column 9) + _backTree = + {-# LINE 457 "./TypeChecking.ag" #-} + Tref ann_ tbl_ + {-# LINE 8237 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Tref ann_ tbl_ + {-# LINE 8242 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) +sem_TableRef_TrefAlias :: Annotation -> + String -> + String -> + T_TableRef +sem_TableRef_TrefAlias ann_ tbl_ alias_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: TableRef + _lhsOjoinIdens :: ([String]) + _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) + -- "./TypeChecking.ag"(line 433, column 9) + _lhsOannotatedTree = + {-# LINE 433 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 8260 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 446, column 9) + _tpe = + {-# LINE 446 "./TypeChecking.ag" #-} + either Left (Right . fst) _relType + {-# LINE 8265 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 447, column 9) + _lhsOjoinIdens = + {-# LINE 447 "./TypeChecking.ag" #-} + [] + {-# LINE 8270 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 448, column 9) + _relType = + {-# LINE 448 "./TypeChecking.ag" #-} + getRelationType _lhsIenv tbl_ + {-# LINE 8275 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 449, column 9) + _unwrappedRelType = + {-# LINE 449 "./TypeChecking.ag" #-} + fromRight ([],[]) $ + do + lrt <- _relType + let (UnnamedCompositeType a,UnnamedCompositeType b) = lrt + return (a,b) + {-# LINE 8284 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 459, column 9) + _lhsOidens = + {-# LINE 459 "./TypeChecking.ag" #-} + [(alias_, _unwrappedRelType )] + {-# LINE 8289 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 460, column 9) + _backTree = + {-# LINE 460 "./TypeChecking.ag" #-} + TrefAlias ann_ tbl_ alias_ + {-# LINE 8294 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + TrefAlias ann_ tbl_ alias_ + {-# LINE 8299 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) +sem_TableRef_TrefFun :: Annotation -> + T_Expression -> + T_TableRef +sem_TableRef_TrefFun ann_ fn_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: TableRef + _lhsOjoinIdens :: ([String]) + _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) + _fnOenv :: Environment + _fnIannotatedTree :: Expression + _fnIliftedColumnName :: String + -- "./TypeChecking.ag"(line 433, column 9) + _lhsOannotatedTree = + {-# LINE 433 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 8319 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 462, column 9) + _tpe = + {-# LINE 462 "./TypeChecking.ag" #-} + getFnType _lhsIenv _alias1 _fnIannotatedTree + {-# LINE 8324 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 463, column 9) + _lhsOjoinIdens = + {-# LINE 463 "./TypeChecking.ag" #-} + [] + {-# LINE 8329 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 464, column 9) + _lhsOidens = + {-# LINE 464 "./TypeChecking.ag" #-} + case getFunIdens + _lhsIenv _alias1 + _fnIannotatedTree of + Right (s, UnnamedCompositeType c) -> [(s,(c,[]))] + _ -> [] + {-# LINE 8338 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 470, column 9) + _alias1 = + {-# LINE 470 "./TypeChecking.ag" #-} + "" + {-# LINE 8343 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 471, column 9) + _backTree = + {-# LINE 471 "./TypeChecking.ag" #-} + TrefFun ann_ _fnIannotatedTree + {-# LINE 8348 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + TrefFun ann_ _fnIannotatedTree + {-# LINE 8353 "AstInternal.hs" #-} + -- copy rule (down) + _fnOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8358 "AstInternal.hs" #-} + ( _fnIannotatedTree,_fnIliftedColumnName) = + (fn_ _fnOenv ) + in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) +sem_TableRef_TrefFunAlias :: Annotation -> + T_Expression -> + String -> + T_TableRef +sem_TableRef_TrefFunAlias ann_ fn_ alias_ = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: TableRef + _lhsOjoinIdens :: ([String]) + _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) + _fnOenv :: Environment + _fnIannotatedTree :: Expression + _fnIliftedColumnName :: String + -- "./TypeChecking.ag"(line 433, column 9) + _lhsOannotatedTree = + {-# LINE 433 "./TypeChecking.ag" #-} + annTypesAndErrors _backTree + (errorToTypeFail _tpe ) + (getErrors _tpe ) + Nothing + {-# LINE 8381 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 462, column 9) + _tpe = + {-# LINE 462 "./TypeChecking.ag" #-} + getFnType _lhsIenv _alias1 _fnIannotatedTree + {-# LINE 8386 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 463, column 9) + _lhsOjoinIdens = + {-# LINE 463 "./TypeChecking.ag" #-} + [] + {-# LINE 8391 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 464, column 9) + _lhsOidens = + {-# LINE 464 "./TypeChecking.ag" #-} + case getFunIdens + _lhsIenv _alias1 + _fnIannotatedTree of + Right (s, UnnamedCompositeType c) -> [(s,(c,[]))] + _ -> [] + {-# LINE 8400 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 473, column 9) + _alias1 = + {-# LINE 473 "./TypeChecking.ag" #-} + alias_ + {-# LINE 8405 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 474, column 9) + _backTree = + {-# LINE 474 "./TypeChecking.ag" #-} + TrefFunAlias ann_ _fnIannotatedTree alias_ + {-# LINE 8410 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + TrefFunAlias ann_ _fnIannotatedTree alias_ + {-# LINE 8415 "AstInternal.hs" #-} + -- copy rule (down) + _fnOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8420 "AstInternal.hs" #-} + ( _fnIannotatedTree,_fnIliftedColumnName) = + (fn_ _fnOenv ) + in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) +-- TableRefList ------------------------------------------------ +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + idens : [(String,([(String,Type)],[(String,Type)]))] + joinIdens : [String] + alternatives: + alternative Cons: + child hd : TableRef + child tl : TableRefList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type TableRefList = [(TableRef)] +-- cata +sem_TableRefList :: TableRefList -> + T_TableRefList +sem_TableRefList list = + (Prelude.foldr sem_TableRefList_Cons sem_TableRefList_Nil (Prelude.map sem_TableRef list) ) +-- semantic domain +type T_TableRefList = Environment -> + ( TableRefList,([(String,([(String,Type)],[(String,Type)]))]),([String])) +data Inh_TableRefList = Inh_TableRefList {env_Inh_TableRefList :: Environment} +data Syn_TableRefList = Syn_TableRefList {annotatedTree_Syn_TableRefList :: TableRefList,idens_Syn_TableRefList :: [(String,([(String,Type)],[(String,Type)]))],joinIdens_Syn_TableRefList :: [String]} +wrap_TableRefList :: T_TableRefList -> + Inh_TableRefList -> + Syn_TableRefList +wrap_TableRefList sem (Inh_TableRefList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens) = + (sem _lhsIenv ) + in (Syn_TableRefList _lhsOannotatedTree _lhsOidens _lhsOjoinIdens )) +sem_TableRefList_Cons :: T_TableRef -> + T_TableRefList -> + T_TableRefList +sem_TableRefList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) + _lhsOjoinIdens :: ([String]) + _lhsOannotatedTree :: TableRefList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: TableRef + _hdIidens :: ([(String,([(String,Type)],[(String,Type)]))]) + _hdIjoinIdens :: ([String]) + _tlIannotatedTree :: TableRefList + _tlIidens :: ([(String,([(String,Type)],[(String,Type)]))]) + _tlIjoinIdens :: ([String]) + -- "./TypeChecking.ag"(line 527, column 12) + _lhsOidens = + {-# LINE 527 "./TypeChecking.ag" #-} + _hdIidens + {-# LINE 8481 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 528, column 12) + _lhsOjoinIdens = + {-# LINE 528 "./TypeChecking.ag" #-} + _hdIjoinIdens + {-# LINE 8486 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 8491 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 8496 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8501 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8506 "AstInternal.hs" #-} + ( _hdIannotatedTree,_hdIidens,_hdIjoinIdens) = + (hd_ _hdOenv ) + ( _tlIannotatedTree,_tlIidens,_tlIjoinIdens) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) +sem_TableRefList_Nil :: T_TableRefList +sem_TableRefList_Nil = + (\ _lhsIenv -> + (let _lhsOidens :: ([(String,([(String,Type)],[(String,Type)]))]) + _lhsOjoinIdens :: ([String]) + _lhsOannotatedTree :: TableRefList + -- "./TypeChecking.ag"(line 530, column 9) + _lhsOidens = + {-# LINE 530 "./TypeChecking.ag" #-} + [] + {-# LINE 8522 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 531, column 9) + _lhsOjoinIdens = + {-# LINE 531 "./TypeChecking.ag" #-} + [] + {-# LINE 8527 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 8532 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 8537 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOidens,_lhsOjoinIdens))) +-- TypeAttributeDef -------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + attrName : String + namedType : Type + alternatives: + alternative TypeAttDef: + child ann : {Annotation} + child name : {String} + child typ : TypeName + visit 0: + local annotatedTree : _ +-} +data TypeAttributeDef = TypeAttDef (Annotation) (String) (TypeName) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_TypeAttributeDef :: TypeAttributeDef -> + T_TypeAttributeDef +sem_TypeAttributeDef (TypeAttDef _ann _name _typ ) = + (sem_TypeAttributeDef_TypeAttDef _ann _name (sem_TypeName _typ ) ) +-- semantic domain +type T_TypeAttributeDef = Environment -> + ( TypeAttributeDef,String,Type) +data Inh_TypeAttributeDef = Inh_TypeAttributeDef {env_Inh_TypeAttributeDef :: Environment} +data Syn_TypeAttributeDef = Syn_TypeAttributeDef {annotatedTree_Syn_TypeAttributeDef :: TypeAttributeDef,attrName_Syn_TypeAttributeDef :: String,namedType_Syn_TypeAttributeDef :: Type} +wrap_TypeAttributeDef :: T_TypeAttributeDef -> + Inh_TypeAttributeDef -> + Syn_TypeAttributeDef +wrap_TypeAttributeDef sem (Inh_TypeAttributeDef _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOattrName,_lhsOnamedType) = + (sem _lhsIenv ) + in (Syn_TypeAttributeDef _lhsOannotatedTree _lhsOattrName _lhsOnamedType )) +sem_TypeAttributeDef_TypeAttDef :: Annotation -> + String -> + T_TypeName -> + T_TypeAttributeDef +sem_TypeAttributeDef_TypeAttDef ann_ name_ typ_ = + (\ _lhsIenv -> + (let _lhsOattrName :: String + _lhsOnamedType :: Type + _lhsOannotatedTree :: TypeAttributeDef + _typOenv :: Environment + _typIannotatedTree :: TypeName + _typInamedType :: Type + -- "./TypeChecking.ag"(line 846, column 9) + _lhsOattrName = + {-# LINE 846 "./TypeChecking.ag" #-} + name_ + {-# LINE 8591 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 847, column 9) + _lhsOnamedType = + {-# LINE 847 "./TypeChecking.ag" #-} + _typInamedType + {-# LINE 8596 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + TypeAttDef ann_ name_ _typIannotatedTree + {-# LINE 8601 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 8606 "AstInternal.hs" #-} + -- copy rule (down) + _typOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8611 "AstInternal.hs" #-} + ( _typIannotatedTree,_typInamedType) = + (typ_ _typOenv ) + in ( _lhsOannotatedTree,_lhsOattrName,_lhsOnamedType))) +-- TypeAttributeDefList ---------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + attrs : [(String, Type)] + alternatives: + alternative Cons: + child hd : TypeAttributeDef + child tl : TypeAttributeDefList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type TypeAttributeDefList = [(TypeAttributeDef)] +-- cata +sem_TypeAttributeDefList :: TypeAttributeDefList -> + T_TypeAttributeDefList +sem_TypeAttributeDefList list = + (Prelude.foldr sem_TypeAttributeDefList_Cons sem_TypeAttributeDefList_Nil (Prelude.map sem_TypeAttributeDef list) ) +-- semantic domain +type T_TypeAttributeDefList = Environment -> + ( TypeAttributeDefList,([(String, Type)])) +data Inh_TypeAttributeDefList = Inh_TypeAttributeDefList {env_Inh_TypeAttributeDefList :: Environment} +data Syn_TypeAttributeDefList = Syn_TypeAttributeDefList {annotatedTree_Syn_TypeAttributeDefList :: TypeAttributeDefList,attrs_Syn_TypeAttributeDefList :: [(String, Type)]} +wrap_TypeAttributeDefList :: T_TypeAttributeDefList -> + Inh_TypeAttributeDefList -> + Syn_TypeAttributeDefList +wrap_TypeAttributeDefList sem (Inh_TypeAttributeDefList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOattrs) = + (sem _lhsIenv ) + in (Syn_TypeAttributeDefList _lhsOannotatedTree _lhsOattrs )) +sem_TypeAttributeDefList_Cons :: T_TypeAttributeDef -> + T_TypeAttributeDefList -> + T_TypeAttributeDefList +sem_TypeAttributeDefList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOattrs :: ([(String, Type)]) + _lhsOannotatedTree :: TypeAttributeDefList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: TypeAttributeDef + _hdIattrName :: String + _hdInamedType :: Type + _tlIannotatedTree :: TypeAttributeDefList + _tlIattrs :: ([(String, Type)]) + -- "./TypeChecking.ag"(line 852, column 12) + _lhsOattrs = + {-# LINE 852 "./TypeChecking.ag" #-} + (_hdIattrName, _hdInamedType) : _tlIattrs + {-# LINE 8669 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 8674 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 8679 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8684 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8689 "AstInternal.hs" #-} + ( _hdIannotatedTree,_hdIattrName,_hdInamedType) = + (hd_ _hdOenv ) + ( _tlIannotatedTree,_tlIattrs) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree,_lhsOattrs))) +sem_TypeAttributeDefList_Nil :: T_TypeAttributeDefList +sem_TypeAttributeDefList_Nil = + (\ _lhsIenv -> + (let _lhsOattrs :: ([(String, Type)]) + _lhsOannotatedTree :: TypeAttributeDefList + -- "./TypeChecking.ag"(line 853, column 11) + _lhsOattrs = + {-# LINE 853 "./TypeChecking.ag" #-} + [] + {-# LINE 8704 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 8709 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 8714 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOattrs))) +-- TypeName ---------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + namedType : Type + alternatives: + alternative ArrayTypeName: + child ann : {Annotation} + child typ : TypeName + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative PrecTypeName: + child ann : {Annotation} + child tn : {String} + child prec : {Integer} + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative SetOfTypeName: + child ann : {Annotation} + child typ : TypeName + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ + alternative SimpleTypeName: + child ann : {Annotation} + child tn : {String} + visit 0: + local tpe : _ + local backTree : _ + local annotatedTree : _ +-} +data TypeName = ArrayTypeName (Annotation) (TypeName) + | PrecTypeName (Annotation) (String) (Integer) + | SetOfTypeName (Annotation) (TypeName) + | SimpleTypeName (Annotation) (String) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_TypeName :: TypeName -> + T_TypeName +sem_TypeName (ArrayTypeName _ann _typ ) = + (sem_TypeName_ArrayTypeName _ann (sem_TypeName _typ ) ) +sem_TypeName (PrecTypeName _ann _tn _prec ) = + (sem_TypeName_PrecTypeName _ann _tn _prec ) +sem_TypeName (SetOfTypeName _ann _typ ) = + (sem_TypeName_SetOfTypeName _ann (sem_TypeName _typ ) ) +sem_TypeName (SimpleTypeName _ann _tn ) = + (sem_TypeName_SimpleTypeName _ann _tn ) +-- semantic domain +type T_TypeName = Environment -> + ( TypeName,Type) +data Inh_TypeName = Inh_TypeName {env_Inh_TypeName :: Environment} +data Syn_TypeName = Syn_TypeName {annotatedTree_Syn_TypeName :: TypeName,namedType_Syn_TypeName :: Type} +wrap_TypeName :: T_TypeName -> + Inh_TypeName -> + Syn_TypeName +wrap_TypeName sem (Inh_TypeName _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOnamedType) = + (sem _lhsIenv ) + in (Syn_TypeName _lhsOannotatedTree _lhsOnamedType )) +sem_TypeName_ArrayTypeName :: Annotation -> + T_TypeName -> + T_TypeName +sem_TypeName_ArrayTypeName ann_ typ_ = + (\ _lhsIenv -> + (let _lhsOnamedType :: Type + _lhsOannotatedTree :: TypeName + _typOenv :: Environment + _typIannotatedTree :: TypeName + _typInamedType :: Type + -- "./TypeChecking.ag"(line 136, column 10) + _lhsOnamedType = + {-# LINE 136 "./TypeChecking.ag" #-} + errorToTypeFail _tpe + {-# LINE 8797 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 137, column 10) + _lhsOannotatedTree = + {-# LINE 137 "./TypeChecking.ag" #-} + updateAnnotation + ((map TypeErrorA $ getErrors _tpe ) ++) + _backTree + {-# LINE 8804 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 147, column 9) + _tpe = + {-# LINE 147 "./TypeChecking.ag" #-} + chainTypeCheckFailed [_typInamedType] $ Right $ ArrayType _typInamedType + {-# LINE 8809 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 148, column 9) + _backTree = + {-# LINE 148 "./TypeChecking.ag" #-} + ArrayTypeName ann_ _typIannotatedTree + {-# LINE 8814 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + ArrayTypeName ann_ _typIannotatedTree + {-# LINE 8819 "AstInternal.hs" #-} + -- copy rule (down) + _typOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8824 "AstInternal.hs" #-} + ( _typIannotatedTree,_typInamedType) = + (typ_ _typOenv ) + in ( _lhsOannotatedTree,_lhsOnamedType))) +sem_TypeName_PrecTypeName :: Annotation -> + String -> + Integer -> + T_TypeName +sem_TypeName_PrecTypeName ann_ tn_ prec_ = + (\ _lhsIenv -> + (let _lhsOnamedType :: Type + _lhsOannotatedTree :: TypeName + -- "./TypeChecking.ag"(line 136, column 10) + _lhsOnamedType = + {-# LINE 136 "./TypeChecking.ag" #-} + errorToTypeFail _tpe + {-# LINE 8840 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 137, column 10) + _lhsOannotatedTree = + {-# LINE 137 "./TypeChecking.ag" #-} + updateAnnotation + ((map TypeErrorA $ getErrors _tpe ) ++) + _backTree + {-# LINE 8847 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 153, column 9) + _tpe = + {-# LINE 153 "./TypeChecking.ag" #-} + Right TypeCheckFailed + {-# LINE 8852 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 154, column 9) + _backTree = + {-# LINE 154 "./TypeChecking.ag" #-} + PrecTypeName ann_ tn_ prec_ + {-# LINE 8857 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + PrecTypeName ann_ tn_ prec_ + {-# LINE 8862 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOnamedType))) +sem_TypeName_SetOfTypeName :: Annotation -> + T_TypeName -> + T_TypeName +sem_TypeName_SetOfTypeName ann_ typ_ = + (\ _lhsIenv -> + (let _lhsOnamedType :: Type + _lhsOannotatedTree :: TypeName + _typOenv :: Environment + _typIannotatedTree :: TypeName + _typInamedType :: Type + -- "./TypeChecking.ag"(line 136, column 10) + _lhsOnamedType = + {-# LINE 136 "./TypeChecking.ag" #-} + errorToTypeFail _tpe + {-# LINE 8878 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 137, column 10) + _lhsOannotatedTree = + {-# LINE 137 "./TypeChecking.ag" #-} + updateAnnotation + ((map TypeErrorA $ getErrors _tpe ) ++) + _backTree + {-# LINE 8885 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 150, column 9) + _tpe = + {-# LINE 150 "./TypeChecking.ag" #-} + chainTypeCheckFailed [_typInamedType] $ Right $ SetOfType _typInamedType + {-# LINE 8890 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 151, column 9) + _backTree = + {-# LINE 151 "./TypeChecking.ag" #-} + SetOfTypeName ann_ _typIannotatedTree + {-# LINE 8895 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + SetOfTypeName ann_ _typIannotatedTree + {-# LINE 8900 "AstInternal.hs" #-} + -- copy rule (down) + _typOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 8905 "AstInternal.hs" #-} + ( _typIannotatedTree,_typInamedType) = + (typ_ _typOenv ) + in ( _lhsOannotatedTree,_lhsOnamedType))) +sem_TypeName_SimpleTypeName :: Annotation -> + String -> + T_TypeName +sem_TypeName_SimpleTypeName ann_ tn_ = + (\ _lhsIenv -> + (let _lhsOnamedType :: Type + _lhsOannotatedTree :: TypeName + -- "./TypeChecking.ag"(line 136, column 10) + _lhsOnamedType = + {-# LINE 136 "./TypeChecking.ag" #-} + errorToTypeFail _tpe + {-# LINE 8920 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 137, column 10) + _lhsOannotatedTree = + {-# LINE 137 "./TypeChecking.ag" #-} + updateAnnotation + ((map TypeErrorA $ getErrors _tpe ) ++) + _backTree + {-# LINE 8927 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 144, column 9) + _tpe = + {-# LINE 144 "./TypeChecking.ag" #-} + envLookupType _lhsIenv $ canonicalizeTypeName tn_ + {-# LINE 8932 "AstInternal.hs" #-} + -- "./TypeChecking.ag"(line 145, column 9) + _backTree = + {-# LINE 145 "./TypeChecking.ag" #-} + SimpleTypeName ann_ tn_ + {-# LINE 8937 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + SimpleTypeName ann_ tn_ + {-# LINE 8942 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOnamedType))) +-- VarDef ------------------------------------------------------ +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + def : (String,Type) + alternatives: + alternative VarDef: + child ann : {Annotation} + child name : {String} + child typ : TypeName + child value : {Maybe Expression} + visit 0: + local annotatedTree : _ +-} +data VarDef = VarDef (Annotation) (String) (TypeName) (Maybe Expression) + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_VarDef :: VarDef -> + T_VarDef +sem_VarDef (VarDef _ann _name _typ _value ) = + (sem_VarDef_VarDef _ann _name (sem_TypeName _typ ) _value ) +-- semantic domain +type T_VarDef = Environment -> + ( VarDef,((String,Type))) +data Inh_VarDef = Inh_VarDef {env_Inh_VarDef :: Environment} +data Syn_VarDef = Syn_VarDef {annotatedTree_Syn_VarDef :: VarDef,def_Syn_VarDef :: (String,Type)} +wrap_VarDef :: T_VarDef -> + Inh_VarDef -> + Syn_VarDef +wrap_VarDef sem (Inh_VarDef _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOdef) = + (sem _lhsIenv ) + in (Syn_VarDef _lhsOannotatedTree _lhsOdef )) +sem_VarDef_VarDef :: Annotation -> + String -> + T_TypeName -> + (Maybe Expression) -> + T_VarDef +sem_VarDef_VarDef ann_ name_ typ_ value_ = + (\ _lhsIenv -> + (let _lhsOdef :: ((String,Type)) + _lhsOannotatedTree :: VarDef + _typOenv :: Environment + _typIannotatedTree :: TypeName + _typInamedType :: Type + -- "./TypeChecking.ag"(line 950, column 14) + _lhsOdef = + {-# LINE 950 "./TypeChecking.ag" #-} + (name_, _typInamedType) + {-# LINE 8996 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + VarDef ann_ name_ _typIannotatedTree value_ + {-# LINE 9001 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 9006 "AstInternal.hs" #-} + -- copy rule (down) + _typOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 9011 "AstInternal.hs" #-} + ( _typIannotatedTree,_typInamedType) = + (typ_ _typOenv ) + in ( _lhsOannotatedTree,_lhsOdef))) +-- VarDefList -------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attributes: + annotatedTree : SELF + defs : [(String,Type)] + alternatives: + alternative Cons: + child hd : VarDef + child tl : VarDefList + visit 0: + local annotatedTree : _ + alternative Nil: + visit 0: + local annotatedTree : _ +-} +type VarDefList = [(VarDef)] +-- cata +sem_VarDefList :: VarDefList -> + T_VarDefList +sem_VarDefList list = + (Prelude.foldr sem_VarDefList_Cons sem_VarDefList_Nil (Prelude.map sem_VarDef list) ) +-- semantic domain +type T_VarDefList = Environment -> + ( VarDefList,([(String,Type)])) +data Inh_VarDefList = Inh_VarDefList {env_Inh_VarDefList :: Environment} +data Syn_VarDefList = Syn_VarDefList {annotatedTree_Syn_VarDefList :: VarDefList,defs_Syn_VarDefList :: [(String,Type)]} +wrap_VarDefList :: T_VarDefList -> + Inh_VarDefList -> + Syn_VarDefList +wrap_VarDefList sem (Inh_VarDefList _lhsIenv ) = + (let ( _lhsOannotatedTree,_lhsOdefs) = + (sem _lhsIenv ) + in (Syn_VarDefList _lhsOannotatedTree _lhsOdefs )) +sem_VarDefList_Cons :: T_VarDef -> + T_VarDefList -> + T_VarDefList +sem_VarDefList_Cons hd_ tl_ = + (\ _lhsIenv -> + (let _lhsOdefs :: ([(String,Type)]) + _lhsOannotatedTree :: VarDefList + _hdOenv :: Environment + _tlOenv :: Environment + _hdIannotatedTree :: VarDef + _hdIdef :: ((String,Type)) + _tlIannotatedTree :: VarDefList + _tlIdefs :: ([(String,Type)]) + -- "./TypeChecking.ag"(line 953, column 12) + _lhsOdefs = + {-# LINE 953 "./TypeChecking.ag" #-} + _hdIdef : _tlIdefs + {-# LINE 9068 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + (:) _hdIannotatedTree _tlIannotatedTree + {-# LINE 9073 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 9078 "AstInternal.hs" #-} + -- copy rule (down) + _hdOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 9083 "AstInternal.hs" #-} + -- copy rule (down) + _tlOenv = + {-# LINE 56 "./TypeChecking.ag" #-} + _lhsIenv + {-# LINE 9088 "AstInternal.hs" #-} + ( _hdIannotatedTree,_hdIdef) = + (hd_ _hdOenv ) + ( _tlIannotatedTree,_tlIdefs) = + (tl_ _tlOenv ) + in ( _lhsOannotatedTree,_lhsOdefs))) +sem_VarDefList_Nil :: T_VarDefList +sem_VarDefList_Nil = + (\ _lhsIenv -> + (let _lhsOdefs :: ([(String,Type)]) + _lhsOannotatedTree :: VarDefList + -- "./TypeChecking.ag"(line 954, column 11) + _lhsOdefs = + {-# LINE 954 "./TypeChecking.ag" #-} + [] + {-# LINE 9103 "AstInternal.hs" #-} + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + [] + {-# LINE 9108 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 9113 "AstInternal.hs" #-} + in ( _lhsOannotatedTree,_lhsOdefs))) +-- Volatility -------------------------------------------------- +{- + visit 0: + inherited attribute: + env : Environment + synthesized attribute: + annotatedTree : SELF + alternatives: + alternative Immutable: + visit 0: + local annotatedTree : _ + alternative Stable: + visit 0: + local annotatedTree : _ + alternative Volatile: + visit 0: + local annotatedTree : _ +-} +data Volatility = Immutable + | Stable + | Volatile + deriving ( Data,Eq,Show,Typeable) +-- cata +sem_Volatility :: Volatility -> + T_Volatility +sem_Volatility (Immutable ) = + (sem_Volatility_Immutable ) +sem_Volatility (Stable ) = + (sem_Volatility_Stable ) +sem_Volatility (Volatile ) = + (sem_Volatility_Volatile ) +-- semantic domain +type T_Volatility = Environment -> + ( Volatility) +data Inh_Volatility = Inh_Volatility {env_Inh_Volatility :: Environment} +data Syn_Volatility = Syn_Volatility {annotatedTree_Syn_Volatility :: Volatility} +wrap_Volatility :: T_Volatility -> + Inh_Volatility -> + Syn_Volatility +wrap_Volatility sem (Inh_Volatility _lhsIenv ) = + (let ( _lhsOannotatedTree) = + (sem _lhsIenv ) + in (Syn_Volatility _lhsOannotatedTree )) +sem_Volatility_Immutable :: T_Volatility +sem_Volatility_Immutable = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Volatility + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Immutable + {-# LINE 9166 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 9171 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_Volatility_Stable :: T_Volatility +sem_Volatility_Stable = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Volatility + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Stable + {-# LINE 9181 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 9186 "AstInternal.hs" #-} + in ( _lhsOannotatedTree))) +sem_Volatility_Volatile :: T_Volatility +sem_Volatility_Volatile = + (\ _lhsIenv -> + (let _lhsOannotatedTree :: Volatility + -- self rule + _annotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + Volatile + {-# LINE 9196 "AstInternal.hs" #-} + -- self rule + _lhsOannotatedTree = + {-# LINE 56 "./TypeChecking.ag" #-} + _annotatedTree + {-# LINE 9201 "AstInternal.hs" #-} in ( _lhsOannotatedTree))) diff --git a/Database/HsSqlPpp/AstInternals/TypeChecking.ag b/Database/HsSqlPpp/AstInternals/TypeChecking.ag --- a/Database/HsSqlPpp/AstInternals/TypeChecking.ag +++ b/Database/HsSqlPpp/AstInternals/TypeChecking.ag @@ -390,8 +390,12 @@ | Select loc.tpe = do - let trefType = fromMaybe typeBool $ fmap getTypeAnnotation - @selTref.annotatedTree + let trefType = let ts = @selTref.annotatedTree + in case null ts of + True -> typeBool + _ -> getTypeAnnotation $ head ts + {-fromMaybe typeBool $ fmap getTypeAnnotation + @selTref.annotatedTree-} slType = @selSelectList.listType chainTypeCheckFailed [trefType, slType] $ Right $ case slType of @@ -405,7 +409,6 @@ @selGroupBy.annotatedTree @selHaving.annotatedTree @selOrderBy.annotatedTree - @selDir.annotatedTree @selLimit.annotatedTree @selOffset.annotatedTree | CombineSelect @@ -422,8 +425,8 @@ getTbCols c = unwrapSetOfComposite (getTypeAnnotation c) } -ATTR TableRef MaybeTableRef [||idens : {[(String,([(String,Type)],[(String,Type)]))]} - joinIdens : {[String]} ] +ATTR TableRef TableRefList [||idens : {[(String,([(String,Type)],[(String,Type)]))]} + joinIdens : {[String]} ] SEM TableRef | SubTref TrefAlias Tref TrefFun TrefFunAlias JoinedTref @@ -520,8 +523,10 @@ _ -> UnnamedCompositeType [] } -SEM MaybeTableRef - | Nothing +SEM TableRefList + | Cons lhs.idens = @hd.idens + lhs.joinIdens = @hd.joinIdens + | Nil lhs.idens = [] lhs.joinIdens = [] diff --git a/Database/HsSqlPpp/Parsing/Parser.lhs b/Database/HsSqlPpp/Parsing/Parser.lhs --- a/Database/HsSqlPpp/Parsing/Parser.lhs +++ b/Database/HsSqlPpp/Parsing/Parser.lhs @@ -201,22 +201,23 @@ > selQuerySpec p = Select p > <$> option Dupes (Distinct <$ keyword "distinct") > <*> selectList -> <*> tryOptionMaybe from +> <*> option [] from > <*> tryOptionMaybe whereClause > <*> option [] groupBy > <*> tryOptionMaybe having > <*> option [] orderBy -> <*> option Asc (choice [ -> Asc <$ keyword "asc" -> ,Desc <$ keyword "desc"]) > <*> tryOptionMaybe limit > <*> tryOptionMaybe offset -> from = keyword "from" *> tref +> from = keyword "from" *> commaSep1 tref > groupBy = keyword "group" *> keyword "by" > *> commaSep1 expr > having = keyword "having" *> expr > orderBy = keyword "order" *> keyword "by" -> *> commaSep1 expr +> *> commaSep1 oneOrder +> oneOrder = (,) <$> expr +> <*> option Asc (choice [ +> Asc <$ keyword "asc" +> ,Desc <$ keyword "desc"]) > limit = keyword "limit" *> expr > offset = keyword "offset" *> expr diff --git a/Database/HsSqlPpp/PrettyPrinter/PrettyPrinter.lhs b/Database/HsSqlPpp/PrettyPrinter/PrettyPrinter.lhs --- a/Database/HsSqlPpp/PrettyPrinter/PrettyPrinter.lhs +++ b/Database/HsSqlPpp/PrettyPrinter/PrettyPrinter.lhs @@ -341,19 +341,20 @@ > convSelectExpression :: Bool -> SelectExpression -> Doc > convSelectExpression writeSelect (Select _ dis l tb wh grp hav -> ord orddir lim off) = +> ord lim off) = > text (if writeSelect then "select" else "") > <+> (case dis of > Dupes -> empty > Distinct -> text "distinct") > <+> convSelList l -> $+$ nest 2 ( -> maybeConv (\tr -> text "from" <+> convTref tr) tb -> $+$ convWhere wh) +> $+$ (if null tb +> then empty +> else nest 2 (text "from" <+> hcatCsvMap convTref tb)) +> $+$ convWhere wh > <+> ifNotEmpty (\g -> text "group by" <+> hcatCsvMap convExp g) grp > <+> maybeConv (\h -> text "having" <+> convExp h) hav -> <+> ifNotEmpty (\o -> text "order by" <+> hcatCsvMap convExp o -> <+> convDir orddir) ord +> <+> ifNotEmpty (\o -> text "order by" <+> hcatCsvMap (\(oe,od) -> convExp oe +> <+> convDir od) o) ord > <+> maybeConv (\lm -> text "limit" <+> convExp lm) lim > <+> maybeConv (\offs -> text "offset" <+> convExp offs) off > where diff --git a/Database/HsSqlPpp/Tests/ParserTests.lhs b/Database/HsSqlPpp/Tests/ParserTests.lhs --- a/Database/HsSqlPpp/Tests/ParserTests.lhs +++ b/Database/HsSqlPpp/Tests/ParserTests.lhs @@ -222,8 +222,8 @@ > [SelectStatement [] $ selectFrom (selIL ["a", "b"]) (Tref [] "inf.tbl")] > ,p "select distinct * from tbl;" -> [SelectStatement [] $ Select [] Distinct (SelectList [] (selIL ["*"]) []) (Just $ Tref [] "tbl") -> Nothing [] Nothing [] Asc Nothing Nothing] +> [SelectStatement [] $ Select [] Distinct (SelectList [] (selIL ["*"]) []) [Tref [] "tbl"] +> Nothing [] Nothing [] Nothing Nothing] > ,p "select a from tbl where b=2;" > [SelectStatement [] $ selectFromWhere @@ -281,6 +281,13 @@ > (JoinedTref [] (Tref [] "b") Unnatural Inner (Tref [] "c") > (Just (JoinOn [] > (FunCall [] "=" [Identifier [] "b.a", Identifier [] "c.a"]))))] +> ,p "select * from t1 a, t2 b;" +> [SelectStatement [] +> (Select [] Dupes +> (SelectList [] +> [SelExp [] (Identifier [] "*")] []) +> [TrefAlias [] "t1" "a",TrefAlias [] "t2" "b"] +> Nothing [] Nothing [] Nothing Nothing)] > ,p "select a from b inner join c as d on b.a=d.a;" > [SelectStatement [] $ selectFrom > (selIL ["a"]) @@ -376,32 +383,43 @@ > ,p "select * from a order by c;" > [SelectStatement [] $ Select [] Dupes > (sl (selIL ["*"])) -> (Just $ Tref [] "a") -> Nothing [] Nothing [Identifier [] "c"] Asc Nothing Nothing] +> [Tref [] "a"] +> Nothing [] Nothing [(Identifier [] "c", Asc)] Nothing Nothing] +> ,p "select *\n\ +> \from Adventure\n\ +> \order by Clicks desc, AdventureID;" +> [SelectStatement [] $ Select [] Dupes +> (sl (selIL ["*"])) +> [Tref [] "Adventure"] +> Nothing [] Nothing [(Identifier [] "Clicks",Desc) +> ,(Identifier [] "AdventureID",Asc)] Nothing Nothing] + > ,p "select * from a order by c,d asc;" > [SelectStatement [] $ Select [] Dupes > (sl (selIL ["*"])) -> (Just $ Tref [] "a") -> Nothing [] Nothing [Identifier [] "c", Identifier [] "d"] Asc Nothing Nothing] +> [Tref [] "a"] +> Nothing [] Nothing [(Identifier [] "c",Asc) +> ,(Identifier [] "d",Asc)] Nothing Nothing] > ,p "select * from a order by c,d desc;" > [SelectStatement [] $ Select [] Dupes > (sl (selIL ["*"])) -> (Just $ Tref [] "a") -> Nothing [] Nothing [Identifier [] "c", Identifier [] "d"] Desc Nothing Nothing] +> [Tref [] "a"] +> Nothing [] Nothing [(Identifier [] "c", Asc) +> ,(Identifier [] "d", Desc)] Nothing Nothing] > ,p "select * from a order by c limit 1;" > [SelectStatement [] $ Select [] Dupes > (sl (selIL ["*"])) -> (Just $ Tref [] "a") -> Nothing [] Nothing [Identifier [] "c"] Asc (Just (IntegerLit [] 1)) Nothing] +> [Tref [] "a"] +> Nothing [] Nothing [(Identifier [] "c",Asc)] (Just (IntegerLit [] 1)) Nothing] > ,p "select * from a order by c offset 3;" > [SelectStatement [] $ Select [] Dupes > (sl (selIL ["*"])) -> (Just $ Tref [] "a") -> Nothing [] Nothing [Identifier [] "c"] Asc Nothing (Just $ IntegerLit [] 3)] +> [Tref [] "a"] +> Nothing [] Nothing [(Identifier [] "c",Asc)] Nothing (Just $ IntegerLit [] 3)] > ,p "select a from (select b from c) as d;" > [SelectStatement [] $ selectFrom @@ -421,15 +439,15 @@ > ,p "select a, count(b) from c group by a;" > [SelectStatement [] $ Select [] Dupes > (sl [selI "a", SelExp [] (FunCall [] "count" [Identifier [] "b"])]) -> (Just $ Tref [] "c") Nothing [Identifier [] "a"] -> Nothing [] Asc Nothing Nothing] +> [Tref [] "c"] Nothing [Identifier [] "a"] +> Nothing [] Nothing Nothing] > ,p "select a, count(b) as cnt from c group by a having cnt > 4;" > [SelectStatement [] $ Select [] Dupes > (sl [selI "a", SelectItem [] (FunCall [] "count" [Identifier [] "b"]) "cnt"]) -> (Just $ Tref [] "c") Nothing [Identifier [] "a"] +> [Tref [] "c"] Nothing [Identifier [] "a"] > (Just $ FunCall [] ">" [Identifier [] "cnt", IntegerLit [] 4]) -> [] Asc Nothing Nothing] +> [] Nothing Nothing] > ,p "select a from (select 1 as a, 2 as b) x;" > [SelectStatement [] $ selectFrom @@ -583,13 +601,13 @@ copy, bit crap at the moment > ,p "copy tbl(a,b) from stdin;\n\ -> \bat t\n\ -> \bear f\n\ +> \bat\tt\n\ +> \bear\tf\n\ > \\\.\n" > [Copy [] "tbl" ["a", "b"] Stdin > ,CopyData [] "\ -> \bat t\n\ -> \bear f\n"] +> \bat\tt\n\ +> \bear\tf\n"] > ]) ================================================================================ @@ -961,10 +979,10 @@ > ,stringQ "_and_stuff"]]] > ,p "select into a,b c,d from e;" > [SelectStatement [] $ Select [] Dupes (SelectList [] [selI "c", selI "d"] ["a", "b"]) -> (Just $ Tref [] "e") Nothing [] Nothing [] Asc Nothing Nothing] +> [Tref [] "e"] Nothing [] Nothing [] Nothing Nothing] > ,p "select c,d into a,b from e;" > [SelectStatement [] $ Select [] Dupes (SelectList [] [selI "c", selI "d"] ["a", "b"]) -> (Just $ Tref [] "e") Nothing [] Nothing [] Asc Nothing Nothing] +> [Tref [] "e"] Nothing [] Nothing [] Nothing Nothing] > ,p "execute s;" > [Execute [] (Identifier [] "s")] @@ -1049,13 +1067,13 @@ > selI = SelExp [] . Identifier [] > sl a = SelectList [] a [] > selectE selList = Select [] Dupes selList -> Nothing Nothing [] Nothing [] Asc Nothing Nothing +> [] Nothing [] Nothing [] Nothing Nothing > selectFrom selList frm = > Select [] Dupes (SelectList [] selList []) -> (Just frm) Nothing [] Nothing [] Asc Nothing Nothing +> [frm] Nothing [] Nothing [] Nothing Nothing > selectFromWhere selList frm whr = > Select [] Dupes (SelectList [] selList []) -> (Just frm) (Just whr) [] Nothing [] Asc Nothing Nothing +> [frm] (Just whr) [] Nothing [] Nothing Nothing > stringQ = StringLit [] "'" > att n t = AttributeDef [] n (SimpleTypeName [] t) Nothing [] diff --git a/hssqlppp.cabal b/hssqlppp.cabal --- a/hssqlppp.cabal +++ b/hssqlppp.cabal @@ -1,5 +1,5 @@ Name: hssqlppp -Version: 0.0.9 +Version: 0.0.10 Synopsis: Sql parser and type checker Description: Sql parser, pretty printer and type checker, targets PostGreSQL SQL