[squeak-dev] The Inbox: Compiler.quasiquote-eem.248.mcz

Eliot Miranda eliot.miranda at gmail.com
Wed Feb 6 06:14:59 UTC 2013


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 at 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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20130205/442da8b2/attachment-0001.htm


More information about the Squeak-dev mailing list