hashs.pas

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

     current.lastALT := nil;
   end;
  end;
  new(dumbAtom);
  dumbAtom.next := nil;
  getMem(dumbAtom.Macro, length(s)+1);
  strcopy(dumbAtom.Macro, PChar(trim(s)));
  if current.lastALT = nil then
  begin
    current.ALT[length(current.ALT)-1] := dumbAtom;
  end
//    current.ALT := dumbAtom
  else
    current.lastALT.next := dumbAtom;
  current.lastALT := dumbAtom;
end;

procedure TVars.addDecl(const s: string);
var dumbAtom: PHashAtom;
begin
  trim(s);
  if current = nil then exit;
  new(dumbAtom);
  dumbAtom.next := nil;
  getMem(dumbAtom.Macro, length(s)+1);
  strcopy(dumbAtom.Macro, PChar(trim(s)));
  if current.lastDecl = nil then
    current.Decl := dumbAtom
  else
    current.lastDecl.next := dumbAtom;
  current.lastDecl := dumbAtom;
end;

procedure TVars.addAltDecl(const s: string);
var dumbAtom: PHashAtom;
begin
  trim(s);
  if current = nil then exit;
  new(dumbAtom);
  dumbAtom.next := nil;
  getMem(dumbAtom.Macro, length(s)+1);
  strcopy(dumbAtom.Macro, PChar(trim(s)));
  if current.lastAltDecl = nil then
    current.altDecl := dumbAtom
  else
    current.lastAltDecl.next := dumbAtom;
  current.lastAltDecl := dumbAtom;
end;

procedure TVars.clearCurrent;
begin
  current := nil;
end;

function TVars.pop: TVars;
begin
  result := next;
end;

function TVars.isEquiv(const s, base: string): boolean;
var baseTemp, sTemp: PVarNode;
 i: word;
begin
  result := false;
  if s = base then result := true;
  if base[1] = '$' then
  begin
    baseTemp := hashlookup(s);
    if baseTemp = nil then
        Raise EDraakNoCompile.Create('Error: Could not find type/var: '+s);
    for i := 0 to length(baseTemp.equiv)-1 do
      if base = baseTemp.equiv[i] then result := true
  end else
  begin
    baseTemp := hashlookup(base);
    if baseTemp = nil then
        Raise EDraakNoCompile.Create('Error: Could not find type/var: '+ base+' '+s);
    if baseTemp.isvar = true then
    begin
      baseTemp := baseTemp.typePtr;
      if baseTemp.name = s then result := true;
    end;
    for i := 0 to length(baseTemp.equiv)-1 do
      if s = baseTemp.equiv[i] then result := true;
    if (result = false){ and (baseTemp.baseType <> base)} then
    begin
      sTemp := hashLookup(s);
      if sTemp = nil then exit;
      if sTemp.isvar = true then
        sTemp := sTemp.typePtr;
      if (sTemp.baseType = s) AND (baseTemp.baseType = base) then exit;
      result := isEquiv(sTemp.baseType, baseTemp.baseType);
    end;
  end;
end;

procedure TVars.addEquiv(const s, base: string);
var temp, baseTemp: PVarNode;
 i: word;
begin
  temp := hashLookup(s); baseTemp := hashlookup(base);
  if temp = nil then begin err.err('No such type for equivalance: ' + s); exit; end;
  if baseTemp = nil then
    begin err.err('No such base type for equivalance: ' + base); exit; end;
  for i := 0 to length(baseTemp.equiv)-1 do
  begin
    if isEquiv(baseTemp.equiv[i], s) = true then continue;
    setLength(temp.equiv, length(temp.equiv)+1);
    temp.equiv[length(temp.equiv)-1] := baseTemp.equiv[i];
  end;
  setLength(temp.equiv, length(temp.equiv)+1);
  temp.equiv[length(temp.equiv)-1] := base;
end;

procedure TVars.saveLocal(const s: varArr);
begin
  current.local := s;
end;

function TVars.getLocal(const s: string): varArr;
var dumbNode: PVarNode;
begin
  dumbNode := hashLookup(s);
  if dumbNode = nil then exit;
  result := dumbNode.local;
end;

procedure TVars.saveContext(context: TVars);
begin
  current.context := PVars(context);
end;

function TVars.loadContext(const s: string): TVars;
var dumbNode: PVarNode;
begin
  dumbNode := hashLookup(s);
  if dumbNode = nil then result := nil
  else begin
    if dumbNode.isvar = true then
      result := TVars(dumbNode.typePtr.context)
    else
      result := TVars(dumbNode.context);
    if result = nil then exit;
    result.next := self;
  end;
end;

function TVars.hashLookup(const S: string; deep: integer = -1): PVarNode;
begin
  if deep = 0 then
  begin
    result := nil;
    exit;
  end;
  result := table[hash(s)];
  while (result <> nil) and (AnsiCompareText(result.name, s) <> 0) do
  begin
    result := result.next;
  end;
  if (hard = true) AND (result = nil) and (next <> nil) then
    result := first.hashLookup(s)
  else
  if (hard = false) AND (result = nil) AND (next <> nil) then
    result := next.hashLookup(s, deep-1);
end;

procedure TVars.dump;
var i, o: word;
  dumbVars: PVarNode;
  dumbAtom: PHashAtom;
  n: string;
  v, t: TStringList;
  s: ^TStringList;
begin
  v := TStringList.Create;
  t := TStringList.Create;
  t.append('<Goal> -> . ');
  for i := 0 to HashSize do
  begin
    dumbVars := table[i];
    while dumbVars <> nil do
    begin
{      if dumbVars.name[1] = '$' then
      begin
        dumbVars := dumbVars.next;
        continue;
      end;}
      n := dumbVars.name;
      if dumbVars.isvar = false then
      begin
        t.Append('@t ' + n + ' ' + dumbVars.baseType);
        s := @t;
      end else
      begin
        v.Append('@v ' + n + ' ' + dumbVars.typePtr.name);
        s := @v;
      end;
      if length(dumbVars.equiv) > 0 then
        for o := 0 to length(dumbVars.equiv)-1 do
          if dumbVars.equiv[o][1] <> '$' then
            v.append('@e ' + n + ' ' + dumbVars.equiv[o]);
      s.Append('!v C');
      for o := 0 to 9 do
        if dumbVars.local[o] <> '' then
          s.append('!v s ''' + intToStr((o+1) MOD 10) + ''' ' + dumbVars.local[o]);
      s.append('@s');
			dumbAtom := dumbVars.RHS;
      while dumbAtom <> nil do
      begin
        s.append('@r ' + dumbAtom.Macro);
        dumbAtom := dumbAtom.next;
      end;
			dumbAtom := dumbVars.LHS;
      while dumbAtom <> nil do
      begin
        s.append('@l ' + dumbAtom.Macro);
        dumbAtom := dumbAtom.next;
      end;
      for o := 0 to length(dumbVars.ALT)-1 do
      begin
	      dumbAtom := dumbVars.ALT[o];
        while dumbAtom <> nil do
        begin
          s.append('@a ' + dumbAtom.Macro);
          dumbAtom := dumbAtom.next;
        end;
      end;
			dumbAtom := dumbVars.Decl;
      while dumbAtom <> nil do
      begin
        s.append('@d ' + dumbAtom.Macro);
        dumbAtom := dumbAtom.next;
      end;
			dumbAtom := dumbVars.altDecl;
      while dumbAtom <> nil do
      begin
        s.append('@D ' + dumbAtom.Macro);
        dumbAtom := dumbAtom.next;
      end;
      s.append('');
      dumbVars :=dumbVars.next;
    end;
  end;
  t.AddStrings(v);
  t.SaveToFile(name+'.dgu');
//  err.stream(t.Text);
end;

procedure TVars.rmVar(const named: string);
var dumbNode, prevNode: PVarNode;
begin
  dumbNode := table[hash(named)];
  prevNode := dumbNode;
  if dumbNode.name = named then
  begin
    if dumbNode.isvar = false then exit;
    table[hash(named)] := dumbNode.next;
  end else
  begin
    while assigned(dumbNode) AND (dumbNode.name <> named) do
    begin
      prevNode := dumbNode;
      dumbNode := dumbNode.next;
    end;
    if not assigned(dumbNode) then exit;
    if dumbNode.isvar = false then exit;
    prevNode.next := dumbNode.next;
  end;
  dispose(dumbNode);
end;

procedure split(s: string; out data: strArr);
var ss: string;
 i, o: word;
begin
  ss := s; i := 0;
  while ss <> '' do
  begin
    while ss[1] = ' ' do
      delete(ss, 1, 1);
    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;
end;

destructor TStringHash.destroy;
var i: cardinal;
  dumbNode, nextNode: PStringHash;
begin
  for i := 0 to HashSize do
  begin
    dumbNode := table[i];
    while dumbNode <> nil do
    begin
      nextNode := dumbNode.next;
      dispose(dumbNode);
      dumbNode := nextNode;
    end;
  end;
end;

procedure TStringHash.add(s: string; data: string);
var i: word; dumbNode: PStringHash;
begin
  remove(s);
  i := hash(s);
  new(dumbNode);
  dumbNode.next := table[i];
  table[i] := dumbNode;
  dumbNode.name := s;
  split(data, dumbNode.data);
end;

procedure TStringHash.remove(s: string);
var dumbNode, aNode: PStringHash;
begin
  dumbNode := table[hash(s)];
  if dumbNode = nil then exit;
  if dumbNode.name = s then
  begin
    aNode := dumbNode;
    table[hash(s)] := dumbNode.next;
    setLength(aNode.data, 0);
    dispose(aNode);
    exit;
  end;
  while (dumbNode.next <> nil) AND (dumbNode.next.name <> s) do
    dumbNode := dumbNode.next;
  if (dumbNode.next = nil) AND (dumbNode.name <> s) then
    exit;
  aNode := dumbNode.next;
  dumbNode.next := dumbNode.next.next;
  setLength(aNode.data, 0);
  dispose(aNode);
end;

procedure TStringHash.removeStr(s: string; data: string);
var i, o: word;
  dumbNode: PStringHash;
begin
  dumbNode := table[hash(s)];
  if dumbNode = nil then exit;
  while (dumbNode.next <> nil) AND (dumbNode.name <> s) do
    dumbNode := dumbNode.next;
  if (dumbNode.next = nil) AND (dumbNode.name <> s) then
    exit;
  if length(dumbNode.data) > 0 then
  for i := 0 to length(dumbNode.data)-1 do
  begin
    if dumbNode.data[i] = data then
    begin
      if i <> length(dumbNode.data)-1 then
      for o := i to length(dumbNode.data)-2 do
        dumbNode.data[o] := dumbNode.data[o+1];
      setLength(dumbNode.data, length(dumbNode.data)-1);
      exit;
    end;
  end;
end;

procedure TStringHash.removeStrEnd(s: string; data: string);
var i, o: word;
  dumbNode: PStringHash;
begin
  dumbNode := table[hash(s)];
  if dumbNode = nil then exit;
  while (dumbNode.next <> nil) AND (dumbNode.name <> s) do
    dumbNode := dumbNode.next;
  if (dumbNode.next = nil) AND (dumbNode.name <> s) then
    exit;
  if length(dumbNode.data) > 0 then
  for i := length(dumbNode.data)-1 downto 0 do
  begin
    if dumbNode.data[i] = data then
    begin
      if i <> length(dumbNode.data)-1 then
      for o := i to length(dumbNode.data)-2 do
        dumbNode.data[o] := dumbNode.data[o+1];
      setLength(dumbNode.data, length(dumbNode.data)-1);
      exit;
    end;
  end;
end;

procedure TStringHash.inc(s, num: string);
var dumbNode: PStringHash;
 i: integer;
begin
  if num = '' then num := '1';
  i := hash(s);
  dumbNode := table[i];
  while (dumbNode <> nil) AND (dumbNode.name <> s) do
    dumbNode := dumbNode.next;
  if dumbNode = nil then exit;
  i := strToInt(dumbNode.data[0]);
  case num[1] of
   '|':
    begin
      delete(num, 1, 1);
      i := i OR strToInt(num);
    end;
   '^':
    begin
      delete(num, 1, 1);
      i := i XOR strToInt(num);
    end;
   '*':
    begin
      delete(num, 1, 1);
      i := i * strToInt(num);
    end;
   '\':
    begin
      delete(num, 1, 1);
      i := i DIV strToInt(num);
    end;
   '%':
    begin
      delete(num, 1, 1);
      i := i MOD strToInt(num);
    end;
   '&':
    begin
      delete(num, 1, 1);
      i := i AND strToInt(num);
    end;
   '>':
    begin
      delete(num, 1, 1);
      i := i SHR strToInt(num);
    end;
   '<':
    begin
      delete(num, 1, 1);
      i := i SHL strToInt(num);
    end;
   else
    begin
      system.Inc(i, strToInt(num));
    end;
  end;
  dumbNode.data[0] := intToStr(i);
end;

procedure TStringHash.append(s, data: string);
var i: word; dumbNode: PStringHash;
begin
  i := hash(s);
  dumbNode := table[i];
  while (dumbNode <> nil) AND (dumbNode.name <> s) do
    dumbNode := dumbNode.next;
  if dumbNode = nil then
    exit;
  setLength(dumbNode.data, length(dumbNode.data)+1);
  dumbNode.data[length(dumbNode.data)-1] := data;
end;

procedure TStringHash.strictAppend(s, data: string);
var i: word; dumbNode: PStringHash;
begin
  i := hash(s);
  dumbNode := table[i];
  while (dumbNode <> nil) AND (dumbNode.name <> s) do
    dumbNode := dumbNode.next;
  if dumbNode = nil then
    exit;
  if length(dumbNode.data) <> 0 then
  for i := 0 to length(dumbNode.data)-1 do
    if AnsiLowerCase(trim(dumbNode.data[i])) = AnsiLowerCase(trim(data)) then
      exit;
  setLength(dumbNode.data, length(dumbNode.data)+1);
  dumbNode.data[length(dumbNode.data)-1] := data;
end;

procedure TStringHash.insert(s, data: string);
var i: word; dumbNode: PStringHash;
begin
  i := hash(s);
  dumbNode := table[i];
  while (dumbNode <> nil) AND (dumbNode.name <> s) do
    dumbNode := dumbNode.next;
  if dumbNode = nil then
    exit;
  setLength(dumbNode.data, length(dumbNode.data)+1);
  for i := length(dumbNode.data)-1 downto 1 do
    dumbNode.data[i] := dumbNode.data[i-1];
  dumbNode.data[0] := data;
end;

function TStringHash.first(s: string): string;
var d: strArr;
begin
  d := lookup(s);
  if d = nil then result := ''
  else result := d[0];
end;

function TStringHash.last(s: string): string;
var d: strArr;
begin
  d := lookup(s);
  result := d[length(d)-1];
end;

function TStringHash.len(s: string): string;
var d: strArr;
begin
  d := lookup(s);
  if d = nil then result := ''
  else result := intToStr(length(d));
end;

function TStringHash.pos(s, data: string): string;
var i: word; dumbNode: PStringHash;
begin
  i := hash(s);
  dumbNode := table[i];
  while (dumbNode <> nil) AND (dumbNode.name <> s) do
    dumbNode := dumbNode.next;
  if dumbNode = nil then
    exit;
end;

function TStringHash.getSubStr(s: string; n: word): string;
var d: strArr;
begin
  d := lookup(s);
  if n >= length(d) then
    result := ''
  else
    result := d[n];
end;

function TStringHash.lookup(s: string): strArr;
var i: word;
 dumbNode: PStringHash;
begin
  result := nil;
  i := hash(s);
  dumbNode := table[i];
  while (dumbNode <> nil) AND (dumbNode.name <> s) do
    dumbNode := dumbNode.next;
  if dumbNode = nil then
    result := nil
  else
    result := dumbNode.data;
end;

end.