# HG changeset patch
# User Claus Gittinger <cg@exept.de>
# Date 1052223696 -7200
# Node ID f888caa1f2d8ccdc0d1bd686b86818113234f157
# Parent  f008ac0eca464e7bd009b8e7999aef6a348b0bc4
refactored primitive-decl parsing;
preps for arrayindexing expression

diff -r f008ac0eca46 -r f888caa1f2d8 Parser.st
--- a/Parser.st	Tue May 06 14:15:02 2003 +0200
+++ b/Parser.st	Tue May 06 14:21:36 2003 +0200
@@ -37,7 +37,8 @@
 		ParseErrorSignal RestartCompilationSignal
 		AllowFunctionCallSyntaxForBlockEvaluation AllowLazyValueExtension
 		AllowVariableReferences AllowReservedWordsAsSelectors
-		AllowLocalVariableDeclarationWithInitializerExpression'
+		AllowLocalVariableDeclarationWithInitializerExpression
+		AllowArrayIndexSyntax'
 	poolDictionaries:''
 	category:'System-Compiler'
 !
@@ -3737,6 +3738,51 @@
     "Created: / 17.11.2001 / 10:23:47 / cg"
 !
 
+parseApiPragma
+    |cString|
+
+    cString := source upTo:$>.
+    self nextToken.
+    "/ TODO: generate that interface ...
+    ^ -1
+!
+
+parseCDeclPragma
+    |cString cStream cParser returnType functionName argTypes|
+
+    cString := source upTo:$>.
+    self nextToken.
+    cStream := cString readStream.
+
+    cParser := CParser new.
+    cParser source:cStream scannerClass:CDeclScanner.
+    cParser nextToken.
+    returnType := cParser type.
+
+    cParser tokenType ~~ #String ifTrue:[
+        self parseError:'invalid cdecl - functionName expected'.
+        ^ -1
+    ].
+    functionName := cParser token.
+    cParser nextToken.
+    argTypes := cParser parseFunctionArgumentSpec.
+self halt.
+    "/ TODO: generate that ffi-calling code ...
+    ^ -1
+!
+
+parseCPragma
+    |cString cParser cType|
+
+    cString := source upTo:$>.
+    self nextToken.
+    "/ TODO: generate that type
+    cParser := CParser parse:(cString , ';').
+    cType := cParser types first.
+    primitiveResource "primitiveType" := cType.
+    ^ -1
+!
+
 parseExceptionOrContextPragma
     |pragmaType|
 
@@ -4182,29 +4228,24 @@
                     self parseExceptionOrContextPragma.    
                 ] ifFalse:[
                     (tokenName = 'C:') ifTrue:[
-                        cString := source upTo:$>.
-                        self nextToken.
-                        "/ TODO: generate that type
-                        cParser := CParser parse:(cString , ';').
-                        cType := cParser types first.
-                        primitiveResource "primitiveType" := cType.
-                        ^ -1
+                        ^ self parseCPragma.    
                     ] ifFalse:[
                         (tokenName = 'api:') ifTrue:[
-                            cString := source upTo:$>.
-                            self nextToken.
-                            "/ TODO: generate that interface ...
-                            ^ -1
+                            ^ self parseApiPragma.    
                         ] ifFalse:[
-                            self parseError:'unrecognized pragma: ' , tokenName.
-
-                            "/ skip
-                            [tokenType ~~ #EOF] whileTrue:[
-                                ((tokenType == #BinaryOperator) and:[tokenName = '>']) ifTrue:[
+                            (tokenName = 'cdecl:') ifTrue:[
+                                ^ self parseCDeclPragma.
+                            ] ifFalse:[
+                                self parseError:'unrecognized pragma: ' , tokenName.
+
+                                "/ skip
+                                [tokenType ~~ #EOF] whileTrue:[
+                                    ((tokenType == #BinaryOperator) and:[tokenName = '>']) ifTrue:[
+                                        self nextToken.
+                                        ^ -1 "/ primNr.
+                                    ].
                                     self nextToken.
-                                    ^ -1 "/ primNr.
                                 ].
-                                self nextToken.
                             ].
                         ].
                     ].
@@ -4643,6 +4684,87 @@
     "Modified: / 14.4.1998 / 18:22:54 / cg"
 !
 
+arrayIndexingExpression
+    "parse an array index expression; this is a squeak/stx extension.
+     foo[idx] is syntactic sugar for foo matrixAt:x
+     and foo[idx] := expr is syntactic sugar for foo matrixAt:x put:expr"
+
+    |receiver argList  evalSelector selectorStream
+     valNode|
+
+    receiver := self functionCallExpression.
+    tokenType == $[ ifFalse:[^ receiver].
+    AllowArrayIndexSyntax == true ifFalse:[^ receiver.].
+    (receiver == #Error) ifTrue:[^ #Error].
+
+"/    receiver isVariable ifFalse:[
+"/        ((receiver isMessage or:[receiver isAssignment]) and:[receiver parenthized]) ifFalse:[
+"/            receiver isBlock ifFalse:[
+"/                ^ receiver
+"/            ]
+"/        ].
+"/    ].
+
+    selectorStream := WriteStream on: (String new: 32).
+    argList := OrderedCollection new.
+    [      
+        |indexNode|
+
+        self nextToken.
+        indexNode := self primary.
+        argList isEmpty
+            ifTrue:[selectorStream nextPutAll:'matrixAt:']
+            ifFalse:[selectorStream nextPutAll:'at:'].
+        argList add: indexNode.
+        tokenType == $, 
+    ] whileTrue.
+    tokenType == $] ifFalse:[ 
+        self parseError:''']'' expected'.
+        ^ #Error
+    ].
+    self nextToken.
+
+    tokenType == #':=' ifTrue:[
+        self nextToken.
+        selectorStream nextPutAll:'put:'.
+        valNode := self expression.
+        valNode == #Error ifTrue:[
+            ^ valNode
+        ].
+"/        (valNode isKindOf: BlockNode) ifFalse:[
+"/                valNode _ BlockNode new
+"/                                        arguments: #()
+"/                                        statements: (OrderedCollection with: valNode)
+"/                                        returns: false
+"/                                        from: encoder.
+"/        ].
+        argList add: valNode
+    ].
+    evalSelector := selectorStream contents.
+
+    ^ MessageNode 
+            receiver:receiver 
+            selector:evalSelector
+            args:argList.
+
+    "
+     AllowArrayIndexSyntax := true.
+    "
+
+    "
+     |foo|
+
+     foo := Array new:10.
+     1 + foo[1].     
+    "
+    "
+     |foo|
+
+     foo := Array new:10.
+     foo[1] := 'hello'.     
+    "
+!
+
 binaryExpression
     "parse a binary-expression; return a node-tree, nil or #Error"
 
@@ -4699,6 +4821,7 @@
         arg := self unaryExpression.
         (arg == #Error) ifTrue:[^ #Error].
         theReceiver := receiver.
+
         try := BinaryNode receiver:receiver selector:sel arg:arg fold:foldConstants.
         (try isMemberOf:String) ifTrue:[
             self parseError:try position:pos to:tokenPosition.
@@ -4790,7 +4913,7 @@
         ^ sel
     ].
 
-    (rec := self functionCallExpression) ~~ #Error ifTrue:[
+    (rec := self arrayIndexingExpression) ~~ #Error ifTrue:[
         sel := self degeneratedKeywordExpressionForSelector.
         sel isNil ifTrue:[
             rec isMessage ifTrue:[
@@ -6103,7 +6226,7 @@
 
     |receiver|
 
-    receiver := self functionCallExpression.
+    receiver := self arrayIndexingExpression.
     (receiver == #Error) ifTrue:[^ #Error].
     ^ self unaryExpressionFor:receiver
 !
@@ -7201,7 +7324,7 @@
 !Parser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.381 2003-04-21 15:58:11 martin Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.382 2003-05-06 12:21:36 cg Exp $'
 ! !
 
 Parser initialize!