tcl/printer.tcl

   1 proc format_list {elements start_char end_char readable} {
   2     set res {}
   3     foreach element $elements {
   4         lappend res [pr_str $element $readable]
   5     }
   6     set joined [join $res " "]
   7     return "${start_char}${joined}${end_char}"
   8 }
   9
  10 proc format_hashmap {dictionary readable} {
  11     set lst {}
  12     dict for {keystr valobj} $dictionary {
  13         lappend lst [string_new $keystr]
  14         lappend lst $valobj
  15     }
  16     format_list $lst "\{" "\}" $readable
  17 }
  18
  19 proc format_string {str readable} {
  20     if {[string index $str 0] == "\u029E"} {
  21         return ":[string range $str 1 end]"
  22     } elseif {$readable} {
  23         set escaped [string map {"\n" "\\n" "\"" "\\\"" "\\" "\\\\"} $str]
  24         return "\"$escaped\""
  25     } else {
  26         return $str
  27     }
  28 }
  29
  30 proc format_function {funcdict} {
  31     set type "function"
  32     if {[dict get $funcdict is_macro]} {
  33         set type "macro"
  34     }
  35     return "<$type:args=[join [dict get $funcdict binds] ","]>"
  36 }
  37
  38 proc pr_str {ast readable} {
  39     set nodetype [obj_type $ast]
  40     set nodevalue [obj_val $ast]
  41     switch $nodetype {
  42         nil            { return "nil" }
  43         true           { return "true" }
  44         false          { return "false" }
  45         integer        { return $nodevalue }
  46         symbol         { return $nodevalue }
  47         string         { return [format_string $nodevalue $readable] }
  48         list           { return [format_list $nodevalue "(" ")" $readable] }
  49         vector         { return [format_list $nodevalue "\[" "\]" $readable] }
  50         hashmap        { return [format_hashmap [dict get $nodevalue] $readable] }
  51         atom           { return "(atom [pr_str $nodevalue $readable])" }
  52         function       { return [format_function $nodevalue] }
  53         nativefunction { return "<nativefunction:$nodevalue>" }
  54         default        { error "cannot print type $nodetype" }
  55     }
  56 }