float parsing fixed

5 files changed, 41 insertions, 27 deletions

diff --git a/src/GF/Canon/CMacros.hs b/src/GF/Canon/CMacros.hs
index 2facd6e65..bb80fb0fa 100644
--- a/src/GF/Canon/CMacros.hs
+++ b/src/GF/Canon/CMacros.hs
@@ -227,6 +227,20 @@ allLinValues trm = do
   lts <- allLinFields trm
   mapM (mapPairsM (return . allCaseValues)) lts
 
+-- | to gather all fields; does not assume s naming of fields; 
+-- used in Morpho only
+allAllLinValues :: Term -> Err [[(Label,[([Patt],Term)])]]
+allAllLinValues trm = do
+  lts <- allFields trm
+  mapM (mapPairsM (return . allCaseValues)) lts
+ where
+  allFields trm = case trm of
+    R rs  -> return [[(l,t) | Ass l t <- rs]]
+    FV ts -> do
+      lts <- mapM allFields ts
+      return $ concat lts
+    _ -> prtBad "fields can only be sought in a record not in" trm
+
 -- | to gather all linearizations, even from nested records; params ignored
 allLinBranches :: Term -> [([Label],Term)]
 allLinBranches trm = case trm of
diff --git a/src/GF/Canon/MkGFC.hs b/src/GF/Canon/MkGFC.hs
index 69ccc3034..8443354fc 100644
--- a/src/GF/Canon/MkGFC.hs
+++ b/src/GF/Canon/MkGFC.hs
@@ -112,12 +112,14 @@ trExp t = case t of
     AM i   -> A.Meta $ A.MetaSymb $ fromInteger i
     AT s   -> A.Sort $ prt s
     AS s   -> A.K s
-    AI i   -> A.EInt $ fromInteger i
+    AI i   -> A.EInt $ i
+    AF i   -> A.EFloat $ i
   trPt p = case p of
     APC mc ps -> let (m,c) = trQIdent mc in A.PP m c (map trPt ps)
     APV x -> A.PV x
     APS s -> A.PString s
-    API i -> A.PInt $ fromInteger i
+    API i -> A.PInt $ i
+    APF i -> A.PFloat $ i
     APW   -> A.PW
 
 trQIdent (CIQ m c) = (m,c)
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs
index 08b14e3fb..037d07072 100644
--- a/src/GF/Compile/CheckGrammar.hs
+++ b/src/GF/Compile/CheckGrammar.hs
@@ -719,42 +719,40 @@ checkEqLType env t u trm = do
      else raise ("type of" +++ prt trm +++ 
                 ": expected" +++ prt t' ++ ", inferred" +++ prt u')
  where
-   alpha g t u = case (t,u) of  --- quick hack version of TC.eqVal
-     (Prod x a b, Prod y c d) -> alpha g c a && alpha ((x,y):g) b d 
-                                                      -- contravariance!
 
-     ---- this should be made in Rename
-     (Q  m a, Q  n b) | a == b -> elem m (allExtendsPlus env n) 
-                               || elem n (allExtendsPlus env m)
-                               || m == n --- for Predef
-     (QC m a, QC n b) | a == b -> elem m (allExtendsPlus env n) 
-                               || elem n (allExtendsPlus env m)
-     (QC m a, Q  n b) | a == b -> elem m (allExtendsPlus env n) 
-                               || elem n (allExtendsPlus env m)
-     (Q  m a, QC n b) | a == b -> elem m (allExtendsPlus env n) 
-                               || elem n (allExtendsPlus env m)
+   -- t is a subtype of u 
+   --- quick hack version of TC.eqVal
+   alpha g t u = case (t,u) of  
 
-     (RecType rs, RecType ts) -> -- and [alpha g a b && l == k --- too strong req
-                                 --       | ((l,a),(k,b)) <- zip rs ts]
-                                 -- . || -- if fails, try subtyping:
-                                 all (\ (l,a) -> 
+     -- contravariance
+     (Prod x a b, Prod y c d) -> alpha g c a && alpha ((x,y):g) b d 
+                              
+     -- record subtyping
+     (RecType rs, RecType ts) -> all (\ (l,a) -> 
                                      any (\ (k,b) -> alpha g a b && l == k) ts) rs
-
      (ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s'
-
      (ExtR r s, t) -> alpha g r t || alpha g s t
 
-
-
-     -- the following say that Ints n is a subset of Int and of Ints m
+     -- the following say that Ints n is a subset of Int and of Ints m >= n
      (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
         App (Q (IC "Predef") (IC "Ints")) (EInt m)) -> m >= n
      (App (Q (IC "Predef") (IC "Ints")) (EInt n), 
         Q (IC "Predef") (IC "Int"))                 -> True ---- should check size
      
-     (Q (IC "Predef") (IC "Int"),
+     (Q (IC "Predef") (IC "Int"),  ---- why this ???? AR 11/12/2005
         App (Q (IC "Predef") (IC "Ints")) (EInt n)) -> True
 
+     ---- this should be made in Rename
+     (Q  m a, Q  n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+                               || m == n --- for Predef
+     (QC m a, QC n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+     (QC m a, Q  n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+     (Q  m a, QC n b) | a == b -> elem m (allExtendsPlus env n) 
+                               || elem n (allExtendsPlus env m)
+
      (Table a b,  Table c d)  -> alpha g a c && alpha g b d
      (Vr x,       Vr y)       -> x == y || elem (x,y) g || elem (y,x) g
      _                        -> t == u 
diff --git a/src/GF/Grammar/Values.hs b/src/GF/Grammar/Values.hs
index a7c58036d..6e029d98b 100644
--- a/src/GF/Grammar/Values.hs
+++ b/src/GF/Grammar/Values.hs
@@ -83,7 +83,7 @@ cString :: Ident
 cString = identC "String"
 
 isPredefCat :: Ident -> Bool
-isPredefCat c = elem c [cInt,cString]
+isPredefCat c = elem c [cInt,cString,cFloat]
 
 eType :: Exp
 eType = Sort "Type"
diff --git a/src/GF/UseGrammar/Linear.hs b/src/GF/UseGrammar/Linear.hs
index 7e052426d..9d76442ae 100644
--- a/src/GF/UseGrammar/Linear.hs
+++ b/src/GF/UseGrammar/Linear.hs
@@ -259,7 +259,7 @@ linearizeToStrss gr mk e = do
 allLinsOfFun :: CanonGrammar -> CIdent -> Err [[(Label,[([Patt],Term)])]]
 allLinsOfFun gr f = do
   t <- lookupLin gr f 
-  allLinValues t
+  allAllLinValues t --- all fields, not only s. 11/12/2005
 
 
 -- | returns printname if one exists; otherwise linearizes with metas