forked from GitHub/gf-core
Improvements in hte editor.
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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,[])
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user