Author: particle
Date: Fri Nov 11 14:47:33 2005
New Revision: 9909
Added:
trunk/languages/amber/
trunk/languages/amber/lib/
trunk/languages/amber/lib/kernel/
trunk/languages/amber/lib/kernel/pmc/
trunk/languages/amber/lib/kernel/pmc/amber_array.pmc
trunk/languages/amber/lib/kernel/pmc/amber_boolean.pmc
trunk/languages/amber/lib/kernel/pmc/amber_character.pmc
trunk/languages/amber/lib/kernel/pmc/amber_default.pmc
trunk/languages/amber/lib/kernel/pmc/amber_integer.pmc
trunk/languages/amber/lib/kernel/pmc/amber_pathname.pmc
trunk/languages/amber/lib/kernel/pmc/amber_string.pmc
trunk/languages/amber/lib/kernel/pmc/amber_table.pmc
Removed:
trunk/t/p6rules/anchors.t
trunk/t/p6rules/escape.t
trunk/t/p6rules/ws.t
Modified:
trunk/MANIFEST
trunk/config/gen/makefiles.pm
trunk/config/gen/makefiles/root.in
Log:
#37658 (Initial PMCs for the Amber language)
also, cleanup empty PGE test files after refactoring
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Fri Nov 11 14:47:33 2005
@@ -225,6 +225,7 @@ config/gen/icu.pm
config/gen/makefiles.pm []
config/gen/makefiles/CFLAGS.in []
config/gen/makefiles/Zcode.in []
+config/gen/makefiles/amber.in []
config/gen/makefiles/bc.in []
config/gen/makefiles/befunge.in []
config/gen/makefiles/bf.in []
@@ -908,6 +909,14 @@ languages/Zcode/t/harness
languages/Zcode/z3.pir [Zcode]
languages/Zcode/z3main.pir [Zcode]
languages/Zcode/zops.pir [Zcode]
+languages/amber/lib/kernel/pmc/amber_array.pmc [amber]
+languages/amber/lib/kernel/pmc/amber_boolean.pmc [amber]
+languages/amber/lib/kernel/pmc/amber_character.pmc [amber]
+languages/amber/lib/kernel/pmc/amber_default.pmc [amber]
+languages/amber/lib/kernel/pmc/amber_integer.pmc [amber]
+languages/amber/lib/kernel/pmc/amber_pathname.pmc [amber]
+languages/amber/lib/kernel/pmc/amber_string.pmc [amber]
+languages/amber/lib/kernel/pmc/amber_table.pmc [amber]
languages/bc/AUTHOR [bc]
languages/bc/ChangeLog [bc]
languages/bc/MAINTAINER [bc]
@@ -1879,18 +1888,15 @@ t/op/stringu.t
t/op/time.t []
t/op/trans.t []
t/op/types.t []
-t/p6rules/anchors.t []
t/p6rules/backtrack.t []
t/p6rules/builtins.t []
t/p6rules/capture.t []
t/p6rules/cclass.t []
t/p6rules/closure.t []
-t/p6rules/escape.t []
t/p6rules/metachars.t []
t/p6rules/modifiers.t []
t/p6rules/subrules.t []
t/p6rules/text_brk.t []
-t/p6rules/ws.t []
t/perl/Parrot_Distribution.t []
t/perl/Parrot_Docs.t []
t/perl/Parrot_IO.t []
Modified: trunk/config/gen/makefiles.pm
==============================================================================
--- trunk/config/gen/makefiles.pm (original)
+++ trunk/config/gen/makefiles.pm Fri Nov 11 14:47:33 2005
@@ -83,6 +83,9 @@ sub makefiles {
genfile('config/gen/makefiles/Zcode.in' => 'languages/Zcode/Makefile',
commentType => '#',
replace_slashes => 1);
+ genfile('config/gen/makefiles/amber.in' => 'languages/amber/Makefile',
+ commentType => '#',
+ replace_slashes => 1);
genfile('config/gen/makefiles/bf.in' => 'languages/bf/Makefile',
commentType => '#',
replace_slashes => 1);
Modified: trunk/config/gen/makefiles/root.in
==============================================================================
--- trunk/config/gen/makefiles/root.in (original)
+++ trunk/config/gen/makefiles/root.in Fri Nov 11 14:47:33 2005
@@ -158,6 +158,7 @@ GEN_MAKEFILES = \
#CONDITIONED_LINE(has_perldoc): docs/Makefile \
dynclasses/Makefile \
dynoplibs/Makefile \
+ languages/amber/Makefile \
languages/cola/Makefile \
languages/parrot_compiler/Makefile \
languages/jako/Makefile \
Added: trunk/languages/amber/lib/kernel/pmc/amber_array.pmc
==============================================================================
--- (empty file)
+++ trunk/languages/amber/lib/kernel/pmc/amber_array.pmc Fri Nov 11
14:47:33 2005
@@ -0,0 +1,116 @@
+/* amber_array.pmc
+ * Copyright: same as Parrot.
+ * Overview:
+ * The Amber_ARRAY PMC, which implementes the Amber kernel class ARRAY
+ */
+
+#include "parrot/parrot.h"
+
+pmclass Amber_ARRAY need_ext extends Array extends Amber_DEFAULT does array
dynpmc group amber_kernel {
+
+ void class_init() {
+ if (pass) {
+ /* Register this PMC as Amber's HLL Array type. */
+ INTVAL amber_id = Parrot_get_HLL_id(
+ INTERP, const_string(INTERP, "Amber")
+ );
+ if (amber_id > 0)
+ Parrot_register_HLL_type(
+ INTERP, amber_id, enum_class_Array, entry
+ );
+ }
+ }
+
+/* non-vtable methods follow */
+
+ METHOD void add_last(PMC* value) {
+ INTVAL size = VTABLE_get_integer(INTERP, SELF);
+ VTABLE_set_integer_native(INTERP, SELF, size + 1);
+ VTABLE_set_pmc_keyed_int(INTERP, SELF, size, value);
+ }
+
+ METHOD PMC* boolean() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Boolean)
+ );
+ VTABLE_set_bool(INTERP, result, VTABLE_get_integer(INTERP, SELF));
+ return result;
+ }
+
+ METHOD PMC* classname() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, result, string_from_const_cstring(INTERP, "ARRAY", 5)
+ );
+ return result;
+ }
+
+ METHOD PMC* count() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Integer)
+ );
+ VTABLE_set_integer_native(
+ INTERP, result, VTABLE_get_integer(INTERP, SELF)
+ );
+ return result;
+ }
+
+ METHOD PMC* first() {
+ /* XXX reject if count = 0 */
+ return VTABLE_get_pmc_keyed_int(INTERP, SELF, (INTVAL) 0);
+ }
+
+ METHOD PMC* has(PMC* index) {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Boolean)
+ );
+ INTVAL adjusted_index = PMC_int_val(index);
+ if (adjusted_index) {
+ if (adjusted_index > 0) adjusted_index = adjusted_index - 1;
+ VTABLE_set_bool(INTERP, result, VTABLE_exists_keyed_int(
+ INTERP, SELF, adjusted_index
+ ));
+ }
+ return result;
+ }
+
+ METHOD PMC* item(PMC* index) {
+ /* XXX reject out-of-range values (0, or > count, or < -count) */
+ INTVAL adjusted_index = PMC_int_val(index);
+ if (adjusted_index > 0) adjusted_index = adjusted_index - 1;
+ return VTABLE_get_pmc_keyed_int(INTERP, SELF, adjusted_index);
+ }
+
+ METHOD PMC* last() {
+ /* XXX reject if count = 0 */
+ return VTABLE_get_pmc_keyed_int(
+ INTERP, SELF, VTABLE_get_integer(INTERP, SELF) - 1
+ );
+ }
+
+ METHOD void set_count(PMC* new_count) {
+ VTABLE_set_integer_native(
+ INTERP, SELF, VTABLE_get_integer(INTERP, new_count)
+ );
+ }
+
+ METHOD void set_item(PMC* index, PMC* value) {
+ /* XXX --require has(index) */
+ INTVAL adjusted_index = PMC_int_val(index);
+ if (adjusted_index > 0) adjusted_index = adjusted_index - 1;
+ VTABLE_set_pmc_keyed_int(INTERP, SELF, adjusted_index, value);
+ }
+
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */
Added: trunk/languages/amber/lib/kernel/pmc/amber_boolean.pmc
==============================================================================
--- (empty file)
+++ trunk/languages/amber/lib/kernel/pmc/amber_boolean.pmc Fri Nov 11
14:47:33 2005
@@ -0,0 +1,74 @@
+/* amber_boolean.pmc
+ * Copyright: same as Parrot.
+ * Overview:
+ * The Amber_BOOLEAN PMC, which implementes the Amber kernel class BOOLEAN
+ */
+
+#include "parrot/parrot.h"
+
+static INTVAL dynclass_CHARACTER;
+
+pmclass Amber_BOOLEAN extends Boolean extends Amber_DEFAULT does boolean
dynpmc group amber_kernel {
+
+ void class_init() {
+ if (pass) {
+ /* Register this PMC as Amber's HLL Boolean type. */
+ INTVAL amber_id = Parrot_get_HLL_id(
+ INTERP, const_string(INTERP, "Amber")
+ );
+ if (amber_id > 0)
+ Parrot_register_HLL_type(
+ INTERP, amber_id, enum_class_Boolean, entry
+ );
+ /* Record the type-id of PMC Amber_CHARACTER */
+ dynclass_CHARACTER = Parrot_PMC_typenum(INTERP, "Amber_CHARACTER");
+ }
+ }
+
+ STRING* get_string () {
+ return PMC_int_val(SELF)
+ ? string_from_const_cstring(INTERP, "true", 4)
+ : string_from_const_cstring(INTERP, "false", 5);
+ }
+
+/* non-vtable methods follow */
+
+ METHOD PMC* character() {
+ PMC* result = pmc_new(INTERP, dynclass_CHARACTER);
+ VTABLE_set_integer_native(
+ INTERP, result, PMC_int_val(SELF) ? 't' : 'f'
+ );
+ return result;
+ }
+
+ METHOD PMC* classname() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, result, string_from_const_cstring(INTERP, "BOOLEAN", 7)
+ );
+ return result;
+ }
+
+ METHOD PMC* integer() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Integer)
+ );
+ VTABLE_set_integer_native(
+ INTERP, result, PMC_int_val(SELF) ? 1 : 0
+ );
+ return result;
+ }
+
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */
Added: trunk/languages/amber/lib/kernel/pmc/amber_character.pmc
==============================================================================
--- (empty file)
+++ trunk/languages/amber/lib/kernel/pmc/amber_character.pmc Fri Nov 11
14:47:33 2005
@@ -0,0 +1,53 @@
+/* amber_character.pmc
+ * Copyright: same as Parrot.
+ * Overview:
+ * The Amber_CHARACTER PMC, which implementes the Amber kernel class
CHARACTER
+ */
+
+#include "parrot/parrot.h"
+
+pmclass Amber_CHARACTER extends Integer extends Amber_DEFAULT does string
dynpmc group amber_kernel {
+
+ STRING* get_string () {
+ return string_chr(INTERP, PMC_int_val(SELF));
+ }
+
+/* non-vtable methods follow */
+
+ METHOD PMC* boolean() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Boolean)
+ );
+ VTABLE_set_bool(INTERP, result, PMC_int_val(SELF));
+ return result;
+ }
+
+ METHOD PMC* classname() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, result, string_from_const_cstring(INTERP, "CHARACTER", 9)
+ );
+ return result;
+ }
+
+ METHOD PMC* integer() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Integer)
+ );
+ VTABLE_set_integer_native(INTERP, result, PMC_int_val(SELF));
+ return result;
+ }
+
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */
Added: trunk/languages/amber/lib/kernel/pmc/amber_default.pmc
==============================================================================
--- (empty file)
+++ trunk/languages/amber/lib/kernel/pmc/amber_default.pmc Fri Nov 11
14:47:33 2005
@@ -0,0 +1,56 @@
+/* amber_default.pmc
+ * Copyright: same as Parrot.
+ * Overview:
+ * The am_default PMC, an abstract ancestor for the Amber PMCs
+ */
+
+#include "parrot/parrot.h"
+
+pmclass Amber_DEFAULT abstract dynpmc group amber_kernel {
+
+/* non-vtable methods follow */
+
+ METHOD PMC* current() {
+ return SELF;
+ }
+
+ METHOD PMC* is_defined() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Boolean)
+ );
+ VTABLE_set_integer_native(
+ INTERP, result, VTABLE_defined(INTERP, SELF)
+ );
+ return result;
+ }
+
+ METHOD PMC* string() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, result, VTABLE_get_string(INTERP, SELF)
+ );
+ return result;
+ }
+
+ METHOD PMC* type_id() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Integer)
+ );
+ VTABLE_set_integer_native(INTERP, result, SELF->vtable->base_type);
+ return result;
+ }
+
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */
+
Added: trunk/languages/amber/lib/kernel/pmc/amber_integer.pmc
==============================================================================
--- (empty file)
+++ trunk/languages/amber/lib/kernel/pmc/amber_integer.pmc Fri Nov 11
14:47:33 2005
@@ -0,0 +1,96 @@
+/* amber_integer.pmc
+ * Copyright: same as Parrot.
+ * Overview:
+ * The Amber_INTEGER PMC, which implementes the Amber kernel class INTEGER
+ */
+
+#include "parrot/parrot.h"
+
+static INTVAL dynclass_CHARACTER;
+
+pmclass Amber_INTEGER extends Integer extends Amber_DEFAULT does integer
dynpmc group amber_kernel {
+
+ void class_init() {
+ if (pass) {
+ /* Register this PMC as Amber's HLL Integer type. */
+ INTVAL amber_id = Parrot_get_HLL_id(
+ INTERP, const_string(INTERP, "Amber")
+ );
+ if (amber_id > 0)
+ Parrot_register_HLL_type(
+ INTERP, amber_id, enum_class_Integer, entry
+ );
+ /* Record the type-id of PMC Amber_CHARACTER */
+ dynclass_CHARACTER = Parrot_PMC_typenum(INTERP, "Amber_CHARACTER");
+ }
+ }
+
+ PMC* neg (PMC* dest) {
+ INTVAL a = -DYNSELF.get_integer();
+ /* if (!dest) --TODO: can we reinstate this if we generate n_neg
instead of neg? */
+ dest = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Integer)
+ );
+ VTABLE_set_integer_native(INTERP, dest, a);
+ return dest;
+ }
+
+/* non-vtable methods follow */
+
+ METHOD PMC* abs() {
+ /* XXX overflow for -maxint */
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Integer)
+ );
+ VTABLE_set_integer_native(INTERP, result, abs(PMC_int_val(SELF)));
+ return result;
+ }
+
+ METHOD PMC* boolean() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Boolean)
+ );
+ VTABLE_set_bool(INTERP, result, PMC_int_val(SELF));
+ return result;
+ }
+
+ METHOD PMC* character() {
+ /* XXX consider Unicode */
+ PMC* result = pmc_new(INTERP, dynclass_CHARACTER);
+ VTABLE_set_integer_native(INTERP, result, PMC_int_val(SELF));
+ return result;
+ }
+
+ METHOD PMC* classname() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, result, string_from_const_cstring(INTERP, "INTEGER", 7)
+ );
+ return result;
+ }
+
+ METHOD PMC* current() {
+ return SELF;
+ }
+
+ METHOD PMC* integer() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Integer)
+ );
+ VTABLE_set_integer_native(INTERP, result, PMC_int_val(SELF));
+ return result;
+ }
+
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */
Added: trunk/languages/amber/lib/kernel/pmc/amber_pathname.pmc
==============================================================================
--- (empty file)
+++ trunk/languages/amber/lib/kernel/pmc/amber_pathname.pmc Fri Nov 11
14:47:33 2005
@@ -0,0 +1,298 @@
+/* amber_pathname.pmc
+ * Copyright: same as Parrot.
+ * Overview:
+ * The Amber_PATHNAME PMC, which implementes the Amber kernel class
PATHNAME
+ */
+
+#include "parrot/parrot.h"
+#include <dirent.h>
+
+static INTVAL class_PATHNAME;
+
+pmclass Amber_PATHNAME extends Amber_STRING extends Amber_DEFAULT does string
dynpmc group amber_kernel {
+
+ void class_init() {
+ if (pass) {
+ /* Record the type-id of this PMC */
+ class_PATHNAME = Parrot_PMC_typenum(INTERP, "Amber_PATHNAME");
+ }
+ }
+
+ void init() {
+ char* buffer = getcwd(NULL, 0);
+ if (!buffer)
+ real_exception(
+ INTERP, NULL, E_IOError,
+ "PATHNAME.set_to_current: couldn't read current working
directory"
+ );
+ PMC_str_val(SELF) = string_from_cstring(INTERP, buffer, 0);
+ free(buffer);
+ PObj_custom_mark_SET(SELF);
+ }
+
+ void init_pmc(PMC* initializer) {
+ PMC_str_val(SELF) = VTABLE_get_string(INTERP, initializer);
+ PObj_custom_mark_SET(SELF);
+ }
+
+/* non-vtable methods follow */
+
+ METHOD PMC* array() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Array)
+ );
+ STRING* delimiter = string_from_const_cstring(INTERP, "/", 1);
+ /* --WINDOWS */
+ STRING* pathname = VTABLE_get_string(INTERP, SELF);
+ int pathlength = string_length(INTERP, pathname);
+ int start, end;
+ start = 0;
+ int index = 0;
+ while (start < pathlength) {
+ end = string_str_index(INTERP, pathname, delimiter, start);
+ if (end < start) /* no more delimiters */
+ end = pathlength;
+ if (end == start) /* found a delimiter at the start */
+ start++;
+ else {
+ STRING* match = string_substr(
+ INTERP, pathname, start, end - start, NULL, 0
+ );
+ PMC* item = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_String)
+ );
+ VTABLE_set_string_native(INTERP, item, match);
+ VTABLE_set_integer_native(INTERP, result, index + 1);
+ VTABLE_set_pmc_keyed_int(INTERP, result, index, item);
+ index++;
+ start = end + 1;
+ }
+ }
+ return result;
+ }
+
+ METHOD PMC* classname() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, result, string_from_const_cstring(INTERP, "PATHNAME", 8)
+ );
+ return result;
+ }
+
+ METHOD PMC* entry_names() {
+ DIR *dp;
+ struct dirent *ep;
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Array)
+ );
+ int index = 0;
+ dp = opendir(string_to_cstring(INTERP, PMC_str_val(SELF)));
+ if (dp != NULL) {
+ while ((ep = readdir(dp))) {
+ VTABLE_set_integer_native(INTERP, result, index + 1);
+ PMC* item = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, item, string_from_cstring(INTERP, ep->d_name, 0)
+ );
+ VTABLE_set_pmc_keyed_int(INTERP, result, index, item);
+ index++;
+ }
+ (void) closedir(dp);
+ } else {
+ real_exception(
+ INTERP, NULL, E_IOError,
+ "PATHNAME.entry_names: couldn't read directory"
+ );
+ }
+ return result;
+ }
+
+ METHOD PMC* file_names() {
+ DIR *dp;
+ struct dirent *ep;
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Array)
+ );
+ int index = 0;
+ dp = opendir(string_to_cstring(INTERP, PMC_str_val(SELF)));
+ if (dp != NULL) {
+ while ((ep = readdir(dp))) {
+ if (ep->d_type == DT_REG) {
+ VTABLE_set_integer_native(INTERP, result, index + 1);
+ PMC* item = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP,
enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, item, string_from_cstring(INTERP, ep->d_name,
0)
+ );
+ VTABLE_set_pmc_keyed_int(INTERP, result, index, item);
+ index++;
+ }
+ }
+ (void) closedir(dp);
+ } else {
+ real_exception(
+ INTERP, NULL, E_IOError,
+ "PATHNAME.file_names: couldn't read directory"
+ );
+ }
+ return result;
+ }
+
+ METHOD PMC* file_pathnames() {
+ DIR *dp;
+ struct dirent *ep;
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Array)
+ );
+ int index = 0;
+ dp = opendir(string_to_cstring(INTERP, PMC_str_val(SELF)));
+ if (dp != NULL) {
+ while ((ep = readdir(dp))) {
+ if (ep->d_type == DT_REG) {
+ VTABLE_set_integer_native(INTERP, result, index + 1);
+ /* PMC* item = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP,
enum_class_String)
+ ); */
+ PMC* item = pmc_new(INTERP, class_PATHNAME);
+ VTABLE_set_string_native(INTERP, item,
+ string_concat(INTERP,
+ VTABLE_get_string(INTERP, SELF),
+ string_concat(INTERP,
+ string_from_const_cstring(INTERP, "/", 1),
+ string_from_cstring(INTERP, ep->d_name, 0),
+ 0
+ ),
+ 0
+ )
+ );
+ VTABLE_set_pmc_keyed_int(INTERP, result, index, item);
+ index++;
+ }
+ }
+ (void) closedir(dp);
+ } else {
+ real_exception(
+ INTERP, NULL, E_IOError,
+ "PATHNAME.file_names: couldn't read directory"
+ );
+ }
+ return result;
+ }
+
+ METHOD PMC* is_readable_directory() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Boolean)
+ );
+ DIR* dp;
+ dp = opendir(string_to_cstring(INTERP, PMC_str_val(SELF)));
+ if (dp != NULL) {
+ VTABLE_set_integer_native(INTERP, result, 1);
+ (void) closedir(dp);
+ } else {
+ VTABLE_set_integer_native(INTERP, result, 0);
+ }
+ return result;
+ }
+/*
+ METHOD PMC* string() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, result, VTABLE_get_string(INTERP, SELF)
+ );
+ return result;
+ }
+*/
+ METHOD PMC* subdirectory_names() {
+ DIR *dp;
+ struct dirent *ep;
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Array)
+ );
+ int index = 0;
+ dp = opendir(string_to_cstring(INTERP, PMC_str_val(SELF)));
+ if (dp != NULL) {
+ while ((ep = readdir(dp))) {
+ if (ep->d_type == DT_DIR) {
+ char *dirname = ep->d_name;
+ if (strcmp(dirname, ".") && strcmp(dirname, "..")) {
+ VTABLE_set_integer_native(INTERP, result, index + 1);
+ PMC* item = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP,
enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, item, string_from_cstring(INTERP, dirname,
0)
+ );
+ VTABLE_set_pmc_keyed_int(INTERP, result, index, item);
+ index++;
+ }
+ }
+ }
+ (void) closedir(dp);
+ } else {
+ real_exception(
+ INTERP, NULL, E_IOError,
+ "PATHNAME.subdirectory_names: couldn't read directory"
+ );
+ }
+ return result;
+ }
+
+ METHOD PMC* subdirectory_pathnames() {
+ DIR *dp;
+ struct dirent *ep;
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Array)
+ );
+ int index = 0;
+ dp = opendir(string_to_cstring(INTERP, PMC_str_val(SELF)));
+ if (dp != NULL) {
+ while ((ep = readdir(dp))) {
+ if (ep->d_type == DT_DIR) {
+ char *dirname = ep->d_name;
+ if (strcmp(dirname, ".") && strcmp(dirname, "..")) {
+ VTABLE_set_integer_native(INTERP, result, index + 1);
+ PMC* item = pmc_new(INTERP, class_PATHNAME);
+ VTABLE_set_string_native(INTERP, item,
+ string_concat(INTERP,
+ VTABLE_get_string(INTERP, SELF),
+ string_concat(INTERP,
+ string_from_const_cstring(INTERP, "/", 1),
+ string_from_cstring(INTERP, dirname, 0),
+ 0
+ ),
+ 0
+ )
+ );
+ VTABLE_set_pmc_keyed_int(INTERP, result, index, item);
+ index++;
+ }
+ }
+ }
+ (void) closedir(dp);
+ } else {
+ real_exception(
+ INTERP, NULL, E_IOError,
+ "PATHNAME.subdirectory_pathnames: couldn't read directory"
+ );
+ }
+ return result;
+ }
+
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */
Added: trunk/languages/amber/lib/kernel/pmc/amber_string.pmc
==============================================================================
--- (empty file)
+++ trunk/languages/amber/lib/kernel/pmc/amber_string.pmc Fri Nov 11
14:47:33 2005
@@ -0,0 +1,109 @@
+/* amber_string.pmc
+ * Copyright: same as Parrot.
+ * Overview:
+ * The Amber_STRING PMC, which implementes the Amber kernel class STRING
+ */
+
+#include "parrot/parrot.h"
+
+static INTVAL dynclass_CHARACTER;
+
+pmclass Amber_STRING extends String extends Amber_DEFAULT does string dynpmc
group amber_kernel {
+
+ void class_init() {
+ if (pass) {
+ /* Register this PMC as Amber's HLL String type. */
+ INTVAL amber_id = Parrot_get_HLL_id(
+ INTERP, const_string(INTERP, "Amber")
+ );
+ if (amber_id > 0)
+ Parrot_register_HLL_type(
+ INTERP, amber_id, enum_class_String, entry
+ );
+ /* Record the type-id of PMC Amber_CHARACTER */
+ dynclass_CHARACTER = Parrot_PMC_typenum(INTERP, "Amber_CHARACTER");
+ }
+ }
+
+/* non-vtable methods follow */
+
+ METHOD PMC* boolean() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Boolean)
+ );
+ VTABLE_set_bool(INTERP, result, PMC_int_val(SELF));
+ return result;
+ }
+
+ METHOD PMC* count() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Integer)
+ );
+ VTABLE_set_integer_native(
+ INTERP, result, string_compute_strlen(INTERP, PMC_str_val(SELF))
+ );
+ return result;
+ }
+
+ METHOD PMC* classname() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, result, string_from_const_cstring(INTERP, "STRING", 6)
+ );
+ return result;
+ }
+
+ METHOD PMC* first() {
+ /* XXX reject if count = 0 */
+ PMC* result = pmc_new(INTERP, dynclass_CHARACTER);
+ VTABLE_set_integer_native(INTERP, result, string_ord(
+ INTERP, PMC_str_val(SELF), (INTVAL) 0
+ ));
+ return result;
+ }
+
+ METHOD PMC* integer() { /* XXX OVERFLOW */
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Integer)
+ );
+ VTABLE_set_integer_native(
+ INTERP, result, string_to_int(INTERP, PMC_str_val(SELF))
+ );
+ return result;
+ }
+
+ METHOD PMC* item(PMC* index) {
+ /* XXX reject out-of-range values (0, or > count, or < -count) */
+ INTVAL adjusted_index = VTABLE_get_integer(INTERP, index);
+ if (adjusted_index > 0) adjusted_index = adjusted_index - 1;
+ PMC* result = pmc_new(INTERP, dynclass_CHARACTER);
+ VTABLE_set_integer_native(INTERP, result, string_ord(
+ INTERP, PMC_str_val(SELF), adjusted_index
+ ));
+ return result;
+ }
+
+ METHOD PMC* last() {
+ /* XXX reject if count = 0 */
+ PMC* result = pmc_new(INTERP, dynclass_CHARACTER);
+ VTABLE_set_integer_native(INTERP, result, string_ord(
+ INTERP, PMC_str_val(SELF), string_compute_strlen(
+ INTERP, PMC_str_val(SELF)
+ ) - 1
+ ));
+ return result;
+ }
+
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */
Added: trunk/languages/amber/lib/kernel/pmc/amber_table.pmc
==============================================================================
--- (empty file)
+++ trunk/languages/amber/lib/kernel/pmc/amber_table.pmc Fri Nov 11
14:47:33 2005
@@ -0,0 +1,86 @@
+/* amber_table.pmc
+ * Copyright: same as Parrot.
+ * Overview:
+ * The Amber_TABLE PMC, which implementes the Amber kernel class TABLE
+ */
+
+#include "parrot/parrot.h"
+
+pmclass Amber_TABLE need_ext extends Hash extends Amber_DEFAULT does hash
dynpmc group amber_kernel {
+
+ void class_init() {
+ if (pass) {
+ /* Register this PMC as Amber's HLL Hash type. */
+ INTVAL amber_id = Parrot_get_HLL_id(
+ INTERP, const_string(INTERP, "Amber")
+ );
+ if (amber_id > 0)
+ Parrot_register_HLL_type(
+ INTERP, amber_id, enum_class_Hash, entry
+ );
+ }
+ }
+
+/* non-vtable methods follow */
+
+ METHOD PMC* boolean() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Boolean)
+ );
+ VTABLE_set_bool(INTERP, result, VTABLE_get_bool(INTERP, SELF));
+ return result;
+ }
+
+ METHOD PMC* classname() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_String)
+ );
+ VTABLE_set_string_native(
+ INTERP, result, string_from_const_cstring(INTERP, "TABLE", 5)
+ );
+ return result;
+ }
+
+ METHOD PMC* count() {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Integer)
+ );
+ VTABLE_set_integer_native(
+ INTERP, result, VTABLE_get_integer(INTERP, SELF)
+ );
+ return result;
+ }
+
+ METHOD void delete(PMC* key) {
+ VTABLE_delete_keyed(INTERP, SELF, key);
+ }
+
+ METHOD PMC* has(PMC* key) {
+ PMC* result = pmc_new(
+ INTERP, Parrot_get_ctx_HLL_type(INTERP, enum_class_Boolean)
+ );
+ VTABLE_set_bool(
+ INTERP, result, VTABLE_exists_keyed(INTERP, SELF, key)
+ );
+ return result;
+ }
+
+ METHOD PMC* item(PMC* key) {
+ return VTABLE_get_pmc_keyed(INTERP, SELF, key);
+ }
+
+ METHOD void set_item(PMC* key, PMC* value) {
+ VTABLE_set_pmc_keyed(INTERP, SELF, key, value);
+ }
+
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */
