diff options
| -rw-r--r-- | MLKInterpreter.m | 29 | ||||
| -rw-r--r-- | MLKPackage.m | 1 | 
2 files changed, 24 insertions, 6 deletions
| diff --git a/MLKInterpreter.m b/MLKInterpreter.m index 9ccc079..7d72f48 100644 --- a/MLKInterpreter.m +++ b/MLKInterpreter.m @@ -62,6 +62,7 @@ static MLKSymbol *QUOTE;  static MLKSymbol *SETQ;  static MLKSymbol *SETF;  static MLKSymbol *SET; +static MLKSymbol *_FSETQ;  static MLKSymbol *_FSET;  static MLKSymbol *PROGV;  static MLKSymbol *UNWIND_PROTECT; @@ -98,6 +99,7 @@ static MLKSymbol *_LOOP;    SETQ = [cl intern:@"SETQ"];    SETF = [cl intern:@"SETF"];    SET = [cl intern:@"SET"]; +  _FSETQ = [sys intern:@"%FSETQ"];    _FSET = [sys intern:@"%FSET"];    PROGV = [cl intern:@"PROGV"];    VALUES = [cl intern:@"VALUES"]; @@ -801,7 +803,7 @@ static MLKSymbol *_LOOP;                  RETURN_VALUE (program);                RETURN_VALUE ([[program cdr] car]);              } -          else if (car == SETQ) +          else if (car == SETQ || car == _FSETQ)              {                id symbol = [[program cdr] car];                id value = [[self eval:[[[program cdr] cdr] car] @@ -814,7 +816,7 @@ static MLKSymbol *_LOOP;                if (![program cdr])                  RETURN_VALUE (nil); -              if ([context symbolNamesSymbolMacro:symbol]) +              if (car == SETQ && [context symbolNamesSymbolMacro:symbol])                  {                    id macrofun = [context symbolMacroForSymbol:symbol];                    id expansion = [macrofun applyToArray: @@ -834,13 +836,13 @@ static MLKSymbol *_LOOP;                if (expandOnly)                  {                    RETURN_VALUE ([MLKCons -                                  cons:SETQ +                                  cons:car                                    with:[MLKCons                                           cons:symbol                                           with:[MLKCons                                                  cons:value                                                  with:denullify([[self eval: -                                                                        [MLKCons cons:SETQ +                                                                        [MLKCons cons:car                                                                                   with:rest]                                                                        inLexicalContext:context                                                                        withEnvironment:lexenv @@ -848,7 +850,22 @@ static MLKSymbol *_LOOP;                                                                   objectAtIndex:0])]]]);                  } -              if ([context variableIsLexical:symbol]) +              if (car == _FSETQ) +                { +                  if ([context symbolNamesFunction:symbol]) +                    { +                      [lexenv setFunction:value forSymbol:symbol]; +                    } +                  else +                    { +                      // FIXME: Maybe print a warning. +                      [[MLKLexicalContext globalContext] addFunction:symbol]; +                      [[MLKLexicalEnvironment globalEnvironment] +                        addFunction:value +                        forSymbol:symbol]; +                    } +                } +              else if ([context variableIsLexical:symbol])                  [lexenv setValue:value forSymbol:symbol];                else if ([dynamicContext bindingForSymbol:symbol])                  [dynamicContext setValue:value forSymbol:symbol]; @@ -859,7 +876,7 @@ static MLKSymbol *_LOOP;                if (rest) -                return [self eval:[MLKCons cons:SETQ with:rest] +                return [self eval:[MLKCons cons:car with:rest]                               inLexicalContext:context                               withEnvironment:lexenv];                else diff --git a/MLKPackage.m b/MLKPackage.m index ae839d4..66a2fbb 100644 --- a/MLKPackage.m +++ b/MLKPackage.m @@ -91,6 +91,7 @@ static NSMutableDictionary *packages = nil;    [sys export:[sys intern:@"%DEFMACRO"]];    [sys export:[sys intern:@"%LAMBDA"]];    [sys export:[sys intern:@"%FSET"]]; +  [sys export:[sys intern:@"%FSETQ"]];    [sys export:[sys intern:@"%LOOP"]];    [sys export:[sys intern:@"%FLET"]];    [sys export:[sys intern:@"%MACROLET"]]; | 
