*root-name-registry* fully initialized

i.c

@@ -17,6 +17,7 @@ extern obj cx__2Acurrent_2Derror_2A;
 
 /* forwards */
 static struct intgtab_entry *lookup_integrable(int sym);
+static int intgtab_count(void);
 static int isintegrable(obj x);
 static struct intgtab_entry *integrabledata(obj x);
 static obj mkintegrable(struct intgtab_entry *);
@@ -3420,7 +3421,16 @@ define_instruction(igp) {
 }
 
 define_instruction(iglk) {
-  struct intgtab_entry *pe; cky(ac);
+  struct intgtab_entry *pe; 
+  /* lookup by index: returns #f for out-of-scope, void for missing */
+  if (is_fixnum(ac)) {
+    int i = get_fixnum(ac), cnt = intgtab_count();
+    if (i < 0 || i >= cnt) ac = bool_obj(0);
+    else if (!isintegrable(ac)) ac = void_obj();
+    gonexti();
+  }
+  /* lookup by by symbol */
+  cky(ac);
   pe = lookup_integrable(get_symbol(ac));
   ac = pe ? mkintegrable(pe) : bool_obj(0);
   gonexti(); 
@@ -3957,6 +3967,11 @@ static obj mkintegrable(struct intgtab_entry *pe)
   return obj_from_fixnum(pe-intgtab);
 }
 
+static int intgtab_count(void)
+{
+  return sizeof(intgtab)/sizeof(intgtab[0]);
+}
+
 static struct intgtab_entry *lookup_integrable(int sym)
 {
   struct intgtab_entry e, *pe;

src/t.scm

@@ -1814,12 +1814,14 @@
 (define (root-environment id at)
   (env-lookup id *root-environment* at))
 
+
 ;---------------------------------------------------------------------------------------------
-; Symbol-name identifiers registry and built-in syntax values
+; Expand-time root name registry initialized with built-in and predefined values
 ;---------------------------------------------------------------------------------------------
 
-; name registries are htables (vectors of prime+1 length) of alists ((sym . <location>) ...)
+; name registries are htables (vectors with one extra slot) of alists ((sym . <location>) ...)
-(define *root-name-registry* (make-vector 102 '())) 
+; last slot is used for list names (library names), the rest for regular symbolic names
+(define *root-name-registry* (make-vector 102 '())) ; vector of prime+1 length
 
 (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))] 
@@ -1831,7 +1833,37 @@
              loc)]
           [else #f])))
 
-; register standard libraries as well as all-encompassing (repl) library
+; register integrable procedures
+(let loop ([i 0])
+  (let ([li (lookup-integrable i)])
+    (when li ; in range: void or integrable
+      (when (integrable? i)
+        (let ([name (integrable-global i)])
+          ;(display "integrable[") (write i) (display "] = ") (write name) (newline)
+          (when (symbol? name) (name-lookup *root-name-registry* name (lambda (name) i)))))
+      (loop (+ i 1))))) 
+
+; register initial transformers
+(let loop ([l (initial-transformers)])
+  (unless (null? l)
+    (let* ([p (car l)] [l (cdr l)] [k (car p)] [v (cdr p)])
+      (cond [(or (symbol? v) (integrable? v))
+             (name-lookup *root-name-registry* k (lambda (name) v)) 
+             (loop l)]
+            [(and (pair? v) (eq? (car v) 'syntax-rules))
+              (body
+                (define (sr-env id at)
+                  ; FIXME: for now, we have to keep using old root env 
+                  (env-lookup id *root-environment* at))
+                (define sr-v
+                  (if (id? (cadr v))
+                      (syntax-rules* sr-env (cadr v) (caddr v) (cdddr v))
+                      (syntax-rules* sr-env #f (cadr v) (cddr v))))
+                (name-lookup *root-name-registry* k (lambda (name) sr-v))
+                (loop l))]))))
+
+; register standard libraries as well as (repl) library for interactive environment
+; ... while doing that, bind missing standard names as refs to constant globals
 (for-each
   (lambda (r)
     (define (key->listname k)
@@ -1854,11 +1886,16 @@
       (let* ([eal (library-exports library)] [p (assq k eal)])
         (cond [p (set-cdr! p loc)] 
               [else (library-set-exports! library (cons (cons k loc) eal))])))
+    (define (get-loc name)
+      ; FIXME: switch root-environment to  *root-name-registry*, and use this:
+      ; (name-lookup *root-name-registry* name (lambda (name) (list 'const name)))
+      ; for now, for libraries to work, we have to share old root env locations:
+      (root-environment name 'ref))
     (let loop ([name (car r)] [keys (cdr r)])
       (cond [(null? keys) ; all go to (repl)
-             (put-loc! (get-library! '(repl)) name (root-environment name 'ref))]
+             (put-loc! (get-library! '(repl)) name (get-loc name))]
             [else
-             (put-loc! (get-library! (key->listname (car keys))) name (root-environment name 'ref))
+             (put-loc! (get-library! (key->listname (car keys))) name (get-loc name))
              (loop name (cdr keys))])))
   '((* v b) (+ v b) (- v b) (... v u b) (/ v b) (< v b) (<= v b) (= v b) (=> v u b) (> v b) (>= v b)
     (_ b) (abs v b) (and v u b) (append v b) (apply v b) (assoc v b) (assq v b) (assv v b) (begin v u b)

t.c

@@ -1015,6 +1015,20 @@ char *t_code[] = {
   "%3'1,.1V3-,.2p?{.0}{.0,.3H2},.0,.3V4,.4p?{.0,.5A5}{.0,.5A3},.0?{.0d]7}"
   ".6?{${.7,.9[01}b,.2,.1,.8cc,.4,.7V5.0]8}f]7",
 
+  "C", 0,
+  "${'0,,#0.0,&1{%1.0U5,.0?{.1U0?{.1U7,.0Y0?{${.4,&1{%1:0]1},.3,@(y20:*ro"
+  "ot-name-registry*),@(y11:name-lookup)[03}}_1}'1,.2+,:0^[21}]2}.!0.0^_1"
+  "[01}",
+
+  "C", 0,
+  "${U1,,#0.0,&1{%1.0u~?{.0a,.1d,.1a,.2d,.0Y0,.0?{.0}{.1U0}_1?{${.2,&1{%1"
+  ":0]1},.4,@(y20:*root-name-registry*),@(y11:name-lookup)[03}.2,:0^[51}."
+  "0p?{'(y12:syntax-rules),.1aq}{f}?{,,#0#1&0{%2.1,@(y18:*root-environmen"
+  "t*),.2,@(y10:env-lookup)[23}.!0${.4da,@(y3:id?)[01}?{${.4ddd,.5dda,.6d"
+  "a,.5^,@(y13:syntax-rules*)[04}}{${.4dd,.5da,f,.5^,@(y13:syntax-rules*)"
+  "[04}}.!1${.3,&1{%1:0^]1},.6,@(y20:*root-name-registry*),@(y11:name-loo"
+  "kup)[03}.4,:0^[71}f]5}]1}.!0.0^_1[01}",
+
   "C", 0,
   "${'(l343:l3:y1:*;y1:v;y1:b;;l3:y1:+;y1:v;y1:b;;l3:y1:-;y1:v;y1:b;;l4:y"
   "3:...;y1:v;y1:u;y1:b;;l3:y1:/;y1:v;y1:b;;l3:y1:<;y1:v;y1:b;;l3:y2:<=;y"
@@ -1146,24 +1160,24 @@ char *t_code[] = {
   "5:write;y1:w;y1:v;;l2:y13:current-jiffy;y1:t;;l2:y14:current-second;y1"
   ":t;;l2:y18:jiffies-per-second;y1:t;;l2:y12:write-shared;y1:w;;l2:y12:w"
   "rite-simple;y1:w;;l1:y4:box?;;l1:y3:box;;l1:y5:unbox;;l1:y8:set-box!;;"
-  "),&0{%1,,,#0#1#2&0{%1.0,'(y1:w),.1v?{'(l2:y6:scheme;y5:write;)]2}'(y1:"
+  "),&0{%1,,,,#0#1#2#3&0{%1.0,'(y1:w),.1v?{'(l2:y6:scheme;y5:write;)]2}'("
-  "t),.1v?{'(l2:y6:scheme;y4:time;)]2}'(y1:p),.1v?{'(l2:y6:scheme;y4:repl"
+  "y1:t),.1v?{'(l2:y6:scheme;y4:time;)]2}'(y1:p),.1v?{'(l2:y6:scheme;y4:r"
-  ";)]2}'(y1:r),.1v?{'(l2:y6:scheme;y4:read;)]2}'(y1:v),.1v?{'(l2:y6:sche"
+  "epl;)]2}'(y1:r),.1v?{'(l2:y6:scheme;y4:read;)]2}'(y1:v),.1v?{'(l2:y6:s"
-  "me;y4:r5rs;)]2}'(y1:u),.1v?{'(l2:y6:scheme;y9:r5rs-null;)]2}'(y1:d),.1"
+  "cheme;y4:r5rs;)]2}'(y1:u),.1v?{'(l2:y6:scheme;y9:r5rs-null;)]2}'(y1:d)"
-  "v?{'(l2:y6:scheme;y4:load;)]2}'(y1:z),.1v?{'(l2:y6:scheme;y4:lazy;)]2}"
+  ",.1v?{'(l2:y6:scheme;y4:load;)]2}'(y1:z),.1v?{'(l2:y6:scheme;y4:lazy;)"
-  "'(y1:s),.1v?{'(l2:y6:scheme;y15:process-context;)]2}'(y1:i),.1v?{'(l2:"
+  "]2}'(y1:s),.1v?{'(l2:y6:scheme;y15:process-context;)]2}'(y1:i),.1v?{'("
-  "y6:scheme;y7:inexact;)]2}'(y1:f),.1v?{'(l2:y6:scheme;y4:file;)]2}'(y1:"
+  "l2:y6:scheme;y7:inexact;)]2}'(y1:f),.1v?{'(l2:y6:scheme;y4:file;)]2}'("
-  "e),.1v?{'(l2:y6:scheme;y4:eval;)]2}'(y1:o),.1v?{'(l2:y6:scheme;y7:comp"
+  "y1:e),.1v?{'(l2:y6:scheme;y4:eval;)]2}'(y1:o),.1v?{'(l2:y6:scheme;y7:c"
-  "lex;)]2}'(y1:h),.1v?{'(l2:y6:scheme;y4:char;)]2}'(y1:l),.1v?{'(l2:y6:s"
+  "omplex;)]2}'(y1:h),.1v?{'(l2:y6:scheme;y4:char;)]2}'(y1:l),.1v?{'(l2:y"
-  "cheme;y11:case-lambda;)]2}'(y1:x),.1v?{'(l2:y6:scheme;y3:cxr;)]2}'(y1:"
+  "6:scheme;y11:case-lambda;)]2}'(y1:x),.1v?{'(l2:y6:scheme;y3:cxr;)]2}'("
-  "b),.1v?{'(l2:y6:scheme;y4:base;)]2}]2}.!0&0{%1${.2,&1{%1n,'(l1:y5:begi"
+  "y1:b),.1v?{'(l2:y6:scheme;y4:base;)]2}]2}.!0&0{%1${.2,&1{%1n,'(l1:y5:b"
-  "n;),V12,${t,.3b,${:0,@(y16:listname->symbol)[01},@(y27:define-in-root-"
+  "egin;),V12,${t,.3b,${:0,@(y16:listname->symbol)[01},@(y27:define-in-ro"
-  "environment!)[03}.0]2},.3,@(y20:*root-name-registry*),@(y11:name-looku"
+  "ot-environment!)[03}.0]2},.3,@(y20:*root-name-registry*),@(y11:name-lo"
-  "p)[03}z]1}.!1&0{%3'1,.1V4,.0,.3A3,.0?{.4,.1sd]5}.1,.5,.5cc,'1,.4V5]5}."
+  "okup)[03}z]1}.!1&0{%3'1,.1V4,.0,.3A3,.0?{.4,.1sd]5}.1,.5,.5cc,'1,.4V5]"
-  "!2.3d,.4a,,#0.0,.6,.5,.7,&4{%2.1u?{${'(y3:ref),.3,@(y16:root-environme"
+  "5}.!2&0{%1'(y3:ref),.1,@(y16:root-environment)[12}.!3.4d,.5a,,#0.0,.6,"
-  "nt)[02},.1,${'(l1:y4:repl;),:0^[01},:2^[23}${${'(y3:ref),.5,@(y16:root"
+  ".5,.7,.(i10),&5{%2.1u?{${.2,:0^[01},.1,${'(l1:y4:repl;),:1^[01},:3^[23"
-  "-environment)[02},.3,${${.9a,:1^[01},:0^[01},:2^[03}.1d,.1,:3^[22}.!0."
+  "}${${.4,:0^[01},.3,${${.9a,:2^[01},:1^[01},:3^[03}.1d,.1,:4^[22}.!0.0^"
-  "0^_1[42},@(y10:%25for-each1)[02}",
+  "_1[52},@(y10:%25for-each1)[02}",
 
   "C", 0,
   "f@!(y9:*verbose*)",