mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
Cleanup, use new module
This commit is contained in:
Justin Ethier
parent
2b533fd2a2
commit
2418730bdd
1 changed files with 67 additions and 105 deletions
172
match-test.scm
172
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)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue