From 2418730bdd8c200c104999383e7022eb50f47095 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 31 Jan 2018 12:52:14 -0500 Subject: [PATCH] Cleanup, use new module --- match-test.scm | 172 +++++++++++++++++++------------------------------ 1 file changed, 67 insertions(+), 105 deletions(-) diff --git a/match-test.scm b/match-test.scm index ab0e0689..fdcf11f7 100644 --- a/match-test.scm +++ b/match-test.scm @@ -5,7 +5,7 @@ (cond-expand (cyclone (import - (match-test-lib) + (scheme cyclone match) (scheme cyclone test))) (chibi (import @@ -14,71 +14,72 @@ (chibi test))) ) -#;(display - ;(match "test" ((? string? s) s) (else #f)) - ; - ;(let ((v "test")) - ; (match-next v ("test" (set! "test")) ((? string? s) s) (else #f))) - ; - ;(let ((v "test")) - ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f))))) - ; (match-one v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()))) - ; - ;(let ((v "test")) - ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f))))) - ; (match-check-ellipsis - ; s - ; (match-extract-vars (? string? s) (match-gen-ellipsis v (? string? s) () ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()) () ()) - ; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ())))) - ; - ;(let ((v "test")) - ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f))))) - ; (match-check-ellipsis - ; s - ; (match-extract-vars (? string? s) (match-gen-ellipsis v (? string? s) () ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()) () ()) - ; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ())))) - ; - ;(let ((v "test")) - ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f))))) - ; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()))) - ; END expansions we are sure about, below is just WIP: - -; (let ((v "test")) -; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f))))) -; (if (string? v) -; (match-one v (and s) ("test" (set! "test")) (match-drop-ids (begin s)) (failure) ()) -; (failure)))) - -;; Following two are broken when using "and" but if we replace "and" with "my-and" in -;; the lib's match-two macro and recompile, the following both work here with "my-and". -;; Something funny going on here... -; (match-one "test" (and s) ("test" (set! "test")) (match-drop-ids (begin s)) (failure) ()) -; (match 1 ((and x) x)) - (match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()) -; (match-two "test" ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (begin) ()) - -;; I think there is some kind of interaction going on here with the "and" macro, where it -;; is being expanded even though it is part of the syntax-rules literals and should not be. -;; Just a guess, need to prove it, but it could explain why we fall into this case even though -;; pattern should have been (and p) - though not 100% sure, just a guess at this point -; ((match-two v (p) g+s sk fk i) -; (if (and (pair? v) (null? (cdr v))) -; (let ((w (car v))) -; (match-one w p ((car v) (set-car! v)) sk fk i)) -; fk)) - -) - -;(expand (match "test" ((? string? s) s) (else #f)))*/ -;(expand (match-two$171 v$1 (? string? s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()))*/ -;(expand (match-one$266 v$1 (and$262 s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()))*/ -;(expand (match-check-ellipsis$270 s (match-extract-vars$269 and$262 (match-gen-ellipsis$268 v$1 and$262 () ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()) () ()) (match-two$267 v$1 (and$262 s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ())))*/ -;(expand (match-two$267 v$1 (and$262 s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()))*/ +;; Temporary test section +;; #;(display +;; ;(match "test" ((? string? s) s) (else #f)) +;; ; +;; ;(let ((v "test")) +;; ; (match-next v ("test" (set! "test")) ((? string? s) s) (else #f))) +;; ; +;; ;(let ((v "test")) +;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f))))) +;; ; (match-one v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()))) +;; ; +;; ;(let ((v "test")) +;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f))))) +;; ; (match-check-ellipsis +;; ; s +;; ; (match-extract-vars (? string? s) (match-gen-ellipsis v (? string? s) () ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()) () ()) +;; ; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ())))) +;; ; +;; ;(let ((v "test")) +;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f))))) +;; ; (match-check-ellipsis +;; ; s +;; ; (match-extract-vars (? string? s) (match-gen-ellipsis v (? string? s) () ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()) () ()) +;; ; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ())))) +;; ; +;; ;(let ((v "test")) +;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f))))) +;; ; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()))) +;; ; END expansions we are sure about, below is just WIP: +;; +;; ; (let ((v "test")) +;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f))))) +;; ; (if (string? v) +;; ; (match-one v (and s) ("test" (set! "test")) (match-drop-ids (begin s)) (failure) ()) +;; ; (failure)))) +;; +;; ;; Following two are broken when using "and" but if we replace "and" with "my-and" in +;; ;; the lib's match-two macro and recompile, the following both work here with "my-and". +;; ;; Something funny going on here... +;; ; (match-one "test" (and s) ("test" (set! "test")) (match-drop-ids (begin s)) (failure) ()) +;; ; (match 1 ((and x) x)) +;; (match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()) +;; ; (match-two "test" ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (begin) ()) +;; +;; ;; I think there is some kind of interaction going on here with the "and" macro, where it +;; ;; is being expanded even though it is part of the syntax-rules literals and should not be. +;; ;; Just a guess, need to prove it, but it could explain why we fall into this case even though +;; ;; pattern should have been (and p) - though not 100% sure, just a guess at this point +;; ; ((match-two v (p) g+s sk fk i) +;; ; (if (and (pair? v) (null? (cdr v))) +;; ; (let ((w (car v))) +;; ; (match-one w p ((car v) (set-car! v)) sk fk i)) +;; ; fk)) +;; +;; ) +;; +;; ;(expand (match "test" ((? string? s) s) (else #f)))*/ +;; ;(expand (match-two$171 v$1 (? string? s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()))*/ +;; ;(expand (match-one$266 v$1 (and$262 s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()))*/ +;; ;(expand (match-check-ellipsis$270 s (match-extract-vars$269 and$262 (match-gen-ellipsis$268 v$1 and$262 () ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()) () ()) (match-two$267 v$1 (and$262 s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ())))*/ +;; ;(expand (match-two$267 v$1 (and$262 s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()))*/ ;;TODO: this does not work, try expanding it manually like we did with the other failing macros. maybe we can discover what's going wrong... ;; NOTE there is a warning in chibi on this one. maybe this is not a big deal ;(display (match 1 ((or x 2) x)) )(newline) -(display +#;(display (let () (define-record-type employee (make-employee name title) @@ -88,47 +89,8 @@ (match (make-employee "Bob" "Doctor") (($ employee n t) (list t n)))) ) -#;(display -; (let ((v 1)) -; (let ((failure (lambda () (match-next v (1 (set! 1)) (else #f))))) -; (match-two v (or x 2) (1 (set! 1)) (match-drop-ids (begin x)) (failure) ()))) -; (let ((v 1)) -; (let ((failure (lambda () (match-next v (1 (set! 1)) (else #f))))) -;; ;(match-two v (or x 2) (1 (set! 1)) (match-drop-ids (begin x)) (failure) ()) -; (match-extract-vars (or x 2) (match-gen-or v (x 2) (1 (set! 1)) (begin x) (failure) ()) () ()))) - -; (let ((v 1)) -; (let ((failure (lambda () (match-next v (1 (set! 1)) (else #f))))) -; (match-gen-or v (x 2) (1 (set! 1)) (begin x) (failure) () ((x p-ls))))) - -; (let ((v 1)) -; (let ((failure (lambda () (match-next v (1 (set! 1)) (else #f))))) -; ;(match-gen-or v (x 2) (1 (set! 1)) (begin x) (failure) () ((x p-ls))))) -; (let ((sk2 (lambda (x) (begin (x))))) -; (match-gen-or-step v (x 2) (1 (set! 1)) (match-drop-ids (sk2 x)) (failure) ())))) - - ;(let ((v 1)) - ; (let ((failure (lambda () (match-next v (1 (set! 1)) (else #f))))) - ; (let ((sk2 (lambda (x) (begin (x))))) - ; (let ((fk2 (lambda () (match-gen-or-step v (2) (1 (set! 1)) (match-drop-ids (sk2 x)) (failure) ())))) - ; (match-one v x (1 (set! 1)) (match-drop-ids (sk2 x)) (fk2) ()))))) - -; Broken, but is this the wrong expansion? Did we already fail? -; (let ((v 1)) -; (let ((failure (lambda () (match-next v (1 (set! 1)) (else #f))))) -; (let ((sk2 (lambda (x) (begin (x))))) -; (match-gen-or-step v (2) (1 (set! 1)) (match-drop-ids (sk2 x)) (failure) ())))) - - ;; Errs out but does not choke on macro expansion - ;(let ((v 1)) - ; (let ((sk2 (lambda (x) (begin (x))))) - ; (let ((failure (lambda () (match-next v (1 (set! 1)) (else #f))))) - ; (match-one v x (1 (set! 1)) (match-drop-ids (sk2 x)) (failure) ())))) - -) - -#;(test-group +(test-group "predicates" (test "test" (match "test" ((? string? s) s) (else #f))) @@ -136,7 +98,7 @@ (test #f (match 42 (X #f))) ) -#;(test-group +(test-group "official tests" (test 2 (match (list 1 2 3) ((a b c) b)) ) @@ -156,10 +118,10 @@ (test '(3) (match (list 1 2 3 4 5) ((a b c ... d e) c)) ) (test '(3 4 5) (match (list 1 2 3 4 5 6 7) ((a b c ... d e) c)) ) -;; Next 2 fail on both cyclone and chibi +;; Next fails on cyclone and chibi, I believe intentionally ;;; Pattern not matched ;(display (match (list 1 2) ((a b c ..1) c)) )(newline) -;;; Should have matched?? + (test '(3) (match (list 1 2 3) ((a b c ..1) c))) (test #t (match 1 ((and) #t)))