Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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.