rev 255 - in trunk: . include/prothon modules pr src
SVN User <[email protected]>
| Newsgroups | gmane.comp.lang.prothon.cvs |
|---|---|
| Message-ID | <[email protected]> |
Author: bcollins
Date: 2004-04-02 00:14:44 -0500 (Fri, 02 Apr 2004)
New Revision: 255
Added:
trunk/src/builtins-core.c
trunk/src/builtins-dict.c
trunk/src/builtins-float.c
trunk/src/builtins-int.c
trunk/src/builtins-list.c
trunk/src/builtins-string.c
trunk/src/builtins-tuple.c
Removed:
trunk/modules/Dict/
trunk/modules/Float/
trunk/modules/List/
trunk/modules/String/
trunk/modules/Tuple/
trunk/src/builtins.c
Modified:
trunk/configure
trunk/configure.in
trunk/include/prothon/prothon.h
trunk/modules/Makefile.in
trunk/pr/file_test.pr
trunk/pr/hex.pr
trunk/pr/re_test.pr
trunk/pr/stdio_test.pr
trunk/src/Makefile.in
trunk/src/object.h
Log:
Move all standard modules to builtins, and break out each main builtin to
its own file.
Modified: trunk/configure
===================================================================
--- trunk/configure 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/configure 2004-04-02 05:14:44 UTC (rev 255)
@@ -19380,7 +19380,7 @@
- ac_config_files="$ac_config_files Rules.mk Makefile src/Makefile modules/Makefile modules/File/Makefile modules/Dict/Makefile modules/Re/Makefile modules/Float/Makefile modules/String/Makefile modules/Tuple/Makefile modules/List/Makefile"
+ ac_config_files="$ac_config_files Rules.mk Makefile src/Makefile modules/Makefile modules/File/Makefile modules/Re/Makefile"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
@@ -19911,12 +19911,7 @@
"src/Makefile" ) CONFIG_FILES="$CONFIG_FILES src/Makefile" ;;
"modules/Makefile" ) CONFIG_FILES="$CONFIG_FILES modules/Makefile" ;;
"modules/File/Makefile" ) CONFIG_FILES="$CONFIG_FILES modules/File/Makefile" ;;
- "modules/Dict/Makefile" ) CONFIG_FILES="$CONFIG_FILES modules/Dict/Makefile" ;;
"modules/Re/Makefile" ) CONFIG_FILES="$CONFIG_FILES modules/Re/Makefile" ;;
- "modules/Float/Makefile" ) CONFIG_FILES="$CONFIG_FILES modules/Float/Makefile" ;;
- "modules/String/Makefile" ) CONFIG_FILES="$CONFIG_FILES modules/String/Makefile" ;;
- "modules/Tuple/Makefile" ) CONFIG_FILES="$CONFIG_FILES modules/Tuple/Makefile" ;;
- "modules/List/Makefile" ) CONFIG_FILES="$CONFIG_FILES modules/List/Makefile" ;;
"include/config.h" ) CONFIG_HEADERS="$CONFIG_HEADERS include/config.h" ;;
*) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
Modified: trunk/configure.in
===================================================================
--- trunk/configure.in 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/configure.in 2004-04-02 05:14:44 UTC (rev 255)
@@ -77,7 +77,4 @@
AC_SUBST(LINK_LIBTOOL)
AC_OUTPUT(Rules.mk Makefile src/Makefile modules/Makefile
- modules/File/Makefile modules/Dict/Makefile
- modules/Re/Makefile modules/Float/Makefile
- modules/String/Makefile modules/Tuple/Makefile
- modules/List/Makefile)
+ modules/File/Makefile modules/Re/Makefile)
Modified: trunk/include/prothon/prothon.h
===================================================================
--- trunk/include/prothon/prothon.h 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/include/prothon/prothon.h 2004-04-02 05:14:44 UTC (rev 255)
@@ -90,7 +90,7 @@
//#define DEBUG_THREADS
//#define DEBUG_MEM_MGR
//#define TRACE_PARSER
-#define TRACE_INTERPRETER
+//#define TRACE_INTERPRETER
//#define DUMP_MODULE_CODE
//#define DUMP_OBJECTS_AT_END
Modified: trunk/modules/Makefile.in
===================================================================
--- trunk/modules/Makefile.in 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/modules/Makefile.in 2004-04-02 05:14:44 UTC (rev 255)
@@ -7,7 +7,7 @@
include $(top_builddir)/Rules.mk
-MODULES = Dict File Float List String Tuple
+MODULES = File
ifeq (@HAVE_BOOST_REGEX@,yes)
MODULES += Re
Modified: trunk/pr/file_test.pr
===================================================================
--- trunk/pr/file_test.pr 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/pr/file_test.pr 2004-04-02 05:14:44 UTC (rev 255)
@@ -1,6 +1,6 @@
#!/usr/local/bin/prothon
-import String, List, File
+import File
f = File("test.txt", 'w+')
for i in 5:
Modified: trunk/pr/hex.pr
===================================================================
--- trunk/pr/hex.pr 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/pr/hex.pr 2004-04-02 05:14:44 UTC (rev 255)
@@ -1,7 +1,5 @@
#!/usr/local/bin/prothon
-import String
-
def hex(n):
s = ""
while n:
Modified: trunk/pr/re_test.pr
===================================================================
--- trunk/pr/re_test.pr 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/pr/re_test.pr 2004-04-02 05:14:44 UTC (rev 255)
@@ -1,6 +1,6 @@
#!/usr/local/bin/prothon
-import Re, List
+import Re
def findall(r,s):
result=[]
Modified: trunk/pr/stdio_test.pr
===================================================================
--- trunk/pr/stdio_test.pr 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/pr/stdio_test.pr 2004-04-02 05:14:44 UTC (rev 255)
@@ -1,6 +1,6 @@
#!/usr/local/bin/prothon
-import File, String
+import File
stdout = File.stdout
stdin = File.stdin
Modified: trunk/src/Makefile.in
===================================================================
--- trunk/src/Makefile.in 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/src/Makefile.in 2004-04-02 05:14:44 UTC (rev 255)
@@ -9,12 +9,14 @@
TARGET=prothon
-# WARNING! The builtins.o object MUST come first, else your binary will be
-# broken! This is not a joke. Also, the object.o object must follow the
-# BUILTIN_MOD_OBJS in the OBJS list below. Doesn't matter where really, so
-# long as it is after the BUILTIN_MOD_OBJS, since it contains the key for
-# the end of the list.
-BUILTIN_MOD_OBJS = builtins.o
+# WARNING! The builtins-core.o object MUST come first, else your binary
+# will be broken! This is not a joke. Also, the object.o object must
+# follow the BUILTIN_MOD_OBJS in the OBJS list below. Doesn't matter where
+# really, so long as it is after the BUILTIN_MOD_OBJS, since it contains
+# the key for the end of the list.
+BUILTIN_MOD_OBJS = builtins-core.o builtins-dict.o builtins-int.o \
+ builtins-list.o builtins-string.o builtins-tuple.o \
+ builtins-float.o
OBJS = main.o $(BUILTIN_MOD_OBJS) object.o argproc.o clist.o lock.o \
memory_mgr.o parser.o prmalloc.o sys.o interp.o parser_routines.o \
Copied: trunk/src/builtins-core.c (from rev 254, trunk/src/builtins.c)
===================================================================
--- trunk/src/builtins.c 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/src/builtins-core.c 2004-04-02 05:14:44 UTC (rev 255)
@@ -0,0 +1,609 @@
+/* ====================================================================
+ * The Prothon License Agreement, Version 1.1
+ *
+ * Copyright (c) 2004 Hahn Creative Applications, http://hahnca.com.
+ * All rights reserved.
+ *
+ * 1. This LICENSE AGREEMENT is between Hahn Creative Applications ("HCA"),
+ * and the Individual or Organization ("Licensee") accessing and otherwise
+ * using Prothon software in source or binary form and its associated
+ * documentation.
+ *
+ * 2. Subject to the terms and conditions of this License Agreement, HCA
+ * hereby grants Licensee a nonexclusive, royalty-free, world-wide license
+ * to reproduce, analyze, test, perform and/or display publicly, prepare
+ * derivative works, distribute, and otherwise use Prothon alone or in any
+ * derivative version, provided, however, that HCA's License Agreement and
+ * HCA's notice of copyright, i.e., "Copyright (c) 2004 Hahn Creative
+ * Applications; All Rights Reserved" are retained in Prothon alone or
+ * in any derivative version prepared by Licensee.
+ *
+ * 3. In the event Licensee prepares a derivative work that is based on or
+ * incorporates Prothon or any part thereof, and wants to make the
+ * derivative work available to others as provided herein, then Licensee
+ * hereby agrees to include in any such work a brief summary of the
+ * changes made to Prothon.
+ *
+ * 4. HCA is making Prothon available to Licensee on an "AS IS" basis.
+ * HCA MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY
+ * OF EXAMPLE, BUT NOT LIMITATION, HCA MAKES NO AND DISCLAIMS ANY
+ * REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS FOR ANY
+ * PARTICULAR PURPOSE OR THAT THE USE OF PROTHON WILL NOT INFRINGE ANY
+ * THIRD PARTY RIGHTS.
+ *
+ * 5. HCA SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PROTHON
+ * FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
+ * RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PROTHON, OR ANY
+ * DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
+ *
+ * 6. This License Agreement will automatically terminate upon a material
+ * breach of its terms and conditions.
+ *
+ * 7. Nothing in this License Agreement shall be deemed to create any
+ * relationship of agency, partnership, or joint venture between HCA and
+ * Licensee. This License Agreement does not grant permission to use HCA
+ * trademarks or trade name in a trademark sense to endorse or promote
+ * products or services of Licensee, or any third party.
+ *
+ * 8. By copying, installing or otherwise using Prothon, Licensee agrees
+ * to be bound by the terms and conditions of this License Agreement.
+ * ====================================================================
+ */
+
+
+// builtins.c
+
+#include <stdio.h>
+#include <string.h>
+
+#include <apr_strings.h>
+
+#include <prothon/prothon.h>
+#include <prothon/dict.h>
+#include "parser.h"
+#include "object.h"
+#include <prothon/prothon_dll.h>
+
+/* Leave this here. Do not move it, and do not declare anything above it.
+ * This is here for a reason, so that the builtin's can be loaded (this is
+ * the key for the start of the pointers to the functions for all the
+ * builtins). */
+PR_PLACE_IN_SECTION(dll_initcall_t,start_dll_entry_ptr, "._module_init") = 0;
+
+MODULE_DECLARE(Object);
+MODULE_DECLARE(False);
+MODULE_DECLARE(True);
+MODULE_DECLARE(None);
+MODULE_DECLARE(Exception);
+MODULE_DECLARE(Gen);
+MODULE_DECLARE(Seq);
+MODULE_DECLARE(Func);
+
+// ***************************** Object *********************************
+
+MODULE_START(Object)
+{
+ Object_OBJ = OBJ(OBJECT);
+ MODULE_SET_DOC(Object, "prototype base for all objects");
+
+ add_doc_to_obj(ist, OBJ(SYMBOL_PROTO), "Symbol object prototype");
+ add_doc_to_obj(ist, OBJ(HASH_PROTO), "Hash object prototype");
+ add_doc_to_obj(ist, OBJ(SLICE_PROTO), "Slice object prototype");
+ add_doc_to_obj(ist, OBJ(SUPER_PROTO), "Super object prototype");
+ add_doc_to_obj(ist, OBJ(ROOT_GLOBALS), "Root_Globals: recursive container of all objects");
+ add_doc_to_obj(ist, OBJ(MODULES), "Modules: container of all modules");
+
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Root_Globals"), OBJ(ROOT_GLOBALS));
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Modules"), OBJ(MODULES));
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Symbols"), OBJ(SYMBOLS));
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Object"), OBJ(OBJECT));
+}
+
+DEF(Object, __init__, NULL) {
+ return self;
+}
+
+DEF(Object, has_proto_QUES, FORM_RPARAM) {
+ if (has_proto_QUES(ist, self, parms[1]))
+ return OBJ(PR_TRUE);
+ else
+ return OBJ(PR_FALSE);
+}
+
+DEF(Object, set_proto, FORM_RPARAM) {
+ read_unlock(ist, self);
+ switch_proto_to(ist, self, parms[1]);
+ read_lock(ist, self);
+ return NULL;
+}
+
+DEF(Object, add_proto, FORM_RPARAM) {
+ read_unlock(ist, self);
+ ins_proto(ist, self, parms[1], 1000);
+ read_lock(ist, self);
+ return NULL;
+}
+
+DEF(Object, Len, FORM_RPARAM) {
+ return call_func0(ist, parms[1], SYM(LEN));
+}
+
+DEF(Object, Cmp, FORM_PARAM2) {
+ return call_func1(ist, parms[1], SYM(CMP), parms[3]);
+}
+
+DEF(Object, Max, FORM_RPARAM) {
+ return call_func0(ist, parms[1], SYM(MAX));
+}
+
+DEF(Object, Min, FORM_RPARAM) {
+ return call_func0(ist, parms[1], SYM(MIN));
+}
+
+DEF(Object, __getitem__, FORM_RPARAM) {
+ raise_exception(ist, OBJ(TYPE_EXC), "indexing not supported on this object");
+ return NULL;
+}
+DEF(Object, __setitem__, FORM_PARAM2) {
+ raise_exception(ist, OBJ(TYPE_EXC), "indexing not supported on this object");
+ return NULL;
+}
+DEF(Object, __delitem__, FORM_RPARAM) {
+ raise_exception(ist, OBJ(TYPE_EXC), "indexing not supported on this object");
+ return NULL;
+}
+
+DEF(Object, proto_list, NULL) {
+ return proto_list(ist, self);
+}
+
+DEF(Object, __bool__QUES, NULL) { return OBJ(PR_TRUE); }
+DEF(Object, __not__QUES, NULL)
+{
+ if (call_func0(ist, self, SYM(__BOOL__QUES)) == OBJ(PR_TRUE))
+ return OBJ(PR_FALSE);
+ else
+ return OBJ(PR_TRUE);
+}
+
+DEF(Object, __is__QUES, FORM_RPARAM) {
+ if (self == parms[1]) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+
+DEF(Object, __isnot__QUES, FORM_RPARAM) {
+ if (self != parms[1]) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+
+DEF(Object, __str__, NULL) {
+ char str[1024];
+ obj_p doc = get_attr(ist, self, SYM(__DOC__));
+ char* p = strch(doc);
+ if (doc)
+ apr_snprintf(str, sizeof(str), "<Object:%lx:%s>", (unsigned long)(uintptr_t)self, p);
+ else
+ apr_snprintf(str, sizeof(str), "<Object:%lx>", (unsigned long)(uintptr_t)self);
+ return new_string_obj(str);
+}
+
+DEF(Object, __hash__, NULL) {
+ return new_hash_obj((i32_t)(uintptr_t) self);
+}
+
+DEF(Object, __eq__QUES, FORM_RPARAM) {
+ obj_p cmp_obj = call_func1(ist, self, SYM(CMP), parms[1]); if_exc_return NULL;
+ if (cmp_obj && *((i64_t*)(obj_data_p(cmp_obj))) == 0)
+ return OBJ(PR_TRUE);
+ else
+ return OBJ(PR_FALSE);
+}
+
+DEF(Object, __ne__QUES, FORM_RPARAM) {
+ obj_p cmp_obj = call_func1(ist, self, SYM(__EQ__QUES), parms[1]); if_exc_return NULL;
+ if (cmp_obj == OBJ(PR_TRUE))
+ return OBJ(PR_FALSE);
+ else
+ return OBJ(PR_TRUE);
+}
+
+DEF(Object, __lt__QUES, FORM_RPARAM) {
+ obj_p cmp_obj = call_func1(ist, self, SYM(CMP), parms[1]); if_exc_return NULL;
+ if (cmp_obj && *((i64_t*)(obj_data_p(cmp_obj))) < 0) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+
+DEF(Object, __le__QUES, FORM_RPARAM) {
+ obj_p cmp_obj = call_func1(ist, self, SYM(CMP), parms[1]); if_exc_return NULL;
+ if (cmp_obj && *((i64_t*)(obj_data_p(cmp_obj))) <= 0) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+
+DEF(Object, __gt__QUES, FORM_RPARAM) {
+ obj_p cmp_obj = call_func1(ist, self, SYM(CMP), parms[1]); if_exc_return NULL;
+ if (cmp_obj && *((i64_t*)(obj_data_p(cmp_obj))) > 0) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+
+DEF(Object, __ge__QUES, FORM_RPARAM) {
+ obj_p cmp_obj = call_func1(ist, self, SYM(CMP), parms[1]); if_exc_return NULL;
+ if (cmp_obj && *((i64_t*)(obj_data_p(cmp_obj))) >= 0) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+
+DEF(Object, __in__QUES, FORM_RPARAM) {
+ return call_func1(ist, parms[1], SYM(__RIN__QUES), self);
+}
+
+DEF(Object, __notin__QUES, FORM_RPARAM) {
+ return call_func1(ist, parms[1], SYM(__RNOTIN__QUES), self);
+}
+
+DEF(Object, attrs, NULL) {
+ int i;
+ size_t alen, asize;
+ attr_p attrp;
+ obj_p dict_obj;
+ if (!self->has_attrs) return new_dict_obj(0);
+ attrp = self->attr_proto.attrs;
+ asize = attr_asize(attrp);
+ alen = attr_alen(attrp);
+ dict_obj = new_dict_obj((int)alen);
+ for (i=0; i < (int) asize; i++) {
+ if (attr_ap(attrp,i)->attr.key > 0)
+ dict_add( ist, dict_obj,
+ new_string_obj(keych(ist, attr_ap(attrp,i)->attr.key)),
+ attr_ap(attrp,i)->attr.value );
+ }
+ return dict_obj;
+}
+
+MODULE_END(Object);
+
+// ***************************** PR_FALSE *****************************************
+
+MODULE_START(False)
+{
+ False_OBJ = OBJ(PR_FALSE);
+ MODULE_SET_DOC(False, "boolean false singleton value");
+ set_attr(ist, OBJ(OBJECT), sym(ist, "False"), False_OBJ);
+}
+
+DEF(False, __str__, NULL) { return new_string_obj("False"); }
+DEF(False, __bool__QUES, NULL) { return False_OBJ; }
+DEF(False, cmp, FORM_RPARAM) {
+ if (parms[1] == False_OBJ)
+ return new_int_obj(0);
+ else
+ return new_int_obj(-1);
+}
+
+MODULE_END(False);
+
+// ***************************** PR_TRUE *****************************************
+
+MODULE_START(True)
+{
+ True_OBJ = OBJ(PR_TRUE);
+ MODULE_SET_DOC(True, "boolean true singleton value");
+ set_attr(ist, OBJ(OBJECT), sym(ist, "True"), True_OBJ);
+}
+
+DEF(True, __str__, NULL) { return new_string_obj("True"); }
+DEF(True, __bool__QUES, NULL) { return True_OBJ; }
+DEF(True, cmp, FORM_RPARAM) {
+ if (parms[1] == OBJ(PR_FALSE))
+ return new_int_obj(1);
+ else if (parms[1] == True_OBJ)
+ return new_int_obj(0);
+ else
+ return new_int_obj(-1);
+}
+
+MODULE_END(True);
+
+// ***************************** NONE *****************************************
+
+MODULE_START(None)
+{
+ None_OBJ = OBJ(NONE);
+ MODULE_SET_DOC(None, "represents empty set");
+ set_attr(ist, OBJ(OBJECT), sym(ist, "None"), None_OBJ);
+}
+
+DEF(None, __str__, NULL) { return new_string_obj("None"); }
+DEF(None, __bool__QUES, NULL) { return OBJ(PR_FALSE); }
+MODULE_END(None);
+
+// ***************************** EXCEPTION ************************************
+MODULE_START(Exception)
+{
+ Exception_OBJ = OBJ(EXCEPTION);
+ MODULE_SET_DOC(Exception, "root for all exception objects");
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Exception"), Exception_OBJ);
+
+ /* Other exception objects dependent on this one */
+ OBJ(INTERNAL_EXC) = new_object(Exception_OBJ);
+ OBJ(PARSEERROR_EXC) = new_object(Exception_OBJ);
+ OBJ(INTERPRETER_EXC) = new_object(Exception_OBJ);
+ OBJ(ASSERTION_EXC) = new_object(Exception_OBJ);
+ OBJ(NAME_EXC) = new_object(Exception_OBJ);
+ OBJ(INDEX_EXC) = new_object(Exception_OBJ);
+ OBJ(FUNCNOTFOUND_EXC) = new_object(Exception_OBJ);
+ OBJ(TYPE_EXC) = new_object(Exception_OBJ);
+ OBJ(MUTABLE_EXC) = new_object(Exception_OBJ);
+ OBJ(DIVIDEZERO_EXC) = new_object(Exception_OBJ);
+ OBJ(OUTOFMEMORY_EXC) = new_object(Exception_OBJ);
+ OBJ(IOEXCEPTION) = new_object(Exception_OBJ);
+ OBJ(FILENOTFOUND_EXC) = new_object(OBJ(IOEXCEPTION));
+ OBJ(STOP_ITERATION_EXC) = new_object(Exception_OBJ);
+ OBJ(LOCK_EXC) = new_object(Exception_OBJ);
+
+ /* And their doc entries */
+ add_doc_to_obj(ist, OBJ(INTERNAL_EXC), "Internal Prothon Error");
+ add_doc_to_obj(ist, OBJ(PARSEERROR_EXC), "Parse Error");
+ add_doc_to_obj(ist, OBJ(INTERPRETER_EXC), "Program Error");
+ add_doc_to_obj(ist, OBJ(ASSERTION_EXC), "Assertion Error");
+ add_doc_to_obj(ist, OBJ(NAME_EXC), "Name Error");
+ add_doc_to_obj(ist, OBJ(INDEX_EXC), "Index Error");
+ add_doc_to_obj(ist, OBJ(TYPE_EXC), "Type Error");
+ add_doc_to_obj(ist, OBJ(MUTABLE_EXC), "Mutable Error");
+ add_doc_to_obj(ist, OBJ(DIVIDEZERO_EXC), "Divide by zero error");
+ add_doc_to_obj(ist, OBJ(OUTOFMEMORY_EXC), "Out Of Memory Error");
+ add_doc_to_obj(ist, OBJ(IOEXCEPTION), "IO Error");
+ add_doc_to_obj(ist, OBJ(FILENOTFOUND_EXC), "File Not Found");
+ add_doc_to_obj(ist, OBJ(STOP_ITERATION_EXC), "End Of Generated Sequence (no error)");
+ add_doc_to_obj(ist, OBJ(LOCK_EXC), "Locking Error");
+}
+
+DEF(Exception, __init__, FORM_STAR_PARAM) {
+ obj_p res;
+ if (list_len(ist, parms[1]) > 0)
+ raise_exception(ist, self, "%s", as_str(ist, list_item(ist, parms[1], 0)));
+ else
+ raise_exception(ist, self, NULL);
+ res = ist->exception_obj;
+ ist->exception_obj = 0;
+ return res;
+}
+MODULE_END(Exception);
+
+// ***************************** GEN ******************************************
+MODULE_START(Gen)
+{
+ Gen_OBJ = OBJ(GEN_PROTO);
+ MODULE_SET_DOC(Gen, "generator object prototype");
+}
+
+DEF(Gen, __gen__, NULL) {
+ return self;
+}
+MODULE_END(Gen);
+
+// ***************************** SEQUENCE *************************************
+
+MODULE_START(Seq)
+{
+ Seq_OBJ = OBJ(SEQ_PROTO);
+ MODULE_SET_DOC(Seq, "object prototype");
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Sequence"), Seq_OBJ);
+}
+
+obj_p str_tuple_list(isp ist, obj_p self, char* ldelim, char* rdelim)
+{
+ int i, len=list_len(ist, self);
+ char msg[64], *res;
+ obj_p ret_obj;
+
+ /* Need enough room for just empty list */
+ res = pr_malloc(strlen(ldelim) + strlen(rdelim) + 1);
+
+ strcpy(res, ldelim);
+
+ for (i = 0; i < len; i++) {
+ char* item_str;
+ obj_p item = list_item(ist, self,i);
+ int is_str = has_proto_QUES(ist, item, OBJ(STRING_PROTO));
+
+ if ((uintptr_t)item > 10) {
+ item_str = as_str(ist, item);
+ } else {
+ apr_snprintf(msg, sizeof(msg), "<objptr:%lx>", (unsigned long)(uintptr_t)item);
+ item_str = msg;
+ is_str = 0;
+ }
+
+ res = pr_realloc(res, strlen(res) + strlen(item_str) + strlen(rdelim) + 6);
+ if (is_str)
+ strcat(res, "'");
+ strcat(res, item_str);
+ if (is_str)
+ strcat(res,"'");
+
+ if (i != len-1)
+ strcat(res, ", ");
+ }
+ strcat(res, rdelim);
+
+ ret_obj = new_string_obj(res);
+ pr_free(res);
+
+ return ret_obj;
+}
+
+obj_p get_sequence_item(isp ist, obj_p self, obj_p slice, int seq_type) {
+ obj_p res = NULL, slice_item1, slice_item2, slice_item3;
+ int i, index1 = 0, index2 = 0, index3 = 0, slice1_empty=FALSE, slice2_empty=FALSE;
+ int exp_len, self_len, slice_len = list_len(ist, slice);
+ char* self_str = NULL;
+
+ CHECK_TYPE_EXC(self, OBJ(SEQ_PROTO), "sequence");
+
+ if (seq_type == SEQ_TYPE_STRING) {
+ self_len = (int) pr_strlen(self);
+ self_str = strch(self);
+ } else
+ self_len = list_len(ist, self);
+ slice_item1 = list_item(ist, slice,0);
+ if (slice_item1 == SLICEPARAM_EMPTY || slice_item1 == OBJ(NONE))
+ slice1_empty=TRUE;
+ else {
+ CHECK_TYPE_EXC(slice_item1, OBJ(INT_PROTO), "integer");
+
+ index1 = (int)(slice_item1->data.i64);
+ if (index1 < 0) index1 += self_len;
+ if (index1 < 0 || index1 >= self_len) {
+ raise_exception(ist, OBJ(INDEX_EXC), "Index (%d) out of range", index1);
+ return NULL;
+ }
+ if (slice_len == 1) {
+ if (seq_type == SEQ_TYPE_STRING) {
+ return new_string_n_obj(self_str+index1, 1);
+ } else
+ return list_item(ist, self, index1);
+ }
+ }
+ if (slice_len == 3) {
+ slice_item3 = list_item(ist, slice,2);
+ if (slice_item3 == SLICEPARAM_EMPTY || slice_item3 == OBJ(NONE)) index3 = 1;
+ else {
+ CHECK_TYPE_EXC(slice_item3, OBJ(INT_PROTO), "integer");
+
+ index3 = (int)(slice_item3->data.i64);
+ if (index3 == 0) {
+ raise_exception(ist, OBJ(INDEX_EXC), "Slice step cannot be zero");
+ return NULL;
+ }
+ }
+ } else index3 = 1;
+ slice_item2 = list_item(ist, slice,1);
+ if (slice_item2 == SLICEPARAM_EMPTY || slice_item2 == OBJ(NONE))
+ slice2_empty=TRUE;
+ else {
+ CHECK_TYPE_EXC(slice_item2, OBJ(INT_PROTO), "integer");
+
+ index2 = (int)(slice_item2->data.i64);
+ if (index2 < 0) index2 += self_len;
+ if (index2 < 0 || index2 > self_len) {
+ raise_exception(ist, OBJ(INDEX_EXC), "Second index (%d) out of range", index2);
+ return NULL;
+ }
+ }
+ if (index3 > 0) {
+ if (slice1_empty) index1 = 0;
+ if (slice2_empty) index2 = self_len;
+ exp_len = (index2-index1+(index3-1))/index3;
+ exp_len = max(exp_len, 0);
+ switch(seq_type) {
+ case SEQ_TYPE_TUPLE:
+ res = new_tuple_obj(exp_len);
+ for(i = index1; i < index2; i += index3)
+ list_append(ist, res, list_item(ist, self, i));
+ break;
+ case SEQ_TYPE_LIST:
+ res = new_list_obj(exp_len);
+ for(i = index1; i < index2; i += index3)
+ list_append(ist, res, list_item(ist, self, i));
+ break;
+ case SEQ_TYPE_STRING: {
+ int j;
+ char* s = pr_malloc(exp_len+2);
+ for(i = index1, j=0; i < index2; i += index3, j++)
+ s[j] = self_str[i];
+ res = new_string_n_obj(s, j);
+ pr_free(s);
+ } break;
+ }
+ } else {
+ if (slice1_empty) index1 = self_len-1;
+ if (slice2_empty) index2 = -1;
+ exp_len = (index2-index1+(index3-1))/index3;
+ exp_len = max(exp_len, 0)+1;
+ switch(seq_type) {
+ case SEQ_TYPE_TUPLE:
+ res = new_tuple_obj(exp_len);
+ for(i = index1; i > index2; i += index3)
+ list_append(ist, res, list_item(ist, self, i));
+ break;
+ case SEQ_TYPE_LIST:
+ res = new_list_obj(exp_len);
+ for(i = index1; i > index2; i += index3)
+ list_append(ist, res, list_item(ist, self, i));
+ break;
+ case SEQ_TYPE_STRING: {
+ int j;
+ char* s = pr_malloc(exp_len+2);
+ for(i = index1, j=0; i > index2; i += index3, j++)
+ s[j] = self_str[i];
+ res = new_string_n_obj(s, j);
+ } break;
+ }
+ }
+ return res;
+}
+
+MODULE_END(Seq);
+
+// ***************************** FUNC ******************************************
+
+MODULE_START(Func)
+{
+ Func_OBJ = OBJ(FUNC_PROTO);
+ MODULE_SET_DOC(Func, "function object prototype");
+}
+
+DEF(Func, __objlist__, FORM_RPARAM) {
+ return parms[1];
+}
+MODULE_END(Func);
+
+// ***************************** INIT_BUILTINS ********************************
+
+static void core_builtins_init(void)
+{
+ OBJ(OBJECT) = new_object(NULL);
+ OBJ(OBJECT)->attr_proto.proto = OBJ(OBJECT);
+
+ OBJ(SEQ_PROTO) = new_object(NULL);
+ OBJ(TUPLE_PROTO) = new_object(OBJ(SEQ_PROTO));
+ OBJ(LIST_PROTO) = new_object(OBJ(TUPLE_PROTO));
+ OBJ(SYMBOL_PROTO) = new_object(NULL);
+
+ OBJ(HASH_PROTO) = new_object(NULL);
+ OBJ(SLICE_PROTO) = new_object(NULL);
+ OBJ(SUPER_PROTO) = new_object(NULL);
+ OBJ(THREAD_PROTO) = new_object(NULL);
+ OBJ(ROOT_GLOBALS) = new_object(NULL);
+ OBJ(MODULES) = new_object(NULL);
+ OBJ(PR_FALSE) = new_object(NULL);
+ OBJ(PR_TRUE) = new_object(NULL);
+ OBJ(NONE) = new_object(NULL);
+ OBJ(EXCEPTION) = new_object(NULL);
+ OBJ(GEN_PROTO) = new_object(NULL);
+ OBJ(INT_PROTO) = new_object(NULL);
+ OBJ(STRING_PROTO) = new_object(NULL);
+ OBJ(DICT_PROTO) = new_object(NULL);
+ OBJ(FUNC_PROTO) = new_object(NULL);
+
+ OBJ(SYMBOLS) = new_list_obj(SYM_ENUM_COUNT+20);
+
+ init_symbol(ist);
+
+ add_doc_to_obj(ist, OBJ(SYMBOLS), "Symbols: list of all symbol objects");
+}
+
+MAIN_MODULE_INIT(Core)
+{
+ /* Call this first to get things sort of setup for the rest of
+ * these things */
+ core_builtins_init();
+
+ MODULE_SUB_INIT(Object);
+ MODULE_SUB_INIT(Seq);
+ MODULE_SUB_INIT(False);
+ MODULE_SUB_INIT(True);
+ MODULE_SUB_INIT(None);
+ MODULE_SUB_INIT(Exception);
+ MODULE_SUB_INIT(Gen);
+ MODULE_SUB_INIT(Func);
+}
Added: trunk/src/builtins-dict.c
===================================================================
--- trunk/src/builtins-dict.c 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/src/builtins-dict.c 2004-04-02 05:14:44 UTC (rev 255)
@@ -0,0 +1,252 @@
+/* ====================================================================
+ * The Prothon License Agreement, Version 1.1
+ *
+ * Copyright (c) 2004 Hahn Creative Applications, http://hahnca.com.
+ * All rights reserved.
+ *
+ * 1. This LICENSE AGREEMENT is between Hahn Creative Applications ("HCA"),
+ * and the Individual or Organization ("Licensee") accessing and otherwise
+ * using Prothon software in source or binary form and its associated
+ * documentation.
+ *
+ * 2. Subject to the terms and conditions of this License Agreement, HCA
+ * hereby grants Licensee a nonexclusive, royalty-free, world-wide license
+ * to reproduce, analyze, test, perform and/or display publicly, prepare
+ * derivative works, distribute, and otherwise use Prothon alone or in any
+ * derivative version, provided, however, that HCA's License Agreement and
+ * HCA's notice of copyright, i.e., "Copyright (c) 2004 Hahn Creative
+ * Applications; All Rights Reserved" are retained in Prothon alone or
+ * in any derivative version prepared by Licensee.
+ *
+ * 3. In the event Licensee prepares a derivative work that is based on or
+ * incorporates Prothon or any part thereof, and wants to make the
+ * derivative work available to others as provided herein, then Licensee
+ * hereby agrees to include in any such work a brief summary of the
+ * changes made to Prothon.
+ *
+ * 4. HCA is making Prothon available to Licensee on an "AS IS" basis.
+ * HCA MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY
+ * OF EXAMPLE, BUT NOT LIMITATION, HCA MAKES NO AND DISCLAIMS ANY
+ * REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS FOR ANY
+ * PARTICULAR PURPOSE OR THAT THE USE OF PROTHON WILL NOT INFRINGE ANY
+ * THIRD PARTY RIGHTS.
+ *
+ * 5. HCA SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PROTHON
+ * FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
+ * RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PROTHON, OR ANY
+ * DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
+ *
+ * 6. This License Agreement will automatically terminate upon a material
+ * breach of its terms and conditions.
+ *
+ * 7. Nothing in this License Agreement shall be deemed to create any
+ * relationship of agency, partnership, or joint venture between HCA and
+ * Licensee. This License Agreement does not grant permission to use HCA
+ * trademarks or trade name in a trademark sense to endorse or promote
+ * products or services of Licensee, or any third party.
+ *
+ * 8. By copying, installing or otherwise using Prothon, Licensee agrees
+ * to be bound by the terms and conditions of this License Agreement.
+ * ====================================================================
+ */
+
+
+// builtins.c
+
+#include <stdio.h>
+#include <string.h>
+
+#include <apr_strings.h>
+
+#include <prothon/prothon.h>
+#include <prothon/dict.h>
+#include "parser.h"
+#include "object.h"
+#include <prothon/prothon_dll.h>
+
+MODULE_DECLARE(Dict);
+MODULE_DECLARE(DictGen);
+
+// ***************************** DICT ******************************************
+
+MODULE_START(Dict)
+{
+ dict_p dict;
+
+ Dict_OBJ = OBJ(DICT_PROTO);
+ MODULE_SET_DOC(Dict, "dictionary object prototype");
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Dict"), Dict_OBJ);
+
+ dict = obj_malloc(Dict_OBJ, (DICT_OVERHEAD+DEFAULT_INITIAL_DICT_SIZE)*sizeof(dict_t));
+ memset(dict, 0, (DICT_OVERHEAD+DEFAULT_INITIAL_DICT_SIZE)*sizeof(dict_t));
+ dictsize(dict) = DEFAULT_INITIAL_DICT_SIZE;
+}
+
+#define __ADD_QUOTE(__is_str) \
+do { \
+ if (__is_str) \
+ strcat(res, "'"); \
+} while(0)
+
+DEF(Dict, __str__, NULL) {
+ int i;
+ size_t len;
+ char* res;
+ obj_p res_obj, keys, vals;
+
+ len = dict_len(ist, self);
+ keys = dict_keys(ist, self);
+ vals = dict_values(ist, self);
+
+ res = pr_malloc(3);
+
+ strcpy(res, "{");
+ for (i=0; i < (int) len; i++) {
+ obj_p item1 = list_item(ist, keys,i);
+ obj_p item2 = list_item(ist, vals,i);
+ char* str1 = as_str(ist, item1);
+ char* str2 = as_str(ist, item2);
+ int is_str1 = has_proto_QUES(ist, item1, OBJ(STRING_PROTO));
+ int is_str2 = has_proto_QUES(ist, item2, OBJ(STRING_PROTO));
+
+ if (str1 == NULL)
+ str1 = "(null)";
+ if (str2 == NULL)
+ str2 = "(null)";
+
+ res = pr_realloc(res, strlen(res)+strlen(str1)+1+strlen(str2)+( i != len-1 ? 3 : 2)+6);
+
+ __ADD_QUOTE(is_str1);
+ strcat(res, str1);
+ __ADD_QUOTE(is_str1);
+ strcat(res, ":");
+ __ADD_QUOTE(is_str2);
+ strcat(res, str2);
+ __ADD_QUOTE(is_str2);
+
+ if (i != len-1) strcat(res, ", ");
+ }
+ strcat(res, "}");
+
+ res_obj = new_string_obj(res);
+ pr_free(res);
+
+ return res_obj;
+}
+
+DEF(Dict, __objlist__, FORM_RPARAM) {
+ size_t i, size, len;
+ dict_p dict, dp;
+ dict = dict_d(self);
+ size = dictsize(dict);
+ len = dictlen(dict);
+ for(i=0; i < size; i++)
+ if ((dp=dictptr(dict,i))->entry.hash > 0) {
+ list_append(ist, parms[1], dp->entry.key);
+ list_append(ist, parms[1], dp->entry.value);
+ }
+ return parms[1];
+}
+
+DEF(Dict, __getitem__, FORM_RPARAM) {
+ obj_p res;
+
+ CHECK_TYPE_EXC(self, OBJ(DICT_PROTO), "dict");
+
+ if (list_len(ist, parms[1]) > 1) {
+ raise_exception(ist, OBJ(INTERPRETER_EXC), "slice not allowed in dictionary indexing");
+ return NULL;
+ }
+ if (!(res = dict_item(ist, self, list_item(ist, parms[1],0)))) {
+ raise_exception(ist, OBJ(INDEX_EXC), "no entry found with key: %s",
+ as_str(ist, list_item(ist, parms[1],0)));
+ return NULL;
+ }
+ return res;
+}
+
+DEF(Dict, __setitem__, FORM_PARAM2) {
+ if (list_len(ist, parms[1]) > 1) {
+ raise_exception(ist, OBJ(INTERPRETER_EXC), "slice not allowed in dictionary indexing");
+ return NULL;
+ }
+ read_unlock(ist, self);
+ dict_add(ist, self, list_item(ist, parms[1], 0), parms[3]);
+ read_lock(ist, self);
+ return NULL;
+}
+
+DEF(Dict, __delitem__, FORM_RPARAM) {
+ i32_t i, hash_in;
+ obj_p key, key_in, rp[2];
+ dict_p dict, dp;
+ rp[0]=0; rp[1] = key_in = list_item(ist, parms[1], 0);
+ if (list_len(ist, parms[1]) > 1) {
+ raise_exception(ist, OBJ(INTERPRETER_EXC), "slice not allowed in dictionary indexing");
+ return NULL;
+ }
+ read_unlock(ist, self); write_lock(ist, self);
+ hash_in = hash_value(call_func(ist, key_in, SYM(__HASH__), 0, NULL, NULL));
+ if (ist->exception_obj) {
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ dict = (dict_p) self->data.ptr;
+ for(i=hash_in; (key=((dp=dictptr(dict,i))->entry.key)); i++){
+ if ( dp->entry.hash == hash_in &&
+ call_func(ist, key, SYM(__EQ__QUES), 2, rp, NULL) == OBJ(PR_TRUE) ) {
+ dp->entry.hash = ENTRY_DELETED;
+ dictlen(dict)--;
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ if (ist->exception_obj) {
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ }
+ raise_exception(ist, OBJ(INDEX_EXC), "no entry found to delete");
+ return NULL;
+}
+
+DEF(Dict, __gen__, NULL) {
+ obj_p list_obj, gen_obj = new_object(DictGen_OBJ);
+
+ gen_obj->data_type = OBJ_TYPE_DATAPTR;
+ gen_obj->data.ptr = list_obj = dict_keys(ist, self);
+
+ listlen(list_obj) = 0;
+ return gen_obj;
+}
+
+MODULE_END(Dict);
+
+MODULE_START(DictGen)
+{
+ DictGen_OBJ = new_object(NULL);
+}
+
+DEF(DictGen, next, NULL) {
+ obj_p res, list_obj = self->data.ptr;
+
+ CHECK_TYPE_EXC(self, DictGen_OBJ, "DictGen");
+ CHECK_TYPE_EXC(list_obj, OBJ(SEQ_PROTO), "list");
+
+ if (listsize(list_obj) == listlen(list_obj)) {
+ raise_exception(ist, OBJ(STOP_ITERATION_EXC), NULL);
+ return NULL;
+ }
+
+ res = listitem(list_obj, listlen(list_obj));
+ listlen(list_obj)++;
+
+ return res;
+}
+
+MODULE_END(DictGen);
+
+MAIN_MODULE_INIT(Dict)
+{
+ MODULE_SUB_INIT(Dict);
+ MODULE_SUB_INIT(DictGen);
+}
Property changes on: trunk/src/builtins-dict.c
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/src/builtins-float.c
===================================================================
--- trunk/src/builtins-float.c 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/src/builtins-float.c 2004-04-02 05:14:44 UTC (rev 255)
@@ -0,0 +1,342 @@
+/* ====================================================================
+ * The Prothon License Agreement, Version 1.1
+ *
+ * Copyright (c) 2004 Hahn Creative Applications, http://hahnca.com.
+ * All rights reserved.
+ *
+ * 1. This LICENSE AGREEMENT is between Hahn Creative Applications ("HCA"),
+ * and the Individual or Organization ("Licensee") accessing and otherwise
+ * using Prothon software in source or binary form and its associated
+ * documentation.
+ *
+ * 2. Subject to the terms and conditions of this License Agreement, HCA
+ * hereby grants Licensee a nonexclusive, royalty-free, world-wide license
+ * to reproduce, analyze, test, perform and/or display publicly, prepare
+ * derivative works, distribute, and otherwise use Prothon alone or in any
+ * derivative version, provided, however, that HCA's License Agreement and
+ * HCA's notice of copyright, i.e., "Copyright (c) 2004 Hahn Creative
+ * Applications; All Rights Reserved" are retained in Prothon alone or
+ * in any derivative version prepared by Licensee.
+ *
+ * 3. In the event Licensee prepares a derivative work that is based on or
+ * incorporates Prothon or any part thereof, and wants to make the
+ * derivative work available to others as provided herein, then Licensee
+ * hereby agrees to include in any such work a brief summary of the
+ * changes made to Prothon.
+ *
+ * 4. HCA is making Prothon available to Licensee on an "AS IS" basis.
+ * HCA MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY
+ * OF EXAMPLE, BUT NOT LIMITATION, HCA MAKES NO AND DISCLAIMS ANY
+ * REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS FOR ANY
+ * PARTICULAR PURPOSE OR THAT THE USE OF PROTHON WILL NOT INFRINGE ANY
+ * THIRD PARTY RIGHTS.
+ *
+ * 5. HCA SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PROTHON
+ * FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
+ * RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PROTHON, OR ANY
+ * DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
+ *
+ * 6. This License Agreement will automatically terminate upon a material
+ * breach of its terms and conditions.
+ *
+ * 7. Nothing in this License Agreement shall be deemed to create any
+ * relationship of agency, partnership, or joint venture between HCA and
+ * Licensee. This License Agreement does not grant permission to use HCA
+ * trademarks or trade name in a trademark sense to endorse or promote
+ * products or services of Licensee, or any third party.
+ *
+ * 8. By copying, installing or otherwise using Prothon, Licensee agrees
+ * to be bound by the terms and conditions of this License Agreement.
+ * ====================================================================
+ */
+
+
+// builtins.c
+
+#include <stdio.h>
+#include <string.h>
+
+#include <apr_strings.h>
+
+#include <prothon/prothon.h>
+#include <prothon/dict.h>
+#include "parser.h"
+#include "object.h"
+#include <prothon/prothon_dll.h>
+
+
+#define FLOAT_DATA_SIZE 8
+
+#define is_Float(objid) (has_proto_QUES(ist, objid, Float_OBJ))
+#define Float_value(objid) (objid->data.f64)
+
+MODULE_DECLARE(Float);
+
+
+MODULE_START(Float)
+{
+ Float_OBJ = OBJ(FLOAT_PROTO) = new_object(NULL);
+ OBJ(IMAG_PROTO) = new_object(NULL);
+
+ add_doc_to_obj(ist, OBJ(FLOAT_PROTO), "Float number object prototype");
+ add_doc_to_obj(ist, OBJ(IMAG_PROTO), "Imaginary number object prototype");
+
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Float"), OBJ(FLOAT_PROTO));
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Imaginary"), OBJ(IMAG_PROTO));
+}
+
+DEF(Float, __bool__QUES, NULL) {
+ if (Float_value(self) != 0.0 )
+ return OBJ(PR_TRUE);
+ else
+ return OBJ(PR_FALSE);
+}
+
+DEF(Float, __hash__, NULL) {
+ double flt = (double) Float_value(self);
+ if (flt < 0) flt = -flt;
+ if (flt == 0.0) flt = 1.0;
+ while (flt < 100.0) flt *= 10.0;
+ while (flt > 1e9) flt /= 10.0;
+ return new_hash_obj((i32_t)flt);
+}
+
+DEF(Float, __abs__, NULL) {
+ double num = Float_value(self);
+ return new_float_obj(num < 0 ? -num : num);
+}
+
+DEF(Float, __neg__, NULL){
+ return new_float_obj( - Float_value(self) );
+}
+
+DEF(Float, __pos__, NULL){
+ return self;
+}
+
+DEF(Float, __add__, FORM_RPARAM){
+ double float_other;
+ obj_p other = parms[1];
+ if (is_Float(other)) float_other = Float_value(other);
+ else {
+ if (has_proto_QUES(ist, other, OBJ(INT_PROTO)))
+ float_other = (double)other->data.i64;
+ else {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__ADD__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "Float cannot be added to this object");
+ return OBJ(NONE);
+ }
+ }
+ return new_float_obj(Float_value(self) + float_other);
+}
+
+DEF(Float, __div__, FORM_RPARAM){
+ double float_other;
+ obj_p other = parms[1];
+ if (is_Float(other)) float_other = Float_value(other);
+ else {
+ if (has_proto_QUES(ist, other, OBJ(INT_PROTO)))
+ float_other = (double)other->data.i64;
+ else {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__RDIV__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "Float cannot be divided by this object");
+ return NULL;
+ }
+ }
+ if (float_other == 0.0) {
+ raise_exception(ist, OBJ(DIVIDEZERO_EXC), NULL);
+ return NULL;
+ }
+ return new_float_obj(Float_value(self) / float_other);
+}
+
+DEF(Float, __rdiv__, FORM_RPARAM){
+ double float_other;
+ obj_p other = parms[1];
+ if (is_Float(other)) float_other = Float_value(other);
+ else {
+ if (has_proto_QUES(ist, other, OBJ(INT_PROTO)))
+ float_other = (double)other->data.i64;
+ else {
+ raise_exception(ist, OBJ(TYPE_EXC), "Float cannot be divided into this object");
+ return NULL;
+ }
+ }
+ if (Float_value(self) == 0.0) {
+ raise_exception(ist, OBJ(DIVIDEZERO_EXC), NULL);
+ return NULL;
+ }
+ return new_float_obj(float_other / Float_value(self));
+}
+
+DEF(Float, __mul__, FORM_RPARAM){
+ double float_other;
+ obj_p other = parms[1];
+ if (is_Float(other)) float_other = Float_value(other);
+ else {
+ if (has_proto_QUES(ist, other, OBJ(INT_PROTO)))
+ float_other = (double)other->data.i64;
+ else {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__MUL__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "float cannot be multiplied by this object");
+ return NULL;
+ }
+ }
+ return new_float_obj(Float_value(self) * float_other);
+}
+
+DEF(Float, __sub__, FORM_RPARAM){
+ double float_other;
+ obj_p other = parms[1];
+ if (is_Float(other)) float_other = Float_value(other);
+ else {
+ if (has_proto_QUES(ist, other, OBJ(INT_PROTO)))
+ float_other = (double)other->data.i64;
+ else {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__RSUB__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "this object cannot be subtracted from a float");
+ return NULL;
+ }
+ }
+ return new_float_obj(Float_value(self) - float_other);
+}
+
+DEF(Float, __rsub__, FORM_RPARAM){
+ double float_other;
+ obj_p other = parms[1];
+ if (is_Float(other)) float_other = Float_value(other);
+ else {
+ if (has_proto_QUES(ist, other, OBJ(INT_PROTO)))
+ float_other = (double)other->data.i64;
+ else {
+ raise_exception(ist, OBJ(TYPE_EXC), "this object cannot be subtracted from a float");
+ return NULL;
+ }
+ }
+ return new_float_obj(float_other - Float_value(self));
+}
+
+DEF(Float, __pow__, FORM_RPARAM){
+ double float_other;
+ obj_p other = parms[1];
+ if (is_Float(other)) float_other = Float_value(other);
+ else {
+ if (has_proto_QUES(ist, other, OBJ(INT_PROTO)))
+ float_other = (double)other->data.i64;
+ else {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__RPOW__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "this object cannot be in a pow function with a float");
+ return NULL;
+ }
+ }
+ return new_float_obj(pow(Float_value(self), float_other));
+}
+
+DEF(Float, __rpow__, FORM_RPARAM){
+ double float_other;
+ obj_p other = parms[1];
+ if (is_Float(other)) float_other = Float_value(other);
+ else {
+ if (has_proto_QUES(ist, other, OBJ(INT_PROTO)))
+ float_other = (double)other->data.i64;
+ else {
+ raise_exception(ist, OBJ(TYPE_EXC), "this object cannot be in a pow function with a float");
+ return NULL;
+ }
+ }
+ return new_float_obj(pow(float_other, Float_value(self)));
+}
+
+
+DEF(Float, cmp, FORM_RPARAM){
+ double float_other;
+ obj_p other = parms[1];
+ if (is_Float(other)) float_other = Float_value(other);
+ else {
+ if (has_proto_QUES(ist, other, OBJ(INT_PROTO)))
+ float_other = (double)other->data.i64;
+ else {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__RCMP__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "this object cannot compared to a float");
+ return NULL;
+ }
+ }
+ if (Float_value(self) == float_other)
+ return new_float_obj(0);
+ else if (Float_value(self) > float_other)
+ return new_int_obj(1);
+ else
+ return new_int_obj(-1);
+}
+
+DEF(Float, __rcmp__, FORM_RPARAM){
+ double float_other;
+ obj_p other = parms[1];
+ if (is_Float(other)) float_other = Float_value(other);
+ else {
+ if (has_proto_QUES(ist, other, OBJ(INT_PROTO)))
+ float_other = (double)other->data.i64;
+ else {
+ raise_exception(ist, OBJ(TYPE_EXC), "this object cannot compared to a float");
+ return NULL;
+ }
+ }
+ if (Float_value(self) == float_other)
+ return new_float_obj(0);
+ else if (Float_value(self) < float_other)
+ return new_int_obj(1);
+ else
+ return new_int_obj(-1);
+}
+
+DEF(Float, __eq__QUES, FORM_RPARAM){
+ double float_other;
+ obj_p other = parms[1];
+ if (is_Float(other)) float_other = Float_value(other);
+ else {
+ if (has_proto_QUES(ist, other, OBJ(INT_PROTO)))
+ float_other = (double)other->data.i64;
+ else {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__EQ__QUES), self);
+ return OBJ(PR_FALSE);
+ }
+ }
+ if (Float_value(self) == float_other) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+
+DEF(Float, __str__, NULL){
+ char str[1024];
+ apr_snprintf(str, sizeof(str), "%g", Float_value(self));
+ return new_string_obj(str);
+}
+
+DEF(Float, __covers__QUES, FORM_RPARAM) {
+ if (has_proto_QUES(ist, parms[1], OBJ(INT_PROTO))) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+
+DEF(Float, __coerce__, FORM_RPARAM) {
+ if (has_proto_QUES(ist, parms[1], OBJ(INT_PROTO)))
+ return new_float_obj((double)(parms[1]->data.i64));
+ else if (has_proto_QUES(ist, parms[1], Float_OBJ))
+ return new_float_obj(parms[1]->data.f64);
+ else
+ raise_exception(ist, OBJ(TYPE_EXC), "This object cannot be coerced to a Float");
+ return NULL;
+}
+
+MODULE_END(Float);
+
+
+MAIN_MODULE_INIT(Float)
+{
+ MODULE_SUB_INIT(Float);
+}
Property changes on: trunk/src/builtins-float.c
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/src/builtins-int.c
===================================================================
--- trunk/src/builtins-int.c 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/src/builtins-int.c 2004-04-02 05:14:44 UTC (rev 255)
@@ -0,0 +1,336 @@
+/* ====================================================================
+ * The Prothon License Agreement, Version 1.1
+ *
+ * Copyright (c) 2004 Hahn Creative Applications, http://hahnca.com.
+ * All rights reserved.
+ *
+ * 1. This LICENSE AGREEMENT is between Hahn Creative Applications ("HCA"),
+ * and the Individual or Organization ("Licensee") accessing and otherwise
+ * using Prothon software in source or binary form and its associated
+ * documentation.
+ *
+ * 2. Subject to the terms and conditions of this License Agreement, HCA
+ * hereby grants Licensee a nonexclusive, royalty-free, world-wide license
+ * to reproduce, analyze, test, perform and/or display publicly, prepare
+ * derivative works, distribute, and otherwise use Prothon alone or in any
+ * derivative version, provided, however, that HCA's License Agreement and
+ * HCA's notice of copyright, i.e., "Copyright (c) 2004 Hahn Creative
+ * Applications; All Rights Reserved" are retained in Prothon alone or
+ * in any derivative version prepared by Licensee.
+ *
+ * 3. In the event Licensee prepares a derivative work that is based on or
+ * incorporates Prothon or any part thereof, and wants to make the
+ * derivative work available to others as provided herein, then Licensee
+ * hereby agrees to include in any such work a brief summary of the
+ * changes made to Prothon.
+ *
+ * 4. HCA is making Prothon available to Licensee on an "AS IS" basis.
+ * HCA MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY
+ * OF EXAMPLE, BUT NOT LIMITATION, HCA MAKES NO AND DISCLAIMS ANY
+ * REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS FOR ANY
+ * PARTICULAR PURPOSE OR THAT THE USE OF PROTHON WILL NOT INFRINGE ANY
+ * THIRD PARTY RIGHTS.
+ *
+ * 5. HCA SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PROTHON
+ * FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
+ * RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PROTHON, OR ANY
+ * DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
+ *
+ * 6. This License Agreement will automatically terminate upon a material
+ * breach of its terms and conditions.
+ *
+ * 7. Nothing in this License Agreement shall be deemed to create any
+ * relationship of agency, partnership, or joint venture between HCA and
+ * Licensee. This License Agreement does not grant permission to use HCA
+ * trademarks or trade name in a trademark sense to endorse or promote
+ * products or services of Licensee, or any third party.
+ *
+ * 8. By copying, installing or otherwise using Prothon, Licensee agrees
+ * to be bound by the terms and conditions of this License Agreement.
+ * ====================================================================
+ */
+
+
+// builtins.c
+
+#include <stdio.h>
+#include <string.h>
+
+#include <apr_strings.h>
+
+#include <prothon/prothon.h>
+#include <prothon/dict.h>
+#include "parser.h"
+#include "object.h"
+#include <prothon/prothon_dll.h>
+
+MODULE_DECLARE(Int);
+MODULE_DECLARE(IntGen);
+
+
+// ***************************** INT *******************************************
+
+#define INT_DATA_SIZE 8
+#define is_Int(objid) (has_proto_QUES(ist, objid, Int_OBJ))
+#define Int_value(objid) (objid->data.i64)
+
+static obj_p SYM_LIMIT;
+
+
+MODULE_START(Int)
+{
+ Int_OBJ = OBJ(INT_PROTO);
+ MODULE_SET_DOC(Int, "number object prototype");
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Int"), Int_OBJ);
+
+ /* Dependent objects */
+ OBJ(ZERO_INT) = new_int_obj(0);
+ OBJ(MAX_INT) = new_int_obj(MAX_INT_VAL);
+ OBJ(LONG_PROTO) = new_object(NULL);
+
+ add_doc_to_obj(ist, OBJ(LONG_PROTO), "Long integer number object prototype");
+}
+
+DEF(Int, __bool__QUES, NULL) {
+ if (Int_value(self)) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+
+DEF(Int, __hash__, NULL) {
+ i32_t i32 = (i32_t) Int_value(self);
+ return new_hash_obj((((i32*i32)<<(i32 & 16))+i32)*17);
+}
+
+DEF(Int, __abs__, NULL){
+ i64_t num = Int_value(self);
+ return new_int_obj(num < 0 ? -num : num);
+}
+
+DEF(Int, __neg__, NULL){
+ return new_int_obj( - Int_value(self) );
+}
+
+DEF(Int, __pos__, NULL){
+ return self;
+}
+
+DEF(Int, __add__, FORM_RPARAM){
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__ADD__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "Integer cannot be added to this object");
+ return OBJ(NONE);
+ }
+ return new_int_obj(Int_value(self) + Int_value(other));
+}
+
+DEF(Int, __div__, FORM_RPARAM){
+ obj_p res;
+ obj_p float_self, float_other, other = parms[1];
+ if (!is_Int(other)) {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__RDIV__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "Integer cannot be divided by this object");
+ return OBJ(NONE);
+ }
+ float_self = call_func1(ist, OBJ(FLOAT_PROTO), SYM(__COERCE__), self); if_exc_return NULL;
+ float_other = call_func1(ist, OBJ(FLOAT_PROTO), SYM(__COERCE__), other); if_exc_return NULL;
+ res = call_func1(ist, float_self, SYM(__DIV__), float_other);
+ del_unlock(float_self); del_unlock(float_other);
+ return res;
+}
+
+DEF(Int, __floordiv__, FORM_RPARAM){
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__RFLOORDIV__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "Integer cannot be floor divided by this object");
+ return OBJ(NONE);
+ }
+ if (Int_value(other) == 0) {
+ raise_exception(ist, OBJ(DIVIDEZERO_EXC), NULL);
+ return NULL;
+ }
+ return new_int_obj(Int_value(self) / Int_value(other));
+}
+
+DEF(Int, __mod__, FORM_RPARAM) {
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__RMOD__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "Integer cannot be modded by this object");
+ return OBJ(NONE);
+ }
+ if (Int_value(other) == 0) {
+ raise_exception(ist, OBJ(DIVIDEZERO_EXC), "modulo by zero");
+ return NULL;
+ }
+ return new_int_obj(Int_value(self) % Int_value(other));
+}
+
+DEF(Int, __mul__, FORM_RPARAM) {
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__MUL__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "Integer cannot be multiplied by this object");
+ return OBJ(NONE);
+ }
+ return new_int_obj(Int_value(self) * Int_value(other));
+}
+
+DEF(Int, __sub__, FORM_RPARAM) {
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__RSUB__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "This object cannot be subtracted from an Integer");
+ return OBJ(NONE);
+ }
+ return new_int_obj(Int_value(self) - Int_value(other));
+}
+
+DEF(Int, __pow__, FORM_RPARAM){
+ obj_p res;
+ obj_p float_self, float_other, other = parms[1];
+ float_self = call_func1(ist, OBJ(FLOAT_PROTO), SYM(__COERCE__), self); if_exc_return NULL;
+ float_other = call_func1(ist, OBJ(FLOAT_PROTO), SYM(__COERCE__), other); if_exc_return NULL;
+ res = call_func1(ist, float_self, SYM(__POW__), float_other);
+ del_unlock(float_self); del_unlock(float_other);
+ return res;
+}
+
+DEF(Int, cmp, FORM_RPARAM){
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__RCMP__), self);
+ raise_exception(ist, OBJ(TYPE_EXC), "This object cannot be compared to an Integer");
+ return OBJ(NONE);
+ }
+ if (Int_value(self) == Int_value(other))
+ return new_int_obj(0);
+ else if (Int_value(self) > Int_value(other))
+ return new_int_obj(1);
+ else
+ return new_int_obj(-1);
+}
+
+DEF(Int, __eq__QUES, FORM_RPARAM){
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ if (covers(other, self))
+ return call_func1(ist, other, SYM(__EQ__QUES), self);
+ return OBJ(PR_FALSE);
+ }
+ if (Int_value(self) == Int_value(other)) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+DEF(Int, __invert__, NULL){
+ return new_int_obj( ~ Int_value(self) );
+}
+
+DEF(Int, __xor__, FORM_RPARAM) {
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ raise_exception(ist, OBJ(TYPE_EXC), "object cannot be xor'd with an Integer");
+ return OBJ(NONE);
+ }
+ return new_int_obj(Int_value(self) ^ Int_value(other));
+}
+
+DEF(Int, __and__, FORM_RPARAM) {
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ raise_exception(ist, OBJ(TYPE_EXC), "object cannot be and'd with an Integer");
+ return OBJ(NONE);
+ }
+ return new_int_obj(Int_value(self) & Int_value(other));
+}
+
+DEF(Int, __or__, FORM_RPARAM) {
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ raise_exception(ist, OBJ(TYPE_EXC), "object cannot be or'd with an Integer");
+ return OBJ(NONE);
+ }
+ return new_int_obj(Int_value(self) | Int_value(other));
+}
+
+DEF(Int, __rshift__, FORM_RPARAM) {
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ raise_exception(ist, OBJ(TYPE_EXC), "object cannot be shifted with an Integer");
+ return OBJ(NONE);
+ }
+ return new_int_obj(Int_value(self) >> Int_value(other));
+}
+
+DEF(Int, __lshift__, FORM_RPARAM) {
+ obj_p other = parms[1];
+ if (!is_Int(other)) {
+ raise_exception(ist, OBJ(TYPE_EXC), "object cannot be shifted with an Integer");
+ return OBJ(NONE);
+ }
+ return new_int_obj(Int_value(self) << Int_value(other));
+}
+
+DEF(Int, __str__, NULL){
+ char str[24];
+ apr_snprintf(str, sizeof(str), LONG_LONG_FMT, (LONG_LONG_CAST)Int_value(self));
+ return new_string_obj(str);
+}
+
+DEF (Int, __gen__, NULL) {
+ obj_p gen_obj = new_int_obj(0);
+ gen_obj->immutable = FALSE;
+ gen_obj->attr_proto.proto = IntGen_OBJ;
+ set_attr(ist, gen_obj, SYM_LIMIT, self);
+ return gen_obj;
+}
+
+DEF(Int, chr, NULL) {
+ char s[1];
+ s[0] = (char) Int_value(self);
+ return new_string_n_obj(s, 1);
+}
+
+MODULE_END(Int);
+
+MODULE_START(IntGen)
+{
+ IntGen_OBJ = new_object(NULL);
+ MODULE_SET_DOC(Int, "number generator object prototype");
+}
+
+DEF (IntGen, next, NULL) {
+ obj_p limit, res;
+ if ( !(limit=get_attr(ist, self, SYM_LIMIT)) ||
+ Int_value(self) == Int_value(limit) ) {
+ if (limit) {
+ read_unlock(ist, self);
+ del_attr(ist, self, SYM_LIMIT);
+ read_lock(ist, self);
+ }
+ raise_exception(ist, OBJ(STOP_ITERATION_EXC), NULL);
+ return NULL;
+ }
+ res = new_int_obj(Int_value(self));
+ read_unlock(ist, self); write_lock(ist, self);
+ Int_value(self)++;
+ write_unlock(ist, self); read_lock(ist, self);
+ return res;
+}
+
+MODULE_END(IntGen);
+
+MAIN_MODULE_INIT(Int)
+{
+ SYM_LIMIT = sym(ist, "limit");
+
+ MODULE_SUB_INIT(Int);
+ MODULE_SUB_INIT(IntGen);
+}
Property changes on: trunk/src/builtins-int.c
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/src/builtins-list.c
===================================================================
--- trunk/src/builtins-list.c 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/src/builtins-list.c 2004-04-02 05:14:44 UTC (rev 255)
@@ -0,0 +1,500 @@
+/* ====================================================================
+ * The Prothon License Agreement, Version 1.1
+ *
+ * Copyright (c) 2004 Hahn Creative Applications, http://hahnca.com.
+ * All rights reserved.
+ *
+ * 1. This LICENSE AGREEMENT is between Hahn Creative Applications ("HCA"),
+ * and the Individual or Organization ("Licensee") accessing and otherwise
+ * using Prothon software in source or binary form and its associated
+ * documentation.
+ *
+ * 2. Subject to the terms and conditions of this License Agreement, HCA
+ * hereby grants Licensee a nonexclusive, royalty-free, world-wide license
+ * to reproduce, analyze, test, perform and/or display publicly, prepare
+ * derivative works, distribute, and otherwise use Prothon alone or in any
+ * derivative version, provided, however, that HCA's License Agreement and
+ * HCA's notice of copyright, i.e., "Copyright (c) 2004 Hahn Creative
+ * Applications; All Rights Reserved" are retained in Prothon alone or
+ * in any derivative version prepared by Licensee.
+ *
+ * 3. In the event Licensee prepares a derivative work that is based on or
+ * incorporates Prothon or any part thereof, and wants to make the
+ * derivative work available to others as provided herein, then Licensee
+ * hereby agrees to include in any such work a brief summary of the
+ * changes made to Prothon.
+ *
+ * 4. HCA is making Prothon available to Licensee on an "AS IS" basis.
+ * HCA MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY
+ * OF EXAMPLE, BUT NOT LIMITATION, HCA MAKES NO AND DISCLAIMS ANY
+ * REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS FOR ANY
+ * PARTICULAR PURPOSE OR THAT THE USE OF PROTHON WILL NOT INFRINGE ANY
+ * THIRD PARTY RIGHTS.
+ *
+ * 5. HCA SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PROTHON
+ * FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
+ * RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PROTHON, OR ANY
+ * DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
+ *
+ * 6. This License Agreement will automatically terminate upon a material
+ * breach of its terms and conditions.
+ *
+ * 7. Nothing in this License Agreement shall be deemed to create any
+ * relationship of agency, partnership, or joint venture between HCA and
+ * Licensee. This License Agreement does not grant permission to use HCA
+ * trademarks or trade name in a trademark sense to endorse or promote
+ * products or services of Licensee, or any third party.
+ *
+ * 8. By copying, installing or otherwise using Prothon, Licensee agrees
+ * to be bound by the terms and conditions of this License Agreement.
+ * ====================================================================
+ */
+
+
+// builtins.c
+
+#include <stdio.h>
+#include <string.h>
+
+#include <apr_strings.h>
+
+#include <prothon/prothon.h>
+#include <prothon/dict.h>
+#include "parser.h"
+#include "object.h"
+#include <prothon/prothon_dll.h>
+
+MODULE_DECLARE(List);
+
+static int seq_len(isp ist, obj_p seq) {
+ if (has_proto_QUES(ist, seq, OBJ(STRING_PROTO)))
+ return (int) strlen(strch(seq));
+ else return list_len(ist, seq);
+}
+
+static obj_p seq_item(isp ist, obj_p seq, int i) {
+ char s[2];
+ if (has_proto_QUES(ist, seq, OBJ(STRING_PROTO))) {
+ s[0] = strch(seq)[i];
+ s[1] = 0;
+ return new_string_obj(s);
+ } else
+ return list_item(ist, seq, i);
+}
+
+// ***************************** LIST ******************************************
+
+MODULE_START(List)
+{
+ list_p lstp;
+
+ List_OBJ = OBJ(LIST_PROTO);
+ MODULE_SET_DOC(List, "object prototype");
+ set_attr(ist, OBJ(OBJECT), sym(ist, "List"), List_OBJ);
+
+ lstp = List_OBJ->data.ptr = pr_malloc((LIST_OVERHEAD+2) * sizeof(list_t));
+ lstpsize(lstp) = 2;
+ lstplen(lstp) = 0;
+}
+
+DEF(List, __str__, NULL) {
+ return str_tuple_list(ist, self, "[", "]");
+}
+
+DEF(List, __getitem__, FORM_RPARAM) {
+ return get_sequence_item(ist, self, parms[1], SEQ_TYPE_LIST);
+}
+
+DEF(List, __setitem__, FORM_PARAM2) {
+ obj_p slice_item1, slice_item2, slice_item3;
+ obj_p slice = parms[1], value = parms[3];
+ int i, j, new_len, index1 = 0, index2 = 0, index3 = 0, slice1_empty=FALSE, slice2_empty=FALSE;
+ int exp_len, val_len, self_len, slice_len = list_len(ist, slice);
+ read_unlock(ist, self); write_lock(ist, self);
+ self_len = listlen(self);
+ slice_item1 = list_item(ist, slice,0);
+ if (slice_item1 == SLICEPARAM_EMPTY || slice_item1 == OBJ(NONE))
+ slice1_empty=TRUE;
+ else {
+ if (!has_proto_QUES(ist, slice_item1, OBJ(INT_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "List slice index must be an integer");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ index1 = (int)(slice_item1->data.i64);
+ if (index1 < 0) index1 += self_len;
+ if (index1 < 0 || index1 >= self_len) {
+ raise_exception(ist, OBJ(INDEX_EXC), "Index (%d) out of range", index1);
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ if (slice_len == 1) {
+ listitem(self, index1) = value;
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ }
+ if ( !has_proto_QUES(ist, value, List_OBJ) &&
+ !has_proto_QUES(ist, value, OBJ(TUPLE_PROTO)) &&
+ !has_proto_QUES(ist, value, OBJ(STRING_PROTO)) ) {
+ raise_exception(ist, OBJ(TYPE_EXC), "list slices may only be replaced with a sequence");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ if (slice_len == 3) {
+ slice_item3 = list_item(ist, slice,2);
+ if (slice_item3 == SLICEPARAM_EMPTY || slice_item3 == OBJ(NONE)) index3 = 1;
+ else {
+ if (!has_proto_QUES(ist, slice_item3, OBJ(INT_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "sequence slice index must be an integer");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ index3 = (int)(slice_item3->data.i64);
+ if (index3 == 0) {
+ raise_exception(ist, OBJ(INDEX_EXC), "slice step cannot be zero");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ }
+ } else index3 = 1;
+ slice_item2 = list_item(ist, slice,1);
+ if (slice_item2 == SLICEPARAM_EMPTY || slice_item2 == OBJ(NONE))
+ slice2_empty=TRUE;
+ else {
+ if (!has_proto_QUES(ist, slice_item2, OBJ(INT_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "sequence slice index must be an integer");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ index2 = (int)(slice_item2->data.i64);
+ if (index2 < 0) index2 += self_len;
+ if (index2 < 0 || index2 > self_len) {
+ raise_exception(ist, OBJ(INDEX_EXC), "Second index (%d) out of range", index2);
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ }
+ if (index3 > 0) {
+ if (slice1_empty) index1 = 0;
+ if (slice2_empty) index2 = self_len;
+ } else {
+ if (slice1_empty) index1 = self_len-1;
+ if (slice2_empty) index2 = -1;
+ }
+ val_len = seq_len(ist, value);
+ exp_len = (index2-index1+(index3-1))/index3;
+ exp_len = max(exp_len, 0);
+ if (slice_len==3) {
+ if (exp_len != val_len) {
+ raise_exception(ist, OBJ(INDEX_EXC), "extended slice assignment lengths do not match");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ if (index3 > 0)
+ for(i = index1, j=0; i < index2; i += index3, j++)
+ listitem(self, i) = seq_item(ist, value, j);
+ else
+ for(i = index1, j=0; i > index2; i += index3, j++)
+ listitem(self, i) = seq_item(ist, value, j);
+ } else {
+ listlen(self) = new_len = index1 + val_len + (self_len - index2);
+ if (new_len+1 > listsize(self)) {
+ listsize(self) = new_len+1;
+ self->data.ptr =
+ pr_realloc(self->data.ptr, (listsize(self)+LIST_OVERHEAD)*sizeof(list_t));
+ }
+ if (exp_len != val_len && index2 != self_len)
+ memmove( ((list_p)self->data.ptr)+LIST_OVERHEAD+index1+val_len,
+ ((list_p)self->data.ptr)+LIST_OVERHEAD+index2,
+ (self_len-index2) * sizeof(list_t) );
+ for(i = index1, j=0; j < val_len; i++, j++)
+ listitem(self, i) = seq_item(ist, value, j);
+ }
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+}
+
+DEF(List, __delitem__, FORM_RPARAM) {
+ obj_p slice_item1, slice_item2, slice_item3;
+ obj_p slice = parms[1];
+ int i, j, new_len, index1 = 0, index2 = 0, index3 = 0, slice1_empty=FALSE, slice2_empty=FALSE;
+ int exp_len, self_len, slice_len = list_len(ist, slice);
+ read_unlock(ist, self); write_lock(ist, self);
+ self_len = listlen(self);
+ slice_item1 = list_item(ist, slice,0);
+ if (slice_item1 == SLICEPARAM_EMPTY || slice_item1 == OBJ(NONE))
+ slice1_empty=TRUE;
+ else {
+ if (!has_proto_QUES(ist, slice_item1, OBJ(INT_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "List slice index must be an integer");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ index1 = (int)(slice_item1->data.i64);
+ if (index1 < 0) index1 += self_len;
+ if (index1 < 0 || index1 >= self_len) {
+ raise_exception(ist, OBJ(INDEX_EXC), "Index (%d) out of range", index1);
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ if (slice_len == 1) {
+ if (index1 != self_len-1)
+ memmove( ((list_p)self->data.ptr)+LIST_OVERHEAD+index1,
+ ((list_p)self->data.ptr)+LIST_OVERHEAD+index1+1,
+ (self_len-1-index1) * sizeof(list_t) );
+ listlen(self)--;
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ }
+ if (slice_len == 3) {
+ slice_item3 = list_item(ist, slice,2);
+ if (slice_item3 == SLICEPARAM_EMPTY || slice_item3 == OBJ(NONE)) index3 = 1;
+ else {
+ if (!has_proto_QUES(ist, slice_item3, OBJ(INT_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "sequence slice index must be an integer");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ index3 = (int)(slice_item3->data.i64);
+ if (index3 == 0) {
+ raise_exception(ist, OBJ(INDEX_EXC), "slice step cannot be zero");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ }
+ } else index3 = 1;
+ slice_item2 = list_item(ist, slice,1);
+ if (slice_item2 == SLICEPARAM_EMPTY || slice_item2 == OBJ(NONE))
+ slice2_empty=TRUE;
+ else {
+ if (!has_proto_QUES(ist, slice_item2, OBJ(INT_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "sequence slice index must be an integer");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ index2 = (int)(slice_item2->data.i64);
+ if (index2 < 0) index2 += self_len;
+ if (index2 < 0 || index2 > self_len) {
+ raise_exception(ist, OBJ(INDEX_EXC), "Second index (%d) out of range", index2);
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ }
+ if (index3 > 0) {
+ if (slice1_empty) index1 = 0;
+ if (slice2_empty) index2 = self_len;
+ } else {
+ if (slice1_empty) index1 = self_len-1;
+ if (slice2_empty) index2 = -1;
+ }
+ exp_len = (index2-index1+(index3-1))/index3;
+ exp_len = max(exp_len, 0);
+ if (index3 != 1) {
+ if (index3 > 0) {
+ for(i = index1, j=0; i < index2; i += index3, j++)
+ if (i != self_len-1)
+ memmove( ((list_p)self->data.ptr)+LIST_OVERHEAD+(i-j),
+ ((list_p)self->data.ptr)+LIST_OVERHEAD+(i-j)+1,
+ (self_len-1-i) * sizeof(list_t) );
+ } else {
+ for(i = index1, j=0; i > index2; i += index3, j++)
+ if (i != self_len-1)
+ memmove( ((list_p)self->data.ptr)+LIST_OVERHEAD+i,
+ ((list_p)self->data.ptr)+LIST_OVERHEAD+i+1,
+ (self_len-1-i) * sizeof(list_t) );
+ }
+ } else {
+ listlen(self) = new_len = index1 + (self_len - index2);
+ if (exp_len != 0 && index2 != self_len)
+ memmove( ((list_p)self->data.ptr)+LIST_OVERHEAD+index1,
+ ((list_p)self->data.ptr)+LIST_OVERHEAD+index2,
+ (self_len-index2) * sizeof(list_t) );
+ }
+ listlen(self) -= exp_len;
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+}
+
+DEF(List, __add__, FORM_RPARAM) {
+ int i;
+ obj_p res = clone_list_obj(ist, self);
+ if (has_proto_QUES(ist, parms[1], OBJ(SEQ_PROTO)) && !has_proto_QUES(ist, parms[1], OBJ(STRING_PROTO)))
+ for(i=0; i < list_len(ist, parms[1]); i++)
+ list_append(ist, res, list_item(ist, parms[1], i));
+ else
+ list_append(ist, res, parms[1]);
+ return res;
+}
+
+DEF(List, __mul__, FORM_RPARAM){
+ obj_p res;
+ list_p lstp, selfp = ((list_p)(self->data.ptr))+LIST_OVERHEAD;
+ int i, size, times, len = list_len(ist, self);
+ if (!has_proto_QUES(ist, parms[1], OBJ(INT_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "multiply times parameter must be an integer");
+ return NULL;
+ }
+ times = (int)parms[1]->data.i64;
+ size = len*times;
+ if(times == 0) return new_list_obj(0);
+ if(times == 1) return self;
+ res = new_object(List_OBJ);
+ lstp = res->data.ptr = pr_malloc((LIST_OVERHEAD+size)*sizeof(list_t));
+ if(!lstp) {
+ raise_exception(ist, OBJ(OUTOFMEMORY_EXC), "memory allocation failed for list multiplication");
+ return NULL;
+ }
+ res->data_type = OBJ_TYPE_DATAPTR;
+ lstpsize(lstp) = size;
+ lstplen(lstp) = size;
+ for(i=0; i < times; i++)
+ memcpy(lstp+LIST_OVERHEAD+(i*len), selfp, len*sizeof(list_t));
+ return res;
+}
+
+DEF(List, append_BANG, FORM_RPARAM) {
+ list_p lstp;
+ read_unlock(ist, self); write_lock(ist, self);
+ lstp = self->data.ptr;
+ if(lstplen(lstp) == lstpsize(lstp)) {
+ lstpsize(lstp) *= LIST_GROWTH_FACTOR;
+ lstp = pr_realloc(lstp, (LIST_OVERHEAD+lstpsize(lstp)) * sizeof(list_t));
+ self->data.ptr = lstp;
+ }
+ listitem(self, listlen(self)++) = parms[1];
+ write_unlock(ist, self); read_lock(ist, self);
+ return self;
+}
+
+DEF(List, extend_BANG, FORM_RPARAM) {
+ list_p selfp, otherp;
+ int self_len, other_len;
+ read_unlock(ist, self); write_lock(ist, self);
+ if (!has_proto_QUES(ist, parms[1], OBJ(TUPLE_PROTO)) && !has_proto_QUES(ist, parms[1], List_OBJ)) {
+ raise_exception(ist, OBJ(TYPE_EXC), "extend parameter must be a tuple or list");
+ return NULL;
+ }
+ selfp = self->data.ptr;
+ self_len = lstplen(selfp);
+ otherp = parms[1]->data.ptr;
+ other_len = lstplen(otherp);
+ if(self_len+other_len > lstpsize(selfp)) {
+ lstpsize(selfp) = (self_len+other_len) * LIST_GROWTH_FACTOR;
+ selfp = pr_realloc(selfp, (LIST_OVERHEAD+lstpsize(selfp)) * sizeof(list_t));
+ self->data.ptr = selfp;
+ }
+ memcpy( selfp+LIST_OVERHEAD+self_len, otherp+LIST_OVERHEAD, other_len*sizeof(list_t));
+ lstplen(selfp) = self_len+other_len;
+ write_unlock(ist, self); read_lock(ist, self);
+ return self;
+}
+
+DEF(List, insert_BANG, FORM_PARAM2) {
+ int index, self_len;
+ list_p selfp;
+ if (!has_proto_QUES(ist, parms[1], OBJ(INT_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "index (i) parameter must be an integer");
+ return NULL;
+ }
+ read_unlock(ist, self); write_lock(ist, self);
+ index = (int)parms[1]->data.i64;
+ selfp = self->data.ptr;
+ self_len = lstplen(selfp);
+ if (index < 0 || index > self_len) {
+ raise_exception(ist, OBJ(INDEX_EXC), "index (i) parameter out of range");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ if(lstplen(selfp) == lstpsize(selfp)) {
+ lstpsize(selfp) *= LIST_GROWTH_FACTOR;
+ selfp = pr_realloc(selfp, (LIST_OVERHEAD+lstpsize(selfp))*sizeof(list_t));
+ self->data.ptr = selfp;
+ }
+ if (index < self_len)
+ memmove( selfp+LIST_OVERHEAD+index+1, selfp+LIST_OVERHEAD+index,
+ (self_len-index)*sizeof(list_t) );
+ listitem(self, index) = parms[3];
+ lstplen(selfp)++;
+ write_unlock(ist, self); read_lock(ist, self);
+ return self;
+}
+
+DEF(List, remove_BANG, FORM_RPARAM) {
+ int i, self_len;
+ list_p selfp;
+ read_unlock(ist, self); write_lock(ist, self);
+ selfp = self->data.ptr;
+ self_len = lstplen(selfp);
+ for (i=0; i < self_len; i++) {
+ if (call_func1(ist, listitem(self, i), SYM(__EQ__QUES), parms[1]) == OBJ(PR_TRUE)) break;
+ if_exc_return NULL;
+ }
+ if (i == self_len) {
+ raise_exception(ist, OBJ(INDEX_EXC), "item not found to remove from list");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ if (i < self_len-1)
+ memmove( selfp+LIST_OVERHEAD+i, selfp+LIST_OVERHEAD+i+1,
+ (self_len-1-i)*sizeof(list_t) );
+ lstplen(selfp)--;
+ write_unlock(ist, self); read_lock(ist, self);
+ return self;
+}
+
+DEF(List, pop_BANG, list2(SYM(RPARAM),OBJ(NONE))) {
+ int index, self_len;
+ list_p selfp;
+ obj_p res;
+ if (parms[1] != OBJ(NONE) && !has_proto_QUES(ist, parms[1], OBJ(INT_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "pop index (i) parameter must be an integer");
+ return NULL;
+ }
+ read_unlock(ist, self); write_lock(ist, self);
+ selfp = self->data.ptr;
+ self_len = lstplen(selfp);
+ if (parms[1] == OBJ(NONE))
+ index = self_len-1;
+ else
+ index = (int)(parms[1]->data.i64);
+ if (index < 0 || index > self_len-1) {
+ raise_exception(ist, OBJ(INDEX_EXC), "index (i) parameter out of range");
+ write_unlock(ist, self); read_lock(ist, self);
+ return NULL;
+ }
+ res = listitem(self, index);
+ if (index < self_len-1)
+ memmove( selfp+LIST_OVERHEAD+index, selfp+LIST_OVERHEAD+index+1,
+ (self_len-1-index)*sizeof(list_t) );
+ lstplen(selfp)--;
+ write_unlock(ist, self); read_lock(ist, self);
+ return res;
+}
+
+DEF(List, reverse_BANG, NULL) {
+ int self_len;
+ list_p selfp, p1, p2;
+ read_unlock(ist, self); write_lock(ist, self);
+ selfp = self->data.ptr;
+ self_len = lstplen(selfp);
+ p1 = selfp+LIST_OVERHEAD;
+ p2 = selfp+LIST_OVERHEAD+self_len-1;
+ while(p1<p2) {
+ list_t tmp = *p2;
+ *p2 = *p1;
+ *p1 = tmp;
+ p1++; p2--;
+ }
+ write_unlock(ist, self); read_lock(ist, self);
+ return self;
+}
+
+MODULE_END(List);
+
+
+MAIN_MODULE_INIT(List)
+{
+ MODULE_SUB_INIT(List);
+}
Property changes on: trunk/src/builtins-list.c
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/src/builtins-string.c
===================================================================
--- trunk/src/builtins-string.c 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/src/builtins-string.c 2004-04-02 05:14:44 UTC (rev 255)
@@ -0,0 +1,294 @@
+/* ====================================================================
+ * The Prothon License Agreement, Version 1.1
+ *
+ * Copyright (c) 2004 Hahn Creative Applications, http://hahnca.com.
+ * All rights reserved.
+ *
+ * 1. This LICENSE AGREEMENT is between Hahn Creative Applications ("HCA"),
+ * and the Individual or Organization ("Licensee") accessing and otherwise
+ * using Prothon software in source or binary form and its associated
+ * documentation.
+ *
+ * 2. Subject to the terms and conditions of this License Agreement, HCA
+ * hereby grants Licensee a nonexclusive, royalty-free, world-wide license
+ * to reproduce, analyze, test, perform and/or display publicly, prepare
+ * derivative works, distribute, and otherwise use Prothon alone or in any
+ * derivative version, provided, however, that HCA's License Agreement and
+ * HCA's notice of copyright, i.e., "Copyright (c) 2004 Hahn Creative
+ * Applications; All Rights Reserved" are retained in Prothon alone or
+ * in any derivative version prepared by Licensee.
+ *
+ * 3. In the event Licensee prepares a derivative work that is based on or
+ * incorporates Prothon or any part thereof, and wants to make the
+ * derivative work available to others as provided herein, then Licensee
+ * hereby agrees to include in any such work a brief summary of the
+ * changes made to Prothon.
+ *
+ * 4. HCA is making Prothon available to Licensee on an "AS IS" basis.
+ * HCA MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY
+ * OF EXAMPLE, BUT NOT LIMITATION, HCA MAKES NO AND DISCLAIMS ANY
+ * REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS FOR ANY
+ * PARTICULAR PURPOSE OR THAT THE USE OF PROTHON WILL NOT INFRINGE ANY
+ * THIRD PARTY RIGHTS.
+ *
+ * 5. HCA SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PROTHON
+ * FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
+ * RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PROTHON, OR ANY
+ * DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
+ *
+ * 6. This License Agreement will automatically terminate upon a material
+ * breach of its terms and conditions.
+ *
+ * 7. Nothing in this License Agreement shall be deemed to create any
+ * relationship of agency, partnership, or joint venture between HCA and
+ * Licensee. This License Agreement does not grant permission to use HCA
+ * trademarks or trade name in a trademark sense to endorse or promote
+ * products or services of Licensee, or any third party.
+ *
+ * 8. By copying, installing or otherwise using Prothon, Licensee agrees
+ * to be bound by the terms and conditions of this License Agreement.
+ * ====================================================================
+ */
+
+
+// builtins.c
+
+#include <stdio.h>
+#include <string.h>
+
+#include <apr_strings.h>
+
+#include <prothon/prothon.h>
+#include <prothon/dict.h>
+#include "parser.h"
+#include "object.h"
+#include <prothon/prothon_dll.h>
+
+#define is_String(objid) (has_proto_QUES(ist, objid, String_OBJ))
+
+
+MODULE_DECLARE(String);
+MODULE_DECLARE(StringGen);
+
+
+MODULE_START(String)
+{
+ String_OBJ = OBJ(STRING_PROTO);
+ MODULE_SET_DOC(String, "string object prototype");
+ set_attr(ist, OBJ(OBJECT), sym(ist, "String"), String_OBJ);
+}
+
+DEF(String, __str__, NULL) {
+ return self;
+}
+
+DEF(String, __hash__, NULL) {
+ i32_t res = 0x9a7c5e3;
+ char *p;
+ for(p=strch(self); *p; p++) res += 131 * (*p);
+ return new_hash_obj(res);
+}
+
+DEF(String, __objlist__, FORM_RPARAM) {
+ return parms[1];
+}
+
+DEF(String, __getitem__, FORM_RPARAM) {
+ return get_sequence_item(ist, self, parms[1], SEQ_TYPE_STRING);
+}
+
+DEF(String, __setitem__, FORM_RPARAM) {
+ raise_exception(ist, OBJ(MUTABLE_EXC), "strings may not be modifed");
+ return NULL;
+}
+
+DEF(String, __delitem__, NULL) {
+ raise_exception(ist, OBJ(MUTABLE_EXC), "strings may not be modifed");
+ return NULL;
+}
+
+DEF(String, cmp, FORM_RPARAM){
+ obj_p other = parms[1];
+ if (self == other)
+ return new_int_obj(0);
+ if (!is_String(other)) {
+ raise_exception(ist, OBJ(TYPE_EXC), "Cannot compare a string and non-string");
+ return NULL;
+ }
+ return new_int_obj(strcmp(strch(self), strch(other)));
+}
+
+DEF(String, __add__, FORM_RPARAM){
+ obj_p obj, other = parms[1];
+ pr_str_p obj_str;
+ size_t slen, olen, tlen;
+ if (!is_String(other)) other = call_func0(ist, other, SYM(__STR__));
+ slen = pr_strlen(self); olen = pr_strlen(other);
+ tlen = slen + olen;
+ obj = new_object(String_OBJ);
+ if (tlen < IMMEDIATE_DATA_LEN) {
+ obj->data_type = OBJ_TYPE_IMMDATA;
+ obj->imm_data_len = (int) tlen;
+ memcpy(&(obj->data.str[0]), strch(self), slen);
+ memcpy(&(obj->data.str[slen]), strch(other), olen);
+ obj->data.str[tlen] = 0;
+ } else {
+ obj_str = obj_malloc(obj, sizeof(pr_str_t)+tlen+1);
+ obj_str->len = tlen;
+ memcpy(&(obj_str->str[0]), strch(self), slen);
+ memcpy(&(obj_str->str[slen]), strch(other), olen);
+ obj_str->str[tlen] = 0;
+ }
+ obj->immutable = TRUE;
+ return obj;
+}
+
+DEF(String, __mul__, FORM_RPARAM){
+ obj_p obj;
+ pr_str_p obj_str;
+ size_t i, times, tlen, len = pr_strlen(self);
+ if (!has_proto_QUES(ist, parms[1], OBJ(INT_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "multiply times parameter must be an integer");
+ return NULL;
+ }
+ times = (size_t) parms[1]->data.i64;
+ if(times == 0) return new_string_obj("");
+ if(times == 1) return self;
+ tlen = len*times+1;
+ obj = new_object(String_OBJ);
+ if (tlen < IMMEDIATE_DATA_LEN) {
+ obj->data_type = OBJ_TYPE_IMMDATA;
+ obj->imm_data_len = (int) tlen;
+ for(i=0; i < times; i++)
+ memcpy(obj->data.str+i*len, strch(self), len);
+ obj->data.str[tlen] = 0;
+ } else {
+ obj_str = obj_malloc(obj, sizeof(pr_str_t)+tlen+1);
+ if(!obj_str) {
+ raise_exception(ist, OBJ(OUTOFMEMORY_EXC), "memory allocation failed for string multiplication");
+ return NULL;
+ }
+ obj_str->len = tlen;
+ for(i=0; i < times; i++)
+ memcpy(obj_str->str+i*len, strch(self), len);
+ obj_str->str[tlen] = 0;
+ }
+ obj->immutable = TRUE;
+ return obj;
+}
+
+DEF(String, __gen__, NULL) {
+ obj_p gen_obj = new_object(StringGen_OBJ);
+ gen_obj->data_type = OBJ_TYPE_DATAPTR;
+ gen_obj->data.ptr = strch(self);
+ set_attr(ist, gen_obj, sym(ist, "saved_string"), self);
+ return gen_obj;
+}
+
+DEF(String, ord, NULL) {
+ return new_int_obj((int)(*strch(self)));
+}
+
+DEF(String, join, FORM_RPARAM) {
+ char *self_str, *dest_ptr;
+ pr_str_p obj_str;
+ obj_p obj, list, str_list;
+ int i, llen;
+ size_t ofs, self_len, tlen;
+ if (!has_proto_QUES(ist, parms[1], OBJ(LIST_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "join function parameter must be a list");
+ return NULL;
+ }
+ list = parms[1];
+ llen = list_len(ist, parms[1]);
+ if (!llen) return new_string_obj("");
+ str_list = new_list_obj(llen);
+ self_str = strch(self);
+ self_len = pr_strlen(self);
+ tlen = 0;
+ for (i=0; i < llen; i++) {
+ obj_p str_obj = call_func0(ist, list_item(ist, list, i), SYM(__STR__)); if_exc_return NULL;
+ list_append(ist, str_list, str_obj);
+ tlen += pr_strlen(str_obj);
+ if (i != llen-1) tlen += self_len;
+ }
+ obj = new_object(String_OBJ);
+ if (tlen < IMMEDIATE_DATA_LEN) {
+ obj->data_type = OBJ_TYPE_IMMDATA;
+ obj->imm_data_len = (int) tlen;
+ dest_ptr = obj->data.str;
+ } else {
+ obj_str = obj_malloc(obj, sizeof(pr_str_t)+tlen+1);
+ if(!obj_str) {
+ raise_exception(ist, OBJ(OUTOFMEMORY_EXC), "memory allocation failed for string multiplication");
+ return NULL;
+ }
+ obj_str->len = tlen;
+ dest_ptr = obj_str->str;
+ }
+ for(i=0, ofs=0; i < llen; i++) {
+ obj_p str_obj = list_item(ist, str_list, i);
+ size_t str_len = pr_strlen(str_obj);
+ memcpy(dest_ptr+ofs, strch(str_obj), str_len);
+ ofs += str_len;
+ if (i != llen-1) {
+ memcpy(dest_ptr+ofs, self_str, self_len);
+ ofs += self_len;
+ }
+ }
+ dest_ptr[tlen] = 0;
+ set_immutable(obj);
+ del_unlock(str_list);
+ return obj;
+}
+
+DEF(String, __in__QUES, FORM_RPARAM) {
+ if (!has_proto_QUES(ist, parms[1], String_OBJ))
+ return call_func1(ist, parms[1], SYM(__RIN__QUES), self);
+ if (strstr(strch(parms[1]), strch(self))) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+
+DEF(String, __notin__QUES, FORM_RPARAM) {
+ if (!has_proto_QUES(ist, parms[1], String_OBJ))
+ return call_func1(ist, parms[1], SYM(__RNOTIN__QUES), self);
+ if (strstr(strch(parms[1]), strch(self))) return OBJ(PR_FALSE);
+ else return OBJ(PR_TRUE);
+}
+
+DEF(String, len, NULL) {
+ return new_int_obj(pr_strlen(self));
+}
+
+MODULE_END(String);
+
+MODULE_START(StringGen)
+{
+ StringGen_OBJ = new_object(NULL);
+}
+
+DEF(StringGen, next, NULL) {
+ int ch;
+ obj_p res = NULL;
+ char* res_str;
+ write_lock(ist, self);
+ if ((ch = *strch(self))) {
+ ((char*)(self->data.ptr))++;
+ res = new_object(String_OBJ);
+ res_str = (char*)obj_malloc(res, 2);
+ res_str[0] = ch;
+ res_str[1] = 0;
+ } else
+ raise_exception(ist, OBJ(STOP_ITERATION_EXC), NULL);
+ write_unlock(ist, self);
+ return res;
+}
+
+MODULE_END(StringGen);
+
+
+MAIN_MODULE_INIT(String)
+{
+ MODULE_SUB_INIT(String);
+ MODULE_SUB_INIT(StringGen);
+}
Property changes on: trunk/src/builtins-string.c
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/src/builtins-tuple.c
===================================================================
--- trunk/src/builtins-tuple.c 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/src/builtins-tuple.c 2004-04-02 05:14:44 UTC (rev 255)
@@ -0,0 +1,306 @@
+/* ====================================================================
+ * The Prothon License Agreement, Version 1.1
+ *
+ * Copyright (c) 2004 Hahn Creative Applications, http://hahnca.com.
+ * All rights reserved.
+ *
+ * 1. This LICENSE AGREEMENT is between Hahn Creative Applications ("HCA"),
+ * and the Individual or Organization ("Licensee") accessing and otherwise
+ * using Prothon software in source or binary form and its associated
+ * documentation.
+ *
+ * 2. Subject to the terms and conditions of this License Agreement, HCA
+ * hereby grants Licensee a nonexclusive, royalty-free, world-wide license
+ * to reproduce, analyze, test, perform and/or display publicly, prepare
+ * derivative works, distribute, and otherwise use Prothon alone or in any
+ * derivative version, provided, however, that HCA's License Agreement and
+ * HCA's notice of copyright, i.e., "Copyright (c) 2004 Hahn Creative
+ * Applications; All Rights Reserved" are retained in Prothon alone or
+ * in any derivative version prepared by Licensee.
+ *
+ * 3. In the event Licensee prepares a derivative work that is based on or
+ * incorporates Prothon or any part thereof, and wants to make the
+ * derivative work available to others as provided herein, then Licensee
+ * hereby agrees to include in any such work a brief summary of the
+ * changes made to Prothon.
+ *
+ * 4. HCA is making Prothon available to Licensee on an "AS IS" basis.
+ * HCA MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY
+ * OF EXAMPLE, BUT NOT LIMITATION, HCA MAKES NO AND DISCLAIMS ANY
+ * REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS FOR ANY
+ * PARTICULAR PURPOSE OR THAT THE USE OF PROTHON WILL NOT INFRINGE ANY
+ * THIRD PARTY RIGHTS.
+ *
+ * 5. HCA SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PROTHON
+ * FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
+ * RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PROTHON, OR ANY
+ * DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
+ *
+ * 6. This License Agreement will automatically terminate upon a material
+ * breach of its terms and conditions.
+ *
+ * 7. Nothing in this License Agreement shall be deemed to create any
+ * relationship of agency, partnership, or joint venture between HCA and
+ * Licensee. This License Agreement does not grant permission to use HCA
+ * trademarks or trade name in a trademark sense to endorse or promote
+ * products or services of Licensee, or any third party.
+ *
+ * 8. By copying, installing or otherwise using Prothon, Licensee agrees
+ * to be bound by the terms and conditions of this License Agreement.
+ * ====================================================================
+ */
+
+
+// builtins.c
+
+#include <stdio.h>
+#include <string.h>
+
+#include <apr_strings.h>
+
+#include <prothon/prothon.h>
+#include <prothon/dict.h>
+#include "parser.h"
+#include "object.h"
+#include <prothon/prothon_dll.h>
+
+MODULE_DECLARE(Tuple);
+MODULE_DECLARE(Tgen);
+
+// ***************************** TUPLE ******************************************
+
+MODULE_START(Tuple)
+{
+ list_p lstp;
+
+ Tuple_OBJ = OBJ(TUPLE_PROTO);
+ MODULE_SET_DOC(Tuple, "object prototype");
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Tuple"), Tuple_OBJ);
+
+ lstp = Tuple_OBJ->data.ptr = pr_malloc((LIST_OVERHEAD+2) * sizeof(list_t));
+ lstpsize(lstp) = 2;
+ lstplen(lstp) = 0;
+}
+
+DEF(Tuple, __str__, NULL) {
+ return str_tuple_list(ist, self, "(", ")");
+}
+
+DEF(Tuple, __getitem__, FORM_RPARAM) {
+ return get_sequence_item(ist, self, parms[1], SEQ_TYPE_TUPLE);
+}
+
+DEF(Tuple, __setitem__, FORM_RPARAM) {
+ raise_exception(ist, OBJ(MUTABLE_EXC), "tuples may not be modifed");
+ return NULL;
+}
+
+DEF(Tuple, __delitem__, NULL) {
+ raise_exception(ist, OBJ(MUTABLE_EXC), "tuples may not be modifed");
+ return NULL;
+}
+
+DEF(Tuple, __objlist__, FORM_RPARAM) {
+ return self;
+}
+
+DEF(Tuple, cmp, FORM_RPARAM) {
+ int i, llen, tlen, mlen;
+ obj_p res;
+ obj_p self_item, tgt_item, tgt_list;
+ if (!has_proto_QUES(ist, parms[1], OBJ(SEQ_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "sequence can only be compared to a sequence");
+ return NULL;
+ }
+ llen = list_len(ist, self);
+ tgt_list = parms[1];
+ tlen = list_len(ist, tgt_list);
+ mlen = min(llen, tlen);
+ for(i=0; i < mlen; i++) {
+ self_item = list_item(ist, self, i);
+ tgt_item = list_item(ist, tgt_list, i);
+ res = call_func1(ist, self_item, SYM(CMP), tgt_item); if_exc_return NULL;
+ if (res->data.i64)
+ return new_int_obj(res->data.i64);
+ }
+ if (llen < tlen) return new_int_obj(-1);
+ if (llen > tlen) return new_int_obj(+1);
+ return OBJ(ZERO_INT);
+}
+
+DEF(Tuple, __eq__QUES, FORM_RPARAM) {
+ int i, llen, tlen;
+ obj_p self_item, tgt_item, tgt_list, false_obj = OBJ(PR_FALSE);
+ if (!has_proto_QUES(ist, parms[1], OBJ(SEQ_PROTO))) return false_obj;
+ llen = list_len(ist, self);
+ tgt_list = parms[1];
+ tlen = list_len(ist, tgt_list);
+ if (llen != tlen) return false_obj;
+ for(i=0; i < llen; i++) {
+ self_item = list_item(ist, self, i);
+ tgt_item = list_item(ist, tgt_list, i);
+ if (call_func1(ist, self_item, SYM(__EQ__QUES), tgt_item) == false_obj)
+ return false_obj;
+ else if_exc_return NULL;
+ }
+ return OBJ(PR_TRUE);
+}
+
+DEF(Tuple, __rin__QUES, FORM_RPARAM) {
+ int i, llen = list_len(ist, self);
+ obj_p item, tgt = parms[1];
+ for(i=0; i < llen; i++) {
+ item = list_item(ist, self, i);
+ if (call_func1(ist, item, SYM(__EQ__QUES), tgt) == OBJ(PR_TRUE))
+ return OBJ(PR_TRUE);
+ else if_exc_return NULL;
+ }
+ return OBJ(PR_FALSE);
+}
+
+DEF(Tuple, __rnotin__QUES, FORM_RPARAM) {
+ int i, llen = list_len(ist, self);
+ obj_p item, tgt = parms[1];
+ for(i=0; i < llen; i++) {
+ item = list_item(ist, self, i);
+ if (call_func1(ist, item, SYM(__EQ__QUES), tgt) == OBJ(PR_TRUE))
+ return OBJ(PR_FALSE);
+ else if_exc_return NULL;
+ }
+ return OBJ(PR_TRUE);
+}
+
+DEF(Tuple, __add__, FORM_RPARAM) {
+ int i;
+ obj_p res = clone_list_obj(ist, self);
+ if (has_proto_QUES(ist, parms[1], OBJ(SEQ_PROTO)) && !has_proto_QUES(ist, parms[1], OBJ(STRING_PROTO)))
+ for(i=0; i < list_len(ist, parms[1]); i++)
+ list_append(ist, res, list_item(ist, parms[1], i));
+ else
+ list_append(ist, res, parms[1]);
+ switch_proto_to(ist, res, Tuple_OBJ);
+ return res;
+}
+
+DEF(Tuple, __mul__, FORM_RPARAM){
+ obj_p res;
+ list_p lstp, selfp = ((list_p)(self->data.ptr))+LIST_OVERHEAD;
+ int i, size, times, len = list_len(ist, self);
+ if (!has_proto_QUES(ist, parms[1], OBJ(INT_PROTO))) {
+ raise_exception(ist, OBJ(TYPE_EXC), "multiply times parameter must be an integer");
+ return NULL;
+ }
+ times = (int)parms[1]->data.i64;
+ size = len*times;
+ if(times == 0) {
+ obj_p res = new_tuple_obj(0);
+ res ->immutable = TRUE;
+ return res;
+ }
+ if(times == 1) return self;
+ res = new_object(OBJ(TUPLE_PROTO));
+ lstp = res->data.ptr = pr_malloc((LIST_OVERHEAD+size)*sizeof(list_t));
+ if(!lstp) {
+ raise_exception(ist, OBJ(OUTOFMEMORY_EXC), "memory allocation failed for tuple multiplication");
+ return NULL;
+ }
+ res->data_type = OBJ_TYPE_DATAPTR;
+ lstpsize(lstp) = size;
+ lstplen(lstp) = size;
+ for(i=0; i < times; i++)
+ memcpy(lstp+LIST_OVERHEAD+(i*len), selfp, len*sizeof(list_t));
+ return res;
+}
+
+DEF(Tuple, len, NULL) {
+ return new_int_obj(list_len(ist, self));
+}
+
+DEF(Tuple, min, NULL) {
+ int i, llen = list_len(ist, self);
+ obj_p min_item, cmp_obj;
+ if (llen == 0) return OBJ(NONE);
+ if (llen == 1) return list_item(ist, self, 0);
+ cmp_obj = call_func1(ist, list_item(ist, self, 0), SYM(CMP), list_item(ist, self, 1)); if_exc_return NULL;
+ if (cmp_obj->data.i64 < 0) min_item = list_item(ist, self, 0);
+ else min_item = list_item(ist, self, 1);
+ for(i=2; i < llen; i++) {
+ cmp_obj = call_func1(ist, list_item(ist, self, i), SYM(CMP), min_item); if_exc_return NULL;
+ if (cmp_obj->data.i64 < 0) min_item = list_item(ist, self, i);
+ }
+ return min_item;
+}
+
+DEF(Tuple, max, NULL) {
+ int i, llen = list_len(ist, self);
+ obj_p max_item, cmp_obj;
+ if (llen == 0) return OBJ(NONE);
+ if (llen == 1) return list_item(ist, self, 0);
+ cmp_obj = call_func1(ist, list_item(ist, self, 0), SYM(CMP), list_item(ist, self, 1)); if_exc_return NULL;
+ if (cmp_obj->data.i64 > 0) max_item = list_item(ist, self, 0);
+ else max_item = list_item(ist, self, 1);
+ for(i=2; i < llen; i++) {
+ cmp_obj = call_func1(ist, list_item(ist, self, i), SYM(CMP), max_item); if_exc_return NULL;
+ if (cmp_obj->data.i64 > 0) max_item = list_item(ist, self, i);
+ }
+ return max_item;
+}
+
+DEF(Tuple, count, FORM_RPARAM) {
+ int i, cnt=0, llen = list_len(ist, self);
+ for (i=0; i < llen; i++) {
+ if (call_func1(ist, list_item(ist, self, i), SYM(__EQ__QUES), parms[1]) == OBJ(PR_TRUE))
+ cnt++;
+ if_exc_return NULL;
+ }
+ return new_int_obj(cnt);
+}
+
+DEF(Tuple, index, FORM_RPARAM) {
+ int i, llen = list_len(ist, self);
+ for (i=0; i < llen; i++) {
+ if (call_func1(ist, list_item(ist, self, i), SYM(__EQ__QUES), parms[1]) == OBJ(PR_TRUE))
+ return new_int_obj(i);
+ if_exc_return NULL;
+ }
+ raise_exception(ist, OBJ(INDEX_EXC), "item not found in index search");
+ return NULL;
+}
+
+DEF(Tuple, __gen__, NULL) {
+ obj_p list_obj, gen_obj = new_object(Tgen_OBJ);
+ gen_obj->data_type = OBJ_TYPE_DATAPTR;
+ gen_obj->data.ptr = list_obj = clone_list_obj(ist, self);
+ listlen(list_obj) = 0;
+ return gen_obj;
+}
+
+
+//*************************** TUPLE GENERATOR OBJECT **************************
+MODULE_START(Tgen)
+{
+ Tgen_OBJ = new_object(NULL);
+}
+
+DEF(Tgen, next, NULL) {
+ obj_p res, list_obj = self->data.ptr;
+ size_t lsiz = listsize(list_obj);
+ size_t llen = listlen(list_obj);
+ if (llen == lsiz) {
+ raise_exception(ist, OBJ(STOP_ITERATION_EXC), NULL);
+ return NULL;
+ }
+ res = listitem(list_obj, llen);
+ listlen(list_obj)++;
+ return res;
+}
+
+MODULE_END(Tgen);
+
+
+//********************************* INITIALIZATION ****************************
+MAIN_MODULE_INIT(Tuple)
+{
+ MODULE_SUB_INIT(Tuple);
+ MODULE_SUB_INIT(Tgen);
+}
Property changes on: trunk/src/builtins-tuple.c
___________________________________________________________________
Name: svn:eol-style
+ native
Deleted: trunk/src/builtins.c
===================================================================
--- trunk/src/builtins.c 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/src/builtins.c 2004-04-02 05:14:44 UTC (rev 255)
@@ -1,1408 +0,0 @@
-/* ====================================================================
- * The Prothon License Agreement, Version 1.1
- *
- * Copyright (c) 2004 Hahn Creative Applications, http://hahnca.com.
- * All rights reserved.
- *
- * 1. This LICENSE AGREEMENT is between Hahn Creative Applications ("HCA"),
- * and the Individual or Organization ("Licensee") accessing and otherwise
- * using Prothon software in source or binary form and its associated
- * documentation.
- *
- * 2. Subject to the terms and conditions of this License Agreement, HCA
- * hereby grants Licensee a nonexclusive, royalty-free, world-wide license
- * to reproduce, analyze, test, perform and/or display publicly, prepare
- * derivative works, distribute, and otherwise use Prothon alone or in any
- * derivative version, provided, however, that HCA's License Agreement and
- * HCA's notice of copyright, i.e., "Copyright (c) 2004 Hahn Creative
- * Applications; All Rights Reserved" are retained in Prothon alone or
- * in any derivative version prepared by Licensee.
- *
- * 3. In the event Licensee prepares a derivative work that is based on or
- * incorporates Prothon or any part thereof, and wants to make the
- * derivative work available to others as provided herein, then Licensee
- * hereby agrees to include in any such work a brief summary of the
- * changes made to Prothon.
- *
- * 4. HCA is making Prothon available to Licensee on an "AS IS" basis.
- * HCA MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY
- * OF EXAMPLE, BUT NOT LIMITATION, HCA MAKES NO AND DISCLAIMS ANY
- * REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS FOR ANY
- * PARTICULAR PURPOSE OR THAT THE USE OF PROTHON WILL NOT INFRINGE ANY
- * THIRD PARTY RIGHTS.
- *
- * 5. HCA SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PROTHON
- * FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
- * RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PROTHON, OR ANY
- * DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
- *
- * 6. This License Agreement will automatically terminate upon a material
- * breach of its terms and conditions.
- *
- * 7. Nothing in this License Agreement shall be deemed to create any
- * relationship of agency, partnership, or joint venture between HCA and
- * Licensee. This License Agreement does not grant permission to use HCA
- * trademarks or trade name in a trademark sense to endorse or promote
- * products or services of Licensee, or any third party.
- *
- * 8. By copying, installing or otherwise using Prothon, Licensee agrees
- * to be bound by the terms and conditions of this License Agreement.
- * ====================================================================
- */
-
-
-// builtins.c
-
-#include <stdio.h>
-#include <string.h>
-
-#include <apr_strings.h>
-
-#include <prothon/prothon.h>
-#include <prothon/dict.h>
-#include "parser.h"
-#include "object.h"
-#include <prothon/prothon_dll.h>
-
-/* Leave this here. Do not move it, and do not declare anything above it.
- * This is here for a reason, so that the builtin's can be loaded (this is
- * the key for the start of the pointers to the functions for all the
- * builtins). */
-PR_PLACE_IN_SECTION(dll_initcall_t,start_dll_entry_ptr, "._module_init") = 0;
-
-MODULE_DECLARE(Object);
-MODULE_DECLARE(False);
-MODULE_DECLARE(True);
-MODULE_DECLARE(None);
-MODULE_DECLARE(Exception);
-MODULE_DECLARE(Gen);
-MODULE_DECLARE(String);
-MODULE_DECLARE(Tuple);
-MODULE_DECLARE(List);
-MODULE_DECLARE(Dict);
-MODULE_DECLARE(DictGen);
-MODULE_DECLARE(Seq);
-MODULE_DECLARE(Func);
-MODULE_DECLARE(Int);
-MODULE_DECLARE(IntGen);
-
-// ***************************** Object *********************************
-
-MODULE_START(Object)
-{
- Object_OBJ = OBJ(OBJECT);
- MODULE_SET_DOC(Object, "prototype base for all objects");
-
- add_doc_to_obj(ist, OBJ(SYMBOL_PROTO), "Symbol object prototype");
- add_doc_to_obj(ist, OBJ(HASH_PROTO), "Hash object prototype");
- add_doc_to_obj(ist, OBJ(SLICE_PROTO), "Slice object prototype");
- add_doc_to_obj(ist, OBJ(SUPER_PROTO), "Super object prototype");
- add_doc_to_obj(ist, OBJ(ROOT_GLOBALS), "Root_Globals: recursive container of all objects");
- add_doc_to_obj(ist, OBJ(MODULES), "Modules: container of all modules");
-
- set_attr(ist, OBJ(OBJECT), sym(ist, "Root_Globals"), OBJ(ROOT_GLOBALS));
- set_attr(ist, OBJ(OBJECT), sym(ist, "Modules"), OBJ(MODULES));
- set_attr(ist, OBJ(OBJECT), sym(ist, "Symbols"), OBJ(SYMBOLS));
- set_attr(ist, OBJ(OBJECT), sym(ist, "Object"), OBJ(OBJECT));
-}
-
-DEF(Object, __init__, NULL) {
- return self;
-}
-
-DEF(Object, has_proto_QUES, FORM_RPARAM) {
- if (has_proto_QUES(ist, self, parms[1]))
- return OBJ(PR_TRUE);
- else
- return OBJ(PR_FALSE);
-}
-
-DEF(Object, set_proto, FORM_RPARAM) {
- read_unlock(ist, self);
- switch_proto_to(ist, self, parms[1]);
- read_lock(ist, self);
- return NULL;
-}
-
-DEF(Object, add_proto, FORM_RPARAM) {
- read_unlock(ist, self);
- ins_proto(ist, self, parms[1], 1000);
- read_lock(ist, self);
- return NULL;
-}
-
-DEF(Object, Len, FORM_RPARAM) {
- return call_func0(ist, parms[1], SYM(LEN));
-}
-
-DEF(Object, Cmp, FORM_PARAM2) {
- return call_func1(ist, parms[1], SYM(CMP), parms[3]);
-}
-
-DEF(Object, Max, FORM_RPARAM) {
- return call_func0(ist, parms[1], SYM(MAX));
-}
-
-DEF(Object, Min, FORM_RPARAM) {
- return call_func0(ist, parms[1], SYM(MIN));
-}
-
-DEF(Object, __getitem__, FORM_RPARAM) {
- raise_exception(ist, OBJ(TYPE_EXC), "indexing not supported on this object");
- return NULL;
-}
-DEF(Object, __setitem__, FORM_PARAM2) {
- raise_exception(ist, OBJ(TYPE_EXC), "indexing not supported on this object");
- return NULL;
-}
-DEF(Object, __delitem__, FORM_RPARAM) {
- raise_exception(ist, OBJ(TYPE_EXC), "indexing not supported on this object");
- return NULL;
-}
-
-DEF(Object, proto_list, NULL) {
- return proto_list(ist, self);
-}
-
-DEF(Object, __bool__QUES, NULL) { return OBJ(PR_TRUE); }
-DEF(Object, __not__QUES, NULL)
-{
- if (call_func0(ist, self, SYM(__BOOL__QUES)) == OBJ(PR_TRUE))
- return OBJ(PR_FALSE);
- else
- return OBJ(PR_TRUE);
-}
-
-DEF(Object, __is__QUES, FORM_RPARAM) {
- if (self == parms[1]) return OBJ(PR_TRUE);
- else return OBJ(PR_FALSE);
-}
-
-DEF(Object, __isnot__QUES, FORM_RPARAM) {
- if (self != parms[1]) return OBJ(PR_TRUE);
- else return OBJ(PR_FALSE);
-}
-
-DEF(Object, __str__, NULL) {
- char str[1024];
- obj_p doc = get_attr(ist, self, SYM(__DOC__));
- char* p = strch(doc);
- if (doc)
- apr_snprintf(str, sizeof(str), "<Object:%lx:%s>", (unsigned long)(uintptr_t)self, p);
- else
- apr_snprintf(str, sizeof(str), "<Object:%lx>", (unsigned long)(uintptr_t)self);
- return new_string_obj(str);
-}
-
-DEF(Object, __hash__, NULL) {
- return new_hash_obj((i32_t)(uintptr_t) self);
-}
-
-DEF(Object, __eq__QUES, FORM_RPARAM) {
- obj_p cmp_obj = call_func1(ist, self, SYM(CMP), parms[1]); if_exc_return NULL;
- if (cmp_obj && *((i64_t*)(obj_data_p(cmp_obj))) == 0)
- return OBJ(PR_TRUE);
- else
- return OBJ(PR_FALSE);
-}
-
-DEF(Object, __ne__QUES, FORM_RPARAM) {
- obj_p cmp_obj = call_func1(ist, self, SYM(__EQ__QUES), parms[1]); if_exc_return NULL;
- if (cmp_obj == OBJ(PR_TRUE))
- return OBJ(PR_FALSE);
- else
- return OBJ(PR_TRUE);
-}
-
-DEF(Object, __lt__QUES, FORM_RPARAM) {
- obj_p cmp_obj = call_func1(ist, self, SYM(CMP), parms[1]); if_exc_return NULL;
- if (cmp_obj && *((i64_t*)(obj_data_p(cmp_obj))) < 0) return OBJ(PR_TRUE);
- else return OBJ(PR_FALSE);
-}
-
-DEF(Object, __le__QUES, FORM_RPARAM) {
- obj_p cmp_obj = call_func1(ist, self, SYM(CMP), parms[1]); if_exc_return NULL;
- if (cmp_obj && *((i64_t*)(obj_data_p(cmp_obj))) <= 0) return OBJ(PR_TRUE);
- else return OBJ(PR_FALSE);
-}
-
-DEF(Object, __gt__QUES, FORM_RPARAM) {
- obj_p cmp_obj = call_func1(ist, self, SYM(CMP), parms[1]); if_exc_return NULL;
- if (cmp_obj && *((i64_t*)(obj_data_p(cmp_obj))) > 0) return OBJ(PR_TRUE);
- else return OBJ(PR_FALSE);
-}
-
-DEF(Object, __ge__QUES, FORM_RPARAM) {
- obj_p cmp_obj = call_func1(ist, self, SYM(CMP), parms[1]); if_exc_return NULL;
- if (cmp_obj && *((i64_t*)(obj_data_p(cmp_obj))) >= 0) return OBJ(PR_TRUE);
- else return OBJ(PR_FALSE);
-}
-
-DEF(Object, __in__QUES, FORM_RPARAM) {
- return call_func1(ist, parms[1], SYM(__RIN__QUES), self);
-}
-
-DEF(Object, __notin__QUES, FORM_RPARAM) {
- return call_func1(ist, parms[1], SYM(__RNOTIN__QUES), self);
-}
-
-DEF(Object, attrs, NULL) {
- int i;
- size_t alen, asize;
- attr_p attrp;
- obj_p dict_obj;
- if (!self->has_attrs) return new_dict_obj(0);
- attrp = self->attr_proto.attrs;
- asize = attr_asize(attrp);
- alen = attr_alen(attrp);
- dict_obj = new_dict_obj((int)alen);
- for (i=0; i < (int) asize; i++) {
- if (attr_ap(attrp,i)->attr.key > 0)
- dict_add( ist, dict_obj,
- new_string_obj(keych(ist, attr_ap(attrp,i)->attr.key)),
- attr_ap(attrp,i)->attr.value );
- }
- return dict_obj;
-}
-
-MODULE_END(Object);
-
-// ***************************** PR_FALSE *****************************************
-
-MODULE_START(False)
-{
- False_OBJ = OBJ(PR_FALSE);
- MODULE_SET_DOC(False, "boolean false singleton value");
- set_attr(ist, OBJ(OBJECT), sym(ist, "False"), False_OBJ);
-}
-
-DEF(False, __str__, NULL) { return new_string_obj("False"); }
-DEF(False, __bool__QUES, NULL) { return False_OBJ; }
-DEF(False, cmp, FORM_RPARAM) {
- if (parms[1] == False_OBJ)
- return new_int_obj(0);
- else
- return new_int_obj(-1);
-}
-
-MODULE_END(False);
-
-// ***************************** PR_TRUE *****************************************
-
-MODULE_START(True)
-{
- True_OBJ = OBJ(PR_TRUE);
- MODULE_SET_DOC(True, "boolean true singleton value");
- set_attr(ist, OBJ(OBJECT), sym(ist, "True"), True_OBJ);
-}
-
-DEF(True, __str__, NULL) { return new_string_obj("True"); }
-DEF(True, __bool__QUES, NULL) { return True_OBJ; }
-DEF(True, cmp, FORM_RPARAM) {
- if (parms[1] == OBJ(PR_FALSE))
- return new_int_obj(1);
- else if (parms[1] == True_OBJ)
- return new_int_obj(0);
- else
- return new_int_obj(-1);
-}
-
-MODULE_END(True);
-
-// ***************************** NONE *****************************************
-
-MODULE_START(None)
-{
- None_OBJ = OBJ(NONE);
- MODULE_SET_DOC(None, "represents empty set");
- set_attr(ist, OBJ(OBJECT), sym(ist, "None"), None_OBJ);
-}
-
-DEF(None, __str__, NULL) { return new_string_obj("None"); }
-DEF(None, __bool__QUES, NULL) { return OBJ(PR_FALSE); }
-MODULE_END(None);
-
-// ***************************** EXCEPTION ************************************
-MODULE_START(Exception)
-{
- Exception_OBJ = OBJ(EXCEPTION);
- MODULE_SET_DOC(Exception, "root for all exception objects");
- set_attr(ist, OBJ(OBJECT), sym(ist, "Exception"), Exception_OBJ);
-
- /* Other exception objects dependent on this one */
- OBJ(INTERNAL_EXC) = new_object(Exception_OBJ);
- OBJ(PARSEERROR_EXC) = new_object(Exception_OBJ);
- OBJ(INTERPRETER_EXC) = new_object(Exception_OBJ);
- OBJ(ASSERTION_EXC) = new_object(Exception_OBJ);
- OBJ(NAME_EXC) = new_object(Exception_OBJ);
- OBJ(INDEX_EXC) = new_object(Exception_OBJ);
- OBJ(FUNCNOTFOUND_EXC) = new_object(Exception_OBJ);
- OBJ(TYPE_EXC) = new_object(Exception_OBJ);
- OBJ(MUTABLE_EXC) = new_object(Exception_OBJ);
- OBJ(DIVIDEZERO_EXC) = new_object(Exception_OBJ);
- OBJ(OUTOFMEMORY_EXC) = new_object(Exception_OBJ);
- OBJ(IOEXCEPTION) = new_object(Exception_OBJ);
- OBJ(FILENOTFOUND_EXC) = new_object(OBJ(IOEXCEPTION));
- OBJ(STOP_ITERATION_EXC) = new_object(Exception_OBJ);
- OBJ(LOCK_EXC) = new_object(Exception_OBJ);
-
- /* And their doc entries */
- add_doc_to_obj(ist, OBJ(INTERNAL_EXC), "Internal Prothon Error");
- add_doc_to_obj(ist, OBJ(PARSEERROR_EXC), "Parse Error");
- add_doc_to_obj(ist, OBJ(INTERPRETER_EXC), "Program Error");
- add_doc_to_obj(ist, OBJ(ASSERTION_EXC), "Assertion Error");
- add_doc_to_obj(ist, OBJ(NAME_EXC), "Name Error");
- add_doc_to_obj(ist, OBJ(INDEX_EXC), "Index Error");
- add_doc_to_obj(ist, OBJ(TYPE_EXC), "Type Error");
- add_doc_to_obj(ist, OBJ(MUTABLE_EXC), "Mutable Error");
- add_doc_to_obj(ist, OBJ(DIVIDEZERO_EXC), "Divide by zero error");
- add_doc_to_obj(ist, OBJ(OUTOFMEMORY_EXC), "Out Of Memory Error");
- add_doc_to_obj(ist, OBJ(IOEXCEPTION), "IO Error");
- add_doc_to_obj(ist, OBJ(FILENOTFOUND_EXC), "File Not Found");
- add_doc_to_obj(ist, OBJ(STOP_ITERATION_EXC), "End Of Generated Sequence (no error)");
- add_doc_to_obj(ist, OBJ(LOCK_EXC), "Locking Error");
-}
-
-DEF(Exception, __init__, FORM_STAR_PARAM) {
- obj_p res;
- if (list_len(ist, parms[1]) > 0)
- raise_exception(ist, self, "%s", as_str(ist, list_item(ist, parms[1], 0)));
- else
- raise_exception(ist, self, NULL);
- res = ist->exception_obj;
- ist->exception_obj = 0;
- return res;
-}
-MODULE_END(Exception);
-
-// ***************************** GEN ******************************************
-MODULE_START(Gen)
-{
- Gen_OBJ = OBJ(GEN_PROTO);
- MODULE_SET_DOC(Gen, "generator object prototype");
-}
-
-DEF(Gen, __gen__, NULL) {
- return self;
-}
-MODULE_END(Gen);
-
-// ***************************** SEQUENCE *************************************
-
-MODULE_START(Seq)
-{
- Seq_OBJ = OBJ(SEQ_PROTO);
- MODULE_SET_DOC(Seq, "object prototype");
- set_attr(ist, OBJ(OBJECT), sym(ist, "Sequence"), Seq_OBJ);
-}
-
-static int seq_len(isp ist, obj_p seq) {
- if (has_proto_QUES(ist, seq, OBJ(STRING_PROTO)))
- return (int) strlen(strch(seq));
- else return list_len(ist, seq);
-}
-
-static obj_p seq_item(isp ist, obj_p seq, int i) {
- char s[2];
- if (has_proto_QUES(ist, seq, OBJ(STRING_PROTO))) {
- s[0] = strch(seq)[i];
- s[1] = 0;
- return new_string_obj(s);
- } else
- return list_item(ist, seq, i);
-}
-
-
-static obj_p str_tuple_list(isp ist, obj_p self, char* ldelim, char* rdelim)
-{
- int i, len=list_len(ist, self);
- char msg[64], *res;
- obj_p ret_obj;
-
- /* Need enough room for just empty list */
- res = pr_malloc(strlen(ldelim) + strlen(rdelim) + 1);
-
- strcpy(res, ldelim);
-
- for (i = 0; i < len; i++) {
- char* item_str;
- obj_p item = list_item(ist, self,i);
- int is_str = has_proto_QUES(ist, item, OBJ(STRING_PROTO));
-
- if ((uintptr_t)item > 10) {
- item_str = as_str(ist, item);
- } else {
- apr_snprintf(msg, sizeof(msg), "<objptr:%lx>", (unsigned long)(uintptr_t)item);
- item_str = msg;
- is_str = 0;
- }
-
- res = pr_realloc(res, strlen(res) + strlen(item_str) + strlen(rdelim) + 6);
- if (is_str)
- strcat(res, "'");
- strcat(res, item_str);
- if (is_str)
- strcat(res,"'");
-
- if (i != len-1)
- strcat(res, ", ");
- }
- strcat(res, rdelim);
-
- ret_obj = new_string_obj(res);
- pr_free(res);
-
- return ret_obj;
-}
-
-#define SEQ_TYPE_STRING 0
-#define SEQ_TYPE_TUPLE 1
-#define SEQ_TYPE_LIST 2
-
-static obj_p get_sequence_item(isp ist, obj_p self, obj_p slice, int seq_type) {
- obj_p res = NULL, slice_item1, slice_item2, slice_item3;
- int i, index1 = 0, index2 = 0, index3 = 0, slice1_empty=FALSE, slice2_empty=FALSE;
- int exp_len, self_len, slice_len = list_len(ist, slice);
- char* self_str = NULL;
-
- CHECK_TYPE_EXC(self, OBJ(SEQ_PROTO), "sequence");
-
- if (seq_type == SEQ_TYPE_STRING) {
- self_len = (int) pr_strlen(self);
- self_str = strch(self);
- } else
- self_len = list_len(ist, self);
- slice_item1 = list_item(ist, slice,0);
- if (slice_item1 == SLICEPARAM_EMPTY || slice_item1 == OBJ(NONE))
- slice1_empty=TRUE;
- else {
- CHECK_TYPE_EXC(slice_item1, OBJ(INT_PROTO), "integer");
-
- index1 = (int)(slice_item1->data.i64);
- if (index1 < 0) index1 += self_len;
- if (index1 < 0 || index1 >= self_len) {
- raise_exception(ist, OBJ(INDEX_EXC), "Index (%d) out of range", index1);
- return NULL;
- }
- if (slice_len == 1) {
- if (seq_type == SEQ_TYPE_STRING) {
- return new_string_n_obj(self_str+index1, 1);
- } else
- return list_item(ist, self, index1);
- }
- }
- if (slice_len == 3) {
- slice_item3 = list_item(ist, slice,2);
- if (slice_item3 == SLICEPARAM_EMPTY || slice_item3 == OBJ(NONE)) index3 = 1;
- else {
- CHECK_TYPE_EXC(slice_item3, OBJ(INT_PROTO), "integer");
-
- index3 = (int)(slice_item3->data.i64);
- if (index3 == 0) {
- raise_exception(ist, OBJ(INDEX_EXC), "Slice step cannot be zero");
- return NULL;
- }
- }
- } else index3 = 1;
- slice_item2 = list_item(ist, slice,1);
- if (slice_item2 == SLICEPARAM_EMPTY || slice_item2 == OBJ(NONE))
- slice2_empty=TRUE;
- else {
- CHECK_TYPE_EXC(slice_item2, OBJ(INT_PROTO), "integer");
-
- index2 = (int)(slice_item2->data.i64);
- if (index2 < 0) index2 += self_len;
- if (index2 < 0 || index2 > self_len) {
- raise_exception(ist, OBJ(INDEX_EXC), "Second index (%d) out of range", index2);
- return NULL;
- }
- }
- if (index3 > 0) {
- if (slice1_empty) index1 = 0;
- if (slice2_empty) index2 = self_len;
- exp_len = (index2-index1+(index3-1))/index3;
- exp_len = max(exp_len, 0);
- switch(seq_type) {
- case SEQ_TYPE_TUPLE:
- res = new_tuple_obj(exp_len);
- for(i = index1; i < index2; i += index3)
- list_append(ist, res, list_item(ist, self, i));
- break;
- case SEQ_TYPE_LIST:
- res = new_list_obj(exp_len);
- for(i = index1; i < index2; i += index3)
- list_append(ist, res, list_item(ist, self, i));
- break;
- case SEQ_TYPE_STRING: {
- int j;
- char* s = pr_malloc(exp_len+2);
- for(i = index1, j=0; i < index2; i += index3, j++)
- s[j] = self_str[i];
- res = new_string_n_obj(s, j);
- pr_free(s);
- } break;
- }
- } else {
- if (slice1_empty) index1 = self_len-1;
- if (slice2_empty) index2 = -1;
- exp_len = (index2-index1+(index3-1))/index3;
- exp_len = max(exp_len, 0)+1;
- switch(seq_type) {
- case SEQ_TYPE_TUPLE:
- res = new_tuple_obj(exp_len);
- for(i = index1; i > index2; i += index3)
- list_append(ist, res, list_item(ist, self, i));
- break;
- case SEQ_TYPE_LIST:
- res = new_list_obj(exp_len);
- for(i = index1; i > index2; i += index3)
- list_append(ist, res, list_item(ist, self, i));
- break;
- case SEQ_TYPE_STRING: {
- int j;
- char* s = pr_malloc(exp_len+2);
- for(i = index1, j=0; i > index2; i += index3, j++)
- s[j] = self_str[i];
- res = new_string_n_obj(s, j);
- } break;
- }
- }
- return res;
-}
-
-MODULE_END(Seq);
-
-// ***************************** INT *******************************************
-
-#define INT_DATA_SIZE 8
-#define is_Int(objid) (has_proto_QUES(ist, objid, Int_OBJ))
-#define Int_value(objid) (objid->data.i64)
-
-static obj_p SYM_LIMIT;
-
-
-MODULE_START(Int)
-{
- Int_OBJ = OBJ(INT_PROTO);
- MODULE_SET_DOC(Int, "number object prototype");
- set_attr(ist, OBJ(OBJECT), sym(ist, "Int"), Int_OBJ);
-
- /* Dependent objects */
- OBJ(ZERO_INT) = new_int_obj(0);
- OBJ(MAX_INT) = new_int_obj(MAX_INT_VAL);
- OBJ(LONG_PROTO) = new_object(NULL);
- OBJ(FLOAT_PROTO) = new_object(NULL);
- OBJ(IMAG_PROTO) = new_object(NULL);
-
- add_doc_to_obj(ist, OBJ(FLOAT_PROTO), "Float number object prototype");
- add_doc_to_obj(ist, OBJ(IMAG_PROTO), "Imaginary number object prototype");
- add_doc_to_obj(ist, OBJ(LONG_PROTO), "Long integer number object prototype");
-
- set_attr(ist, OBJ(OBJECT), sym(ist, "Float"), OBJ(FLOAT_PROTO));
- set_attr(ist, OBJ(OBJECT), sym(ist, "Imaginary"), OBJ(IMAG_PROTO));
-}
-
-DEF(Int, __bool__QUES, NULL) {
- if (Int_value(self)) return OBJ(PR_TRUE);
- else return OBJ(PR_FALSE);
-}
-
-DEF(Int, __hash__, NULL) {
- i32_t i32 = (i32_t) Int_value(self);
- return new_hash_obj((((i32*i32)<<(i32 & 16))+i32)*17);
-}
-
-DEF(Int, __abs__, NULL){
- i64_t num = Int_value(self);
- return new_int_obj(num < 0 ? -num : num);
-}
-
-DEF(Int, __neg__, NULL){
- return new_int_obj( - Int_value(self) );
-}
-
-DEF(Int, __pos__, NULL){
- return self;
-}
-
-DEF(Int, __add__, FORM_RPARAM){
- obj_p other = parms[1];
- if (!is_Int(other)) {
- if (covers(other, self))
- return call_func1(ist, other, SYM(__ADD__), self);
- raise_exception(ist, OBJ(TYPE_EXC), "Integer cannot be added to this object");
- return OBJ(NONE);
- }
- return new_int_obj(Int_value(self) + Int_value(other));
-}
-
-DEF(Int, __div__, FORM_RPARAM){
- obj_p res;
- obj_p float_self, float_other, other = parms[1];
- if (!is_Int(other)) {
- if (covers(other, self))
- return call_func1(ist, other, SYM(__RDIV__), self);
- raise_exception(ist, OBJ(TYPE_EXC), "Integer cannot be divided by this object");
- return OBJ(NONE);
- }
- float_self = call_func1(ist, OBJ(FLOAT_PROTO), SYM(__COERCE__), self); if_exc_return NULL;
- float_other = call_func1(ist, OBJ(FLOAT_PROTO), SYM(__COERCE__), other); if_exc_return NULL;
- res = call_func1(ist, float_self, SYM(__DIV__), float_other);
- del_unlock(float_self); del_unlock(float_other);
- return res;
-}
-
-DEF(Int, __floordiv__, FORM_RPARAM){
- obj_p other = parms[1];
- if (!is_Int(other)) {
- if (covers(other, self))
- return call_func1(ist, other, SYM(__RFLOORDIV__), self);
- raise_exception(ist, OBJ(TYPE_EXC), "Integer cannot be floor divided by this object");
- return OBJ(NONE);
- }
- if (Int_value(other) == 0) {
- raise_exception(ist, OBJ(DIVIDEZERO_EXC), NULL);
- return NULL;
- }
- return new_int_obj(Int_value(self) / Int_value(other));
-}
-
-DEF(Int, __mod__, FORM_RPARAM) {
- obj_p other = parms[1];
- if (!is_Int(other)) {
- if (covers(other, self))
- return call_func1(ist, other, SYM(__RMOD__), self);
- raise_exception(ist, OBJ(TYPE_EXC), "Integer cannot be modded by this object");
- return OBJ(NONE);
- }
- if (Int_value(other) == 0) {
- raise_exception(ist, OBJ(DIVIDEZERO_EXC), "modulo by zero");
- return NULL;
- }
- return new_int_obj(Int_value(self) % Int_value(other));
-}
-
-DEF(Int, __mul__, FORM_RPARAM) {
- obj_p other = parms[1];
- if (!is_Int(other)) {
- if (covers(other, self))
- return call_func1(ist, other, SYM(__MUL__), self);
- raise_exception(ist, OBJ(TYPE_EXC), "Integer cannot be multiplied by this object");
- return OBJ(NONE);
- }
- return new_int_obj(Int_value(self) * Int_value(other));
-}
-
-DEF(Int, __sub__, FORM_RPARAM) {
- obj_p other = parms[1];
- if (!is_Int(other)) {
- if (covers(other, self))
- return call_func1(ist, other, SYM(__RSUB__), self);
- raise_exception(ist, OBJ(TYPE_EXC), "This object cannot be subtracted from an Integer");
- return OBJ(NONE);
- }
- return new_int_obj(Int_value(self) - Int_value(other));
-}
-
-DEF(Int, __pow__, FORM_RPARAM){
- obj_p res;
- obj_p float_self, float_other, other = parms[1];
- float_self = call_func1(ist, OBJ(FLOAT_PROTO), SYM(__COERCE__), self); if_exc_return NULL;
- float_other = call_func1(ist, OBJ(FLOAT_PROTO), SYM(__COERCE__), other); if_exc_return NULL;
- res = call_func1(ist, float_self, SYM(__POW__), float_other);
- del_unlock(float_self); del_unlock(float_other);
- return res;
-}
-
-DEF(Int, cmp, FORM_RPARAM){
- obj_p other = parms[1];
- if (!is_Int(other)) {
- if (covers(other, self))
- return call_func1(ist, other, SYM(__RCMP__), self);
- raise_exception(ist, OBJ(TYPE_EXC), "This object cannot be compared to an Integer");
- return OBJ(NONE);
- }
- if (Int_value(self) == Int_value(other))
- return new_int_obj(0);
- else if (Int_value(self) > Int_value(other))
- return new_int_obj(1);
- else
- return new_int_obj(-1);
-}
-
-DEF(Int, __eq__QUES, FORM_RPARAM){
- obj_p other = parms[1];
- if (!is_Int(other)) {
- if (covers(other, self))
- return call_func1(ist, other, SYM(__EQ__QUES), self);
- return OBJ(PR_FALSE);
- }
- if (Int_value(self) == Int_value(other)) return OBJ(PR_TRUE);
- else return OBJ(PR_FALSE);
-}
-DEF(Int, __invert__, NULL){
- return new_int_obj( ~ Int_value(self) );
-}
-
-DEF(Int, __xor__, FORM_RPARAM) {
- obj_p other = parms[1];
- if (!is_Int(other)) {
- raise_exception(ist, OBJ(TYPE_EXC), "object cannot be xor'd with an Integer");
- return OBJ(NONE);
- }
- return new_int_obj(Int_value(self) ^ Int_value(other));
-}
-
-DEF(Int, __and__, FORM_RPARAM) {
- obj_p other = parms[1];
- if (!is_Int(other)) {
- raise_exception(ist, OBJ(TYPE_EXC), "object cannot be and'd with an Integer");
- return OBJ(NONE);
- }
- return new_int_obj(Int_value(self) & Int_value(other));
-}
-
-DEF(Int, __or__, FORM_RPARAM) {
- obj_p other = parms[1];
- if (!is_Int(other)) {
- raise_exception(ist, OBJ(TYPE_EXC), "object cannot be or'd with an Integer");
- return OBJ(NONE);
- }
- return new_int_obj(Int_value(self) | Int_value(other));
-}
-
-DEF(Int, __rshift__, FORM_RPARAM) {
- obj_p other = parms[1];
- if (!is_Int(other)) {
- raise_exception(ist, OBJ(TYPE_EXC), "object cannot be shifted with an Integer");
- return OBJ(NONE);
- }
- return new_int_obj(Int_value(self) >> Int_value(other));
-}
-
-DEF(Int, __lshift__, FORM_RPARAM) {
- obj_p other = parms[1];
- if (!is_Int(other)) {
- raise_exception(ist, OBJ(TYPE_EXC), "object cannot be shifted with an Integer");
- return OBJ(NONE);
- }
- return new_int_obj(Int_value(self) << Int_value(other));
-}
-
-DEF(Int, __str__, NULL){
- char str[24];
- apr_snprintf(str, sizeof(str), LONG_LONG_FMT, (LONG_LONG_CAST)Int_value(self));
- return new_string_obj(str);
-}
-
-DEF (Int, __gen__, NULL) {
- obj_p gen_obj = new_int_obj(0);
- gen_obj->immutable = FALSE;
- gen_obj->attr_proto.proto = IntGen_OBJ;
- set_attr(ist, gen_obj, SYM_LIMIT, self);
- return gen_obj;
-}
-
-DEF(Int, chr, NULL) {
- char s[1];
- s[0] = (char) Int_value(self);
- return new_string_n_obj(s, 1);
-}
-
-MODULE_END(Int);
-
-MODULE_START(IntGen)
-{
- IntGen_OBJ = new_object(NULL);
- MODULE_SET_DOC(Int, "number generator object prototype");
-}
-
-DEF (IntGen, next, NULL) {
- obj_p limit, res;
- if ( !(limit=get_attr(ist, self, SYM_LIMIT)) ||
- Int_value(self) == Int_value(limit) ) {
- if (limit) {
- read_unlock(ist, self);
- del_attr(ist, self, SYM_LIMIT);
- read_lock(ist, self);
- }
- raise_exception(ist, OBJ(STOP_ITERATION_EXC), NULL);
- return NULL;
- }
- res = new_int_obj(Int_value(self));
- read_unlock(ist, self); write_lock(ist, self);
- Int_value(self)++;
- write_unlock(ist, self); read_lock(ist, self);
- return res;
-}
-
-MODULE_END(IntGen);
-
-// ***************************** STRING_PROTO *********************************
-
-MODULE_START(String)
-{
- String_OBJ = OBJ(STRING_PROTO);
- MODULE_SET_DOC(String, "string object prototype");
- set_attr(ist, OBJ(OBJECT), sym(ist, "String"), String_OBJ);
-}
-
-DEF(String, __str__, NULL) {
- return self;
-}
-
-DEF(String, __hash__, NULL) {
- i32_t res = 0x9a7c5e3;
- char *p;
- for(p=strch(self); *p; p++) res += 131 * (*p);
- return new_hash_obj(res);
-}
-
-DEF(String, __objlist__, FORM_RPARAM) {
- return parms[1];
-}
-
-DEF(String, __getitem__, FORM_RPARAM) {
- return get_sequence_item(ist, self, parms[1], SEQ_TYPE_STRING);
-}
-
-DEF(String, __setitem__, FORM_RPARAM) {
- raise_exception(ist, OBJ(MUTABLE_EXC), "strings may not be modifed");
- return NULL;
-}
-
-DEF(String, __delitem__, NULL) {
- raise_exception(ist, OBJ(MUTABLE_EXC), "strings may not be modifed");
- return NULL;
-}
-
-MODULE_END(String);
-
-
-// ***************************** TUPLE ******************************************
-
-MODULE_START(Tuple)
-{
- list_p lstp;
-
- Tuple_OBJ = OBJ(TUPLE_PROTO);
- MODULE_SET_DOC(Tuple, "object prototype");
- set_attr(ist, OBJ(OBJECT), sym(ist, "Tuple"), Tuple_OBJ);
-
- lstp = Tuple_OBJ->data.ptr = pr_malloc((LIST_OVERHEAD+2) * sizeof(list_t));
- lstpsize(lstp) = 2;
- lstplen(lstp) = 0;
-}
-
-DEF(Tuple, __str__, NULL) {
- return str_tuple_list(ist, self, "(", ")");
-}
-
-DEF(Tuple, __getitem__, FORM_RPARAM) {
- return get_sequence_item(ist, self, parms[1], SEQ_TYPE_TUPLE);
-}
-
-DEF(Tuple, __setitem__, FORM_RPARAM) {
- raise_exception(ist, OBJ(MUTABLE_EXC), "tuples may not be modifed");
- return NULL;
-}
-
-DEF(Tuple, __delitem__, NULL) {
- raise_exception(ist, OBJ(MUTABLE_EXC), "tuples may not be modifed");
- return NULL;
-}
-
-DEF(Tuple, __objlist__, FORM_RPARAM) {
- return self;
-}
-
-MODULE_END(Tuple);
-
-// ***************************** LIST ******************************************
-
-MODULE_START(List)
-{
- list_p lstp;
-
- List_OBJ = OBJ(LIST_PROTO);
- MODULE_SET_DOC(List, "object prototype");
- set_attr(ist, OBJ(OBJECT), sym(ist, "List"), List_OBJ);
-
- lstp = List_OBJ->data.ptr = pr_malloc((LIST_OVERHEAD+2) * sizeof(list_t));
- lstpsize(lstp) = 2;
- lstplen(lstp) = 0;
-}
-
-DEF(List, __str__, NULL) {
- return str_tuple_list(ist, self, "[", "]");
-}
-
-DEF(List, __getitem__, FORM_RPARAM) {
- return get_sequence_item(ist, self, parms[1], SEQ_TYPE_LIST);
-}
-
-DEF(List, __setitem__, FORM_PARAM2) {
- obj_p slice_item1, slice_item2, slice_item3;
- obj_p slice = parms[1], value = parms[3];
- int i, j, new_len, index1 = 0, index2 = 0, index3 = 0, slice1_empty=FALSE, slice2_empty=FALSE;
- int exp_len, val_len, self_len, slice_len = list_len(ist, slice);
- read_unlock(ist, self); write_lock(ist, self);
- self_len = listlen(self);
- slice_item1 = list_item(ist, slice,0);
- if (slice_item1 == SLICEPARAM_EMPTY || slice_item1 == OBJ(NONE))
- slice1_empty=TRUE;
- else {
- if (!has_proto_QUES(ist, slice_item1, OBJ(INT_PROTO))) {
- raise_exception(ist, OBJ(TYPE_EXC), "List slice index must be an integer");
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- index1 = (int)(slice_item1->data.i64);
- if (index1 < 0) index1 += self_len;
- if (index1 < 0 || index1 >= self_len) {
- raise_exception(ist, OBJ(INDEX_EXC), "Index (%d) out of range", index1);
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- if (slice_len == 1) {
- listitem(self, index1) = value;
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- }
- if ( !has_proto_QUES(ist, value, List_OBJ) &&
- !has_proto_QUES(ist, value, OBJ(TUPLE_PROTO)) &&
- !has_proto_QUES(ist, value, OBJ(STRING_PROTO)) ) {
- raise_exception(ist, OBJ(TYPE_EXC), "list slices may only be replaced with a sequence");
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- if (slice_len == 3) {
- slice_item3 = list_item(ist, slice,2);
- if (slice_item3 == SLICEPARAM_EMPTY || slice_item3 == OBJ(NONE)) index3 = 1;
- else {
- if (!has_proto_QUES(ist, slice_item3, OBJ(INT_PROTO))) {
- raise_exception(ist, OBJ(TYPE_EXC), "sequence slice index must be an integer");
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- index3 = (int)(slice_item3->data.i64);
- if (index3 == 0) {
- raise_exception(ist, OBJ(INDEX_EXC), "slice step cannot be zero");
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- }
- } else index3 = 1;
- slice_item2 = list_item(ist, slice,1);
- if (slice_item2 == SLICEPARAM_EMPTY || slice_item2 == OBJ(NONE))
- slice2_empty=TRUE;
- else {
- if (!has_proto_QUES(ist, slice_item2, OBJ(INT_PROTO))) {
- raise_exception(ist, OBJ(TYPE_EXC), "sequence slice index must be an integer");
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- index2 = (int)(slice_item2->data.i64);
- if (index2 < 0) index2 += self_len;
- if (index2 < 0 || index2 > self_len) {
- raise_exception(ist, OBJ(INDEX_EXC), "Second index (%d) out of range", index2);
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- }
- if (index3 > 0) {
- if (slice1_empty) index1 = 0;
- if (slice2_empty) index2 = self_len;
- } else {
- if (slice1_empty) index1 = self_len-1;
- if (slice2_empty) index2 = -1;
- }
- val_len = seq_len(ist, value);
- exp_len = (index2-index1+(index3-1))/index3;
- exp_len = max(exp_len, 0);
- if (slice_len==3) {
- if (exp_len != val_len) {
- raise_exception(ist, OBJ(INDEX_EXC), "extended slice assignment lengths do not match");
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- if (index3 > 0)
- for(i = index1, j=0; i < index2; i += index3, j++)
- listitem(self, i) = seq_item(ist, value, j);
- else
- for(i = index1, j=0; i > index2; i += index3, j++)
- listitem(self, i) = seq_item(ist, value, j);
- } else {
- listlen(self) = new_len = index1 + val_len + (self_len - index2);
- if (new_len+1 > listsize(self)) {
- listsize(self) = new_len+1;
- self->data.ptr =
- pr_realloc(self->data.ptr, (listsize(self)+LIST_OVERHEAD)*sizeof(list_t));
- }
- if (exp_len != val_len && index2 != self_len)
- memmove( ((list_p)self->data.ptr)+LIST_OVERHEAD+index1+val_len,
- ((list_p)self->data.ptr)+LIST_OVERHEAD+index2,
- (self_len-index2) * sizeof(list_t) );
- for(i = index1, j=0; j < val_len; i++, j++)
- listitem(self, i) = seq_item(ist, value, j);
- }
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
-}
-
-DEF(List, __delitem__, FORM_RPARAM) {
- obj_p slice_item1, slice_item2, slice_item3;
- obj_p slice = parms[1];
- int i, j, new_len, index1 = 0, index2 = 0, index3 = 0, slice1_empty=FALSE, slice2_empty=FALSE;
- int exp_len, self_len, slice_len = list_len(ist, slice);
- read_unlock(ist, self); write_lock(ist, self);
- self_len = listlen(self);
- slice_item1 = list_item(ist, slice,0);
- if (slice_item1 == SLICEPARAM_EMPTY || slice_item1 == OBJ(NONE))
- slice1_empty=TRUE;
- else {
- if (!has_proto_QUES(ist, slice_item1, OBJ(INT_PROTO))) {
- raise_exception(ist, OBJ(TYPE_EXC), "List slice index must be an integer");
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- index1 = (int)(slice_item1->data.i64);
- if (index1 < 0) index1 += self_len;
- if (index1 < 0 || index1 >= self_len) {
- raise_exception(ist, OBJ(INDEX_EXC), "Index (%d) out of range", index1);
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- if (slice_len == 1) {
- if (index1 != self_len-1)
- memmove( ((list_p)self->data.ptr)+LIST_OVERHEAD+index1,
- ((list_p)self->data.ptr)+LIST_OVERHEAD+index1+1,
- (self_len-1-index1) * sizeof(list_t) );
- listlen(self)--;
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- }
- if (slice_len == 3) {
- slice_item3 = list_item(ist, slice,2);
- if (slice_item3 == SLICEPARAM_EMPTY || slice_item3 == OBJ(NONE)) index3 = 1;
- else {
- if (!has_proto_QUES(ist, slice_item3, OBJ(INT_PROTO))) {
- raise_exception(ist, OBJ(TYPE_EXC), "sequence slice index must be an integer");
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- index3 = (int)(slice_item3->data.i64);
- if (index3 == 0) {
- raise_exception(ist, OBJ(INDEX_EXC), "slice step cannot be zero");
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- }
- } else index3 = 1;
- slice_item2 = list_item(ist, slice,1);
- if (slice_item2 == SLICEPARAM_EMPTY || slice_item2 == OBJ(NONE))
- slice2_empty=TRUE;
- else {
- if (!has_proto_QUES(ist, slice_item2, OBJ(INT_PROTO))) {
- raise_exception(ist, OBJ(TYPE_EXC), "sequence slice index must be an integer");
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- index2 = (int)(slice_item2->data.i64);
- if (index2 < 0) index2 += self_len;
- if (index2 < 0 || index2 > self_len) {
- raise_exception(ist, OBJ(INDEX_EXC), "Second index (%d) out of range", index2);
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- }
- if (index3 > 0) {
- if (slice1_empty) index1 = 0;
- if (slice2_empty) index2 = self_len;
- } else {
- if (slice1_empty) index1 = self_len-1;
- if (slice2_empty) index2 = -1;
- }
- exp_len = (index2-index1+(index3-1))/index3;
- exp_len = max(exp_len, 0);
- if (index3 != 1) {
- if (index3 > 0) {
- for(i = index1, j=0; i < index2; i += index3, j++)
- if (i != self_len-1)
- memmove( ((list_p)self->data.ptr)+LIST_OVERHEAD+(i-j),
- ((list_p)self->data.ptr)+LIST_OVERHEAD+(i-j)+1,
- (self_len-1-i) * sizeof(list_t) );
- } else {
- for(i = index1, j=0; i > index2; i += index3, j++)
- if (i != self_len-1)
- memmove( ((list_p)self->data.ptr)+LIST_OVERHEAD+i,
- ((list_p)self->data.ptr)+LIST_OVERHEAD+i+1,
- (self_len-1-i) * sizeof(list_t) );
- }
- } else {
- listlen(self) = new_len = index1 + (self_len - index2);
- if (exp_len != 0 && index2 != self_len)
- memmove( ((list_p)self->data.ptr)+LIST_OVERHEAD+index1,
- ((list_p)self->data.ptr)+LIST_OVERHEAD+index2,
- (self_len-index2) * sizeof(list_t) );
- }
- listlen(self) -= exp_len;
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
-}
-
-MODULE_END(List);
-
-// ***************************** DICT ******************************************
-
-MODULE_START(Dict)
-{
- dict_p dict;
-
- Dict_OBJ = OBJ(DICT_PROTO);
- MODULE_SET_DOC(Dict, "dictionary object prototype");
- set_attr(ist, OBJ(OBJECT), sym(ist, "Dict"), Dict_OBJ);
-
- dict = obj_malloc(Dict_OBJ, (DICT_OVERHEAD+DEFAULT_INITIAL_DICT_SIZE)*sizeof(dict_t));
- memset(dict, 0, (DICT_OVERHEAD+DEFAULT_INITIAL_DICT_SIZE)*sizeof(dict_t));
- dictsize(dict) = DEFAULT_INITIAL_DICT_SIZE;
-}
-
-#define __ADD_QUOTE(__is_str) \
-do { \
- if (__is_str) \
- strcat(res, "'"); \
-} while(0)
-
-DEF(Dict, __str__, NULL) {
- int i;
- size_t len;
- char* res;
- obj_p res_obj, keys, vals;
-
- len = dict_len(ist, self);
- keys = dict_keys(ist, self);
- vals = dict_values(ist, self);
-
- res = pr_malloc(3);
-
- strcpy(res, "{");
- for (i=0; i < (int) len; i++) {
- obj_p item1 = list_item(ist, keys,i);
- obj_p item2 = list_item(ist, vals,i);
- char* str1 = as_str(ist, item1);
- char* str2 = as_str(ist, item2);
- int is_str1 = has_proto_QUES(ist, item1, OBJ(STRING_PROTO));
- int is_str2 = has_proto_QUES(ist, item2, OBJ(STRING_PROTO));
-
- if (str1 == NULL)
- str1 = "(null)";
- if (str2 == NULL)
- str2 = "(null)";
-
- res = pr_realloc(res, strlen(res)+strlen(str1)+1+strlen(str2)+( i != len-1 ? 3 : 2)+6);
-
- __ADD_QUOTE(is_str1);
- strcat(res, str1);
- __ADD_QUOTE(is_str1);
- strcat(res, ":");
- __ADD_QUOTE(is_str2);
- strcat(res, str2);
- __ADD_QUOTE(is_str2);
-
- if (i != len-1) strcat(res, ", ");
- }
- strcat(res, "}");
-
- res_obj = new_string_obj(res);
- pr_free(res);
-
- return res_obj;
-}
-
-DEF(Dict, __objlist__, FORM_RPARAM) {
- size_t i, size, len;
- dict_p dict, dp;
- dict = dict_d(self);
- size = dictsize(dict);
- len = dictlen(dict);
- for(i=0; i < size; i++)
- if ((dp=dictptr(dict,i))->entry.hash > 0) {
- list_append(ist, parms[1], dp->entry.key);
- list_append(ist, parms[1], dp->entry.value);
- }
- return parms[1];
-}
-
-DEF(Dict, __getitem__, FORM_RPARAM) {
- obj_p res;
-
- CHECK_TYPE_EXC(self, OBJ(DICT_PROTO), "dict");
-
- if (list_len(ist, parms[1]) > 1) {
- raise_exception(ist, OBJ(INTERPRETER_EXC), "slice not allowed in dictionary indexing");
- return NULL;
- }
- if (!(res = dict_item(ist, self, list_item(ist, parms[1],0)))) {
- raise_exception(ist, OBJ(INDEX_EXC), "no entry found with key: %s",
- as_str(ist, list_item(ist, parms[1],0)));
- return NULL;
- }
- return res;
-}
-
-DEF(Dict, __setitem__, FORM_PARAM2) {
- if (list_len(ist, parms[1]) > 1) {
- raise_exception(ist, OBJ(INTERPRETER_EXC), "slice not allowed in dictionary indexing");
- return NULL;
- }
- read_unlock(ist, self);
- dict_add(ist, self, list_item(ist, parms[1], 0), parms[3]);
- read_lock(ist, self);
- return NULL;
-}
-
-DEF(Dict, __delitem__, FORM_RPARAM) {
- i32_t i, hash_in;
- obj_p key, key_in, rp[2];
- dict_p dict, dp;
- rp[0]=0; rp[1] = key_in = list_item(ist, parms[1], 0);
- if (list_len(ist, parms[1]) > 1) {
- raise_exception(ist, OBJ(INTERPRETER_EXC), "slice not allowed in dictionary indexing");
- return NULL;
- }
- read_unlock(ist, self); write_lock(ist, self);
- hash_in = hash_value(call_func(ist, key_in, SYM(__HASH__), 0, NULL, NULL));
- if (ist->exception_obj) {
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- dict = (dict_p) self->data.ptr;
- for(i=hash_in; (key=((dp=dictptr(dict,i))->entry.key)); i++){
- if ( dp->entry.hash == hash_in &&
- call_func(ist, key, SYM(__EQ__QUES), 2, rp, NULL) == OBJ(PR_TRUE) ) {
- dp->entry.hash = ENTRY_DELETED;
- dictlen(dict)--;
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- if (ist->exception_obj) {
- write_unlock(ist, self); read_lock(ist, self);
- return NULL;
- }
- }
- raise_exception(ist, OBJ(INDEX_EXC), "no entry found to delete");
- return NULL;
-}
-
-DEF(Dict, __gen__, NULL) {
- obj_p list_obj, gen_obj = new_object(DictGen_OBJ);
-
- gen_obj->data_type = OBJ_TYPE_DATAPTR;
- gen_obj->data.ptr = list_obj = dict_keys(ist, self);
-
- listlen(list_obj) = 0;
- return gen_obj;
-}
-
-MODULE_END(Dict);
-
-MODULE_START(DictGen)
-{
- DictGen_OBJ = new_object(NULL);
-}
-
-DEF(DictGen, next, NULL) {
- obj_p res, list_obj = self->data.ptr;
-
- CHECK_TYPE_EXC(self, DictGen_OBJ, "DictGen");
- CHECK_TYPE_EXC(list_obj, OBJ(SEQ_PROTO), "list");
-
- if (listsize(list_obj) == listlen(list_obj)) {
- raise_exception(ist, OBJ(STOP_ITERATION_EXC), NULL);
- return NULL;
- }
-
- res = listitem(list_obj, listlen(list_obj));
- listlen(list_obj)++;
-
- return res;
-}
-
-MODULE_END(DictGen);
-
-// ***************************** FUNC ******************************************
-
-MODULE_START(Func)
-{
- Func_OBJ = OBJ(FUNC_PROTO);
- MODULE_SET_DOC(Func, "function object prototype");
-}
-
-DEF(Func, __objlist__, FORM_RPARAM) {
- return parms[1];
-}
-MODULE_END(Func);
-
-// ***************************** INIT_BUILTINS ********************************
-
-static void core_builtins_init(void)
-{
- OBJ(OBJECT) = new_object(NULL);
- OBJ(OBJECT)->attr_proto.proto = OBJ(OBJECT);
-
- OBJ(SEQ_PROTO) = new_object(NULL);
- OBJ(TUPLE_PROTO) = new_object(OBJ(SEQ_PROTO));
- OBJ(LIST_PROTO) = new_object(OBJ(TUPLE_PROTO));
- OBJ(SYMBOL_PROTO) = new_object(NULL);
-
- OBJ(HASH_PROTO) = new_object(NULL);
- OBJ(SLICE_PROTO) = new_object(NULL);
- OBJ(SUPER_PROTO) = new_object(NULL);
- OBJ(THREAD_PROTO) = new_object(NULL);
- OBJ(ROOT_GLOBALS) = new_object(NULL);
- OBJ(MODULES) = new_object(NULL);
- OBJ(PR_FALSE) = new_object(NULL);
- OBJ(PR_TRUE) = new_object(NULL);
- OBJ(NONE) = new_object(NULL);
- OBJ(EXCEPTION) = new_object(NULL);
- OBJ(GEN_PROTO) = new_object(NULL);
- OBJ(INT_PROTO) = new_object(NULL);
- OBJ(STRING_PROTO) = new_object(NULL);
- OBJ(DICT_PROTO) = new_object(NULL);
- OBJ(FUNC_PROTO) = new_object(NULL);
-
- OBJ(SYMBOLS) = new_list_obj(SYM_ENUM_COUNT+20);
-
- init_symbol(ist);
-
- add_doc_to_obj(ist, OBJ(SYMBOLS), "Symbols: list of all symbol objects");
-}
-
-MAIN_MODULE_INIT(Builtins)
-{
- /* Call this first to get things sort of setup for the rest of
- * these things */
- core_builtins_init();
-
- MODULE_SUB_INIT(Object);
- MODULE_SUB_INIT(Seq);
- MODULE_SUB_INIT(Tuple);
- MODULE_SUB_INIT(List);
- MODULE_SUB_INIT(False);
- MODULE_SUB_INIT(True);
- MODULE_SUB_INIT(None);
- MODULE_SUB_INIT(Exception);
- MODULE_SUB_INIT(Gen);
- MODULE_SUB_INIT(String);
- MODULE_SUB_INIT(Dict);
- MODULE_SUB_INIT(DictGen);
- MODULE_SUB_INIT(Func);
-
- SYM_LIMIT = sym(ist, "limit");
-
- MODULE_SUB_INIT(Int);
- MODULE_SUB_INIT(IntGen);
-}
Modified: trunk/src/object.h
===================================================================
--- trunk/src/object.h 2004-04-02 01:44:19 UTC (rev 254)
+++ trunk/src/object.h 2004-04-02 05:14:44 UTC (rev 255)
@@ -183,4 +183,13 @@
// common exit point for debug breakpoints
void pr_exit(int n);
+/* Some seq stuff from builtins-core.c */
+obj_p str_tuple_list(isp ist, obj_p self, char* ldelim, char* rdelim);
+obj_p get_sequence_item(isp ist, obj_p self, obj_p slice, int seq_type);
+
+#define SEQ_TYPE_STRING 0
+#define SEQ_TYPE_TUPLE 1
+#define SEQ_TYPE_LIST 2
+
+
#endif // #define OBJECT_H