#
#
# Nim's Runtime Library
# (c) Copyright 2015 Andreas Rumpf, Dominik Picheta
#
# See the file "copying.txt", included in this
# distribution, for details about the copyright.
#
import
hashes, strutils, lexbase, streams, unicode, macros
type
SexpEventKind* = enum ## enumeration of all events that may occur when parsing
sexpError, ## an error occurred during parsing
sexpEof, ## end of file reached
sexpString, ## a string literal
sexpSymbol, ## a symbol
sexpInt, ## an integer literal
sexpFloat, ## a float literal
sexpNil, ## the value ``nil``
sexpDot, ## the dot to separate car/cdr
sexpListStart, ## start of a list: the ``(`` token
sexpListEnd, ## end of a list: the ``)`` token
TTokKind = enum # must be synchronized with SexpEventKind!
tkError,
tkEof,
tkString,
tkSymbol,
tkInt,
tkFloat,
tkNil,
tkDot,
tkParensLe,
tkParensRi
tkSpace
SexpError* = enum ## enumeration that lists all errors that can occur
errNone, ## no error
errInvalidToken, ## invalid token
errParensRiExpected, ## ``)`` expected
errQuoteExpected, ## ``"`` expected
errEofExpected, ## EOF expected
SexpParser* = object of BaseLexer ## the parser object.
a: string
tok: TTokKind
kind: SexpEventKind
err: SexpError
const
errorMessages: array[SexpError, string] = [
"no error",
"invalid token",
"')' expected",
"'\"' or \"'\" expected",
"EOF expected",
]
tokToStr: array[TTokKind, string] = [
"invalid token",
"EOF",
"string literal",
"symbol",
"int literal",
"float literal",
"nil",
".",
"(", ")", "space"
]
proc close*(my: var SexpParser) {.inline.} =
## closes the parser `my` and its associated input stream.
lexbase.close(my)
proc str*(my: SexpParser): string {.inline.} =
## returns the character data for the events: ``sexpInt``, ``sexpFloat``,
## ``sexpString``
assert(my.kind in {sexpInt, sexpFloat, sexpString})
result = my.a
proc getInt*(my: SexpParser): BiggestInt {.inline.} =
## returns the number for the event: ``sexpInt``
assert(my.kind == sexpInt)
result = parseBiggestInt(my.a)
proc getFloat*(my: SexpParser): float {.inline.} =
## returns the number for the event: ``sexpFloat``
assert(my.kind == sexpFloat)
result = parseFloat(my.a)
proc kind*(my: SexpParser): SexpEventKind {.inline.} =
## returns the current event type for the SEXP parser
result = my.kind
proc getColumn*(my: SexpParser): int {.inline.} =
## get the current column the parser has arrived at.
result = getColNumber(my, my.bufpos)
proc getLine*(my: SexpParser): int {.inline.} =
## get the current line the parser has arrived at.
result = my.lineNumber
proc errorMsg*(my: SexpParser): string =
## returns a helpful error message for the event ``sexpError``
assert(my.kind == sexpError)
result = "($1, $2) Error: $3" % [$getLine(my), $getColumn(my), errorMessages[my.err]]
proc errorMsgExpected*(my: SexpParser, e: string): string =
## returns an error message "`e` expected" in the same format as the
## other error messages
result = "($1, $2) Error: $3" % [$getLine(my), $getColumn(my), e & " expected"]
proc handleHexChar(c: char, x: var int): bool =
result = true # Success
case c
of '0'..'9': x = (x shl 4) or (ord(c) - ord('0'))
of 'a'..'f': x = (x shl 4) or (ord(c) - ord('a') + 10)
of 'A'..'F': x = (x shl 4) or (ord(c) - ord('A') + 10)
else: result = false # error
proc parseString(my: var SexpParser): TTokKind =
result = tkString
var pos = my.bufpos + 1
var buf = my.buf
while true:
case buf[pos]
of '\0':
my.err = errQuoteExpected
result = tkError
break
of '"':
inc(pos)
break
of '\\':
case buf[pos+1]
of '\\', '"', '\'', '/':
add(my.a, buf[pos+1])
inc(pos, 2)
of 'b':
add(my.a, '\b')
inc(pos, 2)
of 'f':
add(my.a, '\f')
inc(pos, 2)
of 'n':
add(my.a, '\L')
inc(pos, 2)
of 'r':
add(my.a, '\C')
inc(pos, 2)
of 't':
add(my.a, '\t')
inc(pos, 2)
of 'u':
inc(pos, 2)
var r: int
if handleHexChar(buf[pos], r): inc(pos)
if handleHexChar(buf[pos], r): inc(pos)
if handleHexChar(buf[pos], r): inc(pos)
if handleHexChar(buf[pos], r): inc(pos)
add(my.a, toUTF8(Rune(r)))
else:
# don't bother with the error
add(my.a, buf[pos])
inc(pos)
of '\c':
pos = lexbase.handleCR(my, pos)
buf = my.buf
add(my.a, '\c')
of '\L':
pos = lexbase.handleLF(my, pos)
buf = my.buf
add(my.a, '\L')
else:
add(my.a, buf[pos])
inc(pos)
my.bufpos = pos # store back
proc parseNumber(my: var SexpParser) =
var pos = my.bufpos
var buf = my.buf
if buf[pos] == '-':
add(my.a, '-')
inc(pos)
if buf[pos] == '.':
add(my.a, "0.")
inc(pos)
else:
while buf[pos] in Digits:
add(my.a, buf[pos])
inc(pos)
if buf[pos] == '.':
add(my.a, '.')
inc(pos)
# digits after the dot:
while buf[pos] in Digits:
add(my.a, buf[pos])
inc(pos)
if buf[pos] in {'E', 'e'}:
add(my.a, buf[pos])
inc(pos)
if buf[pos] in {'+', '-'}:
add(my.a, buf[pos])
inc(pos)
while buf[pos] in Digits:
add(my.a, buf[pos])
inc(pos)
my.bufpos = pos
proc parseSymbol(my: var SexpParser) =
var pos = my.bufpos
var buf = my.buf
if buf[pos] in IdentStartChars:
while buf[pos] in IdentChars:
add(my.a, buf[pos])
inc(pos)
my.bufpos = pos
proc getTok(my: var SexpParser): TTokKind =
setLen(my.a, 0)
case my.buf[my.bufpos]
of '-', '0'..'9': # numbers that start with a . are not parsed
# correctly.
parseNumber(my)
if {'.', 'e', 'E'} in my.a:
result = tkFloat
else:
result = tkInt
of '"': #" # gotta fix nim-mode
result = parseString(my)
of '(':
inc(my.bufpos)
result = tkParensLe
of ')':
inc(my.bufpos)
result = tkParensRi
of '\0':
result = tkEof
of 'a'..'z', 'A'..'Z', '_':
parseSymbol(my)
if my.a == "nil":
result = tkNil
else:
result = tkSymbol
of ' ':
result = tkSpace
inc(my.bufpos)
of '.':
result = tkDot
inc(my.bufpos)
else:
inc(my.bufpos)
result = tkError
my.tok = result
# ------------- higher level interface ---------------------------------------
type
SexpNodeKind* = enum ## possible SEXP node types
SNil,
SInt,
SFloat,
SString,
SSymbol,
SList,
SCons
SexpNode* = ref SexpNodeObj ## SEXP node
SexpNodeObj* {.acyclic.} = object
case kind*: SexpNodeKind
of SString:
str*: string
of SSymbol:
symbol*: string
of SInt:
num*: BiggestInt
of SFloat:
fnum*: float
of SList:
elems*: seq[SexpNode]
of SCons:
car: SexpNode
cdr: SexpNode
of SNil:
discard
Cons = tuple[car: SexpNode, cdr: SexpNode]
SexpParsingError* = object of ValueError ## is raised for a SEXP error
proc raiseParseErr*(p: SexpParser, msg: string) {.noinline, noreturn.} =
## raises an `ESexpParsingError` exception.
raise newException(SexpParsingError, errorMsgExpected(p, msg))
proc newSString*(s: string): SexpNode {.procvar.}=
## Creates a new `SString SexpNode`.
new(result)
result.kind = SString
result.str = s
proc newSStringMove(s: string): SexpNode =
new(result)
result.kind = SString
shallowCopy(result.str, s)
proc newSInt*(n: BiggestInt): SexpNode {.procvar.} =
## Creates a new `SInt SexpNode`.
new(result)
result.kind = SInt
result.num = n
proc newSFloat*(n: float): SexpNode {.procvar.} =
## Creates a new `SFloat SexpNode`.
new(result)
result.kind = SFloat
result.fnum = n
proc newSNil*(): SexpNode {.procvar.} =
## Creates a new `SNil SexpNode`.
new(result)
proc newSCons*(car, cdr: SexpNode): SexpNode {.procvar.} =
## Creates a new `SCons SexpNode`
new(result)
result.kind = SCons
result.car = car
result.cdr = cdr
proc newSList*(): SexpNode {.procvar.} =
## Creates a new `SList SexpNode`
new(result)
result.kind = SList
result.elems = @[]
proc newSSymbol*(s: string): SexpNode {.procvar.} =
new(result)
result.kind = SSymbol
result.symbol = s
proc newSSymbolMove(s: string): SexpNode =
new(result)
result.kind = SSymbol
shallowCopy(result.symbol, s)
proc getStr*(n: SexpNode, default: string = ""): string =
## Retrieves the string value of a `SString SexpNode`.
##
## Returns ``default`` if ``n`` is not a ``SString``.
if n.kind != SString: return default
else: return n.str
proc getNum*(n: SexpNode, default: BiggestInt = 0): BiggestInt =
## Retrieves the int value of a `SInt SexpNode`.
##
## Returns ``default`` if ``n`` is not a ``SInt``.
if n.kind != SInt: return default
else: return n.num
proc getFNum*(n: SexpNode, default: float = 0.0): float =
## Retrieves the float value of a `SFloat SexpNode`.
##
## Returns ``default`` if ``n`` is not a ``SFloat``.
if n.kind != SFloat: return default
else: return n.fnum
proc getSymbol*(n: SexpNode, default: string = ""): string =
## Retrieves the int value of a `SList SexpNode`.
##
## Returns ``default`` if ``n`` is not a ``SList``.
if n.kind != SSymbol: return default
else: return n.symbol
proc getElems*(n: SexpNode, default: seq[SexpNode] = @[]): seq[SexpNode] =
## Retrieves the int value of a `SList SexpNode`.
##
## Returns ``default`` if ``n`` is not a ``SList``.
if n.kind == SNil: return @[]
elif n.kind != SList: return default
else: return n.elems
proc getCons*(n: SexpNode, defaults: Cons = (newSNil(), newSNil())): Cons =
## Retrieves the cons value of a `SList SexpNode`.
##
## Returns ``default`` if ``n`` is not a ``SList``.
if n.kind == SCons: return (n.car, n.cdr)
elif n.kind == SList: return (n.elems[0], n.elems[1])
else: return defaults
proc sexp*(s: string): SexpNode =
## Generic constructor for SEXP data. Creates a new `SString SexpNode`.
new(result)
result.kind = SString
result.str = s
proc sexp*(n: BiggestInt): SexpNode =
## Generic constructor for SEXP data. Creates a new `SInt SexpNode`.
new(result)
result.kind = SInt
result.num = n
proc sexp*(n: float): SexpNode =
## Generic constructor for SEXP data. Creates a new `SFloat SexpNode`.
new(result)
result.kind = SFloat
result.fnum = n
proc sexp*(b: bool): SexpNode =
## Generic constructor for SEXP data. Creates a new `SSymbol
## SexpNode` with value t or `SNil SexpNode`.
new(result)
if b:
result.kind = SSymbol
result.symbol = "t"
else:
result.kind = SNil
proc sexp*(elements: openArray[SexpNode]): SexpNode =
## Generic constructor for SEXP data. Creates a new `SList SexpNode`
new(result)
result.kind = SList
newSeq(result.elems, elements.len)
for i, p in pairs(elements): result.elems[i] = p
proc sexp*(s: SexpNode): SexpNode =
result = s
proc toSexp(x: NimNode): NimNode {.compiletime.} =
case x.kind
of nnkBracket:
result = newNimNode(nnkBracket)
for i in 0 ..< x.len:
result.add(toSexp(x[i]))
else:
result = x
result = prefix(result, "sexp")
macro convertSexp*(x: untyped): untyped =
## Convert an expression to a SexpNode directly, without having to specify
## `%` for every element.
result = toSexp(x)
proc `==`* (a,b: SexpNode): bool =
## Check two nodes for equality
if a.isNil:
if b.isNil: return true
return false
elif b.isNil or a.kind != b.kind:
return false
else:
return case a.kind
of SString:
a.str == b.str
of SInt:
a.num == b.num
of SFloat:
a.fnum == b.fnum
of SNil:
true
of SList:
a.elems == b.elems
of SSymbol:
a.symbol == b.symbol
of SCons:
a.car == b.car and a.cdr == b.cdr
proc hash* (n:SexpNode): Hash =
## Compute the hash for a SEXP node
case n.kind
of SList:
result = hash(n.elems)
of SInt:
result = hash(n.num)
of SFloat:
result = hash(n.fnum)
of SString:
result = hash(n.str)
of SNil:
result = hash(0)
of SSymbol:
result = hash(n.symbol)
of SCons:
result = hash(n.car) !& hash(n.cdr)
proc len*(n: SexpNode): int =
## If `n` is a `SList`, it returns the number of elements.
## If `n` is a `JObject`, it returns the number of pairs.
## Else it returns 0.
case n.kind
of SList: result = n.elems.len
else: discard
proc `[]`*(node: SexpNode, index: int): SexpNode =
## Gets the node at `index` in a List. Result is undefined if `index`
## is out of bounds
assert(not isNil(node))
assert(node.kind == SList)
return node.elems[index]
proc add*(father, child: SexpNode) =
## Adds `child` to a SList node `father`.
assert father.kind == SList
father.elems.add(child)
# ------------- pretty printing ----------------------------------------------
proc indent(s: var string, i: int) =
s.add(spaces(i))
proc newIndent(curr, indent: int, ml: bool): int =
if ml: return curr + indent
else: return indent
proc nl(s: var string, ml: bool) =
if ml: s.add("\n")
proc escapeJson*(s: string): string =
## Converts a string `s` to its JSON representation.
result = newStringOfCap(s.len + s.len shr 3)
result.add("\"")
for x in runes(s):
var r = int(x)
if r >= 32 and r <= 127:
var c = chr(r)
case c
of '"': result.add("\\\"") #" # gotta fix nim-mode
of '\\': result.add("\\\\")
else: result.add(c)
else:
result.add("\\u")
result.add(toHex(r, 4))
result.add("\"")
proc copy*(p: SexpNode): SexpNode =
## Performs a deep copy of `a`.
case p.kind
of SString:
result = newSString(p.str)
of SInt:
result = newSInt(p.num)
of SFloat:
result = newSFloat(p.fnum)
of SNil:
result = newSNil()
of SSymbol:
result = newSSymbol(p.symbol)
of SList:
result = newSList()
for i in items(p.elems):
result.elems.add(copy(i))
of SCons:
result = newSCons(copy(p.car), copy(p.cdr))
proc toPretty(result: var string, node: SexpNode, indent = 2, ml = true,
lstArr = false, currIndent = 0) =
case node.kind
of SString:
if lstArr: result.indent(currIndent)
result.add(escapeJson(node.str))
of SInt:
if lstArr: result.indent(currIndent)
result.add(node.num)
of SFloat:
if lstArr: result.indent(currIndent)
result.add(node.fnum)
of SNil:
if lstArr: result.indent(currIndent)
result.add("nil")
of SSymbol:
if lstArr: result.indent(currIndent)
result.add(node.symbol)
of SList:
if lstArr: result.indent(currIndent)
if len(node.elems) != 0:
result.add("(")
result.nl(ml)
for i in 0..len(node.elems)-1:
if i > 0:
result.add(" ")
result.nl(ml) # New Line
toPretty(result, node.elems[i], indent, ml,
true, newIndent(currIndent, indent, ml))
result.nl(ml)
result.indent(currIndent)
result.add(")")
else: result.add("nil")
of SCons:
if lstArr: result.indent(currIndent)
result.add("(")
toPretty(result, node.car, indent, ml,
true, newIndent(currIndent, indent, ml))
result.add(" . ")
toPretty(result, node.cdr, indent, ml,
true, newIndent(currIndent, indent, ml))
result.add(")")
proc pretty*(node: SexpNode, indent = 2): string =
## Converts `node` to its Sexp Representation, with indentation and
## on multiple lines.
result = ""
toPretty(result, node, indent)
proc `$`*(node: SexpNode): string =
## Converts `node` to its SEXP Representation on one line.
result = ""
toPretty(result, node, 0, false)
iterator items*(node: SexpNode): SexpNode =
## Iterator for the items of `node`. `node` has to be a SList.
assert node.kind == SList
for i in items(node.elems):
yield i
iterator mitems*(node: var SexpNode): var SexpNode =
## Iterator for the items of `node`. `node` has to be a SList. Items can be
## modified.
assert node.kind == SList
for i in mitems(node.elems):
yield i
proc eat(p: var SexpParser, tok: TTokKind) =
if p.tok == tok: discard getTok(p)
else: raiseParseErr(p, tokToStr[tok])
proc parseSexp(p: var SexpParser): SexpNode =
## Parses SEXP from a SEXP Parser `p`.
case p.tok
of tkString:
# we capture 'p.a' here, so we need to give it a fresh buffer afterwards:
result = newSStringMove(p.a)
p.a = ""
discard getTok(p)
of tkInt:
result = newSInt(parseBiggestInt(p.a))
discard getTok(p)
of tkFloat:
result = newSFloat(parseFloat(p.a))
discard getTok(p)
of tkNil:
result = newSNil()
discard getTok(p)
of tkSymbol:
result = newSSymbolMove(p.a)
p.a = ""
discard getTok(p)
of tkParensLe:
result = newSList()
discard getTok(p)
while p.tok notin {tkParensRi, tkDot}:
result.add(parseSexp(p))
if p.tok != tkSpace: break
discard getTok(p)
if p.tok == tkDot:
eat(p, tkDot)
eat(p, tkSpace)
result.add(parseSexp(p))
result = newSCons(result[0], result[1])
eat(p, tkParensRi)
of tkSpace, tkDot, tkError, tkParensRi, tkEof:
raiseParseErr(p, "(")
proc open*(my: var SexpParser, input: Stream) =
## initializes the parser with an input stream.
lexbase.open(my, input)
my.kind = sexpError
my.a = ""
proc parseSexp*(s: Stream): SexpNode =
## Parses from a buffer `s` into a `SexpNode`.
var p: SexpParser
p.open(s)
discard getTok(p) # read first token
result = p.parseSexp()
p.close()
proc parseSexp*(buffer: string): SexpNode =
## Parses Sexp from `buffer`.
result = parseSexp(newStringStream(buffer))
when isMainModule:
let testSexp = parseSexp("""(1 (98 2) nil (2) foobar "foo" 9.234)""")
assert(testSexp[0].getNum == 1)
assert(testSexp[1][0].getNum == 98)
assert(testSexp[2].getElems == @[])
assert(testSexp[4].getSymbol == "foobar")
assert(testSexp[5].getStr == "foo")
let alist = parseSexp("""((1 . 2) (2 . "foo"))""")
assert(alist[0].getCons.car.getNum == 1)
assert(alist[0].getCons.cdr.getNum == 2)
assert(alist[1].getCons.cdr.getStr == "foo")
# Generator:
var j = convertSexp([true, false, "foobar", [1, 2, "baz"]])
assert($j == """(t nil "foobar" (1 2 "baz"))""")