mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
bug fixes in generate and type check
This commit is contained in:
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/02/24 11:46:38 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.42 $
|
||||
-- > CVS $Date: 2005/03/02 09:43:52 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > CVS $Revision: 1.43 $
|
||||
--
|
||||
-- A database for customizable GF shell commands.
|
||||
--
|
||||
@@ -302,8 +302,8 @@ customTermCommand =
|
||||
in
|
||||
[tr | t <- generateTrees gr False cat 2 Nothing (Just t),
|
||||
Ok tr <- [annotate gr $ MM.qualifTerm (absId g) t]])
|
||||
,(strCI "typecheck", \g t -> err (const [t]) (return . loc2tree)
|
||||
(reCheckState (grammar g) (tree2loc t)))
|
||||
,(strCI "typecheck", \g t -> err (const []) (return . loc2tree)
|
||||
(reCheckStateReject (grammar g) (tree2loc t)))
|
||||
,(strCI "solve", \g t -> err (const [t]) (return . loc2tree)
|
||||
(solveAll (grammar g) (tree2loc t)))
|
||||
,(strCI "context", \g t -> err (const [t]) (return . loc2tree)
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/02/24 11:46:38 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.11 $
|
||||
-- > CVS $Date: 2005/03/02 09:43:52 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > CVS $Revision: 1.12 $
|
||||
--
|
||||
-- generic tree editing, with some grammar notions assumed. AR 18\/8\/2001.
|
||||
-- 19\/6\/2003 for GFC
|
||||
@@ -358,6 +358,14 @@ peelFunHead gr (f@(m,c),i) state = do
|
||||
reCheckState :: CGrammar -> State -> Err State
|
||||
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
|
||||
solveAll :: CGrammar -> State -> Err State
|
||||
solveAll gr st = solve st >>= solve where
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/02/24 11:46:38 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.8 $
|
||||
-- > CVS $Date: 2005/03/02 09:43:52 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > CVS $Revision: 1.9 $
|
||||
--
|
||||
-- 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
|
||||
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
|
||||
gr' = gr2sgr gr
|
||||
cat' = prt $ snd cat
|
||||
|
||||
Reference in New Issue
Block a user