{- Copyright 2009 Jake Wheat This file contains the code for typechecking create table statements (and also create table as statements). It's pretty limited at the moment, the bits that work are: gathers enough information to add the table attributes types to the catalog typechecks row check constraints properly, but table check constraints and all other constraints are not checked at all. doesn't check for duplicate attribute names. doesn't check if the types are valid for a table (e.g. disallow setof types) We produce a valid environment update if the types of the attributes check ok, any errors in the constraints aren't leaked. -} SEM Statement | CreateTable loc.tpe = dependsOnRTpe @loc.attrTypes $ Right $ Pseudo Void loc.envUpdates = dependsOn @loc.attrTypes [] [EnvCreateTable @name @atts.attrs defaultSystemColumns] loc.attrTypes : {[Type]} loc.attrTypes = map snd @atts.attrs loc.statementType = [] loc.backTree = CreateTable @ann @name @atts.annotatedTree @cons.annotatedTree cons.lib = case updateBindings @lhs.lib @lhs.env [LibStackIDs [("", @atts.attrs)]] of Left x -> error $ show x Right e -> e { defaultSystemColumns :: [(String,Type)] defaultSystemColumns = [("tableoid", ScalarType "oid") ,("cmax", ScalarType "cid") ,("xmax", ScalarType "xid") ,("cmin", ScalarType "cid") ,("xmin", ScalarType "xid") ,("ctid", ScalarType "tid")] } SEM Statement | CreateTableAs loc.tpe = dependsOnRTpe [@loc.selType] $ do @loc.attrs Right @loc.selType loc.envUpdates = leftToEmpty (\as -> [EnvCreateTable @name as defaultSystemColumns]) $ do ats <- @loc.attrs return $ dependsOn (tpeToT @loc.tpe : (map snd ats)) [] ats loc.selType = getTypeAnnotation @expr.annotatedTree -- type of the columns in the select expression loc.attrs = unwrapSetOfComposite @loc.selType loc.backTree = CreateTableAs @ann @name @expr.annotatedTree loc.statementType = [] {- attribute name and type gathering -} ATTR AttributeDef [||attrName : String namedType : Type] SEM AttributeDef | AttributeDef lhs.attrName = map toLower @name lhs.namedType = @typ.namedType ATTR AttributeDefList [||attrs : {[(String, Type)]}] SEM AttributeDefList | Cons lhs.attrs = (@hd.attrName, @hd.namedType) : @tl.attrs | Nil lhs.attrs = [] {- row check constraint: inject the column name and type into the column constraints -} SEM AttributeDef | AttributeDef cons.lib = case updateBindings @lhs.lib @lhs.env [LibStackIDs [("", [(@name, @typ.namedType)])]] of Left x -> error $ show x Right e -> e