diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/g-opt.boot | 40 | ||||
| -rw-r--r-- | src/interp/lisp-backend.boot | 56 |
2 files changed, 65 insertions, 31 deletions
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index fbdf5687..58700b52 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -399,25 +399,27 @@ optSuchthat [.,:u] == ["SUCHTHAT",:u] ++ List of VM side effect free operators. $VMsideEffectFreeOperators == '(SPADfirst ASH IDENTP FLOAT_-RADIX FLOAT FLOAT_-SIGN - CGREATERP GGREATERP %when %false %true - %otherwise %2bit %2bool - %and %or %not %peq %ieq %ilt %ile %igt %ige %head %tail %integer? - %beq %blt %ble %bgt %bge %bitand %bitior %bitnot %bcompl %ilength - %ibit %icst0 %icst1 - %imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc - %irem %iquo %idivide %idec - %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float? - %fpow %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc - %fsin %fcos %ftan %fcot %fsec %fcsc %fatan %facot - %fsinh %fcosh %ftanh %fcsch %fcoth %fsech %fasinh %facsch - %nil %pair? %lconcat %llength %lfirst %lsecond %lthird %listlit - %lreverse %lempty? %hash %ismall? %string? %f2s - %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %s2c %cup %cdown %sname - %strlength %streq %i2s %schar %strlt %strconc %strcopy %strstc - %aref %vref %vlength %veclit - %bitvecnot %bitvecand %bitvecnand %bivecor %bitvecnor %bitvecxor - %bitveccopy %bitvecconc %bitveclength %bitvecref %bitveceq %bitveclt - %before? %equal %sptreq %ident? %property) + %when %false %true %otherwise %2bit %2bool + %and %or %not %peq %ieq %ilt %ile %igt %ige %head %tail %integer? + %beq %blt %ble %bgt %bge %bitand %bitior %bitxor %bitnot %bcompl + %ilength %ibit %icst0 %icst1 + %imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc + %irem %iquo %idivide %idec + %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float? + %fpow %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc + %fsin %fcos %ftan %fcot %fsec %fcsc %fatan %facot + %fsinh %fcosh %ftanh %fcsch %fcoth %fsech %fasinh %facsch + %val2z %z2val %zlit %zreal %zimag + %zexp %zlog %zsin %zcos %ztan %zasin %zacos %zatan + %zsinh %zcosh %ztanh %zasinh %zacosh %zatanh + %nil %pair? %lconcat %llength %lfirst %lsecond %lthird %listlit + %lreverse %lempty? %hash %ismall? %string? %f2s + %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %s2c %cup %cdown %sname + %strlength %streq %i2s %schar %strlt %strconc %strcopy %strstc + %aref %vref %vlength %veclit + %bitvecnot %bitvecand %bitvecnand %bivecor %bitvecnor %bitvecxor + %bitveccopy %bitvecconc %bitveclength %bitvecref %bitveceq %bitveclt + %before? %equal %sptreq %ident? %property) ++ List of simple VM operators $simpleVMoperators == diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index 008ed3d1..a98ef3be 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -234,15 +234,6 @@ expandIlt ['%ilt,x,y] == expandIgt ['%igt,x,y] == expandIlt ['%ilt,y,x] -expandBitand ['%bitand,x,y] == - ['BOOLE,'BOOLE_-AND,expandToVMForm x,expandToVMForm y] - -expandBitior ['%bitior,x,y] == - ['BOOLE,'BOOLE_-IOR,expandToVMForm x,expandToVMForm y] - -expandBitnot ['%bitnot,x] == - ['LOGNOT,expandToVMForm x] - -- Floating point support expandFbase ['%fbase] == @@ -337,6 +328,24 @@ expandMakebitvec ['%makebitvec,x,y] == KEYWORD::ELEMENT_-TYPE,quoteForm '%Bit, KEYWORD::INITIAL_-ELEMENT,expandToVMForm y] +--% complex number conversions +--% An OpenAxiom complex number is a pair (real and imaginary parts.) + +-- convert an OpenAxiom complex number to a Lisp complex number +expandVal2z ['%val2z,x] == + cons? x => + g := gensym() + expandToVMForm ['%bind,[[g,x]],['%zlit,['%head,g],['%tail,g]]] + expandToVMForm ['%zlit,['%head,x],['%tail,x]] + +-- convert a Lisp complex number to an OpenAxiom complex number +expandZ2val ['%z2val,x] == + cons? x => + g := gensym() + expandToVMForm ['%bind,[[g,x]],['%makepair,['%zreal,g],['%zimag,g]]] + expandToVMForm ['%makepair,['%zreal,x],['%zimag,x]] + + -- Local variable bindings expandBind ['%bind,inits,:body] == body := expandToVMForm body @@ -445,6 +454,10 @@ for x in [ ['%iquo, :'TRUNCATE], ['%ipow, :'EXPT], ['%isub, :"-"], + ['%bitand, :'LOGAND], + ['%bitior, :'LOGIOR], + ['%bitxor, :'LOGXOR], + ['%bitnot, :'LOGNOT], -- unary float operations. ['%fabs, :'ABS], @@ -478,6 +491,25 @@ for x in [ ['%fasinh, :'ASINH], ['%facsch, :'ACSCH], + -- complex number operations + ['%zlit, :'COMPLEX], + ['%zreal, :'REALPART], + ['%zimag, :'IMAGPART], + ['%zexp, :'EXP], + ['%zlog, :'LOG], + ['%zsin, :'SIN], + ['%zcos, :'COS], + ['%ztan, :'TAN], + ['%zasin, :'ASIN], + ['%zacos, :'ACOS], + ['%zatan, :'ATAN], + ['%zsinh, :'SINH], + ['%zcosh, :'COSH], + ['%ztanh, :'TANH], + ['%zasinh, :'ASINH], + ['%zacosh, :'ACOSH], + ['%zatanh, :'ATANH], + -- string operations ['%f2s, :'DFLOAT_-FORMAT_-GENERAL], @@ -546,9 +578,6 @@ for x in [ ['%ilt, :function expandIlt], ['%ineg, :function expandIneg], ['%idivide, :function expandIdivide], - ['%bitand, :function expandBitand], - ['%bitior, :function expandBitior], - ['%bitnot, :function expandBitnot], ['%i2f, :function expandI2f], ['%fbase, :function expandFbase], @@ -561,6 +590,9 @@ for x in [ ['%fprec, :function expandFprec], ['%fcstpi, :function expandFcstpi], + ['%z2val, :function expandZ2val], + ['%val2z, :function expandVal2z], + ['%streq, :function expandStreq], ['%strlt, :function expandStrlt], ['%strstc, :function expandStrstc], |