Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-16 01:07:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2018-01-30 18:54:20 -05:00
parent b7c0288fa0
commit 8d534fc8cb
2 changed files with 48 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
match-test.scm
View file

@ -9,6 +9,7 @@
(scheme cyclone test)))
(chibi
(import
(chibi ast)
(chibi match)
(chibi test)))
)
@ -75,8 +76,19 @@
;(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))))
)
#;(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) ())))
@ -96,12 +108,24 @@
; (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)))))
;(match-gen-or v (x 2) (1 (set! 1)) (begin x) (failure) () ((x p-ls)))))
(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) ())))))
;(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

19
match-test2.scm
View file

@ -208,8 +208,25 @@
(syntax-rules ()
((_ expr ids ...) expr)))
(define-syntax match-gen-or-step
(syntax-rules ()
((_ v () g+s sk fk . x)
;; no OR clauses, call the failure continuation
fk)
((_ v (p) . x)
;; last (or only) OR clause, just expand normally
(match-one v p . x))
((_ v (p . q) g+s sk fk i)
;; match one and try the remaining on failure
(let ((fk2 (lambda () (match-gen-or-step v q g+s sk fk i))))
(match-one v p g+s sk (fk2) i)))
))
(display
(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) ()))))
;; Works fine with my-and, but change back to and (and above in match-two) and it is broken
;(match-two 1 (my-and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ())
;; With my-and the initial expansions are:
@ -219,7 +236,7 @@
;/* (expand (match-check-identifier$2105 x (let-syntax ((new-sym?$2100 (syntax-rules$2104 () ((new-sym?$2100 x sk2$2102 fk2$2101) sk2$2102) ((new-sym?$2100 y$2103 sk2$2102 fk2$2101) fk2$2101)))) (new-sym?$2100 random-sym-to-match$2099 (let$2098 ((x 1)) (match-one$2095 1 (my-and$2094) (1 (set! 1)) (match-drop-ids (begin x)) (begin) (x))) (if (equal? 1 x) (match-one$2095 1 (my-and$2094) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()) (begin)))) (if (equal? 1 x) (match-one$2095 1 (my-and$2094) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()) (begin))))*/
;; Alternatively, with and the initial expansions are:
(match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ())
; (match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ())
;/* (expand (match-two 1 (and x) (1 (set! 1)) (match-drop-ids (begin x)) (begin) ()))*/
;/* (expand (if (pair? 1) (let$2108 ((w$2107 (car 1)) (x$2105 (cdr 1))) (match-one$2106 w$2107 and ((car 1) (set-car! 1)) (match-one$2106 x$2105 (x) ((cdr 1) (set-cdr! 1)) (match-drop-ids (begin x)) (begin)) (begin) ())) (begin)))*/
;/* (expand (pair? 1))*/