From c2dde4e80fb57259c23ae4bcdb675c412ef7d8ae Mon Sep 17 00:00:00 2001 From: aarne Date: Sun, 11 Dec 2005 17:48:55 +0000 Subject: [PATCH] float parsing fixed --- doc/gf-history.html | 5 ++- examples/tram/Tram.gf | 3 ++ examples/tram/TramI.gf | 2 + lib/resource-1.0/multimodal/Demonstrative.gf | 5 +-- src/GF/Canon/CMacros.hs | 14 +++++++ src/GF/Canon/MkGFC.hs | 6 ++- src/GF/Compile/CheckGrammar.hs | 44 ++++++++++---------- src/GF/Grammar/Values.hs | 2 +- src/GF/UseGrammar/Linear.hs | 2 +- 9 files changed, 52 insertions(+), 31 deletions(-) diff --git a/doc/gf-history.html b/doc/gf-history.html index 3ff42affd..5dc4293d2 100644 --- a/doc/gf-history.html +++ b/doc/gf-history.html @@ -12,6 +12,9 @@ Changes in functionality since May 17, 2005, release of GF Version 2.2 +11/12 (AR) Parsing of float literals now possible in object language. +Use the flag lexer=literals. +

6/12 (AR) Accept param and oper definitions in @@ -25,7 +28,7 @@ prototyping of grammars. resource). Values are stored as Haskell's Double precision floats. For the syntax of float literals, see BNFC document. NB: some bug still prevents parsing float literals in object -languages. +languages. Bug fixed 11/12.

diff --git a/examples/tram/Tram.gf b/examples/tram/Tram.gf index bcd9f7b7c..d8d497fdc 100644 --- a/examples/tram/Tram.gf +++ b/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" + } diff --git a/examples/tram/TramI.gf b/examples/tram/TramI.gf index 4ac7775ea..37b0138c0 100644 --- a/examples/tram/TramI.gf +++ b/examples/tram/TramI.gf @@ -41,4 +41,6 @@ lin -- PHere = DemNP this_NP ; -- PNamed s = DemNP (UsePN (SymbPN s)) ; +---- FromThisPlace = + } diff --git a/lib/resource-1.0/multimodal/Demonstrative.gf b/lib/resource-1.0/multimodal/Demonstrative.gf index ef5c90fbc..d3f7c1cb2 100644 --- a/lib/resource-1.0/multimodal/Demonstrative.gf +++ b/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 ; -- demonstrative noun phrase - MAdv ; -- demonstrative adverbial + MNP ; -- multimodal (demonstrative) noun phrase + MAdv ; -- multimodal (demonstrative) adverbial Point ; -- pointing gesture 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,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 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