mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-09 22:17:33 +02:00
WIP
This commit is contained in:
parent
a26598548b
commit
dafe080adb
1 changed files with 29 additions and 30 deletions
|
@ -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"))
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue