1:- use_module(library(clpfd)).    2
    3% Addition
    4
    5const_add_const(X,Y,Z):-
    6  Z is X + Y,
    7  !.
    8
    9vec_add_vec(X,Y,R):-
   10  maplist(const_add_const,X,Y,R),
   11  !.
   12
   13mat_add_mat(X,Y,R):-
   14  maplist(vec_add_vec,X,Y,R),
   15  !.
   16
   17% Multiplication
   18
   19const_mult_const(X,Y,Z):-
   20  Z is X * Y,
   21  !.
   22
   23const_mult_vec(C,V,R):-
   24  maplist(const_mult_const(C),V,R),
   25  !.
   26
   27vec_mult_const(V,C,R):-
   28  maplist(const_mult_const(C),V,R),
   29  !.
   30
   31vec_mult_vec(X,Y,R):-
   32  maplist(const_mult_const,X,Y,R),
   33  !.
   34
   35mat_mult_const(M,C,R):-
   36  maplist(const_mult_vec(C),M,R),
   37  !.
   38
   39mat_mult_vec(M,V,R):-
   40  maplist(vec_mult_vec(V),M,T),
   41  maplist(sumlist,T,R),
   42  !.
   43
   44mat_mult_mat(X,Y,R):-
   45  transpose(Y,T),
   46  maplist(mat_mult_vec(T),X,R),
   47  !.
   48
   49/*
   50mat_mult_mat(X,Y,R):-
   51  transpose(Y,T),
   52  maplist(mat_mult_vec(X),T,S),
   53  transpose(S,R),
   54  !.
   55*/
   56mapmat(F,M,R):-
   57  maplist(mapmatsub(F),M,R).
   58mapmatsub(F,V,R):-
   59  maplist(F,V,R),
   60  !