msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

fixed shell solve command

Browse Source
This commit is contained in:
aarne
2005-03-02 13:25:45 +00:00
parent 7b08eb7ffd
commit 48deedea14
2 changed files with 13 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/02 09:43:52 $
-- > CVS $Date: 2005/03/02 14:25:45 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.43 $
-- > CVS $Revision: 1.44 $
--
-- A database for customizable GF shell commands.
--
@@ -304,8 +304,9 @@ customTermCommand =
Ok tr <- [annotate gr $ MM.qualifTerm (absId g) 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 "solve", \g t -> err (const []) (return . loc2tree)
(solveAll (grammar g) (tree2loc t)
>>= rejectUnsolvable))
,(strCI "context", \g t -> err (const [t]) (return . loc2tree)
(contextRefinements (grammar g) (tree2loc t)))
,(strCI "reindex", \g t -> let gr = grammar g in

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

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/02 09:43:52 $
-- > CVS $Date: 2005/03/02 14:25:45 $
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.12 $
-- > CVS $Revision: 1.13 $
--
-- generic tree editing, with some grammar notions assumed. AR 18\/8\/2001.
-- 19\/6\/2003 for GFC
@@ -362,9 +362,12 @@ reCheckState gr st = annotate gr (tree2exp (loc2tree st)) >>= return . tree2loc
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
rejectUnsolvable st'
rejectUnsolvable :: State -> Err State
rejectUnsolvable 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