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/CF/CFIdent.hs   | 25 +++++++++++++++++--------
 src/GF/CF/CanonToCF.hs |  3 ++-
 2 files changed, 19 insertions(+), 9 deletions(-)

(limited to 'src/GF/CF')

diff --git a/src/GF/CF/CFIdent.hs b/src/GF/CF/CFIdent.hs
index fe1f1b663..0cf793827 100644
--- a/src/GF/CF/CFIdent.hs
+++ b/src/GF/CF/CFIdent.hs
@@ -14,17 +14,18 @@
 
 module GF.CF.CFIdent (-- * Tokens and categories
 		CFTok(..), CFCat(..),
-		tS, tC, tL, tI, tV, tM, tInt,
+		tS, tC, tL, tI, tF, tV, tM, tInt,
 		prCFTok,
 		-- * Function names and profiles
 		CFFun(..), Profile,
 		wordsCFTok,
 		-- * CF Functions
-		mkCFFun, varCFFun, consCFFun, string2CFFun, stringCFFun, intCFFun, dummyCFFun,
+		mkCFFun, varCFFun, consCFFun, string2CFFun, stringCFFun, 
+                intCFFun, floatCFFun, dummyCFFun,
 		cfFun2String, cfFun2Ident, cfFun2Profile, metaCFFun,
 		-- * CF Categories
 		mkCIdent, ident2CFCat, labels2CFCat, string2CFCat, 
-                catVarCF, cat2CFCat, cfCatString, cfCatInt,
+                catVarCF, cat2CFCat, cfCatString, cfCatInt,cfCatFloat,
 		moduleOfCFCat, cfCat2Cat, cfCat2Ident, lexCFCat,
 		-- * CF Tokens
 		string2CFTok, str2cftoks,
@@ -48,7 +49,8 @@ data CFTok =
    TS String     -- ^ normal strings
  | TC String     -- ^ strings that are ambiguous between upper or lower case
  | TL String     -- ^ string literals
- | TI Int        -- ^ integer literals
+ | TI Integer    -- ^ integer literals
+ | TF Double     -- ^ float literals
  | TV Ident      -- ^ variables
  | TM Int String -- ^ metavariables; the integer identifies it
   deriving (Eq, Ord, Show)
@@ -60,6 +62,7 @@ tS :: String -> CFTok
 tC :: String -> CFTok
 tL :: String -> CFTok
 tI :: String -> CFTok
+tF :: String -> CFTok
 tV :: String -> CFTok
 tM :: String -> CFTok
 
@@ -67,10 +70,11 @@ tS  = TS
 tC  = TC
 tL  = TL
 tI  = TI . read 
+tF  = TF . read 
 tV  = TV . identC
 tM  = TM 0
 
-tInt :: Int -> CFTok
+tInt :: Integer -> CFTok
 tInt = TI
 
 prCFTok :: CFTok -> String
@@ -79,6 +83,7 @@ prCFTok t = case t of
   TC s -> s
   TL s -> s
   TI i -> show i
+  TF i -> show i
   TV x -> prt x
   TM i m -> m --- "?" --- m
 
@@ -113,8 +118,11 @@ string2CFFun m c = consCFFun $ mkCIdent m c
 stringCFFun :: String -> CFFun 
 stringCFFun = mkCFFun . AS
 
-intCFFun :: Int -> CFFun 
-intCFFun = mkCFFun . AI . toInteger
+intCFFun :: Integer -> CFFun 
+intCFFun = mkCFFun . AI
+
+floatCFFun :: Double -> CFFun 
+floatCFFun = mkCFFun . AF
 
 -- | used in lexer-by-need rules
 dummyCFFun :: CFFun
@@ -166,8 +174,9 @@ cat2CFCat = uncurry idents2CFCat
 cfCatString :: CFCat
 cfCatString = string2CFCat (prt cPredefAbs) "String"
 
-cfCatInt :: CFCat
+cfCatInt, cfCatFloat :: CFCat
 cfCatInt = string2CFCat (prt cPredefAbs) "Int"
+cfCatFloat = string2CFCat (prt cPredefAbs) "Float"
 
 
 
diff --git a/src/GF/CF/CanonToCF.hs b/src/GF/CF/CanonToCF.hs
index 6ce443351..882860b2c 100644
--- a/src/GF/CF/CanonToCF.hs
+++ b/src/GF/CF/CanonToCF.hs
@@ -190,7 +190,8 @@ mkCFPredef opts binds rules = (ruls, \s -> preds0 s ++ look s) where
     [(cat,         metaCFFun)     | TM _ _ <- [s], cat <- cats] ++
     [(cat,         varCFFun x)    | TV x   <- [s], cat <- catVarCF : bindcats] ++
     [(cfCatString, stringCFFun t) | TL t   <- [s]]              ++
-    [(cfCatInt,    intCFFun t)    | TI t   <- [s]]
+    [(cfCatInt,    intCFFun t)    | TI t   <- [s]] ++
+    [(cfCatFloat,  floatCFFun t)  | TF t   <- [s]]
   cats = nub [c | (_,rs) <- rules, (_,(_,its)) <- rs, CFNonterm c <- its]
   bindcats = [c | c <- cats, elem (cfCat2Ident c) binds]
   look = concatMap snd . map (trieLookup preds) . wordsCFTok --- for TC tokens
-- 
cgit v1.2.3