[MLton] Showing types of variables
Vesa Karvonen
vesa.a.j.k at gmail.com
Sat Oct 13 11:36:46 PDT 2007
Matthew Fluet mentioned after the ML workshop that one could perhaps
output the types of variables with the def-use info, because the types
have been computed at that point. The def-use mode could then be
extended to parse the types and to show the type (as a message) when
the cursor is at a variable. Below is a exploratory patch to the
def-use mode and MLton that does that. It works (try it!), but there
are a number of issues:
- I couldn't figure out a way to just find the types of variables, so
I modified the code to actually save the type in the newUses function
as a part of the defUses field. I suspect there might be a better way
to do this, but I don't know it.
- Saving the types (and formatting them (layout)) seems to take
considerable space (and time). There are probably several ways to
improve performance (e.g. only print each type once as a separate
table and just print an index into that table with each variable), but
I'm not sure what would be the best approach (e.g. is there a hash
function for Type.t / Scheme.t ?).
- The type names aren't perhaps the best possible names one could get.
They have an extra ?. prefix and sometimes a _N suffix. I don't know
how to get better type names. I tried inserting a call to
setTyconNames at the beginning of processDefUse. I think that just
added the ?. prefixes.
- The type name of a variable is output as an optional string in the
def-use output after the variable name. It might be better to output
it as the last field.
So, feel free to try the below patch. Hopefully we'll be able to
somewhat improve it (reduce space usage and improve the quality of
type names) and commit the improved version.
-Vesa Karvonen
Index: mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/elaborate/elaborate-env.fun (revision 6066)
+++ mlton/elaborate/elaborate-env.fun (working copy)
@@ -1120,6 +1120,7 @@
current: ('a, 'b) Values.t list ref,
defUses: {class: Class.t,
def: 'a,
+ range: 'b option,
uses: 'a Uses.t} list ref,
lookup: 'a -> ('a, 'b) Values.t,
region: 'a -> Region.t,
@@ -1135,13 +1136,14 @@
region = region,
toSymbol = toSymbol}
- fun newUses (T {defUses, ...}, class, def) =
+ fun newUses (T {defUses, ...}, class, def, range) =
let
val u = Uses.new ()
val _ =
if !Control.keepDefUse then
List.push (defUses, {class = class,
def = def,
+ range = range,
uses = u})
else
()
@@ -1645,46 +1647,53 @@
fun processDefUse (E as T f) =
let
+ val _ = setTyconNames E
val _ = forceUsed E
val all: {class: Class.t,
def: Layout.t,
isUsed: bool,
region: Region.t,
+ scheme: Type.t option,
uses: Region.t list} list ref = ref []
- fun doit sel =
+ fun doit (sel, getScheme) =
let
val NameSpace.T {defUses, region, toSymbol, ...} = sel f
in
List.foreach
- (!defUses, fn {class, def, uses, ...} =>
+ (!defUses, fn {class, def, uses, range, ...} =>
List.push
(all, {class = class,
def = Symbol.layout (toSymbol def),
+ scheme = getScheme range,
isUsed = Uses.isUsed uses,
region = region def,
uses = List.fold (Uses.all uses, [], fn (u, ac) =>
region u :: ac)}))
end
- val _ = doit #fcts
- val _ = doit #sigs
- val _ = doit #strs
- val _ = doit #types
- val _ = doit #vals
+ val _ = doit (#fcts, fn _ => NONE)
+ val _ = doit (#sigs, fn _ => NONE)
+ val _ = doit (#strs, fn _ => NONE)
+ val _ = doit (#types, fn _ => NONE)
+ val _ = doit (#vals, fn SOME (_, SOME s) => SOME (Scheme.ty s)
| _ => NONE)
val a = Array.fromList (!all)
val _ =
QuickSort.sortArray (a, fn ({region = r, ...}, {region = r', ...}) =>
Region.<= (r, r'))
val l =
Array.foldr
- (a, [], fn (z as {class, def, isUsed, region, uses}, ac) =>
+ (a, [], fn (z as {class, def, isUsed, region, scheme, uses}, ac) =>
case ac of
[] => [z]
- | {isUsed = i', region = r', uses = u', ...} :: ac' =>
+ | {isUsed = i', region = r', scheme = s', uses = u', ...} :: ac' =>
if Region.equals (region, r')
then {class = class,
def = def,
isUsed = isUsed orelse i',
region = region,
+ scheme = case (s', scheme) of
+ (SOME scheme, _) => SOME scheme
+ | (_, SOME scheme) => SOME scheme
+ | _ => NONE,
uses = uses @ u'} :: ac'
else z :: ac)
val _ =
@@ -1708,7 +1717,7 @@
File.withOut
(f, fn out =>
List.foreach
- (l, fn {class, def, region, uses, ...} =>
+ (l, fn {class, def, region, scheme, uses, ...} =>
case Region.left region of
NONE => ()
| SOME p =>
@@ -1730,7 +1739,13 @@
(align [seq [str (Class.toString class),
str " ",
def,
- str " ",
+ case scheme of
+ NONE => str " "
+ | SOME s =>
+ str (concat
+ [" \"",
+ toString (Type.layoutPretty s),
+ "\" "]),
str (SourcePos.toString p)],
indent
(align
@@ -1754,7 +1769,8 @@
Vector.map (v, fn {con, name} =>
let
val uses = NameSpace.newUses (vals, Class.Con,
- Ast.Vid.fromCon name)
+ Ast.Vid.fromCon name,
+ NONE)
val () =
if not (warnUnused ()) orelse forceUsed
then Uses.forceUsed uses
@@ -1976,7 +1992,10 @@
let
fun newUses () =
let
- val u = NameSpace.newUses (ns, class range, domain)
+ val u = NameSpace.newUses (ns, class range, domain,
+ if class range = Class.Var
+ then SOME range
+ else NONE)
val () =
if not (warnUnused ()) orelse forceUsed
then Uses.forceUsed u
Index: ide/emacs/def-use-mode.el
===================================================================
--- ide/emacs/def-use-mode.el (revision 6066)
+++ ide/emacs/def-use-mode.el (working copy)
@@ -386,7 +386,10 @@
(copy-sequence (def-use-sym-class sym)))
" "
(def-use-add-face (def-use-sym-face sym)
- (copy-sequence (def-use-sym-name sym)))))
+ (copy-sequence (def-use-sym-name sym)))
+ (if (def-use-sym-range sym)
+ (concat " : " (def-use-sym-ty sym))
+ "")))
(defun def-use-format-ref (ref)
"Formats a references."
@@ -460,7 +463,9 @@
length (def-use-ref-pos ref)
(if (def-use-sym-to-uses sym)
'def-use-def-face
- 'def-use-unused-def-face)))))))))
+ 'def-use-unused-def-face))))))))
+ (when (def-use-sym-range sym)
+ (message "%s" (def-use-sym-range sym))))
(defun def-use-highlight-current ()
"Highlights the symbol at the point."
Index: ide/emacs/esml-du-mlton.el
===================================================================
--- ide/emacs/esml-du-mlton.el (revision 6066)
+++ ide/emacs/esml-du-mlton.el (working copy)
@@ -281,6 +281,11 @@
(skip-chars-forward skipping)
result)))
+(defun esml-du-read-opt-str ()
+ (when (= (char-after) ?\")
+ (forward-char 1)
+ (esml-du-read "^\"" "\" ")))
+
(defconst esml-du-classes ;; XXX Needs customization
`((,(def-use-intern "variable") . ,font-lock-variable-name-face)
(,(def-use-intern "type") . ,font-lock-variable-name-face)
@@ -347,12 +352,13 @@
(sym-to-uses (esml-du-ctx-sym-to-uses-table ctx))
(class (def-use-intern (esml-du-read "^ " " ")))
(name (def-use-intern (esml-du-read "^ " " ")))
+ (ty (def-use-intern (esml-du-read-opt-str)))
(src (def-use-file-truename (esml-du-read "^ " " ")))
(line (string-to-int (esml-du-read "^." ".")))
(col (1- (string-to-int (esml-du-read "^\n" "\n"))))
(pos (def-use-pos line col))
(ref (def-use-ref src pos))
- (sym (def-use-sym class name ref
+ (sym (def-use-sym class ty name ref
(cdr (assoc class esml-du-classes))))
(uses nil))
(let ((old-sym (gethash ref ref-to-sym)))
Index: ide/emacs/def-use-data.el
===================================================================
--- ide/emacs/def-use-data.el (revision 6066)
+++ ide/emacs/def-use-data.el (working copy)
@@ -24,10 +24,11 @@
(and (equal (def-use-ref-src lhs) (def-use-ref-src rhs))
(def-use-pos< (def-use-ref-pos lhs) (def-use-ref-pos rhs)))))
-(defun def-use-sym (class name ref &optional face)
+(defun def-use-sym (class range name ref &optional face)
"Symbol constructor."
- (cons ref (cons name (cons class face))))
-(defalias 'def-use-sym-face (function cdddr))
+ (cons ref (cons name (cons class (cons range face)))))
+(defalias 'def-use-sym-face (function cddddr))
+(defalias 'def-use-sym-range (function cadddr))
(defalias 'def-use-sym-class (function caddr))
(defalias 'def-use-sym-name (function cadr))
(defalias 'def-use-sym-ref (function car))
More information about the MLton
mailing list