Skip to content

Commit a5313aa

Browse files
NJdevProNJdevPro
committed
Make length and reverse operate on strings.
Add atom primitive.
1 parent 6c3d68b commit a5313aa

2 files changed

Lines changed: 105 additions & 82 deletions

File tree

‎README.md‎

Lines changed: 18 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -181,12 +181,16 @@ car.
181181
(setcar cell 'x)
182182
cell ; -> (x . b)
183183

184-
`length` and `reverse` operate on a whole list. They can also operate on their arguments.
184+
`length` and `reverse` operate on a whole list or a on string.
185+
They can also operate on their arguments when their number is > 1.
185186

186-
(length '(1 2 3)) ; -> 3
187-
(length 1 2 t) ; -> 3
188-
(reverse '(a b c)) ; -> (c b a)
189-
(reverse '(a) b c) ; -> (c b (a))
187+
(length '(1 2 3)) ; -> 3
188+
(length 1 2 t) ; -> 3
189+
(length "1 2 3") ; -> 5
190+
191+
(reverse '(a b c)) ; -> (c b a)
192+
(reverse "1234") ; -> "4321"
193+
(reverse '(a) b "c") ; -> ("c" b (a))
190194

191195
### Numeric operators
192196

@@ -356,7 +360,15 @@ is not defined.
356360
(define val (+ 3 5))
357361
(setq val (+ val 1)) ; increment "val"
358362

359-
### system functions
363+
### Introspection
364+
365+
`atom` returns () if the argument is a cell, t otherwise.
366+
367+
(atom '(a b)) ; -> ()
368+
(atom "") ; -> t
369+
(atom ()) ; -> t
370+
371+
### System functions
360372
`load` loads a Lisp file and evaluates all its content, adding it to the environment.
361373

362374
(load 'example/nqueens.lisp) -> run the file and store its evaluated functions and macros

‎src/minilisp.c‎

Lines changed: 87 additions & 76 deletions
Original file line numberDiff line numberDiff line change
@@ -108,6 +108,12 @@ static int peek(void) {
108108
return c;
109109
}
110110

111+
void swap(char *left, char *right) {
112+
char tmp = *left;
113+
*left = *right;
114+
*right = tmp;
115+
}
116+
111117
// Destructively reverses the given list.
112118
static Obj *reverse(Obj *p) {
113119
Obj *ret = Nil;
@@ -299,7 +305,7 @@ static void print(Obj *obj) {
299305
case TSTRING:
300306
fputc('"', stdout);
301307
for (char *p = obj->name; *p; p++) {
302-
if (*p == '"') printf("\\\"");
308+
if (*p == '"') fputs("\\\"", stdout);
303309
else if (*p == '\n') fputc('\n', stdout);
304310
else if (*p == '\t') fputc('\t', stdout);
305311
else if (*p == '\r') fputc('\r', stdout);
@@ -310,6 +316,7 @@ static void print(Obj *obj) {
310316
default:
311317
error("Bug: print: Unknown tag type: %d", obj->type);
312318
}
319+
fflush(stdout);
313320
}
314321

315322
// Returns the length of the given list. -1 if it's not a proper list.
@@ -399,8 +406,27 @@ static Obj *apply(void *root, Obj **env, Obj **fn, Obj **args) {
399406
}
400407

401408
// Searches for a variable by symbol. Returns null if not found.
409+
/* An environment consists of a pointer to its parent environment (if any) and
410+
* two parallel lists - vars and vals.
411+
*
412+
* Case 1 - vars is a regular list:
413+
* vars: (a b c), vals: (1 2 3) ; a = 1, b = 2, c = 3
414+
*
415+
* Case 2 - vars is a dotted list:
416+
* vars: (a b . c), vals: (1 2) ; a = 1, b = 2, c = nil
417+
* vars: (a b . c), vals: (1 2 3) ; a = 1, b = 2, c = (3)
418+
* vars: (a b . c), vals: (1 2 3 4 5) ; a = 1, b = 2, c = (3 4 5)
419+
*
420+
* Case 3 - vars is a symbol:
421+
* vars: a, vals: nil ; a = nil
422+
* vars: a, vals: (1) ; a = (1)
423+
* vars: a, vals: (1 2 3) ; a = (1 2 3)
424+
*
425+
* Case 4 - vars and vals are both nil:
426+
* vars: nil, vals: nil
427+
*/
402428
static Obj *find(Obj **env, Obj *sym) {
403-
for (Obj *p = *env; p != Nil; p = p->up) {
429+
for (Obj *p = *env; p != Nil; p = p->up) { // search all environments
404430
for (Obj *cell = p->vars; cell != Nil; cell = cell->cdr) {
405431
Obj *bind = cell->car;
406432
if (sym == bind->car)
@@ -470,6 +496,12 @@ static Obj *prim_quote(void *root, Obj **env, Obj **list) {
470496
return (*list)->car;
471497
}
472498

499+
static Obj *prim_atom(void *root, Obj **env, Obj **list) {
500+
if (length(*list) != 1)
501+
error("atom takes ontly 1 argument");
502+
return ((*list)->car->type != TCELL) ? True : Nil;
503+
}
504+
473505
// (cons expr expr)
474506
static Obj *prim_cons(void *root, Obj **env, Obj **list) {
475507
if (length(*list) != 2)
@@ -540,36 +572,55 @@ static Obj *prim_gensym(void *root, Obj **env, Obj **list) {
540572
return make_symbol(root, buf);
541573
}
542574

543-
// (length <cell> | ...)
575+
// (length <cell> | length <string> | length ...)
544576
static Obj *prim_length(void *root, Obj **env, Obj **list) {
545577
Obj *args = eval_list(root, env, list);
546578
int len = length(args);
547-
if (len != 1) {
548-
// number of arguments to length
549-
}
550-
else {
551-
Obj *lst = args->car;
552-
if (lst != Nil && lst->type != TCELL)
553-
error("When length has a single argument, it must be a list");
554-
for (len = 0; lst != Nil && lst->type == TCELL; lst = lst->cdr)
555-
len++;
579+
if (len == 1) {
580+
Obj *car = args->car;
581+
if (car != Nil) {
582+
if (car->type == TSTRING) {
583+
len = strlen(car->name);
584+
}
585+
else if (car->type == TCELL) {
586+
for (len = 0; car != Nil && car->type == TCELL; car = car->cdr)
587+
len++;
588+
}
589+
else {
590+
error("When length has a single argument, it must be a list or a string");
591+
}
592+
}
556593
}
594+
557595
return make_int(root, len);
558596
}
559597

560598
// (reverse ... | reverse <cell>)
561599
static Obj *prim_reverse(void *root, Obj **env, Obj **list) {
562600
Obj *args = eval_list(root, env, list);
563601
int len = length(args);
564-
if (len > 1) {
565-
// reverse the arguments to reverse
602+
if (len != 1) {
566603
return reverse(args);
567604
}
568-
else { // reverse a list
569-
Obj *lst = args->car;
570-
if (lst != Nil && lst->type != TCELL)
571-
error("Argument to reverse must be a list");
572-
return reverse(lst);
605+
else {
606+
Obj *car = args->car;
607+
if (car != Nil) {
608+
if (car->type == TCELL) {
609+
return reverse(car);
610+
}
611+
else if(car->type == TSTRING){
612+
char *left = car->name,
613+
*right = left + strlen(car->name) - 1;
614+
while (left <= right) {
615+
swap(left, right);
616+
left++, right--;
617+
}
618+
}
619+
else {
620+
error("When reverse has a single argument, it must be a list");
621+
}
622+
}
623+
return car;
573624
}
574625
}
575626

@@ -633,53 +684,24 @@ static Obj *prim_minus(void *root, Obj **env, Obj **list) {
633684
return make_int(root, r);
634685
}
635686

636-
// (< <integer> <integer>)
637-
static Obj *prim_lt(void *root, Obj **env, Obj **list) {
638-
Obj *args = eval_list(root, env, list);
639-
if (length(args) != 2)
640-
error("malformed <");
641-
Obj *x = args->car;
642-
Obj *y = args->cdr->car;
643-
if (x->type != TINT || y->type != TINT)
644-
error("< takes only 2 numbers");
645-
return x->value < y->value ? True : Nil;
687+
// (op <integer> <integer>)
688+
#define PRIM_COMPARISON_OP(PRIM_OP, OP) \
689+
static Obj *PRIM_OP(void *root, Obj **env, Obj **list) { \
690+
Obj *args = eval_list(root, env, list); \
691+
if (length(args) != 2) \
692+
error(#OP " takes only 2 number"); \
693+
Obj *x = args->car; \
694+
Obj *y = args->cdr->car; \
695+
if (x->type != TINT || y->type != TINT) \
696+
error(#OP " takes only 2 numbers"); \
697+
return x->value OP y->value ? True : Nil; \
646698
}
647699

648-
// (> <integer> <integer>)
649-
static Obj *prim_gt(void *root, Obj **env, Obj **list) {
650-
Obj *args = eval_list(root, env, list);
651-
if (length(args) != 2)
652-
error("malformed >");
653-
Obj *x = args->car;
654-
Obj *y = args->cdr->car;
655-
if (x->type != TINT || y->type != TINT)
656-
error("> takes only 2 numbers");
657-
return x->value > y->value ? True : Nil;
658-
}
659-
660-
// (<= <integer> <integer>)
661-
static Obj *prim_lte(void *root, Obj **env, Obj **list) {
662-
Obj *args = eval_list(root, env, list);
663-
if (length(args) != 2)
664-
error("malformed <=");
665-
Obj *x = args->car;
666-
Obj *y = args->cdr->car;
667-
if (x->type != TINT || y->type != TINT)
668-
error("<= takes only 2 numbers");
669-
return x->value <= y->value ? True : Nil;
670-
}
671-
672-
// (>= <integer> <integer>)
673-
static Obj *prim_gte(void *root, Obj **env, Obj **list) {
674-
Obj *args = eval_list(root, env, list);
675-
if (length(args) != 2)
676-
error("malformed >=");
677-
Obj *x = args->car;
678-
Obj *y = args->cdr->car;
679-
if (x->type != TINT || y->type != TINT)
680-
error(">= takes only 2 numbers");
681-
return x->value >= y->value ? True : Nil;
682-
}
700+
PRIM_COMPARISON_OP(prim_num_eq, ==)
701+
PRIM_COMPARISON_OP(prim_lt, <)
702+
PRIM_COMPARISON_OP(prim_lte, <=)
703+
PRIM_COMPARISON_OP(prim_gt, >)
704+
PRIM_COMPARISON_OP(prim_gte, >=)
683705

684706
// (not <cell>)
685707
static Obj *prim_not(void *root, Obj **env, Obj **list) {
@@ -829,18 +851,6 @@ static Obj *prim_if(void *root, Obj **env, Obj **list) {
829851
return *els == Nil ? Nil : progn(root, env, els);
830852
}
831853

832-
// (= <integer> <integer>)
833-
static Obj *prim_num_eq(void *root, Obj **env, Obj **list) {
834-
if (length(*list) != 2)
835-
error("Malformed =");
836-
Obj *values = eval_list(root, env, list);
837-
Obj *x = values->car;
838-
Obj *y = values->cdr->car;
839-
if (x->type != TINT || y->type != TINT)
840-
error("= only takes numbers");
841-
return x->value == y->value ? True : Nil;
842-
}
843-
844854
// (eq expr expr)
845855
static Obj *prim_eq(void *root, Obj **env, Obj **list) {
846856
if (length(*list) != 2)
@@ -969,6 +979,7 @@ static void define_primitives(void *root, Obj **env) {
969979
add_primitive(root, env, "defmacro", prim_defmacro);
970980
add_primitive(root, env, "macroexpand", prim_macroexpand);
971981
add_primitive(root, env, "lambda", prim_lambda);
982+
add_primitive(root, env, "atom", prim_atom);
972983
add_primitive(root, env, "if", prim_if);
973984
add_primitive(root, env, "progn", prim_progn);
974985
add_primitive(root, env, "print", prim_print);

0 commit comments

Comments
 (0)