gt Term

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

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 

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

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)

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

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

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

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)

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)" ++

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"};

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"