ConvertLiteral.hs revision c4838488bd0d0a5a5ffc7cd365d795095e89336f
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder{- |
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian MaederModule : $Header$
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian MaederCopyright : Christian Maeder and Uni Bremen 2004
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian MaederMaintainer : maeder@tzi.de
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian MaederStability : experimental
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian MaederPortability : portable
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maedergenerically converting literals
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder-}
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder
99b26e2ab8ba89bc9a050c1524137eb6269e2753Christian Maedermodule Common.ConvertLiteral
18548c6cc2dff13bf9f5f08b3f6cde6ca914df1dChristian Maeder (convertMixfixToken
92ae4d5885ea837ffe3dae9b2de742f871229b94Christian Maeder , AsAppl
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder , SplitM
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder , isGenNumber
ef1c24c8229ade3ac872febebd18c181e32fb9c4Christian Maeder , isGenString
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder , isGenList
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder , isGenFloat
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder , isGenFrac
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder , toNumber
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder , toFrac
99b26e2ab8ba89bc9a050c1524137eb6269e2753Christian Maeder , toFloat
736fe640b202e3fe7288fad8251d5b210c5d8d87Christian Maeder , toString
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder , getListElems
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder ) where
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maederimport Common.Id
e84c877ad38ce9312eab222a79f44da2015572d2Christian Maederimport Common.Lexer
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maederimport Common.GlobalAnnotations
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maederimport Common.Result
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maederimport Data.Char (isDigit)
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder
ef1c24c8229ade3ac872febebd18c181e32fb9c4Christian Maeder-- * convert a literal to a term
ef1c24c8229ade3ac872febebd18c181e32fb9c4Christian Maeder
945e82ed7877917f3ab1657f555e71991372546aChristian Maedertype AsAppl a = Id -> [a] -> Range -> a
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maeder
c208973c890b8f993297720fd0247bc7481d4304Christian Maederinc :: Int -> Range -> Range
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maederinc n (Range p) =
ef1c24c8229ade3ac872febebd18c181e32fb9c4Christian Maeder Range (map (flip incSourceColumn n) p)
ef1c24c8229ade3ac872febebd18c181e32fb9c4Christian Maeder
7c99a6c982aaf61547de8054296c8055c8d1a13aSimon UlbrichtmakeStringTerm :: Id -> Id -> AsAppl a -> Token -> a
ef1c24c8229ade3ac872febebd18c181e32fb9c4Christian MaedermakeStringTerm c f asAppl tok =
d97700a22b2585ece83b05f3fff945fdfd0c44b4Christian Maeder makeStrTerm (inc 1 sp) str
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maeder where
ea5ccb1c6e89486a54e1f4bd95840147e96093edChristian Maeder sp = tokPos tok
de8eee2014437ec4020be15cd363257f87e79943Christian Maeder str = init (tail (tokStr tok))
ea5ccb1c6e89486a54e1f4bd95840147e96093edChristian Maeder makeStrTerm p l =
fd94a6f66ccb5cef99aa42069b61e4b8734dbd3fChristian Maeder if null l then asAppl c [] p
fd94a6f66ccb5cef99aa42069b61e4b8734dbd3fChristian Maeder else let (hd, tl) = splitString caslChar l
fd94a6f66ccb5cef99aa42069b61e4b8734dbd3fChristian Maeder in asAppl f [asAppl (Id [Token ("'" ++ hd ++ "'") p]
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maeder [] nullRange) [] p,
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maeder makeStrTerm (inc (length hd) p) tl] p
473f5af6e4803fbeecc814065952396f2501039bChristian Maeder
473f5af6e4803fbeecc814065952396f2501039bChristian MaedermakeNumberTerm :: Id -> AsAppl a -> Token -> a
473f5af6e4803fbeecc814065952396f2501039bChristian MaedermakeNumberTerm f asAppl t@(Token n p) =
473f5af6e4803fbeecc814065952396f2501039bChristian Maeder case n of
473f5af6e4803fbeecc814065952396f2501039bChristian Maeder [] -> error "makeNumberTerm"
473f5af6e4803fbeecc814065952396f2501039bChristian Maeder [_] -> asAppl (Id [t] [] nullRange) [] p
6a88f8edd881afaf4b865b01bfbb4faaf0e7a3c9Simon Ulbricht hd:tl -> asAppl f [asAppl (Id [Token [hd] p] [] nullRange) [] p,
473f5af6e4803fbeecc814065952396f2501039bChristian Maeder makeNumberTerm f asAppl (Token tl
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maeder $ inc 1 p)] p
844c7d2ec3917393e139e53503757098d568713eSimon Ulbricht
275698320a734a6fd647ea6a461d6ce38862da1dChristian MaedermakeFraction :: Id -> Id -> AsAppl a -> Token -> a
734a5ebd38032798f0ab908e2d52862c71b2c127Simon UlbrichtmakeFraction f d asAppl t@(Token s p) =
ea5ccb1c6e89486a54e1f4bd95840147e96093edChristian Maeder let (n, r) = span (\c -> c /= '.') s
c99b0eb6632087d502dd4269599c5aa68a148eebSimon Ulbricht dotOffset = length n
c99b0eb6632087d502dd4269599c5aa68a148eebSimon Ulbricht in if null r then makeNumberTerm f asAppl t
b99c9606f2faafeabb3fa8c596992143a561c787Simon Ulbricht else asAppl d [makeNumberTerm f asAppl (Token n p),
2e76bbbed1c936bb0aee1753837e1c50416847a2Simon Ulbricht makeNumberTerm f asAppl $ Token (tail r)
df67ddf64192bfcae6ece65255ad796a17cbe532Christian Maeder $ inc (dotOffset + 1) p]
3e87e1dc85fa76cc6eaeb8eafbc0bea77af939f4Christian Maeder $ inc dotOffset p
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maeder
275698320a734a6fd647ea6a461d6ce38862da1dChristian MaedermakeSignedNumber :: Id -> AsAppl a -> Token -> a
526e7f36639cb58e3c99a54bea082499a6b04a25Christian MaedermakeSignedNumber f asAppl t@(Token n p) =
473f5af6e4803fbeecc814065952396f2501039bChristian Maeder case n of
f675b8f0a612e37472640da57b48d795bef4427eChristian Maeder [] -> error "makeSignedNumber"
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maeder hd:tl ->
526e7f36639cb58e3c99a54bea082499a6b04a25Christian Maeder if hd == '-' || hd == '+' then
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maeder asAppl (Id [Token [hd] p] [] nullRange)
18548c6cc2dff13bf9f5f08b3f6cde6ca914df1dChristian Maeder [makeNumberTerm f asAppl $ Token tl
dae8246f1f55b6a85e946fc1bfb6d32d556395f1Simon Ulbricht $ inc 1 p] p
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maeder else makeNumberTerm f asAppl t
18548c6cc2dff13bf9f5f08b3f6cde6ca914df1dChristian Maeder
6a6689ad6d4c70af2ce3389f39a50982f20fd939Christian MaedermakeFloatTerm :: Id -> Id -> Id -> AsAppl a -> Token -> a
f56cdf11927c31495bae642a9eb383212c90ba61Christian MaedermakeFloatTerm f d e asAppl t@(Token s p) =
7710f7c3425e45af11af124ff37bec27229d24f7Christian Maeder let (m, r) = span (\c -> c /= 'E') s
2e2559f894aaa661b199e4fa00609f522bc5482aSimon Ulbricht offset = length m
df67ddf64192bfcae6ece65255ad796a17cbe532Christian Maeder in if null r then makeFraction f d asAppl t
be1ce1c2b2819ef32743136c13101f1927375311Christian Maeder else asAppl e [makeFraction f d asAppl (Token m p),
6a6689ad6d4c70af2ce3389f39a50982f20fd939Christian Maeder makeSignedNumber f asAppl $ Token (tail r)
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maeder $ inc (offset + 1) p]
5896f38ba2934056542cb7cb3e6359e88a622547Christian Maeder $ inc offset p
526e7f36639cb58e3c99a54bea082499a6b04a25Christian Maeder
275698320a734a6fd647ea6a461d6ce38862da1dChristian Maeder-- | convert a literal token to an application term
526e7f36639cb58e3c99a54bea082499a6b04a25Christian MaederconvertMixfixToken :: LiteralAnnos -> AsAppl a
3e87e1dc85fa76cc6eaeb8eafbc0bea77af939f4Christian Maeder -> (Token -> a) -> Token -> ([Diagnosis], a)
275698320a734a6fd647ea6a461d6ce38862da1dChristian MaederconvertMixfixToken ga asAppl toTerm t =
6a6689ad6d4c70af2ce3389f39a50982f20fd939Christian Maeder if isString t then
6a6689ad6d4c70af2ce3389f39a50982f20fd939Christian Maeder case string_lit ga of
6a6689ad6d4c70af2ce3389f39a50982f20fd939Christian Maeder Nothing -> err "string"
5896f38ba2934056542cb7cb3e6359e88a622547Christian Maeder Just (c, f) -> ([], makeStringTerm c f asAppl t)
18548c6cc2dff13bf9f5f08b3f6cde6ca914df1dChristian Maeder else if isNumber t then
6a6689ad6d4c70af2ce3389f39a50982f20fd939Christian Maeder case number_lit ga of
5896f38ba2934056542cb7cb3e6359e88a622547Christian Maeder Nothing -> err "number"
5896f38ba2934056542cb7cb3e6359e88a622547Christian Maeder Just f -> if isFloating t then
5896f38ba2934056542cb7cb3e6359e88a622547Christian Maeder case float_lit ga of
5fb6343a5a2b4bbc67bc83479c84a92d23d30edfChristian Maeder Nothing -> err "floating"
18548c6cc2dff13bf9f5f08b3f6cde6ca914df1dChristian Maeder Just (d, e) -> ([], makeFloatTerm f d e asAppl t)
18548c6cc2dff13bf9f5f08b3f6cde6ca914df1dChristian Maeder else ([], makeNumberTerm f asAppl t)
5fb6343a5a2b4bbc67bc83479c84a92d23d30edfChristian Maeder else ([], te)
18548c6cc2dff13bf9f5f08b3f6cde6ca914df1dChristian Maeder where te = toTerm t
5fb6343a5a2b4bbc67bc83479c84a92d23d30edfChristian Maeder err s = ([Diag Error ("missing %" ++ s ++ " annotation") (tokPos t)]
6a6689ad6d4c70af2ce3389f39a50982f20fd939Christian Maeder , te)
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder
31a81edf1285dc338211bfe86ba50a1f4128d9d2Christian Maeder-- * test if term is a literal
31a81edf1285dc338211bfe86ba50a1f4128d9d2Christian Maeder
31a81edf1285dc338211bfe86ba50a1f4128d9d2Christian Maedertype SplitM a = a -> Maybe (Id, [a])
9d50556254571c0811e94b4d948463754812a5aaChristian Maeder
31a81edf1285dc338211bfe86ba50a1f4128d9d2Christian MaederisGenNumber :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
31a81edf1285dc338211bfe86ba50a1f4128d9d2Christian MaederisGenNumber splt ga i trs =
9d50556254571c0811e94b4d948463754812a5aaChristian Maeder (digitTest i && null trs)
18548c6cc2dff13bf9f5f08b3f6cde6ca914df1dChristian Maeder || (getLiteralType ga i == Number && all (sameId splt digitTest i) trs)
5dd895cd3d794ecd2f0035ee3a7b6d6bf2eac5efChristian Maeder where digitTest ii =
2f0ca8050a33fbc1a23c0bd2dec0d09c17e3c548Christian Maeder (getLiteralType ga ii == Number) || case ii of
ef1c24c8229ade3ac872febebd18c181e32fb9c4Christian Maeder Id [t] [] _
be2b58b496a13ec3380fc6c0da28d8660c4f39f0Christian Maeder | not $ null tstr -> isDigit $ head $ tstr
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder | otherwise -> False
2f0ca8050a33fbc1a23c0bd2dec0d09c17e3c548Christian Maeder where tstr = tokStr t
2f0ca8050a33fbc1a23c0bd2dec0d09c17e3c548Christian Maeder _ -> False
2f0ca8050a33fbc1a23c0bd2dec0d09c17e3c548Christian Maeder
2f0ca8050a33fbc1a23c0bd2dec0d09c17e3c548Christian MaederisGenSignedNumber :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
2f0ca8050a33fbc1a23c0bd2dec0d09c17e3c548Christian MaederisGenSignedNumber splt ga i trs =
2f0ca8050a33fbc1a23c0bd2dec0d09c17e3c548Christian Maeder case trs of
2f0ca8050a33fbc1a23c0bd2dec0d09c17e3c548Christian Maeder [hd] -> case splt hd of
232c13ff6847a6f2bac7163392f80ab692cd7774Christian Maeder Just (ni, nt) -> isSign i && isGenNumber splt ga ni nt
232c13ff6847a6f2bac7163392f80ab692cd7774Christian Maeder Nothing -> False
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder _ -> False
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder
2f0ca8050a33fbc1a23c0bd2dec0d09c17e3c548Christian MaederisSign :: Id -> Bool
2f0ca8050a33fbc1a23c0bd2dec0d09c17e3c548Christian MaederisSign i = case i of
2f0ca8050a33fbc1a23c0bd2dec0d09c17e3c548Christian Maeder Id [tok] [] _ -> let ts = tokStr tok
f50c9f317ed743022255535248028675a5716d2aSimon Ulbricht in ts == "-" || ts == "+"
232c13ff6847a6f2bac7163392f80ab692cd7774Christian Maeder _ -> False
232c13ff6847a6f2bac7163392f80ab692cd7774Christian Maeder
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian MaederisGenString :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian MaederisGenString splt ga i trs = case getLiteralType ga i of
eae0d62755147d991cc3e903f74f98ac31a7cd42Christian Maeder StringNull -> null trs
99b26e2ab8ba89bc9a050c1524137eb6269e2753Christian Maeder StringCons _ -> all (sameId splt stringTest i) trs
63ec46a77d00127c46ec526df43da8d701c30c65Christian Maeder _ -> False
99b26e2ab8ba89bc9a050c1524137eb6269e2753Christian Maeder where
99b26e2ab8ba89bc9a050c1524137eb6269e2753Christian Maeder stringTest ii = case getLiteralType ga ii of
99b26e2ab8ba89bc9a050c1524137eb6269e2753Christian Maeder StringNull -> True
99b26e2ab8ba89bc9a050c1524137eb6269e2753Christian Maeder _ -> case ii of
99b26e2ab8ba89bc9a050c1524137eb6269e2753Christian Maeder Id [t] [] _ -> take 1 (tokStr t) == "\'"
ef1c24c8229ade3ac872febebd18c181e32fb9c4Christian Maeder _ -> False
cc9f19b1fe81424205736fe0ae73620395b1bb74Simon Ulbricht
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichtisGenList :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichtisGenList splt ga i trms =
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht (case getLiteralType ga i of
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht ListNull _ -> null trms
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht ListCons _ n -> listTest n i trms
38bb7e3212e979b25e0280ea6bf8c4df157d4ef4Simon Ulbricht _ -> False)
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht where listTest n1 i1 terms = case getLiteralType ga i1 of
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht ListNull _ -> n1 == i1 && null terms
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht ListCons _ n2 -> n1 == n2 && case terms of
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht [_, hd] -> case splt hd of
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht Just (i2, ts) -> listTest n1 i2 ts
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht Nothing -> False
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht _ -> False
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht _ -> False
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon UlbrichtisGenFloat :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon UlbrichtisGenFloat splt ga i [l, r] =
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht case getLiteralType ga i of
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht Floating -> case (splt l, splt r) of
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht (Just (li, ltrm), Just (ri, rtrm)) ->
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht (isGenNumber splt ga li ltrm || isGenFrac splt ga li ltrm) &&
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht (isGenSignedNumber splt ga ri rtrm || isGenNumber splt ga ri rtrm)
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht _ -> False
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht _ -> False
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichtisGenFloat _ _ _ _ = False
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichtisGenFrac :: SplitM a -> GlobalAnnos -> Id -> [a] -> Bool
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichtisGenFrac splt ga i [l, r] =
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht case getLiteralType ga i of
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht Fraction -> case (splt l, splt r) of
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht (Just (li, ltrm), Just (ri, rtrm)) ->
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht isGenNumber splt ga li ltrm && isGenNumber splt ga ri rtrm
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht _ -> False
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht _ -> False
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichtisGenFrac _ _ _ _ = False
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichtsameId :: SplitM a -> (Id -> Bool) -> Id -> a -> Bool
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichtsameId splt test i t = case splt t of
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht Just (j, ts) -> if null ts then test j
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht else j == i && all (sameId splt test i) ts
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht _ -> False
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht-- * convert an application back to a literal
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichtjoinToken :: Token -> Token -> Token
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichtjoinToken (Token s1 _) (Token s2 _) =
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht Token (s1 ++ s2) nullRange -- forget the range
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichttoSignedNumber :: (a -> (Id, [a])) -> Id -> [a] -> Token
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichttoSignedNumber splt (Id [sign] [] _) [hd] = case splt hd of
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht (i, ts) -> joinToken sign $ toNumber splt i ts
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichttoSignedNumber _ _ _ = error "toSignedNumber2"
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichttoNumber :: (a -> (Id, [a])) -> Id -> [a] -> Token
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichttoNumber splt i ts = if null ts then case i of
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht Id [d] [] _ -> d
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht _ -> error "toNumber"
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht else foldr1 joinToken $ map (toNumber2 splt) ts
0a46a4d711eca869ad75b4df84dabd72783ebdd2Simon Ulbricht
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon UlbrichttoNumber2 :: (a -> (Id, [a])) -> a -> Token
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon UlbrichttoNumber2 splt t = case splt t of (j, args) -> toNumber splt j args
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon UlbrichttoFrac :: (a -> (Id, [a])) -> [a] -> Token
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon UlbrichttoFrac splt [lt, rt] =
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht joinToken (toNumber2 splt lt) $
0a46a4d711eca869ad75b4df84dabd72783ebdd2Simon Ulbricht joinToken (Token "." nullRange) $
0a46a4d711eca869ad75b4df84dabd72783ebdd2Simon Ulbricht toNumber2 splt rt
0a46a4d711eca869ad75b4df84dabd72783ebdd2Simon UlbrichttoFrac _ _ = error "toFrac"
465c6b72e8e480969b5f08658e394992bcc08bfcSimon Ulbricht
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon UlbrichttoFloat :: (a -> (Id, [a])) -> GlobalAnnos -> [a] -> Token
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon UlbrichttoFloat splt ga [lt, rt] =
0a46a4d711eca869ad75b4df84dabd72783ebdd2Simon Ulbricht case (splt lt, splt rt) of
0a46a4d711eca869ad75b4df84dabd72783ebdd2Simon Ulbricht ((bas_i, bas_t), (ex_i, ex_t)) ->
0b144823976d79a34bff62f7f9ec032e80b8ce85Simon Ulbricht let t1 = if isGenFrac (Just . splt) ga bas_i bas_t then
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht toFrac splt bas_t else
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht toNumber splt bas_i bas_t
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht t2 = if isGenSignedNumber (Just . splt) ga ex_i ex_t then
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht toSignedNumber splt ex_i ex_t else
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht toNumber splt ex_i ex_t
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht in joinToken t1 $ joinToken (Token "E" nullRange) t2
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichttoFloat _ _ _ = error "toFloat2"
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichttoChar :: Token -> String
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichttoChar t = case tokStr t of
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht '\'' : rt -> init rt
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht _ -> error "toChar"
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon Ulbricht
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichttoString :: (a -> (Id, [a])) -> GlobalAnnos -> Id -> [a] -> Token
1ab66a7e4234c760be9689b05ab4c34ce99dba23Simon UlbrichttoString splt ga i ts =
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht Token ( "\"" ++ toString1 splt ga i ts ++ "\"") nullRange
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht-- | the string without double quotes
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon UlbrichttoString1 :: (a -> (Id, [a])) -> GlobalAnnos -> Id -> [a] -> String
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon UlbrichttoString1 splt ga i ts = if null ts then
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht case getLiteralType ga i of
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht StringNull -> ""
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht _ -> case i of
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht Id [c] [] _ -> toChar c
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht _ -> error "toString"
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht else concatMap (toString2 splt ga) ts
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon UlbrichttoString2 :: (a -> (Id, [a])) -> GlobalAnnos -> a -> String
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon UlbrichttoString2 splt ga t = case splt t of (i, ts) -> toString1 splt ga i ts
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht
9a5e6e537c43a631facd9d87ce1a6c76f4b0af6dSimon Ulbricht-- | get list elements
562e30787355109feb0133ffea2ad86b6c143c26Simon UlbrichtgetListElems :: (a -> (Id, [a])) -> [a] -> [a]
562e30787355109feb0133ffea2ad86b6c143c26Simon UlbrichtgetListElems splt ts = case ts of
562e30787355109feb0133ffea2ad86b6c143c26Simon Ulbricht [] -> []
562e30787355109feb0133ffea2ad86b6c143c26Simon Ulbricht [ft, rt] -> ft : getListElems splt (snd $ splt rt)
562e30787355109feb0133ffea2ad86b6c143c26Simon Ulbricht _ -> error "getListElems"
562e30787355109feb0133ffea2ad86b6c143c26Simon Ulbricht