A LONG time ago, after an Apocalypse far, far away, I tried to define
many built-in operators in Perl 6 to see if I "got it". After A12 I
think I get it enough to try at least the math ops again.

Everything in this file about modules and emitting IMCC is total
arm-waving, and there's no exporting going on at all... this is just a
mock-up, but I'm interested in hearing if any of this is wrong in terms
of:

      * Type handling
      * Operator naming (e.g. ~^, etc)
      * multiness

For right now, I have only added three functions that do not exist in an
apocalypse or Perl 5, but they're defined in perlfun in terms of Perl
and in the Parrot opcode set, so I think it's fair (acos, asin, tan).

Enjoy!

-- 
Aaron Sherman <[EMAIL PROTECTED]>
Senior Systems Engineer and Toolsmith
"It's the sound of a satellite saying, 'get me down!'" -Shriekback

#
# Math operations
#
# Written by Aaron Sherman <[EMAIL PROTECTED]> (c) 2004
# Distributed under the same terms as Perl itslef.

# For efficiency we declare as multi both object and basic type versions of any
# functions that will modify their arguments.

# There's a valid argument that:
#
#       my Dog $x = 1;
#       my $y = !$x;
#
# Should not strip the objectness of $x, and that $y should also
# be a Dog... this COULD be done, but has not been. I'm still thinking
# about it, as the other argument is that if Dog wanted that, it would
# define its own &prefix:! with appropriate semantics, after all we don't
# know what a not-Dog is... perhaps it's a Cat and perhaps it's a Vet.
# Same goes for most math ops that don't modify their arguments. -ajs

module Math {

        # Arm-waving about code generation begins....
        use IMCC::Emit; # Provides the macro, "emit"

        # Some generic setup that should be moved to IMCC::Emit
        sub as_imcc(str $op, $target is rw, [EMAIL PROTECTED]) is inline {
                emit($op,$target,[EMAIL PROTECTED]);
                return $target;
        }
        sub as_imcc_tmp(str $op, [EMAIL PROTECTED]) is inline { my $ret; return 
as_imcc($op,$ret,@_) }
        sub as_imcc_save(str $op, $target is rw, [EMAIL PROTECTED]) is inline {
                my $tmp = $target;
                as_imcc($op,$target,@_);
                return $tmp;
        }
        # Arm-waving about code-generation ends.

        # Define both num and int versions to take advantage of the
        # different Parrot-level ops. IMCC lets us call these by the
        # same name, and dispatches based on type.

        # Simple math
        multi sub abs (num $n) returns(num) { as_imcc("abs",$n) }
        multi sub abs (int $n) returns(int) { as_imcc("abs",$n) }
        multi sub exp (num $n) returns(num) { as_imcc("exp",$n) }
        multi sub exp (int $n) returns(int) { as_imcc("exp",$n) }

        sub log (num $n) returns(num) { as_imcc("log",$n) }
        sub rand(num $max=1) returns(num) { as_imcc("rand",$max) }
        sub sqrt(num $n) returns(num) { as_imcc("sqrt",$n) }
        sub srand(int $seed) { as_imcc("srand",$seed) }

        sub int (num $n) returns(int) { $n }

        # Operators
        multi sub prefix:+ (Num $val) returns(Num) { $val }
        multi sub infix:+ (num $n, num $m) returns(num) { as_imcc("add",$n,$m) }
        multi sub infix:- (num $n, num $m) returns(num) { as_imcc("sub",$n,$m) }
        multi sub infix:+ (int $n, int $m) returns(int) { as_imcc("add",$n,$m) }
        multi sub infix:- (int $n, int $m) returns(int) { as_imcc("sub",$n,$m) }
        multi sub infix:* (num $n, num $m) returns(num) { as_imcc("mul",$n,$m) }
        multi sub infix:/ (num $n, num $m) returns(num) { as_imcc("div",$n,$m) }
        multi sub infix:* (int $n, int $m) returns(int) { as_imcc("mul",$n,$m) }
        multi sub infix:/ (int $n, int $m) returns(int) { as_imcc("div",$n,$m) }
        multi sub infix:** (int $n, int $m) returns(int) { as_imcc("pow",$n,$m) }
        multi sub infix:** (num $n, num $m) returns(num) { as_imcc("pow",$n,$m) }
        multi sub infix:% (num $n, num $m) returns(num) { as_imcc("mod",$n,$m) }
        multi sub infix:% (int $n, int $m) returns(int) { as_imcc("mod",$n,$m) }

        multi sub infix:+< (int $n, int $bits) returns(int) { as_imcc("shl",$n,$bits) }
        multi sub infix:+> (int $n, int $bits) returns(int) { as_imcc("shr",$n,$bits) }

        multi sub infix:< (num $n, num $m) returns(num) { as_imcc("lt",$n,$m) }
        multi sub infix:< (int $n, int $m) returns(int) { as_imcc("lt",$n,$m) }
        multi sub infix:> (num $n, num $m) returns(num) { as_imcc("gt",$n,$m) }
        multi sub infix:> (int $n, int $m) returns(int) { as_imcc("gt",$n,$m) }
        multi sub infix:<= (num $n, num $m) returns(num) { as_imcc("le",$n,$m) }
        multi sub infix:<= (int $n, int $m) returns(int) { as_imcc("le",$n,$m) }
        multi sub infix:>= (num $n, num $m) returns(num) { as_imcc("ge",$n,$m) }
        multi sub infix:>= (int $n, int $m) returns(int) { as_imcc("ge",$n,$m) }
        multi sub infix:== (num $n, num $m) returns(num) { as_imcc("eq",$n,$m) }
        multi sub infix:== (int $n, int $m) returns(int) { as_imcc("eq",$n,$m) }
        multi sub infix:!= (num $n, num $m) returns(num) { as_imcc("ne",$n,$m) }
        multi sub infix:!= (int $n, int $m) returns(int) { as_imcc("ne",$n,$m) }
        multi sub infix:<=> (num $n, num $m) returns(num) { as_imcc("cmp",$n,$m) }
        multi sub infix:<=> (int $n, int $m) returns(int) { as_imcc("cmp",$n,$m) }

        multi sub prefix:++ (int $n is rw) returns (int) { as_imcc("inc",$n) }
        multi sub prefix:++ (Int $n is rw) returns (Int) { as_imcc("inc",$n) }
        multi sub prefix:++ (num $n is rw) returns (num) { as_imcc("inc",$n) }
        multi sub prefix:++ (Num $n is rw) returns (Num) { as_imcc("inc",$n) }
        multi sub prefix:-- (int $n is rw) returns (int) { as_imcc("dec",$n) }
        multi sub prefix:-- (Int $n is rw) returns (Int) { as_imcc("dec",$n) }
        multi sub prefix:-- (num $n is rw) returns (num) { as_imcc("dec",$n) }
        multi sub prefix:-- (Num $n is rw) returns (Num) { as_imcc("dec",$n) }
        multi sub postfix:++ (int $n is rw) returns (int) { as_imcc_save("inc",$n) }
        multi sub postfix:++ (Int $n is rw) returns (Int) { as_imcc_save("inc",$n) }
        multi sub postfix:++ (num $n is rw) returns (num) { as_imcc_save("inc",$n) }
        multi sub postfix:++ (Num $n is rw) returns (Num) { as_imcc_save("inc",$n) }
        multi sub postfix:-- (int $n is rw) returns (int) { as_imcc_save("dec",$n) }
        multi sub postfix:-- (Int $n is rw) returns (Int) { as_imcc_save("dec",$n) }
        multi sub postfix:-- (num $n is rw) returns (num) { as_imcc_save("dec",$n) }
        multi sub postfix:-- (Num $n is rw) returns (Num) { as_imcc_save("dec",$n) }

        # Some basic trig, probably augmented by a standard Math::Trig::*
        # set of libs
        module Trig {
                sub acos(num $n) returns(num) { as_imcc("acos",$n) }
                sub asin(num $n) returns(num) { as_imcc("asin",$n) }
                sub atan2(num $y, num $x) returns(num) { as_imcc_tmp("atan",$y,$x) }
                sub cos(num $n) returns(num) { as_imcc("cos",$n) }
                sub sin (num $n) returns(num) { as_imcc("sin",$n) }
                sub tan (num $n) returns(num) { as_imcc("tan",$n) }
        }

        # All of the logic operators. This doesn't count list-management functions
        # like grep which will be defined in List
        module Logic {
                sub prefix:? (bool $val) returns(bool) { $val }
                sub prefix:not (bool $n) returns(bool) { !$n }
                sub prefix:! (bool $n) returns(bool) { as_imcc("not",$n) }

                # These try not to mess with type at all...
                sub infix:and ($a, $b) { $a && $b }
                sub infix:or ($a, $b) { $a || $b }
                sub infix:xor ($a, $b) { as_imcc("xor",$a,$b) }
                sub infix:&& ($a, $b) { as_imcc("and",$a,$b) }
                sub infix:|| ($a, $b) { as_imcc("or",$a,$b) }

                sub infix:?& (bool $a, bool $b) returns(bool) { as_imcc("and",$a,$b) }
                sub infix:?| (bool $a, bool $b) returns(bool) { as_imcc("or",$a,$b) }
                sub infix:?^ (bool $n, bool $m) returns(bool) { as_imcc("xor",$n,$m) }
                sub prefix:?^ (bool $n) returns(bool) { as_imcc("not",$n) }
        }

        # Bitwise logic and bit-vector manipulation
        module Bits {
                sub infix:+& (int $n, int $m) returns(int) { as_imcc("band",$n,$m) }
                sub infix:+| (num $n, num $m) returns(int) { as_imcc("bor",$n,$m) }
                sub prefix:+^ (int $n) returns(int) { as_imcc("bnot",$n) }
                sub infix:+^ (int $n, int $m) returns(int) { as_imcc("bxor",$n,$m) }

                # These look like string functions, but are really bit-vector math
                sub infix:~& (str $n, str $m) returns(str) { as_imcc("band",$n,$m) }
                sub infix:~| (str $n, str $m) returns(str) { as_imcc("bor",$n,$m) }
                sub prefix:~^ (str $n) returns(str) { as_imcc("bnot",$n) }
                sub infix:~^ (str $n, str $m) returns(str) { as_imcc("bxor",$n,$m) }

                # TBA
                sub vec(Str $v is rw, int $off, int $bits) is rw($new) returns str 
{...}
        }
}

Attachment: signature.asc
Description: This is a digitally signed message part

Reply via email to