ConvertLiteral.hs revision 33faa3cc2e40834141817a5c95b1d1ba2a58313c
9658657e918981d91c8647ed8c220464f10a6235Christian MaederModule : $Header$
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederCopyright : Christian Maeder and Uni Bremen 2004
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuMaintainer : maeder@tzi.de
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederStability : experimental
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederPortability : portable
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedergenerically converting literals
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (convertMixfixToken
bdeddba30d29f413af1e1ae6b6bab275c017bd98Christian Maeder , isGenLiteral
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , isGenNumber
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder , isGenSignedNumber
ae35311385999d91f812155fe99439724d54063bChristian Maeder , isGenString
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederimport Data.Char (isDigit)
38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder-- * convert a literal to a term
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertype AsAppl a = Id -> [a] -> Range -> a
411392046c2ba1752cde81eaa92a95a2c28b672dChristian Maederinc :: Int -> Range -> Range
f8cc2399c16fcda7e3bf9d901a0de0cc8a455f86Ewaryst Schulzinc n (Range p) =
78e7910c3360f74f1db172d63d20bb07c64e56e3Christian Maeder Range (map (flip incSourceColumn n) p)
46b207daf66b64930a59f3615c8b127aac0b8e43Christian MaedermakeStringTerm :: Id -> Id -> AsAppl a -> Token -> a
46b1095ba983ce859e17c2a12f48b50583b7150cChristian MaedermakeStringTerm c f asAppl tok =
46b1095ba983ce859e17c2a12f48b50583b7150cChristian Maeder makeStrTerm (inc 1 sp) str
c8a9d35be2207e0d4fbd26a2411e1ba17e3e4c96Christian Maeder sp = tokPos tok
c2257f94016aeb9e5c3ff3d4d675a81f8f873f0dChristian Maeder str = init (tail (tokStr tok))
3986813db69106b9bb1b62faa77532af42512a0cChristian Maeder makeStrTerm p l =
3986813db69106b9bb1b62faa77532af42512a0cChristian Maeder if null l then asAppl c [] p
3986813db69106b9bb1b62faa77532af42512a0cChristian Maeder else let (hd, tl) = splitString caslChar l
596a8e9039bd2f42c09cc0da4a57c8073f96fbddChristian Maeder in asAppl f [asAppl (Id [Token ("'" ++ hd ++ "'") p]
596a8e9039bd2f42c09cc0da4a57c8073f96fbddChristian Maeder [] nullRange) [] p,
596a8e9039bd2f42c09cc0da4a57c8073f96fbddChristian Maeder makeStrTerm (inc (length hd) p) tl] p
e982190515f83fe6615436530ebe89bb320770d6Christian MaedermakeNumberTerm :: Id -> AsAppl a -> Token -> a
ab9b86500ed66416e1a7c01be54491ed72c7d633Christian MaedermakeNumberTerm f asAppl t@(Token n p) =
08d506ebb78da1e8656a73a349492e042f4c9f72Christian Maeder [] -> error "makeNumberTerm"
d27d203b3f42f0e0ecea00e3f19f55f66045bd96Christian Maeder [_] -> asAppl (Id [t] [] nullRange) [] p
46b1095ba983ce859e17c2a12f48b50583b7150cChristian Maeder hd:tl -> asAppl f [asAppl (Id [Token [hd] p] [] nullRange) [] p,
38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder makeNumberTerm f asAppl (Token tl
38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder $ inc 1 p)] p
ec351e60425e2f99448cb44e933d3828f8025dddChristian MaedermakeFraction :: Id -> Id -> AsAppl a -> Token -> a
56440c7ae61e7277a3494452d0165ee52e677b29Christian MaedermakeFraction f d asAppl t@(Token s p) =
56440c7ae61e7277a3494452d0165ee52e677b29Christian Maeder let (n, r) = span (\c -> c /= '.') s
ec351e60425e2f99448cb44e933d3828f8025dddChristian Maeder dotOffset = length n
ec351e60425e2f99448cb44e933d3828f8025dddChristian Maeder in if null r then makeNumberTerm f asAppl t
56440c7ae61e7277a3494452d0165ee52e677b29Christian Maeder else asAppl d [makeNumberTerm f asAppl (Token n p),
9603ad7198b72e812688ad7970e4eac4b553837aKlaus Luettich makeNumberTerm f asAppl $ Token (tail r)
1842453990fed8a1bd7a5ac792d7982c1d2bfcd5Christian Maeder $ inc (dotOffset + 1) p]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder $ inc dotOffset p
0b73fd9cab131c1b25b542007c98b5f8717b1d36Klaus LuettichmakeSignedNumber :: Id -> AsAppl a -> Token -> a
9f08800df9da91d444560875167fbf7acb8396edChristian MaedermakeSignedNumber f asAppl t@(Token n p) =
ec25781c1180ea07f66b48c34f93cf5634e9277cChristian Maeder [] -> error "makeSignedNumber"
64c2422e1ba0691556a6639e959820add102315cChristian Maeder if hd == '-' || hd == '+' then
938677803842b384a91fef21f58f86b8e3188b43Ewaryst Schulz asAppl (Id [Token [hd] p] [] nullRange)
4c8d3c5a9e938633f6147b5a595b9b93bfca99e6Christian Maeder [makeNumberTerm f asAppl $ Token tl
63da71bfb4226f504944b293fb77177ebcaea7d4Ewaryst Schulz else makeNumberTerm f asAppl t
f8cc2399c16fcda7e3bf9d901a0de0cc8a455f86Ewaryst SchulzmakeFloatTerm :: Id -> Id -> Id -> AsAppl a -> Token -> a
b83ff3749d99d03b641adee264b781039a551addChristian MaedermakeFloatTerm f d e asAppl t@(Token s p) =
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder let (m, r) = span (\c -> c /= 'E') s
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder offset = length m
520c5bce318eff52d9315f7c4491c3381a0c4336Christian Maeder in if null r then makeFraction f d asAppl t
c2257f94016aeb9e5c3ff3d4d675a81f8f873f0dChristian Maeder else asAppl e [makeFraction f d asAppl (Token m p),
0850c3e5fb6285405ebaeb5aa433985203ac892dEwaryst Schulz makeSignedNumber f asAppl $ Token (tail r)
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulz $ inc (offset + 1) p]
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulz $ inc offset p
0850c3e5fb6285405ebaeb5aa433985203ac892dEwaryst Schulz-- | convert a literal token to an application term
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst SchulzconvertMixfixToken :: LiteralAnnos -> AsAppl a
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulz -> (Token -> a) -> Token -> ([Diagnosis], a)
938677803842b384a91fef21f58f86b8e3188b43Ewaryst SchulzconvertMixfixToken ga asAppl toTerm t =
0850c3e5fb6285405ebaeb5aa433985203ac892dEwaryst Schulz if isString t then
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder case string_lit ga of
4067eba4f5605d9569d78085deb1a27f08ac34e2Christian Maeder Nothing -> err "string"
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder Just (c, f) -> ([], makeStringTerm c f asAppl t)
bbba6dd86153aacb0f662b182b128df0eb09fd54Christian Maeder else if isNumber t then
bbba6dd86153aacb0f662b182b128df0eb09fd54Christian Maeder case number_lit ga of
4067eba4f5605d9569d78085deb1a27f08ac34e2Christian Maeder Nothing -> err "number"
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder Just f -> if isFloating t then
a43c1a7fa08c12524415386aa13a566cc9e53a4fChristian Maeder case float_lit ga of
a43c1a7fa08c12524415386aa13a566cc9e53a4fChristian Maeder Nothing -> err "floating"
72079df98b3cb7cc1fd82a0a24984893dcd05ecaEwaryst Schulz Just (d, e) -> ([], makeFloatTerm f d e asAppl t)
5ca1fe655d7d4e35e59a082b5955b306643329d0Ewaryst Schulz else ([], makeNumberTerm f asAppl t)
5f2c34b8971f9ca7e63364b69e167851d001168eEwaryst Schulz else ([], te)
5f2c34b8971f9ca7e63364b69e167851d001168eEwaryst Schulz where te = toTerm t
bdf2e01977470bedcb4425e2dadabc9e9f6ba149Ewaryst Schulz err s = ([Diag Error ("missing %" ++ s ++ " annotation") (tokPos t)]
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder-- * test if term is a literal
ce900a84ed9d9882c64fccbd6300f6b0d67efa82Christian Maedertype Split a = a -> Maybe (Id, [a])
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian MaederisGenLiteral :: Split a -> GlobalAnnos -> Id -> [a] -> Bool
4067eba4f5605d9569d78085deb1a27f08ac34e2Christian MaederisGenLiteral splt ga i trm =
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder or [ isGenNumber splt ga i trm
53e165a53dfa59f717588d1f8236c9a763826525Christian Maeder , isGenString splt ga i trm
53e165a53dfa59f717588d1f8236c9a763826525Christian Maeder , isGenList splt ga i trm
1937dccb04b363364f7a7de17fdaae1d70583af9Christian Maeder , isGenFloat splt ga i trm
53e165a53dfa59f717588d1f8236c9a763826525Christian Maeder , isGenFrac splt ga i trm
4067eba4f5605d9569d78085deb1a27f08ac34e2Christian MaederisGenNumber :: Split a -> GlobalAnnos -> Id -> [a] -> Bool
08d506ebb78da1e8656a73a349492e042f4c9f72Christian MaederisGenNumber splt ga i trs =
08d506ebb78da1e8656a73a349492e042f4c9f72Christian Maeder (digitTest i && null trs)
f6b2c6c33c635279973b8f378470da7dbb8ecee8Christian Maeder || (getLiteralType ga i == Number && all (sameId splt digitTest i) trs)
d27d203b3f42f0e0ecea00e3f19f55f66045bd96Christian Maeder where digitTest ii =
d27d203b3f42f0e0ecea00e3f19f55f66045bd96Christian Maeder (getLiteralType ga ii == Number) || case ii of
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder | not $ null tstr -> isDigit $ head $ tstr
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder | otherwise -> False
4067eba4f5605d9569d78085deb1a27f08ac34e2Christian Maeder where tstr = tokStr t
e6ac593966607b1da5b619e0f9492d37820eed74Christian MaederisGenSignedNumber :: Split a -> GlobalAnnos -> Id -> [a] -> Bool
f6b2c6c33c635279973b8f378470da7dbb8ecee8Christian MaederisGenSignedNumber splt ga i trs =
e6ac593966607b1da5b619e0f9492d37820eed74Christian Maeder [hd] -> case splt hd of
f6b2c6c33c635279973b8f378470da7dbb8ecee8Christian Maeder Just (ni, nt) -> isSign i && isGenNumber splt ga ni nt
f6b2c6c33c635279973b8f378470da7dbb8ecee8Christian Maeder Nothing -> False
f6b2c6c33c635279973b8f378470da7dbb8ecee8Christian MaederisSign :: Id -> Bool
e6ac593966607b1da5b619e0f9492d37820eed74Christian MaederisSign i = case i of
e6ac593966607b1da5b619e0f9492d37820eed74Christian Maeder Id [tok] [] _ -> let ts = tokStr tok
e6ac593966607b1da5b619e0f9492d37820eed74Christian Maeder in ts == "-" || ts == "+"
ab9b86500ed66416e1a7c01be54491ed72c7d633Christian MaederisGenString :: Split a -> GlobalAnnos -> Id -> [a] -> Bool
ab9b86500ed66416e1a7c01be54491ed72c7d633Christian MaederisGenString splt ga i trs = case getLiteralType ga i of
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder StringNull -> null trs
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder StringCons _ -> all (sameId splt stringTest i) trs
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder stringTest ii = case getLiteralType ga ii of
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder StringNull -> True
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder _ -> case ii of
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder Id [t] [] _ -> take 1 (tokStr t) == "\'"
ab9b86500ed66416e1a7c01be54491ed72c7d633Christian MaederisGenList :: Split a -> GlobalAnnos -> Id -> [a] -> Bool
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian MaederisGenList splt ga i trms =
4067eba4f5605d9569d78085deb1a27f08ac34e2Christian Maeder (case getLiteralType ga i of
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder ListNull _ -> null trms
1bc5dccbf0083a620ae1181c717fea75e4af5e5cChristian Maeder ListCons _ n -> listTest n i trms
5382091fd2a705e6f026026e8a6adcd3607bdb9fChristian Maeder where listTest n1 i1 terms = case getLiteralType ga i1 of
38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder ListNull _ -> n1 == i1 && null terms
4067eba4f5605d9569d78085deb1a27f08ac34e2Christian Maeder ListCons _ n2 -> n1 == n2 && case terms of
e6ac593966607b1da5b619e0f9492d37820eed74Christian Maeder [_, hd] -> case splt hd of
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder Just (i2, ts) -> listTest n1 i2 ts
63719301448519453f66383f4e583d9fd5b89ecbChristian Maeder Nothing -> False
63719301448519453f66383f4e583d9fd5b89ecbChristian MaederisGenFloat :: Split a -> GlobalAnnos -> Id -> [a] -> Bool
25662bf82f592e3268fddcc2c86e83c203b82e53Ewaryst SchulzisGenFloat splt ga i [l, r] =
38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder case getLiteralType ga i of
154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu Floating -> case (splt l, splt r) of
154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu (Just (li, ltrm), Just (ri, rtrm)) ->
25662bf82f592e3268fddcc2c86e83c203b82e53Ewaryst Schulz (isGenNumber splt ga li ltrm || isGenFrac splt ga li ltrm) &&
21489db35f79507a68ee6e6926e01b8e8ea60c6bChristian Maeder (isGenSignedNumber splt ga ri rtrm || isGenNumber splt ga ri rtrm)
63719301448519453f66383f4e583d9fd5b89ecbChristian MaederisGenFloat _ _ _ _ = False
25662bf82f592e3268fddcc2c86e83c203b82e53Ewaryst SchulzisGenFrac :: Split a -> GlobalAnnos -> Id -> [a] -> Bool
154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai CodescuisGenFrac splt ga i [l, r] =
154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu case getLiteralType ga i of
7fe976d9f9c4af1aa7636c568d9919859523de0aChristian Maeder Fraction -> case (splt l, splt r) of
154be5bfac61cf5b61fd1571e7bfc2572c4b546aMihai Codescu (Just (li, ltrm), Just (ri, rtrm)) ->
4067eba4f5605d9569d78085deb1a27f08ac34e2Christian Maeder isGenNumber splt ga li ltrm && isGenNumber splt ga ri rtrm
63719301448519453f66383f4e583d9fd5b89ecbChristian MaederisGenFrac _ _ _ _ = False
4067eba4f5605d9569d78085deb1a27f08ac34e2Christian MaedersameId :: Split a -> (Id -> Bool) -> Id -> a -> Bool
38824a7dba4f7d82532afec67e0b594a5af5d76bChristian MaedersameId splt test i t = case splt t of
38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder Just (j, ts) -> if null ts then test j
38824a7dba4f7d82532afec67e0b594a5af5d76bChristian Maeder else j == i && all (sameId splt test i) ts