1
1
mirror of https://github.com/kanaka/mal.git synced 2024-09-11 13:55:55 +03:00

All: pass stepA tests, in particular with correct conj behavior.

This commit is contained in:
Joel Martin 2014-04-01 22:50:55 -05:00
parent 950e3c765e
commit 9528bb1451
9 changed files with 184 additions and 72 deletions

View File

@ -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}
}

102
c/types.c
View File

@ -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},
};

View File

@ -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:

View File

@ -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;
}
};

View File

@ -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]; }

View File

@ -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))),\

View File

@ -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); }
);

View File

@ -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

View File

@ -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