Text AST Reimplementation. (#327)

This commit is contained in:
Josef 2019-11-14 13:55:45 +01:00 committed by GitHub
parent 3929b3f72c
commit 8da25bec2d
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 430 additions and 313 deletions

View File

@ -647,138 +647,197 @@ object AST {
type Text = ASTOf[TextOf]
sealed trait TextOf[T] extends ShapeOf[T] with LiteralOf[T] {
val body: Text.BodyOf[Text.Segment[T]]
val quoteChar: Char
def quoteRepr: String = quoteChar.toString * body.quote.asInt
def bodyRepr(implicit ev: Repr[T]): Repr.Builder =
R + body.lines.head + body.lines.tail.map(t => newline + t.off + t.elem)
def quote: Repr.Builder
}
object TextOf {
import Text._
implicit def ftor: Functor[TextOf] = semi.functor
implicit def fold: Foldable[TextOf] = semi.foldable
implicit def repr[T: Repr]: Repr[TextOf[T]] =
t => R + t.quoteRepr + t.bodyRepr + t.quoteRepr
implicit def repr[T: Repr]: Repr[TextOf[T]] = {
case t: Line[T] => Repr(t)
case t: Text.Block[T] => Repr(t)
case t: UnclosedOf[T] => Repr(t)
}
implicit def ozip[T: Repr]: OffsetZip[TextOf, T] = {
case t: Text.RawOf[T] => OffsetZip(t)
case t: Text.FmtOf[T] => OffsetZip(t)
case t: Line[T] => OffsetZip(t)
case t: Text.Block[T] => OffsetZip(t)
case t: UnclosedOf[T] => OffsetZip(t)
}
}
object Text {
import Segment.implicits._
def apply(body: BodyOf[Segment._Fmt[AST]]): Fmt = Fmt(body)
//// Definition ////
type Block[+T] = List1[LineOf[T]]
sealed trait Line[T] extends TextOf[T]
sealed trait Block[T] extends TextOf[T]
type Raw = ASTOf[RawOf]
type Fmt = ASTOf[FmtOf]
type Unclosed = ASTOf[UnclosedOf]
case class LineOf[+T](off: Int, elem: List[T])
case class BodyOf[+T](quote: Quote, lines: Text.Block[T])
case class RawOf[T](body: BodyOf[Segment._Raw[T]])
final case class UnclosedOf[T](line: Line[T])
extends TextOf[T]
with Phantom {
val quoteChar = '"'
}
case class FmtOf[T](body: BodyOf[Segment._Fmt[T]]) extends TextOf[T] {
val quoteChar = '\''
}
case class UnclosedOf[T](text: TextOf[T]) extends AST.InvalidOf[T]
// The body of the text. For a given quote type `t`, `q` can be either
// single or triple. Triple allows for using that quote type within the
// body. `q` is the number of the quote type `t`.
// - Body contains expression segments for the interpolation.
object Body {
def apply[S <: Segment[AST]](q: Quote, s: S*) =
BodyOf(q, List1(LineOf(0, s.to[List])))
with AST.InvalidOf[T] {
def quote = line.quote
}
// These are non-interpolated strings, using `"` as the quote type.
object Raw {
def apply(body: BodyOf[Segment._Raw[AST]]): Raw = RawOf(body)
def unapply(t: AST): Option[BodyOf[Segment._Raw[AST]]] =
Unapply[Raw].run(t => t.body)(t)
}
final case class InvalidQuoteOf[T](quote: Builder)
extends AST.InvalidOf[T]
with Phantom
// These are interpolated strings, using `'` as the quote type.
object Fmt {
def apply(body: BodyOf[Segment._Fmt[AST]]): Fmt = FmtOf(body)
def unapply(t: AST): Option[BodyOf[Segment._Fmt[AST]]] =
Unapply[Fmt].run(t => t.body)(t)
}
final case class InlineBlockOf[T](quote: Builder)
extends AST.InvalidOf[T]
with Phantom
// An unclosed text literal (of either kind).
object Unclosed {
def apply(text: TextOf[AST]): Unclosed = UnclosedOf(text)
def unapply(t: AST): Option[TextOf[AST]] =
Unapply[Unclosed].run(t => t.text)(t)
}
object Line {
final case class Raw[T](text: List[Segment._Raw[T]])
extends Line[T]
with Phantom {
val quote = '"'
}
final case class Fmt[T](text: List[Segment._Fmt[T]]) extends Line[T] {
val quote = '\''
}
//// Instances ////
////// INSTANCES /////
import Segment.implicits._
object RawOf {
implicit def ftor: Functor[RawOf] = semi.functor
implicit def fold: Foldable[RawOf] = semi.foldable
implicit def repr[T: Repr]: Repr[RawOf[T]] =
t => R + t.quoteRepr + t.bodyRepr + t.quoteRepr
implicit def ozip[T]: OffsetZip[RawOf, T] = t => t.coerce
}
object FmtOf {
implicit def ftor: Functor[FmtOf] = semi.functor
implicit def fold: Foldable[FmtOf] = semi.foldable
implicit def repr[T: Repr]: Repr[FmtOf[T]] =
t => R + t.quoteRepr + t.bodyRepr + t.quoteRepr
implicit def ozip[T: Repr]: OffsetZip[FmtOf, T] = t => {
var offset = Index.Start
val lines = for (line <- t.body.lines) yield {
val offLine = line.map {
OffsetZip(_).map { case (o, e) => (offset + o.asSize, e) }
implicit def ftor: Functor[Line] = semi.functor
implicit def fold: Foldable[Line] = semi.foldable
implicit def repr[T: Repr]: Repr[Line[T]] = {
case t: Raw[T] => t.quote + t.text + t.quote
case t: Fmt[T] => t.quote + t.text + t.quote
}
implicit def ozip[T: Repr]: OffsetZip[Line, T] = {
case t: Raw[T] => t.coerce
case t: Fmt[T] =>
var offset = Index(t.quote.span)
val text2 = for (elem <- t.text) yield {
val offElem = elem.map(offset -> _)
offset += Size(elem.span)
offElem
}
offset += Size(line.span)
offLine
}
t.copy(body = t.body.copy(lines = lines))
Line.Fmt(text2)
}
}
object LineOf {
implicit def ftor: Functor[LineOf] = semi.functor
implicit def fold: Foldable[LineOf] = semi.foldable
implicit def repr[T: Repr]: Repr[LineOf[T]] = R + _.elem.map(R + _)
implicit def ozip[T: Repr]: OffsetZip[LineOf, T] = t => {
var offset = Index(t.off)
val elem = for (elem <- t.elem) yield {
val offElem = (offset, elem)
offset += Size(elem.span)
offElem
object Block {
final case class Line[+T](emptyLines: List[Int], text: List[T])
final case class Raw[T](
text: List[Line[Segment._Raw[T]]],
spaces: Int,
offset: Int
) extends Block[T]
with Phantom {
val quote = "\"\"\""
}
case class Fmt[T](
text: List[Line[Segment._Fmt[T]]],
spaces: Int,
offset: Int
) extends Block[T] {
val quote = "'''"
}
///// INSTANCES /////
import Segment.implicits._
implicit def ftor: Functor[Block] = semi.functor
implicit def fold: Foldable[Block] = semi.foldable
implicit def repr[T: Repr]: Repr[Block[T]] = t => {
val q = t.quote
def line(off: Int, l: Line[Segment._Fmt[T]]): Builder =
R + l.emptyLines.map(newline + _) + newline + off + l.text
t match {
case Raw(text, s, off) => q + s + text.map(line(off, _))
case Fmt(text, s, off) => q + s + text.map(line(off, _))
}
t.copy(elem = elem)
}
implicit def ozip[T: Repr]: OffsetZip[Block, T] = {
case body: Raw[T] => body.coerce
case body: Fmt[T] =>
var offset = Index(body.quote.span)
val text =
for (line <- body.text) yield {
offset += Size(line.emptyLines.length + line.emptyLines.sum)
offset += Size(1 + body.offset)
val text = for (elem <- line.text) yield {
val offElem = elem.map(offset -> _)
offset += Size(elem.span)
offElem
}
line.copy(text = text)
}
body.copy(text = text)
}
}
////// CONSTRUCTORS ///////
type Unclosed = ASTOf[UnclosedOf]
object Unclosed {
val any = UnapplyByType[Unclosed]
def unapply(t: AST) =
Unapply[Unclosed].run(t => t.line)(t)
def apply(segment: Segment.Fmt*): Unclosed =
UnclosedOf(Line.Fmt(segment.to[List]))
object Raw {
def apply(segment: Segment.Raw*): Unclosed =
Text.UnclosedOf(Line.Raw(segment.to[List]))
}
}
type InvalidQuote = ASTOf[InvalidQuoteOf]
object InvalidQuote {
val any = UnapplyByType[InvalidQuote]
def unapply(t: AST) =
Unapply[InvalidQuote].run(t => t.quote)(t)
def apply(quote: String): InvalidQuote = InvalidQuoteOf[AST](quote)
}
type InlineBlock = ASTOf[InlineBlockOf]
object InlineBlock {
val any = UnapplyByType[InlineBlock]
def unapply(t: AST) =
Unapply[InlineBlock].run(t => t.quote)(t)
def apply(quote: String): InlineBlock = InlineBlockOf[AST](quote)
}
def apply(text: TextOf[AST]): Text = text
def apply(segment: Segment.Fmt*): Text = Text(Line.Fmt(segment.to[List]))
def apply(spaces: Int, off: Int, line: Block.Line[Segment.Fmt]*): Text =
Text(Block.Fmt(line.to[List], spaces, off))
object Raw {
def apply(segment: Segment.Raw*): Text = Text(Line.Raw(segment.to[List]))
def apply(spaces: Int, off: Int, line: Block.Line[Segment.Raw]*): Text =
Text(Block.Raw(line.to[List], spaces, off))
}
/////// INSTANCES //////////
object UnclosedOf {
import Segment.implicits._
implicit def ftor: Functor[UnclosedOf] = semi.functor
implicit def fold: Foldable[UnclosedOf] = semi.foldable
implicit def repr[T: Repr]: Repr[UnclosedOf[T]] =
t => R + t.text.quoteRepr + t.text.bodyRepr
implicit def repr[T: Repr]: Repr[UnclosedOf[T]] = {
case UnclosedOf(t: Line.Raw[T]) => t.quote + t.text
case UnclosedOf(t: Line.Fmt[T]) => t.quote + t.text
}
implicit def ozip[T: Repr]: OffsetZip[UnclosedOf, T] =
t => t.copy(text = OffsetZip(t.text))
t => t.copy(line = OffsetZip(t.line))
}
///////////////
//// Quote ////
///////////////
sealed trait Quote { val asInt: Int }
object Quote {
final case object Single extends Quote { val asInt = 1 }
final case object Triple extends Quote { val asInt = 3 }
object InvalidQuoteOf {
implicit def ftor: Functor[InvalidQuoteOf] = semi.functor
implicit def fold: Foldable[InvalidQuoteOf] = semi.foldable
implicit def repr[T: Repr]: Repr[InvalidQuoteOf[T]] = _.quote
implicit def ozip[T: Repr]: OffsetZip[InvalidQuoteOf, T] = t => t.coerce
}
object InlineBlockOf {
implicit def ftor: Functor[InlineBlockOf] = semi.functor
implicit def fold: Foldable[InlineBlockOf] = semi.foldable
implicit def repr[T: Repr]: Repr[InlineBlockOf[T]] = _.quote
implicit def ozip[T: Repr]: OffsetZip[InlineBlockOf, T] = t => t.coerce
}
/////////////////
@ -1071,11 +1130,16 @@ object AST {
): Block = BlockOf(typ, indent, emptyLines, firstLine, lines)
def apply(
typ: Type,
indent: Int,
firstLine: LineOf[AST],
lines: List[LineOf[Option[AST]]]
): Block = Block(typ, indent, List(), firstLine, lines)
firstLine: AST,
lines: AST*
): Block = Block(
Continuous,
indent,
List(),
Line(firstLine),
lines.to[List].map(ast => Line(Some(ast)))
)
val any = UnapplyByType[Block]
def unapply(t: AST) =
@ -1183,7 +1247,7 @@ object AST {
segs: Shifted.List1[Match.SegmentOf[T]],
resolved: AST
) extends MacroOf[T] {
def path(): List1[AST] = segs.toList1().map(_.el.head)
def path: List1[AST] = segs.toList1().map(_.el.head)
}
object MatchOf {
@ -1674,4 +1738,4 @@ object AST {
val v1_x = vx.as[Var]
println(v1_x)
}
}
}

View File

@ -36,9 +36,9 @@ case class ParserDef() extends flexer.Parser[AST.Module] {
val digit: Pattern = range('0', '9')
val hex: Pattern = digit | range('a', 'f') | range('A', 'F')
val alphaNum: Pattern = digit | lowerLetter | upperLetter
val whitespace0: Pattern = ' '.many
val space: Pattern = ' '.many1
val newline: Pattern = '\n'
val emptyLine: Pattern = ' '.many >> newline
////////////////
//// Result ////
@ -286,90 +286,117 @@ case class ParserDef() extends flexer.Parser[AST.Module] {
//// Text ////
//////////////
import AST.Text.Quote
class TextState(
var lines: List[AST.Text.LineOf[AST.Text.Segment._Fmt[AST]]],
var lineBuilder: List[AST.Text.Segment.Fmt],
val quote: Quote
var offset: Int,
var spaces: Int,
var lines: List[AST.Text.Block.Line[AST.Text.Segment.Fmt]],
var emptyLines: List[Int],
var lineBuilder: List[AST.Text.Segment.Fmt]
)
final object text {
import AST.Text.Block.Line
val Segment = AST.Text.Segment
var stack: List[TextState] = Nil
var current = new TextState(Nil, Nil, Quote.Single)
var text: TextState = _
def push(): Unit = logger.trace {
stack +:= current
stack +:= text
}
def pop(): Unit = logger.trace {
current = stack.head
stack = stack.tail
text = stack.head
stack = stack.tail
}
def submitEmpty(groupIx: State, quoteNum: Quote): Unit = logger.trace {
if (groupIx == RAW)
result.app(AST.Text.Raw(AST.Text.Body(quoteNum)))
else
result.app(AST.Text.Fmt(AST.Text.Body(quoteNum)))
def onInvalidQuote(): Unit = logger.trace {
result.app(AST.Text.InvalidQuote(currentMatch))
}
def finishCurrent(): AST.Text = logger.trace {
onSubmitLine()
val t = current
val body = AST.Text.BodyOf(t.quote, List1(t.lines.reverse).get)
val isRaw = state.current == RAW
def onInlineBlock(): Unit = logger.trace {
result.app(AST.Text.InlineBlock(currentMatch))
}
def finish(
raw: List[Line[Segment.Raw]] => AST,
fmt: List[Line[Segment.Fmt]] => AST
): Unit = logger.trace {
submitLine()
val isFMT = state.current.parent.contains(FMT)
val body = text.lines.reverse
val t =
if (isFMT) fmt(body)
else raw(body.asInstanceOf[List[Line[Segment.Raw]]])
pop()
off.pop()
state.end()
if (isRaw)
AST.Text.Raw(body.asInstanceOf[AST.Text.BodyOf[Segment._Raw[AST]]])
else
AST.Text.Fmt(body)
}
def submit(): Unit = logger.trace {
result.app(finishCurrent())
result.app(t)
}
def submit(segment: Segment.Fmt): Unit = logger.trace {
current.lineBuilder +:= segment
text.lineBuilder +:= segment
}
def submit(): Unit = logger.trace {
finish(t => AST.Text.Raw(t.head.text: _*), t => AST.Text(t.head.text: _*))
}
def submitUnclosed(): Unit = logger.trace {
result.app(AST.Text.UnclosedOf(finishCurrent()))
rewind()
val Text = AST.Text.Unclosed
finish(t => Text.Raw(t.head.text: _*), t => Text(t.head.text: _*))
}
def onBegin(grp: State, quoteSize: Quote): Unit = logger.trace {
def submitDoubleQuote(): Unit = logger.trace {
val Text = AST.Text.Unclosed
finish(t => Text.Raw(t.head.text: _*), t => Text(t.head.text: _*))
onInvalidQuote()
}
def onEndOfBlock(): Unit = logger.trace {
if (text.lineBuilder.isEmpty)
block.emptyLines = text.emptyLines ++ block.emptyLines
val (s, o) = (text.spaces, text.offset)
finish(t => AST.Text.Raw(s, o, t: _*), t => AST.Text(s, o, t: _*))
off.push()
rewind()
}
def onBegin(grp: State): Unit = logger.trace {
push()
off.push()
off.push()
current = new TextState(Nil, Nil, quoteSize)
state.begin(grp)
text = new TextState(0, 0, Nil, Nil, Nil)
}
def submitPlainSegment(): Unit = logger.trace {
current.lineBuilder = current.lineBuilder match {
case Segment._Plain(t) :: _ =>
Segment.Plain(t + currentMatch) :: current.lineBuilder.tail
case _ => Segment.Plain(currentMatch) :: current.lineBuilder
def onBeginBlock(grp: State): Unit = logger.trace {
val offset = if (state.current == block.FIRSTCHAR) {
state.end()
block.current.offset
} else
OFFSET_OF_FIRST_LINE_FOUND
if (currentMatch.last == '\n') {
onBegin(grp)
text.offset = offset
text.spaces = currentMatch.length - BLOCK_QUOTE_SIZE - 1
state.begin(NEWLINE)
} else {
val spaces = currentMatch.length - BLOCK_QUOTE_SIZE
result.app(
if (grp == FMT_BLCK) AST.Text(spaces = spaces, offset)
else AST.Text.Raw(spaces = spaces, offset)
)
onEOF()
}
}
def onQuote(quoteSize: Quote): Unit = logger.trace {
if (current.quote == Quote.Triple
&& quoteSize == Quote.Single)
submitPlainSegment()
else if (current.quote == Quote.Single
&& quoteSize == Quote.Triple) {
val groupIx = state.current
submit()
submitEmpty(groupIx, Quote.Single)
} else
submit()
def submitPlainSegment(): Unit = logger.trace {
text.lineBuilder = text.lineBuilder match {
case Segment._Plain(t) :: _ =>
Segment.Plain(t + currentMatch) :: text.lineBuilder.tail
case _ => Segment.Plain(currentMatch) :: text.lineBuilder
}
}
def onEscape(code: Segment.Escape): Unit = logger.trace {
@ -426,58 +453,109 @@ case class ParserDef() extends flexer.Parser[AST.Module] {
}
}
def onEOF(): Unit = logger.trace {
def onTextEOF(): Unit = logger.trace {
submitUnclosed()
rewind()
}
def onSubmitLine(): Unit = logger.trace {
off.pop()
current.lines +:= AST.Text.LineOf(off.use(), current.lineBuilder.reverse)
current.lineBuilder = Nil
def submitLine(): Unit = logger.trace {
if (state.current == FMT_LINE || state.current == RAW_LINE || text.lineBuilder.nonEmpty) {
text.lines +:= Line(text.emptyLines.reverse, text.lineBuilder.reverse)
text.lineBuilder = Nil
text.emptyLines = Nil
}
}
def onEndOfLine(): Unit = logger.trace {
state.begin(NEWLINE)
submitLine()
}
def onNewLine(): Unit = logger.trace {
state.end()
onSubmitLine()
off.on()
off.push()
if (text.offset == OFFSET_OF_FIRST_LINE_FOUND)
text.offset = currentMatch.length
val leadingSpaces = currentMatch.length - text.offset
if (leadingSpaces < 0) {
onEndOfBlock()
state.begin(block.NEWLINE)
} else if (leadingSpaces != 0)
text.lineBuilder +:= Segment.Plain(" " * leadingSpaces)
}
def onEmptyLine(): Unit = logger.trace {
text.emptyLines :+= currentMatch.length - 1
}
def onEOFNewLine(): Unit = logger.trace {
state.end()
onEndOfBlock()
state.begin(block.NEWLINE)
}
val BLOCK_QUOTE_SIZE = 3
val OFFSET_OF_FIRST_LINE_FOUND = -1
val fmtBlock = "'''" >> space.opt >> (eof | newline)
val rawBlock = "\"\"\"" >> space.opt >> (eof | newline)
val fmtChar = noneOf("'`\\\n")
val escape_int = "\\" >> num.decimal
val escape_u16 = "\\u" >> repeat(fmtChar, 0, 4)
val escape_u32 = "\\U" >> repeat(fmtChar, 0, 8)
val fmtSeg = fmtChar.many1
val rawSeg = noneOf("\"\n").many1
val fmtBSeg = noneOf("\n\\`").many1
val rawBSeg = noneOf("\n").many1
val FMT: State = state.define("Formatted Text")
val RAW: State = state.define("Raw Text")
val FMT_LINE: State = state.define("Formatted Line Of Text")
val RAW_LINE: State = state.define("Raw Line Of Text")
val FMT_BLCK: State = state.define("Formatted Block Of Text")
val RAW_BLCK: State = state.define("Raw Block Of Text")
val NEWLINE: State = state.define("Text Newline")
val INTERPOLATE: State = state.define("Interpolate")
INTERPOLATE.parent = ROOT
FMT_LINE.parent = FMT
FMT_BLCK.parent = FMT
}
ROOT || '`' || text.onInterpolateEnd()
text.FMT || '`' || text.onInterpolateBegin()
ROOT || "'" || text.onBegin(text.FMT, Quote.Single)
ROOT || "'''" || text.onBegin(text.FMT, Quote.Triple)
text.FMT || "'" || text.onQuote(Quote.Single)
text.FMT || "'''" || text.onQuote(Quote.Triple)
text.FMT || text.fmtSeg || text.submitPlainSegment()
text.FMT || eof || text.onEOF()
text.FMT || '\n' || state.begin(text.NEWLINE)
ROOT || '`' || text.onInterpolateEnd()
text.FMT || '`' || text.onInterpolateBegin()
ROOT || "\"" || text.onBegin(text.RAW, Quote.Single)
ROOT || "\"\"\"" || text.onBegin(text.RAW, Quote.Triple)
text.RAW || "\"" || text.onQuote(Quote.Single)
text.RAW || "$$$$$" || {}
text.RAW || "\"\"\"" || text.onQuote(Quote.Triple)
text.RAW || text.rawSeg || text.submitPlainSegment()
text.RAW || eof || text.onEOF()
text.RAW || '\n' || state.begin(text.NEWLINE)
ROOT || "'''" >> "'".many1 || text.onInvalidQuote()
ROOT || "\"\"\"" >> "\"".many1 || text.onInvalidQuote()
text.NEWLINE || space.opt || text.onNewLine()
ROOT || "'" || text.onBegin(text.FMT_LINE)
text.FMT_LINE || "'" || text.submit()
text.FMT_LINE || "''" || text.submitDoubleQuote()
text.FMT_LINE || "'".many1 || text.submitUnclosed()
text.FMT_LINE || text.fmtSeg || text.submitPlainSegment()
text.FMT_LINE || eof || text.onTextEOF()
text.FMT_LINE || newline || text.submitUnclosed()
block.FIRSTCHAR || text.fmtBlock || text.onBeginBlock(text.FMT_BLCK)
ROOT || text.fmtBlock || text.onBeginBlock(text.FMT_BLCK)
ROOT || "'''" || text.onInlineBlock()
text.FMT_BLCK || text.fmtBSeg || text.submitPlainSegment()
text.FMT_BLCK || eof || text.onEndOfBlock()
text.FMT_BLCK || newline || text.onEndOfLine()
ROOT || '"' || text.onBegin(text.RAW_LINE)
text.RAW_LINE || '"' || text.submit()
text.RAW_LINE || "\"\"" || text.submitDoubleQuote()
text.RAW_LINE || '"'.many1 || text.submitUnclosed()
text.RAW_LINE || text.rawSeg || text.submitPlainSegment()
text.RAW_LINE || eof || text.onTextEOF()
text.RAW_LINE || newline || text.submitUnclosed()
block.FIRSTCHAR || text.rawBlock || text.onBeginBlock(text.RAW_BLCK)
ROOT || text.rawBlock || text.onBeginBlock(text.RAW_BLCK)
ROOT || "\"\"\"" || text.onInlineBlock()
text.RAW_BLCK || text.rawBSeg || text.submitPlainSegment()
text.RAW_BLCK || eof || text.onEndOfBlock()
text.RAW_BLCK || newline || text.onEndOfLine()
text.NEWLINE || space.opt || text.onNewLine()
text.NEWLINE || space.opt >> newline || text.onEmptyLine()
text.NEWLINE || space.opt >> eof || text.onEOFNewLine()
AST.Text.Segment.Escape.Character.codes.foreach { code =>
val char = s"text.Segment.Escape.Character.$code"
@ -506,7 +584,7 @@ case class ParserDef() extends flexer.Parser[AST.Module] {
class BlockState(
val isOrphan: Boolean,
var isValid: Boolean,
var indent: Int,
var offset: Int,
var emptyLines: List[Int],
var firstLine: Option[AST.Block.Line.NonEmpty],
var lines: List[AST.Block.OptLine]
@ -536,7 +614,7 @@ case class ParserDef() extends flexer.Parser[AST.Module] {
AST.Block(
current.isOrphan,
AST.Block.Continuous,
current.indent,
current.offset,
current.emptyLines,
unwrap(current.firstLine),
current.lines.reverse
@ -548,15 +626,9 @@ case class ParserDef() extends flexer.Parser[AST.Module] {
result.pop()
off.pop()
pop()
val block2 = result.last() match {
case None => block
case Some(ast) =>
ast match {
case AST.Opr.any(_) =>
block.replaceType(AST.Block.Discontinuous): AST.Block
case _ => block
}
val block2: AST.Block = result.last() match {
case Some(AST.Opr.any(_)) => block.replaceType(AST.Block.Discontinuous)
case _ => block
}
result.app(block2)
off.push()
@ -630,9 +702,9 @@ case class ParserDef() extends flexer.Parser[AST.Module] {
def onNewLine(): Unit = logger.trace {
state.end()
off.on()
if (off.current == current.indent)
if (off.current == current.offset)
submitLine()
else if (off.current > current.indent)
else if (off.current > current.offset)
onBegin(off.use())
else
onEnd(off.use())
@ -640,8 +712,8 @@ case class ParserDef() extends flexer.Parser[AST.Module] {
}
def onEnd(newIndent: Int): Unit = logger.trace {
while (newIndent < current.indent) submit()
if (newIndent > current.indent) {
while (newIndent < current.offset) submit()
if (newIndent > current.offset) {
logger.log("Block with invalid indentation")
onBegin(newIndent)
current.isValid = false
@ -656,13 +728,13 @@ case class ParserDef() extends flexer.Parser[AST.Module] {
val FIRSTCHAR = state.define("First Char")
}
ROOT || newline || block.onEndLine()
block.NEWLINE || space.opt >> newline || block.onEmptyLine()
block.NEWLINE || space.opt >> eof || block.onEOFLine()
block.NEWLINE || space.opt || block.onNewLine()
block.MODULE || space.opt >> newline || block.onEmptyLine()
block.MODULE || space.opt || block.onModuleBegin()
block.FIRSTCHAR || always || state.end()
ROOT || newline || block.onEndLine()
block.NEWLINE || emptyLine || block.onEmptyLine()
block.NEWLINE || space.opt >> eof || block.onEOFLine()
block.NEWLINE || space.opt || block.onNewLine()
block.MODULE || emptyLine || block.onEmptyLine()
block.MODULE || space.opt || block.onModuleBegin()
block.FIRSTCHAR || always || state.end()
////////////////
/// Defaults ///
@ -687,4 +759,4 @@ case class ParserDef() extends flexer.Parser[AST.Module] {
object ParserDef2 {
type Result[T] = flexer.Parser.Result[T]
}
}

View File

@ -172,89 +172,78 @@ class ParserTest extends FlatSpec with Matchers {
import Text.Segment.implicits.txtFromString
val q1 = Text.Quote.Single
val q3 = Text.Quote.Triple
def line(s: String, empty: Int*) =
Text.Block.Line(empty.to[List], List(txtFromString[AST](s)))
def line(segment: AST.Text.Segment.Fmt, empty: Int*) =
Text.Block.Line(empty.to[List], List(segment))
"'" ?= Text.Unclosed(Text(Text.Body(q1)))
"''" ?= Text(Text.Body(q1))
"'''" ?= Text.Unclosed(Text(Text.Body(q3)))
"''''" ?= Text.Unclosed(Text(Text.Body(q3, "'")))
"'''''" ?= Text.Unclosed(Text(Text.Body(q3, "''")))
"''''''" ?= Text(Text.Body(q3))
"'''''''" ?= Text(Text.Body(q3)) $ Text.Unclosed(Text(Text.Body(q1)))
"'a'" ?= Text(Text.Body(q1, "a"))
"'a" ?= Text.Unclosed(Text(Text.Body(q1, "a")))
"'\"'" ?= Text(Text.Body(q1, "\""))
"'a'''" ?= Text(Text.Body(q1, "a")) $ Text(Text.Body(q1))
"'''a'''" ?= Text(Text.Body(q3, "a"))
"'''a'" ?= Text.Unclosed(Text(Text.Body(q3, "a'")))
"'''a''" ?= Text.Unclosed(Text(Text.Body(q3, "a''")))
"'" ?= Text.Unclosed()
"''" ?= Text()
"'''" ?= Text(0, 0)
"'''a" ?= Text.InlineBlock("'''") $ "a"
"''a" ?= Text() $ "a"
"'a'" ?= Text("a")
"'a" ?= Text.Unclosed("a")
"'a''" ?= Text.Unclosed("a") $ Text.InvalidQuote("''")
"'\"'" ?= Text("\"")
"\"" ?= Text.Unclosed(Text.Raw(Text.Body(q1)))
"\"\"" ?= Text.Raw(Text.Body(q1))
"\"\"\"" ?= Text.Unclosed(Text.Raw(Text.Body(q3)))
"\"\"\"\"" ?= Text.Unclosed(Text.Raw(Text.Body(q3, "\"")))
"\"\"\"\"\"" ?= Text.Unclosed(Text.Raw(Text.Body(q3, "\"\"")))
"\"\"\"\"\"\"" ?= Text.Raw(Text.Body(q3))
"\"a\"" ?= Text.Raw(Text.Body(q1, "a"))
"\"a" ?= Text.Unclosed(Text.Raw(Text.Body(q1, "a")))
"\"a\"\"\"" ?= Text.Raw(Text.Body(q1, "a")) $ Text.Raw(Text.Body(q1))
"\"\"\"a\"\"\"" ?= Text.Raw(Text.Body(q3, "a"))
"\"\"\"a\"" ?= Text.Unclosed(Text.Raw(Text.Body(q3, "a\"")))
"\"\"\"a\"\"" ?= Text.Unclosed(Text.Raw(Text.Body(q3, "a\"\"")))
"\"\"\"\"\"\"\"" ?= Text.Raw(Text.Body(q3)) $ Text.Unclosed(
Text.Raw(Text.Body(q1))
)
"''' \n\n X\n\n Y" ?= Text(1, 0, line(" X", 0), line(" Y", 0))
"a '''\n\n\n X\n\n Y" ?= "a" $_ Text(0, 1, line("X", 0, 0), line("Y", 0))
"'''\nX\n Y\n'''" ?= Text(
Text.BodyOf(
q3,
List1(
Text.LineOf(0, Nil),
Text.LineOf(0, List("X")),
Text.LineOf(1, List("Y")),
Text.LineOf(0, Nil)
)
)
)
"\"" ?= Text.Unclosed.Raw()
"\"\"" ?= Text.Raw()
"\"\"\"" ?= Text.Raw(0, 0)
"\"\"\"a" ?= Text.InlineBlock("\"\"\"") $ "a"
"\"\"a" ?= Text.Raw() $ "a"
"\"a\"" ?= Text.Raw("a")
"\"a" ?= Text.Unclosed.Raw("a")
"\"a\"\"" ?= Text.Unclosed.Raw("a") $ Text.InvalidQuote("\"\"")
"\"'\"" ?= Text.Raw("'")
"\"\"\" \n\n X\n\n Y" ?= Text.Raw(1, 0, line(" X", 0), line(" Y", 0))
"a \"\"\"\n\n\n X\n\n Y" ?= "a" $_ Text.Raw(0, 1, line("X", 0, 0), line("Y", 0))
//// Escapes ////
val Esc = Text.Segment.Escape
def escape(esc: Text.Segment.Escape): Text.Segment.Fmt =
Text.Segment._Escape(esc)
Text.Segment.Escape.Character.codes.foreach(
i => s"'\\$i'" ?= Text(Text.Body(q1, Text.Segment._Escape(i)))
i => s"'\\$i'" ?= Text(escape(i))
)
Text.Segment.Escape.Control.codes.foreach(
i => s"'\\$i'" ?= Text(Text.Body(q1, Text.Segment._Escape(i)))
i => s"'\\$i'" ?= Text(escape(i))
)
"'\\\\'" ?= Text(
Text.Body(q1, Text.Segment._Escape(Text.Segment.Escape.Slash))
)
"'\\''" ?= Text(
Text.Body(q1, Text.Segment._Escape(Text.Segment.Escape.Quote))
)
"'\\\"'" ?= Text(
Text.Body(q1, Text.Segment._Escape(Text.Segment.Escape.RawQuote))
)
"'\\" ?= Text.Unclosed(Text(Text.Body(q1, "\\")))
"'\\c'" ?= Text(
Text.Body(q1, Text.Segment._Escape(Text.Segment.Escape.Invalid("c")))
)
"'\\cd'" ?= Text(
Text.Body(q1, Text.Segment._Escape(Text.Segment.Escape.Invalid("c")), "d")
)
"'\\123d'" ?= Text(
Text.Body(q1, Text.Segment._Escape(Text.Segment.Escape.Number(123)), "d")
)
"'\\\\'" ?= Text(escape(Esc.Slash))
"'\\''" ?= Text(escape(Esc.Quote))
"'\\\"'" ?= Text(escape(Esc.RawQuote))
"'\\" ?= Text.Unclosed("\\")
"'\\c'" ?= Text(escape(Esc.Invalid("c")))
"'\\cd'" ?= Text(escape(Esc.Invalid("c")), "d")
"'\\123d'" ?= Text(escape(Esc.Number(123)), "d")
//// Interpolation ////
"'a`b`c'" ?= Text(Text.Body(q1, "a", Text.Segment._Expr(Some("b")), "c"))
def expr(ast: AST) = Text.Segment._Expr(Some(ast))
"'a`b`c'" ?= Text("a", expr("b"), "c")
"'a`b 'c`d`e' f`g'" ?= {
val bd = "b" $_ Text(Text.Body(q1, "c", Text.Segment._Expr(Some("d")), "e")) $_ "f"
Text(Text.Body(q1, "a", Text.Segment._Expr(Some(bd)), "g"))
val bd = "b" $_ Text("c", expr("d"), "e") $_ "f"
Text("a", expr(bd), "g")
}
"say \n '''\n Hello\n `World`\npal" ??= Module(
OptLine("say" $_ Block(2, Text(0, 2, line("Hello"), line(expr("World"))))),
OptLine("pal")
)
"say '''\n Hello\n `World`\npal" ??= Module(
OptLine("say" $_ Text(0, 2, line("Hello"), line(expr("World")))),
OptLine("pal")
)
//// // // Comments
////// expr("#" , Comment)
////// expr("#c" , Comment :: CommentBody("c"))
@ -349,14 +338,7 @@ class ParserTest extends FlatSpec with Matchers {
Def(
"Maybe",
List("a"),
Some(
Block(
Block.Continuous,
4,
Block.Line(defJust),
List(Block.Line(Some(defNothing)))
)
)
Some(Block(4, defJust, defNothing))
)
}
//
@ -424,26 +406,21 @@ class ParserTest extends FlatSpec with Matchers {
""".testIdentity
"""
# pop1: adults
# pop2: children
# pop3: mutants
# adults: old population
# children: new individuals from crossover
# mutation: new individuals from mutation
Selects the 'fittest' individuals from population and kills the rest!
log
'''
keepBest
`pop1`
`pop2`
`pop3`
'''
unique xs
= xs.at(0.0) +: [1..length xs -1] . filter (isUnique xs) . map xs.at
isUnique xs i ####
= xs.at(i).score != xs.at(i-1).score
pop1<>pop2<>pop3 . sorted . unique . take (length pop1) . pure
armageddon adults children mutants =
log '''
keepBest
`pop1`
`pop2`
`pop3`
unique xs
= xs.at(0.0) +: [1..length xs -1] . filter (isUnique xs) . map xs.at
isUnique xs i ####
= xs.at(i).score != xs.at(i-1).score
adults++children++mutants . sorted . unique . take (length pop1) . pure
""".testIdentity
///////////////////////
@ -463,4 +440,4 @@ class ParserTest extends FlatSpec with Matchers {
// [ ] warnings in scala code
// [ ] Undefined parsing
// [ ] All block types
// [ ] Unary minus
// [ ] Unary minus

View File

@ -47,8 +47,10 @@ object AstToIr {
case AST.Invalid.Unrecognized(str) => IR.Error.UnrecognisedSymbol(str)
case AST.Ident.InvalidSuffix(identifier, suffix) =>
IR.Error.InvalidSuffix(processIdent(identifier), suffix)
case AST.Literal.Text.Unclosed(text) =>
IR.Error.UnclosedText(text.body.lines.toList.map(processLine))
case AST.Literal.Text.Unclosed(AST.Literal.Text.Line.Raw(text)) =>
IR.Error.UnclosedText(List(processLine(text)))
case AST.Literal.Text.Unclosed(AST.Literal.Text.Line.Fmt(text)) =>
IR.Error.UnclosedText(List(processLine(text)))
case _ =>
throw new RuntimeException(
"Fatal: Unhandled entity in processInvalid = " + invalid
@ -102,12 +104,14 @@ object AstToIr {
def processLiteral(literal: AST.Literal): IR.Literal = {
literal match {
case AST.Literal.Number(base, number) => IR.Literal.Number(number, base)
case AST.Literal.Text.Raw(body) => {
IR.Literal.Text.Raw(body.lines.toList.map(processLine))
}
case AST.Literal.Text.Fmt(body) => {
IR.Literal.Text.Format(body.lines.toList.map(processLine))
}
// TODO [AA] Handle text properly
// case AST.Literal.Text.Raw(body) =>
// IR.Literal.Text.Raw(body.lines.toList.map(processLine))
//
// case AST.Literal.Text.Line.Fmt(lines) =>
// IR.Literal.Text.Format(lines.toList.map(processLine))
case _ => throw new UnhandledEntity(literal, "processLiteral")
}
}
@ -119,9 +123,9 @@ object AstToIr {
* @return a representation of `line` in the compiler's [[IR IR]]
*/
def processLine(
line: AST.Literal.Text.LineOf[AST.Literal.Text.Segment[AST]]
line: List[AST.Literal.Text.Segment[AST]]
): IR.Literal.Text.Line =
IR.Literal.Text.Line(line.elem.map(processTextSegment))
IR.Literal.Text.Line(line.map(processTextSegment))
/**
* Transforms a segment of text from the parser AST.
@ -257,4 +261,4 @@ object AstToIr {
}
case _ => throw new UnhandledEntity(binding, "processBinding")
}
}
}