Initialize repository

1 files changed, 163 insertions, 0 deletions

diff --git a/bin/run.ml b/bin/run.ml
new file mode 100644
index 0000000..f39997c
--- /dev/null
+++ b/bin/run.ml
@@ -0,0 +1,163 @@
+open Core
+
+let opts = Settings.opts
+
+module Origin = struct
+  type t = Filename of string | Stdin | Interactive
+
+  let to_string = function
+    | Filename name -> name
+    | Stdin -> "<stdin>"
+    | Interactive -> "<interactive>"
+end
+
+(* [dir] must be an absolute path *)
+let rec find_imports_file dir : (string, string) result =
+  let def_filename = Filename.concat dir "importdef.sexp" in
+  match Core_unix.access def_filename [ `Read ] with
+  | Ok () -> Ok def_filename
+  | Error (Core_unix.Unix_error (ENOENT, _, _))
+  | Error (Core_unix.Unix_error (EACCES, _, _)) ->
+      let parent = Filename.dirname dir in
+      if String.(parent = dir) then Error "Could not find importdef.sexp file"
+      else find_imports_file (Filename.dirname dir)
+  | Error _ -> Error "Could not find importdef.sexp file"
+
+let load_imports ~for_ =
+  let cwd = Core_unix.getcwd () in
+  let filename =
+    match !(opts.imports_def_file) with
+    | None -> (
+        let dir =
+          match for_ with
+          | Origin.Filename filename ->
+              Filename.to_absolute_exn
+                (Filename.dirname filename)
+                ~relative_to:cwd
+          | Origin.Stdin | Origin.Interactive -> cwd
+        in
+        match find_imports_file dir with
+        | Error _ ->
+            printf
+              "Note: no importdef.sexp was found / could be accessed; imports \
+               will not work\n\
+               %!";
+            None
+        | Ok filename ->
+            let relative =
+              if Filename.is_absolute filename then
+                Filename.of_absolute_exn filename ~relative_to:cwd
+              else filename
+            in
+            printf "Imports definition found at %s\n%!" relative;
+            Some filename)
+    | Some filename -> Some filename
+  in
+  match filename with
+  | None -> Ok []
+  | Some filename -> (
+      (* User-provided filenames may not be absolute *)
+      let filename_abs = Filename.to_absolute_exn filename ~relative_to:cwd in
+      try
+        Ok
+          (In_channel.read_all filename
+          |> Sexp.of_string |> Mininix.Sexp.import_forest_of_sexp
+          |> Mininix.Import.materialize
+               ~relative_to:(Filename.dirname filename_abs))
+      with Sys_error err -> Error ("Failed to read imports definition: " ^ err))
+
+let eval_expr_with_imports ~origin ~imports data =
+  let cwd = Core_unix.getcwd () in
+  let config = Sexp_pretty.Config.default
+  and formatter = Stdlib.Format.formatter_of_out_channel stdout in
+  try
+    if !(opts.print_input) then printf "==> Input Nix:\n%s\n\n%!" data;
+    let nexp = Nix.parse ~filename:(Origin.to_string origin) data in
+    if !(opts.print_parsed) then (
+      print_string "==> Parsed Nix:\n";
+      Nix.Printer.print stdout nexp;
+      printf "\n\n%!");
+    let nnexp =
+      Nix.elaborate
+        ~dir:
+          (Some
+             (match origin with
+             | Filename name ->
+                 Filename.to_absolute_exn ~relative_to:cwd
+                   (Filename.dirname name)
+             | Stdin | Interactive -> cwd))
+        nexp
+    in
+    if !(opts.print_elaborated) then (
+      print_string "==> Parsed, elaborated Nix:\n";
+      Nix.Printer.print stdout nnexp;
+      printf "\n\n%!");
+    if !(opts.print_nix_sexp) then (
+      let nsexp = Nix.Ast.sexp_of_expr nnexp in
+      print_string "==> Nix S-expr:\n";
+      Sexp_pretty.pp_formatter config formatter nsexp;
+      printf "\n%!");
+    let mnexp = Mininix.Nix2mininix.from_nix nnexp in
+    if !(opts.print_mininix_sexp) then (
+      let mnsexp = Mininix.Sexp.expr_to_sexp mnexp in
+      print_string "==> Mininix S-expr:\n";
+      Sexp_pretty.pp_formatter config formatter mnsexp;
+      printf "\n%!");
+    let mnwpexp = Mininix.apply_prelude mnexp in
+    if !(opts.print_mininix_sexp_w_prelude) then (
+      let mnwpsexp = Mininix.Sexp.expr_to_sexp mnwpexp in
+      print_string "==> Mininix S-expr (+ prelude):\n";
+      Sexp_pretty.pp_formatter config formatter mnwpsexp;
+      printf "\n%!");
+    let res =
+      Mininix.interp_tl ~fuel:!(opts.fuel_amount) ~mode:!(opts.eval_strategy)
+        ~imports mnwpexp
+    in
+    if !(opts.print_result_mininix_sexp) then (
+      let ressexp = Mininix.Sexp.val_res_to_sexp res in
+      print_string "==> Evaluation result (Mininix S-exp):\n";
+      Sexp_pretty.pp_formatter config formatter ressexp;
+      printf "\n%!");
+    match res with
+    | Res (Some v) ->
+        let nixv = Mininix.Mininix2nix.from_val v in
+        if !(opts.print_result_nix_sexp) then (
+          let nixvsexp = Nix.Ast.sexp_of_expr nixv in
+          print_string "==> Evaluation result (Nix S-exp):\n";
+          Sexp_pretty.pp_formatter config formatter nixvsexp;
+          printf "\n%!");
+        print_string "==> Evaluation result (Nix):\n";
+        Nix.Printer.print stdout nixv;
+        printf "\n%!";
+        true
+    | Res None ->
+        printf "Failed to evaluate\n%!";
+        false
+    | _ ->
+        printf "Ran out of fuel\n%!";
+        false
+  with
+  | Nix.ParseError msg ->
+      printf "Failed to parse: %s\n%!" msg;
+      false
+  | Nix.ElaborateError msg ->
+      printf "Elaboration failed: %s\n%!" msg;
+      false
+  | Mininix.Nix2mininix.FromNixError msg ->
+      printf "Failed to convert Nix to Mininix: %s\n%!" msg;
+      false
+
+let eval_expr ~origin data =
+  match load_imports ~for_:origin with
+  | Ok imports -> eval_expr_with_imports ~origin ~imports data
+  | Error msg ->
+      print_endline msg;
+      false
+
+let eval_ch ~origin ch = In_channel.input_all ch |> eval_expr ~origin
+
+let eval_file filename =
+  In_channel.with_file filename ~binary:true
+    ~f:(eval_ch ~origin:(Filename filename))
+
+let eval_stdin () = eval_ch In_channel.stdin ~origin:Stdin