Checkpoint before unquote-splicing

bin/pre.slime

@@ -12,20 +12,24 @@
       (pair elem (repeat (- times 1) elem))))
   (pair 'begin (repeat times action)))
 
-;; (define (fib n))
-;; (define-syntax define (name :rest value)
-;;   (print name)
-;;   (print (type name))
-;;   (if (= (type name) :pair)
-;;       (begin
-;;        ;; (print `(define ,(first name) ,`(pair lambda (pair (rest name) value))))
-;;        ;; (print rest)
-;;        (print "\naa\n")
-;;        (list 'define (first name) (pair 'lambda (pair (rest name) value))))
-;;     (begin
-;;      ;; (print (pair 'define (pair name value)))
-;;      (print "\nbb\n")
-;;      (pair 'define (pair name value)))))
+(define-syntax (let bindings :rest body)
+  (define (unzip lists)
+    (when lists
+      (define (iter lists l1 l2)
+        (define elem (first lists))
+        (if elem
+            (iter (rest lists)
+                  (pair (first elem) l1)
+                  (pair (first (rest elem)) l2))
+          (list l1 l2))))
+
+    (iter lists () ()))
+
+  (define unzipped (unzip bindings))
+
+  (pair `(lambda ,(first unzipped)
+           ,(pair 'begin body))
+        (first (rest unzipped))))
 
 (define-syntax (cond :rest clauses)
   (define (rec clauses)
@@ -41,6 +45,63 @@
               (rec (rest clauses))))))
     (rec clauses))
 
+(define-syntax (do-list :rest body)
+  (define (car seq) (first seq))
+  (define (cdr seq) (rest seq))
+  (define (cadr seq) (car (cdr seq)))
+  (define (cddr seq) (cdr (cdr seq)))
+  (define (caddr seq) (car (cddr seq)))
+  (define (cdddr seq) (cdr (cddr seq)))
+
+  (define (extend-map f ll)
+    (when ll
+      (extend
+       (f (first ll))
+       (extend-map f (rest ll)))))
+
+  (define (list-bind l f)
+    (extend-map f l))
+
+  (define (list-return x)
+    (list x))
+
+  (define (rec :rest body)
+    (cond
+     ((= () body) (begin))
+     ((= () (rest body)) (first body))
+     ((= (first (rest body)) "<-")
+      `(,list-bind ,(caddr body) (lambda (,(first body)) (,rec . (unquote (cdddr body))))))
+     ((= (first (rest body)) "when")
+      `(if ,(cadr body) (,rec . (unquote (cddr body))) (list-fail)))
+     ((= (first (rest body)) "yield")
+      `(,list-return ,(cadr body)))
+     (else (error "Not a do-able expression: ~S" `',body))))
+
+  (rec body))
+
+;; (define-syntax (define-special name-and-args)
+;;   (define (unzip lists)
+;;     (define elem (first lists))
+;;     (define l1 (pair (first       elem)  ()))
+;;     (define l2 (pair (first (rest elem)) ()))
+
+;;     (define (iter lists)
+;;       (define elem (first lists))
+;;       (when elem
+;;           (begin
+;;            (mutate l1 (pair (first       elem)  (copy l1)))
+;;            (mutate l2 (pair (first (rest elem)) (copy l2)))
+;;            (iter (rest lists)))))
+
+;;     (iter (rest lists))
+;;     (list l1 l2))
+
+;;   (define unzipped (unzip bindings))
+
+;;   (pair `(lambda ,(first unzipped)
+;;            ,(pair 'begin body))
+;;         (first (rest unzipped))))
+
 (define (nil? x)
   "Checks if the argument is nil."
   (= x nil))
@@ -102,10 +163,21 @@ the (rest) of the last element of the sequence."
         seq)
     elem))
 
+(define (extend2 seq elem)
+  "Extends a list with the given element, by putting it in
+the (rest) of the last element of the sequence."
+  (printf "addr of (end seq)" (addr-of (end seq)))
+  (if (pair? seq)
+       (let ((e (end seq)))
+         (printf "addr if e inner" (addr-of e))
+         (mutate e (pair (first e) elem))
+         seq))
+    elem)
+
 (define (append seq elem)
   "Appends an element to a sequence, by extendeing the list
 with (pair elem nil)."
-  (extend seq (pair elem nil)))
+  (extend seq (pair elem ())))
 
 (define (length seq)
   "Returns the length of the given sequence."
@@ -194,10 +266,23 @@ added to a list, which in the end is returned."
               (filter fun (rest seq)))
       (filter fun (rest seq)))))
 
+
 (define (zip l1 l2)
-  (if (and (nil? l1) (nil? l2))
-      nil
-    (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2)))))
+  (unless (and (nil? l1) (nil? l2))
+    (pair (list (first l1) (first l2))
+          (zip (rest l1) (rest l2)))))
+
+(define (unzip lists)
+  (when lists
+    (define (iter lists l1 l2)
+      (define elem (first lists))
+      (if elem
+          (iter (rest lists)
+                (pair (first elem) l1)
+                (pair (first (rest elem)) l2))
+        (list l1 l2))))
+
+  (iter lists () ()))
 
 (define (enumerate seq)
   (define (enumerate-inner seq next-num)

bin/pre.slime.expanded

@@ -1,3 +1,5 @@
+(show do-list)
+
 (define (nil? x) "Checks if the argument is nil." (= x nil))
 
 (define (number? x) "Checks if the argument is a number." (= (type x) :number))
@@ -26,8 +28,11 @@ ithe sequence as arguemens." (eval (pair fun seq)))
 (define (extend seq elem) "Extends a list with the given element, by putting it in
 the (rest) of the last element of the sequence." (if (pair? seq) (begin (define e (end seq)) (mutate e (pair (first e) elem)) seq) elem))
 
+(define (extend2 seq elem) "Extends a list with the given element, by putting it in
+the (rest) of the last element of the sequence." (printf "addr of (end seq)" (addr-of (end seq))) (if (pair? seq) ((lambda (e) (begin (printf "addr if e inner" (addr-of e)) (mutate e (pair (first e) elem)) seq)) (end seq))) elem)
+
 (define (append seq elem) "Appends an element to a sequence, by extendeing the list
-with (pair elem nil)." (extend seq (pair elem nil)))
+with (pair elem nil)." (extend seq (pair elem ())))
 
 (define (length seq) "Returns the length of the given sequence." (if (nil? seq) 0 (+ 1 (length (rest seq)))))
 
@@ -61,7 +66,9 @@ function to every value in the sequence. If the result of that
 funciton application returns a truthy value, the original value is
 added to a list, which in the end is returned." (if seq ([C-function] (if (fun (first seq)) (pair (first seq) (filter fun (rest seq))) (filter fun (rest seq)))) nil))
 
-(define (zip l1 l2) (if (and (nil? l1) (nil? l2)) nil (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2)))))
+(define (zip l1 l2) (if (and (nil? l1) (nil? l2)) nil ([C-function] (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2))))))
+
+(define (unzip lists) (if lists ([C-function] (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2)))) nil) (iter lists () ()))
 
 (define (enumerate seq) (define (enumerate-inner seq next-num) (if seq ([C-function] (pair (list (first seq) next-num) (enumerate-inner (rest seq) (+ 1 next-num)))) nil)) (enumerate-inner seq 0))