implemented support of "ALL" operator; it was necessary to introduce procedure type comparison in FoxSemanticChecker.Distance to allow procedure as a parameter of the operator;

added support of unary "ALL" operators in FoxArrayBase.Mod; currently such operators are supported for SHORTINT, INTEGER, LONGINT, HUGEINT, REAL, LONGREAL, COMPLEX basic data types

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@6484 8c9fc860-2736-0410-a75d-ab315db34111

source/FoxArrayBase.Mod

@@ -8,7 +8,15 @@ IMPORT SYSTEM, KernelLog, Heaps, Math, MathL;
 
 TYPE
 	Address = LONGINT;
-
+	
+	GenericUnaryAALoopS = PROCEDURE ( ladr, dadr, linc, dinc, len: Address; op: PROCEDURE(x: SHORTINT): SHORTINT );
+	GenericUnaryAALoopI = PROCEDURE ( ladr, dadr, linc, dinc, len: Address; op: PROCEDURE(x: INTEGER): INTEGER );
+	GenericUnaryAALoopL = PROCEDURE ( ladr, dadr, linc, dinc, len: Address; op: PROCEDURE(x: LONGINT): LONGINT );
+	GenericUnaryAALoopH = PROCEDURE ( ladr, dadr, linc, dinc, len: Address; op: PROCEDURE(x: HUGEINT): HUGEINT );
+	GenericUnaryAALoopR = PROCEDURE ( ladr, dadr, linc, dinc, len: Address; op: PROCEDURE(x: REAL): REAL );
+	GenericUnaryAALoopX = PROCEDURE ( ladr, dadr, linc, dinc, len: Address; op: PROCEDURE(x: LONGREAL): LONGREAL );
+	GenericUnaryAALoopZ = PROCEDURE ( ladr, dadr, linc, dinc, len: Address; op: PROCEDURE(x: COMPLEX): COMPLEX );
+	GenericUnaryAALoopLZ = PROCEDURE ( ladr, dadr, linc, dinc, len: Address; op: PROCEDURE(x: LONGCOMPLEX): LONGCOMPLEX );
 	UnaryAALoop = PROCEDURE ( ladr, dadr, linc, dinc, len: Address );
 	UnaryASLoop = PROCEDURE ( ladr, dadr, linc, len: Address );
 	UnarySALoop = PROCEDURE ( ladr, dadr, dinc, len: Address );
@@ -509,6 +517,402 @@ Sufficient (but not necessary) conditions:
 
 
 	(*** procedures to traverse arrays and apply operators *)
+	
+	(** apply unary operator to array:  array SHORTINT -> array SHORTINT *)
+	PROCEDURE ApplyGenericUnaryAAOpS( d, l: Address;  elementSize: LONGINT; Loop: GenericUnaryAALoopS; op: PROCEDURE(x: SHORTINT): SHORTINT );
+		VAR loopd, looplen, loopli, loopdi: LONGINT;  p: ANY;  glen: LONGINT;
+			origdest: LONGINT;  modes: SET;
+			dest, left, dim: LONGINT;
+			
+		PROCEDURE Traverse( dim: LONGINT;  ladr, dadr: Address );
+		VAR len: LONGINT;  linc, dinc: LONGINT;
+		BEGIN
+			IF dim = loopd THEN
+				Loop( ladr, dadr, loopli, loopdi, looplen, op );
+				IF conservative THEN INC( glen, looplen ) END;
+			ELSE
+				len := GetLen( left, dim );  linc := GetIncr( left, dim );
+				dinc := GetIncr( dest, dim );  INC( dim );
+				WHILE (len > 0) DO
+					Traverse( dim, ladr, dadr );  INC( ladr, linc );  INC( dadr, dinc ); DEC( len );
+				END;
+			END;
+		END Traverse;
+		
+	BEGIN
+		SYSTEM.GET( d, dest );  SYSTEM.GET( l, left );  dim := GetDim( left );
+		origdest := 0;  modes := {up, down};
+		(* allocate destination, if necessary *)
+		p := AllocateSame( dest, left, elementSize );
+		IF p = NIL THEN
+			CopyUpCompatible( dest, left, modes );
+			IF up IN modes THEN  (* nothing to be done *)
+			ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+			ELSE origdest := dest;  p := AllocateTemp( dest, origdest, elementSize );
+			END;
+		END;
+		(* allocate destination, if necessary *)
+		(*IF GetAdr( dest ) = -1 THEN p := Allocate( left, dest, dim, elementSize )
+		ELSIF CheckGeometry( left, dest, dim )
+		END;		*)
+		IF debug THEN Report( "AA: left", left );  Report( "AA: dest", dest );  END;
+		(* check pattern: longest piece that can be done with a loop *)
+		FindPattern2( left, dest, dim, loopd, looplen, loopli, loopdi );
+		Traverse( 0, GetAdr( left ), GetAdr( dest ) );
+		IF up IN modes THEN  (* nothing to be done *)
+		ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+		ELSE CopyContent( origdest, dest, elementSize );
+		END;
+		SYSTEM.PUT( d, dest );
+	END ApplyGenericUnaryAAOpS;
+
+	(** apply unary operator to array:  array INTEGER -> array INTEGER *)
+	PROCEDURE ApplyGenericUnaryAAOpI( d, l: Address;  elementSize: LONGINT; Loop: GenericUnaryAALoopI; op: PROCEDURE(x: INTEGER): INTEGER );
+		VAR loopd, looplen, loopli, loopdi: LONGINT;  p: ANY;  glen: LONGINT;
+			origdest: LONGINT;  modes: SET;
+			dest, left, dim: LONGINT;
+			
+		PROCEDURE Traverse( dim: LONGINT;  ladr, dadr: Address );
+		VAR len: LONGINT;  linc, dinc: LONGINT;
+		BEGIN
+			IF dim = loopd THEN
+				Loop( ladr, dadr, loopli, loopdi, looplen, op );
+				IF conservative THEN INC( glen, looplen ) END;
+			ELSE
+				len := GetLen( left, dim );  linc := GetIncr( left, dim );
+				dinc := GetIncr( dest, dim );  INC( dim );
+				WHILE (len > 0) DO
+					Traverse( dim, ladr, dadr );  INC( ladr, linc );  INC( dadr, dinc ); DEC( len );
+				END;
+			END;
+		END Traverse;
+		
+	BEGIN
+		SYSTEM.GET( d, dest );  SYSTEM.GET( l, left );  dim := GetDim( left );
+		origdest := 0;  modes := {up, down};
+		(* allocate destination, if necessary *)
+		p := AllocateSame( dest, left, elementSize );
+		IF p = NIL THEN
+			CopyUpCompatible( dest, left, modes );
+			IF up IN modes THEN  (* nothing to be done *)
+			ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+			ELSE origdest := dest;  p := AllocateTemp( dest, origdest, elementSize );
+			END;
+		END;
+		(* allocate destination, if necessary *)
+		(*IF GetAdr( dest ) = -1 THEN p := Allocate( left, dest, dim, elementSize )
+		ELSIF CheckGeometry( left, dest, dim )
+		END;		*)
+		IF debug THEN Report( "AA: left", left );  Report( "AA: dest", dest );  END;
+		(* check pattern: longest piece that can be done with a loop *)
+		FindPattern2( left, dest, dim, loopd, looplen, loopli, loopdi );
+		Traverse( 0, GetAdr( left ), GetAdr( dest ) );
+		IF up IN modes THEN  (* nothing to be done *)
+		ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+		ELSE CopyContent( origdest, dest, elementSize );
+		END;
+		SYSTEM.PUT( d, dest );
+	END ApplyGenericUnaryAAOpI;
+
+	(** apply unary operator to array:  array LONGINT -> array LONGINT *)
+	PROCEDURE ApplyGenericUnaryAAOpL( d, l: Address;  elementSize: LONGINT; Loop: GenericUnaryAALoopL; op: PROCEDURE(x: LONGINT): LONGINT );
+		VAR loopd, looplen, loopli, loopdi: LONGINT;  p: ANY;  glen: LONGINT;
+			origdest: LONGINT;  modes: SET;
+			dest, left, dim: LONGINT;
+			
+		PROCEDURE Traverse( dim: LONGINT;  ladr, dadr: Address );
+		VAR len: LONGINT;  linc, dinc: LONGINT;
+		BEGIN
+			IF dim = loopd THEN
+				Loop( ladr, dadr, loopli, loopdi, looplen, op );
+				IF conservative THEN INC( glen, looplen ) END;
+			ELSE
+				len := GetLen( left, dim );  linc := GetIncr( left, dim );
+				dinc := GetIncr( dest, dim );  INC( dim );
+				WHILE (len > 0) DO
+					Traverse( dim, ladr, dadr );  INC( ladr, linc );  INC( dadr, dinc ); DEC( len );
+				END;
+			END;
+		END Traverse;
+		
+	BEGIN
+		SYSTEM.GET( d, dest );  SYSTEM.GET( l, left );  dim := GetDim( left );
+		origdest := 0;  modes := {up, down};
+		(* allocate destination, if necessary *)
+		p := AllocateSame( dest, left, elementSize );
+		IF p = NIL THEN
+			CopyUpCompatible( dest, left, modes );
+			IF up IN modes THEN  (* nothing to be done *)
+			ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+			ELSE origdest := dest;  p := AllocateTemp( dest, origdest, elementSize );
+			END;
+		END;
+		(* allocate destination, if necessary *)
+		(*IF GetAdr( dest ) = -1 THEN p := Allocate( left, dest, dim, elementSize )
+		ELSIF CheckGeometry( left, dest, dim )
+		END;		*)
+		IF debug THEN Report( "AA: left", left );  Report( "AA: dest", dest );  END;
+		(* check pattern: longest piece that can be done with a loop *)
+		FindPattern2( left, dest, dim, loopd, looplen, loopli, loopdi );
+		Traverse( 0, GetAdr( left ), GetAdr( dest ) );
+		IF up IN modes THEN  (* nothing to be done *)
+		ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+		ELSE CopyContent( origdest, dest, elementSize );
+		END;
+		SYSTEM.PUT( d, dest );
+	END ApplyGenericUnaryAAOpL;
+	
+	(** apply unary operator to array:  array HUGEINT -> array HUGEINT *)
+	PROCEDURE ApplyGenericUnaryAAOpH( d, l: Address;  elementSize: LONGINT; Loop: GenericUnaryAALoopH; op: PROCEDURE(x: HUGEINT): HUGEINT );
+	VAR loopd, looplen, loopli, loopdi: LONGINT;  p: ANY;  glen: LONGINT;
+		origdest: LONGINT;  modes: SET;
+	VAR dest, left, dim: LONGINT;
+
+		PROCEDURE Traverse( dim: LONGINT;  ladr, dadr: Address );
+		VAR len: LONGINT;  linc, dinc: LONGINT;
+		BEGIN
+			IF dim = loopd THEN
+				Loop( ladr, dadr, loopli, loopdi, looplen, op );
+				IF conservative THEN INC( glen, looplen ) END;
+			ELSE
+				len := GetLen( left, dim );  linc := GetIncr( left, dim );
+				dinc := GetIncr( dest, dim );  INC( dim );
+				WHILE (len > 0) DO
+					Traverse( dim, ladr, dadr );  INC( ladr, linc );  INC( dadr, dinc );
+					DEC( len );
+				END;
+			END;
+		END Traverse;
+
+	BEGIN
+		SYSTEM.GET( d, dest );  SYSTEM.GET( l, left );  dim := GetDim( left );
+		origdest := 0;  modes := {up, down};
+		(* allocate destination, if necessary *)
+		p := AllocateSame( dest, left, elementSize );
+		IF p = NIL THEN
+			CopyUpCompatible( dest, left, modes );
+			IF up IN modes THEN  (* nothing to be done *)
+			ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+			ELSE origdest := dest;  p := AllocateTemp( dest, origdest, elementSize );
+			END;
+		END;
+		(*
+		(* allocate destination, if necessary *)
+		IF GetAdr( dest ) = -1 THEN p := Allocate( left, dest, dim, elementSize )
+		ELSIF CheckGeometry( left, dest, dim )
+		END;
+		*)
+		IF debug THEN Report( "AA: left", left );  Report( "AA: dest", dest );  END;
+		(* check pattern: longest piece that can be done with a loop *)
+		FindPattern2( left, dest, dim, loopd, looplen, loopli, loopdi );
+		Traverse( 0, GetAdr( left ), GetAdr( dest ) );
+		IF up IN modes THEN  (* nothing to be done *)
+		ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+		ELSE CopyContent( origdest, dest, elementSize );
+		END;
+		SYSTEM.PUT( d, dest );
+	END ApplyGenericUnaryAAOpH;
+
+	(** apply unary operator to array:  array REAL -> array REAL *)
+	PROCEDURE ApplyGenericUnaryAAOpR( d, l: Address;  elementSize: LONGINT; Loop: GenericUnaryAALoopR; op: PROCEDURE(x: REAL): REAL );
+		VAR loopd, looplen, loopli, loopdi: LONGINT;  p: ANY;  glen: LONGINT;
+			origdest: LONGINT;  modes: SET;
+			dest, left, dim: LONGINT;
+			
+		PROCEDURE Traverse( dim: LONGINT;  ladr, dadr: Address );
+		VAR len: LONGINT;  linc, dinc: LONGINT;
+		BEGIN
+			IF dim = loopd THEN
+				Loop( ladr, dadr, loopli, loopdi, looplen, op );
+				IF conservative THEN INC( glen, looplen ) END;
+			ELSE
+				len := GetLen( left, dim );  linc := GetIncr( left, dim );
+				dinc := GetIncr( dest, dim );  INC( dim );
+				WHILE (len > 0) DO
+					Traverse( dim, ladr, dadr );  INC( ladr, linc );  INC( dadr, dinc ); DEC( len );
+				END;
+			END;
+		END Traverse;
+		
+	BEGIN
+		SYSTEM.GET( d, dest );  SYSTEM.GET( l, left );  dim := GetDim( left );
+		origdest := 0;  modes := {up, down};
+		(* allocate destination, if necessary *)
+		p := AllocateSame( dest, left, elementSize );
+		IF p = NIL THEN
+			CopyUpCompatible( dest, left, modes );
+			IF up IN modes THEN  (* nothing to be done *)
+			ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+			ELSE origdest := dest;  p := AllocateTemp( dest, origdest, elementSize );
+			END;
+		END;
+		(* allocate destination, if necessary *)
+		(*IF GetAdr( dest ) = -1 THEN p := Allocate( left, dest, dim, elementSize )
+		ELSIF CheckGeometry( left, dest, dim )
+		END;		*)
+		IF debug THEN Report( "AA: left", left );  Report( "AA: dest", dest );  END;
+		(* check pattern: longest piece that can be done with a loop *)
+		FindPattern2( left, dest, dim, loopd, looplen, loopli, loopdi );
+		Traverse( 0, GetAdr( left ), GetAdr( dest ) );
+		IF up IN modes THEN  (* nothing to be done *)
+		ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+		ELSE CopyContent( origdest, dest, elementSize );
+		END;
+		SYSTEM.PUT( d, dest );
+	END ApplyGenericUnaryAAOpR;
+	
+	(** apply unary operator to array:  array LONGREAL -> array LONGREAL *)
+	PROCEDURE ApplyGenericUnaryAAOpX( d, l: Address;  elementSize: LONGINT; Loop: GenericUnaryAALoopX; op: PROCEDURE(x: LONGREAL): LONGREAL );
+	VAR loopd, looplen, loopli, loopdi: LONGINT;  p: ANY;  glen: LONGINT;
+		origdest: LONGINT;  modes: SET;
+	VAR dest, left, dim: LONGINT;
+
+		PROCEDURE Traverse( dim: LONGINT;  ladr, dadr: Address );
+		VAR len: LONGINT;  linc, dinc: LONGINT;
+		BEGIN
+			IF dim = loopd THEN
+				Loop( ladr, dadr, loopli, loopdi, looplen, op );
+				IF conservative THEN INC( glen, looplen ) END;
+			ELSE
+				len := GetLen( left, dim );  linc := GetIncr( left, dim );
+				dinc := GetIncr( dest, dim );  INC( dim );
+				WHILE (len > 0) DO
+					Traverse( dim, ladr, dadr );  INC( ladr, linc );  INC( dadr, dinc );
+					DEC( len );
+				END;
+			END;
+		END Traverse;
+
+	BEGIN
+		SYSTEM.GET( d, dest );  SYSTEM.GET( l, left );  dim := GetDim( left );
+		origdest := 0;  modes := {up, down};
+		(* allocate destination, if necessary *)
+		p := AllocateSame( dest, left, elementSize );
+		IF p = NIL THEN
+			CopyUpCompatible( dest, left, modes );
+			IF up IN modes THEN  (* nothing to be done *)
+			ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+			ELSE origdest := dest;  p := AllocateTemp( dest, origdest, elementSize );
+			END;
+		END;
+		(*
+		(* allocate destination, if necessary *)
+		IF GetAdr( dest ) = -1 THEN p := Allocate( left, dest, dim, elementSize )
+		ELSIF CheckGeometry( left, dest, dim )
+		END;
+		*)
+		IF debug THEN Report( "AA: left", left );  Report( "AA: dest", dest );  END;
+		(* check pattern: longest piece that can be done with a loop *)
+		FindPattern2( left, dest, dim, loopd, looplen, loopli, loopdi );
+		Traverse( 0, GetAdr( left ), GetAdr( dest ) );
+		IF up IN modes THEN  (* nothing to be done *)
+		ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+		ELSE CopyContent( origdest, dest, elementSize );
+		END;
+		SYSTEM.PUT( d, dest );
+	END ApplyGenericUnaryAAOpX;
+	
+	(** apply unary operator to array:  array COMPLEX -> array COMPLEX *)
+	PROCEDURE ApplyGenericUnaryAAOpZ( d, l: Address;  elementSize: LONGINT; Loop: GenericUnaryAALoopZ; op: PROCEDURE(x: COMPLEX): COMPLEX );
+	VAR loopd, looplen, loopli, loopdi: LONGINT;  p: ANY;  glen: LONGINT;
+		origdest: LONGINT;  modes: SET;
+	VAR dest, left, dim: LONGINT;
+
+		PROCEDURE Traverse( dim: LONGINT;  ladr, dadr: Address );
+		VAR len: LONGINT;  linc, dinc: LONGINT;
+		BEGIN
+			IF dim = loopd THEN
+				Loop( ladr, dadr, loopli, loopdi, looplen, op );
+				IF conservative THEN INC( glen, looplen ) END;
+			ELSE
+				len := GetLen( left, dim );  linc := GetIncr( left, dim );
+				dinc := GetIncr( dest, dim );  INC( dim );
+				WHILE (len > 0) DO
+					Traverse( dim, ladr, dadr );  INC( ladr, linc );  INC( dadr, dinc );
+					DEC( len );
+				END;
+			END;
+		END Traverse;
+
+	BEGIN
+		SYSTEM.GET( d, dest );  SYSTEM.GET( l, left );  dim := GetDim( left );
+		origdest := 0;  modes := {up, down};
+		(* allocate destination, if necessary *)
+		p := AllocateSame( dest, left, elementSize );
+		IF p = NIL THEN
+			CopyUpCompatible( dest, left, modes );
+			IF up IN modes THEN  (* nothing to be done *)
+			ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+			ELSE origdest := dest;  p := AllocateTemp( dest, origdest, elementSize );
+			END;
+		END;
+		(*
+		(* allocate destination, if necessary *)
+		IF GetAdr( dest ) = -1 THEN p := Allocate( left, dest, dim, elementSize )
+		ELSIF CheckGeometry( left, dest, dim )
+		END;
+		*)
+		IF debug THEN Report( "AA: left", left );  Report( "AA: dest", dest );  END;
+		(* check pattern: longest piece that can be done with a loop *)
+		FindPattern2( left, dest, dim, loopd, looplen, loopli, loopdi );
+		Traverse( 0, GetAdr( left ), GetAdr( dest ) );
+		IF up IN modes THEN  (* nothing to be done *)
+		ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+		ELSE CopyContent( origdest, dest, elementSize );
+		END;
+		SYSTEM.PUT( d, dest );
+	END ApplyGenericUnaryAAOpZ;
+	
+	(** apply unary operator to array:  array LONGCOMPLEX -> array LONGCOMPLEX *)
+	PROCEDURE ApplyGenericUnaryAAOpLZ( d, l: Address;  elementSize: LONGINT; Loop: GenericUnaryAALoopLZ; op: PROCEDURE(x: LONGCOMPLEX): LONGCOMPLEX );
+	VAR loopd, looplen, loopli, loopdi: LONGINT;  p: ANY;  glen: LONGINT;
+		origdest: LONGINT;  modes: SET;
+	VAR dest, left, dim: LONGINT;
+
+		PROCEDURE Traverse( dim: LONGINT;  ladr, dadr: Address );
+		VAR len: LONGINT;  linc, dinc: LONGINT;
+		BEGIN
+			IF dim = loopd THEN
+				Loop( ladr, dadr, loopli, loopdi, looplen, op );
+				IF conservative THEN INC( glen, looplen ) END;
+			ELSE
+				len := GetLen( left, dim );  linc := GetIncr( left, dim );
+				dinc := GetIncr( dest, dim );  INC( dim );
+				WHILE (len > 0) DO
+					Traverse( dim, ladr, dadr );  INC( ladr, linc );  INC( dadr, dinc );
+					DEC( len );
+				END;
+			END;
+		END Traverse;
+
+	BEGIN
+		SYSTEM.GET( d, dest );  SYSTEM.GET( l, left );  dim := GetDim( left );
+		origdest := 0;  modes := {up, down};
+		(* allocate destination, if necessary *)
+		p := AllocateSame( dest, left, elementSize );
+		IF p = NIL THEN
+			CopyUpCompatible( dest, left, modes );
+			IF up IN modes THEN  (* nothing to be done *)
+			ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+			ELSE origdest := dest;  p := AllocateTemp( dest, origdest, elementSize );
+			END;
+		END;
+		(*
+		(* allocate destination, if necessary *)
+		IF GetAdr( dest ) = -1 THEN p := Allocate( left, dest, dim, elementSize )
+		ELSIF CheckGeometry( left, dest, dim )
+		END;
+		*)
+		IF debug THEN Report( "AA: left", left );  Report( "AA: dest", dest );  END;
+		(* check pattern: longest piece that can be done with a loop *)
+		FindPattern2( left, dest, dim, loopd, looplen, loopli, loopdi );
+		Traverse( 0, GetAdr( left ), GetAdr( dest ) );
+		IF up IN modes THEN  (* nothing to be done *)
+		ELSIF down IN modes THEN Reverse( left, dim );  Reverse( dest, dim )
+		ELSE CopyContent( origdest, dest, elementSize );
+		END;
+		SYSTEM.PUT( d, dest );
+	END ApplyGenericUnaryAAOpLZ;
 
 (** apply unary operator to array:  array -> array *)
 	PROCEDURE ApplyUnaryAAOp( d, l: Address;  elementSize: LONGINT;
@@ -1639,8 +2043,89 @@ Sufficient (but not necessary) conditions:
 		ApplyUnaryAAOp( ADDRESSOF( RESULT ), ADDRESSOF( src ), SIZEOF( BOOLEAN ), NotLoopAB );
 		RETURN RESULT
 	END "~";
+	
+	(*** monadic generic (A) -> -A  ********************************************************************)
+
+(** SHORTINT *)
+	PROCEDURE GenericLoopS( ladr, dadr, linc, dinc, len: LONGINT; op: PROCEDURE(x: SHORTINT): SHORTINT );
+	VAR lval: SHORTINT;
+	BEGIN
+		WHILE (len > 0) DO
+			SYSTEM.GET( ladr, lval );  SYSTEM.PUT( dadr, op(lval) );  INC( ladr, linc );  INC( dadr, dinc );
+			DEC( len );
+		END;
+	END GenericLoopS;
+	
+(** INTEGER *)
+	PROCEDURE GenericLoopI( ladr, dadr, linc, dinc, len: LONGINT; op: PROCEDURE(x: INTEGER): INTEGER );
+	VAR lval: INTEGER;
+	BEGIN
+		WHILE (len > 0) DO
+			SYSTEM.GET( ladr, lval );  SYSTEM.PUT( dadr, op(lval) );  INC( ladr, linc );  INC( dadr, dinc );
+			DEC( len );
+		END;
+	END GenericLoopI;
+
+(** LONGINT *)
+	PROCEDURE GenericLoopL( ladr, dadr, linc, dinc, len: LONGINT; op: PROCEDURE(x: LONGINT): LONGINT );
+	VAR lval: LONGINT;
+	BEGIN
+		WHILE (len > 0) DO
+			SYSTEM.GET( ladr, lval );  SYSTEM.PUT( dadr, op(lval) );  INC( ladr, linc );  INC( dadr, dinc );
+			DEC( len );
+		END;
+	END GenericLoopL;
 
+(** HUGEINT *)
+	PROCEDURE GenericLoopH( ladr, dadr, linc, dinc, len: LONGINT; op: PROCEDURE(x: HUGEINT): HUGEINT );
+	VAR lval: HUGEINT;
+	BEGIN
+		WHILE (len > 0) DO
+			SYSTEM.GET( ladr, lval );  SYSTEM.PUT( dadr, op(lval) );  INC( ladr, linc );  INC( dadr, dinc );
+			DEC( len );
+		END;
+	END GenericLoopH;
 
+(** REAL *)
+	PROCEDURE GenericLoopR( ladr, dadr, linc, dinc, len: LONGINT; op: PROCEDURE(x: REAL): REAL );
+	VAR lval: REAL;
+	BEGIN
+		WHILE (len > 0) DO
+			SYSTEM.GET( ladr, lval );  SYSTEM.PUT( dadr, op(lval) );  INC( ladr, linc );  INC( dadr, dinc );
+			DEC( len );
+		END;
+	END GenericLoopR;
+
+(** LONGREAL *)
+	PROCEDURE GenericLoopX( ladr, dadr, linc, dinc, len: LONGINT; op: PROCEDURE(x: LONGREAL): LONGREAL );
+	VAR lval: LONGREAL;
+	BEGIN
+		WHILE (len > 0) DO
+			SYSTEM.GET( ladr, lval );  SYSTEM.PUT( dadr, op(lval) );  INC( ladr, linc );  INC( dadr, dinc );
+			DEC( len );
+		END;
+	END GenericLoopX;
+	
+(** COMPLEX *)
+	PROCEDURE GenericLoopZ( ladr, dadr, linc, dinc, len: LONGINT; op: PROCEDURE(x: COMPLEX): COMPLEX );
+	VAR lval: COMPLEX;
+	BEGIN
+		WHILE (len > 0) DO
+			SYSTEM.GET( ladr, lval );  SYSTEM.PUT( dadr, op(lval) );  INC( ladr, linc );  INC( dadr, dinc );
+			DEC( len );
+		END;
+	END GenericLoopZ;
+(*
+(** LONGCOMPLEX *)
+	PROCEDURE GenericLoopLZ( ladr, dadr, linc, dinc, len: LONGINT; op: PROCEDURE(x: LONGCOMPLEX): LONGCOMPLEX );
+	VAR lval: LONGCOMPLEX;
+	BEGIN
+		WHILE (len > 0) DO
+			SYSTEM.GET( ladr, lval );  SYSTEM.PUT( dadr, op(lval) );  INC( ladr, linc );  INC( dadr, dinc );
+			DEC( len );
+		END;
+	END GenericLoopLZ;
+*)
 	(*** monadic minus A -> -A  ********************************************************************)
 
 (** SHORTINT *)
@@ -9554,6 +10039,48 @@ Sufficient (but not necessary) conditions:
 	OPERATOR ">="*(CONST x, y: LONGCOMPLEX): BOOLEAN; BEGIN RETURN ABS(x) >= ABS(y); END ">=";
 	OPERATOR "<"*(CONST x, y: LONGCOMPLEX): BOOLEAN; BEGIN RETURN ABS(x) < ABS(y); END "<";
 	OPERATOR ">"*(CONST x, y: LONGCOMPLEX): BOOLEAN; BEGIN RETURN ABS(x) > ABS(y); END ">";
+	
+	OPERATOR "ALL"*(CONST x: ARRAY [?] OF SHORTINT; op: PROCEDURE(x: SHORTINT): SHORTINT): ARRAY[?] OF SHORTINT; (*should also accept operator ?*)
+	BEGIN
+		ApplyGenericUnaryAAOpS(ADDRESSOF(RESULT),ADDRESSOF(x),SIZEOF(SHORTINT),GenericLoopS,op);
+		RETURN RESULT;
+	END "ALL";
+
+	OPERATOR "ALL"*(CONST x: ARRAY [?] OF INTEGER; op: PROCEDURE(x: INTEGER): INTEGER): ARRAY[?] OF INTEGER; (*should also accept operator ?*)
+	BEGIN
+		ApplyGenericUnaryAAOpI(ADDRESSOF(RESULT),ADDRESSOF(x),SIZEOF(INTEGER),GenericLoopI,op);
+		RETURN RESULT;
+	END "ALL";
+	
+	OPERATOR "ALL"*(CONST x: ARRAY [?] OF LONGINT; op: PROCEDURE(x: LONGINT): LONGINT): ARRAY[?] OF LONGINT; (*should also accept operator ?*)
+	BEGIN
+		ApplyGenericUnaryAAOpL(ADDRESSOF(RESULT),ADDRESSOF(x),SIZEOF(LONGINT),GenericLoopL,op);
+		RETURN RESULT;
+	END "ALL";
+	
+	OPERATOR "ALL"*(CONST x: ARRAY [?] OF HUGEINT; op: PROCEDURE(x: HUGEINT): HUGEINT): ARRAY[?] OF HUGEINT; (*should also accept operator ?*)
+	BEGIN
+		ApplyGenericUnaryAAOpH(ADDRESSOF(RESULT),ADDRESSOF(x),SIZEOF(HUGEINT),GenericLoopH,op);
+		RETURN RESULT;
+	END "ALL";
+
+	OPERATOR "ALL"*(CONST x: ARRAY [?] OF REAL; op: PROCEDURE(x: REAL): REAL): ARRAY[?] OF REAL; (*should also accept operator ?*)
+	BEGIN
+		ApplyGenericUnaryAAOpR(ADDRESSOF(RESULT),ADDRESSOF(x),SIZEOF(REAL),GenericLoopR,op);
+		RETURN RESULT;
+	END "ALL";
+
+	OPERATOR "ALL"*(CONST x: ARRAY [?] OF LONGREAL; op: PROCEDURE(x: LONGREAL): LONGREAL): ARRAY[?] OF LONGREAL; (*should also accept operator ?*)
+	BEGIN
+		ApplyGenericUnaryAAOpX(ADDRESSOF(RESULT),ADDRESSOF(x),SIZEOF(LONGREAL),GenericLoopX,op);
+		RETURN RESULT;
+	END "ALL";
+	
+	OPERATOR "ALL"*(CONST x: ARRAY [?] OF COMPLEX; op: PROCEDURE(x: COMPLEX): COMPLEX): ARRAY[?] OF COMPLEX; (*should also accept operator ?*)
+	BEGIN
+		ApplyGenericUnaryAAOpZ(ADDRESSOF(RESULT),ADDRESSOF(x),SIZEOF(COMPLEX),GenericLoopZ,op);
+		RETURN RESULT;
+	END "ALL";
 
 BEGIN
 	alloc := 0;  SetDefaults();  InitOptimization();  (* CreateTypePool;  *)

source/FoxGlobal.Mod

@@ -106,8 +106,9 @@ CONST
 	Assert*= Scanner.EndOfText+1; Copy*= Assert+1; Dec*= Copy+1; Excl*= Dec+1; Halt*= Excl+1; Inc*= Halt+1; Incl*= Inc+1; New*= Incl+1; Dispose*= New+1; GetProcedure*= Dispose+1; Connect*= GetProcedure+1; Delegate*= Connect+1; Read*= Delegate+1; Write*= Read+1; Reshape*= Write+1; Wait*= Reshape+1; 
 	(* global functions *)
 	Abs*= Wait+1; Cap*= Abs+1; Chr*= Cap+1; Chr32*= Chr+1; Entier*= Chr32+1; EntierH*= Entier+1; Incr*= EntierH+1; Len*= Incr+1; Long*= Len+1; Max*= Long+1; Min*= Max+1; Odd*= Min+1; Ord*= Odd+1; Ord32*= Ord+1; Short*= Ord32+1; Size*= Short+1; Sum*= Size+1; Dim*= Sum+1; Cas*= Dim+1; First*= Cas+1; Last*= First+1; Step*= Last+1; Re*= Step+1; Im*= Re+1; Ash*= Im+1; Lsh*= Ash+1; Rot*= Lsh+1; 
+	All* = Rot+1;
 	(* system proper procedures *)
-	systemGet*= Rot+1; systemPut*= systemGet+1; systemMove*= systemPut+1; systemNew*= systemMove+1; systemRef*= systemNew+1; systemTypeCode*= systemRef+1; systemHalt*= systemTypeCode+1; systemPut8*= systemHalt+1; systemPut16*= systemPut8+1; systemPut32*= systemPut16+1; systemPut64*= systemPut32+1; systemTrace*= systemPut64+1; systemSetStackPointer*= systemTrace+1; systemSetFramePointer*= systemSetStackPointer+1; systemSetActivity*= systemSetFramePointer+1; 
+	systemGet*= All+1; systemPut*= systemGet+1; systemMove*= systemPut+1; systemNew*= systemMove+1; systemRef*= systemNew+1; systemTypeCode*= systemRef+1; systemHalt*= systemTypeCode+1; systemPut8*= systemHalt+1; systemPut16*= systemPut8+1; systemPut32*= systemPut16+1; systemPut64*= systemPut32+1; systemTrace*= systemPut64+1; systemSetStackPointer*= systemTrace+1; systemSetFramePointer*= systemSetStackPointer+1; systemSetActivity*= systemSetFramePointer+1; 
 	(* system functions *)
 	systemAdr*= systemSetActivity+1; systemSize*= systemAdr+1; systemBit*= systemSize+1; systemGet64*= systemBit+1; systemGet32*= systemGet64+1; systemGet16*= systemGet32+1; systemGet8*= systemGet16+1; systemVal*= systemGet8+1; systemMsk*= systemVal+1; systemGetStackPointer*= systemMsk+1; systemGetFramePointer*= systemGetStackPointer+1; systemGetActivity*= systemGetFramePointer+1; 
 	(* for active cells *)
@@ -834,6 +835,7 @@ TYPE
 		NewBuiltin(GetProcedure,"GETPROCEDURE",system.globalScope,TRUE);
 		NewBuiltin(systemTrace,"TRACE",system.globalScope,TRUE);
 		NewBuiltin(Reshape,"RESHAPE",system.globalScope,TRUE);
+		NewBuiltin(All,"ALL",system.globalScope,TRUE);
 		NewBuiltin(Wait,"WAIT",system.globalScope,FALSE);
 		NewBuiltin(Connect,"CONNECT",system.globalScope,FALSE);
 		NewBuiltin(Receive,"RECEIVE",system.globalScope,FALSE);
@@ -926,6 +928,7 @@ TYPE
 		OperatorDefined(system,Scanner.Address, TRUE);
 		OperatorDefined(system,Scanner.Size, TRUE);
 		OperatorDefined(system,Scanner.Alias, TRUE);
+		OperatorDefined(system,All,TRUE);
 		
 		OperatorDefined(system, Scanner.Questionmarks, TRUE);
 
@@ -1565,6 +1568,7 @@ TYPE
 		NewBuiltinIdentifier(Excl,"EXCL");
 		NewBuiltinIdentifier(Inc,"INC");
 		NewBuiltinIdentifier(Incl,"INCL");
+		NewBuiltinIdentifier(All,"ALL");
 
 
 		(* TODO: check if ok. The operators defined in FoxArrayBase require the following identifiers *)

source/FoxIntermediateBackend.Mod

@@ -8413,6 +8413,8 @@ TYPE
 				Convert(result.op,IntermediateCode.GetType(system, x.type));
 			(* ---- SUM ----- *)
 			|Global.Sum: HALT(200);
+			(* ---- ALL ----- *)
+			|Global.All: HALT(200);
 			(* ---- CAS ----- *)
 			|Global.Cas:
 				needsTrace := p0.NeedsTrace();

source/FoxSemanticChecker.Mod

@@ -5814,6 +5814,9 @@ TYPE
 				(* ---- SUM ----- *)
 				ELSIF (id = Global.Sum) & CheckArity(1,2) THEN (* can only be found by overloading *)
 					Error(position, Diagnostics.Invalid, "sum operator not applicable");
+				(* ---- ALL ----- *)
+				ELSIF (id = Global.All) & CheckArity(2,3) THEN (* can only be found by overloading *)
+					Error(position, Diagnostics.Invalid, "all operator not applicable");
 				(* ---- DIM ----- *)
 				ELSIF (id = Global.Dim) & CheckArity(1,1) THEN
 					type := system.sizeType;
@@ -6907,6 +6910,7 @@ TYPE
 						| Global.Max, Global.Min: (* unary and binary *)
 						| Global.Odd: (* TODO: arity? *)
 						| Global.Sum: (* TODO: arity? *)
+						| Global.All: (* TODO: arity? *)
 						| Global.Dim: mustBeUnary := TRUE; mustReturnInteger := TRUE;
 						| Scanner.Alias:
 						END;
@@ -8889,7 +8893,15 @@ TYPE
 				ASSERT(formalParameter.type # NIL);
 				IF (actualParameter.type = NIL) THEN distance := Infinity
 				ELSE
-					distance := TypeDistance(system,actualParameter.type.resolved,formalParameter.type.resolved,formalParameter.kind = SyntaxTree.VarParameter);
+					IF (actualParameter.type.resolved IS SyntaxTree.ProcedureType) & (formalParameter.type.resolved IS SyntaxTree.ProcedureType) THEN
+						IF actualParameter.type.resolved.SameType(formalParameter.type.resolved) THEN
+							distance := 0;
+						ELSE
+							distance := Infinity;
+						END;
+					ELSE
+						distance := TypeDistance(system,actualParameter.type.resolved,formalParameter.type.resolved,formalParameter.kind = SyntaxTree.VarParameter);
+					END;
 				END;
 				IF distance = Infinity THEN
 					result := Infinity;