forked from miniKanren/Racket-miniKanren
-
Notifications
You must be signed in to change notification settings - Fork 0
/
matchee.scm
80 lines (62 loc) · 2.29 KB
/
matchee.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
#lang racket
(provide
matchee)
(require "mk.rkt")
(require "miniKanren.scm")
(require "matche.scm")
(require "srfi-53.scm")
(define-syntax-computation syntax-macthe-pat-refine
(computation-rules (___ unquote )
((_ ( (h ___ . t) . (body ... ) ) )
(syntax-do
(hb1 <- (syntax-macthe-pat-refine (h . (body ... )) ) )
(b1 <- (syntax-cdr hb1))
(h1 <- (syntax-car hb1))
(tb2 <- (syntax-macthe-pat-refine (t . b1 ) ))
(b2 <- (syntax-cdr tb2))
(t2 <- (syntax-car tb2))
(vs <- (syntax-extract-unique-unquoted h1))
(vs2 <- (syntax-extract-unique-unquoted t2 vs))
(var <- (syntax-gensym))
(var2 <- (syntax-gensym))
(syntax-return
(,var2 . (
(fresh
(var . vs2 )
(appendo var `t2 var2)
(for-eache (lambda (var . vs ) (== `h var)) var . vs )
. b2
))))))
((_ ( (h . t) . ( body ... ) ) )
(syntax-do
(hb1 <- (syntax-macthe-pat-refine (h . (body ... )) ) )
(b1 <- (syntax-cdr hb1))
(h1 <- (syntax-car hb1))
(tb2 <- (syntax-macthe-pat-refine (t . b1 ) ))
(b2 <- (syntax-cdr tb2))
(t2 <- (syntax-car tb2))
(syntax-return ( (h1 . t2) . b2 ) )
))
((_ e ) (syntax-return e))
))
;; ;; example usage
;; (syntax-inspect (syntax-macthe-pat-refine (,a d1 d2 d3 )))
;; (syntax-inspect (syntax-macthe-pat-refine ((,a ,b) d1 d2 d3 )))
;; (syntax-inspect (syntax-macthe-pat-refine ((,a ___ ,b) d1 d2 d3 )))
;; (syntax-inspect (syntax-macthe-pat-refine (( (,a (2 ,c) ) ___ ) d1 d2 d3 )))
;; (syntax-inspect (syntax-macthe-pat-refine (((,a (2 ,c) ) ___ ,b) d1 d2 d3 )))
;; (syntax-inspect (syntax-macthe-pat-refine (((,a (2 ,c) ) ___ ) d1 d2 d3 )))
;; (syntax-inspect (syntax-macthe-pat-refine (((,a (,b ,c) ) ___ b) d d d )))
;; (syntax-inspect (syntax-macthe-pat-refine (((,a (,b ___ ,c) ) ___ 2) d d d )))
;; (syntax-inspect (syntax-macthe-pat-refine ((a b) (d d d ) )))
(define-syntax apply-matche
(syntax-rules ()
( ( _ (v ...) )
(matche v ...))))
(define-syntax matchee
(syntax-rules ()
( ( _ v ... )
(non-syntax-macro-conpose-after
(syntax-map syntax-macthe-pat-refine (v ... ))
apply-matche ;; this is just prepossessed macthe
))))