Remove FbDK boilerplate + general refactoring

dde.opam

@@ -22,6 +22,8 @@ depends: [
   "core_bench" {>= "0.15.0"}
   "core_unix" {>= "0.15.2"}
   "hashset" {>= "1.0.0"}
+  "fmt" {>= "0.9.0"}
+  "landmarks" {>= "1.4"}
   "odoc" {with-doc}
 ]
 build: [

dune-project

@@ -48,4 +48,8 @@
   (core_unix
    (>= 0.15.2))
   (hashset
-   (>= 1.0.0))))
+   (>= 1.0.0))
+  (fmt
+   (>= 0.9.0))
+  (landmarks
+   (>= 1.4))))

interpreter/src/debugutils.ml

@@ -2,28 +2,28 @@
 
 let is_debug_mode = ref false
 let should_simplify = ref false
-let eval = Fbdk.Interpreter.eval
+let eval = Lib.eval
 
 let parse s =
   let lexbuf = Lexing.from_string (s ^ ";;") in
-  Fbdk.Parser.main Fbdk.Lexer.token lexbuf
+  Parser.main Lexer.token lexbuf
 
-let unparse v = Format.asprintf "%a" Fbdk.Pp.pp_result_value v
+let unparse v = Format.asprintf "%a" Pp.pp_result_value v
 
 let parse_eval s =
-  Fbdk.Interpreter.eval (parse s) ~is_debug_mode:!is_debug_mode
+  Lib.eval (parse s) ~is_debug_mode:!is_debug_mode
     ~should_simplify:!should_simplify
 
 let parse_eval_unparse s =
   unparse
-  @@ Fbdk.Interpreter.eval (parse s) ~is_debug_mode:!is_debug_mode
+  @@ Lib.eval (parse s) ~is_debug_mode:!is_debug_mode
        ~should_simplify:!should_simplify
 
 let peu = parse_eval_unparse
 
 let parse_eval_print s =
-  Format.printf "==> %a\n" Fbdk.Pp.pp_result_value
-    (Fbdk.Interpreter.eval (parse s) ~is_debug_mode:!is_debug_mode
+  Format.printf "==> %a\n" Pp.pp_result_value
+    (Lib.eval (parse s) ~is_debug_mode:!is_debug_mode
        ~should_simplify:!should_simplify)
 
 (* let pp s = s |> parse |> unparse |> print_string |> print_newline *)

interpreter/src/dune

@@ -1,11 +1,11 @@
 (library
- (name interpreter)
- (public_name dde.interpreter)
+ (name interp)
+ (public_name dde.interp)
  (preprocess
   (pps ppx_deriving.show bisect_ppx ppx_jane))
  (instrumentation
   (backend bisect_ppx --bisect-file _build/bisect))
- (modules fbdk debugutils ast type interp lexer options parser pp)
+ (modules lexer parser ast lib pp debugutils)
  (libraries core hashcons))
 
 (ocamllex
@@ -18,11 +18,11 @@
  (name main)
  (modes byte)
  (modules main)
- (libraries interpreter))
+ (libraries interp))
 
 (toplevel
  (name toplevel)
- (libraries utop interpreter))
+ (libraries utop interp))
 
 (alias
  (name distributables)

interpreter/src/main.ml

@@ -1,4 +1,4 @@
-open Interpreter
+open Interp
 
 let toplevel_loop typechecking_enabled show_types is_debug_mode should_simplify
     =
@@ -19,33 +19,18 @@ let toplevel_loop typechecking_enabled show_types is_debug_mode should_simplify
   let safe_parse () =
     try
       let lexbuf = Lexing.from_channel stdin in
-      Some (Fbdk.Parser.main Fbdk.Lexer.token lexbuf)
+      Some (Parser.main Lexer.token lexbuf)
     with
     | Exit -> exit 0
     | ex ->
         print_exception ex;
         None
   in
-  (* Type check if enabled and return the result. The result is a false *)
-  (* only if it is enabled and type checking throws an exception (fails) *)
-  let safe_typecheck ast =
-    try
-      if typechecking_enabled then (
-        let exprtype = Fbdk.Typechecker.typecheck ast in
-        if show_types then Format.printf " : %a\n" Fbdk.Pp.pp_fbtype exprtype;
-        true)
-      else true
-    with
-    | Fbdk.Typechecker.TypecheckerNotImplementedException -> true
-    | ex ->
-        print_exception ex;
-        false
-  in
   (* Interpret and print. Exceptions are caught and reported. But the toploop is not aborted *)
   let safe_interpret_and_print ast =
     try
-      let result = Fbdk.Interpreter.eval ast ~is_debug_mode ~should_simplify in
-      Format.printf "==> %a\n" Fbdk.Pp.pp_result_value result
+      let result = Lib.eval ast ~is_debug_mode ~should_simplify in
+      Format.printf "==> %a\n" Pp.pp_result_value result
     with ex -> print_exception ex
   in
   Format.printf "\t(typechecker %s)\n\n"
@@ -58,50 +43,50 @@ let toplevel_loop typechecking_enabled show_types is_debug_mode should_simplify
     match parse_result with
     | None -> ()
     | Some ast ->
-        if safe_typecheck ast then safe_interpret_and_print ast else ();
+        safe_interpret_and_print ast;
         Format.print_flush ()
   done
 
 let run_file filename is_debug_mode should_simplify =
   let fin = open_in filename in
   let lexbuf = Lexing.from_channel fin in
-  let ast = Fbdk.Parser.main Fbdk.Lexer.token lexbuf in
-  let result = Fbdk.Interpreter.eval ast ~is_debug_mode ~should_simplify in
-  Format.printf "%a\n" Fbdk.Pp.pp_result_value result;
+  let ast = Parser.main Lexer.token lexbuf in
+  let result = Lib.eval ast ~is_debug_mode ~should_simplify in
+  Format.printf "%a\n" Pp.pp_result_value result;
   Format.print_flush ()
 
 let main () =
   let filename = ref "" in
   let toplevel = ref true in
   let version = ref false in
-  let no_typechecking = ref (not Fbdk.Typechecker.typecheck_default_enabled) in
+  let no_typechecking = ref false in
+  (* let no_typechecking = ref (not Fbdk.Typechecker.typecheck_default_enabled) in *)
   let no_type_display = ref false in
   let show_exception_stack_trace = ref false in
   let is_debug_mode = ref false in
   let should_simplify = ref false in
   Arg.parse
-    ([
-       ("--typecheck", Arg.Clear no_typechecking, "enable typechecking");
-       ("--no-typecheck", Arg.Set no_typechecking, "disable typechecking");
-       ("--hide-types", Arg.Set no_type_display, "disable displaying of types");
-       ( "--show-backtrace",
-         Arg.Set show_exception_stack_trace,
-         "Enable the display of exception stack traces" );
-       ( "--debug",
-         Arg.Set is_debug_mode,
-         "output debug information from evaluation" );
-       ( "--simplify",
-         Arg.Set should_simplify,
-         "eagerly simplify (substitute free variables, perform function \
-          application, etc.)result" );
-     ]
-    @ Fbdk.Options.options)
+    [
+      ("--typecheck", Arg.Clear no_typechecking, "enable typechecking");
+      ("--no-typecheck", Arg.Set no_typechecking, "disable typechecking");
+      ("--hide-types", Arg.Set no_type_display, "disable displaying of types");
+      ( "--show-backtrace",
+        Arg.Set show_exception_stack_trace,
+        "Enable the display of exception stack traces" );
+      ( "--debug",
+        Arg.Set is_debug_mode,
+        "output debug information from evaluation" );
+      ( "--simplify",
+        Arg.Set should_simplify,
+        "eagerly simplify (substitute free variables, perform function \
+         application, etc.)result" );
+    ]
     (function
       | fname ->
           filename := fname;
           version := false;
           toplevel := false)
-    ("Usage: " ^ Fbdk.name ^ " [ options ] [ filename ]\noptions:");
+    "Usage: Interp [ options ] [ filename ]\noptions:";
 
   Printexc.record_backtrace !show_exception_stack_trace;
 

interpreter/src/pp.ml

@@ -12,7 +12,7 @@ let is_compound_expr = function Var _ -> false | _ -> true
 let rec pp_expr fmt = function
   | Int i -> ff fmt "%d" i
   | Bool b -> ff fmt "%b" b
-  | Function (Ident i, x, l) -> ff fmt "@[<hv>fun %s ->@;<1 4>%a@]" i pp_expr x
+  | Function (Ident i, x, l) -> ff fmt "@[<hv>fun %s ->@;<0 2>%a@]" i pp_expr x
   | Var (Ident x, l) -> ff fmt "%s" x
   | Appl (e1, e2, _) ->
       let is_compound_exprL = function
@@ -36,7 +36,7 @@ let rec pp_expr fmt = function
   | Lt (e1, e2) -> ff fmt "(%a < %a)" pp_expr e1 pp_expr e2
   | Not e1 -> ff fmt "(not %a)" pp_expr e1
   | If (e1, e2, e3, _) ->
-      ff fmt "@[<hv>if %a then@;<1 4>%a@;<1 0>else@;<1 4>%a@]" pp_expr e1
+      ff fmt "@[<hv>if %a then@;<1 2>%a@;<1 0>else@;<1 2>%a@]" pp_expr e1
         pp_expr e2 pp_expr e3
   | Let (Ident i, e1, e2, _) ->
       ff fmt "@[<hv>let %s =@;<1 4>%a@;<1 0>in@;<1 4>%a@]" i pp_expr e1 pp_expr
@@ -102,6 +102,4 @@ let rec pp_res_val_fv fmt = function
   | BoolResFv b -> ff fmt "%b" b
   | VarResFv (Ident x) -> ff fmt "%s" x
   | GeResFv (v1, v2) -> ff fmt "%a > %a" pp_res_val_fv v1 pp_res_val_fv v2
-  | v ->
-      (* Format.printf "%a" Ast.pp_res_val_fv v *)
-      ()
+  | _ -> ()

interpreter/tests/dune

@@ -5,7 +5,7 @@
   ounit2
   core_bench
   core_unix.command_unix
-  dde.interpreter
+  dde.interp
   dde.dinterp
   fbdk.fb
   fbdk.fbenv))