shithub: sl

Info  •  Files  •  Log  •  Branches

sym: call str when needed

--- a/boot/sl.boot

+++ b/boot/sl.boot

@@ -35,18 +35,18 @@

 68687e2e186e3@408788P:" #(#fn(nconc)

   λ #fn(map) #fn("n10B3500<:0:" #()) #fn(copy-list)

   #fn("n10B3500T:7060:" #(void)) letrec))  bcode:code #fn("n1200Ee3:" #(aref))  make-label #fn("n120e1:" #(gensym))  bcode:cenv #fn("n1200r3e3:" #(aref))  > #fn("z12021e12273151510e163:" #(#fn(nconc)

-nc newline #fn(for-each) #fn("n17050471A0P61:" #(newline print)) *funvars* "no help for "

+nc newline #fn(for-each) #fn("n17050471A0P61:" #(newline print)) *funvars* "no help for "

 e3e18D3X02@8D2>1e12>2Ee12L8E5152e12L8@5153e3@30qe12L7M2N8;8A8@8F8C8E0>78?525165:" #(#(NIL

   NIL :named 1 :conc-name 3 :type 0 NIL NIL NIL NIL NIL NIL :predicate 4 NIL NIL NIL NIL NIL NIL

   :constructor 2) vec #0# #fn("n17005121220A>28552485:" #(cddr #fn(for-each)

 							  #fn("n17002152340q:722324A<25F2605661:" #(member

-

-  (:read-only) error #fn(str) "invalid option in slot " " of struct " ": "))) slot-opts)

+

+  (:read-only) error #fn(str) "invalid option in slot " " of struct " ": "))) slot-opts)

 " #(#fn(keyword?)

-) #fn(sym) #fn(str) ":"))) tokw)

-  #fn(str?) #fn(length) #fn(map) #fn("n10B3500<:0:" #())

-  #fn(sym) #fn(str) "?" "make-" "-" #fn(nconc) begin def s and or not quote eq? aref = length when

-  sym-set-doc #fn(copy-list) map-int #fn("n1A<70F05251709205221229386525123872425Ie2e3269424e2e2272825e229242:95510Me37;2<85523O02=2>2?2@86e22A2@96e22Be6e2@B02C242:95510M25e4e4e4:" #(list-ref

+#fn(list*) #fn(sym) #\:))) tokw)

+  #fn(str?) #fn(length) #fn(map) #fn("n10B3500<:0:" #())

+  #fn(sym) #\? "make-" #fn(str) "-" #fn(nconc) begin def s and or not quote eq? aref = length when

+  sym-set-doc #fn(copy-list) map-int #fn("n1A<70F0525170920522193865222872324Ie2e3259423e2e2262724e228232995510Me37:2;85523O02<2=2>2?86e22@2?96e22Ae6e2@B02B232995510M24e4e4e4:" #(list-ref

 ble #fn("n1200Ke3:" #(aref))  with-output-to #fn("z12021e1220e2e1e12315163:" #(#fn(nconc)

   with-bindings *io-out* #fn(copy-list)))  catch #fn("n22012122e123242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch

   λ #:g347 if and cons? eq? car quote thrown-value cadr caddr raise))  let* #fn("z10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)

--- a/src/builtins.c

+++ b/src/builtins.c

@@ -144,10 +144,14 @@

 BUILTIN("sym", sym)

 {

-	argcount(nargs, 1);

-	if(sl_unlikely(!sl_isstr(args[0])))

-		type_error("str", args[0]);

-	return mk_sym(cvalue_data(args[0]), true);

+	if(nargs < 1)

+		argcount(nargs, 1);

+	sl_v name;

+	if(nargs == 1 && sl_isstr(args[0]))

+		name = args[0];

+	else

+		name = fn_builtin_str(args, nargs);

+	return mk_sym(cvalue_data(name), true);

 }

 sl_purefn

--- a/src/system.lsp

+++ b/src/system.lsp

@@ -897,7 +897,7 @@

                       (when (or (not (sym? name))

                                 (keyword? name))

                         (error "invalid slot name: " name))

-                      (list* (sym (str ":" name))

+                      (list* (sym #\: name)

                              (if (keyword? (car tail))

                                  (cons nil tail)

                                  tail))))

@@ -916,16 +916,16 @@

          ; and keywords for names

          [slots-kw (tokw slots)]

          ; struct's underlying type's predicate (either vec? or list?)

-         [type? (sym (str type "?"))]

+         [type? (sym type #\?)]

          ; struct's predicate name

          [is? (or predicate

-                  (sym (str name "?")))]

+                  (sym name #\?))]

          ; constructor name and arguments

          [constructor

            (and constructor ; NIL means none to make at all

                 (or (and (atom? constructor) ; a single argument

                          (cons (or (and (eq? constructor T) ; T means the defaults

-                                        (sym (str "make-" name)))

+                                        (sym "make-" name))

                                    constructor) ; else a custom name

                                slots-kw))

                     constructor))] ; anything else means custom name and args

@@ -949,7 +949,7 @@

       ; accessor per slot

       ,@(map-int (λ (i) [let* {[opts (slot-opts (list-ref slots-kw i))]

                                [fld (list-ref slots-car i)]

-                               [fun (sym (str access fld))]}

+                               [fun (sym access fld)]}

                           `(def (,fun s (v #.(void)))

                              (assert (,is? s))

                              (if (void? v)

--- a/test/ast/asttools.lsp

+++ b/test/ast/asttools.lsp

@@ -1,8 +1,5 @@

 ; utilities for AST processing

-(def (symconcat s1 s2)

-  (sym (str s1 s2)))

-

 (def (list-adjoin item lst)

   (if (member item lst)

       lst

--- a/test/ast/rpasses.lsp

+++ b/test/ast/rpasses.lsp

@@ -20,7 +20,7 @@

 (let ((ctr 0))

   (set! r-gensym (lambda ()

-		   (prog1 (sym (str "%r:" ctr))

+		   (prog1 (sym "%r:" ctr)

 			  (set! ctr (+ ctr 1))))))

 (def (dollarsign-transform e)

--- a/test/unittest.lsp

+++ b/test/unittest.lsp

@@ -646,8 +646,9 @@

 (assert-fail (= (length (u64 0)) 4))

 (assert-fail (= (length (bignum 0)) 0))

-(assert-fail (sym 1))

-(assert-fail (sym 'blah))

+(assert (eq? (sym 'blah) 'blah))

+(assert (eq? (sym "hi" "there" 'symbol 123) 'hitheresymbol123))

+

 (assert-fail (exit 1 2))

 (assert (int-valued? 1.0))