lex.zp

(define (lex stream)
  (cond
    ((null? stream) (error:from-string "Got an empty token stream"))
    ((null? (car stream)) (error:from-string "Encountered empty token"))
    (else
      (let* ((token (car stream))
             (token-key (car token))
             (token-value (cadr token)))
        (case token-key
          (("json-array")
            (lex-array token-value))
          (("json-object")
            (lex-object token-value))
          (("json-num" "json-null") #t)
          (("json-string") (string? token-value))
          (else (error:from-string "Unknown token key" token-key)))))))

(define (lex-all stream) (all? lex stream))

(define (lex-array stream)
  (case (length stream)
    ((0) #t)
    ((1)
      (lex (list (car stream))))
    ((2) (error:from-string "Unknown token" stream))
    (else
      (let* ((next (caadr stream)))
        (if (eq? next "elem-delim")
            (and (lex (list (car stream))) (lex-array (cddr stream)))
            (error:from-string "Expected array delimiter token, got" next))))))

(define (lex-object stream)
  (cond
    ((null? stream) #t)
    ((< (length stream) 3) (error:from-string "Got an invalid object" stream))
    ((not (eq? (caadr stream) "prop-delim"))
      (error:from-string "Expected property delimiter in object, got"
                         (caadr stream)))
    (else
      (begin
        (lex (list (caddr stream)))
        (if (> (length stream) 3)
          (and (eq? (car (list:ref stream 3)) "elem-delim")
               (lex-object (cddddr stream)))
          #t)))))