bbc-basic/printer

   1 REM > printer library for mal in BBC BASIC
   2
   3 DEF FNpr_str(val%, print_readably%)
   4   LOCAL ret%, term$, val$, keys%, vals%
   5   IF FNis_nil(val%) THEN =FNalloc_string("nil")
   6   IF FNis_boolean(val%) THEN
   7     IF FNunbox_boolean(val%) THEN =FNalloc_string("true")
   8     =FNalloc_string("false")
   9   ENDIF
  10   IF FNis_int(val%) THEN =FNalloc_string(STR$(FNunbox_int(val%)))
  11   IF FNis_string(val%) THEN
  12     IF FNstring_chr(val%, 1) = CHR$(127) THEN =FNalloc_string(":" + MID$(FNunbox_string(val%), 2))
  13     IF print_readably% THEN =FNalloc_string(FNformat_string(FNunbox_string(val%))) ELSE =val%
  14   ENDIF
  15   IF FNis_symbol(val%) THEN =FNalloc_string(FNunbox_symbol(val%))
  16   IF FNis_corefn(val%) OR FNis_fn(val%) THEN =FNalloc_string("#<function>")
  17   IF FNis_seq(val%) THEN
  18     ret% = FNalloc_string("(") : term$ = ")"
  19     IF FNis_vector(val%) THEN ret% = FNalloc_string("[") : term$ = "]"
  20     WHILE NOT FNis_empty(val%)
  21       IF FNstring_len(ret%) > 1 THEN PROCstring_append(ret%, " ")
  22       PROCstring_concat(ret%, FNpr_str(FNfirst(val%), print_readably%))
  23       val% = FNrest(val%)
  24     ENDWHILE
  25     PROCstring_append(ret%, term$)
  26     =ret%
  27   ENDIF
  28   IF FNis_hashmap(val%) THEN
  29     ret% = FNalloc_string("{")
  30     keys% = FNhashmap_keys(val%)
  31     vals% = FNhashmap_vals(val%)
  32     WHILE NOT FNis_empty(keys%)
  33       IF FNstring_len(ret%) > 1 THEN PROCstring_append(ret%, " ")
  34       PROCstring_concat(ret%, FNpr_str(FNfirst(keys%), print_readably%))
  35       PROCstring_append(ret%, " ")
  36       PROCstring_concat(ret%, FNpr_str(FNfirst(vals%), print_readably%))
  37       keys% = FNrest(keys%)
  38       vals% = FNrest(vals%)
  39     ENDWHILE
  40     PROCstring_append(ret%, "}")
  41     =ret%
  42   ENDIF
  43   IF FNis_atom(val%) THEN
  44     ret% = FNalloc_string("(atom ")
  45     PROCstring_concat(ret%, FNpr_str(FNatom_deref(val%), print_readably%))
  46     PROCstring_append(ret%, ")")
  47     =ret%
  48   ENDIF
  49   ERROR &40E809F0, "Unprintable value"
  50
  51 DEF FNformat_string(strval$)
  52   LOCAL ptr%, c$, out$
  53   IF strval$ = "" THEN =""""""
  54   FOR ptr% = 1 TO LEN(strval$)
  55     c$ = MID$(strval$, ptr%, 1)
  56     CASE c$ OF
  57       WHEN "\", """": out$ += "\" + c$
  58       WHEN CHR$(10): out$ += "\n"
  59       OTHERWISE: out$ += c$
  60     ENDCASE
  61   NEXT ptr%
  62 ="""" + out$ + """"
  63
  64 REM Local Variables:
  65 REM indent-tabs-mode: nil
  66 REM End: