SystemOrganization addCategory: #'QuasiQuote-Core'! SystemOrganization addCategory: #'QuasiQuote-Nodes'! SystemOrganization addCategory: #'QuasiQuote-Tests'! SystemOrganization addCategory: #'QuasiQuote-Errors'! !RBAssignmentNode class methodsFor: '*quasiquote' stamp: 'lr 3/5/2008 11:22'! qqVariable: aVariableNode value: aValueNode ^ self variable: aVariableNode lift value: aValueNode lift! ! !String methodsFor: '*quasiquote' stamp: 'lr 3/5/2008 11:24'! flattenAndLift ^ self lift! ! !ASTTranslatorForValue methodsFor: '*quasiquote-visitor' stamp: 'lr 4/16/2008 09:21'! acceptQuoteNode: aNode (self as: QQQuoteTranslator) visitNode: aNode value! ! !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! ! ASTTranslator subclass: #QQQuoteTranslator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Nodes'! !QQQuoteTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 3/5/2008 11:01'! acceptArrayNode: aNode methodBuilder pushLiteralVariable: RBArrayNode binding. self visitCollection: aNode statements. methodBuilder send: #qqStatements:! ! !QQQuoteTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 3/5/2008 11:22'! acceptAssignmentNode: aNode methodBuilder pushLiteralVariable: RBAssignmentNode binding. self visitNode: aNode variable; visitNode: aNode value. methodBuilder send: #qqVariable:value:! ! !QQQuoteTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/29/2008 11:40'! acceptBlockNode: aNode methodBuilder pushLiteralVariable: RBBlockNode binding. self visitCollection: aNode arguments; visitNode: aNode body. methodBuilder send: #arguments:body:! ! !QQQuoteTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/29/2008 14:26'! acceptCascadeNode: aNode aNode receiverTemp: methodBuilder newTemp. self visitNode: aNode receiver. methodBuilder storeTemp: aNode receiverTemp; popTop. methodBuilder pushLiteralVariable: RBCascadeNode binding. self visitCollection: aNode messages. methodBuilder send: #messages:! ! !QQQuoteTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 3/5/2008 14:00'! acceptLiteralNode: aNode methodBuilder pushLiteralVariable: RBLiteralNode binding. methodBuilder pushLiteral: aNode value. methodBuilder send: #value:! ! !QQQuoteTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 3/5/2008 11:20'! acceptMessageNode: aNode methodBuilder pushLiteralVariable: RBMessageNode binding. aNode parent isCascade ifFalse: [ self visitNode: aNode receiver ] ifTrue: [ methodBuilder pushTemp: aNode parent receiverTemp ]. methodBuilder pushLiteral: aNode selector. self visitCollection: aNode arguments. methodBuilder send: #qqReceiver:selector:arguments:! ! !QQQuoteTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 2/29/2008 11:46'! acceptReturnNode: aNode methodBuilder pushLiteralVariable: RBReturnNode binding. self visitNode: aNode value. methodBuilder send: #value:! ! !QQQuoteTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 3/5/2008 11:03'! acceptSequenceNode: aNode methodBuilder pushLiteralVariable: RBSequenceNode binding. self visitCollection: aNode temporaries; visitCollection: aNode statements. methodBuilder send: #qqTemporaries:statements:! ! !QQQuoteTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 3/5/2008 11:18'! acceptUnquoteNode: aNode valueTranslator visitNode: aNode value! ! !QQQuoteTranslator methodsFor: 'visitor-dispatching' stamp: 'lr 3/3/2008 16:29'! acceptVariableNode: aNode methodBuilder pushLiteralVariable: RBVariableNode binding. methodBuilder pushLiteral: aNode name. methodBuilder send: #named:! ! !QQQuoteTranslator methodsFor: 'accessing' stamp: 'lr 2/29/2008 14:09'! braceSelectors ^ #(braceWith: braceWith:with: braceWith:with:with: braceWith:with:with:with:)! ! !QQQuoteTranslator methodsFor: 'visitor' stamp: 'lr 2/29/2008 14:15'! visitCollection: aCollection aCollection isEmpty ifTrue: [ methodBuilder pushLiteral: Array new ] ifFalse: [ methodBuilder pushLiteralVariable: Array binding. aCollection size < self braceSelectors size ifTrue: [ aCollection do: [ :each | self visitNode: each ]. methodBuilder send: (self braceSelectors at: aCollection size) ] ifFalse: [ methodBuilder pushLiteral: aCollection size. methodBuilder send: #braceStream:. aCollection do: [ :each | methodBuilder pushDup. self visitNode: each. methodBuilder send: #nextPut:. methodBuilder popTop ]. methodBuilder send: #braceArray ] ]! ! !LexicalScope methodsFor: '*quasiquote' stamp: 'lr 2/28/2008 21:27'! actualClass ^ outerScope actualClass! ! !RBArrayNode class methodsFor: '*quasiquote' stamp: 'lr 3/5/2008 11:04'! qqStatements: anObject ^ self statements: anObject flattenAndLift! ! !RBArrayNode methodsFor: '*quasiquote' stamp: 'lr 3/3/2008 15:18'! addNode: aNode! ! !RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 3/3/2008 15:49'! isQuote ^ false! ! !RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 3/3/2008 15:48'! isUnquote ^ false! ! !RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 16:13'! lift ^ self! ! !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/3/2008 08:47'! unquoteNode "Answer the un-quoted node in the receivers scope or nil, if none." ^ parent isNil ifFalse: [ parent unquoteNode ]! ! !ClassScope methodsFor: '*quasiquote' stamp: 'lr 2/28/2008 21:28'! actualClass ^ class! ! 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 3/3/2008 13:46'! testUnquoteOutsideQuote self should: [ self eval: '`,2' ] raise: Error whoseDescriptionIncludes: 'Unquote not in quote' description: 'Unquote not in quote'. self shouldnt: [ self eval: '``(`,2)' ] raise: Error. self should: [ self eval: '| x | x := ``(2). 1 + `,x' ] raise: Error whoseDescriptionIncludes: 'Unquote not in quote' description: 'Unquote not in quote'. self shouldnt: [ self eval: '| x | x := ``(2). ``(1 + `,x)' ] raise: Error! ! QQTestCase subclass: #QQParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Tests'! !QQParserTest methodsFor: 'testing' stamp: 'lr 3/5/2008 14:41'! testParseQuote | ast | 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: '``{ 1 }'. self assert: (ast isKindOf: QQQuoteNode). self assert: (ast value isKindOf: RBArrayNode). self assert: ast formattedCode = '``{ 1 }'. ast := self parse: '``[ ]'. self assert: (ast isKindOf: QQQuoteNode). self assert: (ast value isKindOf: RBBlockNode). self assert: ast formattedCode = '``[ ]'. 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 3/5/2008 14:41'! testParseSplice | ast | 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: '`@{ 1 }'. self assert: (ast isKindOf: QQSpliceNode). self assert: (ast value isKindOf: RBArrayNode). self assert: ast formattedCode = '`@{ 1 }'. ast := self parse: '`@[ ]'. self assert: (ast isKindOf: QQSpliceNode). self assert: (ast value isKindOf: RBBlockNode). self assert: ast formattedCode = '`@[ ]'. 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 3/5/2008 14:41'! testParseUnquote | ast | 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: '`,{ 1 }'. self assert: (ast isKindOf: QQUnquoteNode). self assert: (ast value isKindOf: RBArrayNode). self assert: ast formattedCode = '`,{ 1 }'. ast := self parse: '`,[ ]'. self assert: (ast isKindOf: QQUnquoteNode). self assert: (ast value isKindOf: RBBlockNode). self assert: ast formattedCode = '`,[ ]'. 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 methodsFor: 'utilities' stamp: 'lr 3/5/2008 14:17'! eval: aString ^ Compiler new evaluate: aString in: nil to: self notifying: self ifFail: [ self fail ] logged: false! ! !QQTestCase methodsFor: 'events' stamp: 'lr 3/5/2008 14:17'! notify: aString at: anInteger in: aStream self error: aString! ! !QQTestCase methodsFor: 'utilities' stamp: 'lr 3/5/2008 14:23'! parse: aString ^ (QQParser parseExpression: aString) statements first! ! !QQTestCase methodsFor: 'running' stamp: 'lr 3/5/2008 14:17'! setUp super setUp. useNewCompiler := Preferences compileUseNewCompiler. Preferences setPreference: #compileUseNewCompiler toValue: true! ! !QQTestCase methodsFor: 'running' stamp: 'lr 3/5/2008 14:17'! tearDown super tearDown. Preferences setPreference: #compileUseNewCompiler toValue: useNewCompiler! ! !Object methodsFor: '*quasiquote' stamp: 'lr 3/5/2008 11:04'! flattenAndLift ^ Array with: self lift! ! !Object methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 15:09'! lift ^ RBLiteralNode value: self! ! !ASTChecker methodsFor: '*quasiquote-visiting' stamp: 'lr 4/16/2008 09:32'! acceptQuoteNode: aNode | children current | children := OrderedCollection withAll: aNode children. [ children isEmpty ] whileFalse: [ current := children removeFirst. current isUnquote ifTrue: [ self visitNode: current ] ifFalse: [ current children reverseDo: [ :each | children addFirst: each ] ] ]! ! !ASTChecker methodsFor: '*quasiquote-visiting' stamp: 'lr 3/3/2008 08:50'! acceptSpliceNode: aNode | method replacement | method := RBMethodNode selector: #splice body: ((RBSequenceNode statements: (Array with: aNode value)) addReturn; yourself). replacement := (method generate valueWithReceiver: scope actualClass theNonMetaClass arguments: #()) lift. aNode replaceWith: replacement. self visitNode: replacement! ! !ASTChecker methodsFor: '*quasiquote-visiting' stamp: 'lr 3/3/2008 08:51'! acceptUnquoteNode: aNode aNode quoteNode isNil ifTrue: [ self unquoteNotInQuote: aNode ]. self visitNode: aNode value! ! !ASTChecker methodsFor: '*quasiquote-errors' stamp: 'lr 3/3/2008 08:48'! unquoteNotInQuote: aNode QQUnquoteNotInQuote new node: aNode; signal! ! !RBSequenceNode class methodsFor: '*quasiquote' stamp: 'lr 3/5/2008 11:04'! qqTemporaries: variableNodes statements: statementNodes ^ self temporaries: variableNodes flattenAndLift statements: statementNodes flattenAndLift! ! !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-Nodes'! !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-token' stamp: 'lr 2/29/2008 16:18'! basicFirstToken ^ self value basicFirstToken! ! !QQMetaNode methodsFor: 'accessing-token' stamp: 'lr 2/29/2008 16:18'! basicLastToken ^ self value basicFirstToken! ! !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: 'accessing' stamp: 'lr 2/29/2008 14:55'! isValue ^ false! ! !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/29/2008 19:59'! precedence ^ 0! ! !QQMetaNode methodsFor: 'accessing' stamp: 'lr 2/29/2008 10:12'! prefix self subclassResponsibility! ! !QQMetaNode methodsFor: 'replacing' stamp: 'lr 2/29/2008 09:12'! replaceNode: aNode withNode: anotherNode value == aNode ifTrue: [ self value: anotherNode ]! ! !QQMetaNode methodsFor: 'accessing' stamp: 'lr 2/29/2008 09:11'! startWithoutParentheses ^ value startWithoutParentheses! ! !QQMetaNode methodsFor: 'accessing' 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-Nodes'! !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 methodsFor: 'visitor' stamp: 'lr 2/29/2008 10:40'! acceptVisitor: aVisitor ^ aVisitor acceptQuoteNode: self! ! !QQQuoteNode methodsFor: 'testing' stamp: 'lr 3/3/2008 15:49'! isQuote ^ true! ! !QQQuoteNode methodsFor: 'accessing' stamp: 'lr 2/29/2008 15:52'! prefix ^ $`! ! !QQQuoteNode methodsFor: 'accessing' stamp: 'lr 3/3/2008 08:45'! quoteNode ^ self! ! QQMetaNode subclass: #QQSpliceNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Nodes'! !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 methodsFor: 'visitor' stamp: 'lr 2/29/2008 14:59'! acceptVisitor: aVisitor ^ aVisitor acceptSpliceNode: self! ! !QQSpliceNode methodsFor: 'accessing' stamp: 'lr 2/29/2008 15:52'! prefix ^ $@! ! QQMetaNode subclass: #QQUnquoteNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Nodes'! !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 2/29/2008 15:52'! prefix ^ $,! ! !QQUnquoteNode methodsFor: 'accessing' stamp: 'lr 3/3/2008 08:45'! unquoteNode ^ self! ! !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 ]! ! !IRBuilder methodsFor: '*quasiquote' stamp: 'lr 3/3/2008 13:52'! newTemp "Answer a new unique temp variable." | index name | index := 1. [ tempMap includesKey: (name := 't' , index asString) ] whileTrue: [ index := index + 1 ]. self addTemp: name. ^ name! ! !Collection methodsFor: '*quasiquote' stamp: 'lr 3/5/2008 11:04'! flattenAndLift ^ self gather: [ :each | each flattenAndLift ]! ! !RBMessageNode class methodsFor: '*quasiquote' stamp: 'lr 3/5/2008 11:25'! qqReceiver: aValueNode selector: aSymbol arguments: valueNodes ^ self receiver: aValueNode lift selector: aSymbol arguments: valueNodes flattenAndLift! ! SqueakParser subclass: #QQParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Core'! !QQParser class methodsFor: 'generated-comments' stamp: 'lr 2/29/2008 19:57'! parserDefinitionComment "%id ; %start Sequence MethodPattern; Method: MethodPattern Sequence {#method:} | MethodPattern Pragmas Sequence {#methodPragma:} | MethodPattern Pragmas Temporaries Pragmas Statements {#methodPragmaTempsPragma:} | MethodPattern Temporaries Pragmas Statements {#methodTempsPragma:}; MethodPattern: {#unaryMessage:} | Variable {#messagePart:} | error {#argumentNameMissing:} | KeywordMethodPattern {#first:}; KeywordMethodPattern: Variable {#messagePart:} | error {#argumentNameMissing:} | KeywordMethodPattern Variable {#addMessagePart:} | KeywordMethodPattern error {#argumentNameMissing:}; Pragmas: ""<"" PragmaMessage "">"" {#pragma:} | ""<"" PragmaMessage error {#pragmaEndMissing:} | ""<"" error {#pragmaMissing:} | Pragmas ""<"" PragmaMessage "">"" {#pragmas:} | Pragmas ""<"" PragmaMessage error {#pragmaEndMissing:} | Pragmas ""<"" error {#pragmaMissing:}; Sequence: Statements {#sequence:} | Temporaries Statements {#sequenceWithTemps:}; Temporaries: ""||"" {#arrayAddToken:} | ""|"" TemporaryVariables ""|"" {#secondAddToken:} | ""|"" TemporaryVariables error {#verticalBarMissing:}; TemporaryVariables: {#array} | TemporaryVariables Variable {#add:}; Statements: {#array} | StatementList ? {#first:} | StatementList ""^"" Expression ? {#returnAdd:} | ""^"" Expression ? {#return:}; StatementList: Expression {#firstIn:} | StatementList Expression {#add3:}; Block: ""["" BlockArgs ""|"" Sequence {#blockWithArgs:} | ""["" Sequence {#blockNoArgs:} | ""["" BlockArgs {#blockArgs:} | ""["" BlockArgs ""||"" TemporaryVariables ""|"" Statements {#blockWithTemps:}; BlockArgs: Variable {#secondIn:} | error {#argumentNameMissing:} | BlockArgs Variable {#add3:} | BlockArgs error {#argumentNameMissing:}; Expression: Assignment {#first:} | Cascade {#first:} | Primary {#first:}; Primary: Meta Primary {#meta:} | ""("" Expression {#secondWithParenthesis:} | Array {#first:} | Block {#first:} | Literal {#first:} | Variable {#first:}; Assignment: MetaVariable Expression {#assignment:} | Variable Expression {#assignment:} | Variable error {#expressionMissing:}; Cascade: MessageSend {#first:} | Cascade Message {#cascade:} | Cascade error {#cascadeMMissing:}; MessageSend: KeywordMessageSend {#first:} | BinaryMessageSend {#first:} | UnaryMessageSend {#first:}; Message: UnaryMessage {#first:} | BinaryMessage {#first:} | KeywordMessage {#first:}; KeywordMessageSend: BinaryMessageSend KeywordMessage {#messageSend:} | UnaryMessageSend KeywordMessage {#messageSend:} | Primary KeywordMessage {#messageSend:}; KeywordMessage: KeywordArgument {#messagePart:} | error {#argumentMissing:} | KeywordMessage KeywordArgument {#addMessagePart:} | KeywordMessage error {#argumentMissing:}; KeywordArgument: BinaryMessageSend {#first:} | UnaryMessageSend {#first:} | Primary {#first:}; BinaryMessageSend: BinaryMessageSend BinaryMessage {#messageSend:} | UnaryMessageSend BinaryMessage {#messageSend:} | Primary BinaryMessage {#messageSend:}; BinaryMessage : BinaryArgument {#messagePart:} | error {#argumentMissing:}; BinaryArgument: UnaryMessageSend {#first:} | Primary {#first:}; UnaryMessageSend : UnaryMessageSend UnaryMessage {#messageSend:} | Primary UnaryMessage {#messageSend:}; UnaryMessage : {#unaryMessage:}; Array: ""{"" Statements {#array:}; Variable: {#variable:}; Literal: ""true"" {#litTrue:} | ""false"" {#litFalse:} | ""nil"" {#litNil:} | {#litNumber:} | {#litNumber:} | {#litChar:} | {#litString:} | ""#"" {#litStringSymbol:} | ""#"" {#litSymbol:} | ""#"" {#litSymbol:} | ""#"" {#litSymbol:} | ""#"" {#litSymbol:} | ""#"" {#litSymbol:} | ""#"" ""["" ByteArray {#litArray:} | ""#"" ""("" LiteralArray {#litArray:} | ""#:"" {#litString:}; ByteArray: {#byteStream} | ByteArray {#byteStreamPut:}; LiteralArray: {#stream} | LiteralArray ArrayLiteral {#streamPut:}; ArrayLiteral: Literal {#value:} | {#valueSymbol:} | {#valueSymbol:} | {#valueSymbol:} | {#valueSymbol:} | {#valueSymbol:} | ""("" LiteralArray {#contents2:} | ""["" ByteArray {#contents2:} | {#valueSymbol:}; PragmaMessage: Apicall {#messagePragma:} | Primitive {#messagePragma:} | MessagePragma {#messagePragma:}; MessagePragma: KeyWordMessagePragma {#pragmaMessage:} | BinaryMessagePragma {#pragmaMessage:} | UnaryMessage {#pragmaUnaryMessage:}; BinaryMessagePragma: PrimaryPragma {#messagePart:} | error {#argumentMissing:}; KeyWordMessagePragma: PrimaryPragma {#messagePart:} | error {#literalMissing:} | KeywordMessage PrimaryPragma {#addMessagePart:} | KeywordMessage error {#literalMissing:}; PrimaryPragma: Array {#first:} | Block {#first:} | Literal {#first:} | Variable {#first:}; Apicall: TypeCall ExternalType IndexName ""("" ParameterApicall {#externalCall:} | TypeCall ExternalType IndexName ""("" ParameterApicall ""module:"" {#externalModuleCall:}; IndexName: {#externalFunction:} | {#externalIndex:}; TypeCall: ""apicall:"" {#callConvention:} | ""cdecl:"" {#callConvention:}; ParameterApicall: ExternalType {#parameterExtCall:} | ParameterApicall ExternalType {#parametersExtCall:}; ExternalType: {#externalType:} | ""*"" {#externalTypePointer:}; Primitive: ""primitive:"" {#primitiveString:} | ""primitive:"" {#primitiveNumber:} | ""primitive:"" error {#primitiveArgMissing:} | ""primitive:"" ""module:"" {#primitiveModule:} | ""primitive:"" ""module:"" error {#moduleArgMissing:}; Meta: ""``"" {QQQuoteNode} | ""`,"" {QQUnquoteNode} | ""`@"" {QQSpliceNode}; MetaVariable: Meta Variable {#meta:};"! ! !QQParser class methodsFor: 'generated-accessing' stamp: 'lr 2/29/2008 19:57'! scannerClass ^QQScanner! ! !QQParser class methodsFor: 'generated-starting states' stamp: 'lr 2/29/2008 19:57'! startingStateForMethod ^1! ! !QQParser class methodsFor: 'generated-starting states' stamp: 'lr 2/29/2008 19:57'! startingStateForMethodPattern ^3! ! !QQParser class methodsFor: 'generated-starting states' stamp: 'lr 2/29/2008 19:57'! startingStateForSequence ^2! ! !QQParser methodsFor: 'building' stamp: 'lr 2/29/2008 19:44'! meta: nodes ^ (nodes at: 1) value: (nodes at: 2)! ! !QQParser methodsFor: 'generated-reduction actions' stamp: 'lr 2/29/2008 19:57'! reduceActionForMeta1: nodes ^ QQQuoteNode! ! !QQParser methodsFor: 'generated-reduction actions' stamp: 'lr 2/29/2008 19:57'! reduceActionForMeta2: nodes ^ QQUnquoteNode! ! !QQParser methodsFor: 'generated-reduction actions' stamp: 'lr 2/29/2008 19:57'! reduceActionForMeta3: nodes ^ QQSpliceNode! ! !QQParser methodsFor: 'generated-tables' stamp: 'lr 2/29/2008 19:57'! reduceTable ^#( #(42 1 #reduceFor:) #(43 1 #variable:) #(44 2 #messagePart:) #(44 2 #argumentNameMissing:) #(44 3 #addMessagePart:) #(44 3 #argumentNameMissing:) #(45 0 #array) #(45 2 #first:) #(45 5 #returnAdd:) #(45 3 #return:) #(46 0 #array) #(46 2 #add:) #(47 1 #firstIn:) #(47 3 #add3:) #(48 0 #reduceActionForOptionalXXXperiodX1:) #(48 1 #reduceActionForOptionalXXXperiodX2:) #(49 1 #first:) #(49 1 #first:) #(49 1 #first:) #(50 2 #secondIn:) #(50 2 #argumentNameMissing:) #(50 3 #add3:) #(50 3 #argumentNameMissing:) #(51 5 #blockWithArgs:) #(51 3 #blockNoArgs:) #(51 3 #blockArgs:) #(51 7 #blockWithTemps:) #(52 3 #assignment:) #(52 3 #assignment:) #(52 3 #expressionMissing:) #(53 1 #first:) #(53 3 #cascade:) #(53 3 #cascadeMMissing:) #(54 2 #meta:) #(54 3 #secondWithParenthesis:) #(54 1 #first:) #(54 1 #first:) #(54 1 #first:) #(54 1 #first:) #(55 1 #reduceActionForMeta1:) #(55 1 #reduceActionForMeta2:) #(55 1 #reduceActionForMeta3:) #(56 3 #array:) #(57 1 #litTrue:) #(57 1 #litFalse:) #(57 1 #litNil:) #(57 1 #litNumber:) #(57 1 #litNumber:) #(57 1 #litChar:) #(57 1 #litString:) #(57 2 #litStringSymbol:) #(57 2 #litSymbol:) #(57 2 #litSymbol:) #(57 2 #litSymbol:) #(57 2 #litSymbol:) #(57 2 #litSymbol:) #(57 4 #litArray:) #(57 4 #litArray:) #(57 1 #litString:) #(58 2 #meta:) #(59 1 #first:) #(59 1 #first:) #(59 1 #first:) #(60 1 #sequence:) #(60 2 #sequenceWithTemps:) #(61 1 #first:) #(61 1 #first:) #(61 1 #first:) #(62 1 #arrayAddToken:) #(62 3 #secondAddToken:) #(62 3 #verticalBarMissing:) #(63 2 #messageSend:) #(63 2 #messageSend:) #(63 2 #messageSend:) #(64 2 #messageSend:) #(64 2 #messageSend:) #(65 1 #unaryMessage:) #(66 2 #messagePart:) #(66 2 #argumentMissing:) #(67 2 #messagePart:) #(67 2 #argumentMissing:) #(67 3 #addMessagePart:) #(67 3 #argumentMissing:) #(68 1 #first:) #(68 1 #first:) #(68 1 #first:) #(69 1 #first:) #(69 1 #first:) #(70 3 #pragma:) #(70 3 #pragmaEndMissing:) #(70 2 #pragmaMissing:) #(70 4 #pragmas:) #(70 4 #pragmaEndMissing:) #(70 3 #pragmaMissing:) #(71 0 #byteStream) #(71 2 #byteStreamPut:) #(72 0 #stream) #(72 2 #streamPut:) #(73 1 #value:) #(73 1 #valueSymbol:) #(73 1 #valueSymbol:) #(73 1 #valueSymbol:) #(73 1 #valueSymbol:) #(73 1 #valueSymbol:) #(73 3 #contents2:) #(73 3 #contents2:) #(73 1 #valueSymbol:) #(74 2 #method:) #(74 3 #methodPragma:) #(74 5 #methodPragmaTempsPragma:) #(74 4 #methodTempsPragma:) #(75 6 #externalCall:) #(75 8 #externalModuleCall:) #(76 2 #primitiveString:) #(76 2 #primitiveNumber:) #(76 2 #primitiveArgMissing:) #(76 4 #primitiveModule:) #(76 4 #moduleArgMissing:) #(77 1 #pragmaMessage:) #(77 1 #pragmaMessage:) #(77 1 #pragmaUnaryMessage:) #(78 2 #messagePart:) #(78 2 #literalMissing:) #(78 3 #addMessagePart:) #(78 3 #literalMissing:) #(79 2 #messagePart:) #(79 2 #argumentMissing:) #(80 1 #first:) #(80 1 #first:) #(80 1 #first:) #(80 1 #first:) #(81 1 #callConvention:) #(81 1 #callConvention:) #(82 1 #externalType:) #(82 2 #externalTypePointer:) #(83 1 #externalFunction:) #(83 1 #externalIndex:) #(84 1 #parameterExtCall:) #(84 2 #parametersExtCall:) #(87 2 #messageSend:) #(87 2 #messageSend:) #(87 2 #messageSend:) #(88 1 #unaryMessage:) #(88 2 #messagePart:) #(88 2 #argumentNameMissing:) #(88 1 #first:) #(89 1 #messagePragma:) #(89 1 #messagePragma:) #(89 1 #messagePragma:) )! ! !QQParser methodsFor: 'generated-tables' stamp: 'lr 2/29/2008 19:57'! transitionTable ^#( #(3 17 25 21 26 25 28 29 44 33 74 37 88) #(3 41 1 45 2 49 3 53 4 57 5 61 6 65 9 69 10 73 11 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 121 45 125 47 129 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 169 60 173 62 177 63 181 64 30 85 185 87) #(3 17 25 21 26 25 28 29 44 189 88) #(2 574 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 33 85) #(3 109 25 193 43 197 86) #(3 109 25 201 43 205 86) #(3 586 1 586 2 586 3 586 4 586 5 586 6 586 7 586 9 586 10 586 11 586 13 586 14 586 16 586 19 586 20 586 22 586 23 586 24 586 25 209 26 586 33 586 85) #(2 0 85) #(3 41 1 45 2 49 3 53 4 57 5 61 6 213 7 65 9 69 10 73 11 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 121 45 125 47 129 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 217 60 221 62 177 63 181 64 225 70 30 85 185 87) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 229 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 185 87) #(3 41 1 45 2 49 3 53 4 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 30 37 117 43 233 45 125 47 129 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 185 87) #(2 170 1 2 3 5 6 9 13 14 16 19 20 22 23 24 25 33) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 237 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 185 87) #(2 178 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 182 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(3 41 1 45 2 49 3 53 4 57 5 61 6 65 9 69 10 73 11 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 30 36 241 39 117 43 121 45 125 47 129 49 245 50 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 249 60 173 62 177 63 181 64 185 87) #(3 46 10 46 25 253 46 46 86) #(2 278 1 2 3 4 5 6 7 9 13 14 16 19 20 22 23 24 25 33 36 85) #(2 162 1 2 3 5 6 9 13 14 16 19 20 22 23 24 25 33) #(2 186 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 166 1 2 3 5 6 9 13 14 16 19 20 22 23 24 25 33) #(3 257 1 261 9 265 24 269 25 273 26 277 27 281 28 285 30) #(2 238 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 190 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 194 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 202 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 10 1 2 3 4 5 6 7 8 9 10 11 13 14 16 19 20 22 23 24 25 26 28 29 33 34 36 37 38 39 40 85 86) #(2 198 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(3 158 25 158 26 158 28 289 29 158 34 158 36 158 37 158 38 158 85) #(2 258 36 85) #(3 293 34 62 36 62 37 297 48 62 85) #(2 54 34 36 37 85) #(2 150 25 26 28 34 36 37 38 40 85) #(2 70 34 36 37 38 85) #(3 74 34 74 36 74 37 74 38 301 40 74 85) #(3 305 25 309 26 313 28 78 34 78 36 78 37 78 38 317 65 321 66 325 67 78 85) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 329 43 133 51 333 54 337 55 153 56 157 57) #(2 146 25 26 28 34 36 37 38 40 85) #(2 154 25 26 28 34 36 37 38 40 85) #(2 341 29) #(2 126 34 36 37 38 40 85) #(2 0 85) #(3 41 1 45 2 49 3 53 4 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 30 36 117 43 345 45 125 47 129 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 30 85 185 87) #(3 309 26 313 28 250 34 250 36 250 37 250 38 250 40 349 66 353 67 250 85) #(3 305 25 309 26 313 28 254 34 254 36 254 37 254 38 254 40 357 65 361 66 365 67 254 85) #(2 246 34 36 37 38 40 85) #(2 0 85) #(2 14 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 26 33 85) #(2 18 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 26 33 85) #(2 578 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 33 85) #(2 582 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 33 85) #(3 109 25 369 43 373 86) #(3 377 12 381 17 385 18 305 25 389 26 393 28 397 65 401 67 405 75 409 76 413 77 417 78 421 79 425 81 429 86 433 89) #(2 434 85) #(3 41 1 45 2 49 3 53 4 57 5 61 6 213 7 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 345 45 125 47 129 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 437 70 30 85 185 87) #(3 41 1 45 2 49 3 53 4 57 5 61 6 441 7 65 9 69 10 73 11 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 121 45 125 47 129 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 445 60 449 62 177 63 181 64 30 85 185 87) #(2 453 38) #(2 457 37) #(3 461 34 62 36 62 37 465 48 62 85) #(3 109 25 469 43 473 86) #(3 477 10 481 11 485 36 489 39) #(2 493 36) #(3 497 10 109 25 501 43 505 86) #(3 390 1 390 5 390 6 390 9 390 14 390 19 390 20 390 22 390 23 390 24 390 25 390 26 390 27 390 28 390 30 390 33 390 38 390 41 509 72) #(3 382 22 382 36 513 71) #(2 206 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 210 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 218 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 222 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 214 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 226 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 517 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 521 86 185 87) #(3 41 1 45 2 49 3 525 4 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 66 36 66 37 117 43 529 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 66 85 185 87) #(2 34 36 37 85) #(3 305 25 309 26 313 28 533 61 537 65 541 66 545 67 549 86) #(2 310 8 25 26 28 34 36 37 38 40 85 86) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 553 43 133 51 557 54 337 55 153 56 157 57 561 63 565 64 569 68 573 86) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 553 43 133 51 577 54 337 55 153 56 157 57 581 64 585 69 589 86) #(2 306 25 26 28 34 36 37 38 40 85) #(2 298 26 28 34 36 37 38 40 85) #(3 593 26 570 34 570 36 570 37 570 38 570 40 570 85) #(3 158 25 158 26 158 28 242 29 158 34 158 36 158 37 158 38 158 85) #(2 138 25 26 28 34 36 37 38 40 85) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 553 43 133 51 333 54 337 55 153 56 157 57) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 597 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 185 87) #(2 262 36 85) #(2 290 26 28 34 36 37 38 40 85) #(3 593 26 562 34 562 36 562 37 562 38 562 40 562 85) #(2 302 25 26 28 34 36 37 38 40 85) #(2 294 26 28 34 36 37 38 40 85) #(3 593 26 566 34 566 36 566 37 566 38 566 40 566 85) #(2 22 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 26 33 85) #(2 26 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 26 33 85) #(3 601 22 605 24 609 86) #(2 534 25) #(2 530 25) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 613 43 617 51 557 54 337 55 621 56 625 57 561 63 565 64 569 68 629 80 633 86) #(3 45 2 57 5 61 6 65 9 81 14 89 19 93 20 97 22 101 23 105 24 109 25 113 33 637 43 641 51 645 56 649 57 653 80 657 86) #(2 486 8 86) #(2 661 26) #(2 590 8 86) #(2 594 8 86) #(2 598 8 86) #(2 478 8 86) #(2 482 8 86) #(3 665 25 669 82) #(2 366 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 33 85) #(3 673 8 677 86) #(3 41 1 45 2 49 3 53 4 57 5 61 6 441 7 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 681 45 125 47 129 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 30 85 185 87) #(3 377 12 381 17 385 18 305 25 389 26 393 28 397 65 401 67 405 75 409 76 413 77 417 78 421 79 425 81 685 86 689 89) #(2 438 85) #(3 41 1 45 2 49 3 53 4 57 5 61 6 213 7 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 345 45 125 47 129 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 693 70 30 85 185 87) #(2 142 25 26 28 34 36 37 38 40 85) #(2 174 8 25 26 28 34 36 37 38 40 85 86) #(2 66 36 37 85) #(2 42 36 37 85) #(2 82 10 11 36 39) #(2 86 10 11 36 39) #(3 41 1 45 2 49 3 53 4 57 5 61 6 65 9 69 10 73 11 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 30 36 117 43 121 45 125 47 129 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 697 60 173 62 177 63 181 64 185 87) #(3 46 10 46 25 701 46) #(2 106 8 25 26 28 34 36 37 38 40 85 86) #(3 109 25 705 43 709 86) #(2 102 8 25 26 28 34 36 37 38 40 85 86) #(2 282 1 2 3 4 5 6 7 9 13 14 16 19 20 22 23 24 25 33 36 85) #(2 50 10 25 86) #(2 286 1 2 3 4 5 6 7 9 13 14 16 19 20 22 23 24 25 33 36 85) #(3 713 1 57 5 61 6 717 9 81 14 89 19 93 20 97 22 101 23 105 24 721 25 725 26 729 27 733 28 737 30 113 33 741 38 745 41 749 57 753 73) #(3 757 22 761 36) #(2 118 34 36 37 38 85) #(2 122 34 36 37 38 85) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 765 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 185 87) #(2 58 34 36 37 85) #(2 130 34 36 37 38 40 85) #(2 266 34 36 37 38 40 85) #(2 270 34 36 37 38 40 85) #(3 593 26 274 34 274 36 274 37 274 38 274 40 274 85) #(2 134 34 36 37 38 40 85) #(2 158 25 26 28 34 36 37 38 40 85) #(3 305 25 346 26 313 28 346 34 346 36 346 37 346 38 346 40 317 65 321 66 346 85) #(3 338 26 313 28 338 34 338 36 338 37 338 38 338 40 349 66 338 85) #(3 305 25 342 26 313 28 342 34 342 36 342 37 342 38 342 40 357 65 361 66 342 85) #(2 322 26 34 36 37 38 40 85) #(2 326 26 34 36 37 38 40 85) #(3 305 25 354 26 354 28 354 34 354 36 354 37 354 38 354 40 317 65 354 85) #(3 305 25 350 26 350 28 350 34 350 36 350 37 350 38 350 40 357 65 350 85) #(2 314 26 28 34 36 37 38 40 85) #(2 318 26 28 34 36 37 38 40 85) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 553 43 133 51 557 54 337 55 153 56 157 57 561 63 565 64 769 68 773 86) #(2 114 34 36 37 38 85) #(2 462 8 86) #(3 458 8 777 21 458 86) #(2 466 8 86) #(3 526 8 158 25 158 26 158 28 526 86) #(3 518 8 150 25 150 26 150 28 518 86) #(3 514 8 146 25 146 26 146 28 514 86) #(3 522 8 154 25 154 26 154 28 522 86) #(2 490 8 86) #(3 494 8 326 26 494 86) #(2 526 8 86) #(2 518 8 86) #(2 514 8 86) #(2 522 8 86) #(2 506 8 86) #(2 510 8 86) #(3 41 1 45 2 49 3 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 613 43 617 51 557 54 337 55 621 56 625 57 561 63 565 64 769 68 781 80 785 86) #(3 789 15 538 22 538 24 538 25 538 38) #(3 793 22 797 24 801 83) #(2 358 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 33 85) #(2 362 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 33 85) #(2 446 85) #(2 378 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 33 85) #(3 805 8 809 86) #(3 41 1 45 2 49 3 53 4 57 5 61 6 441 7 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 117 43 813 45 125 47 129 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 30 85 185 87) #(2 817 36) #(3 821 10 109 25 501 43) #(2 90 10 11 36 39) #(2 94 10 11 36 39) #(3 390 1 390 5 390 6 390 9 390 14 390 19 390 20 390 22 390 23 390 24 390 25 390 26 390 27 390 28 390 30 390 33 390 38 390 41 825 72) #(3 382 22 382 36 829 71) #(2 402 1 5 6 9 14 19 20 22 23 24 25 26 27 28 30 33 38 41) #(2 410 1 5 6 9 14 19 20 22 23 24 25 26 27 28 30 33 38 41) #(2 414 1 5 6 9 14 19 20 22 23 24 25 26 27 28 30 33 38 41) #(2 406 1 5 6 9 14 19 20 22 23 24 25 26 27 28 30 33 38 41) #(2 418 1 5 6 9 14 19 20 22 23 24 25 26 27 28 30 33 38 41) #(2 234 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(2 430 1 5 6 9 14 19 20 22 23 24 25 26 27 28 30 33 38 41) #(2 398 1 5 6 9 14 19 20 22 23 24 25 26 27 28 30 33 38 41) #(2 394 1 5 6 9 14 19 20 22 23 24 25 26 27 28 30 33 38 41) #(2 386 22 36) #(2 230 1 5 6 8 9 14 19 20 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 85 86) #(3 461 34 62 36 62 37 833 48 62 85) #(2 330 26 34 36 37 38 40 85) #(2 334 26 34 36 37 38 40 85) #(3 837 24 841 86) #(2 498 8 86) #(3 502 8 334 26 502 86) #(2 542 22 24 25 38) #(2 550 1) #(2 546 1) #(2 845 1) #(2 370 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 33 85) #(2 374 1 2 3 4 5 6 7 9 10 11 13 14 16 19 20 22 23 24 25 33 85) #(2 442 85) #(2 98 8 25 26 28 34 36 37 38 40 85 86) #(3 41 1 45 2 49 3 53 4 57 5 61 6 65 9 77 13 81 14 85 16 89 19 93 20 97 22 101 23 105 24 109 25 113 33 30 36 117 43 849 45 125 47 129 49 133 51 137 52 141 53 145 54 149 55 153 56 157 57 161 58 165 59 177 63 181 64 185 87) #(3 713 1 57 5 61 6 717 9 81 14 89 19 93 20 97 22 101 23 105 24 721 25 725 26 729 27 733 28 737 30 113 33 853 38 745 41 749 57 753 73) #(3 757 22 857 36) #(2 38 36 37 85) #(2 470 8 86) #(2 474 8 86) #(3 665 25 861 82 865 84) #(2 869 36) #(2 422 1 5 6 9 14 19 20 22 23 24 25 26 27 28 30 33 38 41) #(2 426 1 5 6 9 14 19 20 22 23 24 25 26 27 28 30 33 38 41) #(2 554 25 38) #(3 665 25 873 38 877 82) #(2 110 8 25 26 28 34 36 37 38 40 85 86) #(3 450 8 881 21 450 86) #(2 558 25 38) #(2 885 24) #(2 454 8 86) )! ! !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 ! ! !Parser2 methodsFor: '*quasiquote-override' stamp: 'lr 2/28/2008 15:04'! realParserClass ^ QQParser! ! !NonClosureScopeFixer methodsFor: '*quasiquote' stamp: 'lr 4/16/2008 10:43'! acceptQuoteNode: aNode | children current | children := OrderedCollection withAll: aNode children. [ children isEmpty ] whileFalse: [ current := children removeFirst. current isUnquote ifTrue: [ self visitNode: current ] ifFalse: [ current children reverseDo: [ :each | children addFirst: each ] ] ]! ! !NonClosureScopeFixer methodsFor: '*quasiquote' stamp: 'lr 4/16/2008 10:44'! acceptUnquoteNode: aNode self visitNode: aNode value! ! SqueakScanner subclass: #QQScanner instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Core'! !QQScanner class methodsFor: 'generated-initialization' stamp: 'lr 2/29/2008 19:57'! initializeKeywordMap keywordMap := Dictionary new. #( #(25 'false' 6 ) #(25 'nil' 14 ) #(25 'true' 5 ) #(26 'apicall:' 18 ) #(26 'cdecl:' 17 ) #(26 'module:' 21 ) #(26 'primitive:' 12 ) #(#binarySymbol '||' 11 ) ) do: [ : each | (keywordMap at: each first ifAbsentPut: [ Dictionary new ]) at: (each at: 2) put: each last ]. ^ keywordMap! ! !QQScanner class methodsFor: 'generated-comments' stamp: 'lr 2/29/2008 19:57'! scannerDefinitionComment ": [0-9]+ (\. [0-9]+)? ; : [0-9]+ r [0-9A-Z]+ (\. [0-9A-Z]+)? ; : s [0-9]+ ; : ( | ) e \-? [0-9]+ ; : | | | ; : \- ; : \' [^\']* \' (\' [^\']* \')* ; : [a-zA-Z] [a-zA-Z0-9]* ; : \: ; : \: ( \: )+ ; : [\~\!!\@\%\&\*\-\+\=\\\|\?\/\>\<\,] [\~\!!\@\%\&\*\-\+\=\\\|\?\/\>\<\,]* ; : \: \= | \_ ; : \: \: ( \:)* ; : \s+ ; : \"" [^\""]* \"" ; : \$ . ; : \. ; : \: \= ; : ]; : }; : \); : \:; : \;; : . ; # For VW literal arrays that handle #(;) -> #(#';');"! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! assignmentId ^29! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! binarySymbolId ^28! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! characterId ^33! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! colonId ^39! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! emptySymbolTokenId ^85! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! errorTokenId ^86! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! keywordId ^26! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! multikeywordId ^27! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! nameId ^25! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! negativeNumberId ^23! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! numberId ^22! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! periodId ^34! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! rightBoxBracketsId ^36! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! rightCurlyBracketsId ^37! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! rightParenthesesId ^38! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scan1 [ self step. currentCharacter ~= $' ] whileTrue. currentCharacter = $' ifTrue: [ ^ self scan2 ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scan10 self step. (currentCharacter between: $0 and: $9) ifTrue: [ [ self recordMatch: #(23 ). self step. currentCharacter between: $0 and: $9 ] whileTrue. ^ self reportLastMatch ]. currentCharacter = $- ifTrue: [ ^ self scan11 ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scan11 self step. (currentCharacter between: $0 and: $9) ifTrue: [ [ self recordMatch: #(23 ). self step. currentCharacter between: $0 and: $9 ] whileTrue. ^ self reportLastMatch ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scan2 self recordMatch: #(24 ). self step. currentCharacter = $' ifTrue: [ ^ self scan1 ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scan3 self step. (currentCharacter between: $0 and: $9) ifTrue: [ [ self recordMatch: #(22 ). self step. currentCharacter between: $0 and: $9 ] whileTrue. currentCharacter = $e ifTrue: [ ^ self scan4 ]. currentCharacter = $s ifTrue: [ ^ self scan5 ]. ^ self reportLastMatch ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scan4 self step. (currentCharacter between: $0 and: $9) ifTrue: [ [ self recordMatch: #(22 ). self step. currentCharacter between: $0 and: $9 ] whileTrue. ^ self reportLastMatch ]. currentCharacter = $- ifTrue: [ ^ self scan5 ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scan5 self step. (currentCharacter between: $0 and: $9) ifTrue: [ [ self recordMatch: #(22 ). self step. currentCharacter between: $0 and: $9 ] whileTrue. ^ self reportLastMatch ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scan6 self step. ((currentCharacter between: $0 and: $9) or: [ currentCharacter between: $A and: $Z ]) ifTrue: [ [ self recordMatch: #(22 ). self step. (currentCharacter between: $0 and: $9) or: [ currentCharacter between: $A and: $Z ] ] whileTrue. currentCharacter = $. ifTrue: [ self step. ((currentCharacter between: $0 and: $9) or: [ currentCharacter between: $A and: $Z ]) ifTrue: [ [ self recordMatch: #(22 ). self step. (currentCharacter between: $0 and: $9) or: [ currentCharacter between: $A and: $Z ] ] whileTrue. currentCharacter = $e ifTrue: [ ^ self scan4 ]. ^ self reportLastMatch ]. ^ self reportLastMatch ]. currentCharacter = $e ifTrue: [ ^ self scan4 ]. ^ self reportLastMatch ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scan7 [ self step. (currentCharacter between: $0 and: $9) or: [ (currentCharacter between: $A and: $Z) or: [ currentCharacter between: $a and: $z ] ] ] whileTrue. currentCharacter = $: ifTrue: [ self recordMatch: #(30 ). self step. ((currentCharacter between: $A and: $Z) or: [ currentCharacter between: $a and: $z ]) ifTrue: [ ^ self scan7 ]. ^ self reportLastMatch ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scan8 self recordMatch: #(26 ). self step. ((currentCharacter between: $A and: $Z) or: [ currentCharacter between: $a and: $z ]) ifTrue: [ ^ self scan9 ]. currentCharacter = $= ifTrue: [ ^ self recordAndReportMatch: #variableAssignment ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scan9 [ self step. (currentCharacter between: $0 and: $9) or: [ (currentCharacter between: $A and: $Z) or: [ currentCharacter between: $a and: $z ] ] ] whileTrue. currentCharacter = $: ifTrue: [ self recordMatch: #(27 ). self step. ((currentCharacter between: $A and: $Z) or: [ currentCharacter between: $a and: $z ]) ifTrue: [ ^ self scan9 ]. ^ self reportLastMatch ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 19:57'! scanForToken self step. (currentCharacter <= Character backspace or: [ (currentCharacter between: (Character value: 14) and: (Character value: 31)) or: [ currentCharacter >= $ ] ]) ifTrue: [ ^ self recordAndReportMatch: #(41 ) ]. ((currentCharacter between: $A and: $Z) or: [ currentCharacter between: $a and: $z ]) ifTrue: [ self recordMatch: #(25 41 ). self step. ((currentCharacter between: $0 and: $9) or: [ (currentCharacter between: $A and: $Z) or: [ currentCharacter between: $a and: $z ] ]) ifTrue: [ [ self recordMatch: #(25 ). self step. (currentCharacter between: $0 and: $9) or: [ (currentCharacter between: $A and: $Z) or: [ currentCharacter between: $a and: $z ] ] ] whileTrue. currentCharacter = $: ifTrue: [ ^ self scan8 ]. ^ self reportLastMatch ]. currentCharacter = $: ifTrue: [ ^ self scan8 ]. ^ self reportLastMatch ]. (currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $+ and: $,) or: [ currentCharacter = $/ or: [ currentCharacter = $= or: [ (currentCharacter between: $? and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $~ ] ] ] ] ] ] ]) ifTrue: [ self recordMatch: #binarySymbol. self step. (currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ]) ifTrue: [ [ self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ] ] whileTrue. ^ self reportLastMatch ]. ^ self reportLastMatch ]. (currentCharacter between: $0 and: $9) ifTrue: [ self recordMatch: #(22 41 ). self step. (currentCharacter between: $0 and: $9) ifTrue: [ [ self recordMatch: #(22 ). self step. currentCharacter between: $0 and: $9 ] whileTrue. currentCharacter = $. ifTrue: [ ^ self scan3 ]. currentCharacter = $e ifTrue: [ ^ self scan4 ]. currentCharacter = $r ifTrue: [ ^ self scan6 ]. currentCharacter = $s ifTrue: [ ^ self scan5 ]. ^ self reportLastMatch ]. currentCharacter = $. ifTrue: [ ^ self scan3 ]. currentCharacter = $e ifTrue: [ ^ self scan4 ]. currentCharacter = $r ifTrue: [ ^ self scan6 ]. currentCharacter = $s ifTrue: [ ^ self scan5 ]. ^ self reportLastMatch ]. ((currentCharacter between: Character tab and: Character cr) or: [ currentCharacter = Character space ]) ifTrue: [ self recordMatch: #whitespace. self step. ((currentCharacter between: Character tab and: Character cr) or: [ currentCharacter = Character space ]) ifTrue: [ [ self recordMatch: #whitespace. self step. (currentCharacter between: Character tab and: Character cr) or: [ currentCharacter = Character space ] ] whileTrue. ^ self reportLastMatch ]. ^ self reportLastMatch ]. currentCharacter = $" ifTrue: [ self recordMatch: #(41 ). self step. currentCharacter ~= $" ifTrue: [ [ self step. currentCharacter ~= $" ] whileTrue. currentCharacter = $" ifTrue: [ ^ self recordAndReportMatch: #comment ]. ^ self reportLastMatch ]. currentCharacter = $" ifTrue: [ ^ self recordAndReportMatch: #comment ]. ^ self reportLastMatch ]. currentCharacter = $# ifTrue: [ self recordMatch: #(19 41 ). self step. currentCharacter = $: ifTrue: [ ^ self recordAndReportMatch: #(20 ) ]. ^ self reportLastMatch ]. currentCharacter = $$ ifTrue: [ self recordMatch: #(41 ). self step. currentCharacter <= $ÿ ifTrue: [ ^ self recordAndReportMatch: #(33 ) ]. ^ self reportLastMatch ]. currentCharacter = $' ifTrue: [ self recordMatch: #(41 ). self step. currentCharacter ~= $' ifTrue: [ ^ self scan1 ]. currentCharacter = $' ifTrue: [ ^ self scan2 ]. ^ self reportLastMatch ]. currentCharacter = $( ifTrue: [ ^ self recordAndReportMatch: #(1 41 ) ]. currentCharacter = $) ifTrue: [ ^ self recordAndReportMatch: #(38 41 ) ]. currentCharacter = $* ifTrue: [ self recordMatch: #(15 28 41 ). self step. (currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ]) ifTrue: [ [ self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ] ] whileTrue. ^ self reportLastMatch ]. ^ self reportLastMatch ]. currentCharacter = $- ifTrue: [ self recordMatch: #binarySymbol. self step. (currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ]) ifTrue: [ [ self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ] ] whileTrue. ^ self reportLastMatch ]. (currentCharacter between: $0 and: $9) ifTrue: [ [ self recordMatch: #(23 ). self step. currentCharacter between: $0 and: $9 ] whileTrue. currentCharacter = $. ifTrue: [ self step. (currentCharacter between: $0 and: $9) ifTrue: [ [ self recordMatch: #(23 ). self step. currentCharacter between: $0 and: $9 ] whileTrue. currentCharacter = $e ifTrue: [ ^ self scan10 ]. currentCharacter = $s ifTrue: [ ^ self scan11 ]. ^ self reportLastMatch ]. ^ self reportLastMatch ]. currentCharacter = $e ifTrue: [ ^ self scan10 ]. currentCharacter = $r ifTrue: [ self step. ((currentCharacter between: $0 and: $9) or: [ currentCharacter between: $A and: $Z ]) ifTrue: [ [ self recordMatch: #(23 ). self step. (currentCharacter between: $0 and: $9) or: [ currentCharacter between: $A and: $Z ] ] whileTrue. currentCharacter = $. ifTrue: [ self step. ((currentCharacter between: $0 and: $9) or: [ currentCharacter between: $A and: $Z ]) ifTrue: [ [ self recordMatch: #(23 ). self step. (currentCharacter between: $0 and: $9) or: [ currentCharacter between: $A and: $Z ] ] whileTrue. currentCharacter = $e ifTrue: [ ^ self scan10 ]. ^ self reportLastMatch ]. ^ self reportLastMatch ]. currentCharacter = $e ifTrue: [ ^ self scan10 ]. ^ self reportLastMatch ]. ^ self reportLastMatch ]. currentCharacter = $s ifTrue: [ ^ self scan11 ]. ^ self reportLastMatch ]. ^ self reportLastMatch ]. currentCharacter = $. ifTrue: [ ^ self recordAndReportMatch: #(34 41 ) ]. currentCharacter = $: ifTrue: [ self recordMatch: #(39 41 ). self step. ((currentCharacter between: $A and: $Z) or: [ currentCharacter between: $a and: $z ]) ifTrue: [ ^ self scan7 ]. currentCharacter = $= ifTrue: [ ^ self recordAndReportMatch: #(29 ) ]. ^ self reportLastMatch ]. currentCharacter = $; ifTrue: [ ^ self recordAndReportMatch: #(40 41 ) ]. currentCharacter = $< ifTrue: [ self recordMatch: #(7 28 41 ). self step. (currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ]) ifTrue: [ [ self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ] ] whileTrue. ^ self reportLastMatch ]. ^ self reportLastMatch ]. currentCharacter = $> ifTrue: [ self recordMatch: #(8 28 41 ). self step. (currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ]) ifTrue: [ [ self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ] ] whileTrue. ^ self reportLastMatch ]. ^ self reportLastMatch ]. currentCharacter = $[ ifTrue: [ ^ self recordAndReportMatch: #(9 41 ) ]. currentCharacter = $] ifTrue: [ ^ self recordAndReportMatch: #(36 41 ) ]. currentCharacter = $^ ifTrue: [ ^ self recordAndReportMatch: #(4 41 ) ]. currentCharacter = $_ ifTrue: [ ^ self recordAndReportMatch: #(29 41 ) ]. currentCharacter = $` ifTrue: [ self recordMatch: #(41 ). self step. currentCharacter = $, ifTrue: [ ^ self recordAndReportMatch: #(16 ) ]. currentCharacter = $@ ifTrue: [ ^ self recordAndReportMatch: #(3 ) ]. currentCharacter = $` ifTrue: [ ^ self recordAndReportMatch: #(13 ) ]. ^ self reportLastMatch ]. currentCharacter = ${ ifTrue: [ ^ self recordAndReportMatch: #(2 41 ) ]. currentCharacter = $| ifTrue: [ self recordMatch: #(10 28 41 ). self step. (currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ]) ifTrue: [ [ self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [ (currentCharacter between: $% and: $&) or: [ (currentCharacter between: $* and: $-) or: [ currentCharacter = $/ or: [ (currentCharacter between: $< and: $@) or: [ currentCharacter = $\ or: [ currentCharacter = $| or: [ currentCharacter = $~ ] ] ] ] ] ] ] ] whileTrue. ^ self reportLastMatch ]. ^ self reportLastMatch ]. currentCharacter = $} ifTrue: [ ^ self recordAndReportMatch: #(37 41 ) ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 19:57'! stringId ^24! ! SemanticWarning subclass: #QQUnquoteNotInQuote instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Errors'! !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! !