Script object implemented :o)

git-svn-id: svn+ssh://svn.gna.org/svn/gnustep/libs/steptalk/trunk@17441 72102866-910b-0410-8b05-ffd578937521

Frameworks/StepTalk/STScriptObject.h

@@ -2,27 +2,34 @@
 
 #import <Foundation/NSObject.h>
 
+#import "STMethod.h"
+
 @class NSMutableDictionary;
 @class NSDictionary;
 @class NSArray;
-@class STMethod;
+@class STEnvironment;
 
 @interface STScriptObject:NSObject
 {
     NSMutableDictionary *ivars;
-    NSMutableDictionary *methods;
+    NSMutableDictionary *methodDictionary;
+    
+    STEnvironment       *environment;
 }
 + scriptObject;
 - initWithInstanceVariableNames:(NSString *)names;
 
+- (void)setEnvironment:(STEnvironment *)env;
+- (STEnvironment *)environment;
+
 - (void)setObject:(id)anObject forVariable:(NSString *)aName;
 - (id)objectForVariable:(NSString *)aName;
 
 - (NSArray *)instanceVariableNames;
 
-- (void)addMethod:(STMethod *)aMethod;
-- (STMethod *)methodWithName:(NSString *)aName;
-- (void)removeMethod:(STMethod *)aMethod;
+- (void)addMethod:(id <STMethod>)aMethod;
+- (id <STMethod>)methodWithName:(NSString *)aName;
+- (void)removeMethod:(id <STMethod>)aMethod;
 - (void)removeMethodWithName:(NSString *)aName;
 - (NSArray *)methodNames;
 - (NSDictionary *)methodDictionary;

Frameworks/StepTalk/STScriptObject.m

@@ -2,6 +2,13 @@
 
 #import "STScriptObject.h"
 
+#import "STEngine.h"
+#import "STFunctions.h"
+
+#import <Foundation/NSArray.h>
+#import <Foundation/NSDictionary.h>
+#import <Foundation/NSException.h>
+
 @implementation STScriptObject
 /** Return new instance of script object without any instance variables */
 + scriptObject
@@ -12,7 +19,7 @@
 {
     self = [super init];
     
-    methods = [[NSMutableDictionary alloc] init];
+    methodDictionary = [[NSMutableDictionary alloc] init];
     
     return self;
 }
@@ -22,7 +29,7 @@
 }
 - (void)dealloc
 {
-    RELEASE(methods);
+    RELEASE(methodDictionary);
     RELEASE(ivars);
     [super dealloc];
 }
@@ -41,28 +48,102 @@
     return [ivars allKeys];
 }
 
-- (void)addMethod:(STMethod *)aMethod
+- (void)addMethod:(id <STMethod>)aMethod
 {
-    [methods setObject:aMethod forKey:[aMethod methodName]];
+    [methodDictionary setObject:aMethod forKey:[aMethod methodName]];
 }
-- (STMethod *)methodWithName:(NSString *)aName
+- (id <STMethod>)methodWithName:(NSString *)aName
 {
-    return [methods objectForKey:aName];
+    return [methodDictionary objectForKey:aName];
 }
-- (void)removeMethod:(STMethod *)aMethod
+- (void)removeMethod:(id <STMethod>)aMethod
 {
     [self notImplemented:_cmd];
 }
 - (void)removeMethodWithName:(NSString *)aName
 {
-    [methods removeObjectForKey:aName];
+    [methodDictionary removeObjectForKey:aName];
 }
 - (NSArray *)methodNames
 {
-    return [methods allKeys];
+    return [methodDictionary allKeys];
 }
 - (NSDictionary *)methodDictionary
 {
-    return [NSDictionary dictionaryWithDictionary:methods];
+    return [NSDictionary dictionaryWithDictionary:methodDictionary];
+}
+/** Set object's environment. Note: This method should be replaced by
+some other, more clever mechanism. */
+- (void)setEnvironment:(STEnvironment *)env
+{
+    ASSIGN(environment, env);
+}
+- (STEnvironment *)environment
+{
+    return environment;
+}
+- (BOOL)respondsToSelector:(SEL)aSelector
+{
+    if( [super respondsToSelector:(SEL)aSelector] )
+    {
+        return YES;
+    }
+    
+    return ([methodDictionary objectForKey:NSStringFromSelector(aSelector)] != nil);
+}
+
+- (NSMethodSignature *)methodSignatureForSelector:(SEL)sel
+{
+    NSMethodSignature *signature = nil;
+    
+    signature = [super methodSignatureForSelector:sel];
+
+    if(!signature)
+    {
+        signature = STMethodSignatureForSelector(sel);
+    }
+
+    return signature;
+}
+
+- (void) forwardInvocation:(NSInvocation *)invocation
+{
+    STEngine       *engine;
+    id <STMethod>  *method;
+    NSString       *methodName = NSStringFromSelector([invocation selector]);
+    NSMutableArray *args;
+    id              arg;
+    int             index;
+    int             count;
+    id              retval = nil;
+
+    method = [methodDictionary objectForKey:methodName];
+    
+    if(!method)
+    {
+        [NSException raise:@"STScriptObjectException"
+                     format:@"No script object method with name '%@'",
+                            methodName];
+        return;
+    }
+
+    engine = [STEngine engineForLanguageWithName:[method languageName]];   
+
+    /* Get arguments as array */
+    count = [[invocation methodSignature] numberOfArguments];
+    args = [NSMutableArray array];
+    
+    for(index = 2; index < count; index++)
+    {
+        arg = [invocation getArgumentAsObjectAtIndex:index];
+        [args addObject:arg];
+    }
+
+    retval = [engine executeMethod:method
+                       forReceiver:self
+                     withArguments:args
+                     inEnvironment:environment];
+
+    [invocation setReturnValue:&retval];
 }
 @end

Languages/Smalltalk/STCompiledMethod.m

@@ -110,4 +110,14 @@
 
     return desc;
 }
+
+/* Script object method info */
+- (NSString *)methodName
+{
+    return selector;
+}
+- (NSString *)languageName
+{
+    return @"Smalltalk";
+}
 @end

Languages/Smalltalk/STCompiler.m

@@ -183,8 +183,7 @@ extern int STCparse(void *context);
     int               parsRetval = 0;
 
 
-    //    NSDebugLLog(@"STCompiler", @"Compile method", aString);
-    NSLog(@"Compile method");
+    NSDebugLLog(@"STCompiler", @"Compile method", aString);
 
     if(!environment)
     {

Languages/Smalltalk/STGrammar.m

@@ -1197,7 +1197,7 @@ yyreduce:
   case 4:
 #line 80 "STGrammar.y"
     {
-                                [COMPILER compileMethod:yyvsp[-2]];
+                                [COMPILER compileMethod:yyvsp[0]];
                             ;}
     break;
 

Languages/Smalltalk/STGrammar.y

@@ -78,7 +78,7 @@ source: /* empty string */  {
     /* FIXME: this is a hack */
     |   TK_SEPARATOR TK_SEPARATOR method              
                             {
-                                [COMPILER compileMethod:$1];
+                                [COMPILER compileMethod:$3];
                             }
                             
     | 

TODO

@@ -15,3 +15,5 @@ TODO list
 16 Remove StepTalk modules
 17 Fill implementation of STScriptObject, STMethod and related STEngine methods
 18 Rewrite Smalltalk compiler (grammar)
+19 Remove empty directories (Source, Modules/StepTalk)
+20 Replace STMethod languageName with map table of method class->engine class

Testing/sobjtest.st

@@ -0,0 +1,32 @@
+"   Test for script objects.
+
+    Author: Stefan Urbanek
+    Date: 2003 Aug 6 
+"
+
+| object method source engine |
+
+    Environment includeFramework:'StepTalk'.
+
+" Create a script object and set it's environment " 
+    object := STScriptObject scriptObject.
+    object setEnvironment:Environment.
+    
+" This is the source of new method "
+    source := 'sayHi Transcript showLine: \'Hi.\'. ^self'.
+
+" Get the proper engine "
+    engine := STEngine engineForLanguageWithName:'Smalltalk'.
+
+" Create method "
+    method := engine methodFromSource:source 
+                          forReceiver:object
+                        inEnvironment:Environment.
+
+" Add the method to the object "
+    object addMethod:method.
+
+" Sent it! "
+    object sayHi.
+    
+