# New Ticket Created by Andreas Rottmann # Please include the string: [perl #52666] # in the subject line of all future correspondence about this issue. # <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=52666 >
Well, the subject sais it all. For implementing EQ? efficiently (using the `issame' instruction), the compiler now emits `get_root_global' instructions to access the boolean and empty list values, and those are initialized when the program is loaded.
Implement equality primitives From: Andreas Rottmann <[EMAIL PROTECTED]> --- MANIFEST | 2 + languages/eclectus/compiler.scm | 83 ++++++++++++++++++++++++++++---------- languages/eclectus/t/equality.pl | 5 ++ languages/eclectus/t/equality.t | 15 +++++++ 4 files changed, 84 insertions(+), 21 deletions(-) create mode 100644 languages/eclectus/t/equality.pl create mode 100644 languages/eclectus/t/equality.t diff --git a/MANIFEST b/MANIFEST index 5a50f1f..4827a78 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1324,6 +1324,8 @@ languages/eclectus/t/conditionals.pl [eclectus] languages/eclectus/t/conditionals.t [eclectus] languages/eclectus/t/empty_list.pl [eclectus] languages/eclectus/t/empty_list.t [eclectus] +languages/eclectus/t/equality.pl [eclectus] +languages/eclectus/t/equality.t [eclectus] languages/eclectus/t/harness [eclectus] languages/eclectus/t/integers.pl [eclectus] languages/eclectus/t/integers.t [eclectus] diff --git a/languages/eclectus/compiler.scm b/languages/eclectus/compiler.scm index 2fee04e..fbb7295 100644 --- a/languages/eclectus/compiler.scm +++ b/languages/eclectus/compiler.scm @@ -63,7 +63,6 @@ $P0 = split ' ', 'post pir evalpmc' past_compiler.'stages'( $P0 ) past_compiler.'eval'(stmts) - .end "))) @@ -71,6 +70,16 @@ (define emit-builtins (lambda () (emit " + .sub '__initconst' :init + $P0 = new 'EclectusBoolean' + $P0 = 1 + set_root_global ['_eclectus'], '#t', $P0 + $P0 = new 'EclectusBoolean' + set_root_global ['_eclectus'], '#f', $P0 + $P0 = new 'EclectusEmptyList' + set_root_global ['_eclectus'], '()', $P0 + .end + .sub 'say' .param pmc args :slurpy if null args goto end @@ -127,6 +136,29 @@ .return ($I0) .end + .sub 'eq?' + .param pmc a + .param pmc b + $I0 = issame a, b + + .return ($I0) + .end + + .sub 'eqv?' + .param pmc a + .param pmc b + $I0 = iseq a, b + + .return ($I0) + .end + + .sub 'equal?' + .param pmc a + .param pmc b + $I0 = iseq a, b + + .return ($I0) + .end "))) ; recognition of forms @@ -308,7 +340,14 @@ (define-primitive (fx> arg1 arg2) (emit-comparison "infix:>" arg1 arg2)) +(define-primitive (eq? arg1 arg2) + (emit-comparison "eq?" arg1 arg2)) + +(define-primitive (eqv? arg1 arg2) + (emit-comparison "eqv?" arg1 arg2)) +(define-primitive (equal? arg1 arg2) + (emit-comparison "equal?" arg1 arg2)) ; asking for the type of an object (define emit-typequery @@ -371,26 +410,28 @@ (viviself "Undef")))) (define (emit-constant x) - (past::val - (cond - ((fixnum? x) - (quasiquote (@ (value (unquote x)) - (returns "EclectusFixnum")))) - ((char? x) - (quasiquote (@ (value (unquote (char->integer x))) - (returns "EclectusCharacter")))) - ((null? x) - '(@ (value 0) - (returns "EclectusEmptyList"))) - ((boolean? x) - (quasiquote (@ (value (unquote (if x 1 0))) - (returns "EclectusBoolean")))) - ((string? x) - (quasiquote (@ (value (unquote (format #f "'~a'" x))) - (returns "EclectusString")))) - ((vector? x) - (quasiquote (@ (value "'#0()'") - (returns "EclectusString"))))))) + (cond + ((fixnum? x) + (past::val `(@ (value ,x) + (returns "EclectusFixnum")))) + ((char? x) + (past::val `(@ (value ,(char->integer x)) + (returns "EclectusCharacter")))) + ((null? x) + (emit-global-ref "()")) + ((boolean? x) + (emit-global-ref (if x "#t" "#f"))) + ((string? x) + (past::val `(@ (value (unquote (format #f "'~a'" x))) + (returns "EclectusString")))) + ((vector? x) + (past::val '(@ (value "'#0()'") + (returns "EclectusString")))))) + + +(define (emit-global-ref name) + (past::op `(@ (pasttype "inline") + (inline ,(format #f "%r = get_root_global ['_eclectus'], '~a'" name))))) (define bindings (lambda (x) diff --git a/languages/eclectus/t/equality.pl b/languages/eclectus/t/equality.pl new file mode 100644 index 0000000..bae4864 --- /dev/null +++ b/languages/eclectus/t/equality.pl @@ -0,0 +1,5 @@ +#!/usr/bin/env perl + +# $Id$ + +do 'eclectus/test-wrapper.pl'; diff --git a/languages/eclectus/t/equality.t b/languages/eclectus/t/equality.t new file mode 100644 index 0000000..9dd3510 --- /dev/null +++ b/languages/eclectus/t/equality.t @@ -0,0 +1,15 @@ +; $Id$ + +(load "tests-driver.scm") ; this should come first + +(add-tests-with-string-output "equality" + ((eq? #t #t) => "#t\n") + ((eq? #t #f) => "#f\n") + ((eq? '() '()) => "#t\n") + + ((eqv? #\A #\A) => "#t\n") + ((eqv? 42 42) => "#t\n") +) + +(load "compiler.scm") +(test-all)
Regards, Rotty -- Andreas Rottmann | [EMAIL PROTECTED] | [EMAIL PROTECTED] | [EMAIL PROTECTED] http://rotty.uttx.net | GnuPG Key: http://rotty.uttx.net/gpg.asc Fingerprint | C38A 39C5 16D7 B69F 33A3 6993 22C8 27F7 35A9 92E7 v2sw7MYChw5pr5OFma7u7Lw2m5g/l7Di6e6t5BSb7en6g3/5HZa2Xs6MSr1/2p7 hackerkey.com Python is executable pseudocode, Perl is executable line-noise.