diff options
Diffstat (limited to 'bin/run.ml')
-rw-r--r-- | bin/run.ml | 163 |
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 @@ | |||
1 | open Core | ||
2 | |||
3 | let opts = Settings.opts | ||
4 | |||
5 | module Origin = struct | ||
6 | type t = Filename of string | Stdin | Interactive | ||
7 | |||
8 | let to_string = function | ||
9 | | Filename name -> name | ||
10 | | Stdin -> "<stdin>" | ||
11 | | Interactive -> "<interactive>" | ||
12 | end | ||
13 | |||
14 | (* [dir] must be an absolute path *) | ||
15 | let rec find_imports_file dir : (string, string) result = | ||
16 | let def_filename = Filename.concat dir "importdef.sexp" in | ||
17 | match Core_unix.access def_filename [ `Read ] with | ||
18 | | Ok () -> Ok def_filename | ||
19 | | Error (Core_unix.Unix_error (ENOENT, _, _)) | ||
20 | | Error (Core_unix.Unix_error (EACCES, _, _)) -> | ||
21 | let parent = Filename.dirname dir in | ||
22 | if String.(parent = dir) then Error "Could not find importdef.sexp file" | ||
23 | else find_imports_file (Filename.dirname dir) | ||
24 | | Error _ -> Error "Could not find importdef.sexp file" | ||
25 | |||
26 | let load_imports ~for_ = | ||
27 | let cwd = Core_unix.getcwd () in | ||
28 | let filename = | ||
29 | match !(opts.imports_def_file) with | ||
30 | | None -> ( | ||
31 | let dir = | ||
32 | match for_ with | ||
33 | | Origin.Filename filename -> | ||
34 | Filename.to_absolute_exn | ||
35 | (Filename.dirname filename) | ||
36 | ~relative_to:cwd | ||
37 | | Origin.Stdin | Origin.Interactive -> cwd | ||
38 | in | ||
39 | match find_imports_file dir with | ||
40 | | Error _ -> | ||
41 | printf | ||
42 | "Note: no importdef.sexp was found / could be accessed; imports \ | ||
43 | will not work\n\ | ||
44 | %!"; | ||
45 | None | ||
46 | | Ok filename -> | ||
47 | let relative = | ||
48 | if Filename.is_absolute filename then | ||
49 | Filename.of_absolute_exn filename ~relative_to:cwd | ||
50 | else filename | ||
51 | in | ||
52 | printf "Imports definition found at %s\n%!" relative; | ||
53 | Some filename) | ||
54 | | Some filename -> Some filename | ||
55 | in | ||
56 | match filename with | ||
57 | | None -> Ok [] | ||
58 | | Some filename -> ( | ||
59 | (* User-provided filenames may not be absolute *) | ||
60 | let filename_abs = Filename.to_absolute_exn filename ~relative_to:cwd in | ||
61 | try | ||
62 | Ok | ||
63 | (In_channel.read_all filename | ||
64 | |> Sexp.of_string |> Mininix.Sexp.import_forest_of_sexp | ||
65 | |> Mininix.Import.materialize | ||
66 | ~relative_to:(Filename.dirname filename_abs)) | ||
67 | with Sys_error err -> Error ("Failed to read imports definition: " ^ err)) | ||
68 | |||
69 | let eval_expr_with_imports ~origin ~imports data = | ||
70 | let cwd = Core_unix.getcwd () in | ||
71 | let config = Sexp_pretty.Config.default | ||
72 | and formatter = Stdlib.Format.formatter_of_out_channel stdout in | ||
73 | try | ||
74 | if !(opts.print_input) then printf "==> Input Nix:\n%s\n\n%!" data; | ||
75 | let nexp = Nix.parse ~filename:(Origin.to_string origin) data in | ||
76 | if !(opts.print_parsed) then ( | ||
77 | print_string "==> Parsed Nix:\n"; | ||
78 | Nix.Printer.print stdout nexp; | ||
79 | printf "\n\n%!"); | ||
80 | let nnexp = | ||
81 | Nix.elaborate | ||
82 | ~dir: | ||
83 | (Some | ||
84 | (match origin with | ||
85 | | Filename name -> | ||
86 | Filename.to_absolute_exn ~relative_to:cwd | ||
87 | (Filename.dirname name) | ||
88 | | Stdin | Interactive -> cwd)) | ||
89 | nexp | ||
90 | in | ||
91 | if !(opts.print_elaborated) then ( | ||
92 | print_string "==> Parsed, elaborated Nix:\n"; | ||
93 | Nix.Printer.print stdout nnexp; | ||
94 | printf "\n\n%!"); | ||
95 | if !(opts.print_nix_sexp) then ( | ||
96 | let nsexp = Nix.Ast.sexp_of_expr nnexp in | ||
97 | print_string "==> Nix S-expr:\n"; | ||
98 | Sexp_pretty.pp_formatter config formatter nsexp; | ||
99 | printf "\n%!"); | ||
100 | let mnexp = Mininix.Nix2mininix.from_nix nnexp in | ||
101 | if !(opts.print_mininix_sexp) then ( | ||
102 | let mnsexp = Mininix.Sexp.expr_to_sexp mnexp in | ||
103 | print_string "==> Mininix S-expr:\n"; | ||
104 | Sexp_pretty.pp_formatter config formatter mnsexp; | ||
105 | printf "\n%!"); | ||
106 | let mnwpexp = Mininix.apply_prelude mnexp in | ||
107 | if !(opts.print_mininix_sexp_w_prelude) then ( | ||
108 | let mnwpsexp = Mininix.Sexp.expr_to_sexp mnwpexp in | ||
109 | print_string "==> Mininix S-expr (+ prelude):\n"; | ||
110 | Sexp_pretty.pp_formatter config formatter mnwpsexp; | ||
111 | printf "\n%!"); | ||
112 | let res = | ||
113 | Mininix.interp_tl ~fuel:!(opts.fuel_amount) ~mode:!(opts.eval_strategy) | ||
114 | ~imports mnwpexp | ||
115 | in | ||
116 | if !(opts.print_result_mininix_sexp) then ( | ||
117 | let ressexp = Mininix.Sexp.val_res_to_sexp res in | ||
118 | print_string "==> Evaluation result (Mininix S-exp):\n"; | ||
119 | Sexp_pretty.pp_formatter config formatter ressexp; | ||
120 | printf "\n%!"); | ||
121 | match res with | ||
122 | | Res (Some v) -> | ||
123 | let nixv = Mininix.Mininix2nix.from_val v in | ||
124 | if !(opts.print_result_nix_sexp) then ( | ||
125 | let nixvsexp = Nix.Ast.sexp_of_expr nixv in | ||
126 | print_string "==> Evaluation result (Nix S-exp):\n"; | ||
127 | Sexp_pretty.pp_formatter config formatter nixvsexp; | ||
128 | printf "\n%!"); | ||
129 | print_string "==> Evaluation result (Nix):\n"; | ||
130 | Nix.Printer.print stdout nixv; | ||
131 | printf "\n%!"; | ||
132 | true | ||
133 | | Res None -> | ||
134 | printf "Failed to evaluate\n%!"; | ||
135 | false | ||
136 | | _ -> | ||
137 | printf "Ran out of fuel\n%!"; | ||
138 | false | ||
139 | with | ||
140 | | Nix.ParseError msg -> | ||
141 | printf "Failed to parse: %s\n%!" msg; | ||
142 | false | ||
143 | | Nix.ElaborateError msg -> | ||
144 | printf "Elaboration failed: %s\n%!" msg; | ||
145 | false | ||
146 | | Mininix.Nix2mininix.FromNixError msg -> | ||
147 | printf "Failed to convert Nix to Mininix: %s\n%!" msg; | ||
148 | false | ||
149 | |||
150 | let eval_expr ~origin data = | ||
151 | match load_imports ~for_:origin with | ||
152 | | Ok imports -> eval_expr_with_imports ~origin ~imports data | ||
153 | | Error msg -> | ||
154 | print_endline msg; | ||
155 | false | ||
156 | |||
157 | let eval_ch ~origin ch = In_channel.input_all ch |> eval_expr ~origin | ||
158 | |||
159 | let eval_file filename = | ||
160 | In_channel.with_file filename ~binary:true | ||
161 | ~f:(eval_ch ~origin:(Filename filename)) | ||
162 | |||
163 | let eval_stdin () = eval_ch In_channel.stdin ~origin:Stdin | ||