test-parseo.scm

(load "gram.scm")

;; ============================================================
;; parseo test suite
;; ============================================================

(define *pass-count* 0)
(define *fail-count* 0)

(define (test name expected actual)
  (if (equal? expected actual)
      (begin
        (set! *pass-count* (+ *pass-count* 1))
        (printf "  ✓ ~a\n" name))
      (begin
        (set! *fail-count* (+ *fail-count* 1))
        (printf "  ✗ ~a\n    expected: ~a\n    actual:   ~a\n" name expected actual))))

(define id-reducer (make-identity-reducer))
(define tree-reducer (make-tree-reducer))

;; ============================================================
;; parseo with identity reducer on basic regex forms
;; ============================================================

(printf "\n--- parseo identity: lit ---\n")

(test "lit single char"
      '((#\a))
      (run* (out) (full-parseo (lit #\a) (string->list "a") out id-reducer)))

(test "lit string"
      '((#\h #\i))
      (run* (out) (full-parseo (lit "hi") (string->list "hi") out id-reducer)))

(test "lit no match"
      '()
      (run* (out) (full-parseo (lit #\a) (string->list "b") out id-reducer)))

(printf "\n--- parseo identity: set ---\n")

(test "set match digit"
      '((#\5))
      (run 1 (out) (full-parseo (digit) (string->list "5") out id-reducer)))

(test "set match alpha"
      '((#\z))
      (run 1 (out) (full-parseo (lower) (string->list "z") out id-reducer)))

(test "set no match"
      '()
      (run* (out) (full-parseo (digit) (string->list "x") out id-reducer)))

(printf "\n--- parseo identity: cat ---\n")

(test "cat two lits"
      '((#\a #\b))
      (run* (out) (full-parseo (cat (lit #\a) (lit #\b)) (string->list "ab") out id-reducer)))

(test "cat three lits"
      '((#\a #\b #\c))
      (run* (out)
        (full-parseo (cat (lit #\a) (lit #\b) (lit #\c))
                     (string->list "abc") out id-reducer)))

(printf "\n--- parseo identity: alt ---\n")

(test "alt first branch"
      '((#\a))
      (run 1 (out)
        (full-parseo (alt (lit #\a) (lit #\b)) (string->list "a") out id-reducer)))

(test "alt second branch"
      '((#\b))
      (run 1 (out)
        (full-parseo (alt (lit #\a) (lit #\b)) (string->list "b") out id-reducer)))

(test "alt no match"
      '()
      (run* (out)
        (full-parseo (alt (lit #\a) (lit #\b)) (string->list "c") out id-reducer)))

(printf "\n--- parseo identity: opt ---\n")

(test "opt present"
      '((#\a #\b))
      (run 1 (out)
        (full-parseo (cat (opt (lit #\a)) (lit #\b)) (string->list "ab") out id-reducer)))

(test "opt absent"
      '((#\b))
      (run 1 (out)
        (full-parseo (cat (opt (lit #\a)) (lit #\b)) (string->list "b") out id-reducer)))

(printf "\n--- parseo identity: rep ---\n")

(test "rep single"
      '((#\a))
      (run 1 (out)
        (full-parseo (rep (lit #\a)) (string->list "a") out id-reducer)))

(test "rep multiple"
      '((#\a #\a #\a))
      (run 1 (out)
        (full-parseo (rep (lit #\a)) (string->list "aaa") out id-reducer)))

;; ============================================================
;; parseo with identity reducer + sym
;; ============================================================

(printf "\n--- parseo identity: sym ---\n")

(clear-rules!)
(define-rule 'vowel (alt (lit #\a) (lit #\e) (lit #\i) (lit #\o) (lit #\u)))

(test "sym identity returns matched text"
      '(("a"))
      (run 1 (out) (full-parseo (sym 'vowel) (string->list "a") out id-reducer)))

(test "sym identity no match"
      '()
      (run* (out) (full-parseo (sym 'vowel) (string->list "x") out id-reducer)))

;; ============================================================
;; parseo with tree reducer on grammar with sym references
;; ============================================================

(printf "\n--- parseo tree: simple sym ---\n")

(clear-rules!)
(define-rule 'digit (digit))

(test "tree single digit"
      '(((digit #\4)))
      (run 1 (out) (full-parseo (sym 'digit) (string->list "4") out tree-reducer)))

(printf "\n--- parseo tree: sym with rep ---\n")

(clear-rules!)
(define-rule 'digit (digit))
(define-rule 'number (rep (sym 'digit)))

(test "tree number single digit"
      '(((number (digit #\3))))
      (run 1 (out) (full-parseo (sym 'number) (string->list "3") out tree-reducer)))

(test "tree number multiple digits"
      '(((number (digit #\4) (digit #\2))))
      (run 1 (out) (full-parseo (sym 'number) (string->list "42") out tree-reducer)))

;; ============================================================
;; parseo with tree reducer on nested sym references
;; ============================================================

(printf "\n--- parseo tree: nested sym (expr grammar) ---\n")

(clear-rules!)
(define-rule 'digit (digit))
(define-rule 'number (rep (sym 'digit)))
(define-rule 'expr
  (alt (sym 'number)
       (cat (lit #\() (cat (sym 'expr) (cat (lit #\+) (cat (sym 'expr) (lit #\))))))))

(test "tree expr - number"
      '(((expr (number (digit #\5)))))
      (run 1 (out) (full-parseo (sym 'expr) (string->list "5") out tree-reducer)))

(test "tree expr - addition"
      '(((expr #\( (expr (number (digit #\1))) #\+ (expr (number (digit #\2))) #\))))
      (run 1 (out) (full-parseo (sym 'expr) (string->list "(1+2)") out tree-reducer)))

(test "tree expr - nested addition"
      '(((expr #\( (expr #\( (expr (number (digit #\1))) #\+ (expr (number (digit #\2))) #\)) #\+ (expr (number (digit #\3))) #\))))
      (run 1 (out) (full-parseo (sym 'expr) (string->list "((1+2)+3)") out tree-reducer)))

;; ============================================================
;; Verify matched text is correct in reducer
;; ============================================================

(printf "\n--- parseo: matched text correctness ---\n")

;; Use a simple non-recursive grammar to get deterministic call order
(clear-rules!)
(define-rule 'ab (cat (lit #\a) (lit #\b)))
(define-rule 'cd (cat (lit #\c) (lit #\d)))
(define-rule 'top (cat (sym 'ab) (sym 'cd)))

(define *matched-log* '())

(define (logging-reducer node-type matched children)
  (set! *matched-log* (cons (cons node-type matched) *matched-log*))
  `(,node-type ,@children))

(run 1 (out) (full-parseo (sym 'top) (string->list "abcd") out logging-reducer))

(define logged (reverse *matched-log*))

(test "log has 3 entries"
      3
      (length logged))

(test "matched text for ab"
      '(ab . "ab")
      (list-ref logged 0))

(test "matched text for cd"
      '(cd . "cd")
      (list-ref logged 1))

(test "matched text for top"
      '(top . "abcd")
      (list-ref logged 2))

;; Also verify matched text with nested sym (non-rep, deterministic)
(clear-rules!)
(define-rule 'inner (lit "xy"))
(define-rule 'outer (cat (lit #\[) (cat (sym 'inner) (lit #\]))))

(set! *matched-log* '())
(run 1 (out) (full-parseo (sym 'outer) (string->list "[xy]") out logging-reducer))

(define logged2 (reverse *matched-log*))

(test "nested: matched text for inner"
      '(inner . "xy")
      (list-ref logged2 0))

(test "nested: matched text for outer"
      '(outer . "[xy]")
      (list-ref logged2 1))

;; ============================================================
;; full-parseo convenience relation
;; ============================================================

(printf "\n--- full-parseo ---\n")

(clear-rules!)
(define-rule 'letter (alpha))
(define-rule 'word (rep (sym 'letter)))

(test "full-parseo tree word"
      '(((word (letter #\h) (letter #\i))))
      (run 1 (out) (full-parseo (sym 'word) (string->list "hi") out tree-reducer)))

(test "full-parseo identity word"
      '(("hi"))
      (run 1 (out) (full-parseo (sym 'word) (string->list "hi") out id-reducer)))

(test "full-parseo fails on partial match"
      '()
      (run* (out) (full-parseo (lit "ab") (string->list "abc") out id-reducer)))

;; ============================================================
;; Summary
;; ============================================================

(printf "\n~a/~a tests passed.\n" *pass-count* (+ *pass-count* *fail-count*))
(when (> *fail-count* 0)
  (printf "*** ~a FAILURES ***\n" *fail-count*))