mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-24 20:45:06 +02:00
Prevent overwritting evn's when importing from repl
This commit is contained in:
parent
152a210619
commit
b350a0cf33
4 changed files with 53 additions and 32 deletions
|
@ -4,6 +4,7 @@
|
||||||
|
|
||||||
Features
|
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)`.
|
- Added `c-void` type into `(cyclone foreign)`.
|
||||||
|
|
||||||
Bug Fixes
|
Bug Fixes
|
||||||
|
|
|
@ -9,8 +9,6 @@
|
||||||
(define-library (scheme base)
|
(define-library (scheme base)
|
||||||
(import (scheme cyclone common))
|
(import (scheme cyclone common))
|
||||||
(export
|
(export
|
||||||
*source-loc-lis*
|
|
||||||
error/loc
|
|
||||||
member
|
member
|
||||||
assoc
|
assoc
|
||||||
cons-source
|
cons-source
|
||||||
|
@ -132,6 +130,7 @@
|
||||||
error-object-irritants
|
error-object-irritants
|
||||||
; TODO: file-error?
|
; TODO: file-error?
|
||||||
; TODO: read-error?
|
; TODO: read-error?
|
||||||
|
error/loc
|
||||||
error
|
error
|
||||||
raise
|
raise
|
||||||
raise-continuable
|
raise-continuable
|
||||||
|
@ -234,33 +233,6 @@
|
||||||
fast-string=?
|
fast-string=?
|
||||||
)
|
)
|
||||||
(begin
|
(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
|
;; Features implemented by this Scheme
|
||||||
(define (features)
|
(define (features)
|
||||||
(cons
|
(cons
|
||||||
|
@ -1310,6 +1282,41 @@
|
||||||
}
|
}
|
||||||
return_closcall1(data, k, thd->exception_handler_stack); ")
|
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
|
;; Simplified versions of every/any from SRFI-1
|
||||||
(define (any pred lst)
|
(define (any pred lst)
|
||||||
(let any* ((l (map pred lst)))
|
(let any* ((l (map pred lst)))
|
||||||
|
|
|
@ -13,7 +13,10 @@
|
||||||
*version-number*
|
*version-number*
|
||||||
*version-name*
|
*version-name*
|
||||||
*version-banner*
|
*version-banner*
|
||||||
*c-file-header-comment*)
|
*c-file-header-comment*
|
||||||
|
*reader-source-db*
|
||||||
|
memloc
|
||||||
|
)
|
||||||
(begin
|
(begin
|
||||||
(define *version-number* "0.19")
|
(define *version-number* "0.19")
|
||||||
(define *version-name* "")
|
(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);")
|
||||||
|
|
||||||
))
|
))
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
;;;;
|
;;;;
|
||||||
(define-library (scheme read)
|
(define-library (scheme read)
|
||||||
(import (scheme base)
|
(import (scheme base)
|
||||||
|
(scheme cyclone common)
|
||||||
;(scheme write)
|
;(scheme write)
|
||||||
(scheme char))
|
(scheme char))
|
||||||
(export
|
(export
|
||||||
|
@ -173,9 +174,9 @@
|
||||||
return_closcall1(data, k, obj_int2obj(num)); ")
|
return_closcall1(data, k, obj_int2obj(num)); ")
|
||||||
|
|
||||||
(define (store-source-info! obj filename line col)
|
(define (store-source-info! obj filename line col)
|
||||||
(set! *source-loc-lis*
|
(set! *reader-source-db*
|
||||||
(cons (cons obj (vector filename line col))
|
(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
|
;; 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,
|
;; be accessible from macro's. probably needs to be in global env,
|
||||||
;; see (cyclone foreign) for an example
|
;; see (cyclone foreign) for an example
|
||||||
|
|
Loading…
Add table
Reference in a new issue