> (in-package 'user)
#<Package "USER" 79D15E>
> (defun myassert (relation nodes)
(let ((base-node-var 'mybase))
#!((define ~relation ~~relation myrel snip::test)
(assert ~relation (~@nodes) snip::test #~base-node-var)
(describe ~@(setq nodes (cdr nodes)))
(assert ~~relation (~~@nodes) myrel *~base-node-var)
(assert arg (build myrel hans ~relation franz)
myrel *mybase)
(describe *nodes))))
MYASSERT
;; If the variable *with-snepsul-eval-function* is bound to the
;; function #'with-snepsul-trace-eval then the generated SNePSUL
;; expression will only be printed, but not actually executed:
> (let ((sneps:*with-snepsul-eval-function*
#'sneps:with-snepsul-trace-eval))
(myassert 'relrel '(hans franz otto)))
(SNEPS:DEFINE SNEPSUL::RELREL ;; Note "snepsulization" with single ~
USER::RELREL ;; Package preservation with double ~
SNEPSUL::MYREL ;; Unqualified symbols go into SNePSUL
SNIP::TEST) ;; Qualified symbols keep their package
(SNEPS:ASSERT SNEPSUL::RELREL
(SNEPSUL::HANS SNEPSUL::FRANZ
SNEPSUL::OTTO)
SNIP::TEST
;; had to replace the |'s with !'s here (comment problem)
(SNEPS:!#! 'SNEPSUL::MYBASE)) ;; Combination of # and ~
(SNEPS::DESCRIBE SNEPSUL::FRANZ SNEPSUL::OTTO)
(SNEPS:ASSERT USER::RELREL (USER::FRANZ USER::OTTO)
SNEPSUL::MYREL (SNEPS:* 'SNEPSUL::MYBASE))
(SNEPS:ASSERT SNEPS:ARG (SNEPS:BUILD SNEPSUL::MYREL SNEPSUL::HANS
SNEPSUL::RELREL SNEPSUL::FRANZ)
SNEPSUL::MYREL (SNEPS:* 'SNEPSUL::MYBASE))
(SNEPS::DESCRIBE (SNEPS:* 'SNEPS:NODES))
;; Now actually run it:
> (myassert 'relrel '(hans franz otto))
(FRANZ)
(OTTO)
(B1)
(FRANZ) ;; user::franz
(FRANZ) ;; snepsul::franz
(HANS)
(M1! (RELREL FRANZ HANS OTTO))
(M2! (RELREL FRANZ OTTO))
(M3 (MYREL HANS) (RELREL FRANZ))
(M4! (ARG (M3)))
(M5! (RELREL FRANZ HANS OTTO)
(TEST B1))
(M6! (MYREL B1)
(RELREL FRANZ OTTO))
(M7! (ARG (M3)) (MYREL B1))
(B1 FRANZ FRANZ HANS M1! M2! M3 M4! M5! M6! M7! OTTO OTTO)
SNEPS:DEFAULT-DEFAULTCT
;; Here's what the definition of myassert looks like:
> (ppdef 'myassert)
(LAMBDA (RELATION NODES)
(BLOCK MYASSERT
(LET ((BASE-NODE-VAR 'MYBASE))
(PROGN ;; progn generated by #!
(SNEPS::WITH-SNEPSUL-EVAL
`(SNEPS:DEFINE ,(SNEPS::SNEPSULIZE RELATION) ,RELATION
SNEPSUL::MYREL SNIP::TEST)
#'SNEPS:TOPSNEVAL NIL)
(SNEPS::WITH-SNEPSUL-EVAL
`(SNEPS:ASSERT ,(SNEPS::SNEPSULIZE RELATION)
(,@(SNEPS::SNEPSULIZE NODES)) SNIP::TEST
(SNEPS:!#! ',(SNEPS::SNEPSULIZE BASE-NODE-VAR)))
#'SNEPS:TOPSNEVAL NIL)
(SNEPS::WITH-SNEPSUL-EVAL
`(SNEPS::DESCRIBE
,@(SNEPS::SNEPSULIZE (SETQ NODES (CDR NODES))))
#'SNEPS:TOPSNEVAL NIL)
(SNEPS::WITH-SNEPSUL-EVAL
`(SNEPS:ASSERT ,RELATION (,@NODES) SNEPSUL::MYREL
(SNEPS:* ',(SNEPS::SNEPSULIZE BASE-NODE-VAR)))
#'SNEPS:TOPSNEVAL NIL)
(SNEPS::WITH-SNEPSUL-EVAL
`(SNEPS:ASSERT SNEPS:ARG
(SNEPS:BUILD SNEPSUL::MYREL SNEPSUL::HANS
,(SNEPS::SNEPSULIZE RELATION) SNEPSUL::FRANZ)
SNEPSUL::MYREL (SNEPS:* 'SNEPSUL::MYBASE))
#'SNEPS:TOPSNEVAL NIL)
(SNEPS::WITH-SNEPSUL-EVAL
'(SNEPS::DESCRIBE (SNEPS:* 'SNEPS:NODES))
#'SNEPS:TOPSNEVAL NIL)))))