[Ometa] First pass at OMeta in OMeta2

[Frank Shearar]

I have implemented a first pass at an OMeta2 grammar of the legacy =

OMeta. (Yes, I am too lazy to convert by hand my several hundred rule =

Delphi grammar!)

Please find attached some code, with tests, that hopefully isn't =

unusably horrible.

I also extended OMeta2Compiler a bit. I added a new selector =

#compile:in:notifying:ifFail:using:. The last parameter of this selector =

is a reference to the kind of rules you'll be passing. In particular, we =

have

compile: origCode in: cls notifying: notify ifFail: failBlock
    ^ self compile: origCode in: cls notifying: notify ifFail: failBlock =

using: OMeta2RuleParser.

and

compileLegacy: origCode in: cls notifying: notify ifFail: failBlock
    ^ self compile: origCode in: cls notifying: notify ifFail: failBlock =

using: OMeta1RuleParser.

Lastly, OMeta2RuleParser and OMeta1RuleParser each have a class-side =

method called rootRule that returns the name of each "main" production: =

#production for OMeta1RuleParser, and #rule for OMeta2RuleParser.

The tests have one thing I don't like: they should really show that the =

OMeta1 rules produce the same parse tree as the OMeta2 rules by actually =

producing those trees in the test. So instead of, for instance,

testParseSymbol
    self assertParses: '  #foo ' as: '#foo' using: #symbol.
    self assertParses: '#foo123' as: '#foo123' using: #symbol.
    self assertParses: '#''foo''' as: '#foo' using: #symbol.

the tests should really be saying something like

    self assertParsesIdentically: ' #foo ' using: #symbol

where

assertParsesIdentically: aString and: a2String using: aRule
    ^ self assertEquals: (OMeta1RuleParser matchAll: aString with: =

aRule) collection: (OMeta2RuleParser matchAll: a2String with: aRule)

or something similar.

Like I say, it's a first pass. I've tested it against random rules in my =

Delphi grammar, but I've not attempted exhaustive testing. That's the =

next step.

frank
-------------- next part --------------
'From Squeak3.10.2 of ''5 June 2008'' [latest update: #7179] on 3 June 2009=
 at 8:08:20 pm'!
Smalltalk renameClassNamed: #OMeta1RuleTranslator as: #OMeta1RuleParser!
OMeta2 subclass: #OMeta1RuleParser
	instanceVariableNames: 'grammarClass locals'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'OMeta2'!
TestCase subclass: #TestOMeta1RuleParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'OMeta2-Tests'!

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 6/3/2009 15=
:19'!
application =3D

	spaces $< name:prod argument*:args spaces $>
		-> [OrderedCollection new add: #App; add: prod asSymbol; addAll: args; yo=
urself]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 6/3/2009 15=
:15'!
argument =3D
	spaces hostLanguageTinyExpression! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/24/2009 1=
1:53'!
character =3D
	spaces $$ char:x -> [{#App. #exactly. x storeString.}]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/24/2009 1=
1:53'!
expr =3D
	expr4:x (token('|') expr4)*:xs -> [(OrderedCollection with: #Or) add: x; a=
ddAll: xs; yourself]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/25/2009 1=
2:08'!
expr1 =3D

	application
|	semanticAction
|	semanticPredicate
|	( keyword('nil')	| keyword('true')	| keyword('false')
	| number			| string			| character
	| symbol													):x	-> [{#App. #exactly. x}]
|	token('"') (~$" char)*:cs $"										-> [OrderedCollection new
																			add: #And;
																			addAll: (cs collect: [:c |
																				{#App. #exactly. c storeString}
																			]);
																			add: {#Action. (String withAll: cs) storeString};
																			yourself]
|	token('(') expr:x token(')')										-> [x]
|	token('{') token('}')												-> [{#Form. {#action. 'true'}}]
|	token('{') expr:x token('}')										-> [{#Form. x}]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/25/2009 1=
2:07'!
expr2 =3D

	token('~') expr2:x	-> [{#Not. x}]
|	token('&') expr1:x	-> [{#Lookahead. x}]
|	expr1! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/25/2009 1=
2:09'!
expr3 =3D

	expr2:r
		(	token('*') [{#Many. r}]:r
		|	token('+') [{#Many1. r}]:r
		|	empty						)
		(	$: name:n [locals add: n asSymbol] [{#Set. n. r}]:r
		|	empty													)	-> [r]
|	token(':') name:n [locals add: n asSymbol]							-> [{#Set. n. {#App. #an=
ything}}]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/25/2009 1=
2:05'!
expr4 =3D

	expr3*:xs -> [OrderedCollection new add: #And; addAll: xs; yourself]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 6/3/2009 14=
:09'!
hostLanguageExpression =3D

	foreign(O2SqueakRecognizer. #squeakExpr):r
		(token('.') foreign(O2SqueakRecognizer. #squeakExpr):s [r, '. ', s]:r)*
		-> [r]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 6/3/2009 15=
:15'!
hostLanguageTinyExpression =3D
	foreign(O2SqueakRecognizer. #squeakExpr)! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/23/2009 2=
2:01'!
initialize

	super initialize.
	locals :=3D Set new.! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/30/2009 2=
2:05'!
keyword :xs =3D

	spaces seq(xs) ~(letter | digit)		-> [xs]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 6/3/2009 20=
:03'!
name =3D

	spaces letter:x (letter | digit)*:xs -> [((String with: x), (String withAl=
l: xs)) asSymbol]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/23/2009 2=
2:04'!
number =3D

	spaces digit+:ip
		(	$. digit+:fp	-> [(String withAll: ip), '.', (String withAll: fp)]
		|	empty			-> [String withAll: ip]						)! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 6/3/2009 14=
:29'!
production =3D

	&(name:name)
		productionPart(name):x
		(token(';') productionPart(name))*:xs
		spaces end
		-> [{#Rule. name asSymbol. locals asArray. (OrderedCollection with: #Or w=
ith: x) addAll: xs; yourself}]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/25/2009 1=
2:10'!
productionPart :requiredName =3D

	name:name ?[name =3D requiredName]
		expr4:body
		(	token('::=3D') expr:rhs	-> [{#And. body. rhs}]
		|	empty					-> [body]			  )! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/26/2009 2=
1:37'!
semanticAction
	| e |
	self ometaOr: {
		[self apply: #token withArgs: {'=3D>'}].
		[self apply: #token withArgs: {'!!'}].
	}.
	self apply: #token withArgs: {'['}.
	e :=3D self apply: #hostLanguageExpression.
	self apply: #exactly withArgs: {$]}.
	^ {#Act. e}! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/23/2009 2=
2:06'!
semanticPredicate =3D

	token('?[') hostLanguageExpression:r token(']')	-> [{#pred. r}]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/23/2009 2=
2:18'!
string =3D
	spaces $' (~$' char)*:s $' -> [(String withAll: s) printString]! !

!OMeta1RuleParser methodsFor: 'as yet unclassified' stamp: 'fbs 5/23/2009 2=
2:07'!
symbol =3D

	spaces $#
		(	name
		|	string:s -> [s copyFrom: 2 to: s size - 1] ):n
		-> [n asSymbol printString]! !


!OMeta1RuleParser class methodsFor: 'compiling' stamp: 'fbs 6/3/2009 14:45'!
rootRule
	^ #production.! !


!OMeta2Compiler methodsFor: 'as yet unclassified' stamp: 'fbs 6/3/2009 14:4=
2'!
compile: origCode in: cls notifying: notify ifFail: failBlock
	^ self compile: origCode in: cls notifying: notify ifFail: failBlock using=
: OMeta2RuleParser.! !

!OMeta2Compiler methodsFor: 'as yet unclassified' stamp: 'fbs 6/3/2009 14:4=
4'!
compile: origCode in: cls notifying: notify ifFail: failBlock using: rulePa=
rser

	| origCodeStream parseTree structuredCode translatedCode |
	origCodeStream :=3D origCode asString readStream.
	self from: origCodeStream class: cls context: nil notifying: notify.
	[
		parseTree :=3D ruleParser matchStream: origCodeStream with: (ruleParser r=
ootRule) withArgs: #() withPlaybackDebugging: false.
		parseTree :=3D OMeta2Optimizer match: parseTree with: #optimizeRule.
		structuredCode :=3D OMeta2RuleTranslator match: parseTree with: #translat=
e withArgs: {cls}.
		translatedCode :=3D OMeta2Flattener match: structuredCode with: #flatten
	] on: OM2Fail do: [
		self notify: '<-- parse error around here -->' at: origCodeStream positio=
n.
		^ failBlock value
	].
	^ Compiler new
		compile: translatedCode readStream
		in: cls
		notifying: notify
		ifFail: failBlock! !

!OMeta2Compiler methodsFor: 'as yet unclassified' stamp: 'fbs 6/3/2009 14:4=
2'!
compileLegacy: origCode in: cls notifying: notify ifFail: failBlock
	^ self compile: origCode in: cls notifying: notify ifFail: failBlock using=
: OMeta1RuleParser.! !


!OMeta2RuleParser class methodsFor: 'compiling' stamp: 'fbs 6/3/2009 14:46'!
rootRule
	^ #rule.! !


!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 5/30/2009 21:19'!
testParseAnything
	self assertParses: 'a' as: $a using: #anything.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 15:37'!
testParseApplication
	self assertParses: '<token ''foo''>' as: {#App. #token. '''foo'''.} using:=
 #application.
	self assertParses: '<token foo>' as: {#App. #token. 'foo'.} using: #applic=
ation.
	self assertParses: '<listOf #foo ''bar'' 2>' as: {#App. #listOf. '#foo'. '=
''bar'''. '2'} using: #application.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/2/2009 21:34'!
testParseCharacter
	self assertParses: ' $c ' as: {#App. #exactly. 'c' first storeString.} usi=
ng: #character! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 15:50'!
testParseExpr1
	self assertParses: '<token ''foo''>' as: {#App. #token. '''foo'''.} using:=
 #expr1.
	=

	self assertParses: '=3D>[nil]' as: {#Act. 'nil'.} using: #expr1.
	=

	self assertParses: '  ?[3 + 4] ' as: {#pred. '3 + 4'.} using: #semanticPre=
dicate.
	=

	self assertParses: 'nil' as: {#App. #exactly. 'nil'} using: #expr1.
	self assertParses: 'true' as: {#App. #exactly. 'true'} using: #expr1.
	self assertParses: 'false' as: {#App. #exactly. 'false'} using: #expr1.
	self assertParses: '123' as: {#App. #exactly. '123'} using: #expr1.
	self assertParses: '''foo''' as: {#App. #exactly. '''foo'''} using: #expr1.
	self assertParses: '$c' as: {#App. #exactly. {#App. #exactly. '$c'}} using=
: #expr1.
	self assertParses: '#foo' as: {#App. #exactly. '#foo'} using: #expr1.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 15:50'!
testParseExpr1Braces
	self assertParses: '{<rule>}'
		as:
			{#Form.
				{#Or.
					{#And.
						{#App. #rule.}}}}
		using: #expr1.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 09:41'!
testParseExpr1EmptyBraces
	self assertParses: '{}'
		as:
			{#Form.
				{#action. 'true'}}
		using: #expr1.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 09:39'!
testParseExpr1Parens
	self assertParses: '(#foo)'
		as:
			{#Or.
				{#And.
					{#App. #exactly. '#foo'}.}.}
		using: #expr1.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 09:38'!
testParseExpr1String
	self assertParses: '"foo"'
		as:
			{#And.
				{#App. #exactly. '$f'}.
				{#App. #exactly. '$o'}.
				{#App. #exactly. '$o'}.
				{#Action. '''foo'''}}
		using: #expr1.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 09:29'!
testParseExpr2
	self assertParses: '~$c' as: {#Not. {#App. #exactly. {#App. #exactly. '$c'=
}}} using: #expr2.

	self assertParses: '&$c' as: {#Lookahead. {#App. #exactly. {#App. #exactly=
. '$c'}}} using: #expr2.

	self assertParses: '$c' as: {#App. #exactly. {#App. #exactly. '$c'}} using=
: #expr2.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 20:03'!
testParseExpr3
	self assertParses: '$c*' as: {#Many. {#App. #exactly. {#App. #exactly. '$c=
'}}} using: #expr3.
	self assertParses: '$c+' as: {#Many1. {#App. #exactly. {#App. #exactly. '$=
c'}}} using: #expr3.	=


	self assertParses: '$c' as: {#App. #exactly. {#App. #exactly. '$c'}} using=
: #expr3.
	=

	self assertParses: '<foo>:n' as: {#Set. #n. {#App. #foo.}} using: #expr3.
	=

	self assertParses: ':n' as: {#Set. #n. {#App. #anything.}} using: #expr3.
! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 13:17'!
testParseExpr4
	self assertParses: '' as: {#And.} using: #expr4.

	self
		assertParses: '$c* $c+'
		as:
			{#And.
				{#Many. {#App. #exactly. {#App. #exactly. '$c'}}}.
				{#Many1. {#App. #exactly. {#App. #exactly. '$c'}}}}
		using: #expr4.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 14:10'!
testParseHostLanguageExpression
	self assertParses: '3 + 4' as: '3 + 4' using: #hostLanguageExpression.
	self assertParses: 'OrderedCollection new' as: 'OrderedCollection new' usi=
ng: #hostLanguageExpression.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 15:51'!
testParseHostLanguageTinyExpression
	self assertParses: '(3 + 4)' as: '(3 + 4)' using: #hostLanguageTinyExpress=
ion.
	self assertParses: '{3. 4.}' as: '{3. 4.}' using: #hostLanguageTinyExpress=
ion.
	self assertParses: '[OrderedCollection new]' as: '[OrderedCollection new]'=
 using: #hostLanguageTinyExpression.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 13:41'!
testParseKeyword
	self assertParses: '  foo123 ' as: 'foo123' using: #keyword withArguments:=
 {'foo123'}.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 20:03'!
testParseName
	self assertParses: 'a' as: #a using: #name.
	self assertParses: ' a ' as: #a using: #name.
	self assertParses: 'foo1' as: #foo1 using: #name.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 5/30/2009 21:21'!
testParseNumber
	self assertParses: ' 1' as: '1' using: #number.
	self assertParses: '1234.5678' as: '1234.5678' using: #number.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 20:00'!
testParseProduction
	self
		assertParses: 'empty ::=3D =3D>[t]'
		as: {#Rule. #empty. {}.
				{#Or.
					{#And.
						{#And.}.
						{#Or. {#And. {#Act. 't'}}}}}}
		using: #production.
	=

	self
		assertParses: 'name :a :b ::=3D <token a> <token b>'
		as:
			{#Rule. #name. #(#b #a).
				{#Or.
					{#And.
					{#And.
						{#Set. #a. {#App. #anything}}.
						{#Set. #b. {#App. #anything}}}.
					{#Or.
						{#And.
							{#App. #token. 'a'}.
							{#App. #token. 'b'}}}}}}
		using: #production.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 20:04'!
testParseProductionPart
	self assertParses: 'name' as: {#And} using: #productionPart withArguments:=
 {'name'}.
	=

	self
		assertParses: 'name :a :b ::=3D <token a> <token b>'
		as:
			{#And.
				{#And.
					{#Set. #a. {#App. #anything}}.
					{#Set. #b. {#App. #anything}}}.
				{#Or.
					{#And.
						{#App. #token. 'a'}.
						{#App. #token. 'b'}}}}
		using: #productionPart withArguments: {'name'}.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 14:10'!
testParseSemanticAction
	self assertParses: '=3D>[nil]' as: {#Act. 'nil'.} using: #semanticAction.
	self assertParses: '!![nil]' as: {#Act. 'nil'.} using: #semanticAction.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 14:11'!
testParseSemanticPredicate
	self assertParses: '  ?[3 + 4] ' as: {#pred. '3 + 4'} using: #semanticPred=
icate.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 5/30/2009 21:23'!
testParseString
	self assertParses: '  ''foo'' ' as: '''foo''' using: #string.
	self assertParses: '''I am a String''' as: '''I am a String''' using: #str=
ing.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 5/30/2009 21:25'!
testParseSymbol
	self assertParses: '  #foo ' as: '#foo' using: #symbol.
	self assertParses: '#foo123' as: '#foo123' using: #symbol.
	self assertParses: '#''foo''' as: '#foo' using: #symbol.! !

!TestOMeta1RuleParser methodsFor: 'test-rules' stamp: 'fbs 6/3/2009 13:41'!
testParseToken
	self assertParses: ' abc ' as: 'abc' using: #token withArguments: {'abc'}.=
! !

!TestOMeta1RuleParser methodsFor: 'private' stamp: 'fbs 5/28/2009 16:03'!
assertEquals: seqA collection: seqB
	self assertEquals: seqA collection: seqB description: ''.! !

!TestOMeta1RuleParser methodsFor: 'private' stamp: 'fbs 6/3/2009 14:38'!
assertEquals: expected collection: received description: aString
	"Assert that SequenceableCollections expected, receive each contain equal =
(not necessarily identical) data, recursively."
	=

	self assert: expected isCollection =3D received isCollection description: =
aString.
	=

	"Strings should not be equal to Symbols."
	self assert: expected isSymbol =3D received isSymbol description: aString.
	=

	expected isCollection ifFalse:
		[^ self assert: expected =3D received description: aString].

	self assert: (expected size =3D received size) description: aString.
	=

	1 to: expected size do:
		[:i | self
			assertEquals: (expected at: i)
			collection: (received at: i)
			description: aString].! !

!TestOMeta1RuleParser methodsFor: 'private' stamp: 'fbs 5/30/2009 21:19'!
assertParses: inputString as: aCollection using: aRule
	self
		assertEquals: aCollection
		collection: ((OMeta1RuleParser matcherOn: inputString readStream)
			apply: aRule)
		description: aRule asString.! !

!TestOMeta1RuleParser methodsFor: 'private' stamp: 'fbs 5/30/2009 21:26'!
assertParses: inputString as: aCollection using: aRule withArguments: args
	self
		assertEquals: aCollection
		collection: ((OMeta1RuleParser matcherOn: inputString readStream)
			apply: aRule withArgs: args)
		description: aRule asString.! !

!TestOMeta1RuleParser methodsFor: 'test-self' stamp: 'fbs 6/3/2009 14:38'!
testAssertEqualsCollectionDescription
	self assertEquals: #() collection: #() description: 'empty collection'.
	self assertEquals: #() collection: OrderedCollection new description: 'emp=
ty collection, different species'.
	self assertEquals: 'foo' collection: #($f $o $o) description: 'strings and=
 collections'.

	self
		should: [self assertEquals: 'foo' collection: #foo description: 'Strings =
<> Symbols']
		raise: TestResult failure
		withExceptionDo: [:unused|].! !

TestOMeta1RuleParser removeSelector: #testAssertEqualsCollection!
TestOMeta1RuleParser removeSelector: #testCharacter!

!TestOMeta1RuleParser reorganize!
('test-rules' testParseAnything testParseApplication testParseCharacter tes=
tParseExpr1 testParseExpr1Braces testParseExpr1EmptyBraces testParseExpr1Pa=
rens testParseExpr1String testParseExpr2 testParseExpr3 testParseExpr4 test=
ParseHostLanguageExpression testParseHostLanguageTinyExpression testParseKe=
yword testParseName testParseNumber testParseProduction testParseProduction=
Part testParseSemanticAction testParseSemanticPredicate testParseString tes=
tParseSymbol testParseToken)
('private' assertEquals:collection: assertEquals:collection:description: as=
sertParses:as:using: assertParses:as:using:withArguments:)
('test-self' testAssertEqualsCollectionDescription)
!


!OMeta2RuleParser class reorganize!
('as yet unclassified' isOMeta2Rule:)
('compiling' rootRule)
!

OMeta2RuleParser removeSelector: #rootRule!

!OMeta2RuleParser reorganize!
('as yet unclassified' application args characterLiteral characters expr ex=
pr1 expr2 expr3 expr4 initialize keyword name nameFirst nameRest nsName num=
berLiteral optIter rule rulePart semanticAction semanticPredicate space squ=
eakExpression stringLiteral symbolLiteral tokenSugar)
!


!OMeta1RuleParser class reorganize!
('compiling' rootRule)
!

OMeta1RuleParser removeSelector: #rootRule!
OMeta1RuleParser removeSelector: #token!

!OMeta1RuleParser reorganize!
('as yet unclassified' application argument character expr expr1 expr2 expr=
3 expr4 hostLanguageExpression hostLanguageTinyExpression initialize keywor=
d name number production productionPart semanticAction semanticPredicate st=
ring symbol)
!