1#!/usr/bin/env swipl
6
7:-style_check(-discontiguous). 8:-style_check(-singleton). 9:-use_module(library(wamcl_runtime)). 10
11/*
12;; #+BUILTIN Means to ignore since it should already be defined
13*/
14/*
15;; #+WAM-CL Means we want it
16*/
17/*
18;; #+LISP500 Means probably we dont want it
19*/
20/*
21;; #+ALT Alternative definition
22*/
23/*
24;; #+ABCL From ABCL
25*/
26/*
27;; #+SBCL From SBCL
28*/
29/*
30;; #+ECL From ECL
31*/
32/*
33;; #+SICL From SICL
34*/
35/*
36(in-package "SYSTEM")
37
38
39*/
40
41/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:262 **********************/
42:-lisp_compile_to_prolog(pkg_sys,['in-package','#:system'])
43/*
44% macroexpand:-[in_package,system7].
45*/
46/*
47% into:-[eval_when,[kw_compile_toplevel,kw_load_toplevel,kw_execute],[sys_select_package,'$ARRAY'([*],claz_base_character,"SYSTEM")]].
48*/
49:- do_when([kw_compile_toplevel, kw_load_toplevel, kw_execute],
50 f_sys_select_package('$ARRAY'([*], claz_base_character, "SYSTEM"),
51 _Ignored),
52 _Ignored).
53/*
54#+(or WAM-CL LISP500)
55(defmacro check-type (place typespec &optional string)
56 `(tagbody
57 start
58 (unless (typep ,place ',typespec)
59 (restart-case
60 (error 'type-error :datum ,place :expected-type ',typespec)
61 (store-value (value)
62 (setf ,place value)))
63 (go start))))
64
65
66
67*/
68
69/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:294 **********************/
70:-lisp_compile_to_prolog(pkg_sys,[defmacro,'check-type',[place,typespec,'&optional',string],['#BQ',[tagbody,start,[unless,[typep,['#COMMA',place],[quote,['#COMMA',typespec]]],['restart-case',[error,[quote,'type-error'],':datum',['#COMMA',place],':expected-type',[quote,['#COMMA',typespec]]],['store-value',[value],[setf,['#COMMA',place],value]]],[go,start]]]]])
71/*
72:- side_effect(generate_function_or_macro_name(
73 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
74 name='GLOBAL',
75 environ=env_1
76 ],
77 check_type,
78 kw_special,
79 sf_check_type)).
80*/
81wl:lambda_def(defmacro, check_type, mf_check_type, [sys_place, sys_typespec, c38_optional, string], [['#BQ', [tagbody, sys_start, [unless, [typep, ['#COMMA', sys_place], [quote, ['#COMMA', sys_typespec]]], [restart_case, [error, [quote, type_error], kw_datum, ['#COMMA', sys_place], kw_expected_type, [quote, ['#COMMA', sys_typespec]]], [store_value, [sys_value], [setf, ['#COMMA', sys_place], sys_value]]], [go, sys_start]]]]]).
82wl:arglist_info(check_type, mf_check_type, [sys_place, sys_typespec, c38_optional, string], arginfo{all:[sys_place, sys_typespec, string], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_place, sys_typespec, string], opt:[string], req:[sys_place, sys_typespec], rest:0, sublists:0, whole:0}).
83wl: init_args(2, mf_check_type).
84
89sf_check_type(MacroEnv, Place_In, Typespec_In, RestNKeys, FResult) :-
90 mf_check_type([check_type, Place_In, Typespec_In|RestNKeys],
91 MacroEnv,
92 MFResult),
93 f_sys_env_eval(MacroEnv, MFResult, FResult).
98mf_check_type([check_type, Place_In, Typespec_In|RestNKeys], MacroEnv, MFResult) :-
99 nop(defmacro),
100 GEnv=[bv(sys_place, Place_In), bv(sys_typespec, Typespec_In), bv(string, String_In)],
101 opt_var(MacroEnv, string, String_In, true, [], 1, RestNKeys),
102 catch(( ( get_var(GEnv, sys_place, Place_Get10),
103 ( get_var(GEnv, sys_place, Place_Get12),
104 get_var(GEnv, sys_typespec, Typespec_Get)
105 ),
106 get_var(GEnv, sys_typespec, Typespec_Get11)
107 ),
108 [tagbody, sys_start, [unless, [typep, Place_Get10, [quote, Typespec_Get]], [restart_case, [error, [quote, type_error], kw_datum, Place_Get10, kw_expected_type, [quote, Typespec_Get11]], [store_value, [sys_value], [setf, Place_Get12, sys_value]]], [go, sys_start]]]=MFResult
109 ),
110 block_exit(check_type, MFResult),
111 true).
112:- set_opv(mf_check_type, type_of, sys_macro),
113 set_opv(check_type, symbol_function, mf_check_type),
114 DefMacroResult=check_type. 115/*
116:- side_effect(assert_lsp(check_type,
117 lambda_def(defmacro,
118 check_type,
119 mf_check_type,
120
121 [ sys_place,
122 sys_typespec,
123 c38_optional,
124 string
125 ],
126
127 [
128 [ '#BQ',
129
130 [ tagbody,
131 sys_start,
132
133 [ unless,
134
135 [ typep,
136 ['#COMMA', sys_place],
137 [quote, ['#COMMA', sys_typespec]]
138 ],
139
140 [ restart_case,
141
142 [ error,
143 [quote, type_error],
144 kw_datum,
145 ['#COMMA', sys_place],
146 kw_expected_type,
147
148 [ quote,
149 ['#COMMA', sys_typespec]
150 ]
151 ],
152
153 [ store_value,
154 [sys_value],
155
156 [ setf,
157 ['#COMMA', sys_place],
158 sys_value
159 ]
160 ]
161 ],
162 [go, sys_start]
163 ]
164 ]
165 ]
166 ]))).
167*/
168/*
169:- side_effect(assert_lsp(check_type,
170 arglist_info(check_type,
171 mf_check_type,
172
173 [ sys_place,
174 sys_typespec,
175 c38_optional,
176 string
177 ],
178 arginfo{ all:
179 [ sys_place,
180 sys_typespec,
181 string
182 ],
183 allow_other_keys:0,
184 aux:0,
185 body:0,
186 complex:0,
187 env:0,
188 key:0,
189 names:
190 [ sys_place,
191 sys_typespec,
192 string
193 ],
194 opt:[string],
195 req:[sys_place, sys_typespec],
196 rest:0,
197 sublists:0,
198 whole:0
199 }))).
200*/
201/*
202:- side_effect(assert_lsp(check_type, init_args(2, mf_check_type))).
203*/
204/*
205#+(or WAM-CL LISP500)
206(defun abort (&optional condition)
207 (invoke-restart (find-restart 'abort condition))
208 (error 'control-error))
209
210*/
211
212/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:598 **********************/
213:-lisp_compile_to_prolog(pkg_sys,[defun,abort,['&optional',condition],['invoke-restart',['find-restart',[quote,abort],condition]],[error,[quote,'control-error']]])
214wl:lambda_def(defun, abort, f_abort, [c38_optional, condition], [[invoke_restart, [find_restart, [quote, abort], condition]], [error, [quote, control_error]]]).
215wl:arglist_info(abort, f_abort, [c38_optional, condition], arginfo{all:[condition], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[condition], opt:[condition], req:0, rest:0, sublists:0, whole:0}).
216wl: init_args(0, f_abort).
217
222f_abort(RestNKeys, FnResult) :-
223 GEnv=[bv(condition, Condition_In)],
224 opt_var(Env, condition, Condition_In, true, [], 1, RestNKeys),
225 catch(( ( get_var(GEnv, condition, Condition_Get),
226 f_find_restart(abort, [Condition_Get], Invoke_restart_Param),
227 f_invoke_restart(Invoke_restart_Param, [], Invoke_restart_Ret),
228 f_error([control_error], Error_Ret)
229 ),
230 Error_Ret=FnResult
231 ),
232 block_exit(abort, FnResult),
233 true).
234:- set_opv(abort, symbol_function, f_abort),
235 DefunResult=abort. 236/*
237:- side_effect(assert_lsp(abort,
238 lambda_def(defun,
239 abort,
240 f_abort,
241 [c38_optional, condition],
242
243 [
244 [ invoke_restart,
245
246 [ find_restart,
247 [quote, abort],
248 condition
249 ]
250 ],
251 [error, [quote, control_error]]
252 ]))).
253*/
254/*
255:- side_effect(assert_lsp(abort,
256 arglist_info(abort,
257 f_abort,
258 [c38_optional, condition],
259 arginfo{ all:[condition],
260 allow_other_keys:0,
261 aux:0,
262 body:0,
263 complex:0,
264 env:0,
265 key:0,
266 names:[condition],
267 opt:[condition],
268 req:0,
269 rest:0,
270 sublists:0,
271 whole:0
272 }))).
273*/
274/*
275:- side_effect(assert_lsp(abort, init_args(0, f_abort))).
276*/
277/*
278#+(or WAM-CL LISP500)
279(defun continue (&optional condition)
280 (invoke-restart (find-restart 'continue condition)))
281
282*/
283
284/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:739 **********************/
285:-lisp_compile_to_prolog(pkg_sys,[defun,continue,['&optional',condition],['invoke-restart',['find-restart',[quote,continue],condition]]])
286wl:lambda_def(defun, continue, f_continue, [c38_optional, condition], [[invoke_restart, [find_restart, [quote, continue], condition]]]).
287wl:arglist_info(continue, f_continue, [c38_optional, condition], arginfo{all:[condition], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[condition], opt:[condition], req:0, rest:0, sublists:0, whole:0}).
288wl: init_args(0, f_continue).
289
294f_continue(RestNKeys, FnResult) :-
295 GEnv=[bv(condition, Condition_In)],
296 opt_var(Env, condition, Condition_In, true, [], 1, RestNKeys),
297 catch(( ( get_var(GEnv, condition, Condition_Get),
298 f_find_restart(continue,
299 [Condition_Get],
300 Invoke_restart_Param),
301 f_invoke_restart(Invoke_restart_Param, [], Invoke_restart_Ret)
302 ),
303 Invoke_restart_Ret=FnResult
304 ),
305 block_exit(continue, FnResult),
306 true).
307:- set_opv(continue, symbol_function, f_continue),
308 DefunResult=continue. 309/*
310:- side_effect(assert_lsp(continue,
311 lambda_def(defun,
312 continue,
313 f_continue,
314 [c38_optional, condition],
315
316 [
317 [ invoke_restart,
318
319 [ find_restart,
320 [quote, continue],
321 condition
322 ]
323 ]
324 ]))).
325*/
326/*
327:- side_effect(assert_lsp(continue,
328 arglist_info(continue,
329 f_continue,
330 [c38_optional, condition],
331 arginfo{ all:[condition],
332 allow_other_keys:0,
333 aux:0,
334 body:0,
335 complex:0,
336 env:0,
337 key:0,
338 names:[condition],
339 opt:[condition],
340 req:0,
341 rest:0,
342 sublists:0,
343 whole:0
344 }))).
345*/
346/*
347:- side_effect(assert_lsp(continue, init_args(0, f_continue))).
348*/
349/*
350#+(or WAM-CL LISP500)
351(defun muffle-warning (&optional condition)
352 (invoke-restart (find-restart 'muffle-warning condition))
353 (error 'control-error))
354
355*/
356
357/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:860 **********************/
358:-lisp_compile_to_prolog(pkg_sys,[defun,'muffle-warning',['&optional',condition],['invoke-restart',['find-restart',[quote,'muffle-warning'],condition]],[error,[quote,'control-error']]])
359wl:lambda_def(defun, muffle_warning, f_muffle_warning, [c38_optional, condition], [[invoke_restart, [find_restart, [quote, muffle_warning], condition]], [error, [quote, control_error]]]).
360wl:arglist_info(muffle_warning, f_muffle_warning, [c38_optional, condition], arginfo{all:[condition], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[condition], opt:[condition], req:0, rest:0, sublists:0, whole:0}).
361wl: init_args(0, f_muffle_warning).
362
367f_muffle_warning(RestNKeys, FnResult) :-
368 GEnv=[bv(condition, Condition_In)],
369 opt_var(Env, condition, Condition_In, true, [], 1, RestNKeys),
370 catch(( ( get_var(GEnv, condition, Condition_Get),
371 f_find_restart(muffle_warning,
372 [Condition_Get],
373 Invoke_restart_Param),
374 f_invoke_restart(Invoke_restart_Param, [], Invoke_restart_Ret),
375 f_error([control_error], Error_Ret)
376 ),
377 Error_Ret=FnResult
378 ),
379 block_exit(muffle_warning, FnResult),
380 true).
381:- set_opv(muffle_warning, symbol_function, f_muffle_warning),
382 DefunResult=muffle_warning. 383/*
384:- side_effect(assert_lsp(muffle_warning,
385 lambda_def(defun,
386 muffle_warning,
387 f_muffle_warning,
388 [c38_optional, condition],
389
390 [
391 [ invoke_restart,
392
393 [ find_restart,
394 [quote, muffle_warning],
395 condition
396 ]
397 ],
398 [error, [quote, control_error]]
399 ]))).
400*/
401/*
402:- side_effect(assert_lsp(muffle_warning,
403 arglist_info(muffle_warning,
404 f_muffle_warning,
405 [c38_optional, condition],
406 arginfo{ all:[condition],
407 allow_other_keys:0,
408 aux:0,
409 body:0,
410 complex:0,
411 env:0,
412 key:0,
413 names:[condition],
414 opt:[condition],
415 req:0,
416 rest:0,
417 sublists:0,
418 whole:0
419 }))).
420*/
421/*
422:- side_effect(assert_lsp(muffle_warning, init_args(0, f_muffle_warning))).
423*/
424/*
425#+(or WAM-CL LISP500)
426(defun store-value (value &optional condition)
427 (invoke-restart (find-restart 'store-value condition) value))
428
429*/
430
431/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:1019 **********************/
432:-lisp_compile_to_prolog(pkg_sys,[defun,'store-value',[value,'&optional',condition],['invoke-restart',['find-restart',[quote,'store-value'],condition],value]])
433wl:lambda_def(defun, store_value, f_store_value, [sys_value, c38_optional, condition], [[invoke_restart, [find_restart, [quote, store_value], condition], sys_value]]).
434wl:arglist_info(store_value, f_store_value, [sys_value, c38_optional, condition], arginfo{all:[sys_value, condition], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_value, condition], opt:[condition], req:[sys_value], rest:0, sublists:0, whole:0}).
435wl: init_args(1, f_store_value).
436
441f_store_value(Value_In, RestNKeys, FnResult) :-
442 GEnv=[bv(sys_value, Value_In), bv(condition, Condition_In)],
443 opt_var(Env, condition, Condition_In, true, [], 1, RestNKeys),
444 catch(( ( get_var(GEnv, condition, Condition_Get),
445 f_find_restart(store_value,
446 [Condition_Get],
447 Invoke_restart_Param),
448 get_var(GEnv, sys_value, Value_Get),
449 f_invoke_restart(Invoke_restart_Param,
450 [Value_Get],
451 Invoke_restart_Ret)
452 ),
453 Invoke_restart_Ret=FnResult
454 ),
455 block_exit(store_value, FnResult),
456 true).
457:- set_opv(store_value, symbol_function, f_store_value),
458 DefunResult=store_value. 459/*
460:- side_effect(assert_lsp(store_value,
461 lambda_def(defun,
462 store_value,
463 f_store_value,
464 [sys_value, c38_optional, condition],
465
466 [
467 [ invoke_restart,
468
469 [ find_restart,
470 [quote, store_value],
471 condition
472 ],
473 sys_value
474 ]
475 ]))).
476*/
477/*
478:- side_effect(assert_lsp(store_value,
479 arglist_info(store_value,
480 f_store_value,
481 [sys_value, c38_optional, condition],
482 arginfo{ all:[sys_value, condition],
483 allow_other_keys:0,
484 aux:0,
485 body:0,
486 complex:0,
487 env:0,
488 key:0,
489 names:[sys_value, condition],
490 opt:[condition],
491 req:[sys_value],
492 rest:0,
493 sublists:0,
494 whole:0
495 }))).
496*/
497/*
498:- side_effect(assert_lsp(store_value, init_args(1, f_store_value))).
499*/
500/*
501#+(or WAM-CL LISP500)
502(defun use-value (value &optional condition)
503 (invoke-restart (find-restart 'use-value condition) value))
504
505
506*/
507
508/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:1158 **********************/
509:-lisp_compile_to_prolog(pkg_sys,[defun,'use-value',[value,'&optional',condition],['invoke-restart',['find-restart',[quote,'use-value'],condition],value]])
510wl:lambda_def(defun, use_value, f_use_value, [sys_value, c38_optional, condition], [[invoke_restart, [find_restart, [quote, use_value], condition], sys_value]]).
511wl:arglist_info(use_value, f_use_value, [sys_value, c38_optional, condition], arginfo{all:[sys_value, condition], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_value, condition], opt:[condition], req:[sys_value], rest:0, sublists:0, whole:0}).
512wl: init_args(1, f_use_value).
513
518f_use_value(Value_In, RestNKeys, FnResult) :-
519 GEnv=[bv(sys_value, Value_In), bv(condition, Condition_In)],
520 opt_var(Env, condition, Condition_In, true, [], 1, RestNKeys),
521 catch(( ( get_var(GEnv, condition, Condition_Get),
522 f_find_restart(use_value,
523 [Condition_Get],
524 Invoke_restart_Param),
525 get_var(GEnv, sys_value, Value_Get),
526 f_invoke_restart(Invoke_restart_Param,
527 [Value_Get],
528 Invoke_restart_Ret)
529 ),
530 Invoke_restart_Ret=FnResult
531 ),
532 block_exit(use_value, FnResult),
533 true).
534:- set_opv(use_value, symbol_function, f_use_value),
535 DefunResult=use_value. 536/*
537:- side_effect(assert_lsp(use_value,
538 lambda_def(defun,
539 use_value,
540 f_use_value,
541 [sys_value, c38_optional, condition],
542
543 [
544 [ invoke_restart,
545
546 [ find_restart,
547 [quote, use_value],
548 condition
549 ],
550 sys_value
551 ]
552 ]))).
553*/
554/*
555:- side_effect(assert_lsp(use_value,
556 arglist_info(use_value,
557 f_use_value,
558 [sys_value, c38_optional, condition],
559 arginfo{ all:[sys_value, condition],
560 allow_other_keys:0,
561 aux:0,
562 body:0,
563 complex:0,
564 env:0,
565 key:0,
566 names:[sys_value, condition],
567 opt:[condition],
568 req:[sys_value],
569 rest:0,
570 sublists:0,
571 whole:0
572 }))).
573*/
574/*
575:- side_effect(assert_lsp(use_value, init_args(1, f_use_value))).
576*/
577/*
578#+(or WAM-CL LISP500)
579(defun integer-string (integer &optional (radix 10))
580 (if (= integer 0)
581 "0"
582 (labels ((recur (i l)
583 (if (= i 0)
584 l
585 (multiple-value-bind (ni r)
586 (floor i radix)
587 (recur ni (cons (code-char (+ (if (< r 10) 48 55) r))
588 l))))))
589 (apply #'string (if (< 0 integer)
590 (recur integer nil)
591 (cons (code-char 45) (recur (- integer) nil)))))))
592
593
594
595*/
596
597/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:1295 **********************/
598:-lisp_compile_to_prolog(pkg_sys,[defun,'integer-string',[integer,'&optional',[radix,10]],[if,[=,integer,0],'$STRING'("0"),[labels,[[recur,[i,l],[if,[=,i,0],l,['multiple-value-bind',[ni,r],[floor,i,radix],[recur,ni,[cons,['code-char',[+,[if,[<,r,10],48,55],r]],l]]]]]],[apply,function(string),[if,[<,0,integer],[recur,integer,[]],[cons,['code-char',45],[recur,[-,integer],[]]]]]]]])
599/*
600:- side_effect(generate_function_or_macro_name(
601 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
602 name='GLOBAL',
603 environ=env_1
604 ],
605 sys_integer_string,
606 kw_function,
607 f_sys_integer_string)).
608*/
609/*
610:- side_effect(generate_function_or_macro_name(
611 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
612 name='GLOBAL',
613 environ=env_1
614 ],
615 sys_recur,
616 kw_function,
617 f_sys_recur)).
618*/
619/*
620:- side_effect(generate_function_or_macro_name(
621 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
622 name='GLOBAL',
623 environ=env_1
624 ],
625 sys_recur,
626 kw_function,
627 f_sys_recur)).
628*/
629wl:lambda_def(defun, sys_integer_string, f_sys_integer_string, [integer, c38_optional, [sys_radix, 10]], [[if, [=, integer, 0], '$ARRAY'([*], claz_base_character, "0"), [labels, [[sys_recur, [sys_i, sys_l], [if, [=, sys_i, 0], sys_l, [multiple_value_bind, [sys_ni, sys_r], [floor, sys_i, sys_radix], [sys_recur, sys_ni, [cons, [code_char, [+, [if, [<, sys_r, 10], 48, 55], sys_r]], sys_l]]]]]], [apply, function(string), [if, [<, 0, integer], [sys_recur, integer, []], [cons, [code_char, 45], [sys_recur, [-, integer], []]]]]]]]).
630wl:arglist_info(sys_integer_string, f_sys_integer_string, [integer, c38_optional, [sys_radix, 10]], arginfo{all:[integer, sys_radix], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[integer, sys_radix], opt:[sys_radix], req:[integer], rest:0, sublists:0, whole:0}).
631wl: init_args(1, f_sys_integer_string).
632
637f_sys_integer_string(Integer_In, RestNKeys, FnResult) :-
638 Env11=[bv(integer, Integer_In), bv(sys_radix, Radix_In)],
639 opt_var(Env, sys_radix, Radix_In, true, 10, 1, RestNKeys),
640 catch(( ( get_var(Env11, integer, Integer_Get),
641 ( Integer_Get=:=0
642 -> _8620='$ARRAY'([*], claz_base_character, "0")
643 ; assert_lsp(sys_recur,
644 wl:lambda_def(defun, sys_recur, f_sys_recur1, [sys_i, sys_l], [[if, [=, sys_i, 0], sys_l, [multiple_value_bind, [sys_ni, sys_r], [floor, sys_i, sys_radix], [sys_recur, sys_ni, [cons, [code_char, [+, [if, [<, sys_r, 10], 48, 55], sys_r]], sys_l]]]]])),
645 assert_lsp(sys_recur,
646 wl:arglist_info(sys_recur, f_sys_recur1, [sys_i, sys_l], arginfo{all:[sys_i, sys_l], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_i, sys_l], opt:0, req:[sys_i, sys_l], rest:0, sublists:0, whole:0})),
647 assert_lsp(sys_recur, wl:init_args(2, f_sys_recur1)),
648 assert_lsp(sys_recur,
649 (f_sys_recur1(I_In, L_In, RestNKeys13, FnResult12):-GEnv=[bv(sys_i, I_In), bv(sys_l, L_In)], catch(((get_var(GEnv, sys_i, I_Get), (I_Get=:=0->get_var(GEnv, sys_l, L_Get), _8816=L_Get;LEnv=[bv(sys_ni, []), bv(sys_r, [])|GEnv], get_var(LEnv, sys_i, I_Get24), get_var(LEnv, sys_radix, Radix_Get), f_floor(I_Get24, [Radix_Get], Floor_Ret), setq_from_values(LEnv, [sys_ni, sys_r]), get_var(LEnv, sys_ni, Ni_Get), get_var(LEnv, sys_r, R_Get), (R_Get<10->_9030=48;_9030=55), get_var(LEnv, sys_r, R_Get31), 'f_+'(_9030, R_Get31, Code_char_Param), f_code_char(Code_char_Param, Code_char_Ret), get_var(LEnv, sys_l, L_Get32), _9024=[Code_char_Ret|L_Get32], f_sys_recur(Ni_Get, _9024, LetResult), _8816=LetResult)), _8816=FnResult12), block_exit(sys_recur, FnResult12), true))),
650 get_var(Env11, integer, Integer_Get37),
651 ( 0<Integer_Get37
652 -> get_var(Env11, integer, Integer_Get40),
653 f_sys_recur1(Integer_Get40, [], TrueResult42),
654 _9236=TrueResult42
655 ; f_code_char(45, Code_char_Ret53),
656 get_var(Env11, integer, Integer_Get41),
657 'f_-'(0, Integer_Get41, Recur1_Param),
658 f_sys_recur1(Recur1_Param, [], KeysNRest),
659 ElseResult43=[Code_char_Ret53|KeysNRest],
660 _9236=ElseResult43
661 ),
662 f_apply(f_string, _9236, ElseResult44),
663 _8620=ElseResult44
664 )
665 ),
666 _8620=FnResult
667 ),
668 block_exit(sys_integer_string, FnResult),
669 true).
670:- set_opv(sys_integer_string, symbol_function, f_sys_integer_string),
671 DefunResult=sys_integer_string. 672/*
673:- side_effect(assert_lsp(sys_integer_string,
674 lambda_def(defun,
675 sys_integer_string,
676 f_sys_integer_string,
677 [integer, c38_optional, [sys_radix, 10]],
678
679 [
680 [ if,
681 [=, integer, 0],
682 '$ARRAY'([*], claz_base_character, "0"),
683
684 [ labels,
685
686 [
687 [ sys_recur,
688 [sys_i, sys_l],
689
690 [ if,
691 [=, sys_i, 0],
692 sys_l,
693
694 [ multiple_value_bind,
695 [sys_ni, sys_r],
696 [floor, sys_i, sys_radix],
697
698 [ sys_recur,
699 sys_ni,
700
701 [ cons,
702
703 [ code_char,
704
705 [ (+),
706
707 [ if,
708 [<, sys_r, 10],
709 48,
710 55
711 ],
712 sys_r
713 ]
714 ],
715 sys_l
716 ]
717 ]
718 ]
719 ]
720 ]
721 ],
722
723 [ apply,
724 function(string),
725
726 [ if,
727 [<, 0, integer],
728 [sys_recur, integer, []],
729
730 [ cons,
731 [code_char, 45],
732 [sys_recur, [-, integer], []]
733 ]
734 ]
735 ]
736 ]
737 ]
738 ]))).
739*/
740/*
741:- side_effect(assert_lsp(sys_integer_string,
742 arglist_info(sys_integer_string,
743 f_sys_integer_string,
744 [integer, c38_optional, [sys_radix, 10]],
745 arginfo{ all:[integer, sys_radix],
746 allow_other_keys:0,
747 aux:0,
748 body:0,
749 complex:0,
750 env:0,
751 key:0,
752 names:[integer, sys_radix],
753 opt:[sys_radix],
754 req:[integer],
755 rest:0,
756 sublists:0,
757 whole:0
758 }))).
759*/
760/*
761:- side_effect(assert_lsp(sys_integer_string,
762 init_args(1, f_sys_integer_string))).
763*/
764/*
765#+(or WAM-CL LISP500)
766(defun designator-symbol (designator)
767 (if (symbolp designator)
768 designator
769 (find-symbol designator)))
770
771*/
772
773/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:1730 **********************/
774:-lisp_compile_to_prolog(pkg_sys,[defun,'designator-symbol',[designator],[if,[symbolp,designator],designator,['find-symbol',designator]]])
775/*
776:- side_effect(generate_function_or_macro_name(
777 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
778 name='GLOBAL',
779 environ=env_1
780 ],
781 sys_designator_symbol,
782 kw_function,
783 f_sys_designator_symbol)).
784*/
785wl:lambda_def(defun, sys_designator_symbol, f_sys_designator_symbol, [sys_designator], [[if, [symbolp, sys_designator], sys_designator, [find_symbol, sys_designator]]]).
786wl:arglist_info(sys_designator_symbol, f_sys_designator_symbol, [sys_designator], arginfo{all:[sys_designator], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_designator], opt:0, req:[sys_designator], rest:0, sublists:0, whole:0}).
787wl: init_args(x, f_sys_designator_symbol).
788
793f_sys_designator_symbol(Designator_In, FnResult) :-
794 GEnv=[bv(sys_designator, Designator_In)],
795 catch(( ( get_var(GEnv, sys_designator, Designator_Get),
796 ( is_symbolp(Designator_Get)
797 -> get_var(GEnv, sys_designator, Designator_Get9),
798 _9448=Designator_Get9
799 ; get_var(GEnv, sys_designator, Designator_Get10),
800 f_find_symbol(Designator_Get10, ElseResult),
801 _9448=ElseResult
802 )
803 ),
804 _9448=FnResult
805 ),
806 block_exit(sys_designator_symbol, FnResult),
807 true).
808:- set_opv(sys_designator_symbol, symbol_function, f_sys_designator_symbol),
809 DefunResult=sys_designator_symbol. 810/*
811:- side_effect(assert_lsp(sys_designator_symbol,
812 lambda_def(defun,
813 sys_designator_symbol,
814 f_sys_designator_symbol,
815 [sys_designator],
816
817 [
818 [ if,
819 [symbolp, sys_designator],
820 sys_designator,
821 [find_symbol, sys_designator]
822 ]
823 ]))).
824*/
825/*
826:- side_effect(assert_lsp(sys_designator_symbol,
827 arglist_info(sys_designator_symbol,
828 f_sys_designator_symbol,
829 [sys_designator],
830 arginfo{ all:[sys_designator],
831 allow_other_keys:0,
832 aux:0,
833 body:0,
834 complex:0,
835 env:0,
836 key:0,
837 names:[sys_designator],
838 opt:0,
839 req:[sys_designator],
840 rest:0,
841 sublists:0,
842 whole:0
843 }))).
844*/
845/*
846:- side_effect(assert_lsp(sys_designator_symbol,
847 init_args(x, f_sys_designator_symbol))).
848*/
849/*
850#+BUILTIN
851(defun symbolp (object) (or (null object) (eq (type-of object) 'symbol)))
852
853*/
854
855/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:1874 **********************/
856:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[defun,symbolp,[object],[or,[null,object],[eq,['type-of',object],[quote,symbol]]]]]))
857/*
858#+BUILTIN
859(defun keywordp (object)
860(and (symbolp object)
861 (string= (package-name (symbol-package object)) "KEYwORD")))
862
863*/
864
865/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:1963 **********************/
866:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[defun,keywordp,[object],[and,[symbolp,object],['string=',['package-name',['symbol-package',object]],'$STRING'("KEYwORD")]]]]))
867/*
868#+BUILTIN
869(defun make-symbol (name)
870 (let ((symbol (makei 9 0 name nil nil nil nil (- 1) 0)))
871 (imakunbound symbol 4)
872 (imakunbound symbol 5)
873 (imakunbound symbol 6)
874 symbol))
875
876*/
877
878/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:2096 **********************/
879:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[defun,'make-symbol',[name],[let,[[symbol,[makei,9,0,name,[],[],[],[],[-,1],0]]],[imakunbound,symbol,4],[imakunbound,symbol,5],[imakunbound,symbol,6],symbol]]]))
880/*
881#+(or WAM-CL LISP500)
882(defvar *gensym-counter* 0)
883*/
884
885/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:2295 **********************/
886:-lisp_compile_to_prolog(pkg_sys,[defvar,'*gensym-counter*',0])
887:- set_var(AEnv, xx_gensym_counter_xx, 0).
888/*
889#+(or WAM-CL LISP500)
890(defun gen-sym (&optional x)
891 (let ((prefix (if (stringp x) x "G"))
892 (suffix (if (fixnump x)
893 x
894 (let ((x *gensym-counter*))
895 (setf *gensym-counter* (+ 1 *gensym-counter*))))))
896 (make-symbol (conc-string prefix (integer-string suffix)))))
897
898*/
899
900/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:2347 **********************/
901:-lisp_compile_to_prolog(pkg_sys,[defun,'gen-sym',['&optional',x],[let,[[prefix,[if,[stringp,x],x,'$STRING'("G")]],[suffix,[if,[fixnump,x],x,[let,[[x,'*gensym-counter*']],[setf,'*gensym-counter*',[+,1,'*gensym-counter*']]]]]],['make-symbol',['conc-string',prefix,['integer-string',suffix]]]]])
902/*
903:- side_effect(generate_function_or_macro_name(
904 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
905 name='GLOBAL',
906 environ=env_1
907 ],
908 sys_gen_sym,
909 kw_function,
910 f_sys_gen_sym)).
911*/
912/*
913:- side_effect(generate_function_or_macro_name(
914 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
915 name='GLOBAL',
916 environ=env_1
917 ],
918 sys_conc_string,
919 kw_function,
920 f_sys_conc_string)).
921*/
922wl:lambda_def(defun, sys_gen_sym, f_sys_gen_sym, [c38_optional, sys_x], [[let, [[sys_prefix, [if, [stringp, sys_x], sys_x, '$ARRAY'([*], claz_base_character, "G")]], [sys_suffix, [if, [sys_fixnump, sys_x], sys_x, [let, [[sys_x, xx_gensym_counter_xx]], [setf, xx_gensym_counter_xx, [+, 1, xx_gensym_counter_xx]]]]]], [make_symbol, [sys_conc_string, sys_prefix, [sys_integer_string, sys_suffix]]]]]).
923wl:arglist_info(sys_gen_sym, f_sys_gen_sym, [c38_optional, sys_x], arginfo{all:[sys_x], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x], opt:[sys_x], req:0, rest:0, sublists:0, whole:0}).
924wl: init_args(0, f_sys_gen_sym).
925
930f_sys_gen_sym(RestNKeys, FnResult) :-
931 GEnv=[bv(sys_x, X_In)],
932 opt_var(Env, sys_x, X_In, true, [], 1, RestNKeys),
933 catch(( ( get_var(GEnv, sys_x, X_Get),
934 ( is_stringp(X_Get)
935 -> get_var(GEnv, sys_x, X_Get13),
936 Prefix_Init=X_Get13
937 ; Prefix_Init='$ARRAY'([*], claz_base_character, "G")
938 ),
939 get_var(GEnv, sys_x, X_Get17),
940 f_sys_fixnump(X_Get17, IFTEST15),
941 ( IFTEST15\==[]
942 -> get_var(GEnv, sys_x, X_Get18),
943 Suffix_Init=X_Get18
944 ; get_var(GEnv,
945 xx_gensym_counter_xx,
946 Xx_gensym_counter_xx_Get),
947 LEnv21=[bv(sys_x, Xx_gensym_counter_xx_Get)|GEnv],
948 get_var(LEnv21,
949 xx_gensym_counter_xx,
950 Xx_gensym_counter_xx_Get24),
951 'f_+'(1, Xx_gensym_counter_xx_Get24, LetResult20),
952 set_var(LEnv21, xx_gensym_counter_xx, LetResult20),
953 Suffix_Init=LetResult20
954 ),
955 LEnv=[bv(sys_prefix, Prefix_Init), bv(sys_suffix, Suffix_Init)|GEnv],
956 get_var(LEnv, sys_prefix, Prefix_Get),
957 get_var(LEnv, sys_suffix, Suffix_Get),
958 f_sys_integer_string(Suffix_Get, [], Integer_string_Ret),
959 f_sys_conc_string(Prefix_Get,
960 Integer_string_Ret,
961 Make_symbol_Param),
962 f_make_symbol(Make_symbol_Param, LetResult)
963 ),
964 LetResult=FnResult
965 ),
966 block_exit(sys_gen_sym, FnResult),
967 true).
968:- set_opv(sys_gen_sym, symbol_function, f_sys_gen_sym),
969 DefunResult=sys_gen_sym. 970/*
971:- side_effect(assert_lsp(sys_gen_sym,
972 lambda_def(defun,
973 sys_gen_sym,
974 f_sys_gen_sym,
975 [c38_optional, sys_x],
976
977 [
978 [ let,
979
980 [
981 [ sys_prefix,
982
983 [ if,
984 [stringp, sys_x],
985 sys_x,
986 '$ARRAY'([*],
987 claz_base_character,
988 "G")
989 ]
990 ],
991
992 [ sys_suffix,
993
994 [ if,
995 [sys_fixnump, sys_x],
996 sys_x,
997
998 [ let,
999
1000 [
1001 [ sys_x,
1002 xx_gensym_counter_xx
1003 ]
1004 ],
1005
1006 [ setf,
1007 xx_gensym_counter_xx,
1008 [+, 1, xx_gensym_counter_xx]
1009 ]
1010 ]
1011 ]
1012 ]
1013 ],
1014
1015 [ make_symbol,
1016
1017 [ sys_conc_string,
1018 sys_prefix,
1019 [sys_integer_string, sys_suffix]
1020 ]
1021 ]
1022 ]
1023 ]))).
1024*/
1025/*
1026:- side_effect(assert_lsp(sys_gen_sym,
1027 arglist_info(sys_gen_sym,
1028 f_sys_gen_sym,
1029 [c38_optional, sys_x],
1030 arginfo{ all:[sys_x],
1031 allow_other_keys:0,
1032 aux:0,
1033 body:0,
1034 complex:0,
1035 env:0,
1036 key:0,
1037 names:[sys_x],
1038 opt:[sys_x],
1039 req:0,
1040 rest:0,
1041 sublists:0,
1042 whole:0
1043 }))).
1044*/
1045/*
1046:- side_effect(assert_lsp(sys_gen_sym, init_args(0, f_sys_gen_sym))).
1047*/
1048/*
1049(let ((gentemp-counter 0))
1050 (defun gentemp (&optional (prefix "T") (package *package*))
1051 (setf gentemp-counter (+ 1 gentemp-counter))
1052 (intern (conc-string prefix (integer-string gentemp-counter))
1053 package)))
1054
1055
1056*/
1057
1058/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:2639 **********************/
1059:-lisp_compile_to_prolog(pkg_sys,[let,[['gentemp-counter',0]],[defun,gentemp,['&optional',[prefix,'$STRING'("T")],[package,'*package*']],[setf,'gentemp-counter',[+,1,'gentemp-counter']],[intern,['conc-string',prefix,['integer-string','gentemp-counter']],package]]])
1060/*
1061:- side_effect(generate_function_or_macro_name(
1062 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1063 name='GLOBAL',
1064 environ=env_1
1065 ],
1066 sys_conc_string,
1067 kw_function,
1068 f_sys_conc_string)).
1069*/
1070:- LEnv=[bv(sys_gentemp_counter, 0)|CDR].
1071wl:lambda_def(defun, gentemp, f_gentemp, [c38_optional, [sys_prefix, '$ARRAY'([*], claz_base_character, "T")], [package, xx_package_xx]], [[setf, sys_gentemp_counter, [+, 1, sys_gentemp_counter]], [intern, [sys_conc_string, sys_prefix, [sys_integer_string, sys_gentemp_counter]], package]]).
1072wl:arglist_info(gentemp, f_gentemp, [c38_optional, [sys_prefix, '$ARRAY'([*], claz_base_character, "T")], [package, xx_package_xx]], arginfo{all:[sys_prefix, package], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_prefix, package], opt:[sys_prefix, package], req:0, rest:0, sublists:0, whole:0}).
1073wl: init_args(0, f_gentemp).
1074
1079f_gentemp(RestNKeys, FnResult) :-
1080 GEnv=[bv(sys_prefix, Prefix_In), bv(package, Package_In)],
1081 opt_var(LEnv,
1082 sys_prefix,
1083 Prefix_In,
1084 true,
1085 '$ARRAY'([*], claz_base_character, "T"),
1086 1,
1087 RestNKeys),
1088 opt_var(LEnv,
1089 package,
1090 Package_In,
1091 get_var(Get_var_Param, xx_package_xx, Xx_package_xx_Get),
1092 Xx_package_xx_Get,
1093 2,
1094 RestNKeys),
1095 catch(( ( get_var(GEnv, sys_gentemp_counter, Gentemp_counter_Get),
1096 'f_+'(1, Gentemp_counter_Get, Gentemp_counter),
1097 set_var(GEnv, sys_gentemp_counter, Gentemp_counter),
1098 get_var(GEnv, sys_gentemp_counter, Gentemp_counter_Get13),
1099 get_var(GEnv, sys_prefix, Prefix_Get),
1100 f_sys_integer_string(Gentemp_counter_Get13,
1101 [],
1102 Integer_string_Ret),
1103 f_sys_conc_string(Prefix_Get,
1104 Integer_string_Ret,
1105 Intern_Param),
1106 get_var(GEnv, package, Package_Get),
1107 f_intern(Intern_Param, Package_Get, Intern_Ret)
1108 ),
1109 Intern_Ret=FnResult
1110 ),
1111 block_exit(gentemp, FnResult),
1112 true).
1113:- set_opv(gentemp, symbol_function, f_gentemp),
1114 DefunResult=gentemp. 1115/*
1116:- side_effect(assert_lsp(gentemp,
1117 lambda_def(defun,
1118 gentemp,
1119 f_gentemp,
1120
1121 [ c38_optional,
1122
1123 [ sys_prefix,
1124 '$ARRAY'([*], claz_base_character, "T")
1125 ],
1126 [package, xx_package_xx]
1127 ],
1128
1129 [
1130 [ setf,
1131 sys_gentemp_counter,
1132 [+, 1, sys_gentemp_counter]
1133 ],
1134
1135 [ intern,
1136
1137 [ sys_conc_string,
1138 sys_prefix,
1139
1140 [ sys_integer_string,
1141 sys_gentemp_counter
1142 ]
1143 ],
1144 package
1145 ]
1146 ]))).
1147*/
1148/*
1149:- side_effect(assert_lsp(gentemp,
1150 arglist_info(gentemp,
1151 f_gentemp,
1152
1153 [ c38_optional,
1154
1155 [ sys_prefix,
1156 '$ARRAY'([*],
1157 claz_base_character,
1158 "T")
1159 ],
1160 [package, xx_package_xx]
1161 ],
1162 arginfo{ all:[sys_prefix, package],
1163 allow_other_keys:0,
1164 aux:0,
1165 body:0,
1166 complex:0,
1167 env:0,
1168 key:0,
1169 names:[sys_prefix, package],
1170 opt:[sys_prefix, package],
1171 req:0,
1172 rest:0,
1173 sublists:0,
1174 whole:0
1175 }))).
1176*/
1177/*
1178:- side_effect(assert_lsp(gentemp, init_args(0, f_gentemp))).
1179*/
1180/*
1181#+BUILTIN
1182#+(or WAM-CL LISP500)
1183(defun get (symbol indicator &optional default)
1184 (getf (symbol-plist symbol) indicator default))
1185
1186*/
1187
1188/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:2868 **********************/
1189:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,get,[symbol,indicator,'&optional',default],[getf,['symbol-plist',symbol],indicator,default]]]]))
1190/*
1191#+(or WAM-CL LISP500)
1192(defun (setf get) (new-value symbol indicator &optional default)
1193 (setf (getf (symbol-plist symbol) indicator default) new-value))
1194
1195*/
1196
1197/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:3005 **********************/
1198:-lisp_compile_to_prolog(pkg_sys,[defun,[setf,get],['new-value',symbol,indicator,'&optional',default],[setf,[getf,['symbol-plist',symbol],indicator,default],'new-value']])
1199/*
1200:- side_effect(generate_function_or_macro_name(
1201 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1202 name='GLOBAL',
1203 environ=env_1
1204 ],
1205 setf_get,
1206 kw_function,
1207 f_setf_get)).
1208*/
1209/*
1210:- failure(show_call_trace((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _7606, [sys_indicator, sys_default], CDR, Compile_each_Ret), append([[symbol_plist, symbol]|CDR], [CAR13, CAR], Append_Ret), setf_inverse_op(getf, Inverse_op_Ret)))).
1211*/
1212/*
1213:- failure(show_call_trace((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _7606, [sys_indicator, sys_default], CDR, Compile_each_Ret), append([[symbol_plist, symbol]|CDR], [CAR13, CAR], Append_Ret), setf_inverse_op(getf, Inverse_op_Ret)))).
1214*/
1215wl: declared(get, defun_setf(setf_get)).
1216
1217wl:lambda_def(defun, setf_get, f_setf_get, [sys_new_value, symbol, sys_indicator, c38_optional, sys_default], [[setf, [getf, [symbol_plist, symbol], sys_indicator, sys_default], sys_new_value]]).
1218wl:arglist_info(setf_get, f_setf_get, [sys_new_value, symbol, sys_indicator, c38_optional, sys_default], arginfo{all:[sys_new_value, symbol, sys_indicator, sys_default], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_new_value, symbol, sys_indicator, sys_default], opt:[sys_default], req:[sys_new_value, symbol, sys_indicator], rest:0, sublists:0, whole:0}).
1219wl: init_args(3, f_setf_get).
1220
1225f_setf_get(New_value_In, Symbol_In, Indicator_In, RestNKeys, FnResult) :-
1226 Setf_Env=[bv(sys_new_value, New_value_In), bv(symbol, Symbol_In), bv(sys_indicator, Indicator_In), bv(sys_default, Default_In)],
1227 opt_var(Env, sys_default, Default_In, true, [], 1, RestNKeys),
1228 catch(( ( get_var(Setf_Env, symbol, Symbol_Get),
1229 get_var(Setf_Env, sys_new_value, New_value_Get),
1230 f_symbol_plist(Symbol_Get, Symbol_plist_Ret),
1231 get_var(Setf_Env, sys_default, Default_Get),
1232 get_var(Setf_Env, sys_indicator, Indicator_Get),
1233 set_place(Setf_Env,
1234 setf,
1235 [getf, Symbol_plist_Ret, Indicator_Get, Default_Get],
1236 [New_value_Get],
1237 Setf_R)
1238 ),
1239 Setf_R=FnResult
1240 ),
1241 block_exit(setf_get, FnResult),
1242 true).
1243:- set_opv(setf_get, symbol_function, f_setf_get),
1244 DefunResult=setf_get. 1245/*
1246:- side_effect(assert_lsp(setf_get,
1247 lambda_def(defun,
1248 setf_get,
1249 f_setf_get,
1250
1251 [ sys_new_value,
1252 symbol,
1253 sys_indicator,
1254 c38_optional,
1255 sys_default
1256 ],
1257
1258 [
1259 [ setf,
1260
1261 [ getf,
1262 [symbol_plist, symbol],
1263 sys_indicator,
1264 sys_default
1265 ],
1266 sys_new_value
1267 ]
1268 ]))).
1269*/
1270/*
1271:- side_effect(assert_lsp(setf_get,
1272 arglist_info(setf_get,
1273 f_setf_get,
1274
1275 [ sys_new_value,
1276 symbol,
1277 sys_indicator,
1278 c38_optional,
1279 sys_default
1280 ],
1281 arginfo{ all:
1282 [ sys_new_value,
1283 symbol,
1284 sys_indicator,
1285 sys_default
1286 ],
1287 allow_other_keys:0,
1288 aux:0,
1289 body:0,
1290 complex:0,
1291 env:0,
1292 key:0,
1293 names:
1294 [ sys_new_value,
1295 symbol,
1296 sys_indicator,
1297 sys_default
1298 ],
1299 opt:[sys_default],
1300 req:
1301 [ sys_new_value,
1302 symbol,
1303 sys_indicator
1304 ],
1305 rest:0,
1306 sublists:0,
1307 whole:0
1308 }))).
1309*/
1310/*
1311:- side_effect(assert_lsp(setf_get, init_args(3, f_setf_get))).
1312*/
1313/*
1314#+(or WAM-CL LISP500)
1315(defun (setf rest) (new-tail list) (setf (cdr list) new-tail))
1316
1317;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1318;;;; BEGIN FILE ./remf.lisp
1319;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1320;;; remf.lisp
1321;;;
1322;;; Copyright (C) 2003-2005 Peter Graves
1323;;; $Id$
1324;;;
1325;;; This program is free software; you can redistribute it and/or
1326;;; modify it under the terms of the GNU General Public License
1327;;; as published by the Free Software Foundation; either version 2
1328;;; of the License, or (at your option) any later version.
1329;;;
1330;;; This program is distributed in the hope that it will be useful,
1331;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1332;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1333;;; GNU General Public License for more details.
1334;;;
1335;;; You should have received a copy of the GNU General Public License
1336;;; along with this program; if not, write to the Free Software
1337;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1338;;;
1339;;; As a special exception, the copyright holders of this library give you
1340;;; permission to link this library with independent modules to produce an
1341;;; executable, regardless of the license terms of these independent
1342;;; modules, and to copy and distribute the resulting executable under
1343;;; terms of your choice, provided that you also meet, for each linked
1344;;; independent module, the terms and conditions of the license of that
1345;;; module. An independent module is a module which is not derived from
1346;;; or based on this library. If you modify this library, you may extend
1347;;; this exception to your version of the library, but you are not
1348;;; obligated to do so. If you do not wish to do so, delete this
1349;;; exception statement from your version.
1350
1351;;; Adapted from SBCL.
1352
1353*/
1354
1355/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:3164 **********************/
1356:-lisp_compile_to_prolog(pkg_sys,[defun,[setf,rest],['new-tail',list],[setf,[cdr,list],'new-tail']])
1357/*
1358:- side_effect(generate_function_or_macro_name(
1359 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1360 name='GLOBAL',
1361 environ=env_1
1362 ],
1363 setf_rest,
1364 kw_function,
1365 f_setf_rest)).
1366*/
1367/*
1368:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _7796, [], [], true), append([list], [CAR7, CAR], [list, CAR7, CAR]), setf_inverse_op(cdr, rplacd))).
1369*/
1370/*
1371:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _7730, [], [], true), append([list], [CAR7, CAR], [list, CAR7, CAR]), setf_inverse_op(cdr, rplacd))).
1372*/
1373wl: declared(rest, defun_setf(setf_rest)).
1374
1375wl:lambda_def(defun, setf_rest, f_setf_rest, [sys_new_tail, list], [[setf, [cdr, list], sys_new_tail]]).
1376wl:arglist_info(setf_rest, f_setf_rest, [sys_new_tail, list], arginfo{all:[sys_new_tail, list], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_new_tail, list], opt:0, req:[sys_new_tail, list], rest:0, sublists:0, whole:0}).
1377wl: init_args(x, f_setf_rest).
1378
1383f_setf_rest(New_tail_In, List_In, FnResult) :-
1384 GEnv=[bv(sys_new_tail, New_tail_In), bv(list, List_In)],
1385 catch(( ( get_var(GEnv, list, List_Get),
1386 get_var(GEnv, sys_new_tail, New_tail_Get),
1387 f_rplacd(List_Get, New_tail_Get, Rplacd_Ret)
1388 ),
1389 Rplacd_Ret=FnResult
1390 ),
1391 block_exit(setf_rest, FnResult),
1392 true).
1393:- set_opv(setf_rest, symbol_function, f_setf_rest),
1394 DefunResult=setf_rest. 1395/*
1396:- side_effect(assert_lsp(setf_rest,
1397 lambda_def(defun,
1398 setf_rest,
1399 f_setf_rest,
1400 [sys_new_tail, list],
1401 [[setf, [cdr, list], sys_new_tail]]))).
1402*/
1403/*
1404:- side_effect(assert_lsp(setf_rest,
1405 arglist_info(setf_rest,
1406 f_setf_rest,
1407 [sys_new_tail, list],
1408 arginfo{ all:[sys_new_tail, list],
1409 allow_other_keys:0,
1410 aux:0,
1411 body:0,
1412 complex:0,
1413 env:0,
1414 key:0,
1415 names:[sys_new_tail, list],
1416 opt:0,
1417 req:[sys_new_tail, list],
1418 rest:0,
1419 sublists:0,
1420 whole:0
1421 }))).
1422*/
1423/*
1424:- side_effect(assert_lsp(setf_rest, init_args(x, f_setf_rest))).
1425*/
1426/*
1427;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1428*/
1429/*
1430;;; BEGIN FILE ./remf.lisp
1431*/
1432/*
1433;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1434*/
1435/*
1436;; remf.lisp
1437*/
1438/*
1439;;
1440*/
1441/*
1442;; Copyright (C) 2003-2005 Peter Graves
1443*/
1444/*
1445;; $Id$
1446*/
1447/*
1448;;
1449*/
1450/*
1451;; This program is free software; you can redistribute it and/or
1452*/
1453/*
1454;; modify it under the terms of the GNU General Public License
1455*/
1456/*
1457;; as published by the Free Software Foundation; either version 2
1458*/
1459/*
1460;; of the License, or (at your option) any later version.
1461*/
1462/*
1463;;
1464*/
1465/*
1466;; This program is distributed in the hope that it will be useful,
1467*/
1468/*
1469;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1470*/
1471/*
1472;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1473*/
1474/*
1475;; GNU General Public License for more details.
1476*/
1477/*
1478;;
1479*/
1480/*
1481;; You should have received a copy of the GNU General Public License
1482*/
1483/*
1484;; along with this program; if not, write to the Free Software
1485*/
1486/*
1487;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1488*/
1489/*
1490;;
1491*/
1492/*
1493;; As a special exception, the copyright holders of this library give you
1494*/
1495/*
1496;; permission to link this library with independent modules to produce an
1497*/
1498/*
1499;; executable, regardless of the license terms of these independent
1500*/
1501/*
1502;; modules, and to copy and distribute the resulting executable under
1503*/
1504/*
1505;; terms of your choice, provided that you also meet, for each linked
1506*/
1507/*
1508;; independent module, the terms and conditions of the license of that
1509*/
1510/*
1511;; module. An independent module is a module which is not derived from
1512*/
1513/*
1514;; or based on this library. If you modify this library, you may extend
1515*/
1516/*
1517;; this exception to your version of the library, but you are not
1518*/
1519/*
1520;; obligated to do so. If you do not wish to do so, delete this
1521*/
1522/*
1523;; exception statement from your version.
1524*/
1525/*
1526;; Adapted from SBCL.
1527*/
1528/*
1529(defmacro remf (place indicator &environment env)
1530 "Place may be any place expression acceptable to SETF, and is expected
1531 to hold a property list or (). This list is destructively altered to
1532 remove the property specified by the indicator. Returns T if such a
1533 property was present, NIL if not."
1534 (multiple-value-bind (dummies vals newval setter getter)
1535 (get-setf-expansion place env)
1536 (do* ((d dummies (cdr d))
1537 (v vals (cdr v))
1538 (let-list nil)
1539 (ind-temp (gensym))
1540 (local1 (gensym))
1541 (local2 (gensym)))
1542 ((null d)
1543 ;; See ANSI 5.1.3 for why we do out-of-order evaluation
1544 (push (list ind-temp indicator) let-list)
1545 (push (list (car newval) getter) let-list)
1546 `(let* ,(nreverse let-list)
1547 (do ((,local1 ,(car newval) (cddr ,local1))
1548 (,local2 nil ,local1))
1549 ((atom ,local1) nil)
1550 (cond ((atom (cdr ,local1))
1551 (error "Odd-length property list in REMF."))
1552 ((eq (car ,local1) ,ind-temp)
1553 (cond (,local2
1554 (rplacd (cdr ,local2) (cddr ,local1))
1555 (return t))
1556 (t (setq ,(car newval) (cddr ,(car newval)))
1557 ,setter
1558 (return t))))))))
1559 (push (list (car d) (car v)) let-list))))
1560;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1561;;;; END FILE ./remf.lisp
1562;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1563
1564
1565*/
1566
1567/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:5000 **********************/
1568:-lisp_compile_to_prolog(pkg_sys,[defmacro,remf,[place,indicator,'&environment',env],'$STRING'("Place may be any place expression acceptable to SETF, and is expected\r\n to hold a property list or (). This list is destructively altered to\r\n remove the property specified by the indicator. Returns T if such a\r\n property was present, NIL if not."),['multiple-value-bind',[dummies,vals,newval,setter,getter],['get-setf-expansion',place,env],['do*',[[d,dummies,[cdr,d]],[v,vals,[cdr,v]],['let-list',[]],['ind-temp',[gensym]],[local1,[gensym]],[local2,[gensym]]],[[null,d],[push,[list,'ind-temp',indicator],'let-list'],[push,[list,[car,newval],getter],'let-list'],['#BQ',['let*',['#COMMA',[nreverse,'let-list']],[do,[[['#COMMA',local1],['#COMMA',[car,newval]],[cddr,['#COMMA',local1]]],[['#COMMA',local2],[],['#COMMA',local1]]],[[atom,['#COMMA',local1]],[]],[cond,[[atom,[cdr,['#COMMA',local1]]],[error,'$STRING'("Odd-length property list in REMF.")]],[[eq,[car,['#COMMA',local1]],['#COMMA','ind-temp']],[cond,[['#COMMA',local2],[rplacd,[cdr,['#COMMA',local2]],[cddr,['#COMMA',local1]]],[return,t]],[t,[setq,['#COMMA',[car,newval]],[cddr,['#COMMA',[car,newval]]]],['#COMMA',setter],[return,t]]]]]]]]],[push,[list,[car,d],[car,v]],'let-list']]]])
1569/*
1570% macroexpand:-[push,[list,sys_ind_temp,sys_indicator],sys_let_list].
1571*/
1572/*
1573% into:-[setq,sys_let_list,[cons,[list,sys_ind_temp,sys_indicator],sys_let_list]].
1574*/
1575/*
1576% macroexpand:-[push,[list,[car,sys_newval],sys_getter],sys_let_list].
1577*/
1578/*
1579% into:-[setq,sys_let_list,[cons,[list,[car,sys_newval],sys_getter],sys_let_list]].
1580*/
1581/*
1582% macroexpand:-[push,[list,[car,sys_d],[car,sys_v]],sys_let_list].
1583*/
1584/*
1585% into:-[setq,sys_let_list,[cons,[list,[car,sys_d],[car,sys_v]],sys_let_list]].
1586*/
1587/*
1588% macroexpand:-[push,[list,sys_ind_temp,sys_indicator],sys_let_list].
1589*/
1590/*
1591% into:-[setq,sys_let_list,[cons,[list,sys_ind_temp,sys_indicator],sys_let_list]].
1592*/
1593/*
1594% macroexpand:-[push,[list,[car,sys_newval],sys_getter],sys_let_list].
1595*/
1596/*
1597% into:-[setq,sys_let_list,[cons,[list,[car,sys_newval],sys_getter],sys_let_list]].
1598*/
1599/*
1600% macroexpand:-[push,[list,[car,sys_d],[car,sys_v]],sys_let_list].
1601*/
1602/*
1603% into:-[setq,sys_let_list,[cons,[list,[car,sys_d],[car,sys_v]],sys_let_list]].
1604*/
1605/*
1606:- side_effect(generate_function_or_macro_name(
1607 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1608 name='GLOBAL',
1609 environ=env_1
1610 ],
1611 remf,
1612 kw_special,
1613 sf_remf)).
1614*/
1615doc: doc_string(remf,
1616 _9480,
1617 function,
1618 "Place may be any place expression acceptable to SETF, and is expected\r\n to hold a property list or (). This list is destructively altered to\r\n remove the property specified by the indicator. Returns T if such a\r\n property was present, NIL if not.").
1619
1620wl:lambda_def(defmacro, remf, mf_remf, [sys_place, sys_indicator, c38_environment, sys_env], [[multiple_value_bind, [sys_dummies, sys_vals, sys_newval, sys_setter, sys_getter], [get_setf_expansion, sys_place, sys_env], [do_xx, [[sys_d, sys_dummies, [cdr, sys_d]], [sys_v, sys_vals, [cdr, sys_v]], [sys_let_list, []], [sys_ind_temp, [gensym]], [sys_local1, [gensym]], [sys_local2, [gensym]]], [[null, sys_d], [push, [list, sys_ind_temp, sys_indicator], sys_let_list], [push, [list, [car, sys_newval], sys_getter], sys_let_list], ['#BQ', [let_xx, ['#COMMA', [nreverse, sys_let_list]], [do, [[['#COMMA', sys_local1], ['#COMMA', [car, sys_newval]], [cddr, ['#COMMA', sys_local1]]], [['#COMMA', sys_local2], [], ['#COMMA', sys_local1]]], [[atom, ['#COMMA', sys_local1]], []], [cond, [[atom, [cdr, ['#COMMA', sys_local1]]], [error, '$ARRAY'([*], claz_base_character, "Odd-length property list in REMF.")]], [[eq, [car, ['#COMMA', sys_local1]], ['#COMMA', sys_ind_temp]], [cond, [['#COMMA', sys_local2], [rplacd, [cdr, ['#COMMA', sys_local2]], [cddr, ['#COMMA', sys_local1]]], [return, t]], [t, [setq, ['#COMMA', [car, sys_newval]], [cddr, ['#COMMA', [car, sys_newval]]]], ['#COMMA', sys_setter], [return, t]]]]]]]]], [push, [list, [car, sys_d], [car, sys_v]], sys_let_list]]]]).
1621wl:arglist_info(remf, mf_remf, [sys_place, sys_indicator, c38_environment, sys_env], arginfo{all:[sys_place, sys_indicator], allow_other_keys:0, aux:0, body:0, complex:[environment], env:[sys_env], key:0, names:[sys_place, sys_indicator, sys_env], opt:0, req:[sys_place, sys_indicator], rest:0, sublists:0, whole:0}).
1622wl: init_args(2, mf_remf).
1623
1628sf_remf(Env_In, Place_In, Indicator_In, RestNKeys, FResult) :-
1629 mf_remf([remf, Place_In, Indicator_In|RestNKeys], Env_In, MFResult),
1630 f_sys_env_eval(Env_In, MFResult, FResult).
1635mf_remf([remf, Place_In, Indicator_In|RestNKeys], Env_In, MFResult) :-
1636 nop(defmacro),
1637 CDR=[bv(sys_place, Place_In), bv(sys_indicator, Indicator_In), bv(sys_env, Env_In)],
1638 catch(( ( LEnv=[bv(sys_dummies, []), bv(sys_vals, []), bv(sys_newval, []), bv(sys_setter, []), bv(sys_getter, [])|CDR],
1639 get_var(LEnv, sys_env, Env_Get),
1640 get_var(LEnv, sys_place, Place_Get),
1641 f_get_setf_expansion(Place_Get, [Env_Get], Setf_expansion_Ret),
1642 setq_from_values(LEnv,
1643
1644 [ sys_dummies,
1645 sys_vals,
1646 sys_newval,
1647 sys_setter,
1648 sys_getter
1649 ]),
1650 get_var(LEnv, sys_dummies, Dummies_Get),
1651 LEnv14=[bv(sys_d, Dummies_Get)|LEnv],
1652 get_var(LEnv14, sys_vals, Vals_Get),
1653 LEnv19=[bv(sys_v, Vals_Get)|LEnv14],
1654 LEnv24=[bv(sys_let_list, [])|LEnv19],
1655 f_gensym(Ind_temp_Init),
1656 LEnv27=[bv(sys_ind_temp, Ind_temp_Init)|LEnv24],
1657 f_gensym(Local1_Init),
1658 LEnv31=[bv(sys_local1, Local1_Init)|LEnv27],
1659 f_gensym(Local2_Init),
1660 BlockExitEnv=[bv(sys_local2, Local2_Init)|LEnv31],
1661 catch(( call_addr_block(BlockExitEnv,
1662 (push_label(do_label_34), get_var(BlockExitEnv, sys_d, IFTEST77), (IFTEST77==[]->get_var(BlockExitEnv, sys_ind_temp, Ind_temp_Get83), get_var(BlockExitEnv, sys_indicator, Indicator_Get84), CAR=[Ind_temp_Get83, Indicator_Get84], get_var(BlockExitEnv, sys_let_list, Let_list_Get85), Let_list=[CAR|Let_list_Get85], set_var(BlockExitEnv, sys_let_list, Let_list), get_var(BlockExitEnv, sys_newval, Newval_Get86), f_car(Newval_Get86, Car_Ret), get_var(BlockExitEnv, sys_getter, Getter_Get87), CAR128=[Car_Ret, Getter_Get87], get_var(BlockExitEnv, sys_let_list, Let_list_Get88), Let_list118=[CAR128|Let_list_Get88], set_var(BlockExitEnv, sys_let_list, Let_list118), get_var(BlockExitEnv, sys_let_list, Let_list_Get89), f_nreverse(Let_list_Get89, Nreverse_Ret), get_var(BlockExitEnv, sys_local1, Local1_Get90), get_var(BlockExitEnv, sys_newval, Newval_Get91), f_car(Newval_Get91, Car_Ret130), (get_var(BlockExitEnv, sys_ind_temp, Ind_temp_Get98), get_var(BlockExitEnv, sys_local1, Local1_Get92)), (get_var(BlockExitEnv, sys_local1, Local1_Get95), get_var(BlockExitEnv, sys_local2, Local2_Get93)), get_var(BlockExitEnv, sys_local2, Local2_Get99), get_var(BlockExitEnv, sys_newval, Newval_Get102), f_car(Newval_Get102, Car_Ret131), get_var(BlockExitEnv, sys_newval, Newval_Get103), f_car(Newval_Get103, Car_Ret132), get_var(BlockExitEnv, sys_setter, Setter_Get104), throw(block_exit([], [let_xx, Nreverse_Ret, [do, [[Local1_Get90, Car_Ret130, [cddr, Local1_Get92]], [Local2_Get93, [], Local1_Get92]], [[atom, Local1_Get95], []], [cond, [[atom, [cdr, Local1_Get95]], [error, '$ARRAY'([*], claz_base_character, "Odd-length property list in REMF.")]], [[eq, [car, Local1_Get95], Ind_temp_Get98], [cond, [Local2_Get99, [rplacd, [cdr, Local2_Get99], [cddr, Local1_Get95]], [return, t]], [t, [setq, Car_Ret131, [cddr, Car_Ret132]], Setter_Get104, [return, t]]]]]]])), _TBResult=ThrowResult81;get_var(BlockExitEnv, sys_d, D_Get106), f_car(D_Get106, Car_Ret133), get_var(BlockExitEnv, sys_v, V_Get107), f_car(V_Get107, Car_Ret134), CAR135=[Car_Ret133, Car_Ret134], get_var(BlockExitEnv, sys_let_list, Let_list_Get108), Let_list119=[CAR135|Let_list_Get108], set_var(BlockExitEnv, sys_let_list, Let_list119), get_var(BlockExitEnv, sys_d, D_Get109), f_cdr(D_Get109, D), get_var(BlockExitEnv, sys_v, V_Get110), f_cdr(V_Get110, V), set_var(BlockExitEnv, sys_d, D), set_var(BlockExitEnv, sys_v, V), goto(do_label_34, BlockExitEnv), _TBResult=_GORES111)),
1663
1664 [ addr(addr_tagbody_36_do_label_34,
1665 do_label_34,
1666 '$unused',
1667 BlockExitEnv,
1668 (get_var(BlockExitEnv, sys_d, IFTEST), (IFTEST==[]->get_var(BlockExitEnv, sys_ind_temp, Get_var_Ret), get_var(BlockExitEnv, sys_indicator, Get_var_Ret137), CAR139=[Get_var_Ret, Get_var_Ret137], get_var(BlockExitEnv, sys_let_list, Get_var_Ret138), Set_var_Ret=[CAR139|Get_var_Ret138], set_var(BlockExitEnv, sys_let_list, Set_var_Ret), get_var(BlockExitEnv, sys_newval, Car_Param), f_car(Car_Param, Car_Ret141), get_var(BlockExitEnv, sys_getter, Get_var_Ret142), CAR143=[Car_Ret141, Get_var_Ret142], get_var(BlockExitEnv, sys_let_list, Let_list_Get49), Set_var_Ret144=[CAR143|Let_list_Get49], set_var(BlockExitEnv, sys_let_list, Set_var_Ret144), get_var(BlockExitEnv, sys_let_list, Let_list_Get50), f_nreverse(Let_list_Get50, Nreverse_Ret145), get_var(BlockExitEnv, sys_local1, Get_var_Ret146), get_var(BlockExitEnv, sys_newval, Newval_Get52), f_car(Newval_Get52, Car_Ret147), (get_var(BlockExitEnv, sys_ind_temp, Ind_temp_Get59), get_var(BlockExitEnv, sys_local1, Local1_Get53)), (get_var(BlockExitEnv, sys_local1, Local1_Get56), get_var(BlockExitEnv, sys_local2, Get_var_Ret148)), get_var(BlockExitEnv, sys_local2, Local2_Get60), get_var(BlockExitEnv, sys_newval, Newval_Get63), f_car(Newval_Get63, Car_Ret149), get_var(BlockExitEnv, sys_newval, Newval_Get64), f_car(Newval_Get64, Car_Ret150), get_var(BlockExitEnv, sys_setter, Get_var_Ret151), throw(block_exit([], [let_xx, Nreverse_Ret145, [do, [[Get_var_Ret146, Car_Ret147, [cddr, Local1_Get53]], [Get_var_Ret148, [], Local1_Get53]], [[atom, Local1_Get56], []], [cond, [[atom, [cdr, Local1_Get56]], [error, '$ARRAY'([*], claz_base_character, "Odd-length property list in REMF.")]], [[eq, [car, Local1_Get56], Ind_temp_Get59], [cond, [Local2_Get60, [rplacd, [cdr, Local2_Get60], [cddr, Local1_Get56]], [return, t]], [t, [setq, Car_Ret149, [cddr, Car_Ret150]], Get_var_Ret151, [return, t]]]]]]])), _13122=ThrowResult;get_var(BlockExitEnv, sys_d, D_Get67), f_car(D_Get67, Car_Ret152), get_var(BlockExitEnv, sys_v, Car_Param123), f_car(Car_Param123, Car_Ret153), CAR154=[Car_Ret152, Car_Ret153], get_var(BlockExitEnv, sys_let_list, Let_list_Get69), Set_var_Ret155=[CAR154|Let_list_Get69], set_var(BlockExitEnv, sys_let_list, Set_var_Ret155), get_var(BlockExitEnv, sys_d, D_Get70), f_cdr(D_Get70, Cdr_Ret), get_var(BlockExitEnv, sys_v, V_Get71), f_cdr(V_Get71, Cdr_Ret157), set_var(BlockExitEnv, sys_d, Cdr_Ret), set_var(BlockExitEnv, sys_v, Cdr_Ret157), goto(do_label_34, BlockExitEnv), _13122=_GORES)))
1669 ]),
1670 []=LetResult13
1671 ),
1672 block_exit([], LetResult13),
1673 true)
1674 ),
1675 LetResult13=MFResult
1676 ),
1677 block_exit(remf, MFResult),
1678 true).
1679:- set_opv(mf_remf, type_of, sys_macro),
1680 set_opv(remf, symbol_function, mf_remf),
1681 DefMacroResult=remf. 1682/*
1683:- side_effect(assert_lsp(remf,
1684 doc_string(remf,
1685 _9480,
1686 function,
1687 "Place may be any place expression acceptable to SETF, and is expected\r\n to hold a property list or (). This list is destructively altered to\r\n remove the property specified by the indicator. Returns T if such a\r\n property was present, NIL if not."))).
1688*/
1689/*
1690:- side_effect(assert_lsp(remf,
1691 lambda_def(defmacro,
1692 remf,
1693 mf_remf,
1694
1695 [ sys_place,
1696 sys_indicator,
1697 c38_environment,
1698 sys_env
1699 ],
1700
1701 [
1702 [ multiple_value_bind,
1703
1704 [ sys_dummies,
1705 sys_vals,
1706 sys_newval,
1707 sys_setter,
1708 sys_getter
1709 ],
1710
1711 [ get_setf_expansion,
1712 sys_place,
1713 sys_env
1714 ],
1715
1716 [ do_xx,
1717
1718 [ [sys_d, sys_dummies, [cdr, sys_d]],
1719 [sys_v, sys_vals, [cdr, sys_v]],
1720 [sys_let_list, []],
1721 [sys_ind_temp, [gensym]],
1722 [sys_local1, [gensym]],
1723 [sys_local2, [gensym]]
1724 ],
1725
1726 [ [null, sys_d],
1727
1728 [ push,
1729
1730 [ list,
1731 sys_ind_temp,
1732 sys_indicator
1733 ],
1734 sys_let_list
1735 ],
1736
1737 [ push,
1738
1739 [ list,
1740 [car, sys_newval],
1741 sys_getter
1742 ],
1743 sys_let_list
1744 ],
1745
1746 [ '#BQ',
1747
1748 [ let_xx,
1749
1750 [ '#COMMA',
1751 [nreverse, sys_let_list]
1752 ],
1753
1754 [ do,
1755
1756 [
1757 [ ['#COMMA', sys_local1],
1758
1759 [ '#COMMA',
1760 [car, sys_newval]
1761 ],
1762
1763 [ cddr,
1764 ['#COMMA', sys_local1]
1765 ]
1766 ],
1767
1768 [ ['#COMMA', sys_local2],
1769 [],
1770 ['#COMMA', sys_local1]
1771 ]
1772 ],
1773
1774 [
1775 [ atom,
1776 ['#COMMA', sys_local1]
1777 ],
1778 []
1779 ],
1780
1781 [ cond,
1782
1783 [
1784 [ atom,
1785
1786 [ cdr,
1787
1788 [ '#COMMA',
1789 sys_local1
1790 ]
1791 ]
1792 ],
1793
1794 [ error,
1795 '$ARRAY'([*],
1796 claz_base_character,
1797 "Odd-length property list in REMF.")
1798 ]
1799 ],
1800
1801 [
1802 [ eq,
1803
1804 [ car,
1805
1806 [ '#COMMA',
1807 sys_local1
1808 ]
1809 ],
1810
1811 [ '#COMMA',
1812 sys_ind_temp
1813 ]
1814 ],
1815
1816 [ cond,
1817
1818 [
1819 [ '#COMMA',
1820 sys_local2
1821 ],
1822
1823 [ rplacd,
1824
1825 [ cdr,
1826
1827 [ '#COMMA',
1828 sys_local2
1829 ]
1830 ],
1831
1832 [ cddr,
1833
1834 [ '#COMMA',
1835 sys_local1
1836 ]
1837 ]
1838 ],
1839 [return, t]
1840 ],
1841
1842 [ t,
1843
1844 [ setq,
1845
1846 [ '#COMMA',
1847 [car, sys_newval]
1848 ],
1849
1850 [ cddr,
1851
1852 [ '#COMMA',
1853 [car, sys_newval]
1854 ]
1855 ]
1856 ],
1857
1858 [ '#COMMA',
1859 sys_setter
1860 ],
1861 [return, t]
1862 ]
1863 ]
1864 ]
1865 ]
1866 ]
1867 ]
1868 ]
1869 ],
1870
1871 [ push,
1872 [list, [car, sys_d], [car, sys_v]],
1873 sys_let_list
1874 ]
1875 ]
1876 ]
1877 ]))).
1878*/
1879/*
1880:- side_effect(assert_lsp(remf,
1881 arglist_info(remf,
1882 mf_remf,
1883
1884 [ sys_place,
1885 sys_indicator,
1886 c38_environment,
1887 sys_env
1888 ],
1889 arginfo{ all:[sys_place, sys_indicator],
1890 allow_other_keys:0,
1891 aux:0,
1892 body:0,
1893 complex:[environment],
1894 env:[sys_env],
1895 key:0,
1896 names:
1897 [ sys_place,
1898 sys_indicator,
1899 sys_env
1900 ],
1901 opt:0,
1902 req:[sys_place, sys_indicator],
1903 rest:0,
1904 sublists:0,
1905 whole:0
1906 }))).
1907*/
1908/*
1909:- side_effect(assert_lsp(remf, init_args(2, mf_remf))).
1910*/
1911/*
1912; See ANSI 5.1.3 for why we do out-of-order evaluation
1913*/
1914/*
1915;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1916*/
1917/*
1918;;; END FILE ./remf.lisp
1919*/
1920/*
1921;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1922*/
1923/*
1924#+(or WAM-CL LISP500)
1925(defmacro remprop (symbol indicator) `(remf (symbol-plist ,symbol) ,indicator))
1926
1927*/
1928
1929/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:6358 **********************/
1930:-lisp_compile_to_prolog(pkg_sys,[defmacro,remprop,[symbol,indicator],['#BQ',[remf,['symbol-plist',['#COMMA',symbol]],['#COMMA',indicator]]]])
1931/*
1932:- side_effect(generate_function_or_macro_name(
1933 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1934 name='GLOBAL',
1935 environ=env_1
1936 ],
1937 remprop,
1938 kw_macro,
1939 mf_remprop)).
1940*/
1941wl:lambda_def(defmacro, remprop, mf_remprop, [symbol, sys_indicator], [['#BQ', [remf, [symbol_plist, ['#COMMA', symbol]], ['#COMMA', sys_indicator]]]]).
1942wl:arglist_info(remprop, mf_remprop, [symbol, sys_indicator], arginfo{all:[symbol, sys_indicator], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[symbol, sys_indicator], opt:0, req:[symbol, sys_indicator], rest:0, sublists:0, whole:0}).
1943wl: init_args(2, mf_remprop).
1944
1949f_remprop(MacroEnv, Symbol_In, Indicator_In, RestNKeys, FResult) :-
1950 mf_remprop([remprop, Symbol_In, Indicator_In|RestNKeys],
1951 MacroEnv,
1952 MFResult),
1953 f_sys_env_eval(MacroEnv, MFResult, FResult).
1958mf_remprop([remprop, Symbol_In, Indicator_In|RestNKeys], MacroEnv, MFResult) :-
1959 nop(defmacro),
1960 GEnv=[bv(symbol, Symbol_In), bv(sys_indicator, Indicator_In)],
1961 catch(( ( get_var(GEnv, symbol, Symbol_Get),
1962 get_var(GEnv, sys_indicator, Indicator_Get)
1963 ),
1964 [remf, [symbol_plist, Symbol_Get], Indicator_Get]=MFResult
1965 ),
1966 block_exit(remprop, MFResult),
1967 true).
1968:- set_opv(mf_remprop, type_of, sys_macro),
1969 set_opv(remprop, symbol_function, mf_remprop),
1970 DefMacroResult=remprop. 1971/*
1972:- side_effect(assert_lsp(remprop,
1973 lambda_def(defmacro,
1974 remprop,
1975 mf_remprop,
1976 [symbol, sys_indicator],
1977
1978 [
1979 [ '#BQ',
1980
1981 [ remf,
1982 [symbol_plist, ['#COMMA', symbol]],
1983 ['#COMMA', sys_indicator]
1984 ]
1985 ]
1986 ]))).
1987*/
1988/*
1989:- side_effect(assert_lsp(remprop,
1990 arglist_info(remprop,
1991 mf_remprop,
1992 [symbol, sys_indicator],
1993 arginfo{ all:[symbol, sys_indicator],
1994 allow_other_keys:0,
1995 aux:0,
1996 body:0,
1997 complex:0,
1998 env:0,
1999 key:0,
2000 names:[symbol, sys_indicator],
2001 opt:0,
2002 req:[symbol, sys_indicator],
2003 rest:0,
2004 sublists:0,
2005 whole:0
2006 }))).
2007*/
2008/*
2009:- side_effect(assert_lsp(remprop, init_args(2, mf_remprop))).
2010*/
2011/*
2012#+BUILTIN
2013#+(or WAM-CL LISP500)
2014(defun makunbound (symbol) (imakunbound symbol 4))
2015
2016*/
2017
2018/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:6464 **********************/
2019:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,makunbound,[symbol],[imakunbound,symbol,4]]]]))
2020/*
2021#+BUILTIN
2022#+(or WAM-CL LISP500)
2023(defun set (symbol value) (setf (symbol-value symbol) value))
2024
2025*/
2026
2027/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:6553 **********************/
2028:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,set,[symbol,value],[setf,['symbol-value',symbol],value]]]]))
2029/*
2030#+(or WAM-CL LISP500)
2031(defun designator-string (designator)
2032 (if (stringp designator)
2033 designator
2034 (if (characterp designator)
2035 (string designator)
2036 (symbol-name designator))))
2037
2038*/
2039
2040/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:6653 **********************/
2041:-lisp_compile_to_prolog(pkg_sys,[defun,'designator-string',[designator],[if,[stringp,designator],designator,[if,[characterp,designator],[string,designator],['symbol-name',designator]]]])
2042/*
2043:- side_effect(generate_function_or_macro_name(
2044 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
2045 name='GLOBAL',
2046 environ=env_1
2047 ],
2048 sys_designator_string,
2049 kw_function,
2050 f_sys_designator_string)).
2051*/
2052wl:lambda_def(defun, sys_designator_string, f_sys_designator_string, [sys_designator], [[if, [stringp, sys_designator], sys_designator, [if, [characterp, sys_designator], [string, sys_designator], [symbol_name, sys_designator]]]]).
2053wl:arglist_info(sys_designator_string, f_sys_designator_string, [sys_designator], arginfo{all:[sys_designator], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_designator], opt:0, req:[sys_designator], rest:0, sublists:0, whole:0}).
2054wl: init_args(x, f_sys_designator_string).
2055
2060f_sys_designator_string(Designator_In, FnResult) :-
2061 GEnv=[bv(sys_designator, Designator_In)],
2062 catch(( ( get_var(GEnv, sys_designator, Designator_Get),
2063 ( is_stringp(Designator_Get)
2064 -> get_var(GEnv, sys_designator, Designator_Get9),
2065 _9928=Designator_Get9
2066 ; get_var(GEnv, sys_designator, Designator_Get11),
2067 ( string:is_characterp(Designator_Get11)
2068 -> get_var(GEnv, sys_designator, Designator_Get14),
2069 f_string(Designator_Get14, TrueResult),
2070 ElseResult19=TrueResult
2071 ; get_var(GEnv, sys_designator, Designator_Get15),
2072 f_symbol_name(Designator_Get15, ElseResult),
2073 ElseResult19=ElseResult
2074 ),
2075 _9928=ElseResult19
2076 )
2077 ),
2078 _9928=FnResult
2079 ),
2080 block_exit(sys_designator_string, FnResult),
2081 true).
2082:- set_opv(sys_designator_string, symbol_function, f_sys_designator_string),
2083 DefunResult=sys_designator_string. 2084/*
2085:- side_effect(assert_lsp(sys_designator_string,
2086 lambda_def(defun,
2087 sys_designator_string,
2088 f_sys_designator_string,
2089 [sys_designator],
2090
2091 [
2092 [ if,
2093 [stringp, sys_designator],
2094 sys_designator,
2095
2096 [ if,
2097 [characterp, sys_designator],
2098 [string, sys_designator],
2099 [symbol_name, sys_designator]
2100 ]
2101 ]
2102 ]))).
2103*/
2104/*
2105:- side_effect(assert_lsp(sys_designator_string,
2106 arglist_info(sys_designator_string,
2107 f_sys_designator_string,
2108 [sys_designator],
2109 arginfo{ all:[sys_designator],
2110 allow_other_keys:0,
2111 aux:0,
2112 body:0,
2113 complex:0,
2114 env:0,
2115 key:0,
2116 names:[sys_designator],
2117 opt:0,
2118 req:[sys_designator],
2119 rest:0,
2120 sublists:0,
2121 whole:0
2122 }))).
2123*/
2124/*
2125:- side_effect(assert_lsp(sys_designator_string,
2126 init_args(x, f_sys_designator_string))).
2127*/
2128/*
2129#+BUILTIN
2130#+(or WAM-CL LISP500)
2131(defvar *package* (car (cdr *packages*)))
2132
2133*/
2134
2135/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:6854 **********************/
2136:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defvar,'*package*',[car,[cdr,'*packages*']]]]]))
2137/*
2138#+(or WAM-CL LISP500)
2139(defun list-all-packages ()
2140 (copy-list *packages*))
2141
2142*/
2143
2144/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:6934 **********************/
2145:-lisp_compile_to_prolog(pkg_sys,[defun,'list-all-packages',[],['copy-list','*packages*']])
2146wl:lambda_def(defun, list_all_packages, f_list_all_packages, [], [[copy_list, sys_xx_packages_xx]]).
2147wl:arglist_info(list_all_packages, f_list_all_packages, [], 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}).
2148wl: init_args(x, f_list_all_packages).
2149
2154f_list_all_packages(FnResult) :-
2155 GEnv=[],
2156 catch(( ( get_var(GEnv, sys_xx_packages_xx, Xx_packages_xx_Get),
2157 f_copy_list(Xx_packages_xx_Get, Copy_list_Ret)
2158 ),
2159 Copy_list_Ret=FnResult
2160 ),
2161 block_exit(list_all_packages, FnResult),
2162 true).
2163:- set_opv(list_all_packages, symbol_function, f_list_all_packages),
2164 DefunResult=list_all_packages. 2165/*
2166:- side_effect(assert_lsp(list_all_packages,
2167 lambda_def(defun,
2168 list_all_packages,
2169 f_list_all_packages,
2170 [],
2171 [[copy_list, sys_xx_packages_xx]]))).
2172*/
2173/*
2174:- side_effect(assert_lsp(list_all_packages,
2175 arglist_info(list_all_packages,
2176 f_list_all_packages,
2177 [],
2178 arginfo{ all:0,
2179 allow_other_keys:0,
2180 aux:0,
2181 body:0,
2182 complex:0,
2183 env:0,
2184 key:0,
2185 names:[],
2186 opt:0,
2187 req:0,
2188 rest:0,
2189 sublists:0,
2190 whole:0
2191 }))).
2192*/
2193/*
2194:- side_effect(assert_lsp(list_all_packages, init_args(x, f_list_all_packages))).
2195*/
2196/*
2197#+(or WAM-CL LISP500)
2198(defun /= (number &rest numbers)
2199 (tagbody
2200 start
2201 (when numbers
2202 (dolist (n numbers)
2203 (when (= number n)
2204 (return-from /=)))
2205 (setq number (pop numbers))
2206 (go start)))
2207 t)
2208
2209
2210
2211*/
2212
2213/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:7015 **********************/
2214:-lisp_compile_to_prolog(pkg_sys,[defun,/=,[number,'&rest',numbers],[tagbody,start,[when,numbers,[dolist,[n,numbers],[when,[=,number,n],['return-from',/=]]],[setq,number,[pop,numbers]],[go,start]]],t])
2215/*
2216% macroexpand:-[pop,sys_numbers].
2217*/
2218/*
2219% into:-[prog1,[car,sys_numbers],[setq,sys_numbers,[cdr,sys_numbers]]].
2220*/
2221/*
2222% macroexpand:-[pop,sys_numbers].
2223*/
2224/*
2225% into:-[prog1,[car,sys_numbers],[setq,sys_numbers,[cdr,sys_numbers]]].
2226*/
2227wl:lambda_def(defun, /=, f_c47_c61, [number, c38_rest, sys_numbers], [[tagbody, sys_start, [when, sys_numbers, [dolist, [sys_n, sys_numbers], [when, [=, number, sys_n], [return_from, /=]]], [setq, number, [pop, sys_numbers]], [go, sys_start]]], t]).
2228wl:arglist_info(/=, f_c47_c61, [number, c38_rest, sys_numbers], arginfo{all:[number], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[number, sys_numbers], opt:0, req:[number], rest:[sys_numbers], sublists:0, whole:0}).
2229wl: init_args(1, f_c47_c61).
2230
2235f_c47_c61(Number_In, RestNKeys, FnResult) :-
2236 AEnv=[bv(number, Number_In), bv(sys_numbers, RestNKeys)],
2237 catch(( call_addr_block(AEnv,
2238 (push_label(sys_start), get_var(AEnv, sys_numbers, IFTEST31), (IFTEST31\==[]->get_var(AEnv, sys_numbers, Numbers_Get34), BV44=bv(sys_n, Ele46), BlockExitEnv42=[BV44|AEnv], forall(member(Ele46, Numbers_Get34), (nb_setarg(2, BV44, Ele46), get_var(BlockExitEnv42, number, Number_Get36), get_var(BlockExitEnv42, sys_n, N_Get37), (Number_Get36=:=N_Get37->set_var(BlockExitEnv42, 'block_ret_/=', []), always('block_exit_/=', BlockExitEnv42);_7954=[]))), get_var(AEnv, sys_numbers, Numbers_Get49), f_car(Numbers_Get49, Number), get_var(AEnv, sys_numbers, Numbers_Get51), f_cdr(Numbers_Get51, Numbers), set_var(AEnv, sys_numbers, Numbers), set_var(AEnv, number, Number), goto(sys_start, AEnv), _TBResult=_GORES52;_TBResult=[])),
2239
2240 [ addr(addr_tagbody_37_sys_start,
2241 sys_start,
2242 '$unused',
2243 AEnv,
2244 (get_var(AEnv, sys_numbers, IFTEST), (IFTEST\==[]->get_var(AEnv, sys_numbers, Numbers_Get10), CAR=bv(sys_n, Member_Param), BlockExitEnv=[CAR|AEnv], forall(member(Member_Param, Numbers_Get10), (nb_setarg(2, CAR, Member_Param), get_var(BlockExitEnv, number, Number_Get), get_var(BlockExitEnv, sys_n, N_Get), (Number_Get=:=N_Get->set_var(BlockExitEnv, 'block_ret_/=', []), always('block_exit_/=', BlockExitEnv);_8518=[]))), get_var(AEnv, sys_numbers, Numbers_Get25), f_car(Numbers_Get25, Car_Ret), get_var(AEnv, sys_numbers, Numbers_Get26), f_cdr(Numbers_Get26, Cdr_Ret), set_var(AEnv, sys_numbers, Cdr_Ret), set_var(AEnv, number, Car_Ret), goto(sys_start, AEnv), _8552=_GORES;_8552=[])))
2245 ]),
2246 t=FnResult
2247 ),
2248 block_exit(/=, FnResult),
2249 true).
2250:- set_opv(/=, symbol_function, f_c47_c61),
2251 DefunResult= /= . 2252/*
2253:- side_effect(assert_lsp(/=,
2254 lambda_def(defun,
2255 /=,
2256 f_c47_c61,
2257 [number, c38_rest, sys_numbers],
2258
2259 [
2260 [ tagbody,
2261 sys_start,
2262
2263 [ when,
2264 sys_numbers,
2265
2266 [ dolist,
2267 [sys_n, sys_numbers],
2268
2269 [ when,
2270 [=, number, sys_n],
2271 [return_from, /=]
2272 ]
2273 ],
2274 [setq, number, [pop, sys_numbers]],
2275 [go, sys_start]
2276 ]
2277 ],
2278 t
2279 ]))).
2280*/
2281/*
2282:- side_effect(assert_lsp(/=,
2283 arglist_info(/=,
2284 f_c47_c61,
2285 [number, c38_rest, sys_numbers],
2286 arginfo{ all:[number],
2287 allow_other_keys:0,
2288 aux:0,
2289 body:0,
2290 complex:[rest],
2291 env:0,
2292 key:0,
2293 names:[number, sys_numbers],
2294 opt:0,
2295 req:[number],
2296 rest:[sys_numbers],
2297 sublists:0,
2298 whole:0
2299 }))).
2300*/
2301/*
2302:- side_effect(assert_lsp(/=, init_args(1, f_c47_c61))).
2303*/
2304/*
2305#+BUILTIN
2306#+(or WAM-CL LISP500)
2307(defun > (&rest numbers) (apply #'< (reverse numbers)))
2308
2309
2310*/
2311
2312/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:7257 **********************/
2313:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,>,['&rest',numbers],[apply,function(<),[reverse,numbers]]]]]))
2314/*
2315#+BUILTIN
2316#+(or WAM-CL LISP500)
2317(defun <= (number &rest numbers)
2318 (dolist (n numbers t)
2319 (when (< n number)
2320 (return-from <=))
2321 (setq number n)))
2322
2323*/
2324
2325/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:7353 **********************/
2326:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,<=,[number,'&rest',numbers],[dolist,[n,numbers,t],[when,[<,n,number],['return-from',<=]],[setq,number,n]]]]]))
2327/*
2328#+BUILTIN
2329#+(or WAM-CL LISP500)
2330(defun >= (number &rest numbers)
2331 (dolist (n numbers t)
2332 (when (< number n)
2333 (return-from >=))
2334 (setq number n)))
2335
2336*/
2337
2338/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:7521 **********************/
2339:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,>=,[number,'&rest',numbers],[dolist,[n,numbers,t],[when,[<,number,n],['return-from',>=]],[setq,number,n]]]]]))
2340/*
2341#+BUILTIN
2342#+(or WAM-CL LISP500)
2343(defun max (real &rest reals)
2344 (dolist (r reals real)
2345 (when (< real r)
2346 (setq real r))))
2347
2348*/
2349
2350/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:7689 **********************/
2351:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,max,[real,'&rest',reals],[dolist,[r,reals,real],[when,[<,real,r],[setq,real,r]]]]]]))
2352/*
2353#+BUILTIN
2354#+(or WAM-CL LISP500)
2355(defun min (real &rest reals)
2356 (dolist (r reals real)
2357 (when (< r real)
2358 (setq real r))))
2359
2360*/
2361
2362/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:7829 **********************/
2363:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,min,[real,'&rest',reals],[dolist,[r,reals,real],[when,[<,r,real],[setq,real,r]]]]]]))
2364/*
2365#+BUILTIN
2366#+(or WAM-CL LISP500)
2367(defun oddp (integer)
2368 (= (mod integer 2) 1))
2369
2370*/
2371
2372/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:7969 **********************/
2373:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,oddp,[integer],[=,[mod,integer,2],1]]]]))
2374/*
2375#+BUILTIN
2376#+(or WAM-CL LISP500)
2377(defun evenp (integer)
2378 (= (mod integer 2) 0))
2379
2380
2381*/
2382
2383/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8055 **********************/
2384:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,evenp,[integer],[=,[mod,integer,2],0]]]]))
2385/*
2386#+(or WAM-CL LISP500)
2387(defun minusp (real)
2388 (< real 0))
2389
2390
2391*/
2392
2393/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8144 **********************/
2394:-lisp_compile_to_prolog(pkg_sys,[defun,minusp,[real],[<,real,0]])
2395wl:lambda_def(defun, minusp, f_minusp, [real], [[<, real, 0]]).
2396wl:arglist_info(minusp, f_minusp, [real], arginfo{all:[real], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[real], opt:0, req:[real], rest:0, sublists:0, whole:0}).
2397wl: init_args(x, f_minusp).
2398
2403f_minusp(Real_In, FnResult) :-
2404 GEnv=[bv(real, Real_In)],
2405 catch(( ( get_var(GEnv, real, Real_Get),
2406 'f_<'(Real_Get, 0, _9014)
2407 ),
2408 _9014=FnResult
2409 ),
2410 block_exit(minusp, FnResult),
2411 true).
2412:- set_opv(minusp, symbol_function, f_minusp),
2413 DefunResult=minusp. 2414/*
2415:- side_effect(assert_lsp(minusp,
2416 lambda_def(defun,
2417 minusp,
2418 f_minusp,
2419 [real],
2420 [[<, real, 0]]))).
2421*/
2422/*
2423:- side_effect(assert_lsp(minusp,
2424 arglist_info(minusp,
2425 f_minusp,
2426 [real],
2427 arginfo{ all:[real],
2428 allow_other_keys:0,
2429 aux:0,
2430 body:0,
2431 complex:0,
2432 env:0,
2433 key:0,
2434 names:[real],
2435 opt:0,
2436 req:[real],
2437 rest:0,
2438 sublists:0,
2439 whole:0
2440 }))).
2441*/
2442/*
2443:- side_effect(assert_lsp(minusp, init_args(x, f_minusp))).
2444*/
2445/*
2446#+(or WAM-CL LISP500)
2447(defun plusp (real)
2448 (< 0 real))
2449
2450
2451*/
2452
2453/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8209 **********************/
2454:-lisp_compile_to_prolog(pkg_sys,[defun,plusp,[real],[<,0,real]])
2455wl:lambda_def(defun, plusp, f_plusp, [real], [[<, 0, real]]).
2456wl:arglist_info(plusp, f_plusp, [real], arginfo{all:[real], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[real], opt:0, req:[real], rest:0, sublists:0, whole:0}).
2457wl: init_args(x, f_plusp).
2458
2463f_plusp(Real_In, FnResult) :-
2464 GEnv=[bv(real, Real_In)],
2465 catch(( ( get_var(GEnv, real, Real_Get),
2466 'f_<'(0, Real_Get, _8818)
2467 ),
2468 _8818=FnResult
2469 ),
2470 block_exit(plusp, FnResult),
2471 true).
2472:- set_opv(plusp, symbol_function, f_plusp),
2473 DefunResult=plusp. 2474/*
2475:- side_effect(assert_lsp(plusp,
2476 lambda_def(defun, plusp, f_plusp, [real], [[<, 0, real]]))).
2477*/
2478/*
2479:- side_effect(assert_lsp(plusp,
2480 arglist_info(plusp,
2481 f_plusp,
2482 [real],
2483 arginfo{ all:[real],
2484 allow_other_keys:0,
2485 aux:0,
2486 body:0,
2487 complex:0,
2488 env:0,
2489 key:0,
2490 names:[real],
2491 opt:0,
2492 req:[real],
2493 rest:0,
2494 sublists:0,
2495 whole:0
2496 }))).
2497*/
2498/*
2499:- side_effect(assert_lsp(plusp, init_args(x, f_plusp))).
2500*/
2501/*
2502#+(or WAM-CL LISP500)
2503(defun zerop (real)
2504 (= real 0))
2505
2506
2507*/
2508
2509/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8273 **********************/
2510:-lisp_compile_to_prolog(pkg_sys,[defun,zerop,[real],[=,real,0]])
2511wl:lambda_def(defun, zerop, f_zerop, [real], [[=, real, 0]]).
2512wl:arglist_info(zerop, f_zerop, [real], arginfo{all:[real], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[real], opt:0, req:[real], rest:0, sublists:0, whole:0}).
2513wl: init_args(x, f_zerop).
2514
2519f_zerop(Real_In, FnResult) :-
2520 GEnv=[bv(real, Real_In)],
2521 catch(( ( get_var(GEnv, real, Real_Get),
2522 'f_='(Real_Get, 0, _8818)
2523 ),
2524 _8818=FnResult
2525 ),
2526 block_exit(zerop, FnResult),
2527 true).
2528:- set_opv(zerop, symbol_function, f_zerop),
2529 DefunResult=zerop. 2530/*
2531:- side_effect(assert_lsp(zerop,
2532 lambda_def(defun, zerop, f_zerop, [real], [[=, real, 0]]))).
2533*/
2534/*
2535:- side_effect(assert_lsp(zerop,
2536 arglist_info(zerop,
2537 f_zerop,
2538 [real],
2539 arginfo{ all:[real],
2540 allow_other_keys:0,
2541 aux:0,
2542 body:0,
2543 complex:0,
2544 env:0,
2545 key:0,
2546 names:[real],
2547 opt:0,
2548 req:[real],
2549 rest:0,
2550 sublists:0,
2551 whole:0
2552 }))).
2553*/
2554/*
2555:- side_effect(assert_lsp(zerop, init_args(x, f_zerop))).
2556*/
2557/*
2558#+(or WAM-CL LISP500)
2559(defun abs (number)
2560 (if (< number 0)
2561 (- number)
2562 number))
2563
2564
2565
2566*/
2567
2568/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8337 **********************/
2569:-lisp_compile_to_prolog(pkg_sys,[defun,abs,[number],[if,[<,number,0],[-,number],number]])
2570wl:lambda_def(defun, abs, f_abs, [number], [[if, [<, number, 0], [-, number], number]]).
2571wl:arglist_info(abs, f_abs, [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}).
2572wl: init_args(x, f_abs).
2573
2578f_abs(Number_In, FnResult) :-
2579 GEnv=[bv(number, Number_In)],
2580 catch(( ( get_var(GEnv, number, Number_Get),
2581 ( Number_Get<0
2582 -> get_var(GEnv, number, Number_Get9),
2583 'f_-'(0, Number_Get9, TrueResult),
2584 _9272=TrueResult
2585 ; get_var(GEnv, number, Number_Get10),
2586 _9272=Number_Get10
2587 )
2588 ),
2589 _9272=FnResult
2590 ),
2591 block_exit(abs, FnResult),
2592 true).
2593:- set_opv(abs, symbol_function, f_abs),
2594 DefunResult=abs. 2595/*
2596:- side_effect(assert_lsp(abs,
2597 lambda_def(defun,
2598 abs,
2599 f_abs,
2600 [number],
2601 [[if, [<, number, 0], [-, number], number]]))).
2602*/
2603/*
2604:- side_effect(assert_lsp(abs,
2605 arglist_info(abs,
2606 f_abs,
2607 [number],
2608 arginfo{ all:[number],
2609 allow_other_keys:0,
2610 aux:0,
2611 body:0,
2612 complex:0,
2613 env:0,
2614 key:0,
2615 names:[number],
2616 opt:0,
2617 req:[number],
2618 rest:0,
2619 sublists:0,
2620 whole:0
2621 }))).
2622*/
2623/*
2624:- side_effect(assert_lsp(abs, init_args(x, f_abs))).
2625*/
2626/*
2627#+(or WAM-CL LISP500)
2628(defun byte (size position)
2629 (cons size position))
2630
2631*/
2632
2633/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8442 **********************/
2634:-lisp_compile_to_prolog(pkg_sys,[defun,byte,[size,position],[cons,size,position]])
2635wl:lambda_def(defun, byte, f_byte, [sys_size, position], [[cons, sys_size, position]]).
2636wl:arglist_info(byte, f_byte, [sys_size, position], arginfo{all:[sys_size, position], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_size, position], opt:0, req:[sys_size, position], rest:0, sublists:0, whole:0}).
2637wl: init_args(x, f_byte).
2638
2643f_byte(Size_In, Position_In, FnResult) :-
2644 GEnv=[bv(sys_size, Size_In), bv(position, Position_In)],
2645 catch(( ( get_var(GEnv, position, Position_Get),
2646 get_var(GEnv, sys_size, Size_Get),
2647 _9768=[Size_Get|Position_Get]
2648 ),
2649 _9768=FnResult
2650 ),
2651 block_exit(byte, FnResult),
2652 true).
2653:- set_opv(byte, symbol_function, f_byte),
2654 DefunResult=byte. 2655/*
2656:- side_effect(assert_lsp(byte,
2657 lambda_def(defun,
2658 byte,
2659 f_byte,
2660 [sys_size, position],
2661 [[cons, sys_size, position]]))).
2662*/
2663/*
2664:- side_effect(assert_lsp(byte,
2665 arglist_info(byte,
2666 f_byte,
2667 [sys_size, position],
2668 arginfo{ all:[sys_size, position],
2669 allow_other_keys:0,
2670 aux:0,
2671 body:0,
2672 complex:0,
2673 env:0,
2674 key:0,
2675 names:[sys_size, position],
2676 opt:0,
2677 req:[sys_size, position],
2678 rest:0,
2679 sublists:0,
2680 whole:0
2681 }))).
2682*/
2683/*
2684:- side_effect(assert_lsp(byte, init_args(x, f_byte))).
2685*/
2686/*
2687#+(or WAM-CL LISP500)
2688(defun byte-size (bytespec)
2689 (car bytespec))
2690
2691*/
2692
2693/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8522 **********************/
2694:-lisp_compile_to_prolog(pkg_sys,[defun,'byte-size',[bytespec],[car,bytespec]])
2695wl:lambda_def(defun, byte_size, f_byte_size, [sys_bytespec], [[car, sys_bytespec]]).
2696wl:arglist_info(byte_size, f_byte_size, [sys_bytespec], arginfo{all:[sys_bytespec], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_bytespec], opt:0, req:[sys_bytespec], rest:0, sublists:0, whole:0}).
2697wl: init_args(x, f_byte_size).
2698
2703f_byte_size(Bytespec_In, FnResult) :-
2704 GEnv=[bv(sys_bytespec, Bytespec_In)],
2705 catch(( ( get_var(GEnv, sys_bytespec, Bytespec_Get),
2706 f_car(Bytespec_Get, Car_Ret)
2707 ),
2708 Car_Ret=FnResult
2709 ),
2710 block_exit(byte_size, FnResult),
2711 true).
2712:- set_opv(byte_size, symbol_function, f_byte_size),
2713 DefunResult=byte_size. 2714/*
2715:- side_effect(assert_lsp(byte_size,
2716 lambda_def(defun,
2717 byte_size,
2718 f_byte_size,
2719 [sys_bytespec],
2720 [[car, sys_bytespec]]))).
2721*/
2722/*
2723:- side_effect(assert_lsp(byte_size,
2724 arglist_info(byte_size,
2725 f_byte_size,
2726 [sys_bytespec],
2727 arginfo{ all:[sys_bytespec],
2728 allow_other_keys:0,
2729 aux:0,
2730 body:0,
2731 complex:0,
2732 env:0,
2733 key:0,
2734 names:[sys_bytespec],
2735 opt:0,
2736 req:[sys_bytespec],
2737 rest:0,
2738 sublists:0,
2739 whole:0
2740 }))).
2741*/
2742/*
2743:- side_effect(assert_lsp(byte_size, init_args(x, f_byte_size))).
2744*/
2745/*
2746#+(or WAM-CL LISP500)
2747(defun byte-position (bytespec)
2748 (cdr bytespec))
2749
2750*/
2751
2752/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8596 **********************/
2753:-lisp_compile_to_prolog(pkg_sys,[defun,'byte-position',[bytespec],[cdr,bytespec]])
2754wl:lambda_def(defun, byte_position, f_byte_position, [sys_bytespec], [[cdr, sys_bytespec]]).
2755wl:arglist_info(byte_position, f_byte_position, [sys_bytespec], arginfo{all:[sys_bytespec], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_bytespec], opt:0, req:[sys_bytespec], rest:0, sublists:0, whole:0}).
2756wl: init_args(x, f_byte_position).
2757
2762f_byte_position(Bytespec_In, FnResult) :-
2763 GEnv=[bv(sys_bytespec, Bytespec_In)],
2764 catch(( ( get_var(GEnv, sys_bytespec, Bytespec_Get),
2765 f_cdr(Bytespec_Get, Cdr_Ret)
2766 ),
2767 Cdr_Ret=FnResult
2768 ),
2769 block_exit(byte_position, FnResult),
2770 true).
2771:- set_opv(byte_position, symbol_function, f_byte_position),
2772 DefunResult=byte_position. 2773/*
2774:- side_effect(assert_lsp(byte_position,
2775 lambda_def(defun,
2776 byte_position,
2777 f_byte_position,
2778 [sys_bytespec],
2779 [[cdr, sys_bytespec]]))).
2780*/
2781/*
2782:- side_effect(assert_lsp(byte_position,
2783 arglist_info(byte_position,
2784 f_byte_position,
2785 [sys_bytespec],
2786 arginfo{ all:[sys_bytespec],
2787 allow_other_keys:0,
2788 aux:0,
2789 body:0,
2790 complex:0,
2791 env:0,
2792 key:0,
2793 names:[sys_bytespec],
2794 opt:0,
2795 req:[sys_bytespec],
2796 rest:0,
2797 sublists:0,
2798 whole:0
2799 }))).
2800*/
2801/*
2802:- side_effect(assert_lsp(byte_position, init_args(x, f_byte_position))).
2803*/
2804/*
2805#+(or WAM-CL LISP500)
2806(defun char= (&rest characters)
2807 (apply #'= (mapcar #'char-code characters)))
2808
2809*/
2810
2811/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8674 **********************/
2812:-lisp_compile_to_prolog(pkg_sys,[defun,'char=',['&rest',characters],[apply,function(=),[mapcar,function('char-code'),characters]]])
2813wl:lambda_def(defun, char_c61, f_char_c61, [c38_rest, sys_characters], [[apply, function(=), [mapcar, function(char_code), sys_characters]]]).
2814wl:arglist_info(char_c61, f_char_c61, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
2815wl: init_args(0, f_char_c61).
2816
2821f_char_c61(RestNKeys, FnResult) :-
2822 GEnv=[bv(sys_characters, RestNKeys)],
2823 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
2824 f_mapcar(f_char_code, [Characters_Get], Mapcar_Ret),
2825 f_apply('f_=', Mapcar_Ret, Apply_Ret)
2826 ),
2827 Apply_Ret=FnResult
2828 ),
2829 block_exit(char_c61, FnResult),
2830 true).
2831:- set_opv(char_c61, symbol_function, f_char_c61),
2832 DefunResult=char_c61. 2833/*
2834:- side_effect(assert_lsp(char_c61,
2835 lambda_def(defun,
2836 char_c61,
2837 f_char_c61,
2838 [c38_rest, sys_characters],
2839
2840 [
2841 [ apply,
2842 function(=),
2843
2844 [ mapcar,
2845 function(char_code),
2846 sys_characters
2847 ]
2848 ]
2849 ]))).
2850*/
2851/*
2852:- side_effect(assert_lsp(char_c61,
2853 arglist_info(char_c61,
2854 f_char_c61,
2855 [c38_rest, sys_characters],
2856 arginfo{ all:0,
2857 allow_other_keys:0,
2858 aux:0,
2859 body:0,
2860 complex:[rest],
2861 env:0,
2862 key:0,
2863 names:[sys_characters],
2864 opt:0,
2865 req:0,
2866 rest:[sys_characters],
2867 sublists:0,
2868 whole:0
2869 }))).
2870*/
2871/*
2872:- side_effect(assert_lsp(char_c61, init_args(0, f_char_c61))).
2873*/
2874/*
2875#+(or WAM-CL LISP500)
2876(defun char/= (&rest characters)
2877 (apply #'/= (mapcar #'char-code characters)))
2878
2879*/
2880
2881/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8781 **********************/
2882:-lisp_compile_to_prolog(pkg_sys,[defun,'char/=',['&rest',characters],[apply,function(/=),[mapcar,function('char-code'),characters]]])
2883wl:lambda_def(defun, char_c47_c61, f_char_c47_c61, [c38_rest, sys_characters], [[apply, function(/=), [mapcar, function(char_code), sys_characters]]]).
2884wl:arglist_info(char_c47_c61, f_char_c47_c61, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
2885wl: init_args(0, f_char_c47_c61).
2886
2891f_char_c47_c61(RestNKeys, FnResult) :-
2892 GEnv=[bv(sys_characters, RestNKeys)],
2893 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
2894 f_mapcar(f_char_code,
2895 [Characters_Get],
2896 [C47_c61_Param|KeysNRest]),
2897 f_c47_c61(C47_c61_Param, KeysNRest, C47_c61_Ret)
2898 ),
2899 C47_c61_Ret=FnResult
2900 ),
2901 block_exit(char_c47_c61, FnResult),
2902 true).
2903:- set_opv(char_c47_c61, symbol_function, f_char_c47_c61),
2904 DefunResult=char_c47_c61. 2905/*
2906:- side_effect(assert_lsp(char_c47_c61,
2907 lambda_def(defun,
2908 char_c47_c61,
2909 f_char_c47_c61,
2910 [c38_rest, sys_characters],
2911
2912 [
2913 [ apply,
2914 function(/=),
2915
2916 [ mapcar,
2917 function(char_code),
2918 sys_characters
2919 ]
2920 ]
2921 ]))).
2922*/
2923/*
2924:- side_effect(assert_lsp(char_c47_c61,
2925 arglist_info(char_c47_c61,
2926 f_char_c47_c61,
2927 [c38_rest, sys_characters],
2928 arginfo{ all:0,
2929 allow_other_keys:0,
2930 aux:0,
2931 body:0,
2932 complex:[rest],
2933 env:0,
2934 key:0,
2935 names:[sys_characters],
2936 opt:0,
2937 req:0,
2938 rest:[sys_characters],
2939 sublists:0,
2940 whole:0
2941 }))).
2942*/
2943/*
2944:- side_effect(assert_lsp(char_c47_c61, init_args(0, f_char_c47_c61))).
2945*/
2946/*
2947#+(or WAM-CL LISP500)
2948(defun char< (&rest characters)
2949 (apply #'< (mapcar #'char-code characters)))
2950
2951*/
2952
2953/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8890 **********************/
2954:-lisp_compile_to_prolog(pkg_sys,[defun,'char<',['&rest',characters],[apply,function(<),[mapcar,function('char-code'),characters]]])
2955wl:lambda_def(defun, char_c60, f_char_c60, [c38_rest, sys_characters], [[apply, function(<), [mapcar, function(char_code), sys_characters]]]).
2956wl:arglist_info(char_c60, f_char_c60, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
2957wl: init_args(0, f_char_c60).
2958
2963f_char_c60(RestNKeys, FnResult) :-
2964 GEnv=[bv(sys_characters, RestNKeys)],
2965 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
2966 f_mapcar(f_char_code, [Characters_Get], Mapcar_Ret),
2967 f_apply('f_<', Mapcar_Ret, Apply_Ret)
2968 ),
2969 Apply_Ret=FnResult
2970 ),
2971 block_exit(char_c60, FnResult),
2972 true).
2973:- set_opv(char_c60, symbol_function, f_char_c60),
2974 DefunResult=char_c60. 2975/*
2976:- side_effect(assert_lsp(char_c60,
2977 lambda_def(defun,
2978 char_c60,
2979 f_char_c60,
2980 [c38_rest, sys_characters],
2981
2982 [
2983 [ apply,
2984 function(<),
2985
2986 [ mapcar,
2987 function(char_code),
2988 sys_characters
2989 ]
2990 ]
2991 ]))).
2992*/
2993/*
2994:- side_effect(assert_lsp(char_c60,
2995 arglist_info(char_c60,
2996 f_char_c60,
2997 [c38_rest, sys_characters],
2998 arginfo{ all:0,
2999 allow_other_keys:0,
3000 aux:0,
3001 body:0,
3002 complex:[rest],
3003 env:0,
3004 key:0,
3005 names:[sys_characters],
3006 opt:0,
3007 req:0,
3008 rest:[sys_characters],
3009 sublists:0,
3010 whole:0
3011 }))).
3012*/
3013/*
3014:- side_effect(assert_lsp(char_c60, init_args(0, f_char_c60))).
3015*/
3016/*
3017#+(or WAM-CL LISP500)
3018(defun char> (&rest characters)
3019 (apply #'> (mapcar #'char-code characters)))
3020
3021*/
3022
3023/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:8997 **********************/
3024:-lisp_compile_to_prolog(pkg_sys,[defun,'char>',['&rest',characters],[apply,function(>),[mapcar,function('char-code'),characters]]])
3025wl:lambda_def(defun, char_c62, f_char_c62, [c38_rest, sys_characters], [[apply, function(>), [mapcar, function(char_code), sys_characters]]]).
3026wl:arglist_info(char_c62, f_char_c62, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
3027wl: init_args(0, f_char_c62).
3028
3033f_char_c62(RestNKeys, FnResult) :-
3034 GEnv=[bv(sys_characters, RestNKeys)],
3035 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
3036 f_mapcar(f_char_code, [Characters_Get], Mapcar_Ret),
3037 f_apply('f_>', Mapcar_Ret, Apply_Ret)
3038 ),
3039 Apply_Ret=FnResult
3040 ),
3041 block_exit(char_c62, FnResult),
3042 true).
3043:- set_opv(char_c62, symbol_function, f_char_c62),
3044 DefunResult=char_c62. 3045/*
3046:- side_effect(assert_lsp(char_c62,
3047 lambda_def(defun,
3048 char_c62,
3049 f_char_c62,
3050 [c38_rest, sys_characters],
3051
3052 [
3053 [ apply,
3054 function(>),
3055
3056 [ mapcar,
3057 function(char_code),
3058 sys_characters
3059 ]
3060 ]
3061 ]))).
3062*/
3063/*
3064:- side_effect(assert_lsp(char_c62,
3065 arglist_info(char_c62,
3066 f_char_c62,
3067 [c38_rest, sys_characters],
3068 arginfo{ all:0,
3069 allow_other_keys:0,
3070 aux:0,
3071 body:0,
3072 complex:[rest],
3073 env:0,
3074 key:0,
3075 names:[sys_characters],
3076 opt:0,
3077 req:0,
3078 rest:[sys_characters],
3079 sublists:0,
3080 whole:0
3081 }))).
3082*/
3083/*
3084:- side_effect(assert_lsp(char_c62, init_args(0, f_char_c62))).
3085*/
3086/*
3087#+(or WAM-CL LISP500)
3088(defun char<= (&rest characters)
3089 (apply #'<= (mapcar #'char-code characters)))
3090
3091*/
3092
3093/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:9104 **********************/
3094:-lisp_compile_to_prolog(pkg_sys,[defun,'char<=',['&rest',characters],[apply,function(<=),[mapcar,function('char-code'),characters]]])
3095wl:lambda_def(defun, char_c60_c61, f_char_c60_c61, [c38_rest, sys_characters], [[apply, function(<=), [mapcar, function(char_code), sys_characters]]]).
3096wl:arglist_info(char_c60_c61, f_char_c60_c61, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
3097wl: init_args(0, f_char_c60_c61).
3098
3103f_char_c60_c61(RestNKeys, FnResult) :-
3104 GEnv=[bv(sys_characters, RestNKeys)],
3105 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
3106 f_mapcar(f_char_code, [Characters_Get], Mapcar_Ret),
3107 f_apply('f_<=', Mapcar_Ret, Apply_Ret)
3108 ),
3109 Apply_Ret=FnResult
3110 ),
3111 block_exit(char_c60_c61, FnResult),
3112 true).
3113:- set_opv(char_c60_c61, symbol_function, f_char_c60_c61),
3114 DefunResult=char_c60_c61. 3115/*
3116:- side_effect(assert_lsp(char_c60_c61,
3117 lambda_def(defun,
3118 char_c60_c61,
3119 f_char_c60_c61,
3120 [c38_rest, sys_characters],
3121
3122 [
3123 [ apply,
3124 function(<=),
3125
3126 [ mapcar,
3127 function(char_code),
3128 sys_characters
3129 ]
3130 ]
3131 ]))).
3132*/
3133/*
3134:- side_effect(assert_lsp(char_c60_c61,
3135 arglist_info(char_c60_c61,
3136 f_char_c60_c61,
3137 [c38_rest, sys_characters],
3138 arginfo{ all:0,
3139 allow_other_keys:0,
3140 aux:0,
3141 body:0,
3142 complex:[rest],
3143 env:0,
3144 key:0,
3145 names:[sys_characters],
3146 opt:0,
3147 req:0,
3148 rest:[sys_characters],
3149 sublists:0,
3150 whole:0
3151 }))).
3152*/
3153/*
3154:- side_effect(assert_lsp(char_c60_c61, init_args(0, f_char_c60_c61))).
3155*/
3156/*
3157#+(or WAM-CL LISP500)
3158(defun char>= (&rest characters)
3159 (apply #'>= (mapcar #'char-code characters)))
3160
3161*/
3162
3163/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:9213 **********************/
3164:-lisp_compile_to_prolog(pkg_sys,[defun,'char>=',['&rest',characters],[apply,function(>=),[mapcar,function('char-code'),characters]]])
3165wl:lambda_def(defun, char_c62_c61, f_char_c62_c61, [c38_rest, sys_characters], [[apply, function(>=), [mapcar, function(char_code), sys_characters]]]).
3166wl:arglist_info(char_c62_c61, f_char_c62_c61, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
3167wl: init_args(0, f_char_c62_c61).
3168
3173f_char_c62_c61(RestNKeys, FnResult) :-
3174 GEnv=[bv(sys_characters, RestNKeys)],
3175 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
3176 f_mapcar(f_char_code, [Characters_Get], Mapcar_Ret),
3177 f_apply('f_>=', Mapcar_Ret, Apply_Ret)
3178 ),
3179 Apply_Ret=FnResult
3180 ),
3181 block_exit(char_c62_c61, FnResult),
3182 true).
3183:- set_opv(char_c62_c61, symbol_function, f_char_c62_c61),
3184 DefunResult=char_c62_c61. 3185/*
3186:- side_effect(assert_lsp(char_c62_c61,
3187 lambda_def(defun,
3188 char_c62_c61,
3189 f_char_c62_c61,
3190 [c38_rest, sys_characters],
3191
3192 [
3193 [ apply,
3194 function(>=),
3195
3196 [ mapcar,
3197 function(char_code),
3198 sys_characters
3199 ]
3200 ]
3201 ]))).
3202*/
3203/*
3204:- side_effect(assert_lsp(char_c62_c61,
3205 arglist_info(char_c62_c61,
3206 f_char_c62_c61,
3207 [c38_rest, sys_characters],
3208 arginfo{ all:0,
3209 allow_other_keys:0,
3210 aux:0,
3211 body:0,
3212 complex:[rest],
3213 env:0,
3214 key:0,
3215 names:[sys_characters],
3216 opt:0,
3217 req:0,
3218 rest:[sys_characters],
3219 sublists:0,
3220 whole:0
3221 }))).
3222*/
3223/*
3224:- side_effect(assert_lsp(char_c62_c61, init_args(0, f_char_c62_c61))).
3225*/
3226/*
3227#+(or WAM-CL LISP500)
3228(defun char-equal (&rest characters)
3229 (apply #'char= (mapcar #'char-upcase characters)))
3230
3231*/
3232
3233/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:9322 **********************/
3234:-lisp_compile_to_prolog(pkg_sys,[defun,'char-equal',['&rest',characters],[apply,function('char='),[mapcar,function('char-upcase'),characters]]])
3235wl:lambda_def(defun, char_equal, f_char_equal, [c38_rest, sys_characters], [[apply, function(char_c61), [mapcar, function(char_upcase), sys_characters]]]).
3236wl:arglist_info(char_equal, f_char_equal, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
3237wl: init_args(0, f_char_equal).
3238
3243f_char_equal(RestNKeys, FnResult) :-
3244 GEnv=[bv(sys_characters, RestNKeys)],
3245 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
3246 f_mapcar(f_char_upcase, [Characters_Get], Char_c61_Param),
3247 f_char_c61(Char_c61_Param, Char_c61_Ret)
3248 ),
3249 Char_c61_Ret=FnResult
3250 ),
3251 block_exit(char_equal, FnResult),
3252 true).
3253:- set_opv(char_equal, symbol_function, f_char_equal),
3254 DefunResult=char_equal. 3255/*
3256:- side_effect(assert_lsp(char_equal,
3257 lambda_def(defun,
3258 char_equal,
3259 f_char_equal,
3260 [c38_rest, sys_characters],
3261
3262 [
3263 [ apply,
3264 function(char_c61),
3265
3266 [ mapcar,
3267 function(char_upcase),
3268 sys_characters
3269 ]
3270 ]
3271 ]))).
3272*/
3273/*
3274:- side_effect(assert_lsp(char_equal,
3275 arglist_info(char_equal,
3276 f_char_equal,
3277 [c38_rest, sys_characters],
3278 arginfo{ all:0,
3279 allow_other_keys:0,
3280 aux:0,
3281 body:0,
3282 complex:[rest],
3283 env:0,
3284 key:0,
3285 names:[sys_characters],
3286 opt:0,
3287 req:0,
3288 rest:[sys_characters],
3289 sublists:0,
3290 whole:0
3291 }))).
3292*/
3293/*
3294:- side_effect(assert_lsp(char_equal, init_args(0, f_char_equal))).
3295*/
3296/*
3297#+(or WAM-CL LISP500)
3298(defun char-not-equal (&rest characters)
3299 (apply #'char/= (mapcar #'char-upcase characters)))
3300
3301*/
3302
3303/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:9440 **********************/
3304:-lisp_compile_to_prolog(pkg_sys,[defun,'char-not-equal',['&rest',characters],[apply,function('char/='),[mapcar,function('char-upcase'),characters]]])
3305wl:lambda_def(defun, char_not_equal, f_char_not_equal, [c38_rest, sys_characters], [[apply, function(char_c47_c61), [mapcar, function(char_upcase), sys_characters]]]).
3306wl:arglist_info(char_not_equal, f_char_not_equal, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
3307wl: init_args(0, f_char_not_equal).
3308
3313f_char_not_equal(RestNKeys, FnResult) :-
3314 GEnv=[bv(sys_characters, RestNKeys)],
3315 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
3316 f_mapcar(f_char_upcase, [Characters_Get], C47_c61_Param),
3317 f_char_c47_c61(C47_c61_Param, C47_c61_Ret)
3318 ),
3319 C47_c61_Ret=FnResult
3320 ),
3321 block_exit(char_not_equal, FnResult),
3322 true).
3323:- set_opv(char_not_equal, symbol_function, f_char_not_equal),
3324 DefunResult=char_not_equal. 3325/*
3326:- side_effect(assert_lsp(char_not_equal,
3327 lambda_def(defun,
3328 char_not_equal,
3329 f_char_not_equal,
3330 [c38_rest, sys_characters],
3331
3332 [
3333 [ apply,
3334 function(char_c47_c61),
3335
3336 [ mapcar,
3337 function(char_upcase),
3338 sys_characters
3339 ]
3340 ]
3341 ]))).
3342*/
3343/*
3344:- side_effect(assert_lsp(char_not_equal,
3345 arglist_info(char_not_equal,
3346 f_char_not_equal,
3347 [c38_rest, sys_characters],
3348 arginfo{ all:0,
3349 allow_other_keys:0,
3350 aux:0,
3351 body:0,
3352 complex:[rest],
3353 env:0,
3354 key:0,
3355 names:[sys_characters],
3356 opt:0,
3357 req:0,
3358 rest:[sys_characters],
3359 sublists:0,
3360 whole:0
3361 }))).
3362*/
3363/*
3364:- side_effect(assert_lsp(char_not_equal, init_args(0, f_char_not_equal))).
3365*/
3366/*
3367#+(or WAM-CL LISP500)
3368(defun char-lessp (&rest characters)
3369 (apply #'char< (mapcar #'char-upcase characters)))
3370
3371*/
3372
3373/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:9563 **********************/
3374:-lisp_compile_to_prolog(pkg_sys,[defun,'char-lessp',['&rest',characters],[apply,function('char<'),[mapcar,function('char-upcase'),characters]]])
3375wl:lambda_def(defun, char_lessp, f_char_lessp, [c38_rest, sys_characters], [[apply, function(char_c60), [mapcar, function(char_upcase), sys_characters]]]).
3376wl:arglist_info(char_lessp, f_char_lessp, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
3377wl: init_args(0, f_char_lessp).
3378
3383f_char_lessp(RestNKeys, FnResult) :-
3384 GEnv=[bv(sys_characters, RestNKeys)],
3385 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
3386 f_mapcar(f_char_upcase, [Characters_Get], Char_c60_Param),
3387 f_char_c60(Char_c60_Param, Char_c60_Ret)
3388 ),
3389 Char_c60_Ret=FnResult
3390 ),
3391 block_exit(char_lessp, FnResult),
3392 true).
3393:- set_opv(char_lessp, symbol_function, f_char_lessp),
3394 DefunResult=char_lessp. 3395/*
3396:- side_effect(assert_lsp(char_lessp,
3397 lambda_def(defun,
3398 char_lessp,
3399 f_char_lessp,
3400 [c38_rest, sys_characters],
3401
3402 [
3403 [ apply,
3404 function(char_c60),
3405
3406 [ mapcar,
3407 function(char_upcase),
3408 sys_characters
3409 ]
3410 ]
3411 ]))).
3412*/
3413/*
3414:- side_effect(assert_lsp(char_lessp,
3415 arglist_info(char_lessp,
3416 f_char_lessp,
3417 [c38_rest, sys_characters],
3418 arginfo{ all:0,
3419 allow_other_keys:0,
3420 aux:0,
3421 body:0,
3422 complex:[rest],
3423 env:0,
3424 key:0,
3425 names:[sys_characters],
3426 opt:0,
3427 req:0,
3428 rest:[sys_characters],
3429 sublists:0,
3430 whole:0
3431 }))).
3432*/
3433/*
3434:- side_effect(assert_lsp(char_lessp, init_args(0, f_char_lessp))).
3435*/
3436/*
3437#+(or WAM-CL LISP500)
3438(defun char-greaterp (&rest characters)
3439 (apply #'char> (mapcar #'char-upcase characters)))
3440
3441*/
3442
3443/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:9681 **********************/
3444:-lisp_compile_to_prolog(pkg_sys,[defun,'char-greaterp',['&rest',characters],[apply,function('char>'),[mapcar,function('char-upcase'),characters]]])
3445wl:lambda_def(defun, char_greaterp, f_char_greaterp, [c38_rest, sys_characters], [[apply, function(char_c62), [mapcar, function(char_upcase), sys_characters]]]).
3446wl:arglist_info(char_greaterp, f_char_greaterp, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
3447wl: init_args(0, f_char_greaterp).
3448
3453f_char_greaterp(RestNKeys, FnResult) :-
3454 GEnv=[bv(sys_characters, RestNKeys)],
3455 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
3456 f_mapcar(f_char_upcase, [Characters_Get], Char_c62_Param),
3457 f_char_c62(Char_c62_Param, Char_c62_Ret)
3458 ),
3459 Char_c62_Ret=FnResult
3460 ),
3461 block_exit(char_greaterp, FnResult),
3462 true).
3463:- set_opv(char_greaterp, symbol_function, f_char_greaterp),
3464 DefunResult=char_greaterp. 3465/*
3466:- side_effect(assert_lsp(char_greaterp,
3467 lambda_def(defun,
3468 char_greaterp,
3469 f_char_greaterp,
3470 [c38_rest, sys_characters],
3471
3472 [
3473 [ apply,
3474 function(char_c62),
3475
3476 [ mapcar,
3477 function(char_upcase),
3478 sys_characters
3479 ]
3480 ]
3481 ]))).
3482*/
3483/*
3484:- side_effect(assert_lsp(char_greaterp,
3485 arglist_info(char_greaterp,
3486 f_char_greaterp,
3487 [c38_rest, sys_characters],
3488 arginfo{ all:0,
3489 allow_other_keys:0,
3490 aux:0,
3491 body:0,
3492 complex:[rest],
3493 env:0,
3494 key:0,
3495 names:[sys_characters],
3496 opt:0,
3497 req:0,
3498 rest:[sys_characters],
3499 sublists:0,
3500 whole:0
3501 }))).
3502*/
3503/*
3504:- side_effect(assert_lsp(char_greaterp, init_args(0, f_char_greaterp))).
3505*/
3506/*
3507#+(or WAM-CL LISP500)
3508(defun char-not-greaterp (&rest characters)
3509 (apply #'char<= (mapcar #'char-upcase characters)))
3510
3511*/
3512
3513/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:9802 **********************/
3514:-lisp_compile_to_prolog(pkg_sys,[defun,'char-not-greaterp',['&rest',characters],[apply,function('char<='),[mapcar,function('char-upcase'),characters]]])
3515wl:lambda_def(defun, char_not_greaterp, f_char_not_greaterp, [c38_rest, sys_characters], [[apply, function(char_c60_c61), [mapcar, function(char_upcase), sys_characters]]]).
3516wl:arglist_info(char_not_greaterp, f_char_not_greaterp, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
3517wl: init_args(0, f_char_not_greaterp).
3518
3523f_char_not_greaterp(RestNKeys, FnResult) :-
3524 GEnv=[bv(sys_characters, RestNKeys)],
3525 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
3526 f_mapcar(f_char_upcase, [Characters_Get], C60_c61_Param),
3527 f_char_c60_c61(C60_c61_Param, C60_c61_Ret)
3528 ),
3529 C60_c61_Ret=FnResult
3530 ),
3531 block_exit(char_not_greaterp, FnResult),
3532 true).
3533:- set_opv(char_not_greaterp, symbol_function, f_char_not_greaterp),
3534 DefunResult=char_not_greaterp. 3535/*
3536:- side_effect(assert_lsp(char_not_greaterp,
3537 lambda_def(defun,
3538 char_not_greaterp,
3539 f_char_not_greaterp,
3540 [c38_rest, sys_characters],
3541
3542 [
3543 [ apply,
3544 function(char_c60_c61),
3545
3546 [ mapcar,
3547 function(char_upcase),
3548 sys_characters
3549 ]
3550 ]
3551 ]))).
3552*/
3553/*
3554:- side_effect(assert_lsp(char_not_greaterp,
3555 arglist_info(char_not_greaterp,
3556 f_char_not_greaterp,
3557 [c38_rest, sys_characters],
3558 arginfo{ all:0,
3559 allow_other_keys:0,
3560 aux:0,
3561 body:0,
3562 complex:[rest],
3563 env:0,
3564 key:0,
3565 names:[sys_characters],
3566 opt:0,
3567 req:0,
3568 rest:[sys_characters],
3569 sublists:0,
3570 whole:0
3571 }))).
3572*/
3573/*
3574:- side_effect(assert_lsp(char_not_greaterp, init_args(0, f_char_not_greaterp))).
3575*/
3576/*
3577#+(or WAM-CL LISP500)
3578(defun char-not-lessp (&rest characters)
3579 (apply #'char>= (mapcar #'char-upcase characters)))
3580
3581*/
3582
3583/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:9928 **********************/
3584:-lisp_compile_to_prolog(pkg_sys,[defun,'char-not-lessp',['&rest',characters],[apply,function('char>='),[mapcar,function('char-upcase'),characters]]])
3585wl:lambda_def(defun, char_not_lessp, f_char_not_lessp, [c38_rest, sys_characters], [[apply, function(char_c62_c61), [mapcar, function(char_upcase), sys_characters]]]).
3586wl:arglist_info(char_not_lessp, f_char_not_lessp, [c38_rest, sys_characters], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_characters], opt:0, req:0, rest:[sys_characters], sublists:0, whole:0}).
3587wl: init_args(0, f_char_not_lessp).
3588
3593f_char_not_lessp(RestNKeys, FnResult) :-
3594 GEnv=[bv(sys_characters, RestNKeys)],
3595 catch(( ( get_var(GEnv, sys_characters, Characters_Get),
3596 f_mapcar(f_char_upcase, [Characters_Get], C62_c61_Param),
3597 f_char_c62_c61(C62_c61_Param, C62_c61_Ret)
3598 ),
3599 C62_c61_Ret=FnResult
3600 ),
3601 block_exit(char_not_lessp, FnResult),
3602 true).
3603:- set_opv(char_not_lessp, symbol_function, f_char_not_lessp),
3604 DefunResult=char_not_lessp. 3605/*
3606:- side_effect(assert_lsp(char_not_lessp,
3607 lambda_def(defun,
3608 char_not_lessp,
3609 f_char_not_lessp,
3610 [c38_rest, sys_characters],
3611
3612 [
3613 [ apply,
3614 function(char_c62_c61),
3615
3616 [ mapcar,
3617 function(char_upcase),
3618 sys_characters
3619 ]
3620 ]
3621 ]))).
3622*/
3623/*
3624:- side_effect(assert_lsp(char_not_lessp,
3625 arglist_info(char_not_lessp,
3626 f_char_not_lessp,
3627 [c38_rest, sys_characters],
3628 arginfo{ all:0,
3629 allow_other_keys:0,
3630 aux:0,
3631 body:0,
3632 complex:[rest],
3633 env:0,
3634 key:0,
3635 names:[sys_characters],
3636 opt:0,
3637 req:0,
3638 rest:[sys_characters],
3639 sublists:0,
3640 whole:0
3641 }))).
3642*/
3643/*
3644:- side_effect(assert_lsp(char_not_lessp, init_args(0, f_char_not_lessp))).
3645*/
3646/*
3647#+(or WAM-CL LISP500)
3648(defun character (character)
3649 (if (characterp character)
3650 character
3651 (let ((string (designator-string character)))
3652 (if (= (length string) 1)
3653 (aref string 0)
3654 (error 'type-error :datum string :expected-type '(string 1))))))
3655
3656*/
3657
3658/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:10051 **********************/
3659:-lisp_compile_to_prolog(pkg_sys,[defun,character,[character],[if,[characterp,character],character,[let,[[string,['designator-string',character]]],[if,[=,[length,string],1],[aref,string,0],[error,[quote,'type-error'],':datum',string,':expected-type',[quote,[string,1]]]]]]])
3660wl:lambda_def(defun, character, f_character, [character], [[if, [characterp, character], character, [let, [[string, [sys_designator_string, character]]], [if, [=, [length, string], 1], [aref, string, 0], [error, [quote, type_error], kw_datum, string, kw_expected_type, [quote, [string, 1]]]]]]]).
3661wl:arglist_info(character, f_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}).
3662wl: init_args(x, f_character).
3663
3668f_character(Character_In, FnResult) :-
3669 GEnv=[bv(character, Character_In)],
3670 catch(( ( get_var(GEnv, character, Character_Get),
3671 ( string:is_characterp(Character_Get)
3672 -> get_var(GEnv, character, Character_Get9),
3673 _7546=Character_Get9
3674 ; get_var(GEnv, character, Character_Get10),
3675 f_sys_designator_string(Character_Get10,
3676 Designator_string_Ret),
3677 locally_set(string,
3678 Designator_string_Ret,
3679 (get_var(GEnv, string, String_Get), f_length(String_Get, PredArg1Result), (PredArg1Result=:=1->get_var(GEnv, string, String_Get15), f_aref(String_Get15, [0], TrueResult), ElseResult20=TrueResult;get_var(GEnv, string, String_Get16), f_error([type_error, kw_datum, String_Get16, kw_expected_type, [string, 1]], ElseResult), ElseResult20=ElseResult))),
3680 _7546=ElseResult20
3681 )
3682 ),
3683 _7546=FnResult
3684 ),
3685 block_exit(character, FnResult),
3686 true).
3687:- set_opv(character, symbol_function, f_character),
3688 DefunResult=character. 3689/*
3690:- side_effect(assert_lsp(character,
3691 lambda_def(defun,
3692 character,
3693 f_character,
3694 [character],
3695
3696 [
3697 [ if,
3698 [characterp, character],
3699 character,
3700
3701 [ let,
3702
3703 [
3704 [ string,
3705
3706 [ sys_designator_string,
3707 character
3708 ]
3709 ]
3710 ],
3711
3712 [ if,
3713 [=, [length, string], 1],
3714 [aref, string, 0],
3715
3716 [ error,
3717 [quote, type_error],
3718 kw_datum,
3719 string,
3720 kw_expected_type,
3721 [quote, [string, 1]]
3722 ]
3723 ]
3724 ]
3725 ]
3726 ]))).
3727*/
3728/*
3729:- side_effect(assert_lsp(character,
3730 arglist_info(character,
3731 f_character,
3732 [character],
3733 arginfo{ all:[character],
3734 allow_other_keys:0,
3735 aux:0,
3736 body:0,
3737 complex:0,
3738 env:0,
3739 key:0,
3740 names:[character],
3741 opt:0,
3742 req:[character],
3743 rest:0,
3744 sublists:0,
3745 whole:0
3746 }))).
3747*/
3748/*
3749:- side_effect(assert_lsp(character, init_args(x, f_character))).
3750*/
3751/*
3752#+LISP500
3753(defun characterp (object) (= (ldb '(5 . 0) (ival object)) 24))
3754
3755*/
3756
3757/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:10328 **********************/
3758:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':LISP500'],[defun,characterp,[object],[=,[ldb,[quote,[5|0]],[ival,object]],24]]]))
3759/*
3760#+(or WAM-CL LISP500)
3761(defun alpha-char-p (character)
3762 (let ((code (char-code character)))
3763 (or (< 64 code 91)
3764 (< 96 code 123)
3765 (< 159 code))))
3766
3767*/
3768
3769/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:10406 **********************/
3770:-lisp_compile_to_prolog(pkg_sys,[defun,'alpha-char-p',[character],[let,[[code,['char-code',character]]],[or,[<,64,code,91],[<,96,code,123],[<,159,code]]]])
3771wl:lambda_def(defun, alpha_char_p, f_alpha_char_p, [character], [[let, [[sys_code, [char_code, character]]], [or, [<, 64, sys_code, 91], [<, 96, sys_code, 123], [<, 159, sys_code]]]]).
3772wl:arglist_info(alpha_char_p, f_alpha_char_p, [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}).
3773wl: init_args(x, f_alpha_char_p).
3774
3779f_alpha_char_p(Character_In, FnResult) :-
3780 GEnv=[bv(character, Character_In)],
3781 catch(( ( get_var(GEnv, character, Character_Get),
3782 f_char_code(Character_Get, Code_Init),
3783 LEnv=[bv(sys_code, Code_Init)|GEnv],
3784 ( get_var(LEnv, sys_code, Code_Get),
3785 ( 64<Code_Get
3786 -> get_var(LEnv, sys_code, Code_Get14),
3787 'f_<'(Code_Get14, 91, TrueResult),
3788 FORM1_Res24=TrueResult
3789 ; FORM1_Res24=[]
3790 ),
3791 FORM1_Res24\==[],
3792 LetResult=FORM1_Res24
3793 -> true
3794 ; ( get_var(LEnv, sys_code, Code_Get17),
3795 ( 96<Code_Get17
3796 -> get_var(LEnv, sys_code, Code_Get20),
3797 'f_<'(Code_Get20, 123, TrueResult21),
3798 FORM1_Res=TrueResult21
3799 ; FORM1_Res=[]
3800 ),
3801 FORM1_Res\==[],
3802 _10328=FORM1_Res
3803 -> true
3804 ; get_var(LEnv, sys_code, Code_Get22),
3805 'f_<'(159, Code_Get22, _23188),
3806 _10328=_23188
3807 ),
3808 LetResult=_10328
3809 )
3810 ),
3811 LetResult=FnResult
3812 ),
3813 block_exit(alpha_char_p, FnResult),
3814 true).
3815:- set_opv(alpha_char_p, symbol_function, f_alpha_char_p),
3816 DefunResult=alpha_char_p. 3817/*
3818:- side_effect(assert_lsp(alpha_char_p,
3819 lambda_def(defun,
3820 alpha_char_p,
3821 f_alpha_char_p,
3822 [character],
3823
3824 [
3825 [ let,
3826 [[sys_code, [char_code, character]]],
3827
3828 [ or,
3829 [<, 64, sys_code, 91],
3830 [<, 96, sys_code, 123],
3831 [<, 159, sys_code]
3832 ]
3833 ]
3834 ]))).
3835*/
3836/*
3837:- side_effect(assert_lsp(alpha_char_p,
3838 arglist_info(alpha_char_p,
3839 f_alpha_char_p,
3840 [character],
3841 arginfo{ all:[character],
3842 allow_other_keys:0,
3843 aux:0,
3844 body:0,
3845 complex:0,
3846 env:0,
3847 key:0,
3848 names:[character],
3849 opt:0,
3850 req:[character],
3851 rest:0,
3852 sublists:0,
3853 whole:0
3854 }))).
3855*/
3856/*
3857:- side_effect(assert_lsp(alpha_char_p, init_args(x, f_alpha_char_p))).
3858*/
3859/*
3860#+(or WAM-CL LISP500)
3861(defun alphanumericp (character)
3862 (let ((code (char-code character)))
3863 (or (< 47 code 58)
3864 (< 64 code 91)
3865 (< 96 code 123)
3866 (< 159 code))))
3867
3868*/
3869
3870/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:10564 **********************/
3871:-lisp_compile_to_prolog(pkg_sys,[defun,alphanumericp,[character],[let,[[code,['char-code',character]]],[or,[<,47,code,58],[<,64,code,91],[<,96,code,123],[<,159,code]]]])
3872wl:lambda_def(defun, alphanumericp, f_alphanumericp, [character], [[let, [[sys_code, [char_code, character]]], [or, [<, 47, sys_code, 58], [<, 64, sys_code, 91], [<, 96, sys_code, 123], [<, 159, sys_code]]]]).
3873wl:arglist_info(alphanumericp, f_alphanumericp, [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}).
3874wl: init_args(x, f_alphanumericp).
3875
3880f_alphanumericp(Character_In, FnResult) :-
3881 GEnv=[bv(character, Character_In)],
3882 catch(( ( get_var(GEnv, character, Character_Get),
3883 f_char_code(Character_Get, Code_Init),
3884 LEnv=[bv(sys_code, Code_Init)|GEnv],
3885 ( get_var(LEnv, sys_code, Code_Get),
3886 ( 47<Code_Get
3887 -> get_var(LEnv, sys_code, Code_Get14),
3888 'f_<'(Code_Get14, 58, TrueResult),
3889 FORM1_Res31=TrueResult
3890 ; FORM1_Res31=[]
3891 ),
3892 FORM1_Res31\==[],
3893 LetResult=FORM1_Res31
3894 -> true
3895 ; ( get_var(LEnv, sys_code, Code_Get17),
3896 ( 64<Code_Get17
3897 -> get_var(LEnv, sys_code, Code_Get20),
3898 'f_<'(Code_Get20, 91, TrueResult21),
3899 FORM1_Res30=TrueResult21
3900 ; FORM1_Res30=[]
3901 ),
3902 FORM1_Res30\==[],
3903 _10732=FORM1_Res30
3904 -> true
3905 ; ( get_var(LEnv, sys_code, Code_Get23),
3906 ( 96<Code_Get23
3907 -> get_var(LEnv, sys_code, Code_Get26),
3908 'f_<'(Code_Get26, 123, TrueResult27),
3909 FORM1_Res=TrueResult27
3910 ; FORM1_Res=[]
3911 ),
3912 FORM1_Res\==[],
3913 _11054=FORM1_Res
3914 -> true
3915 ; get_var(LEnv, sys_code, Code_Get28),
3916 'f_<'(159, Code_Get28, _11328),
3917 _11054=_11328
3918 ),
3919 _10732=_11054
3920 ),
3921 LetResult=_10732
3922 )
3923 ),
3924 LetResult=FnResult
3925 ),
3926 block_exit(alphanumericp, FnResult),
3927 true).
3928:- set_opv(alphanumericp, symbol_function, f_alphanumericp),
3929 DefunResult=alphanumericp. 3930/*
3931:- side_effect(assert_lsp(alphanumericp,
3932 lambda_def(defun,
3933 alphanumericp,
3934 f_alphanumericp,
3935 [character],
3936
3937 [
3938 [ let,
3939 [[sys_code, [char_code, character]]],
3940
3941 [ or,
3942 [<, 47, sys_code, 58],
3943 [<, 64, sys_code, 91],
3944 [<, 96, sys_code, 123],
3945 [<, 159, sys_code]
3946 ]
3947 ]
3948 ]))).
3949*/
3950/*
3951:- side_effect(assert_lsp(alphanumericp,
3952 arglist_info(alphanumericp,
3953 f_alphanumericp,
3954 [character],
3955 arginfo{ all:[character],
3956 allow_other_keys:0,
3957 aux:0,
3958 body:0,
3959 complex:0,
3960 env:0,
3961 key:0,
3962 names:[character],
3963 opt:0,
3964 req:[character],
3965 rest:0,
3966 sublists:0,
3967 whole:0
3968 }))).
3969*/
3970/*
3971:- side_effect(assert_lsp(alphanumericp, init_args(x, f_alphanumericp))).
3972*/
3973/*
3974#+(or WAM-CL LISP500)
3975(defun digit-char (weight &optional (radix 10))
3976 (when (< weight radix)
3977 (if (< weight 10)
3978 (code-char (+ 48 weight))
3979 (code-char (+ 55 weight)))))
3980
3981*/
3982
3983/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:10740 **********************/
3984:-lisp_compile_to_prolog(pkg_sys,[defun,'digit-char',[weight,'&optional',[radix,10]],[when,[<,weight,radix],[if,[<,weight,10],['code-char',[+,48,weight]],['code-char',[+,55,weight]]]]])
3985wl:lambda_def(defun, digit_char, f_digit_char, [sys_weight, c38_optional, [sys_radix, 10]], [[when, [<, sys_weight, sys_radix], [if, [<, sys_weight, 10], [code_char, [+, 48, sys_weight]], [code_char, [+, 55, sys_weight]]]]]).
3986wl:arglist_info(digit_char, f_digit_char, [sys_weight, c38_optional, [sys_radix, 10]], arginfo{all:[sys_weight, sys_radix], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_weight, sys_radix], opt:[sys_radix], req:[sys_weight], rest:0, sublists:0, whole:0}).
3987wl: init_args(1, f_digit_char).
3988
3993f_digit_char(Weight_In, RestNKeys, FnResult) :-
3994 GEnv=[bv(sys_weight, Weight_In), bv(sys_radix, Radix_In)],
3995 opt_var(Env, sys_radix, Radix_In, true, 10, 1, RestNKeys),
3996 catch(( ( get_var(GEnv, sys_radix, Radix_Get),
3997 get_var(GEnv, sys_weight, Weight_Get),
3998 ( Weight_Get<Radix_Get
3999 -> get_var(GEnv, sys_weight, Weight_Get14),
4000 ( Weight_Get14<10
4001 -> get_var(GEnv, sys_weight, Weight_Get17),
4002 'f_+'(48, Weight_Get17, Code_char_Param),
4003 f_code_char(Code_char_Param, TrueResult),
4004 TrueResult21=TrueResult
4005 ; get_var(GEnv, sys_weight, Weight_Get18),
4006 'f_+'(55, Weight_Get18, Code_char_Param26),
4007 f_code_char(Code_char_Param26, ElseResult),
4008 TrueResult21=ElseResult
4009 ),
4010 _7302=TrueResult21
4011 ; _7302=[]
4012 )
4013 ),
4014 _7302=FnResult
4015 ),
4016 block_exit(digit_char, FnResult),
4017 true).
4018:- set_opv(digit_char, symbol_function, f_digit_char),
4019 DefunResult=digit_char. 4020/*
4021:- side_effect(assert_lsp(digit_char,
4022 lambda_def(defun,
4023 digit_char,
4024 f_digit_char,
4025 [sys_weight, c38_optional, [sys_radix, 10]],
4026
4027 [
4028 [ when,
4029 [<, sys_weight, sys_radix],
4030
4031 [ if,
4032 [<, sys_weight, 10],
4033 [code_char, [+, 48, sys_weight]],
4034 [code_char, [+, 55, sys_weight]]
4035 ]
4036 ]
4037 ]))).
4038*/
4039/*
4040:- side_effect(assert_lsp(digit_char,
4041 arglist_info(digit_char,
4042 f_digit_char,
4043
4044 [ sys_weight,
4045 c38_optional,
4046 [sys_radix, 10]
4047 ],
4048 arginfo{ all:[sys_weight, sys_radix],
4049 allow_other_keys:0,
4050 aux:0,
4051 body:0,
4052 complex:0,
4053 env:0,
4054 key:0,
4055 names:[sys_weight, sys_radix],
4056 opt:[sys_radix],
4057 req:[sys_weight],
4058 rest:0,
4059 sublists:0,
4060 whole:0
4061 }))).
4062*/
4063/*
4064:- side_effect(assert_lsp(digit_char, init_args(1, f_digit_char))).
4065*/
4066/*
4067#+(or WAM-CL LISP500)
4068(defun digit-char-p (char &optional (radix 10))
4069 (let* ((code (char-code char))
4070 (weight (if (< 47 code 58)
4071 (- code 48)
4072 (if (< 64 code 91)
4073 (- code 55)
4074 (when (< 96 code 123)
4075 (- code 87))))))
4076 (and weight (< weight radix) weight)))
4077
4078*/
4079
4080/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:10923 **********************/
4081:-lisp_compile_to_prolog(pkg_sys,[defun,'digit-char-p',[char,'&optional',[radix,10]],['let*',[[code,['char-code',char]],[weight,[if,[<,47,code,58],[-,code,48],[if,[<,64,code,91],[-,code,55],[when,[<,96,code,123],[-,code,87]]]]]],[and,weight,[<,weight,radix],weight]]])
4082wl:lambda_def(defun, digit_char_p, f_digit_char_p, [char, c38_optional, [sys_radix, 10]], [[let_xx, [[sys_code, [char_code, char]], [sys_weight, [if, [<, 47, sys_code, 58], [-, sys_code, 48], [if, [<, 64, sys_code, 91], [-, sys_code, 55], [when, [<, 96, sys_code, 123], [-, sys_code, 87]]]]]], [and, sys_weight, [<, sys_weight, sys_radix], sys_weight]]]).
4083wl:arglist_info(digit_char_p, f_digit_char_p, [char, c38_optional, [sys_radix, 10]], arginfo{all:[char, sys_radix], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[char, sys_radix], opt:[sys_radix], req:[char], rest:0, sublists:0, whole:0}).
4084wl: init_args(1, f_digit_char_p).
4085
4090f_digit_char_p(Char_In, RestNKeys, FnResult) :-
4091 GEnv=[bv(char, Char_In), bv(sys_radix, Radix_In)],
4092 opt_var(Env, sys_radix, Radix_In, true, 10, 1, RestNKeys),
4093 catch(( ( get_var(GEnv, char, Char_Get),
4094 f_char_code(Char_Get, Code_Init),
4095 LEnv=[bv(sys_code, Code_Init)|GEnv],
4096 get_var(LEnv, sys_code, Code_Get),
4097 ( 47<Code_Get
4098 -> get_var(LEnv, sys_code, Code_Get21),
4099 'f_<'(Code_Get21, 58, TrueResult),
4100 IFTEST=TrueResult
4101 ; IFTEST=[]
4102 ),
4103 ( IFTEST\==[]
4104 -> get_var(LEnv, sys_code, Code_Get23),
4105 'f_-'(Code_Get23, 48, TrueResult45),
4106 Weight_Init=TrueResult45
4107 ; get_var(LEnv, sys_code, Code_Get27),
4108 ( 64<Code_Get27
4109 -> get_var(LEnv, sys_code, Code_Get30),
4110 'f_<'(Code_Get30, 91, TrueResult31),
4111 IFTEST24=TrueResult31
4112 ; IFTEST24=[]
4113 ),
4114 ( IFTEST24\==[]
4115 -> get_var(LEnv, sys_code, Code_Get32),
4116 'f_-'(Code_Get32, 55, TrueResult43),
4117 ElseResult46=TrueResult43
4118 ; get_var(LEnv, sys_code, Code_Get36),
4119 ( 96<Code_Get36
4120 -> get_var(LEnv, sys_code, Code_Get39),
4121 'f_<'(Code_Get39, 123, TrueResult40),
4122 IFTEST33=TrueResult40
4123 ; IFTEST33=[]
4124 ),
4125 ( IFTEST33\==[]
4126 -> get_var(LEnv, sys_code, Code_Get41),
4127 'f_-'(Code_Get41, 87, TrueResult42),
4128 ElseResult=TrueResult42
4129 ; ElseResult=[]
4130 ),
4131 ElseResult46=ElseResult
4132 ),
4133 Weight_Init=ElseResult46
4134 ),
4135 LEnv14=[bv(sys_weight, Weight_Init)|LEnv],
4136 get_var(LEnv14, sys_weight, IFTEST48),
4137 ( IFTEST48\==[]
4138 -> get_var(LEnv14, sys_radix, Radix_Get),
4139 get_var(LEnv14, sys_weight, Weight_Get52),
4140 ( Weight_Get52<Radix_Get
4141 -> get_var(LEnv14, sys_weight, Weight_Get57),
4142 TrueResult59=Weight_Get57
4143 ; TrueResult59=[]
4144 ),
4145 LetResult13=TrueResult59
4146 ; LetResult13=[]
4147 )
4148 ),
4149 LetResult13=FnResult
4150 ),
4151 block_exit(digit_char_p, FnResult),
4152 true).
4153:- set_opv(digit_char_p, symbol_function, f_digit_char_p),
4154 DefunResult=digit_char_p. 4155/*
4156:- side_effect(assert_lsp(digit_char_p,
4157 lambda_def(defun,
4158 digit_char_p,
4159 f_digit_char_p,
4160 [char, c38_optional, [sys_radix, 10]],
4161
4162 [
4163 [ let_xx,
4164
4165 [ [sys_code, [char_code, char]],
4166
4167 [ sys_weight,
4168
4169 [ if,
4170 [<, 47, sys_code, 58],
4171 [-, sys_code, 48],
4172
4173 [ if,
4174 [<, 64, sys_code, 91],
4175 [-, sys_code, 55],
4176
4177 [ when,
4178 [<, 96, sys_code, 123],
4179 [-, sys_code, 87]
4180 ]
4181 ]
4182 ]
4183 ]
4184 ],
4185
4186 [ and,
4187 sys_weight,
4188 [<, sys_weight, sys_radix],
4189 sys_weight
4190 ]
4191 ]
4192 ]))).
4193*/
4194/*
4195:- side_effect(assert_lsp(digit_char_p,
4196 arglist_info(digit_char_p,
4197 f_digit_char_p,
4198 [char, c38_optional, [sys_radix, 10]],
4199 arginfo{ all:[char, sys_radix],
4200 allow_other_keys:0,
4201 aux:0,
4202 body:0,
4203 complex:0,
4204 env:0,
4205 key:0,
4206 names:[char, sys_radix],
4207 opt:[sys_radix],
4208 req:[char],
4209 rest:0,
4210 sublists:0,
4211 whole:0
4212 }))).
4213*/
4214/*
4215:- side_effect(assert_lsp(digit_char_p, init_args(1, f_digit_char_p))).
4216*/
4217/*
4218#+(or WAM-CL LISP500)
4219(defun standard-char-p (character)
4220 (let ((code (char-code character)))
4221 (or (= code 10)
4222 (< 31 code 127))))
4223
4224*/
4225
4226/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:11221 **********************/
4227:-lisp_compile_to_prolog(pkg_sys,[defun,'standard-char-p',[character],[let,[[code,['char-code',character]]],[or,[=,code,10],[<,31,code,127]]]])
4228wl:lambda_def(defun, standard_char_p, f_standard_char_p, [character], [[let, [[sys_code, [char_code, character]]], [or, [=, sys_code, 10], [<, 31, sys_code, 127]]]]).
4229wl:arglist_info(standard_char_p, f_standard_char_p, [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}).
4230wl: init_args(x, f_standard_char_p).
4231
4236f_standard_char_p(Character_In, FnResult) :-
4237 GEnv=[bv(character, Character_In)],
4238 catch(( ( get_var(GEnv, character, Character_Get),
4239 f_char_code(Character_Get, Code_Init),
4240 LEnv=[bv(sys_code, Code_Init)|GEnv],
4241 ( get_var(LEnv, sys_code, Code_Get),
4242 'f_='(Code_Get, 10, FORM1_Res),
4243 FORM1_Res\==[],
4244 LetResult=FORM1_Res
4245 -> true
4246 ; get_var(LEnv, sys_code, Code_Get12),
4247 ( 31<Code_Get12
4248 -> get_var(LEnv, sys_code, Code_Get15),
4249 'f_<'(Code_Get15, 127, TrueResult),
4250 _9704=TrueResult
4251 ; _9704=[]
4252 ),
4253 LetResult=_9704
4254 )
4255 ),
4256 LetResult=FnResult
4257 ),
4258 block_exit(standard_char_p, FnResult),
4259 true).
4260:- set_opv(standard_char_p, symbol_function, f_standard_char_p),
4261 DefunResult=standard_char_p. 4262/*
4263:- side_effect(assert_lsp(standard_char_p,
4264 lambda_def(defun,
4265 standard_char_p,
4266 f_standard_char_p,
4267 [character],
4268
4269 [
4270 [ let,
4271 [[sys_code, [char_code, character]]],
4272
4273 [ or,
4274 [=, sys_code, 10],
4275 [<, 31, sys_code, 127]
4276 ]
4277 ]
4278 ]))).
4279*/
4280/*
4281:- side_effect(assert_lsp(standard_char_p,
4282 arglist_info(standard_char_p,
4283 f_standard_char_p,
4284 [character],
4285 arginfo{ all:[character],
4286 allow_other_keys:0,
4287 aux:0,
4288 body:0,
4289 complex:0,
4290 env:0,
4291 key:0,
4292 names:[character],
4293 opt:0,
4294 req:[character],
4295 rest:0,
4296 sublists:0,
4297 whole:0
4298 }))).
4299*/
4300/*
4301:- side_effect(assert_lsp(standard_char_p, init_args(x, f_standard_char_p))).
4302*/
4303/*
4304#+(or WAM-CL LISP500)
4305(defun char-upcase (character)
4306 (let ((code (char-code character)))
4307 (if (< 96 code 123)
4308 (code-char (- code 32))
4309 character)))
4310
4311*/
4312
4313/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:11364 **********************/
4314:-lisp_compile_to_prolog(pkg_sys,[defun,'char-upcase',[character],[let,[[code,['char-code',character]]],[if,[<,96,code,123],['code-char',[-,code,32]],character]]])
4315wl:lambda_def(defun, char_upcase, f_char_upcase, [character], [[let, [[sys_code, [char_code, character]]], [if, [<, 96, sys_code, 123], [code_char, [-, sys_code, 32]], character]]]).
4316wl:arglist_info(char_upcase, f_char_upcase, [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}).
4317wl: init_args(x, f_char_upcase).
4318
4323f_char_upcase(Character_In, FnResult) :-
4324 GEnv=[bv(character, Character_In)],
4325 catch(( ( get_var(GEnv, character, Character_Get),
4326 f_char_code(Character_Get, Code_Init),
4327 LEnv=[bv(sys_code, Code_Init)|GEnv],
4328 get_var(LEnv, sys_code, Code_Get),
4329 ( 96<Code_Get
4330 -> get_var(LEnv, sys_code, Code_Get16),
4331 'f_<'(Code_Get16, 123, TrueResult),
4332 IFTEST=TrueResult
4333 ; IFTEST=[]
4334 ),
4335 ( IFTEST\==[]
4336 -> get_var(LEnv, sys_code, Code_Get18),
4337 'f_-'(Code_Get18, 32, Code_char_Param),
4338 f_code_char(Code_char_Param, TrueResult20),
4339 LetResult=TrueResult20
4340 ; get_var(LEnv, character, Character_Get19),
4341 LetResult=Character_Get19
4342 )
4343 ),
4344 LetResult=FnResult
4345 ),
4346 block_exit(char_upcase, FnResult),
4347 true).
4348:- set_opv(char_upcase, symbol_function, f_char_upcase),
4349 DefunResult=char_upcase. 4350/*
4351:- side_effect(assert_lsp(char_upcase,
4352 lambda_def(defun,
4353 char_upcase,
4354 f_char_upcase,
4355 [character],
4356
4357 [
4358 [ let,
4359 [[sys_code, [char_code, character]]],
4360
4361 [ if,
4362 [<, 96, sys_code, 123],
4363 [code_char, [-, sys_code, 32]],
4364 character
4365 ]
4366 ]
4367 ]))).
4368*/
4369/*
4370:- side_effect(assert_lsp(char_upcase,
4371 arglist_info(char_upcase,
4372 f_char_upcase,
4373 [character],
4374 arginfo{ all:[character],
4375 allow_other_keys:0,
4376 aux:0,
4377 body:0,
4378 complex:0,
4379 env:0,
4380 key:0,
4381 names:[character],
4382 opt:0,
4383 req:[character],
4384 rest:0,
4385 sublists:0,
4386 whole:0
4387 }))).
4388*/
4389/*
4390:- side_effect(assert_lsp(char_upcase, init_args(x, f_char_upcase))).
4391*/
4392/*
4393#+(or WAM-CL LISP500)
4394(defun char-downcase (character)
4395 (let ((code (char-code character)))
4396 (if (< 64 code 91)
4397 (code-char (+ code 32))
4398 character)))
4399
4400*/
4401
4402/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:11527 **********************/
4403:-lisp_compile_to_prolog(pkg_sys,[defun,'char-downcase',[character],[let,[[code,['char-code',character]]],[if,[<,64,code,91],['code-char',[+,code,32]],character]]])
4404wl:lambda_def(defun, char_downcase, f_char_downcase, [character], [[let, [[sys_code, [char_code, character]]], [if, [<, 64, sys_code, 91], [code_char, [+, sys_code, 32]], character]]]).
4405wl:arglist_info(char_downcase, f_char_downcase, [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}).
4406wl: init_args(x, f_char_downcase).
4407
4412f_char_downcase(Character_In, FnResult) :-
4413 GEnv=[bv(character, Character_In)],
4414 catch(( ( get_var(GEnv, character, Character_Get),
4415 f_char_code(Character_Get, Code_Init),
4416 LEnv=[bv(sys_code, Code_Init)|GEnv],
4417 get_var(LEnv, sys_code, Code_Get),
4418 ( 64<Code_Get
4419 -> get_var(LEnv, sys_code, Code_Get16),
4420 'f_<'(Code_Get16, 91, TrueResult),
4421 IFTEST=TrueResult
4422 ; IFTEST=[]
4423 ),
4424 ( IFTEST\==[]
4425 -> get_var(LEnv, sys_code, Code_Get18),
4426 'f_+'(Code_Get18, 32, Code_char_Param),
4427 f_code_char(Code_char_Param, TrueResult20),
4428 LetResult=TrueResult20
4429 ; get_var(LEnv, character, Character_Get19),
4430 LetResult=Character_Get19
4431 )
4432 ),
4433 LetResult=FnResult
4434 ),
4435 block_exit(char_downcase, FnResult),
4436 true).
4437:- set_opv(char_downcase, symbol_function, f_char_downcase),
4438 DefunResult=char_downcase. 4439/*
4440:- side_effect(assert_lsp(char_downcase,
4441 lambda_def(defun,
4442 char_downcase,
4443 f_char_downcase,
4444 [character],
4445
4446 [
4447 [ let,
4448 [[sys_code, [char_code, character]]],
4449
4450 [ if,
4451 [<, 64, sys_code, 91],
4452 [code_char, [+, sys_code, 32]],
4453 character
4454 ]
4455 ]
4456 ]))).
4457*/
4458/*
4459:- side_effect(assert_lsp(char_downcase,
4460 arglist_info(char_downcase,
4461 f_char_downcase,
4462 [character],
4463 arginfo{ all:[character],
4464 allow_other_keys:0,
4465 aux:0,
4466 body:0,
4467 complex:0,
4468 env:0,
4469 key:0,
4470 names:[character],
4471 opt:0,
4472 req:[character],
4473 rest:0,
4474 sublists:0,
4475 whole:0
4476 }))).
4477*/
4478/*
4479:- side_effect(assert_lsp(char_downcase, init_args(x, f_char_downcase))).
4480*/
4481/*
4482#+(or WAM-CL LISP500)
4483(defun upper-case-p (character)
4484 (< 64 (char-code character) 91))
4485
4486*/
4487
4488/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:11691 **********************/
4489:-lisp_compile_to_prolog(pkg_sys,[defun,'upper-case-p',[character],[<,64,['char-code',character],91]])
4490wl:lambda_def(defun, upper_case_p, f_upper_case_p, [character], [[<, 64, [char_code, character], 91]]).
4491wl:arglist_info(upper_case_p, f_upper_case_p, [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}).
4492wl: init_args(x, f_upper_case_p).
4493
4498f_upper_case_p(Character_In, FnResult) :-
4499 GEnv=[bv(character, Character_In)],
4500 catch(( ( get_var(GEnv, character, Character_Get),
4501 f_char_code(Character_Get, PredArg2Result),
4502 ( 64<PredArg2Result
4503 -> get_var(GEnv, character, Character_Get9),
4504 f_char_code(Character_Get9, Char_code_Ret),
4505 'f_<'(Char_code_Ret, 91, TrueResult),
4506 _6738=TrueResult
4507 ; _6738=[]
4508 )
4509 ),
4510 _6738=FnResult
4511 ),
4512 block_exit(upper_case_p, FnResult),
4513 true).
4514:- set_opv(upper_case_p, symbol_function, f_upper_case_p),
4515 DefunResult=upper_case_p. 4516/*
4517:- side_effect(assert_lsp(upper_case_p,
4518 lambda_def(defun,
4519 upper_case_p,
4520 f_upper_case_p,
4521 [character],
4522 [[<, 64, [char_code, character], 91]]))).
4523*/
4524/*
4525:- side_effect(assert_lsp(upper_case_p,
4526 arglist_info(upper_case_p,
4527 f_upper_case_p,
4528 [character],
4529 arginfo{ all:[character],
4530 allow_other_keys:0,
4531 aux:0,
4532 body:0,
4533 complex:0,
4534 env:0,
4535 key:0,
4536 names:[character],
4537 opt:0,
4538 req:[character],
4539 rest:0,
4540 sublists:0,
4541 whole:0
4542 }))).
4543*/
4544/*
4545:- side_effect(assert_lsp(upper_case_p, init_args(x, f_upper_case_p))).
4546*/
4547/*
4548#+(or WAM-CL LISP500)
4549(defun lower-case-p (character)
4550 (< 96 (char-code character) 123))
4551
4552*/
4553
4554/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:11786 **********************/
4555:-lisp_compile_to_prolog(pkg_sys,[defun,'lower-case-p',[character],[<,96,['char-code',character],123]])
4556wl:lambda_def(defun, lower_case_p, f_lower_case_p, [character], [[<, 96, [char_code, character], 123]]).
4557wl:arglist_info(lower_case_p, f_lower_case_p, [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}).
4558wl: init_args(x, f_lower_case_p).
4559
4564f_lower_case_p(Character_In, FnResult) :-
4565 GEnv=[bv(character, Character_In)],
4566 catch(( ( get_var(GEnv, character, Character_Get),
4567 f_char_code(Character_Get, PredArg2Result),
4568 ( 96<PredArg2Result
4569 -> get_var(GEnv, character, Character_Get9),
4570 f_char_code(Character_Get9, Char_code_Ret),
4571 'f_<'(Char_code_Ret, 123, TrueResult),
4572 _6738=TrueResult
4573 ; _6738=[]
4574 )
4575 ),
4576 _6738=FnResult
4577 ),
4578 block_exit(lower_case_p, FnResult),
4579 true).
4580:- set_opv(lower_case_p, symbol_function, f_lower_case_p),
4581 DefunResult=lower_case_p. 4582/*
4583:- side_effect(assert_lsp(lower_case_p,
4584 lambda_def(defun,
4585 lower_case_p,
4586 f_lower_case_p,
4587 [character],
4588 [[<, 96, [char_code, character], 123]]))).
4589*/
4590/*
4591:- side_effect(assert_lsp(lower_case_p,
4592 arglist_info(lower_case_p,
4593 f_lower_case_p,
4594 [character],
4595 arginfo{ all:[character],
4596 allow_other_keys:0,
4597 aux:0,
4598 body:0,
4599 complex:0,
4600 env:0,
4601 key:0,
4602 names:[character],
4603 opt:0,
4604 req:[character],
4605 rest:0,
4606 sublists:0,
4607 whole:0
4608 }))).
4609*/
4610/*
4611:- side_effect(assert_lsp(lower_case_p, init_args(x, f_lower_case_p))).
4612*/
4613/*
4614#+(or WAM-CL LISP500)
4615(defun both-case-p (character)
4616 (or (upper-case-p character) (lower-case-p character)))
4617
4618*/
4619
4620/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:11882 **********************/
4621:-lisp_compile_to_prolog(pkg_sys,[defun,'both-case-p',[character],[or,['upper-case-p',character],['lower-case-p',character]]])
4622wl:lambda_def(defun, both_case_p, f_both_case_p, [character], [[or, [upper_case_p, character], [lower_case_p, character]]]).
4623wl:arglist_info(both_case_p, f_both_case_p, [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}).
4624wl: init_args(x, f_both_case_p).
4625
4630f_both_case_p(Character_In, FnResult) :-
4631 GEnv=[bv(character, Character_In)],
4632 catch(( ( get_var(GEnv, character, Character_Get),
4633 f_upper_case_p(Character_Get, FORM1_Res),
4634 FORM1_Res\==[],
4635 _6766=FORM1_Res
4636 -> true
4637 ; get_var(GEnv, character, Character_Get6),
4638 f_lower_case_p(Character_Get6, Case_p_Ret),
4639 _6766=Case_p_Ret
4640 ),
4641 _6766=FnResult
4642 ),
4643 block_exit(both_case_p, FnResult),
4644 true).
4645:- set_opv(both_case_p, symbol_function, f_both_case_p),
4646 DefunResult=both_case_p. 4647/*
4648:- side_effect(assert_lsp(both_case_p,
4649 lambda_def(defun,
4650 both_case_p,
4651 f_both_case_p,
4652 [character],
4653
4654 [
4655 [ or,
4656 [upper_case_p, character],
4657 [lower_case_p, character]
4658 ]
4659 ]))).
4660*/
4661/*
4662:- side_effect(assert_lsp(both_case_p,
4663 arglist_info(both_case_p,
4664 f_both_case_p,
4665 [character],
4666 arginfo{ all:[character],
4667 allow_other_keys:0,
4668 aux:0,
4669 body:0,
4670 complex:0,
4671 env:0,
4672 key:0,
4673 names:[character],
4674 opt:0,
4675 req:[character],
4676 rest:0,
4677 sublists:0,
4678 whole:0
4679 }))).
4680*/
4681/*
4682:- side_effect(assert_lsp(both_case_p, init_args(x, f_both_case_p))).
4683*/
4684/*
4685#+(or WAM-CL LISP500)
4686(defun char-int (character)
4687 (char-code character))
4688
4689*/
4690
4691/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:11999 **********************/
4692:-lisp_compile_to_prolog(pkg_sys,[defun,'char-int',[character],['char-code',character]])
4693wl:lambda_def(defun, char_int, f_char_int, [character], [[char_code, character]]).
4694wl:arglist_info(char_int, f_char_int, [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}).
4695wl: init_args(x, f_char_int).
4696
4701f_char_int(Character_In, FnResult) :-
4702 GEnv=[bv(character, Character_In)],
4703 catch(( ( get_var(GEnv, character, Character_Get),
4704 f_char_code(Character_Get, Char_code_Ret)
4705 ),
4706 Char_code_Ret=FnResult
4707 ),
4708 block_exit(char_int, FnResult),
4709 true).
4710:- set_opv(char_int, symbol_function, f_char_int),
4711 DefunResult=char_int. 4712/*
4713:- side_effect(assert_lsp(char_int,
4714 lambda_def(defun,
4715 char_int,
4716 f_char_int,
4717 [character],
4718 [[char_code, character]]))).
4719*/
4720/*
4721:- side_effect(assert_lsp(char_int,
4722 arglist_info(char_int,
4723 f_char_int,
4724 [character],
4725 arginfo{ all:[character],
4726 allow_other_keys:0,
4727 aux:0,
4728 body:0,
4729 complex:0,
4730 env:0,
4731 key:0,
4732 names:[character],
4733 opt:0,
4734 req:[character],
4735 rest:0,
4736 sublists:0,
4737 whole:0
4738 }))).
4739*/
4740/*
4741:- side_effect(assert_lsp(char_int, init_args(x, f_char_int))).
4742*/
4743/*
4744#+(or WAM-CL LISP500)
4745(defconstant char-code-limit 256)
4746
4747*/
4748
4749/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:12080 **********************/
4750:-lisp_compile_to_prolog(pkg_sys,[defconstant,'char-code-limit',256])
4751:- set_var(AEnv, char_code_limit, 256).
4752/*
4753#+(or WAM-CL LISP500)
4754(let ((char-names '((0 . "Null")
4755 (8 . "Backspace")
4756 (9 . "Tab")
4757 (10 . "Newline")
4758 (12 . "Page")
4759 (13 . "Return")
4760 (32 . "Space")
4761 (127 . "Rubout"))))
4762 (defun char-name (character)
4763 (let* ((code (char-code character))
4764 (name (cdr (assoc code char-names))))
4765 (or name (when (< code 32)
4766 (conc-string "U+" (integer-string code))))))
4767 (defun name-char (name)
4768 (setq name (designator-string name))
4769 (if (< (length name) 2)
4770 (aref name 0)
4771 (if (= (char-code (aref name 0)) 85)
4772 (code-char (parse-integer name :start 2))
4773 (let ((code (car (rassoc name char-names :test #'string-equal))))
4774 (when code (code-char code)))))))
4775
4776*/
4777
4778/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:12141 **********************/
4779:-lisp_compile_to_prolog(pkg_sys,[let,[['char-names',[quote,[[0|'$STRING'("Null")],[8|'$STRING'("Backspace")],[9|'$STRING'("Tab")],[10|'$STRING'("Newline")],[12|'$STRING'("Page")],[13|'$STRING'("Return")],[32|'$STRING'("Space")],[127|'$STRING'("Rubout")]]]]],[defun,'char-name',[character],['let*',[[code,['char-code',character]],[name,[cdr,[assoc,code,'char-names']]]],[or,name,[when,[<,code,32],['conc-string','$STRING'("U+"),['integer-string',code]]]]]],[defun,'name-char',[name],[setq,name,['designator-string',name]],[if,[<,[length,name],2],[aref,name,0],[if,[=,['char-code',[aref,name,0]],85],['code-char',['parse-integer',name,':start',2]],[let,[[code,[car,[rassoc,name,'char-names',':test',function('string-equal')]]]],[when,code,['code-char',code]]]]]]])
4780/*
4781:- side_effect(generate_function_or_macro_name(
4782 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
4783 name='GLOBAL',
4784 environ=env_1
4785 ],
4786 sys_conc_string,
4787 kw_function,
4788 f_sys_conc_string)).
4789*/
4790:- LEnv=[bv(sys_char_names, [[0|'$ARRAY'([*], claz_base_character, "Null")], [8|'$ARRAY'([*], claz_base_character, "Backspace")], [9|'$ARRAY'([*], claz_base_character, "Tab")], [10|'$ARRAY'([*], claz_base_character, "Newline")], [12|'$ARRAY'([*], claz_base_character, "Page")], [13|'$ARRAY'([*], claz_base_character, "Return")], [32|'$ARRAY'([*], claz_base_character, "Space")], [127|'$ARRAY'([*], claz_base_character, "Rubout")]])|CDR].
4791wl:lambda_def(defun, char_name, f_char_name, [character], [[let_xx, [[sys_code, [char_code, character]], [sys_name, [cdr, [assoc, sys_code, sys_char_names]]]], [or, sys_name, [when, [<, sys_code, 32], [sys_conc_string, '$ARRAY'([*], claz_base_character, "U+"), [sys_integer_string, sys_code]]]]]]).
4792wl:arglist_info(char_name, f_char_name, [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}).
4793wl: init_args(x, f_char_name).
4794
4799f_char_name(Character_In, FnResult) :-
4800 GEnv=[bv(character, Character_In)],
4801 catch(( ( get_var(GEnv, character, Character_Get),
4802 f_char_code(Character_Get, Code_Init),
4803 LEnv10=[bv(sys_code, Code_Init)|GEnv],
4804 get_var(LEnv10, sys_char_names, Char_names_Get),
4805 get_var(LEnv10, sys_code, Code_Get),
4806 f_assoc(Code_Get, Char_names_Get, [], Cdr_Param),
4807 f_cdr(Cdr_Param, Name_Init),
4808 LEnv15=[bv(sys_name, Name_Init)|LEnv10],
4809 ( get_var(LEnv15, sys_name, Name_Get),
4810 Name_Get\==[],
4811 LetResult9=Name_Get
4812 -> true
4813 ; get_var(LEnv15, sys_code, Code_Get21),
4814 ( Code_Get21<32
4815 -> get_var(LEnv15, sys_code, Code_Get24),
4816 f_sys_integer_string(Code_Get24,
4817 [],
4818 Integer_string_Ret),
4819 f_sys_conc_string('$ARRAY'([*],
4820 claz_base_character,
4821 "U+"),
4822 Integer_string_Ret,
4823 TrueResult),
4824 _10574=TrueResult
4825 ; _10574=[]
4826 ),
4827 LetResult9=_10574
4828 )
4829 ),
4830 LetResult9=FnResult
4831 ),
4832 block_exit(char_name, FnResult),
4833 true).
4834:- set_opv(char_name, symbol_function, f_char_name),
4835 DefunResult=char_name,
4836 assert_lsp(name_char,
4837 wl:lambda_def(defun, name_char, f_name_char, [sys_name], [[setq, sys_name, [sys_designator_string, sys_name]], [if, [<, [length, sys_name], 2], [aref, sys_name, 0], [if, [=, [char_code, [aref, sys_name, 0]], 85], [code_char, [parse_integer, sys_name, kw_start, 2]], [let, [[sys_code, [car, [rassoc, sys_name, sys_char_names, kw_test, function(string_equal)]]]], [when, sys_code, [code_char, sys_code]]]]]])),
4838 assert_lsp(name_char,
4839 wl:arglist_info(name_char, f_name_char, [sys_name], arginfo{all:[sys_name], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_name], opt:0, req:[sys_name], rest:0, sublists:0, whole:0})),
4840 assert_lsp(name_char, wl:init_args(x, f_name_char)),
4841 assert_lsp(name_char,
4842 (f_name_char(Name_In, FnResult29):-AEnv=[bv(sys_name, Name_In)], catch(((get_var(AEnv, sys_name, Name_Get33), f_sys_designator_string(Name_Get33, Name), set_var(AEnv, sys_name, Name), get_var(AEnv, sys_name, Name_Get35), f_length(Name_Get35, PredArg1Result37), (PredArg1Result37<2->get_var(AEnv, sys_name, Name_Get38), f_aref(Name_Get38, [0], TrueResult57), _10844=TrueResult57;get_var(AEnv, sys_name, Name_Get40), f_aref(Name_Get40, [0], Char_code_Param), f_char_code(Char_code_Param, PredArg1Result42), (PredArg1Result42=:=85->get_var(AEnv, sys_name, Name_Get43), f_parse_integer(Name_Get43, kw_start, 2, Code_char_Param), f_code_char(Code_char_Param, TrueResult55), ElseResult58=TrueResult55;get_var(AEnv, sys_char_names, Char_names_Get48), get_var(AEnv, sys_name, Name_Get47), f_rassoc(Name_Get47, Char_names_Get48, [kw_test, f_string_equal], Car_Param), f_car(Car_Param, Code_Init49), LEnv46=[bv(sys_code, Code_Init49)|AEnv], get_var(LEnv46, sys_code, IFTEST50), (IFTEST50\==[]->get_var(LEnv46, sys_code, Code_Get53), f_code_char(Code_Get53, TrueResult54), LetResult45=TrueResult54;LetResult45=[]), ElseResult58=LetResult45), _10844=ElseResult58)), _10844=FnResult29), block_exit(name_char, FnResult29), true))),
4843 set_opv(name_char, symbol_function, f_name_char),
4844 DefunResult60=name_char. 4845/*
4846:- side_effect(assert_lsp(char_name,
4847 lambda_def(defun,
4848 char_name,
4849 f_char_name,
4850 [character],
4851
4852 [
4853 [ let_xx,
4854
4855 [ [sys_code, [char_code, character]],
4856
4857 [ sys_name,
4858
4859 [ cdr,
4860 [assoc, sys_code, sys_char_names]
4861 ]
4862 ]
4863 ],
4864
4865 [ or,
4866 sys_name,
4867
4868 [ when,
4869 [<, sys_code, 32],
4870
4871 [ sys_conc_string,
4872 '$ARRAY'([*],
4873 claz_base_character,
4874 "U+"),
4875 [sys_integer_string, sys_code]
4876 ]
4877 ]
4878 ]
4879 ]
4880 ]))).
4881*/
4882/*
4883:- side_effect(assert_lsp(char_name,
4884 arglist_info(char_name,
4885 f_char_name,
4886 [character],
4887 arginfo{ all:[character],
4888 allow_other_keys:0,
4889 aux:0,
4890 body:0,
4891 complex:0,
4892 env:0,
4893 key:0,
4894 names:[character],
4895 opt:0,
4896 req:[character],
4897 rest:0,
4898 sublists:0,
4899 whole:0
4900 }))).
4901*/
4902/*
4903:- side_effect(assert_lsp(char_name, init_args(x, f_char_name))).
4904*/
4905/*
4906:- side_effect(assert_lsp(name_char,
4907 lambda_def(defun,
4908 name_char,
4909 f_name_char,
4910 [sys_name],
4911
4912 [
4913 [ setq,
4914 sys_name,
4915 [sys_designator_string, sys_name]
4916 ],
4917
4918 [ if,
4919 [<, [length, sys_name], 2],
4920 [aref, sys_name, 0],
4921
4922 [ if,
4923
4924 [ (=),
4925 [char_code, [aref, sys_name, 0]],
4926 85
4927 ],
4928
4929 [ code_char,
4930
4931 [ parse_integer,
4932 sys_name,
4933 kw_start,
4934 2
4935 ]
4936 ],
4937
4938 [ let,
4939
4940 [
4941 [ sys_code,
4942
4943 [ car,
4944
4945 [ rassoc,
4946 sys_name,
4947 sys_char_names,
4948 kw_test,
4949 function(string_equal)
4950 ]
4951 ]
4952 ]
4953 ],
4954
4955 [ when,
4956 sys_code,
4957 [code_char, sys_code]
4958 ]
4959 ]
4960 ]
4961 ]
4962 ]))).
4963*/
4964/*
4965:- side_effect(assert_lsp(name_char,
4966 arglist_info(name_char,
4967 f_name_char,
4968 [sys_name],
4969 arginfo{ all:[sys_name],
4970 allow_other_keys:0,
4971 aux:0,
4972 body:0,
4973 complex:0,
4974 env:0,
4975 key:0,
4976 names:[sys_name],
4977 opt:0,
4978 req:[sys_name],
4979 rest:0,
4980 sublists:0,
4981 whole:0
4982 }))).
4983*/
4984/*
4985:- side_effect(assert_lsp(name_char, init_args(x, f_name_char))).
4986*/
4987/*
4988#+BUILTIN
4989#+(or WAM-CL LISP500)
4990(defun atom (object) (not (consp object)))
4991
4992*/
4993
4994/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:12876 **********************/
4995:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,atom,[object],[not,[consp,object]]]]]))
4996/*
4997#+BUILTIN
4998#+(or WAM-CL LISP500)
4999(defun rplaca (cons object) (setf (car cons) object) cons)
5000
5001*/
5002
5003/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:12957 **********************/
5004:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,rplaca,[cons,object],[setf,[car,cons],object],cons]]]))
5005/*
5006#+BUILTIN
5007#+(or WAM-CL LISP500)
5008(defun rplacd (cons object) (setf (cdr cons) object) cons)
5009
5010
5011
5012*/
5013
5014/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:13054 **********************/
5015:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,rplacd,[cons,object],[setf,[cdr,cons],object],cons]]]))
5016/*
5017#+(or WAM-CL LISP500)
5018(defun copy-tree (tree)
5019 (if (consp tree) (cons (copy-tree (car tree)) (copy-tree (cdr tree))) tree))
5020
5021*/
5022
5023/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:13155 **********************/
5024:-lisp_compile_to_prolog(pkg_sys,[defun,'copy-tree',[tree],[if,[consp,tree],[cons,['copy-tree',[car,tree]],['copy-tree',[cdr,tree]]],tree]])
5025wl:lambda_def(defun, copy_tree, f_copy_tree, [sys_tree], [[if, [consp, sys_tree], [cons, [copy_tree, [car, sys_tree]], [copy_tree, [cdr, sys_tree]]], sys_tree]]).
5026wl:arglist_info(copy_tree, f_copy_tree, [sys_tree], arginfo{all:[sys_tree], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_tree], opt:0, req:[sys_tree], rest:0, sublists:0, whole:0}).
5027wl: init_args(x, f_copy_tree).
5028
5033f_copy_tree(Tree_In, FnResult) :-
5034 GEnv=[bv(sys_tree, Tree_In)],
5035 catch(( ( get_var(GEnv, sys_tree, Tree_Get),
5036 ( c0nz:is_consp(Tree_Get)
5037 -> get_var(GEnv, sys_tree, Tree_Get9),
5038 f_car(Tree_Get9, Copy_tree_Param),
5039 f_copy_tree(Copy_tree_Param, Copy_tree_Ret),
5040 get_var(GEnv, sys_tree, Tree_Get10),
5041 f_cdr(Tree_Get10, Copy_tree_Param18),
5042 f_copy_tree(Copy_tree_Param18, Copy_tree_Ret20),
5043 TrueResult=[Copy_tree_Ret|Copy_tree_Ret20],
5044 _7006=TrueResult
5045 ; get_var(GEnv, sys_tree, Tree_Get11),
5046 _7006=Tree_Get11
5047 )
5048 ),
5049 _7006=FnResult
5050 ),
5051 block_exit(copy_tree, FnResult),
5052 true).
5053:- set_opv(copy_tree, symbol_function, f_copy_tree),
5054 DefunResult=copy_tree. 5055/*
5056:- side_effect(assert_lsp(copy_tree,
5057 lambda_def(defun,
5058 copy_tree,
5059 f_copy_tree,
5060 [sys_tree],
5061
5062 [
5063 [ if,
5064 [consp, sys_tree],
5065
5066 [ cons,
5067 [copy_tree, [car, sys_tree]],
5068 [copy_tree, [cdr, sys_tree]]
5069 ],
5070 sys_tree
5071 ]
5072 ]))).
5073*/
5074/*
5075:- side_effect(assert_lsp(copy_tree,
5076 arglist_info(copy_tree,
5077 f_copy_tree,
5078 [sys_tree],
5079 arginfo{ all:[sys_tree],
5080 allow_other_keys:0,
5081 aux:0,
5082 body:0,
5083 complex:0,
5084 env:0,
5085 key:0,
5086 names:[sys_tree],
5087 opt:0,
5088 req:[sys_tree],
5089 rest:0,
5090 sublists:0,
5091 whole:0
5092 }))).
5093*/
5094/*
5095:- side_effect(assert_lsp(copy_tree, init_args(x, f_copy_tree))).
5096*/
5097/*
5098#+(or WAM-CL LISP500)
5099(defun sublis (alist tree &rest rest)
5100 (if (consp tree)
5101 (let ((a (apply #'sublis alist (car tree) rest))
5102 (d (apply #'sublis alist (cdr tree) rest)))
5103 (if (and (eq a (car tree)) (eq d (cdr tree)))
5104 tree
5105 (cons a d)))
5106 (let ((a (apply #'assoc tree alist rest)))
5107 (if a (cdr a) tree))))
5108
5109*/
5110
5111/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:13286 **********************/
5112:-lisp_compile_to_prolog(pkg_sys,[defun,sublis,[alist,tree,'&rest',rest],[if,[consp,tree],[let,[[a,[apply,function(sublis),alist,[car,tree],rest]],[d,[apply,function(sublis),alist,[cdr,tree],rest]]],[if,[and,[eq,a,[car,tree]],[eq,d,[cdr,tree]]],tree,[cons,a,d]]],[let,[[a,[apply,function(assoc),tree,alist,rest]]],[if,a,[cdr,a],tree]]]])
5113wl:lambda_def(defun, sublis, f_sublis, [sys_alist, sys_tree, c38_rest, rest], [[if, [consp, sys_tree], [let, [[sys_a, [apply, function(sublis), sys_alist, [car, sys_tree], rest]], [sys_d, [apply, function(sublis), sys_alist, [cdr, sys_tree], rest]]], [if, [and, [eq, sys_a, [car, sys_tree]], [eq, sys_d, [cdr, sys_tree]]], sys_tree, [cons, sys_a, sys_d]]], [let, [[sys_a, [apply, function(assoc), sys_tree, sys_alist, rest]]], [if, sys_a, [cdr, sys_a], sys_tree]]]]).
5114wl:arglist_info(sublis, f_sublis, [sys_alist, sys_tree, c38_rest, rest], arginfo{all:[sys_alist, sys_tree], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_alist, sys_tree, rest], opt:0, req:[sys_alist, sys_tree], rest:[rest], sublists:0, whole:0}).
5115wl: init_args(2, f_sublis).
5116
5121f_sublis(Alist_In, Tree_In, RestNKeys, FnResult) :-
5122 GEnv=[bv(sys_alist, Alist_In), bv(sys_tree, Tree_In), bv(rest, RestNKeys)],
5123 catch(( ( get_var(GEnv, sys_tree, Tree_Get),
5124 ( c0nz:is_consp(Tree_Get)
5125 -> get_var(GEnv, sys_alist, Alist_Get),
5126 get_var(GEnv, sys_tree, Tree_Get15),
5127 f_car(Tree_Get15, Car_Ret),
5128 get_var(GEnv, rest, Rest_Get),
5129 f_apply(f_sublis, [Alist_Get, Car_Ret, Rest_Get], A_Init),
5130 get_var(GEnv, sys_alist, Alist_Get17),
5131 get_var(GEnv, sys_tree, Tree_Get18),
5132 f_cdr(Tree_Get18, Cdr_Ret),
5133 get_var(GEnv, rest, Rest_Get19),
5134 f_apply(f_sublis,
5135 [Alist_Get17, Cdr_Ret, Rest_Get19],
5136 D_Init),
5137 LEnv=[bv(sys_a, A_Init), bv(sys_d, D_Init)|GEnv],
5138 get_var(LEnv, sys_a, A_Get),
5139 get_var(LEnv, sys_tree, Tree_Get26),
5140 f_car(Tree_Get26, PredArg2Result),
5141 ( is_eq(A_Get, PredArg2Result)
5142 -> get_var(LEnv, sys_d, D_Get),
5143 get_var(LEnv, sys_tree, Tree_Get31),
5144 f_cdr(Tree_Get31, Cdr_Ret59),
5145 f_eq(D_Get, Cdr_Ret59, TrueResult),
5146 IFTEST22=TrueResult
5147 ; IFTEST22=[]
5148 ),
5149 ( IFTEST22\==[]
5150 -> get_var(LEnv, sys_tree, Tree_Get33),
5151 LetResult=Tree_Get33
5152 ; get_var(LEnv, sys_a, A_Get34),
5153 get_var(LEnv, sys_d, D_Get35),
5154 ElseResult=[A_Get34|D_Get35],
5155 LetResult=ElseResult
5156 ),
5157 _8398=LetResult
5158 ; get_var(GEnv, sys_alist, Alist_Get42),
5159 ( get_var(GEnv, rest, Rest_Get43),
5160 get_var(GEnv, sys_tree, Tree_Get41)
5161 ),
5162 f_apply(f_assoc,
5163 [Tree_Get41, Alist_Get42, Rest_Get43],
5164 A_Init44),
5165 LEnv40=[bv(sys_a, A_Init44)|GEnv],
5166 get_var(LEnv40, sys_a, IFTEST45),
5167 ( IFTEST45\==[]
5168 -> get_var(LEnv40, sys_a, A_Get48),
5169 f_cdr(A_Get48, TrueResult50),
5170 LetResult39=TrueResult50
5171 ; get_var(LEnv40, sys_tree, Tree_Get49),
5172 LetResult39=Tree_Get49
5173 ),
5174 _8398=LetResult39
5175 )
5176 ),
5177 _8398=FnResult
5178 ),
5179 block_exit(sublis, FnResult),
5180 true).
5181:- set_opv(sublis, symbol_function, f_sublis),
5182 DefunResult=sublis. 5183/*
5184:- side_effect(assert_lsp(sublis,
5185 lambda_def(defun,
5186 sublis,
5187 f_sublis,
5188 [sys_alist, sys_tree, c38_rest, rest],
5189
5190 [
5191 [ if,
5192 [consp, sys_tree],
5193
5194 [ let,
5195
5196 [
5197 [ sys_a,
5198
5199 [ apply,
5200 function(sublis),
5201 sys_alist,
5202 [car, sys_tree],
5203 rest
5204 ]
5205 ],
5206
5207 [ sys_d,
5208
5209 [ apply,
5210 function(sublis),
5211 sys_alist,
5212 [cdr, sys_tree],
5213 rest
5214 ]
5215 ]
5216 ],
5217
5218 [ if,
5219
5220 [ and,
5221 [eq, sys_a, [car, sys_tree]],
5222 [eq, sys_d, [cdr, sys_tree]]
5223 ],
5224 sys_tree,
5225 [cons, sys_a, sys_d]
5226 ]
5227 ],
5228
5229 [ let,
5230
5231 [
5232 [ sys_a,
5233
5234 [ apply,
5235 function(assoc),
5236 sys_tree,
5237 sys_alist,
5238 rest
5239 ]
5240 ]
5241 ],
5242 [if, sys_a, [cdr, sys_a], sys_tree]
5243 ]
5244 ]
5245 ]))).
5246*/
5247/*
5248:- side_effect(assert_lsp(sublis,
5249 arglist_info(sublis,
5250 f_sublis,
5251 [sys_alist, sys_tree, c38_rest, rest],
5252 arginfo{ all:[sys_alist, sys_tree],
5253 allow_other_keys:0,
5254 aux:0,
5255 body:0,
5256 complex:[rest],
5257 env:0,
5258 key:0,
5259 names:
5260 [ sys_alist,
5261 sys_tree,
5262 rest
5263 ],
5264 opt:0,
5265 req:[sys_alist, sys_tree],
5266 rest:[rest],
5267 sublists:0,
5268 whole:0
5269 }))).
5270*/
5271/*
5272:- side_effect(assert_lsp(sublis, init_args(2, f_sublis))).
5273*/
5274/*
5275#+(or WAM-CL LISP500)
5276(defun nsublis (alist tree &rest rest)
5277 (if (consp tree)
5278 (progn
5279 (setf (car tree) (apply #'nsublis alist (car tree) rest))
5280 (setf (cdr tree) (apply #'nsublis alist (cdr tree) rest))
5281 tree)
5282 (let ((a (apply #'assoc tree alist rest)))
5283 (if a (cdr a) tree))))
5284
5285*/
5286
5287/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:13630 **********************/
5288:-lisp_compile_to_prolog(pkg_sys,[defun,nsublis,[alist,tree,'&rest',rest],[if,[consp,tree],[progn,[setf,[car,tree],[apply,function(nsublis),alist,[car,tree],rest]],[setf,[cdr,tree],[apply,function(nsublis),alist,[cdr,tree],rest]],tree],[let,[[a,[apply,function(assoc),tree,alist,rest]]],[if,a,[cdr,a],tree]]]])
5289/*
5290:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _9398, [], [], true), append([sys_tree], [CAR12, CAR], [sys_tree, CAR12, CAR]), setf_inverse_op(car, rplaca))).
5291*/
5292/*
5293:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _9294, [], [], true), append([sys_tree], [CAR12, CAR], [sys_tree, CAR12, CAR]), setf_inverse_op(car, rplaca))).
5294*/
5295/*
5296:-side_effect((compile_each([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_9294,[],[],true),append([sys_tree],[_62832,_62660],[sys_tree,_62832,_62660]),setf_inverse_op(cdr,rplacd))).
5297*/
5298/*
5299:-side_effect((compile_each([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_9294,[],[],true),append([sys_tree],[_38438,_38266],[sys_tree,_38438,_38266]),setf_inverse_op(cdr,rplacd))).
5300*/
5301wl:lambda_def(defun, nsublis, f_nsublis, [sys_alist, sys_tree, c38_rest, rest], [[if, [consp, sys_tree], [progn, [setf, [car, sys_tree], [apply, function(nsublis), sys_alist, [car, sys_tree], rest]], [setf, [cdr, sys_tree], [apply, function(nsublis), sys_alist, [cdr, sys_tree], rest]], sys_tree], [let, [[sys_a, [apply, function(assoc), sys_tree, sys_alist, rest]]], [if, sys_a, [cdr, sys_a], sys_tree]]]]).
5302wl:arglist_info(nsublis, f_nsublis, [sys_alist, sys_tree, c38_rest, rest], arginfo{all:[sys_alist, sys_tree], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_alist, sys_tree, rest], opt:0, req:[sys_alist, sys_tree], rest:[rest], sublists:0, whole:0}).
5303wl: init_args(2, f_nsublis).
5304
5309f_nsublis(Alist_In, Tree_In, RestNKeys, FnResult) :-
5310 GEnv=[bv(sys_alist, Alist_In), bv(sys_tree, Tree_In), bv(rest, RestNKeys)],
5311 catch(( ( get_var(GEnv, sys_tree, Tree_Get),
5312 ( c0nz:is_consp(Tree_Get)
5313 -> get_var(GEnv, sys_alist, Alist_Get),
5314 get_var(GEnv, sys_tree, Tree_Get13),
5315 f_car(Tree_Get13, Car_Ret),
5316 get_var(GEnv, rest, Rest_Get),
5317 f_apply(f_nsublis,
5318 [Alist_Get, Car_Ret, Rest_Get],
5319 Apply_Ret),
5320 f_rplaca(Tree_Get13, Apply_Ret, Rplaca_Ret),
5321 get_var(GEnv, sys_alist, Alist_Get20),
5322 get_var(GEnv, sys_tree, Tree_Get19),
5323 f_cdr(Tree_Get19, Cdr_Ret),
5324 get_var(GEnv, rest, Rest_Get22),
5325 f_apply(f_nsublis,
5326 [Alist_Get20, Cdr_Ret, Rest_Get22],
5327 Apply_Ret47),
5328 f_rplacd(Tree_Get19, Apply_Ret47, Rplacd_Ret),
5329 get_var(GEnv, sys_tree, Tree_Get23),
5330 _8028=Tree_Get23
5331 ; get_var(GEnv, sys_alist, Alist_Get28),
5332 ( get_var(GEnv, rest, Rest_Get29),
5333 get_var(GEnv, sys_tree, Tree_Get27)
5334 ),
5335 f_apply(f_assoc,
5336 [Tree_Get27, Alist_Get28, Rest_Get29],
5337 A_Init),
5338 LEnv=[bv(sys_a, A_Init)|GEnv],
5339 get_var(LEnv, sys_a, IFTEST31),
5340 ( IFTEST31\==[]
5341 -> get_var(LEnv, sys_a, A_Get34),
5342 f_cdr(A_Get34, TrueResult),
5343 LetResult=TrueResult
5344 ; get_var(LEnv, sys_tree, Tree_Get35),
5345 LetResult=Tree_Get35
5346 ),
5347 _8028=LetResult
5348 )
5349 ),
5350 _8028=FnResult
5351 ),
5352 block_exit(nsublis, FnResult),
5353 true).
5354:- set_opv(nsublis, symbol_function, f_nsublis),
5355 DefunResult=nsublis. 5356/*
5357:- side_effect(assert_lsp(nsublis,
5358 lambda_def(defun,
5359 nsublis,
5360 f_nsublis,
5361 [sys_alist, sys_tree, c38_rest, rest],
5362
5363 [
5364 [ if,
5365 [consp, sys_tree],
5366
5367 [ progn,
5368
5369 [ setf,
5370 [car, sys_tree],
5371
5372 [ apply,
5373 function(nsublis),
5374 sys_alist,
5375 [car, sys_tree],
5376 rest
5377 ]
5378 ],
5379
5380 [ setf,
5381 [cdr, sys_tree],
5382
5383 [ apply,
5384 function(nsublis),
5385 sys_alist,
5386 [cdr, sys_tree],
5387 rest
5388 ]
5389 ],
5390 sys_tree
5391 ],
5392
5393 [ let,
5394
5395 [
5396 [ sys_a,
5397
5398 [ apply,
5399 function(assoc),
5400 sys_tree,
5401 sys_alist,
5402 rest
5403 ]
5404 ]
5405 ],
5406 [if, sys_a, [cdr, sys_a], sys_tree]
5407 ]
5408 ]
5409 ]))).
5410*/
5411/*
5412:- side_effect(assert_lsp(nsublis,
5413 arglist_info(nsublis,
5414 f_nsublis,
5415 [sys_alist, sys_tree, c38_rest, rest],
5416 arginfo{ all:[sys_alist, sys_tree],
5417 allow_other_keys:0,
5418 aux:0,
5419 body:0,
5420 complex:[rest],
5421 env:0,
5422 key:0,
5423 names:
5424 [ sys_alist,
5425 sys_tree,
5426 rest
5427 ],
5428 opt:0,
5429 req:[sys_alist, sys_tree],
5430 rest:[rest],
5431 sublists:0,
5432 whole:0
5433 }))).
5434*/
5435/*
5436:- side_effect(assert_lsp(nsublis, init_args(2, f_nsublis))).
5437*/
5438/*
5439#+(or WAM-CL LISP500)
5440(defun copy-list (list)
5441 (if (consp list) (cons (car list) (copy-list (cdr list))) list))
5442
5443*/
5444
5445/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:13933 **********************/
5446:-lisp_compile_to_prolog(pkg_sys,[defun,'copy-list',[list],[if,[consp,list],[cons,[car,list],['copy-list',[cdr,list]]],list]])
5447wl:lambda_def(defun, copy_list, f_copy_list, [list], [[if, [consp, list], [cons, [car, list], [copy_list, [cdr, list]]], list]]).
5448wl:arglist_info(copy_list, f_copy_list, [list], arginfo{all:[list], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[list], opt:0, req:[list], rest:0, sublists:0, whole:0}).
5449wl: init_args(x, f_copy_list).
5450
5455f_copy_list(List_In, FnResult) :-
5456 GEnv=[bv(list, List_In)],
5457 catch(( ( get_var(GEnv, list, List_Get),
5458 ( c0nz:is_consp(List_Get)
5459 -> get_var(GEnv, list, List_Get9),
5460 f_car(List_Get9, Car_Ret),
5461 get_var(GEnv, list, List_Get10),
5462 f_cdr(List_Get10, Copy_list_Param),
5463 f_copy_list(Copy_list_Param, Copy_list_Ret),
5464 TrueResult=[Car_Ret|Copy_list_Ret],
5465 _6956=TrueResult
5466 ; get_var(GEnv, list, List_Get11),
5467 _6956=List_Get11
5468 )
5469 ),
5470 _6956=FnResult
5471 ),
5472 block_exit(copy_list, FnResult),
5473 true).
5474:- set_opv(copy_list, symbol_function, f_copy_list),
5475 DefunResult=copy_list. 5476/*
5477:- side_effect(assert_lsp(copy_list,
5478 lambda_def(defun,
5479 copy_list,
5480 f_copy_list,
5481 [list],
5482
5483 [
5484 [ if,
5485 [consp, list],
5486
5487 [ cons,
5488 [car, list],
5489 [copy_list, [cdr, list]]
5490 ],
5491 list
5492 ]
5493 ]))).
5494*/
5495/*
5496:- side_effect(assert_lsp(copy_list,
5497 arglist_info(copy_list,
5498 f_copy_list,
5499 [list],
5500 arginfo{ all:[list],
5501 allow_other_keys:0,
5502 aux:0,
5503 body:0,
5504 complex:0,
5505 env:0,
5506 key:0,
5507 names:[list],
5508 opt:0,
5509 req:[list],
5510 rest:0,
5511 sublists:0,
5512 whole:0
5513 }))).
5514*/
5515/*
5516:- side_effect(assert_lsp(copy_list, init_args(x, f_copy_list))).
5517*/
5518/*
5519#+(or WAM-CL LISP500)
5520(defun make-list (size &key initial-element)
5521 (if (= size 0) nil
5522 (cons initial-element
5523 (make-list (- size 1) :initial-element initial-element))))
5524
5525*/
5526
5527/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:14052 **********************/
5528:-lisp_compile_to_prolog(pkg_sys,[defun,'make-list',[size,'&key','initial-element'],[if,[=,size,0],[],[cons,'initial-element',['make-list',[-,size,1],':initial-element','initial-element']]]])
5529wl:lambda_def(defun, make_list, f_make_list, [sys_size, c38_key, sys_initial_element], [[if, [=, sys_size, 0], [], [cons, sys_initial_element, [make_list, [-, sys_size, 1], kw_initial_element, sys_initial_element]]]]).
5530wl:arglist_info(make_list, f_make_list, [sys_size, c38_key, sys_initial_element], arginfo{all:[sys_size], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_initial_element], names:[sys_size, sys_initial_element], opt:0, req:[sys_size], rest:0, sublists:0, whole:0}).
5531wl: init_args(1, f_make_list).
5532
5537f_make_list(Size_In, RestNKeys, FnResult) :-
5538 GEnv=[bv(sys_size, Size_In), bv(sys_initial_element, Initial_element_In)],
5539 get_kw(Env,
5540 RestNKeys,
5541 sys_initial_element,
5542 sys_initial_element,
5543 Initial_element_In,
5544 []=Initial_element_In,
5545 Initial_element_P),
5546 catch(( ( get_var(GEnv, sys_size, Size_Get),
5547 ( Size_Get=:=0
5548 -> _7096=[]
5549 ; get_var(GEnv, sys_initial_element, Initial_element_Get),
5550 get_var(GEnv, sys_size, Size_Get12),
5551 'f_-'(Size_Get12, 1, Make_list_Param),
5552 get_var(GEnv, sys_initial_element, Initial_element_Get13),
5553 f_make_list(Make_list_Param,
5554 [kw_initial_element, Initial_element_Get13],
5555 Make_list_Ret),
5556 ElseResult=[Initial_element_Get|Make_list_Ret],
5557 _7096=ElseResult
5558 )
5559 ),
5560 _7096=FnResult
5561 ),
5562 block_exit(make_list, FnResult),
5563 true).
5564:- set_opv(make_list, symbol_function, f_make_list),
5565 DefunResult=make_list. 5566/*
5567:- side_effect(assert_lsp(make_list,
5568 lambda_def(defun,
5569 make_list,
5570 f_make_list,
5571 [sys_size, c38_key, sys_initial_element],
5572
5573 [
5574 [ if,
5575 [=, sys_size, 0],
5576 [],
5577
5578 [ cons,
5579 sys_initial_element,
5580
5581 [ make_list,
5582 [-, sys_size, 1],
5583 kw_initial_element,
5584 sys_initial_element
5585 ]
5586 ]
5587 ]
5588 ]))).
5589*/
5590/*
5591:- side_effect(assert_lsp(make_list,
5592 arglist_info(make_list,
5593 f_make_list,
5594 [sys_size, c38_key, sys_initial_element],
5595 arginfo{ all:[sys_size],
5596 allow_other_keys:0,
5597 aux:0,
5598 body:0,
5599 complex:0,
5600 env:0,
5601 key:[sys_initial_element],
5602 names:
5603 [ sys_size,
5604 sys_initial_element
5605 ],
5606 opt:0,
5607 req:[sys_size],
5608 rest:0,
5609 sublists:0,
5610 whole:0
5611 }))).
5612*/
5613/*
5614:- side_effect(assert_lsp(make_list, init_args(1, f_make_list))).
5615*/
5616/*
5617#+(or WAM-CL LISP500)
5618(defun list* (&rest objects)
5619 (if (cdr objects)
5620 (cons (car objects) (apply #'list* (cdr objects)))
5621 (car objects)))
5622
5623*/
5624
5625/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:14240 **********************/
5626:-lisp_compile_to_prolog(pkg_sys,[defun,'list*',['&rest',objects],[if,[cdr,objects],[cons,[car,objects],[apply,function('list*'),[cdr,objects]]],[car,objects]]])
5627wl:lambda_def(defun, list_xx, f_list_xx, [c38_rest, sys_objects], [[if, [cdr, sys_objects], [cons, [car, sys_objects], [apply, function(list_xx), [cdr, sys_objects]]], [car, sys_objects]]]).
5628wl:arglist_info(list_xx, f_list_xx, [c38_rest, sys_objects], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_objects], opt:0, req:0, rest:[sys_objects], sublists:0, whole:0}).
5629wl: init_args(1, f_list_xx).
5630
5635f_list_xx(RestNKeys, FnResult) :-
5636 GEnv=[bv(sys_objects, RestNKeys)],
5637 catch(( ( get_var(GEnv, sys_objects, Objects_Get),
5638 f_cdr(Objects_Get, IFTEST),
5639 ( IFTEST\==[]
5640 -> get_var(GEnv, sys_objects, Objects_Get8),
5641 f_car(Objects_Get8, Car_Ret),
5642 get_var(GEnv, sys_objects, Objects_Get9),
5643 f_cdr(Objects_Get9, [List_xx_Param|KeysNRest]),
5644 f_list_xx(List_xx_Param, KeysNRest, List_xx_Ret),
5645 TrueResult=[Car_Ret|List_xx_Ret],
5646 _7088=TrueResult
5647 ; get_var(GEnv, sys_objects, Objects_Get10),
5648 f_car(Objects_Get10, ElseResult),
5649 _7088=ElseResult
5650 )
5651 ),
5652 _7088=FnResult
5653 ),
5654 block_exit(list_xx, FnResult),
5655 true).
5656:- set_opv(list_xx, symbol_function, f_list_xx),
5657 DefunResult=list_xx. 5658/*
5659:- side_effect(assert_lsp(list_xx,
5660 lambda_def(defun,
5661 list_xx,
5662 f_list_xx,
5663 [c38_rest, sys_objects],
5664
5665 [
5666 [ if,
5667 [cdr, sys_objects],
5668
5669 [ cons,
5670 [car, sys_objects],
5671
5672 [ apply,
5673 function(list_xx),
5674 [cdr, sys_objects]
5675 ]
5676 ],
5677 [car, sys_objects]
5678 ]
5679 ]))).
5680*/
5681/*
5682:- side_effect(assert_lsp(list_xx,
5683 arglist_info(list_xx,
5684 f_list_xx,
5685 [c38_rest, sys_objects],
5686 arginfo{ all:0,
5687 allow_other_keys:0,
5688 aux:0,
5689 body:0,
5690 complex:[rest],
5691 env:0,
5692 key:0,
5693 names:[sys_objects],
5694 opt:0,
5695 req:0,
5696 rest:[sys_objects],
5697 sublists:0,
5698 whole:0
5699 }))).
5700*/
5701/*
5702:- side_effect(assert_lsp(list_xx, init_args(1, f_list_xx))).
5703*/
5704/*
5705#+(or WAM-CL LISP500)
5706(defun list-length (list)
5707 (let ((slow list)
5708 (fast list)
5709 (odd nil)
5710 (len 0))
5711 (tagbody
5712 start
5713 (when (atom fast) (return-from list-length len))
5714 (setf fast (cdr fast))
5715 (setf len (+ 1 len))
5716 (when odd (setf slow (cdr slow)))
5717 (setf odd (not odd))
5718 (unless (eq slow fast) (go start)))))
5719
5720*/
5721
5722/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:14398 **********************/
5723:-lisp_compile_to_prolog(pkg_sys,[defun,'list-length',[list],[let,[[slow,list],[fast,list],[odd,[]],[len,0]],[tagbody,start,[when,[atom,fast],['return-from','list-length',len]],[setf,fast,[cdr,fast]],[setf,len,[+,1,len]],[when,odd,[setf,slow,[cdr,slow]]],[setf,odd,[not,odd]],[unless,[eq,slow,fast],[go,start]]]]])
5724wl:lambda_def(defun, list_length, f_list_length, [list], [[let, [[sys_slow, list], [sys_fast, list], [sys_odd, []], [sys_len, 0]], [tagbody, sys_start, [when, [atom, sys_fast], [return_from, list_length, sys_len]], [setf, sys_fast, [cdr, sys_fast]], [setf, sys_len, [+, 1, sys_len]], [when, sys_odd, [setf, sys_slow, [cdr, sys_slow]]], [setf, sys_odd, [not, sys_odd]], [unless, [eq, sys_slow, sys_fast], [go, sys_start]]]]]).
5725wl:arglist_info(list_length, f_list_length, [list], arginfo{all:[list], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[list], opt:0, req:[list], rest:0, sublists:0, whole:0}).
5726wl: init_args(x, f_list_length).
5727
5732f_list_length(List_In, FnResult) :-
5733 GEnv=[bv(list, List_In)],
5734 catch(( ( get_var(GEnv, list, List_Get9),
5735 BlockExitEnv=[bv(sys_slow, List_Get9), bv(sys_fast, List_Get9), bv(sys_odd, []), bv(sys_len, 0)|GEnv],
5736 call_addr_block(BlockExitEnv,
5737 (push_label(sys_start), get_var(BlockExitEnv, sys_fast, Fast_Get41), (Fast_Get41\=[CAR|CDR]->get_var(BlockExitEnv, sys_len, RetResult44), throw(block_exit(list_length, RetResult44)), _8872=ThrowResult45;_8872=[]), get_var(BlockExitEnv, sys_fast, Fast_Get49), f_cdr(Fast_Get49, Fast), set_var(BlockExitEnv, sys_fast, Fast), get_var(BlockExitEnv, sys_len, Len_Get50), 'f_+'(1, Len_Get50, Len), set_var(BlockExitEnv, sys_len, Len), get_var(BlockExitEnv, sys_odd, IFTEST51), (IFTEST51\==[]->get_var(BlockExitEnv, sys_slow, Slow_Get54), f_cdr(Slow_Get54, TrueResult55), set_var(BlockExitEnv, sys_slow, TrueResult55), _9148=TrueResult55;_9148=[]), get_var(BlockExitEnv, sys_odd, Odd_Get56), f_not(Odd_Get56, Odd), set_var(BlockExitEnv, sys_odd, Odd), get_var(BlockExitEnv, sys_fast, Fast_Get59), get_var(BlockExitEnv, sys_slow, Slow_Get58), (is_eq(Slow_Get58, Fast_Get59)->_TBResult=[];goto(sys_start, BlockExitEnv), _TBResult=_GORES63)),
5738
5739 [ addr(addr_tagbody_38_sys_start,
5740 sys_start,
5741 '$unused',
5742 BlockExitEnv,
5743 (get_var(BlockExitEnv, sys_fast, Fast_Get), (Fast_Get\=[CAR75|CDR76]->get_var(BlockExitEnv, sys_len, Get_var_Ret), throw(block_exit(list_length, Get_var_Ret)), _9524=ThrowResult;_9524=[]), get_var(BlockExitEnv, sys_fast, Fast_Get22), f_cdr(Fast_Get22, Cdr_Ret), set_var(BlockExitEnv, sys_fast, Cdr_Ret), get_var(BlockExitEnv, sys_len, Len_Get23), 'f_+'(1, Len_Get23, Set_var_Ret), set_var(BlockExitEnv, sys_len, Set_var_Ret), get_var(BlockExitEnv, sys_odd, IFTEST24), (IFTEST24\==[]->get_var(BlockExitEnv, sys_slow, Cdr_Param), f_cdr(Cdr_Param, TrueResult28), set_var(BlockExitEnv, sys_slow, TrueResult28), _9602=TrueResult28;_9602=[]), get_var(BlockExitEnv, sys_odd, Odd_Get29), f_not(Odd_Get29, Not_Ret), set_var(BlockExitEnv, sys_odd, Not_Ret), get_var(BlockExitEnv, sys_fast, Fast_Get32), get_var(BlockExitEnv, sys_slow, Slow_Get31), (is_eq(Slow_Get31, Fast_Get32)->_9648=[];goto(sys_start, BlockExitEnv), _9648=_GORES)))
5744 ])
5745 ),
5746 []=FnResult
5747 ),
5748 block_exit(list_length, FnResult),
5749 true).
5750:- set_opv(list_length, symbol_function, f_list_length),
5751 DefunResult=list_length. 5752/*
5753:- side_effect(assert_lsp(list_length,
5754 lambda_def(defun,
5755 list_length,
5756 f_list_length,
5757 [list],
5758
5759 [
5760 [ let,
5761
5762 [ [sys_slow, list],
5763 [sys_fast, list],
5764 [sys_odd, []],
5765 [sys_len, 0]
5766 ],
5767
5768 [ tagbody,
5769 sys_start,
5770
5771 [ when,
5772 [atom, sys_fast],
5773 [return_from, list_length, sys_len]
5774 ],
5775 [setf, sys_fast, [cdr, sys_fast]],
5776 [setf, sys_len, [+, 1, sys_len]],
5777
5778 [ when,
5779 sys_odd,
5780 [setf, sys_slow, [cdr, sys_slow]]
5781 ],
5782 [setf, sys_odd, [not, sys_odd]],
5783
5784 [ unless,
5785 [eq, sys_slow, sys_fast],
5786 [go, sys_start]
5787 ]
5788 ]
5789 ]
5790 ]))).
5791*/
5792/*
5793:- side_effect(assert_lsp(list_length,
5794 arglist_info(list_length,
5795 f_list_length,
5796 [list],
5797 arginfo{ all:[list],
5798 allow_other_keys:0,
5799 aux:0,
5800 body:0,
5801 complex:0,
5802 env:0,
5803 key:0,
5804 names:[list],
5805 opt:0,
5806 req:[list],
5807 rest:0,
5808 sublists:0,
5809 whole:0
5810 }))).
5811*/
5812/*
5813:- side_effect(assert_lsp(list_length, init_args(x, f_list_length))).
5814*/
5815/*
5816#+(or WAM-CL LISP500)
5817(defun listp (object) (or (consp object) (eq object nil)))
5818
5819
5820
5821*/
5822
5823/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:14769 **********************/
5824:-lisp_compile_to_prolog(pkg_sys,[defun,listp,[object],[or,[consp,object],[eq,object,[]]]])
5825wl:lambda_def(defun, listp, f_listp, [sys_object], [[or, [consp, sys_object], [eq, sys_object, []]]]).
5826wl:arglist_info(listp, f_listp, [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}).
5827wl: init_args(x, f_listp).
5828
5833f_listp(Object_In, FnResult) :-
5834 GEnv=[bv(sys_object, Object_In)],
5835 catch(( ( get_var(GEnv, sys_object, Object_Get),
5836 f_consp(Object_Get, FORM1_Res),
5837 FORM1_Res\==[],
5838 _6784=FORM1_Res
5839 -> true
5840 ; get_var(GEnv, sys_object, Object_Get6),
5841 f_eq(Object_Get6, [], Eq_Ret),
5842 _6784=Eq_Ret
5843 ),
5844 _6784=FnResult
5845 ),
5846 block_exit(listp, FnResult),
5847 true).
5848:- set_opv(listp, symbol_function, f_listp),
5849 DefunResult=listp. 5850/*
5851:- side_effect(assert_lsp(listp,
5852 lambda_def(defun,
5853 listp,
5854 f_listp,
5855 [sys_object],
5856
5857 [
5858 [ or,
5859 [consp, sys_object],
5860 [eq, sys_object, []]
5861 ]
5862 ]))).
5863*/
5864/*
5865:- side_effect(assert_lsp(listp,
5866 arglist_info(listp,
5867 f_listp,
5868 [sys_object],
5869 arginfo{ all:[sys_object],
5870 allow_other_keys:0,
5871 aux:0,
5872 body:0,
5873 complex:0,
5874 env:0,
5875 key:0,
5876 names:[sys_object],
5877 opt:0,
5878 req:[sys_object],
5879 rest:0,
5880 sublists:0,
5881 whole:0
5882 }))).
5883*/
5884/*
5885:- side_effect(assert_lsp(listp, init_args(x, f_listp))).
5886*/
5887/*
5888#+(or WAM-CL LISP500)
5889(defun nth (n list) (if (< n 1) (car list) (nth (- n 1) (cdr list))))
5890*/
5891
5892/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:14859 **********************/
5893:-lisp_compile_to_prolog(pkg_sys,[defun,nth,[n,list],[if,[<,n,1],[car,list],[nth,[-,n,1],[cdr,list]]]])
5894wl:lambda_def(defun, nth, f_nth, [sys_n, list], [[if, [<, sys_n, 1], [car, list], [nth, [-, sys_n, 1], [cdr, list]]]]).
5895wl:arglist_info(nth, f_nth, [sys_n, list], arginfo{all:[sys_n, list], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_n, list], opt:0, req:[sys_n, list], rest:0, sublists:0, whole:0}).
5896wl: init_args(x, f_nth).
5897
5902f_nth(N_In, List_In, FnResult) :-
5903 GEnv=[bv(sys_n, N_In), bv(list, List_In)],
5904 catch(( ( get_var(GEnv, sys_n, N_Get),
5905 ( N_Get<1
5906 -> get_var(GEnv, list, List_Get),
5907 f_car(List_Get, TrueResult),
5908 _7036=TrueResult
5909 ; get_var(GEnv, sys_n, N_Get11),
5910 'f_-'(N_Get11, 1, Nth_Param),
5911 get_var(GEnv, list, List_Get12),
5912 f_cdr(List_Get12, Cdr_Ret),
5913 f_nth(Nth_Param, Cdr_Ret, ElseResult),
5914 _7036=ElseResult
5915 )
5916 ),
5917 _7036=FnResult
5918 ),
5919 block_exit(nth, FnResult),
5920 true).
5921:- set_opv(nth, symbol_function, f_nth),
5922 DefunResult=nth. 5923/*
5924:- side_effect(assert_lsp(nth,
5925 lambda_def(defun,
5926 nth,
5927 f_nth,
5928 [sys_n, list],
5929
5930 [
5931 [ if,
5932 [<, sys_n, 1],
5933 [car, list],
5934 [nth, [-, sys_n, 1], [cdr, list]]
5935 ]
5936 ]))).
5937*/
5938/*
5939:- side_effect(assert_lsp(nth,
5940 arglist_info(nth,
5941 f_nth,
5942 [sys_n, list],
5943 arginfo{ all:[sys_n, list],
5944 allow_other_keys:0,
5945 aux:0,
5946 body:0,
5947 complex:0,
5948 env:0,
5949 key:0,
5950 names:[sys_n, list],
5951 opt:0,
5952 req:[sys_n, list],
5953 rest:0,
5954 sublists:0,
5955 whole:0
5956 }))).
5957*/
5958/*
5959:- side_effect(assert_lsp(nth, init_args(x, f_nth))).
5960*/
5961/*
5962'(defun (setf nth) (new-object n list)
5963 (if (< n 1)
5964 (setf (car list) new-object)
5965 (setf (nth (- n 1) (cdr list)) new-object)))
5966
5967
5968*/
5969
5970/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:14954 **********************/
5971:-lisp_compile_to_prolog(pkg_sys,[quote,[defun,[setf,nth],['new-object',n,list],[if,[<,n,1],[setf,[car,list],'new-object'],[setf,[nth,[-,n,1],[cdr,list]],'new-object']]]])
5972/*
5973#+(or WAM-CL LISP500)
5974(defun endp (list) (not list))
5975
5976*/
5977
5978/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:15101 **********************/
5979:-lisp_compile_to_prolog(pkg_sys,[defun,endp,[list],[not,list]])
5980wl:lambda_def(defun, endp, f_endp, [list], [[not, list]]).
5981wl:arglist_info(endp, f_endp, [list], arginfo{all:[list], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[list], opt:0, req:[list], rest:0, sublists:0, whole:0}).
5982wl: init_args(x, f_endp).
5983
5988f_endp(List_In, FnResult) :-
5989 GEnv=[bv(list, List_In)],
5990 catch(( ( get_var(GEnv, list, List_Get),
5991 f_not(List_Get, Not_Ret)
5992 ),
5993 Not_Ret=FnResult
5994 ),
5995 block_exit(endp, FnResult),
5996 true).
5997:- set_opv(endp, symbol_function, f_endp),
5998 DefunResult=endp. 5999/*
6000:- side_effect(assert_lsp(endp,
6001 lambda_def(defun, endp, f_endp, [list], [[not, list]]))).
6002*/
6003/*
6004:- side_effect(assert_lsp(endp,
6005 arglist_info(endp,
6006 f_endp,
6007 [list],
6008 arginfo{ all:[list],
6009 allow_other_keys:0,
6010 aux:0,
6011 body:0,
6012 complex:0,
6013 env:0,
6014 key:0,
6015 names:[list],
6016 opt:0,
6017 req:[list],
6018 rest:0,
6019 sublists:0,
6020 whole:0
6021 }))).
6022*/
6023/*
6024:- side_effect(assert_lsp(endp, init_args(x, f_endp))).
6025*/
6026/*
6027#+(or WAM-CL LISP500)
6028(defun nconc (&rest lists)
6029 (if (cdr lists)
6030 (if (car lists)
6031 (progn (setf (cdr (last (car lists))) (apply #'nconc (cdr lists)))
6032 (car lists))
6033 (apply #'nconc (cdr lists)))
6034 (car lists)))
6035
6036*/
6037
6038/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:15159 **********************/
6039:-lisp_compile_to_prolog(pkg_sys,[defun,nconc,['&rest',lists],[if,[cdr,lists],[if,[car,lists],[progn,[setf,[cdr,[last,[car,lists]]],[apply,function(nconc),[cdr,lists]]],[car,lists]],[apply,function(nconc),[cdr,lists]]],[car,lists]]])
6040/*
6041:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _8672, [], [], true), append([[last, [car, sys_lists]]], [CAR12, CAR], [[last, [car, sys_lists]], CAR12, CAR]), setf_inverse_op(cdr, rplacd))).
6042*/
6043/*
6044:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _8626, [], [], true), append([[last, [car, sys_lists]]], [CAR12, CAR], [[last, [car, sys_lists]], CAR12, CAR]), setf_inverse_op(cdr, rplacd))).
6045*/
6046wl:lambda_def(defun, nconc, f_nconc, [c38_rest, sys_lists], [[if, [cdr, sys_lists], [if, [car, sys_lists], [progn, [setf, [cdr, [last, [car, sys_lists]]], [apply, function(nconc), [cdr, sys_lists]]], [car, sys_lists]], [apply, function(nconc), [cdr, sys_lists]]], [car, sys_lists]]]).
6047wl:arglist_info(nconc, f_nconc, [c38_rest, sys_lists], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_lists], opt:0, req:0, rest:[sys_lists], sublists:0, whole:0}).
6048wl: init_args(0, f_nconc).
6049
6054f_nconc(RestNKeys, FnResult) :-
6055 GEnv=[bv(sys_lists, RestNKeys)],
6056 catch(( ( get_var(GEnv, sys_lists, Lists_Get),
6057 f_cdr(Lists_Get, IFTEST),
6058 ( IFTEST\==[]
6059 -> get_var(GEnv, sys_lists, Lists_Get10),
6060 f_car(Lists_Get10, IFTEST8),
6061 ( IFTEST8\==[]
6062 -> get_var(GEnv, sys_lists, Lists_Get13),
6063 f_car(Lists_Get13, Last_Param),
6064 f_last(Last_Param, [], Rplacd_Param),
6065 get_var(GEnv, sys_lists, Lists_Get14),
6066 f_cdr(Lists_Get14, Nconc_Param),
6067 f_nconc(Nconc_Param, Nconc_Ret),
6068 f_rplacd(Rplacd_Param, Nconc_Ret, Rplacd_Ret),
6069 get_var(GEnv, sys_lists, Lists_Get15),
6070 f_car(Lists_Get15, TrueResult),
6071 TrueResult20=TrueResult
6072 ; get_var(GEnv, sys_lists, Lists_Get16),
6073 f_cdr(Lists_Get16, Nconc_Param28),
6074 f_nconc(Nconc_Param28, ElseResult),
6075 TrueResult20=ElseResult
6076 ),
6077 _7604=TrueResult20
6078 ; get_var(GEnv, sys_lists, Lists_Get19),
6079 f_car(Lists_Get19, ElseResult21),
6080 _7604=ElseResult21
6081 )
6082 ),
6083 _7604=FnResult
6084 ),
6085 block_exit(nconc, FnResult),
6086 true).
6087:- set_opv(nconc, symbol_function, f_nconc),
6088 DefunResult=nconc. 6089/*
6090:- side_effect(assert_lsp(nconc,
6091 lambda_def(defun,
6092 nconc,
6093 f_nconc,
6094 [c38_rest, sys_lists],
6095
6096 [
6097 [ if,
6098 [cdr, sys_lists],
6099
6100 [ if,
6101 [car, sys_lists],
6102
6103 [ progn,
6104
6105 [ setf,
6106 [cdr, [last, [car, sys_lists]]],
6107
6108 [ apply,
6109 function(nconc),
6110 [cdr, sys_lists]
6111 ]
6112 ],
6113 [car, sys_lists]
6114 ],
6115
6116 [ apply,
6117 function(nconc),
6118 [cdr, sys_lists]
6119 ]
6120 ],
6121 [car, sys_lists]
6122 ]
6123 ]))).
6124*/
6125/*
6126:- side_effect(assert_lsp(nconc,
6127 arglist_info(nconc,
6128 f_nconc,
6129 [c38_rest, sys_lists],
6130 arginfo{ all:0,
6131 allow_other_keys:0,
6132 aux:0,
6133 body:0,
6134 complex:[rest],
6135 env:0,
6136 key:0,
6137 names:[sys_lists],
6138 opt:0,
6139 req:0,
6140 rest:[sys_lists],
6141 sublists:0,
6142 whole:0
6143 }))).
6144*/
6145/*
6146:- side_effect(assert_lsp(nconc, init_args(0, f_nconc))).
6147*/
6148/*
6149#+(or WAM-CL LISP500)
6150(defun revappend (list tail)
6151 (if list
6152 (revappend (cdr list) (cons (car list) tail))
6153 tail))
6154
6155*/
6156
6157/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:15397 **********************/
6158:-lisp_compile_to_prolog(pkg_sys,[defun,revappend,[list,tail],[if,list,[revappend,[cdr,list],[cons,[car,list],tail]],tail]])
6159wl:lambda_def(defun, revappend, f_revappend, [list, sys_tail], [[if, list, [revappend, [cdr, list], [cons, [car, list], sys_tail]], sys_tail]]).
6160wl:arglist_info(revappend, f_revappend, [list, sys_tail], arginfo{all:[list, sys_tail], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[list, sys_tail], opt:0, req:[list, sys_tail], rest:0, sublists:0, whole:0}).
6161wl: init_args(x, f_revappend).
6162
6167f_revappend(List_In, Tail_In, FnResult) :-
6168 GEnv=[bv(list, List_In), bv(sys_tail, Tail_In)],
6169 catch(( ( get_var(GEnv, list, IFTEST),
6170 ( IFTEST\==[]
6171 -> get_var(GEnv, list, List_Get9),
6172 f_cdr(List_Get9, Revappend_Param),
6173 get_var(GEnv, list, List_Get10),
6174 f_car(List_Get10, Car_Ret),
6175 get_var(GEnv, sys_tail, Tail_Get),
6176 _7062=[Car_Ret|Tail_Get],
6177 f_revappend(Revappend_Param, _7062, TrueResult),
6178 _6974=TrueResult
6179 ; get_var(GEnv, sys_tail, Tail_Get12),
6180 _6974=Tail_Get12
6181 )
6182 ),
6183 _6974=FnResult
6184 ),
6185 block_exit(revappend, FnResult),
6186 true).
6187:- set_opv(revappend, symbol_function, f_revappend),
6188 DefunResult=revappend. 6189/*
6190:- side_effect(assert_lsp(revappend,
6191 lambda_def(defun,
6192 revappend,
6193 f_revappend,
6194 [list, sys_tail],
6195
6196 [
6197 [ if,
6198 list,
6199
6200 [ revappend,
6201 [cdr, list],
6202 [cons, [car, list], sys_tail]
6203 ],
6204 sys_tail
6205 ]
6206 ]))).
6207*/
6208/*
6209:- side_effect(assert_lsp(revappend,
6210 arglist_info(revappend,
6211 f_revappend,
6212 [list, sys_tail],
6213 arginfo{ all:[list, sys_tail],
6214 allow_other_keys:0,
6215 aux:0,
6216 body:0,
6217 complex:0,
6218 env:0,
6219 key:0,
6220 names:[list, sys_tail],
6221 opt:0,
6222 req:[list, sys_tail],
6223 rest:0,
6224 sublists:0,
6225 whole:0
6226 }))).
6227*/
6228/*
6229:- side_effect(assert_lsp(revappend, init_args(x, f_revappend))).
6230*/
6231/*
6232#+(or WAM-CL LISP500)
6233(defun nreconc (list tail)
6234 (if list
6235 (let ((new-list (cdr list)))
6236 (setf (cdr list) tail)
6237 (nreconc new-list list))
6238 tail))
6239
6240*/
6241
6242/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:15532 **********************/
6243:-lisp_compile_to_prolog(pkg_sys,[defun,nreconc,[list,tail],[if,list,[let,[['new-list',[cdr,list]]],[setf,[cdr,list],tail],[nreconc,'new-list',list]],tail]])
6244/*
6245:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv, [], [], true), append([list], [CAR15, CAR], [list, CAR15, CAR]), setf_inverse_op(cdr, rplacd))).
6246*/
6247/*
6248:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv, [], [], true), append([list], [CAR15, CAR], [list, CAR15, CAR]), setf_inverse_op(cdr, rplacd))).
6249*/
6250wl:lambda_def(defun, nreconc, f_nreconc, [list, sys_tail], [[if, list, [let, [[sys_new_list, [cdr, list]]], [setf, [cdr, list], sys_tail], [nreconc, sys_new_list, list]], sys_tail]]).
6251wl:arglist_info(nreconc, f_nreconc, [list, sys_tail], arginfo{all:[list, sys_tail], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[list, sys_tail], opt:0, req:[list, sys_tail], rest:0, sublists:0, whole:0}).
6252wl: init_args(x, f_nreconc).
6253
6258f_nreconc(List_In, Tail_In, FnResult) :-
6259 GEnv=[bv(list, List_In), bv(sys_tail, Tail_In)],
6260 catch(( ( get_var(GEnv, list, IFTEST),
6261 ( IFTEST\==[]
6262 -> get_var(GEnv, list, List_Get12),
6263 f_cdr(List_Get12, New_list_Init),
6264 LEnv=[bv(sys_new_list, New_list_Init)|GEnv],
6265 get_var(LEnv, list, List_Get16),
6266 get_var(LEnv, sys_tail, Tail_Get),
6267 f_rplacd(List_Get16, Tail_Get, Rplacd_Ret),
6268 get_var(LEnv, list, List_Get19),
6269 get_var(LEnv, sys_new_list, New_list_Get),
6270 f_nreconc(New_list_Get, List_Get19, LetResult),
6271 _7152=LetResult
6272 ; get_var(GEnv, sys_tail, Tail_Get20),
6273 _7152=Tail_Get20
6274 )
6275 ),
6276 _7152=FnResult
6277 ),
6278 block_exit(nreconc, FnResult),
6279 true).
6280:- set_opv(nreconc, symbol_function, f_nreconc),
6281 DefunResult=nreconc. 6282/*
6283:- side_effect(assert_lsp(nreconc,
6284 lambda_def(defun,
6285 nreconc,
6286 f_nreconc,
6287 [list, sys_tail],
6288
6289 [
6290 [ if,
6291 list,
6292
6293 [ let,
6294 [[sys_new_list, [cdr, list]]],
6295 [setf, [cdr, list], sys_tail],
6296 [nreconc, sys_new_list, list]
6297 ],
6298 sys_tail
6299 ]
6300 ]))).
6301*/
6302/*
6303:- side_effect(assert_lsp(nreconc,
6304 arglist_info(nreconc,
6305 f_nreconc,
6306 [list, sys_tail],
6307 arginfo{ all:[list, sys_tail],
6308 allow_other_keys:0,
6309 aux:0,
6310 body:0,
6311 complex:0,
6312 env:0,
6313 key:0,
6314 names:[list, sys_tail],
6315 opt:0,
6316 req:[list, sys_tail],
6317 rest:0,
6318 sublists:0,
6319 whole:0
6320 }))).
6321*/
6322/*
6323:- side_effect(assert_lsp(nreconc, init_args(x, f_nreconc))).
6324*/
6325/*
6326#+(or WAM-CL LISP500)
6327(defun butlast (list &optional (n 1))
6328 (let* ((r (cons nil nil))
6329 (e list)
6330 (m 0))
6331 (tagbody
6332 start
6333 (when (consp e)
6334 (setf m (+ m 1))
6335 (setf e (cdr e))
6336 (go start)))
6337 (setf n (- m n))
6338 (setf e r)
6339 (tagbody
6340 start
6341 (unless (consp list) (return-from butlast nil))
6342 (unless (< n 1)
6343 (setf e (setf (cdr e) (cons (car list) nil)))
6344 (setf list (cdr list))
6345 (setf n (- n 1))
6346 (go start)))
6347 (cdr r)))
6348
6349*/
6350
6351/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:15700 **********************/
6352:-lisp_compile_to_prolog(pkg_sys,[defun,butlast,[list,'&optional',[n,1]],['let*',[[r,[cons,[],[]]],[e,list],[m,0]],[tagbody,start,[when,[consp,e],[setf,m,[+,m,1]],[setf,e,[cdr,e]],[go,start]]],[setf,n,[-,m,n]],[setf,e,r],[tagbody,start,[unless,[consp,list],['return-from',butlast,[]]],[unless,[<,n,1],[setf,e,[setf,[cdr,e],[cons,[car,list],[]]]],[setf,list,[cdr,list]],[setf,n,[-,n,1]],[go,start]]],[cdr,r]]])
6353/*
6354:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], BlockExitEnv, [], [], true), append([sys_e], [CAR56, CAR], [sys_e, CAR56, CAR]), setf_inverse_op(cdr, rplacd))).
6355*/
6356/*
6357:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], BlockExitEnv, [], [], true), append([sys_e], [CAR56, CAR], [sys_e, CAR56, CAR]), setf_inverse_op(cdr, rplacd))).
6358*/
6359/*
6360:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], GoEnv, [], [], true), append([sys_e], [CAR78, CAR77], [sys_e, CAR78, CAR77]), setf_inverse_op(cdr, rplacd))).
6361*/
6362/*
6363:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], GoEnv, [], [], true), append([sys_e], [CAR78, CAR77], [sys_e, CAR78, CAR77]), setf_inverse_op(cdr, rplacd))).
6364*/
6365wl:lambda_def(defun,butlast,f_butlast,[list,c38_optional,[sys_n,1]],[[let_xx,[[sys_r,[cons,[],[]]],[sys_e,list],[sys_m,0]],[tagbody,sys_start,[when,[consp,sys_e],[setf,sys_m,[+,sys_m,1]],[setf,sys_e,[cdr,sys_e]],[go,sys_start]]],[setf,sys_n,[-,sys_m,sys_n]],[setf,sys_e,sys_r],[tagbody,sys_start,[unless,[consp,list],[return_from,butlast,[]]],[unless,[<,sys_n,1],[setf,sys_e,[setf,[cdr,sys_e],[cons,[car,list],[]]]],[setf,list,[cdr,list]],[setf,sys_n,[-,sys_n,1]],[go,sys_start]]],[cdr,sys_r]]]).
6366wl:arglist_info(butlast,f_butlast,[list,c38_optional,[sys_n,1]],arginfo{all:[list,sys_n],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[list,sys_n],opt:[sys_n],req:[list],rest:0,sublists:0,whole:0}).
6367wl:init_args(1,f_butlast).
6368
6373f_butlast(_9170,_9188,_11212):-_9130=[bv(list,_9170),bv(sys_n,_9172)],opt_var(_9122,sys_n,_9172,true,1,1,_9188),catch(((_9266=[[]],_9228=[bv(sys_r,_9266)|_9130],get_var(_9228,list,_9398),_9356=[bv(sys_e,_9398)|_9228],_9482=[bv(sys_m,0)|_9356],call_addr_block(_9482,(push_label(sys_start),get_var(_9482,sys_e,_9752),(c0nz:is_consp(_9752)->get_var(_9482,sys_m,_9810),'f_+'(_9810,1,_9792),set_var(_9482,sys_m,_9792),get_var(_9482,sys_e,_9840),f_cdr(_9840,_9822),set_var(_9482,sys_e,_9822),goto(sys_start,_9482),_9494=_9868;_9494=[])),[addr(addr_tagbody_39_sys_start,sys_start,'$unused',_9908,(get_var(_9908,sys_e,_9912),(c0nz:is_consp(_9912)->get_var(_9908,sys_m,_9924),'f_+'(_9924,1,_9926),set_var(_9908,sys_m,_9926),get_var(_9908,sys_e,_9930),f_cdr(_9930,_9942),set_var(_9908,sys_e,_9942),goto(sys_start,_9908),_9944=_9948;_9944=[])))]),get_var(_9482,sys_m,_9978),get_var(_9482,sys_n,_9990),'f_-'(_9978,_9990,_9960),set_var(_9482,sys_n,_9960),get_var(_9482,sys_r,_10006),set_var(_9482,sys_e,_10006),call_addr_block(_9482,(push_label(sys_start),get_var(_9482,list,_10586),(c0nz:is_consp(_10586)->_10540=[];throw(block_exit(butlast,[])),_10540=_10670),get_var(_9482,sys_n,_10754),(_10754<1->_10038=[];get_var(_9482,list,_10902),get_var(_9482,sys_e,_10868),f_car(_10902,_10884),_10882=[_10884],f_rplacd(_10868,_10882,_15580),set_var(_9482,sys_e,_15580),get_var(_9482,list,_10932),f_cdr(_10932,_10914),set_var(_9482,list,_10914),get_var(_9482,sys_n,_10962),'f_-'(_10962,1,_15618),set_var(_9482,sys_n,_15618),goto(sys_start,_9482),_10038=_10990)),[addr(addr_tagbody_40_sys_start,sys_start,'$unused',_11018,(get_var(_11018,list,_11032),(c0nz:is_consp(_11032)->_11044=[];throw(block_exit(butlast,[])),_11044=_11048),get_var(_11018,sys_n,_11062),(_11062<1->_11076=[];get_var(_11018,list,_11090),get_var(_11018,sys_e,_11104),f_car(_11090,_15704),_11118=[_15704],f_rplacd(_11104,_11118,_11120),set_var(_11018,sys_e,_11120),get_var(_11018,list,_11124),f_cdr(_11124,_15742),set_var(_11018,list,_15742),get_var(_11018,sys_n,_11140),'f_-'(_11140,1,_15768),set_var(_11018,sys_n,_15768),goto(sys_start,_11018),_11076=_11156)))]),get_var(_9482,sys_r,_11184),f_cdr(_11184,_9330)),_9330=_11212),block_exit(butlast,_11212),true).
6374:-set_opv(butlast,symbol_function,f_butlast),_7798=butlast. 6375/*
6376:-side_effect(assert_lsp(butlast,lambda_def(defun,butlast,f_butlast,[list,c38_optional,[sys_n,1]],[[let_xx,[[sys_r,[cons,[],[]]],[sys_e,list],[sys_m,0]],[tagbody,sys_start,[when,[consp,sys_e],[setf,sys_m,[+,sys_m,1]],[setf,sys_e,[cdr,sys_e]],[go,sys_start]]],[setf,sys_n,[-,sys_m,sys_n]],[setf,sys_e,sys_r],[tagbody,sys_start,[unless,[consp,list],[return_from,butlast,[]]],[unless,[<,sys_n,1],[setf,sys_e,[setf,[cdr,sys_e],[cons,[car,list],[]]]],[setf,list,[cdr,list]],[setf,sys_n,[-,sys_n,1]],[go,sys_start]]],[cdr,sys_r]]]))).
6377*/
6378/*
6379:-side_effect(assert_lsp(butlast,arglist_info(butlast,f_butlast,[list,c38_optional,[sys_n,1]],arginfo{all:[list,sys_n],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[list,sys_n],opt:[sys_n],req:[list],rest:0,sublists:0,whole:0}))).
6380*/
6381/*
6382:-side_effect(assert_lsp(butlast,init_args(1,f_butlast))).
6383*/
6384/*
6385#+(or WAM-CL LISP500)
6386(defun nbutlast (list &optional (n 1))
6387 (let* ((e list)
6388 (m 0))
6389 (tagbody
6390 start
6391 (when (consp e)
6392 (setf m (+ m 1))
6393 (setf e (cdr e))
6394 (go start)))
6395 (setf n (- m n))
6396 (setf e list)
6397 (tagbody
6398 start
6399 (unless (consp list) (return-from nbutlast nil))
6400 (unless (< n 2)
6401 (setf e (cdr e))
6402 (setf n (- n 1))
6403 (go start)))
6404 (setf (cdr e) nil)
6405 list))
6406
6407*/
6408
6409/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:16192 **********************/
6410:-lisp_compile_to_prolog(pkg_sys,[defun,nbutlast,[list,'&optional',[n,1]],['let*',[[e,list],[m,0]],[tagbody,start,[when,[consp,e],[setf,m,[+,m,1]],[setf,e,[cdr,e]],[go,start]]],[setf,n,[-,m,n]],[setf,e,list],[tagbody,start,[unless,[consp,list],['return-from',nbutlast,[]]],[unless,[<,n,2],[setf,e,[cdr,e]],[setf,n,[-,n,1]],[go,start]]],[setf,[cdr,e],[]],list]])
6411/*
6412:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], GoEnv, [], [], true), append([sys_e], [CAR74, CAR], [sys_e, CAR74, CAR]), setf_inverse_op(cdr, rplacd))).
6413*/
6414/*
6415:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], GoEnv, [], [], true), append([sys_e], [CAR74, CAR], [sys_e, CAR74, CAR]), setf_inverse_op(cdr, rplacd))).
6416*/
6417wl:lambda_def(defun,nbutlast,f_nbutlast,[list,c38_optional,[sys_n,1]],[[let_xx,[[sys_e,list],[sys_m,0]],[tagbody,sys_start,[when,[consp,sys_e],[setf,sys_m,[+,sys_m,1]],[setf,sys_e,[cdr,sys_e]],[go,sys_start]]],[setf,sys_n,[-,sys_m,sys_n]],[setf,sys_e,list],[tagbody,sys_start,[unless,[consp,list],[return_from,nbutlast,[]]],[unless,[<,sys_n,2],[setf,sys_e,[cdr,sys_e]],[setf,sys_n,[-,sys_n,1]],[go,sys_start]]],[setf,[cdr,sys_e],[]],list]]).
6418wl:arglist_info(nbutlast,f_nbutlast,[list,c38_optional,[sys_n,1]],arginfo{all:[list,sys_n],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[list,sys_n],opt:[sys_n],req:[list],rest:0,sublists:0,whole:0}).
6419wl:init_args(1,f_nbutlast).
6420
6425f_nbutlast(_8774,_8792,_10550):-_8734=[bv(list,_8774),bv(sys_n,_8776)],opt_var(_8726,sys_n,_8776,true,1,1,_8792),catch(((get_var(_8734,list,_8904),_8832=[bv(sys_e,_8904)|_8734],_8988=[bv(sys_m,0)|_8832],call_addr_block(_8988,(push_label(sys_start),get_var(_8988,sys_e,_9258),(c0nz:is_consp(_9258)->get_var(_8988,sys_m,_9316),'f_+'(_9316,1,_9298),set_var(_8988,sys_m,_9298),get_var(_8988,sys_e,_9346),f_cdr(_9346,_9328),set_var(_8988,sys_e,_9328),goto(sys_start,_8988),_9000=_9374;_9000=[])),[addr(addr_tagbody_41_sys_start,sys_start,'$unused',_9414,(get_var(_9414,sys_e,_9418),(c0nz:is_consp(_9418)->get_var(_9414,sys_m,_9430),'f_+'(_9430,1,_9432),set_var(_9414,sys_m,_9432),get_var(_9414,sys_e,_9436),f_cdr(_9436,_9448),set_var(_9414,sys_e,_9448),goto(sys_start,_9414),_9450=_9454;_9450=[])))]),get_var(_8988,sys_m,_9484),get_var(_8988,sys_n,_9496),'f_-'(_9484,_9496,_9466),set_var(_8988,sys_n,_9466),get_var(_8988,list,_9528),set_var(_8988,sys_e,_9528),call_addr_block(_8988,(push_label(sys_start),get_var(_8988,list,_10004),(c0nz:is_consp(_10004)->_9958=[];throw(block_exit(nbutlast,[])),_9958=_10088),get_var(_8988,sys_n,_10172),(_10172<2->_9556=[];get_var(_8988,sys_e,_10230),f_cdr(_10230,_14342),set_var(_8988,sys_e,_14342),get_var(_8988,sys_n,_10260),'f_-'(_10260,1,_14368),set_var(_8988,sys_n,_14368),goto(sys_start,_8988),_9556=_10288)),[addr(addr_tagbody_42_sys_start,sys_start,'$unused',_10316,(get_var(_10316,list,_10330),(c0nz:is_consp(_10330)->_10342=[];throw(block_exit(nbutlast,[])),_10342=_10346),get_var(_10316,sys_n,_10360),(_10360<2->_10374=[];get_var(_10316,sys_e,_10388),f_cdr(_10388,_14430),set_var(_10316,sys_e,_14430),get_var(_10316,sys_n,_10404),'f_-'(_10404,1,_14456),set_var(_10316,sys_n,_14456),goto(sys_start,_10316),_10374=_10420)))]),get_var(_8988,sys_e,_10492),f_rplacd(_10492,[],_10432),get_var(_8988,list,_8962)),_8962=_10550),block_exit(nbutlast,_10550),true).
6426:-set_opv(nbutlast,symbol_function,f_nbutlast),_7594=nbutlast. 6427/*
6428:-side_effect(assert_lsp(nbutlast,lambda_def(defun,nbutlast,f_nbutlast,[list,c38_optional,[sys_n,1]],[[let_xx,[[sys_e,list],[sys_m,0]],[tagbody,sys_start,[when,[consp,sys_e],[setf,sys_m,[+,sys_m,1]],[setf,sys_e,[cdr,sys_e]],[go,sys_start]]],[setf,sys_n,[-,sys_m,sys_n]],[setf,sys_e,list],[tagbody,sys_start,[unless,[consp,list],[return_from,nbutlast,[]]],[unless,[<,sys_n,2],[setf,sys_e,[cdr,sys_e]],[setf,sys_n,[-,sys_n,1]],[go,sys_start]]],[setf,[cdr,sys_e],[]],list]]))).
6429*/
6430/*
6431:-side_effect(assert_lsp(nbutlast,arglist_info(nbutlast,f_nbutlast,[list,c38_optional,[sys_n,1]],arginfo{all:[list,sys_n],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[list,sys_n],opt:[sys_n],req:[list],rest:0,sublists:0,whole:0}))).
6432*/
6433/*
6434:-side_effect(assert_lsp(nbutlast,init_args(1,f_nbutlast))).
6435*/
6436/*
6437#+(or WAM-CL LISP500)
6438(defun last (list &optional (n 1))
6439 (let* ((e list)
6440 (m 0))
6441 (tagbody
6442 start
6443 (when (consp e)
6444 (setf m (+ m 1))
6445 (setf e (cdr e))
6446 (go start)))
6447 (setf n (- m n))
6448 (setf e list)
6449 (tagbody
6450 start
6451 (when (< n 1) (return-from last e))
6452 (setf e (cdr e))
6453 (setf n (- n 1))
6454 (go start))))
6455
6456*/
6457
6458/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:16633 **********************/
6459:-lisp_compile_to_prolog(pkg_sys,[defun,last,[list,'&optional',[n,1]],['let*',[[e,list],[m,0]],[tagbody,start,[when,[consp,e],[setf,m,[+,m,1]],[setf,e,[cdr,e]],[go,start]]],[setf,n,[-,m,n]],[setf,e,list],[tagbody,start,[when,[<,n,1],['return-from',last,e]],[setf,e,[cdr,e]],[setf,n,[-,n,1]],[go,start]]]])
6460wl:lambda_def(defun,last,f_last,[list,c38_optional,[sys_n,1]],[[let_xx,[[sys_e,list],[sys_m,0]],[tagbody,sys_start,[when,[consp,sys_e],[setf,sys_m,[+,sys_m,1]],[setf,sys_e,[cdr,sys_e]],[go,sys_start]]],[setf,sys_n,[-,sys_m,sys_n]],[setf,sys_e,list],[tagbody,sys_start,[when,[<,sys_n,1],[return_from,last,sys_e]],[setf,sys_e,[cdr,sys_e]],[setf,sys_n,[-,sys_n,1]],[go,sys_start]]]]).
6461wl:arglist_info(last,f_last,[list,c38_optional,[sys_n,1]],arginfo{all:[list,sys_n],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[list,sys_n],opt:[sys_n],req:[list],rest:0,sublists:0,whole:0}).
6462wl:init_args(1,f_last).
6463
6468f_last(_8470,_8488,_9980):-_8430=[bv(list,_8470),bv(sys_n,_8472)],opt_var(_8422,sys_n,_8472,true,1,1,_8488),catch(((get_var(_8430,list,_8600),_8528=[bv(sys_e,_8600)|_8430],_8684=[bv(sys_m,0)|_8528],call_addr_block(_8684,(push_label(sys_start),get_var(_8684,sys_e,_8954),(c0nz:is_consp(_8954)->get_var(_8684,sys_m,_9012),'f_+'(_9012,1,_8994),set_var(_8684,sys_m,_8994),get_var(_8684,sys_e,_9042),f_cdr(_9042,_9024),set_var(_8684,sys_e,_9024),goto(sys_start,_8684),_8696=_9070;_8696=[])),[addr(addr_tagbody_43_sys_start,sys_start,'$unused',_9110,(get_var(_9110,sys_e,_9114),(c0nz:is_consp(_9114)->get_var(_9110,sys_m,_9126),'f_+'(_9126,1,_9128),set_var(_9110,sys_m,_9128),get_var(_9110,sys_e,_9132),f_cdr(_9132,_9144),set_var(_9110,sys_e,_9144),goto(sys_start,_9110),_9146=_9150;_9146=[])))]),get_var(_8684,sys_m,_9180),get_var(_8684,sys_n,_9192),'f_-'(_9180,_9192,_9162),set_var(_8684,sys_n,_9162),get_var(_8684,list,_9224),set_var(_8684,sys_e,_9224),call_addr_block(_8684,(push_label(sys_start),get_var(_8684,sys_n,_9632),(_9632<1->get_var(_8684,sys_e,_9688),throw(block_exit(last,_9688)),_9586=_9716;_9586=[]),get_var(_8684,sys_e,_9802),f_cdr(_9802,_13384),set_var(_8684,sys_e,_13384),get_var(_8684,sys_n,_9832),'f_-'(_9832,1,_13410),set_var(_8684,sys_n,_13410),goto(sys_start,_8684)),[addr(addr_tagbody_44_sys_start,sys_start,'$used',_9876,(get_var(_9876,sys_n,_9890),(_9890<1->get_var(_9876,sys_e,_9904),throw(block_exit(last,_9904)),_9916=_9920;_9916=[]),get_var(_9876,sys_e,_9934),f_cdr(_9934,_13472),set_var(_9876,sys_e,_13472),get_var(_9876,sys_n,_9950),'f_-'(_9950,1,_13498),set_var(_9876,sys_n,_13498),goto(sys_start,_9876)))])),[]=_9980),block_exit(last,_9980),true).
6469:-set_opv(last,symbol_function,f_last),_7434=last. 6470/*
6471:-side_effect(assert_lsp(last,lambda_def(defun,last,f_last,[list,c38_optional,[sys_n,1]],[[let_xx,[[sys_e,list],[sys_m,0]],[tagbody,sys_start,[when,[consp,sys_e],[setf,sys_m,[+,sys_m,1]],[setf,sys_e,[cdr,sys_e]],[go,sys_start]]],[setf,sys_n,[-,sys_m,sys_n]],[setf,sys_e,list],[tagbody,sys_start,[when,[<,sys_n,1],[return_from,last,sys_e]],[setf,sys_e,[cdr,sys_e]],[setf,sys_n,[-,sys_n,1]],[go,sys_start]]]]))).
6472*/
6473/*
6474:-side_effect(assert_lsp(last,arglist_info(last,f_last,[list,c38_optional,[sys_n,1]],arginfo{all:[list,sys_n],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[list,sys_n],opt:[sys_n],req:[list],rest:0,sublists:0,whole:0}))).
6475*/
6476/*
6477:-side_effect(assert_lsp(last,init_args(1,f_last))).
6478*/
6479/*
6480#+(or WAM-CL LISP500)
6481(defun ldiff (list object)
6482 (let* ((r (cons nil nil))
6483 (e r))
6484 (tagbody
6485 start
6486 (unless (or (eq object list) (atom list))
6487 (setf e (setf (cdr e) (cons (car list) nil)))
6488 (setf list (cdr list))
6489 (go start)))
6490 (cdr r)))
6491
6492*/
6493
6494/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:17013 **********************/
6495:-lisp_compile_to_prolog(pkg_sys,[defun,ldiff,[list,object],['let*',[[r,[cons,[],[]]],[e,r]],[tagbody,start,[unless,[or,[eq,object,list],[atom,list]],[setf,e,[setf,[cdr,e],[cons,[car,list],[]]]],[setf,list,[cdr,list]],[go,start]]],[cdr,r]]])
6496/*
6497:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _13438, [], [], true), append([sys_e], [CAR23, CAR], [sys_e, CAR23, CAR]), setf_inverse_op(cdr, rplacd))).
6498*/
6499/*
6500:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _13416, [], [], true), append([sys_e], [CAR23, CAR], [sys_e, CAR23, CAR]), setf_inverse_op(cdr, rplacd))).
6501*/
6502/*
6503:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv12, [], [], true), append([sys_e], [CAR38, CAR37], [sys_e, CAR38, CAR37]), setf_inverse_op(cdr, rplacd))).
6504*/
6505/*
6506:- side_effect((compile_each([fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv12, [], [], true), append([sys_e], [CAR38, CAR37], [sys_e, CAR38, CAR37]), setf_inverse_op(cdr, rplacd))).
6507*/
6508wl:lambda_def(defun,ldiff,f_ldiff,[list,sys_object],[[let_xx,[[sys_r,[cons,[],[]]],[sys_e,sys_r]],[tagbody,sys_start,[unless,[or,[eq,sys_object,list],[atom,list]],[setf,sys_e,[setf,[cdr,sys_e],[cons,[car,list],[]]]],[setf,list,[cdr,list]],[go,sys_start]]],[cdr,sys_r]]]).
6509wl:arglist_info(ldiff,f_ldiff,[list,sys_object],arginfo{all:[list,sys_object],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[list,sys_object],opt:0,req:[list,sys_object],rest:0,sublists:0,whole:0}).
6510wl:init_args(x,f_ldiff).
6511
6516f_ldiff(_7868,_7870,_8912):-_7828=[bv(list,_7868),bv(sys_object,_7870)],catch(((_7938=[[]],_7900=[bv(sys_r,_7938)|_7828],get_var(_7900,sys_r,_8070),_8028=[bv(sys_e,_8070)|_7900],call_addr_block(_8028,(push_label(sys_start),(get_var(_8028,list,_8504),get_var(_8028,sys_object,_8476),f_eq(_8476,_8504,_8560),_8560\==[],_8432=_8560->true;get_var(_8028,list,_8534),f_atom(_8534,_8516),_8432=_8516),(_8432\==[]->_8082=[];get_var(_8028,list,_8680),get_var(_8028,sys_e,_8646),f_car(_8680,_8662),_8660=[_8662],f_rplacd(_8646,_8660,_8572),set_var(_8028,sys_e,_8572),get_var(_8028,list,_8710),f_cdr(_8710,_8692),set_var(_8028,list,_8692),goto(sys_start,_8028),_8082=_8738)),[addr(addr_tagbody_45_sys_start,sys_start,'$unused',_8778,((get_var(_8778,list,_8780),get_var(_8778,sys_object,_8782),f_eq(_8782,_8780,_8784),_8784\==[],_8788=_8784->true;get_var(_8778,list,_8802),f_atom(_8802,_11716),_8788=_11716),(_8788\==[]->_8816=[];get_var(_8778,list,_8820),get_var(_8778,sys_e,_8832),f_car(_8820,_11742),_8836=[_11742],f_rplacd(_8832,_8836,_8838),set_var(_8778,sys_e,_8838),get_var(_8778,list,_8842),f_cdr(_8842,_8854),set_var(_8778,list,_8854),goto(sys_start,_8778),_8816=_8858)))]),get_var(_8028,sys_r,_8886),f_cdr(_8886,_8002)),_8002=_8912),block_exit(ldiff,_8912),true).
6517:-set_opv(ldiff,symbol_function,f_ldiff),_7120=ldiff. 6518/*
6519:-side_effect(assert_lsp(ldiff,lambda_def(defun,ldiff,f_ldiff,[list,sys_object],[[let_xx,[[sys_r,[cons,[],[]]],[sys_e,sys_r]],[tagbody,sys_start,[unless,[or,[eq,sys_object,list],[atom,list]],[setf,sys_e,[setf,[cdr,sys_e],[cons,[car,list],[]]]],[setf,list,[cdr,list]],[go,sys_start]]],[cdr,sys_r]]]))).
6520*/
6521/*
6522:-side_effect(assert_lsp(ldiff,arglist_info(ldiff,f_ldiff,[list,sys_object],arginfo{all:[list,sys_object],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[list,sys_object],opt:0,req:[list,sys_object],rest:0,sublists:0,whole:0}))).
6523*/
6524/*
6525:-side_effect(assert_lsp(ldiff,init_args(x,f_ldiff))).
6526*/
6527/*
6528#+(or WAM-CL LISP500)
6529(defun tailp (object list)
6530 (tagbody
6531 start
6532 (when (eq object list) (return-from tailp t))
6533 (unless (consp list) (return-from tailp nil))
6534 (setf list (cdr list))
6535 (go start)))
6536
6537*/
6538
6539/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:17288 **********************/
6540:-lisp_compile_to_prolog(pkg_sys,[defun,tailp,[object,list],[tagbody,start,[when,[eq,object,list],['return-from',tailp,t]],[unless,[consp,list],['return-from',tailp,[]]],[setf,list,[cdr,list]],[go,start]]])
6541wl:lambda_def(defun, tailp, f_tailp, [sys_object, list], [[tagbody, sys_start, [when, [eq, sys_object, list], [return_from, tailp, t]], [unless, [consp, list], [return_from, tailp, []]], [setf, list, [cdr, list]], [go, sys_start]]]).
6542wl:arglist_info(tailp, f_tailp, [sys_object, list], arginfo{all:[sys_object, list], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_object, list], opt:0, req:[sys_object, list], rest:0, sublists:0, whole:0}).
6543wl: init_args(x, f_tailp).
6544
6549f_tailp(Object_In, List_In, FnResult) :-
6550 BlockExitEnv=[bv(sys_object, Object_In), bv(list, List_In)],
6551 catch(( call_addr_block(BlockExitEnv,
6552 (push_label(sys_start), get_var(BlockExitEnv, list, List_Get30), get_var(BlockExitEnv, sys_object, Object_Get29), (is_eq(Object_Get29, List_Get30)->throw(block_exit(tailp, t)), _7826=ThrowResult35;_7826=[]), get_var(BlockExitEnv, list, List_Get39), (c0nz:is_consp(List_Get39)->_8052=[];throw(block_exit(tailp, [])), _8052=ThrowResult43), get_var(BlockExitEnv, list, List_Get46), f_cdr(List_Get46, List), set_var(BlockExitEnv, list, List), goto(sys_start, BlockExitEnv)),
6553
6554 [ addr(addr_tagbody_46_sys_start,
6555 sys_start,
6556 '$used',
6557 BlockExitEnv,
6558 (get_var(BlockExitEnv, list, List_Get), get_var(BlockExitEnv, sys_object, Object_Get), (is_eq(Object_Get, List_Get)->throw(block_exit(tailp, t)), _8336=ThrowResult;_8336=[]), get_var(BlockExitEnv, list, List_Get18), (c0nz:is_consp(List_Get18)->_8366=[];throw(block_exit(tailp, [])), _8366=ThrowResult22), get_var(BlockExitEnv, list, List_Get24), f_cdr(List_Get24, Cdr_Ret), set_var(BlockExitEnv, list, Cdr_Ret), goto(sys_start, BlockExitEnv)))
6559 ]),
6560 []=FnResult
6561 ),
6562 block_exit(tailp, FnResult),
6563 true).
6564:- set_opv(tailp, symbol_function, f_tailp),
6565 DefunResult=tailp. 6566/*
6567:- side_effect(assert_lsp(tailp,
6568 lambda_def(defun,
6569 tailp,
6570 f_tailp,
6571 [sys_object, list],
6572
6573 [
6574 [ tagbody,
6575 sys_start,
6576
6577 [ when,
6578 [eq, sys_object, list],
6579 [return_from, tailp, t]
6580 ],
6581
6582 [ unless,
6583 [consp, list],
6584 [return_from, tailp, []]
6585 ],
6586 [setf, list, [cdr, list]],
6587 [go, sys_start]
6588 ]
6589 ]))).
6590*/
6591/*
6592:- side_effect(assert_lsp(tailp,
6593 arglist_info(tailp,
6594 f_tailp,
6595 [sys_object, list],
6596 arginfo{ all:[sys_object, list],
6597 allow_other_keys:0,
6598 aux:0,
6599 body:0,
6600 complex:0,
6601 env:0,
6602 key:0,
6603 names:[sys_object, list],
6604 opt:0,
6605 req:[sys_object, list],
6606 rest:0,
6607 sublists:0,
6608 whole:0
6609 }))).
6610*/
6611/*
6612:- side_effect(assert_lsp(tailp, init_args(x, f_tailp))).
6613*/
6614/*
6615#+BUILTIN
6616#+(or WAM-CL LISP500)
6617(defun nthcdr (n list) (if (< n 1) list (nthcdr (- n 1) (cdr list))))
6618
6619
6620*/
6621
6622/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:17516 **********************/
6623:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,nthcdr,[n,list],[if,[<,n,1],list,[nthcdr,[-,n,1],[cdr,list]]]]]]))
6624/*
6625#+(or WAM-CL LISP500)
6626(defun rest (list) (cdr list))
6627
6628
6629*/
6630
6631/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:17626 **********************/
6632:-lisp_compile_to_prolog(pkg_sys,[defun,rest,[list],[cdr,list]])
6633wl:lambda_def(defun, rest, f_rest, [list], [[cdr, list]]).
6634wl:arglist_info(rest, f_rest, [list], arginfo{all:[list], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[list], opt:0, req:[list], rest:0, sublists:0, whole:0}).
6635wl: init_args(x, f_rest).
6636
6641f_rest(List_In, FnResult) :-
6642 GEnv=[bv(list, List_In)],
6643 catch(( ( get_var(GEnv, list, List_Get),
6644 f_cdr(List_Get, Cdr_Ret)
6645 ),
6646 Cdr_Ret=FnResult
6647 ),
6648 block_exit(rest, FnResult),
6649 true).
6650:- set_opv(rest, symbol_function, f_rest),
6651 DefunResult=rest. 6652/*
6653:- side_effect(assert_lsp(rest,
6654 lambda_def(defun, rest, f_rest, [list], [[cdr, list]]))).
6655*/
6656/*
6657:- side_effect(assert_lsp(rest,
6658 arglist_info(rest,
6659 f_rest,
6660 [list],
6661 arginfo{ all:[list],
6662 allow_other_keys:0,
6663 aux:0,
6664 body:0,
6665 complex:0,
6666 env:0,
6667 key:0,
6668 names:[list],
6669 opt:0,
6670 req:[list],
6671 rest:0,
6672 sublists:0,
6673 whole:0
6674 }))).
6675*/
6676/*
6677:- side_effect(assert_lsp(rest, init_args(x, f_rest))).
6678*/
6679/*
6680#+(or WAM-CL LISP500)
6681(labels ((all-end (lists)
6682 (dolist (elem lists nil)
6683 (unless elem (return-from all-end t))))
6684 (all-car (lists)
6685 (when lists (cons (caar lists) (all-car (cdr lists)))))
6686 (all-cdr (lists)
6687 (when lists (cons (cdar lists) (all-cdr (cdr lists))))))
6688 (defun mapc (function &rest lists)
6689 (let ((list-1 (car lists)))
6690 (tagbody
6691 start
6692 (when (all-end lists) (return-from mapc list-1))
6693 (apply function (all-car lists))
6694 (setf lists (all-cdr lists))
6695 (go start))))
6696 (defun mapcar (function &rest lists)
6697 (let ((result nil)
6698 (end nil))
6699 (tagbody
6700 start
6701 (when (all-end lists) (return-from mapcar result))
6702 (let ((cons (cons (apply function (all-car lists)) nil)))
6703 (setf end (if end (setf (cdr end) cons) (setf result cons))))
6704 (setf lists (all-cdr lists))
6705 (go start))))
6706 (defun mapl (function &rest lists)
6707 (let ((list-1 (car lists)))
6708 (tagbody
6709 start
6710 (when (all-end lists) (return-from mapl list-1))
6711 (apply function lists)
6712 (setf lists (all-cdr lists))
6713 (go start))))
6714 (defun maplist (function &rest lists)
6715 (let ((result nil)
6716 (end nil))
6717 (tagbody
6718 start
6719 (when (all-end lists) (return-from maplist result))
6720 (let ((cons (cons (apply function lists) nil)))
6721 (setf end (if end (setf (cdr end) cons) (setf result cons))))
6722 (setf lists (all-cdr lists))
6723 (go start)))))
6724
6725
6726
6727*/
6728
6729/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:17686 **********************/
6730:-lisp_compile_to_prolog(pkg_sys,[labels,[['all-end',[lists],[dolist,[elem,lists,[]],[unless,elem,['return-from','all-end',t]]]],['all-car',[lists],[when,lists,[cons,[caar,lists],['all-car',[cdr,lists]]]]],['all-cdr',[lists],[when,lists,[cons,[cdar,lists],['all-cdr',[cdr,lists]]]]]],[defun,mapc,[function,'&rest',lists],[let,[['list-1',[car,lists]]],[tagbody,start,[when,['all-end',lists],['return-from',mapc,'list-1']],[apply,function,['all-car',lists]],[setf,lists,['all-cdr',lists]],[go,start]]]],[defun,mapcar,[function,'&rest',lists],[let,[[result,[]],[end,[]]],[tagbody,start,[when,['all-end',lists],['return-from',mapcar,result]],[let,[[cons,[cons,[apply,function,['all-car',lists]],[]]]],[setf,end,[if,end,[setf,[cdr,end],cons],[setf,result,cons]]]],[setf,lists,['all-cdr',lists]],[go,start]]]],[defun,mapl,[function,'&rest',lists],[let,[['list-1',[car,lists]]],[tagbody,start,[when,['all-end',lists],['return-from',mapl,'list-1']],[apply,function,lists],[setf,lists,['all-cdr',lists]],[go,start]]]],[defun,maplist,[function,'&rest',lists],[let,[[result,[]],[end,[]]],[tagbody,start,[when,['all-end',lists],['return-from',maplist,result]],[let,[[cons,[cons,[apply,function,lists],[]]]],[setf,end,[if,end,[setf,[cdr,end],cons],[setf,result,cons]]]],[setf,lists,['all-cdr',lists]],[go,start]]]]])
6731/*
6732:- side_effect(generate_function_or_macro_name(
6733 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6734 name='GLOBAL',
6735 environ=env_1
6736 ],
6737 sys_all_end,
6738 kw_function,
6739 f_sys_all_end)).
6740*/
6741/*
6742:- side_effect(generate_function_or_macro_name(
6743 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6744 name='GLOBAL',
6745 environ=env_1
6746 ],
6747 sys_all_car,
6748 kw_function,
6749 f_sys_all_car)).
6750*/
6751/*
6752:- side_effect(generate_function_or_macro_name(
6753 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6754 name='GLOBAL',
6755 environ=env_1
6756 ],
6757 sys_all_car,
6758 kw_function,
6759 f_sys_all_car)).
6760*/
6761/*
6762:- side_effect(generate_function_or_macro_name(
6763 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6764 name='GLOBAL',
6765 environ=env_1
6766 ],
6767 sys_all_cdr,
6768 kw_function,
6769 f_sys_all_cdr)).
6770*/
6771/*
6772:- side_effect(generate_function_or_macro_name(
6773 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6774 name='GLOBAL',
6775 environ=env_1
6776 ],
6777 sys_all_cdr,
6778 kw_function,
6779 f_sys_all_cdr)).
6780*/
6781/*
6782:- side_effect((compile_each([fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv98, [], [], true), append([sys_end], [CAR106, CAR], [sys_end, CAR106, CAR]), setf_inverse_op(cdr, rplacd))).
6783*/
6784/*
6785:- side_effect((compile_each([fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv98, [], [], true), append([sys_end], [CAR106, CAR], [sys_end, CAR106, CAR]), setf_inverse_op(cdr, rplacd))).
6786*/
6787/*
6788:- side_effect((compile_each([fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv126, [], [], true), append([sys_end], [CAR134, CAR133], [sys_end, CAR134, CAR133]), setf_inverse_op(cdr, rplacd))).
6789*/
6790/*
6791:- side_effect((compile_each([fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv126, [], [], true), append([sys_end], [CAR134, CAR133], [sys_end, CAR134, CAR133]), setf_inverse_op(cdr, rplacd))).
6792*/
6793/*
6794:- side_effect((compile_each([fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv202, [], [], true), append([sys_end], [CAR210, CAR209], [sys_end, CAR210, CAR209]), setf_inverse_op(cdr, rplacd))).
6795*/
6796/*
6797:- side_effect((compile_each([fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv202, [], [], true), append([sys_end], [CAR210, CAR209], [sys_end, CAR210, CAR209]), setf_inverse_op(cdr, rplacd))).
6798*/
6799/*
6800:- side_effect((compile_each([fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv230, [], [], true), append([sys_end], [CAR238, CAR237], [sys_end, CAR238, CAR237]), setf_inverse_op(cdr, rplacd))).
6801*/
6802/*
6803:- side_effect((compile_each([fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv230, [], [], true), append([sys_end], [CAR238, CAR237], [sys_end, CAR238, CAR237]), setf_inverse_op(cdr, rplacd))).
6804*/
6805wl:lambda_def(defun, sys_all_end, f_sys_all_end1, [sys_lists], [[dolist, [sys_elem, sys_lists, []], [unless, sys_elem, [return_from, sys_all_end, t]]]]).
6806wl:arglist_info(sys_all_end, f_sys_all_end1, [sys_lists], arginfo{all:[sys_lists], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_lists], opt:0, req:[sys_lists], rest:0, sublists:0, whole:0}).
6807wl: init_args(1, f_sys_all_end1).
6808
6813f_sys_all_end1(Lists_In, RestNKeys, FnResult) :-
6814 CDR=[bv(sys_lists, Lists_In)],
6815 catch(( ( LEnv=[bv([], [])|CDR],
6816 get_var(LEnv, sys_lists, Lists_Get),
6817 BV=bv(sys_elem, Ele),
6818 BlockExitEnv=[BV|LEnv],
6819 forall(member(Ele, Lists_Get),
6820 ( nb_setarg(2, BV, Ele),
6821 get_var(BlockExitEnv, sys_elem, IFTEST),
6822 ( IFTEST\==[]
6823 -> _13216=[]
6824 ; throw(block_exit(sys_all_end, t)),
6825 _13216=ThrowResult
6826 )
6827 ))
6828 ),
6829 []=FnResult
6830 ),
6831 block_exit(sys_all_end, FnResult),
6832 true).
6833wl:lambda_def(defun, sys_all_car, f_sys_all_car1, [sys_lists], [[when, sys_lists, [cons, [caar, sys_lists], [sys_all_car, [cdr, sys_lists]]]]]).
6834wl:arglist_info(sys_all_car, f_sys_all_car1, [sys_lists], arginfo{all:[sys_lists], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_lists], opt:0, req:[sys_lists], rest:0, sublists:0, whole:0}).
6835wl: init_args(1, f_sys_all_car1).
6836
6841f_sys_all_car1(Lists_In23, RestNKeys22, FnResult21) :-
6842 GEnv=[bv(sys_lists, Lists_In23)],
6843 catch(( ( get_var(GEnv, sys_lists, IFTEST24),
6844 ( IFTEST24\==[]
6845 -> get_var(GEnv, sys_lists, Lists_Get27),
6846 f_caar(Lists_Get27, Caar_Ret),
6847 get_var(GEnv, sys_lists, Lists_Get28),
6848 f_cdr(Lists_Get28, All_car_Param),
6849 f_sys_all_car(All_car_Param, All_car_Ret),
6850 TrueResult=[Caar_Ret|All_car_Ret],
6851 _13548=TrueResult
6852 ; _13548=[]
6853 )
6854 ),
6855 _13548=FnResult21
6856 ),
6857 block_exit(sys_all_car, FnResult21),
6858 true).
6859wl:lambda_def(defun, sys_all_cdr, f_sys_all_cdr1, [sys_lists], [[when, sys_lists, [cons, [cdar, sys_lists], [sys_all_cdr, [cdr, sys_lists]]]]]).
6860wl:arglist_info(sys_all_cdr, f_sys_all_cdr1, [sys_lists], arginfo{all:[sys_lists], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_lists], opt:0, req:[sys_lists], rest:0, sublists:0, whole:0}).
6861wl: init_args(1, f_sys_all_cdr1).
6862
6867f_sys_all_cdr1(Lists_In33, RestNKeys32, FnResult31) :-
6868 GEnv250=[bv(sys_lists, Lists_In33)],
6869 catch(( ( get_var(GEnv250, sys_lists, IFTEST34),
6870 ( IFTEST34\==[]
6871 -> get_var(GEnv250, sys_lists, Lists_Get37),
6872 f_cdar(Lists_Get37, Cdar_Ret),
6873 get_var(GEnv250, sys_lists, Lists_Get38),
6874 f_cdr(Lists_Get38, All_cdr_Param),
6875 f_sys_all_cdr(All_cdr_Param, All_cdr_Ret),
6876 TrueResult39=[Cdar_Ret|All_cdr_Ret],
6877 _13798=TrueResult39
6878 ; _13798=[]
6879 )
6880 ),
6881 _13798=FnResult31
6882 ),
6883 block_exit(sys_all_cdr, FnResult31),
6884 true).
6885wl:lambda_def(defun, mapc, f_mapc, [function, c38_rest, sys_lists], [[let, [[sys_list_1, [car, sys_lists]]], [tagbody, sys_start, [when, [sys_all_end, sys_lists], [return_from, mapc, sys_list_1]], [apply, function, [sys_all_car, sys_lists]], [setf, sys_lists, [sys_all_cdr, sys_lists]], [go, sys_start]]]]).
6886wl:arglist_info(mapc, f_mapc, [function, c38_rest, sys_lists], arginfo{all:[function], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[function, sys_lists], opt:0, req:[function], rest:[sys_lists], sublists:0, whole:0}).
6887wl: init_args(1, f_mapc).
6888
6893f_mapc(Function_In, RestNKeys42, FnResult41) :-
6894 GEnv251=[bv(function, Function_In), bv(sys_lists, RestNKeys42)],
6895 catch(( ( get_var(GEnv251, sys_lists, Lists_Get48),
6896 f_car(Lists_Get48, List_1_Init),
6897 BlockExitEnv=[bv(sys_list_1, List_1_Init)|GEnv251],
6898 call_addr_block(BlockExitEnv,
6899 (push_label(sys_start), get_var(BlockExitEnv, sys_lists, Lists_Get67), f_sys_all_end1(Lists_Get67, IFTEST65), (IFTEST65\==[]->get_var(BlockExitEnv, sys_list_1, RetResult68), throw(block_exit(mapc, RetResult68)), _14604=ThrowResult69;_14604=[]), get_var(BlockExitEnv, function, Function_Get73), get_var(BlockExitEnv, sys_lists, Lists_Get74), f_sys_all_car1(Lists_Get74, KeysNRest), f_apply(Function_Get73, KeysNRest, Apply_Ret), get_var(BlockExitEnv, sys_lists, Lists_Get75), f_sys_all_cdr1(Lists_Get75, Lists), set_var(BlockExitEnv, sys_lists, Lists), goto(sys_start, BlockExitEnv)),
6900
6901 [ addr(addr_tagbody_47_sys_start,
6902 sys_start,
6903 '$used',
6904 BlockExitEnv57,
6905 (get_var(BlockExitEnv57, sys_lists, Lists_Get53), f_sys_all_end1(Lists_Get53, IFTEST51), (IFTEST51\==[]->get_var(BlockExitEnv57, sys_list_1, RetResult54), throw(block_exit(mapc, RetResult54)), _14976=ThrowResult55;_14976=[]), get_var(BlockExitEnv57, function, Apply_Param), get_var(BlockExitEnv57, sys_lists, Lists_Get60), f_sys_all_car1(Lists_Get60, KeysNRest261), f_apply(Apply_Param, KeysNRest261, Apply_Ret274), get_var(BlockExitEnv57, sys_lists, Lists_Get61), f_sys_all_cdr1(Lists_Get61, KeysNRest262), set_var(BlockExitEnv57, sys_lists, KeysNRest262), goto(sys_start, BlockExitEnv57)))
6906 ])
6907 ),
6908 []=FnResult41
6909 ),
6910 block_exit(mapc, FnResult41),
6911 true).
6912:- set_opv(mapc, symbol_function, f_mapc),
6913 DefunResult=mapc,
6914 assert_lsp(mapcar,
6915 wl:lambda_def(defun, mapcar, f_mapcar, [function, c38_rest, sys_lists], [[let, [[sys_result, []], [sys_end, []]], [tagbody, sys_start, [when, [sys_all_end, sys_lists], [return_from, mapcar, sys_result]], [let, [[cons, [cons, [apply, function, [sys_all_car, sys_lists]], []]]], [setf, sys_end, [if, sys_end, [setf, [cdr, sys_end], cons], [setf, sys_result, cons]]]], [setf, sys_lists, [sys_all_cdr, sys_lists]], [go, sys_start]]]])),
6916 assert_lsp(mapcar,
6917 wl:arglist_info(mapcar, f_mapcar, [function, c38_rest, sys_lists], arginfo{all:[function], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[function, sys_lists], opt:0, req:[function], rest:[sys_lists], sublists:0, whole:0})),
6918 assert_lsp(mapcar, wl:init_args(1, f_mapcar)),
6919 assert_lsp(mapcar,
6920 (f_mapcar(Function_In82, RestNKeys81, FnResult80):-CDR275=[bv(function, Function_In82), bv(sys_lists, RestNKeys81)], catch(((BlockExitEnv=[bv(sys_result, []), bv(sys_end, [])|CDR275], call_addr_block(BlockExitEnv, (push_label(sys_start), get_var(BlockExitEnv, sys_lists, Lists_Get118), f_sys_all_end1(Lists_Get118, IFTEST116), (IFTEST116\==[]->get_var(BlockExitEnv, sys_result, RetResult119), throw(block_exit(mapcar, RetResult119)), _15918=ThrowResult120;_15918=[]), get_var(BlockExitEnv, function, Function_Get127), get_var(BlockExitEnv, sys_lists, Lists_Get128), f_sys_all_car1(Lists_Get128, KeysNRest263), f_apply(Function_Get127, KeysNRest263, Apply_Ret276), Cons_Init129=[Apply_Ret276], LEnv126=[bv(cons, Cons_Init129)|BlockExitEnv], get_var(LEnv126, sys_end, IFTEST130), (IFTEST130\==[]->get_var(LEnv126, cons, Cons_Get136), get_var(LEnv126, sys_end, End_Get135), f_rplacd(End_Get135, Cons_Get136, TrueResult138), LetResult125=TrueResult138;get_var(LEnv126, cons, Cons_Get137), set_var(LEnv126, sys_result, Cons_Get137), LetResult125=Cons_Get137), set_var(LEnv126, sys_end, LetResult125), get_var(BlockExitEnv, sys_lists, Lists_Get140), f_sys_all_cdr1(Lists_Get140, Lists253), set_var(BlockExitEnv, sys_lists, Lists253), goto(sys_start, BlockExitEnv)), [addr(addr_tagbody_48_sys_start, sys_start, '$used', BlockExitEnv94, (get_var(BlockExitEnv94, sys_lists, Lists_Get90), f_sys_all_end1(Lists_Get90, IFTEST88), (IFTEST88\==[]->get_var(BlockExitEnv94, sys_result, RetResult91), throw(block_exit(mapcar, RetResult91)), _16660=ThrowResult92;_16660=[]), get_var(BlockExitEnv94, function, Function_Get99), get_var(BlockExitEnv94, sys_lists, Lists_Get100), f_sys_all_car1(Lists_Get100, KeysNRest264), f_apply(Function_Get99, KeysNRest264, Apply_Ret277), Bv_Ret=[Apply_Ret277], LEnv98=[bv(cons, Bv_Ret)|BlockExitEnv94], get_var(LEnv98, sys_end, IFTEST102), (IFTEST102\==[]->get_var(LEnv98, cons, Get_var_Ret), get_var(LEnv98, sys_end, End_Get107), f_rplacd(End_Get107, Get_var_Ret, TrueResult110), LetResult97=TrueResult110;get_var(LEnv98, cons, Cons_Get109), set_var(LEnv98, sys_result, Cons_Get109), LetResult97=Cons_Get109), set_var(LEnv98, sys_end, LetResult97), get_var(BlockExitEnv94, sys_lists, Lists_Get112), f_sys_all_cdr1(Lists_Get112, KeysNRest265), set_var(BlockExitEnv94, sys_lists, KeysNRest265), goto(sys_start, BlockExitEnv94)))])), []=FnResult80), block_exit(mapcar, FnResult80), true))),
6921 set_opv(mapcar, symbol_function, f_mapcar),
6922 DefunResult144=mapcar,
6923 assert_lsp(mapl,
6924 wl:lambda_def(defun, mapl, f_mapl, [function, c38_rest, sys_lists], [[let, [[sys_list_1, [car, sys_lists]]], [tagbody, sys_start, [when, [sys_all_end, sys_lists], [return_from, mapl, sys_list_1]], [apply, function, sys_lists], [setf, sys_lists, [sys_all_cdr, sys_lists]], [go, sys_start]]]])),
6925 assert_lsp(mapl,
6926 wl:arglist_info(mapl, f_mapl, [function, c38_rest, sys_lists], arginfo{all:[function], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[function, sys_lists], opt:0, req:[function], rest:[sys_lists], sublists:0, whole:0})),
6927 assert_lsp(mapl, wl:init_args(1, f_mapl)),
6928 assert_lsp(mapl,
6929 (f_mapl(Function_In147, RestNKeys146, FnResult145):-GEnv254=[bv(function, Function_In147), bv(sys_lists, RestNKeys146)], catch(((get_var(GEnv254, sys_lists, Lists_Get152), f_car(Lists_Get152, List_1_Init153), BlockExitEnv=[bv(sys_list_1, List_1_Init153)|GEnv254], call_addr_block(BlockExitEnv, (push_label(sys_start), get_var(BlockExitEnv, sys_lists, Lists_Get171), f_sys_all_end1(Lists_Get171, IFTEST169), (IFTEST169\==[]->get_var(BlockExitEnv, sys_list_1, RetResult172), throw(block_exit(mapl, RetResult172)), _17478=ThrowResult173;_17478=[]), get_var(BlockExitEnv, function, Function_Get177), get_var(BlockExitEnv, sys_lists, Lists_Get178), f_apply(Function_Get177, Lists_Get178, Apply_Ret280), get_var(BlockExitEnv, sys_lists, Lists_Get179), f_sys_all_cdr1(Lists_Get179, Lists255), set_var(BlockExitEnv, sys_lists, Lists255), goto(sys_start, BlockExitEnv)), [addr(addr_tagbody_49_sys_start, sys_start, '$used', BlockExitEnv161, (get_var(BlockExitEnv161, sys_lists, Lists_Get157), f_sys_all_end1(Lists_Get157, IFTEST155), (IFTEST155\==[]->get_var(BlockExitEnv161, sys_list_1, RetResult158), throw(block_exit(mapl, RetResult158)), _17850=ThrowResult159;_17850=[]), get_var(BlockExitEnv161, function, Function_Get163), get_var(BlockExitEnv161, sys_lists, Lists_Get164), f_apply(Function_Get163, Lists_Get164, Apply_Ret281), get_var(BlockExitEnv161, sys_lists, Lists_Get165), f_sys_all_cdr1(Lists_Get165, KeysNRest266), set_var(BlockExitEnv161, sys_lists, KeysNRest266), goto(sys_start, BlockExitEnv161)))])), []=FnResult145), block_exit(mapl, FnResult145), true))),
6930 set_opv(mapl, symbol_function, f_mapl),
6931 DefunResult183=mapl,
6932 assert_lsp(maplist,
6933 wl:lambda_def(defun, maplist, f_maplist, [function, c38_rest, sys_lists], [[let, [[sys_result, []], [sys_end, []]], [tagbody, sys_start, [when, [sys_all_end, sys_lists], [return_from, maplist, sys_result]], [let, [[cons, [cons, [apply, function, sys_lists], []]]], [setf, sys_end, [if, sys_end, [setf, [cdr, sys_end], cons], [setf, sys_result, cons]]]], [setf, sys_lists, [sys_all_cdr, sys_lists]], [go, sys_start]]]])),
6934 assert_lsp(maplist,
6935 wl:arglist_info(maplist, f_maplist, [function, c38_rest, sys_lists], arginfo{all:[function], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[function, sys_lists], opt:0, req:[function], rest:[sys_lists], sublists:0, whole:0})),
6936 assert_lsp(maplist, wl:init_args(1, f_maplist)),
6937 assert_lsp(maplist,
6938 (f_maplist(Function_In186, RestNKeys185, FnResult184):-CDR282=[bv(function, Function_In186), bv(sys_lists, RestNKeys185)], catch(((BlockExitEnv=[bv(sys_result, []), bv(sys_end, [])|CDR282], call_addr_block(BlockExitEnv, (push_label(sys_start), get_var(BlockExitEnv, sys_lists, Lists_Get222), f_sys_all_end1(Lists_Get222, IFTEST220), (IFTEST220\==[]->get_var(BlockExitEnv, sys_result, RetResult223), throw(block_exit(maplist, RetResult223)), _18890=ThrowResult224;_18890=[]), get_var(BlockExitEnv, function, Function_Get231), get_var(BlockExitEnv, sys_lists, Lists_Get232), f_apply(Function_Get231, Lists_Get232, Apply_Ret283), Cons_Init233=[Apply_Ret283], LEnv230=[bv(cons, Cons_Init233)|BlockExitEnv], get_var(LEnv230, sys_end, IFTEST234), (IFTEST234\==[]->get_var(LEnv230, cons, Cons_Get240), get_var(LEnv230, sys_end, End_Get239), f_rplacd(End_Get239, Cons_Get240, TrueResult242), LetResult229=TrueResult242;get_var(LEnv230, cons, Cons_Get241), set_var(LEnv230, sys_result, Cons_Get241), LetResult229=Cons_Get241), set_var(LEnv230, sys_end, LetResult229), get_var(BlockExitEnv, sys_lists, Lists_Get244), f_sys_all_cdr1(Lists_Get244, Lists256), set_var(BlockExitEnv, sys_lists, Lists256), goto(sys_start, BlockExitEnv)), [addr(addr_tagbody_50_sys_start, sys_start, '$used', BlockExitEnv198, (get_var(BlockExitEnv198, sys_lists, Lists_Get194), f_sys_all_end1(Lists_Get194, IFTEST192), (IFTEST192\==[]->get_var(BlockExitEnv198, sys_result, RetResult195), throw(block_exit(maplist, RetResult195)), _19630=ThrowResult196;_19630=[]), get_var(BlockExitEnv198, function, Function_Get203), get_var(BlockExitEnv198, sys_lists, Lists_Get204), f_apply(Function_Get203, Lists_Get204, Apply_Ret284), Cons_Init205=[Apply_Ret284], LEnv202=[bv(cons, Cons_Init205)|BlockExitEnv198], get_var(LEnv202, sys_end, IFTEST206), (IFTEST206\==[]->get_var(LEnv202, cons, Cons_Get212), get_var(LEnv202, sys_end, End_Get211), f_rplacd(End_Get211, Cons_Get212, TrueResult214), LetResult201=TrueResult214;get_var(LEnv202, cons, Cons_Get213), set_var(LEnv202, sys_result, Cons_Get213), LetResult201=Cons_Get213), set_var(LEnv202, sys_end, LetResult201), get_var(BlockExitEnv198, sys_lists, Lists_Get216), f_sys_all_cdr1(Lists_Get216, KeysNRest267), set_var(BlockExitEnv198, sys_lists, KeysNRest267), goto(sys_start, BlockExitEnv198)))])), []=FnResult184), block_exit(maplist, FnResult184), true))),
6939 set_opv(maplist, symbol_function, f_maplist),
6940 DefunResult248=maplist. 6941/*
6942:- side_effect(assert_lsp(sys_all_end,
6943 lambda_def(defun,
6944 sys_all_end,
6945 f_sys_all_end1,
6946 [sys_lists],
6947
6948 [
6949 [ dolist,
6950 [sys_elem, sys_lists, []],
6951
6952 [ unless,
6953 sys_elem,
6954 [return_from, sys_all_end, t]
6955 ]
6956 ]
6957 ]))).
6958*/
6959/*
6960:- side_effect(assert_lsp(sys_all_end,
6961 arglist_info(sys_all_end,
6962 f_sys_all_end1,
6963 [sys_lists],
6964 arginfo{ all:[sys_lists],
6965 allow_other_keys:0,
6966 aux:0,
6967 body:0,
6968 complex:0,
6969 env:0,
6970 key:0,
6971 names:[sys_lists],
6972 opt:0,
6973 req:[sys_lists],
6974 rest:0,
6975 sublists:0,
6976 whole:0
6977 }))).
6978*/
6979/*
6980:- side_effect(assert_lsp(sys_all_end, init_args(1, f_sys_all_end1))).
6981*/
6982/*
6983:- side_effect(assert_lsp(sys_all_car,
6984 lambda_def(defun,
6985 sys_all_car,
6986 f_sys_all_car1,
6987 [sys_lists],
6988
6989 [
6990 [ when,
6991 sys_lists,
6992
6993 [ cons,
6994 [caar, sys_lists],
6995 [sys_all_car, [cdr, sys_lists]]
6996 ]
6997 ]
6998 ]))).
6999*/
7000/*
7001:- side_effect(assert_lsp(sys_all_car,
7002 arglist_info(sys_all_car,
7003 f_sys_all_car1,
7004 [sys_lists],
7005 arginfo{ all:[sys_lists],
7006 allow_other_keys:0,
7007 aux:0,
7008 body:0,
7009 complex:0,
7010 env:0,
7011 key:0,
7012 names:[sys_lists],
7013 opt:0,
7014 req:[sys_lists],
7015 rest:0,
7016 sublists:0,
7017 whole:0
7018 }))).
7019*/
7020/*
7021:- side_effect(assert_lsp(sys_all_car, init_args(1, f_sys_all_car1))).
7022*/
7023/*
7024:- side_effect(assert_lsp(sys_all_cdr,
7025 lambda_def(defun,
7026 sys_all_cdr,
7027 f_sys_all_cdr1,
7028 [sys_lists],
7029
7030 [
7031 [ when,
7032 sys_lists,
7033
7034 [ cons,
7035 [cdar, sys_lists],
7036 [sys_all_cdr, [cdr, sys_lists]]
7037 ]
7038 ]
7039 ]))).
7040*/
7041/*
7042:- side_effect(assert_lsp(sys_all_cdr,
7043 arglist_info(sys_all_cdr,
7044 f_sys_all_cdr1,
7045 [sys_lists],
7046 arginfo{ all:[sys_lists],
7047 allow_other_keys:0,
7048 aux:0,
7049 body:0,
7050 complex:0,
7051 env:0,
7052 key:0,
7053 names:[sys_lists],
7054 opt:0,
7055 req:[sys_lists],
7056 rest:0,
7057 sublists:0,
7058 whole:0
7059 }))).
7060*/
7061/*
7062:- side_effect(assert_lsp(sys_all_cdr, init_args(1, f_sys_all_cdr1))).
7063*/
7064/*
7065:- side_effect(assert_lsp(mapc,
7066 lambda_def(defun,
7067 mapc,
7068 f_mapc,
7069 [function, c38_rest, sys_lists],
7070
7071 [
7072 [ let,
7073 [[sys_list_1, [car, sys_lists]]],
7074
7075 [ tagbody,
7076 sys_start,
7077
7078 [ when,
7079 [sys_all_end, sys_lists],
7080 [return_from, mapc, sys_list_1]
7081 ],
7082
7083 [ apply,
7084 function,
7085 [sys_all_car, sys_lists]
7086 ],
7087
7088 [ setf,
7089 sys_lists,
7090 [sys_all_cdr, sys_lists]
7091 ],
7092 [go, sys_start]
7093 ]
7094 ]
7095 ]))).
7096*/
7097/*
7098:- side_effect(assert_lsp(mapc,
7099 arglist_info(mapc,
7100 f_mapc,
7101 [function, c38_rest, sys_lists],
7102 arginfo{ all:[function],
7103 allow_other_keys:0,
7104 aux:0,
7105 body:0,
7106 complex:[rest],
7107 env:0,
7108 key:0,
7109 names:[function, sys_lists],
7110 opt:0,
7111 req:[function],
7112 rest:[sys_lists],
7113 sublists:0,
7114 whole:0
7115 }))).
7116*/
7117/*
7118:- side_effect(assert_lsp(mapc, init_args(1, f_mapc))).
7119*/
7120/*
7121:- side_effect(assert_lsp(mapcar,
7122 lambda_def(defun,
7123 mapcar,
7124 f_mapcar,
7125 [function, c38_rest, sys_lists],
7126
7127 [
7128 [ let,
7129 [[sys_result, []], [sys_end, []]],
7130
7131 [ tagbody,
7132 sys_start,
7133
7134 [ when,
7135 [sys_all_end, sys_lists],
7136 [return_from, mapcar, sys_result]
7137 ],
7138
7139 [ let,
7140
7141 [
7142 [ cons,
7143
7144 [ cons,
7145
7146 [ apply,
7147 function,
7148 [sys_all_car, sys_lists]
7149 ],
7150 []
7151 ]
7152 ]
7153 ],
7154
7155 [ setf,
7156 sys_end,
7157
7158 [ if,
7159 sys_end,
7160 [setf, [cdr, sys_end], cons],
7161 [setf, sys_result, cons]
7162 ]
7163 ]
7164 ],
7165
7166 [ setf,
7167 sys_lists,
7168 [sys_all_cdr, sys_lists]
7169 ],
7170 [go, sys_start]
7171 ]
7172 ]
7173 ]))).
7174*/
7175/*
7176:- side_effect(assert_lsp(mapcar,
7177 arglist_info(mapcar,
7178 f_mapcar,
7179 [function, c38_rest, sys_lists],
7180 arginfo{ all:[function],
7181 allow_other_keys:0,
7182 aux:0,
7183 body:0,
7184 complex:[rest],
7185 env:0,
7186 key:0,
7187 names:[function, sys_lists],
7188 opt:0,
7189 req:[function],
7190 rest:[sys_lists],
7191 sublists:0,
7192 whole:0
7193 }))).
7194*/
7195/*
7196:- side_effect(assert_lsp(mapcar, init_args(1, f_mapcar))).
7197*/
7198/*
7199:- side_effect(assert_lsp(mapl,
7200 lambda_def(defun,
7201 mapl,
7202 f_mapl,
7203 [function, c38_rest, sys_lists],
7204
7205 [
7206 [ let,
7207 [[sys_list_1, [car, sys_lists]]],
7208
7209 [ tagbody,
7210 sys_start,
7211
7212 [ when,
7213 [sys_all_end, sys_lists],
7214 [return_from, mapl, sys_list_1]
7215 ],
7216 [apply, function, sys_lists],
7217
7218 [ setf,
7219 sys_lists,
7220 [sys_all_cdr, sys_lists]
7221 ],
7222 [go, sys_start]
7223 ]
7224 ]
7225 ]))).
7226*/
7227/*
7228:- side_effect(assert_lsp(mapl,
7229 arglist_info(mapl,
7230 f_mapl,
7231 [function, c38_rest, sys_lists],
7232 arginfo{ all:[function],
7233 allow_other_keys:0,
7234 aux:0,
7235 body:0,
7236 complex:[rest],
7237 env:0,
7238 key:0,
7239 names:[function, sys_lists],
7240 opt:0,
7241 req:[function],
7242 rest:[sys_lists],
7243 sublists:0,
7244 whole:0
7245 }))).
7246*/
7247/*
7248:- side_effect(assert_lsp(mapl, init_args(1, f_mapl))).
7249*/
7250/*
7251:- side_effect(assert_lsp(maplist,
7252 lambda_def(defun,
7253 maplist,
7254 f_maplist,
7255 [function, c38_rest, sys_lists],
7256
7257 [
7258 [ let,
7259 [[sys_result, []], [sys_end, []]],
7260
7261 [ tagbody,
7262 sys_start,
7263
7264 [ when,
7265 [sys_all_end, sys_lists],
7266 [return_from, maplist, sys_result]
7267 ],
7268
7269 [ let,
7270
7271 [
7272 [ cons,
7273
7274 [ cons,
7275 [apply, function, sys_lists],
7276 []
7277 ]
7278 ]
7279 ],
7280
7281 [ setf,
7282 sys_end,
7283
7284 [ if,
7285 sys_end,
7286 [setf, [cdr, sys_end], cons],
7287 [setf, sys_result, cons]
7288 ]
7289 ]
7290 ],
7291
7292 [ setf,
7293 sys_lists,
7294 [sys_all_cdr, sys_lists]
7295 ],
7296 [go, sys_start]
7297 ]
7298 ]
7299 ]))).
7300*/
7301/*
7302:- side_effect(assert_lsp(maplist,
7303 arglist_info(maplist,
7304 f_maplist,
7305 [function, c38_rest, sys_lists],
7306 arginfo{ all:[function],
7307 allow_other_keys:0,
7308 aux:0,
7309 body:0,
7310 complex:[rest],
7311 env:0,
7312 key:0,
7313 names:[function, sys_lists],
7314 opt:0,
7315 req:[function],
7316 rest:[sys_lists],
7317 sublists:0,
7318 whole:0
7319 }))).
7320*/
7321/*
7322:- side_effect(assert_lsp(maplist, init_args(1, f_maplist))).
7323*/
7324/*
7325#+(or WAM-CL LISP500)
7326(defun mapcan (function &rest lists)
7327 (apply #'nconc (apply #'mapcar function lists)))
7328
7329*/
7330
7331/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:19122 **********************/
7332:-lisp_compile_to_prolog(pkg_sys,[defun,mapcan,[function,'&rest',lists],[apply,function(nconc),[apply,function(mapcar),function,lists]]])
7333wl:lambda_def(defun, mapcan, f_mapcan, [function, c38_rest, sys_lists], [[apply, function(nconc), [apply, function(mapcar), function, sys_lists]]]).
7334wl:arglist_info(mapcan, f_mapcan, [function, c38_rest, sys_lists], arginfo{all:[function], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[function, sys_lists], opt:0, req:[function], rest:[sys_lists], sublists:0, whole:0}).
7335wl: init_args(1, f_mapcan).
7336
7341f_mapcan(Function_In, RestNKeys, FnResult) :-
7342 GEnv=[bv(function, Function_In), bv(sys_lists, RestNKeys)],
7343 catch(( ( get_var(GEnv, function, Function_Get),
7344 get_var(GEnv, sys_lists, Lists_Get),
7345 f_apply(f_mapcar, [Function_Get, Lists_Get], Nconc_Param),
7346 f_nconc(Nconc_Param, Nconc_Ret)
7347 ),
7348 Nconc_Ret=FnResult
7349 ),
7350 block_exit(mapcan, FnResult),
7351 true).
7352:- set_opv(mapcan, symbol_function, f_mapcan),
7353 DefunResult=mapcan. 7354/*
7355:- side_effect(assert_lsp(mapcan,
7356 lambda_def(defun,
7357 mapcan,
7358 f_mapcan,
7359 [function, c38_rest, sys_lists],
7360
7361 [
7362 [ apply,
7363 function(nconc),
7364
7365 [ apply,
7366 function(mapcar),
7367 function,
7368 sys_lists
7369 ]
7370 ]
7371 ]))).
7372*/
7373/*
7374:- side_effect(assert_lsp(mapcan,
7375 arglist_info(mapcan,
7376 f_mapcan,
7377 [function, c38_rest, sys_lists],
7378 arginfo{ all:[function],
7379 allow_other_keys:0,
7380 aux:0,
7381 body:0,
7382 complex:[rest],
7383 env:0,
7384 key:0,
7385 names:[function, sys_lists],
7386 opt:0,
7387 req:[function],
7388 rest:[sys_lists],
7389 sublists:0,
7390 whole:0
7391 }))).
7392*/
7393/*
7394:- side_effect(assert_lsp(mapcan, init_args(1, f_mapcan))).
7395*/
7396/*
7397#+(or WAM-CL LISP500)
7398(defun mapcon (function &rest lists)
7399 (apply #'nconc (apply #'maplist function lists)))
7400
7401*/
7402
7403/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:19238 **********************/
7404:-lisp_compile_to_prolog(pkg_sys,[defun,mapcon,[function,'&rest',lists],[apply,function(nconc),[apply,function(maplist),function,lists]]])
7405wl:lambda_def(defun, mapcon, f_mapcon, [function, c38_rest, sys_lists], [[apply, function(nconc), [apply, function(maplist), function, sys_lists]]]).
7406wl:arglist_info(mapcon, f_mapcon, [function, c38_rest, sys_lists], arginfo{all:[function], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[function, sys_lists], opt:0, req:[function], rest:[sys_lists], sublists:0, whole:0}).
7407wl: init_args(1, f_mapcon).
7408
7413f_mapcon(Function_In, RestNKeys, FnResult) :-
7414 GEnv=[bv(function, Function_In), bv(sys_lists, RestNKeys)],
7415 catch(( ( get_var(GEnv, function, Function_Get),
7416 get_var(GEnv, sys_lists, Lists_Get),
7417 f_apply(f_maplist, [Function_Get, Lists_Get], Nconc_Param),
7418 f_nconc(Nconc_Param, Nconc_Ret)
7419 ),
7420 Nconc_Ret=FnResult
7421 ),
7422 block_exit(mapcon, FnResult),
7423 true).
7424:- set_opv(mapcon, symbol_function, f_mapcon),
7425 DefunResult=mapcon. 7426/*
7427:- side_effect(assert_lsp(mapcon,
7428 lambda_def(defun,
7429 mapcon,
7430 f_mapcon,
7431 [function, c38_rest, sys_lists],
7432
7433 [
7434 [ apply,
7435 function(nconc),
7436
7437 [ apply,
7438 function(maplist),
7439 function,
7440 sys_lists
7441 ]
7442 ]
7443 ]))).
7444*/
7445/*
7446:- side_effect(assert_lsp(mapcon,
7447 arglist_info(mapcon,
7448 f_mapcon,
7449 [function, c38_rest, sys_lists],
7450 arginfo{ all:[function],
7451 allow_other_keys:0,
7452 aux:0,
7453 body:0,
7454 complex:[rest],
7455 env:0,
7456 key:0,
7457 names:[function, sys_lists],
7458 opt:0,
7459 req:[function],
7460 rest:[sys_lists],
7461 sublists:0,
7462 whole:0
7463 }))).
7464*/
7465/*
7466:- side_effect(assert_lsp(mapcon, init_args(1, f_mapcon))).
7467*/
7468/*
7469#+(or WAM-CL LISP500)
7470(defun acons (key datum alist) (cons (cons key datum) alist))
7471
7472*/
7473
7474/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:19355 **********************/
7475:-lisp_compile_to_prolog(pkg_sys,[defun,acons,[key,datum,alist],[cons,[cons,key,datum],alist]])
7476wl:lambda_def(defun, acons, f_acons, [key, sys_datum, sys_alist], [[cons, [cons, key, sys_datum], sys_alist]]).
7477wl:arglist_info(acons, f_acons, [key, sys_datum, sys_alist], arginfo{all:[key, sys_datum, sys_alist], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[key, sys_datum, sys_alist], opt:0, req:[key, sys_datum, sys_alist], rest:0, sublists:0, whole:0}).
7478wl: init_args(x, f_acons).
7479
7484f_acons(Key_In, Datum_In, Alist_In, FnResult) :-
7485 GEnv=[bv(key, Key_In), bv(sys_datum, Datum_In), bv(sys_alist, Alist_In)],
7486 catch(( ( get_var(GEnv, key, Key_Get),
7487 get_var(GEnv, sys_datum, Datum_Get),
7488 CAR=[Key_Get|Datum_Get],
7489 get_var(GEnv, sys_alist, Alist_Get),
7490 _10522=[CAR|Alist_Get]
7491 ),
7492 _10522=FnResult
7493 ),
7494 block_exit(acons, FnResult),
7495 true).
7496:- set_opv(acons, symbol_function, f_acons),
7497 DefunResult=acons. 7498/*
7499:- side_effect(assert_lsp(acons,
7500 lambda_def(defun,
7501 acons,
7502 f_acons,
7503 [key, sys_datum, sys_alist],
7504 [[cons, [cons, key, sys_datum], sys_alist]]))).
7505*/
7506/*
7507:- side_effect(assert_lsp(acons,
7508 arglist_info(acons,
7509 f_acons,
7510 [key, sys_datum, sys_alist],
7511 arginfo{ all:[key, sys_datum, sys_alist],
7512 allow_other_keys:0,
7513 aux:0,
7514 body:0,
7515 complex:0,
7516 env:0,
7517 key:0,
7518 names:
7519 [ key,
7520 sys_datum,
7521 sys_alist
7522 ],
7523 opt:0,
7524 req:[key, sys_datum, sys_alist],
7525 rest:0,
7526 sublists:0,
7527 whole:0
7528 }))).
7529*/
7530/*
7531:- side_effect(assert_lsp(acons, init_args(x, f_acons))).
7532*/
7533/*
7534#+(or WAM-CL LISP500)
7535(defun copy-alist (alist)
7536 (when alist (cons (if (consp (car alist))
7537 (cons (caar alist) (cdar alist))
7538 (car alist))
7539 (copy-alist (cdr alist)))))
7540
7541*/
7542
7543/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:19444 **********************/
7544:-lisp_compile_to_prolog(pkg_sys,[defun,'copy-alist',[alist],[when,alist,[cons,[if,[consp,[car,alist]],[cons,[caar,alist],[cdar,alist]],[car,alist]],['copy-alist',[cdr,alist]]]]])
7545wl:lambda_def(defun, copy_alist, f_copy_alist, [sys_alist], [[when, sys_alist, [cons, [if, [consp, [car, sys_alist]], [cons, [caar, sys_alist], [cdar, sys_alist]], [car, sys_alist]], [copy_alist, [cdr, sys_alist]]]]]).
7546wl:arglist_info(copy_alist, f_copy_alist, [sys_alist], arginfo{all:[sys_alist], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_alist], opt:0, req:[sys_alist], rest:0, sublists:0, whole:0}).
7547wl: init_args(x, f_copy_alist).
7548
7553f_copy_alist(Alist_In, FnResult) :-
7554 GEnv=[bv(sys_alist, Alist_In)],
7555 catch(( ( get_var(GEnv, sys_alist, IFTEST),
7556 ( IFTEST\==[]
7557 -> get_var(GEnv, sys_alist, Alist_Get9),
7558 f_car(Alist_Get9, PredArgResult),
7559 ( c0nz:is_consp(PredArgResult)
7560 -> get_var(GEnv, sys_alist, Alist_Get12),
7561 f_caar(Alist_Get12, Caar_Ret),
7562 get_var(GEnv, sys_alist, Alist_Get13),
7563 f_cdar(Alist_Get13, Cdar_Ret),
7564 TrueResult=[Caar_Ret|Cdar_Ret],
7565 CAR=TrueResult
7566 ; get_var(GEnv, sys_alist, Alist_Get14),
7567 f_car(Alist_Get14, ElseResult),
7568 CAR=ElseResult
7569 ),
7570 get_var(GEnv, sys_alist, Alist_Get17),
7571 f_cdr(Alist_Get17, Copy_alist_Param),
7572 f_copy_alist(Copy_alist_Param, Copy_alist_Ret),
7573 TrueResult18=[CAR|Copy_alist_Ret],
7574 _7326=TrueResult18
7575 ; _7326=[]
7576 )
7577 ),
7578 _7326=FnResult
7579 ),
7580 block_exit(copy_alist, FnResult),
7581 true).
7582:- set_opv(copy_alist, symbol_function, f_copy_alist),
7583 DefunResult=copy_alist. 7584/*
7585:- side_effect(assert_lsp(copy_alist,
7586 lambda_def(defun,
7587 copy_alist,
7588 f_copy_alist,
7589 [sys_alist],
7590
7591 [
7592 [ when,
7593 sys_alist,
7594
7595 [ cons,
7596
7597 [ if,
7598 [consp, [car, sys_alist]],
7599
7600 [ cons,
7601 [caar, sys_alist],
7602 [cdar, sys_alist]
7603 ],
7604 [car, sys_alist]
7605 ],
7606 [copy_alist, [cdr, sys_alist]]
7607 ]
7608 ]
7609 ]))).
7610*/
7611/*
7612:- side_effect(assert_lsp(copy_alist,
7613 arglist_info(copy_alist,
7614 f_copy_alist,
7615 [sys_alist],
7616 arginfo{ all:[sys_alist],
7617 allow_other_keys:0,
7618 aux:0,
7619 body:0,
7620 complex:0,
7621 env:0,
7622 key:0,
7623 names:[sys_alist],
7624 opt:0,
7625 req:[sys_alist],
7626 rest:0,
7627 sublists:0,
7628 whole:0
7629 }))).
7630*/
7631/*
7632:- side_effect(assert_lsp(copy_alist, init_args(x, f_copy_alist))).
7633*/
7634/*
7635#+(or WAM-CL LISP500)
7636(defun pairlis (keys data &optional alist)
7637 (tagbody
7638 start
7639 (when (and keys data)
7640 (setf alist (acons (car keys) (car data) alist))
7641 (setf keys (cdr keys))
7642 (setf data (cdr data))
7643 (go start)))
7644 alist)
7645
7646
7647
7648*/
7649
7650/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:19631 **********************/
7651:-lisp_compile_to_prolog(pkg_sys,[defun,pairlis,[keys,data,'&optional',alist],[tagbody,start,[when,[and,keys,data],[setf,alist,[acons,[car,keys],[car,data],alist]],[setf,keys,[cdr,keys]],[setf,data,[cdr,data]],[go,start]]],alist])
7652wl:lambda_def(defun,pairlis,f_pairlis,[sys_keys,sys_data,c38_optional,sys_alist],[[tagbody,sys_start,[when,[and,sys_keys,sys_data],[setf,sys_alist,[acons,[car,sys_keys],[car,sys_data],sys_alist]],[setf,sys_keys,[cdr,sys_keys]],[setf,sys_data,[cdr,sys_data]],[go,sys_start]]],sys_alist]).
7653wl:arglist_info(pairlis,f_pairlis,[sys_keys,sys_data,c38_optional,sys_alist],arginfo{all:[sys_keys,sys_data,sys_alist],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[sys_keys,sys_data,sys_alist],opt:[sys_alist],req:[sys_keys,sys_data],rest:0,sublists:0,whole:0}).
7654wl:init_args(2,f_pairlis).
7655
7660f_pairlis(_7622,_7624,_7642,_8590):-_8394=[bv(sys_keys,_7622),bv(sys_data,_7624),bv(sys_alist,_7626)],opt_var(_7574,sys_alist,_7626,true,[],1,_7642),catch(((call_addr_block(_8394,(push_label(sys_start),get_var(_8394,sys_keys,_8100),(_8100\==[]->get_var(_8394,sys_data,_8176),_8058=_8176;_8058=[]),(_8058\==[]->get_var(_8394,sys_keys,_8222),f_car(_8222,_8204),get_var(_8394,sys_data,_8252),f_car(_8252,_8234),get_var(_8394,sys_alist,_8280),f_acons(_8204,_8234,_8280,_8202),set_var(_8394,sys_alist,_8202),get_var(_8394,sys_keys,_8310),f_cdr(_8310,_8292),set_var(_8394,sys_keys,_8292),get_var(_8394,sys_data,_8340),f_cdr(_8340,_8322),set_var(_8394,sys_data,_8322),goto(sys_start,_8394),_7690=_8368;_7690=[])),[addr(addr_tagbody_51_sys_start,sys_start,'$unused',_8420,(get_var(_8420,sys_keys,_8424),(_8424\==[]->get_var(_8420,sys_data,_8438),_8452=_8438;_8452=[]),(_8452\==[]->get_var(_8420,sys_keys,_8466),f_car(_8466,_11142),get_var(_8420,sys_data,_8482),f_car(_8482,_11180),get_var(_8420,sys_alist,_8496),f_acons(_11142,_11180,_8496,_8498),set_var(_8420,sys_alist,_8498),get_var(_8420,sys_keys,_8502),f_cdr(_8502,_8514),set_var(_8420,sys_keys,_8514),get_var(_8420,sys_data,_8518),f_cdr(_8518,_11242),set_var(_8420,sys_data,_11242),goto(sys_start,_8420),_8532=_8536;_8532=[])))]),get_var(_8394,sys_alist,_8564)),_8564=_8590),block_exit(pairlis,_8590),true).
7661:-set_opv(pairlis,symbol_function,f_pairlis),_7030=pairlis. 7662/*
7663:-side_effect(assert_lsp(pairlis,lambda_def(defun,pairlis,f_pairlis,[sys_keys,sys_data,c38_optional,sys_alist],[[tagbody,sys_start,[when,[and,sys_keys,sys_data],[setf,sys_alist,[acons,[car,sys_keys],[car,sys_data],sys_alist]],[setf,sys_keys,[cdr,sys_keys]],[setf,sys_data,[cdr,sys_data]],[go,sys_start]]],sys_alist]))).
7664*/
7665/*
7666:-side_effect(assert_lsp(pairlis,arglist_info(pairlis,f_pairlis,[sys_keys,sys_data,c38_optional,sys_alist],arginfo{all:[sys_keys,sys_data,sys_alist],allow_other_keys:0,aux:0,body:0,complex:0,env:0,key:0,names:[sys_keys,sys_data,sys_alist],opt:[sys_alist],req:[sys_keys,sys_data],rest:0,sublists:0,whole:0}))).
7667*/
7668/*
7669:-side_effect(assert_lsp(pairlis,init_args(2,f_pairlis))).
7670*/
7671/*
7672#+(or WAM-CL LISP500)
7673(defun some-list-2 (predicate list1 list2)
7674 (tagbody
7675 start
7676 (when (and list1 list2)
7677 (when (funcall predicate (car list1) (car list2))
7678 (return-from some-list-2 t))
7679 (pop list1)
7680 (pop list2)
7681 (go start))))
7682
7683
7684*/
7685
7686/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:19905 **********************/
7687:-lisp_compile_to_prolog(pkg_sys,[defun,'some-list-2',[predicate,list1,list2],[tagbody,start,[when,[and,list1,list2],[when,[funcall,predicate,[car,list1],[car,list2]],['return-from','some-list-2',t]],[pop,list1],[pop,list2],[go,start]]]])
7688/*
7689:- side_effect(generate_function_or_macro_name(
7690 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
7691 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
7692 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
7693 fbound(sys_expand, kw_function)=function(f_sys_expand11),
7694 name='GLOBAL',
7695 environ=env_1
7696 ],
7697 sys_some_list_2,
7698 kw_function,
7699 f_sys_some_list_2)).
7700*/
7701/*
7702% macroexpand:-[pop,sys_list1].
7703*/
7704/*
7705% into:-[prog1,[car,sys_list1],[setq,sys_list1,[cdr,sys_list1]]].
7706*/
7707/*
7708% macroexpand:-[pop,sys_list2].
7709*/
7710/*
7711% into:-[prog1,[car,sys_list2],[setq,sys_list2,[cdr,sys_list2]]].
7712*/
7713/*
7714% macroexpand:-[pop,sys_list1].
7715*/
7716/*
7717% into:-[prog1,[car,sys_list1],[setq,sys_list1,[cdr,sys_list1]]].
7718*/
7719/*
7720% macroexpand:-[pop,sys_list2].
7721*/
7722/*
7723% into:-[prog1,[car,sys_list2],[setq,sys_list2,[cdr,sys_list2]]].
7724*/
7725wl:lambda_def(defun, sys_some_list_2, f_sys_some_list_2, [sys_predicate, sys_list1, sys_list2], [[tagbody, sys_start, [when, [and, sys_list1, sys_list2], [when, [funcall, sys_predicate, [car, sys_list1], [car, sys_list2]], [return_from, sys_some_list_2, t]], [pop, sys_list1], [pop, sys_list2], [go, sys_start]]]]).
7726wl:arglist_info(sys_some_list_2, f_sys_some_list_2, [sys_predicate, sys_list1, sys_list2], arginfo{all:[sys_predicate, sys_list1, sys_list2], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_predicate, sys_list1, sys_list2], opt:0, req:[sys_predicate, sys_list1, sys_list2], rest:0, sublists:0, whole:0}).
7727wl: init_args(x, f_sys_some_list_2).
7728
7733f_sys_some_list_2(Predicate_In, List1_In, List2_In, FnResult) :-
7734 AEnv=[bv(sys_predicate, Predicate_In), bv(sys_list1, List1_In), bv(sys_list2, List2_In)],
7735 catch(( call_addr_block(AEnv,
7736 (push_label(sys_start), get_var(AEnv, sys_list1, IFTEST35), (IFTEST35\==[]->get_var(AEnv, sys_list2, List2_Get38), IFTEST33=List2_Get38;IFTEST33=[]), (IFTEST33\==[]->get_var(AEnv, sys_list1, List1_Get43), get_var(AEnv, sys_predicate, Predicate_Get42), f_car(List1_Get43, Car_Ret), get_var(AEnv, sys_list2, List2_Get44), f_car(List2_Get44, Car_Ret63), f_apply(Predicate_Get42, [Car_Ret, Car_Ret63], IFTEST40), (IFTEST40\==[]->throw(block_exit(sys_some_list_2, t)), _8232=ThrowResult46;_8232=[]), get_var(AEnv, sys_list1, List1_Get49), f_car(List1_Get49, Car_Ret64), get_var(AEnv, sys_list1, List1_Get51), f_cdr(List1_Get51, List1), set_var(AEnv, sys_list1, List1), get_var(AEnv, sys_list2, List2_Get52), f_car(List2_Get52, Car_Ret65), get_var(AEnv, sys_list2, List2_Get53), f_cdr(List2_Get53, List2), set_var(AEnv, sys_list2, List2), goto(sys_start, AEnv), _TBResult=_GORES54;_TBResult=[])),
7737
7738 [ addr(addr_tagbody_52_sys_start,
7739 sys_start,
7740 '$unused',
7741 AEnv,
7742 (get_var(AEnv, sys_list1, IFTEST10), (IFTEST10\==[]->get_var(AEnv, sys_list2, List2_Get), IFTEST=List2_Get;IFTEST=[]), (IFTEST\==[]->get_var(AEnv, sys_list1, List1_Get18), get_var(AEnv, sys_predicate, Apply_Param), f_car(List1_Get18, Car_Ret66), get_var(AEnv, sys_list2, List2_Get19), f_car(List2_Get19, Car_Ret67), f_apply(Apply_Param, [Car_Ret66, Car_Ret67], IFTEST15), (IFTEST15\==[]->throw(block_exit(sys_some_list_2, t)), _8766=ThrowResult;_8766=[]), get_var(AEnv, sys_list1, List1_Get24), f_car(List1_Get24, Car_Ret68), get_var(AEnv, sys_list1, List1_Get26), f_cdr(List1_Get26, Cdr_Ret), set_var(AEnv, sys_list1, Cdr_Ret), get_var(AEnv, sys_list2, List2_Get27), f_car(List2_Get27, Car_Ret70), get_var(AEnv, sys_list2, List2_Get28), f_cdr(List2_Get28, Cdr_Ret71), set_var(AEnv, sys_list2, Cdr_Ret71), goto(sys_start, AEnv), _8846=_GORES;_8846=[])))
7743 ]),
7744 []=FnResult
7745 ),
7746 block_exit(sys_some_list_2, FnResult),
7747 true).
7748:- set_opv(sys_some_list_2, symbol_function, f_sys_some_list_2),
7749 DefunResult=sys_some_list_2. 7750/*
7751:- side_effect(assert_lsp(sys_some_list_2,
7752 lambda_def(defun,
7753 sys_some_list_2,
7754 f_sys_some_list_2,
7755 [sys_predicate, sys_list1, sys_list2],
7756
7757 [
7758 [ tagbody,
7759 sys_start,
7760
7761 [ when,
7762 [and, sys_list1, sys_list2],
7763
7764 [ when,
7765
7766 [ funcall,
7767 sys_predicate,
7768 [car, sys_list1],
7769 [car, sys_list2]
7770 ],
7771 [return_from, sys_some_list_2, t]
7772 ],
7773 [pop, sys_list1],
7774 [pop, sys_list2],
7775 [go, sys_start]
7776 ]
7777 ]
7778 ]))).
7779*/
7780/*
7781:- side_effect(assert_lsp(sys_some_list_2,
7782 arglist_info(sys_some_list_2,
7783 f_sys_some_list_2,
7784 [sys_predicate, sys_list1, sys_list2],
7785 arginfo{ all:
7786 [ sys_predicate,
7787 sys_list1,
7788 sys_list2
7789 ],
7790 allow_other_keys:0,
7791 aux:0,
7792 body:0,
7793 complex:0,
7794 env:0,
7795 key:0,
7796 names:
7797 [ sys_predicate,
7798 sys_list1,
7799 sys_list2
7800 ],
7801 opt:0,
7802 req:
7803 [ sys_predicate,
7804 sys_list1,
7805 sys_list2
7806 ],
7807 rest:0,
7808 sublists:0,
7809 whole:0
7810 }))).
7811*/
7812/*
7813:- side_effect(assert_lsp(sys_some_list_2, init_args(x, f_sys_some_list_2))).
7814*/
7815/*
7816(flet
7817 ((satisfies (object elem &key key test test-not)
7818 (let* ((zi (if key (funcall key elem) elem))
7819 (r (funcall (or test test-not #'eql) object zi)))
7820 (if test-not (not r) r)))
7821
7822 (satisfies-if (predicate elem &key key)
7823 (funcall predicate (if key (funcall key elem) elem)))
7824 (satisfies-if-not (predicate elem &key key)
7825 (not (funcall predicate (if key (funcall key elem) elem))))
7826 (seq-start (sequence &key (start 0) end from-end)
7827 (if (listp sequence)
7828 (if from-end
7829 (let ((acc nil)
7830 (sequence (nthcdr start sequence)))
7831 (tagbody
7832 start
7833 (when (and sequence (or (not end) (< start end)))
7834 (push sequence acc)
7835 (setf sequence (cdr sequence))
7836 (setf start (+ 1 start))
7837 (go start)))
7838 (list 3 acc start))
7839 (list 2 (nthcdr start sequence) start))
7840 (if from-end (cons 1 (- end 1)) (cons 0 start))))
7841 (seq-position (iter)
7842 (case (car iter)
7843 ((0 1) (cdr iter))
7844 (t (caddr iter))))
7845 (seq-next (iter)
7846 (case (car iter)
7847 (0 (setf (cdr iter) (+ 1 (cdr iter))))
7848 (1 (setf (cdr iter) (- (cdr iter) 1)))
7849 (2 (setf (cadr iter) (cdadr iter))
7850 (setf (caddr iter) (+ 1 (caddr iter))))
7851 (t (setf (cadr iter) (cdadr iter))
7852 (setf (caddr iter) (- (caddr iter) 1)))))
7853 (seq-ref (sequence iter)
7854 (case (car iter)
7855 ((0 1) (aref sequence (cdr iter)))
7856 (2 (caadr iter))
7857 (t (caaadr iter))))
7858 (seq-set (sequence iter value)
7859 (case (car iter)
7860 ((0 1) (setf (aref sequence (cdr iter)) value))
7861 (2 (setf (caadr iter) value))
7862 (t (setf (caaadr iter) value))))
7863 (seq-end-p (sequence iter &key start end from-end)
7864 (case (car iter)
7865 (0 (or (= (cdr iter) (length sequence))
7866 (and end (= end (cdr iter)))))
7867 (1 (< (cdr iter) start))
7868 (2 (or (null (cadr iter)) (and end (= end (caddr iter)))))
7869 (t (or (null (cadr iter)) (< (caddr iter) start)))))
7870 (seq-result (sequence iter result)
7871 (case (car iter)
7872 (0 (make-array (length result)
7873 :element-type (array-element-type sequence)
7874 :initial-contents (reverse result)))
7875 (1 (make-array (length result)
7876 :element-type (array-element-type sequence)
7877 :initial-contents result))
7878 (2 (reverse result))
7879 (3 result))))
7880
7881
7882
7883#+BUILTIN
7884 (defun member (item list &rest rest)
7885 (tagbody
7886 start
7887 (when list
7888 (when (apply #'satisfies item (car list) rest)
7889 (return-from member list))
7890 (setf list (cdr list))
7891 (go start))))
7892
7893
7894#+BUILTIN
7895 (defun member-if (predicate list &rest rest)
7896 (tagbody
7897 start
7898 (when list
7899 (when (apply #'satisfies-if predicate (car list) rest)
7900 (return-from member-if list))
7901 (setf list (cdr list))
7902 (go start))))
7903
7904#+BUILTIN
7905 (defun member-if-not (predicate list &rest rest)
7906 (tagbody
7907 start
7908 (when list
7909 (when (apply #'satisfies-if-not predicate (car list) rest)
7910 (return-from member-if list))
7911 (setf list (cdr list))
7912 (go start))))
7913 (defun subst (new old tree &rest rest)
7914 (if (consp tree)
7915 (let ((a (apply #'subst new old (car tree) rest))
7916 (d (apply #'subst new old (cdr tree) rest)))
7917 (if (and (eq a (car tree)) (eq d (cdr tree)))
7918 tree
7919 (cons a d)))
7920 (if (apply #'satisfies old tree rest) new tree)))
7921 (defun subst-if (new predicate tree &rest rest)
7922 (if (consp tree)
7923 (let ((a (apply #'subst new predicate (car tree) rest))
7924 (d (apply #'subst new predicate (cdr tree) rest)))
7925 (if (and (eq a (car tree)) (eq d (cdr tree)))
7926 tree
7927 (cons a d)))
7928 (if (apply #'satisfies-if predicate tree rest) new tree)))
7929 (defun subst-if-not (new predicate tree &rest rest)
7930 (if (consp tree)
7931 (let ((a (apply #'subst new predicate (car tree) rest))
7932 (d (apply #'subst new predicate (cdr tree) rest)))
7933 (if (and (eq a (car tree)) (eq d (cdr tree)))
7934 tree
7935 (cons a d)))
7936 (if (apply #'satisfies-if-not predicate tree rest) new tree)))
7937 (defun nsubst (new old tree &rest rest)
7938 (if (consp tree)
7939 (progn
7940 (setf (car tree) (apply #'subst new old (car tree) rest))
7941 (setf (cdr tree) (apply #'subst new old (cdr tree) rest))
7942 tree)
7943 (if (apply #'satisfies old tree rest) new tree)))
7944 (defun nsubst-if (new predicate tree &rest rest)
7945 (if (consp tree)
7946 (progn
7947 (setf (car tree) (apply #'subst new predicate (car tree) rest))
7948 (setf (cdr tree) (apply #'subst new predicate (cdr tree) rest))
7949 tree)
7950 (if (apply #'satisfies-if predicate tree rest) new tree)))
7951 (defun nsubst-if-not (new predicate tree &rest rest)
7952 (if (consp tree)
7953 (progn
7954 (setf (car tree) (apply #'subst new predicate (car tree) rest))
7955 (setf (cdr tree) (apply #'subst new predicate (cdr tree) rest))
7956 tree)
7957 (if (apply #'satisfies-if-not predicate tree rest) new tree)))
7958
7959#+BUILTIN
7960 (defun assoc (item alist &rest rest)
7961 (dolist (elem alist)
7962 (when (apply #'satisfies item (car elem) rest)
7963 (return-from assoc elem))))
7964 (defun assoc-if (predicate alist &rest rest)
7965 (dolist (elem alist)
7966 (when (apply #'satisfies-if predicate (car elem) rest)
7967 (return-from assoc-if elem))))
7968 (defun assoc-if-not (predicate alist &rest rest)
7969 (dolist (elem alist)
7970 (when (apply #'satisfies-if-not predicate (car elem) rest)
7971 (return-from assoc-if-not elem))))
7972 (defun rassoc (item alist &rest rest)
7973 (dolist (elem alist)
7974 (when (apply #'satisfies item (cdr elem) rest)
7975 (return-from rassoc elem))))
7976 (defun rassoc-if (predicate alist &rest rest)
7977 (dolist (elem alist)
7978 (when (apply #'satisfies-if predicate (cdr elem) rest)
7979 (return-from rassoc-if elem))))
7980 (defun rassoc-if-not (predicate alist &rest rest)
7981 (dolist (elem alist)
7982 (when (apply #'satisfies-if-not predicate (cdr elem) rest)
7983 (return-from rassoc-if-not elem))))
7984 (defun adjoin (item list &rest rest)
7985 (dolist (elem list (cons item list))
7986 (when (apply #'satisfies item elem rest)
7987 (return-from adjoin list))))
7988 (defun set-exclusive-or (list-1 list-2 &rest rest &key key)
7989 (let ((result nil))
7990 (dolist (item list-1)
7991 (unless (apply #'member (if key (funcall key item) item) list-2 rest)
7992 (push item result)))
7993 (dolist (item list-2)
7994 (block matches
7995 (dolist (elem list-1)
7996 (when (apply #'satisfies
7997 (if key (funcall key elem) elem) item rest)
7998 (return-from matches)))
7999 (push item result)))
8000 result))
8001 (defun nset-exclusive-or (list-1 list-2 &rest rest &key key)
8002 (let ((result nil)
8003 (list nil)
8004 (item nil))
8005 (tagbody
8006 start-1
8007 (unless list-1 (go start-2))
8008 (setf item (car list-1))
8009 (setf list list-2)
8010 (setf prev nil)
8011 start-1-in
8012 (unless list (go end-1-in))
8013 (let ((elem (if key (funcall key (car list)) (car list))))
8014 (when (apply #'satisfies item (if key (funcall key elem) elem) rest)
8015 (if prev
8016 (setf (cdr prev) (cdr list))
8017 (setf list-2 (cdr list)))
8018 (setf list-1 (cdr list-1))
8019 (go start-1)))
8020 (setf prev list)
8021 (setf list (cdr list))
8022 (go start-1-in)
8023 end-1-in
8024 (setf item (cdr list-1))
8025 (setf (cdr list-1) result)
8026 (unless result (setf end list-1))
8027 (setf result list-1)
8028 (setf list-1 item)
8029 (go start-1)
8030 start-2
8031 (return-from nset-exclusive-or
8032 (if end (progn (setf (cdr end) list-2) result) list-2)))))
8033 (defun fill (sequence item &rest rest)
8034 (let ((iter (apply #'seq-start sequence rest)))
8035 (tagbody
8036 start
8037 (unless (apply #'seq-end-p sequence iter rest)
8038 (seq-set sequence iter item)
8039 (seq-next iter)
8040 (go start))))
8041 sequence)
8042 (defun every (predicate &rest sequences)
8043 (let ((iters (mapcar #'seq-start sequences)))
8044 (tagbody
8045 start
8046 (unless (some-list-2 #'seq-end-p sequences iters)
8047 (unless (apply predicate (mapcar #'seq-ref sequences iters))
8048 (return-from every nil))
8049 (mapc #'seq-next iters)
8050 (go start))))
8051 t)
8052 (defun some (predicate &rest sequences)
8053 (let ((iters (mapcar #'seq-start sequences)))
8054 (tagbody
8055 start
8056 (unless (some-list-2 #'seq-end-p sequences iters)
8057 (let ((result (apply predicate (mapcar #'seq-ref sequences iters))))
8058 (when result (return-from some result)))
8059 (mapc #'seq-next iters)
8060 (go start)))))
8061 (defun notevery (predicate &rest sequences)
8062 (let ((iters (mapcar #'seq-start sequences)))
8063 (tagbody
8064 start
8065 (unless (some-list-2 #'seq-end-p sequences iters)
8066 (unless (apply predicate (mapcar #'seq-ref sequences iters))
8067 (return-from every t))
8068 (mapc #'seq-next iters)
8069 (go start)))))
8070 (defun notany (predicate &rest sequences)
8071 (let ((iters (mapcar #'seq-start sequences)))
8072 (tagbody
8073 start
8074 (unless (some-list-2 #'seq-end-p sequences iters)
8075 (when (apply predicate (mapcar #'seq-ref sequences iters))
8076 (return-from every nil))
8077 (mapc #'seq-next iters)
8078 (go start))))
8079 t)
8080#+(BUILTIN BORKEN)
8081 (defun map-into (result-sequence function &rest sequences)
8082 (let ((result-iter (seq-start result-sequence))
8083 (iters (mapcar #'seq-start sequences)))
8084 (tagbody
8085 start
8086 (unless (some-list-2 #'seq-end-p sequences iters)
8087 (seq-set result-sequence result-iter
8088 (apply function (mapcar #'seq-ref sequences iters)))
8089 (seq-next result-iter)
8090 (mapc #'seq-next iters)
8091 (go start))))
8092 result-sequence)
8093#+(BUILTIN BORKEN)
8094 (defun reduce (function sequence &rest rest)
8095 (let ((iter (apply #'seq-start sequence rest)))
8096 (if (apply #'seq-end-p sequence iter rest)
8097 (funcall function)
8098 (let ((elem (seq-ref sequence iter)))
8099 (seq-next iter)
8100 (unless (apply #'seq-end-p sequence iter rest)
8101 (tagbody
8102 start
8103 (setq elem (funcall function elem (seq-ref sequence iter)))
8104 (seq-next iter)
8105 (unless (apply #'seq-end-p sequence iter rest)
8106 (go start))))
8107 elem))))
8108 (defun count (item sequence &rest rest)
8109 (let ((iter (apply #'seq-start sequence rest))
8110 (count 0))
8111 (tagbody
8112 start
8113 (unless (apply #'seq-end-p sequence iter rest)
8114 (when (apply #'satisfies item (seq-ref sequence iter) rest)
8115 (setf count (+ 1 count)))
8116 (seq-next iter)
8117 (go start)))
8118 count))
8119 (defun count-if (predicate sequence &rest rest)
8120 (let ((iter (apply #'seq-start sequence rest))
8121 (count 0))
8122 (tagbody
8123 start
8124 (unless (apply #'seq-end-p sequence iter rest)
8125 (when (apply #'satisfies-if predicate (seq-ref sequence iter) rest)
8126 (setf count (+ 1 count)))
8127 (seq-next iter)
8128 (go start)))
8129 count))
8130 (defun count-if-not (predicate sequence &rest rest)
8131 (let ((iter (apply #'seq-start sequence rest))
8132 (count 0))
8133 (tagbody
8134 start
8135 (unless (apply #'seq-end-p sequence iter rest)
8136 (when (apply #'satisfies-if-not predicate (seq-ref sequence iter)
8137 rest)
8138 (setf count (+ 1 count)))
8139 (seq-next iter)
8140 (go start)))
8141 count))
8142
8143#+BUILTIN
8144 (defun find (item sequence &rest rest)
8145 (let ((iter (apply #'seq-start sequence rest)))
8146 (tagbody
8147 start
8148 (unless (apply #'seq-end-p sequence iter rest)
8149 (let ((elem (seq-ref sequence iter)))
8150 (when (apply #'satisfies item elem rest)
8151 (return-from find elem)))
8152 (seq-next iter)
8153 (go start)))))
8154
8155#+BUILTIN
8156 (defun find-if (predicate sequence &rest rest)
8157 (let ((iter (apply #'seq-start sequence rest)))
8158 (tagbody
8159 start
8160 (unless (apply #'seq-end-p sequence iter rest)
8161 (let ((elem (seq-ref sequence iter)))
8162 (when (apply #'satisfies-if predicate elem rest)
8163 (return-from find-if elem)))
8164 (seq-next iter)
8165 (go start)))))
8166
8167#+BUILTIN
8168 (defun find-if-not (predicate sequence &rest rest)
8169 (let ((iter (apply #'seq-start sequence rest)))
8170 (tagbody
8171 start
8172 (unless (apply #'seq-end-p sequence iter rest)
8173 (let ((elem (seq-ref sequence iter)))
8174 (when (apply #'satisfies-if-not predicate elem rest)
8175 (return-from find-if-not elem)))
8176 (seq-next iter)
8177 (go start)))))
8178
8179#+BUILTIN
8180 (defun position (item sequence &rest rest)
8181 (let ((iter (apply #'seq-start sequence rest)))
8182 (tagbody
8183 start
8184 (unless (apply #'seq-end-p sequence iter rest)
8185 (when (apply #'satisfies item (seq-ref sequence iter) rest)
8186 (return-from position (seq-position iter)))
8187 (seq-next iter)
8188 (go start)))))
8189
8190#+BUILTIN
8191 (defun position-if (predicate sequence &rest rest)
8192 (let ((iter (apply #'seq-start sequence rest)))
8193 (tagbody
8194 start
8195 (unless (apply #'seq-end-p sequence iter rest)
8196 (when (apply #'satisfies-if predicate (seq-ref sequence iter) rest)
8197 (return-from position-if (seq-position iter)))
8198 (seq-next iter)
8199 (go start)))))
8200
8201#+BUILTIN
8202 (defun position-if-not (predicate sequence &rest rest)
8203 (let ((iter (apply #'seq-start sequence rest)))
8204 (tagbody
8205 start
8206 (unless (apply #'seq-end-p sequence iter rest)
8207 (when (apply #'satisfies-if-not predicate (seq-ref sequence iter)
8208 rest)
8209 (return-from position-if-not (seq-position iter)))
8210 (seq-next iter)
8211 (go start)))))
8212 (defun remove (item sequence &rest rest &key count)
8213 (let ((iter (apply #'seq-start sequence rest))
8214 (result nil))
8215 (tagbody
8216 start
8217 (unless (apply #'seq-end-p sequence iter rest)
8218 (let ((elem (seq-ref sequence iter)))
8219 (unless (and (apply #'satisfies item elem rest)
8220 (or (not count) (not (minusp (decf count)))))
8221 (push elem result)))
8222 (seq-next iter)
8223 (go start)))
8224 (seq-result sequence iter result)))
8225 (defun remove-if (predicate sequence &rest rest &key count)
8226 (let ((iter (apply #'seq-start sequence rest))
8227 (result nil))
8228 (tagbody
8229 start
8230 (unless (apply #'seq-end-p sequence iter rest)
8231 (let ((elem (seq-ref sequence iter)))
8232 (unless (and (apply #'satisfies-if predicate elem rest)
8233 (or (not count) (not (minusp (decf count)))))
8234 (push elem result)))
8235 (seq-next iter)
8236 (go start)))
8237 (seq-result sequence iter result)))
8238 (defun remove-if-not (predicate sequence &rest rest &key count)
8239 (let ((iter (apply #'seq-start sequence rest))
8240 (result nil))
8241 (tagbody
8242 start
8243 (unless (apply #'seq-end-p sequence iter rest)
8244 (let ((elem (seq-ref sequence iter)))
8245 (unless (and (apply #'satisfies-if-not predicate elem rest)
8246 (or (not count) (not (minusp (decf count)))))
8247 (push elem result)))
8248 (seq-next iter)
8249 (go start)))
8250 (seq-result sequence iter result)))
8251)
8252
8253
8254*/
8255
8256/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:20181 **********************/
8257:-lisp_compile_to_prolog(pkg_sys,[flet,[[satisfies,[object,elem,'&key',key,test,'test-not'],['let*',[[zi,[if,key,[funcall,key,elem],elem]],[r,[funcall,[or,test,'test-not',function(eql)],object,zi]]],[if,'test-not',[not,r],r]]],['satisfies-if',[predicate,elem,'&key',key],[funcall,predicate,[if,key,[funcall,key,elem],elem]]],['satisfies-if-not',[predicate,elem,'&key',key],[not,[funcall,predicate,[if,key,[funcall,key,elem],elem]]]],['seq-start',[sequence,'&key',[start,0],end,'from-end'],[if,[listp,sequence],[if,'from-end',[let,[[acc,[]],[sequence,[nthcdr,start,sequence]]],[tagbody,start,[when,[and,sequence,[or,[not,end],[<,start,end]]],[push,sequence,acc],[setf,sequence,[cdr,sequence]],[setf,start,[+,1,start]],[go,start]]],[list,3,acc,start]],[list,2,[nthcdr,start,sequence],start]],[if,'from-end',[cons,1,[-,end,1]],[cons,0,start]]]],['seq-position',[iter],[case,[car,iter],[[0,1],[cdr,iter]],[t,[caddr,iter]]]],['seq-next',[iter],[case,[car,iter],[0,[setf,[cdr,iter],[+,1,[cdr,iter]]]],[1,[setf,[cdr,iter],[-,[cdr,iter],1]]],[2,[setf,[cadr,iter],[cdadr,iter]],[setf,[caddr,iter],[+,1,[caddr,iter]]]],[t,[setf,[cadr,iter],[cdadr,iter]],[setf,[caddr,iter],[-,[caddr,iter],1]]]]],['seq-ref',[sequence,iter],[case,[car,iter],[[0,1],[aref,sequence,[cdr,iter]]],[2,[caadr,iter]],[t,[caaadr,iter]]]],['seq-set',[sequence,iter,value],[case,[car,iter],[[0,1],[setf,[aref,sequence,[cdr,iter]],value]],[2,[setf,[caadr,iter],value]],[t,[setf,[caaadr,iter],value]]]],['seq-end-p',[sequence,iter,'&key',start,end,'from-end'],[case,[car,iter],[0,[or,[=,[cdr,iter],[length,sequence]],[and,end,[=,end,[cdr,iter]]]]],[1,[<,[cdr,iter],start]],[2,[or,[null,[cadr,iter]],[and,end,[=,end,[caddr,iter]]]]],[t,[or,[null,[cadr,iter]],[<,[caddr,iter],start]]]]],['seq-result',[sequence,iter,result],[case,[car,iter],[0,['make-array',[length,result],':element-type',['array-element-type',sequence],':initial-contents',[reverse,result]]],[1,['make-array',[length,result],':element-type',['array-element-type',sequence],':initial-contents',result]],[2,[reverse,result]],[3,result]]]],[defun,subst,[new,old,tree,'&rest',rest],[if,[consp,tree],[let,[[a,[apply,function(subst),new,old,[car,tree],rest]],[d,[apply,function(subst),new,old,[cdr,tree],rest]]],[if,[and,[eq,a,[car,tree]],[eq,d,[cdr,tree]]],tree,[cons,a,d]]],[if,[apply,function(satisfies),old,tree,rest],new,tree]]],[defun,'subst-if',[new,predicate,tree,'&rest',rest],[if,[consp,tree],[let,[[a,[apply,function(subst),new,predicate,[car,tree],rest]],[d,[apply,function(subst),new,predicate,[cdr,tree],rest]]],[if,[and,[eq,a,[car,tree]],[eq,d,[cdr,tree]]],tree,[cons,a,d]]],[if,[apply,function('satisfies-if'),predicate,tree,rest],new,tree]]],[defun,'subst-if-not',[new,predicate,tree,'&rest',rest],[if,[consp,tree],[let,[[a,[apply,function(subst),new,predicate,[car,tree],rest]],[d,[apply,function(subst),new,predicate,[cdr,tree],rest]]],[if,[and,[eq,a,[car,tree]],[eq,d,[cdr,tree]]],tree,[cons,a,d]]],[if,[apply,function('satisfies-if-not'),predicate,tree,rest],new,tree]]],[defun,nsubst,[new,old,tree,'&rest',rest],[if,[consp,tree],[progn,[setf,[car,tree],[apply,function(subst),new,old,[car,tree],rest]],[setf,[cdr,tree],[apply,function(subst),new,old,[cdr,tree],rest]],tree],[if,[apply,function(satisfies),old,tree,rest],new,tree]]],[defun,'nsubst-if',[new,predicate,tree,'&rest',rest],[if,[consp,tree],[progn,[setf,[car,tree],[apply,function(subst),new,predicate,[car,tree],rest]],[setf,[cdr,tree],[apply,function(subst),new,predicate,[cdr,tree],rest]],tree],[if,[apply,function('satisfies-if'),predicate,tree,rest],new,tree]]],[defun,'nsubst-if-not',[new,predicate,tree,'&rest',rest],[if,[consp,tree],[progn,[setf,[car,tree],[apply,function(subst),new,predicate,[car,tree],rest]],[setf,[cdr,tree],[apply,function(subst),new,predicate,[cdr,tree],rest]],tree],[if,[apply,function('satisfies-if-not'),predicate,tree,rest],new,tree]]],[defun,'assoc-if',[predicate,alist,'&rest',rest],[dolist,[elem,alist],[when,[apply,function('satisfies-if'),predicate,[car,elem],rest],['return-from','assoc-if',elem]]]],[defun,'assoc-if-not',[predicate,alist,'&rest',rest],[dolist,[elem,alist],[when,[apply,function('satisfies-if-not'),predicate,[car,elem],rest],['return-from','assoc-if-not',elem]]]],[defun,rassoc,[item,alist,'&rest',rest],[dolist,[elem,alist],[when,[apply,function(satisfies),item,[cdr,elem],rest],['return-from',rassoc,elem]]]],[defun,'rassoc-if',[predicate,alist,'&rest',rest],[dolist,[elem,alist],[when,[apply,function('satisfies-if'),predicate,[cdr,elem],rest],['return-from','rassoc-if',elem]]]],[defun,'rassoc-if-not',[predicate,alist,'&rest',rest],[dolist,[elem,alist],[when,[apply,function('satisfies-if-not'),predicate,[cdr,elem],rest],['return-from','rassoc-if-not',elem]]]],[defun,adjoin,[item,list,'&rest',rest],[dolist,[elem,list,[cons,item,list]],[when,[apply,function(satisfies),item,elem,rest],['return-from',adjoin,list]]]],[defun,'set-exclusive-or',['list-1','list-2','&rest',rest,'&key',key],[let,[[result,[]]],[dolist,[item,'list-1'],[unless,[apply,function(member),[if,key,[funcall,key,item],item],'list-2',rest],[push,item,result]]],[dolist,[item,'list-2'],[block,matches,[dolist,[elem,'list-1'],[when,[apply,function(satisfies),[if,key,[funcall,key,elem],elem],item,rest],['return-from',matches]]],[push,item,result]]],result]],[defun,'nset-exclusive-or',['list-1','list-2','&rest',rest,'&key',key],[let,[[result,[]],[list,[]],[item,[]]],[tagbody,'start-1',[unless,'list-1',[go,'start-2']],[setf,item,[car,'list-1']],[setf,list,'list-2'],[setf,prev,[]],'start-1-in',[unless,list,[go,'end-1-in']],[let,[[elem,[if,key,[funcall,key,[car,list]],[car,list]]]],[when,[apply,function(satisfies),item,[if,key,[funcall,key,elem],elem],rest],[if,prev,[setf,[cdr,prev],[cdr,list]],[setf,'list-2',[cdr,list]]],[setf,'list-1',[cdr,'list-1']],[go,'start-1']]],[setf,prev,list],[setf,list,[cdr,list]],[go,'start-1-in'],'end-1-in',[setf,item,[cdr,'list-1']],[setf,[cdr,'list-1'],result],[unless,result,[setf,end,'list-1']],[setf,result,'list-1'],[setf,'list-1',item],[go,'start-1'],'start-2',['return-from','nset-exclusive-or',[if,end,[progn,[setf,[cdr,end],'list-2'],result],'list-2']]]]],[defun,fill,[sequence,item,'&rest',rest],[let,[[iter,[apply,function('seq-start'),sequence,rest]]],[tagbody,start,[unless,[apply,function('seq-end-p'),sequence,iter,rest],['seq-set',sequence,iter,item],['seq-next',iter],[go,start]]]],sequence],[defun,every,[predicate,'&rest',sequences],[let,[[iters,[mapcar,function('seq-start'),sequences]]],[tagbody,start,[unless,['some-list-2',function('seq-end-p'),sequences,iters],[unless,[apply,predicate,[mapcar,function('seq-ref'),sequences,iters]],['return-from',every,[]]],[mapc,function('seq-next'),iters],[go,start]]]],t],[defun,some,[predicate,'&rest',sequences],[let,[[iters,[mapcar,function('seq-start'),sequences]]],[tagbody,start,[unless,['some-list-2',function('seq-end-p'),sequences,iters],[let,[[result,[apply,predicate,[mapcar,function('seq-ref'),sequences,iters]]]],[when,result,['return-from',some,result]]],[mapc,function('seq-next'),iters],[go,start]]]]],[defun,notevery,[predicate,'&rest',sequences],[let,[[iters,[mapcar,function('seq-start'),sequences]]],[tagbody,start,[unless,['some-list-2',function('seq-end-p'),sequences,iters],[unless,[apply,predicate,[mapcar,function('seq-ref'),sequences,iters]],['return-from',every,t]],[mapc,function('seq-next'),iters],[go,start]]]]],[defun,notany,[predicate,'&rest',sequences],[let,[[iters,[mapcar,function('seq-start'),sequences]]],[tagbody,start,[unless,['some-list-2',function('seq-end-p'),sequences,iters],[when,[apply,predicate,[mapcar,function('seq-ref'),sequences,iters]],['return-from',every,[]]],[mapc,function('seq-next'),iters],[go,start]]]],t],[defun,count,[item,sequence,'&rest',rest],[let,[[iter,[apply,function('seq-start'),sequence,rest]],[count,0]],[tagbody,start,[unless,[apply,function('seq-end-p'),sequence,iter,rest],[when,[apply,function(satisfies),item,['seq-ref',sequence,iter],rest],[setf,count,[+,1,count]]],['seq-next',iter],[go,start]]],count]],[defun,'count-if',[predicate,sequence,'&rest',rest],[let,[[iter,[apply,function('seq-start'),sequence,rest]],[count,0]],[tagbody,start,[unless,[apply,function('seq-end-p'),sequence,iter,rest],[when,[apply,function('satisfies-if'),predicate,['seq-ref',sequence,iter],rest],[setf,count,[+,1,count]]],['seq-next',iter],[go,start]]],count]],[defun,'count-if-not',[predicate,sequence,'&rest',rest],[let,[[iter,[apply,function('seq-start'),sequence,rest]],[count,0]],[tagbody,start,[unless,[apply,function('seq-end-p'),sequence,iter,rest],[when,[apply,function('satisfies-if-not'),predicate,['seq-ref',sequence,iter],rest],[setf,count,[+,1,count]]],['seq-next',iter],[go,start]]],count]],[defun,remove,[item,sequence,'&rest',rest,'&key',count],[let,[[iter,[apply,function('seq-start'),sequence,rest]],[result,[]]],[tagbody,start,[unless,[apply,function('seq-end-p'),sequence,iter,rest],[let,[[elem,['seq-ref',sequence,iter]]],[unless,[and,[apply,function(satisfies),item,elem,rest],[or,[not,count],[not,[minusp,[decf,count]]]]],[push,elem,result]]],['seq-next',iter],[go,start]]],['seq-result',sequence,iter,result]]],[defun,'remove-if',[predicate,sequence,'&rest',rest,'&key',count],[let,[[iter,[apply,function('seq-start'),sequence,rest]],[result,[]]],[tagbody,start,[unless,[apply,function('seq-end-p'),sequence,iter,rest],[let,[[elem,['seq-ref',sequence,iter]]],[unless,[and,[apply,function('satisfies-if'),predicate,elem,rest],[or,[not,count],[not,[minusp,[decf,count]]]]],[push,elem,result]]],['seq-next',iter],[go,start]]],['seq-result',sequence,iter,result]]],[defun,'remove-if-not',[predicate,sequence,'&rest',rest,'&key',count],[let,[[iter,[apply,function('seq-start'),sequence,rest]],[result,[]]],[tagbody,start,[unless,[apply,function('seq-end-p'),sequence,iter,rest],[let,[[elem,['seq-ref',sequence,iter]]],[unless,[and,[apply,function('satisfies-if-not'),predicate,elem,rest],[or,[not,count],[not,[minusp,[decf,count]]]]],[push,elem,result]]],['seq-next',iter],[go,start]]],['seq-result',sequence,iter,result]]]])
8258/*
8259:- side_effect(generate_function_or_macro_name(
8260 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
8261 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
8262 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
8263 fbound(sys_expand, kw_function)=function(f_sys_expand11),
8264 name='GLOBAL',
8265 environ=env_1
8266 ],
8267 satisfies,
8268 kw_function,
8269 f_satisfies)).
8270*/
8271/*
8272:- side_effect(generate_function_or_macro_name(
8273 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
8274 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
8275 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
8276 fbound(sys_expand, kw_function)=function(f_sys_expand11),
8277 name='GLOBAL',
8278 environ=env_1
8279 ],
8280 sys_satisfies_if,
8281 kw_function,
8282 f_sys_satisfies_if)).
8283*/
8284/*
8285:- side_effect(generate_function_or_macro_name(
8286 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
8287 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
8288 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
8289 fbound(sys_expand, kw_function)=function(f_sys_expand11),
8290 name='GLOBAL',
8291 environ=env_1
8292 ],
8293 sys_satisfies_if_not,
8294 kw_function,
8295 f_sys_satisfies_if_not)).
8296*/
8297/*
8298:- side_effect(generate_function_or_macro_name(
8299 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
8300 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
8301 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
8302 fbound(sys_expand, kw_function)=function(f_sys_expand11),
8303 name='GLOBAL',
8304 environ=env_1
8305 ],
8306 sys_seq_start,
8307 kw_function,
8308 f_sys_seq_start)).
8309*/
8310/*
8311% macroexpand:-[push,sequence,sys_acc].
8312*/
8313/*
8314% into:-[setq,sys_acc,[cons,sequence,sys_acc]].
8315*/
8316/*
8317% macroexpand:-[push,sequence,sys_acc].
8318*/
8319/*
8320% into:-[setq,sys_acc,[cons,sequence,sys_acc]].
8321*/
8322/*
8323:- side_effect(generate_function_or_macro_name(
8324 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
8325 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
8326 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
8327 fbound(sys_expand, kw_function)=function(f_sys_expand11),
8328 name='GLOBAL',
8329 environ=env_1
8330 ],
8331 sys_seq_position,
8332 kw_function,
8333 f_sys_seq_position)).
8334*/
8335/*
8336% case:-[[[0,1],[cdr,sys_iter]],[t,[caddr,sys_iter]]].
8337*/
8338/*
8339% conds:-[[[sys_memq,_140818,[quote,[0,1]]],[progn,[cdr,sys_iter]]],[t,[progn,[caddr,sys_iter]]]].
8340*/
8341/*
8342:- side_effect(generate_function_or_macro_name(
8343 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
8344 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
8345 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
8346 fbound(sys_expand, kw_function)=function(f_sys_expand11),
8347 name='GLOBAL',
8348 environ=env_1
8349 ],
8350 sys_seq_next,
8351 kw_function,
8352 f_sys_seq_next)).
8353*/
8354/*
8355% case:-[[0,[setf,[cdr,sys_iter],[+,1,[cdr,sys_iter]]]],[1,[setf,[cdr,sys_iter],[-,[cdr,sys_iter],1]]],[2,[setf,[cadr,sys_iter],[cdadr,sys_iter]],[setf,[caddr,sys_iter],[+,1,[caddr,sys_iter]]]],[t,[setf,[cadr,sys_iter],[cdadr,sys_iter]],[setf,[caddr,sys_iter],[-,[caddr,sys_iter],1]]]].
8356*/
8357/*
8358% conds:-[[[eq,_147068,[quote,0]],[progn,[setf,[cdr,sys_iter],[+,1,[cdr,sys_iter]]]]],[[eq,_147068,[quote,1]],[progn,[setf,[cdr,sys_iter],[-,[cdr,sys_iter],1]]]],[[eq,_147068,[quote,2]],[progn,[setf,[cadr,sys_iter],[cdadr,sys_iter]],[setf,[caddr,sys_iter],[+,1,[caddr,sys_iter]]]]],[t,[progn,[setf,[cadr,sys_iter],[cdadr,sys_iter]],[setf,[caddr,sys_iter],[-,[caddr,sys_iter],1]]]]].
8359*/
8360/*
8361:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_112016,_111450],[sys_iter,_112016,_111450]),setf_inverse_op(cdr,rplacd))).
8362*/
8363/*
8364:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_162218,_125036],[sys_iter,_162218,_125036]),setf_inverse_op(cdr,rplacd))).
8365*/
8366/*
8367:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_293564,_293392],[sys_iter,_293564,_293392]),setf_inverse_op(cdr,rplacd))).
8368*/
8369/*
8370:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_112776,_112748],[sys_iter,_112776,_112748]),setf_inverse_op(cdr,rplacd))).
8371*/
8372/*
8373:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_202254,_202082],[sys_iter,_202254,_202082]),setf_inverse_op(cadr,sys_pf_set_cadr))).
8374*/
8375/*
8376:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_296526,_296354],[sys_iter,_296526,_296354]),setf_inverse_op(cadr,sys_pf_set_cadr))).
8377*/
8378/*
8379:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_168474,_168302],[sys_iter,_168474,_168302]),setf_inverse_op(caddr,sys_pf_set_caddr))).
8380*/
8381/*
8382:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_263210,_263038],[sys_iter,_263210,_263038]),setf_inverse_op(caddr,sys_pf_set_caddr))).
8383*/
8384/*
8385:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_113918,_113890],[sys_iter,_113918,_113890]),setf_inverse_op(cadr,sys_pf_set_cadr))).
8386*/
8387/*
8388:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_165518,_165346],[sys_iter,_165518,_165346]),setf_inverse_op(cadr,sys_pf_set_cadr))).
8389*/
8390/*
8391:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_278468,_278296],[sys_iter,_278468,_278296]),setf_inverse_op(caddr,sys_pf_set_caddr))).
8392*/
8393/*
8394:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_108072,[],[],true),append([sys_iter],[_114190,_114162],[sys_iter,_114190,_114162]),setf_inverse_op(caddr,sys_pf_set_caddr))).
8395*/
8396/*
8397:- side_effect(generate_function_or_macro_name(
8398 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
8399 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
8400 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
8401 fbound(sys_expand, kw_function)=function(f_sys_expand11),
8402 name='GLOBAL',
8403 environ=env_1
8404 ],
8405 sys_seq_ref,
8406 kw_function,
8407 f_sys_seq_ref)).
8408*/
8409/*
8410% case:-[[[0,1],[aref,sequence,[cdr,sys_iter]]],[2,[caadr,sys_iter]],[t,[caaadr,sys_iter]]].
8411*/
8412/*
8413% conds:-[[[sys_memq,_152280,[quote,[0,1]]],[progn,[aref,sequence,[cdr,sys_iter]]]],[[eq,_152280,[quote,2]],[progn,[caadr,sys_iter]]],[t,[progn,[caaadr,sys_iter]]]].
8414*/
8415/*
8416:- side_effect(generate_function_or_macro_name(
8417 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
8418 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
8419 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
8420 fbound(sys_expand, kw_function)=function(f_sys_expand11),
8421 name='GLOBAL',
8422 environ=env_1
8423 ],
8424 sys_seq_set,
8425 kw_function,
8426 f_sys_seq_set)).
8427*/
8428/*
8429% case:-[[[0,1],[setf,[aref,sequence,[cdr,sys_iter]],sys_value]],[2,[setf,[caadr,sys_iter],sys_value]],[t,[setf,[caaadr,sys_iter],sys_value]]].
8430*/
8431/*
8432% conds:-[[[sys_memq,_157480,[quote,[0,1]]],[progn,[setf,[aref,sequence,[cdr,sys_iter]],sys_value]]],[[eq,_157480,[quote,2]],[progn,[setf,[caadr,sys_iter],sys_value]]],[t,[progn,[setf,[caaadr,sys_iter],sys_value]]]].
8433*/
8434/*
8435:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_111592,[[[cdr,sys_iter]]],[[[cdr,sys_iter]]],true),append([sequence,[[cdr,sys_iter]]],[_114900,_114872],[sequence,[[cdr,sys_iter]],_114900,_114872]),setf_inverse_op(aref,svref))).
8436*/
8437/*
8438:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_111592,[[[cdr,sys_iter]]],[[[cdr,sys_iter]]],true),append([sequence,[[cdr,sys_iter]]],[_177614,_177442],[sequence,[[cdr,sys_iter]],_177614,_177442]),setf_inverse_op(aref,svref))).
8439*/
8440/*
8441:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_111592,[],[],true),append([sys_iter],[_115062,_115034],[sys_iter,_115062,_115034]),setf_inverse_op(caadr,sys_pf_set_caadr))).
8442*/
8443/*
8444:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_111592,[],[],true),append([sys_iter],[_169806,_169634],[sys_iter,_169806,_169634]),setf_inverse_op(caadr,sys_pf_set_caadr))).
8445*/
8446/*
8447:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_111592,[],[],true),append([sys_iter],[_288510,_288338],[sys_iter,_288510,_288338]),setf_inverse_op(caaadr,sys_pf_set_caaadr))).
8448*/
8449/*
8450:-side_effect((compile_each([fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_111592,[],[],true),append([sys_iter],[_115230,_115202],[sys_iter,_115230,_115202]),setf_inverse_op(caaadr,sys_pf_set_caaadr))).
8451*/
8452/*
8453:- side_effect(generate_function_or_macro_name(
8454 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
8455 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
8456 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
8457 fbound(sys_expand, kw_function)=function(f_sys_expand11),
8458 name='GLOBAL',
8459 environ=env_1
8460 ],
8461 sys_seq_end_p,
8462 kw_function,
8463 f_sys_seq_end_p)).
8464*/
8465/*
8466% case:-[[0,[or,[=,[cdr,sys_iter],[length,sequence]],[and,sys_end,[=,sys_end,[cdr,sys_iter]]]]],[1,[<,[cdr,sys_iter],sys_start]],[2,[or,[null,[cadr,sys_iter]],[and,sys_end,[=,sys_end,[caddr,sys_iter]]]]],[t,[or,[null,[cadr,sys_iter]],[<,[caddr,sys_iter],sys_start]]]].
8467*/
8468/*
8469% conds:-[[[eq,_364466,[quote,0]],[progn,[or,[=,[cdr,sys_iter],[length,sequence]],[and,sys_end,[=,sys_end,[cdr,sys_iter]]]]]],[[eq,_364466,[quote,1]],[progn,[<,[cdr,sys_iter],sys_start]]],[[eq,_364466,[quote,2]],[progn,[or,[null,[cadr,sys_iter]],[and,sys_end,[=,sys_end,[caddr,sys_iter]]]]]],[t,[progn,[or,[null,[cadr,sys_iter]],[<,[caddr,sys_iter],sys_start]]]]].
8470*/
8471/*
8472:- side_effect(generate_function_or_macro_name(
8473 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
8474 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
8475 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
8476 fbound(sys_expand, kw_function)=function(f_sys_expand11),
8477 name='GLOBAL',
8478 environ=env_1
8479 ],
8480 sys_seq_result,
8481 kw_function,
8482 f_sys_seq_result)).
8483*/
8484/*
8485% case:-[[0,[make_array,[length,sys_result],kw_element_type,[array_element_type,sequence],kw_initial_contents,[reverse,sys_result]]],[1,[make_array,[length,sys_result],kw_element_type,[array_element_type,sequence],kw_initial_contents,sys_result]],[2,[reverse,sys_result]],[3,sys_result]].
8486*/
8487/*
8488% conds:-[[[eq,_172824,[quote,0]],[progn,[make_array,[length,sys_result],kw_element_type,[array_element_type,sequence],kw_initial_contents,[reverse,sys_result]]]],[[eq,_172824,[quote,1]],[progn,[make_array,[length,sys_result],kw_element_type,[array_element_type,sequence],kw_initial_contents,sys_result]]],[[eq,_172824,[quote,2]],[progn,[reverse,sys_result]]],[[eq,_172824,[quote,3]],[progn,sys_result]]].
8489*/
8490/*
8491:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _158946, [], [], true), append([sys_tree], [CAR505, CAR504], [sys_tree, CAR505, CAR504]), setf_inverse_op(car, rplaca))).
8492*/
8493/*
8494:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _158836, [], [], true), append([sys_tree], [CAR505, CAR504], [sys_tree, CAR505, CAR504]), setf_inverse_op(car, rplaca))).
8495*/
8496/*
8497:-side_effect((compile_each([[fbound(satisfies,kw_function)=function(f_satisfies1),fbound(sys_satisfies_if,kw_function)=function(f_sys_satisfies_if1),fbound(sys_satisfies_if_not,kw_function)=function(f_sys_satisfies_if_not1),fbound(sys_seq_start,kw_function)=function(f_sys_seq_start1),fbound(sys_seq_position,kw_function)=function(f_sys_seq_position1),fbound(sys_seq_next,kw_function)=function(f_sys_seq_next1),fbound(sys_seq_ref,kw_function)=function(f_sys_seq_ref1),fbound(sys_seq_set,kw_function)=function(f_sys_seq_set1),fbound(sys_seq_end_p,kw_function)=function(f_sys_seq_end_p1),fbound(sys_seq_result,kw_function)=function(f_sys_seq_result1)],fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_158836,[],[],true),append([sys_tree],[_298822,_298650],[sys_tree,_298822,_298650]),setf_inverse_op(cdr,rplacd))).
8498*/
8499/*
8500:-side_effect((compile_each([[fbound(satisfies,kw_function)=function(f_satisfies1),fbound(sys_satisfies_if,kw_function)=function(f_sys_satisfies_if1),fbound(sys_satisfies_if_not,kw_function)=function(f_sys_satisfies_if_not1),fbound(sys_seq_start,kw_function)=function(f_sys_seq_start1),fbound(sys_seq_position,kw_function)=function(f_sys_seq_position1),fbound(sys_seq_next,kw_function)=function(f_sys_seq_next1),fbound(sys_seq_ref,kw_function)=function(f_sys_seq_ref1),fbound(sys_seq_set,kw_function)=function(f_sys_seq_set1),fbound(sys_seq_end_p,kw_function)=function(f_sys_seq_end_p1),fbound(sys_seq_result,kw_function)=function(f_sys_seq_result1)],fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_158836,[],[],true),append([sys_tree],[_162962,_162934],[sys_tree,_162962,_162934]),setf_inverse_op(cdr,rplacd))).
8501*/
8502/*
8503:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _168078, [], [], true), append([sys_tree], [CAR543, CAR542], [sys_tree, CAR543, CAR542]), setf_inverse_op(car, rplaca))).
8504*/
8505/*
8506:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _168078, [], [], true), append([sys_tree], [CAR543, CAR542], [sys_tree, CAR543, CAR542]), setf_inverse_op(car, rplaca))).
8507*/
8508/*
8509:-side_effect((compile_each([[fbound(satisfies,kw_function)=function(f_satisfies1),fbound(sys_satisfies_if,kw_function)=function(f_sys_satisfies_if1),fbound(sys_satisfies_if_not,kw_function)=function(f_sys_satisfies_if_not1),fbound(sys_seq_start,kw_function)=function(f_sys_seq_start1),fbound(sys_seq_position,kw_function)=function(f_sys_seq_position1),fbound(sys_seq_next,kw_function)=function(f_sys_seq_next1),fbound(sys_seq_ref,kw_function)=function(f_sys_seq_ref1),fbound(sys_seq_set,kw_function)=function(f_sys_seq_set1),fbound(sys_seq_end_p,kw_function)=function(f_sys_seq_end_p1),fbound(sys_seq_result,kw_function)=function(f_sys_seq_result1)],fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_168010,[],[],true),append([sys_tree],[_172150,_172122],[sys_tree,_172150,_172122]),setf_inverse_op(cdr,rplacd))).
8510*/
8511/*
8512:-side_effect((compile_each([[fbound(satisfies,kw_function)=function(f_satisfies1),fbound(sys_satisfies_if,kw_function)=function(f_sys_satisfies_if1),fbound(sys_satisfies_if_not,kw_function)=function(f_sys_satisfies_if_not1),fbound(sys_seq_start,kw_function)=function(f_sys_seq_start1),fbound(sys_seq_position,kw_function)=function(f_sys_seq_position1),fbound(sys_seq_next,kw_function)=function(f_sys_seq_next1),fbound(sys_seq_ref,kw_function)=function(f_sys_seq_ref1),fbound(sys_seq_set,kw_function)=function(f_sys_seq_set1),fbound(sys_seq_end_p,kw_function)=function(f_sys_seq_end_p1),fbound(sys_seq_result,kw_function)=function(f_sys_seq_result1)],fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_168010,[],[],true),append([sys_tree],[_284464,_284292],[sys_tree,_284464,_284292]),setf_inverse_op(cdr,rplacd))).
8513*/
8514/*
8515:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _176904, [], [], true), append([sys_tree], [CAR581, CAR580], [sys_tree, CAR581, CAR580]), setf_inverse_op(car, rplaca))).
8516*/
8517/*
8518:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _176830, [], [], true), append([sys_tree], [CAR581, CAR580], [sys_tree, CAR581, CAR580]), setf_inverse_op(car, rplaca))).
8519*/
8520/*
8521:-side_effect((compile_each([[fbound(satisfies,kw_function)=function(f_satisfies1),fbound(sys_satisfies_if,kw_function)=function(f_sys_satisfies_if1),fbound(sys_satisfies_if_not,kw_function)=function(f_sys_satisfies_if_not1),fbound(sys_seq_start,kw_function)=function(f_sys_seq_start1),fbound(sys_seq_position,kw_function)=function(f_sys_seq_position1),fbound(sys_seq_next,kw_function)=function(f_sys_seq_next1),fbound(sys_seq_ref,kw_function)=function(f_sys_seq_ref1),fbound(sys_seq_set,kw_function)=function(f_sys_seq_set1),fbound(sys_seq_end_p,kw_function)=function(f_sys_seq_end_p1),fbound(sys_seq_result,kw_function)=function(f_sys_seq_result1)],fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_176830,[],[],true),append([sys_tree],[_321612,_321440],[sys_tree,_321612,_321440]),setf_inverse_op(cdr,rplacd))).
8522*/
8523/*
8524:-side_effect((compile_each([[fbound(satisfies,kw_function)=function(f_satisfies1),fbound(sys_satisfies_if,kw_function)=function(f_sys_satisfies_if1),fbound(sys_satisfies_if_not,kw_function)=function(f_sys_satisfies_if_not1),fbound(sys_seq_start,kw_function)=function(f_sys_seq_start1),fbound(sys_seq_position,kw_function)=function(f_sys_seq_position1),fbound(sys_seq_next,kw_function)=function(f_sys_seq_next1),fbound(sys_seq_ref,kw_function)=function(f_sys_seq_ref1),fbound(sys_seq_set,kw_function)=function(f_sys_seq_set1),fbound(sys_seq_end_p,kw_function)=function(f_sys_seq_end_p1),fbound(sys_seq_result,kw_function)=function(f_sys_seq_result1)],fbound(sys_all_cdr,kw_function)=function(f_sys_all_cdr1),fbound(sys_all_car,kw_function)=function(f_sys_all_car1),fbound(sys_all_end,kw_function)=function(f_sys_all_end1),fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],_176830,[],[],true),append([sys_tree],[_180956,_180928],[sys_tree,_180956,_180928]),setf_inverse_op(cdr,rplacd))).
8525*/
8526/*
8527% macroexpand:-[push,sys_item,sys_result].
8528*/
8529/*
8530% into:-[setq,sys_result,[cons,sys_item,sys_result]].
8531*/
8532/*
8533% macroexpand:-[push,sys_item,sys_result].
8534*/
8535/*
8536% into:-[setq,sys_result,[cons,sys_item,sys_result]].
8537*/
8538/*
8539:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv835, [], [], true), append([sys_prev], [CAR861, CAR860], [sys_prev, CAR861, CAR860]), setf_inverse_op(cdr, rplacd))).
8540*/
8541/*
8542:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv835, [], [], true), append([sys_prev], [CAR861, CAR860], [sys_prev, CAR861, CAR860]), setf_inverse_op(cdr, rplacd))).
8543*/
8544/*
8545:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv882, [], [], true), append([sys_prev], [CAR908, CAR907], [sys_prev, CAR908, CAR907]), setf_inverse_op(cdr, rplacd))).
8546*/
8547/*
8548:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv882, [], [], true), append([sys_prev], [CAR908, CAR907], [sys_prev, CAR908, CAR907]), setf_inverse_op(cdr, rplacd))).
8549*/
8550/*
8551:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _247824, [], [], true), append([sys_list_1], [CAR924, CAR923], [sys_list_1, CAR924, CAR923]), setf_inverse_op(cdr, rplacd))).
8552*/
8553/*
8554:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _247824, [], [], true), append([sys_list_1], [CAR924, CAR923], [sys_list_1, CAR924, CAR923]), setf_inverse_op(cdr, rplacd))).
8555*/
8556/*
8557:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _248416, [], [], true), append([sys_end], [CAR942, CAR941], [sys_end, CAR942, CAR941]), setf_inverse_op(cdr, rplacd))).
8558*/
8559/*
8560:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], _248416, [], [], true), append([sys_end], [CAR942, CAR941], [sys_end, CAR942, CAR941]), setf_inverse_op(cdr, rplacd))).
8561*/
8562/*
8563:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv967, [], [], true), append([sys_prev], [CAR993, CAR992], [sys_prev, CAR993, CAR992]), setf_inverse_op(cdr, rplacd))).
8564*/
8565/*
8566:- side_effect((compile_each([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)], fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv967, [], [], true), append([sys_prev], [CAR993, CAR992], [sys_prev, CAR993, CAR992]), setf_inverse_op(cdr, rplacd))).
8567*/
8568/*
8569% macroexpand:-[push,sys_elem,sys_result].
8570*/
8571/*
8572% into:-[setq,sys_result,[cons,sys_elem,sys_result]].
8573*/
8574/*
8575% macroexpand:-[push,sys_elem,sys_result].
8576*/
8577/*
8578% into:-[setq,sys_result,[cons,sys_elem,sys_result]].
8579*/
8580/*
8581% macroexpand:-[push,sys_elem,sys_result].
8582*/
8583/*
8584% into:-[setq,sys_result,[cons,sys_elem,sys_result]].
8585*/
8586/*
8587% macroexpand:-[push,sys_elem,sys_result].
8588*/
8589/*
8590% into:-[setq,sys_result,[cons,sys_elem,sys_result]].
8591*/
8592/*
8593% macroexpand:-[push,sys_elem,sys_result].
8594*/
8595/*
8596% into:-[setq,sys_result,[cons,sys_elem,sys_result]].
8597*/
8598/*
8599% macroexpand:-[push,sys_elem,sys_result].
8600*/
8601/*
8602% into:-[setq,sys_result,[cons,sys_elem,sys_result]].
8603*/
8604wl:lambda_def(defun, satisfies, f_satisfies1, [sys_object, sys_elem, c38_key, key, sys_test, sys_test_not], [[let_xx, [[sys_zi, [if, key, [funcall, key, sys_elem], sys_elem]], [sys_r, [funcall, [or, sys_test, sys_test_not, function(eql)], sys_object, sys_zi]]], [if, sys_test_not, [not, sys_r], sys_r]]]).
8605wl:arglist_info(satisfies, f_satisfies1, [sys_object, sys_elem, c38_key, key, sys_test, sys_test_not], arginfo{all:[sys_object, sys_elem], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key, sys_test, sys_test_not], names:[sys_object, sys_elem, key, sys_test, sys_test_not], opt:0, req:[sys_object, sys_elem], rest:0, sublists:0, whole:0}).
8606wl: init_args(2, f_satisfies1).
8607
8612f_satisfies1(Object_In, Elem_In, RestNKeys, FnResult) :-
8613 GEnv=[bv(sys_object, Object_In), bv(sys_elem, Elem_In), bv(key, Key_In), bv(sys_test, Test_In), bv(sys_test_not, Test_not_In)],
8614 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
8615 get_kw(Env, RestNKeys, sys_test, sys_test, Test_In, []=Test_In, Test_P),
8616 get_kw(Env,
8617 RestNKeys,
8618 sys_test_not,
8619 sys_test_not,
8620 Test_not_In,
8621 []=Test_not_In,
8622 Test_not_P),
8623 catch(( ( get_var(GEnv, key, IFTEST),
8624 ( IFTEST\==[]
8625 -> get_var(GEnv, key, Key_Get18),
8626 get_var(GEnv, sys_elem, Elem_Get),
8627 f_apply(Key_Get18, [Elem_Get], TrueResult),
8628 Zi_Init=TrueResult
8629 ; get_var(GEnv, sys_elem, Elem_Get20),
8630 Zi_Init=Elem_Get20
8631 ),
8632 LEnv=[bv(sys_zi, Zi_Init)|GEnv],
8633 ( get_var(LEnv, sys_test, Test_Get),
8634 Test_Get\==[],
8635 Apply_Param=Test_Get
8636 -> true
8637 ; ( get_var(LEnv, sys_test_not, Test_not_Get),
8638 Test_not_Get\==[],
8639 _64974=Test_not_Get
8640 -> true
8641 ; _64974=f_eql
8642 ),
8643 Apply_Param=_64974
8644 ),
8645 get_var(LEnv, sys_object, Object_Get),
8646 get_var(LEnv, sys_zi, Zi_Get),
8647 f_apply(Apply_Param, [Object_Get, Zi_Get], R_Init),
8648 LEnv26=[bv(sys_r, R_Init)|LEnv],
8649 get_var(LEnv26, sys_test_not, IFTEST34),
8650 ( IFTEST34\==[]
8651 -> get_var(LEnv26, sys_r, R_Get),
8652 f_not(R_Get, TrueResult39),
8653 LetResult25=TrueResult39
8654 ; get_var(LEnv26, sys_r, R_Get38),
8655 LetResult25=R_Get38
8656 )
8657 ),
8658 LetResult25=FnResult
8659 ),
8660 block_exit(satisfies, FnResult),
8661 true).
8662wl:lambda_def(defun, sys_satisfies_if, f_sys_satisfies_if1, [sys_predicate, sys_elem, c38_key, key], [[funcall, sys_predicate, [if, key, [funcall, key, sys_elem], sys_elem]]]).
8663wl:arglist_info(sys_satisfies_if, f_sys_satisfies_if1, [sys_predicate, sys_elem, c38_key, key], arginfo{all:[sys_predicate, sys_elem], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_predicate, sys_elem, key], opt:0, req:[sys_predicate, sys_elem], rest:0, sublists:0, whole:0}).
8664wl: init_args(2, f_sys_satisfies_if1).
8665
8670f_sys_satisfies_if1(Predicate_In, Elem_In46, RestNKeys43, FnResult42) :-
8671 GEnv1645=[bv(sys_predicate, Predicate_In), bv(sys_elem, Elem_In46), bv(key, Key_In47)],
8672 get_kw(Env, RestNKeys43, key, key, Key_In47, []=Key_In47, Key_P44),
8673 catch(( ( get_var(GEnv1645, key, IFTEST49),
8674 get_var(GEnv1645, sys_predicate, Predicate_Get),
8675 ( IFTEST49\==[]
8676 -> get_var(GEnv1645, key, Key_Get52),
8677 get_var(GEnv1645, sys_elem, Elem_Get53),
8678 f_apply(Key_Get52, [Elem_Get53], TrueResult55),
8679 CAR1718=TrueResult55
8680 ; get_var(GEnv1645, sys_elem, Elem_Get54),
8681 CAR1718=Elem_Get54
8682 ),
8683 f_apply(Predicate_Get, [CAR1718], Apply_Ret)
8684 ),
8685 Apply_Ret=FnResult42
8686 ),
8687 block_exit(sys_satisfies_if, FnResult42),
8688 true).
8689wl:lambda_def(defun, sys_satisfies_if_not, f_sys_satisfies_if_not1, [sys_predicate, sys_elem, c38_key, key], [[not, [funcall, sys_predicate, [if, key, [funcall, key, sys_elem], sys_elem]]]]).
8690wl:arglist_info(sys_satisfies_if_not, f_sys_satisfies_if_not1, [sys_predicate, sys_elem, c38_key, key], arginfo{all:[sys_predicate, sys_elem], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_predicate, sys_elem, key], opt:0, req:[sys_predicate, sys_elem], rest:0, sublists:0, whole:0}).
8691wl: init_args(2, f_sys_satisfies_if_not1).
8692
8697f_sys_satisfies_if_not1(Predicate_In61, Elem_In62, RestNKeys59, FnResult58) :-
8698 GEnv1646=[bv(sys_predicate, Predicate_In61), bv(sys_elem, Elem_In62), bv(key, Key_In63)],
8699 get_kw(Env, RestNKeys59, key, key, Key_In63, []=Key_In63, Key_P60),
8700 catch(( ( get_var(GEnv1646, key, IFTEST65),
8701 get_var(GEnv1646, sys_predicate, Predicate_Get64),
8702 ( IFTEST65\==[]
8703 -> get_var(GEnv1646, key, Key_Get68),
8704 get_var(GEnv1646, sys_elem, Elem_Get69),
8705 f_apply(Key_Get68, [Elem_Get69], TrueResult71),
8706 CAR1719=TrueResult71
8707 ; get_var(GEnv1646, sys_elem, Elem_Get70),
8708 CAR1719=Elem_Get70
8709 ),
8710 f_apply(Predicate_Get64, [CAR1719], Not_Param),
8711 f_not(Not_Param, Not_Ret)
8712 ),
8713 Not_Ret=FnResult58
8714 ),
8715 block_exit(sys_satisfies_if_not, FnResult58),
8716 true).
8717wl:lambda_def(defun, sys_seq_start, f_sys_seq_start1, [sequence, c38_key, [sys_start, 0], sys_end, sys_from_end], [[if, [listp, sequence], [if, sys_from_end, [let, [[sys_acc, []], [sequence, [nthcdr, sys_start, sequence]]], [tagbody, sys_start, [when, [and, sequence, [or, [not, sys_end], [<, sys_start, sys_end]]], [push, sequence, sys_acc], [setf, sequence, [cdr, sequence]], [setf, sys_start, [+, 1, sys_start]], [go, sys_start]]], [list, 3, sys_acc, sys_start]], [list, 2, [nthcdr, sys_start, sequence], sys_start]], [if, sys_from_end, [cons, 1, [-, sys_end, 1]], [cons, 0, sys_start]]]]).
8718wl:arglist_info(sys_seq_start, f_sys_seq_start1, [sequence, c38_key, [sys_start, 0], sys_end, sys_from_end], arginfo{all:[sequence], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_start, sys_end, sys_from_end], names:[sequence, sys_start, sys_end, sys_from_end], opt:0, req:[sequence], rest:0, sublists:0, whole:0}).
8719wl: init_args(1, f_sys_seq_start1).
8720
8725f_sys_seq_start1(Sequence_In, RestNKeys75, FnResult74) :-
8726 GEnv1647=[bv(sequence, Sequence_In), bv(sys_start, Start_In), bv(sys_end, End_In), bv(sys_from_end, From_end_In)],
8727 get_kw(Env,
8728 RestNKeys75,
8729 sys_start,
8730 sys_start,
8731 Start_In,
8732 0=Start_In,
8733 Start_P),
8734 get_kw(Env, RestNKeys75, sys_end, sys_end, End_In, []=End_In, End_P),
8735 get_kw(Env,
8736 RestNKeys75,
8737 sys_from_end,
8738 sys_from_end,
8739 From_end_In,
8740 []=From_end_In,
8741 From_end_P),
8742 catch(( ( get_var(GEnv1647, sequence, Sequence_Get),
8743 ( s3q:is_listp(Sequence_Get)
8744 -> get_var(GEnv1647, sys_from_end, IFTEST87),
8745 ( IFTEST87\==[]
8746 -> get_var(GEnv1647, sequence, Sequence_Get94),
8747 get_var(GEnv1647, sys_start, Start_Get),
8748 f_nthcdr(Start_Get, Sequence_Get94, Sequence_Init),
8749 AEnv=[bv(sys_acc, []), bv(sequence, Sequence_Init)|GEnv1647],
8750 call_addr_block(AEnv,
8751 (push_label(sys_start), get_var(AEnv, sequence, IFTEST118), (IFTEST118\==[]->(get_var(AEnv, sys_end, End_Get121), f_not(End_Get121, FORM1_Res124), FORM1_Res124\==[], TrueResult125=FORM1_Res124->true;get_var(AEnv, sys_end, End_Get123), get_var(AEnv, sys_start, Start_Get122), 'f_<'(Start_Get122, End_Get123, _67110), TrueResult125=_67110), IFTEST116=TrueResult125;IFTEST116=[]), (IFTEST116\==[]->get_var(AEnv, sequence, Sequence_Get127), get_var(AEnv, sys_acc, Acc_Get128), Acc=[Sequence_Get127|Acc_Get128], set_var(AEnv, sys_acc, Acc), get_var(AEnv, sequence, Sequence_Get129), f_cdr(Sequence_Get129, Sequence), set_var(AEnv, sequence, Sequence), get_var(AEnv, sys_start, Start_Get130), 'f_+'(1, Start_Get130, Start), set_var(AEnv, sys_start, Start), goto(sys_start, AEnv), _TBResult=_GORES131;_TBResult=[])),
8752
8753 [ addr(addr_tagbody_53_sys_start,
8754 sys_start,
8755 '$unused',
8756 AEnv,
8757 (get_var(AEnv, sequence, IFTEST99), (IFTEST99\==[]->(get_var(AEnv, sys_end, Not_Param1685), f_not(Not_Param1685, FORM1_Res105), FORM1_Res105\==[], TrueResult106=FORM1_Res105->true;get_var(AEnv, sys_end, End_Get104), get_var(AEnv, sys_start, Start_Get103), 'f_<'(Start_Get103, End_Get104, _67492), TrueResult106=_67492), IFTEST97=TrueResult106;IFTEST97=[]), (IFTEST97\==[]->get_var(AEnv, sequence, Sequence_Get108), get_var(AEnv, sys_acc, Get_var_Ret), Set_var_Ret=[Sequence_Get108|Get_var_Ret], set_var(AEnv, sys_acc, Set_var_Ret), get_var(AEnv, sequence, Sequence_Get110), f_cdr(Sequence_Get110, Cdr_Ret), set_var(AEnv, sequence, Cdr_Ret), get_var(AEnv, sys_start, Start_Get111), 'f_+'(1, Start_Get111, Set_var_Ret1724), set_var(AEnv, sys_start, Set_var_Ret1724), goto(sys_start, AEnv), _67558=_GORES;_67558=[])))
8758 ]),
8759 get_var(AEnv, sys_acc, Acc_Get134),
8760 get_var(AEnv, sys_start, Start_Get135),
8761 LetResult91=[3, Acc_Get134, Start_Get135],
8762 TrueResult148=LetResult91
8763 ; get_var(GEnv1647, sequence, Sequence_Get137),
8764 get_var(GEnv1647, sys_start, Start_Get136),
8765 f_nthcdr(Start_Get136, Sequence_Get137, Nthcdr_Ret),
8766 get_var(GEnv1647, sys_start, Start_Get138),
8767 ElseResult140=[2, Nthcdr_Ret, Start_Get138],
8768 TrueResult148=ElseResult140
8769 ),
8770 _66228=TrueResult148
8771 ; get_var(GEnv1647, sys_from_end, IFTEST141),
8772 ( IFTEST141\==[]
8773 -> get_var(GEnv1647, sys_end, End_Get144),
8774 'f_-'(End_Get144, 1, CDR),
8775 TrueResult146=[1|CDR],
8776 ElseResult149=TrueResult146
8777 ; get_var(GEnv1647, sys_start, Start_Get145),
8778 ElseResult147=[0|Start_Get145],
8779 ElseResult149=ElseResult147
8780 ),
8781 _66228=ElseResult149
8782 )
8783 ),
8784 _66228=FnResult74
8785 ),
8786 block_exit(sys_seq_start, FnResult74),
8787 true).
8788wl:lambda_def(defun, sys_seq_position, f_sys_seq_position1, [sys_iter], [[case, [car, sys_iter], [[0, 1], [cdr, sys_iter]], [t, [caddr, sys_iter]]]]).
8789wl:arglist_info(sys_seq_position, f_sys_seq_position1, [sys_iter], arginfo{all:[sys_iter], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_iter], opt:0, req:[sys_iter], rest:0, sublists:0, whole:0}).
8790wl: init_args(1, f_sys_seq_position1).
8791
8796f_sys_seq_position1(Iter_In, RestNKeys152, FnResult151) :-
8797 GEnv1651=[bv(sys_iter, Iter_In)],
8798 catch(( ( get_var(GEnv1651, sys_iter, Iter_Get),
8799 f_car(Iter_Get, Key),
8800 f_sys_memq(Key, [0, 1], IFTEST156),
8801 ( IFTEST156\==[]
8802 -> get_var(GEnv1651, sys_iter, Iter_Get158),
8803 f_cdr(Iter_Get158, TrueResult160),
8804 _68084=TrueResult160
8805 ; get_var(GEnv1651, sys_iter, Iter_Get159),
8806 f_caddr(Iter_Get159, ElseResult161),
8807 _68084=ElseResult161
8808 )
8809 ),
8810 _68084=FnResult151
8811 ),
8812 block_exit(sys_seq_position, FnResult151),
8813 true).
8814wl:lambda_def(defun, sys_seq_next, f_sys_seq_next1, [sys_iter], [[case, [car, sys_iter], [0, [setf, [cdr, sys_iter], [+, 1, [cdr, sys_iter]]]], [1, [setf, [cdr, sys_iter], [-, [cdr, sys_iter], 1]]], [2, [setf, [cadr, sys_iter], [cdadr, sys_iter]], [setf, [caddr, sys_iter], [+, 1, [caddr, sys_iter]]]], [t, [setf, [cadr, sys_iter], [cdadr, sys_iter]], [setf, [caddr, sys_iter], [-, [caddr, sys_iter], 1]]]]]).
8815wl:arglist_info(sys_seq_next, f_sys_seq_next1, [sys_iter], arginfo{all:[sys_iter], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_iter], opt:0, req:[sys_iter], rest:0, sublists:0, whole:0}).
8816wl: init_args(1, f_sys_seq_next1).
8817
8822f_sys_seq_next1(Iter_In165, RestNKeys164, FnResult163) :-
8823 GEnv1652=[bv(sys_iter, Iter_In165)],
8824 catch(( ( get_var(GEnv1652, sys_iter, Iter_Get166),
8825 f_car(Iter_Get166, Key167),
8826 ( is_eq(Key167, 0)
8827 -> get_var(GEnv1652, sys_iter, Iter_Get173),
8828 f_cdr(Iter_Get173, Cdr_Ret1727),
8829 'f_+'(1, Cdr_Ret1727, _68584),
8830 f_rplacd(Iter_Get173, _68584, TrueResult203),
8831 _68388=TrueResult203
8832 ; ( is_eq(Key167, 1)
8833 -> get_var(GEnv1652, sys_iter, Iter_Get179),
8834 f_cdr(Iter_Get179, Cdr_Ret1728),
8835 'f_-'(Cdr_Ret1728, 1, _68750),
8836 f_rplacd(Iter_Get179, _68750, TrueResult201),
8837 ElseResult204=TrueResult201
8838 ; ( is_eq(Key167, 2)
8839 -> get_var(GEnv1652, sys_iter, Iter_Get185),
8840 f_cdadr(Iter_Get185, Cdadr_Ret),
8841 f_sys_pf_set_cadr(Iter_Get185,
8842 Cdadr_Ret,
8843 Set_cadr_Ret),
8844 get_var(GEnv1652, sys_iter, Iter_Get189),
8845 f_caddr(Iter_Get189, Caddr_Ret),
8846 'f_+'(1, Caddr_Ret, _69034),
8847 f_sys_pf_set_caddr(Iter_Get189,
8848 _69034,
8849 TrueResult199),
8850 ElseResult202=TrueResult199
8851 ; get_var(GEnv1652, sys_iter, Iter_Get193),
8852 f_cdadr(Iter_Get193, Cdadr_Ret1732),
8853 f_sys_pf_set_cadr(Iter_Get193,
8854 Cdadr_Ret1732,
8855 Set_cadr_Ret1733),
8856 get_var(GEnv1652, sys_iter, Iter_Get197),
8857 f_caddr(Iter_Get197, Caddr_Ret1734),
8858 'f_-'(Caddr_Ret1734, 1, _69276),
8859 f_sys_pf_set_caddr(Iter_Get197,
8860 _69276,
8861 ElseResult200),
8862 ElseResult202=ElseResult200
8863 ),
8864 ElseResult204=ElseResult202
8865 ),
8866 _68388=ElseResult204
8867 )
8868 ),
8869 _68388=FnResult163
8870 ),
8871 block_exit(sys_seq_next, FnResult163),
8872 true).
8873wl:lambda_def(defun, sys_seq_ref, f_sys_seq_ref1, [sequence, sys_iter], [[case, [car, sys_iter], [[0, 1], [aref, sequence, [cdr, sys_iter]]], [2, [caadr, sys_iter]], [t, [caaadr, sys_iter]]]]).
8874wl:arglist_info(sys_seq_ref, f_sys_seq_ref1, [sequence, sys_iter], arginfo{all:[sequence, sys_iter], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sequence, sys_iter], opt:0, req:[sequence, sys_iter], rest:0, sublists:0, whole:0}).
8875wl: init_args(2, f_sys_seq_ref1).
8876
8881f_sys_seq_ref1(Sequence_In208, Iter_In209, RestNKeys207, FnResult206) :-
8882 GEnv1653=[bv(sequence, Sequence_In208), bv(sys_iter, Iter_In209)],
8883 catch(( ( get_var(GEnv1653, sys_iter, Iter_Get210),
8884 f_car(Iter_Get210, Key211),
8885 f_sys_memq(Key211, [0, 1], IFTEST212),
8886 ( IFTEST212\==[]
8887 -> get_var(GEnv1653, sequence, Sequence_Get214),
8888 get_var(GEnv1653, sys_iter, Iter_Get215),
8889 f_cdr(Iter_Get215, Cdr_Ret1735),
8890 f_aref(Sequence_Get214, [Cdr_Ret1735], TrueResult223),
8891 _69598=TrueResult223
8892 ; ( is_eq(Key211, 2)
8893 -> get_var(GEnv1653, sys_iter, Iter_Get219),
8894 f_caadr(Iter_Get219, TrueResult221),
8895 ElseResult224=TrueResult221
8896 ; get_var(GEnv1653, sys_iter, Iter_Get220),
8897 f_caaadr(Iter_Get220, ElseResult222),
8898 ElseResult224=ElseResult222
8899 ),
8900 _69598=ElseResult224
8901 )
8902 ),
8903 _69598=FnResult206
8904 ),
8905 block_exit(sys_seq_ref, FnResult206),
8906 true).
8907wl:lambda_def(defun, sys_seq_set, f_sys_seq_set1, [sequence, sys_iter, sys_value], [[case, [car, sys_iter], [[0, 1], [setf, [aref, sequence, [cdr, sys_iter]], sys_value]], [2, [setf, [caadr, sys_iter], sys_value]], [t, [setf, [caaadr, sys_iter], sys_value]]]]).
8908wl:arglist_info(sys_seq_set, f_sys_seq_set1, [sequence, sys_iter, sys_value], arginfo{all:[sequence, sys_iter, sys_value], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sequence, sys_iter, sys_value], opt:0, req:[sequence, sys_iter, sys_value], rest:0, sublists:0, whole:0}).
8909wl: init_args(3, f_sys_seq_set1).
8910
8915f_sys_seq_set1(Sequence_In228, Iter_In229, Value_In, RestNKeys227, FnResult226) :-
8916 GEnv1654=[bv(sequence, Sequence_In228), bv(sys_iter, Iter_In229), bv(sys_value, Value_In)],
8917 catch(( ( get_var(GEnv1654, sys_iter, Iter_Get231),
8918 f_car(Iter_Get231, Key232),
8919 f_sys_memq(Key232, [0, 1], IFTEST233),
8920 ( IFTEST233\==[]
8921 -> get_var(GEnv1654, sequence, Sequence_Get237),
8922 get_var(GEnv1654, sys_iter, Iter_Get239),
8923 get_var(GEnv1654, sys_value, Value_Get),
8924 f_cdr(Iter_Get239, Cdr_Ret1736),
8925 f_svref(Sequence_Get237,
8926 Cdr_Ret1736,
8927 Value_Get,
8928 TrueResult253),
8929 _70132=TrueResult253
8930 ; ( is_eq(Key232, 2)
8931 -> get_var(GEnv1654, sys_iter, Iter_Get245),
8932 get_var(GEnv1654, sys_value, Value_Get246),
8933 f_sys_pf_set_caadr(Iter_Get245,
8934 Value_Get246,
8935 TrueResult251),
8936 ElseResult254=TrueResult251
8937 ; get_var(GEnv1654, sys_iter, Iter_Get249),
8938 get_var(GEnv1654, sys_value, Value_Get250),
8939 f_sys_pf_set_caaadr(Iter_Get249,
8940 Value_Get250,
8941 ElseResult252),
8942 ElseResult254=ElseResult252
8943 ),
8944 _70132=ElseResult254
8945 )
8946 ),
8947 _70132=FnResult226
8948 ),
8949 block_exit(sys_seq_set, FnResult226),
8950 true).
8951wl:lambda_def(defun, sys_seq_end_p, f_sys_seq_end_p1, [sequence, sys_iter, c38_key, sys_start, sys_end, sys_from_end], [[case, [car, sys_iter], [0, [or, [=, [cdr, sys_iter], [length, sequence]], [and, sys_end, [=, sys_end, [cdr, sys_iter]]]]], [1, [<, [cdr, sys_iter], sys_start]], [2, [or, [null, [cadr, sys_iter]], [and, sys_end, [=, sys_end, [caddr, sys_iter]]]]], [t, [or, [null, [cadr, sys_iter]], [<, [caddr, sys_iter], sys_start]]]]]).
8952wl:arglist_info(sys_seq_end_p, f_sys_seq_end_p1, [sequence, sys_iter, c38_key, sys_start, sys_end, sys_from_end], arginfo{all:[sequence, sys_iter], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_start, sys_end, sys_from_end], names:[sequence, sys_iter, sys_start, sys_end, sys_from_end], opt:0, req:[sequence, sys_iter], rest:0, sublists:0, whole:0}).
8953wl: init_args(2, f_sys_seq_end_p1).
8954
8959f_sys_seq_end_p1(Sequence_In261, Iter_In262, RestNKeys257, FnResult256) :-
8960 GEnv1655=[bv(sequence, Sequence_In261), bv(sys_iter, Iter_In262), bv(sys_start, Start_In263), bv(sys_end, End_In264), bv(sys_from_end, From_end_In265)],
8961 get_kw(Env,
8962 RestNKeys257,
8963 sys_start,
8964 sys_start,
8965 Start_In263,
8966 []=Start_In263,
8967 Start_P260),
8968 get_kw(Env,
8969 RestNKeys257,
8970 sys_end,
8971 sys_end,
8972 End_In264,
8973 []=End_In264,
8974 End_P259),
8975 get_kw(Env,
8976 RestNKeys257,
8977 sys_from_end,
8978 sys_from_end,
8979 From_end_In265,
8980 []=From_end_In265,
8981 From_end_P258),
8982 catch(( ( get_var(GEnv1655, sys_iter, Iter_Get266),
8983 f_car(Iter_Get266, Key267),
8984 ( is_eq(Key267, 0)
8985 -> ( get_var(GEnv1655, sys_iter, Iter_Get271),
8986 f_cdr(Iter_Get271, Cdr_Ret1737),
8987 get_var(GEnv1655, sequence, Sequence_Get272),
8988 f_length(Sequence_Get272, Length_Ret),
8989 'f_='(Cdr_Ret1737, Length_Ret, FORM1_Res279),
8990 FORM1_Res279\==[],
8991 TrueResult302=FORM1_Res279
8992 -> true
8993 ; get_var(GEnv1655, sys_end, IFTEST273),
8994 ( IFTEST273\==[]
8995 -> get_var(GEnv1655, sys_end, End_Get276),
8996 get_var(GEnv1655, sys_iter, Iter_Get277),
8997 f_cdr(Iter_Get277, Cdr_Ret1739),
8998 'f_='(End_Get276, Cdr_Ret1739, TrueResult278),
8999 _71250=TrueResult278
9000 ; _71250=[]
9001 ),
9002 TrueResult302=_71250
9003 ),
9004 _71064=TrueResult302
9005 ; ( is_eq(Key267, 1)
9006 -> get_var(GEnv1655, sys_iter, Iter_Get282),
9007 f_cdr(Iter_Get282, Cdr_Ret1740),
9008 get_var(GEnv1655, sys_start, Start_Get283),
9009 'f_<'(Cdr_Ret1740, Start_Get283, TrueResult300),
9010 ElseResult303=TrueResult300
9011 ; ( is_eq(Key267, 2)
9012 -> ( get_var(GEnv1655, sys_iter, Iter_Get286),
9013 f_cadr(Iter_Get286, Null_Param),
9014 f_null(Null_Param, FORM1_Res293),
9015 FORM1_Res293\==[],
9016 TrueResult298=FORM1_Res293
9017 -> true
9018 ; get_var(GEnv1655, sys_end, IFTEST287),
9019 ( IFTEST287\==[]
9020 -> get_var(GEnv1655, sys_end, End_Get290),
9021 get_var(GEnv1655, sys_iter, Iter_Get291),
9022 f_caddr(Iter_Get291, Caddr_Ret1741),
9023 'f_='(End_Get290,
9024 Caddr_Ret1741,
9025 TrueResult292),
9026 _71618=TrueResult292
9027 ; _71618=[]
9028 ),
9029 TrueResult298=_71618
9030 ),
9031 ElseResult301=TrueResult298
9032 ; ( get_var(GEnv1655, sys_iter, Iter_Get294),
9033 f_cadr(Iter_Get294, Null_Param1687),
9034 f_null(Null_Param1687, FORM1_Res297),
9035 FORM1_Res297\==[],
9036 ElseResult299=FORM1_Res297
9037 -> true
9038 ; get_var(GEnv1655, sys_iter, Iter_Get295),
9039 f_caddr(Iter_Get295, Caddr_Ret1742),
9040 get_var(GEnv1655, sys_start, Start_Get296),
9041 'f_<'(Caddr_Ret1742, Start_Get296, _71838),
9042 ElseResult299=_71838
9043 ),
9044 ElseResult301=ElseResult299
9045 ),
9046 ElseResult303=ElseResult301
9047 ),
9048 _71064=ElseResult303
9049 )
9050 ),
9051 _71064=FnResult256
9052 ),
9053 block_exit(sys_seq_end_p, FnResult256),
9054 true).
9055wl:lambda_def(defun, sys_seq_result, f_sys_seq_result1, [sequence, sys_iter, sys_result], [[case, [car, sys_iter], [0, [make_array, [length, sys_result], kw_element_type, [array_element_type, sequence], kw_initial_contents, [reverse, sys_result]]], [1, [make_array, [length, sys_result], kw_element_type, [array_element_type, sequence], kw_initial_contents, sys_result]], [2, [reverse, sys_result]], [3, sys_result]]]).
9056wl:arglist_info(sys_seq_result, f_sys_seq_result1, [sequence, sys_iter, sys_result], arginfo{all:[sequence, sys_iter, sys_result], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sequence, sys_iter, sys_result], opt:0, req:[sequence, sys_iter, sys_result], rest:0, sublists:0, whole:0}).
9057wl: init_args(3, f_sys_seq_result1).
9058
9063f_sys_seq_result1(Sequence_In307, Iter_In308, Result_In, RestNKeys306, FnResult305) :-
9064 GEnv1656=[bv(sequence, Sequence_In307), bv(sys_iter, Iter_In308), bv(sys_result, Result_In)],
9065 catch(( ( get_var(GEnv1656, sys_iter, Iter_Get310),
9066 f_car(Iter_Get310, Key311),
9067 ( is_eq(Key311, 0)
9068 -> get_var(GEnv1656, sys_result, Result_Get),
9069 f_length(Result_Get, Length_Ret1743),
9070 get_var(GEnv1656, sequence, Sequence_Get316),
9071 f_array_element_type(Sequence_Get316, Element_type_Ret),
9072 get_var(GEnv1656, sys_result, Result_Get317),
9073 f_reverse(Result_Get317, Reverse_Ret),
9074 f_make_array(
9075 [ Length_Ret1743,
9076 kw_element_type,
9077 Element_type_Ret,
9078 kw_initial_contents,
9079 Reverse_Ret
9080 ],
9081 TrueResult335),
9082 _72224=TrueResult335
9083 ; ( is_eq(Key311, 1)
9084 -> get_var(GEnv1656, sys_result, Result_Get320),
9085 f_length(Result_Get320, Length_Ret1746),
9086 get_var(GEnv1656, sequence, Sequence_Get321),
9087 f_array_element_type(Sequence_Get321,
9088 Element_type_Ret1747),
9089 get_var(GEnv1656, sys_result, Result_Get322),
9090 f_make_array(
9091 [ Length_Ret1746,
9092 kw_element_type,
9093 Element_type_Ret1747,
9094 kw_initial_contents,
9095 Result_Get322
9096 ],
9097 TrueResult333),
9098 ElseResult336=TrueResult333
9099 ; ( is_eq(Key311, 2)
9100 -> get_var(GEnv1656, sys_result, Result_Get325),
9101 f_reverse(Result_Get325, TrueResult331),
9102 ElseResult334=TrueResult331
9103 ; ( is_eq(Key311, 3)
9104 -> get_var(GEnv1656, sys_result, Result_Get328),
9105 ElseResult332=Result_Get328
9106 ; ElseResult330=[],
9107 ElseResult332=ElseResult330
9108 ),
9109 ElseResult334=ElseResult332
9110 ),
9111 ElseResult336=ElseResult334
9112 ),
9113 _72224=ElseResult336
9114 )
9115 ),
9116 _72224=FnResult305
9117 ),
9118 block_exit(sys_seq_result, FnResult305),
9119 true).
9120wl:lambda_def(defun, subst, f_subst, [sys_new, sys_old, sys_tree, c38_rest, rest], [[if, [consp, sys_tree], [let, [[sys_a, [apply, function(subst), sys_new, sys_old, [car, sys_tree], rest]], [sys_d, [apply, function(subst), sys_new, sys_old, [cdr, sys_tree], rest]]], [if, [and, [eq, sys_a, [car, sys_tree]], [eq, sys_d, [cdr, sys_tree]]], sys_tree, [cons, sys_a, sys_d]]], [if, [apply, function(satisfies), sys_old, sys_tree, rest], sys_new, sys_tree]]]).
9121wl:arglist_info(subst, f_subst, [sys_new, sys_old, sys_tree, c38_rest, rest], arginfo{all:[sys_new, sys_old, sys_tree], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_new, sys_old, sys_tree, rest], opt:0, req:[sys_new, sys_old, sys_tree], rest:[rest], sublists:0, whole:0}).
9122wl: init_args(3, f_subst).
9123
9128f_subst(New_In, Old_In, Tree_In, RestNKeys339, FnResult338) :-
9129 GEnv1657=[bv(sys_new, New_In), bv(sys_old, Old_In), bv(sys_tree, Tree_In), bv(rest, RestNKeys339)],
9130 catch(( ( get_var(GEnv1657, sys_tree, Tree_Get),
9131 ( c0nz:is_consp(Tree_Get)
9132 -> get_var(GEnv1657, sys_new, New_Get),
9133 get_var(GEnv1657, sys_old, Old_Get),
9134 get_var(GEnv1657, sys_tree, Tree_Get353),
9135 f_car(Tree_Get353, Car_Ret),
9136 get_var(GEnv1657, rest, Rest_Get),
9137 f_apply(f_subst,
9138 [New_Get, Old_Get, Car_Ret, Rest_Get],
9139 A_Init),
9140 get_var(GEnv1657, sys_new, New_Get355),
9141 get_var(GEnv1657, sys_old, Old_Get356),
9142 get_var(GEnv1657, sys_tree, Tree_Get357),
9143 f_cdr(Tree_Get357, Cdr_Ret1749),
9144 get_var(GEnv1657, rest, Rest_Get358),
9145 f_apply(f_subst,
9146 [New_Get355, Old_Get356, Cdr_Ret1749, Rest_Get358],
9147 D_Init),
9148 LEnv350=[bv(sys_a, A_Init), bv(sys_d, D_Init)|GEnv1657],
9149 get_var(LEnv350, sys_a, A_Get),
9150 get_var(LEnv350, sys_tree, Tree_Get365),
9151 f_car(Tree_Get365, PredArg2Result),
9152 ( is_eq(A_Get, PredArg2Result)
9153 -> get_var(LEnv350, sys_d, D_Get),
9154 get_var(LEnv350, sys_tree, Tree_Get370),
9155 f_cdr(Tree_Get370, Cdr_Ret1750),
9156 f_eq(D_Get, Cdr_Ret1750, TrueResult371),
9157 IFTEST361=TrueResult371
9158 ; IFTEST361=[]
9159 ),
9160 ( IFTEST361\==[]
9161 -> get_var(LEnv350, sys_tree, Tree_Get372),
9162 LetResult349=Tree_Get372
9163 ; get_var(LEnv350, sys_a, A_Get373),
9164 get_var(LEnv350, sys_d, D_Get374),
9165 ElseResult376=[A_Get373|D_Get374],
9166 LetResult349=ElseResult376
9167 ),
9168 _73036=LetResult349
9169 ; ( get_var(GEnv1657, rest, Rest_Get381),
9170 get_var(GEnv1657, sys_old, Old_Get379)
9171 ),
9172 get_var(GEnv1657, sys_tree, Tree_Get380),
9173 f_apply(f_satisfies1,
9174 [Old_Get379, Tree_Get380, Rest_Get381],
9175 IFTEST377),
9176 ( IFTEST377\==[]
9177 -> get_var(GEnv1657, sys_new, New_Get382),
9178 ElseResult387=New_Get382
9179 ; get_var(GEnv1657, sys_tree, Tree_Get383),
9180 ElseResult387=Tree_Get383
9181 ),
9182 _73036=ElseResult387
9183 )
9184 ),
9185 _73036=FnResult338
9186 ),
9187 block_exit(subst, FnResult338),
9188 true).
9189:- set_opv(subst, symbol_function, f_subst),
9190 DefunResult=subst,
9191 assert_lsp(subst_if,
9192 wl:lambda_def(defun, subst_if, f_subst_if, [sys_new, sys_predicate, sys_tree, c38_rest, rest], [[if, [consp, sys_tree], [let, [[sys_a, [apply, function(subst), sys_new, sys_predicate, [car, sys_tree], rest]], [sys_d, [apply, function(subst), sys_new, sys_predicate, [cdr, sys_tree], rest]]], [if, [and, [eq, sys_a, [car, sys_tree]], [eq, sys_d, [cdr, sys_tree]]], sys_tree, [cons, sys_a, sys_d]]], [if, [apply, function(sys_satisfies_if), sys_predicate, sys_tree, rest], sys_new, sys_tree]]])),
9193 assert_lsp(subst_if,
9194 wl:arglist_info(subst_if, f_subst_if, [sys_new, sys_predicate, sys_tree, c38_rest, rest], arginfo{all:[sys_new, sys_predicate, sys_tree], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_new, sys_predicate, sys_tree, rest], opt:0, req:[sys_new, sys_predicate, sys_tree], rest:[rest], sublists:0, whole:0})),
9195 assert_lsp(subst_if, wl:init_args(3, f_subst_if)),
9196 assert_lsp(subst_if,
9197 (f_subst_if(New_In392, Predicate_In393, Tree_In394, RestNKeys391, FnResult390):-GEnv1658=[bv(sys_new, New_In392), bv(sys_predicate, Predicate_In393), bv(sys_tree, Tree_In394), bv(rest, RestNKeys391)], catch(((get_var(GEnv1658, sys_tree, Tree_Get397), (c0nz:is_consp(Tree_Get397)->get_var(GEnv1658, sys_new, New_Get403), get_var(GEnv1658, sys_predicate, Predicate_Get404), get_var(GEnv1658, sys_tree, Tree_Get405), f_car(Tree_Get405, Car_Ret1751), get_var(GEnv1658, rest, Rest_Get406), f_apply(f_subst, [New_Get403, Predicate_Get404, Car_Ret1751, Rest_Get406], A_Init411), get_var(GEnv1658, sys_new, New_Get407), get_var(GEnv1658, sys_predicate, Predicate_Get408), get_var(GEnv1658, sys_tree, Tree_Get409), f_cdr(Tree_Get409, Cdr_Ret1752), get_var(GEnv1658, rest, Rest_Get410), f_apply(f_subst, [New_Get407, Predicate_Get408, Cdr_Ret1752, Rest_Get410], D_Init412), LEnv402=[bv(sys_a, A_Init411), bv(sys_d, D_Init412)|GEnv1658], get_var(LEnv402, sys_a, A_Get416), get_var(LEnv402, sys_tree, Tree_Get417), f_car(Tree_Get417, PredArg2Result420), (is_eq(A_Get416, PredArg2Result420)->get_var(LEnv402, sys_d, D_Get421), get_var(LEnv402, sys_tree, Tree_Get422), f_cdr(Tree_Get422, Cdr_Ret1753), f_eq(D_Get421, Cdr_Ret1753, TrueResult423), IFTEST413=TrueResult423;IFTEST413=[]), (IFTEST413\==[]->get_var(LEnv402, sys_tree, Tree_Get424), LetResult401=Tree_Get424;get_var(LEnv402, sys_a, A_Get425), get_var(LEnv402, sys_d, D_Get426), ElseResult428=[A_Get425|D_Get426], LetResult401=ElseResult428), _74228=LetResult401;(get_var(GEnv1658, rest, Rest_Get433), get_var(GEnv1658, sys_predicate, Predicate_Get431)), get_var(GEnv1658, sys_tree, Tree_Get432), f_apply(f_sys_satisfies_if1, [Predicate_Get431, Tree_Get432, Rest_Get433], IFTEST429), (IFTEST429\==[]->get_var(GEnv1658, sys_new, New_Get434), ElseResult439=New_Get434;get_var(GEnv1658, sys_tree, Tree_Get435), ElseResult439=Tree_Get435), _74228=ElseResult439)), _74228=FnResult390), block_exit(subst_if, FnResult390), true))),
9198 set_opv(subst_if, symbol_function, f_subst_if),
9199 DefunResult441=subst_if,
9200 assert_lsp(subst_if_not,
9201 wl:lambda_def(defun, subst_if_not, f_subst_if_not, [sys_new, sys_predicate, sys_tree, c38_rest, rest], [[if, [consp, sys_tree], [let, [[sys_a, [apply, function(subst), sys_new, sys_predicate, [car, sys_tree], rest]], [sys_d, [apply, function(subst), sys_new, sys_predicate, [cdr, sys_tree], rest]]], [if, [and, [eq, sys_a, [car, sys_tree]], [eq, sys_d, [cdr, sys_tree]]], sys_tree, [cons, sys_a, sys_d]]], [if, [apply, function(sys_satisfies_if_not), sys_predicate, sys_tree, rest], sys_new, sys_tree]]])),
9202 assert_lsp(subst_if_not,
9203 wl:arglist_info(subst_if_not, f_subst_if_not, [sys_new, sys_predicate, sys_tree, c38_rest, rest], arginfo{all:[sys_new, sys_predicate, sys_tree], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_new, sys_predicate, sys_tree, rest], opt:0, req:[sys_new, sys_predicate, sys_tree], rest:[rest], sublists:0, whole:0})),
9204 assert_lsp(subst_if_not, wl:init_args(3, f_subst_if_not)),
9205 assert_lsp(subst_if_not,
9206 (f_subst_if_not(New_In444, Predicate_In445, Tree_In446, RestNKeys443, FnResult442):-GEnv1659=[bv(sys_new, New_In444), bv(sys_predicate, Predicate_In445), bv(sys_tree, Tree_In446), bv(rest, RestNKeys443)], catch(((get_var(GEnv1659, sys_tree, Tree_Get449), (c0nz:is_consp(Tree_Get449)->get_var(GEnv1659, sys_new, New_Get455), get_var(GEnv1659, sys_predicate, Predicate_Get456), get_var(GEnv1659, sys_tree, Tree_Get457), f_car(Tree_Get457, Car_Ret1754), get_var(GEnv1659, rest, Rest_Get458), f_apply(f_subst, [New_Get455, Predicate_Get456, Car_Ret1754, Rest_Get458], A_Init463), get_var(GEnv1659, sys_new, New_Get459), get_var(GEnv1659, sys_predicate, Predicate_Get460), get_var(GEnv1659, sys_tree, Tree_Get461), f_cdr(Tree_Get461, Cdr_Ret1755), get_var(GEnv1659, rest, Rest_Get462), f_apply(f_subst, [New_Get459, Predicate_Get460, Cdr_Ret1755, Rest_Get462], D_Init464), LEnv454=[bv(sys_a, A_Init463), bv(sys_d, D_Init464)|GEnv1659], get_var(LEnv454, sys_a, A_Get468), get_var(LEnv454, sys_tree, Tree_Get469), f_car(Tree_Get469, PredArg2Result472), (is_eq(A_Get468, PredArg2Result472)->get_var(LEnv454, sys_d, D_Get473), get_var(LEnv454, sys_tree, Tree_Get474), f_cdr(Tree_Get474, Cdr_Ret1756), f_eq(D_Get473, Cdr_Ret1756, TrueResult475), IFTEST465=TrueResult475;IFTEST465=[]), (IFTEST465\==[]->get_var(LEnv454, sys_tree, Tree_Get476), LetResult453=Tree_Get476;get_var(LEnv454, sys_a, A_Get477), get_var(LEnv454, sys_d, D_Get478), ElseResult480=[A_Get477|D_Get478], LetResult453=ElseResult480), _75526=LetResult453;(get_var(GEnv1659, rest, Rest_Get485), get_var(GEnv1659, sys_predicate, Predicate_Get483)), get_var(GEnv1659, sys_tree, Tree_Get484), f_apply(f_sys_satisfies_if_not1, [Predicate_Get483, Tree_Get484, Rest_Get485], IFTEST481), (IFTEST481\==[]->get_var(GEnv1659, sys_new, New_Get486), ElseResult491=New_Get486;get_var(GEnv1659, sys_tree, Tree_Get487), ElseResult491=Tree_Get487), _75526=ElseResult491)), _75526=FnResult442), block_exit(subst_if_not, FnResult442), true))),
9207 set_opv(subst_if_not, symbol_function, f_subst_if_not),
9208 DefunResult493=subst_if_not,
9209 assert_lsp(nsubst,
9210 wl:lambda_def(defun, nsubst, f_nsubst, [sys_new, sys_old, sys_tree, c38_rest, rest], [[if, [consp, sys_tree], [progn, [setf, [car, sys_tree], [apply, function(subst), sys_new, sys_old, [car, sys_tree], rest]], [setf, [cdr, sys_tree], [apply, function(subst), sys_new, sys_old, [cdr, sys_tree], rest]], sys_tree], [if, [apply, function(satisfies), sys_old, sys_tree, rest], sys_new, sys_tree]]])),
9211 assert_lsp(nsubst,
9212 wl:arglist_info(nsubst, f_nsubst, [sys_new, sys_old, sys_tree, c38_rest, rest], arginfo{all:[sys_new, sys_old, sys_tree], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_new, sys_old, sys_tree, rest], opt:0, req:[sys_new, sys_old, sys_tree], rest:[rest], sublists:0, whole:0})),
9213 assert_lsp(nsubst, wl:init_args(3, f_nsubst)),
9214 assert_lsp(nsubst,
9215 (f_nsubst(New_In496, Old_In497, Tree_In498, RestNKeys495, FnResult494):-GEnv1660=[bv(sys_new, New_In496), bv(sys_old, Old_In497), bv(sys_tree, Tree_In498), bv(rest, RestNKeys495)], catch(((get_var(GEnv1660, sys_tree, Tree_Get501), (c0nz:is_consp(Tree_Get501)->get_var(GEnv1660, sys_new, New_Get507), get_var(GEnv1660, sys_old, Old_Get508), get_var(GEnv1660, sys_tree, Tree_Get506), f_car(Tree_Get506, Car_Ret1757), get_var(GEnv1660, rest, Rest_Get510), f_apply(f_subst, [New_Get507, Old_Get508, Car_Ret1757, Rest_Get510], Apply_Ret1758), f_rplaca(Tree_Get506, Apply_Ret1758, Rplaca_Ret), get_var(GEnv1660, sys_new, New_Get514), get_var(GEnv1660, sys_old, Old_Get515), get_var(GEnv1660, sys_tree, Tree_Get513), f_cdr(Tree_Get513, Cdr_Ret1760), get_var(GEnv1660, rest, Rest_Get517), f_apply(f_subst, [New_Get514, Old_Get515, Cdr_Ret1760, Rest_Get517], Apply_Ret1761), f_rplacd(Tree_Get513, Apply_Ret1761, Rplacd_Ret), get_var(GEnv1660, sys_tree, Tree_Get518), _76824=Tree_Get518;(get_var(GEnv1660, rest, Rest_Get523), get_var(GEnv1660, sys_old, Old_Get521)), get_var(GEnv1660, sys_tree, Tree_Get522), f_apply(f_satisfies1, [Old_Get521, Tree_Get522, Rest_Get523], IFTEST519), (IFTEST519\==[]->get_var(GEnv1660, sys_new, New_Get524), ElseResult529=New_Get524;get_var(GEnv1660, sys_tree, Tree_Get525), ElseResult529=Tree_Get525), _76824=ElseResult529)), _76824=FnResult494), block_exit(nsubst, FnResult494), true))),
9216 set_opv(nsubst, symbol_function, f_nsubst),
9217 DefunResult531=nsubst,
9218 assert_lsp(nsubst_if,
9219 wl:lambda_def(defun, nsubst_if, f_nsubst_if, [sys_new, sys_predicate, sys_tree, c38_rest, rest], [[if, [consp, sys_tree], [progn, [setf, [car, sys_tree], [apply, function(subst), sys_new, sys_predicate, [car, sys_tree], rest]], [setf, [cdr, sys_tree], [apply, function(subst), sys_new, sys_predicate, [cdr, sys_tree], rest]], sys_tree], [if, [apply, function(sys_satisfies_if), sys_predicate, sys_tree, rest], sys_new, sys_tree]]])),
9220 assert_lsp(nsubst_if,
9221 wl:arglist_info(nsubst_if, f_nsubst_if, [sys_new, sys_predicate, sys_tree, c38_rest, rest], arginfo{all:[sys_new, sys_predicate, sys_tree], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_new, sys_predicate, sys_tree, rest], opt:0, req:[sys_new, sys_predicate, sys_tree], rest:[rest], sublists:0, whole:0})),
9222 assert_lsp(nsubst_if, wl:init_args(3, f_nsubst_if)),
9223 assert_lsp(nsubst_if,
9224 (f_nsubst_if(New_In534, Predicate_In535, Tree_In536, RestNKeys533, FnResult532):-GEnv1661=[bv(sys_new, New_In534), bv(sys_predicate, Predicate_In535), bv(sys_tree, Tree_In536), bv(rest, RestNKeys533)], catch(((get_var(GEnv1661, sys_tree, Tree_Get539), (c0nz:is_consp(Tree_Get539)->get_var(GEnv1661, sys_new, New_Get545), get_var(GEnv1661, sys_predicate, Predicate_Get546), get_var(GEnv1661, sys_tree, Tree_Get544), f_car(Tree_Get544, Car_Ret1763), get_var(GEnv1661, rest, Rest_Get548), f_apply(f_subst, [New_Get545, Predicate_Get546, Car_Ret1763, Rest_Get548], Apply_Ret1764), f_rplaca(Tree_Get544, Apply_Ret1764, Rplaca_Ret1765), get_var(GEnv1661, sys_new, New_Get552), get_var(GEnv1661, sys_predicate, Predicate_Get553), get_var(GEnv1661, sys_tree, Tree_Get551), f_cdr(Tree_Get551, Cdr_Ret1766), get_var(GEnv1661, rest, Rest_Get555), f_apply(f_subst, [New_Get552, Predicate_Get553, Cdr_Ret1766, Rest_Get555], Apply_Ret1767), f_rplacd(Tree_Get551, Apply_Ret1767, Rplacd_Ret1768), get_var(GEnv1661, sys_tree, Tree_Get556), _77800=Tree_Get556;(get_var(GEnv1661, rest, Rest_Get561), get_var(GEnv1661, sys_predicate, Predicate_Get559)), get_var(GEnv1661, sys_tree, Tree_Get560), f_apply(f_sys_satisfies_if1, [Predicate_Get559, Tree_Get560, Rest_Get561], IFTEST557), (IFTEST557\==[]->get_var(GEnv1661, sys_new, New_Get562), ElseResult567=New_Get562;get_var(GEnv1661, sys_tree, Tree_Get563), ElseResult567=Tree_Get563), _77800=ElseResult567)), _77800=FnResult532), block_exit(nsubst_if, FnResult532), true))),
9225 set_opv(nsubst_if, symbol_function, f_nsubst_if),
9226 DefunResult569=nsubst_if,
9227 assert_lsp(nsubst_if_not,
9228 wl:lambda_def(defun, nsubst_if_not, f_nsubst_if_not, [sys_new, sys_predicate, sys_tree, c38_rest, rest], [[if, [consp, sys_tree], [progn, [setf, [car, sys_tree], [apply, function(subst), sys_new, sys_predicate, [car, sys_tree], rest]], [setf, [cdr, sys_tree], [apply, function(subst), sys_new, sys_predicate, [cdr, sys_tree], rest]], sys_tree], [if, [apply, function(sys_satisfies_if_not), sys_predicate, sys_tree, rest], sys_new, sys_tree]]])),
9229 assert_lsp(nsubst_if_not,
9230 wl:arglist_info(nsubst_if_not, f_nsubst_if_not, [sys_new, sys_predicate, sys_tree, c38_rest, rest], arginfo{all:[sys_new, sys_predicate, sys_tree], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_new, sys_predicate, sys_tree, rest], opt:0, req:[sys_new, sys_predicate, sys_tree], rest:[rest], sublists:0, whole:0})),
9231 assert_lsp(nsubst_if_not, wl:init_args(3, f_nsubst_if_not)),
9232 assert_lsp(nsubst_if_not,
9233 (f_nsubst_if_not(New_In572, Predicate_In573, Tree_In574, RestNKeys571, FnResult570):-GEnv1662=[bv(sys_new, New_In572), bv(sys_predicate, Predicate_In573), bv(sys_tree, Tree_In574), bv(rest, RestNKeys571)], catch(((get_var(GEnv1662, sys_tree, Tree_Get577), (c0nz:is_consp(Tree_Get577)->get_var(GEnv1662, sys_new, New_Get583), get_var(GEnv1662, sys_predicate, Predicate_Get584), get_var(GEnv1662, sys_tree, Tree_Get582), f_car(Tree_Get582, Car_Ret1769), get_var(GEnv1662, rest, Rest_Get586), f_apply(f_subst, [New_Get583, Predicate_Get584, Car_Ret1769, Rest_Get586], Apply_Ret1770), f_rplaca(Tree_Get582, Apply_Ret1770, Rplaca_Ret1771), get_var(GEnv1662, sys_new, New_Get590), get_var(GEnv1662, sys_predicate, Predicate_Get591), get_var(GEnv1662, sys_tree, Tree_Get589), f_cdr(Tree_Get589, Cdr_Ret1772), get_var(GEnv1662, rest, Rest_Get593), f_apply(f_subst, [New_Get590, Predicate_Get591, Cdr_Ret1772, Rest_Get593], Apply_Ret1773), f_rplacd(Tree_Get589, Apply_Ret1773, Rplacd_Ret1774), get_var(GEnv1662, sys_tree, Tree_Get594), _78776=Tree_Get594;(get_var(GEnv1662, rest, Rest_Get599), get_var(GEnv1662, sys_predicate, Predicate_Get597)), get_var(GEnv1662, sys_tree, Tree_Get598), f_apply(f_sys_satisfies_if_not1, [Predicate_Get597, Tree_Get598, Rest_Get599], IFTEST595), (IFTEST595\==[]->get_var(GEnv1662, sys_new, New_Get600), ElseResult605=New_Get600;get_var(GEnv1662, sys_tree, Tree_Get601), ElseResult605=Tree_Get601), _78776=ElseResult605)), _78776=FnResult570), block_exit(nsubst_if_not, FnResult570), true))),
9234 set_opv(nsubst_if_not, symbol_function, f_nsubst_if_not),
9235 DefunResult607=nsubst_if_not,
9236 assert_lsp(assoc_if,
9237 wl:lambda_def(defun, assoc_if, f_assoc_if, [sys_predicate, sys_alist, c38_rest, rest], [[dolist, [sys_elem, sys_alist], [when, [apply, function(sys_satisfies_if), sys_predicate, [car, sys_elem], rest], [return_from, assoc_if, sys_elem]]]])),
9238 assert_lsp(assoc_if,
9239 wl:arglist_info(assoc_if, f_assoc_if, [sys_predicate, sys_alist, c38_rest, rest], arginfo{all:[sys_predicate, sys_alist], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_predicate, sys_alist, rest], opt:0, req:[sys_predicate, sys_alist], rest:[rest], sublists:0, whole:0})),
9240 assert_lsp(assoc_if, wl:init_args(2, f_assoc_if)),
9241 assert_lsp(assoc_if,
9242 (f_assoc_if(Predicate_In610, Alist_In, RestNKeys609, FnResult608):-GEnv1663=[bv(sys_predicate, Predicate_In610), bv(sys_alist, Alist_In), bv(rest, RestNKeys609)], catch(((get_var(GEnv1663, sys_alist, Alist_Get), BV=bv(sys_elem, Ele), BlockExitEnv=[BV|GEnv1663], forall(member(Ele, Alist_Get), (nb_setarg(2, BV, Ele), get_var(BlockExitEnv, sys_elem, Elem_Get617), get_var(BlockExitEnv, sys_predicate, Predicate_Get616), f_car(Elem_Get617, Car_Ret1775), get_var(BlockExitEnv, rest, Rest_Get618), f_apply(f_sys_satisfies_if1, [Predicate_Get616, Car_Ret1775, Rest_Get618], IFTEST614), (IFTEST614\==[]->get_var(BlockExitEnv, sys_elem, Elem_Get621), throw(block_exit(assoc_if, Elem_Get621)), _79710=ThrowResult;_79710=[])))), _79710=FnResult608), block_exit(assoc_if, FnResult608), true))),
9243 set_opv(assoc_if, symbol_function, f_assoc_if),
9244 DefunResult629=assoc_if,
9245 assert_lsp(assoc_if_not,
9246 wl:lambda_def(defun, assoc_if_not, f_assoc_if_not, [sys_predicate, sys_alist, c38_rest, rest], [[dolist, [sys_elem, sys_alist], [when, [apply, function(sys_satisfies_if_not), sys_predicate, [car, sys_elem], rest], [return_from, assoc_if_not, sys_elem]]]])),
9247 assert_lsp(assoc_if_not,
9248 wl:arglist_info(assoc_if_not, f_assoc_if_not, [sys_predicate, sys_alist, c38_rest, rest], arginfo{all:[sys_predicate, sys_alist], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_predicate, sys_alist, rest], opt:0, req:[sys_predicate, sys_alist], rest:[rest], sublists:0, whole:0})),
9249 assert_lsp(assoc_if_not, wl:init_args(2, f_assoc_if_not)),
9250 assert_lsp(assoc_if_not,
9251 (f_assoc_if_not(Predicate_In632, Alist_In633, RestNKeys631, FnResult630):-GEnv1664=[bv(sys_predicate, Predicate_In632), bv(sys_alist, Alist_In633), bv(rest, RestNKeys631)], catch(((get_var(GEnv1664, sys_alist, Alist_Get635), BV646=bv(sys_elem, Ele648), BlockExitEnv644=[BV646|GEnv1664], forall(member(Ele648, Alist_Get635), (nb_setarg(2, BV646, Ele648), get_var(BlockExitEnv644, sys_elem, Elem_Get639), get_var(BlockExitEnv644, sys_predicate, Predicate_Get638), f_car(Elem_Get639, Car_Ret1776), get_var(BlockExitEnv644, rest, Rest_Get640), f_apply(f_sys_satisfies_if_not1, [Predicate_Get638, Car_Ret1776, Rest_Get640], IFTEST636), (IFTEST636\==[]->get_var(BlockExitEnv644, sys_elem, RetResult641), throw(block_exit(assoc_if_not, RetResult641)), _80202=ThrowResult642;_80202=[])))), _80202=FnResult630), block_exit(assoc_if_not, FnResult630), true))),
9252 set_opv(assoc_if_not, symbol_function, f_assoc_if_not),
9253 DefunResult651=assoc_if_not,
9254 assert_lsp(rassoc,
9255 wl:lambda_def(defun, rassoc, f_rassoc, [sys_item, sys_alist, c38_rest, rest], [[dolist, [sys_elem, sys_alist], [when, [apply, function(satisfies), sys_item, [cdr, sys_elem], rest], [return_from, rassoc, sys_elem]]]])),
9256 assert_lsp(rassoc,
9257 wl:arglist_info(rassoc, f_rassoc, [sys_item, sys_alist, c38_rest, rest], arginfo{all:[sys_item, sys_alist], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_item, sys_alist, rest], opt:0, req:[sys_item, sys_alist], rest:[rest], sublists:0, whole:0})),
9258 assert_lsp(rassoc, wl:init_args(2, f_rassoc)),
9259 assert_lsp(rassoc,
9260 (f_rassoc(Item_In, Alist_In655, RestNKeys653, FnResult652):-GEnv1665=[bv(sys_item, Item_In), bv(sys_alist, Alist_In655), bv(rest, RestNKeys653)], catch(((get_var(GEnv1665, sys_alist, Alist_Get657), BV668=bv(sys_elem, Ele670), BlockExitEnv666=[BV668|GEnv1665], forall(member(Ele670, Alist_Get657), (nb_setarg(2, BV668, Ele670), get_var(BlockExitEnv666, sys_elem, Elem_Get661), get_var(BlockExitEnv666, sys_item, Item_Get), f_cdr(Elem_Get661, Cdr_Ret1777), get_var(BlockExitEnv666, rest, Rest_Get662), f_apply(f_satisfies1, [Item_Get, Cdr_Ret1777, Rest_Get662], IFTEST658), (IFTEST658\==[]->get_var(BlockExitEnv666, sys_elem, RetResult663), throw(block_exit(rassoc, RetResult663)), _80728=ThrowResult664;_80728=[])))), _80728=FnResult652), block_exit(rassoc, FnResult652), true))),
9261 set_opv(rassoc, symbol_function, f_rassoc),
9262 DefunResult673=rassoc,
9263 assert_lsp(rassoc_if,
9264 wl:lambda_def(defun, rassoc_if, f_rassoc_if, [sys_predicate, sys_alist, c38_rest, rest], [[dolist, [sys_elem, sys_alist], [when, [apply, function(sys_satisfies_if), sys_predicate, [cdr, sys_elem], rest], [return_from, rassoc_if, sys_elem]]]])),
9265 assert_lsp(rassoc_if,
9266 wl:arglist_info(rassoc_if, f_rassoc_if, [sys_predicate, sys_alist, c38_rest, rest], arginfo{all:[sys_predicate, sys_alist], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_predicate, sys_alist, rest], opt:0, req:[sys_predicate, sys_alist], rest:[rest], sublists:0, whole:0})),
9267 assert_lsp(rassoc_if, wl:init_args(2, f_rassoc_if)),
9268 assert_lsp(rassoc_if,
9269 (f_rassoc_if(Predicate_In676, Alist_In677, RestNKeys675, FnResult674):-GEnv1666=[bv(sys_predicate, Predicate_In676), bv(sys_alist, Alist_In677), bv(rest, RestNKeys675)], catch(((get_var(GEnv1666, sys_alist, Alist_Get679), BV690=bv(sys_elem, Ele692), BlockExitEnv688=[BV690|GEnv1666], forall(member(Ele692, Alist_Get679), (nb_setarg(2, BV690, Ele692), get_var(BlockExitEnv688, sys_elem, Elem_Get683), get_var(BlockExitEnv688, sys_predicate, Predicate_Get682), f_cdr(Elem_Get683, Cdr_Ret1778), get_var(BlockExitEnv688, rest, Rest_Get684), f_apply(f_sys_satisfies_if1, [Predicate_Get682, Cdr_Ret1778, Rest_Get684], IFTEST680), (IFTEST680\==[]->get_var(BlockExitEnv688, sys_elem, RetResult685), throw(block_exit(rassoc_if, RetResult685)), _81256=ThrowResult686;_81256=[])))), _81256=FnResult674), block_exit(rassoc_if, FnResult674), true))),
9270 set_opv(rassoc_if, symbol_function, f_rassoc_if),
9271 DefunResult695=rassoc_if,
9272 assert_lsp(rassoc_if_not,
9273 wl:lambda_def(defun, rassoc_if_not, f_rassoc_if_not, [sys_predicate, sys_alist, c38_rest, rest], [[dolist, [sys_elem, sys_alist], [when, [apply, function(sys_satisfies_if_not), sys_predicate, [cdr, sys_elem], rest], [return_from, rassoc_if_not, sys_elem]]]])),
9274 assert_lsp(rassoc_if_not,
9275 wl:arglist_info(rassoc_if_not, f_rassoc_if_not, [sys_predicate, sys_alist, c38_rest, rest], arginfo{all:[sys_predicate, sys_alist], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_predicate, sys_alist, rest], opt:0, req:[sys_predicate, sys_alist], rest:[rest], sublists:0, whole:0})),
9276 assert_lsp(rassoc_if_not, wl:init_args(2, f_rassoc_if_not)),
9277 assert_lsp(rassoc_if_not,
9278 (f_rassoc_if_not(Predicate_In698, Alist_In699, RestNKeys697, FnResult696):-GEnv1667=[bv(sys_predicate, Predicate_In698), bv(sys_alist, Alist_In699), bv(rest, RestNKeys697)], catch(((get_var(GEnv1667, sys_alist, Alist_Get701), BV712=bv(sys_elem, Ele714), BlockExitEnv710=[BV712|GEnv1667], forall(member(Ele714, Alist_Get701), (nb_setarg(2, BV712, Ele714), get_var(BlockExitEnv710, sys_elem, Elem_Get705), get_var(BlockExitEnv710, sys_predicate, Predicate_Get704), f_cdr(Elem_Get705, Cdr_Ret1779), get_var(BlockExitEnv710, rest, Rest_Get706), f_apply(f_sys_satisfies_if_not1, [Predicate_Get704, Cdr_Ret1779, Rest_Get706], IFTEST702), (IFTEST702\==[]->get_var(BlockExitEnv710, sys_elem, RetResult707), throw(block_exit(rassoc_if_not, RetResult707)), _81796=ThrowResult708;_81796=[])))), _81796=FnResult696), block_exit(rassoc_if_not, FnResult696), true))),
9279 set_opv(rassoc_if_not, symbol_function, f_rassoc_if_not),
9280 DefunResult717=rassoc_if_not,
9281 assert_lsp(adjoin,
9282 wl:lambda_def(defun, adjoin, f_adjoin, [sys_item, list, c38_rest, rest], [[dolist, [sys_elem, list, [cons, sys_item, list]], [when, [apply, function(satisfies), sys_item, sys_elem, rest], [return_from, adjoin, list]]]])),
9283 assert_lsp(adjoin,
9284 wl:arglist_info(adjoin, f_adjoin, [sys_item, list, c38_rest, rest], arginfo{all:[sys_item, list], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_item, list, rest], opt:0, req:[sys_item, list], rest:[rest], sublists:0, whole:0})),
9285 assert_lsp(adjoin, wl:init_args(2, f_adjoin)),
9286 assert_lsp(adjoin,
9287 (f_adjoin(Item_In720, List_In, RestNKeys719, FnResult718):-CDR1780=[bv(sys_item, Item_In720), bv(list, List_In), bv(rest, RestNKeys719)], catch(((LEnv725=[bv([cons, sys_item, list], [])|CDR1780], get_var(LEnv725, list, List_Get), BV737=bv(sys_elem, Ele739), BlockExitEnv735=[BV737|LEnv725], forall(member(Ele739, List_Get), (nb_setarg(2, BV737, Ele739), get_var(BlockExitEnv735, sys_elem, Elem_Get730), (get_var(BlockExitEnv735, rest, Rest_Get731), get_var(BlockExitEnv735, sys_item, Item_Get729)), f_apply(f_satisfies1, [Item_Get729, Elem_Get730, Rest_Get731], IFTEST727), (IFTEST727\==[]->get_var(BlockExitEnv735, list, RetResult732), throw(block_exit(adjoin, RetResult732)), _82406=ThrowResult733;_82406=[]))), get_var(LEnv725, list, List_Get742), get_var(LEnv725, sys_item, Item_Get741), LetResult724=[Item_Get741|List_Get742]), LetResult724=FnResult718), block_exit(adjoin, FnResult718), true))),
9288 set_opv(adjoin, symbol_function, f_adjoin),
9289 DefunResult744=adjoin,
9290 assert_lsp(set_exclusive_or,
9291 wl:lambda_def(defun, set_exclusive_or, f_set_exclusive_or, [sys_list_1, sys_list_2, c38_rest, rest, c38_key, key], [[let, [[sys_result, []]], [dolist, [sys_item, sys_list_1], [unless, [apply, function(member), [if, key, [funcall, key, sys_item], sys_item], sys_list_2, rest], [push, sys_item, sys_result]]], [dolist, [sys_item, sys_list_2], [block, sys_matches, [dolist, [sys_elem, sys_list_1], [when, [apply, function(satisfies), [if, key, [funcall, key, sys_elem], sys_elem], sys_item, rest], [return_from, sys_matches]]], [push, sys_item, sys_result]]], sys_result]])),
9292 assert_lsp(set_exclusive_or,
9293 wl:arglist_info(set_exclusive_or, f_set_exclusive_or, [sys_list_1, sys_list_2, c38_rest, rest, c38_key, key], arginfo{all:[sys_list_1, sys_list_2], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:[key], names:[sys_list_1, sys_list_2, rest, key], opt:0, req:[sys_list_1, sys_list_2], rest:[rest], sublists:0, whole:0})),
9294 assert_lsp(set_exclusive_or, wl:init_args(2, f_set_exclusive_or)),
9295 assert_lsp(set_exclusive_or,
9296 (f_set_exclusive_or(List_1_In, List_2_In, RestNKeys746, FnResult745):-CDR1781=[bv(sys_list_1, List_1_In), bv(sys_list_2, List_2_In), bv(rest, RestNKeys746), bv(key, Key_In751)], get_kw([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)]|Env], RestNKeys746, key, key, Key_In751, []=Key_In751, Key_P747), catch(((LEnv754=[bv(sys_result, [])|CDR1781], get_var(LEnv754, sys_list_1, List_1_Get), BV772=bv(sys_item, Ele774), AEnv768=[BV772|LEnv754], forall(member(Ele774, List_1_Get), (nb_setarg(2, BV772, Ele774), get_var(AEnv768, key, IFTEST758), (IFTEST758\==[]->get_var(AEnv768, key, Key_Get761), get_var(AEnv768, sys_item, Item_Get762), f_apply(Key_Get761, [Item_Get762], TrueResult764), CAR1782=TrueResult764;get_var(AEnv768, sys_item, Item_Get763), CAR1782=Item_Get763), get_var(AEnv768, rest, Rest_Get767), get_var(AEnv768, sys_list_2, List_2_Get), f_apply(f_member, [CAR1782, List_2_Get, Rest_Get767], IFTEST756), (IFTEST756\==[]->_83110=[];get_var(AEnv768, sys_item, Item_Get769), get_var(AEnv768, sys_result, Result_Get770), ElseResult771=[Item_Get769|Result_Get770], set_var(AEnv768, sys_result, ElseResult771), _83110=ElseResult771))), get_var(LEnv754, sys_list_2, List_2_Get776), BV800=bv(sys_item, Ele802), AEnv797=[BV800|LEnv754], forall(member(Ele802, List_2_Get776), (nb_setarg(2, BV800, Ele802), catch(((get_var(AEnv797, sys_list_1, List_1_Get777), BV793=bv(sys_elem, Ele795), BlockExitEnv791=[BV793|AEnv797], forall(member(Ele795, List_1_Get777), (nb_setarg(2, BV793, Ele795), get_var(BlockExitEnv791, key, IFTEST780), (IFTEST780\==[]->get_var(BlockExitEnv791, key, Key_Get783), get_var(BlockExitEnv791, sys_elem, Elem_Get784), f_apply(Key_Get783, [Elem_Get784], TrueResult786), CAR1783=TrueResult786;get_var(BlockExitEnv791, sys_elem, Elem_Get785), CAR1783=Elem_Get785), get_var(BlockExitEnv791, rest, Rest_Get789), get_var(BlockExitEnv791, sys_item, Item_Get788), f_apply(f_satisfies1, [CAR1783, Item_Get788, Rest_Get789], IFTEST778), (IFTEST778\==[]->set_var(BlockExitEnv791, block_ret_sys_matches, []), always(block_exit_sys_matches, BlockExitEnv791);_83654=[]))), get_var(AEnv797, sys_item, Item_Get798), get_var(AEnv797, sys_result, Result_Get799), Result1668=[Item_Get798|Result_Get799], set_var(AEnv797, sys_result, Result1668)), Result1668=Block_exit_Ret), block_exit(sys_matches, Block_exit_Ret), true))), get_var(LEnv754, sys_result, LetResult753)), LetResult753=FnResult745), block_exit(set_exclusive_or, FnResult745), true))),
9297 set_opv(set_exclusive_or, symbol_function, f_set_exclusive_or),
9298 DefunResult806=set_exclusive_or,
9299 assert_lsp(nset_exclusive_or,
9300 wl:lambda_def(defun, nset_exclusive_or, f_nset_exclusive_or, [sys_list_1, sys_list_2, c38_rest, rest, c38_key, key], [[let, [[sys_result, []], [list, []], [sys_item, []]], [tagbody, sys_start_1, [unless, sys_list_1, [go, sys_start_2]], [setf, sys_item, [car, sys_list_1]], [setf, list, sys_list_2], [setf, sys_prev, []], sys_start_1_in, [unless, list, [go, sys_end_1_in]], [let, [[sys_elem, [if, key, [funcall, key, [car, list]], [car, list]]]], [when, [apply, function(satisfies), sys_item, [if, key, [funcall, key, sys_elem], sys_elem], rest], [if, sys_prev, [setf, [cdr, sys_prev], [cdr, list]], [setf, sys_list_2, [cdr, list]]], [setf, sys_list_1, [cdr, sys_list_1]], [go, sys_start_1]]], [setf, sys_prev, list], [setf, list, [cdr, list]], [go, sys_start_1_in], sys_end_1_in, [setf, sys_item, [cdr, sys_list_1]], [setf, [cdr, sys_list_1], sys_result], [unless, sys_result, [setf, sys_end, sys_list_1]], [setf, sys_result, sys_list_1], [setf, sys_list_1, sys_item], [go, sys_start_1], sys_start_2, [return_from, nset_exclusive_or, [if, sys_end, [progn, [setf, [cdr, sys_end], sys_list_2], sys_result], sys_list_2]]]]])),
9301 assert_lsp(nset_exclusive_or,
9302 wl:arglist_info(nset_exclusive_or, f_nset_exclusive_or, [sys_list_1, sys_list_2, c38_rest, rest, c38_key, key], arginfo{all:[sys_list_1, sys_list_2], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:[key], names:[sys_list_1, sys_list_2, rest, key], opt:0, req:[sys_list_1, sys_list_2], rest:[rest], sublists:0, whole:0})),
9303 assert_lsp(nset_exclusive_or, wl:init_args(2, f_nset_exclusive_or)),
9304 assert_lsp(nset_exclusive_or,
9305 (f_nset_exclusive_or(List_1_In810, List_2_In811, RestNKeys808, FnResult807):-CDR1785=[bv(sys_list_1, List_1_In810), bv(sys_list_2, List_2_In811), bv(rest, RestNKeys808), bv(key, Key_In813)], get_kw([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)]|Env], RestNKeys808, key, key, Key_In813, []=Key_In813, Key_P809), catch(((LEnv816=[bv(sys_result, []), bv(list, []), bv(sys_item, [])|CDR1785], call_addr_block(LEnv816, (push_label(sys_start_1), get_var(LEnv816, sys_list_1, IFTEST951), (IFTEST951\==[]->_88024=[];goto(sys_start_2, LEnv816), _88024=_GORES954), get_var(LEnv816, sys_list_1, List_1_Get957), f_car(List_1_Get957, Item), set_var(LEnv816, sys_item, Item), get_var(LEnv816, sys_list_2, List_2_Get958), set_var(LEnv816, list, List_2_Get958), set_var(LEnv816, sys_prev, []), push_label(sys_start_1_in), get_var(LEnv816, list, IFTEST960), (IFTEST960\==[]->_88240=[];goto(sys_end_1_in, LEnv816), _88240=_GORES963), get_var(LEnv816, key, IFTEST968), (IFTEST968\==[]->get_var(LEnv816, key, Key_Get971), get_var(LEnv816, list, List_Get972), f_car(List_Get972, Car_Ret1786), f_apply(Key_Get971, [Car_Ret1786], TrueResult974), Elem_Init976=TrueResult974;get_var(LEnv816, list, List_Get973), f_car(List_Get973, ElseResult975), Elem_Init976=ElseResult975), LEnv967=[bv(sys_elem, Elem_Init976)|LEnv816], get_var(LEnv967, key, IFTEST980), get_var(LEnv967, sys_item, Item_Get979), (IFTEST980\==[]->get_var(LEnv967, key, Key_Get983), get_var(LEnv967, sys_elem, Elem_Get984), f_apply(Key_Get983, [Elem_Get984], TrueResult986), CAR1787=TrueResult986;get_var(LEnv967, sys_elem, Elem_Get985), CAR1787=Elem_Get985), get_var(LEnv967, rest, Rest_Get988), f_apply(f_satisfies1, [Item_Get979, CAR1787, Rest_Get988], IFTEST977), (IFTEST977\==[]->get_var(LEnv967, sys_prev, IFTEST989), (IFTEST989\==[]->get_var(LEnv967, list, List_Get995), get_var(LEnv967, sys_prev, Prev_Get994), f_cdr(List_Get995, Cdr_Ret1788), f_rplacd(Prev_Get994, Cdr_Ret1788, TrueResult997), _88980=TrueResult997;get_var(LEnv967, list, List_Get996), f_cdr(List_Get996, ElseResult998), set_var(LEnv967, sys_list_2, ElseResult998), _88980=ElseResult998), get_var(LEnv967, sys_list_1, List_1_Get999), f_cdr(List_1_Get999, List_1), set_var(LEnv967, sys_list_1, List_1), goto(sys_start_1, LEnv967), LetResult966=_GORES1000;LetResult966=[]), get_var(LEnv816, list, List_Get1003), set_var(LEnv816, sys_prev, List_Get1003), get_var(LEnv816, list, List_Get1004), f_cdr(List_Get1004, List1671), set_var(LEnv816, list, List1671), goto(sys_start_1_in, LEnv816)), [addr(addr_tagbody_54_sys_start_1, sys_start_1, '$used', GoEnv822, (get_var(GoEnv822, sys_list_1, IFTEST818), (IFTEST818\==[]->_89456=[];goto(sys_start_2, GoEnv822), _89456=_GORES821), get_var(GoEnv822, sys_list_1, List_1_Get824), f_car(List_1_Get824, Car_Ret1789), set_var(GoEnv822, sys_item, Car_Ret1789), get_var(GoEnv822, sys_list_2, List_2_Get825), set_var(GoEnv822, list, List_2_Get825), set_var(GoEnv822, sys_prev, []), push_label(sys_start_1_in), get_var(GoEnv822, list, IFTEST827), (IFTEST827\==[]->_89516=[];goto(sys_end_1_in, GoEnv822), _89516=_GORES830), get_var(GoEnv822, key, IFTEST836), (IFTEST836\==[]->get_var(GoEnv822, key, Key_Get839), get_var(GoEnv822, list, List_Get840), f_car(List_Get840, Car_Ret1790), f_apply(Key_Get839, [Car_Ret1790], TrueResult842), Bv_Ret=TrueResult842;get_var(GoEnv822, list, List_Get841), f_car(List_Get841, ElseResult843), Bv_Ret=ElseResult843), LEnv835=[bv(sys_elem, Bv_Ret)|GoEnv822], get_var(LEnv835, key, IFTEST848), get_var(LEnv835, sys_item, Item_Get847), (IFTEST848\==[]->get_var(LEnv835, key, Key_Get851), get_var(LEnv835, sys_elem, Elem_Get852), f_apply(Key_Get851, [Elem_Get852], TrueResult854), CAR1792=TrueResult854;get_var(LEnv835, sys_elem, Elem_Get853), CAR1792=Elem_Get853), get_var(LEnv835, rest, Rest_Get856), f_apply(f_satisfies1, [Item_Get847, CAR1792, Rest_Get856], IFTEST845), (IFTEST845\==[]->get_var(LEnv835, sys_prev, IFTEST857), (IFTEST857\==[]->get_var(LEnv835, list, List_Get863), get_var(LEnv835, sys_prev, Prev_Get862), f_cdr(List_Get863, Cdr_Ret1793), f_rplacd(Prev_Get862, Cdr_Ret1793, TrueResult865), _89806=TrueResult865;get_var(LEnv835, list, List_Get864), f_cdr(List_Get864, ElseResult866), set_var(LEnv835, sys_list_2, ElseResult866), _89806=ElseResult866), get_var(LEnv835, sys_list_1, List_1_Get867), f_cdr(List_1_Get867, Cdr_Ret1794), set_var(LEnv835, sys_list_1, Cdr_Ret1794), goto(sys_start_1, LEnv835), LetResult834=_GORES868;LetResult834=[]), get_var(GoEnv822, list, List_Get871), set_var(GoEnv822, sys_prev, List_Get871), get_var(GoEnv822, list, List_Get872), f_cdr(List_Get872, Cdr_Ret1795), set_var(GoEnv822, list, Cdr_Ret1795), goto(sys_start_1_in, GoEnv822))), addr(addr_tagbody_54_sys_start_1_in, sys_start_1_in, '$used', GoEnv878, (get_var(GoEnv878, list, IFTEST874), (IFTEST874\==[]->_89938=[];goto(sys_end_1_in, GoEnv878), _89938=_GORES877), get_var(GoEnv878, key, IFTEST883), (IFTEST883\==[]->get_var(GoEnv878, key, Key_Get886), get_var(GoEnv878, list, List_Get887), f_car(List_Get887, Car_Ret1796), f_apply(Key_Get886, [Car_Ret1796], TrueResult889), Elem_Init891=TrueResult889;get_var(GoEnv878, list, List_Get888), f_car(List_Get888, ElseResult890), Elem_Init891=ElseResult890), LEnv882=[bv(sys_elem, Elem_Init891)|GoEnv878], get_var(LEnv882, key, IFTEST895), get_var(LEnv882, sys_item, Item_Get894), (IFTEST895\==[]->get_var(LEnv882, key, Key_Get898), get_var(LEnv882, sys_elem, Elem_Get899), f_apply(Key_Get898, [Elem_Get899], TrueResult901), CAR1797=TrueResult901;get_var(LEnv882, sys_elem, Elem_Get900), CAR1797=Elem_Get900), get_var(LEnv882, rest, Rest_Get903), f_apply(f_satisfies1, [Item_Get894, CAR1797, Rest_Get903], IFTEST892), (IFTEST892\==[]->get_var(LEnv882, sys_prev, IFTEST904), (IFTEST904\==[]->get_var(LEnv882, list, List_Get910), get_var(LEnv882, sys_prev, Prev_Get909), f_cdr(List_Get910, Cdr_Ret1798), f_rplacd(Prev_Get909, Cdr_Ret1798, TrueResult912), _90240=TrueResult912;get_var(LEnv882, list, List_Get911), f_cdr(List_Get911, ElseResult913), set_var(LEnv882, sys_list_2, ElseResult913), _90240=ElseResult913), get_var(LEnv882, sys_list_1, List_1_Get914), f_cdr(List_1_Get914, Cdr_Ret1799), set_var(LEnv882, sys_list_1, Cdr_Ret1799), goto(sys_start_1, LEnv882), LetResult881=_GORES915;LetResult881=[]), get_var(GoEnv878, list, List_Get918), set_var(GoEnv878, sys_prev, List_Get918), get_var(GoEnv878, list, List_Get919), f_cdr(List_Get919, Cdr_Ret1800), set_var(GoEnv878, list, Cdr_Ret1800), goto(sys_start_1_in, GoEnv878))), addr(addr_tagbody_54_sys_end_1_in, sys_end_1_in, '$unused', GoEnv935, (get_var(GoEnv935, sys_list_1, List_1_Get922), f_cdr(List_1_Get922, Cdr_Ret1801), set_var(GoEnv935, sys_item, Cdr_Ret1801), get_var(GoEnv935, sys_list_1, List_1_Get925), get_var(GoEnv935, sys_result, Result_Get926), f_rplacd(List_1_Get925, Result_Get926, Rplacd_Ret1802), get_var(GoEnv935, sys_result, IFTEST927), (IFTEST927\==[]->_90418=[];get_var(GoEnv935, sys_list_1, List_1_Get930), set_var(GoEnv935, sys_end, List_1_Get930), _90418=List_1_Get930), get_var(GoEnv935, sys_list_1, List_1_Get932), set_var(GoEnv935, sys_result, List_1_Get932), get_var(GoEnv935, sys_item, Item_Get933), set_var(GoEnv935, sys_list_1, Item_Get933), goto(sys_start_1, GoEnv935))), addr(addr_tagbody_54_sys_start_2, sys_start_2, '$unused', BlockExitEnv949, (get_var(BlockExitEnv949, sys_end, IFTEST938), (IFTEST938\==[]->get_var(BlockExitEnv949, sys_end, End_Get943), get_var(BlockExitEnv949, sys_list_2, List_2_Get944), f_rplacd(End_Get943, List_2_Get944, Rplacd_Ret1803), get_var(BlockExitEnv949, sys_result, Result_Get945), RetResult936=Result_Get945;get_var(BlockExitEnv949, sys_list_2, List_2_Get946), RetResult936=List_2_Get946), throw(block_exit(nset_exclusive_or, RetResult936))))])), []=FnResult807), block_exit(nset_exclusive_or, FnResult807), true))),
9306 set_opv(nset_exclusive_or, symbol_function, f_nset_exclusive_or),
9307 DefunResult1007=nset_exclusive_or,
9308 assert_lsp(fill,
9309 wl:lambda_def(defun, fill, f_fill, [sequence, sys_item, c38_rest, rest], [[let, [[sys_iter, [apply, function(sys_seq_start), sequence, rest]]], [tagbody, sys_start, [unless, [apply, function(sys_seq_end_p), sequence, sys_iter, rest], [sys_seq_set, sequence, sys_iter, sys_item], [sys_seq_next, sys_iter], [go, sys_start]]]], sequence])),
9310 assert_lsp(fill,
9311 wl:arglist_info(fill, f_fill, [sequence, sys_item, c38_rest, rest], arginfo{all:[sequence, sys_item], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sequence, sys_item, rest], opt:0, req:[sequence, sys_item], rest:[rest], sublists:0, whole:0})),
9312 assert_lsp(fill, wl:init_args(2, f_fill)),
9313 assert_lsp(fill,
9314 (f_fill(Sequence_In1010, Item_In1011, RestNKeys1009, FnResult1008):-GEnv1672=[bv(sequence, Sequence_In1010), bv(sys_item, Item_In1011), bv(rest, RestNKeys1009)], catch(((get_var(GEnv1672, rest, Rest_Get1017), get_var(GEnv1672, sequence, Sequence_Get1016), f_apply(f_sys_seq_start1, [Sequence_Get1016, Rest_Get1017], Iter_Init), LEnv1015=[bv(sys_iter, Iter_Init)|GEnv1672], call_addr_block(LEnv1015, (push_label(sys_start), (get_var(LEnv1015, rest, Rest_Get1037), get_var(LEnv1015, sequence, Sequence_Get1035)), get_var(LEnv1015, sys_iter, Iter_Get1036), f_apply(f_sys_seq_end_p1, [Sequence_Get1035, Iter_Get1036, Rest_Get1037], IFTEST1033), (IFTEST1033\==[]->_TBResult1019=[];get_var(LEnv1015, sequence, Sequence_Get1038), get_var(LEnv1015, sys_item, Item_Get1040), get_var(LEnv1015, sys_iter, Iter_Get1039), f_sys_seq_set1(Sequence_Get1038, Iter_Get1039, Item_Get1040, KeysNRest), get_var(LEnv1015, sys_iter, Iter_Get1041), f_sys_seq_next1(Iter_Get1041, KeysNRest1696), goto(sys_start, LEnv1015), _TBResult1019=_GORES1042)), [addr(addr_tagbody_55_sys_start, sys_start, '$unused', GoEnv1030, ((get_var(GoEnv1030, rest, Rest_Get1024), get_var(GoEnv1030, sequence, Sequence_Get1022)), get_var(GoEnv1030, sys_iter, Iter_Get1023), f_apply(f_sys_seq_end_p1, [Sequence_Get1022, Iter_Get1023, Rest_Get1024], IFTEST1020), (IFTEST1020\==[]->_TBResult1019=[];get_var(GoEnv1030, sequence, Sequence_Get1025), get_var(GoEnv1030, sys_item, Item_Get1027), get_var(GoEnv1030, sys_iter, Iter_Get1026), f_sys_seq_set1(Sequence_Get1025, Iter_Get1026, Item_Get1027, KeysNRest1697), get_var(GoEnv1030, sys_iter, Iter_Get1028), f_sys_seq_next1(Iter_Get1028, KeysNRest1698), goto(sys_start, GoEnv1030), _TBResult1019=_GORES1029)))]), get_var(GEnv1672, sequence, Sequence_Get1045)), Sequence_Get1045=FnResult1008), block_exit(fill, FnResult1008), true))),
9315 set_opv(fill, symbol_function, f_fill),
9316 DefunResult1047=fill,
9317 assert_lsp(every,
9318 wl:lambda_def(defun, every, f_every, [sys_predicate, c38_rest, sys_sequences], [[let, [[sys_iters, [mapcar, function(sys_seq_start), sys_sequences]]], [tagbody, sys_start, [unless, [sys_some_list_2, function(sys_seq_end_p), sys_sequences, sys_iters], [unless, [apply, sys_predicate, [mapcar, function(sys_seq_ref), sys_sequences, sys_iters]], [return_from, every, []]], [mapc, function(sys_seq_next), sys_iters], [go, sys_start]]]], t])),
9319 assert_lsp(every,
9320 wl:arglist_info(every, f_every, [sys_predicate, c38_rest, sys_sequences], arginfo{all:[sys_predicate], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_predicate, sys_sequences], opt:0, req:[sys_predicate], rest:[sys_sequences], sublists:0, whole:0})),
9321 assert_lsp(every, wl:init_args(x, f_every)),
9322 assert_lsp(every,
9323 (f_every(Predicate_In1050, FnResult1048):-GEnv1673=[bv(sys_predicate, Predicate_In1050), bv(sys_sequences, [])], catch(((get_var(GEnv1673, sys_sequences, Sequences_Get), f_mapcar(f_sys_seq_start1, [Sequences_Get], Iters_Init), BlockExitEnv=[bv(sys_iters, Iters_Init)|GEnv1673], call_addr_block(BlockExitEnv, (push_label(sys_start), get_var(BlockExitEnv, sys_iters, Iters_Get1079), get_var(BlockExitEnv, sys_sequences, Sequences_Get1078), f_sys_some_list_2(f_sys_seq_end_p1, Sequences_Get1078, Iters_Get1079, IFTEST1076), (IFTEST1076\==[]->_TBResult1057=[];get_var(BlockExitEnv, sys_iters, Iters_Get1084), get_var(BlockExitEnv, sys_predicate, Predicate_Get1082), get_var(BlockExitEnv, sys_sequences, Sequences_Get1083), f_mapcar(f_sys_seq_ref1, [Sequences_Get1083, Iters_Get1084], Mapcar_Ret), f_apply(Predicate_Get1082, Mapcar_Ret, IFTEST1080), (IFTEST1080\==[]->_92546=[];throw(block_exit(every, [])), _92546=ThrowResult1086), get_var(BlockExitEnv, sys_iters, Iters_Get1089), f_mapc(f_sys_seq_next1, [Iters_Get1089], Mapc_Ret), goto(sys_start, BlockExitEnv), _TBResult1057=_GORES1090)), [addr(addr_tagbody_56_sys_start, sys_start, '$unused', BlockExitEnv1069, (get_var(BlockExitEnv1069, sys_iters, Get_var_Ret1806), get_var(BlockExitEnv1069, sys_sequences, Sequences_Get1060), f_sys_some_list_2(f_sys_seq_end_p1, Sequences_Get1060, Get_var_Ret1806, IFTEST1058), (IFTEST1058\==[]->_TBResult1057=[];get_var(BlockExitEnv1069, sys_iters, Iters_Get1066), get_var(BlockExitEnv1069, sys_predicate, Predicate_Get1064), get_var(BlockExitEnv1069, sys_sequences, Sequences_Get1065), f_mapcar(f_sys_seq_ref1, [Sequences_Get1065, Iters_Get1066], Mapcar_Ret1807), f_apply(Predicate_Get1064, Mapcar_Ret1807, IFTEST1062), (IFTEST1062\==[]->_92962=[];throw(block_exit(every, [])), _92962=ThrowResult1068), get_var(BlockExitEnv1069, sys_iters, Iters_Get1071), f_mapc(f_sys_seq_next1, [Iters_Get1071], Mapc_Ret1808), goto(sys_start, BlockExitEnv1069), _TBResult1057=_GORES1072)))])), t=FnResult1048), block_exit(every, FnResult1048), true))),
9324 set_opv(every, symbol_function, f_every),
9325 DefunResult1094=every,
9326 assert_lsp(some,
9327 wl:lambda_def(defun, some, f_some, [sys_predicate, c38_rest, sys_sequences], [[let, [[sys_iters, [mapcar, function(sys_seq_start), sys_sequences]]], [tagbody, sys_start, [unless, [sys_some_list_2, function(sys_seq_end_p), sys_sequences, sys_iters], [let, [[sys_result, [apply, sys_predicate, [mapcar, function(sys_seq_ref), sys_sequences, sys_iters]]]], [when, sys_result, [return_from, some, sys_result]]], [mapc, function(sys_seq_next), sys_iters], [go, sys_start]]]]])),
9328 assert_lsp(some,
9329 wl:arglist_info(some, f_some, [sys_predicate, c38_rest, sys_sequences], arginfo{all:[sys_predicate], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_predicate, sys_sequences], opt:0, req:[sys_predicate], rest:[sys_sequences], sublists:0, whole:0})),
9330 assert_lsp(some, wl:init_args(1, f_some)),
9331 assert_lsp(some,
9332 (f_some(Predicate_In1097, RestNKeys1096, FnResult1095):-GEnv1674=[bv(sys_predicate, Predicate_In1097), bv(sys_sequences, RestNKeys1096)], catch(((get_var(GEnv1674, sys_sequences, Sequences_Get1102), f_mapcar(f_sys_seq_start1, [Sequences_Get1102], Iters_Init1103), LEnv1101=[bv(sys_iters, Iters_Init1103)|GEnv1674], call_addr_block(LEnv1101, (push_label(sys_start), get_var(LEnv1101, sys_iters, Iters_Get1132), get_var(LEnv1101, sys_sequences, Sequences_Get1131), f_sys_some_list_2(f_sys_seq_end_p1, Sequences_Get1131, Iters_Get1132, IFTEST1129), (IFTEST1129\==[]->_TBResult1104=[];get_var(LEnv1101, sys_iters, Iters_Get1138), get_var(LEnv1101, sys_predicate, Predicate_Get1136), get_var(LEnv1101, sys_sequences, Sequences_Get1137), f_mapcar(f_sys_seq_ref1, [Sequences_Get1137, Iters_Get1138], Mapcar_Ret1809), f_apply(Predicate_Get1136, Mapcar_Ret1809, Result_Init1139), LEnv1135=[bv(sys_result, Result_Init1139)|LEnv1101], get_var(LEnv1135, sys_result, IFTEST1140), (IFTEST1140\==[]->get_var(LEnv1135, sys_result, RetResult1143), throw(block_exit(some, RetResult1143)), LetResult1134=ThrowResult1144;LetResult1134=[]), get_var(LEnv1101, sys_iters, Iters_Get1148), f_mapc(f_sys_seq_next1, [Iters_Get1148], Mapc_Ret1810), goto(sys_start, LEnv1101), _TBResult1104=_GORES1149)), [addr(addr_tagbody_57_sys_start, sys_start, '$unused', GoEnv1126, (get_var(GoEnv1126, sys_iters, Iters_Get1108), get_var(GoEnv1126, sys_sequences, Sequences_Get1107), f_sys_some_list_2(f_sys_seq_end_p1, Sequences_Get1107, Iters_Get1108, IFTEST1105), (IFTEST1105\==[]->_TBResult1104=[];get_var(GoEnv1126, sys_iters, Iters_Get1114), get_var(GoEnv1126, sys_predicate, Predicate_Get1112), get_var(GoEnv1126, sys_sequences, Sequences_Get1113), f_mapcar(f_sys_seq_ref1, [Sequences_Get1113, Iters_Get1114], Mapcar_Ret1811), f_apply(Predicate_Get1112, Mapcar_Ret1811, Apply_Ret1812), LEnv1111=[bv(sys_result, Apply_Ret1812)|GoEnv1126], get_var(LEnv1111, sys_result, IFTEST1116), (IFTEST1116\==[]->get_var(LEnv1111, sys_result, RetResult1119), throw(block_exit(some, RetResult1119)), LetResult1110=ThrowResult1120;LetResult1110=[]), get_var(GoEnv1126, sys_iters, Iters_Get1124), f_mapc(f_sys_seq_next1, [Iters_Get1124], Mapc_Ret1813), goto(sys_start, GoEnv1126), _TBResult1104=_GORES1125)))])), []=FnResult1095), block_exit(some, FnResult1095), true))),
9333 set_opv(some, symbol_function, f_some),
9334 DefunResult1153=some,
9335 assert_lsp(notevery,
9336 wl:lambda_def(defun, notevery, f_notevery, [sys_predicate, c38_rest, sys_sequences], [[let, [[sys_iters, [mapcar, function(sys_seq_start), sys_sequences]]], [tagbody, sys_start, [unless, [sys_some_list_2, function(sys_seq_end_p), sys_sequences, sys_iters], [unless, [apply, sys_predicate, [mapcar, function(sys_seq_ref), sys_sequences, sys_iters]], [return_from, every, t]], [mapc, function(sys_seq_next), sys_iters], [go, sys_start]]]]])),
9337 assert_lsp(notevery,
9338 wl:arglist_info(notevery, f_notevery, [sys_predicate, c38_rest, sys_sequences], arginfo{all:[sys_predicate], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_predicate, sys_sequences], opt:0, req:[sys_predicate], rest:[sys_sequences], sublists:0, whole:0})),
9339 assert_lsp(notevery, wl:init_args(1, f_notevery)),
9340 assert_lsp(notevery,
9341 (f_notevery(Predicate_In1156, RestNKeys1155, FnResult1154):-GEnv1675=[bv(sys_predicate, Predicate_In1156), bv(sys_sequences, RestNKeys1155)], catch(((get_var(GEnv1675, sys_sequences, Sequences_Get1161), f_mapcar(f_sys_seq_start1, [Sequences_Get1161], Iters_Init1162), BlockExitEnv=[bv(sys_iters, Iters_Init1162)|GEnv1675], call_addr_block(BlockExitEnv, (push_label(sys_start), get_var(BlockExitEnv, sys_iters, Iters_Get1185), get_var(BlockExitEnv, sys_sequences, Sequences_Get1184), f_sys_some_list_2(f_sys_seq_end_p1, Sequences_Get1184, Iters_Get1185, IFTEST1182), (IFTEST1182\==[]->_TBResult1163=[];get_var(BlockExitEnv, sys_iters, Iters_Get1190), get_var(BlockExitEnv, sys_predicate, Predicate_Get1188), get_var(BlockExitEnv, sys_sequences, Sequences_Get1189), f_mapcar(f_sys_seq_ref1, [Sequences_Get1189, Iters_Get1190], Mapcar_Ret1814), f_apply(Predicate_Get1188, Mapcar_Ret1814, IFTEST1186), (IFTEST1186\==[]->_95542=[];throw(block_exit(every, t)), _95542=ThrowResult1192), get_var(BlockExitEnv, sys_iters, Iters_Get1195), f_mapc(f_sys_seq_next1, [Iters_Get1195], Mapc_Ret1815), goto(sys_start, BlockExitEnv), _TBResult1163=_GORES1196)), [addr(addr_tagbody_58_sys_start, sys_start, '$unused', BlockExitEnv1175, (get_var(BlockExitEnv1175, sys_iters, Iters_Get1167), get_var(BlockExitEnv1175, sys_sequences, Sequences_Get1166), f_sys_some_list_2(f_sys_seq_end_p1, Sequences_Get1166, Iters_Get1167, IFTEST1164), (IFTEST1164\==[]->_TBResult1163=[];get_var(BlockExitEnv1175, sys_iters, Iters_Get1172), get_var(BlockExitEnv1175, sys_predicate, Predicate_Get1170), get_var(BlockExitEnv1175, sys_sequences, Sequences_Get1171), f_mapcar(f_sys_seq_ref1, [Sequences_Get1171, Iters_Get1172], Mapcar_Ret1816), f_apply(Predicate_Get1170, Mapcar_Ret1816, IFTEST1168), (IFTEST1168\==[]->_95970=[];throw(block_exit(every, t)), _95970=ThrowResult1174), get_var(BlockExitEnv1175, sys_iters, Iters_Get1177), f_mapc(f_sys_seq_next1, [Iters_Get1177], Mapc_Ret1817), goto(sys_start, BlockExitEnv1175), _TBResult1163=_GORES1178)))])), []=FnResult1154), block_exit(notevery, FnResult1154), true))),
9342 set_opv(notevery, symbol_function, f_notevery),
9343 DefunResult1200=notevery,
9344 assert_lsp(notany,
9345 wl:lambda_def(defun, notany, f_notany, [sys_predicate, c38_rest, sys_sequences], [[let, [[sys_iters, [mapcar, function(sys_seq_start), sys_sequences]]], [tagbody, sys_start, [unless, [sys_some_list_2, function(sys_seq_end_p), sys_sequences, sys_iters], [when, [apply, sys_predicate, [mapcar, function(sys_seq_ref), sys_sequences, sys_iters]], [return_from, every, []]], [mapc, function(sys_seq_next), sys_iters], [go, sys_start]]]], t])),
9346 assert_lsp(notany,
9347 wl:arglist_info(notany, f_notany, [sys_predicate, c38_rest, sys_sequences], arginfo{all:[sys_predicate], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_predicate, sys_sequences], opt:0, req:[sys_predicate], rest:[sys_sequences], sublists:0, whole:0})),
9348 assert_lsp(notany, wl:init_args(1, f_notany)),
9349 assert_lsp(notany,
9350 (f_notany(Predicate_In1203, RestNKeys1202, FnResult1201):-GEnv1676=[bv(sys_predicate, Predicate_In1203), bv(sys_sequences, RestNKeys1202)], catch(((get_var(GEnv1676, sys_sequences, Sequences_Get1208), f_mapcar(f_sys_seq_start1, [Sequences_Get1208], Iters_Init1209), BlockExitEnv=[bv(sys_iters, Iters_Init1209)|GEnv1676], call_addr_block(BlockExitEnv, (push_label(sys_start), get_var(BlockExitEnv, sys_iters, Iters_Get1232), get_var(BlockExitEnv, sys_sequences, Sequences_Get1231), f_sys_some_list_2(f_sys_seq_end_p1, Sequences_Get1231, Iters_Get1232, IFTEST1229), (IFTEST1229\==[]->_TBResult1210=[];get_var(BlockExitEnv, sys_iters, Iters_Get1237), get_var(BlockExitEnv, sys_predicate, Predicate_Get1235), get_var(BlockExitEnv, sys_sequences, Sequences_Get1236), f_mapcar(f_sys_seq_ref1, [Sequences_Get1236, Iters_Get1237], Mapcar_Ret1818), f_apply(Predicate_Get1235, Mapcar_Ret1818, IFTEST1233), (IFTEST1233\==[]->throw(block_exit(every, [])), _96862=ThrowResult1239;_96862=[]), get_var(BlockExitEnv, sys_iters, Iters_Get1242), f_mapc(f_sys_seq_next1, [Iters_Get1242], Mapc_Ret1819), goto(sys_start, BlockExitEnv), _TBResult1210=_GORES1243)), [addr(addr_tagbody_59_sys_start, sys_start, '$unused', BlockExitEnv1222, (get_var(BlockExitEnv1222, sys_iters, Iters_Get1214), get_var(BlockExitEnv1222, sys_sequences, Sequences_Get1213), f_sys_some_list_2(f_sys_seq_end_p1, Sequences_Get1213, Iters_Get1214, IFTEST1211), (IFTEST1211\==[]->_TBResult1210=[];get_var(BlockExitEnv1222, sys_iters, Iters_Get1219), get_var(BlockExitEnv1222, sys_predicate, Predicate_Get1217), get_var(BlockExitEnv1222, sys_sequences, Sequences_Get1218), f_mapcar(f_sys_seq_ref1, [Sequences_Get1218, Iters_Get1219], Mapcar_Ret1820), f_apply(Predicate_Get1217, Mapcar_Ret1820, IFTEST1215), (IFTEST1215\==[]->throw(block_exit(every, [])), _97290=ThrowResult1221;_97290=[]), get_var(BlockExitEnv1222, sys_iters, Iters_Get1224), f_mapc(f_sys_seq_next1, [Iters_Get1224], Mapc_Ret1821), goto(sys_start, BlockExitEnv1222), _TBResult1210=_GORES1225)))])), t=FnResult1201), block_exit(notany, FnResult1201), true))),
9351 set_opv(notany, symbol_function, f_notany),
9352 DefunResult1247=notany,
9353 assert_lsp(count,
9354 wl:lambda_def(defun, count, f_count, [sys_item, sequence, c38_rest, rest], [[let, [[sys_iter, [apply, function(sys_seq_start), sequence, rest]], [count, 0]], [tagbody, sys_start, [unless, [apply, function(sys_seq_end_p), sequence, sys_iter, rest], [when, [apply, function(satisfies), sys_item, [sys_seq_ref, sequence, sys_iter], rest], [setf, count, [+, 1, count]]], [sys_seq_next, sys_iter], [go, sys_start]]], count]])),
9355 assert_lsp(count,
9356 wl:arglist_info(count, f_count, [sys_item, sequence, c38_rest, rest], arginfo{all:[sys_item, sequence], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_item, sequence, rest], opt:0, req:[sys_item, sequence], rest:[rest], sublists:0, whole:0})),
9357 assert_lsp(count, wl:init_args(2, f_count)),
9358 assert_lsp(count,
9359 (f_count(Item_In1250, Sequence_In1251, RestNKeys1249, FnResult1248):-GEnv1677=[bv(sys_item, Item_In1250), bv(sequence, Sequence_In1251), bv(rest, RestNKeys1249)], catch(((get_var(GEnv1677, rest, Rest_Get1257), get_var(GEnv1677, sequence, Sequence_Get1256), f_apply(f_sys_seq_start1, [Sequence_Get1256, Rest_Get1257], Iter_Init1258), LEnv1255=[bv(sys_iter, Iter_Init1258), bv(count, 0)|GEnv1677], call_addr_block(LEnv1255, (push_label(sys_start), (get_var(LEnv1255, rest, Rest_Get1282), get_var(LEnv1255, sequence, Sequence_Get1280)), get_var(LEnv1255, sys_iter, Iter_Get1281), f_apply(f_sys_seq_end_p1, [Sequence_Get1280, Iter_Get1281, Rest_Get1282], IFTEST1278), (IFTEST1278\==[]->_TBResult1259=[];get_var(LEnv1255, sequence, Sequence_Get1286), get_var(LEnv1255, sys_item, Item_Get1285), get_var(LEnv1255, sys_iter, Iter_Get1287), f_sys_seq_ref1(Sequence_Get1286, Iter_Get1287, KeysNRest1699), get_var(LEnv1255, rest, Rest_Get1288), f_apply(f_satisfies1, [Item_Get1285, KeysNRest1699, Rest_Get1288], IFTEST1283), (IFTEST1283\==[]->get_var(LEnv1255, count, Count_Get1289), 'f_+'(1, Count_Get1289, TrueResult1290), set_var(LEnv1255, count, TrueResult1290), _98280=TrueResult1290;_98280=[]), get_var(LEnv1255, sys_iter, Iter_Get1291), f_sys_seq_next1(Iter_Get1291, KeysNRest1700), goto(sys_start, LEnv1255), _TBResult1259=_GORES1292)), [addr(addr_tagbody_60_sys_start, sys_start, '$unused', GoEnv1275, ((get_var(GoEnv1275, rest, Rest_Get1264), get_var(GoEnv1275, sequence, Sequence_Get1262)), get_var(GoEnv1275, sys_iter, Iter_Get1263), f_apply(f_sys_seq_end_p1, [Sequence_Get1262, Iter_Get1263, Rest_Get1264], IFTEST1260), (IFTEST1260\==[]->_TBResult1259=[];get_var(GoEnv1275, sequence, Sequence_Get1268), get_var(GoEnv1275, sys_item, Item_Get1267), get_var(GoEnv1275, sys_iter, Iter_Get1269), f_sys_seq_ref1(Sequence_Get1268, Iter_Get1269, KeysNRest1701), get_var(GoEnv1275, rest, Rest_Get1270), f_apply(f_satisfies1, [Item_Get1267, KeysNRest1701, Rest_Get1270], IFTEST1265), (IFTEST1265\==[]->get_var(GoEnv1275, count, Get_var_Ret1822), 'f_+'(1, Get_var_Ret1822, TrueResult1272), set_var(GoEnv1275, count, TrueResult1272), _98752=TrueResult1272;_98752=[]), get_var(GoEnv1275, sys_iter, Iter_Get1273), f_sys_seq_next1(Iter_Get1273, KeysNRest1702), goto(sys_start, GoEnv1275), _TBResult1259=_GORES1274)))]), get_var(LEnv1255, count, LetResult1254)), LetResult1254=FnResult1248), block_exit(count, FnResult1248), true))),
9360 set_opv(count, symbol_function, f_count),
9361 DefunResult1297=count,
9362 assert_lsp(count_if,
9363 wl:lambda_def(defun, count_if, f_count_if, [sys_predicate, sequence, c38_rest, rest], [[let, [[sys_iter, [apply, function(sys_seq_start), sequence, rest]], [count, 0]], [tagbody, sys_start, [unless, [apply, function(sys_seq_end_p), sequence, sys_iter, rest], [when, [apply, function(sys_satisfies_if), sys_predicate, [sys_seq_ref, sequence, sys_iter], rest], [setf, count, [+, 1, count]]], [sys_seq_next, sys_iter], [go, sys_start]]], count]])),
9364 assert_lsp(count_if,
9365 wl:arglist_info(count_if, f_count_if, [sys_predicate, sequence, c38_rest, rest], arginfo{all:[sys_predicate, sequence], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_predicate, sequence, rest], opt:0, req:[sys_predicate, sequence], rest:[rest], sublists:0, whole:0})),
9366 assert_lsp(count_if, wl:init_args(2, f_count_if)),
9367 assert_lsp(count_if,
9368 (f_count_if(Predicate_In1300, Sequence_In1301, RestNKeys1299, FnResult1298):-GEnv1678=[bv(sys_predicate, Predicate_In1300), bv(sequence, Sequence_In1301), bv(rest, RestNKeys1299)], catch(((get_var(GEnv1678, rest, Rest_Get1307), get_var(GEnv1678, sequence, Sequence_Get1306), f_apply(f_sys_seq_start1, [Sequence_Get1306, Rest_Get1307], Iter_Init1308), LEnv1305=[bv(sys_iter, Iter_Init1308), bv(count, 0)|GEnv1678], call_addr_block(LEnv1305, (push_label(sys_start), (get_var(LEnv1305, rest, Rest_Get1332), get_var(LEnv1305, sequence, Sequence_Get1330)), get_var(LEnv1305, sys_iter, Iter_Get1331), f_apply(f_sys_seq_end_p1, [Sequence_Get1330, Iter_Get1331, Rest_Get1332], IFTEST1328), (IFTEST1328\==[]->_TBResult1309=[];get_var(LEnv1305, sequence, Sequence_Get1336), get_var(LEnv1305, sys_iter, Iter_Get1337), get_var(LEnv1305, sys_predicate, Predicate_Get1335), f_sys_seq_ref1(Sequence_Get1336, Iter_Get1337, KeysNRest1703), get_var(LEnv1305, rest, Rest_Get1338), f_apply(f_sys_satisfies_if1, [Predicate_Get1335, KeysNRest1703, Rest_Get1338], IFTEST1333), (IFTEST1333\==[]->get_var(LEnv1305, count, Count_Get1339), 'f_+'(1, Count_Get1339, TrueResult1340), set_var(LEnv1305, count, TrueResult1340), _99768=TrueResult1340;_99768=[]), get_var(LEnv1305, sys_iter, Iter_Get1341), f_sys_seq_next1(Iter_Get1341, KeysNRest1704), goto(sys_start, LEnv1305), _TBResult1309=_GORES1342)), [addr(addr_tagbody_61_sys_start, sys_start, '$unused', GoEnv1325, ((get_var(GoEnv1325, rest, Rest_Get1314), get_var(GoEnv1325, sequence, Sequence_Get1312)), get_var(GoEnv1325, sys_iter, Iter_Get1313), f_apply(f_sys_seq_end_p1, [Sequence_Get1312, Iter_Get1313, Rest_Get1314], IFTEST1310), (IFTEST1310\==[]->_TBResult1309=[];get_var(GoEnv1325, sequence, Sequence_Get1318), get_var(GoEnv1325, sys_iter, Iter_Get1319), get_var(GoEnv1325, sys_predicate, Predicate_Get1317), f_sys_seq_ref1(Sequence_Get1318, Iter_Get1319, KeysNRest1705), get_var(GoEnv1325, rest, Rest_Get1320), f_apply(f_sys_satisfies_if1, [Predicate_Get1317, KeysNRest1705, Rest_Get1320], IFTEST1315), (IFTEST1315\==[]->get_var(GoEnv1325, count, Count_Get1321), 'f_+'(1, Count_Get1321, TrueResult1322), set_var(GoEnv1325, count, TrueResult1322), _100252=TrueResult1322;_100252=[]), get_var(GoEnv1325, sys_iter, Iter_Get1323), f_sys_seq_next1(Iter_Get1323, KeysNRest1706), goto(sys_start, GoEnv1325), _TBResult1309=_GORES1324)))]), get_var(LEnv1305, count, LetResult1304)), LetResult1304=FnResult1298), block_exit(count_if, FnResult1298), true))),
9369 set_opv(count_if, symbol_function, f_count_if),
9370 DefunResult1347=count_if,
9371 assert_lsp(count_if_not,
9372 wl:lambda_def(defun, count_if_not, f_count_if_not, [sys_predicate, sequence, c38_rest, rest], [[let, [[sys_iter, [apply, function(sys_seq_start), sequence, rest]], [count, 0]], [tagbody, sys_start, [unless, [apply, function(sys_seq_end_p), sequence, sys_iter, rest], [when, [apply, function(sys_satisfies_if_not), sys_predicate, [sys_seq_ref, sequence, sys_iter], rest], [setf, count, [+, 1, count]]], [sys_seq_next, sys_iter], [go, sys_start]]], count]])),
9373 assert_lsp(count_if_not,
9374 wl:arglist_info(count_if_not, f_count_if_not, [sys_predicate, sequence, c38_rest, rest], arginfo{all:[sys_predicate, sequence], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_predicate, sequence, rest], opt:0, req:[sys_predicate, sequence], rest:[rest], sublists:0, whole:0})),
9375 assert_lsp(count_if_not, wl:init_args(2, f_count_if_not)),
9376 assert_lsp(count_if_not,
9377 (f_count_if_not(Predicate_In1350, Sequence_In1351, RestNKeys1349, FnResult1348):-GEnv1679=[bv(sys_predicate, Predicate_In1350), bv(sequence, Sequence_In1351), bv(rest, RestNKeys1349)], catch(((get_var(GEnv1679, rest, Rest_Get1357), get_var(GEnv1679, sequence, Sequence_Get1356), f_apply(f_sys_seq_start1, [Sequence_Get1356, Rest_Get1357], Iter_Init1358), LEnv1355=[bv(sys_iter, Iter_Init1358), bv(count, 0)|GEnv1679], call_addr_block(LEnv1355, (push_label(sys_start), (get_var(LEnv1355, rest, Rest_Get1382), get_var(LEnv1355, sequence, Sequence_Get1380)), get_var(LEnv1355, sys_iter, Iter_Get1381), f_apply(f_sys_seq_end_p1, [Sequence_Get1380, Iter_Get1381, Rest_Get1382], IFTEST1378), (IFTEST1378\==[]->_TBResult1359=[];get_var(LEnv1355, sequence, Sequence_Get1386), get_var(LEnv1355, sys_iter, Iter_Get1387), get_var(LEnv1355, sys_predicate, Predicate_Get1385), f_sys_seq_ref1(Sequence_Get1386, Iter_Get1387, KeysNRest1707), get_var(LEnv1355, rest, Rest_Get1388), f_apply(f_sys_satisfies_if_not1, [Predicate_Get1385, KeysNRest1707, Rest_Get1388], IFTEST1383), (IFTEST1383\==[]->get_var(LEnv1355, count, Count_Get1389), 'f_+'(1, Count_Get1389, TrueResult1390), set_var(LEnv1355, count, TrueResult1390), _101268=TrueResult1390;_101268=[]), get_var(LEnv1355, sys_iter, Iter_Get1391), f_sys_seq_next1(Iter_Get1391, KeysNRest1708), goto(sys_start, LEnv1355), _TBResult1359=_GORES1392)), [addr(addr_tagbody_62_sys_start, sys_start, '$unused', GoEnv1375, ((get_var(GoEnv1375, rest, Rest_Get1364), get_var(GoEnv1375, sequence, Sequence_Get1362)), get_var(GoEnv1375, sys_iter, Iter_Get1363), f_apply(f_sys_seq_end_p1, [Sequence_Get1362, Iter_Get1363, Rest_Get1364], IFTEST1360), (IFTEST1360\==[]->_TBResult1359=[];get_var(GoEnv1375, sequence, Sequence_Get1368), get_var(GoEnv1375, sys_iter, Iter_Get1369), get_var(GoEnv1375, sys_predicate, Predicate_Get1367), f_sys_seq_ref1(Sequence_Get1368, Iter_Get1369, KeysNRest1709), get_var(GoEnv1375, rest, Rest_Get1370), f_apply(f_sys_satisfies_if_not1, [Predicate_Get1367, KeysNRest1709, Rest_Get1370], IFTEST1365), (IFTEST1365\==[]->get_var(GoEnv1375, count, Count_Get1371), 'f_+'(1, Count_Get1371, TrueResult1372), set_var(GoEnv1375, count, TrueResult1372), _101752=TrueResult1372;_101752=[]), get_var(GoEnv1375, sys_iter, Iter_Get1373), f_sys_seq_next1(Iter_Get1373, KeysNRest1710), goto(sys_start, GoEnv1375), _TBResult1359=_GORES1374)))]), get_var(LEnv1355, count, LetResult1354)), LetResult1354=FnResult1348), block_exit(count_if_not, FnResult1348), true))),
9378 set_opv(count_if_not, symbol_function, f_count_if_not),
9379 DefunResult1397=count_if_not,
9380 assert_lsp(remove,
9381 wl:lambda_def(defun, remove, f_remove, [sys_item, sequence, c38_rest, rest, c38_key, count], [[let, [[sys_iter, [apply, function(sys_seq_start), sequence, rest]], [sys_result, []]], [tagbody, sys_start, [unless, [apply, function(sys_seq_end_p), sequence, sys_iter, rest], [let, [[sys_elem, [sys_seq_ref, sequence, sys_iter]]], [unless, [and, [apply, function(satisfies), sys_item, sys_elem, rest], [or, [not, count], [not, [minusp, [decf, count]]]]], [push, sys_elem, sys_result]]], [sys_seq_next, sys_iter], [go, sys_start]]], [sys_seq_result, sequence, sys_iter, sys_result]]])),
9382 assert_lsp(remove,
9383 wl:arglist_info(remove, f_remove, [sys_item, sequence, c38_rest, rest, c38_key, count], arginfo{all:[sys_item, sequence], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:[count], names:[sys_item, sequence, rest, count], opt:0, req:[sys_item, sequence], rest:[rest], sublists:0, whole:0})),
9384 assert_lsp(remove, wl:init_args(2, f_remove)),
9385 assert_lsp(remove,
9386 (f_remove(Item_In1401, Sequence_In1402, RestNKeys1399, FnResult1398):-GEnv1680=[bv(sys_item, Item_In1401), bv(sequence, Sequence_In1402), bv(rest, RestNKeys1399), bv(count, Count_In)], get_kw([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)]|Env], RestNKeys1399, count, count, Count_In, []=Count_In, Count_P), catch(((get_var(GEnv1680, rest, Rest_Get1409), get_var(GEnv1680, sequence, Sequence_Get1408), f_apply(f_sys_seq_start1, [Sequence_Get1408, Rest_Get1409], Iter_Init1410), LEnv1407=[bv(sys_iter, Iter_Init1410), bv(sys_result, [])|GEnv1680], call_addr_block(LEnv1407, (push_label(sys_start), (get_var(LEnv1407, rest, Rest_Get1448), get_var(LEnv1407, sequence, Sequence_Get1446)), get_var(LEnv1407, sys_iter, Iter_Get1447), f_apply(f_sys_seq_end_p1, [Sequence_Get1446, Iter_Get1447, Rest_Get1448], IFTEST1444), (IFTEST1444\==[]->_TBResult1411=[];get_var(LEnv1407, sequence, Sequence_Get1452), get_var(LEnv1407, sys_iter, Iter_Get1453), f_sys_seq_ref1(Sequence_Get1452, Iter_Get1453, Elem_Init1454), Decf_Env=[bv(sys_elem, Elem_Init1454)|LEnv1407], get_var(Decf_Env, rest, Rest_Get1461), get_var(Decf_Env, sys_elem, Elem_Get1460), get_var(Decf_Env, sys_item, Item_Get1459), f_apply(f_satisfies1, [Item_Get1459, Elem_Get1460, Rest_Get1461], IFTEST1457), (IFTEST1457\==[]->(get_var(Decf_Env, count, Count_Get1462), f_not(Count_Get1462, FORM1_Res1465), FORM1_Res1465\==[], TrueResult1466=FORM1_Res1465->true;set_place(Decf_Env, decf, [value, count], [], Decf_R1463), f_minusp(Decf_R1463, Not_Param1688), f_not(Not_Param1688, Not_Ret1823), TrueResult1466=Not_Ret1823), IFTEST1455=TrueResult1466;IFTEST1455=[]), (IFTEST1455\==[]->LetResult1450=[];get_var(Decf_Env, sys_elem, Elem_Get1468), get_var(Decf_Env, sys_result, Result_Get1469), ElseResult1470=[Elem_Get1468|Result_Get1469], set_var(Decf_Env, sys_result, ElseResult1470), LetResult1450=ElseResult1470), get_var(LEnv1407, sys_iter, Iter_Get1471), f_sys_seq_next1(Iter_Get1471, KeysNRest1711), goto(sys_start, LEnv1407), _TBResult1411=_GORES1472)), [addr(addr_tagbody_63_sys_start, sys_start, '$unused', GoEnv1441, ((get_var(GoEnv1441, rest, Rest_Get1416), get_var(GoEnv1441, sequence, Sequence_Get1414)), get_var(GoEnv1441, sys_iter, Iter_Get1415), f_apply(f_sys_seq_end_p1, [Sequence_Get1414, Iter_Get1415, Rest_Get1416], IFTEST1412), (IFTEST1412\==[]->_TBResult1411=[];get_var(GoEnv1441, sequence, Sequence_Get1420), get_var(GoEnv1441, sys_iter, Iter_Get1421), f_sys_seq_ref1(Sequence_Get1420, Iter_Get1421, Elem_Init1422), Decf_Env=[bv(sys_elem, Elem_Init1422)|GoEnv1441], get_var(Decf_Env, rest, Rest_Get1429), get_var(Decf_Env, sys_elem, Elem_Get1428), get_var(Decf_Env, sys_item, Item_Get1427), f_apply(f_satisfies1, [Item_Get1427, Elem_Get1428, Rest_Get1429], IFTEST1425), (IFTEST1425\==[]->(get_var(Decf_Env, count, Count_Get1430), f_not(Count_Get1430, FORM1_Res1433), FORM1_Res1433\==[], TrueResult1434=FORM1_Res1433->true;set_place(Decf_Env, decf, [value, count], [], Minusp_Param), f_minusp(Minusp_Param, Not_Param1690), f_not(Not_Param1690, Not_Ret1824), TrueResult1434=Not_Ret1824), IFTEST1423=TrueResult1434;IFTEST1423=[]), (IFTEST1423\==[]->LetResult1418=[];get_var(Decf_Env, sys_elem, Elem_Get1436), get_var(Decf_Env, sys_result, Result_Get1437), ElseResult1438=[Elem_Get1436|Result_Get1437], set_var(Decf_Env, sys_result, ElseResult1438), LetResult1418=ElseResult1438), get_var(GoEnv1441, sys_iter, Iter_Get1439), f_sys_seq_next1(Iter_Get1439, KeysNRest1712), goto(sys_start, GoEnv1441), _TBResult1411=_GORES1440)))]), get_var(LEnv1407, sequence, Sequence_Get1475), get_var(LEnv1407, sys_iter, Iter_Get1476), get_var(LEnv1407, sys_result, Result_Get1477), f_sys_seq_result1(Sequence_Get1475, Iter_Get1476, Result_Get1477, LetResult1406)), LetResult1406=FnResult1398), block_exit(remove, FnResult1398), true))),
9387 set_opv(remove, symbol_function, f_remove),
9388 DefunResult1479=remove,
9389 assert_lsp(remove_if,
9390 wl:lambda_def(defun, remove_if, f_remove_if, [sys_predicate, sequence, c38_rest, rest, c38_key, count], [[let, [[sys_iter, [apply, function(sys_seq_start), sequence, rest]], [sys_result, []]], [tagbody, sys_start, [unless, [apply, function(sys_seq_end_p), sequence, sys_iter, rest], [let, [[sys_elem, [sys_seq_ref, sequence, sys_iter]]], [unless, [and, [apply, function(sys_satisfies_if), sys_predicate, sys_elem, rest], [or, [not, count], [not, [minusp, [decf, count]]]]], [push, sys_elem, sys_result]]], [sys_seq_next, sys_iter], [go, sys_start]]], [sys_seq_result, sequence, sys_iter, sys_result]]])),
9391 assert_lsp(remove_if,
9392 wl:arglist_info(remove_if, f_remove_if, [sys_predicate, sequence, c38_rest, rest, c38_key, count], arginfo{all:[sys_predicate, sequence], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:[count], names:[sys_predicate, sequence, rest, count], opt:0, req:[sys_predicate, sequence], rest:[rest], sublists:0, whole:0})),
9393 assert_lsp(remove_if, wl:init_args(2, f_remove_if)),
9394 assert_lsp(remove_if,
9395 (f_remove_if(Predicate_In1483, Sequence_In1484, RestNKeys1481, FnResult1480):-GEnv1681=[bv(sys_predicate, Predicate_In1483), bv(sequence, Sequence_In1484), bv(rest, RestNKeys1481), bv(count, Count_In1486)], get_kw([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)]|Env], RestNKeys1481, count, count, Count_In1486, []=Count_In1486, Count_P1482), catch(((get_var(GEnv1681, rest, Rest_Get1491), get_var(GEnv1681, sequence, Sequence_Get1490), f_apply(f_sys_seq_start1, [Sequence_Get1490, Rest_Get1491], Iter_Init1492), LEnv1489=[bv(sys_iter, Iter_Init1492), bv(sys_result, [])|GEnv1681], call_addr_block(LEnv1489, (push_label(sys_start), (get_var(LEnv1489, rest, Rest_Get1530), get_var(LEnv1489, sequence, Sequence_Get1528)), get_var(LEnv1489, sys_iter, Iter_Get1529), f_apply(f_sys_seq_end_p1, [Sequence_Get1528, Iter_Get1529, Rest_Get1530], IFTEST1526), (IFTEST1526\==[]->_TBResult1493=[];get_var(LEnv1489, sequence, Sequence_Get1534), get_var(LEnv1489, sys_iter, Iter_Get1535), f_sys_seq_ref1(Sequence_Get1534, Iter_Get1535, Elem_Init1536), Decf_Env=[bv(sys_elem, Elem_Init1536)|LEnv1489], get_var(Decf_Env, rest, Rest_Get1543), get_var(Decf_Env, sys_elem, Elem_Get1542), get_var(Decf_Env, sys_predicate, Predicate_Get1541), f_apply(f_sys_satisfies_if1, [Predicate_Get1541, Elem_Get1542, Rest_Get1543], IFTEST1539), (IFTEST1539\==[]->(get_var(Decf_Env, count, Count_Get1544), f_not(Count_Get1544, FORM1_Res1547), FORM1_Res1547\==[], TrueResult1548=FORM1_Res1547->true;set_place(Decf_Env, decf, [value, count], [], Decf_R1545), f_minusp(Decf_R1545, Not_Param1691), f_not(Not_Param1691, Not_Ret1825), TrueResult1548=Not_Ret1825), IFTEST1537=TrueResult1548;IFTEST1537=[]), (IFTEST1537\==[]->LetResult1532=[];get_var(Decf_Env, sys_elem, Elem_Get1550), get_var(Decf_Env, sys_result, Result_Get1551), ElseResult1552=[Elem_Get1550|Result_Get1551], set_var(Decf_Env, sys_result, ElseResult1552), LetResult1532=ElseResult1552), get_var(LEnv1489, sys_iter, Iter_Get1553), f_sys_seq_next1(Iter_Get1553, KeysNRest1713), goto(sys_start, LEnv1489), _TBResult1493=_GORES1554)), [addr(addr_tagbody_64_sys_start, sys_start, '$unused', GoEnv1523, ((get_var(GoEnv1523, rest, Rest_Get1498), get_var(GoEnv1523, sequence, Sequence_Get1496)), get_var(GoEnv1523, sys_iter, Iter_Get1497), f_apply(f_sys_seq_end_p1, [Sequence_Get1496, Iter_Get1497, Rest_Get1498], IFTEST1494), (IFTEST1494\==[]->_TBResult1493=[];get_var(GoEnv1523, sequence, Sequence_Get1502), get_var(GoEnv1523, sys_iter, Iter_Get1503), f_sys_seq_ref1(Sequence_Get1502, Iter_Get1503, Elem_Init1504), Decf_Env=[bv(sys_elem, Elem_Init1504)|GoEnv1523], get_var(Decf_Env, rest, Rest_Get1511), get_var(Decf_Env, sys_elem, Elem_Get1510), get_var(Decf_Env, sys_predicate, Predicate_Get1509), f_apply(f_sys_satisfies_if1, [Predicate_Get1509, Elem_Get1510, Rest_Get1511], IFTEST1507), (IFTEST1507\==[]->(get_var(Decf_Env, count, Count_Get1512), f_not(Count_Get1512, FORM1_Res1515), FORM1_Res1515\==[], TrueResult1516=FORM1_Res1515->true;set_place(Decf_Env, decf, [value, count], [], Decf_R1513), f_minusp(Decf_R1513, Not_Param1692), f_not(Not_Param1692, Not_Ret1826), TrueResult1516=Not_Ret1826), IFTEST1505=TrueResult1516;IFTEST1505=[]), (IFTEST1505\==[]->LetResult1500=[];get_var(Decf_Env, sys_elem, Elem_Get1518), get_var(Decf_Env, sys_result, Result_Get1519), ElseResult1520=[Elem_Get1518|Result_Get1519], set_var(Decf_Env, sys_result, ElseResult1520), LetResult1500=ElseResult1520), get_var(GoEnv1523, sys_iter, Iter_Get1521), f_sys_seq_next1(Iter_Get1521, KeysNRest1714), goto(sys_start, GoEnv1523), _TBResult1493=_GORES1522)))]), get_var(LEnv1489, sequence, Sequence_Get1557), get_var(LEnv1489, sys_iter, Iter_Get1558), get_var(LEnv1489, sys_result, Result_Get1559), f_sys_seq_result1(Sequence_Get1557, Iter_Get1558, Result_Get1559, LetResult1488)), LetResult1488=FnResult1480), block_exit(remove_if, FnResult1480), true))),
9396 set_opv(remove_if, symbol_function, f_remove_if),
9397 DefunResult1561=remove_if,
9398 assert_lsp(remove_if_not,
9399 wl:lambda_def(defun, remove_if_not, f_remove_if_not, [sys_predicate, sequence, c38_rest, rest, c38_key, count], [[let, [[sys_iter, [apply, function(sys_seq_start), sequence, rest]], [sys_result, []]], [tagbody, sys_start, [unless, [apply, function(sys_seq_end_p), sequence, sys_iter, rest], [let, [[sys_elem, [sys_seq_ref, sequence, sys_iter]]], [unless, [and, [apply, function(sys_satisfies_if_not), sys_predicate, sys_elem, rest], [or, [not, count], [not, [minusp, [decf, count]]]]], [push, sys_elem, sys_result]]], [sys_seq_next, sys_iter], [go, sys_start]]], [sys_seq_result, sequence, sys_iter, sys_result]]])),
9400 assert_lsp(remove_if_not,
9401 wl:arglist_info(remove_if_not, f_remove_if_not, [sys_predicate, sequence, c38_rest, rest, c38_key, count], arginfo{all:[sys_predicate, sequence], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:[count], names:[sys_predicate, sequence, rest, count], opt:0, req:[sys_predicate, sequence], rest:[rest], sublists:0, whole:0})),
9402 assert_lsp(remove_if_not, wl:init_args(2, f_remove_if_not)),
9403 assert_lsp(remove_if_not,
9404 (f_remove_if_not(Predicate_In1565, Sequence_In1566, RestNKeys1563, FnResult1562):-GEnv1682=[bv(sys_predicate, Predicate_In1565), bv(sequence, Sequence_In1566), bv(rest, RestNKeys1563), bv(count, Count_In1568)], get_kw([[fbound(satisfies, kw_function)=function(f_satisfies1), fbound(sys_satisfies_if, kw_function)=function(f_sys_satisfies_if1), fbound(sys_satisfies_if_not, kw_function)=function(f_sys_satisfies_if_not1), fbound(sys_seq_start, kw_function)=function(f_sys_seq_start1), fbound(sys_seq_position, kw_function)=function(f_sys_seq_position1), fbound(sys_seq_next, kw_function)=function(f_sys_seq_next1), fbound(sys_seq_ref, kw_function)=function(f_sys_seq_ref1), fbound(sys_seq_set, kw_function)=function(f_sys_seq_set1), fbound(sys_seq_end_p, kw_function)=function(f_sys_seq_end_p1), fbound(sys_seq_result, kw_function)=function(f_sys_seq_result1)]|Env], RestNKeys1563, count, count, Count_In1568, []=Count_In1568, Count_P1564), catch(((get_var(GEnv1682, rest, Rest_Get1573), get_var(GEnv1682, sequence, Sequence_Get1572), f_apply(f_sys_seq_start1, [Sequence_Get1572, Rest_Get1573], Iter_Init1574), LEnv1571=[bv(sys_iter, Iter_Init1574), bv(sys_result, [])|GEnv1682], call_addr_block(LEnv1571, (push_label(sys_start), (get_var(LEnv1571, rest, Rest_Get1612), get_var(LEnv1571, sequence, Sequence_Get1610)), get_var(LEnv1571, sys_iter, Iter_Get1611), f_apply(f_sys_seq_end_p1, [Sequence_Get1610, Iter_Get1611, Rest_Get1612], IFTEST1608), (IFTEST1608\==[]->_TBResult1575=[];get_var(LEnv1571, sequence, Sequence_Get1616), get_var(LEnv1571, sys_iter, Iter_Get1617), f_sys_seq_ref1(Sequence_Get1616, Iter_Get1617, Elem_Init1618), Decf_Env=[bv(sys_elem, Elem_Init1618)|LEnv1571], get_var(Decf_Env, rest, Rest_Get1625), get_var(Decf_Env, sys_elem, Elem_Get1624), get_var(Decf_Env, sys_predicate, Predicate_Get1623), f_apply(f_sys_satisfies_if_not1, [Predicate_Get1623, Elem_Get1624, Rest_Get1625], IFTEST1621), (IFTEST1621\==[]->(get_var(Decf_Env, count, Count_Get1626), f_not(Count_Get1626, FORM1_Res1629), FORM1_Res1629\==[], TrueResult1630=FORM1_Res1629->true;set_place(Decf_Env, decf, [value, count], [], Decf_R1627), f_minusp(Decf_R1627, Not_Param1693), f_not(Not_Param1693, Not_Ret1827), TrueResult1630=Not_Ret1827), IFTEST1619=TrueResult1630;IFTEST1619=[]), (IFTEST1619\==[]->LetResult1614=[];get_var(Decf_Env, sys_elem, Elem_Get1632), get_var(Decf_Env, sys_result, Result_Get1633), ElseResult1634=[Elem_Get1632|Result_Get1633], set_var(Decf_Env, sys_result, ElseResult1634), LetResult1614=ElseResult1634), get_var(LEnv1571, sys_iter, Iter_Get1635), f_sys_seq_next1(Iter_Get1635, KeysNRest1715), goto(sys_start, LEnv1571), _TBResult1575=_GORES1636)), [addr(addr_tagbody_65_sys_start, sys_start, '$unused', GoEnv1605, ((get_var(GoEnv1605, rest, Rest_Get1580), get_var(GoEnv1605, sequence, Sequence_Get1578)), get_var(GoEnv1605, sys_iter, Iter_Get1579), f_apply(f_sys_seq_end_p1, [Sequence_Get1578, Iter_Get1579, Rest_Get1580], IFTEST1576), (IFTEST1576\==[]->_TBResult1575=[];get_var(GoEnv1605, sequence, Sequence_Get1584), get_var(GoEnv1605, sys_iter, Iter_Get1585), f_sys_seq_ref1(Sequence_Get1584, Iter_Get1585, Elem_Init1586), Decf_Env=[bv(sys_elem, Elem_Init1586)|GoEnv1605], get_var(Decf_Env, rest, Rest_Get1593), get_var(Decf_Env, sys_elem, Elem_Get1592), get_var(Decf_Env, sys_predicate, Predicate_Get1591), f_apply(f_sys_satisfies_if_not1, [Predicate_Get1591, Elem_Get1592, Rest_Get1593], IFTEST1589), (IFTEST1589\==[]->(get_var(Decf_Env, count, Count_Get1594), f_not(Count_Get1594, FORM1_Res1597), FORM1_Res1597\==[], TrueResult1598=FORM1_Res1597->true;set_place(Decf_Env, decf, [value, count], [], Decf_R1595), f_minusp(Decf_R1595, Not_Param1694), f_not(Not_Param1694, Not_Ret1828), TrueResult1598=Not_Ret1828), IFTEST1587=TrueResult1598;IFTEST1587=[]), (IFTEST1587\==[]->LetResult1582=[];get_var(Decf_Env, sys_elem, Elem_Get1600), get_var(Decf_Env, sys_result, Result_Get1601), ElseResult1602=[Elem_Get1600|Result_Get1601], set_var(Decf_Env, sys_result, ElseResult1602), LetResult1582=ElseResult1602), get_var(GoEnv1605, sys_iter, Iter_Get1603), f_sys_seq_next1(Iter_Get1603, KeysNRest1716), goto(sys_start, GoEnv1605), _TBResult1575=_GORES1604)))]), get_var(LEnv1571, sequence, Sequence_Get1639), get_var(LEnv1571, sys_iter, Iter_Get1640), get_var(LEnv1571, sys_result, Result_Get1641), f_sys_seq_result1(Sequence_Get1639, Iter_Get1640, Result_Get1641, LetResult1570)), LetResult1570=FnResult1562), block_exit(remove_if_not, FnResult1562), true))),
9405 set_opv(remove_if_not, symbol_function, f_remove_if_not),
9406 DefunResult1643=remove_if_not. 9407/*
9408:- side_effect(assert_lsp(satisfies,
9409 lambda_def(defun,
9410 satisfies,
9411 f_satisfies1,
9412
9413 [ sys_object,
9414 sys_elem,
9415 c38_key,
9416 key,
9417 sys_test,
9418 sys_test_not
9419 ],
9420
9421 [
9422 [ let_xx,
9423
9424 [
9425 [ sys_zi,
9426
9427 [ if,
9428 key,
9429 [funcall, key, sys_elem],
9430 sys_elem
9431 ]
9432 ],
9433
9434 [ sys_r,
9435
9436 [ funcall,
9437
9438 [ or,
9439 sys_test,
9440 sys_test_not,
9441 function(eql)
9442 ],
9443 sys_object,
9444 sys_zi
9445 ]
9446 ]
9447 ],
9448 [if, sys_test_not, [not, sys_r], sys_r]
9449 ]
9450 ]))).
9451*/
9452/*
9453:- side_effect(assert_lsp(satisfies,
9454 arglist_info(satisfies,
9455 f_satisfies1,
9456
9457 [ sys_object,
9458 sys_elem,
9459 c38_key,
9460 key,
9461 sys_test,
9462 sys_test_not
9463 ],
9464 arginfo{ all:[sys_object, sys_elem],
9465 allow_other_keys:0,
9466 aux:0,
9467 body:0,
9468 complex:0,
9469 env:0,
9470 key:
9471 [ key,
9472 sys_test,
9473 sys_test_not
9474 ],
9475 names:
9476 [ sys_object,
9477 sys_elem,
9478 key,
9479 sys_test,
9480 sys_test_not
9481 ],
9482 opt:0,
9483 req:[sys_object, sys_elem],
9484 rest:0,
9485 sublists:0,
9486 whole:0
9487 }))).
9488*/
9489/*
9490:- side_effect(assert_lsp(satisfies, init_args(2, f_satisfies1))).
9491*/
9492/*
9493:- side_effect(assert_lsp(sys_satisfies_if,
9494 lambda_def(defun,
9495 sys_satisfies_if,
9496 f_sys_satisfies_if1,
9497 [sys_predicate, sys_elem, c38_key, key],
9498
9499 [
9500 [ funcall,
9501 sys_predicate,
9502
9503 [ if,
9504 key,
9505 [funcall, key, sys_elem],
9506 sys_elem
9507 ]
9508 ]
9509 ]))).
9510*/
9511/*
9512:- side_effect(assert_lsp(sys_satisfies_if,
9513 arglist_info(sys_satisfies_if,
9514 f_sys_satisfies_if1,
9515 [sys_predicate, sys_elem, c38_key, key],
9516 arginfo{ all:[sys_predicate, sys_elem],
9517 allow_other_keys:0,
9518 aux:0,
9519 body:0,
9520 complex:0,
9521 env:0,
9522 key:[key],
9523 names:
9524 [ sys_predicate,
9525 sys_elem,
9526 key
9527 ],
9528 opt:0,
9529 req:[sys_predicate, sys_elem],
9530 rest:0,
9531 sublists:0,
9532 whole:0
9533 }))).
9534*/
9535/*
9536:- side_effect(assert_lsp(sys_satisfies_if, init_args(2, f_sys_satisfies_if1))).
9537*/
9538/*
9539:- side_effect(assert_lsp(sys_satisfies_if_not,
9540 lambda_def(defun,
9541 sys_satisfies_if_not,
9542 f_sys_satisfies_if_not1,
9543 [sys_predicate, sys_elem, c38_key, key],
9544
9545 [
9546 [ not,
9547
9548 [ funcall,
9549 sys_predicate,
9550
9551 [ if,
9552 key,
9553 [funcall, key, sys_elem],
9554 sys_elem
9555 ]
9556 ]
9557 ]
9558 ]))).
9559*/
9560/*
9561:- side_effect(assert_lsp(sys_satisfies_if_not,
9562 arglist_info(sys_satisfies_if_not,
9563 f_sys_satisfies_if_not1,
9564 [sys_predicate, sys_elem, c38_key, key],
9565 arginfo{ all:[sys_predicate, sys_elem],
9566 allow_other_keys:0,
9567 aux:0,
9568 body:0,
9569 complex:0,
9570 env:0,
9571 key:[key],
9572 names:
9573 [ sys_predicate,
9574 sys_elem,
9575 key
9576 ],
9577 opt:0,
9578 req:[sys_predicate, sys_elem],
9579 rest:0,
9580 sublists:0,
9581 whole:0
9582 }))).
9583*/
9584/*
9585:- side_effect(assert_lsp(sys_satisfies_if_not,
9586 init_args(2, f_sys_satisfies_if_not1))).
9587*/
9588/*
9589:- side_effect(assert_lsp(sys_seq_start,
9590 lambda_def(defun,
9591 sys_seq_start,
9592 f_sys_seq_start1,
9593
9594 [ sequence,
9595 c38_key,
9596 [sys_start, 0],
9597 sys_end,
9598 sys_from_end
9599 ],
9600
9601 [
9602 [ if,
9603 [listp, sequence],
9604
9605 [ if,
9606 sys_from_end,
9607
9608 [ let,
9609
9610 [ [sys_acc, []],
9611
9612 [ sequence,
9613 [nthcdr, sys_start, sequence]
9614 ]
9615 ],
9616
9617 [ tagbody,
9618 sys_start,
9619
9620 [ when,
9621
9622 [ and,
9623 sequence,
9624
9625 [ or,
9626 [not, sys_end],
9627 [<, sys_start, sys_end]
9628 ]
9629 ],
9630 [push, sequence, sys_acc],
9631
9632 [ setf,
9633 sequence,
9634 [cdr, sequence]
9635 ],
9636
9637 [ setf,
9638 sys_start,
9639 [+, 1, sys_start]
9640 ],
9641 [go, sys_start]
9642 ]
9643 ],
9644 [list, 3, sys_acc, sys_start]
9645 ],
9646
9647 [ list,
9648 2,
9649 [nthcdr, sys_start, sequence],
9650 sys_start
9651 ]
9652 ],
9653
9654 [ if,
9655 sys_from_end,
9656 [cons, 1, [-, sys_end, 1]],
9657 [cons, 0, sys_start]
9658 ]
9659 ]
9660 ]))).
9661*/
9662/*
9663:- side_effect(assert_lsp(sys_seq_start,
9664 arglist_info(sys_seq_start,
9665 f_sys_seq_start1,
9666
9667 [ sequence,
9668 c38_key,
9669 [sys_start, 0],
9670 sys_end,
9671 sys_from_end
9672 ],
9673 arginfo{ all:[sequence],
9674 allow_other_keys:0,
9675 aux:0,
9676 body:0,
9677 complex:0,
9678 env:0,
9679 key:
9680 [ sys_start,
9681 sys_end,
9682 sys_from_end
9683 ],
9684 names:
9685 [ sequence,
9686 sys_start,
9687 sys_end,
9688 sys_from_end
9689 ],
9690 opt:0,
9691 req:[sequence],
9692 rest:0,
9693 sublists:0,
9694 whole:0
9695 }))).
9696*/
9697/*
9698:- side_effect(assert_lsp(sys_seq_start, init_args(1, f_sys_seq_start1))).
9699*/
9700/*
9701:- side_effect(assert_lsp(sys_seq_position,
9702 lambda_def(defun,
9703 sys_seq_position,
9704 f_sys_seq_position1,
9705 [sys_iter],
9706
9707 [
9708 [ case,
9709 [car, sys_iter],
9710 [[0, 1], [cdr, sys_iter]],
9711 [t, [caddr, sys_iter]]
9712 ]
9713 ]))).
9714*/
9715/*
9716:- side_effect(assert_lsp(sys_seq_position,
9717 arglist_info(sys_seq_position,
9718 f_sys_seq_position1,
9719 [sys_iter],
9720 arginfo{ all:[sys_iter],
9721 allow_other_keys:0,
9722 aux:0,
9723 body:0,
9724 complex:0,
9725 env:0,
9726 key:0,
9727 names:[sys_iter],
9728 opt:0,
9729 req:[sys_iter],
9730 rest:0,
9731 sublists:0,
9732 whole:0
9733 }))).
9734*/
9735/*
9736:- side_effect(assert_lsp(sys_seq_position, init_args(1, f_sys_seq_position1))).
9737*/
9738/*
9739:- side_effect(assert_lsp(sys_seq_next,
9740 lambda_def(defun,
9741 sys_seq_next,
9742 f_sys_seq_next1,
9743 [sys_iter],
9744
9745 [
9746 [ case,
9747 [car, sys_iter],
9748
9749 [ 0,
9750
9751 [ setf,
9752 [cdr, sys_iter],
9753 [+, 1, [cdr, sys_iter]]
9754 ]
9755 ],
9756
9757 [ 1,
9758
9759 [ setf,
9760 [cdr, sys_iter],
9761 [-, [cdr, sys_iter], 1]
9762 ]
9763 ],
9764
9765 [ 2,
9766
9767 [ setf,
9768 [cadr, sys_iter],
9769 [cdadr, sys_iter]
9770 ],
9771
9772 [ setf,
9773 [caddr, sys_iter],
9774 [+, 1, [caddr, sys_iter]]
9775 ]
9776 ],
9777
9778 [ t,
9779
9780 [ setf,
9781 [cadr, sys_iter],
9782 [cdadr, sys_iter]
9783 ],
9784
9785 [ setf,
9786 [caddr, sys_iter],
9787 [-, [caddr, sys_iter], 1]
9788 ]
9789 ]
9790 ]
9791 ]))).
9792*/
9793/*
9794:- side_effect(assert_lsp(sys_seq_next,
9795 arglist_info(sys_seq_next,
9796 f_sys_seq_next1,
9797 [sys_iter],
9798 arginfo{ all:[sys_iter],
9799 allow_other_keys:0,
9800 aux:0,
9801 body:0,
9802 complex:0,
9803 env:0,
9804 key:0,
9805 names:[sys_iter],
9806 opt:0,
9807 req:[sys_iter],
9808 rest:0,
9809 sublists:0,
9810 whole:0
9811 }))).
9812*/
9813/*
9814:- side_effect(assert_lsp(sys_seq_next, init_args(1, f_sys_seq_next1))).
9815*/
9816/*
9817:- side_effect(assert_lsp(sys_seq_ref,
9818 lambda_def(defun,
9819 sys_seq_ref,
9820 f_sys_seq_ref1,
9821 [sequence, sys_iter],
9822
9823 [
9824 [ case,
9825 [car, sys_iter],
9826
9827 [ [0, 1],
9828 [aref, sequence, [cdr, sys_iter]]
9829 ],
9830 [2, [caadr, sys_iter]],
9831 [t, [caaadr, sys_iter]]
9832 ]
9833 ]))).
9834*/
9835/*
9836:- side_effect(assert_lsp(sys_seq_ref,
9837 arglist_info(sys_seq_ref,
9838 f_sys_seq_ref1,
9839 [sequence, sys_iter],
9840 arginfo{ all:[sequence, sys_iter],
9841 allow_other_keys:0,
9842 aux:0,
9843 body:0,
9844 complex:0,
9845 env:0,
9846 key:0,
9847 names:[sequence, sys_iter],
9848 opt:0,
9849 req:[sequence, sys_iter],
9850 rest:0,
9851 sublists:0,
9852 whole:0
9853 }))).
9854*/
9855/*
9856:- side_effect(assert_lsp(sys_seq_ref, init_args(2, f_sys_seq_ref1))).
9857*/
9858/*
9859:- side_effect(assert_lsp(sys_seq_set,
9860 lambda_def(defun,
9861 sys_seq_set,
9862 f_sys_seq_set1,
9863 [sequence, sys_iter, sys_value],
9864
9865 [
9866 [ case,
9867 [car, sys_iter],
9868
9869 [ [0, 1],
9870
9871 [ setf,
9872 [aref, sequence, [cdr, sys_iter]],
9873 sys_value
9874 ]
9875 ],
9876 [2, [setf, [caadr, sys_iter], sys_value]],
9877
9878 [ t,
9879 [setf, [caaadr, sys_iter], sys_value]
9880 ]
9881 ]
9882 ]))).
9883*/
9884/*
9885:- side_effect(assert_lsp(sys_seq_set,
9886 arglist_info(sys_seq_set,
9887 f_sys_seq_set1,
9888 [sequence, sys_iter, sys_value],
9889 arginfo{ all:
9890 [ sequence,
9891 sys_iter,
9892 sys_value
9893 ],
9894 allow_other_keys:0,
9895 aux:0,
9896 body:0,
9897 complex:0,
9898 env:0,
9899 key:0,
9900 names:
9901 [ sequence,
9902 sys_iter,
9903 sys_value
9904 ],
9905 opt:0,
9906 req:
9907 [ sequence,
9908 sys_iter,
9909 sys_value
9910 ],
9911 rest:0,
9912 sublists:0,
9913 whole:0
9914 }))).
9915*/
9916/*
9917:- side_effect(assert_lsp(sys_seq_set, init_args(3, f_sys_seq_set1))).
9918*/
9919/*
9920:- side_effect(assert_lsp(sys_seq_end_p,
9921 lambda_def(defun,
9922 sys_seq_end_p,
9923 f_sys_seq_end_p1,
9924
9925 [ sequence,
9926 sys_iter,
9927 c38_key,
9928 sys_start,
9929 sys_end,
9930 sys_from_end
9931 ],
9932
9933 [
9934 [ case,
9935 [car, sys_iter],
9936
9937 [ 0,
9938
9939 [ or,
9940
9941 [ (=),
9942 [cdr, sys_iter],
9943 [length, sequence]
9944 ],
9945
9946 [ and,
9947 sys_end,
9948 [=, sys_end, [cdr, sys_iter]]
9949 ]
9950 ]
9951 ],
9952 [1, [<, [cdr, sys_iter], sys_start]],
9953
9954 [ 2,
9955
9956 [ or,
9957 [null, [cadr, sys_iter]],
9958
9959 [ and,
9960 sys_end,
9961 [=, sys_end, [caddr, sys_iter]]
9962 ]
9963 ]
9964 ],
9965
9966 [ t,
9967
9968 [ or,
9969 [null, [cadr, sys_iter]],
9970 [<, [caddr, sys_iter], sys_start]
9971 ]
9972 ]
9973 ]
9974 ]))).
9975*/
9976/*
9977:- side_effect(assert_lsp(sys_seq_end_p,
9978 arglist_info(sys_seq_end_p,
9979 f_sys_seq_end_p1,
9980
9981 [ sequence,
9982 sys_iter,
9983 c38_key,
9984 sys_start,
9985 sys_end,
9986 sys_from_end
9987 ],
9988 arginfo{ all:[sequence, sys_iter],
9989 allow_other_keys:0,
9990 aux:0,
9991 body:0,
9992 complex:0,
9993 env:0,
9994 key:
9995 [ sys_start,
9996 sys_end,
9997 sys_from_end
9998 ],
9999 names:
10000 [ sequence,
10001 sys_iter,
10002 sys_start,
10003 sys_end,
10004 sys_from_end
10005 ],
10006 opt:0,
10007 req:[sequence, sys_iter],
10008 rest:0,
10009 sublists:0,
10010 whole:0
10011 }))).
10012*/
10013/*
10014:- side_effect(assert_lsp(sys_seq_end_p, init_args(2, f_sys_seq_end_p1))).
10015*/
10016/*
10017:- side_effect(assert_lsp(sys_seq_result,
10018 lambda_def(defun,
10019 sys_seq_result,
10020 f_sys_seq_result1,
10021 [sequence, sys_iter, sys_result],
10022
10023 [
10024 [ case,
10025 [car, sys_iter],
10026
10027 [ 0,
10028
10029 [ make_array,
10030 [length, sys_result],
10031 kw_element_type,
10032 [array_element_type, sequence],
10033 kw_initial_contents,
10034 [reverse, sys_result]
10035 ]
10036 ],
10037
10038 [ 1,
10039
10040 [ make_array,
10041 [length, sys_result],
10042 kw_element_type,
10043 [array_element_type, sequence],
10044 kw_initial_contents,
10045 sys_result
10046 ]
10047 ],
10048 [2, [reverse, sys_result]],
10049 [3, sys_result]
10050 ]
10051 ]))).
10052*/
10053/*
10054:- side_effect(assert_lsp(sys_seq_result,
10055 arglist_info(sys_seq_result,
10056 f_sys_seq_result1,
10057 [sequence, sys_iter, sys_result],
10058 arginfo{ all:
10059 [ sequence,
10060 sys_iter,
10061 sys_result
10062 ],
10063 allow_other_keys:0,
10064 aux:0,
10065 body:0,
10066 complex:0,
10067 env:0,
10068 key:0,
10069 names:
10070 [ sequence,
10071 sys_iter,
10072 sys_result
10073 ],
10074 opt:0,
10075 req:
10076 [ sequence,
10077 sys_iter,
10078 sys_result
10079 ],
10080 rest:0,
10081 sublists:0,
10082 whole:0
10083 }))).
10084*/
10085/*
10086:- side_effect(assert_lsp(sys_seq_result, init_args(3, f_sys_seq_result1))).
10087*/
10088/*
10089:- side_effect(assert_lsp(subst,
10090 lambda_def(defun,
10091 subst,
10092 f_subst,
10093 [sys_new, sys_old, sys_tree, c38_rest, rest],
10094
10095 [
10096 [ if,
10097 [consp, sys_tree],
10098
10099 [ let,
10100
10101 [
10102 [ sys_a,
10103
10104 [ apply,
10105 function(subst),
10106 sys_new,
10107 sys_old,
10108 [car, sys_tree],
10109 rest
10110 ]
10111 ],
10112
10113 [ sys_d,
10114
10115 [ apply,
10116 function(subst),
10117 sys_new,
10118 sys_old,
10119 [cdr, sys_tree],
10120 rest
10121 ]
10122 ]
10123 ],
10124
10125 [ if,
10126
10127 [ and,
10128 [eq, sys_a, [car, sys_tree]],
10129 [eq, sys_d, [cdr, sys_tree]]
10130 ],
10131 sys_tree,
10132 [cons, sys_a, sys_d]
10133 ]
10134 ],
10135
10136 [ if,
10137
10138 [ apply,
10139 function(satisfies),
10140 sys_old,
10141 sys_tree,
10142 rest
10143 ],
10144 sys_new,
10145 sys_tree
10146 ]
10147 ]
10148 ]))).
10149*/
10150/*
10151:- side_effect(assert_lsp(subst,
10152 arglist_info(subst,
10153 f_subst,
10154
10155 [ sys_new,
10156 sys_old,
10157 sys_tree,
10158 c38_rest,
10159 rest
10160 ],
10161 arginfo{ all:[sys_new, sys_old, sys_tree],
10162 allow_other_keys:0,
10163 aux:0,
10164 body:0,
10165 complex:[rest],
10166 env:0,
10167 key:0,
10168 names:
10169 [ sys_new,
10170 sys_old,
10171 sys_tree,
10172 rest
10173 ],
10174 opt:0,
10175 req:[sys_new, sys_old, sys_tree],
10176 rest:[rest],
10177 sublists:0,
10178 whole:0
10179 }))).
10180*/
10181/*
10182:- side_effect(assert_lsp(subst, init_args(3, f_subst))).
10183*/
10184/*
10185:- side_effect(assert_lsp(subst_if,
10186 lambda_def(defun,
10187 subst_if,
10188 f_subst_if,
10189
10190 [ sys_new,
10191 sys_predicate,
10192 sys_tree,
10193 c38_rest,
10194 rest
10195 ],
10196
10197 [
10198 [ if,
10199 [consp, sys_tree],
10200
10201 [ let,
10202
10203 [
10204 [ sys_a,
10205
10206 [ apply,
10207 function(subst),
10208 sys_new,
10209 sys_predicate,
10210 [car, sys_tree],
10211 rest
10212 ]
10213 ],
10214
10215 [ sys_d,
10216
10217 [ apply,
10218 function(subst),
10219 sys_new,
10220 sys_predicate,
10221 [cdr, sys_tree],
10222 rest
10223 ]
10224 ]
10225 ],
10226
10227 [ if,
10228
10229 [ and,
10230 [eq, sys_a, [car, sys_tree]],
10231 [eq, sys_d, [cdr, sys_tree]]
10232 ],
10233 sys_tree,
10234 [cons, sys_a, sys_d]
10235 ]
10236 ],
10237
10238 [ if,
10239
10240 [ apply,
10241 function(sys_satisfies_if),
10242 sys_predicate,
10243 sys_tree,
10244 rest
10245 ],
10246 sys_new,
10247 sys_tree
10248 ]
10249 ]
10250 ]))).
10251*/
10252/*
10253:- side_effect(assert_lsp(subst_if,
10254 arglist_info(subst_if,
10255 f_subst_if,
10256
10257 [ sys_new,
10258 sys_predicate,
10259 sys_tree,
10260 c38_rest,
10261 rest
10262 ],
10263 arginfo{ all:
10264 [ sys_new,
10265 sys_predicate,
10266 sys_tree
10267 ],
10268 allow_other_keys:0,
10269 aux:0,
10270 body:0,
10271 complex:[rest],
10272 env:0,
10273 key:0,
10274 names:
10275 [ sys_new,
10276 sys_predicate,
10277 sys_tree,
10278 rest
10279 ],
10280 opt:0,
10281 req:
10282 [ sys_new,
10283 sys_predicate,
10284 sys_tree
10285 ],
10286 rest:[rest],
10287 sublists:0,
10288 whole:0
10289 }))).
10290*/
10291/*
10292:- side_effect(assert_lsp(subst_if, init_args(3, f_subst_if))).
10293*/
10294/*
10295:- side_effect(assert_lsp(subst_if_not,
10296 lambda_def(defun,
10297 subst_if_not,
10298 f_subst_if_not,
10299
10300 [ sys_new,
10301 sys_predicate,
10302 sys_tree,
10303 c38_rest,
10304 rest
10305 ],
10306
10307 [
10308 [ if,
10309 [consp, sys_tree],
10310
10311 [ let,
10312
10313 [
10314 [ sys_a,
10315
10316 [ apply,
10317 function(subst),
10318 sys_new,
10319 sys_predicate,
10320 [car, sys_tree],
10321 rest
10322 ]
10323 ],
10324
10325 [ sys_d,
10326
10327 [ apply,
10328 function(subst),
10329 sys_new,
10330 sys_predicate,
10331 [cdr, sys_tree],
10332 rest
10333 ]
10334 ]
10335 ],
10336
10337 [ if,
10338
10339 [ and,
10340 [eq, sys_a, [car, sys_tree]],
10341 [eq, sys_d, [cdr, sys_tree]]
10342 ],
10343 sys_tree,
10344 [cons, sys_a, sys_d]
10345 ]
10346 ],
10347
10348 [ if,
10349
10350 [ apply,
10351 function(sys_satisfies_if_not),
10352 sys_predicate,
10353 sys_tree,
10354 rest
10355 ],
10356 sys_new,
10357 sys_tree
10358 ]
10359 ]
10360 ]))).
10361*/
10362/*
10363:- side_effect(assert_lsp(subst_if_not,
10364 arglist_info(subst_if_not,
10365 f_subst_if_not,
10366
10367 [ sys_new,
10368 sys_predicate,
10369 sys_tree,
10370 c38_rest,
10371 rest
10372 ],
10373 arginfo{ all:
10374 [ sys_new,
10375 sys_predicate,
10376 sys_tree
10377 ],
10378 allow_other_keys:0,
10379 aux:0,
10380 body:0,
10381 complex:[rest],
10382 env:0,
10383 key:0,
10384 names:
10385 [ sys_new,
10386 sys_predicate,
10387 sys_tree,
10388 rest
10389 ],
10390 opt:0,
10391 req:
10392 [ sys_new,
10393 sys_predicate,
10394 sys_tree
10395 ],
10396 rest:[rest],
10397 sublists:0,
10398 whole:0
10399 }))).
10400*/
10401/*
10402:- side_effect(assert_lsp(subst_if_not, init_args(3, f_subst_if_not))).
10403*/
10404/*
10405:- side_effect(assert_lsp(nsubst,
10406 lambda_def(defun,
10407 nsubst,
10408 f_nsubst,
10409 [sys_new, sys_old, sys_tree, c38_rest, rest],
10410
10411 [
10412 [ if,
10413 [consp, sys_tree],
10414
10415 [ progn,
10416
10417 [ setf,
10418 [car, sys_tree],
10419
10420 [ apply,
10421 function(subst),
10422 sys_new,
10423 sys_old,
10424 [car, sys_tree],
10425 rest
10426 ]
10427 ],
10428
10429 [ setf,
10430 [cdr, sys_tree],
10431
10432 [ apply,
10433 function(subst),
10434 sys_new,
10435 sys_old,
10436 [cdr, sys_tree],
10437 rest
10438 ]
10439 ],
10440 sys_tree
10441 ],
10442
10443 [ if,
10444
10445 [ apply,
10446 function(satisfies),
10447 sys_old,
10448 sys_tree,
10449 rest
10450 ],
10451 sys_new,
10452 sys_tree
10453 ]
10454 ]
10455 ]))).
10456*/
10457/*
10458:- side_effect(assert_lsp(nsubst,
10459 arglist_info(nsubst,
10460 f_nsubst,
10461
10462 [ sys_new,
10463 sys_old,
10464 sys_tree,
10465 c38_rest,
10466 rest
10467 ],
10468 arginfo{ all:[sys_new, sys_old, sys_tree],
10469 allow_other_keys:0,
10470 aux:0,
10471 body:0,
10472 complex:[rest],
10473 env:0,
10474 key:0,
10475 names:
10476 [ sys_new,
10477 sys_old,
10478 sys_tree,
10479 rest
10480 ],
10481 opt:0,
10482 req:[sys_new, sys_old, sys_tree],
10483 rest:[rest],
10484 sublists:0,
10485 whole:0
10486 }))).
10487*/
10488/*
10489:- side_effect(assert_lsp(nsubst, init_args(3, f_nsubst))).
10490*/
10491/*
10492:- side_effect(assert_lsp(nsubst_if,
10493 lambda_def(defun,
10494 nsubst_if,
10495 f_nsubst_if,
10496
10497 [ sys_new,
10498 sys_predicate,
10499 sys_tree,
10500 c38_rest,
10501 rest
10502 ],
10503
10504 [
10505 [ if,
10506 [consp, sys_tree],
10507
10508 [ progn,
10509
10510 [ setf,
10511 [car, sys_tree],
10512
10513 [ apply,
10514 function(subst),
10515 sys_new,
10516 sys_predicate,
10517 [car, sys_tree],
10518 rest
10519 ]
10520 ],
10521
10522 [ setf,
10523 [cdr, sys_tree],
10524
10525 [ apply,
10526 function(subst),
10527 sys_new,
10528 sys_predicate,
10529 [cdr, sys_tree],
10530 rest
10531 ]
10532 ],
10533 sys_tree
10534 ],
10535
10536 [ if,
10537
10538 [ apply,
10539 function(sys_satisfies_if),
10540 sys_predicate,
10541 sys_tree,
10542 rest
10543 ],
10544 sys_new,
10545 sys_tree
10546 ]
10547 ]
10548 ]))).
10549*/
10550/*
10551:- side_effect(assert_lsp(nsubst_if,
10552 arglist_info(nsubst_if,
10553 f_nsubst_if,
10554
10555 [ sys_new,
10556 sys_predicate,
10557 sys_tree,
10558 c38_rest,
10559 rest
10560 ],
10561 arginfo{ all:
10562 [ sys_new,
10563 sys_predicate,
10564 sys_tree
10565 ],
10566 allow_other_keys:0,
10567 aux:0,
10568 body:0,
10569 complex:[rest],
10570 env:0,
10571 key:0,
10572 names:
10573 [ sys_new,
10574 sys_predicate,
10575 sys_tree,
10576 rest
10577 ],
10578 opt:0,
10579 req:
10580 [ sys_new,
10581 sys_predicate,
10582 sys_tree
10583 ],
10584 rest:[rest],
10585 sublists:0,
10586 whole:0
10587 }))).
10588*/
10589/*
10590:- side_effect(assert_lsp(nsubst_if, init_args(3, f_nsubst_if))).
10591*/
10592/*
10593:- side_effect(assert_lsp(nsubst_if_not,
10594 lambda_def(defun,
10595 nsubst_if_not,
10596 f_nsubst_if_not,
10597
10598 [ sys_new,
10599 sys_predicate,
10600 sys_tree,
10601 c38_rest,
10602 rest
10603 ],
10604
10605 [
10606 [ if,
10607 [consp, sys_tree],
10608
10609 [ progn,
10610
10611 [ setf,
10612 [car, sys_tree],
10613
10614 [ apply,
10615 function(subst),
10616 sys_new,
10617 sys_predicate,
10618 [car, sys_tree],
10619 rest
10620 ]
10621 ],
10622
10623 [ setf,
10624 [cdr, sys_tree],
10625
10626 [ apply,
10627 function(subst),
10628 sys_new,
10629 sys_predicate,
10630 [cdr, sys_tree],
10631 rest
10632 ]
10633 ],
10634 sys_tree
10635 ],
10636
10637 [ if,
10638
10639 [ apply,
10640 function(sys_satisfies_if_not),
10641 sys_predicate,
10642 sys_tree,
10643 rest
10644 ],
10645 sys_new,
10646 sys_tree
10647 ]
10648 ]
10649 ]))).
10650*/
10651/*
10652:- side_effect(assert_lsp(nsubst_if_not,
10653 arglist_info(nsubst_if_not,
10654 f_nsubst_if_not,
10655
10656 [ sys_new,
10657 sys_predicate,
10658 sys_tree,
10659 c38_rest,
10660 rest
10661 ],
10662 arginfo{ all:
10663 [ sys_new,
10664 sys_predicate,
10665 sys_tree
10666 ],
10667 allow_other_keys:0,
10668 aux:0,
10669 body:0,
10670 complex:[rest],
10671 env:0,
10672 key:0,
10673 names:
10674 [ sys_new,
10675 sys_predicate,
10676 sys_tree,
10677 rest
10678 ],
10679 opt:0,
10680 req:
10681 [ sys_new,
10682 sys_predicate,
10683 sys_tree
10684 ],
10685 rest:[rest],
10686 sublists:0,
10687 whole:0
10688 }))).
10689*/
10690/*
10691:- side_effect(assert_lsp(nsubst_if_not, init_args(3, f_nsubst_if_not))).
10692*/
10693/*
10694:- side_effect(assert_lsp(assoc_if,
10695 lambda_def(defun,
10696 assoc_if,
10697 f_assoc_if,
10698 [sys_predicate, sys_alist, c38_rest, rest],
10699
10700 [
10701 [ dolist,
10702 [sys_elem, sys_alist],
10703
10704 [ when,
10705
10706 [ apply,
10707 function(sys_satisfies_if),
10708 sys_predicate,
10709 [car, sys_elem],
10710 rest
10711 ],
10712 [return_from, assoc_if, sys_elem]
10713 ]
10714 ]
10715 ]))).
10716*/
10717/*
10718:- side_effect(assert_lsp(assoc_if,
10719 arglist_info(assoc_if,
10720 f_assoc_if,
10721 [sys_predicate, sys_alist, c38_rest, rest],
10722 arginfo{ all:[sys_predicate, sys_alist],
10723 allow_other_keys:0,
10724 aux:0,
10725 body:0,
10726 complex:[rest],
10727 env:0,
10728 key:0,
10729 names:
10730 [ sys_predicate,
10731 sys_alist,
10732 rest
10733 ],
10734 opt:0,
10735 req:[sys_predicate, sys_alist],
10736 rest:[rest],
10737 sublists:0,
10738 whole:0
10739 }))).
10740*/
10741/*
10742:- side_effect(assert_lsp(assoc_if, init_args(2, f_assoc_if))).
10743*/
10744/*
10745:- side_effect(assert_lsp(assoc_if_not,
10746 lambda_def(defun,
10747 assoc_if_not,
10748 f_assoc_if_not,
10749 [sys_predicate, sys_alist, c38_rest, rest],
10750
10751 [
10752 [ dolist,
10753 [sys_elem, sys_alist],
10754
10755 [ when,
10756
10757 [ apply,
10758 function(sys_satisfies_if_not),
10759 sys_predicate,
10760 [car, sys_elem],
10761 rest
10762 ],
10763 [return_from, assoc_if_not, sys_elem]
10764 ]
10765 ]
10766 ]))).
10767*/
10768/*
10769:- side_effect(assert_lsp(assoc_if_not,
10770 arglist_info(assoc_if_not,
10771 f_assoc_if_not,
10772 [sys_predicate, sys_alist, c38_rest, rest],
10773 arginfo{ all:[sys_predicate, sys_alist],
10774 allow_other_keys:0,
10775 aux:0,
10776 body:0,
10777 complex:[rest],
10778 env:0,
10779 key:0,
10780 names:
10781 [ sys_predicate,
10782 sys_alist,
10783 rest
10784 ],
10785 opt:0,
10786 req:[sys_predicate, sys_alist],
10787 rest:[rest],
10788 sublists:0,
10789 whole:0
10790 }))).
10791*/
10792/*
10793:- side_effect(assert_lsp(assoc_if_not, init_args(2, f_assoc_if_not))).
10794*/
10795/*
10796:- side_effect(assert_lsp(rassoc,
10797 lambda_def(defun,
10798 rassoc,
10799 f_rassoc,
10800 [sys_item, sys_alist, c38_rest, rest],
10801
10802 [
10803 [ dolist,
10804 [sys_elem, sys_alist],
10805
10806 [ when,
10807
10808 [ apply,
10809 function(satisfies),
10810 sys_item,
10811 [cdr, sys_elem],
10812 rest
10813 ],
10814 [return_from, rassoc, sys_elem]
10815 ]
10816 ]
10817 ]))).
10818*/
10819/*
10820:- side_effect(assert_lsp(rassoc,
10821 arglist_info(rassoc,
10822 f_rassoc,
10823 [sys_item, sys_alist, c38_rest, rest],
10824 arginfo{ all:[sys_item, sys_alist],
10825 allow_other_keys:0,
10826 aux:0,
10827 body:0,
10828 complex:[rest],
10829 env:0,
10830 key:0,
10831 names:
10832 [ sys_item,
10833 sys_alist,
10834 rest
10835 ],
10836 opt:0,
10837 req:[sys_item, sys_alist],
10838 rest:[rest],
10839 sublists:0,
10840 whole:0
10841 }))).
10842*/
10843/*
10844:- side_effect(assert_lsp(rassoc, init_args(2, f_rassoc))).
10845*/
10846/*
10847:- side_effect(assert_lsp(rassoc_if,
10848 lambda_def(defun,
10849 rassoc_if,
10850 f_rassoc_if,
10851 [sys_predicate, sys_alist, c38_rest, rest],
10852
10853 [
10854 [ dolist,
10855 [sys_elem, sys_alist],
10856
10857 [ when,
10858
10859 [ apply,
10860 function(sys_satisfies_if),
10861 sys_predicate,
10862 [cdr, sys_elem],
10863 rest
10864 ],
10865 [return_from, rassoc_if, sys_elem]
10866 ]
10867 ]
10868 ]))).
10869*/
10870/*
10871:- side_effect(assert_lsp(rassoc_if,
10872 arglist_info(rassoc_if,
10873 f_rassoc_if,
10874 [sys_predicate, sys_alist, c38_rest, rest],
10875 arginfo{ all:[sys_predicate, sys_alist],
10876 allow_other_keys:0,
10877 aux:0,
10878 body:0,
10879 complex:[rest],
10880 env:0,
10881 key:0,
10882 names:
10883 [ sys_predicate,
10884 sys_alist,
10885 rest
10886 ],
10887 opt:0,
10888 req:[sys_predicate, sys_alist],
10889 rest:[rest],
10890 sublists:0,
10891 whole:0
10892 }))).
10893*/
10894/*
10895:- side_effect(assert_lsp(rassoc_if, init_args(2, f_rassoc_if))).
10896*/
10897/*
10898:- side_effect(assert_lsp(rassoc_if_not,
10899 lambda_def(defun,
10900 rassoc_if_not,
10901 f_rassoc_if_not,
10902 [sys_predicate, sys_alist, c38_rest, rest],
10903
10904 [
10905 [ dolist,
10906 [sys_elem, sys_alist],
10907
10908 [ when,
10909
10910 [ apply,
10911 function(sys_satisfies_if_not),
10912 sys_predicate,
10913 [cdr, sys_elem],
10914 rest
10915 ],
10916
10917 [ return_from,
10918 rassoc_if_not,
10919 sys_elem
10920 ]
10921 ]
10922 ]
10923 ]))).
10924*/
10925/*
10926:- side_effect(assert_lsp(rassoc_if_not,
10927 arglist_info(rassoc_if_not,
10928 f_rassoc_if_not,
10929 [sys_predicate, sys_alist, c38_rest, rest],
10930 arginfo{ all:[sys_predicate, sys_alist],
10931 allow_other_keys:0,
10932 aux:0,
10933 body:0,
10934 complex:[rest],
10935 env:0,
10936 key:0,
10937 names:
10938 [ sys_predicate,
10939 sys_alist,
10940 rest
10941 ],
10942 opt:0,
10943 req:[sys_predicate, sys_alist],
10944 rest:[rest],
10945 sublists:0,
10946 whole:0
10947 }))).
10948*/
10949/*
10950:- side_effect(assert_lsp(rassoc_if_not, init_args(2, f_rassoc_if_not))).
10951*/
10952/*
10953:- side_effect(assert_lsp(adjoin,
10954 lambda_def(defun,
10955 adjoin,
10956 f_adjoin,
10957 [sys_item, list, c38_rest, rest],
10958
10959 [
10960 [ dolist,
10961 [sys_elem, list, [cons, sys_item, list]],
10962
10963 [ when,
10964
10965 [ apply,
10966 function(satisfies),
10967 sys_item,
10968 sys_elem,
10969 rest
10970 ],
10971 [return_from, adjoin, list]
10972 ]
10973 ]
10974 ]))).
10975*/
10976/*
10977:- side_effect(assert_lsp(adjoin,
10978 arglist_info(adjoin,
10979 f_adjoin,
10980 [sys_item, list, c38_rest, rest],
10981 arginfo{ all:[sys_item, list],
10982 allow_other_keys:0,
10983 aux:0,
10984 body:0,
10985 complex:[rest],
10986 env:0,
10987 key:0,
10988 names:[sys_item, list, rest],
10989 opt:0,
10990 req:[sys_item, list],
10991 rest:[rest],
10992 sublists:0,
10993 whole:0
10994 }))).
10995*/
10996/*
10997:- side_effect(assert_lsp(adjoin, init_args(2, f_adjoin))).
10998*/
10999/*
11000:- side_effect(assert_lsp(set_exclusive_or,
11001 lambda_def(defun,
11002 set_exclusive_or,
11003 f_set_exclusive_or,
11004
11005 [ sys_list_1,
11006 sys_list_2,
11007 c38_rest,
11008 rest,
11009 c38_key,
11010 key
11011 ],
11012
11013 [
11014 [ let,
11015 [[sys_result, []]],
11016
11017 [ dolist,
11018 [sys_item, sys_list_1],
11019
11020 [ unless,
11021
11022 [ apply,
11023 function(member),
11024
11025 [ if,
11026 key,
11027 [funcall, key, sys_item],
11028 sys_item
11029 ],
11030 sys_list_2,
11031 rest
11032 ],
11033 [push, sys_item, sys_result]
11034 ]
11035 ],
11036
11037 [ dolist,
11038 [sys_item, sys_list_2],
11039
11040 [ block,
11041 sys_matches,
11042
11043 [ dolist,
11044 [sys_elem, sys_list_1],
11045
11046 [ when,
11047
11048 [ apply,
11049 function(satisfies),
11050
11051 [ if,
11052 key,
11053 [funcall, key, sys_elem],
11054 sys_elem
11055 ],
11056 sys_item,
11057 rest
11058 ],
11059 [return_from, sys_matches]
11060 ]
11061 ],
11062 [push, sys_item, sys_result]
11063 ]
11064 ],
11065 sys_result
11066 ]
11067 ]))).
11068*/
11069/*
11070:- side_effect(assert_lsp(set_exclusive_or,
11071 arglist_info(set_exclusive_or,
11072 f_set_exclusive_or,
11073
11074 [ sys_list_1,
11075 sys_list_2,
11076 c38_rest,
11077 rest,
11078 c38_key,
11079 key
11080 ],
11081 arginfo{ all:[sys_list_1, sys_list_2],
11082 allow_other_keys:0,
11083 aux:0,
11084 body:0,
11085 complex:[rest],
11086 env:0,
11087 key:[key],
11088 names:
11089 [ sys_list_1,
11090 sys_list_2,
11091 rest,
11092 key
11093 ],
11094 opt:0,
11095 req:[sys_list_1, sys_list_2],
11096 rest:[rest],
11097 sublists:0,
11098 whole:0
11099 }))).
11100*/
11101/*
11102:- side_effect(assert_lsp(set_exclusive_or, init_args(2, f_set_exclusive_or))).
11103*/
11104/*
11105:- side_effect(assert_lsp(nset_exclusive_or,
11106 lambda_def(defun,
11107 nset_exclusive_or,
11108 f_nset_exclusive_or,
11109
11110 [ sys_list_1,
11111 sys_list_2,
11112 c38_rest,
11113 rest,
11114 c38_key,
11115 key
11116 ],
11117
11118 [
11119 [ let,
11120
11121 [ [sys_result, []],
11122 [list, []],
11123 [sys_item, []]
11124 ],
11125
11126 [ tagbody,
11127 sys_start_1,
11128
11129 [ unless,
11130 sys_list_1,
11131 [go, sys_start_2]
11132 ],
11133 [setf, sys_item, [car, sys_list_1]],
11134 [setf, list, sys_list_2],
11135 [setf, sys_prev, []],
11136 sys_start_1_in,
11137 [unless, list, [go, sys_end_1_in]],
11138
11139 [ let,
11140
11141 [
11142 [ sys_elem,
11143
11144 [ if,
11145 key,
11146 [funcall, key, [car, list]],
11147 [car, list]
11148 ]
11149 ]
11150 ],
11151
11152 [ when,
11153
11154 [ apply,
11155 function(satisfies),
11156 sys_item,
11157
11158 [ if,
11159 key,
11160 [funcall, key, sys_elem],
11161 sys_elem
11162 ],
11163 rest
11164 ],
11165
11166 [ if,
11167 sys_prev,
11168
11169 [ setf,
11170 [cdr, sys_prev],
11171 [cdr, list]
11172 ],
11173 [setf, sys_list_2, [cdr, list]]
11174 ],
11175
11176 [ setf,
11177 sys_list_1,
11178 [cdr, sys_list_1]
11179 ],
11180 [go, sys_start_1]
11181 ]
11182 ],
11183 [setf, sys_prev, list],
11184 [setf, list, [cdr, list]],
11185 [go, sys_start_1_in],
11186 sys_end_1_in,
11187 [setf, sys_item, [cdr, sys_list_1]],
11188 [setf, [cdr, sys_list_1], sys_result],
11189
11190 [ unless,
11191 sys_result,
11192 [setf, sys_end, sys_list_1]
11193 ],
11194 [setf, sys_result, sys_list_1],
11195 [setf, sys_list_1, sys_item],
11196 [go, sys_start_1],
11197 sys_start_2,
11198
11199 [ return_from,
11200 nset_exclusive_or,
11201
11202 [ if,
11203 sys_end,
11204
11205 [ progn,
11206
11207 [ setf,
11208 [cdr, sys_end],
11209 sys_list_2
11210 ],
11211 sys_result
11212 ],
11213 sys_list_2
11214 ]
11215 ]
11216 ]
11217 ]
11218 ]))).
11219*/
11220/*
11221:- side_effect(assert_lsp(nset_exclusive_or,
11222 arglist_info(nset_exclusive_or,
11223 f_nset_exclusive_or,
11224
11225 [ sys_list_1,
11226 sys_list_2,
11227 c38_rest,
11228 rest,
11229 c38_key,
11230 key
11231 ],
11232 arginfo{ all:[sys_list_1, sys_list_2],
11233 allow_other_keys:0,
11234 aux:0,
11235 body:0,
11236 complex:[rest],
11237 env:0,
11238 key:[key],
11239 names:
11240 [ sys_list_1,
11241 sys_list_2,
11242 rest,
11243 key
11244 ],
11245 opt:0,
11246 req:[sys_list_1, sys_list_2],
11247 rest:[rest],
11248 sublists:0,
11249 whole:0
11250 }))).
11251*/
11252/*
11253:- side_effect(assert_lsp(nset_exclusive_or, init_args(2, f_nset_exclusive_or))).
11254*/
11255/*
11256:- side_effect(assert_lsp(fill,
11257 lambda_def(defun,
11258 fill,
11259 f_fill,
11260 [sequence, sys_item, c38_rest, rest],
11261
11262 [
11263 [ let,
11264
11265 [
11266 [ sys_iter,
11267
11268 [ apply,
11269 function(sys_seq_start),
11270 sequence,
11271 rest
11272 ]
11273 ]
11274 ],
11275
11276 [ tagbody,
11277 sys_start,
11278
11279 [ unless,
11280
11281 [ apply,
11282 function(sys_seq_end_p),
11283 sequence,
11284 sys_iter,
11285 rest
11286 ],
11287
11288 [ sys_seq_set,
11289 sequence,
11290 sys_iter,
11291 sys_item
11292 ],
11293 [sys_seq_next, sys_iter],
11294 [go, sys_start]
11295 ]
11296 ]
11297 ],
11298 sequence
11299 ]))).
11300*/
11301/*
11302:- side_effect(assert_lsp(fill,
11303 arglist_info(fill,
11304 f_fill,
11305 [sequence, sys_item, c38_rest, rest],
11306 arginfo{ all:[sequence, sys_item],
11307 allow_other_keys:0,
11308 aux:0,
11309 body:0,
11310 complex:[rest],
11311 env:0,
11312 key:0,
11313 names:[sequence, sys_item, rest],
11314 opt:0,
11315 req:[sequence, sys_item],
11316 rest:[rest],
11317 sublists:0,
11318 whole:0
11319 }))).
11320*/
11321/*
11322:- side_effect(assert_lsp(fill, init_args(2, f_fill))).
11323*/
11324/*
11325:- side_effect(assert_lsp(every,
11326 lambda_def(defun,
11327 every,
11328 f_every,
11329 [sys_predicate, c38_rest, sys_sequences],
11330
11331 [
11332 [ let,
11333
11334 [
11335 [ sys_iters,
11336
11337 [ mapcar,
11338 function(sys_seq_start),
11339 sys_sequences
11340 ]
11341 ]
11342 ],
11343
11344 [ tagbody,
11345 sys_start,
11346
11347 [ unless,
11348
11349 [ sys_some_list_2,
11350 function(sys_seq_end_p),
11351 sys_sequences,
11352 sys_iters
11353 ],
11354
11355 [ unless,
11356
11357 [ apply,
11358 sys_predicate,
11359
11360 [ mapcar,
11361 function(sys_seq_ref),
11362 sys_sequences,
11363 sys_iters
11364 ]
11365 ],
11366 [return_from, every, []]
11367 ],
11368
11369 [ mapc,
11370 function(sys_seq_next),
11371 sys_iters
11372 ],
11373 [go, sys_start]
11374 ]
11375 ]
11376 ],
11377 t
11378 ]))).
11379*/
11380/*
11381:- side_effect(assert_lsp(every,
11382 arglist_info(every,
11383 f_every,
11384 [sys_predicate, c38_rest, sys_sequences],
11385 arginfo{ all:[sys_predicate],
11386 allow_other_keys:0,
11387 aux:0,
11388 body:0,
11389 complex:[rest],
11390 env:0,
11391 key:0,
11392 names:
11393 [ sys_predicate,
11394 sys_sequences
11395 ],
11396 opt:0,
11397 req:[sys_predicate],
11398 rest:[sys_sequences],
11399 sublists:0,
11400 whole:0
11401 }))).
11402*/
11403/*
11404:- side_effect(assert_lsp(every, init_args(x, f_every))).
11405*/
11406/*
11407:- side_effect(assert_lsp(some,
11408 lambda_def(defun,
11409 some,
11410 f_some,
11411 [sys_predicate, c38_rest, sys_sequences],
11412
11413 [
11414 [ let,
11415
11416 [
11417 [ sys_iters,
11418
11419 [ mapcar,
11420 function(sys_seq_start),
11421 sys_sequences
11422 ]
11423 ]
11424 ],
11425
11426 [ tagbody,
11427 sys_start,
11428
11429 [ unless,
11430
11431 [ sys_some_list_2,
11432 function(sys_seq_end_p),
11433 sys_sequences,
11434 sys_iters
11435 ],
11436
11437 [ let,
11438
11439 [
11440 [ sys_result,
11441
11442 [ apply,
11443 sys_predicate,
11444
11445 [ mapcar,
11446 function(sys_seq_ref),
11447 sys_sequences,
11448 sys_iters
11449 ]
11450 ]
11451 ]
11452 ],
11453
11454 [ when,
11455 sys_result,
11456 [return_from, some, sys_result]
11457 ]
11458 ],
11459
11460 [ mapc,
11461 function(sys_seq_next),
11462 sys_iters
11463 ],
11464 [go, sys_start]
11465 ]
11466 ]
11467 ]
11468 ]))).
11469*/
11470/*
11471:- side_effect(assert_lsp(some,
11472 arglist_info(some,
11473 f_some,
11474 [sys_predicate, c38_rest, sys_sequences],
11475 arginfo{ all:[sys_predicate],
11476 allow_other_keys:0,
11477 aux:0,
11478 body:0,
11479 complex:[rest],
11480 env:0,
11481 key:0,
11482 names:
11483 [ sys_predicate,
11484 sys_sequences
11485 ],
11486 opt:0,
11487 req:[sys_predicate],
11488 rest:[sys_sequences],
11489 sublists:0,
11490 whole:0
11491 }))).
11492*/
11493/*
11494:- side_effect(assert_lsp(some, init_args(1, f_some))).
11495*/
11496/*
11497:- side_effect(assert_lsp(notevery,
11498 lambda_def(defun,
11499 notevery,
11500 f_notevery,
11501 [sys_predicate, c38_rest, sys_sequences],
11502
11503 [
11504 [ let,
11505
11506 [
11507 [ sys_iters,
11508
11509 [ mapcar,
11510 function(sys_seq_start),
11511 sys_sequences
11512 ]
11513 ]
11514 ],
11515
11516 [ tagbody,
11517 sys_start,
11518
11519 [ unless,
11520
11521 [ sys_some_list_2,
11522 function(sys_seq_end_p),
11523 sys_sequences,
11524 sys_iters
11525 ],
11526
11527 [ unless,
11528
11529 [ apply,
11530 sys_predicate,
11531
11532 [ mapcar,
11533 function(sys_seq_ref),
11534 sys_sequences,
11535 sys_iters
11536 ]
11537 ],
11538 [return_from, every, t]
11539 ],
11540
11541 [ mapc,
11542 function(sys_seq_next),
11543 sys_iters
11544 ],
11545 [go, sys_start]
11546 ]
11547 ]
11548 ]
11549 ]))).
11550*/
11551/*
11552:- side_effect(assert_lsp(notevery,
11553 arglist_info(notevery,
11554 f_notevery,
11555 [sys_predicate, c38_rest, sys_sequences],
11556 arginfo{ all:[sys_predicate],
11557 allow_other_keys:0,
11558 aux:0,
11559 body:0,
11560 complex:[rest],
11561 env:0,
11562 key:0,
11563 names:
11564 [ sys_predicate,
11565 sys_sequences
11566 ],
11567 opt:0,
11568 req:[sys_predicate],
11569 rest:[sys_sequences],
11570 sublists:0,
11571 whole:0
11572 }))).
11573*/
11574/*
11575:- side_effect(assert_lsp(notevery, init_args(1, f_notevery))).
11576*/
11577/*
11578:- side_effect(assert_lsp(notany,
11579 lambda_def(defun,
11580 notany,
11581 f_notany,
11582 [sys_predicate, c38_rest, sys_sequences],
11583
11584 [
11585 [ let,
11586
11587 [
11588 [ sys_iters,
11589
11590 [ mapcar,
11591 function(sys_seq_start),
11592 sys_sequences
11593 ]
11594 ]
11595 ],
11596
11597 [ tagbody,
11598 sys_start,
11599
11600 [ unless,
11601
11602 [ sys_some_list_2,
11603 function(sys_seq_end_p),
11604 sys_sequences,
11605 sys_iters
11606 ],
11607
11608 [ when,
11609
11610 [ apply,
11611 sys_predicate,
11612
11613 [ mapcar,
11614 function(sys_seq_ref),
11615 sys_sequences,
11616 sys_iters
11617 ]
11618 ],
11619 [return_from, every, []]
11620 ],
11621
11622 [ mapc,
11623 function(sys_seq_next),
11624 sys_iters
11625 ],
11626 [go, sys_start]
11627 ]
11628 ]
11629 ],
11630 t
11631 ]))).
11632*/
11633/*
11634:- side_effect(assert_lsp(notany,
11635 arglist_info(notany,
11636 f_notany,
11637 [sys_predicate, c38_rest, sys_sequences],
11638 arginfo{ all:[sys_predicate],
11639 allow_other_keys:0,
11640 aux:0,
11641 body:0,
11642 complex:[rest],
11643 env:0,
11644 key:0,
11645 names:
11646 [ sys_predicate,
11647 sys_sequences
11648 ],
11649 opt:0,
11650 req:[sys_predicate],
11651 rest:[sys_sequences],
11652 sublists:0,
11653 whole:0
11654 }))).
11655*/
11656/*
11657:- side_effect(assert_lsp(notany, init_args(1, f_notany))).
11658*/
11659/*
11660:- side_effect(assert_lsp(count,
11661 lambda_def(defun,
11662 count,
11663 f_count,
11664 [sys_item, sequence, c38_rest, rest],
11665
11666 [
11667 [ let,
11668
11669 [
11670 [ sys_iter,
11671
11672 [ apply,
11673 function(sys_seq_start),
11674 sequence,
11675 rest
11676 ]
11677 ],
11678 [count, 0]
11679 ],
11680
11681 [ tagbody,
11682 sys_start,
11683
11684 [ unless,
11685
11686 [ apply,
11687 function(sys_seq_end_p),
11688 sequence,
11689 sys_iter,
11690 rest
11691 ],
11692
11693 [ when,
11694
11695 [ apply,
11696 function(satisfies),
11697 sys_item,
11698
11699 [ sys_seq_ref,
11700 sequence,
11701 sys_iter
11702 ],
11703 rest
11704 ],
11705 [setf, count, [+, 1, count]]
11706 ],
11707 [sys_seq_next, sys_iter],
11708 [go, sys_start]
11709 ]
11710 ],
11711 count
11712 ]
11713 ]))).
11714*/
11715/*
11716:- side_effect(assert_lsp(count,
11717 arglist_info(count,
11718 f_count,
11719 [sys_item, sequence, c38_rest, rest],
11720 arginfo{ all:[sys_item, sequence],
11721 allow_other_keys:0,
11722 aux:0,
11723 body:0,
11724 complex:[rest],
11725 env:0,
11726 key:0,
11727 names:[sys_item, sequence, rest],
11728 opt:0,
11729 req:[sys_item, sequence],
11730 rest:[rest],
11731 sublists:0,
11732 whole:0
11733 }))).
11734*/
11735/*
11736:- side_effect(assert_lsp(count, init_args(2, f_count))).
11737*/
11738/*
11739:- side_effect(assert_lsp(count_if,
11740 lambda_def(defun,
11741 count_if,
11742 f_count_if,
11743 [sys_predicate, sequence, c38_rest, rest],
11744
11745 [
11746 [ let,
11747
11748 [
11749 [ sys_iter,
11750
11751 [ apply,
11752 function(sys_seq_start),
11753 sequence,
11754 rest
11755 ]
11756 ],
11757 [count, 0]
11758 ],
11759
11760 [ tagbody,
11761 sys_start,
11762
11763 [ unless,
11764
11765 [ apply,
11766 function(sys_seq_end_p),
11767 sequence,
11768 sys_iter,
11769 rest
11770 ],
11771
11772 [ when,
11773
11774 [ apply,
11775 function(sys_satisfies_if),
11776 sys_predicate,
11777
11778 [ sys_seq_ref,
11779 sequence,
11780 sys_iter
11781 ],
11782 rest
11783 ],
11784 [setf, count, [+, 1, count]]
11785 ],
11786 [sys_seq_next, sys_iter],
11787 [go, sys_start]
11788 ]
11789 ],
11790 count
11791 ]
11792 ]))).
11793*/
11794/*
11795:- side_effect(assert_lsp(count_if,
11796 arglist_info(count_if,
11797 f_count_if,
11798 [sys_predicate, sequence, c38_rest, rest],
11799 arginfo{ all:[sys_predicate, sequence],
11800 allow_other_keys:0,
11801 aux:0,
11802 body:0,
11803 complex:[rest],
11804 env:0,
11805 key:0,
11806 names:
11807 [ sys_predicate,
11808 sequence,
11809 rest
11810 ],
11811 opt:0,
11812 req:[sys_predicate, sequence],
11813 rest:[rest],
11814 sublists:0,
11815 whole:0
11816 }))).
11817*/
11818/*
11819:- side_effect(assert_lsp(count_if, init_args(2, f_count_if))).
11820*/
11821/*
11822:- side_effect(assert_lsp(count_if_not,
11823 lambda_def(defun,
11824 count_if_not,
11825 f_count_if_not,
11826 [sys_predicate, sequence, c38_rest, rest],
11827
11828 [
11829 [ let,
11830
11831 [
11832 [ sys_iter,
11833
11834 [ apply,
11835 function(sys_seq_start),
11836 sequence,
11837 rest
11838 ]
11839 ],
11840 [count, 0]
11841 ],
11842
11843 [ tagbody,
11844 sys_start,
11845
11846 [ unless,
11847
11848 [ apply,
11849 function(sys_seq_end_p),
11850 sequence,
11851 sys_iter,
11852 rest
11853 ],
11854
11855 [ when,
11856
11857 [ apply,
11858 function(sys_satisfies_if_not),
11859 sys_predicate,
11860
11861 [ sys_seq_ref,
11862 sequence,
11863 sys_iter
11864 ],
11865 rest
11866 ],
11867 [setf, count, [+, 1, count]]
11868 ],
11869 [sys_seq_next, sys_iter],
11870 [go, sys_start]
11871 ]
11872 ],
11873 count
11874 ]
11875 ]))).
11876*/
11877/*
11878:- side_effect(assert_lsp(count_if_not,
11879 arglist_info(count_if_not,
11880 f_count_if_not,
11881 [sys_predicate, sequence, c38_rest, rest],
11882 arginfo{ all:[sys_predicate, sequence],
11883 allow_other_keys:0,
11884 aux:0,
11885 body:0,
11886 complex:[rest],
11887 env:0,
11888 key:0,
11889 names:
11890 [ sys_predicate,
11891 sequence,
11892 rest
11893 ],
11894 opt:0,
11895 req:[sys_predicate, sequence],
11896 rest:[rest],
11897 sublists:0,
11898 whole:0
11899 }))).
11900*/
11901/*
11902:- side_effect(assert_lsp(count_if_not, init_args(2, f_count_if_not))).
11903*/
11904/*
11905:- side_effect(assert_lsp(remove,
11906 lambda_def(defun,
11907 remove,
11908 f_remove,
11909
11910 [ sys_item,
11911 sequence,
11912 c38_rest,
11913 rest,
11914 c38_key,
11915 count
11916 ],
11917
11918 [
11919 [ let,
11920
11921 [
11922 [ sys_iter,
11923
11924 [ apply,
11925 function(sys_seq_start),
11926 sequence,
11927 rest
11928 ]
11929 ],
11930 [sys_result, []]
11931 ],
11932
11933 [ tagbody,
11934 sys_start,
11935
11936 [ unless,
11937
11938 [ apply,
11939 function(sys_seq_end_p),
11940 sequence,
11941 sys_iter,
11942 rest
11943 ],
11944
11945 [ let,
11946
11947 [
11948 [ sys_elem,
11949
11950 [ sys_seq_ref,
11951 sequence,
11952 sys_iter
11953 ]
11954 ]
11955 ],
11956
11957 [ unless,
11958
11959 [ and,
11960
11961 [ apply,
11962 function(satisfies),
11963 sys_item,
11964 sys_elem,
11965 rest
11966 ],
11967
11968 [ or,
11969 [not, count],
11970
11971 [ not,
11972 [minusp, [decf, count]]
11973 ]
11974 ]
11975 ],
11976 [push, sys_elem, sys_result]
11977 ]
11978 ],
11979 [sys_seq_next, sys_iter],
11980 [go, sys_start]
11981 ]
11982 ],
11983
11984 [ sys_seq_result,
11985 sequence,
11986 sys_iter,
11987 sys_result
11988 ]
11989 ]
11990 ]))).
11991*/
11992/*
11993:- side_effect(assert_lsp(remove,
11994 arglist_info(remove,
11995 f_remove,
11996
11997 [ sys_item,
11998 sequence,
11999 c38_rest,
12000 rest,
12001 c38_key,
12002 count
12003 ],
12004 arginfo{ all:[sys_item, sequence],
12005 allow_other_keys:0,
12006 aux:0,
12007 body:0,
12008 complex:[rest],
12009 env:0,
12010 key:[count],
12011 names:
12012 [ sys_item,
12013 sequence,
12014 rest,
12015 count
12016 ],
12017 opt:0,
12018 req:[sys_item, sequence],
12019 rest:[rest],
12020 sublists:0,
12021 whole:0
12022 }))).
12023*/
12024/*
12025:- side_effect(assert_lsp(remove, init_args(2, f_remove))).
12026*/
12027/*
12028:- side_effect(assert_lsp(remove_if,
12029 lambda_def(defun,
12030 remove_if,
12031 f_remove_if,
12032
12033 [ sys_predicate,
12034 sequence,
12035 c38_rest,
12036 rest,
12037 c38_key,
12038 count
12039 ],
12040
12041 [
12042 [ let,
12043
12044 [
12045 [ sys_iter,
12046
12047 [ apply,
12048 function(sys_seq_start),
12049 sequence,
12050 rest
12051 ]
12052 ],
12053 [sys_result, []]
12054 ],
12055
12056 [ tagbody,
12057 sys_start,
12058
12059 [ unless,
12060
12061 [ apply,
12062 function(sys_seq_end_p),
12063 sequence,
12064 sys_iter,
12065 rest
12066 ],
12067
12068 [ let,
12069
12070 [
12071 [ sys_elem,
12072
12073 [ sys_seq_ref,
12074 sequence,
12075 sys_iter
12076 ]
12077 ]
12078 ],
12079
12080 [ unless,
12081
12082 [ and,
12083
12084 [ apply,
12085 function(sys_satisfies_if),
12086 sys_predicate,
12087 sys_elem,
12088 rest
12089 ],
12090
12091 [ or,
12092 [not, count],
12093
12094 [ not,
12095 [minusp, [decf, count]]
12096 ]
12097 ]
12098 ],
12099 [push, sys_elem, sys_result]
12100 ]
12101 ],
12102 [sys_seq_next, sys_iter],
12103 [go, sys_start]
12104 ]
12105 ],
12106
12107 [ sys_seq_result,
12108 sequence,
12109 sys_iter,
12110 sys_result
12111 ]
12112 ]
12113 ]))).
12114*/
12115/*
12116:- side_effect(assert_lsp(remove_if,
12117 arglist_info(remove_if,
12118 f_remove_if,
12119
12120 [ sys_predicate,
12121 sequence,
12122 c38_rest,
12123 rest,
12124 c38_key,
12125 count
12126 ],
12127 arginfo{ all:[sys_predicate, sequence],
12128 allow_other_keys:0,
12129 aux:0,
12130 body:0,
12131 complex:[rest],
12132 env:0,
12133 key:[count],
12134 names:
12135 [ sys_predicate,
12136 sequence,
12137 rest,
12138 count
12139 ],
12140 opt:0,
12141 req:[sys_predicate, sequence],
12142 rest:[rest],
12143 sublists:0,
12144 whole:0
12145 }))).
12146*/
12147/*
12148:- side_effect(assert_lsp(remove_if, init_args(2, f_remove_if))).
12149*/
12150/*
12151:- side_effect(assert_lsp(remove_if_not,
12152 lambda_def(defun,
12153 remove_if_not,
12154 f_remove_if_not,
12155
12156 [ sys_predicate,
12157 sequence,
12158 c38_rest,
12159 rest,
12160 c38_key,
12161 count
12162 ],
12163
12164 [
12165 [ let,
12166
12167 [
12168 [ sys_iter,
12169
12170 [ apply,
12171 function(sys_seq_start),
12172 sequence,
12173 rest
12174 ]
12175 ],
12176 [sys_result, []]
12177 ],
12178
12179 [ tagbody,
12180 sys_start,
12181
12182 [ unless,
12183
12184 [ apply,
12185 function(sys_seq_end_p),
12186 sequence,
12187 sys_iter,
12188 rest
12189 ],
12190
12191 [ let,
12192
12193 [
12194 [ sys_elem,
12195
12196 [ sys_seq_ref,
12197 sequence,
12198 sys_iter
12199 ]
12200 ]
12201 ],
12202
12203 [ unless,
12204
12205 [ and,
12206
12207 [ apply,
12208 function(sys_satisfies_if_not),
12209 sys_predicate,
12210 sys_elem,
12211 rest
12212 ],
12213
12214 [ or,
12215 [not, count],
12216
12217 [ not,
12218 [minusp, [decf, count]]
12219 ]
12220 ]
12221 ],
12222 [push, sys_elem, sys_result]
12223 ]
12224 ],
12225 [sys_seq_next, sys_iter],
12226 [go, sys_start]
12227 ]
12228 ],
12229
12230 [ sys_seq_result,
12231 sequence,
12232 sys_iter,
12233 sys_result
12234 ]
12235 ]
12236 ]))).
12237*/
12238/*
12239:- side_effect(assert_lsp(remove_if_not,
12240 arglist_info(remove_if_not,
12241 f_remove_if_not,
12242
12243 [ sys_predicate,
12244 sequence,
12245 c38_rest,
12246 rest,
12247 c38_key,
12248 count
12249 ],
12250 arginfo{ all:[sys_predicate, sequence],
12251 allow_other_keys:0,
12252 aux:0,
12253 body:0,
12254 complex:[rest],
12255 env:0,
12256 key:[count],
12257 names:
12258 [ sys_predicate,
12259 sequence,
12260 rest,
12261 count
12262 ],
12263 opt:0,
12264 req:[sys_predicate, sequence],
12265 rest:[rest],
12266 sublists:0,
12267 whole:0
12268 }))).
12269*/
12270/*
12271:- side_effect(assert_lsp(remove_if_not, init_args(2, f_remove_if_not))).
12272*/
12273/*
12274#+BUILTIN
12275#+(or WAM-CL LISP500)
12276(defun null (object) (if object nil t))
12277
12278*/
12279
12280/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:34926 **********************/
12281:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,null,[object],[if,object,[],t]]]]))
12282/*
12283#+BUILTIN
12284#+(or WAM-CL LISP500)
12285(defun not (object) (if object nil t))
12286
12287
12288
12289
12290*/
12291
12292/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:35004 **********************/
12293:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,not,[object],[if,object,[],t]]]]))
12294/*
12295#+(or WAM-CL LISP500)
12296(defun mod (x y) (multiple-value-call #'(lambda (q r) r) (floor x y)))
12297
12298*/
12299
12300/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:35087 **********************/
12301:-lisp_compile_to_prolog(pkg_sys,[defun,mod,[x,y],['multiple-value-call',function([lambda,[q,r],r]),[floor,x,y]]])
12302wl:lambda_def(defun, mod, f_mod, [sys_x, sys_y], [[multiple_value_call, function([lambda, [sys_q, sys_r], sys_r]), [floor, sys_x, sys_y]]]).
12303wl:arglist_info(mod, f_mod, [sys_x, sys_y], arginfo{all:[sys_x, sys_y], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_y], opt:0, req:[sys_x, sys_y], rest:0, sublists:0, whole:0}).
12304wl: init_args(x, f_mod).
12305
12310f_mod(X_In, Y_In, FnResult) :-
12311 GEnv=[bv(sys_x, X_In), bv(sys_y, Y_In)],
12312 catch(( ( get_var(GEnv, sys_x, X_Get),
12313 get_var(GEnv, sys_y, Y_Get),
12314 f_floor(X_Get, [Y_Get], Floor_Ret),
12315 nb_current('$mv_return', Nb_current_Ret),
12316 f_apply(closure(kw_function,
12317 [ClosureEnvironment|GEnv],
12318 Whole,
12319 R_Get,
12320 [sys_q, sys_r],
12321 get_var(ClosureEnvironment, sys_r, R_Get),
12322 [lambda, [sys_q, sys_r], sys_r]),
12323 Nb_current_Ret,
12324 Apply_Ret)
12325 ),
12326 Apply_Ret=FnResult
12327 ),
12328 block_exit(mod, FnResult),
12329 true).
12330:- set_opv(mod, symbol_function, f_mod),
12331 DefunResult=(mod).12332/*
12333:- side_effect(assert_lsp((mod),
12334 lambda_def(defun,
12335 (mod),
12336 f_mod,
12337 [sys_x, sys_y],
12338
12339 [
12340 [ multiple_value_call,
12341 function([lambda, [sys_q, sys_r], sys_r]),
12342 [floor, sys_x, sys_y]
12343 ]
12344 ]))).
12345*/
12346/*
12347:- side_effect(assert_lsp((mod),
12348 arglist_info((mod),
12349 f_mod,
12350 [sys_x, sys_y],
12351 arginfo{ all:[sys_x, sys_y],
12352 allow_other_keys:0,
12353 aux:0,
12354 body:0,
12355 complex:0,
12356 env:0,
12357 key:0,
12358 names:[sys_x, sys_y],
12359 opt:0,
12360 req:[sys_x, sys_y],
12361 rest:0,
12362 sublists:0,
12363 whole:0
12364 }))).
12365*/
12366/*
12367:- side_effect(assert_lsp(mod, init_args(x, f_mod))).
12368*/
12369/*
12370#+(or WAM-CL LISP500)
12371#+BUILTIN
12372(defun functionp (object) (eq (type-of object) 'function))
12373
12374
12375
12376*/
12377
12378/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:35185 **********************/
12379:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[defun,functionp,[object],[eq,['type-of',object],[quote,function]]]]))
12380/*
12381#+(or WAM-CL LISP500)
12382(defun coerce (object result-type)
12383 (if (typep object result-type)
12384 object
12385 (case result-type
12386 ((t) object)
12387 (character (character object))
12388 (function (if (and (consp object) (eq (car object) 'lambda))
12389 (eval (list 'function object))
12390 (if (fboundp object)
12391 (fdefinition object))
12392 (error 'type-error :datum object
12393 :expected-type result-type)))
12394 (t (error 'type-error :datum object :expected-type result-type)))))
12395
12396
12397
12398
12399*/
12400
12401/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:35286 **********************/
12402:-lisp_compile_to_prolog(pkg_sys,[defun,coerce,[object,'result-type'],[if,[typep,object,'result-type'],object,[case,'result-type',[[t],object],[character,[character,object]],[function,[if,[and,[consp,object],[eq,[car,object],[quote,lambda]]],[eval,[list,[quote,function],object]],[if,[fboundp,object],[fdefinition,object]],[error,[quote,'type-error'],':datum',object,':expected-type','result-type']]],[t,[error,[quote,'type-error'],':datum',object,':expected-type','result-type']]]]])
12403/*
12404% case:-[[[t],sys_object],[character,[character,sys_object]],[function,[if,[and,[consp,sys_object],[eq,[car,sys_object],[quote,lambda]]],[eval,[list,[quote,function],sys_object]],[if,[fboundp,sys_object],[fdefinition,sys_object]],[error,[quote,type_error],kw_datum,sys_object,kw_expected_type,sys_result_type]]],[t,[error,[quote,type_error],kw_datum,sys_object,kw_expected_type,sys_result_type]]].
12405*/
12406/*
12407% conds:-[[[eq,_33082,[quote,t]],[progn,sys_object]],[[eq,_33082,[quote,character]],[progn,[character,sys_object]]],[[eq,_33082,[quote,function]],[progn,[if,[and,[consp,sys_object],[eq,[car,sys_object],[quote,lambda]]],[eval,[list,[quote,function],sys_object]],[if,[fboundp,sys_object],[fdefinition,sys_object]],[error,[quote,type_error],kw_datum,sys_object,kw_expected_type,sys_result_type]]]],[t,[progn,[error,[quote,type_error],kw_datum,sys_object,kw_expected_type,sys_result_type]]]].
12408*/
12409wl:lambda_def(defun, coerce, f_coerce, [sys_object, sys_result_type], [[if, [typep, sys_object, sys_result_type], sys_object, [case, sys_result_type, [[t], sys_object], [character, [character, sys_object]], [function, [if, [and, [consp, sys_object], [eq, [car, sys_object], [quote, lambda]]], [eval, [list, [quote, function], sys_object]], [if, [fboundp, sys_object], [fdefinition, sys_object]], [error, [quote, type_error], kw_datum, sys_object, kw_expected_type, sys_result_type]]], [t, [error, [quote, type_error], kw_datum, sys_object, kw_expected_type, sys_result_type]]]]]).
12410wl:arglist_info(coerce, f_coerce, [sys_object, sys_result_type], arginfo{all:[sys_object, sys_result_type], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_object, sys_result_type], opt:0, req:[sys_object, sys_result_type], rest:0, sublists:0, whole:0}).
12411wl: init_args(x, f_coerce).
12412
12417f_coerce(Object_In, Result_type_In, FnResult) :-
12418 GEnv=[bv(sys_object, Object_In), bv(sys_result_type, Result_type_In)],
12419 catch(( ( get_var(GEnv, sys_object, Object_Get),
12420 get_var(GEnv, sys_result_type, Result_type_Get),
12421 f_typep(Object_Get, Result_type_Get, IFTEST),
12422 ( IFTEST\==[]
12423 -> get_var(GEnv, sys_object, Object_Get10),
12424 _11140=Object_Get10
12425 ; get_var(GEnv, sys_result_type, Key),
12426 ( is_eq(Key, t)
12427 -> get_var(GEnv, sys_object, Object_Get16),
12428 ElseResult31=Object_Get16
12429 ; ( is_eq(Key, character)
12430 -> get_var(GEnv, sys_object, Object_Get19),
12431 f_character(Object_Get19, TrueResult26),
12432 ElseResult29=TrueResult26
12433 ; ( is_eq(Key, function)
12434 -> sf_if(
12435 [ and,
12436 [consp, sys_object],
12437 [eq, [car, sys_object], [quote, lambda]]
12438 ],
12439
12440 [ eval,
12441 [list, [quote, function], sys_object]
12442 ],
12443
12444 [ if,
12445 [fboundp, sys_object],
12446 [fdefinition, sys_object]
12447 ],
12448
12449 [ error,
12450 [quote, type_error],
12451 kw_datum,
12452 sys_object,
12453 kw_expected_type,
12454 sys_result_type
12455 ],
12456 TrueResult),
12457 ElseResult27=TrueResult
12458 ; get_var(GEnv, sys_object, Object_Get22),
12459 get_var(GEnv,
12460 sys_result_type,
12461 Result_type_Get23),
12462 f_error(
12463 [ type_error,
12464 kw_datum,
12465 Object_Get22,
12466 kw_expected_type,
12467 Result_type_Get23
12468 ],
12469 ElseResult),
12470 ElseResult27=ElseResult
12471 ),
12472 ElseResult29=ElseResult27
12473 ),
12474 ElseResult31=ElseResult29
12475 ),
12476 _11140=ElseResult31
12477 )
12478 ),
12479 _11140=FnResult
12480 ),
12481 block_exit(coerce, FnResult),
12482 true).
12483:- set_opv(coerce, symbol_function, f_coerce),
12484 DefunResult=coerce.12485/*
12486:- side_effect(assert_lsp(coerce,
12487 lambda_def(defun,
12488 coerce,
12489 f_coerce,
12490 [sys_object, sys_result_type],
12491
12492 [
12493 [ if,
12494 [typep, sys_object, sys_result_type],
12495 sys_object,
12496
12497 [ case,
12498 sys_result_type,
12499 [[t], sys_object],
12500 [character, [character, sys_object]],
12501
12502 [ function,
12503
12504 [ if,
12505
12506 [ and,
12507 [consp, sys_object],
12508
12509 [ eq,
12510 [car, sys_object],
12511 [quote, lambda]
12512 ]
12513 ],
12514
12515 [ eval,
12516
12517 [ list,
12518 [quote, function],
12519 sys_object
12520 ]
12521 ],
12522
12523 [ if,
12524 [fboundp, sys_object],
12525 [fdefinition, sys_object]
12526 ],
12527
12528 [ error,
12529 [quote, type_error],
12530 kw_datum,
12531 sys_object,
12532 kw_expected_type,
12533 sys_result_type
12534 ]
12535 ]
12536 ],
12537
12538 [ t,
12539
12540 [ error,
12541 [quote, type_error],
12542 kw_datum,
12543 sys_object,
12544 kw_expected_type,
12545 sys_result_type
12546 ]
12547 ]
12548 ]
12549 ]
12550 ]))).
12551*/
12552/*
12553:- side_effect(assert_lsp(coerce,
12554 arglist_info(coerce,
12555 f_coerce,
12556 [sys_object, sys_result_type],
12557 arginfo{ all:
12558 [ sys_object,
12559 sys_result_type
12560 ],
12561 allow_other_keys:0,
12562 aux:0,
12563 body:0,
12564 complex:0,
12565 env:0,
12566 key:0,
12567 names:
12568 [ sys_object,
12569 sys_result_type
12570 ],
12571 opt:0,
12572 req:
12573 [ sys_object,
12574 sys_result_type
12575 ],
12576 rest:0,
12577 sublists:0,
12578 whole:0
12579 }))).
12580*/
12581/*
12582:- side_effect(assert_lsp(coerce, init_args(x, f_coerce))).
12583*/
12584/*
12585#+(or WAM-CL LISP500)
12586(defmacro deftype (name lambda-list &rest forms)
12587 `(ensure-type ',name #'(lambda ,lambda-list (block ,name ,@forms))))
12588
12589
12590*/
12591
12592/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:35781 **********************/
12593:-lisp_compile_to_prolog(pkg_sys,[defmacro,deftype,[name,'lambda-list','&rest',forms],['#BQ',['ensure-type',[quote,['#COMMA',name]],function([lambda,['#COMMA','lambda-list'],[block,['#COMMA',name],['#BQ-COMMA-ELIPSE',forms]]])]]])
12594/*
12595:- side_effect(generate_function_or_macro_name(
12596 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
12597 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
12598 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
12599 fbound(sys_expand, kw_function)=function(f_sys_expand11),
12600 name='GLOBAL',
12601 environ=env_1
12602 ],
12603 deftype,
12604 kw_macro,
12605 mf_deftype)).
12606*/
12607wl:lambda_def(defmacro, deftype, mf_deftype, [sys_name, sys_lambda_list, c38_rest, sys_forms], [['#BQ', [sys_ensure_type, [quote, ['#COMMA', sys_name]], function([lambda, ['#COMMA', sys_lambda_list], [block, ['#COMMA', sys_name], ['#BQ-COMMA-ELIPSE', sys_forms]]])]]]).
12608wl:arglist_info(deftype, mf_deftype, [sys_name, sys_lambda_list, c38_rest, sys_forms], arginfo{all:[sys_name, sys_lambda_list], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_name, sys_lambda_list, sys_forms], opt:0, req:[sys_name, sys_lambda_list], rest:[sys_forms], sublists:0, whole:0}).
12609wl: init_args(2, mf_deftype).
12610
12615sf_deftype(MacroEnv, Name_In, Lambda_list_In, RestNKeys, FResult) :-
12616 mf_deftype([deftype, Name_In, Lambda_list_In|RestNKeys],
12617 MacroEnv,
12618 MFResult),
12619 f_sys_env_eval(MacroEnv, MFResult, FResult).
12624mf_deftype([deftype, Name_In, Lambda_list_In|RestNKeys], MacroEnv, MFResult) :-
12625 nop(defmacro),
12626 GEnv=[bv(sys_name, Name_In), bv(sys_lambda_list, Lambda_list_In), bv(sys_forms, RestNKeys)],
12627 catch(( get_var(GEnv, sys_name, Name_Get),
12628 [sys_ensure_type, [quote, Name_Get], function([lambda, ['#COMMA', sys_lambda_list], [block, ['#COMMA', sys_name], ['#BQ-COMMA-ELIPSE', sys_forms]]])]=MFResult
12629 ),
12630 block_exit(deftype, MFResult),
12631 true).
12632:- set_opv(mf_deftype, type_of, sys_macro),
12633 set_opv(deftype, symbol_function, mf_deftype),
12634 DefMacroResult=deftype.12635/*
12636:- side_effect(assert_lsp(deftype,
12637 lambda_def(defmacro,
12638 deftype,
12639 mf_deftype,
12640
12641 [ sys_name,
12642 sys_lambda_list,
12643 c38_rest,
12644 sys_forms
12645 ],
12646
12647 [
12648 [ '#BQ',
12649
12650 [ sys_ensure_type,
12651 [quote, ['#COMMA', sys_name]],
12652 function(
12653 [ lambda,
12654
12655 [ '#COMMA',
12656 sys_lambda_list
12657 ],
12658
12659 [ block,
12660 ['#COMMA', sys_name],
12661
12662 [ '#BQ-COMMA-ELIPSE',
12663 sys_forms
12664 ]
12665 ]
12666 ])
12667 ]
12668 ]
12669 ]))).
12670*/
12671/*
12672:- side_effect(assert_lsp(deftype,
12673 arglist_info(deftype,
12674 mf_deftype,
12675
12676 [ sys_name,
12677 sys_lambda_list,
12678 c38_rest,
12679 sys_forms
12680 ],
12681 arginfo{ all:[sys_name, sys_lambda_list],
12682 allow_other_keys:0,
12683 aux:0,
12684 body:0,
12685 complex:[rest],
12686 env:0,
12687 key:0,
12688 names:
12689 [ sys_name,
12690 sys_lambda_list,
12691 sys_forms
12692 ],
12693 opt:0,
12694 req:[sys_name, sys_lambda_list],
12695 rest:[sys_forms],
12696 sublists:0,
12697 whole:0
12698 }))).
12699*/
12700/*
12701:- side_effect(assert_lsp(deftype, init_args(2, mf_deftype))).
12702*/
12703/*
12704#+(or WAM-CL LISP500)
12705(defun *= (cons number)
12706 (or (not cons) (eq (car cons) '*) (= (car cons) number)))
12707
12708
12709
12710*/
12711
12712/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:35931 **********************/
12713:-lisp_compile_to_prolog(pkg_sys,[defun,*=,[cons,number],[or,[not,cons],[eq,[car,cons],[quote,*]],[=,[car,cons],number]]])
12714/*
12715:- side_effect(generate_function_or_macro_name(
12716 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
12717 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
12718 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
12719 fbound(sys_expand, kw_function)=function(f_sys_expand11),
12720 name='GLOBAL',
12721 environ=env_1
12722 ],
12723 *=,
12724 kw_function,
12725 f_sys_xx_c61)).
12726*/
12727wl:lambda_def(defun, *=, f_sys_xx_c61, [cons, number], [[or, [not, cons], [eq, [car, cons], [quote, *]], [=, [car, cons], number]]]).
12728wl:arglist_info(*=, f_sys_xx_c61, [cons, number], arginfo{all:[cons, number], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[cons, number], opt:0, req:[cons, number], rest:0, sublists:0, whole:0}).
12729wl: init_args(2, f_sys_xx_c61).
12730
12735f_sys_xx_c61(Cons_In, Number_In, RestNKeys, FnResult) :-
12736 GEnv=[bv(cons, Cons_In), bv(number, Number_In)],
12737 catch(( ( get_var(GEnv, cons, Cons_Get),
12738 f_not(Cons_Get, FORM1_Res11),
12739 FORM1_Res11\==[],
12740 _7130=FORM1_Res11
12741 -> true
12742 ; ( get_var(GEnv, cons, Cons_Get7),
12743 f_car(Cons_Get7, Eq_Param),
12744 f_eq(Eq_Param, *, FORM1_Res),
12745 FORM1_Res\==[],
12746 _7150=FORM1_Res
12747 -> true
12748 ; get_var(GEnv, cons, Cons_Get8),
12749 f_car(Cons_Get8, Car_Ret),
12750 get_var(GEnv, number, Number_Get),
12751 'f_='(Car_Ret, Number_Get, _7184),
12752 _7150=_7184
12753 ),
12754 _7130=_7150
12755 ),
12756 _7130=FnResult
12757 ),
12758 block_exit(*=, FnResult),
12759 true).
12760:- set_opv(*=, symbol_function, f_sys_xx_c61),
12761 DefunResult= *= .12762/*
12763:- side_effect(assert_lsp(*=,
12764 lambda_def(defun,
12765 *=,
12766 f_sys_xx_c61,
12767 [cons, number],
12768
12769 [
12770 [ or,
12771 [not, cons],
12772 [eq, [car, cons], [quote, *]],
12773 [=, [car, cons], number]
12774 ]
12775 ]))).
12776*/
12777/*
12778:- side_effect(assert_lsp(*=,
12779 arglist_info(*=,
12780 f_sys_xx_c61,
12781 [cons, number],
12782 arginfo{ all:[cons, number],
12783 allow_other_keys:0,
12784 aux:0,
12785 body:0,
12786 complex:0,
12787 env:0,
12788 key:0,
12789 names:[cons, number],
12790 opt:0,
12791 req:[cons, number],
12792 rest:0,
12793 sublists:0,
12794 whole:0
12795 }))).
12796*/
12797/*
12798:- side_effect(assert_lsp(*=, init_args(2, f_sys_xx_c61))).
12799*/
12800/*
12801#+(or WAM-CL LISP500)
12802(defun ensure-type (name expander)
12803 (let ((cons (assoc name *type-expanders*)))
12804 (if cons
12805 (setf (cdr cons) expander)
12806 (push (cons name expander) *type-expanders*))
12807 name))
12808
12809
12810
12811*/
12812
12813/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:36047 **********************/
12814:-lisp_compile_to_prolog(pkg_sys,[defun,'ensure-type',[name,expander],[let,[[cons,[assoc,name,'*type-expanders*']]],[if,cons,[setf,[cdr,cons],expander],[push,[cons,name,expander],'*type-expanders*']],name]])
12815/*
12816:- side_effect(generate_function_or_macro_name(
12817 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
12818 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
12819 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
12820 fbound(sys_expand, kw_function)=function(f_sys_expand11),
12821 name='GLOBAL',
12822 environ=env_1
12823 ],
12824 sys_ensure_type,
12825 kw_function,
12826 f_sys_ensure_type)).
12827*/
12828/*
12829:- side_effect((compile_each([fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv, [], [], true), append([cons], [CAR16, CAR], [cons, CAR16, CAR]), setf_inverse_op(cdr, rplacd))).
12830*/
12831/*
12832:- side_effect((compile_each([fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1), fbound(sys_all_car, kw_function)=function(f_sys_all_car1), fbound(sys_all_end, kw_function)=function(f_sys_all_end1), fbound(sys_expand, kw_function)=function(f_sys_expand11), name='GLOBAL', environ=env_1], LEnv, [], [], true), append([cons], [CAR16, CAR], [cons, CAR16, CAR]), setf_inverse_op(cdr, rplacd))).
12833*/
12834/*
12835% macroexpand:-[push,[cons,sys_name,sys_expander],sys_xx_type_expanders_xx].
12836*/
12837/*
12838% into:-[setq,sys_xx_type_expanders_xx,[cons,[cons,sys_name,sys_expander],sys_xx_type_expanders_xx]].
12839*/
12840wl:lambda_def(defun, sys_ensure_type, f_sys_ensure_type, [sys_name, sys_expander], [[let, [[cons, [assoc, sys_name, sys_xx_type_expanders_xx]]], [if, cons, [setf, [cdr, cons], sys_expander], [push, [cons, sys_name, sys_expander], sys_xx_type_expanders_xx]], sys_name]]).
12841wl:arglist_info(sys_ensure_type, f_sys_ensure_type, [sys_name, sys_expander], arginfo{all:[sys_name, sys_expander], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_name, sys_expander], opt:0, req:[sys_name, sys_expander], rest:0, sublists:0, whole:0}).
12842wl: init_args(x, f_sys_ensure_type).
12843
12848f_sys_ensure_type(Name_In, Expander_In, FnResult) :-
12849 GEnv=[bv(sys_name, Name_In), bv(sys_expander, Expander_In)],
12850 catch(( ( get_var(GEnv, sys_name, Name_Get),
12851 get_var(GEnv,
12852 sys_xx_type_expanders_xx,
12853 Xx_type_expanders_xx_Get),
12854 f_assoc(Name_Get, Xx_type_expanders_xx_Get, [], Cons_Init),
12855 LEnv=[bv(cons, Cons_Init)|GEnv],
12856 get_var(LEnv, cons, IFTEST),
12857 ( IFTEST\==[]
12858 -> get_var(LEnv, cons, Cons_Get17),
12859 get_var(LEnv, sys_expander, Expander_Get),
12860 f_rplacd(Cons_Get17, Expander_Get, TrueResult),
12861 _10420=TrueResult
12862 ; get_var(LEnv, sys_expander, Expander_Get21),
12863 get_var(LEnv, sys_name, Name_Get20),
12864 CAR29=[Name_Get20|Expander_Get21],
12865 get_var(LEnv,
12866 sys_xx_type_expanders_xx,
12867 Xx_type_expanders_xx_Get22),
12868 ElseResult=[CAR29|Xx_type_expanders_xx_Get22],
12869 set_var(LEnv, sys_xx_type_expanders_xx, ElseResult),
12870 _10420=ElseResult
12871 ),
12872 get_var(LEnv, sys_name, Name_Get25)
12873 ),
12874 Name_Get25=FnResult
12875 ),
12876 block_exit(sys_ensure_type, FnResult),
12877 true).
12878:- set_opv(sys_ensure_type, symbol_function, f_sys_ensure_type),
12879 DefunResult=sys_ensure_type.12880/*
12881:- side_effect(assert_lsp(sys_ensure_type,
12882 lambda_def(defun,
12883 sys_ensure_type,
12884 f_sys_ensure_type,
12885 [sys_name, sys_expander],
12886
12887 [
12888 [ let,
12889
12890 [
12891 [ cons,
12892
12893 [ assoc,
12894 sys_name,
12895 sys_xx_type_expanders_xx
12896 ]
12897 ]
12898 ],
12899
12900 [ if,
12901 cons,
12902 [setf, [cdr, cons], sys_expander],
12903
12904 [ push,
12905 [cons, sys_name, sys_expander],
12906 sys_xx_type_expanders_xx
12907 ]
12908 ],
12909 sys_name
12910 ]
12911 ]))).
12912*/
12913/*
12914:- side_effect(assert_lsp(sys_ensure_type,
12915 arglist_info(sys_ensure_type,
12916 f_sys_ensure_type,
12917 [sys_name, sys_expander],
12918 arginfo{ all:[sys_name, sys_expander],
12919 allow_other_keys:0,
12920 aux:0,
12921 body:0,
12922 complex:0,
12923 env:0,
12924 key:0,
12925 names:[sys_name, sys_expander],
12926 opt:0,
12927 req:[sys_name, sys_expander],
12928 rest:0,
12929 sublists:0,
12930 whole:0
12931 }))).
12932*/
12933/*
12934:- side_effect(assert_lsp(sys_ensure_type, init_args(x, f_sys_ensure_type))).
12935*/
12936/*
12937#+WAM-CL
12938#+(or WAM-CL LISP500)
12939(defun ensure-package (name nicknames shadow shadowing-import-from use
12940 import-from intern export)
12941 (let ((package (find-package name)))
12942 (unless package
12943 (setq package (make-package name :nicknames nicknames)))
12944 (shadow shadow package)
12945 (mapc #'(lambda (list)
12946 (let ((imported-package (find-package (car list)))
12947 (symbol-names (cdr list)))
12948 (shadowing-import (mapcar #'(lambda (symbol-name)
12949 (find-symbol symbol-name
12950 imported-package))
12951 symbol-names)
12952 package)))
12953 shadowing-import-from)
12954 (use-package use package)
12955 (mapc #'(lambda (list)
12956 (let ((imported-package (find-package (car list)))
12957 (symbol-names (cdr list)))
12958 (import (mapcar #'(lambda (symbol-name)
12959 (find-symbol symbol-name imported-package))
12960 symbol-names)
12961 package)))
12962 import-from)
12963 (mapc #'(lambda (symbol-name) (intern symbol-name package)) intern)
12964 (export export package)
12965 package))
12966
12967*/
12968
12969/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:36263 **********************/
12970:-lisp_compile_to_prolog(pkg_sys,[defun,'ensure-package',[name,nicknames,shadow,'shadowing-import-from',use,'import-from',intern,export],[let,[[package,['find-package',name]]],[unless,package,[setq,package,['make-package',name,':nicknames',nicknames]]],[shadow,shadow,package],[mapc,function([lambda,[list],[let,[['imported-package',['find-package',[car,list]]],['symbol-names',[cdr,list]]],['shadowing-import',[mapcar,function([lambda,['symbol-name'],['find-symbol','symbol-name','imported-package']]),'symbol-names'],package]]]),'shadowing-import-from'],['use-package',use,package],[mapc,function([lambda,[list],[let,[['imported-package',['find-package',[car,list]]],['symbol-names',[cdr,list]]],[import,[mapcar,function([lambda,['symbol-name'],['find-symbol','symbol-name','imported-package']]),'symbol-names'],package]]]),'import-from'],[mapc,function([lambda,['symbol-name'],[intern,'symbol-name',package]]),intern],[export,export,package],package]])
12971/*
12972:- side_effect(generate_function_or_macro_name(
12973 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
12974 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
12975 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
12976 fbound(sys_expand, kw_function)=function(f_sys_expand11),
12977 name='GLOBAL',
12978 environ=env_1
12979 ],
12980 sys_ensure_package,
12981 kw_function,
12982 f_sys_ensure_package)).
12983*/
12984wl:lambda_def(defun, sys_ensure_package, f_sys_ensure_package, [sys_name, sys_nicknames, shadow, sys_shadowing_import_from, sys_use, sys_import_from, intern, export], [[let, [[package, [find_package, sys_name]]], [unless, package, [setq, package, [make_package, sys_name, kw_nicknames, sys_nicknames]]], [shadow, shadow, package], [mapc, function([lambda, [list], [let, [[sys_imported_package, [find_package, [car, list]]], [sys_symbol_names, [cdr, list]]], [shadowing_import, [mapcar, function([lambda, [symbol_name], [find_symbol, symbol_name, sys_imported_package]]), sys_symbol_names], package]]]), sys_shadowing_import_from], [use_package, sys_use, package], [mapc, function([lambda, [list], [let, [[sys_imported_package, [find_package, [car, list]]], [sys_symbol_names, [cdr, list]]], [import, [mapcar, function([lambda, [symbol_name], [find_symbol, symbol_name, sys_imported_package]]), sys_symbol_names], package]]]), sys_import_from], [mapc, function([lambda, [symbol_name], [intern, symbol_name, package]]), intern], [export, export, package], package]]).
12985wl:arglist_info(sys_ensure_package, f_sys_ensure_package, [sys_name, sys_nicknames, shadow, sys_shadowing_import_from, sys_use, sys_import_from, intern, export], arginfo{all:[sys_name, sys_nicknames, shadow, sys_shadowing_import_from, sys_use, sys_import_from, intern, export], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_name, sys_nicknames, shadow, sys_shadowing_import_from, sys_use, sys_import_from, intern, export], opt:0, req:[sys_name, sys_nicknames, shadow, sys_shadowing_import_from, sys_use, sys_import_from, intern, export], rest:0, sublists:0, whole:0}).
12986wl: init_args(x, f_sys_ensure_package).
12987
12992f_sys_ensure_package(Name_In, Nicknames_In, Shadow_In, Shadowing_import_from_In, Use_In, Import_from_In, Intern_In, Export_In, FnResult) :-
12993 GEnv=[bv(sys_name, Name_In), bv(sys_nicknames, Nicknames_In), bv(shadow, Shadow_In), bv(sys_shadowing_import_from, Shadowing_import_from_In), bv(sys_use, Use_In), bv(sys_import_from, Import_from_In), bv(intern, Intern_In), bv(export, Export_In)],
12994 catch(( ( get_var(GEnv, sys_name, Name_Get),
12995 f_find_package(Name_Get, Package_Init),
12996 LEnv=[bv(package, Package_Init)|GEnv],
12997 get_var(LEnv, package, IFTEST),
12998 ( IFTEST\==[]
12999 -> _10462=[]
13000 ; get_var(LEnv, sys_name, Name_Get21),
13001 get_var(LEnv, sys_nicknames, Nicknames_Get),
13002 f_make_package(Name_Get21,
13003 [kw_nicknames, Nicknames_Get],
13004 ElseResult),
13005 set_var(LEnv, package, ElseResult),
13006 _10462=ElseResult
13007 ),
13008 get_var(LEnv, package, Package_Get25),
13009 get_var(LEnv, shadow, Shadow_Get),
13010 f_shadow(Shadow_Get, Package_Get25, Shadow_Ret),
13011 get_var(LEnv,
13012 sys_shadowing_import_from,
13013 Shadowing_import_from_Get),
13014 f_mapc(closure(kw_function,
13015 [ClosureEnvironment43|LEnv],
13016 Whole44,
13017 LetResult27,
13018 [list],
13019 (get_var(ClosureEnvironment43, list, List_Get), f_car(List_Get, Find_package_Param), f_find_package(Find_package_Param, Imported_package_Init), get_var(ClosureEnvironment43, list, List_Get30), f_cdr(List_Get30, Symbol_names_Init), LEnv28=[bv(sys_imported_package, Imported_package_Init), bv(sys_symbol_names, Symbol_names_Init)|ClosureEnvironment43], get_var(LEnv28, sys_symbol_names, Symbol_names_Get), f_mapcar(closure(kw_function, [ClosureEnvironment|LEnv28], Whole, LResult, [symbol_name], (get_var(ClosureEnvironment, symbol_name, Symbol_name_Get), get_var(ClosureEnvironment, sys_imported_package, Imported_package_Get), f_find_symbol(Symbol_name_Get, Imported_package_Get, LResult)), [lambda, [symbol_name], [find_symbol, symbol_name, sys_imported_package]]), [Symbol_names_Get], Shadowing_import_Param), get_var(LEnv28, package, Package_Get40), f_shadowing_import(Shadowing_import_Param, Package_Get40, LetResult27)),
13020
13021 [ lambda,
13022 [list],
13023
13024 [ let,
13025
13026 [
13027 [ sys_imported_package,
13028 [find_package, [car, list]]
13029 ],
13030 [sys_symbol_names, [cdr, list]]
13031 ],
13032
13033 [ shadowing_import,
13034
13035 [ mapcar,
13036 function(
13037 [ lambda,
13038 [symbol_name],
13039
13040 [ find_symbol,
13041 symbol_name,
13042 sys_imported_package
13043 ]
13044 ]),
13045 sys_symbol_names
13046 ],
13047 package
13048 ]
13049 ]
13050 ]),
13051 [Shadowing_import_from_Get],
13052 Mapc_Ret),
13053 get_var(LEnv, package, Package_Get47),
13054 get_var(LEnv, sys_use, Use_Get),
13055 f_use_package(Use_Get, Package_Get47, Use_package_Ret),
13056 get_var(LEnv, sys_import_from, Import_from_Get),
13057 f_mapc(closure(kw_function,
13058 [ClosureEnvironment65|LEnv],
13059 Whole66,
13060 LetResult49,
13061 [list],
13062 (get_var(ClosureEnvironment65, list, List_Get51), f_car(List_Get51, Find_package_Param83), f_find_package(Find_package_Param83, Imported_package_Init53), get_var(ClosureEnvironment65, list, List_Get52), f_cdr(List_Get52, Symbol_names_Init54), LEnv50=[bv(sys_imported_package, Imported_package_Init53), bv(sys_symbol_names, Symbol_names_Init54)|ClosureEnvironment65], get_var(LEnv50, sys_symbol_names, Symbol_names_Get61), f_mapcar(closure(kw_function, [ClosureEnvironment59|LEnv50], Whole60, LResult57, [symbol_name], (get_var(ClosureEnvironment59, symbol_name, Symbol_name_Get55), get_var(ClosureEnvironment59, sys_imported_package, Imported_package_Get56), f_find_symbol(Symbol_name_Get55, Imported_package_Get56, LResult57)), [lambda, [symbol_name], [find_symbol, symbol_name, sys_imported_package]]), [Symbol_names_Get61], Import_Param), get_var(LEnv50, package, Package_Get62), f_import(Import_Param, Package_Get62, LetResult49)),
13063
13064 [ lambda,
13065 [list],
13066
13067 [ let,
13068
13069 [
13070 [ sys_imported_package,
13071 [find_package, [car, list]]
13072 ],
13073 [sys_symbol_names, [cdr, list]]
13074 ],
13075
13076 [ import,
13077
13078 [ mapcar,
13079 function(
13080 [ lambda,
13081 [symbol_name],
13082
13083 [ find_symbol,
13084 symbol_name,
13085 sys_imported_package
13086 ]
13087 ]),
13088 sys_symbol_names
13089 ],
13090 package
13091 ]
13092 ]
13093 ]),
13094 [Import_from_Get],
13095 Mapc_Ret88),
13096 get_var(LEnv, intern, Intern_Get),
13097 f_mapc(closure(kw_function,
13098 [ClosureEnvironment72|LEnv],
13099 Whole73,
13100 LResult70,
13101 [symbol_name],
13102 (get_var(ClosureEnvironment72, package, Package_Get69), get_var(ClosureEnvironment72, symbol_name, Symbol_name_Get68), f_intern(Symbol_name_Get68, Package_Get69, LResult70)),
13103
13104 [ lambda,
13105 [symbol_name],
13106 [intern, symbol_name, package]
13107 ]),
13108 [Intern_Get],
13109 Mapc_Ret89),
13110 get_var(LEnv, export, Export_Get),
13111 get_var(LEnv, package, Package_Get76),
13112 f_export(Export_Get, Package_Get76, Export_Ret),
13113 get_var(LEnv, package, Package_Get77)
13114 ),
13115 Package_Get77=FnResult
13116 ),
13117 block_exit(sys_ensure_package, FnResult),
13118 true).
13119:- set_opv(sys_ensure_package, symbol_function, f_sys_ensure_package),
13120 DefunResult=sys_ensure_package.13121/*
13122:- side_effect(assert_lsp(sys_ensure_package,
13123 lambda_def(defun,
13124 sys_ensure_package,
13125 f_sys_ensure_package,
13126
13127 [ sys_name,
13128 sys_nicknames,
13129 shadow,
13130 sys_shadowing_import_from,
13131 sys_use,
13132 sys_import_from,
13133 intern,
13134 export
13135 ],
13136
13137 [
13138 [ let,
13139 [[package, [find_package, sys_name]]],
13140
13141 [ unless,
13142 package,
13143
13144 [ setq,
13145 package,
13146
13147 [ make_package,
13148 sys_name,
13149 kw_nicknames,
13150 sys_nicknames
13151 ]
13152 ]
13153 ],
13154 [shadow, shadow, package],
13155
13156 [ mapc,
13157 function(
13158 [ lambda,
13159 [list],
13160
13161 [ let,
13162
13163 [
13164 [ sys_imported_package,
13165
13166 [ find_package,
13167 [car, list]
13168 ]
13169 ],
13170
13171 [ sys_symbol_names,
13172 [cdr, list]
13173 ]
13174 ],
13175
13176 [ shadowing_import,
13177
13178 [ mapcar,
13179 function(
13180 [ lambda,
13181 [symbol_name],
13182
13183 [ find_symbol,
13184 symbol_name,
13185 sys_imported_package
13186 ]
13187 ]),
13188 sys_symbol_names
13189 ],
13190 package
13191 ]
13192 ]
13193 ]),
13194 sys_shadowing_import_from
13195 ],
13196 [use_package, sys_use, package],
13197
13198 [ mapc,
13199 function(
13200 [ lambda,
13201 [list],
13202
13203 [ let,
13204
13205 [
13206 [ sys_imported_package,
13207
13208 [ find_package,
13209 [car, list]
13210 ]
13211 ],
13212
13213 [ sys_symbol_names,
13214 [cdr, list]
13215 ]
13216 ],
13217
13218 [ import,
13219
13220 [ mapcar,
13221 function(
13222 [ lambda,
13223 [symbol_name],
13224
13225 [ find_symbol,
13226 symbol_name,
13227 sys_imported_package
13228 ]
13229 ]),
13230 sys_symbol_names
13231 ],
13232 package
13233 ]
13234 ]
13235 ]),
13236 sys_import_from
13237 ],
13238
13239 [ mapc,
13240 function(
13241 [ lambda,
13242 [symbol_name],
13243
13244 [ intern,
13245 symbol_name,
13246 package
13247 ]
13248 ]),
13249 intern
13250 ],
13251 [export, export, package],
13252 package
13253 ]
13254 ]))).
13255*/
13256/*
13257:- side_effect(assert_lsp(sys_ensure_package,
13258 arglist_info(sys_ensure_package,
13259 f_sys_ensure_package,
13260
13261 [ sys_name,
13262 sys_nicknames,
13263 shadow,
13264 sys_shadowing_import_from,
13265 sys_use,
13266 sys_import_from,
13267 intern,
13268 export
13269 ],
13270 arginfo{ all:
13271 [ sys_name,
13272 sys_nicknames,
13273 shadow,
13274 sys_shadowing_import_from,
13275 sys_use,
13276 sys_import_from,
13277 intern,
13278 export
13279 ],
13280 allow_other_keys:0,
13281 aux:0,
13282 body:0,
13283 complex:0,
13284 env:0,
13285 key:0,
13286 names:
13287 [ sys_name,
13288 sys_nicknames,
13289 shadow,
13290 sys_shadowing_import_from,
13291 sys_use,
13292 sys_import_from,
13293 intern,
13294 export
13295 ],
13296 opt:0,
13297 req:
13298 [ sys_name,
13299 sys_nicknames,
13300 shadow,
13301 sys_shadowing_import_from,
13302 sys_use,
13303 sys_import_from,
13304 intern,
13305 export
13306 ],
13307 rest:0,
13308 sublists:0,
13309 whole:0
13310 }))).
13311*/
13312/*
13313:- side_effect(assert_lsp(sys_ensure_package,
13314 init_args(x, f_sys_ensure_package))).
13315*/
13316/*
13317#+WAM-CL
13318#+(or WAM-CL LISP500)
13319(defmacro defpackage (defined-package-name &rest options)
13320 (flet ((option (option-name)
13321 (mapcan #'(lambda (option)
13322 (when (eq (car option) option-name)
13323 (mapcar #'designator-string (cdr option))))
13324 options))
13325 (options (option-name)
13326 (mapcan #'(lambda (option)
13327 (when (eq (car option) option-name)
13328 (list (mapcar #'designator-string (cdr option)))))
13329 options)))
13330 `(ensure-package ,(designator-string defined-package-name)
13331 ,(option :nicknames)
13332 ,(option :shadow) ,(options :shadowing-import-from) ,(option :use)
13333 ,(options :import-from) ,(option :intern) ,(option :export))))
13334
13335
13336
13337*/
13338
13339/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:37286 **********************/
13340:-lisp_compile_to_prolog(pkg_sys,[defmacro,defpackage,['defined-package-name','&rest',options],[flet,[[option,['option-name'],[mapcan,function([lambda,[option],[when,[eq,[car,option],'option-name'],[mapcar,function('designator-string'),[cdr,option]]]]),options]],[options,['option-name'],[mapcan,function([lambda,[option],[when,[eq,[car,option],'option-name'],[list,[mapcar,function('designator-string'),[cdr,option]]]]]),options]]],['#BQ',['ensure-package',['#COMMA',['designator-string','defined-package-name']],['#COMMA',[option,':nicknames']],['#COMMA',[option,':shadow']],['#COMMA',[options,':shadowing-import-from']],['#COMMA',[option,':use']],['#COMMA',[options,':import-from']],['#COMMA',[option,':intern']],['#COMMA',[option,':export']]]]]])
13341/*
13342:- side_effect(generate_function_or_macro_name(
13343 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
13344 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
13345 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
13346 fbound(sys_expand, kw_function)=function(f_sys_expand11),
13347 name='GLOBAL',
13348 environ=env_1
13349 ],
13350 defpackage,
13351 kw_macro,
13352 mf_defpackage)).
13353*/
13354/*
13355:- side_effect(generate_function_or_macro_name(
13356 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
13357 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
13358 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
13359 fbound(sys_expand, kw_function)=function(f_sys_expand11),
13360 name='GLOBAL',
13361 environ=env_1
13362 ],
13363 sys_option,
13364 kw_function,
13365 f_sys_option)).
13366*/
13367/*
13368:- side_effect(generate_function_or_macro_name(
13369 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
13370 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
13371 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
13372 fbound(sys_expand, kw_function)=function(f_sys_expand11),
13373 name='GLOBAL',
13374 environ=env_1
13375 ],
13376 sys_options,
13377 kw_function,
13378 f_sys_options)).
13379*/
13380wl:lambda_def(defmacro, defpackage, mf_defpackage, [sys_defined_package_name, c38_rest, sys_options], [[flet, [[sys_option, [sys_option_name], [mapcan, function([lambda, [sys_option], [when, [eq, [car, sys_option], sys_option_name], [mapcar, function(sys_designator_string), [cdr, sys_option]]]]), sys_options]], [sys_options, [sys_option_name], [mapcan, function([lambda, [sys_option], [when, [eq, [car, sys_option], sys_option_name], [list, [mapcar, function(sys_designator_string), [cdr, sys_option]]]]]), sys_options]]], ['#BQ', [sys_ensure_package, ['#COMMA', [sys_designator_string, sys_defined_package_name]], ['#COMMA', [sys_option, kw_nicknames]], ['#COMMA', [sys_option, kw_shadow]], ['#COMMA', [sys_options, kw_shadowing_import_from]], ['#COMMA', [sys_option, kw_use]], ['#COMMA', [sys_options, kw_import_from]], ['#COMMA', [sys_option, kw_intern]], ['#COMMA', [sys_option, kw_export]]]]]]).
13381wl:arglist_info(defpackage, mf_defpackage, [sys_defined_package_name, c38_rest, sys_options], arginfo{all:[sys_defined_package_name], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_defined_package_name, sys_options], opt:0, req:[sys_defined_package_name], rest:[sys_options], sublists:0, whole:0}).
13382wl: init_args(1, mf_defpackage).
13383
13388sf_defpackage(MacroEnv, Defined_package_name_In, RestNKeys, FResult) :-
13389 mf_defpackage([defpackage, Defined_package_name_In|RestNKeys],
13390 MacroEnv,
13391 MFResult),
13392 f_sys_env_eval(MacroEnv, MFResult, FResult).
13397mf_defpackage([defpackage, Defined_package_name_In|RestNKeys], MacroEnv, MFResult) :-
13398 nop(defmacro),
13399 Env=[bv(sys_defined_package_name, Defined_package_name_In), bv(sys_options, RestNKeys)],
13400 catch(( ( assert_lsp(sys_option,
13401 wl:lambda_def(defun, sys_option, f_sys_option1, [sys_option_name], [[mapcan, function([lambda, [sys_option], [when, [eq, [car, sys_option], sys_option_name], [mapcar, function(sys_designator_string), [cdr, sys_option]]]]), sys_options]])),
13402 assert_lsp(sys_option,
13403 wl:arglist_info(sys_option, f_sys_option1, [sys_option_name], arginfo{all:[sys_option_name], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_option_name], opt:0, req:[sys_option_name], rest:0, sublists:0, whole:0})),
13404 assert_lsp(sys_option, wl:init_args(1, f_sys_option1)),
13405 assert_lsp(sys_option,
13406 (f_sys_option1(Option_name_In, RestNKeys8, FnResult):-GEnv=[bv(sys_option_name, Option_name_In)], catch(((get_var(GEnv, sys_options, Options_Get), f_mapcan(closure(kw_function, [ClosureEnvironment|GEnv], Whole, LResult, [sys_option], (get_var(ClosureEnvironment, sys_option, Option_Get), f_car(Option_Get, PredArg1Result), get_var(ClosureEnvironment, sys_option_name, Option_name_Get), (is_eq(PredArg1Result, Option_name_Get)->get_var(ClosureEnvironment, sys_option, Option_Get16), f_cdr(Option_Get16, Cdr_Ret), f_mapcar(f_sys_designator_string, [Cdr_Ret], TrueResult), LResult=TrueResult;LResult=[])), [lambda, [sys_option], [when, [eq, [car, sys_option], sys_option_name], [mapcar, function(sys_designator_string), [cdr, sys_option]]]]), [Options_Get], Mapcan_Ret)), Mapcan_Ret=FnResult), block_exit(sys_option, FnResult), true))),
13407 assert_lsp(sys_options,
13408 wl:lambda_def(defun, sys_options, f_sys_options1, [sys_option_name], [[mapcan, function([lambda, [sys_option], [when, [eq, [car, sys_option], sys_option_name], [list, [mapcar, function(sys_designator_string), [cdr, sys_option]]]]]), sys_options]])),
13409 assert_lsp(sys_options,
13410 wl:arglist_info(sys_options, f_sys_options1, [sys_option_name], arginfo{all:[sys_option_name], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_option_name], opt:0, req:[sys_option_name], rest:0, sublists:0, whole:0})),
13411 assert_lsp(sys_options, wl:init_args(1, f_sys_options1)),
13412 assert_lsp(sys_options,
13413 (f_sys_options1(Option_name_In26, RestNKeys25, FnResult24):-GEnv45=[bv(sys_option_name, Option_name_In26)], catch(((get_var(GEnv45, sys_options, Options_Get39), f_mapcan(closure(kw_function, [ClosureEnvironment37|GEnv45], Whole38, LResult35, [sys_option], (get_var(ClosureEnvironment37, sys_option, Option_Get28), f_car(Option_Get28, PredArg1Result31), get_var(ClosureEnvironment37, sys_option_name, Option_name_Get29), (is_eq(PredArg1Result31, Option_name_Get29)->get_var(ClosureEnvironment37, sys_option, Option_Get33), f_cdr(Option_Get33, Cdr_Ret56), f_mapcar(f_sys_designator_string, [Cdr_Ret56], Mapcar_Ret), TrueResult34=[Mapcar_Ret], LResult35=TrueResult34;LResult35=[])), [lambda, [sys_option], [when, [eq, [car, sys_option], sys_option_name], [list, [mapcar, function(sys_designator_string), [cdr, sys_option]]]]]), [Options_Get39], Mapcan_Ret55)), Mapcan_Ret55=FnResult24), block_exit(sys_options, FnResult24), true))),
13414 get_var(
13415 [
13416 [ fbound(sys_option, kw_function)=function(f_sys_option1),
13417 fbound(sys_options, kw_function)=function(f_sys_options1)
13418 ]
13419 | Env
13420 ],
13421 sys_defined_package_name,
13422 Defined_package_name_Get),
13423 f_sys_designator_string(Defined_package_name_Get,
13424 Designator_string_Ret),
13425 f_sys_option1(kw_nicknames, KeysNRest),
13426 f_sys_option1(kw_shadow, KeysNRest47),
13427 f_sys_options1(kw_shadowing_import_from, KeysNRest48),
13428 f_sys_option1(kw_use, KeysNRest49),
13429 f_sys_options1(kw_import_from, KeysNRest50),
13430 f_sys_option1(kw_intern, KeysNRest51),
13431 f_sys_option1(kw_export, KeysNRest52)
13432 ),
13433 [sys_ensure_package, Designator_string_Ret, KeysNRest, KeysNRest47, KeysNRest48, KeysNRest49, KeysNRest50, KeysNRest51, KeysNRest52]=MFResult
13434 ),
13435 block_exit(defpackage, MFResult),
13436 true).
13437:- set_opv(mf_defpackage, type_of, sys_macro),
13438 set_opv(defpackage, symbol_function, mf_defpackage),
13439 DefMacroResult=defpackage.13440/*
13441:- side_effect(assert_lsp(defpackage,
13442 lambda_def(defmacro,
13443 defpackage,
13444 mf_defpackage,
13445
13446 [ sys_defined_package_name,
13447 c38_rest,
13448 sys_options
13449 ],
13450
13451 [
13452 [ flet,
13453
13454 [
13455 [ sys_option,
13456 [sys_option_name],
13457
13458 [ mapcan,
13459 function(
13460 [ lambda,
13461 [sys_option],
13462
13463 [ when,
13464
13465 [ eq,
13466 [car, sys_option],
13467 sys_option_name
13468 ],
13469
13470 [ mapcar,
13471 function(sys_designator_string),
13472 [cdr, sys_option]
13473 ]
13474 ]
13475 ]),
13476 sys_options
13477 ]
13478 ],
13479
13480 [ sys_options,
13481 [sys_option_name],
13482
13483 [ mapcan,
13484 function(
13485 [ lambda,
13486 [sys_option],
13487
13488 [ when,
13489
13490 [ eq,
13491 [car, sys_option],
13492 sys_option_name
13493 ],
13494
13495 [ list,
13496
13497 [ mapcar,
13498 function(sys_designator_string),
13499 [cdr, sys_option]
13500 ]
13501 ]
13502 ]
13503 ]),
13504 sys_options
13505 ]
13506 ]
13507 ],
13508
13509 [ '#BQ',
13510
13511 [ sys_ensure_package,
13512
13513 [ '#COMMA',
13514
13515 [ sys_designator_string,
13516 sys_defined_package_name
13517 ]
13518 ],
13519
13520 [ '#COMMA',
13521 [sys_option, kw_nicknames]
13522 ],
13523 ['#COMMA', [sys_option, kw_shadow]],
13524
13525 [ '#COMMA',
13526
13527 [ sys_options,
13528 kw_shadowing_import_from
13529 ]
13530 ],
13531 ['#COMMA', [sys_option, kw_use]],
13532
13533 [ '#COMMA',
13534 [sys_options, kw_import_from]
13535 ],
13536 ['#COMMA', [sys_option, kw_intern]],
13537 ['#COMMA', [sys_option, kw_export]]
13538 ]
13539 ]
13540 ]
13541 ]))).
13542*/
13543/*
13544:- side_effect(assert_lsp(defpackage,
13545 arglist_info(defpackage,
13546 mf_defpackage,
13547
13548 [ sys_defined_package_name,
13549 c38_rest,
13550 sys_options
13551 ],
13552 arginfo{ all:[sys_defined_package_name],
13553 allow_other_keys:0,
13554 aux:0,
13555 body:0,
13556 complex:[rest],
13557 env:0,
13558 key:0,
13559 names:
13560 [ sys_defined_package_name,
13561 sys_options
13562 ],
13563 opt:0,
13564 req:[sys_defined_package_name],
13565 rest:[sys_options],
13566 sublists:0,
13567 whole:0
13568 }))).
13569*/
13570/*
13571:- side_effect(assert_lsp(defpackage, init_args(1, mf_defpackage))).
13572*/
13573/*
13574#+BUILTIN
13575#+(or WAM-CL LISP500)
13576(defun backquote-expand (list level)
13577 (if (consp list)
13578 (if (eq 'backquote (car list))
13579 (list 'list ''backquote
13580 (backquote-expand (car (cdr list)) (+ level 1)))
13581 (if (eq 'unquote (car list))
13582 (if (= level 0)
13583 (car (cdr list))
13584 (list 'list ''unquote
13585 (backquote-expand (car (cdr list)) (- level 1))))
13586 (if (eq 'unquote-splicing (car list))
13587 (if (= level 0)
13588 (values (car (cdr list)) t)
13589 (list 'list ''unquote-splicing
13590 (backquote-expand (car (cdr list)) (- level 1))))
13591 (labels ((collect (list)
13592 (if (consp list)
13593 (cons (multiple-value-call
13594 #'(lambda (value
13595 &optional splicingp)
13596 (if splicingp
13597 value
13598 (list 'list value)))
13599 (backquote-expand (car list) level))
13600 (collect (cdr list)))
13601 (list (list 'quote list)))))
13602 (cons 'append (collect list))))))
13603 (list 'quote list)))
13604
13605*/
13606
13607/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:37973 **********************/
13608:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defun,'backquote-expand',[list,level],[if,[consp,list],[if,[eq,[quote,backquote],[car,list]],[list,[quote,list],[quote,[quote,backquote]],['backquote-expand',[car,[cdr,list]],[+,level,1]]],[if,[eq,[quote,unquote],[car,list]],[if,[=,level,0],[car,[cdr,list]],[list,[quote,list],[quote,[quote,unquote]],['backquote-expand',[car,[cdr,list]],[-,level,1]]]],[if,[eq,[quote,'unquote-splicing'],[car,list]],[if,[=,level,0],[values,[car,[cdr,list]],t],[list,[quote,list],[quote,[quote,'unquote-splicing']],['backquote-expand',[car,[cdr,list]],[-,level,1]]]],[labels,[[collect,[list],[if,[consp,list],[cons,['multiple-value-call',function([lambda,[value,'&optional',splicingp],[if,splicingp,value,[list,[quote,list],value]]]),['backquote-expand',[car,list],level]],[collect,[cdr,list]]],[list,[list,[quote,quote],list]]]]],[cons,[quote,append],[collect,list]]]]]],[list,[quote,quote],list]]]]]))
13609/*
13610#+BUILTIN
13611#+(or WAM-CL LISP500)
13612(defmacro backquote (form)
13613 (backquote-expand form 0))
13614
13615
13616*/
13617
13618/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:38983 **********************/
13619:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':BUILTIN'],[#+,[':or',':WAM-CL',':LISP500'],[defmacro,backquote,[form],['backquote-expand',form,0]]]]))
13620/*
13621#+(or WAM-CL LISP500)
13622(defmacro with-simple-restart ((name format-control &rest format-arguments)
13623 &rest forms)
13624 (let ((tag (gensym)))
13625 `(block ,tag
13626 (restart-bind
13627 ((,name
13628 #'(lambda () (return-from ,tag (values nil t)))
13629 :interactive-function #'(lambda () nil)
13630 :report-function #'(lambda (stream)
13631 (apply #'format stream ',format-control
13632 ',format-arguments))
13633 :test-function #'(lambda () t)))
13634 ,@forms))))
13635
13636
13637*/
13638
13639/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:39080 **********************/
13640:-lisp_compile_to_prolog(pkg_sys,[defmacro,'with-simple-restart',[[name,'format-control','&rest','format-arguments'],'&rest',forms],[let,[[tag,[gensym]]],['#BQ',[block,['#COMMA',tag],['restart-bind',[[['#COMMA',name],function([lambda,[],['return-from',['#COMMA',tag],[values,[],t]]]),':interactive-function',function([lambda,[],[]]),':report-function',function([lambda,[stream],[apply,function(format),stream,[quote,['#COMMA','format-control']],[quote,['#COMMA','format-arguments']]]]),':test-function',function([lambda,[],t])]],['#BQ-COMMA-ELIPSE',forms]]]]]])
13641/*
13642:- side_effect(generate_function_or_macro_name(
13643 [ fbound(sys_all_cdr, kw_function)=function(f_sys_all_cdr1),
13644 fbound(sys_all_car, kw_function)=function(f_sys_all_car1),
13645 fbound(sys_all_end, kw_function)=function(f_sys_all_end1),
13646 fbound(sys_expand, kw_function)=function(f_sys_expand11),
13647 name='GLOBAL',
13648 environ=env_1
13649 ],
13650 with_simple_restart,
13651 kw_special,
13652 sf_with_simple_restart)).
13653*/
13654wl:lambda_def(defmacro, with_simple_restart, mf_with_simple_restart, [[sys_name, sys_format_control, c38_rest, sys_format_arguments], c38_rest, sys_forms], [[let, [[sys_tag, [gensym]]], ['#BQ', [block, ['#COMMA', sys_tag], [restart_bind, [[['#COMMA', sys_name], function([lambda, [], [return_from, ['#COMMA', sys_tag], [values, [], t]]]), kw_interactive_function, function([lambda, [], []]), kw_report_function, function([lambda, [stream], [apply, function(format), stream, [quote, ['#COMMA', sys_format_control]], [quote, ['#COMMA', sys_format_arguments]]]]), kw_test_function, function([lambda, [], t])]], ['#BQ-COMMA-ELIPSE', sys_forms]]]]]]).
13655wl:arglist_info(with_simple_restart, mf_with_simple_restart, [[sys_name, sys_format_control, c38_rest, sys_format_arguments], c38_rest, sys_forms], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_forms, sys_name, sys_format_control, sys_format_arguments], opt:0, req:0, rest:[sys_forms], sublists:0, whole:0}).
13656wl: init_args(1, mf_with_simple_restart).
13657
13662sf_with_simple_restart(SubEnv, [Name_In, Format_control_In|Format_arguments_In], RestNKeys, FResult) :-
13663 mf_with_simple_restart(
13664 [ with_simple_restart,
13665
13666 [ Name_In,
13667 Format_control_In
13668 | Format_arguments_In
13669 ]
13670 | RestNKeys
13671 ],
13672 SubEnv,
13673 MFResult),
13674 f_sys_env_eval(SubEnv, MFResult, FResult).
13679mf_with_simple_restart([with_simple_restart, [Name_In, Format_control_In|Format_arguments_In]|RestNKeys], SubEnv, MFResult) :-
13680 nop(defmacro),
13681 CDR=[bv(sys_forms, RestNKeys), bv(sys_name, Name_In), bv(sys_format_control, Format_control_In), bv(sys_format_arguments, Format_arguments_In)],
13682 catch(( ( f_gensym(Tag_Init),
13683 LEnv=[bv(sys_tag, Tag_Init)|CDR],
13684 ( get_var(LEnv, sys_forms, Forms_Get),
13685 get_var(LEnv, sys_name, Name_Get)
13686 ),
13687 get_var(LEnv, sys_tag, Tag_Get)
13688 ),
13689 [block, Tag_Get, [restart_bind, [[Name_Get, function([lambda, [], [return_from, ['#COMMA', sys_tag], [values, [], t]]]), kw_interactive_function, function([lambda, [], []]), kw_report_function, function([lambda, [stream], [apply, function(format), stream, [quote, ['#COMMA', sys_format_control]], [quote, ['#COMMA', sys_format_arguments]]]]), kw_test_function, function([lambda, [], t])]]|Forms_Get]]=MFResult
13690 ),
13691 block_exit(with_simple_restart, MFResult),
13692 true).
13693:- set_opv(mf_with_simple_restart, type_of, sys_macro),
13694 set_opv(with_simple_restart, symbol_function, mf_with_simple_restart),
13695 DefMacroResult=with_simple_restart.13696/*
13697:- side_effect(assert_lsp(with_simple_restart,
13698 lambda_def(defmacro,
13699 with_simple_restart,
13700 mf_with_simple_restart,
13701
13702 [
13703 [ sys_name,
13704 sys_format_control,
13705 c38_rest,
13706 sys_format_arguments
13707 ],
13708 c38_rest,
13709 sys_forms
13710 ],
13711
13712 [
13713 [ let,
13714 [[sys_tag, [gensym]]],
13715
13716 [ '#BQ',
13717
13718 [ block,
13719 ['#COMMA', sys_tag],
13720
13721 [ restart_bind,
13722
13723 [
13724 [ ['#COMMA', sys_name],
13725 function(
13726 [ lambda,
13727 [],
13728
13729 [ return_from,
13730 ['#COMMA', sys_tag],
13731 [values, [], t]
13732 ]
13733 ]),
13734 kw_interactive_function,
13735 function([lambda, [], []]),
13736 kw_report_function,
13737 function(
13738 [ lambda,
13739 [stream],
13740
13741 [ apply,
13742 function(format),
13743 stream,
13744
13745 [ quote,
13746
13747 [ '#COMMA',
13748 sys_format_control
13749 ]
13750 ],
13751
13752 [ quote,
13753
13754 [ '#COMMA',
13755 sys_format_arguments
13756 ]
13757 ]
13758 ]
13759 ]),
13760 kw_test_function,
13761 function([lambda, [], t])
13762 ]
13763 ],
13764 ['#BQ-COMMA-ELIPSE', sys_forms]
13765 ]
13766 ]
13767 ]
13768 ]
13769 ]))).
13770*/
13771/*
13772:- side_effect(assert_lsp(with_simple_restart,
13773 arglist_info(with_simple_restart,
13774 mf_with_simple_restart,
13775
13776 [
13777 [ sys_name,
13778 sys_format_control,
13779 c38_rest,
13780 sys_format_arguments
13781 ],
13782 c38_rest,
13783 sys_forms
13784 ],
13785 arginfo{ all:0,
13786 allow_other_keys:0,
13787 aux:0,
13788 body:0,
13789 complex:[rest],
13790 env:0,
13791 key:0,
13792 names:
13793 [ sys_forms,
13794 sys_name,
13795 sys_format_control,
13796 sys_format_arguments
13797 ],
13798 opt:0,
13799 req:0,
13800 rest:[sys_forms],
13801 sublists:0,
13802 whole:0
13803 }))).
13804*/
13805/*
13806:- side_effect(assert_lsp(with_simple_restart,
13807 init_args(1, mf_with_simple_restart))).
13808*/
13809/*
13810#+(or WAM-CL LISP500)
13811(defun break (&optional format-control &rest format-arguments)
13812 (with-simple-restart (continue "Return from BREAK.")
13813 (let ((*debugger-hook* nil))
13814 (invoke-debugger (make-condition 'simple-condition
13815 :format-control format-control
13816 :format-arguments format-arguments))))
13817 nil)
13818
13819
13820
13821*/
13822
13823/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-30.lisp:39558 **********************/
13824:-lisp_compile_to_prolog(pkg_sys,[defun,break,['&optional','format-control','&rest','format-arguments'],['with-simple-restart',[continue,'$STRING'("Return from BREAK.")],[let,[['*debugger-hook*',[]]],['invoke-debugger',['make-condition',[quote,'simple-condition'],':format-control','format-control',':format-arguments','format-arguments']]]],[]])
13825/*
13826% macroexpand:-[with_simple_restart,[continue,'$ARRAY'([*],claz_base_character,"Return from BREAK.")],[let,[[xx_debugger_hook_xx,[]]],[invoke_debugger,[make_condition,[quote,simple_condition],kw_format_control,sys_format_control,kw_format_arguments,sys_format_arguments]]]].
13827*/
13828/*
13829% into:-[block,g21,[restart_bind,[[continue,function([lambda,[],[return_from,['#COMMA',sys_tag],[values,[],t]]]),kw_interactive_function,function([lambda,[],[]]),kw_report_function,function([lambda,[stream],[apply,function(format),stream,[quote,['#COMMA',sys_format_control]],[quote,['#COMMA',sys_format_arguments]]]]),kw_test_function,function([lambda,[],t])]],[let,[[xx_debugger_hook_xx,[]]],[invoke_debugger,[make_condition,[quote,simple_condition],kw_format_control,sys_format_control,kw_format_arguments,sys_format_arguments]]]]].
13830*/
13831/*
13832% macroexpand:-[restart_bind,[[continue,function([lambda,[],[return_from,['#COMMA',sys_tag],[values,[],t]]]),kw_interactive_function,function([lambda,[],[]]),kw_report_function,function([lambda,[stream],[apply,function(format),stream,[quote,['#COMMA',sys_format_control]],[quote,['#COMMA',sys_format_arguments]]]]),kw_test_function,function([lambda,[],t])]],[let,[[xx_debugger_hook_xx,[]]],[invoke_debugger,[make_condition,[quote,simple_condition],kw_format_control,sys_format_control,kw_format_arguments,sys_format_arguments]]]].
13833*/
13834/*
13835% into:-[let,[[sys_xx_restarts_xx,[cons,[sys_make_restart,[quote,continue],function([lambda,[],[return_from,['#COMMA',sys_tag],[values,[],t]]]),kw_interactive_function,function([lambda,[],[]]),kw_report_function,function([lambda,[stream],[apply,function(format),stream,[quote,['#COMMA',sys_format_control]],[quote,['#COMMA',sys_format_arguments]]]]),kw_test_function,function([lambda,[],t])],sys_xx_restarts_xx]]],[let,[[xx_debugger_hook_xx,[]]],[invoke_debugger,[make_condition,[quote,simple_condition],kw_format_control,sys_format_control,kw_format_arguments,sys_format_arguments]]]].
13836*/
13837wl:lambda_def(defun, break, f_break, [c38_optional, sys_format_control, c38_rest, sys_format_arguments], [[with_simple_restart, [continue, '$ARRAY'([*], claz_base_character, "Return from BREAK.")], [let, [[xx_debugger_hook_xx, []]], [invoke_debugger, [make_condition, [quote, simple_condition], kw_format_control, sys_format_control, kw_format_arguments, sys_format_arguments]]]], []]).
13838wl:arglist_info(break, f_break, [c38_optional, sys_format_control, c38_rest, sys_format_arguments], arginfo{all:[sys_format_control], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sys_format_control, sys_format_arguments], opt:[sys_format_control], req:0, rest:[sys_format_arguments], sublists:0, whole:0}).
13839wl: init_args(0, f_break).
13840
13845f_break(Optionals, FnResult) :-
13846 GEnv=[bv(sys_format_control, Format_control_In), bv(sys_format_arguments, Optionals)],
13847 opt_var(Env, sys_format_control, Format_control_In, true, [], 1, Optionals),
13848 catch(( catch(( ( f_sys_make_restart(continue,
13849 closure(kw_function,
13850 [BlockExitEnv|GEnv],
13851 Whole,
13852 ThrowResult,
13853 [],
13854 (nb_setval('$mv_return', [[], t]), throw(block_exit(['#COMMA', sys_tag], []))),
13855
13856 [ lambda,
13857 [],
13858
13859 [ return_from,
13860 ['#COMMA', sys_tag],
13861 [values, [], t]
13862 ]
13863 ]),
13864 kw_interactive_function,
13865 closure(kw_function,
13866
13867 [ ClosureEnvironment18
13868 | GEnv
13869 ],
13870 Whole19,
13871 [],
13872 [],
13873 true,
13874 [lambda, [], []]),
13875 kw_report_function,
13876 closure(kw_function,
13877
13878 [ ClosureEnvironment23
13879 | GEnv
13880 ],
13881 Whole24,
13882 LResult21,
13883 [stream],
13884 (get_var(ClosureEnvironment23, stream, Stream_Get), f_apply(f_format, [Stream_Get, ['#COMMA', sys_format_control], ['#COMMA', sys_format_arguments]], LResult21)),
13885
13886 [ lambda,
13887 [stream],
13888
13889 [ apply,
13890 function(format),
13891 stream,
13892
13893 [ quote,
13894
13895 [ '#COMMA',
13896 sys_format_control
13897 ]
13898 ],
13899
13900 [ quote,
13901
13902 [ '#COMMA',
13903 sys_format_arguments
13904 ]
13905 ]
13906 ]
13907 ]),
13908 kw_test_function,
13909 closure(kw_function,
13910
13911 [ ClosureEnvironment26
13912 | GEnv
13913 ],
13914 Whole27,
13915 t,
13916 [],
13917 true,
13918 [lambda, [], t]),
13919 Make_restart_Ret),
13920 get_var(GEnv, sys_xx_restarts_xx, Xx_restarts_xx_Get),
13921 Xx_restarts_xx_Init=[Make_restart_Ret|Xx_restarts_xx_Get],
13922 LEnv=[bv(sys_xx_restarts_xx, Xx_restarts_xx_Init)|GEnv],
13923 locally_set(xx_debugger_hook_xx,
13924 [],
13925 (get_var(LEnv, sys_format_arguments, Format_arguments_Get), get_var(LEnv, sys_format_control, Format_control_Get), f_make_condition(simple_condition, kw_format_control, Format_control_Get, kw_format_arguments, Format_arguments_Get, Invoke_debugger_Param), f_invoke_debugger(Invoke_debugger_Param, LetResult)))
13926 ),
13927 LetResult=Block_exit_Ret
13928 ),
13929 block_exit(g21, Block_exit_Ret),
13930 true),
13931 []=FnResult
13932 ),
13933 block_exit(break, FnResult),
13934 true).
13935:- set_opv(break, symbol_function, f_break),
13936 DefunResult=break.14007
14008