Permalink
Browse files

Yeah, that works !

  • Loading branch information...
1 parent 1a71c1d commit f6d421827fbca13e4cf0e9840e12c9f684db4a45 @let-def let-def committed Jan 13, 2013
Showing with 105 additions and 18 deletions.
  1. +5 −2 chunk_parser.mly
  2. +56 −4 control.vim
  3. +1 −0 json.ml
  4. +1 −0 json.mli
  5. +34 −2 test.ml
  6. +7 −10 typer.ml
  7. +1 −0 typer.mli
View
@@ -481,8 +481,8 @@ The precedences must be listed from low to high.
%type <Parsetree.toplevel_phrase list> use_file
%start top_structure_item /* extension, ocaml-ty */
%type <Parsetree.structure_item> top_structure_item
-%start top_directive /* extension, ocaml-ty */
-%type <string * Parsetree.directive_argument> top_directive
+%start top_expr /* extension, ocaml-ty */
+%type <Parsetree.expression> top_expr
%start any_longident
%type <Longident.t> any_longident
%%
@@ -501,6 +501,9 @@ toplevel_phrase:
| toplevel_directive SEMISEMI { $1 }
| EOF { raise End_of_file }
;
+top_expr:
+ | seq_expr EOF { $1 }
+;
top_structure:
structure_item { [$1] }
| structure_item top_structure { $1 :: $2 }
View
@@ -35,30 +35,82 @@ def seek_current():
line, col = position['line'], position['col']
send_command("tell", cb[line-1][col:] + "\n" + "\n".join(cb[line:to_line-1]) + "\n")
+cache = list()
+def sync_buffer():
+ cb = vim.current.buffer
+ cw = vim.current.window
+ to_line, to_col = cw.cursor
+ to_line = min(to_line + 3, len(cb))
+
+ line = 0
+ for line in range(0,min(to_line-1,len(cache))):
+ if cb[line] != cache[line]:
+ break
+ if line == 0:
+ send_command("reset")
+ cache[:to_line-1] = cb[:to_line-1]
+ send_command("tell", "\n".join(cb[:to_line-1]) + "\n")
+ else:
+ line = line + 1
+
+ effective_pos = send_command("seek", {'line' : line, 'col': 0})
+ position = effective_pos[1]
+ line, col = position['line'], position['col']
+ send_command("tell", cb[line-1][col:] + "\n" + "\n".join(cb[line:to_line-1]) + "\n")
+
+ del cache[line-1:]
+ cache[line-1:to_line-1] = cb[line-1:to_line-1]
+
reset_buffer()
EOF
+function! Get_visual_selection()
+ let [lnum1, col1] = getpos("'<")[1:2]
+ let [lnum2, col2] = getpos("'>")[1:2]
+ let lines = getline(lnum1, lnum2)
+ let lines[-1] = lines[-1][: col2 - 1]
+ let lines[0] = lines[0][col1 - 1:]
+ return join(lines, "\n")
+endfunction
+
function! FindFile(ext,file)
python <<EOF
vim.command("e "+ find_file(vim.eval("a:file") + "." + vim.eval("a:ext")))
EOF
endfunction
function! OLinerPath(var,path)
- echo a:path
- python <<EOF
+ python <<EOF
path = vim.eval("a:path")
#send_command('#cd', vim.eval("getcwd()"))
if path == "":
- for path in send_command('#' + vim.eval("a:var")):
+ for path in send_command(vim.eval("a:var"), "list"):
if path != "":
print path
else:
- send_command('#' + vim.eval("a:var"), vim.eval("a:path"))
+ send_command(vim.eval("a:var"), ["add", vim.eval("a:path")])
EOF
endfunction
+function! TypeOf(expr)
+ python <<EOF
+sync_buffer()
+expr = vim.eval("a:expr")
+ty = send_command("typeof", expr)
+print (expr + " : " + ty[1])
+EOF
+endfunction
+
+function! TypeOfSel()
+ call TypeOf(Get_visual_selection())
+endfunction
+
command! -nargs=1 ML call FindFile("ml",<q-args>)
command! -nargs=1 MLI call FindFile("mli",<q-args>)
+command! -nargs=0 TypeOf call TypeOf(substitute(substitute(expand("<cWORD>"),")*$","",""), "^(*", "", ""))
+command! -range -nargs=0 TypeOfSel call TypeOfSel()
command! -nargs=* OLinerSourcePath call OLinerPath("source_path", <q-args>)
command! -nargs=* OLinerBuildPath call OLinerPath("build_path", <q-args>)
+
+map <LocalLeader>t :TypeOf
+vmap <LocalLeader>t :TypeOfSel
View
@@ -0,0 +1 @@
+include Yojson.Basic
View
@@ -0,0 +1 @@
+include module type of Yojson.Basic
View
36 test.ml
@@ -39,6 +39,15 @@ let main_loop () =
try
let rec loop state =
let state, answer =
+ let exns =
+ (match History.prev state.outlines with
+ | Some (_,(_,_,_,exns)) -> exns
+ | None -> []) @
+ (match History.prev state.envs with
+ | Some (_,_,exns) -> exns
+ | None -> [])
+ in
+ List.iter (fun exn -> prerr_endline (Printexc.to_string exn)) exns;
try match Stream.next input with
| `List (`String command :: args) ->
let handler =
@@ -90,8 +99,7 @@ let command_tell state = function
let bufpos = ref state.pos in
let tokens, outlines =
Outline.parse ~bufpos ~goteof
- (state.tokens,state.outlines)
- lexbuf
+ (state.tokens,state.outlines) lexbuf
in
let chunks = Chunk.append outlines state.chunks in
let envs = Typer.sync chunks state.envs in
@@ -103,6 +111,28 @@ let command_tell state = function
loop state, `Bool true
| _ -> invalid_arguments ()
+let command_typeof state = function
+ | [`String expr] ->
+ let lexbuf = Lexing.from_string expr in
+ let env = Typer.env state.envs in
+ let expression = Chunk_parser.top_expr Outline_lexer.token lexbuf in
+ let (str, sg, _) =
+ Typemod.type_toplevel_phrase env
+ Parsetree.([{ pstr_desc = Pstr_eval expression ; pstr_loc = Location.curr lexbuf }])
+ in
+ (*let sg' = Typemod.simplify_signature sg in*)
+ let open Typedtree in
+ begin match str.str_items with
+ | [ { str_desc = Tstr_eval exp }] ->
+ let buffer = Buffer.create 16 in
+ let ppf = Format.formatter_of_buffer buffer in
+ Printtyp.type_scheme ppf exp.exp_type;
+ Format.pp_print_flush ppf ();
+ state, (`List [`String "type" ; `String (Buffer.contents buffer)] :> Json.json)
+ | _ -> failwith "unhandled expression"
+ end
+ | _ -> invalid_arguments ()
+
let command_line state = function
| [] -> state, return_position state.pos
| _ -> invalid_arguments ()
@@ -186,6 +216,8 @@ let _ = List.iter (fun (a,b) -> Hashtbl.add commands a b) [
"which", (command_which :> command);
"source_path", (command_path ~reset:default_build_paths source_path :> command);
"build_path", (command_path ~reset:(lazy []) Config.load_path :> command);
+
+ "typeof", (command_typeof :> command);
]
(* Directives we want :
View
@@ -2,15 +2,12 @@ type item = Chunk.sync * Env.t * exn list
type sync = item History.sync
type t = item History.t
-let initial_env =
- let initial = ref None in
- fun () ->
- match !initial with
- | Some env -> env
- | None ->
- let env = Compile.initial_env () in
- initial := Some env;
- env
+let initial_env = Lazy.from_fun Compile.initial_env
+
+let env t =
+ match History.prev t with
+ | None -> Lazy.force initial_env
+ | Some (_,env,_) -> env
let rec append_step ~stop_at chunk_item env exns =
match chunk_item with
@@ -33,7 +30,7 @@ let sync chunks t =
let t, out_of_sync = History.split t in
(* Process last items *)
let (last_sync,env,exns) = match History.prev t with
- | None -> (History.sync_origin, initial_env (), [])
+ | None -> (History.sync_origin, Lazy.force initial_env, [])
| Some item -> item
in
let stop_at =
View
@@ -2,4 +2,5 @@ type item = Chunk.sync * Env.t * exn list
type sync = item History.sync
type t = item History.t
+val env : t -> Env.t
val sync : Chunk.t -> t -> t

0 comments on commit f6d4218

Please sign in to comment.