rexx/printer.rexx

   1 #ifndef __printer__
   2 #define __printer__
   3
   4 #include "types.rexx"
   5
   6 format_string: procedure /* format_string(str, readable) */
   7   str = arg(1)
   8   readable = arg(2)
   9   if readable then do
  10     res = changestr('5C'x, str, "\\")
  11     res = changestr('"', res, '\"')
  12     res = changestr('0A'x, res, "\n")
  13     return '"' || res || '"'
  14   end
  15   else
  16     return str
  17
  18 format_sequence: procedure expose values. /* format_sequence(val, open_char, close_char, readable) */
  19   val = arg(1)
  20   open_char = arg(2)
  21   close_char = arg(3)
  22   readable = arg(4)
  23   res = ""
  24   do i=1 to words(val)
  25     element = word(val, i)
  26     if i > 1 then res = res || " "
  27     res = res || pr_str(element, readable)
  28   end
  29   return open_char || res || close_char
  30
  31 pr_str: procedure expose values. /* pr_str(ast, readable) */
  32   ast = arg(1)
  33   readable = arg(2)
  34   type = obj_type(ast)
  35   val = obj_val(ast)
  36   select
  37     when type == "nill" then return "nil"
  38     when type == "true" then return "true"
  39     when type == "fals" then return "false"
  40     when type == "numb" then return val
  41     when type == "symb" then return val
  42     when type == "stri" then return format_string(val, readable)
  43     when type == "keyw" then return ":" || val
  44     when type == "list" then return format_sequence(val, "(", ")", readable)
  45     when type == "vect" then return format_sequence(val, "[", "]", readable)
  46     when type == "hash" then return format_sequence(val, "{", "}", readable)
  47     when type == "nafn" then return "#<nativefunction:" || val || ">"
  48     when type == "func" then return "#<function:args=" || pr_str(func_binds(ast), readable) || ">"
  49     when type == "atom" then return "(atom " || pr_str(val, readable) || ")"
  50     otherwise
  51       return "#<UNKNOWN-TYPE>"
  52     end
  53
  54 #endif