Class new title: Parser
	subclassof: Object
	fields: 'source dest oppositeCourt type token mark keep'
	declare: '';
	sharing: TokenCodes

advance | t1 
	[mark _ source position - [type > aBinary  [1]
			0].
	NoteTaker 
		[t1 _ oppositeCourt.
		oppositeCourt _ thisContext.
		t1 eval]
	oppositeCourt _ thisContext swapSender: oppositeCourt]

alternatives: t1 | t2 t3 
	[self advance.
	type  aLeftBrack  [self notify: 'EXPECTED A [BLOCK]']
	t2 _ self block: dest block.
	t3 _ dest block.
	[type = aSemicolon  [self cascade: t3 after: t1]
	self statements: t3].
	dest ifExpr: t1 thenExpr: t2 elseExpr: t3]

begin 
	[mark _ source position.
	type _ 1.
	(Reader new of: source) readInto: self]

binaryMessage: t1 assign: t2 | t3 t4 t5 t6 
	[t3 _ token.
	self advance.
	t4 _ [type = aLeftBrack  [self block: dest block]
			self factor].
	[t2 and type = aLeftArrow 
		[self advance.
		t5 _ Vector new: 2.
		t5  1 _ t4.
		t5  2 _ self expression.
		t4 _ t5 itself.
		t6 _ String new: 2.
		t6  1 _ t3.
		t6  2 _ 95.
		t3 _ t6 itself]].
	dest rcvr: t1 selector: t3 args: t4]

block: t1 
	[self advance.
	self statements: t1.
	type = aRightBrack 
		[self advance.
		t1]
	self notify: 'PERIOD OR RIGHT BRACKET WAS EXPECTED']

body: t1 | t2 
	[type = aLeftBrack 
		[self block: t1.
		[type = aKeyword and token = 'primitive:' 
			[self advance.
			type = aNumber 
				[t2 _ token.
				self advance.
				t2]
			self notify: 'EXPECTED A NUMBER']].
		0]
	0]

cascade: t1 after: t2 | t3 t4 t5 
	[t4 _ dest receivingVar: t2.
	t5 _ dest balance.
	while type = aSemicolon do
		[self advance.
		t3 _ self messageChain: t4.
		t3  t4  [self notify: 'MESSAGE EXPECTED']
		type = aCondArrow 
			[t1 next_ self alternatives: t3.
			dest unbalance: t5.
			self]
		t1 next_ t3].
	dest unbalance: t5]

comment: t1 
	[mark _ source position]

contents 
	[type _ 0.
	mark _ source position + 1.
	[NoteTaker  []
	thisContext sender_ nil].
	while true do
		[self resume.
		self notify: 'MORE EXPECTED']]

declaration: t1 
	[type  aWord  [self notify: 'EXPECTED AN ARGUMENT NAME']
	dest declaration: t1 name: token asArg: true.
	self advance]

expression | t1 
	[type = aLeftBrack  [self block: dest block]
	type = aKeyword  [self macro: dest block]
	type  aWord  [self messageChain: self primary]
	t1 _ dest variable: token.
	self advance.
	type  aLeftArrow  [self messageChain: t1]
	self advance.
	dest assignment: t1 expr: self expression]

factor | t1 
	[t1 _ self primary.
	while type = aWord do
		[t1 _ self unaryMessage: t1 assign: false].
	t1]

float: t1 fraction: t2 exp: t3 
	[token _ (t1 + '.' + t2 + 'e' + t3) asFloat.
	type _ aNumber.
	self resume]

from: t1 to: t2 | t3 
	[source _ t1.
	dest _ t2.
	oppositeCourt _ thisContext.
	NoteTaker 
		[t3 _ Process new: 1000.
		t3 init.
		t3 send: begin to: self.
		t3 eval]
	self begin]

identifier: t1 
	[token _ t1.
	type _ aWord.
	self resume]

integer: t1 
	[token _ t1 asInteger.
	type _ aNumber.
	self resume]

keyword: t1 
	[token _ t1.
	type _ aKeyword.
	self resume]

keywordMessage: t1 macro: t2 | t3 t4 t5 
	[t3 _ Stream default.
	t4 _ (Vector new: 4) asStream.
	while type = aKeyword do
		[t3 append: token.
		self advance.
		t5 _ [type = aLeftBrack  [self block: dest block]
				self term].
		t4 next_ [t3 last = 3  [dest noEvalKeyword: t5]
		dest evalKeyword: t5]].
	[type = aLeftArrow 
		[t3 append: '_'.
		self advance.
		t4 next_ self expression]].
	t3 _ t3 contents.
	t4 _ [t4 position = 1  [t4 last]
			t4 contents].
	t2  [dest macro: t2 selector: t3 args: t4]
	dest keywordMessage: t1 selector: t3 args: t4]

leftparen 
	[type _ aLeftPar.
	self resume]

literal | t1 t2 
	[[type = aLeftPar 
		[t2 _ mark.
		self advance.
		t1 _ self read.
		type = aRightPar 
			[self advance.
			t1]
		mark _ t2.
		self notify: 'UNMATCHED']].
	t1 _ [type  aKeyword  [token unique]
			type 
 aBinary  [UST1  (token + 1)]
			token].
	self advance.
	t1]

loopStmt: t1 | t2 
	[t2 _ mark.
	self keywordMessage: false loop: t1  [self]
	mark _ t2.
	self notify: 'UNKNOWN CONTROL MESSAGE']

macro: t1 | t2 t3 t4 
	[t2 _ mark.
	t3 _ dest juggle.
	t4 _ self keywordMessage: false macro: t1.
	dest unjuggle: t3.
	t4  [t1]
	mark _ t2.
	self notify: 'UNKNOWN CONTROL MESSAGE']

messageChain: t1 
	[while type = aWord do
		[t1 _ self unaryMessage: t1 assign: true].
	while type = aBinary do
		[t1 _ self binaryMessage: t1 assign: true].
	[type = aKeyword  [t1 _ self keywordMessage: t1 macro: false]].
	t1]

mustBeDone 
	[type = 0  [self terminate]
	self notify: 'UNEXPECTED CONSTRUCT']

notify: t1 | t2 
	[source skip: mark - source position.
	t2 _ (9 10 12 13 32 ).
	while (t2 has: source peek) do
		[source next].
	[source myend  false  [source skip: 1]].
	dest abortWith: t1]

onechar: t1 
	[token _ t1.
	type _ [token = 46  [aPeriod]
			token = 91  [aLeftBrack]
			token = 93  [aRightBrack]
			token = 27  [aCondArrow]
			token = 95  [aLeftArrow]
			token = 17  [aReturnArrow]
			token = 59  [aSemicolon]
			token = 15  [aHand]
			aBinary].
	self resume]

otheratom: t1 
	[token _ t1.
	type _ aGibberish.
	self resume]

pattern: t1 | t2 
	[t2 _ Stream default.
	[type = aWord 
		[t2 append: token.
		self advance]
	type = aBinary 
		[t2 append: UST1  (token + 1).
		self advance.
		self declaration: t1]
	while type = aKeyword do
		[t2 append: token.
		self advance.
		self declaration: t1].
	t2 empty  [self notify: 'EXPECTED A SELECTOR']].
	[type = aLeftArrow 
		[t2 append: '_'.
		self advance.
		self declaration: t1]].
	t2 contents unique]

primary | t1 
	[type = aWord 
		[t1 _ dest variable: token.
		self advance.
		t1]
	type = aLeftPar  [self subExpression]
	type = aNumber 
		[t1 _ dest literal: token.
		self advance.
		t1]
	type = aString 
		[t1 _ dest literal: token.
		self advance.
		t1]
	type = aHand 
		[self advance.
		type = aRightPar or type = 0  [self notify: 'EXPECTED LITERAL']
		dest literal: self literal]
	self notify: 'OBJECT EXPECTED']

read | t1 
	[t1 _ (Vector new: 10) asStream.
	until (type = aRightPar or type = 0) do
		[t1 next_ self literal].
	t1 contents]

resume | t1 
	[NoteTaker 
		[t1 _ oppositeCourt.
		oppositeCourt _ thisContext.
		t1 eval]
	oppositeCourt _ thisContext swapSender: oppositeCourt]

rightparen 
	[type _ aRightPar.
	self resume]

separator: t1 
	[]

statement: t1 | t2 
	[type = aReturnArrow 
		[self advance.
		t1 next_ self expression.
		t1 doesReturn.
		[type = aPeriod  [self advance]].
		type  aRightBrack  [self notify: 'SHOULDN''T FOLLOW RETURN']]
	type = aKeyword 
		[self macro: t1.
		type > aPeriod  [self statement: t1]]
	type 
 aPeriod  [dest nullStatement: t1]
	t2 _ self expression.
	type = aCondArrow  [t1 next_ self alternatives: t2]
	t1 next_ t2.
	type = aSemicolon  [self cascade: t1 after: t2]]

statements: t1 
	[self statement: t1.
	while type = aPeriod do
		[self advance.
		self statement: t1]]

string: t1 
	[token _ t1.
	type _ aString.
	self resume]

subExpression | t1 
	[self advance.
	t1 _ self expression.
	type = aRightPar 
		[self advance.
		t1]
	self notify: 'NOT EXPECTED IN A (SUBEXPRESSION)']

temporaries: t1 
	[type = aBinary and token = 124 
		[self advance.
		while type = aWord do
			[dest declaration: t1 name: token asArg: false.
			self advance]]]

term | t1 
	[t1 _ self factor.
	while type = aBinary do
		[t1 _ self binaryMessage: t1 assign: false].
	t1]

terminate 
	[[dest  nil  []
	dest terminate.
	dest _ nil].
	oppositeCourt  nil  []
	[NoteTaker  []
	oppositeCourt release].
	oppositeCourt _ nil]

trailer: t1 
	[mark _ source position]

unaryMessage: t1 assign: t2 | t3 t4 
	[t3 _ token.
	self advance.
	t4 _ (t2 and type = aLeftArrow) and [t3 _ t3 + '_'.
			self advance.
			self expression].
	dest rcvr: t1 selector: t3 args: t4]