packages feed

language-Modula2-0.1: examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/ITEMS/ITEMOPER.MOD

IMPLEMENTATION MODULE ItemOperations;
(*====================================================================
    Version  : 1.0  Sat, Mar 4, 1989  C. Lins
    Compiler : JPI TopSpeed Modula-2
    Code Size: R-  bytes
    Component: Structure Utility - Generic Item Operations

    INTRODUCTION
    This module provides predefined routines for the standard data
    types, (CHAR, INTEGER, etc.), compatible with the procedure types
    exported by the ╥Items╙ module.

    REVISION HISTORY
    v1.0  Sat, Mar 4, 1989  C. Lins
      Initial JPI implementation.

    Proprietary Notices
      Copyright (C) 1989 Charles A. Lins. All rights reserved.
====================================================================*)

FROM Items IMPORT
    (*--Type*) Item;

FROM Relations IMPORT
    (*--Type*) Relation;

    (*-----------------------*)

PROCEDURE AssignItem   (    source : Item     (*-- in	 *))
				   : Item     (*-- out	 *);
BEGIN
  RETURN source;
END AssignItem;
(*----------------------------*)

PROCEDURE EqualItems   (    left   : Item     (*-- in	 *);
			    right  : Item     (*-- in	 *))
				   : BOOLEAN  (*-- out	 *);
BEGIN
  RETURN left = right;
END EqualItems;
(*----------------------------*)

PROCEDURE CharCompare	   (	left : Item	(*-- in    *);
				right: Item	(*-- in    *))
				     : Relation (*-- out   *);

VAR   leftChar	: CHAR;
      rightChar : CHAR;

BEGIN
  leftChar  := CHAR(left);
  rightChar := CHAR(right);

  IF (leftChar = rightChar) THEN
     RETURN equal;

  ELSIF (leftChar < rightChar) THEN
     RETURN less;

  ELSIF (leftChar > rightChar) THEN
     RETURN greater;
  END (*--if*);

  RETURN incomparable; (*-- We should NEVER get here *)
END CharCompare;
(*----------------------------*)

PROCEDURE IntegerCompare   (	left : Item	(*-- in    *);
				right: Item	(*-- in    *))
				     : Relation (*-- out   *);

VAR   leftInt  : INTEGER;
      rightInt : INTEGER;

BEGIN
  leftInt  := INTEGER(left);
  rightInt := INTEGER(right);

  IF (leftInt = rightInt) THEN
     RETURN equal;

  ELSIF (leftInt < rightInt) THEN
     RETURN less;

  ELSIF (leftInt > rightInt) THEN
     RETURN greater;
  END (*--if*);

  RETURN incomparable; (*-- We should NEVER get here *)
END IntegerCompare;
(*----------------------------*)

PROCEDURE CardinalCompare  (	left : Item	(*-- in    *);
				right: Item	(*-- in    *))
				     : Relation (*-- out   *);

VAR   leftCard	: CARDINAL;
      rightCard : CARDINAL;

BEGIN
  leftCard  := CARDINAL(left);
  rightCard := CARDINAL(right);

  IF (leftCard = rightCard) THEN
     RETURN equal;

  ELSIF (leftCard < rightCard) THEN
     RETURN less;

  ELSIF (leftCard > rightCard) THEN
     RETURN greater;
  END (*--if*);

  RETURN incomparable; (*-- We should NEVER get here *)
END CardinalCompare;
(*----------------------------*)

PROCEDURE LongIntCompare   (	left : Item	(*-- in    *);
				right: Item	(*-- in    *))
				     : Relation (*-- out   *);

VAR   leftLongInt  : LONGINT;
      rightLongInt : LONGINT;

BEGIN
  leftLongInt  := LONGINT(left);
  rightLongInt := LONGINT(right);

  IF (leftLongInt = rightLongInt) THEN
     RETURN equal;

  ELSIF (leftLongInt < rightLongInt) THEN
     RETURN less;

  ELSIF (leftLongInt > rightLongInt) THEN
     RETURN greater;
  END (*--if*);

  RETURN incomparable; (*-- We should NEVER get here *)
END LongIntCompare;
(*----------------------------*)

PROCEDURE LongCardCompare  (	left : Item	(*-- in    *);
				right: Item	(*-- in    *))
				     : Relation (*-- out   *);

VAR   leftLongCard  : LONGCARD;
      rightLongCard : LONGCARD;

BEGIN
  leftLongCard	:= LONGCARD(left);
  rightLongCard := LONGCARD(right);

  IF (leftLongCard = rightLongCard) THEN
     RETURN equal;

  ELSIF (leftLongCard < rightLongCard) THEN
     RETURN less;

  ELSIF (leftLongCard > rightLongCard) THEN
     RETURN greater;
  END (*--if*);

  RETURN incomparable; (*-- We should NEVER get here *)
END LongCardCompare;
(*----------------------------*)

PROCEDURE RealCompare	   (	left : Item	(*-- in    *);
				right: Item	(*-- in    *))
				     : Relation (*-- out   *);

VAR   leftReal	: REAL;
      rightReal : REAL;

BEGIN
  leftReal  := REAL(left);
  rightReal := REAL(right);

  IF (leftReal = rightReal) THEN
     RETURN equal;

  ELSIF (leftReal < rightReal) THEN
     RETURN less;

  ELSIF (leftReal > rightReal) THEN
     RETURN greater;
  END (*--if*);

  RETURN incomparable; (*-- We should NEVER get here *)
END RealCompare;
(*----------------------------*)

END ItemOperations.