Plpgsql.ag

{-
Copyright 2009 Jake Wheat

This file contains the checking code for a few plpgsql statements.


-}

--todo: check return type consistent with function return type
SEM Statement
    | Return
        loc.tpe =
            dependsOnRTpe [maybe typeBool
                                getTypeAnnotation
                                @value.annotatedTree] $ Right $ Pseudo Void
        loc.backTree = Return @ann @value.annotatedTree
        loc.catUpdates = []
        loc.statementType = []


SEM Statement
    | Assignment
        loc.tpe =
            do
            let fromType = getTypeAnnotation @value.annotatedTree
            toType <- libLookupID @lhs.lib @target
            dependsOnRTpe [getTypeAnnotation @value.annotatedTree, toType] $ do
            checkAssignmentValid @lhs.cat fromType toType
            return $ Pseudo Void
        loc.backTree = Assignment @ann @target @value.annotatedTree
        loc.catUpdates = []
        loc.statementType = []

SEM Statement
    | ForIntegerStatement
        loc.varTypeE = libLookupID @lhs.lib @var
        loc.tpe =
          do
          let fromType = getTypeAnnotation @from.annotatedTree
              toType = getTypeAnnotation @to.annotatedTree
          dependsOnRTpe [fromType,toType] $ do
          --probably a bit too strict:
          errorWhen (fromType /= toType) [FromToTypesNotSame fromType toType]
          case @loc.varTypeE of
            Right t -> checkAssignmentValid @lhs.cat fromType t
            Left _ -> return ()
          return $ Pseudo Void
        sts.lib =
            case @loc.varTypeE of
              Left [UnrecognisedIdentifier @var] ->
                  fromRight @lhs.lib $
                  updateBindings @lhs.lib @lhs.cat
                                 [LibStackIDs [("", [(@var,getTypeAnnotation @from.annotatedTree)])]]
              _ -> @lhs.lib

        loc.backTree = ForIntegerStatement @ann @var @from.annotatedTree @to.annotatedTree @sts.annotatedTree
        loc.catUpdates = []
        loc.statementType = []


SEM Statement
    | ForSelectStatement
        loc.selType = getTypeAnnotation @sel.annotatedTree
        loc.tpe =
          do
          dependsOnRTpe [@loc.selType] $ do
          toType <- libLookupID @lhs.lib @var
          dependsOnRTpe [toType] $ do
          checkAssignmentValid @lhs.cat @loc.selType toType
          return $ Pseudo Void
        --just handles assigning to a record type for now
        --one thing that isn't quite right is that the record variable
        --holds the last row in it after the for statement, which isn't
        --supported here
        sts.lib =
            if okToUpdate
              then fromRight @lhs.lib $
                   updateBindings @lhs.lib @lhs.cat [LibStackIDs [("", [(@var,@loc.selType)])]]
                   -- todo:ignoring error
              else @lhs.lib
            where
              okToUpdate = isRight @loc.tpe && @loc.selType /= TypeCheckFailed

        loc.backTree = ForSelectStatement @ann @var @sel.annotatedTree @sts.annotatedTree
        loc.catUpdates = []
        loc.statementType = []