Newsgroup: it.comp.lang.pascal
Titolo: problema

Dovrei scrivere un programma che prendendo un file su mem di massa (su cui
e' presente un programma scritto in pascal), deve scrivere in output le
parole chiave(del linguaggio pascal) presenti nel programma (ordinate) e le
loro occorenze, e lo stesso x i simboli speciali (+,-,*,/,(,),<,etc..)  ed
anche per qualsiasi altro identificatore. (Il tutto in pascal standard)
La mia difficoltà consiste principalmente nel riconoscere il tipo di parola
letta e quindi come far si che il programma immeta tale parola nel corretto
albero binario.
Mi pare impossibile(o per lo meno poco corretto) definire un TYPE "pchiave"
di ca.40 elementi (che per giunta non me li accetta nemmeno) ed un altro di
ca. 20 per i simboli speciali.
Vi prego aiutatemi..
GRAZIE a tutti e ciao.


Cornuto ricchione!!!!!
Studia e fatti il progetto da solo!!!!!!!!!

albero binario.
Eccoti di seguito la soluzione.
Il programma adotta un sistema di riconoscimento basato su un automa a stati
finiti e inserisce la parola, al momento del riconoscimento, nel corretto albero
binario.
Si puo' ottimizzare perche' salti i commenti.
Il consumo di memoria, pero', e' altissimo, e per sorgenti molto grossi puo'
generare un "Heap Overflow Error".
E' consigliabile, quindi, scrivere le informazioni non in un albero binario, ma
in un file di testo da ordinare poi con il filtro "SORT" di WINDOWS.
Questo consentirebbe di ordinarle sia per ordine alfabetico, che per occorrenze.
uses crt;
const VALID_CHARS = ['A'..'Z', '0'..'9', '_'];
const KEYWORD : array [1..48] of string[14] =
('AND','ASM','ARRAY','BEGIN','CASE','CONST','CONSTRUCTOR','DESTRUCTOR',
 'DIV','DO','DOWNTO','ELSE','END','FILE','FOR','FUNCTION','GOTO','IF',
 'IMPLEMENTATION','IN','INLINE','INTERFACE','LABEL','MOD','NIL','NOT',
 'OBJECT','OF','OR','PACKED','PROCEDURE','PROGRAM','RECORD','REPEAT',
 'SET','SHL','SHR','STRING','THEN','TO','TYPE','UNIT','UNTIL','USES',
 'VAR','WHILE','WITH','XOR');
const PROC : array [1..138] of string[15] =
('APPEND','ARC','ASSIGN','ASSIGNCRT','BAR','BAR3D','BLOCKREAD',
 'BLOCKWRITE','CHDIR','CIRCLE','CLEARDEVICE','CLEARVIEWPORT','CLOSE',
 'CLOSEGRAPH','CLREOL','CLRSCR','DEC','DELAY','DELETE','DELLINE',
 'DETECTGRAPH','DISPOSE','DRAWPOLY','ELLIPSE','ERASE','EXEC','EXIT',
 'FILLCHAR','FILLELLIPSE','FILLPOLY','FINDFIRST','FINDNEXT','FLOODFILL',
 'FLUSH','FREEMEM','FSPLIT','GETARCCOORDS','GETASPECTRATIO','GETDATE',
 'GETCBREAK','GETDIR','GETFATTR','GETFILLPATTERN','GETFILLSETTINGS',
 'GETFTIME','GETIMAGE','GETINTVEC','GETLINESETTINGS','GETMEM',
 'GETMODERANGE','GETPALETTE','GETTEXTSETTINGS','GETTIME','GETVERIFY',
 'GETVIEWSETTINGS','GOTOXY','HALT','HIGHVIDEO','INC','INITGRAPH',
 'INSERT','INSLINE','INTR','KEEP','LINE','LINEREL','LINETO','LOWVIDEO',
 'MARK','MKDIR','MOVE','MOVEREL','MOVETO','MSDOS','NEW','NORMVIDEO',
 'NOSOUND','OUTTEXT','OUTTEXTXY','OVRCLEARBUF','OVRINIT','OVRINITEMS',
 'OVRSETBUF','PACKTIME','PIESLICE','PUTIMAGE','PUTPIXEL','RANDOMIZE',
 'READ','READLN','RECTANGLE','RELEASE','RENAME','RESET','RESTORECRTMODE',
 'REWRITE','RMDIR','RUNERROR','SECTOR','SEEK','SETACTIVEPAGE',
 'SETALLPALETTE','SETASPECTRATIO','SETBKCOLOR','SETCBREAK','SETCOLOR',
 'SETDATE','SETFATTR','SETFILLPATTERN','SETFILLSTYLE','SETFTIME',
 'SETGRAPHBUFSIZE','SETGRAPHMODE','SETINTVEC','SETLINESTYLE',
 'SETPALETTE','SETRGBPALETTE','SETTEXTBUF','SETTEXTJUSTIFY','SETTEXTSTYLE',
 'SETTIME','SETUSERCHARSIZE','SETVERIFY','SETVIEWPORT','SETVISUALPAGE',
 'SETWRITEMODE','SOUND','STR','SWAPVECTORS','TEXTBACKGROUND','TEXTCOLOR',
 'TEXTMODE','TRUNCATE','UNPACKTIME','VAL','WINDOW','WRITE','WRITELN');
const FUNC : array [1..86] of string[17] =
('ABS','ADDR','ARCTAN','CHR','CONCAT','COPY','COS','CSEG','DISKFREE',
 'DISKSIZE','DOSEXITCODE','DOSVERSION','DSEG','ENVCOUNT','ENVSTR',
 'EOF','EOLN','EXP','FEXPAND','FILEPOS','FILESIZE','FRAC','FSEARCH',
 'GETBKCOLOR','GETCOLOR','GETDEFAULTPALETTE','GETDRIVERNAME','GETENV',
 'GETGRAPHMODE','GETMAXCOLOR','GETMAXMODE','GETMAXX','GETMAXY',
 'GETMODENAME','GETPALETTESIZE','GETPIXEL','GETX','GETY','GRAPHERRORMSG',
 'GRAPHRESULT','HI','IMAGESIZE','INSTALLUSERDRIVER','INSTALLUSERFONT','INT',
 'IORESULT','KEYPRESSED','LENGTH','LN','LO','MAXAVAIL','MEMAVAIL','ODD',
 'OFS','ORD','OVRGETBUF','OVRGETRETRY','PARAMCOUNT','PARAMSTR','PI','POS',
 'PRED','PTR','RANDOM','READKEY','REGISTERBGIDRIVER','REGISTERBGIFONT',
 'ROUND','SEEKEOF','SEEKEOLN','SEG','SIN','SIZEOF','SPTR','SQR','SQRT',
 'SSEG','SUCC','SWAP','TEXTHEIGHT','TEXTWIDTH','TRUNC','TYPEOF','UPCASE',
 'WHEREX','WHEREY');
const END_OF_FILE = -1;
type  ptr_nodo_albero = ^nodo_albero;
      nodo_albero = record
                      ptr_parola : ^string;
                      peso : word;
                      sinistra, destra : ptr_nodo_albero;
                    end;
var f : file;
    state, c : integer;
    buffer : string;
    exit_flag : boolean;
    procedures_tree,
    functions_tree,
    identifiers_tree,
    keywords_tree,
    numeric_constants_tree,
    operators_tree : ptr_nodo_albero;
    procedure inserisci_parola(var nodo : ptr_nodo_albero; parola : string);
    var nodo_temp : ptr_nodo_albero;
    begin
      new(nodo_temp);
      nodo_temp^.peso := 1;
      nodo_temp^.sinistra := nil;
      nodo_temp^.destra := nil;
      getmem(nodo_temp^.ptr_parola, length(parola)+1);
      nodo_temp^.ptr_parola^ := parola;
      if (nodo = nil) then
        nodo := nodo_temp
      else
      if (nodo^.ptr_parola^ = parola) then
      begin
        freemem(nodo_temp^.ptr_parola, length(parola)+1);
        dispose(nodo_temp);
        inc(nodo^.peso);
      end
      else
      if (nodo^.ptr_parola^ > parola) then
      begin
        if (nodo^.sinistra <> nil) then
           inserisci_parola(nodo^.sinistra, parola)
        else
           nodo^.sinistra := nodo_temp;
      end
      else
      if (nodo^.ptr_parola^ < parola) then
      begin
        if (nodo^.destra <> nil) then
           inserisci_parola(nodo^.destra, parola)
        else
           nodo^.destra := nodo_temp;
      end
    end;
    procedure scrivi_albero(nodo : ptr_nodo_albero);
    begin
      if (nodo^.sinistra <> nil) then scrivi_albero(nodo^.sinistra);
      writeln('("'+nodo^.ptr_parola^+'",',nodo^.peso,')');
      if (nodo^.destra <> nil) then scrivi_albero(nodo^.destra);
    end;
    function fgetc(var f : file) : integer;
    var b : byte;
    begin
      if eof(f) then fgetc := END_OF_FILE
      else
      begin
        blockread(f, b, 1);
        fgetc := ord(upcase(char(b)));
      end;
    end;
    function is_procedure(s : string) : boolean;
    var i : integer;
    begin
      is_procedure := FALSE;
      for i := 1 to 138 do
        if (s = PROC[i]) then
        begin
          is_procedure := TRUE;
          exit;
        end
    end;
    function is_keyword(s : string) : boolean;
    var i : integer;
    begin
      is_keyword := FALSE;
      for i := 1 to 48 do
        if (s = KEYWORD[i]) then
        begin
          is_keyword := TRUE;
          exit;
        end
    end;
    function is_function(s : string) : boolean;
    var i : integer;
    begin
      is_function := FALSE;
      for i := 1 to 86 do
        if (s = FUNC[i]) then
        begin
          is_function := TRUE;
          exit;
        end
    end;
begin
  assign(f, paramstr(1)); reset(f, 1);
  exit_flag := FALSE;
  procedures_tree := nil;
  functions_tree := nil;
  identifiers_tree := nil;
  keywords_tree := nil;
  numeric_constants_tree := nil;
  operators_tree := nil;
  buffer := '';
  state := 0;
  while (state <> 99) do
  begin
    case state of
      0 : begin
            c := fgetc(f);
            if c = END_OF_FILE then
            begin
              exit_flag := TRUE;
              state := 6;
            end
            else
            case char(c) of
              '<' : state := 1;
              '>' : state := 2;
              '=' : state := 3;
              ':' : state := 4;
              '+',
              '-',
              '*',
              '/' : state := 5;
              else
              state := 6;
            end;
          end;
      1 : begin
            c := fgetc(f);
            if c = END_OF_FILE then state := 99
            else
            case char(c) of
              '=' : begin
                      inserisci_parola(operators_tree, '<=');
                      state := 6;
                    end;
            else
              begin
                inserisci_parola(operators_tree, '<');
                state := 6;
              end;
            end;
          end;
      2 : begin
            c := fgetc(f);
            if c = END_OF_FILE then state := 99
            else
            case char(c) of
              '=' : begin
                      inserisci_parola(operators_tree, '>=');
                      state := 6;
                    end;
            else
              begin
                inserisci_parola(operators_tree, '>');
                state := 6;
              end;
            end;
          end;
      3 : begin
            inserisci_parola(operators_tree, '=');
            state := 6;
          end;
      4 : begin
            c := fgetc(f);
            if c = END_OF_FILE then state := 99
            else
            case char(c) of
              '=' : begin
                      inserisci_parola(operators_tree, ':=');
                      state := 6;
                    end;
            else
              state := 6;
            end;
          end;
      5 : begin
            inserisci_parola(operators_tree, char(c));
            state := 6;
          end;
      6 : begin
            if (char(c) in VALID_CHARS) then buffer := buffer + char(c)
            else
            if (buffer <> '') then
            begin
              if buffer[1] in ['0'..'9'] then
                 inserisci_parola(numeric_constants_tree, buffer)
              else
              if is_procedure(buffer) then
                 inserisci_parola(procedures_tree, buffer)
              else
              if is_function(buffer) then
                 inserisci_parola(functions_tree, buffer)
              else
              if is_keyword(buffer) then
                 inserisci_parola(keywords_tree, buffer)
              else
                 inserisci_parola(identifiers_tree, buffer);
              buffer := '';
            end;
            if (exit_flag) then state := 99 else state := 0;
          end;
      99 :
    end;
  end;
  close(f);
  writeln('Costanti numeriche');
  writeln('------------------');
  scrivi_albero(numeric_constants_tree);
  writeln;
  writeln('Operatori');
  writeln('---------');
  scrivi_albero(operators_tree);
  writeln;
  writeln('Identificatori');
  writeln('--------------');
  scrivi_albero(identifiers_tree);
  writeln;
  writeln('Parole chiave');
  writeln('-------------');
  scrivi_albero(keywords_tree);
  writeln;
  writeln('Funzioni');
  writeln('--------');
  scrivi_albero(functions_tree);
  writeln;
  writeln('Procedure');
  writeln('---------');
  scrivi_albero(procedures_tree);
end.
Andrea (mica uno qualunque...)
------------------------------
(se mi mandi la spam ti metto un'aspirina nella fanta...)
--
Posted from 
itaca.ulysse.it
 [195.223.254.1]
via Mailgate.ORG Server - 
http://www.mailgate.org