diff --git a/s48/rt-modules/interfaces.scm b/s48/rt-modules/interfaces.scm new file mode 100644 index 0000000..8a3a24a --- /dev/null +++ b/s48/rt-modules/interfaces.scm @@ -0,0 +1,15 @@ +(define-interface rt-modules-interface + (export ((lambda-interface + with-names-from-rt-structure) + :syntax) + reify-structure + load-structure + load-config-file + rt-structure-binding)) + +(define-interface rt-modules-core-interface + (export interface-value-names + reify-structure + load-config-file + rt-structure-binding + load-structure)) \ No newline at end of file diff --git a/s48/rt-modules/packages.scm b/s48/rt-modules/packages.scm new file mode 100644 index 0000000..d4c1953 --- /dev/null +++ b/s48/rt-modules/packages.scm @@ -0,0 +1,46 @@ +(define-structure rt-modules rt-modules-interface + + (open scheme + rt-modules-core) + (for-syntax (open scheme + rt-modules-core)) + + (begin + (define-syntax lambda-interface + (lambda (expr rename compare) + (let ((%lambda (rename 'lambda)) + (interface-name (cadr expr)) + (body (cddr expr))) + `(,%lambda ,(interface-value-names interface-name) ,@body)))) + + (define-syntax with-names-from-rt-structure + (lambda (expr rename compare) + (let ((%lambda (rename 'lambda)) + (%let (rename 'let)) + (%rt-structure-value (rename 'rt-structure-value)) + (%rt-structure-binding (rename 'rt-structure-binding)) + (rt-structure (cadr expr)) + (interface-name (caddr expr)) + (body (cdddr expr))) + (let ((ivn (interface-value-names interface-name))) + `(,%let ((,%rt-structure-value ,rt-structure)) + ((,%lambda ,ivn ,@body) + ,@(map (lambda (name) + `(,%rt-structure-binding ,%rt-structure-value ',name)) + ivn))))))))) + +(define-structure rt-modules-core rt-modules-core-interface + (open scheme + meta-types ; syntax-type + interfaces ; for-each-declaration + define-record-types + records + signals + bindings + packages + packages-internal + locations + environments + ensures-loaded + package-commands-internal) + (files rt-module)) diff --git a/s48/rt-modules/rt-module.scm b/s48/rt-modules/rt-module.scm new file mode 100644 index 0000000..1ba9438 --- /dev/null +++ b/s48/rt-modules/rt-module.scm @@ -0,0 +1,56 @@ +(define (interface-value-names interface-name) + (let ((interface (environment-ref (config-package) interface-name)) + (value-names '())) + (for-each-declaration + (lambda (name base-neme type) + (if (not (equal? type syntax-type)) + (set! value-names (cons name value-names)))) + interface) + value-names)) + +(define-record-type rt-structure :rt-structure + (make-rt-structure meta-structure) + rt-structure? + (meta-structure rt-structure-meta-structure)) + +(define (rt-structure-loaded? rt-structure) + (package-loaded? + (structure-package (rt-structure-meta-structure rt-structure)))) + +(define-record-discloser :rt-structure + (lambda (s) + (list 'rt-stucture (structure-name (rt-structure-meta-structure s))))) + +(define (reify-structure name) + (let ((struct (get-structure name))) + (make-rt-structure struct))) + +(define (load-structure rts) + (ensure-loaded (rt-structure-meta-structure rts))) + +(define (rt-structure-binding structure name) + (if (not (rt-structure-loaded? structure)) + (error "Structure not loaded" structure)) + (contents + (binding-place + (generic-lookup (rt-structure-meta-structure structure) + name)))) + +(define (load-config-file file) + (load file (config-package))) + +;(define-structure t (export b) +; (open scheme +; signals +; define-record-types +; primitives) +; (begin +; (define-record-type bar :bar +; (make-bar i) +; bar? +; (i bar-i)) +; (define a-bar (make-bar "kjk")) +; (add-finalizer! :bar (lambda (a-bar) (warn "finalized a bar"))))) + + + \ No newline at end of file