From fec8262285899e142494409ef028b1c27d58068f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 1 Jun 2015 21:48:16 -0400 Subject: [PATCH] Added list->vector and vector? --- cgen.scm | 6 ++++-- eval.scm | 2 ++ runtime.c | 14 ++++++++++++++ runtime.h | 16 ++++++++++++++++ trans.scm | 2 ++ 5 files changed, 38 insertions(+), 2 deletions(-) diff --git a/cgen.scm b/cgen.scm index c75fdc01..94b70ea1 100644 --- a/cgen.scm +++ b/cgen.scm @@ -435,6 +435,7 @@ ((eq? p 'list->string) "Cyc_list2string") ((eq? p 'string->list) "string2list") ((eq? p 'make-vector) "make_vector") + ((eq? p 'list->vector) "list_vector") ((eq? p 'string-append) "Cyc_string_append") ((eq? p 'string-cmp) "Cyc_string_cmp") ((eq? p 'string->symbol) "Cyc_string2symbol") @@ -461,6 +462,7 @@ ((eq? p 'integer?) "Cyc_is_integer") ((eq? p 'pair?) "Cyc_is_cons") ((eq? p 'procedure?) "Cyc_is_procedure") + ((eq? p 'vector?) "Cyc_is_vector") ((eq? p 'string?) "Cyc_is_string") ((eq? p 'eof-object?) "Cyc_is_eof_object") ((eq? p 'symbol?) "Cyc_is_symbol") @@ -502,7 +504,7 @@ current-input-port open-input-file char->integer system string->number string-append string-cmp list->string string->list - make-vector + make-vector list->vector symbol->string number->string + - * / apply cons length cell)))) @@ -514,7 +516,7 @@ ;; Does primitive allocate an object? (define (prim:allocates-object? exp) (and (prim? exp) - (member exp '(string->list make-vector)))) + (member exp '(string->list make-vector list->vector)))) ;; c-compile-prim : prim-exp -> string -> string (define (c-compile-prim p cont) diff --git a/eval.scm b/eval.scm index b6583d35..6c6ca757 100644 --- a/eval.scm +++ b/eval.scm @@ -266,6 +266,7 @@ (list 'symbol->string symbol->string) (list 'number->string number->string) (list 'make-vector make-vector) + (list 'list->vector list->vector) (list 'boolean? boolean?) (list 'char? char?) (list 'eof-object? eof-object?) @@ -275,6 +276,7 @@ (list 'integer? integer?) (list 'pair? pair?) (list 'procedure? procedure?) + (list 'vector? vector?) (list 'string? string?) (list 'symbol? symbol?) (list 'current-input-port current-input-port) diff --git a/runtime.c b/runtime.c index 3ad088e4..cd094215 100644 --- a/runtime.c +++ b/runtime.c @@ -517,6 +517,11 @@ object Cyc_is_symbol(object o){ return boolean_t; return boolean_f;} +object Cyc_is_vector(object o){ + if (!nullp(o) && !is_value_type(o) && ((list)o)->tag == vector_tag) + return boolean_t; + return boolean_f;} + object Cyc_is_string(object o){ if (!nullp(o) && !is_value_type(o) && ((list)o)->tag == string_tag) return boolean_t; @@ -1019,6 +1024,8 @@ void _pair_127(object cont, object args) { return_funcall1(cont, Cyc_is_cons(car(args))); } void _procedure_127(object cont, object args) { return_funcall1(cont, Cyc_is_procedure(car(args))); } +void _vector_127(object cont, object args) { + return_funcall1(cont, Cyc_is_vector(car(args))); } void _string_127(object cont, object args) { return_funcall1(cont, Cyc_is_string(car(args))); } void _symbol_127(object cont, object args) { @@ -1108,6 +1115,9 @@ void _make_91vector(object cont, object args) { else { make_vector(v, car(args), boolean_f); return_funcall1(cont, v);}} +void _list_91_125vector(object cont, object args) { + list2vector(l, car(args)); + return_funcall1(cont, l);} void _list_91_125string(object cont, object args) { string_type s = Cyc_list2string(car(args)); return_funcall1(cont, &s);} @@ -1793,6 +1803,7 @@ static primitive_type list_91_125string_primitive = {primitive_tag, "list->strin static primitive_type string_91_125symbol_primitive = {primitive_tag, "string->symbol", &_string_91_125symbol}; static primitive_type symbol_91_125string_primitive = {primitive_tag, "symbol->string", &_symbol_91_125string}; static primitive_type number_91_125string_primitive = {primitive_tag, "number->string", &_number_91_125string}; +static primitive_type list_91_125vector_primitive = {primitive_tag, "list-vector", &_list_91_125vector}; static primitive_type make_91vector_primitive = {primitive_tag, "make-vector", &_make_91vector}; static primitive_type boolean_127_primitive = {primitive_tag, "boolean?", &_boolean_127}; static primitive_type char_127_primitive = {primitive_tag, "char?", &_char_127}; @@ -1803,6 +1814,7 @@ static primitive_type real_127_primitive = {primitive_tag, "real?", &_real_127}; static primitive_type integer_127_primitive = {primitive_tag, "integer?", &_integer_127}; static primitive_type pair_127_primitive = {primitive_tag, "pair?", &_pair_127}; static primitive_type procedure_127_primitive = {primitive_tag, "procedure?", &_procedure_127}; +static primitive_type vector_127_primitive = {primitive_tag, "vector?", &_vector_127}; static primitive_type string_127_primitive = {primitive_tag, "string?", &_string_127}; static primitive_type symbol_127_primitive = {primitive_tag, "symbol?", &_symbol_127}; static primitive_type current_91input_91port_primitive = {primitive_tag, "current-input-port", &_current_91input_91port}; @@ -1892,6 +1904,7 @@ const object primitive_string_91_125symbol = &string_91_125symbol_primitive; const object primitive_symbol_91_125string = &symbol_91_125string_primitive; const object primitive_number_91_125string = &number_91_125string_primitive; const object primitive_make_91vector = &make_91vector_primitive; +const object primitive_list_91_125vector = &list_91_125vector_primitive; const object primitive_boolean_127 = &boolean_127_primitive; const object primitive_char_127 = &char_127_primitive; const object primitive_eof_91object_127 = &eof_91object_127_primitive; @@ -1902,6 +1915,7 @@ const object primitive_integer_127 = &integer_127_primitive; const object primitive_pair_127 = &pair_127_primitive; const object primitive_procedure_127 = &procedure_127_primitive; const object primitive_string_127 = &string_127_primitive; +const object primitive_vector_127 = &vector_127_primitive; const object primitive_symbol_127 = &symbol_127_primitive; const object primitive_current_91input_91port = ¤t_91input_91port_primitive; const object primitive_open_91input_91file = &open_91input_91file_primitive; diff --git a/runtime.h b/runtime.h index 0319fcec..df06cc93 100644 --- a/runtime.h +++ b/runtime.h @@ -162,6 +162,20 @@ void do_dispatch(int argc, function_type func, object clo, object *buffer); } \ } +#define list2vector(v, l) object v = nil; { \ + integer_type len = Cyc_length(l); \ + v = alloca(sizeof(vector_type)); \ + ((vector)v)->tag = vector_tag; \ + ((vector)v)->num_elt = len.value; \ + ((vector)v)->elts = (((vector)v)->num_elt > 0) ? (object *)alloca(sizeof(object) * ((vector)v)->num_elt) : NULL; \ + object lst = l; \ + int i = 0; \ + while(!nullp(lst)) { \ + ((vector)v)->elts[i++] = car(lst); \ + lst = cdr(lst); \ + } \ +} + #define make_vector(v, len, fill) object v = nil; { \ v = alloca(sizeof(vector_type)); \ ((vector)v)->tag = vector_tag; \ @@ -277,6 +291,7 @@ extern const object primitive_string_91_125symbol; extern const object primitive_symbol_91_125string; extern const object primitive_number_91_125string; extern const object primitive_make_91vector; +extern const object primitive_list_91_125vector; extern const object primitive_system; extern const object primitive_boolean_127; extern const object primitive_char_127; @@ -287,6 +302,7 @@ extern const object primitive_real_127; extern const object primitive_integer_127; extern const object primitive_pair_127; extern const object primitive_procedure_127; +extern const object primitive_vector_127; extern const object primitive_string_127; extern const object primitive_symbol_127; extern const object primitive_current_91input_91port; diff --git a/trans.scm b/trans.scm index cd3e26e4..0560a4d0 100644 --- a/trans.scm +++ b/trans.scm @@ -517,6 +517,7 @@ symbol->string number->string make-vector + list->vector boolean? char? eof-object? @@ -526,6 +527,7 @@ integer? pair? procedure? + vector? string? symbol? current-input-port