/* -*- mode: objc; coding: utf-8 -*- */
/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
 * Copyright (C) 2008  Matthias Andreas Benkard.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 */

#import "MLKBinding.h"
#import "MLKCons.h"
#import "MLKDynamicContext.h"
#import "MLKInterpreter.h"
#import "MLKNumber.h"
#import "MLKPackage.h"
#import "MLKRoot.h"
#import "MLKStream.h"
#import "MLKSymbol.h"
#import "MLKInteger.h"
#import "MLKSingleFloat.h"
#import "MLKDoubleFloat.h"
#import "NSObject-MLKPrinting.h"
#import "runtime-compatibility.h"
#import "util.h"

#import <Foundation/NSArray.h>
#import <Foundation/NSException.h>
#import <Foundation/NSInvocation.h>
#import <Foundation/NSMethodSignature.h>
#import <Foundation/NSNull.h>
#import <Foundation/NSStream.h>
#import <Foundation/NSString.h>


static NSMethodSignature *signature;
static MLKPackage *sys;
static MLKPackage *cl;


static id truify (BOOL value)
{
  return (value ? (id) [cl intern:@"T"] : nil);
}

#define RETURN_VALUE(thing)                     \
  { return [NSArray arrayWithObject:nullify(thing)]; }


@implementation MLKRoot
+(void) initialize
{
  signature = RETAIN ([self methodSignatureForSelector:@selector(car:)]);
  sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
  cl = [MLKPackage findPackage:@"COMMON-LISP"];
}

+(NSArray *) dispatch:(MLKSymbol *)name withArguments:(NSArray *)args
{
  NSInvocation *invocation;
  NSMutableString *methodName;
  NSArray *result;
  SEL selector;
  BOOL nothing_found;

  nothing_found = NO;

  NS_DURING
    {
      if ([sys findSymbol:[name name]] != name)
        NS_VALUERETURN (nil, NSArray *);
    }
  NS_HANDLER
    {
      nothing_found = YES;
    }
  NS_ENDHANDLER;

  if (nothing_found)
    return nil;

  invocation = [NSInvocation invocationWithMethodSignature:signature];

  methodName = [NSMutableString stringWithString:[[name name] lowercaseString]];
  [methodName replaceOccurrencesOfString:@"-"
              withString:@"_"
              options:NSLiteralSearch
              range:NSMakeRange(0, [methodName length])];
  [methodName appendString:@":"];

  selector = NSSelectorFromString (methodName);
  
  if (!selector || ![self respondsToSelector:selector])
    return nil;

  [invocation setSelector:selector];
  [invocation setTarget:self];
  [invocation setArgument:&args atIndex:2];

  [invocation invoke];
  [invocation getReturnValue:&result];

  return result;
}

+(NSArray *) car:(NSArray *)args
{
  return [NSArray arrayWithObject:nullify([denullify([args objectAtIndex:0]) car])];
}

+(NSArray *) cdr:(NSArray *)args
{
  return [NSArray arrayWithObject:nullify([denullify([args objectAtIndex:0]) cdr])];
}

+(NSArray *) rplaca:(NSArray *)args
{
  MLKCons *cons = [args objectAtIndex:0];
  [cons setCar:denullify([args objectAtIndex:1])];
  RETURN_VALUE (cons);
}

+(NSArray *) rplacd:(NSArray *)args
{
  MLKCons *cons = [args objectAtIndex:0];
  [cons setCdr:denullify([args objectAtIndex:1])];
  RETURN_VALUE (cons);  
}

+(NSArray *) cons:(NSArray *)args
{
  return [NSArray arrayWithObject:
                    [MLKCons cons:denullify([args objectAtIndex:0])
                             with:denullify([args objectAtIndex:1])]];
}

+(NSArray *) load:(NSArray *)args
{
  // FIXME
  BOOL success;
  NSString *fileName = denullify ([args objectAtIndex:0]);
  NSInputStream *input = [NSInputStream inputStreamWithFileAtPath:fileName];
  MLKStream *stream = AUTORELEASE ([[MLKStream alloc] initWithInputStream:input]);

  //NSLog (@"%d", [input hasBytesAvailable]);
  [input open];
  //NSLog (@"%d", [input hasBytesAvailable]);

  success = [MLKInterpreter load:stream verbose:YES print:YES];

  [input close];

  RETURN_VALUE (truify (success));
}

+(NSArray *) eq:(NSArray *)args
{
  RETURN_VALUE (truify ([args objectAtIndex:0] == [args objectAtIndex:1]));
}

+(NSArray *) symbolp:(NSArray *)args
{
  id arg0 = [args objectAtIndex:0];
  RETURN_VALUE (truify (arg0 == [NSNull null]
                        || [arg0 isKindOfClass:[MLKSymbol class]]));
}

+(NSArray *) listp:(NSArray *)args
{
  id arg0 = [args objectAtIndex:0];
  RETURN_VALUE (truify (arg0 == [NSNull null]
                        || [arg0 isKindOfClass:[MLKCons class]]));
}

+(NSArray *) consp:(NSArray *)args
{
  id arg0 = [args objectAtIndex:0];
  RETURN_VALUE (truify ([arg0 isKindOfClass:[MLKCons class]]));
}

+(NSArray *) atom:(NSArray *)args
{
  id arg0 = [args objectAtIndex:0];
  RETURN_VALUE (truify (![arg0 isKindOfClass:[MLKCons class]]));
}

+(NSArray *) null:(NSArray *)args
{
  RETURN_VALUE (truify ([args objectAtIndex:0] == [NSNull null]));
}

+(NSArray *) add:(NSArray *)args
{
  RETURN_VALUE ([((MLKNumber*)[args objectAtIndex:0]) add:[args objectAtIndex:1]]);
}

+(NSArray *) subtract:(NSArray *)args
{
  RETURN_VALUE ([((MLKNumber*)[args objectAtIndex:0]) subtract:[args objectAtIndex:1]]);
}

+(NSArray *) multiply:(NSArray *)args
{
  RETURN_VALUE ([((MLKNumber*)[args objectAtIndex:0]) multiplyWith:[args objectAtIndex:1]]);
}

+(NSArray *) divide:(NSArray *)args
{
  RETURN_VALUE ([((MLKNumber*)[args objectAtIndex:0]) divideBy:[args objectAtIndex:1]]);
}

+(NSArray *) list:(NSArray *)args
{
  RETURN_VALUE ([MLKCons listWithArray:args]);
}

+(NSArray *) macroexpand_1:(NSArray *)args
{
  id form = [args objectAtIndex:0];
  id env = [args count] > 1 ? denullify([args objectAtIndex:1]) : nil;
  MLKLexicalContext *context = env ? (id)env : (id)[MLKLexicalContext globalContext];

  if ([form isKindOfClass:[MLKCons class]]
      && (![form car] || [[form car] isKindOfClass:[MLKSymbol class]])
      && [context symbolNamesMacro:[form car]])
    {
      id <MLKFuncallable> macrofun = [context macroForSymbol:[form car]];
      form = denullify ([[macrofun applyToArray:
                                     [NSArray arrayWithObjects:
                                                form, context, nil]]
                          objectAtIndex:0]);
    }

  RETURN_VALUE (form);
}

+(NSArray *) macroexpand_all:(NSArray *)args
{
  id form = [args objectAtIndex:0];
  id env = [args count] > 1 ? denullify([args objectAtIndex:1]) : nil;
  MLKLexicalContext *context = env ? (id)env : (id)[MLKLexicalContext globalContext];

  return [MLKInterpreter eval:form
                         inLexicalContext:context
                         withEnvironment:nil
                         expandOnly:YES];
}

+(NSArray *) shadow:(NSArray *)args
{
  id symbols = denullify ([args objectAtIndex:0]);
  id package = denullify (([args count] > 1
                           ? [args objectAtIndex:1]
                           : [[MLKDynamicContext currentContext]
                               valueForSymbol:
                                 [[MLKPackage findPackage:@"COMMON-LISP"]
                                   intern:@"*PACKAGE*"]]));

  if (![symbols isKindOfClass:[MLKCons class]])
    symbols = [MLKCons cons:symbols with:nil];

  do
    {
      [package shadow:stringify([symbols car])];
    }
  while ((symbols = [symbols cdr]));

  RETURN_VALUE ([cl intern:@"T"]);
}

+(NSArray *) export:(NSArray *)args
{
  id symbols = denullify ([args objectAtIndex:0]);
  id package = denullify (([args count] > 1
                           ? [args objectAtIndex:1]
                           : [[MLKDynamicContext currentContext]
                               valueForSymbol:
                                 [[MLKPackage findPackage:@"COMMON-LISP"]
                                   intern:@"*PACKAGE*"]]));

  if (![symbols isKindOfClass:[MLKCons class]])
    symbols = [MLKCons cons:symbols with:nil];

  do
    {
      [package export:[symbols car]];
    }
  while ((symbols = [symbols cdr]));

  RETURN_VALUE ([cl intern:@"T"]);
}

+(NSArray *) unexport:(NSArray *)args
{
  id symbols = denullify ([args objectAtIndex:0]);
  id package = denullify (([args count] > 1
                           ? [args objectAtIndex:1]
                           : [[MLKDynamicContext currentContext]
                               valueForSymbol:
                                 [[MLKPackage findPackage:@"COMMON-LISP"]
                                   intern:@"*PACKAGE*"]]));

  if (![symbols isKindOfClass:[MLKCons class]])
    symbols = [MLKCons cons:symbols with:nil];

  do
    {
      [package unexport:[symbols car]];
    }
  while ((symbols = [symbols cdr]));

  RETURN_VALUE ([cl intern:@"T"]);
}

+(NSArray *) find_package:(NSArray *)args
{
  NSString *name = stringify (denullify ([args objectAtIndex:0]));
  MLKPackage *package = [MLKPackage findPackage:name];

  if (package)
    {
      RETURN_VALUE (package);
    }
  else
    {
      [NSException raise:@"MLKNoSuchPackageError"
                   format:@"The package %@ does not exist",
                          [name descriptionForLisp]];
      return nil;
    }
}

+(NSArray *) string:(NSArray *)args
{
  RETURN_VALUE (stringify (denullify ([args objectAtIndex:0])));
}

+(NSArray *) gensym:(NSArray *)args
{
  NSString *prefix;
  NSString *suffix;
  MLKBinding *gensymCounter = [[MLKDynamicContext currentContext]
                                bindingForSymbol:
                                  [[MLKPackage findPackage:@"COMMON-LISP"]
                                    intern:@"*GENSYM-COUNTER*"]];

  if ([args count] > 0)
    {
      id x = [args objectAtIndex:0];
      if ([x isKindOfClass:[NSString class]])
        {
          prefix = x;
          suffix = [[gensymCounter value] descriptionForLisp];
          [gensymCounter
            setValue:[[gensymCounter value]
                       add:[MLKInteger integerWithInt:1]]];
        }
      else if ([x isKindOfClass:[MLKInteger class]])
        {
          // x must be an integer.
          prefix = @"G";
          suffix = [x descriptionForLisp];
        }
      else
        [NSException raise:@"MLKTypeError"
                     format:@"%@ is not of type (OR INTEGER STRING).", x];
    }
  else
    {
      prefix = @"G";
      suffix = [[gensymCounter value] descriptionForLisp];
      [gensymCounter
        setValue:[[gensymCounter value]
                   add:[MLKInteger integerWithInt:1]]];
    }

  RETURN_VALUE (([MLKSymbol symbolWithName:[NSString stringWithFormat:@"%@%@",
                                                                      prefix,
                                                                      suffix]
                            package:nil]));
}

+(NSArray *) make_symbol:(NSArray *)args
{
  NSString *name = [args objectAtIndex:0];

  RETURN_VALUE ([MLKSymbol symbolWithName:name package:nil]);
}

+(NSArray *) intern:(NSArray *)args
{
  NSString *name = [args objectAtIndex:0];
  id package = denullify (([args count] > 1
                           ? [args objectAtIndex:1]
                           : [[MLKDynamicContext currentContext]
                               valueForSymbol:
                                 [[MLKPackage findPackage:@"COMMON-LISP"]
                                   intern:@"*PACKAGE*"]]));
  MLKSymbol *symbol = [package intern:name];

  RETURN_VALUE (symbol);
}

+(NSArray *) import:(NSArray *)args
{
  MLKSymbol *symbol = [args objectAtIndex:0];
  id package = denullify (([args count] > 1
                           ? [args objectAtIndex:1]
                           : [[MLKDynamicContext currentContext]
                               valueForSymbol:
                                 [[MLKPackage findPackage:@"COMMON-LISP"]
                                   intern:@"*PACKAGE*"]]));

  [package import:symbol];

  RETURN_VALUE ([cl intern:@"T"]);
}

+(NSArray *) objc_class_of:(NSArray *)args
{
  RETURN_VALUE ([[args objectAtIndex:0] class]);
}

+(NSArray *) objc_subclassp:(NSArray *)args
{
  RETURN_VALUE (truify ([[args objectAtIndex:0] isSubclassOfClass:
                                                  [args objectAtIndex:1]]));
}

+(NSArray *) find_objc_class:(NSArray *)args
{
  RETURN_VALUE (NSClassFromString ([args objectAtIndex:0]));
}

+(NSArray *) ns_log:(NSArray *)args
{
  NSString *description = [[args objectAtIndex:0] descriptionForLisp];
  NSLog (@"%@", description);
  RETURN_VALUE ([args objectAtIndex:0]);
}

+(NSArray *) symbol_name:(NSArray *)args
{
  MLKSymbol *symbol = denullify ([args objectAtIndex:0]);
  RETURN_VALUE (symbol ? (id)[symbol name] : (id)@"NIL");
}
@end