GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-02 07:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

gt -atoms

Browse Source
This commit is contained in:
aarne
2005-10-12 11:38:29 +00:00
parent ea1dcfd70a
commit 7b941a4ffa
8 changed files with 45 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/10/05 20:02:20 $
-- > CVS $Date: 2005/10/12 12:38:30 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.77 $
-- > CVS $Revision: 1.78 $
--
-- A database for customizable GF shell commands.
--
@@ -344,7 +344,7 @@ customTermCommand =
,(strCI "generate", \g t -> let gr = grammar g
cat = actCat $ tree2loc t --- not needed
in
[tr | t <- generateTrees gr False cat 2 Nothing (Just t),
[tr | t <- generateTrees noOptions gr cat 2 Nothing (Just t),
Ok tr <- [annotate gr $ MM.qualifTerm (absId g) t]])
,(strCI "typecheck", \g t -> err (const []) (return . loc2tree)
(reCheckStateReject (grammar g) (tree2loc t)))

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

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/30 18:39:44 $
-- > CVS $Date: 2005/10/12 12:38:30 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.15 $
-- > CVS $Revision: 1.16 $
--
-- Generate all trees of given category and depth. AR 30\/4\/2004
--
@@ -28,6 +28,7 @@ import GF.Grammar.Grammar (Cat)
import GF.Data.Operations
import GF.Data.Zipper
import GF.Infra.Option
import Data.List
@@ -39,18 +40,20 @@ import Data.List
-- | the main function takes an abstract syntax and returns a list of trees
generateTrees :: GFCGrammar -> Bool -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp]
generateTrees gr ifm cat n mn mt = map str2tr $ generate gr' ifm cat' n mn mt'
generateTrees :: Options -> GFCGrammar -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp]
generateTrees opts gr cat n mn mt = map str2tr $ generate gr' ifm cat' n mn mt'
where
gr' = gr2sgr gr
gr' = gr2sgr ats gr
cat' = prt $ snd cat
mt' = maybe Nothing (return . tr2str) mt
mt' = maybe Nothing (return . tr2str) mt
ifm = oElem withMetas opts
ats = getOptInt opts (aOpt "atoms")
------------------------------------------
-- translate grammar to simpler form and generated trees back
gr2sgr :: GFCGrammar -> SGrammar
gr2sgr gr = buildTree [(c,rs) | rs@((_,(_,c)):_) <- rules] where
gr2sgr :: Maybe Int -> GFCGrammar -> SGrammar
gr2sgr un gr = buildTree [(c,rs) | rs@((_,(_,c)):_) <- prune rules] where
rules =
groupBy (\x y -> scat x == scat y) $
sortBy (\x y -> compare (scat x) (scat y))
@@ -62,6 +65,12 @@ gr2sgr gr = buildTree [(c,rs) | rs@((_,(_,c)):_) <- rules] where
trCat (m,c) = prt c ---
scat (_,(_,c)) = c
prune rs = maybe rs (\n -> map (onlyAtoms n) rs) $ un
onlyAtoms n rs =
let (rs1,rs2) = partition atom rs
in take n rs1 ++ rs2
atom = null . fst . snd
-- str2tr :: STree -> Exp
str2tr t = case t of
SApp (f,ts) -> mkApp (trId f) (map str2tr ts)