#FEATURE by cg
authorClaus Gittinger <cg@exept.de>
Fri, 21 Jun 2019 10:33:02 +0200
changeset 4445 e7ddd0229265
parent 4444 7fe0e4d30943
child 4446 1e31cb48dd3b
#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)
Parser.st
--- 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"