parse.jpr

(mac defp (name args 'body)
  `(def ,name ,args
     (fn (xs i)
       ,@body)))

(defp transform (f p)
  (let (err res i) (p xs i)
    (if err
	(list err)
	(list false (f res) i))))

(mac transp (arg body p)
  `(transform (fn (,arg)
		,body)
	      ,p))

(defp dbgp (f)
  (let foo (f xs i)
    (prn i foo)
    foo))

(def adigit (x)
  (<= "0" x "9"))

(def asymbol-char (x)
  (or (<= 'a x 'z) (<= 'A x 'Z) (adigit x) (some x '!/%-$<>_+*=)))

(def read-number (xs i)
  (let end i
    (if (some (get xs end) '+-) (++ end))
    (zap each-from-while end x xs (adigit x))
    (when (is (get xs end) '.)
      (++ end)
      (zap each-from-while end x xs (adigit x)))
    (list false (asnumber (xs.substring i end)) end)))

(def read-symbol (xs i)
  (let end (+ i 1)
    (zap each-from-while end x xs (asymbol-char x))
    (list false (xs.substring i end) end)))

(def symbol/number (xs i)
  ((if (adigit (get xs (+ i 1)))
       read-number
       read-symbol)
   xs i))

(def make-error (xs i msg)
  (let foo ((xs.substring 0 i).split "\n")
    `((,@msg ,(get xs i) at line ,foo.length collumn ,(get foo (- foo.length 1)).length))))

(def read-escaped (xs i)
  (let end (+ i 1)
    (aif (case (get xs end)
	   n "\n"
	   t "\t"
	   (if (some (get xs end) "\\\"|")
	       (get xs end)))
	 (list false it (+ end 1))
	 (make-error xs end '(no escape char)))))

(defp many-delimited (f delimeter)
  (++ i)
  (with (res ()
	 err false)
    (while (no (or (is (get xs i) delimeter) err))
      (if (is (get xs i) undefined)
	  (= err '((unexpected end of input)))
	  (let (newerr bar newi) (f xs i)
	    (if newerr
		(= err (list newerr))
		(do
		  (res.push bar)
		  (= i newi))))))
    (or err (list false res (+ i 1)))))

(assign seps "\n\t ")

(defp pthunk (f)
  ((f) xs i))

(assign read-list (many-delimited (pthunk (fn () dotted-expression)) ")"))

(assign read-bracket-list
	(transp xs `(|[| ,@xs)
		(many-delimited (pthunk (fn () dotted-expression)) "]")))

(defp string-part (delimeter)
  (if (is (get xs i) "\\")
      (read-escaped xs i)
      (let end (each-from-while i x xs (no (some x (list "\\" delimeter))))
	(list false (xs.substring i end) end))))

(assign read-piped-symbol (transp xs
				  (apply str xs)
				  (many-delimited (string-part "|") "|")))

(assign read-string (transp xs
			    (list '' (apply str xs))
			    (many-delimited (string-part "\"") "\"")))

(def read-modifer (xs i)
  (with (end (+ i (if (is (get xs (+ i 1)) "@")
		      2
		      1))
	 modifer (xs.substring i end))
    (if (some (get xs end) (str seps ")]"))
	(list false modifer end)
	(let (err res i) (dotted-expression xs end)
	  (if err
	      (list err)
	      (list false (list modifer res) i))))))

(def expression (xs i)
  (let c (get xs i)
    ((case c
      |"| read-string
      |\|| read-piped-symbol
      |(| read-list
      |[| read-bracket-list
      (if (adigit c) read-number
	  (some c '+-) symbol/number
	  (or (asymbol-char c) (is '. c)) read-symbol
	  (some c "`',") read-modifer
	  (fn (xs i)
	    (make-error xs i '(unexpected char)))))
     xs i)))

(def sep (xs i) (each-from-while i x xs (some x seps)))

(def second-expression (xs i front)
  (let (err back end) (expression xs (+ i 1))
    (if err
	(list err)
	(let bla (list (case (get xs i)
			 . '.
			 |:| 'get)
		       front back)
	  (if (some (get xs end) ".:")
	      (second-expression xs end bla)
	      (list false bla (sep xs end)))))))

(def dotted-expression (xs i)
  (= i (sep xs i))
  (let (err front i) (expression xs i)
    (if err
	(list err)
	(some (get xs i) ".:")
	(second-expression xs i front)
	(list false front (sep xs i)))))

(assign read-file (fn (xs i) ((many-delimited dotted-expression undefined)
			      xs (- i 1))))

(def pfile (xs i)
  (let (err res i) (read-file xs i)
    (or err (list res i))))