diff options
Diffstat (limited to 'module')
-rw-r--r-- | module/language/scheme/translate.scm | 10 | ||||
-rw-r--r-- | module/system/base/compile.scm | 8 | ||||
-rw-r--r-- | module/system/base/syntax.scm | 7 | ||||
-rw-r--r-- | module/system/vm/assemble.scm | 14 |
4 files changed, 16 insertions, 23 deletions
diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm index b4fb5e397..03e54047c 100644 --- a/module/language/scheme/translate.scm +++ b/module/language/scheme/translate.scm @@ -43,13 +43,13 @@ (cond ((pair? x) (let ((y (macroexpand x))) (if (eq? x y) - (trans-pair e (or (location x) l) (car x) (cdr x)) - (trans e l y)))) + (trans-pair e (or (location x) l) (car x) (cdr x)) + (trans e l y)))) ((symbol? x) (let ((y (symbol-expand x))) (if (symbol? y) - (<ghil-ref> e l (ghil-lookup e y)) - (trans e l y)))) + (<ghil-ref> e l (ghil-lookup e y)) + (trans e l y)))) (else (<ghil-quote> e l x)))) (define (symbol-expand x) @@ -109,7 +109,7 @@ ;; (set! (NAME ARGS...) VAL) ((((? symbol? name) . args) val) ;; -> ((setter NAME) ARGS... VAL) - (trans:pair `((setter ,name) (,@args ,val)))) + (trans:pair `((setter ,name) . (,@args ,val)))) (else (bad-syntax)))) diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index 6c686505c..bd7f6963c 100644 --- a/module/system/base/compile.scm +++ b/module/system/base/compile.scm @@ -25,7 +25,7 @@ :use-module (system il compile) :use-module (system il glil) :use-module ((system vm core) - #:select (the-vm vm-load)) + #:select (the-vm vm-load objcode->u8vector)) :use-module (system vm assemble) :use-module (ice-9 regex)) @@ -68,9 +68,9 @@ (if (memq :c opts) (pprint-glil objcode port) (uniform-vector-write (objcode->u8vector objcode) port))))) - (format #t "Wrote ~A\n" comp)) + (format #t "wrote ~A\n" comp)) (lambda (key . args) - (format #t "ERROR: During compiling ~A:\n" file) + (format #t "ERROR: during compilation of ~A:\n" file) (display "ERROR: ") (apply format #t (cadr args) (caddr args)) (newline) @@ -128,7 +128,7 @@ (lambda (key val) val))) ;;; -;;; +;;; ;;; (define (compile-and-load file . opts) diff --git a/module/system/base/syntax.scm b/module/system/base/syntax.scm index bcc926bee..c28c0dda0 100644 --- a/module/system/base/syntax.scm +++ b/module/system/base/syntax.scm @@ -102,7 +102,7 @@ (def (if (pair? slot) (cdr slot) *unbound*)) (val (get-key args (symbol->keyword key) def))) (if (eq? val *unbound*) - (error "Slot unbound:" key) + (error "slot unbound" key) (cons key val)))) slots)) @@ -116,14 +116,15 @@ (lambda (struct name) (let ((data (assq name (vector-ref struct 1)))) (cond ((not data) - (error "Unknown slot:" name)) + (error "unknown slot" name)) (else (cdr data))))) (lambda (struct name val) (let ((data (assq name (vector-ref struct 1)))) (cond ((not data) - (error "Unknown slot:" name)) + (error "unknown slot" name)) (else (set-cdr! data val))))))) + ;;; ;;; Variants ;;; diff --git a/module/system/vm/assemble.scm b/module/system/vm/assemble.scm index 49dc1fc09..b2697aac4 100644 --- a/module/system/vm/assemble.scm +++ b/module/system/vm/assemble.scm @@ -50,26 +50,18 @@ ;;; (define (preprocess x e) -; (format #t "entering~%") (match x (($ <glil-asm> vars body) -; (format #t "preparing to recurse~%") (let* ((venv (<venv> :parent e :nexts (slot vars 'nexts) :closure? #f)) (body (map (lambda (x) (preprocess x venv)) body))) (<vm-asm> :venv venv :glil x :body body))) (($ <glil-external> op depth index) -; (format #t "preparing to return due to external: ~a ~a ~a [e=~a]~%" -; op depth index e) (do ((d depth (- d 1)) - (e e (slot e 'parent))) - ((= d 0)) + (e e (slot e 'parent))) + ((= d 0)) (set! (slot e 'closure?) #t)) -; (format #t "returning due to external~%") x) - (else - (begin -; (format #t "returning~%") - x)))) + (else x))) ;;; |