summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authoraarne <unknown>2005-03-02 08:43:52 +0000
committeraarne <unknown>2005-03-02 08:43:52 +0000
commitd1a21f95620423997279f4fc7f981d919e33e40b (patch)
treea9dba4adc986091c3af2b3c38859314ae02ca406 /src
parent0bd427b5a83a97adca52c37219c7bfb8f8ca7e87 (diff)
bug fixes in generate and type check
Diffstat (limited to 'src')
-rw-r--r--src/GF/UseGrammar/Custom.hs10
-rw-r--r--src/GF/UseGrammar/Editing.hs14
-rw-r--r--src/GF/UseGrammar/Generate.hs8
3 files changed, 20 insertions, 12 deletions
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index 4b12dba1a..8e2b79c07 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -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)
diff --git a/src/GF/UseGrammar/Editing.hs b/src/GF/UseGrammar/Editing.hs
index 3e6ed0018..b9ccb6691 100644
--- a/src/GF/UseGrammar/Editing.hs
+++ b/src/GF/UseGrammar/Editing.hs
@@ -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
diff --git a/src/GF/UseGrammar/Generate.hs b/src/GF/UseGrammar/Generate.hs
index 7242bb595..a978dd7a4 100644
--- a/src/GF/UseGrammar/Generate.hs
+++ b/src/GF/UseGrammar/Generate.hs
@@ -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