summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF.hs10
-rw-r--r--src/GF/Canon/CMacros.hs3
-rw-r--r--src/GF/Canon/CanonToGrammar.hs10
-rw-r--r--src/GF/Compile/Compile.hs4
-rw-r--r--src/GF/Compile/GrammarToCanon.hs14
-rw-r--r--src/GF/Compile/MkResource.hs2
-rw-r--r--src/GF/Compile/Optimize.hs41
-rw-r--r--src/GF/Grammar/Compute.hs5
-rw-r--r--src/GF/Grammar/Grammar.hs4
-rw-r--r--src/GF/Grammar/Macros.hs9
-rw-r--r--src/GF/Shell.hs2
-rw-r--r--src/GF/Source/GrammarToSource.hs6
-rw-r--r--src/GF/UseGrammar/Custom.hs2
-rw-r--r--src/GF/UseGrammar/Morphology.hs2
-rw-r--r--src/HelpFile8
-rw-r--r--src/HelpFile.hs9
-rw-r--r--src/tools/MkHelpFile.hs1
17 files changed, 84 insertions, 48 deletions
diff --git a/src/GF.hs b/src/GF.hs
index 80cf858c0..178e32b08 100644
--- a/src/GF.hs
+++ b/src/GF.hs
@@ -5,11 +5,11 @@
-- Stability : (stability)
-- Portability : (portability)
--
--- > CVS $Date: 2005/02/04 10:10:28 $
--- > CVS $Author: peb $
--- > CVS $Revision: 1.19 $
+-- > CVS $Date: 2005/02/05 21:52:31 $
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.20 $
--
--- (Description of the module)
+-- The Main module of GF program.
-----------------------------------------------------------------------------
module Main (main) where
@@ -89,7 +89,7 @@ welcomeMsg =
"Welcome to " ++ authorMsg ++++ welcomeArch ++ "\n\nType 'h' for help."
authorMsg = unlines [
- "Grammatical Framework, Version 2.1.1b",
+ "Grammatical Framework, Version 2.1.2b",
"Compiled " ++ today,
"Copyright (c)",
"Björn Bringert, Markus Forsberg, Thomas Hallgren, Harald Hammarström,",
diff --git a/src/GF/Canon/CMacros.hs b/src/GF/Canon/CMacros.hs
index d2c128454..8c655179a 100644
--- a/src/GF/Canon/CMacros.hs
+++ b/src/GF/Canon/CMacros.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- Macros for building and analysing terms in GFC concrete syntax.
-----------------------------------------------------------------------------
module CMacros where
@@ -226,6 +226,7 @@ wordsInTerm trm = filter (not . null) $ case trm of
S c _ -> wo c
R rs -> concat [wo t | Ass _ t <- rs]
T _ cs -> concat [wo t | Cas _ t <- cs]
+ V _ cs -> concat [wo t | t <- cs]
C s t -> wo s ++ wo t
FV ts -> concatMap wo ts
K (KP ss vs) -> ss ++ concat [s | Var s _ <- vs]
diff --git a/src/GF/Canon/CanonToGrammar.hs b/src/GF/Canon/CanonToGrammar.hs
index cd4863442..16c2ae1f0 100644
--- a/src/GF/Canon/CanonToGrammar.hs
+++ b/src/GF/Canon/CanonToGrammar.hs
@@ -143,13 +143,13 @@ redCTerm x = case x of
P term label -> liftM2 G.P (redCTerm term) (return $ redLabel label)
T ctype cases -> do
ctype' <- redCType ctype
- let (ps,ts) = unzip [(p,t) | Cas ps t <- cases, p <- ps] --- destroys sharing
- ps' <- mapM redPatt ps
- ts' <- mapM redCTerm ts --- duplicates work for shared rhss
+ let (ps,ts) = unzip [(ps,t) | Cas ps t <- cases]
+ ps' <- mapM (mapM redPatt) ps
+ ts' <- mapM redCTerm ts
let tinfo = case ps' of
- [G.PV _] -> G.TTyped ctype'
+ [[G.PV _]] -> G.TTyped ctype'
_ -> G.TComp ctype'
- return $ G.T tinfo $ zip ps' ts'
+ return $ G.TSh tinfo $ zip ps' ts'
V ctype ts -> do
ctype' <- redCType ctype
ts' <- mapM redCTerm ts
diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index bfd8f64f2..c1e006168 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -262,10 +262,10 @@ compileSourceModule opts env@(k,gr,can) mo@(i,mi) = do
(k',mo3r:_) <- ioeErr $ refreshModule (k,mos) mo3
- mo4:_ <-
+ mo4 <-
---- case snd mo1b of
---- ModMod n | isModCnc n ->
- putp " optimizing " $ ioeErr $ evalModule mos mo3r
+ putp " optimizing " $ ioeErr $ optimizeModule opts mos mo3r
---- _ -> return [mo3r]
return (k',mo4)
where
diff --git a/src/GF/Compile/GrammarToCanon.hs b/src/GF/Compile/GrammarToCanon.hs
index 5ec5c8091..c090f1622 100644
--- a/src/GF/Compile/GrammarToCanon.hs
+++ b/src/GF/Compile/GrammarToCanon.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- Code generator from optimized GF source code to GFC.
-----------------------------------------------------------------------------
module GrammarToCanon where
@@ -187,7 +187,9 @@ redCType t = case t of
redCTerm :: Term -> Err G.Term
redCTerm t = case t of
- Vr x -> liftM G.Arg $ redArgvar x
+ Vr x -> checkAgain
+ (liftM G.Arg $ redArgvar x)
+ (liftM G.LI $ redIdent x) --- for parametrize optimization
App _ _ -> do -- only constructor applications can remain
(_,c,xx) <- termForm t
xx' <- mapM redCTerm xx
@@ -212,6 +214,13 @@ redCTerm t = case t of
ps' <- mapM redPatt ps
ts' <- mapM redCTerm ts
return $ G.T ty' $ map (uncurry G.Cas) $ zip (map singleton ps') ts'
+ TSh i cs -> do
+ ty <- getTableType i
+ ty' <- redCType ty
+ let (pss,ts) = unzip cs
+ pss' <- mapM (mapM redPatt) pss
+ ts' <- mapM redCTerm ts
+ return $ G.T ty' $ map (uncurry G.Cas) $ zip pss' ts'
V ty ts -> do
ty' <- redCType ty
ts' <- mapM redCTerm ts
@@ -247,6 +256,7 @@ redPatt p = case p of
return $ G.PR $ map (uncurry G.PAss) $ zip ls' ts
PT _ q -> redPatt q
PInt i -> return $ G.PI (toInteger i)
+ PV x -> liftM G.PV $ redIdent x --- for parametrize optimization
_ -> prtBad "cannot reduce pattern" p
redLabel :: Label -> G.Label
diff --git a/src/GF/Compile/MkResource.hs b/src/GF/Compile/MkResource.hs
index cd374ff41..1c0bdb21c 100644
--- a/src/GF/Compile/MkResource.hs
+++ b/src/GF/Compile/MkResource.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- Compile a gfc module into a "reuse" gfr resource, interface, or instance.
-----------------------------------------------------------------------------
module MkResource where
diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs
index ef98e7dab..47405f0b4 100644
--- a/src/GF/Compile/Optimize.hs
+++ b/src/GF/Compile/Optimize.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- Top-level partial evaluation for GF source modules.
-----------------------------------------------------------------------------
module Optimize where
@@ -22,25 +22,38 @@ import Macros
import Lookup
import Refresh
import Compute
+import BackOpt
import CheckGrammar
import Update
import Operations
import CheckM
+import Option
import Monad
import List
--- partial evaluation of concrete syntax. AR 6/2001 -- 16/5/2003
-{-
-evalGrammar :: SourceGrammar -> Err SourceGrammar
-evalGrammar gr = do
- gr2 <- refreshGrammar gr
- mos <- foldM evalModule [] $ modules gr2
- return $ MGrammar $ reverse mos
--}
+-- partial evaluation of concrete syntax. AR 6/2001 -- 16/5/2003 -- 5/2/2005
+-- only do this for resource: concrete is optimized in gfc form
+
+optimizeModule :: Options -> [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) ->
+ Err (Ident,SourceModInfo)
+optimizeModule opts ms mo@(_,mi) = case mi of
+ ModMod m0@(Module mt st fs me ops js) | st == MSComplete && isModRes m0 -> do
+ mo1 <- evalModule ms mo
+ let oopts = addOptions opts (iOpts (flagsModule mo1))
+ optim = maybe "none" id $ getOptVal oopts useOptimizer
+ return $ case optim of
+ "parametrize" -> shareModule paramOpt mo1 -- parametrization and sharing
+ "values" -> shareModule valOpt mo1 -- tables as courses-of-values
+ "share" -> shareModule shareOpt mo1 -- sharing of branches
+ "all" -> shareModule allOpt mo1 -- first parametrize then values
+ "none" -> mo1 -- no optimization
+ _ -> mo1 -- none; default for src
+ _ -> evalModule ms mo
+
evalModule :: [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) ->
- Err [(Ident,SourceModInfo)]
+ Err (Ident,SourceModInfo)
evalModule ms mo@(name,mod) = case mod of
ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
@@ -48,13 +61,13 @@ evalModule ms mo@(name,mod) = case mod of
let deps = allOperDependencies name js
ids <- topoSortOpers deps
MGrammar (mod' : _) <- foldM evalOp gr ids
- return $ mod' : ms
+ return $ mod'
MTConcrete a -> do
js' <- mapMTree (evalCncInfo gr0 name a) js
- return $ (name, ModMod (Module mt st fs me ops js')) : ms
+ return $ (name, ModMod (Module mt st fs me ops js'))
- _ -> return $ (name,mod):ms
- _ -> return $ (name,mod):ms
+ _ -> return $ (name,mod)
+ _ -> return $ (name,mod)
where
gr0 = MGrammar $ ms
gr = MGrammar $ (name,mod) : ms
diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs
index 71bed6d49..2ddce3a6c 100644
--- a/src/GF/Grammar/Compute.hs
+++ b/src/GF/Grammar/Compute.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- Computation of source terms. Used in compilation and in 'cc' command.
-----------------------------------------------------------------------------
module Compute where
@@ -218,6 +218,9 @@ computeTerm gr = comp where
cs' <- if (null g) then return cs else mapPairsM (comp g) cs
return $ T i cs'
+ --- this means some extra work; should implement TSh directly
+ TSh i cs -> comp g $ T i [(p,v) | (ps,v) <- cs, p <- ps]
+
T i cs -> do
pty0 <- getTableType i
ptyp <- comp g pty0
diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs
index d5d59aec3..8ab2356d2 100644
--- a/src/GF/Grammar/Grammar.hs
+++ b/src/GF/Grammar/Grammar.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- GF source abstract syntax used internally in compilation.
-----------------------------------------------------------------------------
module Grammar where
@@ -91,6 +91,7 @@ data Term =
| Table Term Term -- table type: P => A
| T TInfo [Case] -- table: table {p => c ; ...}
+ | TSh TInfo [Cases] -- table with discjunctive patters (only back end opt)
| V Type [Term] -- table given as course of values: table T [c1 ; ... ; cn]
| S Term Term -- selection: t ! p
@@ -149,6 +150,7 @@ type Equation = ([Patt],Term)
type Labelling = (Label, Term)
type Assign = (Label, (Maybe Type, Term))
type Case = (Patt, Term)
+type Cases = ([Patt], Term)
type LocalDef = (Ident, (Maybe Type, Term))
type Param = (Ident, Context)
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index 8c1ac36d7..cfc71b1a5 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- Macros for constructing and analysing source code terms.
-----------------------------------------------------------------------------
module Macros where
@@ -603,6 +603,11 @@ composOp co trm =
i' <- changeTableType co i
return (T i' cc')
+ TSh i cc ->
+ do cc' <- mapPairListM (co . snd) cc
+ i' <- changeTableType co i
+ return (TSh i' cc')
+
V ty vs ->
do ty' <- co ty
vs' <- mapM co vs
@@ -661,6 +666,8 @@ collectOp co trm = case trm of
RecType r -> concatMap (co . snd) r
P t i -> co t
T _ cc -> concatMap (co . snd) cc -- not from patterns --- nor from type annot
+ TSh _ cc -> concatMap (co . snd) cc -- not from patterns --- nor from type annot
+ V _ cc -> concatMap co cc --- nor from type annot
Let (x,(mt,a)) b -> maybe [] co mt ++ co a ++ co b
C s1 s2 -> co s1 ++ co s2
Glue s1 s2 -> co s1 ++ co s2
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index de33de3f0..c98adfb66 100644
--- a/src/GF/Shell.hs
+++ b/src/GF/Shell.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- GF shell command interpreter.
-----------------------------------------------------------------------------
module Shell where
diff --git a/src/GF/Source/GrammarToSource.hs b/src/GF/Source/GrammarToSource.hs
index 346af7101..24826c7f7 100644
--- a/src/GF/Source/GrammarToSource.hs
+++ b/src/GF/Source/GrammarToSource.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- From internal source syntax to BNFC-generated (used for printing).
-----------------------------------------------------------------------------
module GrammarToSource where
@@ -139,6 +139,7 @@ trt trm = case trm of
P t l -> P.EProj (trt t) (trLabel l)
Q t l -> P.EQCons (tri t) (tri l)
QC t l -> P.EQConstr (tri t) (tri l)
+ TSh (TComp ty) cc -> P.ETTable (trt ty) (map trCases cc)
T (TTyped ty) cc -> P.ETTable (trt ty) (map trCase cc)
T (TComp ty) cc -> P.ETTable (trt ty) (map trCase cc)
T (TWild ty) cc -> P.ETTable (trt ty) (map trCase cc)
@@ -192,7 +193,8 @@ trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t')
trLabelling (lab,ty) = P.LDDecl [trLabelIdent lab] (trt ty)
-trCase (patt,trm) = P.Case [P.AltP (trp patt)] (trt trm)
+trCase (patt, trm) = P.Case [P.AltP (trp patt)] (trt trm)
+trCases (patts,trm) = P.Case (map (P.AltP . trp) patts) (trt trm)
trDecl (x,ty) = P.DDDec [trb x] (trt ty)
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index fd9971c73..4ec37d1ae 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- A database for customizable GF shell commands.
-----------------------------------------------------------------------------
module Custom where
diff --git a/src/GF/UseGrammar/Morphology.hs b/src/GF/UseGrammar/Morphology.hs
index f23401068..418bce001 100644
--- a/src/GF/UseGrammar/Morphology.hs
+++ b/src/GF/UseGrammar/Morphology.hs
@@ -9,7 +9,7 @@
-- > CVS $Author $
-- > CVS $Revision $
--
--- (Description of the module)
+-- Morphological analyser constructed from a GF grammar.
-----------------------------------------------------------------------------
module Morphology where
diff --git a/src/HelpFile b/src/HelpFile
index 5581039f2..c9e015810 100644
--- a/src/HelpFile
+++ b/src/HelpFile
@@ -428,17 +428,15 @@ q, quit: q
The default is unlimited.
-optimize, optimization on generated code.
- The default is share.
+ The default is share for concrete, none for resource modules.
-optimize=share share common branches in tables
-optimize=parametrize first try parametrize then do share with the rest
-optimize=values represent tables as courses-of-values
-optimize=all first try parametrize then do values with the rest
-optimize=none no optimization
-
--parser, Context-free parsing algorithm. The default is chart.
- -parser=earley Earley algorithm
- -parser=chart bottom-up chart parser
+-parser, Context-free parsing algorithm. Under construction.
+ The default is a chart parser via context-free approximation.
-printer, format in which the grammar is printed. The default is gfc.
-printer=gfc GFC grammar
diff --git a/src/HelpFile.hs b/src/HelpFile.hs
index 0b78947bb..c2bed6b15 100644
--- a/src/HelpFile.hs
+++ b/src/HelpFile.hs
@@ -10,6 +10,7 @@
-- > CVS $Revision $
--
-- Help on shell commands. Generated from HelpFile by 'make help'.
+-- PLEASE DON'T EDIT THIS FILE.
-----------------------------------------------------------------------------
@@ -456,17 +457,15 @@ txtHelpFile =
"\n The default is unlimited." ++
"\n" ++
"\n-optimize, optimization on generated code." ++
- "\n The default is share." ++
+ "\n The default is share for concrete, none for resource modules." ++
"\n -optimize=share share common branches in tables" ++
"\n -optimize=parametrize first try parametrize then do share with the rest" ++
"\n -optimize=values represent tables as courses-of-values" ++
"\n -optimize=all first try parametrize then do values with the rest" ++
"\n -optimize=none no optimization" ++
"\n" ++
- "\n" ++
- "\n-parser, Context-free parsing algorithm. The default is chart." ++
- "\n -parser=earley Earley algorithm" ++
- "\n -parser=chart bottom-up chart parser" ++
+ "\n-parser, Context-free parsing algorithm. Under construction." ++
+ "\n The default is a chart parser via context-free approximation." ++
"\n" ++
"\n-printer, format in which the grammar is printed. The default is gfc." ++
"\n -printer=gfc GFC grammar" ++
diff --git a/src/tools/MkHelpFile.hs b/src/tools/MkHelpFile.hs
index 6f7fe0184..fc0db2e00 100644
--- a/src/tools/MkHelpFile.hs
+++ b/src/tools/MkHelpFile.hs
@@ -54,6 +54,7 @@ helpHeader = unlines [
"-- > CVS $Revision $",
"--",
"-- Help on shell commands. Generated from HelpFile by 'make help'.",
+ "-- PLEASE DON'T EDIT THIS FILE.",
"-----------------------------------------------------------------------------",
"",
""
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 14:38:50 +0000