diff options
| author | Rose Hogenson <rhogenson@posteo.net> | 2022-07-30 13:31:05 -0700 |
|---|---|---|
| committer | Rose Hogenson <rhogenson@posteo.net> | 2022-07-30 13:31:19 -0700 |
| commit | 6ffa3538cfeb5a97e967544bfbbcf907f4aa565f (patch) | |
| tree | 691d7b73e47c8c07acbf3fef5cee11d76bb34a52 /csc | |
| parent | 0632650d0e4250e08a76982ab2713a34e3531b33 (diff) | |
| download | chromatopelma-6ffa3538cfeb5a97e967544bfbbcf907f4aa565f.tar.zst | |
Add call-builtin syntax.
This syntax allows calling opcodes directly from scheme code.
Very powerful technique.
Diffstat (limited to 'csc')
| -rw-r--r-- | csc/cps.csc | 2 | ||||
| -rw-r--r-- | csc/ir2.csc | 1 | ||||
| -rw-r--r-- | csc/macros-test.csc | 13 | ||||
| -rw-r--r-- | csc/macros.csc | 22 |
4 files changed, 36 insertions, 2 deletions
diff --git a/csc/cps.csc b/csc/cps.csc index 0dc8a96..f2a9c90 100644 --- a/csc/cps.csc +++ b/csc/cps.csc @@ -262,7 +262,7 @@ (lambda (v) (make-apply f (list return-address v)))))))) ((% %call-builtin op args) - (define returns-value? (not (symbol=? op 'poke))) + (define returns-value? (not (memq op '(poke exit)))) (loop for arg in (reverse args) with expr = (lambda (vals) (if returns-value? diff --git a/csc/ir2.csc b/csc/ir2.csc index 800d3c0..888437f 100644 --- a/csc/ir2.csc +++ b/csc/ir2.csc @@ -150,6 +150,7 @@ ; - alloc: size -> result ; - peek: pointer * offset -> result ; - poke: word * pointer * offset -> () + ; - exit: code -> () (define-match-record-type <primitive> (make-primitive operation arguments results continuation) primitive? diff --git a/csc/macros-test.csc b/csc/macros-test.csc index 6ee0596..531e3e2 100644 --- a/csc/macros-test.csc +++ b/csc/macros-test.csc @@ -5,6 +5,7 @@ gensym?) (only (csc ir1) %call + %call-builtin %constant %define-syntax %if @@ -15,6 +16,7 @@ %library-define %library-ref %sequence + call-builtin? call? constant? define-syntax? @@ -27,6 +29,7 @@ lexical-set? library-define? library-ref? + make-call-builtin make-constant make-define-syntax make-lambda @@ -52,6 +55,7 @@ (cons define-syntax? %define-syntax) (cons if? %if) (cons call? %call) + (cons call-builtin? %call-builtin) (cons sequence? %sequence) (cons lambda? %lambda) (cons letrec? %letrec) @@ -278,4 +282,13 @@ ((five _) 5))) (five 6)) builtins-environment) + transform-ir1)) + + + (test builtin-call-builtin + (assert-equal + (make-call-builtin 'bbb (list (make-constant 5))) + (expand-body 'main + '((call-builtin bbb 5)) + builtins-environment) transform-ir1)))) diff --git a/csc/macros.csc b/csc/macros.csc index 288865d..4559991 100644 --- a/csc/macros.csc +++ b/csc/macros.csc @@ -32,6 +32,7 @@ library-ref-name library-ref? make-call + make-call-builtin make-constant make-define-syntax make-lambda @@ -748,6 +749,24 @@ (_ (raise-syntax-error "unexpected form in builtin-define-syntax" x)))))) + (define builtin-call-builtin + (make-macro-transformer + (lambda (x) + (syntax-case x + ((_ op . args) when (identifier? op) + (make-call-builtin (identifier-name op) + (let loop ((args args) + (expanded-args '())) + (syntax-case args + ('() (reverse expanded-args)) + ((head . tail) + (loop tail + (cons (expand-syntax-object head) + expanded-args))) + (_ (raise-syntax-error "unexpected form in call-builtin")))))) + (_ (raise-syntax-error "unexpected form in call-builtin" x)))))) + + (define builtins-environment (alist->substitutions (list (cons 'syntax-rules builtin-syntax-rules) @@ -757,7 +776,8 @@ (cons 'quote builtin-quote) (cons 'lambda builtin-lambda) (cons 'builtin-define builtin-define) - (cons 'define-syntax builtin-define-syntax)))) + (cons 'define-syntax builtin-define-syntax) + (cons 'call-builtin builtin-call-builtin)))) ; Expands the body of a library, or top level. expand-body can be thought |