@@ -0,0 +1,189 @@
1+#use "topfind";;
2+#require "compiler-libs";;
3+#require "unix";;
4+(*#require "reason";;*)
5+#load "ocamlcommon.cma";;
6+#load "unix.cma";;
7+(*#load "reason.cma";;*)
8+
9+type syntax = Reason | OCaml
10+
11+type eval_result = Success | Error of string
12+
13+type mode =
14+ | RunCode of string * syntax
15+ | StartRepl of syntax
16+ | PrintExpression of string * syntax
17+ | Stdin of syntax
18+ | Invalid of string
19+
20+type args = {mode: mode}
21+
22+exception LangException of string
23+
24+let _ =
25+ let quiet = ref false in
26+ let syntax = ref OCaml in
27+ let interactive_mode = ref false in
28+ let print_mode = ref false in
29+ let run_mode = ref false in
30+ let ps1 = Sys.getenv_opt "PRYBAR_PS1" |> function | Some str -> str | None -> "#" in
31+ let ps2 = Sys.getenv_opt "PRYBAR_PS2" |> function | Some str -> str | None -> " " in
32+ (* If there is code provided to interpret *)
33+ let code = ref "" in
34+ let parse_syntax = function
35+ | "re" -> syntax := Reason
36+ | "ml" -> syntax := OCaml
37+ | arg -> raise (Arg.Bad ("Unknown syntax: " ^ arg))
38+ in
39+ (*let string_of_syntax = function OCaml -> "ml" | Reason -> "re" in*)
40+ let print_mode_arg str =
41+ print_mode := true ;
42+ code := str
43+ in
44+ let run_mode_arg str =
45+ run_mode := true ;
46+ code := str
47+ in
48+ let speclist =
49+ [ ("-q", Arg.Set quiet, "Don't print OCaml version on startup")
50+ ; ( "-e" , Arg.String print_mode_arg , "Eval and output results of interpreted code" )
51+ ; ("-c", Arg.String run_mode_arg, "Run code without printing the output")
52+ ; ("-i", Arg.Set interactive_mode, "Run as interactive repl")
53+ ; ( "-s" , Arg.Symbol (["ml"; "re"], parse_syntax), " Sets the syntax for the repl (default: ml)" ) ]
54+ in
55+ let usage_msg =
56+ "OCaml / Reason repl script for prybar. Options available:"
57+ in
58+ Arg.parse speclist
59+ (fun str -> print_endline ("Anonymous arg: " ^ str))
60+ usage_msg ;
61+ let mode =
62+ match (!print_mode, !run_mode, !interactive_mode) with
63+ | true, false, false -> PrintExpression (!code, !syntax)
64+ | false, true, false -> RunCode (!code, !syntax)
65+ | false, false, true -> StartRepl !syntax
66+ | _ -> Invalid "You can only use one mode: -e | -i | -c"
67+ in
68+ let module Custom_Toploop = struct
69+ include Toploop
70+ open Format
71+
72+ (* Most stuff is straightly copied and modified
73+ * from github.com/ocaml/ocaml/blob/trunk/toplevel/toploop.ml *)
74+ exception PPerror
75+
76+ let first_line = ref true
77+
78+ let got_eof = ref false
79+
80+ let refill_lexbuf buffer len =
81+ if !got_eof then (
82+ got_eof := false ;
83+ 0 )
84+ else
85+ let prompt =
86+ if !first_line then ps1 ^ " "
87+ else if Lexer.in_comment () then "* "
88+ else ps2 (* continuation prompt *)
89+ in
90+ first_line := false ;
91+ let len, eof = !read_interactive_input prompt buffer len in
92+ if eof then (
93+ Location.echo_eof () ;
94+ if len > 0 then got_eof := true ;
95+ len )
96+ else len
97+
98+ let loop ppf =
99+ Clflags.debug := true ;
100+ Location.formatter_for_warnings := ppf ;
101+ ( try initialize_toplevel_env () with
102+ | (Env.Error _ | Typetexp.Error _) as exn ->
103+ Location.report_exception ppf exn ;
104+ exit 2 ) ;
105+ let lb = Lexing.from_function refill_lexbuf in
106+ Location.init lb "//toplevel//" ;
107+ Location.input_name := "//toplevel//" ;
108+ Location.input_lexbuf := Some lb ;
109+ Sys.catch_break true ;
110+ (*load_ocamlinit ppf;*)
111+ while true do
112+ let snap = Btype.snapshot () in
113+ try
114+ Lexing.flush_input lb ;
115+ Location.reset () ;
116+ Warnings.reset_fatal () ;
117+ first_line := true ;
118+ let phr =
119+ try !parse_toplevel_phrase lb with Exit -> raise PPerror
120+ in
121+ let phr = preprocess_phrase ppf phr in
122+ Env.reset_cache_toplevel () ;
123+ ignore (execute_phrase true ppf phr)
124+ with
125+ | End_of_file -> exit 0
126+ | Sys.Break ->
127+ fprintf ppf "Interrupted.@." ;
128+ Btype.backtrack snap
129+ | PPerror -> ()
130+ | x ->
131+ Location.report_exception ppf x ;
132+ Btype.backtrack snap
133+ done
134+ end in
135+ let module Repl = struct
136+ let std_fmt = Format.std_formatter
137+
138+ let noop_fmt = Format.make_formatter (fun _ _ _ -> ()) ignore
139+
140+ let init_toploop () =
141+ Topfind.add_predicates ["byte"; "toploop"] ;
142+ (* Add findlib path so Topfind is available and it won't be
143+ initialized twice if the user does [#use "topfind"]. *)
144+ Topdirs.dir_directory (Findlib.package_directory "findlib") ;
145+ Toploop.initialize_toplevel_env ()
146+
147+ let start_loop ?(fmt = std_fmt) () = Custom_Toploop.loop fmt
148+
149+ let eval ?(fmt = std_fmt) ~syntax str =
150+ try
151+ let lex = Lexing.from_string str in
152+ let tpl_phrases =
153+ match syntax with
154+ | OCaml | Reason -> Parse.use_file lex
155+ (*| Reason ->*)
156+ (*List.map Reason_toolchain.To_current.copy_toplevel_phrase*)
157+ (*(Reason_toolchain.RE.use_file lex)*)
158+ in
159+ let exec phr =
160+ if Toploop.execute_phrase true fmt phr then Success
161+ else Error "No result"
162+ in
163+ let rec execAll phrases =
164+ match phrases with
165+ | [] -> Error "No result"
166+ | [phr] -> exec phr
167+ | phr :: next -> (
168+ let ret = exec phr in
169+ match ret with Error _ -> ret | _ -> execAll next )
170+ in
171+ execAll tpl_phrases
172+ with
173+ | Syntaxerr.Error _ -> Error "Syntax Error occurred"
174+ (*| Reason_syntax_util.Error _ -> Error "Reason Parsing Error"*)
175+ | _ -> Error ("Error while exec: " ^ str)
176+ end in
177+ if not !quiet then print_endline ("OCaml " ^ Sys.ocaml_version ^ " on " ^ Sys.os_type);
178+ match mode with
179+ | PrintExpression (code, syntax) ->
180+ Repl.init_toploop () ;
181+ Repl.eval ~syntax code |> ignore
182+ | RunCode (code, syntax) ->
183+ Repl.init_toploop () ;
184+ Repl.eval ~syntax ~fmt:Repl.noop_fmt code |> ignore
185+ | StartRepl syntax ->
186+ Repl.init_toploop () ;
187+ Repl.start_loop ()
188+ | Stdin syntax -> print_endline "Reading from stdin"
189+ | Invalid str -> print_endline str