1:- module(type_list,
    2	[
    3	op(100, yf,  []),    % support block notation
    4	op(500, yfx, \\),    % for appending (pseudo SQL ||)
    5	slice_parameters/4,  % slice support for blocks
    6	index_parameters/3   % index support for blocks
    7	]).    8	
    9:- current_module(arithmetic_types) -> true ; use_module(library(arithmetic_types)).   10
   11% Also provides:
   12%  1. Generic slice evaluation (used inside block indexing)
   13%  2. Generic evaluation of list items
   14
   15:- arithmetic_function(new/2).        % create
   16:- arithmetic_function('[|]'/2).      % evaluate list items
   17:- arithmetic_function([]/1).         % block index
   18:- arithmetic_function([]/2).   19:- arithmetic_function(: /2).         % slice (used with block indexing)
   20:- arithmetic_function(len/1).        % size or length
   21:- arithmetic_function(init/2).       % fill any vars
   22:- arithmetic_function(\\ /2).        % list concat
   23:- arithmetic_function(arange/2).     % list from range(N)
   24:- arithmetic_function(arange/3).     % list from range(B,E)
   25:- arithmetic_function(arange/4).     % list from range(B,E,S)
   26
   27%
   28% Exports
   29%
   30% slice parms
   31slice_parameters(B:E,Len,SBegin,SLen) :-
   32	item_eval(B,Br), (var(Br) -> Br=0 ; integer(Br)),
   33	item_eval(E,Er), (var(Er) -> Er=Len ; integer(Er)),
   34	(Br<0 -> SBegin is Len+Br ; SBegin=Br),
   35	(Er<0 -> SLen is Len+Er-SBegin ; SLen is Er-SBegin).
   36
   37% index parm
   38index_parameters(Ix,Len,I) :-
   39	item_eval(Ix,EIx),	
   40	integer(EIx),
   41	(EIx < 0 -> I is Len+EIx ; I = EIx),
   42	I >= 0.
   43
   44% evaluate (largely for efficiency)
   45item_eval(X,X) :- var(X), !.                          % vars OK in lists
   46item_eval(N,N) :- number(N), !.                       % optimization
   47item_eval(X,R) :- 
   48	catch(arithmetic_expression_value(X,R), _, R=X).  % catchall, identity function
   49
   50%
   51% Function: generic slice expression - pass through until used
   52%
   53':'(B,E,B:E). 
   54
   55%
   56% Function: evaluate list items
   57% 
   58'[|]'(X,Xs,[X|Xs]).        % lazy evaluation
   59
   60%
   61% Function: create new list
   62%
   63new(list,Size,L) :- integer(Size), Size >= 0, (nonvar(L) -> is_list(L) ; true), !,
   64	length(L,Size).
   65
   66new(list,Xs,Xs) :- is_list(Xs).
   67
   68%
   69% Function: indexing and slicing
   70%
   71[](L, L) :- is_list(L).
   72[]([I1,I2|IN],T,X) :-  !,      % multi-level index, works on any supported indexing type
   73	T1 is T[I1],               % index one level and recurse
   74	X is T1[I2|IN].
   75[]([B:E],L,X) :- is_list(L),  
   76	length(L,Len),
   77	slice_parameters(B:E,Len,SB,SL), !,
   78	sub_list(L,SB,SL,_,X).
   79[]([Ix], L, R) :- is_list(L), 
   80	length(L,Len),
   81	index_parameters(Ix,Len,I),
   82	% the following uses near constant time arg for lists exceeding some threshold
   83	(I =< 28 -> skip_N(I,L,[X|_]) ; (T=..[$|L], arg(I,T,X))),
   84	item_eval(X,R).  % evaluate selected item
   85    
   86%  sub_atom/5 for lists
   87sub_list(L,Before,Length,After,SubL) :- integer(Before), integer(Length), is_list(L),
   88	skip_N(Before,L,L1),         % remove prefix
   89	next_N(Length,L1,SubL,L2),   % collect sub list and suffix	
   90	length(L2,After),            % length of suffix
   91	!.                           % deterministic
   92
   93skip_N(0,In,In):- !.
   94skip_N(1,[_|In],In):- !.
   95skip_N(N,[_,_|Xs],Out) :-                  % N>0,  % superfluous check
   96	N1 is N-2,
   97	skip_N(N1,Xs,Out).	
   98	
   99next_N(0,In,[],In) :- !.
  100next_N(1,[X|In],[X],In) :- !.
  101next_N(N,[X1,X2|In],[X1,X2|Out],Rem) :-	   % N>0,  % superfluous check
  102	N1 is N-2,
  103	next_N(N1,In,Out,Rem).	
  104
  105%
  106% Function: size/length
  107%
  108len(L,N) :- is_list(L),
  109	length(L,N).
  110	
  111%
  112% Function: fill any vars	
  113%
  114init(L, Value, L) :- is_list(L),
  115	fill_each(L,Value).
  116	
  117fill_each([],_).	
  118fill_each([X|Xs],Value) :-
  119	(is_list(X)
  120	 -> fill_each(X,Value)
  121	  ; (var(X) -> X=Value ; true)
  122	),
  123	fill_each(Xs,Value).
  124
  125%
  126% Function: append 2 lists	
  127%
  128\\(L1, L2, R) :-  nonvar(L1), is_list(L2),  % guard against ill-formed lists
  129	append_det(L1,L2,R).
  130
  131append_det([], L, L) :- !.  % deterministic, so !
  132append_det([H|T], L, [H|R]) :-
  133    append_det(T, L, R).
  134    
  135%
  136% Function: arange/2,3,4
  137%
  138arange(list,N,L) :- number(N), N>0,
  139	arange_(0,N,1,L).
  140
  141arange(list,B,E,L) :- number(B), number(E),
  142	B>=0, E>B,
  143	arange_(B,E,1,L).
  144
  145arange(list,B,E,S,L) :- number(B), number(E), number(S),
  146	B>=0, E>B, S>0,
  147	arange_(B,E,S,L).
  148	
  149arange_(B,E,_S,[]) :- B>=E, !.
  150arange_(B,E,S,[B|Vs]) :- 
  151	B1 is B+S,
  152	arange_(B1,E,S,Vs)