From 00796f7b8bc97b964a01d647487214579f91775a Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 1 Sep 2008 16:23:42 +0000 Subject: 2008-09-01 Martin Rubey Gabriel Dos Reis Fix AW/431 * algebra/ore.spad.pamphlet (SpareUnivariateSkewPolynomial): Implement **. 2008-09-01 Gabriel Dos Reis Make ^ an alias for **. * interp/postpar.boot (postAtom): Replace "^" with "**". * interp/format.boot (reportOpSymbol): Announce that "^" is an alias for "**". * interp/nrungo.boot (compiledLookup): Be sure to look for "**" when operation is "^". * interp/define.boot (noteCapsuleFunctionDefinition): New. (clearCapsuleFunctionTable): Likewise. (noteExport): Likewise. (clearExportsTable): Likewise. (compDefineCapsuleFunction): Rename "^" to "**". Take a note of the capsule function being compiled. (compCapsule): Clear previous capsule functions table. (doItIf): Keep track of predicate validity. (compCategory): Clear previous exports table. (compCategoryItem): Take notes of declared attributes and signatures. * algebra/catdef.spad.pamphlet (DivisionRing): Remove duplicate definition for "^". (Group): Likewise. (Monoid): Likewise. (SemiGroup): Likewise. * algebra/poly.spad.pamphlet (PolynomialRing): Remove duplicate definitins of "^". (SparseUnivariatePolynomial): Likewise. * algebra/multpoly.spad.pamphlet (SparseMultivariatePolynomial): Remove duplicate definitions for "^". * algebra/interval.spad.pamphlet (Interval): Remove duplicate definition for "^". * algebra/curve.spad.pamphlet (FunctionFieldCategory): Remove duplicate declaration for represents. * algebra/strap/: Update cached Lisp translations. * share/algebra: Update databases. --- src/interp/define.boot | 79 +++++++++++++++++++++++++++++++++++++++++++------ src/interp/format.boot | 4 +++ src/interp/nrungo.boot | 11 +++---- src/interp/postpar.boot | 1 + 4 files changed, 81 insertions(+), 14 deletions(-) (limited to 'src/interp') diff --git a/src/interp/define.boot b/src/interp/define.boot index ea1e1f91..2d8cbd38 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -53,6 +53,51 @@ $suffix := nil -- ??? turns off buggy code $NRTopt := false +++ List of operations defined in a given capsule +++ Each item on this list is of the form +++ (op sig pred) +++ where +++ op: name of the operation +++ sig: signature of the operation +++ pred: scope predicate of the operation. +$capsuleFunctions := nil + +++ record that the operation `op' with signature `sig' and predicate +++ `pred' is defined in the current capsule of the current domain +++ being compiled. +noteCapsuleFunctionDefinition(op,sig,pred) == + member([op,sig,pred],$capsuleFunctions) => + stackAndThrow('"redefinition of %1b: %2 %3", + [op,formatUnabbreviated ["Mapping",:sig],formatIf pred]) + $capsuleFunctions := [[op,sig,pred],:$capsuleFunctions] + +++ Clear the list of functions defined in the last domain capsule. +clearCapsuleFunctionTable() == + $capsuleFunctions := nil + + +++ List of exports (paireed with scope predicate) declared in +++ the category of the currend domain or package. +++ Note: for category packages, this list is nil. +$exports := nil + +noteExport(form,pred) == + -- don't recheck category package exports; we just check + -- them when defining the category. Plus, we might actually + -- get indirect duplicates, which is OK. + $insideCategoryPackageIfTrue => nil + member([form,pred],$exports) => + stackAndThrow('"redeclaration of %1 %2", + [form,formatIf pred]) + $exports := [[form,pred],:$exports] + +clearExportsTable() == + $exports := nil + +makePredicate l == + null l => true + MKPF(l,"and") + --% FUNCTIONS WHICH MUNCH ON == STATEMENTS compDefine: (%Form,%Mode,%Env) -> %Maybe %Triple @@ -842,6 +887,11 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], $CapsuleDomainsInScope: local:= get("$DomainsInScope","special",e) $insideExpressionIfTrue: local:= true $returnMode:= m + -- Change "^" to "**" in definitions. All other places have + -- been changed before we get here. + if first form = "^" then + sayBrightly ['"Replacing", :bright '"^", '"with",:bright '"**"] + rplac(first form,"**") [$op,:argl]:= form $form:= [$op,:argl] argl:= stripOffArgumentConditions argl @@ -894,6 +944,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], sayBrightly ['" compiling ",localOrExported, :bright $op,'": ",:formattedSig] + noteCapsuleFunctionDefinition($op,signature', makePredicate $predl) T := CATCH('compCapsuleBody, compOrCroak(body,rettype,e)) or [" ",rettype,e] NRTassignCapsuleFunctionSlot($op,signature') @@ -1272,6 +1323,7 @@ compCapsule(['CAPSULE,:itemList],m,e) == [bootStrapError($functorForm, _/EDITFILE),m,e] $insideExpressionIfTrue: local:= false $useRepresentationHack := true + clearCapsuleFunctionTable() compCapsuleInner(maybeInsertViewMorphisms itemList,m,addDomain('_$,e)) compSubDomain: (%Form,%Mode,%Env) -> %Maybe %Triple @@ -1324,7 +1376,8 @@ compCapsuleItems(itemlist,$predl,$e) == $myFunctorBody :local := nil ---needed for translator $signatureOfForm: local := nil $suffix: local:= 0 - for item in itemlist repeat $e:= compSingleCapsuleItem(item,$predl,$e) + for item in itemlist repeat + $e:= compSingleCapsuleItem(item,$predl,$e) $e compSingleCapsuleItem(item,$predl,$e) == @@ -1412,11 +1465,11 @@ doItIf(item is [.,p,x,y],$predl,$e) == [p',.,$e]:= compCompilerPredicate(p,$e) or userError ['"not a Boolean:",p] oldFLP:=$functorLocalParameters if x^="%noBranch" then - compSingleCapsuleItem(x,$predl,getSuccessEnvironment(p,$e)) + compSingleCapsuleItem(x,[p,:$predl],getSuccessEnvironment(p,$e)) x':=localExtras(oldFLP) oldFLP:=$functorLocalParameters if y^="%noBranch" then - compSingleCapsuleItem(y,$predl,getInverseEnvironment(p,olde)) + compSingleCapsuleItem(y,[["not",p],:$predl],getInverseEnvironment(p,olde)) y':=localExtras(oldFLP) RPLACA(item,"COND") RPLACD(item,[[p',x,:x'],['(QUOTE T),y,:y']]) @@ -1503,6 +1556,7 @@ makeCategoryForm(c,e) == compCategory: (%Form,%Mode,%Env) -> %Maybe %Triple compCategory(x,m,e) == $TOP__LEVEL: local:= true + clearExportsTable() (m:= resolve(m,$Category))=$Category and x is ['CATEGORY, domainOrPackage,:l] => $sigList: local := nil @@ -1572,24 +1626,30 @@ compCategoryItem(x,predl,env) == --1. if x is a conditional expression, recurse; otherwise, form the predicate x is ["COND",[p,e]] => predl':= [p,:predl] - e is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl',env) + e is ["PROGN",:l] => + for y in l repeat compCategoryItem(y,predl',env) compCategoryItem(e,predl',env) x is ["IF",a,b,c] => predl':= [a,:predl] if b^="%noBranch" then - b is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl',env) + b is ["PROGN",:l] => + for y in l repeat compCategoryItem(y,predl',env) compCategoryItem(b,predl',env) c="%noBranch" => nil predl':= [["not",a],:predl] - c is ["PROGN",:l] => for y in l repeat compCategoryItem(y,predl',env) + c is ["PROGN",:l] => + for y in l repeat compCategoryItem(y,predl',env) compCategoryItem(c,predl',env) - pred:= (predl => MKPF(predl,"AND"); true) + pred := (predl => MKPF(predl,"AND"); true) --2. if attribute, push it and return - x is ["ATTRIBUTE",y] => PUSH(MKQ [y,pred],$atList) + x is ["ATTRIBUTE",y] => + noteExport(y,pred) + PUSH(MKQ [y,pred],$atList) --3. it may be a list, with PROGN as the CAR, and some information as the CDR - x is ["PROGN",:l] => for u in l repeat compCategoryItem(u,predl,env) + x is ["PROGN",:l] => + for u in l repeat compCategoryItem(u,predl,env) -- 4. otherwise, x gives a signature for a -- single operator name or a list of names; if a list of names, @@ -1604,4 +1664,5 @@ compCategoryItem(x,predl,env) == --4. branch on a single type or a signature %with source and target for t in first sig repeat diagnoseUknownType(t,env) + noteExport(rest x,pred) PUSH(MKQ [rest x,pred],$sigList) diff --git a/src/interp/format.boot b/src/interp/format.boot index 252eb860..64414ea6 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -171,6 +171,10 @@ substInOrder(alist,x) == x reportOpSymbol op1 == + -- Don't forget that "^" is another name for "**" + if op1 = "^" then + sayMessage ['" ",op1, '" is another name for", :bright '"**"] + op1 := "**" op := (STRINGP op1 => INTERN op1; op1) modemaps := getAllModemapsFromDatabase(op,nil) null modemaps => diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot index 725be391..90497aea 100644 --- a/src/interp/nrungo.boot +++ b/src/interp/nrungo.boot @@ -65,6 +65,11 @@ compiledLookup(op,sig,dollar) == --called by coerceByFunction, evalForm, findEqualFun, findUniqueOpInDomain, -- getFunctionFromDomain, optDeltaEntry, retractByFunction if not VECP dollar then dollar := NRTevalDomain dollar + -- "^" is an alternate name for "**" in OpenAxiom libraries. + -- ??? When, we get to support Aldor libraries and the equivalence + -- ??? does not hold, we may want to do the reverse lookup too. + -- ??? See compiledLookupCheck below. + if op = "^" then op := "**" basicLookup(op,sig,dollar,dollar) --------------------> NEW DEFINITION (see interop.boot.pamphlet) @@ -80,12 +85,8 @@ compiledLookupCheck(op,sig,dollar) == fn := compiledLookup(op,sig,dollar) -- NEW COMPILER COMPATIBILITY ON - - if (fn = nil) and (op = "^") then - fn := compiledLookup("**",sig,dollar) - else if (fn = nil) and (op = "**") then + if (fn = nil) and (op = "**") then fn := compiledLookup("^",sig,dollar) - -- NEW COMPILER COMPATIBILITY OFF fn = nil => diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index 9ba73705..23411ef5 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -177,6 +177,7 @@ postAtom x == EQ(x,'T) => "T$" -- rename T in spad code to T$ IDENTP x and niladicConstructorFromDB x => [x] x="," => "%Comma" + x = "^" => "**" -- always use `**' internally for exponentiation x postBlock: %ParseTree -> %ParseForm -- cgit v1.2.3