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.

---
 flic/flic-structs.scm | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 89 insertions(+)
 create mode 100644 flic/flic-structs.scm

(limited to 'flic/flic-structs.scm')

diff --git a/flic/flic-structs.scm b/flic/flic-structs.scm
new file mode 100644
index 0000000..2aab75c
--- /dev/null
+++ b/flic/flic-structs.scm
@@ -0,0 +1,89 @@
+;;; flic-structs.scm -- structures to define FLIC intermediate language
+;;;
+;;; author : Sandra Loosemore
+;;; date   : 24 Mar 1992
+
+
+    
+(define-struct flic-exp
+  (type-template flic-td)
+  (slots
+   (unboxed?  (type bool) (default '#f) (bit #t))
+   (cheap?    (type bool) (default '#f) (bit #t))))
+
+
+;;; Use a macro to define each subtype and a BOA constructor.
+;;; Maybe eventually the constructors will need to do additional
+;;; initialization and have to be defined by hand.
+
+(define-local-syntax (define-flic name . slots)
+  (let* ((maker  (symbol-append 'make- name))
+	 (pred   (symbol-append name '?))
+	 (args   (map (function car) slots))
+	 (inits  (map (lambda (x) (list x x)) args)))
+    `(begin
+       (define-struct ,name
+         (include flic-exp)
+	 (predicate ,pred)
+	 (slots ,@slots))
+       (define (,maker ,@args) (make ,name ,@inits))
+       ',name)))
+
+(define-flic flic-lambda
+  (vars (type  (list var)))
+  (body (type flic-exp)))
+
+(define-flic flic-let
+  ;; value exp is stored in var-value slot
+  (bindings (type (list var)))
+  (body (type flic-exp))
+  (recursive? (type bool) (bit #t)))
+
+(define-flic flic-app
+  (fn (type flic-exp))
+  (args (type (list flic-exp)))
+  ;; true if number of args exactly matches arity of fn
+  (saturated? (type bool) (bit #t)))
+
+(define-flic flic-ref
+  (var (type var)))
+
+(define-flic flic-const
+  (value (type t)))
+
+(define-flic flic-pack
+  (con (type con)))
+
+(define-flic flic-case-block
+  (block-name (type symbol))
+  (exps       (type (list flic-exp))))
+
+(define-flic flic-return-from
+  (block-name (type symbol))
+  (exp        (type flic-exp)))
+
+(define-flic flic-and
+  (exps       (type (list flic-exp))))
+
+(define-flic flic-if
+  (test-exp   (type flic-exp))
+  (then-exp   (type flic-exp))
+  (else-exp   (type flic-exp)))
+
+(define-flic flic-sel
+  (con (type con))
+  (i (type int))
+  (exp (type flic-exp)))
+
+(define-flic flic-is-constructor
+  (con (type con))
+  (exp (type flic-exp)))
+
+(define-flic flic-con-number
+  (type (type algdata))
+  (exp (type flic-exp)))
+	   
+(define-flic flic-void
+  )
+
+
-- 
cgit v1.2.3