letrec

Author: matklad

lib_src/gcc_compiler.ml

@@ -83,6 +83,20 @@ let rec compile_expr expr state =
     | Cdr expr ->
       let (tuple_expr, f) = compile_expr expr state in
       (tuple_expr @ [CDR]), f
+    | Letrec (bindings, body) ->
+        let n = List.length bindings in
+        let names = List.map ~f:fst bindings in
+        let rec_env = push_vars state.env names in
+        let rec_state = {functions = state.functions; env = rec_env} in
+        let (vals_code, s1) = List.fold_left bindings
+            ~init: ([], rec_state)
+            ~f:(fun (code, state) (_name, e) ->
+               let (c, s1) = compile_expr e state in
+               (code @ c, s1))
+        in
+        let id = Address.create () in
+        let s2 = compile_func id names body s1 in
+        DUM n :: vals_code @ [LDF id] @ [RAP n], s2
 
 and compile_func id formals expr {functions; env} =
   let e_env = push_vars env formals in
@@ -131,6 +145,8 @@ let assemble instructions =
       | SEL (addr1, addr2) -> sprintf "SEL %d %d" (resolve addr1) (resolve addr2)
       | LDF addr -> sprintf "LDF %d" (resolve addr)
       | AP n -> sprintf "AP %d" n
+      | DUM n -> sprintf "DUM %d" n
+      | RAP n -> sprintf "RAP %d" n
       | _ ->
         let sexp = Sexp.to_string (sexp_of_instruction instruction) in
         failwithf "unsupported instruction %s" sexp ()

lib_src/gcc_types.ml

@@ -47,6 +47,7 @@ type expr =
   | Cons of expr * expr
   | Fn of var list * expr
   | Call of expr * expr list
+  | Letrec of (var * expr) list * expr
   | If of expr * expr * expr
   | Eq of expr * expr
   | Gt of expr * expr