From f4b5882080c8c05c6972d7007c7c4d773593324c Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Thu, 28 Aug 2025 12:30:13 +0200 Subject: [PATCH] Scalar 64bit decimal type --- Src/AST/TestAst.pas | 3 +- Src/Data/Myc.Data.Decimal.pas | 219 +++++++++++++++++++++++++++++++++ Src/Data/Myc.Data.POD.pas | 65 ++++++++++ Test/MycTests.dpr | 6 +- Test/MycTests.dproj | 10 +- Test/TestDataDecimal.pas | 224 ++++++++++++++++++++++++++++++++++ 6 files changed, 523 insertions(+), 4 deletions(-) create mode 100644 Src/Data/Myc.Data.Decimal.pas create mode 100644 Src/Data/Myc.Data.POD.pas create mode 100644 Test/TestDataDecimal.pas diff --git a/Src/AST/TestAst.pas b/Src/AST/TestAst.pas index 97a6100..bffb136 100644 --- a/Src/AST/TestAst.pas +++ b/Src/AST/TestAst.pas @@ -1,9 +1,10 @@ -unit TestAst; +unit TestAst deprecated; interface uses Myc.Ast, + Myc.Ast.Evaluator, DUnitX.TestFramework; type diff --git a/Src/Data/Myc.Data.Decimal.pas b/Src/Data/Myc.Data.Decimal.pas new file mode 100644 index 0000000..77d3163 --- /dev/null +++ b/Src/Data/Myc.Data.Decimal.pas @@ -0,0 +1,219 @@ +unit Myc.Data.Decimal; + +interface + +{$H+} + +type + TScale = 0..7; + + TDecimal64 = record + strict private + FValue: Int64; + public + constructor Create(AValue: Int64; AScale: TScale); overload; + constructor Create(const AValue: TDecimal64; ANewScale: TScale); overload; + + class operator Add(const A, B: TDecimal64): TDecimal64; + class operator Subtract(const A, B: TDecimal64): TDecimal64; + class operator Multiply(const A, B: TDecimal64): TDecimal64; + class operator Divide(const A, B: TDecimal64): TDecimal64; + + class operator Equal(const A, B: TDecimal64): Boolean; + class operator NotEqual(const A, B: TDecimal64): Boolean; + + class operator Implicit(const A: Int64): TDecimal64; + class operator Explicit(const A: TDecimal64): Int64; + class operator Explicit(const A: TDecimal64): Double; + + class function MinValue(AScale: TScale): TDecimal64; static; + class function MaxValue(AScale: TScale): TDecimal64; static; + + function GetValue: Int64; + function GetScale: TScale; + function GetRawValue: Int64; inline; + end; + +implementation + +uses + System.SysUtils, + System.Math; + +const + SCALE_BITS = 3; + VALUE_BITS = 61; + SCALE_MASK = $07; + + // Range of the 61-bit signed value part + MIN_VALUE_61BIT = -(1 shl 60); + MAX_VALUE_61BIT = (1 shl 60) - 1; + + // Use a lookup table for powers of 10 for performance + PowersOf10: array[TScale] of Int64 = (1, 10, 100, 1000, 10000, 100000, 1000000, 10000000); + +{ TDecimal64 } + +constructor TDecimal64.Create(AValue: Int64; AScale: TScale); +begin + FValue := (Int64(AScale) shl VALUE_BITS) or (AValue and ((1 shl VALUE_BITS) - 1)); +end; + +constructor TDecimal64.Create(const AValue: TDecimal64; ANewScale: TScale); +var + oldScale: TScale; + newValue: Int64; + scaleDiff: Integer; + i: Integer; +begin + // Create a new decimal by changing the scale of an existing one. + oldScale := AValue.GetScale; + newValue := AValue.GetValue; + + if oldScale = ANewScale then + begin + FValue := AValue.FValue; + exit; + end; + + scaleDiff := ANewScale - oldScale; + if scaleDiff > 0 then + begin + // Increasing scale: multiply by 10^scaleDiff, checking for overflow at each step. + for i := 1 to scaleDiff do + begin + if newValue > (MAX_VALUE_61BIT div 10) then + raise EOverflow.Create('Decimal scale up resulted in an overflow.'); + if newValue < (MIN_VALUE_61BIT div 10) then + raise EOverflow.Create('Decimal scale up resulted in an overflow.'); + newValue := newValue * 10; + end; + end + else + begin + // Decreasing scale: divide by 10^(-scaleDiff). Overflow is not an issue here. + newValue := newValue div PowersOf10[-scaleDiff]; + end; + + // Pack the new value and scale + FValue := (Int64(ANewScale) shl VALUE_BITS) or (newValue and ((1 shl VALUE_BITS) - 1)); +end; + +class operator TDecimal64.Add(const A, B: TDecimal64): TDecimal64; +var + scale: TScale; + resultValue: Int64; +begin + scale := A.GetScale; + if scale <> B.GetScale then + raise EArgumentException.Create('Operands must have the same scale.'); + + resultValue := A.GetValue + B.GetValue; + Result := TDecimal64.Create(resultValue, A.GetScale); +end; + +class operator TDecimal64.Subtract(const A, B: TDecimal64): TDecimal64; +var + scale: TScale; + resultValue: Int64; +begin + scale := A.GetScale; + if scale <> B.GetScale then + raise EArgumentException.Create('Operands must have the same scale.'); + + resultValue := A.GetValue - B.GetValue; + Result := TDecimal64.Create(resultValue, scale); +end; + +class operator TDecimal64.Multiply(const A, B: TDecimal64): TDecimal64; +var + scale: TScale; + resultValue: Int64; +begin + scale := A.GetScale; + if scale <> B.GetScale then + raise EArgumentException.Create('Operands must have the same scale.'); + + resultValue := Trunc(A.GetValue * B.GetValue / PowersOf10[scale]); + Result := TDecimal64.Create(resultValue, scale); +end; + +class operator TDecimal64.Divide(const A, B: TDecimal64): TDecimal64; +var + scale: TScale; + resultValue: Int64; +begin + scale := A.GetScale; + if scale <> B.GetScale then + raise EArgumentException.Create('Operands must have the same scale.'); + + if B.GetValue = 0 then + raise EDivByZero.Create('Division by zero'); + + // Correctly scale the dividend to preserve precision + resultValue := Trunc(A.GetValue * PowersOf10[scale] / B.GetValue); + Result := TDecimal64.Create(resultValue, scale); +end; + +class operator TDecimal64.Equal(const A, B: TDecimal64): Boolean; +begin + if A.GetScale <> B.GetScale then + Result := False + else + Result := (A.GetValue = B.GetValue); +end; + +class operator TDecimal64.NotEqual(const A, B: TDecimal64): Boolean; +begin + Result := not (A = B); +end; + +class operator TDecimal64.Implicit(const A: Int64): TDecimal64; +begin + // Correctly create a TDecimal64 with scale 0 + Result := TDecimal64.Create(A, 0); +end; + +class operator TDecimal64.Explicit(const A: TDecimal64): Int64; +begin + Result := A.GetValue; +end; + +class operator TDecimal64.Explicit(const A: TDecimal64): Double; +begin + Result := A.GetValue / PowersOf10[A.GetScale]; +end; + +class function TDecimal64.MaxValue(AScale: TScale): TDecimal64; +begin + Result := TDecimal64.Create(MAX_VALUE_61BIT, AScale); +end; + +class function TDecimal64.MinValue(AScale: TScale): TDecimal64; +begin + Result := TDecimal64.Create(MIN_VALUE_61BIT, AScale); +end; + +function TDecimal64.GetValue: Int64; +var + value: Int64; +begin + value := FValue and ((1 shl VALUE_BITS) - 1); + // Perform sign extension from 61 to 64 bits + if (value and (1 shl (VALUE_BITS - 1))) <> 0 then + Result := value or (not ((1 shl VALUE_BITS) - 1)) + else + Result := value; +end; + +function TDecimal64.GetScale: TScale; +begin + Result := TScale((FValue shr VALUE_BITS) and SCALE_MASK); +end; + +function TDecimal64.GetRawValue: Int64; +begin + Result := FValue; +end; + +end. diff --git a/Src/Data/Myc.Data.POD.pas b/Src/Data/Myc.Data.POD.pas new file mode 100644 index 0000000..df7bcdc --- /dev/null +++ b/Src/Data/Myc.Data.POD.pas @@ -0,0 +1,65 @@ +unit Myc.Data.POD; + +interface + +uses + Myc.Data.Series; + +type + // POD: Plain old data (that fits into a 64 bit register) + + TScalarKind = (skInteger, skInt64, skUInt64, skSingle, skDouble, skTimestamp, skBoolean, skChar, skString, skBytes); + + TScalarValue = record + case TScalarKind of + skInteger: (AsInteger: Integer); + skInt64: (AsInt64: Int64); + skUInt64: (AsUInt64: UInt64); + skSingle: (AsSingle: Single); + skDouble: (AsDouble: Double); + skTimestamp: (AsTimeStamp: TDateTime); + skBoolean: (AsBoolean: Boolean); + skChar: (AsChar: Char); + skString: (AsString: String[15]); + skBytes: (AsBytes: array[0..15] of Byte); + end; + + TScalar = record + Kind: TScalarKind; + Value: TScalarValue; + end; + + // Basic data structures using the scalar type (these ar not POD of course) + + TScalarArray = record + Kind: TScalarKind; + Items: TArray; + end; + + TScalarTuple = TArray; + + TScalarRecordField = record + Name: String; + Kind: TScalarKind; + end; + + TScalarRecordDefinition = record + Fields: TArray; + end; + + TScalarRecord = record + Def: TScalarRecordDefinition; + Fields: TArray; + end; + + TScalarSeries = record + Kind: TScalarKind; + Items: TSeries; + end; + +implementation + +initialization + Assert(sizeof(TScalarValue) = 16); + +end. diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index 405e360..68a1531 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -35,9 +35,11 @@ uses Myc.Data.Types.Void in '..\Src\Data\Myc.Data.Types.Void.pas', Myc.Data.Types.Decimal in '..\Src\Data\Myc.Data.Types.Decimal.pas', Myc.Ast in '..\Src\AST\Myc.Ast.pas', - TestAst in '..\Src\AST\TestAst.pas', Myc.Data.Types.JSON in '..\Src\Data\Myc.Data.Types.JSON.pas', - TestDataTypes.JSON in '..\Src\Data\TestDataTypes.JSON.pas'; + TestDataTypes.JSON in '..\Src\Data\TestDataTypes.JSON.pas', + Myc.Data.POD in '..\Src\Data\Myc.Data.POD.pas', + Myc.Data.Decimal in '..\Src\Data\Myc.Data.Decimal.pas', + TestDataDecimal in 'TestDataDecimal.pas'; { keep comment here to protect the following conditional from being removed by the IDE when adding a unit } {$IFNDEF TESTINSIGHT} diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index 90efcd5..1b372ce 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -136,9 +136,11 @@ $(PreBuildEvent)]]> - + + + Base @@ -182,6 +184,12 @@ $(PreBuildEvent)]]> true + + + .\ + true + + MycTests.exe diff --git a/Test/TestDataDecimal.pas b/Test/TestDataDecimal.pas new file mode 100644 index 0000000..e861c2b --- /dev/null +++ b/Test/TestDataDecimal.pas @@ -0,0 +1,224 @@ +unit TestDataDecimal; + +interface + +uses + Myc.Data.Decimal, + DUnitX.TestFramework; + +type + [TestFixture] + TTestDecimal = class + public + [TestCase('Positive Numbers Add', '100,0,200,0,300,0')] + [TestCase('Negative Numbers Add', '-100,0,-200,0,-300,0')] + [TestCase('Mixed Numbers Add', '-100,0,200,0,100,0')] + [TestCase('Zero Add', '0,0,0,0,0,0')] + [Test] + procedure TestAdd(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64); + + [TestCase('Positive Numbers Subtract', '300,0,200,0,100,0')] + [TestCase('Negative Numbers Subtract', '-300,0,-200,0,-100,0')] + [TestCase('Mixed Numbers Subtract', '100,0,200,0,-100,0')] + [TestCase('Zero Subtract', '0,0,0,0,0,0')] + [Test] + procedure TestSubtract(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64); + + [TestCase('Positive Numbers Multiply', '10,1,20,1,20,1')] + [TestCase('Negative Numbers Multiply', '-10,1,-20,1,20,1')] + [TestCase('Mixed Numbers Multiply', '-10,1,20,1,-20,1')] + [TestCase('Zero Multiply', '10,1,0,1,0,1')] + [Test] + procedure TestMultiply(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64); + + [TestCase('Positive Numbers Divide', '400,2,20,2,2000,2')] + [TestCase('Negative Numbers Divide', '-400,2,-20,2,2000,2')] + [TestCase('Mixed Numbers Divide', '-400,2,20,2,-2000,2')] + [TestCase('Zero Divide', '0,2,20,2,0,2')] + [Test] + procedure TestDivide(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64); + + [TestCase('Equality', '100,1,100,1')] + [Test] + procedure TestEqual(const AValue1, AScale1, AValue2, AScale2: Int64); + + [TestCase('Inequality', '100,1,200,1')] + [TestCase('Inequality Different Scale', '100,1,100,2')] + [Test] + procedure TestNotEqual(const AValue1, AScale1, AValue2, AScale2: Int64); + + [Test] + procedure TestImplicitConversion; + + [Test] + procedure TestExplicitConversionToInt64; + + [Test] + procedure TestExplicitConversionToDouble; + + [TestCase('Scale 0', '0')] + [TestCase('Scale 4', '4')] + [TestCase('Scale 7 (Max)', '7')] + [Test] + procedure TestMinMaxValues(AScaleValue: Integer); + + [TestCase('Upscale', '12345,2,4,1234500')] + [TestCase('Downscale (truncation)', '1234567,4,2,12345')] + [TestCase('Same Scale', '-555,3,3,-555')] + [TestCase('Upscale Negative', '-987,1,3,-98700')] + [Test] + procedure TestRescaleConstructor(AValue, AScale, ANewScale, AExpectedValue: Int64); + + [Test] + procedure TestRescaleOverflow; + end; + +implementation + +uses + System.SysUtils; + +const + // Expected boundary values for a 61-bit signed integer + MIN_VALUE_61BIT: Int64 = -(1 shl 60); + MAX_VALUE_61BIT: Int64 = (1 shl 60) - 1; + +{ TTestDecimal } + +procedure TTestDecimal.TestAdd(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64); +var + d1, d2, d3: TDecimal64; +begin + d1 := TDecimal64.Create(AValue1, TScale(AScale1)); + d2 := TDecimal64.Create(AValue2, TScale(AScale2)); + d3 := d1 + d2; + Assert.AreEqual(d3.GetValue, AResultValue, 'Value mismatch'); + Assert.AreEqual(d3.GetScale, TScale(AResultScale), 'Scale mismatch'); +end; + +procedure TTestDecimal.TestSubtract(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64); +var + d1, d2, d3: TDecimal64; +begin + d1 := TDecimal64.Create(AValue1, TScale(AScale1)); + d2 := TDecimal64.Create(AValue2, TScale(AScale2)); + d3 := d1 - d2; + Assert.AreEqual(d3.GetValue, AResultValue, 'Value mismatch'); + Assert.AreEqual(d3.GetScale, TScale(AResultScale), 'Scale mismatch'); +end; + +procedure TTestDecimal.TestMultiply(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64); +var + d1, d2, d3: TDecimal64; +begin + d1 := TDecimal64.Create(AValue1, TScale(AScale1)); + d2 := TDecimal64.Create(AValue2, TScale(AScale2)); + d3 := d1 * d2; + Assert.AreEqual(d3.GetValue, AResultValue, 'Value mismatch'); + Assert.AreEqual(d3.GetScale, TScale(AResultScale), 'Scale mismatch'); +end; + +procedure TTestDecimal.TestDivide(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64); +var + d1, d2, d3: TDecimal64; +begin + d1 := TDecimal64.Create(AValue1, TScale(AScale1)); + d2 := TDecimal64.Create(AValue2, TScale(AScale2)); + d3 := d1 / d2; + Assert.AreEqual(d3.GetValue, AResultValue, 'Value mismatch'); + Assert.AreEqual(d3.GetScale, TScale(AResultScale), 'Scale mismatch'); +end; + +procedure TTestDecimal.TestEqual(const AValue1, AScale1, AValue2, AScale2: Int64); +var + d1, d2: TDecimal64; +begin + d1 := TDecimal64.Create(AValue1, TScale(AScale1)); + d2 := TDecimal64.Create(AValue2, TScale(AScale2)); + Assert.IsTrue(d1 = d2, 'Values should be equal'); +end; + +procedure TTestDecimal.TestNotEqual(const AValue1, AScale1, AValue2, AScale2: Int64); +var + d1, d2: TDecimal64; +begin + d1 := TDecimal64.Create(AValue1, TScale(AScale1)); + d2 := TDecimal64.Create(AValue2, TScale(AScale2)); + Assert.IsFalse(d1 = d2, 'Values should not be equal'); +end; + +procedure TTestDecimal.TestImplicitConversion; +var + intValue: Int64; + decimalValue: TDecimal64; +begin + intValue := 12345; + decimalValue := intValue; + Assert.AreEqual(decimalValue.GetValue, intValue, 'Implicit conversion from Int64 failed'); + Assert.AreEqual(decimalValue.GetScale, TScale(0), 'Implicit conversion should have scale 0'); +end; + +procedure TTestDecimal.TestExplicitConversionToInt64; +var + decimalValue: TDecimal64; + intValue: Int64; +begin + decimalValue := TDecimal64.Create(98765, TScale(3)); + intValue := Int64(decimalValue); + Assert.AreEqual(intValue, Int64(98765), 'Explicit conversion to Int64 failed'); +end; + +procedure TTestDecimal.TestExplicitConversionToDouble; +var + decimalValue: TDecimal64; + doubleValue: Double; +begin + decimalValue := TDecimal64.Create(12345, TScale(3)); + doubleValue := Double(decimalValue); + Assert.AreEqual(doubleValue, 12.345, 0.000001, 'Explicit conversion to Double failed'); +end; + +procedure TTestDecimal.TestMinMaxValues(AScaleValue: Integer); +var + minDec, maxDec: TDecimal64; + scale: TScale; +begin + scale := TScale(AScaleValue); + + // Test MaxValue + maxDec := TDecimal64.MaxValue(scale); + Assert.AreEqual(scale, maxDec.GetScale, 'MaxValue scale mismatch'); + Assert.AreEqual(MAX_VALUE_61BIT, maxDec.GetValue, 'MaxValue value mismatch'); + + // Test MinValue + minDec := TDecimal64.MinValue(scale); + Assert.AreEqual(scale, minDec.GetScale, 'MinValue scale mismatch'); + Assert.AreEqual(MIN_VALUE_61BIT, minDec.GetValue, 'MinValue value mismatch'); +end; + +procedure TTestDecimal.TestRescaleConstructor(AValue, AScale, ANewScale, AExpectedValue: Int64); +var + d1, d2: TDecimal64; +begin + d1 := TDecimal64.Create(AValue, TScale(AScale)); + d2 := TDecimal64.Create(d1, TScale(ANewScale)); + + Assert.AreEqual(TScale(ANewScale), d2.GetScale, 'New scale was not set correctly.'); + Assert.AreEqual(AExpectedValue, d2.GetValue, 'Rescaled value is incorrect.'); +end; + +procedure TTestDecimal.TestRescaleOverflow; +var + d1: TDecimal64; +begin + // Create a value that is just over the overflow threshold for a multiplication by 10 + d1 := TDecimal64.Create((MAX_VALUE_61BIT div 10) + 1, 0); + + // Expect an EOverflow when scaling up from 0 to 1 + Assert.WillRaise(procedure begin TDecimal64.Create(d1, 1); end, EOverflow, 'EOverflow was expected on rescale.'); +end; + +initialization + TDUnitX.RegisterTestFixture(TTestDecimal); + +end.