move modules around

bin/main.ml

@@ -4,6 +4,6 @@ let () =
 
   try
     let syn = Spice.parse "val x = 3 val y = x + 1" in
-    let ir = Spice.compile syn in
-    Fmt.pr "%a\n" Spice.Ir.pp_entrypoint ir
+    let lir = Spice.compile syn in
+    Fmt.pr "%a\n" Spice.Lir.pp_entrypoint lir
   with Spice.Error msg -> Logs.err (fun m -> m "%s" msg)

lib/dune

@@ -1,20 +1,3 @@
 (library
  (name spice)
- (libraries fmt))
-
-(menhir
- (modules parser)
- (flags --unused-tokens))
-
-(ocamllex
- (modules lexer))
-
-; (menhir
-;  (modules parser))
-
-; (ocamllex lexer)
-
-; (library
-;  (name json_parser)
-;  (modules parser lexer json)
-;  (libraries core))
+ (libraries fmt spice_syntax spice_lower))

lib/lower/dune

@@ -0,0 +1,3 @@
+(library
+ (name spice_lower)
+ (libraries spice_syntax fmt))

lib/lower/lir.ml

@@ -1,3 +1,5 @@
+module Syn = Spice_syntax.Ast
+
 module Id = struct
   type t = {
     name : string;

lib/lower/normalize.ml

@@ -1,29 +1,30 @@
 module Env = Map.Make (String)
+module Syn = Spice_syntax.Ast
 
 type binding =
-  | Var_arg of Ir.arg
-  | Var_ele of Ir.arg * Ir.name
-  | Var_fun of Ir.arg * Ir.name
+  | Var_arg of Lir.arg
+  | Var_ele of Lir.arg * Lir.name
+  | Var_fun of Lir.arg * Lir.name
 
 let ( @@@ ) f g x = f (g x)
 let fcf_mthd_name = "call"
 
-let anf modl =
+let to_anf modl =
   let next_uid = ref 0 in
   let gen_id name =
     let uid = !next_uid in
     incr next_uid;
-    Ir.Id.{ name; uid }
+    Lir.Id.{ name; uid }
   in
 
   let lift_rhs name rhs =
     let tmp = gen_id name in
-    let ctx rest = Ir.Let (tmp, rhs, rest) in
-    Ir.Arg tmp, ctx
+    let ctx rest = Lir.Let (tmp, rhs, rest) in
+    Lir.Arg tmp, ctx
   in
 
   let rec lower_exp env = function
-    | Syn.Literal l -> lift_rhs "lit" (Ir.Literal l)
+    | Syn.Literal l -> lift_rhs "lit" (Lir.Literal l)
     | Syn.Path p -> lower_path env p
     | Syn.Call (fn, args) ->
         let (ob_v, ob_ctx), mthd =
@@ -42,14 +43,14 @@ let anf modl =
             ([], ob_ctx)
             args
         in
-        let fn_e = Ir.Ele (ob_v, mthd) in
+        let fn_e = Lir.Ele (ob_v, mthd) in
         let arg_vs = List.rev arg_vs_rev in
-        let v, call_ctx = lift_rhs mthd (Ir.Call (fn_e, arg_vs)) in
+        let v, call_ctx = lift_rhs mthd (Lir.Call (fn_e, arg_vs)) in
         v, ctx @@@ call_ctx
     | Syn.Binop (op, e1, e2) ->
         let v1, v1_ctx = lower_exp env e1 in
         let v2, v2_ctx = lower_exp env e2 in
-        let v, op_ctx = lift_rhs "op" (Ir.Binop (op, v1, v2)) in
+        let v, op_ctx = lift_rhs "op" (Lir.Binop (op, v1, v2)) in
         v, v1_ctx @@@ v2_ctx @@@ op_ctx
     | Syn.If (e1, e2, e3) ->
         let v1, v1_ctx = lower_exp env e1 in
@@ -58,12 +59,12 @@ let anf modl =
         let jn = gen_id "jn" in
         let rv = gen_id "rv" in
         let ctx rest =
-          let cont = Ir.{ params = [ rv ]; body = rest } in
-          let e2 = v2_ctx (Ir.Jump (jn, [ v2 ])) in
-          let e3 = v3_ctx (Ir.Jump (jn, [ v3 ])) in
-          v1_ctx (Ir.Let (jn, Cont cont, If (v1, e2, e3)))
+          let cont = Lir.{ params = [ rv ]; body = rest } in
+          let e2 = v2_ctx (Lir.Jump (jn, [ v2 ])) in
+          let e3 = v3_ctx (Lir.Jump (jn, [ v3 ])) in
+          v1_ctx (Lir.Let (jn, Cont cont, If (v1, e2, e3)))
         in
-        Ir.Arg rv, ctx
+        Lir.Arg rv, ctx
     | Syn.Obj items -> lower_obj env items
     (* | Syn.Fun (xs, e) -> () *)
     (* | Syn.Scope items -> () *)
@@ -72,19 +73,19 @@ let anf modl =
     | Syn.Var x -> (
         match Env.find x env with
         | Var_arg v -> v, Fun.id
-        | Var_ele (ob, el) -> lift_rhs x (Ir.Get (Ele (ob, el)))
+        | Var_ele (ob, el) -> lift_rhs x (Lir.Get (Ele (ob, el)))
         | Var_fun (ob, el) ->
             (* TODO: special treatment for known FCF's? *)
-            lift_rhs x (Ir.Get (Ele (ob, el)))
+            lift_rhs x (Lir.Get (Ele (ob, el)))
         | exception Not_found -> failwith (Fmt.str "undefined variable %S" x))
     | Syn.Ele (ob, el) ->
         let ob_v, ob_ctx = lower_exp env ob in
-        let el_v, el_ctx = lift_rhs el (Ir.Get (Ele (ob_v, el))) in
+        let el_v, el_ctx = lift_rhs el (Lir.Get (Ele (ob_v, el))) in
         el_v, ob_ctx @@@ el_ctx
   and lower_obj env items =
     (* TODO: detect duplicate item names *)
     let ob = gen_id "ob" in
-    let ob_v = Ir.Arg ob in
+    let ob_v = Lir.Arg ob in
     (* TODO: get last expression in block *)
     let env, slots, mthds, inits =
       List.fold_left
@@ -123,8 +124,8 @@ let anf modl =
               params
           in
           let body_v, body_ctx = lower_exp env' body in
-          let body = body_ctx (Ir.Ret body_v) in
-          Ir.{ name; defn = { params; body } })
+          let body = body_ctx (Lir.Ret body_v) in
+          Lir.{ name; defn = { params; body } })
         mthds
     in
     (* inits was built in reverse order, so make sure to *prepend* contexts
@@ -137,17 +138,17 @@ let anf modl =
               ctx @@@ ctx'
           | `Val (name, rhs) ->
               let rhs_v, rhs_ctx = lower_exp env rhs in
-              let set_ctx rest = Ir.Set (Ele (ob_v, name), rhs_v, rest) in
+              let set_ctx rest = Lir.Set (Ele (ob_v, name), rhs_v, rest) in
               rhs_ctx @@@ set_ctx @@@ ctx'
           | `Obj (name, body) ->
               let ob_v, ob_ctx = lower_obj env body in
-              let set_ctx rest = Ir.Set (Ele (ob_v, name), ob_v, rest) in
+              let set_ctx rest = Lir.Set (Ele (ob_v, name), ob_v, rest) in
               ob_ctx @@@ set_ctx @@@ ctx')
         Fun.id
         inits
     in
     let slots = List.rev slots in
-    let ob_ctx rest = Ir.Let (ob, Obj { mthds; slots }, rest) in
+    let ob_ctx rest = Lir.Let (ob, Obj { mthds; slots }, rest) in
     ob_v, ob_ctx @@@ init_ctx
   in
 
@@ -168,5 +169,5 @@ let anf modl =
 
   let ret_v, ctx = lower_obj std_env modl.Syn.items in
   let params = [ std ] in
-  let body = ctx (Ir.Ret ret_v) in
-  Ir.{ params; body }
+  let body = ctx (Lir.Ret ret_v) in
+  Lir.{ params; body }

lib/spice.ml

@@ -1,5 +1,5 @@
-module Syn = Syn
-module Ir = Ir
+module Syn = Spice_syntax.Ast
+module Lir = Spice_lower.Lir
 
 exception Error of string
 
@@ -7,9 +7,10 @@ let failf f = Fmt.kstr (fun s -> raise (Error s)) f
 
 let parse input =
   let lexbuf = Lexing.from_string input ~with_positions:true in
-  try Parser.modl Lexer.read lexbuf with
-  | Parser.Error -> failf "syntax error"
-  | Lexer.Error msg -> failf "syntax error: %s" msg
+  try Spice_syntax.Parser.modl Spice_syntax.Lexer.read lexbuf with
+  | Spice_syntax.Parser.Error -> failf "syntax error"
+  | Spice_syntax.Lexer.Error msg -> failf "syntax error: %s" msg
 
 let compile syn =
-  try Anf_pass.anf syn with Failure msg -> failf "compilation error: %s" msg
+  try Spice_lower.Normalize.to_anf syn
+  with Failure msg -> failf "compilation error: %s" msg

lib/syntax/dune

@@ -0,0 +1,10 @@
+(library
+ (name spice_syntax)
+ (libraries fmt))
+
+(menhir
+ (modules parser)
+ (flags --unused-tokens))
+
+(ocamllex
+ (modules lexer))

lib/syntax/parser.mly

@@ -1,6 +1,6 @@
 %token <int64> Int
-%token <Syn.name> Name
-%token <Syn.binop> Binop
+%token <Ast.name> Name
+%token <Ast.binop> Binop
 
 %token LP "("  RP ")"
 %token LC "{"  RC "}"
@@ -18,10 +18,10 @@
 %token Kw_else "else"
 
 %token EOF
-%start <Syn.modl> modl
+%start <Ast.modl> modl
 
 %{
-    open Syn
+    open Ast
 
     let infix_base e0 = (e0, [])
     let infix_app (e0, ops) op e2 = (e0, (op, e2) :: ops)