From dea5158cbf1c11d45f2ed91d9975fbc77245e652 Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Fri, 2 Dec 2005 13:13:14 +0000
Subject: floats in GF and GFC (parsing user input still doesn't work)

---
 src/GF/UseGrammar/Generate.hs |  5 ++++-
 src/GF/UseGrammar/Linear.hs   |  1 +
 src/GF/UseGrammar/Tokenize.hs | 21 ++++++++++++++++++---
 3 files changed, 23 insertions(+), 4 deletions(-)

(limited to 'src/GF/UseGrammar')

diff --git a/src/GF/UseGrammar/Generate.hs b/src/GF/UseGrammar/Generate.hs
index 941695f8b..f2482e8e8 100644
--- a/src/GF/UseGrammar/Generate.hs
+++ b/src/GF/UseGrammar/Generate.hs
@@ -85,6 +85,7 @@ tr2str (Tr (N (_,at,val,_,_),ts)) = case (at,val) of
   (AtM _,     v)         -> SMeta (catOf v)
   (AtL s,     _)         -> SString s
   (AtI i,     _)         -> SInt i
+  (AtF i,     _)         -> SFloat i
   _ -> SMeta "FAILED_TO_GENERATE" ---- err monad!
  where
    catOf v = case v of
@@ -148,7 +149,8 @@ data STree =
     SApp (SFun,[STree]) 
   | SMeta SCat
   | SString String
-  | SInt Int
+  | SInt Integer
+  | SFloat Double
    deriving (Show,Eq)
 
 depth :: STree -> Int
@@ -164,6 +166,7 @@ prSTree t = case t of
   SMeta c -> '?':c
   SString s -> prQuotedString s
   SInt i -> show i 
+  SFloat i -> show i 
  where
   pr1 t@(SApp (_,ts)) = ' ' : (if null ts then id else prParenth) (prSTree t)
   pr1 t = prSTree t
diff --git a/src/GF/UseGrammar/Linear.hs b/src/GF/UseGrammar/Linear.hs
index 24f7312c5..7e052426d 100644
--- a/src/GF/UseGrammar/Linear.hs
+++ b/src/GF/UseGrammar/Linear.hs
@@ -62,6 +62,7 @@ linearizeToRecord gr mk m = lin [] where
       A.AtC f -> lookf c t f >>= comp xs'
       A.AtL s -> return $ recS $ tK $ prt at
       A.AtI i -> return $ recS $ tK $ prt at
+      A.AtF i -> return $ recS $ tK $ prt at
       A.AtV x -> lookCat c >>= comp [tK (prt_ at)]
       A.AtM m -> lookCat c >>= comp [tK (prt_ at)] 
 
diff --git a/src/GF/UseGrammar/Tokenize.hs b/src/GF/UseGrammar/Tokenize.hs
index bfc0e53bb..91f7f0c61 100644
--- a/src/GF/UseGrammar/Tokenize.hs
+++ b/src/GF/UseGrammar/Tokenize.hs
@@ -52,10 +52,17 @@ tokLits = map mkCFTok . mergeStr . words where
 tokVars :: String -> [CFTok]
 tokVars = map mkCFTokVar . words
 
+isFloat s = case s of
+  c:cs | isDigit c -> isFloat cs
+  '.':cs@(_:_)     -> all isDigit cs
+  _ -> False
+
+
 mkCFTok :: String -> CFTok
 mkCFTok s = case s of
   '"' :cs@(_:_) | last cs == '"'  -> tL $ init cs
   '\'':cs@(_:_) | last cs == '\'' -> tL $ init cs --- 's Gravenhage
+  _:_ | isFloat s -> tF s
   _:_ | all isDigit s -> tI s
   _ -> tS s
 
@@ -73,10 +80,16 @@ mkTokVars tok = map tv . tok where
   tv t = t
 
 mkLit :: String -> CFTok
-mkLit s = if (all isDigit s) then (tI s) else (tL s)
+mkLit s 
+  | isFloat s = tF s
+  | all isDigit s = tI s
+  | otherwise = tL s
 
 mkTL :: String -> CFTok
-mkTL s = if (all isDigit s) then (tI s) else (tL ("'" ++ s ++ "'"))
+mkTL s 
+  | isFloat s = tF s
+  | all isDigit s = tI s
+  | otherwise = tL ("'" ++ s ++ "'")
 
 
 -- | Haskell lexer, usable for much code
@@ -120,7 +133,7 @@ lexC2M' isHigherOrder s = case s of
  where
   lexC = lexC2M' isHigherOrder
   getId s  = mkT i : lexC cs where (i,cs) = span isIdChar s
-  getLit s = tI i  : lexC cs where (i,cs) = span isDigit s
+  getLit s = tI i  : lexC cs where (i,cs) = span isDigit s ---- Float!
   isIdChar c = isAlpha c || isDigit c || elem c "'_"
   isSymb = reservedAnsiCSymbol 
   dropComment s = case s of
@@ -160,6 +173,7 @@ unknown2string :: (String -> Bool) -> [CFTok] -> [CFTok]
 unknown2string isKnown = map mkOne where
   mkOne t@(TS s) 
     | isKnown s = t
+    | isFloat s = tF s
     | all isDigit s = tI s 
     | otherwise = tL s
   mkOne t@(TC s) = if isKnown s then t else mkTL s
@@ -170,6 +184,7 @@ unknown2var isKnown = map mkOne where
   mkOne t@(TS "??") = if isKnown "??" then t else tM "??"
   mkOne t@(TS s) 
     | isKnown s = t
+    | isFloat s = tF s
     | all isDigit s = tI s 
     | otherwise = tV s
   mkOne t@(TC s) = if isKnown s then t else tV s
-- 
cgit v1.2.3