replace problematic ::: which may be interpreted as a keyword with ooo

This commit is contained in:
Alex Shinn 2016-09-28 22:21:25 +09:00
parent 76211609ff
commit ca1a2bd3ae

View file

@ -138,16 +138,16 @@
(map (lambda (x) (cons (car x) (cdr x))) (get-props st)))) (map (lambda (x) (cons (car x) (cdr x))) (get-props st))))
;; bind - a function ;; bind - a function
(define-syntax f! (define-syntax f!
(syntax-rules ::: () (syntax-rules ooo ()
((f! ("step") (params :::) ((p param) . rest) . body) ((f! ("step") (params ooo) ((p param) . rest) . body)
(f! ("step") (params ::: (p param)) rest . body)) (f! ("step") (params ooo (p param)) rest . body))
((f! ("step") (params :::) ((param) . rest) . body) ((f! ("step") (params ooo) ((param) . rest) . body)
(f! ("step") (params ::: (param param)) rest . body)) (f! ("step") (params ooo (param param)) rest . body))
((f! ("step") (params :::) (param . rest) . body) ((f! ("step") (params ooo) (param . rest) . body)
(f! ("step") (params ::: (param param)) rest . body)) (f! ("step") (params ooo (param param)) rest . body))
((f! ("step") ((p param) :::) () . body) ((f! ("step") ((p param) ooo) () . body)
(lambda (st) (lambda (st)
(let ((p (ask st 'param)) :::) (let ((p (ask st 'param)) ooo)
((let () . body) st)))) ((let () . body) st))))
((f! params . body) ((f! params . body)
(f! ("step") () params . body)))) (f! ("step") () params . body))))
@ -164,25 +164,25 @@
((s f . g) (lambda (st) ((s . g) (f st)))))) ((s f . g) (lambda (st) ((s . g) (f st))))))
;; update in place ;; update in place
(define-syntax u (define-syntax u
(syntax-rules ::: () (syntax-rules ooo ()
((u (prop value) :::) ((u (prop value) ooo)
(lambda (st) (lambda (st)
(tell st 'prop value) ::: (tell st 'prop value) ooo
st)))) st))))
;; local binding - update temporarily ;; local binding - update temporarily
(define-syntax w (define-syntax w
(syntax-rules ::: () (syntax-rules ooo ()
((w ("step") ((p tmp v) :::) () . b) ((w ("step") ((p tmp v) ooo) () . b)
(lambda (st) (lambda (st)
(let ((tmp (ask st 'p)) :::) (let ((tmp (ask st 'p)) ooo)
(tell st 'p v) ::: (tell st 'p v) ooo
(let ((st ((begin . b) st))) (let ((st ((begin . b) st)))
(tell st 'p tmp) ::: (tell st 'p tmp) ooo
st)))) st))))
((w ("step") (props :::) ((p v) . rest) . b) ((w ("step") (props ooo) ((p v) . rest) . b)
(w ("step") (props ::: (p tmp v)) rest . b)) (w ("step") (props ooo (p tmp v)) rest . b))
((w ((prop value) :::) . body) ((w ((prop value) ooo) . body)
(w ("step") () ((prop value) :::) . body)))) (w ("step") () ((prop value) ooo) . body))))
;; run ;; run
(define (r proc) (define (r proc)
(proc (make-state init ... '()))) (proc (make-state init ... '())))