LiteralFuns.hs revision f3a94a197960e548ecd6520bb768cb0d547457bb
fd896e2068ad7e50aed66ac18c3720ea7ff2619fChristian MaederModule : $Header$
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerCopyright : (c) Klaus L�ttich and Uni Bremen 2002-2003
5e874259af7e1161240c70c3d2ed33e86c7da167Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuMaintainer : luettich@tzi.de
fd896e2068ad7e50aed66ac18c3720ea7ff2619fChristian MaederStability : experimental
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederPortability : portable
fd896e2068ad7e50aed66ac18c3720ea7ff2619fChristian Maederfunctions to test ids with argument terms for literals of CASL
1711f9cf0aa5b0564a0b5aa5e331e51e4c1b1a4cChristian Maedermodule CASL.LiteralFuns ( isLiteral
a669e4685b32ff5ca1bca785eacc5e30a545b010Christian Maeder , isSignedNumber
34b55522ba6fe2601e4ee37a9ba1fc4b1a0bf50bChristian Maeder , collectElements
dea4c92f0c061d589c542d0640a18dab36dfbb46Christian Maeder , convCASLChar
7221c71b38c871ce66eee4537cb681d468308dfbChristian Maederimport Data.Char (isDigit)
43a582fe35884e2c6f455e7bfa34f0f4ef8dfe2eChristian MaederisLiteral :: GlobalAnnos -> Id -> [TERM f] -> Bool
ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian MaederisLiteral ga i trm =
43a582fe35884e2c6f455e7bfa34f0f4ef8dfe2eChristian Maeder or [ isNumber ga i trm
17388303189780ad2e579c56547bf1a849d3666bChristian Maeder , isString ga i trm
17388303189780ad2e579c56547bf1a849d3666bChristian Maeder , isList ga i trm
1711f9cf0aa5b0564a0b5aa5e331e51e4c1b1a4cChristian Maeder , isFloat ga i trm
e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maeder , isFrac ga i trm
6d23c6f8a099ab258a28e44a721ac32cb0877e9eChristian MaederisNumber :: GlobalAnnos -> Id -> [TERM f] -> Bool
05ca76b03b6d16bcfb3e7654c31e41a220e85663Till MossakowskiisNumber ga i trs =
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian Maeder (digitTest i && null trs)
602041e384342ea908c976a298e8b47774d3500cTill Mossakowski || (getLiteralType ga i == Number && all (sameId digitTest i) trs)
602041e384342ea908c976a298e8b47774d3500cTill Mossakowski where digitTest ii =
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian Maeder (getLiteralType ga ii == Number) || case ii of
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian Maeder | not $ null tstr -> isDigit $ head $ tstr
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian Maeder | otherwise -> False
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian Maeder where tstr = tokStr t
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian MaederisSignedNumber :: GlobalAnnos -> Id -> [TERM f] -> Bool
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian MaederisSignedNumber ga i trs = length trs == 1 &&
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian Maeder isSign i && isNumber ga ni nt && isAppl hd
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian Maeder where hd = head trs
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian Maeder (ni,nt) = splitAppl hd
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian MaederisSign :: Id -> Bool
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian MaederisSign i = case i of
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian Maeder Id [tok] [] _ -> let ts = tokStr tok
70dd17fd1ceb698d8bac709c56ceb60efe95e264Christian Maeder in ts == "-" || ts == "+"
967e5f3c25249c779575864692935627004d3f9eChristian MaederisString :: GlobalAnnos -> Id -> [TERM f] -> Bool
e16b3696b2c173aac14200321868ed81b8f7dc69Christian MaederisString ga i trs = case getLiteralType ga i of
e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maeder StringNull -> null trs
e16b3696b2c173aac14200321868ed81b8f7dc69Christian Maeder StringCons _ -> all (sameId stringTest i) trs
a65c6747c9acbbebc93baba7bae94d2e3d8cdafbTill Mossakowski stringTest ii = case getLiteralType ga ii of
8d97ef4f234681b11bb5924bd4d03adef858d2d2Christian Maeder StringNull -> True
3998bf8fd1b236d1a936b4a01688c3d9e1d49e05Christian Maeder _ -> case ii of
50895dae7d9849df2dc922651d93bbc6aa5529c1Christian Maeder Id [t] [] _ -> take 1 (tokStr t) == "\'"
1711f9cf0aa5b0564a0b5aa5e331e51e4c1b1a4cChristian MaederconvCASLChar :: Token -> String
4c7f058cdd19ce67b2b5d4b7f69703d0f8a21e38Christian MaederconvCASLChar t = case tokStr t of
2faad0c99d17a6ef53a464864caccbb20cf48409Christian Maeder cs | not (null cs) && head cs == '\''
a23e572c8f957cc051a1b0831abd6fe9380d45c7Christian Maeder && last cs == '\'' -> init $ tail cs
2faad0c99d17a6ef53a464864caccbb20cf48409Christian Maeder | otherwise ->
2faad0c99d17a6ef53a464864caccbb20cf48409Christian Maeder error ("convCASLChar: " ++ cs ++
2faad0c99d17a6ef53a464864caccbb20cf48409Christian Maeder " is not a valid CASL Char")
1711f9cf0aa5b0564a0b5aa5e331e51e4c1b1a4cChristian MaederisList :: GlobalAnnos -> Id -> [TERM f] -> Bool
cd6e5706893519bfcf24539afa252fcbed5097ddKlaus LuettichisList ga i trms = -- trace ("isList: "++show i++"; "++show trms) $
e7ce154edb906685b3fa7f6c0a764e18a4658068Christian Maeder (case getLiteralType ga i of
af47051acb16b97b6bc0ff7295cae44eed87d63eChristian Maeder ListNull _ -> null trms
e13ee09381f136f5eadaabdb9699773c0052cf3dChristian Maeder ListCons _ n -> listTest n i trms
4b338e9d8a4e0bffb4d1bc6fb5fa371a8a0dec1aTill Mossakowski where listTest n1 i1 terms = case getLiteralType ga i1 of
fefdf8f5a314d2999934b4ad40035ac062ebcaa1Till Mossakowski ListNull _ -> n1 == i1 && null terms
7d228ff8072e039be1f7b9630fee712733a80334Christian Maeder ListCons _ n2 -> n1 == n2 && length terms == 2 &&
34b55522ba6fe2601e4ee37a9ba1fc4b1a0bf50bChristian Maeder let hd = head $ tail terms
4b338e9d8a4e0bffb4d1bc6fb5fa371a8a0dec1aTill Mossakowski (i2, ts) = splitAppl hd
1711f9cf0aa5b0564a0b5aa5e331e51e4c1b1a4cChristian Maeder in isAppl hd && listTest n1 i2 ts
8d97ef4f234681b11bb5924bd4d03adef858d2d2Christian MaederisFloat :: GlobalAnnos -> Id -> [TERM f] -> Bool
8d97ef4f234681b11bb5924bd4d03adef858d2d2Christian MaederisFloat ga i [l, r] =
462ec4b2fa3e0e788eb60dcb4aebc518298f342cChristian Maeder case getLiteralType ga i of
8d97ef4f234681b11bb5924bd4d03adef858d2d2Christian Maeder Floating -> (isNumber ga li ltrm || isFrac ga li ltrm)
ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian Maeder && isAppl l && isAppl r
a8f87ac3a544ad741961b3ae494c729877203ebeChristian Maeder && (isSignedNumber ga ri rtrm || isNumber ga ri rtrm)
7221c71b38c871ce66eee4537cb681d468308dfbChristian Maeder where (li,ltrm) = splitAppl l
7221c71b38c871ce66eee4537cb681d468308dfbChristian Maeder (ri,rtrm) = splitAppl r
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian MaederisFloat _ _ _ = False
a7be28e157e9ceeec73a8fd0e642c36ea29d4218Christian MaederisFrac :: GlobalAnnos -> Id -> [TERM f] -> Bool
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederisFrac ga i [l, r] =
7221c71b38c871ce66eee4537cb681d468308dfbChristian Maeder case getLiteralType ga i of
096b050a106eefe1093eb7659e4924b1d7850aa4Christian Maeder Fraction -> isAppl l && isAppl r
9b51fc5528c4d34260d97763fb59f427c3c7a63aTill Mossakowski && isNumber ga li ltrm && isNumber ga ri rtrm
d4146229cf85928342dfd25ec8b579a7feb0d381Christian Maeder where (li,ltrm) = splitAppl l
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian Maeder (ri,rtrm) = splitAppl r
01aafb6a9520f05df5ff467b591ecb5474dcfc86Christian MaederisFrac _ _ _ = False
997c56f3bc74a703043010978e5013fdb074d659Christian MaederisAppl :: TERM f -> Bool
ee9eddfa6953868fd6fbaff0d9ff68675a13675aChristian MaederisAppl t = case t of
686c1a3e19c6c174c79037b40cbc1c0aaaf81c45Christian Maeder Application (Op_name _) _ _ -> True
7c2d602a73afe304ac0ca225ecff42b2ae8bdab3Christian MaedersplitAppl :: TERM f -> (Id,[TERM f])
33f182295dff677471ceaba5d565ce38f5a34f34Sonja GröningsplitAppl t = case t of
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder Application oi ts _ -> (op_id oi,ts)
4ef5e33657aae95850b7e6941f67ac1fb73cd13fChristian Maeder _ -> error "splitAppl: no Application found"
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian MaederleftAssCollElems :: Id -> [TERM f] -> [TERM f]
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian MaederleftAssCollElems i trs =
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder [] -> error "no elements to collect"
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder [x,y] -> leftAssCollElems i (splitA x) ++ [y]
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder _ys -> error "too many elements to collect"
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder where splitA t = case t of
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder Application oi its _
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder | op_id oi == i -> its
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder | otherwise -> [t]
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder _ -> error "splitA: no Appl found (left)"
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian MaedercollectElements :: (Maybe Id) -> Id -> [TERM f] -> [TERM f]
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian MaedercollectElements mnid i trs =
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder if detect_left_ass i trs
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder then leftAssCollElems i trs
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder else collectElementsRight mnid i trs
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maederdetect_left_ass :: Id -> [TERM f] -> Bool
5e874259af7e1161240c70c3d2ed33e86c7da167Christian Maederdetect_left_ass i trs =
5e874259af7e1161240c70c3d2ed33e86c7da167Christian Maeder [x,_] -> case x of
5e874259af7e1161240c70c3d2ed33e86c7da167Christian Maeder Application oi _ _ -> op_id oi == i
5e874259af7e1161240c70c3d2ed33e86c7da167Christian MaedercollectElementsRight :: (Maybe Id) -> Id -> [TERM f] -> [TERM f]
5e874259af7e1161240c70c3d2ed33e86c7da167Christian MaedercollectElementsRight mnid i trs =
5e874259af7e1161240c70c3d2ed33e86c7da167Christian Maeder [] -> error "no elements to collect"
5e874259af7e1161240c70c3d2ed33e86c7da167Christian Maeder [x] -> getToken x
5e874259af7e1161240c70c3d2ed33e86c7da167Christian Maeder [x,y] -> x : collectElementsRight mnid i (splitA y)
5e874259af7e1161240c70c3d2ed33e86c7da167Christian Maeder _ys -> error "too many elements to collect"
5e874259af7e1161240c70c3d2ed33e86c7da167Christian Maeder where splitA t = case t of
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder Application oi its _
7c2d602a73afe304ac0ca225ecff42b2ae8bdab3Christian Maeder | op_id oi == i -> its
e7ce154edb906685b3fa7f6c0a764e18a4658068Christian Maeder | otherwise -> [t]
8d97ef4f234681b11bb5924bd4d03adef858d2d2Christian Maeder _ -> error "splitA: no Appl found (right)"
fd896e2068ad7e50aed66ac18c3720ea7ff2619fChristian Maeder getToken :: TERM f -> [TERM f]
7cee561116562e8ba231fd45d6066c0a97abf243Christian Maeder getToken trm = maybe [trm]
cdcf5d3f1e79d8798d77efa29e6193af94ea0604Till Mossakowski (\ nid -> case trm of
b1f59a4ea7c96f4c03a4d7cfcb9c5e66871cfbbbChristian Maeder Application oid [] _
cd6e5706893519bfcf24539afa252fcbed5097ddKlaus Luettich | op_id oid == nid -> []
| null its -> test $ op_id o -- digits i.e.