diff --git a/sex-reader.scm b/sex-reader.scm index 2f3f07b..05f192f 100644 --- a/sex-reader.scm +++ b/sex-reader.scm @@ -2,9 +2,15 @@ (include "utils.macros.scm") -(import (chicken pathname) - brev-separate - fmt) +(import + (chicken base) + (chicken io) + (chicken pathname) + (chicken port) + (chicken read-syntax) + (chicken string) + brev-separate + fmt) (define (read-forms acc) (let ((r (read))) @@ -16,7 +22,41 @@ (with-input-from-file (pathname-strip-directory file) (fn (read-forms (list)))))) +(define (read-bracket port) + (let loop ((c (read-char port)) + (str (string))) + (cond ((char=? c #\]) + (cons '¤ + (with-input-from-string str + (fn (port-map identity read))))) + ((char=? c #\[) + (loop port (conc ))) + (else + (loop (read-char port) + (conc str c)))))) + +(define open-bracket-counter (make-parameter 0)) + (define (read-raw-forms input-source) + (let ((bracket-end (gensym))) + (set-read-syntax! + #\] + (lambda (port) + (when (= 0 (open-bracket-counter)) + (error "Unmatched closing bracket")) + (open-bracket-counter (- (open-bracket-counter) 1)) + bracket-end)) + + (set-read-syntax! + #\[ + (lambda (port) + (open-bracket-counter (+ (open-bracket-counter) 1)) + (let loop ((r (read port)) + (acc (list))) + (if (eq? r bracket-end) + (cons '¤ (reverse acc)) + (loop (read port) + (cons r acc))))))) (if (eq? input-source 'stdin) (read-forms (list)) (read-from-file input-source))) diff --git a/tests/basic.scm b/tests/basic.scm index 847a7bd..2d62f8b 100644 --- a/tests/basic.scm +++ b/tests/basic.scm @@ -19,7 +19,7 @@ (test '%define (atom-to-fmt-c 'define)) (test '%pointer (atom-to-fmt-c 'pointer)) (test '%array (atom-to-fmt-c 'array)) -(test 'vector-ref (atom-to-fmt-c '@)) +(test 'vector-ref (atom-to-fmt-c '¤)) (test '%include (atom-to-fmt-c 'include)) (test '%cast (atom-to-fmt-c 'cast)) diff --git a/tests/reader.scm b/tests/reader.scm new file mode 100644 index 0000000..85f8bfb --- /dev/null +++ b/tests/reader.scm @@ -0,0 +1,28 @@ +(import (chicken port)) + +(test-group "reader" + ;; []-syntax. For array types and array access expressions + (test '((¤ * char)) + (with-input-from-string "[* char]" + (lambda () + (read-raw-forms 'stdin)))) + + (test '((¤ * * char const 512)) + (with-input-from-string "[* * char const 512]" + (lambda () + (read-raw-forms 'stdin)))) + + (test '((¤)) + (with-input-from-string "[]" + (lambda () + (read-raw-forms 'stdin)))) + + (test '((¤ (¤))) + (with-input-from-string "[[]]" + (lambda () + (read-raw-forms 'stdin)))) + + (test '((¤ (¤ const char))) + (with-input-from-string "[[const char]]" + (lambda () + (read-raw-forms 'stdin))))) diff --git a/tests/run.scm b/tests/run.scm index 330a174..6411d71 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -9,6 +9,7 @@ (include "basic.scm") (include "semen.scm") +(include "reader.scm") (include "utils.scm") ;;; Should be the last in the test suite