7.144 bug with RealDomain in Maple 7 (17.9.01)

7.144.1 Werner Burkhardt
7.144.2 Preben Alsholm (19.9.01)
7.144.3 Carl DeVore (24.9.01)
7.144.4 Helmut Kahovec (1.10.01)
7.144.5 Helmut Kahovec (2.10.01)
7.144.6 Helmut Kahovec (25.10.01)

7.144.1 Werner Burkhardt

Can anybody explain this behavior of maple 7

   > with( RealDomain ): 
 
   > solve(x^2-2=0); 
 
                               sqrt(2)
 

It is corrected with Maple 8 (U. Klein)

7.144.2 Preben Alsholm (19.9.01)

Just to add to the mystery, try this:

with(RealDomain); 
seq(solve(x^4-k=0,x), k=0..16);
 

The most remarkable of the 17 results are the solutions to \(x^4-4=0\) and \(x^4-9=0\). Maple says ’undefined’.

7.144.3 Carl DeVore (24.9.01)

Preben Alsholm wrote: Just to add to the mystery ...

No mystery. The module RealDomain has a local procedure ’clean’. clean essentially converts non-reals to undefined. The bug is that clean only operates on its first argument. solve, in general, returns an expression sequence.

So, the bug fix is a one-liner in the export RealDomain:-solve:

1. list'ify solve's output 
 
2. map clean 
 
3. remove hastype undefined 
 
4. de'list'ify
 

However, because of lexical local procedures, the patching process is inordinately complex in our model.

The fact that this bug got through shows that they must not have tested RealDomain:-solve in any significant way! Most solve’s return multiple solutions. This is shocking.

Here is a complete fix of the bug.

Patching a Bug in a Module by Resolving Lexical References

The bugs are in procedure clean local to RealDomain, and RealDomain:-solve, which calls clean.

> p:= Patch(solve, RealDomain): 
> with(p): 
> 0&-oo; 
 
_TheProc := proc() 
   1   _EnvSolveOverReals := true; 
   2   NumericEventHandler(('real_to_complex') = r2c_handler); 
   3   clean(`assuming`([solve(args)],['real'])) 
end proc
 

Clean can only operate on a single argument, but solve returns, in general, an expression sequence.

Before we can patch this, we need to trace back all references to lexcial variables, extract them, and make them global.

> eval(RealDomain); 
 
  module() 
local wrap, RorU, lenv, renv, locn, r2c_handler, fixuneval, 
fixuneval2, fixarith, fixarith2, clean; 
export limit, solve, simplify, surd, `^`, eval, expand, 
signum, sqrt, exp, ln, log, sin, cos, tan, sec, csc, cot, 
sinh, cosh, tanh, sech, csch, coth, arcsin, arccos, arctan, 
arcsec, arccsc, arccot, arcsinh, arccosh, arctanh, arcsech, 
arccsch, arccoth, Re, Im; 
option package; 
description "versions of some standard Maple routines speci\ 
alized for real number domains"; 
end module
 

We that solve calls the lexical r2c_handler.

> p:= Patch(r2c_handler, RealDomain): 
> with(p): 
> 0&-oo; 
 
_TheProc := proc(rator, rands, dflt) 
local s; 
   1   s := convert(rator,'string'); 
   2   if s[1 .. 6] = "evalf/" then 
   3     s := s[7 .. -1] 
       end if; 
   4   userinfo(3,'RealDomain',sprintf("Real to Complex numeric event in %a with arguments %q",rator,op(rands))); 
   5   if member(rator,thismodule) or member(convert(s,'symbol'),thismodule) then 
   6     if hastype(rands,'float') then 
   7       userinfo(3,'RealDomain',"returning Float(undefined)"); 
   8       Float(undefined) 
         else 
   9       userinfo(3,'RealDomain',"returning undefined"); 
  10       undefined 
         end if 
       else 
  11     userinfo(3,'RealDomain',"returning default value"); 
  12     dflt 
       end if 
end proc 
 
> &s"thismodule"; 
 
   5   if member(rator,thismodule) or member(convert(s,'symbol'),thismodule) then 
                       ^^^^^^^^^^ 
> &r"RealDomain"; 
 
   5   if member(rator,RealDomain) or member(convert(s,'symbol'),thismodule) then 
 
> &s s; 
 
   5   if member(rator,RealDomain) or member(convert(s,'symbol'),thismodule) then 
                                                                 ^^^^^^^^^^ 
> &r"RealDomain"; 
 
   5   if member(rator,RealDomain) or member(convert(s,'symbol'),RealDomain) then 
 
> Recompile(); 
 
Error, (in Relink) Relinking local procedures to their parent modules not 
yet implemented.
 

Ignore that error message. The recompiled procedure exists as the global _TheProc. Give it a meaningful global name for later reference.

> `RealDomain/r2c_handler`:= eval(_TheProc): 
Clean refers to a lexical procedure RorU. Extract it. 
 
> p:= Patch(RorU, RealDomain): 
> with(p): 
> 0&-oo; 
 
_TheProc := proc(expr) 
local fexpr; 
   1   if nargs <> 1 then 
   2     op(map(procname,[args])) 
       elif hastype(expr,'nonreal') then 
   3     undefined 
       else 
   4     fexpr := evalf(expr); 
   5     if hastype(fexpr,'{nonreal, undefined}') then 
   6       undefined 
         else 
   7       expr 
         end if 
       end if 
end proc
 

This procedure has no lexical references. We simply recompile it.

> Recompile(); 
Error, (in Relink) Relinking local procedures to their parent modules not 
yet implemented. 
 
> `RealDomain/RorU`:= eval(_TheProc): 
 
> p:= Patch(clean, RealDomain): 
> with(p): 
> 0&-oo; 
 
_TheProc := proc(expr) 
 
   1 `if`(nargs = 0,NULL,subsindets(expr,'anything',proc (e) if nargs <> 1 
then op(map(procname,{args})) else if type(e,'complex(extended_numeric)') 
then if type(e,'nonreal') then undefined elif type(e,'embedded_real') then 
:-Re(e) elif type(evalf(e),'embedded_real') then :-Re(e) else RorU(e) end 
if elif hastype(e,'{nonreal, undefined}') then undefined elif 
type(e,'negative^fraction') then convert(e,'surd') else RorU(subs(0.*I = 
0.,e)) end if end if end proc)) end proc 
Change lexical references to global references. 
 
> &s"RorU": 
> &r"`RealDomain/RorU`"; 
 
   1 `if`(nargs = 0,NULL,subsindets(expr,'anything',proc (e) if nargs <> 1 
then op(map(procname,{args})) else if type(e,'complex(extended_numeric)') 
then if type(e,'nonreal') then undefined elif type(e,'embedded_real') then 
:-Re(e) elif type(evalf(e),'embedded_real') then :-Re(e) else 
`RealDomain/RorU`(e) end if elif hastype(e,'{nonreal, undefined}') then 
undefined elif type(e,'negative^fraction') then convert(e,'surd') else 
RorU(subs(0.*I = 0.,e)) end if end if end proc)) end proc 
 
> &s" RorU": 
> &r" `RealDomain/RorU`"; 
 
   1 `if`(nargs = 0,NULL,subsindets(expr,'anything',proc (e) if nargs <> 1 
then op(map(procname,{args})) else if type(e,'complex(extended_numeric)') 
then if type(e,'nonreal') then undefined elif type(e,'embedded_real') then 
:-Re(e) elif type(evalf(e),'embedded_real') then :-Re(e) else 
`RealDomain/RorU`(e) end if elif hastype(e,'{nonreal, undefined}') then 
undefined elif type(e,'negative^fraction') then convert(e,'surd') else 
`RealDomain/RorU`(subs(0.*I = 0.,e)) end if end if end proc)) end proc 
By the way, I believe that the embedded procedure above is essentially mapped, and thus it could never be called with multiple arguments. This is the real source of the bug. 
 
> Recompile(); 
Error, (in Relink) Relinking local procedures to their parent modules not 
yet implemented. 
 
> `RealDomain/clean`:= eval(_TheProc): 
 
> p:= Patch(solve, RealDomain): 
> with(p): 
> 0&-oo; 
 
_TheProc := proc() 
   1   _EnvSolveOverReals := true; 
   2   NumericEventHandler(('real_to_complex') = r2c_handler); 
   3   clean(`assuming`([solve(args)],['real'])) 
end proc 
 
> &s"r2c_handler"; 
 
   2   NumericEventHandler(('real_to_complex') = r2c_handler); 
                                                 ^^^^^^^^^^^ 
> &r"`RealDomain/r2c_handler`"; 
 
   2   NumericEventHandler(('real_to_complex') = `RealDomain/r2c_handler`); 
 
> &-3; 
 
   3   clean(`assuming`([solve(args)],['real'])) end proc
 

We take the output of solve, make it a list, and then map clean. For the case of solve, we do not wish to see "undefined" as an answer. Just remove them. Finally, de-list the result.

> ""&r"remove(hastype, map(`RealDomain/clean`, [:-solve(args) assuming 'real']), undefined)[]  end proc"; 
   3  remove(hastype, map(`RealDomain/clean`, [:-solve(args) assuming 'real']), undefined)[]  end proc 
 
> Recompile();
 

Since solve was an export, it has been reinstalled into RealDomain. Test.

> with(RealDomain); 
 
  [Im, Re, ^, arccos, arccosh, arccot, arccoth, arccsc, arccsch, 
        arcsec, arcsech, arcsin, arcsinh, arctan, arctanh, cos, cosh, 
        cot, coth, csc, csch, eval, exp, expand, limit, ln, log, sec, 
        sech, signum, simplify, sin, sinh, solve, sqrt, surd, tan, 
        tanh] 
 
> solve(x^2-2=0); 
                          sqrt(2), -sqrt(2) 
> solve(x^4-1); 
                                -1, 1 
> solve(x^2+1);
 

It works. Make sure that we did not break other aspects of RealDomain.

> sqrt(-1); 
                              undefined 
> (-1)^(1/2); 
                              undefined
 

Make it still work after being reinstalled in a library. The following assumes the existence of a library "MEG_Patch".

> libname:= "MEG_Patch", libname; 
              libname := "MEG_Patch", "/opt/maple7/lib" 
 
> savelibname:= "MEG_Patch":
 

The savelib command will take a few seconds. Ignore any warnings about missing help files.

We need to save the module and all the lexicals that we made global.

> savelib('RealDomain', `RealDomain/r2c_handler`, `RealDomain/RorU`, `RealDomain/clean`);
 

Test it.

> restart; 
> libname:= "MEG_Patch", libname; 
              libname := "MEG_Patch", "/opt/maple7/lib" 
 
> with(RealDomain): 
> solve(x^2+1=0); 
> solve(x^4-1=0); 
                                -1, 1 
> solve(x^2-2=0); 
                          sqrt(2), -sqrt(2) 
> sqrt(-1); 
                              undefined 
> ln(-1); 
                              undefined
 

It works.

7.144.4 Helmut Kahovec (1.10.01)

Well, as others have already pointed out, the bug is in the local procedure clean() of RealDomain. We may fix it as shown below. Setting

> infolevel[modifyM]:=3:
 

prints some information on the exported and local procedures of a module instance while modifyM() is executing. Additionally, change contexts of modules by executing the with() function since modified module instances do not correctly work with the ’use’ statement. Nested modules are not yet supported.

> restart; 
 
> extractName:=proc(addr) 
  local NAME,L,s,i,q; 
  option `Copyright (c) 2001 by Helmut Kahovec. All rights reserved.`; 
    NAME:=8; 
    L:=[disassemble(addr)]; 
    if L[1]=NAME then 
      s:=``; 
      for i from 4 to nops(L) do 
        q:=L[i]; 
        s:=s, 
          convert( 
            convert([seq(irem(q,256,'q'),i=1..4)],bytes), 
            name 
          ) 
      end do; 
      cat(s) 
    else 
      error "address does not point to a name" 
    end if 
  end proc: 
 
> extractMember:=proc(M::`module`,m::evaln) 
  local EXPORTS,LOCALS,S,EA,LA,EN,LN,pos; 
  option `Copyright (c) 2001 by Helmut Kahovec. All rights reserved.`; 
    EXPORTS,LOCALS:=2,4; 
    S:=disassemble(disassemble(addressof(M))[2]); 
    EA:=[disassemble(S[EXPORTS])][2..-1]; 
    LA:=[disassemble(S[LOCALS])][2..-1]; 
    EN:=map(u->extractName(u),EA); 
    LN:=map(u->extractName(u),LA); 
    if member(m,EN,'pos') then 
      pointto(EA[pos]) 
    elif member(m,LN,'pos') then 
      pointto(LA[pos]) 
    else 
      NULL 
    end if 
  end proc: 
 
> modifyM:=proc(M::`module`,loc::evaln) 
  local NAME,EXPSEQ,MODULE, 
        EXPORTS,MODULEDEF,LOCALS, 
        EXPORTSEQ,LOCALSEQ, 
        LEXICAL, 
        EVAL,S,emax,lmax,Ae,Al,i,A,Name,InfoLevel, 
        flag,esn,eso,lsn,lso,L,pos,IND,j,t; 
  option `Copyright (c) 2001 by Helmut Kahovec. All rights reserved.`; 
  # NAME,EXPSEQ,MODULE:=8,27,38; # Maple6 
    NAME,EXPSEQ,MODULE:=8,29,40; # Maple7 
    EXPORTS,MODULEDEF,LOCALS:=2,3,4; 
    EXPORTSEQ,LOCALSEQ:=5,3; 
    LEXICAL:=7; 
    EVAL:=u->pointto(disassemble(addressof(u))[2]); 
    InfoLevel:=3; 
    S:=disassemble(disassemble(addressof(M))[2]); 
    emax:=nops([disassemble(S[EXPORTS])]); 
    lmax:=nops([disassemble(S[LOCALS])]); 
    Ae:=array(1..emax); 
    Al:=array(1..lmax); 
    for i from 2 to emax do 
      A:=disassemble(disassemble(S[EXPORTS])[i])[2]; 
      Name:=pointto(disassemble(S[EXPORTS])[i]); 
      if A=0 then 
        Ae[i-1]:=assemble( 
          NAME, 
          A, 
          op(3..-1,[disassemble(disassemble(S[EXPORTS])[i])]) 
        ); 
        userinfo(InfoLevel,modifyM,Name,'unassigned') 
      else 
        if disassemble(A)[1]=MODULE then 
          error "nested modules not yet supported" 
        else 
          flag:=true; 
          esn:=pointto( 
            disassemble(disassemble(S[MODULEDEF])[EXPORTSEQ])[i] 
          ); 
          eso:=pointto(A); 
          if type(eso,procedure) then 
            L:=[op(LEXICAL,EVAL(eso))]; 
            if has(EVAL(eso),loc) and member(loc,L,'pos') then 
              IND:=NULL; 
              for j from 2 by 2 to nops(L) do 
                t:=L[j]; 
                if type('t',procedure) then IND:=IND,j end if 
              end do; 
              if [IND]<>[] then 
                t:=subsop( 
                  seq([LEXICAL,j]=cat(L[j-1],`_`),j=[IND]),EVAL(eso) 
                ); 
                t:=subsop([LEXICAL,pos+1]=loc,EVAL(t)); 
                esn:=subs(seq(cat(L[j-1],`_`)=L[j],j=[IND]),EVAL(t)) 
              else 
                esn:=subsop([LEXICAL,pos+1]=loc,EVAL(eso)) 
              end if; 
              userinfo(InfoLevel,modifyM,Name,'modified') 
            else 
              esn:=EVAL(eso); 
              userinfo(InfoLevel,modifyM,Name,'unchanged') 
            end if 
          elif type(eso,table) then 
            esn:=EVAL(eso) 
          else 
            esn:=eso; 
            flag:=false 
          end if 
        end if; 
        if flag then 
          Ae[i-1]:=assemble( 
            NAME, 
            disassemble(addressof(esn))[2], 
            op(3..-1,[disassemble(disassemble(S[EXPORTS])[i])]) 
          ) 
        else 
          Ae[i-1]:=assemble( 
            NAME, 
            addressof(esn), 
            op(3..-1,[disassemble(disassemble(S[EXPORTS])[i])]) 
          ) 
        end if 
      end if 
    end do; 
    for i from 2 to lmax do 
      A:=disassemble(disassemble(S[LOCALS])[i])[2]; 
      Name:=pointto(disassemble(S[LOCALS])[i]); 
      if A=0 then 
        Al[i-1]:=assemble( 
          NAME, 
          A, 
          op(3..-1,[disassemble(disassemble(S[LOCALS])[i])]) 
        ); 
        userinfo(InfoLevel,modifyM,Name,'unassigned') 
      else 
        if disassemble(A)[1]=MODULE then 
          error "nested modules not yet supported" 
        else 
          flag:=true; 
          lsn:=pointto( 
            disassemble(disassemble(S[MODULEDEF])[LOCALSEQ])[i] 
          ); 
          lso:=pointto(A); 
          if type(lso,procedure) then 
            L:=[op(LEXICAL,EVAL(lso))]; 
            if convert(Name,string)=convert(loc,string) then 
              lsn:=EVAL(loc); 
              userinfo(InfoLevel,modifyM,Name,'replaced') 
            elif has(EVAL(lso),loc) and member(loc,L,'pos') then 
              IND:=NULL; 
              for j from 2 by 2 to nops(L) do 
                t:=L[j]; 
                if type('t',procedure) then IND:=IND,j end if 
              end do; 
              if [IND]<>[] then 
                t:=subsop( 
                  seq([LEXICAL,j]=cat(L[j-1],`_`),j=[IND]),EVAL(lso) 
                ); 
                t:=subsop([LEXICAL,pos+1]=loc,EVAL(t)); 
                lsn:=subs(seq(cat(L[j-1],`_`)=L[j],j=[IND]),EVAL(t)) 
              else 
                lsn:=subsop([LEXICAL,pos+1]=loc,EVAL(lso)) 
              end if; 
              userinfo(InfoLevel,modifyM,Name,'modified') 
            else 
              lsn:=EVAL(lso); 
              userinfo(InfoLevel,modifyM,Name,'unchanged') 
            end if 
          elif type(lso,table) then 
            lsn:=EVAL(lso) 
          else 
            lsn:=lso; 
            flag:=false 
          end if 
        end if; 
        if flag then 
          Al[i-1]:=assemble( 
            NAME, 
            disassemble(addressof(lsn))[2], 
            op(3..-1,[disassemble(disassemble(S[LOCALS])[i])]) 
          ) 
        else 
          Al[i-1]:=assemble( 
            NAME, 
            addressof(lsn), 
            op(3..-1,[disassemble(disassemble(S[LOCALS])[i])]) 
          ) 
        end if 
      end if 
    end do; 
    pointto( 
      assemble( 
        NAME, 
        assemble( 
          MODULE, 
          assemble(EXPSEQ,seq(Ae[i-1],i=2..emax)), 
          S[MODULEDEF], 
          assemble(EXPSEQ,seq(Al[i-1],i=2..lmax)) 
        ), 
        op(3..-1,[disassemble(addressof(M))]) 
      ) 
    ) 
  end proc:
 

After the necessary procedures have been shown, here comes the bug fix:

> extractMember(RealDomain,RorU); 
 
                                 RorU 
 
> RorU:=eval(%); 
 
RorU := proc(expr) 
local fexpr; 
    if nargs <> 1 then op(map(procname, [args])) 
    elif hastype(expr, 'nonreal') then undefined 
    else 
        fexpr := evalf(expr); 
        if hastype(fexpr, '{nonreal, undefined}') then 
            undefined 
        else expr 
        end if 
    end if 
end proc 
 
> clean:=proc(expr) 
  options operator,arrow; 
    `if`(                               # <=== this line added === 
      nargs>1,                          # <=== this line added === 
      op(map(procname,[args])),         # <=== this line added === 
      `if`( 
        nargs=0, 
        NULL, 
        subsindets( 
          expr, 
          'anything', 
          proc(e) 
            if nargs<>1 then 
              op(map(procname,{args})) 
            else 
              if type(e,'complex(extended_numeric)') then 
                if type(e,'nonreal') then undefined 
                elif type(e,'embedded_real') then :-Re(e) 
                elif type(evalf(e),'embedded_real') then :-Re(e) 
                else RorU(e) 
                end if 
              elif hastype(e,'{undefined, nonreal}') then undefined 
              elif type(e,'negative^fraction') then convert(e,'surd') 
              else RorU(subs(0.*I=0.,e)) 
              end if 
            end if 
          end proc 
        ) 
      ) 
    )                                   # <=== this line added === 
  end proc: 
 
> with(RealDomain): 
Warning, these protected names have been redefined and unprotected: 
Im, Re, ^, arccos, arccosh, arccot, arccoth, arccsc, arccsch, arcsec, 
arcsech, arcsin, arcsinh, arctan, arctanh, cos, cosh, cot, coth, csc, 
csch, eval, exp, expand, limit, ln, log, sec, sech, signum, simplify, 
sin, sinh, solve, sqrt, surd, tan, tanh 
 
> S:=disassemble(disassemble(addressof(RealDomain))[2]): 
> LA:=[disassemble(S[4])][2..-1]: 
> LN:=map(u->extractName(u),LA): 
> map(u->extractMember(RealDomain,u),LN): 
> eval(%): 
 
> # infolevel[modifyM]:=3: 
 
> M:=modifyM(RealDomain,clean); 
 
                           M := RealDomain 
 
> with(M): 
Warning, these names have been rebound: 
Im, Re, ^, arccos, arccosh, arccot, arccoth, arccsc, arccsch, arcsec, 
arcsech, arcsin, arcsinh, arctan, arctanh, cos, cosh, cot, coth, csc, 
csch, eval, exp, expand, limit, ln, log, sec, sech, signum, simplify, 
sin, sinh, solve, sqrt, surd, tan, tanh 
 
> map( 
    print@op, 
    [ 
      seq( 
        [ 
          ['k'=k], 
          selectremove(has,[solve(x^4-k=0,x)],'undefined') 
        ], 
        k=0..16 
      ) 
    ] 
  ): 
 
                      [k = 0], [], [0, 0, 0, 0] 
 
               [k = 1], [undefined, undefined], [-1, 1] 
 
                                             (1/4)    (1/4) 
          [k = 2], [undefined, undefined], [2     , -2     ] 
 
                                             (1/4)    (1/4) 
          [k = 3], [undefined, undefined], [3     , -3     ] 
 
         [k = 4], [undefined, undefined], [sqrt(2), -sqrt(2)] 
 
                                             (1/4)    (1/4) 
          [k = 5], [undefined, undefined], [5     , -5     ] 
 
                                             (1/4)    (1/4) 
          [k = 6], [undefined, undefined], [6     , -6     ] 
 
                                             (1/4)    (1/4) 
          [k = 7], [undefined, undefined], [7     , -7     ] 
 
                                             (3/4)    (3/4) 
          [k = 8], [undefined, undefined], [2     , -2     ] 
 
         [k = 9], [undefined, undefined], [sqrt(3), -sqrt(3)] 
 
                                             (1/4)     (1/4) 
        [k = 10], [undefined, undefined], [10     , -10     ] 
 
                                             (1/4)     (1/4) 
        [k = 11], [undefined, undefined], [11     , -11     ] 
 
                                             (1/4)     (1/4) 
        [k = 12], [undefined, undefined], [12     , -12     ] 
 
                                             (1/4)     (1/4) 
        [k = 13], [undefined, undefined], [13     , -13     ] 
 
                                             (1/4)     (1/4) 
        [k = 14], [undefined, undefined], [14     , -14     ] 
 
                                             (1/4)     (1/4) 
        [k = 15], [undefined, undefined], [15     , -15     ] 
 
              [k = 16], [undefined, undefined], [-2, 2] 
 
> with(RealDomain): 
Warning, these names have been rebound: 
Im, Re, ^, arccos, arccosh, arccot, arccoth, arccsc, arccsch, arcsec, 
arcsech, arcsin, arcsinh, arctan, arctanh, cos, cosh, cot, coth, csc, 
csch, eval, exp, expand, limit, ln, log, sec, sech, signum, simplify, 
sin, sinh, solve, sqrt, surd, tan, tanh 
 
> map( 
    print@op, 
    [ 
      seq( 
        [ 
          ['k'=k], 
          selectremove(has,[solve(x^4-k=0,x)],'undefined') 
        ], 
        k=0..16 
      ) 
    ] 
  ): 
 
                           [k = 0], [], [0] 
 
                          [k = 1], [], [-1] 
 
                                       (1/4) 
                        [k = 2], [], [2     ] 
 
                                       (1/4) 
                        [k = 3], [], [3     ] 
 
                       [k = 4], [undefined], [] 
 
                                       (1/4) 
                        [k = 5], [], [5     ] 
 
                                       (1/4) 
                        [k = 6], [], [6     ] 
 
                                       (1/4) 
                        [k = 7], [], [7     ] 
 
                                       (3/4) 
                        [k = 8], [], [2     ] 
 
                       [k = 9], [undefined], [] 
 
                                        (1/4) 
                       [k = 10], [], [10     ] 
 
                                        (1/4) 
                       [k = 11], [], [11     ] 
 
                                        (1/4) 
                       [k = 12], [], [12     ] 
 
                                        (1/4) 
                       [k = 13], [], [13     ] 
 
                                        (1/4) 
                       [k = 14], [], [14     ] 
 
                                        (1/4) 
                       [k = 15], [], [15     ] 
 
                          [k = 16], [], [-2]
 

7.144.5 Helmut Kahovec (2.10.01)

In my previous reply, there are some loose input statements before modifyM() gets called:

> S:=disassemble(disassemble(addressof(RealDomain))[2]): 
> LA:=[disassemble(S[4])][2..-1]: 
> LN:=map(u->extractName(u),LA): 
> map(u->extractMember(RealDomain,u),LN): 
> eval(%):
 

Of course, they can be incorporated into modifyM():

> modifyM:=proc(M::`module`,loc::evaln) 
  local NAME,EXPSEQ,MODULE, 
        EXPORTS,MODULEDEF,LOCALS, 
        EXPORTSEQ,LOCALSEQ, 
        LEXICAL, 
        S,LA,LN,EVAL,InfoLevel,emax,lmax,Ae,Al,i,A,Name, 
        flag,esn,eso,lsn,lso,L,pos,IND,j,t; 
  option `Copyright (c) 2001 by Helmut Kahovec. All rights reserved.`; 
  # NAME,EXPSEQ,MODULE:=8,27,38; # Maple6 
    NAME,EXPSEQ,MODULE:=8,29,40; # Maple7 
    EXPORTS,MODULEDEF,LOCALS:=2,3,4; 
    EXPORTSEQ,LOCALSEQ:=5,3; 
    LEXICAL:=7; 
    S:=disassemble(disassemble(addressof(M))[2]); 
    LA:=[disassemble(S[LOCALS])][2..-1];              # <===!!!=== 
    LN:=map(u->extractName(u),LA);                    # <===!!!=== 
    map(u->extractMember(M,u),LN);                    # <===!!!=== 
    eval(%);                                          # <===!!!=== 
    EVAL:=u->pointto(disassemble(addressof(u))[2]); 
    InfoLevel:=3; 
                 ...
 

The rest of modifyM() remains the same. The other two helper procedures -- extractName() and extractMember() -- remain the same as well. Now fixing the bug in RealDomain is as follows (all output omitted):

> clean:=proc(expr) 
  options operator,arrow; 
    `if`(                               # <=== this line added === 
      nargs>1,                          # <=== this line added === 
      op(map(procname,[args])),         # <=== this line added === 
      `if`( 
        nargs=0, 
        NULL, 
        subsindets( 
          expr, 
          'anything', 
          proc(e) 
            if nargs<>1 then 
              op(map(procname,{args})) 
            else 
              if type(e,'complex(extended_numeric)') then 
                if type(e,'nonreal') then undefined 
                elif type(e,'embedded_real') then :-Re(e) 
                elif type(evalf(e),'embedded_real') then :-Re(e) 
                else RorU(e) 
                end if 
              elif hastype(e,'{undefined, nonreal}') then undefined 
              elif type(e,'negative^fraction') then convert(e,'surd') 
              else RorU(subs(0.*I=0.,e)) 
              end if 
            end if 
          end proc 
        ) 
      ) 
    )                                   # <=== this line added === 
  end proc: 
 
> extractMember(RealDomain,RorU); 
 
> RorU:=eval(%); 
 
> with(RealDomain): 
 
> # infolevel[modifyM]:=3: 
 
> M:=modifyM(RealDomain,clean); 
 
> with(M): 
 
> map( 
    print@op, 
    [ 
      seq( 
        [ 
          'k'=k, 
          selectremove(has,[solve(x^4-k=0,x)],'undefined') 
        ], 
        k=0..16 
      ) 
    ] 
  ): 
 
> with(RealDomain): 
 
> map( 
    print@op, 
    [ 
      seq( 
        [ 
          'k'=k, 
          selectremove(has,[solve(x^4-k=0,x)],'undefined') 
        ], 
        k=0..16 
      ) 
    ] 
  ): 
Sorry for this follow up!
 

7.144.6 Helmut Kahovec (25.10.01)

A while ago I posted a rather complicated method of fixing the underlying bug in RealDomain. Recently, I found that we could fix RealDomain in a surprisingly simple way. In the following Maple7 session we first reproduce the bug:

> restart; 
> :-solve(x^4-1,x); solve(x^4-1,x); simplify(sqrt(x^2)); 
 
                             -1, 1, I, -I 
                              csgn(x) x 
 
> use RealDomain in 
    :-solve(x^4-1,x); 
    solve(x^4-1,x); 
    simplify(sqrt(x^2)) 
  end use; 
 
                             -1, 1, I, -I 
                                  -1 
                                | x |
 

Next we show how to fix the bug. To this end we need two little helper procedures. The first one extracts the bare name of a Maple object of type ’name’. This means that extractName() strips off any attributes of a name:

> restart; 
 
> extractName:=proc(u) 
  option `Copyright (c) 2001 by Helmut Kahovec. All rights reserved.`; 
    convert(convert(u,string),name) 
  end proc:
 

The second one returns the exported or local member m of the module instance M. Choosing the name `&->` for this neutral operator was proposed by Carl DeVore:

> `&->`:=proc(M::`module`,m::evaln) 
  local E,L,pos; 
  option `Copyright (c) 2001 by Helmut Kahovec. All rights reserved.`; 
    E,L:=[op(1,eval(M))],[op(3,eval(M))]; 
    if member(m,map(extractName,L),'pos') then 
      L[pos] 
    else 
      if member(m,map(extractName,E),'pos') then 
        E[pos] 
      else 
        error "%1 is not a module member",m 
      end if 
    end if 
  end proc:
 

Now we assume that we have somehow found out that the bug of RealDomain is in the local procedure clean(). Hence we can define a global procedure clean() which fixes that bug:

> clean:=proc(expr) 
  options operator,arrow; 
    `if`(                                 # <=== this line added === 
      nargs>1,                            # <=== this line added === 
      op(map(procname,[args])),           # <=== this line added === 
      `if`( 
        nargs=0, 
        NULL, 
        subsindets( 
          expr, 
          'anything', 
          proc(e) 
            if nargs<>1 then 
              op(map(procname,{args})) 
            else 
              if type(e,'complex(extended_numeric)') then 
                if type(e,'nonreal') then undefined 
                elif type(e,'embedded_real') then :-Re(e) 
                elif type(evalf(e),'embedded_real') then :-Re(e) 
                else RorU(e) 
                end if 
              elif hastype(e,'{undefined, nonreal}') then undefined 
              elif type(e,'negative^fraction') then convert(e,'surd') 
              else RorU(subs(0.*I=0.,e)) 
              end if 
            end if 
          end proc 
        ) 
      ) 
    )                                     # <=== this line added === 
  end proc:
 

We note that our global clean() calls the procedure RorU(), which is also a local member of RealDomain. The next three input statements are crucial and

- assign the name of the local member clean() to the global name _clean, 
 
- substitute the local RorU() for the yet undefined global RorU() in the procedure definition of clean(), 
 
- assign the procedure definition of clean() to the local member clean() of RealDomain, 
 
- and finally clear the value of the global name 'clean':
 
> _clean:=RealDomain&->clean; 
 
                           _clean := clean 
 
> assign(_clean,subs(RorU=RealDomain&->RorU,eval(clean))); 
> clean:='clean'; 
 
                            clean := clean
 

Now the global name '_clean' evaluates to the name of the local member clean() of RealDomain, which in turn evaluates fully to the bug fixed procedure definition of clean(). This local clean() also calls the local member RorU() of RealDomain. Hence the local procedure clean() of RealDomain is defined and resides in memory even before RealDomain has actually been loaded.

> with(RealDomain): 
Warning, these protected names have been redefined and unprotected: 
Im, Re, ^, arccos, arccosh, arccot, arccoth, arccsc, arccsch, arcsec, 
arcsech, arcsin, arcsinh, arctan, arctanh, cos, cosh, cot, coth, csc, 
csch, eval, exp, expand, limit, ln, log, sec, sech, signum, simplify, 
sin, sinh, solve, sqrt, surd, tan, tanh
 

Note that the last input statement does not load the local member procedures of RealDomain. However, that step is necessary if we are going to save our module instance to a repository. When we now load the locals then the fact that clean() has already been defined prevents Maple from reading in clean() a second time. Thus we end up with a bug fixed RealDomain:

> [op(3,eval(RealDomain))]: eval(%):
 

In order to be able to use the corrected RealDomain without the need of going through all the steps shown above we save our module instance of RealDomain. We create a subdirectory of our current working directory (see ?mkdir and ?currentdir)

> RDlib:="./RD/lib": 
> mkdir("./RD"); mkdir(RDlib);
 

and place a Maple repository there (see ?repository,management):

> march('create',RDlib,1000);
 

We then save our module instance of RealDomain to this repository. Since we have not yet written any documenting worksheet accompanying our bug fix, savelib() issues an error message. Please, ignore it.

> savelibname:=RDlib: 
> savelib(RealDomain);
 

Next, we restart the Maple session and load our saved and corrected module instance of RealDomain.

> restart; 
> libname:="./RD/lib",libname; 
 
          libname := "./RD/lib", "C:\\Programme\\Maple7/lib"
 

Finally, we test our module instance of RealDomain:

> :-solve(x^4-1,x); solve(x^4-1,x); simplify(sqrt(x^2)); 
 
                             -1, 1, I, -I 
                              csgn(x) x 
 
> use RealDomain in 
    :-solve(x^4-1,x); 
    solve(x^4-1,x); 
    simplify(sqrt(x^2)) 
  end use; 
 
                             -1, 1, I, -I 
                     -1, 1, undefined, undefined 
                                | x |