diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/define.boot | 4 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 3 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 14 | ||||
| -rw-r--r-- | src/interp/nrunfast.boot | 18 |
4 files changed, 26 insertions, 13 deletions
diff --git a/src/interp/define.boot b/src/interp/define.boot index 4ce7412c..0e62db1d 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -1620,7 +1620,7 @@ compJoin(["Join",:argl],m,e) == atom y => isDomainForm(y,e) => [y] nil - y is ['LENGTH,y'] => [y,y'] + y is [op,y'] and op in '(LENGTH %llength) => [y,y'] [y] x x is ["DomainSubstitutionMacro",pl,body] => diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 84db991f..8bed62d1 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -439,6 +439,7 @@ $VMsideEffectFreeOperators == QEQCAR QCDR QCAR IDENTP SYMBOLP GREATERP ZEROP ODDP FLOAT_-RADIX FLOAT FLOAT_-SIGN CGREATERP GGREATERP CHAR GET BVEC_-GREATER %when %false %true + %2bit %2bool %and %or %not %peq %ieq %ilt %ile %igt %ige %head %tail %integer? %beq %blt %ble %bgt %bge %bitand %bitior %bitnot %bcompl %icst0 %icst1 diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index e405f304..fb98bc83 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -349,6 +349,9 @@ expandFlt ['%flt,x,y] == expandFgt ['%fgt,x,y] == expandFlt ['%flt,y,x] +expandFcstpi ['%fcstpi] == + ['COERCE,'PI,quoteForm '%DoubleFloat] + -- String operations ++ string equality comparison @@ -425,10 +428,12 @@ for x in [ -- ['%false, :'NIL], ['%true, :'T], -- unary Boolean operations - ['%not, :'NOT], + ['%not, :'NOT], + ['%2bit, :'TRUTH_-TO_-BIT], + ['%2bool, :'BIT_-TO_-TRUTH], -- binary Boolean operations - ['%and, :'AND], - ['%or, :'OR], + ['%and, :'AND], + ['%or, :'OR], -- character operations ['%ceq, :'CHAR_=], @@ -572,6 +577,7 @@ for x in [ ['%fminval, :function expandFminval], ['%fneg, :function expandFneg], ['%fprec, :function expandFprec], + ['%fcstpi, :function expandFcstpi], ['%streq, :function expandStreq], ['%strlt, :function expandStrlt], diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 7d87308b..1d9151d3 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -90,11 +90,12 @@ getOpCode(op,vec,max) == evalSlotDomain(u,dollar) == $returnNowhereFromGoGet: local := false $ : fluid := dollar -- ??? substitute - $lookupDefaults : local := nil -- new world + $lookupDefaults : local := false -- new world u = '$ => dollar u = "$$" => dollar FIXP u => - vector? (y := dollar.u) => y + y := dollar.u + vector? y => y y is ["setShellEntry",:.] => eval y --lazy domains need to marked; this is dangerous? y is ['SETELT,:.] => systemErrorHere "evalSlotDomain" @@ -105,7 +106,7 @@ evalSlotDomain(u,dollar) == lazyDomainSet(y,dollar,u) --new style has lazyt y y - u is ['NRTEVAL,y] => eval y + u is ['NRTEVAL,y] => eval y u is ['QUOTE,y] => y u is ['Record,:argl] => apply('Record,[[":",tag,evalSlotDomain(dom,dollar)] @@ -114,7 +115,11 @@ evalSlotDomain(u,dollar) == apply('Union,[['_:,tag,evalSlotDomain(dom,dollar)] for [.,tag,dom] in argl]) u is ["Enumeration",:.] => eval u - u is [op,:argl] => apply(op,[evalSlotDomain(x,dollar) for x in argl]) + cons? u => + -- The domain form may value arguments, get VM form first. + u := expandToVMForm u + cons? u => apply(u.op,[evalSlotDomain(x,dollar) for x in u.args]) + u systemErrorHere '"evalSlotDomain" --======================================================= @@ -474,7 +479,8 @@ lazyMatch(source,lazyt,dollar,domain) == string? source and lazyt is ['QUOTE,=source] => true integer? source => lazyt is ['_#, slotNum] => source = #(domain.slotNum) - lazyt is ['%call,'LENGTH, slotNum] => source = #(domain.slotNum) + lazyt is ['%call,f,slotNum] and f in '(LENGTH %llength) => + source = #(domain.slotNum) nil -- A hideous hack on the same lines as the previous four lines JHD/MCD |