From 54947d3e4c7bdcbfa3e00a8eb17c7f0b9696664a Mon Sep 17 00:00:00 2001 From: aarne Date: Sun, 2 May 2004 08:21:25 +0000 Subject: [PATCH] gt Term --- src/GF/API.hs | 6 ++-- src/GF/Grammar/TypeCheck.hs | 3 ++ src/GF/Shell.hs | 10 +++++- src/GF/Shell/Commands.hs | 2 ++ src/GF/Shell/PShell.hs | 1 + src/GF/UseGrammar/Custom.hs | 12 ++++++- src/GF/UseGrammar/Generate.hs | 63 ++++++++++++++++++++++++++++------- src/HelpFile | 6 ++-- src/HelpFile.hs | 6 ++-- src/JavaGUI/GFEditor2.java | 2 +- src/Today.hs | 2 +- 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] -generate :: SGrammar -> SCat -> Int -> Maybe Int -> [STree] -generate gr cat i mn = [t | (c,t) <- gen 0 [], c == cat] where + Just t -> genM t + + 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"