adding lisp-interpreter

2025-09-24 10:58:09 +02:00
parent ab482df604
commit d8fc7d2d67
57 changed files with 30702 additions and 5 deletions
@@ -0,0 +1,81 @@
+
+(define (quasiquote-helper tail x)
+  (cond ((null? x) (reverse! tail))
+        ((not (pair? x)) (list 'QUOTE x))
+        ((eq? 'UNQUOTE (car x)) (car (cdr x)))
+        ((eq? 'UNQUOTESPLICE (car x)) (error "invalid place"))
+        ((and (pair? (car x))
+              (eq? (car (car x)) 'UNQUOTESPLICE))
+
+         (quasiquote-helper (reverse-append! (car (cdr (car x))) tail) (cdr x))
+         )
+        (else
+          (quasiquote-helper (cons (quasiquote-helper '() (car x)) tail)
+                              (cdr x)))
+
+          ))
+
+(define-macro quasiquote
+              (lambda (x)
+                (display x)
+                (newline)
+                (quasiquote-helper '() x)
+                ))
+
+
+(display  (macroexpand '`(1 ,x 3)))
+(newline)
+;(display  (macroexpand '`(1 ,@(2 2) 3)))
+
+
+
+(define-macro do2
+  (lambda (vars loop-check loop)
+    (let ((names '())
+          (inits '())
+          (steps '())
+          (func (gensym)))
+
+    (for-each (lambda (var) 
+                (push (car var) names)
+                (set! var (cdr var))
+                (push (car var) inits)
+                (set! var (cdr var))
+                (push (car var) steps))
+              vars)
+
+    (display loop-check)
+    (newline)
+
+    `((lambda (,func)
+        (begin
+          (set! ,func (lambda ,names
+                        (if ,(car loop-check)
+                            ,(car (cdr loop-check))
+                            ,(cons 'BEGIN (list loop (cons func steps)))   
+                            ))) 
+          ,(cons func inits)
+          )) '())
+    )))
+
+(display (macroexpand '(do2 ((i 0 (+ i 1))) 
+                           ((> i 0) 'done)
+                                    '())))
+
+(newline)
+(newline)
+
+
+(define-macro let2 (lambda (def-list . body)
+    (cons `(lambda
+        ,(map1 (lambda (entry) (car entry)) def-list '())
+        ,(cons 'BEGIN body))
+        (map1 (lambda (entry) (car (cdr entry))) def-list '())) ))
+
+(display (macroexpand 
+   '(let2 ((x 1) (y 2)) (set! x (+ x y)) x)))
+
+
+
+
+