home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 01 / levelki / lispfio.inc < prev    next >
Encoding:
Text File  |  1988-10-28  |  2.0 KB  |  76 lines
  1. (*******************************************************)
  2. (*                   LISPFIO.INC                       *)
  3. (*         Include-Modul des LittleLisp-Systems        *)
  4. (*          (C) 1988 Reinhard Häring & TOOLBOX         *)
  5. (*******************************************************)
  6.  
  7. {-- Lisp File IO --------------------------}
  8.  
  9. PROCEDURE read_file(a:objp);
  10.   VAR lfile:TEXT;
  11.       sexpr:lstring;
  12.       name:string20;
  13.  
  14.  PROCEDURE read_sexpr(VAR l:lstring);
  15.     LABEL 99;
  16.     VAR Line,h:lstring;
  17.         kl:INTEGER; strp:BOOLEAN;
  18.  
  19.     FUNCTION count_b(l:lstring):INTEGER;
  20.       VAR i,e:INTEGER;
  21.       BEGIN
  22.         e:=0;
  23.         FOR i:=1 TO Length(l) DO
  24.           IF l[i]='"' THEN strp:= NOT strp
  25.           ELSE IF NOT strp AND (l[i]='(') THEN e:=e+1
  26.           ELSE IF NOT strp AND (l[i]=')') THEN e:=e-1;
  27.         count_b:=e;
  28.       END;
  29.  
  30.     FUNCTION first(a:lstring):CHAR;
  31.       VAR i:INTEGER;
  32.       BEGIN
  33.         i:=1; first:=' ';
  34.         WHILE NOT(i>Length(a)) DO BEGIN
  35.           IF a[i]=' ' THEN
  36.             i:=i+1
  37.           ELSE BEGIN
  38.             first:=a[i]; i:=MaxInt;
  39.           END;
  40.         END;
  41.       END;
  42.  
  43.    BEGIN
  44.      kl:=0; l:=''; strp:=FALSE;
  45.      REPEAT
  46.        REPEAT
  47.          ReadLn(lfile,Line);
  48.        UNTIL first(Line)<>';';
  49.        IF Line<>'' THEN BEGIN
  50.          kl:=kl+count_b(Line); h:=clean(Line);
  51.          IF (Length(l)+1+Length(h))>255 THEN BEGIN
  52.            Write('Too Long:'); WriteLn(l);
  53.            l:='*error*';
  54. GOTO 99;
  55.          END;
  56.          l:=l+' '+h;
  57.        END;
  58.      UNTIL kl<=0;
  59.      l:=clean(l);
  60. 99:
  61.      IF strp THEN error('String not closed'+Line);
  62.      IF kl<0 THEN
  63.        error('Too many closing paranthesis '+Line);
  64.     END;
  65.  
  66.  BEGIN
  67.    IF a^.typ=2 THEN name:=a^.a^+'.lsp' ELSE
  68.    name:=a^.s^;
  69.    Assign(lfile,name); ReSet(lfile);
  70.    WHILE NOT Eof(lfile) DO BEGIN
  71.      read_sexpr(sexpr);
  72.      IF sexpr<>'*error*' THEN dummy:=eval(inlist(sexpr),base_env);
  73.    END;
  74.    Close(lfile);
  75.  END;
  76.