~ 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