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)