mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
Cleanup, add both record type tests from docs
This commit is contained in:
parent
1d91ace450
commit
ba3b016c43
1 changed files with 14 additions and 92 deletions
|
@ -14,96 +14,8 @@
|
|||
(chibi test)))
|
||||
)
|
||||
|
||||
;; 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
|
||||
(let ()
|
||||
(define-record-type employee
|
||||
(make-employee name title)
|
||||
employee?
|
||||
(name get-name)
|
||||
(title get-title))
|
||||
(match (make-employee "Bob" "Doctor")
|
||||
(($ employee n t) (list t n))))
|
||||
)
|
||||
|
||||
;; TODO: slot-ref needs to be extended to support this
|
||||
#;(display
|
||||
(let ()
|
||||
(define-record-type employee
|
||||
(make-employee name title)
|
||||
employee?
|
||||
(name get-name)
|
||||
(title get-title))
|
||||
(match (make-employee "Bob" "Doctor")
|
||||
((@ employee (title t) (name n)) (list t n))))
|
||||
)
|
||||
|
||||
(test-group
|
||||
"official tests"
|
||||
"Official tests"
|
||||
|
||||
(test 2 (match (list 1 2 3) ((a b c) b)) )
|
||||
(test 2 (match (list 1 2 1) ((a a b) 1) ((a b a) 2)))
|
||||
|
@ -154,6 +66,16 @@
|
|||
(match (make-employee "Bob" "Doctor")
|
||||
(($ employee n t) (list t n)))))
|
||||
|
||||
(test '("Doctor" "Bob")
|
||||
(let ()
|
||||
(define-record-type employee
|
||||
(make-employee name title)
|
||||
employee?
|
||||
(name get-name)
|
||||
(title get-title))
|
||||
(match (make-employee "Bob" "Doctor")
|
||||
((@ employee (title t) (name n)) (list t n)))))
|
||||
|
||||
(test '(1 . 3) (let ((x (cons 1 2))) (match x ((1 . (set! s)) (s 3) x))))
|
||||
(test 2 (match '(1 . 2) ((1 . (get! g)) (g))))
|
||||
(test '(a a a) (match '(a (a (a b))) ((x *** 'b) x)))
|
||||
|
@ -161,8 +83,8 @@
|
|||
|
||||
)
|
||||
|
||||
#;(test-group
|
||||
"predicates"
|
||||
(test-group
|
||||
"Predicates"
|
||||
(test "test" (match "test" ((? string? s) s) (else #f)))
|
||||
|
||||
(test #(fromlist 1 2) (match '(1 2) ((a b) (vector 'fromlist a b))))
|
||||
|
@ -190,7 +112,7 @@
|
|||
))
|
||||
|
||||
(test-group
|
||||
"example"
|
||||
"Demo"
|
||||
(test (+ (* 5 60) 10) (calc-time '(5 min 10 sec)))
|
||||
(test (+ (* 24 60 60) (* 60 5) 10) (calc-time '(1 day 5 min 10 sec)))
|
||||
(test (+ (* 24 60 60) (* 60 60) (* 60 5) 10) (calc-time '(0 weeks 1 day 1 h 5 min 10 sec)))
|
||||
|
|
Loading…
Add table
Reference in a new issue