/*
 * Lisp print
 * Don Hopkins
 */

#include "lisp.h"

/*
 * Vanilla print routine. Print an representation of a lisp object.
 */

prin1(obj)
     object obj;
{
  switch(Object_Type(obj)) {

/*
 * Any undefined object.
 */

  case undefined_object:
    fputs("<undefined>", Output_File);
    break;

/*
 * Print an atom's name.
 */

  case atom_object:
    { int needs_quoting = 0;
      char *cp = Atom_Name(obj);

      while (*cp != 0 && !needs_quoting)
	if (*cp++ <= 32)
	  needs_quoting++;
      
      if (needs_quoting)
	putchar('|');
      fputs(Atom_Name(obj), Output_File);
      if (needs_quoting)
	putchar('|');
    }
    break;

/*
 * Print a number's value.
 */

  case number_object:
    {
      double value = Number_Value(obj), fabs();

      if (fabs(value) <= ZERO_THRESHOLD)
	fputs("0", Output_File); /* Foo on floating point! */
      else
	fprintf(Output_File, "%.6g", (double)value);
      break;
    }

/*
 * Print a cons as a list.
 */

  case cons_object:
    print_list(obj);
    break;

/*
 * Print arguments and type and index of body for user function and
 * special objects. 
 */

  case user_function_object:
  case user_special_object:
  case macro_object:
    fprintf(Output_File, "<%s ", type_name(obj));
    sprint(Cons_Car(obj));
    show_object(Cons_Cdr(obj));
    putc('>', Output_File);
    break;

/*
 * Print the name and number of arguments of built-in function and
 * special objects.
 */

  case built_in_function_object:
  case built_in_special_object:
    fprintf(Output_File, "<%s %s ", type_name(obj), Built_In_Name(obj));
    if (Built_In_Args(obj) < 0)
      fputs("(any args)>", Output_File);
    else
      fprintf(Output_File, "(%d arg%s)>", Built_In_Args(obj),
	      Built_In_Args(obj) == 1 ? "" : "s");
    
    break;

/*
 * Print file name and previous stream's file number for stream
 * objects. 
 */

  case stream_object:
    fprintf(Output_File, "<Stream %s %d>",
	    Atom_Name(Cons_Car(obj)),
	    fileno((FILE *)Cons_Cdr(obj)));
    break;

/*
 * Print type and index of function and environment for funarg
 * objects. 
 */

  case funarg_object:
    fputs("<Funarg ", Output_File);
    show_object(Cons_Car(obj));
    putc(' ', Output_File);
    show_object(Cons_Cdr(obj));
    putc('>', Output_File);
    break;

/*
 * Otherwise, just show type and index. 
 */

  default:
    show_object(obj);
    break;
  }
}

/*
 * Lisp interface to prin1.
 */

object lprin1(args)
     object args;
{
  prin1(ARG1);
  return(ARG1);
}

/*
 * Recursivly print the elements of a list. Use in list notation if
 * possible. Use dot notation at end of list if list notation can't be
 * used, when the end of a list is non-nil. If the list is longer than
 * MAX_PRINT_LENGTH, then print ". . ." instead of the rest of the
 * list. 
 */

print_list(obj)
     object obj;
{
  int length = 0;
  
  putc('(', Output_File);

  while (Object_Type(obj) == cons_object &&
	 ++length <= MAX_PRINT_LENGTH) {

    if (Cons_Cdr(obj) == Nil)
      prin1(Cons_Car(obj));
    else
      sprint(Cons_Car(obj));

    obj = Cons_Cdr(obj);
  }

/* 
 * If obj is a cons, then Only MAX_PRINT_LENGTH were printed.
 */

  if (Object_Type(obj) == cons_object)
    fputs(". . . ", Output_File);

  else if (obj != Nil) {
    fputs(". ", Output_File);
    prin1(obj);
  }

  putc(')', Output_File);
}

/*
 * Print an object, followed by a space.
 */

sprint(obj)
     object obj;
{
  prin1(obj);
  putc(' ', Output_File);
}

/*
 * Lisp interface to sprint.
 */

lprint(args)
     object args;
{
  sprint(ARG1);
  return(ARG1);
}

/*
 * Print an object, followed by a newline.
 */

printcr(obj)
     object obj;
{
  prin1(obj);
  putc('\n', Output_File);
}

/*
 * Lisp interface to printcr.
 */

object lprintcr(args)
     object args;
{
  printcr(ARG1);
  return(ARG1);
}

/*
 * Print a newline.
 */

object terpri(args)
     object args;
{
  putc('\n', Output_File);
  return(Nil);
}