Improved typeOf searching and handling of Top and Basis

2 files changed, 173 insertions, 118 deletions

diff --git a/src/compiler.sml b/src/compiler.sml
index 51cf20e1..7ceb209a 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -1786,13 +1786,14 @@ fun isPosIn file row col span =
         val start = #first span
         val end_ = #last span
     in
-        (String.isSuffix file (#file span))
+        String.isSuffix file (#file span)
         andalso
-        ((#line start < row) orelse
-         (#line start = row) andalso (#char start <= col))
+        (#line start < row orelse
+         #line start = row andalso #char start <= col)
         andalso 
-        ((#line end_ > row) orelse
-         (#line end_ = row) andalso (#char end_ >= col))
+        (#line end_ > row orelse
+         #line end_ = row andalso #char end_ >= col)
+
     end
 
 fun isSmallerThan (s1: ErrorMsg.span) (s2: ErrorMsg.span) =
@@ -1827,138 +1828,186 @@ fun getTypeAt file row col =
     else
         case ModDb.lookupForTooling (moduleOf file) of
             NONE => Print.PD.string ("ERROR: No module found: " ^ moduleOf file)
-          | SOME (decl, deps) => 
+          | SOME (modDecl, deps) => 
             let
                 val () = ElabUtilPos.mliftConInCon := ElabEnv.mliftConInCon
+
                 (* Adding dependencies to environment *)
-                val env = List.foldl (fn (d, e) =>
-                                         ElabEnv.declBinds e d)
+                val env = List.foldl (fn (d, e) => ElabEnv.declBinds e d)
                                      ElabEnv.empty
                                      deps
-                (* Adding previous declarations to environment *)
+
+                (* Adding previous declarations in file to environment *)
+                (* "open <mod>" statements are already translated during elaboration *)
+                (*   They get added to the env here ("unprefixed") *)
                 val env =
-                    case #1 decl of 
+                    case #1 modDecl of 
                         Elab.DStr (name, _, sgn, str) =>
                         (case #1 str of
                              Elab.StrConst decls =>
-                             List.foldl
-                                 (fn (d, e) => ElabEnv.declBinds e d)
-                                 env
-                                 decls
+                             List.foldl (fn (d, env) =>
+                                            if #line (#first (#2 d)) <= row
+                                               andalso #char (#first (#2 d)) <= col
+                                            then ElabEnv.declBinds env d
+                                            else env) env decls
                            | _ => env)
                       | Elab.DFfiStr _ => env
                       | _ => env
+
+                (* Basis and Top need to be added to the env explicitly *)
+                val env =
+                    case ModDb.lookupForTooling "Top" of
+                        NONE => raise Fail "ERROR: Top module not found in ModDb"
+                      | SOME ((Elab.DStr (_, top_n, topSgn, topStr), _), _) => 
+                        #2 (Elaborate.dopen env {str = top_n, strs = [], sgn = topSgn})
+                      | _ => raise Fail "ERROR: Impossible"
+
+                val env =
+                    case ModDb.lookupForTooling "Basis" of
+                        NONE => raise Fail "ERROR: Top module not found in ModDb"
+                      | SOME ((Elab.DFfiStr (_, basis_n, sgn), _), _) =>
+                        #2 (Elaborate.dopen env {str = basis_n, strs = [], sgn = sgn})
+                      | _ => raise Fail "ERROR: Impossible"
+
+                fun printLiterally {span = span, item = item, env = env} =
+                    Print.box [ Print.PD.string "Nothing good found, printing literally: \n"
+                              , Print.PD.cut
+                              , case item of
+                                    Kind k => Print.box [Print.PD.string "KIND: ", ElabPrint.p_kind env k]
+                                  | Con c => Print.box [Print.PD.string "CON: ", ElabPrint.p_con env c]
+                                  | Exp e => Print.box [Print.PD.string "EXP: ", ElabPrint.p_exp env e]
+                                  | Sgn_item si => Print.box [Print.PD.string "SGN_ITEM: ", ElabPrint.p_sgn_item env si]
+                                  | Sgn s => Print.box [Print.PD.string "SGN: ", ElabPrint.p_sgn env s]
+                                  | Str s => Print.box [Print.PD.string "STR: ", ElabPrint.p_str env s]
+                                  | Decl d => Print.box [Print.PD.string "DECL: ", ElabPrint.p_decl env d]
+                              , Print.PD.string "\n"
+                              ]
+
+                (* TODO We lose some really useful information, like eg. inferred parameters, *)
+                (*   which we do have in the actual items (Elab.Decl, Elab.Exp, etc) *)
+                (*   but not when we do a lookup into the Env *)
+                (* TODO Rename *)
+                fun printGoodPart env f span =
+                    (case f of
+                         Exp (Elab.EPrim p, _) =>
+                         SOME (Print.box [Prim.p_t p,
+                                          Print.PD.string ": ",
+                                          Print.PD.string (case p of
+                                                               Prim.Int _ => "int"
+                                                             | Prim.Float _ => "float"
+                                                             | Prim.String _ => "string"
+                                                             | Prim.Char _ => "char")])
+                       | Exp (Elab.ERel n, _) =>
+                         SOME ((let val found = ElabEnv.lookupERel env n
+                                in
+
+                                    Print.box [ Print.PD.string (#1 found)
+                                              , Print.PD.string ": "
+                                              , ElabPrint.p_con env (#2 found)]
+                                end)
+                               handle ElabEnv.UnboundRel _ => Print.PD.string ("UNBOUND_REL" ^ Int.toString n))
+                       | Exp (Elab.ENamed n, _) =>
+                         SOME ((let val found = ElabEnv.lookupENamed env n
+                                in
+                                    Print.box [ Print.PD.string (#1 found)
+                                              , Print.PD.string ": "
+                                              , ElabPrint.p_con env (#2 found)]
+                                end)
+                               handle ElabEnv.UnboundNamed _ => Print.PD.string ("UNBOUND_NAMED" ^ Int.toString n))
+                       | Exp (Elab.EModProj ( m1 (* number (= "name") of top level module *)
+                                            , ms (* names of submodules - possibly none *)
+                                            , x (* identifier *)), loc) =>
+                         SOME (let
+                                  val (m1name, m1sgn) = ElabEnv.lookupStrNamed env m1
+                                  val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                                             case ElabEnv.projectStr env {sgn = sgn, str = str, field = m} of
+                                                                 NONE => raise Fail ("Couldn't find Structure: " ^ m)
+                                                               | SOME sgn => ((Elab.StrProj (str, m), loc), sgn))
+                                                         ((Elab.StrVar m1, loc), m1sgn)
+                                                         ms
+                                  val t = case ElabEnv.projectVal env {sgn = sgn, str = str, field = x} of
+                                              NONE => raise Fail ("Couldn't find identifier: " ^ x)
+                                            | SOME t => t
+                              in
+                                  Print.box [ Print.p_list_sep (Print.PD.string ".") Print.PD.string (m1name :: ms @ [x])
+                                            , Print.PD.string ": "
+                                            , ElabPrint.p_con env t
+                                            ]
+                              end
+                               handle ElabEnv.UnboundNamed _ => Print.PD.string ("Module not found: " ^ Int.toString m1))
+                       | Exp e => NONE
+                       | Kind k => NONE
+                       | Con c => NONE
+                       | Sgn_item si => NONE
+                       | Sgn s => NONE
+                       | Str s => NONE
+                       | Decl d => NONE)
+
+                fun add env item span acc =
+                           if not (isPosIn file row col span)
+                           then
+                               acc
+                           else
+                               let
+                                   val smallest =
+                                       if isSmallerThan span (#span (#smallest acc))
+                                       then {span = span, item = item, env = env}
+                                       else #smallest acc
+                                   val smallestgoodpart =
+                                       case #smallestgoodpart acc of
+                                           NONE => 
+                                           (case printGoodPart env item span of
+                                                NONE => NONE
+                                              | SOME desc => SOME (desc, span))
+                                         | SOME (desc', span') => 
+                                           if isSmallerThan span span'
+                                           then 
+                                               (case printGoodPart env item span of
+                                                    NONE => SOME (desc', span')
+                                                  | SOME desc => SOME (desc, span))
+                                           else SOME (desc', span')
+                               in
+                                   {smallest = smallest, smallestgoodpart = smallestgoodpart}
+                               end
+
                 (* Look for item under cursor *)
-                val (atPosition, env) =
+                val result =
                     ElabUtilPos.Decl.foldB
-                        { kind = fn (env, (k, span), acc) =>
-                                    if isPosIn file  row col span andalso isSmallerThan span (getSpan acc)
-                                    then (Kind (k, span), env)
-                                    else acc ,
-                          con = fn (env, (k, span), acc) =>
-                                   if isPosIn file  row col span andalso isSmallerThan span (getSpan acc)
-                                   then (Con (k, span), env)
-                                   else acc,
-                          exp = fn (env, (k, span), acc) =>
-                                   if isPosIn file  row col span andalso isSmallerThan span (getSpan acc)
-                                   then (Exp (k, span), env)
-                                   else acc,
-                          sgn_item = fn (env, (k, span), acc) =>
-                                        if isPosIn file  row col span andalso isSmallerThan span (getSpan acc)
-                                        then (Sgn_item (k, span), env)
-                                        else acc,
-                          sgn = fn (env, (k, span), acc) =>
-                                   if isPosIn file  row col span andalso isSmallerThan span (getSpan acc)
-                                   then (Sgn (k, span), env)
-                                   else acc,
-                          str = fn (env, (k, span), acc) =>
-                                   if isPosIn file  row col span andalso isSmallerThan span (getSpan acc)
-                                   then (Str (k, span), env)
-                                   else acc,
-                          decl = fn (env, (k, span), acc) =>
-                                    if isPosIn file  row col span andalso isSmallerThan span (getSpan acc)
-                                    then (Decl (k, span), env)
-                                    else acc,
+                        { kind = fn (env, (k, span), acc) => add env (Kind (k, span)) span acc,
+                          con = fn (env, (k, span), acc) => add env (Con (k, span)) span acc,
+                          exp = fn (env, (k, span), acc) => add env (Exp (k, span)) span acc,
+                          sgn_item = fn (env, (k, span), acc) => add env (Sgn_item (k, span)) span acc,
+                          sgn = fn (env, (k, span), acc) => add env (Sgn (k, span)) span acc,
+                          str = fn (env, (k, span), acc) => add env (Str (k, span)) span acc,
+                          decl = fn (env, (k, span), acc) => add env (Decl (k, span)) span acc,
                           bind = fn (env, binder) =>
                                     case binder of
-                                        ElabUtilPos.Decl.RelK x => 
-                                        ElabEnv.pushKRel env x
-                                      | ElabUtilPos.Decl.RelC (x, k) =>
-                                        ElabEnv.pushCRel env x k
-                                      | ElabUtilPos.Decl.NamedC (x, n, k, co) =>
-                                        ElabEnv.pushCNamedAs env x n k co
-                                      | ElabUtilPos.Decl.RelE (x, c) =>
-                                        ElabEnv.pushERel env x c
-                                      | ElabUtilPos.Decl.NamedE (x, c) => 
-                                        #1 (ElabEnv.pushENamed env x c)
-                                      | ElabUtilPos.Decl.Str (x, n, sgn) =>
-                                        #1 (ElabEnv.pushStrNamed env x sgn)
-                                      | ElabUtilPos.Decl.Sgn (x, n, sgn) =>
-                                        #1 (ElabEnv.pushSgnNamed env x sgn)
+                                        ElabUtilPos.Decl.RelK x => ElabEnv.pushKRel env x
+                                      | ElabUtilPos.Decl.RelC (x, k) => ElabEnv.pushCRel env x k
+                                      | ElabUtilPos.Decl.NamedC (x, n, k, co) => ElabEnv.pushCNamedAs env x n k co
+                                      | ElabUtilPos.Decl.RelE (x, c) => ElabEnv.pushERel env x c
+                                      | ElabUtilPos.Decl.NamedE (x, c) => #1 (ElabEnv.pushENamed env x c)
+                                      | ElabUtilPos.Decl.Str (x, n, sgn) => #1 (ElabEnv.pushStrNamed env x sgn)
+                                      | ElabUtilPos.Decl.Sgn (x, n, sgn) => #1 (ElabEnv.pushSgnNamed env x sgn)
                         }
                         env
-                        (Decl (#1 decl, { file = file
-                                        , first = { line = 0, char = 0}
-                                        , last = { line = 99999, char = 0} })
-                        , env)
-                        decl
+                        { smallestgoodpart = NONE
+                        , smallest = { item = Decl (#1 modDecl, { file = file
+                                                                , first = { line = 0, char = 0}
+                                                                , last = { line = 99999, char = 0} })
+                                     , span = { file = file
+                                              , first = { line = 0, char = 0}
+                                              , last = { line = 99999, char = 0} }
+                                     , env = env }
+                        }
+                        modDecl
             in
-                case atPosition of
-                    Kind k =>
-                    Print.box [Print.PD.string "Not implemented yet, KIND: ", ElabPrint.p_kind env k]
-                  | Con c =>
-                    Print.box [Print.PD.string "Not implemented yet, CON: ", ElabPrint.p_con env c]
-                  | Exp (Elab.EPrim p, _) =>
-                    Print.box [Prim.p_t p,
-                               Print.PD.string ": ",
-                               Print.PD.string (case p of
-                                                 Prim.Int _ => "int"
-                                               | Prim.Float _ => "float"
-                                               | Prim.String _ => "string"
-                                               | Prim.Char _ => "char")]
-                  | Exp (Elab.ERel n, _) =>
-                    ((let val found = ElabEnv.lookupERel env n
-                      in
-
-                          Print.box [ Print.PD.string (#1 found)
-                                    , Print.PD.string ": "
-                                    , ElabPrint.p_con env (#2 found)]
-                      end)
-                     handle ElabEnv.UnboundRel _ => Print.PD.string ("UNBOUND_REL" ^ Int.toString n))
-                  | Exp (Elab.ENamed n, _) =>
-                    ((let val found = ElabEnv.lookupENamed env n
-                      in
-                          Print.box [ Print.PD.string (#1 found)
-                                    , Print.PD.string ": "
-                                    , ElabPrint.p_con env (#2 found)]
-                      end)
-                     handle ElabEnv.UnboundNamed _ => Print.PD.string ("UNBOUND_NAMED" ^ Int.toString n))
-                  | Exp (Elab.EModProj ( m1 (* number (= "name") of top level module *)
-                                       , ms (* names of submodules - possibly none *)
-                                       , x (* identifier *)), loc) =>
-                    (let
-                        val (m1name, m1sgn) = ElabEnv.lookupStrNamed env m1
-                        val (str, sgn) = foldl (fn (m, (str, sgn)) =>
-                                                   case ElabEnv.projectStr env {sgn = sgn, str = str, field = m} of
-                                                       NONE => raise Fail ("Couldn't find Structure: " ^ m)
-                                                     | SOME sgn => ((Elab.StrProj (str, m), loc), sgn))
-                                               ((Elab.StrVar m1, loc), m1sgn)
-                                               ms
-                        val t = case ElabEnv.projectVal env {sgn = sgn, str = str, field = x} of
-                                    NONE => raise Fail ("Couldn't find identifier: " ^ x)
-                                  | SOME t => t
-                    in
-                        Print.box [ Print.p_list_sep (Print.PD.string ".") Print.PD.string (m1name :: ms @ [x])
-                                  , Print.PD.string ": "
-                                  , ElabPrint.p_con env t
-                                  ]
-                    end
-                     handle ElabEnv.UnboundNamed _ => Print.PD.string ("Module not found: " ^ Int.toString m1))
-                  | Exp e => Print.box [Print.PD.string "Not implemented yet, EXP: ", ElabPrint.p_exp env e]
-                  | Sgn_item si => Print.box [Print.PD.string "Not implemented yet, SGN_ITEM: ", ElabPrint.p_sgn_item env si]
-                  | Sgn s => Print.box [Print.PD.string "Not implemented yet, SGN: ", ElabPrint.p_sgn env s]
-                  | Str s => Print.box [Print.PD.string "Not implemented yet, STR: ", ElabPrint.p_str env s]
-                  | Decl d => Print.box [Print.PD.string "Not implemented yet, DECL: ", ElabPrint.p_decl env d]
+                case #smallestgoodpart result of
+                    NONE => printLiterally (#smallest result)
+                  | SOME (desc, span) =>
+                    Print.box [(* Print.PD.string (ErrorMsg.spanToString span), Print.PD.string " @ " *)
+                                desc
+                              , Print.PD.string "\n"]
             end
 
 
diff --git a/src/elaborate.sig b/src/elaborate.sig
index d60cff42..03359814 100644
--- a/src/elaborate.sig
+++ b/src/elaborate.sig
@@ -47,4 +47,10 @@ signature ELABORATE = sig
     val incremental : bool ref
     val verbose : bool ref
 
+    val dopen: ElabEnv.env
+               -> { str: int
+                  , strs: string list
+                  , sgn: Elab.sgn }
+               -> (Elab.decl list * ElabEnv.env)
+
 end