Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix weird syntax pair bug #141

Merged
merged 8 commits into from
Dec 27, 2023
Merged

Fix weird syntax pair bug #141

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
8960650
Fix(?) weird syntax pair bug
countvajhula Dec 22, 2023
aa253b1
recipe for tagging syntax for testing using a template metafunction
countvajhula Dec 23, 2023
3880647
Commit improved "weird syntax pair bug" fix from the meeting
countvajhula Dec 23, 2023
c09499b
First attempt at fixing the tests with the new syntax property
countvajhula Dec 23, 2023
a54d963
Fix failing compiler utils tests
countvajhula Dec 23, 2023
79c0f71
Fix remaining compiler tests by attaching `nonterminal` syntax property
countvajhula Dec 23, 2023
2950e84
improve test doc
countvajhula Dec 23, 2023
4938e0a
improve a macro used in testing for comparing syntax
countvajhula Dec 23, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 12 additions & 1 deletion qi-lib/flow/core/util.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,10 @@
(require racket/match
syntax/parse)

(define (form-position? v)
(and (syntax? v)
(syntax-property v 'nonterminal)))

;; Walk the syntax tree in a "top down" manner, i.e. from the root down
;; to the leaves, applying a transformation to each node.
;; The transforming function is expected to either return transformed
Expand Down Expand Up @@ -42,8 +46,15 @@
;; #%host-expression is a Racket macro defined by syntax-spec
;; that resumes expansion of its sub-expression with an
;; expander environment containing the original surface bindings
;; TODO: technically should be ~literal host expression to not
;; collide with a user-defined #%host-expression binding, but that
;; would never be hit in practice since that would be rewritten
;; through expansion to a use of the core language. In general,
;; we should be using ~literal matching throughout the compiler.
(find-and-map (syntax-parser [((~datum #%host-expression) e:expr) #f]
[_ (f this-syntax)])
[_ (if (form-position? this-syntax)
(f this-syntax)
this-syntax)])
stx))

;; Applies f repeatedly to the init-val terminating the loop if the
Expand Down
48 changes: 27 additions & 21 deletions qi-test/tests/compiler/rules.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,17 +8,21 @@
rackunit/text-ui
(only-in math sqr)
racket/string
(only-in "../private/util.rkt" tag-syntax)
(only-in racket/list
range)
syntax/parse/define)

;; NOTE: we need to tag test syntax with `tag-syntax`
;; in most cases. See the comment on that function definition.

(define-syntax-parse-rule (test-normalize name a b ...+)
(begin
(test-equal? name
(syntax->datum
(normalize-pass a))
(normalize-pass (tag-syntax a)))
(syntax->datum
(normalize-pass b)))
(normalize-pass (tag-syntax b))))
...))

(define (deforested? exp)
Expand Down Expand Up @@ -467,21 +471,8 @@

(test-suite
"deforest-pass"
(let ([stx #'(amp
(thread
(#%blanket-template
((#%host-expression filter)
(#%host-expression odd?)
__))
(#%blanket-template
((#%host-expression map)
(#%host-expression sqr)
__))))])
(check-true (deforested? (syntax->datum
(deforest-pass
stx)))
"nested positions"))
(let* ([stx #'(tee
(let ([stx (tag-syntax
#'(amp
(thread
(#%blanket-template
((#%host-expression filter)
Expand All @@ -490,10 +481,25 @@
(#%blanket-template
((#%host-expression map)
(#%host-expression sqr)
__)))
(thread
(esc (#%host-expression range))
(esc (#%host-expression car))))]
__)))))])
(check-true (deforested? (syntax->datum
(deforest-pass
stx)))
"nested positions"))
(let* ([stx (tag-syntax
#'(tee
(thread
(#%blanket-template
((#%host-expression filter)
(#%host-expression odd?)
__))
(#%blanket-template
((#%host-expression map)
(#%host-expression sqr)
__)))
(thread
(esc (#%host-expression range))
(esc (#%host-expression car)))))]
[result (syntax->datum
(deforest-pass
stx))])
Expand Down
135 changes: 69 additions & 66 deletions qi-test/tests/compiler/util.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,14 +6,27 @@
rackunit
rackunit/text-ui
syntax/parse
syntax/parse/define
syntax/parse/experimental/template
(for-syntax racket/base)
(only-in "../private/util.rkt" tag-syntax)
(only-in racket/function
curry
curryr
thunk*))

(define-syntax-rule (test-syntax-equal? name a b)
(test-equal? name
(syntax->datum a)
(syntax->datum b)))
;; NOTE: we need to tag test syntax with `tag-syntax`
;; in most cases. See the comment on that function definition.

;; traverse syntax a and map it under the indicated parser patterns
;; using find-and-map/qi, and verify it results in syntax b
(define-syntax-parser test-syntax-map-equal?
[(_ name (pat ...) a b)
#:with f #'(syntax-parser pat ...)
#'(test-equal? name
(syntax->datum
(find-and-map/qi f (tag-syntax a)))
(syntax->datum b))])

(define tests
(test-suite
Expand All @@ -31,69 +44,59 @@
"false return value terminates fixed-point finding"))
(test-suite
"find-and-map/qi"
(test-syntax-equal? "top level"
(find-and-map/qi
(syntax-parser [(~datum b) #'q]
[_ this-syntax])
#'(a b c))
#'(a q c))
(test-syntax-equal? "does not explore node on false return value"
(find-and-map/qi
(syntax-parser [((~datum stop) e ...) #f]
[(~datum b) #'q]
[_ this-syntax])
#'(a b (stop c b)))
#'(a q (stop c b)))
(test-syntax-equal? "nested"
(find-and-map/qi
(syntax-parser [(~datum b) #'q]
[_ this-syntax])
#'(a (b c) d))
#'(a (q c) d))
(test-syntax-equal? "multiple matches"
(find-and-map/qi
(syntax-parser [(~datum b) #'q]
[_ this-syntax])
#'(a b c b d))
#'(a q c q d))
(test-syntax-equal? "multiple nested matches"
(find-and-map/qi
(syntax-parser [(~datum b) #'q]
[_ this-syntax])
#'(a (b c) (b d)))
#'(a (q c) (q d)))
(test-syntax-equal? "no match"
(find-and-map/qi
(syntax-parser [(~datum b) #'q]
[_ this-syntax])
#'(a c d))
#'(a c d))
(test-syntax-map-equal? "top level"
([(~datum b) #'q]
[_ this-syntax])
#'(a b c)
#'(a q c))
(test-syntax-map-equal? "does not explore node on false return value"
([((~datum stop) e ...) #f]
[(~datum b) #'q]
[_ this-syntax])
#'(a b (stop c b))
#'(a q (stop c b)))
(test-syntax-map-equal? "nested"
([(~datum b) #'q]
[_ this-syntax])
#'(a (b c) d)
#'(a (q c) d))
(test-syntax-map-equal? "multiple matches"
([(~datum b) #'q]
[_ this-syntax])
#'(a b c b d)
#'(a q c q d))
(test-syntax-map-equal? "multiple nested matches"
([(~datum b) #'q]
[_ this-syntax])
#'(a (b c) (b d))
#'(a (q c) (q d)))
(test-syntax-map-equal? "no match"
([(~datum b) #'q]
[_ this-syntax])
#'(a c d)
#'(a c d))
;; TODO: review this, it does not transform multi-level matches.
;; Are there cases where we would need this?
(test-syntax-equal? "matches at multiple levels"
(find-and-map/qi
(syntax-parser [((~datum a) b ...) #'(b ...)]
[_ this-syntax])
#'(a c (a d e)))
#'(c (a d e)))
(test-syntax-equal? "does not match spliced"
(find-and-map/qi
(syntax-parser [((~datum a) b ...) #'(b ...)]
[_ this-syntax])
#'(c a b d e))
#'(c a b d e))
(test-syntax-equal? "does not enter host expressions"
(find-and-map/qi
(syntax-parser [(~datum b) #'q]
[_ this-syntax])
#'(a (#%host-expression (b c)) d))
#'(a (#%host-expression (b c)) d))
(test-syntax-equal? "toplevel host expression"
(find-and-map/qi
(syntax-parser [(~datum b) #'q]
[_ this-syntax])
#'(#%host-expression (b c)))
#'(#%host-expression (b c))))))
;; See a TODO in tests/compiler/rules.rkt for a case where we would need it
(test-syntax-map-equal? "matches at multiple levels"
([((~datum a) b ...) #'(b ...)]
[_ this-syntax])
#'(a c (a d e))
#'(c (a d e)))
(test-syntax-map-equal? "does not match spliced"
([((~datum a) b ...) #'(b ...)]
[_ this-syntax])
#'(c a b d e)
#'(c a b d e))
(test-syntax-map-equal? "does not enter host expressions"
([(~datum b) #'q]
[_ this-syntax])
#'(a (#%host-expression (b c)) d)
#'(a (#%host-expression (b c)) d))
(test-syntax-map-equal? "toplevel host expression"
([(~datum b) #'q]
[_ this-syntax])
#'(#%host-expression (b c))
#'(#%host-expression (b c))))))

(module+ main
(void
Expand Down
12 changes: 8 additions & 4 deletions qi-test/tests/flow.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -563,9 +563,9 @@
"a"))
(test-suite
"-<"
;; (check-equal? ((☯ (~> -< ▽))
;; 3 1 2)
;; (list 1 2 1 2 1 2))
(check-equal? ((☯ (~> -< ▽))
3 1 2)
(list 1 2 1 2 1 2))
(check-equal? ((☯ (~> (-< sqr add1) ▽))
5)
(list 25 6))
Expand Down Expand Up @@ -1070,7 +1070,11 @@
[#f list]) collect))
-1 2 1 1 -2 2)
(list null null)
"no match in any clause"))
"no match in any clause")
(check-not-exn (thunk
(convert-compile-time-error
(☯ (partition [-< ▽]))))
"no improper optimization of subforms resembling use of core syntax"))
(test-suite
"gate"
(check-equal? ((☯ (gate positive?))
Expand Down
31 changes: 31 additions & 0 deletions qi-test/tests/private/util.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@
my-or
also-or
also-and
tag-syntax
(for-space qi
also-and
double-me
Expand Down Expand Up @@ -54,3 +55,33 @@
(define-qi-foreign-syntaxes double-me)

(define-qi-foreign-syntaxes add-two)

(define (syntax-list? v)
(and (syntax? v) (syntax->list v)))

(define (tree-map f tree)
(cond [(list? tree) (map (curry tree-map f)
tree)]
[(syntax-list? tree) (f (datum->syntax tree
(tree-map f (syntax->list tree))))]
Comment on lines +65 to +66
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I suspect we should be passing the other two optional arguments to datum->syntax here, but since it's only for tests it might not be relevant?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Interesting, I didn't realize that properties could be automatically propagated by passing the input syntax for the prop argument. That is very useful to know. I'll make this change in a follow-up PR, thank you.

[else (f tree)]))

(define (attach-form-property stx)
(syntax-property stx 'nonterminal 'floe))

;; In traversing Qi syntax to apply optimization rules in the compiler,
;; we only want to apply such rules to syntax that is a legitimate use of
;; a core Qi form. A naive tree traversal may in some cases yield
;; subexpressions that aren't valid Qi syntax on their own, and we
;; need a way to a avoid attempting to optimize these. The "right way"
;; remains to be defined (e.g. either we do a tree traversal that is
;; not naive and is aware of the core language grammar, or Syntax Spec
;; provides such a traversal utility inferred from the core language grammar
;; (for use by any language), or something else. But for now, Syntax Spec
;; helps us out by attaching a syntax property to each such legitimate use
;; of core language syntax, and we look for that during tree traversal
;; (i.e. in `find-and-map`), only optimizing if it is present. In order
;; to test rewrite rules, we need to attach such a property too, in syntax
;; that we use in testing, and that's what this utility does.
(define (tag-syntax stx)
(tree-map attach-form-property stx))
Loading