summaryrefslogtreecommitdiff
path: root/module/system/base/compile.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/system/base/compile.scm')
-rw-r--r--module/system/base/compile.scm18
1 files changed, 9 insertions, 9 deletions
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index adc7e2d90..3da36a7d1 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -20,10 +20,10 @@
;;; Code:
(define-module (system base compile)
- :use-module (oop goops)
:use-syntax (system base syntax)
:use-module (system base language)
:use-module (system il compile)
+ :use-module (system il glil)
:use-module (system vm core)
:use-module (system vm assemble)
:use-module (ice-9 regex))
@@ -32,20 +32,18 @@
;;; Compiler environment
;;;
-(define-vm-class <cenv> ()
- vm language module optimize)
+(define-record (<cenv> vm language module))
(define-public (make-cenv . rest)
- (apply make <cenv> rest))
+ (apply <cenv> rest))
(define-public (syntax-error loc msg exp)
(throw 'syntax-error loc msg exp))
(define-public (call-with-compile-error-catch thunk)
- (catch 'syntax-error
- thunk
- (lambda (key loc msg exp)
- (format #t "~A:~A: ~A: ~A" (car loc) (cdr loc) msg exp))))
+ (try (thunk)
+ ((syntax-error loc msg exp)
+ (format #t "~A:~A: ~A: ~A" (car loc) (cdr loc) msg exp))))
;;;
@@ -65,7 +63,9 @@
(let* ((source (read-file-in file scheme))
(objcode (apply compile-in source (current-module)
scheme opts)))
- (uniform-array-write (objcode->string objcode) port))))
+ (if (memq :c opts)
+ (pprint-glil objcode port)
+ (uniform-array-write (objcode->string objcode) port)))))
(format #t "Wrote ~A\n" comp))))
(lambda (key . args)
(format #t "ERROR: During compiling ~A:\n" file)