Hi All,
I had fun implementing a quasi-quote for Squeak today.
This is a convenient way of embedding substrings in format
strings (a little like printf), and, because it uses a different
quote character, a convenient way of embedding code form other
languages in a string literal.
An example of the former usage is
`hello [#cruel] world`
which evaluates to
'hello cruel world'
And
`Float pi is [Float pi]`
evaluates to
'Float pi is 3.141592653589793'
An example of the latter use is that one can write
`printf("%s: %c\\n", "a string", 'C');`
instead of
'printf("%s: %c\n", "a string", ''C'');'
This last example shows a limitation; The use of \ to escape
characters ($\ $[ and $`) in quasi-quote might not be such a
good choice.
Anyway I thought I'd put this in the in-box for people to
play with and savage. Please let me know what you think, both
about the semantics and the implementation. This is a quick
hack and I'm sure that there's plenty of scope for clean-up.
cheers
Eliot
On Tue, Feb 5, 2013 at 9:54 PM,
<commits@source.squeak.org>
wrote:
A new
version of Compiler was added to project The Inbox:
http://source.squeak.org/inbox/Compiler.quasiquote-eem.248.mcz
==================== Summary ====================
Name: Compiler.quasiquote-eem.248
Author: eem
Time: 5 February 2013, 9:54:20.317 pm
UUID: ef044906-3339-48cc-856b-9b5172e3e81b
Ancestors: Compiler-cwp.247
Add a quasi-quote form that allows convenient embedding
of substrings within a format string, and provides a
convenient way of embedding literal strings within an
alternative literal string 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' }
concatenateQuasiQuote
where concatenateQuasiQuote 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!' }
concatenateQuasiQuote
See Tests.quasiquote-eem.188 for tests and examples.
=============== Diff against Compiler-cwp.247
===============
Item was added:
+ ----- Method: Array>>concatenateQuasiQuote (in
category '*Compiler-support') -----
+ concatenateQuasiQuote
+ "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 removed:
- ----- Method:
Decompiler>>checkForBlock:selector:arguments: (in
category 'control') -----
- checkForBlock: receiver selector: selector arguments:
arguments
- selector == #blockCopy: ifTrue:
- [^self checkForBlockCopy: receiver].
- self assert: selector == #closureCopy:copiedValues:.
- ^self checkForClosureCopy: receiver arguments:
arguments!
Item was added:
+ ----- Method:
Decompiler>>checkForMacroMessage:selector:arguments:
(in category 'control') -----
+ checkForMacroMessage: rcvr selector: selector arguments:
args
+ ^ (selector == #concatenateQuasiQuote
+ and: [self checkForQuasiQuote: 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>>checkForQuasiQuote:selector:arguments: (in
category 'control') -----
+ checkForQuasiQuote: rcvr "<BraceNode>" selector:
selector "<Symbol>" arguments: args "<Array>"
+ stack addLast:
+ ((MessageNode new
+ receiver: rcvr
+ selector: (SelectorNode new
key: #concatenateQuasiQuote code: nil)
+ arguments: args
+ precedence: 1)
+ notePrintingSelector:
#printQuasiQuoteOn: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
concatenateQuasiQuote" ).
- repeat ).
MacroTransformers :=
#( transformIfTrue: transformIfFalse:
transformIfTrueIfFalse: transformIfFalseIfTrue:
transformAnd: transformOr:
transformWhile: transformWhile:
transformWhile: transformWhile:
transformToDo: transformToDo:
transformCase: transformCase:
transformIfNil: transformIfNil:
transformIfNilIfNotNil: transformIfNotNilIfNil:
+ transformRepeat:
+ nil "space for
concatenateQuasiQuote" ).
- 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
concatenateQuasiQuote").
- 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
concatenateQuasiQuote").
- 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:
+ printQuasiQuoteOn: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>>printQuasiQuoteOn:indent:
(in category 'printing') -----
+ printQuasiQuoteOn: 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 changed:
----- Method: Parser>>expression (in category
'expression types') -----
expression
+ (hereType == #word and: [tokenType == #leftArrow])
ifTrue:
+ [^self assignment: self variable].
+ hereType == #backQuote
+ ifTrue: [self quasiQuoteExpression]
+ ifFalse:
+ [hereType == #leftBrace
+ ifTrue: [self
braceExpression]
+ ifFalse:
+ [self
primaryExpression ifFalse:
+ [^false]]].
+ (self messagePart: 3 repeat: true) ifTrue:
+ [hereType == #semicolon ifTrue:
+ [self cascade]].
+ ^true!
- (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 added:
+ ----- Method: Parser>>nonQuasiQuoteExpression (in
category 'expression types') -----
+ nonQuasiQuoteExpression
+
+ (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 added:
+ ----- Method: Parser>>quasiQuoteExpression (in
category 'expression types') -----
+ quasiQuoteExpression
+ "`quasi-quote`
+ => { elements } concatenateQuasiQuote
+ => MessageNode receiver:
BraceNode selector: #concatenateQuasiQuote.
+
+ 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 concatenateQuasiQuote"
+
+ | 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 setHereTypeForQuasiQuote.
+ locations addLast: loc]
+ ifFalse:
+ [(self
scanQuasiQuoteCharactersUsing: stringStream) ifNotNil:
+ [:lit|
+ elements addLast: lit.
+ locations addLast: loc]].
+ hereType ~~ #backQuote] whileTrue.
+ parseNode := MessageNode new
+ receiver: (BraceNode
new elements: elements sourceLocations: locations)
+ selector:
#concatenateQuasiQuote
+ arguments: #()
+ precedence: 1
+ from: encoder.
+ self scanToken; advance.
+ ^true!
Item was changed:
+ ----- Method: Parser>>queriedUnusedTemporaries (in
category 'temps') -----
- ----- Method: Parser>>queriedUnusedTemporaries (in
category 'accessing') -----
queriedUnusedTemporaries
queriedUnusedTemporaries ifNil:
[queriedUnusedTemporaries := Dictionary
new].
^queriedUnusedTemporaries!
Item was added:
+ ----- Method: Parser>>scanQuasiQuoteCharactersUsing:
(in category 'scanning') -----
+ scanQuasiQuoteCharactersUsing: 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 == $\
+ ifTrue:
+ [stringStream nextPut:
aheadChar. self step]
+ ifFalse:
+ [stringStream nextPut:
hereChar].
+ self step].
+ self setHereTypeForQuasiQuote.
+ ^stringStream position > 0 ifTrue:
+ [encoder encodeLiteral: stringStream
contents]!
Item was added:
+ ----- Method: Parser>>setHereTypeForQuasiQuote (in
category 'scanning') -----
+ setHereTypeForQuasiQuote
+ "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 ==
DoItCharacter ifTrue:
+ [hereType :=
#doit]]]!
Item was changed:
+ ----- Method: Parser>>tempsMark (in category
'temps') -----
- ----- Method: Parser>>tempsMark (in category
'accessing') -----
tempsMark
^ tempsMark!
Item was changed:
+ ----- Method: Parser>>tempsMark: (in category
'temps') -----
- ----- Method: Parser>>tempsMark: (in category
'accessing') -----
tempsMark: aNumber
tempsMark := aNumber!
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!!"!
--
best,
Eliot