110 lines
3.7 KiB
OCaml
110 lines
3.7 KiB
OCaml
(* flan — milestone 2 driver. *)
|
|
|
|
let with_errors path f =
|
|
try f () with
|
|
| Flan.Loc.Error (loc, msg) ->
|
|
Printf.eprintf "%s: %s\n" (Flan.Loc.to_string loc) msg;
|
|
ignore path;
|
|
exit 1
|
|
|
|
let summarise (d : Flan.Ast.decl) =
|
|
let open Flan.Ast in
|
|
match d.d with
|
|
| Package n -> Printf.sprintf "package %s" n
|
|
| Import (a, p) -> Printf.sprintf "import %s %S" a p
|
|
| Defalias (n, _) -> Printf.sprintf "defalias %s" n
|
|
| Defstruct (n, fs) -> Printf.sprintf "defstruct %s (%d fields)" n (List.length fs)
|
|
| Defunion (n, vs) -> Printf.sprintf "defunion %s (%d cases)" n (List.length vs)
|
|
| Defvar (n, _, _) -> Printf.sprintf "defvar %s" n
|
|
| Defconst (n, _, _) -> Printf.sprintf "defconst %s" n
|
|
| Defn fn ->
|
|
Printf.sprintf "defn %s (%d params, %s return, %d body forms)"
|
|
fn.name (List.length fn.params)
|
|
(match fn.ret with None -> "Unit" | Some _ -> "explicit")
|
|
(List.length fn.fbody)
|
|
|
|
let () =
|
|
match Array.to_list Sys.argv with
|
|
| _ :: "read" :: files when files <> [] ->
|
|
List.iter
|
|
(fun path ->
|
|
with_errors path (fun () ->
|
|
Flan.Reader.read_file path
|
|
|> List.iter (fun f -> print_endline (Flan.Form.to_string f))))
|
|
files
|
|
| _ :: "parse" :: files when files <> [] ->
|
|
List.iter
|
|
(fun path ->
|
|
with_errors path (fun () ->
|
|
Flan.Reader.read_file path
|
|
|> Flan.Parse.program
|
|
|> List.iter (fun d -> print_endline (summarise d))))
|
|
files
|
|
| _ :: "check" :: files when files <> [] ->
|
|
List.iter
|
|
(fun path ->
|
|
with_errors path (fun () ->
|
|
let p =
|
|
Flan.Reader.read_file path
|
|
|> Flan.Parse.program
|
|
|> Flan.Check.program
|
|
in
|
|
List.iter
|
|
(fun (g : Flan.Tast.global) ->
|
|
Printf.printf "%s %s %s\n"
|
|
(if g.gconst then "defconst" else "defvar")
|
|
g.gname (Flan.Types.to_string g.gty))
|
|
p.globals;
|
|
List.iter
|
|
(fun (f : Flan.Tast.fn) ->
|
|
Printf.printf "defn %s : (Fn [%s] %s) %d slots\n" f.name
|
|
(String.concat " "
|
|
(List.map Flan.Types.to_string f.params))
|
|
(Flan.Types.to_string f.ret) (Array.length f.slots))
|
|
p.fns))
|
|
files
|
|
| _ :: "emit" :: files when files <> [] ->
|
|
List.iter
|
|
(fun path ->
|
|
with_errors path (fun () ->
|
|
Flan.Reader.read_file path
|
|
|> Flan.Parse.program
|
|
|> Flan.Check.program
|
|
|> Flan.Emit.program
|
|
|> print_string))
|
|
files
|
|
| _ :: "build" :: path :: rest ->
|
|
let out =
|
|
match rest with
|
|
| [ "-o"; o ] -> o
|
|
| [] -> Filename.remove_extension (Filename.basename path)
|
|
| _ -> prerr_endline "usage: flan build <file.flan> [-o out]"; exit 2
|
|
in
|
|
with_errors path (fun () ->
|
|
Flan.Reader.read_file path
|
|
|> Flan.Parse.program
|
|
|> Flan.Check.program
|
|
|> fun p -> ignore (Flan.Build.executable p ~out))
|
|
| _ :: "run" :: path :: args ->
|
|
with_errors path (fun () ->
|
|
let exe =
|
|
Filename.concat (Filename.get_temp_dir_name ())
|
|
(Printf.sprintf "flan-run-%d" (Unix.getpid ()))
|
|
in
|
|
Flan.Reader.read_file path
|
|
|> Flan.Parse.program
|
|
|> Flan.Check.program
|
|
|> fun p ->
|
|
ignore (Flan.Build.executable p ~out:exe);
|
|
let code =
|
|
Sys.command (String.concat " " (List.map Filename.quote (exe :: args)))
|
|
in
|
|
(try Sys.remove exe with Sys_error _ -> ());
|
|
exit code)
|
|
| _ ->
|
|
prerr_endline
|
|
"usage: flan (read|parse|check|emit) <file.flan>...\n\
|
|
\ flan build <file.flan> [-o out]\n\
|
|
\ flan run <file.flan> [args...]";
|
|
exit 2
|