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;;; define-modify-macro.lisp
40;;;
41;;; Copyright (C) 2003-2005 Peter Graves
42;;; $Id$
43;;;
44;;; This program is free software; you can redistribute it and/or
45;;; modify it under the terms of the GNU General Public License
46;;; as published by the Free Software Foundation; either version 2
47;;; of the License, or (at your option) any later version.
48;;;
49;;; This program is distributed in the hope that it will be useful,
50;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
51;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
52;;; GNU General Public License for more details.
53;;;
54;;; You should have received a copy of the GNU General Public License
55;;; along with this program; if not, write to the Free Software
56;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
57;;;
58;;; As a special exception, the copyright holders of this library give you
59;;; permission to link this library with independent modules to produce an
60;;; executable, regardless of the license terms of these independent
61;;; modules, and to copy and distribute the resulting executable under
62;;; terms of your choice, provided that you also meet, for each linked
63;;; independent module, the terms and conditions of the license of that
64;;; module. An independent module is a module which is not derived from
65;;; or based on this library. If you modify this library, you may extend
66;;; this exception to your version of the library, but you are not
67;;; obligated to do so. If you do not wish to do so, delete this
68;;; exception statement from your version.
69
70;;; Adapted from SBCL.
71
72*/
73
74/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:262 **********************/
75:-lisp_compile_to_prolog(pkg_sys,['in-package','#:system'])
76/*
77% macroexpand:-[in_package,system4].
78*/
79/*
80% into:-[eval_when,[kw_compile_toplevel,kw_load_toplevel,kw_execute],[sys_select_package,'$ARRAY'([*],claz_base_character,"SYSTEM")]].
81*/
82:- do_when([kw_compile_toplevel, kw_load_toplevel, kw_execute],
83 f_sys_select_package('$ARRAY'([*], claz_base_character, "SYSTEM"),
84 _Ignored),
85 _Ignored).
86/*
87;; define-modify-macro.lisp
88*/
89/*
90;;
91*/
92/*
93;; Copyright (C) 2003-2005 Peter Graves
94*/
95/*
96;; $Id$
97*/
98/*
99;;
100*/
101/*
102;; This program is free software; you can redistribute it and/or
103*/
104/*
105;; modify it under the terms of the GNU General Public License
106*/
107/*
108;; as published by the Free Software Foundation; either version 2
109*/
110/*
111;; of the License, or (at your option) any later version.
112*/
113/*
114;;
115*/
116/*
117;; This program is distributed in the hope that it will be useful,
118*/
119/*
120;; but WITHOUT ANY WARRANTY; without even the implied warranty of
121*/
122/*
123;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
124*/
125/*
126;; GNU General Public License for more details.
127*/
128/*
129;;
130*/
131/*
132;; You should have received a copy of the GNU General Public License
133*/
134/*
135;; along with this program; if not, write to the Free Software
136*/
137/*
138;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
139*/
140/*
141;;
142*/
143/*
144;; As a special exception, the copyright holders of this library give you
145*/
146/*
147;; permission to link this library with independent modules to produce an
148*/
149/*
150;; executable, regardless of the license terms of these independent
151*/
152/*
153;; modules, and to copy and distribute the resulting executable under
154*/
155/*
156;; terms of your choice, provided that you also meet, for each linked
157*/
158/*
159;; independent module, the terms and conditions of the license of that
160*/
161/*
162;; module. An independent module is a module which is not derived from
163*/
164/*
165;; or based on this library. If you modify this library, you may extend
166*/
167/*
168;; this exception to your version of the library, but you are not
169*/
170/*
171;; obligated to do so. If you do not wish to do so, delete this
172*/
173/*
174;; exception statement from your version.
175*/
176/*
177;; Adapted from SBCL.
178*/
179/*
180(in-package "SYSTEM")
181
182;; FIXME See section 5.1.3.
183*/
184
185/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:1927 **********************/
186:-lisp_compile_to_prolog(pkg_sys,['in-package','#:system'])
187/*
188% macroexpand:-[in_package,system5].
189*/
190/*
191% into:-[eval_when,[kw_compile_toplevel,kw_load_toplevel,kw_execute],[sys_select_package,'$ARRAY'([*],claz_base_character,"SYSTEM")]].
192*/
193:- do_when([kw_compile_toplevel, kw_load_toplevel, kw_execute],
194 f_sys_select_package('$ARRAY'([*], claz_base_character, "SYSTEM"),
195 _Ignored),
196 _Ignored).
197/*
198; FIXME See section 5.1.3.
199*/
200/*
201#+(or (and ABCL ALT) WAM-CL)
202(defmacro define-modify-macro (name lambda-list function &optional doc-string)
203 "Creates a new read-modify-write macro like PUSH or INCF."
204 (let ((other-args nil)
205 (rest-arg nil)
206 (env (gensym))
207 (reference (gensym)))
208 ;; Parse out the variable names and &REST arg from the lambda list.
209 (do ((ll lambda-list (cdr ll))
210 (arg nil))
211 ((null ll))
212 (setq arg (car ll))
213 (cond ((eq arg '&optional))
214 ((eq arg '&rest)
215 (if (symbolp (cadr ll))
216 (setq rest-arg (cadr ll))
217 (error "Non-symbol &REST arg in definition of "#+(or (and ABCL ALT) WAM-CL)\r\n(defmacro define-modify-macro (name lambda-list function &optional doc-string)\r\n \"Creates a new read-modify-write macro like PUSH or INCF.\"\r\n (let ((other-args nil)\r\n\t(rest-arg nil)\r\n\t(env (gensym))\r\n\t(reference (gensym)))\r\n ;; Parse out the variable names and &REST arg from the lambda list.\r\n (do ((ll lambda-list (cdr ll))\r\n\t (arg nil))\r\n\t((null ll))\r\n (setq arg (car ll))\r\n (cond ((eq arg '&optional))\r\n\t ((eq arg '&rest)\r\n\t (if (symbolp (cadr ll))\r\n\t\t (setq rest-arg (cadr ll))\r\n\t\t (error \"Non-symbol &REST arg in definition of ~S.\" name))\r\n\t (if (null (cddr ll))\r\n\t\t (return nil)\r\n\t\t (error \"Illegal stuff after &REST argument in DEFINE-MODIFY-MACRO.\")))\r\n\t ((memq arg '(&key &allow-other-keys &aux))\r\n\t (error \"~S not allowed in DEFINE-MODIFY-MACRO lambda list.\" arg))\r\n\t ((symbolp arg)\r\n\t (push arg other-args))\r\n\t ((and (listp arg) (symbolp (car arg)))\r\n\t (push (car arg) other-args))\r\n\t (t (error \"Illegal stuff in DEFINE-MODIFY-MACRO lambda list.\"))))\r\n (setq other-args (nreverse other-args))\r\n `(eval-when (:compile-toplevel :load-toplevel :execute)\r\n (defmacro ,name (,reference ,@lambda-list &environment ,env)\r\n ,doc-string\r\n (multiple-value-bind (dummies vals newval setter getter)\r\n (get-setf-expansion ,reference ,env)\r\n (do ((d dummies (cdr d))\r\n (v vals (cdr v))\r\n (let-list nil (cons (list (car d) (car v)) let-list)))\r\n ((null d)\r\n (push (list (car newval)\r\n ,(if rest-arg\r\n `(list* ',function getter ,@other-args ,rest-arg)\r\n `(list ',function getter ,@other-args)))\r\n let-list)\r\n `(let* ,(nreverse let-list)\r\n ,setter))))))))\r\n\r\n".
218*/
219
220/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:1981 **********************/
221:-lisp_compile_to_prolog(pkg_sys,[defmacro,'define-modify-macro',[name,'lambda-list',function,'&optional','doc-string'],'$STRING'("Creates a new read-modify-write macro like PUSH or INCF."),[let,[['other-args',[]],['rest-arg',[]],[env,[gensym]],[reference,[gensym]]],[do,[[ll,'lambda-list',[cdr,ll]],[arg,[]]],[[null,ll]],[setq,arg,[car,ll]],[cond,[[eq,arg,[quote,'&optional']]],[[eq,arg,[quote,'&rest']],[if,[symbolp,[cadr,ll]],[setq,'rest-arg',[cadr,ll]],[error,'$STRING'("Non-symbol &REST arg in definition of ~S."),name]],[if,[null,[cddr,ll]],[return,[]],[error,'$STRING'("Illegal stuff after &REST argument in DEFINE-MODIFY-MACRO.")]]],[[memq,arg,[quote,['&key','&allow-other-keys','&aux']]],[error,'$STRING'("~S not allowed in DEFINE-MODIFY-MACRO lambda list."),arg]],[[symbolp,arg],[push,arg,'other-args']],[[and,[listp,arg],[symbolp,[car,arg]]],[push,[car,arg],'other-args']],[t,[error,'$STRING'("Illegal stuff in DEFINE-MODIFY-MACRO lambda list.")]]]],[setq,'other-args',[nreverse,'other-args']],['#BQ',['eval-when',[':compile-toplevel',':load-toplevel',':execute'],[defmacro,['#COMMA',name],[['#COMMA',reference],['#BQ-COMMA-ELIPSE','lambda-list'],'&environment',['#COMMA',env]],['#COMMA','doc-string'],['multiple-value-bind',[dummies,vals,newval,setter,getter],['get-setf-expansion',['#COMMA',reference],['#COMMA',env]],[do,[[d,dummies,[cdr,d]],[v,vals,[cdr,v]],['let-list',[],[cons,[list,[car,d],[car,v]],'let-list']]],[[null,d],[push,[list,[car,newval],['#COMMA',[if,'rest-arg',['#BQ',['list*',[quote,['#COMMA',function]],getter,['#BQ-COMMA-ELIPSE','other-args'],['#COMMA','rest-arg']]],['#BQ',[list,[quote,['#COMMA',function]],getter,['#BQ-COMMA-ELIPSE','other-args']]]]]],'let-list'],['#BQ',['let*',['#COMMA',[nreverse,'let-list']],['#COMMA',setter]]]]]]]]]]])
222/*
223% macroexpand:-[push,sys_arg,sys_other_args].
224*/
225/*
226% into:-[setq,sys_other_args,[cons,sys_arg,sys_other_args]].
227*/
228/*
229% macroexpand:-[push,[car,sys_arg],sys_other_args].
230*/
231/*
232% into:-[setq,sys_other_args,[cons,[car,sys_arg],sys_other_args]].
233*/
234/*
235% macroexpand:-[push,sys_arg,sys_other_args].
236*/
237/*
238% into:-[setq,sys_other_args,[cons,sys_arg,sys_other_args]].
239*/
240/*
241% macroexpand:-[push,[car,sys_arg],sys_other_args].
242*/
243/*
244% into:-[setq,sys_other_args,[cons,[car,sys_arg],sys_other_args]].
245*/
246/*
247:- side_effect(generate_function_or_macro_name(
248 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
249 name='GLOBAL',
250 environ=env_1
251 ],
252 define_modify_macro,
253 kw_special,
254 sf_define_modify_macro)).
255*/
256doc: doc_string(define_modify_macro,
257 _10326,
258 function,
259 "Creates a new read-modify-write macro like PUSH or INCF.").
260
261wl:lambda_def(defmacro, define_modify_macro, mf_define_modify_type_macro, [sys_name, sys_lambda_list, function, c38_optional, sys_doc_string], [[let, [[sys_other_args, []], [sys_rest_arg, []], [sys_env, [gensym]], [sys_reference, [gensym]]], [do, [[sys_ll, sys_lambda_list, [cdr, sys_ll]], [sys_arg, []]], [[null, sys_ll]], [setq, sys_arg, [car, sys_ll]], [cond, [[eq, sys_arg, [quote, c38_optional]]], [[eq, sys_arg, [quote, c38_rest]], [if, [symbolp, [cadr, sys_ll]], [setq, sys_rest_arg, [cadr, sys_ll]], [error, '$ARRAY'([*], claz_base_character, "Non-symbol &REST arg in definition of ~S."), sys_name]], [if, [null, [cddr, sys_ll]], [return, []], [error, '$ARRAY'([*], claz_base_character, "Illegal stuff after &REST argument in DEFINE-MODIFY-MACRO.")]]], [[sys_memq, sys_arg, [quote, [c38_key, c38_allow_other_keys, c38_aux]]], [error, '$ARRAY'([*], claz_base_character, "~S not allowed in DEFINE-MODIFY-MACRO lambda list."), sys_arg]], [[symbolp, sys_arg], [push, sys_arg, sys_other_args]], [[and, [listp, sys_arg], [symbolp, [car, sys_arg]]], [push, [car, sys_arg], sys_other_args]], [t, [error, '$ARRAY'([*], claz_base_character, "Illegal stuff in DEFINE-MODIFY-MACRO lambda list.")]]]], [setq, sys_other_args, [nreverse, sys_other_args]], ['#BQ', [eval_when, [kw_compile_toplevel, kw_load_toplevel, kw_execute], [defmacro, ['#COMMA', sys_name], [['#COMMA', sys_reference], ['#BQ-COMMA-ELIPSE', sys_lambda_list], c38_environment, ['#COMMA', sys_env]], ['#COMMA', sys_doc_string], [multiple_value_bind, [sys_dummies, sys_vals, sys_newval, sys_setter, sys_getter], [get_setf_expansion, ['#COMMA', sys_reference], ['#COMMA', sys_env]], [do, [[sys_d, sys_dummies, [cdr, sys_d]], [sys_v, sys_vals, [cdr, sys_v]], [sys_let_list, [], [cons, [list, [car, sys_d], [car, sys_v]], sys_let_list]]], [[null, sys_d], [push, [list, [car, sys_newval], ['#COMMA', [if, sys_rest_arg, ['#BQ', [list_xx, [quote, ['#COMMA', function]], sys_getter, ['#BQ-COMMA-ELIPSE', sys_other_args], ['#COMMA', sys_rest_arg]]], ['#BQ', [list, [quote, ['#COMMA', function]], sys_getter, ['#BQ-COMMA-ELIPSE', sys_other_args]]]]]], sys_let_list], ['#BQ', [let_xx, ['#COMMA', [nreverse, sys_let_list]], ['#COMMA', sys_setter]]]]]]]]]]]).
262wl:arglist_info(define_modify_macro, mf_define_modify_type_macro, [sys_name, sys_lambda_list, function, c38_optional, sys_doc_string], arginfo{all:[sys_name, sys_lambda_list, function, sys_doc_string], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_name, sys_lambda_list, function, sys_doc_string], opt:[sys_doc_string], req:[sys_name, sys_lambda_list, function], rest:0, sublists:0, whole:0}).
263wl: init_args(3, mf_define_modify_type_macro).
264
269sf_define_modify_macro(MacroEnv, Name_In, Lambda_list_In, Function_In, RestNKeys, FResult) :-
270 mf_define_modify_type_macro(
271 [ define_modify_macro,
272 Name_In,
273 Lambda_list_In,
274 Function_In
275 | RestNKeys
276 ],
277 MacroEnv,
278 MFResult),
279 f_sys_env_eval(MacroEnv, MFResult, FResult).
284mf_define_modify_type_macro([define_modify_macro, Name_In, Lambda_list_In, Function_In|RestNKeys], MacroEnv, MFResult) :-
285 nop(defmacro),
286 CDR=[bv(sys_name, Name_In), bv(sys_lambda_list, Lambda_list_In), bv(function, Function_In), bv(sys_doc_string, Doc_string_In)],
287 opt_var(MacroEnv, sys_doc_string, Doc_string_In, true, [], 1, RestNKeys),
288 catch(( ( f_gensym(Env_Init),
289 f_gensym(Reference_Init),
290 LEnv=[bv(sys_other_args, []), bv(sys_rest_arg, []), bv(sys_env, Env_Init), bv(sys_reference, Reference_Init)|CDR],
291 get_var(LEnv, sys_lambda_list, Lambda_list_Get),
292 AEnv=[bv(sys_ll, Lambda_list_Get), bv(sys_arg, [])|LEnv],
293 catch(( call_addr_block(AEnv,
294 (push_label(do_label_19), get_var(AEnv, sys_ll, IFTEST86), (IFTEST86==[]->throw(block_exit([], [])), _TBResult=ThrowResult90;get_var(AEnv, sys_ll, Ll_Get93), f_car(Ll_Get93, Arg), set_var(AEnv, sys_arg, Arg), get_var(AEnv, sys_arg, Arg_Get95), (is_eq(Arg_Get95, c38_optional)->_12264=[];get_var(AEnv, sys_arg, Arg_Get99), (is_eq(Arg_Get99, c38_rest)->get_var(AEnv, sys_ll, Ll_Get103), f_cadr(Ll_Get103, PredArgResult105), (is_symbolp(PredArgResult105)->get_var(AEnv, sys_ll, Ll_Get106), f_cadr(Ll_Get106, TrueResult108), set_var(AEnv, sys_rest_arg, TrueResult108), _12480=TrueResult108;get_var(AEnv, sys_name, Name_Get107), f_error(['$ARRAY'([*], claz_base_character, "Non-symbol &REST arg in definition of ~S."), Name_Get107], ElseResult109), _12480=ElseResult109), get_var(AEnv, sys_ll, Ll_Get112), f_cddr(Ll_Get112, IFTEST110), (IFTEST110==[]->throw(block_exit([], [])), TrueResult143=ThrowResult114;f_error(['$ARRAY'([*], claz_base_character, "Illegal stuff after &REST argument in DEFINE-MODIFY-MACRO.")], ElseResult116), TrueResult143=ElseResult116), ElseResult145=TrueResult143;get_var(AEnv, sys_arg, Arg_Get119), f_sys_memq(Arg_Get119, [c38_key, c38_allow_other_keys, c38_aux], IFTEST117), (IFTEST117\==[]->get_var(AEnv, sys_arg, Arg_Get120), f_error(['$ARRAY'([*], claz_base_character, "~S not allowed in DEFINE-MODIFY-MACRO lambda list."), Arg_Get120], TrueResult141), ElseResult144=TrueResult141;get_var(AEnv, sys_arg, Arg_Get122), (is_symbolp(Arg_Get122)->get_var(AEnv, sys_arg, Arg_Get125), get_var(AEnv, sys_other_args, Other_args_Get126), TrueResult139=[Arg_Get125|Other_args_Get126], set_var(AEnv, sys_other_args, TrueResult139), ElseResult142=TrueResult139;get_var(AEnv, sys_arg, Arg_Get130), (s3q:is_listp(Arg_Get130)->get_var(AEnv, sys_arg, Arg_Get133), f_car(Arg_Get133, Symbolp_Param), f_symbolp(Symbolp_Param, TrueResult134), IFTEST127=TrueResult134;IFTEST127=[]), (IFTEST127\==[]->get_var(AEnv, sys_arg, Arg_Get135), f_car(Arg_Get135, Car_Ret), get_var(AEnv, sys_other_args, Other_args_Get136), TrueResult137=[Car_Ret|Other_args_Get136], set_var(AEnv, sys_other_args, TrueResult137), ElseResult140=TrueResult137;f_error(['$ARRAY'([*], claz_base_character, "Illegal stuff in DEFINE-MODIFY-MACRO lambda list.")], ElseResult138), ElseResult140=ElseResult138), ElseResult142=ElseResult140), ElseResult144=ElseResult142), ElseResult145=ElseResult144), _12264=ElseResult145), get_var(AEnv, sys_ll, Ll_Get146), f_cdr(Ll_Get146, Ll), set_var(AEnv, sys_ll, Ll), goto(do_label_19, AEnv), _TBResult=_GORES147)),
295
296 [ addr(addr_tagbody_19_do_label_19,
297 do_label_19,
298 '$unused',
299 AEnv,
300 (get_var(AEnv, sys_ll, IFTEST), (IFTEST==[]->throw(block_exit([], [])), _13726=ThrowResult;get_var(AEnv, sys_ll, Ll_Get27), f_car(Ll_Get27, Car_Ret177), set_var(AEnv, sys_arg, Car_Ret177), get_var(AEnv, sys_arg, Arg_Get), (is_eq(Arg_Get, c38_optional)->_13772=[];get_var(AEnv, sys_arg, Arg_Get33), (is_eq(Arg_Get33, c38_rest)->get_var(AEnv, sys_ll, Ll_Get37), f_cadr(Ll_Get37, Cadr_Ret), (is_symbolp(Cadr_Ret)->get_var(AEnv, sys_ll, Ll_Get40), f_cadr(Ll_Get40, Cadr_Ret179), set_var(AEnv, sys_rest_arg, Cadr_Ret179), _13820=Cadr_Ret179;get_var(AEnv, sys_name, Get_var_Ret), f_error(['$ARRAY'([*], claz_base_character, "Non-symbol &REST arg in definition of ~S."), Get_var_Ret], Error_Ret), _13820=Error_Ret), get_var(AEnv, sys_ll, Ll_Get46), f_cddr(Ll_Get46, IFTEST44), (IFTEST44==[]->throw(block_exit([], [])), TrueResult77=ThrowResult48;f_error(['$ARRAY'([*], claz_base_character, "Illegal stuff after &REST argument in DEFINE-MODIFY-MACRO.")], ElseResult50), TrueResult77=ElseResult50), ElseResult79=TrueResult77;get_var(AEnv, sys_arg, Arg_Get53), f_sys_memq(Arg_Get53, [c38_key, c38_allow_other_keys, c38_aux], IFTEST51), (IFTEST51\==[]->get_var(AEnv, sys_arg, Arg_Get54), f_error(['$ARRAY'([*], claz_base_character, "~S not allowed in DEFINE-MODIFY-MACRO lambda list."), Arg_Get54], TrueResult75), ElseResult78=TrueResult75;get_var(AEnv, sys_arg, Arg_Get56), (is_symbolp(Arg_Get56)->get_var(AEnv, sys_arg, Arg_Get59), get_var(AEnv, sys_other_args, Get_var_Ret182), TrueResult73=[Arg_Get59|Get_var_Ret182], set_var(AEnv, sys_other_args, TrueResult73), ElseResult76=TrueResult73;get_var(AEnv, sys_arg, Arg_Get64), (s3q:is_listp(Arg_Get64)->get_var(AEnv, sys_arg, Arg_Get67), f_car(Arg_Get67, Symbolp_Param174), f_symbolp(Symbolp_Param174, TrueResult68), IFTEST61=TrueResult68;IFTEST61=[]), (IFTEST61\==[]->get_var(AEnv, sys_arg, Arg_Get69), f_car(Arg_Get69, Car_Ret183), get_var(AEnv, sys_other_args, Other_args_Get70), TrueResult71=[Car_Ret183|Other_args_Get70], set_var(AEnv, sys_other_args, TrueResult71), ElseResult74=TrueResult71;f_error(['$ARRAY'([*], claz_base_character, "Illegal stuff in DEFINE-MODIFY-MACRO lambda list.")], ElseResult72), ElseResult74=ElseResult72), ElseResult76=ElseResult74), ElseResult78=ElseResult76), ElseResult79=ElseResult78), _13772=ElseResult79), get_var(AEnv, sys_ll, Ll_Get80), f_cdr(Ll_Get80, Cdr_Ret), set_var(AEnv, sys_ll, Cdr_Ret), goto(do_label_19, AEnv), _13726=_GORES)))
301 ]),
302 []=LetResult15
303 ),
304 block_exit([], LetResult15),
305 true),
306 get_var(LEnv, sys_other_args, Other_args_Get152),
307 f_nreverse(Other_args_Get152, Other_args),
308 set_var(LEnv, sys_other_args, Other_args),
309 get_var(LEnv, sys_lambda_list, Lambda_list_Get155),
310 ( get_var(LEnv, sys_env, Env_Get),
311 get_var(LEnv, sys_name, Name_Get153)
312 ),
313 get_var(LEnv, sys_reference, Reference_Get),
314 bq_append([Reference_Get|Lambda_list_Get155],
315 [c38_environment, Env_Get],
316 Bq_append_Ret),
317 get_var(LEnv, sys_doc_string, Doc_string_Get),
318 get_var(LEnv, sys_env, Env_Get159),
319 get_var(LEnv, sys_reference, Reference_Get158),
320 get_var(LEnv, sys_rest_arg, IFTEST160),
321 ( IFTEST160\==[]
322 -> get_var(LEnv, function, Function_Get),
323 get_var(LEnv, sys_other_args, Other_args_Get164),
324 get_var(LEnv, sys_rest_arg, Rest_arg_Get165),
325 bq_append([sys_getter|Other_args_Get164],
326 [Rest_arg_Get165],
327 Bq_append_Ret186),
328 CAR=[list_xx, [quote, Function_Get]|Bq_append_Ret186]
329 ; get_var(LEnv, function, Function_Get166),
330 get_var(LEnv, sys_other_args, Other_args_Get167),
331 CAR=[list, [quote, Function_Get166], sys_getter|Other_args_Get167]
332 )
333 ),
334 [eval_when, [kw_compile_toplevel, kw_load_toplevel, kw_execute], [defmacro, Name_Get153, Bq_append_Ret, Doc_string_Get, [multiple_value_bind, [sys_dummies, sys_vals, sys_newval, sys_setter, sys_getter], [get_setf_expansion, Reference_Get158, Env_Get159], [do, [[sys_d, sys_dummies, [cdr, sys_d]], [sys_v, sys_vals, [cdr, sys_v]], [sys_let_list, [], [cons, [list, [car, sys_d], [car, sys_v]], sys_let_list]]], [[null, sys_d], [push, [list, [car, sys_newval], CAR], sys_let_list], ['#BQ', [let_xx, ['#COMMA', [nreverse, sys_let_list]], ['#COMMA', sys_setter]]]]]]]]=MFResult
335 ),
336 block_exit(define_modify_macro, MFResult),
337 true).
338:- set_opv(mf_define_modify_type_macro, type_of, sys_macro),
339 set_opv(define_modify_macro, symbol_function, mf_define_modify_type_macro),
340 DefMacroResult=define_modify_macro. 341/*
342:- side_effect(assert_lsp(define_modify_macro,
343 doc_string(define_modify_macro,
344 _10326,
345 function,
346 "Creates a new read-modify-write macro like PUSH or INCF."))).
347*/
348/*
349:- side_effect(assert_lsp(define_modify_macro,
350 lambda_def(defmacro,
351 define_modify_macro,
352 mf_define_modify_type_macro,
353
354 [ sys_name,
355 sys_lambda_list,
356 function,
357 c38_optional,
358 sys_doc_string
359 ],
360
361 [
362 [ let,
363
364 [ [sys_other_args, []],
365 [sys_rest_arg, []],
366 [sys_env, [gensym]],
367 [sys_reference, [gensym]]
368 ],
369
370 [ do,
371
372 [
373 [ sys_ll,
374 sys_lambda_list,
375 [cdr, sys_ll]
376 ],
377 [sys_arg, []]
378 ],
379 [[null, sys_ll]],
380 [setq, sys_arg, [car, sys_ll]],
381
382 [ cond,
383
384 [
385 [ eq,
386 sys_arg,
387 [quote, c38_optional]
388 ]
389 ],
390
391 [ [eq, sys_arg, [quote, c38_rest]],
392
393 [ if,
394 [symbolp, [cadr, sys_ll]],
395
396 [ setq,
397 sys_rest_arg,
398 [cadr, sys_ll]
399 ],
400
401 [ error,
402 '$ARRAY'([*],
403 claz_base_character,
404 "Non-symbol &REST arg in definition of ~S."),
405 sys_name
406 ]
407 ],
408
409 [ if,
410 [null, [cddr, sys_ll]],
411 [return, []],
412
413 [ error,
414 '$ARRAY'([*],
415 claz_base_character,
416 "Illegal stuff after &REST argument in DEFINE-MODIFY-MACRO.")
417 ]
418 ]
419 ],
420
421 [
422 [ sys_memq,
423 sys_arg,
424
425 [ quote,
426
427 [ c38_key,
428 c38_allow_other_keys,
429 c38_aux
430 ]
431 ]
432 ],
433
434 [ error,
435 '$ARRAY'([*],
436 claz_base_character,
437 "~S not allowed in DEFINE-MODIFY-MACRO lambda list."),
438 sys_arg
439 ]
440 ],
441
442 [ [symbolp, sys_arg],
443 [push, sys_arg, sys_other_args]
444 ],
445
446 [
447 [ and,
448 [listp, sys_arg],
449 [symbolp, [car, sys_arg]]
450 ],
451
452 [ push,
453 [car, sys_arg],
454 sys_other_args
455 ]
456 ],
457
458 [ t,
459
460 [ error,
461 '$ARRAY'([*],
462 claz_base_character,
463 "Illegal stuff in DEFINE-MODIFY-MACRO lambda list.")
464 ]
465 ]
466 ]
467 ],
468
469 [ setq,
470 sys_other_args,
471 [nreverse, sys_other_args]
472 ],
473
474 [ '#BQ',
475
476 [ eval_when,
477
478 [ kw_compile_toplevel,
479 kw_load_toplevel,
480 kw_execute
481 ],
482
483 [ defmacro,
484 ['#COMMA', sys_name],
485
486 [ ['#COMMA', sys_reference],
487
488 [ '#BQ-COMMA-ELIPSE',
489 sys_lambda_list
490 ],
491 c38_environment,
492 ['#COMMA', sys_env]
493 ],
494 ['#COMMA', sys_doc_string],
495
496 [ multiple_value_bind,
497
498 [ sys_dummies,
499 sys_vals,
500 sys_newval,
501 sys_setter,
502 sys_getter
503 ],
504
505 [ get_setf_expansion,
506 ['#COMMA', sys_reference],
507 ['#COMMA', sys_env]
508 ],
509
510 [ do,
511
512 [
513 [ sys_d,
514 sys_dummies,
515 [cdr, sys_d]
516 ],
517
518 [ sys_v,
519 sys_vals,
520 [cdr, sys_v]
521 ],
522
523 [ sys_let_list,
524 [],
525
526 [ cons,
527
528 [ list,
529 [car, sys_d],
530 [car, sys_v]
531 ],
532 sys_let_list
533 ]
534 ]
535 ],
536
537 [ [null, sys_d],
538
539 [ push,
540
541 [ list,
542 [car, sys_newval],
543
544 [ '#COMMA',
545
546 [ if,
547 sys_rest_arg,
548
549 [ '#BQ',
550
551 [ list_xx,
552
553 [ quote,
554 ['#COMMA', function]
555 ],
556 sys_getter,
557
558 [ '#BQ-COMMA-ELIPSE',
559 sys_other_args
560 ],
561
562 [ '#COMMA',
563 sys_rest_arg
564 ]
565 ]
566 ],
567
568 [ '#BQ',
569
570 [ list,
571
572 [ quote,
573 ['#COMMA', function]
574 ],
575 sys_getter,
576
577 [ '#BQ-COMMA-ELIPSE',
578 sys_other_args
579 ]
580 ]
581 ]
582 ]
583 ]
584 ],
585 sys_let_list
586 ],
587
588 [ '#BQ',
589
590 [ let_xx,
591
592 [ '#COMMA',
593
594 [ nreverse,
595 sys_let_list
596 ]
597 ],
598 ['#COMMA', sys_setter]
599 ]
600 ]
601 ]
602 ]
603 ]
604 ]
605 ]
606 ]
607 ]
608 ]))).
609*/
610/*
611:- side_effect(assert_lsp(define_modify_macro,
612 arglist_info(define_modify_macro,
613 mf_define_modify_type_macro,
614
615 [ sys_name,
616 sys_lambda_list,
617 function,
618 c38_optional,
619 sys_doc_string
620 ],
621 arginfo{ all:
622 [ sys_name,
623 sys_lambda_list,
624 function,
625 sys_doc_string
626 ],
627 allow_other_keys:0,
628 aux:0,
629 body:0,
630 complex:0,
631 env:0,
632 key:0,
633 names:
634 [ sys_name,
635 sys_lambda_list,
636 function,
637 sys_doc_string
638 ],
639 opt:[sys_doc_string],
640 req:
641 [ sys_name,
642 sys_lambda_list,
643 function
644 ],
645 rest:0,
646 sublists:0,
647 whole:0
648 }))).
649*/
650/*
651:- side_effect(assert_lsp(define_modify_macro,
652 init_args(3, mf_define_modify_type_macro))).
653*/
654/*
655; Parse out the variable names and &REST arg from the lambda list.
656*/
657/*
658#+ALT #+ABCL
659(define-modify-macro incf-complex (&optional (delta 1)) +
660 "The first argument is some location holding a number. This number is
661 incremented by the second argument, DELTA, which defaults to 1.")
662
663*/
664
665/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:3856 **********************/
666:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':ALT'],[#+,':ABCL',['define-modify-macro','incf-complex',['&optional',[delta,1]],+,'$STRING'("The first argument is some location holding a number. This number is\r\n incremented by the second argument, DELTA, which defaults to 1.")]]]))
667/*
668#+ALT #+ABCL
669(define-modify-macro decf-complex (&optional (delta 1)) -
670 "The first argument is some location holding a number. This number is
671 decremented by the second argument, DELTA, which defaults to 1.")
672
673*/
674
675/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:4075 **********************/
676:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':ALT'],[#+,':ABCL',['define-modify-macro','decf-complex',['&optional',[delta,1]],-,'$STRING'("The first argument is some location holding a number. This number is\r\n decremented by the second argument, DELTA, which defaults to 1.")]]]))
677/*
678#+ALT #+ABCL
679(defmacro incf (place &optional (delta 1))
680 (cond ((symbolp place)
681 (cond ((constantp delta)
682 `(setq ,place (+ ,place ,delta)))
683 (t
684 ;; See section 5.1.3.
685 (let ((temp (gensym)))
686 `(let ((,temp ,delta))
687 (setq ,place (+ ,place ,temp)))))))
688 ((and (consp place) (eq (car place) 'THE))
689 (let ((res (gensym)))
690 `(let ((,res (the ,(second place) (+ ,place ,delta))))
691 (setf ,(third place) ,res))))
692 (t
693 `(incf-complex ,place ,delta))))
694
695*/
696
697/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:4294 **********************/
698:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':ALT'],[#+,':ABCL',[defmacro,incf,[place,'&optional',[delta,1]],[cond,[[symbolp,place],[cond,[[constantp,delta],['#BQ',[setq,['#COMMA',place],[+,['#COMMA',place],['#COMMA',delta]]]]],[t,[let,[[temp,[gensym]]],['#BQ',[let,[[['#COMMA',temp],['#COMMA',delta]]],[setq,['#COMMA',place],[+,['#COMMA',place],['#COMMA',temp]]]]]]]]],[[and,[consp,place],[eq,[car,place],[quote,'THE']]],[let,[[res,[gensym]]],['#BQ',[let,[[['#COMMA',res],[the,['#COMMA',[second,place]],[+,['#COMMA',place],['#COMMA',delta]]]]],[setf,['#COMMA',[third,place]],['#COMMA',res]]]]]],[t,['#BQ',['incf-complex',['#COMMA',place],['#COMMA',delta]]]]]]]]))
699/*
700; See section 5.1.3.
701*/
702/*
703#+(or WAM-CL LISP500)
704(defmacro nth-value (n form)
705 `(nth ,n (multiple-value-list ,form)))
706
707*/
708
709/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:4915 **********************/
710:-lisp_compile_to_prolog(pkg_sys,[defmacro,'nth-value',[n,form],['#BQ',[nth,['#COMMA',n],['multiple-value-list',['#COMMA',form]]]]])
711/*
712:- side_effect(generate_function_or_macro_name(
713 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
714 name='GLOBAL',
715 environ=env_1
716 ],
717 nth_value,
718 kw_special,
719 sf_nth_value)).
720*/
721wl:lambda_def(defmacro, nth_value, mf_nth_value, [sys_n, sys_form], [['#BQ', [nth, ['#COMMA', sys_n], [multiple_value_list, ['#COMMA', sys_form]]]]]).
722wl:arglist_info(nth_value, mf_nth_value, [sys_n, sys_form], arginfo{all:[sys_n, sys_form], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_n, sys_form], opt:0, req:[sys_n, sys_form], rest:0, sublists:0, whole:0}).
723wl: init_args(2, mf_nth_value).
724
729sf_nth_value(MacroEnv, N_In, Form_In, RestNKeys, FResult) :-
730 mf_nth_value([nth_value, N_In, Form_In|RestNKeys], MacroEnv, MFResult),
731 f_sys_env_eval(MacroEnv, MFResult, FResult).
736mf_nth_value([nth_value, N_In, Form_In|RestNKeys], MacroEnv, MFResult) :-
737 nop(defmacro),
738 GEnv=[bv(sys_n, N_In), bv(sys_form, Form_In)],
739 catch(( ( get_var(GEnv, sys_form, Form_Get),
740 get_var(GEnv, sys_n, N_Get)
741 ),
742 [nth, N_Get, [multiple_value_list, Form_Get]]=MFResult
743 ),
744 block_exit(nth_value, MFResult),
745 true).
746:- set_opv(mf_nth_value, type_of, sys_macro),
747 set_opv(nth_value, symbol_function, mf_nth_value),
748 DefMacroResult=nth_value. 749/*
750:- side_effect(assert_lsp(nth_value,
751 lambda_def(defmacro,
752 nth_value,
753 mf_nth_value,
754 [sys_n, sys_form],
755
756 [
757 [ '#BQ',
758
759 [ nth,
760 ['#COMMA', sys_n],
761
762 [ multiple_value_list,
763 ['#COMMA', sys_form]
764 ]
765 ]
766 ]
767 ]))).
768*/
769/*
770:- side_effect(assert_lsp(nth_value,
771 arglist_info(nth_value,
772 mf_nth_value,
773 [sys_n, sys_form],
774 arginfo{ all:[sys_n, sys_form],
775 allow_other_keys:0,
776 aux:0,
777 body:0,
778 complex:0,
779 env:0,
780 key:0,
781 names:[sys_n, sys_form],
782 opt:0,
783 req:[sys_n, sys_form],
784 rest:0,
785 sublists:0,
786 whole:0
787 }))).
788*/
789/*
790:- side_effect(assert_lsp(nth_value, init_args(2, mf_nth_value))).
791*/
792/*
793#+WAM-CL
794(defmacro incf (place &optional (delta 1) &environment env)
795 "The first argument is some location holding a number. This number is
796incremented by the second argument, DELTA, which defaults to 1."
797 (if (and (symbolp (setq place (%symbol-macroexpand place env)))
798 (or (constantp delta)
799 (and (symbolp delta)
800 (not (nth-value 1 (%symbol-macroexpand delta env))))))
801 `(setq ,place (+ ,place ,delta))
802 (multiple-value-bind (dummies vals newval setter getter)
803 (get-setf-method place env)
804 (let ((d (gensym)))
805 `(let* (,@(mapcar #'list dummies vals)
806 (,d ,delta)
807 (,(car newval) (+ ,getter ,d)))
808 ,setter)))))
809
810
811*/
812
813/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:5012 **********************/
814:-lisp_compile_to_prolog(pkg_sys,[defmacro,incf,[place,'&optional',[delta,1],'&environment',env],'$STRING'("The first argument is some location holding a number. This number is\r\nincremented by the second argument, DELTA, which defaults to 1."),[if,[and,[symbolp,[setq,place,['%symbol-macroexpand',place,env]]],[or,[constantp,delta],[and,[symbolp,delta],[not,['nth-value',1,['%symbol-macroexpand',delta,env]]]]]],['#BQ',[setq,['#COMMA',place],[+,['#COMMA',place],['#COMMA',delta]]]],['multiple-value-bind',[dummies,vals,newval,setter,getter],['get-setf-method',place,env],[let,[[d,[gensym]]],['#BQ',['let*',[['#BQ-COMMA-ELIPSE',[mapcar,function(list),dummies,vals]],[['#COMMA',d],['#COMMA',delta]],[['#COMMA',[car,newval]],[+,['#COMMA',getter],['#COMMA',d]]]],['#COMMA',setter]]]]]]])
815/*
816% macroexpand:-[nth_value,1,[sys_pf_symbol_macroexpand,sys_delta,sys_env]].
817*/
818/*
819% into:-[nth,1,[multiple_value_list,[sys_pf_symbol_macroexpand,sys_delta,sys_env]]].
820*/
821/*
822:- side_effect(generate_function_or_macro_name(
823 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
824 name='GLOBAL',
825 environ=env_1
826 ],
827 incf,
828 kw_special,
829 sf_incf)).
830*/
831doc: doc_string(incf,
832 _8028,
833 function,
834 "The first argument is some location holding a number. This number is\r\nincremented by the second argument, DELTA, which defaults to 1.").
835
836wl:lambda_def(defmacro, incf, mf_incf, [sys_place, c38_optional, [sys_delta, 1], c38_environment, sys_env], [[if, [and, [symbolp, [setq, sys_place, [sys_pf_symbol_macroexpand, sys_place, sys_env]]], [or, [constantp, sys_delta], [and, [symbolp, sys_delta], [not, [nth_value, 1, [sys_pf_symbol_macroexpand, sys_delta, sys_env]]]]]], ['#BQ', [setq, ['#COMMA', sys_place], [+, ['#COMMA', sys_place], ['#COMMA', sys_delta]]]], [multiple_value_bind, [sys_dummies, sys_vals, sys_newval, sys_setter, sys_getter], [sys_get_setf_method, sys_place, sys_env], [let, [[sys_d, [gensym]]], ['#BQ', [let_xx, [['#BQ-COMMA-ELIPSE', [mapcar, function(list), sys_dummies, sys_vals]], [['#COMMA', sys_d], ['#COMMA', sys_delta]], [['#COMMA', [car, sys_newval]], [+, ['#COMMA', sys_getter], ['#COMMA', sys_d]]]], ['#COMMA', sys_setter]]]]]]]).
837wl:arglist_info(incf, mf_incf, [sys_place, c38_optional, [sys_delta, 1], c38_environment, sys_env], arginfo{all:[sys_place, sys_delta], allow_other_keys:0, aux:0, body:0, complex:[environment], env:[sys_env], key:0, names:[sys_place, sys_delta, sys_env], opt:[sys_delta], req:[sys_place], rest:0, sublists:0, whole:0}).
838wl: init_args(1, mf_incf).
839
844sf_incf(Env_In, Place_In, RestNKeys, FResult) :-
845 mf_incf([incf, Place_In|RestNKeys], Env_In, MFResult),
846 f_sys_env_eval(Env_In, MFResult, FResult).
851mf_incf([incf, Place_In|RestNKeys], Env_In, MFResult) :-
852 nop(defmacro),
853 AEnv=[bv(sys_place, Place_In), bv(sys_delta, Delta_In), bv(sys_env, Env_In)],
854 opt_var(Env_In, sys_delta, Delta_In, true, 1, 1, RestNKeys),
855 catch(( ( get_var(AEnv, sys_env, Env_Get),
856 get_var(AEnv, sys_place, Place_Get),
857 f_sys_pf_symbol_macroexpand(Place_Get, Env_Get, PredArgResult),
858 set_var(AEnv, sys_place, PredArgResult),
859 ( is_symbolp(PredArgResult)
860 -> ( get_var(AEnv, sys_delta, Delta_Get),
861 f_constantp(Delta_Get, FORM1_Res),
862 FORM1_Res\==[],
863 TrueResult27=FORM1_Res
864 -> true
865 ; get_var(AEnv, sys_delta, Delta_Get18),
866 ( is_symbolp(Delta_Get18)
867 -> get_var(AEnv, sys_delta, Delta_Get23),
868 get_var(AEnv, sys_env, Env_Get24),
869 f_sys_pf_symbol_macroexpand(Delta_Get23,
870 Env_Get24,
871 IgnoredRet),
872 nb_current('$mv_return', MV_RETURN),
873 f_nth(1, MV_RETURN, Not_Param),
874 f_not(Not_Param, TrueResult),
875 _8274=TrueResult
876 ; _8274=[]
877 ),
878 TrueResult27=_8274
879 ),
880 IFTEST=TrueResult27
881 ; IFTEST=[]
882 ),
883 ( IFTEST\==[]
884 -> get_var(AEnv, sys_delta, Delta_Get30),
885 get_var(AEnv, sys_place, Place_Get28),
886 _8112=[setq, Place_Get28, [+, Place_Get28, Delta_Get30]]
887 ; LEnv=[bv(sys_dummies, []), bv(sys_vals, []), bv(sys_newval, []), bv(sys_setter, []), bv(sys_getter, [])|AEnv],
888 get_var(LEnv, sys_env, Env_Get35),
889 get_var(LEnv, sys_place, Place_Get34),
890 f_sys_get_setf_method(Place_Get34,
891 Env_Get35,
892 Setf_method_Ret),
893 setq_from_values(LEnv,
894
895 [ sys_dummies,
896 sys_vals,
897 sys_newval,
898 sys_setter,
899 sys_getter
900 ]),
901 f_gensym(D_Init),
902 LEnv38=[bv(sys_d, D_Init)|LEnv],
903 get_var(LEnv38, sys_dummies, Dummies_Get),
904 get_var(LEnv38, sys_vals, Vals_Get),
905 f_mapcar(f_list, [Dummies_Get, Vals_Get], Bq_append_Param),
906 get_var(LEnv38, sys_d, D_Get),
907 get_var(LEnv38, sys_delta, Delta_Get43),
908 get_var(LEnv38, sys_newval, Newval_Get),
909 f_car(Newval_Get, Car_Ret),
910 get_var(LEnv38, sys_d, D_Get46),
911 get_var(LEnv38, sys_getter, Getter_Get),
912 bq_append(Bq_append_Param,
913
914 [ [D_Get, Delta_Get43],
915 [Car_Ret, [+, Getter_Get, D_Get46]]
916 ],
917 Bq_append_Ret),
918 get_var(LEnv38, sys_setter, Setter_Get),
919 _8112=[let_xx, Bq_append_Ret, Setter_Get]
920 )
921 ),
922 _8112=MFResult
923 ),
924 block_exit(incf, MFResult),
925 true).
926:- set_opv(mf_incf, type_of, sys_macro),
927 set_opv(incf, symbol_function, mf_incf),
928 DefMacroResult=incf. 929/*
930:- side_effect(assert_lsp(incf,
931 doc_string(incf,
932 _8028,
933 function,
934 "The first argument is some location holding a number. This number is\r\nincremented by the second argument, DELTA, which defaults to 1."))).
935*/
936/*
937:- side_effect(assert_lsp(incf,
938 lambda_def(defmacro,
939 incf,
940 mf_incf,
941
942 [ sys_place,
943 c38_optional,
944 [sys_delta, 1],
945 c38_environment,
946 sys_env
947 ],
948
949 [
950 [ if,
951
952 [ and,
953
954 [ symbolp,
955
956 [ setq,
957 sys_place,
958
959 [ sys_pf_symbol_macroexpand,
960 sys_place,
961 sys_env
962 ]
963 ]
964 ],
965
966 [ or,
967 [constantp, sys_delta],
968
969 [ and,
970 [symbolp, sys_delta],
971
972 [ not,
973
974 [ nth_value,
975 1,
976
977 [ sys_pf_symbol_macroexpand,
978 sys_delta,
979 sys_env
980 ]
981 ]
982 ]
983 ]
984 ]
985 ],
986
987 [ '#BQ',
988
989 [ setq,
990 ['#COMMA', sys_place],
991
992 [ (+),
993 ['#COMMA', sys_place],
994 ['#COMMA', sys_delta]
995 ]
996 ]
997 ],
998
999 [ multiple_value_bind,
1000
1001 [ sys_dummies,
1002 sys_vals,
1003 sys_newval,
1004 sys_setter,
1005 sys_getter
1006 ],
1007
1008 [ sys_get_setf_method,
1009 sys_place,
1010 sys_env
1011 ],
1012
1013 [ let,
1014 [[sys_d, [gensym]]],
1015
1016 [ '#BQ',
1017
1018 [ let_xx,
1019
1020 [
1021 [ '#BQ-COMMA-ELIPSE',
1022
1023 [ mapcar,
1024 function(list),
1025 sys_dummies,
1026 sys_vals
1027 ]
1028 ],
1029
1030 [ ['#COMMA', sys_d],
1031 ['#COMMA', sys_delta]
1032 ],
1033
1034 [
1035 [ '#COMMA',
1036 [car, sys_newval]
1037 ],
1038
1039 [ (+),
1040 ['#COMMA', sys_getter],
1041 ['#COMMA', sys_d]
1042 ]
1043 ]
1044 ],
1045 ['#COMMA', sys_setter]
1046 ]
1047 ]
1048 ]
1049 ]
1050 ]
1051 ]))).
1052*/
1053/*
1054:- side_effect(assert_lsp(incf,
1055 arglist_info(incf,
1056 mf_incf,
1057
1058 [ sys_place,
1059 c38_optional,
1060 [sys_delta, 1],
1061 c38_environment,
1062 sys_env
1063 ],
1064 arginfo{ all:[sys_place, sys_delta],
1065 allow_other_keys:0,
1066 aux:0,
1067 body:0,
1068 complex:[environment],
1069 env:[sys_env],
1070 key:0,
1071 names:
1072 [ sys_place,
1073 sys_delta,
1074 sys_env
1075 ],
1076 opt:[sys_delta],
1077 req:[sys_place],
1078 rest:0,
1079 sublists:0,
1080 whole:0
1081 }))).
1082*/
1083/*
1084:- side_effect(assert_lsp(incf, init_args(1, mf_incf))).
1085*/
1086/*
1087#+WAM-CL
1088(defmacro decf (place &optional (delta 1))
1089 `(incf ,place (- 0 ,delta)))
1090
1091*/
1092
1093/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:5756 **********************/
1094:-lisp_compile_to_prolog(pkg_sys,[defmacro,decf,[place,'&optional',[delta,1]],['#BQ',[incf,['#COMMA',place],[-,0,['#COMMA',delta]]]]])
1095/*
1096:- side_effect(generate_function_or_macro_name(
1097 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
1098 name='GLOBAL',
1099 environ=env_1
1100 ],
1101 decf,
1102 kw_special,
1103 sf_decf)).
1104*/
1105wl:lambda_def(defmacro, decf, mf_decf, [sys_place, c38_optional, [sys_delta, 1]], [['#BQ', [incf, ['#COMMA', sys_place], [-, 0, ['#COMMA', sys_delta]]]]]).
1106wl:arglist_info(decf, mf_decf, [sys_place, c38_optional, [sys_delta, 1]], arginfo{all:[sys_place, sys_delta], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_place, sys_delta], opt:[sys_delta], req:[sys_place], rest:0, sublists:0, whole:0}).
1107wl: init_args(1, mf_decf).
1108
1113sf_decf(MacroEnv, Place_In, RestNKeys, FResult) :-
1114 mf_decf([decf, Place_In|RestNKeys], MacroEnv, MFResult),
1115 f_sys_env_eval(MacroEnv, MFResult, FResult).
1120mf_decf([decf, Place_In|RestNKeys], MacroEnv, MFResult) :-
1121 nop(defmacro),
1122 GEnv=[bv(sys_place, Place_In), bv(sys_delta, Delta_In)],
1123 opt_var(MacroEnv, sys_delta, Delta_In, true, 1, 1, RestNKeys),
1124 catch(( ( get_var(GEnv, sys_delta, Delta_Get),
1125 get_var(GEnv, sys_place, Place_Get)
1126 ),
1127 [incf, Place_Get, [-, 0, Delta_Get]]=MFResult
1128 ),
1129 block_exit(decf, MFResult),
1130 true).
1131:- set_opv(mf_decf, type_of, sys_macro),
1132 set_opv(decf, symbol_function, mf_decf),
1133 DefMacroResult=decf. 1134/*
1135:- side_effect(assert_lsp(decf,
1136 lambda_def(defmacro,
1137 decf,
1138 mf_decf,
1139 [sys_place, c38_optional, [sys_delta, 1]],
1140
1141 [
1142 [ '#BQ',
1143
1144 [ incf,
1145 ['#COMMA', sys_place],
1146 [-, 0, ['#COMMA', sys_delta]]
1147 ]
1148 ]
1149 ]))).
1150*/
1151/*
1152:- side_effect(assert_lsp(decf,
1153 arglist_info(decf,
1154 mf_decf,
1155 [sys_place, c38_optional, [sys_delta, 1]],
1156 arginfo{ all:[sys_place, sys_delta],
1157 allow_other_keys:0,
1158 aux:0,
1159 body:0,
1160 complex:0,
1161 env:0,
1162 key:0,
1163 names:[sys_place, sys_delta],
1164 opt:[sys_delta],
1165 req:[sys_place],
1166 rest:0,
1167 sublists:0,
1168 whole:0
1169 }))).
1170*/
1171/*
1172:- side_effect(assert_lsp(decf, init_args(1, mf_decf))).
1173*/
1174/*
1175#+ALT #+ABCL
1176(defmacro decf (place &optional (delta 1))
1177 (cond ((symbolp place)
1178 (cond ((constantp delta)
1179 `(setq ,place (- ,place ,delta)))
1180 (t
1181 ;; See section 5.1.3.
1182 (let ((temp (gensym)))
1183 `(let ((,temp ,delta))
1184 (setq ,place (- ,place ,temp)))))))
1185 ((and (consp place) (eq (car place) 'THE))
1186 (let ((res (gensym)))
1187 `(let ((,res (the ,(second place) (- ,place ,delta))))
1188 (setf ,(third place) ,res))))
1189 (t
1190 `(decf-complex ,place ,delta))))
1191
1192;;; setf.lisp
1193;;;
1194;;; Copyright (C) 2003-2006 Peter Graves
1195;;; $Id$
1196;;;
1197;;; This program is free software; you can redistribute it and/or
1198;;; modify it under the terms of the GNU General Public License
1199;;; as published by the Free Software Foundation; either version 2
1200;;; of the License, or (at your option) any later version.
1201;;;
1202;;; This program is distributed in the hope that it will be useful,
1203;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1204;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1205;;; GNU General Public License for more details.
1206;;;
1207;;; You should have received a copy of the GNU General Public License
1208;;; along with this program; if not, write to the Free Software
1209;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1210;;;
1211;;; As a special exception, the copyright holders of this library give you
1212;;; permission to link this library with independent modules to produce an
1213;;; executable, regardless of the license terms of these independent
1214;;; modules, and to copy and distribute the resulting executable under
1215;;; terms of your choice, provided that you also meet, for each linked
1216;;; independent module, the terms and conditions of the license of that
1217;;; module. An independent module is a module which is not derived from
1218;;; or based on this library. If you modify this library, you may extend
1219;;; this exception to your version of the library, but you are not
1220;;; obligated to do so. If you do not wish to do so, delete this
1221;;; exception statement from your version.
1222
1223*/
1224
1225/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:5844 **********************/
1226:-lisp_compile_to_prolog(pkg_sys,'$COMMENT'([flag_removed,[+,':ALT'],[#+,':ABCL',[defmacro,decf,[place,'&optional',[delta,1]],[cond,[[symbolp,place],[cond,[[constantp,delta],['#BQ',[setq,['#COMMA',place],[-,['#COMMA',place],['#COMMA',delta]]]]],[t,[let,[[temp,[gensym]]],['#BQ',[let,[[['#COMMA',temp],['#COMMA',delta]]],[setq,['#COMMA',place],[-,['#COMMA',place],['#COMMA',temp]]]]]]]]],[[and,[consp,place],[eq,[car,place],[quote,'THE']]],[let,[[res,[gensym]]],['#BQ',[let,[[['#COMMA',res],[the,['#COMMA',[second,place]],[-,['#COMMA',place],['#COMMA',delta]]]]],[setf,['#COMMA',[third,place]],['#COMMA',res]]]]]],[t,['#BQ',['decf-complex',['#COMMA',place],['#COMMA',delta]]]]]]]]))
1227/*
1228; See section 5.1.3.
1229*/
1230/*
1231;; setf.lisp
1232*/
1233/*
1234;;
1235*/
1236/*
1237;; Copyright (C) 2003-2006 Peter Graves
1238*/
1239/*
1240;; $Id$
1241*/
1242/*
1243;;
1244*/
1245/*
1246;; This program is free software; you can redistribute it and/or
1247*/
1248/*
1249;; modify it under the terms of the GNU General Public License
1250*/
1251/*
1252;; as published by the Free Software Foundation; either version 2
1253*/
1254/*
1255;; of the License, or (at your option) any later version.
1256*/
1257/*
1258;;
1259*/
1260/*
1261;; This program is distributed in the hope that it will be useful,
1262*/
1263/*
1264;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1265*/
1266/*
1267;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1268*/
1269/*
1270;; GNU General Public License for more details.
1271*/
1272/*
1273;;
1274*/
1275/*
1276;; You should have received a copy of the GNU General Public License
1277*/
1278/*
1279;; along with this program; if not, write to the Free Software
1280*/
1281/*
1282;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1283*/
1284/*
1285;;
1286*/
1287/*
1288;; As a special exception, the copyright holders of this library give you
1289*/
1290/*
1291;; permission to link this library with independent modules to produce an
1292*/
1293/*
1294;; executable, regardless of the license terms of these independent
1295*/
1296/*
1297;; modules, and to copy and distribute the resulting executable under
1298*/
1299/*
1300;; terms of your choice, provided that you also meet, for each linked
1301*/
1302/*
1303;; independent module, the terms and conditions of the license of that
1304*/
1305/*
1306;; module. An independent module is a module which is not derived from
1307*/
1308/*
1309;; or based on this library. If you modify this library, you may extend
1310*/
1311/*
1312;; this exception to your version of the library, but you are not
1313*/
1314/*
1315;; obligated to do so. If you do not wish to do so, delete this
1316*/
1317/*
1318;; exception statement from your version.
1319*/
1320/*
1321(in-package "SYSTEM")
1322
1323*/
1324
1325/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:8057 **********************/
1326:-lisp_compile_to_prolog(pkg_sys,['in-package','$STRING'("SYSTEM")])
1327/*
1328% macroexpand:-[in_package,'$ARRAY'([*],claz_base_character,"SYSTEM")].
1329*/
1330/*
1331% into:-[eval_when,[kw_compile_toplevel,kw_load_toplevel,kw_execute],[sys_select_package,'$ARRAY'([*],claz_base_character,"SYSTEM")]].
1332*/
1333:- do_when([kw_compile_toplevel, kw_load_toplevel, kw_execute],
1334 f_sys_select_package('$ARRAY'([*], claz_base_character, "SYSTEM"),
1335 _Ignored),
1336 _Ignored).
1337/*
1338#+(or ABCL WAM-CL)
1339(defun get-setf-method-inverse (form inverse setf-function)
1340 (let ((new-var (gensym))
1341 (vars nil)
1342 (vals nil))
1343 (dolist (x (cdr form))
1344 (push (gensym) vars)
1345 (push x vals))
1346 (setq vals (nreverse vals))
1347 (values vars vals (list new-var)
1348 (if setf-function
1349 `(,@inverse ,new-var ,@vars)
1350 (if (functionp (car inverse))
1351 `(funcall ,@inverse ,@vars ,new-var)
1352 `(,@inverse ,@vars ,new-var)))
1353 `(,(car form) ,@vars))))
1354
1355;;; If a macro, expand one level and try again. If not, go for the
1356;;; SETF function.
1357*/
1358
1359/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:8082 **********************/
1360:-lisp_compile_to_prolog(pkg_sys,[defun,'get-setf-method-inverse',[form,inverse,'setf-function'],[let,[['new-var',[gensym]],[vars,[]],[vals,[]]],[dolist,[x,[cdr,form]],[push,[gensym],vars],[push,x,vals]],[setq,vals,[nreverse,vals]],[values,vars,vals,[list,'new-var'],[if,'setf-function',['#BQ',[['#BQ-COMMA-ELIPSE',inverse],['#COMMA','new-var'],['#BQ-COMMA-ELIPSE',vars]]],[if,[functionp,[car,inverse]],['#BQ',[funcall,['#BQ-COMMA-ELIPSE',inverse],['#BQ-COMMA-ELIPSE',vars],['#COMMA','new-var']]],['#BQ',[['#BQ-COMMA-ELIPSE',inverse],['#BQ-COMMA-ELIPSE',vars],['#COMMA','new-var']]]]],['#BQ',[['#COMMA',[car,form]],['#BQ-COMMA-ELIPSE',vars]]]]]])
1361/*
1362% macroexpand:-[push,[gensym],sys_vars].
1363*/
1364/*
1365% into:-[setq,sys_vars,[cons,[gensym],sys_vars]].
1366*/
1367/*
1368% macroexpand:-[push,sys_x,sys_vals].
1369*/
1370/*
1371% into:-[setq,sys_vals,[cons,sys_x,sys_vals]].
1372*/
1373wl:lambda_def(defun, sys_get_setf_method_inverse, f_sys_get_setf_method_inverse, [sys_form, sys_inverse, sys_setf_function], [[let, [[sys_new_var, [gensym]], [sys_vars, []], [sys_vals, []]], [dolist, [sys_x, [cdr, sys_form]], [push, [gensym], sys_vars], [push, sys_x, sys_vals]], [setq, sys_vals, [nreverse, sys_vals]], [values, sys_vars, sys_vals, [list, sys_new_var], [if, sys_setf_function, ['#BQ', [['#BQ-COMMA-ELIPSE', sys_inverse], ['#COMMA', sys_new_var], ['#BQ-COMMA-ELIPSE', sys_vars]]], [if, [functionp, [car, sys_inverse]], ['#BQ', [funcall, ['#BQ-COMMA-ELIPSE', sys_inverse], ['#BQ-COMMA-ELIPSE', sys_vars], ['#COMMA', sys_new_var]]], ['#BQ', [['#BQ-COMMA-ELIPSE', sys_inverse], ['#BQ-COMMA-ELIPSE', sys_vars], ['#COMMA', sys_new_var]]]]], ['#BQ', [['#COMMA', [car, sys_form]], ['#BQ-COMMA-ELIPSE', sys_vars]]]]]]).
1374wl:arglist_info(sys_get_setf_method_inverse, f_sys_get_setf_method_inverse, [sys_form, sys_inverse, sys_setf_function], arginfo{all:[sys_form, sys_inverse, sys_setf_function], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_form, sys_inverse, sys_setf_function], opt:0, req:[sys_form, sys_inverse, sys_setf_function], rest:0, sublists:0, whole:0}).
1375wl: init_args(x, f_sys_get_setf_method_inverse).
1376
1381f_sys_get_setf_method_inverse(Form_In, Inverse_In, Setf_function_In, FnResult) :-
1382 CDR=[bv(sys_form, Form_In), bv(sys_inverse, Inverse_In), bv(sys_setf_function, Setf_function_In)],
1383 catch(( ( f_gensym(New_var_Init),
1384 LEnv=[bv(sys_new_var, New_var_Init), bv(sys_vars, []), bv(sys_vals, [])|CDR],
1385 get_var(LEnv, sys_form, Form_Get),
1386 f_cdr(Form_Get, List),
1387 BV=bv(sys_x, Ele),
1388 AEnv=[BV|LEnv],
1389 forall(member(Ele, List),
1390 ( nb_setarg(2, BV, Ele),
1391 f_gensym(Gensym_Ret),
1392 get_var(AEnv, sys_vars, Vars_Get),
1393 Vars=[Gensym_Ret|Vars_Get],
1394 set_var(AEnv, sys_vars, Vars),
1395 get_var(AEnv, sys_vals, Vals_Get),
1396 get_var(AEnv, sys_x, X_Get),
1397 Vals=[X_Get|Vals_Get],
1398 set_var(AEnv, sys_vals, Vals)
1399 )),
1400 get_var(LEnv, sys_vals, Vals_Get21),
1401 f_nreverse(Vals_Get21, Vals50),
1402 set_var(LEnv, sys_vals, Vals50),
1403 get_var(LEnv, sys_new_var, New_var_Get),
1404 get_var(LEnv, sys_vals, Vals_Get22),
1405 CAR57=[New_var_Get],
1406 get_var(LEnv, sys_setf_function, IFTEST),
1407 ( IFTEST\==[]
1408 -> get_var(LEnv, sys_inverse, Inverse_Get),
1409 get_var(LEnv, sys_new_var, New_var_Get28),
1410 get_var(LEnv, sys_vars, Vars_Get29),
1411 bq_append(Inverse_Get,
1412 [New_var_Get28|Vars_Get29],
1413 TrueResult42),
1414 CAR=TrueResult42
1415 ; get_var(LEnv, sys_inverse, Inverse_Get31),
1416 f_car(Inverse_Get31, PredArgResult),
1417 ( decls:is_functionp(PredArgResult)
1418 -> get_var(LEnv, sys_inverse, Inverse_Get34),
1419 get_var(LEnv, sys_new_var, New_var_Get36),
1420 get_var(LEnv, sys_vars, Vars_Get35),
1421 bq_append(Vars_Get35, [New_var_Get36], Bq_append_Ret),
1422 bq_append([funcall|Inverse_Get34],
1423 Bq_append_Ret,
1424 TrueResult),
1425 ElseResult43=TrueResult
1426 ; get_var(LEnv, sys_inverse, Inverse_Get37),
1427 get_var(LEnv, sys_new_var, New_var_Get39),
1428 get_var(LEnv, sys_vars, Vars_Get38),
1429 bq_append(Vars_Get38,
1430 [New_var_Get39],
1431 Bq_append_Ret54),
1432 bq_append(Inverse_Get37, Bq_append_Ret54, ElseResult),
1433 ElseResult43=ElseResult
1434 ),
1435 CAR=ElseResult43
1436 ),
1437 get_var(LEnv, sys_form, Form_Get44),
1438 f_car(Form_Get44, Car_Ret),
1439 get_var(LEnv, sys_vars, Vars_Get45),
1440 nb_setval('$mv_return',
1441
1442 [ sys_vars,
1443 Vals_Get22,
1444 CAR57,
1445 CAR,
1446 [Car_Ret|Vars_Get45]
1447 ])
1448 ),
1449 sys_vars=FnResult
1450 ),
1451 block_exit(sys_get_setf_method_inverse, FnResult),
1452 true).
1453:- set_opv(sys_get_setf_method_inverse,
1454 symbol_function,
1455 f_sys_get_setf_method_inverse),
1456 DefunResult=sys_get_setf_method_inverse. 1457/*
1458:- side_effect(assert_lsp(sys_get_setf_method_inverse,
1459 lambda_def(defun,
1460 sys_get_setf_method_inverse,
1461 f_sys_get_setf_method_inverse,
1462 [sys_form, sys_inverse, sys_setf_function],
1463
1464 [
1465 [ let,
1466
1467 [ [sys_new_var, [gensym]],
1468 [sys_vars, []],
1469 [sys_vals, []]
1470 ],
1471
1472 [ dolist,
1473 [sys_x, [cdr, sys_form]],
1474 [push, [gensym], sys_vars],
1475 [push, sys_x, sys_vals]
1476 ],
1477 [setq, sys_vals, [nreverse, sys_vals]],
1478
1479 [ values,
1480 sys_vars,
1481 sys_vals,
1482 [list, sys_new_var],
1483
1484 [ if,
1485 sys_setf_function,
1486
1487 [ '#BQ',
1488
1489 [
1490 [ '#BQ-COMMA-ELIPSE',
1491 sys_inverse
1492 ],
1493 ['#COMMA', sys_new_var],
1494 ['#BQ-COMMA-ELIPSE', sys_vars]
1495 ]
1496 ],
1497
1498 [ if,
1499 [functionp, [car, sys_inverse]],
1500
1501 [ '#BQ',
1502
1503 [ funcall,
1504
1505 [ '#BQ-COMMA-ELIPSE',
1506 sys_inverse
1507 ],
1508
1509 [ '#BQ-COMMA-ELIPSE',
1510 sys_vars
1511 ],
1512 ['#COMMA', sys_new_var]
1513 ]
1514 ],
1515
1516 [ '#BQ',
1517
1518 [
1519 [ '#BQ-COMMA-ELIPSE',
1520 sys_inverse
1521 ],
1522
1523 [ '#BQ-COMMA-ELIPSE',
1524 sys_vars
1525 ],
1526 ['#COMMA', sys_new_var]
1527 ]
1528 ]
1529 ]
1530 ],
1531
1532 [ '#BQ',
1533
1534 [ ['#COMMA', [car, sys_form]],
1535 ['#BQ-COMMA-ELIPSE', sys_vars]
1536 ]
1537 ]
1538 ]
1539 ]
1540 ]))).
1541*/
1542/*
1543:- side_effect(assert_lsp(sys_get_setf_method_inverse,
1544 arglist_info(sys_get_setf_method_inverse,
1545 f_sys_get_setf_method_inverse,
1546
1547 [ sys_form,
1548 sys_inverse,
1549 sys_setf_function
1550 ],
1551 arginfo{ all:
1552 [ sys_form,
1553 sys_inverse,
1554 sys_setf_function
1555 ],
1556 allow_other_keys:0,
1557 aux:0,
1558 body:0,
1559 complex:0,
1560 env:0,
1561 key:0,
1562 names:
1563 [ sys_form,
1564 sys_inverse,
1565 sys_setf_function
1566 ],
1567 opt:0,
1568 req:
1569 [ sys_form,
1570 sys_inverse,
1571 sys_setf_function
1572 ],
1573 rest:0,
1574 sublists:0,
1575 whole:0
1576 }))).
1577*/
1578/*
1579:- side_effect(assert_lsp(sys_get_setf_method_inverse,
1580 init_args(x, f_sys_get_setf_method_inverse))).
1581*/
1582/*
1583;; If a macro, expand one level and try again. If not, go for the
1584*/
1585/*
1586;; SETF function.
1587*/
1588/*
1589#+(or ABCL WAM-CL)
1590(defun expand-or-get-setf-inverse (form environment)
1591 (multiple-value-bind (expansion expanded)
1592 (macroexpand-1 form environment)
1593 (if expanded
1594 (get-setf-expansion expansion environment)
1595 (get-setf-method-inverse form `(funcall #'(setf ,(car form)))
1596 t))))
1597
1598*/
1599
1600/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:8744 **********************/
1601:-lisp_compile_to_prolog(pkg_sys,[defun,'expand-or-get-setf-inverse',[form,environment],['multiple-value-bind',[expansion,expanded],['macroexpand-1',form,environment],[if,expanded,['get-setf-expansion',expansion,environment],['get-setf-method-inverse',form,['#BQ',[funcall,function([setf,['#COMMA',[car,form]]])]],t]]]])
1602wl:lambda_def(defun, sys_expand_or_get_setf_inverse, f_sys_expand_or_get_setf_inverse, [sys_form, sys_environment], [[multiple_value_bind, [sys_expansion, sys_expanded], [macroexpand_1, sys_form, sys_environment], [if, sys_expanded, [get_setf_expansion, sys_expansion, sys_environment], [sys_get_setf_method_inverse, sys_form, ['#BQ', [funcall, function([setf, ['#COMMA', [car, sys_form]]])]], t]]]]).
1603wl:arglist_info(sys_expand_or_get_setf_inverse, f_sys_expand_or_get_setf_inverse, [sys_form, sys_environment], arginfo{all:[sys_form, sys_environment], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_form, sys_environment], opt:0, req:[sys_form, sys_environment], rest:0, sublists:0, whole:0}).
1604wl: init_args(x, f_sys_expand_or_get_setf_inverse).
1605
1610f_sys_expand_or_get_setf_inverse(Form_In, Environment_In, FnResult) :-
1611 CDR=[bv(sys_form, Form_In), bv(sys_environment, Environment_In)],
1612 catch(( ( LEnv=[bv(sys_expansion, []), bv(sys_expanded, [])|CDR],
1613 get_var(LEnv, sys_environment, Environment_Get),
1614 get_var(LEnv, sys_form, Form_Get),
1615 f_macroexpand_1([Form_Get, Environment_Get],
1616 Macroexpand_1_Ret),
1617 setq_from_values(LEnv, [sys_expansion, sys_expanded]),
1618 get_var(LEnv, sys_expanded, IFTEST),
1619 ( IFTEST\==[]
1620 -> get_var(LEnv, sys_environment, Environment_Get15),
1621 get_var(LEnv, sys_expansion, Expansion_Get),
1622 f_get_setf_expansion(Expansion_Get,
1623 [Environment_Get15],
1624 TrueResult),
1625 LetResult=TrueResult
1626 ; get_var(LEnv, sys_form, Form_Get16),
1627 f_sys_get_setf_method_inverse(Form_Get16,
1628
1629 [ funcall,
1630 function(
1631 [ setf,
1632
1633 [ '#COMMA',
1634 [car, sys_form]
1635 ]
1636 ])
1637 ],
1638 t,
1639 ElseResult),
1640 LetResult=ElseResult
1641 )
1642 ),
1643 LetResult=FnResult
1644 ),
1645 block_exit(sys_expand_or_get_setf_inverse, FnResult),
1646 true).
1647:- set_opv(sys_expand_or_get_setf_inverse,
1648 symbol_function,
1649 f_sys_expand_or_get_setf_inverse),
1650 DefunResult=sys_expand_or_get_setf_inverse. 1651/*
1652:- side_effect(assert_lsp(sys_expand_or_get_setf_inverse,
1653 lambda_def(defun,
1654 sys_expand_or_get_setf_inverse,
1655 f_sys_expand_or_get_setf_inverse,
1656 [sys_form, sys_environment],
1657
1658 [
1659 [ multiple_value_bind,
1660 [sys_expansion, sys_expanded],
1661
1662 [ macroexpand_1,
1663 sys_form,
1664 sys_environment
1665 ],
1666
1667 [ if,
1668 sys_expanded,
1669
1670 [ get_setf_expansion,
1671 sys_expansion,
1672 sys_environment
1673 ],
1674
1675 [ sys_get_setf_method_inverse,
1676 sys_form,
1677
1678 [ '#BQ',
1679
1680 [ funcall,
1681 function(
1682 [ setf,
1683
1684 [ '#COMMA',
1685 [car, sys_form]
1686 ]
1687 ])
1688 ]
1689 ],
1690 t
1691 ]
1692 ]
1693 ]
1694 ]))).
1695*/
1696/*
1697:- side_effect(assert_lsp(sys_expand_or_get_setf_inverse,
1698 arglist_info(sys_expand_or_get_setf_inverse,
1699 f_sys_expand_or_get_setf_inverse,
1700 [sys_form, sys_environment],
1701 arginfo{ all:[sys_form, sys_environment],
1702 allow_other_keys:0,
1703 aux:0,
1704 body:0,
1705 complex:0,
1706 env:0,
1707 key:0,
1708 names:
1709 [ sys_form,
1710 sys_environment
1711 ],
1712 opt:0,
1713 req:[sys_form, sys_environment],
1714 rest:0,
1715 sublists:0,
1716 whole:0
1717 }))).
1718*/
1719/*
1720:- side_effect(assert_lsp(sys_expand_or_get_setf_inverse,
1721 init_args(x, f_sys_expand_or_get_setf_inverse))).
1722*/
1723/*
1724#+(or ABCL WAM-CL)
1725(defun get-setf-expansion (form &optional environment)
1726 (let (temp)
1727 (cond ((symbolp form)
1728 (multiple-value-bind (expansion expanded)
1729 (macroexpand-1 form environment)
1730 (if expanded
1731 (get-setf-expansion expansion environment)
1732 (let ((new-var (gensym)))
1733 (values nil nil (list new-var)
1734 `(setq ,form ,new-var) form)))))
1735 ((setq temp (get-sysprop (car form) 'setf-inverse))
1736 (get-setf-method-inverse form `(,temp) nil))
1737 ((setq temp (get-sysprop (car form) 'setf-expander))
1738 (funcall temp form environment))
1739 (t
1740 (expand-or-get-setf-inverse form environment)))))
1741
1742*/
1743
1744/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:9086 **********************/
1745:-lisp_compile_to_prolog(pkg_sys,[defun,'get-setf-expansion',[form,'&optional',environment],[let,[temp],[cond,[[symbolp,form],['multiple-value-bind',[expansion,expanded],['macroexpand-1',form,environment],[if,expanded,['get-setf-expansion',expansion,environment],[let,[['new-var',[gensym]]],[values,[],[],[list,'new-var'],['#BQ',[setq,['#COMMA',form],['#COMMA','new-var']]],form]]]]],[[setq,temp,['get-sysprop',[car,form],[quote,'setf-inverse']]],['get-setf-method-inverse',form,['#BQ',[['#COMMA',temp]]],[]]],[[setq,temp,['get-sysprop',[car,form],[quote,'setf-expander']]],[funcall,temp,form,environment]],[t,['expand-or-get-setf-inverse',form,environment]]]]])
1746wl:lambda_def(defun, get_setf_expansion, f_get_setf_expansion, [sys_form, c38_optional, sys_environment], [[let, [sys_temp], [cond, [[symbolp, sys_form], [multiple_value_bind, [sys_expansion, sys_expanded], [macroexpand_1, sys_form, sys_environment], [if, sys_expanded, [get_setf_expansion, sys_expansion, sys_environment], [let, [[sys_new_var, [gensym]]], [values, [], [], [list, sys_new_var], ['#BQ', [setq, ['#COMMA', sys_form], ['#COMMA', sys_new_var]]], sys_form]]]]], [[setq, sys_temp, [sys_get_sysprop, [car, sys_form], [quote, sys_setf_inverse]]], [sys_get_setf_method_inverse, sys_form, ['#BQ', [['#COMMA', sys_temp]]], []]], [[setq, sys_temp, [sys_get_sysprop, [car, sys_form], [quote, sys_setf_expander]]], [funcall, sys_temp, sys_form, sys_environment]], [t, [sys_expand_or_get_setf_inverse, sys_form, sys_environment]]]]]).
1747wl:arglist_info(get_setf_expansion, f_get_setf_expansion, [sys_form, c38_optional, sys_environment], arginfo{all:[sys_form, sys_environment], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_form, sys_environment], opt:[sys_environment], req:[sys_form], rest:0, sublists:0, whole:0}).
1748wl: init_args(1, f_get_setf_expansion).
1749
1754f_get_setf_expansion(Form_In, RestNKeys, FnResult) :-
1755 CDR=[bv(sys_form, Form_In), bv(sys_environment, Environment_In)],
1756 opt_var(Env, sys_environment, Environment_In, true, [], 1, RestNKeys),
1757 catch(( ( LEnv=[bv(sys_temp, [])|CDR],
1758 get_var(LEnv, sys_form, Form_Get),
1759 ( is_symbolp(Form_Get)
1760 -> LEnv16=[bv(sys_expansion, []), bv(sys_expanded, [])|LEnv],
1761 get_var(LEnv16, sys_environment, Environment_Get),
1762 get_var(LEnv16, sys_form, Form_Get18),
1763 f_macroexpand_1([Form_Get18, Environment_Get],
1764 Macroexpand_1_Ret),
1765 setq_from_values(LEnv16, [sys_expansion, sys_expanded]),
1766 get_var(LEnv16, sys_expanded, IFTEST19),
1767 ( IFTEST19\==[]
1768 -> get_var(LEnv16, sys_environment, Environment_Get23),
1769 get_var(LEnv16, sys_expansion, Expansion_Get),
1770 f_get_setf_expansion(Expansion_Get,
1771 [Environment_Get23],
1772 TrueResult),
1773 LetResult15=TrueResult
1774 ; f_gensym(New_var_Init),
1775 LEnv26=[bv(sys_new_var, New_var_Init)|LEnv16],
1776 get_var(LEnv26, sys_new_var, New_var_Get),
1777 CAR=[New_var_Get],
1778 get_var(LEnv26, sys_form, Form_Get29),
1779 get_var(LEnv26, sys_new_var, New_var_Get30),
1780 nb_setval('$mv_return',
1781
1782 [ [],
1783 [],
1784 CAR,
1785 [setq, Form_Get29, New_var_Get30],
1786 Form_Get29
1787 ]),
1788 LetResult15=[]
1789 ),
1790 LetResult=LetResult15
1791 ; get_var(LEnv, sys_form, Form_Get36),
1792 f_car(Form_Get36, Get_sysprop_Param),
1793 f_sys_get_sysprop(Get_sysprop_Param,
1794 sys_setf_inverse,
1795 [],
1796 IFTEST33),
1797 set_var(LEnv, sys_temp, IFTEST33),
1798 ( IFTEST33\==[]
1799 -> get_var(LEnv, sys_form, Form_Get37),
1800 get_var(LEnv, sys_temp, Temp_Get),
1801 f_sys_get_setf_method_inverse(Form_Get37,
1802 [Temp_Get],
1803 [],
1804 TrueResult49),
1805 ElseResult52=TrueResult49
1806 ; get_var(LEnv, sys_form, Form_Get41),
1807 f_car(Form_Get41, Get_sysprop_Param56),
1808 f_sys_get_sysprop(Get_sysprop_Param56,
1809 sys_setf_expander,
1810 [],
1811 IFTEST39),
1812 set_var(LEnv, sys_temp, IFTEST39),
1813 ( IFTEST39\==[]
1814 -> get_var(LEnv, sys_environment, Environment_Get44),
1815 get_var(LEnv, sys_form, Form_Get43),
1816 get_var(LEnv, sys_temp, Temp_Get42),
1817 f_apply(Temp_Get42,
1818 [Form_Get43, Environment_Get44],
1819 TrueResult47),
1820 ElseResult50=TrueResult47
1821 ; get_var(LEnv, sys_environment, Environment_Get46),
1822 get_var(LEnv, sys_form, Form_Get45),
1823 f_sys_expand_or_get_setf_inverse(Form_Get45,
1824 Environment_Get46,
1825 ElseResult),
1826 ElseResult50=ElseResult
1827 ),
1828 ElseResult52=ElseResult50
1829 ),
1830 LetResult=ElseResult52
1831 )
1832 ),
1833 LetResult=FnResult
1834 ),
1835 block_exit(get_setf_expansion, FnResult),
1836 true).
1837:- set_opv(get_setf_expansion, symbol_function, f_get_setf_expansion),
1838 DefunResult=get_setf_expansion. 1839/*
1840:- side_effect(assert_lsp(get_setf_expansion,
1841 lambda_def(defun,
1842 get_setf_expansion,
1843 f_get_setf_expansion,
1844 [sys_form, c38_optional, sys_environment],
1845
1846 [
1847 [ let,
1848 [sys_temp],
1849
1850 [ cond,
1851
1852 [ [symbolp, sys_form],
1853
1854 [ multiple_value_bind,
1855 [sys_expansion, sys_expanded],
1856
1857 [ macroexpand_1,
1858 sys_form,
1859 sys_environment
1860 ],
1861
1862 [ if,
1863 sys_expanded,
1864
1865 [ get_setf_expansion,
1866 sys_expansion,
1867 sys_environment
1868 ],
1869
1870 [ let,
1871 [[sys_new_var, [gensym]]],
1872
1873 [ values,
1874 [],
1875 [],
1876 [list, sys_new_var],
1877
1878 [ '#BQ',
1879
1880 [ setq,
1881 ['#COMMA', sys_form],
1882
1883 [ '#COMMA',
1884 sys_new_var
1885 ]
1886 ]
1887 ],
1888 sys_form
1889 ]
1890 ]
1891 ]
1892 ]
1893 ],
1894
1895 [
1896 [ setq,
1897 sys_temp,
1898
1899 [ sys_get_sysprop,
1900 [car, sys_form],
1901 [quote, sys_setf_inverse]
1902 ]
1903 ],
1904
1905 [ sys_get_setf_method_inverse,
1906 sys_form,
1907 ['#BQ', [['#COMMA', sys_temp]]],
1908 []
1909 ]
1910 ],
1911
1912 [
1913 [ setq,
1914 sys_temp,
1915
1916 [ sys_get_sysprop,
1917 [car, sys_form],
1918 [quote, sys_setf_expander]
1919 ]
1920 ],
1921
1922 [ funcall,
1923 sys_temp,
1924 sys_form,
1925 sys_environment
1926 ]
1927 ],
1928
1929 [ t,
1930
1931 [ sys_expand_or_get_setf_inverse,
1932 sys_form,
1933 sys_environment
1934 ]
1935 ]
1936 ]
1937 ]
1938 ]))).
1939*/
1940/*
1941:- side_effect(assert_lsp(get_setf_expansion,
1942 arglist_info(get_setf_expansion,
1943 f_get_setf_expansion,
1944 [sys_form, c38_optional, sys_environment],
1945 arginfo{ all:[sys_form, sys_environment],
1946 allow_other_keys:0,
1947 aux:0,
1948 body:0,
1949 complex:0,
1950 env:0,
1951 key:0,
1952 names:
1953 [ sys_form,
1954 sys_environment
1955 ],
1956 opt:[sys_environment],
1957 req:[sys_form],
1958 rest:0,
1959 sublists:0,
1960 whole:0
1961 }))).
1962*/
1963/*
1964:- side_effect(assert_lsp(get_setf_expansion,
1965 init_args(1, f_get_setf_expansion))).
1966*/
1967/*
1968#+(or ABCL WAM-CL)
1969(defmacro setf (&rest args &environment environment)
1970 (let ((numargs (length args)))
1971 (cond
1972 ((= numargs 2)
1973 (let ((place (first args))
1974 (value-form (second args)))
1975 (if (atom place)
1976 `(setq ,place ,value-form)
1977 (progn
1978 (multiple-value-bind (dummies vals store-vars setter getter)
1979 (get-setf-expansion place environment)
1980 (let ((inverse (get-sysprop (car place) 'setf-inverse)))
1981 (if (and inverse (eq inverse (car setter)))
1982 (if (functionp inverse)
1983 `(funcall ,inverse ,@(cdr place) ,value-form)
1984 `(,inverse ,@(cdr place) ,value-form))
1985 (if (or (null store-vars) (cdr store-vars))
1986 `(let* (,@(mapcar #'list dummies vals))
1987 (multiple-value-bind ,store-vars ,value-form
1988 ,setter))
1989 `(let* (,@(mapcar #'list dummies vals)
1990 ,(list (car store-vars) value-form))
1991 ,setter)))))))))
1992 ((oddp numargs)
1993 (error "Odd number of arguments to SETF."))
1994 (t
1995 (do ((a args (cddr a)) (l nil))
1996 ((null a) `(progn ,@(nreverse l)))
1997 (setq l (cons (list 'setf (car a) (cadr a)) l)))))))
1998
1999
2000;; (defsetf subseq (sequence start &optional (end nil)) (v)
2001;; `(progn (replace ,sequence ,v :start1 ,start :end1 ,end)
2002;; ,v))
2003*/
2004
2005/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:9860 **********************/
2006:-lisp_compile_to_prolog(pkg_sys,[defmacro,setf,['&rest',args,'&environment',environment],[let,[[numargs,[length,args]]],[cond,[[=,numargs,2],[let,[[place,[first,args]],['value-form',[second,args]]],[if,[atom,place],['#BQ',[setq,['#COMMA',place],['#COMMA','value-form']]],[progn,['multiple-value-bind',[dummies,vals,'store-vars',setter,getter],['get-setf-expansion',place,environment],[let,[[inverse,['get-sysprop',[car,place],[quote,'setf-inverse']]]],[if,[and,inverse,[eq,inverse,[car,setter]]],[if,[functionp,inverse],['#BQ',[funcall,['#COMMA',inverse],['#BQ-COMMA-ELIPSE',[cdr,place]],['#COMMA','value-form']]],['#BQ',[['#COMMA',inverse],['#BQ-COMMA-ELIPSE',[cdr,place]],['#COMMA','value-form']]]],[if,[or,[null,'store-vars'],[cdr,'store-vars']],['#BQ',['let*',[['#BQ-COMMA-ELIPSE',[mapcar,function(list),dummies,vals]]],['multiple-value-bind',['#COMMA','store-vars'],['#COMMA','value-form'],['#COMMA',setter]]]],['#BQ',['let*',[['#BQ-COMMA-ELIPSE',[mapcar,function(list),dummies,vals]],['#COMMA',[list,[car,'store-vars'],'value-form']]],['#COMMA',setter]]]]]]]]]]],[[oddp,numargs],[error,'$STRING'("Odd number of arguments to SETF.")]],[t,[do,[[a,args,[cddr,a]],[l,[]]],[[null,a],['#BQ',[progn,['#BQ-COMMA-ELIPSE',[nreverse,l]]]]],[setq,l,[cons,[list,[quote,setf],[car,a],[cadr,a]],l]]]]]]])
2007wl:lambda_def(defmacro, setf, mf_setf, [c38_rest, sys_args, c38_environment, sys_environment], [[let, [[sys_numargs, [length, sys_args]]], [cond, [[=, sys_numargs, 2], [let, [[sys_place, [first, sys_args]], [sys_value_form, [second, sys_args]]], [if, [atom, sys_place], ['#BQ', [setq, ['#COMMA', sys_place], ['#COMMA', sys_value_form]]], [progn, [multiple_value_bind, [sys_dummies, sys_vals, sys_store_vars, sys_setter, sys_getter], [get_setf_expansion, sys_place, sys_environment], [let, [[sys_inverse, [sys_get_sysprop, [car, sys_place], [quote, sys_setf_inverse]]]], [if, [and, sys_inverse, [eq, sys_inverse, [car, sys_setter]]], [if, [functionp, sys_inverse], ['#BQ', [funcall, ['#COMMA', sys_inverse], ['#BQ-COMMA-ELIPSE', [cdr, sys_place]], ['#COMMA', sys_value_form]]], ['#BQ', [['#COMMA', sys_inverse], ['#BQ-COMMA-ELIPSE', [cdr, sys_place]], ['#COMMA', sys_value_form]]]], [if, [or, [null, sys_store_vars], [cdr, sys_store_vars]], ['#BQ', [let_xx, [['#BQ-COMMA-ELIPSE', [mapcar, function(list), sys_dummies, sys_vals]]], [multiple_value_bind, ['#COMMA', sys_store_vars], ['#COMMA', sys_value_form], ['#COMMA', sys_setter]]]], ['#BQ', [let_xx, [['#BQ-COMMA-ELIPSE', [mapcar, function(list), sys_dummies, sys_vals]], ['#COMMA', [list, [car, sys_store_vars], sys_value_form]]], ['#COMMA', sys_setter]]]]]]]]]]], [[oddp, sys_numargs], [error, '$ARRAY'([*], claz_base_character, "Odd number of arguments to SETF.")]], [t, [do, [[sys_a, sys_args, [cddr, sys_a]], [sys_l, []]], [[null, sys_a], ['#BQ', [progn, ['#BQ-COMMA-ELIPSE', [nreverse, sys_l]]]]], [setq, sys_l, [cons, [list, [quote, setf], [car, sys_a], [cadr, sys_a]], sys_l]]]]]]]).
2008wl:arglist_info(setf, mf_setf, [c38_rest, sys_args, c38_environment, sys_environment], arginfo{all:0, allow_other_keys:0, aux:0, body:0, complex:[rest, environment], env:[sys_environment], key:0, names:[sys_args, sys_environment], opt:0, req:0, rest:[sys_args], sublists:0, whole:0}).
2009wl: init_args(0, mf_setf).
2010
2015sf_setf(Environment_In, RestNKeys, FResult) :-
2016 mf_setf([setf|RestNKeys], Environment_In, MFResult),
2017 f_sys_env_eval(Environment_In, MFResult, FResult).
2022mf_setf([setf|RestNKeys], Environment_In, MFResult) :-
2023 nop(defmacro),
2024 GEnv=[bv(sys_args, RestNKeys), bv(sys_environment, Environment_In)],
2025 catch(( ( get_var(GEnv, sys_args, Args_Get),
2026 f_length(Args_Get, Numargs_Init),
2027 LEnv=[bv(sys_numargs, Numargs_Init)|GEnv],
2028 get_var(LEnv, sys_numargs, Numargs_Get),
2029 ( Numargs_Get=:=2
2030 -> get_var(LEnv, sys_args, Args_Get18),
2031 f_car(Args_Get18, Place_Init),
2032 get_var(LEnv, sys_args, Args_Get19),
2033 f_second(Args_Get19, Value_form_Init),
2034 LEnv17=[bv(sys_place, Place_Init), bv(sys_value_form, Value_form_Init)|LEnv],
2035 get_var(LEnv17, sys_place, Place_Get),
2036 ( Place_Get\=[CAR|CDR]
2037 -> get_var(LEnv17, sys_place, Place_Get26),
2038 get_var(LEnv17, sys_value_form, Value_form_Get),
2039 LetResult16=[setq, Place_Get26, Value_form_Get]
2040 ; LEnv30=[bv(sys_dummies, []), bv(sys_vals, []), bv(sys_store_vars, []), bv(sys_setter, []), bv(sys_getter, [])|LEnv17],
2041 get_var(LEnv30, sys_environment, Environment_Get),
2042 get_var(LEnv30, sys_place, Place_Get31),
2043 f_get_setf_expansion(Place_Get31,
2044 [Environment_Get],
2045 Setf_expansion_Ret),
2046 setq_from_values(LEnv30,
2047
2048 [ sys_dummies,
2049 sys_vals,
2050 sys_store_vars,
2051 sys_setter,
2052 sys_getter
2053 ]),
2054 get_var(LEnv30, sys_place, Place_Get36),
2055 f_car(Place_Get36, Get_sysprop_Param),
2056 f_sys_get_sysprop(Get_sysprop_Param,
2057 sys_setf_inverse,
2058 [],
2059 Inverse_Init),
2060 LEnv35=[bv(sys_inverse, Inverse_Init)|LEnv30],
2061 get_var(LEnv35, sys_inverse, IFTEST40),
2062 ( IFTEST40\==[]
2063 -> get_var(LEnv35, sys_inverse, Inverse_Get43),
2064 get_var(LEnv35, sys_setter, Setter_Get),
2065 f_car(Setter_Get, Car_Ret),
2066 f_eq(Inverse_Get43, Car_Ret, TrueResult),
2067 IFTEST38=TrueResult
2068 ; IFTEST38=[]
2069 ),
2070 ( IFTEST38\==[]
2071 -> get_var(LEnv35, sys_inverse, Inverse_Get47),
2072 ( decls:is_functionp(Inverse_Get47)
2073 -> get_var(LEnv35, sys_inverse, Inverse_Get50),
2074 get_var(LEnv35, sys_place, Place_Get51),
2075 f_cdr(Place_Get51, Cdr_Ret),
2076 get_var(LEnv35,
2077 sys_value_form,
2078 Value_form_Get52),
2079 bq_append([Inverse_Get50|Cdr_Ret],
2080 [Value_form_Get52],
2081 Bq_append_Ret),
2082 TrueResult72=[funcall|Bq_append_Ret]
2083 ; get_var(LEnv35, sys_inverse, Inverse_Get53),
2084 get_var(LEnv35, sys_place, Place_Get54),
2085 f_cdr(Place_Get54, Cdr_Ret136),
2086 get_var(LEnv35,
2087 sys_value_form,
2088 Value_form_Get55),
2089 bq_append([Inverse_Get53|Cdr_Ret136],
2090 [Value_form_Get55],
2091 ElseResult),
2092 TrueResult72=ElseResult
2093 ),
2094 LetResult34=TrueResult72
2095 ; ( get_var(LEnv35,
2096 sys_store_vars,
2097 Store_vars_Get),
2098 f_null(Store_vars_Get, FORM1_Res),
2099 FORM1_Res\==[],
2100 IFTEST57=FORM1_Res
2101 -> true
2102 ; get_var(LEnv35,
2103 sys_store_vars,
2104 Store_vars_Get60),
2105 f_cdr(Store_vars_Get60, Cdr_Ret137),
2106 IFTEST57=Cdr_Ret137
2107 ),
2108 ( IFTEST57\==[]
2109 -> get_var(LEnv35, sys_dummies, Dummies_Get),
2110 get_var(LEnv35, sys_vals, Vals_Get),
2111 f_mapcar(f_list,
2112 [Dummies_Get, Vals_Get],
2113 Mapcar_Ret),
2114 get_var(LEnv35, sys_setter, Setter_Get66),
2115 get_var(LEnv35,
2116 sys_store_vars,
2117 Store_vars_Get64),
2118 get_var(LEnv35,
2119 sys_value_form,
2120 Value_form_Get65),
2121 ElseResult73=[let_xx, Mapcar_Ret, [multiple_value_bind, Store_vars_Get64, Value_form_Get65, Setter_Get66]]
2122 ; get_var(LEnv35, sys_dummies, Dummies_Get67),
2123 get_var(LEnv35, sys_vals, Vals_Get68),
2124 f_mapcar(f_list,
2125 [Dummies_Get67, Vals_Get68],
2126 Bq_append_Param),
2127 get_var(LEnv35,
2128 sys_store_vars,
2129 Store_vars_Get69),
2130 f_car(Store_vars_Get69, Car_Ret139),
2131 get_var(LEnv35,
2132 sys_value_form,
2133 Value_form_Get70),
2134 CAR141=[Car_Ret139, Value_form_Get70],
2135 bq_append(Bq_append_Param,
2136 [CAR141],
2137 Bq_append_Ret140),
2138 get_var(LEnv35, sys_setter, Setter_Get71),
2139 ElseResult73=[let_xx, Bq_append_Ret140, Setter_Get71]
2140 ),
2141 LetResult34=ElseResult73
2142 ),
2143 LetResult16=LetResult34
2144 ),
2145 LetResult=LetResult16
2146 ; get_var(LEnv, sys_numargs, Numargs_Get76),
2147 ( mth:is_oddp(Numargs_Get76)
2148 -> f_error(
2149 [ '$ARRAY'([*],
2150 claz_base_character,
2151 "Odd number of arguments to SETF.")
2152 ],
2153 TrueResult118),
2154 ElseResult121=TrueResult118
2155 ; get_var(LEnv, sys_args, Args_Get82),
2156 AEnv=[bv(sys_a, Args_Get82), bv(sys_l, [])|LEnv],
2157 catch(( call_addr_block(AEnv,
2158 (push_label(do_label_20), get_var(AEnv, sys_a, IFTEST102), (IFTEST102==[]->get_var(AEnv, sys_l, L_Get107), f_nreverse(L_Get107, Nreverse_Ret), throw(block_exit([], [progn|Nreverse_Ret])), _TBResult=ThrowResult106;get_var(AEnv, sys_a, A_Get110), f_car(A_Get110, Car_Ret143), get_var(AEnv, sys_a, A_Get111), f_cadr(A_Get111, Cadr_Ret), CAR145=[setf, Car_Ret143, Cadr_Ret], get_var(AEnv, sys_l, L_Get112), L=[CAR145|L_Get112], set_var(AEnv, sys_l, L), get_var(AEnv, sys_a, A_Get113), f_cddr(A_Get113, A), set_var(AEnv, sys_a, A), goto(do_label_20, AEnv), _TBResult=_GORES114)),
2159
2160 [ addr(addr_tagbody_20_do_label_20,
2161 do_label_20,
2162 '$unused',
2163 AEnv,
2164 (get_var(AEnv, sys_a, IFTEST85), (IFTEST85==[]->get_var(AEnv, sys_l, Nreverse_Param), f_nreverse(Nreverse_Param, Nreverse_Ret146), throw(block_exit([], [progn|Nreverse_Ret146])), _12224=ThrowResult;get_var(AEnv, sys_a, A_Get93), f_car(A_Get93, Car_Ret147), get_var(AEnv, sys_a, A_Get94), f_cadr(A_Get94, Cadr_Ret148), CAR149=[setf, Car_Ret147, Cadr_Ret148], get_var(AEnv, sys_l, L_Get95), Set_var_Ret=[CAR149|L_Get95], set_var(AEnv, sys_l, Set_var_Ret), get_var(AEnv, sys_a, A_Get96), f_cddr(A_Get96, Cddr_Ret), set_var(AEnv, sys_a, Cddr_Ret), goto(do_label_20, AEnv), _12224=_GORES)))
2165 ]),
2166 []=LetResult80
2167 ),
2168 block_exit([], LetResult80),
2169 true),
2170 ElseResult121=LetResult80
2171 ),
2172 LetResult=ElseResult121
2173 )
2174 ),
2175 LetResult=MFResult
2176 ),
2177 block_exit(setf, MFResult),
2178 true).
2179:- set_opv(mf_setf, type_of, sys_macro),
2180 set_opv(setf, symbol_function, mf_setf),
2181 DefMacroResult=setf. 2182/*
2183:- side_effect(assert_lsp(setf,
2184 lambda_def(defmacro,
2185 setf,
2186 mf_setf,
2187
2188 [ c38_rest,
2189 sys_args,
2190 c38_environment,
2191 sys_environment
2192 ],
2193
2194 [
2195 [ let,
2196 [[sys_numargs, [length, sys_args]]],
2197
2198 [ cond,
2199
2200 [ [=, sys_numargs, 2],
2201
2202 [ let,
2203
2204 [ [sys_place, [first, sys_args]],
2205
2206 [ sys_value_form,
2207 [second, sys_args]
2208 ]
2209 ],
2210
2211 [ if,
2212 [atom, sys_place],
2213
2214 [ '#BQ',
2215
2216 [ setq,
2217 ['#COMMA', sys_place],
2218 ['#COMMA', sys_value_form]
2219 ]
2220 ],
2221
2222 [ progn,
2223
2224 [ multiple_value_bind,
2225
2226 [ sys_dummies,
2227 sys_vals,
2228 sys_store_vars,
2229 sys_setter,
2230 sys_getter
2231 ],
2232
2233 [ get_setf_expansion,
2234 sys_place,
2235 sys_environment
2236 ],
2237
2238 [ let,
2239
2240 [
2241 [ sys_inverse,
2242
2243 [ sys_get_sysprop,
2244 [car, sys_place],
2245
2246 [ quote,
2247 sys_setf_inverse
2248 ]
2249 ]
2250 ]
2251 ],
2252
2253 [ if,
2254
2255 [ and,
2256 sys_inverse,
2257
2258 [ eq,
2259 sys_inverse,
2260 [car, sys_setter]
2261 ]
2262 ],
2263
2264 [ if,
2265
2266 [ functionp,
2267 sys_inverse
2268 ],
2269
2270 [ '#BQ',
2271
2272 [ funcall,
2273
2274 [ '#COMMA',
2275 sys_inverse
2276 ],
2277
2278 [ '#BQ-COMMA-ELIPSE',
2279 [cdr, sys_place]
2280 ],
2281
2282 [ '#COMMA',
2283 sys_value_form
2284 ]
2285 ]
2286 ],
2287
2288 [ '#BQ',
2289
2290 [
2291 [ '#COMMA',
2292 sys_inverse
2293 ],
2294
2295 [ '#BQ-COMMA-ELIPSE',
2296 [cdr, sys_place]
2297 ],
2298
2299 [ '#COMMA',
2300 sys_value_form
2301 ]
2302 ]
2303 ]
2304 ],
2305
2306 [ if,
2307
2308 [ or,
2309
2310 [ null,
2311 sys_store_vars
2312 ],
2313
2314 [ cdr,
2315 sys_store_vars
2316 ]
2317 ],
2318
2319 [ '#BQ',
2320
2321 [ let_xx,
2322
2323 [
2324 [ '#BQ-COMMA-ELIPSE',
2325
2326 [ mapcar,
2327 function(list),
2328 sys_dummies,
2329 sys_vals
2330 ]
2331 ]
2332 ],
2333
2334 [ multiple_value_bind,
2335
2336 [ '#COMMA',
2337 sys_store_vars
2338 ],
2339
2340 [ '#COMMA',
2341 sys_value_form
2342 ],
2343
2344 [ '#COMMA',
2345 sys_setter
2346 ]
2347 ]
2348 ]
2349 ],
2350
2351 [ '#BQ',
2352
2353 [ let_xx,
2354
2355 [
2356 [ '#BQ-COMMA-ELIPSE',
2357
2358 [ mapcar,
2359 function(list),
2360 sys_dummies,
2361 sys_vals
2362 ]
2363 ],
2364
2365 [ '#COMMA',
2366
2367 [ list,
2368
2369 [ car,
2370 sys_store_vars
2371 ],
2372 sys_value_form
2373 ]
2374 ]
2375 ],
2376
2377 [ '#COMMA',
2378 sys_setter
2379 ]
2380 ]
2381 ]
2382 ]
2383 ]
2384 ]
2385 ]
2386 ]
2387 ]
2388 ]
2389 ],
2390
2391 [ [oddp, sys_numargs],
2392
2393 [ error,
2394 '$ARRAY'([*],
2395 claz_base_character,
2396 "Odd number of arguments to SETF.")
2397 ]
2398 ],
2399
2400 [ t,
2401
2402 [ do,
2403
2404 [ [sys_a, sys_args, [cddr, sys_a]],
2405 [sys_l, []]
2406 ],
2407
2408 [ [null, sys_a],
2409
2410 [ '#BQ',
2411
2412 [ progn,
2413
2414 [ '#BQ-COMMA-ELIPSE',
2415 [nreverse, sys_l]
2416 ]
2417 ]
2418 ]
2419 ],
2420
2421 [ setq,
2422 sys_l,
2423
2424 [ cons,
2425
2426 [ list,
2427 [quote, setf],
2428 [car, sys_a],
2429 [cadr, sys_a]
2430 ],
2431 sys_l
2432 ]
2433 ]
2434 ]
2435 ]
2436 ]
2437 ]
2438 ]))).
2439*/
2440/*
2441:- side_effect(assert_lsp(setf,
2442 arglist_info(setf,
2443 mf_setf,
2444
2445 [ c38_rest,
2446 sys_args,
2447 c38_environment,
2448 sys_environment
2449 ],
2450 arginfo{ all:0,
2451 allow_other_keys:0,
2452 aux:0,
2453 body:0,
2454 complex:[rest, environment],
2455 env:[sys_environment],
2456 key:0,
2457 names:
2458 [ sys_args,
2459 sys_environment
2460 ],
2461 opt:0,
2462 req:0,
2463 rest:[sys_args],
2464 sublists:0,
2465 whole:0
2466 }))).
2467*/
2468/*
2469:- side_effect(assert_lsp(setf, init_args(0, mf_setf))).
2470*/
2471/*
2472; (defsetf subseq (sequence start &optional (end nil)) (v)
2473*/
2474/*
2475; `(progn (replace ,sequence ,v :start1 ,start :end1 ,end)
2476*/
2477/*
2478; ,v))
2479*/
2480/*
2481#+(or ABCL WAM-CL)
2482(defun %set-subseq (sequence start &rest rest)
2483 (let ((end nil) v)
2484 (ecase (length rest)
2485 (1
2486 (setq v (car rest)))
2487 (2
2488 (setq end (car rest)
2489 v (cadr rest))))
2490 (progn
2491 (replace sequence v :start1 start :end1 end)
2492 v)))
2493
2494*/
2495
2496/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:11430 **********************/
2497:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-subseq',[sequence,start,'&rest',rest],[let,[[end,[]],v],[ecase,[length,rest],[1,[setq,v,[car,rest]]],[2,[setq,end,[car,rest],v,[cadr,rest]]]],[progn,[replace,sequence,v,':start1',start,':end1',end],v]]])
2498/*
2499% ecase:-[[1,[setq,sys_v,[car,rest]]],[2,[setq,sys_end,[car,rest],sys_v,[cadr,rest]]]].
2500*/
2501/*
2502% conds:-[[[eq,_29140,[quote,1]],[progn,[setq,sys_v,[car,rest]]]],[[eq,_29140,[quote,2]],[progn,[setq,sys_end,[car,rest],sys_v,[cadr,rest]]]],[t,[type_error,_29394,[quote,[member,1,2]]]]].
2503*/
2504/*
2505:-side_effect(generate_function_or_macro_name([fbound(sys_expand,kw_function)=function(f_sys_expand11),name='GLOBAL',environ=env_1],type_error,kw_function,f_type_error)).
2506*/
2507wl:lambda_def(defun, sys_pf_set_subseq, f_sys_pf_set_subseq, [sequence, sys_start, c38_rest, rest], [[let, [[sys_end, []], sys_v], [ecase, [length, rest], [1, [setq, sys_v, [car, rest]]], [2, [setq, sys_end, [car, rest], sys_v, [cadr, rest]]]], [progn, [replace, sequence, sys_v, kw_start1, sys_start, kw_end1, sys_end], sys_v]]]).
2508wl:arglist_info(sys_pf_set_subseq, f_sys_pf_set_subseq, [sequence, sys_start, c38_rest, rest], arginfo{all:[sequence, sys_start], allow_other_keys:0, aux:0, body:0, complex:[rest], env:0, key:0, names:[sequence, sys_start, rest], opt:0, req:[sequence, sys_start], rest:[rest], sublists:0, whole:0}).
2509wl: init_args(2, f_sys_pf_set_subseq).
2510
2515f_sys_pf_set_subseq(Sequence_In, Start_In, RestNKeys, FnResult) :-
2516 CDR=[bv(sequence, Sequence_In), bv(sys_start, Start_In), bv(rest, RestNKeys)],
2517 catch(( ( LEnv=[bv(sys_end, []), bv(sys_v, [])|CDR],
2518 get_var(LEnv, rest, Rest_Get),
2519 f_length(Rest_Get, Key),
2520 ( is_eq(Key, 1)
2521 -> get_var(LEnv, rest, Rest_Get17),
2522 f_car(Rest_Get17, TrueResult24),
2523 set_var(LEnv, sys_v, TrueResult24),
2524 _7208=TrueResult24
2525 ; ( is_eq(Key, 2)
2526 -> get_var(LEnv, rest, Rest_Get20),
2527 f_car(Rest_Get20, End),
2528 set_var(LEnv, sys_end, End),
2529 get_var(LEnv, rest, Rest_Get21),
2530 f_cadr(Rest_Get21, TrueResult),
2531 set_var(LEnv, sys_v, TrueResult),
2532 ElseResult25=TrueResult
2533 ; f_type_error(CAR, [member, 1, 2], ElseResult),
2534 ElseResult25=ElseResult
2535 ),
2536 _7208=ElseResult25
2537 ),
2538 get_var(LEnv, sequence, Sequence_Get),
2539 get_var(LEnv, sys_end, End_Get),
2540 get_var(LEnv, sys_start, Start_Get),
2541 get_var(LEnv, sys_v, V_Get),
2542 f_replace(Sequence_Get,
2543 V_Get,
2544 [kw_start1, Start_Get, kw_end1, End_Get],
2545 Replace_Ret),
2546 get_var(LEnv, sys_v, V_Get30)
2547 ),
2548 V_Get30=FnResult
2549 ),
2550 block_exit(sys_pf_set_subseq, FnResult),
2551 true).
2552:- set_opv(sys_pf_set_subseq, symbol_function, f_sys_pf_set_subseq),
2553 DefunResult=sys_pf_set_subseq. 2554/*
2555:- side_effect(assert_lsp(sys_pf_set_subseq,
2556 lambda_def(defun,
2557 sys_pf_set_subseq,
2558 f_sys_pf_set_subseq,
2559 [sequence, sys_start, c38_rest, rest],
2560
2561 [
2562 [ let,
2563 [[sys_end, []], sys_v],
2564
2565 [ ecase,
2566 [length, rest],
2567 [1, [setq, sys_v, [car, rest]]],
2568
2569 [ 2,
2570
2571 [ setq,
2572 sys_end,
2573 [car, rest],
2574 sys_v,
2575 [cadr, rest]
2576 ]
2577 ]
2578 ],
2579
2580 [ progn,
2581
2582 [ replace,
2583 sequence,
2584 sys_v,
2585 kw_start1,
2586 sys_start,
2587 kw_end1,
2588 sys_end
2589 ],
2590 sys_v
2591 ]
2592 ]
2593 ]))).
2594*/
2595/*
2596:- side_effect(assert_lsp(sys_pf_set_subseq,
2597 arglist_info(sys_pf_set_subseq,
2598 f_sys_pf_set_subseq,
2599 [sequence, sys_start, c38_rest, rest],
2600 arginfo{ all:[sequence, sys_start],
2601 allow_other_keys:0,
2602 aux:0,
2603 body:0,
2604 complex:[rest],
2605 env:0,
2606 key:0,
2607 names:
2608 [ sequence,
2609 sys_start,
2610 rest
2611 ],
2612 opt:0,
2613 req:[sequence, sys_start],
2614 rest:[rest],
2615 sublists:0,
2616 whole:0
2617 }))).
2618*/
2619/*
2620:- side_effect(assert_lsp(sys_pf_set_subseq, init_args(2, f_sys_pf_set_subseq))).
2621*/
2622/*
2623#+(or ABCL WAM-CL)
2624(defun %define-setf-macro (name expander inverse doc)
2625 (declare (ignore doc)) ; FIXME
2626 (when inverse
2627 (put-sysprop name 'setf-inverse inverse))
2628 (when expander
2629 (put-sysprop name 'setf-expander expander))
2630 name)
2631
2632
2633*/
2634
2635/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:11733 **********************/
2636:-lisp_compile_to_prolog(pkg_sys,[defun,'%define-setf-macro',[name,expander,inverse,doc],[declare,[ignore,doc]],[when,inverse,['put-sysprop',name,[quote,'setf-inverse'],inverse]],[when,expander,['put-sysprop',name,[quote,'setf-expander'],expander]],name])
2637wl:lambda_def(defun, sys_pf_define_setf_macro, f_sys_pf_define_setf_type_macro, [sys_name, sys_expander, sys_inverse, sys_doc], [[declare, [ignore, sys_doc]], [when, sys_inverse, [sys_put_sysprop, sys_name, [quote, sys_setf_inverse], sys_inverse]], [when, sys_expander, [sys_put_sysprop, sys_name, [quote, sys_setf_expander], sys_expander]], sys_name]).
2638wl:arglist_info(sys_pf_define_setf_macro, f_sys_pf_define_setf_type_macro, [sys_name, sys_expander, sys_inverse, sys_doc], arginfo{all:[sys_name, sys_expander, sys_inverse, sys_doc], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_name, sys_expander, sys_inverse, sys_doc], opt:0, req:[sys_name, sys_expander, sys_inverse, sys_doc], rest:0, sublists:0, whole:0}).
2639wl: init_args(4, f_sys_pf_define_setf_type_macro).
2640
2645f_sys_pf_define_setf_type_macro(Name_In, Expander_In, Inverse_In, Doc_In, RestNKeys, FnResult) :-
2646 GEnv=[bv(sys_name, Name_In), bv(sys_expander, Expander_In), bv(sys_inverse, Inverse_In), bv(sys_doc, Doc_In)],
2647 catch(( ( sf_declare(GEnv, [ignore, sys_doc], Sf_declare_Ret),
2648 get_var(GEnv, sys_inverse, IFTEST),
2649 ( IFTEST\==[]
2650 -> get_var(GEnv, sys_inverse, Inverse_Get12),
2651 get_var(GEnv, sys_name, Name_Get),
2652 f_sys_put_sysprop(Name_Get,
2653 sys_setf_inverse,
2654 Inverse_Get12,
2655 [],
2656 TrueResult),
2657 _6944=TrueResult
2658 ; _6944=[]
2659 ),
2660 get_var(GEnv, sys_expander, IFTEST14),
2661 ( IFTEST14\==[]
2662 -> get_var(GEnv, sys_expander, Expander_Get18),
2663 get_var(GEnv, sys_name, Name_Get17),
2664 f_sys_put_sysprop(Name_Get17,
2665 sys_setf_expander,
2666 Expander_Get18,
2667 [],
2668 TrueResult19),
2669 _7060=TrueResult19
2670 ; _7060=[]
2671 ),
2672 get_var(GEnv, sys_name, Name_Get20)
2673 ),
2674 Name_Get20=FnResult
2675 ),
2676 block_exit(sys_pf_define_setf_macro, FnResult),
2677 true).
2678:- set_opv(sys_pf_define_setf_macro,
2679 symbol_function,
2680 f_sys_pf_define_setf_type_macro),
2681 DefunResult=sys_pf_define_setf_macro. 2682/*
2683:- side_effect(assert_lsp(sys_pf_define_setf_macro,
2684 lambda_def(defun,
2685 sys_pf_define_setf_macro,
2686 f_sys_pf_define_setf_type_macro,
2687
2688 [ sys_name,
2689 sys_expander,
2690 sys_inverse,
2691 sys_doc
2692 ],
2693
2694 [ [declare, [ignore, sys_doc]],
2695
2696 [ when,
2697 sys_inverse,
2698
2699 [ sys_put_sysprop,
2700 sys_name,
2701 [quote, sys_setf_inverse],
2702 sys_inverse
2703 ]
2704 ],
2705
2706 [ when,
2707 sys_expander,
2708
2709 [ sys_put_sysprop,
2710 sys_name,
2711 [quote, sys_setf_expander],
2712 sys_expander
2713 ]
2714 ],
2715 sys_name
2716 ]))).
2717*/
2718/*
2719:- side_effect(assert_lsp(sys_pf_define_setf_macro,
2720 arglist_info(sys_pf_define_setf_macro,
2721 f_sys_pf_define_setf_type_macro,
2722
2723 [ sys_name,
2724 sys_expander,
2725 sys_inverse,
2726 sys_doc
2727 ],
2728 arginfo{ all:
2729 [ sys_name,
2730 sys_expander,
2731 sys_inverse,
2732 sys_doc
2733 ],
2734 allow_other_keys:0,
2735 aux:0,
2736 body:0,
2737 complex:0,
2738 env:0,
2739 key:0,
2740 names:
2741 [ sys_name,
2742 sys_expander,
2743 sys_inverse,
2744 sys_doc
2745 ],
2746 opt:0,
2747 req:
2748 [ sys_name,
2749 sys_expander,
2750 sys_inverse,
2751 sys_doc
2752 ],
2753 rest:0,
2754 sublists:0,
2755 whole:0
2756 }))).
2757*/
2758/*
2759:- side_effect(assert_lsp(sys_pf_define_setf_macro,
2760 init_args(4, f_sys_pf_define_setf_type_macro))).
2761*/
2762/*
2763 FIXME
2764*/
2765/*
2766#+(or ABCL WAM-CL)
2767(defmacro defsetf (access-function update-function)
2768 `(eval-when (:load-toplevel :compile-toplevel :execute)
2769 (put-sysprop ',access-function 'setf-inverse ',update-function)))
2770
2771
2772;; #+(or ABCL WAM-CL) (flet () ;; FLET BEGIN
2773
2774*/
2775
2776/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:11986 **********************/
2777:-lisp_compile_to_prolog(pkg_sys,[defmacro,defsetf,['access-function','update-function'],['#BQ',['eval-when',[':load-toplevel',':compile-toplevel',':execute'],['put-sysprop',[quote,['#COMMA','access-function']],[quote,'setf-inverse'],[quote,['#COMMA','update-function']]]]]])
2778/*
2779:- side_effect(generate_function_or_macro_name(
2780 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
2781 name='GLOBAL',
2782 environ=env_1
2783 ],
2784 defsetf,
2785 kw_macro,
2786 mf_defsetf)).
2787*/
2788wl:lambda_def(defmacro, defsetf, mf_defsetf, [sys_access_function, sys_update_function], [['#BQ', [eval_when, [kw_load_toplevel, kw_compile_toplevel, kw_execute], [sys_put_sysprop, [quote, ['#COMMA', sys_access_function]], [quote, sys_setf_inverse], [quote, ['#COMMA', sys_update_function]]]]]]).
2789wl:arglist_info(defsetf, mf_defsetf, [sys_access_function, sys_update_function], arginfo{all:[sys_access_function, sys_update_function], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_access_function, sys_update_function], opt:0, req:[sys_access_function, sys_update_function], rest:0, sublists:0, whole:0}).
2790wl: init_args(2, mf_defsetf).
2791
2796sf_defsetf(MacroEnv, Access_function_In, Update_function_In, RestNKeys, FResult) :-
2797 mf_defsetf([defsetf, Access_function_In, Update_function_In|RestNKeys],
2798 MacroEnv,
2799 MFResult),
2800 f_sys_env_eval(MacroEnv, MFResult, FResult).
2805mf_defsetf([defsetf, Access_function_In, Update_function_In|RestNKeys], MacroEnv, MFResult) :-
2806 nop(defmacro),
2807 GEnv=[bv(sys_access_function, Access_function_In), bv(sys_update_function, Update_function_In)],
2808 catch(( ( get_var(GEnv, sys_access_function, Access_function_Get),
2809 get_var(GEnv, sys_update_function, Update_function_Get)
2810 ),
2811 [eval_when, [kw_load_toplevel, kw_compile_toplevel, kw_execute], [sys_put_sysprop, [quote, Access_function_Get], [quote, sys_setf_inverse], [quote, Update_function_Get]]]=MFResult
2812 ),
2813 block_exit(defsetf, MFResult),
2814 true).
2815:- set_opv(mf_defsetf, type_of, sys_macro),
2816 set_opv(defsetf, symbol_function, mf_defsetf),
2817 DefMacroResult=defsetf. 2818/*
2819:- side_effect(assert_lsp(defsetf,
2820 lambda_def(defmacro,
2821 defsetf,
2822 mf_defsetf,
2823 [sys_access_function, sys_update_function],
2824
2825 [
2826 [ '#BQ',
2827
2828 [ eval_when,
2829
2830 [ kw_load_toplevel,
2831 kw_compile_toplevel,
2832 kw_execute
2833 ],
2834
2835 [ sys_put_sysprop,
2836
2837 [ quote,
2838 ['#COMMA', sys_access_function]
2839 ],
2840 [quote, sys_setf_inverse],
2841
2842 [ quote,
2843 ['#COMMA', sys_update_function]
2844 ]
2845 ]
2846 ]
2847 ]
2848 ]))).
2849*/
2850/*
2851:- side_effect(assert_lsp(defsetf,
2852 arglist_info(defsetf,
2853 mf_defsetf,
2854
2855 [ sys_access_function,
2856 sys_update_function
2857 ],
2858 arginfo{ all:
2859 [ sys_access_function,
2860 sys_update_function
2861 ],
2862 allow_other_keys:0,
2863 aux:0,
2864 body:0,
2865 complex:0,
2866 env:0,
2867 key:0,
2868 names:
2869 [ sys_access_function,
2870 sys_update_function
2871 ],
2872 opt:0,
2873 req:
2874 [ sys_access_function,
2875 sys_update_function
2876 ],
2877 rest:0,
2878 sublists:0,
2879 whole:0
2880 }))).
2881*/
2882/*
2883:- side_effect(assert_lsp(defsetf, init_args(2, mf_defsetf))).
2884*/
2885/*
2886; #+(or ABCL WAM-CL) (flet () ;; FLET BEGIN
2887*/
2888/*
2889(defun %set-caar (x v) (set-car (car x) v))
2890*/
2891
2892/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12242 **********************/
2893:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-caar',[x,v],['set-car',[car,x],v]])
2894wl:lambda_def(defun, sys_pf_set_caar, f_sys_pf_set_caar, [sys_x, sys_v], [[sys_set_car, [car, sys_x], sys_v]]).
2895wl:arglist_info(sys_pf_set_caar, f_sys_pf_set_caar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
2896wl: init_args(x, f_sys_pf_set_caar).
2897
2902f_sys_pf_set_caar(X_In, V_In, FnResult) :-
2903 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
2904 catch(( ( get_var(GEnv, sys_x, X_Get),
2905 f_car(X_Get, Set_car_Param),
2906 get_var(GEnv, sys_v, V_Get),
2907 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
2908 ),
2909 Set_car_Ret=FnResult
2910 ),
2911 block_exit(sys_pf_set_caar, FnResult),
2912 true).
2913:- set_opv(sys_pf_set_caar, symbol_function, f_sys_pf_set_caar),
2914 DefunResult=sys_pf_set_caar. 2915/*
2916:- side_effect(assert_lsp(sys_pf_set_caar,
2917 lambda_def(defun,
2918 sys_pf_set_caar,
2919 f_sys_pf_set_caar,
2920 [sys_x, sys_v],
2921 [[sys_set_car, [car, sys_x], sys_v]]))).
2922*/
2923/*
2924:- side_effect(assert_lsp(sys_pf_set_caar,
2925 arglist_info(sys_pf_set_caar,
2926 f_sys_pf_set_caar,
2927 [sys_x, sys_v],
2928 arginfo{ all:[sys_x, sys_v],
2929 allow_other_keys:0,
2930 aux:0,
2931 body:0,
2932 complex:0,
2933 env:0,
2934 key:0,
2935 names:[sys_x, sys_v],
2936 opt:0,
2937 req:[sys_x, sys_v],
2938 rest:0,
2939 sublists:0,
2940 whole:0
2941 }))).
2942*/
2943/*
2944:- side_effect(assert_lsp(sys_pf_set_caar, init_args(x, f_sys_pf_set_caar))).
2945*/
2946/*
2947(defun %set-cadr (x v) (set-car (cdr x) v))
2948*/
2949
2950/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12287 **********************/
2951:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cadr',[x,v],['set-car',[cdr,x],v]])
2952wl:lambda_def(defun, sys_pf_set_cadr, f_sys_pf_set_cadr, [sys_x, sys_v], [[sys_set_car, [cdr, sys_x], sys_v]]).
2953wl:arglist_info(sys_pf_set_cadr, f_sys_pf_set_cadr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
2954wl: init_args(x, f_sys_pf_set_cadr).
2955
2960f_sys_pf_set_cadr(X_In, V_In, FnResult) :-
2961 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
2962 catch(( ( get_var(GEnv, sys_x, X_Get),
2963 f_cdr(X_Get, Set_car_Param),
2964 get_var(GEnv, sys_v, V_Get),
2965 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
2966 ),
2967 Set_car_Ret=FnResult
2968 ),
2969 block_exit(sys_pf_set_cadr, FnResult),
2970 true).
2971:- set_opv(sys_pf_set_cadr, symbol_function, f_sys_pf_set_cadr),
2972 DefunResult=sys_pf_set_cadr. 2973/*
2974:- side_effect(assert_lsp(sys_pf_set_cadr,
2975 lambda_def(defun,
2976 sys_pf_set_cadr,
2977 f_sys_pf_set_cadr,
2978 [sys_x, sys_v],
2979 [[sys_set_car, [cdr, sys_x], sys_v]]))).
2980*/
2981/*
2982:- side_effect(assert_lsp(sys_pf_set_cadr,
2983 arglist_info(sys_pf_set_cadr,
2984 f_sys_pf_set_cadr,
2985 [sys_x, sys_v],
2986 arginfo{ all:[sys_x, sys_v],
2987 allow_other_keys:0,
2988 aux:0,
2989 body:0,
2990 complex:0,
2991 env:0,
2992 key:0,
2993 names:[sys_x, sys_v],
2994 opt:0,
2995 req:[sys_x, sys_v],
2996 rest:0,
2997 sublists:0,
2998 whole:0
2999 }))).
3000*/
3001/*
3002:- side_effect(assert_lsp(sys_pf_set_cadr, init_args(x, f_sys_pf_set_cadr))).
3003*/
3004/*
3005(defun %set-cdar (x v) (set-cdr (car x) v))
3006*/
3007
3008/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12332 **********************/
3009:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cdar',[x,v],['set-cdr',[car,x],v]])
3010wl:lambda_def(defun, sys_pf_set_cdar, f_sys_pf_set_cdar, [sys_x, sys_v], [[sys_set_cdr, [car, sys_x], sys_v]]).
3011wl:arglist_info(sys_pf_set_cdar, f_sys_pf_set_cdar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3012wl: init_args(x, f_sys_pf_set_cdar).
3013
3018f_sys_pf_set_cdar(X_In, V_In, FnResult) :-
3019 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3020 catch(( ( get_var(GEnv, sys_x, X_Get),
3021 f_car(X_Get, Set_cdr_Param),
3022 get_var(GEnv, sys_v, V_Get),
3023 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
3024 ),
3025 Set_cdr_Ret=FnResult
3026 ),
3027 block_exit(sys_pf_set_cdar, FnResult),
3028 true).
3029:- set_opv(sys_pf_set_cdar, symbol_function, f_sys_pf_set_cdar),
3030 DefunResult=sys_pf_set_cdar. 3031/*
3032:- side_effect(assert_lsp(sys_pf_set_cdar,
3033 lambda_def(defun,
3034 sys_pf_set_cdar,
3035 f_sys_pf_set_cdar,
3036 [sys_x, sys_v],
3037 [[sys_set_cdr, [car, sys_x], sys_v]]))).
3038*/
3039/*
3040:- side_effect(assert_lsp(sys_pf_set_cdar,
3041 arglist_info(sys_pf_set_cdar,
3042 f_sys_pf_set_cdar,
3043 [sys_x, sys_v],
3044 arginfo{ all:[sys_x, sys_v],
3045 allow_other_keys:0,
3046 aux:0,
3047 body:0,
3048 complex:0,
3049 env:0,
3050 key:0,
3051 names:[sys_x, sys_v],
3052 opt:0,
3053 req:[sys_x, sys_v],
3054 rest:0,
3055 sublists:0,
3056 whole:0
3057 }))).
3058*/
3059/*
3060:- side_effect(assert_lsp(sys_pf_set_cdar, init_args(x, f_sys_pf_set_cdar))).
3061*/
3062/*
3063(defun %set-cddr (x v) (set-cdr (cdr x) v))
3064*/
3065
3066/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12377 **********************/
3067:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cddr',[x,v],['set-cdr',[cdr,x],v]])
3068wl:lambda_def(defun, sys_pf_set_cddr, f_sys_pf_set_cddr, [sys_x, sys_v], [[sys_set_cdr, [cdr, sys_x], sys_v]]).
3069wl:arglist_info(sys_pf_set_cddr, f_sys_pf_set_cddr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3070wl: init_args(x, f_sys_pf_set_cddr).
3071
3076f_sys_pf_set_cddr(X_In, V_In, FnResult) :-
3077 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3078 catch(( ( get_var(GEnv, sys_x, X_Get),
3079 f_cdr(X_Get, Set_cdr_Param),
3080 get_var(GEnv, sys_v, V_Get),
3081 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
3082 ),
3083 Set_cdr_Ret=FnResult
3084 ),
3085 block_exit(sys_pf_set_cddr, FnResult),
3086 true).
3087:- set_opv(sys_pf_set_cddr, symbol_function, f_sys_pf_set_cddr),
3088 DefunResult=sys_pf_set_cddr. 3089/*
3090:- side_effect(assert_lsp(sys_pf_set_cddr,
3091 lambda_def(defun,
3092 sys_pf_set_cddr,
3093 f_sys_pf_set_cddr,
3094 [sys_x, sys_v],
3095 [[sys_set_cdr, [cdr, sys_x], sys_v]]))).
3096*/
3097/*
3098:- side_effect(assert_lsp(sys_pf_set_cddr,
3099 arglist_info(sys_pf_set_cddr,
3100 f_sys_pf_set_cddr,
3101 [sys_x, sys_v],
3102 arginfo{ all:[sys_x, sys_v],
3103 allow_other_keys:0,
3104 aux:0,
3105 body:0,
3106 complex:0,
3107 env:0,
3108 key:0,
3109 names:[sys_x, sys_v],
3110 opt:0,
3111 req:[sys_x, sys_v],
3112 rest:0,
3113 sublists:0,
3114 whole:0
3115 }))).
3116*/
3117/*
3118:- side_effect(assert_lsp(sys_pf_set_cddr, init_args(x, f_sys_pf_set_cddr))).
3119*/
3120/*
3121(defun %set-caaar (x v) (set-car (caar x) v))
3122*/
3123
3124/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12422 **********************/
3125:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-caaar',[x,v],['set-car',[caar,x],v]])
3126wl:lambda_def(defun, sys_pf_set_caaar, f_sys_pf_set_caaar, [sys_x, sys_v], [[sys_set_car, [caar, sys_x], sys_v]]).
3127wl:arglist_info(sys_pf_set_caaar, f_sys_pf_set_caaar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3128wl: init_args(x, f_sys_pf_set_caaar).
3129
3134f_sys_pf_set_caaar(X_In, V_In, FnResult) :-
3135 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3136 catch(( ( get_var(GEnv, sys_x, X_Get),
3137 f_caar(X_Get, Set_car_Param),
3138 get_var(GEnv, sys_v, V_Get),
3139 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
3140 ),
3141 Set_car_Ret=FnResult
3142 ),
3143 block_exit(sys_pf_set_caaar, FnResult),
3144 true).
3145:- set_opv(sys_pf_set_caaar, symbol_function, f_sys_pf_set_caaar),
3146 DefunResult=sys_pf_set_caaar. 3147/*
3148:- side_effect(assert_lsp(sys_pf_set_caaar,
3149 lambda_def(defun,
3150 sys_pf_set_caaar,
3151 f_sys_pf_set_caaar,
3152 [sys_x, sys_v],
3153 [[sys_set_car, [caar, sys_x], sys_v]]))).
3154*/
3155/*
3156:- side_effect(assert_lsp(sys_pf_set_caaar,
3157 arglist_info(sys_pf_set_caaar,
3158 f_sys_pf_set_caaar,
3159 [sys_x, sys_v],
3160 arginfo{ all:[sys_x, sys_v],
3161 allow_other_keys:0,
3162 aux:0,
3163 body:0,
3164 complex:0,
3165 env:0,
3166 key:0,
3167 names:[sys_x, sys_v],
3168 opt:0,
3169 req:[sys_x, sys_v],
3170 rest:0,
3171 sublists:0,
3172 whole:0
3173 }))).
3174*/
3175/*
3176:- side_effect(assert_lsp(sys_pf_set_caaar, init_args(x, f_sys_pf_set_caaar))).
3177*/
3178/*
3179(defun %set-cadar (x v) (set-car (cdar x) v))
3180*/
3181
3182/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12469 **********************/
3183:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cadar',[x,v],['set-car',[cdar,x],v]])
3184wl:lambda_def(defun, sys_pf_set_cadar, f_sys_pf_set_cadar, [sys_x, sys_v], [[sys_set_car, [cdar, sys_x], sys_v]]).
3185wl:arglist_info(sys_pf_set_cadar, f_sys_pf_set_cadar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3186wl: init_args(x, f_sys_pf_set_cadar).
3187
3192f_sys_pf_set_cadar(X_In, V_In, FnResult) :-
3193 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3194 catch(( ( get_var(GEnv, sys_x, X_Get),
3195 f_cdar(X_Get, Set_car_Param),
3196 get_var(GEnv, sys_v, V_Get),
3197 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
3198 ),
3199 Set_car_Ret=FnResult
3200 ),
3201 block_exit(sys_pf_set_cadar, FnResult),
3202 true).
3203:- set_opv(sys_pf_set_cadar, symbol_function, f_sys_pf_set_cadar),
3204 DefunResult=sys_pf_set_cadar. 3205/*
3206:- side_effect(assert_lsp(sys_pf_set_cadar,
3207 lambda_def(defun,
3208 sys_pf_set_cadar,
3209 f_sys_pf_set_cadar,
3210 [sys_x, sys_v],
3211 [[sys_set_car, [cdar, sys_x], sys_v]]))).
3212*/
3213/*
3214:- side_effect(assert_lsp(sys_pf_set_cadar,
3215 arglist_info(sys_pf_set_cadar,
3216 f_sys_pf_set_cadar,
3217 [sys_x, sys_v],
3218 arginfo{ all:[sys_x, sys_v],
3219 allow_other_keys:0,
3220 aux:0,
3221 body:0,
3222 complex:0,
3223 env:0,
3224 key:0,
3225 names:[sys_x, sys_v],
3226 opt:0,
3227 req:[sys_x, sys_v],
3228 rest:0,
3229 sublists:0,
3230 whole:0
3231 }))).
3232*/
3233/*
3234:- side_effect(assert_lsp(sys_pf_set_cadar, init_args(x, f_sys_pf_set_cadar))).
3235*/
3236/*
3237(defun %set-cdaar (x v) (set-cdr (caar x) v))
3238*/
3239
3240/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12516 **********************/
3241:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cdaar',[x,v],['set-cdr',[caar,x],v]])
3242wl:lambda_def(defun, sys_pf_set_cdaar, f_sys_pf_set_cdaar, [sys_x, sys_v], [[sys_set_cdr, [caar, sys_x], sys_v]]).
3243wl:arglist_info(sys_pf_set_cdaar, f_sys_pf_set_cdaar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3244wl: init_args(x, f_sys_pf_set_cdaar).
3245
3250f_sys_pf_set_cdaar(X_In, V_In, FnResult) :-
3251 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3252 catch(( ( get_var(GEnv, sys_x, X_Get),
3253 f_caar(X_Get, Set_cdr_Param),
3254 get_var(GEnv, sys_v, V_Get),
3255 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
3256 ),
3257 Set_cdr_Ret=FnResult
3258 ),
3259 block_exit(sys_pf_set_cdaar, FnResult),
3260 true).
3261:- set_opv(sys_pf_set_cdaar, symbol_function, f_sys_pf_set_cdaar),
3262 DefunResult=sys_pf_set_cdaar. 3263/*
3264:- side_effect(assert_lsp(sys_pf_set_cdaar,
3265 lambda_def(defun,
3266 sys_pf_set_cdaar,
3267 f_sys_pf_set_cdaar,
3268 [sys_x, sys_v],
3269 [[sys_set_cdr, [caar, sys_x], sys_v]]))).
3270*/
3271/*
3272:- side_effect(assert_lsp(sys_pf_set_cdaar,
3273 arglist_info(sys_pf_set_cdaar,
3274 f_sys_pf_set_cdaar,
3275 [sys_x, sys_v],
3276 arginfo{ all:[sys_x, sys_v],
3277 allow_other_keys:0,
3278 aux:0,
3279 body:0,
3280 complex:0,
3281 env:0,
3282 key:0,
3283 names:[sys_x, sys_v],
3284 opt:0,
3285 req:[sys_x, sys_v],
3286 rest:0,
3287 sublists:0,
3288 whole:0
3289 }))).
3290*/
3291/*
3292:- side_effect(assert_lsp(sys_pf_set_cdaar, init_args(x, f_sys_pf_set_cdaar))).
3293*/
3294/*
3295(defun %set-cddar (x v) (set-cdr (cdar x) v))
3296*/
3297
3298/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12563 **********************/
3299:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cddar',[x,v],['set-cdr',[cdar,x],v]])
3300wl:lambda_def(defun, sys_pf_set_cddar, f_sys_pf_set_cddar, [sys_x, sys_v], [[sys_set_cdr, [cdar, sys_x], sys_v]]).
3301wl:arglist_info(sys_pf_set_cddar, f_sys_pf_set_cddar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3302wl: init_args(x, f_sys_pf_set_cddar).
3303
3308f_sys_pf_set_cddar(X_In, V_In, FnResult) :-
3309 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3310 catch(( ( get_var(GEnv, sys_x, X_Get),
3311 f_cdar(X_Get, Set_cdr_Param),
3312 get_var(GEnv, sys_v, V_Get),
3313 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
3314 ),
3315 Set_cdr_Ret=FnResult
3316 ),
3317 block_exit(sys_pf_set_cddar, FnResult),
3318 true).
3319:- set_opv(sys_pf_set_cddar, symbol_function, f_sys_pf_set_cddar),
3320 DefunResult=sys_pf_set_cddar. 3321/*
3322:- side_effect(assert_lsp(sys_pf_set_cddar,
3323 lambda_def(defun,
3324 sys_pf_set_cddar,
3325 f_sys_pf_set_cddar,
3326 [sys_x, sys_v],
3327 [[sys_set_cdr, [cdar, sys_x], sys_v]]))).
3328*/
3329/*
3330:- side_effect(assert_lsp(sys_pf_set_cddar,
3331 arglist_info(sys_pf_set_cddar,
3332 f_sys_pf_set_cddar,
3333 [sys_x, sys_v],
3334 arginfo{ all:[sys_x, sys_v],
3335 allow_other_keys:0,
3336 aux:0,
3337 body:0,
3338 complex:0,
3339 env:0,
3340 key:0,
3341 names:[sys_x, sys_v],
3342 opt:0,
3343 req:[sys_x, sys_v],
3344 rest:0,
3345 sublists:0,
3346 whole:0
3347 }))).
3348*/
3349/*
3350:- side_effect(assert_lsp(sys_pf_set_cddar, init_args(x, f_sys_pf_set_cddar))).
3351*/
3352/*
3353(defun %set-caadr (x v) (set-car (cadr x) v))
3354*/
3355
3356/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12610 **********************/
3357:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-caadr',[x,v],['set-car',[cadr,x],v]])
3358wl:lambda_def(defun, sys_pf_set_caadr, f_sys_pf_set_caadr, [sys_x, sys_v], [[sys_set_car, [cadr, sys_x], sys_v]]).
3359wl:arglist_info(sys_pf_set_caadr, f_sys_pf_set_caadr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3360wl: init_args(x, f_sys_pf_set_caadr).
3361
3366f_sys_pf_set_caadr(X_In, V_In, FnResult) :-
3367 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3368 catch(( ( get_var(GEnv, sys_x, X_Get),
3369 f_cadr(X_Get, Set_car_Param),
3370 get_var(GEnv, sys_v, V_Get),
3371 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
3372 ),
3373 Set_car_Ret=FnResult
3374 ),
3375 block_exit(sys_pf_set_caadr, FnResult),
3376 true).
3377:- set_opv(sys_pf_set_caadr, symbol_function, f_sys_pf_set_caadr),
3378 DefunResult=sys_pf_set_caadr. 3379/*
3380:- side_effect(assert_lsp(sys_pf_set_caadr,
3381 lambda_def(defun,
3382 sys_pf_set_caadr,
3383 f_sys_pf_set_caadr,
3384 [sys_x, sys_v],
3385 [[sys_set_car, [cadr, sys_x], sys_v]]))).
3386*/
3387/*
3388:- side_effect(assert_lsp(sys_pf_set_caadr,
3389 arglist_info(sys_pf_set_caadr,
3390 f_sys_pf_set_caadr,
3391 [sys_x, sys_v],
3392 arginfo{ all:[sys_x, sys_v],
3393 allow_other_keys:0,
3394 aux:0,
3395 body:0,
3396 complex:0,
3397 env:0,
3398 key:0,
3399 names:[sys_x, sys_v],
3400 opt:0,
3401 req:[sys_x, sys_v],
3402 rest:0,
3403 sublists:0,
3404 whole:0
3405 }))).
3406*/
3407/*
3408:- side_effect(assert_lsp(sys_pf_set_caadr, init_args(x, f_sys_pf_set_caadr))).
3409*/
3410/*
3411(defun %set-caddr (x v) (set-car (cddr x) v))
3412*/
3413
3414/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12657 **********************/
3415:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-caddr',[x,v],['set-car',[cddr,x],v]])
3416wl:lambda_def(defun, sys_pf_set_caddr, f_sys_pf_set_caddr, [sys_x, sys_v], [[sys_set_car, [cddr, sys_x], sys_v]]).
3417wl:arglist_info(sys_pf_set_caddr, f_sys_pf_set_caddr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3418wl: init_args(x, f_sys_pf_set_caddr).
3419
3424f_sys_pf_set_caddr(X_In, V_In, FnResult) :-
3425 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3426 catch(( ( get_var(GEnv, sys_x, X_Get),
3427 f_cddr(X_Get, Set_car_Param),
3428 get_var(GEnv, sys_v, V_Get),
3429 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
3430 ),
3431 Set_car_Ret=FnResult
3432 ),
3433 block_exit(sys_pf_set_caddr, FnResult),
3434 true).
3435:- set_opv(sys_pf_set_caddr, symbol_function, f_sys_pf_set_caddr),
3436 DefunResult=sys_pf_set_caddr. 3437/*
3438:- side_effect(assert_lsp(sys_pf_set_caddr,
3439 lambda_def(defun,
3440 sys_pf_set_caddr,
3441 f_sys_pf_set_caddr,
3442 [sys_x, sys_v],
3443 [[sys_set_car, [cddr, sys_x], sys_v]]))).
3444*/
3445/*
3446:- side_effect(assert_lsp(sys_pf_set_caddr,
3447 arglist_info(sys_pf_set_caddr,
3448 f_sys_pf_set_caddr,
3449 [sys_x, sys_v],
3450 arginfo{ all:[sys_x, sys_v],
3451 allow_other_keys:0,
3452 aux:0,
3453 body:0,
3454 complex:0,
3455 env:0,
3456 key:0,
3457 names:[sys_x, sys_v],
3458 opt:0,
3459 req:[sys_x, sys_v],
3460 rest:0,
3461 sublists:0,
3462 whole:0
3463 }))).
3464*/
3465/*
3466:- side_effect(assert_lsp(sys_pf_set_caddr, init_args(x, f_sys_pf_set_caddr))).
3467*/
3468/*
3469(defun %set-cdadr (x v) (set-cdr (cadr x) v))
3470*/
3471
3472/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12704 **********************/
3473:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cdadr',[x,v],['set-cdr',[cadr,x],v]])
3474wl:lambda_def(defun, sys_pf_set_cdadr, f_sys_pf_set_cdadr, [sys_x, sys_v], [[sys_set_cdr, [cadr, sys_x], sys_v]]).
3475wl:arglist_info(sys_pf_set_cdadr, f_sys_pf_set_cdadr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3476wl: init_args(x, f_sys_pf_set_cdadr).
3477
3482f_sys_pf_set_cdadr(X_In, V_In, FnResult) :-
3483 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3484 catch(( ( get_var(GEnv, sys_x, X_Get),
3485 f_cadr(X_Get, Set_cdr_Param),
3486 get_var(GEnv, sys_v, V_Get),
3487 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
3488 ),
3489 Set_cdr_Ret=FnResult
3490 ),
3491 block_exit(sys_pf_set_cdadr, FnResult),
3492 true).
3493:- set_opv(sys_pf_set_cdadr, symbol_function, f_sys_pf_set_cdadr),
3494 DefunResult=sys_pf_set_cdadr. 3495/*
3496:- side_effect(assert_lsp(sys_pf_set_cdadr,
3497 lambda_def(defun,
3498 sys_pf_set_cdadr,
3499 f_sys_pf_set_cdadr,
3500 [sys_x, sys_v],
3501 [[sys_set_cdr, [cadr, sys_x], sys_v]]))).
3502*/
3503/*
3504:- side_effect(assert_lsp(sys_pf_set_cdadr,
3505 arglist_info(sys_pf_set_cdadr,
3506 f_sys_pf_set_cdadr,
3507 [sys_x, sys_v],
3508 arginfo{ all:[sys_x, sys_v],
3509 allow_other_keys:0,
3510 aux:0,
3511 body:0,
3512 complex:0,
3513 env:0,
3514 key:0,
3515 names:[sys_x, sys_v],
3516 opt:0,
3517 req:[sys_x, sys_v],
3518 rest:0,
3519 sublists:0,
3520 whole:0
3521 }))).
3522*/
3523/*
3524:- side_effect(assert_lsp(sys_pf_set_cdadr, init_args(x, f_sys_pf_set_cdadr))).
3525*/
3526/*
3527(defun %set-cdddr (x v) (set-cdr (cddr x) v))
3528*/
3529
3530/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12751 **********************/
3531:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cdddr',[x,v],['set-cdr',[cddr,x],v]])
3532wl:lambda_def(defun, sys_pf_set_cdddr, f_sys_pf_set_cdddr, [sys_x, sys_v], [[sys_set_cdr, [cddr, sys_x], sys_v]]).
3533wl:arglist_info(sys_pf_set_cdddr, f_sys_pf_set_cdddr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3534wl: init_args(x, f_sys_pf_set_cdddr).
3535
3540f_sys_pf_set_cdddr(X_In, V_In, FnResult) :-
3541 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3542 catch(( ( get_var(GEnv, sys_x, X_Get),
3543 f_cddr(X_Get, Set_cdr_Param),
3544 get_var(GEnv, sys_v, V_Get),
3545 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
3546 ),
3547 Set_cdr_Ret=FnResult
3548 ),
3549 block_exit(sys_pf_set_cdddr, FnResult),
3550 true).
3551:- set_opv(sys_pf_set_cdddr, symbol_function, f_sys_pf_set_cdddr),
3552 DefunResult=sys_pf_set_cdddr. 3553/*
3554:- side_effect(assert_lsp(sys_pf_set_cdddr,
3555 lambda_def(defun,
3556 sys_pf_set_cdddr,
3557 f_sys_pf_set_cdddr,
3558 [sys_x, sys_v],
3559 [[sys_set_cdr, [cddr, sys_x], sys_v]]))).
3560*/
3561/*
3562:- side_effect(assert_lsp(sys_pf_set_cdddr,
3563 arglist_info(sys_pf_set_cdddr,
3564 f_sys_pf_set_cdddr,
3565 [sys_x, sys_v],
3566 arginfo{ all:[sys_x, sys_v],
3567 allow_other_keys:0,
3568 aux:0,
3569 body:0,
3570 complex:0,
3571 env:0,
3572 key:0,
3573 names:[sys_x, sys_v],
3574 opt:0,
3575 req:[sys_x, sys_v],
3576 rest:0,
3577 sublists:0,
3578 whole:0
3579 }))).
3580*/
3581/*
3582:- side_effect(assert_lsp(sys_pf_set_cdddr, init_args(x, f_sys_pf_set_cdddr))).
3583*/
3584/*
3585(defun %set-caaaar (x v) (set-car (caaar x) v))
3586*/
3587
3588/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12798 **********************/
3589:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-caaaar',[x,v],['set-car',[caaar,x],v]])
3590wl:lambda_def(defun, sys_pf_set_caaaar, f_sys_pf_set_caaaar, [sys_x, sys_v], [[sys_set_car, [caaar, sys_x], sys_v]]).
3591wl:arglist_info(sys_pf_set_caaaar, f_sys_pf_set_caaaar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3592wl: init_args(x, f_sys_pf_set_caaaar).
3593
3598f_sys_pf_set_caaaar(X_In, V_In, FnResult) :-
3599 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3600 catch(( ( get_var(GEnv, sys_x, X_Get),
3601 f_caaar(X_Get, Set_car_Param),
3602 get_var(GEnv, sys_v, V_Get),
3603 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
3604 ),
3605 Set_car_Ret=FnResult
3606 ),
3607 block_exit(sys_pf_set_caaaar, FnResult),
3608 true).
3609:- set_opv(sys_pf_set_caaaar, symbol_function, f_sys_pf_set_caaaar),
3610 DefunResult=sys_pf_set_caaaar. 3611/*
3612:- side_effect(assert_lsp(sys_pf_set_caaaar,
3613 lambda_def(defun,
3614 sys_pf_set_caaaar,
3615 f_sys_pf_set_caaaar,
3616 [sys_x, sys_v],
3617 [[sys_set_car, [caaar, sys_x], sys_v]]))).
3618*/
3619/*
3620:- side_effect(assert_lsp(sys_pf_set_caaaar,
3621 arglist_info(sys_pf_set_caaaar,
3622 f_sys_pf_set_caaaar,
3623 [sys_x, sys_v],
3624 arginfo{ all:[sys_x, sys_v],
3625 allow_other_keys:0,
3626 aux:0,
3627 body:0,
3628 complex:0,
3629 env:0,
3630 key:0,
3631 names:[sys_x, sys_v],
3632 opt:0,
3633 req:[sys_x, sys_v],
3634 rest:0,
3635 sublists:0,
3636 whole:0
3637 }))).
3638*/
3639/*
3640:- side_effect(assert_lsp(sys_pf_set_caaaar, init_args(x, f_sys_pf_set_caaaar))).
3641*/
3642/*
3643(defun %set-cadaar (x v) (set-car (cdaar x) v))
3644*/
3645
3646/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12847 **********************/
3647:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cadaar',[x,v],['set-car',[cdaar,x],v]])
3648wl:lambda_def(defun, sys_pf_set_cadaar, f_sys_pf_set_cadaar, [sys_x, sys_v], [[sys_set_car, [cdaar, sys_x], sys_v]]).
3649wl:arglist_info(sys_pf_set_cadaar, f_sys_pf_set_cadaar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3650wl: init_args(x, f_sys_pf_set_cadaar).
3651
3656f_sys_pf_set_cadaar(X_In, V_In, FnResult) :-
3657 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3658 catch(( ( get_var(GEnv, sys_x, X_Get),
3659 f_cdaar(X_Get, Set_car_Param),
3660 get_var(GEnv, sys_v, V_Get),
3661 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
3662 ),
3663 Set_car_Ret=FnResult
3664 ),
3665 block_exit(sys_pf_set_cadaar, FnResult),
3666 true).
3667:- set_opv(sys_pf_set_cadaar, symbol_function, f_sys_pf_set_cadaar),
3668 DefunResult=sys_pf_set_cadaar. 3669/*
3670:- side_effect(assert_lsp(sys_pf_set_cadaar,
3671 lambda_def(defun,
3672 sys_pf_set_cadaar,
3673 f_sys_pf_set_cadaar,
3674 [sys_x, sys_v],
3675 [[sys_set_car, [cdaar, sys_x], sys_v]]))).
3676*/
3677/*
3678:- side_effect(assert_lsp(sys_pf_set_cadaar,
3679 arglist_info(sys_pf_set_cadaar,
3680 f_sys_pf_set_cadaar,
3681 [sys_x, sys_v],
3682 arginfo{ all:[sys_x, sys_v],
3683 allow_other_keys:0,
3684 aux:0,
3685 body:0,
3686 complex:0,
3687 env:0,
3688 key:0,
3689 names:[sys_x, sys_v],
3690 opt:0,
3691 req:[sys_x, sys_v],
3692 rest:0,
3693 sublists:0,
3694 whole:0
3695 }))).
3696*/
3697/*
3698:- side_effect(assert_lsp(sys_pf_set_cadaar, init_args(x, f_sys_pf_set_cadaar))).
3699*/
3700/*
3701(defun %set-cdaaar (x v) (set-cdr (caaar x) v))
3702*/
3703
3704/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12896 **********************/
3705:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cdaaar',[x,v],['set-cdr',[caaar,x],v]])
3706wl:lambda_def(defun, sys_pf_set_cdaaar, f_sys_pf_set_cdaaar, [sys_x, sys_v], [[sys_set_cdr, [caaar, sys_x], sys_v]]).
3707wl:arglist_info(sys_pf_set_cdaaar, f_sys_pf_set_cdaaar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3708wl: init_args(x, f_sys_pf_set_cdaaar).
3709
3714f_sys_pf_set_cdaaar(X_In, V_In, FnResult) :-
3715 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3716 catch(( ( get_var(GEnv, sys_x, X_Get),
3717 f_caaar(X_Get, Set_cdr_Param),
3718 get_var(GEnv, sys_v, V_Get),
3719 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
3720 ),
3721 Set_cdr_Ret=FnResult
3722 ),
3723 block_exit(sys_pf_set_cdaaar, FnResult),
3724 true).
3725:- set_opv(sys_pf_set_cdaaar, symbol_function, f_sys_pf_set_cdaaar),
3726 DefunResult=sys_pf_set_cdaaar. 3727/*
3728:- side_effect(assert_lsp(sys_pf_set_cdaaar,
3729 lambda_def(defun,
3730 sys_pf_set_cdaaar,
3731 f_sys_pf_set_cdaaar,
3732 [sys_x, sys_v],
3733 [[sys_set_cdr, [caaar, sys_x], sys_v]]))).
3734*/
3735/*
3736:- side_effect(assert_lsp(sys_pf_set_cdaaar,
3737 arglist_info(sys_pf_set_cdaaar,
3738 f_sys_pf_set_cdaaar,
3739 [sys_x, sys_v],
3740 arginfo{ all:[sys_x, sys_v],
3741 allow_other_keys:0,
3742 aux:0,
3743 body:0,
3744 complex:0,
3745 env:0,
3746 key:0,
3747 names:[sys_x, sys_v],
3748 opt:0,
3749 req:[sys_x, sys_v],
3750 rest:0,
3751 sublists:0,
3752 whole:0
3753 }))).
3754*/
3755/*
3756:- side_effect(assert_lsp(sys_pf_set_cdaaar, init_args(x, f_sys_pf_set_cdaaar))).
3757*/
3758/*
3759(defun %set-cddaar (x v) (set-cdr (cdaar x) v))
3760*/
3761
3762/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12945 **********************/
3763:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cddaar',[x,v],['set-cdr',[cdaar,x],v]])
3764wl:lambda_def(defun, sys_pf_set_cddaar, f_sys_pf_set_cddaar, [sys_x, sys_v], [[sys_set_cdr, [cdaar, sys_x], sys_v]]).
3765wl:arglist_info(sys_pf_set_cddaar, f_sys_pf_set_cddaar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3766wl: init_args(x, f_sys_pf_set_cddaar).
3767
3772f_sys_pf_set_cddaar(X_In, V_In, FnResult) :-
3773 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3774 catch(( ( get_var(GEnv, sys_x, X_Get),
3775 f_cdaar(X_Get, Set_cdr_Param),
3776 get_var(GEnv, sys_v, V_Get),
3777 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
3778 ),
3779 Set_cdr_Ret=FnResult
3780 ),
3781 block_exit(sys_pf_set_cddaar, FnResult),
3782 true).
3783:- set_opv(sys_pf_set_cddaar, symbol_function, f_sys_pf_set_cddaar),
3784 DefunResult=sys_pf_set_cddaar. 3785/*
3786:- side_effect(assert_lsp(sys_pf_set_cddaar,
3787 lambda_def(defun,
3788 sys_pf_set_cddaar,
3789 f_sys_pf_set_cddaar,
3790 [sys_x, sys_v],
3791 [[sys_set_cdr, [cdaar, sys_x], sys_v]]))).
3792*/
3793/*
3794:- side_effect(assert_lsp(sys_pf_set_cddaar,
3795 arglist_info(sys_pf_set_cddaar,
3796 f_sys_pf_set_cddaar,
3797 [sys_x, sys_v],
3798 arginfo{ all:[sys_x, sys_v],
3799 allow_other_keys:0,
3800 aux:0,
3801 body:0,
3802 complex:0,
3803 env:0,
3804 key:0,
3805 names:[sys_x, sys_v],
3806 opt:0,
3807 req:[sys_x, sys_v],
3808 rest:0,
3809 sublists:0,
3810 whole:0
3811 }))).
3812*/
3813/*
3814:- side_effect(assert_lsp(sys_pf_set_cddaar, init_args(x, f_sys_pf_set_cddaar))).
3815*/
3816/*
3817(defun %set-caadar (x v) (set-car (cadar x) v))
3818*/
3819
3820/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:12994 **********************/
3821:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-caadar',[x,v],['set-car',[cadar,x],v]])
3822wl:lambda_def(defun, sys_pf_set_caadar, f_sys_pf_set_caadar, [sys_x, sys_v], [[sys_set_car, [cadar, sys_x], sys_v]]).
3823wl:arglist_info(sys_pf_set_caadar, f_sys_pf_set_caadar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3824wl: init_args(x, f_sys_pf_set_caadar).
3825
3830f_sys_pf_set_caadar(X_In, V_In, FnResult) :-
3831 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3832 catch(( ( get_var(GEnv, sys_x, X_Get),
3833 f_cadar(X_Get, Set_car_Param),
3834 get_var(GEnv, sys_v, V_Get),
3835 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
3836 ),
3837 Set_car_Ret=FnResult
3838 ),
3839 block_exit(sys_pf_set_caadar, FnResult),
3840 true).
3841:- set_opv(sys_pf_set_caadar, symbol_function, f_sys_pf_set_caadar),
3842 DefunResult=sys_pf_set_caadar. 3843/*
3844:- side_effect(assert_lsp(sys_pf_set_caadar,
3845 lambda_def(defun,
3846 sys_pf_set_caadar,
3847 f_sys_pf_set_caadar,
3848 [sys_x, sys_v],
3849 [[sys_set_car, [cadar, sys_x], sys_v]]))).
3850*/
3851/*
3852:- side_effect(assert_lsp(sys_pf_set_caadar,
3853 arglist_info(sys_pf_set_caadar,
3854 f_sys_pf_set_caadar,
3855 [sys_x, sys_v],
3856 arginfo{ all:[sys_x, sys_v],
3857 allow_other_keys:0,
3858 aux:0,
3859 body:0,
3860 complex:0,
3861 env:0,
3862 key:0,
3863 names:[sys_x, sys_v],
3864 opt:0,
3865 req:[sys_x, sys_v],
3866 rest:0,
3867 sublists:0,
3868 whole:0
3869 }))).
3870*/
3871/*
3872:- side_effect(assert_lsp(sys_pf_set_caadar, init_args(x, f_sys_pf_set_caadar))).
3873*/
3874/*
3875(defun %set-caddar (x v) (set-car (cddar x) v))
3876*/
3877
3878/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13043 **********************/
3879:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-caddar',[x,v],['set-car',[cddar,x],v]])
3880wl:lambda_def(defun, sys_pf_set_caddar, f_sys_pf_set_caddar, [sys_x, sys_v], [[sys_set_car, [cddar, sys_x], sys_v]]).
3881wl:arglist_info(sys_pf_set_caddar, f_sys_pf_set_caddar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3882wl: init_args(x, f_sys_pf_set_caddar).
3883
3888f_sys_pf_set_caddar(X_In, V_In, FnResult) :-
3889 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3890 catch(( ( get_var(GEnv, sys_x, X_Get),
3891 f_cddar(X_Get, Set_car_Param),
3892 get_var(GEnv, sys_v, V_Get),
3893 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
3894 ),
3895 Set_car_Ret=FnResult
3896 ),
3897 block_exit(sys_pf_set_caddar, FnResult),
3898 true).
3899:- set_opv(sys_pf_set_caddar, symbol_function, f_sys_pf_set_caddar),
3900 DefunResult=sys_pf_set_caddar. 3901/*
3902:- side_effect(assert_lsp(sys_pf_set_caddar,
3903 lambda_def(defun,
3904 sys_pf_set_caddar,
3905 f_sys_pf_set_caddar,
3906 [sys_x, sys_v],
3907 [[sys_set_car, [cddar, sys_x], sys_v]]))).
3908*/
3909/*
3910:- side_effect(assert_lsp(sys_pf_set_caddar,
3911 arglist_info(sys_pf_set_caddar,
3912 f_sys_pf_set_caddar,
3913 [sys_x, sys_v],
3914 arginfo{ all:[sys_x, sys_v],
3915 allow_other_keys:0,
3916 aux:0,
3917 body:0,
3918 complex:0,
3919 env:0,
3920 key:0,
3921 names:[sys_x, sys_v],
3922 opt:0,
3923 req:[sys_x, sys_v],
3924 rest:0,
3925 sublists:0,
3926 whole:0
3927 }))).
3928*/
3929/*
3930:- side_effect(assert_lsp(sys_pf_set_caddar, init_args(x, f_sys_pf_set_caddar))).
3931*/
3932/*
3933(defun %set-cdadar (x v) (set-cdr (cadar x) v))
3934*/
3935
3936/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13092 **********************/
3937:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cdadar',[x,v],['set-cdr',[cadar,x],v]])
3938wl:lambda_def(defun, sys_pf_set_cdadar, f_sys_pf_set_cdadar, [sys_x, sys_v], [[sys_set_cdr, [cadar, sys_x], sys_v]]).
3939wl:arglist_info(sys_pf_set_cdadar, f_sys_pf_set_cdadar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3940wl: init_args(x, f_sys_pf_set_cdadar).
3941
3946f_sys_pf_set_cdadar(X_In, V_In, FnResult) :-
3947 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
3948 catch(( ( get_var(GEnv, sys_x, X_Get),
3949 f_cadar(X_Get, Set_cdr_Param),
3950 get_var(GEnv, sys_v, V_Get),
3951 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
3952 ),
3953 Set_cdr_Ret=FnResult
3954 ),
3955 block_exit(sys_pf_set_cdadar, FnResult),
3956 true).
3957:- set_opv(sys_pf_set_cdadar, symbol_function, f_sys_pf_set_cdadar),
3958 DefunResult=sys_pf_set_cdadar. 3959/*
3960:- side_effect(assert_lsp(sys_pf_set_cdadar,
3961 lambda_def(defun,
3962 sys_pf_set_cdadar,
3963 f_sys_pf_set_cdadar,
3964 [sys_x, sys_v],
3965 [[sys_set_cdr, [cadar, sys_x], sys_v]]))).
3966*/
3967/*
3968:- side_effect(assert_lsp(sys_pf_set_cdadar,
3969 arglist_info(sys_pf_set_cdadar,
3970 f_sys_pf_set_cdadar,
3971 [sys_x, sys_v],
3972 arginfo{ all:[sys_x, sys_v],
3973 allow_other_keys:0,
3974 aux:0,
3975 body:0,
3976 complex:0,
3977 env:0,
3978 key:0,
3979 names:[sys_x, sys_v],
3980 opt:0,
3981 req:[sys_x, sys_v],
3982 rest:0,
3983 sublists:0,
3984 whole:0
3985 }))).
3986*/
3987/*
3988:- side_effect(assert_lsp(sys_pf_set_cdadar, init_args(x, f_sys_pf_set_cdadar))).
3989*/
3990/*
3991(defun %set-cdddar (x v) (set-cdr (cddar x) v))
3992*/
3993
3994/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13141 **********************/
3995:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cdddar',[x,v],['set-cdr',[cddar,x],v]])
3996wl:lambda_def(defun, sys_pf_set_cdddar, f_sys_pf_set_cdddar, [sys_x, sys_v], [[sys_set_cdr, [cddar, sys_x], sys_v]]).
3997wl:arglist_info(sys_pf_set_cdddar, f_sys_pf_set_cdddar, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
3998wl: init_args(x, f_sys_pf_set_cdddar).
3999
4004f_sys_pf_set_cdddar(X_In, V_In, FnResult) :-
4005 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
4006 catch(( ( get_var(GEnv, sys_x, X_Get),
4007 f_cddar(X_Get, Set_cdr_Param),
4008 get_var(GEnv, sys_v, V_Get),
4009 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
4010 ),
4011 Set_cdr_Ret=FnResult
4012 ),
4013 block_exit(sys_pf_set_cdddar, FnResult),
4014 true).
4015:- set_opv(sys_pf_set_cdddar, symbol_function, f_sys_pf_set_cdddar),
4016 DefunResult=sys_pf_set_cdddar. 4017/*
4018:- side_effect(assert_lsp(sys_pf_set_cdddar,
4019 lambda_def(defun,
4020 sys_pf_set_cdddar,
4021 f_sys_pf_set_cdddar,
4022 [sys_x, sys_v],
4023 [[sys_set_cdr, [cddar, sys_x], sys_v]]))).
4024*/
4025/*
4026:- side_effect(assert_lsp(sys_pf_set_cdddar,
4027 arglist_info(sys_pf_set_cdddar,
4028 f_sys_pf_set_cdddar,
4029 [sys_x, sys_v],
4030 arginfo{ all:[sys_x, sys_v],
4031 allow_other_keys:0,
4032 aux:0,
4033 body:0,
4034 complex:0,
4035 env:0,
4036 key:0,
4037 names:[sys_x, sys_v],
4038 opt:0,
4039 req:[sys_x, sys_v],
4040 rest:0,
4041 sublists:0,
4042 whole:0
4043 }))).
4044*/
4045/*
4046:- side_effect(assert_lsp(sys_pf_set_cdddar, init_args(x, f_sys_pf_set_cdddar))).
4047*/
4048/*
4049(defun %set-caaadr (x v) (set-car (caadr x) v))
4050*/
4051
4052/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13190 **********************/
4053:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-caaadr',[x,v],['set-car',[caadr,x],v]])
4054wl:lambda_def(defun, sys_pf_set_caaadr, f_sys_pf_set_caaadr, [sys_x, sys_v], [[sys_set_car, [caadr, sys_x], sys_v]]).
4055wl:arglist_info(sys_pf_set_caaadr, f_sys_pf_set_caaadr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
4056wl: init_args(x, f_sys_pf_set_caaadr).
4057
4062f_sys_pf_set_caaadr(X_In, V_In, FnResult) :-
4063 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
4064 catch(( ( get_var(GEnv, sys_x, X_Get),
4065 f_caadr(X_Get, Set_car_Param),
4066 get_var(GEnv, sys_v, V_Get),
4067 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
4068 ),
4069 Set_car_Ret=FnResult
4070 ),
4071 block_exit(sys_pf_set_caaadr, FnResult),
4072 true).
4073:- set_opv(sys_pf_set_caaadr, symbol_function, f_sys_pf_set_caaadr),
4074 DefunResult=sys_pf_set_caaadr. 4075/*
4076:- side_effect(assert_lsp(sys_pf_set_caaadr,
4077 lambda_def(defun,
4078 sys_pf_set_caaadr,
4079 f_sys_pf_set_caaadr,
4080 [sys_x, sys_v],
4081 [[sys_set_car, [caadr, sys_x], sys_v]]))).
4082*/
4083/*
4084:- side_effect(assert_lsp(sys_pf_set_caaadr,
4085 arglist_info(sys_pf_set_caaadr,
4086 f_sys_pf_set_caaadr,
4087 [sys_x, sys_v],
4088 arginfo{ all:[sys_x, sys_v],
4089 allow_other_keys:0,
4090 aux:0,
4091 body:0,
4092 complex:0,
4093 env:0,
4094 key:0,
4095 names:[sys_x, sys_v],
4096 opt:0,
4097 req:[sys_x, sys_v],
4098 rest:0,
4099 sublists:0,
4100 whole:0
4101 }))).
4102*/
4103/*
4104:- side_effect(assert_lsp(sys_pf_set_caaadr, init_args(x, f_sys_pf_set_caaadr))).
4105*/
4106/*
4107(defun %set-cadadr (x v) (set-car (cdadr x) v))
4108*/
4109
4110/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13239 **********************/
4111:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cadadr',[x,v],['set-car',[cdadr,x],v]])
4112wl:lambda_def(defun, sys_pf_set_cadadr, f_sys_pf_set_cadadr, [sys_x, sys_v], [[sys_set_car, [cdadr, sys_x], sys_v]]).
4113wl:arglist_info(sys_pf_set_cadadr, f_sys_pf_set_cadadr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
4114wl: init_args(x, f_sys_pf_set_cadadr).
4115
4120f_sys_pf_set_cadadr(X_In, V_In, FnResult) :-
4121 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
4122 catch(( ( get_var(GEnv, sys_x, X_Get),
4123 f_cdadr(X_Get, Set_car_Param),
4124 get_var(GEnv, sys_v, V_Get),
4125 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
4126 ),
4127 Set_car_Ret=FnResult
4128 ),
4129 block_exit(sys_pf_set_cadadr, FnResult),
4130 true).
4131:- set_opv(sys_pf_set_cadadr, symbol_function, f_sys_pf_set_cadadr),
4132 DefunResult=sys_pf_set_cadadr. 4133/*
4134:- side_effect(assert_lsp(sys_pf_set_cadadr,
4135 lambda_def(defun,
4136 sys_pf_set_cadadr,
4137 f_sys_pf_set_cadadr,
4138 [sys_x, sys_v],
4139 [[sys_set_car, [cdadr, sys_x], sys_v]]))).
4140*/
4141/*
4142:- side_effect(assert_lsp(sys_pf_set_cadadr,
4143 arglist_info(sys_pf_set_cadadr,
4144 f_sys_pf_set_cadadr,
4145 [sys_x, sys_v],
4146 arginfo{ all:[sys_x, sys_v],
4147 allow_other_keys:0,
4148 aux:0,
4149 body:0,
4150 complex:0,
4151 env:0,
4152 key:0,
4153 names:[sys_x, sys_v],
4154 opt:0,
4155 req:[sys_x, sys_v],
4156 rest:0,
4157 sublists:0,
4158 whole:0
4159 }))).
4160*/
4161/*
4162:- side_effect(assert_lsp(sys_pf_set_cadadr, init_args(x, f_sys_pf_set_cadadr))).
4163*/
4164/*
4165(defun %set-cdaadr (x v) (set-cdr (caadr x) v))
4166*/
4167
4168/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13288 **********************/
4169:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cdaadr',[x,v],['set-cdr',[caadr,x],v]])
4170wl:lambda_def(defun, sys_pf_set_cdaadr, f_sys_pf_set_cdaadr, [sys_x, sys_v], [[sys_set_cdr, [caadr, sys_x], sys_v]]).
4171wl:arglist_info(sys_pf_set_cdaadr, f_sys_pf_set_cdaadr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
4172wl: init_args(x, f_sys_pf_set_cdaadr).
4173
4178f_sys_pf_set_cdaadr(X_In, V_In, FnResult) :-
4179 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
4180 catch(( ( get_var(GEnv, sys_x, X_Get),
4181 f_caadr(X_Get, Set_cdr_Param),
4182 get_var(GEnv, sys_v, V_Get),
4183 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
4184 ),
4185 Set_cdr_Ret=FnResult
4186 ),
4187 block_exit(sys_pf_set_cdaadr, FnResult),
4188 true).
4189:- set_opv(sys_pf_set_cdaadr, symbol_function, f_sys_pf_set_cdaadr),
4190 DefunResult=sys_pf_set_cdaadr. 4191/*
4192:- side_effect(assert_lsp(sys_pf_set_cdaadr,
4193 lambda_def(defun,
4194 sys_pf_set_cdaadr,
4195 f_sys_pf_set_cdaadr,
4196 [sys_x, sys_v],
4197 [[sys_set_cdr, [caadr, sys_x], sys_v]]))).
4198*/
4199/*
4200:- side_effect(assert_lsp(sys_pf_set_cdaadr,
4201 arglist_info(sys_pf_set_cdaadr,
4202 f_sys_pf_set_cdaadr,
4203 [sys_x, sys_v],
4204 arginfo{ all:[sys_x, sys_v],
4205 allow_other_keys:0,
4206 aux:0,
4207 body:0,
4208 complex:0,
4209 env:0,
4210 key:0,
4211 names:[sys_x, sys_v],
4212 opt:0,
4213 req:[sys_x, sys_v],
4214 rest:0,
4215 sublists:0,
4216 whole:0
4217 }))).
4218*/
4219/*
4220:- side_effect(assert_lsp(sys_pf_set_cdaadr, init_args(x, f_sys_pf_set_cdaadr))).
4221*/
4222/*
4223(defun %set-cddadr (x v) (set-cdr (cdadr x) v))
4224*/
4225
4226/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13337 **********************/
4227:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cddadr',[x,v],['set-cdr',[cdadr,x],v]])
4228wl:lambda_def(defun, sys_pf_set_cddadr, f_sys_pf_set_cddadr, [sys_x, sys_v], [[sys_set_cdr, [cdadr, sys_x], sys_v]]).
4229wl:arglist_info(sys_pf_set_cddadr, f_sys_pf_set_cddadr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
4230wl: init_args(x, f_sys_pf_set_cddadr).
4231
4236f_sys_pf_set_cddadr(X_In, V_In, FnResult) :-
4237 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
4238 catch(( ( get_var(GEnv, sys_x, X_Get),
4239 f_cdadr(X_Get, Set_cdr_Param),
4240 get_var(GEnv, sys_v, V_Get),
4241 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
4242 ),
4243 Set_cdr_Ret=FnResult
4244 ),
4245 block_exit(sys_pf_set_cddadr, FnResult),
4246 true).
4247:- set_opv(sys_pf_set_cddadr, symbol_function, f_sys_pf_set_cddadr),
4248 DefunResult=sys_pf_set_cddadr. 4249/*
4250:- side_effect(assert_lsp(sys_pf_set_cddadr,
4251 lambda_def(defun,
4252 sys_pf_set_cddadr,
4253 f_sys_pf_set_cddadr,
4254 [sys_x, sys_v],
4255 [[sys_set_cdr, [cdadr, sys_x], sys_v]]))).
4256*/
4257/*
4258:- side_effect(assert_lsp(sys_pf_set_cddadr,
4259 arglist_info(sys_pf_set_cddadr,
4260 f_sys_pf_set_cddadr,
4261 [sys_x, sys_v],
4262 arginfo{ all:[sys_x, sys_v],
4263 allow_other_keys:0,
4264 aux:0,
4265 body:0,
4266 complex:0,
4267 env:0,
4268 key:0,
4269 names:[sys_x, sys_v],
4270 opt:0,
4271 req:[sys_x, sys_v],
4272 rest:0,
4273 sublists:0,
4274 whole:0
4275 }))).
4276*/
4277/*
4278:- side_effect(assert_lsp(sys_pf_set_cddadr, init_args(x, f_sys_pf_set_cddadr))).
4279*/
4280/*
4281(defun %set-caaddr (x v) (set-car (caddr x) v))
4282*/
4283
4284/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13386 **********************/
4285:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-caaddr',[x,v],['set-car',[caddr,x],v]])
4286wl:lambda_def(defun, sys_pf_set_caaddr, f_sys_pf_set_caaddr, [sys_x, sys_v], [[sys_set_car, [caddr, sys_x], sys_v]]).
4287wl:arglist_info(sys_pf_set_caaddr, f_sys_pf_set_caaddr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
4288wl: init_args(x, f_sys_pf_set_caaddr).
4289
4294f_sys_pf_set_caaddr(X_In, V_In, FnResult) :-
4295 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
4296 catch(( ( get_var(GEnv, sys_x, X_Get),
4297 f_caddr(X_Get, Set_car_Param),
4298 get_var(GEnv, sys_v, V_Get),
4299 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
4300 ),
4301 Set_car_Ret=FnResult
4302 ),
4303 block_exit(sys_pf_set_caaddr, FnResult),
4304 true).
4305:- set_opv(sys_pf_set_caaddr, symbol_function, f_sys_pf_set_caaddr),
4306 DefunResult=sys_pf_set_caaddr. 4307/*
4308:- side_effect(assert_lsp(sys_pf_set_caaddr,
4309 lambda_def(defun,
4310 sys_pf_set_caaddr,
4311 f_sys_pf_set_caaddr,
4312 [sys_x, sys_v],
4313 [[sys_set_car, [caddr, sys_x], sys_v]]))).
4314*/
4315/*
4316:- side_effect(assert_lsp(sys_pf_set_caaddr,
4317 arglist_info(sys_pf_set_caaddr,
4318 f_sys_pf_set_caaddr,
4319 [sys_x, sys_v],
4320 arginfo{ all:[sys_x, sys_v],
4321 allow_other_keys:0,
4322 aux:0,
4323 body:0,
4324 complex:0,
4325 env:0,
4326 key:0,
4327 names:[sys_x, sys_v],
4328 opt:0,
4329 req:[sys_x, sys_v],
4330 rest:0,
4331 sublists:0,
4332 whole:0
4333 }))).
4334*/
4335/*
4336:- side_effect(assert_lsp(sys_pf_set_caaddr, init_args(x, f_sys_pf_set_caaddr))).
4337*/
4338/*
4339(defun %set-cadddr (x v) (set-car (cdddr x) v))
4340*/
4341
4342/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13435 **********************/
4343:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cadddr',[x,v],['set-car',[cdddr,x],v]])
4344wl:lambda_def(defun, sys_pf_set_cadddr, f_sys_pf_set_cadddr, [sys_x, sys_v], [[sys_set_car, [cdddr, sys_x], sys_v]]).
4345wl:arglist_info(sys_pf_set_cadddr, f_sys_pf_set_cadddr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
4346wl: init_args(x, f_sys_pf_set_cadddr).
4347
4352f_sys_pf_set_cadddr(X_In, V_In, FnResult) :-
4353 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
4354 catch(( ( get_var(GEnv, sys_x, X_Get),
4355 f_cdddr(X_Get, Set_car_Param),
4356 get_var(GEnv, sys_v, V_Get),
4357 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
4358 ),
4359 Set_car_Ret=FnResult
4360 ),
4361 block_exit(sys_pf_set_cadddr, FnResult),
4362 true).
4363:- set_opv(sys_pf_set_cadddr, symbol_function, f_sys_pf_set_cadddr),
4364 DefunResult=sys_pf_set_cadddr. 4365/*
4366:- side_effect(assert_lsp(sys_pf_set_cadddr,
4367 lambda_def(defun,
4368 sys_pf_set_cadddr,
4369 f_sys_pf_set_cadddr,
4370 [sys_x, sys_v],
4371 [[sys_set_car, [cdddr, sys_x], sys_v]]))).
4372*/
4373/*
4374:- side_effect(assert_lsp(sys_pf_set_cadddr,
4375 arglist_info(sys_pf_set_cadddr,
4376 f_sys_pf_set_cadddr,
4377 [sys_x, sys_v],
4378 arginfo{ all:[sys_x, sys_v],
4379 allow_other_keys:0,
4380 aux:0,
4381 body:0,
4382 complex:0,
4383 env:0,
4384 key:0,
4385 names:[sys_x, sys_v],
4386 opt:0,
4387 req:[sys_x, sys_v],
4388 rest:0,
4389 sublists:0,
4390 whole:0
4391 }))).
4392*/
4393/*
4394:- side_effect(assert_lsp(sys_pf_set_cadddr, init_args(x, f_sys_pf_set_cadddr))).
4395*/
4396/*
4397(defun %set-cdaddr (x v) (set-cdr (caddr x) v))
4398*/
4399
4400/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13484 **********************/
4401:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cdaddr',[x,v],['set-cdr',[caddr,x],v]])
4402wl:lambda_def(defun, sys_pf_set_cdaddr, f_sys_pf_set_cdaddr, [sys_x, sys_v], [[sys_set_cdr, [caddr, sys_x], sys_v]]).
4403wl:arglist_info(sys_pf_set_cdaddr, f_sys_pf_set_cdaddr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
4404wl: init_args(x, f_sys_pf_set_cdaddr).
4405
4410f_sys_pf_set_cdaddr(X_In, V_In, FnResult) :-
4411 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
4412 catch(( ( get_var(GEnv, sys_x, X_Get),
4413 f_caddr(X_Get, Set_cdr_Param),
4414 get_var(GEnv, sys_v, V_Get),
4415 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
4416 ),
4417 Set_cdr_Ret=FnResult
4418 ),
4419 block_exit(sys_pf_set_cdaddr, FnResult),
4420 true).
4421:- set_opv(sys_pf_set_cdaddr, symbol_function, f_sys_pf_set_cdaddr),
4422 DefunResult=sys_pf_set_cdaddr. 4423/*
4424:- side_effect(assert_lsp(sys_pf_set_cdaddr,
4425 lambda_def(defun,
4426 sys_pf_set_cdaddr,
4427 f_sys_pf_set_cdaddr,
4428 [sys_x, sys_v],
4429 [[sys_set_cdr, [caddr, sys_x], sys_v]]))).
4430*/
4431/*
4432:- side_effect(assert_lsp(sys_pf_set_cdaddr,
4433 arglist_info(sys_pf_set_cdaddr,
4434 f_sys_pf_set_cdaddr,
4435 [sys_x, sys_v],
4436 arginfo{ all:[sys_x, sys_v],
4437 allow_other_keys:0,
4438 aux:0,
4439 body:0,
4440 complex:0,
4441 env:0,
4442 key:0,
4443 names:[sys_x, sys_v],
4444 opt:0,
4445 req:[sys_x, sys_v],
4446 rest:0,
4447 sublists:0,
4448 whole:0
4449 }))).
4450*/
4451/*
4452:- side_effect(assert_lsp(sys_pf_set_cdaddr, init_args(x, f_sys_pf_set_cdaddr))).
4453*/
4454/*
4455(defun %set-cddddr (x v) (set-cdr (cdddr x) v))
4456
4457*/
4458
4459/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13533 **********************/
4460:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-cddddr',[x,v],['set-cdr',[cdddr,x],v]])
4461wl:lambda_def(defun, sys_pf_set_cddddr, f_sys_pf_set_cddddr, [sys_x, sys_v], [[sys_set_cdr, [cdddr, sys_x], sys_v]]).
4462wl:arglist_info(sys_pf_set_cddddr, f_sys_pf_set_cddddr, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
4463wl: init_args(x, f_sys_pf_set_cddddr).
4464
4469f_sys_pf_set_cddddr(X_In, V_In, FnResult) :-
4470 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
4471 catch(( ( get_var(GEnv, sys_x, X_Get),
4472 f_cdddr(X_Get, Set_cdr_Param),
4473 get_var(GEnv, sys_v, V_Get),
4474 f_sys_set_cdr(Set_cdr_Param, V_Get, Set_cdr_Ret)
4475 ),
4476 Set_cdr_Ret=FnResult
4477 ),
4478 block_exit(sys_pf_set_cddddr, FnResult),
4479 true).
4480:- set_opv(sys_pf_set_cddddr, symbol_function, f_sys_pf_set_cddddr),
4481 DefunResult=sys_pf_set_cddddr. 4482/*
4483:- side_effect(assert_lsp(sys_pf_set_cddddr,
4484 lambda_def(defun,
4485 sys_pf_set_cddddr,
4486 f_sys_pf_set_cddddr,
4487 [sys_x, sys_v],
4488 [[sys_set_cdr, [cdddr, sys_x], sys_v]]))).
4489*/
4490/*
4491:- side_effect(assert_lsp(sys_pf_set_cddddr,
4492 arglist_info(sys_pf_set_cddddr,
4493 f_sys_pf_set_cddddr,
4494 [sys_x, sys_v],
4495 arginfo{ all:[sys_x, sys_v],
4496 allow_other_keys:0,
4497 aux:0,
4498 body:0,
4499 complex:0,
4500 env:0,
4501 key:0,
4502 names:[sys_x, sys_v],
4503 opt:0,
4504 req:[sys_x, sys_v],
4505 rest:0,
4506 sublists:0,
4507 whole:0
4508 }))).
4509*/
4510/*
4511:- side_effect(assert_lsp(sys_pf_set_cddddr, init_args(x, f_sys_pf_set_cddddr))).
4512*/
4513/*
4514(defsetf car set-car)
4515*/
4516
4517/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13584 **********************/
4518:-lisp_compile_to_prolog(pkg_sys,[defsetf,car,'set-car'])
4519/*
4520% macroexpand:-[defsetf,car,sys_set_car].
4521*/
4522/*
4523% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,car],[quote,sys_setf_inverse],[quote,sys_set_car]]].
4524*/
4525:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4526 f_sys_put_sysprop(car, sys_setf_inverse, sys_set_car, [], _Ignored),
4527 _Ignored).
4528/*
4529(defsetf cdr set-cdr)
4530*/
4531
4532/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13607 **********************/
4533:-lisp_compile_to_prolog(pkg_sys,[defsetf,cdr,'set-cdr'])
4534/*
4535% macroexpand:-[defsetf,cdr,sys_set_cdr].
4536*/
4537/*
4538% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cdr],[quote,sys_setf_inverse],[quote,sys_set_cdr]]].
4539*/
4540:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4541 f_sys_put_sysprop(cdr, sys_setf_inverse, sys_set_cdr, [], _Ignored),
4542 _Ignored).
4543/*
4544(defsetf caar %set-caar)
4545*/
4546
4547/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13630 **********************/
4548:-lisp_compile_to_prolog(pkg_sys,[defsetf,caar,'%set-caar'])
4549/*
4550% macroexpand:-[defsetf,caar,sys_pf_set_caar].
4551*/
4552/*
4553% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,caar],[quote,sys_setf_inverse],[quote,sys_pf_set_caar]]].
4554*/
4555:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4556 f_sys_put_sysprop(caar,
4557 sys_setf_inverse,
4558 sys_pf_set_caar,
4559 [],
4560 _Ignored),
4561 _Ignored).
4562/*
4563(defsetf cadr %set-cadr)
4564*/
4565
4566/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13656 **********************/
4567:-lisp_compile_to_prolog(pkg_sys,[defsetf,cadr,'%set-cadr'])
4568/*
4569% macroexpand:-[defsetf,cadr,sys_pf_set_cadr].
4570*/
4571/*
4572% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cadr],[quote,sys_setf_inverse],[quote,sys_pf_set_cadr]]].
4573*/
4574:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4575 f_sys_put_sysprop(cadr,
4576 sys_setf_inverse,
4577 sys_pf_set_cadr,
4578 [],
4579 _Ignored),
4580 _Ignored).
4581/*
4582(defsetf cdar %set-cdar)
4583*/
4584
4585/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13682 **********************/
4586:-lisp_compile_to_prolog(pkg_sys,[defsetf,cdar,'%set-cdar'])
4587/*
4588% macroexpand:-[defsetf,cdar,sys_pf_set_cdar].
4589*/
4590/*
4591% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cdar],[quote,sys_setf_inverse],[quote,sys_pf_set_cdar]]].
4592*/
4593:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4594 f_sys_put_sysprop(cdar,
4595 sys_setf_inverse,
4596 sys_pf_set_cdar,
4597 [],
4598 _Ignored),
4599 _Ignored).
4600/*
4601(defsetf cddr %set-cddr)
4602*/
4603
4604/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13708 **********************/
4605:-lisp_compile_to_prolog(pkg_sys,[defsetf,cddr,'%set-cddr'])
4606/*
4607% macroexpand:-[defsetf,cddr,sys_pf_set_cddr].
4608*/
4609/*
4610% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cddr],[quote,sys_setf_inverse],[quote,sys_pf_set_cddr]]].
4611*/
4612:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4613 f_sys_put_sysprop(cddr,
4614 sys_setf_inverse,
4615 sys_pf_set_cddr,
4616 [],
4617 _Ignored),
4618 _Ignored).
4619/*
4620(defsetf caaar %set-caaar)
4621*/
4622
4623/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13734 **********************/
4624:-lisp_compile_to_prolog(pkg_sys,[defsetf,caaar,'%set-caaar'])
4625/*
4626% macroexpand:-[defsetf,caaar,sys_pf_set_caaar].
4627*/
4628/*
4629% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,caaar],[quote,sys_setf_inverse],[quote,sys_pf_set_caaar]]].
4630*/
4631:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4632 f_sys_put_sysprop(caaar,
4633 sys_setf_inverse,
4634 sys_pf_set_caaar,
4635 [],
4636 _Ignored),
4637 _Ignored).
4638/*
4639(defsetf cadar %set-cadar)
4640*/
4641
4642/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13762 **********************/
4643:-lisp_compile_to_prolog(pkg_sys,[defsetf,cadar,'%set-cadar'])
4644/*
4645% macroexpand:-[defsetf,cadar,sys_pf_set_cadar].
4646*/
4647/*
4648% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cadar],[quote,sys_setf_inverse],[quote,sys_pf_set_cadar]]].
4649*/
4650:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4651 f_sys_put_sysprop(cadar,
4652 sys_setf_inverse,
4653 sys_pf_set_cadar,
4654 [],
4655 _Ignored),
4656 _Ignored).
4657/*
4658(defsetf cdaar %set-cdaar)
4659*/
4660
4661/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13790 **********************/
4662:-lisp_compile_to_prolog(pkg_sys,[defsetf,cdaar,'%set-cdaar'])
4663/*
4664% macroexpand:-[defsetf,cdaar,sys_pf_set_cdaar].
4665*/
4666/*
4667% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cdaar],[quote,sys_setf_inverse],[quote,sys_pf_set_cdaar]]].
4668*/
4669:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4670 f_sys_put_sysprop(cdaar,
4671 sys_setf_inverse,
4672 sys_pf_set_cdaar,
4673 [],
4674 _Ignored),
4675 _Ignored).
4676/*
4677(defsetf cddar %set-cddar)
4678*/
4679
4680/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13818 **********************/
4681:-lisp_compile_to_prolog(pkg_sys,[defsetf,cddar,'%set-cddar'])
4682/*
4683% macroexpand:-[defsetf,cddar,sys_pf_set_cddar].
4684*/
4685/*
4686% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cddar],[quote,sys_setf_inverse],[quote,sys_pf_set_cddar]]].
4687*/
4688:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4689 f_sys_put_sysprop(cddar,
4690 sys_setf_inverse,
4691 sys_pf_set_cddar,
4692 [],
4693 _Ignored),
4694 _Ignored).
4695/*
4696(defsetf caadr %set-caadr)
4697*/
4698
4699/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13846 **********************/
4700:-lisp_compile_to_prolog(pkg_sys,[defsetf,caadr,'%set-caadr'])
4701/*
4702% macroexpand:-[defsetf,caadr,sys_pf_set_caadr].
4703*/
4704/*
4705% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,caadr],[quote,sys_setf_inverse],[quote,sys_pf_set_caadr]]].
4706*/
4707:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4708 f_sys_put_sysprop(caadr,
4709 sys_setf_inverse,
4710 sys_pf_set_caadr,
4711 [],
4712 _Ignored),
4713 _Ignored).
4714/*
4715(defsetf caddr %set-caddr)
4716*/
4717
4718/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13874 **********************/
4719:-lisp_compile_to_prolog(pkg_sys,[defsetf,caddr,'%set-caddr'])
4720/*
4721% macroexpand:-[defsetf,caddr,sys_pf_set_caddr].
4722*/
4723/*
4724% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,caddr],[quote,sys_setf_inverse],[quote,sys_pf_set_caddr]]].
4725*/
4726:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4727 f_sys_put_sysprop(caddr,
4728 sys_setf_inverse,
4729 sys_pf_set_caddr,
4730 [],
4731 _Ignored),
4732 _Ignored).
4733/*
4734(defsetf cdadr %set-cdadr)
4735*/
4736
4737/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13902 **********************/
4738:-lisp_compile_to_prolog(pkg_sys,[defsetf,cdadr,'%set-cdadr'])
4739/*
4740% macroexpand:-[defsetf,cdadr,sys_pf_set_cdadr].
4741*/
4742/*
4743% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cdadr],[quote,sys_setf_inverse],[quote,sys_pf_set_cdadr]]].
4744*/
4745:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4746 f_sys_put_sysprop(cdadr,
4747 sys_setf_inverse,
4748 sys_pf_set_cdadr,
4749 [],
4750 _Ignored),
4751 _Ignored).
4752/*
4753(defsetf cdddr %set-cdddr)
4754*/
4755
4756/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13930 **********************/
4757:-lisp_compile_to_prolog(pkg_sys,[defsetf,cdddr,'%set-cdddr'])
4758/*
4759% macroexpand:-[defsetf,cdddr,sys_pf_set_cdddr].
4760*/
4761/*
4762% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cdddr],[quote,sys_setf_inverse],[quote,sys_pf_set_cdddr]]].
4763*/
4764:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4765 f_sys_put_sysprop(cdddr,
4766 sys_setf_inverse,
4767 sys_pf_set_cdddr,
4768 [],
4769 _Ignored),
4770 _Ignored).
4771/*
4772(defsetf caaaar %set-caaaar)
4773*/
4774
4775/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13958 **********************/
4776:-lisp_compile_to_prolog(pkg_sys,[defsetf,caaaar,'%set-caaaar'])
4777/*
4778% macroexpand:-[defsetf,caaaar,sys_pf_set_caaaar].
4779*/
4780/*
4781% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,caaaar],[quote,sys_setf_inverse],[quote,sys_pf_set_caaaar]]].
4782*/
4783:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4784 f_sys_put_sysprop(caaaar,
4785 sys_setf_inverse,
4786 sys_pf_set_caaaar,
4787 [],
4788 _Ignored),
4789 _Ignored).
4790/*
4791(defsetf cadaar %set-cadaar)
4792*/
4793
4794/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:13988 **********************/
4795:-lisp_compile_to_prolog(pkg_sys,[defsetf,cadaar,'%set-cadaar'])
4796/*
4797% macroexpand:-[defsetf,cadaar,sys_pf_set_cadaar].
4798*/
4799/*
4800% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cadaar],[quote,sys_setf_inverse],[quote,sys_pf_set_cadaar]]].
4801*/
4802:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4803 f_sys_put_sysprop(cadaar,
4804 sys_setf_inverse,
4805 sys_pf_set_cadaar,
4806 [],
4807 _Ignored),
4808 _Ignored).
4809/*
4810(defsetf cdaaar %set-cdaaar)
4811*/
4812
4813/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14018 **********************/
4814:-lisp_compile_to_prolog(pkg_sys,[defsetf,cdaaar,'%set-cdaaar'])
4815/*
4816% macroexpand:-[defsetf,cdaaar,sys_pf_set_cdaaar].
4817*/
4818/*
4819% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cdaaar],[quote,sys_setf_inverse],[quote,sys_pf_set_cdaaar]]].
4820*/
4821:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4822 f_sys_put_sysprop(cdaaar,
4823 sys_setf_inverse,
4824 sys_pf_set_cdaaar,
4825 [],
4826 _Ignored),
4827 _Ignored).
4828/*
4829(defsetf cddaar %set-cddaar)
4830*/
4831
4832/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14048 **********************/
4833:-lisp_compile_to_prolog(pkg_sys,[defsetf,cddaar,'%set-cddaar'])
4834/*
4835% macroexpand:-[defsetf,cddaar,sys_pf_set_cddaar].
4836*/
4837/*
4838% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cddaar],[quote,sys_setf_inverse],[quote,sys_pf_set_cddaar]]].
4839*/
4840:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4841 f_sys_put_sysprop(cddaar,
4842 sys_setf_inverse,
4843 sys_pf_set_cddaar,
4844 [],
4845 _Ignored),
4846 _Ignored).
4847/*
4848(defsetf caadar %set-caadar)
4849*/
4850
4851/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14078 **********************/
4852:-lisp_compile_to_prolog(pkg_sys,[defsetf,caadar,'%set-caadar'])
4853/*
4854% macroexpand:-[defsetf,caadar,sys_pf_set_caadar].
4855*/
4856/*
4857% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,caadar],[quote,sys_setf_inverse],[quote,sys_pf_set_caadar]]].
4858*/
4859:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4860 f_sys_put_sysprop(caadar,
4861 sys_setf_inverse,
4862 sys_pf_set_caadar,
4863 [],
4864 _Ignored),
4865 _Ignored).
4866/*
4867(defsetf caddar %set-caddar)
4868*/
4869
4870/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14108 **********************/
4871:-lisp_compile_to_prolog(pkg_sys,[defsetf,caddar,'%set-caddar'])
4872/*
4873% macroexpand:-[defsetf,caddar,sys_pf_set_caddar].
4874*/
4875/*
4876% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,caddar],[quote,sys_setf_inverse],[quote,sys_pf_set_caddar]]].
4877*/
4878:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4879 f_sys_put_sysprop(caddar,
4880 sys_setf_inverse,
4881 sys_pf_set_caddar,
4882 [],
4883 _Ignored),
4884 _Ignored).
4885/*
4886(defsetf cdadar %set-cdadar)
4887*/
4888
4889/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14138 **********************/
4890:-lisp_compile_to_prolog(pkg_sys,[defsetf,cdadar,'%set-cdadar'])
4891/*
4892% macroexpand:-[defsetf,cdadar,sys_pf_set_cdadar].
4893*/
4894/*
4895% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cdadar],[quote,sys_setf_inverse],[quote,sys_pf_set_cdadar]]].
4896*/
4897:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4898 f_sys_put_sysprop(cdadar,
4899 sys_setf_inverse,
4900 sys_pf_set_cdadar,
4901 [],
4902 _Ignored),
4903 _Ignored).
4904/*
4905(defsetf cdddar %set-cdddar)
4906*/
4907
4908/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14168 **********************/
4909:-lisp_compile_to_prolog(pkg_sys,[defsetf,cdddar,'%set-cdddar'])
4910/*
4911% macroexpand:-[defsetf,cdddar,sys_pf_set_cdddar].
4912*/
4913/*
4914% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cdddar],[quote,sys_setf_inverse],[quote,sys_pf_set_cdddar]]].
4915*/
4916:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4917 f_sys_put_sysprop(cdddar,
4918 sys_setf_inverse,
4919 sys_pf_set_cdddar,
4920 [],
4921 _Ignored),
4922 _Ignored).
4923/*
4924(defsetf caaadr %set-caaadr)
4925*/
4926
4927/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14198 **********************/
4928:-lisp_compile_to_prolog(pkg_sys,[defsetf,caaadr,'%set-caaadr'])
4929/*
4930% macroexpand:-[defsetf,caaadr,sys_pf_set_caaadr].
4931*/
4932/*
4933% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,caaadr],[quote,sys_setf_inverse],[quote,sys_pf_set_caaadr]]].
4934*/
4935:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4936 f_sys_put_sysprop(caaadr,
4937 sys_setf_inverse,
4938 sys_pf_set_caaadr,
4939 [],
4940 _Ignored),
4941 _Ignored).
4942/*
4943(defsetf cadadr %set-cadadr)
4944*/
4945
4946/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14228 **********************/
4947:-lisp_compile_to_prolog(pkg_sys,[defsetf,cadadr,'%set-cadadr'])
4948/*
4949% macroexpand:-[defsetf,cadadr,sys_pf_set_cadadr].
4950*/
4951/*
4952% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cadadr],[quote,sys_setf_inverse],[quote,sys_pf_set_cadadr]]].
4953*/
4954:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4955 f_sys_put_sysprop(cadadr,
4956 sys_setf_inverse,
4957 sys_pf_set_cadadr,
4958 [],
4959 _Ignored),
4960 _Ignored).
4961/*
4962(defsetf cdaadr %set-cdaadr)
4963*/
4964
4965/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14258 **********************/
4966:-lisp_compile_to_prolog(pkg_sys,[defsetf,cdaadr,'%set-cdaadr'])
4967/*
4968% macroexpand:-[defsetf,cdaadr,sys_pf_set_cdaadr].
4969*/
4970/*
4971% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cdaadr],[quote,sys_setf_inverse],[quote,sys_pf_set_cdaadr]]].
4972*/
4973:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4974 f_sys_put_sysprop(cdaadr,
4975 sys_setf_inverse,
4976 sys_pf_set_cdaadr,
4977 [],
4978 _Ignored),
4979 _Ignored).
4980/*
4981(defsetf cddadr %set-cddadr)
4982*/
4983
4984/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14288 **********************/
4985:-lisp_compile_to_prolog(pkg_sys,[defsetf,cddadr,'%set-cddadr'])
4986/*
4987% macroexpand:-[defsetf,cddadr,sys_pf_set_cddadr].
4988*/
4989/*
4990% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cddadr],[quote,sys_setf_inverse],[quote,sys_pf_set_cddadr]]].
4991*/
4992:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
4993 f_sys_put_sysprop(cddadr,
4994 sys_setf_inverse,
4995 sys_pf_set_cddadr,
4996 [],
4997 _Ignored),
4998 _Ignored).
4999/*
5000(defsetf caaddr %set-caaddr)
5001*/
5002
5003/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14318 **********************/
5004:-lisp_compile_to_prolog(pkg_sys,[defsetf,caaddr,'%set-caaddr'])
5005/*
5006% macroexpand:-[defsetf,caaddr,sys_pf_set_caaddr].
5007*/
5008/*
5009% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,caaddr],[quote,sys_setf_inverse],[quote,sys_pf_set_caaddr]]].
5010*/
5011:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5012 f_sys_put_sysprop(caaddr,
5013 sys_setf_inverse,
5014 sys_pf_set_caaddr,
5015 [],
5016 _Ignored),
5017 _Ignored).
5018/*
5019(defsetf cadddr %set-cadddr)
5020*/
5021
5022/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14348 **********************/
5023:-lisp_compile_to_prolog(pkg_sys,[defsetf,cadddr,'%set-cadddr'])
5024/*
5025% macroexpand:-[defsetf,cadddr,sys_pf_set_cadddr].
5026*/
5027/*
5028% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cadddr],[quote,sys_setf_inverse],[quote,sys_pf_set_cadddr]]].
5029*/
5030:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5031 f_sys_put_sysprop(cadddr,
5032 sys_setf_inverse,
5033 sys_pf_set_cadddr,
5034 [],
5035 _Ignored),
5036 _Ignored).
5037/*
5038(defsetf cdaddr %set-cdaddr)
5039*/
5040
5041/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14378 **********************/
5042:-lisp_compile_to_prolog(pkg_sys,[defsetf,cdaddr,'%set-cdaddr'])
5043/*
5044% macroexpand:-[defsetf,cdaddr,sys_pf_set_cdaddr].
5045*/
5046/*
5047% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cdaddr],[quote,sys_setf_inverse],[quote,sys_pf_set_cdaddr]]].
5048*/
5049:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5050 f_sys_put_sysprop(cdaddr,
5051 sys_setf_inverse,
5052 sys_pf_set_cdaddr,
5053 [],
5054 _Ignored),
5055 _Ignored).
5056/*
5057(defsetf cddddr %set-cddddr)
5058
5059*/
5060
5061/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14408 **********************/
5062:-lisp_compile_to_prolog(pkg_sys,[defsetf,cddddr,'%set-cddddr'])
5063/*
5064% macroexpand:-[defsetf,cddddr,sys_pf_set_cddddr].
5065*/
5066/*
5067% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,cddddr],[quote,sys_setf_inverse],[quote,sys_pf_set_cddddr]]].
5068*/
5069:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5070 f_sys_put_sysprop(cddddr,
5071 sys_setf_inverse,
5072 sys_pf_set_cddddr,
5073 [],
5074 _Ignored),
5075 _Ignored).
5076/*
5077(defsetf first set-car)
5078*/
5079
5080/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14440 **********************/
5081:-lisp_compile_to_prolog(pkg_sys,[defsetf,first,'set-car'])
5082/*
5083% macroexpand:-[defsetf,first,sys_set_car].
5084*/
5085/*
5086% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,first],[quote,sys_setf_inverse],[quote,sys_set_car]]].
5087*/
5088:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5089 f_sys_put_sysprop(first, sys_setf_inverse, sys_set_car, [], _Ignored),
5090 _Ignored).
5091/*
5092(defsetf second %set-cadr)
5093*/
5094
5095/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14465 **********************/
5096:-lisp_compile_to_prolog(pkg_sys,[defsetf,second,'%set-cadr'])
5097/*
5098% macroexpand:-[defsetf,second,sys_pf_set_cadr].
5099*/
5100/*
5101% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,second],[quote,sys_setf_inverse],[quote,sys_pf_set_cadr]]].
5102*/
5103:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5104 f_sys_put_sysprop(second,
5105 sys_setf_inverse,
5106 sys_pf_set_cadr,
5107 [],
5108 _Ignored),
5109 _Ignored).
5110/*
5111(defsetf third %set-caddr)
5112*/
5113
5114/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14493 **********************/
5115:-lisp_compile_to_prolog(pkg_sys,[defsetf,third,'%set-caddr'])
5116/*
5117% macroexpand:-[defsetf,third,sys_pf_set_caddr].
5118*/
5119/*
5120% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,third],[quote,sys_setf_inverse],[quote,sys_pf_set_caddr]]].
5121*/
5122:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5123 f_sys_put_sysprop(third,
5124 sys_setf_inverse,
5125 sys_pf_set_caddr,
5126 [],
5127 _Ignored),
5128 _Ignored).
5129/*
5130(defsetf fourth %set-cadddr)
5131*/
5132
5133/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14521 **********************/
5134:-lisp_compile_to_prolog(pkg_sys,[defsetf,fourth,'%set-cadddr'])
5135/*
5136% macroexpand:-[defsetf,fourth,sys_pf_set_cadddr].
5137*/
5138/*
5139% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,fourth],[quote,sys_setf_inverse],[quote,sys_pf_set_cadddr]]].
5140*/
5141:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5142 f_sys_put_sysprop(fourth,
5143 sys_setf_inverse,
5144 sys_pf_set_cadddr,
5145 [],
5146 _Ignored),
5147 _Ignored).
5148/*
5149(defun %set-fifth (x v) (set-car (cddddr x) v))
5150*/
5151
5152/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14551 **********************/
5153:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-fifth',[x,v],['set-car',[cddddr,x],v]])
5154wl:lambda_def(defun, sys_pf_set_fifth, f_sys_pf_set_fifth, [sys_x, sys_v], [[sys_set_car, [cddddr, sys_x], sys_v]]).
5155wl:arglist_info(sys_pf_set_fifth, f_sys_pf_set_fifth, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
5156wl: init_args(x, f_sys_pf_set_fifth).
5157
5162f_sys_pf_set_fifth(X_In, V_In, FnResult) :-
5163 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
5164 catch(( ( get_var(GEnv, sys_x, X_Get),
5165 f_cddddr(X_Get, Set_car_Param),
5166 get_var(GEnv, sys_v, V_Get),
5167 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
5168 ),
5169 Set_car_Ret=FnResult
5170 ),
5171 block_exit(sys_pf_set_fifth, FnResult),
5172 true).
5173:- set_opv(sys_pf_set_fifth, symbol_function, f_sys_pf_set_fifth),
5174 DefunResult=sys_pf_set_fifth. 5175/*
5176:- side_effect(assert_lsp(sys_pf_set_fifth,
5177 lambda_def(defun,
5178 sys_pf_set_fifth,
5179 f_sys_pf_set_fifth,
5180 [sys_x, sys_v],
5181 [[sys_set_car, [cddddr, sys_x], sys_v]]))).
5182*/
5183/*
5184:- side_effect(assert_lsp(sys_pf_set_fifth,
5185 arglist_info(sys_pf_set_fifth,
5186 f_sys_pf_set_fifth,
5187 [sys_x, sys_v],
5188 arginfo{ all:[sys_x, sys_v],
5189 allow_other_keys:0,
5190 aux:0,
5191 body:0,
5192 complex:0,
5193 env:0,
5194 key:0,
5195 names:[sys_x, sys_v],
5196 opt:0,
5197 req:[sys_x, sys_v],
5198 rest:0,
5199 sublists:0,
5200 whole:0
5201 }))).
5202*/
5203/*
5204:- side_effect(assert_lsp(sys_pf_set_fifth, init_args(x, f_sys_pf_set_fifth))).
5205*/
5206/*
5207(defsetf fifth %set-fifth)
5208*/
5209
5210/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14600 **********************/
5211:-lisp_compile_to_prolog(pkg_sys,[defsetf,fifth,'%set-fifth'])
5212/*
5213% macroexpand:-[defsetf,fifth,sys_pf_set_fifth].
5214*/
5215/*
5216% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,fifth],[quote,sys_setf_inverse],[quote,sys_pf_set_fifth]]].
5217*/
5218:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5219 f_sys_put_sysprop(fifth,
5220 sys_setf_inverse,
5221 sys_pf_set_fifth,
5222 [],
5223 _Ignored),
5224 _Ignored).
5225/*
5226(defun %set-sixth (x v) (set-car (cdr (cddddr x)) v))
5227*/
5228
5229/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14628 **********************/
5230:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-sixth',[x,v],['set-car',[cdr,[cddddr,x]],v]])
5231wl:lambda_def(defun, sys_pf_set_sixth, f_sys_pf_set_sixth, [sys_x, sys_v], [[sys_set_car, [cdr, [cddddr, sys_x]], sys_v]]).
5232wl:arglist_info(sys_pf_set_sixth, f_sys_pf_set_sixth, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
5233wl: init_args(x, f_sys_pf_set_sixth).
5234
5239f_sys_pf_set_sixth(X_In, V_In, FnResult) :-
5240 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
5241 catch(( ( get_var(GEnv, sys_x, X_Get),
5242 f_cddddr(X_Get, Cdr_Param),
5243 f_cdr(Cdr_Param, Set_car_Param),
5244 get_var(GEnv, sys_v, V_Get),
5245 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
5246 ),
5247 Set_car_Ret=FnResult
5248 ),
5249 block_exit(sys_pf_set_sixth, FnResult),
5250 true).
5251:- set_opv(sys_pf_set_sixth, symbol_function, f_sys_pf_set_sixth),
5252 DefunResult=sys_pf_set_sixth. 5253/*
5254:- side_effect(assert_lsp(sys_pf_set_sixth,
5255 lambda_def(defun,
5256 sys_pf_set_sixth,
5257 f_sys_pf_set_sixth,
5258 [sys_x, sys_v],
5259
5260 [
5261 [ sys_set_car,
5262 [cdr, [cddddr, sys_x]],
5263 sys_v
5264 ]
5265 ]))).
5266*/
5267/*
5268:- side_effect(assert_lsp(sys_pf_set_sixth,
5269 arglist_info(sys_pf_set_sixth,
5270 f_sys_pf_set_sixth,
5271 [sys_x, sys_v],
5272 arginfo{ all:[sys_x, sys_v],
5273 allow_other_keys:0,
5274 aux:0,
5275 body:0,
5276 complex:0,
5277 env:0,
5278 key:0,
5279 names:[sys_x, sys_v],
5280 opt:0,
5281 req:[sys_x, sys_v],
5282 rest:0,
5283 sublists:0,
5284 whole:0
5285 }))).
5286*/
5287/*
5288:- side_effect(assert_lsp(sys_pf_set_sixth, init_args(x, f_sys_pf_set_sixth))).
5289*/
5290/*
5291(defsetf sixth %set-sixth)
5292*/
5293
5294/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14683 **********************/
5295:-lisp_compile_to_prolog(pkg_sys,[defsetf,sixth,'%set-sixth'])
5296/*
5297% macroexpand:-[defsetf,sixth,sys_pf_set_sixth].
5298*/
5299/*
5300% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,sixth],[quote,sys_setf_inverse],[quote,sys_pf_set_sixth]]].
5301*/
5302:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5303 f_sys_put_sysprop(sixth,
5304 sys_setf_inverse,
5305 sys_pf_set_sixth,
5306 [],
5307 _Ignored),
5308 _Ignored).
5309/*
5310(defun %set-seventh (x v) (set-car (cddr (cddddr x)) v))
5311*/
5312
5313/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14711 **********************/
5314:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-seventh',[x,v],['set-car',[cddr,[cddddr,x]],v]])
5315wl:lambda_def(defun, sys_pf_set_seventh, f_sys_pf_set_seventh, [sys_x, sys_v], [[sys_set_car, [cddr, [cddddr, sys_x]], sys_v]]).
5316wl:arglist_info(sys_pf_set_seventh, f_sys_pf_set_seventh, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
5317wl: init_args(x, f_sys_pf_set_seventh).
5318
5323f_sys_pf_set_seventh(X_In, V_In, FnResult) :-
5324 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
5325 catch(( ( get_var(GEnv, sys_x, X_Get),
5326 f_cddddr(X_Get, Cddr_Param),
5327 f_cddr(Cddr_Param, Set_car_Param),
5328 get_var(GEnv, sys_v, V_Get),
5329 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
5330 ),
5331 Set_car_Ret=FnResult
5332 ),
5333 block_exit(sys_pf_set_seventh, FnResult),
5334 true).
5335:- set_opv(sys_pf_set_seventh, symbol_function, f_sys_pf_set_seventh),
5336 DefunResult=sys_pf_set_seventh. 5337/*
5338:- side_effect(assert_lsp(sys_pf_set_seventh,
5339 lambda_def(defun,
5340 sys_pf_set_seventh,
5341 f_sys_pf_set_seventh,
5342 [sys_x, sys_v],
5343
5344 [
5345 [ sys_set_car,
5346 [cddr, [cddddr, sys_x]],
5347 sys_v
5348 ]
5349 ]))).
5350*/
5351/*
5352:- side_effect(assert_lsp(sys_pf_set_seventh,
5353 arglist_info(sys_pf_set_seventh,
5354 f_sys_pf_set_seventh,
5355 [sys_x, sys_v],
5356 arginfo{ all:[sys_x, sys_v],
5357 allow_other_keys:0,
5358 aux:0,
5359 body:0,
5360 complex:0,
5361 env:0,
5362 key:0,
5363 names:[sys_x, sys_v],
5364 opt:0,
5365 req:[sys_x, sys_v],
5366 rest:0,
5367 sublists:0,
5368 whole:0
5369 }))).
5370*/
5371/*
5372:- side_effect(assert_lsp(sys_pf_set_seventh,
5373 init_args(x, f_sys_pf_set_seventh))).
5374*/
5375/*
5376(defsetf seventh %set-seventh)
5377*/
5378
5379/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14769 **********************/
5380:-lisp_compile_to_prolog(pkg_sys,[defsetf,seventh,'%set-seventh'])
5381/*
5382% macroexpand:-[defsetf,seventh,sys_pf_set_seventh].
5383*/
5384/*
5385% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,seventh],[quote,sys_setf_inverse],[quote,sys_pf_set_seventh]]].
5386*/
5387:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5388 f_sys_put_sysprop(seventh,
5389 sys_setf_inverse,
5390 sys_pf_set_seventh,
5391 [],
5392 _Ignored),
5393 _Ignored).
5394/*
5395(defun %set-eighth (x v) (set-car (cdddr (cddddr x)) v))
5396*/
5397
5398/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14801 **********************/
5399:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-eighth',[x,v],['set-car',[cdddr,[cddddr,x]],v]])
5400wl:lambda_def(defun, sys_pf_set_eighth, f_sys_pf_set_eighth, [sys_x, sys_v], [[sys_set_car, [cdddr, [cddddr, sys_x]], sys_v]]).
5401wl:arglist_info(sys_pf_set_eighth, f_sys_pf_set_eighth, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
5402wl: init_args(x, f_sys_pf_set_eighth).
5403
5408f_sys_pf_set_eighth(X_In, V_In, FnResult) :-
5409 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
5410 catch(( ( get_var(GEnv, sys_x, X_Get),
5411 f_cddddr(X_Get, Cdddr_Param),
5412 f_cdddr(Cdddr_Param, Set_car_Param),
5413 get_var(GEnv, sys_v, V_Get),
5414 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
5415 ),
5416 Set_car_Ret=FnResult
5417 ),
5418 block_exit(sys_pf_set_eighth, FnResult),
5419 true).
5420:- set_opv(sys_pf_set_eighth, symbol_function, f_sys_pf_set_eighth),
5421 DefunResult=sys_pf_set_eighth. 5422/*
5423:- side_effect(assert_lsp(sys_pf_set_eighth,
5424 lambda_def(defun,
5425 sys_pf_set_eighth,
5426 f_sys_pf_set_eighth,
5427 [sys_x, sys_v],
5428
5429 [
5430 [ sys_set_car,
5431 [cdddr, [cddddr, sys_x]],
5432 sys_v
5433 ]
5434 ]))).
5435*/
5436/*
5437:- side_effect(assert_lsp(sys_pf_set_eighth,
5438 arglist_info(sys_pf_set_eighth,
5439 f_sys_pf_set_eighth,
5440 [sys_x, sys_v],
5441 arginfo{ all:[sys_x, sys_v],
5442 allow_other_keys:0,
5443 aux:0,
5444 body:0,
5445 complex:0,
5446 env:0,
5447 key:0,
5448 names:[sys_x, sys_v],
5449 opt:0,
5450 req:[sys_x, sys_v],
5451 rest:0,
5452 sublists:0,
5453 whole:0
5454 }))).
5455*/
5456/*
5457:- side_effect(assert_lsp(sys_pf_set_eighth, init_args(x, f_sys_pf_set_eighth))).
5458*/
5459/*
5460(defsetf eighth %set-eighth)
5461*/
5462
5463/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14859 **********************/
5464:-lisp_compile_to_prolog(pkg_sys,[defsetf,eighth,'%set-eighth'])
5465/*
5466% macroexpand:-[defsetf,eighth,sys_pf_set_eighth].
5467*/
5468/*
5469% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,eighth],[quote,sys_setf_inverse],[quote,sys_pf_set_eighth]]].
5470*/
5471:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5472 f_sys_put_sysprop(eighth,
5473 sys_setf_inverse,
5474 sys_pf_set_eighth,
5475 [],
5476 _Ignored),
5477 _Ignored).
5478/*
5479(defun %set-ninth (x v) (set-car (cddddr (cddddr x)) v))
5480*/
5481
5482/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14889 **********************/
5483:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-ninth',[x,v],['set-car',[cddddr,[cddddr,x]],v]])
5484wl:lambda_def(defun, sys_pf_set_ninth, f_sys_pf_set_ninth, [sys_x, sys_v], [[sys_set_car, [cddddr, [cddddr, sys_x]], sys_v]]).
5485wl:arglist_info(sys_pf_set_ninth, f_sys_pf_set_ninth, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
5486wl: init_args(x, f_sys_pf_set_ninth).
5487
5492f_sys_pf_set_ninth(X_In, V_In, FnResult) :-
5493 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
5494 catch(( ( get_var(GEnv, sys_x, X_Get),
5495 f_cddddr(X_Get, Cddddr_Param),
5496 f_cddddr(Cddddr_Param, Set_car_Param),
5497 get_var(GEnv, sys_v, V_Get),
5498 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
5499 ),
5500 Set_car_Ret=FnResult
5501 ),
5502 block_exit(sys_pf_set_ninth, FnResult),
5503 true).
5504:- set_opv(sys_pf_set_ninth, symbol_function, f_sys_pf_set_ninth),
5505 DefunResult=sys_pf_set_ninth. 5506/*
5507:- side_effect(assert_lsp(sys_pf_set_ninth,
5508 lambda_def(defun,
5509 sys_pf_set_ninth,
5510 f_sys_pf_set_ninth,
5511 [sys_x, sys_v],
5512
5513 [
5514 [ sys_set_car,
5515 [cddddr, [cddddr, sys_x]],
5516 sys_v
5517 ]
5518 ]))).
5519*/
5520/*
5521:- side_effect(assert_lsp(sys_pf_set_ninth,
5522 arglist_info(sys_pf_set_ninth,
5523 f_sys_pf_set_ninth,
5524 [sys_x, sys_v],
5525 arginfo{ all:[sys_x, sys_v],
5526 allow_other_keys:0,
5527 aux:0,
5528 body:0,
5529 complex:0,
5530 env:0,
5531 key:0,
5532 names:[sys_x, sys_v],
5533 opt:0,
5534 req:[sys_x, sys_v],
5535 rest:0,
5536 sublists:0,
5537 whole:0
5538 }))).
5539*/
5540/*
5541:- side_effect(assert_lsp(sys_pf_set_ninth, init_args(x, f_sys_pf_set_ninth))).
5542*/
5543/*
5544(defsetf ninth %set-ninth)
5545*/
5546
5547/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14947 **********************/
5548:-lisp_compile_to_prolog(pkg_sys,[defsetf,ninth,'%set-ninth'])
5549/*
5550% macroexpand:-[defsetf,ninth,sys_pf_set_ninth].
5551*/
5552/*
5553% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,ninth],[quote,sys_setf_inverse],[quote,sys_pf_set_ninth]]].
5554*/
5555:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5556 f_sys_put_sysprop(ninth,
5557 sys_setf_inverse,
5558 sys_pf_set_ninth,
5559 [],
5560 _Ignored),
5561 _Ignored).
5562/*
5563(defun %set-tenth (x v) (set-car (cdr (cddddr (cddddr x))) v))
5564*/
5565
5566/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:14975 **********************/
5567:-lisp_compile_to_prolog(pkg_sys,[defun,'%set-tenth',[x,v],['set-car',[cdr,[cddddr,[cddddr,x]]],v]])
5568wl:lambda_def(defun, sys_pf_set_tenth, f_sys_pf_set_tenth, [sys_x, sys_v], [[sys_set_car, [cdr, [cddddr, [cddddr, sys_x]]], sys_v]]).
5569wl:arglist_info(sys_pf_set_tenth, f_sys_pf_set_tenth, [sys_x, sys_v], arginfo{all:[sys_x, sys_v], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_x, sys_v], opt:0, req:[sys_x, sys_v], rest:0, sublists:0, whole:0}).
5570wl: init_args(x, f_sys_pf_set_tenth).
5571
5576f_sys_pf_set_tenth(X_In, V_In, FnResult) :-
5577 GEnv=[bv(sys_x, X_In), bv(sys_v, V_In)],
5578 catch(( ( get_var(GEnv, sys_x, X_Get),
5579 f_cddddr(X_Get, Cddddr_Param),
5580 f_cddddr(Cddddr_Param, Cdr_Param),
5581 f_cdr(Cdr_Param, Set_car_Param),
5582 get_var(GEnv, sys_v, V_Get),
5583 f_sys_set_car(Set_car_Param, V_Get, Set_car_Ret)
5584 ),
5585 Set_car_Ret=FnResult
5586 ),
5587 block_exit(sys_pf_set_tenth, FnResult),
5588 true).
5589:- set_opv(sys_pf_set_tenth, symbol_function, f_sys_pf_set_tenth),
5590 DefunResult=sys_pf_set_tenth. 5591/*
5592:- side_effect(assert_lsp(sys_pf_set_tenth,
5593 lambda_def(defun,
5594 sys_pf_set_tenth,
5595 f_sys_pf_set_tenth,
5596 [sys_x, sys_v],
5597
5598 [
5599 [ sys_set_car,
5600 [cdr, [cddddr, [cddddr, sys_x]]],
5601 sys_v
5602 ]
5603 ]))).
5604*/
5605/*
5606:- side_effect(assert_lsp(sys_pf_set_tenth,
5607 arglist_info(sys_pf_set_tenth,
5608 f_sys_pf_set_tenth,
5609 [sys_x, sys_v],
5610 arginfo{ all:[sys_x, sys_v],
5611 allow_other_keys:0,
5612 aux:0,
5613 body:0,
5614 complex:0,
5615 env:0,
5616 key:0,
5617 names:[sys_x, sys_v],
5618 opt:0,
5619 req:[sys_x, sys_v],
5620 rest:0,
5621 sublists:0,
5622 whole:0
5623 }))).
5624*/
5625/*
5626:- side_effect(assert_lsp(sys_pf_set_tenth, init_args(x, f_sys_pf_set_tenth))).
5627*/
5628/*
5629(defsetf tenth %set-tenth)
5630
5631*/
5632
5633/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15039 **********************/
5634:-lisp_compile_to_prolog(pkg_sys,[defsetf,tenth,'%set-tenth'])
5635/*
5636% macroexpand:-[defsetf,tenth,sys_pf_set_tenth].
5637*/
5638/*
5639% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,tenth],[quote,sys_setf_inverse],[quote,sys_pf_set_tenth]]].
5640*/
5641:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5642 f_sys_put_sysprop(tenth,
5643 sys_setf_inverse,
5644 sys_pf_set_tenth,
5645 [],
5646 _Ignored),
5647 _Ignored).
5648/*
5649(defsetf rest set-cdr)
5650;;Redefined in extensible-sequences-base.lisp
5651*/
5652
5653/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15069 **********************/
5654:-lisp_compile_to_prolog(pkg_sys,[defsetf,rest,'set-cdr'])
5655/*
5656% macroexpand:-[defsetf,rest,sys_set_cdr].
5657*/
5658/*
5659% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,rest],[quote,sys_setf_inverse],[quote,sys_set_cdr]]].
5660*/
5661:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5662 f_sys_put_sysprop(rest, sys_setf_inverse, sys_set_cdr, [], _Ignored),
5663 _Ignored).
5664/*
5665;Redefined in extensible-sequences-base.lisp
5666*/
5667/*
5668(defsetf elt %set-elt)
5669*/
5670
5671/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15140 **********************/
5672:-lisp_compile_to_prolog(pkg_sys,[defsetf,elt,'%set-elt'])
5673/*
5674% macroexpand:-[defsetf,elt,sys_pf_set_elt].
5675*/
5676/*
5677% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,elt],[quote,sys_setf_inverse],[quote,sys_pf_set_elt]]].
5678*/
5679:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5680 f_sys_put_sysprop(elt, sys_setf_inverse, sys_pf_set_elt, [], _Ignored),
5681 _Ignored).
5682/*
5683(defsetf nth %set-nth)
5684*/
5685
5686/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15164 **********************/
5687:-lisp_compile_to_prolog(pkg_sys,[defsetf,nth,'%set-nth'])
5688/*
5689% macroexpand:-[defsetf,nth,sys_pf_set_nth].
5690*/
5691/*
5692% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,nth],[quote,sys_setf_inverse],[quote,sys_pf_set_nth]]].
5693*/
5694:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5695 f_sys_put_sysprop(nth, sys_setf_inverse, sys_pf_set_nth, [], _Ignored),
5696 _Ignored).
5697/*
5698(defsetf svref svset)
5699*/
5700
5701/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15188 **********************/
5702:-lisp_compile_to_prolog(pkg_sys,[defsetf,svref,svset])
5703/*
5704% macroexpand:-[defsetf,svref,sys_svset].
5705*/
5706/*
5707% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,svref],[quote,sys_setf_inverse],[quote,sys_svset]]].
5708*/
5709:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5710 f_sys_put_sysprop(svref, sys_setf_inverse, sys_svset, [], _Ignored),
5711 _Ignored).
5712/*
5713(defsetf fill-pointer %set-fill-pointer)
5714*/
5715
5716/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15211 **********************/
5717:-lisp_compile_to_prolog(pkg_sys,[defsetf,'fill-pointer','%set-fill-pointer'])
5718/*
5719% macroexpand:-[defsetf,fill_pointer,sys_pf_set_fill_pointer].
5720*/
5721/*
5722% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,fill_pointer],[quote,sys_setf_inverse],[quote,sys_pf_set_fill_pointer]]].
5723*/
5724:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5725 f_sys_put_sysprop(fill_pointer,
5726 sys_setf_inverse,
5727 sys_pf_set_fill_pointer,
5728 [],
5729 _Ignored),
5730 _Ignored).
5731/*
5732(defsetf subseq %set-subseq)
5733*/
5734
5735/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15253 **********************/
5736:-lisp_compile_to_prolog(pkg_sys,[defsetf,subseq,'%set-subseq'])
5737/*
5738% macroexpand:-[defsetf,subseq,sys_pf_set_subseq].
5739*/
5740/*
5741% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,subseq],[quote,sys_setf_inverse],[quote,sys_pf_set_subseq]]].
5742*/
5743:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5744 f_sys_put_sysprop(subseq,
5745 sys_setf_inverse,
5746 sys_pf_set_subseq,
5747 [],
5748 _Ignored),
5749 _Ignored).
5750/*
5751(defsetf symbol-value set)
5752*/
5753
5754/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15283 **********************/
5755:-lisp_compile_to_prolog(pkg_sys,[defsetf,'symbol-value',set])
5756/*
5757% macroexpand:-[defsetf,symbol_value,set].
5758*/
5759/*
5760% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,symbol_value],[quote,sys_setf_inverse],[quote,set]]].
5761*/
5762:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5763 f_sys_put_sysprop(symbol_value, sys_setf_inverse, set, [], _Ignored),
5764 _Ignored).
5765/*
5766(defsetf symbol-function %set-symbol-function)
5767*/
5768
5769/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15311 **********************/
5770:-lisp_compile_to_prolog(pkg_sys,[defsetf,'symbol-function','%set-symbol-function'])
5771/*
5772% macroexpand:-[defsetf,symbol_function,sys_pf_set_symbol_function].
5773*/
5774/*
5775% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,symbol_function],[quote,sys_setf_inverse],[quote,sys_pf_set_symbol_function]]].
5776*/
5777:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5778 f_sys_put_sysprop(symbol_function,
5779 sys_setf_inverse,
5780 sys_pf_set_symbol_function,
5781 [],
5782 _Ignored),
5783 _Ignored).
5784/*
5785(defsetf symbol-plist %set-symbol-plist)
5786*/
5787
5788/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15359 **********************/
5789:-lisp_compile_to_prolog(pkg_sys,[defsetf,'symbol-plist','%set-symbol-plist'])
5790/*
5791% macroexpand:-[defsetf,symbol_plist,sys_pf_set_symbol_plist].
5792*/
5793/*
5794% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,symbol_plist],[quote,sys_setf_inverse],[quote,sys_pf_set_symbol_plist]]].
5795*/
5796:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5797 f_sys_put_sysprop(symbol_plist,
5798 sys_setf_inverse,
5799 sys_pf_set_symbol_plist,
5800 [],
5801 _Ignored),
5802 _Ignored).
5803/*
5804(defsetf get put)
5805*/
5806
5807/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15401 **********************/
5808:-lisp_compile_to_prolog(pkg_sys,[defsetf,get,put])
5809/*
5810% macroexpand:-[defsetf,get,sys_put].
5811*/
5812/*
5813% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,get],[quote,sys_setf_inverse],[quote,sys_put]]].
5814*/
5815:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5816 f_sys_put_sysprop(get, sys_setf_inverse, sys_put, [], _Ignored),
5817 _Ignored).
5818/*
5819(defsetf gethash puthash)
5820*/
5821
5822/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15420 **********************/
5823:-lisp_compile_to_prolog(pkg_sys,[defsetf,gethash,puthash])
5824/*
5825% macroexpand:-[defsetf,gethash,sys_puthash].
5826*/
5827/*
5828% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,gethash],[quote,sys_setf_inverse],[quote,sys_puthash]]].
5829*/
5830:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5831 f_sys_put_sysprop(gethash, sys_setf_inverse, sys_puthash, [], _Ignored),
5832 _Ignored).
5833/*
5834(defsetf char set-char)
5835*/
5836
5837/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15447 **********************/
5838:-lisp_compile_to_prolog(pkg_sys,[defsetf,char,'set-char'])
5839/*
5840% macroexpand:-[defsetf,char,sys_set_char].
5841*/
5842/*
5843% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,char],[quote,sys_setf_inverse],[quote,sys_set_char]]].
5844*/
5845:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5846 f_sys_put_sysprop(char, sys_setf_inverse, sys_set_char, [], _Ignored),
5847 _Ignored).
5848/*
5849(defsetf schar set-schar)
5850*/
5851
5852/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15472 **********************/
5853:-lisp_compile_to_prolog(pkg_sys,[defsetf,schar,'set-schar'])
5854/*
5855% macroexpand:-[defsetf,schar,sys_set_schar].
5856*/
5857/*
5858% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,schar],[quote,sys_setf_inverse],[quote,sys_set_schar]]].
5859*/
5860:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5861 f_sys_put_sysprop(schar, sys_setf_inverse, sys_set_schar, [], _Ignored),
5862 _Ignored).
5863/*
5864(defsetf logical-pathname-translations %set-logical-pathname-translations)
5865*/
5866
5867/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15499 **********************/
5868:-lisp_compile_to_prolog(pkg_sys,[defsetf,'logical-pathname-translations','%set-logical-pathname-translations'])
5869/*
5870% macroexpand:-[defsetf,logical_pathname_translations,sys_pf_set_logical_pathname_translations].
5871*/
5872/*
5873% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,logical_pathname_translations],[quote,sys_setf_inverse],[quote,sys_pf_set_logical_pathname_translations]]].
5874*/
5875:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5876 f_sys_put_sysprop(logical_pathname_translations,
5877 sys_setf_inverse,
5878 sys_pf_set_logical_pathname_translations,
5879 [],
5880 _Ignored),
5881 _Ignored).
5882/*
5883(defsetf readtable-case %set-readtable-case)
5884
5885*/
5886
5887/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15575 **********************/
5888:-lisp_compile_to_prolog(pkg_sys,[defsetf,'readtable-case','%set-readtable-case'])
5889/*
5890% macroexpand:-[defsetf,readtable_case,sys_pf_set_readtable_case].
5891*/
5892/*
5893% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,readtable_case],[quote,sys_setf_inverse],[quote,sys_pf_set_readtable_case]]].
5894*/
5895:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5896 f_sys_put_sysprop(readtable_case,
5897 sys_setf_inverse,
5898 sys_pf_set_readtable_case,
5899 [],
5900 _Ignored),
5901 _Ignored).
5902/*
5903(defsetf function-info %set-function-info)
5904
5905*/
5906
5907/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15623 **********************/
5908:-lisp_compile_to_prolog(pkg_sys,[defsetf,'function-info','%set-function-info'])
5909/*
5910% macroexpand:-[defsetf,sys_function_info,sys_pf_set_function_info].
5911*/
5912/*
5913% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,sys_function_info],[quote,sys_setf_inverse],[quote,sys_pf_set_function_info]]].
5914*/
5915:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5916 f_sys_put_sysprop(sys_function_info,
5917 sys_setf_inverse,
5918 sys_pf_set_function_info,
5919 [],
5920 _Ignored),
5921 _Ignored).
5922/*
5923(defsetf stream-external-format %set-stream-external-format)
5924
5925*/
5926
5927/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15669 **********************/
5928:-lisp_compile_to_prolog(pkg_sys,[defsetf,'stream-external-format','%set-stream-external-format'])
5929/*
5930% macroexpand:-[defsetf,stream_external_format,sys_pf_set_stream_external_format].
5931*/
5932/*
5933% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,stream_external_format],[quote,sys_setf_inverse],[quote,sys_pf_set_stream_external_format]]].
5934*/
5935:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5936 f_sys_put_sysprop(stream_external_format,
5937 sys_setf_inverse,
5938 sys_pf_set_stream_external_format,
5939 [],
5940 _Ignored),
5941 _Ignored).
5942/*
5943(defsetf structure-ref structure-set)
5944
5945;; ) ;; FLET END
5946
5947
5948;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil; Package: SYSTEM -*-
5949;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
5950
5951;;;;
5952;;;; Copyright (c) 1995, Giuseppe Attardi.
5953;;;; Copyright (c) 2001, Juan Jose Garcia Ripoll.
5954;;;;
5955;;;; This program is free software; you can redistribute it and/or
5956;;;; modify it under the terms of the GNU Library General Public
5957;;;; License as published by the Free Software Foundation; either
5958;;;; version 2 of the License, or (at your option) any later version.
5959;;;;
5960;;;; See file '../Copyright' for full details.
5961;;;; list manipulating routines
5962
5963*/
5964
5965/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:15733 **********************/
5966:-lisp_compile_to_prolog(pkg_sys,[defsetf,'structure-ref','structure-set'])
5967/*
5968% macroexpand:-[defsetf,sys_structure_ref,sys_structure_set].
5969*/
5970/*
5971% into:-[eval_when,[kw_load_toplevel,kw_compile_toplevel,kw_execute],[sys_put_sysprop,[quote,sys_structure_ref],[quote,sys_setf_inverse],[quote,sys_structure_set]]].
5972*/
5973:- do_when([kw_load_toplevel, kw_compile_toplevel, kw_execute],
5974 f_sys_put_sysprop(sys_structure_ref,
5975 sys_setf_inverse,
5976 sys_structure_set,
5977 [],
5978 _Ignored),
5979 _Ignored).
5980/*
5981; ) ;; FLET END
5982*/
5983/*
5984;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil; Package: SYSTEM -*-
5985*/
5986/*
5987;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
5988*/
5989/*
5990;;;
5991*/
5992/*
5993;;; Copyright (c) 1995, Giuseppe Attardi.
5994*/
5995/*
5996;;; Copyright (c) 2001, Juan Jose Garcia Ripoll.
5997*/
5998/*
5999;;;
6000*/
6001/*
6002;;; This program is free software; you can redistribute it and/or
6003*/
6004/*
6005;;; modify it under the terms of the GNU Library General Public
6006*/
6007/*
6008;;; License as published by the Free Software Foundation; either
6009*/
6010/*
6011;;; version 2 of the License, or (at your option) any later version.
6012*/
6013/*
6014;;;
6015*/
6016/*
6017;;; See file '../Copyright' for full details.
6018*/
6019/*
6020;;; list manipulating routines
6021*/
6022/*
6023(in-package "SYSTEM")
6024
6025
6026*/
6027
6028/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:16455 **********************/
6029:-lisp_compile_to_prolog(pkg_sys,['in-package','$STRING'("SYSTEM")])
6030/*
6031% macroexpand:-[in_package,'$ARRAY'([*],claz_base_character,"SYSTEM")].
6032*/
6033/*
6034% into:-[eval_when,[kw_compile_toplevel,kw_load_toplevel,kw_execute],[sys_select_package,'$ARRAY'([*],claz_base_character,"SYSTEM")]].
6035*/
6036:- do_when([kw_compile_toplevel, kw_load_toplevel, kw_execute],
6037 f_sys_select_package('$ARRAY'([*], claz_base_character, "SYSTEM"),
6038 _Ignored),
6039 _Ignored).
6040/*
6041#+(or WAM-CL ECL)
6042(defun union (list1 list2 &key test test-not key)
6043 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)
6044Returns, as a list, the union of elements in LIST1 and in LIST2."
6045 (do ((x list1 (cdr x))
6046 (first) (last))
6047 ((null x)
6048 (when last (rplacd last list2))
6049 (or first list2))
6050 (unless (member1 (car x) list2 test test-not key)
6051 (if last
6052 (progn (rplacd last (cons (car x) nil))
6053 (setq last (cdr last)))
6054 (progn (setq first (cons (car x) nil))
6055 (setq last first))))))
6056
6057
6058*/
6059
6060/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:16482 **********************/
6061:-lisp_compile_to_prolog(pkg_sys,[defun,union,[list1,list2,'&key',test,'test-not',key],'$STRING'("Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns, as a list, the union of elements in LIST1 and in LIST2."),[do,[[x,list1,[cdr,x]],[first],[last]],[[null,x],[when,last,[rplacd,last,list2]],[or,first,list2]],[unless,[member1,[car,x],list2,test,'test-not',key],[if,last,[progn,[rplacd,last,[cons,[car,x],[]]],[setq,last,[cdr,last]]],[progn,[setq,first,[cons,[car,x],[]]],[setq,last,first]]]]]])
6062/*
6063:- side_effect(generate_function_or_macro_name(
6064 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6065 name='GLOBAL',
6066 environ=env_1
6067 ],
6068 sys_member1,
6069 kw_function,
6070 f_sys_member1)).
6071*/
6072/*
6073:- side_effect(generate_function_or_macro_name(
6074 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6075 name='GLOBAL',
6076 environ=env_1
6077 ],
6078 sys_member1,
6079 kw_function,
6080 f_sys_member1)).
6081*/
6082doc: doc_string(union,
6083 _9950,
6084 function,
6085 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns, as a list, the union of elements in LIST1 and in LIST2.").
6086
6087wl:lambda_def(defun, union, f_union, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], [[do, [[sys_x, sys_list1, [cdr, sys_x]], [first], [last]], [[null, sys_x], [when, last, [rplacd, last, sys_list2]], [or, first, sys_list2]], [unless, [sys_member1, [car, sys_x], sys_list2, sys_test, sys_test_not, key], [if, last, [progn, [rplacd, last, [cons, [car, sys_x], []]], [setq, last, [cdr, last]]], [progn, [setq, first, [cons, [car, sys_x], []]], [setq, last, first]]]]]]).
6088wl:arglist_info(union, f_union, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], arginfo{all:[sys_list1, sys_list2], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_test, sys_test_not, key], names:[sys_list1, sys_list2, sys_test, sys_test_not, key], opt:0, req:[sys_list1, sys_list2], rest:0, sublists:0, whole:0}).
6089wl: init_args(2, f_union).
6090
6095f_union(List1_In, List2_In, RestNKeys, FnResult) :-
6096 GEnv=[bv(sys_list1, List1_In), bv(sys_list2, List2_In), bv(sys_test, Test_In), bv(sys_test_not, Test_not_In), bv(key, Key_In)],
6097 get_kw(Env, RestNKeys, sys_test, sys_test, Test_In, []=Test_In, Test_P),
6098 get_kw(Env,
6099 RestNKeys,
6100 sys_test_not,
6101 sys_test_not,
6102 Test_not_In,
6103 []=Test_not_In,
6104 Test_not_P),
6105 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
6106 catch(( ( get_var(GEnv, sys_list1, List1_Get),
6107 AEnv=[bv(sys_x, List1_Get), bv([first], []), bv([last], [])|GEnv],
6108 catch(( call_addr_block(AEnv,
6109 (push_label(do_label_21), get_var(AEnv, sys_x, IFTEST58), (IFTEST58==[]->get_var(AEnv, last, IFTEST63), (IFTEST63\==[]->get_var(AEnv, last, Last_Get66), get_var(AEnv, sys_list2, List2_Get67), f_rplacd(Last_Get66, List2_Get67, TrueResult68), _11192=TrueResult68;_11192=[]), (get_var(AEnv, first, First_Get69), First_Get69\==[], RetResult61=First_Get69->true;get_var(AEnv, sys_list2, List2_Get70), RetResult61=List2_Get70), throw(block_exit([], RetResult61)), _TBResult=ThrowResult62;get_var(AEnv, sys_x, X_Get75), f_car(X_Get75, Member1_Param), get_var(AEnv, key, Key_Get79), get_var(AEnv, sys_list2, List2_Get76), get_var(AEnv, sys_test, Test_Get77), get_var(AEnv, sys_test_not, Test_not_Get78), f_sys_member1(Member1_Param, List2_Get76, Test_Get77, Test_not_Get78, Key_Get79, IFTEST73), (IFTEST73\==[]->_11446=[];get_var(AEnv, last, IFTEST80), (IFTEST80\==[]->get_var(AEnv, last, Last_Get83), get_var(AEnv, sys_x, X_Get84), f_car(X_Get84, Car_Ret), _11738=[Car_Ret], f_rplacd(Last_Get83, _11738, Rplacd_Ret), get_var(AEnv, last, Last_Get86), f_cdr(Last_Get86, TrueResult89), set_var(AEnv, last, TrueResult89), ElseResult91=TrueResult89;get_var(AEnv, sys_x, X_Get87), f_car(X_Get87, Car_Ret106), First=[Car_Ret106], set_var(AEnv, first, First), get_var(AEnv, first, First_Get88), set_var(AEnv, last, First_Get88), ElseResult91=First_Get88), _11446=ElseResult91), get_var(AEnv, sys_x, X_Get92), f_cdr(X_Get92, X), set_var(AEnv, sys_x, X), goto(do_label_21, AEnv), _TBResult=_GORES93)),
6110
6111 [ addr(addr_tagbody_21_do_label_21,
6112 do_label_21,
6113 '$unused',
6114 AEnv,
6115 (get_var(AEnv, sys_x, IFTEST), (IFTEST==[]->get_var(AEnv, last, IFTEST23), (IFTEST23\==[]->get_var(AEnv, last, Last_Get26), get_var(AEnv, sys_list2, Get_var_Ret), f_rplacd(Last_Get26, Get_var_Ret, Rplacd_Ret108), _12096=Rplacd_Ret108;_12096=[]), (get_var(AEnv, first, First_Get), First_Get\==[], Block_exit_Ret=First_Get->true;get_var(AEnv, sys_list2, List2_Get30), Block_exit_Ret=List2_Get30), throw(block_exit([], Block_exit_Ret)), _12128=ThrowResult;get_var(AEnv, sys_x, X_Get35), f_car(X_Get35, Member1_Param103), get_var(AEnv, key, Get_var_Ret110), get_var(AEnv, sys_list2, List2_Get36), get_var(AEnv, sys_test, Get_var_Ret111), get_var(AEnv, sys_test_not, Get_var_Ret112), f_sys_member1(Member1_Param103, List2_Get36, Get_var_Ret111, Get_var_Ret112, Get_var_Ret110, IFTEST33), (IFTEST33\==[]->_12194=[];get_var(AEnv, last, IFTEST40), (IFTEST40\==[]->get_var(AEnv, last, Last_Get43), get_var(AEnv, sys_x, X_Get44), f_car(X_Get44, Car_Ret113), _12240=[Car_Ret113], f_rplacd(Last_Get43, _12240, Rplacd_Ret114), get_var(AEnv, last, Last_Get46), f_cdr(Last_Get46, TrueResult49), set_var(AEnv, last, TrueResult49), ElseResult51=TrueResult49;get_var(AEnv, sys_x, X_Get47), f_car(X_Get47, Car_Ret115), Set_var_Ret=[Car_Ret115], set_var(AEnv, first, Set_var_Ret), get_var(AEnv, first, First_Get48), set_var(AEnv, last, First_Get48), ElseResult51=First_Get48), _12194=ElseResult51), get_var(AEnv, sys_x, X_Get52), f_cdr(X_Get52, Cdr_Ret), set_var(AEnv, sys_x, Cdr_Ret), goto(do_label_21, AEnv), _12128=_GORES)))
6116 ]),
6117 []=LetResult
6118 ),
6119 block_exit([], LetResult),
6120 true)
6121 ),
6122 LetResult=FnResult
6123 ),
6124 block_exit(union, FnResult),
6125 true).
6126:- set_opv(union, symbol_function, f_union),
6127 DefunResult=union. 6128/*
6129:- side_effect(assert_lsp(union,
6130 doc_string(union,
6131 _9950,
6132 function,
6133 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns, as a list, the union of elements in LIST1 and in LIST2."))).
6134*/
6135/*
6136:- side_effect(assert_lsp(union,
6137 lambda_def(defun,
6138 union,
6139 f_union,
6140
6141 [ sys_list1,
6142 sys_list2,
6143 c38_key,
6144 sys_test,
6145 sys_test_not,
6146 key
6147 ],
6148
6149 [
6150 [ do,
6151
6152 [ [sys_x, sys_list1, [cdr, sys_x]],
6153 [first],
6154 [last]
6155 ],
6156
6157 [ [null, sys_x],
6158 [when, last, [rplacd, last, sys_list2]],
6159 [or, first, sys_list2]
6160 ],
6161
6162 [ unless,
6163
6164 [ sys_member1,
6165 [car, sys_x],
6166 sys_list2,
6167 sys_test,
6168 sys_test_not,
6169 key
6170 ],
6171
6172 [ if,
6173 last,
6174
6175 [ progn,
6176
6177 [ rplacd,
6178 last,
6179 [cons, [car, sys_x], []]
6180 ],
6181 [setq, last, [cdr, last]]
6182 ],
6183
6184 [ progn,
6185
6186 [ setq,
6187 first,
6188 [cons, [car, sys_x], []]
6189 ],
6190 [setq, last, first]
6191 ]
6192 ]
6193 ]
6194 ]
6195 ]))).
6196*/
6197/*
6198:- side_effect(assert_lsp(union,
6199 arglist_info(union,
6200 f_union,
6201
6202 [ sys_list1,
6203 sys_list2,
6204 c38_key,
6205 sys_test,
6206 sys_test_not,
6207 key
6208 ],
6209 arginfo{ all:[sys_list1, sys_list2],
6210 allow_other_keys:0,
6211 aux:0,
6212 body:0,
6213 complex:0,
6214 env:0,
6215 key:
6216 [ sys_test,
6217 sys_test_not,
6218 key
6219 ],
6220 names:
6221 [ sys_list1,
6222 sys_list2,
6223 sys_test,
6224 sys_test_not,
6225 key
6226 ],
6227 opt:0,
6228 req:[sys_list1, sys_list2],
6229 rest:0,
6230 sublists:0,
6231 whole:0
6232 }))).
6233*/
6234/*
6235:- side_effect(assert_lsp(union, init_args(2, f_union))).
6236*/
6237/*
6238#+(or WAM-CL ECL)
6239(defun nunion (list1 list2 &key test test-not key)
6240 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)
6241Destructive UNION. Both LIST1 and LIST2 may be destroyed."
6242 (do ((x list1 (cdr x))
6243 (first) (last))
6244 ((null x)
6245 (when last (rplacd last list2))
6246 (or first list2))
6247 (unless (member1 (car x) list2 test test-not key)
6248 (if last
6249 (rplacd last x)
6250 (setq first x))
6251 (setq last x))))
6252
6253
6254*/
6255
6256/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:17079 **********************/
6257:-lisp_compile_to_prolog(pkg_sys,[defun,nunion,[list1,list2,'&key',test,'test-not',key],'$STRING'("Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive UNION. Both LIST1 and LIST2 may be destroyed."),[do,[[x,list1,[cdr,x]],[first],[last]],[[null,x],[when,last,[rplacd,last,list2]],[or,first,list2]],[unless,[member1,[car,x],list2,test,'test-not',key],[if,last,[rplacd,last,x],[setq,first,x]],[setq,last,x]]]])
6258/*
6259:- side_effect(generate_function_or_macro_name(
6260 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6261 name='GLOBAL',
6262 environ=env_1
6263 ],
6264 sys_member1,
6265 kw_function,
6266 f_sys_member1)).
6267*/
6268/*
6269:- side_effect(generate_function_or_macro_name(
6270 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6271 name='GLOBAL',
6272 environ=env_1
6273 ],
6274 sys_member1,
6275 kw_function,
6276 f_sys_member1)).
6277*/
6278doc: doc_string(nunion,
6279 _9380,
6280 function,
6281 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive UNION. Both LIST1 and LIST2 may be destroyed.").
6282
6283wl:lambda_def(defun, nunion, f_nunion, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], [[do, [[sys_x, sys_list1, [cdr, sys_x]], [first], [last]], [[null, sys_x], [when, last, [rplacd, last, sys_list2]], [or, first, sys_list2]], [unless, [sys_member1, [car, sys_x], sys_list2, sys_test, sys_test_not, key], [if, last, [rplacd, last, sys_x], [setq, first, sys_x]], [setq, last, sys_x]]]]).
6284wl:arglist_info(nunion, f_nunion, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], arginfo{all:[sys_list1, sys_list2], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_test, sys_test_not, key], names:[sys_list1, sys_list2, sys_test, sys_test_not, key], opt:0, req:[sys_list1, sys_list2], rest:0, sublists:0, whole:0}).
6285wl: init_args(2, f_nunion).
6286
6291f_nunion(List1_In, List2_In, RestNKeys, FnResult) :-
6292 GEnv=[bv(sys_list1, List1_In), bv(sys_list2, List2_In), bv(sys_test, Test_In), bv(sys_test_not, Test_not_In), bv(key, Key_In)],
6293 get_kw(Env, RestNKeys, sys_test, sys_test, Test_In, []=Test_In, Test_P),
6294 get_kw(Env,
6295 RestNKeys,
6296 sys_test_not,
6297 sys_test_not,
6298 Test_not_In,
6299 []=Test_not_In,
6300 Test_not_P),
6301 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
6302 catch(( ( get_var(GEnv, sys_list1, List1_Get),
6303 AEnv=[bv(sys_x, List1_Get), bv([first], []), bv([last], [])|GEnv],
6304 catch(( call_addr_block(AEnv,
6305 (push_label(do_label_22), get_var(AEnv, sys_x, IFTEST57), (IFTEST57==[]->get_var(AEnv, last, IFTEST62), (IFTEST62\==[]->get_var(AEnv, last, Last_Get65), get_var(AEnv, sys_list2, List2_Get66), f_rplacd(Last_Get65, List2_Get66, TrueResult67), _10580=TrueResult67;_10580=[]), (get_var(AEnv, first, First_Get68), First_Get68\==[], RetResult60=First_Get68->true;get_var(AEnv, sys_list2, List2_Get69), RetResult60=List2_Get69), throw(block_exit([], RetResult60)), _TBResult=ThrowResult61;get_var(AEnv, sys_x, X_Get74), f_car(X_Get74, Member1_Param), get_var(AEnv, key, Key_Get78), get_var(AEnv, sys_list2, List2_Get75), get_var(AEnv, sys_test, Test_Get76), get_var(AEnv, sys_test_not, Test_not_Get77), f_sys_member1(Member1_Param, List2_Get75, Test_Get76, Test_not_Get77, Key_Get78, IFTEST72), (IFTEST72\==[]->_10834=[];get_var(AEnv, last, IFTEST79), (IFTEST79\==[]->get_var(AEnv, last, Last_Get82), get_var(AEnv, sys_x, X_Get83), f_rplacd(Last_Get82, X_Get83, TrueResult86), _11020=TrueResult86;get_var(AEnv, sys_x, X_Get85), set_var(AEnv, first, X_Get85), _11020=X_Get85), get_var(AEnv, sys_x, X_Get88), set_var(AEnv, last, X_Get88), _10834=X_Get88), get_var(AEnv, sys_x, X_Get90), f_cdr(X_Get90, X), set_var(AEnv, sys_x, X), goto(do_label_22, AEnv), _TBResult=_GORES91)),
6306
6307 [ addr(addr_tagbody_22_do_label_22,
6308 do_label_22,
6309 '$unused',
6310 AEnv,
6311 (get_var(AEnv, sys_x, IFTEST), (IFTEST==[]->get_var(AEnv, last, IFTEST23), (IFTEST23\==[]->get_var(AEnv, last, Last_Get26), get_var(AEnv, sys_list2, Get_var_Ret), f_rplacd(Last_Get26, Get_var_Ret, Rplacd_Ret), _11434=Rplacd_Ret;_11434=[]), (get_var(AEnv, first, First_Get), First_Get\==[], Block_exit_Ret=First_Get->true;get_var(AEnv, sys_list2, List2_Get30), Block_exit_Ret=List2_Get30), throw(block_exit([], Block_exit_Ret)), _11466=ThrowResult;get_var(AEnv, sys_x, X_Get35), f_car(X_Get35, Member1_Param100), get_var(AEnv, key, Get_var_Ret104), get_var(AEnv, sys_list2, List2_Get36), get_var(AEnv, sys_test, Get_var_Ret105), get_var(AEnv, sys_test_not, Get_var_Ret106), f_sys_member1(Member1_Param100, List2_Get36, Get_var_Ret105, Get_var_Ret106, Get_var_Ret104, IFTEST33), (IFTEST33\==[]->_11532=[];get_var(AEnv, last, IFTEST40), (IFTEST40\==[]->get_var(AEnv, last, Last_Get43), get_var(AEnv, sys_x, X_Get44), f_rplacd(Last_Get43, X_Get44, TrueResult47), _11590=TrueResult47;get_var(AEnv, sys_x, X_Get46), set_var(AEnv, first, X_Get46), _11590=X_Get46), get_var(AEnv, sys_x, X_Get49), set_var(AEnv, last, X_Get49), _11532=X_Get49), get_var(AEnv, sys_x, X_Get51), f_cdr(X_Get51, Cdr_Ret), set_var(AEnv, sys_x, Cdr_Ret), goto(do_label_22, AEnv), _11466=_GORES)))
6312 ]),
6313 []=LetResult
6314 ),
6315 block_exit([], LetResult),
6316 true)
6317 ),
6318 LetResult=FnResult
6319 ),
6320 block_exit(nunion, FnResult),
6321 true).
6322:- set_opv(nunion, symbol_function, f_nunion),
6323 DefunResult=nunion. 6324/*
6325:- side_effect(assert_lsp(nunion,
6326 doc_string(nunion,
6327 _9380,
6328 function,
6329 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive UNION. Both LIST1 and LIST2 may be destroyed."))).
6330*/
6331/*
6332:- side_effect(assert_lsp(nunion,
6333 lambda_def(defun,
6334 nunion,
6335 f_nunion,
6336
6337 [ sys_list1,
6338 sys_list2,
6339 c38_key,
6340 sys_test,
6341 sys_test_not,
6342 key
6343 ],
6344
6345 [
6346 [ do,
6347
6348 [ [sys_x, sys_list1, [cdr, sys_x]],
6349 [first],
6350 [last]
6351 ],
6352
6353 [ [null, sys_x],
6354 [when, last, [rplacd, last, sys_list2]],
6355 [or, first, sys_list2]
6356 ],
6357
6358 [ unless,
6359
6360 [ sys_member1,
6361 [car, sys_x],
6362 sys_list2,
6363 sys_test,
6364 sys_test_not,
6365 key
6366 ],
6367
6368 [ if,
6369 last,
6370 [rplacd, last, sys_x],
6371 [setq, first, sys_x]
6372 ],
6373 [setq, last, sys_x]
6374 ]
6375 ]
6376 ]))).
6377*/
6378/*
6379:- side_effect(assert_lsp(nunion,
6380 arglist_info(nunion,
6381 f_nunion,
6382
6383 [ sys_list1,
6384 sys_list2,
6385 c38_key,
6386 sys_test,
6387 sys_test_not,
6388 key
6389 ],
6390 arginfo{ all:[sys_list1, sys_list2],
6391 allow_other_keys:0,
6392 aux:0,
6393 body:0,
6394 complex:0,
6395 env:0,
6396 key:
6397 [ sys_test,
6398 sys_test_not,
6399 key
6400 ],
6401 names:
6402 [ sys_list1,
6403 sys_list2,
6404 sys_test,
6405 sys_test_not,
6406 key
6407 ],
6408 opt:0,
6409 req:[sys_list1, sys_list2],
6410 rest:0,
6411 sublists:0,
6412 whole:0
6413 }))).
6414*/
6415/*
6416:- side_effect(assert_lsp(nunion, init_args(2, f_nunion))).
6417*/
6418/*
6419#+(or WAM-CL ECL)
6420(defun intersection (list1 list2 &key test test-not key)
6421 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)
6422Returns a list consisting of those objects that are elements of both LIST1 and
6423LIST2."
6424 (do ((x list1 (cdr x))
6425 (ans))
6426 ((null x)
6427 (nreverse ans)) ; optional nreverse: not required by CLtL
6428 (when (member1 (car x) list2 test test-not key)
6429 (push (car x) ans))))
6430
6431
6432*/
6433
6434/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:17566 **********************/
6435:-lisp_compile_to_prolog(pkg_sys,[defun,intersection,[list1,list2,'&key',test,'test-not',key],'$STRING'("Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns a list consisting of those objects that are elements of both LIST1 and\r\nLIST2."),[do,[[x,list1,[cdr,x]],[ans]],[[null,x],[nreverse,ans]],[when,[member1,[car,x],list2,test,'test-not',key],[push,[car,x],ans]]]])
6436/*
6437:- side_effect(generate_function_or_macro_name(
6438 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6439 name='GLOBAL',
6440 environ=env_1
6441 ],
6442 sys_member1,
6443 kw_function,
6444 f_sys_member1)).
6445*/
6446/*
6447% macroexpand:-[push,[car,sys_x],sys_ans].
6448*/
6449/*
6450% into:-[setq,sys_ans,[cons,[car,sys_x],sys_ans]].
6451*/
6452/*
6453:- side_effect(generate_function_or_macro_name(
6454 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6455 name='GLOBAL',
6456 environ=env_1
6457 ],
6458 sys_member1,
6459 kw_function,
6460 f_sys_member1)).
6461*/
6462/*
6463% macroexpand:-[push,[car,sys_x],sys_ans].
6464*/
6465/*
6466% into:-[setq,sys_ans,[cons,[car,sys_x],sys_ans]].
6467*/
6468doc: doc_string(intersection,
6469 _9198,
6470 function,
6471 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns a list consisting of those objects that are elements of both LIST1 and\r\nLIST2.").
6472
6473wl:lambda_def(defun, intersection, f_intersection, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], [[do, [[sys_x, sys_list1, [cdr, sys_x]], [sys_ans]], [[null, sys_x], [nreverse, sys_ans]], [when, [sys_member1, [car, sys_x], sys_list2, sys_test, sys_test_not, key], [push, [car, sys_x], sys_ans]]]]).
6474wl:arglist_info(intersection, f_intersection, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], arginfo{all:[sys_list1, sys_list2], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_test, sys_test_not, key], names:[sys_list1, sys_list2, sys_test, sys_test_not, key], opt:0, req:[sys_list1, sys_list2], rest:0, sublists:0, whole:0}).
6475wl: init_args(2, f_intersection).
6476
6481f_intersection(List1_In, List2_In, RestNKeys, FnResult) :-
6482 GEnv=[bv(sys_list1, List1_In), bv(sys_list2, List2_In), bv(sys_test, Test_In), bv(sys_test_not, Test_not_In), bv(key, Key_In)],
6483 get_kw(Env, RestNKeys, sys_test, sys_test, Test_In, []=Test_In, Test_P),
6484 get_kw(Env,
6485 RestNKeys,
6486 sys_test_not,
6487 sys_test_not,
6488 Test_not_In,
6489 []=Test_not_In,
6490 Test_not_P),
6491 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
6492 catch(( ( get_var(GEnv, sys_list1, List1_Get),
6493 AEnv=[bv(sys_x, List1_Get), bv([sys_ans], [])|GEnv],
6494 catch(( call_addr_block(AEnv,
6495 (push_label(do_label_23), get_var(AEnv, sys_x, IFTEST42), (IFTEST42==[]->get_var(AEnv, sys_ans, Ans_Get47), f_nreverse(Ans_Get47, RetResult45), throw(block_exit([], RetResult45)), _TBResult=ThrowResult46;get_var(AEnv, sys_x, X_Get51), f_car(X_Get51, Member1_Param), get_var(AEnv, key, Key_Get55), get_var(AEnv, sys_list2, List2_Get52), get_var(AEnv, sys_test, Test_Get53), get_var(AEnv, sys_test_not, Test_not_Get54), f_sys_member1(Member1_Param, List2_Get52, Test_Get53, Test_not_Get54, Key_Get55, IFTEST49), (IFTEST49\==[]->get_var(AEnv, sys_x, X_Get57), f_car(X_Get57, Car_Ret), get_var(AEnv, sys_ans, Ans_Get58), TrueResult59=[Car_Ret|Ans_Get58], set_var(AEnv, sys_ans, TrueResult59), _10104=TrueResult59;_10104=[]), get_var(AEnv, sys_x, X_Get60), f_cdr(X_Get60, X), set_var(AEnv, sys_x, X), goto(do_label_23, AEnv), _TBResult=_GORES61)),
6496
6497 [ addr(addr_tagbody_23_do_label_23,
6498 do_label_23,
6499 '$unused',
6500 AEnv,
6501 (get_var(AEnv, sys_x, IFTEST), (IFTEST==[]->get_var(AEnv, sys_ans, Nreverse_Param), f_nreverse(Nreverse_Param, Nreverse_Ret), throw(block_exit([], Nreverse_Ret)), _10532=ThrowResult;get_var(AEnv, sys_x, X_Get27), f_car(X_Get27, Member1_Param71), get_var(AEnv, key, Get_var_Ret), get_var(AEnv, sys_list2, Get_var_Ret75), get_var(AEnv, sys_test, Get_var_Ret76), get_var(AEnv, sys_test_not, Get_var_Ret77), f_sys_member1(Member1_Param71, Get_var_Ret75, Get_var_Ret76, Get_var_Ret77, Get_var_Ret, IFTEST25), (IFTEST25\==[]->get_var(AEnv, sys_x, X_Get33), f_car(X_Get33, Car_Ret78), get_var(AEnv, sys_ans, Ans_Get34), Set_var_Ret=[Car_Ret78|Ans_Get34], set_var(AEnv, sys_ans, Set_var_Ret), _10618=Set_var_Ret;_10618=[]), get_var(AEnv, sys_x, X_Get36), f_cdr(X_Get36, Cdr_Ret), set_var(AEnv, sys_x, Cdr_Ret), goto(do_label_23, AEnv), _10532=_GORES)))
6502 ]),
6503 []=LetResult
6504 ),
6505 block_exit([], LetResult),
6506 true)
6507 ),
6508 LetResult=FnResult
6509 ),
6510 block_exit(intersection, FnResult),
6511 true).
6512:- set_opv(intersection, symbol_function, f_intersection),
6513 DefunResult=intersection. 6514/*
6515:- side_effect(assert_lsp(intersection,
6516 doc_string(intersection,
6517 _9198,
6518 function,
6519 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns a list consisting of those objects that are elements of both LIST1 and\r\nLIST2."))).
6520*/
6521/*
6522:- side_effect(assert_lsp(intersection,
6523 lambda_def(defun,
6524 intersection,
6525 f_intersection,
6526
6527 [ sys_list1,
6528 sys_list2,
6529 c38_key,
6530 sys_test,
6531 sys_test_not,
6532 key
6533 ],
6534
6535 [
6536 [ do,
6537
6538 [ [sys_x, sys_list1, [cdr, sys_x]],
6539 [sys_ans]
6540 ],
6541 [[null, sys_x], [nreverse, sys_ans]],
6542
6543 [ when,
6544
6545 [ sys_member1,
6546 [car, sys_x],
6547 sys_list2,
6548 sys_test,
6549 sys_test_not,
6550 key
6551 ],
6552 [push, [car, sys_x], sys_ans]
6553 ]
6554 ]
6555 ]))).
6556*/
6557/*
6558:- side_effect(assert_lsp(intersection,
6559 arglist_info(intersection,
6560 f_intersection,
6561
6562 [ sys_list1,
6563 sys_list2,
6564 c38_key,
6565 sys_test,
6566 sys_test_not,
6567 key
6568 ],
6569 arginfo{ all:[sys_list1, sys_list2],
6570 allow_other_keys:0,
6571 aux:0,
6572 body:0,
6573 complex:0,
6574 env:0,
6575 key:
6576 [ sys_test,
6577 sys_test_not,
6578 key
6579 ],
6580 names:
6581 [ sys_list1,
6582 sys_list2,
6583 sys_test,
6584 sys_test_not,
6585 key
6586 ],
6587 opt:0,
6588 req:[sys_list1, sys_list2],
6589 rest:0,
6590 sublists:0,
6591 whole:0
6592 }))).
6593*/
6594/*
6595:- side_effect(assert_lsp(intersection, init_args(2, f_intersection))).
6596*/
6597/*
6598 optional nreverse: not required by CLtL
6599*/
6600/*
6601#+(or WAM-CL ECL)
6602(defun nintersection (list1 list2 &key test test-not key)
6603 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)
6604Destructive INTERSECTION. Only LIST1 may be destroyed."
6605 (do ((x list1 (cdr x))
6606 (first) (last))
6607 ((null x)
6608 (when last (rplacd last nil))
6609 first)
6610 (when (member1 (car x) list2 test test-not key)
6611 (if last
6612 (rplacd last x)
6613 (setq first x))
6614 (setq last x))))
6615
6616
6617*/
6618
6619/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:18013 **********************/
6620:-lisp_compile_to_prolog(pkg_sys,[defun,nintersection,[list1,list2,'&key',test,'test-not',key],'$STRING'("Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive INTERSECTION. Only LIST1 may be destroyed."),[do,[[x,list1,[cdr,x]],[first],[last]],[[null,x],[when,last,[rplacd,last,[]]],first],[when,[member1,[car,x],list2,test,'test-not',key],[if,last,[rplacd,last,x],[setq,first,x]],[setq,last,x]]]])
6621/*
6622:- side_effect(generate_function_or_macro_name(
6623 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6624 name='GLOBAL',
6625 environ=env_1
6626 ],
6627 sys_member1,
6628 kw_function,
6629 f_sys_member1)).
6630*/
6631/*
6632:- side_effect(generate_function_or_macro_name(
6633 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6634 name='GLOBAL',
6635 environ=env_1
6636 ],
6637 sys_member1,
6638 kw_function,
6639 f_sys_member1)).
6640*/
6641doc: doc_string(nintersection,
6642 _9274,
6643 function,
6644 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive INTERSECTION. Only LIST1 may be destroyed.").
6645
6646wl:lambda_def(defun, nintersection, f_nintersection, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], [[do, [[sys_x, sys_list1, [cdr, sys_x]], [first], [last]], [[null, sys_x], [when, last, [rplacd, last, []]], first], [when, [sys_member1, [car, sys_x], sys_list2, sys_test, sys_test_not, key], [if, last, [rplacd, last, sys_x], [setq, first, sys_x]], [setq, last, sys_x]]]]).
6647wl:arglist_info(nintersection, f_nintersection, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], arginfo{all:[sys_list1, sys_list2], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_test, sys_test_not, key], names:[sys_list1, sys_list2, sys_test, sys_test_not, key], opt:0, req:[sys_list1, sys_list2], rest:0, sublists:0, whole:0}).
6648wl: init_args(2, f_nintersection).
6649
6654f_nintersection(List1_In, List2_In, RestNKeys, FnResult) :-
6655 GEnv=[bv(sys_list1, List1_In), bv(sys_list2, List2_In), bv(sys_test, Test_In), bv(sys_test_not, Test_not_In), bv(key, Key_In)],
6656 get_kw(Env, RestNKeys, sys_test, sys_test, Test_In, []=Test_In, Test_P),
6657 get_kw(Env,
6658 RestNKeys,
6659 sys_test_not,
6660 sys_test_not,
6661 Test_not_In,
6662 []=Test_not_In,
6663 Test_not_P),
6664 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
6665 catch(( ( get_var(GEnv, sys_list1, List1_Get),
6666 AEnv=[bv(sys_x, List1_Get), bv([first], []), bv([last], [])|GEnv],
6667 catch(( call_addr_block(AEnv,
6668 (push_label(do_label_24), get_var(AEnv, sys_x, IFTEST54), (IFTEST54==[]->get_var(AEnv, last, IFTEST59), (IFTEST59\==[]->get_var(AEnv, last, Last_Get62), f_rplacd(Last_Get62, [], TrueResult63), _10394=TrueResult63;_10394=[]), get_var(AEnv, first, RetResult57), throw(block_exit([], RetResult57)), _TBResult=ThrowResult58;get_var(AEnv, sys_x, X_Get68), f_car(X_Get68, Member1_Param), get_var(AEnv, key, Key_Get72), get_var(AEnv, sys_list2, List2_Get69), get_var(AEnv, sys_test, Test_Get70), get_var(AEnv, sys_test_not, Test_not_Get71), f_sys_member1(Member1_Param, List2_Get69, Test_Get70, Test_not_Get71, Key_Get72, IFTEST66), (IFTEST66\==[]->get_var(AEnv, last, IFTEST73), (IFTEST73\==[]->get_var(AEnv, last, Last_Get76), get_var(AEnv, sys_x, X_Get77), f_rplacd(Last_Get76, X_Get77, TrueResult80), _10766=TrueResult80;get_var(AEnv, sys_x, X_Get79), set_var(AEnv, first, X_Get79), _10766=X_Get79), get_var(AEnv, sys_x, X_Get82), set_var(AEnv, last, X_Get82), _10580=X_Get82;_10580=[]), get_var(AEnv, sys_x, X_Get84), f_cdr(X_Get84, X), set_var(AEnv, sys_x, X), goto(do_label_24, AEnv), _TBResult=_GORES85)),
6669
6670 [ addr(addr_tagbody_24_do_label_24,
6671 do_label_24,
6672 '$unused',
6673 AEnv,
6674 (get_var(AEnv, sys_x, IFTEST), (IFTEST==[]->get_var(AEnv, last, IFTEST23), (IFTEST23\==[]->get_var(AEnv, last, Last_Get26), f_rplacd(Last_Get26, [], Rplacd_Ret), _11178=Rplacd_Ret;_11178=[]), get_var(AEnv, first, Get_var_Ret), throw(block_exit([], Get_var_Ret)), _11182=ThrowResult;get_var(AEnv, sys_x, X_Get32), f_car(X_Get32, Member1_Param94), get_var(AEnv, key, Get_var_Ret97), get_var(AEnv, sys_list2, Get_var_Ret98), get_var(AEnv, sys_test, Get_var_Ret99), get_var(AEnv, sys_test_not, Get_var_Ret100), f_sys_member1(Member1_Param94, Get_var_Ret98, Get_var_Ret99, Get_var_Ret100, Get_var_Ret97, IFTEST30), (IFTEST30\==[]->get_var(AEnv, last, IFTEST37), (IFTEST37\==[]->get_var(AEnv, last, Last_Get40), get_var(AEnv, sys_x, X_Get41), f_rplacd(Last_Get40, X_Get41, TrueResult44), _11292=TrueResult44;get_var(AEnv, sys_x, X_Get43), set_var(AEnv, first, X_Get43), _11292=X_Get43), get_var(AEnv, sys_x, X_Get46), set_var(AEnv, last, X_Get46), _11322=X_Get46;_11322=[]), get_var(AEnv, sys_x, X_Get48), f_cdr(X_Get48, Cdr_Ret), set_var(AEnv, sys_x, Cdr_Ret), goto(do_label_24, AEnv), _11182=_GORES)))
6675 ]),
6676 []=LetResult
6677 ),
6678 block_exit([], LetResult),
6679 true)
6680 ),
6681 LetResult=FnResult
6682 ),
6683 block_exit(nintersection, FnResult),
6684 true).
6685:- set_opv(nintersection, symbol_function, f_nintersection),
6686 DefunResult=nintersection. 6687/*
6688:- side_effect(assert_lsp(nintersection,
6689 doc_string(nintersection,
6690 _9274,
6691 function,
6692 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive INTERSECTION. Only LIST1 may be destroyed."))).
6693*/
6694/*
6695:- side_effect(assert_lsp(nintersection,
6696 lambda_def(defun,
6697 nintersection,
6698 f_nintersection,
6699
6700 [ sys_list1,
6701 sys_list2,
6702 c38_key,
6703 sys_test,
6704 sys_test_not,
6705 key
6706 ],
6707
6708 [
6709 [ do,
6710
6711 [ [sys_x, sys_list1, [cdr, sys_x]],
6712 [first],
6713 [last]
6714 ],
6715
6716 [ [null, sys_x],
6717 [when, last, [rplacd, last, []]],
6718 first
6719 ],
6720
6721 [ when,
6722
6723 [ sys_member1,
6724 [car, sys_x],
6725 sys_list2,
6726 sys_test,
6727 sys_test_not,
6728 key
6729 ],
6730
6731 [ if,
6732 last,
6733 [rplacd, last, sys_x],
6734 [setq, first, sys_x]
6735 ],
6736 [setq, last, sys_x]
6737 ]
6738 ]
6739 ]))).
6740*/
6741/*
6742:- side_effect(assert_lsp(nintersection,
6743 arglist_info(nintersection,
6744 f_nintersection,
6745
6746 [ sys_list1,
6747 sys_list2,
6748 c38_key,
6749 sys_test,
6750 sys_test_not,
6751 key
6752 ],
6753 arginfo{ all:[sys_list1, sys_list2],
6754 allow_other_keys:0,
6755 aux:0,
6756 body:0,
6757 complex:0,
6758 env:0,
6759 key:
6760 [ sys_test,
6761 sys_test_not,
6762 key
6763 ],
6764 names:
6765 [ sys_list1,
6766 sys_list2,
6767 sys_test,
6768 sys_test_not,
6769 key
6770 ],
6771 opt:0,
6772 req:[sys_list1, sys_list2],
6773 rest:0,
6774 sublists:0,
6775 whole:0
6776 }))).
6777*/
6778/*
6779:- side_effect(assert_lsp(nintersection, init_args(2, f_nintersection))).
6780*/
6781/*
6782#+(or WAM-CL ECL)
6783(defun set-difference (list1 list2 &key test test-not key)
6784 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)
6785Returns, as a list, those elements of LIST1 that are not elements of LIST2."
6786 (do ((x list1 (cdr x))
6787 (ans))
6788 ((null x) (nreverse ans))
6789 (unless (member1 (car x) list2 test test-not key)
6790 (push (car x) ans))))
6791
6792
6793*/
6794
6795/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:18489 **********************/
6796:-lisp_compile_to_prolog(pkg_sys,[defun,'set-difference',[list1,list2,'&key',test,'test-not',key],'$STRING'("Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns, as a list, those elements of LIST1 that are not elements of LIST2."),[do,[[x,list1,[cdr,x]],[ans]],[[null,x],[nreverse,ans]],[unless,[member1,[car,x],list2,test,'test-not',key],[push,[car,x],ans]]]])
6797/*
6798:- side_effect(generate_function_or_macro_name(
6799 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6800 name='GLOBAL',
6801 environ=env_1
6802 ],
6803 sys_member1,
6804 kw_function,
6805 f_sys_member1)).
6806*/
6807/*
6808% macroexpand:-[push,[car,sys_x],sys_ans].
6809*/
6810/*
6811% into:-[setq,sys_ans,[cons,[car,sys_x],sys_ans]].
6812*/
6813/*
6814:- side_effect(generate_function_or_macro_name(
6815 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6816 name='GLOBAL',
6817 environ=env_1
6818 ],
6819 sys_member1,
6820 kw_function,
6821 f_sys_member1)).
6822*/
6823/*
6824% macroexpand:-[push,[car,sys_x],sys_ans].
6825*/
6826/*
6827% into:-[setq,sys_ans,[cons,[car,sys_x],sys_ans]].
6828*/
6829doc: doc_string(set_difference,
6830 _9064,
6831 function,
6832 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns, as a list, those elements of LIST1 that are not elements of LIST2.").
6833
6834wl:lambda_def(defun, set_difference, f_set_difference, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], [[do, [[sys_x, sys_list1, [cdr, sys_x]], [sys_ans]], [[null, sys_x], [nreverse, sys_ans]], [unless, [sys_member1, [car, sys_x], sys_list2, sys_test, sys_test_not, key], [push, [car, sys_x], sys_ans]]]]).
6835wl:arglist_info(set_difference, f_set_difference, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], arginfo{all:[sys_list1, sys_list2], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_test, sys_test_not, key], names:[sys_list1, sys_list2, sys_test, sys_test_not, key], opt:0, req:[sys_list1, sys_list2], rest:0, sublists:0, whole:0}).
6836wl: init_args(2, f_set_difference).
6837
6842f_set_difference(List1_In, List2_In, RestNKeys, FnResult) :-
6843 GEnv=[bv(sys_list1, List1_In), bv(sys_list2, List2_In), bv(sys_test, Test_In), bv(sys_test_not, Test_not_In), bv(key, Key_In)],
6844 get_kw(Env, RestNKeys, sys_test, sys_test, Test_In, []=Test_In, Test_P),
6845 get_kw(Env,
6846 RestNKeys,
6847 sys_test_not,
6848 sys_test_not,
6849 Test_not_In,
6850 []=Test_not_In,
6851 Test_not_P),
6852 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
6853 catch(( ( get_var(GEnv, sys_list1, List1_Get),
6854 AEnv=[bv(sys_x, List1_Get), bv([sys_ans], [])|GEnv],
6855 catch(( call_addr_block(AEnv,
6856 (push_label(do_label_25), get_var(AEnv, sys_x, IFTEST42), (IFTEST42==[]->get_var(AEnv, sys_ans, Ans_Get47), f_nreverse(Ans_Get47, RetResult45), throw(block_exit([], RetResult45)), _TBResult=ThrowResult46;get_var(AEnv, sys_x, X_Get51), f_car(X_Get51, Member1_Param), get_var(AEnv, key, Key_Get55), get_var(AEnv, sys_list2, List2_Get52), get_var(AEnv, sys_test, Test_Get53), get_var(AEnv, sys_test_not, Test_not_Get54), f_sys_member1(Member1_Param, List2_Get52, Test_Get53, Test_not_Get54, Key_Get55, IFTEST49), (IFTEST49\==[]->_9970=[];get_var(AEnv, sys_x, X_Get57), f_car(X_Get57, Car_Ret), get_var(AEnv, sys_ans, Ans_Get58), ElseResult59=[Car_Ret|Ans_Get58], set_var(AEnv, sys_ans, ElseResult59), _9970=ElseResult59), get_var(AEnv, sys_x, X_Get60), f_cdr(X_Get60, X), set_var(AEnv, sys_x, X), goto(do_label_25, AEnv), _TBResult=_GORES61)),
6857
6858 [ addr(addr_tagbody_25_do_label_25,
6859 do_label_25,
6860 '$unused',
6861 AEnv,
6862 (get_var(AEnv, sys_x, IFTEST), (IFTEST==[]->get_var(AEnv, sys_ans, Nreverse_Param), f_nreverse(Nreverse_Param, Nreverse_Ret), throw(block_exit([], Nreverse_Ret)), _10398=ThrowResult;get_var(AEnv, sys_x, X_Get27), f_car(X_Get27, Member1_Param71), get_var(AEnv, key, Get_var_Ret), get_var(AEnv, sys_list2, Get_var_Ret75), get_var(AEnv, sys_test, Get_var_Ret76), get_var(AEnv, sys_test_not, Get_var_Ret77), f_sys_member1(Member1_Param71, Get_var_Ret75, Get_var_Ret76, Get_var_Ret77, Get_var_Ret, IFTEST25), (IFTEST25\==[]->_10452=[];get_var(AEnv, sys_x, X_Get33), f_car(X_Get33, Car_Ret78), get_var(AEnv, sys_ans, Ans_Get34), Set_var_Ret=[Car_Ret78|Ans_Get34], set_var(AEnv, sys_ans, Set_var_Ret), _10452=Set_var_Ret), get_var(AEnv, sys_x, X_Get36), f_cdr(X_Get36, Cdr_Ret), set_var(AEnv, sys_x, Cdr_Ret), goto(do_label_25, AEnv), _10398=_GORES)))
6863 ]),
6864 []=LetResult
6865 ),
6866 block_exit([], LetResult),
6867 true)
6868 ),
6869 LetResult=FnResult
6870 ),
6871 block_exit(set_difference, FnResult),
6872 true).
6873:- set_opv(set_difference, symbol_function, f_set_difference),
6874 DefunResult=set_difference. 6875/*
6876:- side_effect(assert_lsp(set_difference,
6877 doc_string(set_difference,
6878 _9064,
6879 function,
6880 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns, as a list, those elements of LIST1 that are not elements of LIST2."))).
6881*/
6882/*
6883:- side_effect(assert_lsp(set_difference,
6884 lambda_def(defun,
6885 set_difference,
6886 f_set_difference,
6887
6888 [ sys_list1,
6889 sys_list2,
6890 c38_key,
6891 sys_test,
6892 sys_test_not,
6893 key
6894 ],
6895
6896 [
6897 [ do,
6898
6899 [ [sys_x, sys_list1, [cdr, sys_x]],
6900 [sys_ans]
6901 ],
6902 [[null, sys_x], [nreverse, sys_ans]],
6903
6904 [ unless,
6905
6906 [ sys_member1,
6907 [car, sys_x],
6908 sys_list2,
6909 sys_test,
6910 sys_test_not,
6911 key
6912 ],
6913 [push, [car, sys_x], sys_ans]
6914 ]
6915 ]
6916 ]))).
6917*/
6918/*
6919:- side_effect(assert_lsp(set_difference,
6920 arglist_info(set_difference,
6921 f_set_difference,
6922
6923 [ sys_list1,
6924 sys_list2,
6925 c38_key,
6926 sys_test,
6927 sys_test_not,
6928 key
6929 ],
6930 arginfo{ all:[sys_list1, sys_list2],
6931 allow_other_keys:0,
6932 aux:0,
6933 body:0,
6934 complex:0,
6935 env:0,
6936 key:
6937 [ sys_test,
6938 sys_test_not,
6939 key
6940 ],
6941 names:
6942 [ sys_list1,
6943 sys_list2,
6944 sys_test,
6945 sys_test_not,
6946 key
6947 ],
6948 opt:0,
6949 req:[sys_list1, sys_list2],
6950 rest:0,
6951 sublists:0,
6952 whole:0
6953 }))).
6954*/
6955/*
6956:- side_effect(assert_lsp(set_difference, init_args(2, f_set_difference))).
6957*/
6958/*
6959#+(or WAM-CL ECL)
6960(defun nset-difference (list1 list2 &key test test-not key)
6961 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)
6962Destructive SET-DIFFERENCE. Only LIST1 may be destroyed."
6963 (do ((x list1 (cdr x))
6964 (first) (last))
6965 ((null x)
6966 (when last (rplacd last nil))
6967 first)
6968 (unless (member1 (car x) list2 test test-not key)
6969 (if last
6970 (rplacd last x)
6971 (setq first x))
6972 (setq last x))))
6973
6974
6975*/
6976
6977/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:18877 **********************/
6978:-lisp_compile_to_prolog(pkg_sys,[defun,'nset-difference',[list1,list2,'&key',test,'test-not',key],'$STRING'("Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive SET-DIFFERENCE. Only LIST1 may be destroyed."),[do,[[x,list1,[cdr,x]],[first],[last]],[[null,x],[when,last,[rplacd,last,[]]],first],[unless,[member1,[car,x],list2,test,'test-not',key],[if,last,[rplacd,last,x],[setq,first,x]],[setq,last,x]]]])
6979/*
6980:- side_effect(generate_function_or_macro_name(
6981 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6982 name='GLOBAL',
6983 environ=env_1
6984 ],
6985 sys_member1,
6986 kw_function,
6987 f_sys_member1)).
6988*/
6989/*
6990:- side_effect(generate_function_or_macro_name(
6991 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
6992 name='GLOBAL',
6993 environ=env_1
6994 ],
6995 sys_member1,
6996 kw_function,
6997 f_sys_member1)).
6998*/
6999doc: doc_string(nset_difference,
7000 _9296,
7001 function,
7002 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive SET-DIFFERENCE. Only LIST1 may be destroyed.").
7003
7004wl:lambda_def(defun, nset_difference, f_nset_difference, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], [[do, [[sys_x, sys_list1, [cdr, sys_x]], [first], [last]], [[null, sys_x], [when, last, [rplacd, last, []]], first], [unless, [sys_member1, [car, sys_x], sys_list2, sys_test, sys_test_not, key], [if, last, [rplacd, last, sys_x], [setq, first, sys_x]], [setq, last, sys_x]]]]).
7005wl:arglist_info(nset_difference, f_nset_difference, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], arginfo{all:[sys_list1, sys_list2], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_test, sys_test_not, key], names:[sys_list1, sys_list2, sys_test, sys_test_not, key], opt:0, req:[sys_list1, sys_list2], rest:0, sublists:0, whole:0}).
7006wl: init_args(2, f_nset_difference).
7007
7012f_nset_difference(List1_In, List2_In, RestNKeys, FnResult) :-
7013 GEnv=[bv(sys_list1, List1_In), bv(sys_list2, List2_In), bv(sys_test, Test_In), bv(sys_test_not, Test_not_In), bv(key, Key_In)],
7014 get_kw(Env, RestNKeys, sys_test, sys_test, Test_In, []=Test_In, Test_P),
7015 get_kw(Env,
7016 RestNKeys,
7017 sys_test_not,
7018 sys_test_not,
7019 Test_not_In,
7020 []=Test_not_In,
7021 Test_not_P),
7022 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
7023 catch(( ( get_var(GEnv, sys_list1, List1_Get),
7024 AEnv=[bv(sys_x, List1_Get), bv([first], []), bv([last], [])|GEnv],
7025 catch(( call_addr_block(AEnv,
7026 (push_label(do_label_26), get_var(AEnv, sys_x, IFTEST54), (IFTEST54==[]->get_var(AEnv, last, IFTEST59), (IFTEST59\==[]->get_var(AEnv, last, Last_Get62), f_rplacd(Last_Get62, [], TrueResult63), _10416=TrueResult63;_10416=[]), get_var(AEnv, first, RetResult57), throw(block_exit([], RetResult57)), _TBResult=ThrowResult58;get_var(AEnv, sys_x, X_Get68), f_car(X_Get68, Member1_Param), get_var(AEnv, key, Key_Get72), get_var(AEnv, sys_list2, List2_Get69), get_var(AEnv, sys_test, Test_Get70), get_var(AEnv, sys_test_not, Test_not_Get71), f_sys_member1(Member1_Param, List2_Get69, Test_Get70, Test_not_Get71, Key_Get72, IFTEST66), (IFTEST66\==[]->_10602=[];get_var(AEnv, last, IFTEST73), (IFTEST73\==[]->get_var(AEnv, last, Last_Get76), get_var(AEnv, sys_x, X_Get77), f_rplacd(Last_Get76, X_Get77, TrueResult80), _10788=TrueResult80;get_var(AEnv, sys_x, X_Get79), set_var(AEnv, first, X_Get79), _10788=X_Get79), get_var(AEnv, sys_x, X_Get82), set_var(AEnv, last, X_Get82), _10602=X_Get82), get_var(AEnv, sys_x, X_Get84), f_cdr(X_Get84, X), set_var(AEnv, sys_x, X), goto(do_label_26, AEnv), _TBResult=_GORES85)),
7027
7028 [ addr(addr_tagbody_26_do_label_26,
7029 do_label_26,
7030 '$unused',
7031 AEnv,
7032 (get_var(AEnv, sys_x, IFTEST), (IFTEST==[]->get_var(AEnv, last, IFTEST23), (IFTEST23\==[]->get_var(AEnv, last, Last_Get26), f_rplacd(Last_Get26, [], Rplacd_Ret), _11200=Rplacd_Ret;_11200=[]), get_var(AEnv, first, Get_var_Ret), throw(block_exit([], Get_var_Ret)), _11204=ThrowResult;get_var(AEnv, sys_x, X_Get32), f_car(X_Get32, Member1_Param94), get_var(AEnv, key, Get_var_Ret97), get_var(AEnv, sys_list2, Get_var_Ret98), get_var(AEnv, sys_test, Get_var_Ret99), get_var(AEnv, sys_test_not, Get_var_Ret100), f_sys_member1(Member1_Param94, Get_var_Ret98, Get_var_Ret99, Get_var_Ret100, Get_var_Ret97, IFTEST30), (IFTEST30\==[]->_11258=[];get_var(AEnv, last, IFTEST37), (IFTEST37\==[]->get_var(AEnv, last, Last_Get40), get_var(AEnv, sys_x, X_Get41), f_rplacd(Last_Get40, X_Get41, TrueResult44), _11316=TrueResult44;get_var(AEnv, sys_x, X_Get43), set_var(AEnv, first, X_Get43), _11316=X_Get43), get_var(AEnv, sys_x, X_Get46), set_var(AEnv, last, X_Get46), _11258=X_Get46), get_var(AEnv, sys_x, X_Get48), f_cdr(X_Get48, Cdr_Ret), set_var(AEnv, sys_x, Cdr_Ret), goto(do_label_26, AEnv), _11204=_GORES)))
7033 ]),
7034 []=LetResult
7035 ),
7036 block_exit([], LetResult),
7037 true)
7038 ),
7039 LetResult=FnResult
7040 ),
7041 block_exit(nset_difference, FnResult),
7042 true).
7043:- set_opv(nset_difference, symbol_function, f_nset_difference),
7044 DefunResult=nset_difference. 7045/*
7046:- side_effect(assert_lsp(nset_difference,
7047 doc_string(nset_difference,
7048 _9296,
7049 function,
7050 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive SET-DIFFERENCE. Only LIST1 may be destroyed."))).
7051*/
7052/*
7053:- side_effect(assert_lsp(nset_difference,
7054 lambda_def(defun,
7055 nset_difference,
7056 f_nset_difference,
7057
7058 [ sys_list1,
7059 sys_list2,
7060 c38_key,
7061 sys_test,
7062 sys_test_not,
7063 key
7064 ],
7065
7066 [
7067 [ do,
7068
7069 [ [sys_x, sys_list1, [cdr, sys_x]],
7070 [first],
7071 [last]
7072 ],
7073
7074 [ [null, sys_x],
7075 [when, last, [rplacd, last, []]],
7076 first
7077 ],
7078
7079 [ unless,
7080
7081 [ sys_member1,
7082 [car, sys_x],
7083 sys_list2,
7084 sys_test,
7085 sys_test_not,
7086 key
7087 ],
7088
7089 [ if,
7090 last,
7091 [rplacd, last, sys_x],
7092 [setq, first, sys_x]
7093 ],
7094 [setq, last, sys_x]
7095 ]
7096 ]
7097 ]))).
7098*/
7099/*
7100:- side_effect(assert_lsp(nset_difference,
7101 arglist_info(nset_difference,
7102 f_nset_difference,
7103
7104 [ sys_list1,
7105 sys_list2,
7106 c38_key,
7107 sys_test,
7108 sys_test_not,
7109 key
7110 ],
7111 arginfo{ all:[sys_list1, sys_list2],
7112 allow_other_keys:0,
7113 aux:0,
7114 body:0,
7115 complex:0,
7116 env:0,
7117 key:
7118 [ sys_test,
7119 sys_test_not,
7120 key
7121 ],
7122 names:
7123 [ sys_list1,
7124 sys_list2,
7125 sys_test,
7126 sys_test_not,
7127 key
7128 ],
7129 opt:0,
7130 req:[sys_list1, sys_list2],
7131 rest:0,
7132 sublists:0,
7133 whole:0
7134 }))).
7135*/
7136/*
7137:- side_effect(assert_lsp(nset_difference, init_args(2, f_nset_difference))).
7138*/
7139/*
7140#+(or WAM-CL ECL)
7141(defun swap-args (f)
7142 ; (declare (c-local))
7143 (and f #'(lambda (x y) (funcall f y x))))
7144
7145
7146*/
7147
7148/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:19359 **********************/
7149:-lisp_compile_to_prolog(pkg_sys,[defun,'swap-args',[f],[and,f,function([lambda,[x,y],[funcall,f,y,x]])]])
7150/*
7151:- side_effect(generate_function_or_macro_name(
7152 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
7153 name='GLOBAL',
7154 environ=env_1
7155 ],
7156 sys_swap_args,
7157 kw_function,
7158 f_sys_swap_args)).
7159*/
7160wl:lambda_def(defun, sys_swap_args, f_sys_swap_args, [sys_f], [[and, sys_f, function([lambda, [sys_x, sys_y], [funcall, sys_f, sys_y, sys_x]])]]).
7161wl:arglist_info(sys_swap_args, f_sys_swap_args, [sys_f], arginfo{all:[sys_f], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:0, names:[sys_f], opt:0, req:[sys_f], rest:0, sublists:0, whole:0}).
7162wl: init_args(x, f_sys_swap_args).
7163
7168f_sys_swap_args(In, FnResult) :-
7169 GEnv=[bv(sys_f, In)],
7170 catch(( ( get_var(GEnv, sys_f, IFTEST),
7171 ( IFTEST\==[]
7172 -> _9034=closure(kw_function, [ClosureEnvironment|GEnv], Whole, LResult, [sys_x, sys_y], (get_var(ClosureEnvironment, sys_f, Get8), get_var(ClosureEnvironment, sys_x, X_Get), get_var(ClosureEnvironment, sys_y, Y_Get), f_apply(Get8, [Y_Get, X_Get], LResult)), [lambda, [sys_x, sys_y], [funcall, sys_f, sys_y, sys_x]])
7173 ; _9034=[]
7174 )
7175 ),
7176 _9034=FnResult
7177 ),
7178 block_exit(sys_swap_args, FnResult),
7179 true).
7180:- set_opv(sys_swap_args, symbol_function, f_sys_swap_args),
7181 DefunResult=sys_swap_args. 7182/*
7183:- side_effect(assert_lsp(sys_swap_args,
7184 lambda_def(defun,
7185 sys_swap_args,
7186 f_sys_swap_args,
7187 [sys_f],
7188
7189 [
7190 [ and,
7191 sys_f,
7192 function(
7193 [ lambda,
7194 [sys_x, sys_y],
7195
7196 [ funcall,
7197 sys_f,
7198 sys_y,
7199 sys_x
7200 ]
7201 ])
7202 ]
7203 ]))).
7204*/
7205/*
7206:- side_effect(assert_lsp(sys_swap_args,
7207 arglist_info(sys_swap_args,
7208 f_sys_swap_args,
7209 [sys_f],
7210 arginfo{ all:[sys_f],
7211 allow_other_keys:0,
7212 aux:0,
7213 body:0,
7214 complex:0,
7215 env:0,
7216 key:0,
7217 names:[sys_f],
7218 opt:0,
7219 req:[sys_f],
7220 rest:0,
7221 sublists:0,
7222 whole:0
7223 }))).
7224*/
7225/*
7226:- side_effect(assert_lsp(sys_swap_args, init_args(x, f_sys_swap_args))).
7227*/
7228/*
7229 (declare (c-local))
7230*/
7231/*
7232#+(or WAM-CL ECL)
7233(defun set-exclusive-or (list1 list2 &key test test-not key)
7234 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)
7235Returns, as a list, those elements of LIST1 that are not elements of LIST2 and
7236those elements of LIST2 that are not elements of LIST1."
7237 (nconc (set-difference list1 list2 :test test :test-not test-not :key key)
7238 (set-difference list2 list1 :test (swap-args test) :test-not (swap-args test-not) :key key)))
7239
7240
7241*/
7242
7243/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:19475 **********************/
7244:-lisp_compile_to_prolog(pkg_sys,[defun,'set-exclusive-or',[list1,list2,'&key',test,'test-not',key],'$STRING'("Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns, as a list, those elements of LIST1 that are not elements of LIST2 and\r\nthose elements of LIST2 that are not elements of LIST1."),[nconc,['set-difference',list1,list2,':test',test,':test-not','test-not',':key',key],['set-difference',list2,list1,':test',['swap-args',test],':test-not',['swap-args','test-not'],':key',key]]])
7245doc: doc_string(set_exclusive_or,
7246 _9514,
7247 function,
7248 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns, as a list, those elements of LIST1 that are not elements of LIST2 and\r\nthose elements of LIST2 that are not elements of LIST1.").
7249
7250wl:lambda_def(defun, set_exclusive_or, f_set_exclusive_or, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], [[nconc, [set_difference, sys_list1, sys_list2, kw_test, sys_test, kw_test_not, sys_test_not, kw_key, key], [set_difference, sys_list2, sys_list1, kw_test, [sys_swap_args, sys_test], kw_test_not, [sys_swap_args, sys_test_not], kw_key, key]]]).
7251wl:arglist_info(set_exclusive_or, f_set_exclusive_or, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], arginfo{all:[sys_list1, sys_list2], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_test, sys_test_not, key], names:[sys_list1, sys_list2, sys_test, sys_test_not, key], opt:0, req:[sys_list1, sys_list2], rest:0, sublists:0, whole:0}).
7252wl: init_args(2, f_set_exclusive_or).
7253
7258f_set_exclusive_or(List1_In, List2_In, RestNKeys, FnResult) :-
7259 GEnv=[bv(sys_list1, List1_In), bv(sys_list2, List2_In), bv(sys_test, Test_In), bv(sys_test_not, Test_not_In), bv(key, Key_In)],
7260 get_kw(Env, RestNKeys, sys_test, sys_test, Test_In, []=Test_In, Test_P),
7261 get_kw(Env,
7262 RestNKeys,
7263 sys_test_not,
7264 sys_test_not,
7265 Test_not_In,
7266 []=Test_not_In,
7267 Test_not_P),
7268 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
7269 catch(( ( get_var(GEnv, sys_list1, List1_Get),
7270 get_var(GEnv, sys_list2, List2_Get),
7271 ( get_var(GEnv, key, Key_Get),
7272 get_var(GEnv, sys_test, Test_Get)
7273 ),
7274 get_var(GEnv, sys_test_not, Test_not_Get),
7275 f_set_difference(List1_Get,
7276 List2_Get,
7277
7278 [ kw_test,
7279 Test_Get,
7280 kw_test_not,
7281 Test_not_Get,
7282 kw_key,
7283 Key_Get
7284 ],
7285 Set_difference_Ret),
7286 get_var(GEnv, sys_list1, List1_Get18),
7287 get_var(GEnv, sys_list2, List2_Get17),
7288 get_var(GEnv, sys_test, Test_Get19),
7289 f_sys_swap_args(Test_Get19, Swap_args_Ret),
7290 get_var(GEnv, sys_test_not, Test_not_Get20),
7291 f_sys_swap_args(Test_not_Get20, Swap_args_Ret27),
7292 get_var(GEnv, key, Key_Get21),
7293 f_set_difference(List2_Get17,
7294 List1_Get18,
7295
7296 [ kw_test,
7297 Swap_args_Ret,
7298 kw_test_not,
7299 Swap_args_Ret27,
7300 kw_key,
7301 Key_Get21
7302 ],
7303 Set_difference_Ret28),
7304 f_nconc([Set_difference_Ret, Set_difference_Ret28], Nconc_Ret)
7305 ),
7306 Nconc_Ret=FnResult
7307 ),
7308 block_exit(set_exclusive_or, FnResult),
7309 true).
7310:- set_opv(set_exclusive_or, symbol_function, f_set_exclusive_or),
7311 DefunResult=set_exclusive_or. 7312/*
7313:- side_effect(assert_lsp(set_exclusive_or,
7314 doc_string(set_exclusive_or,
7315 _9514,
7316 function,
7317 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns, as a list, those elements of LIST1 that are not elements of LIST2 and\r\nthose elements of LIST2 that are not elements of LIST1."))).
7318*/
7319/*
7320:- side_effect(assert_lsp(set_exclusive_or,
7321 lambda_def(defun,
7322 set_exclusive_or,
7323 f_set_exclusive_or,
7324
7325 [ sys_list1,
7326 sys_list2,
7327 c38_key,
7328 sys_test,
7329 sys_test_not,
7330 key
7331 ],
7332
7333 [
7334 [ nconc,
7335
7336 [ set_difference,
7337 sys_list1,
7338 sys_list2,
7339 kw_test,
7340 sys_test,
7341 kw_test_not,
7342 sys_test_not,
7343 kw_key,
7344 key
7345 ],
7346
7347 [ set_difference,
7348 sys_list2,
7349 sys_list1,
7350 kw_test,
7351 [sys_swap_args, sys_test],
7352 kw_test_not,
7353 [sys_swap_args, sys_test_not],
7354 kw_key,
7355 key
7356 ]
7357 ]
7358 ]))).
7359*/
7360/*
7361:- side_effect(assert_lsp(set_exclusive_or,
7362 arglist_info(set_exclusive_or,
7363 f_set_exclusive_or,
7364
7365 [ sys_list1,
7366 sys_list2,
7367 c38_key,
7368 sys_test,
7369 sys_test_not,
7370 key
7371 ],
7372 arginfo{ all:[sys_list1, sys_list2],
7373 allow_other_keys:0,
7374 aux:0,
7375 body:0,
7376 complex:0,
7377 env:0,
7378 key:
7379 [ sys_test,
7380 sys_test_not,
7381 key
7382 ],
7383 names:
7384 [ sys_list1,
7385 sys_list2,
7386 sys_test,
7387 sys_test_not,
7388 key
7389 ],
7390 opt:0,
7391 req:[sys_list1, sys_list2],
7392 rest:0,
7393 sublists:0,
7394 whole:0
7395 }))).
7396*/
7397/*
7398:- side_effect(assert_lsp(set_exclusive_or, init_args(2, f_set_exclusive_or))).
7399*/
7400/*
7401#+(or WAM-CL ECL)
7402(defun nset-exclusive-or (list1 list2 &key test test-not key)
7403 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)
7404Destructive SET-EXCLUSIVE-OR. Both LIST1 and LIST2 may be destroyed."
7405 (nconc (set-difference list1 list2 :test test :test-not test-not :key key)
7406 (nset-difference list2 list1 :test (swap-args test) :test-not (swap-args test-not) :key key)))
7407
7408
7409*/
7410
7411/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:19949 **********************/
7412:-lisp_compile_to_prolog(pkg_sys,[defun,'nset-exclusive-or',[list1,list2,'&key',test,'test-not',key],'$STRING'("Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive SET-EXCLUSIVE-OR. Both LIST1 and LIST2 may be destroyed."),[nconc,['set-difference',list1,list2,':test',test,':test-not','test-not',':key',key],['nset-difference',list2,list1,':test',['swap-args',test],':test-not',['swap-args','test-not'],':key',key]]])
7413doc: doc_string(nset_exclusive_or,
7414 _8802,
7415 function,
7416 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive SET-EXCLUSIVE-OR. Both LIST1 and LIST2 may be destroyed.").
7417
7418wl:lambda_def(defun, nset_exclusive_or, f_nset_exclusive_or, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], [[nconc, [set_difference, sys_list1, sys_list2, kw_test, sys_test, kw_test_not, sys_test_not, kw_key, key], [nset_difference, sys_list2, sys_list1, kw_test, [sys_swap_args, sys_test], kw_test_not, [sys_swap_args, sys_test_not], kw_key, key]]]).
7419wl:arglist_info(nset_exclusive_or, f_nset_exclusive_or, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], arginfo{all:[sys_list1, sys_list2], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_test, sys_test_not, key], names:[sys_list1, sys_list2, sys_test, sys_test_not, key], opt:0, req:[sys_list1, sys_list2], rest:0, sublists:0, whole:0}).
7420wl: init_args(2, f_nset_exclusive_or).
7421
7426f_nset_exclusive_or(List1_In, List2_In, RestNKeys, FnResult) :-
7427 GEnv=[bv(sys_list1, List1_In), bv(sys_list2, List2_In), bv(sys_test, Test_In), bv(sys_test_not, Test_not_In), bv(key, Key_In)],
7428 get_kw(Env, RestNKeys, sys_test, sys_test, Test_In, []=Test_In, Test_P),
7429 get_kw(Env,
7430 RestNKeys,
7431 sys_test_not,
7432 sys_test_not,
7433 Test_not_In,
7434 []=Test_not_In,
7435 Test_not_P),
7436 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
7437 catch(( ( get_var(GEnv, sys_list1, List1_Get),
7438 get_var(GEnv, sys_list2, List2_Get),
7439 ( get_var(GEnv, key, Key_Get),
7440 get_var(GEnv, sys_test, Test_Get)
7441 ),
7442 get_var(GEnv, sys_test_not, Test_not_Get),
7443 f_set_difference(List1_Get,
7444 List2_Get,
7445
7446 [ kw_test,
7447 Test_Get,
7448 kw_test_not,
7449 Test_not_Get,
7450 kw_key,
7451 Key_Get
7452 ],
7453 Set_difference_Ret),
7454 get_var(GEnv, sys_list1, List1_Get18),
7455 get_var(GEnv, sys_list2, List2_Get17),
7456 get_var(GEnv, sys_test, Test_Get19),
7457 f_sys_swap_args(Test_Get19, Swap_args_Ret),
7458 get_var(GEnv, sys_test_not, Test_not_Get20),
7459 f_sys_swap_args(Test_not_Get20, Swap_args_Ret27),
7460 get_var(GEnv, key, Key_Get21),
7461 f_nset_difference(List2_Get17,
7462 List1_Get18,
7463
7464 [ kw_test,
7465 Swap_args_Ret,
7466 kw_test_not,
7467 Swap_args_Ret27,
7468 kw_key,
7469 Key_Get21
7470 ],
7471 Nset_difference_Ret),
7472 f_nconc([Set_difference_Ret, Nset_difference_Ret], Nconc_Ret)
7473 ),
7474 Nconc_Ret=FnResult
7475 ),
7476 block_exit(nset_exclusive_or, FnResult),
7477 true).
7478:- set_opv(nset_exclusive_or, symbol_function, f_nset_exclusive_or),
7479 DefunResult=nset_exclusive_or. 7480/*
7481:- side_effect(assert_lsp(nset_exclusive_or,
7482 doc_string(nset_exclusive_or,
7483 _8802,
7484 function,
7485 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nDestructive SET-EXCLUSIVE-OR. Both LIST1 and LIST2 may be destroyed."))).
7486*/
7487/*
7488:- side_effect(assert_lsp(nset_exclusive_or,
7489 lambda_def(defun,
7490 nset_exclusive_or,
7491 f_nset_exclusive_or,
7492
7493 [ sys_list1,
7494 sys_list2,
7495 c38_key,
7496 sys_test,
7497 sys_test_not,
7498 key
7499 ],
7500
7501 [
7502 [ nconc,
7503
7504 [ set_difference,
7505 sys_list1,
7506 sys_list2,
7507 kw_test,
7508 sys_test,
7509 kw_test_not,
7510 sys_test_not,
7511 kw_key,
7512 key
7513 ],
7514
7515 [ nset_difference,
7516 sys_list2,
7517 sys_list1,
7518 kw_test,
7519 [sys_swap_args, sys_test],
7520 kw_test_not,
7521 [sys_swap_args, sys_test_not],
7522 kw_key,
7523 key
7524 ]
7525 ]
7526 ]))).
7527*/
7528/*
7529:- side_effect(assert_lsp(nset_exclusive_or,
7530 arglist_info(nset_exclusive_or,
7531 f_nset_exclusive_or,
7532
7533 [ sys_list1,
7534 sys_list2,
7535 c38_key,
7536 sys_test,
7537 sys_test_not,
7538 key
7539 ],
7540 arginfo{ all:[sys_list1, sys_list2],
7541 allow_other_keys:0,
7542 aux:0,
7543 body:0,
7544 complex:0,
7545 env:0,
7546 key:
7547 [ sys_test,
7548 sys_test_not,
7549 key
7550 ],
7551 names:
7552 [ sys_list1,
7553 sys_list2,
7554 sys_test,
7555 sys_test_not,
7556 key
7557 ],
7558 opt:0,
7559 req:[sys_list1, sys_list2],
7560 rest:0,
7561 sublists:0,
7562 whole:0
7563 }))).
7564*/
7565/*
7566:- side_effect(assert_lsp(nset_exclusive_or, init_args(2, f_nset_exclusive_or))).
7567*/
7568/*
7569#+(or WAM-CL ECL)
7570(defun subsetp (list1 list2 &key test test-not key)
7571 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)
7572Returns T if every element of LIST1 is also an element of LIST2. Returns NIL
7573otherwise."
7574 (do ((l list1 (cdr l)))
7575 ((null l) t)
7576 (unless (member1 (car l) list2 test test-not key)
7577 (return nil))))
7578
7579
7580*/
7581
7582/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:20359 **********************/
7583:-lisp_compile_to_prolog(pkg_sys,[defun,subsetp,[list1,list2,'&key',test,'test-not',key],'$STRING'("Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns T if every element of LIST1 is also an element of LIST2. Returns NIL\r\notherwise."),[do,[[l,list1,[cdr,l]]],[[null,l],t],[unless,[member1,[car,l],list2,test,'test-not',key],[return,[]]]]])
7584/*
7585:- side_effect(generate_function_or_macro_name(
7586 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
7587 name='GLOBAL',
7588 environ=env_1
7589 ],
7590 sys_member1,
7591 kw_function,
7592 f_sys_member1)).
7593*/
7594/*
7595:- side_effect(generate_function_or_macro_name(
7596 [ fbound(sys_expand, kw_function)=function(f_sys_expand11),
7597 name='GLOBAL',
7598 environ=env_1
7599 ],
7600 sys_member1,
7601 kw_function,
7602 f_sys_member1)).
7603*/
7604doc: doc_string(subsetp,
7605 _9050,
7606 function,
7607 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns T if every element of LIST1 is also an element of LIST2. Returns NIL\r\notherwise.").
7608
7609wl:lambda_def(defun, subsetp, f_subsetp, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], [[do, [[sys_l, sys_list1, [cdr, sys_l]]], [[null, sys_l], t], [unless, [sys_member1, [car, sys_l], sys_list2, sys_test, sys_test_not, key], [return, []]]]]).
7610wl:arglist_info(subsetp, f_subsetp, [sys_list1, sys_list2, c38_key, sys_test, sys_test_not, key], arginfo{all:[sys_list1, sys_list2], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[sys_test, sys_test_not, key], names:[sys_list1, sys_list2, sys_test, sys_test_not, key], opt:0, req:[sys_list1, sys_list2], rest:0, sublists:0, whole:0}).
7611wl: init_args(2, f_subsetp).
7612
7617f_subsetp(List1_In, List2_In, RestNKeys, FnResult) :-
7618 GEnv=[bv(sys_list1, List1_In), bv(sys_list2, List2_In), bv(sys_test, Test_In), bv(sys_test_not, Test_not_In), bv(key, Key_In)],
7619 get_kw(Env, RestNKeys, sys_test, sys_test, Test_In, []=Test_In, Test_P),
7620 get_kw(Env,
7621 RestNKeys,
7622 sys_test_not,
7623 sys_test_not,
7624 Test_not_In,
7625 []=Test_not_In,
7626 Test_not_P),
7627 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
7628 catch(( ( get_var(GEnv, sys_list1, List1_Get),
7629 AEnv=[bv(sys_l, List1_Get)|GEnv],
7630 catch(( call_addr_block(AEnv,
7631 (push_label(do_label_27), get_var(AEnv, sys_l, IFTEST41), (IFTEST41==[]->throw(block_exit([], t)), _TBResult=ThrowResult45;get_var(AEnv, sys_l, L_Get49), f_car(L_Get49, Member1_Param), get_var(AEnv, key, Key_Get53), get_var(AEnv, sys_list2, List2_Get50), get_var(AEnv, sys_test, Test_Get51), get_var(AEnv, sys_test_not, Test_not_Get52), f_sys_member1(Member1_Param, List2_Get50, Test_Get51, Test_not_Get52, Key_Get53, IFTEST47), (IFTEST47\==[]->_9916=[];throw(block_exit([], [])), _9916=ThrowResult55), get_var(AEnv, sys_l, L_Get58), f_cdr(L_Get58, L), set_var(AEnv, sys_l, L), goto(do_label_27, AEnv), _TBResult=_GORES59)),
7632
7633 [ addr(addr_tagbody_27_do_label_27,
7634 do_label_27,
7635 '$unused',
7636 AEnv,
7637 (get_var(AEnv, sys_l, IFTEST), (IFTEST==[]->throw(block_exit([], t)), _10314=ThrowResult;get_var(AEnv, sys_l, L_Get26), f_car(L_Get26, Member1_Param68), get_var(AEnv, key, Get_var_Ret), get_var(AEnv, sys_list2, Get_var_Ret70), get_var(AEnv, sys_test, Get_var_Ret71), get_var(AEnv, sys_test_not, Get_var_Ret72), f_sys_member1(Member1_Param68, Get_var_Ret70, Get_var_Ret71, Get_var_Ret72, Get_var_Ret, IFTEST24), (IFTEST24\==[]->_10368=[];throw(block_exit([], [])), _10368=ThrowResult32), get_var(AEnv, sys_l, L_Get35), f_cdr(L_Get35, Cdr_Ret), set_var(AEnv, sys_l, Cdr_Ret), goto(do_label_27, AEnv), _10314=_GORES)))
7638 ]),
7639 []=LetResult
7640 ),
7641 block_exit([], LetResult),
7642 true)
7643 ),
7644 LetResult=FnResult
7645 ),
7646 block_exit(subsetp, FnResult),
7647 true).
7648:- set_opv(subsetp, symbol_function, f_subsetp),
7649 DefunResult=subsetp. 7650/*
7651:- side_effect(assert_lsp(subsetp,
7652 doc_string(subsetp,
7653 _9050,
7654 function,
7655 "Args: (list1 list2 &key (key #'identity) (test #'eql) test-not)\r\nReturns T if every element of LIST1 is also an element of LIST2. Returns NIL\r\notherwise."))).
7656*/
7657/*
7658:- side_effect(assert_lsp(subsetp,
7659 lambda_def(defun,
7660 subsetp,
7661 f_subsetp,
7662
7663 [ sys_list1,
7664 sys_list2,
7665 c38_key,
7666 sys_test,
7667 sys_test_not,
7668 key
7669 ],
7670
7671 [
7672 [ do,
7673 [[sys_l, sys_list1, [cdr, sys_l]]],
7674 [[null, sys_l], t],
7675
7676 [ unless,
7677
7678 [ sys_member1,
7679 [car, sys_l],
7680 sys_list2,
7681 sys_test,
7682 sys_test_not,
7683 key
7684 ],
7685 [return, []]
7686 ]
7687 ]
7688 ]))).
7689*/
7690/*
7691:- side_effect(assert_lsp(subsetp,
7692 arglist_info(subsetp,
7693 f_subsetp,
7694
7695 [ sys_list1,
7696 sys_list2,
7697 c38_key,
7698 sys_test,
7699 sys_test_not,
7700 key
7701 ],
7702 arginfo{ all:[sys_list1, sys_list2],
7703 allow_other_keys:0,
7704 aux:0,
7705 body:0,
7706 complex:0,
7707 env:0,
7708 key:
7709 [ sys_test,
7710 sys_test_not,
7711 key
7712 ],
7713 names:
7714 [ sys_list1,
7715 sys_list2,
7716 sys_test,
7717 sys_test_not,
7718 key
7719 ],
7720 opt:0,
7721 req:[sys_list1, sys_list2],
7722 rest:0,
7723 sublists:0,
7724 whole:0
7725 }))).
7726*/
7727/*
7728:- side_effect(assert_lsp(subsetp, init_args(2, f_subsetp))).
7729*/
7730/*
7731#+(or WAM-CL ECL)
7732(defun rassoc-if (test alist &key key)
7733 "Returns the first pair in ALIST whose cdr satisfies TEST. Returns NIL if no
7734such pair exists."
7735 (rassoc test alist :test #'funcall :key key))
7736
7737*/
7738
7739/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:20721 **********************/
7740:-lisp_compile_to_prolog(pkg_sys,[defun,'rassoc-if',[test,alist,'&key',key],'$STRING'("Returns the first pair in ALIST whose cdr satisfies TEST. Returns NIL if no\r\nsuch pair exists."),[rassoc,test,alist,':test',function(funcall),':key',key]])
7741doc: doc_string(rassoc_if,
7742 _7868,
7743 function,
7744 "Returns the first pair in ALIST whose cdr satisfies TEST. Returns NIL if no\r\nsuch pair exists.").
7745
7746wl:lambda_def(defun, rassoc_if, f_rassoc_if, [sys_test, sys_alist, c38_key, key], [[rassoc, sys_test, sys_alist, kw_test, function(funcall), kw_key, key]]).
7747wl:arglist_info(rassoc_if, f_rassoc_if, [sys_test, sys_alist, c38_key, key], arginfo{all:[sys_test, sys_alist], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_test, sys_alist, key], opt:0, req:[sys_test, sys_alist], rest:0, sublists:0, whole:0}).
7748wl: init_args(2, f_rassoc_if).
7749
7754f_rassoc_if(Test_In, Alist_In, RestNKeys, FnResult) :-
7755 GEnv=[bv(sys_test, Test_In), bv(sys_alist, Alist_In), bv(key, Key_In)],
7756 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
7757 catch(( ( get_var(GEnv, sys_alist, Alist_Get),
7758 ( get_var(GEnv, key, Key_Get),
7759 get_var(GEnv, sys_test, Test_Get)
7760 ),
7761 f_rassoc(Test_Get,
7762 Alist_Get,
7763 [kw_test, f_funcall, kw_key, Key_Get],
7764 Rassoc_Ret)
7765 ),
7766 Rassoc_Ret=FnResult
7767 ),
7768 block_exit(rassoc_if, FnResult),
7769 true).
7770:- set_opv(rassoc_if, symbol_function, f_rassoc_if),
7771 DefunResult=rassoc_if. 7772/*
7773:- side_effect(assert_lsp(rassoc_if,
7774 doc_string(rassoc_if,
7775 _7868,
7776 function,
7777 "Returns the first pair in ALIST whose cdr satisfies TEST. Returns NIL if no\r\nsuch pair exists."))).
7778*/
7779/*
7780:- side_effect(assert_lsp(rassoc_if,
7781 lambda_def(defun,
7782 rassoc_if,
7783 f_rassoc_if,
7784 [sys_test, sys_alist, c38_key, key],
7785
7786 [
7787 [ rassoc,
7788 sys_test,
7789 sys_alist,
7790 kw_test,
7791 function(funcall),
7792 kw_key,
7793 key
7794 ]
7795 ]))).
7796*/
7797/*
7798:- side_effect(assert_lsp(rassoc_if,
7799 arglist_info(rassoc_if,
7800 f_rassoc_if,
7801 [sys_test, sys_alist, c38_key, key],
7802 arginfo{ all:[sys_test, sys_alist],
7803 allow_other_keys:0,
7804 aux:0,
7805 body:0,
7806 complex:0,
7807 env:0,
7808 key:[key],
7809 names:[sys_test, sys_alist, key],
7810 opt:0,
7811 req:[sys_test, sys_alist],
7812 rest:0,
7813 sublists:0,
7814 whole:0
7815 }))).
7816*/
7817/*
7818:- side_effect(assert_lsp(rassoc_if, init_args(2, f_rassoc_if))).
7819*/
7820/*
7821#+(or WAM-CL ECL)
7822(defun rassoc-if-not (test alist &key key)
7823 "Returns the first pair in ALIST whose cdr does not satisfy TEST. Returns NIL
7824if no such pair exists."
7825 (rassoc test alist :test-not #'funcall :key key))
7826
7827
7828*/
7829
7830/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:20932 **********************/
7831:-lisp_compile_to_prolog(pkg_sys,[defun,'rassoc-if-not',[test,alist,'&key',key],'$STRING'("Returns the first pair in ALIST whose cdr does not satisfy TEST. Returns NIL\r\nif no such pair exists."),[rassoc,test,alist,':test-not',function(funcall),':key',key]])
7832doc: doc_string(rassoc_if_not,
7833 _7956,
7834 function,
7835 "Returns the first pair in ALIST whose cdr does not satisfy TEST. Returns NIL\r\nif no such pair exists.").
7836
7837wl:lambda_def(defun, rassoc_if_not, f_rassoc_if_not, [sys_test, sys_alist, c38_key, key], [[rassoc, sys_test, sys_alist, kw_test_not, function(funcall), kw_key, key]]).
7838wl:arglist_info(rassoc_if_not, f_rassoc_if_not, [sys_test, sys_alist, c38_key, key], arginfo{all:[sys_test, sys_alist], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_test, sys_alist, key], opt:0, req:[sys_test, sys_alist], rest:0, sublists:0, whole:0}).
7839wl: init_args(2, f_rassoc_if_not).
7840
7845f_rassoc_if_not(Test_In, Alist_In, RestNKeys, FnResult) :-
7846 GEnv=[bv(sys_test, Test_In), bv(sys_alist, Alist_In), bv(key, Key_In)],
7847 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
7848 catch(( ( get_var(GEnv, sys_alist, Alist_Get),
7849 ( get_var(GEnv, key, Key_Get),
7850 get_var(GEnv, sys_test, Test_Get)
7851 ),
7852 f_rassoc(Test_Get,
7853 Alist_Get,
7854 [kw_test_not, f_funcall, kw_key, Key_Get],
7855 Rassoc_Ret)
7856 ),
7857 Rassoc_Ret=FnResult
7858 ),
7859 block_exit(rassoc_if_not, FnResult),
7860 true).
7861:- set_opv(rassoc_if_not, symbol_function, f_rassoc_if_not),
7862 DefunResult=rassoc_if_not. 7863/*
7864:- side_effect(assert_lsp(rassoc_if_not,
7865 doc_string(rassoc_if_not,
7866 _7956,
7867 function,
7868 "Returns the first pair in ALIST whose cdr does not satisfy TEST. Returns NIL\r\nif no such pair exists."))).
7869*/
7870/*
7871:- side_effect(assert_lsp(rassoc_if_not,
7872 lambda_def(defun,
7873 rassoc_if_not,
7874 f_rassoc_if_not,
7875 [sys_test, sys_alist, c38_key, key],
7876
7877 [
7878 [ rassoc,
7879 sys_test,
7880 sys_alist,
7881 kw_test_not,
7882 function(funcall),
7883 kw_key,
7884 key
7885 ]
7886 ]))).
7887*/
7888/*
7889:- side_effect(assert_lsp(rassoc_if_not,
7890 arglist_info(rassoc_if_not,
7891 f_rassoc_if_not,
7892 [sys_test, sys_alist, c38_key, key],
7893 arginfo{ all:[sys_test, sys_alist],
7894 allow_other_keys:0,
7895 aux:0,
7896 body:0,
7897 complex:0,
7898 env:0,
7899 key:[key],
7900 names:[sys_test, sys_alist, key],
7901 opt:0,
7902 req:[sys_test, sys_alist],
7903 rest:0,
7904 sublists:0,
7905 whole:0
7906 }))).
7907*/
7908/*
7909:- side_effect(assert_lsp(rassoc_if_not, init_args(2, f_rassoc_if_not))).
7910*/
7911/*
7912#+(or WAM-CL ECL)
7913(defun assoc-if (test alist &key key)
7914 "Returns the first pair in ALIST whose car satisfies TEST. Returns NIL if no
7915such pair exists."
7916 (assoc test alist :test #'funcall :key key))
7917
7918*/
7919
7920/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:21161 **********************/
7921:-lisp_compile_to_prolog(pkg_sys,[defun,'assoc-if',[test,alist,'&key',key],'$STRING'("Returns the first pair in ALIST whose car satisfies TEST. Returns NIL if no\r\nsuch pair exists."),[assoc,test,alist,':test',function(funcall),':key',key]])
7922doc: doc_string(assoc_if,
7923 _7882,
7924 function,
7925 "Returns the first pair in ALIST whose car satisfies TEST. Returns NIL if no\r\nsuch pair exists.").
7926
7927wl:lambda_def(defun, assoc_if, f_assoc_if, [sys_test, sys_alist, c38_key, key], [[assoc, sys_test, sys_alist, kw_test, function(funcall), kw_key, key]]).
7928wl:arglist_info(assoc_if, f_assoc_if, [sys_test, sys_alist, c38_key, key], arginfo{all:[sys_test, sys_alist], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_test, sys_alist, key], opt:0, req:[sys_test, sys_alist], rest:0, sublists:0, whole:0}).
7929wl: init_args(2, f_assoc_if).
7930
7935f_assoc_if(Test_In, Alist_In, RestNKeys, FnResult) :-
7936 GEnv=[bv(sys_test, Test_In), bv(sys_alist, Alist_In), bv(key, Key_In)],
7937 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
7938 catch(( ( get_var(GEnv, sys_alist, Alist_Get),
7939 ( get_var(GEnv, key, Key_Get),
7940 get_var(GEnv, sys_test, Test_Get)
7941 ),
7942 f_assoc(Test_Get,
7943 Alist_Get,
7944 [kw_test, f_funcall, kw_key, Key_Get],
7945 Assoc_Ret)
7946 ),
7947 Assoc_Ret=FnResult
7948 ),
7949 block_exit(assoc_if, FnResult),
7950 true).
7951:- set_opv(assoc_if, symbol_function, f_assoc_if),
7952 DefunResult=assoc_if. 7953/*
7954:- side_effect(assert_lsp(assoc_if,
7955 doc_string(assoc_if,
7956 _7882,
7957 function,
7958 "Returns the first pair in ALIST whose car satisfies TEST. Returns NIL if no\r\nsuch pair exists."))).
7959*/
7960/*
7961:- side_effect(assert_lsp(assoc_if,
7962 lambda_def(defun,
7963 assoc_if,
7964 f_assoc_if,
7965 [sys_test, sys_alist, c38_key, key],
7966
7967 [
7968 [ assoc,
7969 sys_test,
7970 sys_alist,
7971 kw_test,
7972 function(funcall),
7973 kw_key,
7974 key
7975 ]
7976 ]))).
7977*/
7978/*
7979:- side_effect(assert_lsp(assoc_if,
7980 arglist_info(assoc_if,
7981 f_assoc_if,
7982 [sys_test, sys_alist, c38_key, key],
7983 arginfo{ all:[sys_test, sys_alist],
7984 allow_other_keys:0,
7985 aux:0,
7986 body:0,
7987 complex:0,
7988 env:0,
7989 key:[key],
7990 names:[sys_test, sys_alist, key],
7991 opt:0,
7992 req:[sys_test, sys_alist],
7993 rest:0,
7994 sublists:0,
7995 whole:0
7996 }))).
7997*/
7998/*
7999:- side_effect(assert_lsp(assoc_if, init_args(2, f_assoc_if))).
8000*/
8001/*
8002#+(or WAM-CL ECL)
8003(defun assoc-if-not (test alist &key key)
8004 "Returns the first pair in ALIST whose car does not satisfy TEST. Returns NIL
8005if no such pair exists."
8006 (assoc test alist :test-not #'funcall :key key))
8007
8008
8009*/
8010
8011/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:21371 **********************/
8012:-lisp_compile_to_prolog(pkg_sys,[defun,'assoc-if-not',[test,alist,'&key',key],'$STRING'("Returns the first pair in ALIST whose car does not satisfy TEST. Returns NIL\r\nif no such pair exists."),[assoc,test,alist,':test-not',function(funcall),':key',key]])
8013doc: doc_string(assoc_if_not,
8014 _7956,
8015 function,
8016 "Returns the first pair in ALIST whose car does not satisfy TEST. Returns NIL\r\nif no such pair exists.").
8017
8018wl:lambda_def(defun, assoc_if_not, f_assoc_if_not, [sys_test, sys_alist, c38_key, key], [[assoc, sys_test, sys_alist, kw_test_not, function(funcall), kw_key, key]]).
8019wl:arglist_info(assoc_if_not, f_assoc_if_not, [sys_test, sys_alist, c38_key, key], arginfo{all:[sys_test, sys_alist], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_test, sys_alist, key], opt:0, req:[sys_test, sys_alist], rest:0, sublists:0, whole:0}).
8020wl: init_args(2, f_assoc_if_not).
8021
8026f_assoc_if_not(Test_In, Alist_In, RestNKeys, FnResult) :-
8027 GEnv=[bv(sys_test, Test_In), bv(sys_alist, Alist_In), bv(key, Key_In)],
8028 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
8029 catch(( ( get_var(GEnv, sys_alist, Alist_Get),
8030 ( get_var(GEnv, key, Key_Get),
8031 get_var(GEnv, sys_test, Test_Get)
8032 ),
8033 f_assoc(Test_Get,
8034 Alist_Get,
8035 [kw_test_not, f_funcall, kw_key, Key_Get],
8036 Assoc_Ret)
8037 ),
8038 Assoc_Ret=FnResult
8039 ),
8040 block_exit(assoc_if_not, FnResult),
8041 true).
8042:- set_opv(assoc_if_not, symbol_function, f_assoc_if_not),
8043 DefunResult=assoc_if_not. 8044/*
8045:- side_effect(assert_lsp(assoc_if_not,
8046 doc_string(assoc_if_not,
8047 _7956,
8048 function,
8049 "Returns the first pair in ALIST whose car does not satisfy TEST. Returns NIL\r\nif no such pair exists."))).
8050*/
8051/*
8052:- side_effect(assert_lsp(assoc_if_not,
8053 lambda_def(defun,
8054 assoc_if_not,
8055 f_assoc_if_not,
8056 [sys_test, sys_alist, c38_key, key],
8057
8058 [
8059 [ assoc,
8060 sys_test,
8061 sys_alist,
8062 kw_test_not,
8063 function(funcall),
8064 kw_key,
8065 key
8066 ]
8067 ]))).
8068*/
8069/*
8070:- side_effect(assert_lsp(assoc_if_not,
8071 arglist_info(assoc_if_not,
8072 f_assoc_if_not,
8073 [sys_test, sys_alist, c38_key, key],
8074 arginfo{ all:[sys_test, sys_alist],
8075 allow_other_keys:0,
8076 aux:0,
8077 body:0,
8078 complex:0,
8079 env:0,
8080 key:[key],
8081 names:[sys_test, sys_alist, key],
8082 opt:0,
8083 req:[sys_test, sys_alist],
8084 rest:0,
8085 sublists:0,
8086 whole:0
8087 }))).
8088*/
8089/*
8090:- side_effect(assert_lsp(assoc_if_not, init_args(2, f_assoc_if_not))).
8091*/
8092/*
8093#+(or WAM-CL ECL)
8094(defun member-if (test list &key key)
8095 "Searches LIST for an element that satisfies TEST. If found, returns the
8096sublist of LIST that begins with the element. If not found, returns NIL."
8097 (member test list :test #'funcall :key key))
8098
8099*/
8100
8101/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:21598 **********************/
8102:-lisp_compile_to_prolog(pkg_sys,[defun,'member-if',[test,list,'&key',key],'$STRING'("Searches LIST for an element that satisfies TEST. If found, returns the\r\nsublist of LIST that begins with the element. If not found, returns NIL."),[member,test,list,':test',function(funcall),':key',key]])
8103doc: doc_string(member_if,
8104 _8438,
8105 function,
8106 "Searches LIST for an element that satisfies TEST. If found, returns the\r\nsublist of LIST that begins with the element. If not found, returns NIL.").
8107
8108wl:lambda_def(defun, member_if, f_member_if, [sys_test, list, c38_key, key], [[member, sys_test, list, kw_test, function(funcall), kw_key, key]]).
8109wl:arglist_info(member_if, f_member_if, [sys_test, list, c38_key, key], arginfo{all:[sys_test, list], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_test, list, key], opt:0, req:[sys_test, list], rest:0, sublists:0, whole:0}).
8110wl: init_args(2, f_member_if).
8111
8116f_member_if(Test_In, List_In, RestNKeys, FnResult) :-
8117 GEnv=[bv(sys_test, Test_In), bv(list, List_In), bv(key, Key_In)],
8118 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
8119 catch(( ( get_var(GEnv, list, List_Get),
8120 ( get_var(GEnv, key, Key_Get),
8121 get_var(GEnv, sys_test, Test_Get)
8122 ),
8123 f_member(Test_Get,
8124 List_Get,
8125 [kw_test, f_funcall, kw_key, Key_Get],
8126 Member_Ret)
8127 ),
8128 Member_Ret=FnResult
8129 ),
8130 block_exit(member_if, FnResult),
8131 true).
8132:- set_opv(member_if, symbol_function, f_member_if),
8133 DefunResult=member_if. 8134/*
8135:- side_effect(assert_lsp(member_if,
8136 doc_string(member_if,
8137 _8438,
8138 function,
8139 "Searches LIST for an element that satisfies TEST. If found, returns the\r\nsublist of LIST that begins with the element. If not found, returns NIL."))).
8140*/
8141/*
8142:- side_effect(assert_lsp(member_if,
8143 lambda_def(defun,
8144 member_if,
8145 f_member_if,
8146 [sys_test, list, c38_key, key],
8147
8148 [
8149 [ member,
8150 sys_test,
8151 list,
8152 kw_test,
8153 function(funcall),
8154 kw_key,
8155 key
8156 ]
8157 ]))).
8158*/
8159/*
8160:- side_effect(assert_lsp(member_if,
8161 arglist_info(member_if,
8162 f_member_if,
8163 [sys_test, list, c38_key, key],
8164 arginfo{ all:[sys_test, list],
8165 allow_other_keys:0,
8166 aux:0,
8167 body:0,
8168 complex:0,
8169 env:0,
8170 key:[key],
8171 names:[sys_test, list, key],
8172 opt:0,
8173 req:[sys_test, list],
8174 rest:0,
8175 sublists:0,
8176 whole:0
8177 }))).
8178*/
8179/*
8180:- side_effect(assert_lsp(member_if, init_args(2, f_member_if))).
8181*/
8182/*
8183#+(or WAM-CL ECL)
8184(defun member-if-not (test list &key key)
8185 "Searches LIST for an element that does not satisfy TEST. If found, returns
8186the sublist of LIST that begins with the element. If not found, returns NIL."
8187 (member test list :test-not #'funcall :key key))
8188
8189
8190*/
8191
8192/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:21860 **********************/
8193:-lisp_compile_to_prolog(pkg_sys,[defun,'member-if-not',[test,list,'&key',key],'$STRING'("Searches LIST for an element that does not satisfy TEST. If found, returns\r\nthe sublist of LIST that begins with the element. If not found, returns NIL."),[member,test,list,':test-not',function(funcall),':key',key]])
8194doc: doc_string(member_if_not,
8195 _8518,
8196 function,
8197 "Searches LIST for an element that does not satisfy TEST. If found, returns\r\nthe sublist of LIST that begins with the element. If not found, returns NIL.").
8198
8199wl:lambda_def(defun, member_if_not, f_member_if_not, [sys_test, list, c38_key, key], [[member, sys_test, list, kw_test_not, function(funcall), kw_key, key]]).
8200wl:arglist_info(member_if_not, f_member_if_not, [sys_test, list, c38_key, key], arginfo{all:[sys_test, list], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_test, list, key], opt:0, req:[sys_test, list], rest:0, sublists:0, whole:0}).
8201wl: init_args(2, f_member_if_not).
8202
8207f_member_if_not(Test_In, List_In, RestNKeys, FnResult) :-
8208 GEnv=[bv(sys_test, Test_In), bv(list, List_In), bv(key, Key_In)],
8209 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
8210 catch(( ( get_var(GEnv, list, List_Get),
8211 ( get_var(GEnv, key, Key_Get),
8212 get_var(GEnv, sys_test, Test_Get)
8213 ),
8214 f_member(Test_Get,
8215 List_Get,
8216 [kw_test_not, f_funcall, kw_key, Key_Get],
8217 Member_Ret)
8218 ),
8219 Member_Ret=FnResult
8220 ),
8221 block_exit(member_if_not, FnResult),
8222 true).
8223:- set_opv(member_if_not, symbol_function, f_member_if_not),
8224 DefunResult=member_if_not. 8225/*
8226:- side_effect(assert_lsp(member_if_not,
8227 doc_string(member_if_not,
8228 _8518,
8229 function,
8230 "Searches LIST for an element that does not satisfy TEST. If found, returns\r\nthe sublist of LIST that begins with the element. If not found, returns NIL."))).
8231*/
8232/*
8233:- side_effect(assert_lsp(member_if_not,
8234 lambda_def(defun,
8235 member_if_not,
8236 f_member_if_not,
8237 [sys_test, list, c38_key, key],
8238
8239 [
8240 [ member,
8241 sys_test,
8242 list,
8243 kw_test_not,
8244 function(funcall),
8245 kw_key,
8246 key
8247 ]
8248 ]))).
8249*/
8250/*
8251:- side_effect(assert_lsp(member_if_not,
8252 arglist_info(member_if_not,
8253 f_member_if_not,
8254 [sys_test, list, c38_key, key],
8255 arginfo{ all:[sys_test, list],
8256 allow_other_keys:0,
8257 aux:0,
8258 body:0,
8259 complex:0,
8260 env:0,
8261 key:[key],
8262 names:[sys_test, list, key],
8263 opt:0,
8264 req:[sys_test, list],
8265 rest:0,
8266 sublists:0,
8267 whole:0
8268 }))).
8269*/
8270/*
8271:- side_effect(assert_lsp(member_if_not, init_args(2, f_member_if_not))).
8272*/
8273/*
8274#+(or WAM-CL ECL)
8275(defun subst-if (new test tree &key key)
8276 "Substitutes NEW for subtrees of TREE that satisfy TEST and returns the result.
8277The original TREE is not destroyed."
8278 (subst new test tree :test #'funcall :key key))
8279
8280*/
8281
8282/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:22139 **********************/
8283:-lisp_compile_to_prolog(pkg_sys,[defun,'subst-if',[new,test,tree,'&key',key],'$STRING'("Substitutes NEW for subtrees of TREE that satisfy TEST and returns the result.\r\nThe original TREE is not destroyed."),[subst,new,test,tree,':test',function(funcall),':key',key]])
8284doc: doc_string(subst_if,
8285 _8144,
8286 function,
8287 "Substitutes NEW for subtrees of TREE that satisfy TEST and returns the result.\r\nThe original TREE is not destroyed.").
8288
8289wl:lambda_def(defun, subst_if, f_subst_if, [sys_new, sys_test, sys_tree, c38_key, key], [[subst, sys_new, sys_test, sys_tree, kw_test, function(funcall), kw_key, key]]).
8290wl:arglist_info(subst_if, f_subst_if, [sys_new, sys_test, sys_tree, c38_key, key], arginfo{all:[sys_new, sys_test, sys_tree], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_new, sys_test, sys_tree, key], opt:0, req:[sys_new, sys_test, sys_tree], rest:0, sublists:0, whole:0}).
8291wl: init_args(3, f_subst_if).
8292
8297f_subst_if(New_In, Test_In, Tree_In, RestNKeys, FnResult) :-
8298 GEnv=[bv(sys_new, New_In), bv(sys_test, Test_In), bv(sys_tree, Tree_In), bv(key, Key_In)],
8299 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
8300 catch(( ( get_var(GEnv, sys_new, New_Get),
8301 ( get_var(GEnv, key, Key_Get),
8302 get_var(GEnv, sys_test, Test_Get)
8303 ),
8304 get_var(GEnv, sys_tree, Tree_Get),
8305 f_subst(New_Get,
8306 Test_Get,
8307 Tree_Get,
8308 kw_test,
8309 f_funcall,
8310 kw_key,
8311 Key_Get,
8312 Subst_Ret)
8313 ),
8314 Subst_Ret=FnResult
8315 ),
8316 block_exit(subst_if, FnResult),
8317 true).
8318:- set_opv(subst_if, symbol_function, f_subst_if),
8319 DefunResult=subst_if. 8320/*
8321:- side_effect(assert_lsp(subst_if,
8322 doc_string(subst_if,
8323 _8144,
8324 function,
8325 "Substitutes NEW for subtrees of TREE that satisfy TEST and returns the result.\r\nThe original TREE is not destroyed."))).
8326*/
8327/*
8328:- side_effect(assert_lsp(subst_if,
8329 lambda_def(defun,
8330 subst_if,
8331 f_subst_if,
8332 [sys_new, sys_test, sys_tree, c38_key, key],
8333
8334 [
8335 [ subst,
8336 sys_new,
8337 sys_test,
8338 sys_tree,
8339 kw_test,
8340 function(funcall),
8341 kw_key,
8342 key
8343 ]
8344 ]))).
8345*/
8346/*
8347:- side_effect(assert_lsp(subst_if,
8348 arglist_info(subst_if,
8349 f_subst_if,
8350 [sys_new, sys_test, sys_tree, c38_key, key],
8351 arginfo{ all:
8352 [ sys_new,
8353 sys_test,
8354 sys_tree
8355 ],
8356 allow_other_keys:0,
8357 aux:0,
8358 body:0,
8359 complex:0,
8360 env:0,
8361 key:[key],
8362 names:
8363 [ sys_new,
8364 sys_test,
8365 sys_tree,
8366 key
8367 ],
8368 opt:0,
8369 req:
8370 [ sys_new,
8371 sys_test,
8372 sys_tree
8373 ],
8374 rest:0,
8375 sublists:0,
8376 whole:0
8377 }))).
8378*/
8379/*
8380:- side_effect(assert_lsp(subst_if, init_args(3, f_subst_if))).
8381*/
8382/*
8383#+(or WAM-CL ECL)
8384(defun subst-if-not (new test tree &key key)
8385 "Substitutes NEW for subtrees of TREE that do not satisfy TEST and returns the
8386result. The original TREE is not destroyed."
8387 (subst new test tree :test-not #'funcall :key key))
8388
8389
8390*/
8391
8392/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:22375 **********************/
8393:-lisp_compile_to_prolog(pkg_sys,[defun,'subst-if-not',[new,test,tree,'&key',key],'$STRING'("Substitutes NEW for subtrees of TREE that do not satisfy TEST and returns the\r\nresult. The original TREE is not destroyed."),[subst,new,test,tree,':test-not',function(funcall),':key',key]])
8394doc: doc_string(subst_if_not,
8395 _8232,
8396 function,
8397 "Substitutes NEW for subtrees of TREE that do not satisfy TEST and returns the\r\nresult. The original TREE is not destroyed.").
8398
8399wl:lambda_def(defun, subst_if_not, f_subst_if_not, [sys_new, sys_test, sys_tree, c38_key, key], [[subst, sys_new, sys_test, sys_tree, kw_test_not, function(funcall), kw_key, key]]).
8400wl:arglist_info(subst_if_not, f_subst_if_not, [sys_new, sys_test, sys_tree, c38_key, key], arginfo{all:[sys_new, sys_test, sys_tree], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_new, sys_test, sys_tree, key], opt:0, req:[sys_new, sys_test, sys_tree], rest:0, sublists:0, whole:0}).
8401wl: init_args(3, f_subst_if_not).
8402
8407f_subst_if_not(New_In, Test_In, Tree_In, RestNKeys, FnResult) :-
8408 GEnv=[bv(sys_new, New_In), bv(sys_test, Test_In), bv(sys_tree, Tree_In), bv(key, Key_In)],
8409 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
8410 catch(( ( get_var(GEnv, sys_new, New_Get),
8411 ( get_var(GEnv, key, Key_Get),
8412 get_var(GEnv, sys_test, Test_Get)
8413 ),
8414 get_var(GEnv, sys_tree, Tree_Get),
8415 f_subst(New_Get,
8416 Test_Get,
8417 Tree_Get,
8418 kw_test_not,
8419 f_funcall,
8420 kw_key,
8421 Key_Get,
8422 Subst_Ret)
8423 ),
8424 Subst_Ret=FnResult
8425 ),
8426 block_exit(subst_if_not, FnResult),
8427 true).
8428:- set_opv(subst_if_not, symbol_function, f_subst_if_not),
8429 DefunResult=subst_if_not. 8430/*
8431:- side_effect(assert_lsp(subst_if_not,
8432 doc_string(subst_if_not,
8433 _8232,
8434 function,
8435 "Substitutes NEW for subtrees of TREE that do not satisfy TEST and returns the\r\nresult. The original TREE is not destroyed."))).
8436*/
8437/*
8438:- side_effect(assert_lsp(subst_if_not,
8439 lambda_def(defun,
8440 subst_if_not,
8441 f_subst_if_not,
8442 [sys_new, sys_test, sys_tree, c38_key, key],
8443
8444 [
8445 [ subst,
8446 sys_new,
8447 sys_test,
8448 sys_tree,
8449 kw_test_not,
8450 function(funcall),
8451 kw_key,
8452 key
8453 ]
8454 ]))).
8455*/
8456/*
8457:- side_effect(assert_lsp(subst_if_not,
8458 arglist_info(subst_if_not,
8459 f_subst_if_not,
8460 [sys_new, sys_test, sys_tree, c38_key, key],
8461 arginfo{ all:
8462 [ sys_new,
8463 sys_test,
8464 sys_tree
8465 ],
8466 allow_other_keys:0,
8467 aux:0,
8468 body:0,
8469 complex:0,
8470 env:0,
8471 key:[key],
8472 names:
8473 [ sys_new,
8474 sys_test,
8475 sys_tree,
8476 key
8477 ],
8478 opt:0,
8479 req:
8480 [ sys_new,
8481 sys_test,
8482 sys_tree
8483 ],
8484 rest:0,
8485 sublists:0,
8486 whole:0
8487 }))).
8488*/
8489/*
8490:- side_effect(assert_lsp(subst_if_not, init_args(3, f_subst_if_not))).
8491*/
8492/*
8493#+(or WAM-CL ECL)
8494(defun nsubst-if (new test tree &key key)
8495 "Destructive SUBST-IF. TREE may be modified."
8496 (nsubst new test tree :test #'funcall :key key))
8497
8498*/
8499
8500/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:22629 **********************/
8501:-lisp_compile_to_prolog(pkg_sys,[defun,'nsubst-if',[new,test,tree,'&key',key],'$STRING'("Destructive SUBST-IF. TREE may be modified."),[nsubst,new,test,tree,':test',function(funcall),':key',key]])
8502doc: doc_string(nsubst_if,
8503 _7370,
8504 function,
8505 "Destructive SUBST-IF. TREE may be modified.").
8506
8507wl:lambda_def(defun, nsubst_if, f_nsubst_if, [sys_new, sys_test, sys_tree, c38_key, key], [[nsubst, sys_new, sys_test, sys_tree, kw_test, function(funcall), kw_key, key]]).
8508wl:arglist_info(nsubst_if, f_nsubst_if, [sys_new, sys_test, sys_tree, c38_key, key], arginfo{all:[sys_new, sys_test, sys_tree], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_new, sys_test, sys_tree, key], opt:0, req:[sys_new, sys_test, sys_tree], rest:0, sublists:0, whole:0}).
8509wl: init_args(3, f_nsubst_if).
8510
8515f_nsubst_if(New_In, Test_In, Tree_In, RestNKeys, FnResult) :-
8516 GEnv=[bv(sys_new, New_In), bv(sys_test, Test_In), bv(sys_tree, Tree_In), bv(key, Key_In)],
8517 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
8518 catch(( ( get_var(GEnv, sys_new, New_Get),
8519 ( get_var(GEnv, key, Key_Get),
8520 get_var(GEnv, sys_test, Test_Get)
8521 ),
8522 get_var(GEnv, sys_tree, Tree_Get),
8523 f_nsubst(New_Get,
8524 Test_Get,
8525 Tree_Get,
8526 kw_test,
8527 f_funcall,
8528 kw_key,
8529 Key_Get,
8530 Nsubst_Ret)
8531 ),
8532 Nsubst_Ret=FnResult
8533 ),
8534 block_exit(nsubst_if, FnResult),
8535 true).
8536:- set_opv(nsubst_if, symbol_function, f_nsubst_if),
8537 DefunResult=nsubst_if. 8538/*
8539:- side_effect(assert_lsp(nsubst_if,
8540 doc_string(nsubst_if,
8541 _7370,
8542 function,
8543 "Destructive SUBST-IF. TREE may be modified."))).
8544*/
8545/*
8546:- side_effect(assert_lsp(nsubst_if,
8547 lambda_def(defun,
8548 nsubst_if,
8549 f_nsubst_if,
8550 [sys_new, sys_test, sys_tree, c38_key, key],
8551
8552 [
8553 [ nsubst,
8554 sys_new,
8555 sys_test,
8556 sys_tree,
8557 kw_test,
8558 function(funcall),
8559 kw_key,
8560 key
8561 ]
8562 ]))).
8563*/
8564/*
8565:- side_effect(assert_lsp(nsubst_if,
8566 arglist_info(nsubst_if,
8567 f_nsubst_if,
8568 [sys_new, sys_test, sys_tree, c38_key, key],
8569 arginfo{ all:
8570 [ sys_new,
8571 sys_test,
8572 sys_tree
8573 ],
8574 allow_other_keys:0,
8575 aux:0,
8576 body:0,
8577 complex:0,
8578 env:0,
8579 key:[key],
8580 names:
8581 [ sys_new,
8582 sys_test,
8583 sys_tree,
8584 key
8585 ],
8586 opt:0,
8587 req:
8588 [ sys_new,
8589 sys_test,
8590 sys_tree
8591 ],
8592 rest:0,
8593 sublists:0,
8594 whole:0
8595 }))).
8596*/
8597/*
8598:- side_effect(assert_lsp(nsubst_if, init_args(3, f_nsubst_if))).
8599*/
8600/*
8601#+(or WAM-CL ECL)
8602(defun nsubst-if-not (new test tree &key key)
8603 "Destructive SUBST-IF-NOT. TREE may be modified."
8604 (nsubst new test tree :test-not #'funcall :key key))
8605
8606
8607
8608*/
8609
8610/*********** /home/dmiles/logicmoo_workspace/packs_usr/wam_common_lisp/prolog/wam_cl/wam-cl-init-10.lisp:22795 **********************/
8611:-lisp_compile_to_prolog(pkg_sys,[defun,'nsubst-if-not',[new,test,tree,'&key',key],'$STRING'("Destructive SUBST-IF-NOT. TREE may be modified."),[nsubst,new,test,tree,':test-not',function(funcall),':key',key]])
8612doc: doc_string(nsubst_if_not,
8613 _7418,
8614 function,
8615 "Destructive SUBST-IF-NOT. TREE may be modified.").
8616
8617wl:lambda_def(defun, nsubst_if_not, f_nsubst_if_not, [sys_new, sys_test, sys_tree, c38_key, key], [[nsubst, sys_new, sys_test, sys_tree, kw_test_not, function(funcall), kw_key, key]]).
8618wl:arglist_info(nsubst_if_not, f_nsubst_if_not, [sys_new, sys_test, sys_tree, c38_key, key], arginfo{all:[sys_new, sys_test, sys_tree], allow_other_keys:0, aux:0, body:0, complex:0, env:0, key:[key], names:[sys_new, sys_test, sys_tree, key], opt:0, req:[sys_new, sys_test, sys_tree], rest:0, sublists:0, whole:0}).
8619wl: init_args(3, f_nsubst_if_not).
8620
8625f_nsubst_if_not(New_In, Test_In, Tree_In, RestNKeys, FnResult) :-
8626 GEnv=[bv(sys_new, New_In), bv(sys_test, Test_In), bv(sys_tree, Tree_In), bv(key, Key_In)],
8627 get_kw(Env, RestNKeys, key, key, Key_In, []=Key_In, Key_P),
8628 catch(( ( get_var(GEnv, sys_new, New_Get),
8629 ( get_var(GEnv, key, Key_Get),
8630 get_var(GEnv, sys_test, Test_Get)
8631 ),
8632 get_var(GEnv, sys_tree, Tree_Get),
8633 f_nsubst(New_Get,
8634 Test_Get,
8635 Tree_Get,
8636 kw_test_not,
8637 f_funcall,
8638 kw_key,
8639 Key_Get,
8640 Nsubst_Ret)
8641 ),
8642 Nsubst_Ret=FnResult
8643 ),
8644 block_exit(nsubst_if_not, FnResult),
8645 true).
8646:- set_opv(nsubst_if_not, symbol_function, f_nsubst_if_not),
8647 DefunResult=nsubst_if_not. 8710
8711