From a4421267e4baf2534f7ad3be1fd4f94479f4a06b Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 16 Jul 2020 23:10:48 -0400 Subject: [PATCH] Build out infrastructure to save source info Need to be able to save source object / line number data so we can use it for compiler error messages. Trying to be careful not to make this hurt performance too much. --- scheme/read.sld | 124 ++++++++++++++++++++++++++++++++++-------------- 1 file changed, 89 insertions(+), 35 deletions(-) diff --git a/scheme/read.sld b/scheme/read.sld index d3c75991..7ab93301 100644 --- a/scheme/read.sld +++ b/scheme/read.sld @@ -13,6 +13,7 @@ (export read read-all + read-all/source include include-ci) (inline @@ -60,23 +61,41 @@ (lambda args (let ((fp (if (null? args) (current-input-port) - (car args)))) - (let ((result (parse fp))) + (car args))) + (ssi! (if (and (pair? args) + (pair? (cdr args))) + (cadr args) + #f)) ;; Default + (fname (if (and (pair? args) + (pair? (cdr args)) + (pair? (cddr args))) + (caddr args) + #f))) + (let ((result (parse fp ssi! fname))) (if (Cyc-opaque? result) (read-error fp "unexpected closing parenthesis") result))))) -;; TODO: read given file, collecting source location information so we -;; can give meaningful compiler error messages -;; read-all/source -> port -> filename +;; Read given file, collecting source location information so we +;; can give meaningful compiler error messages +(define (read-all/source port filename) + (read-all port store-source-info! filename)) ;; read-all -> port -> [objects] (define (read-all . args) - (let ((fp (if (null? args) - (current-input-port) - (car args)))) + (let* ((fp (if (null? args) + (current-input-port) + (car args))) + (ssi! (if (and (pair? args) + (pair? (cdr args))) + (cadr args) + #f)) ;; Default + (fname (if (and ssi! + (pair? (cddr args))) + (caddr args) + #f))) (define (loop fp result) - (let ((obj (read fp))) + (let ((obj (read fp ssi! fname))) (if (eof-object? obj) (reverse result) (loop fp (cons obj result))))) @@ -136,7 +155,37 @@ "(void *data, int argc, closure _, object k, object r, object i)" " Cyc_make_rectangular(data, k, r, i); ") -(define (parse fp) +(define-c get-line-num + "(void *data, int argc, closure _, object k, object port)" + " int num = ((port_type *)port)->line_num; + return_closcall1(data, k, obj_int2obj(num)); ") + +(define-c get-col-num + "(void *data, int argc, closure _, object k, object port)" + " int num = ((port_type *)port)->col_num; + return_closcall1(data, k, obj_int2obj(num)); ") + +(define (store-source-info! obj filename line col) + ;; 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 + 'todo) +;; TODO: need corresponding macro (syntax-error/source ??) to use this +;; information for error reporting +;; TODO: probably want to have a top-level exception handler on macro +;; expansion and call compiler error to report any error along with +;; source info + + +;; Parse given input port and retrieve next token +;; +;; Params: +;; fp - Input port +;; ssi! - "Store Source Info" function, or #f if none +;; fname - Filename being read, or #f if N/A +;; +;; Returns read token +(define (parse fp ssi! fname) (let ((token (read-token fp))) ;;(display "//")(write `(token ,token)) (newline) (cond @@ -146,27 +195,32 @@ (Cyc-opaque-unsafe-string->number token)) ;; Open paren, start read loop ((Cyc-opaque-unsafe-eq? token #\() - ;; TODO: save line number - (let loop ((lis '()) - (t (parse fp))) - (cond - ((eof-object? t) - (read-error fp "missing closing parenthesis")) - ((Cyc-opaque-eq? t #\)) - (if (and (> (length lis) 2) - (equal? (cadr lis) *sym-dot*)) - (->dotted-list (reverse lis)) - ;; TODO: call code here to save line num (only if arg != #f), - ;; want to do this if pair w/car of symbol - (reverse lis))) - (else - (loop (cons t lis) (parse fp)))))) + (let ((line-num (get-line-num fp)) + (col-num (get-col-num fp))) ;; TODO: minus one for paren + (let loop ((lis '()) + (t (parse fp ssi! fname))) + (cond + ((eof-object? t) + (read-error fp "missing closing parenthesis")) + ((Cyc-opaque-eq? t #\)) + (if (and (> (length lis) 2) + (equal? (cadr lis) *sym-dot*)) + (->dotted-list (reverse lis)) + (let ((result (reverse lis))) + (when (and ssi! + (pair? result) + (symbol? (car result))) + ;; Possible macro expansion, save source info + (ssi! result fname line-num col-num)) + result))) + (else + (loop (cons t lis) (parse fp ssi! fname))))))) ((Cyc-opaque-unsafe-eq? token #\') - (list 'quote (parse fp))) + (list 'quote (parse fp ssi! fname))) ((Cyc-opaque-unsafe-eq? token #\`) - (list 'quasiquote (parse fp))) + (list 'quasiquote (parse fp ssi! fname))) ((Cyc-opaque-unsafe-eq? token #\,) - (list 'unquote (parse fp))) + (list 'unquote (parse fp ssi! fname))) (else token))) ;; error if this is returned to original caller of parse ((vector? token) @@ -179,10 +233,10 @@ (let ((t (vector-ref token 0))) (cond ((eq? t *sym-unquote-splicing*) - (list 'unquote-splicing (parse fp))) + (list 'unquote-splicing (parse fp ssi! fname))) ((eq? t *sym-datum-comment*) - (parse fp) ;; Ignore next datum - (parse fp)) + (parse fp ssi! fname) ;; Ignore next datum + (parse fp ssi! fname)) ((string? t) ;; Special case: complex number (let* ((end (vector-ref token 1)) (len (string-length t)) @@ -203,24 +257,24 @@ (error (vector-ref token 0))) (else (let loop ((lis '()) - (t (parse fp))) + (t (parse fp ssi! fname))) (cond ((eof-object? t) (read-error fp "missing closing parenthesis")) ((Cyc-opaque-eq? t #\)) (list->vector (reverse lis))) (else - (loop (cons t lis) (parse fp)))))))) + (loop (cons t lis) (parse fp ssi! fname)))))))) ((bytevector? token) (let loop ((lis '()) - (t (parse fp))) + (t (parse fp ssi! fname))) (cond ((eof-object? t) (read-error fp "missing closing parenthesis")) ((Cyc-opaque-eq? t #\)) (apply bytevector (reverse lis))) (else - (loop (cons t lis) (parse fp)))))) + (loop (cons t lis) (parse fp ssi! fname)))))) (else token)))) ))