Smart pascal source code


type
  TMyClass = class
    procedure WriteLnMyName; virtual;
  end;
type
  TChild = class(TMyClass)
    procedure WriteLnMyName; override;
  end;

procedure TMyClass.WriteLnMyName;
begin
  Writeln('Ancestor: ' + ClassName);
end;

procedure TChild.WriteLnMyName;
begin
  Writeln('I''m ' + ClassName);
end;

{ main.pas }

var
   o: TObject;
   c: TClass;
  mc: TMyClass;
  cc: TClass;

Begin

  o := TObject.ClassType.Create;
  c := o.ClassType;
  Writeln(TObject.ClassName);
  Writeln(o.ClassName);
  Writeln(c.ClassName);
  o := c.Create;
  Writeln(o.ClassName);

  mc := TMyClass.Create;
  cc := mc.ClassType;
  mc.WriteLnMyName;
  Writeln(TMyClass.ClassType.ClassName);
  Writeln(cc.ClassName);

  mc := TChild.Create;
  cc := mc.ClassType;
  mc.WriteLnMyName;
  Writeln(TChild.ClassType.ClassName);
  Writeln(cc.ClassName);


{ <<< CONSOLE OUTPUTS >>>
  TObject
  TObject
  TObject
  TObject
  Ancestor: TMyClass
  TMyClass
  TMyClass
  I'm TChild
  TChild
  TChild
}

var Exception={
	$ClassName: "Exception",
	$Parent: TObject,
	$Init: function () { FMessage="" },
	Create: function (s,Msg) { s.FMessage=Msg; return s }
}
function $ToClassType(o) {
	if (o===null) return o;
	return o.ClassType
}
;
function $NewDyn(c,z) {
	if (c==null) throw Exception.Create($New(Exception),"ClassType is nil"+z);
	var i={ClassType:c};
	c.$Init(i);
	return i
}

      var o = null;
      var c = null;
      var mc = null;
      var cc = null;
      o = TObject.Create($NewDyn(TObject.ClassType(TObject),""));
      c = TObject.ClassType(o.ClassType);
      WriteLn(ClassName$1(TObject));
      WriteLn(ClassName$1($ToClassType(o)));
      WriteLn(ClassName$1(c));
      o = TObject.Create($NewDyn(c,""));
      WriteLn(ClassName$1($ToClassType(o)));
      mc = TObject.Create($New(TMyClass$1));
      cc = TObject.ClassType(mc.ClassType);
      TMyClass$1.WriteLnMyName$(mc);
      WriteLn(ClassName$1(TObject.ClassType(TMyClass$1)));
      WriteLn(ClassName$1(cc));
      mc = TObject.Create($New(TChild));
      cc = TObject.ClassType(mc.ClassType);
      TMyClass$1.WriteLnMyName$(mc);
      WriteLn(ClassName$1(TObject.ClassType(TChild)));
      WriteLn(ClassName$1(cc));
	  
/// TMyClass = class (TObject)
///  [line: 72, column: 3, file: uMain]
var TMyClass$1 = {
   $ClassName:"TMyClass",$Parent:TObject
   ,$Init:function ($) {
      TObject.$Init($);
   }
   /// procedure TMyClass.WriteLnMyName()
   ///  [line: 80, column: 20, file: uMain]
   ,WriteLnMyName:function(Self) {
      WriteLn(("Ancestor: "+TObject.ClassName(Self.ClassType)));
   }
   ,Destroy:TObject.Destroy
   ,WriteLnMyName$:function($){return $.ClassType.WriteLnMyName($)}
};
/// TChild = class (TMyClass)
///  [line: 76, column: 3, file: uMain]
var TChild = {
   $ClassName:"TChild",$Parent:TMyClass$1
   ,$Init:function ($) {
      TMyClass$1.$Init($);
   }
   /// procedure TChild.WriteLnMyName()
   ///  [line: 85, column: 18, file: uMain]
   ,WriteLnMyName:function(Self) {
      WriteLn(("I'm "+TObject.ClassName(Self.ClassType)));
   }
   ,Destroy:TObject.Destroy
   ,WriteLnMyName$:function($){return $.ClassType.WriteLnMyName($)}
};