# HG changeset patch # User Jan Vrany # Date 1442940218 -3600 # Node ID fa42d3f1a57846f701639511fe4ccc16297f284c # Parent 97090c2baa33fc3f7a9b0995de2c9c6ba5059593 Removed syntax for inline assembly, use syntax. This one is easier to implement and less introusive, syntax-wise. And follows Smalltalk tradiiton. diff -r 97090c2baa33 -r fa42d3f1a578 compiler/Make.proto --- a/compiler/Make.proto Sun Sep 20 12:01:42 2015 +0100 +++ b/compiler/Make.proto Tue Sep 22 17:43:38 2015 +0100 @@ -135,15 +135,11 @@ $(OUTDIR)TCompilerError.$(O) TCompilerError.$(H): TCompilerError.st $(INCLUDE_TOP)/stx/libbasic/Error.$(H) $(INCLUDE_TOP)/stx/libbasic/Exception.$(H) $(INCLUDE_TOP)/stx/libbasic/GenericException.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TEnvironmentProvider.$(O) TEnvironmentProvider.$(H): TEnvironmentProvider.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TFormatter.$(O) TFormatter.$(H): TFormatter.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBFormatter.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) -$(OUTDIR)TInlineAssemblyBeginToken.$(O) TInlineAssemblyBeginToken.$(H): TInlineAssemblyBeginToken.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBToken.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) -$(OUTDIR)TInlineAssemblyEndToken.$(O) TInlineAssemblyEndToken.$(H): TInlineAssemblyEndToken.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBToken.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) -$(OUTDIR)TInlineAssemblyNode.$(O) TInlineAssemblyNode.$(H): TInlineAssemblyNode.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBBlockNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBStatementNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBValueNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TMetaDefinition.$(O) TMetaDefinition.$(H): TMetaDefinition.st $(INCLUDE_TOP)/stx/goodies/ring/RGBehaviorDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGClassDescriptionDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGGlobalDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGMetaclassDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TMethodDefinition.$(O) TMethodDefinition.$(H): TMethodDefinition.st $(INCLUDE_TOP)/stx/goodies/ring/RGDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGElementDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGMethodDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TNamespaceDefinition.$(O) TNamespaceDefinition.$(H): TNamespaceDefinition.st $(INCLUDE_TOP)/stx/goodies/ring/RGAbstractContainer.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGContainer.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGDefinition.$(H) $(INCLUDE_TOP)/stx/goodies/ring/RGNamespace.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TParser.$(O) TParser.$(H): TParser.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TProgramNodeVisitor.$(O) TProgramNodeVisitor.$(H): TProgramNodeVisitor.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) -$(OUTDIR)TScanner.$(O) TScanner.$(H): TScanner.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBScanner.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(STCHDR) $(OUTDIR)TScope.$(O) TScope.$(H): TScope.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TSourceReader.$(O) TSourceReader.$(H): TSourceReader.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)TSpecialFormNode.$(O) TSpecialFormNode.$(H): TSpecialFormNode.st $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBMessageNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBProgramNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBStatementNode.$(H) $(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser/RBValueNode.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) diff -r 97090c2baa33 -r fa42d3f1a578 compiler/Make.spec --- a/compiler/Make.spec Sun Sep 20 12:01:42 2015 +0100 +++ b/compiler/Make.spec Tue Sep 22 17:43:38 2015 +0100 @@ -59,15 +59,11 @@ TCompilerError \ TEnvironmentProvider \ TFormatter \ - TInlineAssemblyBeginToken \ - TInlineAssemblyEndToken \ - TInlineAssemblyNode \ TMetaDefinition \ TMethodDefinition \ TNamespaceDefinition \ TParser \ TProgramNodeVisitor \ - TScanner \ TScope \ TSourceReader \ TSpecialFormNode \ @@ -107,15 +103,11 @@ $(OUTDIR_SLASH)TCompilerError.$(O) \ $(OUTDIR_SLASH)TEnvironmentProvider.$(O) \ $(OUTDIR_SLASH)TFormatter.$(O) \ - $(OUTDIR_SLASH)TInlineAssemblyBeginToken.$(O) \ - $(OUTDIR_SLASH)TInlineAssemblyEndToken.$(O) \ - $(OUTDIR_SLASH)TInlineAssemblyNode.$(O) \ $(OUTDIR_SLASH)TMetaDefinition.$(O) \ $(OUTDIR_SLASH)TMethodDefinition.$(O) \ $(OUTDIR_SLASH)TNamespaceDefinition.$(O) \ $(OUTDIR_SLASH)TParser.$(O) \ $(OUTDIR_SLASH)TProgramNodeVisitor.$(O) \ - $(OUTDIR_SLASH)TScanner.$(O) \ $(OUTDIR_SLASH)TScope.$(O) \ $(OUTDIR_SLASH)TSourceReader.$(O) \ $(OUTDIR_SLASH)TSpecialFormNode.$(O) \ diff -r 97090c2baa33 -r fa42d3f1a578 compiler/TFormatter.st --- a/compiler/TFormatter.st Sun Sep 20 12:01:42 2015 +0100 +++ b/compiler/TFormatter.st Tue Sep 22 17:43:38 2015 +0100 @@ -11,106 +11,6 @@ !TFormatter methodsFor:'visitor-double dispatching'! -acceptInlineAssemblyNode:aBlockNode - |seqNode multiline formattedBody formatter parent parentSelector| - - (CStyleBlocks - and:[ (parent := aBlockNode parent) notNil and:[ parent isMessage ] ]) - ifTrue: - [ parent receiver == aBlockNode - ifTrue: - [ " I am the receiver of a message (i.e. typically a control structure) " - ^ self acceptInlineAssemblyNodeCStyle:aBlockNode ]. - parentSelector := parent selector. - parentSelector == #timesRepeat: - ifTrue: - [ " I am the receiver of a message (i.e. typically a control structure) " - self indent:-2 while:[ ^ self acceptInlineAssemblyNodeCStyle:aBlockNode ] ] ]. - seqNode := aBlockNode body. - formatter := (self copy) - lineStart:0; - yourself. - seqNode isNil ifTrue:[ - formattedBody := '' - ] ifFalse:[ - formattedBody := formatter format:seqNode - ]. - multiline := (self lineLength + formattedBody size > self maxLineSize) - or:[ formatter isMultiLine ]. - (CStyleBlocks and:[ multiline ]) - ifTrue: - [ self indent:-1 while:[ self acceptInlineAssemblyNodeCStyle:aBlockNode ]. - ^ self ]. - multiline ifTrue:[ self indent ]. - codeStream nextPutAll:'%['. - SpaceAfterBlockStart - ifTrue: - [ (formattedBody notEmpty and:[ aBlockNode arguments isEmptyOrNil ]) - ifTrue:[ codeStream space. ] ]. - self formatBlockArguments:aBlockNode. - aBlockNode arguments isEmpty - ifFalse: - [ codeStream nextPutAll:'| '. - multiline ifTrue:[ self indent ] ]. - codeStream nextPutAll:formattedBody. - SpaceBeforeBlockEnd - ifTrue:[ formattedBody notEmpty ifTrue:[ codeStream space. ] ]. - codeStream nextPutAll:'%]' - - "Created: / 02-09-2015 / 06:49:02 / Jan Vrany " -! - -acceptInlineAssemblyNodeCStyle: aBlockNode - | seqNode l multiline formattedBody formatter | - - seqNode := aBlockNode body. - - formatter := (self copy) lineStart: 0; yourself. - formatter indentWhile:[ - formattedBody := formatter format: seqNode. -formattedBody asCollectionOfLines last isBlank ifTrue:[ - formattedBody := (formattedBody asCollectionOfLines copyButLast:1) asStringWith:Character cr. -]. - ]. - multiline := (l := self lineLength + formattedBody size) > self maxLineSize - or: [formatter isMultiLine]. - multiline := multiline or:[l > (MaxLengthForSingleLineBlocks ? 60)]. - - codeStream nextPutAll:'%['. - multiline ifFalse:[ - SpaceAfterBlockStart - ifTrue:[ - (formattedBody notEmpty and:[aBlockNode hasArguments not]) - ifTrue:[ - codeStream space.]]. - ]. - self indentWhile:[ - (BlockArgumentsOnNewLine or:[aBlockNode hasArguments not]) ifTrue:[ - multiline ifTrue:[ - self indent. - ]. - ]. - - self formatBlockArguments:aBlockNode. - aBlockNode arguments isEmpty - ifFalse:[ - codeStream nextPutAll: '| '. - multiline ifTrue: [self indent]]. - ]. - codeStream nextPutAll: formattedBody. - multiline - ifTrue: [self indent] - ifFalse:[ - SpaceBeforeBlockEnd - ifTrue:[ - formattedBody notEmpty - ifTrue:[ - codeStream space.]]]. - codeStream nextPutAll:'%]'. - - "Created: / 02-09-2015 / 06:48:42 / Jan Vrany " -! - acceptSimpleTypeNode: aTSimpleTypeNode codeStream nextPutAll: aTSimpleTypeNode name diff -r 97090c2baa33 -r fa42d3f1a578 compiler/TInlineAssemblyBeginToken.st --- a/compiler/TInlineAssemblyBeginToken.st Sun Sep 20 12:01:42 2015 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,27 +0,0 @@ -"{ Package: 'jv:tea/compiler' }" - -"{ NameSpace: Smalltalk }" - -RBToken subclass:#TInlineAssemblyBeginToken - instanceVariableNames:'' - classVariableNames:'' - poolDictionaries:'' - category:'Languages-Tea-Compiler-AST' -! - - -!TInlineAssemblyBeginToken methodsFor:'testing'! - -isTInlineAssemblyBegin - ^ true - - "Created: / 02-09-2015 / 06:20:13 / Jan Vrany " -! ! - -!TInlineAssemblyBeginToken class methodsFor:'documentation'! - -version_HG - - ^ '$Changeset: $' -! ! - diff -r 97090c2baa33 -r fa42d3f1a578 compiler/TInlineAssemblyEndToken.st --- a/compiler/TInlineAssemblyEndToken.st Sun Sep 20 12:01:42 2015 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -"{ Package: 'jv:tea/compiler' }" - -"{ NameSpace: Smalltalk }" - -RBToken subclass:#TInlineAssemblyEndToken - instanceVariableNames:'' - classVariableNames:'' - poolDictionaries:'' - category:'Languages-Tea-Compiler-AST' -! - -!TInlineAssemblyEndToken methodsFor:'testing'! - -isTInlineAssemblyEnd - ^ true - - "Created: / 02-09-2015 / 06:20:19 / Jan Vrany " -! ! - diff -r 97090c2baa33 -r fa42d3f1a578 compiler/TInlineAssemblyNode.st --- a/compiler/TInlineAssemblyNode.st Sun Sep 20 12:01:42 2015 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,33 +0,0 @@ -"{ Package: 'jv:tea/compiler' }" - -"{ NameSpace: Smalltalk }" - -RBBlockNode subclass:#TInlineAssemblyNode - instanceVariableNames:'' - classVariableNames:'' - poolDictionaries:'' - category:'Languages-Tea-Compiler-AST' -! - -!TInlineAssemblyNode methodsFor:'testing'! - -isBlock - ^false - - "Created: / 02-09-2015 / 06:29:45 / Jan Vrany " -! - -isInlineAssembly - ^true - - "Created: / 02-09-2015 / 06:29:55 / Jan Vrany " -! ! - -!TInlineAssemblyNode methodsFor:'visitor'! - -acceptVisitor: aProgramNodeVisitor - ^aProgramNodeVisitor acceptInlineAssemblyNode: self - - "Created: / 02-09-2015 / 06:30:09 / Jan Vrany " -! ! - diff -r 97090c2baa33 -r fa42d3f1a578 compiler/TParser.st --- a/compiler/TParser.st Sun Sep 20 12:01:42 2015 +0100 +++ b/compiler/TParser.st Tue Sep 22 17:43:38 2015 +0100 @@ -3,7 +3,7 @@ "{ NameSpace: Smalltalk }" RBParser subclass:#TParser - instanceVariableNames:'parsingInlineAssembly' + instanceVariableNames:'parsingPrimitive' classVariableNames:'' poolDictionaries:'' category:'Languages-Tea-Compiler-AST' @@ -28,25 +28,10 @@ "Modified: / 13-09-2015 / 07:55:55 / Jan Vrany " ! ! -!TParser methodsFor:'accessing'! - -initializeParserWith: aString type: aSymbol - |stream| - - stream := ReadStream on: aString. - source := aString. - self scanner: (TScanner - perform: aSymbol - with: stream - with: self errorBlock) - - "Created: / 02-09-2015 / 05:57:33 / Jan Vrany " -! ! - !TParser methodsFor:'initialization & release'! scanner: aScanner - parsingInlineAssembly := false. + parsingPrimitive := false. super scanner: aScanner. "Created: / 02-09-2015 / 06:34:01 / Jan Vrany " @@ -123,42 +108,6 @@ "Created: / 14-09-2015 / 14:35:49 / Jan Vrany " ! -parseInlineAssembly - | position blockNode firstLine prevScope| - - position := currentToken start. - firstLine := currentToken lineNumber. - parsingInlineAssembly := true. - self step. "/ To eat %[ token - blockNode := self parseBlockArgsInto: TInlineAssemblyNode new. -"/ node arguments do:[:eachArg | eachArg parent:self]. - blockNode left: position. - blockNode firstLineNumber:firstLine. - prevScope := currentScope. - currentScope := blockNode. - self rememberLastNode:blockNode. - blockNode body: (self parseStatements: false). - RBParser isSmalltalkX ifTrue:[ - self addComments:(scanner getCommentsBeforeToken) afterNode:blockNode body. - ]. - "/ ensure that right is set, even if parse aborted due to an error - blockNode right: currentToken start-1. - - (currentToken isTInlineAssemblyEnd ) - ifFalse: [self parserError: '''$]'' expected']. - "/ fix right - blockNode right: currentToken start. - blockNode lastLineNumber:currentToken lineNumber. - parsingInlineAssembly := false. - - self step. - self addComments:(scanner getCommentsBeforeToken) afterNode:blockNode. - currentScope := prevScope. - ^ blockNode - - "Created: / 02-09-2015 / 06:25:54 / Jan Vrany " -! - parseKeywordMessageWith: node | message | message := super parseKeywordMessageWith: node. @@ -186,98 +135,32 @@ "Modified: / 21-08-2015 / 22:50:23 / Jan Vrany " ! -parseStatementList: tagBoolean into: sequenceNode - | statements return periods returnPosition returnLineNumber node valueNode| - return := false. - statements := OrderedCollection new. - periods := OrderedCollection new. - self addComments:(scanner getCommentsBeforeToken) beforeNode:sequenceNode. - tagBoolean ifTrue: [self parseResourceTag]. - - [ - "skip empty statements" - emptyStatements ifTrue: - [[currentToken isSpecial and: [currentToken value == $.]] whileTrue: - [periods add: currentToken start. - self step]]. - - self atEnd - or: [(currentToken isSpecial and: ['])}' includes: currentToken value ]) - or: [(currentToken isTInlineAssemblyEnd)]] - ] whileFalse:[ - self addComments:(scanner getCommentsBeforeToken) beforeNode:node "value". +parseKeywordPragma + | selectorParts arguments | - return ifTrue: [ - self class isSmalltalkX - ifTrue: - ["could output a warning"] - ifFalse: - [self - parserError: 'End of statement list encounted (statements after return)' - lastNode:node]]. - (currentToken isTInlineAssemblyBegin) ifTrue:[ - node := self parseInlineAssembly. - statements add: node. - ] ifFalse:[ - (currentToken isSTXPrimitiveCode) - ifTrue:[ - " primPosition := currentToken start. " - node := RBSTXPrimitiveCCodeNode new codeToken: currentToken. - self addComments:(scanner getCommentsBeforeToken) afterNode:node. - statements add: node. - self step. - ] ifFalse:[ - (currentToken isSpecial and: [currentToken value == $^]) - ifTrue: - [ - returnPosition := currentToken start. - returnLineNumber := currentToken lineNumber. - self step. - - valueNode := self parseAssignment. - node := RBReturnNode return: returnPosition value: valueNode. - node lineNumber:returnLineNumber. - scanner atEnd ifFalse:[ - self addComments:(scanner getCommentsBeforeToken) afterNode:node value. - ]. + selectorParts := OrderedCollection new: 2. + arguments := OrderedCollection new: 2. + [ currentToken isKeyword ] whileTrue: [ + selectorParts add: currentToken. + self step. + "Hack to handle + style primitives" + (selectorParts size == 1 + and:[selectorParts last value = 'primitive:' + and:[currentToken isSpecial + and:[currentToken value == $[]]]) ifTrue: [ + parsingPrimitive := true. + arguments addLast: self parseBlock. + parsingPrimitive := false. + ] ifFalse:[ + arguments addLast: self parsePragmaLiteral + ] + ]. + ^ RBPragmaNode + selectorParts: selectorParts + arguments: arguments. - statements add: node. - return := true] - ifFalse: - [ - node := self parseAssignment. - node notNil ifTrue:[ - self addComments:(scanner getCommentsAfterTokenIfInLine:node lastLineNumber) afterNode:node. - scanner atEnd ifFalse:[ - self addComments:(scanner getCommentsAfterToken) afterNode:node. - self addComments:(scanner getCommentsBeforeToken) afterNode:node. - ]. - - statements add: node - ]]. - ]. - ]. - - (currentToken isSpecial and: [currentToken value == $.]) - ifTrue: - [periods add: currentToken start. - self step] - ifFalse: - [return := true]. - emptyStatements - ifTrue: - [[currentToken isSpecial and: [currentToken value == $.]] whileTrue: - [periods add: currentToken start. - self step]]]. - - sequenceNode - statements: statements; - periods: periods. - - self addComments:(scanner getCommentsBeforeToken) afterNode:node "value". - ^sequenceNode - - "Created: / 02-09-2015 / 06:23:44 / Jan Vrany " + "Created: / 22-09-2015 / 16:49:36 / Jan Vrany " ! parseType @@ -318,7 +201,7 @@ ! parseTypeSpec: forReturn - parsingInlineAssembly ifTrue:[ ^ nil ]. + parsingPrimitive ifTrue:[ ^ nil ]. (currentToken isBinary and: [currentToken value == #<]) ifTrue: [ | start stop type | diff -r 97090c2baa33 -r fa42d3f1a578 compiler/TParserTests.st --- a/compiler/TParserTests.st Sun Sep 20 12:01:42 2015 +0100 +++ b/compiler/TParserTests.st Tue Sep 22 17:43:38 2015 +0100 @@ -36,17 +36,6 @@ "Modified: / 14-09-2015 / 14:54:00 / Jan Vrany " ! -test_inline_assembly - | method | - - method := TParser parseMethod: 'foo < ^ Integer > %[ :asm | asm ret: 1 %].'. - self assert: method body statements size == 1. - self assert: method body statements first isInlineAssembly. - - "Created: / 02-09-2015 / 06:31:15 / Jan Vrany " - "Modified: / 14-09-2015 / 12:15:23 / Jan Vrany " -! - test_locals | method | @@ -89,6 +78,17 @@ "Modified: / 21-08-2015 / 23:00:59 / Jan Vrany " ! +test_primitive_inline + | method | + + method := TParser parseMethod: 'foo < ^ Integer > '. + self assert: method body statements isEmpty. + self assert: method pragmas size == 1. + self assert: method pragmas anElement arguments first isBlock. + + "Created: / 22-09-2015 / 16:51:17 / Jan Vrany " +! + test_special_form | method | diff -r 97090c2baa33 -r fa42d3f1a578 compiler/TProgramNodeVisitor.st --- a/compiler/TProgramNodeVisitor.st Sun Sep 20 12:01:42 2015 +0100 +++ b/compiler/TProgramNodeVisitor.st Tue Sep 22 17:43:38 2015 +0100 @@ -25,12 +25,6 @@ !TProgramNodeVisitor methodsFor:'visitor-double dispatching'! -acceptInlineAssemblyNode: aMethodNode - self acceptBlockNode: aMethodNode. - - "Created: / 02-09-2015 / 06:52:21 / Jan Vrany " -! - acceptMethodNode: aMethodNode super acceptMethodNode: aMethodNode. self visitNode: aMethodNode returnTypeSpec diff -r 97090c2baa33 -r fa42d3f1a578 compiler/TScanner.st --- a/compiler/TScanner.st Sun Sep 20 12:01:42 2015 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,66 +0,0 @@ -"{ Package: 'jv:tea/compiler' }" - -"{ NameSpace: Smalltalk }" - -RBScanner subclass:#TScanner - instanceVariableNames:'' - classVariableNames:'' - poolDictionaries:'' - category:'Languages-Tea-Compiler-AST' -! - - -!TScanner methodsFor:'private-scanning'! - -scanSpecialCharacter - | character | - - currentCharacter == $: ifTrue: - [self step. - currentCharacter == $= - ifTrue: - [self step. - ^ RBAssignmentToken start: tokenStart] - ifFalse: [^ RBSpecialCharacterToken value: $: start: tokenStart]]. - - currentCharacter == $% ifTrue:[ - RBParser isSmalltalkX ifTrue:[ - self step. - currentCharacter == ${ ifTrue:[ - self step. - ^ self scanSTXPrimitiveCode. - ]. - currentCharacter == $[ ifTrue:[ - self step. - ^ TInlineAssemblyBeginToken new - lineNumber: tokenLineNumber; - start: tokenStart; - yourself. - ]. - currentCharacter == $] ifTrue:[ - self step. - ^ TInlineAssemblyEndToken new - lineNumber: tokenLineNumber; - start: tokenStart; - yourself. - ]. - characterType := #binary. - ^ self scanBinary:RBBinarySelectorToken alreadyRead:$%. - ]. - ^ self scanBinary: RBBinarySelectorToken - ]. - - character := currentCharacter. - self step. - ^RBSpecialCharacterToken value: character start: tokenStart lineNumber: tokenLineNumber - - "Created: / 02-09-2015 / 06:00:15 / Jan Vrany " -! ! - -!TScanner class methodsFor:'documentation'! - -version_HG - - ^ '$Changeset: $' -! ! - diff -r 97090c2baa33 -r fa42d3f1a578 compiler/TTypechecker.st --- a/compiler/TTypechecker.st Sun Sep 20 12:01:42 2015 +0100 +++ b/compiler/TTypechecker.st Tue Sep 22 17:43:38 2015 +0100 @@ -9,6 +9,7 @@ category:'Languages-Tea-Compiler-Internals' ! + !TTypechecker methodsFor:'visiting'! visitArgument: anRBVariableNode @@ -95,3 +96,10 @@ "Modified: / 14-09-2015 / 14:22:41 / Jan Vrany " ! ! +!TTypechecker class methodsFor:'documentation'! + +version_HG + + ^ '$Changeset: $' +! ! + diff -r 97090c2baa33 -r fa42d3f1a578 compiler/abbrev.stc --- a/compiler/abbrev.stc Sun Sep 20 12:01:42 2015 +0100 +++ b/compiler/abbrev.stc Tue Sep 22 17:43:38 2015 +0100 @@ -7,18 +7,14 @@ TCompiler TCompiler jv:tea/compiler 'Languages-Tea-Compiler' 0 TCompilerContext TCompilerContext jv:tea/compiler 'Languages-Tea-Compiler' 0 TCompilerError TCompilerError jv:tea/compiler 'Languages-Tea-Compiler-Exceptions' 1 -TCompilerExamples TCompilerExamples jv:tea/compiler 'Languages-Tea-Compiler-Examples' 1 TEnvironmentProvider TEnvironmentProvider jv:tea/compiler 'Languages-Tea-Compiler-Model-Provider' 0 TFormatter TFormatter jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 -TInlineAssemblyBeginToken TInlineAssemblyBeginToken jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 -TInlineAssemblyEndToken TInlineAssemblyEndToken jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 -TInlineAssemblyNode TInlineAssemblyNode jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 TMetaDefinition TMetaDefinition jv:tea/compiler 'Languages-Tea-Compiler-Model' 0 TMethodDefinition TMethodDefinition jv:tea/compiler 'Languages-Tea-Compiler-Model' 0 TNamespaceDefinition TNamespaceDefinition jv:tea/compiler 'Languages-Tea-Compiler-Model' 0 TParser TParser jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 +TParserTests TParserTests jv:tea/compiler 'Languages-Tea-Compiler-AST-Tests' 1 TProgramNodeVisitor TProgramNodeVisitor jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 -TScanner TScanner jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 TScope TScope jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 TSourceReader TSourceReader jv:tea/compiler 'Languages-Tea-Compiler-Model' 0 TSpecialFormNode TSpecialFormNode jv:tea/compiler 'Languages-Tea-Compiler-AST' 0 @@ -45,8 +41,8 @@ TVariableBinding TVariableBinding jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 TArgumentBinding TArgumentBinding jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 TLocalBinding TLocalBinding jv:tea/compiler 'Languages-Tea-Compiler-Bindings' 0 +TCompilerExamples TCompilerExamples jv:tea/compiler 'Languages-Tea-Compiler-Examples' 1 TMethodDefinitionTests TMethodDefinitionTests jv:tea/compiler 'Languages-Tea-Compiler-Model-Tests' 1 -TParserTests TParserTests jv:tea/compiler 'Languages-Tea-Compiler-AST-Tests' 1 TSemanticAnalyserTests TSemanticAnalyserTests jv:tea/compiler 'Languages-Tea-Compiler-Internals-Tests' 1 TSourceReaderTests TSourceReaderTests jv:tea/compiler 'Languages-Tea-Compiler-Model-Tests' 1 TTypecheckerTests TTypecheckerTests jv:tea/compiler 'Languages-Tea-Compiler-Internals-Tests' 1 diff -r 97090c2baa33 -r fa42d3f1a578 compiler/bc.mak --- a/compiler/bc.mak Sun Sep 20 12:01:42 2015 +0100 +++ b/compiler/bc.mak Tue Sep 22 17:43:38 2015 +0100 @@ -82,15 +82,11 @@ $(OUTDIR)TCompilerError.$(O) TCompilerError.$(H): TCompilerError.st $(INCLUDE_TOP)\stx\libbasic\Error.$(H) $(INCLUDE_TOP)\stx\libbasic\Exception.$(H) $(INCLUDE_TOP)\stx\libbasic\GenericException.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TEnvironmentProvider.$(O) TEnvironmentProvider.$(H): TEnvironmentProvider.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TFormatter.$(O) TFormatter.$(H): TFormatter.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBFormatter.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) -$(OUTDIR)TInlineAssemblyBeginToken.$(O) TInlineAssemblyBeginToken.$(H): TInlineAssemblyBeginToken.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBToken.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) -$(OUTDIR)TInlineAssemblyEndToken.$(O) TInlineAssemblyEndToken.$(H): TInlineAssemblyEndToken.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBToken.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) -$(OUTDIR)TInlineAssemblyNode.$(O) TInlineAssemblyNode.$(H): TInlineAssemblyNode.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBBlockNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBStatementNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBValueNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TMetaDefinition.$(O) TMetaDefinition.$(H): TMetaDefinition.st $(INCLUDE_TOP)\stx\goodies\ring\RGBehaviorDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGClassDescriptionDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGGlobalDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGMetaclassDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TMethodDefinition.$(O) TMethodDefinition.$(H): TMethodDefinition.st $(INCLUDE_TOP)\stx\goodies\ring\RGDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGElementDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGMethodDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TNamespaceDefinition.$(O) TNamespaceDefinition.$(H): TNamespaceDefinition.st $(INCLUDE_TOP)\stx\goodies\ring\RGAbstractContainer.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGContainer.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGDefinition.$(H) $(INCLUDE_TOP)\stx\goodies\ring\RGNamespace.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TParser.$(O) TParser.$(H): TParser.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TProgramNodeVisitor.$(O) TProgramNodeVisitor.$(H): TProgramNodeVisitor.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNodeVisitor.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) -$(OUTDIR)TScanner.$(O) TScanner.$(H): TScanner.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBScanner.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(STCHDR) $(OUTDIR)TScope.$(O) TScope.$(H): TScope.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TSourceReader.$(O) TSourceReader.$(H): TSourceReader.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)TSpecialFormNode.$(O) TSpecialFormNode.$(H): TSpecialFormNode.st $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBMessageNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBProgramNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBStatementNode.$(H) $(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser\RBValueNode.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) diff -r 97090c2baa33 -r fa42d3f1a578 compiler/jv_tea_compiler.st --- a/compiler/jv_tea_compiler.st Sun Sep 20 12:01:42 2015 +0100 +++ b/compiler/jv_tea_compiler.st Tue Sep 22 17:43:38 2015 +0100 @@ -79,18 +79,14 @@ TCompiler TCompilerContext TCompilerError - (TCompilerExamples autoload) TEnvironmentProvider TFormatter - TInlineAssemblyBeginToken - TInlineAssemblyEndToken - TInlineAssemblyNode TMetaDefinition TMethodDefinition TNamespaceDefinition TParser + (TParserTests autoload) TProgramNodeVisitor - TScanner TScope TSourceReader TSpecialFormNode @@ -117,8 +113,8 @@ TVariableBinding TArgumentBinding TLocalBinding + (TCompilerExamples autoload) (TMethodDefinitionTests autoload) - (TParserTests autoload) (TSemanticAnalyserTests autoload) (TSourceReaderTests autoload) (TTypecheckerTests autoload) diff -r 97090c2baa33 -r fa42d3f1a578 compiler/libInit.cc --- a/compiler/libInit.cc Sun Sep 20 12:01:42 2015 +0100 +++ b/compiler/libInit.cc Tue Sep 22 17:43:38 2015 +0100 @@ -35,15 +35,11 @@ _TCompilerError_Init(pass,__pRT__,snd); _TEnvironmentProvider_Init(pass,__pRT__,snd); _TFormatter_Init(pass,__pRT__,snd); -_TInlineAssemblyBeginToken_Init(pass,__pRT__,snd); -_TInlineAssemblyEndToken_Init(pass,__pRT__,snd); -_TInlineAssemblyNode_Init(pass,__pRT__,snd); _TMetaDefinition_Init(pass,__pRT__,snd); _TMethodDefinition_Init(pass,__pRT__,snd); _TNamespaceDefinition_Init(pass,__pRT__,snd); _TParser_Init(pass,__pRT__,snd); _TProgramNodeVisitor_Init(pass,__pRT__,snd); -_TScanner_Init(pass,__pRT__,snd); _TScope_Init(pass,__pRT__,snd); _TSourceReader_Init(pass,__pRT__,snd); _TSpecialFormNode_Init(pass,__pRT__,snd);