From de9353e9c24c448aaa11e24f2ccfb1820acb3d34 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Thu, 4 Aug 2022 21:45:54 -0700
Subject: Add if and set!.

---
 lib/csc/macros.csc | 47 ++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 42 insertions(+), 5 deletions(-)

(limited to 'lib/csc/macros.csc')

diff --git a/lib/csc/macros.csc b/lib/csc/macros.csc
index 4559991..d41e9da 100644
--- a/lib/csc/macros.csc
+++ b/lib/csc/macros.csc
@@ -25,6 +25,7 @@
             define-syntax-transformer
             define-syntax?
             lexical-ref-gensym
+            lexical-ref-name
             lexical-ref?
             library-define-expression
             library-define-ref
@@ -35,9 +36,11 @@
             make-call-builtin
             make-constant
             make-define-syntax
+            make-if
             make-lambda
             make-letrec
             make-lexical-ref
+            make-lexical-set
             make-library-define
             make-library-ref
             make-sequence
@@ -715,14 +718,18 @@
           (syntax-case x
             ((_ formals . body)
               (let-values (((args rest) (split-args-rest formals)))
+                (define refs (map (lambda (name)
+                                    (make-lexical-ref name (gensym)))
+                                  args))
+                (define environment (syntax-object-environment body))
+                (loop for ref in refs
+                      do (set! environment (add-binding (lexical-ref-name ref) ref environment)))
                 (make-lambda
-                  (map (lambda (name)
-                         (make-lexical-ref name (gensym)))
-                       args)
+                  refs
                   (if rest
                     (make-lexical-ref rest (gensym))
                     #f)
-                  (expand-lambda-body body))))
+                  (expand-lambda-body (make-syntax-object (syntax->expression body) environment (marks body))))))
             (_ (raise-syntax-error "unexpected form in lambda" x))))))
 
 
@@ -767,6 +774,34 @@
             (_ (raise-syntax-error "unexpected form in call-builtin" x))))))
 
 
+    (define builtin-set
+      (make-macro-transformer
+        (lambda (x)
+          (syntax-case x
+            ((_ var value) when (identifier? var)
+              (define var* (expand-syntax-object var))
+              (define val* (expand-syntax-object value))
+              (cond
+                ((lexical-ref? var*)
+                  (make-lexical-set var* val*))
+                ((library-ref? var*)
+                  (make-library-define var* val*))
+                (else
+                  (error "unknown variable form in builtin-set" var*))))
+            (_ (raise-syntax-error "unexpected form in builtin-set" x))))))
+
+
+    (define builtin-if
+      (make-macro-transformer
+        (lambda (x)
+          (syntax-case x
+            ((_ test true false)
+              (make-if (expand-syntax-object test)
+                (expand-syntax-object true)
+                (expand-syntax-object false)))
+            (_ (raise-syntax-error "unexpected form in builtin-if"))))))
+
+
     (define builtins-environment
       (alist->substitutions
         (list (cons 'syntax-rules builtin-syntax-rules)
@@ -777,7 +812,9 @@
               (cons 'lambda builtin-lambda)
               (cons 'builtin-define builtin-define)
               (cons 'define-syntax builtin-define-syntax)
-              (cons 'call-builtin builtin-call-builtin))))
+              (cons 'call-builtin builtin-call-builtin)
+              (cons 'set! builtin-set)
+              (cons 'builtin-if builtin-if))))
 
 
     ; Expands the body of a library, or top level. expand-body can be thought
-- 
cgit v1.3.1