summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
Diffstat (limited to 'module')
-rw-r--r--module/language/scheme/translate.scm10
-rw-r--r--module/system/base/compile.scm8
-rw-r--r--module/system/base/syntax.scm7
-rw-r--r--module/system/vm/assemble.scm14
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)))
;;;