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

bug fixes in generate and type check

Browse Source
This commit is contained in:
aarne
2005-03-02 08:43:52 +00:00
parent 58dd4628ba
commit 7c42133159
3 changed files with 20 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/02/24 11:46:38 $ -- > CVS $Date: 2005/03/02 09:43:52 $
-- > CVS $Author: peb $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.42 $ -- > CVS $Revision: 1.43 $
-- --
-- A database for customizable GF shell commands. -- A database for customizable GF shell commands.
-- --
@@ -302,8 +302,8 @@ customTermCommand =
in in
[tr | t <- generateTrees gr False cat 2 Nothing (Just t), [tr | t <- generateTrees gr False cat 2 Nothing (Just t),
Ok tr <- [annotate gr $ MM.qualifTerm (absId g) t]]) Ok tr <- [annotate gr $ MM.qualifTerm (absId g) t]])
,(strCI "typecheck", \g t -> err (const [t]) (return . loc2tree) ,(strCI "typecheck", \g t -> err (const []) (return . loc2tree)
(reCheckState (grammar g) (tree2loc t))) (reCheckStateReject (grammar g) (tree2loc t)))
,(strCI "solve", \g t -> err (const [t]) (return . loc2tree) ,(strCI "solve", \g t -> err (const [t]) (return . loc2tree)
(solveAll (grammar g) (tree2loc t))) (solveAll (grammar g) (tree2loc t)))
,(strCI "context", \g t -> err (const [t]) (return . loc2tree) ,(strCI "context", \g t -> err (const [t]) (return . loc2tree)

14
src/GF/UseGrammar/Editing.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/02/24 11:46:38 $ -- > CVS $Date: 2005/03/02 09:43:52 $
-- > CVS $Author: peb $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.11 $ -- > CVS $Revision: 1.12 $
-- --
-- generic tree editing, with some grammar notions assumed. AR 18\/8\/2001. -- generic tree editing, with some grammar notions assumed. AR 18\/8\/2001.
-- 19\/6\/2003 for GFC -- 19\/6\/2003 for GFC
@@ -358,6 +358,14 @@ peelFunHead gr (f@(m,c),i) state = do
reCheckState :: CGrammar -> State -> Err State reCheckState :: CGrammar -> State -> Err State
reCheckState gr st = annotate gr (tree2exp (loc2tree st)) >>= return . tree2loc reCheckState gr st = annotate gr (tree2exp (loc2tree st)) >>= return . tree2loc
-- | a variant that returns Bad instead of a tree with unsolvable constraints
reCheckStateReject :: CGrammar -> State -> Err State
reCheckStateReject gr st = do
st' <- reCheckState gr st
case (constrsNode $ nodeTree $ actTree st') of
[] -> return st'
cs -> Bad $ "Unsolvable constraints:" +++ prConstraints cs
-- | extract metasubstitutions from constraints and solve them -- | extract metasubstitutions from constraints and solve them
solveAll :: CGrammar -> State -> Err State solveAll :: CGrammar -> State -> Err State
solveAll gr st = solve st >>= solve where solveAll gr st = solve st >>= solve where

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

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/02/24 11:46:38 $ -- > CVS $Date: 2005/03/02 09:43:52 $
-- > CVS $Author: peb $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.8 $ -- > CVS $Revision: 1.9 $
-- --
-- Generate all trees of given category and depth. AR 30\/4\/2004 -- Generate all trees of given category and depth. AR 30\/4\/2004
-- --
@@ -40,7 +40,7 @@ import List
-- | the main function takes an abstract syntax and returns a list of trees -- | the main function takes an abstract syntax and returns a list of trees
generateTrees :: GFCGrammar -> Bool -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp] 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 gr ifm cat n mn mt = nub $ map str2tr $ generate gr' ifm cat' n mn mt'
where where
gr' = gr2sgr gr gr' = gr2sgr gr
cat' = prt $ snd cat cat' = prt $ snd cat