New unicodings.

New unicodings.
Module with works.

Better compilation of old GF.

10 files changed, 75 insertions, 22 deletions

diff --git a/src/GF/API/IOGrammar.hs b/src/GF/API/IOGrammar.hs
index a00ef18a6..9732c6ea8 100644
--- a/src/GF/API/IOGrammar.hs
+++ b/src/GF/API/IOGrammar.hs
@@ -36,7 +36,9 @@ string2annotTree gr m = annotate gr . string2absTerm (prt m) ---- prt
 
 shellStateFromFiles :: Options -> ShellState -> FilePath -> IOE ShellState
 shellStateFromFiles opts st file = do
-  let osb = addOptions (options [beVerbose, emitCode]) opts ---
+  let osb = if oElem showOld opts 
+               then addOptions (options [beVerbose]) opts -- for old, no emit
+               else addOptions (options [beVerbose, emitCode]) opts -- for new, do
   grts <- compileModule osb st file
   ioeErr $ updateShellState opts st grts
   --- liftM (changeModTimes rts) $ grammar2shellState opts gr
diff --git a/src/GF/Canon/CMacros.hs b/src/GF/Canon/CMacros.hs
index a5a079b4e..647cf9600 100644
--- a/src/GF/Canon/CMacros.hs
+++ b/src/GF/Canon/CMacros.hs
@@ -88,6 +88,7 @@ patt2term p = case p of
 anyTerm :: Term
 anyTerm  = LI (A.identC "_") --- should not happen
 
+matchPatt cs0 (FV ts) = liftM FV $ mapM (matchPatt cs0) ts
 matchPatt cs0 trm = term2patt trm >>= match cs0 where
   match cs t = 
     case cs of
diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index 4364b7b2c..404620a28 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -54,6 +54,21 @@ batchCompileOld f = compileOld defOpts f
 
 compileModule :: Options -> ShellState -> FilePath -> 
                  IOE (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)]))
+compileModule opts st0 file | oElem showOld opts = do
+  let putp = putPointE opts
+  let path = [] ----
+  grammar1 <- putp ("- parsing old gf" +++ file) $ getOldGrammar opts file
+  let mods = modules grammar1
+  let env = compileEnvShSt st0 []
+  (_,sgr,cgr) <- foldM (comp putp path) env mods
+  return $ (reverseModules cgr,       -- to preserve dependency order
+            (reverseModules sgr,[]))  
+ where
+   comp putp path env sm0 = do
+     (k',sm)  <- makeSourceModule opts env sm0
+     cm  <- putp "  generating code... " $ generateModuleCode opts path sm
+     extendCompileEnvInt env (k',sm,cm)
+
 compileModule opts1 st0 file = do
   opts0 <- ioeIO $ getOptionsFromFile file
   let useFileOpt = maybe False (const True) $ getOptVal opts0 pathList
@@ -168,7 +183,6 @@ compileSourceModule opts env@(k,gr,can) mo@(i,mi) = do
   mo1   <- ioeErr $ rebuildModule mos mo
 
   mo1b  <- ioeErr $ extendModule mos mo1
-  ----  prDebug mo1b
 
   case mo1b of
     (_,ModMod n) | not (isCompleteModule n) -> do
@@ -185,8 +199,8 @@ compileSourceModule opts env@(k,gr,can) mo@(i,mi) = do
 
       return (k',mo4)
  where
-   prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug
-
+   ----   prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug
+   prDebug mo = ioeIO $ print $ length $ lines $ prGrammar $ MGrammar [mo]
 
 generateModuleCode :: Options -> InitPath -> SourceModule -> IOE GFC.CanonModule
 generateModuleCode opts path minfo@(name,info) = do
@@ -207,12 +221,14 @@ generateModuleCode opts path minfo@(name,info) = do
       return (gfcFile pname, code)
   if isCompilable info && emit && nomulti 
      then ioeIO $ writeFile file out >> putStr ("  wrote file" +++ file)
-     else ioeIO $ putStrFlush "no need to save for this module "
+     else ioeIO $ putStrFlush $ "no need to save module" +++ prt name
   return minfo'
  where 
-   isCompilable _ = True ---- isCompilableModule ---- emit code for interfaces
+   isCompilable mi = case mi of
+     ModMod m -> not $ isModCnc m && mstatus m == MSIncomplete 
+     _ -> True
    nomulti = not $ oElem makeMulti opts
-   emit  = oElem emitCode opts
+   emit  = oElem emitCode opts && not (oElem notEmitCode opts)
    optim = oElem optimizeCanon opts
 
 -- for old GF: sort into modules, write files, compile as usual
@@ -220,7 +236,7 @@ generateModuleCode opts path minfo@(name,info) = do
 compileOld :: Options -> FilePath -> IOE GFC.CanonGrammar
 compileOld opts file = do
   let putp = putPointE opts
-  grammar1 <- putp ("- parsing old gf" +++ file) $ getOldGrammar file
+  grammar1 <- putp ("- parsing old gf" +++ file) $ getOldGrammar opts file
   files <- mapM writeNewGF $ modules grammar1
   (_,_,grammar) <- foldM (compileOne opts) emptyCompileEnv files
   return grammar
diff --git a/src/GF/Compile/GetGrammar.hs b/src/GF/Compile/GetGrammar.hs
index 32efb960b..ef9e0944f 100644
--- a/src/GF/Compile/GetGrammar.hs
+++ b/src/GF/Compile/GetGrammar.hs
@@ -33,11 +33,11 @@ getSourceModule file = do
 
 -- for old GF format with includes
 
-getOldGrammar :: FilePath -> IOE SourceGrammar
-getOldGrammar file = do
+getOldGrammar :: Options -> FilePath -> IOE SourceGrammar
+getOldGrammar opts file = do
   defs <- parseOldGrammarFiles file
   let g = A.OldGr A.NoIncl defs
-  ioeErr $ transOldGrammar g file
+  ioeErr $ transOldGrammar opts file g
 
 parseOldGrammarFiles :: FilePath -> IOE [A.TopDef]
 parseOldGrammarFiles file = do
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index e28d18fcd..3bdf4dc0f 100644
--- a/src/GF/Infra/Option.hs
+++ b/src/GF/Infra/Option.hs
@@ -144,6 +144,7 @@ beVerbose    = iOpt "v"
 showInfo     = iOpt "i"
 beSilent     = iOpt "s"
 emitCode     = iOpt "o"
+notEmitCode  = iOpt "noemit"
 makeMulti    = iOpt "multi"
 beShort      = iOpt "short"
 wholeGrammar = iOpt "w"
@@ -193,6 +194,11 @@ extractGr      = aOpt "extract"
 pathList       = aOpt "path"
 uniCoding      = aOpt "coding"
 
+useName        = aOpt "name"
+useAbsName     = aOpt "abs"
+useCncName     = aOpt "cnc"
+useResName     = aOpt "res"
+
 markLin        = aOpt "mark"
 markOptXML     = oArg "xml"
 markOptJava    = oArg "java"
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index 0444a0a33..2fd686601 100644
--- a/src/GF/Shell.hs
+++ b/src/GF/Shell.hs
@@ -139,9 +139,6 @@ execLine put (c@(co, os), arg, cs) (outps,st) = do
 execC :: CommandOpt -> ShellIO
 execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
 
-  --- read old GF and write into files; no update of st yet
-  CImport file | oElem showOld opts -> useIOE sa $ batchCompileOld file >> return sa
-
   CImport file -> useIOE sa $ do
     st1 <- shellStateFromFiles opts st file
     ioeIO $ changeState (const st1) sa --- \ ((_,h),a) -> ((st,h), a))
diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs
index 53681104c..17e1819ca 100644
--- a/src/GF/Source/SourceToGrammar.hs
+++ b/src/GF/Source/SourceToGrammar.hs
@@ -12,6 +12,7 @@ import AbsGF
 import PrintGF
 import RemoveLiT --- for bw compat
 import Operations
+import Option
 
 import Monad
 import Char
@@ -482,8 +483,8 @@ transDDecl x = case x of
 -- to deal with the old format, sort judgements in three modules, forming
 -- their names from a given string, e.g. file name or overriding user-given string
 
-transOldGrammar :: OldGrammar -> String -> Err G.SourceGrammar
-transOldGrammar x name = case x of
+transOldGrammar :: Options -> FilePath -> OldGrammar -> Err G.SourceGrammar
+transOldGrammar opts name0 x = case x of
   OldGr includes topdefs  -> do --- includes must be collected separately
     let moddefs = sortTopDefs topdefs
     g1 <- transGrammar $ Gr moddefs
@@ -515,9 +516,10 @@ transOldGrammar x name = case x of
    ne = NoExt
    q = CMCompl
 
-   absName = identC topic
-   resName = identC ("Res" ++ lang)
-   cncName = identC lang
+   name = maybe name0 (++ ".gf") $ getOptVal opts useName
+   absName = identC $ maybe topic id $ getOptVal opts useAbsName
+   resName = identC $ maybe ("Res" ++ lang) id $ getOptVal opts useResName
+   cncName = identC $ maybe lang id $ getOptVal opts useCncName
 
    (beg,rest) = span (/='.') name
    (topic,lang) = case rest of -- to avoid overwriting old files
diff --git a/src/GF/Text/Hebrew.hs b/src/GF/Text/Hebrew.hs
index ebcc078e3..abd2855b8 100644
--- a/src/GF/Text/Hebrew.hs
+++ b/src/GF/Text/Hebrew.hs
@@ -1,13 +1,28 @@
 module Hebrew where
 
 mkHebrew :: String -> String
-mkHebrew = reverse . unwords . (map mkHebrewWord) . words
+mkHebrew = mkHebrewWord
 --- reverse : assumes everything's on same line
 
 type HebrewChar = Char
 
+-- HH 031103 added code for spooling the markup
+-- removed reverse, words, unwords (seemed obsolete and come out wrong on the screen)
+
 mkHebrewWord :: String -> [HebrewChar]
-mkHebrewWord = map mkHebrewChar
+-- mkHebrewWord = map mkHebrewChar
+
+mkHebrewWord s = case s of 
+  [] -> [] 
+  '<' : cs -> '<' : spoolMarkup cs
+  ' ' : cs -> ' ' : mkHebrewWord cs
+  c1 : cs -> mkHebrewChar c1 : mkHebrewWord cs
+
+spoolMarkup :: String -> String
+spoolMarkup s = case s of
+  [] -> [] -- Shouldn't happen
+  '>' : cs -> '>' : mkHebrewWord cs  
+  c1 : cs -> c1 : spoolMarkup cs
 
 mkHebrewChar c = case lookup c cc of Just c' -> c' ; _ -> c 
  where 
diff --git a/src/GF/Text/Unicode.hs b/src/GF/Text/Unicode.hs
index 78aba0461..734879e70 100644
--- a/src/GF/Text/Unicode.hs
+++ b/src/GF/Text/Unicode.hs
@@ -4,6 +4,13 @@ import Greek (mkGreek)
 import Arabic (mkArabic)
 import Hebrew (mkHebrew)
 import Russian (mkRussian, mkRusKOI8)
+import Ethiopic (mkEthiopic)
+import Tamil (mkTamil)
+import OCSCyrillic (mkOCSCyrillic)
+import LatinASupplement (mkLatinASupplement)
+import Devanagari (mkDevanagari)
+import Hiragana (mkJapanese)
+import ExtendedArabic (mkExtendedArabic)
 
 -- ad hoc Unicode conversions from different alphabets
 
@@ -15,6 +22,13 @@ mkUnicode s = case s of
  '/':'-':cs -> mkArabic  (remClosing cs)
  '/':'_':cs -> mkRussian (remClosing cs)
  '/':'*':cs -> mkRusKOI8 (remClosing cs)
+ '/':'E':cs -> mkEthiopic (remClosing cs)
+ '/':'T':cs -> mkTamil (remClosing cs)
+ '/':'C':cs -> mkOCSCyrillic (remClosing cs)
+ '/':'&':cs -> mkDevanagari (remClosing cs)
+ '/':'L':cs -> mkLatinASupplement (remClosing cs)
+ '/':'J':cs -> mkJapanese (remClosing cs)
+ '/':'A':cs -> mkExtendedArabic (remClosing cs)
  _      -> s
 
 remClosing cs 
diff --git a/src/Today.hs b/src/Today.hs
index fbe3b0cd1..d403f7c4d 100644
--- a/src/Today.hs
+++ b/src/Today.hs
@@ -1 +1 @@
-module Today where today = "Thu Nov 13 17:50:30 CET 2003"
+module Today where today = "Fri Nov 14 14:23:19 CET 2003"