Improvements in hte editor.

4 files changed, 21 insertions, 1 deletions

diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs
index 5e0994d46..66d6e4ca3 100644
--- a/src/GF/Grammar/LookAbs.hs
+++ b/src/GF/Grammar/LookAbs.hs
@@ -97,7 +97,6 @@ funsOnTypeFs compat fs val = [((fun,i),typ) |
                                         (i,arg) <- zip [0..] (map snd args),
                                         compat val arg]
 
-
 -- this is needed at compile time
 
 lookupFunTypeSrc :: Grammar -> Ident -> Ident -> Err Type
diff --git a/src/GF/Grammar/MMacros.hs b/src/GF/Grammar/MMacros.hs
index 4078221dc..cea8af11a 100644
--- a/src/GF/Grammar/MMacros.hs
+++ b/src/GF/Grammar/MMacros.hs
@@ -231,6 +231,13 @@ fun2wrap oldvars ((fun,i),typ) exp = do
     let vars = mkFreshVars (length cont) oldvars
     return $ mkAbs vars $ if n==i then exp else mExp
 
+-- weak heuristics: sameness of value category
+compatType :: Val -> Type -> Bool
+compatType v t = errVal True $ do
+  cat1 <- val2cat v
+  cat2 <- valCat t
+  return $ cat1 == cat2
+
 ---
 
 mkJustProd cont typ = mkProd (cont,typ,[])
diff --git a/src/GF/Grammar/TypeCheck.hs b/src/GF/Grammar/TypeCheck.hs
index c97bdd362..a3487fdf7 100644
--- a/src/GF/Grammar/TypeCheck.hs
+++ b/src/GF/Grammar/TypeCheck.hs
@@ -229,3 +229,9 @@ editAsTermCommand gr c e = err (const []) singleton $ do
   t  <- annotate gr $ refreshMetas [] e
   t' <- c $ tree2loc t
   return $ tree2exp $ loc2tree t'
+
+exp2termCommand :: GFCGrammar -> (Exp -> Err Exp) -> Tree -> Err Tree
+exp2termCommand gr f t = do
+  let exp = tree2exp t
+  exp2 <- f exp
+  annotate gr exp2
diff --git a/src/GF/Grammar/Values.hs b/src/GF/Grammar/Values.hs
index 7b02d187a..9df2fc13e 100644
--- a/src/GF/Grammar/Values.hs
+++ b/src/GF/Grammar/Values.hs
@@ -50,3 +50,11 @@ tree2exp (Tr (N (bi,at,_,_,_),ts)) = foldr Abs (foldl App at' ts') bi' where
     AtI s -> EInt s
   bi' = map fst bi
   ts' = map tree2exp ts
+
+loc2treeFocus :: Loc TrNode -> Tree
+loc2treeFocus (Loc (Tr (a,ts),p)) = 
+  loc2tree (Loc (Tr (mark a, map (mapTr nomark) ts), mapPath nomark p)) 
+ where 
+   (mark, nomark) = (\(N (a,b,c,d,_)) -> N(a,b,c,d,True), 
+                     \(N (a,b,c,d,_)) -> N(a,b,c,d,False))
+