(def parseword (cs base)
  (or (parsenum cs base)
      (if (= cs ".")       (err 'unexpected-dot)
          (mem \| cs)      (parset cs base)
          (some intrac cs) (parseslist (runs intrac cs) base)
                           (parsecom cs base))))

(def parsenum (cs base)
  (if (validi cs base)
      (buildnum srzero (parsei cs base))
      (let sign (check (car cs) signc)
        (let (ds es) (split signc (if sign (cdr cs) cs))
          (and (validr ds base)
               (or (no es) (validi es base))
               (buildnum (parsesr (consif sign ds) base)
                         (if (no es) srzero (parsei es base))))))))

(def validi (cs base)
  (and (signc (car cs))
       (= (last cs) \i)
       (let digs (cdr (dock cs))
         (or (no digs) (validr digs base)))))

(def validr (cs base)
  (or (validd cs base)
      (let (n d) (split (is \/) cs)
        (and (validd n base)
             (validd (cdr d) base)))))

(def validd (cs base)
  (and (all (cor [digit _ base] (is \.)) cs)
       (some [digit _ base] cs)
       (~cdr (keep (is \.) cs))))

(def parsei (cs base)
  (if (cddr cs)
      (parsesr (dock cs) base)
      (if (caris cs \+)
          srone
          (srinv srone))))

(def parsesr (cs base)
  (withs (sign  (if (signc (car cs)) (sym (list (car cs))))
          (n d) (split (is \/) (if sign (cdr cs) cs)))
    (simplify (cons (or sign '+)
                    (r/ (parsed n base)
                        (if d
                            (let rd (parsed (cdr d) base)
                              (if (caris rd i0)
                                  (err 'zero-denominator)
                                  rd))
                            (list i1 i1)))))))

(def parsed (cs base)
  (let (i f) (split (is \.) cs)
    (if (cdr f)
        (list (parseint (rev (append i (cdr f))) base)
              (i^ base
                  (apply i+ (map (con i1) (cdr f)))))
        (list (parseint (rev i) base) i1))))

(def parseint (ds base)
  (if ds
      (i+ (charint (car ds))
          (i* base (parseint (cdr ds) base)))
      i0))

(def charint (c)
  (map (con t) (mem c "fedcba987654321")))

(def parset (cs base)
  (if (cdr (keep (is \|) cs))
      (err 'multiple-bars)
      (let vt (tokens cs \|)
        (if (= (len vt) 2)
            (cons t (map [parseword _ base] vt))
            (err 'bad-tspec)))))

(def parseslist (rs base)
  (if (intrac (car (last rs)))
      (err 'final-intrasymbol)
      (map (fn ((cs ds))
             (if (cdr cs)      (err 'double-intrasymbol)
                 (caris cs \!) (list 'quote (parsecom ds base))
                               (parsecom ds base)))
           (hug (if (intrac (car (car rs)))
                    (cons "." "upon" rs)
                    (cons "." rs))))))

(def parsecom (cs base)
  (if (mem \: cs)
      (cons 'compose (map [parseno _ base] (tokens cs \:)))
      (parseno cs base)))

(def parseno (cs base)
  (if (caris cs \~)
      (if (cdr cs)
          (list 'compose 'no (parseno (cdr cs) base))
          'no)
      (or (parsenum cs base) (sym cs))))