[epsilon-devel] Interpreters in epsilon

[Luca Saiu]

  Hi Matteo,

  this night I wrote an interpreter for a functional language in 
epsilon in two versions, eager and lazy; it is amazingly simple. We 
could build the meta-circular interpreter on this basement. I'm 
attaching the source files.
  If you are going to some lessons about languages then you should 
understand it; otherwise don't mind, you will understand it soon :-).
In this days I am eagerly watching the SICP video lessons; they are 
wonderful. SICP (the Wizard book) is a great source of ideas, also for 
epsilon; you should have a copy of the book on your laptop. *If* you 
have some spare time you can skim chapter 4; it explains meta-circular 
interpreters; it's a relatively complicated subject, don't be frightened 
if you don't get all details yet.
  Of course we don't have a working parser yet, and for the 
interpreters we are still forced to use abstract syntax, which is a 
pain. Damn, I must work on epsilonyacc. It's top priority.
  However the thing works really well.

  When you have some time, could you please make that test on GC times 
which I asked a couple of days ago? Wihtout too haste, however; the 
garbage collector is perfectly usable even as it is now and I don't 
think I will modify it very soon.

  Have a good day,

--
Luca Saiu, maintainer of GNU epsilon
http://www.gnu.org/software/epsilon

/* This file is part of an experimental interpreter

Copyright (C) 2002 Luca Saiu

GNU epsilon is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published
by the Free Software Foundation; either version 2, or (at your
option) any later version.

GNU epsilon is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with epsilon; see the file COPYING.  If not, write to the
Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */


declare abstract type environment;

/* This file is part of an experimental interpreter

Copyright (C) 2002 Luca Saiu

GNU epsilon is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published
by the Free Software Foundation; either version 2, or (at your
option) any later version.

GNU epsilon is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with epsilon; see the file COPYING.  If not, write to the
Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */


define concrete type expression =
  INTEGER of integer
| BOOLEAN of boolean
| VARIABLE of string
| IF of expression * expression * expression
| LAMBDA of string * expression
| APPLY of expression * expression
| REC of string * string * expression;

define APPLY3 = \ x_y_z .
  APPLY(APPLY(x_y_z ^ 1, x_y_z ^ 2), x_y_z ^ 3);

define concrete type value =
  Integer of integer
| Boolean of boolean
| Cons of value * value
| Closure of string * expression * environment
| Primitive of value -> value;

define output_value = fix \ f . \ v .
  match v with
    Integer(i) -> output_integer i
  | Boolean(b) -> if b then output_string "true" else output_string "false"
  | Closure(c) -> output_string "<function>"
  | Primitive(p) -> output_string "<primitive>"
  | Cons(v1_v2) -> begin
                     output_string "( ";
                     f (v1_v2 ^ 1);
                     output_string " . ";
                     f (v1_v2 ^ 2);
                     output_string " )";
                   end;

define exception error;
define exception type_error = expression;
define exception not_a_function = value;

define extract_integer = \ v .
  match v with
    Integer(i) -> i
  | _ -> throw error;

define extract_boolean = \ v .
  match v with
    Boolean(b) -> b
  | _ -> throw error;

define extract_carcdr = \ v .
  match v with
    Cons(v1_v2) -> v1_v2
  | _ -> throw error;

define abstract type environment =
  associative_array of string, value;

define binary_to_curried_primitive = \ bop : value -> value -> value .
  Primitive(\ first . Primitive(\ second . bop first second));

define my_not = 
  Primitive(\ x . Boolean(not (extract_boolean x)));

define my_integer_bop = \ op . 
  binary_to_curried_primitive
    (\ a . \ b . Integer(op (extract_integer a) (extract_integer b)));
define my_compare_bop = \ op . 
  binary_to_curried_primitive
    (\ a . \ b . Boolean(op (extract_integer a) (extract_integer b)));
define my_connective_bop = \ op . 
  binary_to_curried_primitive
    (\ a . \ b . Boolean(op (extract_boolean a) (extract_boolean b)));

define empty_environment = 
  empty_associative_array (\ x . \ y . x <s y) (\ x . \ y . x =s y) Integer(1);
define initial_environment = insert_list_into_associative_array
  ["not", my_not;
   "+", my_integer_bop (\ x . \ y . x + y);
   "-", my_integer_bop (\ x . \ y . x - y);
   "*", my_integer_bop (\ x . \ y . x * y);
   "/", my_integer_bop (\ x . \ y . x / y);
   "and", my_connective_bop (\ x . \ y . x and y);
   "or", my_connective_bop (\ x . \ y . x or y);
   "xor", my_connective_bop (\ x . \ y . x xor y);
   "<", my_compare_bop (\ x . \ y . x < y);
   "<=", my_compare_bop (\ x . \ y . x <= y);
   ">", my_compare_bop (\ x . \ y . x > y);
   ">=", my_compare_bop (\ x . \ y . x >= y);
   "=", my_compare_bop (\ x . \ y . x = y);
   "=/=", my_compare_bop (\ x . \ y . x =/= y);
   "cons", binary_to_curried_primitive(\ x . \ y . Cons(x, y));
   "car", Primitive(\ x . (extract_carcdr x) ^ 1);
   "cdr", Primitive(\ x . (extract_carcdr x) ^ 2);
  ]
  empty_environment;

define bind = \ n . \ v . \ env : environment .
  insert_into_associative_array n v env;

define lookup = \ n . \ env : environment .
  lookup_associative_array n env;


declare eval : expression -> environment -> value;
declare my_apply : value -> value -> value;
declare make_rec : string -> string -> expression -> environment -> value;
define eval = fix \ f . \ exp . \ env .
  match exp with
    INTEGER(i) -> Integer(i)
  | BOOLEAN(b) -> Boolean(b)
  | VARIABLE(v) -> lookup v env
  | IF(c_e1_e2) -> (match f (c_e1_e2 ^ 1) env with
                      Boolean(c) -> if c then
                                      f (c_e1_e2 ^ 2) env
                                    else
                                      f (c_e1_e2 ^ 3) env
                    | _ -> throw type_error exp)
  | LAMBDA(v_e) -> Closure(v_e ^ 1, v_e ^ 2, env)
  | APPLY(e1_e2) -> my_apply (f (e1_e2 ^ 1) env) (f (e1_e2 ^ 2) env)
  | REC(f_v_exp) -> make_rec (f_v_exp ^ 1) (f_v_exp ^ 2) (f_v_exp ^ 3) env
//  | _ -> throw error
;

define make_rec = \ func . \ v . \ exp . \ env .
  Closure(v,
          exp,
          bind func
               Primitive(\ z . my_apply (eval REC(func, v, exp) env) z)
               env);

define my_apply = \ v1 . \ v2 .
  match v1 with
    Primitive(p) -> p v2
  | Closure(var_exp_env) ->
      eval (var_exp_env ^ 2)
           (bind (var_exp_env ^ 1) v2 (var_exp_env ^ 3))
  | _ -> throw not_a_function v1;

define program1 =
  IF(BOOLEAN(false),
     INTEGER(10),
     INTEGER(23));

define program2 =
  APPLY(VARIABLE("not"), BOOLEAN(true));

define square = 
  LAMBDA("x", APPLY3(VARIABLE("*"), VARIABLE("x"), VARIABLE("x")));

define fact =
  REC("fact",
      "n",
      IF(APPLY3(VARIABLE("="), VARIABLE("n"), INTEGER(0)),
         INTEGER(1),
         APPLY3(VARIABLE("*"),
                VARIABLE("n"),
                APPLY(VARIABLE("fact"),
                      APPLY3(VARIABLE("-"), VARIABLE("n"), INTEGER(1))))));

define five =
  APPLY(APPLY(VARIABLE("+"),
              INTEGER(2)),
        INTEGER(3));

define program3 = APPLY(fact, INTEGER(10));

//define program = APPLY3(VARIABLE("cons"), INTEGER(1), INTEGER(2));

define dontstopf = REC("f", "x", APPLY(VARIABLE("f"), VARIABLE("x")));

define dontstop = APPLY(dontstopf, INTEGER(1));

define program = APPLY(dontstopf, INTEGER(1));

define main = begin
  output_value (eval program initial_environment);
  output_string "\n";
end;

/* This file is part of an experimental interpreter

Copyright (C) 2002 Luca Saiu

GNU epsilon is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published
by the Free Software Foundation; either version 2, or (at your
option) any later version.

GNU epsilon is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with epsilon; see the file COPYING.  If not, write to the
Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */


declare abstract type environment;

/* This file is part of an experimental interpreter

Copyright (C) 2002 Luca Saiu

GNU epsilon is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published
by the Free Software Foundation; either version 2, or (at your
option) any later version.

GNU epsilon is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with epsilon; see the file COPYING.  If not, write to the
Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */


define concrete type expression =
  INTEGER of integer
| BOOLEAN of boolean
| SYMBOL of string
| VARIABLE of string
| IF of expression * expression * expression
| LAMBDA of string * expression
| APPLY of expression * expression
| REC of string * string * expression;

define APPLY3 = \ x_y_z .
  APPLY(APPLY(x_y_z ^ 1, x_y_z ^ 2), x_y_z ^ 3);

define concrete type value =
  Integer of integer
| Boolean of boolean
| Symbol of string
| Cons of value * value
| Closure of string * expression * environment
| Primitive of value -> value
| Thunk of promise of value;

define exception error;
define exception type_error = expression;
define exception not_a_function = value;

declare eval : expression -> environment -> value;
declare my_apply : value -> value -> value;
declare make_rec : string -> string -> expression -> environment -> value;
declare force_thunk : value -> value;

define output_value = fix \ f . \ v .
  match v with
    Integer(i) -> output_integer i
  | Boolean(b) -> if b then output_string "true" else output_string "false"
  | Symbol(s) -> output_string s
  | Closure(c) -> output_string "<function>"
  | Primitive(p) -> output_string "<primitive>"
  | Cons(v1_v2) -> begin
                     output_string "(";
                     f (v1_v2 ^ 1);
                     output_string " . ";
                     f (v1_v2 ^ 2);
                     output_string ")";
                   end
  | Thunk(t) -> begin
//                  output_string "<";
                  f (force_thunk (force t));
//                  output_string "<thunk>";
//                  output_string ">";
                end;

define force_thunk = fix \ f . \ v .
  match v with
    Thunk(t) -> f (force t)
  | _ -> v; // not a thunk, return v as it is

define extract_integer = \ v .
  match force_thunk v with
    Integer(i) -> i
  | _ -> throw error;

define extract_boolean = \ v .
  match force_thunk v with
    Boolean(b) -> b
  | _ -> throw error;

define extract_carcdr = \ v .
  match force_thunk v with
    Cons(v1_v2) -> v1_v2
  | _ -> throw error;

define abstract type environment =
  associative_array of string, value;

define binary_to_curried_primitive = \ bop : value -> value -> value .
  Primitive(\ first . Primitive(\ second . bop first second));

define my_not = 
  Primitive(\ x . Boolean(not (extract_boolean x)));

define my_integer_bop = \ op . 
  binary_to_curried_primitive
    (\ a . \ b . Integer(op (extract_integer a) (extract_integer b)));
define my_compare_bop = \ op . 
  binary_to_curried_primitive
    (\ a . \ b . Boolean(op (extract_integer a) (extract_integer b)));
define my_connective_bop = \ op . 
  binary_to_curried_primitive
    (\ a . \ b . Boolean(op (extract_boolean a) (extract_boolean b)));

define empty_environment = 
  empty_associative_array (\ x . \ y . x <s y) (\ x . \ y . x =s y) Integer(1);
define initial_environment = insert_list_into_associative_array
  ["not", my_not;
   "+", my_integer_bop (\ x . \ y . x + y);
   "-", my_integer_bop (\ x . \ y . x - y);
   "*", my_integer_bop (\ x . \ y . x * y);
   "/", my_integer_bop (\ x . \ y . x / y);
   "and", my_connective_bop (\ x . \ y . x and y);
   "or", my_connective_bop (\ x . \ y . x or y);
   "xor", my_connective_bop (\ x . \ y . x xor y);
   "<", my_compare_bop (\ x . \ y . x < y);
   "<=", my_compare_bop (\ x . \ y . x <= y);
   ">", my_compare_bop (\ x . \ y . x > y);
   ">=", my_compare_bop (\ x . \ y . x >= y);
   "=", my_compare_bop (\ x . \ y . x = y);
   "=/=", my_compare_bop (\ x . \ y . x =/= y);
   "cons", binary_to_curried_primitive(\ x . \ y . Cons(x, y));
   "car", Primitive(\ x . (extract_carcdr x) ^ 1);
   "cdr", Primitive(\ x . (extract_carcdr x) ^ 2);
  ]
  empty_environment;

define bind = \ n . \ v . \ env : environment .
  insert_into_associative_array n v env;

define lookup = \ n . \ env : environment .
  lookup_associative_array n env;


define eval = fix \ f . \ exp . \ env .
  match exp with
    INTEGER(i) -> Integer(i)
  | BOOLEAN(b) -> Boolean(b)
  | SYMBOL(s) -> Symbol(s)
  | VARIABLE(v) -> lookup v env
  | IF(c_e1_e2) -> (match force_thunk (f (c_e1_e2 ^ 1) env) with
                      Boolean(c) -> if c then
                                      f (c_e1_e2 ^ 2) env
                                    else
                                      f (c_e1_e2 ^ 3) env
                    | _ -> throw type_error exp)
  | LAMBDA(v_e) -> Closure(v_e ^ 1, v_e ^ 2, env)
  | APPLY(e1_e2) -> my_apply (f (e1_e2 ^ 1) env)
                             Thunk(delay (f (e1_e2 ^ 2) env))
  | REC(f_v_exp) -> make_rec (f_v_exp ^ 1) (f_v_exp ^ 2) (f_v_exp ^ 3) env
//  | _ -> throw error
;

define make_rec = \ func . \ v . \ exp . \ env .
  Closure(v,
          exp,
          bind func
               Primitive(\ z . my_apply (eval REC(func, v, exp) env) z)
               env);

define my_apply = \ v1 . \ v2 .
  match force_thunk v1 with
    Primitive(p) -> p v2
  | Closure(var_exp_env) ->
      eval (var_exp_env ^ 2)
           (bind (var_exp_env ^ 1) v2 (var_exp_env ^ 3))
  | _ -> debug force_thunk v1 in throw not_a_function v1;

define program1 =
  IF(BOOLEAN(false),
     INTEGER(10),
     INTEGER(23));

define program2 =
  APPLY(VARIABLE("not"), BOOLEAN(true));

define square = 
  LAMBDA("x", APPLY3(VARIABLE("*"), VARIABLE("x"), VARIABLE("x")));

define fact =
  REC("fact",
      "n",
      IF(APPLY3(VARIABLE("="), VARIABLE("n"), INTEGER(0)),
         INTEGER(1),
         APPLY3(VARIABLE("*"),
                VARIABLE("n"),
                APPLY(VARIABLE("fact"),
                      APPLY3(VARIABLE("-"), VARIABLE("n"), INTEGER(1))))));

define five =
  APPLY(APPLY(VARIABLE("+"),
              INTEGER(2)),
        INTEGER(3));

define program3 = APPLY(fact, INTEGER(10));

//define program = APPLY3(VARIABLE("cons"), INTEGER(1), INTEGER(2));

define dontstopf = REC("f", "x", APPLY(VARIABLE("f"), VARIABLE("x")));

define dontstop = APPLY(dontstopf, INTEGER(1));

define cons = LAMBDA("a",
                     LAMBDA("b",
                            APPLY3(VARIABLE("cons"), 
                                   VARIABLE("a"), 
                                   VARIABLE("b"))));

define f = LAMBDA("x",
                  LAMBDA("y",
                         APPLY3(VARIABLE("+"),
                                VARIABLE("y"),
                                INTEGER(2))));

define naturals_function =
  REC("f",
      "n",
      APPLY3(cons,
             VARIABLE("n"),
             APPLY(VARIABLE("f"), APPLY3(VARIABLE("+"),
                                         VARIABLE("n"),
                                         INTEGER(1)))));
define naturals = 
  APPLY(naturals_function, INTEGER(1));

define first_n =
  REC("f",
      "xs",
      LAMBDA("n",
             IF(APPLY3(VARIABLE("="), VARIABLE("n"), INTEGER(0)),
                SYMBOL("nil"),
                APPLY3(cons,
                       APPLY(VARIABLE("car"),
                             VARIABLE("xs")),
                       APPLY3(VARIABLE("f"),
                              APPLY(VARIABLE("cdr"), VARIABLE("xs")),
                              APPLY3(VARIABLE("-"), VARIABLE("n"), 
INTEGER(1)))))));

//define program = APPLY3(first_n, naturals, INTEGER(10));
define program = naturals;

define main = begin
  output_value (eval program initial_environment);
  output_string "\n";
end;