Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-19 13:49:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Relocating source list to (scheme base)

Browse source
This commit is contained in:
Justin Ethier 2020-07-19 22:58:01 -04:00
parent f4ac3c7cb7
commit 858cac4eee
3 changed files with 15 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
cyclone.scm
View file

@ -680,7 +680,7 @@
(define (read-file filename) (define (read-file filename)
(call-with-input-file filename (call-with-input-file filename
(lambda (port) (lambda (port)
(read-all port)))) (read-all/source port filename))))
;; Compile and emit: ;; Compile and emit:
(define (run-compiler args cc? cc-prog cc-exec cc-lib cc-so cc-prog-linker-opts append-dirs prepend-dirs) (define (run-compiler args cc? cc-prog cc-exec cc-lib cc-so cc-prog-linker-opts append-dirs prepend-dirs)

14
scheme/base.sld
View file

@ -9,6 +9,8 @@
(define-library (scheme base) (define-library (scheme base)
(import (scheme cyclone common)) (import (scheme cyclone common))
(export (export
*source-loc-lis*
syntax-error/loc
member member
assoc assoc
cons-source cons-source
@ -232,6 +234,18 @@
fast-string=? fast-string=?
) )
(begin (begin
(define *source-loc-lis* '())
(define (syntax-error/loc reason expr)
(let ((loc-vec (assoc expr *source-loc-lis*)))
(error "Syntax error at "
(vector-ref (assoc loc-vec *source-loc-lis*) 0)
":"
(vector-ref (assoc loc-vec *source-loc-lis*) 1)
":"
(vector-ref (assoc loc-vec *source-loc-lis*) 2)
reason
expr)))
;; Features implemented by this Scheme ;; Features implemented by this Scheme
(define (features) (define (features)
(cons (cons

10
scheme/read.sld
View file

@ -14,8 +14,6 @@
read read
read-all read-all
read-all/source read-all/source
*source-loc-lis*
read-test
include include
include-ci) include-ci)
(inline (inline
@ -28,7 +26,6 @@
(define *sym-dot* (string->symbol ".")) (define *sym-dot* (string->symbol "."))
(define *sym-unquote-splicing* (string->symbol ",@")) (define *sym-unquote-splicing* (string->symbol ",@"))
(define *sym-datum-comment* (string->symbol "#;")) (define *sym-datum-comment* (string->symbol "#;"))
(define *source-loc-lis* '())
(define-syntax include (define-syntax include
(er-macro-transformer (er-macro-transformer
@ -84,12 +81,6 @@
(define (read-all/source port filename) (define (read-all/source port filename)
(read-all port store-source-info! filename)) (read-all port store-source-info! filename))
;; TODO: assume the source-loc-lis needs to be part of (scheme base) so that those macros can use them
(define-syntax read-test
(er-macro-transformer
(lambda (expr rename compare)
(error "read test error" (assoc expr *source-loc-lis*) *source-loc-lis*))))
;; 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)
@ -176,7 +167,6 @@
(define (store-source-info! obj filename line col) (define (store-source-info! obj filename line col)
(set! *source-loc-lis* (set! *source-loc-lis*
;; TODO: not good enough, need to index by file and obj
(cons (cons obj (vector filename line col)) (cons (cons obj (vector filename line col))
*source-loc-lis*))) *source-loc-lis*)))
;; 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