define-namespace and SRFI-1

README.rst

@@ -0,0 +1,51 @@
+================
+define-namespace
+================
+
+DEFINE-NAMESPACE is an R5RS macro that implements a subset of R7RS's
+DEFINE-LIBRARY.
+
+-----
+Usage
+-----
+
+Syntax::
+
+    (define-namespace namespace-name [DECL list])
+
+    DECL ::= (define defbody ...)
+           | (export [identifier list])
+           | (import [IMPORTSPEC list])
+
+    IMPORTSPEC ::= (only ns [identifier list])
+               ::= (rename ns [(identifier identifier) list]
+
+    (import-from-namespace [IMPORTSPEC list])
+
+Example::
+
+    (define-namespace ns
+      (define param 5)
+      (define (f x) (* 5 x))
+      (export f))
+
+    (define-namespace ns2
+      (import (rename ns (f g)))
+      (define (f x) (* 5 (g x)))
+      (export f))
+
+    (import-from-namespace (only ns2 f))
+
+    (f 17)
+
+---------------------
+Differences from R7RS
+---------------------
+
+* There are only EXPORT, IMPORT, and BEGIN statements.
+* DEFINE-SYNTAX does not work.
+* EXPORT statements must occur after DEFINEs.
+* IMPORT only allows for ONLY and RENAME clauses.
+* Namespace names are identifers, not lists.
+* Namespaces are Scheme objects.
+* To import outside of namespaces, use IMPORT-FROM-NAMSPACE, not IMPORT.

define-namespace-5.scm

@@ -0,0 +1,91 @@
+;;; Copyright (c) 2024, Peter McGoron
+;;; 
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 
+;;; 1) Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+;;; 2) Redistributions in binary form must reproduce the above copyright
+;;; notice, this list of conditions and the following disclaimer in the
+;;; documentation and/or other materials provided with the distribution.
+;;; 
+;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;; 
+
+;;; Compatability functions.
+;;; These functions abstract the namespace container. It is implemented
+;;; as assocation lists, but by changing these functions it could be a
+;;; hash table, binary tree, etc.
+
+(define (%namespace-new) (cons '() '()))
+(define (%namespace-set! ns id val)
+  (let ((alist (car ns)))
+    (set-car! ns (cons (cons id val) alist)))) 
+(define (%namespace-get ns id)
+  (let ((alist (car ns)))
+    (cdr (assv id alist))))
+
+;;; Internal definitions.
+
+(define-syntax %import-from-namespace
+  (syntax-rules (rename only)
+    ((%import-from-namespace continue (only ns identifier rest-only ...) rest ...)
+     (begin
+       (define identifier (%namespace-get ns (quote identifier)))
+       (%import-from-namespace continue (only ns rest-only ...) rest ...)))
+    ((%import-from-namespace continue (only ns) rest ...)
+     (%import-from-namespace continue rest ...))
+    ((%import-from-namespace continue (rename ns (inside to) rename-rest ...) rest ...)
+     (begin
+       (define to (%namespace-get ns (quote inside)))
+       (%import-from-namespace continue (rename ns rename-rest ...) rest ...)))
+    ((%import-from-namespace continue (rename ns) rest ...)
+     (%import-from-namespace continue rest ...))
+    ((%import-from-namespace continue) continue)))
+
+(define-syntax %define-namespace
+  (syntax-rules (export import begin)
+    ((%define-namespace name (begin decls ...) rest ...)
+     (begin
+       (begin decls ...)
+       (%define-namespace name rest ...)))
+    ((%define-namespace name (export identifier exportspec ...) rest ...)
+     (begin
+       (%namespace-set! name (quote identifier) identifier)
+       (%define-namespace name (export exportspec ...) rest ...)))
+    ((%define-namespace name (export) rest ...)
+     (%define-namespace name rest ...))
+    ((%define-namespace name (import body ...) rest ...)
+     (%import-from-namespace (%define-namespace name rest ...)
+                             body ...))
+    ((%define-namespace name) '())))
+
+;;; External definitions.
+
+(define-syntax define-namespace
+  (syntax-rules ()
+    ((define-namespace name body ...)
+     (begin
+       (define name (%namespace-new))
+       (let ((dummy-variable '()))
+         (%define-namespace name body ...))))))
+
+(define-syntax import-from-namespace
+  (syntax-rules ()
+    ((import-from-namespace body ...)
+     (%import-from-namespace '() body ...))))
+
+(import-from-namespace (only srfi-1 fold))
+(fold (lambda (elem acc) (+ elem acc)) 0'(1 2 3 4 5))
+

define-namespace-7.scm

@@ -0,0 +1,21 @@
+;;; Compatability layer to translate DEFINE-NAMESPACE to R7RS's
+;;; DEFINE-LIBRARY.
+
+(define-syntax import-from-namespace
+  (syntax-rules ()
+    ((import-from-namespace body ...) (import body ...))))
+
+(define-syntax define-namespace
+  (syntax-rules ()
+    ((define-namespace ns body ...)
+     (define-library (namespace ns) body ...))))
+
+(display "hello world\n")
+
+(define-namespace blah
+  (begin
+    (define x 5)))
+
+(define-library (namespace blah)
+  (begin
+    (define (x) 5)))