mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
1b8abe5514
* module/language/scheme/translate.scm (lookup-transformer): When expanding syncase macros, use the eval closure from the ghil-env. Probably doesn't make any difference whatsoever. * module/system/base/Makefile.am (SOURCES): Compile pmatch.scm, now that it works :-)) * module/system/base/compile.scm (compile-in): Compile inside a save-module-excursion, so that side effects of evaluation don't leak out. * module/system/base/pmatch.scm: Change from :use-syntax/:export-syntax to simply :use-modules/:export. Also probably has no effect. * module/system/il/ghil.scm (fix-ghil-mod!): Suppress warnings resulting from compilation of define-module. * src/vm_loader.c (link): So, referencing variables defined but not exported from the current module didn't work. Fixed that, but it's hacky. There are still some uncaught cases.
42 lines
1.4 KiB
Scheme
42 lines
1.4 KiB
Scheme
(define-module (system base pmatch)
|
||
#:use-module (ice-9 syncase)
|
||
#:export (pmatch ppat))
|
||
;; FIXME: shouldn't have to export ppat...
|
||
|
||
;; Originally written by Oleg Kiselyov. Taken from:
|
||
;; αKanren: A Fresh Name in Nominal Logic Programming
|
||
;; by William E. Byrd and Daniel P. Friedman
|
||
;; Proceedings of the 2007 Workshop on Scheme and Functional Programming
|
||
;; Université Laval Technical Report DIUL-RT-0701
|
||
|
||
;; Licensing unclear. Probably need to ask Oleg for a disclaimer.
|
||
|
||
(define-syntax pmatch
|
||
(syntax-rules (else guard)
|
||
((_ (op arg ...) cs ...)
|
||
(let ((v (op arg ...)))
|
||
(pmatch v cs ...)))
|
||
((_ v) (if #f #f))
|
||
((_ v (else e0 e ...)) (begin e0 e ...))
|
||
((_ v (pat (guard g ...) e0 e ...) cs ...)
|
||
(let ((fk (lambda () (pmatch v cs ...))))
|
||
(ppat v pat
|
||
(if (and g ...) (begin e0 e ...) (fk))
|
||
(fk))))
|
||
((_ v (pat e0 e ...) cs ...)
|
||
(let ((fk (lambda () (pmatch v cs ...))))
|
||
(ppat v pat (begin e0 e ...) (fk))))))
|
||
|
||
(define-syntax ppat
|
||
(syntax-rules (_ quote unquote)
|
||
((_ v _ kt kf) kt)
|
||
((_ v () kt kf) (if (null? v) kt kf))
|
||
((_ v (quote lit) kt kf)
|
||
(if (equal? v (quote lit)) kt kf))
|
||
((_ v (unquote var) kt kf) (let ((var v)) kt))
|
||
((_ v (x . y) kt kf)
|
||
(if (pair? v)
|
||
(let ((vx (car v)) (vy (cdr v)))
|
||
(ppat vx x (ppat vy y kt kf) kf))
|
||
kf))
|
||
((_ v lit kt kf) (if (equal? v (quote lit)) kt kf))))
|