commit a7031fb36626cda9e2fa0e9f9c199d549792b1e8
parent 4b95c140de6d6ac0803c29ae3d086cee0d54334a
Author: Andres Navarro <canavarro82@gmail.com>
Date: Tue, 22 Mar 2011 23:47:49 -0300
Added make-string to the ground environment.
Diffstat:
7 files changed, 232 insertions(+), 26 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -14,7 +14,8 @@ CORE_O= kobject.o ktoken.o kpair.o kstring.o ksymbol.o kread.o \
kground.o kghelpers.o kgbooleans.o kgeqp.o kgequalp.o \
kgsymbols.o kgcontrol.o kgpairs_lists.o kgpair_mut.o kgenvironments.o \
kgenv_mut.o kgcombiners.o kgcontinuations.o kgencapsulations.o \
- kgpromises.o kgkd_vars.o kgks_vars.o kgports.o kgchars.o kgnumbers.o
+ kgpromises.o kgkd_vars.o kgks_vars.o kgports.o kgchars.o kgnumbers.o \
+ kgstrings.o
KRN_T= klisp
KRN_O= klisp.o
@@ -80,7 +81,7 @@ kground.o: kground.c kground.h kstate.h kobject.h klisp.h kenvironment.h \
kgbooleans.h kgeqp.h kgequalp.h kgsymbols.h kgpairs_lists.h \
kgpair_mut.h kgenvironments.h kgenv_mut.h kgcombiners.h \
kgcontinuations.h kgencapsulations.h kgpromises.h kgkd_vars.h \
- kgks_vars.h kgports.h kgchars.h kgnumbers.h
+ kgks_vars.h kgports.h kgchars.h kgnumbers.h kgstrings.o
kghelpers.o: kghelpers.c kghelpers.h kstate.h kstate.h klisp.h kpair.h \
kapplicative.h koperative.h kerror.h kobject.h ksymbol.h
kgbooleans.o: kgbooleans.c kgbooleans.c kghelpers.h kstate.h klisp.h \
@@ -130,3 +131,6 @@ kgchars.o: kgchars.c kgchars.h kghelpers.h kstate.h klisp.h \
kgnumbers.o: kgnumbers.c kgnumbers.h kghelpers.h kstate.h klisp.h \
kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h \
ksymbol.h
+kgstrings.o: kgstrings.c kgstrings.h kghelpers.h kstate.h klisp.h \
+ kobject.h kerror.h kapplicative.h koperative.h kcontinuation.h \
+ ksymbol.h
diff --git a/src/kghelpers.h b/src/kghelpers.h
@@ -177,7 +177,8 @@ inline bool get_opt_tpar(klisp_State *K, char *name, int32_t type, TValue *par)
return true;
}
} else {
- klispE_throw(K, "apply: Bad ptree structure (in optional argument)");
+ klispE_throw_extra(K, name, ": Bad ptree structure (in optional "
+ "argument)");
/* avoid warning */
return false;
}
diff --git a/src/kground.c b/src/kground.c
@@ -35,9 +35,10 @@
#include "kgpromises.h"
#include "kgkd_vars.h"
#include "kgks_vars.h"
-#include "kgports.h"
-#include "kgchars.h"
#include "kgnumbers.h"
+#include "kgstrings.h"
+#include "kgchars.h"
+#include "kgports.h"
/*
** BEWARE: this is highly unhygienic, it assumes variables "symbol" and
@@ -577,63 +578,64 @@ void kinit_ground_env(klisp_State *K)
** 13.1 Primitive features
*/
- /* 13.1.? string? */
+ /* 13.1.1? string? */
add_applicative(K, ground_env, "string?", typep, 2, symbol,
i2tv(K_TSTRING));
- /* 13.1.? make-string */
- /* TODO */
+ /* 13.1.2? make-string */
+ add_applicative(K, ground_env, "make-string", kgmake_string, 2, symbol,
+ i2tv(K_TSTRING));
- /* 13.1.? string-length */
+ /* 13.1.3? string-length */
/* TODO */
- /* 13.1.? string-ref */
+ /* 13.1.4? string-ref */
/* TODO */
- /* 13.1.? string-set! */
+ /* 13.1.5? string-set! */
/* TODO */
/*
** 13.2 Library features
*/
- /* 13.2.? string */
+ /* 13.2.1? string */
/* TODO */
- /* 13.2.? string=?, string-ci=? */
+ /* 13.2.2? string=?, string-ci=? */
/* TODO */
- /* 13.2.? string<?, string<=?, string>?, string>=? */
+ /* 13.2.3? string<?, string<=?, string>?, string>=? */
/* TODO */
- /* 13.2.? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */
+ /* 13.2.4? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */
/* TODO */
- /* 13.2.? substring */
+ /* 13.2.5? substring */
/* TODO */
- /* 13.2.? string-append */
+ /* 13.2.6? string-append */
/* TODO */
- /* 13.2.? string->list, list->string */
+ /* 13.2.7? string->list, list->string */
/* TODO */
- /* 13.2.? string-copy */
+ /* 13.2.8? string-copy */
/* TODO */
- /* 13.2.? string-fill! */
+ /* 13.2.9? string-fill! */
/* TODO */
/*
** 13.3 Symbol Features (this are from section symbol in r5rs)
*/
- /* 13.3.? symbol->string */
+ /* 13.3.1? symbol->string */
/* TEMP: for now all strings are mutable, this returns a new object
each time */
/* TODO */
- /* 13.3.? symbol->string */
+ /* 13.3.2? symbol->string */
/* TEMP: for now this can create symbols with no external representation
this includes all symbols with non identifiers characters.
*/
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -0,0 +1,101 @@
+/*
+** kgstrings.c
+** Strings features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+#include <ctype.h>
+
+#include "kstate.h"
+#include "kobject.h"
+#include "kapplicative.h"
+#include "koperative.h"
+#include "kcontinuation.h"
+#include "kerror.h"
+#include "ksymbol.h"
+#include "kstring.h"
+
+#include "kghelpers.h"
+#include "kgstrings.h"
+
+/* 13.1.1? string? */
+/* uses typep */
+
+/* 13.1.2? make-string */
+void kgmake_string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+ UNUSED(xparams);
+ UNUSED(denv);
+ bind_al1tp(K, "make-string", ptree, "finite number", ttisfixint, tv_s,
+ maybe_char);
+
+ char fill = ' ';
+ if (get_opt_tpar(K, "make-string", K_TCHAR, &maybe_char))
+ fill = chvalue(maybe_char);
+
+ if (ivalue(tv_s) < 0) {
+ klispE_throw(K, "make-string: negative size");
+ return;
+ }
+
+ TValue new_str = kstring_new_sc(K, ivalue(tv_s), fill);
+ kapply_cc(K, new_str);
+}
+
+/* 13.1.3? string-length */
+/* TODO */
+
+/* 13.1.4? string-ref */
+/* TODO */
+
+/* 13.1.5? string-set! */
+/* TODO */
+
+/* 13.2.1? string */
+/* TODO */
+
+/* 13.2.2? string=?, string-ci=? */
+/* TODO */
+
+/* 13.2.3? string<?, string<=?, string>?, string>=? */
+/* TODO */
+
+/* 13.2.4? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */
+/* TODO */
+
+/* 13.2.5? substring */
+/* TODO */
+
+/* 13.2.6? string-append */
+/* TODO */
+
+/* 13.2.7? string->list, list->string */
+/* TODO */
+
+/* 13.2.8? string-copy */
+/* TODO */
+
+/* 13.2.9? string-fill! */
+/* TODO */
+
+/* 13.3.1? symbol->string */
+/* TEMP: for now all strings are mutable, this returns a new object
+ each time */
+/* TODO */
+
+/* 13.3.2? symbol->string */
+/* TEMP: for now this can create symbols with no external representation
+ this includes all symbols with non identifiers characters.
+*/
+/* NOTE:
+ Symbols with uppercase alphabetic characters will write as lowercase and
+ so, when read again will not compare as either eq? or equal?. This is ok
+ because the report only says that read objects when written and read
+ again must be equal? which happens here
+*/
+/* TODO */
diff --git a/src/kgstrings.h b/src/kgstrings.h
@@ -0,0 +1,80 @@
+/*
+** kgstrings.h
+** Strings features for the ground environment
+** See Copyright Notice in klisp.h
+*/
+
+#ifndef kgstrings_h
+#define kgstrings_h
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+#include <stdint.h>
+
+#include "kobject.h"
+#include "klisp.h"
+#include "kstate.h"
+#include "kghelpers.h"
+
+/* 13.1.1? string? */
+/* uses typep */
+
+/* 13.1.2? make-string */
+void kgmake_string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
+
+/* 13.1.3? string-length */
+/* TODO */
+
+/* 13.1.4? string-ref */
+/* TODO */
+
+/* 13.1.5? string-set! */
+/* TODO */
+
+/* 13.2.1? string */
+/* TODO */
+
+/* 13.2.2? string=?, string-ci=? */
+/* TODO */
+
+/* 13.2.3? string<?, string<=?, string>?, string>=? */
+/* TODO */
+
+/* 13.2.4? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */
+/* TODO */
+
+/* 13.2.5? substring */
+/* TODO */
+
+/* 13.2.6? string-append */
+/* TODO */
+
+/* 13.2.7? string->list, list->string */
+/* TODO */
+
+/* 13.2.8? string-copy */
+/* TODO */
+
+/* 13.2.9? string-fill! */
+/* TODO */
+
+/* 13.3.1? symbol->string */
+/* TEMP: for now all strings are mutable, this returns a new object
+ each time */
+/* TODO */
+
+/* 13.3.2? symbol->string */
+/* TEMP: for now this can create symbols with no external representation
+ this includes all symbols with non identifiers characters.
+*/
+/* NOTE:
+ Symbols with uppercase alphabetic characters will write as lowercase and
+ so, when read again will not compare as either eq? or equal?. This is ok
+ because the report only says that read objects when written and read
+ again must be equal? which happens here
+*/
+/* TODO */
+
+#endif
diff --git a/src/kstring.c b/src/kstring.c
@@ -35,7 +35,7 @@ TValue kstring_new_empty(klisp_State *K)
}
/* TEMP: for now all strings are mutable */
-TValue kstring_new(klisp_State *K, const char *buf, uint32_t size)
+TValue kstring_new_g(klisp_State *K, uint32_t size)
{
String *new_str;
@@ -55,14 +55,30 @@ TValue kstring_new(klisp_State *K, const char *buf, uint32_t size)
/* string specific fields */
new_str->mark = KFALSE;
new_str->size = size;
- /* NOTE: there can be embedded '\0's in a string */
- memcpy(new_str->b, buf, size);
- /* NOTE: they still end with a '\0' for convenience in printing */
+
+ /* the buffer is initialized elsewhere */
+
+ /* NOTE: all string end with a '\0' for convenience in printing
+ even if they have embedded '\0's */
new_str->b[size] = '\0';
return gc2str(new_str);
}
+TValue kstring_new(klisp_State *K, const char *buf, uint32_t size)
+{
+ TValue new_str = kstring_new_g(K, size);
+ memcpy(kstring_buf(new_str), buf, size);
+ return new_str;
+}
+
+TValue kstring_new_sc(klisp_State *K, uint32_t size, char fill)
+{
+ TValue new_str = kstring_new_g(K, size);
+ memset(kstring_buf(new_str), fill, size);
+ return new_str;
+}
+
/* both obj1 and obj2 should be strings! */
bool kstring_equalp(TValue obj1, TValue obj2)
{
diff --git a/src/kstring.h b/src/kstring.h
@@ -16,6 +16,8 @@
TValue kstring_new_empty(klisp_State *K);
TValue kstring_new(klisp_State *K, const char *buf, uint32_t size);
+TValue kstring_new_sc(klisp_State *K, uint32_t size, char fill);
+
#define kstring_buf(tv_) (((String *) ((tv_).tv.v.gc))->b)
#define kstring_size(tv_) (((String *) ((tv_).tv.v.gc))->size)
