From 756b7708af6b0d968fb1af7b668e480963424f9e Mon Sep 17 00:00:00 2001 From: aarne Date: Sat, 18 Nov 2006 21:10:46 +0000 Subject: [PATCH] overloading API and examples --- lib/resource-1.0/api/Combinators.gf | 101 +++++++++ lib/resource-1.0/api/CombinatorsEng.gf | 3 + lib/resource-1.0/api/Constructors.gf | 290 ++++++++++++++++++++++++ lib/resource-1.0/api/ConstructorsEng.gf | 3 + lib/resource-1.0/api/Koe.gf | 5 + lib/resource-1.0/api/KoeEng.gf | 10 + lib/resource-1.0/api/MkOverload.hs | 14 ++ src/GF/Compile/CheckGrammar.hs | 4 +- 8 files changed, 428 insertions(+), 2 deletions(-) create mode 100644 lib/resource-1.0/api/Combinators.gf create mode 100644 lib/resource-1.0/api/CombinatorsEng.gf create mode 100644 lib/resource-1.0/api/Constructors.gf create mode 100644 lib/resource-1.0/api/ConstructorsEng.gf create mode 100644 lib/resource-1.0/api/Koe.gf create mode 100644 lib/resource-1.0/api/KoeEng.gf create mode 100644 lib/resource-1.0/api/MkOverload.hs diff --git a/lib/resource-1.0/api/Combinators.gf b/lib/resource-1.0/api/Combinators.gf new file mode 100644 index 000000000..eaeec71bf --- /dev/null +++ b/lib/resource-1.0/api/Combinators.gf @@ -0,0 +1,101 @@ +incomplete resource Combinators = open Grammar in { + + oper + + pred = overload { + pred : V -> NP -> Cl + = \v,np -> PredVP np (UseV v) ; + pred : V2 -> NP -> NP -> Cl + = \v,np,ob -> PredVP np (ComplV2 v ob) ; + pred : V3 -> NP -> NP -> NP -> Cl + = \v,np,ob,ob2 -> + PredVP np (ComplV3 v ob ob2) ; + pred : V -> NP -> NP -> Cl + = \v,x,y -> PredVP (ConjNP and_Conj (BaseNP x y)) (UseV v) ; + pred : A -> NP -> Cl + = \a,np -> PredVP np (UseComp (CompAP (PositA a))) ; + pred : A2 -> NP -> NP -> Cl + = \a,x,y -> PredVP x (UseComp (CompAP (ComplA2 a y))) ; + pred : A -> NP -> NP -> Cl + = \a,x,y -> PredVP (ConjNP and_Conj (BaseNP x y)) (UseComp (CompAP (PositA a))) ; + pred : N -> NP -> Cl + = \n,x -> PredVP x (UseComp (CompNP (DetCN (DetSg (SgQuant IndefArt) NoOrd) (UseN n)))) ; + pred : N2 -> NP -> NP -> Cl + = \n,x,y -> PredVP x (UseComp (CompNP (DetCN (DetSg (SgQuant IndefArt) NoOrd) (ComplN2 n y)))) ; + pred : N -> NP -> NP -> Cl + = \n,x,y -> PredVP (ConjNP and_Conj (BaseNP x y)) (UseComp (CompNP (DetCN (DetPl (PlQuant IndefArt) NoNum NoOrd) (UseN n)))) ; + pred : Adv -> NP -> Cl + = \a,x -> PredVP x (UseComp (CompAdv a)) ; + pred : Prep -> NP -> NP -> Cl + = \p,x,y -> PredVP x (UseComp (CompAdv (PrepNP p y))) + + } ; + + app = overload { + app : N -> NP + = \n -> DetCN (DetSg (SgQuant DefArt) NoOrd) (UseN n) ; + app : N2 -> NP -> NP + = \n,x -> DetCN (DetSg (SgQuant DefArt) NoOrd) (ComplN2 n x) ; + app : N3 -> NP -> NP -> NP + = \n,x,y -> DetCN (DetSg (SgQuant DefArt) NoOrd) (ComplN2 (ComplN3 n x) y) ; + app : N2 -> NP -> NP -> NP + = \n,x,y -> DetCN (DetSg (SgQuant DefArt) NoOrd) (ComplN2 n (ConjNP and_Conj (BaseNP x y))) ; + app : N2 -> N -> CN + = \f,n -> ComplN2 f (DetCN (DetPl (PlQuant IndefArt) NoNum NoOrd) (UseN n)) + } ; + + coord = overload { + coord : Conj -> Adv -> Adv -> Adv + = \c,x,y -> ConjAdv c (BaseAdv x y) ; + coord : Conj -> AP -> AP -> AP + = \c,x,y -> ConjAP c (BaseAP x y) ; + coord : Conj -> NP -> NP -> NP + = \c,x,y -> ConjNP c (BaseNP x y) ; + coord : Conj -> S -> S -> S + = \c,x,y -> ConjS c (BaseS x y) ; + coord : DConj -> Adv -> Adv -> Adv + = \c,x,y -> DConjAdv c (BaseAdv x y) ; + coord : DConj -> AP -> AP -> AP + = \c,x,y -> DConjAP c (BaseAP x y) ; + coord : DConj -> NP -> NP -> NP + = \c,x,y -> DConjNP c (BaseNP x y) ; + coord : DConj -> S -> S -> S + = \c,x,y -> DConjS c (BaseS x y) ; + coord : Conj -> ListAdv -> Adv + = \c,xy -> ConjAdv c xy ; + coord : Conj -> ListAP -> AP + = \c,xy -> ConjAP c xy ; + coord : Conj -> ListNP -> NP + = \c,xy -> ConjNP c xy ; + coord : Conj -> ListS -> S + = \c,xy -> ConjS c xy ; + coord : DConj -> ListAdv -> Adv + = \c,xy -> DConjAdv c xy ; + coord : DConj -> ListAP -> AP + = \c,xy -> DConjAP c xy ; + coord : DConj -> ListNP -> NP + = \c,xy -> DConjNP c xy ; + coord : DConj -> ListS -> S + = \c,xy -> DConjS c xy + } ; + + mod = overload { + mod : A -> N -> CN + = \a,n -> AdjCN (PositA a) (UseN n) ; + mod : AP -> CN -> CN + = \a,n -> AdjCN a n ; + mod : AdA -> A -> AP + = \m,a -> AdAP m (PositA a) ; + mod : Quant -> N -> NP + = \q,n -> DetCN (DetSg (SgQuant q) NoOrd) (UseN n) ; + mod : Quant -> CN -> NP + = \q,n -> DetCN (DetSg (SgQuant q) NoOrd) n ; + mod : Predet -> N -> NP + = \q,n -> PredetNP q (DetCN (DetPl (PlQuant IndefArt) NoNum NoOrd) (UseN n)) ; + mod : Numeral -> N -> NP + = \nu,n -> DetCN (DetPl (PlQuant IndefArt) (NumNumeral nu) NoOrd) (UseN n) + + } ; + + +} diff --git a/lib/resource-1.0/api/CombinatorsEng.gf b/lib/resource-1.0/api/CombinatorsEng.gf new file mode 100644 index 000000000..3dc4c9064 --- /dev/null +++ b/lib/resource-1.0/api/CombinatorsEng.gf @@ -0,0 +1,3 @@ +--# -path=.:../abstract:../common:../english:prelude + +resource CombinatorsEng = Combinators with (Grammar = GrammarEng) ; diff --git a/lib/resource-1.0/api/Constructors.gf b/lib/resource-1.0/api/Constructors.gf new file mode 100644 index 000000000..846928a1a --- /dev/null +++ b/lib/resource-1.0/api/Constructors.gf @@ -0,0 +1,290 @@ +incomplete resource Constructors = open Grammar in { + + oper + + mkAP = overload { + mkAP : A -> AP -- warm + = PositA ; + mkAP : A -> NP -> AP -- warmer than Spain + = ComparA ; + mkAP : A2 -> NP -> AP -- divisible by 2 + = ComplA2 ; + mkAP : A2 -> AP -- divisible by itself + = ReflA2 ; + mkAP : AP -> SC -> AP -- great that she won, uncertain if she did + = SentAP ; + mkAP : AdA -> AP -> AP -- very uncertain + = AdAP + } ; + + mkAdv = overload { + mkAdv : A -> Adv -- quickly + = PositAdvAdj ; + mkAdv : Prep -> NP -> Adv -- in the house + = PrepNP ; + mkAdv : CAdv -> A -> NP -> Adv -- more quickly than John + = ComparAdvAdj ; + mkAdv : CAdv -> A -> S -> Adv -- more quickly than he runs + = ComparAdvAdjS ; + mkAdv : AdA -> Adv -> Adv -- very quickly + = AdAdv ; + mkAdv : Subj -> S -> Adv -- when he arrives + = SubjS + } ; + + mkCl = overload { + mkCl : NP -> VP -> Cl -- John walks + = PredVP ; + mkCl : VP -> Cl -- it rains + = ImpersCl ; + mkCl : NP -> RS -> Cl -- it is you who did it + = CleftNP ; + mkCl : Adv -> S -> Cl -- it is yesterday she arrived + = CleftAdv ; + mkCl : NP -> Cl -- there is a house + = ExistNP + } ; + + mkNP = overload { + mkNP : Det -> CN -> NP -- the man + = DetCN ; + mkNP : Det -> N -> NP -- the man + = \d,n -> DetCN d (UseN n) ; + mkNP : PN -> NP -- John + = UsePN ; + mkNP : Pron -> NP -- he + = UsePron ; + mkNP : Predet -> NP -> NP -- only the man + = PredetNP ; + mkNP : NP -> V2 -> NP -- the number squared + = PPartNP ; + mkNP : NP -> Adv -> NP -- Paris at midnight + = AdvNP + } ; + + mkDet = overload { + mkDet : QuantSg -> Ord -> Det -- this best man + = DetSg ; + mkDet : Det -- the man + = DetSg (SgQuant DefArt) NoOrd ; + mkDet : QuantSg -> Det -- this man + = \q -> DetSg q NoOrd ; + mkDet : QuantPl -> Num -> Ord -> Det -- these five best men + = DetPl ; + mkDet : QuantPl -> Det -- these men + = \q -> DetPl q NoNum NoOrd ; + mkDet : Quant -> Det -- this man + = \q -> DetSg (SgQuant q) NoOrd ; + mkDet : Num -> Det -- five men + = \n -> DetPl (PlQuant IndefArt) n NoOrd ; + mkDet : Pron -> Det -- my (house) + = \p -> DetSg (SgQuant (PossPron p)) NoOrd + } ; + + mkNum = overload { + mkNum : Num -- [no num] + = NoNum ; + mkNum : Int -> Num -- 51 + = NumInt ; + mkNum : Digit -> Num + = \d -> NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 d))))) + } ; + + mkOrd = overload { + mkOrd : Ord -- [no ord] + = NoOrd ; + mkOrd : Int -> Ord -- 51st + = OrdInt ; + mkOrd : Digit -> Ord -- fifth + = \d -> OrdNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 d))))) ; + mkOrd : A -> Ord -- largest + = OrdSuperl + } ; + + mkCN = overload { + mkCN : N -> CN -- house + = UseN ; + mkCN : N2 -> NP -> CN -- son of the king + = ComplN2 ; + mkCN : N3 -> NP -> NP -> CN -- flight from Moscow (to Paris) + = \f,x -> ComplN2 (ComplN3 f x) ; + mkCN : N2 -> CN -- son + = UseN2 ; + mkCN : N3 -> CN -- flight + = UseN3 ; + mkCN : AP -> CN -> CN -- big house + = AdjCN ; + mkCN : CN -> AP -> CN -- big house + = \x,y -> AdjCN y x ; + mkCN : CN -> RS -> CN -- house that John owns + = RelCN ; + mkCN : CN -> Adv -> CN -- house on the hill + = AdvCN ; + mkCN : CN -> SC -> CN -- fact that John smokes, question if he does + = SentCN ; + mkCN : CN -> NP -> CN -- number x, numbers x and y + = ApposCN + } ; + + + mkPhr = overload { + mkPhr : PConj -> Utt -> Voc -> Phr -- But go home my friend + = PhrUtt ; + mkPhr : Utt -> Phr -- Go home + = \u -> PhrUtt NoPConj u NoVoc ; + mkPhr : S -> Phr -- I go home + = \s -> PhrUtt NoPConj (UttS s) NoVoc + } ; + + mkUtt = overload { + mkUtt : S -> Utt -- John walks + = UttS ; + mkUtt : QS -> Utt -- is it good + = UttQS ; + mkUtt : Pol -> Imp -> Utt -- (don't) help yourself + = UttImpSg ; + mkUtt : Imp -> Utt -- help yourself + = UttImpSg PPos ; + mkUtt : IP -> Utt -- who + = UttIP ; + mkUtt : IAdv -> Utt -- why + = UttIAdv ; + mkUtt : NP -> Utt -- this man + = UttNP ; + mkUtt : Adv -> Utt -- here + = UttAdv ; + mkUtt : VP -> Utt -- to sleep + = UttVP + } ; + + mkQCl = overload { + + mkQCl : Cl -> QCl -- does John walk + = QuestCl ; + mkQCl : IP -> VP -> QCl -- who walks + = QuestVP ; + mkQCl : IP -> Slash -> QCl -- who does John love + = QuestSlash ; + mkQCl : IP -> NP -> V2 -> QCl -- who does John love + = \ip,np,v -> QuestSlash ip (SlashV2 np v) ; + mkQCl : IAdv -> Cl -> QCl -- why does John walk + = QuestIAdv ; + mkQCl : Prep -> IP -> Cl -> QCl -- with whom does John walk + = \p,ip -> QuestIAdv (PrepIP p ip) ; + mkQCl : IAdv -> NP -> QCl -- where is John + = \a -> QuestIComp (CompIAdv a) ; + mkQCl : IP -> QCl -- which houses are there + = ExistIP + } ; + + mkIP = overload { + mkIP : IDet -> Num -> Ord -> CN -> IP -- which five best songs + = IDetCN ; + mkIP : IDet -> N -> IP -- which song + = \i,n -> IDetCN i NoNum NoOrd (UseN n) ; + mkIP : IP -> Adv -> IP -- who in Europe + = AdvIP + } ; + + mkRCl = overload { + mkRCl : Cl -> RCl -- such that John loves her + = RelCl ; + mkRCl : RP -> VP -> RCl -- who loves John + = RelVP ; + mkRCl : RP -> Slash -> RCl -- whom John loves + = RelSlash + } ; + + mkRP = overload { + mkRP : RP -- which + = IdRP ; + mkRP : Prep -> NP -> RP -> RP -- all the roots of which + = FunRP + } ; + + mkSlash = overload { + mkSlash : NP -> V2 -> Slash -- (whom) he sees + = SlashV2 ; + mkSlash : NP -> VV -> V2 -> Slash -- (whom) he wants to see + = SlashVVV2 ; + mkSlash : Slash -> Adv -> Slash -- (whom) he sees tomorrow + = AdvSlash ; + mkSlash : Cl -> Prep -> Slash -- (with whom) he walks + = SlashPrep + } ; + + mkImp = overload { + mkImp : VP -> Imp -- go + = ImpVP ; + mkImp : V -> Imp + = \v -> ImpVP (UseV v) ; + mkImp : V2 -> NP -> Imp + = \v,np -> ImpVP (ComplV2 v np) + } ; + + mkSC = overload { + mkSC : S -> SC -- that you go + = EmbedS ; + mkSC : QS -> SC -- whether you go + = EmbedQS ; + mkSC : VP -> SC -- to go + = EmbedVP + } ; + + mkS = overload { + mkS : Tense -> Ant -> Pol -> Cl -> S + = UseCl ; + mkS : Cl -> S + = UseCl TPres ASimul PPos + } ; + + mkQS = overload { + mkQS : Tense -> Ant -> Pol -> QCl -> QS + = UseQCl ; + mkQS : QCl -> QS + = UseQCl TPres ASimul PPos + } ; + + mkRS = overload { + mkRS : Tense -> Ant -> Pol -> RCl -> RS + = UseRCl ; + mkRS : RCl -> RS + = UseRCl TPres ASimul PPos + } ; + + mkText = overload { + mkText : Text -- [empty text] + = TEmpty ; + mkText : Phr -> Text -> Text -- John walks. ... + = TFullStop + } ; + + mkVP = overload { + mkVP : V -> VP -- sleep + = UseV ; + mkVP : V2 -> NP -> VP -- use it + = ComplV2 ; + mkVP : V3 -> NP -> NP -> VP -- send a message to her + = ComplV3 ; + mkVP : VV -> VP -> VP -- want to run + = ComplVV ; + mkVP : VS -> S -> VP -- know that she runs + = ComplVS ; + mkVP : VQ -> QS -> VP -- ask if she runs + = ComplVQ ; + mkVP : VA -> AP -> VP -- look red + = ComplVA ; + mkVP : V2A -> NP -> AP -> VP -- paint the house red + = ComplV2A ; + mkVP : AP -> VP -- be warm + = \a -> UseComp (CompAP a) ; + mkVP : NP -> VP -- be a man + = \a -> UseComp (CompNP a) ; + mkVP : Adv -> VP -- be here + = \a -> UseComp (CompAdv a) ; + mkVP : VP -> Adv -> VP -- sleep here + = AdvVP ; + mkVP : AdV -> VP -> VP -- always sleep + = AdVVP + } ; +} diff --git a/lib/resource-1.0/api/ConstructorsEng.gf b/lib/resource-1.0/api/ConstructorsEng.gf new file mode 100644 index 000000000..cfa5837b4 --- /dev/null +++ b/lib/resource-1.0/api/ConstructorsEng.gf @@ -0,0 +1,3 @@ +--# -path=.:../abstract:../common:../english:prelude + +resource ConstructorsEng = Constructors with (Grammar = GrammarEng) ; diff --git a/lib/resource-1.0/api/Koe.gf b/lib/resource-1.0/api/Koe.gf new file mode 100644 index 000000000..f8105474a --- /dev/null +++ b/lib/resource-1.0/api/Koe.gf @@ -0,0 +1,5 @@ +abstract Koe = Cat ** { + + fun ex1, ex2, ex3 : Phr ; + +} diff --git a/lib/resource-1.0/api/KoeEng.gf b/lib/resource-1.0/api/KoeEng.gf new file mode 100644 index 000000000..faec870e8 --- /dev/null +++ b/lib/resource-1.0/api/KoeEng.gf @@ -0,0 +1,10 @@ +--# -path=.:../abstract:../common:../english:prelude + +concrete KoeEng of Koe = CatEng ** + open ParadigmsEng, ConstructorsEng, CombinatorsEng, GrammarEng in { + + lin + ex1 = mkPhr (mkS (mkCl (mkNP (regPN "John")) (mkVP (regV "walk")))) ; + ex2 = mkPhr (mkS (pred (regV "walk") (mkNP (regPN "John")))) ; + +} diff --git a/lib/resource-1.0/api/MkOverload.hs b/lib/resource-1.0/api/MkOverload.hs new file mode 100644 index 000000000..c9bbb60f7 --- /dev/null +++ b/lib/resource-1.0/api/MkOverload.hs @@ -0,0 +1,14 @@ +import List + +main = do + s <- readFile "constrs" + mapM_ (putStrLn . mkOne) $ lines s + +mkOne [] = [] +mkOne s = + " mk" ++ cons ++ " " ++ rest ++ + "\n =" ++ fun ++ " ;" + where + (fun,rest) = span (/=':') s + cons = last $ takeWhile (/="--") $ words rest + diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 76ff093f3..1b3159cd1 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -589,8 +589,8 @@ inferLType gr trm = case trm of _ -> raise $ "no overload instance of" +++ prt f +++ "for" +++ unwords (map prtType tys) +++ "among" ++++ unlines [unwords (map prtType ty) | (ty,_) <- typs] - ++++ "DEBUG" +++ unwords (map show tys) +++ ";" - ++++ unlines (map (show . fst) typs) ---- + ---- ++++ "DEBUG" +++ unwords (map show tys) +++ ";" + ---- ++++ unlines (map (show . fst) typs) ---- lookupOverloadInstance tys typs = lookup tys typs ---- use Map