• 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

Revisionc57088232b60ef6f3c8c88a9d246d2987e01cd35 (tree)
Zeit2020-09-21 09:51:46
AutorAlaskanEmily <emily@alas...>
CommiterAlaskanEmily

Log Message

Add some very basic typechecking for SL_I_Execute

Ändern Zusammenfassung

Diff

--- a/sl_i.c
+++ b/sl_i.c
@@ -508,6 +508,13 @@ static void sl_i_defproto(struct SL_I_Runtime *rt,
508508 void *old;
509509 sl_s_len_t num_methods, i, e;
510510
511+ /* Do not allow re-defining protocols. */
512+ for(i = 0; i < rt->num_protocols; i++){
513+ if(SL_S_COMPARE_ATOMS(rt->protocols[i].name, name)){
514+ rt->pending_error = "Duplicate name for defproto";
515+ return;
516+ }
517+ }
511518 num_methods = SL_S_Length(methods);
512519 method_array =
513520 SL_S_Malloc(num_methods * sizeof(struct SL_X_ProtocolMethod));
@@ -619,7 +626,7 @@ SL_S_FUNC(int) SL_I_Run(struct SL_I_Runtime *rt, const struct SL_S_List *code){
619626 sl_i_defproto(rt, name, body);
620627 }
621628 else{
622- SL_I_Execute(rt, code->head);
629+ SL_I_Execute(rt, code->head, SL_S_NIL);
623630 }
624631 }
625632 if(rt->pending_error)
@@ -636,12 +643,15 @@ static const unsigned char sl_i_if_flags[SL_I_IF_ARITY] = {
636643 SL_S_OUT_ANY,
637644 SL_S_OUT_ANY
638645 };
639-static void *sl_i_if(struct SL_I_Runtime *rt, const struct SL_S_List *in){
646+static void *sl_i_if(struct SL_I_Runtime *rt,
647+ const struct SL_S_List *in,
648+ const struct SL_S_Atom **opt_out_hint){
649+
640650 const void *values[SL_I_IF_ARITY], *result;
641651 struct SL_S_List rebuild;
642652 register int i;
643653
644- rebuild.head = SL_I_Execute(rt, in->head);
654+ rebuild.head = SL_I_Execute(rt, in->head, SL_S_NIL);
645655 if(rt->pending_error)
646656 return SL_S_NIL;
647657
@@ -668,8 +678,8 @@ static void *sl_i_if(struct SL_I_Runtime *rt, const struct SL_S_List *in){
668678 rt->pending_error = "First arg to if must be true or false.";
669679 return SL_S_NIL;
670680 }
671-
672- result = SL_I_Execute(rt, (void*)result);
681+ /* TODO: We should check the type hint of the un-evaluated side, too. */
682+ result = SL_I_Execute(rt, (void*)result, opt_out_hint);
673683 SL_S_INCREF(result);
674684 return (void*)result;
675685 }
@@ -707,7 +717,7 @@ SL_S_FUNC(void) *sl_i_to_int(const void *value, void *arg){
707717 return (void*)value;
708718 }
709719
710- value = SL_I_Execute(data->rt, (void*)value);
720+ value = SL_I_Execute(data->rt, (void*)value, SL_S_NIL);
711721
712722 if(SL_S_IS_ATOM(value) &&
713723 SL_X_IsInt(SL_S_PTR_FROM_TAG(value)) == 0){
@@ -810,10 +820,10 @@ static const void * sl_i_ ## NAME (struct SL_I_Runtime *rt, \
810820 rt->pending_error = "Wrong number of args in " #SYMBOL; \
811821 return SL_S_NIL; \
812822 } \
813- a = SL_I_Execute(rt, in->head); \
823+ a = SL_I_Execute(rt, in->head, SL_S_NIL); \
814824 if(rt->pending_error) \
815825 return SL_S_NIL; \
816- b = SL_I_Execute(rt, in->tail->head); \
826+ b = SL_I_Execute(rt, in->tail->head, SL_S_NIL); \
817827 if(rt->pending_error){ \
818828 SL_S_DECREF(a); \
819829 return SL_S_NIL; \
@@ -849,11 +859,11 @@ static void *sl_i_compare(struct SL_I_Runtime *rt,
849859
850860 const void *exe_a, *exe_b;
851861 int i;
852-
853- exe_a = SL_I_Execute(rt, a);
862+
863+ exe_a = SL_I_Execute(rt, a, SL_S_NIL);
854864 if(rt->pending_error)
855865 return SL_S_NIL;
856- exe_b = SL_I_Execute(rt, b);
866+ exe_b = SL_I_Execute(rt, b, SL_S_NIL);
857867 if(rt->pending_error){
858868 SL_S_DECREF(exe_a);
859869 return SL_S_NIL;
@@ -867,24 +877,37 @@ static void *sl_i_compare(struct SL_I_Runtime *rt,
867877
868878 /*****************************************************************************/
869879
870-SL_S_FUNC(void) *SL_I_Execute(struct SL_I_Runtime *rt, const void *value){
880+SL_S_FUNC(void) *SL_I_Execute(struct SL_I_Runtime *rt,
881+ const void *value,
882+ const struct SL_S_Atom **opt_out_hint){
883+
871884 struct SL_S_Atom *atom;
872885 struct SL_S_List *list, *ret_list;
873886 struct SL_X_MeasureResult measure_result;
874887 struct SL_I_Frame *frame;
875888 sl_s_len_t i;
889+
890+#define SL_I_OUT_HINT(WHAT) do{ \
891+ if(opt_out_hint) \
892+ *opt_out_hint = (WHAT); \
893+}while(0)
876894
877- if(SL_S_IS_NIL(value))
895+ if(SL_S_IS_NIL(value)){
896+ SL_I_OUT_HINT(SL_S_NIL);
878897 return SL_S_NIL;
898+ }
879899 if(SL_S_IS_ATOM(value)){
880900 atom = SL_S_PTR_FROM_TAG(value);
881901 if(SL_S_COMPARE_ATOMS(&sl_x_nil, atom)){
902+ SL_I_OUT_HINT(SL_S_NIL);
882903 return SL_S_NIL;
883904 }
884905 else if(SL_S_COMPARE_ATOMS(&sl_x_true, atom)){
906+ SL_I_OUT_HINT(&sl_x_atom_hint);
885907 return SL_S_MK_ATOM(&sl_x_true);
886908 }
887909 else if(SL_S_COMPARE_ATOMS(&sl_x_false, atom)){
910+ SL_I_OUT_HINT(&sl_x_atom_hint);
888911 return SL_S_MK_ATOM(&sl_x_false);
889912 }
890913 else{
@@ -895,16 +918,20 @@ SL_S_FUNC(void) *SL_I_Execute(struct SL_I_Runtime *rt, const void *value){
895918 if(SL_S_COMPARE_ATOMS(atom, frame->defs[i].name)){
896919 value = frame->defs[i].value;
897920 SL_S_INCREF(value);
898- return (void*)value;;
921+ SL_S_INCREF(frame->defs[i].hint);
922+ SL_I_OUT_HINT(frame->defs[i].hint);
923+ return (void*)value;
899924 }
900925 }
901926 }while((frame = frame->next) != SL_S_NIL);
902927
903928 SL_S_INCREF(value);
929+ SL_I_OUT_HINT(SL_S_NIL);
904930 return (void*)value;
905931 }
906932 }
907933 else if(!SL_S_IS_LIST(value)){
934+ SL_I_OUT_HINT(SL_S_NIL);
908935 SL_S_INCREF(value);
909936 return (void*)value;
910937 }
@@ -919,8 +946,10 @@ SL_S_FUNC(void) *SL_I_Execute(struct SL_I_Runtime *rt, const void *value){
919946 atom = SL_S_PTR_FROM_TAG(list->head);
920947
921948 /* Comment */
922- if(SL_S_COMPARE_ATOMS(&sl_x_comment, atom))
949+ if(SL_S_COMPARE_ATOMS(&sl_x_comment, atom)){
950+ SL_I_OUT_HINT(SL_S_NIL);
923951 return SL_S_NIL;
952+ }
924953
925954 /* Tick escape */
926955 if(!SL_S_IS_NIL(list->tail) &&
@@ -933,6 +962,7 @@ SL_S_FUNC(void) *SL_I_Execute(struct SL_I_Runtime *rt, const void *value){
933962 }
934963
935964 SL_S_INCREF(list->tail->head);
965+ SL_I_OUT_HINT(SL_S_NIL);
936966 return list->tail->head;
937967 }
938968
@@ -944,12 +974,13 @@ SL_S_FUNC(void) *SL_I_Execute(struct SL_I_Runtime *rt, const void *value){
944974 }
945975 /* All this is safe for nil. */
946976 SL_S_INCREF(list->tail);
977+ SL_I_OUT_HINT(&sl_x_list_hint);
947978 return SL_S_MK_LIST(list->tail);
948979 }
949980
950981 /* if */
951982 if(SL_S_COMPARE_ATOMS(&sl_x_if, atom)){
952- return sl_i_if(rt, list->tail);
983+ return sl_i_if(rt, list->tail, opt_out_hint);
953984 }
954985
955986 #define SL_I_TEST_ARITHMETIC(NAME, SYMBOL) \
@@ -966,10 +997,12 @@ SL_I_ALL_ARITHMETIC(SL_I_TEST_ARITHMETIC)
966997 rt->pending_error = "Invalid arity in " #NAME "?"; \
967998 return SL_S_NIL; \
968999 } \
969- value = SL_I_Execute(rt, list->tail->head); \
1000+ value = SL_I_Execute(rt, list->tail->head, SL_S_NIL); \
9701001 if(rt->pending_error) \
9711002 return SL_S_NIL; \
1003+ SL_I_OUT_HINT(&sl_x_atom_hint); \
9721004 if(TESTER(value)){ \
1005+ SL_S_DECREF(value); \
9731006 return SL_S_MK_ATOM(&sl_x_true); \
9741007 } \
9751008 else{ \
@@ -982,6 +1015,7 @@ SL_I_ALL_ARITHMETIC(SL_I_TEST_ARITHMETIC)
9821015 SL_I_TEST(list, SL_S_IS_LIST)
9831016 #define SL_I_TEST_INT(X) \
9841017 (SL_S_IS_ATOM(X) && SL_X_IsInt(SL_S_PTR_FROM_TAG(X)) == 0)
1018+
9851019 SL_I_TEST(int, SL_I_TEST_INT)
9861020
9871021 #undef SL_I_TEST_INT
@@ -1009,7 +1043,9 @@ SL_I_ALL_ARITHMETIC(SL_I_TEST_ARITHMETIC)
10091043 SL_S_ForEach(SL_X_ConcatAtomsCB, ret_list, atom);
10101044 atom->text[measure_result.len] = '\0';
10111045 SL_S_DECREF(ret_list);
1012- return atom;
1046+
1047+ SL_I_OUT_HINT(&sl_x_atom_hint);
1048+ return SL_S_MK_ATOM(atom);
10131049 }
10141050
10151051 /* cons */
@@ -1018,7 +1054,7 @@ SL_I_ALL_ARITHMETIC(SL_I_TEST_ARITHMETIC)
10181054 rt->pending_error = "Invalid arity in cons.";
10191055 return SL_S_NIL;
10201056 }
1021- value = SL_I_Execute(rt, list->tail->tail->head);
1057+ value = SL_I_Execute(rt, list->tail->tail->head, SL_S_NIL);
10221058 if(rt->pending_error)
10231059 return SL_S_NIL;
10241060 if(!SL_S_IS_LIST(value)){
@@ -1028,22 +1064,23 @@ SL_I_ALL_ARITHMETIC(SL_I_TEST_ARITHMETIC)
10281064 }
10291065 ret_list = SL_S_Malloc(sizeof(struct SL_S_List));
10301066 ret_list->ref = 1;
1031- ret_list->head = SL_I_Execute(rt, list->tail->head);
1067+ ret_list->head = SL_I_Execute(rt, list->tail->head, SL_S_NIL);
10321068 ret_list->tail = SL_S_PTR_FROM_TAG(value);
10331069 if(rt->pending_error){
10341070 SL_S_FREE_LIST(ret_list);
10351071 return SL_S_NIL;
10361072 }
1037- return ret_list;
1073+ SL_I_OUT_HINT(&sl_x_list_hint);
1074+ return SL_S_MK_LIST(ret_list);
10381075 }
10391076
10401077 /* head */
10411078 if(SL_S_COMPARE_ATOMS(&sl_x_head, atom)){
1042- if(SL_S_LengthCompare(list->tail, 2) != 0){
1079+ if(SL_S_LengthCompare(list->tail, 1) != 0){
10431080 rt->pending_error = "Invalid arity in head.";
10441081 return SL_S_NIL;
10451082 }
1046- value = SL_I_Execute(rt, list->tail->head);
1083+ value = SL_I_Execute(rt, list->tail->head, SL_S_NIL);
10471084 if(rt->pending_error)
10481085 return SL_S_NIL;
10491086 if(!SL_S_IS_LIST(value)){
@@ -1055,27 +1092,19 @@ SL_I_ALL_ARITHMETIC(SL_I_TEST_ARITHMETIC)
10551092 value = ret_list->head;
10561093 SL_S_INCREF(value);
10571094 SL_S_DECREF(ret_list);
1095+ SL_I_OUT_HINT(SL_S_NIL);
10581096 return (void*)value;
10591097 }
10601098
1061- /* head */
1099+ /* tail */
10621100 if(SL_S_COMPARE_ATOMS(&sl_x_tail, atom)){
1063- if(SL_S_LengthCompare(list->tail, 2) != 0){
1101+ if(SL_S_LengthCompare(list->tail, 1) != 0){
10641102 rt->pending_error = "Invalid arity in tail.";
10651103 return SL_S_NIL;
10661104 }
1067- value = SL_I_Execute(rt, list->tail->head);
1068- if(rt->pending_error)
1069- return SL_S_NIL;
1070- if(!SL_S_IS_LIST(value)){
1071- SL_S_DECREF(value);
1072- rt->pending_error = "Invalid arguments to tail.";
1073- return SL_S_NIL;
1074- }
1075- ret_list = SL_S_PTR_FROM_TAG(value);
1076- value = SL_S_MK_LIST(ret_list->tail);
1105+ value = SL_S_MK_LIST(list->tail->tail);
10771106 SL_S_INCREF(value);
1078- SL_S_DECREF(ret_list);
1107+ SL_I_OUT_HINT(&sl_x_list_hint);
10791108 return (void*)value;
10801109 }
10811110
@@ -1085,9 +1114,10 @@ SL_I_ALL_ARITHMETIC(SL_I_TEST_ARITHMETIC)
10851114 rt->pending_error = "Invalid arity in not.";
10861115 return SL_S_NIL;
10871116 }
1088- value = SL_I_Execute(rt, list->tail->head);
1117+ value = SL_I_Execute(rt, list->tail->head, SL_S_NIL);
10891118 if(rt->pending_error)
10901119 return SL_S_NIL;
1120+ SL_I_OUT_HINT(&sl_x_atom_hint);
10911121 /* Very minor optimization, check for address equivalence with
10921122 * the boolean primitives */
10931123 if(SL_S_PTR_FROM_TAG(value) == &sl_x_true){
@@ -1124,6 +1154,7 @@ SL_I_ALL_ARITHMETIC(SL_I_TEST_ARITHMETIC)
11241154 rt->pending_error = "Invalid arith in =";
11251155 return SL_S_NIL;
11261156 }
1157+ SL_I_OUT_HINT(&sl_x_atom_hint);
11271158 return sl_i_compare(rt,
11281159 list->tail->head,
11291160 list->tail->tail->head);
@@ -1135,6 +1166,8 @@ SL_I_ALL_ARITHMETIC(SL_I_TEST_ARITHMETIC)
11351166 if(SL_S_LengthCompare(list->tail,
11361167 rt->binds[i].arity) == 0){
11371168
1169+ SL_S_INCREF(rt->binds[i].hint);
1170+ SL_I_OUT_HINT(rt->binds[i].hint);
11381171 return SL_I_Call(rt, rt->binds + i, list->tail);
11391172 }
11401173 else{
@@ -1170,7 +1203,7 @@ SL_I_ALL_ARITHMETIC(SL_I_TEST_ARITHMETIC)
11701203 SL_S_FUNC(void) *SL_I_Execute2(const void *value, void *rt){
11711204 if(((struct SL_I_Runtime*)rt)->pending_error)
11721205 return SL_S_NIL;
1173- return SL_I_Execute(rt, (void*)value);
1206+ return SL_I_Execute(rt, (void*)value, SL_S_NIL);
11741207 }
11751208
11761209 /*****************************************************************************/
@@ -1200,7 +1233,8 @@ SL_S_FUNC(void) *SL_I_Call(struct SL_I_Runtime *rt,
12001233 frame.num_defs = frame.cap_defs = bind->arity;
12011234 for(i = 0; i < bind->arity; i++){
12021235 frame.defs[i].name = bind->args[i].name;
1203- value = SL_I_Execute(rt, args->head);
1236+ /* TODO: Use the output hint from SL_I_Execute! */
1237+ value = SL_I_Execute(rt, args->head, SL_S_NIL);
12041238 hint = bind->args[i].hint;
12051239 if(!(SL_S_IS_NIL(hint) || SL_S_COMPARE_ATOMS(hint, &sl_x_nil))){
12061240 /* Validate the type. */
@@ -1312,7 +1346,8 @@ type_hint_done:
13121346 code = code->tail){
13131347
13141348 SL_S_DECREF(value);
1315- value = SL_I_Execute(rt, code->head);
1349+ /* TODO: Check that the final value matches our output hint! */
1350+ value = SL_I_Execute(rt, code->head, SL_S_NIL);
13161351 }
13171352
13181353 /* Clean up the stack. */
--- a/sl_i.h
+++ b/sl_i.h
@@ -41,6 +41,7 @@ struct SL_I_Runtime;
4141
4242 struct SL_I_Bind{
4343 const struct SL_S_Atom *name;
44+ const struct SL_S_Atom *hint;
4445 union {
4546 SL_S_FUNC_PTR(void*, native)(
4647 struct SL_I_Runtime *rt,
@@ -48,7 +49,7 @@ struct SL_I_Bind{
4849 const struct SL_S_List *lisp;
4950 } bind;
5051 sl_s_len_t arity;
51- struct SL_X_FuncArg *args; /* Unused (for now) on native binds. */
52+ struct SL_X_FuncArg *args;
5253 unsigned char is_native;
5354 };
5455
@@ -93,8 +94,13 @@ SL_S_FUNC(void) SL_I_InitRuntime(struct SL_I_Runtime *rt);
9394 SL_S_FUNC(int) SL_I_Run(struct SL_I_Runtime *rt, const struct SL_S_List *code);
9495
9596 /*****************************************************************************/
96-/* The result must be DECREF'ed */
97-SL_S_FUNC(void) *SL_I_Execute(struct SL_I_Runtime *rt, const void *value);
97+/* The result must be DECREF'ed.
98+ * If opt_out_hint is not SL_S_NIL, then the return-type hint (if one exists)
99+ * will be placed into the destination.
100+ */
101+SL_S_FUNC(void) *SL_I_Execute(struct SL_I_Runtime *rt,
102+ const void *value,
103+ const struct SL_S_Atom **opt_out_hint);
98104
99105 /*****************************************************************************/
100106 /* Args reversed form of SL_I_Execute. */
--- a/sl_x.c
+++ b/sl_x.c
@@ -103,6 +103,24 @@ SL_X_ATOM(sl_x_le, "<=");
103103
104104 /*****************************************************************************/
105105
106+const struct SL_S_Atom *const sl_x_all_hints[] = {
107+ &sl_x_list_hint,
108+ &sl_x_atom_hint,
109+
110+#define SL_X_HINT_REF(X) &(sl_x_ ## X ## _hint),
111+SL_X_INTEGRAL_TYPES(SL_X_HINT_REF)
112+#undef SL_X_HINT_REF
113+
114+#ifdef SL_S_ENABLE_POINTERS
115+# define SL_X_PTR_HINT_REF(X) &(sl_x_ptr_ ## X ## _hint),
116+SL_X_INTEGRAL_TYPES(SL_X_PTR_HINT_REF)
117+# undef SL_X_PTR_HINT_REF
118+#endif
119+ SL_S_NIL
120+};
121+
122+/*****************************************************************************/
123+
106124 static int sl_x_is_builtin(const struct SL_S_Atom *arg){
107125 return (SL_S_IS_NIL(arg) || arg->len > 5) ? 1 : !(
108126 SL_S_COMPARE_ATOMS(&sl_x_if, arg) ||
--- a/sl_x.h
+++ b/sl_x.h
@@ -85,6 +85,10 @@ const extern struct SL_S_Atom
8585 sl_x_eq, sl_x_ne, sl_x_gt, sl_x_ge, sl_x_lt, sl_x_le;
8686
8787 /*****************************************************************************/
88+/* NULL-terminated. */
89+const extern struct SL_S_Atom *const sl_x_all_hints[];
90+
91+/*****************************************************************************/
8892
8993 struct SL_X_FileOps{
9094 void *x_stdin;