Introduced output of stripped format gfcm.

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

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

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

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
 

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

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
 -}
+

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 

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

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
 

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"

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

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)
 

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

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"