[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Pretty printing examples?



Douglas M. Auclair wrote:
> Chris Double <chris@double.co.nz> wrote in message 
> 
>>Have a look at the following paper
>>(http://www.merl.com/reports/TR93-17) recently mentioned in
>>comp.lang.lisp.

  I thought I had done something with the pretty-print library,
so I dived in the archives. The code was entirely commented-out,
so I can't really tell how much of it was working. Comments
are sorely lacking, as it was a personal project I never
finished.

  IIRC, this was done using a port of the pretty-print library
to Fun-Dev.
-----------------------------------------------------------
Module: SQL-PPrint
Copyright: (C) 1999, Eric Gouriou.  All rights reserved.


/// print-message
///
///
define method print-message
     (tbl :: <sql-table>, stream :: <stream>) => ();
   // --- Printing
   print-message(tbl.name, stream);
end method print-message;

/// print-message
///
///
define method print-message
     (col :: <sql-column>, stream :: <stream>) => ();
   // --- Printing
   print-message(col.name, stream);
end method print-message;

/// print-message                                         [sealed G.F. 
Method]
///
///
define sealed method print-message
     (expr :: <sql-string-expr>, stream :: <stream>) => ();
   // --- Printing
   format(stream, "'%S'", expr.string);
end method print-message;

/// print-message                                         [sealed G.F. 
Method]
///
///
define sealed method print-message
     (expr :: <sql-character-expr>, stream :: <stream>) => ();
   // --- Printing
   format(stream, "'%S'", expr.character);
end method print-message;

/// print-message                                         [sealed G.F. 
Method]
///
///
define sealed method print-message
     (expr :: <sql-integer-expr>, stream :: <stream>) => ();
   // --- Printing
   format(stream, "%D", expr.integer);
end method print-message;


/// print-message                                         [sealed G.F. 
Method]
///
///
define sealed method print-message
     (expr :: <sql-date-expr>, stream :: <stream>) => ();
   // --- Printing
   format(stream, "'%S'", expr.date-string);
end method print-message;

/// print-message                                         [sealed G.F. 
Method]
///
///
define sealed method print-message
     (expr :: <sql-string-as-expression>, stream :: <stream>) => ();
   // --- Printing
   // format(stream, "%S", expr.expression-string);
   write(stream, expr.expression-string);
end method print-message;

/// print-message                                         [sealed G.F. 
Method]
///
///
define sealed method print-message
     (func :: <sql-function>, stream :: <stream>) => ();
   // --- Printing
   print-message(func.function-name, stream);
end method print-message;

///
///
///
define sealed method print-message
     (expr :: <sql-function-call>, stream :: <stream>) => ();
   // --- Printing the function name
   let func = expr.function;
   print-message(func, stream);
   // --- Printing arguments
   unless (func.arity == 0)
     printing-logical-block (stream, prefix: "(", suffix: ")")
       for (argument in expr.arguments,
            first? = #t then #f)
         unless (first?)
           print-message(',', stream);
           pprint-newline(#"miser", stream);
         end unless;
         print-message(argument, stream);
       end for;
     end printing-logical-block;
   end unless;
end method print-message;


/// print-message                                         [sealed G.F. 
Method]
///
///
define sealed method print-message
     (condition :: <sql-string-as-condition>, stream :: <stream>) => ();
   // --- Printing
   // format(stream, "%S", condition.condition-string);
   write(stream, condition.condition-string);
end method print-message;

/// print-message
///
///
define method print-message
     (condition :: <sql-binary-comparison>, stream :: <stream>) => ();
  // --- Printing
   printing-logical-block (stream)
     print-message(condition.left-operand, stream);
     print-message(' ', stream);
     pprint-newline(#"linear", stream);
     print-message(condition.operator, stream);
     print-message(' ', stream);
     print-message(condition.right-operand, stream);
   end printing-logical-block;
end method print-message;

///
///
///
define method print-message
     (condition :: <sql-in>, stream :: <stream>) => ();
   // --- Printing
   print-message(condition.left-operand, stream);

   print-message(" IN ", stream);

   printing-logical-block (stream, prefix: "(", suffix: ")")
     for (value in condition.right-operand,
          first? = #t then #f)
       unless (first?)
         print-message(',', stream);
         pprint-newline(#"miser", stream);
       end unless;
       print-message(value, stream);
     end for;
   end printing-logical-block;
end method print-message;

/*
  * <sql-and> et <sql-or>
  */
define method print-and/or-message
     (condition :: <sql-and/or>,
      equivalent-if-empty :: <object>,
      operator :: <string>,
      stream :: <stream>)
  => ();
   let ops = condition.operands;

   // --- Printing
   select (size(ops))
     0         => print-message(equivalent-if-empty, stream);
     1         => print-message(first(ops), stream);
     otherwise => printing-logical-block (stream, prefix: "(", suffix: ")")
                    for (operand in ops,
                         first? = #t then #f)
                      unless (first?)
                        print-message(' ', stream);
                        pprint-newline(#"linear", stream);
                        print-message(operator, stream);
                        print-message(' ', stream);
                      end unless;

                      print-message(operand, stream);
                    end for;
                  end printing-logical-block;
   end select;
end method print-and/or-message;

define method print-message
     (condition :: <sql-and>, stream :: <stream>) => ();
   // --- Printing
   print-and/or-message(condition,
                        $trivialy-true-condition,
                        "AND",
                        stream);
end method print-message;

define method print-message
     (condition :: <sql-or>, stream :: <stream>) => ();
   // --- Printing
   print-and/or-message(condition,
                        $trivialy-false-condition,
                        "OR",
                        stream);
end method print-message;

define method print-message
     (condition :: <sql-not>, stream :: <stream>) => ();
   // --- Printing
   print-message("NOT ", stream);
   print-message(condition.operand, stream);
end method print-message;

define method print-message
     (condition :: <sql-is-null>, stream :: <stream>) => ();
   // --- Printing
   print-message(condition.operand, stream);
   print-message(" IS NULL", stream);
end method print-message;

define method print-message
     (condition :: <sql-is-not-null>, stream :: <stream>) => ();
   // --- Printing
   print-message(condition.operand, stream);
   print-message(" IS NOT NULL", stream);
end method print-message;

define method print-message
     (condition :: <sql-between>, stream :: <stream>) => ();
   // --- Printing
   format(stream,
          "(%S BETWEEN %S AND %S)",
          condition.expr-tested, condition.min-value, condition.max-value);
end method print-message;

/// print-message                                         [sealed G.F. 
Method]
///
///
define sealed method print-message
     (sql-select :: <sql-select>, stream :: <stream>)
  => ();
   local
     method print-part (stream, prefix, part, suffix) => ();
       printing-logical-block (stream, prefix: prefix, suffix: suffix)
         print-message(part, stream);
       end printing-logical-block;
     end method;

   // --- Printing
   printing-logical-block (stream)
     print-part(stream, "SELECT ", sql-select.what,  " ");

     unless (sql-select.from == #f)
       pprint-newline(#"linear", stream);
       print-part(stream, "FROM ", sql-select.from,  " ");
     end;

     unless (sql-select.where == #f)
       pprint-newline(#"linear", stream);
       print-part(stream, "WHERE ", sql-select.where, " ");
     end unless;

     unless (sql-select.group-by == #f)
       pprint-newline(#"linear", stream);
       print-part(stream, "WHERE ", sql-select.group-by, " ");
     end unless;

     unless (sql-select.order-by == #f)
       pprint-newline(#"linear", stream);
       print-part(stream, "WHERE ", sql-select.order-by, " ");
     end unless;
   end printing-logical-block;
end method print-message;
-----------------------------------------------------------

  I hope this helps.

  Eric