Skip to content
Browse files

add location information for core forms

  • Loading branch information...
1 parent 030fbd9 commit b3e0989ca39a8c8477154281ace2315d7c99d020 Meng Zhang committed Jan 3, 2013
Showing with 29 additions and 26 deletions.
  1. +1 −3 README.md
  2. +6 −2 classify.scm
  3. +11 −10 expr.scm
  4. +11 −11 standard.scm
View
4 README.md
@@ -13,14 +13,12 @@ Currently a test suite(tests/r5rs-tests.scm) from chibi-scheme is fully passed w
2. Error message improvement
- Most internal syntax didn't report location in error message, as the location information already
- saved in expression's meta data, it should be trival to implement this.
+ Currently only internal core forms have proper location information for erros. Should add these for macro expanding?
3. Proper local variable naming
All local variable will compiles into a form of "name.location-number", this could be improved.
-
4. let-syntax, letrec-syntax lacks support for moving internal definition to proper location.
```scheme
View
8 classify.scm
@@ -38,9 +38,9 @@
((macro? denotation)
(if allow-macro
denotation
- (classify-error "Invalid usage macro as variable" denotation name environment)))
+ (classify-error/expr "Invalid usage macro as variable" expr)))
(else
- (classify-error "Invalid denotation:" denotation name environment)))))
+ (classify-error/expr "Invalid denotation:" expr)))))
(else
;; free-vars
(make-ref meta (name->symbol name) #f)))))
@@ -69,3 +69,7 @@
(define (classify-error . msg)
(apply error msg))
+
+(define (classify-error/expr msg expr)
+ (receive-expr* (_ meta) expr
+ (apply classify-error (append (meta/disclose meta) (list msg) (list (expr-strip-meta expr))))))
View
21 expr.scm
@@ -1,3 +1,4 @@
+;;; Expression methods
(define (expr? obj) ;; returns false for expressions without 'attached notes'
(and (vector? obj)
(##fixnum.= (##vector-length obj) 4)
@@ -13,6 +14,10 @@
(vector-ref expr 1))
(define (expr/meta expr)
+ (define (pos/line pos)
+ (+ 1 (bitwise-and pos 65535)))
+ (define (pos/col pos)
+ (+ 1 (quotient pos 65536)))
(let ((type (vector-ref expr 0))
(file (or (vector-ref expr 2) "(generated)"))
(pos (or (vector-ref expr 3) 0)))
@@ -28,16 +33,6 @@
(expr/meta expr)
#f))
-(define (pos/line pos)
- (+ 1 (bitwise-and pos 65535)))
-
-(define (pos/col pos)
- (+ 1 (quotient pos 65536)))
-
-(define (make-pos line col)
- (+ (##fixnum.- line 1)
- (* (##fixnum.- col 1) 65536)))
-
(define-macro (receive-expr* sym expr . body)
`(receive ,sym
(if (expr? ,expr)
@@ -54,4 +49,10 @@
(else v))))
(define (make-expr form meta)
+ (define (make-pos line col)
+ (+ (##fixnum.- line 1)
+ (* (##fixnum.- col 1) 65536)))
(vector (car meta) form (cadr meta) (make-pos (caddr meta) (cadddr meta))))
+
+(define (meta/disclose meta)
+ `(File: ,(cadr meta) Line: ,(caddr meta) Col: ,(cadddr meta)))
View
22 standard.scm
@@ -9,7 +9,7 @@
(receive-expr* (form meta) expr
(if (not (and (= (length form) 3)
(name? (expr*/form (cadr form)))))
- (classify-error "bad set! syntax" form))
+ (classify-error/expr "bad set! syntax" expr))
(make-set meta (classify (cadr form) use-env) (classify (caddr form) use-env))))))))
;; (define var val) -> def ast
@@ -20,7 +20,7 @@
(lambda (expr use-env mac-env)
(receive-expr* (form meta) expr
(if (< (length form) 3)
- (classify-error "bad define syntax" form))
+ (classify-error/expr "bad define syntax" expr))
(receive (name body)
(if (name? (expr*/form (cadr form)))
(values (cadr form) (caddr form))
@@ -48,13 +48,13 @@
(lambda (expr use-env mac-env)
(receive-expr* (form meta) expr
(if (< (length form) 3)
- (classify-error "bad lambda syntax" form))
+ (classify-error/expr "bad lambda syntax" expr))
(let ((env (syntactic-extend use-env)))
(make-lam meta
(map* (lambda (expr)
(receive-expr* (x _) expr
(if (not (name? x))
- (classify-error "bad lambda param" form)
+ (classify-error/expr "bad lambda param" expr)
(bind-variable! x env))
(classify expr env)))
(expr*/form (cadr form)))
@@ -73,7 +73,7 @@
((3) (make-lit #f (void)))
((4) (classify (cadddr form) use-env))
(else
- (classify-error "bad if syntax" form)))))
+ (classify-error/expr "bad if syntax" expr)))))
(make-cnd meta
(classify (cadr form) use-env)
(classify (caddr form) use-env)
@@ -87,7 +87,7 @@
(lambda (expr use-env mac-env)
(receive-expr* (form meta) expr
(if (not (= (length form) 2))
- (classify-error "bad quote syntax" form))
+ (classify-error/expr "bad quote syntax" expr))
(make-lit meta (syntax->datum (expr-strip-meta (cadr form))))))))))
;; (syntax-quote form) -> lit ast
@@ -98,7 +98,7 @@
(lambda (expr use-env mac-env)
(receive-expr* (form meta) expr
(if (not (= (length form) 2))
- (classify-error "bad quote syntax" form))
+ (classify-error/expr "bad syntax-quote syntax" expr))
(make-lit meta (expr-strip-meta (cadr form)))))))))
(define (bind-syntax name value bind-env eval-env)
@@ -109,7 +109,7 @@
(make-macro eval-env (eval-no-hook (expr-strip-meta (ast->expr ast)))))))
(if (and (macro? mac) (procedure? (macro/procedure mac)))
(syntactic-bind! bind-env name mac)
- (classify-error "non-procedure macro" mac))))
+ (classify-error/expr "non-procedure macro" value))))
(define (macrology/define-syntax)
(make-macrology
@@ -119,19 +119,19 @@
(receive-expr* (form meta) expr
(if (not (and (= (length form) 3)
(name? (expr*/form (cadr form)))))
- (classify-error "bad define-syntax syntax " form))
+ (classify-error/expr "bad define-syntax syntax " expr))
(bind-syntax (expr*/form (cadr form)) (caddr form) use-env use-env)
(make-lit meta (void))))))))
(define (let-syntax-helper expr mac-env bind-env eval-env)
(receive-expr* (form meta) expr
(if (not (>= (length form) 3))
- (classify-error "bad let-syntax " form))
+ (classify-error/expr "bad syntax binding" expr))
(map
(lambda (x)
(receive-expr* (form meta) x
(if (not (name? (expr*/form (car form))))
- (classify-error "bad let-syntax name " form))
+ (classify-error "bad syntax binding" x))
(bind-syntax (expr*/form (car form)) (cadr form) bind-env eval-env)))
(expr*/form (cadr form)))
(syntactic-seal! bind-env)

0 comments on commit b3e0989

Please sign in to comment.
Something went wrong with that request. Please try again.