diff --git a/grammars/numerals/old/transNum.gfs b/grammars/numerals/old/transNum.gfs index b5ce6cc6b..177f8e130 100644 --- a/grammars/numerals/old/transNum.gfs +++ b/grammars/numerals/old/transNum.gfs @@ -1,56 +1,56 @@ -i -old -abs=Nums numerals.Dec.gf -i -old -abs=Nums amharic.gf -i -old -abs=Nums basque.gf -i -old -abs=Nums biblical_hebrew.gf -i -old -abs=Nums classical_arabic.gf -i -old -abs=Nums classical_greek.gf -i -old -abs=Nums croatian.gf -i -old -abs=Nums bulgarian.gf -i -old -abs=Nums catalan.gf -i -old -abs=Nums czech.gf -i -old -abs=Nums khmer.gf -i -old -abs=Nums kwami.gf -i -old -abs=Nums lamani.gf -i -old -abs=Nums latvian.gf -i -old -abs=Nums stieng.gf -i -old -abs=Nums swahili.gf -i -old -abs=Nums geez.gf -i -old -abs=Nums hindi.gf -i -old -abs=Nums hungarian.gf -i -old -abs=Nums icelandic.gf -i -old -abs=Nums irish.gf -i -old -abs=Nums italian.gf -i -old -abs=Nums japanese.gf -i -old -abs=Nums khowar.gf -i -old -abs=Nums korean.gf -i -old -abs=Nums kulung.gf -i -old -abs=Nums modern_greek.gf -i -old -abs=Nums mongolian.gf -i -old -abs=Nums numerals.ChiU.gf -i -old -abs=Nums numerals.Dan.gf -i -old -abs=Nums numerals.Deu.gf -i -old -abs=Nums numerals.Eng.gf -i -old -abs=Nums numerals.Fra.gf -i -old -abs=Nums numerals.Malay.gf -i -old -abs=Nums numerals.Ned.gf -i -old -abs=Nums numerals.NorB.gf -i -old -abs=Nums numerals.Rus.gf -i -old -abs=Nums numerals.Suo.gf -i -old -abs=Nums numerals.Swe.gf -i -old -abs=Nums numerals.Tam.gf -i -old -abs=Nums old_church_slavonic.gf -i -old -abs=Nums pashto.gf -i -old -abs=Nums polish.gf -i -old -abs=Nums portuguese.gf -i -old -abs=Nums quechua.gf -i -old -abs=Nums romanian.gf -i -old -abs=Nums sanskrit.gf -i -old -abs=Nums slovak.gf -i -old -abs=Nums sorani.gf -i -old -abs=Nums spanish.gf -i -old -abs=Nums swiss_french.gf -i -old -abs=Nums tamil.gf -i -old -abs=Nums tibetan.gf -i -old -abs=Nums totonac.gf -i -old -abs=Nums turkish.gf +i -old -abs=Nums -cnc=Decimal numerals.Dec.gf +i -old -abs=Nums -cnc=Amharic amharic.gf +i -old -abs=Nums -cnc=Basque basque.gf +i -old -abs=Nums -cnc=Hebrew biblical_hebrew.gf +i -old -abs=Nums -cnc=Arabic classical_arabic.gf +i -old -abs=Nums -cnc=GreekOld classical_greek.gf +i -old -abs=Nums -cnc=Croatian croatian.gf +i -old -abs=Nums -cnc=Bulgarian bulgarian.gf +i -old -abs=Nums -cnc=Catalan catalan.gf +i -old -abs=Nums -cnc=Czech czech.gf +i -old -abs=Nums -cnc=Khmer khmer.gf +i -old -abs=Nums -cnc=Kwami kwami.gf +i -old -abs=Nums -cnc=Lamani lamani.gf +i -old -abs=Nums -cnc=Latvian latvian.gf +i -old -abs=Nums -cnc=Stieng stieng.gf +i -old -abs=Nums -cnc=Swahili swahili.gf +i -old -abs=Nums -cnc=Geez geez.gf +i -old -abs=Nums -cnc=Hindi hindi.gf +i -old -abs=Nums -cnc=Hungarian hungarian.gf +i -old -abs=Nums -cnc=Icelandic icelandic.gf +i -old -abs=Nums -cnc=Irish irish.gf +i -old -abs=Nums -cnc=Italian italian.gf +i -old -abs=Nums -cnc=Japanese japanese.gf +i -old -abs=Nums -cnc=Khowar khowar.gf +i -old -abs=Nums -cnc=Korean korean.gf +i -old -abs=Nums -cnc=Kulung kulung.gf +i -old -abs=Nums -cnc=GreekNew modern_greek.gf +i -old -abs=Nums -cnc=Mongolian mongolian.gf +i -old -abs=Nums -cnc=Chinese numerals.ChiU.gf +i -old -abs=Nums -cnc=Danish numerals.Dan.gf +i -old -abs=Nums -cnc=German numerals.Deu.gf +i -old -abs=Nums -cnc=English numerals.Eng.gf +i -old -abs=Nums -cnc=French numerals.Fra.gf +i -old -abs=Nums -cnc=Malay numerals.Malay.gf +i -old -abs=Nums -cnc=Dutch numerals.Ned.gf +i -old -abs=Nums -cnc=Norwegian numerals.NorB.gf +i -old -abs=Nums -cnc=Russian numerals.Rus.gf +i -old -abs=Nums -cnc=Finnish numerals.Suo.gf +i -old -abs=Nums -cnc=Swedish numerals.Swe.gf +i -old -abs=Nums -cnc=Tampere numerals.Tam.gf +i -old -abs=Nums -cnc=ChurchSlavonic old_church_slavonic.gf +i -old -abs=Nums -cnc=Pashto pashto.gf +i -old -abs=Nums -cnc=Polish polish.gf +i -old -abs=Nums -cnc=Portuguese portuguese.gf +i -old -abs=Nums -cnc=Quechua quechua.gf +i -old -abs=Nums -cnc=Romanian romanian.gf +i -old -abs=Nums -cnc=Sanskrit sanskrit.gf +i -old -abs=Nums -cnc=Slovak slovak.gf +i -old -abs=Nums -cnc=Sorani sorani.gf +i -old -abs=Nums -cnc=Spanich spanish.gf +i -old -abs=Nums -cnc=SwissFrench swiss_french.gf +i -old -abs=Nums -cnc=Tamil tamil.gf +i -old -abs=Nums -cnc=Tibetan tibetan.gf +i -old -abs=Nums -cnc=Totonac totonac.gf +i -old -abs=Nums -cnc=Turkish turkish.gf ---ts -f diff --git a/src/GF/API.hs b/src/GF/API.hs index 29474585f..ab630d7a6 100644 --- a/src/GF/API.hs +++ b/src/GF/API.hs @@ -35,6 +35,7 @@ import qualified Compute as Co import qualified Ident as I import qualified GrammarToCanon as GC import qualified CanonToGrammar as CG +import qualified MkGFC as MC import Editing @@ -113,6 +114,9 @@ transformGrammarFile opts file = do return $ optPrintSyntax opts sy -} +prIdent :: Ident -> String +prIdent = prt + -- then stg for customizable and internal use {- ----- @@ -257,6 +261,9 @@ optPrintGrammar opts = customOrDefault opts grammarPrinter customGrammarPrinter optPrintSyntax :: Options -> GF.Grammar -> String optPrintSyntax opts = customOrDefault opts grammarPrinter customSyntaxPrinter +prCanonGrammar :: CanonGrammar -> String +prCanonGrammar = MC.prCanon + {- ---- optPrintTree :: Options -> GFGrammar -> Tree -> String optPrintTree opts = customOrDefault opts grammarPrinter customTermPrinter diff --git a/src/GF/API/IOGrammar.hs b/src/GF/API/IOGrammar.hs index 9732c6ea8..483afbd86 100644 --- a/src/GF/API/IOGrammar.hs +++ b/src/GF/API/IOGrammar.hs @@ -1,6 +1,5 @@ module IOGrammar where -import Option import Abstract import qualified GFC import PGrammar @@ -8,6 +7,8 @@ import TypeCheck import Compile import ShellState +import Modules +import Option import Operations import UseIO import Arch @@ -35,6 +36,9 @@ string2annotTree gr m = annotate gr . string2absTerm (prt m) ---- prt ---string2paramList st = map (renameTrm (lookupConcrete st) . patt2term) . pPattList shellStateFromFiles :: Options -> ShellState -> FilePath -> IOE ShellState +shellStateFromFiles opts st file | fileSuffix file == "gfcm" = do + (_,_,cgr) <- compileOne opts (compileEnvShSt st []) file + ioeErr $ updateShellState opts st (cgr,(emptyMGrammar,[])) shellStateFromFiles opts st file = do let osb = if oElem showOld opts then addOptions (options [beVerbose]) opts -- for old, no emit diff --git a/src/GF/Canon/GFC.cf b/src/GF/Canon/GFC.cf index 1816a77ad..4289b4c24 100644 --- a/src/GF/Canon/GFC.cf +++ b/src/GF/Canon/GFC.cf @@ -8,9 +8,9 @@ Gr. Canon ::= [Module] ; Mod. Module ::= ModType "=" Extend Open "{" [Flag] [Def] "}" ; -MTAbs. ModType ::= "abstract" Ident ; -MTCnc. ModType ::= "concrete" Ident "of" Ident ; -MTRes. ModType ::= "resource" Ident ; +MTAbs. ModType ::= "abstract" Ident ; +MTCnc. ModType ::= "concrete" Ident "of" Ident ; +MTRes. ModType ::= "resource" Ident ; MTTrans. ModType ::= "transfer" Ident ":" Ident "->" Ident ; separator Module "" ; @@ -18,8 +18,8 @@ separator Module "" ; Ext. Extend ::= Ident "**" ; NoExt. Extend ::= ; -NoOpens. Open ::= ; Opens. Open ::= "open" [Ident] "in" ; +NoOpens. Open ::= ; -- judgements @@ -30,15 +30,15 @@ AbsDCat. Def ::= "cat" Ident "[" [Decl] "]" "=" [CIdent] ; AbsDFun. Def ::= "fun" Ident ":" Exp "=" Exp ; AbsDTrans. Def ::= "transfer" Ident "=" Exp ; -ResDPar. Def ::= "param" Ident "=" [ParDef] ; -ResDOper. Def ::= "oper" Ident ":" CType "=" Term ; +ResDPar. Def ::= "param" Ident "=" [ParDef] ; +ResDOper. Def ::= "oper" Ident ":" CType "=" Term ; -CncDCat. Def ::= "lincat" Ident "=" CType "=" Term ";" Term ; -CncDFun. Def ::= "lin" Ident ":" CIdent "=" "\\" [ArgVar] "->" Term ";" Term ; +CncDCat. Def ::= "lincat" Ident "=" CType "=" Term ";" Term ; +CncDFun. Def ::= "lin" Ident ":" CIdent "=" "\\" [ArgVar] "->" Term ";" Term ; -AnyDInd. Def ::= Ident Status "in" Ident ; +AnyDInd. Def ::= Ident Status "in" Ident ; -ParD. ParDef ::= Ident [CType] ; +ParD. ParDef ::= Ident [CType] ; -- the canonicity of an indirected constant diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs index 9346fce00..c83d628c7 100644 --- a/src/GF/Compile/Compile.hs +++ b/src/GF/Compile/Compile.hs @@ -125,6 +125,9 @@ extendCompileEnvInt (_,MGrammar ss, MGrammar cs) (k,sm,cm) = extendCompileEnv (k,s,c) (sm,cm) = extendCompileEnvInt (k,s,c) (k,sm,cm) +extendCompileEnvCanon (k,s,c) cgr = + return (k,s, MGrammar (modules cgr ++ modules c)) + compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv compileOne opts env file = do @@ -134,7 +137,12 @@ compileOne opts env file = do let name = fileBody file case gf of - -- for canonical gf, just read the file and update environment + -- for multilingual canonical gf, just read the file and update environment + "gfcm" -> do + cgr <- putp ("+ reading" +++ file) $ getCanonGrammar file + extendCompileEnvCanon env cgr + + -- for canonical gf, read the file and update environment, also source env "gfc" -> do cm <- putp ("+ reading" +++ file) $ getCanonModule file sm <- ioeErr $ CG.canon2sourceModule cm @@ -180,6 +188,12 @@ compileSourceModule opts env@(k,gr,can) mo@(i,mi) = do let putp = putPointE opts mos = modules gr + if (oElem showOld opts && oElem emitCode opts) + then do + let (file,out) = (gfFile (prt i), prGrammar (MGrammar [mo])) + ioeIO $ writeFile file out >> putStr (" wrote file" +++ file) + else return () + mo1 <- ioeErr $ rebuildModule mos mo mo1b <- ioeErr $ extendModule mos mo1 diff --git a/src/GF/Compile/ModDeps.hs b/src/GF/Compile/ModDeps.hs index 2f5f916d6..c4784e243 100644 --- a/src/GF/Compile/ModDeps.hs +++ b/src/GF/Compile/ModDeps.hs @@ -11,6 +11,7 @@ import Modules import Operations import Monad +import List -- AR 13/5/2003 @@ -106,6 +107,17 @@ openInterfaces ds m = do let mods = iterFix (concatMap more) (more (m,undefined)) return $ [i | (i,MTInterface) <- mods] +-- this function finds out what modules are really needed in the canoncal gr. +-- its argument is typically a concrete module name + +requiredCanModules :: (Eq i, Show i) => MGrammar i f a -> i -> [i] +requiredCanModules gr = nub . iterFix (concatMap more) . singleton where + more i = errVal [] $ do + m <- lookupModMod gr i + return $ maybe [] return (extends m) ++ map openedModule (opens m) + + + {- -- to test exampleDeps = [ @@ -117,3 +129,4 @@ exampleDeps = [ ii s = IdentM (IC s) MTInterface ir s = IdentM (IC s) MTResource -} + diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index 27d88f6fb..d0232b97e 100644 --- a/src/GF/Compile/ShellState.hs +++ b/src/GF/Compile/ShellState.hs @@ -8,6 +8,7 @@ import MMacros import Look import LookAbs +import ModDeps import qualified Modules as M import qualified Grammar as G import qualified PrGrammar as P @@ -19,6 +20,8 @@ import Option import Ident import Arch (ModTime) +import List (nub,nubBy) + -- AR 11/11/2001 -- 17/6/2003 (for modules) ---- unfinished -- multilingual state with grammars and options @@ -169,6 +172,26 @@ filterAbstracts abstr cgr = M.MGrammar [m | m <- ms, needed m] where Just _ -> a : [] _ -> [] + +purgeShellState :: ShellState -> ShellState +purgeShellState sh = ShSt { + abstract = abstract sh, + concrete = concrete sh, + concretes = [(a,i) | (a,i) <- concretes sh, elem i needed], + canModules = M.MGrammar $ purge $ M.modules $ canModules sh, + srcModules = M.emptyMGrammar, + cfs = cfs sh, + morphos = morphos sh, + gloptions = gloptions sh, + readFiles = [], + absCats = absCats sh, + statistics = statistics sh + } + where + needed = nub $ concatMap (requiredCanModules (canModules sh)) acncs + purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst) + acncs = maybe [] singleton (abstract sh) ++ map snd (concretes sh) + -- form just one state grammar, if unique, from a canonical grammar grammar2stateGrammar :: Options -> CanonGrammar -> Err StateGrammar diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs index e400bce4e..6c557b479 100644 --- a/src/GF/Grammar/Compute.hs +++ b/src/GF/Grammar/Compute.hs @@ -25,7 +25,7 @@ computeConcrete g t = {- refreshTerm t >>= -} computeTerm g [] t computeTerm :: SourceGrammar -> Substitution -> Term -> Err Term computeTerm gr = comp where - comp g t = --- errIn ("subterm" +++ prt t) $ --- for debugging + comp g t = ---- errIn ("subterm" +++ prt t) $ --- for debugging case t of Q (IC "Predef") _ -> return t @@ -59,6 +59,7 @@ computeTerm gr = comp where a' <- comp g a case (f',a') of (Abs x b,_) -> comp (ext x a' g) b + (QC _ _,_) -> returnC $ App f' a' (FV fs, _) -> mapM (\c -> comp g (App c a')) fs >>= return . FV (_, FV as) -> mapM (\c -> comp g (App f' c)) as >>= return . FV @@ -172,8 +173,10 @@ computeTerm gr = comp where _ -> return $ ExtR r' s' -- case-expand tables + -- if already expanded, don't expand again T i@(TComp _) cs -> do - cs' <- mapPairsM (comp g) cs + -- if there are no variables, don't even go inside + cs' <- if (null g) then return cs else mapPairsM (comp g) cs return $ T i cs' T i cs -> do diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs index 2edb183a1..291ea7521 100644 --- a/src/GF/Grammar/Macros.hs +++ b/src/GF/Grammar/Macros.hs @@ -175,6 +175,9 @@ appc = appCons . zIdent mkLet :: [LocalDef] -> Term -> Term mkLet defs t = foldr Let t defs +mkLetUntyped :: Context -> Term -> Term +mkLetUntyped defs = mkLet [(x,(Nothing,t)) | (x,t) <- defs] + isVariable (Vr _ ) = True isVariable _ = False diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index ac2f46b7e..a46127f16 100644 --- a/src/GF/Infra/Option.hs +++ b/src/GF/Infra/Option.hs @@ -139,6 +139,7 @@ latexLin = showLatex tableLin = iOpt "table" defaultLinOpts = [firstLin] useUTF8 = iOpt "utf8" +showLang = iOpt "lang" -- other beVerbose = iOpt "v" diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index 2fd686601..b0647b954 100644 --- a/src/GF/Shell.hs +++ b/src/GF/Shell.hs @@ -41,6 +41,7 @@ data Command = CImport FilePath | CRemoveLanguage Language | CEmptyState + | CStripState | CTransformGrammar FilePath | CConvertLatex FilePath @@ -143,6 +144,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of st1 <- shellStateFromFiles opts st file ioeIO $ changeState (const st1) sa --- \ ((_,h),a) -> ((st,h), a)) CEmptyState -> changeState reinitShellState sa + CStripState -> changeState purgeShellState sa {- CRemoveLanguage lan -> changeState (removeLanguage lan) sa @@ -209,7 +211,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of CPrintInformation c -> justOutput (useIOE () $ showInformation opts st c) sa CPrintLanguages -> justOutput (putStrLn $ unwords $ map prLanguage $ allLanguages st) sa ----- CPrintMultiGrammar -> returnArg (AString (prMultiGrammar opts st)) sa + CPrintMultiGrammar -> returnArg (AString (prCanonGrammar (canModules st))) sa ---- CPrintGramlet -> returnArg (AString (Gr.prGramlet st)) sa ---- CPrintCanonXML -> returnArg (AString (Canon.prCanonXML st False)) sa ---- CPrintCanonXMLStruct -> returnArg (AString (Canon.prCanonXML st True)) sa diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs index f28218f27..666b5b681 100644 --- a/src/GF/Shell/PShell.hs +++ b/src/GF/Shell/PShell.hs @@ -51,6 +51,7 @@ pCommand ws = case ws of "i" : f : [] -> aUnit (CImport f) "rl" : l : [] -> aUnit (CRemoveLanguage (language l)) "e" : [] -> aUnit CEmptyState + "s" : [] -> aUnit CStripState "tg" : f : [] -> aUnit (CTransformGrammar f) "cl" : f : [] -> aUnit (CConvertLatex f) diff --git a/src/GF/Shell/SubShell.hs b/src/GF/Shell/SubShell.hs index 1b8a647df..0134b3530 100644 --- a/src/GF/Shell/SubShell.hs +++ b/src/GF/Shell/SubShell.hs @@ -26,7 +26,11 @@ translateSession :: Options -> ShellState -> IO () translateSession opts st = do let grs = allStateGrammars st cat = firstCatOpts opts (firstStateGrammar st) - trans = unlines . translateBetweenAll grs cat + trans s = unlines $ + if oElem showLang opts then + [l +++ ":" +++ s | (l,s) <- zip (map (prIdent . cncId) grs) + (translateBetweenAll grs cat s)] + else translateBetweenAll grs cat s translateLoop opts trans translateLoop opts trans = do diff --git a/src/Today.hs b/src/Today.hs index 3647e0a63..1490e4866 100644 --- a/src/Today.hs +++ b/src/Today.hs @@ -1 +1 @@ -module Today where today = "Thu Dec 4 13:52:32 CET 2003" +module Today where today = "Tue Dec 9 18:22:33 CET 2003"