shithub: sl

Info  •  Files  •  Log  •  Branches

keyword args: allow ":arg" as such only

There was confusion with :abc vs abc: in C and
compiler - stick to one way to define those.

Fixes: https://todo.sr.ht/~ft/femtolisp/43

--- a/builtins.c

+++ b/builtins.c

@@ -159,8 +159,7 @@

 BUILTIN("keyword?", keywordp)

 {

 	argcount(nargs, 1);

-	return (issymbol(args[0]) &&

-			iskeyword((symbol_t*)ptr(args[0]))) ? FL_t : FL_f;

+	return (issymbol(args[0]) && iskeyword((symbol_t*)ptr(args[0]))) ? FL_t : FL_f;

 }

 fl_purefn

@@ -200,7 +199,7 @@

 	const char *k = nil;

 	symbol_t *v;

 	while(Tnext(FL(symtab), &k, (void**)&v)){

-		if(v->binding != UNBOUND && !fl_is_keyword_name(v->name, strlen(v->name)))

+		if(v->binding != UNBOUND && (v->flags & FLAG_KEYWORD) == 0)

 			lst = fl_cons(tagptr(v, TAG_SYM), lst);

 	}

 	fl_free_gc_handles(1);

--- a/compiler.lsp

+++ b/compiler.lsp

@@ -550,7 +550,7 @@

 (define (keyword->symbol k)

   (if (keyword? k)

       (symbol (let ((s (string k)))

-                (string-sub s 0 (1- (string-length s)))))

+                (string-sub s 1 (string-length s))))

       k))

 (define (lambda-vars l)

@@ -559,7 +559,7 @@

           ((and (cons? l) (symbol? (car l)))

            (if (or opt kw)

                (error "compile error: invalid argument list "

-                      o ". optional arguments must come after required.")

+                      o ": optional arguments must come after required.")

                (check-formals (cdr l) o opt kw)))

           ((and (cons? l) (cons? (car l)))

            (unless (and (length= (car l) 2)

@@ -570,7 +570,7 @@

                (check-formals (cdr l) o opt #t)

                (if kw

                    (error "compile error: invalid argument list "

-                          o ". keyword arguments must come last.")

+                          o ": keyword arguments must come last.")

                    (check-formals (cdr l) o #t kw))))

           ((cons? l)

            (error "compile error: invalid formal argument " (car l)

--- a/flisp.boot

+++ b/flisp.boot

@@ -257,17 +257,17 @@

 	    io-readline #fn("7000n12002162:" #(#fn(io-readuntil) #\newline) io-readline)

 	    io-readlines #fn("7000n17071062:" #(read-all-of io-readline) io-readlines) iota

 	    #fn("7000n17071062:" #(map-int identity) iota) is-lambda? #fn("6000n1020Q;I704020Q:" #(λ) is-lambda?)

-	    keyword->symbol #fn("<000n1200513O021220512386E742586515153^161:0:" #(#fn(keyword?)

-										  #fn(symbol)

-										  #fn(string)

-										  #fn(string-sub)

-										  1- #fn(string-length)) keyword->symbol)

+	    keyword->symbol #fn(";000n1200513K021220512386K24865153^161:0:" #(#fn(keyword?)

+									      #fn(symbol)

+									      #fn(string)

+									      #fn(string-sub)

+									      #fn(string-length)) keyword->symbol)

 	    keyword-arg? #fn("6000n10B;3904200<61:" #(#fn(keyword?)) keyword-arg?) lambda-vars

 	    #fn(":000n1\x8d\x8a520852185>1_51485<00OO54422237405162:" #(#0#

 									#fn(":000n40V;I5040R340D:0B3Z00<R3T082;I504833<0702112263:A<0=1828364:0B3\x8d00<B3\x870730<r2523?074051R360O@=070250<2615442774051513=0A<0=182D64:833<0702112863:A<0=1D8364:0B3>070290<26164:01C:07021162:7029026164:" #(error

-  "compile error: invalid argument list " ". optional arguments must come after required." length=

+  "compile error: invalid argument list " ": optional arguments must come after required." length=

   caar "compile error: invalid optional argument " " in list " #fn(keyword?)

-  ". keyword arguments must come last." "compile error: invalid formal argument ") check-formals)

+  ": keyword arguments must come last." "compile error: invalid formal argument ") check-formals)

 									#fn(map)

 									#fn("6000n10B390700<61:0:" #(keyword->symbol))

 									to-proper) lambda-vars)

binary files a/flisp.boot.builtin b/flisp.boot.builtin differ

--- a/flisp.c

+++ b/flisp.c

@@ -184,18 +184,12 @@

 // symbol table ---------------------------------------------------------------

-bool

-fl_is_keyword_name(const char *str, size_t len)

-{

-	return (str[0] == ':' || str[len-1] == ':') && str[1] != '\0';

-}

-

 static symbol_t *

 mk_symbol(const char *str, int len, bool copy)

 {

 	symbol_t *sym = MEM_ALLOC(sizeof(*sym) + (copy ? len+1 : 0));

 	sym->numtype = NONNUMERIC;

-	if(fl_is_keyword_name(str, len)){

+	if(str[0] == ':' && str[1] != 0){

 		value_t s = tagptr(sym, TAG_SYM);

 		sym->flags = FLAG_KEYWORD;

 		setc(s, s);

--- a/flisp.h

+++ b/flisp.h

@@ -207,7 +207,6 @@

 value_t fl_cons(value_t a, value_t b);

 value_t fl_list2(value_t a, value_t b);

 value_t fl_listn(size_t n, ...);

-bool fl_is_keyword_name(const char *str, size_t len) fl_purefn fl_hotfn;

 bool fl_isnumber(value_t v) fl_purefn;

 value_t alloc_vector(size_t n, int init);

--- a/test/unittest.lsp

+++ b/test/unittest.lsp

@@ -241,22 +241,23 @@

 (assert (equal? ((λ ((x 0) . r) (list x r)) 1 2 3) '(1 (2 3))))

 ; keyword arguments

-(assert (keyword? kw:))

+(assert (keyword? :kw))

+(assert (not (keyword? 'kw:)))

 (assert (not (keyword? 'kw)))

 (assert (not (keyword? ':)))

-(assert (equal? ((λ (x (a 2) (b: a) . r) (list x a b r)) 1 0 8 4 5)

+(assert (equal? ((λ (x (a 2) (:b a) . r) (list x a b r)) 1 0 8 4 5)

                 '(1 0 0 (8 4 5))))

-(assert (equal? ((λ (x (a 2) (b: a) . r) (list x a b r)) 0 b: 3 1)

+(assert (equal? ((λ (x (a 2) (:b a) . r) (list x a b r)) 0 :b 3 1)

                 '(0 2 3 (1))))

-(define (keys4 (a: 8) (b: 3) (c: 7) (d: 6)) (list a b c d))

-(assert (equal? (keys4 a: 10) '(10 3 7 6)))

-(assert (equal? (keys4 b: 10) '(8 10 7 6)))

-(assert (equal? (keys4 c: 10) '(8 3 10 6)))

-(assert (equal? (keys4 d: 10) '(8 3 7 10)))

-(assert-fail (keys4 e: 10))   ; unsupported keyword

-(assert-fail (keys4 a: 1 b:)) ; keyword with no argument

-(define (keys1 (a: 8)) (+ a 1))

-(assert (equal? (keys1 a: 11) 12))

+(define (keys4 (:a 8) (:b 3) (:c 7) (:d 6)) (list a b c d))

+(assert (equal? (keys4 :a 10) '(10 3 7 6)))

+(assert (equal? (keys4 :b 10) '(8 10 7 6)))

+(assert (equal? (keys4 :c 10) '(8 3 10 6)))

+(assert (equal? (keys4 :d 10) '(8 3 7 10)))

+(assert-fail (keys4 :e 10))   ; unsupported keyword

+(assert-fail (keys4 :a 1 :b)) ; keyword with no argument

+(define (keys1 (:a 8)) (+ a 1))

+(assert (equal? (keys1 :a 11) 12))

 ; cvalues and arrays

 (assert (equal? (typeof "") '(array byte)))