minor fixes (record rtd is a symbol now)

n.c

@@ -195,7 +195,8 @@ int istyped(obj o) {
   if (!isobjptr(o)) return 0;
   else { obj h = objptr_from_obj(o)[-1];
     return notaptr(h) && size_from_obj(h) >= 1 
-      && isobjptr(hblkref(o, 0)); }
+      /* FIXME: manual issymbol() check */
+      && isimm(hblkref(o, 0), 4/*SYMBOL_ITAG*/); }
 }
 #ifdef NDEBUG
   #define cktyped(o, t) (o)

s.c

@@ -1,4 +1,4 @@
-/* s.c -- generated via skint -c s.scm */
+/* s.c -- code is generated via skint -c s.scm */
 #include "s.h"
 #include "n.h"
 
@@ -210,7 +210,9 @@ char *s_code[] = {
   ":body;;;",
 
   "P", "new-record-type",
-  "%2.1,.1c]2",
+  "%2'(l1:s6:rtd://;),.2,.2c,,#0.0,&1{%2.0u?{${.3A8,@(y14:%25string-appen"
+  "d),@(y13:apply-to-list)[02}X5]2}.0du?{.1,.1aX4c,.1d,:0^[22}.1,.1aX4c,'"
+  "(s1::)c,.1d,:0^[22}.!0.0^_1[22",
 
   "S", "%id-eq??",
   "l3:y12:syntax-rules;n;l2:l5:y1:_;y2:id;y1:b;y2:kt;y2:kf;;l3:l3:y13:syn"
@@ -643,7 +645,7 @@ char *s_code[] = {
 
   "P", "assertion-violation",
   "%!0Pe,.0W6${.2,.4,'(s19:Assertion violation),@(y19:print-error-message"
-  ")[03}'1Z9]2",
+  ")[03}@(y5:reset)[20",
 
   "C", 0,
   "${'(l3:y4:kind;y7:message;y9:irritants;),'(y14:<error-object>),@(y15:n"

src/s.scm

@@ -269,9 +269,15 @@
 ; (record-ref r i)
 ; (record-set! r i v)
 
-(define (new-record-type name fields) ; stub
-  (cons name fields))
-
+(define (new-record-type name fields)
+  ; should be something like (cons name fields), but that would complicate procedure? 
+  ; check that now relies on block tag being a non-immediate object, so we'll better put 
+  ; some pseudo-unique immediate object here -- and we don't have to be fast doing that
+  (let loop ([fl (cons name fields)] [sl '("rtd://")])
+     (cond [(null? fl) (string->symbol (apply string-append (reverse sl)))]
+           [(null? (cdr fl)) (loop (cdr fl) (cons (symbol->string (car fl)) sl))]
+           [else (loop (cdr fl) (cons ":" (cons (symbol->string (car fl)) sl)))]))) 
+  
 ; see http://okmij.org/ftp/Scheme/macro-symbol-p.txt
 (define-syntax %id-eq?? 
   (syntax-rules ()
@@ -1225,7 +1231,7 @@
   (let ([ep (current-error-port)])
     (newline ep)
     (print-error-message "Assertion violation" args ep)
-    (%exit 1)))
+    (reset)))
 
 (define-record-type <error-object>
   (error-object kind message irritants)

src/t.scm

@@ -891,8 +891,8 @@
 
 (define (make-cond-expand-transformer)
   (lambda (sexp env)
-    (define (lit=? id sym) ; FIXME: match literal using free-id=? -like match
-      (and (id? id) (eq? (xenv-ref env id) (xenv-ref root-environment sym))))
+    (define (lit=? id sym) ; match literal as free identifier
+      (and (id? id) (free-id=? id env sym root-environment sym)))
     (cons begin-id (preprocess-cond-expand lit=? sexp env))))
 
 ; library transformers
@@ -1984,7 +1984,7 @@
     (flexpt) (flsqrt) (flfloor) (flceiling) (fltruncate) (flround) (flexp) (fllog) (flsin) (flcos) 
     (fltan) (flasin) (flacos) (flatan) (fl<?) (fl<=?) (fl>?) (fl>=?) (fl=?) (fl!=?) (flmin) 
     (flmax) (flonum->fixnum) (flonum->string) (string->flonum) 
-    (list-cat) (meme) (asse) (reverse!) (circular?) 
+    (list-cat) (list-head) (meme) (asse) (reverse!) (circular?) 
     (char-cmp) (char-ci-cmp) (string-cat) (string-position) (string-cmp) (string-ci-cmp) 
     (vector-cat) (bytevector->list) (list->bytevector) (subbytevector) 
     (standard-input-port) (standard-output-port) (standard-error-port) (tty-port?)
@@ -2414,5 +2414,7 @@
   (when *repl-first-time*
     (set! *repl-first-time* #f)
     (repl-main))
-  (repl-from-port ip repl-environment prompt op)
+  ; capture cc to handle unhandled exceptions
+  (letcc k (set-reset-handler! k)
+    (repl-from-port ip repl-environment prompt op))
   #t) ; exited normally via end-of-input

t.c

@@ -523,9 +523,9 @@ char *t_code[] = {
   "1,&2{%0:1d,:0^[01},.1,&1{%0:0ad]0},.2aa,:0^[13}.!0.0^_1[41",
 
   "P", "make-cond-expand-transformer",
-  "%0&0{%2,#0.2,&1{%2${.2,@(y3:id?)[01}?{${.3,@(y16:root-environment),@(y"
-  "8:xenv-ref)[02},${.3,:0,@(y8:xenv-ref)[02}q]2}f]2}.!0${.4,.4,.4^,@(y22"
-  ":preprocess-cond-expand)[03},@(y8:begin-id)c]3}]0",
+  "%0&0{%2,#0.2,&1{%2${.2,@(y3:id?)[01}?{.1,@(y16:root-environment),.3,:0"
+  ",.4,@(y9:free-id=?)[25}f]2}.!0${.4,.4,.4^,@(y22:preprocess-cond-expand"
+  ")[03},@(y8:begin-id)c]3}]0",
 
   "P", "adjoin-code",
   "%2'(l1:y5:begin;),.1e?{.1]2}'(l1:y5:begin;),.2e?{.0]2}${.2,'(l3:y5:beg"
@@ -1094,7 +1094,7 @@ char *t_code[] = {
   "0:*root-name-registry*),@(y11:name-lookup)[03}",
 
   "C", 0,
-  "${'(l469:l3:y1:*;y1:v;y1:b;;l3:y1:+;y1:v;y1:b;;l3:y1:-;y1:v;y1:b;;l4:y"
+  "${'(l470: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"
   "1:v;y1:b;;l3:y1:=;y1:v;y1:b;;l4:y2:=>;y1:v;y1:u;y1:b;;l3:y1:>;y1:v;y1:"
   "b;;l3:y2:>=;y1:v;y1:b;;l2:y1:_;y1:b;;l3:y3:abs;y1:v;y1:b;;l4:y3:and;y1"
@@ -1247,32 +1247,32 @@ char *t_code[] = {
   "flasin;;l1:y6:flacos;;l1:y6:flatan;;l1:y4:fl<?;;l1:y5:fl<=?;;l1:y4:fl>"
   "?;;l1:y5:fl>=?;;l1:y4:fl=?;;l1:y5:fl!=?;;l1:y5:flmin;;l1:y5:flmax;;l1:"
   "y14:flonum->fixnum;;l1:y14:flonum->string;;l1:y14:string->flonum;;l1:y"
-  "8:list-cat;;l1:y4:meme;;l1:y4:asse;;l1:y8:reverse!;;l1:y9:circular?;;l"
-  "1:y8:char-cmp;;l1:y11:char-ci-cmp;;l1:y10:string-cat;;l1:y15:string-po"
-  "sition;;l1:y10:string-cmp;;l1:y13:string-ci-cmp;;l1:y10:vector-cat;;l1"
-  ":y16:bytevector->list;;l1:y16:list->bytevector;;l1:y13:subbytevector;;"
-  "l1:y19:standard-input-port;;l1:y20:standard-output-port;;l1:y19:standa"
-  "rd-error-port;;l1:y9:tty-port?;;l1:y11:rename-file;;l1:y5:xform;;l1:y2"
-  "5:compile-and-run-core-expr;;l1:y21:compile-to-thunk-code;;l1:y16:dese"
-  "rialize-code;;l1:y7:closure;;l1:y16:repl-environment;;),&0{%1,,,,#0#1#"
-  "2#3&0{%1.0,'(y1:w),.1v?{'(l2:y6:scheme;y5:write;)]2}'(y1:t),.1v?{'(l2:"
-  "y6:scheme;y4:time;)]2}'(y1:p),.1v?{'(l2:y6:scheme;y4:repl;)]2}'(y1:r),"
-  ".1v?{'(l2:y6:scheme;y4:read;)]2}'(y1:v),.1v?{'(l2:y6:scheme;y4:r5rs;)]"
-  "2}'(y1:u),.1v?{'(l2:y6:scheme;y9:r5rs-null;)]2}'(y1:d),.1v?{'(l2:y6:sc"
-  "heme;y4:load;)]2}'(y1:z),.1v?{'(l2:y6:scheme;y4:lazy;)]2}'(y1:s),.1v?{"
-  "'(l2:y6:scheme;y15:process-context;)]2}'(y1:i),.1v?{'(l2:y6:scheme;y7:"
-  "inexact;)]2}'(y1:f),.1v?{'(l2:y6:scheme;y4:file;)]2}'(y1:e),.1v?{'(l2:"
-  "y6:scheme;y4:eval;)]2}'(y1:o),.1v?{'(l2:y6:scheme;y7:complex;)]2}'(y1:"
-  "h),.1v?{'(l2:y6:scheme;y4:char;)]2}'(y1:l),.1v?{'(l2:y6:scheme;y11:cas"
-  "e-lambda;)]2}'(y1:a),.1v?{'(l2:y6:scheme;y3:cxr;)]2}'(y1:b),.1v?{'(l2:"
-  "y6:scheme;y4:base;)]2}'(y1:x),.1v?{'(l2:y6:scheme;y3:box;)]2}.1I0?{.1,"
-  "'(y4:srfi),l2]2}.1,l1]2}.!0&0{%1${&0{%1n,'(l1:y5:begin;),V12]1},.3,@(y"
-  "20:*root-name-registry*),@(y11:name-lookup)[03}z]1}.!1&0{%3'1,.1V4,.0,"
-  ".3A3,.0?{.4,.1sd]5}.1,.5,.5cc,'1,.4V5]5}.!2&0{%1&0{%1.0,'(y5:const),l2"
-  "]1},.1,@(y20:*root-name-registry*),@(y11:name-lookup)[13}.!3.4d,.5a,,#"
-  "0.0,.6,.5,.7,.(i10),&5{%2.1u?{${.2,:0^[01},.1,${'(l1:y5:skint;),:1^[01"
-  "},:3^[23}${${.4,:0^[01},.3,${${.9a,:2^[01},:1^[01},:3^[03}.1d,.1,:4^[2"
-  "2}.!0.0^_1[52},@(y10:%25for-each1)[02}",
+  "8:list-cat;;l1:y9:list-head;;l1:y4:meme;;l1:y4:asse;;l1:y8:reverse!;;l"
+  "1:y9:circular?;;l1:y8:char-cmp;;l1:y11:char-ci-cmp;;l1:y10:string-cat;"
+  ";l1:y15:string-position;;l1:y10:string-cmp;;l1:y13:string-ci-cmp;;l1:y"
+  "10:vector-cat;;l1:y16:bytevector->list;;l1:y16:list->bytevector;;l1:y1"
+  "3:subbytevector;;l1:y19:standard-input-port;;l1:y20:standard-output-po"
+  "rt;;l1:y19:standard-error-port;;l1:y9:tty-port?;;l1:y11:rename-file;;l"
+  "1:y5:xform;;l1:y25:compile-and-run-core-expr;;l1:y21:compile-to-thunk-"
+  "code;;l1:y16:deserialize-code;;l1:y7:closure;;l1:y16:repl-environment;"
+  ";),&0{%1,,,,#0#1#2#3&0{%1.0,'(y1:w),.1v?{'(l2:y6:scheme;y5:write;)]2}'"
+  "(y1:t),.1v?{'(l2:y6:scheme;y4:time;)]2}'(y1:p),.1v?{'(l2:y6:scheme;y4:"
+  "repl;)]2}'(y1:r),.1v?{'(l2:y6:scheme;y4:read;)]2}'(y1:v),.1v?{'(l2:y6:"
+  "scheme;y4:r5rs;)]2}'(y1:u),.1v?{'(l2:y6:scheme;y9:r5rs-null;)]2}'(y1:d"
+  "),.1v?{'(l2:y6:scheme;y4:load;)]2}'(y1:z),.1v?{'(l2:y6:scheme;y4:lazy;"
+  ")]2}'(y1:s),.1v?{'(l2:y6:scheme;y15:process-context;)]2}'(y1:i),.1v?{'"
+  "(l2:y6:scheme;y7:inexact;)]2}'(y1:f),.1v?{'(l2:y6:scheme;y4:file;)]2}'"
+  "(y1:e),.1v?{'(l2:y6:scheme;y4:eval;)]2}'(y1:o),.1v?{'(l2:y6:scheme;y7:"
+  "complex;)]2}'(y1:h),.1v?{'(l2:y6:scheme;y4:char;)]2}'(y1:l),.1v?{'(l2:"
+  "y6:scheme;y11:case-lambda;)]2}'(y1:a),.1v?{'(l2:y6:scheme;y3:cxr;)]2}'"
+  "(y1:b),.1v?{'(l2:y6:scheme;y4:base;)]2}'(y1:x),.1v?{'(l2:y6:scheme;y3:"
+  "box;)]2}.1I0?{.1,'(y4:srfi),l2]2}.1,l1]2}.!0&0{%1${&0{%1n,'(l1:y5:begi"
+  "n;),V12]1},.3,@(y20:*root-name-registry*),@(y11:name-lookup)[03}z]1}.!"
+  "1&0{%3'1,.1V4,.0,.3A3,.0?{.4,.1sd]5}.1,.5,.5cc,'1,.4V5]5}.!2&0{%1&0{%1"
+  ".0,'(y5:const),l2]1},.1,@(y20:*root-name-registry*),@(y11:name-lookup)"
+  "[13}.!3.4d,.5a,,#0.0,.6,.5,.7,.(i10),&5{%2.1u?{${.2,:0^[01},.1,${'(l1:"
+  "y5:skint;),:1^[01},:3^[23}${${.4,:0^[01},.3,${${.9a,:2^[01},:1^[01},:3"
+  "^[03}.1d,.1,:4^[22}.!0.0^_1[52},@(y10:%25for-each1)[02}",
 
   "C", 0,
   "${'(i200),@(y18:make-name-registry)[01}@!(y20:*user-name-registry*)",
@@ -1527,8 +1527,8 @@ char *t_code[] = {
   "P", "repl",
   "%0,,,#0#1#2Pi.!0Po.!1.0^P09?{'(s6:skint])}{f}.!2${n,@(y23:set-current-"
   "file-stack!)[01}@(y17:*repl-first-time*)?{f@!(y17:*repl-first-time*)${"
-  "@(y9:repl-main)[00}}${.3^,.5^,@(y16:repl-environment),.5^,@(y14:repl-f"
-  "rom-port)[04}t]3",
+  "@(y9:repl-main)[00}}${k0,${.2,@(y18:set-reset-handler!)[01}${.6^,.8^,@"
+  "(y16:repl-environment),.8^,@(y14:repl-from-port)[04}_3}t]3",
 
   0, 0, 0
 };