diff options
Diffstat (limited to 'src/GF/UseGrammar')
| -rw-r--r-- | src/GF/UseGrammar/Custom.hs | 8 | ||||
| -rw-r--r-- | src/GF/UseGrammar/Editing.hs | 18 |
2 files changed, 13 insertions, 13 deletions
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index dfffd2b2a..f28bfc6e1 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -264,12 +264,10 @@ 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 -> let gr = grammar g in - err (const []) (return . const t) - (checkIfValidExp gr (tree2exp t))) + ,(strCI "typecheck", \g t -> err (const [t]) (return . loc2tree) + (reCheckState (grammar g) (tree2loc t))) ,(strCI "solve", \g t -> err (const [t]) (return . loc2tree) - (uniqueRefinements (grammar g) (tree2loc t))) + (solveAll (grammar g) (tree2loc t))) ,(strCI "context", \g t -> err (const [t]) (return . loc2tree) (contextRefinements (grammar g) (tree2loc t))) ,(strCI "reindex", \g t -> let gr = grammar g in diff --git a/src/GF/UseGrammar/Editing.hs b/src/GF/UseGrammar/Editing.hs index 45e180b0d..12113b91f 100644 --- a/src/GF/UseGrammar/Editing.hs +++ b/src/GF/UseGrammar/Editing.hs @@ -187,10 +187,11 @@ refineWithTreeReal :: Bool -> CGrammar -> Tree -> Meta -> Action refineWithTreeReal der gr tree m state = do state' <- replaceSubTree tree state let cs0 = allConstrs state' - (cs,ms) = splitConstraints cs0 + (cs,ms) = splitConstraints gr cs0 v = vClos $ tree2exp (bodyTree tree) msubst = (m,v) : ms - metaSubstRefinements gr msubst $ mapLoc (performMetaSubstNode msubst) state' + metaSubstRefinements gr msubst $ + mapLoc (reduceConstraintsNode gr . performMetaSubstNode msubst) state' -- without dep. types, no constraints, no grammar needed - simply: do -- testErr (actIsMeta state) "move pointer to meta" @@ -339,12 +340,13 @@ reCheckState gr st = annotate gr (tree2exp (loc2tree st)) >>= return . tree2loc -- extract metasubstitutions from constraints and solve them solveAll :: CGrammar -> State -> Err State -solveAll gr st0 = do - st <- reCheckState gr st0 - let cs0 = allConstrs st - (cs,ms) = splitConstraints cs0 - metaSubstRefinements gr ms $ mapLoc (performMetaSubstNode ms) st - +solveAll gr st = solve st >>= solve where + solve st0 = do ---- why need twice? + st <- reCheckState gr st0 + let cs0 = allConstrs st + (cs,ms) = splitConstraints gr cs0 + metaSubstRefinements gr ms $ + mapLoc (reduceConstraintsNode gr . performMetaSubstNode ms) st -- active refinements |