moved Symbol and Symbolic to new places to eliminate mathematical in next-resource

lib/next-resource/Make.hs

@@ -0,0 +1,199 @@
+module Main where
+
+import Control.Monad
+import Data.Maybe
+import System.Cmd
+import System.Directory
+import System.Environment
+import System.Exit
+
+-- Make commands for compiling and testing resource grammars.
+-- usage: runghc Make ((present? OPT?) | (clone FILE))? LANGS? 
+-- where 
+-- - OPT = (lang | api | math | pgf | test | demo | clean)
+-- - LANGS has the form e.g. langs=Eng,Fin,Rus
+-- - clone with a flag file=FILENAME clones the file to the specified languages,
+--   by replacing the 3-letter language name of the original in both 
+--   the filename and the body
+--   with each name in the list (default: all languages)
+-- With no argument, lang and api are done, in this order.
+-- See 'make' below for what is done by which command.
+
+default_gfc = "../../bin/gfc"
+
+presApiPath = "-path=api:present"
+
+-- the languages have long directory names and short ISO codes (3 letters)
+-- we also give the decodings for postprocessing linearizations, as long as grammars
+-- don't support all flags needed; they are used in tests
+ 
+langsCoding = [
+  (("arabic",   "Ara"),""),
+  (("bulgarian","Bul"),""),
+  (("catalan",  "Cat"),""),
+  (("danish",   "Dan"),""),
+  (("english",  "Eng"),""),
+  (("finnish",  "Fin"),""),
+  (("french",   "Fre"),""),
+  (("hindi",    "Hin"),"to_devanagari"),
+  (("german",   "Ger"),""),
+  (("interlingua","Ina"),""),
+  (("italian",  "Ita"),""),
+  (("norwegian","Nor"),""),
+  (("russian",  "Rus"),""),
+  (("spanish",  "Spa"),""),
+  (("swedish",  "Swe"),""), 
+  (("thai",     "Tha"),"to_thai")
+  ]
+
+langs = map fst langsCoding
+
+-- languagues for which to compile Lang
+langsLang = langs `except` ["Ara"]
+
+-- languages for which to compile Try 
+langsAPI  = langsLang `except` ["Ara","Bul","Hin","Ina","Rus","Tha"]
+
+-- languages for which to compile Mathematical 
+langsMath = langsAPI
+
+-- languages for which to run treebank test
+langsTest = langsLang `except` ["Ara","Bul","Cat","Hin","Rus","Spa","Tha"]
+
+-- languages for which to run demo test
+langsDemo = langsLang `except` ["Ara","Hin","Ina","Tha"]
+
+-- languages for which langs.pgf is built
+langsPGF = langsTest `only` ["Eng","Fre","Swe"]
+
+-- languages for which Compatibility exists (to be extended)
+langsCompat = langsLang `only` ["Cat","Eng","Fin","Fre","Ita","Spa","Swe"]
+
+treebankExx = "exx-resource.gft"
+treebankResults = "exx-resource.gftb"
+
+main = do
+  xx <- getArgs
+  make xx
+
+make :: [String] -> IO ()
+make xx = do
+  let ifx  opt act = if null xx || elem opt xx then act >> return () else return () 
+  let ifxx opt act = if            elem opt xx then act >> return () else return () 
+  let pres = elem "present" xx
+  let dir = if pres then "../present" else "../alltenses"
+   
+  let optl ls = maybe ls id $ getOptLangs xx
+
+  ifx "lang" $ do
+    mapM_ (gfc pres [] . lang) (optl langsLang)
+    copy "*/*.gfo" dir
+  ifx "compat" $ do
+    mapM_ (gfc pres [] . compat) (optl langsCompat)
+    copy "*/Compatibility*.gfo" dir
+  ifx "api" $ do
+    mapM_ (gfc pres presApiPath . try) (optl langsAPI)
+    copy "*/*.gfo" dir
+  ifx "math" $ do
+    mapM_ (gfc False [] . math) (optl langsMath)
+    copy "mathematical/*.gfo" "../mathematical"
+    mapM_ (gfc False [] . symbolic) (optl langsMath)
+    copy "mathematical/Symbolic*.gfo" "../mathematical"
+  ifxx "pgf" $ do
+    run_gfc $ ["-s","--make","--name=langs","--parser=off",
+               "--output-dir=" ++ dir]
+               ++ [dir ++ "/Lang" ++ la ++ ".gfo" | (_,la) <- optl langsPGF]
+  ifxx "test" $ do
+    let ls = optl langsTest
+    gf (treeb "Lang" ls) $ unwords [dir ++ "/Lang" ++ la ++ ".gfo" | (_,la) <- ls] 
+  ifxx "demo" $ do
+    let ls = optl langsDemo
+    gf (demos "Demo" ls) $ unwords ["demo/Demo" ++ la ++ ".gf" | (_,la) <- ls]
+  ifxx "clean" $ do
+    system "rm -f */*.gfo ../alltenses/*.gfo ../present/*.gfo"
+  ifxx "clone" $ do
+    let (pref,lang) = case getLangName xx of
+          Just pl -> pl
+          _ -> error "expected flag option file=ppppppLLL.gf"
+    s <- readFile (pref ++ lang ++ ".gf")
+    mapM_ (\la -> writeFile (pref ++ la ++ ".gf") (replaceLang lang la s)) (map snd (optl langs))
+  return ()
+
+gfc pres ppath file = do
+  let preproc = if pres then "-preproc=./mkPresent" else ""
+  let path    = if pres then ppath else ""
+  putStrLn $ "Compiling " ++ file
+  run_gfc ["-s","-src", preproc, path, file]
+
+gf comm file = do
+  putStrLn $ "Reading " ++ file
+  let cmd = "echo \"" ++ comm ++ "\" | gf -s " ++ file
+  putStrLn cmd
+  system cmd
+
+treeb abstr ls = "rf -lines -tree -file=" ++ treebankExx ++ 
+        " | l -treebank " ++ unlexer abstr ls ++ " | wf -file=" ++ treebankResults
+
+demos abstr ls = "gr -number=100 | l -treebank " ++ unlexer abstr ls ++ 
+           " | ps -to_html | wf -file=resdemo.html"
+
+lang (lla,la) = lla ++ "/All" ++ la ++ ".gf"
+compat (lla,la) = lla ++ "/Compatibility" ++ la ++ ".gf"
+try  (lla,la) = "api/Try"  ++ la ++ ".gf"
+math (lla,la) = "mathematical/Mathematical"  ++ la ++ ".gf"
+symbolic (lla,la) = "mathematical/Symbolic"  ++ la ++ ".gf"
+
+except ls es = filter (flip notElem es . snd) ls
+only   ls es = filter (flip elem es . snd) ls
+
+-- list of languages overriding the definitions above
+getOptLangs args = case [ls | a <- args, let (f,ls) = splitAt 6 a, f=="langs="] of
+  ls:_ -> return $ findLangs $ seps ls
+  _ -> Nothing
+ where
+  seps = words . map (\c -> if c==',' then ' ' else c)
+  findLangs ls = [lang | lang@(_,la) <- langs, elem la ls]
+
+-- the file name has the form p....pLLL.gf, i.e. 3-letter lang name, suffix .gf
+getLangName args = case [ls | a <- args, let (f,ls) = splitAt 5 a, f=="file="] of
+  fi:_ -> let (nal,ferp) = splitAt 3 (drop 3 (reverse fi)) in return (reverse ferp,reverse nal)  
+  _ -> Nothing
+
+replaceLang s1 s2 = repl where
+  repl s = case s of
+    c:cs -> case splitAt lgs s of
+      (pre,rest) | pre == s1 -> s2 ++ repl rest
+      _                      -> c : repl cs
+    _ -> s
+  lgs = 3 -- length s1
+
+unlexer abstr ls = 
+  "-unlexer=\\\"" ++ unwords 
+      [abstr ++ la ++ "=" ++ unl | 
+        lla@(_,la) <- ls, let unl = unlex lla, not (null unl)] ++ 
+      "\\\""
+    where
+      unlex lla = maybe "" id $ lookup lla langsCoding
+
+-- | Runs the gfc executable with the given arguments.
+run_gfc :: [String] -> IO ()
+run_gfc args = 
+    do p <- liftM (fromMaybe default_gfc) $ findExecutable "gfc"
+       env <- getEnvironment
+       case lookup "GF_LIB_PATH" env of
+            Nothing -> putStrLn "$GF_LIB_PATH is not set."
+            Just _  -> 
+                do let args' = filter (not . null) args ++ ["+RTS"] ++ rts_flags ++ ["-RTS"]
+                       cmd = p ++ " " ++ unwords (map showArg args')
+                   putStrLn $ "Running: " ++ cmd
+                   e <- system cmd
+                   case e of
+                     ExitSuccess -> return ()
+                     ExitFailure i -> putStrLn $ "gfc exited with exit code: " ++ show i
+  where rts_flags = ["-K100M"]
+        showArg arg = "'" ++ arg ++ "'"
+
+copy :: String -> String -> IO ()
+copy from to = 
+    do system $ "cp " ++ from ++ " " ++ to
+       return ()

lib/next-resource/abstract/Symbol.gf

@@ -0,0 +1,46 @@
+--1 Symbolic expressions
+
+-- *Note*. This module is not automatically included in the main
+-- grammar [Lang Lang.html].
+
+abstract Symbol = Cat, PredefAbs ** {
+
+--2 Noun phrases with symbols and numbers
+
+fun
+
+  SymbPN   : Symb -> PN ;                -- x
+  IntPN    : Int -> PN ;                 -- 27
+  FloatPN  : Float -> PN ;               -- 3.14159
+  NumPN    : Card -> PN ;
+  CNNumNP  : CN -> Card -> NP ;          -- level five ; level 5
+  CNSymbNP : Det -> CN -> [Symb] -> NP ; -- (the) (2) numbers x and y
+
+
+--2 Sentence consisting of a formula
+
+  SymbS    : Symb -> S ;                 -- A
+
+--2 Symbols as numerals
+
+  SymbNum  : Symb -> Card ;              -- n
+  SymbOrd  : Symb -> Ord ;               -- n'th
+
+--2 Symbol lists
+
+-- A symbol list has at least two elements. The last two are separated
+-- by a conjunction ("and" in English), the others by commas.
+-- This produces "x, y and z", in English. 
+
+cat
+  Symb ;
+  [Symb]{2} ;
+
+fun
+  MkSymb : String -> Symb ;
+
+--2 Obsolescent
+
+  CNIntNP  : CN -> Int -> NP ;           -- level 53 (covered by CNNumNP)
+
+}

lib/next-resource/api/Constructors.gf

@@ -1109,6 +1109,13 @@ incomplete resource Constructors = open Grammar in {
     plNum : Num = NumPl ;
 
 
+    mkCard = overload {
+      mkCard : Numeral -> Card 
+        = NumNumeral ;
+      mkNum : Digits -> Card         -- 51
+        = NumDigits ;
+      } ;
+
     mkNum = overload {
       mkNum : Numeral -> Num 
         = \d -> NumCard (NumNumeral d) ;

lib/next-resource/api/Symbolic.gf

@@ -0,0 +1,62 @@
+--1 Symbolic: Noun Phrases with mathematical symbols
+
+incomplete resource Symbolic = open 
+    Symbol, Syntax, PredefCnc in {
+
+  oper
+    symb : overload {
+      symb : Str -> NP ;                       -- x
+      symb : Int -> NP ;                       -- 23
+      symb : Float -> NP ;                     -- 0.99
+      symb : N  -> Digits -> NP ;              -- level 4
+      symb : N  -> Card -> NP ;                -- level four
+      symb : CN -> Card -> NP ;                -- advanced level four
+      symb : Det -> N  -> Card -> NP ;         -- the number four
+      symb : Det -> CN -> Card -> NP ;         -- the even number four
+      symb : Det -> N  -> Str -> Str -> NP ;   -- the levels i and j
+      symb : Det -> CN -> [Symb] -> NP ;       -- the basic levels i, j, and k
+      symb : Symb -> S ;                       -- A
+      symb : Symb -> Card ;                    -- n
+      symb : Symb -> Ord                       -- n'th
+      } ;
+
+    mkSymb  : Str -> Symb ;
+    mkInt   : Str -> PredefCnc.Int ;
+    mkFloat : Str -> PredefCnc.Float ;
+
+--.
+
+    symb = overload {
+      symb : Str -> NP 
+                          = \s -> mkNP (SymbPN (mkSymb s)) ;
+      symb : Int -> NP 
+                          = \i -> mkNP (IntPN i) ;
+      symb : Float -> NP 
+                          = \i -> mkNP (FloatPN i) ;
+      symb : N -> Digits -> NP 
+                          = \c,i -> CNNumNP (mkCN c) (mkCard i) ;
+      symb : N -> Card -> NP 
+                          = \c,n -> CNNumNP (mkCN c) n ;
+      symb : CN -> Card -> NP 
+                          = \c,n -> CNNumNP c n ;
+      symb : Det -> N  -> Card -> NP
+                          = \d,n,x -> mkNP d (mkCN (mkCN n) (mkNP (NumPN x))) ;
+      symb : Det -> CN -> Card -> NP
+                          = \d,n,x -> mkNP d (mkCN n (mkNP (NumPN x))) ;
+      symb : Det -> N  -> Str -> Str -> NP 
+                          = \c,n,x,y -> CNSymbNP c (mkCN n) (BaseSymb (mkSymb x) (mkSymb y)) ;
+      symb : Det -> CN -> [Symb] -> NP 
+                          = CNSymbNP ;
+      symb : Symb -> S = SymbS ;
+      symb : Symb -> Card = SymbNum ;
+      symb : Symb -> Ord = SymbOrd
+
+      } ;
+
+    mkSymb : Str -> Symb = \s -> {s = s ; lock_Symb = <>} ;
+
+    mkInt i = {s = i ; lock_Int = <>} ;
+    mkFloat f = {s = f ; lock_Float = <>} ;
+
+
+}

lib/next-resource/api/SymbolicEng.gf

@@ -0,0 +1,5 @@
+--# -path=.:present:prelude
+
+resource SymbolicEng = Symbolic with 
+  (Symbol = SymbolEng),
+  (Syntax = SyntaxEng) ;

lib/next-resource/english/SymbolEng.gf

@@ -0,0 +1,37 @@
+concrete SymbolEng of Symbol = CatEng ** open Prelude, ResEng in {
+
+lin
+  SymbPN i = {s = \\c => i.s ; g = Neutr} ; --- c
+  IntPN i  = {s = \\c => i.s ; g = Neutr} ; --- c
+  FloatPN i = {s = \\c => i.s ; g = Neutr} ; --- c
+  NumPN i = {s = \\c => i.s ; g = Neutr} ; --- c
+  CNIntNP cn i = {
+    s = \\c => (cn.s ! Sg ! Nom ++ i.s) ;
+    a = agrgP3 Sg cn.g
+    } ;
+  CNSymbNP det cn xs = {
+    s = \\c => det.s ++ cn.s ! det.n ! c ++ xs.s ; 
+    a = agrgP3 det.n cn.g
+    } ;
+  CNNumNP cn i = {
+    s = \\c => (cn.s ! Sg ! Nom ++ i.s) ;
+    a = agrgP3 Sg cn.g
+    } ;
+
+  SymbS sy = sy ; 
+
+  SymbNum sy = {s = sy.s ; n = Pl ; hasCard = True} ;
+  SymbOrd sy = {s = sy.s ++ "th"} ;
+
+lincat 
+
+  Symb, [Symb] = SS ;
+
+lin
+
+  MkSymb s = s ;
+
+  BaseSymb = infixSS "and" ;
+  ConsSymb = infixSS "," ;
+
+}