summaryrefslogtreecommitdiff
path: root/src/compiler.sml
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler.sml')
-rw-r--r--src/compiler.sml233
1 files changed, 0 insertions, 233 deletions
diff --git a/src/compiler.sml b/src/compiler.sml
index 2e6cf312..0aba3a40 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -1781,237 +1781,4 @@ fun moduleOf fname =
end
end
-fun isPosIn file row col span =
- let
- val start = #first span
- val end_ = #last span
- in
- String.isSuffix file (#file span)
- andalso
- (#line start < row orelse
- #line start = row andalso #char start <= col)
- andalso
- (#line end_ > row orelse
- #line end_ = row andalso #char end_ >= col)
-
- end
-
-fun isSmallerThan (s1: ErrorMsg.span) (s2: ErrorMsg.span) =
- (#line (#first s1) > #line (#first s2) orelse
- (#line (#first s1) = #line (#first s2) andalso (#char (#first s1) >= #char (#first s2))))
- andalso
- (#line (#last s1) < #line (#last s2) orelse
- (#line (#last s1) = #line (#last s2) andalso (#char (#last s1) <= #char (#last s2))))
-
-datatype foundStuff =
- Kind of Elab.kind
- | Con of Elab.con
- | Exp of Elab.exp
- | Sgn_item of Elab.sgn_item
- | Sgn of Elab.sgn
- | Str of Elab.str
- | Decl of Elab.decl
-
-fun getSpan (f: foundStuff * ElabEnv.env) =
- case #1 f of
- Kind k => #2 k
- | Con c => #2 c
- | Exp e => #2 e
- | Sgn_item si => #2 si
- | Sgn s => #2 s
- | Str s => #2 s
- | Decl d => #2 d
-
-fun getTypeAt file row col =
- if not (!Elaborate.incremental)
- then Print.PD.string "ERROR: urweb daemon is needed to use typeOf command"
- else
- case ModDb.lookupForTooling (moduleOf file) of
- NONE => Print.PD.string ("ERROR: No module found: " ^ moduleOf file)
- | SOME (modDecl, deps) =>
- let
- val () = ElabUtilPos.mliftConInCon := ElabEnv.mliftConInCon
-
- (* Adding dependencies to environment *)
- val env = List.foldl (fn (d, e) => ElabEnv.declBinds e d)
- ElabEnv.empty
- deps
-
- (* 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 modDecl of
- Elab.DStr (name, _, sgn, str) =>
- (case #1 str of
- Elab.StrConst 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]
- ]
-
- (* 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 result =
- ElabUtilPos.Decl.foldB
- { 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)
- }
- env
- { 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 #smallestgoodpart result of
- NONE => printLiterally (#smallest result)
- | SOME (desc, span) => desc
- end
-
-
-fun typeOf loc =
- case String.tokens (fn ch => ch = #":") loc of
- file :: rowStr :: colStr :: nil =>
- (case (Int.fromString rowStr, Int.fromString colStr) of
- (SOME row, SOME col) => getTypeAt file row col
- | _ => Print.PD.string "ERROR: Wrong typeOf input format, should be <file:row:col>")
- | _ => Print.PD.string "ERROR: Wrong typeOf input format, should be <file:row:col>"
end
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-14 01:24:34 +0000