~ chicken-core (chicken-5) 69fe4239f0160c2dd0a3d54132eb4dbaf8f6ac86
commit 69fe4239f0160c2dd0a3d54132eb4dbaf8f6ac86
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Jun 23 10:48:12 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Jun 23 10:48:12 2011 +0200
generalized introduction of temporaries in rewrite-rule, also allows backrefs; rewrite fp-div into fp/? (new); updated test-files
diff --git a/c-platform.scm b/c-platform.scm
index d1a0d253..3aba549e 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -133,7 +133,7 @@
(define default-extended-bindings
'(bitwise-and alist-cons xcons
bitwise-ior bitwise-xor bitwise-not add1 sub1 fx+ fx- fx* fx/
- fx+? fx-? fx*? fx/? fxmod o
+ fx+? fx-? fx*? fx/? fxmod o fp/?
fx= fx> fx< fx>= fx<= fixnum? fxneg fxmax fxmin identity fp+ fp- fp* fp/ fpmin fpmax fpneg
fp> fp< fp= fp>= fp<= fxand fxnot fxior fxxor fxshr fxshl bit-set? fxodd? fxeven?
fpfloor fpceiling fptruncate fpround fpsin fpcos fptan fpasin fpacos fpatan
@@ -709,6 +709,7 @@
(rewrite 'fp- 16 2 "C_a_i_flonum_difference" #f words-per-flonum)
(rewrite 'fp* 16 2 "C_a_i_flonum_times" #f words-per-flonum)
(rewrite 'fp/ 16 2 "C_a_i_flonum_quotient" #f words-per-flonum)
+(rewrite 'fp/? 16 2 "C_a_i_flonum_quotient_checked" #f words-per-flonum)
(rewrite 'fpneg 16 1 "C_a_i_flonum_negate" #f words-per-flonum)
(rewrite 'exp 16 1 "C_a_i_exp" #t words-per-flonum)
diff --git a/chicken.h b/chicken.h
index fbf3d0dd..2f5f0474 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1799,6 +1799,7 @@ C_fctexport C_word C_fcall C_i_o_fixnum_and(C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_i_o_fixnum_ior(C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_i_o_fixnum_xor(C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_a_i_flonum_round_proper(C_word **a, int c, C_word n) C_regparm;
+C_fctexport C_word C_fcall C_a_i_flonum_quotient_checked(C_word **ptr, int c, C_word n1, C_word n2) C_regparm;
C_fctexport C_word C_fcall C_i_getprop(C_word sym, C_word prop, C_word def) C_regparm;
C_fctexport C_word C_fcall C_putprop(C_word **a, C_word sym, C_word prop, C_word val) C_regparm;
C_fctexport C_word C_fcall C_i_get_keyword(C_word key, C_word args, C_word def) C_regparm;
diff --git a/library.scm b/library.scm
index 79578cc4..4249fff6 100644
--- a/library.scm
+++ b/library.scm
@@ -771,6 +771,10 @@ EOF
(fp-check-flonums x y 'fp/)
(##core#inline_allocate ("C_a_i_flonum_quotient" 4) x y) )
+(define (fp/? x y) ; undocumented
+ (fp-check-flonums x y 'fp/?)
+ (##core#inline_allocate ("C_a_i_flonum_quotient_checked" 4) x y) )
+
(define (fp= x y)
(fp-check-flonums x y 'fp=)
(##core#inline "C_flonum_equalp" x y) )
diff --git a/runtime.c b/runtime.c
index 30dbc70f..9a45a44b 100644
--- a/runtime.c
+++ b/runtime.c
@@ -9299,3 +9299,13 @@ C_filter_heap_objects(C_word c, C_word closure, C_word k, C_word func, C_word ve
C_fromspace_top = C_fromspace_limit; /* force major GC */
C_reclaim((void *)filter_heap_objects_2, NULL);
}
+
+
+C_regparm C_word C_fcall
+C_a_i_flonum_quotient_checked(C_word **ptr, int c, C_word n1, C_word n2)
+{
+ double n3 = C_flonum_magnitude(n2);
+
+ if(n3 == 0.0) barf(C_DIVISION_BY_ZERO_ERROR, "fp/?");
+ else return C_flonum(ptr, C_flonum_magnitude(n1) / n3);
+}
diff --git a/scrutinizer.scm b/scrutinizer.scm
index d42ffd00..b1198940 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -1139,12 +1139,19 @@
(else #f))))
(define (specialize-node! node template)
- (let ((args (cdr (node-subexpressions node))))
+ (let ((args (cdr (node-subexpressions node)))
+ (env '()))
(define (subst x)
(cond ((and (vector? x)
- (= 1 (vector-length x))
- (integer? (vector-ref x 0)))
- (list-ref args (sub1 (vector-ref x 0))))
+ (= 1 (vector-length x)) )
+ (let ((y (vector-ref x 0)))
+ (cond ((integer? y) (list-ref args (sub1 y)))
+ ((symbol? y)
+ (cond ((assq y env) => cdr)
+ (else
+ (let ((var (gensym y)))
+ (set! env (alist-cons y var env))
+ var)))))))
((and (vector? x)
(= 2 (vector-length x))
(integer? (vector-ref x 0))
diff --git a/support.scm b/support.scm
index fe1a03cb..05246b4f 100644
--- a/support.scm
+++ b/support.scm
@@ -471,7 +471,7 @@
(define (qnode const) (make-node 'quote (list const) '()))
(define (build-node-graph exp)
- (let ([count 0])
+ (let ((count 0))
(define (walk x)
(cond ((symbol? x) (varnode x))
((node? x) x)
@@ -495,13 +495,14 @@
[body (caddr x)] )
(if (null? bs)
(walk body)
- (make-node 'let
- (map (lambda (v)
- ;; for temporaries introduced by specialization
- (if (eq? '#:tmp v) (gensym) v))
- (unzip1 bs))
- (append (map (lambda (b) (walk (cadr b))) (cadr x))
- (list (walk body)) ) ) ) ) )
+ (make-node
+ 'let
+ (map (lambda (v)
+ ;; for temporaries introduced by specialization
+ (if (eq? '#:tmp v) (gensym) v)) ; OBSOLETE
+ (unzip1 bs))
+ (append (map (lambda (b) (walk (cadr b))) (cadr x))
+ (list (walk body)) ) ) ) ) )
((lambda ##core#lambda)
(make-node 'lambda (list (cadr x)) (list (walk (caddr x)))))
((##core#the)
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index 3596b460..b0b64e38 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -1,69 +1,69 @@
Note: at toplevel:
- pair?: in procedure call to `pair?', the predicate is called with an argument of type `pair' and will always return true
+ in procedure call to `pair?', the predicate is called with an argument of type `pair' and will always return true
Note: at toplevel:
- pair?: in procedure call to `pair?', the predicate is called with an argument of type `null' and will always return false
+ in procedure call to `pair?', the predicate is called with an argument of type `null' and will always return false
Note: at toplevel:
- pair?: in procedure call to `pair?', the predicate is called with an argument of type `fixnum' and will always return false
+ in procedure call to `pair?', the predicate is called with an argument of type `fixnum' and will always return false
Note: at toplevel:
- pair?: in procedure call to `pair?', the predicate is called with an argument of type `float' and will always return false
+ in procedure call to `pair?', the predicate is called with an argument of type `float' and will always return false
Note: at toplevel:
- list?: in procedure call to `list?', the predicate is called with an argument of type `list' and will always return true
+ in procedure call to `list?', the predicate is called with an argument of type `list' and will always return true
Note: at toplevel:
- list?: in procedure call to `list?', the predicate is called with an argument of type `fixnum' and will always return false
+ in procedure call to `list?', the predicate is called with an argument of type `fixnum' and will always return false
Note: at toplevel:
- list?: in procedure call to `list?', the predicate is called with an argument of type `float' and will always return false
+ in procedure call to `list?', the predicate is called with an argument of type `float' and will always return false
Note: at toplevel:
- null?: in procedure call to `null?', the predicate is called with an argument of type `null' and will always return true
+ in procedure call to `null?', the predicate is called with an argument of type `null' and will always return true
Note: at toplevel:
- null?: in procedure call to `null?', the predicate is called with an argument of type `pair' and will always return false
+ in procedure call to `null?', the predicate is called with an argument of type `pair' and will always return false
Note: at toplevel:
- null?: in procedure call to `null?', the predicate is called with an argument of type `fixnum' and will always return false
+ in procedure call to `null?', the predicate is called with an argument of type `fixnum' and will always return false
Note: at toplevel:
- null?: in procedure call to `null?', the predicate is called with an argument of type `float' and will always return false
+ in procedure call to `null?', the predicate is called with an argument of type `float' and will always return false
Note: at toplevel:
- fixnum?: in procedure call to `fixnum?', the predicate is called with an argument of type `fixnum' and will always return true
+ in procedure call to `fixnum?', the predicate is called with an argument of type `fixnum' and will always return true
Note: at toplevel:
- fixnum?: in procedure call to `fixnum?', the predicate is called with an argument of type `float' and will always return false
+ in procedure call to `fixnum?', the predicate is called with an argument of type `float' and will always return false
Note: at toplevel:
- exact?: in procedure call to `exact?', the predicate is called with an argument of type `fixnum' and will always return true
+ in procedure call to `exact?', the predicate is called with an argument of type `fixnum' and will always return true
Note: at toplevel:
- exact?: in procedure call to `exact?', the predicate is called with an argument of type `float' and will always return false
+ in procedure call to `exact?', the predicate is called with an argument of type `float' and will always return false
Note: at toplevel:
- flonum?: in procedure call to `flonum?', the predicate is called with an argument of type `float' and will always return true
+ in procedure call to `flonum?', the predicate is called with an argument of type `float' and will always return true
Note: at toplevel:
- flonum?: in procedure call to `flonum?', the predicate is called with an argument of type `fixnum' and will always return false
+ in procedure call to `flonum?', the predicate is called with an argument of type `fixnum' and will always return false
Note: at toplevel:
- inexact?: in procedure call to `inexact?', the predicate is called with an argument of type `float' and will always return true
+ in procedure call to `inexact?', the predicate is called with an argument of type `float' and will always return true
Note: at toplevel:
- inexact?: in procedure call to `inexact?', the predicate is called with an argument of type `fixnum' and will always return false
+ in procedure call to `inexact?', the predicate is called with an argument of type `fixnum' and will always return false
Note: at toplevel:
- number?: in procedure call to `number?', the predicate is called with an argument of type `fixnum' and will always return true
+ in procedure call to `number?', the predicate is called with an argument of type `fixnum' and will always return true
Note: at toplevel:
- number?: in procedure call to `number?', the predicate is called with an argument of type `float' and will always return true
+ in procedure call to `number?', the predicate is called with an argument of type `float' and will always return true
Note: at toplevel:
- number?: in procedure call to `number?', the predicate is called with an argument of type `number' and will always return true
+ in procedure call to `number?', the predicate is called with an argument of type `number' and will always return true
Note: at toplevel:
- number?: in procedure call to `number?', the predicate is called with an argument of type `null' and will always return false
+ in procedure call to `number?', the predicate is called with an argument of type `null' and will always return false
diff --git a/tests/scrutiny-tests.scm b/tests/scrutiny-tests.scm
index dea73fe7..dfa87ba6 100644
--- a/tests/scrutiny-tests.scm
+++ b/tests/scrutiny-tests.scm
@@ -101,4 +101,4 @@
(string-append (the pair (substring x 0 10))) ; 1
(the * (values 1 2)) ; 1 + 2
(the * (values)) ; 3
- (the fixnum (* x y))) ; nothing
+ (the fixnum (* x y))) ; nothing (but warns about "x" being string)
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 47294d4a..9325c771 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -43,7 +43,7 @@ Warning: at toplevel:
expected in `let' binding of `g8' a single result, but were given 2 results
Warning: at toplevel:
- g89: in procedure call to `g89', expected a value of type `(procedure () *)', but was given a value of type `fixnum'
+ in procedure call to `g89', expected a value of type `(procedure () *)', but was given a value of type `fixnum'
Warning: in toplevel procedure `foo2':
scrutiny-tests.scm:57: in procedure call to `string-append', expected argument #1 of type `string', but was given an argument of type `number'
@@ -66,7 +66,7 @@ Warning: at toplevel:
Warning: in toplevel procedure `foo9':
scrutiny-tests.scm:97: in procedure call to `+', expected argument #1 of type `number', but was given an argument of type `string'
-Warning: in toplevel procedure `foo10':
+Note: in toplevel procedure `foo10':
expression returns a result of type `string', but is declared to return `pair', which is not a subtype
Warning: in toplevel procedure `foo10':
@@ -75,7 +75,7 @@ Warning: in toplevel procedure `foo10':
Warning: in toplevel procedure `foo10':
expression returns 2 values but is declared to have a single result
-Warning: in toplevel procedure `foo10':
+Note: in toplevel procedure `foo10':
expression returns a result of type `fixnum', but is declared to return `*', which is not a subtype
Warning: in toplevel procedure `foo10':
@@ -85,3 +85,13 @@ Warning: in toplevel procedure `foo10':
scrutiny-tests.scm:104: in procedure call to `*', expected argument #1 of type `number', but was given an argument of type `string'
Warning: redefinition of standard binding: car
+
+Warning: (in k161) constant-folding expression results in error: "bad argument type": (+ (quote a) (quote b))
+
+Warning: (in k171) constant-folding expression results in error: "bad argument type - not a string": (string-append (quote 99) (quote "abc"))
+
+Warning: (in k171) constant-folding expression results in error: "bad argument type - not a string": (string-append (quote 99) (quote "abc"))
+
+Warning: (in k171) constant-folding expression results in error: "bad argument type - not a string": (string-append (quote 99) (quote "abc"))
+
+Warning: (in k171) constant-folding expression results in error: "bad argument type - not a string": (string-append (quote 99) (quote "abc"))
diff --git a/types.db b/types.db
index 62cd4746..e39749e0 100644
--- a/types.db
+++ b/types.db
@@ -29,9 +29,9 @@
; - numeric types are disjoint, "fixnum" or "float" will not match "number" in the
; rewrite rules
; - for a description of the type-specifier syntax, see "scrutinizer.scm" (top of file)
-; - in templates, "#(INDEX)" refers to the INDEXth argument (starting from 1)
-; - in templates "(let ((#:tmp X)) ...)" binds X to a temporary variable, you can not
-; refer to this variable inside the template
+; - in templates, "#(INTEGER)" refers to the INTEGERth argument (starting from 1)
+; - in templates "#(SYMBOL)" binds X to a temporary gensym'd variable, further references
+; to "#(SYMBOL)" allow backreferences to this generated identifier
; - a type of the form "(procedure! ...)" is internally treated like "(procedure ..."
; but declares the procedure as "argument-type enforcing"
; - a type of the form "(procedure? TYPE ...)" is internally treated like "(procedure ..."
@@ -42,7 +42,7 @@
;; scheme
(not (procedure not (*) boolean)
- (((not boolean)) (let ((#:tmp #(1))) '#t)))
+ (((not boolean)) (let ((#(tmp) #(1))) '#t)))
(boolean? (procedure? boolean boolean? (*) boolean))
@@ -122,7 +122,7 @@
;;XXX predicate?
(integer? (procedure integer? (*) boolean)
- ((fixnum) (let ((#:tmp #(1))) '#t))
+ ((fixnum) (let ((#(tmp) #(1))) '#t))
((float) (##core#inline "C_u_i_fpintegerp" #(1))))
(exact? (procedure? fixnum exact? (*) boolean))
@@ -132,7 +132,7 @@
;;XXX predicate?
(rational? (procedure rational? (*) boolean)
- ((fixnum) (let ((#:tmp #(1))) '#t)))
+ ((fixnum) (let ((#(tmp) #(1))) '#t)))
(zero? (procedure! zero? (number) boolean)
((fixnum) (eq? #(1) '0))
@@ -213,16 +213,16 @@
(/ (procedure! / (number #!rest number) number)
((float fixnum) (float)
(##core#inline_allocate
- ("C_a_i_flonum_quotient" 4)
+ ("C_a_i_flonum_quotient_checked" 4)
#(1)
(##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
((fixnum float) (float)
(##core#inline_allocate
- ("C_a_i_flonum_quotient" 4)
+ ("C_a_i_flonum_quotient_checked" 4)
(##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
#(2)))
((float float) (float)
- (##core#inline_allocate ("C_a_i_flonum_quotient" 4) #(1) #(2))))
+ (##core#inline_allocate ("C_a_i_flonum_quotient_checked" 4) #(1) #(2))))
(= (procedure! = (#!rest number) boolean)
((fixnum fixnum) (eq? #(1) #(2)))
@@ -487,7 +487,7 @@
(char-ready? (procedure! char-ready? (#!optional port) boolean))
(imag-part (procedure! imag-part (number) number)
- ((or fixnum float number) (let ((#:tmp #(1))) '0)))
+ ((or fixnum float number) (let ((#(tmp) #(1))) '0)))
(real-part (procedure! real-part (number) number)
((or fixnum float number) #(1)))
@@ -502,7 +502,7 @@
((fixnum) (fixnum) #(1)))
(denominator (procedure! denominator (number) number)
- ((fixnum) (fixnum) (let ((#:tmp #(1))) '1)))
+ ((fixnum) (fixnum) (let ((#(tmp) #(1))) '1)))
(scheme-report-environment (procedure! scheme-report-environment (#!optional fixnum) *))
(null-environment (procedure! null-environment (#!optional fixnum) *))
@@ -849,44 +849,44 @@
((pointer) #(1)))
(##sys#check-blob (procedure! ##sys#check-blob (blob #!optional *) *)
- ((blob) (let ((#:tmp #(1))) '#t))
- ((blob *) (let ((#:tmp #(1))) '#t)))
+ ((blob) (let ((#(tmp) #(1))) '#t))
+ ((blob *) (let ((#(tmp) #(1))) '#t)))
(##sys#check-pair (procedure! ##sys#check-pair (pair #!optional *) *)
- ((pair) (let ((#:tmp #(1))) '#t))
- ((pair *) (let ((#:tmp #(1))) '#t)))
+ ((pair) (let ((#(tmp) #(1))) '#t))
+ ((pair *) (let ((#(tmp) #(1))) '#t)))
(##sys#check-list (procedure! ##sys#check-list (list #!optional *) *)
- (((or null pair list)) (let ((#:tmp #(1))) '#t))
- (((or null pair list) *) (let ((#:tmp #(1))) '#t)))
+ (((or null pair list)) (let ((#(tmp) #(1))) '#t))
+ (((or null pair list) *) (let ((#(tmp) #(1))) '#t)))
(##sys#check-string (procedure! ##sys#check-string (string #!optional *) *)
- ((string) (let ((#:tmp #(1))) '#t))
- ((string) * (let ((#:tmp #(1))) '#t)))
+ ((string) (let ((#(tmp) #(1))) '#t))
+ ((string) * (let ((#(tmp) #(1))) '#t)))
(##sys#check-number (procedure! ##sys#check-number (number #!optional *) *)
- ((number) (let ((#:tmp #(1))) '#t))
- ((number *) (let ((#:tmp #(1))) '#t)))
+ ((number) (let ((#(tmp) #(1))) '#t))
+ ((number *) (let ((#(tmp) #(1))) '#t)))
(##sys#check-exact (procedure! ##sys#check-exact (fixnum #!optional *) *)
- ((fixnum) (let ((#:tmp #(1))) '#t))
- ((fixnum *) (let ((#:tmp #(1))) '#t)))
+ ((fixnum) (let ((#(tmp) #(1))) '#t))
+ ((fixnum *) (let ((#(tmp) #(1))) '#t)))
(##sys#check-inexact (procedure! ##sys#check-inexact (float #!optional *) *)
- ((float) (let ((#:tmp #(1))) '#t))
- ((float *) (let ((#:tmp #(1))) '#t)))
+ ((float) (let ((#(tmp) #(1))) '#t))
+ ((float *) (let ((#(tmp) #(1))) '#t)))
(##sys#check-symbol (procedure! ##sys#check-symbol (symbol #!optional *) *)
- ((symbol) (let ((#:tmp #(1))) '#t))
- ((symbol *) (let ((#:tmp #(1))) '#t)))
+ ((symbol) (let ((#(tmp) #(1))) '#t))
+ ((symbol *) (let ((#(tmp) #(1))) '#t)))
(##sys#check-vector (procedure! ##sys#check-vector (vector #!optional *) *)
- ((vector) (let ((#:tmp #(1))) '#t))
- ((vector *) (let ((#:tmp #(1))) '#t)))
+ ((vector) (let ((#(tmp) #(1))) '#t))
+ ((vector *) (let ((#(tmp) #(1))) '#t)))
(##sys#check-char (procedure! ##sys#check-char (char #!optional *) *)
- ((char) (let ((#:tmp #(1))) '#t))
- ((char *) (let ((#:tmp #(1))) '#t)))
+ ((char) (let ((#(tmp) #(1))) '#t))
+ ((char *) (let ((#(tmp) #(1))) '#t)))
(##sys#check-boolean (procedure! ##sys#check-boolean (boolean #!optional *) *)
- ((boolean) (let ((#:tmp #(1))) '#t))
- ((boolean *) (let ((#:tmp #(1))) '#t)))
+ ((boolean) (let ((#(tmp) #(1))) '#t))
+ ((boolean *) (let ((#(tmp) #(1))) '#t)))
(##sys#check-locative (procedure! ##sys#check-locative (locative #!optional *) *)
- ((locative) (let ((#:tmp #(1))) '#t))
- ((locative *) (let ((#:tmp #(1))) '#t)))
+ ((locative) (let ((#(tmp) #(1))) '#t))
+ ((locative *) (let ((#(tmp) #(1))) '#t)))
(##sys#check-closure (procedure! ##sys#check-closure (procedure #!optional *) *)
- ((procedure) (let ((#:tmp #(1))) '#t))
- ((procedure *) (let ((#:tmp #(1))) '#t)))
+ ((procedure) (let ((#(tmp) #(1))) '#t))
+ ((procedure *) (let ((#(tmp) #(1))) '#t)))
;; data-structures
@@ -898,11 +898,11 @@
(always? (procedure always? (#!rest) boolean))
(any? (procedure any? (*) boolean)
- ((*) (let ((#:tmp #(1))) '#t)))
+ ((*) (let ((#(tmp) #(1))) '#t)))
(atom? (procedure atom? (*) boolean)
- ((pair) (let ((#:tmp #(1))) '#f))
- (((not (or pair list))) (let ((#:tmp #(1))) '#t)))
+ ((pair) (let ((#(tmp) #(1))) '#f))
+ (((not (or pair list))) (let ((#(tmp) #(1))) '#t)))
(binary-search (procedure! binary-search (vector (procedure (*) *)) *))
(butlast (procedure! butlast (pair) list))
@@ -928,7 +928,7 @@
(never? (procedure never? (#!rest) boolean))
(none? (procedure none? (*) boolean)
- ((*) (let ((#:tmp #(1))) '#f)))
+ ((*) (let ((#(tmp) #(1))) '#f)))
(o (procedure! o (#!rest (procedure (*) *)) (procedure (*) *)))
@@ -1179,7 +1179,7 @@
((pointer) (##core#inline "C_pointer_to_object" #(1))))
(pointer-like? (procedure pointer-like? (*) boolean)
- (((or pointer locative procedure port)) (let ((#:tmp #(1))) '#t)))
+ (((or pointer locative procedure port)) (let ((#(tmp) #(1))) '#t)))
(pointer-f32-ref (procedure! pointer-f32-ref (pointer) number))
(pointer-f32-set! (procedure! pointer-f32-set! (pointer number) undefined))
@@ -1204,7 +1204,7 @@
(pointer-s8-set! (procedure! pointer-s8-set! (pointer fixnum) undefined))
(pointer-tag (procedure! pointer-tag ((or pointer locative procedure port)) (or boolean number))
- (((or locative procedure port)) (let ((#:tmp #(1))) '#f)))
+ (((or locative procedure port)) (let ((#(tmp) #(1))) '#f)))
(pointer-u16-ref (procedure! pointer-u16-ref (pointer) fixnum))
(pointer-u16-set! (procedure! pointer-u16-set! (pointer fixnum) undefined))
@@ -1499,7 +1499,7 @@
(circular-list (procedure circular-list (#!rest) list))
(circular-list? (procedure circular-list? (*) boolean)
- ((null) (let ((#:tmp #(1))) '#f)))
+ ((null) (let ((#(tmp) #(1))) '#f)))
(concatenate (procedure! concatenate (list) list))
(concatenate! (procedure! concatenate! (list) list))
@@ -1556,13 +1556,13 @@
(ninth (procedure! ninth (pair) *))
(not-pair? (procedure not-pair? (*) boolean)
- ((pair) (let ((#:tmp #(1))) '#f))
- (((not (or pair list))) (let ((#:tmp #(1))) '#t)))
+ ((pair) (let ((#(tmp) #(1))) '#f))
+ (((not (or pair list))) (let ((#(tmp) #(1))) '#t)))
(null-list? (procedure! null-list? (list) boolean)
- ((pair) (let ((#:tmp #(1))) '#f))
- ((list) (let ((#:tmp #(1))) '#f))
- ((null) (let ((#:tmp #(1))) '#t)))
+ ((pair) (let ((#(tmp) #(1))) '#f))
+ ((list) (let ((#(tmp) #(1))) '#f))
+ ((null) (let ((#(tmp) #(1))) '#t)))
(pair-fold (procedure! pair-fold (procedure * list #!rest list) *))
(pair-fold-right (procedure! pair-fold-right (procedure * list #!rest list) *))
@@ -1571,7 +1571,7 @@
(partition! (procedure! partition! ((procedure (*) *) list) list list))
(proper-list? (procedure proper-list? (*) boolean)
- ((null) (let ((#:tmp #(1))) '#t)))
+ ((null) (let ((#(tmp) #(1))) '#t)))
(reduce (procedure! reduce ((procedure (* *) *) * list) *))
(reduce-right (procedure! reduce-right ((procedure (* *) *) * list) *))
Trap