1#!/usr/bin/env swipl
6
7:-style_check(-discontiguous). 8:-style_check(-singleton). 9:-use_module(library(wamcl_runtime)). 10
11/*
12;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
13*/
14/*
15;;; Copyright (c) 1990, Giuseppe Attardi.
16*/
17/*
18;;;
19*/
20/*
21;;; This program is free software; you can redistribute it and/or
22*/
23/*
24;;; modify it under the terms of the GNU Library General Public
25*/
26/*
27;;; License as published by the Free Software Foundation; either
28*/
29/*
30;;; version 2 of the License, or (at your option) any later version.
31*/
32/*
33;;;
34*/
35/*
36;;; See file '../Copyright' for full details.
37*/
38/*
39;; DESCRIBE and INSPECT
40*/
41/*
42(in-package #:lisp)
43
44*/
45
46/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:494 **********************/
47:-lisp_compile_to_prolog(pkg_user,['in-package','#:lisp'])
48/*
49% macroexpand:-[in_package,lisp1].
50*/
51/*
52% into:-[eval_when,[kw_compile_toplevel,kw_load_toplevel,kw_execute],[sys_select_package,'$ARRAY'([*],claz_base_character,"LISP")]].
53*/
54:- do_when([kw_compile_toplevel, kw_load_toplevel, kw_execute],
55 f_sys_select_package('$ARRAY'([*], claz_base_character, "LISP"),
56 _Ignored),
57 _Ignored).
58/*
59#+AKCL (import 'sys::arglist 'lisp)
60
61*/
62
63/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:517 **********************/
64:-lisp_compile_to_prolog(pkg_cl,'$COMMENT'([flag_removed,[+,':AKCL'],[import,[quote,'sys::arglist'],[quote,lisp]]]))
65/*
66(export '(arglist describe inspect))
67*/
68
69/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:554 **********************/
70:-lisp_compile_to_prolog(pkg_cl,[export,[quote,[arglist,describe,inspect]]])
71:- f_export([sys_arglist, describe, inspect], [], _Ignored).
72/*
73(export '(documentation variable function structure type setf))
74
75*/
76
77/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:591 **********************/
78:-lisp_compile_to_prolog(pkg_cl,[export,[quote,[documentation,variable,function,structure,type,setf]]])
79:- f_export([documentation, variable, function, structure, type, setf], [], _Ignored).
80/*
81(in-package #:system)
82
83*/
84
85/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:656 **********************/
86:-lisp_compile_to_prolog(pkg_cl,['in-package','#:system'])
87/*
88% macroexpand:-[in_package,system1].
89*/
90/*
91% into:-[eval_when,[kw_compile_toplevel,kw_load_toplevel,kw_execute],[sys_select_package,'$ARRAY'([*],claz_base_character,"SYSTEM")]].
92*/
93:- do_when([kw_compile_toplevel, kw_load_toplevel, kw_execute],
94 f_sys_select_package('$ARRAY'([*], claz_base_character, "SYSTEM"),
95 _Ignored),
96 _Ignored).
97/*
98(proclaim '(optimize (safety 2) (space 3)))
99
100*/
101
102/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:679 **********************/
103:-lisp_compile_to_prolog(pkg_sys,[proclaim,[quote,[optimize,[safety,2],[space,3]]]])
104:- sf_proclaim(Sf_proclaim_Param,
105 [quote, [optimize, [safety, 2], [space, 3]]],
106 _Ignored).
107/*
108(defvar *inspect-level* 0)
109*/
110
111/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:724 **********************/
112:-lisp_compile_to_prolog(pkg_sys,[defvar,'*inspect-level*',0])
113:- set_var(AEnv, sys_xx_inspect_level_xx, 0).
114/*
115(defvar *inspect-history* nil)
116*/
117
118/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:751 **********************/
119:-lisp_compile_to_prolog(pkg_sys,[defvar,'*inspect-history*',[]])
120:- set_var(AEnv, sys_xx_inspect_history_xx, []).
121/*
122(defvar *inspect-mode* nil)
123
124*/
125
126/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:782 **********************/
127:-lisp_compile_to_prolog(pkg_sys,[defvar,'*inspect-mode*',[]])
128:- set_var(AEnv, sys_xx_inspect_mode_xx, []).
129/*
130(defvar *old-print-level* nil)
131*/
132
133/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:811 **********************/
134:-lisp_compile_to_prolog(pkg_sys,[defvar,'*old-print-level*',[]])
135:- set_var(AEnv, sys_xx_old_print_level_xx, []).
136/*
137(defvar *old-print-length* nil)
138
139
140*/
141
142/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:842 **********************/
143:-lisp_compile_to_prolog(pkg_sys,[defvar,'*old-print-length*',[]])
144:- set_var(AEnv, sys_xx_old_print_length_xx, []).
145/*
146(defun inspect-read-line ()
147 (do ((char (read-char *query-io*) (read-char *query-io*)))
148 ((or (char= char #\Newline) (char= char #\Return)))))
149
150*/
151
152/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:876 **********************/
153:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-read-line',[],[do,[[char,['read-char','*query-io*'],['read-char','*query-io*']]],[[or,['char=',char,#\('\n')],['char=',char,#\('\r')]]]]])
154/*
155:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
156 sys_inspect_read_line,
157 kw_function,
158 f_sys_inspect_read_line)).
159*/
160wl:lambda_def(defun, sys_inspect_read_line, f_sys_inspect_read_line, [], [[do, [[char, [read_char, xx_query_io_xx], [read_char, xx_query_io_xx]]], [[or, [char_c61, char|"\n"], [char_c61, char|"\r"]]]]]).
161wl:arglist_info(sys_inspect_read_line, f_sys_inspect_read_line, [], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[], opt:0, req:0, rest:0, sublists:0, whole:0}).
162wl: init_args(x, f_sys_inspect_read_line).
163
168f_sys_inspect_read_line(FnResult) :-
169 GEnv=[],
170 catch(( ( get_var(GEnv, xx_query_io_xx, Xx_query_io_xx_Get),
171 f_read_char([Xx_query_io_xx_Get], Char_Init),
172 AEnv=[bv(char, Char_Init)|GEnv],
173 catch(( call_addr_block(AEnv,
174 (push_label(do_label_1), (get_var(AEnv, char, Char_Get27), f_char_c61(Char_Get27, "\n", FORM1_Res29), FORM1_Res29\==[], IFTEST25=FORM1_Res29->true;get_var(AEnv, char, Char_Get28), f_char_c61(Char_Get28, "\r", Char_c61_Ret), IFTEST25=Char_c61_Ret), (IFTEST25\==[]->throw(block_exit([], [])), _TBResult=ThrowResult31;get_var(AEnv, xx_query_io_xx, Xx_query_io_xx_Get34), f_read_char([Xx_query_io_xx_Get34], Char), set_var(AEnv, char, Char), goto(do_label_1, AEnv), _TBResult=_GORES35)),
175
176 [ addr(addr_tagbody_1_do_label_1,
177 do_label_1,
178 '$unused',
179 AEnv,
180 ((get_var(AEnv, char, Char_c61_Param), f_char_c61(Char_c61_Param, "\n", Char_c61_Ret45), Char_c61_Ret45\==[], IFTEST=Char_c61_Ret45->true;get_var(AEnv, char, Char_Get13), f_char_c61(Char_Get13, "\r", Char_c61_Ret46), IFTEST=Char_c61_Ret46), (IFTEST\==[]->throw(block_exit([], [])), _3970=ThrowResult;get_var(AEnv, xx_query_io_xx, Xx_query_io_xx_Get19), f_read_char([Xx_query_io_xx_Get19], Read_char_Ret), set_var(AEnv, char, Read_char_Ret), goto(do_label_1, AEnv), _3970=_GORES)))
181 ]),
182 []=LetResult
183 ),
184 block_exit([], LetResult),
185 true)
186 ),
187 LetResult=FnResult
188 ),
189 block_exit(sys_inspect_read_line, FnResult),
190 true).
191:- set_opv(sys_inspect_read_line, symbol_function, f_sys_inspect_read_line),
192 DefunResult=sys_inspect_read_line. 193/*
194:- side_effect(assert_lsp(sys_inspect_read_line,
195 lambda_def(defun,
196 sys_inspect_read_line,
197 f_sys_inspect_read_line,
198 [],
199
200 [
201 [ do,
202
203 [
204 [ char,
205 [read_char, xx_query_io_xx],
206 [read_char, xx_query_io_xx]
207 ]
208 ],
209
210 [
211 [ or,
212 [char_c61, char|"\n"],
213 [char_c61, char|"\r"]
214 ]
215 ]
216 ]
217 ]))).
218*/
219/*
220:- side_effect(assert_lsp(sys_inspect_read_line,
221 arglist_info(sys_inspect_read_line,
222 f_sys_inspect_read_line,
223 [],
224 arginfo{ all:0,
225 allow_other_keys:0,
226 aux:0,
227 body:0,
228 complex:0,
229 env:0,
230 key:0,
231 names:[],
232 opt:0,
233 req:0,
234 rest:0,
235 sublists:0,
236 whole:0
237 }))).
238*/
239/*
240:- side_effect(assert_lsp(sys_inspect_read_line,
241 init_args(x, f_sys_inspect_read_line))).
242*/
243/*
244(defun select-P (object)
245 (let ((*print-pretty* t) (*print-level* nil) (*print-length* nil))
246 (prin1 object)
247 (terpri)))
248
249*/
250
251/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:1026 **********************/
252:-lisp_compile_to_prolog(pkg_sys,[defun,'select-P',[object],[let,[['*print-pretty*',t],['*print-level*',[]],['*print-length*',[]]],[prin1,object],[terpri]]])
253/*
254:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
255 sys_select_p,
256 kw_function,
257 f_sys_select_p)).
258*/
259wl:lambda_def(defun, sys_select_p, f_sys_select_p, [sys_object], [[let, [[xx_print_pretty_xx, t], [xx_print_level_xx, []], [xx_print_length_xx, []]], [prin1, sys_object], [terpri]]]).
260wl:arglist_info(sys_select_p, f_sys_select_p, [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}).
261wl: init_args(x, f_sys_select_p).
262
267f_sys_select_p(Object_In, FnResult) :-
268 _3044=[bv(sys_object, Object_In)],
269 catch(( ( LEnv=_3044,
270 maplist(save_special,
271
272 [ sv(xx_print_pretty_xx, t, symbol_value, Symbol_value),
273 sv(xx_print_level_xx,
274 [],
275 symbol_value,
276 Symbol_value12),
277 sv(xx_print_length_xx,
278 [],
279 symbol_value,
280 Symbol_value13)
281 ]),
282 get_var(LEnv, sys_object, Object_Get),
283 f_prin1(Object_Get, [], Prin1_Ret),
284 f_terpri([], LetResult),
285 maplist(restore_special,
286
287 [ sv(xx_print_pretty_xx, t, symbol_value, Symbol_value),
288 sv(xx_print_level_xx,
289 [],
290 symbol_value,
291 Symbol_value12),
292 sv(xx_print_length_xx,
293 [],
294 symbol_value,
295 Symbol_value13)
296 ])
297 ),
298 LetResult=FnResult
299 ),
300 block_exit(sys_select_p, FnResult),
301 true).
302:- set_opv(sys_select_p, symbol_function, f_sys_select_p),
303 DefunResult=sys_select_p. 304/*
305:- side_effect(assert_lsp(sys_select_p,
306 lambda_def(defun,
307 sys_select_p,
308 f_sys_select_p,
309 [sys_object],
310
311 [
312 [ let,
313
314 [ [xx_print_pretty_xx, t],
315 [xx_print_level_xx, []],
316 [xx_print_length_xx, []]
317 ],
318 [prin1, sys_object],
319 [terpri]
320 ]
321 ]))).
322*/
323/*
324:- side_effect(assert_lsp(sys_select_p,
325 arglist_info(sys_select_p,
326 f_sys_select_p,
327 [sys_object],
328 arginfo{ all:[sys_object],
329 allow_other_keys:0,
330 aux:0,
331 body:0,
332 complex:0,
333 env:0,
334 key:0,
335 names:[sys_object],
336 opt:0,
337 req:[sys_object],
338 rest:0,
339 sublists:0,
340 whole:0
341 }))).
342*/
343/*
344:- side_effect(assert_lsp(sys_select_p, init_args(x, f_sys_select_p))).
345*/
346/*
347(defun select-E ()
348 (dolist (x (multiple-value-list
349 (multiple-value-prog1
350 (eval (read-preserving-whitespace *query-io*))
351 (inspect-read-line))))
352 (write x
353 :level *old-print-level*
354 :length *old-print-length*)
355 (terpri)))
356
357*/
358
359/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:1161 **********************/
360:-lisp_compile_to_prolog(pkg_sys,[defun,'select-E',[],[dolist,[x,['multiple-value-list',['multiple-value-prog1',[eval,['read-preserving-whitespace','*query-io*']],['inspect-read-line']]]],[write,x,':level','*old-print-level*',':length','*old-print-length*'],[terpri]]])
361/*
362:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
363 sys_select_e,
364 kw_function,
365 f_sys_select_e)).
366*/
367wl:lambda_def(defun, sys_select_e, f_sys_select_e, [], [[dolist, [sys_x, [multiple_value_list, [multiple_value_prog1, [eval, [read_preserving_whitespace, xx_query_io_xx]], [sys_inspect_read_line]]]], [write, sys_x, kw_level, sys_xx_old_print_level_xx, kw_length, sys_xx_old_print_length_xx], [terpri]]]).
368wl:arglist_info(sys_select_e, f_sys_select_e, [], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[], opt:0, req:0, rest:0, sublists:0, whole:0}).
369wl: init_args(x, f_sys_select_e).
370
375f_sys_select_e(FnResult) :-
376 Value_prog1_Param=[],
377 catch(( ( sf_multiple_value_prog1(Value_prog1_Param,
378
379 [ eval,
380
381 [ read_preserving_whitespace,
382 xx_query_io_xx
383 ]
384 ],
385 [sys_inspect_read_line],
386 IgnoredRet),
387 nb_current('$mv_return', MV_RETURN),
388 BV=bv(sys_x, Ele),
389 Env2=[BV|Value_prog1_Param],
390 forall(member(Ele, MV_RETURN),
391 ( nb_setarg(2, BV, Ele),
392 get_var(Env2, sys_x, X_Get),
393 get_var(Env2,
394 sys_xx_old_print_length_xx,
395 Xx_old_print_length_xx_Get),
396 get_var(Env2,
397 sys_xx_old_print_level_xx,
398 Xx_old_print_level_xx_Get),
399 f_write(X_Get,
400 kw_level,
401 Xx_old_print_level_xx_Get,
402 kw_length,
403 Xx_old_print_length_xx_Get,
404 Write_Ret),
405 f_terpri([], Terpri_Ret)
406 ))
407 ),
408 Terpri_Ret=FnResult
409 ),
410 block_exit(sys_select_e, FnResult),
411 true).
412:- set_opv(sys_select_e, symbol_function, f_sys_select_e),
413 DefunResult=sys_select_e. 414/*
415:- side_effect(assert_lsp(sys_select_e,
416 lambda_def(defun,
417 sys_select_e,
418 f_sys_select_e,
419 [],
420
421 [
422 [ dolist,
423
424 [ sys_x,
425
426 [ multiple_value_list,
427
428 [ multiple_value_prog1,
429
430 [ eval,
431
432 [ read_preserving_whitespace,
433 xx_query_io_xx
434 ]
435 ],
436 [sys_inspect_read_line]
437 ]
438 ]
439 ],
440
441 [ write,
442 sys_x,
443 kw_level,
444 sys_xx_old_print_level_xx,
445 kw_length,
446 sys_xx_old_print_length_xx
447 ],
448 [terpri]
449 ]
450 ]))).
451*/
452/*
453:- side_effect(assert_lsp(sys_select_e,
454 arglist_info(sys_select_e,
455 f_sys_select_e,
456 [],
457 arginfo{ all:0,
458 allow_other_keys:0,
459 aux:0,
460 body:0,
461 complex:0,
462 env:0,
463 key:0,
464 names:[],
465 opt:0,
466 req:0,
467 rest:0,
468 sublists:0,
469 whole:0
470 }))).
471*/
472/*
473:- side_effect(assert_lsp(sys_select_e, init_args(x, f_sys_select_e))).
474*/
475/*
476(defun select-U ()
477 (prog1
478 (eval (read-preserving-whitespace *query-io*))
479 (inspect-read-line)))
480
481*/
482
483/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:1406 **********************/
484:-lisp_compile_to_prolog(pkg_sys,[defun,'select-U',[],[prog1,[eval,['read-preserving-whitespace','*query-io*']],['inspect-read-line']]])
485/*
486:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
487 sys_select_u,
488 kw_function,
489 f_sys_select_u)).
490*/
491wl:lambda_def(defun, sys_select_u, f_sys_select_u, [], [[prog1, [eval, [read_preserving_whitespace, xx_query_io_xx]], [sys_inspect_read_line]]]).
492wl:arglist_info(sys_select_u, f_sys_select_u, [], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[], opt:0, req:0, rest:0, sublists:0, whole:0}).
493wl: init_args(x, f_sys_select_u).
494
499f_sys_select_u(FnResult) :-
500 GEnv=[],
501 catch(( ( get_var(GEnv, xx_query_io_xx, Xx_query_io_xx_Get),
502 f_read_preserving_whitespace([Xx_query_io_xx_Get],
503 Preserving_whitespace_Ret),
504 f_sys_env_eval(GEnv, Preserving_whitespace_Ret, Env_eval_Ret),
505 f_sys_inspect_read_line(Read_line_Ret)
506 ),
507 Env_eval_Ret=FnResult
508 ),
509 block_exit(sys_select_u, FnResult),
510 true).
511:- set_opv(sys_select_u, symbol_function, f_sys_select_u),
512 DefunResult=sys_select_u. 513/*
514:- side_effect(assert_lsp(sys_select_u,
515 lambda_def(defun,
516 sys_select_u,
517 f_sys_select_u,
518 [],
519
520 [
521 [ prog1,
522
523 [ eval,
524
525 [ read_preserving_whitespace,
526 xx_query_io_xx
527 ]
528 ],
529 [sys_inspect_read_line]
530 ]
531 ]))).
532*/
533/*
534:- side_effect(assert_lsp(sys_select_u,
535 arglist_info(sys_select_u,
536 f_sys_select_u,
537 [],
538 arginfo{ all:0,
539 allow_other_keys:0,
540 aux:0,
541 body:0,
542 complex:0,
543 env:0,
544 key:0,
545 names:[],
546 opt:0,
547 req:0,
548 rest:0,
549 sublists:0,
550 whole:0
551 }))).
552*/
553/*
554:- side_effect(assert_lsp(sys_select_u, init_args(x, f_sys_select_u))).
555*/
556/*
557(defun select-? ()
558 (terpri)
559 (format t
560 "Inspect commands:"(defun select-? ()\n (terpri)\n (format t\n\t \"Inspect commands:~%~\n n (or N or Newline): inspects the field (recursively).~%~\n s (or S): skips the field.~%~\n p (or P): pretty-prints the field.~%~\n a (or A): aborts the inspection ~\n of the rest of the fields.~%~\n u (or U) form: updates the field ~\n with the value of the form.~%~\n e (or E) form: evaluates and prints the form.~%~\n q (or Q): quits the inspection.~%~\n ?: prints this.~%~%\"))\n\n".
561*/
562
563/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:1512 **********************/
564:-lisp_compile_to_prolog(pkg_sys,[defun,'select-?',[],[terpri],[format,t,'$STRING'("Inspect commands:~%~\n n (or N or Newline): inspects the field (recursively).~%~\n s (or S): skips the field.~%~\n p (or P): pretty-prints the field.~%~\n a (or A): aborts the inspection ~\n of the rest of the fields.~%~\n u (or U) form: updates the field ~\n with the value of the form.~%~\n e (or E) form: evaluates and prints the form.~%~\n q (or Q): quits the inspection.~%~\n ?: prints this.~%~%")]])
565/*
566:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
567 sys_select_c63,
568 kw_function,
569 f_sys_select_c63)).
570*/
571wl:lambda_def(defun, sys_select_c63, f_sys_select_c63, [], [[terpri], [format, t, '$ARRAY'([*], claz_base_character, "Inspect commands:~%~\n n (or N or Newline): inspects the field (recursively).~%~\n s (or S): skips the field.~%~\n p (or P): pretty-prints the field.~%~\n a (or A): aborts the inspection ~\n of the rest of the fields.~%~\n u (or U) form: updates the field ~\n with the value of the form.~%~\n e (or E) form: evaluates and prints the form.~%~\n q (or Q): quits the inspection.~%~\n ?: prints this.~%~%")]]).
572wl:arglist_info(sys_select_c63, f_sys_select_c63, [], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[], opt:0, req:0, rest:0, sublists:0, whole:0}).
573wl: init_args(x, f_sys_select_c63).
574
579f_sys_select_c63(FnResult) :-
580 _9908=[],
581 catch(( ( f_terpri([], Terpri_Ret),
582 f_format(t,
583 '$ARRAY'([*],
584 claz_base_character,
585 "Inspect commands:~%~\n n (or N or Newline): inspects the field (recursively).~%~\n s (or S): skips the field.~%~\n p (or P): pretty-prints the field.~%~\n a (or A): aborts the inspection ~\n of the rest of the fields.~%~\n u (or U) form: updates the field ~\n with the value of the form.~%~\n e (or E) form: evaluates and prints the form.~%~\n q (or Q): quits the inspection.~%~\n ?: prints this.~%~%"),
586 [],
587 Format_Ret)
588 ),
589 Format_Ret=FnResult
590 ),
591 block_exit(sys_select_c63, FnResult),
592 true).
593:- set_opv(sys_select_c63, symbol_function, f_sys_select_c63),
594 DefunResult=sys_select_c63. 595/*
596:- side_effect(assert_lsp(sys_select_c63,
597 lambda_def(defun,
598 sys_select_c63,
599 f_sys_select_c63,
600 [],
601
602 [ [terpri],
603
604 [ format,
605 t,
606 '$ARRAY'([*],
607 claz_base_character,
608 "Inspect commands:~%~\n n (or N or Newline): inspects the field (recursively).~%~\n s (or S): skips the field.~%~\n p (or P): pretty-prints the field.~%~\n a (or A): aborts the inspection ~\n of the rest of the fields.~%~\n u (or U) form: updates the field ~\n with the value of the form.~%~\n e (or E) form: evaluates and prints the form.~%~\n q (or Q): quits the inspection.~%~\n ?: prints this.~%~%")
609 ]
610 ]))).
611*/
612/*
613:- side_effect(assert_lsp(sys_select_c63,
614 arglist_info(sys_select_c63,
615 f_sys_select_c63,
616 [],
617 arginfo{ all:0,
618 allow_other_keys:0,
619 aux:0,
620 body:0,
621 complex:0,
622 env:0,
623 key:0,
624 names:[],
625 opt:0,
626 req:0,
627 rest:0,
628 sublists:0,
629 whole:0
630 }))).
631*/
632/*
633:- side_effect(assert_lsp(sys_select_c63, init_args(x, f_sys_select_c63))).
634*/
635/*
636(defun read-inspect-command (label object allow-recursive)
637 (unless *inspect-mode*
638 (inspect-indent-1)
639 (if allow-recursive
640 (progn (princ label) (inspect-object object))
641 (format t label object))
642 (return-from read-inspect-command nil))
643 (loop
644 (inspect-indent-1)
645 (if allow-recursive
646 (progn (princ label)
647 (inspect-indent)
648 (prin1 object))
649 (format t label object))
650 (write-char #\Space)
651 (force-output)
652 (case (do ((char (read-char *query-io*) (read-char *query-io*)))
653 ((and (char/= char #\Space) (char/= #\Tab)) char))
654 ((#\Newline #\Return)
655 (when allow-recursive (inspect-object object))
656 (return nil))
657 ((#\n #\N)
658 (inspect-read-line)
659 (when allow-recursive (inspect-object object))
660 (return nil))
661 ((#\s #\S)
662 (inspect-read-line)
663 (return nil))
664 ((#\p #\P)
665 (inspect-read-line)
666 (select-P object))
667 ((#\a #\A)
668 (inspect-read-line)
669 (throw 'ABORT-INSPECT nil))
670 ((#\u #\U)
671 (return (values t (select-U))))
672 ((#\e #\E)
673 (select-E))
674 ((#\q #\Q)
675 (inspect-read-line)
676 (throw 'QUIT-INSPECT nil))
677 ((#\?)
678 (inspect-read-line)
679 (select-?))
680 (t
681 (inspect-read-line))
682 )))
683
684*/
685
686/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:2249 **********************/
687:-lisp_compile_to_prolog(pkg_sys,[defun,'read-inspect-command',[label,object,'allow-recursive'],[unless,'*inspect-mode*',['inspect-indent-1'],[if,'allow-recursive',[progn,[princ,label],['inspect-object',object]],[format,t,label,object]],['return-from','read-inspect-command',[]]],[loop,['inspect-indent-1'],[if,'allow-recursive',[progn,[princ,label],['inspect-indent'],[prin1,object]],[format,t,label,object]],['write-char',#\(' ')],['force-output'],[case,[do,[[char,['read-char','*query-io*'],['read-char','*query-io*']]],[[and,['char/=',char,#\(' ')],['char/=',#\('\t')]],char]],[[#\('\n'),#\('\r')],[when,'allow-recursive',['inspect-object',object]],[return,[]]],[[#\(n),#\('N')],['inspect-read-line'],[when,'allow-recursive',['inspect-object',object]],[return,[]]],[[#\(s),#\('S')],['inspect-read-line'],[return,[]]],[[#\(p),#\('P')],['inspect-read-line'],['select-P',object]],[[#\(a),#\('A')],['inspect-read-line'],[throw,[quote,'ABORT-INSPECT'],[]]],[[#\(u),#\('U')],[return,[values,t,['select-U']]]],[[#\(e),#\('E')],['select-E']],[[#\(q),#\('Q')],['inspect-read-line'],[throw,[quote,'QUIT-INSPECT'],[]]],[[#\(?)],['inspect-read-line'],['select-?']],[t,['inspect-read-line']]]]])
688/*
689:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
690 sys_read_inspect_command,
691 kw_function,
692 f_sys_read_inspect_command)).
693*/
694/*
695:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
696 sys_inspect_indent_1,
697 kw_function,
698 f_sys_inspect_indent_1)).
699*/
700/*
701:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
702 sys_inspect_object,
703 kw_function,
704 f_sys_inspect_object)).
705*/
706wl:lambda_def(defun, sys_read_inspect_command, f_sys_read_inspect_command, [sys_label, sys_object, sys_allow_recursive], [[unless, sys_xx_inspect_mode_xx, [sys_inspect_indent_1], [if, sys_allow_recursive, [progn, [princ, sys_label], [sys_inspect_object, sys_object]], [format, t, sys_label, sys_object]], [return_from, sys_read_inspect_command, []]], [loop, [sys_inspect_indent_1], [if, sys_allow_recursive, [progn, [princ, sys_label], [sys_inspect_indent], [prin1, sys_object]], [format, t, sys_label, sys_object]], [write_char|" "], [force_output], [case, [do, [[char, [read_char, xx_query_io_xx], [read_char, xx_query_io_xx]]], [[and, [char_c47_c61, char|" "], [char_c47_c61|"\t"]], char]], ["\n\r", [when, sys_allow_recursive, [sys_inspect_object, sys_object]], [return, []]], ["nN", [sys_inspect_read_line], [when, sys_allow_recursive, [sys_inspect_object, sys_object]], [return, []]], ["sS", [sys_inspect_read_line], [return, []]], ["pP", [sys_inspect_read_line], [sys_select_p, sys_object]], ["aA", [sys_inspect_read_line], [throw, [quote, sys_abort_inspect], []]], ["uU", [return, [values, t, [sys_select_u]]]], ["eE", [sys_select_e]], ["qQ", [sys_inspect_read_line], [throw, [quote, sys_quit_inspect], []]], ["?", [sys_inspect_read_line], [sys_select_c63]], [t, [sys_inspect_read_line]]]]]).
707wl:arglist_info(sys_read_inspect_command, f_sys_read_inspect_command, [sys_label, sys_object, sys_allow_recursive], arginfo{all:[sys_label, sys_object, sys_allow_recursive], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_label, sys_object, sys_allow_recursive], opt:0, req:[sys_label, sys_object, sys_allow_recursive], rest:0, sublists:0, whole:0}).
708wl: init_args(x, f_sys_read_inspect_command).
709
714f_sys_read_inspect_command(Label_In, Object_In, Allow_recursive_In, FnResult) :-
715 BlockExitEnv=[bv(sys_label, Label_In), bv(sys_object, Object_In), bv(sys_allow_recursive, Allow_recursive_In)],
716 catch(( ( get_var(BlockExitEnv, sys_xx_inspect_mode_xx, IFTEST),
717 ( IFTEST\==[]
718 -> _7560=[]
719 ; f_sys_inspect_indent_1(Indent_1_Ret),
720 get_var(BlockExitEnv, sys_allow_recursive, IFTEST10),
721 ( IFTEST10\==[]
722 -> get_var(BlockExitEnv, sys_label, Label_Get),
723 f_princ(Label_Get, [], Princ_Ret),
724 get_var(BlockExitEnv, sys_object, Object_Get),
725 f_sys_inspect_object(Object_Get, TrueResult),
726 _7620=TrueResult
727 ; get_var(BlockExitEnv, sys_label, Label_Get15),
728 get_var(BlockExitEnv, sys_object, Object_Get16),
729 f_format(t, Label_Get15, [Object_Get16], ElseResult),
730 _7620=ElseResult
731 ),
732 throw(block_exit(sys_read_inspect_command, [])),
733 _7560=ThrowResult
734 ),
735 sf_loop(BlockExitEnv,
736 [sys_inspect_indent_1],
737
738 [ if,
739 sys_allow_recursive,
740
741 [ progn,
742 [princ, sys_label],
743 [sys_inspect_indent],
744 [prin1, sys_object]
745 ],
746 [format, t, sys_label, sys_object]
747 ],
748 [write_char|" "],
749 [force_output],
750
751 [ case,
752
753 [ do,
754
755 [
756 [ char,
757 [read_char, xx_query_io_xx],
758 [read_char, xx_query_io_xx]
759 ]
760 ],
761
762 [
763 [ and,
764 [char_c47_c61, char|" "],
765 [char_c47_c61|"\t"]
766 ],
767 char
768 ]
769 ],
770
771 [ "\n\r",
772
773 [ when,
774 sys_allow_recursive,
775 [sys_inspect_object, sys_object]
776 ],
777 [return, []]
778 ],
779
780 [ "nN",
781 [sys_inspect_read_line],
782
783 [ when,
784 sys_allow_recursive,
785 [sys_inspect_object, sys_object]
786 ],
787 [return, []]
788 ],
789 ["sS", [sys_inspect_read_line], [return, []]],
790
791 [ "pP",
792 [sys_inspect_read_line],
793 [sys_select_p, sys_object]
794 ],
795
796 [ "aA",
797 [sys_inspect_read_line],
798 [throw, [quote, sys_abort_inspect], []]
799 ],
800 ["uU", [return, [values, t, [sys_select_u]]]],
801 ["eE", [sys_select_e]],
802
803 [ "qQ",
804 [sys_inspect_read_line],
805 [throw, [quote, sys_quit_inspect], []]
806 ],
807 ["?", [sys_inspect_read_line], [sys_select_c63]],
808 [t, [sys_inspect_read_line]]
809 ],
810 Sf_loop_Ret)
811 ),
812 Sf_loop_Ret=FnResult
813 ),
814 block_exit(sys_read_inspect_command, FnResult),
815 true).
816:- set_opv(sys_read_inspect_command,
817 symbol_function,
818 f_sys_read_inspect_command),
819 DefunResult=sys_read_inspect_command. 820/*
821:- side_effect(assert_lsp(sys_read_inspect_command,
822 lambda_def(defun,
823 sys_read_inspect_command,
824 f_sys_read_inspect_command,
825
826 [ sys_label,
827 sys_object,
828 sys_allow_recursive
829 ],
830
831 [
832 [ unless,
833 sys_xx_inspect_mode_xx,
834 [sys_inspect_indent_1],
835
836 [ if,
837 sys_allow_recursive,
838
839 [ progn,
840 [princ, sys_label],
841 [sys_inspect_object, sys_object]
842 ],
843 [format, t, sys_label, sys_object]
844 ],
845
846 [ return_from,
847 sys_read_inspect_command,
848 []
849 ]
850 ],
851
852 [ loop,
853 [sys_inspect_indent_1],
854
855 [ if,
856 sys_allow_recursive,
857
858 [ progn,
859 [princ, sys_label],
860 [sys_inspect_indent],
861 [prin1, sys_object]
862 ],
863 [format, t, sys_label, sys_object]
864 ],
865 [write_char|" "],
866 [force_output],
867
868 [ case,
869
870 [ do,
871
872 [
873 [ char,
874 [read_char, xx_query_io_xx],
875 [read_char, xx_query_io_xx]
876 ]
877 ],
878
879 [
880 [ and,
881 [char_c47_c61, char|" "],
882 [char_c47_c61|"\t"]
883 ],
884 char
885 ]
886 ],
887
888 [ "\n\r",
889
890 [ when,
891 sys_allow_recursive,
892 [sys_inspect_object, sys_object]
893 ],
894 [return, []]
895 ],
896
897 [ "nN",
898 [sys_inspect_read_line],
899
900 [ when,
901 sys_allow_recursive,
902 [sys_inspect_object, sys_object]
903 ],
904 [return, []]
905 ],
906
907 [ "sS",
908 [sys_inspect_read_line],
909 [return, []]
910 ],
911
912 [ "pP",
913 [sys_inspect_read_line],
914 [sys_select_p, sys_object]
915 ],
916
917 [ "aA",
918 [sys_inspect_read_line],
919
920 [ throw,
921 [quote, sys_abort_inspect],
922 []
923 ]
924 ],
925
926 [ "uU",
927
928 [ return,
929 [values, t, [sys_select_u]]
930 ]
931 ],
932 ["eE", [sys_select_e]],
933
934 [ "qQ",
935 [sys_inspect_read_line],
936
937 [ throw,
938 [quote, sys_quit_inspect],
939 []
940 ]
941 ],
942
943 [ "?",
944 [sys_inspect_read_line],
945 [sys_select_c63]
946 ],
947 [t, [sys_inspect_read_line]]
948 ]
949 ]
950 ]))).
951*/
952/*
953:- side_effect(assert_lsp(sys_read_inspect_command,
954 arglist_info(sys_read_inspect_command,
955 f_sys_read_inspect_command,
956
957 [ sys_label,
958 sys_object,
959 sys_allow_recursive
960 ],
961 arginfo{ all:
962 [ sys_label,
963 sys_object,
964 sys_allow_recursive
965 ],
966 allow_other_keys:0,
967 aux:0,
968 body:0,
969 complex:0,
970 env:0,
971 key:0,
972 names:
973 [ sys_label,
974 sys_object,
975 sys_allow_recursive
976 ],
977 opt:0,
978 req:
979 [ sys_label,
980 sys_object,
981 sys_allow_recursive
982 ],
983 rest:0,
984 sublists:0,
985 whole:0
986 }))).
987*/
988/*
989:- side_effect(assert_lsp(sys_read_inspect_command,
990 init_args(x, f_sys_read_inspect_command))).
991*/
992/*
993(defmacro inspect-recursively (label object &optional place)
994 (if place
995 `(multiple-value-bind (update-flag new-value)
996 (read-inspect-command ,label ,object t)
997 (when update-flag (setf ,place new-value)))
998 `(when (read-inspect-command ,label ,object t)
999 (princ "Not updated.")
1000 (terpri))))
1001
1002*/
1003
1004/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:3571 **********************/
1005:-lisp_compile_to_prolog(pkg_sys,[defmacro,'inspect-recursively',[label,object,'&optional',place],[if,place,['#BQ',['multiple-value-bind',['update-flag','new-value'],['read-inspect-command',['#COMMA',label],['#COMMA',object],t],[when,'update-flag',[setf,['#COMMA',place],'new-value']]]],['#BQ',[when,['read-inspect-command',['#COMMA',label],['#COMMA',object],t],[princ,'$STRING'("Not updated.")],[terpri]]]]])
1006/*
1007:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
1008 sys_inspect_recursively,
1009 kw_macro,
1010 mf_sys_inspect_recursively)).
1011*/
1012/*
1013:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
1014 sys_inspect_recursively,
1015 kw_special,
1016 sf_sys_inspect_recursively)).
1017*/
1018wl:lambda_def(defmacro, sys_inspect_recursively, mf_sys_inspect_recursively, [sys_label, sys_object, c38_optional, sys_place], [[if, sys_place, ['#BQ', [multiple_value_bind, [sys_update_flag, sys_new_value], [sys_read_inspect_command, ['#COMMA', sys_label], ['#COMMA', sys_object], t], [when, sys_update_flag, [setf, ['#COMMA', sys_place], sys_new_value]]]], ['#BQ', [when, [sys_read_inspect_command, ['#COMMA', sys_label], ['#COMMA', sys_object], t], [princ, '$ARRAY'([*], claz_base_character, "Not updated.")], [terpri]]]]]).
1019wl:arglist_info(sys_inspect_recursively, mf_sys_inspect_recursively, [sys_label, sys_object, c38_optional, sys_place], arginfo{all:[sys_label, sys_object, sys_place], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_label, sys_object, sys_place], opt:[sys_place], req:[sys_label, sys_object], rest:0, sublists:0, whole:0}).
1020wl: init_args(2, mf_sys_inspect_recursively).
1021
1026sf_sys_inspect_recursively(MacroEnv, Label_In, Object_In, RestNKeys, FResult) :-
1027 mf_sys_inspect_recursively(
1028 [ sys_inspect_recursively,
1029 Label_In,
1030 Object_In
1031 | RestNKeys
1032 ],
1033 MacroEnv,
1034 MFResult),
1035 f_sys_env_eval(MacroEnv, MFResult, FResult).
1040mf_sys_inspect_recursively([sys_inspect_recursively, Label_In, Object_In|RestNKeys], MacroEnv, MFResult) :-
1041 nop(defmacro),
1042 GEnv=[bv(sys_label, Label_In), bv(sys_object, Object_In), bv(sys_place, Place_In)],
1043 opt_var(MacroEnv, sys_place, Place_In, true, [], 1, RestNKeys),
1044 catch(( ( get_var(GEnv, sys_place, IFTEST),
1045 ( IFTEST\==[]
1046 -> get_var(GEnv, sys_label, Label_Get),
1047 get_var(GEnv, sys_object, Object_Get),
1048 get_var(GEnv, sys_place, Place_Get13),
1049 _3804=[multiple_value_bind, [sys_update_flag, sys_new_value], [sys_read_inspect_command, Label_Get, Object_Get, t], [when, sys_update_flag, [setf, Place_Get13, sys_new_value]]]
1050 ; get_var(GEnv, sys_label, Label_Get14),
1051 get_var(GEnv, sys_object, Object_Get15),
1052 _3804=[when, [sys_read_inspect_command, Label_Get14, Object_Get15, t], [princ, '$ARRAY'([*], claz_base_character, "Not updated.")], [terpri]]
1053 )
1054 ),
1055 _3804=MFResult
1056 ),
1057 block_exit(sys_inspect_recursively, MFResult),
1058 true).
1059:- set_opv(mf_sys_inspect_recursively, type_of, sys_macro),
1060 set_opv(sys_inspect_recursively, symbol_function, mf_sys_inspect_recursively),
1061 DefMacroResult=sys_inspect_recursively. 1062/*
1063:- side_effect(assert_lsp(sys_inspect_recursively,
1064 lambda_def(defmacro,
1065 sys_inspect_recursively,
1066 mf_sys_inspect_recursively,
1067
1068 [ sys_label,
1069 sys_object,
1070 c38_optional,
1071 sys_place
1072 ],
1073
1074 [
1075 [ if,
1076 sys_place,
1077
1078 [ '#BQ',
1079
1080 [ multiple_value_bind,
1081 [sys_update_flag, sys_new_value],
1082
1083 [ sys_read_inspect_command,
1084 ['#COMMA', sys_label],
1085 ['#COMMA', sys_object],
1086 t
1087 ],
1088
1089 [ when,
1090 sys_update_flag,
1091
1092 [ setf,
1093 ['#COMMA', sys_place],
1094 sys_new_value
1095 ]
1096 ]
1097 ]
1098 ],
1099
1100 [ '#BQ',
1101
1102 [ when,
1103
1104 [ sys_read_inspect_command,
1105 ['#COMMA', sys_label],
1106 ['#COMMA', sys_object],
1107 t
1108 ],
1109
1110 [ princ,
1111 '$ARRAY'([*],
1112 claz_base_character,
1113 "Not updated.")
1114 ],
1115 [terpri]
1116 ]
1117 ]
1118 ]
1119 ]))).
1120*/
1121/*
1122:- side_effect(assert_lsp(sys_inspect_recursively,
1123 arglist_info(sys_inspect_recursively,
1124 mf_sys_inspect_recursively,
1125
1126 [ sys_label,
1127 sys_object,
1128 c38_optional,
1129 sys_place
1130 ],
1131 arginfo{ all:
1132 [ sys_label,
1133 sys_object,
1134 sys_place
1135 ],
1136 allow_other_keys:0,
1137 aux:0,
1138 body:0,
1139 complex:0,
1140 env:0,
1141 key:0,
1142 names:
1143 [ sys_label,
1144 sys_object,
1145 sys_place
1146 ],
1147 opt:[sys_place],
1148 req:[sys_label, sys_object],
1149 rest:0,
1150 sublists:0,
1151 whole:0
1152 }))).
1153*/
1154/*
1155:- side_effect(assert_lsp(sys_inspect_recursively,
1156 init_args(2, mf_sys_inspect_recursively))).
1157*/
1158/*
1159(defmacro inspect-print (label object &optional place)
1160 (if place
1161 `(multiple-value-bind (update-flag new-value)
1162 (read-inspect-command ,label ,object nil)
1163 (when update-flag (setf ,place new-value)))
1164 `(when (read-inspect-command ,label ,object nil)
1165 (princ "Not updated.")
1166 (terpri))))
1167
1168*/
1169
1170/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:3916 **********************/
1171:-lisp_compile_to_prolog(pkg_sys,[defmacro,'inspect-print',[label,object,'&optional',place],[if,place,['#BQ',['multiple-value-bind',['update-flag','new-value'],['read-inspect-command',['#COMMA',label],['#COMMA',object],[]],[when,'update-flag',[setf,['#COMMA',place],'new-value']]]],['#BQ',[when,['read-inspect-command',['#COMMA',label],['#COMMA',object],[]],[princ,'$STRING'("Not updated.")],[terpri]]]]])
1172/*
1173:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
1174 sys_inspect_print,
1175 kw_macro,
1176 mf_sys_inspect_print)).
1177*/
1178/*
1179:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
1180 sys_inspect_print,
1181 kw_special,
1182 sf_sys_inspect_print)).
1183*/
1184wl:lambda_def(defmacro, sys_inspect_print, mf_sys_inspect_print, [sys_label, sys_object, c38_optional, sys_place], [[if, sys_place, ['#BQ', [multiple_value_bind, [sys_update_flag, sys_new_value], [sys_read_inspect_command, ['#COMMA', sys_label], ['#COMMA', sys_object], []], [when, sys_update_flag, [setf, ['#COMMA', sys_place], sys_new_value]]]], ['#BQ', [when, [sys_read_inspect_command, ['#COMMA', sys_label], ['#COMMA', sys_object], []], [princ, '$ARRAY'([*], claz_base_character, "Not updated.")], [terpri]]]]]).
1185wl:arglist_info(sys_inspect_print, mf_sys_inspect_print, [sys_label, sys_object, c38_optional, sys_place], arginfo{all:[sys_label, sys_object, sys_place], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_label, sys_object, sys_place], opt:[sys_place], req:[sys_label, sys_object], rest:0, sublists:0, whole:0}).
1186wl: init_args(2, mf_sys_inspect_print).
1187
1192sf_sys_inspect_print(MacroEnv, Label_In, Object_In, RestNKeys, FResult) :-
1193 mf_sys_inspect_print([sys_inspect_print, Label_In, Object_In|RestNKeys],
1194 MacroEnv,
1195 MFResult),
1196 f_sys_env_eval(MacroEnv, MFResult, FResult).
1201mf_sys_inspect_print([sys_inspect_print, Label_In, Object_In|RestNKeys], MacroEnv, MFResult) :-
1202 nop(defmacro),
1203 GEnv=[bv(sys_label, Label_In), bv(sys_object, Object_In), bv(sys_place, Place_In)],
1204 opt_var(MacroEnv, sys_place, Place_In, true, [], 1, RestNKeys),
1205 catch(( ( get_var(GEnv, sys_place, IFTEST),
1206 ( IFTEST\==[]
1207 -> get_var(GEnv, sys_label, Label_Get),
1208 get_var(GEnv, sys_object, Object_Get),
1209 get_var(GEnv, sys_place, Place_Get13),
1210 _3806=[multiple_value_bind, [sys_update_flag, sys_new_value], [sys_read_inspect_command, Label_Get, Object_Get, []], [when, sys_update_flag, [setf, Place_Get13, sys_new_value]]]
1211 ; get_var(GEnv, sys_label, Label_Get14),
1212 get_var(GEnv, sys_object, Object_Get15),
1213 _3806=[when, [sys_read_inspect_command, Label_Get14, Object_Get15, []], [princ, '$ARRAY'([*], claz_base_character, "Not updated.")], [terpri]]
1214 )
1215 ),
1216 _3806=MFResult
1217 ),
1218 block_exit(sys_inspect_print, MFResult),
1219 true).
1220:- set_opv(mf_sys_inspect_print, type_of, sys_macro),
1221 set_opv(sys_inspect_print, symbol_function, mf_sys_inspect_print),
1222 DefMacroResult=sys_inspect_print. 1223/*
1224:- side_effect(assert_lsp(sys_inspect_print,
1225 lambda_def(defmacro,
1226 sys_inspect_print,
1227 mf_sys_inspect_print,
1228
1229 [ sys_label,
1230 sys_object,
1231 c38_optional,
1232 sys_place
1233 ],
1234
1235 [
1236 [ if,
1237 sys_place,
1238
1239 [ '#BQ',
1240
1241 [ multiple_value_bind,
1242 [sys_update_flag, sys_new_value],
1243
1244 [ sys_read_inspect_command,
1245 ['#COMMA', sys_label],
1246 ['#COMMA', sys_object],
1247 []
1248 ],
1249
1250 [ when,
1251 sys_update_flag,
1252
1253 [ setf,
1254 ['#COMMA', sys_place],
1255 sys_new_value
1256 ]
1257 ]
1258 ]
1259 ],
1260
1261 [ '#BQ',
1262
1263 [ when,
1264
1265 [ sys_read_inspect_command,
1266 ['#COMMA', sys_label],
1267 ['#COMMA', sys_object],
1268 []
1269 ],
1270
1271 [ princ,
1272 '$ARRAY'([*],
1273 claz_base_character,
1274 "Not updated.")
1275 ],
1276 [terpri]
1277 ]
1278 ]
1279 ]
1280 ]))).
1281*/
1282/*
1283:- side_effect(assert_lsp(sys_inspect_print,
1284 arglist_info(sys_inspect_print,
1285 mf_sys_inspect_print,
1286
1287 [ sys_label,
1288 sys_object,
1289 c38_optional,
1290 sys_place
1291 ],
1292 arginfo{ all:
1293 [ sys_label,
1294 sys_object,
1295 sys_place
1296 ],
1297 allow_other_keys:0,
1298 aux:0,
1299 body:0,
1300 complex:0,
1301 env:0,
1302 key:0,
1303 names:
1304 [ sys_label,
1305 sys_object,
1306 sys_place
1307 ],
1308 opt:[sys_place],
1309 req:[sys_label, sys_object],
1310 rest:0,
1311 sublists:0,
1312 whole:0
1313 }))).
1314*/
1315/*
1316:- side_effect(assert_lsp(sys_inspect_print, init_args(2, mf_sys_inspect_print))).
1317*/
1318/*
1319(defun inspect-indent ()
1320 (fresh-line)
1321 (format t ""(defun inspect-indent ()\n (fresh-line)\n (format t \"~V@T\"\n (* 4 (if (< *inspect-level* 8) *inspect-level* 8))))\n\n".
1322*/
1323
1324/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:4268 **********************/
1325:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-indent',[],['fresh-line'],[format,t,'$STRING'("~V@T"),[*,4,[if,[<,'*inspect-level*',8],'*inspect-level*',8]]]])
1326/*
1327:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
1328 sys_inspect_indent,
1329 kw_function,
1330 f_sys_inspect_indent)).
1331*/
1332wl:lambda_def(defun, sys_inspect_indent, f_sys_inspect_indent, [], [[fresh_line], [format, t, '$ARRAY'([*], claz_base_character, "~V@T"), [*, 4, [if, [<, sys_xx_inspect_level_xx, 8], sys_xx_inspect_level_xx, 8]]]]).
1333wl:arglist_info(sys_inspect_indent, f_sys_inspect_indent, [], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[], opt:0, req:0, rest:0, sublists:0, whole:0}).
1334wl: init_args(x, f_sys_inspect_indent).
1335
1340f_sys_inspect_indent(FnResult) :-
1341 GEnv=[],
1342 catch(( ( f_fresh_line([], Fresh_line_Ret),
1343 get_var(GEnv,
1344 sys_xx_inspect_level_xx,
1345 Xx_inspect_level_xx_Get),
1346 ( Xx_inspect_level_xx_Get<8
1347 -> get_var(GEnv,
1348 sys_xx_inspect_level_xx,
1349 Xx_inspect_level_xx_Get8),
1350 CAR=Xx_inspect_level_xx_Get8
1351 ; CAR=8
1352 ),
1353 'f_*'([4, CAR], CAR16),
1354 f_format(t,
1355 '$ARRAY'([*], claz_base_character, "~V@T"),
1356 [CAR16],
1357 Format_Ret)
1358 ),
1359 Format_Ret=FnResult
1360 ),
1361 block_exit(sys_inspect_indent, FnResult),
1362 true).
1363:- set_opv(sys_inspect_indent, symbol_function, f_sys_inspect_indent),
1364 DefunResult=sys_inspect_indent. 1365/*
1366:- side_effect(assert_lsp(sys_inspect_indent,
1367 lambda_def(defun,
1368 sys_inspect_indent,
1369 f_sys_inspect_indent,
1370 [],
1371
1372 [ [fresh_line],
1373
1374 [ format,
1375 t,
1376 '$ARRAY'([*],
1377 claz_base_character,
1378 "~V@T"),
1379
1380 [ (*),
1381 4,
1382
1383 [ if,
1384 [<, sys_xx_inspect_level_xx, 8],
1385 sys_xx_inspect_level_xx,
1386 8
1387 ]
1388 ]
1389 ]
1390 ]))).
1391*/
1392/*
1393:- side_effect(assert_lsp(sys_inspect_indent,
1394 arglist_info(sys_inspect_indent,
1395 f_sys_inspect_indent,
1396 [],
1397 arginfo{ all:0,
1398 allow_other_keys:0,
1399 aux:0,
1400 body:0,
1401 complex:0,
1402 env:0,
1403 key:0,
1404 names:[],
1405 opt:0,
1406 req:0,
1407 rest:0,
1408 sublists:0,
1409 whole:0
1410 }))).
1411*/
1412/*
1413:- side_effect(assert_lsp(sys_inspect_indent,
1414 init_args(x, f_sys_inspect_indent))).
1415*/
1416/*
1417(defun inspect-indent-1 ()
1418 (fresh-line)
1419 (format t ""(defun inspect-indent-1 ()\n (fresh-line)\n (format t \"~V@T\"\n (- (* 4 (if (< *inspect-level* 8) *inspect-level* 8)) 3)))\n\n\n".
1420*/
1421
1422/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:4391 **********************/
1423:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-indent-1',[],['fresh-line'],[format,t,'$STRING'("~V@T"),[-,[*,4,[if,[<,'*inspect-level*',8],'*inspect-level*',8]],3]]])
1424/*
1425:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
1426 sys_inspect_indent_1,
1427 kw_function,
1428 f_sys_inspect_indent_1)).
1429*/
1430wl:lambda_def(defun, sys_inspect_indent_1, f_sys_inspect_indent_1, [], [[fresh_line], [format, t, '$ARRAY'([*], claz_base_character, "~V@T"), [-, [*, 4, [if, [<, sys_xx_inspect_level_xx, 8], sys_xx_inspect_level_xx, 8]], 3]]]).
1431wl:arglist_info(sys_inspect_indent_1, f_sys_inspect_indent_1, [], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[], opt:0, req:0, rest:0, sublists:0, whole:0}).
1432wl: init_args(x, f_sys_inspect_indent_1).
1433
1438f_sys_inspect_indent_1(FnResult) :-
1439 GEnv=[],
1440 catch(( ( f_fresh_line([], Fresh_line_Ret),
1441 get_var(GEnv,
1442 sys_xx_inspect_level_xx,
1443 Xx_inspect_level_xx_Get),
1444 ( Xx_inspect_level_xx_Get<8
1445 -> get_var(GEnv,
1446 sys_xx_inspect_level_xx,
1447 Xx_inspect_level_xx_Get8),
1448 CAR=Xx_inspect_level_xx_Get8
1449 ; CAR=8
1450 ),
1451 'f_*'([4, CAR], _3212),
1452 'f_-'(_3212, [3], CAR16),
1453 f_format(t,
1454 '$ARRAY'([*], claz_base_character, "~V@T"),
1455 [CAR16],
1456 Format_Ret)
1457 ),
1458 Format_Ret=FnResult
1459 ),
1460 block_exit(sys_inspect_indent_1, FnResult),
1461 true).
1462:- set_opv(sys_inspect_indent_1, symbol_function, f_sys_inspect_indent_1),
1463 DefunResult=sys_inspect_indent_1. 1464/*
1465:- side_effect(assert_lsp(sys_inspect_indent_1,
1466 lambda_def(defun,
1467 sys_inspect_indent_1,
1468 f_sys_inspect_indent_1,
1469 [],
1470
1471 [ [fresh_line],
1472
1473 [ format,
1474 t,
1475 '$ARRAY'([*],
1476 claz_base_character,
1477 "~V@T"),
1478
1479 [ (-),
1480
1481 [ (*),
1482 4,
1483
1484 [ if,
1485 [<, sys_xx_inspect_level_xx, 8],
1486 sys_xx_inspect_level_xx,
1487 8
1488 ]
1489 ],
1490 3
1491 ]
1492 ]
1493 ]))).
1494*/
1495/*
1496:- side_effect(assert_lsp(sys_inspect_indent_1,
1497 arglist_info(sys_inspect_indent_1,
1498 f_sys_inspect_indent_1,
1499 [],
1500 arginfo{ all:0,
1501 allow_other_keys:0,
1502 aux:0,
1503 body:0,
1504 complex:0,
1505 env:0,
1506 key:0,
1507 names:[],
1508 opt:0,
1509 req:0,
1510 rest:0,
1511 sublists:0,
1512 whole:0
1513 }))).
1514*/
1515/*
1516:- side_effect(assert_lsp(sys_inspect_indent_1,
1517 init_args(x, f_sys_inspect_indent_1))).
1518*/
1519/*
1520(defun inspect-symbol (symbol)
1521 (let ((p (symbol-package symbol)))
1522 (cond ((null p)
1523 (format t ""(defun inspect-symbol (symbol)\n (let ((p (symbol-package symbol)))\n (cond ((null p)\n (format t \"~:@(~S~) - uninterned symbol\" symbol))\n ((eq p (find-package \"KEYWORD\"))\n (format t \"~:@(~S~) - keyword\" symbol))\n (t\n (format t \"~:@(~S~) - ~:[internal~;external~] symbol in ~A package\"\n symbol\n (multiple-value-bind (b f)\n (find-symbol (symbol-name symbol) p)\n (declare (ignore b))\n (eq f :external))\n (package-name p)))))\n\n (when (boundp symbol)\n (if *inspect-mode*\n (inspect-recursively \"value:\"\n (symbol-value symbol)\n (symbol-value symbol))\n (inspect-print \"value:~% ~S\"\n (symbol-value symbol)\n (symbol-value symbol))))\n\n (do ((pl (symbol-plist symbol) (cddr pl)))\n ((endp pl))\n (unless (and (symbolp (car pl))\n (or (eq (symbol-package (car pl)) (find-package 'SYSTEM))\n (eq (symbol-package (car pl)) (find-package 'COMPILER))))\n (if *inspect-mode*\n (inspect-recursively (format nil \"property ~S:\" (car pl))\n (cadr pl)\n (get-sysprop symbol (car pl)))\n (inspect-print (format nil \"property ~:@(~S~):~% ~~S\" (car pl))\n (cadr pl)\n (get-sysprop symbol (car pl))))))\n \n (when (print-doc symbol t)\n (format t \"~&-----------------------------------------------------------------------------~%\"))\n )\n\n".
1524*/
1525
1526/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:4523 **********************/
1527:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-symbol',[symbol],[let,[[p,['symbol-package',symbol]]],[cond,[[null,p],[format,t,'$STRING'("~:@(~S~) - uninterned symbol"),symbol]],[[eq,p,['find-package','$STRING'("KEYWORD")]],[format,t,'$STRING'("~:@(~S~) - keyword"),symbol]],[t,[format,t,'$STRING'("~:@(~S~) - ~:[internal~;external~] symbol in ~A package"),symbol,['multiple-value-bind',[b,f],['find-symbol',['symbol-name',symbol],p],[declare,[ignore,b]],[eq,f,':external']],['package-name',p]]]]],[when,[boundp,symbol],[if,'*inspect-mode*',['inspect-recursively','$STRING'("value:"),['symbol-value',symbol],['symbol-value',symbol]],['inspect-print','$STRING'("value:~% ~S"),['symbol-value',symbol],['symbol-value',symbol]]]],[do,[[pl,['symbol-plist',symbol],[cddr,pl]]],[[endp,pl]],[unless,[and,[symbolp,[car,pl]],[or,[eq,['symbol-package',[car,pl]],['find-package',[quote,'SYSTEM']]],[eq,['symbol-package',[car,pl]],['find-package',[quote,'COMPILER']]]]],[if,'*inspect-mode*',['inspect-recursively',[format,[],'$STRING'("property ~S:"),[car,pl]],[cadr,pl],['get-sysprop',symbol,[car,pl]]],['inspect-print',[format,[],'$STRING'("property ~:@(~S~):~% ~~S"),[car,pl]],[cadr,pl],['get-sysprop',symbol,[car,pl]]]]]],[when,['print-doc',symbol,t],[format,t,'$STRING'("~&-----------------------------------------------------------------------------~%")]]])
1528/*
1529:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
1530 sys_inspect_symbol,
1531 kw_function,
1532 f_sys_inspect_symbol)).
1533*/
1534/*
1535% macroexpand:-[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"value:"),[symbol_value,symbol],[symbol_value,symbol]].
1536*/
1537/*
1538% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"value:"),[symbol_value,symbol],t],[when,sys_update_flag,[setf,[symbol_value,symbol],sys_new_value]]].
1539*/
1540/*
1541:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv41, [], CDR, Compile_each_Ret), append([symbol|CDR], [CAR50, CAR], Append_Ret), setf_inverse_op(symbol_value, Inverse_op_Ret)))).
1542*/
1543/*
1544:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv41, [], CDR, Compile_each_Ret), append([symbol|CDR], [CAR50, CAR], Append_Ret), setf_inverse_op(symbol_value, Inverse_op_Ret)))).
1545*/
1546/*
1547% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"value:~% ~S"),[symbol_value,symbol],[symbol_value,symbol]].
1548*/
1549/*
1550% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"value:~% ~S"),[symbol_value,symbol],[]],[when,sys_update_flag,[setf,[symbol_value,symbol],sys_new_value]]].
1551*/
1552/*
1553:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv53, [], CDR, Compile_each_Ret), append([symbol|CDR], [CAR62, CAR], Append_Ret), setf_inverse_op(symbol_value, Inverse_op_Ret)))).
1554*/
1555/*
1556:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv53, [], CDR, Compile_each_Ret), append([symbol|CDR], [CAR62, CAR], Append_Ret), setf_inverse_op(symbol_value, Inverse_op_Ret)))).
1557*/
1558/*
1559% macroexpand:-[sys_inspect_recursively,[format,[],'$ARRAY'([*],claz_base_character,"property ~S:"),[car,sys_pl]],[cadr,sys_pl],[sys_get_sysprop,symbol,[car,sys_pl]]].
1560*/
1561/*
1562% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,[format,[],'$ARRAY'([*],claz_base_character,"property ~S:"),[car,sys_pl]],[cadr,sys_pl],t],[when,sys_update_flag,[setf,[sys_get_sysprop,symbol,[car,sys_pl]],sys_new_value]]].
1563*/
1564/*
1565:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv94, [[car, sys_pl], []], CDR, Compile_each_Ret), append([symbol|CDR], [CAR104, CAR], Append_Ret), setf_inverse_op(sys_get_sysprop, Inverse_op_Ret)))).
1566*/
1567/*
1568:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv94, [[car, sys_pl], []], CDR, Compile_each_Ret), append([symbol|CDR], [CAR104, CAR], Append_Ret), setf_inverse_op(sys_get_sysprop, Inverse_op_Ret)))).
1569*/
1570/*
1571% macroexpand:-[sys_inspect_print,[format,[],'$ARRAY'([*],claz_base_character,"property ~:@(~S~):~% ~~S"),[car,sys_pl]],[cadr,sys_pl],[sys_get_sysprop,symbol,[car,sys_pl]]].
1572*/
1573/*
1574% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,[format,[],'$ARRAY'([*],claz_base_character,"property ~:@(~S~):~% ~~S"),[car,sys_pl]],[cadr,sys_pl],[]],[when,sys_update_flag,[setf,[sys_get_sysprop,symbol,[car,sys_pl]],sys_new_value]]].
1575*/
1576/*
1577:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv108, [[car, sys_pl], []], CDR, Compile_each_Ret), append([symbol|CDR], [CAR118, CAR], Append_Ret), setf_inverse_op(sys_get_sysprop, Inverse_op_Ret)))).
1578*/
1579/*
1580:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv108, [[car, sys_pl], []], CDR, Compile_each_Ret), append([symbol|CDR], [CAR118, CAR], Append_Ret), setf_inverse_op(sys_get_sysprop, Inverse_op_Ret)))).
1581*/
1582/*
1583% macroexpand:-[sys_inspect_recursively,[format,[],'$ARRAY'([*],claz_base_character,"property ~S:"),[car,sys_pl]],[cadr,sys_pl],[sys_get_sysprop,symbol,[car,sys_pl]]].
1584*/
1585/*
1586% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,[format,[],'$ARRAY'([*],claz_base_character,"property ~S:"),[car,sys_pl]],[cadr,sys_pl],t],[when,sys_update_flag,[setf,[sys_get_sysprop,symbol,[car,sys_pl]],sys_new_value]]].
1587*/
1588/*
1589:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv152, [[car, sys_pl], []], CDR, Compile_each_Ret), append([symbol|CDR], [CAR162, CAR], Append_Ret), setf_inverse_op(sys_get_sysprop, Inverse_op_Ret)))).
1590*/
1591/*
1592:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv152, [[car, sys_pl], []], CDR, Compile_each_Ret), append([symbol|CDR], [CAR162, CAR], Append_Ret), setf_inverse_op(sys_get_sysprop, Inverse_op_Ret)))).
1593*/
1594/*
1595% macroexpand:-[sys_inspect_print,[format,[],'$ARRAY'([*],claz_base_character,"property ~:@(~S~):~% ~~S"),[car,sys_pl]],[cadr,sys_pl],[sys_get_sysprop,symbol,[car,sys_pl]]].
1596*/
1597/*
1598% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,[format,[],'$ARRAY'([*],claz_base_character,"property ~:@(~S~):~% ~~S"),[car,sys_pl]],[cadr,sys_pl],[]],[when,sys_update_flag,[setf,[sys_get_sysprop,symbol,[car,sys_pl]],sys_new_value]]].
1599*/
1600/*
1601:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv166, [[car, sys_pl], []], CDR, Compile_each_Ret), append([symbol|CDR], [CAR176, CAR], Append_Ret), setf_inverse_op(sys_get_sysprop, Inverse_op_Ret)))).
1602*/
1603/*
1604:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv166, [[car, sys_pl], []], CDR, Compile_each_Ret), append([symbol|CDR], [CAR176, CAR], Append_Ret), setf_inverse_op(sys_get_sysprop, Inverse_op_Ret)))).
1605*/
1606/*
1607:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
1608 sys_print_doc,
1609 kw_function,
1610 f_sys_print_doc)).
1611*/
1612wl:lambda_def(defun, sys_inspect_symbol, f_sys_inspect_symbol, [symbol], [[let, [[sys_p, [symbol_package, symbol]]], [cond, [[null, sys_p], [format, t, '$ARRAY'([*], claz_base_character, "~:@(~S~) - uninterned symbol"), symbol]], [[eq, sys_p, [find_package, '$ARRAY'([*], claz_base_character, "KEYWORD")]], [format, t, '$ARRAY'([*], claz_base_character, "~:@(~S~) - keyword"), symbol]], [t, [format, t, '$ARRAY'([*], claz_base_character, "~:@(~S~) - ~:[internal~;external~] symbol in ~A package"), symbol, [multiple_value_bind, [sys_b, sys_f], [find_symbol, [symbol_name, symbol], sys_p], [declare, [ignore, sys_b]], [eq, sys_f, kw_external]], [package_name, sys_p]]]]], [when, [boundp, symbol], [if, sys_xx_inspect_mode_xx, [sys_inspect_recursively, '$ARRAY'([*], claz_base_character, "value:"), [symbol_value, symbol], [symbol_value, symbol]], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "value:~% ~S"), [symbol_value, symbol], [symbol_value, symbol]]]], [do, [[sys_pl, [symbol_plist, symbol], [cddr, sys_pl]]], [[endp, sys_pl]], [unless, [and, [symbolp, [car, sys_pl]], [or, [eq, [symbol_package, [car, sys_pl]], [find_package, [quote, sys_system]]], [eq, [symbol_package, [car, sys_pl]], [find_package, [quote, sys_compiler]]]]], [if, sys_xx_inspect_mode_xx, [sys_inspect_recursively, [format, [], '$ARRAY'([*], claz_base_character, "property ~S:"), [car, sys_pl]], [cadr, sys_pl], [sys_get_sysprop, symbol, [car, sys_pl]]], [sys_inspect_print, [format, [], '$ARRAY'([*], claz_base_character, "property ~:@(~S~):~% ~~S"), [car, sys_pl]], [cadr, sys_pl], [sys_get_sysprop, symbol, [car, sys_pl]]]]]], [when, [sys_print_doc, symbol, t], [format, t, '$ARRAY'([*], claz_base_character, "~&-----------------------------------------------------------------------------~%")]]]).
1613wl:arglist_info(sys_inspect_symbol, f_sys_inspect_symbol, [symbol], arginfo{all:[symbol], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[symbol], opt:0, req:[symbol], rest:0, sublists:0, whole:0}).
1614wl: init_args(x, f_sys_inspect_symbol).
1615
1620f_sys_inspect_symbol(Symbol_In, FnResult) :-
1621 GEnv=[bv(symbol, Symbol_In)],
1622 catch(( ( get_var(GEnv, symbol, Symbol_Get),
1623 f_symbol_package(Symbol_Get, P_Init),
1624 LEnv=[bv(sys_p, P_Init)|GEnv],
1625 get_var(LEnv, sys_p, IFTEST),
1626 ( IFTEST==[]
1627 -> get_var(LEnv, symbol, Symbol_Get13),
1628 f_format(t,
1629 '$ARRAY'([*],
1630 claz_base_character,
1631 "~:@(~S~) - uninterned symbol"),
1632 [Symbol_Get13],
1633 TrueResult30),
1634 LetResult=TrueResult30
1635 ; get_var(LEnv, sys_p, P_Get15),
1636 f_find_package('$ARRAY'([*],
1637 claz_base_character,
1638 "KEYWORD"),
1639 PredArg2Result),
1640 ( is_eq(P_Get15, PredArg2Result)
1641 -> get_var(LEnv, symbol, Symbol_Get19),
1642 f_format(t,
1643 '$ARRAY'([*],
1644 claz_base_character,
1645 "~:@(~S~) - keyword"),
1646 [Symbol_Get19],
1647 TrueResult),
1648 ElseResult31=TrueResult
1649 ; get_var(LEnv, symbol, Symbol_Get20),
1650 LEnv23=[bv(sys_b, []), bv(sys_f, [])|LEnv],
1651 get_var(LEnv23, symbol, Symbol_Get24),
1652 f_symbol_name(Symbol_Get24, Find_symbol_Param),
1653 get_var(LEnv23, sys_p, P_Get25),
1654 f_find_symbol(Find_symbol_Param,
1655 P_Get25,
1656 Find_symbol_Ret),
1657 setq_from_values(LEnv23, [sys_b, sys_f]),
1658 sf_declare(LEnv23, [ignore, sys_b], Sf_declare_Ret),
1659 get_var(LEnv23, sys_f, Get),
1660 f_eq(Get, kw_external, LetResult22),
1661 get_var(LEnv, sys_p, P_Get27),
1662 f_package_name(P_Get27, Package_name_Ret),
1663 f_format(t,
1664 '$ARRAY'([*],
1665 claz_base_character,
1666 "~:@(~S~) - ~:[internal~;external~] symbol in ~A package"),
1667 [Symbol_Get20, LetResult22, Package_name_Ret],
1668 ElseResult),
1669 ElseResult31=ElseResult
1670 ),
1671 LetResult=ElseResult31
1672 ),
1673 get_var(GEnv, symbol, Symbol_Get33),
1674 ( symbol:is_boundp(Symbol_Get33)
1675 -> get_var(GEnv, sys_xx_inspect_mode_xx, IFTEST36),
1676 ( IFTEST36\==[]
1677 -> LEnv41=[bv(sys_update_flag, []), bv(sys_new_value, [])|GEnv],
1678 get_var(LEnv41, symbol, Symbol_Get42),
1679 f_symbol_value(Symbol_Get42, Symbol_value_Ret),
1680 f_sys_read_inspect_command('$ARRAY'([*],
1681 claz_base_character,
1682 "value:"),
1683 Symbol_value_Ret,
1684 t,
1685 T),
1686 setq_from_values(LEnv41,
1687 [sys_update_flag, sys_new_value]),
1688 get_var(LEnv41, sys_update_flag, IFTEST43),
1689 ( IFTEST43\==[]
1690 -> get_var(LEnv41, symbol, Symbol_Get49),
1691 get_var(LEnv41, sys_new_value, New_value_Get),
1692 set_place(LEnv41,
1693 setf,
1694 [symbol_value, Symbol_Get49],
1695 [New_value_Get],
1696 Setf_R),
1697 LetResult40=Setf_R
1698 ; LetResult40=[]
1699 ),
1700 TrueResult65=LetResult40
1701 ; LEnv53=[bv(sys_update_flag, []), bv(sys_new_value, [])|GEnv],
1702 get_var(LEnv53, symbol, Symbol_Get54),
1703 f_symbol_value(Symbol_Get54, Symbol_value_Ret214),
1704 f_sys_read_inspect_command('$ARRAY'([*],
1705 claz_base_character,
1706 "value:~% ~S"),
1707 Symbol_value_Ret214,
1708 [],
1709 Inspect_command_Ret),
1710 setq_from_values(LEnv53,
1711 [sys_update_flag, sys_new_value]),
1712 get_var(LEnv53, sys_update_flag, IFTEST55),
1713 ( IFTEST55\==[]
1714 -> get_var(LEnv53, symbol, Symbol_Get61),
1715 get_var(LEnv53, sys_new_value, New_value_Get58),
1716 set_place(LEnv53,
1717 setf,
1718 [symbol_value, Symbol_Get61],
1719 [New_value_Get58],
1720 Setf_R59),
1721 LetResult52=Setf_R59
1722 ; LetResult52=[]
1723 ),
1724 TrueResult65=LetResult52
1725 ),
1726 _9762=TrueResult65
1727 ; _9762=[]
1728 ),
1729 get_var(GEnv, symbol, Symbol_Get69),
1730 f_symbol_plist(Symbol_Get69, Pl_Init),
1731 AEnv=[bv(sys_pl, Pl_Init)|GEnv],
1732 catch(( call_addr_block(AEnv,
1733 (push_label(do_label_2), get_var(AEnv, sys_pl, Pl_Get131), (s3q:is_endp(Pl_Get131)->throw(block_exit([], [])), _TBResult=ThrowResult135;get_var(AEnv, sys_pl, Pl_Get140), f_car(Pl_Get140, PredArgResult142), (is_symbolp(PredArgResult142)->(get_var(AEnv, sys_pl, Pl_Get143), f_car(Pl_Get143, Symbol_package_Param), f_symbol_package(Symbol_package_Param, Eq_Param), f_find_package(sys_system, Find_package_Ret), f_eq(Eq_Param, Find_package_Ret, FORM1_Res145), FORM1_Res145\==[], TrueResult146=FORM1_Res145->true;get_var(AEnv, sys_pl, Pl_Get144), f_car(Pl_Get144, Symbol_package_Param200), f_symbol_package(Symbol_package_Param200, Eq_Param201), f_find_package(sys_compiler, Find_package_Ret217), f_eq(Eq_Param201, Find_package_Ret217, Eq_Ret), TrueResult146=Eq_Ret), IFTEST137=TrueResult146;IFTEST137=[]), (IFTEST137\==[]->_12174=[];get_var(AEnv, sys_xx_inspect_mode_xx, IFTEST147), (IFTEST147\==[]->LEnv152=[bv(sys_update_flag, []), bv(sys_new_value, [])|AEnv], get_var(LEnv152, sys_pl, Pl_Get153), f_car(Pl_Get153, Car_Ret), f_format([], '$ARRAY'([*], claz_base_character, "property ~S:"), [Car_Ret], Inspect_command_Param), get_var(LEnv152, sys_pl, Pl_Get154), f_cadr(Pl_Get154, Cadr_Ret), f_sys_read_inspect_command(Inspect_command_Param, Cadr_Ret, t, T195), setq_from_values(LEnv152, [sys_update_flag, sys_new_value]), get_var(LEnv152, sys_update_flag, IFTEST155), (IFTEST155\==[]->get_var(LEnv152, symbol, Symbol_Get161), get_var(LEnv152, sys_new_value, New_value_Get158), get_var(LEnv152, sys_pl, Pl_Get162), f_car(Pl_Get162, Car_Ret221), set_place(LEnv152, setf, [sys_get_sysprop, Symbol_Get161, Car_Ret221], [New_value_Get158], Setf_R159), LetResult151=Setf_R159;LetResult151=[]), ElseResult180=LetResult151;LEnv166=[bv(sys_update_flag, []), bv(sys_new_value, [])|AEnv], get_var(LEnv166, sys_pl, Pl_Get167), f_car(Pl_Get167, Car_Ret222), f_format([], '$ARRAY'([*], claz_base_character, "property ~:@(~S~):~% ~~S"), [Car_Ret222], Inspect_command_Param203), get_var(LEnv166, sys_pl, Pl_Get168), f_cadr(Pl_Get168, Cadr_Ret223), f_sys_read_inspect_command(Inspect_command_Param203, Cadr_Ret223, [], Inspect_command_Ret224), setq_from_values(LEnv166, [sys_update_flag, sys_new_value]), get_var(LEnv166, sys_update_flag, IFTEST169), (IFTEST169\==[]->get_var(LEnv166, symbol, Symbol_Get175), get_var(LEnv166, sys_new_value, New_value_Get172), get_var(LEnv166, sys_pl, Pl_Get176), f_car(Pl_Get176, Car_Ret225), set_place(LEnv166, setf, [sys_get_sysprop, Symbol_Get175, Car_Ret225], [New_value_Get172], Setf_R173), LetResult165=Setf_R173;LetResult165=[]), ElseResult180=LetResult165), _12174=ElseResult180), get_var(AEnv, sys_pl, Pl_Get182), f_cddr(Pl_Get182, Pl), set_var(AEnv, sys_pl, Pl), goto(do_label_2, AEnv), _TBResult=_GORES183)),
1734
1735 [ addr(addr_tagbody_2_do_label_2,
1736 do_label_2,
1737 '$unused',
1738 AEnv,
1739 (get_var(AEnv, sys_pl, Pl_Get), (s3q:is_endp(Pl_Get)->throw(block_exit([], [])), _13430=ThrowResult;get_var(AEnv, sys_pl, Pl_Get82), f_car(Pl_Get82, PredArgResult84), (is_symbolp(PredArgResult84)->(get_var(AEnv, sys_pl, Pl_Get85), f_car(Pl_Get85, Symbol_package_Param204), f_symbol_package(Symbol_package_Param204, Eq_Param205), f_find_package(sys_system, Find_package_Ret226), f_eq(Eq_Param205, Find_package_Ret226, Eq_Ret227), Eq_Ret227\==[], TrueResult88=Eq_Ret227->true;get_var(AEnv, sys_pl, Pl_Get86), f_car(Pl_Get86, Symbol_package_Param206), f_symbol_package(Symbol_package_Param206, Eq_Param207), f_find_package(sys_compiler, Find_package_Ret228), f_eq(Eq_Param207, Find_package_Ret228, Eq_Ret229), TrueResult88=Eq_Ret229), IFTEST79=TrueResult88;IFTEST79=[]), (IFTEST79\==[]->_13546=[];get_var(AEnv, sys_xx_inspect_mode_xx, IFTEST89), (IFTEST89\==[]->LEnv94=[bv(sys_update_flag, []), bv(sys_new_value, [])|AEnv], get_var(LEnv94, sys_pl, Pl_Get95), f_car(Pl_Get95, Car_Ret230), f_format([], '$ARRAY'([*], claz_base_character, "property ~S:"), [Car_Ret230], Inspect_command_Param208), get_var(LEnv94, sys_pl, Pl_Get96), f_cadr(Pl_Get96, Cadr_Ret231), f_sys_read_inspect_command(Inspect_command_Param208, Cadr_Ret231, t, Inspect_command_Ret232), setq_from_values(LEnv94, [sys_update_flag, sys_new_value]), get_var(LEnv94, sys_update_flag, IFTEST97), (IFTEST97\==[]->get_var(LEnv94, symbol, Symbol_Get103), get_var(LEnv94, sys_new_value, New_value_Get100), get_var(LEnv94, sys_pl, Pl_Get104), f_car(Pl_Get104, Car_Ret233), set_place(LEnv94, setf, [sys_get_sysprop, Symbol_Get103, Car_Ret233], [New_value_Get100], Setf_R101), LetResult93=Setf_R101;LetResult93=[]), ElseResult122=LetResult93;LEnv108=[bv(sys_update_flag, []), bv(sys_new_value, [])|AEnv], get_var(LEnv108, sys_pl, Pl_Get109), f_car(Pl_Get109, Car_Ret234), f_format([], '$ARRAY'([*], claz_base_character, "property ~:@(~S~):~% ~~S"), [Car_Ret234], Inspect_command_Param209), get_var(LEnv108, sys_pl, Pl_Get110), f_cadr(Pl_Get110, Cadr_Ret235), f_sys_read_inspect_command(Inspect_command_Param209, Cadr_Ret235, [], Inspect_command_Ret236), setq_from_values(LEnv108, [sys_update_flag, sys_new_value]), get_var(LEnv108, sys_update_flag, IFTEST111), (IFTEST111\==[]->get_var(LEnv108, symbol, Symbol_Get117), get_var(LEnv108, sys_new_value, New_value_Get114), get_var(LEnv108, sys_pl, Pl_Get118), f_car(Pl_Get118, Car_Ret237), set_place(LEnv108, setf, [sys_get_sysprop, Symbol_Get117, Car_Ret237], [New_value_Get114], Setf_R115), LetResult107=Setf_R115;LetResult107=[]), ElseResult122=LetResult107), _13546=ElseResult122), get_var(AEnv, sys_pl, Pl_Get124), f_cddr(Pl_Get124, Cddr_Ret), set_var(AEnv, sys_pl, Cddr_Ret), goto(do_label_2, AEnv), _13430=_GORES)))
1740 ]),
1741 []=LetResult67
1742 ),
1743 block_exit([], LetResult67),
1744 true),
1745 get_var(GEnv, symbol, Symbol_Get189),
1746 f_sys_print_doc(Symbol_Get189, t, IFTEST187),
1747 ( IFTEST187\==[]
1748 -> f_format(t,
1749 '$ARRAY'([*],
1750 claz_base_character,
1751 "~&-----------------------------------------------------------------------------~%"),
1752 [],
1753 TrueResult190),
1754 _9172=TrueResult190
1755 ; _9172=[]
1756 )
1757 ),
1758 _9172=FnResult
1759 ),
1760 block_exit(sys_inspect_symbol, FnResult),
1761 true).
1762:- set_opv(sys_inspect_symbol, symbol_function, f_sys_inspect_symbol),
1763 DefunResult=sys_inspect_symbol. 1764/*
1765:- side_effect(assert_lsp(sys_inspect_symbol,
1766 lambda_def(defun,
1767 sys_inspect_symbol,
1768 f_sys_inspect_symbol,
1769 [symbol],
1770
1771 [
1772 [ let,
1773 [[sys_p, [symbol_package, symbol]]],
1774
1775 [ cond,
1776
1777 [ [null, sys_p],
1778
1779 [ format,
1780 t,
1781 '$ARRAY'([*],
1782 claz_base_character,
1783 "~:@(~S~) - uninterned symbol"),
1784 symbol
1785 ]
1786 ],
1787
1788 [
1789 [ eq,
1790 sys_p,
1791
1792 [ find_package,
1793 '$ARRAY'([*],
1794 claz_base_character,
1795 "KEYWORD")
1796 ]
1797 ],
1798
1799 [ format,
1800 t,
1801 '$ARRAY'([*],
1802 claz_base_character,
1803 "~:@(~S~) - keyword"),
1804 symbol
1805 ]
1806 ],
1807
1808 [ t,
1809
1810 [ format,
1811 t,
1812 '$ARRAY'([*],
1813 claz_base_character,
1814 "~:@(~S~) - ~:[internal~;external~] symbol in ~A package"),
1815 symbol,
1816
1817 [ multiple_value_bind,
1818 [sys_b, sys_f],
1819
1820 [ find_symbol,
1821 [symbol_name, symbol],
1822 sys_p
1823 ],
1824 [declare, [ignore, sys_b]],
1825 [eq, sys_f, kw_external]
1826 ],
1827 [package_name, sys_p]
1828 ]
1829 ]
1830 ]
1831 ],
1832
1833 [ when,
1834 [boundp, symbol],
1835
1836 [ if,
1837 sys_xx_inspect_mode_xx,
1838
1839 [ sys_inspect_recursively,
1840 '$ARRAY'([*],
1841 claz_base_character,
1842 "value:"),
1843 [symbol_value, symbol],
1844 [symbol_value, symbol]
1845 ],
1846
1847 [ sys_inspect_print,
1848 '$ARRAY'([*],
1849 claz_base_character,
1850 "value:~% ~S"),
1851 [symbol_value, symbol],
1852 [symbol_value, symbol]
1853 ]
1854 ]
1855 ],
1856
1857 [ do,
1858
1859 [
1860 [ sys_pl,
1861 [symbol_plist, symbol],
1862 [cddr, sys_pl]
1863 ]
1864 ],
1865 [[endp, sys_pl]],
1866
1867 [ unless,
1868
1869 [ and,
1870 [symbolp, [car, sys_pl]],
1871
1872 [ or,
1873
1874 [ eq,
1875 [symbol_package, [car, sys_pl]],
1876
1877 [ find_package,
1878 [quote, sys_system]
1879 ]
1880 ],
1881
1882 [ eq,
1883 [symbol_package, [car, sys_pl]],
1884
1885 [ find_package,
1886 [quote, sys_compiler]
1887 ]
1888 ]
1889 ]
1890 ],
1891
1892 [ if,
1893 sys_xx_inspect_mode_xx,
1894
1895 [ sys_inspect_recursively,
1896
1897 [ format,
1898 [],
1899 '$ARRAY'([*],
1900 claz_base_character,
1901 "property ~S:"),
1902 [car, sys_pl]
1903 ],
1904 [cadr, sys_pl],
1905
1906 [ sys_get_sysprop,
1907 symbol,
1908 [car, sys_pl]
1909 ]
1910 ],
1911
1912 [ sys_inspect_print,
1913
1914 [ format,
1915 [],
1916 '$ARRAY'([*],
1917 claz_base_character,
1918 "property ~:@(~S~):~% ~~S"),
1919 [car, sys_pl]
1920 ],
1921 [cadr, sys_pl],
1922
1923 [ sys_get_sysprop,
1924 symbol,
1925 [car, sys_pl]
1926 ]
1927 ]
1928 ]
1929 ]
1930 ],
1931
1932 [ when,
1933 [sys_print_doc, symbol, t],
1934
1935 [ format,
1936 t,
1937 '$ARRAY'([*],
1938 claz_base_character,
1939 "~&-----------------------------------------------------------------------------~%")
1940 ]
1941 ]
1942 ]))).
1943*/
1944/*
1945:- side_effect(assert_lsp(sys_inspect_symbol,
1946 arglist_info(sys_inspect_symbol,
1947 f_sys_inspect_symbol,
1948 [symbol],
1949 arginfo{ all:[symbol],
1950 allow_other_keys:0,
1951 aux:0,
1952 body:0,
1953 complex:0,
1954 env:0,
1955 key:0,
1956 names:[symbol],
1957 opt:0,
1958 req:[symbol],
1959 rest:0,
1960 sublists:0,
1961 whole:0
1962 }))).
1963*/
1964/*
1965:- side_effect(assert_lsp(sys_inspect_symbol,
1966 init_args(x, f_sys_inspect_symbol))).
1967*/
1968/*
1969(defun inspect-package (package)
1970 (format t ""(defun inspect-package (package)\n (format t \"~S - package\" package)\n (when (package-nicknames package)\n (inspect-print \"nicknames: ~S\" (package-nicknames package)))\n (when (package-use-list package)\n (inspect-print \"use list: ~S\" (package-use-list package)))\n (when (package-used-by-list package)\n (inspect-print \"used-by list: ~S\" (package-used-by-list package)))\n (when (package-shadowing-symbols package)\n (inspect-print \"shadowing symbols: ~S\"\n (package-shadowing-symbols package))))\n\n".
1971*/
1972
1973/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:6238 **********************/
1974:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-package',[package],[format,t,'$STRING'("~S - package"),package],[when,['package-nicknames',package],['inspect-print','$STRING'("nicknames: ~S"),['package-nicknames',package]]],[when,['package-use-list',package],['inspect-print','$STRING'("use list: ~S"),['package-use-list',package]]],[when,['package-used-by-list',package],['inspect-print','$STRING'("used-by list: ~S"),['package-used-by-list',package]]],[when,['package-shadowing-symbols',package],['inspect-print','$STRING'("shadowing symbols: ~S"),['package-shadowing-symbols',package]]]])
1975/*
1976:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
1977 sys_inspect_package,
1978 kw_function,
1979 f_sys_inspect_package)).
1980*/
1981/*
1982% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"nicknames: ~S"),[package_nicknames,package]].
1983*/
1984/*
1985% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"nicknames: ~S"),[package_nicknames,package],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
1986*/
1987/*
1988% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"use list: ~S"),[package_use_list,package]].
1989*/
1990/*
1991% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"use list: ~S"),[package_use_list,package],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
1992*/
1993/*
1994% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"used-by list: ~S"),[package_used_by_list,package]].
1995*/
1996/*
1997% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"used-by list: ~S"),[package_used_by_list,package],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
1998*/
1999/*
2000% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"shadowing symbols: ~S"),[package_shadowing_symbols,package]].
2001*/
2002/*
2003% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"shadowing symbols: ~S"),[package_shadowing_symbols,package],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2004*/
2005wl:lambda_def(defun, sys_inspect_package, f_sys_inspect_package, [package], [[format, t, '$ARRAY'([*], claz_base_character, "~S - package"), package], [when, [package_nicknames, package], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "nicknames: ~S"), [package_nicknames, package]]], [when, [package_use_list, package], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "use list: ~S"), [package_use_list, package]]], [when, [package_used_by_list, package], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "used-by list: ~S"), [package_used_by_list, package]]], [when, [package_shadowing_symbols, package], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "shadowing symbols: ~S"), [package_shadowing_symbols, package]]]]).
2006wl:arglist_info(sys_inspect_package, f_sys_inspect_package, [package], arginfo{all:[package], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[package], opt:0, req:[package], rest:0, sublists:0, whole:0}).
2007wl: init_args(x, f_sys_inspect_package).
2008
2013f_sys_inspect_package(Package_In, FnResult) :-
2014 GEnv=[bv(package, Package_In)],
2015 catch(( ( get_var(GEnv, package, Package_Get),
2016 f_format(t,
2017 '$ARRAY'([*], claz_base_character, "~S - package"),
2018 [Package_Get],
2019 Format_Ret),
2020 get_var(GEnv, package, Package_Get8),
2021 f_package_nicknames(Package_Get8, IFTEST),
2022 ( IFTEST\==[]
2023 -> get_var(GEnv, package, Package_Get11),
2024 f_package_nicknames(Package_Get11, Package_nicknames_Ret),
2025 f_sys_read_inspect_command('$ARRAY'([*],
2026 claz_base_character,
2027 "nicknames: ~S"),
2028 Package_nicknames_Ret,
2029 [],
2030 IFTEST9),
2031 ( IFTEST9\==[]
2032 -> f_princ('$ARRAY'([*],
2033 claz_base_character,
2034 "Not updated."),
2035 [],
2036 Princ_Ret),
2037 f_terpri([], TrueResult),
2038 TrueResult13=TrueResult
2039 ; TrueResult13=[]
2040 ),
2041 _4942=TrueResult13
2042 ; _4942=[]
2043 ),
2044 get_var(GEnv, package, Package_Get16),
2045 f_package_use_list(Package_Get16, IFTEST14),
2046 ( IFTEST14\==[]
2047 -> get_var(GEnv, package, Package_Get19),
2048 f_package_use_list(Package_Get19, Use_list_Ret),
2049 f_sys_read_inspect_command('$ARRAY'([*],
2050 claz_base_character,
2051 "use list: ~S"),
2052 Use_list_Ret,
2053 [],
2054 IFTEST17),
2055 ( IFTEST17\==[]
2056 -> f_princ('$ARRAY'([*],
2057 claz_base_character,
2058 "Not updated."),
2059 [],
2060 Princ_Ret45),
2061 f_terpri([], TrueResult20),
2062 TrueResult21=TrueResult20
2063 ; TrueResult21=[]
2064 ),
2065 _5136=TrueResult21
2066 ; _5136=[]
2067 ),
2068 get_var(GEnv, package, Package_Get24),
2069 f_package_used_by_list(Package_Get24, IFTEST22),
2070 ( IFTEST22\==[]
2071 -> get_var(GEnv, package, Package_Get27),
2072 f_package_used_by_list(Package_Get27, By_list_Ret),
2073 f_sys_read_inspect_command('$ARRAY'([*],
2074 claz_base_character,
2075 "used-by list: ~S"),
2076 By_list_Ret,
2077 [],
2078 IFTEST25),
2079 ( IFTEST25\==[]
2080 -> f_princ('$ARRAY'([*],
2081 claz_base_character,
2082 "Not updated."),
2083 [],
2084 Princ_Ret47),
2085 f_terpri([], TrueResult28),
2086 TrueResult29=TrueResult28
2087 ; TrueResult29=[]
2088 ),
2089 _5346=TrueResult29
2090 ; _5346=[]
2091 ),
2092 get_var(GEnv, package, Package_Get32),
2093 f_package_shadowing_symbols(Package_Get32, IFTEST30),
2094 ( IFTEST30\==[]
2095 -> get_var(GEnv, package, Package_Get35),
2096 f_package_shadowing_symbols(Package_Get35,
2097 Shadowing_symbols_Ret),
2098 f_sys_read_inspect_command('$ARRAY'([*],
2099 claz_base_character,
2100 "shadowing symbols: ~S"),
2101 Shadowing_symbols_Ret,
2102 [],
2103 IFTEST33),
2104 ( IFTEST33\==[]
2105 -> f_princ('$ARRAY'([*],
2106 claz_base_character,
2107 "Not updated."),
2108 [],
2109 Princ_Ret49),
2110 f_terpri([], TrueResult36),
2111 TrueResult37=TrueResult36
2112 ; TrueResult37=[]
2113 ),
2114 _4922=TrueResult37
2115 ; _4922=[]
2116 )
2117 ),
2118 _4922=FnResult
2119 ),
2120 block_exit(sys_inspect_package, FnResult),
2121 true).
2122:- set_opv(sys_inspect_package, symbol_function, f_sys_inspect_package),
2123 DefunResult=sys_inspect_package. 2124/*
2125:- side_effect(assert_lsp(sys_inspect_package,
2126 lambda_def(defun,
2127 sys_inspect_package,
2128 f_sys_inspect_package,
2129 [package],
2130
2131 [
2132 [ format,
2133 t,
2134 '$ARRAY'([*],
2135 claz_base_character,
2136 "~S - package"),
2137 package
2138 ],
2139
2140 [ when,
2141 [package_nicknames, package],
2142
2143 [ sys_inspect_print,
2144 '$ARRAY'([*],
2145 claz_base_character,
2146 "nicknames: ~S"),
2147 [package_nicknames, package]
2148 ]
2149 ],
2150
2151 [ when,
2152 [package_use_list, package],
2153
2154 [ sys_inspect_print,
2155 '$ARRAY'([*],
2156 claz_base_character,
2157 "use list: ~S"),
2158 [package_use_list, package]
2159 ]
2160 ],
2161
2162 [ when,
2163 [package_used_by_list, package],
2164
2165 [ sys_inspect_print,
2166 '$ARRAY'([*],
2167 claz_base_character,
2168 "used-by list: ~S"),
2169 [package_used_by_list, package]
2170 ]
2171 ],
2172
2173 [ when,
2174 [package_shadowing_symbols, package],
2175
2176 [ sys_inspect_print,
2177 '$ARRAY'([*],
2178 claz_base_character,
2179 "shadowing symbols: ~S"),
2180 [package_shadowing_symbols, package]
2181 ]
2182 ]
2183 ]))).
2184*/
2185/*
2186:- side_effect(assert_lsp(sys_inspect_package,
2187 arglist_info(sys_inspect_package,
2188 f_sys_inspect_package,
2189 [package],
2190 arginfo{ all:[package],
2191 allow_other_keys:0,
2192 aux:0,
2193 body:0,
2194 complex:0,
2195 env:0,
2196 key:0,
2197 names:[package],
2198 opt:0,
2199 req:[package],
2200 rest:0,
2201 sublists:0,
2202 whole:0
2203 }))).
2204*/
2205/*
2206:- side_effect(assert_lsp(sys_inspect_package,
2207 init_args(x, f_sys_inspect_package))).
2208*/
2209/*
2210(defun inspect-character (character)
2211 (format t
2212 (cond ((standard-char-p character) ""(defun inspect-character (character)\n (format t\n (cond ((standard-char-p character) \"~S - standard character\")\n ((string-char-p character) \"~S - string character\")\n (t \"~S - character\"))\n character)\n (inspect-print \"code: #x~X\" (char-code character))\n (inspect-print \"bits: ~D\" (char-bits character))\n (inspect-print \"font: ~D\" (char-font character)))\n\n".
2213*/
2214
2215/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:6788 **********************/
2216:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-character',[character],[format,t,[cond,[['standard-char-p',character],'$STRING'("~S - standard character")],[['string-char-p',character],'$STRING'("~S - string character")],[t,'$STRING'("~S - character")]],character],['inspect-print','$STRING'("code: #x~X"),['char-code',character]],['inspect-print','$STRING'("bits: ~D"),['char-bits',character]],['inspect-print','$STRING'("font: ~D"),['char-font',character]]])
2217/*
2218:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
2219 sys_inspect_character,
2220 kw_function,
2221 f_sys_inspect_character)).
2222*/
2223/*
2224% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"code: #x~X"),[char_code,character]].
2225*/
2226/*
2227% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"code: #x~X"),[char_code,character],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2228*/
2229/*
2230% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"bits: ~D"),[sys_char_bits,character]].
2231*/
2232/*
2233% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"bits: ~D"),[sys_char_bits,character],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2234*/
2235/*
2236% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"font: ~D"),[sys_char_font,character]].
2237*/
2238/*
2239% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"font: ~D"),[sys_char_font,character],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2240*/
2241wl:lambda_def(defun, sys_inspect_character, f_sys_inspect_character, [character], [[format, t, [cond, [[standard_char_p, character], '$ARRAY'([*], claz_base_character, "~S - standard character")], [[sys_string_char_p, character], '$ARRAY'([*], claz_base_character, "~S - string character")], [t, '$ARRAY'([*], claz_base_character, "~S - character")]], character], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "code: #x~X"), [char_code, character]], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "bits: ~D"), [sys_char_bits, character]], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "font: ~D"), [sys_char_font, character]]]).
2242wl:arglist_info(sys_inspect_character, f_sys_inspect_character, [character], arginfo{all:[character], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[character], opt:0, req:[character], rest:0, sublists:0, whole:0}).
2243wl: init_args(x, f_sys_inspect_character).
2244
2249f_sys_inspect_character(Character_In, FnResult) :-
2250 GEnv=[bv(character, Character_In)],
2251 catch(( ( get_var(GEnv, character, Character_Get),
2252 f_standard_char_p(Character_Get, IFTEST),
2253 ( IFTEST\==[]
2254 -> _4456='$ARRAY'([*], claz_base_character, "~S - standard character")
2255 ; get_var(GEnv, character, Character_Get10),
2256 f_sys_string_char_p(Character_Get10, IFTEST8),
2257 ( IFTEST8\==[]
2258 -> ElseResult='$ARRAY'([*], claz_base_character, "~S - string character")
2259 ; ElseResult='$ARRAY'([*], claz_base_character, "~S - character")
2260 ),
2261 _4456=ElseResult
2262 ),
2263 get_var(GEnv, character, Character_Get12),
2264 f_format(t, _4456, [Character_Get12], Format_Ret),
2265 get_var(GEnv, character, Character_Get15),
2266 f_char_code(Character_Get15, Char_code_Ret),
2267 f_sys_read_inspect_command('$ARRAY'([*],
2268 claz_base_character,
2269 "code: #x~X"),
2270 Char_code_Ret,
2271 [],
2272 IFTEST13),
2273 ( IFTEST13\==[]
2274 -> f_princ('$ARRAY'([*], claz_base_character, "Not updated."),
2275 [],
2276 Princ_Ret),
2277 f_terpri([], TrueResult),
2278 _4626=TrueResult
2279 ; _4626=[]
2280 ),
2281 get_var(GEnv, character, Character_Get19),
2282 f_sys_char_bits(Character_Get19, Char_bits_Ret),
2283 f_sys_read_inspect_command('$ARRAY'([*],
2284 claz_base_character,
2285 "bits: ~D"),
2286 Char_bits_Ret,
2287 [],
2288 IFTEST17),
2289 ( IFTEST17\==[]
2290 -> f_princ('$ARRAY'([*], claz_base_character, "Not updated."),
2291 [],
2292 Princ_Ret32),
2293 f_terpri([], TrueResult20),
2294 _4724=TrueResult20
2295 ; _4724=[]
2296 ),
2297 get_var(GEnv, character, Character_Get23),
2298 f_sys_char_font(Character_Get23, Char_font_Ret),
2299 f_sys_read_inspect_command('$ARRAY'([*],
2300 claz_base_character,
2301 "font: ~D"),
2302 Char_font_Ret,
2303 [],
2304 IFTEST21),
2305 ( IFTEST21\==[]
2306 -> f_princ('$ARRAY'([*], claz_base_character, "Not updated."),
2307 [],
2308 Princ_Ret34),
2309 f_terpri([], TrueResult24),
2310 _4452=TrueResult24
2311 ; _4452=[]
2312 )
2313 ),
2314 _4452=FnResult
2315 ),
2316 block_exit(sys_inspect_character, FnResult),
2317 true).
2318:- set_opv(sys_inspect_character, symbol_function, f_sys_inspect_character),
2319 DefunResult=sys_inspect_character. 2320/*
2321:- side_effect(assert_lsp(sys_inspect_character,
2322 lambda_def(defun,
2323 sys_inspect_character,
2324 f_sys_inspect_character,
2325 [character],
2326
2327 [
2328 [ format,
2329 t,
2330
2331 [ cond,
2332
2333 [ [standard_char_p, character],
2334 '$ARRAY'([*],
2335 claz_base_character,
2336 "~S - standard character")
2337 ],
2338
2339 [ [sys_string_char_p, character],
2340 '$ARRAY'([*],
2341 claz_base_character,
2342 "~S - string character")
2343 ],
2344
2345 [ t,
2346 '$ARRAY'([*],
2347 claz_base_character,
2348 "~S - character")
2349 ]
2350 ],
2351 character
2352 ],
2353
2354 [ sys_inspect_print,
2355 '$ARRAY'([*],
2356 claz_base_character,
2357 "code: #x~X"),
2358 [char_code, character]
2359 ],
2360
2361 [ sys_inspect_print,
2362 '$ARRAY'([*],
2363 claz_base_character,
2364 "bits: ~D"),
2365 [sys_char_bits, character]
2366 ],
2367
2368 [ sys_inspect_print,
2369 '$ARRAY'([*],
2370 claz_base_character,
2371 "font: ~D"),
2372 [sys_char_font, character]
2373 ]
2374 ]))).
2375*/
2376/*
2377:- side_effect(assert_lsp(sys_inspect_character,
2378 arglist_info(sys_inspect_character,
2379 f_sys_inspect_character,
2380 [character],
2381 arginfo{ all:[character],
2382 allow_other_keys:0,
2383 aux:0,
2384 body:0,
2385 complex:0,
2386 env:0,
2387 key:0,
2388 names:[character],
2389 opt:0,
2390 req:[character],
2391 rest:0,
2392 sublists:0,
2393 whole:0
2394 }))).
2395*/
2396/*
2397:- side_effect(assert_lsp(sys_inspect_character,
2398 init_args(x, f_sys_inspect_character))).
2399*/
2400/*
2401(defun inspect-number (number)
2402 (case (type-of number)
2403 (FIXNUM (format t ""(defun inspect-number (number)\n (case (type-of number)\n (FIXNUM (format t \"~S - fixnum (32 bits)\" number))\n (BIGNUM (format t \"~S - bignum\" number))\n (RATIO\n (format t \"~S - ratio\" number)\n (inspect-recursively \"numerator:\" (numerator number))\n (inspect-recursively \"denominator:\" (denominator number)))\n (COMPLEX\n (format t \"~S - complex\" number)\n (inspect-recursively \"real part:\" (realpart number))\n (inspect-recursively \"imaginary part:\" (imagpart number)))\n ((SHORT-FLOAT SINGLE-FLOAT)\n (format t \"~S - short-float\" number)\n (multiple-value-bind (signif expon sign)\n (integer-decode-float number)\n (declare (ignore sign))\n (inspect-print \"exponent: ~D\" expon)\n (inspect-print \"mantissa: ~D\" signif)))\n ((LONG-FLOAT DOUBLE-FLOAT)\n (format t \"~S - long-float\" number)\n (multiple-value-bind (signif expon sign)\n (integer-decode-float number)\n (declare (ignore sign))\n (inspect-print \"exponent: ~D\" expon)\n (inspect-print \"mantissa: ~D\" signif)))))\n\n".
2404*/
2405
2406/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:7196 **********************/
2407:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-number',[number],[case,['type-of',number],['FIXNUM',[format,t,'$STRING'("~S - fixnum (32 bits)"),number]],['BIGNUM',[format,t,'$STRING'("~S - bignum"),number]],['RATIO',[format,t,'$STRING'("~S - ratio"),number],['inspect-recursively','$STRING'("numerator:"),[numerator,number]],['inspect-recursively','$STRING'("denominator:"),[denominator,number]]],['COMPLEX',[format,t,'$STRING'("~S - complex"),number],['inspect-recursively','$STRING'("real part:"),[realpart,number]],['inspect-recursively','$STRING'("imaginary part:"),[imagpart,number]]],[['SHORT-FLOAT','SINGLE-FLOAT'],[format,t,'$STRING'("~S - short-float"),number],['multiple-value-bind',[signif,expon,sign],['integer-decode-float',number],[declare,[ignore,sign]],['inspect-print','$STRING'("exponent: ~D"),expon],['inspect-print','$STRING'("mantissa: ~D"),signif]]],[['LONG-FLOAT','DOUBLE-FLOAT'],[format,t,'$STRING'("~S - long-float"),number],['multiple-value-bind',[signif,expon,sign],['integer-decode-float',number],[declare,[ignore,sign]],['inspect-print','$STRING'("exponent: ~D"),expon],['inspect-print','$STRING'("mantissa: ~D"),signif]]]]])
2408/*
2409:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
2410 sys_inspect_number,
2411 kw_function,
2412 f_sys_inspect_number)).
2413*/
2414/*
2415% case:-[[fixnum,[format,t,'$ARRAY'([*],claz_base_character,"~S - fixnum (32 bits)"),number]],[bignum,[format,t,'$ARRAY'([*],claz_base_character,"~S - bignum"),number]],[ratio,[format,t,'$ARRAY'([*],claz_base_character,"~S - ratio"),number],[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"numerator:"),[numerator,number]],[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"denominator:"),[denominator,number]]],[complex,[format,t,'$ARRAY'([*],claz_base_character,"~S - complex"),number],[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"real part:"),[realpart,number]],[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"imaginary part:"),[imagpart,number]]],[[short_float,single_float],[format,t,'$ARRAY'([*],claz_base_character,"~S - short-float"),number],[multiple_value_bind,[sys_signif,sys_expon,sys_sign],[integer_decode_float,number],[declare,[ignore,sys_sign]],[sys_inspect_print,'$ARRAY'([*],claz_base_character,"exponent: ~D"),sys_expon],[sys_inspect_print,'$ARRAY'([*],claz_base_character,"mantissa: ~D"),sys_signif]]],[[long_float,double_float],[format,t,'$ARRAY'([*],claz_base_character,"~S - long-float"),number],[multiple_value_bind,[sys_signif,sys_expon,sys_sign],[integer_decode_float,number],[declare,[ignore,sys_sign]],[sys_inspect_print,'$ARRAY'([*],claz_base_character,"exponent: ~D"),sys_expon],[sys_inspect_print,'$ARRAY'([*],claz_base_character,"mantissa: ~D"),sys_signif]]]].
2416*/
2417/*
2418% conds:-[[[eq,_15236,[quote,fixnum]],[progn,[format,t,'$ARRAY'([*],claz_base_character,"~S - fixnum (32 bits)"),number]]],[[eq,_15236,[quote,bignum]],[progn,[format,t,'$ARRAY'([*],claz_base_character,"~S - bignum"),number]]],[[eq,_15236,[quote,ratio]],[progn,[format,t,'$ARRAY'([*],claz_base_character,"~S - ratio"),number],[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"numerator:"),[numerator,number]],[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"denominator:"),[denominator,number]]]],[[eq,_15236,[quote,complex]],[progn,[format,t,'$ARRAY'([*],claz_base_character,"~S - complex"),number],[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"real part:"),[realpart,number]],[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"imaginary part:"),[imagpart,number]]]],[[sys_memq,_15236,[quote,[short_float,single_float]]],[progn,[format,t,'$ARRAY'([*],claz_base_character,"~S - short-float"),number],[multiple_value_bind,[sys_signif,sys_expon,sys_sign],[integer_decode_float,number],[declare,[ignore,sys_sign]],[sys_inspect_print,'$ARRAY'([*],claz_base_character,"exponent: ~D"),sys_expon],[sys_inspect_print,'$ARRAY'([*],claz_base_character,"mantissa: ~D"),sys_signif]]]],[[sys_memq,_15236,[quote,[long_float,double_float]]],[progn,[format,t,'$ARRAY'([*],claz_base_character,"~S - long-float"),number],[multiple_value_bind,[sys_signif,sys_expon,sys_sign],[integer_decode_float,number],[declare,[ignore,sys_sign]],[sys_inspect_print,'$ARRAY'([*],claz_base_character,"exponent: ~D"),sys_expon],[sys_inspect_print,'$ARRAY'([*],claz_base_character,"mantissa: ~D"),sys_signif]]]]].
2419*/
2420/*
2421% macroexpand:-[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"numerator:"),[numerator,number]].
2422*/
2423/*
2424% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"numerator:"),[numerator,number],t],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2425*/
2426/*
2427% macroexpand:-[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"denominator:"),[denominator,number]].
2428*/
2429/*
2430% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"denominator:"),[denominator,number],t],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2431*/
2432/*
2433% macroexpand:-[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"real part:"),[realpart,number]].
2434*/
2435/*
2436% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"real part:"),[realpart,number],t],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2437*/
2438/*
2439% macroexpand:-[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"imaginary part:"),[imagpart,number]].
2440*/
2441/*
2442% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"imaginary part:"),[imagpart,number],t],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2443*/
2444/*
2445% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"exponent: ~D"),sys_expon].
2446*/
2447/*
2448% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"exponent: ~D"),sys_expon,[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2449*/
2450/*
2451% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"mantissa: ~D"),sys_signif].
2452*/
2453/*
2454% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"mantissa: ~D"),sys_signif,[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2455*/
2456/*
2457% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"exponent: ~D"),sys_expon].
2458*/
2459/*
2460% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"exponent: ~D"),sys_expon,[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2461*/
2462/*
2463% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"mantissa: ~D"),sys_signif].
2464*/
2465/*
2466% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"mantissa: ~D"),sys_signif,[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
2467*/
2468wl:lambda_def(defun, sys_inspect_number, f_sys_inspect_number, [number], [[case, [type_of, number], [fixnum, [format, t, '$ARRAY'([*], claz_base_character, "~S - fixnum (32 bits)"), number]], [bignum, [format, t, '$ARRAY'([*], claz_base_character, "~S - bignum"), number]], [ratio, [format, t, '$ARRAY'([*], claz_base_character, "~S - ratio"), number], [sys_inspect_recursively, '$ARRAY'([*], claz_base_character, "numerator:"), [numerator, number]], [sys_inspect_recursively, '$ARRAY'([*], claz_base_character, "denominator:"), [denominator, number]]], [complex, [format, t, '$ARRAY'([*], claz_base_character, "~S - complex"), number], [sys_inspect_recursively, '$ARRAY'([*], claz_base_character, "real part:"), [realpart, number]], [sys_inspect_recursively, '$ARRAY'([*], claz_base_character, "imaginary part:"), [imagpart, number]]], [[short_float, single_float], [format, t, '$ARRAY'([*], claz_base_character, "~S - short-float"), number], [multiple_value_bind, [sys_signif, sys_expon, sys_sign], [integer_decode_float, number], [declare, [ignore, sys_sign]], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "exponent: ~D"), sys_expon], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "mantissa: ~D"), sys_signif]]], [[long_float, double_float], [format, t, '$ARRAY'([*], claz_base_character, "~S - long-float"), number], [multiple_value_bind, [sys_signif, sys_expon, sys_sign], [integer_decode_float, number], [declare, [ignore, sys_sign]], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "exponent: ~D"), sys_expon], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "mantissa: ~D"), sys_signif]]]]]).
2469wl:arglist_info(sys_inspect_number, f_sys_inspect_number, [number], arginfo{all:[number], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[number], opt:0, req:[number], rest:0, sublists:0, whole:0}).
2470wl: init_args(x, f_sys_inspect_number).
2471
2476f_sys_inspect_number(Number_In, FnResult) :-
2477 GEnv=[bv(number, Number_In)],
2478 catch(( ( get_var(GEnv, number, Number_Get),
2479 f_type_of(Number_Get, Key),
2480 ( is_eq(Key, fixnum)
2481 -> get_var(GEnv, number, Number_Get10),
2482 f_format(t,
2483 '$ARRAY'([*],
2484 claz_base_character,
2485 "~S - fixnum (32 bits)"),
2486 [Number_Get10],
2487 TrueResult76),
2488 _7304=TrueResult76
2489 ; ( is_eq(Key, bignum)
2490 -> get_var(GEnv, number, Number_Get13),
2491 f_format(t,
2492 '$ARRAY'([*],
2493 claz_base_character,
2494 "~S - bignum"),
2495 [Number_Get13],
2496 TrueResult74),
2497 ElseResult77=TrueResult74
2498 ; ( is_eq(Key, ratio)
2499 -> get_var(GEnv, number, Number_Get16),
2500 f_format(t,
2501 '$ARRAY'([*],
2502 claz_base_character,
2503 "~S - ratio"),
2504 [Number_Get16],
2505 Format_Ret),
2506 get_var(GEnv, number, Number_Get19),
2507 f_numerator(Number_Get19, Numerator_Ret),
2508 f_sys_read_inspect_command('$ARRAY'([*],
2509 claz_base_character,
2510 "numerator:"),
2511 Numerator_Ret,
2512 t,
2513 IFTEST17),
2514 ( IFTEST17\==[]
2515 -> f_princ('$ARRAY'([*],
2516 claz_base_character,
2517 "Not updated."),
2518 [],
2519 Princ_Ret),
2520 f_terpri([], TrueResult),
2521 _7592=TrueResult
2522 ; _7592=[]
2523 ),
2524 get_var(GEnv, number, Number_Get23),
2525 f_denominator(Number_Get23, Denominator_Ret),
2526 f_sys_read_inspect_command('$ARRAY'([*],
2527 claz_base_character,
2528 "denominator:"),
2529 Denominator_Ret,
2530 t,
2531 IFTEST21),
2532 ( IFTEST21\==[]
2533 -> f_princ('$ARRAY'([*],
2534 claz_base_character,
2535 "Not updated."),
2536 [],
2537 Princ_Ret85),
2538 f_terpri([], TrueResult24),
2539 TrueResult72=TrueResult24
2540 ; TrueResult72=[]
2541 ),
2542 ElseResult75=TrueResult72
2543 ; ( is_eq(Key, complex)
2544 -> get_var(GEnv, number, Number_Get27),
2545 f_format(t,
2546 '$ARRAY'([*],
2547 claz_base_character,
2548 "~S - complex"),
2549 [Number_Get27],
2550 Format_Ret86),
2551 get_var(GEnv, number, Number_Get30),
2552 f_realpart(Number_Get30, Realpart_Ret),
2553 f_sys_read_inspect_command('$ARRAY'([*],
2554 claz_base_character,
2555 "real part:"),
2556 Realpart_Ret,
2557 t,
2558 IFTEST28),
2559 ( IFTEST28\==[]
2560 -> f_princ('$ARRAY'([*],
2561 claz_base_character,
2562 "Not updated."),
2563 [],
2564 Princ_Ret88),
2565 f_terpri([], TrueResult31),
2566 _7876=TrueResult31
2567 ; _7876=[]
2568 ),
2569 get_var(GEnv, number, Number_Get34),
2570 f_imagpart(Number_Get34, Imagpart_Ret),
2571 f_sys_read_inspect_command('$ARRAY'([*],
2572 claz_base_character,
2573 "imaginary part:"),
2574 Imagpart_Ret,
2575 t,
2576 IFTEST32),
2577 ( IFTEST32\==[]
2578 -> f_princ('$ARRAY'([*],
2579 claz_base_character,
2580 "Not updated."),
2581 [],
2582 Princ_Ret90),
2583 f_terpri([], TrueResult35),
2584 TrueResult70=TrueResult35
2585 ; TrueResult70=[]
2586 ),
2587 ElseResult73=TrueResult70
2588 ; f_sys_memq(Key,
2589 [short_float, single_float],
2590 IFTEST36),
2591 ( IFTEST36\==[]
2592 -> get_var(GEnv, number, Number_Get38),
2593 f_format(t,
2594 '$ARRAY'([*],
2595 claz_base_character,
2596 "~S - short-float"),
2597 [Number_Get38],
2598 Format_Ret91),
2599 LEnv=[bv(sys_signif, []), bv(sys_expon, []), bv(sys_sign, [])|GEnv],
2600 get_var(LEnv, number, Number_Get42),
2601 f_integer_decode_float(Number_Get42,
2602 Decode_float_Ret),
2603 setq_from_values(LEnv,
2604
2605 [ sys_signif,
2606 sys_expon,
2607 sys_sign
2608 ]),
2609 sf_declare(LEnv,
2610 [ignore, sys_sign],
2611 Sf_declare_Ret),
2612 get_var(LEnv, sys_expon, Expon_Get),
2613 f_sys_read_inspect_command('$ARRAY'([*],
2614 claz_base_character,
2615 "exponent: ~D"),
2616 Expon_Get,
2617 [],
2618 IFTEST43),
2619 ( IFTEST43\==[]
2620 -> f_princ('$ARRAY'([*],
2621 claz_base_character,
2622 "Not updated."),
2623 [],
2624 Princ_Ret94),
2625 f_terpri([], TrueResult46),
2626 _8256=TrueResult46
2627 ; _8256=[]
2628 ),
2629 get_var(LEnv, sys_signif, Signif_Get),
2630 f_sys_read_inspect_command('$ARRAY'([*],
2631 claz_base_character,
2632 "mantissa: ~D"),
2633 Signif_Get,
2634 [],
2635 IFTEST47),
2636 ( IFTEST47\==[]
2637 -> f_princ('$ARRAY'([*],
2638 claz_base_character,
2639 "Not updated."),
2640 [],
2641 Princ_Ret95),
2642 f_terpri([], TrueResult50),
2643 LetResult=TrueResult50
2644 ; LetResult=[]
2645 ),
2646 ElseResult71=LetResult
2647 ; f_sys_memq(Key,
2648 [long_float, double_float],
2649 IFTEST51),
2650 ( IFTEST51\==[]
2651 -> get_var(GEnv, number, Number_Get53),
2652 f_format(t,
2653 '$ARRAY'([*],
2654 claz_base_character,
2655 "~S - long-float"),
2656 [Number_Get53],
2657 Format_Ret96),
2658 LEnv56=[bv(sys_signif, []), bv(sys_expon, []), bv(sys_sign, [])|GEnv],
2659 get_var(LEnv56, number, Number_Get57),
2660 f_integer_decode_float(Number_Get57,
2661 Decode_float_Ret97),
2662 setq_from_values(LEnv56,
2663
2664 [ sys_signif,
2665 sys_expon,
2666 sys_sign
2667 ]),
2668 sf_declare(LEnv56,
2669 [ignore, sys_sign],
2670 Sf_declare_Ret98),
2671 get_var(LEnv56,
2672 sys_expon,
2673 Expon_Get60),
2674 f_sys_read_inspect_command('$ARRAY'([*],
2675 claz_base_character,
2676 "exponent: ~D"),
2677 Expon_Get60,
2678 [],
2679 IFTEST58),
2680 ( IFTEST58\==[]
2681 -> f_princ('$ARRAY'([*],
2682 claz_base_character,
2683 "Not updated."),
2684 [],
2685 Princ_Ret99),
2686 f_terpri([], TrueResult61),
2687 _8640=TrueResult61
2688 ; _8640=[]
2689 ),
2690 get_var(LEnv56,
2691 sys_signif,
2692 Signif_Get64),
2693 f_sys_read_inspect_command('$ARRAY'([*],
2694 claz_base_character,
2695 "mantissa: ~D"),
2696 Signif_Get64,
2697 [],
2698 IFTEST62),
2699 ( IFTEST62\==[]
2700 -> f_princ('$ARRAY'([*],
2701 claz_base_character,
2702 "Not updated."),
2703 [],
2704 Princ_Ret100),
2705 f_terpri([], TrueResult65),
2706 LetResult55=TrueResult65
2707 ; LetResult55=[]
2708 ),
2709 ElseResult69=LetResult55
2710 ; ElseResult=[],
2711 ElseResult69=ElseResult
2712 ),
2713 ElseResult71=ElseResult69
2714 ),
2715 ElseResult73=ElseResult71
2716 ),
2717 ElseResult75=ElseResult73
2718 ),
2719 ElseResult77=ElseResult75
2720 ),
2721 _7304=ElseResult77
2722 )
2723 ),
2724 _7304=FnResult
2725 ),
2726 block_exit(sys_inspect_number, FnResult),
2727 true).
2728:- set_opv(sys_inspect_number, symbol_function, f_sys_inspect_number),
2729 DefunResult=sys_inspect_number. 2730/*
2731:- side_effect(assert_lsp(sys_inspect_number,
2732 lambda_def(defun,
2733 sys_inspect_number,
2734 f_sys_inspect_number,
2735 [number],
2736
2737 [
2738 [ case,
2739 [type_of, number],
2740
2741 [ fixnum,
2742
2743 [ format,
2744 t,
2745 '$ARRAY'([*],
2746 claz_base_character,
2747 "~S - fixnum (32 bits)"),
2748 number
2749 ]
2750 ],
2751
2752 [ bignum,
2753
2754 [ format,
2755 t,
2756 '$ARRAY'([*],
2757 claz_base_character,
2758 "~S - bignum"),
2759 number
2760 ]
2761 ],
2762
2763 [ ratio,
2764
2765 [ format,
2766 t,
2767 '$ARRAY'([*],
2768 claz_base_character,
2769 "~S - ratio"),
2770 number
2771 ],
2772
2773 [ sys_inspect_recursively,
2774 '$ARRAY'([*],
2775 claz_base_character,
2776 "numerator:"),
2777 [numerator, number]
2778 ],
2779
2780 [ sys_inspect_recursively,
2781 '$ARRAY'([*],
2782 claz_base_character,
2783 "denominator:"),
2784 [denominator, number]
2785 ]
2786 ],
2787
2788 [ complex,
2789
2790 [ format,
2791 t,
2792 '$ARRAY'([*],
2793 claz_base_character,
2794 "~S - complex"),
2795 number
2796 ],
2797
2798 [ sys_inspect_recursively,
2799 '$ARRAY'([*],
2800 claz_base_character,
2801 "real part:"),
2802 [realpart, number]
2803 ],
2804
2805 [ sys_inspect_recursively,
2806 '$ARRAY'([*],
2807 claz_base_character,
2808 "imaginary part:"),
2809 [imagpart, number]
2810 ]
2811 ],
2812
2813 [ [short_float, single_float],
2814
2815 [ format,
2816 t,
2817 '$ARRAY'([*],
2818 claz_base_character,
2819 "~S - short-float"),
2820 number
2821 ],
2822
2823 [ multiple_value_bind,
2824 [sys_signif, sys_expon, sys_sign],
2825 [integer_decode_float, number],
2826 [declare, [ignore, sys_sign]],
2827
2828 [ sys_inspect_print,
2829 '$ARRAY'([*],
2830 claz_base_character,
2831 "exponent: ~D"),
2832 sys_expon
2833 ],
2834
2835 [ sys_inspect_print,
2836 '$ARRAY'([*],
2837 claz_base_character,
2838 "mantissa: ~D"),
2839 sys_signif
2840 ]
2841 ]
2842 ],
2843
2844 [ [long_float, double_float],
2845
2846 [ format,
2847 t,
2848 '$ARRAY'([*],
2849 claz_base_character,
2850 "~S - long-float"),
2851 number
2852 ],
2853
2854 [ multiple_value_bind,
2855 [sys_signif, sys_expon, sys_sign],
2856 [integer_decode_float, number],
2857 [declare, [ignore, sys_sign]],
2858
2859 [ sys_inspect_print,
2860 '$ARRAY'([*],
2861 claz_base_character,
2862 "exponent: ~D"),
2863 sys_expon
2864 ],
2865
2866 [ sys_inspect_print,
2867 '$ARRAY'([*],
2868 claz_base_character,
2869 "mantissa: ~D"),
2870 sys_signif
2871 ]
2872 ]
2873 ]
2874 ]
2875 ]))).
2876*/
2877/*
2878:- side_effect(assert_lsp(sys_inspect_number,
2879 arglist_info(sys_inspect_number,
2880 f_sys_inspect_number,
2881 [number],
2882 arginfo{ all:[number],
2883 allow_other_keys:0,
2884 aux:0,
2885 body:0,
2886 complex:0,
2887 env:0,
2888 key:0,
2889 names:[number],
2890 opt:0,
2891 req:[number],
2892 rest:0,
2893 sublists:0,
2894 whole:0
2895 }))).
2896*/
2897/*
2898:- side_effect(assert_lsp(sys_inspect_number,
2899 init_args(x, f_sys_inspect_number))).
2900*/
2901/*
2902(defun inspect-cons (cons)
2903 (format t
2904 (case
2905 #-LOCATIVE (car cons)
2906 #+LOCATIVE
2907 (let ((acar (car cons)))
2908 (cond ((locativep acar)
2909 (dereference acar))
2910 ((sl-boundp acar) acar)
2911 (t nil)))
2912 ((LAMBDA LAMBDA-BLOCK LAMBDA-CLOSURE LAMBDA-BLOCK-CLOSURE)
2913 ""(defun inspect-cons (cons)\n (format t\n (case\n\t #-LOCATIVE (car cons)\n\t #+LOCATIVE\n\t (let ((acar (car cons)))\n\t\t(cond ((locativep acar)\n\t\t (dereference acar))\n\t\t ((sl-boundp acar) acar)\n\t\t (t nil)))\n ((LAMBDA LAMBDA-BLOCK LAMBDA-CLOSURE LAMBDA-BLOCK-CLOSURE)\n \"~S - function\")\n (QUOTE \"~S - constant\")\n (t \"~S - cons\"))\n cons)\n (when *inspect-mode*\n (do ((i 0 (1+ i))\n (l cons (cdr l)))\n ((atom l)\n (inspect-recursively (format nil \"nthcdr ~D:\" i)\n l (cdr (nthcdr (1- i) cons))))\n (inspect-recursively (format nil \"nth ~D:\" i)\n (car l) (nth i cons)))))\n\n".
2914*/
2915
2916/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:8264 **********************/
2917:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-cons',[cons],[format,t,[case,[car,cons],[['LAMBDA','LAMBDA-BLOCK','LAMBDA-CLOSURE','LAMBDA-BLOCK-CLOSURE'],'$STRING'("~S - function")],['QUOTE','$STRING'("~S - constant")],[t,'$STRING'("~S - cons")]],cons],[when,'*inspect-mode*',[do,[[i,0,['1+',i]],[l,cons,[cdr,l]]],[[atom,l],['inspect-recursively',[format,[],'$STRING'("nthcdr ~D:"),i],l,[cdr,[nthcdr,['1-',i],cons]]]],['inspect-recursively',[format,[],'$STRING'("nth ~D:"),i],[car,l],[nth,i,cons]]]]])
2918/*
2919:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
2920 sys_inspect_cons,
2921 kw_function,
2922 f_sys_inspect_cons)).
2923*/
2924/*
2925% case:-[[[lambda,sys_lambda_block,sys_lambda_closure,sys_lambda_block_closure],'$ARRAY'([*],claz_base_character,"~S - function")],[quote,'$ARRAY'([*],claz_base_character,"~S - constant")],[t,'$ARRAY'([*],claz_base_character,"~S - cons")]].
2926*/
2927/*
2928% conds:-[[[sys_memq,_28620,[quote,[lambda,sys_lambda_block,sys_lambda_closure,sys_lambda_block_closure]]],[progn,'$ARRAY'([*],claz_base_character,"~S - function")]],[[eq,_28620,[quote,quote]],[progn,'$ARRAY'([*],claz_base_character,"~S - constant")]],[t,[progn,'$ARRAY'([*],claz_base_character,"~S - cons")]]].
2929*/
2930/*
2931% macroexpand:-[sys_inspect_recursively,[format,[],'$ARRAY'([*],claz_base_character,"nthcdr ~D:"),sys_i],sys_l,[cdr,[nthcdr,['1-',sys_i],cons]]].
2932*/
2933/*
2934% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,[format,[],'$ARRAY'([*],claz_base_character,"nthcdr ~D:"),sys_i],sys_l,t],[when,sys_update_flag,[setf,[cdr,[nthcdr,['1-',sys_i],cons]],sys_new_value]]].
2935*/
2936/*
2937:-side_effect((compile_each([name='GLOBAL',environ=env_1],_15198,[],[],true),append([[nthcdr,['1-',sys_i],cons]],[_55396,_24682],[[nthcdr,['1-',sys_i],cons],_55396,_24682]),setf_inverse_op(cdr,rplacd))).
2938*/
2939/*
2940:-side_effect((compile_each([name='GLOBAL',environ=env_1],_15164,[],[],true),append([[nthcdr,['1-',sys_i],cons]],[_60644,_29930],[[nthcdr,['1-',sys_i],cons],_60644,_29930]),setf_inverse_op(cdr,rplacd))).
2941*/
2942/*
2943% macroexpand:-[sys_inspect_recursively,[format,[],'$ARRAY'([*],claz_base_character,"nth ~D:"),sys_i],[car,sys_l],[nth,sys_i,cons]].
2944*/
2945/*
2946% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,[format,[],'$ARRAY'([*],claz_base_character,"nth ~D:"),sys_i],[car,sys_l],t],[when,sys_update_flag,[setf,[nth,sys_i,cons],sys_new_value]]].
2947*/
2948/*
2949:-failure(show_call_trace((compile_each([name='GLOBAL',environ=env_1],_16098,[cons],_39218,_33890),append([sys_i|_39218],[_58260,_58088],_39234),setf_inverse_op(nth,_33878)))).
2950*/
2951/*
2952:-failure(show_call_trace((compile_each([name='GLOBAL',environ=env_1],_16076,[cons],_17668,_17626),append([sys_i|_17668],[_22176,_22004],_17684),setf_inverse_op(nth,_17614)))).
2953*/
2954/*
2955% macroexpand:-[sys_inspect_recursively,[format,[],'$ARRAY'([*],claz_base_character,"nthcdr ~D:"),sys_i],sys_l,[cdr,[nthcdr,['1-',sys_i],cons]]].
2956*/
2957/*
2958% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,[format,[],'$ARRAY'([*],claz_base_character,"nthcdr ~D:"),sys_i],sys_l,t],[when,sys_update_flag,[setf,[cdr,[nthcdr,['1-',sys_i],cons]],sys_new_value]]].
2959*/
2960/*
2961:-side_effect((compile_each([name='GLOBAL',environ=env_1],_17454,[],[],true),append([[nthcdr,['1-',sys_i],cons]],[_57798,_57626],[[nthcdr,['1-',sys_i],cons],_57798,_57626]),setf_inverse_op(cdr,rplacd))).
2962*/
2963/*
2964:-side_effect((compile_each([name='GLOBAL',environ=env_1],_17444,[],[],true),append([[nthcdr,['1-',sys_i],cons]],[_62992,_62820],[[nthcdr,['1-',sys_i],cons],_62992,_62820]),setf_inverse_op(cdr,rplacd))).
2965*/
2966/*
2967% macroexpand:-[sys_inspect_recursively,[format,[],'$ARRAY'([*],claz_base_character,"nth ~D:"),sys_i],[car,sys_l],[nth,sys_i,cons]].
2968*/
2969/*
2970% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,[format,[],'$ARRAY'([*],claz_base_character,"nth ~D:"),sys_i],[car,sys_l],t],[when,sys_update_flag,[setf,[nth,sys_i,cons],sys_new_value]]].
2971*/
2972/*
2973:-failure(show_call_trace((compile_each([name='GLOBAL',environ=env_1],_18472,[cons],_41592,_36264),append([sys_i|_41592],[_60634,_60462],_41608),setf_inverse_op(nth,_36252)))).
2974*/
2975/*
2976:-failure(show_call_trace((compile_each([name='GLOBAL',environ=env_1],_18442,[cons],_20034,_19992),append([sys_i|_20034],[_24542,_24370],_20050),setf_inverse_op(nth,_19980)))).
2977*/
2978wl:lambda_def(defun, sys_inspect_cons, f_sys_inspect_cons, [cons], [[format, t, [case, [car, cons], [[lambda, sys_lambda_block, sys_lambda_closure, sys_lambda_block_closure], '$ARRAY'([*], claz_base_character, "~S - function")], [quote, '$ARRAY'([*], claz_base_character, "~S - constant")], [t, '$ARRAY'([*], claz_base_character, "~S - cons")]], cons], [when, sys_xx_inspect_mode_xx, [do, [[sys_i, 0, ['1+', sys_i]], [sys_l, cons, [cdr, sys_l]]], [[atom, sys_l], [sys_inspect_recursively, [format, [], '$ARRAY'([*], claz_base_character, "nthcdr ~D:"), sys_i], sys_l, [cdr, [nthcdr, ['1-', sys_i], cons]]]], [sys_inspect_recursively, [format, [], '$ARRAY'([*], claz_base_character, "nth ~D:"), sys_i], [car, sys_l], [nth, sys_i, cons]]]]]).
2979wl:arglist_info(sys_inspect_cons, f_sys_inspect_cons, [cons], arginfo{all:[cons], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[cons], opt:0, req:[cons], rest:0, sublists:0, whole:0}).
2980wl: init_args(x, f_sys_inspect_cons).
2981
2986f_sys_inspect_cons(Cons_In, FnResult) :-
2987 GEnv=[bv(cons, Cons_In)],
2988 catch(( ( get_var(GEnv, cons, Cons_Get),
2989 f_car(Cons_Get, Key),
2990 f_sys_memq(Key,
2991
2992 [ lambda,
2993 sys_lambda_block,
2994 sys_lambda_closure,
2995 sys_lambda_block_closure
2996 ],
2997 IFTEST),
2998 ( IFTEST\==[]
2999 -> _5174='$ARRAY'([*], claz_base_character, "~S - function")
3000 ; ( is_eq(Key, quote)
3001 -> ElseResult='$ARRAY'([*], claz_base_character, "~S - constant")
3002 ; ElseResult='$ARRAY'([*], claz_base_character, "~S - cons")
3003 ),
3004 _5174=ElseResult
3005 ),
3006 get_var(GEnv, cons, Cons_Get13),
3007 f_format(t, _5174, [Cons_Get13], Format_Ret),
3008 get_var(GEnv, sys_xx_inspect_mode_xx, IFTEST14),
3009 ( IFTEST14\==[]
3010 -> get_var(GEnv, cons, Cons_Get20),
3011 BlockExitEnv=[bv(sys_i, 0), bv(sys_l, Cons_Get20)|GEnv],
3012 catch(( call_addr_block(BlockExitEnv,
3013 (push_label(do_label_3), get_var(BlockExitEnv, sys_l, L_Get66), (L_Get66\=[CAR123|CDR]->LEnv73=[bv(sys_update_flag, []), bv(sys_new_value, [])|BlockExitEnv], get_var(LEnv73, sys_i, I_Get74), f_format([], '$ARRAY'([*], claz_base_character, "nthcdr ~D:"), [I_Get74], Inspect_command_Param), get_var(LEnv73, sys_l, L_Get75), f_sys_read_inspect_command(Inspect_command_Param, L_Get75, t, T), setq_from_values(LEnv73, [sys_update_flag, sys_new_value]), get_var(LEnv73, sys_update_flag, IFTEST76), (IFTEST76\==[]->get_var(LEnv73, sys_i, I_Get81), 'f_1-'(I_Get81, Nthcdr_Param), get_var(LEnv73, cons, Cons_Get82), f_nthcdr(Nthcdr_Param, Cons_Get82, Rplacd_Param), get_var(LEnv73, sys_new_value, New_value_Get83), f_rplacd(Rplacd_Param, New_value_Get83, TrueResult84), RetResult69=TrueResult84;RetResult69=[]), throw(block_exit([], RetResult69)), _TBResult=ThrowResult70;LEnv88=[bv(sys_update_flag, []), bv(sys_new_value, [])|BlockExitEnv], get_var(LEnv88, sys_i, I_Get89), f_format([], '$ARRAY'([*], claz_base_character, "nth ~D:"), [I_Get89], Inspect_command_Param117), get_var(LEnv88, sys_l, L_Get90), f_car(L_Get90, Car_Ret), f_sys_read_inspect_command(Inspect_command_Param117, Car_Ret, t, T111), setq_from_values(LEnv88, [sys_update_flag, sys_new_value]), get_var(LEnv88, sys_update_flag, IFTEST91), (IFTEST91\==[]->get_var(LEnv88, cons, Cons_Get98), get_var(LEnv88, sys_i, I_Get97), get_var(LEnv88, sys_new_value, New_value_Get94), set_place(LEnv88, setf, [nth, I_Get97, Cons_Get98], [New_value_Get94], Setf_R95), LetResult87=Setf_R95;LetResult87=[]), get_var(BlockExitEnv, sys_i, I_Get100), 'f_1+'(I_Get100, I), get_var(BlockExitEnv, sys_l, L_Get101), f_cdr(L_Get101, L), set_var(BlockExitEnv, sys_i, I), set_var(BlockExitEnv, sys_l, L), goto(do_label_3, BlockExitEnv), _TBResult=_GORES102)),
3014
3015 [ addr(addr_tagbody_3_do_label_3,
3016 do_label_3,
3017 '$unused',
3018 BlockExitEnv,
3019 (get_var(BlockExitEnv, sys_l, L_Get), (L_Get\=[CAR126|CDR127]->LEnv31=[bv(sys_update_flag, []), bv(sys_new_value, [])|BlockExitEnv], get_var(LEnv31, sys_i, Get_var_Ret), f_format([], '$ARRAY'([*], claz_base_character, "nthcdr ~D:"), [Get_var_Ret], Inspect_command_Param118), get_var(LEnv31, sys_l, L_Get33), f_sys_read_inspect_command(Inspect_command_Param118, L_Get33, t, Inspect_command_Ret), setq_from_values(LEnv31, [sys_update_flag, sys_new_value]), get_var(LEnv31, sys_update_flag, IFTEST34), (IFTEST34\==[]->get_var(LEnv31, sys_i, I_Get39), 'f_1-'(I_Get39, Nthcdr_Param119), get_var(LEnv31, cons, Cons_Get40), f_nthcdr(Nthcdr_Param119, Cons_Get40, Rplacd_Param120), get_var(LEnv31, sys_new_value, Get_var_Ret130), f_rplacd(Rplacd_Param120, Get_var_Ret130, Rplacd_Ret), LetResult30=Rplacd_Ret;LetResult30=[]), throw(block_exit([], LetResult30)), _7670=ThrowResult;LEnv46=[bv(sys_update_flag, []), bv(sys_new_value, [])|BlockExitEnv], get_var(LEnv46, sys_i, I_Get47), f_format([], '$ARRAY'([*], claz_base_character, "nth ~D:"), [I_Get47], Inspect_command_Param121), get_var(LEnv46, sys_l, L_Get48), f_car(L_Get48, Car_Ret132), f_sys_read_inspect_command(Inspect_command_Param121, Car_Ret132, t, Inspect_command_Ret133), setq_from_values(LEnv46, [sys_update_flag, sys_new_value]), get_var(LEnv46, sys_update_flag, IFTEST49), (IFTEST49\==[]->get_var(LEnv46, cons, Cons_Get56), get_var(LEnv46, sys_i, I_Get55), get_var(LEnv46, sys_new_value, New_value_Get52), set_place(LEnv46, setf, [nth, I_Get55, Cons_Get56], [New_value_Get52], Setf_R), LetResult45=Setf_R;LetResult45=[]), get_var(BlockExitEnv, sys_i, I_Get58), 'f_1+'(I_Get58, Set_var_Ret), get_var(BlockExitEnv, sys_l, L_Get59), f_cdr(L_Get59, Cdr_Ret), set_var(BlockExitEnv, sys_i, Set_var_Ret), set_var(BlockExitEnv, sys_l, Cdr_Ret), goto(do_label_3, BlockExitEnv), _7670=_GORES)))
3020 ]),
3021 []=LetResult
3022 ),
3023 block_exit([], LetResult),
3024 true),
3025 _5170=LetResult
3026 ; _5170=[]
3027 )
3028 ),
3029 _5170=FnResult
3030 ),
3031 block_exit(sys_inspect_cons, FnResult),
3032 true).
3033:- set_opv(sys_inspect_cons, symbol_function, f_sys_inspect_cons),
3034 DefunResult=sys_inspect_cons. 3035/*
3036:- side_effect(assert_lsp(sys_inspect_cons,
3037 lambda_def(defun,
3038 sys_inspect_cons,
3039 f_sys_inspect_cons,
3040 [cons],
3041
3042 [
3043 [ format,
3044 t,
3045
3046 [ case,
3047 [car, cons],
3048
3049 [
3050 [ lambda,
3051 sys_lambda_block,
3052 sys_lambda_closure,
3053 sys_lambda_block_closure
3054 ],
3055 '$ARRAY'([*],
3056 claz_base_character,
3057 "~S - function")
3058 ],
3059
3060 [ quote,
3061 '$ARRAY'([*],
3062 claz_base_character,
3063 "~S - constant")
3064 ],
3065
3066 [ t,
3067 '$ARRAY'([*],
3068 claz_base_character,
3069 "~S - cons")
3070 ]
3071 ],
3072 cons
3073 ],
3074
3075 [ when,
3076 sys_xx_inspect_mode_xx,
3077
3078 [ do,
3079
3080 [ [sys_i, 0, ['1+', sys_i]],
3081 [sys_l, cons, [cdr, sys_l]]
3082 ],
3083
3084 [ [atom, sys_l],
3085
3086 [ sys_inspect_recursively,
3087
3088 [ format,
3089 [],
3090 '$ARRAY'([*],
3091 claz_base_character,
3092 "nthcdr ~D:"),
3093 sys_i
3094 ],
3095 sys_l,
3096
3097 [ cdr,
3098 [nthcdr, ['1-', sys_i], cons]
3099 ]
3100 ]
3101 ],
3102
3103 [ sys_inspect_recursively,
3104
3105 [ format,
3106 [],
3107 '$ARRAY'([*],
3108 claz_base_character,
3109 "nth ~D:"),
3110 sys_i
3111 ],
3112 [car, sys_l],
3113 [nth, sys_i, cons]
3114 ]
3115 ]
3116 ]
3117 ]))).
3118*/
3119/*
3120:- side_effect(assert_lsp(sys_inspect_cons,
3121 arglist_info(sys_inspect_cons,
3122 f_sys_inspect_cons,
3123 [cons],
3124 arginfo{ all:[cons],
3125 allow_other_keys:0,
3126 aux:0,
3127 body:0,
3128 complex:0,
3129 env:0,
3130 key:0,
3131 names:[cons],
3132 opt:0,
3133 req:[cons],
3134 rest:0,
3135 sublists:0,
3136 whole:0
3137 }))).
3138*/
3139/*
3140:- side_effect(assert_lsp(sys_inspect_cons, init_args(x, f_sys_inspect_cons))).
3141*/
3142/*
3143(defun inspect-string (string)
3144 (format t (if (simple-string-p string) ""(defun inspect-string (string)\n (format t (if (simple-string-p string) \"~S - simple string\" \"~S - string\")\n string)\n (inspect-print \"dimension: ~D\"(array-dimension string 0))\n (when (array-has-fill-pointer-p string)\n (inspect-print \"fill pointer: ~D\"\n (fill-pointer string)\n (fill-pointer string)))\n (when *inspect-mode*\n (dotimes (i (array-dimension string 0))\n (inspect-recursively (format nil \"aref ~D:\" i)\n (char string i)\n (char string i)))))\n\n".
3145*/
3146
3147/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:9027 **********************/
3148:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-string',[string],[format,t,[if,['simple-string-p',string],'$STRING'("~S - simple string"),'$STRING'("~S - string")],string],['inspect-print','$STRING'("dimension: ~D"),['array-dimension',string,0]],[when,['array-has-fill-pointer-p',string],['inspect-print','$STRING'("fill pointer: ~D"),['fill-pointer',string],['fill-pointer',string]]],[when,'*inspect-mode*',[dotimes,[i,['array-dimension',string,0]],['inspect-recursively',[format,[],'$STRING'("aref ~D:"),i],[char,string,i],[char,string,i]]]]])
3149/*
3150:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
3151 sys_inspect_string,
3152 kw_function,
3153 f_sys_inspect_string)).
3154*/
3155/*
3156% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"dimension: ~D"),[array_dimension,string,0]].
3157*/
3158/*
3159% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"dimension: ~D"),[array_dimension,string,0],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
3160*/
3161/*
3162% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"fill pointer: ~D"),[fill_pointer,string],[fill_pointer,string]].
3163*/
3164/*
3165% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"fill pointer: ~D"),[fill_pointer,string],[]],[when,sys_update_flag,[setf,[fill_pointer,string],sys_new_value]]].
3166*/
3167/*
3168:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv, [], CDR, Compile_each_Ret), append([string|CDR], [CAR27, CAR], Append_Ret), setf_inverse_op(fill_pointer, Inverse_op_Ret)))).
3169*/
3170/*
3171:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv, [], CDR, Compile_each_Ret), append([string|CDR], [CAR27, CAR], Append_Ret), setf_inverse_op(fill_pointer, Inverse_op_Ret)))).
3172*/
3173wl:lambda_def(defun, sys_inspect_string, f_sys_inspect_string, [string], [[format, t, [if, [simple_string_p, string], '$ARRAY'([*], claz_base_character, "~S - simple string"), '$ARRAY'([*], claz_base_character, "~S - string")], string], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "dimension: ~D"), [array_dimension, string, 0]], [when, [array_has_fill_pointer_p, string], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "fill pointer: ~D"), [fill_pointer, string], [fill_pointer, string]]], [when, sys_xx_inspect_mode_xx, [dotimes, [sys_i, [array_dimension, string, 0]], [sys_inspect_recursively, [format, [], '$ARRAY'([*], claz_base_character, "aref ~D:"), sys_i], [char, string, sys_i], [char, string, sys_i]]]]]).
3174wl:arglist_info(sys_inspect_string, f_sys_inspect_string, [string], arginfo{all:[string], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[string], opt:0, req:[string], rest:0, sublists:0, whole:0}).
3175wl: init_args(x, f_sys_inspect_string).
3176
3181f_sys_inspect_string(String_In, FnResult) :-
3182 GEnv=[bv(string, String_In)],
3183 catch(( ( get_var(GEnv, string, String_Get),
3184 f_simple_string_p(String_Get, IFTEST),
3185 ( IFTEST\==[]
3186 -> _4664='$ARRAY'([*], claz_base_character, "~S - simple string")
3187 ; _4664='$ARRAY'([*], claz_base_character, "~S - string")
3188 ),
3189 get_var(GEnv, string, String_Get8),
3190 f_format(t, _4664, [String_Get8], Format_Ret),
3191 get_var(GEnv, string, String_Get11),
3192 f_array_dimension(String_Get11, 0, Array_dimension_Ret),
3193 f_sys_read_inspect_command('$ARRAY'([*],
3194 claz_base_character,
3195 "dimension: ~D"),
3196 Array_dimension_Ret,
3197 [],
3198 IFTEST9),
3199 ( IFTEST9\==[]
3200 -> f_princ('$ARRAY'([*], claz_base_character, "Not updated."),
3201 [],
3202 Princ_Ret),
3203 f_terpri([], TrueResult),
3204 _4750=TrueResult
3205 ; _4750=[]
3206 ),
3207 get_var(GEnv, string, String_Get15),
3208 f_array_has_fill_pointer_p(String_Get15, IFTEST13),
3209 ( IFTEST13\==[]
3210 -> LEnv=[bv(sys_update_flag, []), bv(sys_new_value, [])|GEnv],
3211 get_var(LEnv, string, String_Get19),
3212 f_fill_pointer(String_Get19, Fill_pointer_Ret),
3213 f_sys_read_inspect_command('$ARRAY'([*],
3214 claz_base_character,
3215 "fill pointer: ~D"),
3216 Fill_pointer_Ret,
3217 [],
3218 Inspect_command_Ret),
3219 setq_from_values(LEnv, [sys_update_flag, sys_new_value]),
3220 get_var(LEnv, sys_update_flag, IFTEST20),
3221 ( IFTEST20\==[]
3222 -> get_var(LEnv, string, String_Get26),
3223 get_var(LEnv, sys_new_value, New_value_Get),
3224 set_place(LEnv,
3225 setf,
3226 [fill_pointer, String_Get26],
3227 [New_value_Get],
3228 Setf_R),
3229 LetResult=Setf_R
3230 ; LetResult=[]
3231 ),
3232 _4848=LetResult
3233 ; _4848=[]
3234 ),
3235 get_var(GEnv, sys_xx_inspect_mode_xx, IFTEST29),
3236 ( IFTEST29\==[]
3237 -> sf_dotimes(GEnv,
3238 [sys_i, [array_dimension, string, 0]],
3239
3240 [ sys_inspect_recursively,
3241
3242 [ format,
3243 [],
3244 '$ARRAY'([*],
3245 claz_base_character,
3246 "aref ~D:"),
3247 sys_i
3248 ],
3249 [char, string, sys_i],
3250 [char, string, sys_i]
3251 ],
3252 TrueResult32),
3253 _4660=TrueResult32
3254 ; _4660=[]
3255 )
3256 ),
3257 _4660=FnResult
3258 ),
3259 block_exit(sys_inspect_string, FnResult),
3260 true).
3261:- set_opv(sys_inspect_string, symbol_function, f_sys_inspect_string),
3262 DefunResult=sys_inspect_string. 3263/*
3264:- side_effect(assert_lsp(sys_inspect_string,
3265 lambda_def(defun,
3266 sys_inspect_string,
3267 f_sys_inspect_string,
3268 [string],
3269
3270 [
3271 [ format,
3272 t,
3273
3274 [ if,
3275 [simple_string_p, string],
3276 '$ARRAY'([*],
3277 claz_base_character,
3278 "~S - simple string"),
3279 '$ARRAY'([*],
3280 claz_base_character,
3281 "~S - string")
3282 ],
3283 string
3284 ],
3285
3286 [ sys_inspect_print,
3287 '$ARRAY'([*],
3288 claz_base_character,
3289 "dimension: ~D"),
3290 [array_dimension, string, 0]
3291 ],
3292
3293 [ when,
3294 [array_has_fill_pointer_p, string],
3295
3296 [ sys_inspect_print,
3297 '$ARRAY'([*],
3298 claz_base_character,
3299 "fill pointer: ~D"),
3300 [fill_pointer, string],
3301 [fill_pointer, string]
3302 ]
3303 ],
3304
3305 [ when,
3306 sys_xx_inspect_mode_xx,
3307
3308 [ dotimes,
3309 [sys_i, [array_dimension, string, 0]],
3310
3311 [ sys_inspect_recursively,
3312
3313 [ format,
3314 [],
3315 '$ARRAY'([*],
3316 claz_base_character,
3317 "aref ~D:"),
3318 sys_i
3319 ],
3320 [char, string, sys_i],
3321 [char, string, sys_i]
3322 ]
3323 ]
3324 ]
3325 ]))).
3326*/
3327/*
3328:- side_effect(assert_lsp(sys_inspect_string,
3329 arglist_info(sys_inspect_string,
3330 f_sys_inspect_string,
3331 [string],
3332 arginfo{ all:[string],
3333 allow_other_keys:0,
3334 aux:0,
3335 body:0,
3336 complex:0,
3337 env:0,
3338 key:0,
3339 names:[string],
3340 opt:0,
3341 req:[string],
3342 rest:0,
3343 sublists:0,
3344 whole:0
3345 }))).
3346*/
3347/*
3348:- side_effect(assert_lsp(sys_inspect_string,
3349 init_args(x, f_sys_inspect_string))).
3350*/
3351/*
3352(defun inspect-vector (vector)
3353 (format t (if (simple-vector-p vector) ""(defun inspect-vector (vector)\n (format t (if (simple-vector-p vector) \"~S - simple vector\" \"~S - vector\")\n vector)\n (inspect-print \"dimension: ~D\" (array-dimension vector 0))\n (when (array-has-fill-pointer-p vector)\n (inspect-print \"fill pointer: ~D\"\n (fill-pointer vector)\n (fill-pointer vector)))\n (when *inspect-mode*\n (dotimes (i (array-dimension vector 0))\n (inspect-recursively (format nil \"aref ~D:\" i)\n (aref vector i)\n (aref vector i)))))\n\n".
3354*/
3355
3356/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:9640 **********************/
3357:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-vector',[vector],[format,t,[if,['simple-vector-p',vector],'$STRING'("~S - simple vector"),'$STRING'("~S - vector")],vector],['inspect-print','$STRING'("dimension: ~D"),['array-dimension',vector,0]],[when,['array-has-fill-pointer-p',vector],['inspect-print','$STRING'("fill pointer: ~D"),['fill-pointer',vector],['fill-pointer',vector]]],[when,'*inspect-mode*',[dotimes,[i,['array-dimension',vector,0]],['inspect-recursively',[format,[],'$STRING'("aref ~D:"),i],[aref,vector,i],[aref,vector,i]]]]])
3358/*
3359:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
3360 sys_inspect_vector,
3361 kw_function,
3362 f_sys_inspect_vector)).
3363*/
3364/*
3365% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"dimension: ~D"),[array_dimension,vector,0]].
3366*/
3367/*
3368% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"dimension: ~D"),[array_dimension,vector,0],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
3369*/
3370/*
3371% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"fill pointer: ~D"),[fill_pointer,vector],[fill_pointer,vector]].
3372*/
3373/*
3374% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"fill pointer: ~D"),[fill_pointer,vector],[]],[when,sys_update_flag,[setf,[fill_pointer,vector],sys_new_value]]].
3375*/
3376/*
3377:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv, [], CDR, Compile_each_Ret), append([vector|CDR], [CAR27, CAR], Append_Ret), setf_inverse_op(fill_pointer, Inverse_op_Ret)))).
3378*/
3379/*
3380:- failure(show_call_trace((compile_each([name='GLOBAL', environ=env_1], LEnv, [], CDR, Compile_each_Ret), append([vector|CDR], [CAR27, CAR], Append_Ret), setf_inverse_op(fill_pointer, Inverse_op_Ret)))).
3381*/
3382wl:lambda_def(defun, sys_inspect_vector, f_sys_inspect_vector, [vector], [[format, t, [if, [simple_vector_p, vector], '$ARRAY'([*], claz_base_character, "~S - simple vector"), '$ARRAY'([*], claz_base_character, "~S - vector")], vector], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "dimension: ~D"), [array_dimension, vector, 0]], [when, [array_has_fill_pointer_p, vector], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "fill pointer: ~D"), [fill_pointer, vector], [fill_pointer, vector]]], [when, sys_xx_inspect_mode_xx, [dotimes, [sys_i, [array_dimension, vector, 0]], [sys_inspect_recursively, [format, [], '$ARRAY'([*], claz_base_character, "aref ~D:"), sys_i], [aref, vector, sys_i], [aref, vector, sys_i]]]]]).
3383wl:arglist_info(sys_inspect_vector, f_sys_inspect_vector, [vector], arginfo{all:[vector], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[vector], opt:0, req:[vector], rest:0, sublists:0, whole:0}).
3384wl: init_args(x, f_sys_inspect_vector).
3385
3390f_sys_inspect_vector(Vector_In, FnResult) :-
3391 GEnv=[bv(vector, Vector_In)],
3392 catch(( ( get_var(GEnv, vector, Vector_Get),
3393 f_simple_vector_p(Vector_Get, IFTEST),
3394 ( IFTEST\==[]
3395 -> _4664='$ARRAY'([*], claz_base_character, "~S - simple vector")
3396 ; _4664='$ARRAY'([*], claz_base_character, "~S - vector")
3397 ),
3398 get_var(GEnv, vector, Vector_Get8),
3399 f_format(t, _4664, [Vector_Get8], Format_Ret),
3400 get_var(GEnv, vector, Vector_Get11),
3401 f_array_dimension(Vector_Get11, 0, Array_dimension_Ret),
3402 f_sys_read_inspect_command('$ARRAY'([*],
3403 claz_base_character,
3404 "dimension: ~D"),
3405 Array_dimension_Ret,
3406 [],
3407 IFTEST9),
3408 ( IFTEST9\==[]
3409 -> f_princ('$ARRAY'([*], claz_base_character, "Not updated."),
3410 [],
3411 Princ_Ret),
3412 f_terpri([], TrueResult),
3413 _4750=TrueResult
3414 ; _4750=[]
3415 ),
3416 get_var(GEnv, vector, Vector_Get15),
3417 f_array_has_fill_pointer_p(Vector_Get15, IFTEST13),
3418 ( IFTEST13\==[]
3419 -> LEnv=[bv(sys_update_flag, []), bv(sys_new_value, [])|GEnv],
3420 get_var(LEnv, vector, Vector_Get19),
3421 f_fill_pointer(Vector_Get19, Fill_pointer_Ret),
3422 f_sys_read_inspect_command('$ARRAY'([*],
3423 claz_base_character,
3424 "fill pointer: ~D"),
3425 Fill_pointer_Ret,
3426 [],
3427 Inspect_command_Ret),
3428 setq_from_values(LEnv, [sys_update_flag, sys_new_value]),
3429 get_var(LEnv, sys_update_flag, IFTEST20),
3430 ( IFTEST20\==[]
3431 -> get_var(LEnv, sys_new_value, New_value_Get),
3432 get_var(LEnv, vector, Vector_Get26),
3433 set_place(LEnv,
3434 setf,
3435 [fill_pointer, Vector_Get26],
3436 [New_value_Get],
3437 Setf_R),
3438 LetResult=Setf_R
3439 ; LetResult=[]
3440 ),
3441 _4848=LetResult
3442 ; _4848=[]
3443 ),
3444 get_var(GEnv, sys_xx_inspect_mode_xx, IFTEST29),
3445 ( IFTEST29\==[]
3446 -> sf_dotimes(GEnv,
3447 [sys_i, [array_dimension, vector, 0]],
3448
3449 [ sys_inspect_recursively,
3450
3451 [ format,
3452 [],
3453 '$ARRAY'([*],
3454 claz_base_character,
3455 "aref ~D:"),
3456 sys_i
3457 ],
3458 [aref, vector, sys_i],
3459 [aref, vector, sys_i]
3460 ],
3461 TrueResult32),
3462 _4660=TrueResult32
3463 ; _4660=[]
3464 )
3465 ),
3466 _4660=FnResult
3467 ),
3468 block_exit(sys_inspect_vector, FnResult),
3469 true).
3470:- set_opv(sys_inspect_vector, symbol_function, f_sys_inspect_vector),
3471 DefunResult=sys_inspect_vector. 3472/*
3473:- side_effect(assert_lsp(sys_inspect_vector,
3474 lambda_def(defun,
3475 sys_inspect_vector,
3476 f_sys_inspect_vector,
3477 [vector],
3478
3479 [
3480 [ format,
3481 t,
3482
3483 [ if,
3484 [simple_vector_p, vector],
3485 '$ARRAY'([*],
3486 claz_base_character,
3487 "~S - simple vector"),
3488 '$ARRAY'([*],
3489 claz_base_character,
3490 "~S - vector")
3491 ],
3492 vector
3493 ],
3494
3495 [ sys_inspect_print,
3496 '$ARRAY'([*],
3497 claz_base_character,
3498 "dimension: ~D"),
3499 [array_dimension, vector, 0]
3500 ],
3501
3502 [ when,
3503 [array_has_fill_pointer_p, vector],
3504
3505 [ sys_inspect_print,
3506 '$ARRAY'([*],
3507 claz_base_character,
3508 "fill pointer: ~D"),
3509 [fill_pointer, vector],
3510 [fill_pointer, vector]
3511 ]
3512 ],
3513
3514 [ when,
3515 sys_xx_inspect_mode_xx,
3516
3517 [ dotimes,
3518 [sys_i, [array_dimension, vector, 0]],
3519
3520 [ sys_inspect_recursively,
3521
3522 [ format,
3523 [],
3524 '$ARRAY'([*],
3525 claz_base_character,
3526 "aref ~D:"),
3527 sys_i
3528 ],
3529 [aref, vector, sys_i],
3530 [aref, vector, sys_i]
3531 ]
3532 ]
3533 ]
3534 ]))).
3535*/
3536/*
3537:- side_effect(assert_lsp(sys_inspect_vector,
3538 arglist_info(sys_inspect_vector,
3539 f_sys_inspect_vector,
3540 [vector],
3541 arginfo{ all:[vector],
3542 allow_other_keys:0,
3543 aux:0,
3544 body:0,
3545 complex:0,
3546 env:0,
3547 key:0,
3548 names:[vector],
3549 opt:0,
3550 req:[vector],
3551 rest:0,
3552 sublists:0,
3553 whole:0
3554 }))).
3555*/
3556/*
3557:- side_effect(assert_lsp(sys_inspect_vector,
3558 init_args(x, f_sys_inspect_vector))).
3559*/
3560/*
3561(defun inspect-array (array)
3562 (format t (if (adjustable-array-p array)
3563 ""(defun inspect-array (array)\n (format t (if (adjustable-array-p array)\n \"~S - adjustable aray\"\n \"~S - array\")\n array)\n (inspect-print \"rank: ~D\" (array-rank array))\n (inspect-print \"dimensions: ~D\" (array-dimensions array))\n (inspect-print \"total size: ~D\" (array-total-size array)))\n\n".
3564*/
3565
3566/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:10254 **********************/
3567:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-array',[array],[format,t,[if,['adjustable-array-p',array],'$STRING'("~S - adjustable aray"),'$STRING'("~S - array")],array],['inspect-print','$STRING'("rank: ~D"),['array-rank',array]],['inspect-print','$STRING'("dimensions: ~D"),['array-dimensions',array]],['inspect-print','$STRING'("total size: ~D"),['array-total-size',array]]])
3568/*
3569:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
3570 sys_inspect_array,
3571 kw_function,
3572 f_sys_inspect_array)).
3573*/
3574/*
3575% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"rank: ~D"),[array_rank,array]].
3576*/
3577/*
3578% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"rank: ~D"),[array_rank,array],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
3579*/
3580/*
3581% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"dimensions: ~D"),[array_dimensions,array]].
3582*/
3583/*
3584% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"dimensions: ~D"),[array_dimensions,array],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
3585*/
3586/*
3587% macroexpand:-[sys_inspect_print,'$ARRAY'([*],claz_base_character,"total size: ~D"),[array_total_size,array]].
3588*/
3589/*
3590% into:-[when,[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"total size: ~D"),[array_total_size,array],[]],[princ,'$ARRAY'([*],claz_base_character,"Not updated.")],[terpri]].
3591*/
3592wl:lambda_def(defun, sys_inspect_array, f_sys_inspect_array, [array], [[format, t, [if, [adjustable_array_p, array], '$ARRAY'([*], claz_base_character, "~S - adjustable aray"), '$ARRAY'([*], claz_base_character, "~S - array")], array], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "rank: ~D"), [array_rank, array]], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "dimensions: ~D"), [array_dimensions, array]], [sys_inspect_print, '$ARRAY'([*], claz_base_character, "total size: ~D"), [array_total_size, array]]]).
3593wl:arglist_info(sys_inspect_array, f_sys_inspect_array, [array], arginfo{all:[array], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[array], opt:0, req:[array], rest:0, sublists:0, whole:0}).
3594wl: init_args(x, f_sys_inspect_array).
3595
3600f_sys_inspect_array(Array_In, FnResult) :-
3601 GEnv=[bv(array, Array_In)],
3602 catch(( ( get_var(GEnv, array, Array_Get),
3603 ( get_opv(Array_Get, adjustable, t)
3604 -> _4082='$ARRAY'([*], claz_base_character, "~S - adjustable aray")
3605 ; _4082='$ARRAY'([*], claz_base_character, "~S - array")
3606 ),
3607 get_var(GEnv, array, Array_Get9),
3608 f_format(t, _4082, [Array_Get9], Format_Ret),
3609 get_var(GEnv, array, Array_Get12),
3610 f_array_rank(Array_Get12, Array_rank_Ret),
3611 f_sys_read_inspect_command('$ARRAY'([*],
3612 claz_base_character,
3613 "rank: ~D"),
3614 Array_rank_Ret,
3615 [],
3616 IFTEST10),
3617 ( IFTEST10\==[]
3618 -> f_princ('$ARRAY'([*], claz_base_character, "Not updated."),
3619 [],
3620 Princ_Ret),
3621 f_terpri([], TrueResult),
3622 _4194=TrueResult
3623 ; _4194=[]
3624 ),
3625 get_var(GEnv, array, Array_Get16),
3626 f_array_dimensions(Array_Get16, Array_dimensions_Ret),
3627 f_sys_read_inspect_command('$ARRAY'([*],
3628 claz_base_character,
3629 "dimensions: ~D"),
3630 Array_dimensions_Ret,
3631 [],
3632 IFTEST14),
3633 ( IFTEST14\==[]
3634 -> f_princ('$ARRAY'([*], claz_base_character, "Not updated."),
3635 [],
3636 Princ_Ret29),
3637 f_terpri([], TrueResult17),
3638 _4292=TrueResult17
3639 ; _4292=[]
3640 ),
3641 get_var(GEnv, array, Array_Get20),
3642 f_array_total_size(Array_Get20, Total_size_Ret),
3643 f_sys_read_inspect_command('$ARRAY'([*],
3644 claz_base_character,
3645 "total size: ~D"),
3646 Total_size_Ret,
3647 [],
3648 IFTEST18),
3649 ( IFTEST18\==[]
3650 -> f_princ('$ARRAY'([*], claz_base_character, "Not updated."),
3651 [],
3652 Princ_Ret31),
3653 f_terpri([], TrueResult21),
3654 _4078=TrueResult21
3655 ; _4078=[]
3656 )
3657 ),
3658 _4078=FnResult
3659 ),
3660 block_exit(sys_inspect_array, FnResult),
3661 true).
3662:- set_opv(sys_inspect_array, symbol_function, f_sys_inspect_array),
3663 DefunResult=sys_inspect_array. 3664/*
3665:- side_effect(assert_lsp(sys_inspect_array,
3666 lambda_def(defun,
3667 sys_inspect_array,
3668 f_sys_inspect_array,
3669 [array],
3670
3671 [
3672 [ format,
3673 t,
3674
3675 [ if,
3676 [adjustable_array_p, array],
3677 '$ARRAY'([*],
3678 claz_base_character,
3679 "~S - adjustable aray"),
3680 '$ARRAY'([*],
3681 claz_base_character,
3682 "~S - array")
3683 ],
3684 array
3685 ],
3686
3687 [ sys_inspect_print,
3688 '$ARRAY'([*],
3689 claz_base_character,
3690 "rank: ~D"),
3691 [array_rank, array]
3692 ],
3693
3694 [ sys_inspect_print,
3695 '$ARRAY'([*],
3696 claz_base_character,
3697 "dimensions: ~D"),
3698 [array_dimensions, array]
3699 ],
3700
3701 [ sys_inspect_print,
3702 '$ARRAY'([*],
3703 claz_base_character,
3704 "total size: ~D"),
3705 [array_total_size, array]
3706 ]
3707 ]))).
3708*/
3709/*
3710:- side_effect(assert_lsp(sys_inspect_array,
3711 arglist_info(sys_inspect_array,
3712 f_sys_inspect_array,
3713 [array],
3714 arginfo{ all:[array],
3715 allow_other_keys:0,
3716 aux:0,
3717 body:0,
3718 complex:0,
3719 env:0,
3720 key:0,
3721 names:[array],
3722 opt:0,
3723 req:[array],
3724 rest:0,
3725 sublists:0,
3726 whole:0
3727 }))).
3728*/
3729/*
3730:- side_effect(assert_lsp(sys_inspect_array, init_args(x, f_sys_inspect_array))).
3731*/
3732/*
3733(defun select-ht-N (hashtable)
3734 (incf *inspect-level*)
3735 (maphash #'(lambda (key val)
3736 (inspect-indent-1)
3737 (format t "key : "(defun select-ht-N (hashtable)\n (incf *inspect-level*)\n (maphash #'(lambda (key val)\n\t (inspect-indent-1)\n\t (format t \"key : ~S\" key)\n\t (inspect-recursively \"value:\" val (gethash key hashtable)))\n\t hashtable)\n (decf *inspect-level*))\n\n".
3738*/
3739
3740/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:10585 **********************/
3741:-lisp_compile_to_prolog(pkg_sys,[defun,'select-ht-N',[hashtable],[incf,'*inspect-level*'],[maphash,function([lambda,[key,val],['inspect-indent-1'],[format,t,'$STRING'("key : ~S"),key],['inspect-recursively','$STRING'("value:"),val,[gethash,key,hashtable]]]),hashtable],[decf,'*inspect-level*']])
3742/*
3743:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
3744 sys_select_ht_n,
3745 kw_function,
3746 f_sys_select_ht_n)).
3747*/
3748/*
3749% macroexpand:-[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"value:"),sys_val,[gethash,key,sys_hashtable]].
3750*/
3751/*
3752% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"value:"),sys_val,t],[when,sys_update_flag,[setf,[gethash,key,sys_hashtable],sys_new_value]]].
3753*/
3754/*
3755:- side_effect((compile_each([name='GLOBAL', environ=env_1], LEnv, [sys_hashtable], [sys_hashtable], true), append([key, sys_hashtable], [CAR14, CAR], [key, sys_hashtable, CAR14, CAR]), setf_inverse_op(gethash, sys_puthash))).
3756*/
3757/*
3758:- side_effect((compile_each([name='GLOBAL', environ=env_1], LEnv, [sys_hashtable], [sys_hashtable], true), append([key, sys_hashtable], [CAR14, CAR], [key, sys_hashtable, CAR14, CAR]), setf_inverse_op(gethash, sys_puthash))).
3759*/
3760wl:lambda_def(defun, sys_select_ht_n, f_sys_select_ht_n, [sys_hashtable], [[incf, sys_xx_inspect_level_xx], [maphash, function([lambda, [key, sys_val], [sys_inspect_indent_1], [format, t, '$ARRAY'([*], claz_base_character, "key : ~S"), key], [sys_inspect_recursively, '$ARRAY'([*], claz_base_character, "value:"), sys_val, [gethash, key, sys_hashtable]]]), sys_hashtable], [decf, sys_xx_inspect_level_xx]]).
3761wl:arglist_info(sys_select_ht_n, f_sys_select_ht_n, [sys_hashtable], arginfo{all:[sys_hashtable], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_hashtable], opt:0, req:[sys_hashtable], rest:0, sublists:0, whole:0}).
3762wl: init_args(x, f_sys_select_ht_n).
3763
3768f_sys_select_ht_n(Hashtable_In, FnResult) :-
3769 Decf_Env=[bv(sys_hashtable, Hashtable_In)],
3770 catch(( ( place_op(Decf_Env,
3771 incf,
3772 sys_xx_inspect_level_xx,
3773 symbol_value,
3774 [],
3775 Place_op_Ret),
3776 get_var(Decf_Env, sys_hashtable, Hashtable_Get23),
3777 f_maphash(closure(kw_function,
3778 [ClosureEnvironment|Decf_Env],
3779 Whole,
3780 LetResult,
3781 [key, sys_val],
3782 (f_sys_inspect_indent_1(Indent_1_Ret), get_var(ClosureEnvironment, key, Key_Get), f_format(t, '$ARRAY'([*], claz_base_character, "key : ~S"), [Key_Get], Format_Ret), LEnv=[bv(sys_update_flag, []), bv(sys_new_value, [])|ClosureEnvironment], get_var(LEnv, sys_val, Val_Get), f_sys_read_inspect_command('$ARRAY'([*], claz_base_character, "value:"), Val_Get, t, T), setq_from_values(LEnv, [sys_update_flag, sys_new_value]), get_var(LEnv, sys_update_flag, IFTEST), (IFTEST\==[]->get_var(LEnv, key, Key_Get15), get_var(LEnv, sys_hashtable, Hashtable_Get), get_var(LEnv, sys_new_value, New_value_Get), f_sys_puthash(Key_Get15, Hashtable_Get, New_value_Get, TrueResult), LetResult=TrueResult;LetResult=[])),
3783
3784 [ lambda,
3785 [key, sys_val],
3786 [sys_inspect_indent_1],
3787
3788 [ format,
3789 t,
3790 '$ARRAY'([*],
3791 claz_base_character,
3792 "key : ~S"),
3793 key
3794 ],
3795
3796 [ sys_inspect_recursively,
3797 '$ARRAY'([*],
3798 claz_base_character,
3799 "value:"),
3800 sys_val,
3801 [gethash, key, sys_hashtable]
3802 ]
3803 ]),
3804 Hashtable_Get23,
3805 Maphash_Ret),
3806 set_place(Decf_Env,
3807 decf,
3808 [value, sys_xx_inspect_level_xx],
3809 [],
3810 Decf_R)
3811 ),
3812 Decf_R=FnResult
3813 ),
3814 block_exit(sys_select_ht_n, FnResult),
3815 true).
3816:- set_opv(sys_select_ht_n, symbol_function, f_sys_select_ht_n),
3817 DefunResult=sys_select_ht_n. 3818/*
3819:- side_effect(assert_lsp(sys_select_ht_n,
3820 lambda_def(defun,
3821 sys_select_ht_n,
3822 f_sys_select_ht_n,
3823 [sys_hashtable],
3824
3825 [ [incf, sys_xx_inspect_level_xx],
3826
3827 [ maphash,
3828 function(
3829 [ lambda,
3830 [key, sys_val],
3831 [sys_inspect_indent_1],
3832
3833 [ format,
3834 t,
3835 '$ARRAY'([*],
3836 claz_base_character,
3837 "key : ~S"),
3838 key
3839 ],
3840
3841 [ sys_inspect_recursively,
3842 '$ARRAY'([*],
3843 claz_base_character,
3844 "value:"),
3845 sys_val,
3846
3847 [ gethash,
3848 key,
3849 sys_hashtable
3850 ]
3851 ]
3852 ]),
3853 sys_hashtable
3854 ],
3855 [decf, sys_xx_inspect_level_xx]
3856 ]))).
3857*/
3858/*
3859:- side_effect(assert_lsp(sys_select_ht_n,
3860 arglist_info(sys_select_ht_n,
3861 f_sys_select_ht_n,
3862 [sys_hashtable],
3863 arginfo{ all:[sys_hashtable],
3864 allow_other_keys:0,
3865 aux:0,
3866 body:0,
3867 complex:0,
3868 env:0,
3869 key:0,
3870 names:[sys_hashtable],
3871 opt:0,
3872 req:[sys_hashtable],
3873 rest:0,
3874 sublists:0,
3875 whole:0
3876 }))).
3877*/
3878/*
3879:- side_effect(assert_lsp(sys_select_ht_n, init_args(x, f_sys_select_ht_n))).
3880*/
3881/*
3882(defun select-ht-L (hashtable)
3883 (terpri)
3884 (format t "The keys of the hash table are:"(defun select-ht-L (hashtable)\n (terpri)\n (format t \"The keys of the hash table are:~%\")\n (maphash #'(lambda (key val)\n\t (declare (ignore val))\n\t (format t \" ~S~%\" key))\n\t hashtable)\n (terpri))\n\n".
3885*/
3886
3887/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:10844 **********************/
3888:-lisp_compile_to_prolog(pkg_sys,[defun,'select-ht-L',[hashtable],[terpri],[format,t,'$STRING'("The keys of the hash table are:~%")],[maphash,function([lambda,[key,val],[declare,[ignore,val]],[format,t,'$STRING'(" ~S~%"),key]]),hashtable],[terpri]])
3889/*
3890:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
3891 sys_select_ht_l,
3892 kw_function,
3893 f_sys_select_ht_l)).
3894*/
3895wl:lambda_def(defun, sys_select_ht_l, f_sys_select_ht_l, [sys_hashtable], [[terpri], [format, t, '$ARRAY'([*], claz_base_character, "The keys of the hash table are:~%")], [maphash, function([lambda, [key, sys_val], [declare, [ignore, sys_val]], [format, t, '$ARRAY'([*], claz_base_character, " ~S~%"), key]]), sys_hashtable], [terpri]]).
3896wl:arglist_info(sys_select_ht_l, f_sys_select_ht_l, [sys_hashtable], arginfo{all:[sys_hashtable], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_hashtable], opt:0, req:[sys_hashtable], rest:0, sublists:0, whole:0}).
3897wl: init_args(x, f_sys_select_ht_l).
3898
3903f_sys_select_ht_l(Hashtable_In, FnResult) :-
3904 GEnv=[bv(sys_hashtable, Hashtable_In)],
3905 catch(( ( f_terpri([], Terpri_Ret),
3906 f_format(t,
3907 '$ARRAY'([*],
3908 claz_base_character,
3909 "The keys of the hash table are:~%"),
3910 [],
3911 Format_Ret),
3912 get_var(GEnv, sys_hashtable, Hashtable_Get),
3913 f_maphash(closure(kw_function,
3914 [ClosureEnvironment|GEnv],
3915 Whole,
3916 LResult,
3917 [key, sys_val],
3918 (sf_declare(ClosureEnvironment, [ignore, sys_val], Sf_declare_Ret), get_var(ClosureEnvironment, key, Key_Get), f_format(t, '$ARRAY'([*], claz_base_character, " ~S~%"), [Key_Get], LResult)),
3919
3920 [ lambda,
3921 [key, sys_val],
3922 [declare, [ignore, sys_val]],
3923
3924 [ format,
3925 t,
3926 '$ARRAY'([*],
3927 claz_base_character,
3928 " ~S~%"),
3929 key
3930 ]
3931 ]),
3932 Hashtable_Get,
3933 Maphash_Ret),
3934 f_terpri([], Terpri_Ret18)
3935 ),
3936 Terpri_Ret18=FnResult
3937 ),
3938 block_exit(sys_select_ht_l, FnResult),
3939 true).
3940:- set_opv(sys_select_ht_l, symbol_function, f_sys_select_ht_l),
3941 DefunResult=sys_select_ht_l. 3942/*
3943:- side_effect(assert_lsp(sys_select_ht_l,
3944 lambda_def(defun,
3945 sys_select_ht_l,
3946 f_sys_select_ht_l,
3947 [sys_hashtable],
3948
3949 [ [terpri],
3950
3951 [ format,
3952 t,
3953 '$ARRAY'([*],
3954 claz_base_character,
3955 "The keys of the hash table are:~%")
3956 ],
3957
3958 [ maphash,
3959 function(
3960 [ lambda,
3961 [key, sys_val],
3962 [declare, [ignore, sys_val]],
3963
3964 [ format,
3965 t,
3966 '$ARRAY'([*],
3967 claz_base_character,
3968 " ~S~%"),
3969 key
3970 ]
3971 ]),
3972 sys_hashtable
3973 ],
3974 [terpri]
3975 ]))).
3976*/
3977/*
3978:- side_effect(assert_lsp(sys_select_ht_l,
3979 arglist_info(sys_select_ht_l,
3980 f_sys_select_ht_l,
3981 [sys_hashtable],
3982 arginfo{ all:[sys_hashtable],
3983 allow_other_keys:0,
3984 aux:0,
3985 body:0,
3986 complex:0,
3987 env:0,
3988 key:0,
3989 names:[sys_hashtable],
3990 opt:0,
3991 req:[sys_hashtable],
3992 rest:0,
3993 sublists:0,
3994 whole:0
3995 }))).
3996*/
3997/*
3998:- side_effect(assert_lsp(sys_select_ht_l, init_args(x, f_sys_select_ht_l))).
3999*/
4000/*
4001(defun select-ht-J (hashtable)
4002 (let* ((key (prog1
4003 (read-preserving-whitespace *query-io*)
4004 (inspect-read-line)))
4005 (val (gethash key hashtable)))
4006 (if val
4007 (progn
4008 (incf *inspect-level*)
4009 (inspect-indent-1)
4010 (format t "key : "(defun select-ht-J (hashtable)\n (let* ((key (prog1\n\t\t(read-preserving-whitespace *query-io*)\n\t\t(inspect-read-line)))\n\t (val (gethash key hashtable)))\n (if val\n\t (progn\n\t (incf *inspect-level*)\n\t (inspect-indent-1)\n\t (format t \"key : ~S\" key)\n\t (inspect-recursively \"value:\" val (gethash key hashtable))\n\t (decf *inspect-level*))\n\t (progn\n\t (terpri)\n\t (format t \"The key ~S is not present or the value associated is NIL.\" key)\n\t (terpri)\n\t (terpri)))))\n\n".
4011*/
4012
4013/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:11058 **********************/
4014:-lisp_compile_to_prolog(pkg_sys,[defun,'select-ht-J',[hashtable],['let*',[[key,[prog1,['read-preserving-whitespace','*query-io*'],['inspect-read-line']]],[val,[gethash,key,hashtable]]],[if,val,[progn,[incf,'*inspect-level*'],['inspect-indent-1'],[format,t,'$STRING'("key : ~S"),key],['inspect-recursively','$STRING'("value:"),val,[gethash,key,hashtable]],[decf,'*inspect-level*']],[progn,[terpri],[format,t,'$STRING'("The key ~S is not present or the value associated is NIL."),key],[terpri],[terpri]]]]])
4015/*
4016:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
4017 sys_select_ht_j,
4018 kw_function,
4019 f_sys_select_ht_j)).
4020*/
4021/*
4022% macroexpand:-[sys_inspect_recursively,'$ARRAY'([*],claz_base_character,"value:"),sys_val,[gethash,key,sys_hashtable]].
4023*/
4024/*
4025% into:-[multiple_value_bind,[sys_update_flag,sys_new_value],[sys_read_inspect_command,'$ARRAY'([*],claz_base_character,"value:"),sys_val,t],[when,sys_update_flag,[setf,[gethash,key,sys_hashtable],sys_new_value]]].
4026*/
4027/*
4028:- side_effect((compile_each([name='GLOBAL', environ=env_1], LEnv22, [sys_hashtable], [sys_hashtable], true), append([key, sys_hashtable], [CAR28, CAR], [key, sys_hashtable, CAR28, CAR]), setf_inverse_op(gethash, sys_puthash))).
4029*/
4030/*
4031:- side_effect((compile_each([name='GLOBAL', environ=env_1], LEnv22, [sys_hashtable], [sys_hashtable], true), append([key, sys_hashtable], [CAR28, CAR], [key, sys_hashtable, CAR28, CAR]), setf_inverse_op(gethash, sys_puthash))).
4032*/
4033wl:lambda_def(defun, sys_select_ht_j, f_sys_select_ht_j, [sys_hashtable], [[let_xx, [[key, [prog1, [read_preserving_whitespace, xx_query_io_xx], [sys_inspect_read_line]]], [sys_val, [gethash, key, sys_hashtable]]], [if, sys_val, [progn, [incf, sys_xx_inspect_level_xx], [sys_inspect_indent_1], [format, t, '$ARRAY'([*], claz_base_character, "key : ~S"), key], [sys_inspect_recursively, '$ARRAY'([*], claz_base_character, "value:"), sys_val, [gethash, key, sys_hashtable]], [decf, sys_xx_inspect_level_xx]], [progn, [terpri], [format, t, '$ARRAY'([*], claz_base_character, "The key ~S is not present or the value associated is NIL."), key], [terpri], [terpri]]]]]).
4034wl:arglist_info(sys_select_ht_j, f_sys_select_ht_j, [sys_hashtable], arginfo{all:[sys_hashtable], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_hashtable], opt:0, req:[sys_hashtable], rest:0, sublists:0, whole:0}).
4035wl: init_args(x, f_sys_select_ht_j).
4036
4041f_sys_select_ht_j(Hashtable_In, FnResult) :-
4042 GEnv=[bv(sys_hashtable, Hashtable_In)],
4043 catch(( ( get_var(GEnv, xx_query_io_xx, Xx_query_io_xx_Get),
4044 f_read_preserving_whitespace([Xx_query_io_xx_Get], Key_Init),
4045 f_sys_inspect_read_line(Read_line_Ret),
4046 LEnv=[bv(key, Key_Init)|GEnv],
4047 get_var(LEnv, key, Key_Get),
4048 get_var(LEnv, sys_hashtable, Hashtable_Get),
4049 f_gethash(Key_Get, Hashtable_Get, Val_Init),
4050 LEnv12=[bv(sys_val, Val_Init)|LEnv],
4051 get_var(LEnv12, sys_val, IFTEST),
4052 ( IFTEST\==[]
4053 -> place_op(LEnv12,
4054 incf,
4055 sys_xx_inspect_level_xx,
4056 symbol_value,
4057 [],
4058 Place_op_Ret),
4059 f_sys_inspect_indent_1(Indent_1_Ret),
4060 get_var(LEnv12, key, Key_Get19),
4061 f_format(t,
4062 '$ARRAY'([*], claz_base_character, "key : ~S"),
4063 [Key_Get19],
4064 Format_Ret),
4065 LEnv22=[bv(sys_update_flag, []), bv(sys_new_value, [])|LEnv12],
4066 get_var(LEnv22, sys_val, Val_Get23),
4067 f_sys_read_inspect_command('$ARRAY'([*],
4068 claz_base_character,
4069 "value:"),
4070 Val_Get23,
4071 t,
4072 T),
4073 setq_from_values(LEnv22, [sys_update_flag, sys_new_value]),
4074 get_var(LEnv22, sys_update_flag, IFTEST24),
4075 ( IFTEST24\==[]
4076 -> get_var(LEnv22, key, Key_Get29),
4077 get_var(LEnv22, sys_hashtable, Hashtable_Get31),
4078 get_var(LEnv22, sys_new_value, New_value_Get),
4079 f_sys_puthash(Key_Get29,
4080 Hashtable_Get31,
4081 New_value_Get,
4082 TrueResult),
4083 LetResult21=TrueResult
4084 ; LetResult21=[]
4085 ),
4086 set_place(LEnv12,
4087 decf,
4088 [value, sys_xx_inspect_level_xx],
4089 [],
4090 Decf_R),
4091 LetResult11=Decf_R
4092 ; f_terpri([], Terpri_Ret),
4093 get_var(LEnv12, key, Key_Get35),
4094 f_format(t,
4095 '$ARRAY'([*],
4096 claz_base_character,
4097 "The key ~S is not present or the value associated is NIL."),
4098 [Key_Get35],
4099 Format_Ret47),
4100 f_terpri([], Terpri_Ret48),
4101 f_terpri([], ElseResult),
4102 LetResult11=ElseResult
4103 )
4104 ),
4105 LetResult11=FnResult
4106 ),
4107 block_exit(sys_select_ht_j, FnResult),
4108 true).
4109:- set_opv(sys_select_ht_j, symbol_function, f_sys_select_ht_j),
4110 DefunResult=sys_select_ht_j. 4111/*
4112:- side_effect(assert_lsp(sys_select_ht_j,
4113 lambda_def(defun,
4114 sys_select_ht_j,
4115 f_sys_select_ht_j,
4116 [sys_hashtable],
4117
4118 [
4119 [ let_xx,
4120
4121 [
4122 [ key,
4123
4124 [ prog1,
4125
4126 [ read_preserving_whitespace,
4127 xx_query_io_xx
4128 ],
4129 [sys_inspect_read_line]
4130 ]
4131 ],
4132
4133 [ sys_val,
4134 [gethash, key, sys_hashtable]
4135 ]
4136 ],
4137
4138 [ if,
4139 sys_val,
4140
4141 [ progn,
4142 [incf, sys_xx_inspect_level_xx],
4143 [sys_inspect_indent_1],
4144
4145 [ format,
4146 t,
4147 '$ARRAY'([*],
4148 claz_base_character,
4149 "key : ~S"),
4150 key
4151 ],
4152
4153 [ sys_inspect_recursively,
4154 '$ARRAY'([*],
4155 claz_base_character,
4156 "value:"),
4157 sys_val,
4158 [gethash, key, sys_hashtable]
4159 ],
4160 [decf, sys_xx_inspect_level_xx]
4161 ],
4162
4163 [ progn,
4164 [terpri],
4165
4166 [ format,
4167 t,
4168 '$ARRAY'([*],
4169 claz_base_character,
4170 "The key ~S is not present or the value associated is NIL."),
4171 key
4172 ],
4173 [terpri],
4174 [terpri]
4175 ]
4176 ]
4177 ]
4178 ]))).
4179*/
4180/*
4181:- side_effect(assert_lsp(sys_select_ht_j,
4182 arglist_info(sys_select_ht_j,
4183 f_sys_select_ht_j,
4184 [sys_hashtable],
4185 arginfo{ all:[sys_hashtable],
4186 allow_other_keys:0,
4187 aux:0,
4188 body:0,
4189 complex:0,
4190 env:0,
4191 key:0,
4192 names:[sys_hashtable],
4193 opt:0,
4194 req:[sys_hashtable],
4195 rest:0,
4196 sublists:0,
4197 whole:0
4198 }))).
4199*/
4200/*
4201:- side_effect(assert_lsp(sys_select_ht_j, init_args(x, f_sys_select_ht_j))).
4202*/
4203/*
4204(defun select-ht-? ()
4205 (terpri)
4206 (format t
4207 "Inspect commands for hash tables:"(defun select-ht-? ()\n (terpri)\n (format t\n\t \"Inspect commands for hash tables:~%~\nn (or N or Newline): inspects the keys/values of the hashtable (recursively).~%~\ns (or S): skips the field.~%~\np (or P): pretty-prints the field.~%~\na (or A): aborts the inspection of the rest of the fields.~%~\ne (or E) form: evaluates and prints the form.~%~\nl (or L): show the keys of the hash table.~%~\nj (or J) key: inspect the value associated to the key requested.~%~\nq (or Q): quits the inspection.~%~\n?: prints this.~%~%\"\n\t ))\n\n".
4208*/
4209
4210/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:11571 **********************/
4211:-lisp_compile_to_prolog(pkg_sys,[defun,'select-ht-?',[],[terpri],[format,t,'$STRING'("Inspect commands for hash tables:~%~\nn (or N or Newline): inspects the keys/values of the hashtable (recursively).~%~\ns (or S): skips the field.~%~\np (or P): pretty-prints the field.~%~\na (or A): aborts the inspection of the rest of the fields.~%~\ne (or E) form: evaluates and prints the form.~%~\nl (or L): show the keys of the hash table.~%~\nj (or J) key: inspect the value associated to the key requested.~%~\nq (or Q): quits the inspection.~%~\n?: prints this.~%~%")]])
4212/*
4213:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
4214 sys_select_ht_c63,
4215 kw_function,
4216 f_sys_select_ht_c63)).
4217*/
4218wl:lambda_def(defun, sys_select_ht_c63, f_sys_select_ht_c63, [], [[terpri], [format, t, '$ARRAY'([*], claz_base_character, "Inspect commands for hash tables:~%~\nn (or N or Newline): inspects the keys/values of the hashtable (recursively).~%~\ns (or S): skips the field.~%~\np (or P): pretty-prints the field.~%~\na (or A): aborts the inspection of the rest of the fields.~%~\ne (or E) form: evaluates and prints the form.~%~\nl (or L): show the keys of the hash table.~%~\nj (or J) key: inspect the value associated to the key requested.~%~\nq (or Q): quits the inspection.~%~\n?: prints this.~%~%")]]).
4219wl:arglist_info(sys_select_ht_c63, f_sys_select_ht_c63, [], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[], opt:0, req:0, rest:0, sublists:0, whole:0}).
4220wl: init_args(x, f_sys_select_ht_c63).
4221
4226f_sys_select_ht_c63(FnResult) :-
4227 _8588=[],
4228 catch(( ( f_terpri([], Terpri_Ret),
4229 f_format(t,
4230 '$ARRAY'([*],
4231 claz_base_character,
4232 "Inspect commands for hash tables:~%~\nn (or N or Newline): inspects the keys/values of the hashtable (recursively).~%~\ns (or S): skips the field.~%~\np (or P): pretty-prints the field.~%~\na (or A): aborts the inspection of the rest of the fields.~%~\ne (or E) form: evaluates and prints the form.~%~\nl (or L): show the keys of the hash table.~%~\nj (or J) key: inspect the value associated to the key requested.~%~\nq (or Q): quits the inspection.~%~\n?: prints this.~%~%"),
4233 [],
4234 Format_Ret)
4235 ),
4236 Format_Ret=FnResult
4237 ),
4238 block_exit(sys_select_ht_c63, FnResult),
4239 true).
4240:- set_opv(sys_select_ht_c63, symbol_function, f_sys_select_ht_c63),
4241 DefunResult=sys_select_ht_c63. 4242/*
4243:- side_effect(assert_lsp(sys_select_ht_c63,
4244 lambda_def(defun,
4245 sys_select_ht_c63,
4246 f_sys_select_ht_c63,
4247 [],
4248
4249 [ [terpri],
4250
4251 [ format,
4252 t,
4253 '$ARRAY'([*],
4254 claz_base_character,
4255 "Inspect commands for hash tables:~%~\nn (or N or Newline): inspects the keys/values of the hashtable (recursively).~%~\ns (or S): skips the field.~%~\np (or P): pretty-prints the field.~%~\na (or A): aborts the inspection of the rest of the fields.~%~\ne (or E) form: evaluates and prints the form.~%~\nl (or L): show the keys of the hash table.~%~\nj (or J) key: inspect the value associated to the key requested.~%~\nq (or Q): quits the inspection.~%~\n?: prints this.~%~%")
4256 ]
4257 ]))).
4258*/
4259/*
4260:- side_effect(assert_lsp(sys_select_ht_c63,
4261 arglist_info(sys_select_ht_c63,
4262 f_sys_select_ht_c63,
4263 [],
4264 arginfo{ all:0,
4265 allow_other_keys:0,
4266 aux:0,
4267 body:0,
4268 complex:0,
4269 env:0,
4270 key:0,
4271 names:[],
4272 opt:0,
4273 req:0,
4274 rest:0,
4275 sublists:0,
4276 whole:0
4277 }))).
4278*/
4279/*
4280:- side_effect(assert_lsp(sys_select_ht_c63, init_args(x, f_sys_select_ht_c63))).
4281*/
4282/*
4283(defun inspect-hashtable (hashtable)
4284 (if *inspect-mode*
4285 (progn
4286 (decf *inspect-level*)
4287 (loop
4288 (format t ""(defun inspect-hashtable (hashtable)\n (if *inspect-mode*\n (progn\n\t(decf *inspect-level*)\n (loop\n (format t \"~S - hash table: \" hashtable)\n\t (force-output)\n (case (do ((char (read-char *query-io*) (read-char *query-io*)))\n\t ((and (char/= char #\\Space) (char/= #\\Tab)) char))\n\t ((#\\Newline #\\Return)\n\t\t (select-ht-N hashtable)\n\t\t (return nil))\n\t ((#\\n #\\N)\n\t (inspect-read-line)\n\t\t (select-ht-N hashtable)\n\t\t (return nil))\n\t ((#\\s #\\S)\n\t (inspect-read-line)\n\t (return nil))\n\t\t((#\\p #\\P)\n\t\t (inspect-read-line)\n\t\t (select-P hashtable))\n\t\t((#\\a #\\A)\n\t\t (inspect-read-line)\n\t\t (throw 'ABORT-INSPECT nil))\n\t\t((#\\e #\\E)\n\t\t (select-E))\n\t\t((#\\q #\\Q)\n\t\t (inspect-read-line)\n\t\t (throw 'QUIT-INSPECT nil))\n\t\t((#\\l #\\L)\n\t\t (inspect-read-line)\n\t\t (select-ht-L hashtable))\n\t\t((#\\j #\\J)\n\t\t (select-ht-J hashtable))\n\t\t((#\\?)\n\t\t (inspect-read-line)\n\t\t (select-ht-?)))\n (inspect-indent)))\n (progn\n\t(format t \"~S - hash table: \" hashtable)\n\t(maphash #'(lambda (key val)\n\t\t (inspect-indent-1)\n\t\t (format t \"key : ~S\" key)\n\t\t (inspect-indent-1)\n\t\t (format t \"value:\")\n\t\t (inspect-object val))\n\t hashtable))))\n\n".
4289*/
4290
4291/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:12189 **********************/
4292:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-hashtable',[hashtable],[if,'*inspect-mode*',[progn,[decf,'*inspect-level*'],[loop,[format,t,'$STRING'("~S - hash table: "),hashtable],['force-output'],[case,[do,[[char,['read-char','*query-io*'],['read-char','*query-io*']]],[[and,['char/=',char,#\(' ')],['char/=',#\('\t')]],char]],[[#\('\n'),#\('\r')],['select-ht-N',hashtable],[return,[]]],[[#\(n),#\('N')],['inspect-read-line'],['select-ht-N',hashtable],[return,[]]],[[#\(s),#\('S')],['inspect-read-line'],[return,[]]],[[#\(p),#\('P')],['inspect-read-line'],['select-P',hashtable]],[[#\(a),#\('A')],['inspect-read-line'],[throw,[quote,'ABORT-INSPECT'],[]]],[[#\(e),#\('E')],['select-E']],[[#\(q),#\('Q')],['inspect-read-line'],[throw,[quote,'QUIT-INSPECT'],[]]],[[#\(l),#\('L')],['inspect-read-line'],['select-ht-L',hashtable]],[[#\(j),#\('J')],['select-ht-J',hashtable]],[[#\(?)],['inspect-read-line'],['select-ht-?']]],['inspect-indent']]],[progn,[format,t,'$STRING'("~S - hash table: "),hashtable],[maphash,function([lambda,[key,val],['inspect-indent-1'],[format,t,'$STRING'("key : ~S"),key],['inspect-indent-1'],[format,t,'$STRING'("value:")],['inspect-object',val]]),hashtable]]]])
4293/*
4294:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
4295 sys_inspect_hashtable,
4296 kw_function,
4297 f_sys_inspect_hashtable)).
4298*/
4299/*
4300:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
4301 sys_inspect_object,
4302 kw_function,
4303 f_sys_inspect_object)).
4304*/
4305wl:lambda_def(defun, sys_inspect_hashtable, f_sys_inspect_hashtable, [sys_hashtable], [[if, sys_xx_inspect_mode_xx, [progn, [decf, sys_xx_inspect_level_xx], [loop, [format, t, '$ARRAY'([*], claz_base_character, "~S - hash table: "), sys_hashtable], [force_output], [case, [do, [[char, [read_char, xx_query_io_xx], [read_char, xx_query_io_xx]]], [[and, [char_c47_c61, char|" "], [char_c47_c61|"\t"]], char]], ["\n\r", [sys_select_ht_n, sys_hashtable], [return, []]], ["nN", [sys_inspect_read_line], [sys_select_ht_n, sys_hashtable], [return, []]], ["sS", [sys_inspect_read_line], [return, []]], ["pP", [sys_inspect_read_line], [sys_select_p, sys_hashtable]], ["aA", [sys_inspect_read_line], [throw, [quote, sys_abort_inspect], []]], ["eE", [sys_select_e]], ["qQ", [sys_inspect_read_line], [throw, [quote, sys_quit_inspect], []]], ["lL", [sys_inspect_read_line], [sys_select_ht_l, sys_hashtable]], ["jJ", [sys_select_ht_j, sys_hashtable]], ["?", [sys_inspect_read_line], [sys_select_ht_c63]]], [sys_inspect_indent]]], [progn, [format, t, '$ARRAY'([*], claz_base_character, "~S - hash table: "), sys_hashtable], [maphash, function([lambda, [key, sys_val], [sys_inspect_indent_1], [format, t, '$ARRAY'([*], claz_base_character, "key : ~S"), key], [sys_inspect_indent_1], [format, t, '$ARRAY'([*], claz_base_character, "value:")], [sys_inspect_object, sys_val]]), sys_hashtable]]]]).
4306wl:arglist_info(sys_inspect_hashtable, f_sys_inspect_hashtable, [sys_hashtable], arginfo{all:[sys_hashtable], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_hashtable], opt:0, req:[sys_hashtable], rest:0, sublists:0, whole:0}).
4307wl: init_args(x, f_sys_inspect_hashtable).
4308
4313f_sys_inspect_hashtable(Hashtable_In, FnResult) :-
4314 Decf_Env=[bv(sys_hashtable, Hashtable_In)],
4315 catch(( ( get_var(Decf_Env, sys_xx_inspect_mode_xx, IFTEST),
4316 ( IFTEST\==[]
4317 -> set_place(Decf_Env,
4318 decf,
4319 [value, sys_xx_inspect_level_xx],
4320 [],
4321 Decf_R),
4322 sf_loop(Decf_Env,
4323
4324 [ format,
4325 t,
4326 '$ARRAY'([*],
4327 claz_base_character,
4328 "~S - hash table: "),
4329 sys_hashtable
4330 ],
4331 [force_output],
4332
4333 [ case,
4334
4335 [ do,
4336
4337 [
4338 [ char,
4339 [read_char, xx_query_io_xx],
4340 [read_char, xx_query_io_xx]
4341 ]
4342 ],
4343
4344 [
4345 [ and,
4346 [char_c47_c61, char|" "],
4347 [char_c47_c61|"\t"]
4348 ],
4349 char
4350 ]
4351 ],
4352
4353 [ "\n\r",
4354 [sys_select_ht_n, sys_hashtable],
4355 [return, []]
4356 ],
4357
4358 [ "nN",
4359 [sys_inspect_read_line],
4360 [sys_select_ht_n, sys_hashtable],
4361 [return, []]
4362 ],
4363 ["sS", [sys_inspect_read_line], [return, []]],
4364
4365 [ "pP",
4366 [sys_inspect_read_line],
4367 [sys_select_p, sys_hashtable]
4368 ],
4369
4370 [ "aA",
4371 [sys_inspect_read_line],
4372 [throw, [quote, sys_abort_inspect], []]
4373 ],
4374 ["eE", [sys_select_e]],
4375
4376 [ "qQ",
4377 [sys_inspect_read_line],
4378 [throw, [quote, sys_quit_inspect], []]
4379 ],
4380
4381 [ "lL",
4382 [sys_inspect_read_line],
4383 [sys_select_ht_l, sys_hashtable]
4384 ],
4385 ["jJ", [sys_select_ht_j, sys_hashtable]],
4386
4387 [ "?",
4388 [sys_inspect_read_line],
4389 [sys_select_ht_c63]
4390 ]
4391 ],
4392 [sys_inspect_indent],
4393 TrueResult),
4394 _7100=TrueResult
4395 ; get_var(Decf_Env, sys_hashtable, Hashtable_Get),
4396 f_format(t,
4397 '$ARRAY'([*],
4398 claz_base_character,
4399 "~S - hash table: "),
4400 [Hashtable_Get],
4401 Format_Ret),
4402 get_var(Decf_Env, sys_hashtable, Hashtable_Get17),
4403 f_maphash(closure(kw_function,
4404 [ClosureEnvironment|Decf_Env],
4405 Whole,
4406 LResult,
4407 [key, sys_val],
4408 (f_sys_inspect_indent_1(Indent_1_Ret), get_var(ClosureEnvironment, key, Key_Get), f_format(t, '$ARRAY'([*], claz_base_character, "key : ~S"), [Key_Get], Format_Ret24), f_sys_inspect_indent_1(Indent_1_Ret25), f_format(t, '$ARRAY'([*], claz_base_character, "value:"), [], Format_Ret26), get_var(ClosureEnvironment, sys_val, Val_Get), f_sys_inspect_object(Val_Get, LResult)),
4409
4410 [ lambda,
4411 [key, sys_val],
4412 [sys_inspect_indent_1],
4413
4414 [ format,
4415 t,
4416 '$ARRAY'([*],
4417 claz_base_character,
4418 "key : ~S"),
4419 key
4420 ],
4421 [sys_inspect_indent_1],
4422
4423 [ format,
4424 t,
4425 '$ARRAY'([*],
4426 claz_base_character,
4427 "value:")
4428 ],
4429 [sys_inspect_object, sys_val]
4430 ]),
4431 Hashtable_Get17,
4432 ElseResult),
4433 _7100=ElseResult
4434 )
4435 ),
4436 _7100=FnResult
4437 ),
4438 block_exit(sys_inspect_hashtable, FnResult),
4439 true).
4440:- set_opv(sys_inspect_hashtable, symbol_function, f_sys_inspect_hashtable),
4441 DefunResult=sys_inspect_hashtable. 4442/*
4443:- side_effect(assert_lsp(sys_inspect_hashtable,
4444 lambda_def(defun,
4445 sys_inspect_hashtable,
4446 f_sys_inspect_hashtable,
4447 [sys_hashtable],
4448
4449 [
4450 [ if,
4451 sys_xx_inspect_mode_xx,
4452
4453 [ progn,
4454 [decf, sys_xx_inspect_level_xx],
4455
4456 [ loop,
4457
4458 [ format,
4459 t,
4460 '$ARRAY'([*],
4461 claz_base_character,
4462 "~S - hash table: "),
4463 sys_hashtable
4464 ],
4465 [force_output],
4466
4467 [ case,
4468
4469 [ do,
4470
4471 [
4472 [ char,
4473
4474 [ read_char,
4475 xx_query_io_xx
4476 ],
4477
4478 [ read_char,
4479 xx_query_io_xx
4480 ]
4481 ]
4482 ],
4483
4484 [
4485 [ and,
4486 [char_c47_c61, char|" "],
4487 [char_c47_c61|"\t"]
4488 ],
4489 char
4490 ]
4491 ],
4492
4493 [ "\n\r",
4494
4495 [ sys_select_ht_n,
4496 sys_hashtable
4497 ],
4498 [return, []]
4499 ],
4500
4501 [ "nN",
4502 [sys_inspect_read_line],
4503
4504 [ sys_select_ht_n,
4505 sys_hashtable
4506 ],
4507 [return, []]
4508 ],
4509
4510 [ "sS",
4511 [sys_inspect_read_line],
4512 [return, []]
4513 ],
4514
4515 [ "pP",
4516 [sys_inspect_read_line],
4517 [sys_select_p, sys_hashtable]
4518 ],
4519
4520 [ "aA",
4521 [sys_inspect_read_line],
4522
4523 [ throw,
4524 [quote, sys_abort_inspect],
4525 []
4526 ]
4527 ],
4528 ["eE", [sys_select_e]],
4529
4530 [ "qQ",
4531 [sys_inspect_read_line],
4532
4533 [ throw,
4534 [quote, sys_quit_inspect],
4535 []
4536 ]
4537 ],
4538
4539 [ "lL",
4540 [sys_inspect_read_line],
4541
4542 [ sys_select_ht_l,
4543 sys_hashtable
4544 ]
4545 ],
4546
4547 [ "jJ",
4548
4549 [ sys_select_ht_j,
4550 sys_hashtable
4551 ]
4552 ],
4553
4554 [ "?",
4555 [sys_inspect_read_line],
4556 [sys_select_ht_c63]
4557 ]
4558 ],
4559 [sys_inspect_indent]
4560 ]
4561 ],
4562
4563 [ progn,
4564
4565 [ format,
4566 t,
4567 '$ARRAY'([*],
4568 claz_base_character,
4569 "~S - hash table: "),
4570 sys_hashtable
4571 ],
4572
4573 [ maphash,
4574 function(
4575 [ lambda,
4576 [key, sys_val],
4577 [sys_inspect_indent_1],
4578
4579 [ format,
4580 t,
4581 '$ARRAY'([*],
4582 claz_base_character,
4583 "key : ~S"),
4584 key
4585 ],
4586 [sys_inspect_indent_1],
4587
4588 [ format,
4589 t,
4590 '$ARRAY'([*],
4591 claz_base_character,
4592 "value:")
4593 ],
4594
4595 [ sys_inspect_object,
4596 sys_val
4597 ]
4598 ]),
4599 sys_hashtable
4600 ]
4601 ]
4602 ]
4603 ]))).
4604*/
4605/*
4606:- side_effect(assert_lsp(sys_inspect_hashtable,
4607 arglist_info(sys_inspect_hashtable,
4608 f_sys_inspect_hashtable,
4609 [sys_hashtable],
4610 arginfo{ all:[sys_hashtable],
4611 allow_other_keys:0,
4612 aux:0,
4613 body:0,
4614 complex:0,
4615 env:0,
4616 key:0,
4617 names:[sys_hashtable],
4618 opt:0,
4619 req:[sys_hashtable],
4620 rest:0,
4621 sublists:0,
4622 whole:0
4623 }))).
4624*/
4625/*
4626:- side_effect(assert_lsp(sys_inspect_hashtable,
4627 init_args(x, f_sys_inspect_hashtable))).
4628*/
4629/*
4630#+CLOS
4631(defun inspect-instance (instance)
4632 (if *inspect-mode*
4633 (clos::inspect-obj instance)
4634 (clos::describe-object instance)))
4635
4636*/
4637
4638/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:13408 **********************/
4639:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':CLOS'],[defun,'inspect-instance',[instance],[if,'*inspect-mode*',['clos::inspect-obj',instance],['clos::describe-object',instance]]]]))
4640/*
4641(defun inspect-object (object &aux (*inspect-level* *inspect-level*))
4642 (inspect-indent)
4643 (when (and (not *inspect-mode*)
4644 (or (> *inspect-level* 5)
4645 (member object *inspect-history*)))
4646 (prin1 object)
4647 (return-from inspect-object))
4648 (incf *inspect-level*)
4649 (push object *inspect-history*)
4650 (catch 'ABORT-INSPECT
4651 (cond
4652 #+LOCATIVE
4653 ((not (sys:sl-boundp object)) nil)
4654 ((symbolp object) (inspect-symbol object))
4655 ((packagep object) (inspect-package object))
4656 ((characterp object) (inspect-character object))
4657 ((numberp object) (inspect-number object))
4658 ((consp object) (inspect-cons object))
4659 ((stringp object) (inspect-string object))
4660 ((vectorp object) (inspect-vector object))
4661 ((arrayp object) (inspect-array object))
4662 ((hash-table-p object) (inspect-hashtable object))
4663 #+clos
4664 ((sys:instancep object) (inspect-instance object))
4665 #+LOCATIVE
4666 ((sys:locativep object) (inspect-locative object))
4667 (t (format t ""(defun inspect-object (object &aux (*inspect-level* *inspect-level*))\n (inspect-indent)\n (when (and (not *inspect-mode*)\n (or (> *inspect-level* 5)\n (member object *inspect-history*)))\n (prin1 object)\n (return-from inspect-object))\n (incf *inspect-level*)\n (push object *inspect-history*)\n (catch 'ABORT-INSPECT\n (cond\n\t #+LOCATIVE\n ((not (sys:sl-boundp object)) nil)\n\t ((symbolp object) (inspect-symbol object))\n ((packagep object) (inspect-package object))\n ((characterp object) (inspect-character object))\n ((numberp object) (inspect-number object))\n ((consp object) (inspect-cons object))\n ((stringp object) (inspect-string object))\n ((vectorp object) (inspect-vector object))\n ((arrayp object) (inspect-array object))\n ((hash-table-p object) (inspect-hashtable object))\n\t #+clos\n\t ((sys:instancep object) (inspect-instance object))\n\t #+LOCATIVE\n\t ((sys:locativep object) (inspect-locative object))\n (t (format t \"~S - ~S\" object (type-of object))))))\n\n\n".
4668*/
4669
4670/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:13548 **********************/
4671:-lisp_compile_to_prolog(pkg_sys,[defun,'inspect-object',[object,'&aux',['*inspect-level*','*inspect-level*']],['inspect-indent'],[when,[and,[not,'*inspect-mode*'],[or,[>,'*inspect-level*',5],[member,object,'*inspect-history*']]],[prin1,object],['return-from','inspect-object']],[incf,'*inspect-level*'],[push,object,'*inspect-history*'],[catch,[quote,'ABORT-INSPECT'],[cond,[[symbolp,object],['inspect-symbol',object]],[[packagep,object],['inspect-package',object]],[[characterp,object],['inspect-character',object]],[[numberp,object],['inspect-number',object]],[[consp,object],['inspect-cons',object]],[[stringp,object],['inspect-string',object]],[[vectorp,object],['inspect-vector',object]],[[arrayp,object],['inspect-array',object]],[['hash-table-p',object],['inspect-hashtable',object]],[t,[format,t,'$STRING'("~S - ~S"),object,['type-of',object]]]]]])
4672/*
4673:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
4674 sys_inspect_object,
4675 kw_function,
4676 f_sys_inspect_object)).
4677*/
4678wl:lambda_def(defun, sys_inspect_object, f_sys_inspect_object, [sys_object, c38_aux, [sys_xx_inspect_level_xx, sys_xx_inspect_level_xx]], [[sys_inspect_indent], [when, [and, [not, sys_xx_inspect_mode_xx], [or, [>, sys_xx_inspect_level_xx, 5], [member, sys_object, sys_xx_inspect_history_xx]]], [prin1, sys_object], [return_from, sys_inspect_object]], [incf, sys_xx_inspect_level_xx], [push, sys_object, sys_xx_inspect_history_xx], [catch, [quote, sys_abort_inspect], [cond, [[symbolp, sys_object], [sys_inspect_symbol, sys_object]], [[packagep, sys_object], [sys_inspect_package, sys_object]], [[characterp, sys_object], [sys_inspect_character, sys_object]], [[numberp, sys_object], [sys_inspect_number, sys_object]], [[consp, sys_object], [sys_inspect_cons, sys_object]], [[stringp, sys_object], [sys_inspect_string, sys_object]], [[vectorp, sys_object], [sys_inspect_vector, sys_object]], [[arrayp, sys_object], [sys_inspect_array, sys_object]], [[hash_table_p, sys_object], [sys_inspect_hashtable, sys_object]], [t, [format, t, '$ARRAY'([*], claz_base_character, "~S - ~S"), sys_object, [type_of, sys_object]]]]]]).
4679wl:arglist_info(sys_inspect_object, f_sys_inspect_object, [sys_object, c38_aux, [sys_xx_inspect_level_xx, sys_xx_inspect_level_xx]], arginfo{all:[sys_object], allow_other_keys:0, aux:[sys_xx_inspect_level_xx], body:0, complex:0, env:0, key:0, names:[sys_object, sys_xx_inspect_level_xx], opt:0, req:[sys_object], rest:0, sublists:0, whole:0}).
4680wl: init_args(1, f_sys_inspect_object).
4681
4686f_sys_inspect_object(Object_In, RestNKeys, FnResult) :-
4687 BlockExitEnv=[bv(sys_object, Object_In), bv(sys_xx_inspect_level_xx, Xx_inspect_level_xx_In)],
4688 aux_var(Env,
4689 sys_xx_inspect_level_xx,
4690 Xx_inspect_level_xx_In,
4691 get_var(Get_var_Param,
4692 sys_xx_inspect_level_xx,
4693 Xx_inspect_level_xx_Get),
4694 Xx_inspect_level_xx_Get),
4695 catch(( ( f_sys_inspect_indent(Inspect_indent_Ret),
4696 get_var(BlockExitEnv,
4697 sys_xx_inspect_mode_xx,
4698 Xx_inspect_mode_xx_Get),
4699 ( Xx_inspect_mode_xx_Get==[]
4700 -> ( get_var(BlockExitEnv,
4701 sys_xx_inspect_level_xx,
4702 Xx_inspect_level_xx_Get13),
4703 'f_>'(Xx_inspect_level_xx_Get13, [5], FORM1_Res),
4704 FORM1_Res\==[],
4705 TrueResult=FORM1_Res
4706 -> true
4707 ; get_var(BlockExitEnv, sys_object, Object_Get),
4708 get_var(BlockExitEnv,
4709 sys_xx_inspect_history_xx,
4710 Xx_inspect_history_xx_Get),
4711 f_member(Object_Get,
4712 Xx_inspect_history_xx_Get,
4713 [],
4714 Member_Ret),
4715 TrueResult=Member_Ret
4716 ),
4717 IFTEST=TrueResult
4718 ; IFTEST=[]
4719 ),
4720 ( IFTEST\==[]
4721 -> get_var(BlockExitEnv, sys_object, Object_Get18),
4722 f_prin1(Object_Get18, [], Prin1_Ret),
4723 set_var(BlockExitEnv, block_ret_sys_inspect_object, []),
4724 always(block_exit_sys_inspect_object, BlockExitEnv)
4725 ; _5496=[]
4726 ),
4727 place_op(BlockExitEnv,
4728 incf,
4729 sys_xx_inspect_level_xx,
4730 symbol_value,
4731 [],
4732 Place_op_Ret),
4733 sf_push(BlockExitEnv,
4734 sys_object,
4735 sys_xx_inspect_history_xx,
4736 Xx_inspect_history_xx),
4737 sf_catch(BlockExitEnv,
4738 [quote, sys_abort_inspect],
4739
4740 [ cond,
4741
4742 [ [symbolp, sys_object],
4743 [sys_inspect_symbol, sys_object]
4744 ],
4745
4746 [ [packagep, sys_object],
4747 [sys_inspect_package, sys_object]
4748 ],
4749
4750 [ [characterp, sys_object],
4751 [sys_inspect_character, sys_object]
4752 ],
4753
4754 [ [numberp, sys_object],
4755 [sys_inspect_number, sys_object]
4756 ],
4757
4758 [ [consp, sys_object],
4759 [sys_inspect_cons, sys_object]
4760 ],
4761
4762 [ [stringp, sys_object],
4763 [sys_inspect_string, sys_object]
4764 ],
4765
4766 [ [vectorp, sys_object],
4767 [sys_inspect_vector, sys_object]
4768 ],
4769
4770 [ [arrayp, sys_object],
4771 [sys_inspect_array, sys_object]
4772 ],
4773
4774 [ [hash_table_p, sys_object],
4775 [sys_inspect_hashtable, sys_object]
4776 ],
4777
4778 [ t,
4779
4780 [ format,
4781 t,
4782 '$ARRAY'([*], claz_base_character, "~S - ~S"),
4783 sys_object,
4784 [type_of, sys_object]
4785 ]
4786 ]
4787 ],
4788 Sf_catch_Ret)
4789 ),
4790 Sf_catch_Ret=FnResult
4791 ),
4792 block_exit(sys_inspect_object, FnResult),
4793 true).
4794:- set_opv(sys_inspect_object, symbol_function, f_sys_inspect_object),
4795 DefunResult=sys_inspect_object. 4796/*
4797:- side_effect(assert_lsp(sys_inspect_object,
4798 lambda_def(defun,
4799 sys_inspect_object,
4800 f_sys_inspect_object,
4801
4802 [ sys_object,
4803 c38_aux,
4804
4805 [ sys_xx_inspect_level_xx,
4806 sys_xx_inspect_level_xx
4807 ]
4808 ],
4809
4810 [ [sys_inspect_indent],
4811
4812 [ when,
4813
4814 [ and,
4815 [not, sys_xx_inspect_mode_xx],
4816
4817 [ or,
4818 [>, sys_xx_inspect_level_xx, 5],
4819
4820 [ member,
4821 sys_object,
4822 sys_xx_inspect_history_xx
4823 ]
4824 ]
4825 ],
4826 [prin1, sys_object],
4827 [return_from, sys_inspect_object]
4828 ],
4829 [incf, sys_xx_inspect_level_xx],
4830
4831 [ push,
4832 sys_object,
4833 sys_xx_inspect_history_xx
4834 ],
4835
4836 [ catch,
4837 [quote, sys_abort_inspect],
4838
4839 [ cond,
4840
4841 [ [symbolp, sys_object],
4842 [sys_inspect_symbol, sys_object]
4843 ],
4844
4845 [ [packagep, sys_object],
4846 [sys_inspect_package, sys_object]
4847 ],
4848
4849 [ [characterp, sys_object],
4850
4851 [ sys_inspect_character,
4852 sys_object
4853 ]
4854 ],
4855
4856 [ [numberp, sys_object],
4857 [sys_inspect_number, sys_object]
4858 ],
4859
4860 [ [consp, sys_object],
4861 [sys_inspect_cons, sys_object]
4862 ],
4863
4864 [ [stringp, sys_object],
4865 [sys_inspect_string, sys_object]
4866 ],
4867
4868 [ [vectorp, sys_object],
4869 [sys_inspect_vector, sys_object]
4870 ],
4871
4872 [ [arrayp, sys_object],
4873 [sys_inspect_array, sys_object]
4874 ],
4875
4876 [ [hash_table_p, sys_object],
4877
4878 [ sys_inspect_hashtable,
4879 sys_object
4880 ]
4881 ],
4882
4883 [ t,
4884
4885 [ format,
4886 t,
4887 '$ARRAY'([*],
4888 claz_base_character,
4889 "~S - ~S"),
4890 sys_object,
4891 [type_of, sys_object]
4892 ]
4893 ]
4894 ]
4895 ]
4896 ]))).
4897*/
4898/*
4899:- side_effect(assert_lsp(sys_inspect_object,
4900 arglist_info(sys_inspect_object,
4901 f_sys_inspect_object,
4902
4903 [ sys_object,
4904 c38_aux,
4905
4906 [ sys_xx_inspect_level_xx,
4907 sys_xx_inspect_level_xx
4908 ]
4909 ],
4910 arginfo{ all:[sys_object],
4911 allow_other_keys:0,
4912 aux:[sys_xx_inspect_level_xx],
4913 body:0,
4914 complex:0,
4915 env:0,
4916 key:0,
4917 names:
4918 [ sys_object,
4919 sys_xx_inspect_level_xx
4920 ],
4921 opt:0,
4922 req:[sys_object],
4923 rest:0,
4924 sublists:0,
4925 whole:0
4926 }))).
4927*/
4928/*
4929:- side_effect(assert_lsp(sys_inspect_object,
4930 init_args(1, f_sys_inspect_object))).
4931*/
4932/*
4933(defun describe (object &aux (*inspect-mode* nil)
4934 (*inspect-level* 0)
4935 (*inspect-history* nil)
4936 (*print-level* nil)
4937 (*print-length* nil))
4938 "The lisp function DESCRIBE."
4939 (terpri)
4940 (catch 'QUIT-INSPECT (inspect-object object))
4941 (terpri)
4942 (values))
4943
4944*/
4945
4946/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:14737 **********************/
4947:-lisp_compile_to_prolog(pkg_sys,[defun,describe,[object,'&aux',['*inspect-mode*',[]],['*inspect-level*',0],['*inspect-history*',[]],['*print-level*',[]],['*print-length*',[]]],'$STRING'("The lisp function DESCRIBE."),[terpri],[catch,[quote,'QUIT-INSPECT'],['inspect-object',object]],[terpri],[values]])
4948doc: doc_string(describe, _3046, function, "The lisp function DESCRIBE.").
4949
4950wl:lambda_def(defun, describe, f_describe, [sys_object, c38_aux, [sys_xx_inspect_mode_xx, []], [sys_xx_inspect_level_xx, 0], [sys_xx_inspect_history_xx, []], [xx_print_level_xx, []], [xx_print_length_xx, []]], [[terpri], [catch, [quote, sys_quit_inspect], [sys_inspect_object, sys_object]], [terpri], [values]]).
4951wl:arglist_info(describe, f_describe, [sys_object, c38_aux, [sys_xx_inspect_mode_xx, []], [sys_xx_inspect_level_xx, 0], [sys_xx_inspect_history_xx, []], [xx_print_level_xx, []], [xx_print_length_xx, []]], arginfo{all:[sys_object], allow_other_keys:0, aux:[sys_xx_inspect_mode_xx, sys_xx_inspect_level_xx, sys_xx_inspect_history_xx, xx_print_level_xx, xx_print_length_xx], body:0, complex:0, env:0, key:0, names:[sys_object, sys_xx_inspect_mode_xx, sys_xx_inspect_level_xx, sys_xx_inspect_history_xx, xx_print_level_xx, xx_print_length_xx], opt:0, req:[sys_object], rest:0, sublists:0, whole:0}).
4952wl: init_args(1, f_describe).
4953
4958f_describe(Object_In, RestNKeys, FnResult) :-
4959 Sf_catch_Param=[bv(sys_object, Object_In), bv(sys_xx_inspect_mode_xx, Xx_inspect_mode_xx_In), bv(sys_xx_inspect_level_xx, Xx_inspect_level_xx_In), bv(sys_xx_inspect_history_xx, Xx_inspect_history_xx_In), bv(xx_print_level_xx, Xx_print_level_xx_In), bv(xx_print_length_xx, Xx_print_length_xx_In)],
4960 aux_var(Env, sys_xx_inspect_mode_xx, Xx_inspect_mode_xx_In, true, []),
4961 aux_var(Env, sys_xx_inspect_level_xx, Xx_inspect_level_xx_In, true, 0),
4962 aux_var(Env,
4963 sys_xx_inspect_history_xx,
4964 Xx_inspect_history_xx_In,
4965 true,
4966 []),
4967 aux_var(Env, xx_print_level_xx, Xx_print_level_xx_In, true, []),
4968 aux_var(Env, xx_print_length_xx, Xx_print_length_xx_In, true, []),
4969 catch(( ( f_terpri([], Terpri_Ret),
4970 sf_catch(Sf_catch_Param,
4971 [quote, sys_quit_inspect],
4972 [sys_inspect_object, sys_object],
4973 Sf_catch_Ret),
4974 f_terpri([], Terpri_Ret15),
4975 nb_setval('$mv_return', [])
4976 ),
4977 []=FnResult
4978 ),
4979 block_exit(describe, FnResult),
4980 true).
4981:- set_opv(describe, symbol_function, f_describe),
4982 DefunResult=describe. 4983/*
4984:- side_effect(assert_lsp(describe,
4985 doc_string(describe,
4986 _3046,
4987 function,
4988 "The lisp function DESCRIBE."))).
4989*/
4990/*
4991:- side_effect(assert_lsp(describe,
4992 lambda_def(defun,
4993 describe,
4994 f_describe,
4995
4996 [ sys_object,
4997 c38_aux,
4998 [sys_xx_inspect_mode_xx, []],
4999 [sys_xx_inspect_level_xx, 0],
5000 [sys_xx_inspect_history_xx, []],
5001 [xx_print_level_xx, []],
5002 [xx_print_length_xx, []]
5003 ],
5004
5005 [ [terpri],
5006
5007 [ catch,
5008 [quote, sys_quit_inspect],
5009 [sys_inspect_object, sys_object]
5010 ],
5011 [terpri],
5012 [values]
5013 ]))).
5014*/
5015/*
5016:- side_effect(assert_lsp(describe,
5017 arglist_info(describe,
5018 f_describe,
5019
5020 [ sys_object,
5021 c38_aux,
5022 [sys_xx_inspect_mode_xx, []],
5023 [sys_xx_inspect_level_xx, 0],
5024 [sys_xx_inspect_history_xx, []],
5025 [xx_print_level_xx, []],
5026 [xx_print_length_xx, []]
5027 ],
5028 arginfo{ all:[sys_object],
5029 allow_other_keys:0,
5030 aux:
5031 [ sys_xx_inspect_mode_xx,
5032 sys_xx_inspect_level_xx,
5033 sys_xx_inspect_history_xx,
5034 xx_print_level_xx,
5035 xx_print_length_xx
5036 ],
5037 body:0,
5038 complex:0,
5039 env:0,
5040 key:0,
5041 names:
5042 [ sys_object,
5043 sys_xx_inspect_mode_xx,
5044 sys_xx_inspect_level_xx,
5045 sys_xx_inspect_history_xx,
5046 xx_print_level_xx,
5047 xx_print_length_xx
5048 ],
5049 opt:0,
5050 req:[sys_object],
5051 rest:0,
5052 sublists:0,
5053 whole:0
5054 }))).
5055*/
5056/*
5057:- side_effect(assert_lsp(describe, init_args(1, f_describe))).
5058*/
5059/*
5060(defun inspect (object &aux (*inspect-mode* t)
5061 (*inspect-level* 0)
5062 (*inspect-history* nil)
5063 (*old-print-level* *print-level*)
5064 (*old-print-length* *print-length*)
5065 (*print-level* 3)
5066 (*print-length* 3))
5067 "The lisp function INSPECT."
5068 (read-line)
5069 (princ "Type ? and a newline for help.")
5070 (terpri)
5071 (catch 'QUIT-INSPECT (inspect-object object))
5072 (terpri)
5073 (values))
5074
5075 ;; Format of entries in file help.doc:
5076 ;; ^_[F | V | T]<name>
5077 ;; description
5078 ;; [@[F | V | T]<name>
5079 ;; other description]
5080 ;;
5081 ;; where F means Function, V Variable and T Type.
5082 ;;
5083*/
5084
5085/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:15104 **********************/
5086:-lisp_compile_to_prolog(pkg_sys,[defun,inspect,[object,'&aux',['*inspect-mode*',t],['*inspect-level*',0],['*inspect-history*',[]],['*old-print-level*','*print-level*'],['*old-print-length*','*print-length*'],['*print-level*',3],['*print-length*',3]],'$STRING'("The lisp function INSPECT."),['read-line'],[princ,'$STRING'("Type ? and a newline for help.")],[terpri],[catch,[quote,'QUIT-INSPECT'],['inspect-object',object]],[terpri],[values]])
5087doc: doc_string(inspect, _3288, function, "The lisp function INSPECT.").
5088
5089wl:lambda_def(defun, inspect, f_inspect, [sys_object, c38_aux, [sys_xx_inspect_mode_xx, t], [sys_xx_inspect_level_xx, 0], [sys_xx_inspect_history_xx, []], [sys_xx_old_print_level_xx, xx_print_level_xx], [sys_xx_old_print_length_xx, xx_print_length_xx], [xx_print_level_xx, 3], [xx_print_length_xx, 3]], [[read_line], [princ, '$ARRAY'([*], claz_base_character, "Type ? and a newline for help.")], [terpri], [catch, [quote, sys_quit_inspect], [sys_inspect_object, sys_object]], [terpri], [values]]).
5090wl:arglist_info(inspect, f_inspect, [sys_object, c38_aux, [sys_xx_inspect_mode_xx, t], [sys_xx_inspect_level_xx, 0], [sys_xx_inspect_history_xx, []], [sys_xx_old_print_level_xx, xx_print_level_xx], [sys_xx_old_print_length_xx, xx_print_length_xx], [xx_print_level_xx, 3], [xx_print_length_xx, 3]], arginfo{all:[sys_object], allow_other_keys:0, aux:[sys_xx_inspect_mode_xx, sys_xx_inspect_level_xx, sys_xx_inspect_history_xx, sys_xx_old_print_level_xx, sys_xx_old_print_length_xx, xx_print_level_xx, xx_print_length_xx], body:0, complex:0, env:0, key:0, names:[sys_object, sys_xx_inspect_mode_xx, sys_xx_inspect_level_xx, sys_xx_inspect_history_xx, sys_xx_old_print_level_xx, sys_xx_old_print_length_xx, xx_print_level_xx, xx_print_length_xx], opt:0, req:[sys_object], rest:0, sublists:0, whole:0}).
5091wl: init_args(1, f_inspect).
5092
5097f_inspect(Object_In, RestNKeys, FnResult) :-
5098 Sf_catch_Param=[bv(sys_object, Object_In), bv(sys_xx_inspect_mode_xx, Xx_inspect_mode_xx_In), bv(sys_xx_inspect_level_xx, Xx_inspect_level_xx_In), bv(sys_xx_inspect_history_xx, Xx_inspect_history_xx_In), bv(sys_xx_old_print_level_xx, Xx_old_print_level_xx_In), bv(sys_xx_old_print_length_xx, Xx_old_print_length_xx_In), bv(xx_print_level_xx, Xx_print_level_xx_In), bv(xx_print_length_xx, Xx_print_length_xx_In)],
5099 aux_var(Env, sys_xx_inspect_mode_xx, Xx_inspect_mode_xx_In, true, t),
5100 aux_var(Env, sys_xx_inspect_level_xx, Xx_inspect_level_xx_In, true, 0),
5101 aux_var(Env,
5102 sys_xx_inspect_history_xx,
5103 Xx_inspect_history_xx_In,
5104 true,
5105 []),
5106 aux_var(Env,
5107 sys_xx_old_print_level_xx,
5108 Xx_old_print_level_xx_In,
5109 get_var(Get_var_Param, xx_print_level_xx, Xx_print_level_xx_Get),
5110 Xx_print_level_xx_Get),
5111 aux_var(Env,
5112 sys_xx_old_print_length_xx,
5113 Xx_old_print_length_xx_In,
5114 get_var(Get_var_Param17,
5115 xx_print_length_xx,
5116 Xx_print_length_xx_Get),
5117 Xx_print_length_xx_Get),
5118 aux_var(Env, xx_print_level_xx, Xx_print_level_xx_In, true, 3),
5119 aux_var(Env, xx_print_length_xx, Xx_print_length_xx_In, true, 3),
5120 catch(( ( f_read_line([], Read_line_Ret),
5121 f_princ('$ARRAY'([*],
5122 claz_base_character,
5123 "Type ? and a newline for help."),
5124 [],
5125 Princ_Ret),
5126 f_terpri([], Terpri_Ret),
5127 sf_catch(Sf_catch_Param,
5128 [quote, sys_quit_inspect],
5129 [sys_inspect_object, sys_object],
5130 Sf_catch_Ret),
5131 f_terpri([], Terpri_Ret23),
5132 nb_setval('$mv_return', [])
5133 ),
5134 []=FnResult
5135 ),
5136 block_exit(inspect, FnResult),
5137 true).
5138:- set_opv(inspect, symbol_function, f_inspect),
5139 DefunResult=inspect. 5140/*
5141:- side_effect(assert_lsp(inspect,
5142 doc_string(inspect,
5143 _3288,
5144 function,
5145 "The lisp function INSPECT."))).
5146*/
5147/*
5148:- side_effect(assert_lsp(inspect,
5149 lambda_def(defun,
5150 inspect,
5151 f_inspect,
5152
5153 [ sys_object,
5154 c38_aux,
5155 [sys_xx_inspect_mode_xx, t],
5156 [sys_xx_inspect_level_xx, 0],
5157 [sys_xx_inspect_history_xx, []],
5158
5159 [ sys_xx_old_print_level_xx,
5160 xx_print_level_xx
5161 ],
5162
5163 [ sys_xx_old_print_length_xx,
5164 xx_print_length_xx
5165 ],
5166 [xx_print_level_xx, 3],
5167 [xx_print_length_xx, 3]
5168 ],
5169
5170 [ [read_line],
5171
5172 [ princ,
5173 '$ARRAY'([*],
5174 claz_base_character,
5175 "Type ? and a newline for help.")
5176 ],
5177 [terpri],
5178
5179 [ catch,
5180 [quote, sys_quit_inspect],
5181 [sys_inspect_object, sys_object]
5182 ],
5183 [terpri],
5184 [values]
5185 ]))).
5186*/
5187/*
5188:- side_effect(assert_lsp(inspect,
5189 arglist_info(inspect,
5190 f_inspect,
5191
5192 [ sys_object,
5193 c38_aux,
5194 [sys_xx_inspect_mode_xx, t],
5195 [sys_xx_inspect_level_xx, 0],
5196 [sys_xx_inspect_history_xx, []],
5197
5198 [ sys_xx_old_print_level_xx,
5199 xx_print_level_xx
5200 ],
5201
5202 [ sys_xx_old_print_length_xx,
5203 xx_print_length_xx
5204 ],
5205 [xx_print_level_xx, 3],
5206 [xx_print_length_xx, 3]
5207 ],
5208 arginfo{ all:[sys_object],
5209 allow_other_keys:0,
5210 aux:
5211 [ sys_xx_inspect_mode_xx,
5212 sys_xx_inspect_level_xx,
5213 sys_xx_inspect_history_xx,
5214 sys_xx_old_print_level_xx,
5215 sys_xx_old_print_length_xx,
5216 xx_print_level_xx,
5217 xx_print_length_xx
5218 ],
5219 body:0,
5220 complex:0,
5221 env:0,
5222 key:0,
5223 names:
5224 [ sys_object,
5225 sys_xx_inspect_mode_xx,
5226 sys_xx_inspect_level_xx,
5227 sys_xx_inspect_history_xx,
5228 sys_xx_old_print_level_xx,
5229 sys_xx_old_print_length_xx,
5230 xx_print_level_xx,
5231 xx_print_length_xx
5232 ],
5233 opt:0,
5234 req:[sys_object],
5235 rest:0,
5236 sublists:0,
5237 whole:0
5238 }))).
5239*/
5240/*
5241:- side_effect(assert_lsp(inspect, init_args(1, f_inspect))).
5242*/
5243/*
5244; Format of entries in file help.doc:
5245*/
5246/*
5247; ^_[F | V | T]<name>
5248*/
5249/*
5250; description
5251*/
5252/*
5253; [@[F | V | T]<name>
5254*/
5255/*
5256; other description]
5257*/
5258/*
5259;
5260*/
5261/*
5262; where F means Function, V Variable and T Type.
5263*/
5264/*
5265;
5266*/
5267/*
5268(defun print-doc-part-2 (symbol &optional (called-from-apropos-doc-p nil)
5269 &aux (f nil) x (*notify-gbc* nil))
5270
5271 (let* ((name (symbol-name symbol))
5272 (path (merge-pathnames *system-directory* "help.doc"))
5273 (pos 0))
5274
5275 (labels ((bin-search (file start end &aux (delta 0) (middle 0) sym)
5276 (declare (fixnum start end delta middle))
5277 (when (< start end)
5278 (setq middle (round (+ start end) 2))
5279 (file-position file middle)
5280 (if (and (plusp (setq delta (scan-for #\^_ file)))
5281 (<= delta (- end middle)))
5282 (if (string-equal name
5283 (setq sym (symbol-name (read file))))
5284 (+ middle delta (length name) 1) ; skip EOL
5285 (if (string< name sym)
5286 (bin-search file start (1- middle))
5287 (bin-search file (+ middle delta) end)))
5288 (bin-search file start (1- middle)))))
5289 (scan-for (char file)
5290 (do ((v #\space (read-char file nil nil))
5291 (n 0 (1+ n)))
5292 ((eql v #\^_)
5293 (if (read-char file nil nil) n -1))
5294 ; skip V | F | T.
5295 (declare (fixnum n)))))
5296
5297 (if (probe-file path)
5298 (with-open-file (file path)
5299 (setq pos (bin-search file 0 (file-length file)))
5300 (when pos
5301 (setq f t)
5302 (file-position file pos)
5303 (do (v)
5304 ((eql (setq v (read-char file nil #\^_)) #\^_))
5305 (if (eql v #\Space )
5306 (progn
5307 (terpri)
5308 (read-char file nil nil)) ; skip V | F | T.
5309 (princ v)))))
5310 (format t ""(defun print-doc-part-2 (symbol &optional (called-from-apropos-doc-p nil)\n &aux (f nil) x (*notify-gbc* nil))\n\n (let* ((name (symbol-name symbol))\n\t (path (merge-pathnames *system-directory* \"help.doc\"))\n\t (pos 0))\n\n (labels ((bin-search (file start end &aux (delta 0) (middle 0) sym)\n\t (declare (fixnum start end delta middle))\n\t (when (< start end)\n\t\t (setq middle (round (+ start end) 2))\n\t\t (file-position file middle)\n\t\t (if (and (plusp (setq delta (scan-for #\\^_ file)))\n\t\t\t (<= delta (- end middle)))\n\t\t (if (string-equal name\n\t\t\t\t (setq sym (symbol-name (read file))))\n\t\t\t (+ middle delta (length name) 1) ; skip EOL\n\t\t\t (if (string< name sym)\n\t\t\t (bin-search file start (1- middle))\n\t\t\t (bin-search file (+ middle delta) end)))\n\t\t (bin-search file start (1- middle)))))\n\t (scan-for (char file)\n\t (do ((v #\\space (read-char file nil nil))\n\t\t (n 0 (1+ n)))\n\t\t ((eql v #\\^_)\n\t\t (if (read-char file nil nil) n -1))\t\n\t\t ; skip V | F | T.\n\t\t (declare (fixnum n)))))\n\n (if (probe-file path)\n\t (with-open-file (file path)\n\t (setq pos (bin-search file 0 (file-length file)))\n\t (when pos\n\t (setq f t)\n\t (file-position file pos)\n\t (do (v)\n\t\t ((eql (setq v (read-char file nil #\\^_)) #\\^_))\n\t\t(if (eql v #\\Space\000\)\n\t\t (progn\n\t\t (terpri)\n\t\t (read-char file nil nil))\t; skip V | F | T.\n\t\t (princ v)))))\n\t (format t \"~&Cannot find the help file \\\"help.doc\\\"\"\n\t ))\n\n\t ))\n\n (if called-from-apropos-doc-p\n f\n (progn (if f\n (format t \"~&-----------------------------------------------------------------------------\")\n (format t \"~&No documentation for ~:@(~S~).\" symbol))\n (values))))\n\n".
5311*/
5312
5313/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:15835 **********************/
5314:-lisp_compile_to_prolog(pkg_sys,[defun,'print-doc-part-2',[symbol,'&optional',['called-from-apropos-doc-p',[]],'&aux',[f,[]],x,['*notify-gbc*',[]]],['let*',[[name,['symbol-name',symbol]],[path,['merge-pathnames','*system-directory*','$STRING'("help.doc")]],[pos,0]],[labels,[['bin-search',[file,start,end,'&aux',[delta,0],[middle,0],sym],[declare,[fixnum,start,end,delta,middle]],[when,[<,start,end],[setq,middle,[round,[+,start,end],2]],['file-position',file,middle],[if,[and,[plusp,[setq,delta,['scan-for',#\('\037\'),file]]],[<=,delta,[-,end,middle]]],[if,['string-equal',name,[setq,sym,['symbol-name',[read,file]]]],[+,middle,delta,[length,name],1],[if,['string<',name,sym],['bin-search',file,start,['1-',middle]],['bin-search',file,[+,middle,delta],end]]],['bin-search',file,start,['1-',middle]]]]],['scan-for',[char,file],[do,[[v,#\(' '),['read-char',file,[],[]]],[n,0,['1+',n]]],[[eql,v,#\('\037\')],[if,['read-char',file,[],[]],n,-1]],[declare,[fixnum,n]]]]],[if,['probe-file',path],['with-open-file',[file,path],[setq,pos,['bin-search',file,0,['file-length',file]]],[when,pos,[setq,f,t],['file-position',file,pos],[do,[v],[[eql,[setq,v,['read-char',file,[],#\('\037\')]],#\('\037\')]],[if,[eql,v,#\(' ')],[progn,[terpri],['read-char',file,[],[]]],[princ,v]]]]],[format,t,'$STRING'("~&Cannot find the help file \"help.doc\"")]]]],[if,'called-from-apropos-doc-p',f,[progn,[if,f,[format,t,'$STRING'("~&-----------------------------------------------------------------------------")],[format,t,'$STRING'("~&No documentation for ~:@(~S~)."),symbol]],[values]]]])
5315/*
5316:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
5317 sys_print_doc_part_2,
5318 kw_function,
5319 f_sys_print_doc_part_2)).
5320*/
5321/*
5322:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
5323 sys_bin_search,
5324 kw_function,
5325 f_sys_bin_search)).
5326*/
5327/*
5328:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
5329 sys_scan_for,
5330 kw_function,
5331 f_sys_scan_for)).
5332*/
5333/*
5334:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
5335 sys_bin_search,
5336 kw_function,
5337 f_sys_bin_search)).
5338*/
5339/*
5340:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
5341 sys_bin_search,
5342 kw_function,
5343 f_sys_bin_search)).
5344*/
5345/*
5346:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
5347 sys_bin_search,
5348 kw_function,
5349 f_sys_bin_search)).
5350*/
5351/*
5352:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
5353 sys_scan_for,
5354 kw_function,
5355 f_sys_scan_for)).
5356*/
5357wl:lambda_def(defun, sys_print_doc_part_2, f_sys_print_doc_part_2, [symbol, c38_optional, [sys_called_from_apropos_doc_p, []], c38_aux, [sys_f, []], sys_x, [sys_xx_notify_gbc_xx, []]], [[let_xx, [[sys_name, [symbol_name, symbol]], [sys_path, [merge_pathnames, sys_xx_system_directory_xx, '$ARRAY'([*], claz_base_character, "help.doc")]], [sys_pos, 0]], [labels, [[sys_bin_search, [sys_file, sys_start, sys_end, c38_aux, [sys_delta, 0], [sys_middle, 0], sys_sym], [declare, [fixnum, sys_start, sys_end, sys_delta, sys_middle]], [when, [<, sys_start, sys_end], [setq, sys_middle, [round, [+, sys_start, sys_end], 2]], [file_position, sys_file, sys_middle], [if, [and, [plusp, [setq, sys_delta, [sys_scan_for, #\('\037\'), sys_file]]], [<=, sys_delta, [-, sys_end, sys_middle]]], [if, [string_equal, sys_name, [setq, sys_sym, [symbol_name, [read, sys_file]]]], [+, sys_middle, sys_delta, [length, sys_name], 1], [if, [string_c60, sys_name, sys_sym], [sys_bin_search, sys_file, sys_start, ['1-', sys_middle]], [sys_bin_search, sys_file, [+, sys_middle, sys_delta], sys_end]]], [sys_bin_search, sys_file, sys_start, ['1-', sys_middle]]]]], [sys_scan_for, [char, sys_file], [do, [[sys_v, #\(' '), [read_char, sys_file, [], []]], [sys_n, 0, ['1+', sys_n]]], [[eql, sys_v|"\037\"], [if, [read_char, sys_file, [], []], sys_n, -1]], [declare, [fixnum, sys_n]]]]], [if, [probe_file, sys_path], [with_open_file, [sys_file, sys_path], [setq, sys_pos, [sys_bin_search, sys_file, 0, [file_length, sys_file]]], [when, sys_pos, [setq, sys_f, t], [file_position, sys_file, sys_pos], [do, [sys_v], [[eql, [setq, sys_v, [read_char, sys_file, []|"\037\"]]|"\037\"]], [if, [eql, sys_v|" "], [progn, [terpri], [read_char, sys_file, [], []]], [princ, sys_v]]]]], [format, t, '$ARRAY'([*], claz_base_character, "~&Cannot find the help file \"help.doc\"")]]]], [if, sys_called_from_apropos_doc_p, sys_f, [progn, [if, sys_f, [format, t, '$ARRAY'([*], claz_base_character, "~&-----------------------------------------------------------------------------")], [format, t, '$ARRAY'([*], claz_base_character, "~&No documentation for ~:@(~S~)."), symbol]], [values]]]]).
5358wl:arglist_info(sys_print_doc_part_2, f_sys_print_doc_part_2, [symbol, c38_optional, [sys_called_from_apropos_doc_p, []], c38_aux, [sys_f, []], sys_x, [sys_xx_notify_gbc_xx, []]], arginfo{all:[symbol, sys_called_from_apropos_doc_p], allow_other_keys:0, aux:[sys_f, sys_x, sys_xx_notify_gbc_xx], body:0, complex:0, env:0, key:0, names:[symbol, sys_called_from_apropos_doc_p, sys_f, sys_x, sys_xx_notify_gbc_xx], opt:[sys_called_from_apropos_doc_p], req:[symbol], rest:0, sublists:0, whole:0}).
5359wl: init_args(1, f_sys_print_doc_part_2).
5360
5365f_sys_print_doc_part_2(Symbol_In, RestNKeys, FnResult) :-
5366 GEnv=[bv(symbol, Symbol_In), bv(sys_called_from_apropos_doc_p, Called_from_apropos_doc_p_In), bv(sys_f, In), bv(sys_x, X_In), bv(sys_xx_notify_gbc_xx, Xx_notify_gbc_xx_In)],
5367 opt_var(Env,
5368 sys_called_from_apropos_doc_p,
5369 Called_from_apropos_doc_p_In,
5370 true,
5371 [],
5372 1,
5373 RestNKeys),
5374 aux_var(Env, sys_f, In, true, []),
5375 aux_var(Env, sys_x, X_In, true, []),
5376 aux_var(Env, sys_xx_notify_gbc_xx, Xx_notify_gbc_xx_In, true, []),
5377 catch(( ( get_var(GEnv, symbol, Symbol_Get),
5378 f_symbol_name(Symbol_Get, Name_Init),
5379 LEnv=[bv(sys_name, Name_Init)|GEnv],
5380 get_var(LEnv,
5381 sys_xx_system_directory_xx,
5382 Xx_system_directory_xx_Get),
5383 f_merge_pathnames(Xx_system_directory_xx_Get,
5384
5385 [ '$ARRAY'([*],
5386 claz_base_character,
5387 "help.doc")
5388 ],
5389 Path_Init),
5390 LEnv17=[bv(sys_path, Path_Init)|LEnv],
5391 LEnv22=[bv(sys_pos, 0)|LEnv17],
5392 assert_lsp(sys_bin_search,
5393 wl:lambda_def(defun, sys_bin_search, f_sys_bin_search1, [sys_file, sys_start, sys_end, c38_aux, [sys_delta, 0], [sys_middle, 0], sys_sym], [[declare, [fixnum, sys_start, sys_end, sys_delta, sys_middle]], [when, [<, sys_start, sys_end], [setq, sys_middle, [round, [+, sys_start, sys_end], 2]], [file_position, sys_file, sys_middle], [if, [and, [plusp, [setq, sys_delta, [sys_scan_for, #\('\037\'), sys_file]]], [<=, sys_delta, [-, sys_end, sys_middle]]], [if, [string_equal, sys_name, [setq, sys_sym, [symbol_name, [read, sys_file]]]], [+, sys_middle, sys_delta, [length, sys_name], 1], [if, [string_c60, sys_name, sys_sym], [sys_bin_search, sys_file, sys_start, ['1-', sys_middle]], [sys_bin_search, sys_file, [+, sys_middle, sys_delta], sys_end]]], [sys_bin_search, sys_file, sys_start, ['1-', sys_middle]]]]])),
5394 assert_lsp(sys_bin_search,
5395 wl:arglist_info(sys_bin_search, f_sys_bin_search1, [sys_file, sys_start, sys_end, c38_aux, [sys_delta, 0], [sys_middle, 0], sys_sym], arginfo{all:[sys_file, sys_start, sys_end], allow_other_keys:0, aux:[sys_delta, sys_middle, sys_sym], body:0, complex:0, env:0, key:0, names:[sys_file, sys_start, sys_end, sys_delta, sys_middle, sys_sym], opt:0, req:[sys_file, sys_start, sys_end], rest:0, sublists:0, whole:0})),
5396 assert_lsp(sys_bin_search, wl:init_args(3, f_sys_bin_search1)),
5397 assert_lsp(sys_bin_search,
5398 (f_sys_bin_search1(File_In, Start_In, End_In, RestNKeys25, FnResult24):-AEnv=[bv(sys_file, File_In), bv(sys_start, Start_In), bv(sys_end, End_In), bv(sys_delta, Delta_In), bv(sys_middle, Middle_In), bv(sys_sym, Sym_In)], aux_var(LEnv22, sys_delta, Delta_In, true, 0), aux_var(LEnv22, sys_middle, Middle_In, true, 0), aux_var(LEnv22, sys_sym, Sym_In, true, []), catch(((sf_declare(AEnv, [fixnum, sys_start, sys_end, sys_delta, sys_middle], Sf_declare_Ret), get_var(AEnv, sys_end, End_Get), get_var(AEnv, sys_start, Start_Get), (Start_Get<End_Get->get_var(AEnv, sys_end, End_Get40), get_var(AEnv, sys_start, Start_Get39), 'f_+'([Start_Get39, End_Get40], Round_Param), f_round(Round_Param, [2], Middle), set_var(AEnv, sys_middle, Middle), get_var(AEnv, sys_file, File_Get), get_var(AEnv, sys_middle, Middle_Get), f_file_position(File_Get, [Middle_Get], File_position_Ret), get_var(AEnv, sys_file, File_Get46), f_sys_scan_for(#\('\037\'), File_Get46, PredArgResult), set_var(AEnv, sys_delta, PredArgResult), (mth:is_plusp(PredArgResult)->get_var(AEnv, sys_delta, Delta_Get), get_var(AEnv, sys_end, End_Get50), get_var(AEnv, sys_middle, Middle_Get51), 'f_-'(End_Get50, [Middle_Get51], CAR), 'f_<='(Delta_Get, [CAR], TrueResult), IFTEST43=TrueResult;IFTEST43=[]), (IFTEST43\==[]->get_var(AEnv, sys_file, File_Get56), get_var(AEnv, sys_name, Name_Get), f_read(File_Get56, Symbol_name_Param), f_symbol_name(Symbol_name_Param, Sym), set_var(AEnv, sys_sym, Sym), f_string_equal(Name_Get, Sym, [], IFTEST53), (IFTEST53\==[]->get_var(AEnv, sys_delta, Delta_Get58), get_var(AEnv, sys_middle, Middle_Get57), 'f_+'([Middle_Get57, Delta_Get58], CAR157), get_var(AEnv, sys_name, Name_Get59), f_length(Name_Get59, Length_Ret), 'f_+'([CAR157, Length_Ret], CAR158), 'f_+'([CAR158, 1], TrueResult73), TrueResult78=TrueResult73;get_var(AEnv, sys_name, Name_Get62), get_var(AEnv, sys_sym, Sym_Get), f_string_c60(Name_Get62, Sym_Get, [], IFTEST60), (IFTEST60\==[]->get_var(AEnv, sys_file, File_Get64), get_var(AEnv, sys_middle, Middle_Get66), get_var(AEnv, sys_start, Start_Get65), 'f_1-'(Middle_Get66, _11112), f_sys_bin_search(File_Get64, Start_Get65, _11112, TrueResult71), ElseResult74=TrueResult71;get_var(AEnv, sys_delta, Delta_Get69), get_var(AEnv, sys_file, File_Get67), get_var(AEnv, sys_middle, Middle_Get68), 'f_+'([Middle_Get68, Delta_Get69], _11172), get_var(AEnv, sys_end, End_Get70), f_sys_bin_search(File_Get67, _11172, End_Get70, ElseResult), ElseResult74=ElseResult), TrueResult78=ElseResult74), TrueResult80=TrueResult78;get_var(AEnv, sys_file, File_Get75), get_var(AEnv, sys_middle, Middle_Get77), get_var(AEnv, sys_start, Start_Get76), 'f_1-'(Middle_Get77, _11406), f_sys_bin_search(File_Get75, Start_Get76, _11406, ElseResult79), TrueResult80=ElseResult79), _10288=TrueResult80;_10288=[])), _10288=FnResult24), block_exit(sys_bin_search, FnResult24), true))),
5399 assert_lsp(sys_scan_for,
5400 wl:lambda_def(defun, sys_scan_for, f_sys_scan_for1, [char, sys_file], [[do, [[sys_v, #\(' '), [read_char, sys_file, [], []]], [sys_n, 0, ['1+', sys_n]]], [[eql, sys_v|"\037\"], [if, [read_char, sys_file, [], []], sys_n, -1]], [declare, [fixnum, sys_n]]]])),
5401 assert_lsp(sys_scan_for,
5402 wl:arglist_info(sys_scan_for, f_sys_scan_for1, [char, sys_file], arginfo{all:[char, sys_file], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[char, sys_file], opt:0, req:[char, sys_file], rest:0, sublists:0, whole:0})),
5403 assert_lsp(sys_scan_for, wl:init_args(2, f_sys_scan_for1)),
5404 assert_lsp(sys_scan_for,
5405 (f_sys_scan_for1(Char_In, File_In85, RestNKeys83, FnResult82):-CDR=[bv(char, Char_In), bv(sys_file, File_In85)], catch(((BlockExitEnv=[bv(sys_v, #\(' ')), bv(sys_n, 0)|CDR], catch((call_addr_block(BlockExitEnv, (push_label(do_label_4), get_var(BlockExitEnv, sys_v, V_Get110), (is_eql(V_Get110, #\('\037\'))->get_var(BlockExitEnv, sys_file, File_Get117), f_read_char([File_Get117, [], []], IFTEST115), (IFTEST115\==[]->get_var(BlockExitEnv, sys_n, N_Get118), RetResult113=N_Get118;RetResult113= -1), throw(block_exit([], RetResult113)), _TBResult=ThrowResult114;sf_declare(BlockExitEnv, [fixnum, sys_n], Sf_declare_Ret160), get_var(BlockExitEnv, sys_file, File_Get121), f_read_char([File_Get121, [], []], V), get_var(BlockExitEnv, sys_n, N_Get122), 'f_1+'(N_Get122, N), set_var(BlockExitEnv, sys_v, V), set_var(BlockExitEnv, sys_n, N), goto(do_label_4, BlockExitEnv), _TBResult=_GORES123)), [addr(addr_tagbody_4_do_label_4, do_label_4, '$unused', BlockExitEnv, (get_var(BlockExitEnv, sys_v, V_Get), (is_eql(V_Get, #\('\037\'))->get_var(BlockExitEnv, sys_file, File_Get98), f_read_char([File_Get98, [], []], IFTEST96), (IFTEST96\==[]->get_var(BlockExitEnv, sys_n, N_Get), Block_exit_Ret=N_Get;Block_exit_Ret= -1), throw(block_exit([], Block_exit_Ret)), _12598=ThrowResult;sf_declare(BlockExitEnv, [fixnum, sys_n], Sf_declare_Ret162), get_var(BlockExitEnv, sys_file, File_Get102), f_read_char([File_Get102, [], []], Read_char_Ret), get_var(BlockExitEnv, sys_n, N_Get103), 'f_1+'(N_Get103, Set_var_Ret), set_var(BlockExitEnv, sys_v, Read_char_Ret), set_var(BlockExitEnv, sys_n, Set_var_Ret), goto(do_label_4, BlockExitEnv), _12598=_GORES)))]), []=LetResult87), block_exit([], LetResult87), true)), LetResult87=FnResult82), block_exit(sys_scan_for, FnResult82), true))),
5406 get_var(LEnv22, sys_path, Path_Get),
5407 f_probe_file(Path_Get, IFTEST128),
5408 ( IFTEST128\==[]
5409 -> sf_with_open_file(LEnv22,
5410 [sys_file, sys_path],
5411
5412 [ setq,
5413 sys_pos,
5414
5415 [ sys_bin_search,
5416 sys_file,
5417 0,
5418 [file_length, sys_file]
5419 ]
5420 ],
5421
5422 [ when,
5423 sys_pos,
5424 [setq, sys_f, t],
5425 [file_position, sys_file, sys_pos],
5426
5427 [ do,
5428 [sys_v],
5429
5430 [
5431 [ eql,
5432
5433 [ setq,
5434 sys_v,
5435
5436 [ read_char,
5437 sys_file,
5438 []
5439 | "\037\"
5440 ]
5441 ]
5442 | "\037\"
5443 ]
5444 ],
5445
5446 [ if,
5447 [eql, sys_v|" "],
5448
5449 [ progn,
5450 [terpri],
5451 [read_char, sys_file, [], []]
5452 ],
5453 [princ, sys_v]
5454 ]
5455 ]
5456 ],
5457 TrueResult131),
5458 LetResult16=TrueResult131
5459 ; f_format(t,
5460 '$ARRAY'([*],
5461 claz_base_character,
5462 "~&Cannot find the help file \"help.doc\""),
5463 [],
5464 ElseResult132),
5465 LetResult16=ElseResult132
5466 ),
5467 get_var(GEnv, sys_called_from_apropos_doc_p, IFTEST133),
5468 ( IFTEST133\==[]
5469 -> get_var(GEnv, sys_f, Get),
5470 _9856=Get
5471 ; get_var(GEnv, sys_f, IFTEST137),
5472 ( IFTEST137\==[]
5473 -> f_format(t,
5474 '$ARRAY'([*],
5475 claz_base_character,
5476 "~&-----------------------------------------------------------------------------"),
5477 [],
5478 TrueResult141),
5479 _12862=TrueResult141
5480 ; get_var(GEnv, symbol, Symbol_Get140),
5481 f_format(t,
5482 '$ARRAY'([*],
5483 claz_base_character,
5484 "~&No documentation for ~:@(~S~)."),
5485 [Symbol_Get140],
5486 ElseResult142),
5487 _12862=ElseResult142
5488 ),
5489 nb_setval('$mv_return', []),
5490 _9856=[]
5491 )
5492 ),
5493 _9856=FnResult
5494 ),
5495 block_exit(sys_print_doc_part_2, FnResult),
5496 true).
5497:- set_opv(sys_print_doc_part_2, symbol_function, f_sys_print_doc_part_2),
5498 DefunResult=sys_print_doc_part_2. 5499/*
5500:- side_effect(assert_lsp(sys_print_doc_part_2,
5501 lambda_def(defun,
5502 sys_print_doc_part_2,
5503 f_sys_print_doc_part_2,
5504
5505 [ symbol,
5506 c38_optional,
5507 [sys_called_from_apropos_doc_p, []],
5508 c38_aux,
5509 [sys_f, []],
5510 sys_x,
5511 [sys_xx_notify_gbc_xx, []]
5512 ],
5513
5514 [
5515 [ let_xx,
5516
5517 [ [sys_name, [symbol_name, symbol]],
5518
5519 [ sys_path,
5520
5521 [ merge_pathnames,
5522 sys_xx_system_directory_xx,
5523 '$ARRAY'([*],
5524 claz_base_character,
5525 "help.doc")
5526 ]
5527 ],
5528 [sys_pos, 0]
5529 ],
5530
5531 [ labels,
5532
5533 [
5534 [ sys_bin_search,
5535
5536 [ sys_file,
5537 sys_start,
5538 sys_end,
5539 c38_aux,
5540 [sys_delta, 0],
5541 [sys_middle, 0],
5542 sys_sym
5543 ],
5544
5545 [ declare,
5546
5547 [ fixnum,
5548 sys_start,
5549 sys_end,
5550 sys_delta,
5551 sys_middle
5552 ]
5553 ],
5554
5555 [ when,
5556 [<, sys_start, sys_end],
5557
5558 [ setq,
5559 sys_middle,
5560
5561 [ round,
5562 [+, sys_start, sys_end],
5563 2
5564 ]
5565 ],
5566
5567 [ file_position,
5568 sys_file,
5569 sys_middle
5570 ],
5571
5572 [ if,
5573
5574 [ and,
5575
5576 [ plusp,
5577
5578 [ setq,
5579 sys_delta,
5580
5581 [ sys_scan_for,
5582 #\('\037\'),
5583 sys_file
5584 ]
5585 ]
5586 ],
5587
5588 [ <=,
5589 sys_delta,
5590 [-, sys_end, sys_middle]
5591 ]
5592 ],
5593
5594 [ if,
5595
5596 [ string_equal,
5597 sys_name,
5598
5599 [ setq,
5600 sys_sym,
5601
5602 [ symbol_name,
5603 [read, sys_file]
5604 ]
5605 ]
5606 ],
5607
5608 [ (+),
5609 sys_middle,
5610 sys_delta,
5611 [length, sys_name],
5612 1
5613 ],
5614
5615 [ if,
5616
5617 [ string_c60,
5618 sys_name,
5619 sys_sym
5620 ],
5621
5622 [ sys_bin_search,
5623 sys_file,
5624 sys_start,
5625 ['1-', sys_middle]
5626 ],
5627
5628 [ sys_bin_search,
5629 sys_file,
5630
5631 [ (+),
5632 sys_middle,
5633 sys_delta
5634 ],
5635 sys_end
5636 ]
5637 ]
5638 ],
5639
5640 [ sys_bin_search,
5641 sys_file,
5642 sys_start,
5643 ['1-', sys_middle]
5644 ]
5645 ]
5646 ]
5647 ],
5648
5649 [ sys_scan_for,
5650 [char, sys_file],
5651
5652 [ do,
5653
5654 [
5655 [ sys_v,
5656 #\(' '),
5657
5658 [ read_char,
5659 sys_file,
5660 [],
5661 []
5662 ]
5663 ],
5664 [sys_n, 0, ['1+', sys_n]]
5665 ],
5666
5667 [ [eql, sys_v|"\037\"],
5668
5669 [ if,
5670
5671 [ read_char,
5672 sys_file,
5673 [],
5674 []
5675 ],
5676 sys_n,
5677 -1
5678 ]
5679 ],
5680 [declare, [fixnum, sys_n]]
5681 ]
5682 ]
5683 ],
5684
5685 [ if,
5686 [probe_file, sys_path],
5687
5688 [ with_open_file,
5689 [sys_file, sys_path],
5690
5691 [ setq,
5692 sys_pos,
5693
5694 [ sys_bin_search,
5695 sys_file,
5696 0,
5697 [file_length, sys_file]
5698 ]
5699 ],
5700
5701 [ when,
5702 sys_pos,
5703 [setq, sys_f, t],
5704
5705 [ file_position,
5706 sys_file,
5707 sys_pos
5708 ],
5709
5710 [ do,
5711 [sys_v],
5712
5713 [
5714 [ eql,
5715
5716 [ setq,
5717 sys_v,
5718
5719 [ read_char,
5720 sys_file,
5721 []
5722 | "\037\"
5723 ]
5724 ]
5725 | "\037\"
5726 ]
5727 ],
5728
5729 [ if,
5730 [eql, sys_v|" "],
5731
5732 [ progn,
5733 [terpri],
5734
5735 [ read_char,
5736 sys_file,
5737 [],
5738 []
5739 ]
5740 ],
5741 [princ, sys_v]
5742 ]
5743 ]
5744 ]
5745 ],
5746
5747 [ format,
5748 t,
5749 '$ARRAY'([*],
5750 claz_base_character,
5751 "~&Cannot find the help file \"help.doc\"")
5752 ]
5753 ]
5754 ]
5755 ],
5756
5757 [ if,
5758 sys_called_from_apropos_doc_p,
5759 sys_f,
5760
5761 [ progn,
5762
5763 [ if,
5764 sys_f,
5765
5766 [ format,
5767 t,
5768 '$ARRAY'([*],
5769 claz_base_character,
5770 "~&-----------------------------------------------------------------------------")
5771 ],
5772
5773 [ format,
5774 t,
5775 '$ARRAY'([*],
5776 claz_base_character,
5777 "~&No documentation for ~:@(~S~)."),
5778 symbol
5779 ]
5780 ],
5781 [values]
5782 ]
5783 ]
5784 ]))).
5785*/
5786/*
5787:- side_effect(assert_lsp(sys_print_doc_part_2,
5788 arglist_info(sys_print_doc_part_2,
5789 f_sys_print_doc_part_2,
5790
5791 [ symbol,
5792 c38_optional,
5793 [sys_called_from_apropos_doc_p, []],
5794 c38_aux,
5795 [sys_f, []],
5796 sys_x,
5797 [sys_xx_notify_gbc_xx, []]
5798 ],
5799 arginfo{ all:
5800 [ symbol,
5801 sys_called_from_apropos_doc_p
5802 ],
5803 allow_other_keys:0,
5804 aux:
5805 [ sys_f,
5806 sys_x,
5807 sys_xx_notify_gbc_xx
5808 ],
5809 body:0,
5810 complex:0,
5811 env:0,
5812 key:0,
5813 names:
5814 [ symbol,
5815 sys_called_from_apropos_doc_p,
5816 sys_f,
5817 sys_x,
5818 sys_xx_notify_gbc_xx
5819 ],
5820 opt:
5821 [ sys_called_from_apropos_doc_p
5822 ],
5823 req:[symbol],
5824 rest:0,
5825 sublists:0,
5826 whole:0
5827 }))).
5828*/
5829/*
5830:- side_effect(assert_lsp(sys_print_doc_part_2,
5831 init_args(1, f_sys_print_doc_part_2))).
5832*/
5833/*
5834 skip EOL
5835*/
5836/*
5837 skip V | F | T.
5838*/
5839/*
5840 skip V | F | T.
5841*/
5842/*
5843(defun print-doc (symbol &optional (called-from-apropos-doc-p nil)
5844 &aux (f nil) x (*notify-gbc* nil))
5845 (flet ((doc1 (doc ind) ; &aux (arglist (get-sysprop symbol 'ARGLIST))
5846 (setq f t)
5847 (format t
5848 ""(defun print-doc (symbol &optional (called-from-apropos-doc-p nil)\n &aux (f nil) x (*notify-gbc* nil))\n (flet ((doc1 (doc ind) ; &aux (arglist (get-sysprop symbol 'ARGLIST))\n (setq f t)\n (format t\n \"~&-----------------------------------------------------------------------------~%~53S~24@A~%~A\"\n symbol ind doc))\n (good-package ()\n (if (eq (symbol-package symbol) (find-package \"LISP\"))\n (find-package \"SYSTEM\")\n *package*)))\n\n ".
5849*/
5850
5851/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:17599 **********************/
5852:-lisp_compile_to_prolog(pkg_sys,[defun,'print-doc',[symbol,'&optional',['called-from-apropos-doc-p',[]],'&aux',[f,[]],x,['*notify-gbc*',[]]],[flet,[[doc1,[doc,ind],[setq,f,t],[format,t,'$STRING'("~&-----------------------------------------------------------------------------~%~53S~24@A~%~A"),symbol,ind,doc]],['good-package',[],[if,[eq,['symbol-package',symbol],['find-package','$STRING'("LISP")]],['find-package','$STRING'("SYSTEM")],'*package*']]],[cond,[['special-form-p',symbol],[doc1,[or,[documentation,symbol,[quote,'FUNCTION']],'$STRING'("")],[if,['macro-function',symbol],'$STRING'("[Special form and Macro]"),'$STRING'("[Special form]")]]],[['macro-function',symbol],[doc1,[or,[documentation,symbol,[quote,'FUNCTION']],'$STRING'("")],'$STRING'("[Macro]")]],[[fboundp,symbol],[doc1,[or,[documentation,symbol,[quote,'FUNCTION']],[if,[consp,[setq,x,['symbol-function',symbol]]],[case,[car,x],['LAMBDA',[format,[],'$STRING'("~%Args: ~S"),[cadr,x]]],['LAMBDA-BLOCK',[format,[],'$STRING'("~%Args: ~S"),[caddr,x]]],['LAMBDA-CLOSURE',[format,[],'$STRING'("~%Args: ~S"),[car,[cddddr,x]]]],['LAMBDA-BLOCK-CLOSURE',[format,[],'$STRING'("~%Args: ~S"),[cadr,[cddddr,x]]]],[t,'$STRING'("")]],'$STRING'("")]],'$STRING'("[Function]")]],[[setq,x,[documentation,symbol,[quote,'FUNCTION']]],[doc1,x,'$STRING'("[Macro or Function]")]]],[cond,[[constantp,symbol],[unless,[and,[eq,['symbol-package',symbol],['find-package','$STRING'("KEYWORD")]],[null,[documentation,symbol,[quote,'VARIABLE']]]],[doc1,[or,[documentation,symbol,[quote,'VARIABLE']],'$STRING'("")],'$STRING'("[Constant]")]]],[['sys:specialp',symbol],[doc1,[or,[documentation,symbol,[quote,'VARIABLE']],'$STRING'("")],'$STRING'("[Special variable]")]],[[or,[setq,x,[documentation,symbol,[quote,'VARIABLE']]],[boundp,symbol]],[doc1,[or,x,'$STRING'("")],'$STRING'("[Variable]")]]],[cond,[[setq,x,[documentation,symbol,[quote,'TYPE']]],[doc1,x,'$STRING'("[Type]")]],[[setq,x,['get-sysprop',symbol,[quote,'DEFTYPE-FORM']]],[let,[['*package*',['good-package']]],[doc1,[format,[],'$STRING'("~%Defined as: ~S~%See the doc of DEFTYPE."),x],'$STRING'("[Type]")]]]],[cond,[[setq,x,[documentation,symbol,[quote,'STRUCTURE']]],[doc1,x,'$STRING'("[Structure]")]],[[setq,x,['get-sysprop',symbol,[quote,'DEFSTRUCT-FORM']]],[doc1,[format,[],'$STRING'("~%Defined as: ~S~%See the doc of DEFSTRUCT."),x],'$STRING'("[Structure]")]]],[cond,[[setq,x,[documentation,symbol,[quote,'SETF']]],[doc1,x,'$STRING'("[Setf]")]],[[setq,x,['get-sysprop',symbol,[quote,'SETF-UPDATE-FN']]],[let,[['*package*',['good-package']]],[doc1,[format,[],'$STRING'("~%Defined as: ~S~%See the doc of DEFSETF."),['#BQ',[defsetf,['#COMMA',symbol],['#COMMA',['get-sysprop',symbol,[quote,'SETF-UPDATE-FN']]]]]],'$STRING'("[Setf]")]]],[[setq,x,['get-sysprop',symbol,[quote,'SETF-LAMBDA']]],[let,[['*package*',['good-package']]],[doc1,[format,[],'$STRING'("~%Defined as: ~S~%See the doc of DEFSETF."),['#BQ',[defsetf,['#COMMA',symbol],['#BQ-COMMA-ELIPSE',['get-sysprop',symbol,[quote,'SETF-LAMBDA']]]]]],'$STRING'("[Setf]")]]],[[setq,x,['get-sysprop',symbol,[quote,'SETF-METHOD']]],[let,[['*package*',['good-package']]],[doc1,[format,[],'$STRING'("~@[~%Defined as: ~S~%See the doc of DEFINE-SETF-METHOD.~]"),[if,[consp,x],[case,[car,x],['LAMBDA',['#BQ',['define-setf-method',['#BQ-COMMA-ELIPSE',[cdr,x]]]]],['LAMBDA-BLOCK',['#BQ',['define-setf-method',['#BQ-COMMA-ELIPSE',[cddr,x]]]]],['LAMBDA-CLOSURE',['#BQ',['define-setf-method',['#BQ-COMMA-ELIPSE',[cddddr,x]]]]],['LAMBDA-BLOCK-CLOSURE',['#BQ',['define-setf-method',['#BQ-COMMA-ELIPSE',[cdr,[cddddr,x]]]]]],[t,[]]],[]]],'$STRING'("[Setf]")]]]]],['print-doc-part-2',symbol,'called-f','&aux',[arglist,['get-sysprop',symbol,[quote,'ARGLIST']]],[setq,f,t],[format,t,'$STRING'("~&-----------------------------------------------------------------------------~%~53S~24@A~%~A"),symbol,ind,doc]],['good-package',[],[if,[eq,['symbol-package',symbol],['find-package','$STRING'("LISP")]],['find-package','$STRING'("SYSTEM")],'*package*']]])
5853/*
5854:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
5855 sys_print_doc,
5856 kw_function,
5857 f_sys_print_doc)).
5858*/
5859/*
5860:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
5861 sys_doc1,
5862 kw_function,
5863 f_sys_doc1)).
5864*/
5865/*
5866:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
5867 sys_good_package,
5868 kw_function,
5869 f_sys_good_package)).
5870*/
5871/*
5872% case:-[[lambda,[format,[],'$ARRAY'([*],claz_base_character,"~%Args: ~S"),[cadr,sys_x]]],[sys_lambda_block,[format,[],'$ARRAY'([*],claz_base_character,"~%Args: ~S"),[caddr,sys_x]]],[sys_lambda_closure,[format,[],'$ARRAY'([*],claz_base_character,"~%Args: ~S"),[car,[cddddr,sys_x]]]],[sys_lambda_block_closure,[format,[],'$ARRAY'([*],claz_base_character,"~%Args: ~S"),[cadr,[cddddr,sys_x]]]],[t,'$ARRAY'([*],claz_base_character,[])]].
5873*/
5874/*
5875% conds:-[[[eq,_63218,[quote,lambda]],[progn,[format,[],'$ARRAY'([*],claz_base_character,"~%Args: ~S"),[cadr,sys_x]]]],[[eq,_63218,[quote,sys_lambda_block]],[progn,[format,[],'$ARRAY'([*],claz_base_character,"~%Args: ~S"),[caddr,sys_x]]]],[[eq,_63218,[quote,sys_lambda_closure]],[progn,[format,[],'$ARRAY'([*],claz_base_character,"~%Args: ~S"),[car,[cddddr,sys_x]]]]],[[eq,_63218,[quote,sys_lambda_block_closure]],[progn,[format,[],'$ARRAY'([*],claz_base_character,"~%Args: ~S"),[cadr,[cddddr,sys_x]]]]],[t,[progn,'$ARRAY'([*],claz_base_character,[])]]].
5876*/
5877/*
5878:- side_effect(generate_function_or_macro_name(
5879 [
5880 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
5881 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
5882 ],
5883 name='GLOBAL',
5884 environ=env_1
5885 ],
5886 sys_specialp,
5887 kw_function,
5888 f_sys_specialp)).
5889*/
5890/*
5891% case:-[[lambda,['#BQ',[sys_define_setf_method,['#BQ-COMMA-ELIPSE',[cdr,sys_x]]]]],[sys_lambda_block,['#BQ',[sys_define_setf_method,['#BQ-COMMA-ELIPSE',[cddr,sys_x]]]]],[sys_lambda_closure,['#BQ',[sys_define_setf_method,['#BQ-COMMA-ELIPSE',[cddddr,sys_x]]]]],[sys_lambda_block_closure,['#BQ',[sys_define_setf_method,['#BQ-COMMA-ELIPSE',[cdr,[cddddr,sys_x]]]]]],[t,[]]].
5892*/
5893/*
5894% conds:-[[[eq,_81560,[quote,lambda]],[progn,['#BQ',[sys_define_setf_method,['#BQ-COMMA-ELIPSE',[cdr,sys_x]]]]]],[[eq,_81560,[quote,sys_lambda_block]],[progn,['#BQ',[sys_define_setf_method,['#BQ-COMMA-ELIPSE',[cddr,sys_x]]]]]],[[eq,_81560,[quote,sys_lambda_closure]],[progn,['#BQ',[sys_define_setf_method,['#BQ-COMMA-ELIPSE',[cddddr,sys_x]]]]]],[[eq,_81560,[quote,sys_lambda_block_closure]],[progn,['#BQ',[sys_define_setf_method,['#BQ-COMMA-ELIPSE',[cdr,[cddddr,sys_x]]]]]]],[t,[progn,[]]]].
5895*/
5896/*
5897:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
5898 sys_good_package,
5899 kw_function,
5900 f_sys_good_package)).
5901*/
5902wl:lambda_def(defun, sys_print_doc, f_sys_print_doc, [symbol, c38_optional, [sys_called_from_apropos_doc_p, []], c38_aux, [sys_f, []], sys_x, [sys_xx_notify_gbc_xx, []]], [[flet, [[sys_doc1, [sys_doc, sys_ind], [setq, sys_f, t], [format, t, '$ARRAY'([*], claz_base_character, "~&-----------------------------------------------------------------------------~%~53S~24@A~%~A"), symbol, sys_ind, sys_doc]], [sys_good_package, [], [if, [eq, [symbol_package, symbol], [find_package, '$ARRAY'([*], claz_base_character, "LISP")]], [find_package, '$ARRAY'([*], claz_base_character, "SYSTEM")], xx_package_xx]]], [cond, [[sys_special_form_p, symbol], [sys_doc1, [or, [documentation, symbol, [quote, function]], '$ARRAY'([*], claz_base_character, [])], [if, [macro_function, symbol], '$ARRAY'([*], claz_base_character, "[Special form and Macro]"), '$ARRAY'([*], claz_base_character, "[Special form]")]]], [[macro_function, symbol], [sys_doc1, [or, [documentation, symbol, [quote, function]], '$ARRAY'([*], claz_base_character, [])], '$ARRAY'([*], claz_base_character, "[Macro]")]], [[fboundp, symbol], [sys_doc1, [or, [documentation, symbol, [quote, function]], [if, [consp, [setq, sys_x, [symbol_function, symbol]]], [case, [car, sys_x], [lambda, [format, [], '$ARRAY'([*], claz_base_character, "~%Args: ~S"), [cadr, sys_x]]], [sys_lambda_block, [format, [], '$ARRAY'([*], claz_base_character, "~%Args: ~S"), [caddr, sys_x]]], [sys_lambda_closure, [format, [], '$ARRAY'([*], claz_base_character, "~%Args: ~S"), [car, [cddddr, sys_x]]]], [sys_lambda_block_closure, [format, [], '$ARRAY'([*], claz_base_character, "~%Args: ~S"), [cadr, [cddddr, sys_x]]]], [t, '$ARRAY'([*], claz_base_character, [])]], '$ARRAY'([*], claz_base_character, [])]], '$ARRAY'([*], claz_base_character, "[Function]")]], [[setq, sys_x, [documentation, symbol, [quote, function]]], [sys_doc1, sys_x, '$ARRAY'([*], claz_base_character, "[Macro or Function]")]]], [cond, [[constantp, symbol], [unless, [and, [eq, [symbol_package, symbol], [find_package, '$ARRAY'([*], claz_base_character, "KEYWORD")]], [null, [documentation, symbol, [quote, variable]]]], [sys_doc1, [or, [documentation, symbol, [quote, variable]], '$ARRAY'([*], claz_base_character, [])], '$ARRAY'([*], claz_base_character, "[Constant]")]]], [[sys_specialp, symbol], [sys_doc1, [or, [documentation, symbol, [quote, variable]], '$ARRAY'([*], claz_base_character, [])], '$ARRAY'([*], claz_base_character, "[Special variable]")]], [[or, [setq, sys_x, [documentation, symbol, [quote, variable]]], [boundp, symbol]], [sys_doc1, [or, sys_x, '$ARRAY'([*], claz_base_character, [])], '$ARRAY'([*], claz_base_character, "[Variable]")]]], [cond, [[setq, sys_x, [documentation, symbol, [quote, type]]], [sys_doc1, sys_x, '$ARRAY'([*], claz_base_character, "[Type]")]], [[setq, sys_x, [sys_get_sysprop, symbol, [quote, sys_deftype_form]]], [let, [[xx_package_xx, [sys_good_package]]], [sys_doc1, [format, [], '$ARRAY'([*], claz_base_character, "~%Defined as: ~S~%See the doc of DEFTYPE."), sys_x], '$ARRAY'([*], claz_base_character, "[Type]")]]]], [cond, [[setq, sys_x, [documentation, symbol, [quote, structure]]], [sys_doc1, sys_x, '$ARRAY'([*], claz_base_character, "[Structure]")]], [[setq, sys_x, [sys_get_sysprop, symbol, [quote, sys_defstruct_form]]], [sys_doc1, [format, [], '$ARRAY'([*], claz_base_character, "~%Defined as: ~S~%See the doc of DEFSTRUCT."), sys_x], '$ARRAY'([*], claz_base_character, "[Structure]")]]], [cond, [[setq, sys_x, [documentation, symbol, [quote, setf]]], [sys_doc1, sys_x, '$ARRAY'([*], claz_base_character, "[Setf]")]], [[setq, sys_x, [sys_get_sysprop, symbol, [quote, sys_setf_update_fn]]], [let, [[xx_package_xx, [sys_good_package]]], [sys_doc1, [format, [], '$ARRAY'([*], claz_base_character, "~%Defined as: ~S~%See the doc of DEFSETF."), ['#BQ', [defsetf, ['#COMMA', symbol], ['#COMMA', [sys_get_sysprop, symbol, [quote, sys_setf_update_fn]]]]]], '$ARRAY'([*], claz_base_character, "[Setf]")]]], [[setq, sys_x, [sys_get_sysprop, symbol, [quote, sys_setf_lambda]]], [let, [[xx_package_xx, [sys_good_package]]], [sys_doc1, [format, [], '$ARRAY'([*], claz_base_character, "~%Defined as: ~S~%See the doc of DEFSETF."), ['#BQ', [defsetf, ['#COMMA', symbol], ['#BQ-COMMA-ELIPSE', [sys_get_sysprop, symbol, [quote, sys_setf_lambda]]]]]], '$ARRAY'([*], claz_base_character, "[Setf]")]]], [[setq, sys_x, [sys_get_sysprop, symbol, [quote, sys_setf_method]]], [let, [[xx_package_xx, [sys_good_package]]], [sys_doc1, [format, [], '$ARRAY'([*], claz_base_character, "~@[~%Defined as: ~S~%See the doc of DEFINE-SETF-METHOD.~]"), [if, [consp, sys_x], [case, [car, sys_x], [lambda, ['#BQ', [sys_define_setf_method, ['#BQ-COMMA-ELIPSE', [cdr, sys_x]]]]], [sys_lambda_block, ['#BQ', [sys_define_setf_method, ['#BQ-COMMA-ELIPSE', [cddr, sys_x]]]]], [sys_lambda_closure, ['#BQ', [sys_define_setf_method, ['#BQ-COMMA-ELIPSE', [cddddr, sys_x]]]]], [sys_lambda_block_closure, ['#BQ', [sys_define_setf_method, ['#BQ-COMMA-ELIPSE', [cdr, [cddddr, sys_x]]]]]], [t, []]], []]], '$ARRAY'([*], claz_base_character, "[Setf]")]]]]], [sys_print_doc_part_2, symbol, sys_called_f, c38_aux, [sys_arglist, [sys_get_sysprop, symbol, [quote, sys_arglist]]], [setq, sys_f, t], [format, t, '$ARRAY'([*], claz_base_character, "~&-----------------------------------------------------------------------------~%~53S~24@A~%~A"), symbol, sys_ind, sys_doc]], [sys_good_package, [], [if, [eq, [symbol_package, symbol], [find_package, '$ARRAY'([*], claz_base_character, "LISP")]], [find_package, '$ARRAY'([*], claz_base_character, "SYSTEM")], xx_package_xx]]]).
5903wl:arglist_info(sys_print_doc, f_sys_print_doc, [symbol, c38_optional, [sys_called_from_apropos_doc_p, []], c38_aux, [sys_f, []], sys_x, [sys_xx_notify_gbc_xx, []]], arginfo{all:[symbol, sys_called_from_apropos_doc_p], allow_other_keys:0, aux:[sys_f, sys_x, sys_xx_notify_gbc_xx], body:0, complex:0, env:0, key:0, names:[symbol, sys_called_from_apropos_doc_p, sys_f, sys_x, sys_xx_notify_gbc_xx], opt:[sys_called_from_apropos_doc_p], req:[symbol], rest:0, sublists:0, whole:0}).
5904wl: init_args(1, f_sys_print_doc).
5905
5910f_sys_print_doc(Symbol_In, RestNKeys, FnResult) :-
5911 Env=[bv(symbol, Symbol_In), bv(sys_called_from_apropos_doc_p, Called_from_apropos_doc_p_In), bv(sys_f, In), bv(sys_x, X_In), bv(sys_xx_notify_gbc_xx, Xx_notify_gbc_xx_In)],
5912 opt_var(Env,
5913 sys_called_from_apropos_doc_p,
5914 Called_from_apropos_doc_p_In,
5915 true,
5916 [],
5917 1,
5918 RestNKeys),
5919 aux_var(Env, sys_f, In, true, []),
5920 aux_var(Env, sys_x, X_In, true, []),
5921 aux_var(Env, sys_xx_notify_gbc_xx, Xx_notify_gbc_xx_In, true, []),
5922 catch(( ( assert_lsp(sys_doc1,
5923 wl:lambda_def(defun, sys_doc1, f_sys_doc11, [sys_doc, sys_ind], [[setq, sys_f, t], [format, t, '$ARRAY'([*], claz_base_character, "~&-----------------------------------------------------------------------------~%~53S~24@A~%~A"), symbol, sys_ind, sys_doc]])),
5924 assert_lsp(sys_doc1,
5925 wl:arglist_info(sys_doc1, f_sys_doc11, [sys_doc, sys_ind], arginfo{all:[sys_doc, sys_ind], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_doc, sys_ind], opt:0, req:[sys_doc, sys_ind], rest:0, sublists:0, whole:0})),
5926 assert_lsp(sys_doc1, wl:init_args(2, f_sys_doc11)),
5927 assert_lsp(sys_doc1,
5928 (f_sys_doc11(Doc_In, Ind_In, RestNKeys12, FnResult11):-AEnv=[bv(sys_doc, Doc_In), bv(sys_ind, Ind_In)], catch(((set_var(AEnv, sys_f, t), get_var(AEnv, symbol, Symbol_Get), get_var(AEnv, sys_doc, Doc_Get), get_var(AEnv, sys_ind, Ind_Get), f_format(t, '$ARRAY'([*], claz_base_character, "~&-----------------------------------------------------------------------------~%~53S~24@A~%~A"), [Symbol_Get, Ind_Get, Doc_Get], Format_Ret)), Format_Ret=FnResult11), block_exit(sys_doc1, FnResult11), true))),
5929 assert_lsp(sys_good_package,
5930 wl:lambda_def(defun, sys_good_package, f_sys_good_package1, [], [[if, [eq, [symbol_package, symbol], [find_package, '$ARRAY'([*], claz_base_character, "LISP")]], [find_package, '$ARRAY'([*], claz_base_character, "SYSTEM")], xx_package_xx]])),
5931 assert_lsp(sys_good_package,
5932 wl:arglist_info(sys_good_package, f_sys_good_package1, [], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[], opt:0, req:0, rest:0, sublists:0, whole:0})),
5933 assert_lsp(sys_good_package,
5934 wl:init_args(0, f_sys_good_package1)),
5935 assert_lsp(sys_good_package,
5936 (f_sys_good_package1(RestNKeys22, FnResult21):-GEnv=[], catch(((get_var(GEnv, symbol, Symbol_Get24), f_symbol_package(Symbol_Get24, PredArg1Result), f_find_package('$ARRAY'([*], claz_base_character, "LISP"), PredArg2Result), (is_eq(PredArg1Result, PredArg2Result)->f_find_package('$ARRAY'([*], claz_base_character, "SYSTEM"), TrueResult), _20648=TrueResult;get_var(GEnv, xx_package_xx, Xx_package_xx_Get), _20648=Xx_package_xx_Get)), _20648=FnResult21), block_exit(sys_good_package, FnResult21), true))),
5937 get_var(
5938 [
5939 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
5940 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
5941 ]
5942 | Env
5943 ],
5944 symbol,
5945 Symbol_Get34),
5946 f_sys_special_form_p(Symbol_Get34, IFTEST32),
5947 ( IFTEST32\==[]
5948 -> ( get_var(
5949 [
5950 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
5951 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
5952 ]
5953 | Env
5954 ],
5955 symbol,
5956 Symbol_Get35),
5957 f_documentation(Symbol_Get35, function, FORM1_Res),
5958 FORM1_Res\==[],
5959 Doc11_Param=FORM1_Res
5960 -> true
5961 ; Doc11_Param='$ARRAY'([*], claz_base_character, [])
5962 ),
5963 get_var(
5964 [
5965 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
5966 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
5967 ]
5968 | Env
5969 ],
5970 symbol,
5971 Symbol_Get39),
5972 f_macro_function(Symbol_Get39, [], IFTEST37),
5973 ( IFTEST37\==[]
5974 -> _20932='$ARRAY'([*], claz_base_character, "[Special form and Macro]")
5975 ; _20932='$ARRAY'([*], claz_base_character, "[Special form]")
5976 ),
5977 f_sys_doc11(Doc11_Param, _20932, TrueResult88),
5978 _20814=TrueResult88
5979 ; get_var(
5980 [
5981 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
5982 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
5983 ]
5984 | Env
5985 ],
5986 symbol,
5987 Symbol_Get42),
5988 f_macro_function(Symbol_Get42, [], IFTEST40),
5989 ( IFTEST40\==[]
5990 -> ( get_var(
5991 [
5992 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
5993 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
5994 ]
5995 | Env
5996 ],
5997 symbol,
5998 Symbol_Get43),
5999 f_documentation(Symbol_Get43,
6000 function,
6001 FORM1_Res44),
6002 FORM1_Res44\==[],
6003 Doc11_Param217=FORM1_Res44
6004 -> true
6005 ; Doc11_Param217='$ARRAY'([*], claz_base_character, [])
6006 ),
6007 f_sys_doc11(Doc11_Param217,
6008 '$ARRAY'([*],
6009 claz_base_character,
6010 "[Macro]"),
6011 TrueResult86),
6012 ElseResult89=TrueResult86
6013 ; get_var(
6014 [
6015 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6016 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6017 ]
6018 | Env
6019 ],
6020 symbol,
6021 Symbol_Get46),
6022 ( symbol:is_fboundp(Symbol_Get46)
6023 -> ( get_var(
6024 [
6025 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6026 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6027 ]
6028 | Env
6029 ],
6030 symbol,
6031 Symbol_Get49),
6032 f_documentation(Symbol_Get49,
6033 function,
6034 FORM1_Res77),
6035 FORM1_Res77\==[],
6036 Doc11_Param220=FORM1_Res77
6037 -> true
6038 ; get_var(
6039 [
6040 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6041 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6042 ]
6043 | Env
6044 ],
6045 symbol,
6046 Symbol_Get51),
6047 f_symbol_function(Symbol_Get51,
6048 PredArgResult53),
6049 set_var(
6050 [
6051 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6052 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6053 ]
6054 | Env
6055 ],
6056 sys_x,
6057 PredArgResult53),
6058 ( c0nz:is_consp(PredArgResult53)
6059 -> get_var(
6060 [
6061 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6062 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6063 ]
6064 | Env
6065 ],
6066 sys_x,
6067 X_Get),
6068 f_car(X_Get, Key),
6069 ( is_eq(Key, lambda)
6070 -> get_var(
6071 [
6072 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6073 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6074 ]
6075 | Env
6076 ],
6077 sys_x,
6078 X_Get59),
6079 f_cadr(X_Get59, Cadr_Ret),
6080 f_format([],
6081 '$ARRAY'([*],
6082 claz_base_character,
6083 "~%Args: ~S"),
6084 [Cadr_Ret],
6085 TrueResult74),
6086 TrueResult76=TrueResult74
6087 ; ( is_eq(Key, sys_lambda_block)
6088 -> get_var(
6089 [
6090 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6091 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6092 ]
6093 | Env
6094 ],
6095 sys_x,
6096 X_Get62),
6097 f_caddr(X_Get62, Caddr_Ret),
6098 f_format([],
6099 '$ARRAY'([*],
6100 claz_base_character,
6101 "~%Args: ~S"),
6102 [Caddr_Ret],
6103 TrueResult72),
6104 ElseResult75=TrueResult72
6105 ; ( is_eq(Key,
6106 sys_lambda_closure)
6107 -> get_var(
6108 [
6109 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6110 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6111 ]
6112 | Env
6113 ],
6114 sys_x,
6115 X_Get65),
6116 f_cddddr(X_Get65, Car_Param),
6117 f_car(Car_Param, Car_Ret),
6118 f_format([],
6119 '$ARRAY'([*],
6120 claz_base_character,
6121 "~%Args: ~S"),
6122 [Car_Ret],
6123 TrueResult70),
6124 ElseResult73=TrueResult70
6125 ; ( is_eq(Key,
6126 sys_lambda_block_closure)
6127 -> get_var(
6128 [
6129 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6130 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6131 ]
6132 | Env
6133 ],
6134 sys_x,
6135 X_Get68),
6136 f_cddddr(X_Get68,
6137 Cadr_Param),
6138 f_cadr(Cadr_Param,
6139 Cadr_Ret239),
6140 f_format([],
6141 '$ARRAY'([*],
6142 claz_base_character,
6143 "~%Args: ~S"),
6144 [Cadr_Ret239],
6145 TrueResult69),
6146 ElseResult71=TrueResult69
6147 ; ElseResult71='$ARRAY'([*], claz_base_character, [])
6148 ),
6149 ElseResult73=ElseResult71
6150 ),
6151 ElseResult75=ElseResult73
6152 ),
6153 TrueResult76=ElseResult75
6154 ),
6155 _21256=TrueResult76
6156 ; _21256='$ARRAY'([*], claz_base_character, [])
6157 ),
6158 Doc11_Param220=_21256
6159 ),
6160 f_sys_doc11(Doc11_Param220,
6161 '$ARRAY'([*],
6162 claz_base_character,
6163 "[Function]"),
6164 TrueResult84),
6165 ElseResult87=TrueResult84
6166 ; get_var(
6167 [
6168 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6169 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6170 ]
6171 | Env
6172 ],
6173 symbol,
6174 Symbol_Get80),
6175 f_documentation(Symbol_Get80, function, IFTEST78),
6176 set_var(
6177 [
6178 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6179 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6180 ]
6181 | Env
6182 ],
6183 sys_x,
6184 IFTEST78),
6185 ( IFTEST78\==[]
6186 -> get_var(
6187 [
6188 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6189 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6190 ]
6191 | Env
6192 ],
6193 sys_x,
6194 X_Get81),
6195 f_sys_doc11(X_Get81,
6196 '$ARRAY'([*],
6197 claz_base_character,
6198 "[Macro or Function]"),
6199 TrueResult82),
6200 ElseResult85=TrueResult82
6201 ; ElseResult83=[],
6202 ElseResult85=ElseResult83
6203 ),
6204 ElseResult87=ElseResult85
6205 ),
6206 ElseResult89=ElseResult87
6207 ),
6208 _20814=ElseResult89
6209 ),
6210 get_var(
6211 [
6212 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6213 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6214 ]
6215 | Env
6216 ],
6217 symbol,
6218 Symbol_Get91),
6219 ( symbol:is_constantp(Symbol_Get91)
6220 -> get_var(
6221 [
6222 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6223 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6224 ]
6225 | Env
6226 ],
6227 symbol,
6228 Symbol_Get97),
6229 f_symbol_package(Symbol_Get97, PredArg1Result99),
6230 f_find_package('$ARRAY'([*],
6231 claz_base_character,
6232 "KEYWORD"),
6233 PredArg2Result100),
6234 ( is_eq(PredArg1Result99, PredArg2Result100)
6235 -> get_var(
6236 [
6237 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6238 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6239 ]
6240 | Env
6241 ],
6242 symbol,
6243 Symbol_Get101),
6244 f_documentation(Symbol_Get101, variable, Variable),
6245 f_null(Variable, TrueResult102),
6246 IFTEST94=TrueResult102
6247 ; IFTEST94=[]
6248 ),
6249 ( IFTEST94\==[]
6250 -> TrueResult122=[]
6251 ; ( get_var(
6252 [
6253 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6254 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6255 ]
6256 | Env
6257 ],
6258 symbol,
6259 Symbol_Get103),
6260 f_documentation(Symbol_Get103,
6261 variable,
6262 FORM1_Res104),
6263 FORM1_Res104\==[],
6264 Doc11_Param221=FORM1_Res104
6265 -> true
6266 ; Doc11_Param221='$ARRAY'([*], claz_base_character, [])
6267 ),
6268 f_sys_doc11(Doc11_Param221,
6269 '$ARRAY'([*],
6270 claz_base_character,
6271 "[Constant]"),
6272 ElseResult105),
6273 TrueResult122=ElseResult105
6274 ),
6275 _22278=TrueResult122
6276 ; get_var(
6277 [
6278 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6279 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6280 ]
6281 | Env
6282 ],
6283 symbol,
6284 Symbol_Get108),
6285 f_sys_specialp(Symbol_Get108, IFTEST106),
6286 ( IFTEST106\==[]
6287 -> ( get_var(
6288 [
6289 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6290 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6291 ]
6292 | Env
6293 ],
6294 symbol,
6295 Symbol_Get109),
6296 f_documentation(Symbol_Get109,
6297 variable,
6298 FORM1_Res110),
6299 FORM1_Res110\==[],
6300 Doc11_Param222=FORM1_Res110
6301 -> true
6302 ; Doc11_Param222='$ARRAY'([*], claz_base_character, [])
6303 ),
6304 f_sys_doc11(Doc11_Param222,
6305 '$ARRAY'([*],
6306 claz_base_character,
6307 "[Special variable]"),
6308 TrueResult120),
6309 ElseResult123=TrueResult120
6310 ; ( get_var(
6311 [
6312 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6313 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6314 ]
6315 | Env
6316 ],
6317 symbol,
6318 Symbol_Get113),
6319 f_documentation(Symbol_Get113,
6320 variable,
6321 FORM1_Res115),
6322 set_var(
6323 [
6324 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6325 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6326 ]
6327 | Env
6328 ],
6329 sys_x,
6330 FORM1_Res115),
6331 FORM1_Res115\==[],
6332 IFTEST111=FORM1_Res115
6333 -> true
6334 ; get_var(
6335 [
6336 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6337 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6338 ]
6339 | Env
6340 ],
6341 symbol,
6342 Symbol_Get114),
6343 f_boundp(Symbol_Get114, Boundp_Ret),
6344 IFTEST111=Boundp_Ret
6345 ),
6346 ( IFTEST111\==[]
6347 -> ( get_var(
6348 [
6349 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6350 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6351 ]
6352 | Env
6353 ],
6354 sys_x,
6355 X_Get116),
6356 X_Get116\==[],
6357 Doc11_Param223=X_Get116
6358 -> true
6359 ; Doc11_Param223='$ARRAY'([*], claz_base_character, [])
6360 ),
6361 f_sys_doc11(Doc11_Param223,
6362 '$ARRAY'([*],
6363 claz_base_character,
6364 "[Variable]"),
6365 TrueResult118),
6366 ElseResult121=TrueResult118
6367 ; ElseResult119=[],
6368 ElseResult121=ElseResult119
6369 ),
6370 ElseResult123=ElseResult121
6371 ),
6372 _22278=ElseResult123
6373 ),
6374 get_var(
6375 [
6376 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6377 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6378 ]
6379 | Env
6380 ],
6381 symbol,
6382 Symbol_Get126),
6383 f_documentation(Symbol_Get126, type, IFTEST124),
6384 set_var(
6385 [
6386 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6387 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6388 ]
6389 | Env
6390 ],
6391 sys_x,
6392 IFTEST124),
6393 ( IFTEST124\==[]
6394 -> get_var(
6395 [
6396 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6397 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6398 ]
6399 | Env
6400 ],
6401 sys_x,
6402 X_Get127),
6403 f_sys_doc11(X_Get127,
6404 '$ARRAY'([*], claz_base_character, "[Type]"),
6405 TrueResult134),
6406 _23144=TrueResult134
6407 ; get_var(
6408 [
6409 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6410 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6411 ]
6412 | Env
6413 ],
6414 symbol,
6415 Symbol_Get130),
6416 f_sys_get_sysprop(Symbol_Get130,
6417 sys_deftype_form,
6418 [],
6419 IFTEST128),
6420 set_var(
6421 [
6422 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6423 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6424 ]
6425 | Env
6426 ],
6427 sys_x,
6428 IFTEST128),
6429 ( IFTEST128\==[]
6430 -> f_sys_good_package1(KeysNRest),
6431 locally_set(xx_package_xx,
6432 KeysNRest,
6433 (get_var([[fbound(sys_doc1, kw_function)=function(f_sys_doc11), fbound(sys_good_package, kw_function)=function(f_sys_good_package1)]|Env], sys_x, X_Get131), f_format([], '$ARRAY'([*], claz_base_character, "~%Defined as: ~S~%See the doc of DEFTYPE."), [X_Get131], Doc11_Param224), f_sys_doc11(Doc11_Param224, '$ARRAY'([*], claz_base_character, "[Type]"), TrueResult132))),
6434 ElseResult135=TrueResult132
6435 ; ElseResult133=[],
6436 ElseResult135=ElseResult133
6437 ),
6438 _23144=ElseResult135
6439 ),
6440 get_var(
6441 [
6442 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6443 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6444 ]
6445 | Env
6446 ],
6447 symbol,
6448 Symbol_Get138),
6449 f_documentation(Symbol_Get138, structure, IFTEST136),
6450 set_var(
6451 [
6452 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6453 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6454 ]
6455 | Env
6456 ],
6457 sys_x,
6458 IFTEST136),
6459 ( IFTEST136\==[]
6460 -> get_var(
6461 [
6462 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6463 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6464 ]
6465 | Env
6466 ],
6467 sys_x,
6468 X_Get139),
6469 f_sys_doc11(X_Get139,
6470 '$ARRAY'([*],
6471 claz_base_character,
6472 "[Structure]"),
6473 TrueResult146),
6474 _23458=TrueResult146
6475 ; get_var(
6476 [
6477 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6478 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6479 ]
6480 | Env
6481 ],
6482 symbol,
6483 Symbol_Get142),
6484 f_sys_get_sysprop(Symbol_Get142,
6485 sys_defstruct_form,
6486 [],
6487 IFTEST140),
6488 set_var(
6489 [
6490 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6491 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6492 ]
6493 | Env
6494 ],
6495 sys_x,
6496 IFTEST140),
6497 ( IFTEST140\==[]
6498 -> get_var(
6499 [
6500 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6501 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6502 ]
6503 | Env
6504 ],
6505 sys_x,
6506 X_Get143),
6507 f_format([],
6508 '$ARRAY'([*],
6509 claz_base_character,
6510 "~%Defined as: ~S~%See the doc of DEFSTRUCT."),
6511 [X_Get143],
6512 Doc11_Param225),
6513 f_sys_doc11(Doc11_Param225,
6514 '$ARRAY'([*],
6515 claz_base_character,
6516 "[Structure]"),
6517 TrueResult144),
6518 ElseResult147=TrueResult144
6519 ; ElseResult145=[],
6520 ElseResult147=ElseResult145
6521 ),
6522 _23458=ElseResult147
6523 ),
6524 get_var(
6525 [
6526 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6527 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6528 ]
6529 | Env
6530 ],
6531 symbol,
6532 Symbol_Get150),
6533 f_documentation(Symbol_Get150, setf, IFTEST148),
6534 set_var(
6535 [
6536 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6537 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6538 ]
6539 | Env
6540 ],
6541 sys_x,
6542 IFTEST148),
6543 ( IFTEST148\==[]
6544 -> get_var(
6545 [
6546 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6547 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6548 ]
6549 | Env
6550 ],
6551 sys_x,
6552 X_Get151),
6553 f_sys_doc11(X_Get151,
6554 '$ARRAY'([*], claz_base_character, "[Setf]"),
6555 TrueResult194),
6556 _20386=TrueResult194
6557 ; get_var(
6558 [
6559 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6560 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6561 ]
6562 | Env
6563 ],
6564 symbol,
6565 Symbol_Get154),
6566 f_sys_get_sysprop(Symbol_Get154,
6567 sys_setf_update_fn,
6568 [],
6569 IFTEST152),
6570 set_var(
6571 [
6572 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6573 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6574 ]
6575 | Env
6576 ],
6577 sys_x,
6578 IFTEST152),
6579 ( IFTEST152\==[]
6580 -> f_sys_good_package1(KeysNRest232),
6581 locally_set(xx_package_xx,
6582 KeysNRest232,
6583 (get_var([[fbound(sys_doc1, kw_function)=function(f_sys_doc11), fbound(sys_good_package, kw_function)=function(f_sys_good_package1)]|Env], symbol, Symbol_Get155), f_sys_get_sysprop(Symbol_Get155, sys_setf_update_fn, [], Get_sysprop_Ret), f_format([], '$ARRAY'([*], claz_base_character, "~%Defined as: ~S~%See the doc of DEFSETF."), [[defsetf, Symbol_Get155, Get_sysprop_Ret]], Doc11_Param226), f_sys_doc11(Doc11_Param226, '$ARRAY'([*], claz_base_character, "[Setf]"), TrueResult192))),
6584 ElseResult195=TrueResult192
6585 ; get_var(
6586 [
6587 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6588 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6589 ]
6590 | Env
6591 ],
6592 symbol,
6593 Symbol_Get159),
6594 f_sys_get_sysprop(Symbol_Get159,
6595 sys_setf_lambda,
6596 [],
6597 IFTEST157),
6598 set_var(
6599 [
6600 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6601 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6602 ]
6603 | Env
6604 ],
6605 sys_x,
6606 IFTEST157),
6607 ( IFTEST157\==[]
6608 -> f_sys_good_package1(KeysNRest233),
6609 locally_set(xx_package_xx,
6610 KeysNRest233,
6611 (get_var([[fbound(sys_doc1, kw_function)=function(f_sys_doc11), fbound(sys_good_package, kw_function)=function(f_sys_good_package1)]|Env], symbol, Symbol_Get160), f_sys_get_sysprop(Symbol_Get160, sys_setf_lambda, [], Get_sysprop_Ret242), f_format([], '$ARRAY'([*], claz_base_character, "~%Defined as: ~S~%See the doc of DEFSETF."), [[defsetf, Symbol_Get160|Get_sysprop_Ret242]], Doc11_Param227), f_sys_doc11(Doc11_Param227, '$ARRAY'([*], claz_base_character, "[Setf]"), TrueResult190))),
6612 ElseResult193=TrueResult190
6613 ; get_var(
6614 [
6615 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6616 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6617 ]
6618 | Env
6619 ],
6620 symbol,
6621 Symbol_Get164),
6622 f_sys_get_sysprop(Symbol_Get164,
6623 sys_setf_method,
6624 [],
6625 IFTEST162),
6626 set_var(
6627 [
6628 [ fbound(sys_doc1, kw_function)=function(f_sys_doc11),
6629 fbound(sys_good_package, kw_function)=function(f_sys_good_package1)
6630 ]
6631 | Env
6632 ],
6633 sys_x,
6634 IFTEST162),
6635 ( IFTEST162\==[]
6636 -> f_sys_good_package1(KeysNRest234),
6637 locally_set(xx_package_xx,
6638 KeysNRest234,
6639 (get_var([[fbound(sys_doc1, kw_function)=function(f_sys_doc11), fbound(sys_good_package, kw_function)=function(f_sys_good_package1)]|Env], sys_x, X_Get166), (c0nz:is_consp(X_Get166)->get_var([[fbound(sys_doc1, kw_function)=function(f_sys_doc11), fbound(sys_good_package, kw_function)=function(f_sys_good_package1)]|Env], sys_x, X_Get169), f_car(X_Get169, Key170), (is_eq(Key170, lambda)->get_var([[fbound(sys_doc1, kw_function)=function(f_sys_doc11), fbound(sys_good_package, kw_function)=function(f_sys_good_package1)]|Env], sys_x, X_Get174), f_cdr(X_Get174, Cdr_Ret), TrueResult187=[sys_define_setf_method|Cdr_Ret];(is_eq(Key170, sys_lambda_block)->get_var([[fbound(sys_doc1, kw_function)=function(f_sys_doc11), fbound(sys_good_package, kw_function)=function(f_sys_good_package1)]|Env], sys_x, X_Get177), f_cddr(X_Get177, Cddr_Ret), ElseResult186=[sys_define_setf_method|Cddr_Ret];(is_eq(Key170, sys_lambda_closure)->get_var([[fbound(sys_doc1, kw_function)=function(f_sys_doc11), fbound(sys_good_package, kw_function)=function(f_sys_good_package1)]|Env], sys_x, X_Get180), f_cddddr(X_Get180, Cddddr_Ret), ElseResult185=[sys_define_setf_method|Cddddr_Ret];(is_eq(Key170, sys_lambda_block_closure)->get_var([[fbound(sys_doc1, kw_function)=function(f_sys_doc11), fbound(sys_good_package, kw_function)=function(f_sys_good_package1)]|Env], sys_x, X_Get183), f_cddddr(X_Get183, Cdr_Param), f_cdr(Cdr_Param, Cdr_Ret246), ElseResult184=[sys_define_setf_method|Cdr_Ret246];ElseResult184=[]), ElseResult185=ElseResult184), ElseResult186=ElseResult185), TrueResult187=ElseResult186), CAR=TrueResult187;CAR=[]), f_format([], '$ARRAY'([*], claz_base_character, "~@[~%Defined as: ~S~%See the doc of DEFINE-SETF-METHOD.~]"), [CAR], Doc11_Param229), f_sys_doc11(Doc11_Param229, '$ARRAY'([*], claz_base_character, "[Setf]"), TrueResult188))),
6640 ElseResult191=TrueResult188
6641 ; ElseResult189=[],
6642 ElseResult191=ElseResult189
6643 ),
6644 ElseResult193=ElseResult191
6645 ),
6646 ElseResult195=ElseResult193
6647 ),
6648 _20386=ElseResult195
6649 ),
6650 ( get_var(Env, c38_aux, C38_aux_Get),
6651 get_var(Env, symbol, Symbol_Get196)
6652 ),
6653 ( get_var(Env, symbol, Symbol_Get199),
6654 get_var(Env, sys_called_f, Called_f_Get)
6655 ),
6656 f_sys_get_sysprop(Symbol_Get199,
6657 sys_arglist,
6658 [],
6659 Arglist_Param),
6660 f_sys_arglist(Arglist_Param, Arglist_Ret),
6661 set_var(Env, sys_f, t),
6662 get_var(Env, symbol, Symbol_Get201),
6663 get_var(Env, sys_doc, Doc_Get203),
6664 get_var(Env, sys_ind, Ind_Get202),
6665 f_format(t,
6666 '$ARRAY'([*],
6667 claz_base_character,
6668 "~&-----------------------------------------------------------------------------~%~53S~24@A~%~A"),
6669 [Symbol_Get201, Ind_Get202, Doc_Get203],
6670 Format_Ret249),
6671 f_sys_print_doc_part_2(Symbol_Get196,
6672
6673 [ Called_f_Get,
6674 C38_aux_Get,
6675 Arglist_Ret,
6676 t,
6677 Format_Ret249
6678 ],
6679 Part_2_Ret),
6680 get_var(Env, symbol, Symbol_Get205),
6681 f_symbol_package(Symbol_Get205, PredArg1Result207),
6682 f_find_package('$ARRAY'([*], claz_base_character, "LISP"),
6683 PredArg2Result208),
6684 ( is_eq(PredArg1Result207, PredArg2Result208)
6685 -> f_find_package('$ARRAY'([*],
6686 claz_base_character,
6687 "SYSTEM"),
6688 TrueResult210),
6689 _25198=TrueResult210
6690 ; get_var(Env, xx_package_xx, Xx_package_xx_Get209),
6691 _25198=Xx_package_xx_Get209
6692 ),
6693 f_sys_good_package([], _25198, Good_package_Ret)
6694 ),
6695 Good_package_Ret=FnResult
6696 ),
6697 block_exit(sys_print_doc, FnResult),
6698 true).
6699:- set_opv(sys_print_doc, symbol_function, f_sys_print_doc),
6700 DefunResult=sys_print_doc. 6701/*
6702:- side_effect(assert_lsp(sys_print_doc,
6703 lambda_def(defun,
6704 sys_print_doc,
6705 f_sys_print_doc,
6706
6707 [ symbol,
6708 c38_optional,
6709 [sys_called_from_apropos_doc_p, []],
6710 c38_aux,
6711 [sys_f, []],
6712 sys_x,
6713 [sys_xx_notify_gbc_xx, []]
6714 ],
6715
6716 [
6717 [ flet,
6718
6719 [
6720 [ sys_doc1,
6721 [sys_doc, sys_ind],
6722 [setq, sys_f, t],
6723
6724 [ format,
6725 t,
6726 '$ARRAY'([*],
6727 claz_base_character,
6728 "~&-----------------------------------------------------------------------------~%~53S~24@A~%~A"),
6729 symbol,
6730 sys_ind,
6731 sys_doc
6732 ]
6733 ],
6734
6735 [ sys_good_package,
6736 [],
6737
6738 [ if,
6739
6740 [ eq,
6741 [symbol_package, symbol],
6742
6743 [ find_package,
6744 '$ARRAY'([*],
6745 claz_base_character,
6746 "LISP")
6747 ]
6748 ],
6749
6750 [ find_package,
6751 '$ARRAY'([*],
6752 claz_base_character,
6753 "SYSTEM")
6754 ],
6755 xx_package_xx
6756 ]
6757 ]
6758 ],
6759
6760 [ cond,
6761
6762 [ [sys_special_form_p, symbol],
6763
6764 [ sys_doc1,
6765
6766 [ or,
6767
6768 [ documentation,
6769 symbol,
6770 [quote, function]
6771 ],
6772 '$ARRAY'([*],
6773 claz_base_character,
6774 [])
6775 ],
6776
6777 [ if,
6778 [macro_function, symbol],
6779 '$ARRAY'([*],
6780 claz_base_character,
6781 "[Special form and Macro]"),
6782 '$ARRAY'([*],
6783 claz_base_character,
6784 "[Special form]")
6785 ]
6786 ]
6787 ],
6788
6789 [ [macro_function, symbol],
6790
6791 [ sys_doc1,
6792
6793 [ or,
6794
6795 [ documentation,
6796 symbol,
6797 [quote, function]
6798 ],
6799 '$ARRAY'([*],
6800 claz_base_character,
6801 [])
6802 ],
6803 '$ARRAY'([*],
6804 claz_base_character,
6805 "[Macro]")
6806 ]
6807 ],
6808
6809 [ [fboundp, symbol],
6810
6811 [ sys_doc1,
6812
6813 [ or,
6814
6815 [ documentation,
6816 symbol,
6817 [quote, function]
6818 ],
6819
6820 [ if,
6821
6822 [ consp,
6823
6824 [ setq,
6825 sys_x,
6826
6827 [ symbol_function,
6828 symbol
6829 ]
6830 ]
6831 ],
6832
6833 [ case,
6834 [car, sys_x],
6835
6836 [ lambda,
6837
6838 [ format,
6839 [],
6840 '$ARRAY'([*],
6841 claz_base_character,
6842 "~%Args: ~S"),
6843 [cadr, sys_x]
6844 ]
6845 ],
6846
6847 [ sys_lambda_block,
6848
6849 [ format,
6850 [],
6851 '$ARRAY'([*],
6852 claz_base_character,
6853 "~%Args: ~S"),
6854 [caddr, sys_x]
6855 ]
6856 ],
6857
6858 [ sys_lambda_closure,
6859
6860 [ format,
6861 [],
6862 '$ARRAY'([*],
6863 claz_base_character,
6864 "~%Args: ~S"),
6865 [car, [cddddr, sys_x]]
6866 ]
6867 ],
6868
6869 [ sys_lambda_block_closure,
6870
6871 [ format,
6872 [],
6873 '$ARRAY'([*],
6874 claz_base_character,
6875 "~%Args: ~S"),
6876 [cadr, [cddddr, sys_x]]
6877 ]
6878 ],
6879
6880 [ t,
6881 '$ARRAY'([*],
6882 claz_base_character,
6883 [])
6884 ]
6885 ],
6886 '$ARRAY'([*],
6887 claz_base_character,
6888 [])
6889 ]
6890 ],
6891 '$ARRAY'([*],
6892 claz_base_character,
6893 "[Function]")
6894 ]
6895 ],
6896
6897 [
6898 [ setq,
6899 sys_x,
6900
6901 [ documentation,
6902 symbol,
6903 [quote, function]
6904 ]
6905 ],
6906
6907 [ sys_doc1,
6908 sys_x,
6909 '$ARRAY'([*],
6910 claz_base_character,
6911 "[Macro or Function]")
6912 ]
6913 ]
6914 ],
6915
6916 [ cond,
6917
6918 [ [constantp, symbol],
6919
6920 [ unless,
6921
6922 [ and,
6923
6924 [ eq,
6925 [symbol_package, symbol],
6926
6927 [ find_package,
6928 '$ARRAY'([*],
6929 claz_base_character,
6930 "KEYWORD")
6931 ]
6932 ],
6933
6934 [ null,
6935
6936 [ documentation,
6937 symbol,
6938 [quote, variable]
6939 ]
6940 ]
6941 ],
6942
6943 [ sys_doc1,
6944
6945 [ or,
6946
6947 [ documentation,
6948 symbol,
6949 [quote, variable]
6950 ],
6951 '$ARRAY'([*],
6952 claz_base_character,
6953 [])
6954 ],
6955 '$ARRAY'([*],
6956 claz_base_character,
6957 "[Constant]")
6958 ]
6959 ]
6960 ],
6961
6962 [ [sys_specialp, symbol],
6963
6964 [ sys_doc1,
6965
6966 [ or,
6967
6968 [ documentation,
6969 symbol,
6970 [quote, variable]
6971 ],
6972 '$ARRAY'([*],
6973 claz_base_character,
6974 [])
6975 ],
6976 '$ARRAY'([*],
6977 claz_base_character,
6978 "[Special variable]")
6979 ]
6980 ],
6981
6982 [
6983 [ or,
6984
6985 [ setq,
6986 sys_x,
6987
6988 [ documentation,
6989 symbol,
6990 [quote, variable]
6991 ]
6992 ],
6993 [boundp, symbol]
6994 ],
6995
6996 [ sys_doc1,
6997
6998 [ or,
6999 sys_x,
7000 '$ARRAY'([*],
7001 claz_base_character,
7002 [])
7003 ],
7004 '$ARRAY'([*],
7005 claz_base_character,
7006 "[Variable]")
7007 ]
7008 ]
7009 ],
7010
7011 [ cond,
7012
7013 [
7014 [ setq,
7015 sys_x,
7016
7017 [ documentation,
7018 symbol,
7019 [quote, type]
7020 ]
7021 ],
7022
7023 [ sys_doc1,
7024 sys_x,
7025 '$ARRAY'([*],
7026 claz_base_character,
7027 "[Type]")
7028 ]
7029 ],
7030
7031 [
7032 [ setq,
7033 sys_x,
7034
7035 [ sys_get_sysprop,
7036 symbol,
7037 [quote, sys_deftype_form]
7038 ]
7039 ],
7040
7041 [ let,
7042
7043 [
7044 [ xx_package_xx,
7045 [sys_good_package]
7046 ]
7047 ],
7048
7049 [ sys_doc1,
7050
7051 [ format,
7052 [],
7053 '$ARRAY'([*],
7054 claz_base_character,
7055 "~%Defined as: ~S~%See the doc of DEFTYPE."),
7056 sys_x
7057 ],
7058 '$ARRAY'([*],
7059 claz_base_character,
7060 "[Type]")
7061 ]
7062 ]
7063 ]
7064 ],
7065
7066 [ cond,
7067
7068 [
7069 [ setq,
7070 sys_x,
7071
7072 [ documentation,
7073 symbol,
7074 [quote, structure]
7075 ]
7076 ],
7077
7078 [ sys_doc1,
7079 sys_x,
7080 '$ARRAY'([*],
7081 claz_base_character,
7082 "[Structure]")
7083 ]
7084 ],
7085
7086 [
7087 [ setq,
7088 sys_x,
7089
7090 [ sys_get_sysprop,
7091 symbol,
7092 [quote, sys_defstruct_form]
7093 ]
7094 ],
7095
7096 [ sys_doc1,
7097
7098 [ format,
7099 [],
7100 '$ARRAY'([*],
7101 claz_base_character,
7102 "~%Defined as: ~S~%See the doc of DEFSTRUCT."),
7103 sys_x
7104 ],
7105 '$ARRAY'([*],
7106 claz_base_character,
7107 "[Structure]")
7108 ]
7109 ]
7110 ],
7111
7112 [ cond,
7113
7114 [
7115 [ setq,
7116 sys_x,
7117
7118 [ documentation,
7119 symbol,
7120 [quote, setf]
7121 ]
7122 ],
7123
7124 [ sys_doc1,
7125 sys_x,
7126 '$ARRAY'([*],
7127 claz_base_character,
7128 "[Setf]")
7129 ]
7130 ],
7131
7132 [
7133 [ setq,
7134 sys_x,
7135
7136 [ sys_get_sysprop,
7137 symbol,
7138 [quote, sys_setf_update_fn]
7139 ]
7140 ],
7141
7142 [ let,
7143
7144 [
7145 [ xx_package_xx,
7146 [sys_good_package]
7147 ]
7148 ],
7149
7150 [ sys_doc1,
7151
7152 [ format,
7153 [],
7154 '$ARRAY'([*],
7155 claz_base_character,
7156 "~%Defined as: ~S~%See the doc of DEFSETF."),
7157
7158 [ '#BQ',
7159
7160 [ defsetf,
7161 ['#COMMA', symbol],
7162
7163 [ '#COMMA',
7164
7165 [ sys_get_sysprop,
7166 symbol,
7167
7168 [ quote,
7169 sys_setf_update_fn
7170 ]
7171 ]
7172 ]
7173 ]
7174 ]
7175 ],
7176 '$ARRAY'([*],
7177 claz_base_character,
7178 "[Setf]")
7179 ]
7180 ]
7181 ],
7182
7183 [
7184 [ setq,
7185 sys_x,
7186
7187 [ sys_get_sysprop,
7188 symbol,
7189 [quote, sys_setf_lambda]
7190 ]
7191 ],
7192
7193 [ let,
7194
7195 [
7196 [ xx_package_xx,
7197 [sys_good_package]
7198 ]
7199 ],
7200
7201 [ sys_doc1,
7202
7203 [ format,
7204 [],
7205 '$ARRAY'([*],
7206 claz_base_character,
7207 "~%Defined as: ~S~%See the doc of DEFSETF."),
7208
7209 [ '#BQ',
7210
7211 [ defsetf,
7212 ['#COMMA', symbol],
7213
7214 [ '#BQ-COMMA-ELIPSE',
7215
7216 [ sys_get_sysprop,
7217 symbol,
7218
7219 [ quote,
7220 sys_setf_lambda
7221 ]
7222 ]
7223 ]
7224 ]
7225 ]
7226 ],
7227 '$ARRAY'([*],
7228 claz_base_character,
7229 "[Setf]")
7230 ]
7231 ]
7232 ],
7233
7234 [
7235 [ setq,
7236 sys_x,
7237
7238 [ sys_get_sysprop,
7239 symbol,
7240 [quote, sys_setf_method]
7241 ]
7242 ],
7243
7244 [ let,
7245
7246 [
7247 [ xx_package_xx,
7248 [sys_good_package]
7249 ]
7250 ],
7251
7252 [ sys_doc1,
7253
7254 [ format,
7255 [],
7256 '$ARRAY'([*],
7257 claz_base_character,
7258 "~@[~%Defined as: ~S~%See the doc of DEFINE-SETF-METHOD.~]"),
7259
7260 [ if,
7261 [consp, sys_x],
7262
7263 [ case,
7264 [car, sys_x],
7265
7266 [ lambda,
7267
7268 [ '#BQ',
7269
7270 [ sys_define_setf_method,
7271
7272 [ '#BQ-COMMA-ELIPSE',
7273 [cdr, sys_x]
7274 ]
7275 ]
7276 ]
7277 ],
7278
7279 [ sys_lambda_block,
7280
7281 [ '#BQ',
7282
7283 [ sys_define_setf_method,
7284
7285 [ '#BQ-COMMA-ELIPSE',
7286 [cddr, sys_x]
7287 ]
7288 ]
7289 ]
7290 ],
7291
7292 [ sys_lambda_closure,
7293
7294 [ '#BQ',
7295
7296 [ sys_define_setf_method,
7297
7298 [ '#BQ-COMMA-ELIPSE',
7299 [cddddr, sys_x]
7300 ]
7301 ]
7302 ]
7303 ],
7304
7305 [ sys_lambda_block_closure,
7306
7307 [ '#BQ',
7308
7309 [ sys_define_setf_method,
7310
7311 [ '#BQ-COMMA-ELIPSE',
7312
7313 [ cdr,
7314 [cddddr, sys_x]
7315 ]
7316 ]
7317 ]
7318 ]
7319 ],
7320 [t, []]
7321 ],
7322 []
7323 ]
7324 ],
7325 '$ARRAY'([*],
7326 claz_base_character,
7327 "[Setf]")
7328 ]
7329 ]
7330 ]
7331 ]
7332 ],
7333
7334 [ sys_print_doc_part_2,
7335 symbol,
7336 sys_called_f,
7337 c38_aux,
7338
7339 [ sys_arglist,
7340
7341 [ sys_get_sysprop,
7342 symbol,
7343 [quote, sys_arglist]
7344 ]
7345 ],
7346 [setq, sys_f, t],
7347
7348 [ format,
7349 t,
7350 '$ARRAY'([*],
7351 claz_base_character,
7352 "~&-----------------------------------------------------------------------------~%~53S~24@A~%~A"),
7353 symbol,
7354 sys_ind,
7355 sys_doc
7356 ]
7357 ],
7358
7359 [ sys_good_package,
7360 [],
7361
7362 [ if,
7363
7364 [ eq,
7365 [symbol_package, symbol],
7366
7367 [ find_package,
7368 '$ARRAY'([*],
7369 claz_base_character,
7370 "LISP")
7371 ]
7372 ],
7373
7374 [ find_package,
7375 '$ARRAY'([*],
7376 claz_base_character,
7377 "SYSTEM")
7378 ],
7379 xx_package_xx
7380 ]
7381 ]
7382 ]))).
7383*/
7384/*
7385:- side_effect(assert_lsp(sys_print_doc,
7386 arglist_info(sys_print_doc,
7387 f_sys_print_doc,
7388
7389 [ symbol,
7390 c38_optional,
7391 [sys_called_from_apropos_doc_p, []],
7392 c38_aux,
7393 [sys_f, []],
7394 sys_x,
7395 [sys_xx_notify_gbc_xx, []]
7396 ],
7397 arginfo{ all:
7398 [ symbol,
7399 sys_called_from_apropos_doc_p
7400 ],
7401 allow_other_keys:0,
7402 aux:
7403 [ sys_f,
7404 sys_x,
7405 sys_xx_notify_gbc_xx
7406 ],
7407 body:0,
7408 complex:0,
7409 env:0,
7410 key:0,
7411 names:
7412 [ symbol,
7413 sys_called_from_apropos_doc_p,
7414 sys_f,
7415 sys_x,
7416 sys_xx_notify_gbc_xx
7417 ],
7418 opt:
7419 [ sys_called_from_apropos_doc_p
7420 ],
7421 req:[symbol],
7422 rest:0,
7423 sublists:0,
7424 whole:0
7425 }))).
7426*/
7427/*
7428:- side_effect(assert_lsp(sys_print_doc, init_args(1, f_sys_print_doc))).
7429*/
7430/*
7431 &aux (arglist (get-sysprop symbol 'ARGLIST))
7432*/
7433/*
7434mbol
7435*/
7436
7437/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22100 **********************/
7438:-lisp_compile_to_prolog(pkg_sys,mbol)
7439:- get_var(GEnv, sys_mbol, Mbol_Get).
7440/*
7441)
7442*/
7443
7444/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22104 **********************/
7445:-lisp_compile_to_prolog(pkg_sys,')')
7446:- get_var(GEnv, ')', C41_Get).
7447/*
7448)
7449
7450*/
7451
7452/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22105 **********************/
7453:-lisp_compile_to_prolog(pkg_sys,')')
7454:- get_var(GEnv, ')', C41_Get).
7455/*
7456(setq f (or (print-doc symbol t) f))
7457*/
7458
7459/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22117 **********************/
7460:-lisp_compile_to_prolog(pkg_sys,[setq,f,[or,['print-doc',symbol,t],f]])
7461:- ( get_var(AEnv, symbol, Symbol_Get),
7462 f_sys_print_doc(Symbol_Get, [t], FORM1_Res),
7463 FORM1_Res\==[],
7464 _Ignored=FORM1_Res
7465 -> true
7466 ; get_var(AEnv, sys_f, Get),
7467 _Ignored=Get
7468 ),
7469 set_var(AEnv, sys_f, _Ignored).
7470/*
7471)
7472*/
7473
7474/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22153 **********************/
7475:-lisp_compile_to_prolog(pkg_sys,')')
7476:- get_var(GEnv, ')', C41_Get).
7477/*
7478)
7479*/
7480
7481/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22154 **********************/
7482:-lisp_compile_to_prolog(pkg_sys,')')
7483:- get_var(GEnv, ')', C41_Get).
7484/*
7485)
7486
7487*/
7488
7489/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22155 **********************/
7490:-lisp_compile_to_prolog(pkg_sys,')')
7491:- get_var(GEnv, ')', C41_Get).
7492/*
7493(if f
7494 (format t ""(if f\n (format t \"~&-----------------------------------------------------------------------------\")\n (format t \"~&No documentation for ~S in ~:[any~;~A~] package.\"\n string package\n (and package (package-name (coerce-to-package package)))))\n ".
7495*/
7496
7497/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22159 **********************/
7498:-lisp_compile_to_prolog(pkg_sys,[if,f,[format,t,'$STRING'("~&-----------------------------------------------------------------------------")],[format,t,'$STRING'("~&No documentation for ~S in ~:[any~;~A~] package."),string,package,[and,package,['package-name',['coerce-to-package',package]]]]])
7499/*
7500:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
7501 sys_coerce_to_package,
7502 kw_function,
7503 f_sys_coerce_to_package)).
7504*/
7505:- get_var(GEnv, sys_f, IFTEST),
7506 ( IFTEST\==[]
7507 -> f_format(t,
7508 '$ARRAY'([*],
7509 claz_base_character,
7510 "~&-----------------------------------------------------------------------------"),
7511 [],
7512 TrueResult11),
7513 _Ignored=TrueResult11
7514 ; get_var(GEnv, package, Package_Get),
7515 get_var(GEnv, package, IFTEST6),
7516 get_var(GEnv, string, String_Get),
7517 ( IFTEST6\==[]
7518 -> get_var(GEnv, package, Package_Get9),
7519 f_sys_coerce_to_package(Package_Get9, Package_name_Param),
7520 f_package_name(Package_name_Param, TrueResult),
7521 CAR=TrueResult
7522 ; CAR=[]
7523 ),
7524 f_format(t,
7525 '$ARRAY'([*],
7526 claz_base_character,
7527 "~&No documentation for ~S in ~:[any~;~A~] package."),
7528 [String_Get, Package_Get, CAR],
7529 ElseResult),
7530 _Ignored=ElseResult
7531 ).
7532/*
7533(values)
7534*/
7535
7536/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22437 **********************/
7537:-lisp_compile_to_prolog(pkg_sys,[values])
7538:- nb_setval('$mv_return', []).
7539/*
7540)
7541
7542*/
7543
7544/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22445 **********************/
7545:-lisp_compile_to_prolog(pkg_sys,')')
7546:- get_var(GEnv, ')', C41_Get).
7547/*
7548#+LOCATIVE
7549(defun inspect-locative (locative)
7550 (if (sys:sl-boundp (dereference locative))
7551 (if *inspect-mode*
7552 (inspect-recursively "locative pointing to:"
7553 (dereference locative))
7554 (if (locativep (dereference locative))
7555 (format t ""#+LOCATIVE\n(defun inspect-locative (locative)\n (if (sys:sl-boundp (dereference locative))\n (if *inspect-mode*\n\t (inspect-recursively \"locative pointing to:\"\n\t\t\t (dereference locative))\n\t (if (locativep (dereference locative))\n\t (format t \"~S - ~S\" locative \"UNBOUND-LOCATIVE\")\n\t (inspect-print \"locative pointing to:~% ~S\"\n\t\t\t (dereference locative)\n\t\t\t )))\n (format t \"~S - ~S\" locative \"UNBOUND-LOCATIVE\")))\n\n;;;----------------------------------------------------------------------\n \n".
7556*/
7557
7558/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22448 **********************/
7559:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':LOCATIVE'],[defun,'inspect-locative',[locative],[if,['sys:sl-boundp',[dereference,locative]],[if,'*inspect-mode*',['inspect-recursively','$STRING'("locative pointing to:"),[dereference,locative]],[if,[locativep,[dereference,locative]],[format,t,'$STRING'("~S - ~S"),locative,'$STRING'("UNBOUND-LOCATIVE")],['inspect-print','$STRING'("locative pointing to:~% ~S"),[dereference,locative]]]],[format,t,'$STRING'("~S - ~S"),locative,'$STRING'("UNBOUND-LOCATIVE")]]]]))
7560/*
7561;;----------------------------------------------------------------------
7562*/
7563/*
7564(defun documentation (symbol doc-type)
7565 (case doc-type
7566 (VARIABLE (get-sysprop symbol 'VARIABLE-DOCUMENTATION))
7567 (FUNCTION (get-sysprop symbol 'FUNCTION-DOCUMENTATION))
7568 (STRUCTURE (get-sysprop symbol 'STRUCTURE-DOCUMENTATION))
7569 (TYPE (get-sysprop symbol 'TYPE-DOCUMENTATION))
7570 (SETF (get-sysprop symbol 'SETF-DOCUMENTATION))
7571 (t (error ""(defun documentation (symbol doc-type)\n (case doc-type\n (VARIABLE (get-sysprop symbol 'VARIABLE-DOCUMENTATION))\n (FUNCTION (get-sysprop symbol 'FUNCTION-DOCUMENTATION))\n (STRUCTURE (get-sysprop symbol 'STRUCTURE-DOCUMENTATION))\n (TYPE (get-sysprop symbol 'TYPE-DOCUMENTATION))\n (SETF (get-sysprop symbol 'SETF-DOCUMENTATION))\n (t (error \"~S is an illegal documentation type.\" doc-type))))\n\n".
7572*/
7573
7574/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:22983 **********************/
7575:-lisp_compile_to_prolog(pkg_sys,[defun,documentation,[symbol,'doc-type'],[case,'doc-type',['VARIABLE',['get-sysprop',symbol,[quote,'VARIABLE-DOCUMENTATION']]],['FUNCTION',['get-sysprop',symbol,[quote,'FUNCTION-DOCUMENTATION']]],['STRUCTURE',['get-sysprop',symbol,[quote,'STRUCTURE-DOCUMENTATION']]],['TYPE',['get-sysprop',symbol,[quote,'TYPE-DOCUMENTATION']]],['SETF',['get-sysprop',symbol,[quote,'SETF-DOCUMENTATION']]],[t,[error,'$STRING'("~S is an illegal documentation type."),'doc-type']]]])
7576/*
7577% case:-[[variable,[sys_get_sysprop,symbol,[quote,sys_variable_documentation]]],[function,[sys_get_sysprop,symbol,[quote,sys_function_documentation]]],[structure,[sys_get_sysprop,symbol,[quote,sys_structure_documentation]]],[type,[sys_get_sysprop,symbol,[quote,sys_type_documentation]]],[setf,[sys_get_sysprop,symbol,[quote,sys_setf_documentation]]],[t,[error,'$ARRAY'([*],claz_base_character,"~S is an illegal documentation type."),sys_doc_type]]].
7578*/
7579/*
7580% conds:-[[[eq,_8442,[quote,variable]],[progn,[sys_get_sysprop,symbol,[quote,sys_variable_documentation]]]],[[eq,_8442,[quote,function]],[progn,[sys_get_sysprop,symbol,[quote,sys_function_documentation]]]],[[eq,_8442,[quote,structure]],[progn,[sys_get_sysprop,symbol,[quote,sys_structure_documentation]]]],[[eq,_8442,[quote,type]],[progn,[sys_get_sysprop,symbol,[quote,sys_type_documentation]]]],[[eq,_8442,[quote,setf]],[progn,[sys_get_sysprop,symbol,[quote,sys_setf_documentation]]]],[t,[progn,[error,'$ARRAY'([*],claz_base_character,"~S is an illegal documentation type."),sys_doc_type]]]].
7581*/
7582wl:lambda_def(defun, documentation, f_documentation, [symbol, sys_doc_type], [[case, sys_doc_type, [variable, [sys_get_sysprop, symbol, [quote, sys_variable_documentation]]], [function, [sys_get_sysprop, symbol, [quote, sys_function_documentation]]], [structure, [sys_get_sysprop, symbol, [quote, sys_structure_documentation]]], [type, [sys_get_sysprop, symbol, [quote, sys_type_documentation]]], [setf, [sys_get_sysprop, symbol, [quote, sys_setf_documentation]]], [t, [error, '$ARRAY'([*], claz_base_character, "~S is an illegal documentation type."), sys_doc_type]]]]).
7583wl:arglist_info(documentation, f_documentation, [symbol, sys_doc_type], arginfo{all:[symbol, sys_doc_type], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[symbol, sys_doc_type], opt:0, req:[symbol, sys_doc_type], rest:0, sublists:0, whole:0}).
7584wl: init_args(x, f_documentation).
7585
7590f_documentation(Symbol_In, Doc_type_In, FnResult) :-
7591 GEnv=[bv(symbol, Symbol_In), bv(sys_doc_type, Doc_type_In)],
7592 catch(( ( get_var(GEnv, sys_doc_type, Key),
7593 ( is_eq(Key, variable)
7594 -> get_var(GEnv, symbol, Symbol_Get),
7595 f_sys_get_sysprop(Symbol_Get,
7596 sys_variable_documentation,
7597 [],
7598 TrueResult33),
7599 _3342=TrueResult33
7600 ; ( is_eq(Key, function)
7601 -> get_var(GEnv, symbol, Symbol_Get14),
7602 f_sys_get_sysprop(Symbol_Get14,
7603 sys_function_documentation,
7604 [],
7605 TrueResult31),
7606 ElseResult34=TrueResult31
7607 ; ( is_eq(Key, structure)
7608 -> get_var(GEnv, symbol, Symbol_Get17),
7609 f_sys_get_sysprop(Symbol_Get17,
7610 sys_structure_documentation,
7611 [],
7612 TrueResult29),
7613 ElseResult32=TrueResult29
7614 ; ( is_eq(Key, type)
7615 -> get_var(GEnv, symbol, Symbol_Get20),
7616 f_sys_get_sysprop(Symbol_Get20,
7617 sys_type_documentation,
7618 [],
7619 TrueResult27),
7620 ElseResult30=TrueResult27
7621 ; ( is_eq(Key, setf)
7622 -> get_var(GEnv, symbol, Symbol_Get23),
7623 f_sys_get_sysprop(Symbol_Get23,
7624 sys_setf_documentation,
7625 [],
7626 TrueResult),
7627 ElseResult28=TrueResult
7628 ; get_var(GEnv,
7629 sys_doc_type,
7630 Doc_type_Get24),
7631 f_error(
7632 [ '$ARRAY'([*],
7633 claz_base_character,
7634 "~S is an illegal documentation type."),
7635 Doc_type_Get24
7636 ],
7637 ElseResult),
7638 ElseResult28=ElseResult
7639 ),
7640 ElseResult30=ElseResult28
7641 ),
7642 ElseResult32=ElseResult30
7643 ),
7644 ElseResult34=ElseResult32
7645 ),
7646 _3342=ElseResult34
7647 )
7648 ),
7649 _3342=FnResult
7650 ),
7651 block_exit(documentation, FnResult),
7652 true).
7653:- set_opv(documentation, symbol_function, f_documentation),
7654 DefunResult=documentation. 7655/*
7656:- side_effect(assert_lsp(documentation,
7657 lambda_def(defun,
7658 documentation,
7659 f_documentation,
7660 [symbol, sys_doc_type],
7661
7662 [
7663 [ case,
7664 sys_doc_type,
7665
7666 [ variable,
7667
7668 [ sys_get_sysprop,
7669 symbol,
7670
7671 [ quote,
7672 sys_variable_documentation
7673 ]
7674 ]
7675 ],
7676
7677 [ function,
7678
7679 [ sys_get_sysprop,
7680 symbol,
7681
7682 [ quote,
7683 sys_function_documentation
7684 ]
7685 ]
7686 ],
7687
7688 [ structure,
7689
7690 [ sys_get_sysprop,
7691 symbol,
7692
7693 [ quote,
7694 sys_structure_documentation
7695 ]
7696 ]
7697 ],
7698
7699 [ type,
7700
7701 [ sys_get_sysprop,
7702 symbol,
7703 [quote, sys_type_documentation]
7704 ]
7705 ],
7706
7707 [ setf,
7708
7709 [ sys_get_sysprop,
7710 symbol,
7711 [quote, sys_setf_documentation]
7712 ]
7713 ],
7714
7715 [ t,
7716
7717 [ error,
7718 '$ARRAY'([*],
7719 claz_base_character,
7720 "~S is an illegal documentation type."),
7721 sys_doc_type
7722 ]
7723 ]
7724 ]
7725 ]))).
7726*/
7727/*
7728:- side_effect(assert_lsp(documentation,
7729 arglist_info(documentation,
7730 f_documentation,
7731 [symbol, sys_doc_type],
7732 arginfo{ all:[symbol, sys_doc_type],
7733 allow_other_keys:0,
7734 aux:0,
7735 body:0,
7736 complex:0,
7737 env:0,
7738 key:0,
7739 names:[symbol, sys_doc_type],
7740 opt:0,
7741 req:[symbol, sys_doc_type],
7742 rest:0,
7743 sublists:0,
7744 whole:0
7745 }))).
7746*/
7747/*
7748:- side_effect(assert_lsp(documentation, init_args(x, f_documentation))).
7749*/
7750/*
7751(defun find-documentation (body)
7752 (unless (or (endp body) (endp (cdr body)))
7753 (let ((form (macroexpand (car body))))
7754 (if (stringp form)
7755 form
7756 (when (and (consp form)
7757 (eq (car form) 'DECLARE))
7758 (find-documentation (cdr body)))))))
7759
7760;(provide 'describe)
7761*/
7762
7763/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/lib/lsp/describe.lsp:23392 **********************/
7764:-lisp_compile_to_prolog(pkg_sys,[defun,'find-documentation',[body],[unless,[or,[endp,body],[endp,[cdr,body]]],[let,[[form,[macroexpand,[car,body]]]],[if,[stringp,form],form,[when,[and,[consp,form],[eq,[car,form],[quote,'DECLARE']]],['find-documentation',[cdr,body]]]]]]])
7765/*
7766:- side_effect(generate_function_or_macro_name([name='GLOBAL', environ=env_1],
7767 sys_find_documentation,
7768 kw_function,
7769 f_sys_find_documentation)).
7770*/
7771wl:lambda_def(defun, sys_find_documentation, f_sys_find_documentation, [sys_body], [[unless, [or, [endp, sys_body], [endp, [cdr, sys_body]]], [let, [[sys_form, [macroexpand, [car, sys_body]]]], [if, [stringp, sys_form], sys_form, [when, [and, [consp, sys_form], [eq, [car, sys_form], [quote, declare]]], [sys_find_documentation, [cdr, sys_body]]]]]]]).
7772wl:arglist_info(sys_find_documentation, f_sys_find_documentation, [sys_body], arginfo{all:[sys_body], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_body], opt:0, req:[sys_body], rest:0, sublists:0, whole:0}).
7773wl: init_args(x, f_sys_find_documentation).
7774
7779f_sys_find_documentation(Body_In, FnResult) :-
7780 GEnv=[bv(sys_body, Body_In)],
7781 catch(( ( ( get_var(GEnv, sys_body, Body_Get),
7782 f_endp(Body_Get, FORM1_Res),
7783 FORM1_Res\==[],
7784 IFTEST=FORM1_Res
7785 -> true
7786 ; get_var(GEnv, sys_body, Body_Get8),
7787 f_cdr(Body_Get8, Endp_Param),
7788 f_endp(Endp_Param, Endp_Ret),
7789 IFTEST=Endp_Ret
7790 ),
7791 ( IFTEST\==[]
7792 -> _3880=[]
7793 ; get_var(GEnv, sys_body, Body_Get13),
7794 f_car(Body_Get13, Car_Ret),
7795 f_macroexpand([Car_Ret], Form_Init),
7796 LEnv=[bv(sys_form, Form_Init)|GEnv],
7797 get_var(LEnv, sys_form, Form_Get),
7798 ( is_stringp(Form_Get)
7799 -> get_var(LEnv, sys_form, Form_Get19),
7800 LetResult=Form_Get19
7801 ; get_var(LEnv, sys_form, Form_Get23),
7802 ( c0nz:is_consp(Form_Get23)
7803 -> get_var(LEnv, sys_form, Form_Get26),
7804 f_car(Form_Get26, Eq_Param),
7805 f_eq(Eq_Param, declare, TrueResult),
7806 IFTEST20=TrueResult
7807 ; IFTEST20=[]
7808 ),
7809 ( IFTEST20\==[]
7810 -> get_var(LEnv, sys_body, Body_Get28),
7811 f_cdr(Body_Get28, Find_documentation_Param),
7812 f_sys_find_documentation(Find_documentation_Param,
7813 TrueResult29),
7814 ElseResult=TrueResult29
7815 ; ElseResult=[]
7816 ),
7817 LetResult=ElseResult
7818 ),
7819 _3880=LetResult
7820 )
7821 ),
7822 _3880=FnResult
7823 ),
7824 block_exit(sys_find_documentation, FnResult),
7825 true).
7826:- set_opv(sys_find_documentation, symbol_function, f_sys_find_documentation),
7827 DefunResult=sys_find_documentation. 7902
7903