Newsgroup: it.comp.lang.pascal
Titolo: Extended_strings (ovvero stringhe di 2^18 caratteri)

Salve
mi sono cimentato nella realizzazione di questa unit dove si crea il tipo
estring (che può contenere fino a 2^18 caratteri) e relative funzioni
primarie. So che già esiste il tipo pchar che ha molte funzioni ma so anche
che pchar arriva al massimo a 64K caratteri. Il mio tipo anche se a scapito
della maggiore allocazione di memoria (le estring sono array di caratteri)
può arricare fino a circa il quadruplo dei pchar.
Qui di seguito trascrivo la Unit. Fatemi sapere cosa vi piace, cosa non vi
piace, come la ottimizzereste.
Grazie
Unit Extended_Strings;
{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! UNIT EXTENDED_STRINGS : Con questa Unit è possibile !
 ! utilizzare stringhe di lunghezza 2^18 caratteri.    !
 ! Sono state implementate le funzioni di maggior uti- !
 ! lizzo. La unit è stata scritta e compilata con TMT  !
 ! Pascal. Questo software può essere riprodotto in    !
 ! qualsiasi forma purchè venga menzionato l'autore e  !
 ! purchè non venga usata a scopo di lucro.            !
 ! La unit può essere alterata sotto esplicito consen- !
 ! so dell'autore.                                     !
 !                                                     !
 ! Autore : Giacomo Bellucci                           !
 ! E-mail : 
mill...@infinito.it
                       !
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
}
Interface
uses crt,strings,math;
const max=262144; {Indica la massima lunghezza della estring}
                  {max=2^18}
type estring = array[-2..max] of byte;
{Struttura delle estring : da -2 a 0 ci sono le cifre della rappresentazione
                           in base 256 della lunghezza della estring
                           da 1 a elength(estring) ci sono rappresentati i
ca-
                           ratteri della estring sotto forma di codice ascii
                           (numeri da 0 a 255)}
     vet = array[1..3] of byte;
Function eord(c:string):byte;
{Converte un carattere nel suo codice ascii}
Function elength(s:estring):longint;
{Restituisce la lunghezza della estring}
Procedure ewrite(s:estring);
{Stampa la estring senza tornare a capo in fondo alla riga}
Procedure ewriteln(s:estring);
{Stampa la estring e torna a capo in fondo alla riga}
Procedure es2s(estringa:estring ; var stringa:string);
{Converte una estring in una string}
Procedure s2es(stringa:string ; var estringa:estring);
{Converte una string in una estring}
Procedure enull(var estringa:estring);
{Esegue estringa:=''}
Procedure eques(var s1:estring ; s2:estring);
{Esegue s1:=s2}
Function eequ(s1,s2:estring):boolean;
{Restituisce TRUE<==>s1=s2}
Procedure b10b256(n:longint ; var vettore:vet);
{Converte un numeroda base 10 a base 256 e mette il risultato di massimo 4
cifre in vettore}
Procedure ecopy(s:estring ; i,len:longint ; var r:estring);
{Esegue il comando copy per estring e mette il risultato in r}
Procedure econcat(s1,s2:estring ; var s3:estring);
{Esegue s3:=s1+s2. Attenzione s3 non deve essere ne s1 ne s2}
Procedure edelete(var s:estring ; i,len:longint);
{Esegue il comando delete per estring}
Function instr(i:longint ; s,sub:estring):longint;
{Cerca sub in s a partire da i e ne restituisce la posizione oppure 0 nel
caso
che sub non venga trovata}
Function egreater(s1,s2:estring):boolean;
{Restituisce TRUE<==>s1>s2 nell'ordinamento lessicografico}
Function eminor(s1,s2:estring):boolean;
{Restituisce TRUE<==>s1<s2 nell'ordinamento lessicografico}
Implementation
Function eord(c:string):byte;
var i,f,m:byte;
begin
         i:=0;
         f:=255;
         while f-i>1 do begin
                 if (i+f) mod 2=0 then
                         m:=(i+f) div 2
                         else
                                 m:=(i+f-1) div 2;
                  if chr(m)>c then
                         f:=m
                         else
                                 i:=m;
          end;
          eord:=i;
end;
Function elength(s:estring):longint;
begin
         elength:=65536*s[-2]+256*s[-1]+s[0];
end;
Procedure ewrite(s:estring);
var i:longint;
begin
         for i:=1 to elength(s) do
                 write(chr(s[i]));
end;
Procedure ewriteln(s:estring);
begin
         ewrite(s);
         writeln;
end;
Procedure es2s(estringa:estring ; var stringa:string);
var i:longint;
begin
         stringa:='';
         i:=0;
         while (i<256) and (i<elength(estringa)) do begin
                 inc(i);
                 stringa:=stringa+chr(estringa[i]);
         end;
end;
Procedure enull(var estringa:estring);
begin
         s2es('',estringa);
end;
Procedure eques(var s1:estring ; s2:estring);
var i : longint;
begin
         for i:=-2 to elength(s2) do
                 s1[i]:=s2[i];
end;
Function eequ(s1,s2:estring):boolean;
var i,l1,l2:longint;
    flag:boolean;
begin
         flag:=true;
         l1:=elength(s1);
         l2:=elength(s2);
         if l1<>l2 then flag:=false;
         i:=0;
         while (flag) and (i<l1) do begin
                 inc(i);
                 if s1[i]<>s2[i] then flag:=false;
         end;
         eequ:=flag;
end;
Procedure s2es(stringa:string ; var estringa:estring);
var i : integer;
begin
         for i:=-2 to -1 do
                 estringa[i]:=0;
         estringa[0]:=length(stringa);
         for i:=1 to length(stringa) do
                 estringa[i]:=eord(copy(stringa,i,1));
end;
Procedure b10b256(n:longint ; var vettore:vet);
var temp,cifra:string;
    i:integer;
begin
         temp:=Hex(n);
         for i:=3 downto 1 do begin
                 cifra:=copy(temp,2*i+1,2);
                 vettore[i]:=hexval(cifra[1])*16+hexval(cifra[2]);
         end;
end;
Procedure ecopy(s:estring ; i,len:longint ; var r:estring);
var j,fine:longint;
    l:vet;
begin
         if (i>elength(s)) then
                 enull(r)
                 else
                         begin
                                 fine:=min(i+len-1,elength(s));
                                 b10b256(fine-i+1,l);
                                 for j:=-2 to 0 do
                                         r[j]:=l[j+3];
                                 for j:=i to fine do
                                         r[j-i+1]:=s[j];
                         end;
end;
Procedure econcat(s1,s2:estring ; var s3:estring);
var l1,l2,i:longint;
    l:vet;
begin
         l1:=elength(s1);
         l2:=elength(s2);
         b10b256(l1+l2,l);
         enull(s3);
         for i:=-2 to 0 do
                 s3[i]:=l[i+3];
         for i:=1 to l1 do
                 s3[i]:=s1[i];
         for i:=l1+1 to l1+l2 do
                 s3[i]:=s2[i-l1];
end;
Procedure edelete(var s:estring ; i,len:longint);
var s1,s2:estring;
begin
         ecopy(s,1,i-1,s1);
         ecopy(s,i+len,elength(s)-i-len+1,s2);
         econcat(s1,s2,s);
end;
Function instr(i:longint ; s,sub:estring):longint;
var j,l1,l2:longint;
    flag:boolean;
    temp:estring;
begin
         flag:=false;
         j:=i-1;
         l1:=elength(s);
         l2:=elength(sub);
         while (not flag) and (j<l1) do begin
                 inc(j);
                 enull(temp);
                 ecopy(s,j,l2,temp);
                 flag:=eequ(temp,sub);
         end;
         if flag then
                 instr:=j
                 else
                         instr:=0;
end;
Function egreater(s1,s2:estring):boolean;
var i,l1,l2:longint;
    flag1,flag2:boolean;
begin
         l1:=elength(s1);
         l2:=elength(s2);
         i:=0;
         flag1:=true;
         flag2:=true;
         while (i<min(l1,l2)) and (flag1) and (flag2) do begin
                 inc(i);
                 if s1[i]>s2[i] then
                         flag1:=false
                         else if s1[i]<s2[i] then
                                 flag2:=false;
         end;
         if not flag1 then egreater:=true;
         if not flag2 then egreater:=false;
         if (flag1) and (flag2) and (l1>l2) then
                 egreater:=true
                 else
                         if (flag1) and (flag2) and (l1=l2) then
                                 egreater:=false
end;
Function eminor(s1,s2:estring):boolean;
begin
         eminor:=egreater(s2,s1);
end;
end.

Troppo complicato.... si può fare di meglio.... e addirittura con lunghezza
superiore a 2^18 byte...
Se interessa a tutto il gruppo provvedo a realizzarne la unit e postarla..
su richiesta :-)
Cordialmente, Cooper.
"milliken" <milliken@infiTOGLI_QUESTOnito.it> ha scritto nel messaggio
news:a4esho$srk$1...@serv1.albacom.net...



Certo a me interesserebbe, comunque io mi gaserei di meno....!!!!!
E sei capace di farlo senza puntatori ?
Milliken

 > Troppo complicato.... si può fare di meglio.... e addirittura con


 aiutano sempre a crescere e a migliorarsi ^__^
beh anche io ti ho fatto delle critiche negative, vediamo se riuscirai a
crescere e a migliorare
Naturalmente non continuerò a discutere con te a meno che non ti tolga quel
tono saccente e superiore, e non risponderò ad altre polemiche ma solo a
pareri informatici seri e spuri da "gasamenti" di vario genere...
Ricordati che nessuno "nasce imparato" come dicono dalle mie parti. Un
giorno avrai bisogno di consigli di vario genere e quando qualcuno ti
risponderà con il tuo stesso tono allora forse capirai dove hai sbagliato...
Milliken

Ricorda, VERBA VOLANT SCRIPTA MANENT.   Non credo proprio di averti offeso o
detto che il codice fa schifo...
Quindi please rileggi meglio ciň che ho scritto... e le specifiche parole
che ho usato, penso sia opportuno per evitare inutili discussioni... che cmq
ti invito se ci tieni... a proseguire tramite email personale o direttamente
in chat...
Eviterň di rispondere a ulteriori battute di questa specie in questa sede,
nel rispetto degli altri che ci seguono, in quanto il tutto sta prendendo
forma di polemica e non di critica costruttiva.
Il perchč? Beh te l'ho detto... basta che leggi l'ultimo mio post... li
trovi la giustificazione della mia conclusione.
Infine, si sono un informatico... analista per l'esattezza.
Cordialmente, Cooper.
"milliken" <milliken@infiTOGLI_QUESTOnito.it> ha scritto nel messaggio
news:a4gb2m$ebl$1...@serv1.albacom.net...


it.discussioni.litigi
ciaooooooo
"milliken" <milliken@infiTOGLI_QUESTOnito.it> ha scritto nel messaggio
news:a4gb2m$ebl$1...@serv1.albacom.net...


>  ! lizzo. La unit è stata scritta e compilata con TMT  !
il TMT lavora a 32 bit no ?  i problemi elencati da Cooper non
dovrebbero esserci percio'... pero' penso che semplicemente
usando i PChar normali dovresti ottenere stringhe lunghe quanto
vuoi: la limitazione ai 64kb e' dovuta solo all'uso di compilatori
come il TP e il BP che lavorano a 16 bit, appena switchi a 32
non dovresti avere limiti se non la memoria :-)
(poi tutto dipende dal compilatore)
--
Dreadnaut
(Life would be easier if I had the source code)

Cordialmente, Cooper.
 a me interessa, grazie
 saluti
 
s...@col.it
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG