diff --git a/src/compiler/GF/Grammar/Printer.hs b/src/compiler/GF/Grammar/Printer.hs index 08d70928c..9f8ee45b9 100644 --- a/src/compiler/GF/Grammar/Printer.hs +++ b/src/compiler/GF/Grammar/Printer.hs @@ -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 diff --git a/src/compiler/SimpleEditor/Convert.hs b/src/compiler/SimpleEditor/Convert.hs index 93844ea18..037b04986 100644 --- a/src/compiler/SimpleEditor/Convert.hs +++ b/src/compiler/SimpleEditor/Convert.hs @@ -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" diff --git a/src/www/gfse/editor.js b/src/www/gfse/editor.js index 9748fa79d..c86fe72d1 100644 --- a/src/www/gfse/editor.js +++ b/src/www/gfse/editor.js @@ -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"];