From f4c8a091aaf662b9b544a852a728459e84e5b7f5 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Sun, 4 Jan 2015 15:47:20 -0600 Subject: 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 --- make/Makefile | 3 +- make/core.mk | 27 ++- make/gmsl.mk | 63 +------ make/numbers.mk | 409 +++++++++++++++++++++++++++++++++++++++++++++ make/types.mk | 18 +- make/util.mk | 30 +++- perf.mal | 22 +-- tests/step1_read_print.mal | 2 + tests/step2_eval.mal | 3 + 9 files changed, 478 insertions(+), 99 deletions(-) create mode 100644 make/numbers.mk 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.* -- cgit v1.2.3