mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 11:42:49 -06:00
added and editor function allMetas showing all meta positions and their types
This commit is contained in:
@@ -10,10 +10,12 @@ module PGF.Editor (
|
|||||||
goNext, -- :: State -> State -- move to next node
|
goNext, -- :: State -> State -- move to next node
|
||||||
goTop, -- :: State -> State -- move focus to the top (=root)
|
goTop, -- :: State -> State -- move focus to the top (=root)
|
||||||
goPosition, -- :: Position -> State -> State -- move focus to given position
|
goPosition, -- :: Position -> State -> State -- move focus to given position
|
||||||
mkPosition, -- :: [Int] -> Position -- list of choices (top = [])
|
mkPosition, -- :: [Int] -> Position -- list of choices (top = [])
|
||||||
|
showPosition,-- :: Position -> [Int] -- readable position
|
||||||
focusType, -- :: State -> Type -- get the type of focus
|
focusType, -- :: State -> Type -- get the type of focus
|
||||||
stateTree, -- :: State -> Tree -- get the current tree
|
stateTree, -- :: State -> Tree -- get the current tree
|
||||||
isMetaFocus, -- :: State -> Bool -- whether focus is ?
|
isMetaFocus, -- :: State -> Bool -- whether focus is ?
|
||||||
|
allMetas, -- :: State -> [(Position,Type)] -- all ?s and their positions
|
||||||
prState, -- :: State -> String -- print state, focus marked *
|
prState, -- :: State -> String -- print state, focus marked *
|
||||||
refineMenu, -- :: Dict -> State -> [CId] -- get refinement menu
|
refineMenu, -- :: Dict -> State -> [CId] -- get refinement menu
|
||||||
pgf2dict -- :: PGF -> Dict -- create editing Dict from PGF
|
pgf2dict -- :: PGF -> Dict -- create editing Dict from PGF
|
||||||
@@ -63,7 +65,7 @@ refineMenu :: Dict -> State -> [CId]
|
|||||||
refineMenu dict s = maybe [] (map fst) $ M.lookup (focusBType s) (refines dict)
|
refineMenu dict s = maybe [] (map fst) $ M.lookup (focusBType s) (refines dict)
|
||||||
|
|
||||||
focusType :: State -> Type
|
focusType :: State -> Type
|
||||||
focusType s = DTyp [] (focusBType s) []
|
focusType s = btype2type (focusBType s)
|
||||||
|
|
||||||
stateTree :: State -> Tree
|
stateTree :: State -> Tree
|
||||||
stateTree = etree2tree . tree
|
stateTree = etree2tree . tree
|
||||||
@@ -104,8 +106,14 @@ prState s = unlines [replicate i ' ' ++ f | (i,f) <- pr [] (tree s)] where
|
|||||||
ind i = 2 * length i
|
ind i = 2 * length i
|
||||||
sub j i = i ++ [j]
|
sub j i = i ++ [j]
|
||||||
|
|
||||||
---- TODO
|
showPosition :: Position -> [Int]
|
||||||
-- getPosition :: Language -> Int -> ETree -> Position
|
showPosition = id
|
||||||
|
|
||||||
|
allMetas :: State -> [(Position,Type)]
|
||||||
|
allMetas s = [(reverse p, btype2type ty) | (p,ty) <- metas [] (tree s)] where
|
||||||
|
metas p t =
|
||||||
|
(if isMetaAtom (atom t) then [(p,typ t)] else []) ++
|
||||||
|
concat [metas (i:p) u | (i,u) <- zip [0..] (children t)]
|
||||||
|
|
||||||
---- Trees and navigation
|
---- Trees and navigation
|
||||||
|
|
||||||
@@ -121,6 +129,9 @@ data Atom =
|
|||||||
| AMeta Int
|
| AMeta Int
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
|
btype2type :: BType -> Type
|
||||||
|
btype2type t = DTyp [] t []
|
||||||
|
|
||||||
uETree :: BType -> ETree
|
uETree :: BType -> ETree
|
||||||
uETree ty = ETree (AMeta 0) ty []
|
uETree ty = ETree (AMeta 0) ty []
|
||||||
|
|
||||||
@@ -194,7 +205,7 @@ goNext s = case focus s of
|
|||||||
st | not (null (children st)) -> navigate down s
|
st | not (null (children st)) -> navigate down s
|
||||||
_ -> findSister s
|
_ -> findSister s
|
||||||
where
|
where
|
||||||
findSister s = trace (show (position s)) $ case s of
|
findSister s = case s of
|
||||||
s' | null (position s') -> s'
|
s' | null (position s') -> s'
|
||||||
s' | hasYoungerSisters s' -> navigate right s'
|
s' | hasYoungerSisters s' -> navigate right s'
|
||||||
s' -> findSister (navigate up s')
|
s' -> findSister (navigate up s')
|
||||||
@@ -203,7 +214,10 @@ goNext s = case focus s of
|
|||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
isMetaFocus :: State -> Bool
|
isMetaFocus :: State -> Bool
|
||||||
isMetaFocus s = case atom (focus s) of
|
isMetaFocus s = isMetaAtom (atom (focus s))
|
||||||
|
|
||||||
|
isMetaAtom :: Atom -> Bool
|
||||||
|
isMetaAtom a = case a of
|
||||||
AMeta _ -> True
|
AMeta _ -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
|
|||||||
@@ -66,6 +66,9 @@ interpret pgf dict st c = case words c of
|
|||||||
let st' = goNext st
|
let st' = goNext st
|
||||||
prLState pgf st'
|
prLState pgf st'
|
||||||
return st'
|
return st'
|
||||||
|
"x":_ -> do
|
||||||
|
mapM_ putStrLn [show (showPosition p) ++ showType t | (p,t) <- allMetas st]
|
||||||
|
return st
|
||||||
"h":_ -> putStrLn commandHelp >> return st
|
"h":_ -> putStrLn commandHelp >> return st
|
||||||
_ -> do
|
_ -> do
|
||||||
putStrLn "command not understood"
|
putStrLn "command not understood"
|
||||||
@@ -96,7 +99,8 @@ commandHelp = unlines [
|
|||||||
"h -- display this help message",
|
"h -- display this help message",
|
||||||
"m -- show refinement menu",
|
"m -- show refinement menu",
|
||||||
"p Anything -- parse Anything and refine with it",
|
"p Anything -- parse Anything and refine with it",
|
||||||
"r Function -- refine with Function",
|
"r Function -- refine with Function",
|
||||||
|
"x -- show all unknown positions and their types",
|
||||||
"4 -- refine with 4th item from menu (see m)",
|
"4 -- refine with 4th item from menu (see m)",
|
||||||
"[1,2,3] -- go to position 1,2,3",
|
"[1,2,3] -- go to position 1,2,3",
|
||||||
"> -- go to next node"
|
"> -- go to next node"
|
||||||
|
|||||||
Reference in New Issue
Block a user