aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoel Martin <github@martintribe.org>2014-04-01 22:50:55 -0500
committerJoel Martin <github@martintribe.org>2014-04-01 22:50:55 -0500
commit9528bb145193159fa3e697da642e32a0877af5fb (patch)
tree3375b4524d7c845ec33c7636fb7697ce3c1d6a42
parent950e3c765e30648de34cfc4f65fffdce06f0727f (diff)
downloadmal-9528bb145193159fa3e697da642e32a0877af5fb.tar.gz
mal-9528bb145193159fa3e697da642e32a0877af5fb.zip
All: pass stepA tests, in particular with correct conj behavior.
-rw-r--r--bash/types.sh22
-rw-r--r--c/types.c102
-rw-r--r--docs/step_notes.txt12
-rw-r--r--java/src/main/java/mal/types.java19
-rw-r--r--js/types.js15
-rw-r--r--make/types.mk40
-rw-r--r--php/types.php13
-rw-r--r--python/mal_types.py5
-rw-r--r--tests/stepA_more.mal28
9 files changed, 184 insertions, 72 deletions
diff --git a/bash/types.sh b/bash/types.sh
index e678321..33278da 100644
--- a/bash/types.sh
+++ b/bash/types.sh
@@ -128,7 +128,7 @@ true? () { _true? "${1}" && r="${__true}" || r="${__false}"; }
true_pr_str () { r="true"; }
_false? () { [[ ${1} =~ ^fals_ ]]; }
-false? () { _false? "${1}" && r="${__false}" || r="${__false}"; }
+false? () { _false? "${1}" && r="${__true}" || r="${__false}"; }
false_pr_str () { r="false"; }
@@ -516,10 +516,18 @@ conj () {
local obj="${1}"; shift
local obj_data="${ANON["${obj}"]}"
__new_obj_like "${obj}"
- ANON["${r}"]="${obj_data:+${obj_data} }${*}"
+ if _list? "${obj}"; then
+ ANON["${r}"]="${obj_data:+${obj_data}}"
+ for elem in ${@}; do
+ ANON["${r}"]="${elem} ${ANON["${r}"]}"
+ done
+
+ else
+ ANON["${r}"]="${obj_data:+${obj_data} }${*}"
+ fi
}
-# conj that mutates in place
+# conj that mutates in place (and always appends)
conj! () {
local obj="${1}"; shift
local obj_data="${ANON["${obj}"]}"
@@ -541,6 +549,7 @@ count () {
first () {
local temp="${ANON["${1}"]}"
r="${temp%% *}"
+ [ "${r}" ] || r="${__nil}"
}
last () {
@@ -559,7 +568,7 @@ _slice () {
# element
rest () {
local temp="${ANON["${1}"]}"
- __new_obj_like "${1}"
+ __new_obj list
if [[ "${temp#* }" == "${temp}" ]]; then
ANON["${r}"]=
else
@@ -568,9 +577,8 @@ rest () {
}
apply () {
- local f="${ANON["${1}"]}"
- local args="${2}"
- local items="${ANON["${2}"]}"
+ local f="${ANON["${1}"]}"; shift
+ local items="${@:1:$(( ${#@} -1 ))} ${ANON["${!#}"]}"
eval ${f%%@*} ${items}
}
diff --git a/c/types.c b/c/types.c
index 1308aac..a6bfbf6 100644
--- a/c/types.c
+++ b/c/types.c
@@ -556,44 +556,62 @@ MalVal *_hash_map(int count, ...) {
return hm;
}
-MalVal *hash_map(MalVal *args) {
- assert_type(args, MAL_LIST|MAL_VECTOR,
- "hash-map called with non-sequential arguments");
- assert((args->val.array->len % 2) == 0,
- "odd number of parameters to hash-map");
- GHashTable *htable = g_hash_table_new(g_str_hash, g_str_equal);
- MalVal *hm = malval_new_hash_map(htable);
+MalVal *_assoc_BANG(MalVal* hm, MalVal *args) {
+ assert((_count(args) % 2) == 0,
+ "odd number of parameters to assoc!");
+ GHashTable *htable = hm->val.hash_table;
int i;
MalVal *k, *v;
- for(i=0; i< args->val.array->len; i+=2) {
+ for (i=0; i<_count(args); i+=2) {
k = g_array_index(args->val.array, MalVal*, i);
assert_type(k, MAL_STRING,
- "hash-map called with non-string key");
+ "assoc! called with non-string key");
v = g_array_index(args->val.array, MalVal*, i+1);
g_hash_table_insert(htable, k->val.string, v);
}
return hm;
}
+MalVal *_dissoc_BANG(MalVal* hm, MalVal *args) {
+ GHashTable *htable = hm->val.hash_table;
+ int i;
+ MalVal *k, *v;
+ for (i=0; i<_count(args); i++) {
+ k = g_array_index(args->val.array, MalVal*, i);
+ assert_type(k, MAL_STRING,
+ "dissoc! called with non-string key");
+ g_hash_table_remove(htable, k->val.string);
+ }
+ return hm;
+}
+
+MalVal *hash_map(MalVal *args) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "hash-map called with non-sequential arguments");
+ GHashTable *htable = g_hash_table_new(g_str_hash, g_str_equal);
+ MalVal *hm = malval_new_hash_map(htable);
+ return _assoc_BANG(hm, args);
+}
+
int _hash_map_Q(MalVal *seq) {
return seq->type & MAL_HASH_MAP;
}
MalVal *hash_map_Q(MalVal *seq) { return _hash_map_Q(seq) ? &mal_true : &mal_false; }
-// TODO: support multiple key/values
-MalVal *assoc(MalVal *hm, MalVal *key, MalVal *val) {
- GHashTable *htable = g_hash_table_copy(hm->val.hash_table);
- MalVal *new_hm = malval_new_hash_map(htable);
- g_hash_table_insert(htable, key->val.string, val);
- return new_hm;
+MalVal *assoc(MalVal *args) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "assoc called with non-sequential arguments");
+ assert(_count(args) >= 2,
+ "assoc needs at least 2 arguments");
+ GHashTable *htable = g_hash_table_copy(_nth(args,0)->val.hash_table);
+ MalVal *hm = malval_new_hash_map(htable);
+ return _assoc_BANG(hm, rest(args));
}
-// TODO: support multiple keys
-MalVal *dissoc(MalVal *hm, MalVal *key) {
- GHashTable *htable = g_hash_table_copy(hm->val.hash_table);
- MalVal *new_hm = malval_new_hash_map(htable);
- g_hash_table_remove(htable, key->val.string);
- return new_hm;
+MalVal *dissoc(MalVal* args) {
+ GHashTable *htable = g_hash_table_copy(_nth(args,0)->val.hash_table);
+ MalVal *hm = malval_new_hash_map(htable);
+ return _dissoc_BANG(hm, rest(args));
}
MalVal *keys(MalVal *obj) {
@@ -849,10 +867,19 @@ MalVal *sconj(MalVal *args) {
int i, len = _count(src_lst) + _count(args) - 1;
GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
len);
- for (i=1; i<len; i++) {
- g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i));
+ // Copy in src_lst
+ for (i=0; i<_count(src_lst); i++) {
+ g_array_append_val(new_arr, g_array_index(src_lst->val.array, MalVal*, i));
}
- return malval_new_list(MAL_LIST, new_arr);
+ // Conj extra args
+ for (i=1; i<_count(args); i++) {
+ if (src_lst->type & MAL_LIST) {
+ g_array_prepend_val(new_arr, g_array_index(args->val.array, MalVal*, i));
+ } else {
+ g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i));
+ }
+ }
+ return malval_new_list(src_lst->type, new_arr);
}
MalVal *first(MalVal *seq) {
@@ -889,6 +916,27 @@ MalVal *nth(MalVal *seq, MalVal *idx) {
return _nth(seq, idx->val.intnum);
}
+MalVal *sapply(MalVal *args) {
+ assert_type(args, MAL_LIST|MAL_VECTOR,
+ "apply called with non-sequential");
+ MalVal *f = _nth(args, 0);
+ MalVal *last_arg = _nth(args, _count(args)-1);
+ assert_type(last_arg, MAL_LIST|MAL_VECTOR,
+ "last argument to apply is non-sequential");
+ int i, len = _count(args) - 2 + _count(last_arg);
+ GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*),
+ len);
+ // Initial arguments
+ for (i=1; i<_count(args)-1; i++) {
+ g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i));
+ }
+ // Add arguments from last_arg
+ for (i=0; i<_count(last_arg); i++) {
+ g_array_append_val(new_arr, g_array_index(last_arg->val.array, MalVal*, i));
+ }
+ return apply(f, malval_new_list(MAL_LIST, new_arr));
+}
+
MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2) {
MalVal *e, *el;
assert_type(lst, MAL_LIST|MAL_VECTOR,
@@ -1007,8 +1055,8 @@ types_ns_entry types_ns[49] = {
{"<=", (void*(*)(void*))int_lte, 2},
{"hash-map", (void*(*)(void*))hash_map, -1},
{"map?", (void*(*)(void*))hash_map_Q, 1},
- {"assoc", (void*(*)(void*))assoc, 3},
- {"dissoc", (void*(*)(void*))dissoc, 2},
+ {"assoc", (void*(*)(void*))assoc, -1},
+ {"dissoc", (void*(*)(void*))dissoc, -1},
{"get", (void*(*)(void*))get, 2},
{"contains?", (void*(*)(void*))contains_Q, 2},
{"keys", (void*(*)(void*))keys, 1},
@@ -1033,6 +1081,6 @@ types_ns_entry types_ns[49] = {
{"last", (void*(*)(void*))last, 1},
{"rest", (void*(*)(void*))rest, 1},
{"nth", (void*(*)(void*))nth, 2},
- {"apply", (void*(*)(void*))apply, 2},
+ {"apply", (void*(*)(void*))sapply, -1},
{"map", (void*(*)(void*))map, 2},
};
diff --git a/docs/step_notes.txt b/docs/step_notes.txt
index 63e7a76..b5b1c6f 100644
--- a/docs/step_notes.txt
+++ b/docs/step_notes.txt
@@ -168,12 +168,18 @@ Step Notes:
- throw function
- apply, map functions: should not directly call EVAL, which
requires the function object to be runnable
- - symbol?, nil?, true?, false?, sequential? (if not already)
- - conj, first, rest
- EVAL:
- try*/catch*: for normal exceptions, extracts string
otherwise extracts full value
- - define cond and or macros using rep()
+
+- Extra defintions needed for self-hosting
+ - types module:
+ - symbol?, nil?, true?, false?, sequential? (if not already)
+ - first, rest
+ - define cond and or macros using REP/RE
+
+- Other misc:
+ - conj function
- atoms
- reader module:
diff --git a/java/src/main/java/mal/types.java b/java/src/main/java/mal/types.java
index 1e9bb34..8a4910b 100644
--- a/java/src/main/java/mal/types.java
+++ b/java/src/main/java/mal/types.java
@@ -716,12 +716,21 @@ public class types {
static MalFunction conj = new MalFunction() {
public MalVal apply(MalList a) throws MalThrowable {
- MalList lst = new MalList();
- lst.value.addAll(((MalList)a.nth(0)).value);
- for(Integer i=1; i<a.size(); i++) {
- lst.value.add(a.nth(i));
+ MalList src_seq = (MalList)a.nth(0), new_seq;
+ if (a.nth(0) instanceof MalVector) {
+ new_seq = new MalVector();
+ new_seq.value.addAll(src_seq.value);
+ for(Integer i=1; i<a.size(); i++) {
+ new_seq.value.add(a.nth(i));
+ }
+ } else {
+ new_seq = new MalList();
+ new_seq.value.addAll(src_seq.value);
+ for(Integer i=1; i<a.size(); i++) {
+ new_seq.value.add(0, a.nth(i));
+ }
}
- return (MalVal) lst;
+ return (MalVal) new_seq;
}
};
diff --git a/js/types.js b/js/types.js
index 062b0dd..18fad0a 100644
--- a/js/types.js
+++ b/js/types.js
@@ -2,6 +2,9 @@
var types = {};
if (typeof module === 'undefined') {
var exports = types;
+} else {
+ // map output/print to console.log
+ var print = exports.print = function () { console.log.apply(console, arguments); };
}
// General utility functions
@@ -112,13 +115,13 @@ function str() {
}
function prn() {
- console.log.apply(console, Array.prototype.map.call(arguments,function(exp) {
+ print.apply({}, Array.prototype.map.call(arguments,function(exp) {
return _pr_str(exp, true);
}));
}
function println() {
- console.log.apply(console, Array.prototype.map.call(arguments,function(exp) {
+ print.apply({}, Array.prototype.map.call(arguments,function(exp) {
return _pr_str(exp, false);
}));
}
@@ -325,7 +328,13 @@ function concat(lst) {
}
function conj(lst) {
- return lst.concat(Array.prototype.slice.call(arguments, 1));
+ if (list_Q(lst)) {
+ return Array.prototype.slice.call(arguments, 1).reverse().concat(lst);
+ } else {
+ var v = lst.concat(Array.prototype.slice.call(arguments, 1));
+ v.__isvector__ = true;
+ return v;
+ }
}
function first(lst) { return lst[0]; }
diff --git a/make/types.mk b/make/types.mk
index 234ca51..9f03530 100644
--- a/make/types.mk
+++ b/make/types.mk
@@ -181,7 +181,10 @@ apply = $(call $(1)_value,$($(2)_value))
# Takes a space separated arguments and invokes the first argument
# (function object) using the remaining arguments.
-sapply = $(call $(word 1,$(1))_value,$($(word 2,$(1))_value))
+sapply = $(call $(word 1,$(1))_value,\
+ $(strip \
+ $(wordlist 2,$(call gmsl_subtract,$(words $(1)),1),$(1)) \
+ $($(word $(words $(1)),$(1))_value)))
#
# hash maps (associative arrays)
@@ -203,17 +206,22 @@ _assoc_seq! = $(call _assoc!,$(1),$(call str_decode,$($(word 1,$(2))_value)),$(w
_assoc! = $(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),$(eval $(1)_size := $(call gmsl_plus,$($(1)_size),1)),)$(eval $(1)_$(k)_value := $(3))$(1))
# set a key/value in a copy of the hash map
-# TODO: multiple arguments
-assoc = $(foreach hm,$(call _clone_obj,$(word 1,$(1))),$(call _assoc!,$(hm),$(call str_decode,$($(word 2,$(1))_value)),$(word 3,$(1))))
+assoc = $(word 1,\
+ $(foreach hm,$(call _clone_obj,$(word 1,$(1))),\
+ $(hm) \
+ $(call _assoc_seq!,$(hm),$(wordlist 2,$(words $(1)),$(1)))))
# unset a key in the hash map
_dissoc! = $(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),,$(eval $(1)_$(k)_value := $(__undefined))$(eval $(1)_size := $(call gmsl_subtract,$($(1)_size),1))))$(1)
-# unset a key in a copy of the hash map
-# TODO: this could be made more efficient by not copying the key in
-# the first place
-# TODO: multiple arguments
-dissoc = $(foreach hm,$(call _clone_obj,$(word 1,$(1))),$(call _dissoc!,$(hm),$(call str_decode,$($(word 2,$(1))_value))))
+# unset keys in a copy of the hash map
+# TODO: this could be made more efficient by copying only the
+# keys that not being removed.
+dissoc = $(word 1,\
+ $(foreach hm,$(call _clone_obj,$(word 1,$(1))),\
+ $(hm) \
+ $(foreach key,$(wordlist 2,$(words $(1)),$(1)),\
+ $(call _dissoc!,$(hm),$(call str_decode,$($(key)_value))))))
keys = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$(call string,$(word 4,$(subst _, ,$(v)))))))
@@ -322,7 +330,13 @@ empty? = $(if $(call _EQ,0,$(if $(call _hash_map?,$(1)),$($(1)_size),$(words $($
concat = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $(strip $(foreach lst,$1,$(call __get_obj_values,$(lst)))))))
-conj = $(word 1,$(foreach new_list,$(call __new_obj_like,$(word 1,$(1))),$(new_list) $(eval $(new_list)_value := $(strip $($(word 1,$(1))_value) $(wordlist 2,$(words $(1)),$(1))))))
+conj = $(word 1,$(foreach new_list,$(call __new_obj_like,$(word 1,$(1))),\
+ $(new_list) \
+ $(eval $(new_list)_value := $(strip $($(word 1,$(1))_value))) \
+ $(if $(call _list?,$(new_list)),\
+ $(foreach elem,$(wordlist 2,$(words $(1)),$(1)),\
+ $(eval $(new_list)_value := $(strip $(elem) $($(new_list)_value)))),\
+ $(eval $(new_list)_value := $(strip $($(new_list)_value) $(wordlist 2,$(words $(1)),$(1)))))))
# conj that mutates a sequence in-place to append the call arguments
_conj! = $(eval $(1)_value := $(strip $($(1)_value) $2 $3 $4 $5 $6 $7 $8 $9 $(10) $(11) $(12) $(13) $(14) $(15) $(16) $(17) $(18) $(19) $(20)))$(1)
@@ -339,7 +353,9 @@ slast = $(word $(words $($(1)_value)),$($(1)_value))
# Creates a new vector/list of the everything after but the first
# element
-srest = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $(wordlist 2,$(words $($(1)_value)),$($(1)_value)))))
+srest = $(word 1,$(foreach new_list,$(call _list),\
+ $(new_list) \
+ $(eval $(new_list)_value := $(wordlist 2,$(words $($(1)_value)),$($(1)_value)))))
# maps a make function over a list object, using mutating _conj!
_smap = $(word 1,\
@@ -358,7 +374,7 @@ _smap_vec = $(word 1,\
# Map a function object over a list object
smap = $(strip\
$(foreach func,$(word 1,$(1)),\
- $(foreach lst,$(word 2,$(1)),\
+ $(foreach lst,$(word 2,$(1)),\
$(foreach type,$(word 2,$(subst _, ,$(lst))),\
$(foreach new_hcode,$(call __new_obj_hash_code),\
$(foreach sz,$(words $(call __get_obj_values,$(lst))),\
@@ -372,7 +388,7 @@ smap = $(strip\
_equal? = $(strip \
$(foreach ot1,$(call _obj_type,$(1)),$(foreach ot2,$(call _obj_type,$(2)),\
$(if $(or $(call _EQ,$(ot1),$(ot2)),\
- $(and $(call _sequential?,$(1)),$(call _sequential?,$(2)))),\
+ $(and $(call _sequential?,$(1)),$(call _sequential?,$(2)))),\
$(if $(or $(call _string?,$(1)),$(call _symbol?,$(1)),$(call _number?,$(1))),\
$(call _EQ,$($(1)_value),$($(2)_value)),\
$(if $(or $(call _vector?,$(1)),$(call _list?,$(1)),$(call _hash_map?,$(1))),\
diff --git a/php/types.php b/php/types.php
index 0c4ab33..4486a18 100644
--- a/php/types.php
+++ b/php/types.php
@@ -338,12 +338,11 @@ function concat() {
function conj($src) {
$args = array_slice(func_get_args(), 1);
$tmp = $src->getArrayCopy();
- foreach ($args as $arg) {
- $tmp[] = $arg;
- }
if (list_Q($src)) {
+ foreach ($args as $arg) { array_unshift($tmp, $arg); }
$s = new ListClass();
} else {
+ foreach ($args as $arg) { $tmp[] = $arg; }
$s = new VectorClass();
}
$s->exchangeArray($tmp);
@@ -368,8 +367,10 @@ function nth($seq, $idx) {
return $seq[$idx];
}
-function apply($f, $args) {
- return $f->apply($args->getArrayCopy());
+function apply($f) {
+ $args = array_slice(func_get_args(), 1);
+ $last_arg = array_pop($args)->getArrayCopy();
+ return $f->apply(array_merge($args, $last_arg));
}
function map($f, $seq) {
@@ -480,7 +481,7 @@ $types_ns = array(
'first'=> function ($a) { return first($a); },
'rest'=> function ($a) { return rest($a); },
'nth'=> function ($a, $b) { return nth($a, $b); },
- 'apply'=> function ($a, $b) { return apply($a, $b); },
+ 'apply'=> function () { return call_user_func_array('apply', func_get_args()); },
'map'=> function ($a, $b) { return map($a, $b); }
);
diff --git a/python/mal_types.py b/python/mal_types.py
index fa0a11e..401a03b 100644
--- a/python/mal_types.py
+++ b/python/mal_types.py
@@ -200,7 +200,10 @@ def concat(*lsts): return List(chain(*lsts))
# retains metadata
def conj(lst, *args):
- new_lst = List(lst + list(args))
+ if list_Q(lst):
+ new_lst = List(list(reversed(list(args))) + lst)
+ else:
+ new_lst = Vector(lst + list(args))
if hasattr(lst, "__meta__"):
new_lst.__meta__ = lst.__meta__
return new_lst
diff --git a/tests/stepA_more.mal b/tests/stepA_more.mal
index bae226d..31eb2bb 100644
--- a/tests/stepA_more.mal
+++ b/tests/stepA_more.mal
@@ -103,15 +103,24 @@
(conj (list) 1)
;=>(1)
(conj (list 1) 2)
-;=>(1 2)
+;=>(2 1)
(conj (list 2 3) 4)
-;=>(2 3 4)
+;=>(4 2 3)
(conj (list 2 3) 4 5 6)
-;=>(2 3 4 5 6)
+;=>(6 5 4 2 3)
(conj (list 1) (list 2 3))
-;=>(1 (2 3))
-(conj [1 2] [3 4] )
-;=>(1 2 [3 4])
+;=>((2 3) 1)
+
+(conj [] 1)
+;=>[1]
+(conj [1] 2)
+;=>[1 2]
+(conj [2 3] 4)
+;=>[2 3 4]
+(conj [2 3] 4 5 6)
+;=>[2 3 4 5 6]
+(conj [1] [2 3])
+;=>[1 [2 3]]
;; Testing first/rest functions
(first '())
@@ -190,6 +199,9 @@
(vals hm2)
;=>(1)
+(count (keys (assoc hm2 "b" 2 "c" 3)))
+;=>3
+
(def! hm3 (assoc hm2 "b" 2))
(count (keys hm3))
;=>2
@@ -263,8 +275,8 @@
;;
;; Testing read-str and eval
-(read-string "[1 2 (3 4) nil]")
-;=>[1 2 (3 4) nil]
+(read-string "(1 2 (3 4) nil)")
+;=>(1 2 (3 4) nil)
(eval (read-string "(+ 4 5)"))
;=>9