Changeset 12948 in project

Timestamp:

01/07/09 10:59:13 (12 years ago)

Author:

felix winkelmann

Message:

special length procedure in compiler to compute llist lengths (reported by Peter Bex); updated bootstrap tarball

Location:

chicken/trunk

Files:

• bootstrap.tar.gz (modified) (previous)
• compiler.scm (modified) (3 diffs)
• optimizer.scm (modified) (2 diffs)
• support.scm (modified) (2 diffs)

chicken/trunk/compiler.scm

@@ -271 +271 @@
   compiler-arguments process-command-line explicit-use-flag
   default-standard-bindings default-extended-bindings
-  foldable-bindings
+  foldable-bindings llist-length
   installation-home decompose-lambda-list external-to-pointer defconstant-bindings constant-declarations
   copy-node! error-is-extended-binding toplevel-scope toplevel-lambda-id
@@ -1236 +1236 @@
              (##sys#check-syntax 'lambda lexp '(lambda lambda-list . #(_ 1)) #f se)
              (let ([llist (cadr lexp)])
-               (if (and (proper-list? llist) (= (length llist) (length args)))
+               (if (and (proper-list? llist) (= (llist-length llist) (length args)))
                    (walk `(,(macro-alias 'let se)
                            ,(map list llist args) ,@(cddr lexp)) se dest)
@@ -2176 +2176 @@
                                                      (= (length refs) (length sites)) 
                                                      (proper-list? llist) ) ] )
-                                          (when (and name custom (not (= (length llist) (length (cdr subs)))))
+                                          (when (and name 
+                                                     custom
+                                                     (not (= (llist-length llist) (length (cdr subs)))))
                                             (quit
                                              "known procedure called with wrong number of arguments: ~A" 

chicken/trunk/optimizer.scm

@@ -31 +31 @@
   compiler-arguments process-command-line perform-lambda-lifting!
   default-standard-bindings default-extended-bindings
-  foldable-bindings
+  foldable-bindings llist-length
   installation-home decompose-lambda-list external-to-pointer
   copy-node! variable-visible? mark-variable intrinsic?
@@ -363 +363 @@
                                       [(and (test fid 'explicit-rest)
                                             (not (memq n rest-consers)) ) ; make sure we haven't inlined rest-list already
-                                       (let ([n (length llist)])
+                                       (let ([n (llist-length llist)])
                                          (if (< (length args) n)
                                              (walk-generic n class params subs)

chicken/trunk/support.scm

@@ -67 +67 @@
   generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
   foreign-argument-conversion foreign-result-conversion final-foreign-type debugging
-  constant-declarations process-lambda-documentation big-fixnum? sort-symbols
+  constant-declarations process-lambda-documentation big-fixnum? sort-symbols llist-length
   export-dump-hook intrinsic? node->sexpr emit-global-inline-file inline-max-size
   make-random-name foreign-type-convert-result foreign-type-convert-argument)
@@ -302 +302 @@
 (define (process-lambda-documentation id doc proc)
   proc)                                 ; Hook this
+
+(define (llist-length llist)
+  (##core#inline "C_u_i_length" llist))