home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 300-399 / ff386.lzh / XLispStat / src1.lzh / XLisp / xlpp.c < prev    next >
C/C++ Source or Header  |  1990-10-03  |  4KB  |  161 lines
  1. /* xlpp.c - xlisp pretty printer */
  2. /* Copyright (c) 1989, by David Michael Betz.                            */
  3. /* You may give out copies of this software; for conditions see the file */
  4. /* COPYING included with this distribution.                              */
  5.  
  6. #include "xlisp.h"
  7. #include "osdef.h"
  8. #ifdef ANSI
  9. #include "xlproto.h"
  10. #include "xlsproto.h"
  11. #else
  12. #include "xlfun.h"
  13. #include "xlsfun.h"
  14. #endif ANSI
  15. #include "xlvar.h"
  16.  
  17. /* forward declarations */
  18. #ifdef ANSI
  19. void ppterpri(void),ppputc(char),ppexpr(LVAL),pplist(LVAL),pp(LVAL);
  20. int flatsize(LVAL);
  21. #else
  22. #endif ANSI
  23.  
  24. /* local variables */
  25. static int pplevel,ppmargin,ppmaxlen;
  26. static LVAL ppfile;
  27.  
  28. /* xpp - pretty-print an expression */
  29. LVAL xpp()
  30. {
  31.     LVAL expr;
  32.  
  33.     /* get expression to print and file pointer */
  34.     expr = xlgetarg();
  35.     ppfile = (moreargs() ? xlgetfile() : getvalue(s_stdout));
  36.     xllastarg();
  37.  
  38.     /* pretty print the expression */
  39.     pplevel = ppmargin = 0; ppmaxlen = 40;
  40.     pp(expr); ppterpri(); /* argument removed - L. Tierney */
  41.  
  42.     /* return nil */
  43.     return (NIL);
  44. }
  45.  
  46. /* pp - pretty print an expression */
  47. LOCAL void pp(expr)
  48.   LVAL expr;
  49. {
  50. #ifndef XLISP_ONLY
  51. /*************************************************************************/
  52. /*         Lines below added to allow for common lisp arrays             */
  53. /*         Luke Tierney, March 1, 1988                                   */
  54. /*************************************************************************/
  55.  
  56.   if (displacedarrayp(expr)) {
  57.     extern LVAL array_to_nested_list();
  58.     LVAL value;
  59.  
  60.     /* protect a pointer */
  61.     xlsave1(value);
  62.   
  63.     ppputc('#');
  64.     value = cvfixnum((FIXTYPE) arrayrank(expr));
  65.     ppexpr(value);
  66.     ppputc('A');
  67.     value = array_to_nested_list(expr);
  68.     if (value ==NULL) {
  69.       ppputc('(');
  70.       ppputc(')');
  71.   }
  72.   else
  73.     pplist(value);
  74.   
  75.   /* restore the stack frame */
  76.   xlpop();
  77.     return;
  78.   }
  79.     
  80. /*************************************************************************/
  81. /*        Lines above added to allow for common lisp arrays              */
  82. /*        Luke Tierney, March 1, 1988                                    */
  83. /*************************************************************************/
  84. #endif /* XLISP_ONLY */
  85.     if (consp(expr))
  86.     pplist(expr);
  87.     else
  88.     ppexpr(expr);
  89. }
  90.  
  91. /* pplist - pretty print a list */
  92. LOCAL void pplist( expr)
  93.   LVAL expr;
  94. {
  95.     int n;
  96.  
  97.     /* if the expression will fit on one line, print it on one */
  98.     if ((n = flatsize(expr)) < ppmaxlen) {
  99.     xlprint(ppfile,expr,TRUE);
  100.     pplevel += n;
  101.     }
  102.  
  103.     /* otherwise print it on several lines */
  104.     else {
  105.     n = ppmargin;
  106.     ppputc('(');
  107.     if (atom(car(expr))) {
  108.         ppexpr(car(expr));
  109.         ppputc(' ');
  110.         ppmargin = pplevel;
  111.         expr = cdr(expr);
  112.     }
  113.     else
  114.         ppmargin = pplevel;
  115.     for (; consp(expr); expr = cdr(expr)) {
  116.         pp(car(expr));
  117.         if (consp(cdr(expr)))
  118.         ppterpri();
  119.     }
  120.     if (expr != NIL) {
  121.         ppputc(' '); ppputc('.'); ppputc(' ');
  122.         ppexpr(expr);
  123.     }
  124.     ppputc(')');
  125.     ppmargin = n;
  126.     }
  127. }
  128.  
  129. /* ppexpr - print an expression and update the indent level */
  130. LOCAL void ppexpr(expr)
  131.   LVAL expr;
  132. {
  133.     xlprint(ppfile,expr,TRUE);
  134.     pplevel += flatsize(expr);
  135. }
  136.  
  137. /* ppputc - output a character and update the indent level */
  138. LOCAL void ppputc(ch)
  139.   char ch;  /* changed from int to char - L. Tierney */
  140. {
  141.     xlputc(ppfile,ch);
  142.     pplevel++;
  143. }
  144.  
  145. /* ppterpri - terminate the print line and indent */
  146. LOCAL void ppterpri()
  147. {
  148.     xlterpri(ppfile);
  149.     for (pplevel = 0; pplevel < ppmargin; pplevel++)
  150.     xlputc(ppfile,' ');
  151. }
  152.  
  153. /* flatsize - compute the flat size of an expression */
  154. LOCAL int flatsize(expr)
  155.   LVAL expr;
  156. {
  157.     xlfsize = 0;
  158.     xlprint(NIL,expr,TRUE);
  159.     return (xlfsize);
  160. }
  161.