Skip to content

Commit

Permalink
Add support for properties #103
Browse files Browse the repository at this point in the history
  • Loading branch information
@slackydev @ollydev
slackydev authored and ollydev committed Apr 23, 2024
1 parent 5eed1c4 commit 331cd0b
Show file tree
Hide file tree
Showing 12 changed files with 255 additions and 79 deletions.
2 changes: 1 addition & 1 deletion extensions/ffi/lpffiwrappers.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -234,7 +234,7 @@ function _ParseMethodHeader(Compiler: TLapeCompiler; Header: lpString): TLapeTyp

OldState := c.getTempTokenizerState(Header + ';', 'ffi');
try
c.Expect([tk_kw_Function, tk_kw_Procedure]);
c.Expect([tk_kw_Function, tk_kw_Procedure, tk_kw_Property, tk_kw_Operator]);
Result := c.ParseMethodHeader(s, False);

if (Result = nil) then
Expand Down
132 changes: 99 additions & 33 deletions lpcompiler.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1383,9 +1383,6 @@ function TLapeCompiler.HandleDirective(Sender: TLapeTokenizerBase; Directive, Ar
if (Name = 'autoinvoke') then
Result := (lcoAutoInvoke in FOptions)
else
if (Name = 'autoproperties') then
Result := (lcoAutoProperties in FOptions)
else
if (Name = 'scopedenums') then
Result := (lcoScopedEnums in FOptions)
else
Expand Down Expand Up @@ -1601,9 +1598,6 @@ function TLapeCompiler.HandleDirective(Sender: TLapeTokenizerBase; Directive, Ar
if (Directive = 'f') or (Directive = 'autoinvoke') then
setOption(lcoAutoInvoke)
else
if (Directive = 'p') or (Directive = 'autoproperties') then
setOption(lcoAutoProperties)
else
if (Directive = 's') or (Directive = 'scopedenums') then
setOption(lcoScopedEnums)
else
Expand Down Expand Up @@ -1827,7 +1821,7 @@ function TLapeCompiler.ParseBlockList(StopAfterBeginEnd: Boolean = True): TLapeT
DoBreak := (Tokenizer.LastTok = tk_sym_Dot) or StopAfterBeginEnd;
end;
tk_kw_Const, tk_kw_Var: Statement := ParseVarBlock();
tk_kw_Function, tk_kw_Procedure, tk_kw_Operator:
tk_kw_Function, tk_kw_Procedure, tk_kw_Operator, tk_kw_Property:
addDelayedExpression(ParseMethod(FuncForwards));
tk_kw_Type: ParseTypeBlock();

Expand Down Expand Up @@ -1884,7 +1878,8 @@ function TLapeCompiler.ParseMethodHeader(out Name: lpString; addToScope: Boolean
var
i: Integer;
Pos: TDocPos;
isFunction: Boolean;
ExpectResult: Boolean;
methodDef: EMethodDef;
Typ: TLapeDeclaration;
Identifiers: TStringArray;
Param: TLapeParameter;
Expand All @@ -1895,14 +1890,18 @@ function TLapeCompiler.ParseMethodHeader(out Name: lpString; addToScope: Boolean
begin
Pos := Tokenizer.DocPos;
Result := TLapeType_Method.Create(Self, nil, nil, '', @Pos);
Result.isOperator := (Tokenizer.Tok = tk_kw_Operator);
isFunction := (Tokenizer.Tok = tk_kw_Function) or Result.isOperator;
case Tokenizer.Tok of
tk_kw_Operator: Result.MethodDef := mdOperator;
tk_kw_Property: Result.MethodDef := mdProperty;
else Result.MethodDef := mdUnspecified;
end;
ExpectResult := Tokenizer.Tok in [tk_kw_Function, tk_kw_Operator];

try
if (isNext([tk_Identifier, tk_sym_ParenthesisOpen], Token) and (Token = tk_Identifier)) or
(Result.isOperator and isNext(ParserToken_Operators, Token)) then
((Result.MethodDef = mdOperator) and isNext(ParserToken_Operators, Token)) then
begin
if not Result.isOperator then
if Result.MethodDef <> mdOperator then
Name := Tokenizer.TokString
else begin
op := ParserTokenToOperator(Tokenizer.Tok);
Expand All @@ -1926,12 +1925,16 @@ function TLapeCompiler.ParseMethodHeader(out Name: lpString; addToScope: Boolean
begin
if addToScope then
FStackInfo.addSelfVar(Lape_SelfParam, TLapeType(Typ));
methodDef := Result.MethodDef;
Result.Free();
Result := TLapeType_MethodOfType.Create(Self, TLapeType(Typ), nil, nil, '', @Pos);
Result.MethodDef := methodDef;
end
else if (not (Typ is TLapeType_SystemUnit)) then
LapeException(lpeTypeExpected, [Tokenizer]);
end;
end
else if (Result.MethodDef = mdProperty) then
LapeException(lpeExpectedProperty, Tokenizer.DocPos);
end;

if (Token = tk_sym_ParenthesisOpen) or ((Token = tk_NULL) and isNext([tk_sym_ParenthesisOpen])) then
Expand Down Expand Up @@ -1965,6 +1968,8 @@ function TLapeCompiler.ParseMethodHeader(out Name: lpString; addToScope: Boolean

if (Tokenizer.Tok = tk_sym_Equals) then
begin
if (Result.MethodDef = mdProperty) then
LapeException(lpeDefaultParamInProperties, Tokenizer.DocPos);
Default := ParseExpression([tk_sym_ParenthesisClose], True, False).setExpectedType(Param.VarType) as TLapeTree_ExprBase;
try
Param.Default := Default.Evaluate();
Expand Down Expand Up @@ -1992,7 +1997,7 @@ function TLapeCompiler.ParseMethodHeader(out Name: lpString; addToScope: Boolean
LapeException(lpeMethodDeclarationParenthesesExpected, Tokenizer.DocPos);
end;

if Result.isOperator then
if (Result.MethodDef = mdOperator) then
begin
if (Result.Params.Count <> 2) then
LapeExceptionFmt(lpeInvalidOperator, [op_name[op], 2], Pos);
Expand All @@ -2002,7 +2007,7 @@ function TLapeCompiler.ParseMethodHeader(out Name: lpString; addToScope: Boolean
LapeExceptionFmt(lpeCannotOverrideOperator, [op_name[op], ltyp.AsString, rtyp.AsString], Pos);
end;

if isFunction then
if ExpectResult or ((Result.MethodDef = mdProperty) and (Peek() = tk_sym_Colon)) then
begin
Expect(tk_sym_Colon, True, False);
Result.Res := ParseType(nil);
Expand Down Expand Up @@ -2211,10 +2216,12 @@ function TLapeCompiler.ParseMethod(FuncForwards: TLapeFuncForwards; FuncHeader:
Result.Method.setReadWrite(False, False);

try
if (Tokenizer.Tok = tk_kw_Overload) or (FuncHeader.isOperator and (Tokenizer.Tok <> tk_kw_Override)) then
if (Tokenizer.Tok = tk_kw_Overload) or ((FuncHeader.MethodDef in [mdOperator, mdProperty]) and (Tokenizer.Tok <> tk_kw_Override)) then
begin
if not FuncHeader.isOperator then
ParseExpressionEnd(tk_sym_SemiColon, True, False);
if not(FuncHeader.MethodDef in [mdOperator, mdProperty]) then
ParseExpressionEnd(tk_sym_SemiColon, True, False)
else if (Tokenizer.Tok = tk_kw_Overload) then
LapeExceptionFmt(lpeUnexpectedToken, [LapeTokenToString(Tokenizer.Tok)], DocPos);

if (OldDeclaration = nil) or (not LocalDecl) or ((OldDeclaration is TLapeGlobalVar) and (TLapeGlobalVar(OldDeclaration).VarType is TLapeType_Method)) then
with TLapeType_OverloadedMethod(addLocalDecl(TLapeType_OverloadedMethod.Create(Self, '', @Pos), FStackInfo.Owner)) do
Expand All @@ -2226,13 +2233,17 @@ function TLapeCompiler.ParseMethod(FuncForwards: TLapeFuncForwards; FuncHeader:
addMethod(OldDeclaration as TLapeGlobalVar);
end;

MethodDef := FuncHeader.MethodDef;
OldDeclaration := addLocalDecl(NewGlobalVar('', @_DocPos), FStackInfo.Owner);
OldDeclaration.Name := FuncName;
end
else if (not (OldDeclaration is TLapeGlobalVar)) or (not (TLapeGlobalVar(OldDeclaration).VarType is TLapeType_OverloadedMethod)) or (TLapeType_OverloadedMethod(TLapeGlobalVar(OldDeclaration).VarType).getMethod(FuncHeader) <> nil) then
LapeException(lpeCannotOverload, Tokenizer.DocPos);

try
if TLapeType_OverloadedMethod(TLapeGlobalVar(OldDeclaration).VarType).MethodDef <> FuncHeader.MethodDef then
LapeExceptionFmt(lpeCannotOverload2, [LapeMethodDefToString(TLapeType_OverloadedMethod(TLapeGlobalVar(OldDeclaration).VarType).MethodDef), LapeMethodDefToString(FuncHeader.MethodDef)], Tokenizer.DocPos);

TLapeType_OverloadedMethod(TLapeGlobalVar(OldDeclaration).VarType).addMethod(Result.Method, not LocalDecl);
except on E: lpException do
LapeException(lpString(E.Message), Tokenizer.DocPos);
Expand Down Expand Up @@ -2689,6 +2700,8 @@ function TLapeCompiler.ParseType(TypeForwards: TLapeTypeForwards; addToStackOwne
Name: lpString;
begin
BaseType := ltPointer;
if (Tokenizer.Tok in [tk_kw_Property, tk_kw_Operator]) then
LapeException(lpeTypeExpected);
if (Tokenizer.Tok in [tk_kw_External, {tk_kw_Export,} tk_kw_Private]) then
begin
if (Tokenizer.Tok = tk_kw_External) then
Expand All @@ -2697,7 +2710,7 @@ function TLapeCompiler.ParseType(TypeForwards: TLapeTypeForwards; addToStackOwne
else if (Tokenizer.Tok = tk_kw_Private) then
BaseType := ltScriptMethod;

Expect([tk_kw_Function, tk_kw_Procedure], True, False);
Expect([tk_kw_Function, tk_kw_Procedure{, tk_kw_Property, tk_kw_Operator}], True, False);
end;

Result := ParseMethodHeader(Name, False);
Expand Down Expand Up @@ -2804,7 +2817,7 @@ function TLapeCompiler.ParseType(TypeForwards: TLapeTypeForwards; addToStackOwne
end;
tk_sym_Caret, tk_kw_Strict: ParsePointer();
tk_kw_Enum, tk_sym_ParenthesisOpen: ParseEnum();
tk_kw_Function, tk_kw_Procedure, tk_kw_Operator, tk_kw_External, tk_kw_Private: ParseMethodType();
tk_kw_Function, tk_kw_Procedure, tk_kw_Operator, tk_kw_Property, tk_kw_External, tk_kw_Private: ParseMethodType();
tk_kw_Type: ParseTypeType();
else ParseDef();
end;
Expand Down Expand Up @@ -3009,6 +3022,7 @@ function TLapeCompiler.ParseExpression(ReturnOn: EParserTokenSet; FirstNext: Boo
Precedence: Byte;
Expr: TLapeTree_ExprBase;
Method: TLapeTree_Invoke;
Prop: TLapeTree_InvokeProperty;
_LastNode: (_None, _Var, _Op);
InExpr: Integer;
DoNext: Boolean;
Expand Down Expand Up @@ -3226,6 +3240,11 @@ function TLapeCompiler.ParseExpression(ReturnOn: EParserTokenSet; FirstNext: Boo
end;
end;

function IsProperty(typ: TLapeType): Boolean;
begin
Result := (Typ <> nil) and (Typ is TLapeType_OverloadedMethod) and (TLapeType_OverloadedMethod(Typ).MethodDef = mdProperty);
end;

function ResolveMethods(Node: TLapeTree_Base; SkipTop: Boolean): TLapeTree_Base;

function Resolve(Node: TLapeTree_Base; Top, Recurse: Boolean; out HasChanged: Boolean): TLapeTree_Base;
Expand All @@ -3238,26 +3257,32 @@ function TLapeCompiler.ParseExpression(ReturnOn: EParserTokenSet; FirstNext: Boo
function ResolveMethod(Node: TLapeTree_ExprBase): TLapeTree_ExprBase;
var
Op: EOperator;
idc:Boolean;
begin
if (Node is TLapeTree_Operator) then
Op := TLapeTree_Operator(Node).OperatorType
else
Op := op_Unknown;

if (not (Op in AssignOperators)) and MethodType(Node.resType()) then
if (not (Op in AssignOperators)) and IsProperty(Node.resType()) then
begin
Result := TLapeTree_InvokeProperty.Create(Node, Node);
TLapeTree_InvokeProperty(Result).PropertyType := ptRead;
end
else if (lcoAutoInvoke in Node.CompilerOptions) and (not (Op in AssignOperators)) and MethodType(Node.resType()) then
Result := TLapeTree_Invoke.Create(Node, Node)
else if (Op = op_Assign) and (lcoAutoProperties in Node.CompilerOptions) and MethodType(TLapeTree_Operator(Node).Left.resType()) then
else if (Op in AssignOperators) and IsProperty(TLapeTree_Operator(Node).Left.resType()) then
begin
Result := TLapeTree_Invoke.Create(TLapeTree_Operator(Node).Left, Node);
TLapeTree_Invoke(Result).addParam(TLapeTree_Operator(Node).Right);
Result := TLapeTree_InvokeProperty.Create(TLapeTree_Operator(Node).Left, Node);
TLapeTree_InvokeProperty(Result).addParam(Resolve(TLapeTree_Operator(Node).Right, True, True, idc) as TLapeTree_ExprBase);
TLapeTree_InvokeProperty(Result).PropertyType := ptWrite;
TLapeTree_InvokeProperty(Result).AssignOp := Op;
Node.Free();
end
else if (Op = op_Addr) and MethodType(TLapeTree_Operator(Node).Left.resType()) then
begin
Result := TLapeTree_Operator(Node).Left;
Result.Parent := nil;
if (Node.Parent <> nil) then
Node.Parent.CompilerOptions := Node.Parent.CompilerOptions - [lcoAutoProperties];
Node.Free();
end
else
Expand All @@ -3270,10 +3295,7 @@ function TLapeCompiler.ParseExpression(ReturnOn: EParserTokenSet; FirstNext: Boo
Result := Node;
HasChanged := False;

if TLapeTree_Base.isEmpty(Node) or
(([lcoAutoInvoke, lcoAutoProperties] * Node.CompilerOptions) = []) or
(not (Node is TLapeTree_ExprBase)) or (Node is TLapeTree_Invoke)
then
if TLapeTree_Base.isEmpty(Node) or (not (Node is TLapeTree_ExprBase)) or (Node is TLapeTree_Invoke) then
Exit;

if Top then
Expand Down Expand Up @@ -3309,6 +3331,7 @@ function TLapeCompiler.ParseExpression(ReturnOn: EParserTokenSet; FirstNext: Boo
begin
Result := nil;
Method := nil;
Prop := nil;
VarStack := TLapeTree_NodeStack.Create(8);
OpStack := TLapeTree_OpStack.Create(16);
_LastNode := _None;
Expand Down Expand Up @@ -3408,6 +3431,9 @@ function TLapeCompiler.ParseExpression(ReturnOn: EParserTokenSet; FirstNext: Boo
PopOpStack(op_Invoke);
if (Method = nil) then
begin
if IsProperty(VarStack.Top.resType()) then
LapeException(lpeCannotInvoke, Tokenizer.DocPos);

Expr := ResolveMethods(VarStack.Top.FoldConstants(), True) as TLapeTree_ExprBase;
if (Expr <> VarStack.Pop()) and (Expr is TLapeTree_InternalMethod) then
Method := TLapeTree_Invoke(Expr)
Expand Down Expand Up @@ -3443,6 +3469,44 @@ function TLapeCompiler.ParseExpression(ReturnOn: EParserTokenSet; FirstNext: Boo
Dec(InExpr);
end;

tk_sym_BracketOpen:
if (_LastNode = _Var) then
begin
PopOpStack(op_Index);
if IsProperty(VarStack.Top.resType()) then
begin
Expr := ResolveMethods(VarStack.Pop().FoldConstants(), True) as TLapeTree_ExprBase;
Prop := TLapeTree_InvokeProperty.Create(Expr, Self, getPDocPos());
if (Next() <> tk_sym_BracketClose) then
begin
Prop.addParam(EnsureExpression(ParseExpression([tk_sym_BracketClose, tk_sym_Comma], False)));
while True do
case Tokenizer.Tok of
tk_sym_BracketClose: Break;
tk_sym_Comma: Prop.addParam(EnsureExpression(ParseExpression([tk_sym_BracketClose, tk_sym_Comma])));
else LapeException(lpeClosingBracketExpected, Tokenizer.DocPos);
end;

if ParserTokenToOperator(Peek()) in AssignOperators then
begin
Next();
Prop.PropertyType := ptWrite;
Prop.AssignOp := ParserTokenToOperator(Tokenizer.Tok);
Prop.addParam(EnsureExpression(ParseExpression(ParserToken_ExpressionEnd, True)));
DoNext := False;
end else
Prop.PropertyType := ptRead;
end else
LapeException(lpeExpectedIndexValue, Tokenizer.DocPos);

VarStack.Push(Prop);
Prop := nil;
end else
ParseOperator();
end
else
ParseOperator();

{$IFDEF Lape_PascalLabels}
tk_sym_Colon:
begin
Expand All @@ -3463,9 +3527,11 @@ function TLapeCompiler.ParseExpression(ReturnOn: EParserTokenSet; FirstNext: Boo
end;
{$ENDIF}

ParserToken_FirstOperator..ParserToken_LastOperator: ParseOperator();
else
Break;
if Tokenizer.Tok in [ParserToken_FirstOperator..ParserToken_LastOperator] then
ParseOperator()
else
Break;
end;
end;

Expand Down Expand Up @@ -4804,7 +4870,7 @@ function TLapeCompiler.addGlobalFunc(AHeader: lpString; Value: Pointer): TLapeGl

try
try
Expect([tk_kw_Function, tk_kw_Procedure, tk_kw_Operator]);
Expect([tk_kw_Function, tk_kw_Procedure, tk_kw_Property, tk_kw_Operator]);
Method := ParseMethod(nil, True);
CheckAfterCompile();

Expand Down
2 changes: 1 addition & 1 deletion lpeval.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -131,7 +131,7 @@ function LapeEval_GetProc(Op: EOperator; Left, Right: ELapeBaseType): TLapeEvalP
LapeEvalRes: TLapeEvalRes;
LapeEvalArr: TLapeEvalArr;

LapeDelayedFlags: lpString = '{$ASSERTIONS ON}{$BOOLEVAL ON}{$CONSTADDRESS ON}{$RANGECHECKS ON}{$AUTOINVOKE OFF}{$AUTOPROPERTIES OFF}{$LOOSESEMICOLON OFF}{$EXTENDEDSYNTAX OFF}{$HINTS OFF}' + LineEnding;
LapeDelayedFlags: lpString = '{$ASSERTIONS ON}{$BOOLEVAL ON}{$CONSTADDRESS ON}{$RANGECHECKS ON}{$AUTOINVOKE OFF}{$LOOSESEMICOLON OFF}{$EXTENDEDSYNTAX OFF}{$HINTS OFF}' + LineEnding;
LapeDelayedTypes: lpString =
'type' + LineEnding +
' _LapeCompareFunc = private function(constref A, B): Int32;' + LineEnding +
Expand Down
6 changes: 6 additions & 0 deletions lpmessages.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,12 +45,15 @@ lpException = class(Exception)
lpeCannotInvoke = 'Cannot invoke identifier';
lpeCannotMixStaticOverload = 'Cannot mix static with non-static method overload';
lpeCannotOverload = 'Cannot overload function';
lpeCannotOverload2 = 'Cannot overload "%s" with a "%s"';
lpeCannotOverloadOperator = 'Cannot overload operator "%s"';
lpeCannotOverrideOperator = 'Cannot override operator "%s" with types "%s" and "%s"';
lpeClosingParenthesisExpected = 'Closing parenthesis expected';
lpeClosingBracketExpected = 'Closing bracket expected';
lpeConditionalNotClosed = 'Conditional statement not properly closed';
lpeConstantExpected = 'Constant expression expected';
lpeDeclarationOutOfScope = 'Declaration "%s" out of scope';
lpeDefaultParamInProperties = 'Properties do not support default parameters';
lpeDefaultToMoreThanOne = 'Runtime default value can only be assigned to one variable';
lpeDuplicateDeclaration = 'Duplicate declaration "%s"';
lpeDuplicateHashBucket = 'Duplicate hash bucket with "%s" and "%s"';
Expand All @@ -66,6 +69,7 @@ lpException = class(Exception)
lpeExpectedDynamicArray = 'Dynamic array expected';
lpeExpectedNormalMethod = 'Normal method expected';
lpeExpectedPointerType = 'Pointer type expected';
lpeExpectedIndexValue = 'Expected at least one index value';
lpeExpectedOther = 'Found unexpected token "%s", expected "%s"';
lpeExpressionExpected = 'Expression expected';
lpeExpectedEnum = 'Enum expected';
Expand Down Expand Up @@ -98,6 +102,7 @@ lpException = class(Exception)
lpeMethodOfObjectExpected = 'Expected method of object';
lpeNoDefaultForParam = 'No default value for parameter %d found';
lpeNoForwardMatch = 'Forwarded declaration doesn''t match';
lpeNoMatchingProperty = 'No matching property found';
lpeNoOverloadedMethod = 'Don''t know which overloaded method to call with params (%s)';
lpeNeedMoreBuckets = 'Need more hash buckets (currently %d)';
lpeOperatorExpected = 'Operator expected';
Expand All @@ -112,6 +117,7 @@ lpException = class(Exception)
lpeIndexOutOfRangeLow = 'Index out of range (index:%d, low:%d)';
lpeIndexOutOfRangeHigh = 'Index out of range (index:%d, high:%d)';
lpeParentOutOfScope = 'Parent declaration is out of scope';
lpeExpectedProperty = 'Property has to be of a type';
lpeRuntime = 'Runtime error: "%s"';
lpeStatementNotAllowed = 'Statement not allowed here';
lpeStaticMethodExpected = 'Variable expected. "%s" is not a static method';
Expand Down
Loading

0 comments on commit 331cd0b

Please sign in to comment.