lisp_print.c 1.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778
  1. /* Copyright (C) 2016 Jeremiah Orians
  2. * This file is part of stage0.
  3. *
  4. * stage0 is free software: you can redistribute it and/or modify
  5. * it under the terms of the GNU General Public License as published by
  6. * the Free Software Foundation, either version 3 of the License, or
  7. * (at your option) any later version.
  8. *
  9. * stage0 is distributed in the hope that it will be useful,
  10. * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. * GNU General Public License for more details.
  13. *
  14. * You should have received a copy of the GNU General Public License
  15. * along with stage0. If not, see <http://www.gnu.org/licenses/>.
  16. */
  17. #include "lisp.h"
  18. void writeobj(FILE *output_file, struct cell* op)
  19. {
  20. if(!echo) return;
  21. if(INT == op->type)
  22. {
  23. fputs(int2str(op->value, 10, TRUE), output_file);
  24. }
  25. else if(CONS == op->type)
  26. {
  27. fputc('(', output_file);
  28. do
  29. {
  30. writeobj(output_file, op->car);
  31. if(nil == op->cdr)
  32. {
  33. fputc(')', output_file);
  34. break;
  35. }
  36. op = op->cdr;
  37. if(op->type != CONS)
  38. {
  39. fputs(" . ", output_file);
  40. writeobj(output_file, op);
  41. fputc(')', output_file);
  42. break;
  43. }
  44. fputc(' ', output_file);
  45. } while(TRUE);
  46. }
  47. else if(SYM == op->type)
  48. {
  49. fputs(op->string, output_file);
  50. }
  51. else if(PRIMOP == op->type)
  52. {
  53. fputs("#<PRIMOP>", output_file);
  54. }
  55. else if(PROC == op->type)
  56. {
  57. fputs("#<PROC>", output_file);
  58. }
  59. else if(CHAR == op->type)
  60. {
  61. fputc(op->value, output_file);
  62. }
  63. else if(STRING == op->type)
  64. {
  65. fputs(op->string, output_file);
  66. }
  67. else
  68. {
  69. fputs("Type ", stderr);
  70. fputs(int2str(op->type, 10, TRUE), stderr);
  71. fputs(" is unknown\nPrint aborting hard\n", stderr);
  72. exit(EXIT_FAILURE);
  73. }
  74. }