From 4e987026148fe65c323afbc93cd560c07bf06b3f Mon Sep 17 00:00:00 2001
From: Yale AI Dept <ai@nebula.cs.yale.edu>
Date: Wed, 14 Jul 1993 13:08:00 -0500
Subject: Import to github.

---
 csys/dump-flic.scm | 130 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 130 insertions(+)
 create mode 100644 csys/dump-flic.scm

(limited to 'csys/dump-flic.scm')

diff --git a/csys/dump-flic.scm b/csys/dump-flic.scm
new file mode 100644
index 0000000..0fc654d
--- /dev/null
+++ b/csys/dump-flic.scm
@@ -0,0 +1,130 @@
+;;; dump-flic.scm -- general dump functions for flic structures
+;;;
+;;; author :  Sandra Loosemore
+;;; date   :  24 Feb 1993
+;;;
+;;;
+;;; This stuff is used to write inline expansions to the interface file.
+;;; 
+
+
+(define-flic-walker dump-flic (object var-renamings))
+
+(define (dump-flic-list objects var-renamings)
+  (let ((result  '()))
+    (dolist (o objects)
+      (push (dump-flic o var-renamings) result))
+    `(list ,@(nreverse result))))
+
+(define (dump-flic-top object)
+  (dump-flic object '()))
+
+
+(define (make-temp-bindings-for-dump oldvars var-renamings)
+  (let ((vars      '())
+	(bindings  '()))
+    (dolist (v oldvars)
+      (let ((var  (def-name v))
+	    (temp (gensym)))
+	(push temp vars)
+	(push `(,temp (create-temp-var ',var)) bindings)
+	(push (cons v temp) var-renamings)))
+    (setf bindings (nreverse bindings))
+    (setf vars (nreverse vars))
+    (values vars bindings var-renamings)))
+
+(define-dump-flic flic-lambda (object var-renamings)
+  (multiple-value-bind (vars bindings var-renamings)
+      (make-temp-bindings-for-dump (flic-lambda-vars object) var-renamings)
+    `(let ,bindings
+       (make-flic-lambda
+	 (list ,@vars)
+	 ,(dump-flic (flic-lambda-body object) var-renamings)))
+    ))
+
+(define-dump-flic flic-let (object var-renamings)
+  (multiple-value-bind (vars bindings var-renamings)
+      (make-temp-bindings-for-dump (flic-let-bindings object) var-renamings)
+    `(let ,bindings
+       ,@(map (lambda (temp v)
+		`(setf (var-value ,temp)
+		       ,(dump-flic (var-value v) var-renamings)))
+	      vars
+	      (flic-let-bindings object))
+       (make-flic-let
+	 (list ,@vars)
+	 ,(dump-flic (flic-let-body object) var-renamings)
+	 ',(flic-let-recursive? object)))
+    ))
+
+(define-dump-flic flic-app (object var-renamings)
+  `(make-flic-app
+     ,(dump-flic (flic-app-fn object) var-renamings)
+     ,(dump-flic-list (flic-app-args object) var-renamings)
+     ',(flic-app-saturated? object)))
+
+(define-dump-flic flic-ref (object var-renamings)
+  (let* ((var    (flic-ref-var object))
+	 (entry  (assq var var-renamings)))
+    (if entry
+	`(make-flic-ref ,(cdr entry))
+	`(make-flic-ref ,(dump-object var)))))
+
+(define-dump-flic flic-const (object var-renamings)
+  (declare (ignore var-renamings))
+  `(make-flic-const ',(flic-const-value object)))
+
+(define-dump-flic flic-pack (object var-renamings)
+  (declare (ignore var-renamings))
+  `(make-flic-pack ,(dump-object (flic-pack-con object))))
+
+(define-dump-flic flic-case-block (object var-renamings)
+  `(make-flic-case-block
+     ',(flic-case-block-block-name object)
+     ,(dump-flic-list (flic-case-block-exps object) var-renamings)))
+
+(define-dump-flic flic-return-from (object var-renamings)
+  `(make-flic-return-from
+     ',(flic-return-from-block-name object)
+     ,(dump-flic (flic-return-from-exp object) var-renamings)))
+
+(define-dump-flic flic-and (object var-renamings)
+  `(make-flic-and
+     ,(dump-flic-list (flic-and-exps object) var-renamings)))
+
+(define-dump-flic flic-if (object var-renamings)
+  `(make-flic-if
+     ,(dump-flic (flic-if-test-exp object) var-renamings)
+     ,(dump-flic (flic-if-then-exp object) var-renamings)
+     ,(dump-flic (flic-if-else-exp object) var-renamings)))
+
+(define-dump-flic flic-sel (object var-renamings)
+  `(make-flic-sel
+     ,(dump-object (flic-sel-con object))
+     ,(flic-sel-i object)
+     ,(dump-flic (flic-sel-exp object) var-renamings)))
+
+(define-dump-flic flic-is-constructor (object var-renamings)
+  `(make-flic-is-constructor
+     ,(dump-object (flic-is-constructor-con object))
+     ,(dump-flic (flic-is-constructor-exp object) var-renamings)))
+
+(define-dump-flic flic-con-number (object var-renamings)
+  `(make-flic-con-number
+     ,(dump-object (flic-con-number-type object))
+     ,(dump-flic (flic-con-number-exp object) var-renamings)))
+
+(define-dump-flic flic-void (object var-renamings)
+  (declare (ignore object var-renamings))
+  `(make-flic-void))
+    
+
+
+
+
+
+
+	
+
+    
+
-- 
cgit v1.2.3