--- a/Parser.st Tue May 06 16:03:55 2003 +0200
+++ b/Parser.st Tue May 06 19:45:51 2003 +0200
@@ -3738,51 +3738,6 @@
"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|
@@ -4148,207 +4103,6 @@
"Modified: / 31.3.1998 / 17:31:59 / cg"
!
-parsePrimitive
- "parse an ST-80 type primitive as '< primitive: nr >';
- return primitive number or #Error.
- or a Squeak-style primitive, as '< primitive: string >';
- return primitive name or #Error.
-
- Also, ST-80 style resource specs are parsed; the result is
- left (as side effect) in primitiveResource.
- (maybe someone else knows what to do with it ...)
- Well, as we now have this mechanism, I'll use it to mark methods which
- do keyboard processing ... <resource: keyboard ( keys )>
- For faster finding of used keyboard accelerators,
- and to mark resource methods (image, menu or canvas resources).
-
- prim ::= st80Primitive | st80Pragma | stxPragma
- squeakPrimitive | newSTXPrimitive | resourceDecl
-
- st80Primitive ::= 'primitive:' INTEGER
- st80Pragma ::= 'exception:' ( 'handle | 'raise' | 'unwind' )
- stxPragma ::= 'context:' 'return'
-
- squeakPrimitive ::= 'primitive:' STRING
-
- newSTXPrimitive ::= 'primitive'
-
- resourceDecl ::= 'resource:' SYMBOL - leave SYMBOL in primitiveResource
- | 'resource:' SYMBOL (...) - leave (SYMBOL (...)) in primitiveResource
- "
-
- |primNumber cString cParser cType|
-
- (tokenType == #Keyword or:[tokenType == #Identifier]) ifFalse:[
- self parseError:'bad primitive definition (keyword expected)'.
- ^ #Error
- ].
-
- (tokenName = 'primitive:') ifTrue:[
- self nextToken.
- (tokenType == #Integer) ifFalse:[
- allowSqueakExtensions ifTrue:[
- (tokenType == #String) ifFalse:[
- self parseError:'primitive number or name expected'.
- ^ #Error
- ]
- ] ifFalse:[
- self parseError:'primitive number expected'.
- ^ #Error
- ]
- ].
- primitiveNr notNil ifTrue:[
- self parseError:'only one primitive spec allowed'.
- primNumber := -1.
- ] ifFalse:[
- primNumber := tokenValue.
- ].
- self nextToken.
- ((tokenType == #BinaryOperator) and:[tokenName = '>']) ifFalse:[
- ((tokenType == #Keyword) and:[tokenName = 'errorCode:']) ifTrue:[
- self nextToken.
- (tokenType == #Identifier) ifTrue:[
- self nextToken.
- ] ifFalse:[
- self error:'not yet implemented'.
- ]
- ].
- ]
- ] ifFalse:[
- (tokenName = 'primitive') ifTrue:[
- self nextToken.
- primNumber := 0.
- ] ifFalse:[
- (tokenName = 'resource:') ifTrue:[
- self parseResourcePragma.
- primNumber := -1.
- ] ifFalse:[
- (tokenName = 'exception:'
- or:[tokenName = 'context:']) ifTrue:[
- self parseExceptionOrContextPragma.
- ] ifFalse:[
- (tokenName = 'C:') ifTrue:[
- ^ self parseCPragma.
- ] ifFalse:[
- (tokenName = 'api:') ifTrue:[
- ^ self parseApiPragma.
- ] ifFalse:[
- (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.
- ].
- ].
- ].
- ].
- ]
- ].
- ].
- ].
-
- ((tokenType == #BinaryOperator) and:[tokenName = '>']) ifFalse:[
- self parseError:'bad primitive definition (> expected)'.
- ^ #Error
- ].
- self nextToken.
- ^ primNumber
-
- "Modified: 29.5.1996 / 17:24:09 / cg"
-!
-
-parsePrimitiveOrResourceSpecOrEmpty
- "parse a methods primitive or resource spec"
-
- |pos wmsg primNr primNrOrString|
-
- [(tokenType == #BinaryOperator) and:[tokenName = '<']] whileTrue:[
- "/ an ST-80 primitive or resourceSpec - parsed but ignored
-
- pos := tokenPosition.
- self nextToken.
- primNrOrString := self parsePrimitive.
-
- (primNrOrString == #Error) ifTrue:[^ #Error].
- wmsg := nil.
-
- primNrOrString isString ifTrue:[
- primNr := self primitiveNumberFromName:primNrOrString
- ] ifFalse:[
- primNr := primNrOrString
- ].
-
- primNr notNil ifTrue:[
- primNr < 0 ifTrue:[
- WarnST80Directives == true ifTrue:[
- wmsg := 'ST-80/Squeak directive ignored'.
- ].
- ] ifFalse:[
- primNr > 0 ifTrue:[
- primitiveNr := primNr.
- wmsg := 'ST-80 primitive may not work'
- ] ifFalse:[
- primitiveNr := primNr.
- wmsg := 'ST/X primitives only work in rel5 and newer'
- ]
- ].
- ].
- wmsg notNil ifTrue:[self warning:wmsg position:pos]
- ].
-
- "Created: 27.4.1996 / 16:55:55 / cg"
- "Modified: 29.5.1996 / 17:25:52 / cg"
-!
-
-parseResourcePragma
- |keys resource resourceValue|
-
- "/ < resource: has already been parsed.
-
- self nextToken.
- (tokenType ~~ #Symbol) ifTrue:[
- self parseError:'symbol expected'.
- ^ #Error
- ].
-
- resource := tokenValue.
- resourceValue := true.
-
- self nextToken.
-
- tokenType == $( ifTrue:[
- self nextToken.
- keys := OrderedCollection new.
- [(tokenType == $)) or:[tokenType == #EOF] ] whileFalse:[
- keys add:tokenValue.
- self nextToken.
- ].
- resourceValue := keys.
- (tokenType == $)) ifFalse:[
- self parseError:'unterminated primitive/spec (missing '')'')'.
- ].
- self nextToken.
- ].
-
- primitiveResource isNil ifTrue:[
- primitiveResource := IdentityDictionary new.
- ].
- primitiveResource at:(resource asSymbol) put:resourceValue.
-!
-
-primitiveNumberFromName:aPrimitiveName
- "for future compatibility with Squeak ..."
-
- ^ nil
-!
-
statement
"parse a statement; return a node-tree or #Error.
@@ -6545,6 +6299,257 @@
"Modified: / 5.11.2001 / 16:45:35 / cg"
! !
+!Parser methodsFor:'parsing-primitives & pragmas'!
+
+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 new.
+ cParser source:(cString , ';').
+ cParser nextToken.
+ cType := cParser type.
+
+ primitiveResource "primitiveType" := cType.
+ ^ -1
+!
+
+parsePrimitive
+ "parse an ST-80 type primitive as '< primitive: nr >';
+ return primitive number or #Error.
+ or a Squeak-style primitive, as '< primitive: string >';
+ return primitive name or #Error.
+
+ Also, ST-80 style resource specs are parsed; the result is
+ left (as side effect) in primitiveResource.
+ (maybe someone else knows what to do with it ...)
+ Well, as we now have this mechanism, I'll use it to mark methods which
+ do keyboard processing ... <resource: keyboard ( keys )>
+ For faster finding of used keyboard accelerators,
+ and to mark resource methods (image, menu or canvas resources).
+
+ prim ::= st80Primitive | st80Pragma | stxPragma
+ squeakPrimitive | newSTXPrimitive | resourceDecl
+
+ st80Primitive ::= 'primitive:' INTEGER
+ st80Pragma ::= 'exception:' ( 'handle | 'raise' | 'unwind' )
+ stxPragma ::= 'context:' 'return'
+
+ squeakPrimitive ::= 'primitive:' STRING
+
+ newSTXPrimitive ::= 'primitive'
+
+ resourceDecl ::= 'resource:' SYMBOL - leave SYMBOL in primitiveResource
+ | 'resource:' SYMBOL (...) - leave (SYMBOL (...)) in primitiveResource
+ "
+
+ |primNumber cString cParser cType|
+
+ (tokenType == #Keyword or:[tokenType == #Identifier]) ifFalse:[
+ self parseError:'bad primitive definition (keyword expected)'.
+ ^ #Error
+ ].
+
+ (tokenName = 'primitive:') ifTrue:[
+ self nextToken.
+ (tokenType == #Integer) ifFalse:[
+ allowSqueakExtensions ifTrue:[
+ (tokenType == #String) ifFalse:[
+ self parseError:'primitive number or name expected'.
+ ^ #Error
+ ]
+ ] ifFalse:[
+ self parseError:'primitive number expected'.
+ ^ #Error
+ ]
+ ].
+ primitiveNr notNil ifTrue:[
+ self parseError:'only one primitive spec allowed'.
+ primNumber := -1.
+ ] ifFalse:[
+ primNumber := tokenValue.
+ ].
+ self nextToken.
+ ((tokenType == #BinaryOperator) and:[tokenName = '>']) ifFalse:[
+ ((tokenType == #Keyword) and:[tokenName = 'errorCode:']) ifTrue:[
+ self nextToken.
+ (tokenType == #Identifier) ifTrue:[
+ self nextToken.
+ ] ifFalse:[
+ self error:'not yet implemented'.
+ ]
+ ].
+ ]
+ ] ifFalse:[
+ (tokenName = 'primitive') ifTrue:[
+ self nextToken.
+ primNumber := 0.
+ ] ifFalse:[
+ (tokenName = 'resource:') ifTrue:[
+ self parseResourcePragma.
+ primNumber := -1.
+ ] ifFalse:[
+ (tokenName = 'exception:'
+ or:[tokenName = 'context:']) ifTrue:[
+ self parseExceptionOrContextPragma.
+ ] ifFalse:[
+ (tokenName = 'C:') ifTrue:[
+ ^ self parseCPragma.
+ ] ifFalse:[
+ (tokenName = 'api:') ifTrue:[
+ ^ self parseApiPragma.
+ ] ifFalse:[
+ (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.
+ ].
+ ].
+ ].
+ ].
+ ]
+ ].
+ ].
+ ].
+
+ ((tokenType == #BinaryOperator) and:[tokenName = '>']) ifFalse:[
+ self parseError:'bad primitive definition (> expected)'.
+ ^ #Error
+ ].
+ self nextToken.
+ ^ primNumber
+
+ "Modified: 29.5.1996 / 17:24:09 / cg"
+!
+
+parsePrimitiveOrResourceSpecOrEmpty
+ "parse a methods primitive or resource spec"
+
+ |pos wmsg primNr primNrOrString|
+
+ [(tokenType == #BinaryOperator) and:[tokenName = '<']] whileTrue:[
+ "/ an ST-80 primitive or resourceSpec - parsed but ignored
+
+ pos := tokenPosition.
+ self nextToken.
+ primNrOrString := self parsePrimitive.
+
+ (primNrOrString == #Error) ifTrue:[^ #Error].
+ wmsg := nil.
+
+ primNrOrString isString ifTrue:[
+ primNr := self primitiveNumberFromName:primNrOrString
+ ] ifFalse:[
+ primNr := primNrOrString
+ ].
+
+ primNr notNil ifTrue:[
+ primNr < 0 ifTrue:[
+ WarnST80Directives == true ifTrue:[
+ wmsg := 'ST-80/Squeak directive ignored'.
+ ].
+ ] ifFalse:[
+ primNr > 0 ifTrue:[
+ primitiveNr := primNr.
+ wmsg := 'ST-80 primitive may not work'
+ ] ifFalse:[
+ primitiveNr := primNr.
+ wmsg := 'ST/X primitives only work in rel5 and newer'
+ ]
+ ].
+ ].
+ wmsg notNil ifTrue:[self warning:wmsg position:pos]
+ ].
+
+ "Created: 27.4.1996 / 16:55:55 / cg"
+ "Modified: 29.5.1996 / 17:25:52 / cg"
+!
+
+parseResourcePragma
+ |keys resource resourceValue|
+
+ "/ < resource: has already been parsed.
+
+ self nextToken.
+ (tokenType ~~ #Symbol) ifTrue:[
+ self parseError:'symbol expected'.
+ ^ #Error
+ ].
+
+ resource := tokenValue.
+ resourceValue := true.
+
+ self nextToken.
+
+ tokenType == $( ifTrue:[
+ self nextToken.
+ keys := OrderedCollection new.
+ [(tokenType == $)) or:[tokenType == #EOF] ] whileFalse:[
+ keys add:tokenValue.
+ self nextToken.
+ ].
+ resourceValue := keys.
+ (tokenType == $)) ifFalse:[
+ self parseError:'unterminated primitive/spec (missing '')'')'.
+ ].
+ self nextToken.
+ ].
+
+ primitiveResource isNil ifTrue:[
+ primitiveResource := IdentityDictionary new.
+ ].
+ primitiveResource at:(resource asSymbol) put:resourceValue.
+!
+
+primitiveNumberFromName:aPrimitiveName
+ "for future compatibility with Squeak ..."
+
+ ^ nil
+! !
+
!Parser methodsFor:'private'!
currentNameSpace
@@ -7321,7 +7326,7 @@
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.384 2003-05-06 13:58:52 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.385 2003-05-06 17:45:51 cg Exp $'
! !
Parser initialize!