forked from MagicFoundation/Alcinoe
-
Notifications
You must be signed in to change notification settings - Fork 0
/
ALExprEval.pas
4571 lines (4006 loc) · 141 KB
/
ALExprEval.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{*************************************************************
Author(s): Jedi Project - JCL
Barry Kelly
Matthias Thoma (mthoma)
Petr Vones (pvones)
Robert Marquardt (marquardt)
Robert Rossmair (rrossmair)
product: Alcinoe Expression Evaluator
Description: This unit contains expression evaluators, each tailored for different usage
patterns. It also contains the component objects, so that a customized
expression evaluator can be assembled relatively easily.
Note : operator priority (as implemented in this unit)
all binary operators are associated from left to right
all unary operators are associated from right to left
(highest) not bnot(bitwise) +(unary) -(unary) (level 3)
* / div mod and band(bitwise) shl shr in (level 2)
+(binary) -(binary) or xor bor(bitwise) bxor(bitwise) (level 1)
(lowest) < <= > >= cmp = <> (level 0)
details on cmp operator:
"1.5 cmp 2.0" returns -1.0 because 1.5 < 2.0
"1.5 cmp 1.5" returns 0.0 because 1.5 = 1.5
"1.5 cmp 0.0" returns 1.0 because 1.5 > 0.0
**************************************************************}
unit ALExprEval;
interface
{$IF CompilerVersion >= 25} {Delphi XE4}
{$LEGACYIFEND ON} // http://docwiki.embarcadero.com/RADStudio/XE4/en/Legacy_IFEND_(Delphi)
{$IFEND}
uses System.SysUtils,
System.Classes,
ALStringList;
type
EALExprEvalError = class(Exception);
type
ALFloat = Extended;
PALFloat = ^ALFloat;
TALFloat = ALFloat;
TALFloat32 = Single;
PALFloat32 = ^TALFloat32;
TALFloat64 = Double;
PALFloat64 = ^TALFloat64;
TALFloat80 = Extended;
PALFloat80 = ^TALFloat80;
TALFloatFunc = function: TALFloat;
TALFloat32Func = function: TALFloat32;
TALFloat64Func = function: TALFloat64;
TALFloat80Func = function: TALFloat80;
TALUnaryFunc = function(X: TALFloat): TALFloat;
TALUnary32Func = function(X: TALFloat32): TALFloat32;
TALUnary64Func = function(X: TALFloat64): TALFloat64;
TALUnary80Func = function(X: TALFloat80): TALFloat80;
TALBinaryFunc = function(X, Y: TALFloat): TALFloat;
TALBinary32Func = function(X, Y: TALFloat32): TALFloat32;
TALBinary64Func = function(X, Y: TALFloat64): TALFloat64;
TALBinary80Func = function(X, Y: TALFloat80): TALFloat80;
TALTernaryFunc = function(X, Y, Z: TALFloat): TALFloat;
TALTernary32Func = function(X, Y, Z: TALFloat32): TALFloat32;
TALTernary64Func = function(X, Y, Z: TALFloat64): TALFloat64;
TALTernary80Func = function(X, Y, Z: TALFloat80): TALFloat80;
type
{ Forward Declarations }
TALExprLexer = class;
TALExprCompileParser = class;
TALExprEvalParser = class;
TALExprSym = class;
TALExprNode = class;
TALExprNodeFactory = class;
TALExprContext = class(TObject)
public
function Find(const AName: AnsiString): TALExprSym; virtual; abstract;
end;
TALExprHashContext = class(TALExprContext)
private
FHashMap: TALAVLStringList;
public
constructor Create(ACaseSensitive: Boolean = False);
destructor Destroy; override;
procedure Add(ASymbol: TALExprSym);
procedure Remove(const AName: AnsiString);
function Find(const AName: AnsiString): TALExprSym; override;
end;
TALExprSetContext = class(TALExprContext)
private
FList: TList;
FOwnsContexts: Boolean;
function GetContexts(AIndex: Integer): TALExprContext;
function GetCount: Integer;
public
constructor Create(AOwnsContexts: Boolean);
destructor Destroy; override;
procedure Add(AContext: TALExprContext);
procedure Remove(AContext: TALExprContext);
procedure Delete(AIndex: Integer);
function Extract(AContext: TALExprContext): TALExprContext;
property Count: Integer read GetCount;
property Contexts[AIndex: Integer]: TALExprContext read GetContexts;
property InternalList: TList read FList;
function Find(const AName: AnsiString): TALExprSym; override;
end;
TALExprSym = class(TObject)
private
FIdent: AnsiString;
FLexer: TALExprLexer;
FEvalParser: TALExprEvalParser;
FCompileParser: TALExprCompileParser;
FNodeFactory: TALExprNodeFactory;
public
constructor Create(const AIdent: AnsiString);
function Evaluate: TALFloat; virtual; abstract;
function Compile: TALExprNode; virtual; abstract;
property Ident: AnsiString read FIdent;
property Lexer: TALExprLexer read FLexer write FLexer;
property CompileParser: TALExprCompileParser read FCompileParser
write FCompileParser;
property EvalParser: TALExprEvalParser read FEvalParser write FEvalParser;
property NodeFactory: TALExprNodeFactory read FNodeFactory write FNodeFactory;
end;
TALExprToken = (
// specials
etEof,
etNumber,
etIdentifier,
// user extension tokens
etUser0, etUser1, etUser2, etUser3, etUser4, etUser5, etUser6, etUser7,
etUser8, etUser9, etUser10, etUser11, etUser12, etUser13, etUser14, etUser15,
etUser16, etUser17, etUser18, etUser19, etUser20, etUser21, etUser22, etUser23,
etUser24, etUser25, etUser26, etUser27, etUser28, etUser29, etUser30, etUser31,
// compound tokens
etNotEqual, // <>
etLessEqual, // <=
etGreaterEqual, // >=
// ASCII normal & ordinals
etBang, // '!' #$21 33
etDoubleQuote, // '"' #$22 34
etHash, // '#' #$23 35
etDollar, // '$' #$24 36
etPercent, // '%' #$25 37
etAmpersand, // '&' #$26 38
etSingleQuote, // '''' #$27 39
etLParen, // '(' #$28 40
etRParen, // ')' #$29 41
etAsterisk, // '*' #$2A 42
etPlus, // '+' #$2B 43
etComma, // ',' #$2C 44
etMinus, // '-' #$2D 45
etDot, // '.' #$2E 46
etForwardSlash, // '/' #$2F 47
// 48..57 - numbers...
etColon, // ':' #$3A 58
etSemiColon, // ';' #$3B 59
etLessThan, // '<' #$3C 60
etEqualTo, // '=' #$3D 61
etGreaterThan, // '>' #$3E 62
etQuestion, // '?' #$3F 63
etAt, // '@' #$40 64
// 65..90 - capital letters...
etLBracket, // '[' #$5B 91
etBackSlash, // '\' #$5C 92
etRBracket, // ']' #$5D 93
etArrow, // '^' #$5E 94
// 95 - underscore
etBackTick, // '`' #$60 96
// 97..122 - small letters...
etLBrace, // '{' #$7B 123
etPipe, // '|' #$7C 124
etRBrace, // '}' #$7D 125
etTilde, // '~' #$7E 126
et127, // '' #$7F 127
etEuro, // '€' #$80 128
et129, // '' #$81 129
et130, // '‚' #$82 130
et131, // 'ƒ' #$83 131
et132, // '„' #$84 132
et133, // '…' #$85 133
et134, // '†' #$86 134
et135, // '‡' #$87 135
et136, // 'ˆ' #$88 136
et137, // '‰' #$89 137
et138, // 'Š' #$8A 138
et139, // '‹' #$8B 139
et140, // 'Œ' #$8C 140
et141, // '' #$8D 141
et142, // 'Ž' #$8E 142
et143, // '' #$8F 143
et144, // '' #$90 144
et145, // '‘' #$91 145
et146, // '’' #$92 146
et147, // '“' #$93 147
et148, // '”' #$94 148
et149, // '•' #$95 149
et150, // '–' #$96 150
et151, // '—' #$97 151
et152, // '˜' #$98 152
et153, // '™' #$99 153
et154, // 'š' #$9A 154
et155, // '›' #$9B 155
et156, // 'œ' #$9C 156
et157, // '' #$9D 157
et158, // 'ž' #$9E 158
et159, // 'Ÿ' #$9F 159
et160, // ' ' #$A0 160
et161, // '¡' #$A1 161
et162, // '¢' #$A2 162
et163, // '£' #$A3 163
et164, // '¤' #$A4 164
et165, // '¥' #$A5 165
et166, // '¦' #$A6 166
et167, // '§' #$A7 167
et168, // '¨' #$A8 168
et169, // '©' #$A9 169
et170, // 'ª' #$AA 170
et171, // '«' #$AB 171
et172, // '¬' #$AC 172
et173, // '' #$AD 173
et174, // '®' #$AE 174
et175, // '¯' #$AF 175
et176, // '°' #$B0 176
et177, // '±' #$B1 177
et178, // '²' #$B2 178
et179, // '³' #$B3 179
et180, // '´' #$B4 180
et181, // 'µ' #$B5 181
et182, // '¶' #$B6 182
et183, // '·' #$B7 183
et184, // '¸' #$B8 184
et185, // '¹' #$B9 185
et186, // 'º' #$BA 186
et187, // '»' #$BB 187
et188, // '¼' #$BC 188
et189, // '½' #$BD 189
et190, // '¾' #$BE 190
et191, // '¿' #$BF 191
et192, // 'À' #$C0 192
et193, // 'Á' #$C1 193
et194, // 'Â' #$C2 194
et195, // 'Ã' #$C3 195
et196, // 'Ä' #$C4 196
et197, // 'Å' #$C5 197
et198, // 'Æ' #$C6 198
et199, // 'Ç' #$C7 199
et200, // 'È' #$C8 200
et201, // 'É' #$C9 201
et202, // 'Ê' #$CA 202
et203, // 'Ë' #$CB 203
et204, // 'Ì' #$CC 204
et205, // 'Í' #$CD 205
et206, // 'Î' #$CE 206
et207, // 'Ï' #$CF 207
et208, // 'Ð' #$D0 208
et209, // 'Ñ' #$D1 209
et210, // 'Ò' #$D2 210
et211, // 'Ó' #$D3 211
et212, // 'Ô' #$D4 212
et213, // 'Õ' #$D5 213
et214, // 'Ö' #$D6 214
et215, // '×' #$D7 215
et216, // 'Ø' #$D8 216
et217, // 'Ù' #$D9 217
et218, // 'Ú' #$DA 218
et219, // 'Û' #$DB 219
et220, // 'Ü' #$DC 220
et221, // 'Ý' #$DD 221
et222, // 'Þ' #$DE 222
et223, // 'ß' #$DF 223
et224, // 'à' #$E0 224
et225, // 'á' #$E1 225
et226, // 'â' #$E2 226
et227, // 'ã' #$E3 227
et228, // 'ä' #$E4 228
et229, // 'å' #$E5 229
et230, // 'æ' #$E6 230
et231, // 'ç' #$E7 231
et232, // 'è' #$E8 232
et233, // 'é' #$E9 233
et234, // 'ê' #$EA 234
et235, // 'ë' #$EB 235
et236, // 'ì' #$EC 236
et237, // 'í' #$ED 237
et238, // 'î' #$EE 238
et239, // 'ï' #$EF 239
et240, // 'ð' #$F0 240
et241, // 'ñ' #$F1 241
et242, // 'ò' #$F2 242
et243, // 'ó' #$F3 243
et244, // 'ô' #$F4 244
et245, // 'õ' #$F5 245
et246, // 'ö' #$F6 246
et247, // '÷' #$F7 247
et248, // 'ø' #$F8 248
et249, // 'ù' #$F9 249
et250, // 'ú' #$FA 250
et251, // 'û' #$FB 251
et252, // 'ü' #$FC 252
et253, // 'ý' #$FD 253
et254, // 'þ' #$FE 254
et255, // 'ÿ' #$FF 255
etInvalid // invalid token type
);
TALExprLexer = class(TObject)
protected
FCurrTok: TALExprToken;
FTokenAsNumber: TALFloat;
FTokenAsString: AnsiString;
public
constructor Create;
procedure NextTok(const EvalTok: Boolean = True); virtual; abstract;
procedure Reset; virtual;
property TokenAsString: AnsiString read FTokenAsString;
property TokenAsNumber: TALFloat read FTokenAsNumber;
property CurrTok: TALExprToken read FCurrTok;
end;
TALExprNode = class(TObject)
private
FDepList: TList;
function GetDepCount: Integer;
function GetDeps(AIndex: Integer): TALExprNode;
public
constructor Create(const ADepList: array of TALExprNode);
destructor Destroy; override;
procedure AddDep(ADep: TALExprNode);
property DepCount: Integer read GetDepCount;
property Deps[AIndex: Integer]: TALExprNode read GetDeps; default;
property DepList: TList read FDepList;
end;
TALExprNodeFactory = class(TObject)
public
function LoadVar32(ALoc: PALFloat32): TALExprNode; virtual; abstract;
function LoadVar64(ALoc: PALFloat64): TALExprNode; virtual; abstract;
function LoadVar80(ALoc: PALFloat80): TALExprNode; virtual; abstract;
function LoadConst32(AValue: TALFloat32): TALExprNode; virtual; abstract;
function LoadConst64(AValue: TALFloat64): TALExprNode; virtual; abstract;
function LoadConst80(AValue: TALFloat80): TALExprNode; virtual; abstract;
function CallFloatFunc(AFunc: TALFloatFunc): TALExprNode; virtual; abstract;
function CallFloat32Func(AFunc: TALFloat32Func): TALExprNode; virtual; abstract;
function CallFloat64Func(AFunc: TALFloat64Func): TALExprNode; virtual; abstract;
function CallFloat80Func(AFunc: TALFloat80Func): TALExprNode; virtual; abstract;
function CallUnaryFunc(AFunc: TALUnaryFunc; X: TALExprNode): TALExprNode; virtual; abstract;
function CallUnary32Func(AFunc: TALUnary32Func; X: TALExprNode): TALExprNode; virtual; abstract;
function CallUnary64Func(AFunc: TALUnary64Func; X: TALExprNode): TALExprNode; virtual; abstract;
function CallUnary80Func(AFunc: TALUnary80Func; X: TALExprNode): TALExprNode; virtual; abstract;
function CallBinaryFunc(AFunc: TALBinaryFunc; X, Y: TALExprNode): TALExprNode; virtual; abstract;
function CallBinary32Func(AFunc: TALBinary32Func; X, Y: TALExprNode): TALExprNode; virtual; abstract;
function CallBinary64Func(AFunc: TALBinary64Func; X, Y: TALExprNode): TALExprNode; virtual; abstract;
function CallBinary80Func(AFunc: TALBinary80Func; X, Y: TALExprNode): TALExprNode; virtual; abstract;
function CallTernaryFunc(AFunc: TALTernaryFunc; X, Y, Z: TALExprNode): TALExprNode; virtual; abstract;
function CallTernary32Func(AFunc: TALTernary32Func; X, Y, Z: TALExprNode): TALExprNode; virtual; abstract;
function CallTernary64Func(AFunc: TALTernary64Func; X, Y, Z: TALExprNode): TALExprNode; virtual; abstract;
function CallTernary80Func(AFunc: TALTernary80Func; X, Y, Z: TALExprNode): TALExprNode; virtual; abstract;
function Add(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function Subtract(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function Multiply(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function Divide(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function IntegerDivide(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function Modulo(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function Negate(AValue: TALExprNode): TALExprNode; virtual; abstract;
function Compare(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function CompareEqual(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function CompareNotEqual(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function CompareLess(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function CompareLessEqual(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function CompareGreater(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function CompareGreaterEqual(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function LogicalAnd(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function LogicalOr(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function LogicalXor(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function LogicalNot(AValue: TALExprNode): TALExprNode; virtual; abstract;
function BitwiseAnd(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function BitwiseOr(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function BitwiseXor(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function BitwiseNot(AValue: TALExprNode): TALExprNode; virtual; abstract;
function ShiftLeft(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function ShiftRight(ALeft, ARight: TALExprNode): TALExprNode; virtual; abstract;
function LoadVar(ALoc: PALFloat32): TALExprNode; overload;
function LoadVar(ALoc: PALFloat64): TALExprNode; overload;
function LoadVar(ALoc: PALFloat80): TALExprNode; overload;
function LoadConst(AValue: TALFloat32): TALExprNode; overload;
function LoadConst(AValue: TALFloat64): TALExprNode; overload;
function LoadConst(AValue: TALFloat80): TALExprNode; overload;
end;
TALExprCompileParser = class(TObject)
private
FContext: TALExprContext;
FLexer: TALExprLexer;
FNodeFactory: TALExprNodeFactory;
protected
function CompileExprLevel0(ASkip: Boolean): TALExprNode; virtual;
function CompileExprLevel1(ASkip: Boolean): TALExprNode; virtual;
function CompileExprLevel2(ASkip: Boolean): TALExprNode; virtual;
function CompileExprLevel3(ASkip: Boolean): TALExprNode; virtual;
function CompileFactor: TALExprNode; virtual;
function CompileIdentFactor: TALExprNode; virtual;
public
constructor Create(ALexer: TALExprLexer; ANodeFactory: TALExprNodeFactory);
function Compile: TALExprNode; virtual;
property Lexer: TALExprLexer read FLexer;
property NodeFactory: TALExprNodeFactory read FNodeFactory;
property Context: TALExprContext read FContext write FContext;
end;
TALExprEvalParser = class(TObject)
private
FContext: TALExprContext;
FLexer: TALExprLexer;
protected
function EvalExprLevel0(ASkip: Boolean): TALFloat; virtual;
function EvalExprLevel1(ASkip: Boolean): TALFloat; virtual;
function EvalExprLevel2(ASkip: Boolean): TALFloat; virtual;
function EvalExprLevel3(ASkip: Boolean): TALFloat; virtual;
function EvalFactor: TALFloat; virtual;
function EvalIdentFactor: TALFloat; virtual;
public
constructor Create(ALexer: TALExprLexer);
function Evaluate: TALFloat; virtual;
property Lexer: TALExprLexer read FLexer;
property Context: TALExprContext read FContext write FContext;
end;
{ some concrete class descendants follow... }
TALExprSimpleLexer = class(TALExprLexer)
protected
FCurrPos: PAnsiChar;
FBuf: AnsiString;
procedure SetBuf(const ABuf: AnsiString);
public
constructor Create(const ABuf: AnsiString);
procedure NextTok(const EvalTok: Boolean = True); override;
procedure Reset; override;
property Buf: AnsiString read FBuf write SetBuf;
end;
TALExprVirtMachOp = class(TObject)
private
function GetOutputLoc: PALFloat;
protected
FOutput: TALFloat;
public
procedure Execute; virtual; abstract;
property OutputLoc: PALFloat read GetOutputLoc;
end;
TALExprVirtMach = class(TObject)
private
FCodeList: TList;
FConstList: TList;
public
constructor Create;
destructor Destroy; override;
procedure Add(AOp: TALExprVirtMachOp);
procedure AddConst(AOp: TALExprVirtMachOp);
procedure Clear;
function Execute: TALFloat;
end;
TALExprVirtMachNodeFactory = class(TALExprNodeFactory)
private
FNodeList: TList;
function AddNode(ANode: TALExprNode): TALExprNode;
procedure DoClean(AVirtMach: TALExprVirtMach);
procedure DoConsts(AVirtMach: TALExprVirtMach);
procedure DoCode(AVirtMach: TALExprVirtMach);
public
constructor Create;
destructor Destroy; override;
procedure GenCode(AVirtMach: TALExprVirtMach);
function LoadVar32(ALoc: PALFloat32): TALExprNode; override;
function LoadVar64(ALoc: PALFloat64): TALExprNode; override;
function LoadVar80(ALoc: PALFloat80): TALExprNode; override;
function LoadConst32(AValue: TALFloat32): TALExprNode; override;
function LoadConst64(AValue: TALFloat64): TALExprNode; override;
function LoadConst80(AValue: TALFloat80): TALExprNode; override;
function CallFloatFunc(AFunc: TALFloatFunc): TALExprNode; override;
function CallFloat32Func(AFunc: TALFloat32Func): TALExprNode; override;
function CallFloat64Func(AFunc: TALFloat64Func): TALExprNode; override;
function CallFloat80Func(AFunc: TALFloat80Func): TALExprNode; override;
function CallUnaryFunc(AFunc: TALUnaryFunc; X: TALExprNode): TALExprNode; override;
function CallUnary32Func(AFunc: TALUnary32Func; X: TALExprNode): TALExprNode; override;
function CallUnary64Func(AFunc: TALUnary64Func; X: TALExprNode): TALExprNode; override;
function CallUnary80Func(AFunc: TALUnary80Func; X: TALExprNode): TALExprNode; override;
function CallBinaryFunc(AFunc: TALBinaryFunc; X, Y: TALExprNode): TALExprNode; override;
function CallBinary32Func(AFunc: TALBinary32Func; X, Y: TALExprNode): TALExprNode; override;
function CallBinary64Func(AFunc: TALBinary64Func; X, Y: TALExprNode): TALExprNode; override;
function CallBinary80Func(AFunc: TALBinary80Func; X, Y: TALExprNode): TALExprNode; override;
function CallTernaryFunc(AFunc: TALTernaryFunc; X, Y, Z: TALExprNode): TALExprNode; override;
function CallTernary32Func(AFunc: TALTernary32Func; X, Y, Z: TALExprNode): TALExprNode; override;
function CallTernary64Func(AFunc: TALTernary64Func; X, Y, Z: TALExprNode): TALExprNode; override;
function CallTernary80Func(AFunc: TALTernary80Func; X, Y, Z: TALExprNode): TALExprNode; override;
function Add(ALeft, ARight: TALExprNode): TALExprNode; override;
function Subtract(ALeft, ARight: TALExprNode): TALExprNode; override;
function Multiply(ALeft, ARight: TALExprNode): TALExprNode; override;
function Divide(ALeft, ARight: TALExprNode): TALExprNode; override;
function IntegerDivide(ALeft, ARight: TALExprNode): TALExprNode; override;
function Modulo(ALeft, ARight: TALExprNode): TALExprNode; override;
function Negate(AValue: TALExprNode): TALExprNode; override;
function Compare(ALeft, ARight: TALExprNode): TALExprNode; override;
function CompareEqual(ALeft, ARight: TALExprNode): TALExprNode; override;
function CompareNotEqual(ALeft, ARight: TALExprNode): TALExprNode; override;
function CompareLess(ALeft, ARight: TALExprNode): TALExprNode; override;
function CompareLessEqual(ALeft, ARight: TALExprNode): TALExprNode; override;
function CompareGreater(ALeft, ARight: TALExprNode): TALExprNode; override;
function CompareGreaterEqual(ALeft, ARight: TALExprNode): TALExprNode; override;
function LogicalAnd(ALeft, ARight: TALExprNode): TALExprNode; override;
function LogicalOr(ALeft, ARight: TALExprNode): TALExprNode; override;
function LogicalXor(ALeft, ARight: TALExprNode): TALExprNode; override;
function LogicalNot(AValue: TALExprNode): TALExprNode; override;
function BitwiseAnd(ALeft, ARight: TALExprNode): TALExprNode; override;
function BitwiseOr(ALeft, ARight: TALExprNode): TALExprNode; override;
function BitwiseXor(ALeft, ARight: TALExprNode): TALExprNode; override;
function BitwiseNot(AValue: TALExprNode): TALExprNode; override;
function ShiftLeft(ALeft, ARight: TALExprNode): TALExprNode; override;
function ShiftRight(ALeft, ARight: TALExprNode): TALExprNode; override;
end;
{ some concrete symbols }
TALExprConstSym = class(TALExprSym)
private
FValue: TALFloat;
public
constructor Create(const AIdent: AnsiString; AValue: TALFloat);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprConst32Sym = class(TALExprSym)
private
FValue: TALFloat32;
public
constructor Create(const AIdent: AnsiString; AValue: TALFloat32);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprConst64Sym = class(TALExprSym)
private
FValue: TALFloat64;
public
constructor Create(const AIdent: AnsiString; AValue: TALFloat64);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprConst80Sym = class(TALExprSym)
private
FValue: TALFloat80;
public
constructor Create(const AIdent: AnsiString; AValue: TALFloat80);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprVar32Sym = class(TALExprSym)
private
FLoc: PALFloat32;
public
constructor Create(const AIdent: AnsiString; ALoc: PALFloat32);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprVar64Sym = class(TALExprSym)
private
FLoc: PALFloat64;
public
constructor Create(const AIdent: AnsiString; ALoc: PALFloat64);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprVar80Sym = class(TALExprSym)
private
FLoc: PALFloat80;
public
constructor Create(const AIdent: AnsiString; ALoc: PALFloat80);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprAbstractFuncSym = class(TALExprSym)
protected
function EvalFirstArg: TALFloat;
function EvalNextArg: TALFloat;
function CompileFirstArg: TALExprNode;
function CompileNextArg: TALExprNode;
procedure EndArgs;
end;
TALExprFuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALFloatFunc;
public
constructor Create(const AIdent: AnsiString; AFunc: TALFloatFunc);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprFloat32FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALFloat32Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALFloat32Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprFloat64FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALFloat64Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALFloat64Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprFloat80FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALFloat80Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALFloat80Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprUnaryFuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALUnaryFunc;
public
constructor Create(const AIdent: AnsiString; AFunc: TALUnaryFunc);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprUnary32FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALUnary32Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALUnary32Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprUnary64FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALUnary64Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALUnary64Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprUnary80FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALUnary80Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALUnary80Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprBinaryFuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALBinaryFunc;
public
constructor Create(const AIdent: AnsiString; AFunc: TALBinaryFunc);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprBinary32FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALBinary32Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALBinary32Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprBinary64FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALBinary64Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALBinary64Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprBinary80FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALBinary80Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALBinary80Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprTernaryFuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALTernaryFunc;
public
constructor Create(const AIdent: AnsiString; AFunc: TALTernaryFunc);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprTernary32FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALTernary32Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALTernary32Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprTernary64FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALTernary64Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALTernary64Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALExprTernary80FuncSym = class(TALExprAbstractFuncSym)
private
FFunc: TALTernary80Func;
public
constructor Create(const AIdent: AnsiString; AFunc: TALTernary80Func);
function Evaluate: TALFloat; override;
function Compile: TALExprNode; override;
end;
TALEasyEvaluator = class(TObject)
private
FOwnContext: TALExprHashContext;
FExtContextSet: TALExprSetContext;
FInternalContextSet: TALExprSetContext;
protected
property InternalContextSet: TALExprSetContext read FInternalContextSet;
public
constructor Create;
destructor Destroy; override;
//Adds a variable to the internal context. Whenever the variable is found in
//an expression, its current value will be inserted.
procedure AddVar(const AName: AnsiString; var AVar: TALFloat32); overload;
procedure AddVar(const AName: AnsiString; var AVar: TALFloat64); overload;
procedure AddVar(const AName: AnsiString; var AVar: TALFloat80); overload;
//Adds a constant to the internal context. Constants are different from variables
//because sub-expressions made entirely from constants may be evaluated only once
//(at compile time), and that value used for all subsequent evaluations.
procedure AddConst(const AName: AnsiString; AConst: TALFloat32); overload;
procedure AddConst(const AName: AnsiString; AConst: TALFloat64); overload;
procedure AddConst(const AName: AnsiString; AConst: TALFloat80); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALFloat32Func); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALFloat64Func); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALFloat80Func); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALUnary32Func); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALUnary64Func); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALUnary80Func); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALBinary32Func); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALBinary64Func); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALBinary80Func); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALTernary32Func); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALTernary64Func); overload;
procedure AddFunc(const AName: AnsiString; AFunc: TALTernary80Func); overload;
procedure Remove(const AName: AnsiString);
procedure Clear; virtual;
property ExtContextSet: TALExprSetContext read FExtContextSet;
end;
TALEvaluator = class(TALEasyEvaluator)
private
FLexer: TALExprSimpleLexer;
FParser: TALExprEvalParser;
public
constructor Create;
destructor Destroy; override;
function Evaluate(const AExpr: AnsiString): TALFloat;
end;
TALCompiledEvaluator = class(TALEasyEvaluator)
private
FExpr: AnsiString;
FVirtMach: TALExprVirtMach;
public
constructor Create;
destructor Destroy; override;
procedure Compile(const AExpr: AnsiString);
function Evaluate: TALFloat;
end;
resourcestring
RsALExprEvalRParenExpected = 'Parse error: '')'' expected';
RsALExprEvalFactorExpected = 'Parse error: Factor expected';
RsALExprEvalUnknownSymbol = 'Parse error: Unknown symbol: ''%s''';
RsALExprEvalFirstArg = 'Parse error: ''('' and function''s first parameter expected';
RsALExprEvalNextArg = 'Parse error: '','' and another parameter expected';
RsALExprEvalEndArgs = 'Parse error: '')'' to close function''s parameters expected';
implementation
uses System.Types,
System.Math,
System.Contnrs,
ALString,
ALCipher;
{*****************************************************}
function ALEvaluator_Max(A, B: TALFloat80): TALFloat80;
begin
Result := Max(A, B);
end;
{*****************************************************}
function ALEvaluator_Min(A, B: TALFloat80): TALFloat80;
begin
Result := Min(A, B);
end;
{***************************************}
procedure ALClearObjectList(List: TList);
var
I: Integer;
begin
if List <> nil then
begin
for I := List.Count - 1 downto 0 do
begin
if List[I] <> nil then
begin
if TObject(List[I]) is TList then
begin
// recursively delete TList sublists
ALClearObjectList(TList(List[I]));
end;
TObject(List[I]).Free;
if (not (List is TComponentList))
and ((not(List is TObjectList)) or not TObjectList(List).OwnsObjects) then
List[I] := nil;
end;
end;
List.Clear;
end;
end;
{******************************************}
procedure ALFreeObjectList(var List: TList);
begin
if List <> nil then
begin
ALClearObjectList(List);
FreeAndNil(List);
end;
end;
{******************************************************}
function ALCharIsWhiteSpace(const C: AnsiChar): Boolean;
const _AnsiTab = AnsiChar(#9);
_AnsiLineFeed = AnsiChar(#10);
_AnsiVerticalTab = AnsiChar(#11);
_AnsiFormFeed = AnsiChar(#12);
_AnsiCarriageReturn = AnsiChar(#13);
_AnsiSpace = AnsiChar(' ');
begin
Result := (C = _AnsiTab) or (C = _AnsiLineFeed) or (C = _AnsiVerticalTab) or
(C = _AnsiFormFeed) or (C = _AnsiCarriageReturn) or (C = _AnsiSpace);
end;
{*****************************************************************}
function ALCharIsValidIdentifierLetter(const C: AnsiChar): Boolean;
begin
case C of
'0'..'9', 'A'..'Z', 'a'..'z', '_':
Result := True;
else
Result := False;
end;
end;
{*************************************************}
function ALCharIsDigit(const C: AnsiChar): Boolean;
begin
Result := C in ['0'..'9'];
end;
{*************************************************************}
constructor TALExprHashContext.Create(ACaseSensitive: Boolean);
begin
inherited Create;
FHashMap := TALAVLStringList.Create(true);
FHashMap.CaseSensitive := ACaseSensitive;
end;
{************************************}
destructor TALExprHashContext.Destroy;
begin
FHashMap.Free;
inherited Destroy;
end;
{****************************************************}
procedure TALExprHashContext.Add(ASymbol: TALExprSym);
begin
FHashMap.AddObject(ASymbol.Ident, ASymbol);
end;
{***********************************************************}
procedure TALExprHashContext.Remove(const AName: AnsiString);
Var aIdx: integer;
begin
aIdx := FHashMap.IndexOf(AName);
if aIdx >= 0 then FHashMap.Delete(aIdx);
end;
{********************************************************************}
function TALExprHashContext.Find(const AName: AnsiString): TALExprSym;
Var aIdx: integer;
begin
Result := nil;
aIdx := FHashMap.IndexOf(AName);
if aIdx >= 0 then result := TALExprSym(FHashMap.Objects[aIdx]);
end;
{***********************************************************}
constructor TALExprSetContext.Create(AOwnsContexts: Boolean);
begin
inherited Create;
FOwnsContexts := AOwnsContexts;
FList := TList.Create;
end;
{***********************************}
destructor TALExprSetContext.Destroy;
begin
if FOwnsContexts then
ALClearObjectList(FList);
FList.Free;
inherited Destroy;