# New Ticket Created by Andreas Rottmann
# Please include the string: [perl #52664]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=52664 >
The attached patch fixes quoting - only chars, numbers strings and
booleans are self-evaluating, lists (including the empty list) and
vectors must be quoted.
Implement quotating, and make () (without quote) a syntax error
From: Andreas Rottmann <[EMAIL PROTECTED]>
---
languages/eclectus/compiler.scm | 92 ++++++++++++++++---------------
languages/eclectus/t/conditionals.t | 2 -
languages/eclectus/t/empty_list.t | 4 +
languages/eclectus/t/harness | 4 +
languages/eclectus/t/pair.t | 2 -
languages/eclectus/t/unary_primitives.t | 10 ++-
languages/eclectus/t/vectors.t | 2 -
7 files changed, 58 insertions(+), 58 deletions(-)
diff --git a/languages/eclectus/compiler.scm b/languages/eclectus/compiler.scm
index db7a069..2fee04e 100644
--- a/languages/eclectus/compiler.scm
+++ b/languages/eclectus/compiler.scm
@@ -136,17 +136,11 @@
(and (pair? form)
(eq? name (car form))))))
-(define if?
- (make-combination-predicate 'if))
-
-(define let?
- (make-combination-predicate 'let))
-
-(define lambda?
- (make-combination-predicate 'lambda))
-
-(define begin?
- (make-combination-predicate 'begin))
+(define if? (make-combination-predicate 'if))
+(define let? (make-combination-predicate 'let))
+(define lambda? (make-combination-predicate 'lambda))
+(define begin? (make-combination-predicate 'begin))
+(define quote? (make-combination-predicate 'quote))
(define if-test
(lambda (form)
@@ -160,6 +154,12 @@
(lambda (form)
(car (cdr (cdr (cdr form))))))
+(define (self-evaluating? x)
+ (or (string? x)
+ (number? x)
+ (char? x)
+ (boolean? x)))
+
; Support for primitive functions
(define-record primitive (arg-count emitter))
@@ -365,34 +365,32 @@
(emit-expr arg))
(cdr x)))))
-
-; emit PIR for a scalar
-(define emit-atom
- (lambda (x)
- ((if (symbol? x) past::var 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"))))
- ((symbol? x)
- (quasiquote (@ (name (unquote x))
- (scope "lexical")
- (viviself "Undef"))))
- ((string? x)
- (quasiquote (@ (value (unquote (format #f "'~a'" x)))
- (returns "EclectusString"))))
- ((vector? x)
- (quasiquote (@ (value "'#0()'")
- (returns "EclectusString"))))))))
+(define (emit-variable x)
+ (past::var `(@ (name ,x)
+ (scope "lexical")
+ (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")))))))
(define bindings
(lambda (x)
@@ -464,13 +462,15 @@
(lambda (x)
;(diag (format "emit-expr: ~s" x))
(cond
- ((atom? x) (emit-atom x))
- ((let? x) (emit-let (bindings x) (body x)))
- ((if? x) (emit-if x))
- ((begin? x) (emit-begin x))
- ((lambda? x) (emit-lambda x))
- ((primcall? x) (emit-primcall x))
- (else (emit-functional-application x)))))
+ ((symbol? x) (emit-variable x))
+ ((quote? x) (emit-constant (cadr x)))
+ ((self-evaluating? x) (emit-constant x))
+ ((let? x) (emit-let (bindings x) (body x)))
+ ((if? x) (emit-if x))
+ ((begin? x) (emit-begin x))
+ ((lambda? x) (emit-lambda x))
+ ((primcall? x) (emit-primcall x))
+ (else (emit-functional-application x)))))
; transverse the program and rewrite
; "and" can be supported by transformation before compiling
diff --git a/languages/eclectus/t/conditionals.t b/languages/eclectus/t/conditionals.t
index 0e54d0a..b4e3017 100644
--- a/languages/eclectus/t/conditionals.t
+++ b/languages/eclectus/t/conditionals.t
@@ -43,7 +43,7 @@
((if (if #f #f #t) 1 0) => "1\n" )
((if (if #t #f #f) 1 0) => "0\n" )
((if #f (if #t #f #f) #t) => "#t\n" )
- ((if () #f #t) => "#f\n" )
+ ((if '() #f #t) => "#f\n" )
)
(test-all)
diff --git a/languages/eclectus/t/empty_list.t b/languages/eclectus/t/empty_list.t
index 265f966..4359021 100644
--- a/languages/eclectus/t/empty_list.t
+++ b/languages/eclectus/t/empty_list.t
@@ -3,8 +3,8 @@
(load "tests-driver.scm") ; this should come first
; there have to be nine tests, as the number of tests is hardcoded in test-driver.scm
-(add-tests-with-string-output "booleans"
- (() => "()\n"))
+(add-tests-with-string-output "empty list"
+ ('() => "()\n"))
(load "compiler.scm")
(test-all)
diff --git a/languages/eclectus/t/harness b/languages/eclectus/t/harness
index c74367a..2e0af05 100644
--- a/languages/eclectus/t/harness
+++ b/languages/eclectus/t/harness
@@ -30,9 +30,9 @@ use lib qw( ../lib ../../lib ../../lib );
use Parrot::Test::Harness
language => 'eclectus',
- exec => [ 'petite', '--script' ],
+ #exec => [ 'petite', '--script' ],
#exec => [ 'guile', '--debug', '-l', 'guile/prelude.scm', '-s' ],
- #exec => [ 'gosh', '-fcase-fold', '-I', '.', '-l', 'gauche/prelude.scm' ],
+ exec => [ 'gosh', '-fcase-fold', '-I', '.', '-l', 'gauche/prelude.scm' ],
files => [ 't/*.pl' ];
=head1 SEE ALSO
diff --git a/languages/eclectus/t/pair.t b/languages/eclectus/t/pair.t
index 825149d..e977546 100644
--- a/languages/eclectus/t/pair.t
+++ b/languages/eclectus/t/pair.t
@@ -3,7 +3,7 @@
(load "tests-driver.scm") ; this should come first
(add-tests-with-string-output "booleans"
- ((pair? ()) => "#f\n")
+ ((pair? '()) => "#f\n")
((pair? #\A) => "#f\n")
((pair? (fx+ 1 2)) => "#f\n")
((pair? (pair? (fx+ 1 2))) => "#f\n")
diff --git a/languages/eclectus/t/unary_primitives.t b/languages/eclectus/t/unary_primitives.t
index 0d42407..2953009 100644
--- a/languages/eclectus/t/unary_primitives.t
+++ b/languages/eclectus/t/unary_primitives.t
@@ -31,21 +31,21 @@
((fxzero? 1) => "#f\n" )
((fxzero? (char->fixnum #\A)) => "#f\n" )
- ((null? ()) => "#t\n" )
+ ((null? '()) => "#t\n" )
((null? (fxsub1 1)) => "#f\n" )
((null? (fxsub1 10)) => "#f\n" )
((null? #\A) => "#f\n" )
((null? 65) => "#f\n" )
((null? (char->fixnum #\A)) => "#f\n" )
- ((fixnum? ()) => "#f\n" )
+ ((fixnum? '()) => "#f\n" )
((fixnum? (fxsub1 1)) => "#t\n" )
((fixnum? (fxsub1 10)) => "#t\n" )
((fixnum? #\A) => "#f\n" )
((fixnum? 65) => "#t\n" )
((fixnum? (char->fixnum #\A)) => "#t\n" )
- ((boolean? ()) => "#f\n" )
+ ((boolean? '()) => "#f\n" )
((boolean? (fxsub1 1)) => "#f\n" )
((boolean? (fxsub1 10)) => "#f\n" )
((boolean? #\A) => "#f\n" )
@@ -56,7 +56,7 @@
((boolean? (fixnum? #\A)) => "#t\n" )
((boolean? (fixnum? 65)) => "#t\n" )
- ((char? ()) => "#f\n" )
+ ((char? '()) => "#f\n" )
((char? (fxsub1 1)) => "#f\n" )
((char? (fxsub1 10)) => "#f\n" )
((char? #\A) => "#t\n" )
@@ -70,7 +70,7 @@
((not 1) => "#f\n" )
((not 0) => "#f\n" )
- ((not ()) => "#f\n" )
+ ((not '()) => "#f\n" )
((not (fxsub1 1)) => "#f\n" )
((not (fxsub1 10)) => "#f\n" )
((not #\A) => "#f\n" )
diff --git a/languages/eclectus/t/vectors.t b/languages/eclectus/t/vectors.t
index 5f3ce77..0f4e245 100644
--- a/languages/eclectus/t/vectors.t
+++ b/languages/eclectus/t/vectors.t
@@ -3,7 +3,7 @@
(load "tests-driver.scm") ; this should come first
(add-tests-with-string-output "vectors"
- (#() => "#0()\n")
+ ('#() => "#0()\n")
)
(load "compiler.scm")
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
It's *GNU*/Linux dammit!
