Changeset 63

Timestamp:

Jul 17, 2012, 10:54:18 AM (12 years ago)

Author:

chronos

Message:

• Fixed: Procedure/function header and body not paired properly.

Location:

trunk/Compiler

Files:

• Analyze/UAnalyzerPascal.pas (modified) (2 diffs)
• Target/Delphi/UProducerPascal.pas (modified) (2 diffs)
• Target/XML/UTargetXML.pas (modified) (3 diffs)
• USourceCode.pas (modified) (1 diff)

trunk/Compiler/Analyze/UAnalyzerPascal.pas

@@ -76 +76 @@
   SUnitNotFound = 'Unit "%s" not found.';
   SFunctionNotDeclared = 'Function "%s" not declared.';
+  SFunctionRedefinition = 'Function "%s" redefined.';
   SUnknownProcName = 'Unknown proc name "%s".';
   SUnknownModuleType = 'Unknown module name "%s".';
@@ -703 +704 @@
       end;
     end else begin
-      // Create new function
-      UseFunction := TFunction.Create;
-      UseFunction.Parent := SourceCode.Parent;
-      UseFunction.Name := UseName;
-      UseFunction.FunctionType := FunctionType;
-      UseFunction.Exported := Exported;
-      Add(UseFunction);
-      UseFunction.Parent.Order.Add(UseFunction);
-      ValidParams := False;
+      UseFunction := SourceCode.Search(UseName, True);
+      if not Assigned(UseFunction) then begin
+        // Create new function
+        UseFunction := TFunction.Create;
+        UseFunction.Parent := SourceCode.Parent;
+        UseFunction.Name := UseName;
+        UseFunction.FunctionType := FunctionType;
+        UseFunction.Exported := Exported;
+        Add(UseFunction);
+        UseFunction.Parent.Order.Add(UseFunction);
+        ValidParams := False;
+      end else begin
+        if not UseFunction.BodyLoaded then UseFunction.BodyLoaded := True
+          else begin
+            ErrorMessage(SFunctionRedefinition, [UseName]);
+            Exit;
+          end;
+      end;
     end;
     with UseFunction do begin

trunk/Compiler/Target/Delphi/UProducerPascal.pas

@@ -101 +101 @@
     Module.TargetFile := Module.Name + '.dpr';
     EmitLn('program ' + Name + ';');
+    EmitLn;
+    EnitLn('{$APPTYPE Console}');
     EmitLn;
     GenerateUses(UsedModules);
@@ -505 +507 @@
 end;
 
-
-
 end.

trunk/Compiler/Target/XML/UTargetXML.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, UTarget;
+  Classes, SysUtils, UTarget, UProducer, USourceCode;
 
 type
@@ -16 +16 @@
   end;
 
+  { TProducerXML }
+
+  TProducerXML = class(TProducer)
+  private
+    procedure GenerateModule(Module: TModule);
+    procedure GenerateUnit(Module: TModule);
+    procedure GenerateLibrary(Module: TModule);
+    procedure GeneratePackage(Module: TModule);
+  public
+    procedure AssignToStringList(Target: TStringList); override;
+    procedure Produce(Module: TModule); override;
+  end;
+
+
 implementation
+
+{ TProducerXML }
+
+procedure TProducerXML.GenerateModule(Module: TModule);
+begin
+  Module.TargetFile := Module.Name + '.xml';
+  if Module is TModuleProgram then
+  with TModuleProgram(Module) do begin
+    EmitLn('<?xml version="1.0"?>');
+    EmitLn('<program>');
+    //GenerateUses(UsedModules);
+    //GenerateCommonBlockImplementation(Body, '');
+    EmitLn('</program>');
+  end;
+  if Module is TModuleUnit then GenerateUnit(Module)
+  else if Module is TModuleLibrary then GenerateLibrary(Module)
+  else if Module is TModulePackage then GeneratePackage(Module);
+end;
+
+procedure TProducerXML.GenerateUnit(Module: TModule);
+begin
+  EmitLn('<?xml version="1.0"?>');
+  EmitLn('<unit>');
+  //GenerateUses(UsedModules);
+  //GenerateCommonBlockImplementation(Body, '');
+  EmitLn('</unit');
+end;
+
+procedure TProducerXML.GenerateLibrary(Module: TModule);
+begin
+  EmitLn('<?xml version="1.0"?>');
+  EmitLn('<library>');
+  //GenerateUses(UsedModules);
+  //GenerateCommonBlockImplementation(Body, '');
+  EmitLn('</library>');
+end;
+
+procedure TProducerXML.GeneratePackage(Module: TModule);
+begin
+  EmitLn('<?xml version="1.0"?>');
+  EmitLn('<package>');
+  //GenerateUses(UsedModules);
+  //GenerateCommonBlockImplementation(Body, '');
+  EmitLn('</package>');
+end;
+
+procedure TProducerXML.Produce(Module: TModule);
+begin
+  GenerateModule(Module);
+end;
+
+procedure TProducerXML.AssignToStringList(Target: TStringList);
+begin
+  Target.Assign(TextSource);
+end;
 
 { TTargetXML }
@@ -25 +94 @@
   SysName := 'XML';
   Name := 'XML';
+  Producer := TProducerXML.Create;
 end;
 

trunk/Compiler/USourceCode.pas

@@ -305 +305 @@
     ResultType: TType;
     Exported: Boolean;
+    BodyLoaded: Boolean;
     constructor Create; override;
     destructor Destroy; override;