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)))