anb.scm

(use www.css)
(select-module www.css)
(define %an+b
  (let ()
    (define %+ ($seq ($delim #\+) ($return +)))
    (define %- ($seq ($delim #\-) ($return -)))
    (define %opt-sign
      ($optional ($or %+ %-) +))
    (define %n   ($match1 ('IDENT . 'n)))
    (define %-n  ($match1 ('IDENT . '-n)))
    (define %n-  ($match1 ('IDENT . 'n-)))
    (define %-n- ($match1 ('IDENT . '-n-)))
    (define %n-dimension
      ($lift cdr ($match1 ('DIMENSION (? integer?) 'n))))
    (define %ndash-dimension
      ($lift cdr ($match1 ('DIMENSION (? integer?) 'n-))))
    (define (ndashdigit-symbol? s)
      (and (symbol? s)
           (#/^n-[0-9]+$/ (symbol->string s))))
    (define (ndashdigit-symbol-integer s)
      (string->number
       (string-copy (symbol->string s) 1)))
    (define %ndashdigit-dimension
      ($lift cdr ($match1 ('DIMENSION (? integer?) (? ndashdigit-symbol?)))))
    (define %ndashdigit-ident
      ($lift cdr ($match1 ('IDENT . (? ndashdigit-symbol?)))))
    (define (dashndashdigit-symbol? s)
      (and (symbol? s)
           (#/^-n-[0-9]+$/ (symbol->string s))))
    (define (dashndashdigit-symbol-integer s)
      (string->number
       (string-copy (symbol->string s) 2)))
    (define %dashndashdigit-ident
      ($lift cdr ($match1 ('IDENT . (? dashndashdigit-symbol?)))))
    (define %integer
      ($lift cdr ($match1 ('NUMBER . (? integer?)))))
    (define (an+b a b)
      `(:an+b ,a ,b))
    ($/
     ;; 16. [+-]?<N>'n' [+-] <N>
     ($let ((s %opt-sign)
            (dim %n-dimension)
            (_ %WS*)
            (op ($or %+ %-))
            (_ %WS*)
            (b %integer))
       ($return (an+b (s (car dim)) (op b))))
     ;; 17. '+'?'n' [+-] <N>
     ($let ((_ ($optional %+))
            (_ %n)
            (_ %WS*)
            (op ($or %+ %-))
            (_ %WS*)
            (b %integer))
       ($return (an+b 1 (op b))))
     ;; 18. '-n' [+-] <N>
     ($let ((_ %-n)
            (_ %WS*)
            (op ($or %+ %-))
            (_ %WS*)
            (b %integer))
       ($return (an+b -1 (op b))))

     ;; 13. <N>n- <N>
     ($let ((s %opt-sign)
            (dim %ndash-dimension)
            (_ %WS*)
            (b %integer))
       ($return (an+b (s (car dim)) (- b))))
     ;; 14. +?n- <N>
     ($let ((_ ($optional %+))
            (_ %n-)
            (_ %WS*)
            (b %integer))
       ($return (an+b 1 (- b))))
     ;; 15. -n- <N>
     ($let ((_ %-n-)
            (_ %WS*)
            (b %integer))
       ($return (an+b -1 (- b))))

     ;; NB: www.css does not have signed integer
     ;; 10. <n-dimension> <signed-integer>
     ;; 11. '+'? 'n' <signed-integer>
     ;; 12. '-n' <signed-integer>

     ;; 7. <N>'n-'<N>
     ($let ((dim %ndashdigit-dimension))
       ($return (an+b (car dim)
                      (ndashdigit-symbol-integer (cadr dim)))))
     ;; 8. '+'?'n-'<N>
     ($let ((_ ($optional %+))
            (i %ndashdigit-ident))
       ($return (an+b 1 (ndashdigit-symbol-integer i))))
     ;; 9. '-n-'<N>
     ($let ((i %dashndashdigit-ident))
       ($return (an+b -1 (dashndashdigit-symbol-integer i))))

     ;; 4. <N>n
     ($let ((s %opt-sign)
            (dim %n-dimension))
       ($return (an+b (s (car dim)) 0)))
     ;; 5. '+'?n
     ($let ((_ ($optional %+))
            (_ %n))
       ($return (an+b 1 0)))
     ;; 6. -n
     ($let ((_ %-n))
       ($return (an+b -1 0)))

     ;; 1. odd
     ($let ((_ ($match1 ('IDENT . 'odd))))
       ($return (an+b 2 1)))
     ;; 2. even
     ($let ((_ ($match1 ('IDENT . 'even))))
       ($return (an+b 2 0)))
     ;; 3. <integer>
     ($let ((s %opt-sign)
            (n %integer))
       ($return (an+b 0 (s n))))
     )))