make with test trees

lib/resource-1.4/Make.hs

@@ -2,38 +2,79 @@ module Main where
 
 import System
 
+-- Make commands for compiling and testing resource grammars.
+-- usage: runghc Make (lang | api | pgf | test | clean)?
+-- With no argument, lang and api are done, in this order.
+-- See 'make' below for what is done by which command.
+
 langs = [
---  ("arabic",   "Ara"),
+  ("arabic",   "Ara"),
---  ("bulgarian","Bul"),
+  ("bulgarian","Bul"),
---  ("catalan",  "Cat"),
+  ("catalan",  "Cat"),
   ("danish",   "Dan"),
   ("english",  "Eng"),
   ("finnish",  "Fin"),
   ("french",   "Fre"),
   ("german",   "Ger"),
---  ("interlingua","Ina"),
+  ("interlingua","Ina"),
   ("italian",  "Ita"),
   ("norwegian","Nor"),
---  ("russian",  "Rus"),
+  ("russian",  "Rus"),
   ("spanish",  "Spa"),
   ("swedish",  "Swe")
   ]
 
+-- languagues for which to compile Lang
+langsLang = langs `except` ["Ara","Ina","Rus"]
+
+-- languages for which to compile Try 
+langsAPI  = langsLang `except` ["Bul","Cat"]
+
+-- languages for which to run treebank test
+langsTest = langsLang `except` ["Bul","Cat","Spa"]
+
+-- languages for which langs.pgf is built
+langsPGF = langsTest `only` ["Eng","Fre","Swe"]
+
+treebankExx = "exx-resource.gft"
+treebankResults = "exx-resource.gftb"
 
 main = do
   xx <- getArgs
   make xx
 
-make xx = case xx of
+make xx = do
-  _ -> do
+  let ifx  opt act = if null xx || elem opt xx then act >> return () else return () 
---    mapM_ (gfc . lang) langs
+  let ifxx opt act = if            elem opt xx then act >> return () else return () 
---    system $ "cp */*.gfo ../alltenses"
+  ifx "lang" $ do
-    mapM_ (gfc . try) langs
+    mapM_ (gfc . lang) langsLang
     system $ "cp */*.gfo ../alltenses"
+  ifx "api" $ do
+    mapM_ (gfc . try) langsAPI
+    system $ "cp */*.gfo ../alltenses"
+  ifxx "pgf" $ do
+    system $ "gfc -s --make --name=langs --parser=off --output-dir=../alltenses " ++
+              unwords ["../alltenses/Lang" ++ la ++ ".gfo" | (_,la) <- langsPGF] ++
+              " +RTS -K100M"
+  ifxx "test" $ do
+    gf treeb $ unwords ["../alltenses/Lang" ++ la ++ ".gfo" | (_,la) <- langsTest]
+  ifxx "clean" $ do
+    system "rm */*.gfo ../alltenses/*.gfo"
+  return ()
 
 gfc file = do
   putStrLn $ "compiling " ++ file
   system $ "gfc -s " ++ file
 
+gf comm file = do
+  putStrLn $ "reading " ++ file
+  system $ "echo \"" ++ comm ++ "\" | gf3 -s " ++ file
+
+treeb = "rf -lines -term -file=" ++ treebankExx ++ 
+        " | l -treebank | wf -file=" ++ treebankResults
+
 lang (lla,la) = lla ++ "/Lang" ++ la ++ ".gf"
 try  (lla,la) = "api/Try"  ++ la ++ ".gf"
+
+except ls es = filter (flip notElem es . snd) ls
+only   ls es = filter (flip elem es . snd) ls

lib/resource-1.4/exx-resource.gft

@@ -0,0 +1,150 @@
+PositA warm_A
+ComparA warm_A (UsePron i_Pron)
+ComplA2 married_A2 (UsePron she_Pron)
+ReflA2 married_A2
+PositA (UseA2 married_A2)
+SentAP (PositA good_A) (EmbedS (UseCl TPres ASimul PPos (PredVP (UsePron she_Pron) (UseComp (CompAdv here_Adv)))))
+AdAP very_AdA (PositA warm_A)
+PositAdvAdj warm_A
+PrepNP in_Prep (DetArtSg DefArt (UseN house_N))
+ComparAdvAdj more_CAdv warm_A (UsePN john_PN)
+ComparAdvAdjS more_CAdv warm_A (UseCl TPres ASimul PPos (PredVP (UsePron he_Pron) (UseV run_V)))
+SubjS when_Subj (UseCl TPres ASimul PPos (PredVP (UsePron she_Pron) (UseV sleep_V)))
+AdNum (AdnCAdv more_CAdv) (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))
+ConjS and_Conj (BaseS (UseCl TPres ASimul PPos (PredVP (UsePron he_Pron) (UseV walk_V))) (UseCl TPres ASimul PPos (PredVP (UsePron she_Pron) (UseV run_V))))
+ConjAP and_Conj (BaseAP (PositA cold_A) (PositA warm_A))
+ConjNP or_Conj (BaseNP (UsePron she_Pron) (UsePron we_Pron))
+ConjAdv or_Conj (BaseAdv here_Adv there_Adv)
+ConjS either7or_DConj (BaseS (UseCl TPres ASimul PPos (PredVP (UsePron he_Pron) (UseV walk_V))) (UseCl TPres ASimul PPos (PredVP (UsePron she_Pron) (UseV run_V))))
+ConjAP both7and_DConj (BaseAP (PositA warm_A) (PositA cold_A))
+ConjNP either7or_DConj (BaseNP (UsePron he_Pron) (UsePron she_Pron))
+ConjAdv both7and_DConj (BaseAdv here_Adv there_Adv)
+ImpersCl (UseComp (CompAP (PositA hot_A)))
+GenericCl (UseV sleep_V)
+CleftNP (UsePron i_Pron) (UseRCl TPast ASimul PPos (RelVP IdRP (ComplSlash (SlashV2a do_V2) (UsePron it_Pron))))
+CleftAdv here_Adv (UseCl TPast ASimul PPos (PredVP (UsePron she_Pron) (UseV sleep_V)))
+ExistNP (DetArtSg IndefArt (UseN house_N))
+ExistIP (IdetCN (IdetQuant which_IQuant NumPl) (UseN house_N))
+PredVP (UsePron i_Pron) (ProgrVP (UseV sleep_V))
+ImpPl1 (UseV go_V)
+DetArtSg DefArt (UseN man_N)
+UsePN john_PN
+UsePron he_Pron
+PredetNP only_Predet (DetArtSg DefArt (UseN man_N))
+PPartNP (DetArtSg DefArt (UseN man_N)) see_V2
+AdvNP (UsePN paris_PN) today_Adv
+RelNP (UsePN paris_PN) (UseRCl TPres ASimul PPos (RelVP IdRP (UseComp (CompAdv here_Adv))))
+DetNP (DetQuant this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))))
+DetCN (DetQuantOrd this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))) (OrdSuperl good_A)) (UseN man_N)
+DetCN (DetQuant this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) (UseN man_N)
+DetCN (DetQuant this_Quant NumPl) (UseN man_N)
+DetCN (DetQuant this_Quant NumSg) (UseN man_N)
+NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))
+NumCard (NumDigits (IIDig D_5 (IDig D_1)))
+NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot1plus n5 pot01)))))
+NumCard (AdNum almost_AdN (NumDigits (IIDig D_5 (IDig D_1))))
+OrdDigits (IIDig D_5 (IDig D_1))
+OrdNumeral (num (pot2as3 (pot1as2 (pot1plus n5 pot01))))
+OrdSuperl warm_A
+DetCN (DetArtOrd DefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))) (OrdSuperl good_A)) (UseN man_N)
+DetCN (DetArtCard DefArt (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))) (UseN man_N)
+DetCN (DetArtCard IndefArt (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 pot01)))))) (UseN man_N)
+DetCN (DetArtCard DefArt (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 pot01)))))) (UseN man_N)
+DetArtSg DefArt (UseN man_N)
+DetArtPl DefArt (UseN man_N)
+MassNP (UseN beer_N)
+DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN house_N)
+UseN house_N
+ComplN2 mother_N2 (DetArtSg DefArt (UseN king_N))
+ComplN2 (ComplN3 distance_N3 (DetCN (DetQuant this_Quant NumSg) (UseN city_N))) (UsePN paris_PN)
+UseN2 mother_N2
+ComplN2 (Use2N3 distance_N3) (DetCN (DetQuant this_Quant NumSg) (UseN city_N))
+ComplN2 (Use3N3 distance_N3) (UsePN paris_PN)
+UseN2 (Use2N3 distance_N3)
+AdjCN (PositA big_A) (UseN house_N)
+RelCN (UseN house_N) (UseRCl TPast ASimul PPos (RelSlash IdRP (SlashVP (UsePN john_PN) (SlashV2a buy_V2))))
+AdvCN (UseN house_N) (PrepNP on_Prep (DetArtSg DefArt (UseN hill_N)))
+SentCN (UseN question_N) (EmbedQS (UseQCl TPres ASimul PPos (QuestIAdv where_IAdv (PredVP (UsePron she_Pron) (UseV sleep_V)))))
+ApposCN (UseN city_N) (UsePN paris_PN)
+num (pot2as3 (pot1as2 (pot0as1 (pot0 n6))))
+num (pot2as3 (pot1as2 (pot0as1 pot01)))
+num (pot2as3 (pot1as2 (pot1 n6)))
+num (pot2as3 (pot1as2 pot110))
+num (pot2as3 (pot1as2 pot111))
+num (pot2as3 (pot1as2 (pot1to19 n6)))
+num (pot2as3 (pot1as2 (pot1 n6)))
+num (pot2as3 (pot1as2 (pot1plus n6 (pot0 n5))))
+num (pot2as3 (pot2 (pot0 n4)))
+num (pot2as3 (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7))))
+num (pot3 (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7))))
+num (pot3plus (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7))) (pot1as2 (pot1plus n8 (pot0 n9))))
+IDig D_8
+IIDig D_8 (IIDig D_0 (IIDig D_0 (IIDig D_1 (IIDig D_7 (IIDig D_8 (IDig D_9))))))
+PhrUtt but_PConj (UttImpSg PPos (ImpVP (AdvVP (UseV come_V) here_Adv))) (VocNP (DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN friend_N)))
+PhrUtt NoPConj (UttS (UseCl TPres ASimul PPos (PredVP (UsePN john_PN) (UseV walk_V)))) NoVoc
+UttQS (UseQCl TPres ASimul PPos (QuestCl (PredVP (UsePron it_Pron) (UseComp (CompAP (PositA good_A))))))
+UttImpSg PNeg (ImpVP (ReflVP (SlashV2a love_V2)))
+UttImpPl PNeg (ImpVP (ReflVP (SlashV2a love_V2)))
+UttImpPol PNeg (ImpVP (UseV sleep_V))
+UttIP whoPl_IP
+UttIP whoSg_IP
+UttIAdv why_IAdv
+UttNP (DetCN (DetQuant this_Quant NumSg) (UseN man_N))
+UttAdv here_Adv
+UttVP (UseV sleep_V)
+VocNP (DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN friend_N))
+QuestCl (PredVP (UsePN john_PN) (UseV walk_V))
+QuestVP whoSg_IP (UseV walk_V)
+QuestSlash whoSg_IP (SlashVP (UsePN john_PN) (SlashV2a love_V2))
+QuestIAdv why_IAdv (PredVP (UsePN john_PN) (UseV walk_V))
+QuestIComp (CompIAdv where_IAdv) (UsePN john_PN)
+IdetCN (IdetQuant which_IQuant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) (UseN song_N)
+IdetIP (IdetQuant which_IQuant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))))
+AdvIP whoSg_IP (PrepNP in_Prep (UsePN paris_PN))
+IdetIP (IdetQuant which_IQuant NumSg)
+PrepIP with_Prep whoSg_IP
+QuestIComp (CompIAdv where_IAdv) (UsePron it_Pron)
+QuestIComp (CompIP whoSg_IP) (UsePron it_Pron)
+ExistNP (DetArtSg IndefArt (RelCN (UseN woman_N) (UseRCl TPres ASimul PPos (RelCl (PredVP (UsePN john_PN) (ComplSlash (SlashV2a love_V2) (UsePron she_Pron)))))))
+ExistNP (DetArtSg IndefArt (RelCN (UseN woman_N) (UseRCl TPres ASimul PPos (RelVP IdRP (ComplSlash (SlashV2a love_V2) (UsePN john_PN))))))
+ExistNP (DetArtSg IndefArt (RelCN (UseN woman_N) (UseRCl TPres ASimul PPos (RelSlash IdRP (SlashVP (UsePN john_PN) (SlashV2a love_V2))))))
+ExistNP (DetArtSg IndefArt (RelCN (UseN woman_N) (UseRCl TPres ASimul PPos (RelSlash (FunRP possess_Prep (DetArtSg DefArt (UseN2 mother_N2)) IdRP) (SlashVP (UsePN john_PN) (SlashV2a love_V2))))))
+PredVP (UsePN john_PN) (UseV walk_V)
+PredSCVP (EmbedS (UseCl TPres ASimul PPos (PredVP (UsePron she_Pron) (UseV go_V)))) (UseComp (CompAP (PositA good_A)))
+RelCN (UseN girl_N) (UseRCl TPres ASimul PPos (RelSlash IdRP (SlashVP (UsePron he_Pron) (SlashV2a see_V2))))
+RelCN (UseN girl_N) (UseRCl TPres ASimul PPos (RelSlash IdRP (AdvSlash (SlashVP (UsePron he_Pron) (SlashV2a see_V2)) today_Adv)))
+RelCN (UseN girl_N) (UseRCl TPres ASimul PPos (RelSlash IdRP (SlashPrep (PredVP (UsePron he_Pron) (UseV walk_V)) with_Prep)))
+RelCN (UseN girl_N) (UseRCl TPres ASimul PPos (RelSlash IdRP (SlashVS (UsePron she_Pron) say_VS (UseSlash TPres ASimul PPos (SlashVP (UsePron he_Pron) (SlashV2a love_V2))))))
+ImpVP (ReflVP (SlashV2a love_V2))
+EmbedS (UseCl TPres ASimul PPos (PredVP (UsePron she_Pron) (UseV go_V)))
+EmbedQS (UseQCl TPres ASimul PPos (QuestVP whoSg_IP (UseV go_V)))
+EmbedVP (UseV go_V)
+UseCl TCond AAnter PNeg (PredVP (UsePN john_PN) (UseV walk_V))
+UseQCl TCond AAnter PNeg (QuestCl (PredVP (UsePN john_PN) (UseV walk_V)))
+RelCN (UseN girl_N) (UseRCl TCond AAnter PNeg (RelVP IdRP (UseV walk_V)))
+RelCN (UseN girl_N) (UseRCl TCond AAnter PNeg (RelSlash IdRP (SlashPrep (PredVP (UsePron i_Pron) (UseV walk_V)) with_Prep)))
+RelS (UseCl TPres ASimul PPos (PredVP (UsePron she_Pron) (UseV sleep_V))) (UseRCl TPres ASimul PPos (RelVP IdRP (UseComp (CompAP (PositA good_A)))))
+TEmpty
+TFullStop (PhrUtt NoPConj (UttS (UseCl TPres ASimul PPos (PredVP (UsePN john_PN) (UseV walk_V)))) NoVoc) TEmpty
+TQuestMark (PhrUtt NoPConj (UttQS (UseQCl TPres ASimul PPos (QuestCl (PredVP (UsePron they_Pron) (UseComp (CompAdv here_Adv)))))) NoVoc) TEmpty
+TExclMark (PhrUtt NoPConj (ImpPl1 (UseV go_V)) NoVoc) TEmpty
+PredVP (UsePron i_Pron) (UseV sleep_V)
+PredVP (UsePron i_Pron) (ComplVV want_VV (UseV run_V))
+PredVP (UsePron i_Pron) (ComplVS say_VS (UseCl TPres ASimul PPos (PredVP (UsePron she_Pron) (UseV run_V))))
+PredVP (UsePron i_Pron) (ComplVQ wonder_VQ (UseQCl TPres ASimul PPos (QuestVP whoSg_IP (UseV run_V))))
+PredVP (UsePron they_Pron) (ComplVA become_VA (PositA red_A))
+PredVP (UsePron i_Pron) (ComplSlash (Slash3V3 give_V3 (UsePron he_Pron)) (UsePron it_Pron))
+PredVP (UsePron i_Pron) (ComplSlash (SlashV2V beg_V2V (UseV go_V)) (UsePron she_Pron))
+PredVP (UsePron i_Pron) (ComplSlash (SlashV2S answer_V2S (UseCl TPres ASimul PPos (PredVP (UsePron it_Pron) (UseComp (CompAP (PositA good_A)))))) (UsePron he_Pron))
+PredVP (UsePron i_Pron) (ComplSlash (SlashV2Q ask_V2Q (UseQCl TPast ASimul PPos (QuestVP whoSg_IP (UseV come_V)))) (UsePron he_Pron))
+PredVP (UsePron i_Pron) (ComplSlash (SlashV2A paint_V2A (PositA red_A)) (UsePron it_Pron))
+RelCN (UseN car_N) (UseRCl TPres ASimul PPos (RelSlash IdRP (SlashVP (UsePron i_Pron) (SlashVV want_VV (SlashV2a buy_V2)))))
+RelCN (UseN car_N) (UseRCl TPres ASimul PPos (RelSlash IdRP (SlashVP (UsePron they_Pron) (SlashV2VNP beg_V2V (UsePron i_Pron) (SlashV2a buy_V2)))))
+PredVP (UsePron he_Pron) (ReflVP (SlashV2a love_V2))
+PredVP (DetNP (DetQuant this_Quant NumSg)) (UseComp (CompAP (PositA warm_A)))
+PredVP (UsePron we_Pron) (PassV2 love_V2)
+PredVP (UsePron we_Pron) (AdvVP (UseV sleep_V) here_Adv)
+PredVP (UsePron we_Pron) (AdVVP always_AdV (UseV sleep_V))
+PredVP (UsePron we_Pron) (UseComp (CompAP (PositA small_A)))
+PredVP (UsePron i_Pron) (UseComp (CompNP (DetArtSg IndefArt (UseN man_N))))
+PredVP (UsePron i_Pron) (UseComp (CompAdv here_Adv))

src-3.0/GF/Command/Commands.hs

@@ -66,6 +66,15 @@ commandHelp full (co,info) = unlines $ [
 -- this list must no more be kept sorted by the command name
 allCommands :: PGF -> Map.Map String CommandInfo
 allCommands pgf = Map.fromList [
+  ("af", emptyCommandInfo {
+     longname = "append_file",
+     synopsis = "append string or tree to a file",
+     exec = \opts arg -> do
+         let file = valIdOpts "file" "_gftmp" opts
+         appendFile file (toString arg)
+         return void,
+     flags = ["file"]
+    }),
   ("cc", emptyCommandInfo {
      longname = "compute_concrete",
      synopsis = "computes concrete syntax term using the source grammar",
@@ -225,14 +234,16 @@ allCommands pgf = Map.fromList [
        ],
      options = ["lines","term"],
      exec = \opts arg -> do 
-       s <- readFile (toString arg)
+       let file = valIdOpts "file" "_gftmp" opts
+       s <- readFile file
        return $ case opts of
          _ | isOpt "lines" opts && isOpt "term" opts -> 
                fromTrees [t | l <- lines s, Just t <- [readExp l]] 
          _ | isOpt "term" opts -> 
                fromTrees [t | Just t <- [readExp s]] 
          _ | isOpt "lines" opts -> fromStrings $ lines s 
-         _ -> fromString s 
+         _ -> fromString s,
+     flags = ["file"] 
      }),
   ("wf", emptyCommandInfo {
      longname = "write_file",
@@ -240,7 +251,8 @@ allCommands pgf = Map.fromList [
      exec = \opts arg -> do
          let file = valIdOpts "file" "_gftmp" opts
          writeFile file (toString arg)
-         return void
+         return void,
+     flags = ["file"] 
      })
   ]
  where