Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2024-12-26 21:58:51 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

faster library import registries

Browse source
This commit is contained in:
ESL 2024-07-16 02:47:57 -04:00
parent 4ab2982e26
commit 373e9dec38
2 changed files with 40 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
src/t.scm
View file

@ -1807,10 +1807,21 @@
(define prime (cond [(member size primes <=) => car] [else 991])) (define prime (cond [(member size primes <=) => car] [else 991]))
(make-vector (+ prime 1) '())) ; last bucket used for listnames (make-vector (+ prime 1) '())) ; last bucket used for listnames
(define (eal->name-registry eal) (vector eal '())) (define (eal->name-registry eal n)
(if (= n 1)
(vector eal '())
(let ([nr (make-name-registry n)])
(for-each (lambda (p) (name-install! nr (car p) (cdr p))) eal)
nr)))
(define (eal-name-registry-import! ir ial) (define (eal-name-registry-import! ir ial)
(vector-set! ir 0 (adjoin-eals (vector-ref ir 0) ial))) ; may end in x-error on conflict (if (= (vector-length ir) 2)
(vector-set! ir 0 (adjoin-eals (vector-ref ir 0) ial)) ; may end in x-error on conflict
(let loop ([ial ial])
(unless (null? ial)
(case (name-install! ir (caar ial) (cdar ial))
[(modified) (x-error "import conflict on importing binding" (caar ial) (cdar ial))])
(loop (cdr ial))))))
(define (name-lookup nr name mkdefval) ;=> loc | #f (define (name-lookup nr name mkdefval) ;=> loc | #f
(let* ([n-1 (- (vector-length nr) 1)] [i (if (pair? name) n-1 (immediate-hash name n-1))] (let* ([n-1 (- (vector-length nr) 1)] [i (if (pair? name) n-1 (immediate-hash name n-1))]
@ -2014,7 +2025,7 @@
; makes controlled environments for libraries and programs using import al, global name generator, ; makes controlled environments for libraries and programs using import al, global name generator,
; and env allowing fall-through for list names (so libraries can still be fetched by list name) ; and env allowing fall-through for list names (so libraries can still be fetched by list name)
(define (make-controlled-environment ial global use-env) (define (make-controlled-environment ial global use-env)
(define ir (eal->name-registry ial)) ; handmade import registry from ial (define ir (eal->name-registry ial 100)) ; handmade import registry from ial
(define lr (make-name-registry 100)) ; local registry for new names (define lr (make-name-registry 100)) ; local registry for new names
(lambda (name at) (lambda (name at)
(cond [(new-id? name) ; nonsymbolic ids can't be (re)bound here (cond [(new-id? name) ; nonsymbolic ids can't be (re)bound here
@ -2161,7 +2172,7 @@
(define iform (cons 'import isets)) ; incredibly stupid, but whatcha gonna do (define iform (cons 'import isets)) ; incredibly stupid, but whatcha gonna do
(define ienv root-environment) ; it's a procedure, so there you go... (define ienv root-environment) ; it's a procedure, so there you go...
(define ic&eal (preprocess-import-sets iform ienv)) ;=> (init-core . exports-eal) (define ic&eal (preprocess-import-sets iform ienv)) ;=> (init-core . exports-eal)
(define ir (eal->name-registry (cdr ic&eal))) ; handmade import registry from ial (define ir (eal->name-registry (cdr ic&eal) 1)) ; handmade import registry from ial
; initialization code got to be run, so we may as well do it right now ; initialization code got to be run, so we may as well do it right now
(compile-and-run-core-expr (car ic&eal)) ; defined below, value(s) ignored (compile-and-run-core-expr (car ic&eal)) ; defined below, value(s) ignored
; now just wrap the regisry in read-only env and be done with it ; now just wrap the regisry in read-only env and be done with it

44
t.c
View file

@ -1042,10 +1042,14 @@ char *t_code[] = {
"V2]3", "V2]3",
"P", "eal->name-registry", "P", "eal->name-registry",
"%1n,.1,V12]1", "%2'1,.2=?{n,.1,V12]2}${.3,@(y18:make-name-registry)[01},${.3,.3,&1{%1."
"0d,.1a,:0,@(y13:name-install!)[13},@(y10:%25for-each1)[02}.0]3",
"P", "eal-name-registry-import!", "P", "eal-name-registry-import!",
"%2${.3,'0,.4V4,@(y11:adjoin-eals)[02},'0,.2V5]2", "%2'2,.1V3=?{${.3,'0,.4V4,@(y11:adjoin-eals)[02},'0,.2V5]2}.1,,#0.2,.1,"
"&2{%1.0u~?{${.2ad,.3aa,:1,@(y13:name-install!)[03},'(y8:modified),.1v?"
"{${.3ad,.4aa,'(s36:import conflict on importing binding),@(y7:x-error)"
"[03}}_1.0d,:0^[11}]1}.!0.0^_1[21",
"P", "name-lookup", "P", "name-lookup",
"%3'1,.1V3-,.2p?{.0}{.0,.3H2},.0,.3V4,.4p?{.0,.5A5}{.0,.5A3},.0?{.0d]7}" "%3'1,.1V3-,.2p?{.0}{.0,.3H2},.0,.3V4,.4p?{.0,.5A5}{.0,.5A3},.0?{.0d]7}"
@ -1283,21 +1287,21 @@ char *t_code[] = {
"?{.0]3}:0]3}'(y3:ref),.2q?{f,.1,:0,@(y11:name-lookup)[23}f]2}]1", "?{.0]3}:0]3}'(y3:ref),.2q?{f,.1,:0,@(y11:name-lookup)[23}f]2}]1",
"P", "make-controlled-environment", "P", "make-controlled-environment",
"%3,,#0#1${.4,@(y18:eal->name-registry)[01}.!0${'(i100),@(y18:make-name" "%3,,#0#1${'(i100),.5,@(y18:eal->name-registry)[02}.!0${'(i100),@(y18:m"
"-registry)[01}.!1.1,.1,.5,.7,&4{%2.0K0?{.1,'(l3:y3:ref;y4:set!;y4:peek" "ake-name-registry)[01}.!1.1,.1,.5,.7,&4{%2.0K0?{.1,'(l3:y3:ref;y4:set!"
";),.1A1?{.2,.2,@(y13:new-id-lookup)[32}f]3}'(y3:ref),.2q?{:2,.1,:1,:0," ";y4:peek;),.1A1?{.2,.2,@(y13:new-id-lookup)[32}f]3}'(y3:ref),.2q?{:2,."
"&4{%1${f,:2,:3^,@(y11:name-lookup)[03},.0?{.0]2}:2Y0?{${:2,:1[01},'(y3" "1,:1,:0,&4{%1${f,:2,:3^,@(y11:name-lookup)[03},.0?{.0]2}:2Y0?{${:2,:1["
":ref),l2]2}'(y3:ref),:2,:0[22},.1,:3^,@(y11:name-lookup)[23}'(y4:peek)" "01},'(y3:ref),l2]2}'(y3:ref),:2,:0[22},.1,:3^,@(y11:name-lookup)[23}'("
",.2q?{${f,.3,:3^,@(y11:name-lookup)[03},.0?{.0]3}${f,.4,:2^,@(y11:name" "y4:peek),.2q?{${f,.3,:3^,@(y11:name-lookup)[03},.0?{.0]3}${f,.4,:2^,@("
"-lookup)[03},.0?{.0]4}.2Y0?{:3^]4}'(y4:peek),.3,:0[42}'(l2:y4:set!;y6:" "y11:name-lookup)[03},.0?{.0]4}.2Y0?{:3^]4}'(y4:peek),.3,:0[42}'(l2:y4:"
"define;),.2A0?{.0Y0?{.0,:1,:2,&3{%1${f,:2,:0^,@(y11:name-lookup)[03}~?" "set!;y6:define;),.2A0?{.0Y0?{.0,:1,:2,&3{%1${f,:2,:0^,@(y11:name-looku"
"{${:2,:1[01},'(y3:ref),l2]1}f]1},.1,:3^,@(y11:name-lookup)[23}f]2}'(y1" "p)[03}~?{${:2,:1[01},'(y3:ref),l2]1}f]1},.1,:3^,@(y11:name-lookup)[23}"
"3:define-syntax),.2q?{.0,:2,&2{%1${f,:1,:0^,@(y11:name-lookup)[03}~?{Y" "f]2}'(y13:define-syntax),.2q?{.0,:2,&2{%1${f,:1,:0^,@(y11:name-lookup)"
"9]1}f]1},.1,:3^,@(y11:name-lookup)[23}'(y6:import),.2q?{${.2,'(l2:py8:" "[03}~?{Y9]1}f]1},.1,:3^,@(y11:name-lookup)[23}'(y6:import),.2q?{${.2,'"
"<symbol>;zy1:*;;;y3:...;),@(y11:sexp-match?)[02}}{f}?{.0,,#0:3,&1{%1${" "(l2:py8:<symbol>;zy1:*;;;y3:...;),@(y11:sexp-match?)[02}}{f}?{.0,,#0:3"
"f,.3a,:0^,@(y11:name-lookup)[03},.0?{.0,.0,.3d,.4a,'(s32:imported name" ",&1{%1${f,.3a,:0^,@(y11:name-lookup)[03},.0?{.0,.0,.3d,.4a,'(s32:impor"
" shadows local name),@(y7:x-error)[34}f]2}.!0${.3,.3^,@(y10:%25for-eac" "ted name shadows local name),@(y7:x-error)[34}f]2}.!0${.3,.3^,@(y10:%2"
"h1)[02}${.3,:2^,@(y25:eal-name-registry-import!)[02}t]4}f]2}]5", "5for-each1)[02}${.3,:2^,@(y25:eal-name-registry-import!)[02}t]4}f]2}]5",
"P", "make-sld-environment", "P", "make-sld-environment",
"%1,#0.0,.2,&2{%2'(l2:y3:ref;y4:peek;),.2A0~?{f]2}.0K0?{.1,.1,@(y13:new" "%1,#0.0,.2,&2{%2'(l2:y3:ref;y4:peek;),.2A0~?{f]2}.0K0?{.1,.1,@(y13:new"
@ -1366,9 +1370,9 @@ char *t_code[] = {
"P", "environment", "P", "environment",
"%!0,,,,#0#1#2#3.4,'(y6:import)c.!0@(y16:root-environment).!1${.3^,.3^," "%!0,,,,#0#1#2#3.4,'(y6:import)c.!0@(y16:root-environment).!1${.3^,.3^,"
"@(y22:preprocess-import-sets)[02}.!2${.4^d,@(y18:eal->name-registry)[0" "@(y22:preprocess-import-sets)[02}.!2${'1,.5^d,@(y18:eal->name-registry"
"1}.!3${.4^a,@(y25:compile-and-run-core-expr)[01}.3^,@(y25:make-readonl" ")[02}.!3${.4^a,@(y25:compile-and-run-core-expr)[01}.3^,@(y25:make-read"
"y-environment)[51", "only-environment)[51",
"C", 0, "C", 0,
"f@!(y9:*verbose*)", "f@!(y9:*verbose*)",