objpascal/printer.pas

   1 unit printer;
   2
   3 {$H+} // Use AnsiString
   4
   5 interface
   6
   7 Uses sysutils,
   8      mal_types,
   9      mal_func;
  10
  11 function pr_str_array(Args : TMalArray;
  12                       print_readably : Boolean;
  13                       Separator : string) : string;
  14
  15 function pr_str(Obj : TMal; print_readably : Boolean) : string;
  16
  17 implementation
  18
  19 function pr_str_array(Args : TMalArray;
  20                       print_readably : Boolean;
  21                       Separator : string) : string;
  22 var
  23     Str : string;
  24     I   : longint;
  25 begin
  26     Str := '';
  27     for I := 0 to Length(Args)-1 do
  28     begin
  29         Str := Str + pr_str(Args[I], print_readably);
  30         if I <> Length(Args)-1 then
  31             Str := Str + Separator;
  32     end;
  33     pr_str_array := Str;
  34 end;
  35
  36 function pr_str_dict(Dict : TMalDict;
  37                      print_readably : Boolean;
  38                      Separator : string) : string;
  39 var
  40     I    : longint;
  41     Arr  : TMalArray;
  42 begin
  43     SetLength(Arr, Dict.Count * 2);
  44     I := 0;
  45     while I < Dict.Count do
  46     begin
  47         Arr[I*2]   := TMalString.Create(Dict.Keys[I]);
  48         Arr[I*2+1] := Dict[Dict.Keys[I]];
  49         I := I + 1;
  50     end;
  51     pr_str_dict := pr_str_array(Arr, print_readably, ' ');
  52 end;
  53
  54
  55 function pr_str(Obj : TMal; print_readably : Boolean) : string;
  56 var
  57     Str  : string;
  58     Fn   : TMalFunc;
  59 begin
  60     if Obj.ClassType = TMalList then
  61         pr_str := '(' + pr_str_array((Obj as TMalList).Val,
  62                                      print_readably,
  63                                      ' ') + ')'
  64     else if Obj.ClassType = TMalVector then
  65         pr_str := '[' + pr_str_array((Obj as TMalList).Val,
  66                                      print_readably,
  67                                      ' ') + ']'
  68     else if Obj is TMalHashMap then
  69         pr_str := '{' + pr_str_dict((Obj as TMalHashMap).Val,
  70                                      print_readably,
  71                                      ' ') + '}'
  72     else if Obj is TMalString then
  73     begin
  74         Str := (Obj as TMalString).Val;
  75         if (Length(Str) > 0) and (Str[1] = #127) then
  76             pr_str := ':' + copy(Str, 2, Length(Str))
  77         else if print_readably then
  78         begin
  79             Str := StringReplace(Str, '\', '\\', [rfReplaceAll]);
  80             Str := StringReplace(Str, '"', '\"', [rfReplaceAll]);
  81             Str := StringReplace(Str, #10, '\n', [rfReplaceAll]);
  82             pr_str := Format('"%s"', [Str])
  83         end
  84         else
  85             pr_str := Str;
  86     end
  87     else if Obj is TMalNil then
  88         pr_str := 'nil'
  89     else if Obj is TMalTrue then
  90         pr_str := 'true'
  91     else if Obj is TMalFalse then
  92         pr_str := 'false'
  93     else if Obj is TMalInt then
  94         pr_str := IntToStr((Obj as TMalInt).Val)
  95     else if Obj is TMalSymbol then
  96         pr_str := (Obj as TMalSymbol).Val
  97     else if Obj is TMalAtom then
  98         pr_str := '(atom ' +
  99                   pr_str((Obj as TMalAtom).Val, print_readably) +
 100                   ')'
 101     else if Obj is TMalFunc then
 102     begin
 103         Fn := (Obj as TMalFunc);
 104         if Fn.Ast = nil then
 105             pr_str := '#<native function>'
 106         else
 107             pr_str := '(fn* ' + pr_str(Fn.Params,true) +
 108                       ' ' + pr_str(Fn.Ast,true) + ')'
 109     end
 110     else
 111         pr_str := '#unknown';
 112 end;
 113
 114 end.