Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

304 lines (258 sloc) 8.776 kB
use("core")
use("data")
use("define")
use("control-flow")
use("comparison")
use("array")
use("patterns")
use("condition")
infix("</> <//> <$> <$$>", 60, .right)
infix("<> <+>", 70, .right)
-- combinatorial structures
data(Doc):
Empty
Cat(@x, @y)
Nest(@depth, @doc)
Text(@value)
Raw(@value)
Line(@space?)
Union(@x-thunk, @y-thunk, @prefer? = false)
Column(@thunk) -- @thunk is (Integer -> Doc)
Nesting(@thunk) -- @thunk is (Integer -> Doc)
-- simple documents (used internally)
data(SDoc):
SEmpty
SText(@value, @rest-thunk)
SRaw(@value, @rest-thunk)
SLine(@space?, @indentation, @rest-thunk)
-- helpful for debugging
SEmpty to-sexp := .sempty
SText to-sexp := [.stext, @value, @rest-thunk [] to-sexp]
SRaw to-sexp := [.sraw, @value, @rest-thunk [] to-sexp]
SLine to-sexp := [.sline, @space?, @indentation, @rest-thunk [] to-sexp]
Empty to-sexp := .empty
Cat to-sexp := [.cat, @x to-sexp, @y to-sexp]
Nest to-sexp := [.nest, @depth, @doc]
Text to-sexp := [.text, @value]
Raw to-sexp := [.raw, @value]
Line to-sexp := [.line, @space?]
Union to-sexp := [.union, x to-sexp, y to-sexp, @prefer?]
Column to-sexp := .column
Nesting to-sexp := .nesting
-- lazy values
Union x := @x ||= @x-thunk call
Union y := @y ||= @y-thunk call
SText rest := @rest ||= @rest-thunk call
SRaw rest := @rest ||= @rest-thunk call
SLine rest := @rest ||= @rest-thunk call
-- constructors
Empty <> y := y
Doc <> Empty := self
Doc <> y := Cat new(self, y)
Proc <|> y := Union new(self, y)
Doc <|> y := Union new({ self }, { y })
Proc <||> y := Union new(self, y, true)
Doc <||> y := Union new({ self }, { y }, true)
Doc nest(i) := Nest new(i, self)
-- flatten a document
Empty flatten := /empty
Cat(x, y) flatten := x flatten <> y flatten
Nest(i, x) flatten := x flatten
Text(s) flatten := /text(s)
Raw(s) flatten := /raw(s)
Line(true) flatten := /text(" ")
Line(false) flatten := /empty
Union flatten := x flatten
Column(f) flatten := /(column [x]: f [x] flatten)
Nesting(f) flatten := /(nesting [x]: f [x] flatten)
-- hanging indentation
Doc hang(i) := /align(nest(i))
-- full indentation
Doc indent(i) := (/text(" " * i) <> self) hang(i)
-- p punctuate([d1, d2, ..., dn]) => [d1 <> p, d2 <> p, ..., dn]
Doc punctuate([]) := []
Doc punctuate([d]) := [d]
Doc punctuate(d . ds) := [d <> self] + punctuate(ds)
-- sep + punctuate
Doc separate(ds) := /align(/sep(/punctuate(ds)))
-- concatenate two documents, with a space in-between
Empty <+> y := y
Doc <+> Empty := self
Doc <+> y := self <> /space <> y
-- concatenates two documents, with a `softline' in between
Empty </> y := y
Doc </> Empty := self
Doc </> y := self <> /softline <> y
-- concatenates two documents, with a `suggestline' in between
Empty <\> y := y
Doc <\> Empty := self
Doc <\> y := self <> /suggestline <> y
-- concatenates two documents, with a `softbreak' in between
Empty <//> y := y
Doc <//> Empty := self
Doc <//> y := self <> /softbreak <> y
-- concatenates two documents, with a `suggestbreak' in between
Empty <\\> y := y
Doc <\\> Empty := self
Doc <\\> y := self <> /suggestbreak <> y
-- concatenates two documents, with a `line' in between
Empty <$> y := y
Doc <$> Empty := self
Doc <$> y := self <> /line <> y
-- concatenates two documents, with a `linebreak' in between
Empty <$$> y := y
Doc <$$> Empty := self
Doc <$$> y := self <> /linebreak <> y
-- predeclare so pick-union can use it
fit() = nil
-- chose the side of a Union that best fits the given width
pick-union(w, k, i, ds, x, y, prefer?) = do:
flattened = fit(w, k, [i, x] . ds, prefer?)
if(flattened fits(w - k)?)
then: flattened
else:
/signal(.no-fit)
fit(w, k, [i, y] . ds, prefer?)
-- helper for `best' by linearizing documents
fit(_, _, [], pref = false) = SEmpty new
fit(w, k, [i, d] . ds, pref = false) =
d match:
Empty -> fit(w, k, ds, pref)
Cat(x, y) -> fit(w, k, [[i, x], [i, y]] + ds, pref)
Nest(j, x) -> fit(w, k, [i + j, x] . ds, pref)
Text(s) -> SText new(s, { fit(w, k + s size, ds, pref) })
Raw(s) -> SRaw new(s, { fit(w, k, ds, pref) })
Line(s) -> SLine new(s, i, { fit(w, i, ds, false) })
Column(f) -> fit(w, k, [i, f[k]] . ds, pref)
Nesting(f) -> fit(w, k, [i, f[i]] . ds, pref)
Union:
if(d prefer? and not pref)
then:
{ with-restarts(use-fit -> fit(w, k, [i, d y] . ds, false)):
pick-union(w, k, i, ds, d x, d y, true)
} bind:
.no-fit -> /restart(.use-fit)
else: pick-union(w, k, i, ds, d x, d y, pref)
-- find the best configuration to fit document X in width w
Doc best(w, k) := fit(w, k, [[0, self]])
-- test that a document can fit in a given width
SText fits(w)? := w >= 0 and rest fits(w - @value size)?
SRaw fits(w)? := w >= 0 and rest fits(w)?
SDoc fits(w)? := w >= 0
-- rendering to a string
SEmpty layout := ""
SText layout := @value + rest layout
SRaw layout := @value + rest layout
SLine layout := "\n" + (" " * @indentation) + rest layout
-- rendering to a string
Cat(x, y) layout := x layout + y layout
Empty layout := ""
Text(s) layout := s
Raw(s) layout := s
Line layout := "\n"
Union layout := y layout
Nest(i, d) layout :=
d match:
Cat(x, y) -> x nest(i) layout + y nest(i) layout
Empty -> ""
Text(s) -> s
Raw(s) -> s
Line -> "\n" + (" " * i)
Nest(e, x) -> Nest new(i + e, x) layout
Union -> Nest new(i, d y) layout
-- trivial emptiness check
Empty empty? := true
Doc empty? := false
-- pretty-printing with a maximum width
Doc render(width = 70) := best(width, 0) layout
-- trivial constructors
empty := Empty new
text(s) := Text new(s to-s)
raw(s) := Raw new(s to-s)
line := Line new(true)
linebreak := Line new(false)
column &f := Column new(f)
nesting &f := Nesting new(f)
group(x) := { x flatten } <|> { x }
preferred-group(x) := { x flatten } <||> { x }
softline := group(line)
softbreak := group(linebreak)
suggestline := preferred-group(line)
suggestbreak := preferred-group(linebreak)
-- render x with the nesting level set to the current column
align(x) :=
column [k]:
nesting [i]:
x nest(k - i)
-- wrap `x' in `left' and `right'
enclose(left, right, x) := left <> x <> right
-- punctuate `xs' with `delim', separating with a space, and wrapping with
-- `left` and `right`
enclose-sep(left, right, delim, xs) :=
enclose(left, right, align(sep(delim punctuate(xs))))
-- punctuate `xs' with `delim', and wrapping with `left` and `right`
enclose-cat(left, right, delim, xs) :=
enclose(left, right, align(cat(delim punctuate(xs))))
-- separating lists
hsep(xs) := xs inject-right(empty) [x, y]: x <+> y
vsep(xs) := xs inject-right(empty) [x, y]: x <$> y
sep(xs) := group(vsep(xs))
fill-sep(xs) := xs inject-right(empty) [x, y]: x </> y
suggest-sep(xs) := xs inject-right(empty) [x, y]: x <\> y
-- concatenating lists
hcat(xs) := xs inject-right(empty) [x, y]: x <> y
vcat(xs) := xs inject-right(empty) [x, y]: x <$$> y
cat(xs) := group(vcat(xs))
fill-cat(xs) := xs inject-right(empty) [x, y]: x <//> y
suggest-cat(xs) := xs inject-right(empty) [x, y]: x <\\> y
-- fill a document with whitespace to width `i'
fill(i, d) :=
width(d) [w]:
if(w >= i)
then: empty
else: text(" " * (i - w))
-- fill a document with whitespace to width `i', breaking onto a new line if
-- the document gets too long
fill-break(i, d) :=
width(d) [w]:
if(w > i)
then: linebreak nest(i)
else: text(" " * (i - w))
-- call `f' with the width of the passed document, and render the result
-- after it
width(d) &f :=
column [c1]: d <> column [c2]: f [c2 - c1]
-- helper documents
lparen := text("(")
rparen := text(")")
langle := text("<")
rangle := text(">")
lbrace := text("{")
rbrace := text("}")
lbracket := text("[")
rbracket := text("]")
squote := text("'")
dquote := text("\"")
semi := text(";")
colon := text(":")
comma := text(",")
space := text(" ")
dot := text(".")
backslash := text("\\")
equals := text("=")
-- helper for creating text from a string that may contain newlines
string(s) := hcat(line punctuate(s split("\n") collect [x]: text(x)))
-- wrappers
parens(x) := lparen <> x <> rparen
angles(x) := langle <> x <> rangle
braces(x) := lbrace <> x <> rbrace
brackets(x) := lbracket <> x <> rbracket
squotes(x) := squote <> x <> squote
dquotes(x) := dquote <> x <> dquote
-- helpers for common syntax
list(xs) :=
enclose(lbracket, rbracket, align(fill-sep(comma punctuate(xs))))
tupled(xs) :=
enclose(lparen, rparen, align(fill-sep(comma punctuate(xs))))
semi-braces(xs) :=
enclose-sep(lbrace, rbrace, semi, xs)
Jump to Line
Something went wrong with that request. Please try again.