This commit is contained in:
Justin Ethier 2018-01-23 18:18:18 -05:00
parent a26598548b
commit dafe080adb

View file

@ -1,5 +1,6 @@
;; A temporary test file, based on code from: ;; A temporary test file, based on code from:
;; http://synthcode.com/scheme/match-simple.scm ;; http://synthcode.com/scheme/match-simple.scm
;; See also - https://github.com/LemonBoy/matchable-egg/blob/master/match.scm
(import (scheme base) (scheme write)) (import (scheme base) (scheme write))
(define-syntax match (define-syntax match
@ -162,7 +163,7 @@
;(display (tst 42)) ;(display (tst 42))
;(display (match-one '(a . b) (? pair? x) 1 0)) ;(display (match-one '(a . b) (? pair? x) 1 0))
(display (match #;(display (match
"test" "test"
;'(c . d) ;;"test" ;'(c . d) ;;"test"
;((? pair? x) x) ;((? pair? x) x)
@ -170,32 +171,30 @@
(_ 'no-match) (_ 'no-match)
)) ))
;; Expanded version of above, what is going on? (display (match (list 1 2 3) ((a b c) b)) )(newline)
(display (display (match (list 1 2 1) ((a a b) 1) ((a b a) 2)))(newline)
((lambda (tmp$1539$1543) (display (match (list 1 2 1) ((_ _ b) 1) ((a b a) 2)) )(newline)
((lambda (fail$1534$1545 fail$1537$1544) (display (match 'a ('b 1) ('a 2)) )(newline)
(set! fail$1534$1545 (lambda () 'no-match)) ;(display (match (list 1 2 3) (`(1 ,b ,c) (list b c))) )(newline)
(set! fail$1537$1544 ;(display (match (list 1 2) ((1 2 3 ...) #t)) )(newline)
(lambda () (error "no matches" tmp$1539$1543))) ;(display (match (list 1 2 3) ((1 2 3 ...) #t)) )(newline)
(if (string? tmp$1539$1543) ;(display (match (list 1 2 3 3 3) ((1 2 3 ...) #t)) )(newline)
(if (pair? tmp$1539$1543) ;(display (match (list 1 2) ((a b c ...) c)) )(newline)
((lambda (tmp1$1558$1559) ;(display (match (list 1 2 3) ((a b c ...) c)) )(newline)
((lambda (abracadabra$1561$1612) ;(display (match (list 1 2 3 4 5) ((a b c ...) c)) )(newline)
((lambda (tmp2$1555$1608$1613) ;(display (match (list 1 2 3 4) ((a b c ... d e) c)) )(newline)
(if (if (pair? tmp2$1555$1608$1613) ;(display (match (list 1 2 3 4 5) ((a b c ... d e) c)) )(newline)
(null? (cdr tmp2$1555$1608$1613)) ;(display (match (list 1 2 3 4 5 6 7) ((a b c ... d e) c)) )(newline)
#f) ;(display (match (list 1 2) ((a b c ..1) c)) )(newline)
((lambda (tmp$1617$1621) ;(display (match (list 1 2 3) ((a b c ..1) c)) )(newline)
((lambda (abracadabra$1623$1670) (display (match 1 ((and) #t)) )(newline)
abracadabra$1623$1670) (display (match 1 ((and x) x)) )(newline)
tmp$1617$1621)) (display (match 1 ((and x 1) x)) )(newline)
(car tmp2$1555$1608$1613)) (display (match 1 ((or) #t) (else #f)) )(newline)
(fail$1534$1545))) ;(display (match 1 ((or x) x)) )(newline)
(cdr tmp$1539$1543))) ;(display (match 1 ((or x 2) x)) )(newline)
tmp1$1558$1559)) (display (match 1 ((not 2) #t)) )(newline)
(car tmp$1539$1543)) (display (match 1 ((? odd? x) x)) )(newline)
(fail$1534$1545)) ;(display (match '(1 . 2) ((= car x) x)) )(newline)
(fail$1534$1545))) ;(display (match 4 ((= square x) x)) )(newline)
#f
#f))
"test"))