├── Makefile ├── README.md ├── environment.c ├── environment.h ├── eval.c ├── eval.h ├── main.c ├── object.c ├── object.h ├── read.c ├── read.h ├── repl.c ├── repl.h └── test.lisp /Makefile: -------------------------------------------------------------------------------- 1 | TARGET=simple-lisp 2 | OBJS=environment.o main.o object.o eval.o read.o repl.o 3 | CFLAGS=-Wall -Werror 4 | CC=gcc 5 | 6 | all: $(TARGET) 7 | 8 | $(TARGET): $(OBJS) 9 | $(CC) -g3 $(CFLAGS) -o $@ $(OBJS) 10 | 11 | .c.o: 12 | $(CC) -g3 $(CFLAGS) -c $< 13 | 14 | clean: 15 | rm $(OBJS) $(TARGET) 16 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Micro Lisp Implementation in C 2 | 3 | [A micro-manual for LISP Implemented in C](http://nakkaya.com/2010/08/24/a-micro-manual-for-lisp-implemented-in-c/) 4 | -------------------------------------------------------------------------------- /environment.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include "object.h" 5 | #include "eval.h" 6 | 7 | object *tee; 8 | object *nil; 9 | 10 | static object *fn_car(object *args, object *env) 11 | { 12 | object *first_arg = car(args); 13 | return car(first_arg); 14 | } 15 | 16 | static object *fn_cdr(object *args, object *env) 17 | { 18 | object *first_arg = car(args); 19 | return cdr(first_arg); 20 | } 21 | 22 | static object *fn_quote(object *args, object *env) 23 | { 24 | return car(args); 25 | } 26 | 27 | static object *fn_cons(object *args, object *env) 28 | { 29 | object *list = cons(car(args), NULL); 30 | args = car(cdr(args)); 31 | 32 | // @@@ 33 | 34 | while (args != NULL && IS_CONS(args)) { 35 | append(list, car(args)); 36 | args = cdr(args); 37 | } 38 | 39 | return list; 40 | } 41 | 42 | static object *fn_equal(object *args, object *env) 43 | { 44 | object *first_arg = car(args); 45 | object *second_arg = car(cdr(args)); 46 | 47 | if (strcmp(object_name(first_arg), object_name(second_arg)) == 0) 48 | return tee; 49 | 50 | return nil; 51 | } 52 | 53 | static object *fn_atom(object *args, object *env) 54 | { 55 | object *first_arg = car(args); 56 | 57 | if (IS_ATOM(first_arg)) 58 | return tee; 59 | else 60 | return nil; 61 | } 62 | 63 | static object *fn_cond(object *args, object *env) 64 | { 65 | while (args != NULL && IS_CONS(args)) { 66 | object *cond_and_body = car(args); 67 | object *condition_result = nil; 68 | object *condition = car(cond_and_body); 69 | object *body = car(cdr(cond_and_body)); 70 | 71 | if (condition != nil) 72 | condition_result = eval(condition, env); 73 | 74 | if (condition_result != nil) 75 | return eval(body, env); 76 | 77 | args = cdr(args); 78 | } 79 | return NULL; 80 | } 81 | 82 | static object *create_parameter_pairs(object *parameters, object *arguments) 83 | { 84 | object *pairs; 85 | object *pair; 86 | object *param, *arg; 87 | 88 | param = car(parameters); 89 | arg = car(arguments); 90 | pair = cons(param, cons(arg, NULL)); 91 | 92 | pairs = cons(pair, NULL); 93 | 94 | parameters = cdr(parameters); 95 | arguments = cdr(arguments); 96 | 97 | while (parameters != NULL && IS_CONS(parameters)) { 98 | param = car(parameters); 99 | arg = car(arguments); 100 | 101 | pair = cons(param, cons(arg, NULL)); 102 | append(pairs, pair); 103 | 104 | parameters = cdr(parameters); 105 | arguments = cdr(arguments); 106 | } 107 | 108 | return pairs; 109 | } 110 | 111 | static object *replace_atom(object *sexp, object *parameter_pairs) 112 | { 113 | if (IS_CONS(sexp)) { 114 | object *list; 115 | 116 | list = cons(replace_atom(car(sexp), parameter_pairs), NULL); 117 | sexp = cdr(sexp); 118 | 119 | while (sexp != NULL && IS_CONS(sexp)) { 120 | append(list, replace_atom(car(sexp), parameter_pairs)); 121 | sexp = cdr(sexp); 122 | } 123 | 124 | return list; 125 | 126 | } else { 127 | object *tmp = parameter_pairs; 128 | 129 | while (tmp != NULL && IS_CONS(tmp)) { 130 | object *pair = car(tmp); 131 | object *parameter = car(pair); 132 | object *argument = car(cdr(pair)); 133 | 134 | if (strcmp(object_name(parameter), object_name(sexp)) == 0) 135 | return argument; 136 | 137 | tmp = cdr(tmp); 138 | } 139 | 140 | return sexp; 141 | } 142 | } 143 | 144 | object *fn_lambda(object *args, object *env) 145 | { 146 | lambda_object *lambda; 147 | object *arguments, *sexp; 148 | object *parameter_pairs; 149 | 150 | lambda = (lambda_object*)car(args); 151 | arguments = cdr(args); 152 | 153 | parameter_pairs = create_parameter_pairs(lambda->args, arguments); 154 | sexp = replace_atom(lambda->sexp, parameter_pairs); 155 | 156 | return eval(sexp, env); 157 | } 158 | 159 | static object *fn_label(object *args, object *env) 160 | { 161 | object *first_arg = car(args); 162 | object *symbol = atom(object_name(first_arg)); 163 | object *value = car(cdr(args)); 164 | 165 | append(env, cons(symbol, cons(value, NULL))); 166 | return tee; 167 | } 168 | #include 169 | object* init_env(void) 170 | { 171 | object *env; 172 | 173 | #define FUNCTION_SYMBOL(name, func_ptr) \ 174 | (cons(atom((name)), cons(function((func_ptr)), NULL))) 175 | 176 | env = cons(FUNCTION_SYMBOL("QUOTE", &fn_quote), NULL); 177 | 178 | append( env, FUNCTION_SYMBOL("CAR", &fn_car)); 179 | append( env, FUNCTION_SYMBOL("CDR", &fn_cdr)); 180 | append( env, FUNCTION_SYMBOL("CONS", &fn_cons)); 181 | append( env, FUNCTION_SYMBOL("EQUAL", &fn_equal)); 182 | append( env, FUNCTION_SYMBOL("ATOM", &fn_atom)); 183 | append( env, FUNCTION_SYMBOL("COND", &fn_cond)); 184 | append( env, FUNCTION_SYMBOL("LAMBDA", &fn_lambda)); 185 | append( env, FUNCTION_SYMBOL("LABEL", &fn_label)); 186 | 187 | #undef FUNCTION_SYMBOL 188 | 189 | tee = atom("#T"); 190 | nil = cons(NULL,NULL); 191 | 192 | return env; 193 | } 194 | -------------------------------------------------------------------------------- /environment.h: -------------------------------------------------------------------------------- 1 | #ifndef _ENVIRONMENT_H_ 2 | #define _ENVIRONMENT_H_ 3 | 4 | extern object *fn_lambda(object *args, object *env); 5 | extern object* init_env(void); 6 | 7 | #endif /* _ENVIRONMENT_H_ */ 8 | -------------------------------------------------------------------------------- /eval.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #include "object.h" 6 | #include "environment.h" 7 | 8 | static object *eval_function(object *sexp, object *env) 9 | { 10 | object *symbol = car(sexp); 11 | object *args = cdr(sexp); 12 | 13 | if (IS_LAMBDA(symbol)) 14 | return fn_lambda(sexp, env); 15 | else if (IS_FUNCTION(symbol)) { 16 | function_object *func = (function_object*)symbol; 17 | return (func->fn)(args, env); 18 | } else 19 | return sexp; 20 | } 21 | 22 | static object *lookup(char *symbol_name, object *env) 23 | { 24 | object *tmp = env; 25 | 26 | while (tmp != NULL && IS_CONS(tmp)) { 27 | object *pair, *name, *value; 28 | pair = car(tmp); 29 | name = car(pair); 30 | value = car(cdr(pair)); 31 | 32 | if (strcmp(object_name(name), symbol_name) == 0) 33 | return value; 34 | 35 | tmp = cdr(tmp); 36 | } 37 | 38 | return NULL; 39 | } 40 | 41 | object *eval(object *sexp, object *env) 42 | { 43 | if (sexp == NULL) 44 | return nil; 45 | 46 | if (IS_CONS(sexp)) { 47 | object *first_param = car(sexp); 48 | 49 | if (IS_ATOM(first_param) 50 | && strcmp(object_name(first_param), "LAMBDA") == 0) { 51 | object *rest_args = cdr(sexp); 52 | object *lambda_args = car(rest_args); 53 | object *lambda_sexp = car( cdr(rest_args) ); 54 | 55 | return lambda(lambda_args, lambda_sexp); 56 | } else { 57 | object *func_symbol = car(sexp); 58 | object *accum = cons(eval(func_symbol, env), NULL); 59 | 60 | sexp = cdr(sexp); 61 | while (sexp != NULL && IS_CONS(sexp)) { 62 | append(accum, eval(car(sexp), env)); 63 | sexp = cdr(sexp); 64 | } 65 | 66 | return eval_function(accum, env); 67 | } 68 | } else { 69 | object *value = lookup(object_name(sexp), env); 70 | 71 | if (value == NULL) 72 | return sexp; 73 | else 74 | return value; 75 | } 76 | 77 | fprintf(stderr, "Never Reach Here"); 78 | exit(1); 79 | } 80 | -------------------------------------------------------------------------------- /eval.h: -------------------------------------------------------------------------------- 1 | #ifndef _EVAL_H_ 2 | #define _EVAL_H_ 3 | 4 | extern object *eval(object *sexp, object *env); 5 | 6 | #endif /* _EVAL_H_ */ 7 | -------------------------------------------------------------------------------- /main.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include "repl.h" 4 | 5 | int main(int argc, char *argv[]) 6 | { 7 | FILE* in; 8 | 9 | if (argc > 1) 10 | in = fopen(argv[1], "r"); 11 | else 12 | in = stdin; 13 | 14 | repl(in); 15 | return 0; 16 | } 17 | -------------------------------------------------------------------------------- /object.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | #include "object.h" 7 | 8 | char *object_name(object *obj) 9 | { 10 | if (!IS_ATOM(obj)) { 11 | fprintf(stderr, "[%s] Object is not Atom(type=%d)\n", __func__, obj->type); 12 | exit(1); 13 | } 14 | 15 | return ((atom_object*)obj)->name; 16 | } 17 | 18 | object *atom(char *atom_name) 19 | { 20 | atom_object *ptr; 21 | char *name; 22 | size_t name_len; 23 | 24 | name_len = strlen(atom_name) + 1; /* with '\0' */ 25 | 26 | ptr = (atom_object*)malloc(sizeof(atom_object)); 27 | if (ptr == NULL) { 28 | perror("malloc(obj):"); 29 | exit(1); 30 | } 31 | 32 | ptr->type = ATOM; 33 | name = (char*)malloc(name_len); 34 | if (name == NULL) { 35 | perror("malloc(name):"); 36 | exit(1); 37 | } 38 | 39 | strncpy(name, atom_name, name_len); 40 | ptr->name = name; 41 | return (object*)ptr; 42 | } 43 | 44 | object *cons(object *first, object *rest) 45 | { 46 | cons_object *ptr; 47 | 48 | ptr = (cons_object*)malloc(sizeof(cons_object)); 49 | if (ptr == NULL) { 50 | perror("malloc(ptr)"); 51 | exit(1); 52 | } 53 | 54 | ptr->type = CONS; 55 | ptr->car = first; 56 | ptr->cdr = rest; 57 | 58 | return (object*)ptr; 59 | } 60 | 61 | object *function(object* (*fn)(object*, object*)) 62 | { 63 | function_object *ptr; 64 | 65 | ptr = (function_object*)malloc(sizeof(function_object)); 66 | if (ptr == NULL) { 67 | perror("malloc(ptr)"); 68 | exit(1); 69 | } 70 | 71 | ptr->type = FUNC; 72 | ptr->fn = fn; 73 | 74 | return (object*)ptr; 75 | } 76 | 77 | object *lambda(object *args, object *sexp) 78 | { 79 | lambda_object *ptr; 80 | 81 | ptr = (lambda_object*)malloc(sizeof(lambda_object)); 82 | if (ptr == NULL) { 83 | perror("malloc(obj)"); 84 | exit(1); 85 | } 86 | 87 | ptr->type = LAMBDA; 88 | ptr->args = args; 89 | ptr->sexp = sexp; 90 | 91 | return (object*)ptr; 92 | } 93 | 94 | void append(object *list, object *obj) 95 | { 96 | object *ptr; 97 | 98 | for (ptr = list; cdr(ptr) != NULL; ptr = cdr(ptr)) 99 | ; 100 | 101 | cdr(ptr) = cons(obj, NULL); 102 | } 103 | -------------------------------------------------------------------------------- /object.h: -------------------------------------------------------------------------------- 1 | #ifndef _OBJECT_H_ 2 | #define _OBJECT_H_ 3 | 4 | enum object_type { 5 | CONS, 6 | ATOM, 7 | FUNC, 8 | LAMBDA 9 | }; 10 | 11 | #define IS_ATOM(obj) ((obj)->type == ATOM) 12 | #define IS_CONS(obj) ((obj)->type == CONS) 13 | #define IS_FUNCTION(obj) ((obj)->type == FUNC) 14 | #define IS_LAMBDA(obj) ((obj)->type == LAMBDA) 15 | 16 | /* 17 | * Object Type Definitions 18 | */ 19 | typedef struct { 20 | enum object_type type; 21 | } object; 22 | 23 | typedef struct { 24 | enum object_type type; 25 | char *name; 26 | } atom_object; 27 | 28 | typedef struct { 29 | enum object_type type; 30 | object *car; 31 | object *cons; 32 | object *cdr; 33 | } cons_object; 34 | 35 | typedef struct { 36 | enum object_type type; 37 | object *(*fn)(object *, object*); 38 | } function_object; 39 | 40 | typedef struct { 41 | enum object_type type; 42 | object *args; 43 | object *sexp; 44 | } lambda_object; 45 | 46 | #define car(obj) (((cons_object*)(obj))->car) 47 | #define cdr(obj) (((cons_object*)(obj))->cdr) 48 | 49 | extern char *object_name(object *obj); 50 | extern object *cons(object *first, object *rest); 51 | extern void append(object *list, object *obj); 52 | 53 | extern object *atom(char *atom_name); 54 | extern object *function(object* (*fn)(object*, object*)); 55 | extern object *lambda(object *args, object *sexp); 56 | 57 | extern object *tee; 58 | extern object *nil; 59 | 60 | #endif /* _OBJECT_H_ */ 61 | -------------------------------------------------------------------------------- /read.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | #include "object.h" 7 | 8 | static object *next_token(FILE *in) 9 | { 10 | char buffer[1024]; 11 | int ch, index = 0; 12 | 13 | ch = getc(in); 14 | while (isspace(ch)) 15 | ch = getc(in); 16 | 17 | if (ch == '\n') 18 | ch = getc(in); 19 | 20 | if (ch == EOF) { 21 | exit(0); 22 | } 23 | 24 | if (ch == ')') 25 | return atom(")"); 26 | if (ch == '(') 27 | return atom("("); 28 | 29 | while (!isspace(ch) && ch != ')') { 30 | buffer[index++] = ch; 31 | ch = getc(in); 32 | } 33 | 34 | buffer[index++] = '\0'; 35 | if (ch == ')') 36 | ungetc(ch, in); 37 | 38 | return atom(buffer); 39 | } 40 | 41 | static object *read_tail(FILE *in) 42 | { 43 | object *token = next_token(in); 44 | 45 | if (strcmp(object_name(token), ")") == 0){ 46 | return NULL; 47 | } else if (strcmp(object_name(token), "(") == 0) { 48 | object *first = read_tail(in); 49 | object *second = read_tail(in); 50 | 51 | return cons(first, second); 52 | } else { 53 | object *first = token; 54 | object *second = read_tail(in); 55 | 56 | return cons(first, second); 57 | } 58 | } 59 | 60 | object *read(FILE *in) 61 | { 62 | object *token = next_token(in); 63 | 64 | if (strcmp(object_name(token), "(") == 0) 65 | return read_tail(in); 66 | 67 | return token; 68 | } 69 | -------------------------------------------------------------------------------- /read.h: -------------------------------------------------------------------------------- 1 | #ifndef _READ_H_ 2 | #define _READ_H_ 3 | 4 | extern object *read(FILE *in); 5 | 6 | #endif /* _READ_H_ */ 7 | -------------------------------------------------------------------------------- /repl.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include "object.h" 4 | #include "environment.h" 5 | #include "eval.h" 6 | #include "read.h" 7 | 8 | static void print(object *sexp) 9 | { 10 | if (sexp == NULL) 11 | return; 12 | 13 | if (IS_CONS(sexp)) { 14 | printf("("); 15 | 16 | print(car(sexp)); 17 | sexp = cdr(sexp); 18 | while (sexp != NULL && IS_CONS(sexp)) { 19 | printf(" "); 20 | print(car(sexp)); 21 | 22 | sexp = cdr(sexp); 23 | } 24 | 25 | printf(")"); 26 | } else if (IS_ATOM(sexp)) { 27 | printf("%s", object_name(sexp)); 28 | } else if (IS_LAMBDA(sexp)) { 29 | lambda_object *lambda = (lambda_object*)sexp; 30 | 31 | printf("#"); 32 | 33 | print(lambda->args); 34 | print(lambda->sexp); 35 | } else { 36 | printf("Error."); 37 | } 38 | } 39 | 40 | void repl(FILE *input) 41 | { 42 | object *env; 43 | 44 | env = init_env(); 45 | 46 | do { 47 | printf("(simple-lisp)> "); 48 | print(eval(read(input), env)); 49 | printf("\n"); 50 | } while(1); 51 | } 52 | -------------------------------------------------------------------------------- /repl.h: -------------------------------------------------------------------------------- 1 | #ifndef _REPL_H_ 2 | #define _REPL_H_ 3 | 4 | extern void repl(FILE *input); 5 | 6 | #endif /* _REPL_H_ */ 7 | -------------------------------------------------------------------------------- /test.lisp: -------------------------------------------------------------------------------- 1 | (QUOTE A) 2 | (QUOTE (A B C)) 3 | (CAR (QUOTE (A B C))) 4 | (CDR (QUOTE (A B C))) 5 | (CONS (QUOTE A) (QUOTE (B C))) 6 | (EQUAL (CAR (QUOTE (A B))) (QUOTE A)) 7 | (EQUAL (CAR (CDR (QUOTE (A B)))) (QUOTE A)) 8 | (ATOM (QUOTE A)) 9 | (COND ((ATOM (QUOTE A)) (QUOTE B)) ((QUOTE T) (QUOTE C))) 10 | ((LAMBDA (X Y) (CONS (CAR X) Y)) (QUOTE (A B)) (CDR (QUOTE (C D)))) 11 | (LABEL FF (LAMBDA (X Y) (CONS (CAR X) Y))) 12 | (FF (QUOTE (A B)) (CDR (QUOTE (C D)))) 13 | (LABEL XX (QUOTE (A B))) 14 | (CAR XX) 15 | --------------------------------------------------------------------------------