The quoting.patch contained a spurious change to t/harness; the new, attached patch fixes this.
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/pair.t | 2 - languages/eclectus/t/unary_primitives.t | 10 ++- languages/eclectus/t/vectors.t | 2 - 6 files changed, 56 insertions(+), 56 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/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 Always be wary of the Software Engineer who carries a screwdriver. -- Robert Paul