Question

How to best implement a three valued logic in Delphi?

I was thinking of

type
  TExtBoolean = (ebTrue, ebFalse, ebUnknown);

with

function ExtOr(A: TExtBoolean; B: TExtBoolean): TExtBoolean;
begin
  if (A = ebTrue) or (B = ebTrue) then
    Result := ebTrue
  else if (A = ebFalse) and (B = ebFalse) then
    Result := ebFalse
  else
    Result := ebUnknown;
end;

and so on.

But that does not seem to be very elegant. Does a better way exist?

Edit: With elegance I mean easy to use. The more elegant the implementation, the better. CPU-efficiency is not (that) important for me.

Was it helpful?

Solution

You could implement an enhanced record with operator overloading. It would look like this:

type
  TTriBool = record
  public
    type
      TTriBoolEnum = (tbFalse, tbTrue, tbUnknown);
  public
    Value: TTriBoolEnum;
  public
    class operator Implicit(const Value: Boolean): TTriBool;
    class operator Implicit(const Value: TTriBoolEnum): TTriBool;
    class operator Implicit(const Value: TTriBool): TTriBoolEnum;
    class operator Equal(const lhs, rhs: TTriBool): Boolean;
    class operator LogicalOr(const lhs, rhs: TTriBool): TTriBool;
    function ToString: string;
  end;

class operator TTriBool.Implicit(const Value: Boolean): TTriBool;
begin
  if Value then
    Result.Value := tbTrue
  else
    Result.Value := tbFalse;
end;

class operator TTriBool.Implicit(const Value: TTriBoolEnum): TTriBool;
begin
  Result.Value := Value;
end;

class operator TTriBool.Implicit(const Value: TTriBool): TTriBoolEnum;
begin
  Result := Value.Value;
end;

class operator TTriBool.Equal(const lhs, rhs: TTriBool): Boolean;
begin
  Result := lhs.Value=rhs.Value;
end;

class operator TTriBool.LogicalOr(const lhs, rhs: TTriBool): TTriBool;
begin
  if (lhs.Value=tbTrue) or (rhs.Value=tbTrue) then
    Result := tbTrue
  else if (lhs.Value=tbFalse) and (rhs.Value=tbFalse) then
    Result := tbFalse
  else
    Result := tbUnknown;
end;

function TTriBool.ToString: string;
begin
  case Value of
  tbFalse:
    Result := 'False';
  tbTrue:
    Result := 'True';
  tbUnknown:
    Result := 'Unknown';
  end;
end;

Some sample usage:

var
  x: Double;
  tb1, tb2: TTriBool;

tb1 := True;
tb2 := x>3.0;
Writeln((tb1 or tb2).ToString);

tb1 := False;
tb2.Value := tbUnknown;
Writeln((tb1 or tb2).ToString);

which outputs:

True
Unknown

OTHER TIPS

AS. What did you mean by elegancre here ? Elegance of implementation or elegance of use or CPI-effieciency or maintainability ? Elegance is a very vague word...

I think the obvious way to make it easier to use is converting the type to be usable in the fashion like ExtBoolean1 or (ExtBoolean2 and True).

However the features required might be in or short before Delphi 2006 (quite a buggy release per se), so take your DUnit and do a lot of tests..

To list the features to be used and their descriptions:

  1. Enhanced Records: When should I use enhanced record types in Delphi instead of classes? and http://delphi.about.com/od/adptips2006/qt/newdelphirecord.htm and manual
  2. Operation overloading, including implicit typecasts: What operator do I overload when assigning an "Enhanced Record" to a normal "Data Type" variable? and Operator Overloading in Delphi and manual
  3. Functions inlining: what is use of inline keyword in delphi and manual

To outline some of those ideas:

type
  TExtBoolean = record
     Value: (ebUnknown, ebTrue, ebFalse);

     function IsNull: boolean; inline;
     function Defined: boolean; inline;

     class operator Implicit ( from: boolean ): TExtBoolean; inline;
     class operator Implicit ( from: TExtBoolean ): boolean; 
     class operator LogicalAnd( Value1, Value2: TExtBoolean ):   TExtBoolean; 
     class operator LogicalAnd( Value1: TExtBoolean; Value2: boolean):  TExtBoolean; inline;
     class operator LogicalAnd( Value1: boolean; Value2: TExtBoolean ):   TExtBoolean; 
....
  end;

const Unknown: TExtBoolean = (Value: ebUnknown); 

...
var v1: TExtBoolean;
    v1 := False; 
    v1 := True;
    v1 := Unknown;
...

class operator TExtBoolean.Implicit ( from: boolean ): TExtBoolean; 
begin
  if from
     then Result.Value := ebTrue
     else Result.Value := ebFalse
end;

class operator TExtBoolean.Implicit ( from: TExtBoolean ): Boolean; 
begin
  case from.Value of
    ebTrue: Result := True;
    ebFalse: Result := False;  
    else raise EConvertError.Create('....');
end;


function TExtBoolean.Defined: boolean; 
begin
  Result := (Self.Value = ebTrue) or (Self.Value = ebFalse);
end;

// this implementation detects values other than ebTrue/ebFalse/ebUnkonwn
// that might appear in reality due to non-initialized memory garbage 
// since hardware type of Value is byte and may be equal to 3, 4, ...255
function TExtBoolean.IsNull: boolean; 
begin
  Result := not Self.Defined
end;

class operator TExtBoolean.And( Value1, Value2: TExtBoolean ): TExtBoolean; 
begin
  if Value1.IsNull or Value2.IsNull
     then Result.Value := eb.Undefined
     else Result := boolean(Value1) and boolean(Value2);
// Or, sacrificing readability and safety for the sake of speed
// and removing duplicate IsNull checks
//   else Result := (Value1.Value = ebTrue) and (Value2.Value = ebTrue);
end;

class operator TExtBoolean.LogicalAnd( Value1, TExtBoolean; Value2: boolean):  TExtBoolean;
begin
  Result := Value2 and Value1;
end;

class operator TExtBoolean.LogicalAnd( Value1: boolean; Value2: TExtBoolean ):   TExtBoolean; 
begin
  if Value2.IsNull
     then Result := Value2
     else Result := Value1 and (Value2.Value = ebTrue);
// or if to accept a duplicate redundant check for readability sake
//   and to avert potential later erros (refactoring, you may accidentally remove the check above)
//    else Result := Value1 and boolean (Value2);
end;

etc

PS. The check for being unspecified above is intentionally made pessimistic, tending to err on bad side. It is the defense against non-initialized variables and possible future changes, adding more states than three. While thise might seems to be over-protecting, at least Delphi XE2 is agreeing with mee: see the warning in a similar case:

program Project20;  {$APPTYPE CONSOLE}
uses System.SysUtils;

type enum = (e1, e2, e3);
var e: enum;

function name( e: enum ): char;
begin
  case e of
    e1: Result := 'A';
    e2: Result := 'B';
    e3: Result := 'C';
  end;
end;

// [DCC Warning] Project20.dpr: W1035 Return value of function 'name' might be undefined

begin
  for e := e1 to e3
      do Writeln(name(e));
  ReadLn;
end.
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top