mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-24 13:31:58 -08:00
48d5420b16
This is useful for identification, where the problem occured. Also add some indent and line wrap fixes which are estetic. Comment out unused variable.
97 lines
3.7 KiB
Common Lisp
97 lines
3.7 KiB
Common Lisp
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; indent-tabs-mode: nil; Package: C -*-
|
|
;;;; vim: set filetype=lisp tabstop=8 shiftwidth=2 expandtab:
|
|
|
|
;;;;
|
|
;;;; CMPBIND Variable Binding.
|
|
;;;;
|
|
;;;; Copyright (c) 1990, Giuseppe Attardi.
|
|
;;;;
|
|
;;;; This file is part of ECoLisp, herein referred to as ECL.
|
|
;;;;
|
|
;;;; ECL is free software; you can redistribute it and/or modify it under
|
|
;;;; the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
|
|
;;;; the Free Software Foundation; either version 2 of the License, or
|
|
;;;; (at your option) any later version.
|
|
;;;;
|
|
;;;; See file '../Copyright' for full details.
|
|
|
|
(in-package "COMPILER")
|
|
|
|
;;; bind must be called for each variable in a lambda or let, once the value
|
|
;;; to be bound has been placed in loc.
|
|
;;; bind takes care of setting var-loc.
|
|
|
|
(defun bind (loc var)
|
|
;; loc can be either (LCL n), 'VA-ARGS, (KEYVARS n), (CAR n),
|
|
;; a constant, or (VAR var) from a let binding. ; ccb
|
|
(declare (type var var))
|
|
(case (var-kind var)
|
|
(CLOSURE
|
|
(let ((var-loc (var-loc var)))
|
|
(unless (typep var-loc 'fixnum)
|
|
;; first binding: assign location
|
|
(setq var-loc (next-env))
|
|
(setf (var-loc var) var-loc))
|
|
(when (zerop var-loc) (wt-nl "env" *env-lvl* " = ECL_NIL;"))
|
|
(wt-nl "CLV" var-loc " = env" *env-lvl* " = CONS(")
|
|
(wt-coerce-loc :object loc)
|
|
(wt ",env" *env-lvl* ");")
|
|
(wt-comment (var-name var))))
|
|
(LEXICAL
|
|
(let ((var-loc (var-loc var)))
|
|
(unless (consp var-loc)
|
|
;; first binding: assign location
|
|
(setq var-loc (next-lex))
|
|
(setf (var-loc var) var-loc))
|
|
(wt-nl) (wt-lex var-loc) (wt " = ")
|
|
(wt-coerce-loc :object loc)
|
|
(wt ";"))
|
|
(wt-comment (var-name var)))
|
|
((SPECIAL GLOBAL)
|
|
(bds-bind loc var))
|
|
(t
|
|
(cond ((not (eq (var-loc var) 'OBJECT))
|
|
;; already has location (e.g. optional in lambda list)
|
|
;; check they are not the same
|
|
(unless (equal (var-loc var) loc)
|
|
(wt-nl var " = ")
|
|
(wt-coerce-loc (var-rep-type var) loc)
|
|
(wt ";")))
|
|
((and (consp loc) (eql (car loc) 'LCL))
|
|
;; set location for lambda list requireds
|
|
(setf (var-loc var) loc))
|
|
(t
|
|
(baboon :format-control "bind: unexpected var-kind (~s) and loc (~s)."
|
|
:format-arguments (list (var-kind var) loc)))))))
|
|
|
|
;;; Used by let*, defmacro and lambda's &aux, &optional, &rest, &keyword
|
|
(defun bind-init (form var)
|
|
(let ((kind (var-kind var)))
|
|
(if (member kind '(CLOSURE LEXICAL SPECIAL GLOBAL))
|
|
;; Binding these variables is complicated and involves lexical
|
|
;; environments, global environments, etc. If we use `(BIND var)
|
|
;; as destination, BIND might receive the wrong environment.
|
|
(let* ((*inline-blocks* 0)
|
|
(*temp* *temp*)
|
|
(locs (coerce-locs (inline-args (list form)))))
|
|
(bind (first locs) var)
|
|
(close-inline-blocks)
|
|
;; Notice that we do not need to update *UNWIND-EXIT*
|
|
;; because BIND does it for us.
|
|
)
|
|
;; The simple case of a variable which is local to a function.
|
|
(let ((*destination* `(BIND ,var)))
|
|
(c2expr* form)))))
|
|
|
|
(defun bds-bind (loc var)
|
|
;; Optimize the case (let ((*special-var* *special-var*)) ...)
|
|
(cond ((and (var-p loc)
|
|
(member (var-kind loc) '(global special))
|
|
(eq (var-name loc) (var-name var)))
|
|
(wt-nl "ecl_bds_push(cl_env_copy," (var-loc var) ");"))
|
|
(t
|
|
(wt-nl "ecl_bds_bind(cl_env_copy," (var-loc var) ",")
|
|
(wt-coerce-loc :object loc)
|
|
(wt ");")))
|
|
(push 'BDS-BIND *unwind-exit*)
|
|
(wt-comment (var-name var)))
|