Fix loading from relative paths, and output of empty lists.
Also add some basic command-line processing to the front-end.
This commit is contained in:
parent
2f67f502f7
commit
a76e86013a
34
compiler.scm
34
compiler.scm
|
|
@ -1,16 +1,42 @@
|
||||||
#! /usr/bin/mzscheme
|
#! /usr/bin/mzscheme
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
|
(require scheme/path)
|
||||||
(require scheme/pretty)
|
(require scheme/pretty)
|
||||||
|
(require scheme/cmdline)
|
||||||
|
|
||||||
(require (file "libcompiler/reader.scm"))
|
(require (file "libcompiler/reader.scm"))
|
||||||
(require (file "libcompiler/compiler.scm"))
|
(require (file "libcompiler/compiler.scm"))
|
||||||
(require (file "libcompiler/writer.scm"))
|
(require (file "libcompiler/writer.scm"))
|
||||||
|
|
||||||
(optimize? #t)
|
(define map-bytecode? (make-parameter #t))
|
||||||
|
|
||||||
;(pretty-print (reduce-function (read-module)))
|
(define source-file
|
||||||
(write-rla-value (compile-function (read-module)))
|
(command-line
|
||||||
(write-char #\Newline)
|
#:once-each
|
||||||
|
[("-O") ol "Set the optimization level"
|
||||||
|
(optimize? (>= (string->number ol) 1))]
|
||||||
|
[("-R" "--reduce-only") "Stop before mapping forms to VM bytecode"
|
||||||
|
(map-bytecode? #f)]
|
||||||
|
#:args source-file
|
||||||
|
(if (null? source-file)
|
||||||
|
"-"
|
||||||
|
(car source-file))))
|
||||||
|
|
||||||
|
(define source-module
|
||||||
|
(if (string=? source-file "-")
|
||||||
|
(read-module)
|
||||||
|
(let* ([complete-path (path->complete-path source-file)]
|
||||||
|
[directory (path-only complete-path)])
|
||||||
|
(with-input-from-file complete-path
|
||||||
|
(lambda ()
|
||||||
|
(parameterize ([current-directory directory])
|
||||||
|
(read-module)))))))
|
||||||
|
|
||||||
|
(if (map-bytecode?)
|
||||||
|
(begin
|
||||||
|
(write-rla-value (compile-function source-module))
|
||||||
|
(write-char #\Newline))
|
||||||
|
(pretty-print (reduce-function source-module)))
|
||||||
|
|
||||||
; vim:set sw=2 expandtab:
|
; vim:set sw=2 expandtab:
|
||||||
|
|
|
||||||
|
|
@ -3,6 +3,7 @@
|
||||||
(require scheme/list)
|
(require scheme/list)
|
||||||
(require scheme/match)
|
(require scheme/match)
|
||||||
(require scheme/path)
|
(require scheme/path)
|
||||||
|
(require scheme/pretty)
|
||||||
|
|
||||||
(provide read-module)
|
(provide read-module)
|
||||||
|
|
||||||
|
|
@ -23,17 +24,6 @@
|
||||||
(error "Unrecognized define-form:" (first forms))]
|
(error "Unrecognized define-form:" (first forms))]
|
||||||
[`((begin . ,body) . ,rst)
|
[`((begin . ,body) . ,rst)
|
||||||
(iter (append body rst) bindings)]
|
(iter (append body rst) bindings)]
|
||||||
[`((load ,(? string? pathname)) . ,rst)
|
|
||||||
(let* ([complete-path (path->complete-path pathname)]
|
|
||||||
[directory (path-only complete-path)])
|
|
||||||
(iter (append (with-input-from-file complete-path
|
|
||||||
(lambda ()
|
|
||||||
(parameterize ([current-directory directory])
|
|
||||||
(read-forms))))
|
|
||||||
rst)
|
|
||||||
bindings))]
|
|
||||||
[`((load . ,_) . ,rst)
|
|
||||||
(error "Unrecognized load-form:" (first forms))]
|
|
||||||
[`(,form . ,rst)
|
[`(,form . ,rst)
|
||||||
(if (null? bindings)
|
(if (null? bindings)
|
||||||
(cons form (iter rst '()))
|
(cons form (iter rst '()))
|
||||||
|
|
@ -41,10 +31,19 @@
|
||||||
,@(cons form (iter rst '())))))]))))
|
,@(cons form (iter rst '())))))]))))
|
||||||
|
|
||||||
(define (read-forms [port (current-input-port)])
|
(define (read-forms [port (current-input-port)])
|
||||||
(reverse (let iter ([form (read port)]
|
(let iter ([form (read port)]
|
||||||
[forms '()])
|
[forms '()])
|
||||||
(if (eof-object? form)
|
(match form
|
||||||
forms
|
[(? eof-object?)
|
||||||
(iter (read port) (cons form forms))))))
|
(reverse forms)]
|
||||||
|
[`(load ,(? string? pathname))
|
||||||
|
(let ([loaded-forms (with-input-from-file pathname
|
||||||
|
(lambda ()
|
||||||
|
(parameterize ([current-directory (or (path-only pathname) ".")])
|
||||||
|
(read-forms))))])
|
||||||
|
(iter (read port) (cons `(begin ,@loaded-forms) forms)))]
|
||||||
|
[`(load . ,_)
|
||||||
|
(error "Unrecognized load-form:" (first forms))]
|
||||||
|
[_ (iter (read port) (cons form forms))])))
|
||||||
|
|
||||||
; vim:set sw=2 expandtab:
|
; vim:set sw=2 expandtab:
|
||||||
|
|
|
||||||
|
|
@ -135,6 +135,8 @@
|
||||||
(write-rla-value (vector-ref value i) port)
|
(write-rla-value (vector-ref value i) port)
|
||||||
(write-char #\Space port))
|
(write-char #\Space port))
|
||||||
(write-string ")" port)]
|
(write-string ")" port)]
|
||||||
|
[(null? value)
|
||||||
|
(write-string "()" port)]
|
||||||
[(pair? value)
|
[(pair? value)
|
||||||
(write-string "(" port)
|
(write-string "(" port)
|
||||||
(let iter ([lst value])
|
(let iter ([lst value])
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue