
#--------------------------------------------------------------------#
# MuPAD - Systeminitialisierungsdatei		     (16.09.94)	     #
#--------------------------------------------------------------------#


proc()
    local x, path, ttype, readbin;
begin	# Wird als Prozedur geschrieben, um Eintragungen in  #
 	# in die History zu vermeiden.			     #

#--------------------------------------------------------------------#
# initialize domains for buit-in types 				     #
#--------------------------------------------------------------------#

ttype:= newpurefunc("fun(...)", NIL, hold((
    if domtype(args(1)) = args(2) then
	TRUE
    else
	FAIL
    end_if
)));

DOM_ARRAY := domtype(array(1..1));
DOM_ARRAY::name := "DOM_ARRAY";
DOM_ARRAY::testtype:= ttype;
DOM_ARRAY::func_call:= proc() begin
    map(context(args(1)),
	fun(args(1)(args(2..args(0)))),
	context(args(2..args(0))))
end_proc:


DOM_BOOL := domtype(TRUE);
DOM_BOOL::name := "DOM_BOOL"; 
DOM_BOOL::testtype:= ttype;
 
DOM_COMPLEX := domtype(I);
DOM_COMPLEX::name := "DOM_COMPLEX"; 
DOM_COMPLEX::testtype:= ttype;
DOM_COMPLEX::D := 0 ;
 
DOM_DOMAIN := domtype(domain());
DOM_DOMAIN::name := "DOM_DOMAIN";
DOM_DOMAIN::testtype:= ttype;
DOM_DOMAIN::func_call:= domainfunccall ;

DOM_EXEC := domtype(op(_assign, 1));
DOM_EXEC::name := "DOM_EXEC"; 
DOM_EXEC::testtype:= ttype;

DOM_EXPR := domtype(x+1);
DOM_EXPR::name := "DOM_EXPR";
DOM_EXPR::testtype:= newpurefunc("fun(...)", NIL, hold((
    if domtype(args(2)) = DOM_EXPR then
	if domtype(args(1)) <> DOM_EXPR then
	    FALSE
	elif op(args(1), 0) <> op(args(2), 0) then
	    FALSE
	elif nops(args(1)) <> nops(args(2)) then
	    FALSE
	elif nops(args(1)) = 0 then
	    TRUE
	elif nops(args(1)) = 1 then
	    testtype(op(args(1), 1), op(args(2), 1))
	else
	    testtype(op(args(1)), Type::Product(op(args(2))))
	end_if
    elif domtype(args(1)) = args(2) then
	TRUE
    else
	FAIL
    end_if
)));

DOM_FAIL := domtype(FAIL);
DOM_FAIL::name := "DOM_FAIL"; 
DOM_FAIL::testtype:= ttype;
DOM_FAIL::D := newpurefunc("fun(...)", NIL, FAIL);
 
DOM_FLOAT := domtype(1.0);
DOM_FLOAT::name := "DOM_FLOAT"; 
DOM_FLOAT::testtype:= ttype;
DOM_FLOAT::D := 0 ;
 
DOM_FUNC_ENV := domtype(_assign);
DOM_FUNC_ENV::name := "DOM_FUNC_ENV"; 
DOM_FUNC_ENV::testtype:= ttype;
 
DOM_IDENT := domtype(x);
DOM_IDENT::name := "DOM_IDENT"; 
DOM_IDENT::testtype:= ttype;
 
DOM_INT := domtype(1);
DOM_INT::name := "DOM_INT"; 
DOM_INT::testtype:= ttype;
DOM_INT::D := 0 ;
 
DOM_NIL := domtype(NIL);
DOM_NIL::name := "DOM_NIL"; 
DOM_NIL::testtype:= ttype;
 
DOM_NULL := domtype(null());
DOM_NULL::name := "DOM_NULL" ;
DOM_NULL::testtype:= ttype;

DOM_POLY := domtype(poly(0, [x]));
DOM_POLY::name := "DOM_POLY";
DOM_POLY::testtype:= ttype;

DOM_PROC := domtype(proc() begin end_proc);
DOM_PROC::name := "DOM_PROC";
DOM_PROC::testtype:= ttype;
 
DOM_RAT := domtype(1/2);
DOM_RAT::name := "DOM_RAT"; 
DOM_RAT::testtype:= ttype;
DOM_RAT::D := 0 ;
 
DOM_SET := domtype({});
DOM_SET::name := "DOM_SET"; 
DOM_SET::testtype:= ttype;
DOM_SET::func_call:= DOM_ARRAY::func_call:
 
DOM_LIST := domtype([]);
DOM_LIST::name := "DOM_LIST"; 
DOM_LIST::testtype:= ttype;
DOM_LIST::func_call:= DOM_ARRAY::func_call:

DOM_STRING := domtype("");
DOM_STRING::name := "DOM_STRING"; 
DOM_STRING::testtype:= newpurefunc("fun(...)", NIL, hold((
    if domtype(args(2)) = DOM_STRING then
	bool(type(args(1)) = args(2))
    elif domtype(args(1)) = args(2) then
	TRUE
    else
	FAIL
    end_if
)));

DOM_TABLE := domtype(table());
DOM_TABLE::name := "DOM_TABLE"; 
DOM_TABLE::testtype:= ttype;
DOM_TABLE::func_call:= DOM_ARRAY::func_call:

NUMERIC:= domain();
NUMERIC::name:= "NUMERIC";
NUMERIC::testtype:= newpurefunc("fun(...)", NIL, hold((
    if contains({ DOM_INT, DOM_RAT, DOM_FLOAT, DOM_COMPLEX },
	        domtype(args(1))) then
        TRUE
    else
	FAIL
    end_if
)));


DOM_POINT := domtype(point(1,2,3));
DOM_POINT::name := "DOM_POINT";
DOM_POINT::testtype := ttype;

DOM_POLYGON := domtype(polygon(point(1,2,3)));
DOM_POLYGON::name := "DOM_POLYGON"; 
DOM_POLYGON::testtype := ttype;

#--------------------------------------------------------------------#
# remember values for special functions                              #
#--------------------------------------------------------------------#

abs(I):= 1: abs(PI):=PI: abs(E):=E: abs(EULER):=EULER:

#--------------------------------------------------------------------#
# Operatorregeln f"ur +, *, ^ und @                                  #
#--------------------------------------------------------------------#

#(f+g)(x) --> f(x)+g(x)#
_plus := funcattr(_plus, "operator", op_plusmult) :

#(f*g)(x) --> f(x)*g(x)#
_mult := funcattr(_mult, "operator", op_plusmult) :

#(f^n)(x) --> f(x)^n#
_power := funcattr(_power, "operator", op_power) :

#(f@g)(x) --> f(g(x))#
_fconcat := funcattr(_fconcat, "operator", op_fconcat) :

#--------------------------------------------------------------------#
# define "float" attributes for basic arithmetic operators           #
#--------------------------------------------------------------------#

_plus:=  funcattr(_plus, "float",
		  subsop(float_gen, 5=op(_plus,1), 3="_plus"));

_mult:=  funcattr(_mult, "float",
		  subsop(float_gen, 5=op(_mult,1), 3="_mult"));

_power:= funcattr(_power, "float",
		  subsop(float_gen, 5=op(_power,1), 3="_power"));


#--------------------------------------------------------------------#
# define standard prefix for 'genident'                                                  #
#--------------------------------------------------------------------#

genident := func_env(built_in(1056, NIL, "genident", NIL, "X" ),
		    built_in(1101, 0, NIL, "genident" ),
		    NIL );

#--------------------------------------------------------------------#
# Polynome als Operatoren                                            #
#--------------------------------------------------------------------#

DOM_POLY::func_call:= proc(p)		# func_call ueberladen #
    local X, i;
begin
    X:= op(p,2);
    if args(0) <> nops(X)+1 then
	error("wrong no of args [DOM_POLY::func_call]")
    end_if;
    evalp(p, X[i]=context(args(i+1)) $ i=1..nops(X))
end_proc;

#--------------------------------------------------------------------#
# Erzeugung des stdlib-Domains (wird von loadproc benoetigt)	     #
#--------------------------------------------------------------------#

# the 'stdlib' library domain serves only as name space for utilies #

stdlib:= domain():
stdlib::name:= "stdlib":
stdlib::info:= "Library 'stdlib': \
Utilities for the standard library":
stdlib::interface:= {}:

#--------------------------------------------------------------------#
# Kern-Funktionen sichern (werden in specfunc/stdlib umdefiniert)    #
#--------------------------------------------------------------------#

stdlib::sin:= sin:
stdlib::cos:= cos:
stdlib::tan:= tan:
stdlib::asin:= asin:
stdlib::acos:= acos:
stdlib::atan:= atan:
stdlib::sinh:= sinh:
stdlib::cosh:= cosh:
stdlib::tanh:= tanh:
stdlib::asinh:= asinh:
stdlib::acosh:= acosh:
stdlib::atanh:= atanh:
stdlib::exp:= exp:
stdlib::ln:= ln:
stdlib::sqrt:= sqrt:
stdlib::gamma:= gamma:
stdlib::igamma:= igamma:
stdlib::zeta:= zeta:
stdlib::erfc:= erfc:
stdlib::eint:= eint:
stdlib::psi:= psi:
stdlib::sign:= sign: 
stdlib::abs:= abs: 
stdlib::fact:= fact: 
stdlib::psi:=psi:
stdlib::powermod:= powermod:

powermod:=NIL:

#--------------------------------------------------------------------#
# Initialisierung der vordefinierten Standardprozeduren, die bei     #
# Bedarf automatisch nachgeladen werden sollen.                      #
#--------------------------------------------------------------------#

# read loading utils #

readbin:= proc(p, f) local fp; begin
    fp:= fopen(p.stdlib::BinPath.f.".mb");
    if fp = FAIL then
        fread(p.f.".mu")
    else
	fread(fp);
	fclose(fp)
    end_if;
end_proc:

case sysname()
of "UNIX" do
    stdlib::PathSep:= "/";
    path:= LIB_PATH;
    break;
of "MACOS" do
    stdlib::PathSep:= ":";
    path:= LIB_PATH.":";
    break;
of "MSDOS" do
    stdlib::PathSep:= "\\";
    path:= LIB_PATH;
    break;
end_case:

stdlib::BinPath:= "BIN".stdlib::PathSep;

readbin(path."STDLIB".stdlib::PathSep, "pathname"):
readbin(path."STDLIB".stdlib::PathSep, "loadproc"):

readbin(path."LIBFILES".stdlib::PathSep, "stdlib"):
readbin(path."LIBFILES".stdlib::PathSep, "misc"):
readbin(path."LIBFILES".stdlib::PathSep, "specfunc"):

#--------------------------------------------------------------------#
# load packages                                                      #
#--------------------------------------------------------------------#

path:= pathname("LIBFILES"):

sharelib:= loadproc(sharelib, path, "sharelib"):
groebner:= loadproc(groebner, path, "groebner"):
orthpoly:= loadproc(orthpoly, path, "orthpoly"):
gcdlib:= loadproc(gcdlib, path, "gcdlib"):
faclib:= loadproc(faclib, path, "faclib"):
module:= loadproc(module, path, "module"):
Type:= loadproc(Type, path, "Type"):
Network:= loadproc(Network, path, "Network"):

end_proc():

#- the end ----------------------------------------------------------#
