commit 71af0f0750cca8285b9d45685aadda78bbf09213 Author: cqc Date: Mon Mar 27 15:11:24 2023 -0500 initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5276a98 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*~ +_build/ \ No newline at end of file diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..e69de29 diff --git a/bin/dune b/bin/dune new file mode 100644 index 0000000..f6f7da2 --- /dev/null +++ b/bin/dune @@ -0,0 +1,10 @@ +(executable + (public_name typedastsch) + (name main) + (modes byte) + (flags -I +compiler-libs -linkall + ocamlcommon.cma + ocamlbytecomp.cma + ocamltoplevel.cma ) + (libraries + )) diff --git a/bin/main.ml b/bin/main.ml new file mode 100644 index 0000000..68946e0 --- /dev/null +++ b/bin/main.ml @@ -0,0 +1,848 @@ +let () = print_endline "Hello, World!" + +module Toploop = struct + open Format + include Toploop + (**************************************************************************) + (* *) + (* OCaml *) + (* *) + (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) + (* *) + (* Copyright 1996 Institut National de Recherche en Informatique et *) + (* en Automatique. *) + (* *) + (* All rights reserved. This file is distributed under the terms of *) + (* the GNU Lesser General Public License version 2.1, with the *) + (* special exception on linking described in the file LICENSE. *) + (* *) + (**************************************************************************) + + (* The interactive toplevel loop *) + + open Format + open Misc + open Parsetree + open Types + open Typedtree + open Outcometree + open Ast_helper + module String = Misc.Stdlib.String + + type directive_fun = + | Directive_none of (unit -> unit) + | Directive_string of (string -> unit) + | Directive_int of (int -> unit) + | Directive_ident of (Longident.t -> unit) + | Directive_bool of (bool -> unit) + + type directive_info = { section : string; doc : string } + + (* Phase buffer that stores the last toplevel phrase (see + [Location.input_phrase_buffer]). *) + let phrase_buffer = Buffer.create 1024 + + (* The table of toplevel value bindings and its accessors *) + + let toplevel_value_bindings : Obj.t String.Map.t ref = + ref String.Map.empty + + let getvalue name = + try String.Map.find name !toplevel_value_bindings + with Not_found -> fatal_error (name ^ " unbound at toplevel") + + let setvalue name v = + toplevel_value_bindings := + String.Map.add name v !toplevel_value_bindings + + (* Return the value referred to by a path *) + + let rec eval_address = function + | Env.Aident id -> ( + if Ident.persistent id || Ident.global id then + Symtable.get_global_value id + else + let name = Translmod.toplevel_name id in + try String.Map.find name !toplevel_value_bindings + with Not_found -> + raise (Symtable.Error (Symtable.Undefined_global name))) + | Env.Adot (p, pos) -> Obj.field (eval_address p) pos + + let eval_path find env path = + match find path env with + | addr -> eval_address addr + | exception Not_found -> + fatal_error ("Cannot find address for: " ^ Path.name path) + + let eval_module_path env path = + eval_path Env.find_module_address env path + + let eval_value_path env path = + eval_path Env.find_value_address env path + + let eval_extension_path env path = + eval_path Env.find_constructor_address env path + + let eval_class_path env path = + eval_path Env.find_class_address env path + + (* To print values *) + + module EvalPath = struct + type valu = Obj.t + + exception Error + + let eval_address addr = + try eval_address addr with Symtable.Error _ -> raise Error + + let same_value v1 v2 = v1 == v2 + end + + module Printer = Genprintval.Make (Obj) (EvalPath) + + let max_printer_depth = ref 100 + let max_printer_steps = ref 300 + let print_out_value = Oprint.out_value + let print_out_type = Oprint.out_type + let print_out_class_type = Oprint.out_class_type + let print_out_module_type = Oprint.out_module_type + let print_out_type_extension = Oprint.out_type_extension + let print_out_sig_item = Oprint.out_sig_item + let print_out_signature = Oprint.out_signature + let print_out_phrase = Oprint.out_phrase + + let print_untyped_exception ppf obj = + !print_out_value ppf (Printer.outval_of_untyped_exception obj) + + let outval_of_value env obj ty = + Printer.outval_of_value !max_printer_steps !max_printer_depth + (fun _ _ _ -> None) + env obj ty + + let print_value env obj ppf ty = + !print_out_value ppf (outval_of_value env obj ty) + + type ('a, 'b) gen_printer = ('a, 'b) Genprintval.gen_printer = + | Zero of 'b + | Succ of ('a -> ('a, 'b) gen_printer) + + let install_printer = Printer.install_printer + let install_generic_printer = Printer.install_generic_printer + let install_generic_printer' = Printer.install_generic_printer' + let remove_printer = Printer.remove_printer + + (* Hooks for parsing functions *) + + let parse_toplevel_phrase = ref Parse.toplevel_phrase + let parse_use_file = ref Parse.use_file + let print_location = Location.print_loc + let print_error = Location.print_report + let print_warning = Location.print_warning + let input_name = Location.input_name + + let parse_mod_use_file name lb = + let modname = + String.capitalize_ascii + (Filename.remove_extension (Filename.basename name)) + in + let items = + List.concat + (List.map + (function Ptop_def s -> s | Ptop_dir _ -> []) + (!parse_use_file lb)) + in + [ + Ptop_def + [ + Str.module_ + (Mb.mk + (Location.mknoloc (Some modname)) + (Mod.structure items)); + ]; + ] + + (* Hook for initialization *) + + let toplevel_startup_hook = ref (fun () -> ()) + + type event = .. + type event += Startup | After_setup + + let hooks = ref [] + let add_hook f = hooks := f :: !hooks + + let () = + add_hook (function + | Startup -> !toplevel_startup_hook () + | _ -> ()) + + let run_hooks hook = List.iter (fun f -> f hook) !hooks + + (* Load in-core and execute a lambda term *) + + let may_trace = ref false (* Global lock on tracing *) + + type evaluation_outcome = Result of Obj.t | Exception of exn + + let backtrace = ref None + + let record_backtrace () = + if Printexc.backtrace_status () then + backtrace := Some (Printexc.get_backtrace ()) + + let load_lambda ppf lam = + if !Clflags.dump_rawlambda then + fprintf ppf "%a@." Printlambda.lambda lam; + let slam = Simplif.simplify_lambda lam in + if !Clflags.dump_lambda then + fprintf ppf "%a@." Printlambda.lambda slam; + let init_code, fun_code = Bytegen.compile_phrase slam in + if !Clflags.dump_instr then + fprintf ppf "%a%a@." Printinstr.instrlist init_code + Printinstr.instrlist fun_code; + let code, reloc, events = Emitcode.to_memory init_code fun_code in + let can_free = fun_code = [] in + let initial_symtable = Symtable.current_state () in + Symtable.patch_object code reloc; + Symtable.check_global_initialized reloc; + Symtable.update_global_table (); + let initial_bindings = !toplevel_value_bindings in + let bytecode, closure = + Meta.reify_bytecode code [| events |] None + in + match + may_trace := true; + Fun.protect + ~finally:(fun () -> + may_trace := false; + if can_free then Meta.release_bytecode bytecode) + closure + with + | retval -> Result retval + | exception x -> + record_backtrace (); + toplevel_value_bindings := initial_bindings; + (* PR#6211 *) + Symtable.restore_state initial_symtable; + Exception x + + (* Print the outcome of an evaluation *) + + let pr_item = + Printtyp.print_items (fun env -> function + | Sig_value (id, { val_kind = Val_reg; val_type }, _) -> + Some + (outval_of_value env + (getvalue (Translmod.toplevel_name id)) + val_type) + | _ -> None) + + (* The current typing environment for the toplevel *) + + let toplevel_env = ref Env.empty + + (* Print an exception produced by an evaluation *) + + let print_out_exception ppf exn outv = + !print_out_phrase ppf (Ophr_exception (exn, outv)) + + let print_exception_outcome ppf exn = + if exn = Out_of_memory then Gc.full_major (); + let outv = + outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn + in + print_out_exception ppf exn outv; + if Printexc.backtrace_status () then + match !backtrace with + | None -> () + | Some b -> + print_string b; + backtrace := None + + (* Inserting new toplevel directives *) + + let directive_table = + (Hashtbl.create 23 : (string, directive_fun) Hashtbl.t) + + let directive_info_table = + (Hashtbl.create 23 : (string, directive_info) Hashtbl.t) + + let add_directive name dir_fun dir_info = + Hashtbl.add directive_table name dir_fun; + Hashtbl.add directive_info_table name dir_info + + (* Execute a toplevel phrase *) + + let execute_phrase print_outcome ppf phr = + match phr with + | Ptop_def sstr -> ( + let oldenv = !toplevel_env in + Typecore.reset_delayed_checks (); + let str, sg, sn, _, newenv = + Typemod.type_toplevel_phrase oldenv sstr + in + if !Clflags.dump_typedtree then + Printtyped.implementation ppf str; + let sg' = Typemod.Signature_names.simplify newenv sn sg in + ignore + (Includemod.signatures ~mark:Mark_positive oldenv sg sg'); + Typecore.force_delayed_checks (); + let lam = Translmod.transl_toplevel_definition str in + Warnings.check_fatal (); + try + toplevel_env := newenv; + let res = load_lambda ppf lam in + let out_phr = + match res with + | Result v -> + if print_outcome then + Printtyp.wrap_printing_env ~error:false oldenv + (fun () -> + match str.str_items with + | [ + { + str_desc = + ( Tstr_eval (exp, _) + | Tstr_value + ( Asttypes.Nonrecursive, + [ + { + vb_pat = { pat_desc = Tpat_any }; + vb_expr = exp; + }; + ] ) ); + }; + ] -> + let outv = + outval_of_value newenv v exp.exp_type + in + let ty = + Printtyp.tree_of_type_scheme exp.exp_type + in + Ophr_eval (outv, ty) + | [] -> Ophr_signature [] + | _ -> Ophr_signature (pr_item oldenv sg')) + else Ophr_signature [] + | Exception exn -> + toplevel_env := oldenv; + if exn = Out_of_memory then Gc.full_major (); + let outv = + outval_of_value !toplevel_env (Obj.repr exn) + Predef.type_exn + in + Ophr_exception (exn, outv) + in + !print_out_phrase ppf out_phr; + (if Printexc.backtrace_status () then + match !backtrace with + | None -> () + | Some b -> + pp_print_string ppf b; + pp_print_flush ppf (); + backtrace := None); + match out_phr with + | Ophr_eval (_, _) | Ophr_signature _ -> true + | Ophr_exception _ -> false + with x -> + toplevel_env := oldenv; + raise x) + | Ptop_dir { pdir_name = { Location.txt = dir_name }; pdir_arg } + -> ( + let d = + try Some (Hashtbl.find directive_table dir_name) + with Not_found -> None + in + match d with + | None -> + fprintf ppf "Unknown directive `%s'." dir_name; + let directives = + Hashtbl.fold + (fun dir _ acc -> dir :: acc) + directive_table [] + in + Misc.did_you_mean ppf (fun () -> + Misc.spellcheck directives dir_name); + fprintf ppf "@."; + false + | Some d -> ( + match (d, pdir_arg) with + | Directive_none f, None -> + f (); + true + | Directive_string f, Some { pdira_desc = Pdir_string s } + -> + f s; + true + | ( Directive_int f, + Some { pdira_desc = Pdir_int (n, None) } ) -> ( + match Int_literal_converter.int n with + | n -> + f n; + true + | exception _ -> + fprintf ppf + "Integer literal exceeds the range of \ + representable integers for directive `%s'.@." + dir_name; + false) + | ( Directive_int _, + Some { pdira_desc = Pdir_int (_, Some _) } ) -> + fprintf ppf + "Wrong integer literal for directive `%s'.@." + dir_name; + false + | Directive_ident f, Some { pdira_desc = Pdir_ident lid } + -> + f lid; + true + | Directive_bool f, Some { pdira_desc = Pdir_bool b } -> + f b; + true + | _ -> + fprintf ppf + "Wrong type of argument for directive `%s'.@." + dir_name; + false)) + + let execute_phrase print_outcome ppf phr = + try execute_phrase print_outcome ppf phr + with exn -> + Warnings.reset_fatal (); + raise exn + + (* Read and execute commands from a file, or from stdin if [name] is "". *) + + let use_print_results = ref true + + let preprocess_phrase ppf phr = + let phr = + match phr with + | Ptop_def str -> + let str = + Pparse.apply_rewriters_str ~restore:true + ~tool_name:"ocaml" str + in + Ptop_def str + | phr -> phr + in + if !Clflags.dump_parsetree then Printast.top_phrase ppf phr; + if !Clflags.dump_source then Pprintast.top_phrase ppf phr; + phr + + let use_channel ppf ~wrap_in_module ic name filename = + let lb = Lexing.from_channel ic in + Warnings.reset_fatal (); + Location.init lb filename; + (* Skip initial #! line if any *) + Lexer.skip_hash_bang lb; + protect_refs + [ + R (Location.input_name, filename); + R (Location.input_lexbuf, Some lb); + ] + (fun () -> + try + List.iter + (fun ph -> + let ph = preprocess_phrase ppf ph in + if not (execute_phrase !use_print_results ppf ph) then + raise Exit) + (if wrap_in_module then parse_mod_use_file name lb + else !parse_use_file lb); + true + with + | Exit -> false + | Sys.Break -> + fprintf ppf "Interrupted.@."; + false + | x -> + Location.report_exception ppf x; + false) + + let use_output ppf command = + let fn = Filename.temp_file "ocaml" "_toploop.ml" in + Misc.try_finally + ~always:(fun () -> try Sys.remove fn with Sys_error _ -> ()) + (fun () -> + match + Printf.ksprintf Sys.command "%s > %s" command + (Filename.quote fn) + with + | 0 -> + let ic = open_in_bin fn in + Misc.try_finally + ~always:(fun () -> close_in ic) + (fun () -> + use_channel ppf ~wrap_in_module:false ic "" + "(command-output)") + | n -> + fprintf ppf "Command exited with code %d.@." n; + false) + + let use_file ppf ~wrap_in_module name = + match name with + | "" -> use_channel ppf ~wrap_in_module stdin name "(stdin)" + | _ -> ( + match Load_path.find name with + | filename -> + let ic = open_in_bin filename in + Misc.try_finally + ~always:(fun () -> close_in ic) + (fun () -> + use_channel ppf ~wrap_in_module ic name filename) + | exception Not_found -> + fprintf ppf "Cannot find file %s.@." name; + false) + + let mod_use_file ppf name = use_file ppf ~wrap_in_module:true name + let use_file ppf name = use_file ppf ~wrap_in_module:false name + + let use_silently ppf name = + protect_refs + [ R (use_print_results, false) ] + (fun () -> use_file ppf name) + + (* Reading function for interactive use *) + + let first_line = ref true + let got_eof = ref false + + let read_input_default prompt buffer len = + output_string stdout prompt; + flush stdout; + let i = ref 0 in + try + while true do + if !i >= len then raise Exit; + let c = input_char stdin in + Bytes.set buffer !i c; + (* Also populate the phrase buffer as new characters are added. *) + Buffer.add_char phrase_buffer c; + incr i; + if c = '\n' then raise Exit + done; + (!i, false) + with + | End_of_file -> (!i, true) + | Exit -> (!i, false) + + let read_interactive_input = ref read_input_default + + let refill_lexbuf buffer len = + if !got_eof then ( + got_eof := false; + 0) + else + let prompt = + if !Clflags.noprompt then "" + else if !first_line then "# " + else if !Clflags.nopromptcont then "" + else if Lexer.in_comment () then "* " + else " " + in + first_line := false; + let len, eof = !read_interactive_input prompt buffer len in + if eof then ( + Location.echo_eof (); + if len > 0 then got_eof := true; + len) + else len + + (* Toplevel initialization. Performed here instead of at the + beginning of loop() so that user code linked in with ocamlmktop + can call directives from Topdirs. *) + + let _ = + if !Sys.interactive then + (* PR#6108 *) + invalid_arg + "The ocamltoplevel.cma library from compiler-libs cannot be \ + loaded inside the OCaml toplevel"; + Sys.interactive := true; + let crc_intfs = Symtable.init_toplevel () in + Compmisc.init_path (); + Env.import_crcs ~source:Sys.executable_name crc_intfs; + () + + let find_ocamlinit () = + let ocamlinit = ".ocamlinit" in + if Sys.file_exists ocamlinit then Some ocamlinit + else + let getenv var = + match Sys.getenv var with + | exception Not_found -> None + | "" -> None + | v -> Some v + in + let exists_in_dir dir file = + match dir with + | None -> None + | Some dir -> + let file = Filename.concat dir file in + if Sys.file_exists file then Some file else None + in + let home_dir () = getenv "HOME" in + let config_dir () = + if Sys.win32 then None + else + match getenv "XDG_CONFIG_HOME" with + | Some _ as v -> v + | None -> ( + match home_dir () with + | None -> None + | Some dir -> Some (Filename.concat dir ".config")) + in + let init_ml = Filename.concat "ocaml" "init.ml" in + match exists_in_dir (config_dir ()) init_ml with + | Some _ as v -> v + | None -> exists_in_dir (home_dir ()) ocamlinit + + let load_ocamlinit ppf = + if !Clflags.noinit then () + else + match !Clflags.init_file with + | Some f -> + if Sys.file_exists f then ignore (use_silently ppf f) + else fprintf ppf "Init file not found: \"%s\".@." f + | None -> ( + match find_ocamlinit () with + | None -> () + | Some file -> ignore (use_silently ppf file)) + + let set_paths () = + (* Add whatever -I options have been specified on the command line, + but keep the directories that user code linked in with ocamlmktop + may have added to load_path. *) + let expand = Misc.expand_directory Config.standard_library in + let current_load_path = Load_path.get_paths () in + let load_path = + List.concat + [ + [ "" ]; + List.map expand (List.rev !Compenv.first_include_dirs); + List.map expand (List.rev !Clflags.include_dirs); + List.map expand (List.rev !Compenv.last_include_dirs); + current_load_path; + [ expand "+camlp4" ]; + ] + in + Load_path.init load_path; + Dll.add_path load_path + + let initialize_toplevel_env () = + toplevel_env := Compmisc.initial_env () + + (* The interactive loop *) + + exception PPerror + + let loop ppf = + Clflags.debug := true; + Location.formatter_for_warnings := ppf; + if not !Clflags.noversion then + fprintf ppf " OCaml version %s@.@." Config.version; + (try initialize_toplevel_env () + with (Env.Error _ | Typetexp.Error _) as exn -> + Location.report_exception ppf exn; + raise (Compenv.Exit_with_status 2)); + let lb = Lexing.from_function refill_lexbuf in + Location.init lb "//toplevel//"; + Location.input_name := "//toplevel//"; + Location.input_lexbuf := Some lb; + Location.input_phrase_buffer := Some phrase_buffer; + Sys.catch_break true; + run_hooks After_setup; + load_ocamlinit ppf; + while true do + let snap = Btype.snapshot () in + try + Lexing.flush_input lb; + (* Reset the phrase buffer when we flush the lexing buffer. *) + Buffer.reset phrase_buffer; + Location.reset (); + Warnings.reset_fatal (); + first_line := true; + let phr = + try !parse_toplevel_phrase lb with Exit -> raise PPerror + in + let phr = preprocess_phrase ppf phr in + Env.reset_cache_toplevel (); + ignore (execute_phrase true ppf phr) + with + | End_of_file -> raise (Compenv.Exit_with_status 0) + | Sys.Break -> + fprintf ppf "Interrupted.@."; + Btype.backtrack snap + | PPerror -> () + | x -> + Location.report_exception ppf x; + Btype.backtrack snap + done + + external caml_sys_modify_argv : string array -> unit + = "caml_sys_modify_argv" + + let override_sys_argv new_argv = + caml_sys_modify_argv new_argv; + Arg.current := 0 + + (* Execute a script. If [name] is "", read the script from stdin. *) + + let run_script ppf name args = + override_sys_argv args; + Compmisc.init_path ~dir:(Filename.dirname name) (); + (* Note: would use [Filename.abspath] here, if we had it. *) + (try toplevel_env := Compmisc.initial_env () + with (Env.Error _ | Typetexp.Error _) as exn -> + Location.report_exception ppf exn; + raise (Compenv.Exit_with_status 2)); + Sys.interactive := false; + run_hooks After_setup; + let explicit_name = + (* Prevent use_silently from searching in the path. *) + if name <> "" && Filename.is_implicit name then + Filename.concat Filename.current_dir_name name + else name + in + use_silently ppf explicit_name +end + +module Topmain = struct + (**************************************************************************) + (* *) + (* OCaml *) + (* *) + (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) + (* *) + (* Copyright 1996 Institut National de Recherche en Informatique et *) + (* en Automatique. *) + (* *) + (* All rights reserved. This file is distributed under the terms of *) + (* the GNU Lesser General Public License version 2.1, with the *) + (* special exception on linking described in the file LICENSE. *) + (* *) + (**************************************************************************) + + let usage = + "Usage: ocaml [script-file [arguments]]\n\ + options are:" + + let preload_objects = ref [] + + (* Position of the first non expanded argument *) + let first_nonexpanded_pos = ref 0 + let current = ref !Arg.current + let argv = ref Sys.argv + + (* Test whether the option is part of a responsefile *) + let is_expanded pos = pos < !first_nonexpanded_pos + + let expand_position pos len = + if pos < !first_nonexpanded_pos then + (* Shift the position *) + first_nonexpanded_pos := !first_nonexpanded_pos + len + else (* New last position *) + first_nonexpanded_pos := pos + len + 2 + + let prepare ppf = + Toploop.set_paths (); + try + let res = + let objects = + List.rev (!preload_objects @ !Compenv.first_objfiles) + in + List.for_all (Topdirs.load_file ppf) objects + in + Toploop.run_hooks Toploop.Startup; + res + with x -> ( + try + Location.report_exception ppf x; + false + with x -> + Format.fprintf ppf "Uncaught exception: %s\n" + (Printexc.to_string x); + false) + + (* If [name] is "", then the "file" is stdin treated as a script file. *) + let file_argument name = + let ppf = Format.err_formatter in + if + Filename.check_suffix name ".cmo" + || Filename.check_suffix name ".cma" + then preload_objects := name :: !preload_objects + else if is_expanded !current then ( + (* Script files are not allowed in expand options because otherwise the + check in override arguments may fail since the new argv can be larger + than the original argv. + *) + Printf.eprintf + "For implementation reasons, the toplevel does not support \ + having script files (here %S) inside expanded arguments \ + passed through the -args{,0} command-line option.\n" + name; + raise (Compenv.Exit_with_status 2)) + else + let newargs = + Array.sub !argv !current (Array.length !argv - !current) + in + Compenv.readenv ppf Before_link; + Compmisc.read_clflags_from_env (); + if prepare ppf && Toploop.run_script ppf name newargs then + raise (Compenv.Exit_with_status 0) + else raise (Compenv.Exit_with_status 2) + + let wrap_expand f s = + let start = !current in + let arr = f s in + expand_position start (Array.length arr); + arr + + module Options = Main_args.Make_bytetop_options (struct + include Main_args.Default.Topmain + + let _stdin () = file_argument "" + let _args = wrap_expand Arg.read_arg + let _args0 = wrap_expand Arg.read_arg0 + let anonymous s = file_argument s + end) + + let () = + let extra_paths = + match Sys.getenv "OCAMLTOP_INCLUDE_PATH" with + | exception Not_found -> [] + | s -> Misc.split_path_contents s + in + Clflags.include_dirs := + List.rev_append extra_paths !Clflags.include_dirs + + let main () = + let ppf = Format.err_formatter in + Compenv.readenv ppf Before_args; + let list = ref Options.list in + (try + Arg.parse_and_expand_argv_dynamic current argv list + file_argument usage + with + | Arg.Bad msg -> + Printf.eprintf "%s" msg; + raise (Compenv.Exit_with_status 2) + | Arg.Help msg -> + Printf.printf "%s" msg; + raise (Compenv.Exit_with_status 0)); + Compenv.readenv ppf Before_link; + Compmisc.read_clflags_from_env (); + if not (prepare ppf) then raise (Compenv.Exit_with_status 2); + Compmisc.init_path (); + Toploop.loop Format.std_formatter + + let main () = + match main () with + | exception Compenv.Exit_with_status n -> n + | () -> 0 +end + +let _ = + Clflags.dump_typedtree := true; + exit (Topmain.main ()) diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..7464ab1 --- /dev/null +++ b/dune-project @@ -0,0 +1,26 @@ +(lang dune 3.4) + +(name typedastsch) + +(generate_opam_files true) + +(source + (github username/reponame)) + +(authors "Author Name") + +(maintainers "Maintainer Name") + +(license LICENSE) + +(documentation https://url/to/documentation) + +(package + (name typedastsch) + (synopsis "A short synopsis") + (description "A longer description") + (depends ocaml dune) + (tags + (topics "to describe" your project))) + +; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project diff --git a/lib/dot_of_tast.ml b/lib/dot_of_tast.ml new file mode 100644 index 0000000..ab0422b --- /dev/null +++ b/lib/dot_of_tast.ml @@ -0,0 +1,26 @@ +open Merlin_kernel +open Merlin_utils + +let _ = + Logs.set_reporter (Logs_fmt.reporter ()); + Logs.set_level (Some Debug) + +module Log = (val Logs.src_log + (Logs.Src.create "dot_of_tast" + ~doc:"dot_of_tast.ml logger") : Logs.LOG) + +let merlin_parse str : unit = + let config, _command_args = + Mconfig.parse_arguments ~wd:(Sys.getcwd ()) + ~warning:(fun _ -> ()) + (List.map snd []) [] Mconfig.initial [] + in + File_id.with_cache @@ fun () -> + let source = Msource.make str in + let pipeline = Mpipeline.make config source in + Mpipeline.with_pipeline pipeline @@ fun () -> + Log.info (fun m -> m "merlin_parse..."); + let typer = Mpipeline.typer_result pipeline in + let structure = Mbrowse.of_typedtree (Mtyper.get_typedtree typer) in + Log.info (fun m -> + m "Mbrowse.print: %s" (Mbrowse.print () structure)) diff --git a/lib/dot_of_tast.mli b/lib/dot_of_tast.mli new file mode 100644 index 0000000..70d2ec1 --- /dev/null +++ b/lib/dot_of_tast.mli @@ -0,0 +1 @@ +val merlin_parse : string -> unit diff --git a/lib/dune b/lib/dune new file mode 100644 index 0000000..43f003d --- /dev/null +++ b/lib/dune @@ -0,0 +1,14 @@ +(library + (name dot_of_tast) + (libraries + logs.fmt + fmt + merlin-lib.kernel + merlin-lib.analysis + merlin-lib.ocaml_merlin_specific + merlin-lib.ocaml_utils + merlin-lib.ocaml_preprocess + merlin-lib.ocaml_parsing + merlin-lib.ocaml_typing)) + + diff --git a/notes.org b/notes.org new file mode 100644 index 0000000..29b22ed --- /dev/null +++ b/notes.org @@ -0,0 +1,23 @@ + + + +** current development pattern + +[cqc@fynn typedastsch]$ ocaml +OCaml version 4.14.0 +Enter #help;; for help. + +Findlib has been successfully loaded. Additional directives: + #require "package";; to load a package + #list;; to list the available packages + #camlp4o;; to load camlp4 (standard syntax) + #camlp4r;; to load camlp4 (revised syntax) + #predicates "p,q,...";; to set these predicates + Topfind.reset();; to force that packages will be reloaded + #thread;; to enable threads + +# #use_output "dune top";; +# Dot_of_tast.merlin_parse "let x = 0;;" + ;; +Exception: Assert_failure ("src/kernel/mocaml.ml", 29, 2). +# diff --git a/typedastsch.opam b/typedastsch.opam new file mode 100644 index 0000000..e8e1f76 --- /dev/null +++ b/typedastsch.opam @@ -0,0 +1,31 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "A short synopsis" +description: "A longer description" +maintainer: ["Maintainer Name"] +authors: ["Author Name"] +license: "LICENSE" +tags: ["topics" "to describe" "your" "project"] +homepage: "https://github.com/username/reponame" +doc: "https://url/to/documentation" +bug-reports: "https://github.com/username/reponame/issues" +depends: [ + "ocaml" + "dune" {>= "3.4"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/username/reponame.git"