/*
   Written by Pieter J. Schoenmakers <tiggr@ics.ele.tue.nl>

   Copyright (C) 1996-1998 Pieter J. Schoenmakers.

   This file is part of TOM.  TOM is distributed under the terms of the
   TOM License, a copy of which can be found in the TOM distribution; see
   the file LICENSE.

   $Id: OTMMethod.m,v 1.74 1998/03/22 18:39:02 tiggr Exp $  */

#define OTMMETHOD_DECLARE_PRIVATE_METHODS
#import "OTMMethod.h"
#import "OTMArgument.h"
#import "OTMBasic.h"
#import "OTMDynamicType.h"
#import "OTMExtension.h"
#import "OTMInvocation.h"
#import "OTMMeta.h"
#import "OTMRefVar.h"
#import "OTMTuple.h"
#import "OTMType.h"
#import "OTMTypeTuple.h"
#import "OTMVariable.h"

@implementation OTMMethod

+(OTMMethod *) methodWithExtension: (OTMExtension *) ext
			      name: (TLString *) n
			returnType: (id) rt
			     flatp: (BOOL) flatp
{
  return [[self gcAlloc] initWithExtension: ext name: n returnType: rt
			 flatp: flatp];
}

+(OTMMethod *) methodWithExtension: (OTMExtension *) ext
			 nameTypes: (TLCons *) nt
			returnType: (id) rt
			     flatp: (BOOL) flatp
{
  return [[self gcAlloc] initWithExtension: ext nameTypes: nt returnType: rt
			 flatp: flatp];
}

+(LTTSelector *) selectorForMethod: (OTMMethod *) m
			invocation: (OTMInvocation *) inv
			      used: (BOOL) used_p
{
  TLVector *ne = [m nameParts];
  id on, in_args = nil;
  OTMType *rt = inv ? [inv type] : [m returnType];
  LTTSelector *rs;

  on = formac (nil, @"%@", [rt frobnicatedName]);

  if (!ne)
    formac (on, @"_%@", [m methodName]);
  else
    {
      TLVector *a = [m arguments];
      int i, n = [ne length];
      int skip = [m implicitArguments];

      for (i = 0; i < n; i++)
	{
	  OTMType *t = [[a _elementAtIndex: i + skip] type];

	  if (t == the_dynamic_type && inv)
	    t = [[[inv arguments] _elementAtIndex: i] type];

	  if (t != basic_type[BT_VOID])
	    in_args = formac (in_args, @"%@", [t flatFrobnicatedName]);
	  formac (on, @"_%@_%@", [ne _elementAtIndex: i], [t frobnicatedName]);
	}
    }

  rs = [CO_LTTSelector selectorWithName: on
		    inArgs: (in_args ? in_args : @"")
		    outArgs: rt ? [rt flatFrobnicatedName] : @""];

  if (used_p)
    [rs noteUsage];

  return rs;
}

-(void) addOutArgsFrom: (OTMTypeTuple *) tup
		  skip: (BOOL) skip
{
  TLVector *v = [tup elements];
  int mi, mn;

  for (mi = 0, mn = [v length]; mi < mn; mi++)
    {
      OTMType *tp = [v _elementAtIndex: mi];

      if ([tp isTuple])
	[self addOutArgsFrom: (OTMTypeTuple *) tp skip: skip];
      else if (!skip)
	{
	  OTMRefVar *v = [CO_OTMRefVar temporaryVariableWithType: tp];

	  [out_args addElement: v];
	}
      skip = NO;
    }
}

-(BOOL) allowedRedeclaration: (OTMMethod *) m
		  inSubclass: (BOOL) subclass_p
{
  TLVector *others = [m arguments];
  int i, n = [others length];

  if (n != [arguments length])
    return NO;

  for (i = 0; i < n; i++)
    if (![[(OTMVariable *) [arguments _elementAtIndex: i] type]
	  allowedTypeForArgumentRedeclaration:
	    [(OTMVariable *) [others _elementAtIndex: i] type]
	  inSubclass: subclass_p])
      return NO;

  return YES;
}

-(OTMExpr *) argumentDefaultAt: (int) index
{
  return [arg_values _elementAtIndex: index];
}

-(TLVector *) argumentsForNameParts: (TLVector *) name_parts
			  arguments: (TLVector *) args
{
  int en = name_elements ? [name_elements length] : 0;
  int pi, ei, pn = [name_parts length];
  TLVector *r = [CO_TLVector vectorWithCapacity: en];
  id npn = [name_parts _elementAtIndex: 0];
  int ia = [self implicitArguments];

  for (ei = pi = 0; ei < en; ei++)
    {
      id npe = [name_elements _elementAtIndex: ei];

      if (npe == npn)
	{
	  [r addElement: [args _elementAtIndex: pi]];
	  npn = (++pi == pn) ? nil : [name_parts _elementAtIndex: pi];
	}
      else
	{
	  id av = [arg_values _elementAtIndex: ei + ia];

	  if (!av)
	    ABORT ();
	  else
	    {
	      if (![av type])
		resolve_expr (av, nil, nil,
			      [[[extension structure] meta] semantics]);
	      [r addElement: av];
	    }
	}
    }

  return r;
}

-(void) assignOutArgsFrom: (OTMTuple *) tup
{
  id <TLEnumerator> e = [out_args enumerator];

  [self assignOutArgsFrom: tup to: e skip: YES];
}

-(void) assignOutArgsFrom: (OTMTuple *) tup
		       to: (id <TLEnumerator>) to
		     skip: (BOOL) skip
{
  TLVector *v = [tup elements];
  int mi, mn;

  for (mi = 0, mn = [v length]; mi < mn; mi++)
    {
      OTMExpr *tp = [v _elementAtIndex: mi];

      if ([tp isTuple])
	[self assignOutArgsFrom: (OTMTuple *) tp to: to skip: skip];
      else if (!skip)
	{
	  OTMRefVar *rv = [to nextObject];

	  [rv compileAssignment: tp];
	}
      skip = NO;
    }
}

-(OTMVariable *) argumentNamed: (id <TLString>) nm
{
  int i, n = [arguments length];

  for (i = 0; i < n; i++)
    {
      id t = [arguments _elementAtIndex: i];

      if ([t isTuple])
	{
	  TLVector *vec = [t elements];
	  int j, o = [vec length];
	  OTMVariable *v;

	  for (j = 0; j < o; j++)
	    {
	      v = [vec _elementAtIndex: j];
	      if ([(id) nm equal: [v variableName]])
		return v;
	    }
	}
      else if ([(id) nm equal: [(OTMVariable *) t variableName]])
	return t;
    }

  return nil;
}

-(OTMArgument *) argumentNumbered: (int) x
{
  int i, n = [arguments length];

  for (i = 0; i < n; i++)
    {
      OTMArgument *a = [arguments _elementAtIndex: i];
      a = [a argumentNumbered: x];
      if (a)
	return a;
    }

  return nil;
}

-(TLVector *) arguments
{
  return arguments;
}

-(BOOL) argumentsTypeMatch: (TLVector *) a
{
  int i, n = [a length], offset = 0, o;
  int skip = [self implicitArguments];

  if (n != [arguments length] - skip)
    return NO;

  for (i = 0; i < n; i++)
    {
      o = [[(OTMVariable *) [arguments _elementAtIndex: i + skip] type]
	   matchesConvertibly: [[(OTMVariable *) [a _elementAtIndex: i] type]
				actualSelf: [current_either semantics]]];
      if (o < 0)
	return NO;
      offset += o;
    }

  return YES;
}

-(BOOL) builtinp
{
  return NO;
}

-(void) compileDeclarationTypes
{
  int i, n;

  [return_type compileDeclaration];

  for (i = 0, n = [arguments length]; i < n; i++)
    {
      OTMVariable *e = [arguments _elementAtIndex: i];

      [[e type] compileDeclaration];
    }

  if (out_args)
    for (i = 0, n = [out_args length]; i < n; i++)
      {
	OTMVariable *e = [out_args _elementAtIndex: i];

	[[e type] compileDeclaration];
      }
}

-(void) compileDeclaration
{
  int i, na = [arguments length];
  id previous_context = output_current_context;
  id previous_method = output_current_method;

  output_current_context = [[extension structure] meta];
  output_current_method = (id) self;

  [self compileDeclarationTypes];

  /* Output the return type.  */
  formac (of, @"%@\n", [[return_type tupleFirstFlatElement] outputTypeName]);

  /* Output the name.  */
  formac (of, @"%@ (", [self outputName]);

  if (!na)
    formac (of, @"void)\n");
  else
    {
      /* Output the arguments.  */
      for (i = 0; i < na; i++)
	{
	  OTMArgument *arg = [arguments _elementAtIndex: i];

	  if (i)
	    formac (of, @",\n\t");

	  if ([arg type] == the_dynamic_type)
	    {
	      formac (of, @"...");
	      break;
	    }

	  [arg outputDeclaration: of];
	}

      /* Output the second and following tuple return value elements.  */
      if (out_args && i == na)
	{
	  int no = [out_args length];

	  for (i = 0; i < no; i++)
	    {
	      if (i || na)
		formac (of, @",\n\t");
	      [[out_args _elementAtIndex: i] outputDeclaration: of];
	    }
	}

      /* Done.  */
      formac (of, @")");
    }

  output_current_context = previous_context;
  output_current_method = previous_method;
}

-(void) description: (id <TLMutableStream>) stream
{
  [super description: stream];

  formac (stream, @" %@", method_name (self, 0));
}

-(void) dumpInfo: (id <TLOutputStream>) s
{
  if ([self deferredp])
    formac (s, @"\n  (%#)", [[[self selector] lttName] internal]);
  else
    formac (s, @"\n  (%# %@)", [[[self selector] lttName] internal],
	    [self outputName]);
}

-(BOOL) dynamicTyped
{
  return dynamic_typing;
}

-(OTMExtension *) extension
{
  return extension;
}

-(BOOL) fitsInvocationNumArguments: (int) n
{
  int i = [self implicitArguments];
  int num_args = [arguments length];

  if (num_args - i < n
      || num_fixed_arguments - i > n)
    return NO;

  return YES;
}

-(id <TLString>) firstNamePart
{
  return name_elements ? [name_elements _elementAtIndex: 0] : internal_name;
}

-(void) gcReference
{
  MARK (extension);
  MARK (return_type);
  MARK (arguments);
  MARK (arg_values);
  MARK (out_args);
  MARK (name_elements);
  MARK (internal_name);
  MARK (the_selector);
  MARK (output_name);

  [super gcReference];
}

-(BOOL) identical: m inContext: (OTMMeta *) either
{
  OTMType *mrt = [[m returnType] actualSelf: either];
  int i, impl, impl2, num_args;
  TLVector *v;

  if (![return_type matches: mrt])
    return NO;

  num_args = [arguments length];
  v = [m arguments];
  if (num_args != [v length])
    return NO;

  impl = [self implicitArguments];
  impl2 = [m implicitArguments];
  for (i = 0; i < num_args - impl; i++)
    // Used to use `matches:', but that is wrong, sort of...
    // Thu Aug  8 13:58:41 1996, tiggr@cobra.es.ele.tue.nl
    if ([[[v _elementAtIndex: i + impl2] type] actualSelf: either]
	!= [[[arguments _elementAtIndex: i + impl] type] actualSelf: either])
      return NO;

  return YES;
}

-(int) implicitArguments
{
  return flat ? 0 : 2;
}

-initWithExtension: (OTMExtension *) ext
	returnType: (id) rt
	     flatp: (BOOL) flatp
{
  if (![super init])
    return nil;

  extension = ext;
  arguments = [CO_TLVector vector];
  arg_values = [CO_TLVector vector];
  return_type = rt;

  if ([return_type isTuple])
    {
      out_args = [CO_TLVector vector];
      [self addOutArgsFrom: (OTMTypeTuple *) return_type skip: YES];
    }
  else if (return_type == the_dynamic_type)
    dynamic_typing = 1;

  if (flatp)
    flat = YES;
  else
    {
      [arg_values addElement: nil];
      [arguments addElement: [CO_OTMArgument variableWithName: TO_NAME_SELF
					     type: basic_type[BT_RECV]
					     number: 0]];
      [arg_values addElement: nil];
      [arguments addElement: [CO_OTMArgument variableWithName: TO_NAME_CMD
					     type: basic_type[BT_SELECTOR]
					     number: 1]];
      num_fixed_arguments = 2;
    }

  [isa selectorForMethod: self invocation: nil used: NO];

  return self;
}

-initWithExtension: (OTMExtension *) ext
	      name: (TLString *) n
	returnType: (id) rt
	     flatp: (BOOL) flatp
{
  if (![self initWithExtension: ext returnType: rt flatp: flatp])
    return nil;

  internal_name = n;

  return self;
}

-initWithExtension: (OTMExtension *) ext
	 nameTypes: (TLCons *) nt
	returnType: (id) rt
	     flatp: (BOOL) flatp
{
  TLString *np;
  BOOL first = YES;

  if (![self initWithExtension: ext returnType: rt flatp: flatp])
    return nil;

  name_elements = [CO_TLVector vectorWithCapacity: 1];

  while (nt)
    {
      TLCons *o, *av;
      OTMTuple *vp, *val;
      
      DECONS (nt, o, nt);
      DECONS (o, np, av);
      DECONS (av, vp, val);

      if (np)
	{
	  [name_elements addElement: np];
	  internal_name = formac (internal_name,
				  internal_name ? @" %@" : @"%@", np);
	}

      if ([vp checkProperArgument: self])
	dynamic_typing = 1;

      if (first)
	{
	  if (val)
	    {
	      error_for (self, @"optional first argument not allowed");
	      val = nil;
	    }
	  first = NO;
	}

      [arguments addElement: vp];
      [arg_values addElement: val];
      if (!val)
	num_fixed_arguments++;
    }

  [isa selectorForMethod: self invocation: nil used: NO];

  return self;
}

-(id <TLString>) methodName
{
  return internal_name;
}

-(TLVector *) nameParts
{
  return name_elements;
}

-(BOOL) namePartsMatch: (TLVector *) name_parts
{
  int pn = [name_parts length];

  if (!name_elements)
    return ([name_parts length] == 1
	    && internal_name == [name_parts _elementAtIndex: 0]);

  {
    int en = [name_elements length], ei, pi, ia;
    id npn;

    if (en < pn)
      return NO;

    ia = [self implicitArguments];
    npn = [name_parts _elementAtIndex: 0];
    for (ei = pi = 0; ei < en; ei++)
      {
	id npe = [name_elements _elementAtIndex: ei];

	if (npe == npn)
	  npn = (++pi == pn) ? nil : [name_parts _elementAtIndex: pi];
	else if (![arg_values _elementAtIndex: ei + ia])
	  return NO;
      }

    return !npn;
  }
}

-(int) numExplicitArguments
{
  return [arguments length] - [self implicitArguments];
}

-(id <TLString>) outputName
{
  if (!output_name)
    output_name = formac (nil, @"%@_%@", [[extension structure] outputName],
			  [[[self selector] lttName] external]);

  return output_name;
}

-(id) precompile
{
  int i, n = [arguments length];

  for (i = 0; i < n; i++)
    {
      OTMArgument *a = [arguments _elementAtIndex: i];
      OTMType *t = [a type];
      [t precompile];
    }

  return self;
}

-(void) resolveIdentifiers: (OTMMeta *) meta
{
  int i, n = [arg_values length];

  for (i = 0; i < n; i++)
    {
      OTMExpr *o, *p = [arg_values _elementAtIndex: i];

      if (p)
	{
	  o = [p resolveInContext: meta];
	  if (o != p)
	    [arg_values _replaceElementAtIndex: i by: o];
	}
    }
}

-(OTMType *) returnType
{
  return return_type;
}

-(OTMVariable *) searchVariableNamed: (id <TLString>) n
{
  return [self argumentNamed: n];
}

-(LTTSelector *) selector
{
  if (!the_selector)
    the_selector = [isa selectorForMethod: self invocation: nil used: YES];

  return the_selector;
}

-(void) setHaveStackReferences: (OTMVariable *) v
{
}

-(OTMType *) typeForArgumentAtIndex: (int) i
			  inContext: (OTMMeta *) either
		       withNamePart: (TLString *) np
{
  int n = [name_elements length];

  for (; i < n; i++)
    if ([name_elements _elementAtIndex: i] == np)
      return [[[arguments _elementAtIndex: i + [self implicitArguments]]
	       type] actualSelf: either];

  ABORT ();

  return nil;
}

-(BOOL) typesMatch: (OTMMethod *) m
{
  int i, n, skip_self, skip_other;
  TLVector *others;

  if (![return_type matches: [m returnType]])
    return NO;

  skip_self = [self implicitArguments];
  skip_other = [m implicitArguments];
  others = [m arguments];
  n = [others length] - skip_other;
  if (n != [arguments length] - skip_self)
    return NO;

  for (i = 0; i < n; i++)
    if (![[(OTMVariable *) [arguments _elementAtIndex: i + skip_self] type]
	  matches: [(OTMVariable *) [others _elementAtIndex: i + skip_other]
		    type]])
      return NO;

  return YES;
}

-(void) warnDifferingArguments: (OTMMethod *) orig
{
  /* XXX */
}

-(id) resultOfInvocation: (OTMInvocation *) inv
{
  [self subclassResponsibility: _cmd];
}

-(id) resultOfInvocation: (OTMInvocation *) inv
		 toTuple: (OTMTuple *) tup
{
  [self subclassResponsibility: _cmd];
}

@end