File: theme-d-expression-rebinding.scm

package info (click to toggle)
theme-d 1.4.0-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 12,784 kB
  • sloc: lisp: 47,684; sh: 4,200; makefile: 455; ansic: 319
file content (40 lines) | stat: -rw-r--r-- 1,145 bytes parent folder | download
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
;; Copyright (C) 2008-2013 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.


;; *** Expression rebinding ***


(import (th-scheme-utilities stdutils))


(define	(rebind-match-type-expr binder repr
				expr-to-match-new
				lst-repr-clauses-new
				expr-else-new)
  (assert (is-binder? binder))
  (assert (hrecord-is-instance? repr <match-type-expression>))
  (let* ((lst-types (map cadr lst-repr-clauses-new))
	 (tt-value (get-entity-type expr-to-match-new))
	 (x-opt (optimize-match-type binder tt-value lst-types
				     lst-repr-clauses-new))
	 (opt? (car x-opt))
	 (l-processed-clauses (cdr x-opt)))
    (make-hrecord <match-type-expression>
		  (hfield-ref repr 'type)
		  (hfield-ref repr 'type-dispatched?)
		  (hfield-ref repr 'exact-type?)
		  '()
		  (hfield-ref repr 'pure?)
		  (hfield-ref repr 'static?)
		  (hfield-ref repr 'need-revision?)
		  ;; Should we give the old value here?
		  '()
		  (hfield-ref repr 'always-returns?)
		  (hfield-ref repr 'never-returns?)
		  (hfield-ref repr 'strong?)
		  expr-to-match-new
		  l-processed-clauses
		  expr-else-new
		  opt?)))