1#!/usr/bin/env swipl
6
7:-style_check(-discontiguous). 8:-style_check(-singleton). 9:-use_module(library(wamcl_runtime)). 10
11/*
12;; #+BUILTIN Means to ignore since it should already be defined
13*/
14/*
15;; #+WAM-CL Means we want it
16*/
17/*
18;; #+LISP500 Means probably we dont want it
19*/
20/*
21;; #+ALT Alternative definition
22*/
23/*
24;; #+ABCL From ABCL
25*/
26/*
27;; #+SBCL From SBCL
28*/
29/*
30;; #+ECL From ECL
31*/
32/*
33;; #+SICL From SICL
34*/
35/*
36(in-package "SYSTEM")
37
38
39
40*/
41
42/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:262 **********************/
43:-lisp_compile_to_prolog(pkg_sys,['in-package','#:system'])
44/*
45% macroexpand:-[in_package,system6].
46*/
47/*
48% into:-[eval_when,[kw_compile_toplevel,kw_load_toplevel,kw_execute],[sys_select_package,'$ARRAY'([*],claz_base_character,"SYSTEM")]].
49*/
50:- do_when([kw_compile_toplevel, kw_load_toplevel, kw_execute],
51 f_sys_select_package('$ARRAY'([*], claz_base_character, "SYSTEM"),
52 _Ignored),
53 _Ignored).
54/*
55(defmacro=sourceinfo psetq (&rest rest)
56 (let ((inits nil)
57 (sets nil)
58 (list rest))
59 (tagbody
60 start
61 (when (cddr list)
62 (push (list (gensym) (cadr list)) inits)
63 (setq list (cddr list))
64 (go start)))
65 (setq list inits)
66 (tagbody
67 start
68 (when (cddr rest)
69 (push (caar list) sets)
70 (push (car rest) sets)
71 (setq list (cdr list))
72 (setq rest (cddr rest))
73 (go start)))
74 `(let ,(reverse inits)
75 (setq ,@sets ,@rest))))
76
77
78*/
79
80/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:296 **********************/
81:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',psetq,['&rest',rest],[let,[[inits,[]],[sets,[]],[list,rest]],[tagbody,start,[when,[cddr,list],[push,[list,[gensym],[cadr,list]],inits],[setq,list,[cddr,list]],[go,start]]],[setq,list,inits],[tagbody,start,[when,[cddr,rest],[push,[caar,list],sets],[push,[car,rest],sets],[setq,list,[cdr,list]],[setq,rest,[cddr,rest]],[go,start]]],['#BQ',[let,['#COMMA',[reverse,inits]],[setq,['#BQ-COMMA-ELIPSE',sets],['#BQ-COMMA-ELIPSE',rest]]]]]])
82/*
83% macroexpand:-[sys_defmacro_c61_sourceinfo,psetq,[c38_rest,rest],[let,[[sys_inits,[]],[sys_sets,[]],[list,rest]],[tagbody,sys_start,[when,[cddr,list],[push,[list,[gensym],[cadr,list]],sys_inits],[setq,list,[cddr,list]],[go,sys_start]]],[setq,list,sys_inits],[tagbody,sys_start,[when,[cddr,rest],[push,[caar,list],sys_sets],[push,[car,rest],sys_sets],[setq,list,[cdr,list]],[setq,rest,[cddr,rest]],[go,sys_start]]],['#BQ',[let,['#COMMA',[reverse,sys_inits]],[setq,['#BQ-COMMA-ELIPSE',sys_sets],['#BQ-COMMA-ELIPSE',rest]]]]]].
84*/
85/*
86% into:-[sys_put_sysprop,[quote,psetq],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,psetq,[c38_rest,rest],[let,[[sys_inits,[]],[sys_sets,[]],[list,rest]],[tagbody,sys_start,[when,[cddr,list],[push,[list,[gensym],[cadr,list]],sys_inits],[setq,list,[cddr,list]],[go,sys_start]]],[setq,list,sys_inits],[tagbody,sys_start,[when,[cddr,rest],[push,[caar,list],sys_sets],[push,[car,rest],sys_sets],[setq,list,[cdr,list]],[setq,rest,[cddr,rest]],[go,sys_start]]],['#BQ',[let,['#COMMA',[reverse,sys_inits]],[setq,['#BQ-COMMA-ELIPSE',sys_sets],['#BQ-COMMA-ELIPSE',rest]]]]]]]].
87*/
88:- f_sys_put_sysprop(psetq,
89 sys_defmacro_c61_sourceinfo,
90
91 [ defmacro,
92 psetq,
93 [c38_rest, rest],
94
95 [ let,
96 [[sys_inits, []], [sys_sets, []], [list, rest]],
97
98 [ tagbody,
99 sys_start,
100
101 [ when,
102 [cddr, list],
103 [push, [list, [gensym], [cadr, list]], sys_inits],
104 [setq, list, [cddr, list]],
105 [go, sys_start]
106 ]
107 ],
108 [setq, list, sys_inits],
109
110 [ tagbody,
111 sys_start,
112
113 [ when,
114 [cddr, rest],
115 [push, [caar, list], sys_sets],
116 [push, [car, rest], sys_sets],
117 [setq, list, [cdr, list]],
118 [setq, rest, [cddr, rest]],
119 [go, sys_start]
120 ]
121 ],
122
123 [ '#BQ',
124
125 [ let,
126 ['#COMMA', [reverse, sys_inits]],
127
128 [ setq,
129 ['#BQ-COMMA-ELIPSE', sys_sets],
130 ['#BQ-COMMA-ELIPSE', rest]
131 ]
132 ]
133 ]
134 ]
135 ],
136 [],
137 _Ignored).
138/*
139(defmacro=sourceinfo return (&optional result)
140 `(return-from nil ,result))
141
142*/
143
144/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:785 **********************/
145:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',return,['&optional',result],['#BQ',['return-from',[],['#COMMA',result]]]])
146/*
147% macroexpand:-[sys_defmacro_c61_sourceinfo,return,[c38_optional,sys_result],['#BQ',[return_from,[],['#COMMA',sys_result]]]].
148*/
149/*
150% into:-[sys_put_sysprop,[quote,return],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,return,[c38_optional,sys_result],['#BQ',[return_from,[],['#COMMA',sys_result]]]]]].
151*/
152:- f_sys_put_sysprop(return,
153 sys_defmacro_c61_sourceinfo,
154
155 [ defmacro,
156 return,
157 [c38_optional, sys_result],
158 ['#BQ', [return_from, [], ['#COMMA', sys_result]]]
159 ],
160 [],
161 _Ignored).
162/*
163(defmacro=sourceinfo when (test-form &rest forms)
164 `(if ,test-form (progn ,@forms)))
165
166*/
167
168/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:866 **********************/
169:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',when,['test-form','&rest',forms],['#BQ',[if,['#COMMA','test-form'],[progn,['#BQ-COMMA-ELIPSE',forms]]]]])
170/*
171% macroexpand:-[sys_defmacro_c61_sourceinfo,when,[sys_test_form,c38_rest,sys_forms],['#BQ',[if,['#COMMA',sys_test_form],[progn,['#BQ-COMMA-ELIPSE',sys_forms]]]]].
172*/
173/*
174% into:-[sys_put_sysprop,[quote,when],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,when,[sys_test_form,c38_rest,sys_forms],['#BQ',[if,['#COMMA',sys_test_form],[progn,['#BQ-COMMA-ELIPSE',sys_forms]]]]]]].
175*/
176:- f_sys_put_sysprop(when,
177 sys_defmacro_c61_sourceinfo,
178
179 [ defmacro,
180 when,
181 [sys_test_form, c38_rest, sys_forms],
182
183 [ '#BQ',
184
185 [ if,
186 ['#COMMA', sys_test_form],
187 [progn, ['#BQ-COMMA-ELIPSE', sys_forms]]
188 ]
189 ]
190 ],
191 [],
192 _Ignored).
193/*
194(defmacro=sourceinfo unless (test-form &rest forms)
195 `(if (not ,test-form) (progn ,@forms)))
196
197*/
198
199/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:956 **********************/
200:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',unless,['test-form','&rest',forms],['#BQ',[if,[not,['#COMMA','test-form']],[progn,['#BQ-COMMA-ELIPSE',forms]]]]])
201/*
202% macroexpand:-[sys_defmacro_c61_sourceinfo,unless,[sys_test_form,c38_rest,sys_forms],['#BQ',[if,[not,['#COMMA',sys_test_form]],[progn,['#BQ-COMMA-ELIPSE',sys_forms]]]]].
203*/
204/*
205% into:-[sys_put_sysprop,[quote,unless],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,unless,[sys_test_form,c38_rest,sys_forms],['#BQ',[if,[not,['#COMMA',sys_test_form]],[progn,['#BQ-COMMA-ELIPSE',sys_forms]]]]]]].
206*/
207:- f_sys_put_sysprop(unless,
208 sys_defmacro_c61_sourceinfo,
209
210 [ defmacro,
211 unless,
212 [sys_test_form, c38_rest, sys_forms],
213
214 [ '#BQ',
215
216 [ if,
217 [not, ['#COMMA', sys_test_form]],
218 [progn, ['#BQ-COMMA-ELIPSE', sys_forms]]
219 ]
220 ]
221 ],
222 [],
223 _Ignored).
224/*
225(defmacro=sourceinfo and (&rest forms)
226 (if forms
227 (if (cdr forms)
228 `(when ,(car forms) (and ,@(cdr forms)))
229 (car forms))
230 `t))
231
232*/
233
234/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:1054 **********************/
235:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',and,['&rest',forms],[if,forms,[if,[cdr,forms],['#BQ',[when,['#COMMA',[car,forms]],[and,['#BQ-COMMA-ELIPSE',[cdr,forms]]]]],[car,forms]],['#BQ',t]]])
236/*
237% macroexpand:-[sys_defmacro_c61_sourceinfo,and,[c38_rest,sys_forms],[if,sys_forms,[if,[cdr,sys_forms],['#BQ',[when,['#COMMA',[car,sys_forms]],[and,['#BQ-COMMA-ELIPSE',[cdr,sys_forms]]]]],[car,sys_forms]],['#BQ',t]]].
238*/
239/*
240% into:-[sys_put_sysprop,[quote,and],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,and,[c38_rest,sys_forms],[if,sys_forms,[if,[cdr,sys_forms],['#BQ',[when,['#COMMA',[car,sys_forms]],[and,['#BQ-COMMA-ELIPSE',[cdr,sys_forms]]]]],[car,sys_forms]],['#BQ',t]]]]].
241*/
242:- f_sys_put_sysprop(and,
243 sys_defmacro_c61_sourceinfo,
244
245 [ defmacro,
246 and,
247 [c38_rest, sys_forms],
248
249 [ if,
250 sys_forms,
251
252 [ if,
253 [cdr, sys_forms],
254
255 [ '#BQ',
256
257 [ when,
258 ['#COMMA', [car, sys_forms]],
259 [and, ['#BQ-COMMA-ELIPSE', [cdr, sys_forms]]]
260 ]
261 ],
262 [car, sys_forms]
263 ],
264 ['#BQ', t]
265 ]
266 ],
267 [],
268 _Ignored).
269/*
270(defmacro=sourceinfo or (&rest forms)
271 (if forms
272 (if (cdr forms)
273 (let ((temp (gensym)))
274 `(let ((,temp ,(car forms)))
275 (if ,temp
276 ,temp
277 (or ,@(cdr forms)))))
278 (car forms))
279 `nil))
280
281*/
282
283/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:1202 **********************/
284:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',or,['&rest',forms],[if,forms,[if,[cdr,forms],[let,[[temp,[gensym]]],['#BQ',[let,[[['#COMMA',temp],['#COMMA',[car,forms]]]],[if,['#COMMA',temp],['#COMMA',temp],[or,['#BQ-COMMA-ELIPSE',[cdr,forms]]]]]]],[car,forms]],['#BQ',[]]]])
285/*
286% macroexpand:-[sys_defmacro_c61_sourceinfo,or,[c38_rest,sys_forms],[if,sys_forms,[if,[cdr,sys_forms],[let,[[sys_temp,[gensym]]],['#BQ',[let,[[['#COMMA',sys_temp],['#COMMA',[car,sys_forms]]]],[if,['#COMMA',sys_temp],['#COMMA',sys_temp],[or,['#BQ-COMMA-ELIPSE',[cdr,sys_forms]]]]]]],[car,sys_forms]],['#BQ',[]]]].
287*/
288/*
289% into:-[sys_put_sysprop,[quote,or],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,or,[c38_rest,sys_forms],[if,sys_forms,[if,[cdr,sys_forms],[let,[[sys_temp,[gensym]]],['#BQ',[let,[[['#COMMA',sys_temp],['#COMMA',[car,sys_forms]]]],[if,['#COMMA',sys_temp],['#COMMA',sys_temp],[or,['#BQ-COMMA-ELIPSE',[cdr,sys_forms]]]]]]],[car,sys_forms]],['#BQ',[]]]]]].
290*/
291:- f_sys_put_sysprop(or,
292 sys_defmacro_c61_sourceinfo,
293
294 [ defmacro,
295 or,
296 [c38_rest, sys_forms],
297
298 [ if,
299 sys_forms,
300
301 [ if,
302 [cdr, sys_forms],
303
304 [ let,
305 [[sys_temp, [gensym]]],
306
307 [ '#BQ',
308
309 [ let,
310
311 [
312 [ ['#COMMA', sys_temp],
313 ['#COMMA', [car, sys_forms]]
314 ]
315 ],
316
317 [ if,
318 ['#COMMA', sys_temp],
319 ['#COMMA', sys_temp],
320 [or, ['#BQ-COMMA-ELIPSE', [cdr, sys_forms]]]
321 ]
322 ]
323 ]
324 ],
325 [car, sys_forms]
326 ],
327 ['#BQ', []]
328 ]
329 ],
330 [],
331 _Ignored).
332/*
333(defmacro=sourceinfo cond (&rest clauses)
334 (when clauses
335 (if (cdar clauses)
336 `(if ,(caar clauses)
337 (progn ,@(cdar clauses))
338 (cond ,@(cdr clauses)))
339 `(or ,(caar clauses)
340 (cond ,@(cdr clauses))))))
341
342
343*/
344
345/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:1422 **********************/
346:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',cond,['&rest',clauses],[when,clauses,[if,[cdar,clauses],['#BQ',[if,['#COMMA',[caar,clauses]],[progn,['#BQ-COMMA-ELIPSE',[cdar,clauses]]],[cond,['#BQ-COMMA-ELIPSE',[cdr,clauses]]]]],['#BQ',[or,['#COMMA',[caar,clauses]],[cond,['#BQ-COMMA-ELIPSE',[cdr,clauses]]]]]]]])
347/*
348% macroexpand:-[sys_defmacro_c61_sourceinfo,cond,[c38_rest,sys_clauses],[when,sys_clauses,[if,[cdar,sys_clauses],['#BQ',[if,['#COMMA',[caar,sys_clauses]],[progn,['#BQ-COMMA-ELIPSE',[cdar,sys_clauses]]],[cond,['#BQ-COMMA-ELIPSE',[cdr,sys_clauses]]]]],['#BQ',[or,['#COMMA',[caar,sys_clauses]],[cond,['#BQ-COMMA-ELIPSE',[cdr,sys_clauses]]]]]]]].
349*/
350/*
351% into:-[sys_put_sysprop,[quote,cond],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,cond,[c38_rest,sys_clauses],[when,sys_clauses,[if,[cdar,sys_clauses],['#BQ',[if,['#COMMA',[caar,sys_clauses]],[progn,['#BQ-COMMA-ELIPSE',[cdar,sys_clauses]]],[cond,['#BQ-COMMA-ELIPSE',[cdr,sys_clauses]]]]],['#BQ',[or,['#COMMA',[caar,sys_clauses]],[cond,['#BQ-COMMA-ELIPSE',[cdr,sys_clauses]]]]]]]]]].
352*/
353:- f_sys_put_sysprop(cond,
354 sys_defmacro_c61_sourceinfo,
355
356 [ defmacro,
357 cond,
358 [c38_rest, sys_clauses],
359
360 [ when,
361 sys_clauses,
362
363 [ if,
364 [cdar, sys_clauses],
365
366 [ '#BQ',
367
368 [ if,
369 ['#COMMA', [caar, sys_clauses]],
370 [progn, ['#BQ-COMMA-ELIPSE', [cdar, sys_clauses]]],
371 [cond, ['#BQ-COMMA-ELIPSE', [cdr, sys_clauses]]]
372 ]
373 ],
374
375 [ '#BQ',
376
377 [ or,
378 ['#COMMA', [caar, sys_clauses]],
379 [cond, ['#BQ-COMMA-ELIPSE', [cdr, sys_clauses]]]
380 ]
381 ]
382 ]
383 ]
384 ],
385 [],
386 _Ignored).
387/*
388(defmacro=sourceinfo case (keyform &rest clauses)
389 (let ((temp (gensym)))
390 (labels ((recur (clauses)
391 (when clauses
392 (if (member (caar clauses) '(otherwise t))
393 `(progn ,@(cdar clauses))
394 `(if ,(if (listp (caar clauses))
395 `(member ,temp ',(caar clauses))
396 `(eql ,temp ',(caar clauses)))
397 (progn ,@(cdar clauses))
398 ,(recur (cdr clauses)))))))
399 `(let ((,temp ,keyform))
400 ,(recur clauses)))))
401
402
403*/
404
405/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:1653 **********************/
406:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',case,[keyform,'&rest',clauses],[let,[[temp,[gensym]]],[labels,[[recur,[clauses],[when,clauses,[if,[member,[caar,clauses],[quote,[otherwise,t]]],['#BQ',[progn,['#BQ-COMMA-ELIPSE',[cdar,clauses]]]],['#BQ',[if,['#COMMA',[if,[listp,[caar,clauses]],['#BQ',[member,['#COMMA',temp],[quote,['#COMMA',[caar,clauses]]]]],['#BQ',[eql,['#COMMA',temp],[quote,['#COMMA',[caar,clauses]]]]]]],[progn,['#BQ-COMMA-ELIPSE',[cdar,clauses]]],['#COMMA',[recur,[cdr,clauses]]]]]]]]],['#BQ',[let,[[['#COMMA',temp],['#COMMA',keyform]]],['#COMMA',[recur,clauses]]]]]]])
407/*
408% macroexpand:-[sys_defmacro_c61_sourceinfo,case,[sys_keyform,c38_rest,sys_clauses],[let,[[sys_temp,[gensym]]],[labels,[[sys_recur,[sys_clauses],[when,sys_clauses,[if,[member,[caar,sys_clauses],[quote,[otherwise,t]]],['#BQ',[progn,['#BQ-COMMA-ELIPSE',[cdar,sys_clauses]]]],['#BQ',[if,['#COMMA',[if,[listp,[caar,sys_clauses]],['#BQ',[member,['#COMMA',sys_temp],[quote,['#COMMA',[caar,sys_clauses]]]]],['#BQ',[eql,['#COMMA',sys_temp],[quote,['#COMMA',[caar,sys_clauses]]]]]]],[progn,['#BQ-COMMA-ELIPSE',[cdar,sys_clauses]]],['#COMMA',[sys_recur,[cdr,sys_clauses]]]]]]]]],['#BQ',[let,[[['#COMMA',sys_temp],['#COMMA',sys_keyform]]],['#COMMA',[sys_recur,sys_clauses]]]]]]].
409*/
410/*
411% into:-[sys_put_sysprop,[quote,case],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,case,[sys_keyform,c38_rest,sys_clauses],[let,[[sys_temp,[gensym]]],[labels,[[sys_recur,[sys_clauses],[when,sys_clauses,[if,[member,[caar,sys_clauses],[quote,[otherwise,t]]],['#BQ',[progn,['#BQ-COMMA-ELIPSE',[cdar,sys_clauses]]]],['#BQ',[if,['#COMMA',[if,[listp,[caar,sys_clauses]],['#BQ',[member,['#COMMA',sys_temp],[quote,['#COMMA',[caar,sys_clauses]]]]],['#BQ',[eql,['#COMMA',sys_temp],[quote,['#COMMA',[caar,sys_clauses]]]]]]],[progn,['#BQ-COMMA-ELIPSE',[cdar,sys_clauses]]],['#COMMA',[sys_recur,[cdr,sys_clauses]]]]]]]]],['#BQ',[let,[[['#COMMA',sys_temp],['#COMMA',sys_keyform]]],['#COMMA',[sys_recur,sys_clauses]]]]]]]]].
412*/
413:- f_sys_put_sysprop(case,
414 sys_defmacro_c61_sourceinfo,
415
416 [ defmacro,
417 case,
418 [sys_keyform, c38_rest, sys_clauses],
419
420 [ let,
421 [[sys_temp, [gensym]]],
422
423 [ labels,
424
425 [
426 [ sys_recur,
427 [sys_clauses],
428
429 [ when,
430 sys_clauses,
431
432 [ if,
433
434 [ member,
435 [caar, sys_clauses],
436 [quote, [otherwise, t]]
437 ],
438
439 [ '#BQ',
440
441 [ progn,
442 ['#BQ-COMMA-ELIPSE', [cdar, sys_clauses]]
443 ]
444 ],
445
446 [ '#BQ',
447
448 [ if,
449
450 [ '#COMMA',
451
452 [ if,
453 [listp, [caar, sys_clauses]],
454
455 [ '#BQ',
456
457 [ member,
458 ['#COMMA', sys_temp],
459
460 [ quote,
461 ['#COMMA', [caar, sys_clauses]]
462 ]
463 ]
464 ],
465
466 [ '#BQ',
467
468 [ eql,
469 ['#COMMA', sys_temp],
470
471 [ quote,
472 ['#COMMA', [caar, sys_clauses]]
473 ]
474 ]
475 ]
476 ]
477 ],
478
479 [ progn,
480
481 [ '#BQ-COMMA-ELIPSE',
482 [cdar, sys_clauses]
483 ]
484 ],
485
486 [ '#COMMA',
487 [sys_recur, [cdr, sys_clauses]]
488 ]
489 ]
490 ]
491 ]
492 ]
493 ]
494 ],
495
496 [ '#BQ',
497
498 [ let,
499 [[['#COMMA', sys_temp], ['#COMMA', sys_keyform]]],
500 ['#COMMA', [sys_recur, sys_clauses]]
501 ]
502 ]
503 ]
504 ]
505 ],
506 [],
507 _Ignored).
508/*
509(defmacro=sourceinfo ecase (keyform &rest clauses)
510 (let ((temp (gensym)))
511 `(let ((,temp ,keyform))
512 (case ,temp ,@clauses
513 (error 'type-error :datum ,temp
514 :expected-type `(member ,@(mapcan #'(lambda (x)
515 (if (listp (car x))
516 (car x)
517 (list (car x))))
518 clauses)))))))
519
520*/
521
522/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:2130 **********************/
523:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',ecase,[keyform,'&rest',clauses],[let,[[temp,[gensym]]],['#BQ',[let,[[['#COMMA',temp],['#COMMA',keyform]]],[case,['#COMMA',temp],['#BQ-COMMA-ELIPSE',clauses],[error,[quote,'type-error'],':datum',['#COMMA',temp],':expected-type',['#BQ',[member,['#BQ-COMMA-ELIPSE',[mapcan,function([lambda,[x],[if,[listp,[car,x]],[car,x],[list,[car,x]]]]),clauses]]]]]]]]]])
524/*
525% macroexpand:-[sys_defmacro_c61_sourceinfo,ecase,[sys_keyform,c38_rest,sys_clauses],[let,[[sys_temp,[gensym]]],['#BQ',[let,[[['#COMMA',sys_temp],['#COMMA',sys_keyform]]],[case,['#COMMA',sys_temp],['#BQ-COMMA-ELIPSE',sys_clauses],[error,[quote,type_error],kw_datum,['#COMMA',sys_temp],kw_expected_type,['#BQ',[member,['#BQ-COMMA-ELIPSE',[mapcan,function([lambda,[sys_x],[if,[listp,[car,sys_x]],[car,sys_x],[list,[car,sys_x]]]]),sys_clauses]]]]]]]]]].
526*/
527/*
528% into:-[sys_put_sysprop,[quote,ecase],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,ecase,[sys_keyform,c38_rest,sys_clauses],[let,[[sys_temp,[gensym]]],['#BQ',[let,[[['#COMMA',sys_temp],['#COMMA',sys_keyform]]],[case,['#COMMA',sys_temp],['#BQ-COMMA-ELIPSE',sys_clauses],[error,[quote,type_error],kw_datum,['#COMMA',sys_temp],kw_expected_type,['#BQ',[member,['#BQ-COMMA-ELIPSE',[mapcan,function([lambda,[sys_x],[if,[listp,[car,sys_x]],[car,sys_x],[list,[car,sys_x]]]]),sys_clauses]]]]]]]]]]]].
529*/
530:- f_sys_put_sysprop(ecase,
531 sys_defmacro_c61_sourceinfo,
532
533 [ defmacro,
534 ecase,
535 [sys_keyform, c38_rest, sys_clauses],
536
537 [ let,
538 [[sys_temp, [gensym]]],
539
540 [ '#BQ',
541
542 [ let,
543 [[['#COMMA', sys_temp], ['#COMMA', sys_keyform]]],
544
545 [ case,
546 ['#COMMA', sys_temp],
547 ['#BQ-COMMA-ELIPSE', sys_clauses],
548
549 [ error,
550 [quote, type_error],
551 kw_datum,
552 ['#COMMA', sys_temp],
553 kw_expected_type,
554
555 [ '#BQ',
556
557 [ member,
558
559 [ '#BQ-COMMA-ELIPSE',
560
561 [ mapcan,
562 function(
563 [ lambda,
564 [sys_x],
565
566 [ if,
567 [listp, [car, sys_x]],
568 [car, sys_x],
569 [list, [car, sys_x]]
570 ]
571 ]),
572 sys_clauses
573 ]
574 ]
575 ]
576 ]
577 ]
578 ]
579 ]
580 ]
581 ]
582 ],
583 [],
584 _Ignored).
585/*
586(defmacro=sourceinfo multiple-value-bind (vars values-form &rest forms)
587 `(multiple-value-call #'(lambda (&optional ,@vars &rest ,(gensym))
588 ,@forms)
589 ,values-form))
590
591*/
592
593/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:2468 **********************/
594:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo','multiple-value-bind',[vars,'values-form','&rest',forms],['#BQ',['multiple-value-call',function([lambda,['&optional',['#BQ-COMMA-ELIPSE',vars],'&rest',['#COMMA',[gensym]]],['#BQ-COMMA-ELIPSE',forms]]),['#COMMA','values-form']]]])
595/*
596% macroexpand:-[sys_defmacro_c61_sourceinfo,multiple_value_bind,[sys_vars,sys_values_form,c38_rest,sys_forms],['#BQ',[multiple_value_call,function([lambda,[c38_optional,['#BQ-COMMA-ELIPSE',sys_vars],c38_rest,['#COMMA',[gensym]]],['#BQ-COMMA-ELIPSE',sys_forms]]),['#COMMA',sys_values_form]]]].
597*/
598/*
599% into:-[sys_put_sysprop,[quote,multiple_value_bind],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,multiple_value_bind,[sys_vars,sys_values_form,c38_rest,sys_forms],['#BQ',[multiple_value_call,function([lambda,[c38_optional,['#BQ-COMMA-ELIPSE',sys_vars],c38_rest,['#COMMA',[gensym]]],['#BQ-COMMA-ELIPSE',sys_forms]]),['#COMMA',sys_values_form]]]]]].
600*/
601:- f_sys_put_sysprop(multiple_value_bind,
602 sys_defmacro_c61_sourceinfo,
603
604 [ defmacro,
605 multiple_value_bind,
606 [sys_vars, sys_values_form, c38_rest, sys_forms],
607
608 [ '#BQ',
609
610 [ multiple_value_call,
611 function(
612 [ lambda,
613
614 [ c38_optional,
615 ['#BQ-COMMA-ELIPSE', sys_vars],
616 c38_rest,
617 ['#COMMA', [gensym]]
618 ],
619 ['#BQ-COMMA-ELIPSE', sys_forms]
620 ]),
621 ['#COMMA', sys_values_form]
622 ]
623 ]
624 ],
625 [],
626 _Ignored).
627/*
628(defmacro=sourceinfo multiple-value-list (form)
629 `(multiple-value-call #'list ,form))
630
631*/
632
633/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:2670 **********************/
634:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo','multiple-value-list',[form],['#BQ',['multiple-value-call',function(list),['#COMMA',form]]]])
635/*
636% macroexpand:-[sys_defmacro_c61_sourceinfo,multiple_value_list,[sys_form],['#BQ',[multiple_value_call,function(list),['#COMMA',sys_form]]]].
637*/
638/*
639% into:-[sys_put_sysprop,[quote,multiple_value_list],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,multiple_value_list,[sys_form],['#BQ',[multiple_value_call,function(list),['#COMMA',sys_form]]]]]].
640*/
641:- f_sys_put_sysprop(multiple_value_list,
642 sys_defmacro_c61_sourceinfo,
643
644 [ defmacro,
645 multiple_value_list,
646 [sys_form],
647
648 [ '#BQ',
649
650 [ multiple_value_call,
651 function(list),
652 ['#COMMA', sys_form]
653 ]
654 ]
655 ],
656 [],
657 _Ignored).
658/*
659(defun=sourceinfo values-list (list) (apply #'values list))
660
661*/
662
663/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:2761 **********************/
664:-lisp_compile_to_prolog(pkg_sys,['defun=sourceinfo','values-list',[list],[apply,function(values),list]])
665/*
666% macroexpand:-[sys_defun_c61_sourceinfo,values_list,[list],[apply,function(values),list]].
667*/
668/*
669% into:-[sys_put_sysprop,[quote,values_list],[quote,sys_defun_c61_sourceinfo],['#BQ',[defun,['#COMMA',[quote,values_list]],['#COMMA',[quote,[list]]],['#COMMA',[quote,[apply,function(values),list]]]]]].
670*/
671:- f_sys_put_sysprop(values_list,
672 sys_defun_c61_sourceinfo,
673 [defun, values_list, [list], [apply, function(values), list]],
674 [],
675 _Ignored).
676/*
677(defmacro=sourceinfo prog (inits &rest forms)
678 `(block nil
679 (let ,inits
680 (tagbody ,@forms))))
681*/
682
683/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:2824 **********************/
684:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',prog,[inits,'&rest',forms],['#BQ',[block,[],[let,['#COMMA',inits],[tagbody,['#BQ-COMMA-ELIPSE',forms]]]]]])
685/*
686% macroexpand:-[sys_defmacro_c61_sourceinfo,prog,[sys_inits,c38_rest,sys_forms],['#BQ',[block,[],[let,['#COMMA',sys_inits],[tagbody,['#BQ-COMMA-ELIPSE',sys_forms]]]]]].
687*/
688/*
689% into:-[sys_put_sysprop,[quote,prog],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,prog,[sys_inits,c38_rest,sys_forms],['#BQ',[block,[],[let,['#COMMA',sys_inits],[tagbody,['#BQ-COMMA-ELIPSE',sys_forms]]]]]]]].
690*/
691:- f_sys_put_sysprop(prog,
692 sys_defmacro_c61_sourceinfo,
693
694 [ defmacro,
695 prog,
696 [sys_inits, c38_rest, sys_forms],
697
698 [ '#BQ',
699
700 [ block,
701 [],
702
703 [ let,
704 ['#COMMA', sys_inits],
705 [tagbody, ['#BQ-COMMA-ELIPSE', sys_forms]]
706 ]
707 ]
708 ]
709 ],
710 [],
711 _Ignored).
712/*
713(defmacro=sourceinfo prog* (inits &rest forms)
714 `(block nil
715 (let* ,inits
716 (tagbody ,@forms))))
717*/
718
719/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:2931 **********************/
720:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo','prog*',[inits,'&rest',forms],['#BQ',[block,[],['let*',['#COMMA',inits],[tagbody,['#BQ-COMMA-ELIPSE',forms]]]]]])
721/*
722% macroexpand:-[sys_defmacro_c61_sourceinfo,prog_xx,[sys_inits,c38_rest,sys_forms],['#BQ',[block,[],[let_xx,['#COMMA',sys_inits],[tagbody,['#BQ-COMMA-ELIPSE',sys_forms]]]]]].
723*/
724/*
725% into:-[sys_put_sysprop,[quote,prog_xx],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,prog_xx,[sys_inits,c38_rest,sys_forms],['#BQ',[block,[],[let_xx,['#COMMA',sys_inits],[tagbody,['#BQ-COMMA-ELIPSE',sys_forms]]]]]]]].
726*/
727:- f_sys_put_sysprop(prog_xx,
728 sys_defmacro_c61_sourceinfo,
729
730 [ defmacro,
731 prog_xx,
732 [sys_inits, c38_rest, sys_forms],
733
734 [ '#BQ',
735
736 [ block,
737 [],
738
739 [ let_xx,
740 ['#COMMA', sys_inits],
741 [tagbody, ['#BQ-COMMA-ELIPSE', sys_forms]]
742 ]
743 ]
744 ]
745 ],
746 [],
747 _Ignored).
748/*
749(defmacro=sourceinfo prog1 (first-form &rest forms)
750 (let ((temp (gensym)))
751 `(let ((,temp ,first-form))
752 ,@forms
753 ,temp)))
754*/
755
756/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:3040 **********************/
757:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',prog1,['first-form','&rest',forms],[let,[[temp,[gensym]]],['#BQ',[let,[[['#COMMA',temp],['#COMMA','first-form']]],['#BQ-COMMA-ELIPSE',forms],['#COMMA',temp]]]]])
758/*
759% macroexpand:-[sys_defmacro_c61_sourceinfo,prog1,[sys_first_form,c38_rest,sys_forms],[let,[[sys_temp,[gensym]]],['#BQ',[let,[[['#COMMA',sys_temp],['#COMMA',sys_first_form]]],['#BQ-COMMA-ELIPSE',sys_forms],['#COMMA',sys_temp]]]]].
760*/
761/*
762% into:-[sys_put_sysprop,[quote,prog1],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,prog1,[sys_first_form,c38_rest,sys_forms],[let,[[sys_temp,[gensym]]],['#BQ',[let,[[['#COMMA',sys_temp],['#COMMA',sys_first_form]]],['#BQ-COMMA-ELIPSE',sys_forms],['#COMMA',sys_temp]]]]]]].
763*/
764:- f_sys_put_sysprop(prog1,
765 sys_defmacro_c61_sourceinfo,
766
767 [ defmacro,
768 prog1,
769 [sys_first_form, c38_rest, sys_forms],
770
771 [ let,
772 [[sys_temp, [gensym]]],
773
774 [ '#BQ',
775
776 [ let,
777 [[['#COMMA', sys_temp], ['#COMMA', sys_first_form]]],
778 ['#BQ-COMMA-ELIPSE', sys_forms],
779 ['#COMMA', sys_temp]
780 ]
781 ]
782 ]
783 ],
784 [],
785 _Ignored).
786/*
787(defmacro=sourceinfo prog2 (first-form second-form &rest forms)
788 (let ((temp (gensym)))
789 `(progn
790 ,first-form
791 (let ((,temp ,second-form))
792 ,@forms
793 ,temp))))
794
795*/
796
797/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:3183 **********************/
798:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',prog2,['first-form','second-form','&rest',forms],[let,[[temp,[gensym]]],['#BQ',[progn,['#COMMA','first-form'],[let,[[['#COMMA',temp],['#COMMA','second-form']]],['#BQ-COMMA-ELIPSE',forms],['#COMMA',temp]]]]]])
799/*
800% macroexpand:-[sys_defmacro_c61_sourceinfo,prog2,[sys_first_form,sys_second_form,c38_rest,sys_forms],[let,[[sys_temp,[gensym]]],['#BQ',[progn,['#COMMA',sys_first_form],[let,[[['#COMMA',sys_temp],['#COMMA',sys_second_form]]],['#BQ-COMMA-ELIPSE',sys_forms],['#COMMA',sys_temp]]]]]].
801*/
802/*
803% into:-[sys_put_sysprop,[quote,prog2],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,prog2,[sys_first_form,sys_second_form,c38_rest,sys_forms],[let,[[sys_temp,[gensym]]],['#BQ',[progn,['#COMMA',sys_first_form],[let,[[['#COMMA',sys_temp],['#COMMA',sys_second_form]]],['#BQ-COMMA-ELIPSE',sys_forms],['#COMMA',sys_temp]]]]]]]].
804*/
805:- f_sys_put_sysprop(prog2,
806 sys_defmacro_c61_sourceinfo,
807
808 [ defmacro,
809 prog2,
810 [sys_first_form, sys_second_form, c38_rest, sys_forms],
811
812 [ let,
813 [[sys_temp, [gensym]]],
814
815 [ '#BQ',
816
817 [ progn,
818 ['#COMMA', sys_first_form],
819
820 [ let,
821
822 [
823 [ ['#COMMA', sys_temp],
824 ['#COMMA', sys_second_form]
825 ]
826 ],
827 ['#BQ-COMMA-ELIPSE', sys_forms],
828 ['#COMMA', sys_temp]
829 ]
830 ]
831 ]
832 ]
833 ],
834 [],
835 _Ignored).
836/*
837#+BUILTIN
838#+(or WAM-CL LISP500)
839(defun equal (a b)
840 (or (eql a b)
841 (cond
842 ((not a) nil)
843 ((consp a) (and (consp b)
844 (equal (car a) (car b))
845 (equal (cdr a) (cdr b))))
846 ((stringp a) (and (stringp b)
847 (string= a b)))
848 ((bit-vector-p a) (and (bit-vector-p b)
849 (= (length a) (length b))
850 (dotimes (i (length a) t)
851 (when (/= (aref a i) (aref b i))
852 (return))))))))
853
854*/
855
856/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:3365 **********************/
857:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,equal,[a,b],[or,[eql,a,b],[cond,[[not,a],[]],[[consp,a],[and,[consp,b],[equal,[car,a],[car,b]],[equal,[cdr,a],[cdr,b]]]],[[stringp,a],[and,[stringp,b],['string=',a,b]]],[['bit-vector-p',a],[and,['bit-vector-p',b],[=,[length,a],[length,b]],[dotimes,[i,[length,a],t],[when,[/=,[aref,a,i],[aref,b,i]],[return]]]]]]]]]]))
858/*
859#+(or WAM-CL LISP500)
860(defun identity (object) object)
861
862*/
863
864/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:3786 **********************/
865:-lisp_compile_to_prolog(pkg_sys,[defun,identity,[object],object])
866wl:lambda_def(defun, identity, f_identity, [sys_object], [sys_object]).
867wl:arglist_info(identity, f_identity, [sys_object], arginfo{all:[sys_object], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_object], opt:0, req:[sys_object], rest:0, sublists:0, whole:0}).
868wl: init_args(x, f_identity).
869
874f_identity(Object_In, FnResult) :-
875 GEnv=[bv(sys_object, Object_In)],
876 catch(( get_var(GEnv, sys_object, Object_Get),
877 Object_Get=FnResult
878 ),
879 block_exit(identity, FnResult),
880 true).
881:- set_opv(identity, symbol_function, f_identity),
882 DefunResult=identity. 883/*
884:- side_effect(assert_lsp(identity,
885 lambda_def(defun,
886 identity,
887 f_identity,
888 [sys_object],
889 [sys_object]))).
890*/
891/*
892:- side_effect(assert_lsp(identity,
893 arglist_info(identity,
894 f_identity,
895 [sys_object],
896 arginfo{ all:[sys_object],
897 allow_other_keys:0,
898 aux:0,
899 body:0,
900 complex:0,
901 env:0,
902 key:0,
903 names:[sys_object],
904 opt:0,
905 req:[sys_object],
906 rest:0,
907 sublists:0,
908 whole:0
909 }))).
910*/
911/*
912:- side_effect(assert_lsp(identity, init_args(x, f_identity))).
913*/
914/*
915#+(or WAM-CL LISP500)
916(defun complement (function)
917 #'(lambda (&rest rest) (not (apply function rest))))
918
919*/
920
921/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:3845 **********************/
922:-lisp_compile_to_prolog(pkg_sys,[defun,complement,[function],function([lambda,['&rest',rest],[not,[apply,function,rest]]])])
923wl:lambda_def(defun, complement, f_complement, [function], [function([lambda, [c38_rest, rest], [not, [apply, function, rest]]])]).
924wl:arglist_info(complement, f_complement, [function], arginfo{all:[function], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[function], opt:0, req:[function], rest:0, sublists:0, whole:0}).
925wl: init_args(x, f_complement).
926
931f_complement(Function_In, FnResult) :-
932 CDR=[bv(function, Function_In)],
933 catch(( true,
934 closure(kw_function, [ClosureEnvironment|CDR], Whole, LResult, [c38_rest, rest], (get_var(ClosureEnvironment, function, Function_Get), get_var(ClosureEnvironment, rest, Rest_Get), f_apply(Function_Get, Rest_Get, Not_Param), f_not(Not_Param, LResult)), [lambda, [c38_rest, rest], [not, [apply, function, rest]]])=FnResult
935 ),
936 block_exit(complement, FnResult),
937 true).
938:- set_opv(complement, symbol_function, f_complement),
939 DefunResult=complement. 940/*
941:- side_effect(assert_lsp(complement,
942 lambda_def(defun,
943 complement,
944 f_complement,
945 [function],
946
947 [ function(
948 [ lambda,
949 [c38_rest, rest],
950 [not, [apply, function, rest]]
951 ])
952 ]))).
953*/
954/*
955:- side_effect(assert_lsp(complement,
956 arglist_info(complement,
957 f_complement,
958 [function],
959 arginfo{ all:[function],
960 allow_other_keys:0,
961 aux:0,
962 body:0,
963 complex:0,
964 env:0,
965 key:0,
966 names:[function],
967 opt:0,
968 req:[function],
969 rest:0,
970 sublists:0,
971 whole:0
972 }))).
973*/
974/*
975:- side_effect(assert_lsp(complement, init_args(x, f_complement))).
976*/
977/*
978#+(or WAM-CL LISP500)
979(defun constantly (value) #'(lambda (&rest rest) value))
980
981
982
983*/
984
985/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:3956 **********************/
986:-lisp_compile_to_prolog(pkg_sys,[defun,constantly,[value],function([lambda,['&rest',rest],value])])
987wl:lambda_def(defun, constantly, f_constantly, [sys_value], [function([lambda, [c38_rest, rest], sys_value])]).
988wl:arglist_info(constantly, f_constantly, [sys_value], arginfo{all:[sys_value], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_value], opt:0, req:[sys_value], rest:0, sublists:0, whole:0}).
989wl: init_args(x, f_constantly).
990
995f_constantly(Value_In, FnResult) :-
996 CDR=[bv(sys_value, Value_In)],
997 catch(( true,
998 closure(kw_function, [ClosureEnvironment|CDR], Whole, Value_Get, [c38_rest, rest], get_var(ClosureEnvironment, sys_value, Value_Get), [lambda, [c38_rest, rest], sys_value])=FnResult
999 ),
1000 block_exit(constantly, FnResult),
1001 true).
1002:- set_opv(constantly, symbol_function, f_constantly),
1003 DefunResult=constantly. 1004/*
1005:- side_effect(assert_lsp(constantly,
1006 lambda_def(defun,
1007 constantly,
1008 f_constantly,
1009 [sys_value],
1010
1011 [ function(
1012 [ lambda,
1013 [c38_rest, rest],
1014 sys_value
1015 ])
1016 ]))).
1017*/
1018/*
1019:- side_effect(assert_lsp(constantly,
1020 arglist_info(constantly,
1021 f_constantly,
1022 [sys_value],
1023 arginfo{ all:[sys_value],
1024 allow_other_keys:0,
1025 aux:0,
1026 body:0,
1027 complex:0,
1028 env:0,
1029 key:0,
1030 names:[sys_value],
1031 opt:0,
1032 req:[sys_value],
1033 rest:0,
1034 sublists:0,
1035 whole:0
1036 }))).
1037*/
1038/*
1039:- side_effect(assert_lsp(constantly, init_args(x, f_constantly))).
1040*/
1041/*
1042(defmacro=sourceinfo dotimes ((var count-form &optional result-form) &rest forms)
1043 (let ((start (gensym))
1044 (count (gensym)))
1045 `(block nil
1046 (let ((,var 0)
1047 (,count ,count-form))
1048 (tagbody
1049 ,start
1050 (when (< ,var ,count)
1051 ,@forms
1052 (incf ,var)
1053 (go ,start)))
1054 ,result-form))))
1055
1056
1057
1058*/
1059
1060/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:4043 **********************/
1061:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',dotimes,[[var,'count-form','&optional','result-form'],'&rest',forms],[let,[[start,[gensym]],[count,[gensym]]],['#BQ',[block,[],[let,[[['#COMMA',var],0],[['#COMMA',count],['#COMMA','count-form']]],[tagbody,['#COMMA',start],[when,[<,['#COMMA',var],['#COMMA',count]],['#BQ-COMMA-ELIPSE',forms],[incf,['#COMMA',var]],[go,['#COMMA',start]]]],['#COMMA','result-form']]]]]])
1062/*
1063% macroexpand:-[sys_defmacro_c61_sourceinfo,dotimes,[[sys_var,sys_count_form,c38_optional,sys_result_form],c38_rest,sys_forms],[let,[[sys_start,[gensym]],[count,[gensym]]],['#BQ',[block,[],[let,[[['#COMMA',sys_var],0],[['#COMMA',count],['#COMMA',sys_count_form]]],[tagbody,['#COMMA',sys_start],[when,[<,['#COMMA',sys_var],['#COMMA',count]],['#BQ-COMMA-ELIPSE',sys_forms],[incf,['#COMMA',sys_var]],[go,['#COMMA',sys_start]]]],['#COMMA',sys_result_form]]]]]].
1064*/
1065/*
1066% into:-[sys_put_sysprop,[quote,dotimes],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,dotimes,[[sys_var,sys_count_form,c38_optional,sys_result_form],c38_rest,sys_forms],[let,[[sys_start,[gensym]],[count,[gensym]]],['#BQ',[block,[],[let,[[['#COMMA',sys_var],0],[['#COMMA',count],['#COMMA',sys_count_form]]],[tagbody,['#COMMA',sys_start],[when,[<,['#COMMA',sys_var],['#COMMA',count]],['#BQ-COMMA-ELIPSE',sys_forms],[incf,['#COMMA',sys_var]],[go,['#COMMA',sys_start]]]],['#COMMA',sys_result_form]]]]]]]].
1067*/
1068:- f_sys_put_sysprop(dotimes,
1069 sys_defmacro_c61_sourceinfo,
1070
1071 [ defmacro,
1072 dotimes,
1073
1074 [ [sys_var, sys_count_form, c38_optional, sys_result_form],
1075 c38_rest,
1076 sys_forms
1077 ],
1078
1079 [ let,
1080 [[sys_start, [gensym]], [count, [gensym]]],
1081
1082 [ '#BQ',
1083
1084 [ block,
1085 [],
1086
1087 [ let,
1088
1089 [ [['#COMMA', sys_var], 0],
1090 [['#COMMA', count], ['#COMMA', sys_count_form]]
1091 ],
1092
1093 [ tagbody,
1094 ['#COMMA', sys_start],
1095
1096 [ when,
1097 [<, ['#COMMA', sys_var], ['#COMMA', count]],
1098 ['#BQ-COMMA-ELIPSE', sys_forms],
1099 [incf, ['#COMMA', sys_var]],
1100 [go, ['#COMMA', sys_start]]
1101 ]
1102 ],
1103 ['#COMMA', sys_result_form]
1104 ]
1105 ]
1106 ]
1107 ]
1108 ],
1109 [],
1110 _Ignored).
1111/*
1112(defmacro=sourceinfo do (vars (end-test-form &rest result-forms) &rest forms)
1113 (let ((start (gensym))
1114 (inits nil)
1115 (steps nil))
1116 `(block nil
1117 (let ,(dolist (var vars (reverse inits))
1118 (push (if (consp var)
1119 (list (car var) (cadr var))
1120 (list var)) inits))
1121 (tagbody
1122 ,start
1123 (if ,end-test-form (return (progn ,@result-forms)))
1124 ,@forms
1125 ,@(dolist (var vars (when steps `((psetq ,@(reverse steps)))))
1126 (when (and (consp var) (cddr var))
1127 (push (car var) steps)
1128 (push (caddr var) steps)))
1129 (go ,start))))))
1130*/
1131
1132/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:4369 **********************/
1133:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',do,[vars,['end-test-form','&rest','result-forms'],'&rest',forms],[let,[[start,[gensym]],[inits,[]],[steps,[]]],['#BQ',[block,[],[let,['#COMMA',[dolist,[var,vars,[reverse,inits]],[push,[if,[consp,var],[list,[car,var],[cadr,var]],[list,var]],inits]]],[tagbody,['#COMMA',start],[if,['#COMMA','end-test-form'],[return,[progn,['#BQ-COMMA-ELIPSE','result-forms']]]],['#BQ-COMMA-ELIPSE',forms],['#BQ-COMMA-ELIPSE',[dolist,[var,vars,[when,steps,['#BQ',[[psetq,['#BQ-COMMA-ELIPSE',[reverse,steps]]]]]]],[when,[and,[consp,var],[cddr,var]],[push,[car,var],steps],[push,[caddr,var],steps]]]],[go,['#COMMA',start]]]]]]]])
1134/*
1135% macroexpand:-[sys_defmacro_c61_sourceinfo,do,[sys_vars,[sys_end_test_form,c38_rest,sys_result_forms],c38_rest,sys_forms],[let,[[sys_start,[gensym]],[sys_inits,[]],[sys_steps,[]]],['#BQ',[block,[],[let,['#COMMA',[dolist,[sys_var,sys_vars,[reverse,sys_inits]],[push,[if,[consp,sys_var],[list,[car,sys_var],[cadr,sys_var]],[list,sys_var]],sys_inits]]],[tagbody,['#COMMA',sys_start],[if,['#COMMA',sys_end_test_form],[return,[progn,['#BQ-COMMA-ELIPSE',sys_result_forms]]]],['#BQ-COMMA-ELIPSE',sys_forms],['#BQ-COMMA-ELIPSE',[dolist,[sys_var,sys_vars,[when,sys_steps,['#BQ',[[psetq,['#BQ-COMMA-ELIPSE',[reverse,sys_steps]]]]]]],[when,[and,[consp,sys_var],[cddr,sys_var]],[push,[car,sys_var],sys_steps],[push,[caddr,sys_var],sys_steps]]]],[go,['#COMMA',sys_start]]]]]]]].
1136*/
1137/*
1138% into:-[sys_put_sysprop,[quote,do],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,do,[sys_vars,[sys_end_test_form,c38_rest,sys_result_forms],c38_rest,sys_forms],[let,[[sys_start,[gensym]],[sys_inits,[]],[sys_steps,[]]],['#BQ',[block,[],[let,['#COMMA',[dolist,[sys_var,sys_vars,[reverse,sys_inits]],[push,[if,[consp,sys_var],[list,[car,sys_var],[cadr,sys_var]],[list,sys_var]],sys_inits]]],[tagbody,['#COMMA',sys_start],[if,['#COMMA',sys_end_test_form],[return,[progn,['#BQ-COMMA-ELIPSE',sys_result_forms]]]],['#BQ-COMMA-ELIPSE',sys_forms],['#BQ-COMMA-ELIPSE',[dolist,[sys_var,sys_vars,[when,sys_steps,['#BQ',[[psetq,['#BQ-COMMA-ELIPSE',[reverse,sys_steps]]]]]]],[when,[and,[consp,sys_var],[cddr,sys_var]],[push,[car,sys_var],sys_steps],[push,[caddr,sys_var],sys_steps]]]],[go,['#COMMA',sys_start]]]]]]]]]].
1139*/
1140:- f_sys_put_sysprop(do,
1141 sys_defmacro_c61_sourceinfo,
1142
1143 [ defmacro,
1144 do,
1145
1146 [ sys_vars,
1147 [sys_end_test_form, c38_rest, sys_result_forms],
1148 c38_rest,
1149 sys_forms
1150 ],
1151
1152 [ let,
1153 [[sys_start, [gensym]], [sys_inits, []], [sys_steps, []]],
1154
1155 [ '#BQ',
1156
1157 [ block,
1158 [],
1159
1160 [ let,
1161
1162 [ '#COMMA',
1163
1164 [ dolist,
1165 [sys_var, sys_vars, [reverse, sys_inits]],
1166
1167 [ push,
1168
1169 [ if,
1170 [consp, sys_var],
1171 [list, [car, sys_var], [cadr, sys_var]],
1172 [list, sys_var]
1173 ],
1174 sys_inits
1175 ]
1176 ]
1177 ],
1178
1179 [ tagbody,
1180 ['#COMMA', sys_start],
1181
1182 [ if,
1183 ['#COMMA', sys_end_test_form],
1184
1185 [ return,
1186
1187 [ progn,
1188 ['#BQ-COMMA-ELIPSE', sys_result_forms]
1189 ]
1190 ]
1191 ],
1192 ['#BQ-COMMA-ELIPSE', sys_forms],
1193
1194 [ '#BQ-COMMA-ELIPSE',
1195
1196 [ dolist,
1197
1198 [ sys_var,
1199 sys_vars,
1200
1201 [ when,
1202 sys_steps,
1203
1204 [ '#BQ',
1205
1206 [
1207 [ psetq,
1208
1209 [ '#BQ-COMMA-ELIPSE',
1210 [reverse, sys_steps]
1211 ]
1212 ]
1213 ]
1214 ]
1215 ]
1216 ],
1217
1218 [ when,
1219 [and, [consp, sys_var], [cddr, sys_var]],
1220 [push, [car, sys_var], sys_steps],
1221 [push, [caddr, sys_var], sys_steps]
1222 ]
1223 ]
1224 ],
1225 [go, ['#COMMA', sys_start]]
1226 ]
1227 ]
1228 ]
1229 ]
1230 ]
1231 ],
1232 [],
1233 _Ignored).
1234/*
1235(defmacro=sourceinfo do* (vars (end-test-form &rest result-forms) &rest forms)
1236 (let ((start (gensym))
1237 (inits nil)
1238 (steps nil))
1239 `(block nil
1240 (let* ,(dolist (var vars (reverse inits))
1241 (push (if (consp var)
1242 (list (car var) (cadr var))
1243 (list var)) inits))
1244 (tagbody
1245 ,start
1246 (if ,end-test-form (return (progn ,@result-forms)))
1247 ,@forms
1248 ,@(dolist (var vars (when steps `((setq ,@(reverse steps)))))
1249 (when (and (consp var) (cddr var))
1250 (push (car var) steps)
1251 (push (caddr var) steps)))
1252 (go ,start))))))
1253
1254
1255
1256*/
1257
1258/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:4946 **********************/
1259:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo','do*',[vars,['end-test-form','&rest','result-forms'],'&rest',forms],[let,[[start,[gensym]],[inits,[]],[steps,[]]],['#BQ',[block,[],['let*',['#COMMA',[dolist,[var,vars,[reverse,inits]],[push,[if,[consp,var],[list,[car,var],[cadr,var]],[list,var]],inits]]],[tagbody,['#COMMA',start],[if,['#COMMA','end-test-form'],[return,[progn,['#BQ-COMMA-ELIPSE','result-forms']]]],['#BQ-COMMA-ELIPSE',forms],['#BQ-COMMA-ELIPSE',[dolist,[var,vars,[when,steps,['#BQ',[[setq,['#BQ-COMMA-ELIPSE',[reverse,steps]]]]]]],[when,[and,[consp,var],[cddr,var]],[push,[car,var],steps],[push,[caddr,var],steps]]]],[go,['#COMMA',start]]]]]]]])
1260/*
1261% macroexpand:-[sys_defmacro_c61_sourceinfo,do_xx,[sys_vars,[sys_end_test_form,c38_rest,sys_result_forms],c38_rest,sys_forms],[let,[[sys_start,[gensym]],[sys_inits,[]],[sys_steps,[]]],['#BQ',[block,[],[let_xx,['#COMMA',[dolist,[sys_var,sys_vars,[reverse,sys_inits]],[push,[if,[consp,sys_var],[list,[car,sys_var],[cadr,sys_var]],[list,sys_var]],sys_inits]]],[tagbody,['#COMMA',sys_start],[if,['#COMMA',sys_end_test_form],[return,[progn,['#BQ-COMMA-ELIPSE',sys_result_forms]]]],['#BQ-COMMA-ELIPSE',sys_forms],['#BQ-COMMA-ELIPSE',[dolist,[sys_var,sys_vars,[when,sys_steps,['#BQ',[[setq,['#BQ-COMMA-ELIPSE',[reverse,sys_steps]]]]]]],[when,[and,[consp,sys_var],[cddr,sys_var]],[push,[car,sys_var],sys_steps],[push,[caddr,sys_var],sys_steps]]]],[go,['#COMMA',sys_start]]]]]]]].
1262*/
1263/*
1264% into:-[sys_put_sysprop,[quote,do_xx],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,do_xx,[sys_vars,[sys_end_test_form,c38_rest,sys_result_forms],c38_rest,sys_forms],[let,[[sys_start,[gensym]],[sys_inits,[]],[sys_steps,[]]],['#BQ',[block,[],[let_xx,['#COMMA',[dolist,[sys_var,sys_vars,[reverse,sys_inits]],[push,[if,[consp,sys_var],[list,[car,sys_var],[cadr,sys_var]],[list,sys_var]],sys_inits]]],[tagbody,['#COMMA',sys_start],[if,['#COMMA',sys_end_test_form],[return,[progn,['#BQ-COMMA-ELIPSE',sys_result_forms]]]],['#BQ-COMMA-ELIPSE',sys_forms],['#BQ-COMMA-ELIPSE',[dolist,[sys_var,sys_vars,[when,sys_steps,['#BQ',[[setq,['#BQ-COMMA-ELIPSE',[reverse,sys_steps]]]]]]],[when,[and,[consp,sys_var],[cddr,sys_var]],[push,[car,sys_var],sys_steps],[push,[caddr,sys_var],sys_steps]]]],[go,['#COMMA',sys_start]]]]]]]]]].
1265*/
1266:- f_sys_put_sysprop(do_xx,
1267 sys_defmacro_c61_sourceinfo,
1268
1269 [ defmacro,
1270 do_xx,
1271
1272 [ sys_vars,
1273 [sys_end_test_form, c38_rest, sys_result_forms],
1274 c38_rest,
1275 sys_forms
1276 ],
1277
1278 [ let,
1279 [[sys_start, [gensym]], [sys_inits, []], [sys_steps, []]],
1280
1281 [ '#BQ',
1282
1283 [ block,
1284 [],
1285
1286 [ let_xx,
1287
1288 [ '#COMMA',
1289
1290 [ dolist,
1291 [sys_var, sys_vars, [reverse, sys_inits]],
1292
1293 [ push,
1294
1295 [ if,
1296 [consp, sys_var],
1297 [list, [car, sys_var], [cadr, sys_var]],
1298 [list, sys_var]
1299 ],
1300 sys_inits
1301 ]
1302 ]
1303 ],
1304
1305 [ tagbody,
1306 ['#COMMA', sys_start],
1307
1308 [ if,
1309 ['#COMMA', sys_end_test_form],
1310
1311 [ return,
1312
1313 [ progn,
1314 ['#BQ-COMMA-ELIPSE', sys_result_forms]
1315 ]
1316 ]
1317 ],
1318 ['#BQ-COMMA-ELIPSE', sys_forms],
1319
1320 [ '#BQ-COMMA-ELIPSE',
1321
1322 [ dolist,
1323
1324 [ sys_var,
1325 sys_vars,
1326
1327 [ when,
1328 sys_steps,
1329
1330 [ '#BQ',
1331
1332 [
1333 [ setq,
1334
1335 [ '#BQ-COMMA-ELIPSE',
1336 [reverse, sys_steps]
1337 ]
1338 ]
1339 ]
1340 ]
1341 ]
1342 ],
1343
1344 [ when,
1345 [and, [consp, sys_var], [cddr, sys_var]],
1346 [push, [car, sys_var], sys_steps],
1347 [push, [caddr, sys_var], sys_steps]
1348 ]
1349 ]
1350 ],
1351 [go, ['#COMMA', sys_start]]
1352 ]
1353 ]
1354 ]
1355 ]
1356 ]
1357 ],
1358 [],
1359 _Ignored).
1360/*
1361(defmacro=sourceinfo dolist ((var list-form &optional result-form) &rest forms)
1362 (let ((start (gensym))
1363 (list (gensym)))
1364 `(block nil
1365 (let ((,list ,list-form)
1366 (,var nil))
1367 (tagbody
1368 ,start
1369 (unless ,list
1370 (setf ,var nil)
1371 (return-from nil ,result-form))
1372 (setf ,var (car ,list))
1373 (setf ,list (cdr ,list))
1374 ,@forms
1375 (go ,start))))))
1376
1377
1378
1379
1380*/
1381
1382/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:5533 **********************/
1383:-lisp_compile_to_prolog(pkg_sys,['defmacro=sourceinfo',dolist,[[var,'list-form','&optional','result-form'],'&rest',forms],[let,[[start,[gensym]],[list,[gensym]]],['#BQ',[block,[],[let,[[['#COMMA',list],['#COMMA','list-form']],[['#COMMA',var],[]]],[tagbody,['#COMMA',start],[unless,['#COMMA',list],[setf,['#COMMA',var],[]],['return-from',[],['#COMMA','result-form']]],[setf,['#COMMA',var],[car,['#COMMA',list]]],[setf,['#COMMA',list],[cdr,['#COMMA',list]]],['#BQ-COMMA-ELIPSE',forms],[go,['#COMMA',start]]]]]]]])
1384/*
1385% macroexpand:-[sys_defmacro_c61_sourceinfo,dolist,[[sys_var,sys_list_form,c38_optional,sys_result_form],c38_rest,sys_forms],[let,[[sys_start,[gensym]],[list,[gensym]]],['#BQ',[block,[],[let,[[['#COMMA',list],['#COMMA',sys_list_form]],[['#COMMA',sys_var],[]]],[tagbody,['#COMMA',sys_start],[unless,['#COMMA',list],[setf,['#COMMA',sys_var],[]],[return_from,[],['#COMMA',sys_result_form]]],[setf,['#COMMA',sys_var],[car,['#COMMA',list]]],[setf,['#COMMA',list],[cdr,['#COMMA',list]]],['#BQ-COMMA-ELIPSE',sys_forms],[go,['#COMMA',sys_start]]]]]]]].
1386*/
1387/*
1388% into:-[sys_put_sysprop,[quote,dolist],[quote,sys_defmacro_c61_sourceinfo],[quote,[defmacro,dolist,[[sys_var,sys_list_form,c38_optional,sys_result_form],c38_rest,sys_forms],[let,[[sys_start,[gensym]],[list,[gensym]]],['#BQ',[block,[],[let,[[['#COMMA',list],['#COMMA',sys_list_form]],[['#COMMA',sys_var],[]]],[tagbody,['#COMMA',sys_start],[unless,['#COMMA',list],[setf,['#COMMA',sys_var],[]],[return_from,[],['#COMMA',sys_result_form]]],[setf,['#COMMA',sys_var],[car,['#COMMA',list]]],[setf,['#COMMA',list],[cdr,['#COMMA',list]]],['#BQ-COMMA-ELIPSE',sys_forms],[go,['#COMMA',sys_start]]]]]]]]]].
1389*/
1390:- f_sys_put_sysprop(dolist,
1391 sys_defmacro_c61_sourceinfo,
1392
1393 [ defmacro,
1394 dolist,
1395
1396 [ [sys_var, sys_list_form, c38_optional, sys_result_form],
1397 c38_rest,
1398 sys_forms
1399 ],
1400
1401 [ let,
1402 [[sys_start, [gensym]], [list, [gensym]]],
1403
1404 [ '#BQ',
1405
1406 [ block,
1407 [],
1408
1409 [ let,
1410
1411 [ [['#COMMA', list], ['#COMMA', sys_list_form]],
1412 [['#COMMA', sys_var], []]
1413 ],
1414
1415 [ tagbody,
1416 ['#COMMA', sys_start],
1417
1418 [ unless,
1419 ['#COMMA', list],
1420 [setf, ['#COMMA', sys_var], []],
1421 [return_from, [], ['#COMMA', sys_result_form]]
1422 ],
1423
1424 [ setf,
1425 ['#COMMA', sys_var],
1426 [car, ['#COMMA', list]]
1427 ],
1428 [setf, ['#COMMA', list], [cdr, ['#COMMA', list]]],
1429 ['#BQ-COMMA-ELIPSE', sys_forms],
1430 [go, ['#COMMA', sys_start]]
1431 ]
1432 ]
1433 ]
1434 ]
1435 ]
1436 ],
1437 [],
1438 _Ignored).
1439/*
1440#+(or WAM-CL LISP500)
1441(defun designator-condition (default-type datum arguments)
1442 (if (symbolp datum)
1443 (apply #'make-condition datum arguments)
1444 (if (or (stringp datum) (functionp datum))
1445 (make-condition default-type
1446 :format-control datum
1447 :format-arguments arguments)
1448 datum)))
1449
1450
1451*/
1452
1453/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:5932 **********************/
1454:-lisp_compile_to_prolog(pkg_sys,[defun,'designator-condition',['default-type',datum,arguments],[if,[symbolp,datum],[apply,function('make-condition'),datum,arguments],[if,[or,[stringp,datum],[functionp,datum]],['make-condition','default-type',':format-control',datum,':format-arguments',arguments],datum]]])
1455/*
1456:- side_effect(generate_function_or_macro_name(
1457 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1458 name='GLOBAL',
1459 environ=env_1
1460 ],
1461 sys_designator_condition,
1462 kw_function,
1463 f_sys_designator_condition)).
1464*/
1465wl:lambda_def(defun, sys_designator_condition, f_sys_designator_condition, [sys_default_type, sys_datum, sys_arguments], [[if, [symbolp, sys_datum], [apply, function(make_condition), sys_datum, sys_arguments], [if, [or, [stringp, sys_datum], [functionp, sys_datum]], [make_condition, sys_default_type, kw_format_control, sys_datum, kw_format_arguments, sys_arguments], sys_datum]]]).
1466wl:arglist_info(sys_designator_condition, f_sys_designator_condition, [sys_default_type, sys_datum, sys_arguments], arginfo{all:[sys_default_type, sys_datum, sys_arguments], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_default_type, sys_datum, sys_arguments], opt:0, req:[sys_default_type, sys_datum, sys_arguments], rest:0, sublists:0, whole:0}).
1467wl: init_args(x, f_sys_designator_condition).
1468
1473f_sys_designator_condition(Default_type_In, Datum_In, Arguments_In, FnResult) :-
1474 GEnv=[bv(sys_default_type, Default_type_In), bv(sys_datum, Datum_In), bv(sys_arguments, Arguments_In)],
1475 catch(( ( get_var(GEnv, sys_datum, Datum_Get),
1476 ( is_symbolp(Datum_Get)
1477 -> get_var(GEnv, sys_arguments, Arguments_Get),
1478 get_var(GEnv, sys_datum, Datum_Get11),
1479 f_apply(f_make_condition,
1480 [Datum_Get11, Arguments_Get],
1481 TrueResult24),
1482 _7386=TrueResult24
1483 ; ( get_var(GEnv, sys_datum, Datum_Get15),
1484 f_stringp(Datum_Get15, FORM1_Res),
1485 FORM1_Res\==[],
1486 IFTEST13=FORM1_Res
1487 -> true
1488 ; get_var(GEnv, sys_datum, Datum_Get16),
1489 f_functionp(Datum_Get16, Functionp_Ret),
1490 IFTEST13=Functionp_Ret
1491 ),
1492 ( IFTEST13\==[]
1493 -> get_var(GEnv, sys_datum, Datum_Get19),
1494 ( get_var(GEnv, sys_arguments, Arguments_Get20),
1495 get_var(GEnv, sys_default_type, Default_type_Get)
1496 ),
1497 f_make_condition(Default_type_Get,
1498 kw_format_control,
1499 Datum_Get19,
1500 kw_format_arguments,
1501 Arguments_Get20,
1502 TrueResult),
1503 ElseResult25=TrueResult
1504 ; get_var(GEnv, sys_datum, Datum_Get21),
1505 ElseResult25=Datum_Get21
1506 ),
1507 _7386=ElseResult25
1508 )
1509 ),
1510 _7386=FnResult
1511 ),
1512 block_exit(sys_designator_condition, FnResult),
1513 true).
1514:- set_opv(sys_designator_condition,
1515 symbol_function,
1516 f_sys_designator_condition),
1517 DefunResult=sys_designator_condition. 1518/*
1519:- side_effect(assert_lsp(sys_designator_condition,
1520 lambda_def(defun,
1521 sys_designator_condition,
1522 f_sys_designator_condition,
1523
1524 [ sys_default_type,
1525 sys_datum,
1526 sys_arguments
1527 ],
1528
1529 [
1530 [ if,
1531 [symbolp, sys_datum],
1532
1533 [ apply,
1534 function(make_condition),
1535 sys_datum,
1536 sys_arguments
1537 ],
1538
1539 [ if,
1540
1541 [ or,
1542 [stringp, sys_datum],
1543 [functionp, sys_datum]
1544 ],
1545
1546 [ make_condition,
1547 sys_default_type,
1548 kw_format_control,
1549 sys_datum,
1550 kw_format_arguments,
1551 sys_arguments
1552 ],
1553 sys_datum
1554 ]
1555 ]
1556 ]))).
1557*/
1558/*
1559:- side_effect(assert_lsp(sys_designator_condition,
1560 arglist_info(sys_designator_condition,
1561 f_sys_designator_condition,
1562
1563 [ sys_default_type,
1564 sys_datum,
1565 sys_arguments
1566 ],
1567 arginfo{ all:
1568 [ sys_default_type,
1569 sys_datum,
1570 sys_arguments
1571 ],
1572 allow_other_keys:0,
1573 aux:0,
1574 body:0,
1575 complex:0,
1576 env:0,
1577 key:0,
1578 names:
1579 [ sys_default_type,
1580 sys_datum,
1581 sys_arguments
1582 ],
1583 opt:0,
1584 req:
1585 [ sys_default_type,
1586 sys_datum,
1587 sys_arguments
1588 ],
1589 rest:0,
1590 sublists:0,
1591 whole:0
1592 }))).
1593*/
1594/*
1595:- side_effect(assert_lsp(sys_designator_condition,
1596 init_args(x, f_sys_designator_condition))).
1597*/
1598/*
1599#+(or WAM-CL LISP500)
1600(defun invoke-debugger (condition)
1601 (let ((debugger-hook *debugger-hook*)
1602 (*debugger-hook* nil))
1603 (when debugger-hook
1604 (funcall debugger-hook condition debugger-hook))
1605 (format *debug-io* "Entering debugger."#+(or WAM-CL LISP500) \r\n(defun invoke-debugger (condition)\r\n (let ((debugger-hook *debugger-hook*)\r\n\t(*debugger-hook* nil))\r\n (when debugger-hook\r\n (funcall debugger-hook condition debugger-hook))\r\n (format *debug-io* \"Entering debugger.~%\")\r\n (princ condition *debug-io*)\r\n (terpri *debug-io*)\r\n (let ((restarts (compute-restarts condition))\r\n\t (stack (makef))\r\n\t (frame-depth 0)\r\n\t (active-frame nil))\r\n (let ((count 0))\r\n\t(dolist (restart restarts)\r\n\t (format *debug-io* \"~A: \" count)\r\n\t (princ restart *debug-io*)\r\n\t (terpri *debug-io*)\r\n\t (incf count)))\r\n (setq active-frame (next-function-frame (- stack 20)))\r\n (show-frame active-frame 0)\r\n (tagbody\r\n start\r\n\t (format *debug-io* \";~A> \" frame-depth)\r\n\t (let ((form (read)))\r\n\t (case form\r\n\t (:help (format *debug-io* \"Type :help to get help.~%\")\r\n\t\t (format *debug-io* \"Type :continue <index> to invoke the indexed restart.~%\"))\r\n\t (:back (do ((frame (next-function-frame (- stack 20))\r\n\t\t\t\t(next-function-frame frame))\r\n\t\t\t (index 0 (+ 1 index)))\r\n\t\t\t((not frame))\r\n\t\t (show-frame frame index)))\r\n\t (:up (if (plusp frame-depth)\r\n\t\t (progn\r\n\t\t\t(decf frame-depth)\r\n\t\t\t(do ((frame (next-function-frame (- stack 20))\r\n\t\t\t\t (next-function-frame frame))\r\n\t\t\t (index 0 (+ 1 index)))\r\n\t\t\t ((= index frame-depth) (setq active-frame frame)))\r\n\t\t\t(show-frame active-frame frame-depth))\r\n\t\t (format *debug-io* \"Top of stack.~%\")))\r\n\t (:down (let ((frame (next-function-frame active-frame)))\r\n\t\t (if frame\r\n\t\t\t (progn\r\n\t\t\t (incf frame-depth)\r\n\t\t\t (setq active-frame frame)\r\n\t\t\t (show-frame active-frame frame-depth))\r\n\t\t\t (format *debug-io* \"Bottom of stack.~%\"))))\r\n\t (:locals (do ((env (fref (- active-frame 1)) (cdr env)))\r\n\t\t\t ((not env))\r\n\t\t\t(when (symbolp (caar env))\r\n\t\t\t (format *debug-io* \"~A~%\" (caar env)))))\r\n\t (:continue (let ((index (read)))\r\n\t\t\t (invoke-restart-interactively (nth index restarts))))\r\n\t (t (let ((values (multiple-value-list\r\n\t\t\t (eval form (fref (- active-frame 1)))))\r\n\t\t (count 0))\r\n\t\t (if values\r\n\t\t (dolist (value values)\r\n\t\t\t(format *debug-io* \";~A: ~S~%\" count value)\r\n\t\t\t(incf count))\r\n\t\t (format *debug-io* \";No values.~%\")))))\r\n\t (go start))))))\r\n\r\n\r\n\r\n\r\n\r\n".
1606*/
1607
1608/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:6249 **********************/
1609:-lisp_compile_to_prolog(pkg_sys,[defun,'invoke-debugger',[condition],[let,[['debugger-hook','*debugger-hook*'],['*debugger-hook*',[]]],[when,'debugger-hook',[funcall,'debugger-hook',condition,'debugger-hook']],[format,'*debug-io*','$STRING'("Entering debugger.~%")],[princ,condition,'*debug-io*'],[terpri,'*debug-io*'],[let,[[restarts,['compute-restarts',condition]],[stack,[makef]],['frame-depth',0],['active-frame',[]]],[let,[[count,0]],[dolist,[restart,restarts],[format,'*debug-io*','$STRING'("~A: "),count],[princ,restart,'*debug-io*'],[terpri,'*debug-io*'],[incf,count]]],[setq,'active-frame',['next-function-frame',[-,stack,20]]],['show-frame','active-frame',0],[tagbody,start,[format,'*debug-io*','$STRING'(";~A> "),'frame-depth'],[let,[[form,[read]]],[case,form,[':help',[format,'*debug-io*','$STRING'("Type :help to get help.~%")],[format,'*debug-io*','$STRING'("Type :continue <index> to invoke the indexed restart.~%")]],[':back',[do,[[frame,['next-function-frame',[-,stack,20]],['next-function-frame',frame]],[index,0,[+,1,index]]],[[not,frame]],['show-frame',frame,index]]],[':up',[if,[plusp,'frame-depth'],[progn,[decf,'frame-depth'],[do,[[frame,['next-function-frame',[-,stack,20]],['next-function-frame',frame]],[index,0,[+,1,index]]],[[=,index,'frame-depth'],[setq,'active-frame',frame]]],['show-frame','active-frame','frame-depth']],[format,'*debug-io*','$STRING'("Top of stack.~%")]]],[':down',[let,[[frame,['next-function-frame','active-frame']]],[if,frame,[progn,[incf,'frame-depth'],[setq,'active-frame',frame],['show-frame','active-frame','frame-depth']],[format,'*debug-io*','$STRING'("Bottom of stack.~%")]]]],[':locals',[do,[[env,[fref,[-,'active-frame',1]],[cdr,env]]],[[not,env]],[when,[symbolp,[caar,env]],[format,'*debug-io*','$STRING'("~A~%"),[caar,env]]]]],[':continue',[let,[[index,[read]]],['invoke-restart-interactively',[nth,index,restarts]]]],[t,[let,[[values,['multiple-value-list',[eval,form,[fref,[-,'active-frame',1]]]]],[count,0]],[if,values,[dolist,[value,values],[format,'*debug-io*','$STRING'(";~A: ~S~%"),count,value],[incf,count]],[format,'*debug-io*','$STRING'(";No values.~%")]]]]],[go,start]]]]]])
1610/*
1611:- side_effect(generate_function_or_macro_name(
1612 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1613 name='GLOBAL',
1614 environ=env_1
1615 ],
1616 sys_makef,
1617 kw_function,
1618 f_sys_makef)).
1619*/
1620/*
1621:- side_effect(generate_function_or_macro_name(
1622 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1623 name='GLOBAL',
1624 environ=env_1
1625 ],
1626 sys_next_function_frame,
1627 kw_function,
1628 f_sys_next_function_frame)).
1629*/
1630/*
1631:- side_effect(generate_function_or_macro_name(
1632 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1633 name='GLOBAL',
1634 environ=env_1
1635 ],
1636 sys_show_frame,
1637 kw_function,
1638 f_sys_show_frame)).
1639*/
1640/*
1641% case:-[[kw_help,[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :help to get help.~%")],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :continue <index> to invoke the indexed restart.~%")]],[kw_back,[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[not,sys_frame]],[sys_show_frame,sys_frame,sys_index]]],[kw_up,[if,[plusp,sys_frame_depth],[progn,[decf,sys_frame_depth],[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[=,sys_index,sys_frame_depth],[setq,sys_active_frame,sys_frame]]],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Top of stack.~%")]]],[kw_down,[let,[[sys_frame,[sys_next_function_frame,sys_active_frame]]],[if,sys_frame,[progn,[incf,sys_frame_depth],[setq,sys_active_frame,sys_frame],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Bottom of stack.~%")]]]],[kw_locals,[do,[[sys_env,[sys_fref,[-,sys_active_frame,1]],[cdr,sys_env]]],[[not,sys_env]],[when,[symbolp,[caar,sys_env]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"~A~%"),[caar,sys_env]]]]],[kw_continue,[let,[[sys_index,[read]]],[invoke_restart_interactively,[nth,sys_index,sys_restarts]]]],[t,[let,[[values,[multiple_value_list,[eval,sys_form,[sys_fref,[-,sys_active_frame,1]]]]],[count,0]],[if,values,[dolist,[sys_value,values],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";~A: ~S~%"),count,sys_value],[incf,count]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";No values.~%")]]]]].
1642*/
1643/*
1644% conds:-[[[eq,_135670,[quote,kw_help]],[progn,[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :help to get help.~%")],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :continue <index> to invoke the indexed restart.~%")]]],[[eq,_135670,[quote,kw_back]],[progn,[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[not,sys_frame]],[sys_show_frame,sys_frame,sys_index]]]],[[eq,_135670,[quote,kw_up]],[progn,[if,[plusp,sys_frame_depth],[progn,[decf,sys_frame_depth],[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[=,sys_index,sys_frame_depth],[setq,sys_active_frame,sys_frame]]],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Top of stack.~%")]]]],[[eq,_135670,[quote,kw_down]],[progn,[let,[[sys_frame,[sys_next_function_frame,sys_active_frame]]],[if,sys_frame,[progn,[incf,sys_frame_depth],[setq,sys_active_frame,sys_frame],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Bottom of stack.~%")]]]]],[[eq,_135670,[quote,kw_locals]],[progn,[do,[[sys_env,[sys_fref,[-,sys_active_frame,1]],[cdr,sys_env]]],[[not,sys_env]],[when,[symbolp,[caar,sys_env]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"~A~%"),[caar,sys_env]]]]]],[[eq,_135670,[quote,kw_continue]],[progn,[let,[[sys_index,[read]]],[invoke_restart_interactively,[nth,sys_index,sys_restarts]]]]],[t,[progn,[let,[[values,[multiple_value_list,[eval,sys_form,[sys_fref,[-,sys_active_frame,1]]]]],[count,0]],[if,values,[dolist,[sys_value,values],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";~A: ~S~%"),count,sys_value],[incf,count]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";No values.~%")]]]]]].
1645*/
1646/*
1647:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1648*/
1649/*
1650:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_show_frame,kw_function,f_sys_show_frame)).
1651*/
1652/*
1653:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1654*/
1655/*
1656:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_show_frame,kw_function,f_sys_show_frame)).
1657*/
1658/*
1659:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1660*/
1661/*
1662:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1663*/
1664/*
1665:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1666*/
1667/*
1668:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1669*/
1670/*
1671:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_show_frame,kw_function,f_sys_show_frame)).
1672*/
1673/*
1674:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1675*/
1676/*
1677:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_show_frame,kw_function,f_sys_show_frame)).
1678*/
1679/*
1680:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_fref,kw_function,f_sys_fref)).
1681*/
1682/*
1683:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_fref,kw_function,f_sys_fref)).
1684*/
1685/*
1686% case:-[[kw_help,[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :help to get help.~%")],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :continue <index> to invoke the indexed restart.~%")]],[kw_back,[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[not,sys_frame]],[sys_show_frame,sys_frame,sys_index]]],[kw_up,[if,[plusp,sys_frame_depth],[progn,[decf,sys_frame_depth],[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[=,sys_index,sys_frame_depth],[setq,sys_active_frame,sys_frame]]],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Top of stack.~%")]]],[kw_down,[let,[[sys_frame,[sys_next_function_frame,sys_active_frame]]],[if,sys_frame,[progn,[incf,sys_frame_depth],[setq,sys_active_frame,sys_frame],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Bottom of stack.~%")]]]],[kw_locals,[do,[[sys_env,[sys_fref,[-,sys_active_frame,1]],[cdr,sys_env]]],[[not,sys_env]],[when,[symbolp,[caar,sys_env]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"~A~%"),[caar,sys_env]]]]],[kw_continue,[let,[[sys_index,[read]]],[invoke_restart_interactively,[nth,sys_index,sys_restarts]]]],[t,[let,[[values,[multiple_value_list,[eval,sys_form,[sys_fref,[-,sys_active_frame,1]]]]],[count,0]],[if,values,[dolist,[sys_value,values],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";~A: ~S~%"),count,sys_value],[incf,count]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";No values.~%")]]]]].
1687*/
1688/*
1689% conds:-[[[eq,_107400,[quote,kw_help]],[progn,[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :help to get help.~%")],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :continue <index> to invoke the indexed restart.~%")]]],[[eq,_107400,[quote,kw_back]],[progn,[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[not,sys_frame]],[sys_show_frame,sys_frame,sys_index]]]],[[eq,_107400,[quote,kw_up]],[progn,[if,[plusp,sys_frame_depth],[progn,[decf,sys_frame_depth],[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[=,sys_index,sys_frame_depth],[setq,sys_active_frame,sys_frame]]],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Top of stack.~%")]]]],[[eq,_107400,[quote,kw_down]],[progn,[let,[[sys_frame,[sys_next_function_frame,sys_active_frame]]],[if,sys_frame,[progn,[incf,sys_frame_depth],[setq,sys_active_frame,sys_frame],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Bottom of stack.~%")]]]]],[[eq,_107400,[quote,kw_locals]],[progn,[do,[[sys_env,[sys_fref,[-,sys_active_frame,1]],[cdr,sys_env]]],[[not,sys_env]],[when,[symbolp,[caar,sys_env]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"~A~%"),[caar,sys_env]]]]]],[[eq,_107400,[quote,kw_continue]],[progn,[let,[[sys_index,[read]]],[invoke_restart_interactively,[nth,sys_index,sys_restarts]]]]],[t,[progn,[let,[[values,[multiple_value_list,[eval,sys_form,[sys_fref,[-,sys_active_frame,1]]]]],[count,0]],[if,values,[dolist,[sys_value,values],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";~A: ~S~%"),count,sys_value],[incf,count]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";No values.~%")]]]]]].
1690*/
1691/*
1692:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1693*/
1694/*
1695:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_show_frame,kw_function,f_sys_show_frame)).
1696*/
1697/*
1698:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1699*/
1700/*
1701:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_show_frame,kw_function,f_sys_show_frame)).
1702*/
1703/*
1704:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1705*/
1706/*
1707:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1708*/
1709/*
1710:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1711*/
1712/*
1713:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1714*/
1715/*
1716:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_show_frame,kw_function,f_sys_show_frame)).
1717*/
1718/*
1719:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_next_function_frame,kw_function,f_sys_next_function_frame)).
1720*/
1721/*
1722:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_show_frame,kw_function,f_sys_show_frame)).
1723*/
1724/*
1725:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_fref,kw_function,f_sys_fref)).
1726*/
1727/*
1728:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],sys_fref,kw_function,f_sys_fref)).
1729*/
1730wl:lambda_def(defun,invoke_debugger,f_invoke_debugger,[condition],[[let,[[sys_debugger_hook,xx_debugger_hook_xx],[xx_debugger_hook_xx,[]]],[when,sys_debugger_hook,[funcall,sys_debugger_hook,condition,sys_debugger_hook]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Entering debugger.~%")],[princ,condition,xx_debug_io_xx],[terpri,xx_debug_io_xx],[let,[[sys_restarts,[compute_restarts,condition]],[sys_stack,[sys_makef]],[sys_frame_depth,0],[sys_active_frame,[]]],[let,[[count,0]],[dolist,[restart,sys_restarts],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"~A: "),count],[princ,restart,xx_debug_io_xx],[terpri,xx_debug_io_xx],[incf,count]]],[setq,sys_active_frame,[sys_next_function_frame,[-,sys_stack,20]]],[sys_show_frame,sys_active_frame,0],[tagbody,sys_start,[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";~A> "),sys_frame_depth],[let,[[sys_form,[read]]],[case,sys_form,[kw_help,[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :help to get help.~%")],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :continue <index> to invoke the indexed restart.~%")]],[kw_back,[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[not,sys_frame]],[sys_show_frame,sys_frame,sys_index]]],[kw_up,[if,[plusp,sys_frame_depth],[progn,[decf,sys_frame_depth],[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[=,sys_index,sys_frame_depth],[setq,sys_active_frame,sys_frame]]],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Top of stack.~%")]]],[kw_down,[let,[[sys_frame,[sys_next_function_frame,sys_active_frame]]],[if,sys_frame,[progn,[incf,sys_frame_depth],[setq,sys_active_frame,sys_frame],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Bottom of stack.~%")]]]],[kw_locals,[do,[[sys_env,[sys_fref,[-,sys_active_frame,1]],[cdr,sys_env]]],[[not,sys_env]],[when,[symbolp,[caar,sys_env]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"~A~%"),[caar,sys_env]]]]],[kw_continue,[let,[[sys_index,[read]]],[invoke_restart_interactively,[nth,sys_index,sys_restarts]]]],[t,[let,[[values,[multiple_value_list,[eval,sys_form,[sys_fref,[-,sys_active_frame,1]]]]],[count,0]],[if,values,[dolist,[sys_value,values],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";~A: ~S~%"),count,sys_value],[incf,count]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";No values.~%")]]]]],[go,sys_start]]]]]]).
1731wl:arglist_info(invoke_debugger,f_invoke_debugger,[condition],arginfo{all:[condition],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[condition],opt:0,req:[condition],rest:0,sublists:0,whole:0}).
1732wl:init_args(x,f_invoke_debugger).
1733
1738f_invoke_debugger(_16770,_29940):-_16730=[bv(condition,_16770)],catch(((get_var(_16730,xx_debugger_hook_xx,_16860),_16788=[bv(sys_debugger_hook,_16860)|_16730],save_special(sv(xx_debugger_hook_xx,[],symbol_value,_16872)),get_var(_16788,sys_debugger_hook,_16904),(_16904\==[]->get_var(_16788,condition,_16960),get_var(_16788,sys_debugger_hook,_16948),f_apply(_16948,[_16960,_16948],_16930),_16874=_16930;_16874=[]),get_var(_16788,xx_debug_io_xx,_17018),f_format([_17018,'$ARRAY'([*],claz_base_character,"Entering debugger.~%")],_17016),get_var(_16788,condition,_17052),get_var(_16788,xx_debug_io_xx,_17080),f_princ(_17052,_17080,_17034),get_var(_16788,xx_debug_io_xx,_17110),f_terpri(_17110,_17092),get_var(_16788,condition,_17224),f_compute_restarts(_17224,_17206),f_sys_makef(_17236),_17194=[bv(sys_restarts,_17206),bv(sys_stack,_17236),bv(sys_frame_depth,0),bv(sys_active_frame,[])|_16788],_17334=[bv(count,0)|_17194],get_var(_17334,sys_restarts,_17538),_17484=bv(restart,_17510),_17360=[_17484|_17334],forall(member(_17510,_17538),(nb_setarg(2,_17484,_17510),get_var(_17360,count,_17392),get_var(_17360,xx_debug_io_xx,_17380),f_format([_17380,'$ARRAY'([*],claz_base_character,"~A: "),_17392],_54062),get_var(_17360,restart,_17410),get_var(_17360,xx_debug_io_xx,_17442),f_princ(_17410,_17442,_54088),get_var(_17360,xx_debug_io_xx,_17472),f_terpri(_17472,_54114),place_op(_17360,incf,count,symbol_value,[],_17308))),get_var(_17194,sys_stack,_17568),'f_-'(_17568,20,_17566),f_sys_next_function_frame(_17566,_17550),set_var(_17194,sys_active_frame,_17550),get_var(_17194,sys_active_frame,_17586),f_sys_show_frame(_17586,0,_17584),call_addr_block(_17194,(push_label(sys_start),get_var(_17194,sys_frame_depth,_22696),get_var(_17194,xx_debug_io_xx,_22668),f_format([_22668,'$ARRAY'([*],claz_base_character,";~A> "),_22696],_54152),f_read(_22808),_22780=[bv(sys_form,_22808)|_17194],get_var(_22780,sys_form,_22838),(is_eq(_22838,kw_help)->get_var(_22780,xx_debug_io_xx,_22940),f_format([_22940,'$ARRAY'([*],claz_base_character,"Type :help to get help.~%")],_54178),get_var(_22780,xx_debug_io_xx,_22968),f_format([_22968,'$ARRAY'([*],claz_base_character,"Type :continue <index> to invoke the indexed restart.~%")],_28198),_22820=_28198;(is_eq(_22838,kw_back)->get_var(_22780,sys_stack,_23128),'f_-'(_23128,20,_53794),f_sys_next_function_frame(_53794,_23154),_23096=[bv(sys_frame,_23154),bv(sys_index,0)|_22780],catch((call_addr_block(_23096,(push_label(do_label_31),get_var(_23096,sys_frame,_23618),(_23618==[]->throw(block_exit([],[])),_23182=_23702;get_var(_23096,sys_frame,_23748),get_var(_23096,sys_index,_23776),f_sys_show_frame(_23748,_23776,_54204),get_var(_23096,sys_frame,_23808),f_sys_next_function_frame(_23808,_23790),get_var(_23096,sys_index,_23836),'f_+'(1,_23836,_23788),set_var(_23096,sys_frame,_23790),set_var(_23096,sys_index,_23788),goto(do_label_31,_23096),_23182=_23864)),[addr(addr_tagbody_32_do_label_31,do_label_31,'$unused',_23918,(get_var(_23918,sys_frame,_23932),(_23932==[]->throw(block_exit([],[])),_23946=_23960;get_var(_23918,sys_frame,_23974),get_var(_23918,sys_index,_23988),f_sys_show_frame(_23974,_23988,_54230),get_var(_23918,sys_frame,_24004),f_sys_next_function_frame(_24004,_24016),get_var(_23918,sys_index,_24020),'f_+'(1,_24020,_24032),set_var(_23918,sys_frame,_24016),set_var(_23918,sys_index,_24032),goto(do_label_31,_23918),_23946=_24036)))]),[]=_23070),block_exit([],_23070),true),_28224=_23070;(is_eq(_22838,kw_up)->get_var(_22780,sys_frame_depth,_24138),(mth:is_plusp(_24138)->set_place(_22780,decf,[value,sys_frame_depth],[],_24196),get_var(_22780,sys_stack,_24326),'f_-'(_24326,20,_53820),f_sys_next_function_frame(_53820,_24352),_24294=[bv(sys_frame,_24352),bv(sys_index,0)|_22780],catch((call_addr_block(_24294,(push_label(do_label_32),get_var(_24294,sys_frame_depth,_24870),get_var(_24294,sys_index,_24842),(_24842=:=_24870->get_var(_24294,sys_frame,_24942),set_var(_24294,sys_active_frame,_24942),throw(block_exit([],_24942)),_24380=_24968;get_var(_24294,sys_frame,_25056),f_sys_next_function_frame(_25056,_53692),get_var(_24294,sys_index,_25084),'f_+'(1,_25084,_53718),set_var(_24294,sys_frame,_53692),set_var(_24294,sys_index,_53718),goto(do_label_32,_24294),_24380=_25112)),[addr(addr_tagbody_33_do_label_32,do_label_32,'$unused',_25166,(get_var(_25166,sys_frame_depth,_25180),get_var(_25166,sys_index,_25194),(_25194=:=_25180->get_var(_25166,sys_frame,_25208),set_var(_25166,sys_active_frame,_25208),throw(block_exit([],_25208)),_25222=_25236;get_var(_25166,sys_frame,_25250),f_sys_next_function_frame(_25250,_54280),get_var(_25166,sys_index,_25266),'f_+'(1,_25266,_54306),set_var(_25166,sys_frame,_54280),set_var(_25166,sys_index,_54306),goto(do_label_32,_25166),_25222=_25282)))]),[]=_24268),block_exit([],_24268),true),get_var(_22780,sys_active_frame,_25310),get_var(_22780,sys_frame_depth,_25338),f_sys_show_frame(_25310,_25338,_25394),_28106=_25394;get_var(_22780,xx_debug_io_xx,_25368),f_format([_25368,'$ARRAY'([*],claz_base_character,"Top of stack.~%")],_25420),_28106=_25420),_28172=_28106;(is_eq(_22838,kw_down)->get_var(_22780,sys_active_frame,_25578),f_sys_next_function_frame(_25578,_25604),_25548=[bv(sys_frame,_25604)|_22780],get_var(_25548,sys_frame,_25632),(_25632\==[]->place_op(_25548,incf,sys_frame_depth,symbol_value,[],_25690),get_var(_25548,sys_frame,_25722),set_var(_25548,sys_active_frame,_25722),get_var(_25548,sys_active_frame,_25750),get_var(_25548,sys_frame_depth,_25778),f_sys_show_frame(_25750,_25778,_25834),_25522=_25834;get_var(_25548,xx_debug_io_xx,_25808),f_format([_25808,'$ARRAY'([*],claz_base_character,"Bottom of stack.~%")],_25860),_25522=_25860),_28132=_25522;(is_eq(_22838,kw_locals)->get_var(_22780,sys_active_frame,_26020),'f_-'(_26020,1,_26002),f_sys_fref(_26002,_26046),_25988=[bv(sys_env,_26046)|_22780],catch((call_addr_block(_25988,(push_label(do_label_33),get_var(_25988,sys_env,_26620),(_26620==[]->throw(block_exit([],[])),_26074=_26704;get_var(_25988,sys_env,_26780),f_caar(_26780,_26820),(is_symbolp(_26820)->get_var(_25988,sys_env,_26880),get_var(_25988,xx_debug_io_xx,_26850),f_caar(_26880,_26862),f_format([_26850,'$ARRAY'([*],claz_base_character,"~A~%"),_26862],_26906),_26732=_26906;_26732=[]),get_var(_25988,sys_env,_26948),f_cdr(_26948,_53744),set_var(_25988,sys_env,_53744),goto(do_label_33,_25988),_26074=_26976)),[addr(addr_tagbody_34_do_label_33,do_label_33,'$unused',_27030,(get_var(_27030,sys_env,_27044),(_27044==[]->throw(block_exit([],[])),_27058=_27072;get_var(_27030,sys_env,_27086),f_caar(_27086,_27100),(is_symbolp(_27100)->get_var(_27030,sys_env,_27114),get_var(_27030,xx_debug_io_xx,_27128),f_caar(_27114,_54356),f_format([_27128,'$ARRAY'([*],claz_base_character,"~A~%"),_54356],_27144),_27156=_27144;_27156=[]),get_var(_27030,sys_env,_27160),f_cdr(_27160,_27172),set_var(_27030,sys_env,_27172),goto(do_label_33,_27030),_27058=_27176)))]),[]=_25962),block_exit([],_25962),true),_28080=_25962;(is_eq(_22838,kw_continue)->f_read(_27332),_27304=[bv(sys_index,_27332)|_22780],get_var(_27304,sys_index,_27362),get_var(_27304,sys_restarts,_27390),f_nth(_27362,_27390,_27344),f_invoke_restart_interactively(_27344,_27278),_28040=_27278;get_var(_22780,sys_active_frame,_27590),get_var(_22780,sys_form,_27558),'f_-'(_27590,1,_53870),f_sys_fref(_53870,_27570),f_eval(_27558,_27570,_27530),nb_current('$mv_return',_27502),_27474=[bv(values,_27502),bv(count,0)|_22780],get_var(_27474,values,_27632),(_27632\==[]->get_var(_27474,values,_27706),_27822=bv(sys_value,_27876),_27848=[_27822|_27474],forall(member(_27876,_27706),(nb_setarg(2,_27822,_27876),get_var(_27848,count,_27766),(get_var(_27848,sys_value,_27794),get_var(_27848,xx_debug_io_xx,_27738)),f_format([_27738,'$ARRAY'([*],claz_base_character,";~A: ~S~%"),_27766,_27794],_54406),place_op(_27848,incf,count,symbol_value,[],_27946))),_27448=_27946;get_var(_27474,xx_debug_io_xx,_27920),f_format([_27920,'$ARRAY'([*],claz_base_character,";No values.~%")],_27972),_27448=_27972),_28040=_27448),_28080=_28040),_28132=_28080),_28172=_28132),_28224=_28172),_22820=_28224),goto(sys_start,_22780)),[addr(addr_tagbody_28_sys_start,sys_start,'$unused',_28280,(get_var(_28280,sys_frame_depth,_28282),get_var(_28280,xx_debug_io_xx,_28286),f_format([_28286,'$ARRAY'([*],claz_base_character,";~A> "),_28282],_54444),f_read(_28300),_28304=[bv(sys_form,_28300)|_28280],get_var(_28304,sys_form,_28318),(is_eq(_28318,kw_help)->get_var(_28304,xx_debug_io_xx,_28332),f_format([_28332,'$ARRAY'([*],claz_base_character,"Type :help to get help.~%")],_54482),get_var(_28304,xx_debug_io_xx,_28348),f_format([_28348,'$ARRAY'([*],claz_base_character,"Type :continue <index> to invoke the indexed restart.~%")],_28362),_28374=_28362;(is_eq(_28318,kw_back)->get_var(_28304,sys_stack,_28378),'f_-'(_28378,20,_53896),f_sys_next_function_frame(_53896,_54508),_28396=[bv(sys_frame,_54508),bv(sys_index,0)|_28304],catch((call_addr_block(_28396,(push_label(do_label_28),get_var(_28396,sys_frame,_28410),(_28410==[]->throw(block_exit([],[])),_28424=_28438;get_var(_28396,sys_frame,_28452),get_var(_28396,sys_index,_28466),f_sys_show_frame(_28452,_28466,_54534),get_var(_28396,sys_frame,_28482),f_sys_next_function_frame(_28482,_54560),get_var(_28396,sys_index,_28498),'f_+'(1,_28498,_54586),set_var(_28396,sys_frame,_54560),set_var(_28396,sys_index,_54586),goto(do_label_28,_28396),_28424=_28514)),[addr(addr_tagbody_29_do_label_28,do_label_28,'$unused',_28528,(get_var(_28528,sys_frame,_28542),(_28542==[]->throw(block_exit([],[])),_28556=_28570;get_var(_28528,sys_frame,_28584),get_var(_28528,sys_index,_54612),f_sys_show_frame(_28584,_54612,_54638),get_var(_28528,sys_frame,_28602),f_sys_next_function_frame(_28602,_54664),get_var(_28528,sys_index,_28618),'f_+'(1,_28618,_54690),set_var(_28528,sys_frame,_54664),set_var(_28528,sys_index,_54690),goto(do_label_28,_28528),_28556=_28634)))]),[]=_28648),block_exit([],_28648),true),_28662=_28648;(is_eq(_28318,kw_up)->get_var(_28304,sys_frame_depth,_28676),(mth:is_plusp(_28676)->set_place(_28304,decf,[value,sys_frame_depth],[],_28688),get_var(_28304,sys_stack,_28692),'f_-'(_28692,20,_53922),f_sys_next_function_frame(_53922,_28708),_28722=[bv(sys_frame,_28708),bv(sys_index,0)|_28304],catch((call_addr_block(_28722,(push_label(do_label_29),get_var(_28722,sys_frame_depth,_28736),get_var(_28722,sys_index,_28750),(_28750=:=_28736->get_var(_28722,sys_frame,_28764),set_var(_28722,sys_active_frame,_28764),throw(block_exit([],_28764)),_28778=_28792;get_var(_28722,sys_frame,_28806),f_sys_next_function_frame(_28806,_54728),get_var(_28722,sys_index,_28822),'f_+'(1,_28822,_54754),set_var(_28722,sys_frame,_54728),set_var(_28722,sys_index,_54754),goto(do_label_29,_28722),_28778=_28838)),[addr(addr_tagbody_30_do_label_29,do_label_29,'$unused',_28852,(get_var(_28852,sys_frame_depth,_28866),get_var(_28852,sys_index,_28880),(_28880=:=_28866->get_var(_28852,sys_frame,_28894),set_var(_28852,sys_active_frame,_28894),throw(block_exit([],_28894)),_28908=_28922;get_var(_28852,sys_frame,_28936),f_sys_next_function_frame(_28936,_54780),get_var(_28852,sys_index,_28952),'f_+'(1,_28952,_54806),set_var(_28852,sys_frame,_54780),set_var(_28852,sys_index,_54806),goto(do_label_29,_28852),_28908=_28968)))]),[]=_28982),block_exit([],_28982),true),get_var(_28304,sys_active_frame,_28996),get_var(_28304,sys_frame_depth,_29010),f_sys_show_frame(_28996,_29010,_29024),_29038=_29024;get_var(_28304,xx_debug_io_xx,_29052),f_format([_29052,'$ARRAY'([*],claz_base_character,"Top of stack.~%")],_29066),_29038=_29066),_29080=_29038;(is_eq(_28318,kw_down)->get_var(_28304,sys_active_frame,_29094),f_sys_next_function_frame(_29094,_29108),_29122=[bv(sys_frame,_29108)|_28304],get_var(_29122,sys_frame,_29136),(_29136\==[]->place_op(_29122,incf,sys_frame_depth,symbol_value,[],_54832),get_var(_29122,sys_frame,_29152),set_var(_29122,sys_active_frame,_29152),get_var(_29122,sys_active_frame,_29166),get_var(_29122,sys_frame_depth,_29180),f_sys_show_frame(_29166,_29180,_29194),_29208=_29194;get_var(_29122,xx_debug_io_xx,_29222),f_format([_29222,'$ARRAY'([*],claz_base_character,"Bottom of stack.~%")],_29236),_29208=_29236),_29250=_29208;(is_eq(_28318,kw_locals)->get_var(_28304,sys_active_frame,_29264),'f_-'(_29264,1,_53948),f_sys_fref(_53948,_54858),_29282=[bv(sys_env,_54858)|_28304],catch((call_addr_block(_29282,(push_label(do_label_30),get_var(_29282,sys_env,_29296),(_29296==[]->throw(block_exit([],[])),_29310=_29324;get_var(_29282,sys_env,_29338),f_caar(_29338,_29352),(is_symbolp(_29352)->get_var(_29282,sys_env,_29366),get_var(_29282,xx_debug_io_xx,_29380),f_caar(_29366,_54884),f_format([_29380,'$ARRAY'([*],claz_base_character,"~A~%"),_54884],_29396),_29408=_29396;_29408=[]),get_var(_29282,sys_env,_29412),f_cdr(_29412,_54910),set_var(_29282,sys_env,_54910),goto(do_label_30,_29282),_29310=_29428)),[addr(addr_tagbody_31_do_label_30,do_label_30,'$unused',_29442,(get_var(_29442,sys_env,_29456),(_29456==[]->throw(block_exit([],[])),_29470=_29484;get_var(_29442,sys_env,_29498),f_caar(_29498,_29512),(is_symbolp(_29512)->get_var(_29442,sys_env,_29526),get_var(_29442,xx_debug_io_xx,_29540),f_caar(_29526,_54936),f_format([_29540,'$ARRAY'([*],claz_base_character,"~A~%"),_54936],_29556),_29568=_29556;_29568=[]),get_var(_29442,sys_env,_29572),f_cdr(_29572,_54962),set_var(_29442,sys_env,_54962),goto(do_label_30,_29442),_29470=_29588)))]),[]=_29602),block_exit([],_29602),true),_29616=_29602;(is_eq(_28318,kw_continue)->f_read(_54988),_29632=[bv(sys_index,_54988)|_28304],get_var(_29632,sys_index,_29646),get_var(_29632,sys_restarts,_29660),f_nth(_29646,_29660,_53974),f_invoke_restart_interactively(_53974,_29676),_29690=_29676;get_var(_28304,sys_active_frame,_29704),get_var(_28304,sys_form,_29718),'f_-'(_29704,1,_54000),f_sys_fref(_54000,_55014),f_eval(_29718,_55014,_29734),nb_current('$mv_return',_29738),_29752=[bv(values,_29738),bv(count,0)|_28304],get_var(_29752,values,_29766),(_29766\==[]->get_var(_29752,values,_29780),_29794=bv(sys_value,_29808),_29822=[_29794|_29752],forall(member(_29808,_29780),(nb_setarg(2,_29794,_29808),get_var(_29822,count,_29836),(get_var(_29822,sys_value,_55052),get_var(_29822,xx_debug_io_xx,_29852)),f_format([_29852,'$ARRAY'([*],claz_base_character,";~A: ~S~%"),_29836,_55052],_55078),place_op(_29822,incf,count,symbol_value,[],_29868))),_29882=_29868;get_var(_29752,xx_debug_io_xx,_29896),f_format([_29896,'$ARRAY'([*],claz_base_character,";No values.~%")],_29910),_29882=_29910),_29690=_29882),_29616=_29690),_29250=_29616),_29080=_29250),_28662=_29080),_28374=_28662),goto(sys_start,_28304)))]),restore_special(sv(xx_debugger_hook_xx,[],symbol_value,_16872))),[]=_29940),block_exit(invoke_debugger,_29940),true).
1739:-set_opv(invoke_debugger,symbol_function,f_invoke_debugger),_10982=invoke_debugger. 1740/*
1741:-side_effect(assert_lsp(invoke_debugger,lambda_def(defun,invoke_debugger,f_invoke_debugger,[condition],[[let,[[sys_debugger_hook,xx_debugger_hook_xx],[xx_debugger_hook_xx,[]]],[when,sys_debugger_hook,[funcall,sys_debugger_hook,condition,sys_debugger_hook]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Entering debugger.~%")],[princ,condition,xx_debug_io_xx],[terpri,xx_debug_io_xx],[let,[[sys_restarts,[compute_restarts,condition]],[sys_stack,[sys_makef]],[sys_frame_depth,0],[sys_active_frame,[]]],[let,[[count,0]],[dolist,[restart,sys_restarts],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"~A: "),count],[princ,restart,xx_debug_io_xx],[terpri,xx_debug_io_xx],[incf,count]]],[setq,sys_active_frame,[sys_next_function_frame,[-,sys_stack,20]]],[sys_show_frame,sys_active_frame,0],[tagbody,sys_start,[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";~A> "),sys_frame_depth],[let,[[sys_form,[read]]],[case,sys_form,[kw_help,[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :help to get help.~%")],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Type :continue <index> to invoke the indexed restart.~%")]],[kw_back,[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[not,sys_frame]],[sys_show_frame,sys_frame,sys_index]]],[kw_up,[if,[plusp,sys_frame_depth],[progn,[decf,sys_frame_depth],[do,[[sys_frame,[sys_next_function_frame,[-,sys_stack,20]],[sys_next_function_frame,sys_frame]],[sys_index,0,[+,1,sys_index]]],[[=,sys_index,sys_frame_depth],[setq,sys_active_frame,sys_frame]]],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Top of stack.~%")]]],[kw_down,[let,[[sys_frame,[sys_next_function_frame,sys_active_frame]]],[if,sys_frame,[progn,[incf,sys_frame_depth],[setq,sys_active_frame,sys_frame],[sys_show_frame,sys_active_frame,sys_frame_depth]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"Bottom of stack.~%")]]]],[kw_locals,[do,[[sys_env,[sys_fref,[-,sys_active_frame,1]],[cdr,sys_env]]],[[not,sys_env]],[when,[symbolp,[caar,sys_env]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,"~A~%"),[caar,sys_env]]]]],[kw_continue,[let,[[sys_index,[read]]],[invoke_restart_interactively,[nth,sys_index,sys_restarts]]]],[t,[let,[[values,[multiple_value_list,[eval,sys_form,[sys_fref,[-,sys_active_frame,1]]]]],[count,0]],[if,values,[dolist,[sys_value,values],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";~A: ~S~%"),count,sys_value],[incf,count]],[format,xx_debug_io_xx,'$ARRAY'([*],claz_base_character,";No values.~%")]]]]],[go,sys_start]]]]]]))).
1742*/
1743/*
1744:-side_effect(assert_lsp(invoke_debugger,arglist_info(invoke_debugger,f_invoke_debugger,[condition],arginfo{all:[condition],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[condition],opt:0,req:[condition],rest:0,sublists:0,whole:0}))).
1745*/
1746/*
1747:-side_effect(assert_lsp(invoke_debugger,init_args(x,f_invoke_debugger))).
1748*/
1749/*
1750#+(or WAM-CL LISP500)
1751(defparameter *debugger-hook* nil)
1752
1753*/
1754
1755/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:8548 **********************/
1756:-lisp_compile_to_prolog(pkg_sys,[defparameter,'*debugger-hook*',[]])
1757:- set_var(AEnv, xx_debugger_hook_xx, []).
1758/*
1759#+(or WAM-CL LISP500)
1760(defparameter *break-on-signals* nil)
1761
1762*/
1763
1764/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:8610 **********************/
1765:-lisp_compile_to_prolog(pkg_sys,[defparameter,'*break-on-signals*',[]])
1766:- set_var(AEnv, xx_break_on_signals_xx, []).
1767/*
1768#+(or WAM-CL LISP500)
1769(defparameter *handlers* nil)
1770
1771*/
1772
1773/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:8675 **********************/
1774:-lisp_compile_to_prolog(pkg_sys,[defparameter,'*handlers*',[]])
1775:- set_var(AEnv, sys_xx_handlers_xx, []).
1776/*
1777#+(or WAM-CL LISP500)
1778(defun invoke-handler (condition)
1779 (dolist (handler *handlers*)
1780 (when (typep condition (car handler))
1781 (setq *handlers* (caddr handler))
1782 (funcall (cadr handler) condition))))
1783
1784
1785*/
1786
1787/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:8732 **********************/
1788:-lisp_compile_to_prolog(pkg_sys,[defun,'invoke-handler',[condition],[dolist,[handler,'*handlers*'],[when,[typep,condition,[car,handler]],[setq,'*handlers*',[caddr,handler]],[funcall,[cadr,handler],condition]]]])
1789/*
1790:- side_effect(generate_function_or_macro_name(
1791 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1792 name='GLOBAL',
1793 environ=env_1
1794 ],
1795 sys_invoke_handler,
1796 kw_function,
1797 f_sys_invoke_handler)).
1798*/
1799wl:lambda_def(defun, sys_invoke_handler, f_sys_invoke_handler, [condition], [[dolist, [sys_handler, sys_xx_handlers_xx], [when, [typep, condition, [car, sys_handler]], [setq, sys_xx_handlers_xx, [caddr, sys_handler]], [funcall, [cadr, sys_handler], condition]]]]).
1800wl:arglist_info(sys_invoke_handler, f_sys_invoke_handler, [condition], arginfo{all:[condition], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[condition], opt:0, req:[condition], rest:0, sublists:0, whole:0}).
1801wl: init_args(x, f_sys_invoke_handler).
1802
1807f_sys_invoke_handler(Condition_In, FnResult) :-
1808 GEnv=[bv(condition, Condition_In)],
1809 catch(( ( get_var(GEnv, sys_xx_handlers_xx, Xx_handlers_xx_Get),
1810 BV=bv(sys_handler, Ele),
1811 AEnv=[BV|GEnv],
1812 forall(member(Ele, Xx_handlers_xx_Get),
1813 ( nb_setarg(2, BV, Ele),
1814 get_var(AEnv, condition, Condition_Get),
1815 get_var(AEnv, sys_handler, Handler_Get),
1816 f_car(Handler_Get, Car_Ret),
1817 f_typep(Condition_Get, Car_Ret, IFTEST),
1818 ( IFTEST\==[]
1819 -> get_var(AEnv, sys_handler, Handler_Get11),
1820 f_caddr(Handler_Get11, Xx_handlers_xx),
1821 set_var(AEnv, sys_xx_handlers_xx, Xx_handlers_xx),
1822 get_var(AEnv, sys_handler, Handler_Get12),
1823 f_cadr(Handler_Get12, Apply_Param),
1824 get_var(AEnv, condition, Condition_Get13),
1825 f_apply(Apply_Param,
1826 [Condition_Get13],
1827 TrueResult),
1828 _7198=TrueResult
1829 ; _7198=[]
1830 )
1831 ))
1832 ),
1833 _7198=FnResult
1834 ),
1835 block_exit(sys_invoke_handler, FnResult),
1836 true).
1837:- set_opv(sys_invoke_handler, symbol_function, f_sys_invoke_handler),
1838 DefunResult=sys_invoke_handler. 1839/*
1840:- side_effect(assert_lsp(sys_invoke_handler,
1841 lambda_def(defun,
1842 sys_invoke_handler,
1843 f_sys_invoke_handler,
1844 [condition],
1845
1846 [
1847 [ dolist,
1848 [sys_handler, sys_xx_handlers_xx],
1849
1850 [ when,
1851 [typep, condition, [car, sys_handler]],
1852
1853 [ setq,
1854 sys_xx_handlers_xx,
1855 [caddr, sys_handler]
1856 ],
1857
1858 [ funcall,
1859 [cadr, sys_handler],
1860 condition
1861 ]
1862 ]
1863 ]
1864 ]))).
1865*/
1866/*
1867:- side_effect(assert_lsp(sys_invoke_handler,
1868 arglist_info(sys_invoke_handler,
1869 f_sys_invoke_handler,
1870 [condition],
1871 arginfo{ all:[condition],
1872 allow_other_keys:0,
1873 aux:0,
1874 body:0,
1875 complex:0,
1876 env:0,
1877 key:0,
1878 names:[condition],
1879 opt:0,
1880 req:[condition],
1881 rest:0,
1882 sublists:0,
1883 whole:0
1884 }))).
1885*/
1886/*
1887:- side_effect(assert_lsp(sys_invoke_handler,
1888 init_args(x, f_sys_invoke_handler))).
1889*/
1890/*
1891#+(or WAM-CL LISP500)
1892(defmacro handler-bind (bindings &rest forms)
1893 (let ((form '*handlers*)
1894 (handlers (gensym)))
1895 (dolist (binding (reverse bindings))
1896 (setq form
1897 `(cons (list ',(car binding) ,(cadr binding) ',handlers) ,form)))
1898 `(let ((handlers *handlers*)
1899 (*handlers* ,form))
1900 ,@forms)))
1901
1902*/
1903
1904/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:8956 **********************/
1905:-lisp_compile_to_prolog(pkg_sys,[defmacro,'handler-bind',[bindings,'&rest',forms],[let,[[form,[quote,'*handlers*']],[handlers,[gensym]]],[dolist,[binding,[reverse,bindings]],[setq,form,['#BQ',[cons,[list,[quote,['#COMMA',[car,binding]]],['#COMMA',[cadr,binding]],[quote,['#COMMA',handlers]]],['#COMMA',form]]]]],['#BQ',[let,[[handlers,'*handlers*'],['*handlers*',['#COMMA',form]]],['#BQ-COMMA-ELIPSE',forms]]]]])
1906/*
1907:- side_effect(generate_function_or_macro_name(
1908 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1909 name='GLOBAL',
1910 environ=env_1
1911 ],
1912 handler_bind,
1913 kw_special,
1914 sf_handler_bind)).
1915*/
1916wl:lambda_def(defmacro, handler_bind, mf_handler_bind, [sys_bindings, c38_rest, sys_forms], [[let, [[sys_form, [quote, sys_xx_handlers_xx]], [sys_handlers, [gensym]]], [dolist, [sys_binding, [reverse, sys_bindings]], [setq, sys_form, ['#BQ', [cons, [list, [quote, ['#COMMA', [car, sys_binding]]], ['#COMMA', [cadr, sys_binding]], [quote, ['#COMMA', sys_handlers]]], ['#COMMA', sys_form]]]]], ['#BQ', [let, [[sys_handlers, sys_xx_handlers_xx], [sys_xx_handlers_xx, ['#COMMA', sys_form]]], ['#BQ-COMMA-ELIPSE', sys_forms]]]]]).
1917wl:arglist_info(handler_bind, mf_handler_bind, [sys_bindings, c38_rest, sys_forms], arginfo{all:[sys_bindings], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_bindings, sys_forms], opt:0, req:[sys_bindings], rest:[sys_forms], sublists:0, whole:0}).
1918wl: init_args(1, mf_handler_bind).
1919
1924sf_handler_bind(MacroEnv, Bindings_In, RestNKeys, FResult) :-
1925 mf_handler_bind([handler_bind, Bindings_In|RestNKeys],
1926 MacroEnv,
1927 MFResult),
1928 f_sys_env_eval(MacroEnv, MFResult, FResult).
1933mf_handler_bind([handler_bind, Bindings_In|RestNKeys], MacroEnv, MFResult) :-
1934 nop(defmacro),
1935 CDR=[bv(sys_bindings, Bindings_In), bv(sys_forms, RestNKeys)],
1936 catch(( ( f_gensym(Handlers_Init),
1937 LEnv=[bv(sys_form, sys_xx_handlers_xx), bv(sys_handlers, Handlers_Init)|CDR],
1938 get_var(LEnv, sys_bindings, Bindings_Get),
1939 f_reverse(Bindings_Get, List),
1940 BV=bv(sys_binding, Ele),
1941 AEnv=[BV|LEnv],
1942 forall(member(Ele, List),
1943 ( nb_setarg(2, BV, Ele),
1944 get_var(AEnv, sys_binding, Binding_Get),
1945 f_car(Binding_Get, Car_Ret),
1946 get_var(AEnv, sys_binding, Binding_Get13),
1947 f_cadr(Binding_Get13, Cadr_Ret),
1948 get_var(AEnv, sys_form, Form_Get),
1949 get_var(AEnv, sys_handlers, Handlers_Get),
1950 set_var(AEnv,
1951 sys_form,
1952
1953 [ cons,
1954
1955 [ list,
1956 [quote, Car_Ret],
1957 Cadr_Ret,
1958 [quote, Handlers_Get]
1959 ],
1960 Form_Get
1961 ])
1962 )),
1963 get_var(LEnv, sys_form, Form_Get20),
1964 get_var(LEnv, sys_forms, Forms_Get)
1965 ),
1966 [let, [[sys_handlers, sys_xx_handlers_xx], [sys_xx_handlers_xx, Form_Get20]]|Forms_Get]=MFResult
1967 ),
1968 block_exit(handler_bind, MFResult),
1969 true).
1970:- set_opv(mf_handler_bind, type_of, sys_macro),
1971 set_opv(handler_bind, symbol_function, mf_handler_bind),
1972 DefMacroResult=handler_bind. 1973/*
1974:- side_effect(assert_lsp(handler_bind,
1975 lambda_def(defmacro,
1976 handler_bind,
1977 mf_handler_bind,
1978 [sys_bindings, c38_rest, sys_forms],
1979
1980 [
1981 [ let,
1982
1983 [
1984 [ sys_form,
1985 [quote, sys_xx_handlers_xx]
1986 ],
1987 [sys_handlers, [gensym]]
1988 ],
1989
1990 [ dolist,
1991
1992 [ sys_binding,
1993 [reverse, sys_bindings]
1994 ],
1995
1996 [ setq,
1997 sys_form,
1998
1999 [ '#BQ',
2000
2001 [ cons,
2002
2003 [ list,
2004
2005 [ quote,
2006
2007 [ '#COMMA',
2008 [car, sys_binding]
2009 ]
2010 ],
2011
2012 [ '#COMMA',
2013 [cadr, sys_binding]
2014 ],
2015
2016 [ quote,
2017 ['#COMMA', sys_handlers]
2018 ]
2019 ],
2020 ['#COMMA', sys_form]
2021 ]
2022 ]
2023 ]
2024 ],
2025
2026 [ '#BQ',
2027
2028 [ let,
2029
2030 [
2031 [ sys_handlers,
2032 sys_xx_handlers_xx
2033 ],
2034
2035 [ sys_xx_handlers_xx,
2036 ['#COMMA', sys_form]
2037 ]
2038 ],
2039 ['#BQ-COMMA-ELIPSE', sys_forms]
2040 ]
2041 ]
2042 ]
2043 ]))).
2044*/
2045/*
2046:- side_effect(assert_lsp(handler_bind,
2047 arglist_info(handler_bind,
2048 mf_handler_bind,
2049 [sys_bindings, c38_rest, sys_forms],
2050 arginfo{ all:[sys_bindings],
2051 allow_other_keys:0,
2052 aux:0,
2053 body:0,
2054 complex:[rest],
2055 env:0,
2056 key:0,
2057 names:[sys_bindings, sys_forms],
2058 opt:0,
2059 req:[sys_bindings],
2060 rest:[sys_forms],
2061 sublists:0,
2062 whole:0
2063 }))).
2064*/
2065/*
2066:- side_effect(assert_lsp(handler_bind, init_args(1, mf_handler_bind))).
2067*/
2068/*
2069#+(or WAM-CL LISP500)
2070(defmacro handler-case (expression &rest clauses)
2071 (let ((tag (gensym))
2072 (bindings nil))
2073 `(handler-bind
2074 ,(dolist (clause clauses (reverse bindings))
2075 (let ((typespec (car clause))
2076 (var-list (cadr clause))
2077 (forms (cddr clauses)))
2078 (push `(typespec #'(lambda (,(if var-list (car var-list) (gensym)))
2079 (return-from tag (progn ,@forms))))
2080 bindings)))
2081 ,expression)))
2082
2083*/
2084
2085/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:9289 **********************/
2086:-lisp_compile_to_prolog(pkg_sys,[defmacro,'handler-case',[expression,'&rest',clauses],[let,[[tag,[gensym]],[bindings,[]]],['#BQ',['handler-bind',['#COMMA',[dolist,[clause,clauses,[reverse,bindings]],[let,[[typespec,[car,clause]],['var-list',[cadr,clause]],[forms,[cddr,clauses]]],[push,['#BQ',[typespec,function([lambda,[['#COMMA',[if,'var-list',[car,'var-list'],[gensym]]]],['return-from',tag,[progn,['#BQ-COMMA-ELIPSE',forms]]]])]],bindings]]]],['#COMMA',expression]]]]])
2087/*
2088% macroexpand:-[push,['#BQ',[sys_typespec,function([lambda,[['#COMMA',[if,sys_var_list,[car,sys_var_list],[gensym]]]],[return_from,sys_tag,[progn,['#BQ-COMMA-ELIPSE',sys_forms]]]])]],sys_bindings].
2089*/
2090/*
2091% into:-[setq,sys_bindings,[cons,['#BQ',[sys_typespec,function([lambda,[['#COMMA',[if,sys_var_list,[car,sys_var_list],[gensym]]]],[return_from,sys_tag,[progn,['#BQ-COMMA-ELIPSE',sys_forms]]]])]],sys_bindings]].
2092*/
2093/*
2094:- side_effect(generate_function_or_macro_name(
2095 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
2096 name='GLOBAL',
2097 environ=env_1
2098 ],
2099 handler_case,
2100 kw_special,
2101 sf_handler_case)).
2102*/
2103wl:lambda_def(defmacro, handler_case, mf_handler_case, [sys_expression, c38_rest, sys_clauses], [[let, [[sys_tag, [gensym]], [sys_bindings, []]], ['#BQ', [handler_bind, ['#COMMA', [dolist, [sys_clause, sys_clauses, [reverse, sys_bindings]], [let, [[sys_typespec, [car, sys_clause]], [sys_var_list, [cadr, sys_clause]], [sys_forms, [cddr, sys_clauses]]], [push, ['#BQ', [sys_typespec, function([lambda, [['#COMMA', [if, sys_var_list, [car, sys_var_list], [gensym]]]], [return_from, sys_tag, [progn, ['#BQ-COMMA-ELIPSE', sys_forms]]]])]], sys_bindings]]]], ['#COMMA', sys_expression]]]]]).
2104wl:arglist_info(handler_case, mf_handler_case, [sys_expression, c38_rest, sys_clauses], arginfo{all:[sys_expression], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_expression, sys_clauses], opt:0, req:[sys_expression], rest:[sys_clauses], sublists:0, whole:0}).
2105wl: init_args(1, mf_handler_case).
2106
2111sf_handler_case(MacroEnv, Expression_In, RestNKeys, FResult) :-
2112 mf_handler_case([handler_case, Expression_In|RestNKeys],
2113 MacroEnv,
2114 MFResult),
2115 f_sys_env_eval(MacroEnv, MFResult, FResult).
2120mf_handler_case([handler_case, Expression_In|RestNKeys], MacroEnv, MFResult) :-
2121 nop(defmacro),
2122 CDR=[bv(sys_expression, Expression_In), bv(sys_clauses, RestNKeys)],
2123 catch(( ( f_gensym(Tag_Init),
2124 LEnv=[bv(sys_tag, Tag_Init), bv(sys_bindings, [])|CDR],
2125 get_var(LEnv, sys_bindings, Bindings_Get),
2126 LEnv12=[bv(reverse, Bindings_Get)|LEnv],
2127 get_var(LEnv12, sys_clauses, Clauses_Get),
2128 BV=bv(sys_clause, Ele),
2129 Env2=[BV|LEnv12],
2130 forall(member(Ele, Clauses_Get),
2131 ( nb_setarg(2, BV, Ele),
2132 get_var(Env2, sys_clause, Clause_Get),
2133 f_car(Clause_Get, Typespec_Init),
2134 get_var(Env2, sys_clause, Clause_Get20),
2135 f_cadr(Clause_Get20, Var_list_Init),
2136 get_var(Env2, sys_clauses, Clauses_Get21),
2137 f_cddr(Clauses_Get21, Forms_Init),
2138 LEnv18=[bv(sys_typespec, Typespec_Init), bv(sys_var_list, Var_list_Init), bv(sys_forms, Forms_Init)|Env2],
2139 get_var(LEnv18, sys_bindings, Bindings_Get26),
2140 LetResult17=[[sys_typespec, function([lambda, [['#COMMA', [if, sys_var_list, [car, sys_var_list], [gensym]]]], [return_from, sys_tag, [progn, ['#BQ-COMMA-ELIPSE', sys_forms]]]])]|Bindings_Get26],
2141 set_var(LEnv18, sys_bindings, LetResult17)
2142 )),
2143 get_var(LEnv12, sys_bindings, Bindings_Get31),
2144 f_reverse(Bindings_Get31, LetResult11),
2145 get_var(LEnv, sys_expression, Expression_Get)
2146 ),
2147 [handler_bind, LetResult11, Expression_Get]=MFResult
2148 ),
2149 block_exit(handler_case, MFResult),
2150 true).
2151:- set_opv(mf_handler_case, type_of, sys_macro),
2152 set_opv(handler_case, symbol_function, mf_handler_case),
2153 DefMacroResult=handler_case. 2154/*
2155:- side_effect(assert_lsp(handler_case,
2156 lambda_def(defmacro,
2157 handler_case,
2158 mf_handler_case,
2159 [sys_expression, c38_rest, sys_clauses],
2160
2161 [
2162 [ let,
2163
2164 [ [sys_tag, [gensym]],
2165 [sys_bindings, []]
2166 ],
2167
2168 [ '#BQ',
2169
2170 [ handler_bind,
2171
2172 [ '#COMMA',
2173
2174 [ dolist,
2175
2176 [ sys_clause,
2177 sys_clauses,
2178 [reverse, sys_bindings]
2179 ],
2180
2181 [ let,
2182
2183 [
2184 [ sys_typespec,
2185 [car, sys_clause]
2186 ],
2187
2188 [ sys_var_list,
2189 [cadr, sys_clause]
2190 ],
2191
2192 [ sys_forms,
2193 [cddr, sys_clauses]
2194 ]
2195 ],
2196
2197 [ push,
2198
2199 [ '#BQ',
2200
2201 [ sys_typespec,
2202 function(
2203 [ lambda,
2204
2205 [
2206 [ '#COMMA',
2207
2208 [ if,
2209 sys_var_list,
2210 [car, sys_var_list],
2211 [gensym]
2212 ]
2213 ]
2214 ],
2215
2216 [ return_from,
2217 sys_tag,
2218
2219 [ progn,
2220
2221 [ '#BQ-COMMA-ELIPSE',
2222 sys_forms
2223 ]
2224 ]
2225 ]
2226 ])
2227 ]
2228 ],
2229 sys_bindings
2230 ]
2231 ]
2232 ]
2233 ],
2234 ['#COMMA', sys_expression]
2235 ]
2236 ]
2237 ]
2238 ]))).
2239*/
2240/*
2241:- side_effect(assert_lsp(handler_case,
2242 arglist_info(handler_case,
2243 mf_handler_case,
2244 [sys_expression, c38_rest, sys_clauses],
2245 arginfo{ all:[sys_expression],
2246 allow_other_keys:0,
2247 aux:0,
2248 body:0,
2249 complex:[rest],
2250 env:0,
2251 key:0,
2252 names:
2253 [ sys_expression,
2254 sys_clauses
2255 ],
2256 opt:0,
2257 req:[sys_expression],
2258 rest:[sys_clauses],
2259 sublists:0,
2260 whole:0
2261 }))).
2262*/
2263/*
2264:- side_effect(assert_lsp(handler_case, init_args(1, mf_handler_case))).
2265*/
2266/*
2267#+(or WAM-CL LISP500)
2268(defmacro ignore-errors (&rest forms)
2269 `(handler-case (progn ,@forms)
2270 (error (condition) (values nil condition))))
2271
2272*/
2273
2274/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:9732 **********************/
2275:-lisp_compile_to_prolog(pkg_sys,[defmacro,'ignore-errors',['&rest',forms],['#BQ',['handler-case',[progn,['#BQ-COMMA-ELIPSE',forms]],[error,[condition],[values,[],condition]]]]])
2276/*
2277:- side_effect(generate_function_or_macro_name(
2278 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
2279 name='GLOBAL',
2280 environ=env_1
2281 ],
2282 ignore_errors,
2283 kw_special,
2284 sf_ignore_errors)).
2285*/
2286wl:lambda_def(defmacro, ignore_errors, mf_ignore_errors, [c38_rest, sys_forms], [['#BQ', [handler_case, [progn, ['#BQ-COMMA-ELIPSE', sys_forms]], [error, [condition], [values, [], condition]]]]]).
2287wl:arglist_info(ignore_errors, mf_ignore_errors, [c38_rest, sys_forms], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_forms], opt:0, req:0, rest:[sys_forms], sublists:0, whole:0}).
2288wl: init_args(0, mf_ignore_errors).
2289
2294sf_ignore_errors(MacroEnv, RestNKeys, FResult) :-
2295 mf_ignore_errors([ignore_errors|RestNKeys], MacroEnv, MFResult),
2296 f_sys_env_eval(MacroEnv, MFResult, FResult).
2301mf_ignore_errors([ignore_errors|RestNKeys], MacroEnv, MFResult) :-
2302 nop(defmacro),
2303 GEnv=[bv(sys_forms, RestNKeys)],
2304 catch(( get_var(GEnv, sys_forms, Forms_Get),
2305 [handler_case, [progn|Forms_Get], [error, [condition], [values, [], condition]]]=MFResult
2306 ),
2307 block_exit(ignore_errors, MFResult),
2308 true).
2309:- set_opv(mf_ignore_errors, type_of, sys_macro),
2310 set_opv(ignore_errors, symbol_function, mf_ignore_errors),
2311 DefMacroResult=ignore_errors. 2312/*
2313:- side_effect(assert_lsp(ignore_errors,
2314 lambda_def(defmacro,
2315 ignore_errors,
2316 mf_ignore_errors,
2317 [c38_rest, sys_forms],
2318
2319 [
2320 [ '#BQ',
2321
2322 [ handler_case,
2323
2324 [ progn,
2325 ['#BQ-COMMA-ELIPSE', sys_forms]
2326 ],
2327
2328 [ error,
2329 [condition],
2330 [values, [], condition]
2331 ]
2332 ]
2333 ]
2334 ]))).
2335*/
2336/*
2337:- side_effect(assert_lsp(ignore_errors,
2338 arglist_info(ignore_errors,
2339 mf_ignore_errors,
2340 [c38_rest, sys_forms],
2341 arginfo{ all:0,
2342 allow_other_keys:0,
2343 aux:0,
2344 body:0,
2345 complex:[rest],
2346 env:0,
2347 key:0,
2348 names:[sys_forms],
2349 opt:0,
2350 req:0,
2351 rest:[sys_forms],
2352 sublists:0,
2353 whole:0
2354 }))).
2355*/
2356/*
2357:- side_effect(assert_lsp(ignore_errors, init_args(0, mf_ignore_errors))).
2358*/
2359/*
2360#+(or WAM-CL LISP500)
2361(defparameter *restarts* nil)
2362
2363*/
2364
2365/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:9881 **********************/
2366:-lisp_compile_to_prolog(pkg_sys,[defparameter,'*restarts*',[]])
2367:- set_var(AEnv, sys_xx_restarts_xx, []).
2368/*
2369#+(or WAM-CL LISP500)
2370(defun compute-restarts (&optional condition)
2371 "FIXME restarts associated with conditions"
2372 (if condition
2373 *restarts*
2374 *restarts*))
2375
2376*/
2377
2378/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:9938 **********************/
2379:-lisp_compile_to_prolog(pkg_sys,[defun,'compute-restarts',['&optional',condition],'$STRING'("FIXME restarts associated with conditions"),[if,condition,'*restarts*','*restarts*']])
2380doc: doc_string(compute_restarts,
2381 _8326,
2382 function,
2383 "FIXME restarts associated with conditions").
2384
2385wl:lambda_def(defun, compute_restarts, f_compute_restarts, [c38_optional, condition], [[if, condition, sys_xx_restarts_xx, sys_xx_restarts_xx]]).
2386wl:arglist_info(compute_restarts, f_compute_restarts, [c38_optional, condition], arginfo{all:[condition], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[condition], opt:[condition], req:0, rest:0, sublists:0, whole:0}).
2387wl: init_args(0, f_compute_restarts).
2388
2393f_compute_restarts(RestNKeys, FnResult) :-
2394 GEnv=[bv(condition, Condition_In)],
2395 opt_var(Env, condition, Condition_In, true, [], 1, RestNKeys),
2396 catch(( ( get_var(GEnv, condition, IFTEST),
2397 ( IFTEST\==[]
2398 -> get_var(GEnv, sys_xx_restarts_xx, Xx_restarts_xx_Get),
2399 _10132=Xx_restarts_xx_Get
2400 ; get_var(GEnv, sys_xx_restarts_xx, Xx_restarts_xx_Get10),
2401 _10132=Xx_restarts_xx_Get10
2402 )
2403 ),
2404 _10132=FnResult
2405 ),
2406 block_exit(compute_restarts, FnResult),
2407 true).
2408:- set_opv(compute_restarts, symbol_function, f_compute_restarts),
2409 DefunResult=compute_restarts. 2410/*
2411:- side_effect(assert_lsp(compute_restarts,
2412 doc_string(compute_restarts,
2413 _8326,
2414 function,
2415 "FIXME restarts associated with conditions"))).
2416*/
2417/*
2418:- side_effect(assert_lsp(compute_restarts,
2419 lambda_def(defun,
2420 compute_restarts,
2421 f_compute_restarts,
2422 [c38_optional, condition],
2423
2424 [
2425 [ if,
2426 condition,
2427 sys_xx_restarts_xx,
2428 sys_xx_restarts_xx
2429 ]
2430 ]))).
2431*/
2432/*
2433:- side_effect(assert_lsp(compute_restarts,
2434 arglist_info(compute_restarts,
2435 f_compute_restarts,
2436 [c38_optional, condition],
2437 arginfo{ all:[condition],
2438 allow_other_keys:0,
2439 aux:0,
2440 body:0,
2441 complex:0,
2442 env:0,
2443 key:0,
2444 names:[condition],
2445 opt:[condition],
2446 req:0,
2447 rest:0,
2448 sublists:0,
2449 whole:0
2450 }))).
2451*/
2452/*
2453:- side_effect(assert_lsp(compute_restarts, init_args(0, f_compute_restarts))).
2454*/
2455/*
2456#+(or WAM-CL LISP500)
2457(defun find-restart (identifier &optional condition)
2458 (dolist (restart *restarts*)
2459 (when (eq restart identifier)
2460 (return restart))
2461 (when (eq (restart-name restart) identifier)
2462 (return restart))))
2463
2464
2465
2466*/
2467
2468/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:10113 **********************/
2469:-lisp_compile_to_prolog(pkg_sys,[defun,'find-restart',[identifier,'&optional',condition],[dolist,[restart,'*restarts*'],[when,[eq,restart,identifier],[return,restart]],[when,[eq,['restart-name',restart],identifier],[return,restart]]]])
2470wl:lambda_def(defun, find_restart, f_find_restart, [sys_identifier, c38_optional, condition], [[dolist, [restart, sys_xx_restarts_xx], [when, [eq, restart, sys_identifier], [return, restart]], [when, [eq, [restart_name, restart], sys_identifier], [return, restart]]]]).
2471wl:arglist_info(find_restart, f_find_restart, [sys_identifier, c38_optional, condition], arginfo{all:[sys_identifier, condition], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_identifier, condition], opt:[condition], req:[sys_identifier], rest:0, sublists:0, whole:0}).
2472wl: init_args(1, f_find_restart).
2473
2478f_find_restart(Identifier_In, RestNKeys, FnResult) :-
2479 GEnv=[bv(sys_identifier, Identifier_In), bv(condition, Condition_In)],
2480 opt_var(Env, condition, Condition_In, true, [], 1, RestNKeys),
2481 catch(( ( get_var(GEnv, sys_xx_restarts_xx, Xx_restarts_xx_Get),
2482 BV=bv(restart, Ele),
2483 BlockExitEnv=[BV|GEnv],
2484 forall(member(Ele, Xx_restarts_xx_Get),
2485 ( nb_setarg(2, BV, Ele),
2486 get_var(BlockExitEnv, restart, Restart_Get),
2487 get_var(BlockExitEnv, sys_identifier, Identifier_Get),
2488 ( is_eq(Restart_Get, Identifier_Get)
2489 -> get_var(BlockExitEnv, restart, Restart_Get16),
2490 throw(block_exit([], Restart_Get16)),
2491 _9718=ThrowResult
2492 ; _9718=[]
2493 ),
2494 get_var(BlockExitEnv, restart, Restart_Get20),
2495 f_restart_name(Restart_Get20, PredArg1Result23),
2496 get_var(BlockExitEnv,
2497 sys_identifier,
2498 Identifier_Get21),
2499 ( is_eq(PredArg1Result23, Identifier_Get21)
2500 -> get_var(BlockExitEnv, restart, RetResult25),
2501 throw(block_exit([], RetResult25)),
2502 _8792=ThrowResult26
2503 ; _8792=[]
2504 )
2505 ))
2506 ),
2507 _8792=FnResult
2508 ),
2509 block_exit(find_restart, FnResult),
2510 true).
2511:- set_opv(find_restart, symbol_function, f_find_restart),
2512 DefunResult=find_restart. 2513/*
2514:- side_effect(assert_lsp(find_restart,
2515 lambda_def(defun,
2516 find_restart,
2517 f_find_restart,
2518 [sys_identifier, c38_optional, condition],
2519
2520 [
2521 [ dolist,
2522 [restart, sys_xx_restarts_xx],
2523
2524 [ when,
2525 [eq, restart, sys_identifier],
2526 [return, restart]
2527 ],
2528
2529 [ when,
2530
2531 [ eq,
2532 [restart_name, restart],
2533 sys_identifier
2534 ],
2535 [return, restart]
2536 ]
2537 ]
2538 ]))).
2539*/
2540/*
2541:- side_effect(assert_lsp(find_restart,
2542 arglist_info(find_restart,
2543 f_find_restart,
2544 [sys_identifier, c38_optional, condition],
2545 arginfo{ all:[sys_identifier, condition],
2546 allow_other_keys:0,
2547 aux:0,
2548 body:0,
2549 complex:0,
2550 env:0,
2551 key:0,
2552 names:
2553 [ sys_identifier,
2554 condition
2555 ],
2556 opt:[condition],
2557 req:[sys_identifier],
2558 rest:0,
2559 sublists:0,
2560 whole:0
2561 }))).
2562*/
2563/*
2564:- side_effect(assert_lsp(find_restart, init_args(1, f_find_restart))).
2565*/
2566/*
2567#+(or WAM-CL LISP500)
2568(defun designator-restart (designator)
2569 (if (restartp designator)
2570 designator
2571 (dolist (restart *restarts* (error 'type-error :datum designator
2572 :expected-type 'restart))
2573 (when (eq (restart-name restart) designator)
2574 (return restart)))))
2575
2576
2577*/
2578
2579/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:10366 **********************/
2580:-lisp_compile_to_prolog(pkg_sys,[defun,'designator-restart',[designator],[if,[restartp,designator],designator,[dolist,[restart,'*restarts*',[error,[quote,'type-error'],':datum',designator,':expected-type',[quote,restart]]],[when,[eq,['restart-name',restart],designator],[return,restart]]]]])
2581/*
2582:- side_effect(generate_function_or_macro_name(
2583 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
2584 name='GLOBAL',
2585 environ=env_1
2586 ],
2587 sys_designator_restart,
2588 kw_function,
2589 f_sys_designator_restart)).
2590*/
2591/*
2592:- side_effect(generate_function_or_macro_name(
2593 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
2594 name='GLOBAL',
2595 environ=env_1
2596 ],
2597 sys_restartp,
2598 kw_function,
2599 f_sys_restartp)).
2600*/
2601wl:lambda_def(defun, sys_designator_restart, f_sys_designator_restart, [sys_designator], [[if, [sys_restartp, sys_designator], sys_designator, [dolist, [restart, sys_xx_restarts_xx, [error, [quote, type_error], kw_datum, sys_designator, kw_expected_type, [quote, restart]]], [when, [eq, [restart_name, restart], sys_designator], [return, restart]]]]]).
2602wl:arglist_info(sys_designator_restart, f_sys_designator_restart, [sys_designator], arginfo{all:[sys_designator], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_designator], opt:0, req:[sys_designator], rest:0, sublists:0, whole:0}).
2603wl: init_args(x, f_sys_designator_restart).
2604
2609f_sys_designator_restart(Designator_In, FnResult) :-
2610 GEnv=[bv(sys_designator, Designator_In)],
2611 catch(( ( get_var(GEnv, sys_designator, Designator_Get),
2612 f_sys_restartp(Designator_Get, IFTEST),
2613 ( IFTEST\==[]
2614 -> get_var(GEnv, sys_designator, Designator_Get8),
2615 _8990=Designator_Get8
2616 ; LEnv=[bv([error, [quote, type_error], kw_datum, sys_designator, kw_expected_type, [quote, restart]], [])|GEnv],
2617 get_var(LEnv, sys_xx_restarts_xx, Xx_restarts_xx_Get),
2618 BV=bv(restart, Ele),
2619 BlockExitEnv=[BV|LEnv],
2620 forall(member(Ele, Xx_restarts_xx_Get),
2621 ( nb_setarg(2, BV, Ele),
2622 get_var(BlockExitEnv, restart, Restart_Get),
2623 f_restart_name(Restart_Get, PredArg1Result),
2624 get_var(BlockExitEnv,
2625 sys_designator,
2626 Designator_Get15),
2627 ( is_eq(PredArg1Result, Designator_Get15)
2628 -> get_var(BlockExitEnv, restart, Restart_Get21),
2629 throw(block_exit([], Restart_Get21)),
2630 _11208=ThrowResult
2631 ; _11208=[]
2632 )
2633 )),
2634 get_var(LEnv, sys_designator, Designator_Get28),
2635 f_error(
2636 [ type_error,
2637 kw_datum,
2638 Designator_Get28,
2639 kw_expected_type,
2640 restart
2641 ],
2642 LetResult),
2643 _8990=LetResult
2644 )
2645 ),
2646 _8990=FnResult
2647 ),
2648 block_exit(sys_designator_restart, FnResult),
2649 true).
2650:- set_opv(sys_designator_restart, symbol_function, f_sys_designator_restart),
2651 DefunResult=sys_designator_restart. 2652/*
2653:- side_effect(assert_lsp(sys_designator_restart,
2654 lambda_def(defun,
2655 sys_designator_restart,
2656 f_sys_designator_restart,
2657 [sys_designator],
2658
2659 [
2660 [ if,
2661 [sys_restartp, sys_designator],
2662 sys_designator,
2663
2664 [ dolist,
2665
2666 [ restart,
2667 sys_xx_restarts_xx,
2668
2669 [ error,
2670 [quote, type_error],
2671 kw_datum,
2672 sys_designator,
2673 kw_expected_type,
2674 [quote, restart]
2675 ]
2676 ],
2677
2678 [ when,
2679
2680 [ eq,
2681 [restart_name, restart],
2682 sys_designator
2683 ],
2684 [return, restart]
2685 ]
2686 ]
2687 ]
2688 ]))).
2689*/
2690/*
2691:- side_effect(assert_lsp(sys_designator_restart,
2692 arglist_info(sys_designator_restart,
2693 f_sys_designator_restart,
2694 [sys_designator],
2695 arginfo{ all:[sys_designator],
2696 allow_other_keys:0,
2697 aux:0,
2698 body:0,
2699 complex:0,
2700 env:0,
2701 key:0,
2702 names:[sys_designator],
2703 opt:0,
2704 req:[sys_designator],
2705 rest:0,
2706 sublists:0,
2707 whole:0
2708 }))).
2709*/
2710/*
2711:- side_effect(assert_lsp(sys_designator_restart,
2712 init_args(x, f_sys_designator_restart))).
2713*/
2714/*
2715#+(or WAM-CL LISP500)
2716(defun invoke-restart (restart &rest arguments)
2717 (setq restart (designator-restart restart))
2718 (apply (restart-function restart) arguments))
2719
2720*/
2721
2722/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:10658 **********************/
2723:-lisp_compile_to_prolog(pkg_sys,[defun,'invoke-restart',[restart,'&rest',arguments],[setq,restart,['designator-restart',restart]],[apply,['restart-function',restart],arguments]])
2724wl:lambda_def(defun, invoke_restart, f_invoke_restart, [restart, c38_rest, sys_arguments], [[setq, restart, [sys_designator_restart, restart]], [apply, [sys_restart_function, restart], sys_arguments]]).
2725wl:arglist_info(invoke_restart, f_invoke_restart, [restart, c38_rest, sys_arguments], arginfo{all:[restart], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[restart, sys_arguments], opt:0, req:[restart], rest:[sys_arguments], sublists:0, whole:0}).
2726wl: init_args(1, f_invoke_restart).
2727
2732f_invoke_restart(Restart_In, RestNKeys, FnResult) :-
2733 AEnv=[bv(restart, Restart_In), bv(sys_arguments, RestNKeys)],
2734 catch(( ( get_var(AEnv, restart, Restart_Get),
2735 f_sys_designator_restart(Restart_Get, Restart),
2736 set_var(AEnv, restart, Restart),
2737 get_var(AEnv, restart, Restart_Get8),
2738 f_sys_restart_function(Restart_Get8, Apply_Param),
2739 get_var(AEnv, sys_arguments, Arguments_Get),
2740 f_apply(Apply_Param, Arguments_Get, Apply_Ret)
2741 ),
2742 Apply_Ret=FnResult
2743 ),
2744 block_exit(invoke_restart, FnResult),
2745 true).
2746:- set_opv(invoke_restart, symbol_function, f_invoke_restart),
2747 DefunResult=invoke_restart. 2748/*
2749:- side_effect(assert_lsp(invoke_restart,
2750 lambda_def(defun,
2751 invoke_restart,
2752 f_invoke_restart,
2753 [restart, c38_rest, sys_arguments],
2754
2755 [
2756 [ setq,
2757 restart,
2758 [sys_designator_restart, restart]
2759 ],
2760
2761 [ apply,
2762 [sys_restart_function, restart],
2763 sys_arguments
2764 ]
2765 ]))).
2766*/
2767/*
2768:- side_effect(assert_lsp(invoke_restart,
2769 arglist_info(invoke_restart,
2770 f_invoke_restart,
2771 [restart, c38_rest, sys_arguments],
2772 arginfo{ all:[restart],
2773 allow_other_keys:0,
2774 aux:0,
2775 body:0,
2776 complex:[rest],
2777 env:0,
2778 key:0,
2779 names:[restart, sys_arguments],
2780 opt:0,
2781 req:[restart],
2782 rest:[sys_arguments],
2783 sublists:0,
2784 whole:0
2785 }))).
2786*/
2787/*
2788:- side_effect(assert_lsp(invoke_restart, init_args(1, f_invoke_restart))).
2789*/
2790/*
2791#+(or WAM-CL LISP500)
2792(defun invoke-restart-interactively (restart)
2793 (setq restart (designator-restart restart))
2794 (apply (restart-function restart)
2795 (funcall (restart-interactive-function restart))))
2796
2797*/
2798
2799/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:10829 **********************/
2800:-lisp_compile_to_prolog(pkg_sys,[defun,'invoke-restart-interactively',[restart],[setq,restart,['designator-restart',restart]],[apply,['restart-function',restart],[funcall,['restart-interactive-function',restart]]]])
2801wl:lambda_def(defun, invoke_restart_interactively, f_invoke_restart_interactively, [restart], [[setq, restart, [sys_designator_restart, restart]], [apply, [sys_restart_function, restart], [funcall, [sys_restart_interactive_function, restart]]]]).
2802wl:arglist_info(invoke_restart_interactively, f_invoke_restart_interactively, [restart], arginfo{all:[restart], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[restart], opt:0, req:[restart], rest:0, sublists:0, whole:0}).
2803wl: init_args(x, f_invoke_restart_interactively).
2804
2809f_invoke_restart_interactively(Restart_In, FnResult) :-
2810 AEnv=[bv(restart, Restart_In)],
2811 catch(( ( get_var(AEnv, restart, Restart_Get),
2812 f_sys_designator_restart(Restart_Get, Restart),
2813 set_var(AEnv, restart, Restart),
2814 get_var(AEnv, restart, Restart_Get7),
2815 f_sys_restart_function(Restart_Get7, Apply_Param13),
2816 get_var(AEnv, restart, Restart_Get8),
2817 f_sys_restart_interactive_function(Restart_Get8, Apply_Param),
2818 f_apply(Apply_Param, [], Apply_Ret),
2819 f_apply(Apply_Param13, Apply_Ret, Apply_Ret15)
2820 ),
2821 Apply_Ret15=FnResult
2822 ),
2823 block_exit(invoke_restart_interactively, FnResult),
2824 true).
2825:- set_opv(invoke_restart_interactively,
2826 symbol_function,
2827 f_invoke_restart_interactively),
2828 DefunResult=invoke_restart_interactively. 2829/*
2830:- side_effect(assert_lsp(invoke_restart_interactively,
2831 lambda_def(defun,
2832 invoke_restart_interactively,
2833 f_invoke_restart_interactively,
2834 [restart],
2835
2836 [
2837 [ setq,
2838 restart,
2839 [sys_designator_restart, restart]
2840 ],
2841
2842 [ apply,
2843 [sys_restart_function, restart],
2844
2845 [ funcall,
2846
2847 [ sys_restart_interactive_function,
2848 restart
2849 ]
2850 ]
2851 ]
2852 ]))).
2853*/
2854/*
2855:- side_effect(assert_lsp(invoke_restart_interactively,
2856 arglist_info(invoke_restart_interactively,
2857 f_invoke_restart_interactively,
2858 [restart],
2859 arginfo{ all:[restart],
2860 allow_other_keys:0,
2861 aux:0,
2862 body:0,
2863 complex:0,
2864 env:0,
2865 key:0,
2866 names:[restart],
2867 opt:0,
2868 req:[restart],
2869 rest:0,
2870 sublists:0,
2871 whole:0
2872 }))).
2873*/
2874/*
2875:- side_effect(assert_lsp(invoke_restart_interactively,
2876 init_args(x, f_invoke_restart_interactively))).
2877*/
2878/*
2879#+(or WAM-CL LISP500)
2880(defmacro restart-bind (restart-bindings &rest forms)
2881 (let ((form '*restarts*))
2882 (dolist (binding (reverse restart-bindings))
2883 (setq form
2884 `(cons (make-restart ',(car binding) ,@(cdr binding)) ,form)))
2885 `(let ((*restarts* ,form))
2886 ,@forms)))
2887
2888
2889*/
2890
2891/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:11040 **********************/
2892:-lisp_compile_to_prolog(pkg_sys,[defmacro,'restart-bind',['restart-bindings','&rest',forms],[let,[[form,[quote,'*restarts*']]],[dolist,[binding,[reverse,'restart-bindings']],[setq,form,['#BQ',[cons,['make-restart',[quote,['#COMMA',[car,binding]]],['#BQ-COMMA-ELIPSE',[cdr,binding]]],['#COMMA',form]]]]],['#BQ',[let,[['*restarts*',['#COMMA',form]]],['#BQ-COMMA-ELIPSE',forms]]]]])
2893/*
2894:- side_effect(generate_function_or_macro_name(
2895 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
2896 name='GLOBAL',
2897 environ=env_1
2898 ],
2899 restart_bind,
2900 kw_special,
2901 sf_restart_bind)).
2902*/
2903wl:lambda_def(defmacro, restart_bind, mf_restart_bind, [sys_restart_bindings, c38_rest, sys_forms], [[let, [[sys_form, [quote, sys_xx_restarts_xx]]], [dolist, [sys_binding, [reverse, sys_restart_bindings]], [setq, sys_form, ['#BQ', [cons, [sys_make_restart, [quote, ['#COMMA', [car, sys_binding]]], ['#BQ-COMMA-ELIPSE', [cdr, sys_binding]]], ['#COMMA', sys_form]]]]], ['#BQ', [let, [[sys_xx_restarts_xx, ['#COMMA', sys_form]]], ['#BQ-COMMA-ELIPSE', sys_forms]]]]]).
2904wl:arglist_info(restart_bind, mf_restart_bind, [sys_restart_bindings, c38_rest, sys_forms], arginfo{all:[sys_restart_bindings], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_restart_bindings, sys_forms], opt:0, req:[sys_restart_bindings], rest:[sys_forms], sublists:0, whole:0}).
2905wl: init_args(1, mf_restart_bind).
2906
2911sf_restart_bind(MacroEnv, Restart_bindings_In, RestNKeys, FResult) :-
2912 mf_restart_bind([restart_bind, Restart_bindings_In|RestNKeys],
2913 MacroEnv,
2914 MFResult),
2915 f_sys_env_eval(MacroEnv, MFResult, FResult).
2920mf_restart_bind([restart_bind, Restart_bindings_In|RestNKeys], MacroEnv, MFResult) :-
2921 nop(defmacro),
2922 CDR=[bv(sys_restart_bindings, Restart_bindings_In), bv(sys_forms, RestNKeys)],
2923 catch(( ( LEnv=[bv(sys_form, sys_xx_restarts_xx)|CDR],
2924 get_var(LEnv, sys_restart_bindings, Restart_bindings_Get),
2925 f_reverse(Restart_bindings_Get, List),
2926 BV=bv(sys_binding, Ele),
2927 AEnv=[BV|LEnv],
2928 forall(member(Ele, List),
2929 ( nb_setarg(2, BV, Ele),
2930 get_var(AEnv, sys_binding, Binding_Get),
2931 f_car(Binding_Get, Car_Ret),
2932 get_var(AEnv, sys_binding, Binding_Get12),
2933 f_cdr(Binding_Get12, Cdr_Ret),
2934 get_var(AEnv, sys_form, Form_Get),
2935 set_var(AEnv,
2936 sys_form,
2937
2938 [ cons,
2939
2940 [ sys_make_restart,
2941 [quote, Car_Ret]
2942 | Cdr_Ret
2943 ],
2944 Form_Get
2945 ])
2946 )),
2947 get_var(LEnv, sys_form, Form_Get18),
2948 get_var(LEnv, sys_forms, Forms_Get)
2949 ),
2950 [let, [[sys_xx_restarts_xx, Form_Get18]]|Forms_Get]=MFResult
2951 ),
2952 block_exit(restart_bind, MFResult),
2953 true).
2954:- set_opv(mf_restart_bind, type_of, sys_macro),
2955 set_opv(restart_bind, symbol_function, mf_restart_bind),
2956 DefMacroResult=restart_bind. 2957/*
2958:- side_effect(assert_lsp(restart_bind,
2959 lambda_def(defmacro,
2960 restart_bind,
2961 mf_restart_bind,
2962 [sys_restart_bindings, c38_rest, sys_forms],
2963
2964 [
2965 [ let,
2966
2967 [
2968 [ sys_form,
2969 [quote, sys_xx_restarts_xx]
2970 ]
2971 ],
2972
2973 [ dolist,
2974
2975 [ sys_binding,
2976 [reverse, sys_restart_bindings]
2977 ],
2978
2979 [ setq,
2980 sys_form,
2981
2982 [ '#BQ',
2983
2984 [ cons,
2985
2986 [ sys_make_restart,
2987
2988 [ quote,
2989
2990 [ '#COMMA',
2991 [car, sys_binding]
2992 ]
2993 ],
2994
2995 [ '#BQ-COMMA-ELIPSE',
2996 [cdr, sys_binding]
2997 ]
2998 ],
2999 ['#COMMA', sys_form]
3000 ]
3001 ]
3002 ]
3003 ],
3004
3005 [ '#BQ',
3006
3007 [ let,
3008
3009 [
3010 [ sys_xx_restarts_xx,
3011 ['#COMMA', sys_form]
3012 ]
3013 ],
3014 ['#BQ-COMMA-ELIPSE', sys_forms]
3015 ]
3016 ]
3017 ]
3018 ]))).
3019*/
3020/*
3021:- side_effect(assert_lsp(restart_bind,
3022 arglist_info(restart_bind,
3023 mf_restart_bind,
3024
3025 [ sys_restart_bindings,
3026 c38_rest,
3027 sys_forms
3028 ],
3029 arginfo{ all:[sys_restart_bindings],
3030 allow_other_keys:0,
3031 aux:0,
3032 body:0,
3033 complex:[rest],
3034 env:0,
3035 key:0,
3036 names:
3037 [ sys_restart_bindings,
3038 sys_forms
3039 ],
3040 opt:0,
3041 req:[sys_restart_bindings],
3042 rest:[sys_forms],
3043 sublists:0,
3044 whole:0
3045 }))).
3046*/
3047/*
3048:- side_effect(assert_lsp(restart_bind, init_args(1, mf_restart_bind))).
3049*/
3050/*
3051#+(or WAM-CL LISP500)
3052(defmacro restart-case (restartable-form &rest clauses)
3053 (let ((catch-tag (gensym))
3054 (bindings nil))
3055 `(catch ',catch-tag
3056 (restart-bind
3057 ,(dolist (clause clauses (reverse bindings))
3058 (let ((name (car clause))
3059 (lambda-list (cadr clause))
3060 (rest (cddr clause))
3061 (interactive '#'(lambda () nil))
3062 (report '#'(lambda (stream)
3063 (format stream ""#+(or WAM-CL LISP500) \r\n(defmacro restart-case (restartable-form &rest clauses)\r\n (let ((catch-tag (gensym))\r\n\t(bindings nil))\r\n `(catch ',catch-tag\r\n (restart-bind\r\n\t ,(dolist (clause clauses (reverse bindings))\r\n\t (let ((name (car clause))\r\n\t\t (lambda-list (cadr clause))\r\n\t\t (rest (cddr clause))\r\n\t\t (interactive '#'(lambda () nil))\r\n\t\t (report '#'(lambda (stream)\r\n\t\t\t\t(format stream \"~A\" (car clause))))\r\n\t\t (test '#'(lambda (condition) t)))\r\n\t (tagbody\r\n\t\tstart\r\n\t\t (when (member (car rest) '(:interactive :report :test))\r\n\t\t (let ((value (cadr rest)))\r\n\t\t (case (car rest)\r\n\t\t\t(:interactive (setq interactive `(function ,value)))\r\n\t\t\t(:report (setq report\r\n\t\t\t\t (if (stringp value)\r\n\t\t\t\t\t `#'(lambda (stream)\r\n\t\t\t\t\t\t(write-string ,value stream))\r\n\t\t\t\t\t `(function ,value))))\r\n\t\t\t(:test (setq test `(function ,value)))))\r\n\t\t (setq rest (cddr rest))\r\n\t\t (go start)))\r\n\t (push `(,(car clause)\r\n\t\t #'(lambda ,(cadr clause)\r\n\t\t\t (throw ',catch-tag (progn ,@rest)))\r\n\t\t :interactive-function ,interactive\r\n\t\t :report-function ,report\r\n\t\t :test-function ,test)\r\n\t\t bindings)))\r\n\t,restartable-form))))\r\n\r\n\r\n\r\n\r\n".
3064*/
3065
3066/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:11339 **********************/
3067:-lisp_compile_to_prolog(pkg_sys,[defmacro,'restart-case',['restartable-form','&rest',clauses],[let,[['catch-tag',[gensym]],[bindings,[]]],['#BQ',[catch,[quote,['#COMMA','catch-tag']],['restart-bind',['#COMMA',[dolist,[clause,clauses,[reverse,bindings]],[let,[[name,[car,clause]],['lambda-list',[cadr,clause]],[rest,[cddr,clause]],[interactive,[quote,function([lambda,[],[]])]],[report,[quote,function([lambda,[stream],[format,stream,'$STRING'("~A"),[car,clause]]])]],[test,[quote,function([lambda,[condition],t])]]],[tagbody,start,[when,[member,[car,rest],[quote,[':interactive',':report',':test']]],[let,[[value,[cadr,rest]]],[case,[car,rest],[':interactive',[setq,interactive,['#BQ',[function,['#COMMA',value]]]]],[':report',[setq,report,[if,[stringp,value],['#BQ',function([lambda,[stream],['write-string',['#COMMA',value],stream]])],['#BQ',[function,['#COMMA',value]]]]]],[':test',[setq,test,['#BQ',[function,['#COMMA',value]]]]]]],[setq,rest,[cddr,rest]],[go,start]]],[push,['#BQ',[['#COMMA',[car,clause]],function([lambda,['#COMMA',[cadr,clause]],[throw,[quote,['#COMMA','catch-tag']],[progn,['#BQ-COMMA-ELIPSE',rest]]]]),':interactive-function',['#COMMA',interactive],':report-function',['#COMMA',report],':test-function',['#COMMA',test]]],bindings]]]],['#COMMA','restartable-form']]]]]])
3068/*
3069% case:-[[kw_interactive,[setq,sys_interactive,['#BQ',[function,['#COMMA',sys_value]]]]],[kw_report,[setq,sys_report,[if,[stringp,sys_value],['#BQ',function([lambda,[stream],[write_string,['#COMMA',sys_value],stream]])],['#BQ',[function,['#COMMA',sys_value]]]]]],[kw_test,[setq,sys_test,['#BQ',[function,['#COMMA',sys_value]]]]]].
3070*/
3071/*
3072% conds:-[[[eq,_71020,[quote,kw_interactive]],[progn,[setq,sys_interactive,['#BQ',[function,['#COMMA',sys_value]]]]]],[[eq,_71020,[quote,kw_report]],[progn,[setq,sys_report,[if,[stringp,sys_value],['#BQ',function([lambda,[stream],[write_string,['#COMMA',sys_value],stream]])],['#BQ',[function,['#COMMA',sys_value]]]]]]],[[eq,_71020,[quote,kw_test]],[progn,[setq,sys_test,['#BQ',[function,['#COMMA',sys_value]]]]]]].
3073*/
3074/*
3075% case:-[[kw_interactive,[setq,sys_interactive,['#BQ',[function,['#COMMA',sys_value]]]]],[kw_report,[setq,sys_report,[if,[stringp,sys_value],['#BQ',function([lambda,[stream],[write_string,['#COMMA',sys_value],stream]])],['#BQ',[function,['#COMMA',sys_value]]]]]],[kw_test,[setq,sys_test,['#BQ',[function,['#COMMA',sys_value]]]]]].
3076*/
3077/*
3078% conds:-[[[eq,_77308,[quote,kw_interactive]],[progn,[setq,sys_interactive,['#BQ',[function,['#COMMA',sys_value]]]]]],[[eq,_77308,[quote,kw_report]],[progn,[setq,sys_report,[if,[stringp,sys_value],['#BQ',function([lambda,[stream],[write_string,['#COMMA',sys_value],stream]])],['#BQ',[function,['#COMMA',sys_value]]]]]]],[[eq,_77308,[quote,kw_test]],[progn,[setq,sys_test,['#BQ',[function,['#COMMA',sys_value]]]]]]].
3079*/
3080/*
3081% macroexpand:-[push,['#BQ',[['#COMMA',[car,sys_clause]],function([lambda,['#COMMA',[cadr,sys_clause]],[throw,[quote,['#COMMA',sys_catch_tag]],[progn,['#BQ-COMMA-ELIPSE',rest]]]]),kw_interactive_function,['#COMMA',sys_interactive],kw_report_function,['#COMMA',sys_report],kw_test_function,['#COMMA',sys_test]]],sys_bindings].
3082*/
3083/*
3084% into:-[setq,sys_bindings,[cons,['#BQ',[['#COMMA',[car,sys_clause]],function([lambda,['#COMMA',[cadr,sys_clause]],[throw,[quote,['#COMMA',sys_catch_tag]],[progn,['#BQ-COMMA-ELIPSE',rest]]]]),kw_interactive_function,['#COMMA',sys_interactive],kw_report_function,['#COMMA',sys_report],kw_test_function,['#COMMA',sys_test]]],sys_bindings]].
3085*/
3086/*
3087:- side_effect(generate_function_or_macro_name(
3088 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
3089 name='GLOBAL',
3090 environ=env_1
3091 ],
3092 restart_case,
3093 kw_special,
3094 sf_restart_case)).
3095*/
3096wl:lambda_def(defmacro, restart_case, mf_restart_case, [sys_restartable_form, c38_rest, sys_clauses], [[let, [[sys_catch_tag, [gensym]], [sys_bindings, []]], ['#BQ', [catch, [quote, ['#COMMA', sys_catch_tag]], [restart_bind, ['#COMMA', [dolist, [sys_clause, sys_clauses, [reverse, sys_bindings]], [let, [[sys_name, [car, sys_clause]], [sys_lambda_list, [cadr, sys_clause]], [rest, [cddr, sys_clause]], [sys_interactive, [quote, function([lambda, [], []])]], [sys_report, [quote, function([lambda, [stream], [format, stream, '$ARRAY'([*], claz_base_character, "~A"), [car, sys_clause]]])]], [sys_test, [quote, function([lambda, [condition], t])]]], [tagbody, sys_start, [when, [member, [car, rest], [quote, [kw_interactive, kw_report, kw_test]]], [let, [[sys_value, [cadr, rest]]], [case, [car, rest], [kw_interactive, [setq, sys_interactive, ['#BQ', [function, ['#COMMA', sys_value]]]]], [kw_report, [setq, sys_report, [if, [stringp, sys_value], ['#BQ', function([lambda, [stream], [write_string, ['#COMMA', sys_value], stream]])], ['#BQ', [function, ['#COMMA', sys_value]]]]]], [kw_test, [setq, sys_test, ['#BQ', [function, ['#COMMA', sys_value]]]]]]], [setq, rest, [cddr, rest]], [go, sys_start]]], [push, ['#BQ', [['#COMMA', [car, sys_clause]], function([lambda, ['#COMMA', [cadr, sys_clause]], [throw, [quote, ['#COMMA', sys_catch_tag]], [progn, ['#BQ-COMMA-ELIPSE', rest]]]]), kw_interactive_function, ['#COMMA', sys_interactive], kw_report_function, ['#COMMA', sys_report], kw_test_function, ['#COMMA', sys_test]]], sys_bindings]]]], ['#COMMA', sys_restartable_form]]]]]]).
3097wl:arglist_info(restart_case, mf_restart_case, [sys_restartable_form, c38_rest, sys_clauses], arginfo{all:[sys_restartable_form], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_restartable_form, sys_clauses], opt:0, req:[sys_restartable_form], rest:[sys_clauses], sublists:0, whole:0}).
3098wl: init_args(1, mf_restart_case).
3099
3104sf_restart_case(MacroEnv, Restartable_form_In, RestNKeys, FResult) :-
3105 mf_restart_case([restart_case, Restartable_form_In|RestNKeys],
3106 MacroEnv,
3107 MFResult),
3108 f_sys_env_eval(MacroEnv, MFResult, FResult).
3113mf_restart_case([restart_case, Restartable_form_In|RestNKeys], MacroEnv, MFResult) :-
3114 nop(defmacro),
3115 CDR=[bv(sys_restartable_form, Restartable_form_In), bv(sys_clauses, RestNKeys)],
3116 catch(( ( f_gensym(Catch_tag_Init),
3117 LEnv=[bv(sys_catch_tag, Catch_tag_Init), bv(sys_bindings, [])|CDR],
3118 get_var(LEnv, sys_bindings, Bindings_Get),
3119 get_var(LEnv, sys_catch_tag, Catch_tag_Get),
3120 LEnv13=[bv(reverse, Bindings_Get)|LEnv],
3121 get_var(LEnv13, sys_clauses, Clauses_Get),
3122 BV=bv(sys_clause, Ele),
3123 Env2=[BV|LEnv13],
3124 forall(member(Ele, Clauses_Get),
3125 ( nb_setarg(2, BV, Ele),
3126 get_var(Env2, sys_clause, Clause_Get),
3127 f_car(Clause_Get, Name_Init),
3128 get_var(Env2, sys_clause, Clause_Get21),
3129 f_cadr(Clause_Get21, Lambda_list_Init),
3130 get_var(Env2, sys_clause, Clause_Get22),
3131 f_cddr(Clause_Get22, Rest_Init),
3132 AEnv=[bv(sys_name, Name_Init), bv(sys_lambda_list, Lambda_list_Init), bv(rest, Rest_Init), bv(sys_interactive, function([lambda, [], []])), bv(sys_report, function([lambda, [stream], [format, stream, '$ARRAY'([*], claz_base_character, "~A"), [car, sys_clause]]])), bv(sys_test, function([lambda, [condition], t]))|Env2],
3133 call_addr_block(AEnv,
3134 (push_label(sys_start), get_var(AEnv, rest, Rest_Get64), f_car(Rest_Get64, Member_Param), f_member(Member_Param, [kw_interactive, kw_report, kw_test], [], IFTEST62), (IFTEST62\==[]->get_var(AEnv, rest, Rest_Get68), f_cadr(Rest_Get68, Value_Init69), LEnv67=[bv(sys_value, Value_Init69)|AEnv], get_var(LEnv67, rest, Rest_Get70), f_car(Rest_Get70, Key71), (is_eq(Key71, kw_interactive)->get_var(LEnv67, sys_value, Value_Get76), set_var(LEnv67, sys_interactive, [function, Value_Get76]), LetResult66=[function, Value_Get76];(is_eq(Key71, kw_report)->get_var(LEnv67, sys_value, Value_Get80), (is_stringp(Value_Get80)->TrueResult88=function([lambda, [stream], [write_string, ['#COMMA', sys_value], stream]]);get_var(LEnv67, sys_value, Value_Get83), TrueResult88=[function, Value_Get83]), set_var(LEnv67, sys_report, TrueResult88), ElseResult90=TrueResult88;(is_eq(Key71, kw_test)->get_var(LEnv67, sys_value, Value_Get86), set_var(LEnv67, sys_test, [function, Value_Get86]), ElseResult89=[function, Value_Get86];ElseResult87=[], ElseResult89=ElseResult87), ElseResult90=ElseResult89), LetResult66=ElseResult90), get_var(AEnv, rest, Rest_Get92), f_cddr(Rest_Get92, Rest), set_var(AEnv, rest, Rest), goto(sys_start, AEnv), _TBResult=_GORES93;_TBResult=[])),
3135
3136 [ addr(addr_tagbody_35_sys_start,
3137 sys_start,
3138 '$unused',
3139 AEnv56,
3140 (get_var(AEnv56, rest, Car_Param), f_car(Car_Param, Member_Param112), f_member(Member_Param112, [kw_interactive, kw_report, kw_test], [], IFTEST), (IFTEST\==[]->get_var(AEnv56, rest, Rest_Get33), f_cadr(Rest_Get33, Cadr_Ret), LEnv32=[bv(sys_value, Cadr_Ret)|AEnv56], get_var(LEnv32, rest, Rest_Get35), f_car(Rest_Get35, Key), (is_eq(Key, kw_interactive)->get_var(LEnv32, sys_value, Get_var_Ret), set_var(LEnv32, sys_interactive, [function, Get_var_Ret]), LetResult31=[function, Get_var_Ret];(is_eq(Key, kw_report)->get_var(LEnv32, sys_value, Value_Get45), (is_stringp(Value_Get45)->Set_var_Ret=function([lambda, [stream], [write_string, ['#COMMA', sys_value], stream]]);get_var(LEnv32, sys_value, Value_Get48), Set_var_Ret=[function, Value_Get48]), set_var(LEnv32, sys_report, Set_var_Ret), ElseResult55=Set_var_Ret;(is_eq(Key, kw_test)->get_var(LEnv32, sys_value, Value_Get51), set_var(LEnv32, sys_test, [function, Value_Get51]), ElseResult54=[function, Value_Get51];_11712=[], ElseResult54=_11712), ElseResult55=ElseResult54), LetResult31=ElseResult55), get_var(AEnv56, rest, Rest_Get57), f_cddr(Rest_Get57, Cddr_Ret), set_var(AEnv56, rest, Cddr_Ret), goto(sys_start, AEnv56), _11730=_GORES;_11730=[])))
3141 ]),
3142 get_var(AEnv, sys_clause, Clause_Get96),
3143 f_car(Clause_Get96, Car_Ret),
3144 ( get_var(AEnv, sys_bindings, Bindings_Get100),
3145 get_var(AEnv, sys_interactive, Interactive_Get)
3146 ),
3147 get_var(AEnv, sys_report, Report_Get),
3148 get_var(AEnv, sys_test, Test_Get),
3149 LetResult18=[[Car_Ret, function([lambda, ['#COMMA', [cadr, sys_clause]], [throw, [quote, ['#COMMA', sys_catch_tag]], [progn, ['#BQ-COMMA-ELIPSE', rest]]]]), kw_interactive_function, Interactive_Get, kw_report_function, Report_Get, kw_test_function, Test_Get]|Bindings_Get100],
3150 set_var(AEnv, sys_bindings, LetResult18)
3151 )),
3152 get_var(LEnv13, sys_bindings, Bindings_Get105),
3153 f_reverse(Bindings_Get105, LetResult12),
3154 get_var(LEnv, sys_restartable_form, Restartable_form_Get)
3155 ),
3156 [catch, [quote, Catch_tag_Get], [restart_bind, LetResult12, Restartable_form_Get]]=MFResult
3157 ),
3158 block_exit(restart_case, MFResult),
3159 true).
3160:- set_opv(mf_restart_case, type_of, sys_macro),
3161 set_opv(restart_case, symbol_function, mf_restart_case),
3162 DefMacroResult=restart_case. 3163/*
3164:- side_effect(assert_lsp(restart_case,
3165 lambda_def(defmacro,
3166 restart_case,
3167 mf_restart_case,
3168
3169 [ sys_restartable_form,
3170 c38_rest,
3171 sys_clauses
3172 ],
3173
3174 [
3175 [ let,
3176
3177 [ [sys_catch_tag, [gensym]],
3178 [sys_bindings, []]
3179 ],
3180
3181 [ '#BQ',
3182
3183 [ catch,
3184 [quote, ['#COMMA', sys_catch_tag]],
3185
3186 [ restart_bind,
3187
3188 [ '#COMMA',
3189
3190 [ dolist,
3191
3192 [ sys_clause,
3193 sys_clauses,
3194 [reverse, sys_bindings]
3195 ],
3196
3197 [ let,
3198
3199 [
3200 [ sys_name,
3201 [car, sys_clause]
3202 ],
3203
3204 [ sys_lambda_list,
3205 [cadr, sys_clause]
3206 ],
3207
3208 [ rest,
3209 [cddr, sys_clause]
3210 ],
3211
3212 [ sys_interactive,
3213
3214 [ quote,
3215 function([lambda, [], []])
3216 ]
3217 ],
3218
3219 [ sys_report,
3220
3221 [ quote,
3222 function(
3223 [ lambda,
3224 [stream],
3225
3226 [ format,
3227 stream,
3228 '$ARRAY'([*],
3229 claz_base_character,
3230 "~A"),
3231 [car, sys_clause]
3232 ]
3233 ])
3234 ]
3235 ],
3236
3237 [ sys_test,
3238
3239 [ quote,
3240 function(
3241 [ lambda,
3242 [condition],
3243 t
3244 ])
3245 ]
3246 ]
3247 ],
3248
3249 [ tagbody,
3250 sys_start,
3251
3252 [ when,
3253
3254 [ member,
3255 [car, rest],
3256
3257 [ quote,
3258
3259 [ kw_interactive,
3260 kw_report,
3261 kw_test
3262 ]
3263 ]
3264 ],
3265
3266 [ let,
3267
3268 [
3269 [ sys_value,
3270 [cadr, rest]
3271 ]
3272 ],
3273
3274 [ case,
3275 [car, rest],
3276
3277 [ kw_interactive,
3278
3279 [ setq,
3280 sys_interactive,
3281
3282 [ '#BQ',
3283
3284 [ function,
3285
3286 [ '#COMMA',
3287 sys_value
3288 ]
3289 ]
3290 ]
3291 ]
3292 ],
3293
3294 [ kw_report,
3295
3296 [ setq,
3297 sys_report,
3298
3299 [ if,
3300 [stringp, sys_value],
3301
3302 [ '#BQ',
3303 function(
3304 [ lambda,
3305 [stream],
3306
3307 [ write_string,
3308
3309 [ '#COMMA',
3310 sys_value
3311 ],
3312 stream
3313 ]
3314 ])
3315 ],
3316
3317 [ '#BQ',
3318
3319 [ function,
3320
3321 [ '#COMMA',
3322 sys_value
3323 ]
3324 ]
3325 ]
3326 ]
3327 ]
3328 ],
3329
3330 [ kw_test,
3331
3332 [ setq,
3333 sys_test,
3334
3335 [ '#BQ',
3336
3337 [ function,
3338
3339 [ '#COMMA',
3340 sys_value
3341 ]
3342 ]
3343 ]
3344 ]
3345 ]
3346 ]
3347 ],
3348
3349 [ setq,
3350 rest,
3351 [cddr, rest]
3352 ],
3353 [go, sys_start]
3354 ]
3355 ],
3356
3357 [ push,
3358
3359 [ '#BQ',
3360
3361 [
3362 [ '#COMMA',
3363 [car, sys_clause]
3364 ],
3365 function(
3366 [ lambda,
3367
3368 [ '#COMMA',
3369 [cadr, sys_clause]
3370 ],
3371
3372 [ throw,
3373
3374 [ quote,
3375
3376 [ '#COMMA',
3377 sys_catch_tag
3378 ]
3379 ],
3380
3381 [ progn,
3382
3383 [ '#BQ-COMMA-ELIPSE',
3384 rest
3385 ]
3386 ]
3387 ]
3388 ]),
3389 kw_interactive_function,
3390
3391 [ '#COMMA',
3392 sys_interactive
3393 ],
3394 kw_report_function,
3395
3396 [ '#COMMA',
3397 sys_report
3398 ],
3399 kw_test_function,
3400 ['#COMMA', sys_test]
3401 ]
3402 ],
3403 sys_bindings
3404 ]
3405 ]
3406 ]
3407 ],
3408 ['#COMMA', sys_restartable_form]
3409 ]
3410 ]
3411 ]
3412 ]
3413 ]))).
3414*/
3415/*
3416:- side_effect(assert_lsp(restart_case,
3417 arglist_info(restart_case,
3418 mf_restart_case,
3419
3420 [ sys_restartable_form,
3421 c38_rest,
3422 sys_clauses
3423 ],
3424 arginfo{ all:[sys_restartable_form],
3425 allow_other_keys:0,
3426 aux:0,
3427 body:0,
3428 complex:[rest],
3429 env:0,
3430 key:0,
3431 names:
3432 [ sys_restartable_form,
3433 sys_clauses
3434 ],
3435 opt:0,
3436 req:[sys_restartable_form],
3437 rest:[sys_clauses],
3438 sublists:0,
3439 whole:0
3440 }))).
3441*/
3442/*
3443:- side_effect(assert_lsp(restart_case, init_args(1, mf_restart_case))).
3444*/
3445/*
3446#+(or WAM-CL LISP500)
3447(defun warn (datum &rest arguments)
3448 (restart-case
3449 (let ((warning (if (symbolp datum)
3450 (apply #'make-condition 'warning datum arguments)
3451 datum)))
3452 (signal warning)
3453 (print-object warning *error-output*))
3454 (muffle-warning () nil))
3455 nil)
3456
3457
3458*/
3459
3460/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:12540 **********************/
3461:-lisp_compile_to_prolog(pkg_sys,[defun,warn,[datum,'&rest',arguments],['restart-case',[let,[[warning,[if,[symbolp,datum],[apply,function('make-condition'),[quote,warning],datum,arguments],datum]]],[signal,warning],['print-object',warning,'*error-output*']],['muffle-warning',[],[]]],[]])
3462/*
3463% macroexpand:-[restart_case,[let,[[warning,[if,[symbolp,sys_datum],[apply,function(make_condition),[quote,warning],sys_datum,sys_arguments],sys_datum]]],[signal,warning],[print_object,warning,xx_error_output_xx]],[muffle_warning,[],[]]].
3464*/
3465/*
3466% into:-[catch,[quote,g11],[restart_bind,[[muffle_warning,function([lambda,['#COMMA',[cadr,sys_clause]],[throw,[quote,['#COMMA',sys_catch_tag]],[progn,['#BQ-COMMA-ELIPSE',rest]]]]),kw_interactive_function,function([lambda,[],[]]),kw_report_function,function([lambda,[stream],[format,stream,'$ARRAY'([*],claz_base_character,"~A"),[car,sys_clause]]]),kw_test_function,function([lambda,[condition],t])]],[let,[[warning,[if,[symbolp,sys_datum],[apply,function(make_condition),[quote,warning],sys_datum,sys_arguments],sys_datum]]],[signal,warning],[print_object,warning,xx_error_output_xx]]]].
3467*/
3468wl:lambda_def(defun, warn, f_warn, [sys_datum, c38_rest, sys_arguments], [[restart_case, [let, [[warning, [if, [symbolp, sys_datum], [apply, function(make_condition), [quote, warning], sys_datum, sys_arguments], sys_datum]]], [signal, warning], [print_object, warning, xx_error_output_xx]], [muffle_warning, [], []]], []]).
3469wl:arglist_info(warn, f_warn, [sys_datum, c38_rest, sys_arguments], arginfo{all:[sys_datum], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_datum, sys_arguments], opt:0, req:[sys_datum], rest:[sys_arguments], sublists:0, whole:0}).
3470wl: init_args(1, f_warn).
3471
3476f_warn(Datum_In, RestNKeys, FnResult) :-
3477 _7416=[bv(sys_datum, Datum_In), bv(sys_arguments, RestNKeys)],
3478 catch(( sf_catch([quote, g11],
3479
3480 [ restart_bind,
3481
3482 [
3483 [ muffle_warning,
3484 function(
3485 [ lambda,
3486 ['#COMMA', [cadr, sys_clause]],
3487
3488 [ throw,
3489 [quote, ['#COMMA', sys_catch_tag]],
3490 [progn, ['#BQ-COMMA-ELIPSE', rest]]
3491 ]
3492 ]),
3493 kw_interactive_function,
3494 function([lambda, [], []]),
3495 kw_report_function,
3496 function(
3497 [ lambda,
3498 [stream],
3499
3500 [ format,
3501 stream,
3502 '$ARRAY'([*],
3503 claz_base_character,
3504 "~A"),
3505 [car, sys_clause]
3506 ]
3507 ]),
3508 kw_test_function,
3509 function([lambda, [condition], t])
3510 ]
3511 ],
3512
3513 [ let,
3514
3515 [
3516 [ warning,
3517
3518 [ if,
3519 [symbolp, sys_datum],
3520
3521 [ apply,
3522 function(make_condition),
3523 [quote, warning],
3524 sys_datum,
3525 sys_arguments
3526 ],
3527 sys_datum
3528 ]
3529 ]
3530 ],
3531 [signal, warning],
3532 [print_object, warning, xx_error_output_xx]
3533 ]
3534 ],
3535 Sf_catch_Ret),
3536 []=FnResult
3537 ),
3538 block_exit(warn, FnResult),
3539 true).
3540:- set_opv(warn, symbol_function, f_warn),
3541 DefunResult=warn. 3542/*
3543:- side_effect(assert_lsp(warn,
3544 lambda_def(defun,
3545 warn,
3546 f_warn,
3547 [sys_datum, c38_rest, sys_arguments],
3548
3549 [
3550 [ restart_case,
3551
3552 [ let,
3553
3554 [
3555 [ warning,
3556
3557 [ if,
3558 [symbolp, sys_datum],
3559
3560 [ apply,
3561 function(make_condition),
3562 [quote, warning],
3563 sys_datum,
3564 sys_arguments
3565 ],
3566 sys_datum
3567 ]
3568 ]
3569 ],
3570 [signal, warning],
3571
3572 [ print_object,
3573 warning,
3574 xx_error_output_xx
3575 ]
3576 ],
3577 [muffle_warning, [], []]
3578 ],
3579 []
3580 ]))).
3581*/
3582/*
3583:- side_effect(assert_lsp(warn,
3584 arglist_info(warn,
3585 f_warn,
3586 [sys_datum, c38_rest, sys_arguments],
3587 arginfo{ all:[sys_datum],
3588 allow_other_keys:0,
3589 aux:0,
3590 body:0,
3591 complex:[rest],
3592 env:0,
3593 key:0,
3594 names:
3595 [ sys_datum,
3596 sys_arguments
3597 ],
3598 opt:0,
3599 req:[sys_datum],
3600 rest:[sys_arguments],
3601 sublists:0,
3602 whole:0
3603 }))).
3604*/
3605/*
3606:- side_effect(assert_lsp(warn, init_args(1, f_warn))).
3607*/
3608/*
3609#+(or WAM-CL LISP500)
3610(defun error (datum &rest arguments)
3611 (let ((condition (designator-condition 'simple-error datum arguments)))
3612 (when (typep condition *break-on-signals*)
3613 (invoke-debugger condition))
3614 (invoke-handler condition)
3615 (invoke-debugger condition)))
3616
3617
3618*/
3619
3620/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:12831 **********************/
3621:-lisp_compile_to_prolog(pkg_sys,[defun,error,[datum,'&rest',arguments],[let,[[condition,['designator-condition',[quote,'simple-error'],datum,arguments]]],[when,[typep,condition,'*break-on-signals*'],['invoke-debugger',condition]],['invoke-handler',condition],['invoke-debugger',condition]]])
3622wl:lambda_def(defun, error, f_error, [sys_datum, c38_rest, sys_arguments], [[let, [[condition, [sys_designator_condition, [quote, simple_error], sys_datum, sys_arguments]]], [when, [typep, condition, xx_break_on_signals_xx], [invoke_debugger, condition]], [sys_invoke_handler, condition], [invoke_debugger, condition]]]).
3623wl:arglist_info(error, f_error, [sys_datum, c38_rest, sys_arguments], arginfo{all:[sys_datum], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_datum, sys_arguments], opt:0, req:[sys_datum], rest:[sys_arguments], sublists:0, whole:0}).
3624wl: init_args(0, f_error).
3625
3630f_error(Datum_In, RestNKeys, FnResult) :-
3631 GEnv=[bv(sys_datum, Datum_In), bv(sys_arguments, RestNKeys)],
3632 catch(( ( get_var(GEnv, sys_arguments, Arguments_Get),
3633 get_var(GEnv, sys_datum, Datum_Get),
3634 f_sys_designator_condition(simple_error,
3635 Datum_Get,
3636 Arguments_Get,
3637 Condition_Init),
3638 LEnv=[bv(condition, Condition_Init)|GEnv],
3639 get_var(LEnv, condition, Condition_Get),
3640 get_var(LEnv,
3641 xx_break_on_signals_xx,
3642 Xx_break_on_signals_xx_Get),
3643 f_typep(Condition_Get, Xx_break_on_signals_xx_Get, IFTEST),
3644 ( IFTEST\==[]
3645 -> get_var(LEnv, condition, Condition_Get16),
3646 f_invoke_debugger(Condition_Get16, TrueResult),
3647 _7438=TrueResult
3648 ; _7438=[]
3649 ),
3650 get_var(LEnv, condition, Condition_Get18),
3651 f_sys_invoke_handler(Condition_Get18, Invoke_handler_Ret),
3652 get_var(LEnv, condition, Condition_Get19),
3653 f_invoke_debugger(Condition_Get19, LetResult)
3654 ),
3655 LetResult=FnResult
3656 ),
3657 block_exit(error, FnResult),
3658 true).
3659:- set_opv(error, symbol_function, f_error),
3660 DefunResult=error. 3661/*
3662:- side_effect(assert_lsp(error,
3663 lambda_def(defun,
3664 error,
3665 f_error,
3666 [sys_datum, c38_rest, sys_arguments],
3667
3668 [
3669 [ let,
3670
3671 [
3672 [ condition,
3673
3674 [ sys_designator_condition,
3675 [quote, simple_error],
3676 sys_datum,
3677 sys_arguments
3678 ]
3679 ]
3680 ],
3681
3682 [ when,
3683
3684 [ typep,
3685 condition,
3686 xx_break_on_signals_xx
3687 ],
3688 [invoke_debugger, condition]
3689 ],
3690 [sys_invoke_handler, condition],
3691 [invoke_debugger, condition]
3692 ]
3693 ]))).
3694*/
3695/*
3696:- side_effect(assert_lsp(error,
3697 arglist_info(error,
3698 f_error,
3699 [sys_datum, c38_rest, sys_arguments],
3700 arginfo{ all:[sys_datum],
3701 allow_other_keys:0,
3702 aux:0,
3703 body:0,
3704 complex:[rest],
3705 env:0,
3706 key:0,
3707 names:
3708 [ sys_datum,
3709 sys_arguments
3710 ],
3711 opt:0,
3712 req:[sys_datum],
3713 rest:[sys_arguments],
3714 sublists:0,
3715 whole:0
3716 }))).
3717*/
3718/*
3719:- side_effect(assert_lsp(error, init_args(0, f_error))).
3720*/
3721/*
3722#+(or WAM-CL LISP500)
3723(defun cerror (continue-format-control datum &rest arguments)
3724 (with-simple-restart (continue continue-format-control)
3725 (apply #'error datum arguments)))
3726
3727
3728*/
3729
3730/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:13123 **********************/
3731:-lisp_compile_to_prolog(pkg_sys,[defun,cerror,['continue-format-control',datum,'&rest',arguments],['with-simple-restart',[continue,'continue-format-control'],[apply,function(error),datum,arguments]]])
3732wl:lambda_def(defun, cerror, f_cerror, [sys_continue_format_control, sys_datum, c38_rest, sys_arguments], [[with_simple_restart, [continue, sys_continue_format_control], [apply, function(error), sys_datum, sys_arguments]]]).
3733wl:arglist_info(cerror, f_cerror, [sys_continue_format_control, sys_datum, c38_rest, sys_arguments], arginfo{all:[sys_continue_format_control, sys_datum], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_continue_format_control, sys_datum, sys_arguments], opt:0, req:[sys_continue_format_control, sys_datum], rest:[sys_arguments], sublists:0, whole:0}).
3734wl: init_args(2, f_cerror).
3735
3740f_cerror(Continue_format_control_In, Datum_In, RestNKeys, FnResult) :-
3741 Simple_restart_Param=[bv(sys_continue_format_control, Continue_format_control_In), bv(sys_datum, Datum_In), bv(sys_arguments, RestNKeys)],
3742 catch(( sf_with_simple_restart(Simple_restart_Param,
3743 [continue, sys_continue_format_control],
3744
3745 [ apply,
3746 function(error),
3747 sys_datum,
3748 sys_arguments
3749 ],
3750 Simple_restart_Ret),
3751 Simple_restart_Ret=FnResult
3752 ),
3753 block_exit(cerror, FnResult),
3754 true).
3755:- set_opv(cerror, symbol_function, f_cerror),
3756 DefunResult=cerror. 3757/*
3758:- side_effect(assert_lsp(cerror,
3759 lambda_def(defun,
3760 cerror,
3761 f_cerror,
3762
3763 [ sys_continue_format_control,
3764 sys_datum,
3765 c38_rest,
3766 sys_arguments
3767 ],
3768
3769 [
3770 [ with_simple_restart,
3771
3772 [ continue,
3773 sys_continue_format_control
3774 ],
3775
3776 [ apply,
3777 function(error),
3778 sys_datum,
3779 sys_arguments
3780 ]
3781 ]
3782 ]))).
3783*/
3784/*
3785:- side_effect(assert_lsp(cerror,
3786 arglist_info(cerror,
3787 f_cerror,
3788
3789 [ sys_continue_format_control,
3790 sys_datum,
3791 c38_rest,
3792 sys_arguments
3793 ],
3794 arginfo{ all:
3795 [ sys_continue_format_control,
3796 sys_datum
3797 ],
3798 allow_other_keys:0,
3799 aux:0,
3800 body:0,
3801 complex:[rest],
3802 env:0,
3803 key:0,
3804 names:
3805 [ sys_continue_format_control,
3806 sys_datum,
3807 sys_arguments
3808 ],
3809 opt:0,
3810 req:
3811 [ sys_continue_format_control,
3812 sys_datum
3813 ],
3814 rest:[sys_arguments],
3815 sublists:0,
3816 whole:0
3817 }))).
3818*/
3819/*
3820:- side_effect(assert_lsp(cerror, init_args(2, f_cerror))).
3821*/
3822/*
3823#+(or WAM-CL LISP500)
3824(defun signal (datum &rest arguments)
3825 (let ((condition (designator-condition 'simple-condition datum arguments)))
3826 (when (typep condition *break-on-signals*)
3827 (invoke-debugger condition))
3828 (invoke-handler condition)
3829 nil))
3830
3831
3832
3833*/
3834
3835/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-20.lisp:13312 **********************/
3836:-lisp_compile_to_prolog(pkg_sys,[defun,signal,[datum,'&rest',arguments],[let,[[condition,['designator-condition',[quote,'simple-condition'],datum,arguments]]],[when,[typep,condition,'*break-on-signals*'],['invoke-debugger',condition]],['invoke-handler',condition],[]]])
3837wl:lambda_def(defun, signal, f_signal, [sys_datum, c38_rest, sys_arguments], [[let, [[condition, [sys_designator_condition, [quote, simple_condition], sys_datum, sys_arguments]]], [when, [typep, condition, xx_break_on_signals_xx], [invoke_debugger, condition]], [sys_invoke_handler, condition], []]]).
3838wl:arglist_info(signal, f_signal, [sys_datum, c38_rest, sys_arguments], arginfo{all:[sys_datum], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_datum, sys_arguments], opt:0, req:[sys_datum], rest:[sys_arguments], sublists:0, whole:0}).
3839wl: init_args(1, f_signal).
3840
3845f_signal(Datum_In, RestNKeys, FnResult) :-
3846 GEnv=[bv(sys_datum, Datum_In), bv(sys_arguments, RestNKeys)],
3847 catch(( ( get_var(GEnv, sys_arguments, Arguments_Get),
3848 get_var(GEnv, sys_datum, Datum_Get),
3849 f_sys_designator_condition(simple_condition,
3850 Datum_Get,
3851 Arguments_Get,
3852 Condition_Init),
3853 LEnv=[bv(condition, Condition_Init)|GEnv],
3854 get_var(LEnv, condition, Condition_Get),
3855 get_var(LEnv,
3856 xx_break_on_signals_xx,
3857 Xx_break_on_signals_xx_Get),
3858 f_typep(Condition_Get, Xx_break_on_signals_xx_Get, IFTEST),
3859 ( IFTEST\==[]
3860 -> get_var(LEnv, condition, Condition_Get16),
3861 f_invoke_debugger(Condition_Get16, TrueResult),
3862 _7382=TrueResult
3863 ; _7382=[]
3864 ),
3865 get_var(LEnv, condition, Condition_Get18),
3866 f_sys_invoke_handler(Condition_Get18, Invoke_handler_Ret)
3867 ),
3868 []=FnResult
3869 ),
3870 block_exit(signal, FnResult),
3871 true).
3872:- set_opv(signal, symbol_function, f_signal),
3873 DefunResult=signal. 3934
3935