summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/compiler/GF/Grammar/Printer.hs5
-rw-r--r--src/compiler/SimpleEditor/Convert.hs70
-rw-r--r--src/www/gfse/editor.js45
3 files changed, 104 insertions, 16 deletions
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"];
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 07:19:05 +0000