cmddrv.pas

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

  for i := 0 to length(s1)-1 do
  begin
    if i >= length(s2) then break;
    if vars.isEquiv(s1[i], s2[i]) = false then
    begin
      PLocal(local.Peek).truth := notEqual;
      exit;
    end;
  end;
  PLocal(local.Peek).truth := Equal;
  current.returns[length(current.returns)-1] := s1[i-1];
end;

procedure TMacro.use(inMacro: PHashAtom; inNode: PParseNode);
var d: strArr; s, found, foundPas: string;
  parse: Parser.TParser;
  dumbGmr: TGmr; search: TSearchRec;
  tim: integer;
begin
  split(inMacro.Macro, d);
  s := expand(d[2]);
  if searchDirs = '' then searchDirs := '.';
  found := FileSearch(s+'.dgu', searchDirs);
  foundPas := FileSearch(s+'.pas', searchDirs);
  if found <> '' then
  begin
    findFirst(found, faAnyFile, search);
    tim := search.Time;
    if foundPas <> '' then
      findFirst(foundPas, faAnyFile, search)
    else
      search.Time := tim-1;
    if tim > search.Time then
    begin
      dumbGmr := TGmr.init(TFile.init((found)));
      pushContext(s, inNode);
      hardenContext;
      varHash.add('uses', 'True');
      execNode(dumbGmr.getGoal.Macros, inNode);
      varHash.remove('uses');
//      err.status(s+'.pas: Compiled! ' );
      softenContext;
      exit;
    end;
  end;
  if foundPas = '' then
    Raise EDraakNoCompile.Create('Cannot find unit "'+s+'"');
  parse := Parser.TParser.Create;
  parse.err := err;
  parse.parse(TFile.init(foundPas), gmr);
  pushContext(s, inNode);
  hardenContext;
  varHash.add('uses', 'True');
  try
  if parse.rootNode <> nil then
    Self.execute(parse.rootNode)
  else
  begin
    err.err('Error including unit: '+s);
    giantError := true;
    exit;
  end;
  varHash.remove('uses');
  except on E: EDraakNoCompile do
  begin
    err.err('Error including unit: '+s+'.  "'+E.Message+'"');
    giantError := true;
    exit;
  end; end;
//  err.status(s+'.pas: Compiled! ('+intToStr(parse.lines)+' lines)' );
  softenContext;
end;

procedure TMacro.typeAdd(s: string; inNode: PParseNode);
var name, base, temp, context: string;
 dumbContext: TVars;
 i, o: word; a: strArr;
begin
  temp := expand(s); split(temp, a);
  name := a[0]; base := a[1];
  if length(a) > 2 then context := a[2] else context := 'a';
  if vars.hashLookup(name, 1) <> nil then
  begin
    err.err('Type '+name+' already defined in current context');
    exit;
  end;
  dumbContext := vars;
  i := AnsiPos(context[1], numbers);
  for o := 1 to i do
    dumbContext := dumbContext.pop;
  dumbContext.addType(name, base);
end;

procedure TMacro.basedTypeAdd(s: string; inNode: PParseNode);
var name, base, temp, context: string;
 dumbContext: TVars;
 i, o: word; a: strArr;
begin
  temp := expand(s); split(temp, a);
  name := a[0]; base := a[1];
  if length(a) > 2 then context := a[2] else context := 'a';
  if vars.hashLookup(s, 1) <> nil then
  begin
    err.err('Type '+s+' already defined in current context');
    exit;
  end;
  dumbContext := vars;
  i := AnsiPos(context[1], numbers);
  for o := 1 to i do
    dumbContext := dumbContext.pop;
  dumbContext.addBasedType(name, base);
end;

procedure TMacro.pushContext(s: string; inNode: PParseNode);
var temp: string;
  tempVars: TVars;
begin
  temp := copy(s, 1, length(s));
  temp := expand(temp);
  if AnsiPos(' ', temp) <> 0 then
    temp := copy(temp, 1, AnsiPos(' ', temp)-1);
  tempVars := vars;
  vars := TVars.Create(temp, tempVars, err);
  vars.clearCurrent;
  tempVars.clearCurrent;
end;

procedure TMacro.popContext;
begin
  vars := vars.pop;
end;

procedure TMacro.saveContext(context: TVars);
begin
  context.saveContext(vars);
end;

procedure TMacro.loadContext(const s, harden: string);
var temp: TVars;
begin
  temp := vars.loadContext(s);
  if not(assigned(temp)) then
    PLocal(local.Peek).truth := Nonexists
  else begin
    vars := temp;
    PLocal(local.Peek).truth := Exists;
    if harden = '' then
      vars.harden := true
    else if harden[1] = 's' then
      vars.harden := false
    else
      vars.harden := true;
  end;
end;

procedure TMacro.hardenContext;
begin
  vars.harden := true;
end;
procedure TMacro.softenContext;
begin
  vars.harden := false;
end;

procedure TMacro.saveReturn(s: string; varSave: string = '');
var current: PLocal;
begin
  if (varSave = '') OR (varSave[1] = '$') then
  begin
    current := local.Peek;
    setLength(current.returns, length(current.returns)+1);
    current.returns[length(current.returns)-1] := s;
  end else
  begin
    varHash.add(varSave, s);
  end;
end;

function TMacro.localed(d: strArr): boolean;
{Deals with the local variables (1-9)}
var i, o: word;
 s: string;
begin
  if d[2] = '' then
  begin
    result := false;
    exit;
  end;
  if d[2] = '''''' then
  begin
    o := 0; result := true;
  end else
  if (d[2][1] = '''') AND (AnsiPos(d[2][2], numbers) <> 0) AND (d[2][3] = '''') then
  begin
    o := AnsiPos(d[2][2], numbers)-1;
    result := true;
  end else
  begin
    result := false; exit;
  end;
  case d[1][1] of
    's':
      begin
        s := d[3];
        for i := 4 to length(d)-1 do
          s := s + ' ' + d[i];
        s := expand(s);
        PLocal(local.Peek).lvar[o] := s;
      end;
    'u': PLocal(local.Peek).lvar[o] := '';
    'i':
     begin
       i := strToInt(PLocal(local.Peek).lvar[o]);
       system.Inc(i, strToInt(d[3]));
       PLocal(local.Peek).lvar[o] := intToStr(i);
     end;
    'a': PLocal(local.Peek).lvar[o] := PLocal(local.Peek).lvar[o] + ' ' + expand(d[3]);
   else err.err('Bad variable usage: '+d[1]);
  end;
end;

{procedure TMacro.setLocal(d: strArr);
var s: string; i: word;
begin
  s := d[3];
  for i := 4 to length(d)-1 do
    s := s + ' ' + d[i];
  s := expand(s);
  PLocal(local.Peek).lvar[0] := s;
end;}

procedure TMacro.getNumber;
//var current: PLocal;
begin
{  current := local.peek;
  setLength(current.returns, length(current.returns)+1);
  current.returns[length(current.returns)-1] := intToStr(currentNum);}
  saveReturn(intToStr(currentNum));
  inc(currentNum);
end;

function TMacro.expand(s: string): string;
var i, o, p: word; temp: string; tempStrs: strArr;
begin
  result := ''; tempStrs := nil;
  while s <> '' do
  begin
    i := ansipos('$', s); o := 0;
    if i = 0 then i := length(s)
    else o := AnsiPos(s[i+1], numbers);
    if o <> 0 then
    begin                                             
      result := result+copy(s, 1, i-1);
      if length(PLocal(local.peek).returns) < o then
      begin
        Raise EDraakNoCompile.Create('Error with lenth of returns and attempted usage there of');
      end;
      result := result+PLocal(local.peek).returns[o-1];
      delete(s, 1, 1);
    end
    else result := result+copy(s, 1, i);
    delete(s, 1, i);
  end;
  s := result;
  result := '';
  while s <> '' do
  begin
    i := ansipos('&', s);
    if i = 0 then
    begin
      result := result + copy(s, 1, length(s));
      delete(s, 1, length(s));
      continue;
    end;
    if s[i+1] = '''' then
    begin
      if s[i+2] = '''' then
      begin
        delete(s, i, 3);
        insert(PLocal(local.Peek).lvar[0], s, i);
        i := i + length(PLocal(local.Peek).lvar[0]);
      end else
      if (s[i+3] = '''') AND (AnsiPos(s[i+2], numbers) <> 0) then
      begin
        o := AnsiPos(s[i+2], numbers)-1;
        delete(s, i, 4);
        if (i <= length(s)) and (s[i] = '^') then
        begin
          delete(s, i, 1);
          insert('&'''+PLocal(local.Peek).lvar[o]+'''', s, i);
          continue;
        end;
        insert(PLocal(local.Peek).lvar[o], s, i);
        i := i + length(PLocal(local.Peek).lvar[o]);
      end else
      begin
        temp := copy(s, i+2, length(s));
        delete(temp, AnsiPos('''', temp), length(temp));
        delete(s, i, length(temp)+3);
        tempStrs := varHash.lookup(temp);
        p := i;
        if tempStrs <> nil then
        begin
          if (i <= length(s)) AND (s[i] = '^') then
          begin
            delete(s, i, 1);
            insert('&'''+tempStrs[0]+'''', s, p);
            continue;
          end;
          if (i+2 <= length(s)) AND (s[i] = '[') then
          begin
            temp := copy(s, i+1, length(s));
            delete(temp, AnsiPos(']', temp), length(temp));
            o := StrToInt(expand(temp))-1;
            delete(s, i, length(temp)+2);
            if (p <= length(s)) AND (s[p] = '^') then
            begin
              delete(s, p, 1);
              insert('&''''', s, p);
              insert(tempStrs[o], s, p+2);
              continue;
            end;
            insert(tempStrs[o]+' ', s, p);
            i := i+length(tempStrs[o]);
            delete(s, i, 1);
          end else
          begin
            for o := length(tempStrs)-1 downto 0 do
            begin
              insert(tempStrs[o]+' ', s, p);
              i := i+length(tempStrs[o]);
            end;
            delete(s, i+length(tempStrs)-1, 1);
          end;
        end;
      end;
    end;
    result := result + copy(s, 1, i-1);
    delete(s, 1, i-1);
    {Replace the var}
  end;
end;

procedure TMacro.split(s: string; out data: strArr; minSize: word = 0);
var ss: string;
 i, o: word;
begin
  ss := s; i := 0;
  while ss <> '' do
  begin
    while (ss <> '') AND (ss[1] = ' ') do
      delete(ss, 1, 1);
    if ss = '' then continue;
    setlength(data, i+1);
    o := AnsiPos(' ', ss);
    if o = 0 then o := length(ss)+1;
    data[i] := Copy(ss, 0, o-1);
    delete(ss, 1, o); i := i + 1;
  end;
//  if minSize > 0 then
    if length(data) < minSize then
      setLength(data, minSize);
end;

begin
  numbers := '1234567890';
end.