Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-12 15:27:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Build out infrastructure to save source info

Browse source 
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 2020-07-16 23:10:48 -04:00
parent 7751464294
commit a4421267e4
1 changed files with 89 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

124
scheme/read.sld
View file

@ -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))))
))