summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF/API.hs6
-rw-r--r--src/GF/Grammar/TypeCheck.hs3
-rw-r--r--src/GF/Shell.hs10
-rw-r--r--src/GF/Shell/Commands.hs2
-rw-r--r--src/GF/Shell/PShell.hs1
-rw-r--r--src/GF/UseGrammar/Custom.hs12
-rw-r--r--src/GF/UseGrammar/Generate.hs63
-rw-r--r--src/HelpFile6
-rw-r--r--src/HelpFile.hs6
-rw-r--r--src/JavaGUI/GFEditor2.java2
-rw-r--r--src/Today.hs2
11 files changed, 90 insertions, 23 deletions
diff --git a/src/GF/API.hs b/src/GF/API.hs
index 49d7fd5a2..d748a5517 100644
--- a/src/GF/API.hs
+++ b/src/GF/API.hs
@@ -157,10 +157,10 @@ randomTreesIO opts gr n = do
g = grammar gr
mx = optIntOrN opts flagDepth 41
-generateTrees :: Options -> GFGrammar -> [Tree]
-generateTrees opts gr =
+generateTrees :: Options -> GFGrammar -> Maybe Tree -> [Tree]
+generateTrees opts gr mt =
optIntOrAll opts flagNumber
- [tr | t <- Gen.generateTrees gr' cat dpt mn, Ok tr <- [mkTr t]]
+ [tr | t <- Gen.generateTrees gr' cat dpt mn mt, Ok tr <- [mkTr t]]
where
mkTr = annotate gr' . qualifTerm (absId gr)
gr' = grammar gr
diff --git a/src/GF/Grammar/TypeCheck.hs b/src/GF/Grammar/TypeCheck.hs
index 1cc486965..183b0ac12 100644
--- a/src/GF/Grammar/TypeCheck.hs
+++ b/src/GF/Grammar/TypeCheck.hs
@@ -243,3 +243,6 @@ exp2termCommand gr f t = errIn ("modifying term" +++ prt t) $ do
exp2termlistCommand :: GFCGrammar -> (Exp -> [Exp]) -> Tree -> [Tree]
exp2termlistCommand gr f = err (const []) fst . mapErr (annotate gr) . f . tree2exp
+
+tree2termlistCommand :: GFCGrammar -> (Tree -> [Exp]) -> Tree -> [Tree]
+tree2termlistCommand gr f = err (const []) fst . mapErr (annotate gr) . f
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index 66a073ebc..61fa7ce1e 100644
--- a/src/GF/Shell.hs
+++ b/src/GF/Shell.hs
@@ -188,7 +188,15 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
_ -> do
ts <- randomTreesIO opts gro (optIntOrN opts flagNumber 1)
returnArg (ATrms ts) sa
- CGenerateTrees -> returnArg (ATrms $ generateTrees opts gro) sa
+ CGenerateTrees -> do
+ let
+ a' = case a of
+ ASTrm _ -> s2t a
+ _ -> a
+ mt = case a' of
+ ATrms (tr:_) -> Just tr
+ _ -> Nothing
+ returnArg (ATrms $ generateTrees opts gro mt) sa
CPutTerm -> changeArg (opTT2CommandArg (optTermCommand opts gro) . s2t) sa
diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs
index 19148c1bc..678d3d7da 100644
--- a/src/GF/Shell/Commands.hs
+++ b/src/GF/Shell/Commands.hs
@@ -238,6 +238,8 @@ execECommand env c = case c of
replaceByTermCommand der gr c (actTree (stateSState s)) s
---- "transfer" -> action2commandNext $
---- transferSubTree (stateTransferFun sgr) gr
+ "generate" -> \s ->
+ replaceByTermCommand der gr c (actTree (stateSState s)) s
_ -> replaceByEditCommand gr c
CAddOption o -> changeStOptions (addOption o)
diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs
index befdb8ea2..7a7f1e702 100644
--- a/src/GF/Shell/PShell.hs
+++ b/src/GF/Shell/PShell.hs
@@ -73,6 +73,7 @@ pCommand ws = case ws of
"gr" : [] -> aUnit CGenerateRandom
"gr" : t -> aTerm CGenerateRandom t
"gt" : [] -> aUnit CGenerateTrees
+ "gt" : t -> aTerm CGenerateTrees t
"pt" : s -> aTerm CPutTerm s
----- "wt" : f : s -> aTerm (CWrapTerm (string2id f)) s
"ma" : s -> aString CMorphoAnalyse s
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index 66ba55934..400b358c7 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -11,6 +11,7 @@ import qualified AbsGF as GF
import qualified MMacros as MM
import AbsCompute
import TypeCheck
+import Generate
------import Compile
import ShellState
import Editing
@@ -203,6 +204,14 @@ customTermCommand =
(exp2termCommand gr (computeAbsTerm gr) t))
,(strCI "paraphrase", \g t -> let gr = grammar g in
exp2termlistCommand gr (mkParaphrases gr) t)
+
+ ,(strCI "generate", \g t -> let gr = grammar g
+ cat = actCat $ tree2loc t --- not needed
+ in
+ tree2termlistCommand gr
+ (generateTrees gr cat 2
+ Nothing . Just) t)
+
,(strCI "typecheck", \g t -> let gr = grammar g in
err (const []) (return . const t)
(checkIfValidExp gr (tree2exp t)))
@@ -219,12 +228,13 @@ customEditCommand =
customData "Editor state transformers, selected by option -edit=x" $
[
(strCI "identity", const return) -- DEFAULT
- ,(strCI "transfer", const return) --- done ad hoc on top level
,(strCI "typecheck", \g -> reCheckState (grammar g))
,(strCI "solve", \g -> solveAll (grammar g))
,(strCI "context", \g -> contextRefinements (grammar g))
,(strCI "compute", \g -> computeSubTree (grammar g))
,(strCI "paraphrase", const return) --- done ad hoc on top level
+ ,(strCI "generate", const return) --- done ad hoc on top level
+ ,(strCI "transfer", const return) --- done ad hoc on top level
-- add your own edit commands here
]
++ moreCustomEditCommand
diff --git a/src/GF/UseGrammar/Generate.hs b/src/GF/UseGrammar/Generate.hs
index 9f8fb66d1..94d6a6cfe 100644
--- a/src/GF/UseGrammar/Generate.hs
+++ b/src/GF/UseGrammar/Generate.hs
@@ -4,8 +4,11 @@ import GFC
import LookAbs
import PrGrammar
import Macros
+import Values
import Operations
+import Zipper
+
import List
-- Generate all trees of given category and depth. AR 30/4/2004
@@ -17,10 +20,14 @@ import List
-- the main function takes an abstract syntax and returns a list of trees
--- generateTrees :: GFCGrammar -> Cat -> Int -> Maybe Int -> [Exp]
-generateTrees gr cat n mn = map str2tr $ generate gr' cat' n mn where
- gr' = gr2sgr gr
- cat' = prt $ snd cat
+--- if type were shown more modules should be imported
+-- generateTrees ::
+-- GFCGrammar -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp]
+generateTrees gr cat n mn mt = map str2tr $ generate gr' cat' n mn mt'
+ where
+ gr' = gr2sgr gr
+ cat' = prt $ snd cat
+ mt' = maybe Nothing (return . tr2str) mt
------------------------------------------
-- translate grammar to simpler form and generated trees back
@@ -34,28 +41,49 @@ gr2sgr gr = [(trId f, ty') | (f,ty) <- funRulesOf gr, ty' <- trTy ty] where
trCat (m,c) = prt c ---
-- str2tr :: STree -> Exp
-str2tr (STr (f,ts)) = mkApp (trId f) (map str2tr ts) where
- trId = cn . zIdent
+str2tr t = case t of
+ SApp (f,ts) -> mkApp (trId f) (map str2tr ts)
+
+ where
+ trId = cn . zIdent
+
+-- tr2str :: Tree -> STree
+tr2str (Tr (N (_,at,val,_,_),ts)) = case (at,val) of
+ (AtC (_,f), _) -> SApp (prt_ f,map tr2str ts)
+ (AtM _, VCn (_,c)) -> SMeta (prt_ c)
+ (AtL s, _) -> SString s
+ (AtI i, _) -> SInt i
+ _ -> SMeta "FAILED_TO_GENERATE" ---- err monad!
------------------------------------------
-- do the main thing with a simpler data structure
-- the first Int gives tree depth, the second constrains subtrees
-- chosen for each branch. A small number, such as 2, is a good choice
-- if the depth is large (more than 3)
+-- If a tree is given as argument, generation concerns its metavariables.
+
+generate :: SGrammar -> SCat -> Int -> Maybe Int -> Maybe STree -> [STree]
+generate gr cat i mn mt = case mt of
+ Nothing -> [t | (c,t) <- gen 0 [], c == cat]
+ Just t -> genM t
-generate :: SGrammar -> SCat -> Int -> Maybe Int -> [STree]
-generate gr cat i mn = [t | (c,t) <- gen 0 [], c == cat] where
+ where
gen :: Int -> [(SCat,STree)] -> [(SCat,STree)]
gen n cts = if n==i then cts else
- gen (n+1) (nub [(c,STr (f, xs)) | (f,(cs,c)) <- gr, xs <- args cs cts] ++ cts)
+ gen (n+1) (nub [(c,SApp (f, xs)) | (f,(cs,c)) <- gr, xs <- args cs cts] ++ cts)
args :: [SCat] -> [(SCat,STree)] -> [[STree]]
args cs cts = combinations [constr [t | (k,t) <- cts, k == c] | c <- cs]
constr = maybe id take mn
+ genM t = case t of
+ SApp (f,ts) -> [SApp (f,ts') | ts' <- combinations (map genM ts)]
+ SMeta k -> [t | (c,t) <- gen 0 [], c == k]
+ _ -> [t]
+
type SGrammar = [SRule]
type SIdent = String
type SRule = (SFun,SType)
@@ -63,13 +91,24 @@ type SType = ([SCat],SCat)
type SCat = SIdent
type SFun = SIdent
-newtype STree = STr (SFun,[STree]) deriving (Show,Eq)
+data STree =
+ SApp (SFun,[STree])
+ | SMeta SCat
+ | SString String
+ | SInt Int
+ deriving (Show,Eq)
------------------------------------------
-- to test
-prSTree (STr (f,ts)) = f ++ concat (map pr1 ts) where
- pr1 t@(STr (_,ts)) = ' ' : (if null ts then id else prParenth) (prSTree t)
+prSTree t = case t of
+ SApp (f,ts) -> f ++ concat (map pr1 ts)
+ SMeta c -> '?':c
+ SString s -> prQuotedString s
+ SInt i -> show i
+ where
+ pr1 t@(SApp (_,ts)) = ' ' : (if null ts then id else prParenth) (prSTree t)
+ pr1 t = prSTree t
pSRule :: String -> SRule
pSRule s = case words s of
diff --git a/src/HelpFile b/src/HelpFile
index 513c6add0..fa49f89ef 100644
--- a/src/HelpFile
+++ b/src/HelpFile
@@ -162,9 +162,11 @@ gr, generate_random: gr Tree?
-number generate this number of trees (not impl. with Tree argument)
-depth use this number of search steps at most
-gt, generate_trees: gt
+gt, generate_trees: gt Tree?
Generates all trees up to a given depth. If the depth is large,
- a small -alts is recommended
+ a small -alts is recommended. If a Tree argument is given, the
+ command completes the Tree with values to the metavariables in
+ the tree.
flags:
-depth generate to this depth (default 3)
-alts take this number of alternatives at each branch (default unlimited)
diff --git a/src/HelpFile.hs b/src/HelpFile.hs
index 085f244f5..b6a2eadf2 100644
--- a/src/HelpFile.hs
+++ b/src/HelpFile.hs
@@ -175,9 +175,11 @@ txtHelpFile =
"\n -number generate this number of trees (not impl. with Tree argument)" ++
"\n -depth use this number of search steps at most" ++
"\n" ++
- "\ngt, generate_trees: gt" ++
+ "\ngt, generate_trees: gt Tree?" ++
"\n Generates all trees up to a given depth. If the depth is large," ++
- "\n a small -alts is recommended" ++
+ "\n a small -alts is recommended. If a Tree argument is given, the" ++
+ "\n command completes the Tree with values to the metavariables in" ++
+ "\n the tree." ++
"\n flags:" ++
"\n -depth generate to this depth (default 3)" ++
"\n -alts take this number of alternatives at each branch (default unlimited)" ++
diff --git a/src/JavaGUI/GFEditor2.java b/src/JavaGUI/GFEditor2.java
index adbeebf12..2751c1c18 100644
--- a/src/JavaGUI/GFEditor2.java
+++ b/src/JavaGUI/GFEditor2.java
@@ -66,7 +66,7 @@ public class GFEditor2 extends JFrame implements ActionListener, CaretListener,
"erase", "take100", "text", "code", "latexfile",
"structured", "unstructured" };
private String [] modifyMenu = {"Modify", "identity","transfer",
- "compute", "paraphrase", "typecheck", "solve", "context" };
+ "compute", "paraphrase", "generate","typecheck", "solve", "context" };
// private String [] modeMenu = {"Menus", "printname",
// "plain", "short", "long", "typed", "untyped" };
private static String [] newMenu = {"New"};
diff --git a/src/Today.hs b/src/Today.hs
index 85bc90114..34e882dcb 100644
--- a/src/Today.hs
+++ b/src/Today.hs
@@ -1 +1 @@
-module Today where today = "Fri Apr 30 21:40:30 CEST 2004"
+module Today where today = "Sun May 2 11:14:33 CEST 2004"
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 07:42:40 +0000