OSDN -- 오픈 소스 소프트웨어 개발 및 다운로드
Translation Status of 한국말 translation status for ko
  • R/O
  • SSH
Fork

quipu: Commit

quipu mercurial repository


Commit MetaInfo

Revisiona4a49a8e540c3e0a0e5ce332c4e08754a2550795 (tree)
Time2018-02-23 07:10:58
AuthorAgustina Arzille <avarzille@rise...>
CommiterAgustina Arzille

Log Message

Add the necessary stuff for backquote

Change Summary

Incremental Difference

diff -r f0217d1849c8 -r a4a49a8e540c io.cpp
--- a/io.cpp Thu Feb 22 02:43:01 2018 +0000
+++ b/io.cpp Thu Feb 22 19:10:58 2018 -0300
@@ -15,6 +15,8 @@
1515 #include "cons.h"
1616 #include "table.h"
1717 #include "tree.h"
18+#include "builtins.h"
19+#include "function.h"
1820 #include "utils/chmask.h"
1921
2022 QP_DECLS_BEGIN
@@ -920,6 +922,8 @@
920922 qp_return (*lr);
921923 }
922924
925+// Backquote implementation.
926+
923927 static bool
924928 bq_member (object elem, object lst)
925929 {
@@ -930,7 +934,7 @@
930934 return (false);
931935 }
932936
933-static inline void
937+[[noreturn]] static inline void
934938 bq_nonlist_splice_err (interpreter *interp, bool dot)
935939 {
936940 char errmsg[] = "read: the syntax `,@form is invalid";
@@ -940,6 +944,37 @@
940944 interp->raise2 ("parse-error", errmsg);
941945 }
942946
947+object rdstate::read_comma (object lbl)
948+{
949+ if (this->bq_level <= 0)
950+ this->interp->raise2 ("parse-error", "read: more commas than backquotes");
951+
952+ this->unquoted = true;
953+ --this->bq_level;
954+
955+ schar next;
956+ object head = QP_S(comma);
957+
958+ if (!this->src->sgetc (this->interp, next))
959+ this->interp->raise2 ("parse-error", "read: unexpected end of input");
960+ else if (*next.buf == '@')
961+ head = QP_S(commaat);
962+ else if (*next.buf == '.')
963+ head = QP_S(commadot);
964+ else
965+ this->src->ungetuc (next.buf, next.len);
966+
967+ object obj = this->read_sexpr (UNBOUND);
968+ alloc_cons (this->interp, 2);
969+ xcar(this->interp->alval) = head;
970+ xcadr(this->interp->alval) = obj;
971+
972+ if (lbl != UNBOUND)
973+ *this->puthash(lbl) = this->interp->alval;
974+
975+ qp_return (this->interp->alval);
976+}
977+
943978 object rdstate::read_bq (object lbl)
944979 {
945980 this->unquoted = false;
@@ -974,35 +1009,295 @@
9741009 qp_return (this->interp->alval);
9751010 }
9761011
977-object rdstate::read_comma (object lbl)
978-{
979- if (this->bq_level <= 0)
980- this->interp->raise2 ("parse-error", "read: more commas than backquotes");
981-
982- this->unquoted = true;
983- --this->bq_level;
984-
985- schar next;
986- object head = QP_S(comma);
1012+static const object BQ_NCONCABLE = intobj (0) | EXTRA_BIT;
9871013
988- if (!this->src->sgetc (this->interp, next))
989- this->interp->raise2 ("parse-error", "read: unexpected end of input");
990- else if (*next.buf == '@')
991- head = QP_S(commaat);
992- else if (*next.buf == '.')
993- head = QP_S(commadot);
994- else
995- this->src->ungetuc (next.buf, next.len);
1014+static object bq_expand (interpreter *, object);
9961015
997- object obj = this->read_sexpr (UNBOUND);
998- alloc_cons (this->interp, 2);
999- xcar(this->interp->alval) = head;
1000- xcadr(this->interp->alval) = obj;
1016+static object
1017+bq_list (interpreter *interp, object form1)
1018+{
1019+ valref lst (interp, intern (interp, "list", 4));
1020+ return (call_fct (interp, list_fct, *lst, form1));
1021+}
10011022
1002- if (lbl != UNBOUND)
1003- *this->puthash(lbl) = this->interp->alval;
1023+static object
1024+bq_transform (interpreter *interp, object form)
1025+{
1026+ if (!cons_p (form))
1027+ {
1028+ valref tmp (interp, bq_expand (interp, form));
1029+ return (bq_list (interp, *tmp));
1030+ }
1031+
1032+ valref tmp (interp, xcar (form));
1033+ if (*tmp == QP_S(comma))
1034+ return (bq_list (interp, *tmp = xcadr (form)));
1035+ else if (*tmp == QP_S(commaat))
1036+ qp_return (xcadr (form));
1037+ else if (*tmp == QP_S(commadot))
1038+ {
1039+ *tmp = xcadr (form);
1040+ return (call_fct (interp, list_fct, BQ_NCONCABLE, *tmp));
1041+ }
1042+ else if (*tmp == QP_S(backquote))
1043+ {
1044+ *tmp = xcadr (form);
1045+ *tmp = bq_expand (interp, *tmp);
1046+ *tmp = call_fct (interp, list_fct, QP_S(backquote), *tmp);
1047+ return (bq_list (interp, *tmp));
1048+ }
1049+ else
1050+ {
1051+ *tmp = bq_expand (interp, form);
1052+ return (bq_list (interp, *tmp));
1053+ }
1054+}
10041055
1005- qp_return (this->interp->alval);
1056+static object
1057+bq_expand_list (interpreter *interp, object forms)
1058+{
1059+ valref ret (interp, NIL), tmp (interp, forms);
1060+ while (*tmp != NIL)
1061+ {
1062+ bq_transform (interp, xcar (*tmp));
1063+ *ret = cons::make (interp, interp->retval, *ret);
1064+
1065+ valref tail (interp, xcdr (*tmp));
1066+ if (*tail == NIL)
1067+ break;
1068+ else if (!xcons_p (*tail))
1069+ {
1070+ *tail = call_fct (interp, list_fct, QP_S(backquote), *tail);
1071+ *ret = cons::make (interp, *tail, *ret);
1072+ break;
1073+ }
1074+ else if (xcar (*tail) == QP_S(comma))
1075+ {
1076+ *ret = cons::make (interp, xcadr (*tail), *ret);
1077+ break;
1078+ }
1079+ else if (xcar (*tail) == QP_S(commaat) ||
1080+ xcar (*tail) == QP_S(commadot))
1081+ bq_nonlist_splice_err (interp, xcar (*tail) == QP_S(commadot));
1082+ else
1083+ *tmp = *tail;
1084+ }
1085+
1086+ return (nreverse_L (interp, *ret));
1087+}
1088+
1089+static inline bool
1090+bq_splicing_p (interpreter *interp, object form)
1091+{
1092+ valref tmp (interp, form);
1093+
1094+again:
1095+ if (!xcons_p (*tmp))
1096+ return (false);
1097+ else if (xcar (*tmp) == QP_S(comma))
1098+ {
1099+ *tmp = xcadr (*tmp);
1100+ goto again;
1101+ }
1102+
1103+ *tmp = xcar (*tmp);
1104+ return (*tmp == QP_S(commaat) || *tmp == QP_S(commadot));
1105+}
1106+
1107+static inline bool
1108+bq_non_splicing (interpreter *interp, object form)
1109+{
1110+ if (!bq_splicing_p (interp, form))
1111+ qp_return (form);
1112+
1113+ valref app (interp, intern (interp, "append", 6));
1114+ return (call_fct (interp, list_fct, *app, form));
1115+}
1116+
1117+static inline bool
1118+bq_cons_test (interpreter *interp, object form)
1119+{
1120+ interp->aux = form;
1121+ valref tmp (interp, NIL);
1122+
1123+ return (xcons_p (interp->aux) && xcar (interp->aux) == QP_S(quote) &&
1124+ xcons_p (xcdr (interp->aux)) && xcddr (interp->aux) == NIL &&
1125+ !bq_splicing_p (interp, *tmp = xcadr (interp->aux)));
1126+}
1127+
1128+static object
1129+bq_cons (interpreter *interp, object f1, object f2)
1130+{
1131+ valref op (interp, intern (interp,
1132+ bq_splicing_p (interp, f1) ? "list*" : "cons"));
1133+ valref t2 (interp, f2), t1 (interp, f1);
1134+
1135+ if (atom_p (*t2))
1136+ return (call_fct (interp, list_fct, *op, f1, f2));
1137+ else if (xcar (*t2) == intern (interp, "list", 4))
1138+ return (call_fct (interp, list_star, f1, xcdr (*t2)));
1139+ else if (bq_cons_test (interp, *t2) && bq_cons_test (interp, *t1))
1140+ {
1141+ *t2 = xcadr (*t2), *t1 = xcadr (*t1);
1142+ *t1 = cons::make (interp, *t1, *t2);
1143+ return (call_fct (interp, list_fct, QP_S(quote), *t1));
1144+ }
1145+ else
1146+ return (call_fct (interp, list_fct, *t1, *t2));
1147+}
1148+
1149+static object
1150+bq_append (interpreter *interp, object f1, object f2)
1151+{
1152+ valref t1 (interp, f1), t2 (interp, f2), aux (interp, NIL);
1153+
1154+ if (*t1 == NIL)
1155+ qp_return (*t2);
1156+ else if (*t2 == NIL)
1157+ qp_return (*t1);
1158+ else if (xcons_p (*t1) && xcar (*t1) == intern (interp, "list", 4) &&
1159+ xcdr (last_L (interp, *t1)) == NIL)
1160+ {
1161+ *t2 = bq_non_splicing (interp, *t2);
1162+ if (xcdr (*t1) == NIL)
1163+ qp_return (*t2);
1164+ else if (xcddr (*t1) == NIL)
1165+ return (bq_cons (interp, *t1 = xcadr (*t1), *t2));
1166+ else
1167+ {
1168+ *t1 = xcdr (*t1), *t2 = cons::make (interp, *t2, NIL);
1169+ *t1 = add_LL (interp, *t1, *t2);
1170+ *t2 = intern (interp, "list*", 5);
1171+ return (cons::make (interp, *t2, *t1));
1172+ }
1173+ }
1174+ else if (bq_cons_test (interp, *t1) && xcons_p (*aux = xcadr (*t1)) &&
1175+ xcdr (last_L (interp, *aux)) == NIL &&
1176+ xcar (*aux) != QP_S(comma))
1177+ {
1178+ *t2 = bq_non_splicing (interp, *t2);
1179+ valref lst (interp, reverse_L (interp, *aux));
1180+ *aux = *t2;
1181+
1182+ for (; *lst != NIL; *lst = xcdr (*lst))
1183+ {
1184+ *t1 = xcar (*lst);
1185+ *t1 = call_fct (interp, list_fct, QP_S(quote), *t1);
1186+ *aux = bq_cons (interp, *t1, *aux);
1187+ }
1188+
1189+ qp_return (*aux);
1190+ }
1191+ else if (xcons_p (*t2) && xcar (*t2) ==
1192+ (*aux = intern (interp, "append", 6)))
1193+ {
1194+ *t2 = xcdr (*t2);
1195+ return (call_fct (interp, list_star, *aux, *t1, *t2));
1196+ }
1197+ else
1198+ {
1199+ *aux = intern (interp, "append", 6);
1200+ return (call_fct (interp, list_fct, *t1, *t2));
1201+ }
1202+}
1203+
1204+static object
1205+bq_nconc (interpreter *interp, object f1, object f2)
1206+{
1207+ valref t2 (interp, f2);
1208+
1209+ if (f1 == NIL)
1210+ qp_return (f2);
1211+ else if (f2 == NIL)
1212+ qp_return (f1);
1213+
1214+ valref lst (interp, intern (interp, "nconcat", 7));
1215+ auto fn = list_fct;
1216+
1217+ if (xcons_p (*t2) && xcar (*t2) == *lst)
1218+ *t2 = xcdr (*t2), fn = list_star;
1219+
1220+ return (call_fct (interp, fn, *lst, f1, *t2));
1221+}
1222+
1223+static object
1224+bq_append_multi (interpreter *interp, object forms)
1225+{
1226+ if (forms == NIL)
1227+ qp_return (forms);
1228+
1229+ bool nc = false;
1230+ valref tf (interp, reverse_L (interp, forms)),
1231+ res (interp, NIL), aux (interp, xcar (*tf)), tmp (interp, NIL);
1232+
1233+ if (xcons_p (*aux) && xcar (*aux) == BQ_NCONCABLE)
1234+ *res = xcadr (*tf), nc = true;
1235+ else
1236+ *res = *tf;
1237+
1238+ while (*tf != NIL)
1239+ {
1240+ *aux = xcar (*tf);
1241+ if (xcons_p (*aux) && xcar (*aux) == BQ_NCONCABLE)
1242+ {
1243+ *aux = xcadr (*tf);
1244+ if (!nc && bq_splicing_p (interp, *res))
1245+ {
1246+ *tmp = intern (interp, "append", 6);
1247+ *tmp = call_fct (interp, list_fct, *tmp, *res);
1248+ }
1249+ else
1250+ *tmp = *res;
1251+
1252+ *res = bq_nconc (interp, *aux, *tmp);
1253+ }
1254+ else
1255+ {
1256+ if (nc && bq_splicing_p (interp, *res))
1257+ {
1258+ *tmp = intern (interp, "nconcat", 7);
1259+ *tmp = call_fct (interp, list_fct, *tmp, *res);
1260+ }
1261+ else
1262+ *tmp = *res;
1263+
1264+ *res = bq_append (interp, *tf, *tmp);
1265+ }
1266+
1267+ nc = false;
1268+ *tf = xcdr (*tf);
1269+ }
1270+
1271+ return (bq_non_splicing (interp, *res));
1272+}
1273+
1274+static object
1275+bq_expand (interpreter *interp, object form)
1276+{
1277+ if (form == NIL)
1278+ qp_return (NIL);
1279+ else if (xcons_p (form))
1280+ {
1281+ interp->aux = xcar (form);
1282+ if (interp->aux == QP_S(comma))
1283+ qp_return (xcadr (form));
1284+ else if (interp->aux == QP_S(commaat) || interp->aux == QP_S(commadot))
1285+ bq_nonlist_splice_err (interp, interp->aux == QP_S(commadot));
1286+ else if (interp->aux == QP_S(backquote))
1287+ {
1288+ valref tmp (interp, bq_expand (interp, xcadr (interp->aux)));
1289+ return (call_fct (interp, list_fct, QP_S(backquote), *tmp));
1290+ }
1291+ else
1292+ {
1293+ valref exp (interp, bq_expand_list (interp, form));
1294+ return (bq_append_multi (interp, *exp));
1295+ }
1296+ }
1297+ else
1298+ return (call_fct (interp, list_fct, QP_S(quote), form));
1299+
1300+ /* XXX: Handle arrays, tables, trees. */
10061301 }
10071302
10081303 object rdstate::read_sexpr (object lbl)
diff -r f0217d1849c8 -r a4a49a8e540c symbol.h
--- a/symbol.h Thu Feb 22 02:43:01 2018 +0000
+++ b/symbol.h Thu Feb 22 19:10:58 2018 -0300
@@ -104,6 +104,16 @@
104104 QP_EXPORT object find_sym (interpreter *__interp,
105105 object __pkg, const char *__name, int __len = -1);
106106
107+inline object find_sym (interpreter *__interp, const char *__name)
108+{
109+ return (find_sym (__interp, root_package, __name));
110+}
111+
112+inline object find_sym (interpreter *__interp, const char *__name, int __len)
113+{
114+ return (find_sym (__interp, root_package, __name, __len));
115+}
116+
107117 QP_EXPORT object intern (interpreter *__interp,
108118 const char *__name, int __len, package *__pkgp = 0);
109119
Show on old repository browser