From 0e520d3fd675bcebb5751bd1a0c304033f4f7782 Mon Sep 17 00:00:00 2001 From: FrigoEU Date: Thu, 1 Aug 2019 17:38:09 +0200 Subject: Improved typeOf searching and handling of Top and Basis --- src/compiler.sml | 285 ++++++++++++++++++++++++++++++++---------------------- src/elaborate.sig | 6 ++ 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 " 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 -- cgit v1.2.3