module cvit; % Header module for CVIT package.
% Authors: A.Kryukov, A.Rodionov, A.Taranov.
% Copyright (C) 1988,1990, Institute of Nuclear Physics, Moscow State
% University.
% VERSION 2.1
% RELEASE 11-MAR-90
% 07.06.90 all MAP replaced by MAP_ RT
% 08.06.90 SOME MACROS FROM CVITMAP FILE ADDED to section IV RT
% 10.06.90 SOME MACROS FROM CVITMAP FILE ADDED RT
% Modifications for Reduce 3.4.1 by John Fitch.
create!-package('(cvit red2cvit map2strn evalmaps intfierz cvitmap),
'(contrib physics));
% The High Energy Physics package must be loaded first.
load_package hephys;
% These fluids and globals have been moved here for cleaner compilation.
fluid '(!*msg ndims!* dindices!*)$
global '(windices!* indices!* !*cvit gamma5!* !*g5cvit)$
if null windices!*
then windices!*:=
'(nil !_f0 !_f1 !_f2 !_f3 !_f4 !_f5 !_f6 !_f7 !_f8 !_f9)$
if null gamma5!*
then gamma5!*:=
'(nil !_a0 !_a1 !_a2 !_a3 !_a4 !_a5 !_a6 !_a7 !_a8 !_a9)$
%GGGGGGGGGGGGGGGGGGGGGGGGG GLOBALS & FLUIDS FFFFFFFFFFFFFFFFFFFFFFFFF$
global '( !_0edge)$
fluid '( new_edge_list old_edge_list )$
% NEW_EDGE_LIST - LIST OF CREATED EDGES$
% OLD_EDGE_LIST - LIST OF INITIAL EDGES$
fluid '(n_edge)$
% N_EDGE - NUMBER OF CREATED EDGES$
% The following smacros need only be present during compilation.
%************ SECTION I ************************************
smacro procedure hvectorp x$
get(x,'rtype) eq 'hvector$
smacro procedure windexp x$
x memq car windices!*$
smacro procedure replace_by_indexp v$
get(v,'replace_by_index)$
smacro procedure indexp i$
i memq indices!*$
smacro procedure replace_by_vectorp i$
get(i,'replace_by_vector)$
smacro procedure replace_by_vector i$
get(i,'replace_by_vector) or i$
smacro procedure gamma5p x$
memq(x,car gamma5!*)$
smacro procedure nospurp x$
flagp(x,'nospur)$
smacro procedure clear_gamma5()$
gamma5!* := nil . append(reverse car gamma5!*,cdr gamma5!*)$
%********************* SECTION II **************************
symbolic smacro procedure p_empty_map_ map_$
% IS MAP_ EMPTY ? $
null map_$
symbolic smacro procedure p_empty_vertex vertex$
% IS VERTEX EMPTY ? $
null vertex$
%++++++++++++++++++++++++++ SELECTORS +++++++++++++++++++++++++++++++$
symbolic smacro procedure s_vertex_first map_$
% SELECT FIRST VERTEX IN MAP_ $
car map_$
symbolic smacro procedure s_map__rest map_$
% SELECT TAIL OF MAP_ $
cdr map_$
symbolic smacro procedure s_vertex_second map_$
% SELECT SECOND VERTEX IN MAP_ $
s_vertex_first s_map__rest map_$
symbolic smacro procedure first_edge vertex$
% SELECT FIRST EDGE IN VERTEX $
car vertex$
symbolic smacro procedure s_vertex_rest vertex$
% SELECT TAIL OF VERTEX $
cdr vertex$
symbolic smacro procedure second_edge vertex$
% SELECT SECOND EDGE IN VERTEX $
first_edge s_vertex_rest vertex$
symbolic smacro procedure s_edge_name edge$
% SELECT EDGE'S NAME $
car edge$
symbolic smacro procedure s_edge_prop_ edge$
% SELECT PROP_ERTY OF AN EDGE (NAMES OF PARENTS OR NUMBERS)$
cadr edge$
symbolic smacro procedure s_edge_type edge$
% SELEC TYPE (PARITY) OF AN EDGE$
caddr edge$
%?????????????????????? CONSTRUCTORS ??????????????????????????????$
symbolic smacro procedure add_vertex (vertex,map_)$
% ADD VERTEX TO MAP_ $
vertex . map_ $
symbolic smacro procedure add_edge (edge,vertex)$
% ADD EDGE TO VERTEX$
edge . vertex$
symbolic smacro procedure append_map_s (map_1,map_2)$
% APPEND TWO MAP_S $
append(map_1,map_2)$
symbolic smacro procedure conc_map_s (map_1,map_2)$
% APPEND TWO MAP_S $
nconc(map_1,map_2)$
symbolic smacro procedure conc_vertex (vertex1,vertex2)$
% APPEND TWO VERTICES
nconc(vertex1,vertex2)$
symbolic smacro procedure mk_name1 name$
explode name$
symbolic smacro procedure mk_edge_prop_ (prop_1,prop_2)$
prop_1 . prop_2 $
symbolic smacro procedure mk_edge_type (typ1,typ2)$
% DEFINED EDGE <=> TYPE T,
% UNDEFINED EDGE <=> TYPE NIL$
typ1 and typ2 $
symbolic smacro procedure mk_edge (name,prop_,type)$
% MAKE UP NEW EDGE $
list(name,prop_,type)$
symbolic smacro procedure mk_edge3_vertex (edge1,edge2,edge3)$
% MAKES PRIMITIVE VERTEX $
list(edge1,edge2,edge3)$
symbolic smacro procedure mk_empty_map_ ()$
% GENERATE EMPTY MAP_ $
nil $
symbolic smacro procedure mk_empty_vertex ()$
% GENERATE EMPTY VERTEX $
nil $
symbolic smacro procedure mk_vertex1_map_ vertex1$
% MAKE MAP_ OF ONE VERTEX $
list(vertex1)$
symbolic smacro procedure mk_vertex2_map_ (vertex1,vertex2)$
% MAKE MAP_ OF TWO VERTICES $
list(vertex1,vertex2)$
symbolic smacro procedure mk_edge2_vertex (edge1,edge2)$
%MAKES VERTEX FROM TWO EDGES$
list(edge1,edge2)$
symbolic smacro procedure conc_vertex (vertex1,vertex2)$
nconc(vertex1,vertex2)$
symbolic smacro procedure cycl_map_ map_$
% MAKES CYCLIC PERMUTATION OF MAP_$
append(cdr map_,list car map_)$
symbolic smacro procedure cycl_vertex vertex$
% MAKES CYCLIC PERMUTATION OF VERTEX$
append(cdr vertex,list car vertex)$
symbolic smacro procedure mk_world (actedges,world1)$
list(actedges,list nil,world1)$
%====================== PREDICATES (CONTINUE) =====================$
symbolic smacro procedure p_member_edge (edge,vertex)$
% IS EDGE (WITH THE SAME NAME) CONTAINS IN VERTEX ?$
assoc(s_edge_name edge,vertex)$
symbolic smacro procedure equal_edges (edge1,edge2)$
% IF EDGES HAVE THE SAME NAMES ? $
eq ( s_edge_name edge1, s_edge_name edge2)$
symbolic smacro procedure single_no_parents edges$
length edges = 1 $
symbolic smacro procedure resto_map__order map_$
% REVERSE (BETTER REVERSIP) MAP_ $
reverse map_$
symbolic smacro procedure map__length map_$
% NUMBER OF VERTICES IN MAP_$$
length map_$
symbolic smacro procedure vertex_length vertex$
% NUMBER OF EDGES IN VERTEX $
length vertex$
symbolic smacro procedure prepare_map_ map_$
for each x in map_
collect mk_old_edge x$
symbolic smacro procedure p_vertex_prim vertex$
% IS VERTEX PRIMITIVE ? $
vertex_length (vertex) <= 3 $
%************ SECTION III ************************************
symbolic smacro procedure s!-edge!-name edge$ car edge$
symbolic smacro procedure sappend(x,y)$ append(x,y)$
symbolic smacro procedure sreverse y $ reverse y$
symbolic smacro procedure getedge(x,y)$ cdr assoc(x,y)$
symbolic smacro procedure mk!-road!-name(x,y,n)$
list(car x . n,car y . n)$
symbolic smacro procedure mk!-external!-leg edge$
%< FLAG(LIST EDGE,'EXTRNL)$
list( edge . 0) $
symbolic smacro procedure index!-in(ind,l)$
if atom ind then nil
else member(ind,l)$
%************ SECTION IV ************************************
symbolic smacro procedure reverse_map_ map_$
reverse map_$
symbolic smacro procedure mk_edge1_vertex edge$
list edge$
symbolic smacro procedure mk_edges_vertex edges$
edges$
symbolic smacro procedure reversip_vertex vertex$
reversip vertex$
symbolic smacro procedure append_vertex (vertex1,vertex2)$
append(vertex1,vertex2)$
%symbolic smacro procedure conc_vertex (vertex1,vertex2)$
% nconc(vertex1,vertex2)$
symbolic smacro procedure mk_edge4_vertex (edge1,edge2,edge3,edge4)$
list(edge1,edge2,edge3,edge4)$
symbolic smacro procedure p_old_edge edge$
assoc(s_edge_name edge,old_edge_list )$
symbolic smacro procedure s_atlas_map_ atlas$
car atlas$
symbolic smacro procedure s_atlas_coeff atlas$
cadr atlas$
symbolic smacro procedure s_atlas_den_om atlas$
caddr atlas$
symbolic smacro procedure mk_atlas (map_,atlases,den_om)$
list(map_,atlases,den_om)$
symbolic smacro procedure vertex_edges edge$
edge$
symbolic smacro procedure s_coeff_world1 world1$
cadr world1 $
symbolic smacro procedure s_edgelist_world world$
car world$
symbolic smacro procedure s_world1 world$
caddr world $
symbolic smacro procedure s_world_var world$
cadr world$
symbolic smacro procedure s_world_atlas world$
caddr world$
symbolic smacro procedure s_world_edges world$
car world$
endmodule;
end;