SystemOrganization addCategory: #'QuasiQuote-Core'! SystemOrganization addCategory: #'QuasiQuote-Nodes'! SystemOrganization addCategory: #'QuasiQuote-Tests'! SystemOrganization addCategory: #'QuasiQuote-Errors'! !ASTTranslatorForValue methodsFor: '*quasiquote-visitor' stamp: 'lr 2/29/2008 14:25'! acceptQuasiQuoteNode: aNode (self as: QQQuasiQuoteTranslator) visitNode: aNode value! ! !ASTTranslatorForValue methodsFor: '*quasiquote-visitor' stamp: 'lr 2/29/2008 14:19'! acceptQuoteNode: aNode methodBuilder pushLiteral: aNode value! ! ASTTranslator subclass: #QQQuasiQuoteTranslator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Nodes'! !QQQuasiQuoteTranslator methodsFor: 'visiting' stamp: 'lr 2/29/2008 11:39'! acceptArrayNode: aNode methodBuilder pushLiteralVariable: RBArrayNode binding. self visitCollection: aNode statements. methodBuilder send: #statements:! ! !QQQuasiQuoteTranslator methodsFor: 'visiting' stamp: 'lr 2/29/2008 11:39'! acceptAssignmentNode: aNode methodBuilder pushLiteralVariable: RBAssignmentNode binding. self visitNode: aNode variable; visitNode: aNode value. methodBuilder send: #variable:value:! ! !QQQuasiQuoteTranslator methodsFor: 'visiting' stamp: 'lr 2/29/2008 11:40'! acceptBlockNode: aNode methodBuilder pushLiteralVariable: RBBlockNode binding. self visitCollection: aNode arguments; visitNode: aNode body. methodBuilder send: #arguments:body:! ! !QQQuasiQuoteTranslator methodsFor: 'visiting' 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:! ! !QQQuasiQuoteTranslator methodsFor: 'visiting' stamp: 'lr 2/29/2008 11:48'! acceptLiteralNode: aNode methodBuilder pushLiteralVariable: RBLiteralNode binding. methodBuilder pushLiteral: aNode value. methodBuilder send: #value:! ! !QQQuasiQuoteTranslator methodsFor: 'visiting' stamp: 'lr 2/29/2008 13:48'! 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: #receiver:selector:arguments:! ! !QQQuasiQuoteTranslator methodsFor: 'visiting' stamp: 'lr 2/29/2008 11:46'! acceptReturnNode: aNode methodBuilder pushLiteralVariable: RBReturnNode binding. self visitNode: aNode value. methodBuilder send: #value:! ! !QQQuasiQuoteTranslator methodsFor: 'visiting' stamp: 'lr 2/29/2008 11:45'! acceptSequenceNode: aNode methodBuilder pushLiteralVariable: RBSequenceNode binding. self visitCollection: aNode temporaries; visitCollection: aNode statements. methodBuilder send: #temporaries:statements:! ! !QQQuasiQuoteTranslator methodsFor: 'visiting' stamp: 'lr 2/29/2008 14:41'! acceptUnquoteNode: aNode valueTranslator visitNode: aNode value! ! !QQQuasiQuoteTranslator methodsFor: 'visiting' stamp: 'lr 2/29/2008 11:51'! acceptVariableNode: aNode methodBuilder pushLiteralVariable: RBVariableNode binding. methodBuilder pushLiteral: aNode name. methodBuilder send: #named:! ! !QQQuasiQuoteTranslator methodsFor: 'accessing' stamp: 'lr 2/29/2008 14:09'! braceSelectors ^ #(braceWith: braceWith:with: braceWith:with:with: braceWith:with:with:with:)! ! !QQQuasiQuoteTranslator methodsFor: 'tools' 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 ] ]! ! !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! ! !LexicalScope methodsFor: '*quasiquote' stamp: 'lr 2/28/2008 21:27'! actualClass ^ outerScope actualClass! ! !RBProgramNode methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 10:46'! parents ^ self parent isNil ifTrue: [ OrderedCollection new ] ifFalse: [ self parent parents addFirst: self parent; yourself ]! ! TestCase subclass: #QQExample instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Tests'! !QQExample class methodsFor: 'fibonacci' stamp: 'lr 2/28/2008 20:57'! fib30 ^ `[RBLiteralNode value: (QQExample fib: 30)]! ! !QQExample class methodsFor: 'fibonacci' stamp: 'lr 2/28/2008 20:41'! fib: n ^ n < 2 ifTrue: [ n ] ifFalse: [ (self fib: n - 1) + (self fib: n - 2) ]! ! !QQExample class methodsFor: 'power' stamp: 'lr 2/28/2008 21:49'! power3: x ^ `[ :x | QQExample power: 3 with: `(x) ]! ! !QQExample class methodsFor: 'power' stamp: 'lr 2/28/2008 23:18'! power: n with: x ^ n isZero ifTrue: [ `( 1 ) ] ifFalse: [ `( x * (self power: n - 1 with: x)) ]! ! !QQExample class methodsFor: 'as yet unclassified' stamp: 'lr 2/29/2008 14:40'! test ^ ``( self foo: ,(RBLiteralNode value: 2))! ! TestCase subclass: #QQTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Tests'! !QQTest methodsFor: 'testing-old' stamp: 'lr 2/28/2008 21:58'! testCancel '`[ `( 1 + 2 ) ]' = 3! ! !QQTest methodsFor: 'testing' stamp: 'lr 2/29/2008 10:43'! testQuasiQuote | ast | ast := QQParser parseExpression: '``(1 + 2)'. self assert: (ast children first isKindOf: QQQuasiQuoteNode). self assert: (ast children first value isKindOf: RBMessageNode). self assert: (ast formattedCode = '``(1 + 2)')! ! !QQTest methodsFor: 'testing' stamp: 'lr 2/29/2008 10:43'! testQuote | ast | ast := QQParser parseExpression: '`(1 + 2)'. self assert: (ast children first isKindOf: QQQuoteNode). self assert: (ast children first value isKindOf: RBMessageNode). self assert: (ast formattedCode = '`(1 + 2)')! ! !QQTest methodsFor: 'testing' stamp: 'lr 2/29/2008 10:43'! testUnquote | ast | ast := QQParser parseExpression: ',(1 + 2)'. self assert: (ast children first isKindOf: QQUnquoteNode). self assert: (ast children first value isKindOf: RBMessageNode). self assert: (ast formattedCode = ',(1 + 2)')! ! !ClassScope methodsFor: '*quasiquote' stamp: 'lr 2/28/2008 21:28'! actualClass ^ class! ! !ASTChecker methodsFor: '*quasiquote-visiting' stamp: 'lr 2/29/2008 11:12'! acceptQuasiQuoteNode: aNode aNode allChildren do: [ :each | (each isKindOf: QQUnquoteNode) ifTrue: [ self visitNode: each ] ]! ! !ASTChecker methodsFor: '*quasiquote-visiting' stamp: 'lr 2/29/2008 11:16'! acceptUnquoteNode: aNode (aNode parents anySatisfy: [ :each | each isKindOf: QQQuasiQuoteNode ]) ifFalse: [ self unquoteNotInQuasiquote: aNode ]. self visitNode: aNode value! ! !ASTChecker methodsFor: '*quasiquote-errors' stamp: 'lr 2/29/2008 10:58'! unquoteNotInQuasiquote: aNode QQUnquoteNotInQuasiquote new node: aNode; signal! ! 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' 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/29/2008 14:34'! 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: #QQQuasiQuoteNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Nodes'! !QQQuasiQuoteNode commentStamp: 'lr 2/29/2008 14:34' prior: 0! Quasi-quote is similar to quote, but it allows parts of the quoted parse-tree to be unquoted. The value of each unquote subform is inserted into the output in place of the unquote form. Example: ``(1 + 2) --> RBMessageNode(1 + 2)! !QQQuasiQuoteNode class methodsFor: 'instance-creation' stamp: 'lr 2/28/2008 21:04'! expression: aNode ^ self new expression: aNode! ! !QQQuasiQuoteNode methodsFor: 'visitor' stamp: 'lr 2/29/2008 10:39'! acceptVisitor: aVisitor ^ aVisitor acceptQuasiQuoteNode: self! ! !QQQuasiQuoteNode methodsFor: 'accessing' stamp: 'lr 2/29/2008 10:12'! prefix ^ '``'! ! 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: 'accessing' stamp: 'lr 2/29/2008 10:12'! 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: 'accessing' stamp: 'lr 2/29/2008 10:13'! prefix ^ ','! ! !RBFormatter methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 10:40'! acceptQuasiQuoteNode: aNode self formatMeta: aNode! ! !RBFormatter methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 10:40'! acceptQuoteNode: 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 10:42'! formatMeta: aNode codeStream nextPutAll: aNode prefix; nextPut: $(. self visitNode: aNode value. codeStream nextPut: $)! ! !IRBuilder methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 13:52'! newTemp "Answer a new temp variable that is unique." | index name | index := 1. [ tempMap includesKey: (name := 't' , index asString) ] whileTrue: [ index := index + 1 ]. self addTemp: name. ^ name! ! RBBlockNode subclass: #QQSpliceNode instanceVariableNames: 'node' 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 class methodsFor: 'instance creation' stamp: 'lr 2/28/2008 15:41'! value: aNode ^ self new value: aNode! ! !QQSpliceNode methodsFor: 'visitor' stamp: 'lr 2/28/2008 20:03'! acceptVisitor: aProgramNodeVisitor ^ aProgramNodeVisitor acceptSpliceNode: self! ! SqueakParser subclass: #QQParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Core'! !QQParser class methodsFor: 'generated-comments' stamp: 'lr 2/29/2008 10:39'! 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: "",("" Expression {#unquote:} | ""``("" Expression {#quasiquote:} | ""`("" Expression {#quote:} | ""("" Expression {#secondWithParenthesis:} | Array {#first:} | Block {#first:} | Literal {#first:} | Variable {#first:}; 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:};"! ! !QQParser class methodsFor: 'generated-accessing' stamp: 'lr 2/29/2008 10:39'! scannerClass ^QQScanner! ! !QQParser class methodsFor: 'generated-starting states' stamp: 'lr 2/29/2008 10:39'! startingStateForMethod ^1! ! !QQParser class methodsFor: 'generated-starting states' stamp: 'lr 2/29/2008 10:39'! startingStateForMethodPattern ^3! ! !QQParser class methodsFor: 'generated-starting states' stamp: 'lr 2/29/2008 10:39'! startingStateForSequence ^2! ! !QQParser methodsFor: 'building' stamp: 'lr 2/29/2008 10:38'! quasiquote: nodes ^ QQQuasiQuoteNode value: (nodes at: 2)! ! !QQParser methodsFor: 'building' stamp: 'lr 2/29/2008 10:39'! quote: nodes ^ QQQuoteNode value: (nodes at: 2)! ! !QQParser methodsFor: 'generated-reduction actions' stamp: 'lr 2/29/2008 10:39'! reduceActionForOptionalXXXperiodX1: nodes ^ nil! ! !QQParser methodsFor: 'generated-reduction actions' stamp: 'lr 2/29/2008 10:39'! reduceActionForOptionalXXXperiodX2: nodes ^ nodes at: 1! ! !QQParser methodsFor: 'generated-tables' stamp: 'lr 2/29/2008 10:39'! reduceTable ^#( #(42 1 #reduceFor:) #(43 1 #variable:) #(44 2 #method:) #(44 3 #methodPragma:) #(44 5 #methodPragmaTempsPragma:) #(44 4 #methodTempsPragma:) #(45 1 #messagePragma:) #(45 1 #messagePragma:) #(45 1 #messagePragma:) #(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 #expressionMissing:) #(53 1 #first:) #(53 3 #cascade:) #(53 3 #cascadeMMissing:) #(54 0 #array) #(54 2 #first:) #(54 5 #returnAdd:) #(54 3 #return:) #(55 3 #array:) #(56 1 #litTrue:) #(56 1 #litFalse:) #(56 1 #litNil:) #(56 1 #litNumber:) #(56 1 #litNumber:) #(56 1 #litChar:) #(56 1 #litString:) #(56 2 #litStringSymbol:) #(56 2 #litSymbol:) #(56 2 #litSymbol:) #(56 2 #litSymbol:) #(56 2 #litSymbol:) #(56 2 #litSymbol:) #(56 4 #litArray:) #(56 4 #litArray:) #(56 1 #litString:) #(57 1 #first:) #(57 1 #first:) #(57 1 #first:) #(58 1 #arrayAddToken:) #(58 3 #secondAddToken:) #(58 3 #verticalBarMissing:) #(59 1 #sequence:) #(59 2 #sequenceWithTemps:) #(60 2 #messageSend:) #(60 2 #messageSend:) #(60 2 #messageSend:) #(61 2 #messageSend:) #(61 2 #messageSend:) #(61 2 #messageSend:) #(62 2 #messageSend:) #(62 2 #messageSend:) #(63 1 #unaryMessage:) #(64 2 #messagePart:) #(64 2 #argumentMissing:) #(65 2 #messagePart:) #(65 2 #argumentMissing:) #(65 3 #addMessagePart:) #(65 3 #argumentMissing:) #(66 1 #first:) #(66 1 #first:) #(66 1 #first:) #(67 1 #first:) #(67 1 #first:) #(68 3 #pragma:) #(68 3 #pragmaEndMissing:) #(68 2 #pragmaMissing:) #(68 4 #pragmas:) #(68 4 #pragmaEndMissing:) #(68 3 #pragmaMissing:) #(69 0 #byteStream) #(69 2 #byteStreamPut:) #(70 0 #stream) #(70 2 #streamPut:) #(71 1 #value:) #(71 1 #valueSymbol:) #(71 1 #valueSymbol:) #(71 1 #valueSymbol:) #(71 1 #valueSymbol:) #(71 1 #valueSymbol:) #(71 3 #contents2:) #(71 3 #contents2:) #(71 1 #valueSymbol:) #(72 3 #unquote:) #(72 3 #quasiquote:) #(72 3 #quote:) #(72 3 #secondWithParenthesis:) #(72 1 #first:) #(72 1 #first:) #(72 1 #first:) #(72 1 #first:) #(73 6 #externalCall:) #(73 8 #externalModuleCall:) #(74 2 #primitiveString:) #(74 2 #primitiveNumber:) #(74 2 #primitiveArgMissing:) #(74 4 #primitiveModule:) #(74 4 #moduleArgMissing:) #(75 1 #pragmaMessage:) #(75 1 #pragmaMessage:) #(75 1 #pragmaUnaryMessage:) #(76 2 #messagePart:) #(76 2 #literalMissing:) #(76 3 #addMessagePart:) #(76 3 #literalMissing:) #(77 2 #messagePart:) #(77 2 #argumentMissing:) #(78 1 #first:) #(78 1 #first:) #(78 1 #first:) #(78 1 #first:) #(79 1 #callConvention:) #(79 1 #callConvention:) #(80 1 #externalType:) #(80 2 #externalTypePointer:) #(81 1 #externalFunction:) #(81 1 #externalIndex:) #(82 1 #parameterExtCall:) #(82 2 #parametersExtCall:) #(85 1 #unaryMessage:) #(85 2 #messagePart:) #(85 2 #argumentNameMissing:) #(85 1 #first:) #(86 1 #first:) #(86 1 #first:) #(86 1 #first:) #(87 2 #messagePart:) #(87 2 #argumentNameMissing:) #(87 3 #addMessagePart:) #(87 3 #argumentNameMissing:) )! ! !QQParser methodsFor: 'generated-tables' stamp: 'lr 2/29/2008 10:39'! transitionTable ^#( #(3 17 25 21 26 25 28 29 44 33 85 37 87) #(3 41 1 45 2 49 4 53 5 57 6 61 9 65 10 69 11 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 121 47 125 49 129 51 133 52 137 53 141 54 145 55 149 56 153 57 157 58 161 59 165 60 169 61 173 62 177 72 130 83) #(3 17 25 21 26 25 28 181 85 37 87) #(2 546 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 33 83) #(3 109 25 185 43 189 84) #(3 109 25 193 43 197 84) #(2 0 83) #(3 41 1 45 2 49 4 53 5 57 6 201 7 61 9 65 10 69 11 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 121 47 125 49 129 51 133 52 137 53 141 54 145 55 149 56 153 57 205 58 209 59 165 60 169 61 173 62 213 68 177 72 130 83) #(3 558 1 558 2 558 4 558 5 558 6 558 7 558 9 558 10 558 11 558 14 558 17 558 18 558 19 558 20 558 21 558 22 558 23 558 24 558 25 217 26 558 33 558 83) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 221 49 129 51 133 52 137 53 145 55 149 56 153 57 165 60 169 61 173 62 177 72) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 225 49 129 51 133 52 137 53 145 55 149 56 153 57 165 60 169 61 173 62 177 72) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 229 49 129 51 133 52 137 53 145 55 149 56 153 57 165 60 169 61 173 62 177 72) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 233 49 129 51 133 52 137 53 145 55 149 56 153 57 165 60 169 61 173 62 177 72) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 237 49 129 51 133 52 137 53 145 55 149 56 153 57 165 60 169 61 173 62 177 72) #(3 41 1 45 2 49 4 53 5 57 6 61 9 65 10 69 11 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 130 36 241 39 117 43 121 47 125 49 245 50 129 51 133 52 137 53 141 54 145 55 149 56 153 57 157 58 249 59 165 60 169 61 173 62 177 72) #(3 42 10 42 25 253 46 42 84) #(2 226 1 2 4 5 6 7 9 14 17 18 19 20 21 22 23 24 25 33 36 83) #(3 41 1 45 2 49 4 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 130 37 117 43 121 47 125 49 129 51 133 52 137 53 257 54 145 55 149 56 153 57 165 60 169 61 173 62 177 72) #(2 210 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(3 261 6 265 9 269 24 273 25 277 26 281 27 285 28 289 30) #(2 150 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 154 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 158 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 162 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 166 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 174 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 10 1 2 4 5 6 7 8 9 10 11 14 17 18 19 20 21 22 23 24 25 26 28 29 33 34 36 37 38 39 40 83 84) #(2 170 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(3 430 25 430 26 430 28 293 29 430 34 430 36 430 37 430 38 430 83) #(3 297 34 58 36 58 37 301 48 58 83) #(2 50 34 36 37 83) #(2 422 25 26 28 34 36 37 38 40 83) #(2 66 34 36 37 38 83) #(3 70 34 70 36 70 37 70 38 305 40 70 83) #(2 238 36 83) #(2 418 25 26 28 34 36 37 38 40 83) #(2 426 25 26 28 34 36 37 38 40 83) #(2 118 34 36 37 38 40 83) #(3 41 1 45 2 49 4 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 130 36 117 43 121 47 125 49 129 51 133 52 137 53 309 54 145 55 149 56 153 57 165 60 169 61 173 62 177 72 130 83) #(2 0 83) #(2 214 34 36 37 38 40 83) #(3 313 26 317 28 218 34 218 36 218 37 218 38 218 40 321 64 325 65 218 83) #(3 329 25 313 26 317 28 222 34 222 36 222 37 222 38 222 40 333 63 337 64 341 65 222 83) #(3 329 25 313 26 317 28 74 34 74 36 74 37 74 38 345 63 349 64 353 65 74 83) #(2 0 83) #(2 574 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 26 33 83) #(2 578 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 26 33 83) #(2 550 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 33 83) #(2 554 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 33 83) #(3 357 3 361 12 365 13 329 25 369 26 373 28 377 45 381 63 385 65 389 73 393 74 397 75 401 76 405 77 409 79 413 84) #(3 41 1 45 2 49 4 53 5 57 6 201 7 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 121 47 125 49 129 51 133 52 137 53 309 54 145 55 149 56 153 57 165 60 169 61 173 62 417 68 177 72 130 83) #(2 14 83) #(3 41 1 45 2 49 4 53 5 57 6 421 7 61 9 65 10 69 11 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 121 47 125 49 129 51 133 52 137 53 141 54 145 55 149 56 153 57 425 58 429 59 165 60 169 61 173 62 177 72 130 83) #(3 109 25 433 43 437 84) #(2 441 38) #(2 445 38) #(3 449 34 58 36 58 37 453 48 58 83) #(2 457 38) #(2 461 38) #(3 109 25 465 43 469 84) #(3 473 10 477 11 481 36 485 39) #(2 489 36) #(3 493 10 109 25 497 43 501 84) #(2 505 37) #(3 358 6 358 9 358 17 358 18 358 19 358 20 358 21 358 22 358 23 358 24 358 25 358 26 358 27 358 28 358 30 358 33 358 38 358 41 509 70) #(3 350 22 350 36 513 69) #(2 178 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 182 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 190 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 194 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 186 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 198 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 517 49 129 51 133 52 137 53 145 55 149 56 153 57 165 60 169 61 173 62 177 72 521 84) #(3 41 1 45 2 525 4 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 62 36 62 37 117 43 529 49 129 51 133 52 137 53 145 55 149 56 153 57 165 60 169 61 173 62 177 72 62 83) #(2 134 36 37 83) #(3 329 25 313 26 317 28 533 63 537 64 541 65 545 84 549 86) #(2 242 36 83) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 553 43 129 51 145 55 149 56 557 61 561 62 565 66 569 72 573 84) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 553 43 129 51 145 55 149 56 577 62 581 67 585 72 589 84) #(2 258 26 28 34 36 37 38 40 83) #(3 593 26 246 34 246 36 246 37 246 38 246 40 246 83) #(2 278 8 25 26 28 34 36 37 38 40 83 84) #(2 270 25 26 28 34 36 37 38 40 83) #(2 262 26 28 34 36 37 38 40 83) #(3 593 26 250 34 250 36 250 37 250 38 250 40 250 83) #(2 274 25 26 28 34 36 37 38 40 83) #(2 266 26 28 34 36 37 38 40 83) #(3 593 26 254 34 254 36 254 37 254 38 254 40 254 83) #(3 597 22 601 24 605 84) #(2 514 25) #(2 518 25) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 609 43 613 51 617 55 621 56 557 61 561 62 565 66 569 72 625 78 629 84) #(3 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 633 43 637 51 641 55 645 56 649 78 653 84) #(3 657 8 661 84) #(2 470 8 84) #(2 665 26) #(2 30 8 84) #(2 34 8 84) #(2 38 8 84) #(2 462 8 84) #(2 466 8 84) #(3 669 25 673 80) #(2 334 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 33 83) #(3 41 1 45 2 49 4 53 5 57 6 421 7 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 121 47 125 49 129 51 133 52 137 53 677 54 145 55 149 56 153 57 165 60 169 61 173 62 177 72 130 83) #(3 357 3 361 12 365 13 329 25 369 26 373 28 681 45 381 63 385 65 389 73 393 74 397 75 401 76 405 77 409 79 685 84) #(3 41 1 45 2 49 4 53 5 57 6 201 7 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 121 47 125 49 129 51 133 52 137 53 309 54 145 55 149 56 153 57 165 60 169 61 173 62 689 68 177 72 130 83) #(2 18 83) #(2 582 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 26 33 83) #(2 586 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 26 33 83) #(2 402 25 26 28 34 36 37 38 40 83) #(2 406 25 26 28 34 36 37 38 40 83) #(2 62 36 37 83) #(2 142 36 37 83) #(2 410 25 26 28 34 36 37 38 40 83) #(2 414 25 26 28 34 36 37 38 40 83) #(2 78 10 11 36 39) #(2 82 10 11 36 39) #(3 41 1 45 2 49 4 53 5 57 6 61 9 65 10 69 11 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 130 36 117 43 121 47 125 49 129 51 133 52 137 53 141 54 145 55 149 56 153 57 157 58 693 59 165 60 169 61 173 62 177 72) #(3 42 10 42 25 697 46) #(2 102 8 25 26 28 34 36 37 38 40 83 84) #(3 109 25 701 43 705 84) #(2 98 8 25 26 28 34 36 37 38 40 83 84) #(2 230 1 2 4 5 6 7 9 14 17 18 19 20 21 22 23 24 25 33 36 83) #(2 46 10 25 84) #(2 234 1 2 4 5 6 7 9 14 17 18 19 20 21 22 23 24 25 33 36 83) #(2 146 8 25 26 28 34 36 37 38 40 83 84) #(3 709 6 713 9 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 717 25 721 26 725 27 729 28 733 30 113 33 737 38 741 41 745 56 749 71) #(3 753 22 757 36) #(2 110 34 36 37 38 83) #(2 114 34 36 37 38 83) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 761 49 129 51 133 52 137 53 145 55 149 56 153 57 165 60 169 61 173 62 177 72) #(2 54 34 36 37 83) #(2 562 34 36 37 38 40 83) #(2 566 34 36 37 38 40 83) #(3 593 26 570 34 570 36 570 37 570 38 570 40 570 83) #(2 126 34 36 37 38 40 83) #(2 122 34 36 37 38 40 83) #(2 430 25 26 28 34 36 37 38 40 83) #(3 306 26 317 28 306 34 306 36 306 37 306 38 306 40 321 64 306 83) #(3 329 25 310 26 317 28 310 34 310 36 310 37 310 38 310 40 333 63 337 64 310 83) #(2 290 26 34 36 37 38 40 83) #(3 329 25 314 26 317 28 314 34 314 36 314 37 314 38 314 40 345 63 349 64 314 83) #(2 294 26 34 36 37 38 40 83) #(3 329 25 318 26 318 28 318 34 318 36 318 37 318 38 318 40 333 63 318 83) #(2 282 26 28 34 36 37 38 40 83) #(3 329 25 322 26 322 28 322 34 322 36 322 37 322 38 322 40 345 63 322 83) #(2 286 26 28 34 36 37 38 40 83) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 553 43 129 51 145 55 149 56 557 61 561 62 765 66 569 72 769 84) #(2 446 8 84) #(3 442 8 773 15 442 84) #(2 450 8 84) #(3 510 8 430 25 430 26 430 28 510 84) #(3 502 8 422 25 422 26 422 28 502 84) #(3 498 8 418 25 418 26 418 28 498 84) #(3 506 8 426 25 426 26 426 28 506 84) #(2 474 8 84) #(3 478 8 294 26 478 84) #(2 510 8 84) #(2 502 8 84) #(2 498 8 84) #(2 506 8 84) #(2 490 8 84) #(2 494 8 84) #(2 326 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 33 83) #(2 330 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 33 83) #(3 41 1 45 2 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 609 43 613 51 617 55 621 56 557 61 561 62 765 66 569 72 777 78 781 84) #(3 785 16 522 22 522 24 522 25 522 38) #(3 789 22 793 24 797 81) #(2 26 83) #(3 801 8 805 84) #(2 346 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 33 83) #(3 41 1 45 2 49 4 53 5 57 6 421 7 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 117 43 121 47 125 49 129 51 133 52 137 53 809 54 145 55 149 56 153 57 165 60 169 61 173 62 177 72 130 83) #(2 813 36) #(3 817 10 109 25 497 43) #(2 86 10 11 36 39) #(2 90 10 11 36 39) #(3 358 6 358 9 358 17 358 18 358 19 358 20 358 21 358 22 358 23 358 24 358 25 358 26 358 27 358 28 358 30 358 33 358 38 358 41 821 70) #(3 350 22 350 36 825 69) #(2 370 6 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 38 41) #(2 378 6 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 38 41) #(2 382 6 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 38 41) #(2 374 6 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 38 41) #(2 386 6 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 38 41) #(2 206 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(2 398 6 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 38 41) #(2 366 6 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 38 41) #(2 362 6 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 38 41) #(2 354 22 36) #(2 202 6 8 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 34 36 37 38 40 41 83 84) #(3 449 34 58 36 58 37 829 48 58 83) #(2 298 26 34 36 37 38 40 83) #(2 302 26 34 36 37 38 40 83) #(3 833 24 837 84) #(2 482 8 84) #(3 486 8 302 26 486 84) #(2 526 22 24 25 38) #(2 534 6) #(2 530 6) #(2 841 6) #(2 338 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 33 83) #(2 342 1 2 4 5 6 7 9 10 11 14 17 18 19 20 21 22 23 24 25 33 83) #(2 22 83) #(2 94 8 25 26 28 34 36 37 38 40 83 84) #(3 41 1 45 2 49 4 53 5 57 6 61 9 73 14 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 109 25 113 33 130 36 117 43 121 47 125 49 129 51 133 52 137 53 845 54 145 55 149 56 153 57 165 60 169 61 173 62 177 72) #(3 709 6 713 9 77 17 81 18 85 19 89 20 93 21 97 22 101 23 105 24 717 25 721 26 725 27 729 28 733 30 113 33 849 38 741 41 745 56 749 71) #(3 753 22 853 36) #(2 138 36 37 83) #(2 454 8 84) #(2 458 8 84) #(3 669 25 857 80 861 82) #(2 865 36) #(2 390 6 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 38 41) #(2 394 6 9 17 18 19 20 21 22 23 24 25 26 27 28 30 33 38 41) #(2 538 25 38) #(3 669 25 869 38 873 80) #(2 106 8 25 26 28 34 36 37 38 40 83 84) #(3 434 8 877 15 434 84) #(2 542 25 38) #(2 881 24) #(2 438 8 84) )! ! !QQParser methodsFor: 'building' stamp: 'lr 2/29/2008 10:38'! unquote: nodes ^ QQUnquoteNode value: (nodes at: 2)! ! !RBProgramNodeVisitor methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 10:40'! acceptQuasiQuoteNode: aNode ! ! !RBProgramNodeVisitor methodsFor: '*quasiquote' stamp: 'lr 2/29/2008 10:40'! acceptQuoteNode: 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! ! SqueakScanner subclass: #QQScanner instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Core'! !QQScanner class methodsFor: 'generated-initialization' stamp: 'lr 2/29/2008 10:39'! initializeKeywordMap keywordMap := Dictionary new. #( #(25 'false' 20 ) #(25 'nil' 21 ) #(25 'true' 19 ) #(26 'apicall:' 12 ) #(26 'cdecl:' 13 ) #(26 'module:' 15 ) #(26 'primitive:' 3 ) #(#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 10:39'! 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 10:39'! assignmentId ^29! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! binarySymbolId ^28! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! characterId ^33! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! colonId ^39! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! emptySymbolTokenId ^83! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! errorTokenId ^84! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! keywordId ^26! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! multikeywordId ^27! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! nameId ^25! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! negativeNumberId ^23! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! numberId ^22! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! periodId ^34! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! rightBoxBracketsId ^36! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! rightCurlyBracketsId ^37! ! !QQScanner methodsFor: 'generated-tokens' stamp: 'lr 2/29/2008 10:39'! rightParenthesesId ^38! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 10:39'! scan1 [ self step. currentCharacter ~= $' ] whileTrue. currentCharacter = $' ifTrue: [ ^ self scan2 ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 10:39'! 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 10:39'! 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 10:39'! scan2 self recordMatch: #(24 ). self step. currentCharacter = $' ifTrue: [ ^ self scan1 ]. ^ self reportLastMatch! ! !QQScanner methodsFor: 'generated-scanner' stamp: 'lr 2/29/2008 10:39'! 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 10:39'! 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 10:39'! 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 10:39'! 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 10:39'! 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 10:39'! 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 10:39'! 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 10:39'! 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 = $+ 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: #(18 41 ). self step. currentCharacter = $: ifTrue: [ ^ self recordAndReportMatch: #(17 ) ]. ^ 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: #(6 41 ) ]. currentCharacter = $) ifTrue: [ ^ self recordAndReportMatch: #(38 41 ) ]. currentCharacter = $* ifTrue: [ self recordMatch: #(16 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 = $( ifTrue: [ ^ self recordAndReportMatch: #(1 ) ]. ^ 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: #(5 ) ]. currentCharacter = $` ifTrue: [ self step. currentCharacter = $( ifTrue: [ ^ self recordAndReportMatch: #(2 ) ]. ^ self reportLastMatch ]. ^ self reportLastMatch ]. currentCharacter = ${ ifTrue: [ ^ self recordAndReportMatch: #(14 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 10:39'! stringId ^24! ! SemanticWarning subclass: #QQUnquoteNotInQuasiquote instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'QuasiQuote-Errors'! !QQUnquoteNotInQuasiquote methodsFor: 'actions' stamp: 'lr 2/29/2008 11:05'! correctIn: aCompiler aCompiler notify: 'Unquote not in quasiquote' at: self node start! ! !QQUnquoteNotInQuasiquote methodsFor: 'accessing' stamp: 'lr 2/29/2008 11:03'! node ^ node! ! !QQUnquoteNotInQuasiquote methodsFor: 'accessing' stamp: 'lr 2/29/2008 11:03'! node: aNode node := aNode! !