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!