Progress towards making the compiler run on other R7RS implementations.portable-cyclone

16 files changed, 320 insertions, 138 deletions

diff --git a/cyclone.scm b/cyclone.scm
index c5b14a8b..4045a99d 100644
--- a/cyclone.scm
+++ b/cyclone.scm
@@ -24,6 +24,27 @@
         (scheme cyclone libraries)
         (srfi 18))
 
+(cond-expand
+ ((not cyclone)
+  (import (scheme process-context)
+	  (only (rename (scheme list)
+			(fold foldl))
+		foldl)))
+ (else))
+
+(cond-expand
+ (chibi
+  (import (chibi filesystem)))
+ ((and (library (srfi 170))
+       (library (srfi 19)))
+  (import (library (srfi 170))
+          (library (srfi 19))))
+ (else))
+
+(cond-expand
+ (chibi (import (chibi process)))
+ (else))
+
 (define *fe:batch-compile* #t) ;; Batch compilation. TODO: default to false or true??
 (define *optimization-level* 2) ;; Default level
 (define *optimize:memoize-pure-functions* #f) ;; Memoize pure function
@@ -74,17 +95,34 @@
            (string-length dir))
        (equal? dir (substring path 0 (string-length dir)))))
 
+(cond-expand
+ (cyclone
 (define-c file-mtime
   "(void *data, int argc, closure _, object k, object filename)"
   " make_double(box, 0.0);
     Cyc_check_str(data, filename);
     double_value(&box) = Cyc_file_last_modified_time(string_str(filename));
-    return_closcall1(data, k, &box); ")
-
+    return_closcall1(data, k, &box); "))
+ (chibi
+  (define file-mtime file-modification-time))
+ (guile
+  (define (file-mtime filename)
+    (stat:mtime (stat filename))))
+ ((and (library (srfi 170))
+       (library (srfi 19)))
+  (define (file-mtime filename)
+    (time-second (file-info:mtime (file-info filename #f)))))
+ (else
+  (error "no available definition of file-mtime")))
+
+(cond-expand
+ (cyclone
 (define-c calling-program
   "(void *data, int argc, closure _, object k)"
   " make_utf8_string(data, s, _cyc_argv[0]);
-    return_closcall1(data, k, &s); ")
+    return_closcall1(data, k, &s); "))
+ (else
+  (define (calling-program) (car (command-line)))))
 ;; END batch compilation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -999,6 +1037,13 @@
         (string-append " " prefix " " dir " "))
       dirs)))
 
+(cond-expand
+ (cyclone)
+ ((or guile chibi gauche)
+  (define (command-line-arguments)
+    (cdr (command-line))))
+ (else (error "no implementation of (command-line-arguments)")))
+
 ;; Handle command line arguments
 (let* ((args (command-line-arguments))
        (non-opts 
diff --git a/scheme/base.sld b/scheme/base.sld
index ecae30da..283e1973 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -2054,19 +2054,6 @@
       (and (not (null? lis))
            (if (eq? e (car lis)) n (lp (cdr lis) (+ n 1)))))))
 
-;(define (record? obj)
-;  (and (vector? obj)
-;       (> (vector-length obj) 0)
-;       (or 
-;        (equal? record-marker (vector-ref obj 0))
-;        (equal? (list 'record-marker) (vector-ref obj 0))
-;       ) 
-;       ))
-
-(define-c record?
-  "(void *data, int argc, closure _, object k, object obj)"
-  " return_closcall1(data, k, Cyc_is_record(obj)); ")
-
 (define (is-a? obj rtype)
   (and (record? obj)
        (record? rtype)
diff --git a/scheme/cyclone/ast.sld b/scheme/cyclone/ast.sld
index 194e9412..effc9582 100644
--- a/scheme/cyclone/ast.sld
+++ b/scheme/cyclone/ast.sld
@@ -26,14 +26,10 @@
      ast:get-next-lambda-id!
      ast:reset-lambda-ids!
      ast:ast->pp-sexp
-     ast:ast->sexp
-     ast:sexp->ast
+     (rename ast->sexp ast:ast->sexp)
+     (rename sexp->ast ast:sexp->ast)
   )
   (begin
-    (define ast:ast->sexp ast->sexp)
-
-    (define ast:sexp->ast sexp->ast)
-
     (define *lambda-id* 0)
 
     (define (ast:get-next-lambda-id!)
diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld
index 3be3001b..ea491997 100644
--- a/scheme/cyclone/cgen.sld
+++ b/scheme/cyclone/cgen.sld
@@ -9,11 +9,12 @@
 (define-library (scheme cyclone cgen)
   (import (scheme base)
           (scheme char)
+	  (scheme cxr)
           (scheme complex)
           (scheme eval)
           (scheme inexact)
           (scheme write)
-          (cyclone foreign)
+          ;; (cyclone foreign)
           (srfi 69)
           (scheme cyclone primitives)
           (scheme cyclone transforms)
@@ -21,6 +22,13 @@
           (scheme cyclone cps-optimizations)
           (scheme cyclone util)
           (scheme cyclone libraries))
+  (cond-expand
+   ((not cyclone)
+    (import (only (rename (scheme list)
+			  (fold foldl)
+			  (fold-right foldr))
+		  foldl foldr)))
+   (else))
   (export
     mta:code-gen
     autogen
@@ -34,12 +42,15 @@
     emit-newline
     ;; Helpers
     self-closure-call?)
-  (inline
-    global-not-lambda?
-    global-lambda?
-    c:num-args
-    c:allocs
-    st:->var)
+  (cond-expand
+   (cyclone
+    (inline
+     global-not-lambda?
+     global-lambda?
+     c:num-args
+     c:allocs
+     st:->var))
+   (else))
   (begin
 
 (define *cgen:track-call-history* #t)
@@ -716,9 +727,14 @@
 (define (->cstr str) 
   (string-append "\"" (cstr:escape-chars str) "\""))
 
+(cond-expand
+ (cyclone
 (define-c string-byte-length
   "(void *data, int argc, closure _, object k, object s)"
-  " return_closcall1(data, k, Cyc_string_byte_length(data, s)); ")
+  " return_closcall1(data, k, Cyc_string_byte_length(data, s)); "))
+ (else
+  (define (string-byte-length s)
+    (bytevector-length (string->utf8 s)))))
 ; cargs TODO:
 ;(define-c string-byte-length
 ;  "(void *data, object clo, int argc, object *args)"
diff --git a/scheme/cyclone/common.sld b/scheme/cyclone/common.sld
index 0465ec2f..38ad89a2 100644
--- a/scheme/cyclone/common.sld
+++ b/scheme/cyclone/common.sld
@@ -7,6 +7,7 @@
 ;;;; This module contains definitions used by the compiler and interpreter.
 ;;;;
 (define-library (scheme cyclone common)
+  (import (scheme base))
   (export 
     *Cyc-version-banner*
     *version*
@@ -15,8 +16,11 @@
     *version-banner*
     *c-file-header-comment*
     *reader-source-db*
-    memloc
-  )
+    )
+  (cond-expand
+   (cyclone
+    (export memloc))
+   (else))
   (begin
 (define *version-number* "0.36.0")
 (define *version-name* "")
@@ -57,11 +61,14 @@
 
 (define *reader-source-db* '())
 
+(cond-expand
+ (cyclone
 (define-c memloc
   "(void *data, int argc, closure _, object k, object obj)"
   " char str[32];
     sprintf(str, \"%p\", obj);
     make_utf8_string(data, s, str);
-  return_closcall1(data, k, &s);")
+  return_closcall1(data, k, &s);"))
+ (else))
 
 ))
diff --git a/scheme/cyclone/cps-opt-analyze-call-graph.scm b/scheme/cyclone/cps-opt-analyze-call-graph.scm
index 4e896aab..6106da66 100644
--- a/scheme/cyclone/cps-opt-analyze-call-graph.scm
+++ b/scheme/cyclone/cps-opt-analyze-call-graph.scm
@@ -20,7 +20,8 @@
             (srfi 2)
             (srfi 69)
             )
-    ))
+    )
+  (else))
 
 ;; symbol -> hash-table -> boolean
 ;; Is it OK to inline code replacing ref, based on call graph data from lookup table?
@@ -261,4 +262,5 @@
     ;  (ast:ast->pp-sexp
     ;    (opt:local-var-reduction (ast:sexp->ast sexp)))
     ;)
-))
+    )
+  (else))
diff --git a/scheme/cyclone/cps-opt-local-var-redux.scm b/scheme/cyclone/cps-opt-local-var-redux.scm
index be573f4d..61f40b50 100644
--- a/scheme/cyclone/cps-opt-local-var-redux.scm
+++ b/scheme/cyclone/cps-opt-local-var-redux.scm
@@ -14,7 +14,8 @@
             (scheme cyclone ast) 
             (scheme cyclone primitives)
             (scheme cyclone util) 
-            (scheme cyclone pretty-print))))
+            (scheme cyclone pretty-print)))
+  (else))
 
 ;; Local variable reduction:
 ;; Reduce given sexp by replacing certain lambda calls with a let containing
@@ -434,4 +435,5 @@
       (ast:ast->pp-sexp
         (opt:local-var-reduction (ast:sexp->ast sexp)))
     )
-    ))
+    )
+  (else))
diff --git a/scheme/cyclone/cps-opt-memoize-pure-fncs.scm b/scheme/cyclone/cps-opt-memoize-pure-fncs.scm
index 1b096394..2718b6f7 100644
--- a/scheme/cyclone/cps-opt-memoize-pure-fncs.scm
+++ b/scheme/cyclone/cps-opt-memoize-pure-fncs.scm
@@ -20,7 +20,8 @@
             (srfi 2)
             (srfi 69)
             )
-    ))
+    )
+  (else))
 
 ;; Predicate to determine if a function can be memoized
 ;; var - symbol - global name of the function
@@ -371,4 +372,5 @@
 ;;    ;  (ast:ast->pp-sexp
 ;;    ;    (opt:local-var-reduction (ast:sexp->ast sexp)))
 ;;    ;)
-))
+)
+  (else))
diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld
index c79b6f20..c49afde1 100644
--- a/scheme/cyclone/cps-optimizations.sld
+++ b/scheme/cyclone/cps-optimizations.sld
@@ -10,6 +10,7 @@
 ;(define-library (cps-optimizations) ;; For debugging via local unit tests
 (define-library (scheme cyclone cps-optimizations)
   (import (scheme base)
+	  (scheme cxr)
           (scheme eval)
           (scheme write)
           (scheme cyclone util)
@@ -18,6 +19,12 @@
           (scheme cyclone transforms)
           (srfi 2)
           (srfi 69))
+  (cond-expand
+   ((not cyclone)
+    (import (only (rename (scheme list)
+			  (fold foldl))
+		  foldl)))
+   (else))
   (export
       closure-convert 
       analyze:cc-ast->vars
@@ -125,6 +132,12 @@
     (define (opt:add-inlinable-functions lis)
       (set! *inlinable-functions* lis))
 
+    (cond-expand
+     ((not cyclone)
+      (define (create-environment . args)
+	(environment '(scheme base))))
+     (else))
+
     (define
       *contract-env* 
       (let ((env (create-environment '() '())))
@@ -1440,11 +1453,11 @@
             (cddr exp)))
           ((and (not (prim? (car exp)))
                 (ref? (car exp)))
-           (define pure-fnc #f)
-           (define calling-cont #f)
-           (define ref-formals '())
            ;; Does ref refer to a pure function (no side effects)?
-           (let ((var (adb:get/default (car exp) #f)))
+           (let ((pure-fnc #f)
+		 (calling-cont #f)
+		 (ref-formals '())
+		 (var (adb:get/default (car exp) #f)))
             (if var
                 (let ((lid (adbv:defines-lambda-id var))
                       (assigned-val (adbv:assigned-value var)))
@@ -1715,13 +1728,13 @@
             (let ((var (adb:get/default id #f)))
               (when (and var (adbv:self-rec-call? var))
                 (and-let*
-                  ((a-value (adbv:assigned-value var))
-                   ((pair? a-value))
-                   ((ast:lambda? (car a-value)))
-                   (lid (ast:lambda-id (car a-value))))
-(trace:info `(TODO ,id ,lid ,a-value))
+                    ((a-value (adbv:assigned-value var))
+                     ((pair? a-value))
+                     ((ast:lambda? (car a-value)))
+                     (lid (ast:lambda-id (car a-value))))
+		  (trace:info `(TODO ,id ,lid ,a-value))
                   (with-fnc! lid (lambda (fnc)
-                    (adbf:set-calls-self! fnc #t))))
+				   (adbf:set-calls-self! fnc #t))))
               ))
           )
           idents)))
diff --git a/scheme/cyclone/hashset.sld b/scheme/cyclone/hashset.sld
index 555dbe3c..b466ee6f 100644
--- a/scheme/cyclone/hashset.sld
+++ b/scheme/cyclone/hashset.sld
@@ -23,11 +23,11 @@
       hs-remove!
       hs-member?
     )
-    (import (scheme base)
-            (scheme write))
-    (include-c-header "cyclone/hashset.h")
-    (begin
-
+    (import (scheme base))
+    (cond-expand
+     (cyclone
+      (include-c-header "cyclone/hashset.h")
+      (begin
 (define-c hs-create
   "(void *data, int argc, closure _, object k )"
   "
@@ -80,6 +80,28 @@
     hashset_t hs = (hashset_t)(opaque_ptr(opq));
     int rv = hashset_is_member(hs, item);
     return_closcall1(data, k, rv ? boolean_t : boolean_f);
-  ")
+  ")))
+     ((and (library (srfi 113))
+	   (library (srfi 128)))
+      (import (srfi 113)
+	      (srfi 128))
+      (begin
+	(define (hs-create)
+	  (set (make-default-comparator)))
+
+	;; Do nothing, assume GC
+	(define (hs-destroy! . args) (values))
+
+	(define hs-num-items set-size)
+
+	(define hs-add! set-adjoin!)
+
+	(define (hs-add-all! hs lis)
+	  (apply set-adjoin! hs lis))
+
+	(define hs-remove! set-delete!)
 
-))
+	(define (hs-member? hs item)
+	  (set-member hs item #f))))
+     (else
+      (error "no implementation of (scheme cyclone hashset) available"))))
diff --git a/scheme/cyclone/libraries.sld b/scheme/cyclone/libraries.sld
index ea355c13..4641398a 100644
--- a/scheme/cyclone/libraries.sld
+++ b/scheme/cyclone/libraries.sld
@@ -10,11 +10,20 @@
 ;;;;
 (define-library (scheme cyclone libraries)
   (import (scheme base)
+	  (scheme cxr)
+	  (scheme file)
           ;(scheme write) ;; Debug only 
           (scheme read)
           (scheme process-context)
           (scheme cyclone util)
-  )
+	  )
+  (cond-expand
+   ((not cyclone)
+    (import (only (rename (scheme list)
+			  (fold foldl)
+			  (fold-right foldr))
+		  foldl foldr)))
+   (else))
   (export
     library?
     library-exists?
@@ -65,13 +74,53 @@
     lib:idb:lookup
     lib:idb:entry->library-name
     lib:idb:entry->library-id
-  )
-  (inline
-    lib:idb:entry->library-name
-    lib:import-set->import-set
-  )
+    )
+  (cond-expand
+   ((not cyclone)
+    (export Cyc-installation-dir))
+   (else))
+  (cond-expand
+   (cyclone
+    (inline
+     lib:idb:entry->library-name
+     lib:import-set->import-set
+     ))
+   (else))
   (begin
 
+(cond-expand
+ ((not cyclone)
+  (define (read-all . args)
+    (let* ((fp (if (null? args)
+		   (current-input-port)
+		   (car args)))
+	   (ssi! (if (and (pair? args)
+			  (pair? (cdr args)))
+		     (cadr args)
+		     #f)) ;; Default
+	   (fname (if (and ssi!
+			   (pair? (cddr args)))
+		      (caddr args)
+		      #f)))
+      (define (loop fp result)
+	(let ((obj (read fp ssi! fname)))
+	  (if (eof-object? obj)
+	      (reverse result)
+	      (loop fp (cons obj result)))))
+      (loop fp '())))
+
+  (define (Cyc-installation-dir type)
+    (let ((base (get-environment-variable "CYCLONE_PREFIX")))
+      (unless base
+	(error "CYCLONE_PREFIX environment variable must be set when building with an implementation of Scheme other than Cyclone"))
+      (case type
+	((sld) (string-append base "/share/cyclone"))
+	((lib) (string-append base "/lib"))
+	((bin) (string-append base "/bin"))
+	((inc) (string-append base "/include/cyclone"))
+	(else  base)))))
+ (else))
+
 ;; Alias friendlier names to SRFI libraries
 (define *srfi-aliases*
   '( ;; Red Edition
@@ -747,11 +796,6 @@
    (lib:get-dep-list libraries/deps)
    ))
 
-;; Given a list of alists (library-name . imports), return an ordered
-;; list of library names such that each lib is encounted after the
-;; libraries it imports (it's dependencies).
-(define lib:get-dep-list resolve-dependencies)
-
 ;; Goal is to resolve a list of dependencies into the appropriate order such 
 ;; that no node is encountered before its dependencies.
 ;; We also need to raise an error if a circular dependency is found
@@ -792,4 +836,9 @@
          (deps (reverse (cdr (get-cell resolved))))) ;; cdr to get rid of master list
     (map car deps)))
 
+;; Given a list of alists (library-name . imports), return an ordered
+;; list of library names such that each lib is encounted after the
+;; libraries it imports (it's dependencies).
+(define lib:get-dep-list resolve-dependencies)
+
 ))
diff --git a/scheme/cyclone/pass-validate-syntax.scm b/scheme/cyclone/pass-validate-syntax.scm
index 74689670..dadbc757 100644
--- a/scheme/cyclone/pass-validate-syntax.scm
+++ b/scheme/cyclone/pass-validate-syntax.scm
@@ -14,7 +14,8 @@
       (scheme base)
       (scheme read)
       (scheme cyclone pretty-print)
-      (scheme cyclone util))))
+      (scheme cyclone util)))
+  (else))
 ;;
 ;; TODO: call this from cyclone.scm after it works, probably after "resolve macros"
 
@@ -59,7 +60,8 @@
   (define (search exp vars)
     (cond-expand
       (program
-        (pretty-print `(search ,exp ,vars))(newline))) ;; Debugging
+       (pretty-print `(search ,exp ,vars))(newline)) ;; Debugging
+      (else))
     (cond
       ;((ast:lambda? exp) 'TODO)
       ((const? exp) #f)
@@ -111,4 +113,5 @@
     ;(if 1 2 3 4)
     
      (let ((sexp (read-all (open-input-file "validation.scm"))))
-      (validate-keyword-syntax sexp))))
+       (validate-keyword-syntax sexp)))
+  (else))
diff --git a/scheme/cyclone/pretty-print.sld b/scheme/cyclone/pretty-print.sld
index c4350a63..e573c9f1 100644
--- a/scheme/cyclone/pretty-print.sld
+++ b/scheme/cyclone/pretty-print.sld
@@ -10,7 +10,9 @@
 (define-library (scheme cyclone pretty-print)
     (export pretty-print)
     (import (scheme base)
-            (scheme write))
+	    (scheme cxr)
+            (scheme write)
+	    (scheme cyclone util))
     (begin
       (define pretty-print #f)
       (define pp-width 80) ;; TODO: make configurable?
diff --git a/scheme/cyclone/primitives.sld b/scheme/cyclone/primitives.sld
index 3c8e60bc..d77e2ca9 100644
--- a/scheme/cyclone/primitives.sld
+++ b/scheme/cyclone/primitives.sld
@@ -8,10 +8,15 @@
 ;;;;
 (define-library (scheme cyclone primitives)
   (import (scheme base)
+	  (scheme cxr)
           (scheme cyclone hashset)
           ;(scheme write)
           (srfi 69)
-  )
+	  )
+  (cond-expand
+   ((not cyclone)
+    (import (rename (scheme list) (fold foldl))))
+   (else))
   (export
     prim?
     *primitives*
diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld
index bf432073..c2956182 100644
--- a/scheme/cyclone/transforms.sld
+++ b/scheme/cyclone/transforms.sld
@@ -11,6 +11,7 @@
 (define-library (scheme cyclone transforms)
   (import (scheme base)
           (scheme char)
+	  (scheme cxr)
           (scheme eval)
           (scheme file)
           (scheme read)
@@ -22,7 +23,13 @@
           (scheme cyclone pretty-print)
           (scheme cyclone util)
           (srfi 69)
-  )
+	  )
+  (cond-expand
+   ((not cyclone)
+    (import (only (rename (scheme list)
+			  (fold-right foldr))
+		  foldr)))
+   (else))
   (export
     *do-code-gen*
     *trace-level*
@@ -98,27 +105,30 @@
     prim-convert
     validate-keyword-syntax
   )
-  (inline
-    cell-get->cell
-    cell->value
-    set-cell!->value
-    set-cell!->cell
-    env-get->env
-    env-get->field
-    env-get->id
-    env-make->id
-    closure->fv
-    closure->env
-    closure->lam
-    begin->exps
-    app->args
-    app->fun
-    letrec->exp
-    letrec->bindings
-    let->exp
-    let->bindings
-    void
-  )
+  (cond-expand
+   (cyclone
+    (inline
+     cell-get->cell
+     cell->value
+     set-cell!->value
+     set-cell!->cell
+     env-get->env
+     env-get->field
+     env-get->id
+     env-make->id
+     closure->fv
+     closure->env
+     closure->lam
+     begin->exps
+     app->args
+     app->fun
+     letrec->exp
+     letrec->bindings
+     let->exp
+     let->bindings
+     void
+     ))
+   (else))
   (include "pass-validate-syntax.scm")
   (begin
 
@@ -172,17 +182,9 @@
 
 ;; Utilities.
 
+; symbol<? : symbol symbol -> boolean
 (cond-expand
-  (cyclone
-    ; void : -> void
-    (define (void) (if #f #t)))
-  (else #f))
-
-; symbol<? : symbol symobl -> boolean
-;(define (symbol<? sym1 sym2)
-;  (string<? (symbol->string sym1)
-;            (symbol->string sym2)))
-
+ (cyclone
 (define-c symbol<?
   "(void *data, int argc, closure _, object k, object sym1, object sym2)"
   "
@@ -200,16 +202,15 @@
                      ? boolean_t : boolean_f;
      return result;
   ")
+  )
+ (else
+  (define (symbol<? sym1 sym2)
+    (string<? (symbol->string sym1)
+              (symbol->string sym2)))))
 
 ; insert : symbol sorted-set[symbol] -> sorted-set[symbol]
-;(define (insert sym S)
-;  (if (not (pair? S))
-;      (list sym)
-;      (cond
-;        ((eq? sym (car S))       S)
-;        ((symbol<? sym (car S))  (cons sym S))
-;        (else (cons (car S) (insert sym (cdr S)))))))
-;
+(cond-expand
+ (cyclone
 (define-c insert
  "(void *data, int argc, closure _, object k_7318, object sym_731_7312, object S_732_7313)"
  "
@@ -260,7 +261,15 @@ if (acc) {
 } else {
   return_closcall1(data, k_7318, result);
 }
-")
+"))
+ (else
+  (define (insert sym S)
+    (if (not (pair? S))
+	(list sym)
+	(cond
+	 ((eq? sym (car S))       S)
+	 ((symbol<? sym (car S))  (cons sym S))
+	 (else (cons (car S) (insert sym (cdr S)))))))))
 
 ; remove : symbol sorted-set[symbol] -> sorted-set[symbol]
 (define (remove sym S)
diff --git a/scheme/cyclone/util.sld b/scheme/cyclone/util.sld
index 2d9db7b3..72abf115 100644
--- a/scheme/cyclone/util.sld
+++ b/scheme/cyclone/util.sld
@@ -8,7 +8,8 @@
 ;;;;
 (define-library (scheme cyclone util)
   (import (scheme base)
-          (scheme char))
+          (scheme char)
+	  (scheme cxr))
   (export
     ;; Code analysis
     define-syntax?
@@ -35,7 +36,7 @@
     if-else? 
     if->else 
     const? 
-    ref? 
+    ref?
     quote? 
     define-c?
     set!? 
@@ -94,26 +95,45 @@
     take
     drop
     filter
-    current-expand-filepath)
-  (inline
-    env:frame-values
-    env:frame-variables
-    env:first-frame
-    env:enclosing-environment
-    lambda->exp
-    lambda->formals
-    define->exp
-    set!->exp
-    set!->var
-    ref?
-    app?
-    if->else
-    if->then
-    if->condition
-    tagged-list?
-  )
+    current-expand-filepath
+    void
+    record?)
+  (cond-expand
+   (cyclone
+    (inline
+     env:frame-values
+     env:frame-variables
+     env:first-frame
+     env:enclosing-environment
+     lambda->exp
+     lambda->formals
+     define->exp
+     set!->exp
+     set!->var
+     ref?
+     app?
+     if->else
+     if->then
+     if->condition
+     tagged-list?))
+   (else))
   (begin
 
+(define (void) (if #f #t))
+
+(cond-expand
+ (cyclone
+  (define-c record?
+    "(void *data, int argc, closure _, object k, object obj)"
+    " return_closcall1(data, k, Cyc_is_record(obj)); "))
+ (else
+  (define (record? obj)
+    (and (vector? obj)
+	 (> (vector-length obj) 0)
+	 (or
+	  (equal? record-marker (vector-ref obj 0))
+	  (equal? (list 'record-marker) (vector-ref obj 0)))))))
+
 (define current-expand-filepath (make-parameter #f))
 
 (define (tagged-list? tag exp)
@@ -761,9 +781,9 @@
                     (loop input output current) ;; Ignore delim by itself
                     (loop input (add current output) '()))
                 (loop input output (cons char current))))))))
-
 ;; Immutable Object section
-
+(cond-expand
+ (cyclone
 ;; Internal helper function - set immutable field on a single obj
 (define-c _Cyc-set-immutable!
    "(void *data, int argc, closure _, object k, object obj, object val)"
@@ -773,7 +793,6 @@
       result = boolean_t;
     }
     return_closcall1(data, k, result); ")
-
 ;; Recursively update the immutable field for the given object
 (define (Cyc-set-immutable! obj val)
   (_Cyc-set-immutable! obj val)
@@ -781,7 +800,10 @@
     ((pair? obj) 
      (_Cyc-set-immutable! (car obj) val)
      (_Cyc-set-immutable! (cdr obj) val))
-    ((vector? obj) (vector-for-each (lambda (o) (_Cyc-set-immutable! o val)) obj))))
+    ((vector? obj) (vector-for-each (lambda (o) (_Cyc-set-immutable! o val)) obj)))))
+ (else
+  ;; Hopefully the compiler doesn't actually need this to run.
+  (define (Cyc-set-immutable! obj val)
+    (void))))
 ;; END immutables
-
 ))