2:- style_check(-singleton). 3
5
6
8:-lisp_compile_to_prolog(pkg_sys,[defmacro,pushnew,['&environment',env,item,place,'&rest',keys],[if,[and,[symbolp,place],[eq,place,[macroexpand,place,env]]],['#BQ',[setq,['#COMMA',place],[adjoin,['#COMMA',item],['#COMMA',place],['#BQ-COMMA-ELIPSE',keys]]]],['multiple-value-bind',[dummies,vals,newval,setter,getter],['get-setf-expansion',place,env],[let,[[g,[gensym]]],['#BQ',['let*',[[['#COMMA',g],['#COMMA',item]],['#BQ-COMMA-ELIPSE',[mapcar,function(list),dummies,vals]],[['#COMMA',[car,newval]],[adjoin,['#COMMA',g],['#COMMA',getter],['#BQ-COMMA-ELIPSE',keys]]]],['#COMMA',setter]]]]]]]). 9wl:lambda_def(defmacro, pushnew, mf_pushnew, [c38_environment, env, item, sys_place, c38_rest, sys_keys], [progn, [if, [and, [symbolp, sys_place], [eq, sys_place, [macroexpand, sys_place, env]]], ['#BQ', [setq, ['#COMMA', sys_place], [adjoin, ['#COMMA', item], ['#COMMA', sys_place], ['#BQ-COMMA-ELIPSE', sys_keys]]]], [multiple_value_bind, [sys_dummies, sys_vals, sys_newval, sys_setter, sys_getter], [get_setf_expansion, sys_place, env], [let, [[sys_g, [gensym]]], ['#BQ', [let_xx, [[['#COMMA', sys_g], ['#COMMA', item]], ['#BQ-COMMA-ELIPSE', [mapcar, function(list), sys_dummies, sys_vals]], [['#COMMA', [car, sys_newval]], [adjoin, ['#COMMA', sys_g], ['#COMMA', sys_getter], ['#BQ-COMMA-ELIPSE', sys_keys]]]], ['#COMMA', sys_setter]]]]]]]).
10wl: declared_as(mf_pushnew, env_arg1).
11
12wl:arglist_info(pushnew, mf_pushnew, [c38_environment, env, item, sys_place, c38_rest, sys_keys], arginfo{all:[item, sys_place], allow_other_keys:0, aux:0, body:0, complex:[environment, rest], env:[env], key:0, names:[env, item, sys_place, sys_keys], opt:0, req:[item, sys_place], rest:[sys_keys], sublists:0, whole:0}).
13wl: init_args(2,op_pushnew).
14wl: init_args(0,mf_pushnew).
15wl: init_args(2,pushnew).
16
21:- export(sf_pushnew/5). 22sf_pushnew(Env,Item_In, Place_In, RestNKeys, FnResult):-
23 mf_pushnew([(pushnew), Item_In, Place_In|RestNKeys],Env, MFResult),
24 f_eval(MFResult, FnResult).
25mf_pushnew([pushnew, Item_In, Place_In|RestNKeys], Env_In, MFResult) :-
26 nop(defmacro),
27 GEnv=[bv(u_env, Env_In), bv(u_item, Item_In), bv(u_place, Place_In), bv(u_keys, RestNKeys)],
28 catch(( ( get_var(GEnv, u_place, Place_Get),
29 ( is_symbolp(Place_Get)
30 -> get_var(GEnv, u_env, Env_Get),
31 get_var(GEnv, u_place, Place_Get14),
32 f_macroexpand([Place_Get14, Env_Get], Macroexpand_Ret),
33 f_eq(Place_Get14, Macroexpand_Ret, TrueResult),
34 IFTEST=TrueResult
35 ; IFTEST=[]
36 ),
37 ( IFTEST\==[]
38 -> get_var(GEnv, u_item, Item_Get),
39 ( get_var(GEnv, u_keys, Keys_Get),
40 get_var(GEnv, u_place, Place_Get18)
41 ),
42 get_var(GEnv, u_place, Place_Get20),
43 _2292=[setq, Place_Get18, [adjoin, Item_Get, Place_Get20|Keys_Get]]
44 ; LEnv=[bv(u_dummies, []), bv(u_vals, []), bv(u_newval, []), bv(u_setter, []), bv(u_getter, [])|GEnv],
45 get_var(LEnv, u_env, Env_Get26),
46 get_var(LEnv, u_place, Place_Get25),
47 load_and_call(f_get_setf_expansion(Place_Get25,
48 [Env_Get26],
49 Setf_expansion_Ret)),
50 setq_from_values(LEnv,
51
52 [ u_dummies,
53 u_vals,
54 u_newval,
55 u_setter,
56 u_getter
57 ]),
58 f_gensym(G_Init),
59 LEnv29=[bv(u_g, G_Init)|LEnv],
60 get_var(LEnv29, u_dummies, Dummies_Get),
61 get_var(LEnv29, u_g, G_Get),
62 get_var(LEnv29, u_item, Item_Get32),
63 get_var(LEnv29, u_vals, Vals_Get),
64 f_mapcar(f_list, [Dummies_Get, Vals_Get], Mapcar_Ret),
65 get_var(LEnv29, u_newval, Newval_Get),
66 f_car(Newval_Get, Car_Ret),
67 get_var(LEnv29, u_g, G_Get36),
68 get_var(LEnv29, u_getter, Getter_Get),
69 get_var(LEnv29, u_keys, Keys_Get38),
70 bq_append([[G_Get, Item_Get32]|Mapcar_Ret],
71
72 [
73 [ Car_Ret,
74 [adjoin, G_Get36, Getter_Get|Keys_Get38]
75 ]
76 ],
77 Bq_append_Ret),
78 get_var(LEnv29, u_setter, Setter_Get),
79 _2292=[let_xx, Bq_append_Ret, Setter_Get]
80 )
81 ),
82 _2292=MFResult
83 ),
84 block_exit(pushnew, MFResult),
85 true).
86:- set_opv(mf_pushnew, type_of, sys_macro),
87 set_opv(pushnew, symbol_function, mf_pushnew),
88 DefMacroResult=pushnew.