From c9d10ab5ed8b82ba0f74a25ca30103ccf0985e6d Mon Sep 17 00:00:00 2001 From: aarne Date: Fri, 30 Apr 2004 11:28:35 +0000 Subject: [PATCH] random gen to fill given term --- src/GF/CF/CFIdent.hs | 4 +++- src/GF/Shell.hs | 12 +++++++----- src/GF/Shell/PShell.hs | 2 +- src/GF/UseGrammar/Parsing.hs | 3 ++- src/GF/UseGrammar/Tokenize.hs | 2 +- src/HelpFile | 6 ++++-- src/HelpFile.hs | 6 ++++-- src/Today.hs | 2 +- 8 files changed, 23 insertions(+), 14 deletions(-) diff --git a/src/GF/CF/CFIdent.hs b/src/GF/CF/CFIdent.hs index 95d532e2d..28903e5d7 100644 --- a/src/GF/CF/CFIdent.hs +++ b/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] diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index 9e922171f..2fdf6dabd 100644 --- a/src/GF/Shell.hs +++ b/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 - ASTrm _ -> do - case s2t a of - ATrms [trm] -> do + CGenerateRandom n -> do + let + a' = case a of + 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 diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs index 06554287b..9a1185032 100644 --- a/src/GF/Shell/PShell.hs +++ b/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 diff --git a/src/GF/UseGrammar/Parsing.hs b/src/GF/UseGrammar/Parsing.hs index 48b6ffac6..5d601bc58 100644 --- a/src/GF/UseGrammar/Parsing.hs +++ b/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, diff --git a/src/GF/UseGrammar/Tokenize.hs b/src/GF/UseGrammar/Tokenize.hs index b264075ba..22d70a9b1 100644 --- a/src/GF/UseGrammar/Tokenize.hs +++ b/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 diff --git a/src/HelpFile b/src/HelpFile index 0f7db045b..f1e4eb1fb 100644 --- a/src/HelpFile +++ b/src/HelpFile @@ -152,8 +152,10 @@ t, translate: t Lang Lang String -lexer -parser -gr, generate_random: gr - Generates a random Tree. +gr, generate_random: gr 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 diff --git a/src/HelpFile.hs b/src/HelpFile.hs index 099fee6b9..a8abb739f 100644 --- a/src/HelpFile.hs +++ b/src/HelpFile.hs @@ -165,8 +165,10 @@ txtHelpFile = "\n -lexer" ++ "\n -parser" ++ "\n" ++ - "\ngr, generate_random: gr" ++ - "\n Generates a random Tree." ++ + "\ngr, generate_random: gr 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" ++ diff --git a/src/Today.hs b/src/Today.hs index d51fee573..e642f3d0e 100644 --- a/src/Today.hs +++ b/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"