gistfile1.lisp

(defparameter *true* t)
(defparameter *false* nil)
(defparameter *null* nil)
(defparameter *empty-dict* nil)
(defparameter *empty-list* nil)
(declaim (optimize (speed 3)))

(defun <isfloat>  ()
  (=and
    (smug:int)
    (=char #\.)
    (natural-number)))

(defun <tnetpair> ()
  (=let*
    ((a (<tnetstring>))
     (b (<tnetstring>)))
    (result (cons a b))))

(defun <tnetstring> () 
  (=let*
    ((length (natural-number))
     (_ (=char #\:))
     (val
       (if (= 0 length)
         (result nil)
         (exactly length (item))
         ))
     (tag (=satisfies
            (lambda (x)
              (not (null (find x ",#]}^!~")))))))
    (let ((val (concatenate 'string val)))
      (case tag
      (#\, (result val))
      (#\# (let 
             ((x (funcall (int) val)))
             (if (and x (= (length (cdar x)) 0))
               (result (caar x))
               (fail))))
      (#\^ (let 
             ((x (funcall (<isfloat>) val)))
             (if (and x (= (length (cdar x)) 0))
               (result (read-from-string val))
               (fail))))
      (#\! (cond
             ((equal val "true") (result *true*))
             ((equal val "false") (result *false*))
             (t (fail))))
      (#\~ (if (= 0 length)
             (result *null*) (fail)))
      (#\} (let
             ((x (funcall
                   (=prog1
                     (zero-or-more (<tnetpair>))
                     (=not (item))) val)))
             (if (null x) (fail)
               (result (caar x)))
             ))
      (#\] (let
             ((x (funcall
                   (=prog1
                     (zero-or-more (<tnetstring>))
                     (=not (item))) val)))
             (if (null x) (fail)
               (result (caar x)))))))))