From 5d4159c87e88efa85648bb6c91bb195aa267b1e2 Mon Sep 17 00:00:00 2001 From: pzinn Date: Thu, 28 Nov 2024 13:37:32 +1100 Subject: [PATCH] 1st attempt: m2 level makeKeyword --- M2/Macaulay2/d/actors5.d | 10 ++++++++++ M2/Macaulay2/d/binding.d | 7 +++++-- M2/Macaulay2/d/convertr.d | 17 ++++++++++++++--- M2/Macaulay2/d/evaluate.d | 9 +++++++++ M2/Macaulay2/m2/exports.m2 | 1 + 5 files changed, 39 insertions(+), 5 deletions(-) diff --git a/M2/Macaulay2/d/actors5.d b/M2/Macaulay2/d/actors5.d index 1c15f103dae..1a268d8502d 100644 --- a/M2/Macaulay2/d/actors5.d +++ b/M2/Macaulay2/d/actors5.d @@ -1,6 +1,7 @@ -- Copyright 1995,2010 by Daniel R. Grayson use actors; use actors2; +use binding; header "#include "; @@ -13,6 +14,15 @@ getParsing(e:Expr):Expr := ( else nullE); setupfun("getParsing",getParsing); +export makeKeywordFun(e:Expr):Expr := ( + when e + is s:stringCell do ( + Expr(makeKeyword(unarybinaryleft(s.v))) -- TODO check whether install is really needed (for mathematical symbols as opposed to words) + ) + else nullE -- TODO error (but anyway won't be called directly) + ); +setupfun("makeKeyword",makeKeywordFun); + LongDoubleRightArrowFun(lhs:Code,rhs:Code):Expr := binarymethod(lhs,rhs,LongDoubleRightArrowS); setup(LongDoubleRightArrowS,LongDoubleRightArrowFun); diff --git a/M2/Macaulay2/d/binding.d b/M2/Macaulay2/d/binding.d index f4b4985e516..0bab20b7ad1 100644 --- a/M2/Macaulay2/d/binding.d +++ b/M2/Macaulay2/d/binding.d @@ -137,7 +137,7 @@ export makeProtectedSymbolClosure(w:Word):SymbolClosure := ( when globalFrame.values.(entry.frameindex) is s:SymbolClosure do s else SymbolClosure(globalFrame,entry)); -makeKeyword(w:Word):SymbolClosure := ( +export makeKeyword(w:Word):SymbolClosure := ( -- keywords differ from symbols in that their initial value is null entry := makeEntry(w,dummyPosition,globalDictionary); entry.Protected = true; @@ -157,7 +157,7 @@ unaryword(s:string) :Word := makeUniqueWord(s, parseinfo(prec,nopr postfix(s:string) :Word := install(s,makeUniqueWord(s, parseinfo(prec,nopr ,nopr,parsefuns(errorunary,postfixop)))); unarybinaryleft(s:string) :Word := install(s,makeUniqueWord(s, parseinfo(prec,prec ,prec,parsefuns(unaryop ,binaryop)))); unarybinaryright(s:string) :Word := install(s,makeUniqueWord(s, parseinfo(prec,prec-1,prec,parsefuns(unaryop ,binaryop)))); -binaryleft(s:string) :Word := install(s,makeUniqueWord(s, parseinfo(prec,prec ,nopr,parsefuns(errorunary,binaryop)))); +export binaryleft(s:string) :Word := install(s,makeUniqueWord(s, parseinfo(prec,prec ,nopr,parsefuns(errorunary,binaryop)))); nright(s:string) :Word := install(s,makeUniqueWord(s, parseinfo(prec,prec-1,nopr,parsefuns(errorunary,nbinaryop)))); nleftword(s:string) :Word := makeUniqueWord(s, parseinfo(prec,prec ,nopr,parsefuns(errorunary,nbinaryop))); nunarybinaryleft(s:string) :Word := install(s,makeUniqueWord(s, parseinfo(prec,prec ,prec,parsefuns(nnunaryop ,nbinaryop)))); @@ -644,14 +644,17 @@ bindParenParmList(e:ParseTree,dictionary:Dictionary,desc:functionDescription):vo is p:EmptyParentheses do nothing else makeErrorTree(e,"expected parenthesized argument list or symbol")); opHasBinaryMethod(o:Symbol):bool := ( + return true; -- TEMP foreach s in opsWithBinaryMethod do if s.symbol == o then return true; return false; ); opHasUnaryMethod(o:Symbol):bool := ( + return true; -- TEMP foreach s in opsWithUnaryMethod do if s.symbol == o then return true; return false; ); opHasPostfixMethod(o:Symbol):bool := ( + return true; -- TEMP foreach s in opsWithPostfixMethod do if s.symbol == o then return true; return false; ); diff --git a/M2/Macaulay2/d/convertr.d b/M2/Macaulay2/d/convertr.d index b3a9d3e7221..e4e5bed21bb 100644 --- a/M2/Macaulay2/d/convertr.d +++ b/M2/Macaulay2/d/convertr.d @@ -21,6 +21,8 @@ export UnaryInstallMethodFun := dummyTernaryFun; export InstallValueFun := dummyMultaryFun; export UnaryInstallValueFun := dummyTernaryFun; +export binarymethod1 := dummyTernaryFun; -- temporary, will be redefined in evaluate.d + convert(e:ParseTree):Code; CodeSequenceLength(e:ParseTree,separator:Word):int := ( i := 0; @@ -189,7 +191,12 @@ export convert0(e:ParseTree):Code := ( rhs := convertGlobalOperator(token); -- TODO: is this check necessary? if token.word.typecode == TCid - then Code(binaryCode(b.Operator.entry.binary, convert(b.lhs), rhs, pos)) + then ( + f:=b.Operator.entry.binary; if f==dummyBinaryFun then + Code(ternaryCode(binarymethod1,convert(b.lhs), rhs, globalSymbolClosureCode(b.Operator.entry, dummyPosition),pos)) + else + Code(binaryCode(f, convert(b.lhs), rhs, pos)) + ) else dummyCode -- should not occur ) else dummyCode -- should not occur @@ -300,8 +307,12 @@ export convert0(e:ParseTree):Code := ( else Code(augmentedAssignmentCode( b.Operator.entry, dummyCode, dummyCode, dummySymbol, dummyPosition)) -- CHECK ) - else Code(binaryCode(b.Operator.entry.binary, convert(b.lhs), convert(b.rhs), pos)) - ) + else ( + f:=b.Operator.entry.binary; if f==dummyBinaryFun then + Code(ternaryCode(binarymethod1,convert(b.lhs), convert(b.rhs), globalSymbolClosureCode(b.Operator.entry, dummyPosition),pos)) + else + Code(binaryCode(f, convert(b.lhs), convert(b.rhs), pos)) + )) is u:Unary do ( if u.Operator.word == CommaW then Code(sequenceCode(makeCodeSequence(e, CommaW), pos)) else if u.Operator.word == SemicolonW then Code(semiCode( makeCodeSequence(e, SemicolonW), pos)) diff --git a/M2/Macaulay2/d/evaluate.d b/M2/Macaulay2/d/evaluate.d index 8c4629f4cbe..e7f5009d9db 100644 --- a/M2/Macaulay2/d/evaluate.d +++ b/M2/Macaulay2/d/evaluate.d @@ -1095,6 +1095,7 @@ export unarymethod(rhs:Code,methodkey:SymbolClosure):Expr := ( method := lookup(Class(right),Expr(methodkey),methodkey.symbol.hash); if method == nullE then MissingMethod(methodkey) else applyEE(method,right))); + export binarymethod(lhs:Code,rhs:Code,methodkey:SymbolClosure):Expr := ( left := eval(lhs); when left is Error do left @@ -1119,6 +1120,12 @@ export binarymethod(left:Expr,rhs:Code,methodkey:SymbolClosure):Expr := ( else MissingMethodPair(methodkey,left,right) ) else applyEEE(method,left,right))); +export binarymethodCode(lhs:Code,rhs:Code,methodkey:Code):Expr := ( + when methodkey is + s:globalSymbolClosureCode do binarymethod(lhs,rhs,SymbolClosure(globalFrame,s.symbol)) + else nullE +); + ----------------------------------------------------------------------------- @@ -2110,6 +2117,8 @@ nullCoalescion(lhs:Code,rhs:Code):Expr := ( else e); setup(QuestionQuestionS, nullify, nullCoalescion); +binarymethod1=binarymethodCode; + -- Local Variables: -- compile-command: "echo \"make: Entering directory \\`$M2BUILDDIR/Macaulay2/d'\" && make -C $M2BUILDDIR/Macaulay2/d evaluate.o " -- End: diff --git a/M2/Macaulay2/m2/exports.m2 b/M2/Macaulay2/m2/exports.m2 index bdd7f479a22..a1dd5453ffd 100644 --- a/M2/Macaulay2/m2/exports.m2 +++ b/M2/Macaulay2/m2/exports.m2 @@ -896,6 +896,7 @@ export { "lookup", "lookupCount", "makeDirectory", + "makeKeyword", "makeDocumentTag", "makePackageIndex", "map",