For review: Term display helper
Waye-Ian CHIEW
wchi at students.cs.mu.OZ.AU
Fri Feb 27 17:14:31 AEDT 1998
Hello.
This is the term display helper, which takes univ terms and displays them in a
choice of pretty formats.
It is not finished and not really useable; some critical additions, like
the scripting language and the interactive browser, haven't been implemented
yet.
-- Ian!!
#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.1).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 1998-02-27 17:00 EST by <wchi at holly>.
# Source directory was `/mount/munkora/stude/w/wchi/work/portray_last_working'.
#
# Existing files will *not* be overwritten unless `-c' is specified.
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 13399 -rw-rw-rw- FRAMES
# 180 -rw-rw-rw- Mmakefile
# 10900 -rw-rw-rw- SPECS
# 11432 -rw-rw-rw- frame.m
# 1708 -rw-rw-rw- frame_test.m
# 2890 -rw-rw-rw- frames.m
# 905 -rw-rw-rw- frames_test.m
# 14348 -rw------- portray.m
# 1116 -rw-rw-rw- portray_test.m
# 1551 -rw-rw-rw- term_interface.m
# 682 -rw-rw-rw- term_interface_test.m
#
touch -am 1231235999 $$.touch >/dev/null 2>&1
if test ! -f 1231235999 && test -f $$.touch; then
shar_touch=touch
else
shar_touch=:
echo
echo 'WARNING: not restoring timestamps. Consider getting and'
echo "installing GNU \`touch', distributed in GNU File Utilities..."
echo
fi
rm -f 1231235999 $$.touch
#
# ============= FRAMES ==============
if test -f 'FRAMES' && test X"$1" != X"-c"; then
echo 'x - skipping FRAMES (file already exists)'
else
shar: Saving FRAMES (text)
echo 'x - extracting FRAMES (text)'
sed 's/^X//' << 'SHAR_EOF' > 'FRAMES' &&
FRAMES
X
X CONCEPTS
X
X FRAME TYPES
X
X There are different types of frames, some of which can hold a single
X child; some of which can hold a list of children, and some which act
X as leaf nodes.
X
X The leaf nodes contain printable text or empty space. The interior
X nodes of the tree contain formatting nodes, which organise the text
X into tabled regions, divided areas and overlapping layers.
X
X FILLING ORDER
X
X Frames which hold child frames must fill themselves in some systematic
X way. This is the filling order of the frame, and all frames which
X have child frames default to filling themselves in the same order as
X English words running across a page.
X
X Occassionally, a frame may need to have a different filling order.
X Hence, filling orders can have orientation and parity. For example, a
X page of Chinese text has words with a filling order that is oriented
X right.
X
X COORDINATES AND SIZES
X
X A frame coordinate is a position offset relative to the upper-left
X corner of the frame. Frames always have horizontal and vertical
X coordinates relative to their parent frame.
X
X Frames can have a size measured in characters; if they hold
X collections of other frames, they can have a size measured in number
X of frames. Frame width and frame height are character sizes; frame
X span and frame length is frame size in number of frames.
X
X The alignment of a frame is its position relative to the parent frame.
X There are three alignments - 'least', 'center' and 'most'
X
X EXPANSION LIMITS
X
X Some types of frames expand to fit their parent frame; some frames
X are fixed in horizontal size and/or vertical size. A frame limit is
X the ultimate size of a frame. A frame's horizontal and vertical
X limits may be fixed at a particular size (expansion not allowed), or
X it can be unfixed (can expand to infinity).
X
X Framing space is the space around a frame into which it can expand.
X It is handed down to frames by parent frames. When a parent
X imposes a fixed limit on its child, then the child can only expand up
X to that limit. If it doesn't impose a limit, then the child can
X expand out to the previous limit. A child frame that is bigger anyway
X will see some of its contents excluded from view, or clipped.
X
X
X FRAME TYPES
X
X TEXT FRAMES
X
X Text frames are the leaf nodes of frame trees. They contain the raw
X printable text that will be successively transformed by parent frames.
X Contents: Printable, single-lined strings.
X Expansion: Fixed in size, doesn't expand.
X Minimum size: As side as child string, one character tall.
X
X +-text------------------------------------------------+
X |Text frames are only as big as they string they hold.|
X +-----------------------------------------------------+
X
X EMPTY FRAMES
X
X Empty frames are also leaf nodes. They are used to fill empty places
X in table or page frames. These frames should not even be evaluated
X directly -- the frames holding them should avoid or ignore them
X because they have a zero size.
X Contents: Nothing.
X Expansion: Fixed in size, doesn't expand.
X Minimum size: Zero.
X
X CLIPPING FRAMES
X
X Clipping frames selectively enforce frame limits on children.
X Contents: One child frame.
X Expansion: Can be fixed/unfixed horizontally or vertically.
X Minimum size: If unfixed, is the child's minimum size. If fixed,
X is that fixed size.
X
X +-clipping-----+
X |+-text--------|
X ||This is clipp|
X |+-------------|
X +--------------+
X
X This clipping frame is unfixed vertically and fixed horizontally.
X The fixed horizontal limit is clipping some of the text frame off.
X
X PLACEHOLDER FRAMES
X
X Placeholder frames align a child in framing space -- in 'most',
X 'center' or 'least' positions horizontally and vertically.
X Contents: One child frame.
X Expansion: Expands into framing space.
X Minimum size: Is the child's minimum size.
X
X +-clipping---------------+
X |+-placeholder----------+|
X || ||
X || +-text-+||
X || |Hallo!|||
X || +------+||
X |+----------------------+|
X +------------------------+
X
X This placeholder frame is aligning a text frame in most-most
X position.
X
X OVERLAPPER FRAMES
X
X Overlapper frames hold many child frames in free form.
X They behave like windows in graphical GUI's -- each child frame has a
X Z order and is mounted somewhere on an infinite canvas.
X The viewport of the overlapper frame can pan around freely on the
X All coordinates, including the upper-left corner of the overlapper
X frame, are relative to the canvas origin.
X canvas.
X Contents: A list of child frames.
X Expansion: Expands into framing space.
X Minimum size: The minimum viewport size necessary to keep all
X child frames in full view.
X
X +-clipping--------------------------------+
X |+-overlap-------------------------------+|
X ||+-text------------------+ ||
X |||This is the top window.|--------------||
X ||+-----------------------+he bottom wind||
X || +--------------------------||
X || ||
X |+---------------------------------------+|
X +-----------------------------------------+
X
X ROTARY FRAMES
X
X Rotary frames rotate a child frame into a particular orientation.
X Contents: One child frame.
X Expansion: Doesn't expand.
X Minimum size: Is the minimum size of the child.
X
X +-rotary----+
X |+---------+|
X ||+-++-++-+||
X |||r||i||T|||
X |||o||s||h|||
X |||t|+-+|i|||
X |||a| |s|||
X |||t| +-+||
X |||e| ||
X |||d| ||
X |||.| ||
X ||+-+ ||
X |+---------+|
X +-----------+
X
X The orientation of this rotary frame is to the 'right'.
X
X MIRROR FRAMES
X
X Mirror frames flip a child frame across the horizontal or vertical
X axes (toggle the child frame's horizontal or vertical parity).
X Contents: One child frame.ca
X Expansion: Doesn't expand.
X Minimum size: Is the minimum size of child.
X
X +-mirror------------+
X |+-----------------+|
X ||.desrever si sihT||
X |+-----------------+|
X +-------------------+
X
X This is a horizontally facing mirror frame.
X
X CARTON FRAMES
X
X Carton frames are the building block of frames with regular
X arrangements. By default, carton frames line up their child frames in
X a row running from left to right, but orient their filling order in
X any direction. Filling order parities don't make sense for carton
X frames, because there is only one row.
X Contents: A list of child frames.
X Expansion: Doesn't expand.
X Minimum size: Is the minimum size of a row holding all the child
X frames.
X
X +-carton--------------------+
X |+----++-++--------++---++-+|
X || || || || || ||
X |+----+| || || |+-+|
X | +-+| |+---+ |
X | +--------+ |
X +---------------------------+
X
X This is a carton frame with a default orientation.
X
X TABLE FRAMES
X
X Table frames hold many child frames in grid arrangement.
X By default, table frames fill their rows from left to right, and the
X table from top to bottom. The filling order can be reoriented,
X however, and the parities of the filling order can be reversed to make
X it fill bottom-up or right-to-left.
X Contents: A list of child frames.
X Expansion: Doesn't expand.
X Minimum size: Is the minimum size of a regular grid holding all
X the child frames.
X
X +-clipping---------------------+ +-clipping---------------------+
X |+-grid------------------------| |+-grid------------------------|
X ||+----+ +-+ +---| ||+---------++--+ |
X |||one | |t| |thr| |||three ||si| |
X ||| | +-+ | | ||| |+--+ |
X ||+----+ +---| ||+---------+ |
X ||+---+ +-+ +--+| ||+-+ +-+ +------------|
X |||fou| +-+ |si|| |||t| +-+ |eight |
X ||+---+ +--+| ||+-+ +------------|
X ||+-------++--------------+ | ||+----+ +---++-------+ |
X |||seven ||eight | | |||one | |fou||seven | |
X ||| |+--------------+ | ||| | +---+| | |
X ||+-------+ | ||+----+ +-------+ |
X |+-----------------------------| |+-----------------------------|
X | | | |
X +------------------------------+ +------------------------------+
X
X filling order of left table: down, normal horizontal and vertical
X parity; filling order of right table: left, normal horizontal and
X vertical parity.
X
X PAGE FRAMES
X
X Page frames are similar to tables in their filling order, but
X are different in that their child frames do not follow a grid.
X Instead, they arrange their child frames end-to-end in
X wrapping lines (like a page of text).
X Contents: A list of child frames.
X Expansion: Doesn't expand.
X Minimum size: Is the minimum size of a long wrapping line holding
X all the child frames.
X
X +-page---------------------------+
X |+-----++--++---++-----------+ |
X || || || || | |
X |+-----+| |+---+| | |
X | +--+ | | |
X | +-----------+ |
X |+--------++------++---++-------+|
X || |+------+| || ||
X |+--------+ +---+| ||
X | +-------+|
X |+-------------------------------|
X || |
X || |
X |+-------------------------------|
X |+-+ |
X || | |
X |+-+ |
X +--------------------------------+
X
X This is a page frame in the default orientation. Frames which are
X too large to fit on a single line are clipped.
X
X
X USER INTERFACE
X
X FRAME SIZES
X
X The size of a frame can depend on the sizes of their children
X frames. Only minimum sizes are really meaningful because frames
X can expand to fill available space.
X
X Placeholder frames need to know how large their child frames
X are to be able to align them. Table frames need child sizes to
X be able to handle wrapping and do gridding.
X
X The user may also need to know the size of a frame.
X
X :- func size(frame::in) = int::out is det.
X
X RASTERISATION AND EVALUATION
X
X Frames can be readied for output in two ways: evaluation finds what
X character is at a particular frame coordinate, and rasterisation
X converts the frame into a list of strings.
X
X Rasterisation is usually much more efficient than single character
X evaluation. The rasterisation itself can have an orientation (to be
X able to deal efficiently with rotated frames).
X
X Character evalution finds the character at a particular coordinate in a
X frame. It is useful for higher level windowing code which might need to
X draw frames one character at a time. Character evaluation fails
X if the position given is outside the frame.
X
X Evaluation and rasterisation is recursive.
X
X :- func evaluate(frame, frame__coordinate, frame__size) = char.
X :- mode evaluate(in, in, in) = out is semidet.
X
X :- func rasterise(frame, frame__size) = list(string).
X :- mode rasterise(in, in) = out is det.
X
X Each evaluation/rasterisation must take in and pass the size of the
X framing space -- frames like placeholder frames can't do without
X knowing how large the framing space is.
X
X But the caller shouldn't need to specify a size directly; another
X version of evaluate and rasterise must be provided:
X
X :- func evaluate(frame, frame__coordinate) = char.
X :- mode evaluate(in, in) = out is semidet.
X
X :- func rasterise(frame) = list(string).
X :- mode rasterise(in) = out is det.
X
X These versions evaluate the frame in the minimum space possible.
X
X EXTRACTION
X
X Often, a small part of a frame hierarchy needs to be changed. A
X single string might need to be replaced, or another frame added to a
X page or table.
X
X Since the frame type itself is opaque, it is much more helpful if
X access predicates are provided to extract the children and the
X attributes of a frame. The frame type can be made simple enough for
X the frame creation predicates to work in reverse.
X
SHAR_EOF
$shar_touch -am 0227164998 'FRAMES' &&
chmod 0666 'FRAMES' ||
echo 'restore of FRAMES failed'
shar_count="`wc -c < 'FRAMES'`"
test 13399 -eq "$shar_count" ||
echo "FRAMES: original size 13399, current size $shar_count"
fi
# ============= Mmakefile ==============
if test -f 'Mmakefile' && test X"$1" != X"-c"; then
echo 'x - skipping Mmakefile (file already exists)'
else
shar: Saving Mmakefile (text)
echo 'x - extracting Mmakefile (text)'
sed 's/^X//' << 'SHAR_EOF' > 'Mmakefile' &&
default_target: frame_test frames_test term_interface_test \
X portray_test
X
depend: frame_test.depend frames_test.depend \
X term_interface_test.depend portray_test.depend
SHAR_EOF
$shar_touch -am 0227154698 'Mmakefile' &&
chmod 0666 'Mmakefile' ||
echo 'restore of Mmakefile failed'
shar_count="`wc -c < 'Mmakefile'`"
test 180 -eq "$shar_count" ||
echo "Mmakefile: original size 180, current size $shar_count"
fi
# ============= SPECS ==============
if test -f 'SPECS' && test X"$1" != X"-c"; then
echo 'x - skipping SPECS (file already exists)'
else
shar: Saving SPECS (text)
echo 'x - extracting SPECS (text)'
sed 's/^X//' << 'SHAR_EOF' > 'SPECS' &&
DATA DISPLAY HELPER
X
X
PURPOSE
X
X To make the display of large and complex data structures in a debugger
X meaningful and readable.
X
X
REQUIREMENTS
X
X Mercury programs can generate very large data structures that are
X much too large to dump to output and view during a debugging
X session.
X
X Most of this data isn't useful to the debugger user.
X The user must have selective control over what is viewed in detail,
X and what is ignored -- the maximum number of term arguments printed
X to output; the maximum depth of the output; which terms and terms
X of which data type get omitted.
X
X The user must also have control over the format in which the data
X structure is displayed in: there may be dense data structures
X where indentation would make things much more readable, and there
X may be places where output has to be flattened to fit as
X much into each view as possible.
X
X More complex types, like tree-based maps and sets, have data
X structures which are very difficult to understand in output and
X don't look anything like the abstraction they represent. The
X display helper needs some user-definable way of navigating through
X these structures and displaying them in a custom format.
X
X The implementation of the display helper shouldn't rely on the
X debugger to set user preferences and provide an interface.
X A separate interactive browser is needed for this. It would be a
X convenient way of building and setting user preferences.
X Saving and retrieving the preferences, however, should be left to
X the debugger.
X
X The display helper might also be used by a source-transformed
X Mercury program, which may have to dump (or allow the user to
X browse) a proof tree in formatted form.
X
X
CONCEPTS
X
X There are a number of data types and concepts that are needed when
X using the display helper.
X
X VISIBILITY TREES
X
X A Prolog data structure is a tree of terms. The display helper
X must keep a visibility tree for every term tree that needs to be
X displayed.
X
X Each node of the visibility tree shows:
X - The format in which a term is to be displayed in.
X - Whether the term will be displayed collapsed or expanded.
X
X Every term may have a node in the visibility tree, but not
X necessarily. This would be very wasteful for large data
X structures. Visibility trees are lazily expanded. A tree stub
X awaiting lazy expansion is called a default tree.
X
X PATHS
X
X Visibility trees and term trees can be treated like directory
X trees. Paths are now lists of argument numbers, not lists of
X directory names.
X
X Subterms of Prolog terms are position-important. This is
X inconvenient when dealing with terms with many subterms;
X it becomes really error prone when dealing with trees and
X paths full of such terms.
X
X String names can be assigned to visibility tree nodes to help with
X navigation. These node names can be used in paths.
X
X Visibility tree/term tree paths behave identically to UNIX
X paths. That is, ".." refers to the parent directory, "." to the
X current directory. A "/" at the start of the path is a
X reference to the root directory.
X
X USER PREFERENCES
X
X How default trees get expanded depends on the user's
X preferences. User preferences are really a map of functor names
X to preset visibility trees. This map of presets is called on
X first when expanding default trees.
X
X If a preset tree doesn't exist, then a builtin limit (related
X to the total number of items being displayed and the depth of
X the tree) is used to avoid making giant visibility trees.
X
X
INTERFACE
X
X The display helper will be a Mercury library.
X
X portray(Term, Visible, Prefs, Output, State0, State).
X portray(term::in, visible::in, preference::in,
X io__output_stream::in, io__state::di, io__state::uo) is det.
X
X Displays a term noninteractively.
X
X browse(Term, Visible0, Visible, Prefs0, Prefs, State0, State).
X browse(term::in, visible::in, visible::out,
X preference::in, preference::out,
X io__state::di, io__state::uo) is det.
X
X Invokes the interactive browser.
X
X 'Term' is the term to be displayed.
X
X 'Visible' is the visibility tree. The interactive browser also
X returns a user-modified visibility tree. The caller must supply
X and store the visibility tree.
X
X 'Prefs' is the user preference map. The interactive browser also
X returns user-modified user preferences. The caller must supply and
X store the preference map.
X
X 'Output' is the output text stream. The browser does not need this
X argument -- it always reads user input from standard input and
X writer to standard output.
X
X
OUTPUT
X
X A term can be displayed in three different output formats: flat,
X pretty printed, or verbose.
X
X For example, if the user preferred the type rgb to be collapsed,
X then the displayer helper would display the term:
X shape(vector(1.2, 0, 15.8), colour(rgb(15, 0, 12), hsb(140, 18, 19))).
X
X In flat format as:
X shape(vector(1.2, 0, 15.8), colour(rgb/3, hsb(140, 18, 19))).
X
X Pretty printed as:
X shape(vector(1.2,
X 0,
X 15.8),
X colour(rgb/3,
X hsb(140,
X 18,
X 19))).
X
X In verbose format as:
X - shape/2
X - vector/3
X * float: 1.2
X * float: 0
X * float: 15.8
X - colour/2
X + rgb/3
X - hsb/3
X * integer: 140
X * integer: 18
X * integer: 19
X
X Collapsed functors terms are always printed with their arity.
X
X In verbose format, '*' denotes a constant (integer, string, float).
X '-' denotes functor term with arguments that can be collapsed, and
X '+' denotes an expandible functor term.
X
X Display formats can be mixed.
X
X
DISPLAY SCRIPTS
X
X A simple scripting language can be attached to any visibility tree
X node. It's a user-definable way of fine-controlling the display of
X data types.
X
X The goal of a script is to generate -- from a term tree -- a
X simpler term tree. It also must be able to print out arbitary
X strings to help with formatting.
X
X For example, the term which would be displayed pretty printed as:
X
X f(cons(1,
X cons(2,
X cons(3,
X nil))),
X map(map(leaf,
X pair("date", 188),
X leaf),
X pair("weight", 12),
X leaf))
X
X Would be much more meaningful displayed as:
X
X f([1,
X 2,
X 3],
X map("date" -> 188,
X "weight" -> 12)).
X
X The elements of the map now look like its subterms.
X
X
X SCRIPT COMMAND SET
X
X The scripting language has a minimalist command set and
X structure. A script is a Prolog term, to simplify parsing and
X storage.
X
X block([<command>])
X
X Executes a list of commands.
X
X subterm(<command>)
X
X Executes <command> to look like a subterm.
X
X show(<string>)
X
X Appends a string to the subterm being composed.
X
X show(<path>)
X
X Displays the term at <path> and appends its output to
X the subterm is being composed.
X
X If term at <path> is missing, or its visibility tree node
X at <path> is missing, nothing happens.
X
X If the tree at <path> is a default tree, then ellipses ("...")
X will be printed instead.
X
X nop
X
X Does nothing.
X
X compare(<path>, <value>, <truecommand>, <falsecommand>)
X
X If the term at <path> is a functor, then the functor name is
X compared to <value>.
X
X If the term at <path> is a string, integer or float constant,
X then its string representation is compared to <value>.
X
X If they are equal, then <truecommand> is evaluated. If not,
X then <falsecommand> is evaluated. A missing <path> is always
X unequal to <value>.
X
X <value> is always a string.
X
X For example:
X
X A list type:
X
X :- type list(T) --->
X cons(T, list(T))
X ; nil.
X
X
X cons -> block([subterm(show([1])), show([2])]).
X
X nil -> nop.
X
X
X A tree-based map:
X
X :- type map(K,V) == tree234(K,V).
X :- type tree234(K, V) --->
X empty
X ; two(K, V, tree234(K, V), tree234(K, V))
X ; three(K, V, K, V, tree234(K, V), tree234(K, V), tree234(K, V))
X ; four(K, V, K, V, K, V, tree234(K, V), tree234(K, V),
X tree234(K, V), tree234(K, V)).
X
X
X A corresponding script would really be four scripts -- one for each
X functor in the tree type.
X
X empty -> nop.
X
X two -> block([show([3]),
X subterm(block([show([1]), show([2])])),
X show([4])]).
X
X three -> block([show([5]),
X subterm(block([show([1]), show([2])])),
X show([6]),
X subterm(block([show([3]), show([4])])),
X show([7])]).
X
X four -> block([show([7]),
X subterm(block([show([1]), show([2])])),
X show([8]),
X subterm(block([show([3]), show([4])])),
X show([9]),
X subterm(block([show([5]), show([6])])),
X show([10])]).
X
X
INTERACTIVE COMMAND SET
X
X The interactive browser is intended to be a way of setting user
X preferences.
X
X The browser loops and accepts a small set of user commands from
X input. It calls 'portray' display terms.
X
X . <path>
X .
X show <path>
X show
X Displays the term at <path>.
X If <path> is omitted, displays the root term.
X
X + <path>
X expand <path>
X Temporarily collapses the term at <path>.
X
X - <path>
X collapse <path>
X Temporarily expands the term at <path>.
X
X + <type>
X expand <type>
X Expands all terms of type <type> and makes this a preference
X from now on.
X
X - <type>
X collapse <type>
X Collapses all terms of type <type> and makes this a preference
X from now on.
X
X format <type> <format>
X Changes the display format of all terms of type <type> and makes
X this a preference from now on.
X
X format <path> <format>
X Temporarily changes the display format of the term at <path>.
X
X cd <path>
X Changes the current path to <path>.
X
X chroot <path>
X Changes the root of the term tree to <path>.
X
X attach <path> <script>
X Attaches the display script <script> to the visibility tree node
X of the term at path <path>.
X
X quit
X Quits and returns the user-modified visibility tree and
X preferences to the caller.
X
X quit!
X Quits and returns the original visibility tree and user
X preferences to the caller.
X
X
SHAR_EOF
$shar_touch -am 0227162098 'SPECS' &&
chmod 0666 'SPECS' ||
echo 'restore of SPECS failed'
shar_count="`wc -c < 'SPECS'`"
test 10900 -eq "$shar_count" ||
echo "SPECS: original size 10900, current size $shar_count"
fi
# ============= frame.m ==============
if test -f 'frame.m' && test X"$1" != X"-c"; then
echo 'x - skipping frame.m (file already exists)'
else
shar: Saving frame.m (text)
echo 'x - extracting frame.m (text)'
sed 's/^X//' << 'SHAR_EOF' > 'frame.m' &&
% File: frame.m
%
% This module implements text frames, a way of organising structured text on
% screen using nested rectangular frames. It is an implementation of only a
% small subset of the frames specification.
% It defines a central data type, frame, and a set of low-level functions to
% convert them into strings ready for output.
%
%------------------------------------------------------------------------------%
X
:- module frame.
:- interface.
X
:- import_module string, int, char.
:- import_module std_util.
X
%------------------------------------------------------------------------------%
X
:- type frame --->
X whitespace
X ; filler(char)
X % Text frames hold single lines of text.
X ; text(string)
X % Clipping frames limit the size of a frame.
X ; clipping(frame, frame__size)
X % Horizontal and vertical alignment frames align
X % a frame in free space.
X ; horizontal(frame, frame__alignment)
X ; vertical(frame, frame__alignment)
X % Folding frames hold two frames next to each other.
X % They can be used recursively to generate rows, pages
X % and tables.
X ; fold(pair(frame, frame), frame__direction)
X .
X
X % The alignment of a frame inside its parent, horizontally or
X % vertically. 'least' is toward the top-left corner;
X % 'most' is toward the bottom-right corner.
:- type frame__alignment --->
X least
X ; center
X ; most
X .
X
:- type frame__direction --->
X up
X ; right
X ; down
X ; left
X .
X
:- type frame__size ---> size(int, int).
X
%------------------------------------------------------------------------------%
X
X % frame__rasterise(Frame) turns Frame into a list of lines, ready for
X % output.
:- func frame__rasterise(frame) = list(string).
:- mode frame__rasterise(in) = out is det.
X
X % frame__measure(Frame) returns the size of Frame, in characters.
:- func frame__measure(frame) = frame__size.
:- mode frame__measure(in) = out is det.
X
%------------------------------------------------------------------------------%
X
:- implementation.
X
:- import_module list.
X
X % The size of a frame needs to be known before it can be rasterised --
X % frames have to expand to fit their contents, and must know where
X % to clip or where to pad.
X % The interface version of frame_rasterise shouldn't need to specify
X % sizes. Instead, it shrinks Frame to its minimum size
X % (frame__measure finds the minimum size of a frame).
X
frame__rasterise(Frame) = Stringlist :-
X size(Frame_width, Frame_height) = frame__measure(Frame),
X Stringlist = frame__rasterise(Frame, size(Frame_width, Frame_height)).
X
:- func frame__rasterise(frame, frame__size) = list(string).
:- mode frame__rasterise(in, in) = out is det.
X
frame__rasterise(filler(Char), size(Space_width, Space_height)) = Stringlist :-
X string__duplicate_char(Char, Space_width, Filler_line),
X list__duplicate(Space_height, Filler_line, Stringlist).
X
frame__rasterise(whitespace, size(Space_width, Space_height)) = Stringlist :-
X Stringlist = frame__pad_upper_left([""],
X size(Space_width, Space_height)).
X
frame__rasterise(text(String), size(Space_width, Space_height)) = Stringlist :-
X Stringlist = frame__pad_lower_right([String],
X size(Space_width, Space_height)).
X
frame__rasterise(clipping(Child, size(Clipping_width, Clipping_height)),
X size(Space_width, Space_height)) = Stringlist :-
X Unpadded_stringlist = frame__rasterise(Child,
X size(Clipping_width, Clipping_height)),
X Stringlist = frame__pad_lower_right(Unpadded_stringlist,
X size(Space_width, Space_height)).
X
frame__rasterise(horizontal(Child, Alignment),
X size(Space_width, Space_height)) = Stringlist :-
X frame__size(Child_width, _) = frame__measure(Child),
X Unpadded_stringlist = frame__rasterise(Child,
X size(Child_width, Space_height)),
X Right_padded_stringlist = frame__pad_lower_right(Unpadded_stringlist,
X size(Right_padded_width, Space_height)),
X (
X Alignment = least,
X Right_padded_width = Space_width
X ;
X Alignment = center,
X Right_padded_width = (Child_width + Space_width) // 2
X ;
X Alignment = most,
X Right_padded_width = Child_width
X ),
X Stringlist = frame__pad_upper_left(Right_padded_stringlist,
X size(Space_width, Space_height)).
X
frame__rasterise(vertical(Child, Alignment),
X size(Space_width, Space_height)) = Stringlist :-
X size(_, Child_height) = frame__measure(Child),
X Unpadded_stringlist = frame__rasterise(Child,
X size(Space_width, Child_height)),
X Top_padded_stringlist = frame__pad_lower_right(Unpadded_stringlist,
X size(Space_width, Top_padded_height)),
X (
X Alignment = least,
X Top_padded_height = Space_height
X ;
X Alignment = center,
X Top_padded_height = (Space_height + Child_height) // 2
X ;
X Alignment = most,
X Top_padded_height = Child_height
X ),
X Stringlist = frame__pad_upper_left(Top_padded_stringlist,
X size(Space_width, Space_height)).
X
frame__rasterise(fold(Child_A - Child_B, Direction),
X size(Space_width, Space_height)) = Stringlist :-
X size(A_width, A_height) = frame__measure(Child_A),
X size(B_width, B_height) = frame__measure(Child_B),
X max(A_height, B_height, Max_height),
X max(A_width, B_width, Max_width),
X Stringlist_A = frame__rasterise(Child_A, Final_size_A),
X Stringlist_B = frame__rasterise(Child_B, Final_size_B),
X ( ( Direction = left ; Direction = right) ->
X Final_size_A = size(A_width, Max_height),
X Final_size_B = size(Space_width - A_width, Max_height)
X ;
X Final_size_A = size(Max_width, A_height),
X Final_size_B = size(Max_width, Space_height - A_height)
X ),
X Unpadded_stringlist = frame__block_append(Stringlist_A - Final_size_A,
X Stringlist_B - Final_size_B, Direction),
X Stringlist = frame__pad_lower_right(Unpadded_stringlist,
X size(Space_width, Space_height)).
X
%------------------------------------------------------------------------------%
X
frame__measure(whitespace) = size(0, 0).
X
frame__measure(filler(_)) = size(0, 0).
X
frame__measure(text(String)) = size(String_length, 1) :-
X string__length(String, String_length).
X
frame__measure(clipping(_, size(Clipping_width, Clipping_height)))
X = size(Clipping_width, Clipping_height).
X
frame__measure(horizontal(Child, _))
X = size(Child_width, Child_height) :-
X size(Child_width, Child_height) = frame__measure(Child).
X
frame__measure(vertical(Child, _))
X = size(Child_width, Child_height) :-
X size(Child_width, Child_height) = frame__measure(Child).
X
frame__measure(fold(Child_A - Child_B, Direction ))
X = size(Width, Height) :-
X size(Child_A_width, Child_A_height) = frame__measure(Child_A),
X size(Child_B_width, Child_B_height) = frame__measure(Child_B),
X ( (Direction = up ; Direction = down) ->
X max(Child_A_width, Child_B_width, Width),
X Height = Child_A_height + Child_B_height
X ;
X Width = Child_A_width + Child_B_width,
X max(Child_A_height, Child_B_height, Height)
X ).
X
%------------------------------------------------------------------------------%
X
X % frame__pad_lower_right(Stringlist, Size) and
X % frame__pad_upper_left(Stringlist, Size) make sure that the list of
X % strings Stringlist is a rectangle of size Size.
X % If it isn't it will be padded or clipped; frame__pad_lower_right
X % adds padding or clips text from the lower right corner of the
X % rectangle, frame__pad_upper_left from the upper left.
X
:- func frame__pad_lower_right(list(string), frame__size) = list(string).
:- mode frame__pad_lower_right(in, in) = out is det.
X
frame__pad_lower_right(Unclipped_stringlist, size(Width, Height)) = Stringlist :-
X Clipper = (pred(Line::in, Clipped_line::out) is det :-
X string__left(Line, Width, Clipped_line0),
X string__pad_right(Clipped_line0, ' ', Width, Clipped_line)),
X list__map(Clipper, Unclipped_stringlist, Unpadded_stringlist),
X list__length(Unpadded_stringlist, Unpadded_height),
X string__pad_left("", ' ', Width, Empty_line),
X list__duplicate(Height - Unpadded_height, Empty_line, Empty_lines),
X list__append(Unpadded_stringlist, Empty_lines, Untrimmed_stringlist),
X list__take_upto(Height, Untrimmed_stringlist, Stringlist).
X
:- func frame__pad_upper_left(list(string), frame__size) = list(string).
:- mode frame__pad_upper_left(in, in) = out is det.
X
frame__pad_upper_left(Unclipped_stringlist, size(Width, Height)) = Stringlist :-
X Clipper = (pred(Line::in, Clipped_line::out) is det :-
X string__right(Line, Width, Clipped_line0),
X string__pad_left(Clipped_line0, ' ', Width, Clipped_line)),
X list__map(Clipper, Unclipped_stringlist, Unpadded_stringlist),
X list__length(Unpadded_stringlist, Unpadded_height),
X string__pad_left("", ' ', Width, Empty_line),
X list__duplicate(Height - Unpadded_height, Empty_line, Empty_lines),
X list__append(Empty_lines, Unpadded_stringlist, Untrimmed_stringlist),
X list__take_upto(Height, Untrimmed_stringlist, Stringlist).
X
%------------------------------------------------------------------------------%
X
X % frame__block__append(Block_A - Size_A, Block_B - Size_B, Direction)
X % joins the rectangular region of text Block_B onto Block_A in the
X % direction Direction. The sizes of the text regions must be given.
X % If they differ from the actual size, the regions will be padded or
X % clipped.
X
:- func frame__block_append(pair(list(string), frame__size),
X pair(list(string), frame__size), frame__direction) = list(string).
:- mode frame__block_append(in, in, in) = out is det.
X
frame__block_append(Stringlist_A - Size_A, Stringlist_B - Size_B, left)
X = Stringlist :-
X Stringlist = frame__block_append(Stringlist_B - Size_B,
X Stringlist_A - Size_A, right).
X
frame__block_append(Stringlist_A - Size_A, Stringlist_B - Size_B, up)
X = Stringlist :-
X Stringlist = frame__block_append(Stringlist_B - Size_B,
X Stringlist_A - Size_A, down).
X
frame__block_append(Stringlist_A - size(Width_A, Height_A),
X Stringlist_B - size(Width_B, Height_B), right) = Stringlist :-
X max(Height_A, Height_B, Height),
X Padded_stringlist_A = frame__pad_lower_right(Stringlist_A,
X size(Width_A, Height)),
X Padded_stringlist_B = frame__pad_lower_right(Stringlist_B,
X size(Width_B, Height)),
X Appender = (func(Line_A::in, Line_B::in) = (Line::out) is det :-
X string__append(Line_A, Line_B, Line)),
X Stringlist = frame__list_map2(Appender,
X Padded_stringlist_A, Padded_stringlist_B).
X
frame__block_append(Stringlist_A - size(Width_A, Height_A),
X Stringlist_B - size(Width_B, Height_B), down) = Stringlist :-
X max(Width_A, Width_B, Width),
X Padded_stringlist_A = frame__pad_lower_right(Stringlist_A,
X size(Width, Height_A)),
X Padded_stringlist_B = frame__pad_lower_right(Stringlist_B,
X size(Width, Height_B)),
X list__append(Padded_stringlist_A, Padded_stringlist_B, Stringlist).
X
%------------------------------------------------------------------------------%
X
X % frame__list_map(F, Xs) maps every element of Xs into the list it
X % returns, using the function F.
X
:- func frame__list_map(func(X) = Y, list(X)) = list(Y).
:- mode frame__list_map(func(in) = out is det, in) = out is det.
X
frame__list_map(_, []) = [].
frame__list_map(F, [X | Xs]) = Ys :-
X Ys = [apply(F, X) | frame__list_map(F, Xs)].
X
X % frame__list_map2(F, Xs, Ys) maps pairs of elements from Xs and Ys
X % into the list it returns, using the function F.
X
:- func frame__list_map2(func(X, Y) = Z, list(X), list(Y)) = list(Z).
:- mode frame__list_map2(func(in, in) = out is det, in, in) = out is det.
X
frame__list_map2(_, [], _) = [].
frame__list_map2(_, [_ | _], []) = [].
frame__list_map2(F, [X | Xs], [Y | Ys]) = Zs :-
X Zs = [apply(F, X, Y) | frame__list_map2(F, Xs, Ys)].
X
%------------------------------------------------------------------------------%
SHAR_EOF
$shar_touch -am 0227165198 'frame.m' &&
chmod 0666 'frame.m' ||
echo 'restore of frame.m failed'
shar_count="`wc -c < 'frame.m'`"
test 11432 -eq "$shar_count" ||
echo "frame.m: original size 11432, current size $shar_count"
fi
# ============= frame_test.m ==============
if test -f 'frame_test.m' && test X"$1" != X"-c"; then
echo 'x - skipping frame_test.m (file already exists)'
else
shar: Saving frame_test.m (text)
echo 'x - extracting frame_test.m (text)'
sed 's/^X//' << 'SHAR_EOF' > 'frame_test.m' &&
% File: frame_test.m
%
% Tests all of the functionality in the frame module.
%
% ---------------------------------------------------------------------------- %
% ---------------------------------------------------------------------------- %
X
:- module frame_test.
X
% ---------------------------------------------------------------------------- %
X
:- interface.
:- import_module io.
X
:- pred main(io__state::di, io__state::uo) is det.
X
% ---------------------------------------------------------------------------- %
X
:- implementation.
:- import_module frame.
:- import_module list, string.
:- import_module std_util.
X
main -->
X {
X Frame = fold(text("+ functor") - Nextlevel, down),
X Nextlevel = fold(clipping(whitespace, size(3, 0)) -
X Subterms, right),
X Subterms = cascade(
X [cascade_string(["int: ", "5"], right),
X cascade_string(["float: ", "12.8"], right),
X cascade_string(["string: ", "Hello, world!"], right)],
X down),
X Stringlist = frame__rasterise(Frame),
X P = (pred(X::in, di, uo) is det --> io__nl, io__print(X))
X },
X io__print("Frame size: "),
X io__print(frame__measure(Frame)),
X list__foldl(P, Stringlist),
X io__nl.
X
% ---------------------------------------------------------------------------- %
X
:- func cascade(list(frame), frame__direction) = frame.
:- mode cascade(in, in) = out is det.
X
cascade([], _) = whitespace.
cascade([F | Fs], Direction) = Fold :-
X Fold = fold(F - cascade(Fs, Direction), Direction).
X
:- func cascade_string(list(string), frame__direction) = frame.
:- mode cascade_string(in, in) = out is det.
X
cascade_string([], _) = whitespace.
cascade_string([S | Ss], Direction) = Fold :-
X Fold = fold(text(S) - cascade_string(Ss, Direction), Direction).
X
SHAR_EOF
$shar_touch -am 0227144498 'frame_test.m' &&
chmod 0666 'frame_test.m' ||
echo 'restore of frame_test.m failed'
shar_count="`wc -c < 'frame_test.m'`"
test 1708 -eq "$shar_count" ||
echo "frame_test.m: original size 1708, current size $shar_count"
fi
# ============= frames.m ==============
if test -f 'frames.m' && test X"$1" != X"-c"; then
echo 'x - skipping frames.m (file already exists)'
else
shar: Saving frames.m (text)
echo 'x - extracting frames.m (text)'
sed 's/^X//' << 'SHAR_EOF' > 'frames.m' &&
% File: frames.m
%
% This module implements higher-level ways of dealing with text frames.
%
%------------------------------------------------------------------------------%
X
:- module frames.
:- interface.
X
:- import_module frame.
:- import_module char.
:- import_module list, std_util, io.
X
%------------------------------------------------------------------------------%
X
:- func frames__fold(list(frame), frame__direction) = frame.
:- mode frames__fold(in, in) = out is det.
X
:- func frames__align(pair(frame, frame),
X pair(frame__direction, frame__alignment)) = frame.
:- mode frames__align(in, in) = out is det.
X
:- pred frames__print(frame, io__output_stream, io__state, io__state).
:- mode frames__print(in, in, di, uo) is det.
X
:- pred frames__print(frame, io__state, io__state).
:- mode frames__print(in, di, uo) is det.
X
:- func frames__border(frame, frame__direction, char, char, char) = frame.
:- mode frames__border(in, in, in, in, in) = out is det.
X
:- func frames__border(frame, frame__direction, char) = frame.
:- mode frames__border(in, in, in) = out is det.
X
%------------------------------------------------------------------------------%
X
:- implementation.
:- import_module string.
X
frames__fold([], _) = whitespace.
frames__fold([Child | Children], Direction) = Frame :-
X Frame = fold(Child - fold(Children, Direction), Direction).
X
frames__align(FrameA0 - FrameB0, Direction - Alignment) = Frame :-
X ( (Direction = up ; Direction = down) ->
X FrameA = FrameA0,
X FrameB = horizontal(FrameB0, Alignment)
X ;
X FrameA = FrameA0,
X FrameB = vertical(FrameB0, Alignment)
X ),
X Frame = fold(FrameA - FrameB, Direction).
X
%------------------------------------------------------------------------------%
X
frames__print(Frame, Output_stream) -->
X { Stringlist = frame__rasterise(Frame) },
X io__write_list(Output_stream, Stringlist, "\n", io__print),
X io__nl(Output_stream).
X
frames__print(Frame) -->
X { Stringlist = frame__rasterise(Frame) },
X io__write_list(Stringlist, "\n", io__print),
X io__nl.
X
%------------------------------------------------------------------------------%
X
frames__border(Child, Direction, Border_char) = Frame :-
X Frame = frames__border(Child, Direction,
X Border_char, Border_char, Border_char).
X
frames__border(Child, Direction, Least_corner_char, Border_char, Most_corner_char)
X = Frame :-
X (
X (Direction = left ; Direction = right) ->
X Border_direction = down,
X Anti_border_direction = up
X ;
X Border_direction = right,
X Anti_border_direction = left
X ),
X string__char_to_string(Least_corner_char, Least_string),
X string__char_to_string(Most_corner_char, Most_string),
X Border0 = fold(text(Least_string) - filler(Border_char), Border_direction),
X Border = fold(text(Most_string) - Border0, Anti_border_direction),
X Frame = fold(Child - Border, Direction).
X
%------------------------------------------------------------------------------%
SHAR_EOF
$shar_touch -am 0227144498 'frames.m' &&
chmod 0666 'frames.m' ||
echo 'restore of frames.m failed'
shar_count="`wc -c < 'frames.m'`"
test 2890 -eq "$shar_count" ||
echo "frames.m: original size 2890, current size $shar_count"
fi
# ============= frames_test.m ==============
if test -f 'frames_test.m' && test X"$1" != X"-c"; then
echo 'x - skipping frames_test.m (file already exists)'
else
shar: Saving frames_test.m (text)
echo 'x - extracting frames_test.m (text)'
sed 's/^X//' << 'SHAR_EOF' > 'frames_test.m' &&
% File: frames_test.m
%
% This program tests the frames module.
%
%------------------------------------------------------------------------------%
X
:- module frames_test.
:- interface.
X
:- import_module io.
X
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
X
%------------------------------------------------------------------------------%
X
:- implementation.
:- import_module frames, frame.
:- import_module list, string, std_util.
X
main -->
X { Frame1 = frames__fold([text("Hel"), text("lo"), text("world!")],
X down),
X Frame2 = frames__align(text("A long sentence.") - text("Short."),
X up - most),
X Frame3 = frames__align(Frame1 - Frame2, left - most),
X Frame4 = frames__border(Frame3, left, '/', '|', '\\'),
X Frame = frames__border(Frame4, up, '-', '-', '-')
X },
X frames__print(Frame).
X
%------------------------------------------------------------------------------%
SHAR_EOF
$shar_touch -am 0227144498 'frames_test.m' &&
chmod 0666 'frames_test.m' ||
echo 'restore of frames_test.m failed'
shar_count="`wc -c < 'frames_test.m'`"
test 905 -eq "$shar_count" ||
echo "frames_test.m: original size 905, current size $shar_count"
fi
# ============= portray.m ==============
if test -f 'portray.m' && test X"$1" != X"-c"; then
echo 'x - skipping portray.m (file already exists)'
else
shar: Saving portray.m (text)
echo 'x - extracting portray.m (text)'
sed 's/^X//' << 'SHAR_EOF' > 'portray.m' &&
% ---------------------------------------------------------------------------- %
% ---------------------------------------------------------------------------- %
X
:- module portray.
:- interface.
:- import_module io.
X
% ---------------------------------------------------------------------------- %
X
X % The opaque user preference and visibility tree type. Callers to the
X % portray or browse predicates are expected to store and provide them
X % each call.
X % Use default_preferences and default_visibility to generate default
X % user preferences or visibility trees.
X
:- type preferences.
:- type visibility.
X
X % portray(Univ, Preferences, Visibility, Output_stream, S0, S).
X % Prints a term in univ form to Output_stream in a human readable
X % format. Preferences and Visibility are user preferences and the
X % visibility tree are used by portray to display the term.
X
:- pred portray(univ, preferences, visibility, io__output_stream,
X io__state, io__state).
:- mode portray(in, in, in, in,
X di, uo) is det.
X
:- func default_visibility = visibility.
:- mode default_visibility = out is det.
X
:- func default_preferences = preferences.
:- mode default_preferences = out is det.
X
X % browse(Univ, Pref0, Pref, Visi0, Visi, Input, Output, S0, S).
X % Starts an interactive term browser that prints terms in human
X % readable format to Output in response to user commands from Input.
X % Pref0 and Visi0 are the initial user preferences and visibility tree
X % used for term display.
X % When the browser finishes, the user-modified preferences and
X % visibility tree are returned in Pref and Visi.
X % (NOT IMPLEMENTED YET)
X
/*
:- pred browse(univ, preferences, preferences, visibility, visibility,
X io__input_stream, io__output_stream, io__state, io__state).
:- mode browse(in, in, out, in, out,
X in, out, di, uo) is det.
*/
X
% ---------------------------------------------------------------------------- %
X
:- implementation.
X
:- import_module string, int, char.
:- import_module map, list, std_util.
:- import_module frame, frames, term_interface.
X
% ---------------------------------------------------------------------------- %
X
portray(Univ, Prefs, Visi, Output_stream) -->
X {
X Simplified = visibility_to_simplified(60, Univ, Prefs, Visi),
X Frame = simplified_to_frame(Simplified),
X Stringlist = frame__rasterise(Frame)
X },
X io__write_list(Output_stream, Stringlist, "\n", io__print),
X io__nl.
X
% ---------------------------------------------------------------------------- %
X
X % The user preference map is implemented simply as a type to
X % visibility tree map.
X
:- type preferences
X == map(string, visibility).
X
X % preferences_search(Pref, Short_name) returns the visibility tree
X % preferred for types with name Short_name.
X
:- func preferences_search(preferences, string) = visibility.
:- mode preferences_search(in, in) = (out) is semidet.
X
X % preferences_add(Pref, Short_name, Visibility) returns an updated
X % Pref where all types with name Short_name are expanded to visibility
X % tree Visibility tree.
X
:- func preferences_add(preferences, string, visibility) = preferences.
:- mode preferences_add(in, in, in) = out is semidet.
X
X % preferences_remove(Pref, Short_name) removes any user preference for
X % type Short_name.
X
:- func preferences_remove(preferences, string) = preferences.
:- mode preferences_remove(in, in) = out is semidet.
X
default_preferences = Preferences :-
X map__init(Preferences).
X
default_visibility = stub.
X
preferences_search(Preferences, Short_name) = Visibility :-
X map__search(Preferences, Short_name, Visibility),
X not Visibility = stub.
X
preferences_add(Preferences0, Short_name, Visibility) = Preferences :-
X map__insert(Preferences0, Short_name, Visibility, Preferences),
X not Visibility = stub.
X
preferences_remove(Preferences0, Short_name) = Preferences :-
X map__remove(Preferences0, Short_name, _, Preferences).
X
% ---------------------------------------------------------------------------- %
X
X % The mapping of terms and visibility trees into frames is done in
X % several steps. It involves several simplified data structures.
X %
X % 1. univ + initial visibility tree ->
X % univ + simplified visibility tree
X % The visibility tree for the term is first expanded out to a
X % reasonable size, then turned into a simplified tree.
X % Simplified tree structures represent the user-visible parts of
X % the term tree, whereas visibility trees store as much preference
X % information as possible.
X %
X % 2. simplified tree -> frame
X %
X % 3. frame -> string output
X
:- type visibility
X ---> stub
X ; nonstub(visibility_info,
X format).
X
:- type visibility_info
X ---> expanded(list(visibility))
X ; collapsed(list(visibility)).
X
:- type format
X ---> flat
X ; pretty
X ; verbose.
X
:- type script
X ---> dummy.
X
:- func visibility_to_simplified(int::in, univ::in, preferences::in,
X visibility::in) = (simplified::out) is det.
X
:- func visibility_to_simplified_2(int::in, list(univ)::in, preferences::in,
X list(visibility)::in) = (list(simplified)::out) is det.
X
:- func expand_stub(univ::in, preferences::in) = (visibility::out) is det.
X
visibility_to_simplified(N, Univ, Preferences, Visibility) = Simplified :-
X % Change this when scripting works.
X Univ_subterms = term_interface__arguments(Univ),
X Name = term_interface__name(Univ),
X Short_name = term_interface__name(Univ),
X Rep = term_interface__representation(Univ),
X Arity = term_interface__arity(Univ),
X (
X Visibility = nonstub(expanded(Visibility_subtrees), Format),
X Arity1 = Arity + 1,
X Simplified_subtrees = visibility_to_simplified_2(N // Arity1,
X Univ_subterms, Preferences, Visibility_subtrees),
X (
X N > 0 ->
X Functor_type = expanded(Simplified_subtrees)
X ;
X Functor_type = collapsed
X ),
X Functor = functor(Short_name, Name, Rep, Arity,
X Functor_type),
X Simplified = simplified(Functor, Format)
X ;
X Visibility = nonstub(collapsed(_), Format),
X Functor_type = collapsed,
X Functor = functor(Short_name, Name, Rep, Arity, Functor_type),
X Simplified = simplified(Functor, Format)
X ;
X Visibility = stub,
X Expanded_stub = expand_stub(Univ, Preferences),
X Simplified = visibility_to_simplified(N, Univ, Preferences,
X Expanded_stub)
X ).
X
visibility_to_simplified_2(_, [], _, _) = [].
X
visibility_to_simplified_2(N, [Univ | Univs], Preferences, []) = Rest :-
X Rest = visibility_to_simplified_2(N, [Univ | Univs],
X Preferences, [stub]).
X
visibility_to_simplified_2(N, [Univ | Univs], Preferences,
X [Visibility | Visibilities]) = [Simplified | Simplifieds] :-
X Simplified = visibility_to_simplified(N, Univ, Preferences, Visibility),
X Simplifieds = visibility_to_simplified_2(N, Univs, Preferences,
X Visibilities).
X
expand_stub(Univ, Preferences) = Visibility :-
X Name = term_interface__name(Univ),
X Arity = term_interface__arity(Univ),
X ( Visibility0 = preferences_search(Preferences, Name),
X not Visibility0 = stub
X ->
X Visibility = Visibility0
X ;
X % If the user hasn't a preference, then choose
X % either flat or pretty print format depending on the
X % number of subterms.
X Visibility = nonstub(expanded(Visibility_subs), pretty)
X ),
X list__duplicate(Arity, stub, Visibility_subs).
X
% ---------------------------------------------------------------------------- %
X
X % Simplified trees are trees of user-visible information.
X % All scripts have been run and no further expansion needs to be done;
X % the tree is ready to be dumped to screen in some particular format.
X
:- type simplified
X ---> simplified(simplified_type,
X format). % Display format of the term.
X
:- type simplified_type
X ---> functor(string, % Short type name.
X string, % Long (module qualified name).
X string, % String representation of the term.
X int, % Term arity.
X functor_type)
X ; prop(string, % Is it a formatting dummy for a script?
X list(simplified)).
X
:- type functor_type
X ---> expanded(list(simplified))
X ; collapsed
X ; builtin.
X
:- func simplified_to_frame(simplified::in)
X = (frame::out) is det.
X
simplified_to_frame(Simplified) = Frame :-
X Simplified = simplified(Term_type, _),
X (
X Term_type = prop(_, Simplified_subs)
X ;
X Term_type = functor(_, _, _, _, Functor_type),
X (
X Functor_type = expanded(Simplified_subs)
X ;
X Functor_type = collapsed,
X Simplified_subs = []
X ;
X Functor_type = builtin,
X Simplified_subs = []
X )
X ),
X
X % Descend simplified tree in postorder and map simplified tree
X % children into subframes first.
X Subframes = portray__map(simplified_to_frame, Simplified_subs),
X Frame = build_main_frame(Simplified, Subframes).
X
X % Whichever format type the user displays a term in, the frame the
X % term is dumped into always has two parts: a label, which is the
X % term as a string, and subframes, which are packed in an arrangement
X % of some sort (left-to-right, top-to-bottom, in table columns).
X % make_label creates the label for the term, pack_subframes packs the
X % subframes together, and build_main_frame puts the packed frames and
X % the label together. Both obey the arrangement rules each display
X % format requires.
X
:- func make_label(simplified::in)
X = (string::out) is det.
X
:- func build_main_frame(simplified::in, list(frame)::in)
X = (frame::out) is det.
X
:- func pack_subframes(format::in, list(frame)::in)
X = (frame::out) is det.
X
make_label(simplified(Term_type, verbose)) = Label :-
X (
X Term_type = functor(_, Name, Representation, Arity, Functor_type),
X (
X Functor_type = expanded(_),
X Blurb = "+ "
X ;
X Functor_type = collapsed,
X Blurb = "- "
X ;
X Functor_type = builtin,
X Blurb = "~ "
X ),
X string__int_to_string(Arity, Arity_string),
X List = [Blurb, Name, "/", Arity_string, ": ", Representation],
X string__append_list(List, Label)
X ;
X Term_type = prop(Label, _)
X ).
X
X
make_label(simplified(Term_type, flat)) = Label :-
X (
X Term_type = functor(_, _, Representation, _, _),
X Representation = Label
X ;
X Term_type = prop(Label, _)
X ).
X
make_label(simplified(Term_type, pretty)) = Label :-
X (
X Term_type = functor(_, _, Representation, _, _),
X Representation = Label
X ;
X Term_type = prop(Label, _)
X ).
X
X % Formatting props are always printed as-is.
build_main_frame(simplified(prop(Label, _), _), _) = Frame :-
X Frame = text(Label).
X
build_main_frame(simplified(functor(A, B, C, D, E), verbose), Subframes)
X = Frame :-
X Functor = functor(A, B, C, D, E),
X Label = make_label(simplified(Functor, verbose)),
X Label_frame = text(Label),
X
X Indent_frame = clipping(whitespace, size(3, 0)),
X Bar_frame = fold(clipping(whitespace, size(1, 0)) - filler('|'), down),
X Level_indent_frame = fold(Indent_frame - Bar_frame, down),
X
X ( Subframes = [] ->
X Frame = Label_frame
X ;
X Packed_frame = pack_subframes(verbose, Subframes),
X Frame0 = fold(Level_indent_frame - Packed_frame, right),
X Frame = fold(Label_frame - Frame0, down)
X ).
X
build_main_frame(simplified(functor(A, B, C, D, E), flat), Subframes) = Frame :-
X Functor = functor(A, B, C, D, E),
X Label = make_label(simplified(Functor, flat)),
X Label_frame = text(Label),
X
X ( Subframes = [] ->
X Frame = Label_frame
X ;
X Packed_frame0 = pack_subframes(flat, Subframes),
X Packed_frame1 = frames__align(Packed_frame0 - text("("),
X left - least),
X Packed_frame = frames__align(Packed_frame1 - text(")"),
X right - most),
X Frame = fold(Label_frame - Packed_frame, right)
X ).
X
build_main_frame(simplified(functor(A, B, C, D, E), pretty), Subframes)
X = Frame :-
X Functor = functor(A, B, C, D, E),
X Label = make_label(simplified(Functor, pretty)),
X Label_frame = text(Label),
X
X ( Subframes = [] ->
X Frame = Label_frame
X ;
X Packed_frames = pack_subframes(pretty, Subframes),
X Left_padded_frames = fold(Packed_frames - text(" "), left),
X Padded_frames = fold(Left_padded_frames - text(" "), right),
X
X % Giant brackets are needed to readably group blocks
X % of more than three subterms; small brackets suffice
X % for two or less.
X list__length(Subframes, Length),
X ( Length >= 3 ->
X Left_bracketed_frames = frames__border(Padded_frames,
X left, '/', '|', '\\'),
X Bracketed_frames = frames__border(Left_bracketed_frames,
X right, '\\', '|', '/')
X ;
X Left_bracketed_frames = frames__align(
X Padded_frames - text("( "), left - least),
X Bracketed_frames = frames__align(
X Left_bracketed_frames - text(" )"), right - most)
X ),
X
X Frame0 = fold(Label_frame - text(" "), right),
X Frame = fold(Frame0 - Bracketed_frames, right)
X ).
X
pack_subframes(_, []) = whitespace.
X
pack_subframes(verbose, [Subframe | Subframes]) = Packed_frame :-
X Packed_frame = fold(Subframe - Rest_packed_frame, down),
X Rest_packed_frame = pack_subframes(verbose, Subframes).
X
pack_subframes(flat, [Subframe | Subframes]) = Packed_frame :-
X ( Subframes = [] ->
X Packed_frame = Subframe
X ;
X Comma_frame = text(", "),
X Commaed_subframe = frames__align(Subframe - Comma_frame,
X right - most),
X Packed_frame = fold(Commaed_subframe - Rest_packed_frame,
X right),
X Rest_packed_frame = pack_subframes(flat, Subframes)
X ).
X
pack_subframes(pretty, [Subframe | Subframes]) = Packed_frame :-
X Frames = [Subframe | Subframes],
X list__length(Frames, Length),
X ( Length > 5,
X list__split_list(Length // 2, Frames, Left_frames, Right_frames) ->
X Packed_right_frame = pack_subframes(pretty, Right_frames),
X Packed_left_frame0 = pack_subframes(pretty, Left_frames),
X Packed_left_frame1 = frames__border(Packed_left_frame0, right, '|'),
X Packed_left_frame = frames__border(Packed_left_frame1, right, ' '),
X Packed_frame = fold(Packed_left_frame - Packed_right_frame,
X right)
X ;
X Packed_frame = fold(Subframe - Rest_packed_frame, down),
X Rest_packed_frame = pack_subframes(pretty, Subframes)
X ).
X
% ---------------------------------------------------------------------------- %
X
:- func portray__map(func(X) = Y, list(X)) = list(Y).
:- mode portray__map(func(in) = out is det, in) = out is det.
X
:- func portray__zip(list(X)::in, list(Y)::in)
X = (list(pair(X, Y))::out) is det.
X
portray__map(_, []) = [].
portray__map(F, [X | Xs]) = [Y | Ys] :-
X [Y | Ys] = [apply(F, X) | portray__map(F, Xs)].
X
portray__zip([], _) = [].
portray__zip([_ | _], []) = [].
portray__zip([X | Xs], [Y | Ys]) = [X - Y | Zs] :-
X Zs = portray__zip(Xs, Ys).
X
% ---------------------------------------------------------------------------- %
SHAR_EOF
$shar_touch -am 0227165298 'portray.m' &&
chmod 0600 'portray.m' ||
echo 'restore of portray.m failed'
shar_count="`wc -c < 'portray.m'`"
test 14348 -eq "$shar_count" ||
echo "portray.m: original size 14348, current size $shar_count"
fi
# ============= portray_test.m ==============
if test -f 'portray_test.m' && test X"$1" != X"-c"; then
echo 'x - skipping portray_test.m (file already exists)'
else
shar: Saving portray_test.m (text)
echo 'x - extracting portray_test.m (text)'
sed 's/^X//' << 'SHAR_EOF' > 'portray_test.m' &&
:- module portray_test.
X
% ---------------------------------------------------------------------------- %
X
:- interface.
:- import_module io.
X
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
X
% ---------------------------------------------------------------------------- %
X
:- implementation.
:- import_module int, list, string, map.
:- import_module std_util.
:- import_module portray, frame.
X
main -->
X {
X L0 = ["March" - 3,
X "September" - 9,
X "May" - 5,
X "February" - 2,
X "November" - 11,
X "January" - 1,
X "June" - 6,
X "December" - 12,
X "July" - 7,
X "April" - 4,
X "August" - 8,
X "October" - 10],
X pair_unzip(L0) = L1 - L2,
X map__init(T0),
X map__det_insert_from_corresponding_lists(T0, L1, L2, T)
X },
X io__output_stream(Stdout),
X portray(univ(T), default_preferences, default_visibility, Stdout).
X
:- func pair_unzip(list(pair(X, Y))) = pair(list(X), list(Y)).
:- mode pair_unzip(in) = out is det.
X
pair_unzip([]) = [] - [].
pair_unzip([X - Y | XYs]) = [X | Xs] - [Y | Ys] :-
X Xs - Ys = pair_unzip(XYs).
SHAR_EOF
$shar_touch -am 0227144498 'portray_test.m' &&
chmod 0666 'portray_test.m' ||
echo 'restore of portray_test.m failed'
shar_count="`wc -c < 'portray_test.m'`"
test 1116 -eq "$shar_count" ||
echo "portray_test.m: original size 1116, current size $shar_count"
fi
# ============= term_interface.m ==============
if test -f 'term_interface.m' && test X"$1" != X"-c"; then
echo 'x - skipping term_interface.m (file already exists)'
else
shar: Saving term_interface.m (text)
echo 'x - extracting term_interface.m (text)'
sed 's/^X//' << 'SHAR_EOF' > 'term_interface.m' &&
% File: term_interface.m
%
% This module implements
%
%------------------------------------------------------------------------------%
X
:- module term_interface.
:- interface.
:- import_module list, string.
:- import_module std_util.
X
%------------------------------------------------------------------------------%
X
:- func term_interface__name(univ) = string.
:- mode term_interface__name(in) = out is det.
X
:- func term_interface__arguments(univ) = list(univ).
:- mode term_interface__arguments(in) = out is det.
X
:- func term_interface__arity(univ) = int.
:- mode term_interface__arity(in) = out is det.
X
:- func term_interface__representation(univ) = string.
:- mode term_interface__representation(in) = out is det.
X
:- pred term_interface__builtin(univ).
:- mode term_interface__builtin(in) is semidet.
X
%------------------------------------------------------------------------------%
X
:- implementation.
:- import_module int.
:- import_module term.
X
term_interface__name(Univ) = Name :-
X Name = type_name(univ_type(Univ)).
X
term_interface__arguments(Univ) = Arguments :-
X deconstruct(Univ, _, _, Arguments).
X
term_interface__arity(Univ) = Arity :-
X deconstruct(Univ, _, Arity, _).
X
term_interface__representation(Univ) = Value :-
X deconstruct(Univ, Value, _, _).
X
term_interface__builtin(Univ) :-
X term__univ_to_term(Univ, Term),
X Term = term__functor(Const, _, _),
X ( Const = term__integer(_) ;
X Const = term__float(_) ;
X Const = term__string(_) ).
X
%------------------------------------------------------------------------------%
SHAR_EOF
$shar_touch -am 0227144498 'term_interface.m' &&
chmod 0666 'term_interface.m' ||
echo 'restore of term_interface.m failed'
shar_count="`wc -c < 'term_interface.m'`"
test 1551 -eq "$shar_count" ||
echo "term_interface.m: original size 1551, current size $shar_count"
fi
# ============= term_interface_test.m ==============
if test -f 'term_interface_test.m' && test X"$1" != X"-c"; then
echo 'x - skipping term_interface_test.m (file already exists)'
else
shar: Saving term_interface_test.m (text)
echo 'x - extracting term_interface_test.m (text)'
sed 's/^X//' << 'SHAR_EOF' > 'term_interface_test.m' &&
%------------------------------------------------------------------------------%
X
:- module term_interface_test.
:- interface.
:- import_module io.
X
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
X
%------------------------------------------------------------------------------%
X
:- implementation.
:- import_module list, string, std_util.
:- import_module term_interface.
X
main -->
X { Univ = univ("Hello!") },
X io__print(term_interface__name(Univ)),
X ( { term_interface__builtin(Univ) } ->
X io__print(": "),
X io__print(term_interface__representation(Univ))
X ;
X { true }
X ).
X
X
%------------------------------------------------------------------------------%
SHAR_EOF
$shar_touch -am 0227144498 'term_interface_test.m' &&
chmod 0666 'term_interface_test.m' ||
echo 'restore of term_interface_test.m failed'
shar_count="`wc -c < 'term_interface_test.m'`"
test 682 -eq "$shar_count" ||
echo "term_interface_test.m: original size 682, current size $shar_count"
fi
exit 0
More information about the developers
mailing list