aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/g-opt.boot40
-rw-r--r--src/interp/lisp-backend.boot56
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],