nybble
/
rosella
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix some reader-bugs introduced in the conversion to scheme/match.

This commit is contained in:
Jesse D. McDonald 2010-05-02 04:21:01 -05:00
parent cbcea20701
commit 387ff63a48
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
libcompiler/reader.scm
View File

@ -1,6 +1,7 @@
#lang scheme/base #lang scheme/base
(require scheme/list) (require scheme/list)
(require scheme/match)
(require scheme/path) (require scheme/path)
(provide read-module) (provide read-module)
@ -14,16 +15,16 @@
(if (null? bindings) (if (null? bindings)
'() '()
`((letrec ,(reverse bindings))))] `((letrec ,(reverse bindings))))]
[`((define ,var ,expr) . ,rst) [`((define (,(? symbol? var) . ,arglist) . ,body) . ,rst)
(iter rst (cons (list var expr) bindings))]
[`((define (,var . ,arglist) . ,body) . ,rst)
(iter rst (cons (list var `(lambda ,arglist ,@body)) bindings))] (iter rst (cons (list var `(lambda ,arglist ,@body)) bindings))]
[`((define ,(? symbol? var) ,expr) . ,rst)
(iter rst (cons (list var expr) bindings))]
[`((define . ,_) . ,_) [`((define . ,_) . ,_)
(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) [`((load ,(? string? pathname)) . ,rst)
(let ([complete-path (path->complete-path pathname)] (let* ([complete-path (path->complete-path pathname)]
[directory (path-only complete-path)]) [directory (path-only complete-path)])
(iter (append (with-input-from-file complete-path (iter (append (with-input-from-file complete-path
(lambda () (lambda ()
@ -33,7 +34,7 @@
bindings))] bindings))]
[`((load . ,_) . ,rst) [`((load . ,_) . ,rst)
(error "Unrecognized load-form:" (first forms))] (error "Unrecognized load-form:" (first forms))]
[(,form . ,rst) [`(,form . ,rst)
(if (null? bindings) (if (null? bindings)
(cons form (iter rst '())) (cons form (iter rst '()))
`((letrec ,(reverse bindings) `((letrec ,(reverse bindings)