diff --git a/bytecode-compiler.scm b/bytecode-compiler.scm index 6f04632..cd32e73 100644 --- a/bytecode-compiler.scm +++ b/bytecode-compiler.scm @@ -1,7 +1,6 @@ (use-modules (ice-9 match) (ice-9 format) (srfi srfi-1) - (srfi srfi-2) (srfi srfi-9) (oop goops) ((rnrs base) #:version (6) #:select (assert))) @@ -17,12 +16,6 @@ (define atom? (negate pair?)) -(define finish-pc 0) - -(define (conjoin . preds) - (lambda (x) - (any (lambda (pred) (pred x)) preds))) - ;; Activation frames (define-class () (next #:init-value #f #:accessor frame-next) @@ -32,7 +25,8 @@ (format out "#< (next=~s) (args=~s)>" (frame-next f) (frame-values f))) (define (frame? x) - (is-a? x )) + (or (eq? #f x) + (is-a? x ))) (define (allocate-frame size+1) (make #:values (make-vector size+1))) @@ -84,29 +78,24 @@ ;; Virtual machine registers and functions (define-syntax define-registers - (syntax-rules (null false) - [(_ name null more ...) - (begin (define name (make-parameter '())) - (define-registers more ...))] - [(_ name false more ...) - (begin (define name (make-parameter #f)) + (syntax-rules () + [(_ name default more ...) + (begin (define name (make-parameter default)) (define-registers more ...))] [(_) '()])) (define-registers - *globals* null - *primitives* null - *stack* null - *constants* null - *code* null - *env* false - *val* false - *pc* false - *finish-pc* false - *fun* false - *arg1* false - *arg2* false - *exit* false) + *globals* '() + *primitives* '() + *stack* '() + *constants* '() + *code* '() + *env* #f + *val* #f + *pc* #f + *finish-pc* #f + *fun* #f + *exit* #f) (define (stack-push v) (*stack* (cons v (*stack*)))) @@ -150,7 +139,7 @@ (pair? pair? 1) (symbol? symbol? 1) (eq? eq? 2) - ;; These are not direct instructions, but we act like they are? I'm a little confused + ;; These are not direct instructions, they can be invoked by an argument (+ + 2) (- - 2) (* * 2) @@ -176,7 +165,7 @@ (if (null? (cdr e*)) (meaning (car e*) r tail?) (+sequence+ (meaning (car e*) r #f) - (meaning-sequence (car e*) r tail?)))) + (meaning-sequence (cdr e*) r tail?)))) (define (meaning-alternative e1 e2 e3 r tail?) (+alternative+ (meaning e1 r #f) @@ -505,12 +494,12 @@ (stack-push (*val*))) (define-inst (preserve-env 37) - (assert ((conjoin frame? boolean?) (*env*))) + (assert (frame? (*env*))) (stack-push (*env*))) (define-inst (restore-env 38) (*env* (stack-pop)) - (assert ((conjoin frame? boolean?) (*env*)))) + (assert (frame? (*env*)))) (define-inst (pop-function 39) (*fun* (stack-pop)))