SystemOrganization addCategory: #'QuasiQuote-Core'!
SystemOrganization addCategory: #'QuasiQuote-Tests'!

!String methodsFor: '*quasiquote' stamp: 'lr 4/16/2008 16:35'!
flattenAndLift
	^ Array with: self lift! !

!RBCascadeNode methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 13:47'!
receiverTemp
	^ self propertyAt: #receiverTemp! !

!RBCascadeNode methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 13:47'!
receiverTemp: aString
	self propertyAt: #receiverTemp put: aString! !

!RBArrayNode methodsFor: '*quasiquote' stamp: 'lr 3/3/2008 15:18'!
addNode: aNode! !

!RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 12/2/2008 13:29'!
adjustBy: anInteger
	"Adjust the current token position by anInteger."

	| firstToken lastToken |
	self nodesDo: [ :each |
		firstToken := each firstToken.
		lastToken := each lastToken.
		(firstToken isNil or: [ lastToken isNil ]) ifFalse: [
			lastToken start isNil
				ifTrue: [ lastToken start: firstToken start ].
			each 
				start: firstToken start + anInteger
				stop: lastToken stop + anInteger ] ]! !

!RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 3/3/2008 15:48'!
isUnquote
	^ false! !

!RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 3/11/2009 15:28'!
lift
	^ self copy
		parent: nil; 
		yourself! !

!RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 3/11/2009 15:28'!
lift: aToken
	^ self copy
		parent: nil;
		adjustBy: aToken;
		yourself! !

!RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 3/3/2008 08:46'!
quoteNode
	"Answer the quoted node in the receivers scope or nil, if none."
	
	^ parent isNil ifFalse: [ parent quoteNode ]! !

!RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 3/11/2009 15:10'!
swapWith: aNode
	"Replace the receiver node with aNode. Try to fix the token positioning automatically."
	
	self swapWith: aNode offset: self firstToken start - aNode firstToken start! !

!RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 6/10/2008 22:03'!
swapWith: aNode offset: anInteger
	"Replace the receiver node with aNode. Reposition tokens by offset anInteger."
	
	self replaceWith: (aNode adjustBy: anInteger)! !

!RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 3/3/2008 08:47'!
unquoteNode
	"Answer the un-quoted node in the receivers scope or nil, if none."
	
	^ parent isNil ifFalse: [ parent unquoteNode ]! !

!CompiledMethod methodsFor: '*quasiquote-override' stamp: 'lr 6/10/2008 21:40'!
methodNode
	| source |
	^ self properties at: #parseTree ifAbsent: [
		(source := self getSourceFromFile) isNil
			ifTrue: [ self decompile ]
			ifFalse: [
				self parserClass new 
					parse: source 
					class: (self methodClass 
						ifNil: [ self sourceClass ]) ] ]! !

TestCase subclass: #QQLiftTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Tests'!

!QQLiftTest methodsFor: 'testing' stamp: 'lr 4/17/2008 15:52'!
testFlatten
	self assert: #abc flattenAndLift = (Array with: #abc lift).
	self assert: #(abc) flattenAndLift = (Array with: #abc lift).
	self assert: #((abc)) flattenAndLift = (Array with: #abc lift)! !

!QQLiftTest methodsFor: 'testing' stamp: 'lr 2/18/2010 16:21'!
testLiterals
	self assert: 'abc' lift class = RBLiteralValueNode.
	self assert: #abc lift class = RBLiteralValueNode.
	self assert: 123 lift class = RBLiteralValueNode.
	self assert: 12.3 lift class = RBLiteralValueNode.
	self assert: true lift class = RBLiteralValueNode.
	self assert: false lift class = RBLiteralValueNode.
	self assert: nil lift class = RBLiteralValueNode.

	self assert: #(1) lift class = QQObjectNode.
	self assert: #[1] lift class = QQObjectNode.
	self assert: Object new lift class = QQObjectNode! !

!QQLiftTest methodsFor: 'testing' stamp: 'lr 4/17/2008 15:50'!
testObjects
	self assert: Object new lift class = QQObjectNode.
	self assert: (1 @ 2) lift class = QQObjectNode.
	self assert: (1 -> 2) lift class = QQObjectNode! !

!QQLiftTest methodsFor: 'testing' stamp: 'lr 4/17/2008 15:50'!
testParseTree
	self assert: RBProgramNode new lift class = RBProgramNode.
	self assert: RBLiteralNode new lift class = RBLiteralNode! !

TestCase subclass: #QQTestCase
	instanceVariableNames: 'useNewCompiler'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Tests'!

QQTestCase subclass: #QQCompilerTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Tests'!

!QQCompilerTest methodsFor: 'accessing' stamp: 'lr 4/16/2008 09:11'!
simpleExpressions
	^ #( 'self' 'super' 'nil' 'true' 'false' 'thisContext' '''foo''' '#foo' '#(1)' '1' '1.0' '1 + 2' '1 + 2 + 3' '1 negated' '1 raisedTo: 2' '1 interpolateTo: 2 at: 3' '1 negated; negated' '1 raisedTo: 1 + 2' '1 raisedTo: (1 negated; negated)' 'x' 'x := y' 'x := y := y' '[ ]' '[ :a | ]' '[ :a :b | 1 ]' '[ 1 ]' '[ 1. 2 ]' '[ 1. ^ 2 ]' '[ :a | a ]' 'self foo: [ ]' 'self foo: [ :a | ]' 'self foo: [ :a :b | 1 ]' 'self foo: [ 1 ]' 'self foo: [ 1. 2 ]' 'self foo: [ :a | 1. ^ 2 ]' 'self foo: [ :a | a ]' '{ }' '{ 1 }' '{ 1 + 2 }' '{ 1 + 2. 3 }' )! !

!QQCompilerTest methodsFor: 'testing' stamp: 'lr 3/5/2008 14:23'!
testDynamicArray
	| normalParseTree quotedParseTree |
	normalParseTree := self parse: '{ 1. 2. 3. 4. 5. 6. 7. 8 }'.
	quotedParseTree := self eval: '``{ `,((1 to: 8) collect: [ :i | i ]) }'.
	self assert: normalParseTree = quotedParseTree! !

!QQCompilerTest methodsFor: 'testing' stamp: 'lr 3/5/2008 14:53'!
testDynamicBlock
	| normalParseTree quotedParseTree |
	normalParseTree := self parse: '[ :a | #foo. #bar. #zork ]'.
	quotedParseTree := self eval: '``[ :a | `,( #(foo bar zork) collect: [ :each | each ]) ]'.
	self assert: normalParseTree = quotedParseTree! !

!QQCompilerTest methodsFor: 'testing' stamp: 'lr 3/5/2008 14:23'!
testQuoteCompiler
	| normalParseTree quotedParseTree |
	self simpleExpressions do: [ :each |
		normalParseTree := self parse: each.
		quotedParseTree := self eval: '``(' , each , ')'.
		self assert: normalParseTree = quotedParseTree ]! !

!QQCompilerTest methodsFor: 'testing' stamp: 'lr 2/18/2010 17:40'!
testUnquoteOutsideQuote
	self
		should: [ self eval: '`,2' ]
		raise: QQUnquoteNotInQuote
		whoseDescriptionIncludes: 'Unquote not in quote'
		description: 'Unquote not in quote'.
	self
		shouldnt: [ self eval: '``(`,2)' ]
		raise: QQUnquoteNotInQuote.
	self
		should: [ self eval: '| x | x := ``(2). 1 + `,x' ]
		raise: QQUnquoteNotInQuote
		whoseDescriptionIncludes: 'Unquote not in quote'
		description: 'Unquote not in quote'.
	self
		shouldnt: [ self eval: '| x | x := ``(2). ``(1 + `,x)' ]
		raise: QQUnquoteNotInQuote! !

QQTestCase subclass: #QQParserTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Tests'!

!QQParserTest methodsFor: 'testing' stamp: 'lr 2/18/2010 15:55'!
testParseQuote
	| ast |
	ast := self parse: '``(self yourself)'.
	self assert: (ast isKindOf: QQQuoteNode).
	self assert: (ast value isKindOf: RBMessageNode).
	self assert: (ast formattedCode = '``(self yourself)').	
	
	ast := self parse: '``(1 + 2)'.
	self assert: (ast isKindOf: QQQuoteNode).
	self assert: (ast value isKindOf: RBMessageNode).
	self assert: (ast formattedCode = '``(1 + 2)').
	
	ast := self parse: '``(self raised: 1 to: 2)'.
	self assert: (ast isKindOf: QQQuoteNode).
	self assert: (ast value isKindOf: RBMessageNode).
	self assert: (ast formattedCode = '``(self raised: 1 to: 2)').
	
	ast := self parse: '``{ 1 }'.
	self assert: (ast isKindOf: QQQuoteNode).
	self assert: (ast value isKindOf: RBArrayNode).
	self assert: (ast formattedCode beginsWith: '``{').
	
	ast := self parse: '``[  ]'.
	self assert: (ast isKindOf: QQQuoteNode).
	self assert: (ast value isKindOf: RBBlockNode).
	self assert: (ast formattedCode beginsWith: '``[').
	
	ast := self parse: '``123'.
	self assert: (ast isKindOf: QQQuoteNode).
	self assert: (ast value isKindOf: RBLiteralNode).
	self assert: (ast formattedCode = '``123').
	
	ast := self parse: '``x'.
	self assert: (ast isKindOf: QQQuoteNode).
	self assert: (ast value isKindOf: RBVariableNode).
	self assert: (ast formattedCode = '``x').
	
	ast := self parse: '``x := 1'.
	self assert: (ast variable isKindOf: QQQuoteNode).
	self assert: (ast isKindOf: RBAssignmentNode).
	self assert: (ast formattedCode = '``x := 1')! !

!QQParserTest methodsFor: 'testing' stamp: 'lr 2/18/2010 15:55'!
testParseSplice
	| ast |
	ast := self parse: '`@(self yourself)'.
	self assert: (ast isKindOf: QQSpliceNode).
	self assert: (ast value isKindOf: RBMessageNode).
	self assert: (ast formattedCode = '`@(self yourself)').	
	
	ast := self parse: '`@(1 + 2)'.
	self assert: (ast isKindOf: QQSpliceNode).
	self assert: (ast value isKindOf: RBMessageNode).
	self assert: (ast formattedCode = '`@(1 + 2)').
	
	ast := self parse: '`@(self raised: 1 to: 2)'.
	self assert: (ast isKindOf: QQSpliceNode).
	self assert: (ast value isKindOf: RBMessageNode).
	self assert: (ast formattedCode = '`@(self raised: 1 to: 2)').
	
	ast := self parse: '`@{ 1 }'.
	self assert: (ast isKindOf: QQSpliceNode).
	self assert: (ast value isKindOf: RBArrayNode).
	self assert: (ast formattedCode beginsWith: '`@{').
	
	ast := self parse: '`@[  ]'.
	self assert: (ast isKindOf: QQSpliceNode).
	self assert: (ast value isKindOf: RBBlockNode).
	self assert: (ast formattedCode beginsWith: '`@[').
	
	ast := self parse: '`@123'.
	self assert: (ast isKindOf: QQSpliceNode).
	self assert: (ast value isKindOf: RBLiteralNode).
	self assert: (ast formattedCode = '`@123').
	
	ast := self parse: '`@x'.
	self assert: (ast isKindOf: QQSpliceNode).
	self assert: (ast value isKindOf: RBVariableNode).
	self assert: (ast formattedCode = '`@x').
	
	ast := self parse: '`@x := 1'.
	self assert: (ast variable isKindOf: QQSpliceNode).
	self assert: (ast isKindOf: RBAssignmentNode).
	self assert: (ast formattedCode = '`@x := 1')! !

!QQParserTest methodsFor: 'testing' stamp: 'lr 2/18/2010 15:56'!
testParseUnquote
	| ast |
	ast := self parse: '`,(self yourself)'.
	self assert: (ast isKindOf: QQUnquoteNode).
	self assert: (ast value isKindOf: RBMessageNode).
	self assert: (ast formattedCode = '`,(self yourself)').	
	
	ast := self parse: '`,(1 + 2)'.
	self assert: (ast isKindOf: QQUnquoteNode).
	self assert: (ast value isKindOf: RBMessageNode).
	self assert: (ast formattedCode = '`,(1 + 2)').
	
	ast := self parse: '`,(self raised: 1 to: 2)'.
	self assert: (ast isKindOf: QQUnquoteNode).
	self assert: (ast value isKindOf: RBMessageNode).
	self assert: (ast formattedCode = '`,(self raised: 1 to: 2)').
	
	ast := self parse: '`,{ 1 }'.
	self assert: (ast isKindOf: QQUnquoteNode).
	self assert: (ast value isKindOf: RBArrayNode).
	self assert: (ast formattedCode beginsWith: '`,{').
	
	ast := self parse: '`,[  ]'.
	self assert: (ast isKindOf: QQUnquoteNode).
	self assert: (ast value isKindOf: RBBlockNode).
	self assert: (ast formattedCode beginsWith: '`,[').
	
	ast := self parse: '`,123'.
	self assert: (ast isKindOf: QQUnquoteNode).
	self assert: (ast value isKindOf: RBLiteralNode).
	self assert: (ast formattedCode = '`,123').
	
	ast := self parse: '`,x'.
	self assert: (ast isKindOf: QQUnquoteNode).
	self assert: (ast value isKindOf: RBVariableNode).
	self assert: (ast formattedCode = '`,x').
	
	ast := self parse: '`,x := 1'.
	self assert: (ast variable isKindOf: QQUnquoteNode).
	self assert: (ast isKindOf: RBAssignmentNode).
	self assert: (ast formattedCode = '`,x := 1')! !

!QQTestCase class methodsFor: 'testing' stamp: 'lr 2/14/2010 11:34'!
isAbstract
	^ self name = #QQTestCase! !

!QQTestCase methodsFor: 'accessing' stamp: 'lr 2/14/2010 11:38'!
compilerClass
	^ QQCompiler! !

!QQTestCase methodsFor: 'utilities' stamp: 'lr 2/14/2010 11:38'!
eval: aString
	^ self compilerClass new
		evaluate: aString
		in: nil to: self
		notifying: self
		ifFail: [ self fail ]
		logged: false! !

!QQTestCase methodsFor: 'utilities' stamp: 'lr 2/18/2010 17:00'!
parse: aString
	^ self compilerClass new parserClass parseExpression: aString! !

!RBConfigurableFormatter methodsFor: '*quasiquote' stamp: 'lr 2/14/2010 11:40'!
acceptObjectNode: aNode
	codeStream space; nextPutAll: aNode formattedCode! !

!RBConfigurableFormatter methodsFor: '*quasiquote' stamp: 'lr 2/14/2010 11:40'!
acceptQuoteNode: aNode 
	self formatMeta: aNode! !

!RBConfigurableFormatter methodsFor: '*quasiquote' stamp: 'lr 2/14/2010 11:40'!
acceptSpliceNode: aNode 
	self formatMeta: aNode! !

!RBConfigurableFormatter methodsFor: '*quasiquote' stamp: 'lr 2/14/2010 11:40'!
acceptUnquoteNode: aNode 
	self formatMeta: aNode! !

!RBConfigurableFormatter methodsFor: '*quasiquote' stamp: 'lr 2/14/2010 11:40'!
formatMeta: aNode
	codeStream nextPut: $`; nextPut: aNode prefix.
	self visitNode: aNode value! !

!RBMethodNode methodsFor: '*quasiquote-override' stamp: 'lr 6/10/2008 21:36'!
generateIR
	ir isNil ifFalse: [ ^ ir ].
	ir := ASTTranslator new
		visitNode: self;
		ir.
	ir properties 
		at: #parseTree
		put: self.
	^ ir! !

!Object methodsFor: '*quasiquote' stamp: 'lr 3/5/2008 11:04'!
flattenAndLift
	^ Array with: self lift! !

!Object methodsFor: '*quasiquote' stamp: 'lr 2/18/2010 16:05'!
lift
	^ self lift: (RBLiteralToken value: self start: 0 stop: -1)! !

!Object methodsFor: '*quasiquote' stamp: 'lr 2/18/2010 16:08'!
lift: aToken
	^ (self isLiteral
		ifTrue: [ RBLiteralNode ]
		ifFalse: [ QQObjectNode ])
			literalToken: aToken! !

PPSmalltalkParser subclass: #QQParser
	instanceVariableNames: 'meta'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Core'!

QQParser class
	instanceVariableNames: 'meta metaQuote metaUnquote metaSplice'!

QQParser class
	instanceVariableNames: 'meta metaQuote metaUnquote metaSplice'!

!QQParser methodsFor: 'grammar-meta' stamp: 'lr 2/14/2010 11:20'!
meta
	^ (self metaFor: QQQuoteNode) 
	/ (self metaFor: QQUnquoteNode) 
	/ (self metaFor: QQSpliceNode)! !

!QQParser methodsFor: 'private' stamp: 'lr 2/14/2010 11:19'!
meta: aClass wrap: aNode
	^ aClass isNil
		ifTrue: [ aNode ]
		ifFalse: [ aClass value: aNode ]! !

!QQParser methodsFor: 'grammar-meta' stamp: 'lr 2/14/2010 11:26'!
metaFor: aClass
	^ (String with: $` with: aClass prefix) asParser ==> [ :node | aClass ]! !

!QQParser methodsFor: 'grammar' stamp: 'lr 2/14/2010 11:22'!
primary
	^ meta optional , super primary map: [ :class :node | self meta: class wrap: node ]! !

!QQParser methodsFor: 'grammar' stamp: 'lr 2/14/2010 11:18'!
variable
	^ meta optional , super variable map: [ :class :node | self meta: class wrap: node ]! !

RBValueNode subclass: #QQMetaNode
	instanceVariableNames: 'value'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Core'!

!QQMetaNode class methodsFor: 'accessing' stamp: 'lr 2/3/2009 18:00'!
prefix
	^ nil! !

!QQMetaNode class methodsFor: 'instance creation' stamp: 'lr 2/29/2008 09:11'!
value: aNode
	^ self new value: aNode! !

!QQMetaNode methodsFor: 'comparing' stamp: 'lr 2/29/2008 09:12'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	^ self value = anObject value! !

!QQMetaNode methodsFor: 'accessing' stamp: 'lr 2/29/2008 09:10'!
children
	^ Array with: value! !

!QQMetaNode methodsFor: 'comparing' stamp: 'lr 2/29/2008 09:12'!
hash
	^ self value hash! !

!QQMetaNode methodsFor: 'copying' stamp: 'lr 2/29/2008 09:12'!
postCopy
	super postCopy.
	value := value copy.
	value parent: self! !

!QQMetaNode methodsFor: 'accessing' stamp: 'lr 2/18/2010 15:33'!
precedence
	^ 0! !

!QQMetaNode methodsFor: 'accessing' stamp: 'lr 2/3/2009 18:00'!
prefix
	^ self class prefix! !

!QQMetaNode methodsFor: 'replacing' stamp: 'lr 2/29/2008 09:12'!
replaceNode: aNode withNode: anotherNode 
	value == aNode ifTrue: [ self value: anotherNode ]! !

!QQMetaNode methodsFor: 'accessing-token' stamp: 'lr 2/29/2008 09:11'!
startWithoutParentheses
	^ value startWithoutParentheses! !

!QQMetaNode methodsFor: 'accessing-token' stamp: 'lr 2/29/2008 09:11'!
stopWithoutParentheses
	^ value stopWithoutParentheses! !

!QQMetaNode methodsFor: 'accessing' stamp: 'lr 2/29/2008 09:10'!
value
	^ value! !

!QQMetaNode methodsFor: 'accessing' stamp: 'lr 2/29/2008 11:16'!
value: aNode
	value := aNode.
	value parent: self! !

QQMetaNode subclass: #QQQuoteNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Core'!

!QQQuoteNode commentStamp: 'lr 2/29/2008 14:35' prior: 0!
Quote inhibits the normal evaluation rule for the parse-tree value, allowing value to be employed as data.

Example: `(1 + 2) --> RBMessageNode(1 + 2)!

!QQQuoteNode class methodsFor: 'accessing' stamp: 'lr 2/3/2009 17:59'!
prefix
	^ $`! !

!QQQuoteNode methodsFor: 'visitor' stamp: 'lr 2/29/2008 10:40'!
acceptVisitor: aVisitor 
	^ aVisitor acceptQuoteNode: self! !

!QQQuoteNode methodsFor: 'accessing' stamp: 'lr 3/3/2008 08:45'!
quoteNode
	^ self! !

QQMetaNode subclass: #QQSpliceNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Core'!

!QQSpliceNode commentStamp: 'lr 2/28/2008 21:01' prior: 0!
A splice evaluates the expression within at compile-time, replacing the splice annotation itself with the AST resulting from its evaluation.!

!QQSpliceNode class methodsFor: 'accessing' stamp: 'lr 2/3/2009 17:59'!
prefix
	^ $@! !

!QQSpliceNode methodsFor: 'visitor' stamp: 'lr 2/29/2008 14:59'!
acceptVisitor: aVisitor 
	^ aVisitor acceptSpliceNode: self! !

QQMetaNode subclass: #QQUnquoteNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Core'!

!QQUnquoteNode class methodsFor: 'accessing' stamp: 'lr 2/3/2009 18:00'!
prefix
	^ $,! !

!QQUnquoteNode methodsFor: 'visitor' stamp: 'lr 2/29/2008 10:41'!
acceptVisitor: aVisitor 
	^ aVisitor acceptUnquoteNode: self! !

!QQUnquoteNode methodsFor: 'testing' stamp: 'lr 3/3/2008 15:49'!
isUnquote
	^ true! !

!QQUnquoteNode methodsFor: 'accessing' stamp: 'lr 3/3/2008 08:45'!
unquoteNode
	^ self! !

!RBFormatter methodsFor: '*quasiquote' stamp: 'lr 4/17/2008 15:41'!
acceptObjectNode: aNode
	codeStream space; nextPutAll: aNode formattedCode! !

!RBFormatter methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 15:41'!
acceptQuoteNode: aNode 
	self formatMeta: aNode! !

!RBFormatter methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 15:01'!
acceptSpliceNode: aNode 
	self formatMeta: aNode! !

!RBFormatter methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 10:41'!
acceptUnquoteNode: aNode 
	self formatMeta: aNode! !

!RBFormatter methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 19:58'!
formatMeta: aNode
	codeStream nextPut: $`; nextPut: aNode prefix.
	self visitNode: aNode value! !

!SHParserST80 methodsFor: '*quasiquote-override' stamp: 'lr 4/16/2008 14:21'!
scanWhitespace
	| c |
	[ c := self currentChar.
	  c notNil and: [ c isSeparator ] ]
		whileTrue: [ sourcePosition := sourcePosition + 1 ].
	c = $` ifTrue: [ sourcePosition := sourcePosition + 2 ].
	c = $" ifTrue: [ self scanComment ]! !

AnObsoleteSemanticWarning subclass: #QQUnquoteNotInQuote
	instanceVariableNames: 'node'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Core'!

!QQUnquoteNotInQuote methodsFor: 'actions' stamp: 'lr 3/3/2008 09:03'!
correctIn: aCompiler
	aCompiler notify: 'Unquote not in quote' at: node start! !

!QQUnquoteNotInQuote methodsFor: 'accessing' stamp: 'lr 2/29/2008 11:03'!
node: aNode
	node := aNode! !

RBCompiler subclass: #QQCompiler
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Core'!

!QQCompiler methodsFor: 'configuration' stamp: 'lr 2/14/2010 11:27'!
parserClass
	^ QQParser! !

!RBCompilerTranslator methodsFor: '*quasiquote' stamp: 'lr 2/18/2010 17:39'!
acceptObjectNode: aNode! !

!RBCompilerTranslator methodsFor: '*quasiquote' stamp: 'lr 2/18/2010 17:48'!
acceptQuoteNode: aNode
	"Create a quasiquoted expression from aNode and use the result to continue with the normal code transformation."

	^ self visitNode: (QQTranslator visit: aNode value)! !

!RBCompilerTranslator methodsFor: '*quasiquote' stamp: 'lr 2/18/2010 16:54'!
acceptSpliceNode: aNode
	"Evaluate the splice and insert the result into the generated AST."

	| method replacement token |
	method := RBMethodNode
		selector: #doIt
		body: ((RBSequenceNode
			statements: (Array with: aNode value))
				addReturn;
				yourself).
	replacement := (method generate
		valueWithReceiver: compiler theClass theNonMetaClass
		arguments: #()) lift.
	token := QQNullToken
		start: aNode firstToken start
		stop: aNode lastToken stop.
	replacement nodesDo: [ :node | node firstToken: token; lastToken: token ].
	^ self visitNode: replacement! !

!Collection methodsFor: '*quasiquote' stamp: 'lr 4/16/2008 16:35'!
flattenAndLift
	^ self gather: [ :each | each flattenAndLift ]! !

!Collection methodsFor: '*quasiquote' stamp: 'lr 8/13/2008 12:36'!
fold: aBlock
	| result marker |
	result := nil.
	marker := true.
	self emptyCheck.
	self do: [ :each |
		result := marker
			ifTrue: [ marker := false. each ]
			ifFalse: [ aBlock value: result value: each ] ].
	^ result! !

!RBMessageNode methodsFor: '*quasiquote-override' stamp: 'lr 6/6/2008 17:13'!
debugHighlightStart
	^ self firstToken start! !

!RBMessageNode methodsFor: '*quasiquote-override' stamp: 'lr 6/16/2008 16:19'!
debugHighlightStop
	^ [ self lastToken stop ] ifError: [ nil ]! !

!Array methodsFor: '*quasiquote' stamp: 'lr 2/18/2010 16:20'!
lift: aToken
	^ QQObjectNode literalToken: aToken! !

RBProgramNodeVisitor subclass: #QQTranslator
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Core'!

!QQTranslator class methodsFor: 'instance creation' stamp: 'lr 2/18/2010 17:01'!
visit: aNode
	^ self new visitNode: aNode! !

!QQTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/18/2010 16:38'!
acceptArrayNode: aNode
	^ RBMessageNode
		receiver: (RBVariableNode named: RBArrayNode name)
		selector: #statements:
		arguments: (Array with: (self visitCollection: aNode statements))! !

!QQTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/18/2010 18:00'!
acceptAssignmentNode: aNode
	^ RBMessageNode
		receiver: (RBVariableNode named: RBAssignmentNode name)
		selector: #variable:value:
		arguments: (Array
			with: (self visitNode: aNode variable)
			with: (self visitNode: aNode value))! !

!QQTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/18/2010 18:01'!
acceptBlockNode: aNode
	^ RBMessageNode
		receiver: (RBVariableNode named: RBBlockNode name)
		selector: #arguments:body:
		arguments: (Array
			with: (self visitCollection: aNode arguments)
			with: (self visitNode: aNode body))! !

!QQTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/18/2010 16:42'!
acceptCascadeNode: aNode
	^ RBMessageNode
		receiver: (RBVariableNode named: RBCascadeNode name)
		selector: #messages:
		arguments: (Array with: (self visitCollection: aNode statements))! !

!QQTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/18/2010 17:59'!
acceptLiteralArrayNode: aNode
	^ RBMessageNode
		receiver: (RBVariableNode named: RBLiteralArrayNode name)
		selector: #startPosition:contents:stopPosition:isByteArray: 
		arguments: (Array 
			with: aNode start lift
			with: aNode contents lift
			with: aNode stop lift
			with: aNode isForByteArray lift)! !

!QQTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/18/2010 17:59'!
acceptLiteralNode: aNode
	^ RBMessageNode
		receiver: (RBVariableNode named: RBLiteralNode name)
		selector: #literalToken:
		arguments: (Array with: aNode token lift)! !

!QQTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/18/2010 18:01'!
acceptMessageNode: aNode
	^ RBMessageNode
		receiver: (RBVariableNode named: RBMessageNode name)
		selector: #receiver:selector:arguments:
		arguments: (Array
			with: (self visitNode: aNode arguments)
			with: aNode selector
			with: (self visitCollection: aNode arguments))! !

!QQTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/18/2010 18:01'!
acceptReturnNode: aNode
	^ RBMessageNode
		receiver: (RBVariableNode named: RBReturnNode name)
		selector: #value:
		arguments: (Array with: (self visitNode: aNode value))! !

!QQTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/18/2010 16:46'!
acceptSequenceNode: aNode
	^ RBMessageNode
		receiver: (RBVariableNode named: RBSequenceNode name)
		selector: #temporaries:statements:
		arguments: (Array 
			with: (self visitCollection: aNode temporaries)
			with: (self visitCollection: aNode statements))! !

!QQTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/18/2010 16:47'!
acceptUnquoteNode: aNode
	^ aNode value! !

!QQTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/18/2010 17:58'!
acceptVariableNode: aNode
	^ RBMessageNode
		receiver: (RBVariableNode named: RBVariableNode name)
		selector: #identifierToken: 
		arguments: (Array with: aNode token lift)! !

!QQTranslator methodsFor: 'visitor' stamp: 'lr 2/18/2010 17:02'!
visitCollection: aCollection
	^ RBMessageNode 
		receiver: (RBArrayNode 
			statements: (aCollection collect: [ :each | self visitNode: each ]))
		selector: #flattenAndLift! !

!RBProgramNodeVisitor methodsFor: '*quasiquote' stamp: 'lr 4/17/2008 15:41'!
acceptObjectNode: aNode
	self acceptLiteralNode: aNode! !

!RBProgramNodeVisitor methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 15:41'!
acceptQuoteNode: aNode 
	! !

!RBProgramNodeVisitor methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 15:01'!
acceptSpliceNode: aNode 
	! !

!RBProgramNodeVisitor methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 10:41'!
acceptUnquoteNode: aNode 
	! !

!ByteArray methodsFor: '*quasiquote' stamp: 'lr 2/18/2010 16:21'!
lift: aToken
	^ QQObjectNode literalToken: aToken! !

RBLiteralValueNode subclass: #QQObjectNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'QuasiQuote-Core'!

!QQObjectNode methodsFor: 'comparing' stamp: 'lr 4/17/2008 15:39'!
= anObject 
	^ self == anObject or: [ self class = anObject class and: [ self value = anObject value ] ]! !

!QQObjectNode methodsFor: 'visitor' stamp: 'lr 4/17/2008 15:40'!
acceptVisitor: aVisitor 
	^ aVisitor acceptObjectNode: self! !

!QQObjectNode methodsFor: 'accessing' stamp: 'lr 4/17/2008 15:54'!
formattedCode
	^ self value printString! !

!QQObjectNode methodsFor: 'comparing' stamp: 'lr 3/18/2009 10:07'!
hash
	^ self value hash! !