dane/lisp-in-small-pieces
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

I could twiddle like this forever, one last change before compiler

Browse Source
This commit is contained in:
Dane Johnson
2025-11-23 09:13:27 -06:00
parent 0fa5814710
commit c7e47d6bf8
1 changed files with 20 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
direct-style-interpreter.scm
View File

@@ -213,28 +213,26 @@
(define-primitive + + 2) (define-primitive + + 2)
(define-primitive = = 2) (define-primitive = = 2)
(define-initial call/cc (define-initial call/cc
(let* ([arity 1]
[arity+1 (1+ arity)])
(make-closure (make-closure
(lambda (v* sr) (lambda (v* sr)
(if (= arity+1 (activation-rec-length v*)) (if (= (activation-rec-length v*) 2)
(call/cc ;; call/cc is "magic" for our purposes here, (call/cc ;; call/cc is "magic" for our purposes here,
;; there are no reified continuations in the denotation ;; there are no reified continuations in the denotation
(lambda (k) (lambda (k)
(invoke (invoke
(activation-rec-ref v* 0) (activation-rec-ref v* 0)
(let ([rec (make-activation-rec (+ 1 1))]) (let ([rec (make-activation-rec 2)])
(activation-rec-set! (activation-rec-set!
rec 0 rec 0
(make-closure (make-closure
(lambda (values r) (lambda (values r)
(if (= arity+1 (activation-rec-length values)) (if (= (activation-rec-length values) 2)
(k (activation-rec-ref values 0)) (k (activation-rec-ref values 0))
(error "Incorrect arity" 'continuation))) (error "Incorrect arity" 'continuation)))
(*env*))) (*env*)))
rec)))) rec))))
(error "Incorrect arity" 'call/cc))) (error "Incorrect arity" 'call/cc)))
(*env*)))) (*env*)))
(define-initial apply (define-initial apply
(make-closure (make-closure
(lambda (v* sr) (lambda (v* sr)