gt Term

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