2beta2

src/GF.hs

@@ -69,7 +69,7 @@ welcomeMsg =
 
 authorMsg = unlines [
  "Grammatical Framework, Version 2-beta (incomplete functionality)",
- "November 25, 2003", 
+ "April 1, 2004", 
 --- "Compiled March 26, 2003",
  "Compiled " ++ today,
  "Copyright (c) Markus Forsberg, Thomas Hallgren, Harald Hammarström,",

src/GF/API/IOGrammar.hs

@@ -8,6 +8,7 @@ import Compile
 import ShellState
 
 import Modules
+import ReadFiles (isOldFile)
 import Option
 import Operations
 import UseIO
@@ -45,9 +46,12 @@ shellStateFromFiles opts st file = case fileSuffix file of
      grts <- compileModule osb st file
      ioeErr $ updateShellState opts st grts
   _ -> do
-     let osb = if oElem showOld opts 
+     b <- ioeIO $ isOldFile file
-                 then addOptions (options [beVerbose]) opts -- for old, no emit
+     let opts' = if b then (addOption showOld opts) else opts
-                 else addOptions (options [beVerbose, emitCode]) opts -- for new,do
+
+     let osb = if oElem showOld opts' 
+                 then addOptions (options [beVerbose]) opts' -- for old no emit
+                 else addOptions (options [beVerbose, emitCode]) opts'
      grts <- compileModule osb st file
-     ioeErr $ updateShellState opts st grts
+     ioeErr $ updateShellState opts' st grts
      --- liftM (changeModTimes rts) $ grammar2shellState opts gr

src/GF/Compile/Compile.hs

@@ -56,7 +56,8 @@ batchCompileOld f = compileOld defOpts f
 compileModule :: Options -> ShellState -> FilePath -> 
                  IOE (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)]))
 
-compileModule opts st0 file | oElem showOld opts || 
+compileModule opts st0 file | 
+     oElem showOld opts || 
      elem suff ["cf","ebnf"] = do
   let putp = putPointE opts
   let path = [] ----

src/GF/Compile/ShellState.hs

@@ -210,6 +210,20 @@ greatestAbstract gr = case allAbstracts gr of
   [] -> Nothing
   a -> return $ last a
 
+-- all resource modules
+allResources :: G.SourceGrammar -> [Ident]
+allResources gr = [i | (i,M.ModMod m) <- M.modules gr, M.mtype m == M.MTResource]
+
+
+-- the last resource in dependency order
+greatestResource :: G.SourceGrammar -> Maybe Ident
+greatestResource gr = case allResources gr of
+  [] -> Nothing
+  a -> return $ last a
+
+resourceOfShellState :: ShellState -> Maybe Ident
+resourceOfShellState = greatestResource . srcModules
+
 qualifTop :: StateGrammar -> G.QIdent -> G.QIdent
 qualifTop gr (_,c) = (absId gr,c)
 

src/GF/Infra/Option.hs

@@ -182,6 +182,7 @@ withFun        = aOpt "fun"
 firstCat       = aOpt "cat"      -- used on command line
 gStartCat      = aOpt "startcat" -- used in grammar, to avoid clash w res word
 useLanguage    = aOpt "lang"
+useResource    = aOpt "res"
 speechLanguage = aOpt "language"
 useFont        = aOpt "font"
 grammarFormat  = aOpt "format"

src/GF/Infra/ReadFiles.hs

@@ -6,7 +6,7 @@ module ReadFiles
 --  
 getAllFiles,fixNewlines,ModName,getOptionsFromFile,
 --  
-gfcFile,gfFile,gfrFile,isGFC,resModName) where
+gfcFile,gfFile,gfrFile,isGFC,resModName,isOldFile) where
 
 import Arch (selectLater, modifiedFiles, ModTime, getModTime,laterModTime)
 
@@ -251,6 +251,18 @@ getOptionsFromFile file = do
   let ls = filter (isPrefixOf "--#") $ lines s
   return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
 
+-- check if old GF file
+isOldFile :: FilePath -> IO Bool
+isOldFile f = do
+  s <- readFileIf f
+  let s' = unComm s
+  return $ not (null s') && old (head (words s'))
+ where
+   old = flip elem $ words 
+     "cat category data def flags fun include lin lincat lindef lintype oper param pattern printname rule"
+
+
+
 -- old GF tolerated newlines in quotes. No more supported!
 fixNewlines s = case s of
      '"':cs -> '"':mk cs

src/GF/Shell.hs

@@ -53,7 +53,7 @@ data Command =
  | CWrapTerm Ident
  | CMorphoAnalyse
  | CTestTokenizer
- | CComputeConcrete I.Ident String
+ | CComputeConcrete String
 
  | CTranslationQuiz Language Language
  | CTranslationList Language Language Int
@@ -176,7 +176,11 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
   CMorphoAnalyse -> changeArg (AString . morphoAnalyse opts gro . prCommandArg) sa
   CTestTokenizer -> changeArg (AString . optTokenizer opts gro . prCommandArg) sa
 
-  CComputeConcrete m t -> 
+  CComputeConcrete t -> do
+    m <- return $
+         maybe (I.identC "?") id $  -- meaningful if no opers in t 
+           maybe (resourceOfShellState st) (return . I.identC) $ -- topmost res
+             getOptVal opts useResource             -- flag -res=m
     justOutput (putStrLn (err id (prt . stripTerm) (
                 string2srcTerm src m t >>= Co.computeConcrete src))) sa
 

src/GF/Shell/PShell.hs

@@ -76,7 +76,7 @@ pCommand ws = case ws of
 -----  "wt" : f : s  -> aTerm   (CWrapTerm (string2id f)) s
   "ma" : s      -> aString CMorphoAnalyse s
   "tt" : s      -> aString CTestTokenizer s
-  "cc" : m : s  -> aUnit   $ CComputeConcrete (pzIdent m) $ unwords s
+  "cc" : s      -> aUnit   $ CComputeConcrete $ unwords s
 
   "tq" : i:o:[] -> aUnit   (CTranslationQuiz (language i) (language o))
   "tl":i:o:n:[] -> aUnit   (CTranslationList (language i) (language o) (readIntArg n))

src/HelpFile

@@ -22,7 +22,7 @@ i,  import: i File
         .ebnf  Extended BNF format
         .cf    Context-free (BNF) format
   options:
-      -old          old: parse in GF<2.0 format
+      -old          old: parse in GF<2.0 format (not necessary)
       -v            verbose: give lots of messages 
       -s            silent: don't give error messages
       -opt          perform branch-sharing optimization
@@ -133,15 +133,17 @@ tt, test_tokenizer: tt String
   flags: 
      -lexer    use this lexer
 
-cc, compute_concrete: cc Ident Term
+cc, compute_concrete: cc Term
-      Compute a term by concrete syntax definitions.
+      Compute a term by concrete syntax definitions. Uses the topmost
-      The identifier Ident is a resource module name 
+      resource module (the last in listing by command po) to resolve 
-      needed to resolve constant. 
+      constant names. 
       N.B. You need the flag -retain when importing the grammar, if you want 
       the oper definitions to be retained after compilation; otherwise this
       command does not expand oper constants.
       N.B.' The resulting Term is not a term in the sense of abstract syntax,
       and hence not a valid input to a Tree-demanding command.
+  flags:
+     -res      use another module than the topmost one
 
 t,  translate: t Lang Lang String
       Parses String in Lang1 and linearizes the resulting Trees in Lang2.

src/HelpFile.hs

@@ -35,7 +35,7 @@ txtHelpFile =
   "\n        .ebnf  Extended BNF format" ++
   "\n        .cf    Context-free (BNF) format" ++
   "\n  options:" ++
-  "\n      -old          old: parse in GF<2.0 format" ++
+  "\n      -old          old: parse in GF<2.0 format (not necessary)" ++
   "\n      -v            verbose: give lots of messages " ++
   "\n      -s            silent: don't give error messages" ++
   "\n      -opt          perform branch-sharing optimization" ++
@@ -146,15 +146,17 @@ txtHelpFile =
   "\n  flags: " ++
   "\n     -lexer    use this lexer" ++
   "\n" ++
-  "\ncc, compute_concrete: cc Ident Term" ++
+  "\ncc, compute_concrete: cc Term" ++
-  "\n      Compute a term by concrete syntax definitions." ++
+  "\n      Compute a term by concrete syntax definitions. Uses the topmost" ++
-  "\n      The identifier Ident is a resource module name " ++
+  "\n      resource module (the last in listing by command po) to resolve " ++
-  "\n      needed to resolve constant. " ++
+  "\n      constant names. " ++
   "\n      N.B. You need the flag -retain when importing the grammar, if you want " ++
   "\n      the oper definitions to be retained after compilation; otherwise this" ++
   "\n      command does not expand oper constants." ++
   "\n      N.B.' The resulting Term is not a term in the sense of abstract syntax," ++
   "\n      and hence not a valid input to a Tree-demanding command." ++
+  "\n  flags:" ++
+  "\n     -res      use another module than the topmost one" ++
   "\n" ++
   "\nt,  translate: t Lang Lang String" ++
   "\n      Parses String in Lang1 and linearizes the resulting Trees in Lang2." ++

src/Today.hs

@@ -1 +1 @@
-module Today where today = "Wed Mar 31 15:13:46 CEST 2004"
+module Today where today = "Thu Apr  1 11:42:56 CEST 2004"