summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2016-08-23 22:18:16 +0200
committertomsmeding <tom.smeding@gmail.com>2016-08-23 22:18:16 +0200
commitba57b2de9e84af94c68a94a5d0be08d5e25ab921 (patch)
tree40b8d3278d08214f1eba3a74eb2eebe033fb906d
parentcac651cd88f8da1e5957b0cc13fa25d79e1887fc (diff)
Add builtin_define
-rw-r--r--ast.c14
-rw-r--r--ast.h1
-rw-r--r--code.lysp4
-rw-r--r--inter_builtins.c77
-rw-r--r--inter_builtins.h4
-rw-r--r--interpreter.c14
-rw-r--r--interpreter.h1
-rw-r--r--main.c4
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 <stdio.h>
#include <stdlib.h>
+#include <string.h>
#include <assert.h>
#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;i<ast->li.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;i<nargs;i++){
+ if(strcmp(ast->wo.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;i<arglist->li.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;i<arglist->li.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;i<ast->li.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);