MiscCreates.ag

{-
Copyright 2009 Jake Wheat

This file contains the ddl checking, apart from create function and
create table which have their own files.

= create view

pretty simple, just forwards the select expression type

-}

SEM Statement
    | CreateView
        loc.tpe = dependsOnRTpe [getTypeAnnotation @expr.annotatedTree] $
                    Right $ Pseudo Void
        loc.backTree = CreateView @ann @name @expr.annotatedTree
        loc.attrs = case getTypeAnnotation @expr.annotatedTree of
                      SetOfType (CompositeType c) -> c
                      _ -> [] --TODO: error ignored
        loc.envUpdates = [EnvCreateView @name @loc.attrs]
        loc.statementType = []

{-
================================================================================

= create type

might move this to create table since they have a fair bit in common

main shortcomings are the names and types aren't checked

-}

ATTR TypeAttributeDef [||attrName : String
                         namedType : Type]

SEM TypeAttributeDef
    | TypeAttDef
        lhs.attrName = @name
        lhs.namedType = @typ.namedType

ATTR TypeAttributeDefList [||attrs : {[(String, Type)]}]

SEM TypeAttributeDefList
    | Cons lhs.attrs = (@hd.attrName, @hd.namedType) : @tl.attrs
    | Nil lhs.attrs = []

SEM Statement
    | CreateType
        loc.tpe = Right $ Pseudo Void
        loc.backTree = CreateType @ann @name @atts.annotatedTree
        loc.statementType = []
        loc.envUpdates = [EnvCreateComposite @name @atts.attrs]

{-

= create domain

-}

SEM Statement
    | CreateDomain
        loc.tpe = Right $ Pseudo Void
        loc.backTree = CreateDomain @ann @name @typ.annotatedTree @checkName @check.annotatedTree
        loc.statementType = []
        loc.envUpdates = [EnvCreateDomain (DomainType @name) @typ.namedType]
        --allow refering to value as 'value' in check expression
        check.lib = fromRight @lhs.lib $
                    updateBindings @lhs.lib @lhs.env
                      [LibStackIDs [("", [("value", @typ.namedType)])]]