ConvertLiteral.hs revision 42c01284bba8d7c8d995c8dfb96ace57d28ed1bc
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederModule : $Header$
5ba323da9f037264b4a356085e844889aedeac23Christian MaederCopyright : Christian Maeder and Uni Bremen 2004
c58a94c44b76b072ace930f2126c889c0b64cb2aChristian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
ea03c5d09694b4a966fbd19d46cfa5772648d95fChristian MaederMaintainer : maeder@tzi.de
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederStability : experimental
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian MaederPortability : portable
4b0a4c7dea0f67a233dcc42ce9bb18d36de109aeChristian Maederconverting literals
ad270004874ce1d0697fb30d7309f180553bb315Christian Maedertype AsAppl a = Id -> [a] -> Range -> a
afa6848d579d235c9677e1ab477916df8e5ae11aChristian Maederinc :: Int -> Range -> Range
dc6b48bb46df8e56da3491c98476e6da0d1d5d1dChristian Maederinc n (Range p) =
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder Range (map (incPos n) p)
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder incPos n p = incSourceColumn p n
9348e8460498ddfcd9da11cd8b5794c06023e004Christian MaedermakeStringTerm :: Id -> Id -> AsAppl a -> Token -> a
fd5d3885a092ac0727fa2436cdfc3b248318ebd8Christian MaedermakeStringTerm c f asAppl tok =
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder makeStrTerm (inc 1 sp) str
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder sp = tokPos tok
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder str = init (tail (tokStr tok))
16e124196c6b204769042028c74f533509c9b5d3Christian Maeder makeStrTerm p l =
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian Maeder if null l then asAppl c [] p
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder else let (hd, tl) = splitString caslChar l
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder in asAppl f [asAppl (Id [Token ("'" ++ hd ++ "'") p] [] nullRange) [] p,
c00adad2e9459b422dee09e3a2bddba66b433bb7Christian Maeder makeStrTerm (inc (length hd) p) tl] p
502ed7ed7fecd10b6d0c83cdd48a244ec45e840aChristian MaedermakeNumberTerm :: Id -> AsAppl a -> Token -> a
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian MaedermakeNumberTerm f asAppl t@(Token n p) =
fd5d3885a092ac0727fa2436cdfc3b248318ebd8Christian Maeder [] -> error "makeNumberTerm"
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder [_] -> asAppl (Id [t] [] nullRange) [] p
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder hd:tl -> asAppl f [asAppl (Id [Token [hd] p] [] nullRange) [] p,
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder makeNumberTerm f asAppl (Token tl
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder $ inc 1 p)] p
23f8d286586ff38a9e73052b2c7c04c62c5c638fChristian MaedermakeFraction :: Id -> Id -> AsAppl a -> Token -> a
9348e8460498ddfcd9da11cd8b5794c06023e004Christian MaedermakeFraction f d asAppl t@(Token s p) =
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder let (n, r) = span (\c -> c /= '.') s
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder dotOffset = length n
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder in if null r then makeNumberTerm f asAppl t
23f8d286586ff38a9e73052b2c7c04c62c5c638fChristian Maeder else asAppl d [makeNumberTerm f asAppl (Token n p),
4561227a776bdf0ab679b19fb92f1eaaed8786f7Christian Maeder makeNumberTerm f asAppl $ Token (tail r)
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder $ inc (dotOffset + 1) p]
aff01ee50b66032469c232e00c945d1fd4f57d1bChristian Maeder $ inc dotOffset p
54ff63bb3b23ef18efbdc51b053a2ca6f348329aChristian MaedermakeSignedNumber :: Id -> AsAppl a -> Token -> a
54ff63bb3b23ef18efbdc51b053a2ca6f348329aChristian MaedermakeSignedNumber f asAppl t@(Token n p) =
54ff63bb3b23ef18efbdc51b053a2ca6f348329aChristian Maeder [] -> error "makeSignedNumber"
f454c20b6c126bea7d31d400cc8824b9ee8cc6eaChristian Maeder if hd == '-' || hd == '+' then
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder asAppl (Id [Token [hd] p] [] nullRange)
e1839fb37a3a2ccd457464cb0dcc5efd466dbe22Christian Maeder [makeNumberTerm f asAppl $ Token tl
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder else makeNumberTerm f asAppl t
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedermakeFloatTerm :: Id -> Id -> Id -> AsAppl a -> Token -> a
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian MaedermakeFloatTerm f d e asAppl t@(Token s p) =
27912d626bf179b82fcb337077e5cd9653bb71cfChristian Maeder let (m, r) = span (\c -> c /= 'E') s
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder offset = length m
cf3232cec840a6945667bdb06f5b47b22243bc8fChristian Maeder in if null r then makeFraction f d asAppl t
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder else asAppl e [makeFraction f d asAppl (Token m p),
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder makeSignedNumber f asAppl $ Token (tail r)
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder $ inc (offset + 1) p]
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder $ inc offset p
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder-- analyse Mixfix_token
5ba323da9f037264b4a356085e844889aedeac23Christian MaederconvertMixfixToken :: LiteralAnnos -> AsAppl a
5ba323da9f037264b4a356085e844889aedeac23Christian Maeder -> (Token -> a) -> Token -> ([Diagnosis], a)
5ba323da9f037264b4a356085e844889aedeac23Christian MaederconvertMixfixToken ga asAppl toTerm t =
16e124196c6b204769042028c74f533509c9b5d3Christian Maeder if isString t then
16e124196c6b204769042028c74f533509c9b5d3Christian Maeder case string_lit ga of
16e124196c6b204769042028c74f533509c9b5d3Christian Maeder Nothing -> err "string"
16e124196c6b204769042028c74f533509c9b5d3Christian Maeder Just (c, f) -> ([], makeStringTerm c f asAppl t)
16e124196c6b204769042028c74f533509c9b5d3Christian Maeder else if isNumber t then
16e124196c6b204769042028c74f533509c9b5d3Christian Maeder case number_lit ga of
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder Nothing -> err "number"
0be2d0cfd911d313e7e941edbc77f95052c8c19bChristian Maeder Just f -> if isFloating t then
7de39d39bc1700cc8a9bb9df90b920aad9e18d4aChristian Maeder case float_lit ga of
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder Nothing -> err "floating"
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder Just (d, e) -> ([], makeFloatTerm f d e asAppl t)
1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder else ([], makeNumberTerm f asAppl t)
f26a1fc3851297e6483cf3fb56e9c0967b8f8b13Christian Maeder else ([], te)
1d589334ba6b4a4cbfb35307a7a732261e77b0cdChristian Maeder where te = toTerm t
9348e8460498ddfcd9da11cd8b5794c06023e004Christian Maeder err s = ([Diag Error ("missing %" ++ s ++ " annotation") (tokPos t)]