Promote special operators SET and %FSET to intrinsics.

6 files changed, 32 insertions, 110 deletions

diff --git a/MLKForm.h b/MLKForm.h
index ac08241..bf7c41b 100644
--- a/MLKForm.h
+++ b/MLKForm.h
@@ -282,22 +282,6 @@
 @end
 
 
-@interface MLKSetForm : MLKCompoundForm
-{
-  MLKForm *_variableForm;
-  MLKForm *_valueForm;
-}
-@end
-
-
-@interface MLKFSetForm : MLKCompoundForm
-{
-  MLKForm *_functionNameForm;
-  MLKForm *_valueForm;
-}
-@end
-
-
 @interface MLKThrowForm : MLKCompoundForm
 {
   MLKForm *_tagForm;
diff --git a/MLKForm.m b/MLKForm.m
index 955aa63..19e04ac 100644
--- a/MLKForm.m
+++ b/MLKForm.m
@@ -148,8 +148,6 @@
   else if (car == QUOTE) return [MLKQuoteForm class];
   else if (car == SETQ) return [MLKSetQForm class];
   else if (car == _FSETQ) return [MLKFSetQForm class];
-  else if (car == SET) return [MLKSetForm class];
-  else if (car == _FSET) return [MLKFSetForm class];
   else if (car == THROW) return [MLKThrowForm class];
   else if (car == UNWIND_PROTECT) return [MLKUnwindProtectForm class];
   else return [MLKSimpleCompoundForm class];
@@ -791,40 +789,6 @@
 @end
 
 
-@implementation MLKSetForm
--(id) complete
-{
-  self = [super complete];
-  LASSIGN (_variableForm, MAKE_FORM ([_tail car]));
-  LASSIGN (_valueForm, MAKE_FORM ([[_tail cdr] car]));
-  return self;
-}
-
--(NSArray *) subforms
-{
-  return [[[super subforms] arrayByAddingObject:_variableForm]
-          arrayByAddingObject:_valueForm];
-}
-@end
-
-
-@implementation MLKFSetForm
--(id) complete
-{
-  self = [super complete];
-  LASSIGN (_functionNameForm, MAKE_FORM ([_tail car]));
-  LASSIGN (_valueForm, MAKE_FORM ([[_tail cdr] car]));
-  return self;
-}
-
--(NSArray *) subforms
-{
-  return [[[super subforms] arrayByAddingObject:_functionNameForm]
-          arrayByAddingObject:_valueForm];
-}
-@end
-
-
 @implementation MLKThrowForm
 -(id) complete
 {
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 693c742..21adaea 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -1059,59 +1059,6 @@
               else
                 RETURN_VALUE (value);
             }
-          else if (car == SET)
-            {
-              id symbol = [[self eval:[[program cdr] car]
-                                 inLexicalContext:context
-                                 withEnvironment:lexenv
-                                 expandOnly:expandOnly]
-                           objectAtIndex:0];
-              id value = [[self eval:[[[program cdr] cdr] car]
-                                inLexicalContext:context
-                                withEnvironment:lexenv
-                                expandOnly:expandOnly]
-                          objectAtIndex:0];
-
-              if (expandOnly)
-                RETURN_VALUE ([MLKCons cons:SET
-                                       with:[MLKCons cons:symbol
-                                                     with:[MLKCons cons:value
-                                                                   with:nil]]]);
-
-              if ([dynamicContext bindingForSymbol:symbol])
-                [dynamicContext setValue:value forSymbol:symbol];
-              else
-                [[MLKDynamicContext globalContext] addValue:value
-                                                   forSymbol:symbol];
-
-              return [NSArray arrayWithObject:symbol];
-            }
-          else if (car == _FSET)
-            {
-              // Like SET, but for the function cell.
-              id symbol = [[self eval:[[program cdr] car]
-                                 inLexicalContext:context
-                                 withEnvironment:lexenv
-                                 expandOnly:expandOnly]
-                            objectAtIndex:0];
-              id value = [[self eval:[[[program cdr] cdr] car]
-                                inLexicalContext:context
-                                withEnvironment:lexenv
-                                expandOnly:expandOnly]
-                           objectAtIndex:0];
-
-              if (expandOnly)
-                RETURN_VALUE ([MLKCons cons:_FSET
-                                       with:[MLKCons cons:symbol
-                                                     with:[MLKCons cons:value
-                                                                   with:nil]]]);
-
-              [[MLKLexicalContext globalContext] addFunction:symbol];
-              [[MLKLexicalEnvironment globalEnvironment] addFunction:value
-                                                         forSymbol:symbol];
-
-              return [NSArray arrayWithObject:symbol];
-            }
           else if (car == THROW)
             {
               id catchTag;
diff --git a/MLKPackage.m b/MLKPackage.m
index acaf6db..9bae8fe 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -101,7 +101,6 @@ static NSMutableDictionary *packages = nil;
   [cl export:[cl intern:@"VALUES"]];
   [cl export:[cl intern:@"EVAL"]];
   [cl export:[cl intern:@"SPECIAL"]];
-  [cl export:[cl intern:@"SET"]];
   [cl export:[cl intern:@"UNWIND-PROTECT"]];
   [cl export:[cl intern:@"MULTIPLE-VALUE-CALL"]];
   [cl export:[cl intern:@"EVAL-WHEN"]];
@@ -155,6 +154,7 @@ static NSMutableDictionary *packages = nil;
   [sys export:[sys intern:@"DECLARATIONS-AND-DOC-AND-FORMS"]];
   [sys export:[sys intern:@"DECLARATIONS-AND-FORMS"]];
   [sys export:[sys intern:@"COMPILE"]];
+  [sys export:[sys intern:@"SET"]];
 
   [sys export:[sys intern:@"OBJC-CLASS-OF"]];
   [sys export:[sys intern:@"OBJC-SUBCLASSP"]];
diff --git a/MLKRoot.m b/MLKRoot.m
index b051dd3..0c59c23 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -99,6 +99,10 @@ static id truify (BOOL value)
               withString:@"_"
               options:NSLiteralSearch
               range:NSMakeRange(0, [methodName length])];
+  [methodName replaceOccurrencesOfString:@"%"
+              withString:@""
+              options:NSLiteralSearch
+              range:NSMakeRange(0, [methodName length])];
   [methodName appendString:@":"];
 
   selector = NSSelectorFromString (methodName);
@@ -715,4 +719,31 @@ as provided by method %@ of object %@",
   RETURN_VALUE (thing);
 }
 #endif
+
++(NSArray *) fset:(NSArray *)args
+{
+  id symbol = denullify ([args objectAtIndex:0]);
+  id value = denullify ([args objectAtIndex:1]);
+
+  [[MLKLexicalContext globalContext] addFunction:symbol];
+  [[MLKLexicalEnvironment globalEnvironment] addFunction:value
+                                             forSymbol:symbol];
+
+  RETURN_VALUE (value);
+}
+
++(NSArray *) set:(NSArray *)args
+{
+  id symbol = denullify ([args objectAtIndex:0]);
+  id value = denullify ([args objectAtIndex:1]);
+  MLKDynamicContext *dynamicContext = [MLKDynamicContext currentContext];
+
+  if ([dynamicContext bindingForSymbol:symbol])
+    [dynamicContext setValue:value forSymbol:symbol];
+  else
+    [[MLKDynamicContext globalContext] addValue:value
+                                       forSymbol:symbol];
+
+  RETURN_VALUE (value);
+}
 @end
diff --git a/special-symbols.h b/special-symbols.h
index fa68ba7..c455025 100644
--- a/special-symbols.h
+++ b/special-symbols.h
@@ -44,9 +44,7 @@ static MLKSymbol *EVAL_WHEN;
 static MLKSymbol *QUOTE;
 static MLKSymbol *SETQ;
 static MLKSymbol *SETF;
-static MLKSymbol *SET;
 static MLKSymbol *_FSETQ;
-static MLKSymbol *_FSET;
 static MLKSymbol *SYMBOL_MACROLET;
 static MLKSymbol *PROGV;
 static MLKSymbol *UNWIND_PROTECT;
@@ -95,9 +93,7 @@ ensure_symbols ()
   QUOTE = [cl intern:@"QUOTE"];
   SETQ = [cl intern:@"SETQ"];
   SETF = [cl intern:@"SETF"];
-  SET = [cl intern:@"SET"];
   _FSETQ = [sys intern:@"%FSETQ"];
-  _FSET = [sys intern:@"%FSET"];
   SYMBOL_MACROLET = [cl intern:@"SYMBOL-MACROLET"];
   PROGV = [cl intern:@"PROGV"];
   VALUES = [cl intern:@"VALUES"];