[Fdcil-cvs] dev/miracle2k/exercises .cvsignore,NONE,1.1 Cradle.pas,NONE,1.1

[Michael E. <mir...@us...>]

Update of /cvsroot/fdcil/dev/miracle2k/exercises
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4526/miracle2k/exercises

Added Files:
	.cvsignore Cradle.pas 
Log Message:
first tests

--- NEW FILE: .cvsignore ---
*.exe
*.dcuil
*.rsp
*.pdb
Model
--- NEW FILE: Cradle.pas ---
unit Cradle;

interface

uses
  SysUtils;

var
  Input: string;
  Curr: Integer;

  Look: char;

procedure GetChar;
procedure Error (s: string);
procedure Abort(s: string);
procedure Expected(s: string);
procedure Match(x: char);
function IsAlpha(c: char): boolean;
function IsDigit(c: char): boolean;
function IsAddOp(c: char): boolean;
function GetName: char;
function GetNum: char;
procedure Emit(s: string);
procedure EmitLn(s: string);
procedure Init;

implementation

procedure GetChar;
begin
  Inc(Curr);
  if Curr <= Length(Input) then
    Look := Input[Curr]
  else
    Look := #0;
end;

procedure Error(s: string);
begin
  WriteLn;
  WriteLn(^G, 'Error: ', s, '.');
end;

procedure Abort(s: string);
begin
  Error(s);
  raise Exception.Create;
end;

procedure Expected(s: string);
begin
  if s = #0 then
    Abort('Invalid characters at end of input')
  else
    Abort ( s + ' was expected.');
end;

procedure Match(x: char);
begin
  if Look = x then GetChar
  else Expected(x);
end ;

function IsAlpha(c: char): boolean;
begin
  IsAlpha := UpperCase(c)[1] in [ 'A'..'Z' ] ;
end;

function IsDigit(c: char): boolean;
begin
  IsDigit := c in [ '0'..'9' ] ;
end;

function IsAddOp(c: char): boolean;
begin
  Result := c in ['+', '-'];
end;

function GetName: char;
begin
  if not IsAlpha ( Look ) then Expected ( 'Name' );
  GetName := UpCase( Look );
  GetChar;
end;

function GetNum: char;
begin
  if not IsDigit ( Look ) then Expected ('Integer');
  GetNum := Look;
  GetChar;
end;

procedure Emit(s: string);
begin
  Write(#9 + s);
end;

procedure EmitLn(s: string);
begin
  Emit(s);
  Writeln;
end;

procedure Init;
begin
  Readln(Input);
  Curr := 0;
  GetChar;
end;

end.