The Trunk: ShoutCore-mt.78.mcz

Marcel Taeumel uploaded a new version of ShoutCore to project The Trunk:
http://source.squeak.org/trunk/ShoutCore-mt.78.mcz

==================== Summary ====================

Name: ShoutCore-mt.78
Author: mt
Time: 12 June 2020, 5:28:15.527851 pm
UUID: 7decada5-8996-304c-ba9c-a93b00f0cc33
Ancestors: ShoutCore-mt.77

Complements Compiler-mt.436 (inbox).

Adds a (extension) method-based hook to install custom pragma-parsing methods. Use it to move FFI-specific pragma-parsing, i.e. <apicall: ...> and <cdecl: ...>, into FFI packages.

=============== Diff against ShoutCore-mt.77 ===============

Item was removed:
- ----- Method: SHParserST80>>isTokenExternalFunctionCallingConvention (in category 'token testing') -----
- isTokenExternalFunctionCallingConvention
-
- currentToken ifNil: [ ^false ].
- ^(Smalltalk classNamed: #ExternalFunction)
- ifNil: [ false ]
- ifNotNil: [ :descriptorClass |
- (descriptorClass callingConventionFor: currentToken) notNil ]!

Item was removed:
- ----- Method: SHParserST80>>parseExternalCall (in category 'parse') -----
- parseExternalCall
- [self scanNext.
- ((Smalltalk at: #ExternalFunction) callingConventionModifierFor: currentToken) notNil]
- whileTrue.
- self failUnless: currentToken notNil.
- self scanPast: #externalCallType.
- currentToken = '*'
- ifTrue: [self scanPast: #externalCallTypePointerIndicator].
- currentTokenFirst isDigit
- ifTrue: [self scanPast: #integer]
- ifFalse: [
- self failUnless: currentTokenFirst == $'.
- self parseString].
- self failUnless: currentTokenFirst == $(.
- self scanPast: #leftParenthesis.
- [currentTokenFirst ~= $)]
- whileTrue: [
- self failUnless: currentToken notNil.
- self scanPast: #externalCallType.
- currentToken = '*'
- ifTrue: [self scanPast: #externalCallTypePointerIndicator]].
- self scanPast: #rightParenthesis.
- currentToken = 'module:'
- ifTrue: [
- self scanPast: #module.
- self parseStringOrSymbol ].
- currentToken = 'error:' ifTrue: [
- self scanPast: #primitive. "there's no rangeType for error"
- self currentTokenType == #name
- ifTrue: [ self parseTemporary: #patternTempVar ]
- ifFalse: [ self parseStringOrSymbol ] ].
- self failUnless: currentToken = '>'.
- self scanPast: #primitiveOrExternalCallEnd!

Item was changed:
+ ----- Method: SHParserST80>>parsePragmaBinary (in category 'parse pragma') -----
- ----- Method: SHParserST80>>parsePragmaBinary (in category 'parse') -----
  parsePragmaBinary
 
  self scanPast: #pragmaBinary.
  self currentTokenType == #name
  ifTrue:[self scanPast: (self resolvePragmaArgument: currentToken)]
  ifFalse:[ self parseLiteral: false].
  self failUnless: currentToken = '>'.
  self scanPast: #primitiveOrExternalCallEnd!

Item was changed:
+ ----- Method: SHParserST80>>parsePragmaKeyword (in category 'parse pragma') -----
- ----- Method: SHParserST80>>parsePragmaKeyword (in category 'parse') -----
  parsePragmaKeyword
 
  [self currentTokenType == #keyword]
  whileTrue:[
  self scanPast: #pragmaKeyword.
  self currentTokenType == #name
  ifTrue:[self scanPast: (self resolvePragmaArgument: currentToken)]
  ifFalse:[ self parseLiteral: false]].
  self failUnless: currentToken = '>'.
  self scanPast: #primitiveOrExternalCallEnd!

Item was changed:
+ ----- Method: SHParserST80>>parsePragmaSequence (in category 'parse pragma') -----
- ----- Method: SHParserST80>>parsePragmaSequence (in category 'parse') -----
  parsePragmaSequence
+
  [currentToken = '<' ]
+ whileTrue: [
- whileTrue:[
  self scanPast: #primitiveOrExternalCallStart.
+ self parsePragmaStatement].!
- currentToken = 'primitive:'
- ifTrue: [
- self addRangeType: #primitive.
- self parsePrimitive]
- ifFalse:[
- self isTokenExternalFunctionCallingConvention
- ifTrue: [
- self addRangeType: #externalFunctionCallingConvention.
- self parseExternalCall]
- ifFalse:[
- self currentTokenType
- caseOf: {
- [ #name ] -> [
- self scanPast: #pragmaUnary.
- self failUnless: currentToken = '>'.
- self scanPast: #primitiveOrExternalCallEnd ].
- [ #binary ] -> [ self parsePragmaBinary ].
- [ #keyword ] -> [ self parsePragmaKeyword ] }
- otherwise: [ self fail ": 'Invalid External Function Calling convention'" ] ] ] ]!

Item was added:
+ ----- Method: SHParserST80>>parsePragmaStatement (in category 'parse pragma') -----
+ parsePragmaStatement
+
+ | parserSelector parserMethod |
+ currentToken last == $: ifFalse: [
+ "Quick exit to not break one-word pragmas such as <primitive> or <foobar>."
+ ^ self parsePragmaStatementKeywords].
+
+ (self class includesSelector: (parserSelector := currentToken asSimpleGetter)) ifTrue: [
+ ((parserMethod := self class compiledMethodAt: parserSelector) pragmas
+ anySatisfy: [:pragma | pragma keyword == #pragmaParser])
+ ifTrue: [^ self executeMethod: parserMethod]].
+
+ ^ self parsePragmaStatementKeywords!

Item was added:
+ ----- Method: SHParserST80>>parsePragmaStatementKeywords (in category 'parse pragma') -----
+ parsePragmaStatementKeywords
+
+ self currentTokenType
+ caseOf: {
+ [ #name ] -> [
+ self scanPast: #pragmaUnary.
+ self failUnless: currentToken = '>'.
+ self scanPast: #primitiveOrExternalCallEnd ].
+ [ #binary ] -> [ self parsePragmaBinary ].
+ [ #keyword ] -> [ self parsePragmaKeyword ] }
+ otherwise: [ self fail ": 'Invalid External Function Calling convention'" ]. !

Item was removed:
- ----- Method: SHParserST80>>parsePrimitive (in category 'parse') -----
- parsePrimitive
-
- self scanNext.
- currentTokenFirst isDigit
- ifTrue: [ self scanPast: #integer ]
- ifFalse: [
- self parseStringOrSymbol.
- currentToken = 'module:' ifTrue: [
- self scanPast: #module.
- self parseStringOrSymbol ] ].
- currentToken = 'error:' ifTrue: [
- self scanPast: #primitive. "there's no rangeType for error"
- self currentTokenType == #name
- ifTrue: [ self parseTemporary: #patternTempVar ]
- ifFalse: [ self parseStringOrSymbol ] ].
- self failUnless: currentToken = '>'.
- self scanPast: #primitiveOrExternalCallEnd!

Item was added:
+ ----- Method: SHParserST80>>primitive (in category 'parse pragma') -----
+ primitive
+ "Parse keywords and literals of primitive pragmas differently to emit different range tokens for different UI styling. This hook exists so that packages do not break primitive-pragma parsing by accident. Instead, this method needs to be replaced intentionally."
+ <pragmaParser>
+
+ self addRangeType: #primitive.
+
+ self scanNext.
+ currentTokenFirst isDigit
+ ifTrue: [ self scanPast: #integer ]
+ ifFalse: [
+ self parseStringOrSymbol.
+ currentToken = 'module:' ifTrue: [
+ self scanPast: #module.
+ self parseStringOrSymbol ] ].
+ currentToken = 'error:' ifTrue: [
+ self scanPast: #primitive. "there's no rangeType for error"
+ self currentTokenType == #name
+ ifTrue: [ self parseTemporary: #patternTempVar ]
+ ifFalse: [ self parseStringOrSymbol ] ].
+ self failUnless: currentToken = '>'.
+ self scanPast: #primitiveOrExternalCallEnd!