From 1b19db54a48980f95eb58387ecc15d21c95b6a41 Mon Sep 17 00:00:00 2001 From: Joseph Donaldson Date: Sat, 19 Oct 2019 13:36:20 -0700 Subject: [PATCH 1/3] Add suport for adding a prefix to module exports extend the module system to support prefixing exported symbols with a user-provided symbol. For example, the following prefixes all of the exports from the test module with t-. (import (:prefix t- test)) You can also prefix an explicitly specified set of symbols: (import (:prefix t- doit fizzbuzz test)) In this case, doit and fizzbuzz are available as t-doit and t-fizzbuzz. The pre-exisiting alias functionality is still available and takes precendence. (import (:prfix t- (my-doit doit) fizzbuzz test)) In the above, doit is available as my-doit and fizzbuzz as t-fizzbuzz --- comptime/Module/impuse.sch | 14 ++++++--- comptime/Module/impuse.scm | 63 ++++++++++++++++++++++++++++---------- recette/module.scm | 6 ++-- 3 files changed, 59 insertions(+), 24 deletions(-) diff --git a/comptime/Module/impuse.sch b/comptime/Module/impuse.sch index 6f7e72f00..ad632aa7f 100644 --- a/comptime/Module/impuse.sch +++ b/comptime/Module/impuse.sch @@ -1,8 +1,8 @@ ;; ========================================================== ;; Class accessors -;; Bigloo (4.2c) -;; Inria -- Sophia Antipolis Fri Nov 6 10:55:25 CET 2015 -;; (bigloo.new -classgen Module/impuse.scm) +;; Bigloo (4.3g) +;; Inria -- Sophia Antipolis Thu 05 Sep 2019 08:47:27 AM CEST +;; (bigloo -classgen Module/impuse.scm) ;; ========================================================== ;; The directives @@ -11,7 +11,7 @@ ;; import (cond-expand ((and bigloo-class-sans (not bigloo-class-generate)) (static - (inline make-import::import module1080::symbol number1081::long mode1082::symbol vars1083::obj aliases1084::obj checksum1085::obj loc1086::obj src1087::obj decl1088::obj provide1089::pair-nil code1090::obj access1091::obj) + (inline make-import::import module1081::symbol number1082::long mode1083::symbol vars1084::obj aliases1085::obj prefix1086::obj checksum1087::obj loc1088::obj src1089::obj decl1090::obj provide1091::pair-nil code1092::obj access1093::obj) (inline import?::bool ::obj) (import-nil::import) (inline import-access::obj ::import) @@ -26,6 +26,8 @@ (inline import-loc::obj ::import) (inline import-checksum::obj ::import) (inline import-checksum-set! ::import ::obj) + (inline import-prefix::obj ::import) + (inline import-prefix-set! ::import ::obj) (inline import-aliases::obj ::import) (inline import-aliases-set! ::import ::obj) (inline import-vars::obj ::import) @@ -39,7 +41,7 @@ ;; The definitions (cond-expand (bigloo-class-sans ;; import -(define-inline (make-import::import module1080::symbol number1081::long mode1082::symbol vars1083::obj aliases1084::obj checksum1085::obj loc1086::obj src1087::obj decl1088::obj provide1089::pair-nil code1090::obj access1091::obj) (instantiate::import (module module1080) (number number1081) (mode mode1082) (vars vars1083) (aliases aliases1084) (checksum checksum1085) (loc loc1086) (src src1087) (decl decl1088) (provide provide1089) (code code1090) (access access1091))) +(define-inline (make-import::import module1081::symbol number1082::long mode1083::symbol vars1084::obj aliases1085::obj prefix1086::obj checksum1087::obj loc1088::obj src1089::obj decl1090::obj provide1091::pair-nil code1092::obj access1093::obj) (instantiate::import (module module1081) (number number1082) (mode mode1083) (vars vars1084) (aliases aliases1085) (prefix prefix1086) (checksum checksum1087) (loc loc1088) (src src1089) (decl decl1090) (provide provide1091) (code code1092) (access access1093))) (define-inline (import?::bool obj::obj) ((@ isa? __object) obj (@ import module_impuse))) (define (import-nil::import) (class-nil (@ import module_impuse))) (define-inline (import-access::obj o::import) (-> |#!bigloo_wallow| o access)) @@ -56,6 +58,8 @@ (define-inline (import-loc-set! o::import v::obj) (set! (-> |#!bigloo_wallow| o loc) v)) (define-inline (import-checksum::obj o::import) (-> |#!bigloo_wallow| o checksum)) (define-inline (import-checksum-set! o::import v::obj) (set! (-> |#!bigloo_wallow| o checksum) v)) +(define-inline (import-prefix::obj o::import) (-> |#!bigloo_wallow| o prefix)) +(define-inline (import-prefix-set! o::import v::obj) (set! (-> |#!bigloo_wallow| o prefix) v)) (define-inline (import-aliases::obj o::import) (-> |#!bigloo_wallow| o aliases)) (define-inline (import-aliases-set! o::import v::obj) (set! (-> |#!bigloo_wallow| o aliases) v)) (define-inline (import-vars::obj o::import) (-> |#!bigloo_wallow| o vars)) diff --git a/comptime/Module/impuse.scm b/comptime/Module/impuse.scm index 2a22be324..eec67a018 100644 --- a/comptime/Module/impuse.scm +++ b/comptime/Module/impuse.scm @@ -47,6 +47,7 @@ (mode::symbol (default 'import)) (vars (default '())) (aliases (default '())) + (prefix (default #f)) (checksum (default #unspecified)) (loc read-only) (src read-only) @@ -123,15 +124,18 @@ ;*---------------------------------------------------------------------*/ ;* import-all-module ... */ ;*---------------------------------------------------------------------*/ -(define (import-all-module module::symbol mode src) +(define (import-all-module module::symbol prefix mode src) (let ((mi (hashtable-get *imports* module))) (if (import? mi) - (import-vars-set! mi 'all) + (begin + (import-vars-set! mi 'all) + (import-prefix-set! mi prefix)) (let ((loc (find-location/loc src (find-location *module-clause*)))) (register-import! (instantiate::import (module module) (mode mode) + (prefix prefix) (vars 'all) (loc loc) (src src))))))) @@ -144,7 +148,7 @@ ;* The CAR is the declared name of the binding and the CDR */ ;* the aliased named, used in alias import clauses. */ ;*---------------------------------------------------------------------*/ -(define (import-1-module module::symbol var alias mode src) +(define (import-1-module module::symbol prefix var alias mode src) (let ((mi (hashtable-get *imports* module))) (if (import? mi) ;; patch the previous import @@ -160,15 +164,21 @@ 'nothing) (else (import-vars-set! mi - (cons (cons var #f) (import-vars mi)))))) + (cons (cons var (if prefix (symbol-append prefix var) #f)) + (import-vars mi)))))) ;; register a new import - (let ((loc (find-location/loc src (find-location *module-clause*)))) + (let ((loc (find-location/loc src (find-location *module-clause*))) + (aliases (if alias (list (cons var alias)) '())) + (prefixes (if (and var prefix) + (list (cons var (symbol-append prefix var))) + '()))) (register-import! (instantiate::import (module module) (mode mode) - (aliases (if alias (list (cons var alias)) '())) - (vars (if alias '() (list (cons var #f)))) + (prefix prefix) + (aliases (if alias aliases prefixes)) + (vars (if (or prefix alias) '() (list (cons var #f)))) (loc loc) (src src))))))) @@ -196,6 +206,9 @@ ;* | (variable module-name) */ ;* | (variable module-name) */ ;* | (variable module-name "file-name" *) */ +;* | (prefix: prefix-symbol module-name) +;* | (prefix: prefix-symbol var-symbol module-name) +;* | (prefix: prefix-symbol var-symbol module-name "file-name") ;* variable ::= symbol */ ;* | (symbol symbol) */ ;*---------------------------------------------------------------------*/ @@ -213,13 +226,25 @@ (define (variable? v) (or (symbol? v) (alias? v))) - + + (define (prefixed-import? prototype) + (and (list? prototype) + (eq? (car prototype) prefix:) + (>= (length prototype) 3))) + + (define (prefix-name prototype) + (if (and (>= (length prototype) 3) + (symbol? (cadr prototype))) + (cadr prototype) + (err))) (cond ((symbol? prototype) ;; module-name - (import-all-module prototype mode import-src)) + (import-all-module prototype #f mode import-src)) ((list? prototype) - (let ((inv (reverse prototype))) + (let* ((prefixed? (prefixed-import? prototype)) + (prefix (if prefixed? (prefix-name prototype) #f)) + (inv (reverse (if prefixed? (cddr prototype) prototype)))) (let loop ((lst inv) (files '())) (cond @@ -234,15 +259,15 @@ ((null? vars) ;; (module-name "file-name"+) (if (pair? files) (module-add-access! mod files ".")) - (import-all-module mod mode prototype)) + (import-all-module mod prefix mode prototype)) ((every variable? vars) ;; (var1 var2 ... varN module-name "file-name"*) (when (pair? files) (module-add-access! mod files ".")) (for-each (lambda (v) (if (alias? v) - (import-1-module mod (cadr v) (car v) mode prototype) - (import-1-module mod v #f mode prototype))) + (import-1-module mod prefix (cadr v) (car v) mode prototype) + (import-1-module mod prefix v #f mode prototype))) vars)) (else (err))))) @@ -459,7 +484,7 @@ ;* import-everything ... */ ;*---------------------------------------------------------------------*/ (define (import-everything import) - (with-access::import import (module provide src) + (with-access::import import (module prefix provide src) (let loop ((provided provide) (inline '()) (macro '()) @@ -467,7 +492,13 @@ (expd '())) (if (null? provided) (values inline macro syntax expd) - (let ((p (import-parser module (car provided) #f src))) + (let* ((proto (if prefix (parse-prototype (car provided)) #f)) + (alias-id (if (pair? proto) + (symbol-append prefix + (fast-id-of-id (cadr proto) + (find-location (car provided)))) + #f)) + (p (import-parser module (car provided) alias-id src))) (match-case p ((? global?) (let ((val (global-value p))) @@ -495,7 +526,7 @@ ;* import-wanted ... */ ;*---------------------------------------------------------------------*/ (define (import-wanted import vars) - (with-access::import import (module provide src) + (with-access::import import (module prefix provide src) (let loop ((provided provide) (inline '()) (macro '()) diff --git a/recette/module.scm b/recette/module.scm index 5694c0fe1..844eeaa0a 100644 --- a/recette/module.scm +++ b/recette/module.scm @@ -10,7 +10,7 @@ (module module (include "test.sch") - (import (x import1 "import1.scm") + (import (:prefix imp1- x import1 "import1.scm") (y z import1 "import1.scm") (import2 "import2.scm") ((renamed-test1 import-test1) import1 "import1.scm") @@ -51,9 +51,9 @@ ;*---------------------------------------------------------------------*/ (define (test-modulel) (test-module "module" "module.scm") - (test "@" (@ x import1) 1) + (test "prefix" imp1-x 1) (test "@" (@ x import2) 2) - (test "@" (or (eq? x (@ x import1)) (eq? x (@ x import2))) #t) + (test "@" (or (eq? x (@ imp1-x import1)) (eq? x (@ x import2))) #t) (test "inline/type" (z) 1) (test "init/read" (init/read-test) '(init . (1 2 3 4))) (test "rename.1" (renamed-test1) 'import-test1) From 587e15230488dc2180179ee0fd55bc058a9cee2a Mon Sep 17 00:00:00 2001 From: Joseph Donaldson Date: Sun, 1 Dec 2019 13:59:23 -0800 Subject: [PATCH 2/3] Add support for import prefixes to bigloo interpreter --- runtime/Eval/evmodule.scm | 54 +++++++++++++++++++++++++++++++-------- 1 file changed, 43 insertions(+), 11 deletions(-) diff --git a/runtime/Eval/evmodule.scm b/runtime/Eval/evmodule.scm index 2ccf7a6a5..60b9b172f 100644 --- a/runtime/Eval/evmodule.scm +++ b/runtime/Eval/evmodule.scm @@ -553,7 +553,12 @@ ;*---------------------------------------------------------------------*/ ;* evmodule-import! ... */ ;*---------------------------------------------------------------------*/ -(define (evmodule-import! mod ident path set abase loc) +(define (evmodule-import! mod ident prefix path set abase loc) + + (define (prefix-binding s) + (if prefix + (symbol-append prefix s) + s)) (define (import-error msg obj) (evcompile-error loc "eval" msg obj)) @@ -564,11 +569,21 @@ (hashtable-for-each (%evmodule-macros mod2) (lambda (k v) (hashtable-put! t k v)))) + + ;; prefix exports when necessary + (when prefix + (for-each (lambda (b) + (when (or (null? set) (memq (car b) set)) + (bind-alias! mod ident (prefix-binding (car b)) (car b) + loc))) + (%evmodule-exports mod2))) + ;; bind variables (for-each (lambda (b) (when (or (null? set) (memq (car b) set)) - (evmodule-import-binding! mod (car b) (cdr b) (car b) loc))) - (%evmodule-exports mod2))) + (evmodule-import-binding! mod + (car b) (cdr b) (car b) loc))) + (%evmodule-exports mod2))) (define (load-module) (unwind-protect @@ -606,6 +621,20 @@ (define (import-error arg) (evcompile-error loc "eval" "Illegal `import' clause" arg)) + + (define (prefixed? clause) + (and (pair? clause) (eq? (car clause) :prefix) + (pair? (cdr clause)) (symbol? (cadr clause)))) + + (define (find-module-prefix clause) + (if (prefixed? clause) + (cadr clause) + #f)) + + (define (skip-prefix-if-present clause) + (if (prefixed? clause) + (cddr clause) + clause)) (define (find-module-files clause) (cond @@ -639,17 +668,20 @@ (cond ((symbol? s) (let ((path ((bigloo-module-resolver) s '() abase))) - (evmodule-import! mod s path '() abase loc))) + (evmodule-import! mod s #f path '() abase loc))) ((or (not (pair? s)) (not (list? s)) - (not (or (symbol? (car s)) (alias-pair? (car s))))) + (not (or (symbol? (car s)) (alias-pair? (car s)) + (and (keyword? (car s)) (eq? (car s) :prefix))))) (import-error s)) (else - (let ((files (find-module-files s)) - (imod (find symbol? s)) - (imports (find-module-imports s)) - (aliases (find-module-aliases s)) - (dir (or (location-dir loc) (pwd)))) + (let* ((prefix (find-module-prefix s)) + (s-w/out-prefix (skip-prefix-if-present s)) + (files (find-module-files s-w/out-prefix)) + (imod (find symbol? s-w/out-prefix)) + (imports (find-module-imports s-w/out-prefix)) + (aliases (find-module-aliases s-w/out-prefix)) + (dir (or (location-dir loc) (pwd)))) (let ((path ((bigloo-module-resolver) imod files dir))) (for-each (lambda (ap) (bind-alias! mod imod @@ -657,7 +689,7 @@ (cadr ap) (or (get-source-location ap) loc))) aliases) - (evmodule-import! mod imod path imports abase loc))))))) + (evmodule-import! mod imod prefix path imports abase loc))))))) (if (not (list? clause)) (import-error clause) From 1abbd634825e8350f70b8b76d0c25c4cab65549f Mon Sep 17 00:00:00 2001 From: Joseph Donaldson Date: Fri, 15 May 2020 14:36:51 -0700 Subject: [PATCH 3/3] Remove erroneous date method This method was causing a java compilation error and is not used anywhere, so I removed it. --- runtime/Jlib/date.java | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/runtime/Jlib/date.java b/runtime/Jlib/date.java index 628a23b4d..34d2362d2 100644 --- a/runtime/Jlib/date.java +++ b/runtime/Jlib/date.java @@ -42,16 +42,6 @@ public date( final long seconds ) { timezone = -tmz.getRawOffset() / 1000; } - public date( final long seconds, bool ) { - calendar = new GregorianCalendar(); - final Date d = new Date(); - d.setTime( seconds * 1000 ); - - calendar.setTime( d ); - final TimeZone tmz = calendar.getTimeZone(); - timezone = -tmz.getRawOffset() / 1000; - } - public date( final long nseconds, boolean _b ) { calendar = new GregorianCalendar(); final Date d = new Date();