This is mostly preparatory work for the conversion tool.
One syntax change is that we now use Foo subclass: Bar [ Bar class [ ] ] instead of Foo subclass: Bar [ Class protocol [ ] ] to switch to the class side and define class methods. Paolo 2007-05-25 Daniele Sciascia <[hidden email]> * compiler/RBFormatter.st: fix various bugs. Reformat method comments. Support varying the overall indentation. * compiler/RBParseNodes.st: store category in RBMethodNode. * compiler/RBParser.st: support storing a method category. Rewrite parseDoits to deal with comments correctly (almost). * compiler/RBToken.st: fix bug in handling of #{...}. * compiler/STLoader.st: Replace #unknownTo:selector:arguments: with #unknown:. Store a proxy for the nil superclass. Add various methods used by the converter. * compiler/STLoaderObjs.st: Add ProxyNilClass. Store selector in LoadedMethod. Add various #copyEmpty: methods. * libgst/dict.c: Turn _gst_find_shared_pool_variable into _gst_namespace_association_at, add _gst_namespace_at. * libgst/dict.h: Declare it. * libgst/gst-parse.c: Support attributes both before and after temporaries. Improve error recovery. Set the correct namespace when extending a class. Fix error locations. Support class definition in a namespace definition. Replace "Class protocol" with "Foo class". Support subclassing nil. Lookup classes in the superspaces too. * libgst/sym.c: Use _gst_namespace_association_at. --- orig/compiler/RBFormatter.st +++ mod/compiler/RBFormatter.st @@ -17,7 +17,7 @@ RBProgramNodeVisitor subclass: #RBFormatter - instanceVariableNames: 'codeStream lineStart firstLineLength tabs ' + instanceVariableNames: 'codeStream lineStart firstLineLength tabs initialIndent ' classVariableNames: '' poolDictionaries: '' category: 'Refactory-Parser'! @@ -35,6 +35,13 @@ format: aNode self visitNode: aNode. ^codeStream contents! +initialIndent + initialIndent isNil ifTrue: [ initialIndent := 0 ]. + ^initialIndent! + +initialIndent: anInteger + initialIndent := anInteger! + isMultiLine ^firstLineLength notNil! @@ -129,15 +136,30 @@ selectorsToStartOnNewLine !RBFormatter methodsFor: 'private-formatting'! -formatLiteral: aValue - | isArray | - (isArray := aValue class == Array) | (aValue class == ByteArray) ifTrue: - [codeStream nextPutAll: (isArray ifTrue: ['#('] ifFalse: ['#[']). - aValue - do: [:each | self formatLiteral: each] - separatedBy: [codeStream nextPut: $ ]. - codeStream nextPut: (isArray ifTrue: [$)] ifFalse: [$]]). +formatLiteral: token + | isArray aValue | + + aValue := token value. + + token isCompileTimeBound ifTrue: + [codeStream nextPutAll: '#{'; + nextPutAll: aValue; + nextPut: $}. ^self]. + aValue class == Array ifTrue: + [codeStream nextPutAll: '#('. + aValue + do: [:each | self formatLiteral: each] + separatedBy: [codeStream nextPut: $ ]. + codeStream nextPut: $). + ^self]. + aValue class == ByteArray ifTrue: + [codeStream nextPutAll: '#['. + aValue + do: [:each | codeStream store: each] + separatedBy: [codeStream nextPut: $ ]. + codeStream nextPut: $]. + ^self]. aValue isSymbol ifTrue: [self formatSymbol: aValue. ^self]. @@ -145,6 +167,11 @@ formatLiteral: aValue [codeStream nextPut: $$; nextPut: aValue. ^self]. + aValue class == String ifTrue: + [codeStream nextPut: $'; + nextPutAll: (aValue copyReplaceAll: '''' with: ''''''); + nextPut: $'. + ^self]. aValue storeOn: codeStream! formatMessage: aMessageNode cascade: cascadeBoolean @@ -194,6 +221,19 @@ formatMessageSelector: selectorParts wit nextPutAll: (formattedArgs at: i). (multiLine and: [i < formattedArgs size]) ifTrue: [self indent]]]! +formatComment: aString + | stream | + stream := ReadStream on: aString + from: (aString findFirst: [ :each | each = $" ]) + 1 + to: (aString findLast: [ :each | each = $" ]) - 1. + stream atEnd ifTrue: [ ^self ]. + codeStream nextPut: $". + stream linesDo: [ :each | + codeStream nextPutAll: each trimSeparators. + stream atEnd ifFalse: [ + self indent. codeStream space ] ]. + codeStream nextPut: $"! + formatMethodCommentFor: aNode indentBefore: aBoolean | source | source := aNode source. @@ -201,8 +241,8 @@ formatMethodCommentFor: aNode indentBefo aNode comments do: [:each | aBoolean ifTrue: [self indent]. - codeStream nextPutAll: (aNode source copyFrom: each first to: each last); - nl. + self formatComment: (aNode source copyFrom: each first to: each last). + codeStream nl. aBoolean ifFalse: [self indent]]! formatMethodPatternFor: aMethodNode @@ -210,7 +250,8 @@ formatMethodPatternFor: aMethodNode selectorParts := aMethodNode selectorParts. arguments := aMethodNode arguments. arguments isEmpty - ifTrue: [codeStream nextPutAll: selectorParts first value] + ifTrue: [codeStream nextPutAll: selectorParts first value; + nextPut: $ ] ifFalse: [selectorParts with: arguments do: @@ -230,7 +271,7 @@ formatStatementCommentFor: aNode crs := self newLinesFor: source startingAt: each first. (crs - 1 max: 0) timesRepeat: [codeStream nl]. crs == 0 ifTrue: [codeStream tab] ifFalse: [self indent]. - codeStream nextPutAll: (source copyFrom: each first to: each last)]! + self formatComment: (source copyFrom: each first to: each last)]! formatStatementsFor: aSequenceNode | statements | @@ -367,12 +408,7 @@ acceptCascadeNode: aCascadeNode separatedBy: [codeStream nextPut: $;]]! acceptLiteralNode: aLiteralNode - aLiteralNode isCompileTimeBound ifTrue: - [codeStream nextPutAll: '#{'; - nextPutAll: aLiteralNode value; - nextPut: $}. - ^self]. - ^self formatLiteral: aLiteralNode value! + ^self formatLiteral: aLiteralNode token! acceptMessageNode: aMessageNode | newFormatter code | @@ -387,11 +423,24 @@ acceptMessageNode: aMessageNode acceptMethodNode: aMethodNode self formatMethodPatternFor: aMethodNode. - self indentWhile: + codeStream nextPut: $[. + + self indent: self initialIndent while: [ + self indentWhile: [self formatMethodCommentFor: aMethodNode indentBefore: true. + + (aMethodNode category isNil) + ifFalse: [ + self indent. + codeStream nextPutAll: '<category: '; + print: (aMethodNode category); + nextPut: $> ] . + self indent. - aMethodNode body statements isEmpty - ifFalse: [self visitNode: aMethodNode body]]! + self visitNode: aMethodNode body ]. + + self indent. + codeStream nextPut: $] ]! acceptOptimizedNode: anOptimizedNode codeStream nextPutAll: '##('. @@ -404,8 +453,10 @@ acceptReturnNode: aReturnNode acceptSequenceNode: aSequenceNode | parent | - self formatMethodCommentFor: aSequenceNode indentBefore: false. - self formatTemporariesFor: aSequenceNode. + aSequenceNode statements isEmpty ifFalse: [ + self formatMethodCommentFor: aSequenceNode indentBefore: false. + self formatTemporariesFor: aSequenceNode. + ]. parent := aSequenceNode parent. (parent notNil and: [parent isMethod]) ifTrue: [self formatTagFor: parent]. self formatStatementsFor: aSequenceNode! --- orig/compiler/RBParseNodes.st +++ mod/compiler/RBParseNodes.st @@ -900,7 +900,7 @@ RBStatementNode class RBProgramNode subclass: #RBMethodNode - instanceVariableNames: 'selector selectorParts body source arguments tags ' + instanceVariableNames: 'selector selectorParts body source arguments tags category' classVariableNames: '' poolDictionaries: '' category: 'Refactory-Parser'! @@ -1015,7 +1015,13 @@ tags ^tags isNil ifTrue: [#()] ifFalse: [tags]! tags: aCollectionOfIntervals - tags := aCollectionOfIntervals! ! + tags := aCollectionOfIntervals! + +category + ^category! + +category: aCategory + category := aCategory! ! !RBMethodNode methodsFor: 'comparing'! --- orig/compiler/RBParser.st +++ mod/compiler/RBParser.st @@ -17,7 +17,7 @@ Object subclass: #RBParser - instanceVariableNames: 'scanner currentToken nextToken errorBlock tags source ' + instanceVariableNames: 'scanner currentToken nextToken errorBlock tags source methodCategory' classVariableNames: '' poolDictionaries: '' category: 'Refactory-Parser'! @@ -26,6 +26,12 @@ Object subclass: #RBParser !RBParser methodsFor: 'accessing'! +methodCategory + ^methodCategory ! + +methodCategory: aCategory + methodCategory := aCategory ! + errorBlock: aBlock errorBlock := aBlock. scanner notNil ifTrue: [scanner errorBlock: aBlock]! @@ -255,14 +261,34 @@ parseDoits " Parses the stuff to be executed until a ! <class expression> methodsFor: <category string> ! " - | node | + | node method start stop comments asd | [ - self atEnd ifTrue: [ ^false ]. + self atEnd ifTrue: [ ^false ]. + comments := scanner getComments. + start := comments isNil + ifTrue: [ asd := true. currentToken start - 2 ] + ifFalse: [ asd := false. comments first first - 2 ]. + + tags := nil. node := self parseStatements: false. + comments notNil + ifTrue: [ node comments isNil ifTrue: [ node comments: #() ]. + node comments: comments, node comments ]. + + "One -1 accounts for base-1 vs. base-0 (as above), the + other drops the bang because we have a one-token lookahead." + stop := currentToken start - 2. + + method := RBMethodNode selectorParts: #() arguments: #(). + method source: (scanner stream segmentFrom: start to: stop). + node parent: method. + self step. "gobble doit terminating bang" - node statements size > 0 and: [ self evaluate: node ] + node statements size > 0 and: [ self evaluate: node ] + ] whileFalse. + ^true ! @@ -311,6 +337,7 @@ parseMethod self addCommentsTo: methodNode. methodNode body: (self parseStatements: true). methodNode tags: tags. + methodNode category: methodCategory. ^methodNode! parseMethodDefinitionList @@ -552,13 +579,20 @@ parseExpression: aString onError: aBlock ^(node statements size == 1 and: [node temporaries isEmpty]) ifTrue: [node statements first] ifFalse: [node]! - + parseMethod: aString - ^self parseMethod: aString onError: nil! + ^self parseMethod: aString category: nil onError: nil! + +parseMethod: aString category: aCategory + ^self parseMethod: aString category: aCategory onError: nil! parseMethod: aString onError: aBlock + ^self parseMethod: aString category: nil onError: aBlock! + +parseMethod: aString category: aCategory onError: aBlock | parser | parser := self new. + parser methodCategory: aCategory. parser errorBlock: aBlock. parser initializeParserWith: aString type: #on:errorBlock:. ^parser parseMethod: aString! --- orig/compiler/RBToken.st +++ mod/compiler/RBToken.st @@ -241,7 +241,7 @@ compiler: aCompiler compiler := aCompiler! isCompileTimeBound - ^false! + ^true! realValue association notNil ifTrue: [ ^association ]. --- orig/compiler/STLoader.st +++ mod/compiler/STLoader.st @@ -44,7 +44,7 @@ STInterpreter comment: file-in.'! STInterpreter subclass: #STClassLoader - instanceVariableNames: 'loadedClasses proxies currentClass + instanceVariableNames: 'loadedClasses proxies proxyNilClass currentClass currentCategory currentNamespace' classVariableNames: '' poolDictionaries: 'STClassLoaderObjects' @@ -77,7 +77,7 @@ evaluationMethodFor: selector method := class evaluationMethods at: selector ifAbsent: [ nil ]. method isNil ifFalse: [ ^method ]. ]. - class == STInterpreter ifTrue: [ ^#unknownTo:selector:arguments: ]. + class == STInterpreter ifTrue: [ ^nil ]. class := class superclass ] repeat ! @@ -85,15 +85,13 @@ evaluationMethodFor: selector evaluateStatement: node | method | method := self evaluationMethodFor: node selector. - ^self - perform: method - with: node receiver - with: node selector - with: node arguments -! - -unknownTo: receiver selector: selector arguments: argumentNodes - ^false + (method isNil) + ifTrue: [ ^self unknown: node ] + ifFalse: [ ^self + perform: method + with: node receiver + with: node selector + with: node arguments ] ! evaluate: node @@ -103,8 +101,12 @@ evaluate: node "We *do not* want short-circuit evaluation here!!" each isMessage ifTrue: [ old | (self evaluateStatement: each) ] - ifFalse: [ old ] + ifFalse: [ self unknown: each ] ] +! + +unknown: node + ^false ! ! !STClassLoader class methodsFor: 'accessing'! @@ -171,6 +173,10 @@ currentNamespace currentNamespace: ns currentNamespace := ns! +proxyNilClass + proxyNilClass isNil ifTrue: [ proxyNilClass := ProxyNilClass on: nil for: self ]. + ^proxyNilClass! + proxyForNamespace: anObject ^proxies at: anObject ifAbsentPut: [ ProxyNamespace on: anObject for: self ]! @@ -181,10 +187,14 @@ proxyForClass: anObject !STClassLoader methodsFor: 'initializing'! +defaultNamespace + ^Namespace current +! + initialize - loadedClasses := OrderedCollection new. + loadedClasses := OrderedSet new. proxies := IdentityDictionary new. - currentNamespace := self proxyForNamespace: Namespace current. + currentNamespace := self proxyForNamespace: self defaultNamespace. ! ! !STClassLoader methodsFor: 'overrides'! @@ -198,26 +208,38 @@ endMethodList currentClass := nil ! +defineMethod: node + ^currentClass methodDictionary + at: (node selector asSymbol) + put: (LoadedMethod + category: currentCategory + source: (node source) + selector: (node selector asSymbol)) +! + compile: node - currentClass methodDictionary - at: node selector asSymbol - put: (LoadedMethod - category: currentCategory - source: node source) + self defineMethod: node. ! ! !STClassLoader methodsFor: 'evaluating statements'! -doSubclass: receiver selector: selector arguments: argumentNodes +defineSubclass: receiver selector: selector arguments: argumentNodes | class arguments newClass | - (argumentNodes allSatisfy: [ :each | each isLiteral ]) - ifFalse: [ ^false ]. - + class := self resolveClass: receiver. arguments := argumentNodes collect: [ :each | each value ]. newClass := class perform: selector withArguments: arguments asArray. loadedClasses add: newClass. proxies at: newClass put: newClass. + ^newClass +! + +doSubclass: receiver selector: selector arguments: argumentNodes + + (argumentNodes allSatisfy: [ :each | each isLiteral ]) + ifFalse: [ ^false ]. + + self defineSubclass: receiver selector: selector arguments: argumentNodes. ^false ! @@ -278,7 +300,10 @@ resolveClass: node | object | (node isMessage and: [ node selector = #class ]) ifTrue: [ ^(self resolveClass: node receiver) asMetaclass ]. - + node isLiteral ifTrue: [ + "Dictionary cannot have nil as a key, use the entire RBLiteralNode." + ^self proxyNilClass ]. + object := self resolveName: node. object isClass ifFalse: [ ^object ]. --- orig/compiler/STLoaderObjs.st +++ mod/compiler/STLoaderObjs.st @@ -127,6 +127,15 @@ STClassLoader as a superclass while pars preexisting classes is necessary to correctly augment their subclasses with the new classes, and to handle extension methods.'! +ProxyClass subclass: #ProxyNilClass + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'System-Compiler'! + +ProxyClass comment: +'This class represent a proxy for the nil fake superclass.'! + PseudoBehavior subclass: #LoadedBehavior instanceVariableNames: 'instVars superclass methods comment ' classVariableNames: '' @@ -159,7 +168,7 @@ LoadedBehavior comment: by an STClassLoader.'! Object subclass: #LoadedMethod - instanceVariableNames: 'source category' + instanceVariableNames: 'source category selector' classVariableNames: '' poolDictionaries: '' category: 'System-Compiler'! @@ -689,7 +698,13 @@ doesNotUnderstand: aMessage setProxy: aClass for: aSTClassLoader self initialize: aSTClassLoader. proxy := aClass. - self setSubclasses: aClass subclasses copy. + self setSubclasses: OrderedCollection new. +! ! + +!ProxyNilClass methodsFor: 'accessing'! + +nameIn: aNamespace + ^'nil' ! ! !LoadedBehavior methodsFor: 'accessing'! @@ -999,8 +1014,11 @@ superclass: sup name: s instanceVariable !LoadedMethod class methodsFor: 'instance creation'! -category: category source: source - ^self new category: category source: source +category: category source: source selector: selector + ^self new + category: category + source: source + selector: selector ! !LoadedMethod methodsFor: 'accessing'! @@ -1013,6 +1031,10 @@ methodSourceCode ^source ! +selector + ^selector +! + methodSourceString ^source asString ! ! @@ -1024,9 +1046,10 @@ discardTranslation !LoadedMethod methodsFor: 'initializing'! -category: c source: s +category: c source: s selector: sel category := c. source := s. + selector := sel. ! ! !PseudoNamespace methodsFor: 'abstract'! @@ -1062,11 +1085,16 @@ storeOn: aStream copyEmpty: newSize ^(super copyEmpty: newSize) setLoader: loader; + setSubspaces: subspaces; yourself ! setLoader: aSTClassLoader loader := aSTClassLoader +! + +setSubspaces: aSet + subspaces := aSet ! ! !PseudoNamespace methodsFor: 'accessing'! @@ -1098,6 +1126,13 @@ name: aSymbol in: aDictionary for: aSTCl environment: aDictionary; yourself) ! ! + +!LoadedNamespace methodsFor: 'initializing'! +copyEmpty: newSize + ^(super copyEmpty: newSize) + name: name; + yourself +! ! !LoadedNamespace methodsFor: 'accessing'! --- orig/libgst/dict.c +++ mod/libgst/dict.c @@ -1431,8 +1431,8 @@ _gst_shared_pool_dictionary (OOP class_o OOP -_gst_find_shared_pool_variable (OOP poolOOP, - OOP symbol) +_gst_namespace_association_at (OOP poolOOP, + OOP symbol) { OOP assocOOP; gst_namespace pool; @@ -1457,6 +1457,17 @@ _gst_find_shared_pool_variable (OOP pool poolOOP = pool->superspace; } } + +OOP +_gst_namespace_at (OOP poolOOP, + OOP symbol) +{ + OOP assocOOP = _gst_namespace_association_at (poolOOP, symbol); + if (IS_NIL (assocOOP)) + return assocOOP; + else + return ASSOCIATION_VALUE (assocOOP); +} size_t --- orig/libgst/dict.h +++ mod/libgst/dict.h @@ -423,9 +423,16 @@ extern OOP _gst_class_variable_dictionar ATTRIBUTE_HIDDEN; /* This finds the key SYMBOL into the dictionary POOLOOP and, if any, - in all of its super-namespaces. */ -extern OOP _gst_find_shared_pool_variable (OOP poolOOP, - OOP symbol) + in all of its super-namespaces. Returns the association. */ +extern OOP _gst_namespace_association_at (OOP poolOOP, + OOP symbol) + ATTRIBUTE_PURE + ATTRIBUTE_HIDDEN; + +/* This finds the key SYMBOL into the dictionary POOLOOP and, if any, + in all of its super-namespaces. Returns the value. */ +extern OOP _gst_namespace_at (OOP poolOOP, + OOP symbol) ATTRIBUTE_PURE ATTRIBUTE_HIDDEN; --- orig/libgst/gst-parse.c +++ mod/libgst/gst-parse.c @@ -97,7 +97,8 @@ static int filprintf (Filament *fil, /* Grammar productions. */ static void parse_chunks (gst_parser *p); -static void parse_doit (gst_parser *p); +static void parse_doit (gst_parser *p, + mst_Boolean accept_bang); static mst_Boolean parse_scoped_definition (gst_parser *p, tree_node first_stmt); @@ -121,7 +122,8 @@ static void parse_method (gst_parser *p, static tree_node parse_message_pattern (gst_parser *p); static tree_node parse_keyword_variable_list (gst_parser *p); static tree_node parse_variable (gst_parser *p); -static tree_node parse_attributes (gst_parser *p); +static tree_node parse_attributes (gst_parser *p, + tree_node prev_attrs); static tree_node parse_attribute (gst_parser *p); static tree_node parse_temporaries (gst_parser *p, mst_Boolean implied_pipe); @@ -352,7 +354,7 @@ parse_chunks (gst_parser *p) if (p->state == PARSE_METHOD_LIST) parse_method_list (p); else - parse_doit (p); + parse_doit (p, true); } _gst_pop_temporaries_dictionary (oldTemporaries); } @@ -435,7 +437,7 @@ recover_error (gst_parser *p) | empty */ static void -parse_doit (gst_parser *p) +parse_doit (gst_parser *p, mst_Boolean accept_bang) { tree_node statement = NULL; mst_Boolean caret; @@ -443,7 +445,7 @@ parse_doit (gst_parser *p) if (token (p, 0) == '|') parse_temporaries (p, false); - if (token (p, 0) == EOF) + if (token (p, 0) == EOF && accept_bang) return; caret = lex_skip_if (p, '^', false); @@ -468,7 +470,8 @@ parse_doit (gst_parser *p) /* Do not lex until after _gst_free_tree, or we lose a token! */ lex_skip_if (p, '.', false); - lex_skip_if (p, '!', false); + if (accept_bang) + lex_skip_if (p, '!', false); } @@ -519,19 +522,40 @@ parse_scoped_definition (gst_parser *p, else if (first_stmt->nodeType == TREE_UNARY_EXPR && first_stmt->v_expr.selector == _gst_intern_string ("extend")) { - - if (receiver->nodeType == TREE_VARIABLE_NODE) - classOOP = parse_class (receiver); + OOP namespace_old = _gst_current_namespace; + OOP classOrMetaclassOOP = NULL; + mst_Boolean ret_value; + _gst_register_oop (namespace_old); + if (receiver->nodeType == TREE_VARIABLE_NODE) + { + classOOP = parse_class (receiver); + classOrMetaclassOOP = classOOP; + } else if (receiver->nodeType == TREE_UNARY_EXPR && receiver->v_expr.selector == _gst_intern_string ("class")) - { - classOOP = parse_class (receiver->v_expr.receiver); - classOOP = OOP_CLASS (classOOP); - } + { + classOOP = parse_class (receiver->v_expr.receiver); + classOrMetaclassOOP = OOP_CLASS (classOOP); + } + if (classOrMetaclassOOP != NULL) + { + OOP namespace_new = ((gst_class) OOP_TO_OBJ (classOOP))->environment; + + /* When creating the image, current namespace is not available. */ + if (namespace_new != namespace_old) + _gst_msg_sendf (NULL, "%v %o current: %o", + _gst_namespace_class, namespace_new); + + ret_value = parse_class_definition (p, classOrMetaclassOOP); - if (classOOP != NULL) - return parse_class_definition (p, classOOP); + if (namespace_new != namespace_old) + _gst_msg_sendf (NULL, "%v %o current: %o", + _gst_namespace_class, namespace_old); + + _gst_unregister_oop (namespace_old); + return ret_value; + } } _gst_errorf_at (first_stmt->location.first_line, @@ -579,8 +603,9 @@ parse_namespace_definition (gst_parser * _gst_msg_sendf (NULL, "%v %o current: %o", _gst_namespace_class, new_namespace); - parse_eval_definition (p); - + while (token (p, 0) != ']' && token (p, 0) != EOF) + parse_doit (p, false); + _gst_msg_sendf (NULL, "%v %o current: %o", _gst_namespace_class, old_namespace); @@ -755,16 +780,22 @@ parse_class_definition (gst_parser *p, O parse_scoped_method (p, classOOP); continue; } - else if (t3 == '[' - && strcmp (val (p, 0)->sval, "Class") == 0 - && strcmp (val (p, 1)->sval, "protocol") == 0) + else if (t3 == '[' && strcmp (val (p, 1)->sval, "class") == 0) { #if 0 printf ("parse class protocol\n"); #endif if (_gst_object_is_kind_of (classOOP, _gst_metaclass_class)) { - _gst_errorf ("already on class side, Class protocol invalid"); + _gst_errorf ("already on class side"); + _gst_had_error = true; + continue; + } + else if (((gst_class) OOP_TO_OBJ (classOOP))->name + != _gst_intern_string (val (p, 0)->sval)) + { + _gst_errorf ("`%s class' invalid within %O", + val (p, 0)->sval, classOOP); _gst_had_error = true; continue; } @@ -785,7 +816,8 @@ parse_class_definition (gst_parser *p, O #if 0 printf ("parse instance variables - ignore\n"); #endif - lex_consume (p, 2); + lex_consume (p, 2); + continue; } else if (t2 == IDENTIFIER) { @@ -868,11 +900,14 @@ parse_class (tree_node list) { const char* name; OOP currentOOP = _gst_current_namespace; - + + if (strcmp (list->v_list.name, "nil") == 0) + return _gst_nil_oop; + do { name = list->v_list.name; - currentOOP = dictionary_at (currentOOP, _gst_intern_string (name)); + currentOOP = _gst_namespace_at (currentOOP, _gst_intern_string (name)); if (currentOOP == _gst_nil_oop) { @@ -918,7 +953,7 @@ parse_namespace (tree_node list) while (list->v_list.next != NULL) { name = _gst_intern_string (list->v_list.name); - current_namespace = dictionary_at (current_namespace, name); + current_namespace = _gst_namespace_at (current_namespace, name); if (current_namespace == _gst_nil_oop) { @@ -997,7 +1032,7 @@ parse_method_list (gst_parser *p) static void parse_method (gst_parser *p, int at_end) { - tree_node pat, temps, attrs, stmts; + tree_node pat, temps, stmts, attrs = NULL; YYLTYPE current_pos; tree_node method; @@ -1006,8 +1041,14 @@ parse_method (gst_parser *p, int at_end) if (at_end == ']') lex_skip_mandatory (p, '['); + if (token (p, 0) == '<') + attrs = parse_attributes (p, NULL); + temps = parse_temporaries (p, false); - attrs = parse_attributes (p); + + if (token (p, 0) == '<') + attrs = parse_attributes (p, attrs); + stmts = parse_statements (p, NULL, true); /* Don't lex until _gst_free_tree, or we lose a token. */ @@ -1121,18 +1162,16 @@ parse_variable (gst_parser *p) | KEYWORD binary_expr */ static tree_node -parse_attributes (gst_parser *p) +parse_attributes (gst_parser *p, tree_node prev_attrs) { - tree_node attrs = NULL; - while (token (p, 0) == '<') { tree_node attr = parse_attribute (p); if (attr) - attrs = _gst_add_node (attrs, attr); + prev_attrs = _gst_add_node (prev_attrs, attr); } - return attrs; + return prev_attrs; } static tree_node --- orig/libgst/sym.c +++ mod/libgst/sym.c @@ -515,7 +515,7 @@ find_class_variable (OOP varName) { class = (gst_class) OOP_TO_OBJ (class_oop); assocOOP = - _gst_find_shared_pool_variable (class->environment, varName); + _gst_namespace_association_at (class->environment, varName); if (!IS_NIL (assocOOP)) return (assocOOP); } @@ -530,7 +530,7 @@ find_class_variable (OOP varName) { poolDictionaryOOP = ARRAY_AT (class->sharedPools, i + 1); assocOOP = - _gst_find_shared_pool_variable (poolDictionaryOOP, varName); + _gst_namespace_association_at (poolDictionaryOOP, varName); if (!IS_NIL (assocOOP)) return (assocOOP); } @@ -578,7 +578,7 @@ _gst_find_variable_binding (tree_node li { root = ASSOCIATION_VALUE (assocOOP); symbol = _gst_intern_string (list->v_list.name); - assocOOP = _gst_find_shared_pool_variable (root, symbol); + assocOOP = _gst_namespace_association_at (root, symbol); } if (IS_NIL (assocOOP) && !(list->v_list.next)) --- orig/tests/except.st +++ mod/tests/except.st @@ -31,7 +31,7 @@ Notification subclass: MyException [ <category: 'testing'> - Class protocol [ + MyException class [ | count | count [ ^count ] --- orig/tests/getopt.st +++ mod/tests/getopt.st @@ -31,7 +31,7 @@ ======================================================================" Getopt extend [ - Class protocol [ + Getopt class [ test: args with: pattern [ args do: [ :each | self --- orig/tests/objects.st +++ mod/tests/objects.st @@ -33,7 +33,7 @@ Object subclass: ObjectsTest [ Messages := nil. - Class protocol [ + ObjectsTest class [ testCompaction [ Messages := SortedCollection new. ObjectMemory compact. _______________________________________________ help-smalltalk mailing list [hidden email] http://lists.gnu.org/mailman/listinfo/help-smalltalk |
Free forum by Nabble | Edit this page |