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

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

!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 ]) ] ]! !

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

!RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 2/18/2010 19:21'!
lift: aToken
	^ self lift! !

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

!QQCompilerTest class methodsFor: 'accessing' stamp: 'lr 2/18/2010 19:15'!
packageNamesUnderTest
	^ #('QuasiQuote')! !

!QQCompilerTest methodsFor: 'accessing' stamp: 'lr 2/18/2010 19:05'!
compilerClass
	^ QQCompiler! !

!QQCompilerTest methodsFor: 'utilities' stamp: 'lr 2/18/2010 19:05'!
eval: aString
	^ self compilerClass new
		evaluate: aString
		in: nil to: self
		notifying: self
		ifFail: [ self fail ]
		logged: false! !

!QQCompilerTest methodsFor: 'accessing' stamp: 'lr 2/18/2010 19:07'!
expressions
	^ #( 'self' 'super' 'nil' 'true' 'false' 'thisContext' '''foo''' '#foo' '#()' '#(1)' '#(1 (2 3))' '#[]' '#[1]' '#[1 2]' '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: 'utilities' stamp: 'lr 2/18/2010 19:05'!
parse: aString
	^ self compilerClass new parserClass parseExpression: aString! !

!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 2/18/2010 19:07'!
testQuoteCompiler
	| normalParseTree quotedParseTree |
	self expressions do: [ :each |
		normalParseTree := self parse: each.
		quotedParseTree := self eval: '``(' , each , ')'.
		self 
			assert: normalParseTree = quotedParseTree
			description: each ]! !

!QQCompilerTest methodsFor: 'testing-quote' stamp: 'lr 2/18/2010 19:14'!
testQuoteParse1
	| 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')! !

!QQCompilerTest methodsFor: 'testing-quote' stamp: 'lr 2/18/2010 19:22'!
testQuoteParse2
	| normal quote |
	self expressions do: [ :each |
		normal := self parse: each.
		quote := self parse: '``(' , each  , ')'.
		self assert: (quote formattedCode beginsWith: '``').
		self assert: (quote isKindOf: QQQuoteNode).
		self assert: (quote value = normal) ]! !

!QQCompilerTest methodsFor: 'testing-splice' stamp: 'lr 2/18/2010 18:42'!
testSpliceLiterals
	self assert: (self eval: '`@(1)') = 1.
	self assert: (self eval: '`@($a)') = $a.
	self assert: (self eval: '`@(''a'')') = 'a'.

	self assert: (self eval: '`@(true)') = true.
	self assert: (self eval: '`@(false)') = false.
	self assert: (self eval: '`@(nil)') = nil! !

!QQCompilerTest methodsFor: 'testing-splice' stamp: 'lr 2/18/2010 19:13'!
testSpliceParse1
	| 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')! !

!QQCompilerTest methodsFor: 'testing-splice' stamp: 'lr 2/18/2010 19:14'!
testSpliceParse2
	| normal splice |
	self expressions do: [ :each |
		normal := self parse: each.
		splice := self parse: '`@(' , each  , ')'.
		self assert: (splice formattedCode beginsWith: '`@').
		self assert: (splice isKindOf: QQSpliceNode).
		self assert: (splice value = normal) ]! !

!QQCompilerTest methodsFor: 'testing-splice' stamp: 'lr 2/18/2010 18:46'!
testSpliceReferences
	self assert: (self eval: '`@(self name)') = self class name.
	self assert: (self eval: '`@(super name)') = self class name! !

!QQCompilerTest methodsFor: 'testing-unquote' stamp: 'lr 2/18/2010 19:02'!
testUnquoteError1
	self
		should: [ self eval: '`,1' ]
		raise: QQUnquoteNotInQuote! !

!QQCompilerTest methodsFor: 'testing-unquote' stamp: 'lr 2/18/2010 19:02'!
testUnquoteError2
	self
		should: [ self eval: '1 + `,2' ]
		raise: QQUnquoteNotInQuote! !

!QQCompilerTest methodsFor: 'testing-unquote' stamp: 'lr 2/18/2010 19:02'!
testUnquoteError3
	self
		should: [ self eval: '[ `,3 ]' ]
		raise: QQUnquoteNotInQuote! !

!QQCompilerTest methodsFor: 'testing-unquote' stamp: 'lr 2/18/2010 19:12'!
testUnquoteParse1
	| 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')! !

!QQCompilerTest methodsFor: 'testing-unquote' stamp: 'lr 2/18/2010 19:13'!
testUnquoteParse2
	| normal unquoted |
	self expressions do: [ :each |
		normal := self parse: each.
		unquoted := self parse: '`,(' , each  , ')'.
		self assert: (unquoted formattedCode beginsWith: '`,').
		self assert: (unquoted isKindOf: QQUnquoteNode).
		self assert: (unquoted value = normal) ]! !

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! !

!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! !

!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 ]! !

!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 ]! !

!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! !

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

!QQMetaNode class methodsFor: 'accessing' stamp: 'lr 2/18/2010 19:20'!
prefix
	self subclassResponsibility! !

!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/18/2010 19:21'!
postCopy
	super postCopy.
	self parent: value copy! !

!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! !

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! !

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

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: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 18:39'!
acceptSpliceNode: aNode
	"Evaluate the splice and insert the result into the generated AST."
	
	| tree method result |
	tree := RBMethodNode
		selector: #doIt
		body: (aNode value isSequence
			ifTrue: [ aNode value copy ]
			ifFalse: [ RBSequenceNode statements: (Array with: aNode value copy) ]).
	tree addReturn.
	method := (self compiler translate: tree)
		generate: #(0 0 0 0).
	result := method 
		valueWithReceiver: method methodClass 
		arguments: #().
	^ self visitNode: result lift! !

!RBCompilerTranslator methodsFor: '*quasiquote' stamp: 'lr 2/18/2010 19:20'!
acceptUnquoteNode: aNode 
	^ QQUnquoteNotInQuote signal! !

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

!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/18/2010 19:17'!
acceptQuoteNode: aNode 
	self visitNode: aNode value! !

!RBProgramNodeVisitor methodsFor: '*quasiquote' stamp: 'lr 2/18/2010 19:17'!
acceptSpliceNode: aNode
	self visitNode: aNode value! !

!RBProgramNodeVisitor methodsFor: '*quasiquote' stamp: 'lr 2/18/2010 19:17'!
acceptUnquoteNode: aNode
	self visitNode: aNode value! !

!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! !