The Inbox: Compiler.quasiliteral-eem.280.mcz

Eliot Miranda uploaded a new version of Compiler to project The Inbox:
http://source.squeak.org/inbox/Compiler.quasiliteral-eem.280.mcz

==================== Summary ====================

Name: Compiler.quasiliteral-eem.280
Author: eem
Time: 4 May 2014, 1:49:28.091 pm
UUID: d6f78930-4e27-4378-ad72-beb74ca0d13d
Ancestors: Compiler-nice.279

[Derived from Compiler-nice.279, and renamed from
 the bogusly named Compiler.quasiquote-eem.248]

Add a quasi-literal form for "string interpolation", that allows
convenient embedding of expressions within a format string,
and provides a convenient way of embedding literal strings
within an alternative literal string syntax whose string delimiter
is different.

e.g.
        `hello [#cruel] world!`
evaluates to
        'hello cruel world'.

        `S1[B1]...SN[BN]SN+1`

is equivalent to
        { 'S1'. [B1] value. ... 'SN'. [BN] value. 'SN+1' } concatenateQuasiLiteral
where concatenateQuasiLiteral sends asString to each
element and answers the concatenation of those elements.

however, single-statement blocks are inlined, so e.g. the
above `hello [#cruel] world!` is compiled as
        { 'hello '. #cruel. ' world!' } concatenateQuasiLiteral

See e.g. Tests.quasiliteral-eem.296 for tests and examples.

=============== Diff against Compiler-nice.279 ===============

Item was added:
+ ----- Method: Array>>concatenateQuasiLiteral (in category '*Compiler-support') -----
+ concatenateQuasiLiteral
+ "This method is used in compilation of quasi-quote constructs.
+ It MUST NOT be deleted or altered."
+
+ | s sz |
+ sz := self size.
+ s := WriteStream on: (String new: sz * 16).
+ 1 to: sz do:
+ [:i| s nextPutAll: (self at: i) asString].
+ ^s contents!

Item was added:
+ ----- Method: Decompiler>>checkForMacroMessage:selector:arguments: (in category 'control') -----
+ checkForMacroMessage: rcvr selector: selector arguments: args
+ ^ (selector == #concatenateQuasiLiteral
+   and: [self checkForQuasiLiteral: rcvr selector: selector arguments: args])
+  or: [(#closureCopy:copiedValues: == selector
+   and: [self checkForClosureCopy: rcvr arguments: args])
+  or: [#blockCopy: == selector
+  and: [self checkForBlockCopy: rcvr]]]!

Item was added:
+ ----- Method: Decompiler>>checkForQuasiLiteral:selector:arguments: (in category 'control') -----
+ checkForQuasiLiteral: rcvr "<BraceNode>" selector: selector "<Symbol>" arguments: args "<Array>"
+ stack addLast:
+ ((MessageNode new
+ receiver: rcvr
+ selector: (SelectorNode new key: #concatenateQuasiLiteral code: nil)
+ arguments: args
+ precedence: 1)
+ notePrintingSelector: #printQuasiLiteralOn:indent:;
+ yourself).
+ ^true!

Item was changed:
  ----- Method: Decompiler>>send:super:numArgs: (in category 'instruction decoding') -----
  send: selector super: superFlag numArgs: numArgs
 
  | args rcvr selNode msgNode messages |
  args := Array new: numArgs.
  (numArgs to: 1 by: -1) do:
  [:i | args at: i put: stack removeLast].
  rcvr := stack removeLast.
  superFlag ifTrue: [rcvr := constructor codeSuper].
+ (self checkForMacroMessage: rcvr selector: selector arguments: args) ifFalse:
- ((#(blockCopy: closureCopy:copiedValues:) includes: selector)
-  and: [self checkForBlock: rcvr selector: selector arguments: args]) ifFalse:
  [selNode := constructor codeAnySelector: selector.
  rcvr == CascadeFlag
  ifTrue:
  ["May actually be a cascade or an ifNil: for value."
  self willJumpIfFalse
  ifTrue: "= generated by a case macro"
  [selector == #= ifTrue:
  [" = signals a case statement..."
  statements addLast: args first.
  stack addLast: rcvr. "restore CascadeFlag"
  ^ self].
  selector == #== ifTrue:
  [" == signals an ifNil: for value..."
  stack removeLast; removeLast.
  rcvr := stack removeLast.
  stack addLast: IfNilFlag;
  addLast: (constructor
  codeMessage: rcvr
  selector: selNode
  arguments: args).
  ^ self]]
  ifFalse:
  [(self willJumpIfTrue and: [selector == #==]) ifTrue:
  [" == signals an ifNotNil: for value..."
  stack removeLast; removeLast.
  rcvr := stack removeLast.
  stack addLast: IfNilFlag;
  addLast: (constructor
  codeMessage: rcvr
  selector: selNode
  arguments: args).
  ^ self]].
  msgNode := constructor
  codeCascadedMessage: selNode
  arguments: args.
  stack last == CascadeFlag ifFalse:
  ["Last message of a cascade"
  statements addLast: msgNode.
  messages := self popTo: stack removeLast.  "Depth saved by first dup"
  msgNode := constructor
  codeCascade: stack removeLast
  messages: messages]]
  ifFalse:
  [msgNode := constructor
  codeMessage: rcvr
  selector: selNode
  arguments: args].
  stack addLast: msgNode]!

Item was changed:
  ----- Method: MessageNode class>>initialize (in category 'class initialization') -----
  initialize
  "MessageNode initialize"
  MacroSelectors :=
  #( ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:
  and: or:
  whileFalse: whileTrue: whileFalse whileTrue
  to:do: to:by:do:
  caseOf: caseOf:otherwise:
  ifNil: ifNotNil:  ifNil:ifNotNil: ifNotNil:ifNil:
+ repeat
+ nil "space for concatenateQuasiLiteral" ).
- repeat ).
  MacroTransformers :=
  #( transformIfTrue: transformIfFalse: transformIfTrueIfFalse: transformIfFalseIfTrue:
  transformAnd: transformOr:
  transformWhile: transformWhile: transformWhile: transformWhile:
  transformToDo: transformToDo:
  transformCase: transformCase:
  transformIfNil: transformIfNil:  transformIfNilIfNotNil: transformIfNotNilIfNil:
+ transformRepeat:
+ nil "space for concatenateQuasiLiteral" ).
- transformRepeat: ).
  MacroEmitters :=
  #( emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
  emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
  emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
  emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value:
  emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value:
  emitCodeForToDo:encoder:value: emitCodeForToDo:encoder:value:
  emitCodeForCase:encoder:value: emitCodeForCase:encoder:value:
  emitCodeForIfNil:encoder:value: emitCodeForIfNil:encoder:value:
  emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
+ emitCodeForRepeat:encoder:value:
+ nil "space for concatenateQuasiLiteral").
- emitCodeForRepeat:encoder:value:).
  MacroSizers :=
  #( sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value:
  sizeCodeForIf:value: sizeCodeForIf:value:
  sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value:
  sizeCodeForToDo:value: sizeCodeForToDo:value:
  sizeCodeForCase:value: sizeCodeForCase:value:
  sizeCodeForIfNil:value: sizeCodeForIfNil:value: sizeCodeForIf:value: sizeCodeForIf:value:
+ sizeCodeForRepeat:value:
+ nil "space for concatenateQuasiLiteral").
- sizeCodeForRepeat:value:).
  MacroPrinters :=
  #( printIfOn:indent: printIfOn:indent: printIfOn:indent: printIfOn:indent:
  printIfOn:indent: printIfOn:indent:
  printWhileOn:indent: printWhileOn:indent: printWhileOn:indent: printWhileOn:indent:
  printToDoOn:indent: printToDoOn:indent:
  printCaseOn:indent: printCaseOn:indent:
  printIfNil:indent: printIfNil:indent: printIfNilNotNil:indent: printIfNilNotNil:indent:
+ printRepeatOn:indent:
+ printQuasiLiteralOn:indent:)!
- printRepeatOn:indent:)!

Item was added:
+ ----- Method: MessageNode>>notePrintingSelector: (in category 'macro transformations') -----
+ notePrintingSelector: printingSelectorSymbol
+ "decompile"
+
+ special := MacroPrinters indexOf: printingSelectorSymbol!

Item was added:
+ ----- Method: MessageNode>>printQuasiLiteralOn:indent: (in category 'printing') -----
+ printQuasiLiteralOn: aStream indent: level
+ aStream nextPut: $`.
+ receiver elements do:
+ [:parseNode|
+ (parseNode isLiteralNode
+ and: [parseNode key class == 'literal' class])
+ ifTrue:
+ [parseNode key do:
+ [:char|
+ ('$`[' includes: char) ifTrue:
+ [aStream nextPut: $$].
+ aStream nextPut: char]]
+ ifFalse:
+ [(parseNode isMessageNode
+  and: [parseNode selector key == #value
+  and: [parseNode receiver isBlockNode]])
+ ifTrue:
+ [parseNode receiver printOn: aStream indent: 0]
+ ifFalse:
+ [aStream nextPut: $[.
+ parseNode printOn: aStream indent: 0.
+ aStream nextPut: $]]]].
+ aStream nextPut: $`!

Item was changed:
  ----- Method: Parser>>advance (in category 'scanning') -----
  advance
  | this |
  prevMark := hereMark.
  prevEnd := hereEnd.
  this := here.
  here := token.
  hereType := tokenType.
  hereMark := mark.
  hereEnd := source position - (aheadChar == DoItCharacter
  ifTrue: [hereChar == DoItCharacter
  ifTrue: [0]
  ifFalse: [1]]
  ifFalse: [2]).
+ hereType ~~ #backQuote ifTrue:
+ [self scanToken].
- self scanToken.
  "Transcript show: 'here: ', here printString, ' mark: ', hereMark printString, ' end: ', hereEnd printString; cr."
  ^this!

Item was added:
+ ----- Method: Parser>>nonQuasiLiteralExpression (in category 'expression types') -----
+ nonQuasiLiteralExpression
+
+ (hereType == #word and: [tokenType == #leftArrow])
+ ifTrue: [^ self assignment: self variable].
+ hereType == #leftBrace
+ ifTrue: [self braceExpression]
+ ifFalse: [self primaryExpression ifFalse: [^ false]].
+ (self messagePart: 3 repeat: true)
+ ifTrue: [hereType == #semicolon ifTrue: [self cascade]].
+ ^ true!

Item was changed:
  ----- Method: Parser>>primaryExpression (in category 'expression types') -----
  primaryExpression
  hereType == #word
  ifTrue:
  [parseNode := self variable.
  (parseNode isUndefTemp and: [self interactive])
  ifTrue: [self queryUndefined].
  parseNode nowHasRef.
  ^ true].
  hereType == #leftBracket
  ifTrue:
  [self advance.
  self blockExpression.
  ^true].
  hereType == #leftBrace
  ifTrue:
  [self braceExpression.
  ^true].
+ hereType == #backQuote
+ ifTrue:
+ [self advance.
+ self quasiLiteralExpression.
+ ^true].
  hereType == #leftParenthesis
  ifTrue:
  [self advance.
  self expression ifFalse: [^self expected: 'expression'].
  (self match: #rightParenthesis)
  ifFalse: [^self expected: 'right parenthesis'].
  ^true].
  (hereType == #string or: [hereType == #number or: [hereType == #literal or: [hereType == #character]]])
  ifTrue:
  [parseNode := encoder encodeLiteral: self advance.
  ^true].
  (here == #- and: [tokenType == #number and: [1 + hereEnd = mark]])
  ifTrue:
  [self advance.
  parseNode := encoder encodeLiteral: self advance negated.
  ^true].
  ^false!

Item was added:
+ ----- Method: Parser>>quasiLiteralExpression (in category 'expression types') -----
+ quasiLiteralExpression
+ "`quasi-quote`
+ => { elements } concatenateQuasiLiteral
+ => MessageNode receiver: BraceNode selector: #concatenateQuasiLiteral.
+
+ The syntax of quasi-quote is
+ quasi-quote := $` (characters | blockExpression) * $`
+ characters := (unescapedCharacter | $\ escapedCharacter) *
+
+ The semantics of quasi-quote are that each blockExpression is evaluated
+ left-to-right in the scope of the enclosing method or block.  The sequence
+ of interspersed character sequences and expressions are concatenated
+ left-to-right, sending asString to each element immediately prior to concatenation.
+ The concatenation is then the result of the expression.  It is always a new string.
+
+ The implementation inlines single-statement blocks into the brace expression that
+ comprises the receiver of concatenateQuasiLiteral"
+
+ | elements locations stringStream loc |
+ elements := OrderedCollection new.
+ locations := OrderedCollection new.
+ stringStream := WriteStream on: (String new: 16).
+ [loc := hereMark + requestorOffset.
+ hereType == #doit ifTrue:
+ [^self expected: 'back quote'].
+ hereType == #leftBracket
+ ifTrue:
+ [self scanToken; advance.
+ parseNode := nil.
+ self blockExpression.
+ parseNode statements size = 1
+ ifTrue:
+ [elements addLast: parseNode statements first]
+ ifFalse:
+ [elements addLast: (MessageNode new
+ receiver: parseNode
+ selector: #value
+ arguments: #()
+ precedence: 1
+ from: encoder)].
+ source position: hereMark - 1.
+ [source peek ~~ $]] whileTrue:
+ [source position: source position - 1].
+ source next.
+ self step; step.
+ self setHereTypeForQuasiLiteral.
+ locations addLast: loc]
+ ifFalse:
+ [(self scanQuasiLiteralCharactersUsing: stringStream) ifNotNil:
+ [:lit|
+ elements addLast: lit.
+ locations addLast: loc]].
+ hereType ~~ #backQuote] whileTrue.
+ parseNode := MessageNode new
+ receiver: (BraceNode new elements: elements sourceLocations: locations)
+ selector: #concatenateQuasiLiteral
+ arguments: #()
+ precedence: 1
+ from: encoder.
+ self scanToken; advance.
+ ^true!

Item was added:
+ ----- Method: Parser>>scanQuasiLiteralCharactersUsing: (in category 'scanning') -----
+ scanQuasiLiteralCharactersUsing: stringStream
+ "Answer the next non-empty sequence of characters in a quasi-quote string, or nil, if none."
+ stringStream reset.
+ [hereChar ~~ $` and: [hereChar ~~ $[ and: [hereChar ~~ DoItCharacter]]] whileTrue:
+ [(hereChar == $$ and: ['`[$' includes: aheadChar])
+ ifTrue:
+ [stringStream nextPut: aheadChar. self step]
+ ifFalse:
+ [stringStream nextPut: hereChar].
+ self step].
+ self setHereTypeForQuasiLiteral.
+ ^stringStream position > 0 ifTrue:
+ [encoder encodeLiteral: stringStream contents]!

Item was added:
+ ----- Method: Parser>>setHereTypeForQuasiLiteral (in category 'scanning') -----
+ setHereTypeForQuasiLiteral
+ "Set hereType appropriately based on hereChar.  Used only for quasi-quote parsing."
+ hereChar == $`
+ ifTrue:
+ [hereType := #backQuote.
+ self step]
+ ifFalse:
+ [hereChar == $[
+ ifTrue:
+ [hereType := #leftBracket.
+ self step]
+ ifFalse:
+ [hereChar == $]
+ ifTrue:
+ [hereType := #rightBracket.
+ self step]
+ ifFalse:
+ [hereChar == DoItCharacter ifTrue:
+ [hereType := #doit]]]]!

Item was changed:
  ----- Method: Scanner class>>initializeTypeTable (in category 'initialization') -----
  initializeTypeTable
  "self initializeTypeTable"
 
  | newTable |
  newTable := Array new: 256 withAll: #xBinary. "default"
  newTable atAll: #(9 10 12 13 32 ) put: #xDelimiter. "tab lf ff cr space"
  newTable atAll: ($0 asciiValue to: $9 asciiValue) put: #xDigit.
 
  1 to: 255
  do: [:index |
  (Character value: index) isLetter
  ifTrue: [newTable at: index put: #xLetter]].
 
  newTable at: $" asciiValue put: #xDoubleQuote.
  newTable at: $# asciiValue put: #xLitQuote.
  newTable at: $$ asciiValue put: #xDollar.
  newTable at: $' asciiValue put: #xSingleQuote.
+ newTable at: $` asciiValue put: #backQuote.
  newTable at: $: asciiValue put: #xColon.
  newTable at: $( asciiValue put: #leftParenthesis.
  newTable at: $) asciiValue put: #rightParenthesis.
  newTable at: $. asciiValue put: #period.
  newTable at: $; asciiValue put: #semicolon.
  newTable at: $[ asciiValue put: #leftBracket.
  newTable at: $] asciiValue put: #rightBracket.
  newTable at: ${ asciiValue put: #leftBrace.
  newTable at: $} asciiValue put: #rightBrace.
  newTable at: $^ asciiValue put: #upArrow.
  newTable at: $_ asciiValue put: #xUnderscore.
  newTable at: $| asciiValue put: #verticalBar.
  TypeTable := newTable "bon voyage!!"!