Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Cleanup, use new module

Browse source
This commit is contained in:
Justin Ethier 2018-01-31 12:52:14 -05:00
parent 2b533fd2a2
commit 2418730bdd
1 changed files with 67 additions and 105 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

172
match-test.scm
View file

@ -5,7 +5,7 @@
(cond-expand (cond-expand
(cyclone (cyclone
(import (import
(match-test-lib) (scheme cyclone match)
(scheme cyclone test))) (scheme cyclone test)))
(chibi (chibi
(import (import
@ -14,71 +14,72 @@
(chibi test))) (chibi test)))
) )
#;(display ;; Temporary test section
;(match "test" ((? string? s) s) (else #f)) ;; #;(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"))
; ;; ; (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))))) ;; ;(let ((v "test"))
; (match-one v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()))) ;; ; (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))))) ;; ;(let ((v "test"))
; (match-check-ellipsis ;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f)))))
; s ;; ; (match-check-ellipsis
; (match-extract-vars (? string? s) (match-gen-ellipsis v (? string? s) () ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()) () ()) ;; ; s
; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ())))) ;; ; (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))))) ;; ;(let ((v "test"))
; (match-check-ellipsis ;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f)))))
; s ;; ; (match-check-ellipsis
; (match-extract-vars (? string? s) (match-gen-ellipsis v (? string? s) () ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()) () ()) ;; ; s
; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ())))) ;; ; (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))))) ;; ;(let ((v "test"))
; (match-two v ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (failure) ()))) ;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f)))))
; END expansions we are sure about, below is just WIP: ;; ; (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))))) ;; ; (let ((v "test"))
; (if (string? v) ;; ; (let ((failure (lambda () (match-next v ("test" (set! "test")) (else #f)))))
; (match-one v (and s) ("test" (set! "test")) (match-drop-ids (begin s)) (failure) ()) ;; ; (if (string? v)
; (failure)))) ;; ; (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". ;; ;; Following two are broken when using "and" but if we replace "and" with "my-and" in
;; Something funny going on here... ;; ;; the lib's match-two macro and recompile, the following both work here with "my-and".
; (match-one "test" (and s) ("test" (set! "test")) (match-drop-ids (begin s)) (failure) ()) ;; ;; Something funny going on here...
; (match 1 ((and x) x)) ;; ; (match-one "test" (and s) ("test" (set! "test")) (match-drop-ids (begin s)) (failure) ())
(match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()) ;; ; (match 1 ((and x) x))
; (match-two "test" ((? string? s) s) ("test" (set! "test")) (match-drop-ids (begin . s)) (begin) ()) ;; (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. ;; ;; I think there is some kind of interaction going on here with the "and" macro, where it
;; Just a guess, need to prove it, but it could explain why we fall into this case even though ;; ;; is being expanded even though it is part of the syntax-rules literals and should not be.
;; pattern should have been (and p) - though not 100% sure, just a guess at this point ;; ;; Just a guess, need to prove it, but it could explain why we fall into this case even though
; ((match-two v (p) g+s sk fk i) ;; ;; pattern should have been (and p) - though not 100% sure, just a guess at this point
; (if (and (pair? v) (null? (cdr v))) ;; ; ((match-two v (p) g+s sk fk i)
; (let ((w (car v))) ;; ; (if (and (pair? v) (null? (cdr v)))
; (match-one w p ((car v) (set-car! v)) sk fk i)) ;; ; (let ((w (car v)))
; fk)) ;; ; (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 "test" ((? string? s) s) (else #f)))*/
;(expand (match-one$266 v$1 (and$262 s) ("test" (set! "test")) (match-drop-ids$9 (begin s)) (failure$5) ()))*/ ;; ;(expand (match-two$171 v$1 (? string? 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-one$266 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) ()))*/ ;; ;(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... ;;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 ;; 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 (match 1 ((or x 2) x)) )(newline)
(display #;(display
(let () (let ()
(define-record-type employee (define-record-type employee
(make-employee name title) (make-employee name title)
@ -88,47 +89,8 @@
(match (make-employee "Bob" "Doctor") (match (make-employee "Bob" "Doctor")
(($ employee n t) (list t n)))) (($ 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)) (test-group
; (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
"predicates" "predicates"
(test "test" (match "test" ((? string? s) s) (else #f))) (test "test" (match "test" ((? string? s) s) (else #f)))
@ -136,7 +98,7 @@
(test #f (match 42 (X #f))) (test #f (match 42 (X #f)))
) )
#;(test-group (test-group
"official tests" "official tests"
(test 2 (match (list 1 2 3) ((a b c) b)) ) (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) (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)) ) (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 ;;; Pattern not matched
;(display (match (list 1 2) ((a b c ..1) c)) )(newline) ;(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 '(3) (match (list 1 2 3) ((a b c ..1) c)))
(test #t (match 1 ((and) #t))) (test #t (match 1 ((and) #t)))