diff --git a/cgen.scm b/cgen.scm index 77ee43b6..f6748e06 100644 --- a/cgen.scm +++ b/cgen.scm @@ -449,6 +449,7 @@ ((eq? p 'memv) "memqp") ((eq? p 'member) "memberp") ((eq? p 'length) "Cyc_length") + ((eq? p 'vector-length) "Cyc_vector_length") ((eq? p 'set-car!) "Cyc_set_car") ((eq? p 'set-cdr!) "Cyc_set_cdr") ((eq? p 'eq?) "Cyc_eq") @@ -481,6 +482,7 @@ ((eq? p 'current-input-port) "port_type") ((eq? p 'open-input-file) "port_type") ((eq? p 'length) "integer_type") + ((eq? p 'vector-length) "integer_type") ((eq? p 'char->integer) "integer_type") ((eq? p 'system) "integer_type") ((eq? p '+) "common_type") @@ -506,7 +508,7 @@ string-append string-cmp list->string string->list make-vector list->vector symbol->string number->string - + - * / apply cons length cell)))) + + - * / apply cons length vector-length cell)))) ;; Pass an integer arg count as the function's first parameter? (define (prim:arg-count? exp) diff --git a/eval.scm b/eval.scm index 6c6ca757..bfb46655 100644 --- a/eval.scm +++ b/eval.scm @@ -223,6 +223,7 @@ (list 'memv memv) (list 'member member) (list 'length length) + (list 'vector-length vector-length) (list 'set-car! set-car!) (list 'set-cdr! set-cdr!) (list 'car car) diff --git a/runtime.c b/runtime.c index cd094215..ad8d2558 100644 --- a/runtime.c +++ b/runtime.c @@ -577,12 +577,18 @@ object Cyc_set_cdr(object l, object val) { return l; } +integer_type Cyc_vector_length(object v) { + if (!nullp(v) && !is_value_type(v) && ((list)v)->tag == vector_tag) { + make_int(len, ((vector)v)->num_elt); + return len; + } + Cyc_rt_raise_msg("vector-length - invalid parameter, expected vector\n"); } + integer_type Cyc_length(object l){ make_int(len, 0); while(!nullp(l)){ if (((list)l)->tag != cons_tag){ - printf("length - invalid parameter, expected list\n"); - exit(1); + Cyc_rt_raise_msg("length - invalid parameter, expected list\n"); } l = cdr(l); len.value++; @@ -986,6 +992,9 @@ void _equal_127(object cont, object args){ void _length(object cont, object args){ integer_type i = Cyc_length(car(args)); return_funcall1(cont, &i); } +void _vector_91length(object cont, object args){ + integer_type i = Cyc_vector_length(car(args)); + return_funcall1(cont, &i); } void _null_127(object cont, object args) { return_funcall1(cont, Cyc_is_null(car(args))); } void _set_91car_67(object cont, object args) { @@ -1760,6 +1769,7 @@ static primitive_type member_primitive = {primitive_tag, "member", &_member}; static primitive_type memq_primitive = {primitive_tag, "memq", &_memq}; static primitive_type memv_primitive = {primitive_tag, "memv", &_memv}; static primitive_type length_primitive = {primitive_tag, "length", &_length}; +static primitive_type vector_91length_primitive = {primitive_tag, "vector-length", &_vector_91length}; static primitive_type set_91car_67_primitive = {primitive_tag, "set-car!", &_set_91car_67}; static primitive_type set_91cdr_67_primitive = {primitive_tag, "set-cdr!", &_set_91cdr_67}; static primitive_type car_primitive = {primitive_tag, "car", &_car}; @@ -1860,6 +1870,7 @@ const object primitive_member = &member_primitive; const object primitive_memq = &memq_primitive; const object primitive_memv = &memv_primitive; const object primitive_length = &length_primitive; +const object primitive_vector_91length = &vector_91length_primitive; const object primitive_set_91car_67 = &set_91car_67_primitive; const object primitive_set_91cdr_67 = &set_91cdr_67_primitive; const object primitive_car = &car_primitive; diff --git a/runtime.h b/runtime.h index df06cc93..229adbec 100644 --- a/runtime.h +++ b/runtime.h @@ -82,6 +82,7 @@ object Cyc_eq(object x, object y); object Cyc_set_car(object l, object val) ; object Cyc_set_cdr(object l, object val) ; integer_type Cyc_length(object l); +integer_type Cyc_vector_length(object v); string_type Cyc_number2string(object n) ; string_type Cyc_symbol2string(object sym) ; object Cyc_string2symbol(object str); @@ -108,6 +109,7 @@ object Cyc_is_null(object o); object Cyc_is_number(object o); object Cyc_is_real(object o); object Cyc_is_integer(object o); +object Cyc_is_vector(object o); object Cyc_is_symbol(object o); object Cyc_is_string(object o); object Cyc_is_char(object o); @@ -248,6 +250,7 @@ extern const object primitive_member; extern const object primitive_memq; extern const object primitive_memv; extern const object primitive_length; +extern const object primitive_vector_91length; extern const object primitive_set_91car_67; extern const object primitive_set_91cdr_67; extern const object primitive_car; diff --git a/trans.scm b/trans.scm index 0560a4d0..5e6b4fb4 100644 --- a/trans.scm +++ b/trans.scm @@ -498,6 +498,7 @@ memv member length + vector-length set-car! set-cdr! car