summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF/API/IOGrammar.hs4
-rw-r--r--src/GF/Canon/CMacros.hs1
-rw-r--r--src/GF/Compile/Compile.hs30
-rw-r--r--src/GF/Compile/GetGrammar.hs6
-rw-r--r--src/GF/Infra/Option.hs6
-rw-r--r--src/GF/Shell.hs3
-rw-r--r--src/GF/Source/SourceToGrammar.hs12
-rw-r--r--src/GF/Text/Hebrew.hs19
-rw-r--r--src/GF/Text/Unicode.hs14
-rw-r--r--src/Today.hs2
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"
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 19:02:01 +0000