hssqlppp-0.0.7: Database/HsSqlPpp/AstInternals/AstInternal.hs
{-# 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" #-}
in ( _lhsOannotatedTree)))