interpreter.scm 19 KB
Newer Older
1
(define-module (logic guile-log guile-prolog interpreter)
2
  #:use-module ((logic guile-log) #:select 
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
3
                (<clear> <define> <let> <let*> <=> <lookup> <match> <fail>
4
                         <cut> <wrap> <state-ref> <state-set!> <continue>
5
                         <code> <scm> <stall> <case-lambda> <cc> <set>
6
			 <<match>> <recur>
7
                         <newframe> <=> <and> <lambda> <apply> <pp> S P))
8 9
  #:use-module (logic guile-log guile-prolog hash)
  #:use-module (logic guile-log guile-prolog fluid)
10
  #:use-module (logic guile-log guile-prolog attribute)
11
  #:use-module (logic guile-log vlist)
12 13
  #:use-module (logic guile-log persistance)
  #:use-module (logic guile-log prolog persist)
14
  #:use-module (logic guile-log iinterleave)
15 16 17
  #:use-module (ice-9 match)
  #:use-module (ice-9 readline)
  #:use-module (ice-9 rdelim)
18
  #:use-module (logic guile-log umatch)
19
  #:use-module (logic guile-log memoize)
20 21
  #:use-module (logic guile-log iso-prolog)
  #:use-module (logic guile-log prolog names)
22
  #:use-module (logic guile-log prolog error)
23
  #:use-module (logic guile-log prolog parser)
24
  #:use-module (logic guile-log prolog namespace)
25
  #:use-module (logic guile-log prolog closed)
26
  #:use-module (logic guile-log prolog goal-functors)
27
  #:use-module (logic guile-log dynamic-features)
28
  #:use-module (logic guile-log guile-prolog attribute)
29
  #:use-module (logic guile-log guile-prolog project)
30
  #:use-module (logic guile-log guile-prolog dynamic-features)
31
  #:use-module (logic guile-log guile-prolog memoize)
32
  #:use-module (logic guile-log prolog global)
33
  #:use-module (logic guile-log guile-prolog postpone)
34
  #:use-module (logic guile-log guile-prolog copy-term)
35

36 37 38
  #:export (prolog-shell conversation leave read-prolog user_ref user_set 
                         stall thin_stall))

39
(define-named-object -all- (make-fluid false))
40
(<wrap> add-fluid-dynamics -all-)
41 42 43 44 45
(define-named-object *once*     (gp-make-var #f))
(define-named-object -nsol-     (make-fluid #f))
(define-named-object -mute?-    (make-fluid #f))
(define-named-object -rec?-     (make-fluid #f))
(define-named-object -nonrec?-  (make-fluid #f))
46
(<wrap> add-fluid-dynamics -mute?-)
47 48

(define-named-object *user-data* (make-fluid vlist-null))
49
(<wrap> add-vhash-dynamics *user-data*)
50

51 52 53 54 55 56 57 58 59 60 61 62
(<define> (user_set a v)
  (<code> (fluid-set! *user-data* (vhash-cons (<lookup> a)
                                              (<scm> v)
                                              (fluid-ref *user-data*)))))
(<define> (user_ret a v)
  (<=> (_ . v) ,(vhash-assoc (<lookup> a) (fluid-ref *user-data*))))

(define (usr-ref x) 
  (cdr (vhash-assoc x (fluid-ref *user-data*))))
(define (usr-set! x v) 
  (fluid-set! *user-data* (vhash-cons x v (fluid-ref *user-data*))))

63
;; Silence the prolog compiler
64 65
(define conversation1   #t)
(define conversation2   #t)
66 67 68
(define loop            #f)
(define finish          #f)
(define leave           #f)
69 70 71 72 73
(define solve           #t)
(define output_and_more #t)
(define consult         #t)
(define conversation    #t)
(define conversation_   #t)
74
(define conversation__  #t)
75 76
(define more            #t)
(define write_out       #t)
77
(define empty           #t)
78 79
(define hash_new        #t)
(define vtosym          #t)
80
(define vtosym_         #t)
81
(define vtosym4         #t)
82 83
(mk-sym finish)

84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
(define (prolog-shell)
  ((@ (guile) catch) #t
   (lambda () 
     (<clear>)
     (prolog-run 1 () (loop))
     (format #t "leaving prolog~%"))
   (lambda x
     (format #t "System error~%~a~%RESTARTING~%" x)
     (prolog-shell))))
  
(define readline_term* (@ (logic guile-log guile-prolog readline)
			  readline_term))
(define readline       (@ (logic guile-log guile-prolog readline)
			  readline))
(define -n-            (@ (logic guile-log guile-prolog readline)
		 	  -n-))
100
(define lold #f)
101
(define-named-object *usr-state* (make-fluid #f))
102 103 104 105 106 107 108

(define (tosym x)
  (cond
   ((string? x) (string->symbol x))
   ((procedure? x) (procedure-name x))
   (else x)))

109 110 111 112
(define stall
  (<case-lambda>
   (()
    (<code> 
113
     (usr-set! 'stall-ret '())
114
     (fluid-set! *usr-state* S)
115 116
     (set! lold (<state-ref>)))
    (<stall>))
117

118 119 120 121 122 123 124 125 126 127 128 129
   (l
    (<let> ((n.x (let lp ((l l) (n '()) (r '()))
		   (if (pair? l)
		       (lp (cddr l) 
			   (cons (car l) n)
			   (cons (cadr l) r))
		       (cons n r)))))
      (add_env (car n.x) (cdr n.x))
      (<code> 
       (fluid-set! *usr-state* S)
       (set! lold (<state-ref>)))
      (<stall>)))))
130 131 132 133

(<define> (thin_stall)
  (<stall>))

134
(define-named-object env (make-fluid '()))
135
(<define> (add_env n x)
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
136 137 138 139 140 141
  (fluid-guard-dynamic-object env)
  (<code> (let lp ((r (fluid-ref env)) (n (<scm> n)) (x (<scm> x)))
	    (if (pair? n)
		(lp (cons (cons (tosym (car n))
				(car x)) r) (cdr n) (cdr x))
		(fluid-set! env r)))))
142 143 144 145 146 147 148 149 150 151 152 153 154
	    
(<define> (unify_env n x)
  (<recur> lp ((n n) (x x))
    (<<match>> (#:mode - #:name unify_env) (n x)
       ((n . ns) (x . xs)
	(<let*> ((r (assoc (tosym (<lookup> n)) (fluid-ref env))))
	   (if r
	       (<=> x ,(cdr r))
	       <cc>)
	   (lp ns xs)))

       (_ _ <cc>))))
	       
155

156
(define *states* (make-hash-table))
157
(define *persister* (make-persister))
158

159
(define (read-prolog port env)
160
  (define nn?   #f)
161 162
  (define all?  #f)
  (define fail? #f)
163
  (define mute? #f)
164
  (define help? #f)
165 166 167
  (define save  #f)
  (define load  #f)
  (define cont  #f)
168 169
  (define ref   #f)
  (define set   #f)
170
  (define old   #f)
171
  (define clear #f)
172
  (define endl  #f)  
173
  (define profile #f)
174
  (define newp  #f)
175 176
  (let* 
      ((l (with-input-from-port port
177
	    (lambda ()
178
      	      (let lp ((first? #t) (ch (peek-char)) (r '()) (dot-cont? #f))
179 180
		(when (eof-object? ch)
		      (set! ch #\.))
181
		(match ch
182 183 184
		  (#\space 
		   (read-char)
		   (if first? 
185 186
		       (lp first? (peek-char) r           #f)
		       (lp first? (peek-char) (cons ch r) #f)))
187 188 189 190 191
                  
                  (#\.
                   (read-char)
		   (if first?
                       (let ((action ((@ (guile) read))))
192 193
                         (cond 
                          ((integer? action)
194
                           (set! nn? action))
195 196
                          ((pair? action)
                           action)
197
                          (else
198
                           (case action
199 200
			     ((profile pr)
			      (set! profile #t))
201 202 203 204 205 206 207 208 209 210 211 212 213 214
			     ((newp)
			      (set! *persister* (make-persister))
			      (set! old #t))
			     ((setp)
			      (persist-state *persister* ((@ (guile) read)))
			      (set! old #t))
			     ((savep)
			      (save-persists *persister*)
			      (set! old #t))
			     ((loadp)
			      (load-persists *persister*)
			      (set! old #t))
			     ((refp)
			      (persist-restate *persister* 
215
					       ((@ (guile) read)))
216
			      (set! old #t))
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
			     ((rec)       (begin
					    (fluid-set! -rec?-    #t)
					    (fluid-set! -nonrec?- #f)))
			     ((nonrec)    (begin
					    (fluid-set! -rec?-    #f)
					    (fluid-set! -nonrec?- #t)))
                             ((mute m)    (fluid-set! -mute?- #t))
                             ((unmute um) (fluid-set! -mute?- #f))
                             ((all *)     (set! all?  #t))
                             ((once)      (set! nn? 1))
                             ((h help)    (set! help? #t))
                             ((s save)    (set! save  ((@ (guile) read))))
                             ((l load)    (set! load  ((@ (guile) read))))
                             ((c cont)    (set! cont  #t))
                             ((ref)       (set! ref ((@ (guile) read))))
232 233
                             ((set)    (set! set (list ((@ (guile) read))
                                                       ((@ (guile) read)))))
234
                             ((clear)  (set! clear #t) (set! endl #\.))
235 236 237 238
                             ((lo lold) 
                              (set! old #t)
                              (if lold (<state-set!> lold)))
                             (else 
239 240 241 242 243 244 245
                              (set! fail? #t)))))

			 (cond
			  (endl
			   (if #f #f))
			  ((or fail? help?)
			   #f)
246 247
			  ((pair? action)
			   action)
248 249 250 251
			  ((or load save cont ref set old)
			   #t)
			  (else
			   (lp #t (peek-char) '() #f))))
252 253 254
                       (let ((ch (peek-char)))
                         (if dot-cont?
                             (lp #f ch (cons #\. r) #f)
255 256 257 258
                             (if (not (char-whitespace? ch))
				 (if (eq? ch #\.)
				     (lp #f ch (cons #\. r) #t)
				     (lp #f ch (cons #\. r) #f))
259
                                 (list->string (reverse (cons #\. r))))))))
260

261 262 263 264
		  (#\,
		   (read-char)
		   (if first?
		       (cons ch (string->list (read-line)))
265
                       (lp #f (peek-char) (cons ch r) #f)))
266 267 268
		     
		  (_
		   (read-char)
269
		   (lp #f (peek-char) (cons ch r) #f))))))))
270

271
    (cond
272
     (clear
273 274
      `((@ (logic guile-log) begin)
	((@ (logic guile-log) <clear>))
275
	((@ (guile) if) #f #f)))
276 277
     (old
      '((@ (guile) if)  #f #f))
278 279 280 281 282 283 284 285
     (ref
      `((@@ (logic guile-log guile-prolog interpreter) usr-ref) ,ref))

     (set
      `((@ (guile) begin)
        ((@@ (logic guile-log guile-prolog interpreter) usr-set!) ,@set)
        ((@ (guile) if)  #f #f)))

286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302
     (load
      `((@ (guile) begin)
        ((@ (logic guile-log) <state-set!>) 
         ((@ (guile) hash-ref) (@@ (logic guile-log guile-prolog interpreter)
                                    *states*)
           ',load))
        ((@ (guile) if)  #f #f)))

     (save
      `((@ (guile) begin)
         ((@ (guile) hash-set!) 
          (@@ (logic guile-log guile-prolog interpreter) *states*)
          ',save
          ((@ (logic guile-log) <state-ref>)))
         ((@ (guile) if)  #f #f)))

     (cont
303 304 305 306 307 308 309 310
      `((@ (guile) begin)
	((@ (guile) fluid-set!)
	 (@@ (logic guile-log guile-prolog interpreter) -nsol-)
	  ,(cond
	    (all? '(@ (logic guile-log iso-prolog) true))
	    (nn? nn?)
	    (else
	     '(@ (logic guile-log iso-prolog) false))))
311 312 313
	((@ (logic guile-log prolog error) redo-wrapper)
	 ((@ (guile) lambda) () ((@ (logic guile-log) <continue>))))
	((@ (guile) if) #f #f)))
314

315
     (fail? 
316
      '((@ (guile) begin)
317
         ((@ (guile) format) #t "wrong-input of '.' action ~%")
318
         ((@ (guile) if)  #f #f)))
319 320 321 322

     (help?
      (format #t "
HELP FOR PROLOG COMMANDS
323
---------------------------------------------------------------------
324 325 326 327 328
(.n           )             try to find n solutions
(.all    | .* )             try to find all solutions
(.once   | .1 )             try to find one solution
(.mute   | .m )             no value output is written.
(.unmute | .um)             output values is written.
329
---------------------------------------------------------------------
330 331 332 333 334
(.save   | .s ) <ref>       associate current state with name ref
(.load   | .l ) <ref>       restore associate state with name ref
(.cont   | .c )             continue the execution from last stall point
(.lold   | .lo)             restore the last state at a stall
(.clear       )             clear the prolog stack and state
335 336
(.rec         )             enable rational tree handling
(.unrec       )             disable rational tree handling
337
---------------------------------------------------------------------
338 339
(.ref         ) <ref>       get value of reference user variable ref
(.set         ) <ref> <val> set user variable ref to value val
340
---------------------------------------------------------------------
341 342 343 344
(.setp        ) <key>       associate current state to key
(.refp        ) <key>       instate state referenced by key
(.savep       )             save all referenced states to disk
(.loadp       )             load new referenced states from disk
345
")
346
      '((@ (guile) if) #f #f))
347 348 349 350 351 352 353 354 355 356 357
        
      
     ((string? l)
      (let ((str l))
        (when (eq? (string-ref str 0) #\,)
          (string-set! str 0 #\space)
          (set! str (string-append str " "))
          (with-input-from-string (string-trim str)
            (lambda ()
              ((@@ (system repl command) meta-command) repl)))
          (set! str "do[#f]"))
358 359 360 361 362 363 364
       (let ((lam (lambda (x) 
                    (if profile 
                       `((@ (statprof) statprof)
                           ((@@ (guile) lambda) () ,x))
                        x))))

        (lam `((@ (guile) begin)
365 366
            ((@@ (logic guile-log prolog run) prolog-run-0)
             (@@ (logic guile-log guile-prolog interpreter) 
367 368
                 conversation1)                 
             ,str 
369
             ,(cond
370
               (all? '(@ (logic guile-log iso-prolog) true))
371
               (nn? nn?)
372
               (else
373
                '(@ (logic guile-log iso-prolog) false))))
374
           ((@ (guile) if) #f #f))))))
375
     (else
376 377 378 379
        `((@ (guile) with-fluids)
            (((@ (system base language) *current-language*)
              ((@ (system base language) lookup-language) 'scheme)))
                ,l)))))
380

381 382
(<define> (wrap_frame) (<let> ((fr (<newframe>))) <cc>))

383 384 385 386 387 388 389 390 391 392 393 394
(<define> (readline_term T O)
  (<let*> ((n  (fluid-ref -n-))
	   (pr (if (= n 1) "-? " (format #f "(~a)? " n)))
	   (cr (let lp ((n (string-length pr)))
		 (if (= n 1)
		     " "
		     (string-append "." (lp (- n 1)))))))
     (readline_term* pr cr T O)))

(define (readline_term_str s p cc Str T O)
  (with-input-from-string Str
    (lambda ()
395 396
      (let ((port (current-input-port)))
        (read_term s p cc port T O)))))
397
	  
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
398
(<define> (ftof X Y I H)
399
   (<match> (#:mode + #:name 'ftof) (X Y)
400
     (#(XL) #(YL) (<cut> (vtosym4 XL YL I H)))
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
401 402
     (_     _     (<cut> <fail>))))

403
(<wrap> add-fluid-dynamics -nsol-)
404
(<wrap> add-fluid-dynamics env)
405

406 407
(<define> (wrap_namespace x y yy)
  (<let> ((x (<lookup> x)))
408 409 410 411 412 413
    (<code> (gp-set! y (make-namespace 
                        yy
                        (namespace-ns      x)
                        (namespace-local? x)
                        (namespace-lexical? x))
		     S))))
414

415
(<define> (set_once) (<set> *once* P))
416
(<define> (if_once Y Z)
417
   (if (eq? (<lookup> *once*) P)
418 419 420
       (goal-eval Y)
       (goal-eval Z)))

421 422
(compile-prolog-string
"
423 424 425
leave :- throw(leave).

loop :- catch(conversation,X,(write(X),nl,loop)).
426 427

conversation        :-
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
428 429
  fluid_guard_dynamic_object(scm[-n-]),
   (      
430
      conversation__
431 432
   ).

433
conversation__ :- 
434
  do[(fluid-set! -n- (+ (fluid-ref -n-) 1))],
435
  conversation_.
436 437 438

conversation_       :- 
   (
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
439 440 441 442
    fluid_guard_dynamic_object(scm[-all-]),
    do[ (fluid-set! -all- false) ],
    nl,readline_term(T,[variables(V),variable_names(N)]),
    consult(T,V,N,false,false)     
443 444
   ) ; conversation_.

445
conversation1(X,All) :-  
446
  backtrack_dynamic_object(scm[*globals-map*]),
447
  fluid_guard_dynamic_object(scm[*var-attributator*],scm[-n-],scm[env],
448
     scm[-nsol-], scm[-all-], scm[-mute?-],scm[*globals-map*]),
449
  state_guard_dynamic_object(scm[*var-attributator*],
450
     scm[-n-], scm[-nsol-], scm[-all-], scm[-mute?-],scm[env], 
451
                             scm[*user-data*],scm[*globals-map*]),
452
  wrap_frame,
453
  'new-machine',
454
  conversation2(X,All).
455

456
tree :- when[(fluid-ref -rec?-)]    
457
            ->  (do[(fluid-set! -rec?- #f)],rational_trees);
458 459 460
        when[(fluid-ref -nonrec?-)] 
            ->  (do[(fluid-set! -rec?- #f)],non_rational_trees);
        true.
461

462 463 464
conversation2(X,All) :- 
   do[(fluid-set! -n- (+ (fluid-ref -n-) 1))],   
   readline_term_str(X,T,[variables(V),variable_names(N)]),
465 466
   unify_env(N,V),
   add_env(N,V),
467 468 469 470
   tree,
   consult(T,V,N,All).

consult(X,V,N,All)     :-
471
   do[(fluid-set! -nsol- (<lookup> All))],
472
   catch((solve(V,N,X) ; (nl,write(no),nl,fail)),finish, fail).
473

474 475 476 477 478 479 480 481 482 483
add_N(H,[],[]).
add_N(H,[V|Vs],[N|Ns]) :-
   (var(V) -> vhashq_cons(H,V,N) ; true),
   add_N(H,Vs,Ns).

vtosym(X,Y,N,L,LL) :- 
 make_vhash(H),add_N(H,X,N),
 make_fluid(0,I),
 rec_analyze(X),vtosym4(X,Y,H,I),
 rec_analyze(L),vtosym4(L,LL,H,I).
484

485
%vtosym_(X,Y,_,_) :- write([1,X,Y]),nl,fail.
486
vtosym_(X,Y,H,I) :-
487
  var(X)         -> (!, (vhashq_ref(H,X,Y)->true ; hash_new(X,Y,H,I)));
488
  namespace_p(X) -> (!, namespace_val(X,XX),
489
                        vtosym4(XX,YY,H,I),
490 491
                        wrap_namespace(X,Y,YY)) ; fail.

492 493
vtosym_([X|XL],[U|UL],H,I) :- 
  !,vtosym4(X,U,H,I), vtosym4(XL,UL,H,I).
494

495 496
vtosym_([],[],_,_) :- !.
vtosym_(X,Y,_,_)   :- atomic(X) -> (!,X=Y) ; fail.
497
vtosym_(X,Y,H,I) :-
498 499
  X =.. [F|A], !,
  vtosym_(F,G,H,I),vtosym_(A,B,H,I), Y =.. [G|B].
500 501
 

502
vtosym_(F,G,H,I) :- ftof(F,G,H,I).
503

504
vtosym_(X,X,_,_) :- !.
505 506

hash_new(X,Y,H,I) :-
507
  Y = scm[(string->symbol (format #f \"X~a\" (fluid-ref (<lookup> I))))],
508 509 510
  fluid_set(I,scm[(+ 1 (fluid-ref (<lookup> I)))]),
  vhashq_cons(H,X,Y).

511 512 513
output_and_more(V,N,More) :-
      (when[(eq? (fluid-ref -mute?-) #t)] -> more ;
        (
514 515
         (V==[] -> (write(\"yes\"),nl) ; (once((copy_term(V,U,L),
                                                vtosym(U,VV,N,L,LL))),
516
                                            setenv,write_out(VV,N,LL))),
517 518 519
          (More=#t -> more ; throw(finish))
        )
      ).
520

521
%write_out(X,Y) :- write(writeout(X,Y)),nl,fail.
522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538
write_out(VV,N,L) :- write_out0(VV,N,Empty), write_out_trail(L,Empty).
write_out0([],[],_).
write_out0([V|Vs],[N|Ns],Empty) :-
  V == N -> write_out0(Vs,Ns,Empty) ;
  Empty=1,nl,write(\"   \"),write(N),write(\" = \"),write(V),
  write_out2(Vs,Ns,Empty).

write_out2([],[],_).
write_out2([V|Vs],[N|Ns],Empty) :-
  V == N -> write_out2(Vs,Ns,Empty) ;
  Empty=1,write(','),nl,write(\"   \"),write(N),write(\" = \"),write(V),
  write_out2(Vs,Ns,Empty).

write_out_trail([A|B], Empty) :- 
  (Empty==1 -> write(',') ; true), nl, 
  write(\"   \"),write(A), write_out_trail(B,1).

539 540
write_out_trail([],Empty) :- 
  Empty==1 -> write('.'), nl ; true.
541

542
wstall :- stall,tree.
543

544
more :- 
545
  scm[(fluid-ref -all-)]  == true -> fail           ; 
546
  (
547 548 549 550 551
    N=scm[(fluid-ref -nsol-)], 
    (
      N == true   -> fail ;
      integer(N)  -> (N > 1 -> (do[(fluid-set! -nsol- (- (<lookup> N) 1))], 
                                fail)
552 553
                             ; wstall ,fail)               ;
      readline(\"more (y/n/a/s) > \",Ans),
554
      (
555 556
        Ans == \"y\" -> fail                               ;
        Ans == \"n\" -> throw(finish)                      ;
557 558
        Ans == \"a\" -> scm[(fluid-set! -all- true)]==1    ;
        Ans == \"s\" -> stall, fail                        ;
559
        write(\" wrong input\"),nl,more
560 561
      )
    )
562 563 564
  ).

empty :- peek_char(X),char_code(X,Code),Code==10->get_char(_);true.
565

566 567 568
h([(?- X)|L],(X,LL)) :- h(L,LL).
h([],true).

569 570
solve(V,N,X) :- 
   set_once,
571
   (expand_term_0((?- X),Y) -> (h(Y,YY),YY) ; X),
572
   once(project_the_attributes(V)),
573
   if_once(output_and_more(V,N,#f),output_and_more(V,N,#t)).
574
.
575
")
576 577 578 579

(define recurs-map (make-fluid '()))
(<define> (rec_analyze x) 
  (<code> (fluid-set! recurs-map (make-hash-table)))
580 581 582 583 584 585 586
  ((with-atomic-frec
    (<lambda> (x)
      (rec-action
       (<lambda> (x)
         (<code> (hashq-set! (fluid-ref recurs-map) 
			     (<lookup> x) #t)))
       x)))
587 588
   x))

589
(<define> (vtosym-guard x s)
590
  (<let> ((a (car x)))
591
    (if (or (gp-pair? a s) (pair? a) (vector? a) (struct? a))
592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607
	(<let> ((b (hashq-ref (fluid-ref recurs-map) a #f)))
	  (if (eq? b #t)
	      (<code> (hashq-set! (fluid-ref recurs-map) a (cadr x)))
	      <cc>)
	  (<cc> (list a)))
	(<and>
	 (<cc> #f)))))

(<define> (doit-at-rec x)
 (<apply> (<lambda> (x y a b)
	     (<let> ((r (hashq-ref (fluid-ref recurs-map) (<lookup> x) #f)))
	       (if r
		   (rec= y  r)
		   (<=> y '*))))
	  x))

608 609 610
(define vtosym4 
  (with-atomic-rec
   (rec-00 vtosym_ vtosym-guard doit-at-rec)))
611

612 613
(<define> (setenv)
  (<code> (fluid-set! (@@ (logic guile-log vset) sfluid) S))) 
614 615 616 617 618 619 620 621