diff --git a/CHANGELOG.md b/CHANGELOG.md index 4be87088..8db7a715 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,7 @@ Features +- The compiler now provides improved error messages with file and line numbers for a wide range of syntax errors. - Added `c-void` type into `(cyclone foreign)`. Bug Fixes diff --git a/scheme/base.sld b/scheme/base.sld index 9386bb87..486e8edf 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -9,8 +9,6 @@ (define-library (scheme base) (import (scheme cyclone common)) (export - *source-loc-lis* - error/loc member assoc cons-source @@ -132,6 +130,7 @@ error-object-irritants ; TODO: file-error? ; TODO: read-error? + error/loc error raise raise-continuable @@ -234,33 +233,6 @@ fast-string=? ) (begin - (define *source-loc-lis* '()) - (define (error/loc reason expr . args) - ;; Does reason already include line/file location info? - (define (reason/line-loc? reason) - (and (string? reason) - (equal? (substring reason 0 8) - "at line "))) - (let* ((found (assoc expr *source-loc-lis*)) - (loc-vec (if found - (cdr found) ;; Get value - #f)) - (msg (if (and loc-vec ;; Have line info - (not (reason/line-loc? reason))) ;; Not there yet - (string-append - "at line " - (number->string (vector-ref loc-vec 1)) - ", column " - (number->string (vector-ref loc-vec 2)) - " of " - (vector-ref loc-vec 0) - ": " - reason) - reason))) - (if (pair? args) - (apply error (cons msg args)) - (error msg expr)))) - ;; Features implemented by this Scheme (define (features) (cons @@ -1310,6 +1282,41 @@ } return_closcall1(data, k, thd->exception_handler_stack); ") + ;; Non-standard, used internally by Cyclone to report line number + ;; information for error messages + (define (error/loc reason expr . args) + ;(Cyc-write `(error/loc ,(map + ; (lambda (alis) + ; (list (car alis) + ; (memloc (car alis)) + ; (cdr alis))) + ; *reader-source-db*))) + ;(Cyc-display "\n") + ;; Does reason already include line/file location info? + (define (reason/line-loc? reason) + (and (string? reason) + (equal? (substring reason 0 8) + "at line "))) + (let* ((found (assoc expr *reader-source-db*)) + (loc-vec (if found + (cdr found) ;; Get value + #f)) + (msg (if (and loc-vec ;; Have line info + (not (reason/line-loc? reason))) ;; Not there yet + (string-append + "at line " + (number->string (vector-ref loc-vec 1)) + ", column " + (number->string (vector-ref loc-vec 2)) + " of " + (vector-ref loc-vec 0) + ": " + reason) + reason))) + (if (pair? args) + (apply error (cons msg args)) + (error msg expr)))) + ;; Simplified versions of every/any from SRFI-1 (define (any pred lst) (let any* ((l (map pred lst))) diff --git a/scheme/cyclone/common.sld b/scheme/cyclone/common.sld index 1e4717c8..129e76f6 100644 --- a/scheme/cyclone/common.sld +++ b/scheme/cyclone/common.sld @@ -13,7 +13,10 @@ *version-number* *version-name* *version-banner* - *c-file-header-comment*) + *c-file-header-comment* + *reader-source-db* + memloc + ) (begin (define *version-number* "0.19") (define *version-name* "") @@ -52,4 +55,13 @@ **/ ")) +(define *reader-source-db* '()) + +(define-c memloc + "(void *data, int argc, closure _, object k, object obj)" + " char str[32]; + sprintf(str, \"%p\", obj); + make_utf8_string(data, s, str); + return_closcall1(data, k, &s);") + )) diff --git a/scheme/read.sld b/scheme/read.sld index 6bee710c..aaff4892 100644 --- a/scheme/read.sld +++ b/scheme/read.sld @@ -8,6 +8,7 @@ ;;;; (define-library (scheme read) (import (scheme base) + (scheme cyclone common) ;(scheme write) (scheme char)) (export @@ -173,9 +174,9 @@ return_closcall1(data, k, obj_int2obj(num)); ") (define (store-source-info! obj filename line col) - (set! *source-loc-lis* + (set! *reader-source-db* (cons (cons obj (vector filename line col)) - *source-loc-lis*))) + *reader-source-db*))) ;; TODO: where to store? Need to use a hashtable but also needs to ;; be accessible from macro's. probably needs to be in global env, ;; see (cyclone foreign) for an example