Change quasiquote algorithm

[jackhill/mal.git] / impls / make / core.mk

#
# mal (Make a Lisp) Core functions
#

ifndef __mal_core_included
__mal_core_included := true

_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST)))
include $(_TOP_DIR)util.mk
include $(_TOP_DIR)types.mk
include $(_TOP_DIR)readline.mk
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))


# Scalar functions
nil? = $(if $(call _nil?,$(1)),$(__true),$(__false))
true? = $(if $(call _true?,$(1)),$(__true),$(__false))
false? = $(if $(call _false?,$(1)),$(__true),$(__false))


# Symbol functions
symbol = $(call _symbol,$(call str_decode,$($(1)_value)))
symbol? = $(if $(call _symbol?,$(1)),$(__true),$(__false))

# Keyword functions
keyword = $(call _keyword,$(call str_decode,$($(1)_value)))
keyword? = $(if $(call _keyword?,$(1)),$(__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)))

# String functions

string? = $(if $(call _string?,$(1)),$(if $(call _keyword?,$(1)),$(__false),$(__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),, )))

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



# Function functions
fn? = $(if $(call _function?,$(1)),$(if $(_macro_$(1)),$(__false),$(__true)),$(__false))
macro? = $(if $(_macro_$(1)),$(__true),$(__false))


# List functions
list? = $(if $(call _list?,$(1)),$(__true),$(__false))


# Vector functions
vector? = $(if $(call _vector?,$(1)),$(__true),$(__false))

vec = $(if $(_list?),$(call _vector,$($1_value)),$(if $(_vector?),$1,$(call _error,vec: called on non-sequence)))


# Hash map (associative array) functions
hash_map? = $(if $(call _hash_map?,$(1)),$(__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)))))

# 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)))))))

vals = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$($(v)))))

# Hash map and vector functions

# 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))))))

contains? = $(if $(call _contains?,$(word 1,$(1)),$(call str_decode,$($(word 2,$(1))_value))),$(__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)))))))

concat = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $(strip $(foreach lst,$1,$(call __get_obj_values,$(lst)))))))

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

sfirst = $(word 1,$($(1)_value))

slast = $(word $(words $($(1)_value)),$($(1)_value))

empty? = $(if $(_empty?),$(__true),$(__false))

count = $(call _number,$(call _count,$(1)))

# 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)))))

# 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)))

# 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))))))

# 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))


# 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)

reset! = $(eval $(word 1,$(1))_value := $(word 2,$(1)))$(word 2,$(1))

swap! = $(foreach resp,$(call $(word 2,$(1))_value,$($(word 1,$(1))_value) $(wordlist 3,$(words $(1)),$(1))),\
          $(eval $(word 1,$(1))_value := $(resp))\
          $(resp))




# 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!

endif