home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 01 / levelki / lispio.inc < prev    next >
Encoding:
Text File  |  1988-09-29  |  4.8 KB  |  165 lines
  1. (*******************************************************)
  2. (*                     LISPIO.INC                      *)
  3. (*         Include-Modul des LittleLisp-Systems        *)
  4. (*          (C) 1988 Reinhard Häring & TOOLBOX         *)
  5. (*******************************************************)
  6.  
  7. FUNCTION clean(x:lstring):lstring;
  8.     VAR i:INTEGER;
  9.         xs,xss:lstring;
  10.     BEGIN
  11.       IF x='' THEN clean:=x ELSE BEGIN
  12.         i:=0; xs:=x;
  13.         REPEAT i:=i+1; IF NOT (x[i]=' ') THEN
  14.           BEGIN xs:=Copy(x,i,Length(x)); i:=MaxInt; END;
  15.         UNTIL i>=Length(x);
  16.         i:=Length(xs)+1; xss:=xs;
  17.         REPEAT i:=i-1; IF NOT (xs[i]=' ') THEN
  18.           BEGIN xss:=Copy(xs,1,i); i:=-1; END;
  19.         UNTIL i<=1;
  20.         clean:=xss;
  21.       END;
  22.     END;
  23.  
  24. FUNCTION inlist(xs:lstring):objp;
  25.   FUNCTION atom_string(x:lstring):BOOLEAN;
  26.     VAR i:INTEGER;
  27.     BEGIN
  28.       i:=1;
  29.       IF (Ord(x[1])>=Ord('0')) AND (Ord(x[1])<=Ord('9'))
  30.         THEN atom_string:=FALSE
  31.         ELSE BEGIN
  32.         atom_string:=TRUE;
  33.         REPEAT
  34.           IF Ord(x[i])>32 THEN i:=i+1 ELSE
  35.             BEGIN i:=MaxInt; atom_string:=FALSE; END;
  36.         UNTIL i>Length(x);
  37.        END;
  38.   END; {atom_string}
  39.   FUNCTION number_string(x:lstring):BOOLEAN;
  40.     VAR i:INTEGER; r:INTEGER;
  41.     BEGIN
  42.       Val(x,r,i);
  43.       number_string:=i=0;
  44.     END;
  45.   FUNCTION stringp(x:lstring):BOOLEAN;
  46.     BEGIN
  47.       stringp:=(x[1]='"') AND (x[Length(x)]='"');
  48.     END;
  49.   FUNCTION listp(x:lstring):BOOLEAN;
  50.     BEGIN
  51.       listp:=(x[1]='(') AND (x[Length(x)]=')');
  52.     END;
  53.   PROCEDURE list_convert(x:lstring; VAR p:pair);
  54.     VAR head,tail:objp;
  55.         content:lstring;
  56.         hs,ts,ts1,ts2,ts3:lstring;
  57.     PROCEDURE donix; BEGIN END;
  58.     FUNCTION space_pos(x:lstring):INTEGER;
  59.       VAR i,kl:INTEGER; stringp:BOOLEAN;
  60.       BEGIN
  61.         kl:=0; i:=0; space_pos:=-1; stringp:=FALSE;
  62.         REPEAT
  63.           i:=i+1;
  64.           CASE x[i] OF
  65.             '"': stringp:=NOT stringp;
  66.             ' ': IF (NOT stringp) AND (kl=0) THEN
  67.                    BEGIN space_pos:=i; i:=MaxInt; END;
  68.             '(': IF NOT stringp THEN kl:=kl+1;
  69.             ')': IF NOT stringp THEN kl:=kl-1;
  70.             ELSE donix;
  71.           END;
  72.         UNTIL i>=Length(x);
  73.       END;
  74.     FUNCTION head_string(x:lstring):lstring;
  75.       VAR i:INTEGER;
  76.       BEGIN
  77.         i:=space_pos(x);
  78.         IF i=-1 THEN head_string:=x
  79.           ELSE head_string:=clean(Copy(x,1,i-1))
  80.       END;
  81.     FUNCTION tail_string(x:lstring):lstring;
  82.       VAR i:INTEGER;
  83.       BEGIN
  84.         i:=space_pos(x);
  85.         IF i=-1 THEN tail_string:=''
  86.           ELSE tail_string:=clean(Copy(x,i+1,Length(x)));
  87.       END;
  88.     BEGIN
  89.       content:=clean(Copy(x,2,Length(x)-2));
  90.       hs:=head_string(content);
  91.       ts1:=tail_string(content); ts:='('+ts1+')';
  92.       ts2:=clean(ts1);
  93.       ts3:=Copy(ts2,2,255);
  94.       IF NOT (ts2[1]='.') THEN BEGIN
  95.         New(head); New(tail); head:=inlist(hs);
  96.         tail:=inlist(ts);
  97.         p.car:=head; p.cdr:=tail;
  98.       END ELSE BEGIN
  99.         New(head); New(tail); head:=inlist(hs);
  100.         tail:=inlist(ts3);
  101.         p.car:=head; p.cdr:=tail;
  102.       END;
  103.     END;
  104.   VAR cl:lstring;
  105.       i,p:INTEGER;
  106.       o:objp;
  107. BEGIN
  108.   cl:=clean(xs);
  109.   IF (cl='') OR (cl='()') THEN BEGIN
  110.      New(o); o^.typ:=-1; inlist:=o;
  111.   END
  112.   ELSE BEGIN
  113.     IF Ord(cl[1])=39 THEN
  114.       inlist:=inlist('(quote '+Copy(cl,2,255)+')');
  115.     IF number_string(cl) THEN BEGIN
  116.       Val(cl,i,p);
  117.       New(o); o^.typ:=0; o^.i:=i; inlist:=o;
  118.     END;
  119.     IF atom_string(cl) THEN
  120.       IF Ord(cl[1])=39 THEN
  121.         inlist:=inlist('(quote '+Copy(cl,2,255)+')')
  122.       ELSE BEGIN
  123.         New(o); New(o^.a); o^.a^:=cl;
  124.         o^.typ:=2; inlist:=o;
  125.       END;
  126.     IF stringp(cl) THEN BEGIN
  127.       New(o); New(o^.s);
  128.       o^.s^:=Copy(cl,2,Length(cl)-2);
  129.       o^.typ:=1; inlist:=o;
  130.     END;
  131.     IF listp(cl) THEN BEGIN
  132.       New(o); o^.typ:=3;
  133.       list_convert(cl,o^.o); inlist:=o;
  134.     END;
  135.   END;
  136. END;
  137.  
  138. FUNCTION outlist1(x1:objp;t:INTEGER):lstring;
  139.   VAR x:obj; s:lstring;   LABEL 99;
  140.   BEGIN
  141.     IF t>maxdepth THEN BEGIN
  142.       outlist1:='...';
  143.       GOTO 99;
  144.     END;
  145.     IF NOT(x1=NIL) THEN BEGIN
  146.     x:=x1^;
  147.     CASE x.typ OF
  148.       -1:outlist1:='()';
  149.       0:BEGIN Str(x.i,s); outlist1:=s; END;
  150.       1:outlist1:='"'+x.s^+'"';
  151.       2:outlist1:=x.a^;
  152.       3:IF list_format THEN
  153.           IF (x.o.cdr^.typ=3) OR (x.o.cdr^.typ=-1) THEN
  154.            outlist1:='('+outlist1(x.o.car,t+1)+' '+
  155.                      Copy(outlist1(x.o.cdr,t+1),2,255)
  156.           ELSE outlist1:='('+outlist1(x.o.car,t+1)+' . '+
  157.                          outlist1(x.o.cdr,t+1)+')'
  158.         ELSE  outlist1:='('+outlist1(x.o.car,t+1)+' . '
  159.                         +outlist1(x.o.cdr,t+1)+')';
  160.     ELSE outlist1:='()';
  161. END; END; 99:END;
  162.  
  163. FUNCTION outlist(x:objp):lstring;
  164.   BEGIN outlist:=outlist1(x,1); END;
  165.