Know your signatures (#300)

* Some minor improvement.

* Relative import. Related to #117.

* Close #171 with an ugly solution.

src/frontend/Frontend.ml

@@ -11,23 +11,24 @@ let read_from_channel file_name channel =
   let (lexbuf, tokens) = Lex.tokens ~file_name channel in
   let checkpoint = Grammar.Incremental.esig @@ Lexing.lexeme_start_p lexbuf in
   begin
-    Lwt.catch (Parse.loop lexbuf tokens @@ checkpoint) @@ fun exn ->
+    Lwt.catch (Parse.loop lexbuf tokens checkpoint) @@ fun exn ->
     Lwt_io.printlf "  raised: %s" @@ Printexc.to_string exn >>= fun _ ->
     Lwt_io.printlf "parser :: cleaning up…" >>= fun _ ->
     Lwt_io.close channel >>= fun _ ->
-    Lwt.return []
+    Lwt.fail exn
   end
 
 let read_file file_name =
   let open Lwt.Infix in
   Lwt_io.open_file ~mode:Lwt_io.Input file_name >>=
   read_from_channel file_name
 
-let execute_signature esig =
+let execute_signature dirname esig =
   let module I =
   struct
     let cache = Hashtbl.create 20
     let import f =
+      let f = Filename.concat dirname f in
       match Hashtbl.find_opt cache f with
       | None ->
         let esig = Lwt_main.run @@ read_file @@ f ^ ".red" in
@@ -52,9 +53,11 @@ let execute_signature esig =
 
 let load_file file_name =
   let open Lwt.Infix in
-  read_file file_name >>= execute_signature
+  let dirname = Filename.dirname file_name in
+  read_file file_name >>= execute_signature dirname
 
 let load_from_stdin file_name =
   let open Lwt.Infix in
+  let dirname = Filename.dirname file_name in
   read_from_channel file_name Lwt_io.stdin
-  >>= execute_signature
+  >>= execute_signature dirname

src/frontend/Parse.ml

@@ -71,10 +71,10 @@ let loop lexbuf tokens =
       | I.HandlingError env ->
         begin match I.top env with
           | None ->
-            Lwt.return []
+            Lwt.fail_with "[parser] parsing failed"
           | Some element ->
             Lwt.bind (Message.render @@ Element.handle lexbuf element) @@ fun _ ->
-            Lwt.return []
+            Lwt.fail_with "[parser] parsing failed"
         end
 
       | I.InputNeeded _env ->

src/frontend/ResEnv.ml

@@ -46,7 +46,7 @@ let rec get x renv =
     | Snoc (ys, Some y) ->
       if x = y
       then acc
-      else go ys (acc + 1)
+      else (go[@tailcall]) ys (acc + 1)
     | Snoc (ys, None) ->
       (go[@tailcall]) ys (acc + 1)
   in