float parsing fixed

doc/gf-history.html

@@ -12,6 +12,9 @@ Changes in functionality since May 17, 2005, release of GF Version 2.2
 
 </center>
 
+11/12 (AR) Parsing of float literals now possible in object language.
+Use the flag <tt>lexer=literals</tt>.
+
 <p>
 
 6/12 (AR) Accept <tt>param</tt> and <tt>oper</tt> definitions in
@@ -25,7 +28,7 @@ prototyping of grammars.
 resource). Values are stored as Haskell's <tt>Double</tt> precision
 floats. For the syntax of float literals, see BNFC document.
 NB: some bug still prevents parsing float literals in object
-languages.
+languages. <b>Bug fixed 11/12.</b>
 
 <p>
 

examples/tram/Tram.gf

@@ -30,4 +30,7 @@ fun
 --  PClick   : Click -> Place ;          -- click associated with a "here"
 --  PHere    : Place ;                   -- indexical "here", without a click
 
+  FromThisPlace : Dep ;               -- "from this place"
+  ToThisPlace   : Dest ;              -- "to this place"
+
 }

examples/tram/TramI.gf

@@ -41,4 +41,6 @@ lin
 --  PHere = DemNP this_NP ;
 --  PNamed s = DemNP (UsePN (SymbPN s)) ;
 
+----  FromThisPlace = 
+
 }

lib/resource-1.0/multimodal/Demonstrative.gf

@@ -11,9 +11,8 @@ abstract Demonstrative = Cat, Tense ** {
     MVP ;    -- multimodal verb phrase
     MComp ;  -- multimodal complement to copula (MAP, MNP, MAdv)
     MAP ;    -- multimodal adjectival phrase
-
+    MNP ;    -- multimodal (demonstrative) noun phrase
-    MNP ;    -- demonstrative noun phrase
+    MAdv ;   -- multimodal (demonstrative) adverbial
-    MAdv ;   -- demonstrative adverbial
 
     Point ;  -- pointing gesture
 

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

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)

src/GF/Compile/CheckGrammar.hs

@@ -719,9 +719,28 @@ 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
+
+   -- t is a subtype of u 
+   --- quick hack version of TC.eqVal
+   alpha g t u = case (t,u) of  
+
+     -- contravariance
      (Prod x a b, Prod y c d) -> alpha g c a && alpha ((x,y):g) b d 
-                                                      -- contravariance!
+                              
+     -- 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 >= 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"),  ---- 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) 
@@ -734,27 +753,6 @@ checkEqLType env t u trm = do
      (Q  m a, QC n b) | a == b -> elem m (allExtendsPlus env n) 
                                || elem n (allExtendsPlus env m)
 
-     (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) -> 
-                                     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
-     (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"),
-        App (Q (IC "Predef") (IC "Ints")) (EInt n)) -> True
-
      (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 

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"

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