~ chicken-core (chicken-5) e24b7dbb69765501ba4ff4c5c806d45a843caf80
commit e24b7dbb69765501ba4ff4c5c806d45a843caf80 Author: Felix <bunny351@gmail.com> AuthorDate: Sun Oct 11 00:00:36 2009 +0200 Commit: Felix <bunny351@gmail.com> CommitDate: Sun Oct 11 00:00:36 2009 +0200 make-lambda-info is fine in eval.scm diff --git a/.gitignore b/.gitignore index 77661160..09a690ed 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ .svn *.o *.so +*~ diff --git a/eval.scm b/eval.scm index 1e91db10..d5a6a916 100644 --- a/eval.scm +++ b/eval.scm @@ -76,7 +76,7 @@ ##sys#make-c-string ##sys#resolve-include-filename ##sys#load ##sys#error ##sys#warn ##sys#hash-table-location ##sys#expand-home-path ##sys#make-flonum ##sys#make-pointer ##sys#null-pointer ##sys#address->pointer - ##sys#pointer->address ##sys#compile-to-closure ##sys#make-string ##sys#make-lambda-info ##sys#lambda-info? + ##sys#pointer->address ##sys#compile-to-closure ##sys#make-string ##sys#make-lambda-info ##sys#number? ##sys#symbol->qualified-string ##sys#decorate-lambda ##sys#string-append ##sys#ensure-heap-reserve ##sys#syntax-error-hook ##sys#read-prompt-hook ##sys#repl-eval-hook ##sys#append ##sys#eval-decorator @@ -215,7 +215,7 @@ (define (##sys#eval-decorator p ll h cntr) (##sys#decorate-lambda p - ##sys#lambda-info? + (lambda (x) (and (not (##sys#immediate? x)) (##core#inline "C_lambdainfop" x))) (lambda (p i) (##sys#setslot p i @@ -1807,3 +1807,13 @@ (define-external (CHICKEN_get_error_message ((c-pointer "char") buf) (int bufsize)) void (store-string (or last-error "No error") bufsize buf) ) + + +;;; Create lambda-info object + +(define (##sys#make-lambda-info str) + (let* ((sz (##sys#size str)) + (info (##sys#make-string sz)) ) + (##core#inline "C_copy_memory" info str sz) + (##core#inline "C_string_to_lambdainfo" info) + info) ) diff --git a/library.scm b/library.scm index e00c2020..f9d4b797 100644 --- a/library.scm +++ b/library.scm @@ -155,7 +155,7 @@ EOF ##sys#intern-symbol ##sys#make-string ##sys#number? software-type build-platform open-output-string get-output-string print-call-chain ##sys#symbol-has-toplevel-binding? repl argv condition-property-accessor ##sys#decorate-lambda ##sys#become! ##sys#lambda-decoration - getter-with-setter ##sys#lambda-info? ##sys#lambda-info ##sys#lambda-info->string open-input-string ##sys#gc + getter-with-setter ##sys#lambda-info ##sys#lambda-info->string open-input-string ##sys#gc ##sys#memory-info ##sys#make-c-string ##sys#find-symbol-table display newline string-append ##sys#with-print-length-limit write print vector-fill! ##sys#context-switch ##sys#set-finalizer! open-output-string get-output-string read ##sys#make-pointer @@ -4613,18 +4613,10 @@ EOF ;;; Function debug info: -(define (##sys#make-lambda-info str) - (let* ((sz (##sys#size str)) - (info (##sys#make-string sz)) ) - (##core#inline "C_copy_memory" info str sz) - (##core#inline "C_string_to_lambdainfo" info) - info) ) - -(define (##sys#lambda-info? x) - (and (not (##sys#immediate? x)) (##core#inline "C_lambdainfop" x)) ) - (define (##sys#lambda-info proc) - (##sys#lambda-decoration proc ##sys#lambda-info?) ) + (##sys#lambda-decoration + proc + (lambda (x) (and (not (##sys#immediate? x)) (##core#inline "C_lambdainfop" x))) ) ) (define (##sys#lambda-info->string info) (let* ((sz (##sys#size info))Trap