Ben / Nujel

(import (green red) :ansi)

(def nujel-reader
  (let*
    (def Comment (gensym))

    (defn new-symbol (buf start end)
          (:symbol (:cut buf start end)))

    (defn read-symbol (buf start end)
          (def i start)
          (def c 0)
          (while (< i end)
            (set! c (ref buf i))
            (when (or (<= c 32)
                      (= c #\;)
                      (= c #\()
                      (= c #\)))
              (return (cons (new-symbol buf start i) (- i 1))))
            (set! i (inc/int i)))
          (cons (new-symbol buf start i) i))

    (defn read-comment (buf start end)
          (def i start)
          (def c 0)
          (while (< i end)
            (set! c (ref buf i))
            (when (= c 10)
              (return (cons Comment i)))
            (set! i (inc/int i)))
          (return (cons Comment i)))

    (defn read-ml-comment (buf start end)
          (def i start)
          (def l 0)
          (def c 0)
          (while (< i end)
            (set! l c)
            (set! c (ref buf i))
            (when (and (= c #\#)
                       (= l #\|))
              (return (cons Comment i)))
            (set! i (inc/int i)))
          (return (cons Comment i)))

    (defn read-special (buf start end)
          (when (>= start end) (return (cons Comment start)))
          (def c (ref buf start))
          (case c
                (#\! (return (read-comment buf start end)))
                (#\| (return (read-ml-comment buf start end)))
                (#\t (def s (read-symbol buf start end))
                 (if (or (= (car s) 't) (= (car s) 'true))
                     (cons #t (cdr s))
                     (exception :read-error "Unknown #t special value" s)))
                (#\f (def s (read-symbol buf start end))
                 (if (or (= (car s) 'f) (= (car s) 'false))
                     (cons #f (cdr s))
                     (exception :read-error "Unknown #f special value" s)))
                (#\n (def s (read-symbol buf start end))
                 (if (or (= (car s) 'n) (= (car s) 'nil))
                     (cons #nil (cdr s))
                     (exception :read-error "Unknown #n special value" s)))
                (otherwise (cons Comment (inc start)))))

    (defn read-list (buf start end depth)
          (def ret #nil)
          (def i start)
          (while (< i end)
            (def c (ref buf i))
            (cond ((<= c 32) #t)
                  ((= c #\#) (def t (read-special buf (inc i) end))
                   (when-not (= (car t) Comment) (set! ret (cons (car t) ret)))
                   (set! i (cdr t)))
                  ((= c #\;) (set! i (cdr (read-comment buf (inc i) end))))
                  ((= c #\() (def t (read-list buf (inc i) end (inc depth)))
                   (set! ret (cons (car t) ret))
                   (set! i (cdr t)))
                  ((= c #\)) (if (zero? depth)
                                 (exception :read-error "Unmatching parenthesis")
                                 (return (cons (nreverse ret) i))))
                  ((= c #\:) (def t (read-symbol buf (inc i) end))
                   (set! ret (cons (:keyword (car t)) ret))
                   (set! i (cdr t)))
                  (#t (def t (read-symbol buf i end))
                      (set! ret (cons (car t) ret))
                      (set! i (cdr t))))
            (set! i (inc/int i)))
          (cons (nreverse ret) i))

    (defn nujel-reader (buf)
          (car (read-list buf 0 (:length buf) 0)))))

(defn test-reader (file)
      (def raw (slurp file))
      (def l (nujel-reader raw))
      (def t (read raw))
      (pfmtln "-- {file} -- ")
      (pfmtln "{:?} - {:?}" l (map l :type-of))
      (pfmtln "{:?} - {:?}" t (map t :type-of))
      (pfmtln "-- {} --" (if (equal? l t) (green "Both readers return an identical result") (red "ERROR"))))

(for-each (directory/read-recursive "tests/reader") test-reader)