tokenize.zp

(define (tokenize json) 
  "tokenizes json to array of tokens; 
    e.g. input:  \"{'lol': 1}\"
         output: (json-object ((json-string \"lol\") (prop-delim) (json-num \"1\")))"
  (cdr (_tokenize json)))

(define (tokenize-all json) 
  "tokenizes json to array of tokens; consumes everything, even if it is multiple disjunctive objects;
    e.g. input:  \"{'lol': 1}\"
         output: (json-object ((json-string \"lol\") (prop-delim) (json-num \"1\")))"
  (define (internal-tokenize input l)
      (define tuple (_tokenize input))
      (if (null? (car tuple))
        (+= l (cdr tuple))
        (internal-tokenize (car tuple) (+= l (cdr tuple)))))
  (internal-tokenize json []))

(define (_tokenize json-list)
  "internal tokenizer method; takes a sequence of chars and returns rest and tokenized input"
  (if (null? json-list)
    (list '() '())
  (let* ((token (car json-list)))
    (cond ((char=? token #\,) 
            (list (cdr json-list) ["elem-delim" ","]))
          ((char=? token #\:)
            (list (cdr json-list) ["prop-delim" ":"]))
          ((or (char=? token #\space) (char=? token #\tab) (char=? token #\newline))
            (_tokenize (cdr json-list)))
          ((char=? token #\}) (list json-list '()))
          ((char=? token #\]) (list json-list '()))
          ((char=? token #\{)
            (begin
              (define tuple (parse-json-object (cdr json-list)))
              (list (car tuple) (list "json-object" (cadr tuple)))))
          ((char=? token #\[)
            (begin
              (define tuple (parse-json-array (cdr json-list)))
              (list (car tuple) (list "json-array" (cadr tuple)))))
          ((or (char=? token #\") (char=? token #\'))
            (begin
              (define tuple (parse-json-string (cdr json-list) token))
              (list (car tuple) (list "json-string" (cadr tuple)))))
          ((or (char:num? token) (char=? token #\-))
            (begin
              (define tuple (parse-json-num json-list))
              (list (car tuple) (list "json-num" (cadr tuple)))))
          ((string:starts-with json-list "null")
            (list (drop 4 json-list) (list "json-null")))
          (else (error:from-string "Invalid token" token "in" json-list))))))

(define (parse-json-object l)
  (define (parse-object x s)
    (if (null? x)
      (error:from-string "Unclosed object" s)
      (if (char=? (car x) #\})
        (list (cdr x) s)
        (begin
          (define tuple (_tokenize x))
          (if (null? (cadr tuple))
            (parse-object (car tuple) s)
            (parse-object (car tuple) (+= s (cadr tuple))))))))
  (parse-object l []))

(define (parse-json-array l)
  (define (parse-array x s)
    (if (null? x)
      (error:from-string "Unclosed array" s)
      (if (char=? (car x) #\])
        (list (cdr x) s)
        (begin
          (define tuple (_tokenize x))
          (if (null? (cadr tuple))
            (parse-array (car tuple) s)
            (parse-array (car tuple) (+= s (cadr tuple))))))))
  (parse-array l []))

(define (parse-json-string l token)
  (define (parse-string x s)
    (cond
      ((null? x) (error:from-string "Unclosed string" s))
      ((char=? (car x) #\\)
        (parse-string (cddr x) (++ s (cadr x))))
      ((char=? (car x) token) (list (cdr x) s))
      (else (parse-string (cdr x) (++ s (car x))))))
  (parse-string l ""))

(define (parse-json-num l)
  (define (parse-num x s dot)
    (if (null? x)
      (list x s)
      (cond 
        ((eq? #\. (car x))
          (if dot
            (parse-num (cdr x) (++ s (car x)) #f)
            (error:from-string "Double dot in number " s)))
        ((char:num? (car x)) (parse-num (cdr x) (++ s (car x)) dot))
        (else (list x s)))))
  (if (eq? #\- (get-from l 0 #\0))
    (parse-num (cdr l) "-" #t)
    (parse-num l "" #t)))