/**
* This is a simple Box to text converter.
* It formats H, HV, A/R and ALT boxes.
*
* Authors:
* - Merijn de Jonge <mdjonge@cwi.nl>
* - Eelco Visser <visser@acm.org>
* - Joost Visser <jvisser@cwi.nl>
* - Martin Bravenboer <martin.bravenboer@gmail.com>
*
* Eelco Visser (April 5, 2001)
* - repaired bug in handling of H boxes
* - refactored handling of H case using thread-map
*
* Martin Bravenboer (December 26/27/28, 2002)
* - implemented HV and A/R boxes
* - refactored many strategy defs
*/
module stratego/gpp/BoxToText
imports
Box
libstratego-lib
stratego/gpp/Util
strategies
/**
* @todo Dump the exit
*/
try-abox2text(|pos, width) =
let local-abox2text(|pos) =
abox2text(local-abox2text | pos, width)
<+ log(|Error(), "invalid box: ", <id>)
; <exit> 1
in local-abox2text(|0)
end
; Fst
abox2text(| width) =
let local-abox2text(|pos) =
abox2text(local-abox2text | pos, width)
in local-abox2text(|0)
end
; Fst
strategies
/**
* Use different names to make profiling easier.
*/
abox2text(rec : t * t -> t | xpos, width) =
abox2text-HV(rec | xpos, width)
+ abox2text-HV(rec | xpos, width)
+ abox2text-H(rec | xpos, width)
+ abox2text-V(rec | xpos, width)
+ abox2text-A(rec | xpos, width)
+ abox2text-R(rec | xpos, width)
+ abox2text-S(rec | xpos, width)
+ abox2text-C(rec | xpos, width)
+ abox2text-FBOX(rec | xpos, width)
+ abox2text-R(rec | xpos, width)
+ abox2text-ALT(rec | xpos, width)
+ abox2text-list(rec | xpos, width)
/**
* This encoding of HV boxes is exponential; not so bad for formatting
* paragraphs, but not tractable for formatting nested expressions.
*/
strategies
/**
* HV
*
* @todo Handle vs and is options
* @todo Substract last hspace from xpos
* @type (Box, Int) -> (Strs, Int)
*/
abox2text-HV(rec : t * t -> t | xpos, width) =
?HV(sopt, bs)
; <gpp-hs-chars> sopt => hs-chars
; <implode-string> hs-chars => hs
; <gpp-vs-text> sopt => vs
; <length> hs-chars => hsl
; <add> (xpos, <gpp-is-length> sopt) => left-xpos
; !(bs, [([], xpos)])
; foldl(
gpp-hv-add-to-hbox(rec | hsl, width)
<+ gpp-hv-in-new-vbox(rec | hsl, left-xpos, width)
)
; reverse; map((reverse, id))
; map((<separate-by> (hs, <id>), id))
; gpp-format-vbox(|sopt, xpos)
/**
* @type Box * [Int * [String]] -> [Int * [String]]
*/
gpp-hv-add-to-hbox(rec : t * t -> t | hsl, width) :
(box, [(strs, xpos) | vbs ]) -> [([ str | strs ], <add> (new-xpos, hsl)) | vbs]
where
<rec(|xpos)> box => (str, new-xpos)
; (<leq> (new-xpos, width) + (!width => 0))
gpp-hv-in-new-vbox(rec : t * t -> t | hsl, left-xpos, width) :
(box, vbs) -> [([str], <add> (new-xpos, hsl)) | vbs]
where
<rec(|left-xpos)> box => (str, new-xpos)
strategies
/**
* H
*
* @type (Box, Int) -> (Strs, Int)
*/
abox2text-H(rec : t * t -> t | xpos, width) =
?H(sopt, bs)
; <gpp-hs-chars> sopt => hschars
; <implode-string> hschars => hs
; <length> hschars => hsl
; <filter(gpp-is-real-hbox)> bs
; let rec-add(|pos) =
rec(|pos); (id, <add> (hsl, <id>))
in gpp-thread-map(rec-add | xpos)
; (separate-by(|hs), id)
; try((not([]), <subt> (<id>, hsl)))
end
gpp-thread-map(s: t * t -> t | t) :
[] -> ([], t)
gpp-thread-map(s : t * t -> t | t) :
[x | xs] -> ([y | ys], t'')
where
<s(|t)> x => (y, t')
; <gpp-thread-map(s | t')> xs => (ys, t'')
strategies
/**
* V
*
* @type (Box, Int) -> (Strs, Int)
*/
abox2text-V(rec : t * t -> t | xpos, width) =
?V(sopt, bs)
; <add> (xpos, <gpp-is-length> sopt) => left-xpos
; <filter(gpp-is-real-vbox)> bs
; if ?[] then
!([], xpos)
else
gpp-do-vbox-children(rec | xpos, left-xpos)
; gpp-format-vbox(|sopt, xpos)
end
/**
* @type Int * Int * [BOX] -> [Strings * Int]
*/
gpp-do-vbox-children(rec : t * t -> t | xpos, left-xpos) :
[b | bs] -> [<rec(|xpos)> b | <map(rec(|left-xpos))> bs]
strategies
/**
* A
*
* The first two rules are to handle empty alignment operators, i.e., A
* boxses with [] or [[]] as third argument.
* Without subboxes ([] as third argument)
*/
abox2text-A(rec : t * t -> t | xpos, width) :
A(AOPTIONS(aopt), sopt, []) -> ([], xpos)
/**
* Without subboxes ([[]] as third argument)
*/
abox2text-A(rec : t * t -> t | xpos, width) :
A(AOPTIONS(aopt), sopt, [[]]) -> ([], xpos)
abox2text-A(rec : t * t -> t | xpos, width) =
?A(AOPTIONS(aopt), sopt, bs)
; !bs
; gpp-construct-rows
; map(?R(_, <id>))
; gpp-to-matrix(|<length> aopt)
; matrix-transpose
; reverse
; add-indices
; reverse
; ?columns
; <zip> (aopt, columns) => column-tuples
; <foldl(gpp-do-A-column(rec))> (column-tuples, (xpos, [])) => (last-xpos, str-columns)
; <reverse; matrix-transpose> str-columns
; map(!(<id>, last-xpos))
; gpp-format-vbox(|sopt, xpos)
/**
* (A-OPTION * (Int * [BOX])) * (Int * [[Strs]]) -> Int * [[Strs]]
*/
gpp-do-A-column(rec : t * t -> t) :
((aopt, (index, bs)), (xpos, columns)) -> (<add> (<string-length> hs, max-xpos), [ new-column | columns ])
where
< map(rec(|xpos))
; unzip
; (map(try(flatten-list; concat-strings)), list-max)
> bs => (strings, max-xpos)
; <subt> (max-xpos, xpos) => max-width
; (<gt> (index, 1) < <gpp-SOpts-of-alignment; gpp-hs-text> aopt + !"") => hs
; <map(
<gpp-align-column> (index, aopt, (' ', <id>, max-width))
; <conc-strings> (<id>, hs)
)> strings => new-column
gpp-align-column : (_, AR(_), t) -> <align-right> t
gpp-align-column : (_, AC(_), t) -> <align-center> t
gpp-align-column : (1, AL(_), (_, s, _)) -> s
gpp-align-column : (i, AL(_), t) -> <align-left> t
where <gt> (i, 1)
// TODO: align cannot handle newlines in cells
// TODO: remove flatten-list and implement our own align strategies
/**
* Make sure that all R boxes have the same number of arguments. If
* not, add empty boxes ([]) to make equal lengths.
*/
gpp-to-matrix(|nr-cols) =
map(gpp-FitToMax(|nr-cols))
gpp-FitToMax(|nr-cols) =
?lst
; where(length => my-length)
; <subt> (nr-cols, my-length) => diff
; ( <gt> (<id>, 0)
// Create new (empty) columns
; <copy> (diff, []) => l
// Create row with correct number of columns
; <conc> (lst, l)
<+ ?0
; !lst
<+ // A row with to many columns cause a fatal error, because
// since formatting information is missing, we do not know
// how to format these extra columns
log(|Error(), "Too many columns in row: ", lst)
; <exit> 1
)
// R, not as child of an A
abox2text-R(rec : t * t -> t | xpos, width) :
R(sopt, bs) -> <rec(|xpos)> HV(sopt, bs)
/**
* S
*/
abox2text-S(rec : t * t -> t | xpos, width) :
S(s) -> (s, <add> (xpos, <gpp-rel-string-length(|xpos)> s))
abox2text-C(rec : t * t -> t | xpos, width) :
C(_,[S(s)]) -> (s, xpos)
abox2text-FBOX(rec : t * t -> t | xpos, width) :
FBOX(_,b) -> <rec(|xpos)> b
abox2text-R(rec : t * t -> t | xpos, width) :
R(sopt, bs) -> <rec(|xpos)> HV(sopt, bs)
abox2text-ALT(rec : t * t -> t | xpos, width) =
?ALT(a1, a2)
; <rec(|xpos)> a1 => r1@(s, xpos2)
; if <leq> (xpos2, width) then
!r1
else
<rec(|xpos)> a2
end
abox2text-list(rec : t * t -> t | xpos, width) :
[b] -> <rec(|xpos)> b
abox2text-list(rec : t * t -> t | xpos, width) :
[] -> ("", xpos)
strategies
/**
* @type List(S-Option) -> String
*/
gpp-hs-text =
gpp-hs-chars
; implode-string
gpp-hs-chars =
gpp-hs-length
; gpp-copy(|' ')
/**
* @type List(S-Option) -> String
*/
gpp-vs-text =
gpp-vs-chars
; implode-string
gpp-vs-chars =
gpp-vs-chars(|[])
gpp-vs-chars(|cont) =
gpp-vs-length
; inc
; gpp-copy(|'\n', cont)
/**
* @type List(S-Option) -> String
*/
gpp-is-text =
gpp-is-chars
; implode-string
gpp-is-chars =
gpp-is-chars(|[])
gpp-is-chars(|cont) =
gpp-is-length
; gpp-copy(|' ', cont)
strategies
gpp-copy(|t) =
gpp-copy(|t, [])
gpp-copy(|t, ts) =
\ 0 -> ts \
<+ ?n
; <subt> (n, 1)
; gpp-copy(|t, [t | ts])
strategies
/**
* @type Box ->? Box
*/
gpp-is-real-vbox =
not(
?[]
+ ?_#([_,[]])
+ ?_#([_,[[]]])
)
/**
* @type Box ->? Box
*/
gpp-is-real-hbox =
not(?[] + ?H([],[]))
strategies
/**
* @param List(S-Option)
* @param Int
* @type List((Strings, Int)) -> (List(Strings), Int)
*/
gpp-format-vbox(|sopt, xpos) :
strs -> (result, last-xpos)
where
<gpp-vertical-sep(|xpos)> sopt => sep
; <last> strs => (_, last-xpos)
; !strs
// separate-by + Fst
; ([] + [Fst |
rec x(
[]
+ [Fst | x]
; ![sep | <id>]
)])
; ?result
/**
* @param Int
* @type List(S-Option) -> String
*/
gpp-vertical-sep(|xpos) =
?sopt
; <gpp-vs-chars(|
<gpp-is-chars(|
<gpp-copy(|' ')> xpos
)> sopt
)> sopt
; implode-string