msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

gt Term

Browse Source
This commit is contained in:
aarne
2004-05-02 08:21:25 +00:00
parent 487571a685
commit 54947d3e4c
11 changed files with 90 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/GF/API.hs
View File

@@ -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

3
src/GF/Grammar/TypeCheck.hs
View File

@@ -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

10
src/GF/Shell.hs
View File

@@ -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

2
src/GF/Shell/Commands.hs
View File

@@ -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)

1
src/GF/Shell/PShell.hs
View File

@@ -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

12
src/GF/UseGrammar/Custom.hs
View File

@@ -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

63
src/GF/UseGrammar/Generate.hs
View File

@@ -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

6
src/HelpFile
View File

@@ -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)

6
src/HelpFile.hs
View File

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

2
src/JavaGUI/GFEditor2.java
View File

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

2
src/Today.hs
View File

@@ -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"