From 36f77e92323b534ebcac4f2384eb28ec5e7bf4ff Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Tue, 1 Feb 2022 18:06:57 +0100 Subject: [PATCH] make: improve efficiency and encapsulation Readability * Use implicit parameter transmission ($(_list?) instead of $(call _list?,$1), first/lastword instead of word 1/words, $1 instead of $(1). * Use an undefined $(rem) macro and some automatic stripping (if, foreach) to indent code with less calls to `strip` functions. * Name the Make macro implementing a MAL core function exactly like the function (modulo the encoding above) and simplify core_ns accordingly. * Replace empty results representing `nil` with explicit MAL values. * Implement large conditionals with a computed variable name, as already done in printer.mk. For QUASIQUOTE and EVAL, this reduces a lot the diff between steps. * Represent the reader state as an explicit global variable instead of passing the same name as argument again and again. * Merge read-atom into read-form so that the switch on first character is more visible. Encapsulation * Hide most representations into types.mk. * Implement the type as a suffix in order to avoid a conditional in _obj_type. * Implement _error with throw. * Create distinct types for keywords and macros. * Move most metadata and atom stuff from core.mk to types.mk. * Move parameter association from env to types because it hides more about the representation of functions. Representation * Encode Make special characters in all strings/keywords/symbols, so they can be used directly as spaced words and/or variable names for map keys. (The encoding adding separating characters is kept for read-string and seq). * Change representation of numbers/strings/keywords/symbols, reducing the number of Make variables. Various * Allow keyword argument for keyword core function. * Shorten time-mes,slurp,readline... * Remove obsolete stuff: * `get` and `contains?` for vectors * `count` for hash-maps * `_join` from util.mk. * `type` from core.mk. * Add a function listing env_keys for DEBUG-EVAL. * Fix some includes. --- impls/make/README | 11 ++ impls/make/core.mk | 323 +++++++++++---------------------- impls/make/env.mk | 42 ++--- impls/make/numbers.mk | 2 +- impls/make/printer.mk | 36 ++-- impls/make/reader.mk | 259 ++++++++++---------------- impls/make/readline.mk | 15 +- impls/make/step0_repl.mk | 25 ++- impls/make/step1_read_print.mk | 33 +++- impls/make/step2_eval.mk | 94 ++++++---- impls/make/step3_env.mk | 130 +++++++------ impls/make/step4_if_fn_do.mk | 166 +++++++++-------- impls/make/step6_file.mk | 183 ++++++++++--------- impls/make/step7_quote.mk | 234 +++++++++++++----------- impls/make/step8_macros.mk | 248 ++++++++++++++----------- impls/make/step9_try.mk | 279 +++++++++++++++------------- impls/make/stepA_mal.mk | 293 +++++++++++++++++------------- impls/make/types.mk | 311 +++++++++++++------------------ impls/make/util.mk | 93 ++++++---- 19 files changed, 1407 insertions(+), 1370 deletions(-) create mode 100644 impls/make/README diff --git a/impls/make/README b/impls/make/README new file mode 100644 index 0000000000..09ee22b55d --- /dev/null +++ b/impls/make/README @@ -0,0 +1,11 @@ +It is often useful to add $(warning /$0/ /$1/ /$2/ /$3/) at the very +start of each interesting macro. + +Recal that foreach does nothing when the list only contains spaces, +and adds spaces between the results even if some results are empty. + +If debugging the reader: +# export READER_DEBUG=1 + +In order to get the equivalent of DEBUG_EVAL in step2: +# export EVAL_DEBUG=1 diff --git a/impls/make/core.mk b/impls/make/core.mk index 5e88f7b44f..1442f049dd 100644 --- a/impls/make/core.mk +++ b/impls/make/core.mk @@ -13,292 +13,189 @@ include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk -# Errors/Exceptions -throw = $(eval __ERROR := $(1)) - - # General functions -# Return the type of the object (or "make" if it's not a object -obj_type = $(call _string,$(call _obj_type,$(1))) - -equal? = $(if $(call _equal?,$(word 1,$(1)),$(word 2,$(1))),$(__true),$(__false)) +$(encoded_equal) = $(if $(call _equal?,$(firstword $1),$(lastword $1)),$(__true),$(__false)) # Scalar functions -nil? = $(if $(call _nil?,$(1)),$(__true),$(__false)) -true? = $(if $(call _true?,$(1)),$(__true),$(__false)) -false? = $(if $(call _false?,$(1)),$(__true),$(__false)) +nil? = $(if $(_nil?),$(__true),$(__false)) +true? = $(if $(_true?),$(__true),$(__false)) +false? = $(if $(_false?),$(__true),$(__false)) # Symbol functions -symbol = $(call _symbol,$(call str_decode,$($(1)_value))) -symbol? = $(if $(call _symbol?,$(1)),$(__true),$(__false)) +symbol = $(call _symbol,$(_string_val)) +symbol? = $(if $(_symbol?),$(__true),$(__false)) # Keyword functions -keyword = $(if $(_keyword?),$(1),$(call _keyword,$(call str_decode,$($(1)_value)))) -keyword? = $(if $(call _keyword?,$(1)),$(__true),$(__false)) +keyword = $(if $(_keyword?),$1,$(call _keyword,$(_string_val))) +keyword? = $(if $(_keyword?),$(__true),$(__false)) # Number functions -number? = $(if $(call _number?,$(1)),$(__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_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))) +number? = $(if $(_number?),$(__true),$(__false)) + +define < +$(if $(call int_lt,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef +define <$(encoded_equal) +$(if $(call int_lte,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef +define > +$(if $(call int_gt,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef +define >$(encoded_equal) +$(if $(call int_gte,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))\ + ,$(__true),$(__false)) +endef + ++ = $(call _number,$(call int_add,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) +- = $(call _number,$(call int_sub,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) +* = $(call _number,$(call int_mult,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) +/ = $(call _number,$(call int_div,$(call _number_val,$(firstword $1)),$(call _number_val,$(lastword $1)))) + +time-ms = $(call _number,$(shell date +%s%3N)) # String functions -string? = $(if $(call _string?,$(1)),$(if $(call _keyword?,$(1)),$(__false),$(__true)),$(__false)) +string? = $(if $(_string?),$(__true),$(__false)) -pr_str = $(call _string,$(call _pr_str_mult,$(1),yes, )) -str = $(call _string,$(call _pr_str_mult,$(1),,)) -prn = $(info $(call _pr_str_mult,$(1),yes, )) -println = $(info $(subst \n,$(NEWLINE),$(call _pr_str_mult,$(1),, ))) +pr-str = $(call _string,$(call _pr_str_mult,$1,yes,$(_SP))) +str = $(call _string,$(_pr_str_mult)) +prn = $(__nil)$(call print,$(call _pr_str_mult,$1,yes,$(_SP))) +println = $(__nil)$(call print,$(call _pr_str_mult,$1,,$(_SP))) -readline= $(foreach res,$(call _string,$(call READLINE,"$(call str_decode,$($(1)_value))")),$(if $(READLINE_EOF),$(eval READLINE_EOF :=)$(__nil),$(res))) -read_str= $(call READ_STR,$(1)) -slurp = $(call _string,$(call _read_file,$(call str_decode,$($(1)_value)))) - -subs = $(strip \ - $(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)))))) +readline = $(or $(foreach res,$(call READLINE,$(_string_val))\ + ,$(call _string,$(res:ok=)))\ + ,$(__nil)) +read-string = $(call READ_STR,$(_string_val)) +slurp = $(call _string,$(call _read_file,$(_string_val))) # Function functions -fn? = $(if $(call _function?,$(1)),$(if $(_macro_$(1)),$(__false),$(__true)),$(__false)) -macro? = $(if $(_macro_$(1)),$(__true),$(__false)) +fn? = $(if $(_fn?),$(__true),$(__false)) +macro? = $(if $(_macro?),$(__true),$(__false)) # List functions -list? = $(if $(call _list?,$(1)),$(__true),$(__false)) +list? = $(if $(_list?),$(__true),$(__false)) # Vector functions -vector? = $(if $(call _vector?,$(1)),$(__true),$(__false)) +vector? = $(if $(_vector?),$(__true),$(__false)) -vec = $(if $(_list?),$(call _vector,$($1_value)),$(if $(_vector?),$1,$(call _error,vec: called on non-sequence))) +vec = $(if $(_list?)\ + ,$(call vector,$(_seq_vals))$(rem \ +),$(if $(_vector?)\ + ,$1$(rem \ +),$(call _error,vec$(encoded_colon)$(_SP)called$(_SP)on$(_SP)non-sequence))) # Hash map (associative array) functions -hash_map? = $(if $(call _hash_map?,$(1)),$(__true),$(__false)) +hash-map = $(call _map_new,,$1) +map? = $(if $(_hash_map?),$(__true),$(__false)) # set a key/value in a copy of the hash map -assoc = $(word 1,\ - $(foreach hm,$(call _clone_obj,$(word 1,$(1))),\ - $(hm) \ - $(call _assoc_seq!,$(hm),$(wordlist 2,$(words $(1)),$(1))))) +assoc = $(call _map_new,$(firstword $1),$(_rest)) # 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) \ - $(call _dissoc_seq!,$(hm),$(wordlist 2,$(words $(1)),$(1))))) - -keys = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$(foreach vval,$(word 4,$(subst _, ,$(v))),$(if $(filter $(__keyword)%,$(vval)),$(call _keyword,$(patsubst $(__keyword)%,%,$(vval))),$(call _string,$(vval))))))) +dissoc = $(call _map_new,$(firstword $1),,$(_rest)) -vals = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$($(v))))) +keys = $(call list,$(_keys)) -# Hash map and vector functions +vals = $(call list,$(foreach k,$(_keys),$(call _get,$1,$k))) # retrieve the value of a string key object from the hash map, or -# retrive a vector by number object index -get = $(strip \ - $(if $(call _nil?,$(word 1,$(1))),\ - $(__nil),\ - $(if $(call _hash_map?,$(word 1,$(1))),\ - $(call _get,$(word 1,$(1)),$(call str_decode,$($(word 2,$(1))_value))),\ - $(call _get,$(word 1,$(1)),$(call int_decode,$($(word 2,$(1))_value)))))) +# return nil if the key is not found. +get = $(or $(call _get,$(firstword $1),$(lastword $1)),$(__nil)) -contains? = $(if $(call _contains?,$(word 1,$(1)),$(call str_decode,$($(word 2,$(1))_value))),$(__true),$(__false)) +contains? = $(if $(call _get,$(firstword $1),$(lastword $1)),$(__true),$(__false)) # sequence operations -sequential? = $(if $(call _sequential?,$(1)),$(__true),$(__false)) - -cons = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $(strip $(word 1,$(1)) $(call __get_obj_values,$(word 2,$(1))))))) +sequential? = $(if $(_sequential?),$(__true),$(__false)) -concat = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $(strip $(foreach lst,$1,$(call __get_obj_values,$(lst))))))) +# Strip in case seq_vals is empty. +cons = $(call list,$(strip $(firstword $1) $(call _seq_vals,$(lastword $1)))) -nth = $(strip \ - $(if $(call int_lt,$($(word 2,$(1))_value),$(call int_encode,$(call _count,$(word 1,$(1))))),\ - $(word $(call int_add,1,$(call int_decode,$($(word 2,$(1))_value))),$($(word 1,$(1))_value)),\ - $(call _error,nth: index out of range))) +# Strip in case foreach introduces a space after an empty argument. +concat = $(call list,$(strip $(foreach l,$1,$(call _seq_vals,$l)))) -sfirst = $(word 1,$($(1)_value)) +nth = $(or $(word $(call int_add,1,$(call _number_val,$(lastword $1))),\ + $(call _seq_vals,$(firstword $1)))\ + ,$(call _error,nth: index out of range)) -slast = $(word $(words $($(1)_value)),$($(1)_value)) +first = $(or $(if $(_sequential?),$(firstword $(_seq_vals))),$(__nil)) -empty? = $(if $(_empty?),$(__true),$(__false)) +empty? = $(if $(_seq_vals),$(__false),$(__true)) -count = $(call _number,$(call _count,$(1))) +count = $(call _number,$(words $(if $(_sequential?),$(_seq_vals)))) # 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))))) +rest = $(call list,$(if $(_sequential?),$(call _rest,$(_seq_vals)))) # Takes a space separated arguments and invokes the first argument # (function object) using the remaining arguments. -sapply = $(call $(word 1,$(1))_value,$(strip \ - $(wordlist 2,$(call int_sub,$(words $(1)),1),$(1)) \ - $($(word $(words $(1)),$(1))_value))) +# Strip in case wordlist or _seq_vals is empty. +apply = $(call _apply,$(firstword $1),$(strip \ + $(wordlist 2,$(call int_sub,$(words $1),1),$1) \ + $(call _seq_vals,$(lastword $1)))) # Map a function object over a list object -smap = $(strip\ - $(foreach func,$(word 1,$(1)),\ - $(foreach lst,$(word 2,$(1)),\ - $(foreach type,list,\ - $(foreach new_hcode,$(call __new_obj_hash_code),\ - $(foreach sz,$(words $(call __get_obj_values,$(lst))),\ - $(eval $(__obj_magic)_$(type)_$(new_hcode)_value := $(strip \ - $(foreach val,$(call __get_obj_values,$(lst)),\ - $(call $(func)_value,$(val))))))\ - $(__obj_magic)_$(type)_$(new_hcode)))))) - -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))))))) - -seq = $(strip\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),$(__nil),$(1)),\ - $(if $(call _vector?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(__nil),\ - $(word 1,$(foreach new_list,$(call _list),\ - $(new_list) \ - $(eval $(new_list)_value := $(strip $($(word 1,$(1))_value)))))),\ - $(if $(call _EQ,string,$(call _obj_type,$(1))),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(__nil),\ - $(word 1,$(foreach new_list,$(call _list),\ - $(new_list) \ - $(eval $(new_list)_value := $(strip \ - $(foreach c,$($(word 1,$(1))_value),\ - $(call _string,$(c)))))))),\ - $(if $(call _nil?,$(1)),\ - $(__nil),\ - $(call _error,seq: called on non-sequence)))))) +map = $(call list,$(foreach e,$(call _seq_vals,$(lastword $1))\ + ,$(call _apply,$(firstword $1),$e))) + +conj = $(foreach seq,$(firstword $1)\ + ,$(call conj_$(call _obj_type,$(seq)),$(call _seq_vals,$(seq)),$(_rest))) +# Strip in case $1 or $2 is empty. +# Also, _reverse introduces blanks. +conj_vector = $(call vector,$(strip $1 $2)) +conj_list = $(call list,$(strip $(call _reverse,$2) $1)) + +seq = $(or $(seq_$(_obj_type))\ + ,$(call _error,seq: called on non-sequence)) +seq_list = $(if $(_seq_vals),$1,$(__nil)) +seq_vector = $(if $(_seq_vals),$(call list,$(_seq_vals)),$(__nil)) +seq_nil = $1 +seq_string = $(if $(_string_val)\ + ,$(call list,$(foreach c,$(call str_encode,$(_string_val))\ + ,$(call _string,$(call str_decode,$c))))$(rem \ + ),$(__nil)) # Metadata functions -with_meta = $(strip \ - $(foreach new_obj,$(call _clone_obj,$(word 1,$(1))),\ - $(eval $(new_obj)_meta := $(strip $(word 2,$(1))))\ - $(new_obj))) - -meta = $(strip $($(1)_meta)) +# are implemented in types.mk. # Atom functions -atom = $(strip \ - $(foreach hcode,$(call __new_obj_hash_code),\ - $(foreach new_atom,$(__obj_magic)_atom_$(hcode),\ - $(new_atom)\ - $(eval $(new_atom)_value := $(1))))) -atom? = $(if $(call _atom?,$(1)),$(__true),$(__false)) - -deref = $($(1)_value) +atom? = $(if $(_atom?),$(__true),$(__false)) -reset! = $(eval $(word 1,$(1))_value := $(word 2,$(1)))$(word 2,$(1)) +reset! = $(foreach v,$(lastword $1),$(call _reset,$(firstword $1),$v)$v) -swap! = $(foreach resp,$(call $(word 2,$(1))_value,$($(word 1,$(1))_value) $(wordlist 3,$(words $(1)),$(1))),\ - $(eval $(word 1,$(1))_value := $(resp))\ - $(resp)) +swap! = $(foreach a,$(firstword $1)\ + ,$(call reset!,$a $(call _apply,$(word 2,$1),$(call deref,$a) $(_rest2)))) # Namespace of core functions -core_ns = type obj_type \ - = equal? \ - throw throw \ - nil? nil? \ - true? true? \ - false? false? \ - string? string? \ - symbol symbol \ - symbol? symbol? \ - keyword keyword \ - keyword? keyword? \ - number? number? \ - fn? fn? \ - macro? macro? \ - \ - pr-str pr_str \ - str str \ - prn prn \ - println println \ - readline readline \ - read-string read_str \ - slurp slurp \ - subs subs \ - < number_lt \ - <= number_lte \ - > number_gt \ - >= number_gte \ - + number_plus \ - - number_subtract \ - * number_multiply \ - / number_divide \ - time-ms time_ms \ - \ - list _list \ - list? list? \ - vector _vector \ - vector? vector? \ - hash-map _hash_map \ - map? hash_map? \ - assoc assoc \ - dissoc dissoc \ - get get \ - contains? contains? \ - keys keys \ - vals vals \ - \ - sequential? sequential? \ - cons cons \ - concat concat \ - vec vec \ - nth nth \ - first sfirst \ - rest srest \ - last slast \ - empty? empty? \ - count count \ - apply sapply \ - map smap \ - \ - conj conj \ - seq seq \ - \ - with-meta with_meta \ - meta meta \ - atom atom \ - atom? atom? \ - deref deref \ - reset! reset! \ - swap! swap! +core_ns := $(encoded_equal) throw nil? true? false? string? symbol \ + symbol? keyword keyword? number? fn? macro? \ + pr-str str prn println readline read-string slurp \ < \ + <$(encoded_equal) > >$(encoded_equal) + - * / time-ms \ + list list? vector vector? hash-map map? assoc dissoc get \ + contains? keys vals \ + sequential? cons concat vec nth first rest empty? count apply map \ + conj seq \ + with-meta meta atom atom? deref reset! swap! endif diff --git a/impls/make/env.mk b/impls/make/env.mk index 733ac62b56..67719d4543 100644 --- a/impls/make/env.mk +++ b/impls/make/env.mk @@ -14,31 +14,21 @@ include $(_TOP_DIR)types.mk # An ENV environment is a hash-map with an __outer__ reference to an # outer environment -define BIND_ARGS -$(strip \ - $(word 1,$(1) \ - $(foreach fparam,$(call _nth,$(2),0),\ - $(if $(call _EQ,&,$($(fparam)_value)), - $(call ENV_SET,$(1),$($(call _nth,$(2),1)_value),$(strip \ - $(foreach new_list,$(call _list), - $(word 1,$(new_list) \ - $(foreach val,$(3),$(call _conj!,$(new_list),$(val))))))),\ - $(foreach val,$(word 1,$(3)),\ - $(call ENV_SET,$(1),$($(fparam)_value),$(val))\ - $(foreach left,$(call srest,$(2)),\ - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call BIND_ARGS,$(1),$(left),$(wordlist 2,$(words $(3)),$(3)))))))))) -endef - -# Create a new ENV and optional bind values in it -# $(1): outer environment (set as a key named __outer__) -# $(2): list/vector object of bind forms -# $(3): space separated list of expressions to bind -ENV = $(strip $(foreach new_env,$(call _assoc!,$(call _hash_map),__outer__,$(if $(1),$(1),$(__nil))),$(if $(2),$(call BIND_ARGS,$(new_env),$(2),$(3)),$(new_env)))) - -ENV_GET = $(if $(call _EQ,$(1),$(__nil)),,$(or $(_get),$(call ENV_GET,$(call _get,$(1),__outer__),$(2)))) - -ENV_SET = $(if $(call _assoc!,$(1),$(subst =,$(__equal),$(2)),$(3)),$(1),) + +# Keys are stored as Make variables named $(env)_$(key). The outer +# environment is the content of the variable itself. + +# 1: outer environment, or "" -> new environment +ENV = $(call __new_obj,env,$1) + +# 1:env 2:key -> value or "" +ENV_GET = $(if $1,$(or $($1_$2),$(call ENV_GET,$($1),$2))) + +# 1:env 2:key 3:value +ENV_SET = $(eval $1_$2 := $3) + +# 1:env -> (encoded) keys +env_keys = $(foreach k,$(patsubst $1_%,%,$(filter $1_%,$(.VARIABLES)))\ + ,$(call _symbol_val,$k)) endif diff --git a/impls/make/numbers.mk b/impls/make/numbers.mk index 6d35bbbc34..ad87b77d78 100644 --- a/impls/make/numbers.mk +++ b/impls/make/numbers.mk @@ -22,7 +22,7 @@ int_encode = $(strip $(call _reverse,\ $(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)))) +int_decode = $(subst $(SPACE),,$(_reverse)) # 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))) diff --git a/impls/make/printer.mk b/impls/make/printer.mk index adf859cac7..55abd96f06 100644 --- a/impls/make/printer.mk +++ b/impls/make/printer.mk @@ -11,37 +11,45 @@ include $(_TOP_DIR)types.mk # return a printable form of the argument, the second parameter is # 'print_readably' which backslashes quotes in string values -_pr_str = $(if $(1),$(foreach ot,$(call _obj_type,$(1)),$(if $(call _EQ,make,$(ot)),$(call _error,_pr_str failed on $(1)),$(call $(ot)_pr_str,$(1),$(2)))),) +_pr_str = $(call $(_obj_type)_pr_str,$1,$2) # Like _pr_str but takes multiple values in first argument, the second # parameter is 'print_readably' which backslashes quotes in string # values, the third parameter is the delimeter to use between each # _pr_str'd value -_pr_str_mult = $(call _pr_str,$(word 1,$(1)),$(2))$(if $(word 2,$(1)),$(3)$(call _pr_str_mult,$(wordlist 2,$(words $(1)),$(1)),$(2),$(3)),) +_pr_str_mult = $(subst $(SPACE),$3,$(foreach f,$1,$(call _pr_str,$f,$2))) # Type specific printing -nil_pr_str = nil -true_pr_str = true -false_pr_str = false +nil_pr_str := nil +true_pr_str := true +false_pr_str := false -number_pr_str = $(call int_decode,$($(1)_value)) +number_pr_str = $(_number_val) -symbol_pr_str = $($(1)_value) +symbol_pr_str = $(_symbol_val) -keyword_pr_str = $(COLON)$(patsubst $(__keyword)%,%,$(call str_decode,$($(1)_value))) +keyword_pr_str = $(encoded_colon)$(_keyword_val) -string_pr_str = $(if $(filter $(__keyword)%,$(call str_decode,$($(1)_value))),$(COLON)$(patsubst $(__keyword)%,%,$(call str_decode,$($(1)_value))),$(if $(2),"$(subst $(NEWLINE),$(ESC_N),$(subst $(DQUOTE),$(ESC_DQUOTE),$(subst $(SLASH),$(SLASH)$(SLASH),$(call str_decode,$($(1)_value)))))",$(call str_decode,$($(1)_value)))) +string_pr_str = $(if $2\ + ,"$(subst $(_NL),$(ESC_N),$(rem \ + )$(subst $(DQUOTE),$(ESC_DQUOTE),$(rem \ + )$(subst $(encoded_slash),$(encoded_slash)$(encoded_slash),$(rem \ + )$(_string_val))))"$(rem \ +else \ + ),$(_string_val)) -function_pr_str = +corefn_pr_str := +function_pr_str := +macro_pr_str := -list_pr_str = ($(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))) +list_pr_str = $(_LP)$(call _pr_str_mult,$(_seq_vals),$2,$(_SP))$(_RP) -vector_pr_str = [$(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))] +vector_pr_str = [$(call _pr_str_mult,$(_seq_vals),$2,$(_SP))] -hash_map_pr_str = {$(foreach v,$(call __get_obj_values,$(1)),$(foreach vval,$(foreach hcode,$(word 3,$(subst _, ,$(1))),$(patsubst $(1)_%,%,$(v:%_value=%))),$(if $(filter $(__keyword)%,$(vval)),$(patsubst $(__keyword)%,$(COLON)%,$(vval)),"$(vval)")) $(call _pr_str,$($(v)),$(2)))} +map_pr_str = {$(call _pr_str_mult,$(foreach k,$(_keys),$k $(call _get,$1,$k)),$2,$(_SP))} -atom_pr_str = (atom $(call _pr_str,$($(1)_value),$(2))) +atom_pr_str = $(_LP)atom$(_SP)$(call _pr_str,$(deref),$2)$(_RP) endif diff --git a/impls/make/reader.mk b/impls/make/reader.mk index 2dc0f53203..eff3ad9d96 100755 --- a/impls/make/reader.mk +++ b/impls/make/reader.mk @@ -8,194 +8,123 @@ __mal_reader_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk -include $(_TOP_DIR)readline.mk READER_DEBUG ?= -_TOKEN_DELIMS := $(SEMI) $(COMMA) $(DQUOTE) $(QQUOTE) $(_SP) $(_NL) $(_LC) $(_RC) $(_LP) $(_RP) $(LBRACKET) $(RBRACKET) +_TOKEN_DELIMS := $(SEMI) $(COMMA) $(DQUOTE) $(QQUOTE) $(_SP) $(_NL) { } $(_LP) $(_RP) $(LBRACKET) $(RBRACKET) + +reader_init = $(eval __reader_temp := $(str_encode)) +reader_next = $(firstword $(__reader_temp)) +reader_drop = $(eval __reader_temp := $(call _rest,$(__reader_temp))) +reader_log = $(if $(READER_DEBUG),$(info READER: $1 from $(__reader_temp))) define READ_NUMBER -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(filter $(_TOKEN_DELIMS),$(ch)),\ - ,\ - $(if $(filter-out $(MINUS) $(NUMBERS),$(ch)),\ - $(call _error,Invalid number character '$(ch)'),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_NUMBER ch: $(ch) | $($(1))))\ - $(ch)$(strip $(call READ_NUMBER,$(1))))),\ - )) +$(call reader_log,number)$(rem \ +)$(if $(filter $(NUMBERS),$(reader_next))\ + ,$(reader_next)$(reader_drop)$(call READ_NUMBER)) endef -# $(_NL) is used here instead of $(NEWLINE) because $(strip) removes -# $(NEWLINE). str_encode will just pass through $(_NL) so str_decode -# later will restore a correct newline define READ_STRING -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(and $(filter \,$(ch)),$(filter $(DQUOTE),$(word 2,$($(1))))),\ - $(eval $(1) := $(wordlist 3,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_STRING ch: \$(word 1,$($(1))) | $($(1))))\ - $(DQUOTE) $(strip $(call READ_STRING,$(1))),\ - $(if $(and $(filter \,$(ch)),$(filter n,$(word 2,$($(1))))),\ - $(eval $(1) := $(wordlist 3,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_STRING ch: \$(word 1,$($(1))) | $($(1))))\ - $(_NL) $(strip $(call READ_STRING,$(1))),\ - $(if $(and $(filter \,$(ch)),$(filter \,$(word 2,$($(1))))),\ - $(eval $(1) := $(wordlist 3,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_STRING ch: \$(word 1,$($(1))) | $($(1))))\ - \ $(strip $(call READ_STRING,$(1))),\ - $(if $(filter $(DQUOTE),$(ch)),\ - ,\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_STRING ch: $(ch) | $($(1))))\ - $(ch) $(strip $(call READ_STRING,$(1))))))),)) +$(call reader_log,string)$(rem \ +)$(if $(filter $(DQUOTE),$(reader_next))\ + ,$(reader_drop)$(rem \ +),$(if $(filter $(encoded_slash),$(reader_next))\ + ,$(reader_drop)$(rem \ + )$(if $(filter n,$(reader_next)),$(_NL),$(reader_next))$(rem \ + )$(reader_drop)$(call READ_STRING)$(rem \ +),$(if $(reader_next)\ + ,$(reader_next)$(reader_drop)$(call READ_STRING)$(rem \ +),$(call _error,Expected '$(DQUOTE)'$(COMMA) got EOF)))) endef define READ_SYMBOL -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(filter $(_TOKEN_DELIMS),$(ch)),\ - ,\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_SYMBOL ch: $(ch) | $($(1))))\ - $(ch)$(strip $(call READ_SYMBOL,$(1)))),\ - )) -endef - -define READ_KEYWORD -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(filter $(_TOKEN_DELIMS),$(ch)),\ - ,\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(and $(READER_DEBUG),$(info READ_KEYWORD ch: $(ch) | $($(1))))\ - $(ch)$(strip $(call READ_KEYWORD,$(1)))),\ - )) +$(call reader_log,symbol or keyword)$(rem \ +)$(if $(filter-out $(_TOKEN_DELIMS),$(reader_next))\ + ,$(reader_next)$(reader_drop)$(call READ_SYMBOL)) endef -define READ_ATOM -$(and $(READER_DEBUG),$(info READ_ATOM: $($(1)))) -$(foreach ch,$(word 1,$($(1))),\ - $(if $(and $(filter $(MINUS),$(ch)),$(filter $(NUMBERS),$(word 2,$($(1))))),\ - $(call _number,$(call READ_NUMBER,$(1))),\ - $(if $(filter $(NUMBERS),$(ch)),\ - $(call _number,$(call READ_NUMBER,$(1))),\ - $(if $(filter $(DQUOTE),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call __string,$(strip $(call READ_STRING,$(1))))\ - $(eval $(if $(filter $(DQUOTE),$(word 1,$($(1)))),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1)))),\ - $(call _error,Expected '$(DQUOTE)' in; $($(1))$(COMMA) got EOF))),\ - $(if $(filter $(COLON),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _keyword,$(call READ_KEYWORD,$(1))),\ - $(foreach sym,$(call READ_SYMBOL,$(1)),\ - $(if $(call _EQ,nil,$(sym)),\ - $(__nil),\ - $(if $(call _EQ,true,$(sym)),\ - $(__true),\ - $(if $(call _EQ,false,$(sym)),\ - $(__false),\ - $(call _symbol,$(sym))))))))))) -endef - -# read and return tokens until $(2) found +# read and return tokens until $1 found +# The last element if any is followed by a space. define READ_UNTIL -$(and $(READER_DEBUG),$(info READ_UNTIL: $($(1)) [$(2) $(3)])) -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(filter $(2),$(ch)),\ - ,\ - $(call READ_FORM,$(1))\ - $(call READ_UNTIL,$(1),$(2),$(3))),\ - $(call _error,Expected '$(3)'$(COMMA) got EOF))) +$(call reader_log,until $1)$(rem \ +)$(READ_SPACES)$(rem \ +)$(if $(filter $1,$(reader_next))\ + ,$(reader_drop)$(rem \ +),$(if $(reader_next)\ + ,$(call READ_FORM) $(call READ_UNTIL,$1)$(rem \ +),$(call _error,Expected '$1'$(COMMA) got EOF))) endef -define DROP_UNTIL -$(and $(READER_DEBUG),$(info DROP_UNTIL: $($(1)) [$(2)])) -$(foreach ch,$(word 1,$($(1))),\ - $(if $(ch),\ - $(if $(filter $(2),$(ch)),\ - ,\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call DROP_UNTIL,$(1),$(2),$(3))),\ - )) +define READ_COMMENT +$(call reader_log,read comment)$(rem \ +)$(if $(filter-out $(_NL),$(reader_next))\ + ,$(reader_drop)$(call READ_COMMENT)) endef define READ_SPACES -$(and $(READER_DEBUG),$(info READ_SPACES: $($(1)))) -$(foreach ch,$(word 1,$($(1))),\ - $(if $(filter $(_SP) $(_NL) $(COMMA),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call READ_SPACES,$(1)),)) +$(call reader_log,spaces)$(rem \ +)$(if $(filter $(_SP) $(_NL) $(COMMA),$(reader_next))\ + ,$(reader_drop)$(call READ_SPACES),$(rem \ +)$(if $(filter $(SEMI),$(reader_next))\ + ,$(READ_COMMENT))) endef define READ_FORM -$(and $(READER_DEBUG),$(info READ_FORM: $($(1)))) -$(call READ_SPACES,$(1)) -$(foreach ch,$(word 1,$($(1))),\ - $(if $(filter $(SEMI),$(ch)),\ - $(call DROP_UNTIL,$(1),$(_NL)),\ - $(if $(filter $(SQUOTE),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _list,$(call _symbol,quote) $(strip $(call READ_FORM,$(1)))),\ - $(if $(filter $(QQUOTE),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _list,$(call _symbol,quasiquote) $(strip $(call READ_FORM,$(1)))),\ - $(if $(filter $(UNQUOTE),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _list,$(call _symbol,unquote) $(strip $(call READ_FORM,$(1)))),\ - $(if $(filter $(_SUQ),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _list,$(call _symbol,splice-unquote) $(strip $(call READ_FORM,$(1)))),\ - $(if $(filter $(CARET),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(foreach meta,$(strip $(call READ_FORM,$(1))),\ - $(call _list,$(call _symbol,with-meta) $(strip $(call READ_FORM,$(1))) $(meta))),\ - $(if $(filter $(ATSIGN),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _list,$(call _symbol,deref) $(strip $(call READ_FORM,$(1)))),\ - $(if $(filter $(_RC),$(ch)),\ - $(call _error,Unexpected '$(RCURLY)'),\ - $(if $(filter $(_LC),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call READ_SPACES,$(1))\ - $(foreach thm,$(call _hash_map),\ - $(call do,$(call _assoc_seq!,$(thm),$(strip $(call READ_UNTIL,$(1),$(_RC),$(RCURLY)))))\ - $(eval $(if $(filter $(_RC),$(word 1,$($(1)))),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1)))),\ - $(call _error,Expected '$(RCURLY)'$(COMMA) got EOF)))\ - $(thm)),\ - $(if $(filter $(_RP),$(ch)),\ - $(call _error,Unexpected '$(RPAREN)'),\ - $(if $(filter $(_LP),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call READ_SPACES,$(1))\ - $(foreach tlist,$(call _list),\ - $(eval $(foreach item,$(strip $(call READ_UNTIL,$(1),$(_RP),$(RPAREN))),\ - $(call do,$(call _conj!,$(tlist),$(item)))))\ - $(eval $(if $(filter $(_RP),$(word 1,$($(1)))),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1)))),\ - $(call _error,Expected '$(RPAREN)'$(COMMA) got EOF)))\ - $(tlist)),\ - $(if $(filter $(RBRACKET),$(ch)),\ - $(call _error,Unexpected '$(RBRACKET)'),\ - $(if $(filter $(LBRACKET),$(ch)),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call READ_SPACES,$(1))\ - $(foreach tvec,$(call _vector),\ - $(eval $(foreach item,$(strip $(call READ_UNTIL,$(1),$(RBRACKET),$(RBRACKET))),\ - $(call do,$(call _conj!,$(tvec),$(item)))))\ - $(eval $(if $(filter $(RBRACKET),$(word 1,$($(1)))),\ - $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1)))),\ - $(call _error,Expected '$(RBRACKET)'$(COMMA) got EOF)))\ - $(tvec)),\ - $(call READ_ATOM,$(1)))))))))))))))) -$(call READ_SPACES,$(1)) +$(call reader_log,form)$(rem \ +)$(READ_SPACES)$(rem \ +)$(if $(filter-out undefined,$(flavor READ_FORM_$(reader_next)))\ + ,$(call READ_FORM_$(reader_next)$(reader_drop))$(rem \ +),$(if $(reader_next)\ + ,$(foreach sym,$(READ_SYMBOL)\ + ,$(if $(filter false nil true,$(sym))\ + ,$(__$(sym))$(rem \ + ),$(call _symbol,$(sym))))$(rem \ +),$(call _error,expected a form, found EOF))) +endef + +# Reader macros +READ_FORM_$(ATSIGN) = $(call list,$(call _symbol,deref) $(call READ_FORM)) +READ_FORM_$(SQUOTE) = $(call list,$(call _symbol,quote) $(call READ_FORM)) +READ_FORM_$(QQUOTE) = $(call list,$(call _symbol,quasiquote) $(call READ_FORM)) +READ_FORM_$(CARET) = $(call list,$(call _symbol,with-meta) $(foreach m,\ + $(call READ_FORM),$(call READ_FORM) $m)) + +READ_FORM_$(UNQUOTE) = $(call list,$(if $(filter $(ATSIGN),$(reader_next))\ + ,$(reader_drop)$(call _symbol,splice-unquote)$(rem \ + ),$(call _symbol,unquote)) $(call READ_FORM)) + +# Lists, vectors and maps +# _map_new accepts a leading space, list and vector require )strip. +READ_FORM_$(LCURLY) = $(call _map_new,,$(strip $(call READ_UNTIL,$(RCURLY)))) +READ_FORM_$(_LP) = $(call list,$(strip $(call READ_UNTIL,$(_RP)))) +READ_FORM_$(LBRACKET) = $(call vector,$(strip $(call READ_UNTIL,$(RBRACKET)))) +READ_FORM_$(RCURLY) = $(call _error,Unexpected '$(RCURLY)') +READ_FORM_$(_RP) = $(call _error,Unexpected '$(_RP)') +READ_FORM_$(RBRACKET) = $(call _error,Unexpected '$(RBRACKET)') + +# Numbers +define READ_FORM_$(MINUS) +$(if $(filter $(NUMBERS),$(reader_next))\ + ,$(call _number,$(MINUS)$(READ_NUMBER))$(rem \ + ),$(call _symbol,$(MINUS)$(READ_SYMBOL))) endef +READ_FORM_0 = $(call _number,0$(READ_NUMBER)) +READ_FORM_1 = $(call _number,1$(READ_NUMBER)) +READ_FORM_2 = $(call _number,2$(READ_NUMBER)) +READ_FORM_3 = $(call _number,3$(READ_NUMBER)) +READ_FORM_4 = $(call _number,4$(READ_NUMBER)) +READ_FORM_5 = $(call _number,5$(READ_NUMBER)) +READ_FORM_6 = $(call _number,6$(READ_NUMBER)) +READ_FORM_7 = $(call _number,7$(READ_NUMBER)) +READ_FORM_8 = $(call _number,8$(READ_NUMBER)) +READ_FORM_9 = $(call _number,9$(READ_NUMBER)) + +# Strings +READ_FORM_$(DQUOTE) = $(call _string,$(call str_decode,$(READ_STRING))) + +# Keywords +READ_FORM_$(encoded_colon) = $(call _keyword,$(READ_SYMBOL)) -# read-str from a raw "string" or from a string object -READ_STR = $(strip $(eval __reader_temp := $(call str_encode,$(if $(call _string?,$(1)),$(call str_decode,$($(1)_value)),$(1))))$(call READ_FORM,__reader_temp)) +READ_STR = $(reader_init)$(or $(READ_FORM),$(__nil)) endif diff --git a/impls/make/readline.mk b/impls/make/readline.mk index 3d08ab199b..ab4e287134 100644 --- a/impls/make/readline.mk +++ b/impls/make/readline.mk @@ -5,19 +5,22 @@ ifndef __mal_readline_included __mal_readline_included := true +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)util.mk + # Call bash read/readline. Since each call is in a separate shell # instance we need to restore and save after each call in order to # have readline history. -READLINE_EOF := READLINE_HISTORY_FILE := $${HOME}/.mal-history -READLINE = $(eval __readline_temp := $(subst #,\#,$(subst $$,$$$$,$(shell \ + +# Either empty (if EOF) or an encoded string with the 'ok' suffix. +READLINE = $(call str_encode_nospace,$(shell \ history -r $(READLINE_HISTORY_FILE); \ - read -u 0 -r -e -p $(if $(1),$(1),"user> ") line && \ + read -u 0 -r -e -p '$(str_decode_nospace)' line && \ history -s -- "$${line}" && \ - echo "$${line}" || \ - echo "__||EOF||__"; \ + echo "$${line}ok" ; \ history -a $(READLINE_HISTORY_FILE) 2>/dev/null || \ true \ -))))$(if $(filter __||EOF||__,$(__readline_temp)),$(eval READLINE_EOF := yes),$(__readline_temp))$(if $(DEBUG_READLINE),$(warning readline/$(__readline_temp)/)) +)) endif diff --git a/impls/make/step0_repl.mk b/impls/make/step0_repl.mk index 46b4756ae7..9868ed3983 100644 --- a/impls/make/step0_repl.mk +++ b/impls/make/step0_repl.mk @@ -3,23 +3,36 @@ # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk SHELL := /bin/bash define READ -$(call READLINE) +$1 endef define EVAL -$(if $(READLINE_EOF),,$(1)) +$1 endef define PRINT -$(1) +$1 endef -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ))))) -REPL = $(info $(call REP))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef # Call the read-eval-print loop -$(call REPL) +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step1_read_print.mk b/impls/make/step1_read_print.mk index f695a7e174..2c2503aeb3 100644 --- a/impls/make/step1_read_print.mk +++ b/impls/make/step1_read_print.mk @@ -2,31 +2,48 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) -include $(_TOP_DIR)types.mk +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk SHELL := /bin/bash -INTERACTIVE ?= yes # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: just return the input define EVAL -$(if $(READLINE_EOF)$(__ERROR),,$(1)) +$(if $(__ERROR)\ +,,$1) endef + # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: read, eval, print, loop -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) + +REP = $(call PRINT,$(call EVAL,$(READ))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step2_eval.mk b/impls/make/step2_eval.mk index f03d6d73de..1dd8f231b2 100644 --- a/impls/make/step2_eval.mk +++ b/impls/make/step2_eval.mk @@ -2,66 +2,86 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1))))\ - $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ - $(call _apply,$(call sfirst,$(el)),$(call srest,$(el))))) +# EVAL: evaluate the parameter + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call _get,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) endef -# EVAL: evaluate the parameter define EVAL -$(strip $(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_AST: $(call _pr_str,$(1))))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(if $(call _contains?,$(2),$(key)),\ - $(call _get,$(2),$(key)),\ - $(call _error,'$(key)' not found in REPL_ENV))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(strip $(call EVAL_INVOKE,$(1),$(2)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(EVAL_DEBUG),\ + $(call print,EVAL: $(call _pr_str,$1,yes)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: -REPL_ENV := $(call _hash_map) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REPL_ENV := $(call hash-map,$(foreach f,+ - * /\ + ,$(call _symbol,$f) $(call _corefn,$f))) -$(call do,$(call _assoc!,$(REPL_ENV),+,number_plus)) -$(call do,$(call _assoc!,$(REPL_ENV),-,number_subtract)) -$(call do,$(call _assoc!,$(REPL_ENV),*,number_multiply)) -$(call do,$(call _assoc!,$(REPL_ENV),/,number_divide)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step3_env.mk b/impls/make/step3_env.mk index ccd1fbfd20..0adc209b3b 100644 --- a/impls/make/step3_env.mk +++ b/impls/make/step3_env.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,84 +11,98 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ - $(call _apply,$(call sfirst,$(el)),$(call srest,$(el)))))))) +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) endef define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef # Setup the environment -REPL_ENV := $(call ENV_SET,$(REPL_ENV),+,number_plus) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),-,number_subtract) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*,number_multiply) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),/,number_divide) +$(foreach f,+ - * /\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step4_if_fn_do.mk b/impls/make/step4_if_fn_do.mk index 529f5e5a5c..6384f63507 100644 --- a/impls/make/step4_if_fn_do.mk +++ b/impls/make/step4_if_fn_do.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,102 +11,120 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))) +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) endef +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) + +# Do not complain that there is no target. +.PHONY: none +none: + @true diff --git a/impls/make/step6_file.mk b/impls/make/step6_file.mk index 6bdad802ce..265d25f76f 100644 --- a/impls/make/step6_file.mk +++ b/impls/make/step6_file.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,117 +11,132 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))) +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) endef +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) +endif +# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/step7_quote.mk b/impls/make/step7_quote.mk index a239e5cb69..68665fb325 100644 --- a/impls/make/step7_quote.mk +++ b/impls/make/step7_quote.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,140 +11,168 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + # elt, accumulator list -> new accumulator list -QQ_LOOP = $(call _list,\ - $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ - $(call _symbol,concat) $(call _nth,$1,1),\ - $(call _symbol,cons) $(QUASIQUOTE))\ - $2) +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list -QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) - -QUASIQUOTE = $(strip \ - $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ - $(call _nth,$1,1),\ - $(QQ_FOLD)),\ - $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ - $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ - $1)))) - -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2))))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach el,$(call _smap,EVAL,$(1),$(2)),\ - $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ - $(foreach f,$(call sfirst,$(el)),\ - $(foreach args,$(call srest,$(el)),\ - $(call apply,$(f),$(args)))))))))))))) +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) endef +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) +endif +# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/step8_macros.mk b/impls/make/step8_macros.mk index 07f17b7000..7815c9d80f 100644 --- a/impls/make/step8_macros.mk +++ b/impls/make/step8_macros.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,146 +11,176 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + # elt, accumulator list -> new accumulator list -QQ_LOOP = $(call _list,\ - $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ - $(call _symbol,concat) $(call _nth,$1,1),\ - $(call _symbol,cons) $(QUASIQUOTE))\ - $2) +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list -QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) - -QUASIQUOTE = $(strip \ - $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ - $(call _nth,$1,1),\ - $(QQ_FOLD)),\ - $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ - $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ - $1)))) -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(if $(call _macro?,$f)\ + ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ + ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,defmacro!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ - $(eval _macro_$(res) = true)\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach f,$(call EVAL,$(a0),$(2)),\ - $(foreach args,$(call srest,$(1)),\ - $(if $(_macro_$(f)),\ - $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ - $(call apply,$(f),$(call _smap,EVAL,$(args),$(2)))))))))))))))) +define EVAL_special_defmacro! +$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ + ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) endef +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) +endef + +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) -$(call do,$(call REP, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +$(call RE, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) ) +ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) +endif +# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/step9_try.mk b/impls/make/step9_try.mk index 7a9b8653b1..4d80fd9810 100644 --- a/impls/make/step9_try.mk +++ b/impls/make/step9_try.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,161 +11,192 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + # elt, accumulator list -> new accumulator list -QQ_LOOP = $(call _list,\ - $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ - $(call _symbol,concat) $(call _nth,$1,1),\ - $(call _symbol,cons) $(QUASIQUOTE))\ - $2) +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list -QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) - -QUASIQUOTE = $(strip \ - $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ - $(call _nth,$1,1),\ - $(QQ_FOLD)),\ - $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ - $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ - $1)))) -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(if $(call _macro?,$f)\ + ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ + ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) +endef + +define EVAL_special_defmacro! +$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ + ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,defmacro!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ - $(eval _macro_$(res) = true)\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,try*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach res,$(call EVAL,$(a1),$(2)),\ - $(if $(__ERROR),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach a20,$(call _nth,$(a2),0),\ - $(if $(call _EQ,catch*,$($(a20)_value)),\ - $(foreach a21,$(call _nth,$(a2),1),\ - $(foreach a22,$(call _nth,$(a2),2),\ - $(foreach binds,$(call _list,$(a21)),\ - $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ - $(eval __ERROR :=)\ - $(call EVAL,$(a22),$(catch_env)))))),\ - $(res)))),\ - $(res)))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach f,$(call EVAL,$(a0),$(2)),\ - $(foreach args,$(call srest,$(1)),\ - $(if $(_macro_$(f)),\ - $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ - $(call apply,$(f),$(call _smap,EVAL,$(args),$(2))))))))))))))))) +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + +# EVAL may fail and return nothing, so the first foreach may execute +# nothing, so we need to duplicate the test for error. +# The second foreach deliberately does nothing when there is no +# catch_list. +define EVAL_special_try* +$(foreach res,$(call EVAL,$(firstword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)))$(rem \ +)$(if $(__ERROR)\ + ,$(foreach catch_list,$(word 2,$1)\ + ,$(foreach env,$(call ENV,$2)\ + ,$(call ENV_SET,$(env),$(word 2,$(call _seq_vals,$(catch_list))),$(__ERROR))$(rem \ + )$(eval __ERROR :=)$(rem \ + )$(call EVAL,$(lastword $(call _seq_vals,$(catch_list))),$(env))))) endef define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) -$(call do,$(call REP, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +$(call RE, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) ) +ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else # repl loop -$(if $(strip $(INTERACTIVE)),$(call REPL)) +$(REPL) +endif +# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/stepA_mal.mk b/impls/make/stepA_mal.mk index 275524ee6c..5b7788e562 100644 --- a/impls/make/stepA_mal.mk +++ b/impls/make/stepA_mal.mk @@ -2,6 +2,8 @@ # mal (Make Lisp) # _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)readline.mk +include $(_TOP_DIR)util.mk include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk include $(_TOP_DIR)printer.mk @@ -9,168 +11,199 @@ include $(_TOP_DIR)env.mk include $(_TOP_DIR)core.mk SHELL := /bin/bash -INTERACTIVE ?= yes -EVAL_DEBUG ?= # READ: read and parse input define READ -$(if $(READLINE_EOF)$(__ERROR),,$(call READ_STR,$(if $(1),$(1),$(call READLINE,"user> ")))) +$(READ_STR) endef # EVAL: evaluate the parameter +# If $1 is empty, `foreach` does no iteration at all. +starts_with? = $(foreach f,$(firstword $1)\ + ,$(and $(call _symbol?,$f),\ + $(filter $2,$(call _symbol_val,$f)))) + # elt, accumulator list -> new accumulator list -QQ_LOOP = $(call _list,\ - $(if $(and $(_list?),$(call _EQ,splice-unquote,$($(sfirst)_value))),\ - $(call _symbol,concat) $(call _nth,$1,1),\ - $(call _symbol,cons) $(QUASIQUOTE))\ - $2) +QQ_LOOP = $(if $(and $(_list?),\ + $(call starts_with?,$(_seq_vals),splice-unquote))\ + ,$(call list,$(call _symbol,concat) $(lastword $(_seq_vals)) $2)$(rem \ + ),$(call list,$(call _symbol,cons) $(call QUASIQUOTE,$1) $2)) # list or vector source -> right folded list -QQ_FOLD = $(if $(_empty?),$(call _list,),$(call QQ_LOOP,$(sfirst),$(call QQ_FOLD,$(srest)))) - -QUASIQUOTE = $(strip \ - $(if $(_list?), $(if $(call _EQ,unquote,$($(sfirst)_value)),\ - $(call _nth,$1,1),\ - $(QQ_FOLD)),\ - $(if $(_vector?), $(call _list,$(call _symbol,vec) $(QQ_FOLD)),\ - $(if $(_symbol?)$(_hash_map?), $(call _list,$(call _symbol,quote) $1),\ - $1)))) -define LET -$(strip \ - $(word 1,$(2) \ - $(foreach var,$(call _nth,$(1),0),\ - $(foreach val,$(call _nth,$(1),1),\ - $(call ENV_SET,$(2),$($(var)_value),$(call EVAL,$(val),$(2)))\ - $(foreach left,$(call srest,$(call srest,$(1))), - $(if $(call _EQ,0,$(call _count,$(left))),\ - ,\ - $(call LET,$(left),$(2)))))))) +QQ_FOLD = $(if $1\ + ,$(call QQ_LOOP,$(firstword $1),$(call QQ_FOLD,$(_rest)))$(rem \ + ),$(call list)) + +QUASIQUOTE = $(call QUASIQUOTE_$(_obj_type),$1) +QUASIQUOTE_nil = $1 +QUASIQUOTE_true = $1 +QUASIQUOTE_false = $1 +QUASIQUOTE_string = $1 +QUASIQUOTE_number = $1 +QUASIQUOTE_keyword = $1 +QUASIQUOTE_symbol = $(call list,$(call _symbol,quote) $1) +QUASIQUOTE_map = $(call list,$(call _symbol,quote) $1) + +QUASIQUOTE_vector = $(call list,$(call _symbol,vec) $(call QQ_FOLD,$(_seq_vals))) + +QUASIQUOTE_list = $(if $(call starts_with?,$(_seq_vals),unquote)\ + ,$(lastword $(_seq_vals))$(rem \ + ),$(call QQ_FOLD,$(_seq_vals))) + +EVAL_special_quote = $1 + +EVAL_special_quasiquote = $(call EVAL,$(QUASIQUOTE),$2) + +EVAL_nil = $1 +EVAL_true = $1 +EVAL_false = $1 +EVAL_string = $1 +EVAL_number = $1 +EVAL_keyword = $1 + +EVAL_symbol = $(or $(call ENV_GET,$2,$1),$(call _error,'$(_symbol_val)' not found)) + +EVAL_vector = $(call vector,$(foreach e,$(_seq_vals),$(call EVAL,$e,$2))) + +# First foreach defines a constant, second one loops on keys. +define EVAL_map +$(foreach obj,$(call _map_new)\ +,$(obj)$(rem $(foreach k,$(_keys)\ + ,$(call _assoc!,$(obj),$k,$(call EVAL,$(call _get,$1,$k),$2))))) +endef + +define EVAL_list +$(if $(_seq_vals)\ + ,$(foreach a0,$(firstword $(_seq_vals))\ + ,$(if $(call _symbol?,$(a0))\ + ,$(foreach dispatch,EVAL_special_$(call _symbol_val,$(a0))\ + ,$(if $(filter undefined,$(flavor $(dispatch)))\ + ,$(call EVAL_apply,$(_seq_vals),$2)$(rem \ + ),$(call $(dispatch),$(call _rest,$(_seq_vals)),$2)))$(rem \ + ),$(call EVAL_apply,$(_seq_vals),$2)))$(rem \ + ),$1) +endef + +define EVAL_apply +$(foreach f,$(call EVAL,$(firstword $1),$2)\ +,$(if $(__ERROR)\ + ,,$(if $(call _macro?,$f)\ + ,$(call EVAL,$(call _apply,$f,$(_rest)),$2)$(rem \ + ),$(call _apply,$f,$(foreach a,$(_rest),$(call EVAL,$a,$2)))))) +endef + +define EVAL_special_defmacro! +$(foreach res,$(call _as_macro,$(call EVAL,$(lastword $1),$2))\ + ,$(res)$(call ENV_SET,$2,$(firstword $1),$(res))) +endef + +define EVAL_special_def! +$(foreach res,$(call EVAL,$(lastword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)$(call ENV_SET,$2,$(firstword $1),$(res)))) +endef + +define EVAL_special_let* +$(foreach let_env,$(call ENV,$2)\ +,$(call _foreach2,$(call _seq_vals,$(firstword $1))\ + ,$$(call ENV_SET,$(let_env),$$k,$$(call EVAL,$$v,$(let_env))))$(rem \ +)$(call EVAL,$(lastword $1),$(let_env))) endef -define EVAL_INVOKE -$(if $(__ERROR),,\ - $(and $(EVAL_DEBUG),$(info EVAL_INVOKE: $(call _pr_str,$(1)))) - $(foreach a0,$(call _nth,$(1),0),\ - $(if $(call _EQ,def!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call EVAL,$(a2),$(2)),\ - $(if $(__ERROR),,\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),))))),\ - $(if $(call _EQ,let*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call EVAL,$(a2),$(call LET,$(a1),$(call ENV,$(2)))))),\ - $(if $(call _EQ,quote,$($(a0)_value)),\ - $(call _nth,$(1),1),\ - $(if $(call _EQ,quasiquote,$($(a0)_value)),\ - $(call EVAL,$(call QUASIQUOTE,$(call _nth,$(1),1)),$(2)),\ - $(if $(call _EQ,defmacro!,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach res,$(call _clone_obj,$(call EVAL,$(a2),$(2))),\ - $(eval _macro_$(res) = true)\ - $(if $(call ENV_SET,$(2),$($(a1)_value),$(res)),$(res),)))),\ - $(if $(call _EQ,make*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(and $(EVAL_DEBUG),$(info make*: $$(eval __result := $(call str_decode,$(value $(a1)_value)))))\ - $(eval __result := $(call str_decode,$(value $(a1)_value)))$(call _string,$(__result))),\ - $(if $(call _EQ,try*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach res,$(call EVAL,$(a1),$(2)),\ - $(if $(__ERROR),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach a20,$(call _nth,$(a2),0),\ - $(if $(call _EQ,catch*,$($(a20)_value)),\ - $(foreach a21,$(call _nth,$(a2),1),\ - $(foreach a22,$(call _nth,$(a2),2),\ - $(foreach binds,$(call _list,$(a21)),\ - $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ - $(eval __ERROR :=)\ - $(call EVAL,$(a22),$(catch_env)))))),\ - $(res)))),\ - $(res)))),\ - $(if $(call _EQ,do,$($(a0)_value)),\ - $(call slast,$(call _smap,EVAL,$(call srest,$(1)),$(2))),\ - $(if $(call _EQ,if,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(foreach cond,$(call EVAL,$(a1),$(2)),\ - $(if $(or $(call _EQ,$(__nil),$(cond)),$(call _EQ,$(__false),$(cond))),\ - $(foreach a3,$(call _nth,$(1),3),$(call EVAL,$(a3),$(2))),\ - $(call EVAL,$(a2),$(2)))))),\ - $(if $(call _EQ,fn*,$($(a0)_value)),\ - $(foreach a1,$(call _nth,$(1),1),\ - $(foreach a2,$(call _nth,$(1),2),\ - $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ - $(foreach f,$(call EVAL,$(a0),$(2)),\ - $(foreach args,$(call srest,$(1)),\ - $(if $(_macro_$(f)),\ - $(call EVAL,$(call apply,$(f),$(args)),$(2)),\ - $(call apply,$(f),$(call _smap,EVAL,$(args),$(2)))))))))))))))))) +EVAL_special_do = $(lastword $(foreach x,$1,$(call EVAL,$x,$2))) + +define EVAL_special_if +$(if $(call truthy?,$(call EVAL,$(firstword $1),$2))\ + ,$(call EVAL,$(word 2,$1),$2)$(rem \ +),$(if $(word 3,$1)\ + ,$(call EVAL,$(lastword $1),$2)$(rem \ +),$(__nil))) +endef + +EVAL_special_fn* = $(call _function,$(call _seq_vals,$(firstword $1)),$(lastword $1),$2) + +# EVAL may fail and return nothing, so the first foreach may execute +# nothing, so we need to duplicate the test for error. +# The second foreach deliberately does nothing when there is no +# catch_list. +define EVAL_special_try* +$(foreach res,$(call EVAL,$(firstword $1),$2)\ + ,$(if $(__ERROR)\ + ,,$(res)))$(rem \ +)$(if $(__ERROR)\ + ,$(foreach catch_list,$(word 2,$1)\ + ,$(foreach env,$(call ENV,$2)\ + ,$(call ENV_SET,$(env),$(word 2,$(call _seq_vals,$(catch_list))),$(__ERROR))$(rem \ + )$(eval __ERROR :=)$(rem \ + )$(call EVAL,$(lastword $(call _seq_vals,$(catch_list))),$(env))))) +endef + +define EVAL_special_make* +$(eval __result := $(call str_decode_nospace,$(_string_val)))$(rem \ +)$(call _string,$(call str_encode_nospace,$(__result))) endef define EVAL -$(strip $(if $(__ERROR),,\ - $(if $(filter-out false nil,$(call _obj_type,$(or $(call ENV_GET,$(2),DEBUG-EVAL),$(__nil)))),\ - $(info EVAL: $(_pr_str)))\ - $(if $(call _symbol?,$(1)),\ - $(foreach key,$($(1)_value),\ - $(or $(call ENV_GET,$(2),$(key)),\ - $(call _error,'$(key)' not found)$(__nil))),\ - $(if $(call _vector?,$(1)),\ - $(call _smap_vec,EVAL,$(1),$(2)),\ - $(if $(call _hash_map?,$(1)),\ - $(foreach new_hmap,$(call __new_obj,hmap),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_hmap)_%) := $(call EVAL,$($(v)),$(2))))\ - $(eval $(new_hmap)_size := $($(1)_size))\ - $(new_hmap)),\ - $(if $(call _list?,$(1)),\ - $(if $(call _EQ,0,$(call _count,$(1))),\ - $(1),\ - $(word 1,$(strip $(call EVAL_INVOKE,$(1),$(2)) $(__nil)))),\ - $(1))))))) +$(if $(__ERROR)\ +,,$(if $(call truthy?,$(call ENV_GET,$(2),$(call _symbol,DEBUG-EVAL)))\ + ,$(call print,EVAL: $(call _pr_str,$1,yes) env: $(call env_keys,$2)))$(rem \ +)$(call EVAL_$(_obj_type),$1,$2)) endef # PRINT: define PRINT -$(if $(__ERROR),Error: $(call _pr_str,$(__ERROR),yes),$(if $(1),$(call _pr_str,$(1),yes)))$(if $(__ERROR),$(eval __ERROR :=),) +$(if $(__ERROR)\ + ,Error$(encoded_colon)$(_SP)$(call _pr_str,$(__ERROR),yes)$(rem \ + ),$(call _pr_str,$1,yes)) endef # REPL: REPL_ENV := $(call ENV) -REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) -REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) +REP = $(call PRINT,$(call EVAL,$(READ),$(REPL_ENV))) + +# The foreach does nothing when line is empty (EOF). +define REPL +$(foreach line,$(call READLINE,user>$(_SP))\ +,$(eval __ERROR :=)$(rem \ +)$(call print,$(call REP,$(line:ok=)))$(rem \ +)$(call REPL)) +endef + +# Read and evaluate for side effects but ignore the result. +define RE +$(rem $(call EVAL,$(call READ,$(str_encode_nospace)),$(REPL_ENV)) \ +)$(if $(__ERROR)\ + ,$(error during startup: $(call str_decode_nospace,$(call _pr_str,$(__ERROR),yes)))) +endef # core.mk: defined using Make -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -_import_core = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_core,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_core,$(core_ns)) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_argv := $(call _list) -REPL_ENV := $(call ENV_SET,$(REPL_ENV),*ARGV*,$(_argv)) +$(foreach f,$(core_ns)\ + ,$(call ENV_SET,$(REPL_ENV),$(call _symbol,$f),$(call _corefn,$f))) + +core_eval = $(call EVAL,$1,$(REPL_ENV)) +$(call ENV_SET,$(REPL_ENV),$(call _symbol,eval),$(call _corefn,core_eval)) + +$(call ENV_SET,$(REPL_ENV),$(call _symbol,*ARGV*),$(call list,$(foreach arg,\ + $(call _rest,$(MAKECMDGOALS)),$(call _string,$(call str_encode_nospace,$(arg)))))) # core.mal: defined in terms of the language itself -$(call do,$(call REP, (def! *host-language* "make") )) -$(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) -$(call do,$(call REP, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) )) -$(call do,$(call REP, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) )) +$(call RE, (def! not (fn* (a) (if a false true))) ) +$(call RE, (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) ) +$(call RE, (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons 'cond (rest (rest xs))))))) ) +$(call RE, (def! *host-language* "make") ) +ifneq (,$(MAKECMDGOALS)) # Load and eval any files specified on the command line -$(if $(MAKECMDGOALS),\ - $(foreach arg,$(wordlist 2,$(words $(MAKECMDGOALS)),$(MAKECMDGOALS)),\ - $(call do,$(call _conj!,$(_argv),$(call _string,$(arg)))))\ - $(call do,$(call REP, (load-file "$(word 1,$(MAKECMDGOALS))") )) \ - $(eval INTERACTIVE :=),) - +$(call RE, (load-file "$(firstword $(MAKECMDGOALS))") ) +else # repl loop -$(if $(strip $(INTERACTIVE)),\ - $(call do,$(call REP, (println (str "Mal [" *host-language* "]")) )) \ - $(call REPL)) +$(call RE, (println (str "Mal [" *host-language* "]")) ) +$(REPL) +endif +# Do not complain that there is no target. .PHONY: none $(MAKECMDGOALS) none $(MAKECMDGOALS): @true diff --git a/impls/make/types.mk b/impls/make/types.mk index a5a055a5bf..cae9184f0e 100644 --- a/impls/make/types.mk +++ b/impls/make/types.mk @@ -14,255 +14,194 @@ include $(_TOP_DIR)numbers.mk # Low-level type implemenation # magic is \u2344 \u204a -__obj_magic = ⍄⁊ +__obj_magic := ⍄⁊ # \u2256 -__equal = ≛ -__keyword = ʞ -__obj_hash_code = 0 +__obj_hash_code := 0 -__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) - -__new_obj_like = $(foreach type,$(word 2,$(subst _, ,$(1))),$(__obj_magic)_$(type)_$(__new_obj_hash_code)) - -__get_obj_values = $(strip \ - $(if $(filter $(__obj_magic)_hmap_%,$(1)),\ - $(sort $(foreach v,$(filter %_value,$(filter $(1)_%,$(.VARIABLES))),$(if $(call _undefined?,$(v)),,$(v)))),\ - $($(1)_value))) +# 1:type 2:optional content -> variable name +define __new_obj +$(eval __obj_hash_code := $(call int_add,1,$(__obj_hash_code)))$(rem \ +)$(foreach obj,$(__obj_magic)_$(__obj_hash_code)_$1\ + ,$(obj)$(if $2,$(eval $(obj) := $2))) +endef # Visualize Objects in memory -__var_name = $(word 2,$(subst _, ,$(1)))_$(word 3,$(subst _, ,$(1))) -__var_idx := 0 -__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 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 int_add,1,$($(lidx)))))),\ - $(if $(call _hash_map?,$(v)),\ - $(info $(2)$(var):)\ - $(foreach vkey,$(filter $(v)_%,$(.VARIABLES)),\ - $(foreach key,$(word 4,$(subst _, ,$(vkey))),\ - $(info $(2)$(SPACE)$(SPACE)$(subst $(__equal),=,$(key)): )\ - $(call __var_print,$($(vkey)),$(2)$(SPACE)$(SPACE)$(SPACE)$(SPACE)))),\ - $(if $(call _symbol?,$(v)),\ - $(info $(2)$(var): $($(v)_value)),\ - $(if $(call _keyword?,$(v)),\ - $(info $(2)$(var): $($(v)_value)),\ - $(if $(call _number?,$(v)),\ - $(info $(2)$(var): $(call int_decode,$($(v)_value))),\ - $(if $(call _nil?,$(v)),\ - $(info $(2)nil),\ - $(if $(call _function?,$(v)),\ - $(if $(word 6,$(value $(v)_value)),\ - $(info $(2)$(var): $(wordlist 1,5,$(value $(v)_value))...),\ - $(info $(2)$(var): $(value $(v)_value))),\ - $(info $(2)$(var): ...)))))))))) - -_visualize_memory = $(foreach var,$(sort $(foreach vv,$(filter $(__obj_magic)_%,$(.VARIABLES)),$(call __var_name,$(vv)))),$(call __var_print,$(__obj_magic)_$(var))) +_visualize_memory = $(foreach v,$(sort $(filter $(__obj_magic)_%,$(.VARIABLES)))\ + ,$(info $v $($v))) # Errors/Exceptions __ERROR := -_error = $(strip $(eval __ERROR := $(call _string,$(1)))) +throw = $(eval __ERROR := $1) +_error = $(call throw,$(call _string,$(str_encode_nospace))) # Constant atomic values -__undefined = $(__obj_magic)_undf_0 -__nil = $(__obj_magic)__nil_0 -__true = $(__obj_magic)_true_0 -__false = $(__obj_magic)_fals_0 +__nil := _nil +__true := _true +__false := _false # General functions -# Return the type of the object (or "make" if it's not a object -_obj_type = $(strip \ - $(if $(filter $(__obj_magic)_symb_%,$(1)),symbol,\ - $(if $(filter $(__obj_magic)_list_%,$(1)),list,\ - $(if $(filter $(__obj_magic)_numb_%,$(1)),number,\ - $(if $(filter $(__obj_magic)_func_%,$(1)),function,\ - $(if $(filter $(__obj_magic)_strn_%,$(1)),\ - $(if $(filter $(__keyword)%,$($(1)_value)),keyword,string),\ - $(if $(filter $(__obj_magic)__nil_%,$(1)),nil,\ - $(if $(filter $(__obj_magic)_true_%,$(1)),true,\ - $(if $(filter $(__obj_magic)_fals_%,$(1)),false,\ - $(if $(filter $(__obj_magic)_vect_%,$(1)),vector,\ - $(if $(filter $(__obj_magic)_atom_%,$(1)),atom,\ - $(if $(filter $(__obj_magic)_hmap_%,$(1)),hash_map,\ - $(if $(filter $(__obj_magic)_undf_%,$(1)),undefined,\ - make))))))))))))) - -_clone_obj = $(strip \ - $(foreach new_hcode,$(call __new_obj_hash_code),\ - $(foreach new_obj,$(foreach type,$(word 2,$(subst _, ,$(1))),$(__obj_magic)_$(type)_$(new_hcode)),\ - $(if $(filter $(__obj_magic)_hmap_%,$(1)),\ - $(foreach v,$(call __get_obj_values,$(1)),\ - $(eval $(v:$(1)_%=$(new_obj)_%) := $($(v))))\ - $(eval $(new_obj)_size := $($(1)_size)),\ - $(if $(filter $(__obj_magic)_func_%,$(1)),\ - $(eval $(new_obj)_value = $(value $(1)_value)),\ - $(eval $(new_obj)_value := $(strip $($(1)_value)))))\ - $(new_obj)))) - -_hash_equal? = $(strip \ - $(if $(and $(call _EQ,$(foreach v,$(call __get_obj_values,$(1)),$(word 4,$(subst _, ,$(v)))),$(foreach v,$(call __get_obj_values,$(2)),$(word 4,$(subst _, ,$(v))))),\ - $(call _EQ,$(call _count,$(1)),$(words $(call gmsl_pairmap,_equal?,$(foreach v,$(call __get_obj_values,$(1)),$($(v))),$(foreach v,$(call __get_obj_values,$(2)),$($(v))))))),\ - $(__true),)) - -_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)))),\ - $(if $(or $(call _string?,$(1)),$(call _symbol?,$(1)),$(call _keyword?,$(1)),$(call _number?,$(1))),\ - $(call _EQ,$($(1)_value),$($(2)_value)),\ - $(if $(call _hash_map?,$(1)),\ - $(call _hash_equal?,$(1),$(2)),\ - $(if $(or $(call _vector?,$(1)),$(call _list?,$(1))),\ - $(if $(and $(call _EQ,$(call _count,$(1)),$(call _count,$(2))),\ - $(call _EQ,$(call _count,$(1)),$(words $(call gmsl_pairmap,_equal?,$(call __get_obj_values,$(1)),$(call __get_obj_values,$(2)))))),\ - $(__true),),\ - $(call _EQ,$(1),$(2))))))))) - -_undefined? = $(or $(call _EQ,undefined,$(origin $(1))),$(filter $(__undefined),$($(1)))) - -_nil? = $(if $(filter $(__obj_magic)__nil_%,$(1)),$(__true),) - -_true? = $(if $(filter $(__obj_magic)_true_%,$(1)),$(__true),) - -_false? = $(if $(filter $(__obj_magic)_fals_%,$(1)),$(__true),) +_obj_type = $(lastword $(subst _, ,$1)) + +_clone_obj = $(_clone_obj_$(_obj_type)) +_clone_obj_list = $(call list,$($1)) +_clone_obj_vector = $(call vector,$($1)) +_clone_obj_map = $(_map_new) +_clone_obj_function = $(call __new_obj,function,$($1)) +_clone_obj_corefn = $(call _corefn,$($1)) + +define _hash_equal? +$(if $3\ + ,$(and $(call _equal?,$($1_$(firstword $3)),$($2_$(firstword $3))),\ + $(call _hash_equal?,$1,$2,$(call _rest,$3)))$(rem \ + ),true) +endef + +define _equal?_seq_loop +$(if $1\ + ,$(and $2,\ + $(call _equal?,$(firstword $1),$(firstword $2)),\ + $(call _equal?_seq_loop,$(_rest),$(call _rest,$2)))$(rem \ + ),$(if $2,,true)) +endef + +define _equal? +$(or $(filter $1,$2),\ + $(and $(filter %_list %_vector,$1),\ + $(filter %_list %_vector,$2),\ + $(call _equal?_seq_loop,$($1),$($2))),\ + $(and $(filter %_map,$1),\ + $(filter %_map,$2),\ + $(call _EQ,$(_keys),$(call _keys,$2)),\ + $(call _hash_equal?,$1,$2,$(_keys)))) +endef + +_nil? = $(filter $(__nil),$1) + +_true? = $(filter $(__true),$1) + +_false? = $(filter $(__false),$1) + +# Conveniently for DEBUG-EVAL, returns false if $1 is empty. +truthy? = $(filter-out _nil _false,$1) # Symbols -_symbol = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_symb_$(hcode)$(eval $(__obj_magic)_symb_$(hcode)_value := $(1))) -_symbol? = $(if $(filter $(__obj_magic)_symb_%,$(1)),$(__true),) +_symbol = $1_symbol +_symbol_val = $(1:_symbol=) +_symbol? = $(filter %_symbol,$1) # Keywords -_keyword = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_strn_$(hcode)$(eval $(__obj_magic)_strn_$(hcode)_value := $(__keyword)$(1))) -_keyword? = $(if $(filter $(__obj_magic)_strn_%,$(1)),$(if $(filter $(__keyword)%,$($(1)_value)),$(__true),)) +_keyword = $1_keyword +_keyword? = $(filter %_keyword,$1) +_keyword_val = $(1:_keyword=) # Numbers -_pnumber = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_numb_$(hcode)$(eval $(__obj_magic)_numb_$(hcode)_value := $(1))) -_number = $(call _pnumber,$(call int_encode,$(1))) -_number? = $(if $(filter $(__obj_magic)_numb_%,$(1)),$(__true),) +_number = $1_number +_number? = $(filter %_number,$1) +_number_val = $(1:_number=) # Strings -__string = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_strn_$(hcode)$(eval $(__obj_magic)_strn_$(hcode)_value := $(1))) -_string = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_strn_$(hcode)$(eval $(__obj_magic)_strn_$(hcode)_value := $(call str_encode,$(1)))) -_string? = $(if $(filter $(__obj_magic)_strn_%,$(1)),$(__true),) +_string = $1_string +_string? = $(filter %_string,$1) +_string_val = $(1:_string=) # Functions -# Return a function object. The first parameter is the -# function/macro 'source'. Note that any $ must be escaped as $$ to be -# preserved and become positional arguments for when the -# function/macro is later invoked. -_function = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_func_$(hcode)$(eval $(__obj_magic)_func_$(hcode)_value = $(1))) -_function? = $(if $(filter $(__obj_magic)_func_%,$(1)),$(__true),) - -# Takes a function name and a list object of arguments and invokes -# the function with space separated arguments -_apply = $(call $(1),$($(2)_value)) +_corefn = $(call __new_obj,corefn,$1) +_function = $(call __new_obj,function,$2 $3 $1) +_as_macro = $(call __new_obj,macro,$($1)) +_fn? = $(filter %_corefn %_function,$1) +_macro? = $(filter %_macro,$1) + +# 1:env 2:formal parameters 3:actual parameters +define _function_set_env +$(if $2\ + ,$(if $(filter &_symbol,$(firstword $2))\ + ,$(call ENV_SET,$1,$(lastword $2),$(call list,$3)),$(rem \ + else \ + $(call ENV_SET,$1,$(firstword $2),$(firstword $3)) + $(call _function_set_env,$1,$(call _rest,$2),$(call _rest,$3))))) +endef # Takes a function object and a list object of arguments and invokes # the function with space separated arguments -apply = $(call $(1)_value,$($(2)_value)) +define _apply +$(if $(filter %_corefn,$1)\ + ,$(call $($1),$2)$(rem \ +),$(if $(filter %_function %_macro,$1)\ + ,$(foreach env,$(call ENV,$(word 2,$($1)))\ + ,$(call _function_set_env,$(env),$(call _rest2,$($1)),$2)$(rem \ + )$(call EVAL,$(firstword $($1)),$(env)))$(rem \ +),$(call _error,cannot apply non-function))) +endef # Lists -_list = $(word 1,$(foreach new_list,$(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_list_$(hcode)),$(new_list) $(eval $(new_list)_value := $1))) -_list? = $(if $(filter $(__obj_magic)_list_%,$(1)),$(__true),) +list = $(if $1,$(call __new_obj,list,$1),empty_list) +_list? = $(filter %_list,$1) + +_seq_vals = $($1) # Vectors (same as lists for now) -_vector = $(word 1,$(foreach new_vect,$(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_vect_$(hcode)),$(new_vect) $(eval $(new_vect)_value := $1))) -_vector? = $(if $(filter $(__obj_magic)_vect_%,$(1)),$(__true),) +vector = $(if $1,$(call __new_obj,vector,$1),empty_vector) +_vector? = $(filter %_vector,$1) # Hash maps (associative arrays) -_hash_map = $(word 1,$(foreach hcode,$(call __new_obj_hash_code),$(foreach new_hmap,$(__obj_magic)_hmap_$(hcode),$(new_hmap) $(eval $(new_hmap)_size := 0) $(if $(1),$(call _assoc_seq!,$(new_hmap),$(1)))))) -_hash_map? = $(if $(filter $(__obj_magic)_hmap_%,$(1)),$(__true),) +# 1:optional source map 2:optional key/value pairs 3:optional removals +define _map_new +$(foreach obj,$(call __new_obj,map,$(filter-out $3,$(if $1,$($1))))\ +,$(obj)$(rem \ +$(foreach k,$($(obj))\ + ,$(eval $(obj)_$k := $($1_$k)))\ +$(call _foreach2,$2\ + ,$$(call _assoc!,$(obj),$$k,$$v)))) +endef -# Set multiple key/values in a map -_assoc_seq! = $(call _assoc!,$(1),$(call str_decode,$($(word 1,$(2))_value)),$(word 2,$(2)))$(if $(word 3,$(2)),$(call _assoc_seq!,$(1),$(wordlist 3,$(words $(2)),$(2))),) +_hash_map? = $(filter %_map,$1) -_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 int_add,$($(1)_size),1)),)$(eval $(1)_$(k)_value := $(3))$(1)) +# map key val +# sort removes duplicates. +_assoc! = $(eval $1_$2 := $3)$(eval $1 := $(sort $($1) $2)) -# 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 int_sub,$($(1)_size),1))))$(1) - -# Hash map and vector functions +_keys = $($1) # retrieve the value of a plain string key from the hash map, or -# retrive a vector by plain index -_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 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 int_add,1,$(2)),$($(1)_value)),$(__true),),\ - ,))) +# return the empty string if the key is missing +_get = $($1_$2) # sequence operations -_sequential? = $(if $(filter $(__obj_magic)_list_% $(__obj_magic)_vect_%,$(1)),$(__true),) - -_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) - -_count = $(strip \ - $(if $(call _hash_map?,$(1)),\ - $($(1)_size),\ - $(words $($(1)_value)))) +_sequential? = $(filter %_list %_vector,$1) -_empty? = $(call _EQ,0,$(_count)) -# 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))))) +# Metadata functions -# maps a make function over a list object, using mutating _conj! -_smap = $(word 1,\ - $(foreach new_list,$(call _list),\ - $(new_list)\ - $(foreach v,$(call __get_obj_values,$(2)),\ - $(call _conj!,$(new_list),$(call $(1),$(v),$(3),$(4)))))) +with-meta = $(foreach obj,$(call _clone_obj,$(firstword $1))\ + ,$(obj)$(eval $(obj)_meta := $(lastword $1))) -# Same as _smap but returns a vector -_smap_vec = $(word 1,\ - $(foreach new_vector,$(call _vector),\ - $(new_vector)\ - $(foreach v,$(call __get_obj_values,$(2)),\ - $(call _conj!,$(new_vector),$(call $(1),$(v),$(3),$(4)))))) +meta = $(or $($1_meta),$(__nil)) # atoms -_atom? = $(if $(filter $(__obj_magic)_atom_%,$(1)),$(__true),) +atom = $(call __new_obj,atom,$1) +_atom? = $(filter %_atom,$1) +deref = $($1) +_reset = $(eval $1 = $2) endif diff --git a/impls/make/util.mk b/impls/make/util.mk index 887798542b..77139a1add 100644 --- a/impls/make/util.mk +++ b/impls/make/util.mk @@ -8,6 +8,12 @@ __mal_util_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)gmsl.mk +encoded_equal := Ξ +encoded_colon := κ +encoded_slash := λ +raw_hash := \# +encoded_hash := η + SEMI := ; COMMA := , COLON := : @@ -19,37 +25,29 @@ LBRACKET := [ RBRACKET := ] DQUOTE := "# " SLASH := $(strip \ ) -ESC_DQUOTE := $(SLASH)$(DQUOTE) -ESC_N := $(SLASH)n +ESC_DQUOTE := $(encoded_slash)$(DQUOTE) +ESC_N := $(encoded_slash)n SQUOTE := '# ' QQUOTE := `# ` -SPACE := $(hopefully_undefined) $(hopefully_undefined) +SPACE := +SPACE := $(SPACE) $(SPACE) MINUS := - NUMBERS := 0 1 2 3 4 5 6 7 8 9 UNQUOTE := ~ -SPLICE_UNQUOTE := ~@ define NEWLINE endef CARET := ^ ATSIGN := @ -HASH := \# -_HASH := © # \u00ab _LP := « # \u00bb _RP := » -# \u00ed -_LC := í -# \u00ec -_RC := ì ## \u00a7 _SP := § ## \u00ae -_SUQ := ® -## \u015e _DOL := Ş ## \u00b6 _NL := ¶ @@ -63,38 +61,69 @@ _NL := ¶ _EQ = $(if $(subst x$1,,x$2)$(subst x$2,,x$1),,true) -_NOT = $(if $1,,true) - -# 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))) - -#$(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)) +_reverse = $(if $1,$(call _reverse,$(_rest)) $(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 $$(HASH),$(_HASH) ,$$(subst $$(SPACE),$(_SP) ,$$1))))))))))$(foreach a,$(gmsl_characters),$(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(__temp)) +define str_encode +$(eval __temp := $1)$(rem \ +)$(foreach a,$(encoded_slash) $(_DOL) $(_LP) $(_RP) $(_NL) \ + $(encoded_hash) $(encoded_colon) $(_SP) $(encoded_equal) $(gmsl_characters)\ + ,$(eval __temp := $$(subst $$a,$$a$$(SPACE),$(__temp))))$(rem \ +)$(__temp) +endef # 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),$$,$(subst $(_HASH),$(HASH),$(strip $(call _join,$(1)))))))))))) +str_decode = $(subst $(SPACE),,$1) + +define str_encode_nospace +$(subst $(SLASH),$(encoded_slash),$(rem \ +)$(subst $$,$(_DOL),$(rem \ +)$(subst $(LPAREN),$(_LP),$(rem \ +)$(subst $(RPAREN),$(_RP),$(rem \ +)$(subst $(NEWLINE),$(_NL),$(rem \ +)$(subst $(raw_hash),$(encoded_hash),$(rem \ +)$(subst $(COLON),$(encoded_colon),$(rem \ +)$(subst $(SPACE),$(_SP),$(rem \ +)$(subst =,$(encoded_equal),$(rem \ +)$1))))))))) +endef + +define str_decode_nospace +$(subst $(encoded_slash),$(SLASH),$(rem \ +)$(subst $(_DOL),$$,$(rem \ +)$(subst $(_LP),$(LPAREN),$(rem \ +)$(subst $(_RP),$(RPAREN),$(rem \ +)$(subst $(_NL),$(NEWLINE),$(rem \ +)$(subst $(encoded_hash),$(raw_hash),$(rem \ +)$(subst $(encoded_colon),$(COLON),$(rem \ +)$(subst $(_SP),$(SPACE),$(rem \ +)$(subst $(encoded_equal),=,$1))))))))) +endef # 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")) +_read_file = $(call str_encode_nospace,$(shell \ + sed -z 's/\n/$(_NL)/g' '$(str_decode_nospace)')) + +print = $(info $(str_decode_nospace)) + +_rest = $(wordlist 2,$(words $1),$1) +_rest2 = $(wordlist 3,$(words $1),$1) + +# Evaluate $3 repeatedly with $k and $v set to key/value pairs from $1. +define _foreach2 +$(if $1\ + ,$(foreach k,$(firstword $1)\ + ,$(foreach v,$(word 2,$1)\ + ,$(eval $2)))$(rem \ + )$(call _foreach2,$(_rest2),$2)) +endef endif