ParserCombinators.ns

Newspeak3
'Benchmarks'
class ParserCombinators usingPlatform: p = (
(* This benchmark parses and evaluates a fixed string using a simple arithmetic
expresssion grammar built from parser combinators. It is an example of a
program that is natural to write in an exception-oriented style, or with
non-local returns in a language that has them. The natural translation of
NLRs to a language without them also uses exceptions in this way.

These parser combinators use explicitly initialized forward reference parsers
to handle cycles in the productions, rather than using reflection or
#doesNotUnderstand:, to make the benchmark portable to languages lacking
these features and to avoid measuring their performance. They also do not use
any platform-defined streams to avoid API differences.  Arithmetic operations
are masked to keep all intermediate results within Smi range.

This benchmark is derived from the Newspeak version of CombinatorialParsers,
which is why the Cadence copyrights apply.

Copyright 2008 Cadence Design Systems, Inc.
Copyright 2012 Cadence Design Systems, Inc.
Copyright 2013 Ryan Macnak and Google Inc.

Licensed under the Apache License, Version 2.0 (the "License"); you may not
use this file except in compliance with the License. You may obtain a copy of
the License at http://www.apache.org/licenses/LICENSE-2.0 *)
|
private List = p collections List.

seed <Integer> ::= 16rCAFE.
parser <CombinatorialParser> = SimpleExpressionGrammar new start compress.
theExpression <String> = randomExpression: 20.
|theExpression size = 41137 ifFalse:
  [Error signal: 'Generated expression of the wrong size'].
((parser parseWithContext: (ParserContext over: theExpression) ifError: [parseFailed]) = 31615)
  ifFalse: [Error signal: 'Expression evaluated to wrong value']) (
class AlternatingParser either: p or: q = CombinatorialParser (|
p <CombinatorialParser> ::= p.
q <CombinatorialParser> ::= q.
|) (
public compress = (
	compressed ifTrue: [^self].
	compressed: true.
	p:: p compress.
	q:: q compress.
	^self
)
public parseWithContext: ctxt ifError: onError = (
	| pos = ctxt position. |
	^p parseWithContext: ctxt ifError: [ctxt position: pos. ^q parseWithContext: ctxt ifError: onError]
)
) : (
)
class CharacterRangeParser between: c1 and: c2 = CombinatorialParser (|
lowerBound <Character> = (c1 runeAt: 1).
upperBound <Character> = (c2 runeAt: 1).
|) (
public compress = (
	^self
)
public parseWithContext: ctxt ifError: onError = (
	| c |
	ctxt atEnd ifTrue: [onError value].
	c:: ctxt next.
	(lowerBound <= c) & (c <= upperBound) ifTrue: [^c].
	onError value.
)
) : (
)
class CombinatorialParser = (|
compressed <Boolean> ::= false.
|) (
public , p = (
	^SequencingParser subparsers: {self. p}
)
char: c = (
	^CharacterRangeParser between: c and: c.
)
charBetween: c1 and: c2 = (
	^CharacterRangeParser between: c1 and: c2.
)
eoi = (
	^EOIParser new
)
public parseWithContext: ctxt ifError: onError = (
	subclassResponsibility
)
public star = (
	^StarParser repeat: self
)
public wrapper: block = (
	^WrappingParser wrap: self with: block
)
public | q = (
	^AlternatingParser either: self or: q
)
) : (
)
class EOIParser = CombinatorialParser () (
public compress = (
	^self
)
public parseWithContext: ctxt ifError: onError = (
	ctxt atEnd ifTrue: [^nil].
	onError value.
)
) : (
)
class ForwardReferenceParser = CombinatorialParser (|
forwardee <CombinatorialParser>
|) (
public bind: p = (
	forwardee isNil ifFalse: [Error signal: 'Forward reference parser already bound'].
	forwardee:: p.
)
public compress = (
	^forwardee compress
)
public parseWithContext: ctxt ifError: onError = (
	Error signal: 'Forward reference parsers should be compressed away before parsing'
)
) : (
)
class ParserContext over: s = (|
	content <String> = s.
	public position <Integer> ::= 0.
|) (
public atEnd = (
	^position >= content size
)
public next = (
	| rune |
	position: position + 1.
	^content runeAt: position.
)
) : (
)
class SequencingParser subparsers: ps = CombinatorialParser (|
	subparsers <List[CombinatorialParser]> ::= ps.
|) (
public , p = (
	^SequencingParser subparsers: (subparsers copyWith: p)
)
public compress = (
	compressed ifTrue: [^self].
	compressed: true.
	subparsers:: subparsers collect: [:e | e compress].
	^self
)
public parseWithContext: ctxt ifError: onError = (
	^subparsers collect: [:p | p parseWithContext: ctxt ifError: onError]
)
public wrapper: block = (
	^WrappingParser wrap: self with: [:results | block valueWithArguments: results]
)
) : (
)
class SimpleExpressionGrammar = CombinatorialParser (|
public start = ForwardReferenceParser new.
exp = ForwardReferenceParser new.
e1 = ForwardReferenceParser new.
e2 = ForwardReferenceParser new.
parenExp = ForwardReferenceParser new.
number = ForwardReferenceParser new.
plus = ForwardReferenceParser new.
times = ForwardReferenceParser new.
digit = ForwardReferenceParser new.
lparen = ForwardReferenceParser new.
rparen = ForwardReferenceParser new.
|start bind: (exp, eoi wrapper: [:v :dollar | v]).
exp bind: (e1, (plus, e1) star wrapper: [:lhs :rhss |
		| z ::= lhs. | rhss do: [:rhs | z:: z + (rhs at: 2) rem: 16rFFFF]. z]).
e1 bind: (e2, (times, e2) star wrapper: [:lhs :rhss |
		| z ::= lhs. | rhss do: [:rhs | z:: z * (rhs at: 2) rem: 16rFFFF]. z]).
e2 bind: (number | parenExp).

parenExp bind: (lparen, exp, rparen wrapper: [:lhs :e :rhs | e]).
number bind: (digit wrapper: [:d | d - 48]).

plus bind: (char: "+").
times bind: (char: "*").
digit bind: (charBetween: "0" and: "9").
lparen bind: (char: "(").
rparen bind: (char: ")")) (
) : (
)
class StarParser repeat: p = CombinatorialParser (|
subparser <CombinatorialParser> ::= p.
|) (
public compress = (
	compressed ifTrue: [^self].
	compressed: true.
	subparser:: subparser compress.
	^self
)
public parseWithContext: ctxt ifError: onError = (
	| results = List new. |
	[
		| pos |
		pos: ctxt position.
		results add: (subparser parseWithContext: ctxt ifError: [ctxt position: pos. ^results]).
	] repeat.
)
public wrapper: block = (
	^WrappingParser wrap: self with: [:results | block valueWithArguments: results]
)
) : (
)
class WrappingParser wrap: p with: t = CombinatorialParser (|
subparser <CombintorialParser> ::= p.
transform <Block> = t.
|) (
public compress = (
	compressed ifTrue: [^self].
	compressed: true.
	subparser:: subparser compress.
	^self
)
public parseWithContext: ctxt ifError: onError = (
	^transform value: (subparser parseWithContext: ctxt ifError: onError)
)
) : (
)
public bench = (
	parser parseWithContext: (ParserContext over: theExpression) ifError: [parseFailed].
)
nextRandom = (
	seed:: seed * 16rDEAD + 16rC0DE.
	seed:: seed bitAnd: 16rFFF.
	^seed
)
randomExpression: depth = (
	| m |
	depth < 1 ifTrue: [^(nextRandom rem: 10) printString].
	m:: nextRandom rem: 3.
	m = 0 ifTrue: [^(randomExpression: depth - 1), '+', (randomExpression: depth - 1)].
	m = 1 ifTrue: [^(randomExpression: depth - 1), '*', (randomExpression: depth - 1)].
	m = 2 ifTrue: [^'(', (randomExpression: depth - 1), ')'].
	halt.
)
) : (
)