From 8d534fc8cb57225bd9debab0bb59007ff680cff7 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 30 Jan 2018 18:54:20 -0500 Subject: [PATCH] WIP --- match-test.scm | 36 ++++++++++++++++++++++++++++++------ match-test2.scm | 19 ++++++++++++++++++- 2 files changed, 48 insertions(+), 7 deletions(-) diff --git a/match-test.scm b/match-test.scm index 7a1e1f69..ab0e0689 100644 --- a/match-test.scm +++ b/match-test.scm @@ -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 diff --git a/match-test2.scm b/match-test2.scm index c6056b75..a3a503af 100644 --- a/match-test2.scm +++ b/match-test2.scm @@ -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))*/