{- Copyright 2009 Jake Wheat This file contains the ast nodes, and the api functions to pass an ast and get back type information. It uses the Utrecht University Attribute Grammar system: http://www.cs.uu.nl/wiki/bin/view/HUT/AttributeGrammarSystem http://www.haskell.org/haskellwiki/The_Monad.Reader/Issue4/Why_Attribute_Grammars_Matter The attr and sem definitions are in TypeChecking.ag, which is included into this file. These ast nodes are both used as the result of successful parsing, and as the input to the type checker (and the output from the type checker), and the pretty printer. = compiling use uuagc -dcfwsp --cycle --genlinepragmas AstInternal.ag to generate a new AstInternal.hs from this file (cycle will check for cycles - it's bad if you get any of these, and genlinepragmas mean that you'll be able to view the original source ag positions when there are errors or warnings compiling the generated hs file, which you want much more often than not). (install uuagc with cabal install uuagc ) -} MODULE {Database.HsSqlPpp.AstInternals.AstInternal} { -- {-# LANGUAGE DeriveDataTypeable,RankNTypes,ScopedTypeVariables #-} -- {-# OPTIONS_HADDOCK hide #-} --from the ag files: --ast nodes Statement (..) ,SelectExpression (..) ,FnBody (..) ,SetClause (..) ,TableRef (..) ,TableAlias(..) ,JoinExpression (..) ,JoinType (..) ,SelectList (..) ,SelectItem (..) ,CopySource (..) ,AttributeDef (..) ,RowConstraint (..) ,AlterTableAction(..) ,Constraint (..) ,TypeAttributeDef (..) ,ParamDef (..) ,VarDef (..) ,RaiseType (..) ,CombineType (..) ,Volatility (..) ,Language (..) ,TypeName (..) ,DropType (..) ,Cascade (..) ,Direction (..) ,Distinct (..) ,Natural (..) ,IfExists (..) ,RestartIdentity (..) ,Expression (..) ,FrameClause(..) ,InList (..) ,LiftFlavour(..) ,TriggerWhen(..) ,TriggerEvent(..) ,TriggerFire(..) ,StatementList ,ExpressionListStatementListPairList ,ExpressionListStatementListPair ,ExpressionList ,StringList ,ParamDefList ,AttributeDefList ,ConstraintList ,TypeAttributeDefList ,TypeNameList ,StringTypeNameListPair ,StringTypeNameListPairList ,ExpressionStatementListPairList ,SetClauseList ,CaseExpressionListExpressionPairList ,MaybeExpression ,TableRefList ,ExpressionListList ,SelectItemList ,OnExpr ,RowConstraintList ,VarDefList ,ExpressionStatementListPair ,CaseExpressionListExpressionPair ,CaseExpressionList ,ExpressionDirectionPair ,ExpressionDirectionPairList ,MaybeBoolExpression ,MaybeSelectList ,SetValue(..) -- typechecking ,typeCheck ,typeCheckPS ,typeCheckExpression } { 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 Data.Char import Database.HsSqlPpp.AstInternals.TypeType import Database.HsSqlPpp.AstInternals.TypeChecking.TypeConversion import Database.HsSqlPpp.AstInternals.TypeChecking.ErrorUtils import Database.HsSqlPpp.AstInternals.AstAnnotation import Database.HsSqlPpp.AstInternals.Environment.EnvironmentInternal import Database.HsSqlPpp.AstInternals.Environment.LocalIdentifierBindings import Database.HsSqlPpp.AstInternals.Environment.DefaultTemplate1Environment import Database.HsSqlPpp.Utils import Data.Generics.PlateData } {- ================================================================================ SQL top level statements everything is chucked in here: dml, ddl, plpgsql statements -} DATA Statement --queries | SelectStatement ann:Annotation ex:SelectExpression -- dml --table targetcolumns insertdata(values or select statement) returning | Insert ann:Annotation table : String targetCols : StringList insData : SelectExpression returning : MaybeSelectList --tablename setitems where returning | Update ann:Annotation table : String assigns : SetClauseList whr : MaybeBoolExpression returning : MaybeSelectList --tablename, where, returning | Delete ann:Annotation table : String whr : MaybeBoolExpression returning : MaybeSelectList --tablename column names, from | Copy ann:Annotation table : String targetCols : StringList source : CopySource --represents inline data for copy statement | CopyData ann:Annotation insData : String | Truncate ann:Annotation tables: StringList restartIdentity : RestartIdentity cascade : Cascade -- ddl | CreateTable ann:Annotation name : String atts : AttributeDefList cons : ConstraintList | AlterTable ann:Annotation name : String actions : {[AlterTableAction]} | CreateSequence ann:Annotation name:String incr:Integer min:Integer max:Integer start:Integer cache:Integer | AlterSequence ann:Annotation name:String ownedBy: String | CreateTableAs ann:Annotation name : String expr : SelectExpression | CreateView ann:Annotation name : String expr : SelectExpression | CreateType ann:Annotation name : String atts : TypeAttributeDefList -- language name args rettype bodyquoteused body vol | CreateFunction ann:Annotation name : String params : ParamDefList rettype : TypeName lang : Language bodyQuote : String body : FnBody vol : Volatility -- name type checkexpression | CreateDomain ann:Annotation name : String typ : TypeName checkName: String check : MaybeBoolExpression | CreateLanguage ann:Annotation name:String | CreateTrigger ann:Annotation name:String wh : TriggerWhen events: {[TriggerEvent]} tbl : String firing : TriggerFire fnName : String fnArgs : {[Expression]} -- ifexists (name,argtypes)* cascadeorrestrict | DropFunction ann:Annotation ifE : IfExists sigs : StringTypeNameListPairList cascade : Cascade -- ifexists names cascadeorrestrict | DropSomething ann:Annotation dropType : DropType ifE : IfExists names : StringList cascade : Cascade | Assignment ann:Annotation target : String value : Expression | Return ann:Annotation value : (MaybeExpression) | ReturnNext ann:Annotation expr : Expression | ReturnQuery ann:Annotation sel : SelectExpression | Raise ann:Annotation level : RaiseType message : String args : ExpressionList | NullStatement ann:Annotation | Perform ann:Annotation expr : Expression | Execute ann:Annotation expr : Expression | ExecuteInto ann:Annotation expr : Expression targets : StringList | ForSelectStatement ann:Annotation var : String sel : SelectExpression sts : StatementList | ForIntegerStatement ann:Annotation var : String from : Expression to : Expression sts : StatementList | WhileStatement ann:Annotation expr : Expression sts : StatementList | ContinueStatement ann:Annotation --variable, list of when parts, else part | CaseStatement ann:Annotation val : Expression cases : ExpressionListStatementListPairList els : StatementList --list is --first if (condition, statements):elseifs(condition, statements) --last bit is else statements | If ann:Annotation cases : ExpressionStatementListPairList els : StatementList --misc | Set ann:Annotation name:String values:{[SetValue]} | Notify ann:Annotation name:String -- ============================================================================= --Statement components -- maybe this should be called relation valued expression? DATA SelectExpression | Select ann:Annotation selDistinct : Distinct selSelectList : SelectList selTref : TableRefList selWhere : MaybeBoolExpression selGroupBy : ExpressionList selHaving : MaybeBoolExpression selOrderBy : ExpressionDirectionPairList selLimit : MaybeExpression selOffset : MaybeExpression | CombineSelect ann:Annotation ctype : CombineType sel1 : SelectExpression sel2 : SelectExpression | Values ann:Annotation vll:ExpressionListList TYPE TableRefList = [TableRef] TYPE MaybeExpression = MAYBE Expression TYPE MaybeBoolExpression = MAYBE Expression DATA FnBody | SqlFnBody ann:Annotation sts : StatementList | PlpgsqlFnBody ann:Annotation vars:VarDefList sts : StatementList DATA SetClause | SetClause ann:Annotation att:String val:Expression | RowSetClause ann:Annotation atts:StringList vals:ExpressionList DATA TableRef | Tref ann:Annotation tbl:String alias : TableAlias | JoinedTref ann:Annotation tbl : TableRef nat : Natural joinType : JoinType tbl1 : TableRef onExpr : OnExpr alias : TableAlias | SubTref ann:Annotation sel : SelectExpression alias : TableAlias | TrefFun ann:Annotation fn:Expression alias : TableAlias DATA TableAlias | NoAlias | TableAlias alias:String | FullAlias alias:String cols:{[String]} TYPE OnExpr = MAYBE JoinExpression DATA JoinExpression | JoinOn ann:Annotation Expression | JoinUsing ann:Annotation StringList DATA JoinType | Inner | LeftOuter| RightOuter | FullOuter | Cross -- select columns, into columns DATA SelectList | SelectList ann:Annotation items:SelectItemList into:StringList TYPE MaybeSelectList = MAYBE SelectList DATA SelectItem | SelExp ann:Annotation ex:Expression | SelectItem ann:Annotation ex:Expression name:String DATA CopySource | CopyFilename String | Stdin --name type default null constraint DATA AttributeDef | AttributeDef ann:Annotation name : String typ : TypeName def: MaybeExpression cons : RowConstraintList --Constraints which appear attached to an individual field DATA RowConstraint | NullConstraint ann:Annotation name:String | NotNullConstraint ann:Annotation name:String | RowCheckConstraint ann:Annotation name:String Expression | RowUniqueConstraint ann:Annotation name:String | RowPrimaryKeyConstraint ann:Annotation name:String | RowReferenceConstraint ann:Annotation name:String table : String att : (Maybe String) onUpdate : Cascade onDelete : Cascade --constraints which appear on a separate row in the create table DATA Constraint | UniqueConstraint ann:Annotation name:String StringList | PrimaryKeyConstraint ann:Annotation name:String StringList | CheckConstraint ann:Annotation name:String Expression -- sourcecols targettable targetcols ondelete onupdate | ReferenceConstraint ann:Annotation name:String atts : StringList table : String tableAtts : StringList onUpdate : Cascade onDelete : Cascade DATA TypeAttributeDef | TypeAttDef ann:Annotation name : String typ : TypeName DATA AlterTableAction | AlterColumnDefault ann:Annotation nm : String def : Expression | AddConstraint ann:Annotation con: Constraint DATA SetValue | SetStr ann:Annotation String | SetId ann:Annotation String | SetNum ann:Annotation Double DATA TriggerWhen | TriggerBefore | TriggerAfter DATA TriggerEvent | TInsert| TUpdate | TDelete DATA TriggerFire | EachRow | EachStatement DATA ParamDef | ParamDef ann:Annotation name:String typ:TypeName | ParamDefTp ann:Annotation typ:TypeName DATA VarDef | VarDef ann:Annotation name : String typ : TypeName value : (Maybe Expression) DATA RaiseType | RNotice | RException | RError DATA CombineType | Except | Union | Intersect | UnionAll DATA Volatility | Volatile | Stable | Immutable DATA Language | Sql | Plpgsql DATA TypeName | SimpleTypeName ann:Annotation tn:String | PrecTypeName ann:Annotation tn:String prec:Integer | ArrayTypeName ann:Annotation typ:TypeName | SetOfTypeName ann:Annotation typ:TypeName DATA DropType | Table | Domain | View | Type DATA Cascade | Cascade | Restrict DATA Direction | Asc | Desc DATA Distinct | Distinct | Dupes DATA Natural | Natural | Unnatural DATA IfExists | Require | IfExists DATA RestartIdentity | RestartIdentity | ContinueIdentity {- ================================================================================ Expressions Similarly to the statement type, all expressions are chucked into one even though there are many restrictions on which expressions can appear in different places. Maybe this should be called scalar expression? -} DATA Expression | IntegerLit ann:Annotation i:Integer | FloatLit ann:Annotation d:Double | StringLit ann:Annotation quote : String value : String | NullLit ann:Annotation | BooleanLit ann:Annotation b:Bool | PositionalArg ann:Annotation p:Integer | Placeholder ann:Annotation -- represents a '?' | Cast ann:Annotation expr:Expression tn:TypeName | Identifier ann:Annotation i:String | Case ann:Annotation cases : CaseExpressionListExpressionPairList els : MaybeExpression | CaseSimple ann:Annotation value : Expression cases : CaseExpressionListExpressionPairList els : MaybeExpression | Exists ann:Annotation sel : SelectExpression | FunCall ann:Annotation funName:String args:ExpressionList | InPredicate ann:Annotation expr:Expression i:Bool list:InList | WindowFn ann:Annotation fn : Expression partitionBy : ExpressionList orderBy : ExpressionList dir : Direction frm : FrameClause | ScalarSubQuery ann:Annotation sel : SelectExpression | LiftOperator ann:Annotation oper:String flav:LiftFlavour args:ExpressionList DATA LiftFlavour | LiftAny | LiftAll --todo: use liftoperator to implement inlist? DATA InList | InList ann:Annotation exprs : ExpressionList | InSelect ann:Annotation sel : SelectExpression DATA FrameClause | FrameUnboundedPreceding | FrameUnboundedFull | FrameRowsUnboundedPreceding {- list of expression flavours from postgresql with the equivalents in this ast pg here -- ---- constant/literal integerlit, floatlit, unknownstringlit, nulllit, boollit column reference identifier positional parameter reference positionalarg subscripted expression funcall field selection expression identifier operator invocation funcall function call funcall aggregate expression funcall window function call windowfn type cast cast scalar subquery scalarsubquery array constructor funcall row constructor funall Anything that is represented in the ast as some sort of name plus a list of expressions as arguments is treated as the same type of node: FunCall. This includes symbol operators regular function calls keyword operators e.g. and, like (ones which can be parsed as normal syntactic operators) unusual syntax operators, e.g. between unusual syntax function calls e.g. substring(x from 5 for 3) arrayctors e.g. array[3,5,6] rowctors e.g. ROW (2,4,6) array subscripting list of keyword operators (regular prefix, infix and postfix): and, or, not is null, is not null, isnull, notnull is distinct from, is not distinct from is true, is not true,is false, is not false, is unknown, is not unknown like, not like, ilike, not ilike similar to, not similar to in, not in (don't include these here since the argument isn't always an expr) unusual syntax operators and fn calls between, not between, between symmetric overlay, substring, trim any, some, all Most of unusual syntax forms and keywords operators are not yet supported, so this is mainly a todo list. Keyword operators are encoded with the function name as a ! followed by a string e.g. operator 'and' -> FunCall "!and" ... see keywordOperatorTypes value in AstUtils.lhs for the list of currently supported keyword operators. -} -- some list nodes, not sure if all of these are needed as separately -- named node types TYPE ExpressionList = [Expression] TYPE ExpressionListList = [ExpressionList] TYPE StringList = [String] TYPE SetClauseList = [SetClause] TYPE AttributeDefList = [AttributeDef] TYPE ConstraintList = [Constraint] TYPE TypeAttributeDefList = [TypeAttributeDef] TYPE ParamDefList = [ParamDef] TYPE TypeNameList = [TypeName] TYPE StringTypeNameListPair = (String, TypeNameList) TYPE StringTypeNameListPairList = [StringTypeNameListPair] TYPE ExpressionListStatementListPair = (ExpressionList,StatementList) TYPE ExpressionListStatementListPairList = [ExpressionListStatementListPair] TYPE ExpressionStatementListPair = (Expression, StatementList) TYPE ExpressionStatementListPairList = [ExpressionStatementListPair] TYPE VarDefList = [VarDef] TYPE SelectItemList = [SelectItem] TYPE RowConstraintList = [RowConstraint] TYPE CaseExpressionListExpressionPair = (CaseExpressionList,Expression) TYPE CaseExpressionList = [Expression] TYPE CaseExpressionListExpressionPairList = [CaseExpressionListExpressionPair] TYPE StatementList = [Statement] TYPE ExpressionDirectionPair = (Expression,Direction) TYPE ExpressionDirectionPairList = [ExpressionDirectionPair] -- Add a root data type so we can put initial values for inherited -- attributes in the section which defines and uses those attributes -- rather than in the sem_ calls DATA Root | Root statements:StatementList DERIVING Root: Show -- use an expression root also to support type checking, -- etc., individual expressions DATA ExpressionRoot | ExpressionRoot expr:Expression DERIVING ExpressionRoot: Show {- ================================================================================ =some basic bookkeeping attributes which every node has -} SET AllNodes = 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 MaybeExpression MaybeBoolExpression ExpressionList ExpressionListList StringList SetClauseList AttributeDefList ConstraintList TypeAttributeDefList ParamDefList TypeNameList StringTypeNameListPair StringTypeNameListPairList StatementList ExpressionListStatementListPair ExpressionListStatementListPairList ExpressionStatementListPair ExpressionStatementListPairList VarDefList SelectItemList RowConstraintList CaseExpressionListExpressionPair CaseExpressionListExpressionPairList CaseExpressionList TableRefList TableRef OnExpr LiftFlavour MaybeSelectList SetValue TableAlias FrameClause AlterTableAction TriggerWhen TriggerEvent TriggerFire ExpressionDirectionPair ExpressionDirectionPairList DERIVING AllNodes: Show,Eq,Typeable,Data INCLUDE "TypeChecking/TypeChecking.ag" {- ================================================================================ used to use record syntax to try to insulate code from field changes, and not have to write out loads of nothings and [] for simple selects, but don't know how to create haskell named records from uuagc DATA things makeSelect :: Statement makeSelect = Select Dupes (SelectList [SelExp (Identifier "*")] []) Nothing Nothing [] Nothing [] Asc Nothing Nothing ================================================================================ = annotation functions -} { {- -- | Type check multiple asts, allowing type checking references in -- later files to definitions in earlier files. This is probably -- more straightforward if you parse the files then concatenate the -- statementlists together before type checking rather than using -- this function typeCheckMany :: Environment -> [StatementList] -> [StatementList] typeCheckMany env sts = annInt env sts [] where annInt e (s:ss) ress = let (e1,res) = typeCheck e s in annInt e1 ss (res:ress) annInt _ [] ress = reverse ress -} -- | Takes an ast, checks against catalog passed, and adds -- annotations, including types, type errors, and statement info. -- Returns the updated catalog as well as the annotated ast. typeCheck :: Environment -> StatementList -> (Environment,StatementList) typeCheck env sts = let t = sem_Root (Root (fixupImplicitJoins sts)) ta = wrap_Root t Inh_Root {env_Inh_Root = env ,lib_Inh_Root = emptyBindings} tl = annotatedTree_Syn_Root ta env1 = producedEnv_Syn_Root ta in case tl of Root r -> (env1,r) -- | Unfinished version of type check which can type check an -- individual statement with ? or positional arg placeholders in -- it. Will error if the statement isn't select, update, insert or -- delete. For use in type checking embedded parameterized -- statements. Does all typechecking and annotation that the regular -- typecheck does. typeCheckPS :: Environment -> Statement -> Either String Statement typeCheckPS env st = case st of SelectStatement _ _ -> tc Insert _ _ _ _ _ -> tc Update _ _ _ _ _ -> tc Delete _ _ _ _ -> tc _ -> Left "requires select, update, insert or delete statement" where tc = let t = sem_Root (Root (fixupImplicitJoins [st])) ta = wrap_Root t Inh_Root {env_Inh_Root = env ,lib_Inh_Root = emptyBindings} tl = annotatedTree_Syn_Root ta env1 = producedEnv_Syn_Root ta in case tl of Root [st1] -> Right st1 _ -> error "impossible happened in typeCheckPS!" -- | Testing utility, mainly used to check an expression for type errors -- or to get its type. typeCheckExpression :: Environment -> Expression -> Expression typeCheckExpression env ex = let t = sem_ExpressionRoot (ExpressionRoot (fixupImplicitJoins ex)) rt = (annotatedTree_Syn_ExpressionRoot (wrap_ExpressionRoot t Inh_ExpressionRoot {env_Inh_ExpressionRoot = env ,lib_Inh_ExpressionRoot = emptyBindings})) in case rt of ExpressionRoot e -> e {- bit of a hack, to avoid rewriting the tableref type checking to be able to do implicit joins, we just convert them in to the equivalent explicit join -} fixupImplicitJoins :: Data a => a -> a fixupImplicitJoins = transformBi $ \x -> case x of -- alter asts to change implicit joins into explicit joins Select an dis sl trs@(_:_:_) whr grp hav ord lim off -> Select an dis sl [convTrefs trs] whr grp hav ord lim off x1 -> x1 where convTrefs (tr:tr1:trs) = JoinedTref [] tr Unnatural Cross (convTrefs (tr1:trs)) Nothing NoAlias convTrefs (tr:[]) = tr convTrefs _ = error "failed doing implicit join fixup hack" } {- Future plans: Investigate how much mileage can get out of making these nodes the parse tree nodes, and using a separate ast. Hinges on how much extra value can get from making the types more restrictive for the ast nodes compared to the parse tree. Starting to think this won't be worth it. Would like to turn this back into regular Haskell file, maybe could use AspectAG instead of uuagc to make this happen? -}