math API; lock field warnings

lib/resource-1.0/Makefile

@@ -6,6 +6,13 @@ stat:
 gfdoc:
 	gfdoc -txthtml abstract/*.gf
 	gfdoc -txthtml */Paradigms*.gf
+	gfdoc -txthtml mathematical/Mathematical.gf
+	gfdoc -txthtml mathematical/Symbol.gf
+	gfdoc -txthtml mathematical/Predication.gf
+	gfdoc -txthtml multimodal/Demonstrative.gf
+	gfdoc -txthtml multimodal/Multimodal.gf
 	mv abstract/*.html doc/gfdoc
+	mv mathematical/*.html doc/gfdoc
+	mv multimodal/*.html doc/gfdoc
 	mv */Paradigms*.html doc/gfdoc
 	cp */Irreg???.gf doc/gfdoc

lib/resource-1.0/doc/index.txt

@@ -59,3 +59,7 @@ The documentation of the individual modules:
 % - [IrregGer gfdoc/IrregGer.gf]: German irregular verbs
 - [IrregNor gfdoc/IrregNor.gf]: Norwegian irregular verbs
 - [IrregSwe gfdoc/IrregSwe.gf]: Swedish irregular verbs
+
+
+==Special-purpose APIs==
+

lib/resource-1.0/german/ResGer.gf

@@ -374,7 +374,7 @@ resource ResGer = ParamGer ** open Prelude in {
           verb  = vp.s  ! agr ! VPFinite t a ;
           neg   = vp.a1 ! b ;
           obj   = vp.n2 ! agr ++ vp.a2 ;
-          compl = neg ++ obj ;
+          compl = obj ++ neg ;
           inf   = vp.inf ++ verb.inf ;
           extra = vp.ext ;
           inffin = case <a,vp.isAux> of {

lib/resource-1.0/mathematical/Mathematical.gf

@@ -0,0 +1,29 @@
+--1 The Mathematics API to the Resource Grammar
+
+-- This grammar is a collection of the different modules.
+-- It differs from $Lang$ in two main ways:
+-- - the combinations in Noun, Verb, Adjective, Adverb, Sentence are not included
+-- - instead, Symbol and Predication are used
+-- 
+-- 
+-- In practice, the most important difference is that only present-tense sentences
+-- are included, and that symbolic expressions are recognized as NPs.
+
+abstract Mathematical = 
+  Noun - [ComplN2], --- to avoid ambiguity
+--  Verb, 
+--  Adjective,
+--  Adverb,
+  Numeral,
+--  Sentence, 
+  Question,
+  Relative,
+  Conjunction,
+  Phrase,
+  Structural,
+
+  Symbol,
+  Predication,
+
+  Lexicon
+  ** {} ;

lib/resource-1.0/mathematical/MathematicalEng.gf

@@ -0,0 +1,24 @@
+--# -path=.:../english:../abstract:../common:prelude
+
+concrete MathematicalEng of Mathematical = 
+  NounEng - [ComplN2], --- to avoid ambiguity 
+--  VerbEng, 
+--  AdjectiveEng,
+--  AdverbEng,
+  NumeralEng,
+--  SentenceEng,
+  QuestionEng,
+  RelativeEng,
+  ConjunctionEng,
+  PhraseEng,
+  StructuralEng,
+
+  SymbolEng,
+  PredicationEng,
+
+  LexiconEng
+  ** {
+
+flags startcat = Phr ;
+
+} ;

lib/resource-1.0/mathematical/MathematicalFre.gf

@@ -0,0 +1,24 @@
+--# -path=.:../french:../romance:../abstract:../common:prelude
+
+concrete MathematicalFre of Mathematical = 
+  NounFre - [ComplN2], --- to avoid ambiguity 
+--  VerbFre, 
+--  AdjectiveFre,
+--  AdverbFre,
+  NumeralFre,
+--  SentenceFre,
+  QuestionFre,
+  RelativeFre,
+  ConjunctionFre,
+  PhraseFre,
+  StructuralFre,
+
+  SymbolFre,
+  PredicationFre,
+
+  LexiconFre
+  ** {
+
+flags startcat = Phr ;
+
+} ;

lib/resource-1.0/mathematical/MathematicalGer.gf

@@ -0,0 +1,24 @@
+--# -path=.:../german:../abstract:../common:prelude
+
+concrete MathematicalGer of Mathematical = 
+  NounGer - [ComplN2], --- to avoid ambiguity 
+--  VerbGer, 
+--  AdjectiveGer,
+--  AdverbGer,
+  NumeralGer,
+--  SentenceGer,
+  QuestionGer,
+  RelativeGer,
+  ConjunctionGer,
+  PhraseGer,
+  StructuralGer,
+
+  SymbolGer,
+  PredicationGer,
+
+  LexiconGer
+  ** {
+
+flags startcat = Phr ;
+
+} ;

lib/resource-1.0/mathematical/MathematicalSwe.gf

@@ -0,0 +1,24 @@
+--# -path=.:../swedish:../scandinavian:../abstract:../common:prelude
+
+concrete MathematicalSwe of Mathematical = 
+  NounSwe - [ComplN2], --- to avoid ambiguity 
+--  VerbSwe, 
+--  AdjectiveSwe,
+--  AdverbSwe,
+  NumeralSwe,
+--  SentenceSwe,
+  QuestionSwe,
+  RelativeSwe,
+  ConjunctionSwe,
+  PhraseSwe,
+  StructuralSwe,
+
+  SymbolSwe,
+  PredicationSwe,
+
+  LexiconSwe
+  ** {
+
+flags startcat = Phr ;
+
+} ;

lib/resource-1.0/mathematical/Predication.gf

@@ -0,0 +1,57 @@
+--1 A Small Predication Library
+--
+-- (c) Aarne Ranta 2003-2006 under Gnu GPL.
+--
+-- This library is a derived library built on the language-independent Ground 
+-- API of resource grammars. 
+
+abstract Predication = Cat ** {
+
+--2 The category of atomic sentences
+
+-- These sentences have both a positive and a negative form
+
+cat
+  AS ;
+
+fun
+  PosAS : AS -> S ;
+  NegAS : AS -> S ;
+
+--2 Predication patterns.
+
+  predV     : V  -> NP -> AS ;         -- one-place verb:      "x converges"
+  predV2    : V2 -> NP -> NP -> AS ;   -- two-place verb:      "x intersects y"
+  predV3    : V3 -> NP->NP-> NP -> AS; -- three-place verb:    "x intersects y at z"
+  predVColl : V  -> NP -> NP -> AS ;   -- collective verb:     "x and y intersect"
+  predA     : A  -> NP -> AS ;         -- one-place adjective: "x is even"
+  predA2    : A2 -> NP -> NP -> AS ;   -- two-place adj:       "x is divisible by y"
+  predAComp : A  -> NP -> NP -> AS;    -- comparative adj:     "x is greater than y"
+  predAColl : A  -> NP -> NP -> AS ;   -- collective adj:      "x and y are parallel"
+  predN     : N  -> NP -> AS ;         -- one-place noun:      "x is a point"
+  predN2    : N2 -> NP -> NP -> AS ;   -- two-place noun:      "x is a divisor of y"
+  predNColl : N  -> NP -> NP -> AS ;   -- collective noun:     "x and y are duals"
+  predAdv   : Adv -> NP -> AS ;        -- adverb:              "x is inside"
+  predPrep  : Prep -> NP -> NP -> AS ; -- preposition:         "x is outside y"
+
+--2 Individual-valued function applications
+
+  appN2     : N2 -> NP -> NP ;         -- one-place function:  "the successor of x"
+  appN3     : N3 -> NP -> NP -> NP ;   -- two-place function: "the distance from x to y"
+  appColl   : N2 -> NP -> NP -> NP ;   -- collective function: "the sum of x and y"
+
+--2 Families of types
+
+-- These are expressed by relational nouns applied to arguments.
+
+  famN2     : N2 -> NP -> CN ;         -- one-place family:    "divisor of x"
+  famN3     : N3 -> NP -> NP -> CN ;   -- two-place family:    "path from x to y"
+  famColl   : N2 -> NP -> NP -> CN ;   -- collective family:   "path between x and y"
+
+--2 Type constructor
+
+-- This is similar to a family except that the argument is a type.
+
+  typN2     : N2 -> CN -> CN ;         -- constructed type:   "list of integers"
+
+}

lib/resource-1.0/mathematical/PredicationEng.gf

@@ -0,0 +1,3 @@
+concrete PredicationEng of Predication = CatEng ** PredicationI with
+  (Lang = LangEng) ;
+

lib/resource-1.0/mathematical/PredicationFre.gf

@@ -0,0 +1,3 @@
+concrete PredicationFre of Predication = CatFre ** PredicationI with
+  (Lang = LangFre) ;
+

lib/resource-1.0/mathematical/PredicationGer.gf

@@ -0,0 +1,3 @@
+concrete PredicationGer of Predication = CatGer ** PredicationI with
+  (Lang = LangGer) ;
+

lib/resource-1.0/mathematical/PredicationI.gf

@@ -0,0 +1,56 @@
+incomplete concrete PredicationI of Predication = Cat ** open ParamX, Lang in {
+
+lincat
+  AS = {s : Polarity => S} ;
+
+lin
+  PosAS as = as.s ! Pos ;
+  NegAS as = as.s ! Neg ;
+
+--2 Predication patterns.
+
+  predV v x = mkAS x (UseV v) ;
+  predV2 v x y = mkAS x (ComplV2 v y) ;
+  predV3 v x y z = mkAS x (ComplV3 v y z) ;
+  predVColl v x y = mkAS (ConjNP and_Conj (BaseNP x y)) (UseV v) ;
+  predA a x = mkAS x (UseComp (CompAP (PositA a))) ;
+  predA2 a x y = mkAS x (UseComp (CompAP (ComplA2 a y))) ;
+  predAComp a x y = mkAS x (UseComp (CompAP (ComparA a y))) ;
+  predAColl a x y = mkAS (ConjNP and_Conj (BaseNP x y)) (UseComp (CompAP (PositA a))) ;
+  predN n x = mkAS x (UseComp (CompNP (DetCN (DetSg IndefSg NoOrd) (UseN n)))) ;
+  predN2 n x y = mkAS x (UseComp (CompNP (DetCN (DetSg IndefSg NoOrd) (ComplN2 n y)))) ;
+  predNColl n x y = mkAS (ConjNP and_Conj (BaseNP x y)) 
+    (UseComp (CompNP (DetCN (DetPl IndefPl NoNum NoOrd) (UseN n)))) ;
+  predAdv a x = mkAS x (UseComp (CompAdv a)) ;
+  predPrep p x y = mkAS x (UseComp (CompAdv (PrepNP p y))) ;
+
+--2 Individual-valued function applications
+
+  appN2 n x = DetCN (DetSg DefSg NoOrd) (ComplN2 n x) ;
+  appN3 n x y = DetCN (DetSg DefSg NoOrd) (ComplN2 (ComplN3 n x) y) ;
+  appColl n x y = DetCN (DetSg DefSg NoOrd) (ComplN2 n (ConjNP and_Conj (BaseNP x y))) ;
+
+--2 Families of types
+
+-- These are expressed by relational nouns applied to arguments.
+
+  famN2 n x = ComplN2 n x ;
+  famN3 n x y = ComplN2 (ComplN3 n x) y ; 
+  famColl n x y = ComplN2 n (ConjNP and_Conj (BaseNP x y)) ;
+
+--2 Type constructor
+
+-- This is similar to a family except that the argument is a type.
+
+  typN2 f n = ComplN2 f (DetCN (DetPl IndefPl NoNum NoOrd) n) ;
+
+
+oper
+  mkAS : NP -> VP -> {s : Polarity => S} = \x,vp -> {
+    s = table {
+      Pos => UseCl TPres ASimul PPos (PredVP x vp) ;
+      Neg => UseCl TPres ASimul PNeg (PredVP x vp)
+      }
+    } ; 
+
+}

lib/resource-1.0/mathematical/PredicationSwe.gf

@@ -0,0 +1,3 @@
+concrete PredicationSwe of Predication = CatSwe ** PredicationI with
+  (Lang = LangSwe) ;
+

src/GF/CF/CanonToCF.hs

@@ -128,6 +128,8 @@ term2CFItems m t = errIn "forming cf items" $ case t of
      its <- mapM t2c ts
      tryMkCFTerm (concat its)
 
+   P (S c _) _ -> t2c c --- w-around for bug in Compute? AR 31/1/2006
+
    P arg s -> extrR arg s
 
    K (KS s) -> return [[PTerm (RegAlts [s]) | not (null s)]]

src/GF/Compile/CheckGrammar.hs

@@ -37,6 +37,7 @@ import GF.Grammar.Macros
 import GF.Grammar.ReservedWords ----
 import GF.Grammar.PatternMatch
 import GF.Grammar.AppPredefined
+import GF.Grammar.Lockfield (isLockLabel)
 
 import GF.Data.Operations
 import GF.Infra.CheckM
@@ -757,9 +758,15 @@ checkEqLType :: LTEnv -> Type -> Type -> Term -> Check Type
 checkEqLType env t u trm = do
   t' <- comp t 
   u' <- comp u
-  if alpha [] t' u' 
-     then return t'
-     else raise ("type of" +++ prt trm +++ 
+  case alpha [] t' u' of
+    True -> return t'
+    -- forgive missing lock fields by only generating a warning.
+    --- better: use a flag to forgive (AR 31/1/2006)
+    _ -> case missingLock [] t' u' of
+      Just lo -> do
+        checkWarn $ "missing lock field" +++ unwords (map prt lo)
+        return t'
+      _ -> raise ("type of" +++ prt trm +++ 
                 ": expected" +++ prt t' ++ ", inferred" +++ prt u')
  where
 
@@ -772,7 +779,7 @@ checkEqLType env t u trm = do
                               
      -- record subtyping
      (RecType rs, RecType ts) -> all (\ (l,a) -> 
-                                     any (\ (k,b) -> alpha g a b && l == k) ts) rs
+                                   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
 
@@ -780,7 +787,7 @@ checkEqLType env t u trm = do
      (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"))                 -> True ---- check size!
      
      (Q (IC "Predef") (IC "Int"),  ---- why this ???? AR 11/12/2005
         App (Q (IC "Predef") (IC "Ints")) (EInt n)) -> True
@@ -804,6 +811,17 @@ checkEqLType env t u trm = do
                                   || (t == typeType && u == typePType) 
                                   || (u == typeType && t == typePType) 
 
+   missingLock g t u = case (t,u) of  
+     (RecType rs, RecType ts) -> 
+       let 
+         ls = [l | (l,a) <- rs, 
+                   not (any (\ (k,b) -> alpha g a b && l == k) ts)]
+         (locks,others) = partition isLockLabel ls
+       in case others of
+         _:_ -> Nothing
+         _ -> return locks
+     _ -> Nothing
+
    sTypes = [typeStr, typeTok, typeString]
    comp = computeLType env
 
@@ -827,20 +845,3 @@ linTypeOfType cnc m typ = do
      ,return defLinType
      ]
 
-{-
--- check if a type is complex in variants
--- Not so useful as one might think, since variants of a complex type
--- can be created indirectly: f (variants {True,False})
-
-checkIfComplexVariantType :: Term -> Type -> Check ()
-checkIfComplexVariantType e t = case t of
-  Prod _ _ _ -> cs
-  Table _ _  -> cs
-  RecType (_:_:_) -> cs
-  _ -> return ()
- where
-   cs = case e of
-      FV (_:_) -> checkWarn $ "Warning:" +++ prt e +++ "has complex type" +++ prt t
-      _ -> return ()
-
--}