git.iko.soy/project-m36
on 48a1cfd help sign in
project-m36/ProjectM36/AtomFunction.hs
37 lines 1.8 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module ProjectM36.AtomFunction where
3import ProjectM36.Base
4import ProjectM36.Error
5import qualified ProjectM36.Attribute as A
6import qualified Data.HashSet as HS
7import qualified Data.Vector as V
9foldAtomFuncType :: AtomType -> AtomType -> [AtomType]
10foldAtomFuncType foldType returnType = [RelationAtomType (A.attributesFromList [Attribute "_" foldType]), returnType]
12atomFunctionForName :: AtomFunctionName -> AtomFunctions -> Either RelationalError AtomFunction
13atomFunctionForName funcName funcSet = if HS.null foundFunc then
14 Left $ NoSuchTupleExprFunctionError funcName
15 else
16 Right $ head $ HS.toList foundFunc
17 where
18 foundFunc = HS.filter (\(AtomFunction name _ _) -> name == funcName) funcSet
20--determine if two types are equal or compatible
21atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType
22atomTypeVerify AnyAtomType x = Right x
23atomTypeVerify x AnyAtomType = Right x
24atomTypeVerify x@(RelationAtomType attrs1) y@(RelationAtomType attrs2) = do
25 _ <- mapM (\(attr1,attr2) -> let name1 = A.attributeName attr1
26 name2 = A.attributeName attr2 in
27 if notElem "_" [name1, name2] && name1 /= name2 then
28 Left $ AtomTypeMismatchError x y
29 else
30 atomTypeVerify (A.atomType attr1) (A.atomType attr2)) $ V.toList (V.zip attrs1 attrs2)
31 return x
32atomTypeVerify x y = if x == y then
33 Right x
34 else
35 Left $ AtomTypeMismatchError x y