cmddrv.pas

Draak is a multi-language, macro compiler, meaning all syntax and code generation is defined in a si

(* cmddrv.pas: Please see the end of Draak.pas for copyright information      *)
(* This file may NOT be distributed without Draak.pas and is under the same   *)
(* licence agreement as Draak.pas.                                            *)
unit cmddrv;

interface

uses parser, hashs, classes, strutils, sysutils, contnrs, error, gmrdrv;

type
  PLocal = ^RLocal;
  RLocal = record
    returns: strArr;
    lvar: varArr;
    truth: (equal, Exists, notequal, Nonexists, greater, less, sElse, SEndif);
  end;

  TMacroDrv = class
    procedure execute(inNode: PParseNode); virtual; abstract;
   private
    Ferr: TError;
    Fgmr: TGmr;
    FoutCode: TStringList;
    FoutData: TStringList;
    Fvars: TVars;
    FsearchDirs: string;
    FgiantError: boolean;
   public
    property err: TError read Ferr write Ferr;
    property gmr: TGmr read Fgmr write Fgmr;
    property outCode: TStringList read FoutCode write FoutCode;
    property outData: TStringList read FoutData write FoutData;
    property vars: TVars read Fvars write Fvars;
    property searchDirs: string read FsearchDirs write FSearchDirs;
    property giantError: boolean read FgiantError write FgiantError;
  end;

  TMacro = class(TMacroDrv)
    constructor create;
    procedure execute(inNode: PParseNode); override;
    destructor destroy; override;
   private
    local: TStack;
    varHash: TStringHash;
    cmdExec: boolean;
    return: string;
    skipAhead: PHashAtom;
    whilePlace: PHashAtom;
    currentNum: cardinal;
    squelsh: boolean;
    logging: boolean;
    hasBeenTrue: boolean;
    procedure cmd(inMacro: PHashAtom; inNode: PParseNode);
    procedure varcmd(inMacro: PHashAtom; inNode: PParseNode);
    procedure hashcmd(inMacro: PHashAtom; inNode: PParseNode);
    procedure ifcmd(inMacro: PHashAtom; inNode: PParseNode);
    procedure extention(inMacro: PHashAtom; inNode: PParseNode);
    procedure results(inMacro: PHashAtom; inNode: PParseNode);
    function line(inMacro: PHashAtom; inNode: PParseNode): string;
    procedure execNode(inMacro: PHashAtom; inNode: PParseNode);
    procedure forloop(inMacro: PHashAtom; inNode: PParseNode);
    procedure varAdd(s: string; inNode: PParseNode);
    procedure varAltAdd(s: string; inNode: PParseNode);
    procedure lhs(inMacro: PHashAtom; inNode: PParseNode);
    procedure rhs(inMacro: PHashAtom; inNode: PParseNode);
    procedure alt(inMacro: PHashAtom; inNode: PParseNode);
    procedure extractType(inMacro: PHashAtom; inNode: PParseNode);
    procedure whileLoop(inMacro: PHashAtom; inNode: PParseNode);
    procedure compare(inMacro: PHashAtom; inNode: PParseNode);
    procedure compareEquiv(inMacro: PHashAtom; inNode: PParseNode);
    procedure partialCompare(inMacro: PHashAtom; inNode: PParseNode);
    procedure use(inMacro: PHashAtom; inNode: PParseNode);
    procedure basedTypeAdd(s: string; inNode: PParseNode);
    procedure typeAdd(s: string; inNode: PParseNode);
    procedure pushContext(s: string; inNode: PParseNode);
    procedure popContext;
    procedure saveContext(context: TVars);
    procedure loadContext(const s, harden: string);
    procedure hardenContext;
    procedure softenContext;
    procedure saveReturn(s: string; varSave: string = '');
    function localed(d: strArr): boolean;
//    procedure setLocal(d: strArr);
    procedure getNumber;
    function expand(s: string): string;
    procedure split(s: string; out data: strArr; minSize: word = 0);
  end;

implementation

uses filedrv, draak;

var numbers: string;

constructor TMacro.create;
begin
  FoutCode := TStringList.Create;
  FoutData := TStringList.Create;
  local := TStack.create;
  varHash := TStringHash.Create;
  cmdExec := true;
end;

destructor TMacro.destroy;
begin
  local.Destroy;
  varHash.Destroy;
  FoutCode.Destroy;
  FoutData.Destroy;
  vars.Destroy;
end;

procedure TMacro.execute(inNode: PParseNode);
begin
  local.Push(new(PLocal)); 
  if inNode = nil then
  begin
    local.Pop;
    PLocal(local.Peek).truth := Nonexists;
    exit;
  end;
  PLocal(local.Peek).truth := Exists;
  if inNode.point.special = true then
  begin
    return := inNode.point.name;
    local.Pop;
    saveReturn(return);
    return := '';
    exit;
  end;

  if inNode.point.Macros = nil then
  begin
    err.err('No macro defined for '+inNode.point.name);
    local.Pop;
    PLocal(local.Peek).truth := Exists;
    exit;
  end;
  try
    execNode(inNode.point.Macros, inNode);
  except on E: EDraakNoCompile do
  begin
    Err.err(E.Message+' on node '+inNode.point.name+', Line '+intToStr(inNode.line));
    giantError := true;
    exit;
  end; end;
  local.Pop;
  if local.Count > 0 then
    PLocal(local.Peek).truth := Exists;  
  if return <> '' then
  begin
    saveReturn(return); return := '';
  end;
end;

procedure TMacro.cmd(inMacro: PHashAtom; inNode: PParseNode);
var s: string; d: strArr;
begin
  split(inMacro.Macro, d, 2);
  if (cmdExec = false) AND (inMacro.Macro[1] <> 'I') then exit;
  case inMacro.macro[1] of
   'E': execute(inNode.children[strToInt(copy(d[1], 2, 5))-1]);
   'R': results(inMacro, inNode);
   'v': hashcmd(inMacro, inNode);
   'l': lhs(inMacro, inNode);
   'r': rhs(inMacro, inNode);
   'a': alt(inMacro, inNode);
   't': extractType(inMacro, inNode);
   'W': whileLoop(inMacro, inNode);
   'C': compare(inMacro, inNode);
   'I': ifcmd(inMacro, inNode);
   'F': forloop(inMacro, inNode);
   'g': getNumber;
   'Q': squelsh := not squelsh;
   'X': extention(inMacro, inNode);
   'b':
     begin
       skipAhead := inMacro;
       while skipAhead.next <> nil do
         skipAhead := skipAhead.next;
     end;
   'Z':
     begin
       s := expand(PChar(inMacro.Macro)+AnsiPos(' ', inMacro.Macro));
       err.err(s); giantError := true;
     end;
   'z':
     begin
       s := expand(PChar(inMacro.Macro)+AnsiPos(' ', inMacro.Macro));
       err.err(s);
     end;
   else err.err('Unknown command: ' + inMacro.macro);
  end;
end;

procedure TMacro.varcmd(inMacro: PHashAtom; inNode: PParseNode);
var s: string;
  dumbContext: TVars;
  i, o: word;
  d: strArr;
begin
  s := inMacro.Macro; split(s, d, 3);
  i := AnsiPos(' ', s);
  if i = 0 then
    i := length(s)+1;
  i := ansiPos(s[i-1], numbers);
  dumbContext := vars;
  for o := 1 to i do
    dumbContext := dumbContext.pop;
  case s[2] of
   'v': varAdd(PChar(s)+AnsiPos(' ', s), inNode);
   'V': varAltAdd(PChar(s)+AnsiPos(' ', s), inNode);
   't': typeAdd(PChar(s)+AnsiPos(' ', s), inNode);
   'T': basedTypeAdd(PChar(s)+AnsiPos(' ', s), inNode);
   'E': dumbContext.attachType(expand(PChar(s)+AnsiPos(' ', s)));
   'd': dumbContext.addDecl(PChar(s)+AnsiPos(' ', s));
   'D': dumbContext.addAltDecl(PChar(s)+AnsiPos(' ', s));
   'l': dumbContext.addLHS(PChar(s)+AnsiPos(' ', s));
   'r': dumbContext.addRHS(PChar(s)+AnsiPos(' ', s));
   'a': dumbContext.addALT(PChar(s)+AnsiPos(' ', s));
   'N': pushContext(PChar(s)+AnsiPos(' ', s), inNode);
   'n': popContext;
   'e': for o := 2 to length(d)-1 do dumbContext.addEquiv(expand(d[1]), expand(d[o]));
   's': dumbContext.saveLocal(PLocal(local.Peek).lvar);
   'S': PLocal(local.Peek).lvar := dumbContext.getLocal(expand(PChar(s)+AnsiPos(' ', s)));
   'c': saveContext(dumbContext);
   'C': loadContext(expand(d[1]), expand(d[2]));
   'U': dumbContext.dump;
   'X': dumbContext.rmVar(expand(d[1]));
   else err.err('Bad macro: '+s);
  end;
end;

procedure TMacro.hashcmd(inMacro: PHashAtom; inNode: PParseNode);
var d: strArr; i: byte;
begin
  split(inMacro.Macro, d, 4);
  if localed(d) = false then
  case d[1][1] of
    's': varHash.add(expand(d[2]), expand(d[3]));
    'u': varHash.remove(expand(d[2]));
    'i': varHash.inc(expand(d[2]), expand(d[3]));
    'a': varHash.append(expand(d[2]), expand(d[3]));
    'r': varHash.removeStr(expand(d[2]), expand(d[3]));
    'R': varHash.removeStrEnd(expand(d[2]), expand(d[3]));
    'A': varHash.strictAppend(expand(d[2]), expand(d[3]));
    'n': varHash.insert(expand(d[2]), expand(d[3]));
    'e': Self.saveReturn(varHash.len(expand(d[2])), (d[3]));
    'f': Self.saveReturn(varHash.first(expand(d[2])), (d[3]));
    'l': Self.saveReturn(varHash.last(expand(d[2])), (d[3]));
    'g': varHash.add(expand(d[4]), varHash.getSubStr(expand(d[2]), StrToInt(expand(d[3]))-1));
    'C': for i := 0 to 9 do PLocal(local.Peek).lvar[i] := '';
   else err.err('Bad variable usage: '+d[1]);
  end;
end;

procedure TMacro.ifcmd(inMacro: PHashAtom; inNode: PParseNode);
var d: strArr;
begin
  split(inMacro.Macro, d, 1);
  case d[1][1] of
   'e': if PLocal(local.Peek).truth <> exists       then cmdExec := false else cmdExec := true;
   'n': if PLocal(local.Peek).truth <> nonexists    then cmdExec := false else cmdExec := true;
   'E': if PLocal(local.Peek).truth <> Equal        then cmdExec := false else cmdExec := true;
   'N': if PLocal(local.Peek).truth <> Notequal     then cmdExec := false else cmdExec := true;
   'g': if PLocal(local.Peek).truth <> greater      then cmdExec := false else cmdExec := true;
   'G': if (PLocal(local.Peek).truth <> greater) AND (PLocal(local.Peek).truth <> Equal)
                                                    then cmdExec := false else cmdExec := true;
   'l': if PLocal(local.Peek).truth <> less         then cmdExec := false else cmdExec := true;
   'L': if (PLocal(local.Peek).truth <> less)    AND (PLocal(local.Peek).truth <> Equal)
                                                    then cmdExec := false else cmdExec := true;
   'S': begin cmdExec := true; hasBeenTrue := false; end;
   's':
    begin
      if length(d) >= 4 then
      begin
        d[2] := expand(d[2]); d[3] := expand(d[3]);
        hasBeenTrue := (cmdExec AND true) or hasBeenTrue;
        if d[2] = d[3] then
          PLocal(local.Peek).truth := Equal
        else
          PLocal(local.Peek).truth := notEqual;
        if PLocal(local.Peek).truth <> Equal then
          cmdExec := false
        else cmdExec := true;
      end else
      begin
        if hasBeenTrue = false then
          cmdExec := not(cmdExec)
        else
          cmdExec := false;
      end;
    end;
  end;
end;

procedure TMacro.extention(inMacro: PHashAtom; inNode: PParseNode);
var d: strArr; s: string;
  i: word;
begin
  split(inMacro.Macro, d, 2);
  s := '';
  for i:= 2 to length(d)-1 do s := s + d[i] + ' ';
  s := expand(s); 
  case d[1][1] of
    'a': err.assemble(s);
    'l': err.link(s);
    'c': err.compile(s);
    'U': use(inMacro, inNode);
    'e': logging := true;
    'd': logging := false;
    else err.err('Unknown Extension: ' + d[1]);
  end;
end;

procedure TMacro.results(inMacro: PHashAtom; inNode: PParseNode);
var s: string;
begin
  s := copy(inMacro.Macro, AnsiPos(' ', inMacro.Macro)+1, length(inMacro.Macro)-2);
  return := expand(s);
end;

function TMacro.line(inMacro: PHashAtom; inNode: PParseNode): string;
var s: string;
begin
  s := inMacro.Macro+1; result := expand(s);
end;

procedure TMacro.execNode(inMacro: PHashAtom; inNode: PParseNode);
var dumbNode: PHashAtom;
begin
  dumbNode := inMacro;//inNode.point.Macros;
  while dumbNode <> nil do
  begin
    if giantError = true then exit;
    if logging = true then err.stream(dumbNode.Macro); 
    case dumbNode.Macro[0] of
     '!': cmd(dumbNode, inNode);
     '@': if cmdExec = true then varcmd(dumbNode, inNode);
     '+': if (cmdExec = true) AND (squelsh = false) then outCode.Append(line(dumbNode, inNode));
     '*': if (cmdExec = true) AND (squelsh = false) then outData.Append(line(dumbNode, inNode));
     else
      err.err('Bad macro! ' + dumbNode.macro);
    end;
    if skipAhead <> nil then
    begin
      dumbNode := skipAhead.next;
      skipAhead := nil;
    end else
      dumbNode := dumbNode.next;
  end;
end;

procedure TMacro.forloop(inMacro: PHashAtom; inNode: PParseNode);
var dumbNode: PHashAtom;
  dumbParse: PParseNode;
  tempPoint: RHashNode;
  i, o, p: word;
  d: string;
begin
  dumbParse := inNode.children[strToInt(inMacro.Macro[AnsiPos('%', inMacro.Macro)])-1];
  if dumbParse = nil then
  begin
    dumbNode := inMacro.next;
    while not((dumbNode.Macro[0] = '!') AND (dumbNode.Macro[1] = 'F')) do
      dumbNode := dumbNode.next;
    skipAhead := dumbNode;
    PLocal(local.Peek).truth := Nonexists;
    exit;