objpascal/step2_eval.pas

   1 program Mal;
   2
   3 {$H+} // Use AnsiString
   4
   5 Uses sysutils,
   6      CMem,
   7      fgl,
   8      Readline in 'pas-readline/src/readline.pas',
   9      History in 'pas-readline/src/history.pas',
  10      mal_types,
  11      mal_func,
  12      reader,
  13      printer;
  14
  15 type
  16     TEnv = specialize TFPGMap<string,TMal>;
  17
  18 var
  19     Repl_Env : TEnv;
  20     Line     : PChar;
  21
  22 // read
  23 function READ(const Str: string) : TMal;
  24 begin
  25     READ := read_str(Str);
  26 end;
  27
  28 // eval
  29 // Forward declation since eval_ast call it
  30 function EVAL(Ast: TMal; Env: TEnv) : TMal; forward;
  31
  32 function eval_ast(Ast: TMal; Env: TEnv) : TMal;
  33 var
  34     Sym              : string;
  35     OldArr, NewArr   : TMalArray;
  36     OldDict, NewDict : TMalDict;
  37     I                : longint;
  38 begin
  39     if Ast is TMalSymbol then
  40     begin
  41         Sym := (Ast as TMalSymbol).Val;
  42         if Env.IndexOf(Sym) < 0 then
  43             raise Exception.Create('''' + Sym + ''' not found')
  44         else
  45             eval_ast := Env[Sym];
  46     end
  47     else if Ast is TMalList then
  48     begin
  49         OldArr := (Ast as TMalList).Val;
  50         SetLength(NewArr, Length(OldArr));
  51         for I := 0 to Length(OldArr)-1 do
  52         begin
  53             NewArr[I] := EVAL(OldArr[I], Env);
  54         end;
  55         if Ast is TMalVector then
  56             eval_ast := TMalVector.Create(NewArr)
  57         else
  58             eval_ast := TMalList.Create(NewArr);
  59     end
  60     else if Ast is TMalHashMap then
  61     begin
  62         OldDict := (Ast as TMalHashMap).Val;
  63         NewDict := TMalDict.Create;
  64         I := 0;
  65         while I < OldDict.Count do
  66         begin
  67             NewDict[OldDict.Keys[I]] := EVAL(OldDict[OldDict.Keys[I]], Env);
  68             I := I + 1;
  69         end;
  70         eval_ast := TMalHashMap.Create(NewDict);
  71     end
  72     else
  73         eval_ast := Ast;
  74 end;
  75
  76 function EVAL(Ast: TMal; Env: TEnv) : TMal;
  77 var
  78     Arr    : TMalArray;
  79     Fn     : TMalCallable;
  80 begin
  81     if Ast.ClassType <> TMalList then
  82         Exit(eval_ast(Ast, Env));
  83
  84     // Apply list
  85     Arr := (eval_ast(Ast, Env) as TMalList).Val;
  86     if Arr[0] is TMalFunc then
  87     begin
  88         Fn := (Arr[0] as TMalFunc).Val;
  89         EVAL := Fn(copy(Arr, 1, Length(Arr)-1));
  90     end
  91     else
  92         raise Exception.Create('invalid apply');
  93 end;
  94
  95 // print
  96 function PRINT(Exp: TMal) : string;
  97 begin
  98     PRINT := pr_str(Exp, True);
  99 end;
 100
 101 // repl
 102 function REP(Str: string) : string;
 103 begin
 104     REP := PRINT(EVAL(READ(Str), Repl_Env));
 105 end;
 106
 107 function add(Args: TMalArray) : TMal;
 108 begin
 109     add := TMalInt.Create((Args[0] as TMalInt).Val +
 110                           (Args[1] as TMalInt).Val);
 111 end;
 112 function subtract(Args: TMalArray) : TMal;
 113 begin
 114     subtract := TMalInt.Create((Args[0] as TMalInt).Val -
 115                                (Args[1] as TMalInt).Val);
 116 end;
 117 function multiply(Args: TMalArray) : TMal;
 118 begin
 119     multiply := TMalInt.Create((Args[0] as TMalInt).Val *
 120                                (Args[1] as TMalInt).Val);
 121 end;
 122 function divide(Args: TMalArray) : TMal;
 123 begin
 124     divide := TMalInt.Create((Args[0] as TMalInt).Val div
 125                              (Args[1] as TMalInt).Val);
 126 end;
 127
 128 begin
 129     Repl_Env := TEnv.Create;
 130     Repl_Env.Add('+', TMalFunc.Create(@add));
 131     Repl_Env.Add('-', TMalFunc.Create(@subtract));
 132     Repl_Env.Add('*', TMalFunc.Create(@multiply));
 133     Repl_Env.Add('/', TMalFunc.Create(@divide));
 134     while True do
 135     begin
 136         Line := Readline.readline('user> ');
 137         if Line = Nil then
 138             Halt(0);
 139         if Line[0] = #0 then
 140             continue;
 141         add_history(Line);
 142
 143         try
 144             WriteLn(REP(Line))
 145         except
 146             On E : Exception do
 147             begin
 148                 WriteLn('Error: ' + E.message);
 149                 WriteLn('Backtrace:');
 150                 WriteLn(GetBacktrace(E));
 151             end;
 152         end;
 153     end;
 154 end.