msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

gfse: experimental support for editing concrete syntax in text mode

Browse Source
This commit is contained in:
hallgren
2012-02-22 16:30:42 +00:00
parent 2312b3c9c9
commit 9ebc423004
3 changed files with 104 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
src/compiler/GF/Grammar/Printer.hs
View File

@@ -13,6 +13,7 @@ module GF.Grammar.Printer
, ppGrammar
, ppModule
, ppJudgement
, ppParams
, ppTerm
, ppPatt
, ppValue
@@ -20,6 +21,7 @@ module GF.Grammar.Printer
, ppLocation
, ppQIdent
, ppMeta
, getAbs
) where
import GF.Infra.Ident
@@ -107,7 +109,7 @@ ppJudgement q (id, AbsFun ptype _ pexp poper) =
ppJudgement q (id, ResParam pparams _) =
text "param" <+> ppIdent id <+>
(case pparams of
Just (L _ ps) -> equals <+> fsep (intersperse (char '|') (map (ppParam q) ps))
Just (L _ ps) -> equals <+> ppParams q ps
_ -> empty) <+> semi
ppJudgement q (id, ResValue pvalue) = empty
ppJudgement q (id, ResOper ptype pexp) =
@@ -304,6 +306,7 @@ ppBind (Implicit,v) = braces (ppIdent v)
ppAltern q (x,y) = ppTerm q 0 x <+> char '/' <+> ppTerm q 0 y
ppParams q ps = fsep (intersperse (char '|') (map (ppParam q) ps))
ppParam q (id,cxt) = ppIdent id <+> hsep (map (ppDDecl q) cxt)
ppLocation :: FilePath -> Location -> Doc

70
src/compiler/SimpleEditor/Convert.hs
View File

@@ -5,17 +5,19 @@ import Control.Monad(unless,foldM,ap)
import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as BS(pack)
import Text.JSON(encode,makeObj)
import Text.PrettyPrint(render)
--import GF.Compile.GetGrammar (getSourceModule)
--import GF.Infra.Option(noOptions)
import GF.Infra.Ident(showIdent)
--import GF.Infra.UseIO(appIOE)
import GF.Grammar.Grammar
import GF.Grammar.Printer(ppParams,ppTerm,getAbs,TermPrintQual(..))
import GF.Grammar.Parser(runP,pModDef)
import GF.Grammar.Lexer(Posn(..))
import GF.Data.ErrM
import SimpleEditor.Syntax
import SimpleEditor.Syntax as S
import SimpleEditor.JSON
@@ -25,7 +27,7 @@ parseModule (path,source) =
Left (Pn l c,msg) ->
makeObj [prop "error" msg,
prop "location" (show l++":"++show c)]
Right mod -> case convAbstract mod of
Right mod -> case convModule mod of
Ok g -> makeObj [prop "converted" g]
Bad msg -> makeObj [prop "parsed" msg]
@@ -33,11 +35,19 @@ parseModule (path,source) =
convAbstractFile path =
appIOE (fmap encode . convAbstract =<< getSourceModule noOptions path)
-}
convModule m@(modid,src) =
if isModAbs src
then convAbstract m
else if isModCnc src
then convConcrete m
else fail "An abstract or concrete syntax module was expected"
convAbstract (modid,src) =
do unless (isModAbs src) $ fail "Abstract syntax expected"
unless (isCompleteModule src) $ fail "A complete abstract syntax expected"
extends <- convExtends (mextend src)
(cats,funs) <- convJments (jments src)
(cats,funs) <- convAbsJments (jments src)
let startcat = head (cats++["-"]) -- !!!
return $ Grammar (convId modid) extends (Abstract startcat cats funs) []
@@ -45,9 +55,9 @@ convExtends = mapM convExtend
convExtend (modid,MIAll) = return (convId modid)
convExtend _ = fail "unsupported module extension"
convJments jments = foldM convJment ([],[]) (Map.toList jments)
convAbsJments jments = foldM convAbsJment ([],[]) (Map.toList jments)
convJment (cats,funs) (name,jment) =
convAbsJment (cats,funs) (name,jment) =
case jment of
AbsCat octx -> do unless (null (maybe [] unLoc octx)) $
fail "category with context"
@@ -69,3 +79,53 @@ convSimpleType (Vr id) = return (convId id)
convSimpleType t = fail "unsupported type"
convId = showIdent
convConcrete (modid,src) =
do unless (isModCnc src) $ fail "Concrete syntax expected"
unless (isCompleteModule src) $ fail "A complete concrete syntax expected"
extends <- convExtends (mextend src)
opens <- convOpens (mopens src)
js <- convCncJments (jments src)
let ps = [p | Pa p <-js]
lcs = [lc | LC lc<-js]
os = [o | Op o <-js]
ls = [l | Li l <-js]
langcode = "" -- !!!
conc = Concrete langcode opens ps lcs os ls
abs = Abstract "-" [] [] -- dummy
return $ Grammar (convId modid) extends abs [conc]
convOpens = mapM convOpen
convOpen o =
case o of
OSimple id -> return (convId id)
_ -> fail "unsupported module open"
data CncJment = Pa S.Param | LC Lincat | Op Oper | Li Lin
convCncJments = mapM convCncJment . Map.toList
convCncJment (name,jment) =
case jment of
ResParam ops _ ->
return $ Pa $ Param i (maybe "" (render . ppParams q . unLoc) ops)
CncCat (Just (L _ typ)) Nothing Nothing _ ->
return $ LC $ Lincat i (render $ ppTerm q 0 typ)
ResOper oltyp (Just lterm) -> return $ Op $ Oper lhs rhs
where
lhs = i++maybe "" ((" : "++) . render . ppTerm q 0 . unLoc) oltyp
rhs = " = "++render (ppTerm q 0 (unLoc lterm))
CncFun _ (Just ldef) Nothing _ ->
do let (xs,e') = getAbs (unLoc ldef)
lin = render $ ppTerm q 0 e'
args <- mapM convBind xs
return $ Li $ Lin i args lin
_ -> fail $ "unsupported judgement form: "++show jment
where
i = convId name
q = Unqualified
convBind (Explicit,v) = return $ convId v
convBind (Implicit,v) = fail "implicit binding not supported"

45
src/www/gfse/editor.js
View File

@@ -461,14 +461,21 @@ function draw_abstract(g) {
extensible([kw_fun,
indent_sortable(draw_funs(g),sort_funs)])])]);
if(navigator.onLine) {
var mode_button=text_mode(g,file);
var mode_button=text_mode(g,file,0);
insertBefore(mode_button,file.firstChild)
}
return file;
}
function text_mode(g,file) {
var path=g.basename+".gf"
function module_name(g,ix) {
return ix==0 ? g.basename : g.basename+g.concretes[ix-1].langcode
}
function show_module(g,ix) {
return ix==0 ? show_abstract(g) : show_concrete(g)(g.concretes[ix-1]);
}
function text_mode(g,file,ix) {
var path=module_name(g,ix)+".gf"
function switch_to_guided_mode() {
clear(compiler_output);
edit_grammar(g); // !!
@@ -485,11 +492,24 @@ function text_mode(g,file) {
dst.innerHTML=
"Accepted by GF, but not by this editor ("+msg.parsed+")"
else if(msg.converted) {
var gnew=msg.converted;
g.abstract=gnew.abstract;
g.extends=gnew.extends;
timestamp(g.abstract);
save_grammar(g);
if(ix==0) {
var gnew=msg.converted;
g.abstract=gnew.abstract;
g.extends=gnew.extends;
timestamp(g.abstract);
save_grammar(g);
}
else {
var conc=g.concretes[ix-1];
var cnew=msg.converted.concretes[0];
conc.opens=cnew.opens;
conc.params=cnew.params;
conc.lincats=cnew.lincats;
conc.opers=cnew.opers;
conc.lins=cnew.lins;
timestamp(conc);
save_grammar(g);
}
}
else replaceInnerHTML(dst,"unexpected parse result");
}
@@ -507,7 +527,7 @@ function text_mode(g,file) {
}
function switch_to_text_mode() {
var ta=node("textarea",{class:"text_mode",rows:25,cols:80},
[text(show_abstract(g))])
[text(show_module(g,ix))])
var timeout;
ta.onkeyup=function() {
if(timeout) clearTimeout(timeout);
@@ -704,7 +724,7 @@ function draw_concrete(g,i) {
kw_param.title="Parameter type definitions can be added here. [C.3.12]"
var kw_oper=kw("oper")
kw_oper.title="Operation definitions can be added here. [C.3.14]"
return div_id("file",
var file=div_id("file",
[kw("concrete "),
ident(g.basename),
editable("span",ident(conc.langcode),g,
@@ -719,6 +739,11 @@ function draw_concrete(g,i) {
indent([extensible([kw_oper,draw_opers(g,i)])]),
exb_extra(g,i)
])
if(navigator.onLine) {
var mode_button=text_mode(g,file,i+1);
insertBefore(mode_button,file.firstChild)
}
return file;
}
var rgl_modules=["Paradigms","Syntax","Lexicon","Extra"];