uses free-id-table to accomplish better hygiene

parent 50ae81ea
(define-module (logic guile-log guile-log-pre)
#:use-module (syntax id-table)
#:use-module (compat racket misc)
#:export (define-guile-log guile-log-macro? log-code-macro log-code-macro?))
(define *guile-log-macros* (make-free-id-table))
(define *log-code-macros* (make-free-id-table))
(define (guile-log-macro? s)
(and (symbol? s) (symbol-property s 'guile-log-macro?)))
(and (syntax? s)
(identifier? s)
(free-id-table-ref *guile-log-macros* s #f)))
(define (log-code-macro? s)
(and (symbol? s) (symbol-property s 'log-code-macro?)))
(and (syntax? s)
(identifier? s)
(free-id-table-ref *log-code-macros* s #f)))
(define (log-code-macro s)
(set-symbol-property! s 'log-code-macro? #t))
(define-syntax log-code-macro
(syntax-rules (quote)
((_ (quote x)) (log-code-macro x))
((_ x)
(free-id-table-set! *log-code-macros* #'x #t))))
(define-syntax define-guile-log
(lambda (x)
(syntax-case x ()
((_ n . l)
#'(begin
(set-symbol-property! 'n 'guile-log-macro? #t)
(define-syntax n . l))))))
(define-syntax n . l)
(define-values ()
(begin
(free-id-table-set! *guile-log-macros* #'n #t)
(values))))))))
......@@ -7,7 +7,7 @@
<match> <=> <r=> <==> *r* <funcall>
<and!> <and!!> <succeeds>
<format> <tail-code> <code> <ret> <return>
<def> <<define>> <with-fail> <dynwind>
<def> <<define>> <with-fail> <dynwind> parse<>
let<> <or!> <stall> <continue> <take>)
(re-export define-guile-log guile-log-macro? log-code-macro log-code-macro?)
......@@ -198,7 +198,7 @@
#'(parse<> meta e1))
((_ (cut fi pr cc) (a b ...) e2 ...)
(log-code-macro? (syntax->datum (syntax a)))
(log-code-macro? (syntax a))
#'(a (cut fi pr (parse<> (cut fi pr cc) (<and> e2 ...))) b ...))
((_ (cut fi pr cc) e1 e2 ...)
......@@ -281,8 +281,8 @@
(define-guile-log <cond>
(syntax-rules ()
((_ meta (#t b))
(syntax-rules (else)
((_ meta (else b))
(parse<> meta b))
((_ meta (a b))
(parse<> meta (<and> a b)))
......@@ -422,7 +422,7 @@
(syntax-case x ()
((_ w (n . l))
;(pk (syntax->datum (syntax (n w . l))))
(if (guile-log-macro? (syntax->datum (syntax n)))
(if (guile-log-macro? (syntax n))
(syntax (n w . l))
(syntax (<%fkn%> w n . l)))))))
......@@ -722,5 +722,4 @@
(include-from-path "logic/guile-log/interleave.scm")
......@@ -21,6 +21,7 @@
(define-module (logic guile-log umatch)
#:use-module (ice-9 match-phd-lookup)
#:use-module (ice-9 pretty-print)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:export (gp-clear gp-unify! gp-unify-raw! gp-newframe gp-unwind gp-var!
gp->scm gp-print
......@@ -48,6 +49,14 @@
(define gp-car #f)
(define gp-cdr #f)
(let ((file (%search-load-path "logic/guile-log/src/libguile-unify.so")))
(if file
(load-extension file "gp_init")
(error "libguile-unify.so is not present, did you forget to make it?")))
(gp-module-init)
(define old gp-make-fluid)
(define gp-make-fluid
......@@ -57,13 +66,6 @@
(gp-fluid-set! ret x)
ret))))
(let ((file (%search-load-path "logic/guile-log/src/libguile-unify.so")))
(if file
(load-extension file "gp_init")
(error "libguile-unify.so is not present, did you forget to make it?")))
(gp-module-init)
(use-modules (srfi srfi-11))
(define (get-line x u)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment