Ignore:
Timestamp:
Jan 16, 2018, 10:38:33 AM (7 years ago)
Author:
chronos
Message:
  • Modified: General definition of functions. Static functions are now dynamic predefined.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/easy compiler/USourceCode.pas

    r139 r140  
    2626  TSourceVariables = class(TObjectList)
    2727    function AddNew(Name: string = ''): TSourceVariable;
    28     function Find(Name: string): TSourceVariable;
     28    function Search(Name: string): TSourceVariable;
    2929  end;
    3030
    … …  
    3838  end;
    3939
     40  TSourceParameterKind = (pkString, pkVariable);
     41
     42  TSourceFunctionParameter = class
     43    Name: string;
     44    Kind: TSourceParameterKind;
     45  end;
     46
     47  TSourceFunctionParameters = class(TObjectList)
     48  end;
     49
     50  { TSourceFunction }
     51
     52  TSourceFunction = class
     53    Name: string;
     54    Parameters: TSourceFunctionParameters;
     55    procedure AddParameter(Name: string; Kind: TSourceParameterKind);
     56    constructor Create;
     57    destructor Destroy; override;
     58  end;
     59
     60  { TSourceFunctions }
     61
     62  TSourceFunctions = class(TObjectList)
     63    function AddNew(Name: string): TSourceFunction;
     64    function Search(Name: string): TSourceFunction;
     65  end;
     66
    4067  { TSourceConstants }
    4168
    … …  
    5986
    6087  TSourceCode = class
     88  private
     89    procedure InitFunctions;
     90  public
    6191    Variables: TSourceVariables;
    6292    Constants: TSourceConstants;
     93    Functions: TSourceFunctions;
    6394    Instructions: TSourceInstructions;
    6495    constructor Create;
    … …  
    6697  end;
    6798
    68   TOutputEvent = procedure (Text: string) of object;
    69 
    70   { TSourceExecutor }
    71 
    72   TSourceExecutor = class
    73   private
    74     FOnOutput: TOutputEvent;
    75     Variables: TStringList;
    76   public
    77     constructor Create;
    78     destructor Destroy; override;
    79     procedure Execute(SourceCode: TSourceCode);
    80     property OnOutput: TOutputEvent read FOnOutput write FOnOutput;
    81   end;
    82 
    83   { TSourceGenerator }
    84 
    85   TSourceGenerator = class
    86     procedure Generate(SourceCode: TSourceCode);
    87   end;
    8899
    89100implementation
    90101
    91 { TSourceGenerator }
    92 
    93 procedure TSourceGenerator.Generate(SourceCode: TSourceCode);
    94 var
    95   F: TStringList;
    96   Output: string;
    97   Instruction: TSourceInstruction;
    98   Parameter: TSourceReference;
    99   I: Integer;
    100 begin
    101   Output := '';
    102   if SourceCode.Variables.Count > 0 then
    103     Output := Output + 'var' + LineEnding;
    104   with SourceCode do
    105   for I := 0 to Variables.Count - 1 do
    106     Output := Output + '  ' + TSourceVariable(Variables[I]).Name + ': string;' + LineEnding;
    107   Output := Output + 'begin' + LineEnding;
    108   with SourceCode do
    109   for I := 0 to Instructions.Count - 1 do begin
    110     Instruction := TSourceInstruction(Instructions[I]);
    111     if Instruction is TSourceInstructionFunction then begin
    112       if TSourceInstructionFunction(Instruction).Name = 'print' then begin
    113         Output := Output + '  Write(';
    114         Parameter := TSourceInstructionFunction(Instruction).Parameters[0];
    115         if Parameter is TSourceReferenceConstant then begin
    116           Output := Output + '''' + TSourceReferenceConstant(Parameter).Constant.Value + '''';
    117         end else
    118         if Parameter is TSourceReferenceVariable then begin
    119           Output := Output + TSourceReferenceVariable(Parameter).Variable.Name;
    120         end else raise Exception.Create('Unsupported parameter type');
    121         Output := Output + ');' + LineEnding;
    122       end else
    123       if TSourceInstructionFunction(Instruction).Name = 'println' then begin
    124         Output := Output + '  WriteLn(';
    125         Parameter := TSourceInstructionFunction(Instruction).Parameters[0];
    126         if Parameter is TSourceReferenceConstant then begin
    127           Output := Output + '''' + TSourceReferenceConstant(Parameter).Constant.Value + '''';
    128         end else
    129         if Parameter is TSourceReferenceVariable then begin
    130           Output := Output + TSourceReferenceVariable(Parameter).Variable.Name;
    131         end else raise Exception.Create('Unsupported parameter type');
    132         Output := Output + ');' + LineEnding;
    133       end else
    134       if TSourceInstructionFunction(Instruction).Name = 'assign' then begin
    135         Output := Output + '  ';
    136         Parameter := TSourceInstructionFunction(Instruction).Parameters[0];
    137         if Parameter is TSourceReferenceVariable then begin
    138           Output := Output + TSourceReferenceVariable(Parameter).Variable.Name;
    139         end else raise Exception.Create('Unsupported parameter type');
    140         Output := Output + ' := ';
    141         Parameter := TSourceInstructionFunction(Instruction).Parameters[1];
    142         if Parameter is TSourceReferenceConstant then begin
    143           Output := Output + '''' + TSourceReferenceConstant(Parameter).Constant.Value + '''';
    144         end else
    145         if Parameter is TSourceReferenceVariable then begin
    146           Output := Output + TSourceReferenceVariable(Parameter).Variable.Name;
    147         end else raise Exception.Create('Unsupported parameter type');
    148         Output := Output + ';' + LineEnding;
    149       end else raise Exception.Create('Unsupported instruction name.');
    150     end else raise Exception.Create('Unsupported instruction');
    151   end;
    152   Output := Output + 'end.' + LineEnding;
    153 
    154   F := TStringList.Create;
    155   try
    156     F.Text := Output;
    157     F.SaveToFile('Output.pas');
    158   finally
    159     F.Free;
    160   end;
    161 end;
    162 
    163 { TSourceExecutor }
    164 
    165 constructor TSourceExecutor.Create;
    166 begin
    167   Variables := TStringList.Create;
    168 end;
    169 
    170 destructor TSourceExecutor.Destroy;
    171 begin
    172   Variables.Free;
     102{ TSourceFunctions }
     103
     104function TSourceFunctions.AddNew(Name: string): TSourceFunction;
     105begin
     106  Result := TSourceFunction.Create;
     107  Result.Name := Name;
     108  Add(Result);
     109end;
     110
     111function TSourceFunctions.Search(Name: string): TSourceFunction;
     112var
     113  Item: TSourceFunction;
     114begin
     115  Result := nil;
     116  for Item in Self do
     117  if Item.Name = Name then begin
     118    Result := Item;
     119    Break;
     120  end;
     121end;
     122
     123{ TSourceFunction }
     124
     125procedure TSourceFunction.AddParameter(Name: string; Kind: TSourceParameterKind
     126  );
     127var
     128  Parameter: TSourceFunctionParameter;
     129begin
     130  Parameter := TSourceFunctionParameter.Create;
     131  Parameter.Name := Name;
     132  Parameter.Kind := Kind;
     133  Parameters.Add(Parameter);
     134end;
     135
     136constructor TSourceFunction.Create;
     137begin
     138  Parameters := TSourceFunctionParameters.Create;
     139end;
     140
     141destructor TSourceFunction.Destroy;
     142begin
     143  Parameters.Free;
    173144  inherited Destroy;
    174 end;
    175 
    176 procedure TSourceExecutor.Execute(SourceCode: TSourceCode);
    177 var
    178   IP: Integer;
    179   Instruction: TSourceInstruction;
    180   Text: string;
    181   Reference: TSourceReference;
    182   Variable: TSourceVariable;
    183 begin
    184   IP := 0;
    185   while IP < SourceCode.Instructions.Count do begin
    186     Instruction := TSourceInstruction(SourceCode.Instructions[IP]);
    187     if Instruction is TSourceInstructionFunction then begin
    188       if TSourceInstructionFunction(Instruction).Name = 'print' then begin
    189         Reference := TSourceInstructionFunction(Instruction).Parameters[0];
    190         if Reference is TSourceReferenceConstant then begin
    191           Text := TSourceReferenceConstant(Reference).Constant.Value;
    192         end else
    193         if Reference is TSourceReferenceVariable then begin
    194           Text := Variables.Values[TSourceReferenceVariable(Reference).Variable.Name];
    195         end else raise Exception.Create('Unsupported reference');
    196         if Assigned(FOnOutput) then FOnOutput(Text);
    197       end else
    198       if TSourceInstructionFunction(Instruction).Name = 'println' then begin
    199         Reference := TSourceInstructionFunction(Instruction).Parameters[0];
    200         if Reference is TSourceReferenceConstant then begin
    201           Text := TSourceReferenceConstant(Reference).Constant.Value;
    202         end else
    203         if Reference is TSourceReferenceVariable then begin
    204           Text := Variables.Values[TSourceReferenceVariable(Reference).Variable.Name];
    205         end else raise Exception.Create('Unsupported reference');
    206         if Assigned(FOnOutput) then FOnOutput(Text + LineEnding);
    207       end else
    208       if TSourceInstructionFunction(Instruction).Name = 'assign' then begin
    209         Variable := nil;
    210         Reference := TSourceInstructionFunction(Instruction).Parameters[0];
    211         if Reference is TSourceReferenceVariable then begin
    212           Variable := TSourceReferenceVariable(Reference).Variable;
    213         end else raise Exception.Create('Unsupported reference');
    214         Reference := TSourceInstructionFunction(Instruction).Parameters[1];
    215         if Reference is TSourceReferenceConstant then begin
    216           Text := TSourceReferenceConstant(Reference).Constant.Value;
    217         end else
    218         if Reference is TSourceReferenceVariable then begin
    219           Text := Variables.Values[TSourceReferenceVariable(Reference).Variable.Name];
    220         end else raise Exception.Create('Unsupported reference');
    221         Variables.Values[Variable.Name] := Text;
    222       end else raise Exception.Create('Unsupported function: ' + TSourceInstructionFunction(Instruction).Name);
    223     end else raise Exception.Create('Unsupported instruction');
    224     Inc(IP);
    225   end;
    226145end;
    227146
    … …  
    235154end;
    236155
    237 function TSourceVariables.Find(Name: string): TSourceVariable;
    238 var
    239   I: Integer;
     156function TSourceVariables.Search(Name: string): TSourceVariable;
     157var
    240158  Variable: TSourceVariable;
    241159begin
    … …  
    268186{ TSourceCode }
    269187
     188procedure TSourceCode.InitFunctions;
     189var
     190  Funct: TSourceFunction;
     191begin
     192  Functions.Clear;
     193  Funct := Functions.AddNew('print');
     194  Funct.AddParameter('Text', pkString);
     195  Funct := Functions.AddNew('println');
     196  Funct.AddParameter('Text', pkString);
     197  Funct := Functions.AddNew('assign');
     198  Funct.AddParameter('Destination', pkVariable);
     199  Funct.AddParameter('Source', pkString);
     200  Funct := Functions.AddNew('inputln');
     201  Funct.AddParameter('Text', pkVariable);
     202end;
     203
    270204constructor TSourceCode.Create;
    271205begin
    … …  
    273207  Constants := TSourceConstants.Create;
    274208  Instructions := TSourceInstructions.Create;
     209  Functions := TSourceFunctions.Create;
     210  InitFunctions;
    275211end;
    276212
    277213destructor TSourceCode.Destroy;
    278214begin
     215  Functions.Free;
    279216  Variables.Free;
    280217  Constants.Free;
Note: See TracChangeset for help on using the changeset viewer.