Learn how easy it is to sync an existing GitHub or Google Code repo to a SourceForge project! See Demo

Close

[e90b2f]: src / cmp / cmpbind.lsp Maximize Restore History

Download this file

cmpbind.lsp    96 lines (90 with data), 3.3 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
;;;;
;;;; 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)))
)))
;;; 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)))