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

WIP

Browse source
This commit is contained in:
Justin Ethier 2020-07-20 14:52:46 -04:00
parent 858cac4eee
commit f3c9874e29
2 changed files with 20 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
scheme/base.sld
View file

@ -10,7 +10,7 @@
(import (scheme cyclone common)) (import (scheme cyclone common))
(export (export
*source-loc-lis* *source-loc-lis*
syntax-error/loc syntax-error2
member member
assoc assoc
cons-source cons-source
@ -235,14 +235,21 @@
) )
(begin (begin
(define *source-loc-lis* '()) (define *source-loc-lis* '())
(define (syntax-error/loc reason expr) (define (syntax-error2 reason expr)
(let ((loc-vec (assoc expr *source-loc-lis*))) (Cyc-write expr (current-error-port))
(Cyc-display #\newline (current-error-port))
(let* ((found (assoc expr *source-loc-lis*))
(loc-vec (if found
(cdr found) ;; Get value
(vector #f #f #f))))
(Cyc-display loc-vec (current-error-port))
(Cyc-display #\newline (current-error-port))
(error "Syntax error at " (error "Syntax error at "
(vector-ref (assoc loc-vec *source-loc-lis*) 0) (vector-ref loc-vec 0)
":" ":"
(vector-ref (assoc loc-vec *source-loc-lis*) 1) (vector-ref loc-vec 1)
":" ":"
(vector-ref (assoc loc-vec *source-loc-lis*) 2) (vector-ref loc-vec 2)
reason reason
expr))) expr)))
@ -290,7 +297,8 @@
(define-syntax let (define-syntax let
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)
(if (null? (cdr expr)) (error "empty let" expr)) (if (null? (cdr expr)) (syntax-error2 "empty let" expr))
;(if (null? (cdr expr)) (error "empty let" expr))
(if (null? (cddr expr)) (error "no let body" expr)) (if (null? (cddr expr)) (error "no let body" expr))
((lambda (bindings) ((lambda (bindings)
(if (list? bindings) #f (error "bad let bindings")) (if (list? bindings) #f (error "bad let bindings"))

7
scheme/read.sld
View file

@ -198,7 +198,7 @@
;; Open paren, start read loop ;; Open paren, start read loop
((Cyc-opaque-unsafe-eq? token #\() ((Cyc-opaque-unsafe-eq? token #\()
(let ((line-num (get-line-num fp)) (let ((line-num (get-line-num fp))
(col-num (get-col-num fp))) ;; TODO: minus one for paren (col-num (get-col-num fp)))
(let loop ((lis '()) (let loop ((lis '())
(t (parse fp ssi! fname))) (t (parse fp ssi! fname)))
(cond (cond
@ -213,7 +213,10 @@
(pair? result) (pair? result)
(symbol? (car result))) (symbol? (car result)))
;; Possible macro expansion, save source info ;; Possible macro expansion, save source info
(ssi! result fname line-num col-num)) (ssi! result
fname
line-num
(- col-num 1))) ;; Account for open paren
result))) result)))
(else (else
(loop (cons t lis) (parse fp ssi! fname))))))) (loop (cons t lis) (parse fp ssi! fname)))))))