Revision 66 Version 12

 A small bug fixed, and some new modules for Info file.

Here is two version of Roots (Roots and Roots1 modules in Info file):

// we place all functions for cx which we use on a global group
// for this example not need to be global
Global Group Cx {
	declare m math2
	function neg(a as cxComplex) {
		method .m, "cxNeg", a as ret: =ret
	}
	function sqr(a as cxComplex) {
		method .m, "cxSqr", a as ret: =ret
	}
	function sub(a as cxComplex, b as cxComplex) {
		method .m, "cxSub", a, b as ret: =ret
	}
	function add(a as cxComplex, b as cxComplex) {
		method .m, "cxAdd", a, b as ret:	=ret
	}
	function div(a as cxComplex, b as cxComplex) {
		method .m, "cxDiv", a, b as ret: =ret
	}
	function divReal(a as cxComplex, b as double) {
		method .m, "cxDivReal", a , b as ret: =ret
	}
	function complex(a as double, b as double=0) {
		method .m, "cxNew", a, b as ret: =ret
	}
	// quad_discriminating_roots return a tuple (array) of three vaues:
	// one string and two numeric (cxComplex is a UDT - a numeric variant for interpreter)
	function quad_discriminating_roots(a1, b1, c1, entier=1e-5) {
		var discriminant = b1*b1 - 4*a1*c1
		var a=.complex(a1), b=.complex(b1), c=.complex(c1), d=.complex(discriminant)
		var root1=.div(.divReal(.add(.neg(b), .sqr(d)), 2), a)
		var root2=.div(.divReal(.sub(.neg(b), .sqr(d)), 2), a)
		if abs(discriminant)<entier then
			="real and equal", root1|r, root1|r
		else.if discriminant>0 then
			="real", root1|r, root2|r
		else
			="complex", root1, root2
		end if
	}
}
' Using ! we send three values
Disp(!cx.quad_discriminating_roots(3, 4, 4/3))
Disp(!cx.quad_discriminating_roots(3, 2, -1))
' Without using ! we send an array with all values
Disp(cx.quad_discriminating_roots(3, 2, 1))
Disp(cx.quad_discriminating_roots(1, -1e9, 1))
Disp(cx.quad_discriminating_roots(1, -1e70, 1))
Disp(cx.quad_discriminating_roots(1, -1e100, 1))
Disp(cx.quad_discriminating_roots(1, -1e200, 1))
Disp(cx.quad_discriminating_roots(1, -1e300, 1))
sub disp()
	// this is the way we can overload a sub
	if match("SNN") then
		// subs need to make new variables because they share
		// scope with module which call them
		read new s,a,b
	else.if match("A") then
		read new arg
		// (x, y)=(100, 200)  where (100, 200) is a tulple
		// so this is the same, arg is a tuple.
		(s, a, b)=arg
	end if
	? $("0.0####"),field$(s, 14);
	if type$(a)="cxComplex" then
		? " (";a|r;if$(a|i<0->"-","+");abs(a|i);"i)";
	else
		? $(if$(abs(a>1e6)->"#.###e+###", "0.0####"));" ";a;
	end if
	if type$(b)="cxComplex" then
		? " (";b|r;if$(b|i<0->"-","+");abs(b|i);"i)"
	else
		? $(if$(abs(b>1e6)->"#.###e+###", "0.0####"));" ";b
	end if
	Print $("")
end sub

The coloured 0.0 is wrong (see results of next program)

single root  -0.66666667 -0.66666667
real         0.33333 -1.0
complex      (-0.33333+0.4714i) (-0.33333-0.4714i)
real         1.e+9 0.0
real         1.00E+70 0.0
real         1.00E+100 0.0
real         -1.#IND -1.#IND
real         -1.#IND -1.#IND

And this is the very good one:

Module Roots_of_Quadratic_Function {
	declare global m math2
	function global complex(a as double, b as double=0) {
		method m, "cxNew", a, b as ret: =ret
	}
	function quadroots(a as double, b as double, c as double) {
		var d = b*b - 4*a*c,  a2 = a + a	
		if d<0 then
			var r=-b/a2
			var i=sqrt(-d)/a2
			="complex", complex(r, i), complex(r, -i), 5
		else.if d==0 then
			="single root", -b/2/a, -b/2/a, 8
		else
			var r =if(b<0 -> (-b + sqrt(d)) / a2, (-b - sqrt(d)) / a2)
			="real", r, c/(a*r), 5
		end if
	}
	flush
	data "" , "outputRoots.txt"
	while not empty
		read filename
		open filename for wide output as #f
			Disp(quadroots(3, 4, 4/3))
			Disp(quadroots(3, 2, -1))
			Disp(quadroots(3, 2, 1))
			Disp(quadroots(1, -1e9, 1))
			Disp(quadroots(1, -1e70, 1))
			Disp(quadroots(1, -1e100, 1))
			Disp(quadroots(1, -1e200, 1))
			Disp(quadroots(1, -1e300, 1))
			Disp(quadroots(1, 0, 1))
			Disp(quadroots(2, -1, -6))
			Disp(quadroots(3, 4, 5))
			Disp(quadroots(0.5, sqrt(2), 1))
			Disp(quadroots(1, 2, 2))
		close #f
		if filename<>"" then win dir$+filename
	end while
	sub disp(arg as array)
		(s, a, b, n)=arg
		Print #f, field$(s, 12);
		if type$(a)="cxComplex" then disp1(a) else disp2(a)
		if type$(b)="cxComplex" then disp1(b) else	disp2(b)
		Print #f
	end sub
	sub disp1(a)
		local aa="", bb=if$(a|i<0->"-","+")
		if a|i<>0 then			
			if abs(a|i)<>1 then bb+=""+(abs(round(a|i, n)))
			bb+="i"
		else
			bb=""
		end if
		if a|r=0 then
			if a|i=0 then aa="0"
		else
			aa=""+(round(a|r, n))
		end if
		Print #f, " (";aa;bb;")";
	end sub
	sub disp2(b)
		local boolean k=b<>0 and (abs(b)<1e-6 or abs(b)>1e6)
		local res=if$(k-> str$(b,"Scientific"), ""+(round(b, n)))
		if instr(res, "INF") then res="inf"
		Print #f, " ";res;
	end sub
}
Roots_of_Quadratic_Function

single root  -0.66666667 -0.66666667
real         -1 0.33333
complex      (-0.33333+0.4714i) (-0.33333-0.4714i)
real         1.00E+09 1.00E-09
real         1.00E+70 1.00E-70
real         1.00E+100 1.00E-100
real         inf 0
real         inf 0
complex      (+i) (-i)
real         2 -1.5
complex      (-0.66667+1.10554i) (-0.66667-1.10554i)
single root  -1.41421356 -1.41421356
complex      (-1+i) (-1-i)