mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-24 03:52:50 -06:00
langs option to Make.hs ; utf8 exception in linearization from the coding flag in grammar
This commit is contained in:
@@ -3,7 +3,8 @@ module Main where
|
|||||||
import System
|
import System
|
||||||
|
|
||||||
-- Make commands for compiling and testing resource grammars.
|
-- Make commands for compiling and testing resource grammars.
|
||||||
-- usage: runghc Make present? (lang | api | math | pgf | test | demo | clean)?
|
-- usage: runghc Make present? (lang | api | math | pgf | test | demo | clean)? langs?
|
||||||
|
-- where langs has the form e.g. langs=Eng,Fin,Rus
|
||||||
-- With no argument, lang and api are done, in this order.
|
-- With no argument, lang and api are done, in this order.
|
||||||
-- See 'make' below for what is done by which command.
|
-- See 'make' below for what is done by which command.
|
||||||
|
|
||||||
@@ -56,25 +57,28 @@ make xx = do
|
|||||||
let ifxx opt act = if 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 pres = elem "present" xx
|
||||||
let dir = if pres then "../present" else "../alltenses"
|
let dir = if pres then "../present" else "../alltenses"
|
||||||
|
|
||||||
|
let optl ls = maybe ls id $ getOptLangs xx
|
||||||
|
|
||||||
ifx "lang" $ do
|
ifx "lang" $ do
|
||||||
mapM_ (gfc pres [] . lang) langsLang
|
mapM_ (gfc pres [] . lang) (optl langsLang)
|
||||||
system $ "cp */*.gfo " ++ dir
|
system $ "cp */*.gfo " ++ dir
|
||||||
ifx "api" $ do
|
ifx "api" $ do
|
||||||
mapM_ (gfc pres presApiPath . try) langsAPI
|
mapM_ (gfc pres presApiPath . try) (optl langsAPI)
|
||||||
system $ "cp */*.gfo " ++ dir
|
system $ "cp */*.gfo " ++ dir
|
||||||
ifx "math" $ do
|
ifx "math" $ do
|
||||||
mapM_ (gfc False [] . math) langsMath
|
mapM_ (gfc False [] . math) (optl langsMath)
|
||||||
system $ "cp mathematical/*.gfo ../mathematical"
|
system $ "cp mathematical/*.gfo ../mathematical"
|
||||||
mapM_ (gfc False [] . symbolic) langsMath
|
mapM_ (gfc False [] . symbolic) (optl langsMath)
|
||||||
system $ "cp mathematical/Symbolic*.gfo ../mathematical"
|
system $ "cp mathematical/Symbolic*.gfo ../mathematical"
|
||||||
ifxx "pgf" $ do
|
ifxx "pgf" $ do
|
||||||
system $ "gfc -s --make --name=langs --parser=off --output-dir=" ++ dir ++ " " ++
|
system $ "gfc -s --make --name=langs --parser=off --output-dir=" ++ dir ++ " " ++
|
||||||
unwords [dir ++ "/Lang" ++ la ++ ".gfo" | (_,la) <- langsPGF] ++
|
unwords [dir ++ "/Lang" ++ la ++ ".gfo" | (_,la) <- optl langsPGF] ++
|
||||||
" +RTS -K100M"
|
" +RTS -K100M"
|
||||||
ifxx "test" $ do
|
ifxx "test" $ do
|
||||||
gf treeb $ unwords [dir ++ "/Lang" ++ la ++ ".gfo" | (_,la) <- langsTest]
|
gf treeb $ unwords [dir ++ "/Lang" ++ la ++ ".gfo" | (_,la) <- optl langsTest]
|
||||||
ifxx "demo" $ do
|
ifxx "demo" $ do
|
||||||
gf demos $ unwords ["demo/Demo" ++ la ++ ".gf" | (_,la) <- langsDemo]
|
gf demos $ unwords ["demo/Demo" ++ la ++ ".gf" | (_,la) <- optl langsDemo]
|
||||||
ifxx "clean" $ do
|
ifxx "clean" $ do
|
||||||
system "rm */*.gfo ../alltenses/*.gfo ../present/*.gfo"
|
system "rm */*.gfo ../alltenses/*.gfo ../present/*.gfo"
|
||||||
return ()
|
return ()
|
||||||
@@ -104,3 +108,9 @@ only ls es = filter (flip elem es . snd) ls
|
|||||||
|
|
||||||
presApiPath = " -path=api:present "
|
presApiPath = " -path=api:present "
|
||||||
|
|
||||||
|
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]
|
||||||
|
|||||||
@@ -21,7 +21,8 @@ oper
|
|||||||
Pl => case co of {
|
Pl => case co of {
|
||||||
NCard Masc => "-cents" ;
|
NCard Masc => "-cents" ;
|
||||||
NCard Fem => "-centes" ;
|
NCard Fem => "-centes" ;
|
||||||
_ => "-cents" ; ---- variants {} } ; ---- AR 23/6/2008
|
_ => "-cents" ---- variants {} ---- AR 23/6/2008
|
||||||
|
} ;
|
||||||
Sg => "cent"
|
Sg => "cent"
|
||||||
} ;
|
} ;
|
||||||
cardOrd1 : CardOrd -> (_,_,_:Str) -> Str = \co,dos,dues,segon -> case co of {
|
cardOrd1 : CardOrd -> (_,_,_:Str) -> Str = \co,dos,dues,segon -> case co of {
|
||||||
|
|||||||
@@ -18,6 +18,6 @@ concrete DemoRus of Demo =
|
|||||||
LexiconRus
|
LexiconRus
|
||||||
** {
|
** {
|
||||||
|
|
||||||
flags startcat = Phr ; unlexer = text ; lexer = text ;
|
flags startcat = Phr ; unlexer = text ; lexer = text ; coding = utf8 ;
|
||||||
|
|
||||||
} ;
|
} ;
|
||||||
|
|||||||
@@ -5,6 +5,6 @@ concrete LangRus of Lang =
|
|||||||
LexiconRus
|
LexiconRus
|
||||||
** {
|
** {
|
||||||
|
|
||||||
flags startcat = Phr ; unlexer = text ; lexer = text ;
|
flags startcat = Phr ; unlexer = text ; lexer = text ; coding=utf8 ;
|
||||||
|
|
||||||
} ;
|
} ;
|
||||||
|
|||||||
@@ -497,7 +497,11 @@ allCommands pgf = Map.fromList [
|
|||||||
(abstractName pgf ++ ": " ++ showTree t) :
|
(abstractName pgf ++ ": " ++ showTree t) :
|
||||||
[lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
|
[lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
|
||||||
|
|
||||||
unlex opts lang = stringOps opts
|
unlex opts lang = stringOps (exceptUTF8 opts) where
|
||||||
|
exceptUTF8 = if isUTF8 then filter ((/="to_UTF8") . prOpt) else id
|
||||||
|
isUTF8 = case lookFlag pgf lang "coding" of
|
||||||
|
Just "utf8" -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
optRestricted opts = restrictPGF (hasLin pgf (mkCId (optLang opts))) pgf
|
optRestricted opts = restrictPGF (hasLin pgf (mkCId (optLang opts))) pgf
|
||||||
|
|
||||||
@@ -570,3 +574,5 @@ morphologyQuiz pgf ig cat = do
|
|||||||
infinity :: Int
|
infinity :: Int
|
||||||
infinity = 256
|
infinity = 256
|
||||||
|
|
||||||
|
lookFlag :: PGF -> String -> String -> Maybe String
|
||||||
|
lookFlag pgf lang flag = lookConcrFlag pgf (mkCId lang) (mkCId flag)
|
||||||
|
|||||||
@@ -106,10 +106,17 @@ appPredefined t = case t of
|
|||||||
_ -> retb t
|
_ -> retb t
|
||||||
---- should really check the absence of arg variables
|
---- should really check the absence of arg variables
|
||||||
where
|
where
|
||||||
retb t = return (t,True) -- no further computing needed
|
retb t = return (retc t,True) -- no further computing needed
|
||||||
retf t = return (t,False) -- must be computed further
|
retf t = return (retc t,False) -- must be computed further
|
||||||
|
retc t = case t of
|
||||||
|
K [] -> t
|
||||||
|
K s -> foldr1 C (map K (words s))
|
||||||
|
_ -> t
|
||||||
norm t = case t of
|
norm t = case t of
|
||||||
Empty -> K []
|
Empty -> K []
|
||||||
|
C u v -> case (norm u,norm v) of
|
||||||
|
(K x,K y) -> K (x +++ y)
|
||||||
|
_ -> t
|
||||||
_ -> t
|
_ -> t
|
||||||
fi = fromInteger
|
fi = fromInteger
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user