summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF/API/IOGrammar.hs6
-rw-r--r--src/GF/CF/CFtoGrammar.hs4
-rw-r--r--src/GF/CF/EBNF.hs177
-rw-r--r--src/GF/CF/PPrCF.hs2
-rw-r--r--src/GF/Compile/CheckGrammar.hs6
-rw-r--r--src/GF/Compile/Compile.hs14
-rw-r--r--src/GF/Compile/GetGrammar.hs17
-rw-r--r--src/GF/Compile/Rename.hs1
-rw-r--r--src/GF/Grammar/AppPredefined.hs4
-rw-r--r--src/GF/Grammar/Macros.hs2
-rw-r--r--src/GF/Grammar/PrGrammar.hs9
-rw-r--r--src/GF/Infra/Comments.hs29
-rw-r--r--src/GF/Infra/ReadFiles.hs22
-rw-r--r--src/GF/Source/SourceToGrammar.hs2
-rw-r--r--src/HelpFile7
-rw-r--r--src/HelpFile.hs7
-rw-r--r--src/Today.hs2
17 files changed, 280 insertions, 31 deletions
diff --git a/src/GF/API/IOGrammar.hs b/src/GF/API/IOGrammar.hs
index 9b6fe0c5a..b535c9be0 100644
--- a/src/GF/API/IOGrammar.hs
+++ b/src/GF/API/IOGrammar.hs
@@ -39,7 +39,11 @@ shellStateFromFiles :: Options -> ShellState -> FilePath -> IOE ShellState
shellStateFromFiles opts st file = case fileSuffix file of
"gfcm" -> do
(_,_,cgr) <- compileOne opts (compileEnvShSt st []) file
- ioeErr $ updateShellState opts st (cgr,(emptyMGrammar,[]))
+ ioeErr $ updateShellState opts st (cgr,(emptyMGrammar,[]))
+ s | elem s ["cf","ebnf"] -> do
+ let osb = addOptions (options [beVerbose]) opts
+ grts <- compileModule osb st file
+ ioeErr $ updateShellState opts st grts
_ -> do
let osb = if oElem showOld opts
then addOptions (options [beVerbose]) opts -- for old, no emit
diff --git a/src/GF/CF/CFtoGrammar.hs b/src/GF/CF/CFtoGrammar.hs
index 440c4f7c3..b052ee88e 100644
--- a/src/GF/CF/CFtoGrammar.hs
+++ b/src/GF/CF/CFtoGrammar.hs
@@ -40,9 +40,9 @@ cf2rule (fun, (cat, items)) = (def,ldef) where
ldef = (f, CncFun
Nothing
(yes (mkAbs (map fst args)
- (mkRecord linLabel [foldconcat (map mkIt args0)])))
+ (mkRecord (const theLinLabel) [foldconcat (map mkIt args0)])))
nope)
- mkIt (v, CFNonterm _) = P (Vr v) (linLabel 0)
+ mkIt (v, CFNonterm _) = P (Vr v) theLinLabel
mkIt (_, CFTerm (RegAlts [a])) = K a
mkIt _ = K "" --- regexp not recognized in input CF ; use EBNF for this
foldconcat [] = K ""
diff --git a/src/GF/CF/EBNF.hs b/src/GF/CF/EBNF.hs
new file mode 100644
index 000000000..10b73c174
--- /dev/null
+++ b/src/GF/CF/EBNF.hs
@@ -0,0 +1,177 @@
+module EBNF where
+
+import Operations
+import Parsers
+import Comments
+import CF
+import CFIdent
+import Grammar
+import PrGrammar
+import CFtoGrammar
+import qualified AbsGF as A
+
+import List (nub, partition)
+
+-- AR 18/4/2000 - 31/3/2004
+
+-- Extended BNF grammar with token type a
+-- put a = String for simple applications
+
+type EBNF = [ERule]
+type ERule = (ECat, ERHS)
+type ECat = (String,[Int])
+type ETok = String
+
+ebnfID = "EBNF" ---- make this parametric!
+
+data ERHS =
+ ETerm ETok
+ | ENonTerm ECat
+ | ESeq ERHS ERHS
+ | EAlt ERHS ERHS
+ | EStar ERHS
+ | EPlus ERHS
+ | EOpt ERHS
+ | EEmpty
+
+type CFRHS = [CFItem]
+type CFJustRule = (CFCat, CFRHS)
+
+ebnf2gf :: EBNF -> [A.TopDef]
+ebnf2gf = cf2grammar . rules2CF . ebnf2cf
+
+ebnf2cf :: EBNF -> [CFRule]
+ebnf2cf ebnf = [(mkCFF i rule,rule) | (i,rule) <- zip [0..] (normEBNF ebnf)] where
+ mkCFF i (CFCat (_,c), _) = string2CFFun ebnfID ("Mk" ++ prt c ++ "_" ++ show i)
+
+normEBNF :: EBNF -> [CFJustRule]
+normEBNF erules = let
+ erules1 = [normERule ([i],r) | (i,r) <- zip [0..] erules]
+ erules2 = erules1 ---refreshECats erules1 --- this seems to be just bad !
+ erules3 = concat (map pickERules erules2)
+ erules4 = nubERules erules3
+ in [(mkCFCatE cat, map eitem2cfitem its) | (cat,itss) <- erules3, its <- itss]
+
+refreshECats :: [NormERule] -> [NormERule]
+refreshECats rules = [recas [i] rule | (i,rule) <- zip [0..] rules] where
+ recas ii (cat,its) = (updECat ii cat, [recss ii 0 s | s <- its])
+ recss ii n [] = []
+ recss ii n (s:ss) = recit (ii ++ [n]) s : recss ii (n+1) ss
+ recit ii it = case it of
+ EINonTerm cat -> EINonTerm (updECat ii cat)
+ EIStar (cat,t) -> EIStar (updECat ii cat, [recss ii 0 s | s <- t])
+ EIPlus (cat,t) -> EIPlus (updECat ii cat, [recss ii 0 s | s <- t])
+ EIOpt (cat,t) -> EIOpt (updECat ii cat, [recss ii 0 s | s <- t])
+ _ -> it
+
+pickERules :: NormERule -> [NormERule]
+pickERules rule@(cat,alts) = rule : concat (map pics (concat alts)) where
+ pics it = case it of
+ EIStar ru@(cat,t) -> mkEStarRules cat ++ pickERules ru
+ EIPlus ru@(cat,t) -> mkEPlusRules cat ++ pickERules ru
+ EIOpt ru@(cat,t) -> mkEOptRules cat ++ pickERules ru
+ _ -> []
+ mkEStarRules cat = [(cat', [[],[EINonTerm cat, EINonTerm cat']])]
+ where cat' = mkNewECat cat "Star"
+ mkEPlusRules cat = [(cat', [[EINonTerm cat],[EINonTerm cat, EINonTerm cat']])]
+ where cat' = mkNewECat cat "Plus"
+ mkEOptRules cat = [(cat', [[],[EINonTerm cat]])]
+ where cat' = mkNewECat cat "Opt"
+
+nubERules :: [NormERule] -> [NormERule]
+nubERules rules = nub optim where
+ optim = map (substERules (map mkSubst replaces)) irreducibles
+ (replaces,irreducibles) = partition reducible rules
+ reducible (cat,[items]) = isNewCat cat && all isOldIt items
+ reducible _ = False
+ isNewCat (_,ints) = ints == []
+ isOldIt (EITerm _) = True
+ isOldIt (EINonTerm cat) = not (isNewCat cat)
+ isOldIt _ = False
+ mkSubst (cat,its) = (cat, head its) -- def of reducible: its must be singleton
+--- the optimization assumes each cat has at most one EBNF rule.
+
+substERules :: [(ECat,[EItem])] -> NormERule -> NormERule
+substERules g (cat,itss) = (cat, map sub itss) where
+ sub [] = []
+ sub (i@(EINonTerm cat') : ii) = case lookup cat g of
+ Just its -> its ++ sub ii
+ _ -> i : sub ii
+ sub (EIStar r : ii) = EIStar (substERules g r) : ii
+ sub (EIPlus r : ii) = EIPlus (substERules g r) : ii
+ sub (EIOpt r : ii) = EIOpt (substERules g r) : ii
+
+eitem2cfitem :: EItem -> CFItem
+eitem2cfitem it = case it of
+ EITerm a -> atomCFTerm $ tS a
+ EINonTerm cat -> CFNonterm (mkCFCatE cat)
+ EIStar (cat,_) -> CFNonterm (mkCFCatE (mkNewECat cat "Star"))
+ EIPlus (cat,_) -> CFNonterm (mkCFCatE (mkNewECat cat "Plus"))
+ EIOpt (cat,_) -> CFNonterm (mkCFCatE (mkNewECat cat "Opt"))
+
+type NormERule = (ECat,[[EItem]]) -- disjunction of sequences of items
+
+data EItem =
+ EITerm String
+ | EINonTerm ECat
+ | EIStar NormERule
+ | EIPlus NormERule
+ | EIOpt NormERule
+ deriving Eq
+
+normERule :: ([Int],ERule) -> NormERule
+normERule (ii,(cat,rhs)) =
+ (cat,[map (mkEItem (ii ++ [i])) r' | (i,r') <- zip [0..] (disjNorm rhs)]) where
+ disjNorm r = case r of
+ ESeq r1 r2 -> [x ++ y | x <- disjNorm r1, y <- disjNorm r2]
+ EAlt r1 r2 -> disjNorm r1 ++ disjNorm r2
+ EEmpty -> [[]]
+ _ -> [[r]]
+
+mkEItem :: [Int] -> ERHS -> EItem
+mkEItem ii rhs = case rhs of
+ ETerm a -> EITerm a
+ ENonTerm cat -> EINonTerm cat
+ EStar r -> EIStar (normERule (ii,(mkECat ii, r)))
+ EPlus r -> EIPlus (normERule (ii,(mkECat ii, r)))
+ EOpt r -> EIOpt (normERule (ii,(mkECat ii, r)))
+ _ -> EINonTerm ("?????",[])
+-- _ -> error "should not happen in ebnf" ---
+
+mkECat ints = ("C", ints)
+
+prECat (c,[]) = c
+prECat (c,ints) = c ++ "_" ++ prTList "_" (map show ints)
+
+mkCFCatE :: ECat -> CFCat
+mkCFCatE = string2CFCat ebnfID . prECat
+
+updECat _ (c,[]) = (c,[])
+updECat ii (c,_) = (c,ii)
+
+mkNewECat (c,ii) str = (c ++ str,ii)
+
+------ parser for EBNF grammars
+
+pEBNFasGrammar :: String -> Err [A.TopDef]
+pEBNFasGrammar = parseResultErr (pEBNF *** ebnf2gf) . remComments
+
+pEBNF :: Parser Char EBNF
+pEBNF = longestOfMany (pJ pERule)
+
+pERule :: Parser Char ERule
+pERule = pECat ... pJ (literals ":=" ||| literals "::=") +.. pERHS 0 ..+ jL ";"
+
+pERHS :: Int -> Parser Char ERHS
+pERHS 0 = pTList "|" (pERHS 1) *** foldr1 EAlt
+pERHS 1 = longestOfMany (pJ (pERHS 2)) *** foldr ESeq EEmpty
+pERHS 2 = pERHS 3 ... pJ pUnaryEOp *** (\ (a,f) -> f a)
+pERHS 3 = pQuotedString *** ETerm
+ ||| pECat *** ENonTerm ||| pParenth (pERHS 0)
+
+pUnaryEOp :: Parser Char (ERHS -> ERHS)
+pUnaryEOp =
+ lits "*" <<< EStar ||| lits "+" <<< EPlus ||| lits "?" <<< EOpt ||| succeed id
+
+pECat = pIdent *** (\c -> (c,[]))
+
diff --git a/src/GF/CF/PPrCF.hs b/src/GF/CF/PPrCF.hs
index 6712c45f3..a797daace 100644
--- a/src/GF/CF/PPrCF.hs
+++ b/src/GF/CF/PPrCF.hs
@@ -52,7 +52,7 @@ getCFRule :: String -> String -> Err CFRule
getCFRule mo s = getcf (wrds s) where
getcf ww | length ww > 2 && ww !! 2 `elem` ["->", "::="] =
Ok (string2CFFun mo (init fun), (string2CFCat mo cat, map mkIt its)) where
- fun : cat : _ : its = words s
+ fun : cat : _ : its = ww
mkIt ('"':w@(_:_)) = atomCFTerm (string2CFTok (init w))
mkIt w = CFNonterm (string2CFCat mo w)
getcf _ = Bad (" invalid rule:" +++ s)
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs
index 3a1b480ff..f7df7102d 100644
--- a/src/GF/Compile/CheckGrammar.hs
+++ b/src/GF/Compile/CheckGrammar.hs
@@ -269,6 +269,8 @@ inferLType gr trm = case trm of
prtFail "cannot infer type of constant" trm
]
+ QC m ident | m==cPredef -> termWith trm $ checkErr (typPredefined ident)
+
QC m ident -> checks [
termWith trm $ checkErr (lookupResType gr m ident)
,
@@ -426,7 +428,7 @@ inferLType gr trm = case trm of
_ -> False
inferPatt p = case p of
- PP q c ps -> checkErr $ lookupResType gr q c >>= valTypeCnc
+ PP q c ps | q /= cPredef -> checkErr $ lookupResType gr q c >>= valTypeCnc
_ -> infer (patt2term p) >>= return . snd
checkLType :: SourceGrammar -> Term -> Type -> Check (Term, Type)
@@ -560,7 +562,7 @@ checkLType env trm typ0 = do
pattContext :: LTEnv -> Type -> Patt -> Check Context
pattContext env typ p = case p of
PV x -> return [(x,typ)]
- PP q c ps -> do
+ PP q c ps | q /= cPredef -> do
t <- checkErr $ lookupResType cnc q c
(cont,v) <- checkErr $ typeFormCnc t
checkCond ("wrong number of arguments for constructor in" +++ prt p)
diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index e6936809c..145ada8a9 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -56,18 +56,22 @@ batchCompileOld f = compileOld defOpts f
compileModule :: Options -> ShellState -> FilePath ->
IOE (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)]))
-compileModule opts st0 file | oElem showOld opts || fileSuffix file == "cf" = do
+compileModule opts st0 file | oElem showOld opts ||
+ elem suff ["cf","ebnf"] = do
let putp = putPointE opts
let path = [] ----
- grammar1 <- if fileSuffix file == "cf"
- then putp ("- parsing cf" +++ file) $ getCFGrammar opts file
- else putp ("- parsing old gf" +++ file) $ getOldGrammar opts file
+ grammar1 <- if suff == "cf"
+ then putp ("- parsing" +++ suff +++ file) $ getCFGrammar opts file
+ else if suff == "ebnf"
+ then putp ("- parsing" +++ suff +++ file) $ getEBNFGrammar opts file
+ else 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
+ suff = fileSuffix file
comp putp path env sm0 = do
(k',sm) <- makeSourceModule opts env sm0
cm <- putp " generating code... " $ generateModuleCode opts path sm
@@ -87,7 +91,7 @@ compileModule opts1 st0 file = do
let st = st0 --- if useFileOpt then emptyShellState else st0
let rfs = readFiles st
let file' = if useFileOpt then justFileName file else file -- to find file itself
- files <- getAllFiles ps rfs file'
+ files <- getAllFiles opts ps rfs file'
ioeIO $ putStrLn $ "files to read:" +++ show files ----
let names = map justModuleName files
ioeIO $ putStrLn $ "modules to include:" +++ show names ----
diff --git a/src/GF/Compile/GetGrammar.hs b/src/GF/Compile/GetGrammar.hs
index 58ce8d62b..a9cae513a 100644
--- a/src/GF/Compile/GetGrammar.hs
+++ b/src/GF/Compile/GetGrammar.hs
@@ -18,6 +18,7 @@ import qualified LexGF as L
import PPrCF
import CFtoGrammar
+import EBNF
import ReadFiles ----
@@ -86,9 +87,23 @@ oldLexer = map change . L.tokens where
getCFGrammar :: Options -> FilePath -> IOE SourceGrammar
getCFGrammar opts file = do
- let mo = takeWhile (/='-') file
+ let mo = takeWhile (/='.') file
s <- ioeIO $ readFileIf file
cf <- ioeErr $ pCF mo s
defs <- return $ cf2grammar cf
let g = A.OldGr A.NoIncl defs
+--- let ma = justModuleName file
+--- let mc = 'C':ma ---
+--- let opts' = addOptions (options [useAbsName ma, useCncName mc]) opts
+ ioeErr $ transOldGrammar opts file g
+
+getEBNFGrammar :: Options -> FilePath -> IOE SourceGrammar
+getEBNFGrammar opts file = do
+ let mo = takeWhile (/='.') file
+ s <- ioeIO $ readFileIf file
+ defs <- ioeErr $ pEBNFasGrammar s
+ let g = A.OldGr A.NoIncl defs
+--- let ma = justModuleName file
+--- let mc = 'C':ma ---
+--- let opts' = addOptions (options [useAbsName ma, useCncName mc]) opts
ioeErr $ transOldGrammar opts file g
diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs
index 30c2b2c71..6c3f964df 100644
--- a/src/GF/Compile/Rename.hs
+++ b/src/GF/Compile/Rename.hs
@@ -62,6 +62,7 @@ renameIdentTerm env@(act,imps) t =
m <- lookupErr m' qualifs
f <- lookupTree prt c m
return $ f c
+ QC m' c | m' == cPredef {- && isInPredefined c -} -> return t
QC m' c -> do
m <- lookupErr m' qualifs
f <- lookupTree prt c m
diff --git a/src/GF/Grammar/AppPredefined.hs b/src/GF/Grammar/AppPredefined.hs
index eceb749b0..7ff479df0 100644
--- a/src/GF/Grammar/AppPredefined.hs
+++ b/src/GF/Grammar/AppPredefined.hs
@@ -16,8 +16,8 @@ typPredefined :: Ident -> Err Type
typPredefined c@(IC f) = case f of
"Int" -> return typePType
"PBool" -> return typePType
---- "PFalse" -> -- hidden
---- "PTrue" ->
+ "PFalse" -> return $ cnPredef "PBool"
+ "PTrue" -> return $ cnPredef "PBool"
"dp" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
"drop" -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
"eqInt" -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index 075da2a9d..b74d02fd8 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -290,6 +290,8 @@ eqStrIdent = (==)
tupleLabel i = LIdent $ "p" ++ show i
linLabel i = LIdent $ "s" ++ show i
+theLinLabel = LIdent "s"
+
tuple2record :: [Term] -> [Assign]
tuple2record ts = [assign (tupleLabel i) t | (i,t) <- zip [1..] ts]
diff --git a/src/GF/Grammar/PrGrammar.hs b/src/GF/Grammar/PrGrammar.hs
index aa155c966..1a3754f04 100644
--- a/src/GF/Grammar/PrGrammar.hs
+++ b/src/GF/Grammar/PrGrammar.hs
@@ -68,12 +68,17 @@ prContext co = unwords $ map prParenth [prt x +++ ":" +++ prt t | (x,t) <- co]
instance Print A.Exp where prt = C.printTree
instance Print A.Term where prt = C.printTree
instance Print A.Case where prt = C.printTree
-instance Print A.Atom where prt = C.printTree
instance Print A.CType where prt = C.printTree
instance Print A.Label where prt = C.printTree
instance Print A.Module where prt = C.printTree
instance Print A.Sort where prt = C.printTree
+instance Print A.Atom where
+ prt = C.printTree
+ prt_ (A.AC c) = prt_ c
+ prt_ (A.AD c) = prt_ c
+ prt_ a = prt a
+
instance Print A.Patt where
prt = C.printTree
prt_ = prPatt
@@ -174,7 +179,7 @@ instance Print Atom where
prt (AtV i) = prt i
prt (AtL s) = s
prt (AtI i) = show i
- prt_ (AtC f) = prQIdent_ f
+ prt_ (AtC (_,f)) = prt f
prt_ a = prt a
prQIdent :: QIdent -> String
diff --git a/src/GF/Infra/Comments.hs b/src/GF/Infra/Comments.hs
new file mode 100644
index 000000000..442728b80
--- /dev/null
+++ b/src/GF/Infra/Comments.hs
@@ -0,0 +1,29 @@
+module Comments where
+
+-- comment removal : line tails prefixed by -- as well as chunks in {- ... -}
+
+remComments :: String -> String
+remComments s =
+ case s of
+ '"':s2 -> '"':pass remComments s2 -- comment marks in quotes not removed!
+ '{':'-':cs -> readNested cs
+ '-':'-':cs -> readTail cs
+ c:cs -> c : remComments cs
+ [] -> []
+ where
+ readNested t =
+ case t of
+ '"':s2 -> '"':pass readNested s2
+ '-':'}':cs -> remComments cs
+ _:cs -> readNested cs
+ [] -> []
+ readTail t =
+ case t of
+ '\n':cs -> '\n':remComments cs
+ _:cs -> readTail cs
+ [] -> []
+ pass f t =
+ case t of
+ '"':s2 -> '"': f s2
+ c:s2 -> c:pass f s2
+ _ -> t
diff --git a/src/GF/Infra/ReadFiles.hs b/src/GF/Infra/ReadFiles.hs
index 06205e350..4172ee32e 100644
--- a/src/GF/Infra/ReadFiles.hs
+++ b/src/GF/Infra/ReadFiles.hs
@@ -27,15 +27,15 @@ import List
type ModName = String
type ModEnv = [(ModName,ModTime)]
-getAllFiles :: [InitPath] -> ModEnv -> FileName -> IOE [FullPath]
-getAllFiles ps env file = do
+getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath]
+getAllFiles opts ps env file = do
-- read module headers from all files recursively
ds0 <- getImports ps file
let ds = [((snd m,map fst ms),p) | ((m,ms),p) <- ds0]
ioeIO $ putStrLn $ "all modules:" +++ show (map (fst . fst) ds)
- -- get a topological sorting of files: returns file names --- deletes paths
+ -- get a topological sorting of files: returns file names --- deletes paths
ds1 <- ioeErr $ either
return
(\ms -> Bad $ "circular modules" +++
@@ -44,12 +44,15 @@ getAllFiles ps env file = do
-- associate each file name with its path --- more optimal: save paths in ds1
let paths = [(f,p) | ((f,_),p) <- ds]
let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]]
+ if oElem fromSource opts
+ then return [gfFile (prefixPathName p f) | (p,f) <- pds1]
+ else do
- ds2 <- ioeIO $ mapM (selectFormat env) pds1
+ ds2 <- ioeIO $ mapM (selectFormat env) pds1
- let ds4 = needCompile (map fst ds0) ds2
- return ds4
+ let ds4 = needCompile opts (map fst ds0) ds2
+ return ds4
-- to decide whether to read gf or gfc, or if in env; returns full file path
@@ -77,8 +80,9 @@ selectFormat env (p,f) = do
return $ (f, (p,stat))
-needCompile :: [ModuleHeader] -> [(ModName,(InitPath,CompStatus))] -> [FullPath]
-needCompile headers sfiles0 = paths $ res $ mark $ iter changed where
+needCompile :: Options ->
+ [ModuleHeader] -> [(ModName,(InitPath,CompStatus))] -> [FullPath]
+needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
deps = [(snd m,map fst ms) | (m,ms) <- headers]
typ m = maybe MTyOther id $ lookup m [(m,t) | ((t,m),_) <- headers]
@@ -117,10 +121,12 @@ needCompile headers sfiles0 = paths $ res $ mark $ iter changed where
-- if a compilable file depends on a resource, read gfr instead of gfc/env
-- but don't read gfr if already in env (by CSEnvR)
+ -- Also read res if the option "retain" is present
res cs = map mkRes cs where
mkRes x@(f,(path,st)) | elem st [CSRead,CSEnv] = case typ f of
MTyResource | not (null [m | (m,(_,CSComp)) <- cs,
Just ms <- [lookup m allDeps], elem f ms])
+ || oElem retainOpers opts
-> (f,(path,CSRes))
_ -> x
mkRes x = x
diff --git a/src/GF/Source/SourceToGrammar.hs b/src/GF/Source/SourceToGrammar.hs
index 9834fb0cf..074c8a577 100644
--- a/src/GF/Source/SourceToGrammar.hs
+++ b/src/GF/Source/SourceToGrammar.hs
@@ -539,6 +539,8 @@ transOldGrammar opts name0 x = case x of
(beg,rest) = span (/='.') name
(topic,lang) = case rest of -- to avoid overwriting old files
".gf" -> ("Abs" ++ beg,"Cnc" ++ beg)
+ ".cf" -> ("Abs" ++ beg,"Cnc" ++ beg)
+ ".ebnf" -> ("Abs" ++ beg,"Cnc" ++ beg)
[] -> ("Abs" ++ beg,"Cnc" ++ beg)
_:s -> (beg, takeWhile (/='.') s)
diff --git a/src/HelpFile b/src/HelpFile
index 523f69a7c..48602030b 100644
--- a/src/HelpFile
+++ b/src/HelpFile
@@ -19,14 +19,15 @@ i, import: i File
.gfc canonical GF
.gfr precompiled GF resource
.gfcm multilingual canonical GF
- *.ebnf Extended BNF format
+ .ebnf Extended BNF format
.cf Context-free (BNF) format
options:
-old old: parse in GF<2.0 format
-v verbose: give lots of messages
-s silent: don't give error messages
-opt perform branch-sharing optimization
- *-src source: ignore precompiled gfc and gfr files
+ -src source: ignore precompiled gfc and gfr files
+ -retain retain operations: read resource modules (needed in comm cc)
-nocf don't build context-free grammar (thus no parser)
-nocheckcirc don't eliminate circular rules from CF
-cflexer build an optimized parser with separate lexer trie
@@ -136,7 +137,7 @@ cc, compute_concrete: cc Ident Term
Compute a term by concrete syntax definitions.
The identifier Ident is a resource module name
needed to resolve constant.
- N.B. You need the flag -src when importing the grammar, if you want
+ 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,
diff --git a/src/HelpFile.hs b/src/HelpFile.hs
index 0cbfb026c..12fdab8a6 100644
--- a/src/HelpFile.hs
+++ b/src/HelpFile.hs
@@ -32,14 +32,15 @@ txtHelpFile =
"\n .gfc canonical GF" ++
"\n .gfr precompiled GF resource " ++
"\n .gfcm multilingual canonical GF" ++
- "\n *.ebnf Extended BNF format" ++
+ "\n .ebnf Extended BNF format" ++
"\n .cf Context-free (BNF) format" ++
"\n options:" ++
"\n -old old: parse in GF<2.0 format" ++
"\n -v verbose: give lots of messages " ++
"\n -s silent: don't give error messages" ++
"\n -opt perform branch-sharing optimization" ++
- "\n *-src source: ignore precompiled gfc and gfr files " ++
+ "\n -src source: ignore precompiled gfc and gfr files" ++
+ "\n -retain retain operations: read resource modules (needed in comm cc) " ++
"\n -nocf don't build context-free grammar (thus no parser)" ++
"\n -nocheckcirc don't eliminate circular rules from CF " ++
"\n -cflexer build an optimized parser with separate lexer trie" ++
@@ -149,7 +150,7 @@ txtHelpFile =
"\n Compute a term by concrete syntax definitions." ++
"\n The identifier Ident is a resource module name " ++
"\n needed to resolve constant. " ++
- "\n N.B. You need the flag -src when importing the grammar, if you want " ++
+ "\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," ++
diff --git a/src/Today.hs b/src/Today.hs
index e8b0bfc69..cc400444a 100644
--- a/src/Today.hs
+++ b/src/Today.hs
@@ -1 +1 @@
-module Today where today = "Fri Mar 26 19:27:07 CET 2004"
+module Today where today = "Wed Mar 31 15:13:46 CEST 2004"
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 11:31:39 +0000