• R/O
  • HTTP
  • SSH
  • HTTPS

Commit

Tags
Keine Tags

Frequently used words (click to add to your profile)

javac++androidlinuxc#objective-cqtwindows誰得cocoapythonphprubygameguibathyscaphec翻訳omegat計画中(planning stage)frameworktwittertestdomvb.netdirectxbtronarduinopreviewerゲームエンジン

Baremetal Lisp interpreter and compiler for low-resource devices


Commit MetaInfo

Revision7e066dd0aa943dd48b88e8fd7db88ab543b4adb4 (tree)
Zeit2020-09-21 08:15:38
AutorAlaskanEmily <emily@alas...>
CommiterAlaskanEmily

Log Message

Add basic protocol parsing

Ändern Zusammenfassung

Diff

--- a/sl_i.c
+++ b/sl_i.c
@@ -26,6 +26,7 @@
2626
2727 #define SL_I_BIND_CAP_GROWTH 64
2828 #define SL_I_REC_CAP_GROWTH 32
29+#define SL_I_PROTO_CAP_GROWTH 32
2930 #define SL_I_DEF_CAP_INIT 16
3031 #define SL_I_DEF_CAP_DOUBLE_MAX 256
3132
@@ -236,7 +237,7 @@ type_hint_ok:
236237 SL_S_Free(old);
237238 }
238239 bind = rt->binds + i;
239- bind->args = SL_S_Malloc(sizeof(struct SL_I_FuncArg) * arity);
240+ bind->args = SL_S_Malloc(sizeof(struct SL_X_FuncArg) * arity);
240241 rt->num_binds++;
241242 }
242243 else{
@@ -256,7 +257,7 @@ type_hint_ok:
256257 /* Reuse the original args allocation, if possible. */
257258 if(bind->arity < arity || bind->args == SL_S_NIL){
258259 SL_S_Free(rt->binds[i].args);
259- bind->args = SL_S_Malloc(sizeof(struct SL_I_FuncArg) * arity);
260+ bind->args = SL_S_Malloc(sizeof(struct SL_X_FuncArg) * arity);
260261 if(SL_I_UNLIKELY(bind->args == SL_S_NIL)){
261262 rt->pending_error = "Out of memory";
262263 /* The only error recover we can do is to remove this bind, as
@@ -401,6 +402,173 @@ static void sl_i_defrec(struct SL_I_Runtime *rt,
401402
402403 /*****************************************************************************/
403404
405+static int sl_i_defproto_method(const struct SL_S_List *list,
406+ struct SL_X_ProtocolMethod *to){
407+
408+ struct SL_S_Atom *name, *hint, *tmp, **target;
409+ const struct SL_S_List *args;
410+ int tag;
411+ SL_S_PTR_TAG_DATA(list->head, name, tag);
412+ if(SL_I_UNLIKELY(tag != SL_S_ATOM_TAG))
413+ return -1;
414+ if((list = list->tail) == SL_S_NIL)
415+ return -1;
416+ if(name->len > 1 && name->text[0] == '^'){
417+ hint = name;
418+ SL_S_PTR_TAG_DATA(list->head, name, tag);
419+ if(SL_I_UNLIKELY(tag != SL_S_ATOM_TAG))
420+ return -1;
421+ if(SL_I_UNLIKELY((list = list->tail) == SL_S_NIL))
422+ return -1;
423+ }
424+ else{
425+ hint = SL_S_NIL;
426+ }
427+ if(!SL_I_LIKELY(SL_S_IS_LIST(list->head)))
428+ return -1;
429+ args = list = SL_S_PTR_FROM_TAG(list->head);
430+
431+ to->name = name;
432+ to->hint = hint;
433+
434+ /* Compute the arity. */
435+ name = SL_S_NIL;
436+ hint = SL_S_NIL;
437+ to->arity = 0;
438+ while(list != SL_S_NIL){
439+ SL_S_PTR_TAG_DATA(list->head, tmp, tag);
440+ if(SL_I_UNLIKELY(tag != SL_S_ATOM_TAG))
441+ return -1;
442+
443+ if(tmp->len > 1 && tmp->text[0] == '^')
444+ target = &hint;
445+ else
446+ target = &name;
447+ if(!SL_S_IS_NIL(*target)){
448+ to->arity++;
449+ name = SL_S_NIL;
450+ hint = SL_S_NIL;
451+ }
452+ *target = tmp;
453+ list = list->tail;
454+ }
455+ if(!SL_S_IS_NIL(name) || !SL_S_IS_NIL(hint))
456+ to->arity++;
457+
458+ /* Validated, allocate and then fill. */
459+ if(to->arity == 0){
460+ to->args = SL_S_NIL;
461+ goto finished_args;
462+ }
463+
464+ to->args = SL_S_Malloc(to->arity * sizeof(struct SL_X_FuncArg));
465+ if(SL_I_UNLIKELY(to->args == SL_S_NIL))
466+ return -1;
467+
468+ /* Fill the args. */
469+ name = SL_S_NIL;
470+ hint = SL_S_NIL;
471+ to->arity = 0;
472+ list = args;
473+ while(list != SL_S_NIL){
474+ tmp = SL_S_PTR_FROM_TAG(list->head);
475+
476+ if(tmp->len > 1 && tmp->text[0] == '^')
477+ target = &hint;
478+ else
479+ target = &name;
480+
481+ if(!SL_S_IS_NIL(*target)){
482+ to->args[to->arity].hint = hint;
483+ to->args[to->arity].name = name;
484+ to->arity++;
485+ name = SL_S_NIL;
486+ hint = SL_S_NIL;
487+ }
488+ SL_S_INCREF(*target);
489+ *target = tmp;
490+ list = list->tail;
491+ }
492+ if(!SL_S_IS_NIL(name) || !SL_S_IS_NIL(hint)){
493+ to->args[to->arity].hint = hint;
494+ to->args[to->arity].name = name;
495+ to->arity++;
496+ }
497+finished_args:
498+ SL_S_INCREF(to->name);
499+ SL_S_INCREF(to->hint);
500+ return 0;
501+}
502+
503+static void sl_i_defproto(struct SL_I_Runtime *rt,
504+ const struct SL_S_Atom *name,
505+ const struct SL_S_List *methods){
506+
507+ struct SL_X_ProtocolMethod *method_array;
508+ void *old;
509+ sl_s_len_t num_methods, i, e;
510+
511+ num_methods = SL_S_Length(methods);
512+ method_array =
513+ SL_S_Malloc(num_methods * sizeof(struct SL_X_ProtocolMethod));
514+ if(SL_I_UNLIKELY(SL_S_IS_NIL(methods))){
515+ rt->pending_error = "Out of memory";
516+ return;
517+ }
518+ i = 0;
519+
520+ if(rt->num_protocols == rt->cap_protocols){
521+ old = rt->protocols;
522+ rt->cap_protocols += SL_I_PROTO_CAP_GROWTH;
523+ rt->protocols =
524+ SL_S_Malloc(rt->cap_protocols * sizeof(struct SL_X_ProtocolType));
525+ if(SL_I_UNLIKELY(rt->protocols == SL_S_NIL)){
526+ rt->protocols = old;
527+ rt->pending_error = "Out of memory";
528+ SL_S_Free(method_array);
529+ return;
530+ }
531+ SL_S_MemCopy(rt->protocols,
532+ old,
533+ sizeof(struct SL_X_ProtocolType) * rt->num_protocols);
534+ }
535+
536+ while(!SL_S_IS_NIL(methods)){
537+ if(SL_I_UNLIKELY(!SL_S_IS_LIST(methods->head)) ||
538+ SL_I_UNLIKELY(
539+ sl_i_defproto_method(
540+ SL_S_PTR_FROM_TAG(methods->head),
541+ method_array + i) != 0)){
542+
543+ goto fail_in_methods;
544+ methods = methods->tail;
545+ }
546+ i++;
547+ methods = methods->tail;
548+ }
549+
550+ SL_S_INCREF(name);
551+ rt->protocols[rt->num_protocols].name = name;
552+ rt->protocols[rt->num_protocols].methods = method_array;
553+ rt->protocols[rt->num_protocols].num_methods = num_methods;
554+ rt->num_protocols++;
555+ return;
556+
557+fail_in_methods:
558+ while(i--){
559+ for(e = 0; e < method_array[i].arity; e++){
560+ SL_S_DECREF(method_array[i].args[e].hint);
561+ SL_S_DECREF(method_array[i].args[e].name);
562+ }
563+ SL_S_Free(method_array[i].args);
564+ }
565+ SL_S_Free(method_array);
566+ rt->pending_error = "Invalid protocol method declaration";
567+ return;
568+}
569+
570+/*****************************************************************************/
571+
404572 SL_S_FUNC(int) SL_I_Run(struct SL_I_Runtime *rt, const struct SL_S_List *code){
405573
406574 const struct SL_S_Atom *name, *hint;
@@ -410,7 +578,7 @@ SL_S_FUNC(int) SL_I_Run(struct SL_I_Runtime *rt, const struct SL_S_List *code){
410578 if(SL_S_IS_LIST(code->head)){
411579 data = SL_S_PTR_FROM_TAG(code->head);
412580 if(SL_X_IsDefun(data) == 0){
413- if(SL_I_UNLIKELY(
581+ if(SL_I_LIKELY(
414582 SL_X_ParseDefun(data, &name, &args, &body) == 0)){
415583
416584 data = SL_X_ParseArgs(args);
@@ -426,20 +594,30 @@ SL_S_FUNC(int) SL_I_Run(struct SL_I_Runtime *rt, const struct SL_S_List *code){
426594 }
427595 }
428596 else if(SL_X_IsDef(data) == 0){
429- if(SL_X_ParseDef(data, &hint, &name, &value) != 0){
597+ if(SL_I_UNLIKELY(
598+ SL_X_ParseDef(data, &hint, &name, &value) != 0)){
599+
430600 rt->pending_error = "Error in def";
431601 return 1;
432602 }
433603 sl_i_def(rt, hint, name, value);
434604 }
435605 else if(SL_X_IsDefrec(data) == 0){
436- if(SL_X_ParseDefrec(data, &name, &body) != 0){
606+ if(SL_I_UNLIKELY(SL_X_ParseDefrec(data, &name, &body) != 0)){
437607 rt->pending_error = "Error in defrec";
438608 return 1;
439609 }
440610 SL_S_INCREF(name);
441611 sl_i_defrec(rt, name, body);
442612 }
613+ else if(SL_X_IsDefproto(data) == 0){
614+ if(SL_I_UNLIKELY(SL_X_ParseDefproto(data, &name, &body) != 0)){
615+ rt->pending_error = "Error in defproto";
616+ return 1;
617+ }
618+ SL_S_INCREF(name);
619+ sl_i_defproto(rt, name, body);
620+ }
443621 else{
444622 SL_I_Execute(rt, code->head);
445623 }
--- a/sl_i.h
+++ b/sl_i.h
@@ -32,8 +32,6 @@ extern "C"{
3232 /*****************************************************************************/
3333
3434 struct SL_I_Runtime;
35-struct SL_X_FuncArg;
36-struct SL_X_FileOps;
3735
3836 /*****************************************************************************/
3937
@@ -41,13 +39,6 @@ struct SL_X_FileOps;
4139
4240 /*****************************************************************************/
4341
44-struct SL_I_FuncArg{
45- const struct SL_S_Atom *hint;
46- const struct SL_S_Atom *name;
47-};
48-
49-/*****************************************************************************/
50-
5142 struct SL_I_Bind{
5243 const struct SL_S_Atom *name;
5344 union {
@@ -57,7 +48,7 @@ struct SL_I_Bind{
5748 const struct SL_S_List *lisp;
5849 } bind;
5950 sl_s_len_t arity;
60- struct SL_I_FuncArg *args; /* Unused (for now) on native binds. */
51+ struct SL_X_FuncArg *args; /* Unused (for now) on native binds. */
6152 unsigned char is_native;
6253 };
6354
@@ -70,7 +61,6 @@ struct SL_I_Frame{
7061 struct SL_I_Frame *next;
7162 };
7263
73-
7464 /*****************************************************************************/
7565
7666 struct SL_I_Runtime{
@@ -82,6 +72,9 @@ struct SL_I_Runtime{
8272 struct SL_X_Record *recs;
8373 sl_s_len_t num_recs;
8474 sl_s_len_t cap_recs;
75+ struct SL_X_ProtocolType *protocols;
76+ sl_s_len_t num_protocols;
77+ sl_s_len_t cap_protocols;
8578 struct SL_I_Frame global, *frames;
8679 const char *pending_error;
8780 void *error_free_ptr;
--- a/sl_x.c
+++ b/sl_x.c
@@ -67,6 +67,7 @@ SL_X_INTEGRAL_TYPES(SL_X_PTR_HINT_END)
6767 SL_X_ATOM(sl_x_defun, "defun");
6868 SL_X_ATOM(sl_x_def, "def");
6969 SL_X_ATOM(sl_x_defrec, "defrec");
70+SL_X_ATOM(sl_x_defproto,"defproto");
7071 SL_X_ATOM(sl_x_if, "if");
7172 SL_X_ATOM(sl_x_let, "let");
7273 SL_X_ATOM(sl_x_plus, "+");
@@ -416,6 +417,21 @@ SL_S_PURE_FUNC(int) SL_X_IsDefrec(const struct SL_S_List *code){
416417
417418 /*****************************************************************************/
418419
420+SL_S_PURE_FUNC(int) SL_X_IsDefproto(const struct SL_S_List *code){
421+ if(!SL_S_IS_NIL(code) &&
422+ SL_S_IS_ATOM(code->head) &&
423+ !SL_S_IS_NIL(code->tail) &&
424+ SL_S_IS_ATOM(code->tail->head) &&
425+ SL_S_COMPARE_ATOMS(&sl_x_defproto,
426+ (struct SL_S_Atom*)SL_S_PTR_FROM_TAG(code->head))){
427+
428+ return 0;
429+ }
430+ return -1;
431+}
432+
433+/*****************************************************************************/
434+
419435 SL_S_FUNC(int) SL_X_ParseDefun(const struct SL_S_List *code,
420436 const struct SL_S_Atom **out_name,
421437 const struct SL_S_List **out_args,
@@ -540,6 +556,24 @@ SL_S_FUNC(int) SL_X_ParseDefrec(const struct SL_S_List *code,
540556 }
541557
542558 /*****************************************************************************/
559+/* Returns 0 on success.
560+ * This DOES incref the methods, unlike most other parsers.
561+ * This does no incref the name.
562+ */
563+SL_S_FUNC(int) SL_X_ParseDefproto(const struct SL_S_List *code,
564+ const struct SL_S_Atom **out_name,
565+ const struct SL_S_List **out_methods){
566+
567+ if(SL_X_IsDefproto(code) != 0)
568+ return -1;
569+
570+ *out_name = SL_S_PTR_FROM_TAG(code->tail->head);
571+ *out_methods = SL_S_PTR_FROM_TAG(code->tail->tail);
572+ return 0;
573+
574+}
575+
576+/*****************************************************************************/
543577
544578 static struct SL_S_List *sl_x_create_args(const struct SL_S_Atom *hint,
545579 const struct SL_S_Atom *name){
--- a/sl_x.h
+++ b/sl_x.h
@@ -73,6 +73,7 @@ const extern struct SL_S_Atom
7373 sl_x_defun,
7474 sl_x_def,
7575 sl_x_defrec,
76+ sl_x_defproto,
7677 sl_x_if,
7778 sl_x_let,
7879 sl_x_comment, sl_x_dot, sl_x_tick,
@@ -117,6 +118,30 @@ struct SL_X_Record{
117118
118119 /*****************************************************************************/
119120
121+struct SL_X_FuncArg{
122+ const struct SL_S_Atom *hint;
123+ const struct SL_S_Atom *name;
124+};
125+
126+/*****************************************************************************/
127+
128+struct SL_X_ProtocolMethod{
129+ struct SL_S_Atom *name;
130+ struct SL_S_Atom *hint;
131+ struct SL_X_FuncArg *args;
132+ sl_s_len_t arity;
133+};
134+
135+/*****************************************************************************/
136+
137+struct SL_X_ProtocolType{
138+ const struct SL_S_Atom *name;
139+ struct SL_X_ProtocolMethod *methods;
140+ sl_s_len_t num_methods;
141+};
142+
143+/*****************************************************************************/
144+
120145 SL_S_PURE_FUNC(int) SL_X_IsRuntimeConstant(const void *value);
121146
122147 /*****************************************************************************/
@@ -145,6 +170,10 @@ SL_S_PURE_FUNC(int) SL_X_IsDefrec(const struct SL_S_List *code);
145170
146171 /*****************************************************************************/
147172 /* Returns 0 on success. */
173+SL_S_PURE_FUNC(int) SL_X_IsDefproto(const struct SL_S_List *code);
174+
175+/*****************************************************************************/
176+/* Returns 0 on success. */
148177 SL_S_PURE_FUNC(int) SL_X_IsImport(const struct SL_S_List *code);
149178
150179 /*****************************************************************************/
@@ -167,7 +196,7 @@ SL_S_FUNC(int) SL_X_ParseDef(const struct SL_S_List *code,
167196
168197 /*****************************************************************************/
169198 /* Returns 0 on success.
170- * This DOES incref the fields, unlike the other parsers.
199+ * This DOES incref the fields, unlike most other parsers.
171200 * This does no incref the name.
172201 */
173202 SL_S_FUNC(int) SL_X_ParseDefrec(const struct SL_S_List *code,
@@ -175,6 +204,12 @@ SL_S_FUNC(int) SL_X_ParseDefrec(const struct SL_S_List *code,
175204 const struct SL_S_List **out_fields);
176205
177206 /*****************************************************************************/
207+/* Returns 0 on success. */
208+SL_S_FUNC(int) SL_X_ParseDefproto(const struct SL_S_List *code,
209+ const struct SL_S_Atom **out_name,
210+ const struct SL_S_List **out_methods);
211+
212+/*****************************************************************************/
178213 /* Returns 0 on success.
179214 * The args is a list of lists, of the structure ((hint name) (hint name) ...)
180215 */
--- /dev/null
+++ b/tests/proto1.lsp
@@ -0,0 +1,7 @@
1+; Any copyright is dedicated to the Public Domain.
2+; https://creativecommons.org/publicdomain/zero/1.0/
3+
4+(defproto foo
5+ (bar (a b c))
6+ (baz ()))
7+