{-
Copyright 2009 Jake Wheat

Contains bit and pieces of type checking which don't fit anywhere else

================================================================================

= type names

Types with type modifiers (called PrecTypeName here, to be changed),
are not supported at the moment.

-}

ATTR TypeName [||namedType : Type]

SEM TypeName
     | SimpleTypeName ArrayTypeName SetOfTypeName PrecTypeName
         lhs.namedType = tpeToT @loc.tpe
         lhs.annotatedTree = updateAnnotation
                               ((map TypeErrorA $ getErrors @loc.tpe) ++)
                               @loc.backTree


SEM TypeName
     | SimpleTypeName
        loc.tpe = envLookupType @lhs.env $ canonicalizeTypeName @tn
        loc.backTree = SimpleTypeName @ann @tn
     | ArrayTypeName
        loc.tpe = dependsOnRTpe [@typ.namedType] $ Right $ ArrayType @typ.namedType
        loc.backTree = ArrayTypeName @ann @typ.annotatedTree
     | SetOfTypeName
        loc.tpe = dependsOnRTpe [@typ.namedType] $ Right $ SetOfType @typ.namedType
        loc.backTree = SetOfTypeName @ann @typ.annotatedTree
     | PrecTypeName
        loc.tpe = envLookupType @lhs.env $ canonicalizeTypeName @tn
        loc.backTree = PrecTypeName @ann @tn @prec


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

= generic node types

-}

--expression list and list list - just collect up the types

ATTR ExpressionList [||typeList : {[Type]}]

SEM ExpressionList
    | Cons lhs.typeList = getTypeAnnotation @hd.annotatedTree : @tl.typeList
    | Nil lhs.typeList = []


ATTR ExpressionListList  [||typeListList : {[[Type]]}]

SEM ExpressionListList
    | Cons lhs.typeListList = @hd.typeList : @tl.typeListList
    | Nil lhs.typeListList = []


-- stringlist: collect the strings
ATTR StringList [||strings : {[String]}]

SEM StringList
  | Cons lhs.strings = @hd : @tl.strings
  | Nil lhs.strings = []

-- maybe bool expression: if present, then check its type is bool

SEM MaybeBoolExpression
    | Just
        lhs.annotatedTree =
          if getTypeAnnotation @just.annotatedTree `notElem` [typeBool, TypeCheckFailed]
            then Just $ updateAnnotation ((TypeErrorA ExpressionMustBeBool) :)
                          @just.annotatedTree
            else Just $ @just.annotatedTree


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

= couple of small utils

I think this should be alright, an identifier referenced in an
expression can only have zero or one dot in it.
-}

splitIdentifier :: String -> (String,String)
splitIdentifier s = let (a,b) = span (/= '.') s
                    in if b == ""
                         then ("", a)
                         else (a,tail b)

{-
helper to make adding annotations a bit easier
-}

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) ++)

}