diff --git a/lib/resource-1.4/Make.hs b/lib/resource-1.4/Make.hs index a83e06ee0..e4202c226 100644 --- a/lib/resource-1.4/Make.hs +++ b/lib/resource-1.4/Make.hs @@ -3,7 +3,8 @@ module Main where import System -- 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. -- 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 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) langsLang + mapM_ (gfc pres [] . lang) (optl langsLang) system $ "cp */*.gfo " ++ dir ifx "api" $ do - mapM_ (gfc pres presApiPath . try) langsAPI + mapM_ (gfc pres presApiPath . try) (optl langsAPI) system $ "cp */*.gfo " ++ dir ifx "math" $ do - mapM_ (gfc False [] . math) langsMath + mapM_ (gfc False [] . math) (optl langsMath) system $ "cp mathematical/*.gfo ../mathematical" - mapM_ (gfc False [] . symbolic) langsMath + mapM_ (gfc False [] . symbolic) (optl langsMath) system $ "cp mathematical/Symbolic*.gfo ../mathematical" ifxx "pgf" $ do 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" 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 - gf demos $ unwords ["demo/Demo" ++ la ++ ".gf" | (_,la) <- langsDemo] + gf demos $ unwords ["demo/Demo" ++ la ++ ".gf" | (_,la) <- optl langsDemo] ifxx "clean" $ do system "rm */*.gfo ../alltenses/*.gfo ../present/*.gfo" return () @@ -104,3 +108,9 @@ only ls es = filter (flip elem es . snd) ls 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] diff --git a/lib/resource-1.4/catalan/NumeralCat.gf b/lib/resource-1.4/catalan/NumeralCat.gf index 5cbc15c02..fe824165e 100644 --- a/lib/resource-1.4/catalan/NumeralCat.gf +++ b/lib/resource-1.4/catalan/NumeralCat.gf @@ -21,7 +21,8 @@ oper Pl => case co of { NCard Masc => "-cents" ; NCard Fem => "-centes" ; - _ => "-cents" ; ---- variants {} } ; ---- AR 23/6/2008 + _ => "-cents" ---- variants {} ---- AR 23/6/2008 + } ; Sg => "cent" } ; cardOrd1 : CardOrd -> (_,_,_:Str) -> Str = \co,dos,dues,segon -> case co of { diff --git a/lib/resource-1.4/demo/DemoRus.gf b/lib/resource-1.4/demo/DemoRus.gf index e6f6596a6..0caccbb7b 100644 --- a/lib/resource-1.4/demo/DemoRus.gf +++ b/lib/resource-1.4/demo/DemoRus.gf @@ -18,6 +18,6 @@ concrete DemoRus of Demo = LexiconRus ** { -flags startcat = Phr ; unlexer = text ; lexer = text ; +flags startcat = Phr ; unlexer = text ; lexer = text ; coding = utf8 ; } ; diff --git a/lib/resource-1.4/russian/LangRus.gf b/lib/resource-1.4/russian/LangRus.gf index 5beb1169a..c3126dcfe 100644 --- a/lib/resource-1.4/russian/LangRus.gf +++ b/lib/resource-1.4/russian/LangRus.gf @@ -5,6 +5,6 @@ concrete LangRus of Lang = LexiconRus ** { -flags startcat = Phr ; unlexer = text ; lexer = text ; +flags startcat = Phr ; unlexer = text ; lexer = text ; coding=utf8 ; } ; diff --git a/src-3.0/GF/Command/Commands.hs b/src-3.0/GF/Command/Commands.hs index 5514a0596..68e2c5526 100644 --- a/src-3.0/GF/Command/Commands.hs +++ b/src-3.0/GF/Command/Commands.hs @@ -497,7 +497,11 @@ allCommands pgf = Map.fromList [ (abstractName pgf ++ ": " ++ showTree t) : [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 @@ -570,3 +574,5 @@ morphologyQuiz pgf ig cat = do infinity :: Int infinity = 256 +lookFlag :: PGF -> String -> String -> Maybe String +lookFlag pgf lang flag = lookConcrFlag pgf (mkCId lang) (mkCId flag) diff --git a/src-3.0/GF/Grammar/AppPredefined.hs b/src-3.0/GF/Grammar/AppPredefined.hs index 452050ac8..cfb6baf1d 100644 --- a/src-3.0/GF/Grammar/AppPredefined.hs +++ b/src-3.0/GF/Grammar/AppPredefined.hs @@ -106,10 +106,17 @@ appPredefined t = case t of _ -> retb t ---- should really check the absence of arg variables where - retb t = return (t,True) -- no further computing needed - retf t = return (t,False) -- must be computed further + retb t = return (retc t,True) -- no further computing needed + 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 Empty -> K [] + C u v -> case (norm u,norm v) of + (K x,K y) -> K (x +++ y) + _ -> t _ -> t fi = fromInteger