示例#1
0
LISPTR lisp_read(FILE* in)
{
	LISPTR s = NIL;
	wchar_t ch = fgetwc(in);
	while (iswspace(ch)) {
		ch = fgetwc(in);
	}
	if (ch == '(') {
		// start of cons
		LISPTR last = s = cons(lisp_read(in), NIL);
		while (true) {
			ch = fgetwc(in); while (iswspace(ch)) { ch = fgetwc(in); }
			if (ch==WEOF || ch==')') { break; }
			ungetwc(ch, in);
			LISPTR e = lisp_read(in);
			rplacd(last, cons(e, NIL));
			last = cdr(last);
		}
	} else if (ch == '\'') {
		// '<expr>, sugar for (QUOTE <expr>)
		s = cons(QUOTE, cons(lisp_read(in), NIL));
	} else if (ch == '#') {
		// so-called sharpsign or 'dispatching macro character'
		// http://www.lispworks.com/documentation/HyperSpec/Body/02_dh.htm
		ch = fgetwc(in);
		switch (ch) {
		case '\'':				// function-quote
			s = cons(FUNCTION, cons(lisp_read(in), NIL));
			break;
		default:
			lisp_error(L"invalid char after #");
			break;
		} // switch
	} else if (ch == WEOF) {
		// end of file, return NIL.
	} else {
		// must be an atom - number, symbol or string
		wchar_t name[MAX_ATOM_CHARS];
		int n = 0;
		while (true) {
			if (n < MAX_ATOM_CHARS) {
				name[n++] = towupper(ch);
			}
			ch = fgetwc(in);
			if (ch==WEOF) break;				// better not be inside a string, eh?
			if (name[0] != '"') {
				// not a string
				if (iswspace(ch)) break;
				if (ch==')' || ch=='(') {
					ungetwc(ch, in);
					break;
				}
			} else {
				// collecting a string
				if (ch=='\\') {
					ch = fgetwc(in);
					if (ch==WEOF) break;		// bad luck er bad string syntax
				} else if (ch=='"') {
					break;				// end of string
				}
			}
		} // while (true)
		name[n] = 0;
		if (name[0] == '"') {
			s = intern_string(name+1);
		} else if (isnumber(name)) {
			s = intern_number(name);
		} else {
			s = intern(name);
		}
	}
	return s;
}
示例#2
0
文件: eval.c 项目: JackMc/BasicLisp
struct lisp_object *c_eval(struct lisp_object *obj) {
  if (!obj) {
    lisp_error();
    return NULL;
  }
  
  if (obj->quoted) {
    struct lisp_object *new_obj = lisp_object_deep_copy(obj);
    new_obj->quoted = C_FALSE;
    return new_obj;
  }

  switch (obj->obj_type) {
  case LIST:
  {
    struct lisp_object *ret = make_lisp_object(LIST, NULL);
    
    struct lisp_object *head = HEAD(obj);

    if (!head) {
      // It already is nil
      return ret;
    }

    struct lisp_object *func = c_eval(head);

    if (!func) {
      set_error("Function %s doesn't exist.", TOSTR(head));
      return NULL;
    }

    if (func->obj_type != BUILTIN && func->obj_type != FUNCTION) {
      set_error("First object in list is not a function.", SYM_NAME(head));
      return NULL;
    }

    /* Allocate an object to be used to store the copied arguments list */
    struct lisp_object *args = make_lisp_object(LIST, NULL);
    
    if (head->next) {
      struct lisp_object *args_head;

      if (func->obj_type == BUILTIN && (TOBUILTIN(func)->spec & UNEVAL_ARGS)) {
        args_head = lisp_object_deep_copy(head->next);
      }
      else {
	       args_head = c_eval(head->next);

         if (!args_head) {
           return NULL;
         }
      }

      args_head->next = NULL;
      args_head->prev = NULL;
      struct lisp_object *current = head->next->next;

      struct lisp_object *args_current = NULL;

      struct lisp_object *args_prev = args_head;

      while (current) {
        if (func->obj_type == BUILTIN && (TOBUILTIN(func)->spec & UNEVAL_ARGS)) {
          args_current = lisp_object_deep_copy(current);
        }
        else {
          args_current = c_eval(current);
          if (!args_current) {
            return NULL;
          }
        }

        args_current->prev = args_prev;
        args_current->next = NULL;
        args_prev->next = args_current;

        args_prev = args_current;
        current = current->next;
      }

      /* Finish constructing the arguments list */
      args->data = args_head;
    }

    /* Perform the function call. */
    if (func->obj_type == BUILTIN) {
      int count = list_length(args);

      struct lisp_builtin *builtin = TOBUILTIN(func);

      if (builtin->max_params != -1 && count > builtin->max_params) {
        set_error("Incorrect number of arguments (%d) to function %s!", count, TOSTR(head));
      }

      if (builtin->min_params != -1 && count < builtin->min_params) {
        set_error("Incorrect number of arguments (%d) to function %s!", count, TOSTR(head));
      }

      return builtin->func(args);
    }
    else if (func->obj_type == FUNCTION) {
      struct lisp_function *func_obj = TOFUNC(func);

      int count = list_length(args);

      char *func_name = head->obj_type == SYMBOL ? TOSTR(head) : "<unnamed lambda>";

      if (count != func_obj->numparams) {
        set_error("Incorrect number of arguments (%d) to function %s!", count, func_name);
        return NULL;
      }

      int i = 0;
      struct lisp_object *params_current = HEAD(func_obj->params);
      struct lisp_object *args_current = HEAD(args);
      struct symbol *syms = malloc(sizeof(struct symbol)*count);

      while (params_current) {
        syms[i].symbol_name = SYM_NAME(params_current);
        syms[i].value = args_current;

        i++;
        params_current = params_current->next;
        args_current = args_current->next;
      }

      set_local_symbols(syms, count);

      struct lisp_object *form_current = func_obj->forms;

      struct lisp_object *sub = nil;

      while (form_current) {
        sub = c_eval(form_current);

        if (!sub) {
          return NULL;
        }

        // Keep track of the return value
        ret = sub;

        form_current = form_current->next;
      }

      unset_local_symbols();

      free(syms);

      return ret;
    }
  }
  case SYMBOL:
  {
    /* Do a lookup of the symbol and return the value. */
    struct lisp_object *value = symbol_value(SYM_NAME(obj));

    if (!value) {
      set_error("Symbol %s does not exist!", SYM_NAME(obj));
    }

    return value;
  }
  default:
  {
    return lisp_object_deep_copy(obj);
  }
  }
}