~ chicken-core (chicken-5) 77e3855c5d4328af6275b2a18b4440054638b32a

commit 77e3855c5d4328af6275b2a18b4440054638b32a
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Jan 30 11:56:05 2015 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Fri Jan 30 11:56:05 2015 +0100

    added posq/posv to mini-srfi-1.scm and fixed a few bugs, but optimizer seems to be broken.

diff --git a/c-backend.scm b/c-backend.scm
index d012a09d..e81ab4df 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -463,7 +463,8 @@
 	(let loop ((xs args))
 	  (unless (null? xs)
 	    (unless (eq? xs args) (gen #\,))
-	    (expr (car xs) i) )))
+	    (expr (car xs) i)
+	    (loop (cdr xs)))))
 
       (expr node temps) )
   
@@ -1153,7 +1154,8 @@
     (let loop ((vs vlist) (ts argtypes))
       (unless (null? vs)
 	(gen (foreign-type-declaration (car ts) (car vs)))
-	(when (pair? (cdr vs)) (gen #\,)) ))
+	(when (pair? (cdr vs)) (gen #\,))
+	(loop (cdr vs) (cdr ts))))
     (gen #\)) ) )
 
 
diff --git a/eval.scm b/eval.scm
index ff047a84..ce66ce22 100644
--- a/eval.scm
+++ b/eval.scm
@@ -50,6 +50,7 @@
 <#
 
 (include "common-declarations.scm")
+(include "mini-srfi-1.scm")
 
 (define-syntax d (syntax-rules () ((_ . _) (void))))
 
diff --git a/mini-srfi-1.scm b/mini-srfi-1.scm
index 4534ebf7..1b20c441 100644
--- a/mini-srfi-1.scm
+++ b/mini-srfi-1.scm
@@ -30,7 +30,7 @@
 	first second third fourth alist-cons delete-duplicates fifth
 	filter filter-map unzip1 last list-index lset-adjoin lset-difference
 	lset-union lset-intersection list-tabulate lset<= lset= length+ find find-tail
-	iota make-list))
+	iota make-list posq posv))
 
 
 (define (partition pred lst)
@@ -47,7 +47,7 @@
 
 (define (take lst n)
   (if (fx<= n 0)
-      lst
+      '()
       (cons (car lst) (take lst (fx- n 1)))))
 
 (define (drop lst n)
@@ -216,3 +216,16 @@
 
 (define (make-list n x)
   (list-tabulate n (lambda _ x)))
+
+(define (posq x lst)
+  (let loop ((i 0) (lst lst))
+    (cond ((null? lst) #f)
+	  ((eq? (car lst) x) i)
+	  (else (loop (fx+ i 1) (cdr lst))))))
+
+(define (posv x lst)
+  (let loop ((i 0) (lst lst))
+    (cond ((null? lst) #f)
+	  ((eqv? (car lst) x) i)
+	  (else (loop (fx+ i 1) (cdr lst))))))
+
diff --git a/optimizer.scm b/optimizer.scm
index 5c480819..d0d1d55d 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -1072,8 +1072,8 @@
 				vars) ) ) )
 			   (make-node 'let 
 				      (list (car names))
-				      (list (car callargs))
-				      (loop (cdr callargs) (cdr names))))))))))
+				      (list (car callargs)
+					    (loop (cdr callargs) (cdr names)))))))))))
 
     ;; (<op> a [b]) -> (<primitiveop> a (quote <i>) b)
     ((10) ; classargs = (<primitiveop> <i> <bvar> <safe>)
diff --git a/rules.make b/rules.make
index 5a61887d..0eef0c99 100644
--- a/rules.make
+++ b/rules.make
@@ -541,7 +541,7 @@ bootstrap-lib = $(CHICKEN) $(call profile-flags, $@) $< $(CHICKEN_LIBRARY_OPTION
 
 library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations.scm
 	$(bootstrap-lib)
-eval.c: $(SRCDIR)eval.scm $(SRCDIR)common-declarations.scm
+eval.c: $(SRCDIR)eval.scm $(SRCDIR)common-declarations.scm $(SRCDIR)mini-srfi-1.scm
 	$(bootstrap-lib)
 expand.c: $(SRCDIR)expand.scm $(SRCDIR)synrules.scm $(SRCDIR)common-declarations.scm
 	$(bootstrap-lib)
diff --git a/support.scm b/support.scm
index 678575b5..bffedf43 100644
--- a/support.scm
+++ b/support.scm
@@ -32,7 +32,7 @@
 (module chicken.compiler.support
     (compiler-cleanup-hook bomb collected-debugging-output debugging
      debugging-chicken with-debugging-output quit-compiling
-     emit-syntax-trace-info check-signature posq posv stringify symbolify
+     emit-syntax-trace-info check-signature stringify symbolify
      build-lambda-list string->c-identifier c-ify-string valid-c-identifier?
      bytes->words words->bytes
      check-and-open-input-file close-checked-input-file fold-inner
@@ -196,19 +196,6 @@
 
 ;;; Generic utility routines:
 
-;; XXX: Don't posq and posv belong better in library or data-structures?
-(define (posq x lst)
-  (let loop ([lst lst] [i 0])
-    (cond [(null? lst) #f]
-	  [(eq? x (car lst)) i]
-	  [else (loop (cdr lst) (add1 i))] ) ) )
-
-(define (posv x lst)
-  (let loop ([lst lst] [i 0])
-    (cond [(null? lst) #f]
-	  [(eqv? x (car lst)) i]
-	  [else (loop (cdr lst) (add1 i))] ) ) )
-
 (define (stringify x)
   (cond ((string? x) x)
 	((symbol? x) (symbol->string x))