[m-dev.] diff: use pretty printer in mdb

Mark Anthony BROWN dougl at cs.mu.OZ.AU
Mon May 22 16:45:45 AEST 2000


Estimated hours taken: 1

browser/browse.m:
	Portray terms using the standard pretty printer.  This mode
	is not yet used by default, since there is no term size limit.

tests/debugger/Mmakefile:
tests/debugger/browse_pretty.m:
tests/debugger/browse_pretty.inp:
tests/debugger/browse_pretty.exp:
	Test case for this new feature.

? tests/debugger/browse_pretty.m
? tests/debugger/browse_pretty.inp
? tests/debugger/browse_pretty.exp
Index: browser/browse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.13
diff -u -r1.13 browse.m
--- browser/browse.m	2000/05/11 07:44:32	1.13
+++ browser/browse.m	2000/05/22 04:16:13
@@ -48,7 +48,7 @@
 :- implementation.
 
 :- import_module mdb__parse, mdb__util, mdb__frame.
-:- import_module string, list, parser, require, std_util, int, char.
+:- import_module string, list, parser, require, std_util, int, char, pprint.
 
 %---------------------------------------------------------------------------%
 %
@@ -431,12 +431,12 @@
 :- pred portray_pretty(debugger, browser_state, io__state, io__state).
 :- mode portray_pretty(in, in, di, uo) is det.
 portray_pretty(Debugger, State) -->
-	{ get_size(State, MaxSize) },
+	{ get_clipx(State, Width) },
 	{ get_depth(State, MaxDepth) },
 	{ get_term(State, Univ) },
 	{ get_dirs(State, Dir) },
 	( { deref_subterm(Univ, Dir, SubUniv) } ->
-		{ term_to_string_pretty(SubUniv, MaxSize, MaxDepth, Str) },
+		{ term_to_string_pretty(SubUniv, Width, MaxDepth, Str) },
 		write_string_debugger(Debugger, Str)
 	;
 		write_string_debugger(Debugger, "error: no such subterm")
@@ -530,93 +530,19 @@
 
 %---------------------------------------------------------------------------%
 %
-% Simple indented view of a term. This isn't really
-% pretty printing since parentheses and commas are omitted.
-% XXX: Should do proper pretty printing?
+% Print using the pretty printer from the standard library.
+% XXX the size of the term is not limited---the pretty printer
+% provides no way of doing this.
 %
 
 :- pred term_to_string_pretty(univ, int, int, string).
 :- mode term_to_string_pretty(in, in, in, out) is det.
-term_to_string_pretty(Univ, MaxSize, MaxDepth, Str) :-
-	CurSize = 0,
-	CurDepth = 0,
-	term_to_string_pretty_2(Univ, MaxSize, CurSize, _NewSize,
-		MaxDepth, CurDepth, Lines),
-	unlines(Lines, Str).
-
-:- pred term_to_string_pretty_2(univ, int, int, int, int, int, list(string)).
-:- mode term_to_string_pretty_2(in, in, in, out, in, in, out) is det.
-term_to_string_pretty_2(Univ, MaxSize, CurSize, NewSize,
-		MaxDepth, CurDepth, Lines) :-
-	( ((CurSize >= MaxSize) ; (CurDepth >= MaxDepth)) ->
-		term_compress(Univ, Line),
-		Lines = [Line],
-		% Lines = ["..."],
-		NewSize = CurSize
-	;
-		deconstruct(Univ, Functor, Arity, Args),
-		CurSize1 is CurSize + 1,
-		CurDepth1 is CurDepth + 1,
-		( Arity >= 1 ->
-			string__append(Functor, "(", Functor1)
-		;
-			Functor1 = Functor
-		),
-		term_to_string_pretty_list(Args, MaxSize, CurSize1,
-			NewSize, MaxDepth, CurDepth1, ArgsLines),
-		list__condense(ArgsLines, ArgsLineses),
-		map(indent, ArgsLineses, IndentedArgLines),
-		list__append([Functor1], IndentedArgLines, Lines1),
-		( Arity >= 1 ->
-			list__append(Lines1, [")"], Lines)
-		;
-			Lines = Lines1
-		)
-	).
-
-
-:- pred term_to_string_pretty_list(list(univ), int, int, int, int, int,
-	list(list(string))).
-:- mode term_to_string_pretty_list(in, in, in, out, in, in, out) is det.
-term_to_string_pretty_list([], _MaxSize, CurSize, NewSize,
-		_MaxDepth, _CurDepth, Lines) :-
-	Lines = [],
-	NewSize = CurSize.
-term_to_string_pretty_list([Univ], MaxSize, CurSize, NewSize,
-		MaxDepth, CurDepth, Lineses) :-
-	term_to_string_pretty_2(Univ, MaxSize, CurSize, NewSize,
-		MaxDepth, CurDepth, Lines),
-	Lineses = [Lines].
-term_to_string_pretty_list([Univ1, Univ2 | Univs], MaxSize, CurSize, NewSize,
-		MaxDepth, CurDepth, Lineses) :-
-	term_to_string_pretty_2(Univ1, MaxSize, CurSize, NewSize1,
-		MaxDepth, CurDepth, Lines1),
-	comma_last(Lines1, Lines),
-	term_to_string_pretty_list([Univ2 | Univs], MaxSize, NewSize1, NewSize,
-		MaxDepth, CurDepth, RestLineses),
-	Lineses = [Lines | RestLineses].
-
-:- pred comma_last(list(string), list(string)).
-:- mode comma_last(in, out) is det.
-comma_last([], []).
-comma_last([S], [Sc]) :-
-	string__append(S, ",", Sc).
-comma_last([S1, S2 | Ss], [S1 | Rest]) :-
-	comma_last([S2 | Ss], Rest).
-
-	
-:- pred indent(string::in, string::out) is det.
-indent(Str, IndentedStr) :-
-	string__append("  ", Str, IndentedStr).
 
-:- pred unlines(list(string)::in, string::out) is det.
-unlines([], "").
-unlines([Line | Lines], Str) :-
-	string__append(Line, "\n", NLine),
-	unlines(Lines, Strs),
-	string__append(NLine, Strs, Str).
+term_to_string_pretty(Univ, Width, MaxDepth, Str) :-
+	Value = univ_value(Univ),
+	Doc = to_doc(MaxDepth, Value),
+	Str = to_string(Width, Doc).
 
-
 %---------------------------------------------------------------------------%
 %
 % Verbose printing. Tree layout with numbered branches.
@@ -686,6 +612,13 @@
 	frame__vglue([BranchFrameS], VBranchFrame, LeftFrame),
 	frame__hglue(LeftFrame, TreeFrame, TopFrame),
 	frame__vglue(TopFrame, RestTreesFrame, Frame).
+
+:- pred unlines(list(string)::in, string::out) is det.
+unlines([], "").
+unlines([Line | Lines], Str) :-
+	string__append(Line, "\n", NLine),
+	unlines(Lines, Strs),
+	string__append(NLine, Strs, Str).
 
 %---------------------------------------------------------------------------%
 %
Index: tests/debugger/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.39
diff -u -r1.39 Mmakefile
--- tests/debugger/Mmakefile	2000/05/15 20:07:08	1.39
+++ tests/debugger/Mmakefile	2000/05/22 04:16:24
@@ -19,6 +19,7 @@
 
 DEBUGGER_PROGS=	\
 	breakpoints			\
+	browse_pretty			\
 	browser_test			\
 	debugger_regs			\
 	exception_vars			\
@@ -73,6 +74,12 @@
 
 breakpoints.out: breakpoints breakpoints.inp
 	$(MDB) ./breakpoints < breakpoints.inp > breakpoints.out 2>&1
+
+# We need to pipe the output through sed to avoid hard-coding dependencies on
+# particular line numbers in the standard library source code.
+browse_pretty.out: browse_pretty browse_pretty.inp
+	$(MDB) ./browse_pretty < browse_pretty.inp 2>&1 | \
+		sed 's/io.m:[0-9]*/io.m:NNNN/g' > browse_pretty.out 2>&1
 
 # We need to pipe the output through sed to avoid hard-coding dependencies on
 # particular line numbers in the standard library source code.


New file tests/debugger/browse_pretty.m:

:- module browse_pretty.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
:- import_module list.

:- type big
	--->	big(big, list(int), big)
	;	small.

main -->
	{ big_data(Data) },
	io__print(Data),
	io__write_string(".\n").

:- pred big_data(big::out) is det.

big_data(Data) :-
	Data = big(
		big(
			big(
				small,
				[1],
				small
			),
			[1, 2],
			small
		),
		[1, 2, 3],
		big(
			big(
				small,
				[1, 2, 3, 4],
				big(
					small,
					[1, 2, 3, 4, 5],
					small
				)
			),
			[1, 2, 3, 4, 5, 6],
			small
		)
	).


New file tests/debugger/browse_pretty.inp:

echo on
goto 3
print *
browse 1
set format pretty
set depth 10
ls
set clipx 131
ls
set clipx 30
ls
set clipx 10
ls
set clipx 79
set depth 3
ls
quit
continue


New file tests/debugger/browse_pretty.exp:

       1:      1  1 CALL pred browse_pretty:main/2-0 (det) browse_pretty.m:12
mdb> echo on
Command echo enabled.
mdb> goto 3
       3:      2  2 EXIT pred browse_pretty:big_data/1-0 (det) browse_pretty.m:19 (browse_pretty.m:13)
mdb> print *
       HeadVar__1             	big(big(big(small, ./2, small), .(1, ./2), small), .(1, .(2, ./2)), big(big(small, ./2, big/3), ./2, small))
mdb> browse 1
browser> set format pretty
browser> set depth 10
browser> ls
big(
  big(big(small, .(1, []), small), .(1, .(2, [])), small), 
  .(1, .(2, .(3, []))), 
  big(
    big(
      small, 
      .(1, .(2, .(3, .(4, [])))), 
      big(small, .(1, .(2, .(3, .(4, .(5, []))))), small)
    ), 
    .(1, .(2, .(3, .(4, .(5, .(6, [])))))), 
    small
  )
)
browser> set clipx 131
browser> ls
big(
  big(big(small, .(1, []), small), .(1, .(2, [])), small), 
  .(1, .(2, .(3, []))), 
  big(
    big(small, .(1, .(2, .(3, .(4, [])))), big(small, .(1, .(2, .(3, .(4, .(5, []))))), small)), 
    .(1, .(2, .(3, .(4, .(5, .(6, [])))))), 
    small
  )
)
browser> set clipx 30
browser> ls
big(
  big(
    big(
      small, 
      .(1, []), 
      small
    ), 
    .(1, .(2, [])), 
    small
  ), 
  .(1, .(2, .(3, []))), 
  big(
    big(
      small, 
      .(
        1, 
        .(2, .(3, .(4, [])))
      ), 
      big(
        small, 
        .(
          1, 
          .(
            2, 
            .(
              3, 
              .(4, .(5, []))
            )
          )
        ), 
        small
      )
    ), 
    .(
      1, 
      .(
        2, 
        .(
          3, 
          .(4, .(5, .(6, [])))
        )
      )
    ), 
    small
  )
)
browser> set clipx 10
browser> ls
big(
  big(
    big(
      small, 
      .(
        1, 
        []
      ), 
      small
    ), 
    .(
      1, 
      .(
        2, 
        []
      )
    ), 
    small
  ), 
  .(
    1, 
    .(
      2, 
      .(
        3, 
        []
      )
    )
  ), 
  big(
    big(
      small, 
      .(
        1, 
        .(
          2, 
          .(
            3, 
            .(
              4, 
              []
            )
          )
        )
      ), 
      big(
        small, 
        .(
          1, 
          .(
            2, 
            .(
              3, 
              .(
                4, 
                .(
                  5, 
                  []
                )
              )
            )
          )
        ), 
        small
      )
    ), 
    .(
      1, 
      .(
        2, 
        .(
          3, 
          .(
            4, 
            .(
              5, 
              .(
                6, 
                []
              )
            )
          )
        )
      )
    ), 
    small
  )
)
browser> set clipx 79
browser> set depth 3
browser> ls
big(
  big(big(small, .(...), small), .(1, .(...)), small), 
  .(1, .(2, .(...))), 
  big(big(small, .(...), big(...)), .(1, .(...)), small)
)
browser> quit
mdb> continue
big(big(big(small, [1], small), [1, 2], small), [1, 2, 3], big(big(small, [1, 2, 3, 4], big(small, [1, 2, 3, 4, 5], small)), [1, 2, 3, 4, 5, 6], small)).
-- 
Mark Brown, PhD student            )O+  |  "Another of Fortran's breakthroughs
(m.brown at cs.mu.oz.au)                   |  was the GOTO statement, which was...
Dept. of Computer Science and Software  |  uniquely simple and understandable"
Engineering, University of Melbourne    |              -- IEEE, 1994
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list