forked from GitHub/gf-core
Fixed several things, e.g. tokenizer.
This commit is contained in:
@@ -51,7 +51,7 @@ getCommandUTF = do
|
||||
|
||||
pCommand = pCommandWords . words where
|
||||
pCommandWords s = case s of
|
||||
"n" : cat : _ -> CNewCat (strings2Cat cat)
|
||||
"n" : cat : _ -> CNewCat cat
|
||||
"t" : ws -> CNewTree $ unwords ws
|
||||
"g" : ws -> CRefineWithTree $ unwords ws -- *g*ive
|
||||
"p" : ws -> CRefineParse $ unwords ws
|
||||
|
||||
@@ -6,9 +6,10 @@ import Zipper
|
||||
import qualified Grammar as G ---- Cat, Fun, Q, QC
|
||||
import GFC
|
||||
import CMacros
|
||||
import Macros (qq)----
|
||||
import LookAbs
|
||||
import Look
|
||||
import Values (loc2treeFocus)----
|
||||
import Values (loc2treeFocus,tree2exp)----
|
||||
|
||||
import GetTree
|
||||
import API
|
||||
@@ -46,7 +47,7 @@ import List (intersperse)
|
||||
-- See CommandsL for a parser of a command language.
|
||||
|
||||
data Command =
|
||||
CNewCat G.Cat
|
||||
CNewCat String
|
||||
| CNewTree String
|
||||
| CAhead Int
|
||||
| CBack Int
|
||||
@@ -201,7 +202,8 @@ execCommand env c s = case c of
|
||||
execECommand :: CEnv -> Command -> ECommand
|
||||
execECommand env c = case c of
|
||||
CNewCat cat -> action2commandNext $ \x -> do
|
||||
s' <- newCat cgr cat x
|
||||
cat' <- string2cat sgr cat
|
||||
s' <- newCat cgr cat' x
|
||||
uniqueRefinements cgr s'
|
||||
CNewTree s -> action2commandNext $ \x -> do
|
||||
t <- string2treeErr gr s
|
||||
@@ -271,6 +273,7 @@ execECommand env c = case c of
|
||||
gr = grammarCEnv env
|
||||
der = maybe True not $ caseYesNo (globalOptions env) noDepTypes
|
||||
-- if there are dep types, then derived refs; deptypes is the default
|
||||
abs = absId sgr
|
||||
|
||||
--
|
||||
|
||||
@@ -285,7 +288,7 @@ string2varPair s = case words s of
|
||||
cMenuDisplay :: String -> Command
|
||||
cMenuDisplay s = CAddOption (menuDisplay s)
|
||||
|
||||
newCatMenu env = [(CNewCat c, printname env initSState c) |
|
||||
newCatMenu env = [(CNewCat (prQIdent c), printname env initSState c) |
|
||||
(c,[]) <- allCatsOf (canCEnv env)]
|
||||
|
||||
mkRefineMenu :: CEnv -> SState -> [(Command,String)]
|
||||
@@ -302,8 +305,7 @@ mkRefineMenuAll env sstate =
|
||||
[(CAddClip, (ifShort "ac" "AddClip", "ac"))]
|
||||
(refs,[],_) ->
|
||||
[(CRefineWithAtom (prRefinement f), prRef t) | t@(f,_) <- refs] ++
|
||||
[(CRefineWithClip i, prClip i t e) | (i,t) <- possClipsSState gr sstate,
|
||||
let e = tree2string t]
|
||||
[(CRefineWithClip i, prClip i t) | (i,t) <- possClipsSState gr sstate]
|
||||
(_,cands,_) ->
|
||||
[(CSelectCand i, prCand (t,i)) | (t,i) <- zip cands [0..]]
|
||||
|
||||
@@ -311,8 +313,8 @@ mkRefineMenuAll env sstate =
|
||||
prRef (f,t) =
|
||||
(ifShort "r" "Refine" +++ prOrLinRef f +++ ifTyped (":" +++ prt t),
|
||||
"r" +++ prRefinement f)
|
||||
prClip i t e =
|
||||
(ifShort "rc" "Paste" +++ prOrLinTree t e,
|
||||
prClip i t =
|
||||
(ifShort "rc" "Paste" +++ prOrLinTree t,
|
||||
"rc" +++ show i)
|
||||
prChangeHead f =
|
||||
(ifShort "ch" "ChangeHead" +++ prOrLinFun f,
|
||||
@@ -339,10 +341,10 @@ mkRefineMenuAll env sstate =
|
||||
G.QC m f -> printname env sstate (m,f)
|
||||
_ -> prt t
|
||||
prOrLinFun = printname env sstate
|
||||
prOrLinTree t e = case getOptVal opts menuDisplay of
|
||||
Just "Abs" -> e
|
||||
prOrLinTree t = case getOptVal opts menuDisplay of
|
||||
Just "Abs" -> prTermOpt opts $ tree2exp t
|
||||
Just lang -> prQuotedString $ lin lang t
|
||||
_ -> e
|
||||
_ -> prTermOpt opts $ tree2exp t
|
||||
lin lang t = optLinearizeTreeVal opts (stateGrammarOfLang env (language lang)) t
|
||||
|
||||
-- there are three orthogonal parameters: Abs/[conc], short/long, typed/untyped
|
||||
@@ -364,6 +366,8 @@ displayCommandMenu :: CEnv -> [(Command,String)]
|
||||
displayCommandMenu env =
|
||||
[(CAddOption (menuDisplay s), s) | s <- "Abs" : langs] ++
|
||||
[(CAddOption (sizeDisplay s), s) | s <- ["short", "long"]] ++
|
||||
[(fo nostripQualif, s) | (fo,s) <- [(CAddOption,"qualified"),
|
||||
(CRemoveOption,"unqualified")]] ++
|
||||
[(CAddOption (typeDisplay s), s) | s <- ["typed", "untyped"]]
|
||||
where
|
||||
langs = map prLanguage $ allLanguages env
|
||||
@@ -456,7 +460,7 @@ printname :: CEnv -> SState -> G.Fun -> String
|
||||
printname env state f = case getOptVal opts menuDisplay of
|
||||
Just "Abs" -> prQIdent f
|
||||
Just lang -> printn lang f
|
||||
_ -> prQIdent f
|
||||
_ -> prTermOpt opts (qq f)
|
||||
where
|
||||
opts = addOptions (optsSState state) (globalOptions env)
|
||||
printn lang f = err id (ifNull (prQIdent f) (sstr . head)) $ do
|
||||
|
||||
Reference in New Issue
Block a user