From 994c2f349f6742484c434b3eb7fed3e29f6299ed Mon Sep 17 00:00:00 2001 From: aarne Date: Sat, 13 Sep 2008 10:39:18 +0000 Subject: [PATCH] moved Symbol and Symbolic to new places to eliminate mathematical in next-resource --- lib/next-resource/Make.hs | 199 +++++++++++++++++++++++++ lib/next-resource/abstract/Symbol.gf | 46 ++++++ lib/next-resource/api/Constructors.gf | 7 + lib/next-resource/api/Symbolic.gf | 62 ++++++++ lib/next-resource/api/SymbolicEng.gf | 5 + lib/next-resource/english/SymbolEng.gf | 37 +++++ 6 files changed, 356 insertions(+) create mode 100644 lib/next-resource/Make.hs create mode 100644 lib/next-resource/abstract/Symbol.gf create mode 100644 lib/next-resource/api/Symbolic.gf create mode 100644 lib/next-resource/api/SymbolicEng.gf create mode 100644 lib/next-resource/english/SymbolEng.gf diff --git a/lib/next-resource/Make.hs b/lib/next-resource/Make.hs new file mode 100644 index 000000000..973e6def1 --- /dev/null +++ b/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 () diff --git a/lib/next-resource/abstract/Symbol.gf b/lib/next-resource/abstract/Symbol.gf new file mode 100644 index 000000000..a8ac9ca1b --- /dev/null +++ b/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) + +} diff --git a/lib/next-resource/api/Constructors.gf b/lib/next-resource/api/Constructors.gf index db86dfb1f..8ebd94958 100644 --- a/lib/next-resource/api/Constructors.gf +++ b/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) ; diff --git a/lib/next-resource/api/Symbolic.gf b/lib/next-resource/api/Symbolic.gf new file mode 100644 index 000000000..2a621cf9c --- /dev/null +++ b/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 = <>} ; + + +} diff --git a/lib/next-resource/api/SymbolicEng.gf b/lib/next-resource/api/SymbolicEng.gf new file mode 100644 index 000000000..0ce4725fa --- /dev/null +++ b/lib/next-resource/api/SymbolicEng.gf @@ -0,0 +1,5 @@ +--# -path=.:present:prelude + +resource SymbolicEng = Symbolic with + (Symbol = SymbolEng), + (Syntax = SyntaxEng) ; diff --git a/lib/next-resource/english/SymbolEng.gf b/lib/next-resource/english/SymbolEng.gf new file mode 100644 index 000000000..488c3fbdd --- /dev/null +++ b/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 "," ; + +}