next up previous contents index
Next: The Tell-Ask Interface Up: With-SNePSUL Reader Macro Previous: Controlling the Evaluation of

Example Use of #!

> (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)))))



John Francis Santore
Fri May 14 11:18:57 EDT 1999