aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoel Martin <github@martintribe.org>2015-01-04 15:47:20 -0600
committerJoel Martin <github@martintribe.org>2015-01-09 16:16:56 -0600
commitf4c8a091aaf662b9b544a852a728459e84e5b7f5 (patch)
treeac1df2f7549cbac089678c6b6bd92083dfa63174
parent0f352c382c7291b12da7f1800f54b9a27a27ad64 (diff)
downloadmal-f4c8a091aaf662b9b544a852a728459e84e5b7f5.tar.gz
mal-f4c8a091aaf662b9b544a852a728459e84e5b7f5.zip
Make: refactor number type. Support large numbers.
- Can support numbers up to 100 decimal digits in length. - Still no support for negative numbers or floating point. - Change time-secs to time-ms and remove conditional in perf.mal
-rw-r--r--make/Makefile3
-rw-r--r--make/core.mk27
-rw-r--r--make/gmsl.mk63
-rw-r--r--make/numbers.mk409
-rw-r--r--make/types.mk18
-rw-r--r--make/util.mk30
-rw-r--r--perf.mal22
-rw-r--r--tests/step1_read_print.mal2
-rw-r--r--tests/step2_eval.mal3
9 files changed, 478 insertions, 99 deletions
diff --git a/make/Makefile b/make/Makefile
index bd19020..39658ac 100644
--- a/make/Makefile
+++ b/make/Makefile
@@ -1,7 +1,8 @@
TESTS = tests/types.mk tests/reader.mk tests/stepA_interop.mk
-SOURCES_BASE = util.mk readline.mk gmsl.mk types.mk reader.mk printer.mk
+SOURCES_BASE = util.mk numbers.mk readline.mk gmsl.mk types.mk \
+ reader.mk printer.mk
SOURCES_LISP = env.mk core.mk stepA_interop.mk
SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
diff --git a/make/core.mk b/make/core.mk
index 0bb17e6..c2cef59 100644
--- a/make/core.mk
+++ b/make/core.mk
@@ -43,18 +43,17 @@ keyword? = $(if $(call _keyword?,$(1)),$(__true),$(__false))
# Number functions
number? = $(if $(call _number?,$(1)),$(__true),$(__false))
-number_lt = $(if $(call int_lt,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false))
-number_lte = $(if $(call int_lte,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false))
-number_gt = $(if $(call int_gt,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false))
-number_gte = $(if $(call int_gte,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false))
+number_lt = $(if $(call int_lt_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false))
+number_lte = $(if $(call int_lte_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false))
+number_gt = $(if $(call int_gt_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false))
+number_gte = $(if $(call int_gte_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false))
-number_plus = $(call _pnumber,$(call int_plus,$($(word 1,$(1))_value),$($(word 2,$(1))_value)))
-number_subtract = $(call _pnumber,$(call int_subtract,$($(word 1,$(1))_value),$($(word 2,$(1))_value)))
-number_multiply = $(call _pnumber,$(call int_multiply,$($(word 1,$(1))_value),$($(word 2,$(1))_value)))
-number_divide = $(call _pnumber,$(call int_divide,$($(word 1,$(1))_value),$($(word 2,$(1))_value)))
-
-time_secs = $(call _number,$(shell echo $$(( $$(date +%s) % 65536 ))))
+number_plus = $(call _pnumber,$(call int_add_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)))
+number_subtract = $(call _pnumber,$(call int_sub_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)))
+number_multiply = $(call _pnumber,$(call int_mult_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)))
+number_divide = $(call _pnumber,$(call int_div_encoded,$($(word 1,$(1))_value),$($(word 2,$(1))_value)))
+time_ms = $(call _number,$(shell echo $$(date +%s%3N)))
# String functions
@@ -70,7 +69,7 @@ read_str= $(call READ_STR,$(1))
slurp = $(call _string,$(call _read_file,$(call str_decode,$($(1)_value))))
subs = $(strip \
- $(foreach start,$(call gmsl_plus,1,$(call int_decode,$($(word 2,$(1))_value))),\
+ $(foreach start,$(call int_add,1,$(call int_decode,$($(word 2,$(1))_value))),\
$(foreach end,$(if $(3),$(call int_decode,$($(3)_value)),$(words $($(word 1,$(1))_value))),\
$(call _string,$(wordlist $(start),$(end),$($(word 1,$(1))_value))))))
@@ -133,7 +132,7 @@ concat = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list
nth = $(strip \
$(if $(call int_lt,$($(word 2,$(1))_value),$(call int_encode,$(call _count,$(word 1,$(1))))),\
- $(word $(call gmsl_plus,1,$(call int_decode,$($(word 2,$(1))_value))),$($(word 1,$(1))_value)),\
+ $(word $(call int_add,1,$(call int_decode,$($(word 2,$(1))_value))),$($(word 1,$(1))_value)),\
$(call _error,nth: index out of range)))
sfirst = $(word 1,$($(1)_value))
@@ -162,7 +161,7 @@ srest = $(word 1,$(foreach new_list,$(call _list),\
# (function object) using the remaining arguments.
sapply = $(call $(word 1,$(1))_value,\
$(strip \
- $(wordlist 2,$(call gmsl_subtract,$(words $(1)),1),$(1)) \
+ $(wordlist 2,$(call int_sub,$(words $(1)),1),$(1)) \
$($(word $(words $(1)),$(1))_value)))
# Map a function object over a list object
@@ -240,7 +239,7 @@ core_ns = type obj_type \
- number_subtract \
* number_multiply \
/ number_divide \
- time-secs time_secs \
+ time-ms time_ms \
\
list _list \
list? list? \
diff --git a/make/gmsl.mk b/make/gmsl.mk
index e988d2c..adfb953 100644
--- a/make/gmsl.mk
+++ b/make/gmsl.mk
@@ -47,66 +47,13 @@ __mal_gmsl_included := true
#
# ----------------------------------------------------------------------------
-
-# Numbers
-__gmsl_sixteen := x x x x x x x x x x x x x x x x
-__gmsl_input_int := $(foreach a,$(__gmsl_sixteen), \
- $(foreach b,$(__gmsl_sixteen), \
- $(foreach c,$(__gmsl_sixteen), \
- $(__gmsl_sixteen)))))
-
-int_decode = $(words $1)
-int_encode = $(wordlist 1,$1,$(__gmsl_input_int))
-
-__gmsl_int_wrap = $(call int_decode,$(call $1,$(call int_encode,$2),$(call int_encode,$3)))
-
-int_plus = $(strip $1 $2)
-int_subtract = $(strip $(if $(call int_gte,$1,$2), \
- $(filter-out xx,$(join $1,$2)), \
- $(warning Subtraction underflow)))
-int_multiply = $(strip $(foreach a,$1,$2))
-# _error function must be provided to report/catch division by zero
-int_divide = $(strip $(if $2, \
- $(if $(call int_gte,$1,$2), \
- x $(call int_divide,$(call int_subtract,$1,$2),$2),), \
- $(call _error,Division by zero)))
-
-int_max = $(subst xx,x,$(join $1,$2))
-int_min = $(subst xx,x,$(filter xx,$(join $1,$2)))
-int_gt = $(strip $(filter-out $(words $2),$(words $(call int_max,$1,$2))))
-int_gte = $(strip $(call int_gt,$1,$2)$(call int_eq,$1,$2))
-int_lt = $(strip $(filter-out $(words $1),$(words $(call int_max,$1,$2))))
-int_lte = $(strip $(call int_lt,$1,$2)$(call int_eq,$1,$2))
-int_eq = $(strip $(filter $(words $1),$(words $2)))
-int_ne = $(strip $(filter-out $(words $1),$(words $2)))
-
-gmsl_plus = $(call __gmsl_int_wrap,int_plus,$1,$2)
-gmsl_subtract = $(call __gmsl_int_wrap,int_subtract,$1,$2)
-gmsl_multiply = $(call __gmsl_int_wrap,int_multiply,$1,$2)
-gmsl_divide = $(call __gmsl_int_wrap,int_divide,$1,$2)
-
-
# Strings
-__gmsl_characters := A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
-__gmsl_characters += a b c d e f g h i j k l m n o p q r s t u v w x y z
-__gmsl_characters += 0 1 2 3 4 5 6 7 8 9
-__gmsl_characters += ` ~ ! @ \# $$ % ^ & * ( ) - _ = +
-__gmsl_characters += { } [ ] \ : ; ' " < > , . / ? |
-__syntax_highlight_protect = #"'`
-
-
-__gmsl_space :=
-__gmsl_space +=
-
-gmsl_strlen = $(strip $(eval __temp := $(subst $(__gmsl_space),x,$1)) \
- $(foreach a,$(__gmsl_characters),$(eval __temp := $$(subst $$a,x,$(__temp)))) \
- $(eval __temp := $(subst x,x ,$(__temp))) \
- $(words $(__temp)))
-
-gmsl_merge = $(strip $(if $2, \
- $(if $(call _EQ,1,$(words $2)), \
- $2,$(firstword $2)$1$(call gmsl_merge,$1,$(wordlist 2,$(words $2),$2)))))
+gmsl_characters := A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
+gmsl_characters += a b c d e f g h i j k l m n o p q r s t u v w x y z
+gmsl_characters += 0 1 2 3 4 5 6 7 8 9
+gmsl_characters += ` ~ ! @ \# $$ % ^ & * ( ) - _ = +
+gmsl_characters += { } [ ] \ : ; ' " < > , . / ? |
gmsl_pairmap = $(strip \
$(if $2$3,$(call $1,$(word 1,$2),$(word 1,$3)) \
diff --git a/make/numbers.mk b/make/numbers.mk
new file mode 100644
index 0000000..b0fa29a
--- /dev/null
+++ b/make/numbers.mk
@@ -0,0 +1,409 @@
+#
+# mal (Make a Lisp) number types
+#
+
+ifndef __mal_numbers_included
+__mal_numbers_included := true
+
+_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST)))
+include $(_TOP_DIR)util.mk
+
+LIST20_X := x x x x x x x x x x x x x x x x x x x x
+LIST100_X := $(foreach x,$(LIST20_X),X X X X X)
+LIST100_0 := $(foreach x,$(LIST20_X),0 0 0 0 0)
+LIST100_9 := $(foreach x,$(LIST20_X),9 9 9 9 9)
+
+###
+### general numeric utility functions
+###
+
+int_encode = $(strip $(call _reverse,\
+ $(eval __temp := $(1))\
+ $(foreach a,0 1 2 3 4 5 6 7 8 9,\
+ $(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(__temp)))
+
+int_decode = $(strip $(call _join,$(call _reverse,$(1))))
+
+# trim extaneous zero digits off the end (front of number)
+_trim_zeros = $(if $(call _EQ,0,$(strip $(1))),0,$(if $(call _EQ,0,$(word 1,$(1))),$(call _trim_zeros,$(wordlist 2,$(words $(1)),$(1))),$(1)))
+trim_zeros = $(strip $(if $(call _EQ,0,$(strip $(1))),$(1),$(call _reverse,$(call _trim_zeros,$(call _reverse,$(1))))))
+
+# drop the last element of a list of words/digits
+drop_last = $(call _reverse,$(wordlist 2,$(words $(1)),$(call _reverse,$(1))))
+
+### utility function tests
+
+#$(info $(filter-out 1,$(filter 1%,1 132 456)))
+#$(info (int_encode 13): [$(call int_encode,13)])
+#$(info (int_encode 156463): [$(call int_encode,156463)])
+#$(info (int_decode (int_encode 156463)): [$(call int_decode,$(call int_encode,156463))])
+
+#$(info trim_zeros(0 0 0): [$(call trim_zeros,0 0 0)])
+
+
+###
+### comparisons
+###
+
+# compare two digits and return 'true' if digit 1 is less than or
+# equal to digit 2
+_lte_digit = $(strip \
+ $(if $(call _EQ,$(1),$(2)),\
+ true,\
+ $(if $(call _EQ,0,$(1)),\
+ true,\
+ $(if $(wordlist $(1),$(2),$(LIST20_X)),\
+ true,\
+ ))))
+
+# compare two lists of digits (MSB->LSB) of equal length and return
+# 'true' if number 1 is less than number 2
+_lte_digits = $(strip \
+ $(if $(strip $(1)),\
+ $(if $(call _EQ,$(word 1,$(1)),$(word 1,$(2))),\
+ $(call _lte_digits,$(wordlist 2,$(words $(1)),$(1)),$(wordlist 2,$(words $(2)),$(2))),\
+ $(if $(call _lte_digit,$(word 1,$(1)),$(word 1,$(2))),true,)),\
+ true))
+
+### lte/less than or equal to
+
+int_lte_encoded = $(strip \
+ $(foreach len1,$(words $(1)),$(foreach len2,$(words $(2)),\
+ $(if $(call _EQ,$(len1),$(len2)),\
+ $(call _lte_digits,$(call _reverse,$(1)),$(call _reverse,$(2))),\
+ $(if $(wordlist $(len1),$(len2),$(LIST100_X)),\
+ true,\
+ )))))
+
+int_lte = $(call int_lte_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))
+
+### lt/less than
+
+int_lt_encoded = $(strip \
+ $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\
+ ,\
+ $(call int_lte_encoded,$(1),$(2))))
+
+int_lt = $(call int_lt_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))
+
+### gte/greater than or equal to
+
+int_gte_encoded = $(strip \
+ $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\
+ true,\
+ $(if $(call int_lte_encoded,$(1),$(2)),,true)))
+
+int_gte = $(call int_gte_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))
+
+### gt/greater than
+
+int_gt_encoded = $(strip \
+ $(if $(call _EQ,$(strip $(1)),$(strip $(2))),\
+ ,\
+ $(call int_gte_encoded,$(1),$(2))))
+
+int_gt = $(call int_gt_encoded,$(call int_encode,$(1)),$(call int_encode,$(2)))
+
+#$(info _lte_digit,7,8: [$(call _lte_digit,7,8)])
+#$(info _lte_digit,8,8: [$(call _lte_digit,8,8)])
+#$(info _lte_digit,2,1: [$(call _lte_digit,2,1)])
+#$(info _lte_digit,0,0: [$(call _lte_digit,0,0)])
+#$(info _lte_digit,0,1: [$(call _lte_digit,0,1)])
+#$(info _lte_digit,1,0: [$(call _lte_digit,1,0)])
+
+#$(info _lte_digits,1 2 3,1 2 4: [$(call _lte_digits,1 2 3,1 2 4)])
+#$(info _lte_digits,1 2 4,1 2 4: [$(call _lte_digits,1 2 4,1 2 4)])
+#$(info _lte_digits,1 2 5,1 2 4: [$(call _lte_digits,1 2 5,1 2 4)])
+#$(info _lte_digits,4 1,9 0: [$(call _lte_digits,4 1,9 0)])
+
+#$(info int_lte_encoded,1,1: [$(call int_lte_encoded,1,1)])
+#$(info int_lte_encoded,1,2: [$(call int_lte_encoded,1,2)])
+#$(info int_lte_encoded,2,1: [$(call int_lte_encoded,2,1)])
+#$(info int_lte_encoded,0,3: [$(call int_lte_encoded,0,3)])
+#$(info int_lte_encoded,3,0: [$(call int_lte_encoded,3,0)])
+#$(info int_lte_encoded,1 4,0 9: [$(call int_lte_encoded,1 4,0 9)])
+#$(info int_lte_encoded,4 3 2 1,4 3 2 1: [$(call int_lte_encoded,4 3 2 1,4 3 2 1)])
+#$(info int_lte_encoded,5 3 2 1,4 3 2 1: [$(call int_lte_encoded,5 3 2 1,4 3 2 1)])
+#$(info int_lte_encoded,4 3 2 1,5 3 2 1: [$(call int_lte_encoded,4 3 2 1,5 3 2 1)])
+
+#$(info int_lte,1,1: [$(call int_lte,1,1)])
+#$(info int_lte,1,2: [$(call int_lte,1,2)])
+#$(info int_lte,2,1: [$(call int_lte,2,1)])
+#$(info int_lte,0,3: [$(call int_lte,0,3)])
+#$(info int_lte,3,0: [$(call int_lte,3,0)])
+#$(info int_lte,1234,1234: [$(call int_lte,1234,1234)])
+#$(info int_lte,1235,1234: [$(call int_lte,1235,1234)])
+#$(info int_lte,1234,1235: [$(call int_lte,1234,1235)])
+#
+#$(info int_lt,1,1: [$(call int_lt,1,1)])
+#$(info int_lt,1,2: [$(call int_lt,1,2)])
+#$(info int_lt,2,1: [$(call int_lt,2,1)])
+#$(info int_lt,0,3: [$(call int_lt,0,3)])
+#$(info int_lt,3,0: [$(call int_lt,3,0)])
+#$(info int_lt,1234,1234: [$(call int_lt,1234,1234)])
+#$(info int_lt,1235,1234: [$(call int_lt,1235,1234)])
+#$(info int_lt,1234,1235: [$(call int_lt,1234,1235)])
+#
+#$(info int_gte,1,1: [$(call int_gte,1,1)])
+#$(info int_gte,1,2: [$(call int_gte,1,2)])
+#$(info int_gte,2,1: [$(call int_gte,2,1)])
+#$(info int_gte,0,3: [$(call int_gte,0,3)])
+#$(info int_gte,3,0: [$(call int_gte,3,0)])
+#$(info int_gte,1234,1234: [$(call int_gte,1234,1234)])
+#$(info int_gte,1235,1234: [$(call int_gte,1235,1234)])
+#$(info int_gte,1234,1235: [$(call int_gte,1234,1235)])
+#
+#$(info int_gt,1,1: [$(call int_gt,1,1)])
+#$(info int_gt,1,2: [$(call int_gt,1,2)])
+#$(info int_gt,2,1: [$(call int_gt,2,1)])
+#$(info int_gt,0,3: [$(call int_gt,0,3)])
+#$(info int_gt,3,0: [$(call int_gt,3,0)])
+#$(info int_gt,1234,1234: [$(call int_gt,1234,1234)])
+#$(info int_gt,1235,1234: [$(call int_gt,1235,1234)])
+#$(info int_gt,1234,1235: [$(call int_gt,1234,1235)])
+
+
+###
+### addition
+###
+
+
+# add_digits_with_carry
+_add_digit = $(words $(if $(strip $(1)),$(wordlist 1,$(1),$(LIST20_X)),) \
+ $(if $(strip $(2)),$(wordlist 1,$(2),$(LIST20_X)),))
+
+# add one to a single digit
+_inc_digit = $(words $(wordlist 1,$(if $(1),$(1),0),$(LIST20_X)) x)
+
+# add two encoded numbers digit by digit without resolving carries
+# (each digit will be larger than 9 if there is a carry value)
+_add = $(if $(1)$(2),$(call _add_digit,$(word 1,$(1)),$(word 1,$(2))) $(call _add,$(wordlist 2,$(words $(1)),$(1)),$(wordlist 2,$(words $(2)),$(2))),)
+
+# take the result of _add and resolve the carry values digit by digit
+_resolve_carries = $(strip \
+ $(if $(1),\
+ $(foreach num,$(word 1,$(1)),\
+ $(if $(filter-out 1,$(filter 1%,$(num))),\
+ $(call _resolve_carries,$(call _inc_digit,$(word 2,$(1))) $(wordlist 3,$(words $(1)),$(1)),$(2) $(patsubst 1%,%,$(num))),\
+ $(call _resolve_carries,$(wordlist 2,$(words $(1)),$(1)),$(2) $(num)))),\
+ $(2)))
+
+# add two encoded numbers, returns encoded number
+int_add_encoded = $(call _resolve_carries,$(call _add,$(1),$(2)))
+
+# add two unencoded numbers, returns unencoded number
+int_add = $(call int_decode,$(call int_add_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))))
+
+### addition tests
+
+#$(info _add_digit(7,6,1): [$(call _add_digit,7,6,1)])
+#$(info _add_digit(7,6,0): [$(call _add_digit,7,6,0)])
+#$(info _add_digit(7,6,0): [$(call _add_digit,7,6,0)])
+#$(info _carries(12 14 15): [$(call _carries,12 14 15)])
+#$(info _inc_digit(0): $(call _inc_digit,0))
+#$(info _inc_digit(1): $(call _inc_digit,1))
+#$(info _inc_digit(9): $(call _inc_digit,9))
+#$(info _inc_digit(18): $(call _inc_digit,18))
+#$(info int_add_encoded(0,0): [$(call int_add_encoded,0,0)])
+
+#$(info int_add(1,2): [$(call int_add,1,2)])
+#$(info int_add(9,9): [$(call int_add,9,9)])
+#$(info int_add(0,9): [$(call int_add,0,9)])
+#$(info int_add(9,0): [$(call int_add,9,0)])
+#$(info int_add(0,0): [$(call int_add,0,0)])
+#$(info int_add(123,456): [$(call int_add,123,456)])
+#$(info int_add(678,789): [$(call int_add,678,789)])
+#$(info int_add(1,12): [$(call int_add,1,12)])
+#$(info int_add(123,5): [$(call int_add,123,5)])
+#$(info int_add(123456,9): [$(call int_add,123456,9)])
+#$(info int_add(999999991,9): [$(call int_add,999999991,9)])
+
+###
+### subtraction
+###
+
+_get_zeros = $(if $(call _EQ,0,$(word 1,$(1))),$(call _get_zeros,$(wordlist 2,$(words $(1)),$(1)),$(2) 0),$(2))
+
+# return a 9's complement of a single digit
+_complement9 = $(strip \
+ $(if $(call _EQ,0,$(1)),9,\
+ $(if $(call _EQ,1,$(1)),8,\
+ $(if $(call _EQ,2,$(1)),7,\
+ $(if $(call _EQ,3,$(1)),6,\
+ $(if $(call _EQ,4,$(1)),5,\
+ $(if $(call _EQ,5,$(1)),4,\
+ $(if $(call _EQ,6,$(1)),3,\
+ $(if $(call _EQ,7,$(1)),2,\
+ $(if $(call _EQ,8,$(1)),1,\
+ $(if $(call _EQ,9,$(1)),0)))))))))))
+
+# return a 10's complement of a single digit
+_complement10 = $(call _inc_digit,$(call _complement9,$(1)))
+
+#
+_complement_rest = $(if $(strip $(1)),\
+ $(strip \
+ $(call _complement10,$(word 1,$(1))) \
+ $(foreach digit,$(wordlist 2,$(words $(1)),$(1)),\
+ $(call _complement9,$(digit)))),)
+
+# return the complement of a number
+_complement = $(strip $(call _get_zeros,$(1)) \
+ $(call _complement_rest,$(wordlist $(call _inc_digit,$(words $(call _get_zeros,$(1)))),$(words $(1)),$(1))))
+
+# subtracted encoded number 2 from encoded number 1 and return and
+# encoded number result
+int_sub_encoded = $(strip \
+ $(if $(call _EQ,0,$(strip $(2))),\
+ $(1),\
+ $(call trim_zeros,\
+ $(call drop_last,\
+ $(call int_add_encoded,\
+ $(1),\
+ $(wordlist 1,$(words $(1)),$(call _complement,$(2)) $(LIST100_9)))))))
+
+# subtract unencoded number 2 from unencoded number 1 and return
+# unencoded result
+int_sub = $(call int_decode,$(call int_sub_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))))
+
+### subtraction tests
+
+#$(info _get_zeros(5 7): [$(call _get_zeros,5 7)])
+#$(info _get_zeros(0 0 0 2): [$(call _get_zeros,0 0 0 2)])
+#$(info _get_zeros(0 0 0 2 5): [$(call _get_zeros,0 0 0 2 5)])
+
+#$(info _complement(0): [$(call _complement,0)])
+#$(info _complement(1): [$(call _complement,1)])
+#$(info _complement(9): [$(call _complement,9)])
+#$(info _complement(5 7): [$(call _complement,5 7)])
+#$(info _complement(0 0 0 2): [$(call _complement,0 0 0 2)])
+#$(info _complement(0 0 0 5 4 3 2 1): [$(call _complement,0 0 0 5 4 3 2 1)])
+
+#$(info int_sub_encoded(0 0 1, 3 1): [$(call int_sub_encoded,0 0 1,3 1)])
+#$(info int_sub_encoded(2, 2): [$(call int_sub_encoded,2,2)])
+
+#$(info int_sub(2,1): [$(call int_sub,2,1)])
+#$(info int_sub(2,0): [$(call int_sub,2,0)])
+#$(info int_sub(2,2): [$(call int_sub,2,2)])
+#$(info int_sub(100,13): [$(call int_sub,100,13)])
+#$(info int_sub(100,99): [$(call int_sub,100,99)])
+#$(info int_sub(91,19): [$(call int_sub,91,19)])
+
+
+###
+### multiplication
+###
+
+# multiply two digits
+#_mult_digit = $(words $(foreach x,$(1),$(2)))
+_mult_digit = $(strip \
+ $(words $(foreach x,$(wordlist 1,$(1),$(LIST20_X)),\
+ $(wordlist 1,$(2),$(LIST20_X)))))
+
+# multipy every digit of number 1 with number 2
+# params: digits, digit, indent_zeros, results
+_mult_row = $(if $(strip $(1)),$(call _mult_row,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)0,$(4) $(call _mult_digit,$(word 1,$(1)),$(2))$(3)),$(4))
+
+# multiply every digit of number 2 with every digit of number 1 adding
+# correct zero padding to the end of each result
+# params: digits, digits, indent_zeros, results
+_mult_each = $(if $(strip $(2)),$(call _mult_each,$(1),$(wordlist 2,$(words $(2)),$(2)),$(3)0,$(4) $(call _mult_row,$(1),$(word 1,$(2)),$(3))),$(4))
+
+# add up a bunch of unencoded numbers. Basically reduce into the first number
+_add_many = $(if $(word 2,$(1)),$(call _add_many,$(call int_add,$(word 1,$(1)),$(word 2,$(1))) $(wordlist 3,$(words $(1)),$(1))),$(1))
+
+# multiply two encoded numbers, returns encoded number
+int_mult_encoded = $(call trim_zeros,$(call int_encode,$(call _add_many,$(call _mult_each,$(1),$(2)))))
+
+# multiply two unencoded numbers, returns unencoded number
+int_mult = $(call int_decode,$(call int_mult_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))))
+
+#$(info _mult_digit(8,6): [$(call _mult_digit,8,6)])
+#$(info _mult_digit(7,6): [$(call _mult_digit,7,6)])
+#$(info _mult_row(8,6): [$(call _mult_row,8,6)])
+#$(info _mult_row(8 7,6): [$(call _mult_row,8 7,6)])
+#$(info _mult_row(8 7 3,6): [$(call _mult_row,8 7 3,6)])
+#$(info _mult_each(8 7 6, 4 3 2): [$(call _mult_each,8 7 6,4 3 2)])
+#$(info _add_many(123 234 345 456): [$(call _add_many,123 234 345 456)])
+
+#$(info int_mult_encoded(8 7 3,6): [$(call int_mult_encoded,8 7 3,6)])
+#$(info int_mult_encoded(8 7 3,0): [$(call int_mult_encoded,8 7 3,0)])
+
+#$(info int_mult(378,6): [$(call int_mult,378,6)])
+#$(info int_mult(678,234): [$(call int_mult,678,234)])
+#$(info int_mult(1,23456): [$(call int_mult,1,23456)])
+#$(info int_mult(0,23456): [$(call int_mult,0,23456)])
+#$(info int_mult(0,0): [$(call int_mult,0,0)])
+
+###
+### division
+###
+
+# return list of zeros needed to pad number 2 to the same length as number 1
+_zero_pad = $(strip $(wordlist 1,$(call int_sub,$(words $(1)),$(words $(2))),$(LIST100_0)))
+
+# num1, num2, zero pad, result_accumulator
+# algorithm:
+# - B = pad with zeros to make same digit length as A
+# - loop
+# - if (B <= A)
+# - A = subtract B from A
+# - C = C + 10^(B pad.length)
+# - else
+# - if B.length < origin B.length: break
+# - chop least significant digit of B
+_div = $(strip \
+ $(if $(call int_lte_encoded,$(3) $(2),$(1)),\
+ $(call _div,$(call int_sub_encoded,$(1),$(3) $(2)),$(2),$(3),$(call int_add_encoded,$(4),$(3) 1)),\
+ $(if $(3),\
+ $(call _div,$(1),$(2),$(wordlist 2,$(words $(3)),$(3)),$(4)),\
+ $(4))))
+
+# divide two encoded numbers, returns encoded number
+int_div_encoded = $(strip \
+ $(if $(call _EQ,0,$(1)),\
+ 0,\
+ $(if $(call _EQ,$(1),$(2)),\
+ 1,\
+ $(if $(call int_gt_encoded,$(2),$(1)),\
+ 0,\
+ $(call _div,$(1),$(2),$(call _zero_pad,$(1),$(2)),0)))))
+
+# divide two unencoded numbers, returns unencoded number
+int_div = $(call int_decode,$(call int_div_encoded,$(call int_encode,$(1)),$(call int_encode,$(2))))
+
+### division tests
+
+#$(info _zero_pad(1 2 3 4,1 3): [$(call _zero_pad,1 2 3 4,1 3)])
+#$(info _zero_pad(1 2,1 3): [$(call _zero_pad,1 2,1 3)])
+#$(info _zero_pad(2,1 3): [$(call _zero_pad,1 2,1 3)])
+#
+#$(info int_div_encoded(2,1): [$(call int_div_encoded,2,1)])
+#$(info int_div_encoded(3,1): [$(call int_div_encoded,3,1)])
+#$(info int_div_encoded(3,2): [$(call int_div_encoded,3,2)])
+#$(info int_div_encoded(0,7): [$(call int_div_encoded,0,7)])
+#$(info int_div_encoded(0 3,0 2): [$(call int_div_encoded,0 3,0 2)])
+#$(info int_div_encoded(0 3,5): [$(call int_div_encoded,0 3,5)])
+#
+#$(info int_div(5,1): [$(call int_div,5,1)])
+#$(info int_div(5,2): [$(call int_div,5,2)])
+#$(info int_div(123,7): [$(call int_div,123,7)])
+#$(info int_div(100,7): [$(call int_div,100,7)])
+
+
+### combination tests
+
+# (/ (- (+ 515 (* 222 311)) 300) 41)
+#$(info int_mult,222,311: [$(call int_mult,222,311)])
+#$(info int_add(515,69042): [$(call int_add,515,69042)])
+#$(info int_sub(69557,300): [$(call int_sub,69557,300)])
+#$(info int_div(69257,41): [$(call int_div,69257,41)])
+
+###############################################################
+
+all:
+ @true
+
+endif
+
+# vim: ts=2 et
diff --git a/make/types.mk b/make/types.mk
index 02588f7..6320396 100644
--- a/make/types.mk
+++ b/make/types.mk
@@ -6,7 +6,9 @@ ifndef __mal_types_included
__mal_types_included := true
_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST)))
+include $(_TOP_DIR)gmsl.mk
include $(_TOP_DIR)util.mk
+include $(_TOP_DIR)numbers.mk
# Low-level type implemenation
@@ -18,7 +20,7 @@ __equal = ≛
__keyword = ʞ
__obj_hash_code = 0
-__new_obj_hash_code = $(eval __obj_hash_code := $(call gmsl_plus,1,$(__obj_hash_code)))$(__obj_hash_code)
+__new_obj_hash_code = $(eval __obj_hash_code := $(call int_add,1,$(__obj_hash_code)))$(__obj_hash_code)
__new_obj = $(__obj_magic)_$(1)_$(call __new_obj_hash_code)
@@ -37,12 +39,12 @@ __var_print = $(foreach v,$(1),\
$(foreach var,$(call __var_name,$(v)),\
$(if $(or $(call _list?,$(v)),$(call _vector?,$(v))),\
$(info $(2)$(var):)\
- $(eval __var_idx := $(call gmsl_plus,1,$(__var_idx)))\
+ $(eval __var_idx := $(call int_add,1,$(__var_idx)))\
$(foreach lidx,__lidx_$(__var_idx),\
$(eval $(lidx) := 0)\
$(foreach val,$($(v)_value),\
$(call __var_print,$(val),$(2)$(SPACE)$(SPACE)$($(lidx)): )\
- $(eval $(lidx) := $(call gmsl_plus,1,$($(lidx)))))),\
+ $(eval $(lidx) := $(call int_add,1,$($(lidx)))))),\
$(if $(call _hash_map?,$(v)),\
$(info $(2)$(var):)\
$(foreach vkey,$(filter $(v)_%,$(.VARIABLES)),\
@@ -189,10 +191,10 @@ _dissoc_seq! = $(foreach key,$(2),\
$(call _dissoc!,$(1),$(call str_decode,$($(key)_value))))
# set a key/value in the hash map
-_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))
+_assoc! = $(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),$(eval $(1)_size := $(call int_add,$($(1)_size),1)),)$(eval $(1)_$(k)_value := $(3))$(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)
+_dissoc! = $(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),,$(eval $(1)_$(k)_value := $(__undefined))$(eval $(1)_size := $(call int_sub,$($(1)_size),1))))$(1)
# Hash map and vector functions
@@ -202,14 +204,14 @@ _get = $(strip \
$(if $(call _hash_map?,$(1)),\
$(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),,$($(1)_$(k)_value))),\
$(if $(call _vector?,$(1)),\
- $(word $(call gmsl_plus,1,$(2)),$($(1)_value)),\
+ $(word $(call int_add,1,$(2)),$($(1)_value)),\
,)))
_contains? = $(strip \
$(if $(call _hash_map?,$(1)),\
$(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),,$(__true))),\
$(if $(call _vector?,$(1)),\
- $(if $(word $(call gmsl_plus,1,$(2)),$($(1)_value)),$(__true),),\
+ $(if $(word $(call int_add,1,$(2)),$($(1)_value)),$(__true),),\
,)))
@@ -217,7 +219,7 @@ _contains? = $(strip \
_sequential? = $(if $(filter $(__obj_magic)_list_% $(__obj_magic)_vect_%,$(1)),$(__true),)
-_nth = $(word $(call gmsl_plus,1,$(2)),$($(1)_value))
+_nth = $(word $(call int_add,1,$(2)),$($(1)_value))
# 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)
diff --git a/make/util.mk b/make/util.mk
index eff258a..ffe635d 100644
--- a/make/util.mk
+++ b/make/util.mk
@@ -62,10 +62,34 @@ _EQ = $(if $(subst x$1,,x$2)$(subst x$2,,x$1),,true)
_NOT = $(if $1,,true)
-# READ: read and parse input
-str_encode = $(strip $(eval __temp := $$(subst $$$$,$(_DOL) ,$$(subst $(SPLICE_UNQUOTE),$(_SUQ) ,$$(subst $$(LPAREN),$$(_LP) ,$$(subst $$(RPAREN),$$(_RP) ,$$(subst $$(LCURLY),$$(_LC) ,$$(subst $$(RCURLY),$$(_RC) ,$$(subst $$(NEWLINE),$$(_NL) ,$$(subst $$(SPACE),$(_SP) ,$$1)))))))))$(foreach a,$(__gmsl_characters),$(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(__temp))
+# take a list of words and join them with a separator
+# params: words, seperator, result
+_join = $(strip \
+ $(if $(strip $(1)),\
+ $(if $(strip $(3)),\
+ $(call _join,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)$(2)$(word 1,$(1))),\
+ $(call _join,$(wordlist 2,$(words $(1)),$(1)),$(2),$(word 1,$(1)))),\
+ $(3)))
-str_decode = $(subst $(_SP),$(SPACE),$(subst $(_NL),$(NEWLINE),$(subst $(_LC),$(LCURLY),$(subst $(_RC),$(RCURLY),$(subst $(_LP),$(LPAREN),$(subst $(_RP),$(RPAREN),$(subst $(_SUQ),$(SPLICE_UNQUOTE),$(subst $(_DOL),$$,$(strip $(call gmsl_merge,,$(1)))))))))))
+#$(info _join(1 2 3 4): [$(call _join,1 2 3 4)])
+#$(info _join(1 2 3 4,X): [$(call _join,1 2 3 4, )])
+#$(info _join(1): [$(call _join,1)])
+#$(info _join(): [$(call _join,)])
+
+# reverse list of words
+_reverse = $(if $(1),$(call _reverse,$(wordlist 2,$(words $(1)),$(1)))) $(firstword $(1))
+
+#$(info reverse(1 2 3 4 5): $(call reverse,1 2 3 4 5))
+
+# str_encode: take a string and return an encoded version of it with
+# every character separated by a space and special characters replaced
+# with special Unicode characters
+str_encode = $(strip $(eval __temp := $$(subst $$$$,$(_DOL) ,$$(subst $(SPLICE_UNQUOTE),$(_SUQ) ,$$(subst $$(LPAREN),$$(_LP) ,$$(subst $$(RPAREN),$$(_RP) ,$$(subst $$(LCURLY),$$(_LC) ,$$(subst $$(RCURLY),$$(_RC) ,$$(subst $$(NEWLINE),$$(_NL) ,$$(subst $$(SPACE),$(_SP) ,$$1)))))))))$(foreach a,$(gmsl_characters),$(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(__temp))
+
+# str_decode: take an encoded string an return an unencoded version of
+# it by replacing the special Unicode charactes with the real
+# characters and with all characters joined into a regular string
+str_decode = $(subst $(_SP),$(SPACE),$(subst $(_NL),$(NEWLINE),$(subst $(_LC),$(LCURLY),$(subst $(_RC),$(RCURLY),$(subst $(_LP),$(LPAREN),$(subst $(_RP),$(RPAREN),$(subst $(_SUQ),$(SPLICE_UNQUOTE),$(subst $(_DOL),$$,$(strip $(call _join,$(1)))))))))))
# Read a whole file substituting newlines with $(_NL)
_read_file = $(subst $(_NL),$(NEWLINE),$(shell out=""; while read -r l; do out="$${out}$${l}$(_NL)"; done < $(1); echo "$$out"))
diff --git a/perf.mal b/perf.mal
index e00d2ef..79e6230 100644
--- a/perf.mal
+++ b/perf.mal
@@ -1,15 +1,7 @@
-(if (= "make" *host-language*)
- (defmacro! time
- (fn* (exp)
- `(let* [start_FIXME (time-secs)
- ret_FIXME ~exp]
- (do
- (prn (str "Elapsed time: " (- (time-secs) start_FIXME) "000 msecs"))
- ret_FIXME))))
- (defmacro! time
- (fn* (exp)
- `(let* [start_FIXME (time-ms)
- ret_FIXME ~exp]
- (do
- (prn (str "Elapsed time: " (- (time-ms) start_FIXME) " msecs"))
- ret_FIXME)))))
+(defmacro! time
+ (fn* (exp)
+ `(let* [start_FIXME (time-ms)
+ ret_FIXME ~exp]
+ (do
+ (prn (str "Elapsed time: " (- (time-ms) start_FIXME) " msecs"))
+ ret_FIXME))))
diff --git a/tests/step1_read_print.mal b/tests/step1_read_print.mal
index 4ac08cb..8172479 100644
--- a/tests/step1_read_print.mal
+++ b/tests/step1_read_print.mal
@@ -40,6 +40,8 @@ abc-def
;=>"abc\"def"
;;;"abc\ndef"
;;;;=>"abc\ndef"
+""
+;=>""
;; Testing read of lists
diff --git a/tests/step2_eval.mal b/tests/step2_eval.mal
index 2f48c73..aaf1a7d 100644
--- a/tests/step2_eval.mal
+++ b/tests/step2_eval.mal
@@ -11,6 +11,9 @@
(/ (- (+ 5 (* 2 3)) 3) 4)
;=>2
+(/ (- (+ 515 (* 222 311)) 300) 41)
+;=>1689
+
(abc 1 2 3)
; .*\'abc\' not found.*