#FEATURE by cg
class: Parser
added:
#genMakeInlineObjectWith:
#primary_squeakComputedArrayOrComputedInlineObject
#stxComputedInlineObject
removed: #primary_squeakComputedArray
comment/format in:
#inlineObjectFrom:
#squeakComputedArrayExpressions
changed: #primary (send #primary_squeakComputedArrayOrComputedInlineObject instead of #primary_squeakComputedArray)
--- a/Parser.st Tue Jun 11 03:28:00 2019 +0000
+++ b/Parser.st Fri Jun 21 10:33:02 2019 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -7472,7 +7474,8 @@
inlineObjectFrom:pos1
"an experimental ST/X feature.
- InlineObject as #{ name1: value1. ... nameN: valueN }
+ InlineObject as
+ #{ name1: value1. ... nameN: valueN }
creates a literal object with an anon class which provides getter/setters on all
names and is preinitialized with valueI.
The initial #{ is supposed to be skipped and its position passed in as pos1.
@@ -7510,6 +7513,8 @@
].
self nextToken.
^ ConstantNode type:#Object value:(self literalInlineObjectFor:namesAndValues).
+
+ "Modified (comment): / 21-06-2019 / 10:09:22 / Claus Gittinger"
!
keywordExpression
@@ -7875,7 +7880,7 @@
"/ errorFlag := false.
].
].
- ^ self primary_squeakComputedArray.
+ ^ self primary_squeakComputedArrayOrComputedInlineObject.
].
(tokenType == #Primitive) ifTrue:[
@@ -8028,7 +8033,7 @@
"Created: / 13-09-1995 / 12:50:50 / claus"
"Modified: / 01-08-2011 / 12:04:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 26-07-2012 / 11:35:46 / cg"
- "Modified: / 09-06-2019 / 15:24:10 / Claus Gittinger"
+ "Modified: / 21-06-2019 / 10:06:11 / Claus Gittinger"
!
primary_dolphinComputedLiteral
@@ -8699,18 +8704,30 @@
"Modified: / 09-06-2019 / 15:24:17 / Claus Gittinger"
!
-primary_squeakComputedArray
- "parse a squeak computed array literal; return a node-tree, or raise an Error.
- In squeak, these are written as: { expr1 . expr2 . ... exprN )
- and create a message to construct an Array containing the exprI values"
-
- |pos pos2 exprList line1 node|
+primary_squeakComputedArrayOrComputedInlineObject
+ "parse a squeak computed array literal;
+ return a node-tree, or raise an Error.
+ In squeak, these are written as:
+ { expr1 . expr2 . ... exprN }
+ and create a message to construct an Array containing the exprI values.
+ ST/X also supports immediate objects which are instances of anonymous classes,
+ and are written as:
+ { slotName1: expr1 . slotName2: expr2 . ... slotNameN: exprN }
+ "
+
+ |pos pos2 exprList nameExprDict line1 node isComputedArray|
pos := tokenPosition.
line1 := tokenLineNr.
self nextToken.
- exprList := self squeakComputedArrayExpressions.
+ (tokenType == #Keyword) ifTrue:[
+ nameExprDict := self stxComputedInlineObject.
+ isComputedArray := false.
+ ] ifFalse:[
+ exprList := self squeakComputedArrayExpressions.
+ isComputedArray := true.
+ ].
(exprList == #Error) ifTrue:[ ^ #Error ].
tokenType ~~ $} ifTrue:[
@@ -8722,10 +8739,14 @@
(self noAssignmentAllowed:'Invalid assignment' at:pos) ifFalse:[
^ #Error
].
-
- "/ make it an array creation expression ...
- node := (self genMakeArrayWith:exprList)
- startPosition:pos endPosition:pos2.
+ isComputedArray ifTrue:[
+ "/ make it an array creation expression ...
+ node := self genMakeArrayWith:exprList.
+ ] ifFalse:[
+ "/ make it an inline object creation expression ...
+ node := self genMakeInlineObjectWith:nameExprDict.
+ ].
+ node startPosition:pos endPosition:pos2.
node lineNumber:line1.
^ node
@@ -8741,9 +8762,7 @@
Compiler allowSqueakExtensions:false.
"
- "Modified: / 27-07-2011 / 15:56:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 22-08-2012 / 13:20:58 / cg"
- "Modified: / 19-08-2018 / 11:17:34 / Claus Gittinger"
+ "Created: / 21-06-2019 / 10:06:06 / Claus Gittinger"
!
primary_super
@@ -8927,7 +8946,12 @@
!
squeakComputedArrayExpressions
- "parse a squeak array expression's '{' expr... '}' list of exprs."
+ "parse a squeak computed array literal;
+ return a node-tree, or raise an Error.
+ In squeak, these are written as:
+ { expr1 . expr2 . ... exprN }
+ and create a message to construct an Array containing the exprI values.
+ "
|expressions elem pos1|
@@ -8958,6 +8982,7 @@
"/ not reached
"Created: / 19-08-2018 / 11:13:42 / Claus Gittinger"
+ "Modified (comment): / 21-06-2019 / 09:50:18 / Claus Gittinger"
!
stringWithEmbeddedExpressions
@@ -9004,6 +9029,48 @@
"Modified: / 09-06-2019 / 15:21:58 / Claus Gittinger"
!
+stxComputedInlineObject
+ "parse an ST/X immediate object, which is an instance of an anonymous class,
+ and written as:
+ { slotName1: expr1 . slotName2: expr2 . ... slotNameN: exprN }
+ "
+
+ |nameExprDict slotName elemExpr pos1|
+
+ tokenType == $} ifTrue:[
+ ^ #()
+ ].
+
+ pos1 := tokenPosition.
+ nameExprDict := OrderedDictionary new.
+ [
+ (tokenType == #Keyword) ifFalse:[
+ self syntaxError:'slotname (keyword) expected' position:pos1 to:tokenPosition
+ ].
+ slotName := token.
+ self nextToken.
+ elemExpr := self expression.
+ (elemExpr == #Error) ifTrue:[
+ (tokenType == #EOF) ifTrue:[
+ self syntaxError:'unterminated computed-inline-object; ''}'' expected'
+ position:pos1 to:tokenPosition
+ ].
+ ^ #Error
+ ].
+ nameExprDict at:slotName put:elemExpr.
+ tokenType == $. ifFalse:[
+ ^ nameExprDict
+ ].
+ self nextToken.
+ tokenType == $} ifTrue:[
+ ^ nameExprDict
+ ].
+ ] loop.
+ "/ not reached
+
+ "Created: / 21-06-2019 / 09:51:31 / Claus Gittinger"
+!
+
typedArray:typeSymbol
"parse a typed array's elements.
This is an ST/X extension, which is not supported by other Smalltalk implementations.
@@ -10550,6 +10617,23 @@
"Modified: / 01-08-2011 / 12:38:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+genMakeInlineObjectWith:nameExpressionDictionary
+ "return a node to generate an inline object at runtime"
+
+ |class classNode arrayNode node slotNames expressions|
+
+ slotNames := nameExpressionDictionary keys collect:#asSymbol.
+ expressions := nameExpressionDictionary values.
+
+ class := self inlineObjectClassFor:slotNames.
+ classNode := ConstantNode type:#Object value:class.
+ arrayNode := self genMakeArrayWith:expressions.
+ node := MessageNode receiver:arrayNode selector:#'changeClassTo:' arg:classNode.
+ ^ node
+
+ "Created: / 21-06-2019 / 10:08:18 / Claus Gittinger"
+!
+
inWhichClassIsClassInstVar:aString
"search class-chain for the class-instance variable named aString
- return the class or nil if not found"