From ba57b2de9e84af94c68a94a5d0be08d5e25ab921 Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Tue, 23 Aug 2016 22:18:16 +0200 Subject: Add builtin_define --- ast.c | 14 +++++++++++ ast.h | 1 + code.lysp | 4 ++- inter_builtins.c | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++++---- inter_builtins.h | 4 +-- interpreter.c | 14 ++++++++--- interpreter.h | 1 + main.c | 4 +-- 8 files changed, 105 insertions(+), 14 deletions(-) diff --git a/ast.c b/ast.c index c2ea654..7456ee3 100644 --- a/ast.c +++ b/ast.c @@ -24,6 +24,9 @@ void ast_free(AST *ast){ if(ast->la.body)ast_free(ast->la.body); break; + case AST_LAMBDAARG: + break; + case AST_WORD: assert(ast->wo.word); free(ast->wo.word); @@ -64,6 +67,9 @@ AST* ast_copy(const AST *ast){ case AST_LAMBDA: return ast_lambda(ast->la.cfunc,ast->la.body?ast_copy(ast->la.body):NULL); + case AST_LAMBDAARG: + return ast_lambdaarg(ast->ar.idx); + case AST_WORD: assert(ast->wo.word); return ast_word(copystring(ast->wo.word)); @@ -217,6 +223,14 @@ AST* ast_lambda(lambdafunc_t cfunc,AST *body){ return ast; } +AST* ast_lambdaarg(int idx){ + assert(idx>=0); + AST *ast=malloc(1,AST); + ast->type=AST_LAMBDAARG; + ast->ar.idx=idx; + return ast; +} + AST* ast_word(char *word){ assert(word); AST *ast=malloc(1,AST); diff --git a/ast.h b/ast.h index 6ec6ce8..99aa2d8 100644 --- a/ast.h +++ b/ast.h @@ -85,6 +85,7 @@ char* ast_stringify(const AST *ast); AST* ast_list(int len,AST **nodes); //these convenience functions DO NOT copy their arguments AST* ast_lambda(lambdafunc_t cfunc,AST *body); +AST* ast_lambdaarg(int idx); AST* ast_word(char *word); AST* ast_number(double num); AST* ast_string(char *str,int len); diff --git a/code.lysp b/code.lysp index f509404..17a3d24 100644 --- a/code.lysp +++ b/code.lysp @@ -8,4 +8,6 @@ '''"hoi" '''''(dit is quoted) 'kaas ;meer commentaar - "kazen enzo")) \ No newline at end of file + "kazen enzo") + (define 'kaas '(a b) '(print a b)) + (print (kaas 10 "hoi"))) \ No newline at end of file diff --git a/inter_builtins.c b/inter_builtins.c index cc96afd..6793c60 100644 --- a/inter_builtins.c +++ b/inter_builtins.c @@ -1,5 +1,6 @@ #include #include +#include #include #include "inter_builtins.h" @@ -32,6 +33,7 @@ InterRet builtin_print(InterState *is,int nargs,AST **args){ return ir_ast(ast_list(0,malloc(1,AST*))); } + #define BUILTIN_ARITH_OP(op,name,defval,expr) \ InterRet builtin_##name(InterState *is,int nargs,AST **args){ \ (void)is; \ @@ -51,10 +53,75 @@ InterRet builtin_print(InterState *is,int nargs,AST **args){ return ir_ast(ast_number(res)); \ } -BUILTIN_ARITH_OP(+,sum,0,res+n) -BUILTIN_ARITH_OP(-,difference,0,res-n) -BUILTIN_ARITH_OP(*,product,1,res*n) -BUILTIN_ARITH_OP(/,quotient,1,res/n) -BUILTIN_ARITH_OP(%,remainder,1,floatmod(res,n)) +BUILTIN_ARITH_OP(+,sum,0,res+n); +BUILTIN_ARITH_OP(-,difference,0,res-n); +BUILTIN_ARITH_OP(*,product,1,res*n); +BUILTIN_ARITH_OP(/,quotient,1,res/n); +BUILTIN_ARITH_OP(%,remainder,1,floatmod(res,n)); #undef BUILTIN_ARITH_OP + + +void convert_arguments(AST *ast,int nargs,const char **args){ + switch(ast->type){ + case AST_LIST: + for(int i=0;ili.len;i++)convert_arguments(ast->li.nodes[i],nargs,args); + break; + + case AST_LAMBDA: + if(ast->la.body)convert_arguments(ast->la.body,nargs,args); + break; + + case AST_WORD:{ + int i; + for(i=0;iwo.word,args[i])==0)break; + } + if(i==nargs)break; + free(ast->wo.word); + ast->type=AST_LAMBDAARG; + ast->ar.idx=i; + break; + } + + case AST_QUOTED: + convert_arguments(ast->qu.ast,nargs,args); + break; + + case AST_LAMBDAARG: + case AST_NUMBER: + case AST_STRING: + case AST_SYMBOL: + break; + + default: + assert(false); + } +} + +InterRet builtin_define(InterState *is,int nargs,AST **args){ + if(nargs!=3)return ir_err_c("Invalid number of arguments to builtin 'define'"); + if(args[0]->type!=AST_SYMBOL){ + return ir_err_c("First argument to builtin 'define' should be symbol"); + } + if(args[1]->type!=AST_LIST){ + return ir_err_c("Second argument to builtin 'define' should be quoted list"); + } + const AST *arglist=args[1]; + for(int i=0;ili.len;i++){ + if(arglist->li.nodes[i]->type!=AST_WORD){ + return ir_err_c("Second argument to builtin 'define' should contain words"); + } + } + + const char *funcname=args[0]->sy.name; + AST *body=args[2]; + + const char *argnames[arglist->li.len]; + for(int i=0;ili.len;i++)argnames[i]=arglist->li.nodes[i]->wo.word; + + convert_arguments(body,arglist->li.len,argnames); + + inter_assign(is,funcname,ast_lambda(NULL,ast_copy(body))); + return ir_ast(ast_list(0,malloc(1,AST*))); +} diff --git a/inter_builtins.h b/inter_builtins.h index 6dc935d..c9a4bdc 100644 --- a/inter_builtins.h +++ b/inter_builtins.h @@ -1,8 +1,7 @@ #pragma once #include "ast.h" - -typedef struct InterRet InterRet; +#include "interpreter.h" InterRet builtin_do(InterState *is,int nargs,AST **args); InterRet builtin_print(InterState *is,int nargs,AST **args); @@ -11,3 +10,4 @@ InterRet builtin_difference(InterState *is,int nargs,AST **args); InterRet builtin_product(InterState *is,int nargs,AST **args); InterRet builtin_quotient(InterState *is,int nargs,AST **args); InterRet builtin_remainder(InterState *is,int nargs,AST **args); +InterRet builtin_define(InterState *is,int nargs,AST **args); diff --git a/interpreter.c b/interpreter.c index 05e5d2c..fec9087 100644 --- a/interpreter.c +++ b/interpreter.c @@ -172,7 +172,9 @@ static InterRet interpret(InterState *is,const AST *ast){ #define NOT_IMPLEMENTED false if(nodes[0]->la.body)assert(NOT_IMPLEMENTED); - return nodes[0]->la.cfunc(is,ast->li.len-1,nodes+1); + InterRet ir=nodes[0]->la.cfunc(is,ast->li.len-1,nodes+1); + for(int i=0;ili.len;i++)ast_free(nodes[i]); + return ir; } case AST_SYMBOL: @@ -201,16 +203,20 @@ static InterRet interpret(InterState *is,const AST *ast){ } } -void inter_register(InterState *is,const char *name,lambdafunc_t cfunc){ +void inter_assign(InterState *is,const char *name,AST *ast){ assert(is->scope); int h=namehash(name,VMAP_HASHSZ); Vllist *ll=malloc(1,Vllist); ll->name=copystring(name); - ll->value=ast_lambda(cfunc,NULL); + ll->value=ast; ll->next=is->scope->vmap[h]; is->scope->vmap[h]=ll; } +void inter_register(InterState *is,const char *name,lambdafunc_t cfunc){ + inter_assign(is,name,ast_lambda(cfunc,NULL)); +} + void inter_register_prelude(InterState *is){ inter_register(is,"do",builtin_do); inter_register(is,"print",builtin_print); @@ -224,10 +230,10 @@ void inter_register_prelude(InterState *is){ inter_register(is,"product",builtin_product); inter_register(is,"quotient",builtin_quotient); inter_register(is,"remainder",builtin_remainder); + inter_register(is,"define",builtin_define); } InterRet inter_runcode(InterState *is,AST *ast){ intern_symbols(is,ast); - return interpret(is,ast); } diff --git a/interpreter.h b/interpreter.h index 4434de2..5dbd119 100644 --- a/interpreter.h +++ b/interpreter.h @@ -19,6 +19,7 @@ typedef struct InterState InterState; InterState* inter_make(void); void inter_destroy(InterState *is); +void inter_assign(InterState *is,const char *name,AST *ast); //ast is not copied void inter_register(InterState *is,const char *name,lambdafunc_t cfunc); void inter_register_prelude(InterState *is); InterRet inter_runcode(InterState *is,AST *ast); //updates symbol id's diff --git a/main.c b/main.c index fefeafc..9bbb379 100644 --- a/main.c +++ b/main.c @@ -81,7 +81,7 @@ int main(int argc,char **argv){ } assert(pr.ast); char *s=ast_stringify(pr.ast); - printf("%s\n",s); + printf("parsed: %s\n",s); free(s); InterState *is=inter_make(); @@ -93,7 +93,7 @@ int main(int argc,char **argv){ return 1; } s=ast_stringify(ir.ast); - printf("%s\n",s); + printf("return value: %s\n",s); free(s); ast_free(ir.ast); inter_destroy(is); -- cgit v1.2.3