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

Eliot Miranda eliot.miranda at gmail.com
Wed Feb 6 06:16:46 UTC 2013


On Tue, Feb 5, 2013 at 10:14 PM, Eliot Miranda <eliot.miranda at gmail.com>wrote:

> 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.
>

And while I have it compiling, reporting errors, running and decompiling, I
don't have it syntax highlighting yet.


>
> 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
>



-- 
best,
Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20130205/b0984bd9/attachment.htm


More information about the Squeak-dev mailing list