random gen to fill given term

src/GF/CF/CFIdent.hs

@@ -43,7 +43,7 @@ prCFTok t = case t of
   TL s -> s
   TI i -> show i
   TV x -> prt x
-  TM i _ -> "?" ---
+  TM i m -> m --- "?" --- m
 
 -- to build trees: the Atom contains a GF function, Cn | Meta | Vr | Literal
 newtype CFFun = CFFun (Atom, Profile) deriving (Eq,Show)
@@ -157,6 +157,8 @@ str2cftoks = map tS . words . sstr
 compatToks :: [CFTok] -> [CFTok] -> Bool
 compatToks ts us = and [compatTok t u | (t,u) <- zip ts us]
 
+compatTok (TM _ _) _ = True --- hack because metas are renamed
+compatTok _ (TM _ _) = True
 compatTok t u = any (`elem` (alts t)) (alts u) where
   alts u = case u of
     TC (c:s) -> [toLower c : s, toUpper c : s]

src/GF/Shell.hs

@@ -173,15 +173,17 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
   CTranslate il ol -> do
     let a' = opST2CommandArg (optParseArgErr opts (sgr il)) a
     returnArg (opTS2CommandArg (optLinearizeTreeVal opts (sgr ol)) a') sa
-  CGenerateRandom n -> case a of
+  CGenerateRandom n -> do
-      ASTrm _ -> do
+    let 
-        case s2t a of
+      a' = case a of
-          ATrms [trm] -> do 
+        ASTrm _ -> s2t a
+        _ -> a
+    case a' of
+      ATrms (trm:_) -> do
             g    <- newStdGen
             case (goFirstMeta (tree2loc trm) >>= refineRandom g 41 cgr) of
               Ok trm' -> returnArg (ATrms [loc2tree trm']) sa
               Bad s   -> returnArg (AError s) sa
-          _ -> returnArg a sa
       _ -> do
         ts <- randomTreesIO opts gro (optIntOrN opts flagNumber n)
         returnArg (ATrms ts) sa

src/GF/Shell/PShell.hs

@@ -71,7 +71,7 @@ pCommand ws = case ws of
   "p"  : s      -> aString CParse s
   "t"  : i:o: s -> aString (CTranslate (language i) (language o)) s
   "gr" : []     -> aUnit   (CGenerateRandom 1)
-  "gr" : t      -> aTerm   (CGenerateRandom 1) t
+  "gt" : t      -> aTerm   (CGenerateRandom 1) t
 ---  "gr" : n : [] -> aUnit   (CGenerateRandom (readIntArg n)) -- deprecated 12/5/2001
   "pt" : s      -> aTerm   CPutTerm s
 -----  "wt" : f : s  -> aTerm   (CWrapTerm (string2id f)) s

src/GF/UseGrammar/Parsing.hs

@@ -5,6 +5,7 @@ import qualified AbsGFC as C
 import GFC
 import MkGFC (trExp) ----
 import CMacros
+import MMacros (refreshMetas)
 import Linear
 import Str
 import CF
@@ -68,7 +69,7 @@ tokens2trms opts sg cn parser as = do
     _ -> do
       (ts1,ss) <- checkErr $ mapErr postParse ts0
       if null ts1 then raise ss else return ()
-      ts2 <- mapM (checkErr . (annotate gr) . trExp) ts1 ---- 
+      ts2 <- mapM (checkErr . annotate gr . refreshMetas [] . trExp) ts1 ---- 
       if forgive then return ts2 else do
         let tsss = [(t, allLinsOfTree gr cn t) | t <- ts2]
             ps = [t | (t,ss) <- tsss, 

src/GF/UseGrammar/Tokenize.hs

@@ -29,7 +29,7 @@ mkCFTok s = case s of
 
 mkCFTokVar :: String -> CFTok
 mkCFTokVar s = case s of
-  '?':_:_      -> tM s
+  '?':_:_      -> tM s --- "?" --- compat with prCF
   'x':'_':_    -> tV s
   'x':[]       -> tV s
   '$':xs@(_:_) -> if last s == '$' then tV (init xs) else tS s

src/HelpFile

@@ -152,8 +152,10 @@ t,  translate: t Lang Lang String
       -lexer
       -parser
 
-gr, generate_random: gr
+gr, generate_random: gr Tree?
-      Generates a random Tree.
+      Generates a random Tree of a given category. If a Tree
+      argument is given, the command completes the Tree with values to
+      the metavariables in the tree. 
   flags:
       -cat     generate in this category
       -lang    use the abstract syntax of this grammar

src/HelpFile.hs

@@ -165,8 +165,10 @@ txtHelpFile =
   "\n      -lexer" ++
   "\n      -parser" ++
   "\n" ++
-  "\ngr, generate_random: gr" ++
+  "\ngr, generate_random: gr Tree?" ++
-  "\n      Generates a random Tree." ++
+  "\n      Generates a random Tree of a given category. If a Tree" ++
+  "\n      argument is given, the command completes the Tree with values to" ++
+  "\n      the metavariables in the tree. " ++
   "\n  flags:" ++
   "\n      -cat     generate in this category" ++
   "\n      -lang    use the abstract syntax of this grammar" ++

src/Today.hs

@@ -1 +1 @@
-module Today where today = "Fre Apr 30 11:08:20 CEST 2004"
+module Today where today = "Fri Apr 30 14:27:30 CEST 2004"