Added (make-parameter) and (let*)

cyclone.scm

@@ -15,6 +15,7 @@
  (chicken
    (require-extension extras) ;; pretty-print
    (require-extension chicken-syntax) ;; when
+   (require-extension srfi-1) ;; every
    (load (string-append (cyc:get-lib-dir) "parser.so"))
    (load (string-append (cyc:get-lib-dir) "libraries.so"))
    (load (string-append (cyc:get-lib-dir) "trans.so"))

scheme/base.sld

@@ -50,6 +50,7 @@
     vector->list
     vector->string
     string->vector
+    make-parameter
     error
     raise
     raise-continuable
@@ -264,6 +265,20 @@
                       fill)))
         (list->string
           (apply make-list (cons k fill*)))))
+    (define (make-parameter init . o)
+      (let* ((converter
+               (if (pair? o) (car o) (lambda (x) x)))
+             (value (converter init)))
+        (lambda args
+          (cond
+            ((null? args)
+             value)
+            ((eq? (car args) '<param-set!>)
+             (set! value (cadr args)))
+            ((eq? (car args) '<param-convert>)
+             converter)
+           (else
+             (error "bad parameter syntax"))))))
     (define (error msg . args)
       (raise (cons msg args)))
     (define (raise obj)

trans.scm

@@ -31,6 +31,21 @@
                           (rename 'tmp)
                           (cons (rename 'or) (cddr expr))))))))
     (cons 'let (lambda (exp rename compare) (let=>lambda exp)))
+    (cons 'let*
+      (lambda (expr rename compare)
+        (if (null? (cdr expr)) (error "empty let*" expr))
+        (if (null? (cddr expr)) (error "no let* body" expr))
+        (if (null? (cadr expr))
+            `(,(rename 'let) () ,@(cddr expr))
+            (if (if (list? (cadr expr))
+                    (every
+                     (lambda (x)
+                       (if (pair? x) (if (pair? (cdr x)) (null? (cddr x)) #f) #f))
+                     (cadr expr))
+                    #f)
+                `(,(rename 'let) (,(caar (cdr expr)))
+                  (,(rename 'let*) ,(cdar (cdr expr)) ,@(cddr expr)))
+                (error "bad let* syntax")))))
     (cons 'begin (lambda (exp rename compare) (begin=>let exp)))
     (cons 'letrec (lambda (exp rename compare) (letrec=>lets+sets exp)))
     (cons 'cond