mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-13 07:47:39 +02:00
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.
This commit is contained in:
Justin Ethier
parent
7751464294
commit
a4421267e4
1 changed files with 89 additions and 35 deletions
124
scheme/read.sld
124
scheme/read.sld
|
|
@ -13,6 +13,7 @@
|
||||||
(export
|
(export
|
||||||
read
|
read
|
||||||
read-all
|
read-all
|
||||||
|
read-all/source
|
||||||
include
|
include
|
||||||
include-ci)
|
include-ci)
|
||||||
(inline
|
(inline
|
||||||
|
|
@ -60,23 +61,41 @@
|
||||||
(lambda args
|
(lambda args
|
||||||
(let ((fp (if (null? args)
|
(let ((fp (if (null? args)
|
||||||
(current-input-port)
|
(current-input-port)
|
||||||
(car args))))
|
(car args)))
|
||||||
(let ((result (parse fp)))
|
(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)
|
(if (Cyc-opaque? result)
|
||||||
(read-error fp "unexpected closing parenthesis")
|
(read-error fp "unexpected closing parenthesis")
|
||||||
result)))))
|
result)))))
|
||||||
|
|
||||||
;; TODO: read given file, collecting source location information so we
|
;; Read given file, collecting source location information so we
|
||||||
;; can give meaningful compiler error messages
|
;; can give meaningful compiler error messages
|
||||||
;; read-all/source -> port -> filename
|
(define (read-all/source port filename)
|
||||||
|
(read-all port store-source-info! filename))
|
||||||
|
|
||||||
;; read-all -> port -> [objects]
|
;; read-all -> port -> [objects]
|
||||||
(define (read-all . args)
|
(define (read-all . args)
|
||||||
(let ((fp (if (null? args)
|
(let* ((fp (if (null? args)
|
||||||
(current-input-port)
|
(current-input-port)
|
||||||
(car args))))
|
(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)
|
(define (loop fp result)
|
||||||
(let ((obj (read fp)))
|
(let ((obj (read fp ssi! fname)))
|
||||||
(if (eof-object? obj)
|
(if (eof-object? obj)
|
||||||
(reverse result)
|
(reverse result)
|
||||||
(loop fp (cons obj result)))))
|
(loop fp (cons obj result)))))
|
||||||
|
|
@ -136,7 +155,37 @@
|
||||||
"(void *data, int argc, closure _, object k, object r, object i)"
|
"(void *data, int argc, closure _, object k, object r, object i)"
|
||||||
" Cyc_make_rectangular(data, k, r, 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)))
|
(let ((token (read-token fp)))
|
||||||
;;(display "//")(write `(token ,token)) (newline)
|
;;(display "//")(write `(token ,token)) (newline)
|
||||||
(cond
|
(cond
|
||||||
|
|
@ -146,27 +195,32 @@
|
||||||
(Cyc-opaque-unsafe-string->number token))
|
(Cyc-opaque-unsafe-string->number token))
|
||||||
;; Open paren, start read loop
|
;; Open paren, start read loop
|
||||||
((Cyc-opaque-unsafe-eq? token #\()
|
((Cyc-opaque-unsafe-eq? token #\()
|
||||||
;; TODO: save line number
|
(let ((line-num (get-line-num fp))
|
||||||
(let loop ((lis '())
|
(col-num (get-col-num fp))) ;; TODO: minus one for paren
|
||||||
(t (parse fp)))
|
(let loop ((lis '())
|
||||||
(cond
|
(t (parse fp ssi! fname)))
|
||||||
((eof-object? t)
|
(cond
|
||||||
(read-error fp "missing closing parenthesis"))
|
((eof-object? t)
|
||||||
((Cyc-opaque-eq? t #\))
|
(read-error fp "missing closing parenthesis"))
|
||||||
(if (and (> (length lis) 2)
|
((Cyc-opaque-eq? t #\))
|
||||||
(equal? (cadr lis) *sym-dot*))
|
(if (and (> (length lis) 2)
|
||||||
(->dotted-list (reverse lis))
|
(equal? (cadr lis) *sym-dot*))
|
||||||
;; TODO: call code here to save line num (only if arg != #f),
|
(->dotted-list (reverse lis))
|
||||||
;; want to do this if pair w/car of symbol
|
(let ((result (reverse lis)))
|
||||||
(reverse lis)))
|
(when (and ssi!
|
||||||
(else
|
(pair? result)
|
||||||
(loop (cons t lis) (parse fp))))))
|
(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 #\')
|
((Cyc-opaque-unsafe-eq? token #\')
|
||||||
(list 'quote (parse fp)))
|
(list 'quote (parse fp ssi! fname)))
|
||||||
((Cyc-opaque-unsafe-eq? token #\`)
|
((Cyc-opaque-unsafe-eq? token #\`)
|
||||||
(list 'quasiquote (parse fp)))
|
(list 'quasiquote (parse fp ssi! fname)))
|
||||||
((Cyc-opaque-unsafe-eq? token #\,)
|
((Cyc-opaque-unsafe-eq? token #\,)
|
||||||
(list 'unquote (parse fp)))
|
(list 'unquote (parse fp ssi! fname)))
|
||||||
(else
|
(else
|
||||||
token))) ;; error if this is returned to original caller of parse
|
token))) ;; error if this is returned to original caller of parse
|
||||||
((vector? token)
|
((vector? token)
|
||||||
|
|
@ -179,10 +233,10 @@
|
||||||
(let ((t (vector-ref token 0)))
|
(let ((t (vector-ref token 0)))
|
||||||
(cond
|
(cond
|
||||||
((eq? t *sym-unquote-splicing*)
|
((eq? t *sym-unquote-splicing*)
|
||||||
(list 'unquote-splicing (parse fp)))
|
(list 'unquote-splicing (parse fp ssi! fname)))
|
||||||
((eq? t *sym-datum-comment*)
|
((eq? t *sym-datum-comment*)
|
||||||
(parse fp) ;; Ignore next datum
|
(parse fp ssi! fname) ;; Ignore next datum
|
||||||
(parse fp))
|
(parse fp ssi! fname))
|
||||||
((string? t) ;; Special case: complex number
|
((string? t) ;; Special case: complex number
|
||||||
(let* ((end (vector-ref token 1))
|
(let* ((end (vector-ref token 1))
|
||||||
(len (string-length t))
|
(len (string-length t))
|
||||||
|
|
@ -203,24 +257,24 @@
|
||||||
(error (vector-ref token 0)))
|
(error (vector-ref token 0)))
|
||||||
(else
|
(else
|
||||||
(let loop ((lis '())
|
(let loop ((lis '())
|
||||||
(t (parse fp)))
|
(t (parse fp ssi! fname)))
|
||||||
(cond
|
(cond
|
||||||
((eof-object? t)
|
((eof-object? t)
|
||||||
(read-error fp "missing closing parenthesis"))
|
(read-error fp "missing closing parenthesis"))
|
||||||
((Cyc-opaque-eq? t #\))
|
((Cyc-opaque-eq? t #\))
|
||||||
(list->vector (reverse lis)))
|
(list->vector (reverse lis)))
|
||||||
(else
|
(else
|
||||||
(loop (cons t lis) (parse fp))))))))
|
(loop (cons t lis) (parse fp ssi! fname))))))))
|
||||||
((bytevector? token)
|
((bytevector? token)
|
||||||
(let loop ((lis '())
|
(let loop ((lis '())
|
||||||
(t (parse fp)))
|
(t (parse fp ssi! fname)))
|
||||||
(cond
|
(cond
|
||||||
((eof-object? t)
|
((eof-object? t)
|
||||||
(read-error fp "missing closing parenthesis"))
|
(read-error fp "missing closing parenthesis"))
|
||||||
((Cyc-opaque-eq? t #\))
|
((Cyc-opaque-eq? t #\))
|
||||||
(apply bytevector (reverse lis)))
|
(apply bytevector (reverse lis)))
|
||||||
(else
|
(else
|
||||||
(loop (cons t lis) (parse fp))))))
|
(loop (cons t lis) (parse fp ssi! fname))))))
|
||||||
(else
|
(else
|
||||||
token))))
|
token))))
|
||||||
))
|
))
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue