~ chicken-r7rs (master) fd8abdea593243d951ccdb66889100cf1e3c1fc9
commit fd8abdea593243d951ccdb66889100cf1e3c1fc9
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Tue May 29 17:56:25 2018 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Tue May 29 17:56:25 2018 +0200
first go at .egg file, many changes, still not compiling
diff --git a/r7rs-compile-time.scm b/r7rs-compile-time.scm
index a610a55..2fe8238 100644
--- a/r7rs-compile-time.scm
+++ b/r7rs-compile-time.scm
@@ -1,9 +1,12 @@
;;;; compile-time support code (mostly for modules)
-(import matchable)
-(use srfi-1 files extras)
-(use r7rs-library r7rs-support)
+(module r7rs-compile-time *
+
+(import scheme matchable)
+(import srfi-1 chicken.base chicken.syntax chicken.plist
+ chicken.pathname chicken.platform chicken.file)
+(import r7rs-library r7rs-support)
(define (locate-library name loc) ; must be stripped
;;XXX scan include-path?
@@ -13,8 +16,7 @@
(memq name2 ##sys#core-library-modules)
(memq name2 ##sys#core-syntax-modules)
(file-exists? (string-append sname2 ".import.so"))
- (file-exists? (string-append sname2 ".import.scm"))
- (extension-information name2))))
+ (file-exists? (string-append sname2 ".import.scm")))))
(define (process-cond-expand clauses)
;; returns list of forms of successful clause or #f
@@ -246,3 +248,5 @@
r7rs-include
r7rs-include-ci))))
(##sys#macro-environment)))
+
+)
diff --git a/r7rs-library.scm b/r7rs-library.scm
index 9d2cb5a..61589bb 100644
--- a/r7rs-library.scm
+++ b/r7rs-library.scm
@@ -7,8 +7,9 @@
(module r7rs-library *
- (import scheme chicken matchable)
- (use (only data-structures string-intersperse))
+ (import scheme chicken.base matchable)
+ (import (only chicken.string string-intersperse))
+ (import (only chicken.syntax syntax-error))
(define (fixup-import/export-spec spec loc)
(match spec
diff --git a/r7rs-support.scm b/r7rs-support.scm
index feadb9c..1606043 100644
--- a/r7rs-support.scm
+++ b/r7rs-support.scm
@@ -4,7 +4,7 @@
(module r7rs-support *
- (import scheme chicken)
+ (import scheme chicken.base chicken.syntax)
(define (macro-handler name)
(cond ((assq name (##sys#macro-environment)) => caddr)
diff --git a/r7rs.egg b/r7rs.egg
new file mode 100644
index 0000000..9630b35
--- /dev/null
+++ b/r7rs.egg
@@ -0,0 +1,33 @@
+((synopsis "R7RS compatibility")
+ (author "The Chicken Team")
+ (category lang-exts)
+ (license "BSD")
+ (dependencies matchable)
+ (test-dependencies test)
+ (components
+ (extension r7rs
+ (component-dependencies r7rs-compile-time)
+ (source-dependencies "synrules.scm"))
+ (extension r7rs-support)
+ (extension r7rs-library)
+ (extension r7rs-compile-time
+ (component-dependencies r7rs-library r7rs-support))
+ (extension scheme.base
+ (source-dependencies "scheme.base-interface.scm")
+ (types-file)
+ (component-dependencies r7rs-support r7rs-compile-time))
+ (extension scheme.case-lambda (types-file))
+ (extension scheme.char (types-file) (component-dependencies r7rs-support))
+ (extension scheme.complex (types-file))
+ (extension scheme.cxr (types-file))
+ (extension scheme.eval (types-file) (component-dependencies r7rs-library))
+ (extension scheme.file (types-file))
+ (extension scheme.inexact (types-file))
+ (extension scheme.lazy (types-file))
+ (extension scheme.load (types-file))
+ (extension scheme.process-context (types-file))
+ (extension scheme.r5rs (types-file))
+ (extension scheme.read (types-file))
+ (extension scheme.repl (types-file))
+ (extension scheme.time (types-file))
+ (extension scheme.write (types-file))))
diff --git a/r7rs.scm b/r7rs.scm
index e12cb34..9c4d162 100644
--- a/r7rs.scm
+++ b/r7rs.scm
@@ -9,14 +9,6 @@
(begin-for-syntax
(require-library r7rs-compile-time))
- ;; For extended number literals.
- (cond-expand
- (no-numbers)
- (else
- (if (feature? 'compiler-extension)
- (require-library numbers-syntax)
- (require-extension numbers))))
-
;; For #u8(...) syntax.
(require-extension srfi-4)
diff --git a/scheme.base.scm b/scheme.base.scm
index a71ea19..d0d8964 100644
--- a/scheme.base.scm
+++ b/scheme.base.scm
@@ -1,7 +1,8 @@
(module scheme.base ()
-(import (rename (except chicken vector-copy! with-exception-handler)
+(import (rename chicken.platform
(features feature-keywords)))
+(import (except chicken.condition with-exception-handler))
(import (except scheme syntax-rules assoc member list-tail
char=? char<? char>? char<=? char>=?
@@ -31,27 +32,22 @@
(begin-for-syntax
(require-library r7rs-compile-time))
(import r7rs-support)
+(import (only chicken.type :))
-(cond-expand
- (no-numbers
- (import (only scheme modulo quotient remainder))
- (import (only (rename scheme (inexact->exact exact) (exact->inexact inexact)) exact inexact)))
- (else
- (import numbers)
- (export exact-integer? exact-integer-sqrt)
- (export floor/ floor-quotient floor-remainder)
- (export rationalize)
- (export truncate truncate/ truncate-quotient truncate-remainder)))
+(export exact-integer? exact-integer-sqrt)
+(export floor/ floor-quotient floor-remainder)
+(export rationalize)
+(export truncate truncate/ truncate-quotient truncate-remainder)
;; read/write-string/line/byte
(require-library extras)
-(import (prefix (only extras read-string write-string) %))
-(import (rename (only extras read-line read-byte write-byte)
+(import (prefix (only chicken.io read-string write-string) %))
+(import (rename (only chicken.io read-line read-byte write-byte)
(read-byte read-u8)
(write-byte write-u8)))
;; flush-output
-(import (rename (only chicken flush-output)
+(import (rename (only chicken.base flush-output case-lambda)
(flush-output flush-output-port)))
;; u8-ready?
@@ -64,7 +60,7 @@
(import (only srfi-13 string-copy string-copy! string-fill! string->list))
;; For d-r-t redefinition.
-(import-for-syntax (only chicken define-record-type))
+(import-for-syntax (only chicken.base define-record-type))
;;;
;;; 4.1.7. Inclusion
diff --git a/scheme.case-lambda.scm b/scheme.case-lambda.scm
index f49bb3d..413ea16 100644
--- a/scheme.case-lambda.scm
+++ b/scheme.case-lambda.scm
@@ -1,3 +1,3 @@
(module scheme.case-lambda (case-lambda)
(import (only scheme >= car cdr eq? length)
- (only chicken case-lambda)))
+ (only chicken.base case-lambda)))
diff --git a/scheme.char.scm b/scheme.char.scm
index f792a86..05f03c8 100644
--- a/scheme.char.scm
+++ b/scheme.char.scm
@@ -7,7 +7,8 @@
string-upcase string-downcase
digit-value)
-(import chicken)
+(import chicken.base chicken.fixnum)
+(import (only chicken.type :))
(import r7rs-support)
(import
(except scheme
@@ -19,7 +20,6 @@
string-ci=? string-ci<? string-ci>? string-ci<=? string-ci>=?)
%))
-(require-library srfi-13)
(import (only srfi-13 string-map string-upcase string-downcase))
(: char-ci=? (char char #!rest char -> boolean))
diff --git a/scheme.complex.scm b/scheme.complex.scm
index a221bf3..781cbb4 100644
--- a/scheme.complex.scm
+++ b/scheme.complex.scm
@@ -1,8 +1,3 @@
(module scheme.complex ()
- (import scheme)
- (cond-expand
- (no-numbers
- (export angle magnitude imag-part real-part))
- (else
- (import numbers)
- (export angle magnitude make-polar make-rectangular imag-part real-part))))
+ (import scheme chicken.module)
+ (export angle magnitude make-polar make-rectangular imag-part real-part))
diff --git a/scheme.eval.scm b/scheme.eval.scm
index f221d82..6c167d2 100644
--- a/scheme.eval.scm
+++ b/scheme.eval.scm
@@ -1,8 +1,9 @@
(module scheme.eval (eval
environment)
- (import (rename scheme (eval %eval)) chicken)
- (use r7rs-library)
+ (import (rename scheme (eval %eval)) chicken.base)
+ (import (only chicken.type :))
+ (import r7rs-library)
;;;
;;; 6.12. Environments and evaluation
diff --git a/scheme.file.scm b/scheme.file.scm
index c83f4d3..435dd36 100644
--- a/scheme.file.scm
+++ b/scheme.file.scm
@@ -12,7 +12,8 @@
with-output-to-file)
(import scheme)
- (import (rename (only chicken delete-file file-exists? :)
+ (import (only chicken.type :))
+ (import (rename (only chicken.file delete-file file-exists?)
(file-exists? chicken-file-exists?)))
;; CHICKEN's file-exists? returns the filename when true,
diff --git a/scheme.inexact.scm b/scheme.inexact.scm
index b726af7..6744b62 100644
--- a/scheme.inexact.scm
+++ b/scheme.inexact.scm
@@ -1,9 +1,3 @@
(module scheme.inexact ()
- (import scheme)
- (cond-expand
- (no-numbers
- (import chicken)
- (export acos asin atan exp sin cos tan finite? log sqrt))
- (else
- (import numbers)
- (export acos asin atan exp infinite? sin cos tan finite? log sqrt nan?))))
+ (import scheme chicken.base chicken.module)
+ (export acos asin atan exp infinite? sin cos tan finite? log sqrt nan?))
diff --git a/scheme.lazy.scm b/scheme.lazy.scm
index 362e3e4..5fda0e4 100644
--- a/scheme.lazy.scm
+++ b/scheme.lazy.scm
@@ -3,4 +3,4 @@
force
make-promise
promise?)
- (import scheme chicken))
+ (import scheme chicken.base))
diff --git a/scheme.load.scm b/scheme.load.scm
index f664f86..460598e 100644
--- a/scheme.load.scm
+++ b/scheme.load.scm
@@ -1,5 +1,6 @@
(module scheme.load (load)
- (import chicken)
+ (import chicken.base
+ (only chicken.type :))
(import (rename scheme (load %load)
(eval %eval)))
diff --git a/scheme.process-context.scm b/scheme.process-context.scm
index c09eef2..94347bd 100644
--- a/scheme.process-context.scm
+++ b/scheme.process-context.scm
@@ -5,8 +5,11 @@
get-environment-variables)
(import scheme
- (rename chicken (exit chicken-exit))
- foreign)
+ (rename chicken.base (exit chicken-exit))
+ chicken.type
+ chicken.process-context
+ (only chicken.fixnum fx+)
+ chicken.foreign)
;;;
;;; 6.14. System interface.
@@ -69,12 +72,4 @@ extern char **environ;
;; The built-in exit runs cleanup handlers for us.
(chicken-exit (->exit-status obj)))))
-(define emergency-exit
- (case-lambda
- (()
- (emergency-exit 0))
- ((obj)
- (##sys#cleanup-before-exit)
- ((foreign-lambda void "_exit" int) (->exit-status obj)))))
-
)
diff --git a/scheme.r5rs.scm b/scheme.r5rs.scm
index 6f35d15..3dc003b 100644
--- a/scheme.r5rs.scm
+++ b/scheme.r5rs.scm
@@ -1,19 +1,13 @@
(module scheme.r5rs ()
- (import chicken)
+ (import chicken.base
+ (only chicken.type :))
(import
(rename scheme
(null-environment %null-environment)
(scheme-report-environment %scheme-report-environment)))
- (cond-expand
- (no-numbers
- (export angle))
- (else
- (import numbers)
- (export angle make-polar make-rectangular rationalize)))
-
- (require-extension scheme.eval)
+ (export angle make-polar make-rectangular rationalize)
(export null-environment scheme-report-environment)
(reexport
diff --git a/scheme.read.scm b/scheme.read.scm
index 8ca0b13..e828958 100644
--- a/scheme.read.scm
+++ b/scheme.read.scm
@@ -1,7 +1,12 @@
(module scheme.read (read)
(import (except scheme read)
- (only chicken : current-read-table feature? fluid-let fx+ fx= optional unless when)
- (only chicken case-sensitive define-constant define-inline parameterize))
+ (only chicken.type :)
+ (only chicken.platform feature?)
+ (only chicken.fixnum fx+ fx=)
+ (only chicken.read-syntax current-read-table)
+ (only chicken.base fluid-let
+ optional unless when case-sensitive
+ define-constant define-inline parameterize))
;;;
;;; 2.1 Identifiers
diff --git a/scheme.time.scm b/scheme.time.scm
index 43ae33d..f9a64e0 100644
--- a/scheme.time.scm
+++ b/scheme.time.scm
@@ -2,7 +2,10 @@
current-jiffy
jiffies-per-second)
(import (only scheme define inexact->exact)
- (only chicken : define-constant current-seconds current-milliseconds fp+))
+ (only chicken.type :)
+ (only chicken.base define-constant)
+ (only chicken.time current-seconds current-milliseconds)
+ (only chicken.flonum fp+))
;; As of 2012-06-30.
(define-constant tai-offset 35.)
diff --git a/scheme.write.scm b/scheme.write.scm
index 3a24f15..3bfc4fd 100644
--- a/scheme.write.scm
+++ b/scheme.write.scm
@@ -3,7 +3,10 @@
write-shared
write-simple)
(import (rename scheme (display display-simple) (write write-simple))
- (only chicken : feature? foldl fx+ fx= fx<= optional when))
+ (only chicken.base foldl when optional)
+ (only chicken.platform feature?)
+ (only chicken.type :)
+ (only chicken.fixnum fx+ fx= fx<=))
(when (feature? 'csi)
(set! ##sys#repl-print-hook
Trap