mbutterick
/
brag
1
0
Fork 0
Code Issues 3 Pull Requests 1 Projects Releases Wiki Activity
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
master
jackfirth/patch-1
dev-subparser
hide-top-rule-name
v1.1
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'fc61543f29'
${ noResults }
brag/tests/test-flatten.rkt

207 lines
8.7 KiB
Racket
Raw Normal View History Unescape Escape

next
8 years ago
#lang racket/base
Use test submodules for yaragg lang tests
3 years ago
(module+ test
next
8 years ago
Use test submodules for yaragg lang tests
3 years ago
(require yaragg/rules/stx-types
yaragg/codegen/flatten
rackunit)
next
8 years ago
Use test submodules for yaragg lang tests
3 years ago
(define (make-fresh-name)
Run `resyntax` over everything
3 years ago
(define n 0)
(lambda ()
(set! n (add1 n))
(string->symbol (format "r~a" n))))
next
8 years ago
Use test submodules for yaragg lang tests
3 years ago
;; Simple literals
(check-equal? (map syntax->datum (flatten-rule #'(rule expr (lit "hello"))))
'((prim-rule lit expr [(lit "hello")])))
next
8 years ago
Use test submodules for yaragg lang tests
3 years ago
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr
(seq (lit "hello")
(lit "world")))))
'((prim-rule seq expr [(lit "hello") (lit "world")])))
next
8 years ago
Use test submodules for yaragg lang tests
3 years ago
(check-equal? (map syntax->datum (flatten-rule #'(rule expr (token HELLO))))
'((prim-rule token expr [(token HELLO)])))
(check-equal? (map syntax->datum (flatten-rule #'(rule expr (id rule-2))))
'((prim-rule id expr [(id rule-2)])))
;; Sequences of primitives
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (seq (lit "1") (seq (lit "2") (lit "3"))))))
'((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (seq (seq (lit "1") (lit "2")) (lit "3")))))
'((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (seq (seq (lit "1")) (seq (lit "2") (lit "3"))))))
'((prim-rule seq expr
[(lit "1") (lit "2") (lit "3")])))
;; choices
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (choice (id rule-2) (id rule-3)))))
'((prim-rule choice expr
[(id rule-2)]
[(id rule-3)])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (lit "(") (lit ")"))
(seq)))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "(") (lit ")")] [])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (seq (lit "(") (token BLAH))
(lit ")"))
(seq)))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "(") (token BLAH) (lit ")")] [])))
;; maybe
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (maybe (id rule-2)))))
'((prim-rule maybe expr
[(id rule-2)]
[])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (maybe (token HUH)))))
'((prim-rule maybe expr
[(token HUH)]
[])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule expr (maybe (seq (lit "hello") (lit "world"))))))
'((prim-rule maybe expr
[(lit "hello") (lit "world")]
[])))
;; repeat
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 0 #f (id rule-2)))))
'((prim-rule maybe rule-2+ ((inferred-id %rule1 repeat)) ())
(inferred-prim-rule repeat %rule1
((inferred-id %rule1 repeat) (id rule-2))
((id rule-2)))))
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 0 #f (seq (lit "+") (id rule-2))))))
'((prim-rule maybe rule-2+ ((inferred-id %rule2 repeat)) ())
(inferred-prim-rule repeat %rule2
((inferred-id %rule2 repeat) (lit "+") (id rule-2))
((lit "+") (id rule-2)))))
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 1 #f (id rule-2)))))
'((prim-rule repeat rule-2+
[(inferred-id rule-2+ repeat) (id rule-2)]
[(id rule-2)])))
(check-equal? (map syntax->datum
(flatten-rule #'(rule rule-2+ (repeat 1 #f (seq (lit "-") (id rule-2))))))
'((prim-rule repeat rule-2+
[(inferred-id rule-2+ repeat) (lit "-") (id rule-2)]
[(lit "-") (id rule-2)])))
;; Mixtures
;; choice and maybe
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (lit "x")
(maybe (lit "y"))))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "x")]
[(inferred-id r1 maybe)])
(inferred-prim-rule maybe r1
[(lit "y")]
[])))
;; choice, maybe, repeat
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (lit "x")
(maybe (repeat 1 #f (lit "y")))))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "x")]
[(inferred-id r1 maybe)])
(inferred-prim-rule maybe r1
[(inferred-id r2 repeat)]
[])
(inferred-prim-rule repeat r2
[(inferred-id r2 repeat) (lit "y")]
[(lit "y")])))
;; choice, seq
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (choice (seq (lit "x") (lit "y"))
(seq (lit "z") (lit "w"))))
#:fresh-name (make-fresh-name)))
'((prim-rule choice sexp
[(lit "x") (lit "y")]
[(lit "z") (lit "w")])))
;; maybe, choice
(check-equal? (map syntax->datum
(flatten-rule #'(rule sexp (maybe (choice (seq (lit "x") (lit "y"))
(seq (lit "z") (lit "w")))))
#:fresh-name (make-fresh-name)))
'((prim-rule maybe sexp
[(inferred-id r1 choice)]
[])
(inferred-prim-rule choice r1
[(lit "x") (lit "y")]
[(lit "z") (lit "w")])))
(test-case "seq, repeat"
(define rule-stx #'(rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term))))))
(check-equal? (map syntax->datum (flatten-rule rule-stx #:fresh-name (make-fresh-name)))
'((prim-rule seq expr ((id term) (inferred-id r1 repeat)))
(prim-rule maybe r1 ((inferred-id r2 repeat)) ())
(inferred-prim-rule repeat r2
((inferred-id r2 repeat) (lit "+") (id term))
((lit "+") (id term))))))
(test-case "larger example: simple arithmetic"
(define rule-stxs
(syntax->list
#'((rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term)))))
(rule term (seq (id factor) (repeat 0 #f (seq (lit "*") (id factor)))))
(rule factor (token INT)))))
(check-equal? (map syntax->datum (flatten-rules rule-stxs #:fresh-name (make-fresh-name)))
next
8 years ago
Use test submodules for yaragg lang tests
3 years ago
'((prim-rule seq expr ((id term) (inferred-id r1 repeat)))
(prim-rule maybe r1 ((inferred-id r2 repeat)) ())
(inferred-prim-rule repeat r2
((inferred-id r2 repeat) (lit "+") (id term))
((lit "+") (id term)))
(prim-rule seq term ((id factor) (inferred-id r3 repeat)))
(prim-rule maybe r3 ((inferred-id r4 repeat)) ())
(inferred-prim-rule repeat r4
((inferred-id r4 repeat) (lit "*") (id factor))
((lit "*") (id factor)))
(prim-rule token factor ((token INT)))))))