diff options
149 files changed, 5738 insertions, 5091 deletions
diff --git a/bash/Makefile b/bash/Makefile index 53f0d09..65694ee 100644 --- a/bash/Makefile +++ b/bash/Makefile @@ -1,6 +1,6 @@ TESTS = tests/types.sh tests/reader.sh -SOURCES = types.sh reader.sh stepA_more.sh +SOURCES = types.sh reader.sh printer.sh env.sh core.sh stepA_more.sh all: mal.sh diff --git a/bash/core.sh b/bash/core.sh new file mode 100644 index 0000000..0da820c --- /dev/null +++ b/bash/core.sh @@ -0,0 +1,370 @@ +# +# mal (Make a Lisp) object types +# + +if [ -z "${__mal_core_included__}" ]; then +__mal_core_included=true + +source $(dirname $0)/types.sh +source $(dirname $0)/printer.sh + +# Exceptions/Errors + +throw() { + __ERROR="${1}" + r= +} + + +# General functions + +obj_type () { + _obj_type "${1}" + _string "${r}" +} + +equal? () { + _equal? "${1}" "${2}" && r="${__true}" || r="${__false}" +} + + +# Scalar functions + +nil? () { _nil? "${1}" && r="${__true}" || r="${__false}"; } +true? () { _true? "${1}" && r="${__true}" || r="${__false}"; } +false? () { _false? "${1}" && r="${__true}" || r="${__false}"; } + + +# Symbol functions + +symbol? () { _symbol? "${1}" && r="${__true}" || r="${__false}"; } + + +# Number functions + +number? () { _number? "${1}" && r="${__true}" || r="${__false}"; } + +num_plus () { r=$(( ${ANON["${1}"]} + ${ANON["${2}"]} )); _number "${r}"; } +num_minus () { r=$(( ${ANON["${1}"]} - ${ANON["${2}"]} )); _number "${r}"; } +num_multiply () { r=$(( ${ANON["${1}"]} * ${ANON["${2}"]} )); _number "${r}"; } +num_divide () { r=$(( ${ANON["${1}"]} / ${ANON["${2}"]} )); _number "${r}"; } + +_num_bool () { [[ "${1}" = "1" ]] && r="${__true}" || r="${__false}"; } +num_gt () { r=$(( ${ANON["${1}"]} > ${ANON["${2}"]} )); _num_bool "${r}"; } +num_gte () { r=$(( ${ANON["${1}"]} >= ${ANON["${2}"]} )); _num_bool "${r}"; } +num_lt () { r=$(( ${ANON["${1}"]} < ${ANON["${2}"]} )); _num_bool "${r}"; } +num_lte () { r=$(( ${ANON["${1}"]} <= ${ANON["${2}"]} )); _num_bool "${r}"; } + + +# String functions + +string? () { _string? "${1}" && r="${__true}" || r="${__false}"; } + +pr_str () { + local res="" + for x in "${@}"; do _pr_str "${x}" yes; res="${res} ${r}"; done + _string "${res:1}" +} + +str () { + local res="" + for x in "${@}"; do _pr_str "${x}"; res="${res}${r}"; done + _string "${res}" +} + +prn () { + local res="" + for x in "${@}"; do _pr_str "${x}" yes; res="${res} ${r}"; done + echo "${res:1}" + r="${__nil}"; +} + +println () { + local res="" + for x in "${@}"; do _pr_str "${x}"; res="${res} ${r}"; done + res="${res//\\n/$'\n'}" + echo -e "${res:1}" + r="${__nil}"; +} + + +# Function functions +function? () { _function? "${1}" && r="${__true}" || r="${__false}"; } + + +# List functions +list? () { _list? "${1}" && r="${__true}" || r="${__false}"; } + + +# Vector functions (same as lists for now) +vector? () { _vector? "${1}" && r="${__true}" || r="${__false}"; } + + +# Hash map (associative array) functions +hash_map? () { _hash_map? "${1}" && r="${__true}" || r="${__false}"; } + +# Return new hash map with keys/values updated +assoc () { + if ! _hash_map? "${1}"; then + _error "assoc onto non-hash-map" + return + fi + _copy_hash_map "${1}"; shift + local name="${r}" + local obj=${ANON["${name}"]} + declare -A -g ${obj} + + while [[ "${1}" ]]; do + eval ${obj}[\"${ANON["${1}"]}\"]=\"${2}\" + shift; shift + done + r="${name}" +} + +dissoc () { + if ! _hash_map? "${1}"; then + _error "dissoc from non-hash-map" + return + fi + _copy_hash_map "${1}"; shift + local name="${r}" + local obj=${ANON["${name}"]} + declare -A -g ${obj} + + while [[ "${1}" ]]; do + eval unset ${obj}[\"${ANON["${1}"]}\"] + shift + done + r="${name}" +} + +_get () { + _obj_type "${1}"; local ot="${r}" + case "${ot}" in + hash_map) + local obj="${ANON["${1}"]}" + eval r="\${${obj}[\"${2}\"]}" ;; + list|vector) + _nth "${1}" "${2}" + esac +} +get () { + _get "${1}" "${ANON["${2}"]}" + [[ "${r}" ]] || r="${__nil}" +} + +_contains? () { + local obj="${ANON["${1}"]}" + #echo "_contains? ${1} ${2} -> \${${obj}[\"${2}\"]+isset}" + eval [[ "\${${obj}[\"${2}\"]+isset}" ]] +} +contains? () { _contains? "${1}" "${ANON["${2}"]}" && r="${__true}" || r="${__false}"; } + +keys () { + local obj="${ANON["${1}"]}" + local kstrs= + eval local keys="\${!${obj}[@]}" + for k in ${keys}; do + _string "${k}" + kstrs="${kstrs} ${r}" + done + + __new_obj_hash_code + r="list_${r}" + ANON["${r}"]="${kstrs:1}" +} + +vals () { + local obj="${ANON["${1}"]}" + local kvals= + local val= + eval local keys="\${!${obj}[@]}" + for k in ${keys}; do + eval val="\${${obj}["\${k}"]}" + kvals="${kvals} ${val}" + done + + __new_obj_hash_code + r="list_${r}" + ANON["${r}"]="${kvals:1}" +} + + +# sequence operations + +sequential? () { + _sequential? "${1}" && r="${__true}" || r="${__false}" +} + +cons () { + _list ${1} ${ANON["${2}"]} +} + +concat () { + _list + local acc="" + for item in "${@}"; do + acc="${acc} ${ANON["${item}"]}" + done + ANON["${r}"]="${acc:1}" +} + +nth () { + _nth "${1}" "${ANON["${2}"]}" +} + +first () { + local temp="${ANON["${1}"]}" + r="${temp%% *}" + [ "${r}" ] || r="${__nil}" +} + +# Creates a new vector/list of the everything after but the first +# element +rest () { + local temp="${ANON["${1}"]}" + _list + if [[ "${temp#* }" == "${temp}" ]]; then + ANON["${r}"]= + else + ANON["${r}"]="${temp#* }" + fi +} + +last () { + local temp="${ANON["${1}"]}" + r="${temp##* }" +} + +empty? () { _empty? "${1}" && r="${__true}" || r="${__false}"; } + +count () { + _count "${1}" + _number "${r}" +} + +conj () { + local obj="${1}"; shift + local obj_data="${ANON["${obj}"]}" + __new_obj_like "${obj}" + if _list? "${obj}"; then + ANON["${r}"]="${obj_data:+${obj_data}}" + for elem in ${@}; do + ANON["${r}"]="${elem} ${ANON["${r}"]}" + done + + else + ANON["${r}"]="${obj_data:+${obj_data} }${*}" + fi +} + +apply () { + local f="${ANON["${1}"]}"; shift + local items="${@:1:$(( ${#@} -1 ))} ${ANON["${!#}"]}" + eval ${f%%@*} ${items} +} + +# Takes a function object and an list object and invokes the function +# on each element of the list, returning a new list of the results. +map () { + local f="${ANON["${1}"]}"; shift + #echo _map "${f}" "${@}" + _map "${f}" "${@}" +} + + +# Metadata functions + +with_meta () { + local obj="${1}"; shift + local meta_data="${1}"; shift + __new_obj_like "${obj}" + ANON["${r}"]="${ANON["${obj}"]}" + local meta_obj="meta_${r#*_}" + ANON["${meta_obj}"]="${meta_data}" +} + +meta () { + r="${ANON["meta_${1#*_}"]}" + [[ "${r}" ]] || r="${__nil}" +} + + +# atoms + +atom? () { _atom? "${1}" && r="${__true}" || r="${__false}"; } +deref () { + # TODO: double-check atom type + r=${ANON["${1}"]} +} +reset_BANG () { + local atm="${1}"; shift + ANON["${atm}"]="${*}" + r="${*}" +} +swap_BANG () { + local atm="${1}"; shift + local f="${ANON["${1}"]}"; shift + ${f%%@*} "${ANON["${atm}"]}" "${@}" + ANON["${atm}"]="${r}" +} + + + +# Namespace of core functions + +declare -A core_ns=( + [type]=obj_type + [=]=equal? + [throw]=throw + [nil?]=nil? + [true?]=true? + [false?]=false? + [symbol?]=symbol? + [pr-str]=pr_str + [str]=str + [prn]=prn + [println]=println + [<]=num_lt + [<=]=num_lte + [>]=num_gt + [>=]=num_gte + [+]=num_plus + [-]=num_minus + [__STAR__]=num_multiply + [/]=num_divide + + [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 + [nth]=nth + [first]=first + [rest]=rest + [empty?]=empty? + [count]=count + [conj]=conj + [apply]=apply + [map]=map + + [with-meta]=with_meta + [meta]=meta + [atom]=_atom + [atom?]=atom? + [deref]=deref + [reset!]=reset_BANG + [swap!]=swap_BANG) + +fi diff --git a/bash/env.sh b/bash/env.sh new file mode 100644 index 0000000..2eabe8b --- /dev/null +++ b/bash/env.sh @@ -0,0 +1,78 @@ +# +# mal (Make a Lisp) environment definition +# + +if [ -z "${__mal_env_included__}" ]; then +__mal_env_included=true + +source $(dirname $0)/types.sh + +# Any environment is a hash_map with an __outer__ key that refers to +# a parent environment (or nil) +ENV () { + r= + _hash_map + local env="${r}" + if [[ "${1}" ]]; then + outer="${1}"; shift + _assoc! "${env}" "__outer__" "${outer}" + else + _assoc! "${env}" "__outer__" "${__nil}" + fi + r="${env}" + + if [[ "${1}" && "${@}" ]]; then + local binds=(${ANON["${1}"]}); shift + local idx=0 + while [[ "${binds["${idx}"]}" ]]; do + local fp="${ANON["${binds["${idx}"]}"]}" + if [[ "${fp}" == "&" ]]; then + idx=$(( idx + 1 )) + fp="${ANON["${binds["${idx}"]}"]}" + _list "${@}" + _assoc! "${env}" "${fp}" "${r}" + break + else + _assoc! "${env}" "${fp}" "${1}" + shift + idx=$(( idx + 1 )) + fi + done + fi + r="${env}" +} + +# Find the environment with the key set and return the environment +ENV_FIND () { + if _contains? "${1}" "${2}"; then + r="${1}" + else + local obj="${ANON["${1}"]}" + eval local outer="\${${obj}["__outer__"]}" + if [[ "${outer}" && "${outer}" != "${__nil}" ]]; then + ENV_FIND "${outer}" "${2}" + else + r= + fi + fi +} + +# Find the environment with the key set and return the value of the +# key in that environment. If no environment contains the key then +# return an error +ENV_GET () { + ENV_FIND "${1}" "${2}" + local env="${r}" + if [[ "${r}" ]]; then + local obj="${ANON["${env}"]}" + eval r="\${${obj}["${2}"]}" + else + _error "'${2}' not found" + fi +} + +ENV_SET () { + _assoc! "${1}" "${2}" "${3}" +} + +fi diff --git a/bash/printer.sh b/bash/printer.sh new file mode 100644 index 0000000..911db17 --- /dev/null +++ b/bash/printer.sh @@ -0,0 +1,87 @@ +# +# mal (Make a Lisp) printer +# + +if [ -z "${__mal_printer_included__}" ]; then +__mal_printer_included=true + +source $(dirname $0)/types.sh + +_pr_str () { + local print_readably="${2}" + _obj_type "${1}"; local ot="${r}" + if [[ -z "${ot}" ]]; then + _error "_pr_str failed on '${1}'" + r="<${1}>" + else + eval ${ot}_pr_str "${1}" "${print_readably}" + fi +} + +nil_pr_str () { r="nil"; } +true_pr_str () { r="true"; } +false_pr_str () { r="false"; } + +number_pr_str () { r="${ANON["${1}"]}"; } + +symbol_pr_str () { + r="${ANON["${1}"]}" + r="${r//__STAR__/*}" +} + +string_pr_str () { + local print_readably="${2}" + if [ "${print_readably}" == "yes" ]; then + local s="${ANON["${1}"]}" + s="${s//\\/\\\\}" + r="\"${s//\"/\\\"}\"" + else + r="${ANON["${1}"]}" + fi + r="${r//__STAR__/$'*'}" +} + +function_pr_str () { r="${ANON["${1}"]}"; } + +hash_map_pr_str () { + local print_readably="${2}" + local res=""; local val="" + local hm="${ANON["${1}"]}" + eval local keys="\${!${hm}[@]}" + for key in ${keys}; do + #res="${res} \"${ANON["${key}"]}\"" + res="${res} \"${key//__STAR__/$'*'}\"" + eval val="\${${hm}[\"${key}\"]}" + _pr_str "${val}" "${print_readably}" + res="${res} ${r}" + done + r="{${res:1}}" +} + +vector_pr_str () { + local print_readably="${2}" + local res="" + for elem in ${ANON["${1}"]}; do + _pr_str "${elem}" "${print_readably}" + res="${res} ${r}" + done + r="[${res:1}]" +} + +list_pr_str () { + local print_readably="${2}" + local res="" + for elem in ${ANON["${1}"]}; do + _pr_str "${elem}" "${print_readably}" + res="${res} ${r}" + done + r="(${res:1})" +} + +atom_pr_str () { + local print_readably="${2}" + _pr_str "${ANON["${1}"]}" "${print_readably}" + r="(atom ${r})"; +} + +fi diff --git a/bash/reader.sh b/bash/reader.sh index bc32fa7..585b152 100644 --- a/bash/reader.sh +++ b/bash/reader.sh @@ -2,20 +2,23 @@ # mal (Make Lisp) Parser/Reader # +if [ -z "${__mal_readerr_included__}" ]; then +__mal_readerr_included=true + source $(dirname $0)/types.sh READ_ATOM () { local token=${__reader_tokens[${__reader_idx}]} __reader_idx=$(( __reader_idx + 1 )) case "${token}" in - [0-9]*) number "${token}" ;; + [0-9]*) _number "${token}" ;; \"*) token="${token:1:-1}" token="${token//\\\"/\"}" - string "${token}" ;; + _string "${token}" ;; nil) r="${__nil}" ;; true) r="${__true}" ;; false) r="${__false}" ;; - *) symbol "${token}" ;; + *) _symbol "${token}" ;; esac } @@ -54,39 +57,39 @@ READ_FORM () { local token=${__reader_tokens[${__reader_idx}]} case "${token}" in \') __reader_idx=$(( __reader_idx + 1 )) - symbol quote; local q="${r}" + _symbol quote; local q="${r}" READ_FORM; local f="${r}" - list "${q}" "${f}" ;; + _list "${q}" "${f}" ;; \`) __reader_idx=$(( __reader_idx + 1 )) - symbol quasiquote; local q="${r}" + _symbol quasiquote; local q="${r}" READ_FORM; local f="${r}" - list "${q}" "${f}" ;; + _list "${q}" "${f}" ;; \~) __reader_idx=$(( __reader_idx + 1 )) - symbol unquote; local q="${r}" + _symbol unquote; local q="${r}" READ_FORM; local f="${r}" - list "${q}" "${f}" ;; + _list "${q}" "${f}" ;; \~\@) __reader_idx=$(( __reader_idx + 1 )) - symbol splice-unquote; local q="${r}" + _symbol splice-unquote; local q="${r}" READ_FORM; local f="${r}" - list "${q}" "${f}" ;; + _list "${q}" "${f}" ;; ^) __reader_idx=$(( __reader_idx + 1 )) - symbol with-meta; local wm="${r}" + _symbol with-meta; local wm="${r}" READ_FORM; local meta="${r}" READ_FORM; local obj="${r}" - list "${wm}" "${obj}" "${meta}" ;; + _list "${wm}" "${obj}" "${meta}" ;; @) __reader_idx=$(( __reader_idx + 1 )) - symbol deref; local d="${r}" + _symbol deref; local d="${r}" READ_FORM; local f="${r}" - list "${d}" "${f}" ;; + _list "${d}" "${f}" ;; \)) _error "unexpected ')'" ;; \() READ_SEQ "(" ")" - list ${r} ;; + _list ${r} ;; \]) _error "unexpected ']'" ;; \[) READ_SEQ "[" "]" - vector ${r} ;; + _vector ${r} ;; \}) _error "unexpected '}'" ;; \{) READ_SEQ "{" "}" - hash_map ${r} ;; + _hash_map ${r} ;; *) READ_ATOM esac } @@ -151,3 +154,5 @@ READLINE () { history -s -- "${r}" history -a "${READLINE_HISTORY_FILE}" } + +fi diff --git a/bash/step1_read_print.sh b/bash/step1_read_print.sh index ba94208..ca852ed 100755 --- a/bash/step1_read_print.sh +++ b/bash/step1_read_print.sh @@ -3,6 +3,7 @@ INTERACTIVE=${INTERACTIVE-yes} source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh # READ: read and parse input READ () { diff --git a/bash/step2_eval.sh b/bash/step2_eval.sh index 4d571e4..0f03a79 100755 --- a/bash/step2_eval.sh +++ b/bash/step2_eval.sh @@ -3,6 +3,8 @@ INTERACTIVE=${INTERACTIVE-yes} source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/core.sh # READ: read and parse input READ () { @@ -20,17 +22,17 @@ EVAL_AST () { eval r="\${${env}["${val}"]}" [ "${r}" ] || _error "'${val}' not found" ;; list) - _map_with_type list EVAL "${ast}" "${env}" ;; + _map_with_type _list EVAL "${ast}" "${env}" ;; vector) - _map_with_type vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" ;; hash_map) local res="" val="" hm="${ANON["${ast}"]}" - hash_map; local new_hm="${r}" + _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" - assoc! "${new_hm}" "${key}" "${r}" + _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" ;; *) diff --git a/bash/step3_env.sh b/bash/step3_env.sh index cbc0867..28106ee 100755 --- a/bash/step3_env.sh +++ b/bash/step3_env.sh @@ -3,6 +3,9 @@ INTERACTIVE=${INTERACTIVE-yes} source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/core.sh +source $(dirname $0)/env.sh # READ: read and parse input READ () { @@ -20,17 +23,17 @@ EVAL_AST () { ENV_GET "${env}" "${val}" return ;; list) - _map_with_type list EVAL "${ast}" "${env}" ;; + _map_with_type _list EVAL "${ast}" "${env}" ;; vector) - _map_with_type vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" ;; hash_map) local res="" val="" hm="${ANON["${ast}"]}" - hash_map; local new_hm="${r}" + _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" - assoc! "${new_hm}" "${key}" "${r}" + _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" ;; *) diff --git a/bash/step4_if_fn_do.sh b/bash/step4_if_fn_do.sh index fedb324..d22ade6 100755 --- a/bash/step4_if_fn_do.sh +++ b/bash/step4_if_fn_do.sh @@ -3,6 +3,9 @@ INTERACTIVE=${INTERACTIVE-yes} source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/core.sh +source $(dirname $0)/env.sh # READ: read and parse input READ () { @@ -20,17 +23,17 @@ EVAL_AST () { ENV_GET "${env}" "${val}" return ;; list) - _map_with_type list EVAL "${ast}" "${env}" ;; + _map_with_type _list EVAL "${ast}" "${env}" ;; vector) - _map_with_type vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" ;; hash_map) local res="" val="" hm="${ANON["${ast}"]}" - hash_map; local new_hm="${r}" + _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" - assoc! "${new_hm}" "${key}" "${r}" + _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" ;; *) @@ -90,8 +93,8 @@ EVAL () { EVAL "${a2}" "${env}" fi return ;; - fn*) new_function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" + fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" return ;; *) EVAL_AST "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 @@ -124,10 +127,10 @@ REP () { PRINT "${r}" } -_fref () { new_function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } +_fref () { _function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } # Import types functions -for n in "${!types_ns[@]}"; do _fref "${n}" "${types_ns["${n}"]}"; done +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done # Defined using the language itself REP "(def! not (fn* (a) (if a false true)))" diff --git a/bash/step5_tco.sh b/bash/step5_tco.sh index 409ec87..2d81d84 100755 --- a/bash/step5_tco.sh +++ b/bash/step5_tco.sh @@ -3,6 +3,9 @@ INTERACTIVE=${INTERACTIVE-yes} source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/core.sh +source $(dirname $0)/env.sh # READ: read and parse input READ () { @@ -20,17 +23,17 @@ EVAL_AST () { ENV_GET "${env}" "${val}" return ;; list) - _map_with_type list EVAL "${ast}" "${env}" ;; + _map_with_type _list EVAL "${ast}" "${env}" ;; vector) - _map_with_type vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" ;; hash_map) local res="" val="" hm="${ANON["${ast}"]}" - hash_map; local new_hm="${r}" + _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" - assoc! "${new_hm}" "${key}" "${r}" + _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" ;; *) @@ -96,9 +99,9 @@ EVAL () { fi # Continue loop ;; - fn*) new_function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" + fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" return ;; *) EVAL_AST "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 @@ -141,10 +144,10 @@ REP () { PRINT "${r}" } -_fref () { new_function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } +_fref () { _function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } # Import types functions -for n in "${!types_ns[@]}"; do _fref "${n}" "${types_ns["${n}"]}"; done +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done # Defined using the language itself REP "(def! not (fn* (a) (if a false true)))" diff --git a/bash/step6_file.sh b/bash/step6_file.sh index 1c8fab5..1ebba64 100755 --- a/bash/step6_file.sh +++ b/bash/step6_file.sh @@ -3,6 +3,9 @@ INTERACTIVE=${INTERACTIVE-yes} source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/core.sh +source $(dirname $0)/env.sh # READ: read and parse input READ () { @@ -20,17 +23,17 @@ EVAL_AST () { ENV_GET "${env}" "${val}" return ;; list) - _map_with_type list EVAL "${ast}" "${env}" ;; + _map_with_type _list EVAL "${ast}" "${env}" ;; vector) - _map_with_type vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" ;; hash_map) local res="" val="" hm="${ANON["${ast}"]}" - hash_map; local new_hm="${r}" + _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" - assoc! "${new_hm}" "${key}" "${r}" + _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" ;; *) @@ -96,9 +99,9 @@ EVAL () { fi # Continue loop ;; - fn*) new_function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" + fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" return ;; *) EVAL_AST "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 @@ -141,10 +144,10 @@ REP () { PRINT "${r}" } -_fref () { new_function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } +_fref () { _function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } # Import types functions -for n in "${!types_ns[@]}"; do _fref "${n}" "${types_ns["${n}"]}"; done +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done read_string () { READ_STR "${ANON["${1}"]}"; } _fref "read-string" read_string @@ -154,7 +157,7 @@ slurp () { local lines mapfile lines < "${ANON["${1}"]}" local text="${lines[*]}"; text=${text//$'\n' /$'\n'} - string "${text}" + _string "${text}" } _fref "slurp" slurp diff --git a/bash/step7_quote.sh b/bash/step7_quote.sh index cecc3b8..5aa2991 100755 --- a/bash/step7_quote.sh +++ b/bash/step7_quote.sh @@ -3,6 +3,9 @@ INTERACTIVE=${INTERACTIVE-yes} source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/core.sh +source $(dirname $0)/env.sh # READ: read and parse input READ () { @@ -20,8 +23,8 @@ IS_PAIR () { QUASIQUOTE () { if ! IS_PAIR "${1}"; then - symbol quote - list "${r}" "${1}" + _symbol quote + _list "${r}" "${1}" return else _nth "${1}" 0; local a0="${r}" @@ -31,20 +34,20 @@ QUASIQUOTE () { elif IS_PAIR "${a0}"; then _nth "${a0}" 0; local a00="${r}" if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - symbol concat; local a="${r}" + _symbol concat; local a="${r}" _nth "${a0}" 1; local b="${r}" rest "${1}" QUASIQUOTE "${r}"; local c="${r}" - list "${a}" "${b}" "${c}" + _list "${a}" "${b}" "${c}" return fi fi fi - symbol cons; local a="${r}" + _symbol cons; local a="${r}" QUASIQUOTE "${a0}"; local b="${r}" rest "${1}" QUASIQUOTE "${r}"; local c="${r}" - list "${a}" "${b}" "${c}" + _list "${a}" "${b}" "${c}" return } @@ -58,17 +61,17 @@ EVAL_AST () { ENV_GET "${env}" "${val}" return ;; list) - _map_with_type list EVAL "${ast}" "${env}" ;; + _map_with_type _list EVAL "${ast}" "${env}" ;; vector) - _map_with_type vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" ;; hash_map) local res="" val="" hm="${ANON["${ast}"]}" - hash_map; local new_hm="${r}" + _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" - assoc! "${new_hm}" "${key}" "${r}" + _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" ;; *) @@ -141,9 +144,9 @@ EVAL () { fi # Continue loop ;; - fn*) new_function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" + fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" return ;; *) EVAL_AST "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 @@ -182,14 +185,14 @@ ENV; REPL_ENV="${r}" REP () { r= READ_STR "${1}" - EVAL "${r}" ${REPL_ENV} + EVAL "${r}" "${REPL_ENV}" PRINT "${r}" } -_fref () { new_function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } +_fref () { _function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } # Import types functions -for n in "${!types_ns[@]}"; do _fref "${n}" "${types_ns["${n}"]}"; done +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done read_string () { READ_STR "${ANON["${1}"]}"; } _fref "read-string" read_string @@ -199,7 +202,7 @@ slurp () { local lines mapfile lines < "${ANON["${1}"]}" local text="${lines[*]}"; text=${text//$'\n' /$'\n'} - string "${text}" + _string "${text}" } _fref "slurp" slurp diff --git a/bash/step8_macros.sh b/bash/step8_macros.sh index a905958..a32e7f9 100755 --- a/bash/step8_macros.sh +++ b/bash/step8_macros.sh @@ -3,6 +3,9 @@ INTERACTIVE=${INTERACTIVE-yes} source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/core.sh +source $(dirname $0)/env.sh # READ: read and parse input READ () { @@ -20,8 +23,8 @@ IS_PAIR () { QUASIQUOTE () { if ! IS_PAIR "${1}"; then - symbol quote - list "${r}" "${1}" + _symbol quote + _list "${r}" "${1}" return else _nth "${1}" 0; local a0="${r}" @@ -31,20 +34,20 @@ QUASIQUOTE () { elif IS_PAIR "${a0}"; then _nth "${a0}" 0; local a00="${r}" if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - symbol concat; local a="${r}" + _symbol concat; local a="${r}" _nth "${a0}" 1; local b="${r}" rest "${1}" QUASIQUOTE "${r}"; local c="${r}" - list "${a}" "${b}" "${c}" + _list "${a}" "${b}" "${c}" return fi fi fi - symbol cons; local a="${r}" + _symbol cons; local a="${r}" QUASIQUOTE "${a0}"; local b="${r}" rest "${1}" QUASIQUOTE "${r}"; local c="${r}" - list "${a}" "${b}" "${c}" + _list "${a}" "${b}" "${c}" return } @@ -83,17 +86,17 @@ EVAL_AST () { ENV_GET "${env}" "${val}" return ;; list) - _map_with_type list EVAL "${ast}" "${env}" ;; + _map_with_type _list EVAL "${ast}" "${env}" ;; vector) - _map_with_type vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" ;; hash_map) local res="" val="" hm="${ANON["${ast}"]}" - hash_map; local new_hm="${r}" + _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" - assoc! "${new_hm}" "${key}" "${r}" + _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" ;; *) @@ -177,9 +180,9 @@ EVAL () { fi # Continue loop ;; - fn*) new_function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" + fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" return ;; *) EVAL_AST "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 @@ -201,6 +204,7 @@ EVAL () { esac done } + # PRINT: PRINT () { if [[ "${__ERROR}" ]]; then @@ -221,22 +225,20 @@ REP () { PRINT "${r}" } -_fref () { new_function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } +_fref () { _function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } # Import types functions -for n in "${!types_ns[@]}"; do _fref "${n}" "${types_ns["${n}"]}"; done +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done read_string () { READ_STR "${ANON["${1}"]}"; } _fref "read-string" read_string -_eval () { - EVAL "${1}" "${REPL_ENV}" -} +_eval () { EVAL "${1}" "${REPL_ENV}"; } _fref "eval" _eval slurp () { local lines mapfile lines < "${ANON["${1}"]}" local text="${lines[*]}"; text=${text//$'\n' /$'\n'} - string "${text}" + _string "${text}" } _fref "slurp" slurp diff --git a/bash/step9_interop.sh b/bash/step9_interop.sh index e1d57f5..dfa1e2c 100755 --- a/bash/step9_interop.sh +++ b/bash/step9_interop.sh @@ -3,6 +3,9 @@ INTERACTIVE=${INTERACTIVE-yes} source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/core.sh +source $(dirname $0)/env.sh # READ: read and parse input READ () { @@ -20,8 +23,8 @@ IS_PAIR () { QUASIQUOTE () { if ! IS_PAIR "${1}"; then - symbol quote - list "${r}" "${1}" + _symbol quote + _list "${r}" "${1}" return else _nth "${1}" 0; local a0="${r}" @@ -31,20 +34,20 @@ QUASIQUOTE () { elif IS_PAIR "${a0}"; then _nth "${a0}" 0; local a00="${r}" if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - symbol concat; local a="${r}" + _symbol concat; local a="${r}" _nth "${a0}" 1; local b="${r}" rest "${1}" QUASIQUOTE "${r}"; local c="${r}" - list "${a}" "${b}" "${c}" + _list "${a}" "${b}" "${c}" return fi fi fi - symbol cons; local a="${r}" + _symbol cons; local a="${r}" QUASIQUOTE "${a0}"; local b="${r}" rest "${1}" QUASIQUOTE "${r}"; local c="${r}" - list "${a}" "${b}" "${c}" + _list "${a}" "${b}" "${c}" return } @@ -83,17 +86,17 @@ EVAL_AST () { ENV_GET "${env}" "${val}" return ;; list) - _map_with_type list EVAL "${ast}" "${env}" ;; + _map_with_type _list EVAL "${ast}" "${env}" ;; vector) - _map_with_type vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" ;; hash_map) local res="" val="" hm="${ANON["${ast}"]}" - hash_map; local new_hm="${r}" + _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" - assoc! "${new_hm}" "${key}" "${r}" + _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" ;; *) @@ -160,7 +163,7 @@ EVAL () { while read line; do output="${output}${line}\n" done < <(eval ${ANON["${r}"]}) - string "${output}" + _string "${output}" return ;; do) _count "${ast}" _slice "${ast}" 1 $(( ${r} - 2 )) @@ -186,9 +189,9 @@ EVAL () { fi # Continue loop ;; - fn*) new_function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" + fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" return ;; *) EVAL_AST "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 @@ -210,6 +213,7 @@ EVAL () { esac done } + # PRINT: PRINT () { if [[ "${__ERROR}" ]]; then @@ -230,22 +234,20 @@ REP () { PRINT "${r}" } -_fref () { new_function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } +_fref () { _function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } # Import types functions -for n in "${!types_ns[@]}"; do _fref "${n}" "${types_ns["${n}"]}"; done +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done read_string () { READ_STR "${ANON["${1}"]}"; } _fref "read-string" read_string -_eval () { - EVAL "${1}" "${REPL_ENV}" -} +_eval () { EVAL "${1}" "${REPL_ENV}"; } _fref "eval" _eval slurp () { local lines mapfile lines < "${ANON["${1}"]}" local text="${lines[*]}"; text=${text//$'\n' /$'\n'} - string "${text}" + _string "${text}" } _fref "slurp" slurp diff --git a/bash/stepA_more.sh b/bash/stepA_more.sh index 0902b57..605ca7f 100755 --- a/bash/stepA_more.sh +++ b/bash/stepA_more.sh @@ -3,6 +3,9 @@ INTERACTIVE=${INTERACTIVE-yes} source $(dirname $0)/reader.sh +source $(dirname $0)/printer.sh +source $(dirname $0)/core.sh +source $(dirname $0)/env.sh # READ: read and parse input READ () { @@ -20,8 +23,8 @@ IS_PAIR () { QUASIQUOTE () { if ! IS_PAIR "${1}"; then - symbol quote - list "${r}" "${1}" + _symbol quote + _list "${r}" "${1}" return else _nth "${1}" 0; local a0="${r}" @@ -31,20 +34,20 @@ QUASIQUOTE () { elif IS_PAIR "${a0}"; then _nth "${a0}" 0; local a00="${r}" if [[ "${ANON["${a00}"]}" == "splice-unquote" ]]; then - symbol concat; local a="${r}" + _symbol concat; local a="${r}" _nth "${a0}" 1; local b="${r}" rest "${1}" QUASIQUOTE "${r}"; local c="${r}" - list "${a}" "${b}" "${c}" + _list "${a}" "${b}" "${c}" return fi fi fi - symbol cons; local a="${r}" + _symbol cons; local a="${r}" QUASIQUOTE "${a0}"; local b="${r}" rest "${1}" QUASIQUOTE "${r}"; local c="${r}" - list "${a}" "${b}" "${c}" + _list "${a}" "${b}" "${c}" return } @@ -83,17 +86,17 @@ EVAL_AST () { ENV_GET "${env}" "${val}" return ;; list) - _map_with_type list EVAL "${ast}" "${env}" ;; + _map_with_type _list EVAL "${ast}" "${env}" ;; vector) - _map_with_type vector EVAL "${ast}" "${env}" ;; + _map_with_type _vector EVAL "${ast}" "${env}" ;; hash_map) local res="" val="" hm="${ANON["${ast}"]}" - hash_map; local new_hm="${r}" + _hash_map; local new_hm="${r}" eval local keys="\${!${hm}[@]}" for key in ${keys}; do eval val="\${${hm}[\"${key}\"]}" EVAL "${val}" "${env}" - assoc! "${new_hm}" "${key}" "${r}" + _assoc! "${new_hm}" "${key}" "${r}" done r="${new_hm}" ;; *) @@ -160,7 +163,7 @@ EVAL () { while read line; do output="${output}${line}\n" done < <(eval ${ANON["${r}"]}) - string "${output}" + _string "${output}" return ;; try*) MACROEXPAND "${a1}" "${env}" EVAL "${r}" "${env}" @@ -169,7 +172,7 @@ EVAL () { if [ "${ANON["${a20}"]}" == "catch__STAR__" ]; then _nth "${a2}" 1; local a21="${r}" _nth "${a2}" 2; local a22="${r}" - list "${a21}"; local binds="${r}" + _list "${a21}"; local binds="${r}" ENV "${env}" "${binds}" "${__ERROR}" local try_env="${r}" __ERROR= @@ -201,9 +204,9 @@ EVAL () { fi # Continue loop ;; - fn*) new_function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ - EVAL \"${a2}\" \"\${r}\"" \ - "${a2}" "${env}" "${a1}" + fn*) _function "ENV \"${env}\" \"${a1}\" \"\${@}\"; \ + EVAL \"${a2}\" \"\${r}\"" \ + "${a2}" "${env}" "${a1}" return ;; *) EVAL_AST "${ast}" "${env}" [[ "${__ERROR}" ]] && r= && return 1 @@ -225,6 +228,7 @@ EVAL () { esac done } + # PRINT: PRINT () { if [[ "${__ERROR}" ]]; then @@ -245,26 +249,24 @@ REP () { PRINT "${r}" } -_fref () { new_function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } +_fref () { _function "${2} \"\${@}\""; ENV_SET "${REPL_ENV}" "${1}" "${r}"; } # Import types functions -for n in "${!types_ns[@]}"; do _fref "${n}" "${types_ns["${n}"]}"; done +for n in "${!core_ns[@]}"; do _fref "${n}" "${core_ns["${n}"]}"; done readline () { - READLINE "${ANON["${1}"]}" && string "${r}" || r="${__nil}"; + READLINE "${ANON["${1}"]}" && _string "${r}" || r="${__nil}"; } _fref "readline" readline read_string () { READ_STR "${ANON["${1}"]}"; } _fref "read-string" read_string -_eval () { - EVAL "${1}" "${REPL_ENV}" -} +_eval () { EVAL "${1}" "${REPL_ENV}"; } _fref "eval" _eval slurp () { local lines mapfile lines < "${ANON["${1}"]}" local text="${lines[*]}"; text=${text//$'\n' /$'\n'} - string "${text}" + _string "${text}" } _fref "slurp" slurp diff --git a/bash/tests/types.sh b/bash/tests/types.sh index 7ce1ce4..0e073c5 100644 --- a/bash/tests/types.sh +++ b/bash/tests/types.sh @@ -39,8 +39,8 @@ assert_eq $LINENO ${__true} "string? ${STR2}" echo "Testing function objects" -assert_eq $LINENO "function" "new_function \"echo hello\"; _obj_type \$r" -new_function "r=\"arg1:'\$1' arg2:'\$2'\""; FN1="${r}" +assert_eq $LINENO "function" "_function \"echo hello\"; _obj_type \$r" +_function "r=\"arg1:'\$1' arg2:'\$2'\""; FN1="${r}" assert_eq $LINENO ${__true} "function? ${FN1}" assert_eq $LINENO "arg1:'A' arg2:'B'" "${ANON["${FN1}"]} A B" @@ -105,7 +105,7 @@ echo "Testing _map/map function" list; conj "${r}" 1 2 3; L5="${r}" inc () { r=$(( ${1} + 1)); } assert_eq $LINENO "2 3 4" "_map inc ${L5}; r=\${ANON[\$r]}" -new_function "r=\$(( \$1 + 1 ));"; inc_func="${r}" +_function "r=\$(( \$1 + 1 ));"; inc_func="${r}" assert_eq $LINENO "2 3 4" "map ${inc_func} ${L5}; r=\${ANON[\$r]}" diff --git a/bash/types.sh b/bash/types.sh index 33278da..8e256be 100644 --- a/bash/types.sh +++ b/bash/types.sh @@ -1,7 +1,10 @@ # -# mal: Object Types and Functions +# mal (Make a Lisp) object types # +if [ -z "${__mal_types_included__}" ]; then +__mal_types_included=true + declare -A ANON __obj_magic=__5bal7 @@ -22,7 +25,16 @@ __new_obj_like () { r="${1%_*}_${r}" } + +# Errors/Exceptions + __ERROR= +_error() { + _string "${1}" + __ERROR="${r}" + r= +} + # @@ -50,162 +62,77 @@ _obj_type () { esac } -obj_type () { - _obj_type "${1}" - string "${r}" -} - -_pr_str () { - local print_readably="${2}" - _obj_type "${1}"; local ot="${r}" - if [[ -z "${ot}" ]]; then - _error "_pr_str failed on '${1}'" - r="<${1}>" - else - eval ${ot}_pr_str "${1}" "${print_readably}" +_equal? () { + _obj_type "${1}"; local ot1="${r}" + _obj_type "${2}"; local ot2="${r}" + if [[ "${ot1}" != "${ot2}" ]]; then + if ! _sequential? "${1}" || ! _sequential? "${2}"; then + return 1 + fi fi + case "${ot1}" in + string|symbol|number) + [[ "${ANON["${1}"]}" == "${ANON["${2}"]}" ]] ;; + list|vector|hash_map) + _count "${1}"; local sz1="${r}" + _count "${2}"; local sz2="${r}" + [[ "${sz1}" == "${sz2}" ]] || return 1 + local a1=(${ANON["${1}"]}) + local a2=(${ANON["${2}"]}) + for ((i=0;i<${#a1[*]};i++)); do + _equal? "${a1[${i}]}" "${a2[${i}]}" || return 1 + done + ;; + *) + [[ "${1}" == "${2}" ]] ;; + esac } -pr_str () { - local res="" - for x in "${@}"; do _pr_str "${x}" yes; res="${res} ${r}"; done - string "${res:1}" -} - -str () { - local res="" - for x in "${@}"; do _pr_str "${x}"; res="${res}${r}"; done - string "${res}" -} - -prn () { - local res="" - for x in "${@}"; do _pr_str "${x}" yes; res="${res} ${r}"; done - echo "${res:1}" - r="${__nil}"; -} - -println () { - local res="" - for x in "${@}"; do _pr_str "${x}"; res="${res} ${r}"; done - res="${res//\\n/$'\n'}" - echo -e "${res:1}" - r="${__nil}"; -} - -with_meta () { - local obj="${1}"; shift - local meta_data="${1}"; shift - __new_obj_like "${obj}" - ANON["${r}"]="${ANON["${obj}"]}" - local meta_obj="meta_${r#*_}" - ANON["${meta_obj}"]="${meta_data}" -} - -meta () { - r="${ANON["meta_${1#*_}"]}" - [[ "${r}" ]] || r="${__nil}" -} - -# # Constant atomic values -# -__undefined=undf_0 __nil=_nil_0 __true=true_0 __false=fals_0 -_undefined? () { [[ ${1} =~ ^undf_ ]]; } -undefined? () { _undefined? "${1}" && r="${__true}" || r="${__false}"; } - _nil? () { [[ ${1} =~ ^_nil_ ]]; } -nil? () { _nil? "${1}" && r="${__true}" || r="${__false}"; } -nil_pr_str () { r="nil"; } - _true? () { [[ ${1} =~ ^true_ ]]; } -true? () { _true? "${1}" && r="${__true}" || r="${__false}"; } -true_pr_str () { r="true"; } - _false? () { [[ ${1} =~ ^fals_ ]]; } -false? () { _false? "${1}" && r="${__true}" || r="${__false}"; } -false_pr_str () { r="false"; } - - -# -# Numbers -# -number () { - __new_obj_hash_code - r="numb_${r}" - ANON["${r}"]="${1}" -} -_number? () { [[ ${1} =~ ^numb_ ]]; } -number? () { _number? "${1}" && r="${__true}" || r="${__false}"; } -number_pr_str () { r="${ANON["${1}"]}"; } - -num_plus () { r=$(( ${ANON["${1}"]} + ${ANON["${2}"]} )); number "${r}"; } -num_minus () { r=$(( ${ANON["${1}"]} - ${ANON["${2}"]} )); number "${r}"; } -num_multiply () { r=$(( ${ANON["${1}"]} * ${ANON["${2}"]} )); number "${r}"; } -num_divide () { r=$(( ${ANON["${1}"]} / ${ANON["${2}"]} )); number "${r}"; } -_num_bool () { [[ "${1}" = "1" ]] && r="${__true}" || r="${__false}"; } -num_gt () { r=$(( ${ANON["${1}"]} > ${ANON["${2}"]} )); _num_bool "${r}"; } -num_gte () { r=$(( ${ANON["${1}"]} >= ${ANON["${2}"]} )); _num_bool "${r}"; } -num_lt () { r=$(( ${ANON["${1}"]} < ${ANON["${2}"]} )); _num_bool "${r}"; } -num_lte () { r=$(( ${ANON["${1}"]} <= ${ANON["${2}"]} )); _num_bool "${r}"; } - -# # Symbols -# -symbol () { +_symbol () { __new_obj_hash_code r="symb_${r}" ANON["${r}"]="${1//$'\*'/__STAR__}" } _symbol? () { [[ ${1} =~ ^symb_ ]]; } -symbol? () { _symbol? "${1}" && r="${__true}" || r="${__false}"; } -symbol_pr_str () { - r="${ANON["${1}"]}" - r="${r//__STAR__/*}" + + +# Numbers + +_number () { + __new_obj_hash_code + r="numb_${r}" + ANON["${r}"]="${1}" } +_number? () { [[ ${1} =~ ^numb_ ]]; } -# # Strings -# -string () { +_string () { __new_obj_hash_code r="strn_${r}" ANON["${r}"]="${1//$'\*'/__STAR__}" } _string? () { [[ ${1} =~ ^strn_ ]]; } -string? () { _string? "${1}" && r="${__true}" || r="${__false}"; } -string_pr_str () { - local print_readably="${2}" - if [ "${print_readably}" == "yes" ]; then - local s="${ANON["${1}"]}" - s="${s//\\/\\\\}" - r="\"${s//\"/\\\"}\"" - else - r="${ANON["${1}"]}" - fi - r="${r//__STAR__/$'*'}" -} - -# TODO: subs -# -# Function objects -# - +# Functions # Return a function object. The first parameter is the # function 'source'. -new_function () { +_function () { __new_obj_hash_code eval "function ${__obj_magic}_func_${r} () { ${1%;} ; }" r="func_${r}" @@ -218,15 +145,31 @@ new_function () { fi } _function? () { [[ ${1} =~ ^func_ ]]; } -function? () { _function? "${1}" && r="${__true}" || r="${__false}"; } -function_pr_str () { r="${ANON["${1}"]}"; } -# +# Lists + +_list () { + __new_obj_hash_code + r="list_${r}" + ANON["${r}"]="${*}" +} +_list? () { [[ ${1} =~ ^list_ ]]; } + + +# Vectors + +_vector () { + __new_obj_hash_code + r="vector_${r}" + ANON["${r}"]="${*}" +} +_vector? () { [[ ${1} =~ ^vector_ ]]; } + + # hash maps (associative arrays) -# -hash_map () { +_hash_map () { __new_obj_hash_code local name="hmap_${r}" local obj="${__obj_magic}_${name}" @@ -241,26 +184,10 @@ hash_map () { r="${name}" } _hash_map? () { [[ ${1} =~ ^hmap_ ]]; } -hash_map? () { _hash_map? "${1}" && r="${__true}" || r="${__false}"; } - -hash_map_pr_str () { - local print_readably="${2}" - local res=""; local val="" - local hm="${ANON["${1}"]}" - eval local keys="\${!${hm}[@]}" - for key in ${keys}; do - #res="${res} \"${ANON["${key}"]}\"" - res="${res} \"${key//__STAR__/$'*'}\"" - eval val="\${${hm}[\"${key}\"]}" - _pr_str "${val}" "${print_readably}" - res="${res} ${r}" - done - r="{${res:1}}" -} _copy_hash_map () { local orig_obj="${ANON["${1}"]}" - hash_map + _hash_map local name="${r}" local obj="${ANON["${name}"]}" @@ -271,7 +198,7 @@ _copy_hash_map () { } # Return same hash map with keys/values added/mutated in place -assoc! () { +_assoc! () { local obj=${ANON["${1}"]}; shift declare -A -g ${obj} @@ -283,7 +210,7 @@ assoc! () { } # Return same hash map with keys/values deleted/mutated in place -dissoc! () { +_dissoc! () { local obj=${ANON["${1}"]}; shift declare -A -g ${obj} @@ -294,241 +221,32 @@ dissoc! () { done } -# Return new hash map with keys/values updated -assoc () { - if ! _hash_map? "${1}"; then - _error "assoc onto non-hash-map" - return - fi - _copy_hash_map "${1}"; shift - local name="${r}" - local obj=${ANON["${name}"]} - declare -A -g ${obj} - - while [[ "${1}" ]]; do - eval ${obj}[\"${ANON["${1}"]}\"]=\"${2}\" - shift; shift - done - r="${name}" -} - -dissoc () { - if ! _hash_map? "${1}"; then - _error "dissoc from non-hash-map" - return - fi - _copy_hash_map "${1}"; shift - local name="${r}" - local obj=${ANON["${name}"]} - declare -A -g ${obj} - - while [[ "${1}" ]]; do - eval unset ${obj}[\"${ANON["${1}"]}\"] - shift - done - r="${name}" -} - -_get () { - _obj_type "${1}"; local ot="${r}" - case "${ot}" in - hash_map) - local obj="${ANON["${1}"]}" - eval r="\${${obj}[\"${2}\"]}" ;; - list|vector) - _nth "${1}" "${2}" - esac -} -get () { - _get "${1}" "${ANON["${2}"]}" - [[ "${r}" ]] || r="${__nil}" -} - -_contains? () { - local obj="${ANON["${1}"]}" - #echo "_contains? ${1} ${2} -> \${${obj}[\"${2}\"]+isset}" - eval [[ "\${${obj}[\"${2}\"]+isset}" ]] -} -contains? () { _contains? "${1}" "${ANON["${2}"]}" && r="${__true}" || r="${__false}"; } - -keys () { - local obj="${ANON["${1}"]}" - local kstrs= - eval local keys="\${!${obj}[@]}" - for k in ${keys}; do - string "${k}" - kstrs="${kstrs} ${r}" - done - - __new_obj_hash_code - r="list_${r}" - ANON["${r}"]="${kstrs:1}" -} - -vals () { - local obj="${ANON["${1}"]}" - local kvals= - local val= - eval local keys="\${!${obj}[@]}" - for k in ${keys}; do - eval val="\${${obj}["\${k}"]}" - kvals="${kvals} ${val}" - done - __new_obj_hash_code - r="list_${r}" - ANON["${r}"]="${kvals:1}" -} +# Atoms -# -# Exceptions/Errors -# - -_error() { - string "${1}" - __ERROR="${r}" - r= -} -throw() { - __ERROR="${1}" - r= -} - -# -# vectors -# - -# -# vector (same as lists for now) -# - -vector () { - __new_obj_hash_code - r="vector_${r}" - ANON["${r}"]="${*}" -} -_vector? () { [[ ${1} =~ ^vector_ ]]; } -vector? () { _vector? "${1}" && r="${__true}" || r="${__false}"; } - -vector_pr_str () { - local print_readably="${2}" - local res="" - for elem in ${ANON["${1}"]}; do - _pr_str "${elem}" "${print_readably}" - res="${res} ${r}" - done - r="[${res:1}]" -} - - -# -# list (same as vectors for now) -# - -list () { - __new_obj_hash_code - r="list_${r}" - ANON["${r}"]="${*}" -} -_list? () { [[ ${1} =~ ^list_ ]]; } -list? () { _list? "${1}" && r="${__true}" || r="${__false}"; } - -list_pr_str () { - local print_readably="${2}" - local res="" - for elem in ${ANON["${1}"]}; do - _pr_str "${elem}" "${print_readably}" - res="${res} ${r}" - done - r="(${res:1})" -} - -cons () { - list ${1} ${ANON["${2}"]} -} - - -# -# atoms -# -atom() { +_atom() { __new_obj_hash_code r="atom_${r}" ANON["${r}"]="${*}" } _atom? () { [[ ${1} =~ ^atom_ ]]; } -atom? () { _atom? "${1}" && r="${__true}" || r="${__false}"; } -atom_pr_str () { - local print_readably="${2}" - _pr_str "${ANON["${1}"]}" "${print_readably}" - r="(atom ${r})"; -} -deref () { - # TODO: double-check atom type - r=${ANON["${1}"]} -} -reset_BANG () { - local atm="${1}"; shift - ANON["${atm}"]="${*}" - r="${*}" -} -swap_BANG () { - local atm="${1}"; shift - local f="${ANON["${1}"]}"; shift - ${f%%@*} "${ANON["${atm}"]}" "${@}" - ANON["${atm}"]="${r}" -} -# # sequence operations -# _sequential? () { _list? "${1}" || _vector? "${1}" } -sequential? () { - _sequential? "${1}" && r="${__true}" || r="${__false}" -} _nth () { local temp=(${ANON["${1}"]}) r=${temp[${2}]} } -nth () { - _nth "${1}" "${ANON["${2}"]}" -} - _empty? () { [[ -z "${ANON["${1}"]}" ]]; } -empty? () { _empty? "${1}" && r="${__true}" || r="${__false}"; } - -concat () { - list - local acc="" - for item in "${@}"; do - acc="${acc} ${ANON["${item}"]}" - done - ANON["${r}"]="${acc:1}" -} - -conj () { - local obj="${1}"; shift - local obj_data="${ANON["${obj}"]}" - __new_obj_like "${obj}" - if _list? "${obj}"; then - ANON["${r}"]="${obj_data:+${obj_data}}" - for elem in ${@}; do - ANON["${r}"]="${elem} ${ANON["${r}"]}" - done - - else - ANON["${r}"]="${obj_data:+${obj_data} }${*}" - fi -} # conj that mutates in place (and always appends) -conj! () { +_conj! () { local obj="${1}"; shift local obj_data="${ANON["${obj}"]}" ANON["${obj}"]="${obj_data:+${obj_data} }${*}" @@ -541,21 +259,6 @@ _count () { local temp=(${ANON["${1}"]}) r=${#temp[*]} } -count () { - _count "${1}" - number "${r}" -} - -first () { - local temp="${ANON["${1}"]}" - r="${temp%% *}" - [ "${r}" ] || r="${__nil}" -} - -last () { - local temp="${ANON["${1}"]}" - r="${temp##* }" -} # Slice a sequence object $1 starting at $2 of length $3 _slice () { @@ -564,175 +267,24 @@ _slice () { ANON["${r}"]="${temp[@]:${2}:${3}}" } -# Creates a new vector/list of the everything after but the first -# element -rest () { - local temp="${ANON["${1}"]}" - __new_obj list - if [[ "${temp#* }" == "${temp}" ]]; then - ANON["${r}"]= - else - ANON["${r}"]="${temp#* }" - fi -} - -apply () { - local f="${ANON["${1}"]}"; shift - local items="${@:1:$(( ${#@} -1 ))} ${ANON["${!#}"]}" - eval ${f%%@*} ${items} -} - # Takes a bash function and an list object and invokes the function on # each element of the list, returning a new list (or vector) of the results. _map_with_type () { - local ot="${1}"; shift + local constructor="${1}"; shift local f="${1}"; shift local items="${ANON["${1}"]}"; shift - eval "${ot}"; local new_seq="${r}" + eval "${constructor}"; local new_seq="${r}" for v in ${items}; do #echo eval ${f%%@*} "${v}" "${@}" eval ${f%%@*} "${v}" "${@}" [[ "${__ERROR}" ]] && r= && return 1 - conj! "${new_seq}" "${r}" + _conj! "${new_seq}" "${r}" done r="${new_seq}" } _map () { - _map_with_type list "${@}" -} - -# Takes a function object and an list object and invokes the function -# on each element of the list, returning a new list of the results. -map () { - local f="${ANON["${1}"]}"; shift - #echo _map "${f}" "${@}" - _map "${f}" "${@}" -} - -_equal? () { - _obj_type "${1}"; local ot1="${r}" - _obj_type "${2}"; local ot2="${r}" - if [[ "${ot1}" != "${ot2}" ]]; then - if ! _sequential? "${1}" || ! _sequential? "${2}"; then - return 1 - fi - fi - case "${ot1}" in - string|symbol|number) - [[ "${ANON["${1}"]}" == "${ANON["${2}"]}" ]] ;; - list|vector|hash_map) - _count "${1}"; local sz1="${r}" - _count "${2}"; local sz2="${r}" - [[ "${sz1}" == "${sz2}" ]] || return 1 - local a1=(${ANON["${1}"]}) - local a2=(${ANON["${2}"]}) - for ((i=0;i<${#a1[*]};i++)); do - _equal? "${a1[${i}]}" "${a2[${i}]}" || return 1 - done - ;; - *) - [[ "${1}" == "${2}" ]] ;; - esac -} -equal? () { - _equal? "${1}" "${2}" && r="${__true}" || r="${__false}" -} - -# -# ENV -# - -# Any environment is a hash_map with an __outer__ key that refers to -# a parent environment (or nil) -ENV () { - r= - hash_map - local env="${r}" - if [[ "${1}" ]]; then - outer="${1}"; shift - assoc! "${env}" "__outer__" "${outer}" - else - assoc! "${env}" "__outer__" "${__nil}" - fi - r="${env}" - - if [[ "${1}" && "${@}" ]]; then - local binds=(${ANON["${1}"]}); shift - local idx=0 - while [[ "${binds["${idx}"]}" ]]; do - local fp="${ANON["${binds["${idx}"]}"]}" - if [[ "${fp}" == "&" ]]; then - idx=$(( idx + 1 )) - fp="${ANON["${binds["${idx}"]}"]}" - list "${@}" - assoc! "${env}" "${fp}" "${r}" - break - else - assoc! "${env}" "${fp}" "${1}" - shift - idx=$(( idx + 1 )) - fi - done - fi - r="${env}" -} - -# Find the environment with the key set and return the environment -ENV_FIND () { - if _contains? "${1}" "${2}"; then - r="${1}" - else - local obj="${ANON["${1}"]}" - eval local outer="\${${obj}["__outer__"]}" - if [[ "${outer}" && "${outer}" != "${__nil}" ]]; then - ENV_FIND "${outer}" "${2}" - else - r= - fi - fi -} - -# Find the environment with the key set and return the value of the -# key in that environment. If no environment contains the key then -# return an error -ENV_GET () { - ENV_FIND "${1}" "${2}" - local env="${r}" - if [[ "${r}" ]]; then - local obj="${ANON["${env}"]}" - eval r="\${${obj}["${2}"]}" - else - _error "'${2}' not found" - fi -} - -ENV_SET () { - assoc! "${1}" "${2}" "${3}" + _map_with_type _list "${@}" } -# TODO: memory visualizer (like Make implementation) - -# Namespace of type functions - -declare -A types_ns=( - [type]=obj_type - [pr-str]=pr_str [str]=str [prn]=prn [println]=println - [with-meta]=with_meta [meta]=meta - [=]=equal? - [nil?]=nil? [true?]=true? [false?]=false? - [symbol?]=symbol? - [>]=num_gt [>=]=num_gte [<]=num_lt [<=]=num_lte - [+]=num_plus [-]=num_minus [__STAR__]=num_multiply [/]=num_divide - [hash-map]=hash_map [map?]=hash_map? - [assoc]=assoc [dissoc]=dissoc [get]=get - [contains?]=contains? [keys]=keys [vals]=vals - [throw]=throw - [list]=list [list?]=list? - [vector]=vector [vector?]=vector? - [atom]=atom [atom?]=atom? [deref]=deref - [reset!]=reset_BANG [swap!]=swap_BANG - [sequential?]=sequential? - [cons]=cons [nth]=nth [count]=count [empty?]=empty? - [concat]=concat [conj]=conj [first]=first [rest]=rest - [apply]=apply [map]=map) +fi @@ -6,8 +6,10 @@ LDFLAGS += -g TESTS = -SOURCES = types.h types.c readline.h readline.c reader.h reader.c \ - interop.h interop.c stepA_more.c +SOURCES = readline.h readline.c types.h types.c \ + reader.h reader.c printer.h printer.c \ + env.c core.h core.c interop.h interop.c \ + stepA_more.c ##################### @@ -16,8 +18,8 @@ SRCS = step0_repl.c step1_read_print.c step2_eval.c step3_env.c \ step8_macros.c step9_interop.c stepA_more.c OBJS = $(SRCS:%.c=%.o) BINS = $(OBJS:%.o=%) -OTHER_OBJS = types.o readline.o reader.o interop.o -OTHER_HDRS = types.h readline.h reader.h interop.h +OTHER_OBJS = types.o readline.o reader.o printer.o env.o core.o interop.o +OTHER_HDRS = types.h readline.h reader.h printer.h core.h interop.h GLIB_CFLAGS ?= $(shell pkg-config --cflags glib-2.0) GLIB_LDFLAGS ?= $(shell pkg-config --libs glib-2.0) diff --git a/c/core.c b/c/core.c new file mode 100644 index 0000000..abdf755 --- /dev/null +++ b/c/core.c @@ -0,0 +1,464 @@ +#include <stdarg.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#include "types.h" +#include "core.h" +#include "printer.h" + +// Errors/Exceptions +void throw(MalVal *obj) { + mal_error = obj; +} + + +// General functions + +MalVal *equal_Q(MalVal *a, MalVal *b) { + if (_equal_Q(a, b)) { return &mal_true; } + else { return &mal_false; } +} + + +// Scalar functions + +MalVal *nil_Q(MalVal *seq) { return seq->type & MAL_NIL ? &mal_true : &mal_false; } +MalVal *true_Q(MalVal *seq) { return seq->type & MAL_TRUE ? &mal_true : &mal_false; } +MalVal *false_Q(MalVal *seq) { return seq->type & MAL_FALSE ? &mal_true : &mal_false; } + + +// Symbol functions + +MalVal *symbol(MalVal *args) { + assert_type(args, MAL_STRING, + "symbol called with non-string value"); + args->type = MAL_SYMBOL; // change string to symbol + return args; +} + +MalVal *symbol_Q(MalVal *seq) { return seq->type & MAL_SYMBOL ? &mal_true : &mal_false; } + + +// String functions + +// Return a string representation of a MalVal sequence (in a format that can +// be read by the reader). Returned string must be freed by caller. +MalVal *pr_str(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "pr_str called with non-sequential args"); + return malval_new_string(_pr_str_args(args, " ", 1)); +} + +// Return a string representation of a MalVal sequence with every item +// concatenated together. Returned string must be freed by caller. +MalVal *str(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "str called with non-sequential args"); + return malval_new_string(_pr_str_args(args, "", 0)); +} + +// Print a string representation of a MalVal sequence (in a format that can +// be read by the reader) followed by a newline. Returns nil. +MalVal *prn(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "prn called with non-sequential args"); + char *repr = _pr_str_args(args, " ", 1); + g_print("%s\n", repr); + free(repr); + return &mal_nil; +} + +// Print a string representation of a MalVal sequence (for human consumption) +// followed by a newline. Returns nil. +MalVal *println(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "println called with non-sequential args"); + char *repr = _pr_str_args(args, " ", 0); + g_print("%s\n", repr); + free(repr); + return &mal_nil; +} + + +// Number functions + +#define WRAP_INTEGER_OP(name, op) \ + MalVal *int_ ## name(MalVal *a, MalVal *b) { \ + return malval_new_integer(a->val.intnum op b->val.intnum); \ + } +#define WRAP_INTEGER_CMP_OP(name, op) \ + MalVal *int_ ## name(MalVal *a, MalVal *b) { \ + return a->val.intnum op b->val.intnum ? &mal_true : &mal_false; \ + } +WRAP_INTEGER_OP(plus,+) +WRAP_INTEGER_OP(minus,-) +WRAP_INTEGER_OP(multiply,*) +WRAP_INTEGER_OP(divide,/) +WRAP_INTEGER_CMP_OP(gt,>) +WRAP_INTEGER_CMP_OP(gte,>=) +WRAP_INTEGER_CMP_OP(lt,<) +WRAP_INTEGER_CMP_OP(lte,<=) + + +// List functions + +MalVal *list(MalVal *args) { return _list(args); } +MalVal *list_Q(MalVal *seq) { return _list_Q(seq) ? &mal_true : &mal_false; } + + +// Vector functions + +MalVal *vector(MalVal *args) { return _vector(args); } +MalVal *vector_Q(MalVal *seq) { return _vector_Q(seq) ? &mal_true : &mal_false; } + + +// Hash map functions + +MalVal *hash_map(MalVal *args) { return _hash_map(args); } +MalVal *hash_map_Q(MalVal *seq) { return _hash_map_Q(seq) ? &mal_true : &mal_false; } + +MalVal *assoc(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "assoc called with non-sequential arguments"); + assert(_count(args) >= 2, + "assoc needs at least 2 arguments"); + GHashTable *htable = g_hash_table_copy(first(args)->val.hash_table); + MalVal *hm = malval_new_hash_map(htable); + return _assoc_BANG(hm, rest(args)); +} + +MalVal *dissoc(MalVal* args) { + GHashTable *htable = g_hash_table_copy(first(args)->val.hash_table); + MalVal *hm = malval_new_hash_map(htable); + return _dissoc_BANG(hm, rest(args)); +} + +MalVal *keys(MalVal *obj) { + assert_type(obj, MAL_HASH_MAP, + "keys called on non-hash-map"); + + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(obj))); + g_hash_table_iter_init (&iter, obj->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + MalVal *kname = malval_new_string((char *)key); + g_array_append_val(seq->val.array, kname); + } + return seq; +} + +MalVal *vals(MalVal *obj) { + assert_type(obj, MAL_HASH_MAP, + "vals called on non-hash-map"); + + GHashTableIter iter; + gpointer key, value; + MalVal *seq = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + _count(obj))); + g_hash_table_iter_init (&iter, obj->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + g_array_append_val(seq->val.array, value); + } + return seq; +} + + +// hash map and vector functions +MalVal *get(MalVal *obj, MalVal *key) { + MalVal *val; + switch (obj->type) { + case MAL_VECTOR: + return _nth(obj, key->val.intnum); + case MAL_HASH_MAP: + if (g_hash_table_lookup_extended(obj->val.hash_table, + key->val.string, + NULL, (gpointer*)&val)) { + return val; + } else { + return &mal_nil; + } + default: + abort("get called on unsupported type %d", obj->type); + } +} + +MalVal *contains_Q(MalVal *obj, MalVal *key) { + switch (obj->type) { + case MAL_VECTOR: + if (key->val.intnum < obj->val.array->len) { + return &mal_true; + } else { + return &mal_false; + } + case MAL_HASH_MAP: + if (g_hash_table_contains(obj->val.hash_table, key->val.string)) { + return &mal_true; + } else { + return &mal_false; + } + default: + abort("contains? called on unsupported type %d", obj->type); + } +} + + +// Sequence functions + +MalVal *sequential_Q(MalVal *seq) { + return _sequential_Q(seq) ? &mal_true : &mal_false; +} + +MalVal *cons(MalVal *x, MalVal *seq) { + assert_type(seq, MAL_LIST|MAL_VECTOR, + "second argument to cons is non-sequential"); + int i, len = _count(seq); + GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + len+1); + g_array_append_val(new_arr, x); + for (i=0; i<len; i++) { + g_array_append_val(new_arr, g_array_index(seq->val.array, MalVal*, i)); + } + return malval_new_list(MAL_LIST, new_arr); +} + +MalVal *concat(MalVal *args) { + MalVal *arg, *e, *lst; + int i, j, arg_cnt = _count(args); + lst = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), arg_cnt)); + for (i=0; i<arg_cnt; i++) { + arg = g_array_index(args->val.array, MalVal*, i); + assert_type(arg, MAL_LIST|MAL_VECTOR, + "concat called with non-sequential"); + for (j=0; j<_count(arg); j++) { + e = g_array_index(arg->val.array, MalVal*, j); + g_array_append_val(lst->val.array, e); + } + } + return lst; +} + +MalVal *nth(MalVal *seq, MalVal *idx) { + return _nth(seq, idx->val.intnum); +} + +MalVal *first(MalVal *seq) { + assert_type(seq, MAL_LIST|MAL_VECTOR, + "first called with non-sequential"); + if (_count(seq) == 0) { + return &mal_nil; + } + return g_array_index(seq->val.array, MalVal*, 0); +} + +MalVal *rest(MalVal *seq) { + return _slice(seq, 1, _count(seq)); +} + +MalVal *empty_Q(MalVal *seq) { + assert_type(seq, MAL_LIST|MAL_VECTOR, + "empty? called with non-sequential"); + return (seq->val.array->len == 0) ? &mal_true : &mal_false; +} + +MalVal *count(MalVal *seq) { + return malval_new_integer(_count(seq)); +} + +MalVal *sconj(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "conj called with non-sequential"); + MalVal *src_lst = _nth(args, 0); + assert_type(args, MAL_LIST|MAL_VECTOR, + "first argument to conj is non-sequential"); + int i, len = _count(src_lst) + _count(args) - 1; + GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + len); + // Copy in src_lst + for (i=0; i<_count(src_lst); i++) { + g_array_append_val(new_arr, g_array_index(src_lst->val.array, MalVal*, i)); + } + // Conj extra args + for (i=1; i<_count(args); i++) { + if (src_lst->type & MAL_LIST) { + g_array_prepend_val(new_arr, g_array_index(args->val.array, MalVal*, i)); + } else { + g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i)); + } + } + return malval_new_list(src_lst->type, new_arr); +} + +MalVal *last(MalVal *seq) { + assert_type(seq, MAL_LIST|MAL_VECTOR, + "last called with non-sequential"); + if (_count(seq) == 0) { + return &mal_nil; + } + return g_array_index(seq->val.array, MalVal*, _count(seq)-1); +} + +MalVal *apply(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "apply called with non-sequential"); + MalVal *f = _nth(args, 0); + MalVal *last_arg = last(args); + assert_type(last_arg, MAL_LIST|MAL_VECTOR, + "last argument to apply is non-sequential"); + int i, len = _count(args) - 2 + _count(last_arg); + GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), + len); + // Initial arguments + for (i=1; i<_count(args)-1; i++) { + g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i)); + } + // Add arguments from last_arg + for (i=0; i<_count(last_arg); i++) { + g_array_append_val(new_arr, g_array_index(last_arg->val.array, MalVal*, i)); + } + return _apply(f, malval_new_list(MAL_LIST, new_arr)); +} + +MalVal *map(MalVal *mvf, MalVal *lst) { + MalVal *res, *el; + assert_type(mvf, MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "map called with non-function"); + assert_type(lst, MAL_LIST|MAL_VECTOR, + "map called with non-sequential"); + int i, len = _count(lst); + el = malval_new_list(MAL_LIST, + g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len)); + for (i=0; i<len; i++) { + // TODO: this is replicating some of apply functionality + if (mvf->type & MAL_FUNCTION_MAL) { + Env *fn_env = new_env(mvf->val.func.env, + mvf->val.func.args, + _slice(lst, i, i+1)); + res = mvf->val.func.evaluator(mvf->val.func.body, fn_env); + } else { + res = mvf->val.f1(g_array_index(lst->val.array, MalVal*, i)); + } + if (!res || mal_error) return NULL; + g_array_append_val(el->val.array, res); + } + return el; +} + + +// Metadata functions + +MalVal *with_meta(MalVal *obj, MalVal *meta) { + MalVal *new_obj = malval_new(obj->type, meta); + new_obj->val = obj->val; + return new_obj; +} + +MalVal *meta(MalVal *obj) { + assert_type(obj, MAL_LIST|MAL_VECTOR|MAL_HASH_MAP|MAL_FUNCTION_C|MAL_FUNCTION_MAL, + "attempt to get metadata from non-collection type"); + if (obj->metadata == NULL) { + return &mal_nil; + } else { + return obj->metadata; + } +} + + +// Atoms + +MalVal *atom(MalVal *val) { + return malval_new_atom(val); +} + +MalVal *atom_Q(MalVal *exp) { return _atom_Q(exp) ? &mal_true : &mal_false; } + +MalVal *deref(MalVal *atm) { + assert_type(atm, MAL_ATOM, + "deref called on non-atom"); + return atm->val.atom_val; +} + +MalVal *reset_BANG(MalVal *atm, MalVal *val) { + assert_type(atm, MAL_ATOM, + "reset! called with non-atom"); + atm->val.atom_val = val; + return val; +} + +MalVal *swap_BANG(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "swap! called with invalid arguments"); + assert(_count(args) >= 2, + "swap! called with %d args, needs at least 2", _count(args)); + MalVal *atm = _nth(args, 0), + *f = _nth(args, 1), + *sargs = _slice(args, 2, _count(args)), + *fargs = cons(atm->val.atom_val, sargs), + *new_val = _apply(f, fargs); + if (mal_error) { return NULL; } + atm->val.atom_val = new_val; + return new_val; +} + + + +core_ns_entry core_ns[50] = { + {"=", (void*(*)(void*))equal_Q, 2}, + {"throw", (void*(*)(void*))throw, 1}, + {"nil?", (void*(*)(void*))nil_Q, 1}, + {"true?", (void*(*)(void*))true_Q, 1}, + {"false?", (void*(*)(void*))false_Q, 1}, + {"symbol", (void*(*)(void*))symbol, 1}, + {"symbol?", (void*(*)(void*))symbol_Q, 1}, + {"pr-str", (void*(*)(void*))pr_str, -1}, + {"str", (void*(*)(void*))str, -1}, + {"prn", (void*(*)(void*))prn, -1}, + {"println", (void*(*)(void*))println, -1}, + {"<", (void*(*)(void*))int_lt, 2}, + {"<=", (void*(*)(void*))int_lte, 2}, + {">", (void*(*)(void*))int_gt, 2}, + {">=", (void*(*)(void*))int_gte, 2}, + {"+", (void*(*)(void*))int_plus, 2}, + {"-", (void*(*)(void*))int_minus, 2}, + {"*", (void*(*)(void*))int_multiply, 2}, + {"/", (void*(*)(void*))int_divide, 2}, + + {"list", (void*(*)(void*))list, -1}, + {"list?", (void*(*)(void*))list_Q, 1}, + {"vector", (void*(*)(void*))vector, -1}, + {"vector?", (void*(*)(void*))vector_Q, 1}, + {"hash-map", (void*(*)(void*))hash_map, -1}, + {"map?", (void*(*)(void*))hash_map_Q, 1}, + {"assoc", (void*(*)(void*))assoc, -1}, + {"dissoc", (void*(*)(void*))dissoc, -1}, + {"get", (void*(*)(void*))get, 2}, + {"contains?", (void*(*)(void*))contains_Q, 2}, + {"keys", (void*(*)(void*))keys, 1}, + {"vals", (void*(*)(void*))vals, 1}, + + {"sequential?", (void*(*)(void*))sequential_Q, 1}, + {"cons", (void*(*)(void*))cons, 2}, + {"concat", (void*(*)(void*))concat, -1}, + {"nth", (void*(*)(void*))nth, 2}, + {"first", (void*(*)(void*))first, 1}, + {"rest", (void*(*)(void*))rest, 1}, + {"last", (void*(*)(void*))last, 1}, + {"empty?", (void*(*)(void*))empty_Q, 1}, + {"count", (void*(*)(void*))count, 1}, + {"conj", (void*(*)(void*))sconj, -1}, + {"apply", (void*(*)(void*))apply, -1}, + {"map", (void*(*)(void*))map, 2}, + + {"with-meta", (void*(*)(void*))with_meta, 2}, + {"meta", (void*(*)(void*))meta, 1}, + {"atom", (void*(*)(void*))atom, 1}, + {"atom?", (void*(*)(void*))atom_Q, 1}, + {"deref", (void*(*)(void*))deref, 1}, + {"reset!", (void*(*)(void*))reset_BANG, 2}, + {"swap!", (void*(*)(void*))swap_BANG, -1}, + }; diff --git a/c/core.h b/c/core.h new file mode 100644 index 0000000..6668c53 --- /dev/null +++ b/c/core.h @@ -0,0 +1,29 @@ +#ifndef __MAL_CORE__ +#define __MAL_CORE__ + +#include <glib.h> + +// These are just used by step2 and step3 before then core_ns environment is +// imported + +MalVal *int_plus(MalVal *a, MalVal *b); +MalVal *int_minus(MalVal *a, MalVal *b); +MalVal *int_multiply(MalVal *a, MalVal *b); +MalVal *int_divide(MalVal *a, MalVal *b); + +// Useful for step implementation +MalVal *first(MalVal *seq); +MalVal *rest(MalVal *seq); +MalVal *last(MalVal *seq); +MalVal *hash_map(MalVal *args); + +// namespace of type functions +typedef struct { + char *name; + void *(*func)(void*); + int arg_cnt; +} core_ns_entry; + +extern core_ns_entry core_ns[50]; + +#endif @@ -0,0 +1,62 @@ +/* +#include <stdarg.h> +#include <stdio.h> +#include <string.h> +*/ +#include <stdlib.h> +#include "types.h" + +// Env + +Env *new_env(Env *outer, MalVal* binds, MalVal *exprs) { + Env *e = malloc(sizeof(Env)); + e->table = g_hash_table_new(g_str_hash, g_str_equal); + e->outer = outer; + + if (binds && exprs) { + assert_type(binds, MAL_LIST|MAL_VECTOR, + "new_env called with non-sequential bindings"); + assert_type(exprs, MAL_LIST|MAL_VECTOR, + "new_env called with non-sequential expressions"); + int binds_len = _count(binds), + exprs_len = _count(exprs), + varargs = 0, i; + for (i=0; i<binds_len; i++) { + if (i > exprs_len) { break; } + if (_nth(binds, i)->val.string[0] == '&') { + varargs = 1; + env_set(e, _nth(binds, i+1)->val.string, _slice(exprs, i, _count(exprs))); + break; + } else { + env_set(e, _nth(binds, i)->val.string, _nth(exprs, i)); + } + } + assert(varargs || (binds_len == exprs_len), + "Arity mismatch: %d formal params vs %d actual params", + binds_len, exprs_len); + + } + return e; +} + +Env *env_find(Env *env, char *key) { + void *val = g_hash_table_lookup(env->table, key); + if (val) { + return env; + } else if (env->outer) { + return env_find(env->outer, key); + } else { + return NULL; + } +} + +MalVal *env_get(Env *env, char *key) { + Env *e = env_find(env, key); + assert(e, "'%s' not found", key); + return g_hash_table_lookup(e->table, key); +} + +Env *env_set(Env *env, char *key, MalVal *val) { + g_hash_table_insert(env->table, key, val); + return env; +} diff --git a/c/printer.c b/c/printer.c new file mode 100644 index 0000000..0669cf6 --- /dev/null +++ b/c/printer.c @@ -0,0 +1,140 @@ +#include <stdlib.h> +#include <stdio.h> +#include "types.h" +#include "printer.h" + +char *_pr_str_hash_map(MalVal *obj, int print_readably) { + int start = 1; + char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL; + GHashTableIter iter; + gpointer key, value; + + repr = g_strdup_printf("{"); + + g_hash_table_iter_init (&iter, obj->val.hash_table); + while (g_hash_table_iter_next (&iter, &key, &value)) { + //g_print ("%s/%p ", (const char *) key, (void *) value); + + repr_tmp1 = _pr_str((MalVal*)value, print_readably); + if (start) { + start = 0; + repr = g_strdup_printf("{\"%s\" %s", (char *)key, repr_tmp1); + } else { + repr_tmp2 = repr; + repr = g_strdup_printf("%s \"%s\" %s", repr_tmp2, (char *)key, repr_tmp1); + free(repr_tmp2); + } + free(repr_tmp1); + } + repr_tmp2 = repr; + repr = g_strdup_printf("%s}", repr_tmp2); + free(repr_tmp2); + return repr; +} + +char *_pr_str_list(MalVal *obj, int print_readably, char start, char end) { + int i; + char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL; + repr = g_strdup_printf("%c", start); + for (i=0; i<_count(obj); i++) { + repr_tmp1 = _pr_str(g_array_index(obj->val.array, MalVal*, i), + print_readably); + if (i == 0) { + repr = g_strdup_printf("%c%s", start, repr_tmp1); + } else { + repr_tmp2 = repr; + repr = g_strdup_printf("%s %s", repr_tmp2, repr_tmp1); + free(repr_tmp2); + } + free(repr_tmp1); + } + repr_tmp2 = repr; + repr = g_strdup_printf("%s%c", repr_tmp2, end); + free(repr_tmp2); + return repr; +} + +// Return a string representation of the MalVal object. Returned string must +// be freed by caller. +char *_pr_str(MalVal *obj, int print_readably) { + char *repr = NULL; + if (obj == NULL) { return NULL; } + switch (obj->type) { + case MAL_NIL: + repr = g_strdup_printf("nil"); + break; + case MAL_TRUE: + repr = g_strdup_printf("true"); + break; + case MAL_FALSE: + repr = g_strdup_printf("false"); + break; + case MAL_STRING: + if (print_readably) { + char *repr_tmp = g_strescape(obj->val.string, ""); + repr = g_strdup_printf("\"%s\"", repr_tmp); + free(repr_tmp); + } else { + repr = g_strdup_printf("%s", obj->val.string); + } + break; + case MAL_SYMBOL: + repr = g_strdup_printf("%s", obj->val.string); + break; + case MAL_INTEGER: + repr = g_strdup_printf("%" G_GINT64_FORMAT, obj->val.intnum); + break; + case MAL_FLOAT: + repr = g_strdup_printf("%f", obj->val.floatnum); + break; + case MAL_HASH_MAP: + repr = _pr_str_hash_map(obj, print_readably); + break; + case MAL_LIST: + repr = _pr_str_list(obj, print_readably, '(', ')'); + break; + case MAL_VECTOR: + repr = _pr_str_list(obj, print_readably, '[', ']'); + break; + case MAL_ATOM: + repr = g_strdup_printf("(atom %s)", + _pr_str(obj->val.atom_val, print_readably)); + break; + case MAL_FUNCTION_C: + repr = g_strdup_printf("#<function@%p>", obj->val.f0); + break; + case MAL_FUNCTION_MAL: + repr = g_strdup_printf("#<Function: (fn* %s %s)>", + _pr_str(obj->val.func.args, print_readably), + _pr_str(obj->val.func.body, print_readably)); + break; + default: + printf("pr_str unknown type %d\n", obj->type); + repr = g_strdup_printf("<unknown>"); + } + return repr; +} + +// Return a string representation of the MalVal arguments. Returned string must +// be freed by caller. +char *_pr_str_args(MalVal *args, char *sep, int print_readably) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "_pr_str called with non-sequential args"); + int i; + char *repr = g_strdup_printf(""), + *repr2 = NULL; + for (i=0; i<_count(args); i++) { + MalVal *obj = g_array_index(args->val.array, MalVal*, i); + if (i != 0) { + repr2 = repr; + repr = g_strdup_printf("%s%s", repr2, sep); + free(repr2); + } + repr2 = repr; + repr = g_strdup_printf("%s%s", + repr2, _pr_str(obj, print_readably)); + free(repr2); + } + return repr; +} + diff --git a/c/printer.h b/c/printer.h new file mode 100644 index 0000000..b3f389a --- /dev/null +++ b/c/printer.h @@ -0,0 +1,9 @@ +#ifndef __MAL_PRINTER__ +#define __MAL_PRINTER__ + +#include "types.h" + +char *_pr_str_args(MalVal *args, char *sep, int print_readably); +char *_pr_str(MalVal *obj, int print_readably); + +#endif @@ -181,7 +181,7 @@ MalVal *read_list(Reader *reader, MalType type, char start, char end) { MalVal *read_hash_map(Reader *reader) { MalVal *lst = read_list(reader, MAL_LIST, '{', '}'); - MalVal *hm = hash_map(lst); + MalVal *hm = _hash_map(lst); malval_free(lst); return hm; } @@ -207,34 +207,34 @@ MalVal *read_form(Reader *reader) { break; case '\'': reader_next(reader); - form = _list(2, malval_new_symbol("quote"), - read_form(reader)); + form = _listX(2, malval_new_symbol("quote"), + read_form(reader)); break; case '`': reader_next(reader); - form = _list(2, malval_new_symbol("quasiquote"), - read_form(reader)); + form = _listX(2, malval_new_symbol("quasiquote"), + read_form(reader)); break; case '~': reader_next(reader); if (token[1] == '@') { - form = _list(2, malval_new_symbol("splice-unquote"), - read_form(reader)); + form = _listX(2, malval_new_symbol("splice-unquote"), + read_form(reader)); } else { - form = _list(2, malval_new_symbol("unquote"), - read_form(reader)); + form = _listX(2, malval_new_symbol("unquote"), + read_form(reader)); }; break; case '^': reader_next(reader); MalVal *meta = read_form(reader); - form = _list(3, malval_new_symbol("with-meta"), - read_form(reader), meta); + form = _listX(3, malval_new_symbol("with-meta"), + read_form(reader), meta); break; case '@': reader_next(reader); - form = _list(2, malval_new_symbol("deref"), - read_form(reader)); + form = _listX(2, malval_new_symbol("deref"), + read_form(reader)); break; diff --git a/c/step2_eval.c b/c/step2_eval.c index 509e795..85746f8 100644 --- a/c/step2_eval.c +++ b/c/step2_eval.c @@ -4,6 +4,7 @@ #include "types.h" #include "readline.h" #include "reader.h" +#include "core.h" // Declarations MalVal *EVAL(MalVal *ast, GHashTable *env); diff --git a/c/step3_env.c b/c/step3_env.c index bc645b8..4abf4d6 100644 --- a/c/step3_env.c +++ b/c/step3_env.c @@ -4,6 +4,7 @@ #include "types.h" #include "readline.h" #include "reader.h" +#include "core.h" // Declarations MalVal *EVAL(MalVal *ast, Env *env); diff --git a/c/step4_if_fn_do.c b/c/step4_if_fn_do.c index a96641e..3662816 100644 --- a/c/step4_if_fn_do.c +++ b/c/step4_if_fn_do.c @@ -4,6 +4,7 @@ #include "types.h" #include "readline.h" #include "reader.h" +#include "core.h" // Declarations MalVal *EVAL(MalVal *ast, Env *env); @@ -139,7 +140,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { *args = rest(el); assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "cannot apply '%s'", _pr_str(f,1)); - return apply(f, args); + return _apply(f, args); } } @@ -179,9 +180,9 @@ void init_repl_env() { repl_env = new_env(NULL, NULL, NULL); int i; - for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) { - MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func; - _ref(types_ns[i].name, f, types_ns[i].arg_cnt); + for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func; + _ref(core_ns[i].name, f, core_ns[i].arg_cnt); } RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); diff --git a/c/step5_tco.c b/c/step5_tco.c index dc0b28e..99d6826 100644 --- a/c/step5_tco.c +++ b/c/step5_tco.c @@ -4,6 +4,7 @@ #include "types.h" #include "readline.h" #include "reader.h" +#include "core.h" // Declarations MalVal *EVAL(MalVal *ast, Env *env); @@ -144,7 +145,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { - return apply(f, args); + return _apply(f, args); } } } @@ -186,9 +187,9 @@ void init_repl_env() { repl_env = new_env(NULL, NULL, NULL); int i; - for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) { - MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func; - _ref(types_ns[i].name, f, types_ns[i].arg_cnt); + for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func; + _ref(core_ns[i].name, f, core_ns[i].arg_cnt); } RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); diff --git a/c/step6_file.c b/c/step6_file.c index bfd81fd..acde758 100644 --- a/c/step6_file.c +++ b/c/step6_file.c @@ -6,6 +6,7 @@ #include "types.h" #include "readline.h" #include "reader.h" +#include "core.h" #include "interop.h" // Declarations @@ -147,7 +148,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { - return apply(f, args); + return _apply(f, args); } } } @@ -209,9 +210,9 @@ void init_repl_env() { repl_env = new_env(NULL, NULL, NULL); int i; - for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) { - MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func; - _ref(types_ns[i].name, f, types_ns[i].arg_cnt); + for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func; + _ref(core_ns[i].name, f, core_ns[i].arg_cnt); } MalVal *read_string(MalVal *str) { diff --git a/c/step7_quote.c b/c/step7_quote.c index 5e6de17..7da47ee 100644 --- a/c/step7_quote.c +++ b/c/step7_quote.c @@ -6,6 +6,7 @@ #include "types.h" #include "readline.h" #include "reader.h" +#include "core.h" #include "interop.h" // Declarations @@ -36,7 +37,7 @@ int is_pair(MalVal *x) { MalVal *quasiquote(MalVal *ast) { if (!is_pair(ast)) { - return _list(2, malval_new_symbol("quote"), ast); + return _listX(2, malval_new_symbol("quote"), ast); } else { MalVal *a0 = _nth(ast, 0); if ((a0->type & MAL_SYMBOL) && @@ -46,14 +47,14 @@ MalVal *quasiquote(MalVal *ast) { MalVal *a00 = _nth(a0, 0); if ((a00->type & MAL_SYMBOL) && strcmp("splice-unquote", a00->val.string) == 0) { - return _list(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))); + return _listX(3, malval_new_symbol("concat"), + _nth(a0, 1), + quasiquote(rest(ast))); } } - return _list(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))); + return _listX(3, malval_new_symbol("cons"), + quasiquote(a0), + quasiquote(rest(ast))); } } @@ -91,8 +92,8 @@ MalVal *eval_ast(MalVal *ast, Env *env) { MalVal *EVAL(MalVal *ast, Env *env) { while (TRUE) { - //g_print("EVAL: %s\n", _pr_str(ast,1)); if (!ast || mal_error) return NULL; + //g_print("EVAL: %s\n", _pr_str(ast,1)); if (ast->type != MAL_LIST) { return eval_ast(ast, env); } @@ -183,7 +184,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { - return apply(f, args); + return _apply(f, args); } } } @@ -245,9 +246,9 @@ void init_repl_env() { repl_env = new_env(NULL, NULL, NULL); int i; - for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) { - MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func; - _ref(types_ns[i].name, f, types_ns[i].arg_cnt); + for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func; + _ref(core_ns[i].name, f, core_ns[i].arg_cnt); } MalVal *read_string(MalVal *str) { diff --git a/c/step8_macros.c b/c/step8_macros.c index 97da0ec..eb715b1 100644 --- a/c/step8_macros.c +++ b/c/step8_macros.c @@ -6,6 +6,7 @@ #include "types.h" #include "readline.h" #include "reader.h" +#include "core.h" #include "interop.h" // Declarations @@ -37,7 +38,7 @@ int is_pair(MalVal *x) { MalVal *quasiquote(MalVal *ast) { if (!is_pair(ast)) { - return _list(2, malval_new_symbol("quote"), ast); + return _listX(2, malval_new_symbol("quote"), ast); } else { MalVal *a0 = _nth(ast, 0); if ((a0->type & MAL_SYMBOL) && @@ -47,14 +48,14 @@ MalVal *quasiquote(MalVal *ast) { MalVal *a00 = _nth(a0, 0); if ((a00->type & MAL_SYMBOL) && strcmp("splice-unquote", a00->val.string) == 0) { - return _list(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))); + return _listX(3, malval_new_symbol("concat"), + _nth(a0, 1), + quasiquote(rest(ast))); } } - return _list(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))); + return _listX(3, malval_new_symbol("cons"), + quasiquote(a0), + quasiquote(rest(ast))); } } @@ -72,7 +73,7 @@ MalVal *macroexpand(MalVal *ast, Env *env) { MalVal *a0 = _nth(ast, 0); MalVal *mac = env_get(env, a0->val.string); // TODO: this is weird and limits it to 20. FIXME - ast = apply(mac, rest(ast)); + ast = _apply(mac, rest(ast)); } return ast; } @@ -222,7 +223,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { - return apply(f, args); + return _apply(f, args); } } } @@ -284,9 +285,9 @@ void init_repl_env() { repl_env = new_env(NULL, NULL, NULL); int i; - for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) { - MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func; - _ref(types_ns[i].name, f, types_ns[i].arg_cnt); + for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func; + _ref(core_ns[i].name, f, core_ns[i].arg_cnt); } MalVal *read_string(MalVal *str) { diff --git a/c/step9_interop.c b/c/step9_interop.c index 9c25b40..dcd1526 100644 --- a/c/step9_interop.c +++ b/c/step9_interop.c @@ -6,6 +6,7 @@ #include "types.h" #include "readline.h" #include "reader.h" +#include "core.h" #include "interop.h" // Declarations @@ -37,7 +38,7 @@ int is_pair(MalVal *x) { MalVal *quasiquote(MalVal *ast) { if (!is_pair(ast)) { - return _list(2, malval_new_symbol("quote"), ast); + return _listX(2, malval_new_symbol("quote"), ast); } else { MalVal *a0 = _nth(ast, 0); if ((a0->type & MAL_SYMBOL) && @@ -47,14 +48,14 @@ MalVal *quasiquote(MalVal *ast) { MalVal *a00 = _nth(a0, 0); if ((a00->type & MAL_SYMBOL) && strcmp("splice-unquote", a00->val.string) == 0) { - return _list(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))); + return _listX(3, malval_new_symbol("concat"), + _nth(a0, 1), + quasiquote(rest(ast))); } } - return _list(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))); + return _listX(3, malval_new_symbol("cons"), + quasiquote(a0), + quasiquote(rest(ast))); } } @@ -72,7 +73,7 @@ MalVal *macroexpand(MalVal *ast, Env *env) { MalVal *a0 = _nth(ast, 0); MalVal *mac = env_get(env, a0->val.string); // TODO: this is weird and limits it to 20. FIXME - ast = apply(mac, rest(ast)); + ast = _apply(mac, rest(ast)); } return ast; } @@ -227,7 +228,7 @@ MalVal *EVAL(MalVal *ast, Env *env) { env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { - return apply(f, args); + return _apply(f, args); } } } @@ -289,9 +290,9 @@ void init_repl_env() { repl_env = new_env(NULL, NULL, NULL); int i; - for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) { - MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func; - _ref(types_ns[i].name, f, types_ns[i].arg_cnt); + for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func; + _ref(core_ns[i].name, f, core_ns[i].arg_cnt); } MalVal *read_string(MalVal *str) { diff --git a/c/stepA_more.c b/c/stepA_more.c index f5a53ca..4e4152c 100644 --- a/c/stepA_more.c +++ b/c/stepA_more.c @@ -6,6 +6,7 @@ #include "types.h" #include "readline.h" #include "reader.h" +#include "core.h" #include "interop.h" // Declarations @@ -37,7 +38,7 @@ int is_pair(MalVal *x) { MalVal *quasiquote(MalVal *ast) { if (!is_pair(ast)) { - return _list(2, malval_new_symbol("quote"), ast); + return _listX(2, malval_new_symbol("quote"), ast); } else { MalVal *a0 = _nth(ast, 0); if ((a0->type & MAL_SYMBOL) && @@ -47,14 +48,14 @@ MalVal *quasiquote(MalVal *ast) { MalVal *a00 = _nth(a0, 0); if ((a00->type & MAL_SYMBOL) && strcmp("splice-unquote", a00->val.string) == 0) { - return _list(3, malval_new_symbol("concat"), - _nth(a0, 1), - quasiquote(rest(ast))); + return _listX(3, malval_new_symbol("concat"), + _nth(a0, 1), + quasiquote(rest(ast))); } } - return _list(3, malval_new_symbol("cons"), - quasiquote(a0), - quasiquote(rest(ast))); + return _listX(3, malval_new_symbol("cons"), + quasiquote(a0), + quasiquote(rest(ast))); } } @@ -72,7 +73,7 @@ MalVal *macroexpand(MalVal *ast, Env *env) { MalVal *a0 = _nth(ast, 0); MalVal *mac = env_get(env, a0->val.string); // TODO: this is weird and limits it to 20. FIXME - ast = apply(mac, rest(ast)); + ast = _apply(mac, rest(ast)); } return ast; } @@ -193,8 +194,8 @@ MalVal *EVAL(MalVal *ast, Env *env) { MalVal *a21 = _nth(a2, 1); MalVal *a22 = _nth(a2, 2); Env *catch_env = new_env(env, - _list(1, a21), - _list(1, mal_error)); + _listX(1, a21), + _listX(1, mal_error)); //malval_free(mal_error); mal_error = NULL; res = EVAL(a22, catch_env); @@ -248,12 +249,12 @@ MalVal *EVAL(MalVal *ast, Env *env) { env = new_env(f->val.func.env, f->val.func.args, args); // Continue loop } else { - return apply(f, args); + return _apply(f, args); } } } } - + // print char *PRINT(MalVal *exp) { if (mal_error) { @@ -310,9 +311,9 @@ void init_repl_env() { repl_env = new_env(NULL, NULL, NULL); int i; - for(i=0; i< (sizeof(types_ns) / sizeof(types_ns[0])); i++) { - MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))types_ns[i].func; - _ref(types_ns[i].name, f, types_ns[i].arg_cnt); + for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) { + MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func; + _ref(core_ns[i].name, f, core_ns[i].arg_cnt); } MalVal *readline(MalVal *str) { @@ -3,11 +3,17 @@ #include <stdlib.h> #include <string.h> #include "types.h" +#include "printer.h" -// State -MalVal *mal_error = NULL; +// Errors/Exceptions +MalVal *mal_error = NULL; // WARNGIN: global state +void _error(const char *fmt, ...) { + va_list args; + va_start(args, fmt); + mal_error = malval_new_string(g_strdup_vprintf(fmt, args)); +} // Constant atomic values @@ -16,10 +22,6 @@ MalVal mal_true = {MAL_TRUE, NULL, {0}, 0}; MalVal mal_false = {MAL_FALSE, NULL, {0}, 0}; -// Pre-declarations - -MalVal *cons(MalVal *x, MalVal *seq); - // General Functions // Print a hash table @@ -103,18 +105,18 @@ MalVal *malval_new_symbol(char *val) { return mv; } -MalVal *malval_new_hash_map(GHashTable *val) { - MalVal *mv = malval_new(MAL_HASH_MAP, NULL); - mv->val.hash_table = val; - return mv; -} - MalVal *malval_new_list(MalType type, GArray *val) { MalVal *mv = malval_new(type, NULL); mv->val.array = val; return mv; } +MalVal *malval_new_hash_map(GHashTable *val) { + MalVal *mv = malval_new(MAL_HASH_MAP, NULL); + mv->val.hash_table = val; + return mv; +} + MalVal *malval_new_atom(MalVal *val) { MalVal *mv = malval_new(MAL_ATOM, NULL); mv->val.atom_val = val; @@ -186,7 +188,7 @@ MalVal *malval_new_function(void *(*func)(void *), int arg_cnt, MalVal* metadata return mv; } -MalVal *apply(MalVal *f, MalVal *args) { +MalVal *_apply(MalVal *f, MalVal *args) { MalVal *res; assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, "Cannot invoke %s", _pr_str(f,1)); @@ -259,196 +261,6 @@ MalVal *apply(MalVal *f, MalVal *args) { } -char *_pr_str_hash_map(MalVal *obj, int print_readably) { - int start = 1; - char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL; - GHashTableIter iter; - gpointer key, value; - - repr = g_strdup_printf("{"); - - g_hash_table_iter_init (&iter, obj->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - //g_print ("%s/%p ", (const char *) key, (void *) value); - - repr_tmp1 = _pr_str((MalVal*)value, print_readably); - if (start) { - start = 0; - repr = g_strdup_printf("{\"%s\" %s", (char *)key, repr_tmp1); - } else { - repr_tmp2 = repr; - repr = g_strdup_printf("%s \"%s\" %s", repr_tmp2, (char *)key, repr_tmp1); - free(repr_tmp2); - } - free(repr_tmp1); - } - repr_tmp2 = repr; - repr = g_strdup_printf("%s}", repr_tmp2); - free(repr_tmp2); - return repr; -} - -char *_pr_str_list(MalVal *obj, int print_readably, char start, char end) { - int i; - char *repr = NULL, *repr_tmp1 = NULL, *repr_tmp2 = NULL; - repr = g_strdup_printf("%c", start); - for (i=0; i<_count(obj); i++) { - repr_tmp1 = _pr_str(g_array_index(obj->val.array, MalVal*, i), - print_readably); - if (i == 0) { - repr = g_strdup_printf("%c%s", start, repr_tmp1); - } else { - repr_tmp2 = repr; - repr = g_strdup_printf("%s %s", repr_tmp2, repr_tmp1); - free(repr_tmp2); - } - free(repr_tmp1); - } - repr_tmp2 = repr; - repr = g_strdup_printf("%s%c", repr_tmp2, end); - free(repr_tmp2); - return repr; -} - -// Return a string representation of the MalVal object. Returned string must -// be freed by caller. -char *_pr_str(MalVal *obj, int print_readably) { - char *repr = NULL; - if (obj == NULL) { return NULL; } - switch (obj->type) { - case MAL_NIL: - repr = g_strdup_printf("nil"); - break; - case MAL_TRUE: - repr = g_strdup_printf("true"); - break; - case MAL_FALSE: - repr = g_strdup_printf("false"); - break; - case MAL_STRING: - if (print_readably) { - char *repr_tmp = g_strescape(obj->val.string, ""); - repr = g_strdup_printf("\"%s\"", repr_tmp); - free(repr_tmp); - } else { - repr = g_strdup_printf("%s", obj->val.string); - } - break; - case MAL_SYMBOL: - repr = g_strdup_printf("%s", obj->val.string); - break; - case MAL_INTEGER: - repr = g_strdup_printf("%" G_GINT64_FORMAT, obj->val.intnum); - break; - case MAL_FLOAT: - repr = g_strdup_printf("%f", obj->val.floatnum); - break; - case MAL_HASH_MAP: - repr = _pr_str_hash_map(obj, print_readably); - break; - case MAL_LIST: - repr = _pr_str_list(obj, print_readably, '(', ')'); - break; - case MAL_VECTOR: - repr = _pr_str_list(obj, print_readably, '[', ']'); - break; - case MAL_ATOM: - repr = g_strdup_printf("(atom %s)", - _pr_str(obj->val.atom_val, print_readably)); - break; - case MAL_FUNCTION_C: - repr = g_strdup_printf("#<function@%p>", obj->val.f0); - break; - case MAL_FUNCTION_MAL: - repr = g_strdup_printf("#<Function: (fn* %s %s)>", - _pr_str(obj->val.func.args, print_readably), - _pr_str(obj->val.func.body, print_readably)); - break; - default: - printf("pr_str unknown type %d\n", obj->type); - repr = g_strdup_printf("<unknown>"); - } - return repr; -} - -// Return a string representation of the MalVal arguments. Returned string must -// be freed by caller. -char *_pr_str_args(MalVal *args, char *sep, int print_readably) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "_pr_str called with non-sequential args"); - int i; - char *repr = g_strdup_printf(""), - *repr2 = NULL; - for (i=0; i<_count(args); i++) { - MalVal *obj = g_array_index(args->val.array, MalVal*, i); - if (i != 0) { - repr2 = repr; - repr = g_strdup_printf("%s%s", repr2, sep); - free(repr2); - } - repr2 = repr; - repr = g_strdup_printf("%s%s", - repr2, _pr_str(obj, print_readably)); - free(repr2); - } - return repr; -} - -// Return a string representation of a MalVal sequence (in a format that can -// be read by the reader). Returned string must be freed by caller. -MalVal *pr_str(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "pr_str called with non-sequential args"); - return malval_new_string(_pr_str_args(args, " ", 1)); -} - -// Return a string representation of a MalVal sequence with every item -// concatenated together. Returned string must be freed by caller. -MalVal *str(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "str called with non-sequential args"); - return malval_new_string(_pr_str_args(args, "", 0)); -} - -// Print a string representation of a MalVal sequence (in a format that can -// be read by the reader) followed by a newline. Returns nil. -MalVal *prn(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "prn called with non-sequential args"); - char *repr = _pr_str_args(args, " ", 1); - g_print("%s\n", repr); - free(repr); - return &mal_nil; -} - -// Print a string representation of a MalVal sequence (for human consumption) -// followed by a newline. Returns nil. -MalVal *println(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "println called with non-sequential args"); - char *repr = _pr_str_args(args, " ", 0); - g_print("%s\n", repr); - free(repr); - return &mal_nil; -} - -MalVal *with_meta(MalVal *obj, MalVal *meta) { - MalVal *new_obj = malval_new(obj->type, meta); - new_obj->val = obj->val; - return new_obj; -} - -MalVal *meta(MalVal *obj) { - assert_type(obj, MAL_LIST|MAL_VECTOR|MAL_HASH_MAP|MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "attempt to get metadata from non-collection type"); - if (obj->metadata == NULL) { - return &mal_nil; - } else { - return obj->metadata; - } -} - - int _equal_Q(MalVal *a, MalVal *b) { if (a == NULL || b == NULL) { return FALSE; } @@ -498,170 +310,9 @@ int _equal_Q(MalVal *a, MalVal *b) { } } -MalVal *equal_Q(MalVal *a, MalVal *b) { - if (_equal_Q(a, b)) { return &mal_true; } - else { return &mal_false; } -} - -// -// nil, true, false, string -MalVal *nil_Q(MalVal *seq) { return seq->type & MAL_NIL ? &mal_true : &mal_false; } -MalVal *true_Q(MalVal *seq) { return seq->type & MAL_TRUE ? &mal_true : &mal_false; } -MalVal *false_Q(MalVal *seq) { return seq->type & MAL_FALSE ? &mal_true : &mal_false; } -MalVal *string_Q(MalVal *seq) { return seq->type & MAL_STRING ? &mal_true : &mal_false; } - -// -// Numbers -#define WRAP_INTEGER_OP(name, op) \ - MalVal *int_ ## name(MalVal *a, MalVal *b) { \ - return malval_new_integer(a->val.intnum op b->val.intnum); \ - } -#define WRAP_INTEGER_CMP_OP(name, op) \ - MalVal *int_ ## name(MalVal *a, MalVal *b) { \ - return a->val.intnum op b->val.intnum ? &mal_true : &mal_false; \ - } -WRAP_INTEGER_OP(plus,+) -WRAP_INTEGER_OP(minus,-) -WRAP_INTEGER_OP(multiply,*) -WRAP_INTEGER_OP(divide,/) -WRAP_INTEGER_CMP_OP(gt,>) -WRAP_INTEGER_CMP_OP(gte,>=) -WRAP_INTEGER_CMP_OP(lt,<) -WRAP_INTEGER_CMP_OP(lte,<=) - - -// -// Symbols -MalVal *symbol_Q(MalVal *seq) { return seq->type & MAL_SYMBOL ? &mal_true : &mal_false; } - - -// Hash maps -// -MalVal *_hash_map(int count, ...) { - assert((count % 2) == 0, - "odd number of parameters to hash-map"); - GHashTable *htable = g_hash_table_new(g_str_hash, g_str_equal); - MalVal *hm = malval_new_hash_map(htable); - char *k; - MalVal *v; - va_list ap; - va_start(ap, count); - while (count > 0) { - k = va_arg(ap, char*); - v = va_arg(ap, MalVal*); - g_hash_table_insert(htable, k, v); - count = count - 2; - } - va_end(ap); - return hm; -} - -MalVal *_assoc_BANG(MalVal* hm, MalVal *args) { - assert((_count(args) % 2) == 0, - "odd number of parameters to assoc!"); - GHashTable *htable = hm->val.hash_table; - int i; - MalVal *k, *v; - for (i=0; i<_count(args); i+=2) { - k = g_array_index(args->val.array, MalVal*, i); - assert_type(k, MAL_STRING, - "assoc! called with non-string key"); - v = g_array_index(args->val.array, MalVal*, i+1); - g_hash_table_insert(htable, k->val.string, v); - } - return hm; -} - -MalVal *_dissoc_BANG(MalVal* hm, MalVal *args) { - GHashTable *htable = hm->val.hash_table; - int i; - MalVal *k, *v; - for (i=0; i<_count(args); i++) { - k = g_array_index(args->val.array, MalVal*, i); - assert_type(k, MAL_STRING, - "dissoc! called with non-string key"); - g_hash_table_remove(htable, k->val.string); - } - return hm; -} - -MalVal *hash_map(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "hash-map called with non-sequential arguments"); - GHashTable *htable = g_hash_table_new(g_str_hash, g_str_equal); - MalVal *hm = malval_new_hash_map(htable); - return _assoc_BANG(hm, args); -} - -int _hash_map_Q(MalVal *seq) { - return seq->type & MAL_HASH_MAP; -} -MalVal *hash_map_Q(MalVal *seq) { return _hash_map_Q(seq) ? &mal_true : &mal_false; } - -MalVal *assoc(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "assoc called with non-sequential arguments"); - assert(_count(args) >= 2, - "assoc needs at least 2 arguments"); - GHashTable *htable = g_hash_table_copy(_nth(args,0)->val.hash_table); - MalVal *hm = malval_new_hash_map(htable); - return _assoc_BANG(hm, rest(args)); -} - -MalVal *dissoc(MalVal* args) { - GHashTable *htable = g_hash_table_copy(_nth(args,0)->val.hash_table); - MalVal *hm = malval_new_hash_map(htable); - return _dissoc_BANG(hm, rest(args)); -} - -MalVal *keys(MalVal *obj) { - assert_type(obj, MAL_HASH_MAP, - "keys called on non-hash-map"); - - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(obj))); - g_hash_table_iter_init (&iter, obj->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - MalVal *kname = malval_new_string((char *)key); - g_array_append_val(seq->val.array, kname); - } - return seq; -} - -MalVal *vals(MalVal *obj) { - assert_type(obj, MAL_HASH_MAP, - "vals called on non-hash-map"); - - GHashTableIter iter; - gpointer key, value; - MalVal *seq = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - _count(obj))); - g_hash_table_iter_init (&iter, obj->val.hash_table); - while (g_hash_table_iter_next (&iter, &key, &value)) { - g_array_append_val(seq->val.array, value); - } - return seq; -} - - -// Errors/Exceptions -void _error(const char *fmt, ...) { - va_list args; - va_start(args, fmt); - mal_error = malval_new_string(g_strdup_vprintf(fmt, args)); -} -void throw(MalVal *obj) { - mal_error = obj; -} - // Lists - -MalVal *_list(int count, ...) { +MalVal *_listX(int count, ...) { MalVal *seq = malval_new_list(MAL_LIST, g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), count)); @@ -675,7 +326,8 @@ MalVal *_list(int count, ...) { va_end(ap); return seq; } -MalVal *list(MalVal *args) { + +MalVal *_list(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "list called with invalid arguments"); args->type = MAL_LIST; @@ -685,116 +337,68 @@ MalVal *list(MalVal *args) { int _list_Q(MalVal *seq) { return seq->type & MAL_LIST; } -MalVal *list_Q(MalVal *seq) { return _list_Q(seq) ? &mal_true : &mal_false; } // Vectors - -MalVal *_vector(int count, ...) { - MalVal *seq = malval_new_list(MAL_VECTOR, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - count)); - MalVal *v; - va_list ap; - va_start(ap, count); - while (count-- > 0) { - v = va_arg(ap, MalVal*); - g_array_append_val(seq->val.array, v); - } - va_end(ap); - return seq; -} -MalVal *vector(MalVal *args) { +MalVal *_vector(MalVal *args) { assert_type(args, MAL_LIST|MAL_VECTOR, "vector called with invalid arguments"); args->type = MAL_VECTOR; return args; } - int _vector_Q(MalVal *seq) { return seq->type & MAL_VECTOR; } -MalVal *vector_Q(MalVal *seq) { return _vector_Q(seq) ? &mal_true : &mal_false; } -// hash map and vector functions -MalVal *get(MalVal *obj, MalVal *key) { - MalVal *val; - switch (obj->type) { - case MAL_VECTOR: - return _nth(obj, key->val.intnum); - case MAL_HASH_MAP: - if (g_hash_table_lookup_extended(obj->val.hash_table, - key->val.string, - NULL, (gpointer*)&val)) { - return val; - } else { - return &mal_nil; - } - default: - abort("get called on unsupported type %d", obj->type); +// Hash maps +MalVal *_hash_map(MalVal *args) { + assert_type(args, MAL_LIST|MAL_VECTOR, + "hash-map called with non-sequential arguments"); + GHashTable *htable = g_hash_table_new(g_str_hash, g_str_equal); + MalVal *hm = malval_new_hash_map(htable); + return _assoc_BANG(hm, args); +} + +int _hash_map_Q(MalVal *seq) { + return seq->type & MAL_HASH_MAP; +} + +MalVal *_assoc_BANG(MalVal* hm, MalVal *args) { + assert((_count(args) % 2) == 0, + "odd number of parameters to assoc!"); + GHashTable *htable = hm->val.hash_table; + int i; + MalVal *k, *v; + for (i=0; i<_count(args); i+=2) { + k = g_array_index(args->val.array, MalVal*, i); + assert_type(k, MAL_STRING, + "assoc! called with non-string key"); + v = g_array_index(args->val.array, MalVal*, i+1); + g_hash_table_insert(htable, k->val.string, v); } + return hm; } -MalVal *contains_Q(MalVal *obj, MalVal *key) { - switch (obj->type) { - case MAL_VECTOR: - if (key->val.intnum < obj->val.array->len) { - return &mal_true; - } else { - return &mal_false; - } - case MAL_HASH_MAP: - if (g_hash_table_contains(obj->val.hash_table, key->val.string)) { - return &mal_true; - } else { - return &mal_false; - } - default: - abort("contains? called on unsupported type %d", obj->type); +MalVal *_dissoc_BANG(MalVal* hm, MalVal *args) { + GHashTable *htable = hm->val.hash_table; + int i; + MalVal *k, *v; + for (i=0; i<_count(args); i++) { + k = g_array_index(args->val.array, MalVal*, i); + assert_type(k, MAL_STRING, + "dissoc! called with non-string key"); + g_hash_table_remove(htable, k->val.string); } + return hm; } // Atoms -MalVal *atom(MalVal *val) { - return malval_new_atom(val); -} - int _atom_Q(MalVal *exp) { return exp->type & MAL_ATOM; } -MalVal *atom_Q(MalVal *exp) { return _atom_Q(exp) ? &mal_true : &mal_false; } - -MalVal *deref(MalVal *atm) { - assert_type(atm, MAL_ATOM, - "deref called on non-atom"); - return atm->val.atom_val; -} - -MalVal *reset_BANG(MalVal *atm, MalVal *val) { - assert_type(atm, MAL_ATOM, - "reset! called with non-atom"); - atm->val.atom_val = val; - return val; -} - -MalVal *swap_BANG(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "swap! called with invalid arguments"); - assert(_count(args) >= 2, - "swap! called with %d args, needs at least 2", _count(args)); - MalVal *atm = _nth(args, 0), - *f = _nth(args, 1), - *sargs = _slice(args, 2, _count(args)), - *fargs = cons(atm->val.atom_val, sargs), - *new_val = apply(f, fargs); - if (mal_error) { return NULL; } - atm->val.atom_val = new_val; - return new_val; -} - // Sequence functions @@ -813,96 +417,6 @@ MalVal *_slice(MalVal *seq, int start, int end) { int _sequential_Q(MalVal *seq) { return seq->type & (MAL_LIST|MAL_VECTOR); } -MalVal *sequential_Q(MalVal *seq) { - return _sequential_Q(seq) ? &mal_true : &mal_false; -} - -MalVal *cons(MalVal *x, MalVal *seq) { - assert_type(seq, MAL_LIST|MAL_VECTOR, - "second argument to cons is non-sequential"); - int i, len = _count(seq); - GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - len+1); - g_array_append_val(new_arr, x); - for (i=0; i<len; i++) { - g_array_append_val(new_arr, g_array_index(seq->val.array, MalVal*, i)); - } - return malval_new_list(MAL_LIST, new_arr); -} - -MalVal *count(MalVal *seq) { - return malval_new_integer(_count(seq)); -} - -MalVal *empty_Q(MalVal *seq) { - assert_type(seq, MAL_LIST|MAL_VECTOR, - "empty? called with non-sequential"); - return (seq->val.array->len == 0) ? &mal_true : &mal_false; -} - -MalVal *concat(MalVal *args) { - MalVal *arg, *e, *lst; - int i, j, arg_cnt = _count(args); - lst = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), arg_cnt)); - for (i=0; i<arg_cnt; i++) { - arg = g_array_index(args->val.array, MalVal*, i); - assert_type(arg, MAL_LIST|MAL_VECTOR, - "concat called with non-sequential"); - for (j=0; j<_count(arg); j++) { - e = g_array_index(arg->val.array, MalVal*, j); - g_array_append_val(lst->val.array, e); - } - } - - return lst; -} - -MalVal *sconj(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "conj called with non-sequential"); - MalVal *src_lst = _nth(args, 0); - assert_type(args, MAL_LIST|MAL_VECTOR, - "first argument to conj is non-sequential"); - int i, len = _count(src_lst) + _count(args) - 1; - GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - len); - // Copy in src_lst - for (i=0; i<_count(src_lst); i++) { - g_array_append_val(new_arr, g_array_index(src_lst->val.array, MalVal*, i)); - } - // Conj extra args - for (i=1; i<_count(args); i++) { - if (src_lst->type & MAL_LIST) { - g_array_prepend_val(new_arr, g_array_index(args->val.array, MalVal*, i)); - } else { - g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i)); - } - } - return malval_new_list(src_lst->type, new_arr); -} - -MalVal *first(MalVal *seq) { - assert_type(seq, MAL_LIST|MAL_VECTOR, - "first called with non-sequential"); - if (_count(seq) == 0) { - return &mal_nil; - } - return g_array_index(seq->val.array, MalVal*, 0); -} - -MalVal *last(MalVal *seq) { - assert_type(seq, MAL_LIST|MAL_VECTOR, - "last called with non-sequential"); - if (_count(seq) == 0) { - return &mal_nil; - } - return g_array_index(seq->val.array, MalVal*, _count(seq)-1); -} - -MalVal *rest(MalVal *seq) { - return _slice(seq, 1, _count(seq)); -} MalVal *_nth(MalVal *seq, int idx) { assert_type(seq, MAL_LIST|MAL_VECTOR, @@ -912,30 +426,6 @@ MalVal *_nth(MalVal *seq, int idx) { } return g_array_index(seq->val.array, MalVal*, idx); } -MalVal *nth(MalVal *seq, MalVal *idx) { - return _nth(seq, idx->val.intnum); -} - -MalVal *sapply(MalVal *args) { - assert_type(args, MAL_LIST|MAL_VECTOR, - "apply called with non-sequential"); - MalVal *f = _nth(args, 0); - MalVal *last_arg = _nth(args, _count(args)-1); - assert_type(last_arg, MAL_LIST|MAL_VECTOR, - "last argument to apply is non-sequential"); - int i, len = _count(args) - 2 + _count(last_arg); - GArray *new_arr = g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), - len); - // Initial arguments - for (i=1; i<_count(args)-1; i++) { - g_array_append_val(new_arr, g_array_index(args->val.array, MalVal*, i)); - } - // Add arguments from last_arg - for (i=0; i<_count(last_arg); i++) { - g_array_append_val(new_arr, g_array_index(last_arg->val.array, MalVal*, i)); - } - return apply(f, malval_new_list(MAL_LIST, new_arr)); -} MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2) { MalVal *e, *el; @@ -951,136 +441,3 @@ MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2) { } return el; } - -MalVal *map(MalVal *mvf, MalVal *lst) { - MalVal *res, *el; - assert_type(mvf, MAL_FUNCTION_C|MAL_FUNCTION_MAL, - "map called with non-function"); - assert_type(lst, MAL_LIST|MAL_VECTOR, - "map called with non-sequential"); - int i, len = _count(lst); - el = malval_new_list(MAL_LIST, - g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), len)); - for (i=0; i<len; i++) { - // TODO: this is replicating some of apply functionality - if (mvf->type & MAL_FUNCTION_MAL) { - Env *fn_env = new_env(mvf->val.func.env, - mvf->val.func.args, - _slice(lst, i, i+1)); - res = mvf->val.func.evaluator(mvf->val.func.body, fn_env); - } else { - res = mvf->val.f1(g_array_index(lst->val.array, MalVal*, i)); - } - if (!res || mal_error) return NULL; - g_array_append_val(el->val.array, res); - } - return el; -} - - -// Env - -Env *new_env(Env *outer, MalVal* binds, MalVal *exprs) { - Env *e = malloc(sizeof(Env)); - e->table = g_hash_table_new(g_str_hash, g_str_equal); - e->outer = outer; - - if (binds && exprs) { - assert_type(binds, MAL_LIST|MAL_VECTOR, - "new_env called with non-sequential bindings"); - assert_type(exprs, MAL_LIST|MAL_VECTOR, - "new_env called with non-sequential expressions"); - int binds_len = _count(binds), - exprs_len = _count(exprs), - varargs = 0, i; - for (i=0; i<binds_len; i++) { - if (i > exprs_len) { break; } - if (_nth(binds, i)->val.string[0] == '&') { - varargs = 1; - env_set(e, _nth(binds, i+1)->val.string, _slice(exprs, i, _count(exprs))); - break; - } else { - env_set(e, _nth(binds, i)->val.string, _nth(exprs, i)); - } - } - assert(varargs || (binds_len == exprs_len), - "Arity mismatch: %d formal params vs %d actual params", - binds_len, exprs_len); - - } - return e; -} - -Env *env_find(Env *env, char *key) { - void *val = g_hash_table_lookup(env->table, key); - if (val) { - return env; - } else if (env->outer) { - return env_find(env->outer, key); - } else { - return NULL; - } -} - -MalVal *env_get(Env *env, char *key) { - Env *e = env_find(env, key); - assert(e, "'%s' not found", key); - return g_hash_table_lookup(e->table, key); -} - -Env *env_set(Env *env, char *key, MalVal *val) { - g_hash_table_insert(env->table, key, val); - return env; -} - -types_ns_entry types_ns[49] = { - {"pr-str", (void*(*)(void*))pr_str, -1}, - {"str", (void*(*)(void*))str, -1}, - {"prn", (void*(*)(void*))prn, -1}, - {"println", (void*(*)(void*))println, -1}, - {"with-meta", (void*(*)(void*))with_meta, 2}, - {"meta", (void*(*)(void*))meta, 1}, - {"=", (void*(*)(void*))equal_Q, 2}, - {"symbol?", (void*(*)(void*))symbol_Q, 1}, - {"nil?", (void*(*)(void*))nil_Q, 1}, - {"true?", (void*(*)(void*))true_Q, 1}, - {"false?", (void*(*)(void*))false_Q, 1}, - {"+", (void*(*)(void*))int_plus, 2}, - {"-", (void*(*)(void*))int_minus, 2}, - {"*", (void*(*)(void*))int_multiply, 2}, - {"/", (void*(*)(void*))int_divide, 2}, - {">", (void*(*)(void*))int_gt, 2}, - {">=", (void*(*)(void*))int_gte, 2}, - {"<", (void*(*)(void*))int_lt, 2}, - {"<=", (void*(*)(void*))int_lte, 2}, - {"hash-map", (void*(*)(void*))hash_map, -1}, - {"map?", (void*(*)(void*))hash_map_Q, 1}, - {"assoc", (void*(*)(void*))assoc, -1}, - {"dissoc", (void*(*)(void*))dissoc, -1}, - {"get", (void*(*)(void*))get, 2}, - {"contains?", (void*(*)(void*))contains_Q, 2}, - {"keys", (void*(*)(void*))keys, 1}, - {"vals", (void*(*)(void*))vals, 1}, - {"throw", (void*(*)(void*))throw, 1}, - {"list", (void*(*)(void*))list, -1}, - {"list?", (void*(*)(void*))list_Q, 1}, - {"vector", (void*(*)(void*))vector, -1}, - {"vector?", (void*(*)(void*))vector_Q, 1}, - {"atom", (void*(*)(void*))atom, 1}, - {"atom?", (void*(*)(void*))atom_Q, 1}, - {"deref", (void*(*)(void*))deref, 1}, - {"reset!", (void*(*)(void*))reset_BANG, 2}, - {"swap!", (void*(*)(void*))swap_BANG, -1}, - {"sequential?", (void*(*)(void*))sequential_Q, 1}, - {"cons", (void*(*)(void*))cons, 2}, - {"count", (void*(*)(void*))count, 1}, - {"empty?", (void*(*)(void*))empty_Q, 1}, - {"concat", (void*(*)(void*))concat, -1}, - {"conj", (void*(*)(void*))sconj, -1}, - {"first", (void*(*)(void*))first, 1}, - {"last", (void*(*)(void*))last, 1}, - {"rest", (void*(*)(void*))rest, 1}, - {"nth", (void*(*)(void*))nth, 2}, - {"apply", (void*(*)(void*))sapply, -1}, - {"map", (void*(*)(void*))map, 2}, - }; @@ -3,10 +3,32 @@ #include <glib.h> -// State struct MalVal; // pre-declare + + +// Env (implentation in env.c) + +typedef struct Env { + struct Env *outer; + GHashTable *table; +} Env; + +Env *new_env(Env *outer, struct MalVal* binds, struct MalVal *exprs); +Env *env_find(Env *env, char *key); +struct MalVal *env_get(Env *env, char *key); +Env *env_set(Env *env, char *key, struct MalVal *val); + + +// Utility functiosn +void g_hash_table_print(GHashTable *hash_table); +GHashTable *g_hash_table_copy(GHashTable *src_table); + + +// Errors/exceptions + extern struct MalVal *mal_error; +void _error(const char *fmt, ...); #define abort(format, ...) \ { _error(format, ##__VA_ARGS__); return NULL; } @@ -23,6 +45,7 @@ extern struct MalVal *mal_error; return NULL; \ } + typedef enum { MAL_NIL = 1, MAL_TRUE = 2, @@ -39,10 +62,6 @@ typedef enum { MAL_FUNCTION_MAL = 4096, } MalType; - -// Predeclare Env -typedef struct Env Env; - typedef struct MalVal { MalType type; struct MalVal *metadata; @@ -112,51 +131,24 @@ MalVal *malval_new_float(gdouble val); MalVal *malval_new_string(char *val); MalVal *malval_new_symbol(char *val); MalVal *malval_new_list(MalType type, GArray *val); +MalVal *malval_new_hash_map(GHashTable *val); +MalVal *malval_new_atom(MalVal *val); MalVal *malval_new_function(void *(*func)(void *), int arg_cnt, MalVal* metadata); -MalVal *hash_map(MalVal *args); -void _error(const char *fmt, ...); -MalVal *_list(int count, ...); +MalVal *_listX(int count, ...); +MalVal *_list(MalVal *args); +MalVal *_vector(MalVal *args); +MalVal *_hash_map(MalVal *args); +MalVal *_assoc_BANG(MalVal* hm, MalVal *args); +MalVal *_dissoc_BANG(MalVal* hm, MalVal *args); -MalVal *apply(MalVal *f, MalVal *el); +MalVal *_apply(MalVal *f, MalVal *el); char *_pr_str(MalVal *args, int print_readably); -MalVal *first(MalVal* seq); -MalVal *last(MalVal* seq); MalVal *_slice(MalVal *seq, int start, int end); MalVal *_nth(MalVal *seq, int idx); -MalVal *rest(MalVal *seq); MalVal *_map2(MalVal *(*func)(void*, void*), MalVal *lst, void *arg2); -// These are just used by step2 and step3 before then type_ns environment is -// imported - -MalVal *int_plus(MalVal *a, MalVal *b); -MalVal *int_minus(MalVal *a, MalVal *b); -MalVal *int_multiply(MalVal *a, MalVal *b); -MalVal *int_divide(MalVal *a, MalVal *b); - -// Env - -typedef struct Env { - struct Env *outer; - GHashTable *table; -} Env; - -Env *new_env(Env *outer, MalVal* binds, MalVal *exprs); -Env *env_find(Env *env, char *key); -MalVal *env_get(Env *env, char *key); -Env *env_set(Env *env, char *key, MalVal *val); - -// namespace of type functions -typedef struct { - char *name; - void *(*func)(void*); - int arg_cnt; -} types_ns_entry; - -extern types_ns_entry types_ns[49]; - #endif diff --git a/clojure/Makefile b/clojure/Makefile index d18eb50..4bc289e 100644 --- a/clojure/Makefile +++ b/clojure/Makefile @@ -1,7 +1,8 @@ TESTS = -SOURCES = src/types.clj src/readline.clj src/reader.clj src/stepA_more.clj +SOURCES = src/readline.clj src/reader.clj src/printer.clj \ + src/env.clj src/core.clj src/stepA_more.clj all: diff --git a/clojure/src/core.clj b/clojure/src/core.clj new file mode 100644 index 0000000..23dfc55 --- /dev/null +++ b/clojure/src/core.clj @@ -0,0 +1,63 @@ +(ns core) + +;; Errors/exceptions +(defn mal_throw [obj] + (throw (ex-info "mal exception" {:data obj}))) + +;; Atoms +(defn atom? [atm] + (= (type atm) clojure.lang.Atom)) + +;; core_ns is core namespaces functions +(def core_ns + [['= =] + ['throw mal_throw] + ['nil? nil?] + ['true? true?] + ['false? false?] + ['symbol? symbol?] + ['pr-str pr-str] + ['str str] + ['prn prn] + ['println println] + ['< <] + ['<= <=] + ['> >] + ['>= >=] + ['+ +] + ['- -] + ['* *] + ['/ /] + + ['list list] + ['list? seq?] + ['vector vector] + ['vector? vector?] + ['hash-map hash-map] + ['map? map?] + ['assoc assoc] + ['dissoc dissoc] + ['get get] + ['contains? contains?] + ['keys keys] + ['vals vals] + + ['sequential? sequential?] + ['cons cons] + ['concat concat] + ['nth nth] + ['first first] + ['rest rest] + ['empty? empty?] + ['count count] + ['conj conj] + ['apply apply] + ['map #(doall (map %1 %2))] + + ['with-meta with-meta] + ['meta meta] + ['atom atom] + ['atom? atom?] + ['deref deref] + ['reset! reset!] + ['swap! swap!]]) diff --git a/clojure/src/env.clj b/clojure/src/env.clj new file mode 100644 index 0000000..7f1f934 --- /dev/null +++ b/clojure/src/env.clj @@ -0,0 +1,35 @@ +(ns env) + +(defn env [& [outer binds exprs]] + ;;(prn "env" binds exprs) + ;; (when (not= (count binds) (count exprs)) + ;; (throw (Exception. "Arity mistmatch in env call"))) + (atom + (loop [env {:outer outer} + b binds + e exprs] + (cond + (= nil b) + env + + (= '& (first b)) + (assoc env (nth b 1) e) + + :else + (recur (assoc env (first b) (first e)) (next b) (next e)))))) + +(defn env-find [env k] + (cond + (contains? @env k) env + (:outer @env) (env-find (:outer @env) k) + :else nil)) + +(defn env-get [env k] + (let [e (env-find env k)] + (when-not e + (throw (Exception. (str "'" k "' not found")))) + (get @e k))) + +(defn env-set [env k v] + (swap! env assoc k v) + v) diff --git a/clojure/src/printer.clj b/clojure/src/printer.clj new file mode 100644 index 0000000..656914f --- /dev/null +++ b/clojure/src/printer.clj @@ -0,0 +1,7 @@ +(ns printer) + +(defmethod clojure.core/print-method clojure.lang.Atom [a writer] + (.write writer "(atom ") + (.write writer (pr-str @a)) + (.write writer ")")) + diff --git a/clojure/src/step1_read_print.clj b/clojure/src/step1_read_print.clj index a99a0ed..31b2ac6 100644 --- a/clojure/src/step1_read_print.clj +++ b/clojure/src/step1_read_print.clj @@ -1,8 +1,8 @@ (ns step1-read-print (:require [clojure.repl] - [types] [readline] - [reader])) + [reader] + [printer])) ;; read (defn READ [& [strng]] diff --git a/clojure/src/step2_eval.clj b/clojure/src/step2_eval.clj index 6ff9eb3..581bf3f 100644 --- a/clojure/src/step2_eval.clj +++ b/clojure/src/step2_eval.clj @@ -1,10 +1,8 @@ (ns step2-eval (:require [clojure.repl] - [types] [readline] - [reader])) - -(declare EVAL) + [reader] + [printer])) ;; read (defn READ [& [strng]] @@ -12,6 +10,7 @@ (reader/read-string strng))) ;; eval +(declare EVAL) (defn eval-ast [ast env] (cond (symbol? ast) (or (get env ast) diff --git a/clojure/src/step3_env.clj b/clojure/src/step3_env.clj index c0c4e8e..449bf79 100644 --- a/clojure/src/step3_env.clj +++ b/clojure/src/step3_env.clj @@ -1,10 +1,9 @@ (ns step3-env (:require [clojure.repl] - [types] [readline] - [reader])) - -(declare EVAL) + [reader] + [printer] + [env])) ;; read (defn READ [& [strng]] @@ -12,9 +11,10 @@ (reader/read-string strng))) ;; eval +(declare EVAL) (defn eval-ast [ast env] (cond - (symbol? ast) (types/env-get env ast) + (symbol? ast) (env/env-get env ast) (seq? ast) (doall (map #(EVAL % env) ast)) @@ -34,12 +34,12 @@ (let [[a0 a1 a2 a3] ast] (condp = a0 'def! - (types/env-set env a1 (EVAL a2 env)) + (env/env-set env a1 (EVAL a2 env)) 'let* - (let [let-env (types/env env)] + (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] - (types/env-set let-env b (EVAL e let-env))) + (env/env-set let-env b (EVAL e let-env))) (EVAL a2 let-env)) ;; apply @@ -52,12 +52,12 @@ (defn PRINT [exp] (pr-str exp)) ;; repl -(def repl-env (types/env)) +(def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng), repl-env))) -(defn _ref [k,v] (types/env-set repl-env k v)) +(defn _ref [k,v] (env/env-set repl-env k v)) (_ref '+ +) (_ref '- -) (_ref '* *) diff --git a/clojure/src/step4_if_fn_do.clj b/clojure/src/step4_if_fn_do.clj index 4171848..b36f482 100644 --- a/clojure/src/step4_if_fn_do.clj +++ b/clojure/src/step4_if_fn_do.clj @@ -1,10 +1,10 @@ (ns step4-if-fn-do (:require [clojure.repl] - [types] [readline] - [reader])) - -(declare EVAL) + [reader] + [printer] + [env] + [core])) ;; read (defn READ [& [strng]] @@ -12,9 +12,10 @@ (reader/read-string strng))) ;; eval +(declare EVAL) (defn eval-ast [ast env] (cond - (symbol? ast) (types/env-get env ast) + (symbol? ast) (env/env-get env ast) (seq? ast) (doall (map #(EVAL % env) ast)) @@ -34,12 +35,12 @@ (let [[a0 a1 a2 a3] ast] (condp = a0 'def! - (types/env-set env a1 (EVAL a2 env)) + (env/env-set env a1 (EVAL a2 env)) 'let* - (let [let-env (types/env env)] + (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] - (types/env-set let-env b (EVAL e let-env))) + (env/env-set let-env b (EVAL e let-env))) (EVAL a2 let-env)) 'do @@ -55,7 +56,7 @@ 'fn* (fn [& args] - (EVAL a2 (types/env env a1 args))) + (EVAL a2 (env/env env a1 args))) ;; apply (let [el (eval-ast ast env) @@ -67,15 +68,15 @@ (defn PRINT [exp] (pr-str exp)) ;; repl -(def repl-env (types/env)) +(def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng), repl-env))) -(defn _ref [k,v] (types/env-set repl-env k v)) +(defn _ref [k,v] (env/env-set repl-env k v)) ;; Import types related functions -(doseq [[k v] types/types_ns] (_ref k v)) +(doseq [[k v] core/core_ns] (_ref k v)) ;; Defined using the language itself (rep "(def! not (fn* [a] (if a false true)))") diff --git a/clojure/src/step5_tco.clj b/clojure/src/step5_tco.clj index 2ed07b4..7739029 100644 --- a/clojure/src/step5_tco.clj +++ b/clojure/src/step5_tco.clj @@ -1,10 +1,10 @@ (ns step5-tco (:require [clojure.repl] - [types] [readline] - [reader])) - -(declare EVAL) + [reader] + [printer] + [env] + [core])) ;; read (defn READ [& [strng]] @@ -12,9 +12,10 @@ (reader/read-string strng))) ;; eval +(declare EVAL) (defn eval-ast [ast env] (cond - (symbol? ast) (types/env-get env ast) + (symbol? ast) (env/env-get env ast) (seq? ast) (doall (map #(EVAL % env) ast)) @@ -36,12 +37,12 @@ (let [[a0 a1 a2 a3] ast] (condp = a0 'def! - (types/env-set env a1 (EVAL a2 env)) + (env/env-set env a1 (EVAL a2 env)) 'let* - (let [let-env (types/env env)] + (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] - (types/env-set let-env b (EVAL e let-env))) + (env/env-set let-env b (EVAL e let-env))) (EVAL a2 let-env)) 'do @@ -61,7 +62,7 @@ :environment env :parameters a1} (fn [& args] - (EVAL a2 (types/env env a1 args))) + (EVAL a2 (env/env env a1 args))) ;; apply (let [el (eval-ast ast env) @@ -69,22 +70,22 @@ args (rest el) {:keys [expression environment parameters]} (meta f)] (if expression - (recur expression (types/env environment parameters args)) + (recur expression (env/env environment parameters args)) (apply f args)))))))) ;; print (defn PRINT [exp] (pr-str exp)) ;; repl -(def repl-env (types/env)) +(def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng), repl-env))) -(defn _ref [k,v] (types/env-set repl-env k v)) +(defn _ref [k,v] (env/env-set repl-env k v)) ;; Import types related functions -(doseq [[k v] types/types_ns] (_ref k v)) +(doseq [[k v] core/core_ns] (_ref k v)) ;; Defined using the language itself (rep "(def! not (fn* [a] (if a false true)))") diff --git a/clojure/src/step6_file.clj b/clojure/src/step6_file.clj index 2eb4e3d..a65b741 100644 --- a/clojure/src/step6_file.clj +++ b/clojure/src/step6_file.clj @@ -1,10 +1,10 @@ (ns step6-file (:require [clojure.repl] - [types] [readline] - [reader])) - -(declare EVAL) + [reader] + [printer] + [env] + [core])) ;; read (defn READ [& [strng]] @@ -12,9 +12,10 @@ (reader/read-string strng))) ;; eval +(declare EVAL) (defn eval-ast [ast env] (cond - (symbol? ast) (types/env-get env ast) + (symbol? ast) (env/env-get env ast) (seq? ast) (doall (map #(EVAL % env) ast)) @@ -36,12 +37,12 @@ (let [[a0 a1 a2 a3] ast] (condp = a0 'def! - (types/env-set env a1 (EVAL a2 env)) + (env/env-set env a1 (EVAL a2 env)) 'let* - (let [let-env (types/env env)] + (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] - (types/env-set let-env b (EVAL e let-env))) + (env/env-set let-env b (EVAL e let-env))) (EVAL a2 let-env)) 'do @@ -61,7 +62,7 @@ :environment env :parameters a1} (fn [& args] - (EVAL a2 (types/env env a1 args))) + (EVAL a2 (env/env env a1 args))) ;; apply (let [el (eval-ast ast env) @@ -69,22 +70,22 @@ args (rest el) {:keys [expression environment parameters]} (meta f)] (if expression - (recur expression (types/env environment parameters args)) + (recur expression (env/env environment parameters args)) (apply f args)))))))) ;; print (defn PRINT [exp] (pr-str exp)) ;; repl -(def repl-env (types/env)) +(def repl-env (env/env)) (defn rep [strng] - (PRINT (EVAL (READ strng), repl-env))) + (PRINT (EVAL (READ strng) repl-env))) -(defn _ref [k,v] (types/env-set repl-env k v)) +(defn _ref [k,v] (env/env-set repl-env k v)) ;; Import types related functions -(doseq [[k v] types/types_ns] (_ref k v)) +(doseq [[k v] core/core_ns] (_ref k v)) ;; Defined using the language itself (_ref 'read-string reader/read-string) diff --git a/clojure/src/step7_quote.clj b/clojure/src/step7_quote.clj index 398b7d2..e68a4cc 100644 --- a/clojure/src/step7_quote.clj +++ b/clojure/src/step7_quote.clj @@ -1,10 +1,10 @@ (ns step7-quote (:require [clojure.repl] - [types] [readline] - [reader])) - -(declare EVAL) + [reader] + [printer] + [env] + [core])) ;; read (defn READ [& [strng]] @@ -12,6 +12,7 @@ (reader/read-string strng))) ;; eval +(declare EVAL) (defn is-pair [x] (and (sequential? x) (> (count x) 0))) @@ -31,7 +32,7 @@ (defn eval-ast [ast env] (cond - (symbol? ast) (types/env-get env ast) + (symbol? ast) (env/env-get env ast) (seq? ast) (doall (map #(EVAL % env) ast)) @@ -53,12 +54,12 @@ (let [[a0 a1 a2 a3] ast] (condp = a0 'def! - (types/env-set env a1 (EVAL a2 env)) + (env/env-set env a1 (EVAL a2 env)) 'let* - (let [let-env (types/env env)] + (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] - (types/env-set let-env b (EVAL e let-env))) + (env/env-set let-env b (EVAL e let-env))) (EVAL a2 let-env)) 'quote @@ -84,7 +85,7 @@ :environment env :parameters a1} (fn [& args] - (EVAL a2 (types/env env a1 args))) + (EVAL a2 (env/env env a1 args))) ;; apply (let [el (eval-ast ast env) @@ -92,22 +93,22 @@ args (rest el) {:keys [expression environment parameters]} (meta f)] (if expression - (recur expression (types/env environment parameters args)) + (recur expression (env/env environment parameters args)) (apply f args)))))))) ;; print (defn PRINT [exp] (pr-str exp)) ;; repl -(def repl-env (types/env)) +(def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) -(defn _ref [k,v] (types/env-set repl-env k v)) +(defn _ref [k,v] (env/env-set repl-env k v)) ;; Import types related functions -(doseq [[k v] types/types_ns] (_ref k v)) +(doseq [[k v] core/core_ns] (_ref k v)) ;; Defined using the language itself (_ref 'read-string reader/read-string) diff --git a/clojure/src/step8_macros.clj b/clojure/src/step8_macros.clj index 6b696e7..ed5638b 100644 --- a/clojure/src/step8_macros.clj +++ b/clojure/src/step8_macros.clj @@ -1,11 +1,11 @@ (ns step8-macros (:refer-clojure :exclude [macroexpand]) (:require [clojure.repl] - [types] [readline] - [reader])) - -(declare EVAL) + [reader] + [printer] + [env] + [core])) ;; read (defn READ [& [strng]] @@ -13,6 +13,7 @@ (reader/read-string strng))) ;; eval +(declare EVAL) (defn is-pair [x] (and (sequential? x) (> (count x) 0))) @@ -33,19 +34,19 @@ (defn is-macro-call [ast env] (and (seq? ast) (symbol? (first ast)) - (types/env-find env (first ast)) - (:ismacro (meta (types/env-get env (first ast)))))) + (env/env-find env (first ast)) + (:ismacro (meta (env/env-get env (first ast)))))) (defn macroexpand [ast env] (loop [ast ast] (if (is-macro-call ast env) - (let [mac (types/env-get env (first ast))] + (let [mac (env/env-get env (first ast))] (recur (apply mac (rest ast)))) ast))) (defn eval-ast [ast env] (cond - (symbol? ast) (types/env-get env ast) + (symbol? ast) (env/env-get env ast) (seq? ast) (doall (map #(EVAL % env) ast)) @@ -71,12 +72,12 @@ (let [[a0 a1 a2 a3] ast] (condp = a0 'def! - (types/env-set env a1 (EVAL a2 env)) + (env/env-set env a1 (EVAL a2 env)) 'let* - (let [let-env (types/env env)] + (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] - (types/env-set let-env b (EVAL e let-env))) + (env/env-set let-env b (EVAL e let-env))) (EVAL a2 let-env)) 'quote @@ -88,7 +89,7 @@ 'defmacro! (let [func (with-meta (EVAL a2 env) {:ismacro true})] - (types/env-set env a1 func)) + (env/env-set env a1 func)) 'macroexpand (macroexpand a1 env) @@ -110,7 +111,7 @@ :environment env :parameters a1} (fn [& args] - (EVAL a2 (types/env env a1 args))) + (EVAL a2 (env/env env a1 args))) ;; apply (let [el (eval-ast ast env) @@ -118,22 +119,22 @@ args (rest el) {:keys [expression environment parameters]} (meta f)] (if expression - (recur expression (types/env environment parameters args)) + (recur expression (env/env environment parameters args)) (apply f args)))))))))) ;; print (defn PRINT [exp] (pr-str exp)) ;; repl -(def repl-env (types/env)) +(def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) -(defn _ref [k,v] (types/env-set repl-env k v)) +(defn _ref [k,v] (env/env-set repl-env k v)) ;; Import types related functions -(doseq [[k v] types/types_ns] (_ref k v)) +(doseq [[k v] core/core_ns] (_ref k v)) ;; Defined using the language itself (_ref 'read-string reader/read-string) diff --git a/clojure/src/step9_interop.clj b/clojure/src/step9_interop.clj index d78aed7..da37574 100644 --- a/clojure/src/step9_interop.clj +++ b/clojure/src/step9_interop.clj @@ -1,11 +1,11 @@ (ns step9-interop (:refer-clojure :exclude [macroexpand]) (:require [clojure.repl] - [types] [readline] - [reader])) - -(declare EVAL) + [reader] + [printer] + [env] + [core])) ;; read (defn READ [& [strng]] @@ -13,6 +13,7 @@ (reader/read-string strng))) ;; eval +(declare EVAL) (defn is-pair [x] (and (sequential? x) (> (count x) 0))) @@ -33,19 +34,19 @@ (defn is-macro-call [ast env] (and (seq? ast) (symbol? (first ast)) - (types/env-find env (first ast)) - (:ismacro (meta (types/env-get env (first ast)))))) + (env/env-find env (first ast)) + (:ismacro (meta (env/env-get env (first ast)))))) (defn macroexpand [ast env] (loop [ast ast] (if (is-macro-call ast env) - (let [mac (types/env-get env (first ast))] + (let [mac (env/env-get env (first ast))] (recur (apply mac (rest ast)))) ast))) (defn eval-ast [ast env] (cond - (symbol? ast) (types/env-get env ast) + (symbol? ast) (env/env-get env ast) (seq? ast) (doall (map #(EVAL % env) ast)) @@ -71,12 +72,12 @@ (let [[a0 a1 a2 a3] ast] (condp = a0 'def! - (types/env-set env a1 (EVAL a2 env)) + (env/env-set env a1 (EVAL a2 env)) 'let* - (let [let-env (types/env env)] + (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] - (types/env-set let-env b (EVAL e let-env))) + (env/env-set let-env b (EVAL e let-env))) (EVAL a2 let-env)) 'quote @@ -88,7 +89,7 @@ 'defmacro! (let [func (with-meta (EVAL a2 env) {:ismacro true})] - (types/env-set env a1 func)) + (env/env-set env a1 func)) 'macroexpand (macroexpand a1 env) @@ -113,7 +114,7 @@ :environment env :parameters a1} (fn [& args] - (EVAL a2 (types/env env a1 args))) + (EVAL a2 (env/env env a1 args))) ;; apply (let [el (eval-ast ast env) @@ -121,22 +122,22 @@ args (rest el) {:keys [expression environment parameters]} (meta f)] (if expression - (recur expression (types/env environment parameters args)) + (recur expression (env/env environment parameters args)) (apply f args)))))))))) ;; print (defn PRINT [exp] (pr-str exp)) ;; repl -(def repl-env (types/env)) +(def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) -(defn _ref [k,v] (types/env-set repl-env k v)) +(defn _ref [k,v] (env/env-set repl-env k v)) ;; Import types related functions -(doseq [[k v] types/types_ns] (_ref k v)) +(doseq [[k v] core/core_ns] (_ref k v)) ;; Defined using the language itself (_ref 'read-string reader/read-string) diff --git a/clojure/src/stepA_more.clj b/clojure/src/stepA_more.clj index d5d80bf..77b8cd7 100644 --- a/clojure/src/stepA_more.clj +++ b/clojure/src/stepA_more.clj @@ -1,11 +1,11 @@ (ns stepA-more (:refer-clojure :exclude [macroexpand]) (:require [clojure.repl] - [types] [readline] - [reader])) - -(declare EVAL) + [reader] + [printer] + [env] + [core])) ;; read (defn READ [& [strng]] @@ -13,6 +13,7 @@ (reader/read-string strng))) ;; eval +(declare EVAL) (defn is-pair [x] (and (sequential? x) (> (count x) 0))) @@ -33,19 +34,19 @@ (defn is-macro-call [ast env] (and (seq? ast) (symbol? (first ast)) - (types/env-find env (first ast)) - (:ismacro (meta (types/env-get env (first ast)))))) + (env/env-find env (first ast)) + (:ismacro (meta (env/env-get env (first ast)))))) (defn macroexpand [ast env] (loop [ast ast] (if (is-macro-call ast env) - (let [mac (types/env-get env (first ast))] + (let [mac (env/env-get env (first ast))] (recur (apply mac (rest ast)))) ast))) (defn eval-ast [ast env] (cond - (symbol? ast) (types/env-get env ast) + (symbol? ast) (env/env-get env ast) (seq? ast) (doall (map #(EVAL % env) ast)) @@ -71,12 +72,12 @@ (let [[a0 a1 a2 a3] ast] (condp = a0 'def! - (types/env-set env a1 (EVAL a2 env)) + (env/env-set env a1 (EVAL a2 env)) 'let* - (let [let-env (types/env env)] + (let [let-env (env/env env)] (doseq [[b e] (partition 2 a1)] - (types/env-set let-env b (EVAL e let-env))) + (env/env-set let-env b (EVAL e let-env))) (EVAL a2 let-env)) 'quote @@ -88,7 +89,7 @@ 'defmacro! (let [func (with-meta (EVAL a2 env) {:ismacro true})] - (types/env-set env a1 func)) + (env/env-set env a1 func)) 'macroexpand (macroexpand a1 env) @@ -101,13 +102,13 @@ (try (EVAL a1 env) (catch clojure.lang.ExceptionInfo ei - (EVAL (nth a2 2) (types/env env - [(nth a2 1)] - [(:data (ex-data ei))]))) + (EVAL (nth a2 2) (env/env env + [(nth a2 1)] + [(:data (ex-data ei))]))) (catch Throwable t - (EVAL (nth a2 2) (types/env env - [(nth a2 1)] - [(.getMessage t)])))) + (EVAL (nth a2 2) (env/env env + [(nth a2 1)] + [(.getMessage t)])))) (EVAL a1 env)) 'do @@ -127,7 +128,7 @@ :environment env :parameters a1} (fn [& args] - (EVAL a2 (types/env env a1 args))) + (EVAL a2 (env/env env a1 args))) ;; apply (let [el (eval-ast ast env) @@ -135,22 +136,22 @@ args (rest el) {:keys [expression environment parameters]} (meta f)] (if expression - (recur expression (types/env environment parameters args)) + (recur expression (env/env environment parameters args)) (apply f args)))))))))) ;; print (defn PRINT [exp] (pr-str exp)) ;; repl -(def repl-env (types/env)) +(def repl-env (env/env)) (defn rep [strng] (PRINT (EVAL (READ strng) repl-env))) -(defn _ref [k,v] (types/env-set repl-env k v)) +(defn _ref [k,v] (env/env-set repl-env k v)) ;; Import types related functions -(doseq [[k v] types/types_ns] (_ref k v)) +(doseq [[k v] core/core_ns] (_ref k v)) ;; Defined using the language itself (_ref 'readline readline/readline) diff --git a/clojure/src/types.clj b/clojure/src/types.clj deleted file mode 100644 index 922cf79..0000000 --- a/clojure/src/types.clj +++ /dev/null @@ -1,71 +0,0 @@ -(ns types) - -;; Custom printing - -(defmethod clojure.core/print-method clojure.lang.Atom [a writer] - (.write writer "(atom ") - (.write writer (pr-str @a)) - (.write writer ")")) - -;; Errors/exceptions -(defn mal_throw [obj] - (throw (ex-info "mal exception" {:data obj}))) - - -;; Atoms -(defn atom? [atm] - (= (type atm) clojure.lang.Atom)) - - -;; env - -(defn env [& [outer binds exprs]] - ;;(prn "env" binds exprs) - ;; (when (not= (count binds) (count exprs)) - ;; (throw (Exception. "Arity mistmatch in env call"))) - (atom - (loop [env {:outer outer} - b binds - e exprs] - (cond - (= nil b) - env - - (= '& (first b)) - (assoc env (nth b 1) e) - - :else - (recur (assoc env (first b) (first e)) (next b) (next e)))))) - -(defn env-find [env k] - (cond - (contains? @env k) env - (:outer @env) (env-find (:outer @env) k) - :else nil)) - -(defn env-get [env k] - (let [e (env-find env k)] - (when-not e - (throw (Exception. (str "'" k "' not found")))) - (get @e k))) - -(defn env-set [env k v] - (swap! env assoc k v) - v) - -(def types_ns - [['pr-str pr-str] ['str str] ['prn prn] ['println println] - ['with-meta with-meta] ['meta meta] ['= =] - ['nil? nil?] ['true? true?] ['false? false?] ['symbol? symbol?] - ['> >] ['>= >=] ['< <] ['<= <=] ['+ +] ['- -] ['* *] ['/ /] - ['hash-map hash-map] ['map? map?] - ['assoc assoc] ['dissoc dissoc] ['get get] - ['contains? contains?] ['keys keys] ['vals vals] - ['throw mal_throw] - ['list list] ['list? seq?] ['vector vector] ['vector? vector?] - ['atom atom] ['atom? atom?] ['deref deref] - ['reset! reset!] ['swap! swap!] - ['sequential? sequential?] ['cons cons] ['nth nth] - ['empty? empty?] ['count count] ['concat concat] - ['conj conj] ['first first] ['rest rest] - ['apply apply] ['map #(doall (map %1 %2))]]) diff --git a/java/Makefile b/java/Makefile index 8559a05..e6312a3 100644 --- a/java/Makefile +++ b/java/Makefile @@ -2,8 +2,10 @@ TESTS = -SOURCES = src/main/java/mal/types.java src/main/java/mal/readline.java \ - src/main/java/mal/reader.java src/main/java/mal/stepA_more.java +SOURCES = src/main/java/mal/readline.java src/main/java/mal/types.java \ + src/main/java/mal/reader.java src/main/java/mal/printer.java \ + src/main/java/mal/env.java src/main/java/mal/core.java \ + src/main/java/mal/stepA_more.java #.PHONY: stats tests $(TESTS) .PHONY: stats diff --git a/java/src/main/java/mal/core.java b/java/src/main/java/mal/core.java new file mode 100644 index 0000000..3200c0e --- /dev/null +++ b/java/src/main/java/mal/core.java @@ -0,0 +1,470 @@ +package mal; + +import java.util.List; +import java.util.ArrayList; +import java.util.Set; +import java.util.Map; +import java.util.HashMap; +import com.google.common.collect.ImmutableMap; + +import mal.types.*; +import mal.printer; + +public class core { + // Local references for convenience + static MalConstant Nil = mal.types.Nil; + static MalConstant True = mal.types.True; + static MalConstant False = mal.types.False; + + + // Errors/Exceptions + static MalFunction mal_throw = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + throw new MalException(a.nth(0)); + } + }; + + + // Scalar functions + static MalFunction nil_Q = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + return args.nth(0) == Nil ? True : False; + } + }; + + static MalFunction true_Q = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + return args.nth(0) == True ? True : False; + } + }; + + static MalFunction false_Q = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + return args.nth(0) == False ? True : False; + } + }; + static MalFunction symbol_Q = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + return args.nth(0) instanceof MalSymbol ? True : False; + } + }; + + + // String functions + static MalFunction pr_str = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + return new MalString(printer._pr_str_args(args, " ", true)); + } + }; + + static MalFunction str = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + return new MalString(printer._pr_str_args(args, "", false)); + } + }; + + static MalFunction prn = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + System.out.println(printer._pr_str_args(args, " ", true)); + return Nil; + } + }; + + static MalFunction println = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + System.out.println(printer._pr_str_args(args, " ", false)); + return Nil; + } + }; + + + static MalFunction equal_Q = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + return types._equal_Q(args.nth(0), args.nth(1)) ? True : False; + } + }; + + + // Number functions + static MalFunction add = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).add((MalInteger)a.nth(1)); + } + }; + static MalFunction subtract = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).subtract((MalInteger)a.nth(1)); + } + }; + static MalFunction multiply = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).multiply((MalInteger)a.nth(1)); + } + }; + static MalFunction divide = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).divide((MalInteger)a.nth(1)); + } + }; + + static MalFunction lt = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).lt((MalInteger)a.nth(1)); + } + }; + static MalFunction lte = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).lte((MalInteger)a.nth(1)); + } + }; + static MalFunction gt = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).gt((MalInteger)a.nth(1)); + } + }; + static MalFunction gte = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalInteger)a.nth(0)).gte((MalInteger)a.nth(1)); + } + }; + + + // List functions + static MalFunction new_list = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return new MalList(a.value); + } + }; + + static public Boolean _list_Q(MalVal mv) { + return mv.getClass().equals(MalList.class); + } + static MalFunction list_Q = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return _list_Q(a.nth(0)) ? True : False; + } + }; + + + // Vector functions + static MalFunction new_vector = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return new MalVector(a.value); + } + }; + + static public Boolean _vector_Q(MalVal mv) { + return mv.getClass().equals(MalVector.class); + } + static MalFunction vector_Q = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return _vector_Q(a.nth(0)) ? True : False; + } + }; + + // + // Hash map operations + // + static MalFunction new_hash_map = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return new MalHashMap(a); + } + }; + static MalFunction hash_map_Q = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return a.nth(0) instanceof MalHashMap ? True : False; + } + }; + + static MalFunction contains_Q = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + String key = ((MalString)a.nth(1)).getValue(); + MalHashMap mhm = (MalHashMap)a.nth(0); + HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; + return hm.containsKey(key) ? True : False; + } + }; + + static MalFunction assoc = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalHashMap mhm = (MalHashMap)a.nth(0); + HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; + MalHashMap new_mhm = new MalHashMap((Map)hm.clone()); + new_mhm.assoc_BANG((MalList)a.slice(1)); + return new_mhm; + } + }; + + static MalFunction dissoc = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalHashMap mhm = (MalHashMap)a.nth(0); + HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; + MalHashMap new_mhm = new MalHashMap((Map)hm.clone()); + new_mhm.dissoc_BANG((MalList)a.slice(1)); + return new_mhm; + } + }; + + static MalFunction get = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + String key = ((MalString)a.nth(1)).getValue(); + MalHashMap mhm = (MalHashMap)a.nth(0); + HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; + if (hm.containsKey(key)) { + return hm.get(key); + } else { + return Nil; + } + } + }; + + static MalFunction keys = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalHashMap mhm = (MalHashMap)a.nth(0); + HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; + MalList key_lst = new MalList(); + for (String key : hm.keySet()) { + key_lst.conj_BANG(new MalString(key)); + } + return key_lst; + } + }; + + static MalFunction vals = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalHashMap mhm = (MalHashMap)a.nth(0); + HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; + //return new ArrayList<MalVal>(((HashMap<String,MalVal>)hm).values()); + MalList val_lst = new MalList(); + for (MalVal val : hm.values()) { + val_lst.conj_BANG(val); + } + return val_lst; + } + }; + + + // Sequence functions + static MalFunction sequential_Q = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return a.nth(0) instanceof MalList ? True : False; + } + }; + + static MalFunction count = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return new MalInteger(((MalList)a.nth(0)).size()); + } + }; + + static MalFunction empty_Q = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalVal exp = a.nth(0); + if (exp == Nil || (exp instanceof MalList && + ((MalList)exp).size() == 0)) { + return True; + } else { + return False; + } + } + }; + + static MalFunction cons = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalList lst = new MalList(); + lst.value.addAll(((MalList)a.nth(1)).value); + lst.value.add(0, a.nth(0)); + return (MalVal) lst; + } + }; + + static MalFunction concat = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + if (a.size() == 0) { return new MalList(); } + MalList lst = new MalList(); + lst.value.addAll(((MalList)a.nth(0)).value); + for(Integer i=1; i<a.size(); i++) { + lst.value.addAll(((MalList)a.nth(i)).value); + } + return (MalVal) lst; + } + }; + + static MalFunction conj = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalList src_seq = (MalList)a.nth(0), new_seq; + if (a.nth(0) instanceof MalVector) { + new_seq = new MalVector(); + new_seq.value.addAll(src_seq.value); + for(Integer i=1; i<a.size(); i++) { + new_seq.value.add(a.nth(i)); + } + } else { + new_seq = new MalList(); + new_seq.value.addAll(src_seq.value); + for(Integer i=1; i<a.size(); i++) { + new_seq.value.add(0, a.nth(i)); + } + } + return (MalVal) new_seq; + } + }; + + static MalFunction first = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalList ml = ((MalList)a.nth(0)); + return ml.size() > 0 ? ml.nth(0) : Nil; + } + }; + + static MalFunction rest = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalList ml = ((MalList)a.nth(0)); + return ml.rest(); + } + }; + + static MalFunction nth = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + Integer idx = ((MalInteger)a.nth(1)).getValue(); + return ((MalList)a.nth(0)).nth(idx); + } + }; + + // General list related functions + static MalFunction apply = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalFunction f = (MalFunction)a.nth(0); + MalList args = a.slice(1,a.size()-1); + args.value.addAll( ((MalList)a.nth(a.size()-1)).value); + return f.apply(args); + } + }; + + static MalFunction map = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalFunction f = (MalFunction) a.nth(0); + MalList src_lst = (MalList) a.nth(1); + MalList new_lst = new MalList(); + for(Integer i=0; i<src_lst.size(); i++) { + new_lst.value.add( + f.apply(new MalList(src_lst.nth(i)))); + } + return new_lst; + } + }; + + + // Metadata functions + + static MalFunction meta = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + return args.nth(0).getMeta(); + } + }; + + static MalFunction with_meta = new MalFunction() { + public MalVal apply(MalList args) throws MalThrowable { + MalVal new_mv = ((MalVal)args.nth(0)).copy(); + new_mv.setMeta(args.nth(1)); + return new_mv; + } + }; + + + // Atom functions + static MalFunction new_atom = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return new MalAtom(a.nth(0)); + } + }; + + static MalFunction atom_Q = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return a.nth(0) instanceof MalAtom ? True : False; + } + }; + + static MalFunction deref = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalAtom)a.nth(0)).value; + } + }; + + static MalFunction reset_BANG = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + return ((MalAtom)a.nth(0)).value = a.nth(1); + } + }; + + static MalFunction swap_BANG = new MalFunction() { + public MalVal apply(MalList a) throws MalThrowable { + MalAtom atm = (MalAtom)a.nth(0); + MalFunction f = (MalFunction)a.nth(1); + MalList new_args = new MalList(); + new_args.value.addAll(((MalList)a.slice(2)).value); + new_args.value.add(0, atm.value); + atm.value = f.apply(new_args); + return atm.value; + } + }; + + + + + + // types_ns is namespace of type functions + static Map<String, MalVal> ns = ImmutableMap.<String, MalVal>builder() + .put("=", equal_Q) + .put("throw", mal_throw) + .put("nil?", nil_Q) + .put("true?", true_Q) + .put("false?", false_Q) + .put("symbol?", symbol_Q) + .put("pr-str", pr_str) + .put("str", str) + .put("prn", prn) + .put("println", println) + .put("<", lt) + .put("<=", lte) + .put(">", gt) + .put(">=", gte) + .put("+", add) + .put("-", subtract) + .put("*", multiply) + .put("/", divide) + + .put("list", new_list) + .put("list?", list_Q) + .put("vector", new_vector) + .put("vector?", vector_Q) + .put("hash-map", new_hash_map) + .put("map?", hash_map_Q) + .put("assoc", assoc) + .put("dissoc", dissoc) + .put("contains?", contains_Q) + .put("get", get) + .put("keys", keys) + .put("vals", vals) + + .put("sequential?", sequential_Q) + .put("cons", cons) + .put("concat", concat) + .put("nth", nth) + .put("first", first) + .put("rest", rest) + .put("empty?", empty_Q) + .put("count", count) + .put("conj", conj) + .put("apply", apply) + .put("map", map) + + .put("with-meta", with_meta) + .put("meta", meta) + .put("atom", new_atom) + .put("atom?", atom_Q) + .put("deref", deref) + .put("reset!", reset_BANG) + .put("swap!", swap_BANG) + .build(); +} diff --git a/java/src/main/java/mal/env.java b/java/src/main/java/mal/env.java new file mode 100644 index 0000000..8a1913e --- /dev/null +++ b/java/src/main/java/mal/env.java @@ -0,0 +1,57 @@ +package mal; + +import java.util.HashMap; + +import mal.types.MalThrowable; +import mal.types.MalException; +import mal.types.MalVal; +import mal.types.MalSymbol; +import mal.types.MalList; + +public class env { + public static class Env { + Env outer = null; + HashMap<String,MalVal> data = new HashMap<String,MalVal>(); + + public Env(Env outer) { + this.outer = outer; + } + public Env(Env outer, MalList binds, MalList exprs) { + this.outer = outer; + for (Integer i=0; i<binds.size(); i++) { + String sym = ((MalSymbol)binds.nth(i)).getName(); + if (sym.equals("&")) { + data.put(((MalSymbol)binds.nth(i+1)).getName(), + exprs.slice(i)); + break; + } else { + data.put(sym, exprs.nth(i)); + } + } + } + + public Env find(String key) { + if (data.containsKey(key)) { + return this; + } else if (outer != null) { + return outer.find(key); + } else { + return null; + } + } + + public MalVal get(String key) throws MalThrowable { + Env e = find(key); + if (e == null) { + throw new MalException("'" + key + "' not found"); + } else { + return e.data.get(key); + } + } + + public Env set(String key, MalVal value) { + data.put(key, value); + return this; + } + } +} diff --git a/java/src/main/java/mal/printer.java b/java/src/main/java/mal/printer.java new file mode 100644 index 0000000..73dfca3 --- /dev/null +++ b/java/src/main/java/mal/printer.java @@ -0,0 +1,50 @@ +package mal; + +import java.util.List; +import java.util.ArrayList; +import com.google.common.base.Joiner; +import java.util.Map; +import org.apache.commons.lang3.StringEscapeUtils; + +import mal.types.MalVal; +import mal.types.MalList; + +public class printer { + + public static String join(List<MalVal> value, + String delim, Boolean print_readably) { + ArrayList<String> strs = new ArrayList<String>(); + for (MalVal mv : value) { + strs.add(mv.toString(print_readably)); + } + return Joiner.on(delim).join(strs); + } + + public static String join(Map<String,MalVal> value, + String delim, Boolean print_readably) { + ArrayList<String> strs = new ArrayList<String>(); + for (Map.Entry<String, MalVal> entry : value.entrySet()) { + if (print_readably) { + strs.add("\"" + entry.getKey().toString() + "\""); + } else { + strs.add(entry.getKey().toString()); + } + strs.add(entry.getValue().toString(print_readably)); + } + return Joiner.on(" ").join(strs); + } + + public static String _pr_str(MalVal mv, + Boolean print_readably) { + return mv.toString(print_readably); + } + + public static String _pr_str_args(MalList args, + String sep, Boolean print_readably) { + return join(args.getList(), sep, print_readably); + } + + public static String escapeString(String value) { + return StringEscapeUtils.escapeJson(value); + } +} diff --git a/java/src/main/java/mal/step1_read_print.java b/java/src/main/java/mal/step1_read_print.java index 447afc5..3f7e3fb 100644 --- a/java/src/main/java/mal/step1_read_print.java +++ b/java/src/main/java/mal/step1_read_print.java @@ -5,6 +5,7 @@ import java.io.IOException; import mal.types.*; import mal.readline; import mal.reader; +import mal.printer; public class step1_read_print { // read @@ -19,7 +20,7 @@ public class step1_read_print { // print public static String PRINT(MalVal exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // REPL @@ -30,7 +31,7 @@ public class step1_read_print { public static void main(String[] args) throws MalThrowable { String prompt = "user> "; - if (args[0].equals("--raw")) { + if (args.length > 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; } while (true) { diff --git a/java/src/main/java/mal/step2_eval.java b/java/src/main/java/mal/step2_eval.java index e1b30a9..3d425db 100644 --- a/java/src/main/java/mal/step2_eval.java +++ b/java/src/main/java/mal/step2_eval.java @@ -9,6 +9,7 @@ import java.util.Iterator; import mal.types.*; import mal.readline; import mal.reader; +import mal.printer; public class step2_eval { // read @@ -23,8 +24,8 @@ public class step2_eval { return (MalVal)env.get(sym.getName()); } else if (ast instanceof MalList) { MalList old_lst = (MalList)ast; - MalList new_lst = types._list_Q(ast) ? new MalList() - : (MalList)new MalVector(); + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); for (MalVal mv : (List<MalVal>)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } @@ -44,8 +45,8 @@ public class step2_eval { public static MalVal EVAL(MalVal orig_ast, HashMap env) throws MalThrowable { MalVal a0; - //System.out.println("EVAL: " + types._pr_str(orig_ast, true)); - if (!(types._list_Q(orig_ast))) { + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { return eval_ast(orig_ast, env); } @@ -55,17 +56,20 @@ public class step2_eval { a0 = ast.nth(0); if (!(a0 instanceof MalSymbol)) { throw new MalError("attempt to apply on non-symbol '" - + types._pr_str(a0,true) + "'"); + + printer._pr_str(a0,true) + "'"); } - MalVal args = eval_ast(types._rest(ast), env); + MalVal args = eval_ast(ast.rest(), env); MalSymbol fsym = (MalSymbol)a0; ILambda f = (ILambda)env.get(fsym.getName()); + if (f == null) { + throw new MalError("'" + fsym.getName() + "' not found"); + } return f.apply((MalList)args); } // print public static String PRINT(MalVal exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // REPL @@ -110,7 +114,7 @@ public class step2_eval { repl_env.put("*", new multiply()); repl_env.put("/", new divide()); - if (args[0].equals("--raw")) { + if (args.length > 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; } while (true) { diff --git a/java/src/main/java/mal/step3_env.java b/java/src/main/java/mal/step3_env.java index 867dba1..690469e 100644 --- a/java/src/main/java/mal/step3_env.java +++ b/java/src/main/java/mal/step3_env.java @@ -9,6 +9,9 @@ import java.util.Iterator; import mal.types.*; import mal.readline; import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; public class step3_env { // read @@ -23,8 +26,8 @@ public class step3_env { return env.get(sym.getName()); } else if (ast instanceof MalList) { MalList old_lst = (MalList)ast; - MalList new_lst = types._list_Q(ast) ? new MalList() - : (MalList)new MalVector(); + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); for (MalVal mv : (List<MalVal>)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } @@ -44,8 +47,8 @@ public class step3_env { public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { MalVal a0, a1,a2, res; - //System.out.println("EVAL: " + types._pr_str(orig_ast, true)); - if (!(types._list_Q(orig_ast))) { + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { return eval_ast(orig_ast, env); } @@ -55,7 +58,7 @@ public class step3_env { a0 = ast.nth(0); if (!(a0 instanceof MalSymbol)) { throw new MalError("attempt to apply on non-symbol '" - + types._pr_str(a0,true) + "'"); + + printer._pr_str(a0,true) + "'"); } switch (((MalSymbol)a0).getName()) { @@ -78,7 +81,7 @@ public class step3_env { } return EVAL(a2, let_env); default: - MalVal args = eval_ast(types._rest(ast), env); + MalVal args = eval_ast(ast.rest(), env); MalSymbol fsym = (MalSymbol)a0; ILambda f = (ILambda)env.get(fsym.getName()); return f.apply((MalList)args); @@ -87,7 +90,7 @@ public class step3_env { // print public static String PRINT(MalVal exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // REPL @@ -102,12 +105,12 @@ public class step3_env { String prompt = "user> "; Env repl_env = new Env(null); - _ref(repl_env, "+", types.add); - _ref(repl_env, "-", types.subtract); - _ref(repl_env, "*", types.multiply); - _ref(repl_env, "/", types.divide); + _ref(repl_env, "+", core.add); + _ref(repl_env, "-", core.subtract); + _ref(repl_env, "*", core.multiply); + _ref(repl_env, "/", core.divide); - if (args[0].equals("--raw")) { + if (args.length > 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; } while (true) { diff --git a/java/src/main/java/mal/step4_if_fn_do.java b/java/src/main/java/mal/step4_if_fn_do.java index 7501b50..4d064cf 100644 --- a/java/src/main/java/mal/step4_if_fn_do.java +++ b/java/src/main/java/mal/step4_if_fn_do.java @@ -9,6 +9,9 @@ import java.util.Iterator; import mal.types.*; import mal.readline; import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; public class step4_if_fn_do { // read @@ -23,8 +26,8 @@ public class step4_if_fn_do { return env.get(sym.getName()); } else if (ast instanceof MalList) { MalList old_lst = (MalList)ast; - MalList new_lst = types._list_Q(ast) ? new MalList() - : (MalList)new MalVector(); + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); for (MalVal mv : (List<MalVal>)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } @@ -45,8 +48,8 @@ public class step4_if_fn_do { public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { MalVal a0, a1,a2, a3, res; MalList el; - //System.out.println("EVAL: " + types._pr_str(orig_ast, true)); - if (!(types._list_Q(orig_ast))) { + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { return eval_ast(orig_ast, env); } @@ -76,7 +79,7 @@ public class step4_if_fn_do { } return EVAL(a2, let_env); case "do": - el = (MalList)eval_ast(types._rest(ast), env); + el = (MalList)eval_ast(ast.rest(), env); return el.nth(el.size()-1); case "if": a1 = ast.nth(1); @@ -106,13 +109,13 @@ public class step4_if_fn_do { default: el = (MalList)eval_ast(ast, env); MalFunction f = (MalFunction)el.nth(0); - return f.apply(types._rest(el)); + return f.apply(el.rest()); } } // print public static String PRINT(MalVal exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // REPL @@ -127,13 +130,13 @@ public class step4_if_fn_do { String prompt = "user> "; Env repl_env = new Env(null); - for (String key : types.types_ns.keySet()) { - _ref(repl_env, key, types.types_ns.get(key)); + for (String key : core.ns.keySet()) { + _ref(repl_env, key, core.ns.get(key)); } RE(repl_env, "(def! not (fn* (a) (if a false true)))"); - if (args[0].equals("--raw")) { + if (args.length > 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; } while (true) { diff --git a/java/src/main/java/mal/step5_tco.java b/java/src/main/java/mal/step5_tco.java index 41b295b..43b93c6 100644 --- a/java/src/main/java/mal/step5_tco.java +++ b/java/src/main/java/mal/step5_tco.java @@ -9,6 +9,9 @@ import java.util.Iterator; import mal.types.*; import mal.readline; import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; public class step5_tco { // read @@ -23,8 +26,8 @@ public class step5_tco { return env.get(sym.getName()); } else if (ast instanceof MalList) { MalList old_lst = (MalList)ast; - MalList new_lst = types._list_Q(ast) ? new MalList() - : (MalList)new MalVector(); + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); for (MalVal mv : (List<MalVal>)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } @@ -43,20 +46,20 @@ public class step5_tco { } public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a1,a2, a3, res; + MalVal a0, a1,a2, a3, res; MalList el; while (true) { - //System.out.println("EVAL: " + types._pr_str(orig_ast, true)); - if (!(types._list_Q(orig_ast))) { + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { return eval_ast(orig_ast, env); } // apply list MalList ast = (MalList)orig_ast; if (ast.size() == 0) { return ast; } - MalVal a0 = ast.nth(0); + a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { @@ -101,7 +104,7 @@ public class step5_tco { final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; - return new MalFunction (a2f, (mal.types.Env)env, a1f) { + return new MalFunction (a2f, (mal.env.Env)env, a1f) { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } @@ -114,7 +117,7 @@ public class step5_tco { orig_ast = fnast; env = new Env(f.getEnv(), f.getParams(), el.slice(1)); } else { - return f.apply(types._rest(el)); + return f.apply(el.rest()); } } @@ -123,7 +126,7 @@ public class step5_tco { // print public static String PRINT(MalVal exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // REPL @@ -138,13 +141,13 @@ public class step5_tco { String prompt = "user> "; Env repl_env = new Env(null); - for (String key : types.types_ns.keySet()) { - _ref(repl_env, key, types.types_ns.get(key)); + for (String key : core.ns.keySet()) { + _ref(repl_env, key, core.ns.get(key)); } RE(repl_env, "(def! not (fn* (a) (if a false true)))"); - if (args[0].equals("--raw")) { + if (args.length > 0 && args[0].equals("--raw")) { readline.mode = readline.Mode.JAVA; } while (true) { diff --git a/java/src/main/java/mal/step6_file.java b/java/src/main/java/mal/step6_file.java index 65d9d38..0a1a99b 100644 --- a/java/src/main/java/mal/step6_file.java +++ b/java/src/main/java/mal/step6_file.java @@ -12,6 +12,9 @@ import java.util.Iterator; import mal.types.*; import mal.readline; import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; public class step6_file { // read @@ -26,8 +29,8 @@ public class step6_file { return env.get(sym.getName()); } else if (ast instanceof MalList) { MalList old_lst = (MalList)ast; - MalList new_lst = types._list_Q(ast) ? new MalList() - : (MalList)new MalVector(); + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); for (MalVal mv : (List<MalVal>)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } @@ -46,20 +49,20 @@ public class step6_file { } public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a1,a2, a3, res; + MalVal a0, a1,a2, a3, res; MalList el; while (true) { - //System.out.println("EVAL: " + types._pr_str(orig_ast, true)); - if (!(types._list_Q(orig_ast))) { + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { return eval_ast(orig_ast, env); } // apply list MalList ast = (MalList)orig_ast; if (ast.size() == 0) { return ast; } - MalVal a0 = ast.nth(0); + a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { @@ -104,7 +107,7 @@ public class step6_file { final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; - return new MalFunction (a2f, (mal.types.Env)env, a1f) { + return new MalFunction (a2f, (mal.env.Env)env, a1f) { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } @@ -117,7 +120,7 @@ public class step6_file { orig_ast = fnast; env = new Env(f.getEnv(), f.getParams(), el.slice(1)); } else { - return f.apply(types._rest(el)); + return f.apply(el.rest()); } } @@ -126,7 +129,7 @@ public class step6_file { // print public static String PRINT(MalVal exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // REPL @@ -149,8 +152,8 @@ public class step6_file { String prompt = "user> "; final Env repl_env = new Env(null); - for (String key : types.types_ns.keySet()) { - _ref(repl_env, key, types.types_ns.get(key)); + for (String key : core.ns.keySet()) { + _ref(repl_env, key, core.ns.get(key)); } _ref(repl_env, "read-string", new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { diff --git a/java/src/main/java/mal/step7_quote.java b/java/src/main/java/mal/step7_quote.java index 2a09d3e..7105671 100644 --- a/java/src/main/java/mal/step7_quote.java +++ b/java/src/main/java/mal/step7_quote.java @@ -12,6 +12,9 @@ import java.util.Iterator; import mal.types.*; import mal.readline; import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; public class step7_quote { // read @@ -38,12 +41,12 @@ public class step7_quote { (((MalSymbol)a00).getName() == "splice-unquote")) { return new MalList(new MalSymbol("concat"), ((MalList)a0).nth(1), - quasiquote(types._rest((MalList)ast))); + quasiquote(((MalList)ast).rest())); } } return new MalList(new MalSymbol("cons"), quasiquote(a0), - quasiquote(types._rest((MalList)ast))); + quasiquote(((MalList)ast).rest())); } } @@ -53,8 +56,8 @@ public class step7_quote { return env.get(sym.getName()); } else if (ast instanceof MalList) { MalList old_lst = (MalList)ast; - MalList new_lst = types._list_Q(ast) ? new MalList() - : (MalList)new MalVector(); + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); for (MalVal mv : (List<MalVal>)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } @@ -73,20 +76,20 @@ public class step7_quote { } public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a1,a2, a3, res; + MalVal a0, a1,a2, a3, res; MalList el; while (true) { - //System.out.println("EVAL: " + types._pr_str(orig_ast, true)); - if (!(types._list_Q(orig_ast))) { + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { return eval_ast(orig_ast, env); } // apply list MalList ast = (MalList)orig_ast; if (ast.size() == 0) { return ast; } - MalVal a0 = ast.nth(0); + a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { @@ -135,7 +138,7 @@ public class step7_quote { final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; - return new MalFunction (a2f, (mal.types.Env)env, a1f) { + return new MalFunction (a2f, (mal.env.Env)env, a1f) { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } @@ -148,7 +151,7 @@ public class step7_quote { orig_ast = fnast; env = new Env(f.getEnv(), f.getParams(), el.slice(1)); } else { - return f.apply(types._rest(el)); + return f.apply(el.rest()); } } @@ -157,7 +160,7 @@ public class step7_quote { // print public static String PRINT(MalVal exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // REPL @@ -180,8 +183,8 @@ public class step7_quote { String prompt = "user> "; final Env repl_env = new Env(null); - for (String key : types.types_ns.keySet()) { - _ref(repl_env, key, types.types_ns.get(key)); + for (String key : core.ns.keySet()) { + _ref(repl_env, key, core.ns.get(key)); } _ref(repl_env, "read-string", new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { diff --git a/java/src/main/java/mal/step8_macros.java b/java/src/main/java/mal/step8_macros.java index 47732dd..c834119 100644 --- a/java/src/main/java/mal/step8_macros.java +++ b/java/src/main/java/mal/step8_macros.java @@ -12,6 +12,9 @@ import java.util.Iterator; import mal.types.*; import mal.readline; import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; public class step8_macros { // read @@ -38,12 +41,12 @@ public class step8_macros { (((MalSymbol)a00).getName() == "splice-unquote")) { return new MalList(new MalSymbol("concat"), ((MalList)a0).nth(1), - quasiquote(types._rest((MalList)ast))); + quasiquote(((MalList)ast).rest())); } } return new MalList(new MalSymbol("cons"), quasiquote(a0), - quasiquote(types._rest((MalList)ast))); + quasiquote(((MalList)ast).rest())); } } @@ -68,7 +71,7 @@ public class step8_macros { while (is_macro_call(ast, env)) { MalSymbol a0 = (MalSymbol)((MalList)ast).nth(0); MalFunction mac = (MalFunction) env.get(a0.getName()); - ast = mac.apply(types._rest((MalList)ast)); + ast = mac.apply(((MalList)ast).rest()); } return ast; } @@ -79,8 +82,8 @@ public class step8_macros { return env.get(sym.getName()); } else if (ast instanceof MalList) { MalList old_lst = (MalList)ast; - MalList new_lst = types._list_Q(ast) ? new MalList() - : (MalList)new MalVector(); + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); for (MalVal mv : (List<MalVal>)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } @@ -99,22 +102,22 @@ public class step8_macros { } public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a1,a2, a3, res; + MalVal a0, a1,a2, a3, res; MalList el; while (true) { - //System.out.println("EVAL: " + types._pr_str(orig_ast, true)); - if (!(types._list_Q(orig_ast))) { + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { return eval_ast(orig_ast, env); } // apply list MalVal expanded = macroexpand(orig_ast, env); - if (!types._list_Q(expanded)) { return expanded; } + if (!expanded.list_Q()) { return expanded; } MalList ast = (MalList) expanded; if (ast.size() == 0) { return ast; } - MalVal a0 = ast.nth(0); + a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { @@ -173,7 +176,7 @@ public class step8_macros { final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; - return new MalFunction (a2f, (mal.types.Env)env, a1f) { + return new MalFunction (a2f, (mal.env.Env)env, a1f) { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } @@ -186,7 +189,7 @@ public class step8_macros { orig_ast = fnast; env = new Env(f.getEnv(), f.getParams(), el.slice(1)); } else { - return f.apply(types._rest(el)); + return f.apply(el.rest()); } } @@ -195,7 +198,7 @@ public class step8_macros { // print public static String PRINT(MalVal exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // REPL @@ -218,8 +221,8 @@ public class step8_macros { String prompt = "user> "; final Env repl_env = new Env(null); - for (String key : types.types_ns.keySet()) { - _ref(repl_env, key, types.types_ns.get(key)); + for (String key : core.ns.keySet()) { + _ref(repl_env, key, core.ns.get(key)); } _ref(repl_env, "read-string", new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { diff --git a/java/src/main/java/mal/stepA_more.java b/java/src/main/java/mal/stepA_more.java index d3bb161..9f4fb07 100644 --- a/java/src/main/java/mal/stepA_more.java +++ b/java/src/main/java/mal/stepA_more.java @@ -14,6 +14,9 @@ import java.util.Iterator; import mal.types.*; import mal.readline; import mal.reader; +import mal.printer; +import mal.env.Env; +import mal.core; public class stepA_more { // read @@ -40,12 +43,12 @@ public class stepA_more { (((MalSymbol)a00).getName() == "splice-unquote")) { return new MalList(new MalSymbol("concat"), ((MalList)a0).nth(1), - quasiquote(types._rest((MalList)ast))); + quasiquote(((MalList)ast).rest())); } } return new MalList(new MalSymbol("cons"), quasiquote(a0), - quasiquote(types._rest((MalList)ast))); + quasiquote(((MalList)ast).rest())); } } @@ -70,7 +73,7 @@ public class stepA_more { while (is_macro_call(ast, env)) { MalSymbol a0 = (MalSymbol)((MalList)ast).nth(0); MalFunction mac = (MalFunction) env.get(a0.getName()); - ast = mac.apply(types._rest((MalList)ast)); + ast = mac.apply(((MalList)ast).rest()); } return ast; } @@ -81,8 +84,8 @@ public class stepA_more { return env.get(sym.getName()); } else if (ast instanceof MalList) { MalList old_lst = (MalList)ast; - MalList new_lst = types._list_Q(ast) ? new MalList() - : (MalList)new MalVector(); + MalList new_lst = ast.list_Q() ? new MalList() + : (MalList)new MalVector(); for (MalVal mv : (List<MalVal>)old_lst.value) { new_lst.conj_BANG(EVAL(mv, env)); } @@ -101,22 +104,22 @@ public class stepA_more { } public static MalVal EVAL(MalVal orig_ast, Env env) throws MalThrowable { - MalVal a1,a2, a3, res; + MalVal a0, a1,a2, a3, res; MalList el; while (true) { - //System.out.println("EVAL: " + types._pr_str(orig_ast, true)); - if (!(types._list_Q(orig_ast))) { + //System.out.println("EVAL: " + printer._pr_str(orig_ast, true)); + if (!orig_ast.list_Q()) { return eval_ast(orig_ast, env); } // apply list MalVal expanded = macroexpand(orig_ast, env); - if (!types._list_Q(expanded)) { return expanded; } + if (!expanded.list_Q()) { return expanded; } MalList ast = (MalList) expanded; if (ast.size() == 0) { return ast; } - MalVal a0 = ast.nth(0); + a0 = ast.nth(0); String a0sym = a0 instanceof MalSymbol ? ((MalSymbol)a0).getName() : "__<*fn*>__"; switch (a0sym) { @@ -199,7 +202,7 @@ public class stepA_more { final MalList a1f = (MalList)ast.nth(1); final MalVal a2f = ast.nth(2); final Env cur_env = env; - return new MalFunction (a2f, (mal.types.Env)env, a1f) { + return new MalFunction (a2f, (mal.env.Env)env, a1f) { public MalVal apply(MalList args) throws MalThrowable { return EVAL(a2f, new Env(cur_env, a1f, args)); } @@ -212,7 +215,7 @@ public class stepA_more { orig_ast = fnast; env = new Env(f.getEnv(), f.getParams(), el.slice(1)); } else { - return f.apply(types._rest(el)); + return f.apply(el.rest()); } } @@ -221,7 +224,7 @@ public class stepA_more { // print public static String PRINT(MalVal exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // REPL @@ -244,8 +247,8 @@ public class stepA_more { String prompt = "user> "; final Env repl_env = new Env(null); - for (String key : types.types_ns.keySet()) { - _ref(repl_env, key, types.types_ns.get(key)); + for (String key : core.ns.keySet()) { + _ref(repl_env, key, core.ns.get(key)); } _ref(repl_env, "readline", new MalFunction() { public MalVal apply(MalList args) throws MalThrowable { @@ -315,7 +318,7 @@ public class stepA_more { System.out.println(e.getMessage()); continue; } catch (MalException e) { - System.out.println("Error: " + types._pr_str(e.getValue(), false)); + System.out.println("Error: " + printer._pr_str(e.getValue(), false)); continue; } catch (MalThrowable t) { System.out.println("Error: " + t.getMessage()); diff --git a/java/src/main/java/mal/types.java b/java/src/main/java/mal/types.java index 8a4910b..a53c0e9 100644 --- a/java/src/main/java/mal/types.java +++ b/java/src/main/java/mal/types.java @@ -2,12 +2,12 @@ package mal; import java.util.List; import java.util.ArrayList; -import com.google.common.base.Joiner; import java.util.Set; import java.util.Map; import java.util.HashMap; -import com.google.common.collect.ImmutableMap; -import org.apache.commons.lang3.StringEscapeUtils; + +import mal.printer; +import mal.env.Env; public class types { // @@ -34,6 +34,41 @@ public class types { public MalVal getValue() { return value; } } + // + // General functions + // + + public static Boolean _equal_Q(MalVal a, MalVal b) { + Class ota = a.getClass(), otb = b.getClass(); + if (!((ota == otb) || + (a instanceof MalList && b instanceof MalList))) { + return false; + } else { + if (a instanceof MalInteger) { + return ((MalInteger)a).getValue() == + ((MalInteger)b).getValue(); + } else if (a instanceof MalSymbol) { + return ((MalSymbol)a).getName().equals( + ((MalSymbol)b).getName()); + } else if (a instanceof MalString) { + return ((MalString)a).getValue().equals( + ((MalString)b).getValue()); + } else if (a instanceof MalList) { + if (((MalList)a).size() != ((MalList)b).size()) { + return false; + } + for (Integer i=0; i<((MalList)a).size(); i++) { + if (! _equal_Q(((MalList)a).nth(i), + ((MalList)b).nth(i))) { + return false; + } + } + return true; + } else { + return a == b; + } + } + } // // Mal boxed types @@ -48,6 +83,7 @@ public class types { } public MalVal getMeta() { return meta; } public void setMeta(MalVal m) { meta = m; } + public Boolean list_Q() { return false; } } public static class MalConstant extends MalVal { String value; @@ -56,9 +92,9 @@ public class types { public String toString() { return value; } } - static MalConstant Nil = new MalConstant("nil"); - static MalConstant True = new MalConstant("true"); - static MalConstant False = new MalConstant("false"); + public static MalConstant Nil = new MalConstant("nil"); + public static MalConstant True = new MalConstant("true"); + public static MalConstant False = new MalConstant("false"); public static class MalInteger extends MalVal { Integer value; @@ -117,7 +153,7 @@ public class types { } public String toString(Boolean print_readably) { if (print_readably) { - return "\"" + StringEscapeUtils.escapeJson(value) + "\""; + return "\"" + printer.escapeString(value) + "\""; } else { return value; } @@ -141,19 +177,15 @@ public class types { return new_ml; } - String _join(String delim, Boolean print_readably) { - ArrayList<String> strs = new ArrayList<String>(); - for (MalVal mv : (List<MalVal>)value) { - strs.add(mv.toString(print_readably)); - } - return Joiner.on(delim).join(strs); - } @Override public String toString() { - return start + _join(" ", true) + end; + return start + printer.join(value, " ", true) + end; } public String toString(Boolean print_readably) { - return start + _join(" ", print_readably) + end; + return start + printer.join(value, " ", print_readably) + end; } + + public List getList() { return value; } + public Boolean list_Q() { return true; } public MalList conj_BANG(MalVal... mvs) { for (MalVal mv : mvs) { @@ -169,6 +201,14 @@ public class types { public MalVal nth(Integer idx) { return (MalVal)value.get(idx); } + public MalList rest () { + if (size() > 0) { + return new MalList(value.subList(1, value.size())); + } else { + return new MalList(); + } + } + public MalList slice(Integer start, Integer end) { return new MalList(value.subList(start, end)); @@ -197,6 +237,8 @@ public class types { return new_mv; } + public Boolean list_Q() { return false; } + public MalVector slice(Integer start, Integer end) { return new MalVector(value.subList(start, end)); } @@ -223,24 +265,11 @@ public class types { return new_hm; } - String _join(Boolean print_readably) { - ArrayList<String> strs = new ArrayList<String>(); - for (Map.Entry<String, MalVal> entry : - ((Map<String,MalVal>)value).entrySet()) { - if (print_readably) { - strs.add("\"" + entry.getKey().toString() + "\""); - } else { - strs.add(entry.getKey().toString()); - } - strs.add(entry.getValue().toString(print_readably)); - } - return Joiner.on(" ").join(strs); - } @Override public String toString() { - return "{" + _join(true) + "}"; + return "{" + printer.join(value, " ", true) + "}"; } public String toString(Boolean print_readably) { - return "{" + _join(print_readably) + "}"; + return "{" + printer.join(value, " ", print_readably) + "}"; } public Set _entries() { @@ -280,10 +309,10 @@ public class types { public MalAtom(MalVal value) { this.value = value; } public MalAtom copy() throws MalThrowable { return new MalAtom(value); } @Override public String toString() { - return "(atom " + _pr_str(value, true) + ")"; + return "(atom " + printer._pr_str(value, true) + ")"; } public String toString(Boolean print_readably) { - return "(atom " + _pr_str(value, print_readably) + ")"; + return "(atom " + printer._pr_str(value, print_readably) + ")"; } } @@ -329,563 +358,4 @@ public class types { public Boolean isMacro() { return macro; } public void setMacro() { macro = true; } } - - - // - // General functions - // - public static String _pr_str(MalVal mv, Boolean print_readably) { - return mv.toString(print_readably); - } - - public static String _pr_str_args(MalList args, String sep, Boolean print_readably) { - return args._join(sep, print_readably); - } - - static MalFunction pr_str = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return new MalString(_pr_str_args(args, " ", true)); - } - }; - - static MalFunction str = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return new MalString(_pr_str_args(args, "", false)); - } - }; - - static MalFunction prn = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - System.out.println(_pr_str_args(args, " ", true)); - return Nil; - } - }; - - static MalFunction println = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - System.out.println(_pr_str_args(args, " ", false)); - return Nil; - } - }; - - - static MalFunction meta = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return args.nth(0).getMeta(); - } - }; - - static MalFunction with_meta = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - MalVal new_mv = ((MalVal)args.nth(0)).copy(); - new_mv.setMeta(args.nth(1)); - return new_mv; - } - }; - - - public static Boolean _equal_Q(MalVal a, MalVal b) { - Class ota = a.getClass(), otb = b.getClass(); - if (!((ota == otb) || - (a instanceof MalList && b instanceof MalList))) { - return false; - } else { - if (a instanceof MalInteger) { - return ((MalInteger)a).getValue() == - ((MalInteger)b).getValue(); - } else if (a instanceof MalSymbol) { - return ((MalSymbol)a).getName().equals( - ((MalSymbol)b).getName()); - } else if (a instanceof MalString) { - return ((MalString)a).getValue().equals( - ((MalString)b).getValue()); - } else if (a instanceof MalList) { - if (((MalList)a).size() != ((MalList)b).size()) { - return false; - } - for (Integer i=0; i<((MalList)a).size(); i++) { - if (! _equal_Q(((MalList)a).nth(i), - ((MalList)b).nth(i))) { - return false; - } - } - return true; - } else { - return a == b; - } - } - } - - static MalFunction equal_Q = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return _equal_Q(args.nth(0), args.nth(1)) ? True : False; - } - }; - - - // - // Constants operations - // - static MalFunction symbol_Q = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return args.nth(0) instanceof MalSymbol ? True : False; - } - }; - - static MalFunction nil_Q = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return args.nth(0) == Nil ? True : False; - } - }; - - static MalFunction true_Q = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return args.nth(0) == True ? True : False; - } - }; - - static MalFunction false_Q = new MalFunction() { - public MalVal apply(MalList args) throws MalThrowable { - return args.nth(0) == False ? True : False; - } - }; - - - // - // Number operations - // - static MalFunction add = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).add((MalInteger)a.nth(1)); - } - }; - static MalFunction subtract = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).subtract((MalInteger)a.nth(1)); - } - }; - static MalFunction multiply = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).multiply((MalInteger)a.nth(1)); - } - }; - static MalFunction divide = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).divide((MalInteger)a.nth(1)); - } - }; - - static MalFunction lt = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).lt((MalInteger)a.nth(1)); - } - }; - static MalFunction lte = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).lte((MalInteger)a.nth(1)); - } - }; - static MalFunction gt = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).gt((MalInteger)a.nth(1)); - } - }; - static MalFunction gte = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalInteger)a.nth(0)).gte((MalInteger)a.nth(1)); - } - }; - - // - // Errors/Exceptions - // - static MalFunction mal_throw = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - throw new MalException(a.nth(0)); - } - }; - - // - // List operations - // - static MalFunction new_list = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return new MalList(a.value); - } - }; - - static public Boolean _list_Q(MalVal mv) { - return mv.getClass().equals(MalList.class); - } - static MalFunction list_Q = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return _list_Q(a.nth(0)) ? True : False; - } - }; - - // - // Vector operations - // - static MalFunction new_vector = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return new MalVector(a.value); - } - }; - - static public Boolean _vector_Q(MalVal mv) { - return mv.getClass().equals(MalVector.class); - } - static MalFunction vector_Q = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return _vector_Q(a.nth(0)) ? True : False; - } - }; - - // - // Hash map operations - // - static MalFunction new_hash_map = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return new MalHashMap(a); - } - }; - - static MalFunction hash_map_Q = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return a.nth(0) instanceof MalHashMap ? True : False; - } - }; - - static MalFunction contains_Q = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - String key = ((MalString)a.nth(1)).getValue(); - MalHashMap mhm = (MalHashMap)a.nth(0); - HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; - return hm.containsKey(key) ? True : False; - } - }; - - static MalFunction assoc = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalHashMap mhm = (MalHashMap)a.nth(0); - HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; - MalHashMap new_mhm = new MalHashMap((Map)hm.clone()); - new_mhm.assoc_BANG((MalList)a.slice(1)); - return new_mhm; - } - }; - - static MalFunction dissoc = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalHashMap mhm = (MalHashMap)a.nth(0); - HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; - MalHashMap new_mhm = new MalHashMap((Map)hm.clone()); - new_mhm.dissoc_BANG((MalList)a.slice(1)); - return new_mhm; - } - }; - - static MalFunction get = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - String key = ((MalString)a.nth(1)).getValue(); - MalHashMap mhm = (MalHashMap)a.nth(0); - HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; - if (hm.containsKey(key)) { - return hm.get(key); - } else { - return Nil; - } - } - }; - - static MalFunction keys = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalHashMap mhm = (MalHashMap)a.nth(0); - HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; - MalList key_lst = new MalList(); - for (String key : hm.keySet()) { - key_lst.conj_BANG(new MalString(key)); - } - return key_lst; - } - }; - - static MalFunction vals = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalHashMap mhm = (MalHashMap)a.nth(0); - HashMap<String,MalVal> hm = (HashMap<String,MalVal>)mhm.value; - //return new ArrayList<MalVal>(((HashMap<String,MalVal>)hm).values()); - MalList val_lst = new MalList(); - for (MalVal val : hm.values()) { - val_lst.conj_BANG(val); - } - return val_lst; - } - }; - - - // - // Atoms - // - static MalFunction new_atom = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return new MalAtom(a.nth(0)); - } - }; - - static MalFunction atom_Q = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return a.nth(0) instanceof MalAtom ? True : False; - } - }; - - static MalFunction deref = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalAtom)a.nth(0)).value; - } - }; - - static MalFunction reset_BANG = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return ((MalAtom)a.nth(0)).value = a.nth(1); - } - }; - - static MalFunction swap_BANG = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalAtom atm = (MalAtom)a.nth(0); - MalFunction f = (MalFunction)a.nth(1); - MalList new_args = new MalList(); - new_args.value.addAll(((MalList)a.slice(2)).value); - new_args.value.add(0, atm.value); - atm.value = f.apply(new_args); - return atm.value; - } - }; - - - - - // - // Sequence operations - // - static MalFunction sequential_Q = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return a.nth(0) instanceof MalList ? True : False; - } - }; - - static MalFunction count = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - return new MalInteger(((MalList)a.nth(0)).size()); - } - }; - - static MalFunction empty_Q = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalVal exp = a.nth(0); - if (exp == Nil || (exp instanceof MalList && - ((MalList)exp).size() == 0)) { - return True; - } else { - return False; - } - } - }; - - static MalFunction cons = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalList lst = new MalList(); - lst.value.addAll(((MalList)a.nth(1)).value); - lst.value.add(0, a.nth(0)); - return (MalVal) lst; - } - }; - - static MalFunction concat = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - if (a.size() == 0) { return new MalList(); } - MalList lst = new MalList(); - lst.value.addAll(((MalList)a.nth(0)).value); - for(Integer i=1; i<a.size(); i++) { - lst.value.addAll(((MalList)a.nth(i)).value); - } - return (MalVal) lst; - } - }; - - static MalFunction conj = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalList src_seq = (MalList)a.nth(0), new_seq; - if (a.nth(0) instanceof MalVector) { - new_seq = new MalVector(); - new_seq.value.addAll(src_seq.value); - for(Integer i=1; i<a.size(); i++) { - new_seq.value.add(a.nth(i)); - } - } else { - new_seq = new MalList(); - new_seq.value.addAll(src_seq.value); - for(Integer i=1; i<a.size(); i++) { - new_seq.value.add(0, a.nth(i)); - } - } - return (MalVal) new_seq; - } - }; - - static MalFunction first = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalList ml = ((MalList)a.nth(0)); - return ml.size() > 0 ? ml.nth(0) : Nil; - } - }; - - static MalList _rest (MalList ml) { - if (ml.size() > 0) { - return new MalList(ml.value.subList(1, ml.value.size())); - } else { - return new MalList(); - } - } - - static MalFunction rest = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalList ml = ((MalList)a.nth(0)); - return _rest(ml); - } - }; - - static MalFunction nth = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - Integer idx = ((MalInteger)a.nth(1)).getValue(); - return ((MalList)a.nth(0)).nth(idx); - } - }; - - // General list related functions - static MalFunction apply = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalFunction f = (MalFunction)a.nth(0); - MalList args = a.slice(1,a.size()-1); - args.value.addAll( ((MalList)a.nth(a.size()-1)).value); - return f.apply(args); - } - }; - - static MalFunction map = new MalFunction() { - public MalVal apply(MalList a) throws MalThrowable { - MalFunction f = (MalFunction) a.nth(0); - MalList src_lst = (MalList) a.nth(1); - MalList new_lst = new MalList(); - for(Integer i=0; i<src_lst.size(); i++) { - new_lst.value.add( - f.apply(new MalList(src_lst.nth(i)))); - } - return new_lst; - } - }; - - - - // - // Env implementation - // - public static class Env { - Env outer = null; - HashMap<String,MalVal> data = new HashMap<String,MalVal>(); - - public Env(Env outer) { - this.outer = outer; - } - public Env(Env outer, MalList binds, MalList exprs) { - this.outer = outer; - for (Integer i=0; i<binds.size(); i++) { - String sym = ((MalSymbol)binds.nth(i)).getName(); - if (sym.equals("&")) { - data.put(((MalSymbol)binds.nth(i+1)).getName(), - exprs.slice(i)); - break; - } else { - data.put(sym, exprs.nth(i)); - } - } - } - - public Env find(String key) { - if (data.containsKey(key)) { - return this; - } else if (outer != null) { - return outer.find(key); - } else { - return null; - } - } - - public MalVal get(String key) throws MalThrowable { - Env e = find(key); - if (e == null) { - throw new MalException("'" + key + "' not found"); - } else { - return e.data.get(key); - } - } - - public Env set(String key, MalVal value) { - data.put(key, value); - return this; - } - } - - // types_ns is namespace of type functions - static Map<String, MalVal> types_ns = ImmutableMap.<String, MalVal>builder() - .put("pr-str", pr_str) - .put("str", str) - .put("prn", prn) - .put("println", println) - .put("meta", meta) - .put("with-meta", with_meta) - .put("=", equal_Q) - .put("symbol?", symbol_Q) - .put("nil?", nil_Q) - .put("true?", true_Q) - .put("false?", false_Q) - .put("<", lt) - .put("<=", lte) - .put(">", gt) - .put(">=", gte) - .put("+", add) - .put("-", subtract) - .put("*", multiply) - .put("/", divide) - .put("throw", mal_throw) - .put("list", new_list) - .put("list?", list_Q) - .put("vector", new_vector) - .put("vector?", vector_Q) - .put("hash-map", new_hash_map) - .put("map?", hash_map_Q) - .put("assoc", assoc) - .put("dissoc", dissoc) - .put("contains?", contains_Q) - .put("get", get) - .put("keys", keys) - .put("vals", vals) - .put("atom", new_atom) - .put("atom?", atom_Q) - .put("deref", deref) - .put("reset!", reset_BANG) - .put("swap!", swap_BANG) - .put("sequential?", sequential_Q) - .put("cons", cons) - .put("concat", concat) - .put("conj", conj) - .put("first", first) - .put("rest", rest) - .put("nth", nth) - .put("count", count) - .put("empty?", empty_Q) - .put("apply", apply) - .put("map", map) - .build(); } diff --git a/js/Makefile b/js/Makefile index cb57644..2b7aa88 100644 --- a/js/Makefile +++ b/js/Makefile @@ -1,7 +1,8 @@ TESTS = tests/types.js tests/reader.js tests/step5_tco.js -SOURCES = node_readline.js types.js reader.js stepA_more.js +SOURCES = node_readline.js types.js reader.js printer.js \ + env.js core.js stepA_more.js WEB_SOURCES = $(SOURCES:node_readline.js=josh_readline.js) all: mal.js mal_web.js diff --git a/js/core.js b/js/core.js new file mode 100644 index 0000000..48bbe16 --- /dev/null +++ b/js/core.js @@ -0,0 +1,193 @@ +// Node vs browser behavior +var core = {}; +if (typeof module === 'undefined') { + var exports = core; +} else { + var types = require('./types'), + printer = require('./printer'); +} + +// Errors/Exceptions +function mal_throw(exc) { throw exc; } + + +// String functions +function pr_str() { + return Array.prototype.map.call(arguments,function(exp) { + return printer._pr_str(exp, true); + }).join(" "); +} + +function str() { + return Array.prototype.map.call(arguments,function(exp) { + return printer._pr_str(exp, false); + }).join(""); +} + +function prn() { + printer.print.apply({}, Array.prototype.map.call(arguments,function(exp) { + return printer._pr_str(exp, true); + })); +} + +function println() { + printer.print.apply({}, Array.prototype.map.call(arguments,function(exp) { + return printer._pr_str(exp, false); + })); +} + + +// Hash Map functions +function assoc(src_hm) { + var hm = types._clone(src_hm); + var args = [hm].concat(Array.prototype.slice.call(arguments, 1)); + return types._assoc_BANG.apply(null, args); +} + +function dissoc(src_hm) { + var hm = types._clone(src_hm); + var args = [hm].concat(Array.prototype.slice.call(arguments, 1)); + return types._dissoc_BANG.apply(null, args); +} + +function get(hm, key) { + if (key in hm) { + return hm[key]; + } else { + return null; + } +} + +function contains_Q(hm, key) { + if (key in hm) { return true; } else { return false; } +} + +function keys(hm) { return Object.keys(hm); } +function vals(hm) { return Object.keys(hm).map(function(k) { return hm[k]; }); } + + +// Sequence functions +function cons(a, b) { return [a].concat(b); } + +function concat(lst) { + lst = lst || []; + return lst.concat.apply(lst, Array.prototype.slice.call(arguments, 1)); +} + +function nth(lst, idx) { return lst[idx]; } + +function first(lst) { return lst[0]; } + +function rest(lst) { return lst.slice(1); } + +function empty_Q(lst) { return lst.length === 0; } + +function count(s) { + if (Array.isArray(s)) { return s.length; } + else { return Object.keys(s).length; } +} + +function conj(lst) { + if (types._list_Q(lst)) { + return Array.prototype.slice.call(arguments, 1).reverse().concat(lst); + } else { + var v = lst.concat(Array.prototype.slice.call(arguments, 1)); + v.__isvector__ = true; + return v; + } +} + +function apply(f) { + var args = Array.prototype.slice.call(arguments, 1); + return f.apply(f, args.slice(0, args.length-1).concat(args[args.length-1])); +} + +function map(f, lst) { + return lst.map(function(el){ return f(el); }); +} + + +// Metadata functions +function with_meta(obj, m) { + var new_obj = types._clone(obj); + new_obj.__meta__ = m; + return new_obj; +} + +function meta(obj) { + // TODO: support symbols and atoms + if ((!types._sequential_Q(obj)) && + (!(types._hash_map_Q(obj))) && + (!(types._function_Q(obj)))) { + throw new Error("attempt to get metadata from: " + types._obj_type(obj)); + } + return obj.__meta__; +} + + +// Atom functions +function deref(atm) { return atm.val; } +function reset_BANG(atm, val) { return atm.val = val; } +function swap_BANG(atm, f) { + var args = [atm.val].concat(Array.prototype.slice.call(arguments, 2)); + atm.val = f.apply(f, args); + return atm.val; +} + + +// types.ns is namespace of type functions +var ns = {'type': types._obj_type, + '=': types._equal_Q, + 'throw': mal_throw, + 'nil?': types._nil_Q, + 'true?': types._true_Q, + 'false?': types._false_Q, + 'symbol': types._symbol, + 'symbol?': types._symbol_Q, + 'pr-str': pr_str, + 'str': str, + 'prn': prn, + 'println': println, + '<' : function(a,b){return a<b;}, + '<=' : function(a,b){return a<=b;}, + '>' : function(a,b){return a>b;}, + '>=' : function(a,b){return a>=b;}, + '+' : function(a,b){return a+b;}, + '-' : function(a,b){return a-b;}, + '*' : function(a,b){return a*b;}, + '/' : function(a,b){return a/b;}, + + 'list': types._list, + 'list?': types._list_Q, + 'vector': types._vector, + 'vector?': types._vector_Q, + 'hash-map': types._hash_map, + 'map?': types._hash_map_Q, + 'assoc': assoc, + 'dissoc': dissoc, + 'get': get, + 'contains?': contains_Q, + 'keys': keys, + 'vals': vals, + + 'sequential?': types._sequential_Q, + 'cons': cons, + 'concat': concat, + 'nth': nth, + 'first': first, + 'rest': rest, + 'empty?': empty_Q, + 'count': count, + 'conj': conj, + 'apply': apply, + 'map': map, + + 'with-meta': with_meta, + 'meta': meta, + 'atom': types._atom, + 'atom?': types._atom_Q, + "deref": deref, + "reset!": reset_BANG, + "swap!": swap_BANG}; + +exports.ns = core.ns = ns; diff --git a/js/env.js b/js/env.js new file mode 100644 index 0000000..3c9eac8 --- /dev/null +++ b/js/env.js @@ -0,0 +1,40 @@ +// Node vs browser behavior +var env = {}; +if (typeof module === 'undefined') { + var exports = env; +} + +// Env implementation +function Env(outer, binds, exprs) { + this.data = {}; + this.outer = outer || null; + + if (binds && exprs) { + // Returns a new Env with symbols in binds bound to + // corresponding values in exprs + // TODO: check types of binds and exprs and compare lengths + for (var i=0; i<binds.length;i++) { + if (binds[i].value === "&") { + // variable length arguments + this.data[binds[i+1].value] = Array.prototype.slice.call(exprs, i); + break; + } else { + this.data[binds[i].value] = exprs[i]; + } + } + } + return this; +} +Env.prototype.find = function (key) { + if (key in this.data) { return this; } + else if (this.outer) { return this.outer.find(key); } + else { return null; } +}; +Env.prototype.set = function(key, value) { this.data[key] = value; return value; }, +Env.prototype.get = function(key) { + var env = this.find(key); + if (!env) { throw new Error("'" + key + "' not found"); } + return env.data[key]; +}; + +exports.Env = env.Env = Env; diff --git a/js/printer.js b/js/printer.js new file mode 100644 index 0000000..0d84cc6 --- /dev/null +++ b/js/printer.js @@ -0,0 +1,44 @@ +// Node vs browser behavior +var printer = {}; +if (typeof module !== 'undefined') { + var types = require('./types'); + // map output/print to console.log + var print = exports.print = function () { console.log.apply(console, arguments); }; +} else { + var exports = printer; +} + +function _pr_str(obj, print_readably) { + if (typeof print_readably === 'undefined') { print_readably = true; } + var _r = print_readably; + var ot = types._obj_type(obj); + switch (ot) { + case 'list': + var ret = obj.map(function(e) { return _pr_str(e,_r); }); + return "(" + ret.join(' ') + ")"; + case 'vector': + var ret = obj.map(function(e) { return _pr_str(e,_r); }); + return "[" + ret.join(' ') + "]"; + case 'hash-map': + var ret = []; + for (var k in obj) { + ret.push(_pr_str(k,_r), _pr_str(obj[k],_r)); + } + return "{" + ret.join(' ') + "}"; + case 'string': + if (print_readably) { + return '"' + obj.replace(/\\/, "\\\\").replace(/"/g, '\\"') + '"'; + } else { + return obj; + } + case 'nil': + return "nil"; + case 'atom': + return "(atom " + _pr_str(obj.val,_r) + ")"; + default: + return obj.toString(); + } +} + +exports._pr_str = printer._pr_str = _pr_str; + diff --git a/js/reader.js b/js/reader.js index da51088..f19010d 100644 --- a/js/reader.js +++ b/js/reader.js @@ -40,7 +40,7 @@ function read_atom (reader) { } else if (token === "false") { return false; } else { - return types.symbol(token); // symbol + return types._symbol(token); // symbol } } @@ -66,13 +66,13 @@ function read_list(reader, start, end) { // read vector of tokens function read_vector(reader) { var lst = read_list(reader, '[', ']'); - return types.vector.apply(types.vector, lst); + return types._vector.apply(null, lst); } // read hash-map key/value pairs function read_hash_map(reader) { var lst = read_list(reader, '{', '}'); - return types.hash_map.apply(types.hash_map, lst); + return types._hash_map.apply(null, lst); } function read_form(reader) { @@ -81,18 +81,18 @@ function read_form(reader) { // reader macros/transforms case ';': return null; // Ignore comments case '\'': reader.next(); - return [types.symbol('quote'), read_form(reader)]; + return [types._symbol('quote'), read_form(reader)]; case '`': reader.next(); - return [types.symbol('quasiquote'), read_form(reader)]; + return [types._symbol('quasiquote'), read_form(reader)]; case '~': reader.next(); - return [types.symbol('unquote'), read_form(reader)]; + return [types._symbol('unquote'), read_form(reader)]; case '~@': reader.next(); - return [types.symbol('splice-unquote'), read_form(reader)]; + return [types._symbol('splice-unquote'), read_form(reader)]; case '^': reader.next(); var meta = read_form(reader); - return [types.symbol('with-meta'), read_form(reader), meta]; + return [types._symbol('with-meta'), read_form(reader), meta]; case '@': reader.next(); - return [types.symbol('deref'), read_form(reader)]; + return [types._symbol('deref'), read_form(reader)]; // list case ')': throw new Error("unexpected ')'"); diff --git a/js/step1_read_print.js b/js/step1_read_print.js index ee027d7..264b6c6 100644 --- a/js/step1_read_print.js +++ b/js/step1_read_print.js @@ -1,5 +1,6 @@ var types = require('./types'); var reader = require('./reader'); +var printer = require('./printer'); if (typeof module !== 'undefined') { var readline = require('./node_readline'); } @@ -16,7 +17,7 @@ function EVAL(ast, env) { // print function PRINT(exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // repl diff --git a/js/step2_eval.js b/js/step2_eval.js index f2cb8b1..f5efa2c 100644 --- a/js/step2_eval.js +++ b/js/step2_eval.js @@ -1,5 +1,6 @@ var types = require('./types'); var reader = require('./reader'); +var printer = require('./printer'); if (typeof module !== 'undefined') { var readline = require('./node_readline'); } @@ -11,15 +12,15 @@ function READ(str) { // eval function eval_ast(ast, env) { - if (types.symbol_Q(ast)) { + if (types._symbol_Q(ast)) { return env[ast]; - } else if (types.list_Q(ast)) { + } else if (types._list_Q(ast)) { return ast.map(function(a) { return EVAL(a, env); }); - } else if (types.vector_Q(ast)) { + } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; - } else if (types.hash_map_Q(ast)) { + } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[EVAL(k, env)] = EVAL(ast[k], env); @@ -31,7 +32,7 @@ function eval_ast(ast, env) { } function _EVAL(ast, env) { - if (!types.list_Q(ast)) { + if (!types._list_Q(ast)) { return eval_ast(ast, env); } @@ -47,7 +48,7 @@ function EVAL(ast, env) { // print function PRINT(exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // repl diff --git a/js/step3_env.js b/js/step3_env.js index 5b6e802..41e21c1 100644 --- a/js/step3_env.js +++ b/js/step3_env.js @@ -1,5 +1,7 @@ var types = require('./types'); var reader = require('./reader'); +var printer = require('./printer'); +var Env = require('./env').Env; if (typeof module !== 'undefined') { var readline = require('./node_readline'); } @@ -11,15 +13,15 @@ function READ(str) { // eval function eval_ast(ast, env) { - if (types.symbol_Q(ast)) { + if (types._symbol_Q(ast)) { return env.get(ast); - } else if (types.list_Q(ast)) { + } else if (types._list_Q(ast)) { return ast.map(function(a) { return EVAL(a, env); }); - } else if (types.vector_Q(ast)) { + } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; - } else if (types.hash_map_Q(ast)) { + } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[EVAL(k, env)] = EVAL(ast[k], env); @@ -31,7 +33,7 @@ function eval_ast(ast, env) { } function _EVAL(ast, env) { - if (!types.list_Q(ast)) { + if (!types._list_Q(ast)) { return eval_ast(ast, env); } @@ -42,7 +44,7 @@ function _EVAL(ast, env) { var res = EVAL(a2, env); return env.set(a1, res); case "let*": - var let_env = new types.Env(env); + var let_env = new Env(env); for (var i=0; i < a1.length; i+=2) { let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } @@ -60,11 +62,11 @@ function EVAL(ast, env) { // print function PRINT(exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // repl -var repl_env = new types.Env(); +var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; _ref = function (k,v) { repl_env.set(k, v); } diff --git a/js/step4_if_fn_do.js b/js/step4_if_fn_do.js index d33ec04..37803ef 100644 --- a/js/step4_if_fn_do.js +++ b/js/step4_if_fn_do.js @@ -1,5 +1,8 @@ var types = require('./types'); var reader = require('./reader'); +var printer = require('./printer'); +var Env = require('./env').Env; +var core = require('./core'); if (typeof module !== 'undefined') { var readline = require('./node_readline'); } @@ -11,15 +14,15 @@ function READ(str) { // eval function eval_ast(ast, env) { - if (types.symbol_Q(ast)) { + if (types._symbol_Q(ast)) { return env.get(ast); - } else if (types.list_Q(ast)) { + } else if (types._list_Q(ast)) { return ast.map(function(a) { return EVAL(a, env); }); - } else if (types.vector_Q(ast)) { + } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; - } else if (types.hash_map_Q(ast)) { + } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[EVAL(k, env)] = EVAL(ast[k], env); @@ -31,7 +34,7 @@ function eval_ast(ast, env) { } function _EVAL(ast, env) { - if (!types.list_Q(ast)) { + if (!types._list_Q(ast)) { return eval_ast(ast, env); } @@ -42,7 +45,7 @@ function _EVAL(ast, env) { var res = EVAL(a2, env); return env.set(a1, res); case "let*": - var let_env = new types.Env(env); + var let_env = new Env(env); for (var i=0; i < a1.length; i+=2) { let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } @@ -59,7 +62,7 @@ function _EVAL(ast, env) { } case "fn*": return function() { - return EVAL(a2, new types.Env(env, a1, arguments)); + return EVAL(a2, new Env(env, a1, arguments)); }; default: var el = eval_ast(ast, env), f = el[0]; @@ -74,16 +77,16 @@ function EVAL(ast, env) { // print function PRINT(exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // repl -var repl_env = new types.Env(); +var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; _ref = function (k,v) { repl_env.set(k, v); } -// Import types functions -for (var n in types.ns) { repl_env.set(n, types.ns[n]); } +// Import core functions +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } // Defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); diff --git a/js/step5_tco.js b/js/step5_tco.js index 20a9583..2d1793d 100644 --- a/js/step5_tco.js +++ b/js/step5_tco.js @@ -1,5 +1,8 @@ var types = require('./types'); var reader = require('./reader'); +var printer = require('./printer'); +var Env = require('./env').Env; +var core = require('./core'); if (typeof module !== 'undefined') { var readline = require('./node_readline'); } @@ -11,15 +14,15 @@ function READ(str) { // eval function eval_ast(ast, env) { - if (types.symbol_Q(ast)) { + if (types._symbol_Q(ast)) { return env.get(ast); - } else if (types.list_Q(ast)) { + } else if (types._list_Q(ast)) { return ast.map(function(a) { return EVAL(a, env); }); - } else if (types.vector_Q(ast)) { + } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; - } else if (types.hash_map_Q(ast)) { + } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[EVAL(k, env)] = EVAL(ast[k], env); @@ -32,45 +35,48 @@ function eval_ast(ast, env) { function _EVAL(ast, env) { while (true) { - if (!types.list_Q(ast)) { - return eval_ast(ast, env); + + //console.log("EVAL:", types._pr_str(ast, true)); + if (!types._list_Q(ast)) { + return eval_ast(ast, env); + } + + // apply list + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + return env.set(a1, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } - - // apply list - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new types.Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); - } - return EVAL(a2, let_env); - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types.new_function(EVAL, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; - if (meta && meta.exp) { - ast = meta.exp; - env = new types.Env(meta.env, meta.params, el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } + return EVAL(a2, let_env); + case "do": + eval_ast(ast.slice(1, -1), env); + ast = ast[ast.length-1]; + break; + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + ast = (typeof a3 !== "undefined") ? a3 : null; + } else { + ast = a2; } + break; + case "fn*": + return types._function(EVAL, Env, a2, env, a1); + default: + var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; + if (meta && meta.exp) { + ast = meta.exp; + env = new Env(meta.env, meta.params, el.slice(1)); + } else { + return f.apply(f, el.slice(1)); + } + } + } } @@ -81,16 +87,16 @@ function EVAL(ast, env) { // print function PRINT(exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // repl -var repl_env = new types.Env(); +var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; _ref = function (k,v) { repl_env.set(k, v); } -// Import types functions -for (var n in types.ns) { repl_env.set(n, types.ns[n]); } +// Import core functions +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } // Defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); diff --git a/js/step6_file.js b/js/step6_file.js index 6a014eb..df216da 100644 --- a/js/step6_file.js +++ b/js/step6_file.js @@ -1,5 +1,8 @@ var types = require('./types'); var reader = require('./reader'); +var printer = require('./printer'); +var Env = require('./env').Env; +var core = require('./core'); if (typeof module !== 'undefined') { var readline = require('./node_readline'); } @@ -11,15 +14,15 @@ function READ(str) { // eval function eval_ast(ast, env) { - if (types.symbol_Q(ast)) { + if (types._symbol_Q(ast)) { return env.get(ast); - } else if (types.list_Q(ast)) { + } else if (types._list_Q(ast)) { return ast.map(function(a) { return EVAL(a, env); }); - } else if (types.vector_Q(ast)) { + } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; - } else if (types.hash_map_Q(ast)) { + } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[EVAL(k, env)] = EVAL(ast[k], env); @@ -32,45 +35,48 @@ function eval_ast(ast, env) { function _EVAL(ast, env) { while (true) { - if (!types.list_Q(ast)) { - return eval_ast(ast, env); + + //console.log("EVAL:", types._pr_str(ast, true)); + if (!types._list_Q(ast)) { + return eval_ast(ast, env); + } + + // apply list + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + return env.set(a1, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } - - // apply list - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new types.Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); - } - return EVAL(a2, let_env); - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types.new_function(EVAL, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; - if (meta && meta.exp) { - ast = meta.exp; - env = new types.Env(meta.env, meta.params, el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } + return EVAL(a2, let_env); + case "do": + eval_ast(ast.slice(1, -1), env); + ast = ast[ast.length-1]; + break; + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + ast = (typeof a3 !== "undefined") ? a3 : null; + } else { + ast = a2; } + break; + case "fn*": + return types._function(EVAL, Env, a2, env, a1); + default: + var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; + if (meta && meta.exp) { + ast = meta.exp; + env = new Env(meta.env, meta.params, el.slice(1)); + } else { + return f.apply(f, el.slice(1)); + } + } + } } @@ -81,16 +87,16 @@ function EVAL(ast, env) { // print function PRINT(exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // repl -var repl_env = new types.Env(); +var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; _ref = function (k,v) { repl_env.set(k, v); } -// Import types functions -for (var n in types.ns) { repl_env.set(n, types.ns[n]); } +// Import core functions +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } _ref('read-string', reader.read_str); _ref('eval', function(ast) { return EVAL(ast, repl_env); }); diff --git a/js/step7_quote.js b/js/step7_quote.js index 6d23595..9721d59 100644 --- a/js/step7_quote.js +++ b/js/step7_quote.js @@ -1,5 +1,8 @@ var types = require('./types'); var reader = require('./reader'); +var printer = require('./printer'); +var Env = require('./env').Env; +var core = require('./core'); if (typeof module !== 'undefined') { var readline = require('./node_readline'); } @@ -11,31 +14,31 @@ function READ(str) { // eval function is_pair(x) { - return types.sequential_Q(x) && x.length > 0; + return types._sequential_Q(x) && x.length > 0; } function quasiquote(ast) { if (!is_pair(ast)) { - return [types.symbol("quote"), ast]; + return [types._symbol("quote"), ast]; } else if (ast[0].value === 'unquote') { return ast[1]; } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types.symbol("concat"), ast[0][1], quasiquote(ast.slice(1))]; + return [types._symbol("concat"), ast[0][1], quasiquote(ast.slice(1))]; } else { - return [types.symbol("cons"), quasiquote(ast[0]), quasiquote(ast.slice(1))]; + return [types._symbol("cons"), quasiquote(ast[0]), quasiquote(ast.slice(1))]; } } function eval_ast(ast, env) { - if (types.symbol_Q(ast)) { + if (types._symbol_Q(ast)) { return env.get(ast); - } else if (types.list_Q(ast)) { + } else if (types._list_Q(ast)) { return ast.map(function(a) { return EVAL(a, env); }); - } else if (types.vector_Q(ast)) { + } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; - } else if (types.hash_map_Q(ast)) { + } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[EVAL(k, env)] = EVAL(ast[k], env); @@ -48,50 +51,52 @@ function eval_ast(ast, env) { function _EVAL(ast, env) { while (true) { - //console.log("EVAL:", types._pr_str(ast, true)); - if (!types.list_Q(ast)) { - return eval_ast(ast, env); + + //console.log("EVAL:", types._pr_str(ast, true)); + if (!types._list_Q(ast)) { + return eval_ast(ast, env); + } + + // apply list + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + return env.set(a1, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } - - // apply list - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new types.Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); - } - return EVAL(a2, let_env); - case "quote": - return a1; - case "quasiquote": - return EVAL(quasiquote(a1), env); - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types.new_function(EVAL, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; - if (meta && meta.exp) { - ast = meta.exp; - env = new types.Env(meta.env, meta.params, el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } + return EVAL(a2, let_env); + case "quote": + return a1; + case "quasiquote": + return EVAL(quasiquote(a1), env); + case "do": + eval_ast(ast.slice(1, -1), env); + ast = ast[ast.length-1]; + break; + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + ast = (typeof a3 !== "undefined") ? a3 : null; + } else { + ast = a2; } + break; + case "fn*": + return types._function(EVAL, Env, a2, env, a1); + default: + var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; + if (meta && meta.exp) { + ast = meta.exp; + env = new Env(meta.env, meta.params, el.slice(1)); + } else { + return f.apply(f, el.slice(1)); + } + } + } } @@ -102,16 +107,16 @@ function EVAL(ast, env) { // print function PRINT(exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // repl -var repl_env = new types.Env(); +var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; _ref = function (k,v) { repl_env.set(k, v); } -// Import types functions -for (var n in types.ns) { repl_env.set(n, types.ns[n]); } +// Import core functions +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } _ref('read-string', reader.read_str); _ref('eval', function(ast) { return EVAL(ast, repl_env); }); diff --git a/js/step8_macros.js b/js/step8_macros.js index 65d7a87..3ad3e31 100644 --- a/js/step8_macros.js +++ b/js/step8_macros.js @@ -1,5 +1,8 @@ var types = require('./types'); var reader = require('./reader'); +var printer = require('./printer'); +var Env = require('./env').Env; +var core = require('./core'); if (typeof module !== 'undefined') { var readline = require('./node_readline'); } @@ -11,24 +14,24 @@ function READ(str) { // eval function is_pair(x) { - return types.sequential_Q(x) && x.length > 0; + return types._sequential_Q(x) && x.length > 0; } function quasiquote(ast) { if (!is_pair(ast)) { - return [types.symbol("quote"), ast]; + return [types._symbol("quote"), ast]; } else if (ast[0].value === 'unquote') { return ast[1]; } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types.symbol("concat"), ast[0][1], quasiquote(ast.slice(1))]; + return [types._symbol("concat"), ast[0][1], quasiquote(ast.slice(1))]; } else { - return [types.symbol("cons"), quasiquote(ast[0]), quasiquote(ast.slice(1))]; + return [types._symbol("cons"), quasiquote(ast[0]), quasiquote(ast.slice(1))]; } } function is_macro_call(ast, env) { - return types.list_Q(ast) && - types.symbol_Q(ast[0]) && + return types._list_Q(ast) && + types._symbol_Q(ast[0]) && env.find(ast[0].value) && env.get(ast[0].value)._ismacro_; } @@ -42,15 +45,15 @@ function macroexpand(ast, env) { } function eval_ast(ast, env) { - if (types.symbol_Q(ast)) { + if (types._symbol_Q(ast)) { return env.get(ast); - } else if (types.list_Q(ast)) { + } else if (types._list_Q(ast)) { return ast.map(function(a) { return EVAL(a, env); }); - } else if (types.vector_Q(ast)) { + } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; - } else if (types.hash_map_Q(ast)) { + } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[EVAL(k, env)] = EVAL(ast[k], env); @@ -63,59 +66,61 @@ function eval_ast(ast, env) { function _EVAL(ast, env) { while (true) { - //console.log("EVAL:", types._pr_str(ast, true)); - if (!types.list_Q(ast)) { - return eval_ast(ast, env); + + //console.log("EVAL:", types._pr_str(ast, true)); + if (!types._list_Q(ast)) { + return eval_ast(ast, env); + } + + // apply list + ast = macroexpand(ast, env); + if (!types._list_Q(ast)) { return ast; } + + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + return env.set(a1, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } - - // apply list - ast = macroexpand(ast, env); - if (!types.list_Q(ast)) { return ast; } - - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new types.Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); - } - return EVAL(a2, let_env); - case "quote": - return a1; - case "quasiquote": - return EVAL(quasiquote(a1), env); - case 'defmacro!': - var func = EVAL(a2, env); - func._ismacro_ = true; - return env.set(a1, func); - case 'macroexpand': - return macroexpand(a1, env); - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types.new_function(EVAL, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; - if (meta && meta.exp) { - ast = meta.exp; - env = new types.Env(meta.env, meta.params, el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } + return EVAL(a2, let_env); + case "quote": + return a1; + case "quasiquote": + return EVAL(quasiquote(a1), env); + case 'defmacro!': + var func = EVAL(a2, env); + func._ismacro_ = true; + return env.set(a1, func); + case 'macroexpand': + return macroexpand(a1, env); + case "do": + eval_ast(ast.slice(1, -1), env); + ast = ast[ast.length-1]; + break; + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + ast = (typeof a3 !== "undefined") ? a3 : null; + } else { + ast = a2; } + break; + case "fn*": + return types._function(EVAL, Env, a2, env, a1); + default: + var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; + if (meta && meta.exp) { + ast = meta.exp; + env = new Env(meta.env, meta.params, el.slice(1)); + } else { + return f.apply(f, el.slice(1)); + } + } + } } @@ -126,16 +131,16 @@ function EVAL(ast, env) { // print function PRINT(exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // repl -var repl_env = new types.Env(); +var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; _ref = function (k,v) { repl_env.set(k, v); } -// Import types functions -for (var n in types.ns) { repl_env.set(n, types.ns[n]); } +// Import core functions +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } _ref('read-string', reader.read_str); _ref('eval', function(ast) { return EVAL(ast, repl_env); }); diff --git a/js/step9_interop.js b/js/step9_interop.js index bfc01cb..3c83e51 100644 --- a/js/step9_interop.js +++ b/js/step9_interop.js @@ -1,5 +1,8 @@ var types = require('./types'); var reader = require('./reader'); +var printer = require('./printer'); +var Env = require('./env').Env; +var core = require('./core'); if (typeof module !== 'undefined') { var readline = require('./node_readline'); } @@ -11,24 +14,24 @@ function READ(str) { // eval function is_pair(x) { - return types.sequential_Q(x) && x.length > 0; + return types._sequential_Q(x) && x.length > 0; } function quasiquote(ast) { if (!is_pair(ast)) { - return [types.symbol("quote"), ast]; + return [types._symbol("quote"), ast]; } else if (ast[0].value === 'unquote') { return ast[1]; } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types.symbol("concat"), ast[0][1], quasiquote(ast.slice(1))]; + return [types._symbol("concat"), ast[0][1], quasiquote(ast.slice(1))]; } else { - return [types.symbol("cons"), quasiquote(ast[0]), quasiquote(ast.slice(1))]; + return [types._symbol("cons"), quasiquote(ast[0]), quasiquote(ast.slice(1))]; } } function is_macro_call(ast, env) { - return types.list_Q(ast) && - types.symbol_Q(ast[0]) && + return types._list_Q(ast) && + types._symbol_Q(ast[0]) && env.find(ast[0].value) && env.get(ast[0].value)._ismacro_; } @@ -42,15 +45,15 @@ function macroexpand(ast, env) { } function eval_ast(ast, env) { - if (types.symbol_Q(ast)) { + if (types._symbol_Q(ast)) { return env.get(ast); - } else if (types.list_Q(ast)) { + } else if (types._list_Q(ast)) { return ast.map(function(a) { return EVAL(a, env); }); - } else if (types.vector_Q(ast)) { + } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; - } else if (types.hash_map_Q(ast)) { + } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[EVAL(k, env)] = EVAL(ast[k], env); @@ -63,65 +66,67 @@ function eval_ast(ast, env) { function _EVAL(ast, env) { while (true) { - //console.log("EVAL:", types._pr_str(ast, true)); - if (!types.list_Q(ast)) { - return eval_ast(ast, env); + + //console.log("EVAL:", types._pr_str(ast, true)); + if (!types._list_Q(ast)) { + return eval_ast(ast, env); + } + + // apply list + ast = macroexpand(ast, env); + if (!types._list_Q(ast)) { return ast; } + + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + return env.set(a1, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } - - // apply list - ast = macroexpand(ast, env); - if (!types.list_Q(ast)) { return ast; } - - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new types.Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); - } - return EVAL(a2, let_env); - case "quote": - return a1; - case "quasiquote": - return EVAL(quasiquote(a1), env); - case 'defmacro!': - var func = EVAL(a2, env); - func._ismacro_ = true; - return env.set(a1, func); - case 'macroexpand': - return macroexpand(a1, env); - case "js*": - return eval(a1.toString()); - case ".": - var el = eval_ast(ast.slice(2), env), - f = eval(a1.toString()); - return f.apply(f, el); - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types.new_function(EVAL, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; - if (meta && meta.exp) { - ast = meta.exp; - env = new types.Env(meta.env, meta.params, el.slice(1)); - } else { - return f.apply(f, el.slice(1)); - } + return EVAL(a2, let_env); + case "quote": + return a1; + case "quasiquote": + return EVAL(quasiquote(a1), env); + case 'defmacro!': + var func = EVAL(a2, env); + func._ismacro_ = true; + return env.set(a1, func); + case 'macroexpand': + return macroexpand(a1, env); + case "js*": + return eval(a1.toString()); + case ".": + var el = eval_ast(ast.slice(2), env), + f = eval(a1.toString()); + return f.apply(f, el); + case "do": + eval_ast(ast.slice(1, -1), env); + ast = ast[ast.length-1]; + break; + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + ast = (typeof a3 !== "undefined") ? a3 : null; + } else { + ast = a2; } + break; + case "fn*": + return types._function(EVAL, Env, a2, env, a1); + default: + var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; + if (meta && meta.exp) { + ast = meta.exp; + env = new Env(meta.env, meta.params, el.slice(1)); + } else { + return f.apply(f, el.slice(1)); + } + } + } } @@ -132,16 +137,16 @@ function EVAL(ast, env) { // print function PRINT(exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // repl -var repl_env = new types.Env(); +var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; _ref = function (k,v) { repl_env.set(k, v); } -// Import types functions -for (var n in types.ns) { repl_env.set(n, types.ns[n]); } +// Import core functions +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } _ref('read-string', reader.read_str); _ref('eval', function(ast) { return EVAL(ast, repl_env); }); diff --git a/js/stepA_more.js b/js/stepA_more.js index 2778649..a4e1bda 100644 --- a/js/stepA_more.js +++ b/js/stepA_more.js @@ -1,5 +1,8 @@ var types = require('./types'); var reader = require('./reader'); +var printer = require('./printer'); +var Env = require('./env').Env; +var core = require('./core'); if (typeof module !== 'undefined') { var readline = require('./node_readline'); } @@ -11,24 +14,24 @@ function READ(str) { // eval function is_pair(x) { - return types.sequential_Q(x) && x.length > 0; + return types._sequential_Q(x) && x.length > 0; } function quasiquote(ast) { if (!is_pair(ast)) { - return [types.symbol("quote"), ast]; + return [types._symbol("quote"), ast]; } else if (ast[0].value === 'unquote') { return ast[1]; } else if (is_pair(ast[0]) && ast[0][0].value === 'splice-unquote') { - return [types.symbol("concat"), ast[0][1], quasiquote(ast.slice(1))]; + return [types._symbol("concat"), ast[0][1], quasiquote(ast.slice(1))]; } else { - return [types.symbol("cons"), quasiquote(ast[0]), quasiquote(ast.slice(1))]; + return [types._symbol("cons"), quasiquote(ast[0]), quasiquote(ast.slice(1))]; } } function is_macro_call(ast, env) { - return types.list_Q(ast) && - types.symbol_Q(ast[0]) && + return types._list_Q(ast) && + types._symbol_Q(ast[0]) && env.find(ast[0].value) && env.get(ast[0].value)._ismacro_; } @@ -42,15 +45,15 @@ function macroexpand(ast, env) { } function eval_ast(ast, env) { - if (types.symbol_Q(ast)) { + if (types._symbol_Q(ast)) { return env.get(ast); - } else if (types.list_Q(ast)) { + } else if (types._list_Q(ast)) { return ast.map(function(a) { return EVAL(a, env); }); - } else if (types.vector_Q(ast)) { + } else if (types._vector_Q(ast)) { var v = ast.map(function(a) { return EVAL(a, env); }); v.__isvector__ = true; return v; - } else if (types.hash_map_Q(ast)) { + } else if (types._hash_map_Q(ast)) { var new_hm = {}; for (k in ast) { new_hm[EVAL(k, env)] = EVAL(ast[k], env); @@ -63,76 +66,78 @@ function eval_ast(ast, env) { function _EVAL(ast, env) { while (true) { - //console.log("EVAL:", types._pr_str(ast, true)); - if (!types.list_Q(ast)) { - return eval_ast(ast, env); + + //console.log("EVAL:", types._pr_str(ast, true)); + if (!types._list_Q(ast)) { + return eval_ast(ast, env); + } + + // apply list + ast = macroexpand(ast, env); + if (!types._list_Q(ast)) { return ast; } + + var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; + switch (a0.value) { + case "def!": + var res = EVAL(a2, env); + return env.set(a1, res); + case "let*": + var let_env = new Env(env); + for (var i=0; i < a1.length; i+=2) { + let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); } - - // apply list - ast = macroexpand(ast, env); - if (!types.list_Q(ast)) { return ast; } - - var a0 = ast[0], a1 = ast[1], a2 = ast[2], a3 = ast[3]; - switch (a0.value) { - case "def!": - var res = EVAL(a2, env); - return env.set(a1, res); - case "let*": - var let_env = new types.Env(env); - for (var i=0; i < a1.length; i+=2) { - let_env.set(a1[i].value, EVAL(a1[i+1], let_env)); - } - return EVAL(a2, let_env); - case "quote": - return a1; - case "quasiquote": - return EVAL(quasiquote(a1), env); - case 'defmacro!': - var func = EVAL(a2, env); - func._ismacro_ = true; - return env.set(a1, func); - case 'macroexpand': - return macroexpand(a1, env); - case "js*": - return eval(a1.toString()); - case ".": - var el = eval_ast(ast.slice(2), env), - f = eval(a1.toString()); - return f.apply(f, el); - case "try*": - try { - return EVAL(a1, env); - } catch (exc) { - if (a2 && a2[0].value === "catch*") { - if (exc instanceof Error) { exc = exc.message; } - return EVAL(a2[2], new types.Env(env, [a2[1]], [exc])); - } else { - throw exc; - } - } - case "do": - eval_ast(ast.slice(1, -1), env); - ast = ast[ast.length-1]; - break; - case "if": - var cond = EVAL(a1, env); - if (cond === null || cond === false) { - ast = (typeof a3 !== "undefined") ? a3 : null; - } else { - ast = a2; - } - break; - case "fn*": - return types.new_function(EVAL, a2, env, a1); - default: - var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; - if (meta && meta.exp) { - ast = meta.exp; - env = new types.Env(meta.env, meta.params, el.slice(1)); + return EVAL(a2, let_env); + case "quote": + return a1; + case "quasiquote": + return EVAL(quasiquote(a1), env); + case 'defmacro!': + var func = EVAL(a2, env); + func._ismacro_ = true; + return env.set(a1, func); + case 'macroexpand': + return macroexpand(a1, env); + case "js*": + return eval(a1.toString()); + case ".": + var el = eval_ast(ast.slice(2), env), + f = eval(a1.toString()); + return f.apply(f, el); + case "try*": + try { + return EVAL(a1, env); + } catch (exc) { + if (a2 && a2[0].value === "catch*") { + if (exc instanceof Error) { exc = exc.message; } + return EVAL(a2[2], new Env(env, [a2[1]], [exc])); } else { - return f.apply(f, el.slice(1)); + throw exc; } } + case "do": + eval_ast(ast.slice(1, -1), env); + ast = ast[ast.length-1]; + break; + case "if": + var cond = EVAL(a1, env); + if (cond === null || cond === false) { + ast = (typeof a3 !== "undefined") ? a3 : null; + } else { + ast = a2; + } + break; + case "fn*": + return types._function(EVAL, Env, a2, env, a1); + default: + var el = eval_ast(ast, env), f = el[0], meta = f.__meta__; + if (meta && meta.exp) { + ast = meta.exp; + env = new Env(meta.env, meta.params, el.slice(1)); + } else { + return f.apply(f, el.slice(1)); + } + } + } } @@ -143,16 +148,16 @@ function EVAL(ast, env) { // print function PRINT(exp) { - return types._pr_str(exp, true); + return printer._pr_str(exp, true); } // repl -var repl_env = new types.Env(); +var repl_env = new Env(); var rep = function(str) { return PRINT(EVAL(READ(str), repl_env)); }; _ref = function (k,v) { repl_env.set(k, v); } -// Import types functions -for (var n in types.ns) { repl_env.set(n, types.ns[n]); } +// Import core functions +for (var n in core.ns) { repl_env.set(n, core.ns[n]); } _ref('readline', readline.readline) _ref('read-string', reader.read_str); diff --git a/js/types.js b/js/types.js index 18fad0a..7fd2962 100644 --- a/js/types.js +++ b/js/types.js @@ -7,59 +7,17 @@ if (typeof module === 'undefined') { var print = exports.print = function () { console.log.apply(console, arguments); }; } -// General utility functions - -// Clone a function -Function.prototype.clone = function() { - var that = this; - var temp = function () { return that.apply(this, arguments); }; - for( key in this ) { - temp[key] = this[key]; - } - return temp; -}; - -function _clone (obj) { - var new_obj; - switch (obj_type(obj)) { - case 'list': - new_obj = obj.slice(0); - break; - case 'vector': - new_obj = obj.slice(0); - new_obj.__isvector__ = true; - break; - case 'hash-map': - new_obj = {}; - for (var k in obj) { - if (obj.hasOwnProperty(k)) { new_obj[k] = obj[k]; } - } - break; - case 'function': - new_obj = obj.clone(); - break; - default: - throw new Error("clone of non-collection: " + obj_type(obj)); - } - return new_obj; -} - - - - -function nil_Q(a) { return a === null ? true : false; } -function true_Q(a) { return a === true ? true : false; } -function false_Q(a) { return a === false ? true : false; } - -function obj_type(obj) { - if (symbol_Q(obj)) { return 'symbol'; } - else if (list_Q(obj)) { return 'list'; } - else if (vector_Q(obj)) { return 'vector'; } - else if (hash_map_Q(obj)) { return 'hash-map'; } - else if (nil_Q(obj)) { return 'nil'; } - else if (true_Q(obj)) { return 'true'; } - else if (false_Q(obj)) { return 'false'; } - else if (atom_Q(obj)) { return 'atom'; } +// General fucnctions + +function _obj_type(obj) { + if (_symbol_Q(obj)) { return 'symbol'; } + else if (_list_Q(obj)) { return 'list'; } + else if (_vector_Q(obj)) { return 'vector'; } + else if (_hash_map_Q(obj)) { return 'hash-map'; } + else if (_nil_Q(obj)) { return 'nil'; } + else if (_true_Q(obj)) { return 'true'; } + else if (_false_Q(obj)) { return 'false'; } + else if (_atom_Q(obj)) { return 'atom'; } else { switch (typeof(obj)) { case 'number': return 'number'; @@ -70,82 +28,12 @@ function obj_type(obj) { } } -function _pr_str(obj, print_readably) { - if (typeof print_readably === 'undefined') { print_readably = true; } - var _r = print_readably; - var ot = obj_type(obj); - switch (ot) { - case 'list': - var ret = obj.map(function(e) { return _pr_str(e,_r); }); - return "(" + ret.join(' ') + ")"; - case 'vector': - var ret = obj.map(function(e) { return _pr_str(e,_r); }); - return "[" + ret.join(' ') + "]"; - case 'hash-map': - var ret = []; - for (var k in obj) { - ret.push(_pr_str(k,_r), _pr_str(obj[k],_r)); - } - return "{" + ret.join(' ') + "}"; - case 'string': - if (print_readably) { - return '"' + obj.replace(/\\/, "\\\\").replace(/"/g, '\\"') + '"'; - } else { - return obj; - } - case 'nil': - return "nil"; - case 'atom': - return "(atom " + _pr_str(obj.val,_r) + ")"; - default: - return obj.toString(); - } -} - -function pr_str() { - return Array.prototype.map.call(arguments,function(exp) { - return _pr_str(exp, true); - }).join(" "); -} - -function str() { - return Array.prototype.map.call(arguments,function(exp) { - return _pr_str(exp, false); - }).join(""); -} - -function prn() { - print.apply({}, Array.prototype.map.call(arguments,function(exp) { - return _pr_str(exp, true); - })); -} - -function println() { - print.apply({}, Array.prototype.map.call(arguments,function(exp) { - return _pr_str(exp, false); - })); -} - -function with_meta(obj, m) { - var new_obj = _clone(obj); - new_obj.__meta__ = m; - return new_obj; -} - -function meta(obj) { - // TODO: support symbols and atoms - if ((!sequential_Q(obj)) && - (!(hash_map_Q(obj))) && - (!(function_Q(obj)))) { - throw new Error("attempt to get metadata from: " + obj_type(obj)); - } - return obj.__meta__; -} +function _sequential_Q(lst) { return _list_Q(lst) || _vector_Q(lst); } -function equal_Q (a, b) { - var ota = obj_type(a), otb = obj_type(b); - if (!(ota === otb || (sequential_Q(a) && sequential_Q(b)))) { +function _equal_Q (a, b) { + var ota = _obj_type(a), otb = _obj_type(b); + if (!(ota === otb || (_sequential_Q(a) && _sequential_Q(b)))) { return false; } switch (ota) { @@ -154,7 +42,7 @@ function equal_Q (a, b) { case 'vector': if (a.length !== b.length) { return false; } for (var i=0; i<a.length; i++) { - if (! equal_Q(a[i], b[i])) { return false; } + if (! _equal_Q(a[i], b[i])) { return false; } } return true; case 'hash-map': @@ -172,6 +60,37 @@ function equal_Q (a, b) { } +function _clone (obj) { + var new_obj; + switch (_obj_type(obj)) { + case 'list': + new_obj = obj.slice(0); + break; + case 'vector': + new_obj = obj.slice(0); + new_obj.__isvector__ = true; + break; + case 'hash-map': + new_obj = {}; + for (var k in obj) { + if (obj.hasOwnProperty(k)) { new_obj[k] = obj[k]; } + } + break; + case 'function': + new_obj = obj.clone(); + break; + default: + throw new Error("clone of non-collection: " + _obj_type(obj)); + } + return new_obj; +} + + +// Scalars +function _nil_Q(a) { return a === null ? true : false; } +function _true_Q(a) { return a === true ? true : false; } +function _false_Q(a) { return a === false ? true : false; } + // Symbols function Symbol(name) { @@ -179,68 +98,61 @@ function Symbol(name) { return this; } Symbol.prototype.toString = function() { return this.value; } - -function symbol(name) { return new Symbol(name); } - -function symbol_Q(obj) { return obj instanceof Symbol; } +function _symbol(name) { return new Symbol(name); } +function _symbol_Q(obj) { return obj instanceof Symbol; } // Functions -function new_function(func, exp, env, params) { +function _function(Eval, Env, exp, env, params) { var f = function() { // TODO: figure out why this throws with 'and' macro //throw new Error("Attempt to invoke mal function directly"); - return func(exp, new Env(env, params, arguments)); + return Eval(exp, new Env(env, params, arguments)); }; f.__meta__ = {exp: exp, env: env, params: params}; return f; - } -function function_Q(f) { return typeof f == "function"; } - +function _function_Q(obj) { return typeof obj == "function"; } +Function.prototype.clone = function() { + var that = this; + var temp = function () { return that.apply(this, arguments); }; + for( key in this ) { + temp[key] = this[key]; + } + return temp; +}; -// Errors/Exceptions -function mal_throw(exc) { throw exc; } +// Lists +function _list() { return Array.prototype.slice.call(arguments, 0); } +function _list_Q(obj) { return Array.isArray(obj) && !obj.__isvector__; } // Vectors -function vector() { +function _vector() { var v = Array.prototype.slice.call(arguments, 0); v.__isvector__ = true; return v; } +function _vector_Q(obj) { return Array.isArray(obj) && obj.__isvector__; } -function vector_Q(v) { return Array.isArray(v) && v.__isvector__; } - - -// Lists - -function list() { - return Array.prototype.slice.call(arguments, 0); -} - -function list_Q(lst) { return Array.isArray(lst) && !lst.__isvector__; } // Hash Maps - -function hash_map() { +function _hash_map() { if (arguments.length % 2 === 1) { throw new Error("Odd number of hash map arguments"); } var args = [{}].concat(Array.prototype.slice.call(arguments, 0)); - return assoc_BANG.apply(null, args); + return _assoc_BANG.apply(null, args); } - -function hash_map_Q(hm) { +function _hash_map_Q(hm) { return typeof hm === "object" && !Array.isArray(hm) && - !(hm === null) && + !(hm === null) && !(hm instanceof Atom); } - -function assoc_BANG(hm) { +function _assoc_BANG(hm) { if (arguments.length % 2 !== 1) { throw new Error("Odd number of assoc arguments"); } @@ -258,14 +170,7 @@ function assoc_BANG(hm) { } return hm; } - -function assoc(src_hm) { - var hm = _clone(src_hm); - var args = [hm].concat(Array.prototype.slice.call(arguments, 1)); - return assoc_BANG.apply(null, args); -} - -function dissoc_BANG(hm) { +function _dissoc_BANG(hm) { for (var i=1; i<arguments.length; i++) { var ktoken = arguments[i]; delete hm[ktoken]; @@ -273,166 +178,32 @@ function dissoc_BANG(hm) { return hm; } -function dissoc(src_hm) { - var hm = _clone(src_hm); - var args = [hm].concat(Array.prototype.slice.call(arguments, 1)); - return dissoc_BANG.apply(null, args); -} - -function get(hm, key) { - if (key in hm) { - return hm[key]; - } else { - return null; - } -} - -function contains_Q(hm, key) { - if (key in hm) { return true; } else { return false; } -} - -function keys(hm) { return Object.keys(hm); } -function vals(hm) { return Object.keys(hm).map(function(k) { return hm[k]; }); } - // Atoms function Atom(val) { this.val = val; } -function atom(val) { return new Atom(val); } -function atom_Q(atm) { return atm instanceof Atom; } -function deref(atm) { return atm.val; } -function reset_BANG(atm, val) { return atm.val = val; } -function swap_BANG(atm, f) { - var args = [atm.val].concat(Array.prototype.slice.call(arguments, 2)); - atm.val = f.apply(f, args); - return atm.val; -} - - -// Sequence operations -function sequential_Q(lst) { return list_Q(lst) || vector_Q(lst); } - -function nth(lst, idx) { return lst[idx]; } - -function count(s) { - if (Array.isArray(s)) { return s.length; } - else { return Object.keys(s).length; } -} - -function empty_Q(lst) { return lst.length === 0; } - -function cons(a, b) { return [a].concat(b); } - -function concat(lst) { - lst = lst || []; - return lst.concat.apply(lst, Array.prototype.slice.call(arguments, 1)); -} - -function conj(lst) { - if (list_Q(lst)) { - return Array.prototype.slice.call(arguments, 1).reverse().concat(lst); - } else { - var v = lst.concat(Array.prototype.slice.call(arguments, 1)); - v.__isvector__ = true; - return v; - } -} - -function first(lst) { return lst[0]; } - -function rest(lst) { return lst.slice(1); } - - - -// General list related functions -function apply(f) { - var args = Array.prototype.slice.call(arguments, 1); - return f.apply(f, args.slice(0, args.length-1).concat(args[args.length-1])); -} - -function map(f, lst) { - return lst.map(function(el){ return f(el); }); -} - - -// Env implementation -function Env(outer, binds, exprs) { - this.data = {}; - this.outer = outer || null; - - if (binds && exprs) { - // Returns a new Env with symbols in binds bound to - // corresponding values in exprs - // TODO: check types of binds and exprs and compare lengths - for (var i=0; i<binds.length;i++) { - if (binds[i].value === "&") { - // variable length arguments - this.data[binds[i+1].value] = Array.prototype.slice.call(exprs, i); - break; - } else { - this.data[binds[i].value] = exprs[i]; - } - } - } - return this; -} -Env.prototype.find = function (key) { - if (key in this.data) { return this; } - else if (this.outer) { return this.outer.find(key); } - else { return null; } -}; -Env.prototype.set = function(key, value) { this.data[key] = value; return value; }, -Env.prototype.get = function(key) { - var env = this.find(key); - if (!env) { throw new Error("'" + key + "' not found"); } - return env.data[key]; -}; - -// types.ns is namespace of type functions -var ns = {'pr-str': pr_str, 'str': str, 'prn': prn, 'println': println, - 'with-meta': with_meta, 'meta': meta, - type: obj_type, '=': equal_Q, - symbol: symbol, 'symbol?': symbol_Q, - 'nil?': nil_Q, 'true?': true_Q, 'false?': false_Q, - '<' : function(a,b){return a<b;}, - '<=' : function(a,b){return a<=b;}, - '>' : function(a,b){return a>b;}, - '>=' : function(a,b){return a>=b;}, - '+' : function(a,b){return a+b;}, - '-' : function(a,b){return a-b;}, - '*' : function(a,b){return a*b;}, - '/' : function(a,b){return a/b;}, - 'throw': mal_throw, - 'list': list, 'list?': list_Q, - 'vector': vector, 'vector?': vector_Q, - 'hash-map': hash_map, 'map?': hash_map_Q, - 'assoc': assoc, 'dissoc': dissoc, 'get': get, - 'contains?': contains_Q, 'keys': keys, 'vals': vals, - 'atom': atom, 'atom?': atom_Q, - "deref": deref, "reset!": reset_BANG, "swap!": swap_BANG, - 'sequential?': sequential_Q, 'cons': cons, 'nth': nth, - 'empty?': empty_Q, 'count': count, 'concat': concat, - 'conj': conj, 'first': first, 'rest': rest, - 'apply': apply, 'map': map}; - -exports.ns = types.ns = ns; -exports._pr_str = types._pr_str = _pr_str; -exports.prn = types.prn = prn; -exports.Env = types.Env = Env; - -exports.symbol = types.symbol = symbol; -exports.symbol_Q = types.symbol_Q = symbol_Q; -exports.hash_map = types.hash_map = hash_map; -exports.hash_map_Q = types.hash_map_Q = hash_map_Q; -exports.new_function = types.new_function = new_function; -exports.list = types.list = list; -exports.list_Q = types.list_Q = list_Q; -exports.vector = types.vector = vector; -exports.vector_Q = types.vector_Q = vector_Q; - -exports.sequential_Q = types.sequential_Q = sequential_Q; -exports.cons = types.cons = cons; -exports.concat = types.concat = concat; -exports.first = types.first = first; -exports.rest = types.rest = rest; -exports.apply = types.apply = apply; -exports.map = types.map = map; +function _atom(val) { return new Atom(val); } +function _atom_Q(atm) { return atm instanceof Atom; } + + +// Exports +exports._obj_type = types._obj_type = _obj_type; +exports._sequential_Q = types._sequential_Q = _sequential_Q; +exports._equal_Q = types._equal_Q = _equal_Q; +exports._clone = types._clone = _clone; +exports._nil_Q = types._nil_Q = _nil_Q; +exports._true_Q = types._true_Q = _true_Q; +exports._false_Q = types._false_Q = _false_Q; +exports._symbol = types._symbol = _symbol; +exports._symbol_Q = types._symbol_Q = _symbol_Q; +exports._function = types._function = _function; +exports._function_Q = types._function_Q = _function_Q; +exports._list = types._list = _list; +exports._list_Q = types._list_Q = _list_Q; +exports._vector = types._vector = _vector; +exports._vector_Q = types._vector_Q = _vector_Q; +exports._hash_map = types._hash_map = _hash_map; +exports._hash_map_Q = types._hash_map_Q = _hash_map_Q; +exports._assoc_BANG = types._assoc_BANG = _assoc_BANG; +exports._dissoc_BANG = types._dissoc_BANG = _dissoc_BANG; +exports._atom = types._atom = _atom; +exports._atom_Q = types._atom_Q = _atom_Q; diff --git a/make/Makefile b/make/Makefile index 1110397..2bb1e1e 100644 --- a/make/Makefile +++ b/make/Makefile @@ -1,7 +1,8 @@ TESTS = tests/types.mk tests/reader.mk tests/step9_interop.mk -SOURCES = util.mk readline.mk gmsl.mk types.mk reader.mk stepA_more.mk +SOURCES = util.mk readline.mk gmsl.mk types.mk reader.mk printer.mk \ + env.mk core.mk stepA_more.mk mal.mk: $(SOURCES) echo "#!/usr/bin/make -f" > $@ diff --git a/make/core.mk b/make/core.mk new file mode 100644 index 0000000..aaba3fd --- /dev/null +++ b/make/core.mk @@ -0,0 +1,255 @@ +# +# 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)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? = $(if $(call _symbol?,$(1)),$(__true),$(__false)) + + +# Number functions +number? = $(if $(call _number?,$(1)),$(__true),$(__false)) + +number_lt = $(if $(call int_lt,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) +number_lte = $(if $(call int_lte,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) +number_gt = $(if $(call int_gt,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) +number_gte = $(if $(call int_gte,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) + +number_plus = $(call _pnumber,$(call int_plus,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) +number_subtract = $(call _pnumber,$(call int_subtract,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) +number_multiply = $(call _pnumber,$(call int_multiply,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) +number_divide = $(call _pnumber,$(call int_divide,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) + + +# String functions + +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),, ))) + +string? = $(if $(call _string?,$(1)),$(__true),$(__false)) + +subs = $(strip \ + $(foreach start,$(call gmsl_plus,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 +function? = $(if $(call _function?,$(1)),$(__true),$(__false)) + + +# List functions +list? = $(if $(call _list?,$(1)),$(__true),$(__false)) + + +# Vector functions +vector? = $(if $(call _vector?,$(1)),$(__true),$(__false)) + + +# 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) \ + $(foreach key,$(wordlist 2,$(words $(1)),$(1)),\ + $(call _dissoc!,$(hm),$(call str_decode,$($(key)_value)))))) + +keys = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$(call _string,$(word 4,$(subst _, ,$(v))))))) + +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 _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 = $(word $(call gmsl_plus,1,$(call int_decode,$($(word 2,$(1))_value))),$($(word 1,$(1))_value)) + +sfirst = $(word 1,$($(1)_value)) + +slast = $(word $(words $($(1)_value)),$($(1)_value)) + +empty? = $(if $(call _EQ,0,$(if $(call _hash_map?,$(1)),$($(1)_size),$(words $($(1)_value)))),$(__true),$(__false)) + +count = $(call _number,$(call _count,$(1))) + +conj = $(word 1,$(foreach new_list,$(call __new_obj_like,$(word 1,$(1))),\ + $(new_list) \ + $(eval $(new_list)_value := $(strip $($(word 1,$(1))_value))) \ + $(if $(call _list?,$(new_list)),\ + $(foreach elem,$(wordlist 2,$(words $(1)),$(1)),\ + $(eval $(new_list)_value := $(strip $(elem) $($(new_list)_value)))),\ + $(eval $(new_list)_value := $(strip $($(new_list)_value) $(wordlist 2,$(words $(1)),$(1))))))) + +# 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 gmsl_subtract,$(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,$(word 2,$(subst _, ,$(lst))),\ + $(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)))))) + + +# 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? \ + symbol _symbol \ + symbol? symbol? \ + function? function? \ + string? string? \ + pr-str pr_str \ + str str \ + prn prn \ + println println \ + subs subs \ + number? number? \ + < number_lt \ + <= number_lte \ + > number_gt \ + >= number_gte \ + + number_plus \ + - number_subtract \ + * number_multiply \ + / number_divide \ + \ + 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 \ + nth nth \ + first sfirst \ + rest srest \ + last slast \ + empty? empty? \ + count count \ + conj conj \ + apply sapply \ + map smap \ + \ + with-meta with_meta \ + meta meta \ + atom atom \ + atom? atom? \ + deref deref \ + reset! reset! \ + swap! swap! + +endif diff --git a/make/env.mk b/make/env.mk new file mode 100644 index 0000000..d508283 --- /dev/null +++ b/make/env.mk @@ -0,0 +1,50 @@ +# +# mal (Make Lisp) Object Types and Functions +# + +ifndef __mal_env_included +__mal_env_included := true + +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)types.mk + +# +# ENV +# + +# 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_FIND = $(strip \ + $(if $(call _contains?,$(1),$(subst =,$(__equal),$(2))),\ + $(1),\ + $(if $(call _EQ,$(__nil),$(call _get,$(1),__outer__)),\ + ,\ + $(call ENV_FIND,$(call _get,$(1),__outer__),$(2))))) + +ENV_GET = $(foreach env,|$(call ENV_FIND,$(1),$(2))|,$(if $(call _EQ,||,$(env)),$(call _error,'$(2)' not found),$(call _get,$(strip $(subst |,,$(env))),$(subst =,$(__equal),$(2))))) + +ENV_SET = $(if $(call _assoc!,$(1),$(subst =,$(__equal),$(2)),$(3)),$(1),) + +endif diff --git a/make/printer.mk b/make/printer.mk new file mode 100644 index 0000000..a1f2559 --- /dev/null +++ b/make/printer.mk @@ -0,0 +1,45 @@ +# +# mal (Make a Lisp) printer +# + +ifndef __mal_printer_included +__mal_printer_included := true + +_TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) +include $(_TOP_DIR)util.mk +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)))),) + +# 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)),) + + +# Type specific printing + +nil_pr_str = nil +true_pr_str = true +false_pr_str = false + +number_pr_str = $(call int_decode,$($(1)_value)) + +symbol_pr_str = $($(1)_value) + +string_pr_str = $(if $(2),"$(subst $(DQUOTE),$(ESC_DQUOTE),$(subst $(SLASH),$(SLASH)$(SLASH),$(call str_decode,$($(1)_value))))",$(call str_decode,$($(1)_value))) + +function_pr_str = <$(if $(word 6,$(value $(1)_value)),$(wordlist 1,5,$(value $(1)_value))...,$(value $(1)_value))> + +list_pr_str = ($(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))) + +vector_pr_str = [$(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))] + +hash_map_pr_str = {$(foreach v,$(call __get_obj_values,$(1)),"$(foreach hcode,$(word 3,$(subst _, ,$(1))),$(patsubst $(1)_%,%,$(v:%_value=%)))" $(call _pr_str,$($(v)),$(2)))} + +atom_pr_str = (atom $(call _pr_str,$($(1)_value),$(2))) + +endif diff --git a/make/reader.mk b/make/reader.mk index ce3b078..8d04596 100755 --- a/make/reader.mk +++ b/make/reader.mk @@ -55,10 +55,10 @@ endef define READ_ATOM $(foreach ch,$(word 1,$($(1))),\ $(if $(filter $(NUMBERS),$(ch)),\ - $(call number,$(call READ_NUMBER,$(1))),\ + $(call _number,$(call READ_NUMBER,$(1))),\ $(if $(filter $(DQUOTE),$(ch)),\ $(eval $(1) := $(wordlist 2,$(words $($(1))),$($(1))))\ - $(call _string,$(strip $(call READ_STRING,$(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))))),\ @@ -69,7 +69,7 @@ $(foreach ch,$(word 1,$($(1))),\ $(__true),\ $(if $(call _EQ,false,$(sym)),\ $(__false),\ - $(call symbol,$(sym))))))))) + $(call _symbol,$(sym))))))))) endef # read and return tokens until $(2) found @@ -111,28 +111,28 @@ $(foreach ch,$(word 1,$($(1))),\ $(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)))),\ + $(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)))),\ + $(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)))),\ + $(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)))),\ + $(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))),\ + $(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)))),\ + $(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))))\ - $(foreach thm,$(call hash_map),\ + $(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)))),\ diff --git a/make/step1_read_print.mk b/make/step1_read_print.mk index 710cd1d..a5fe2d2 100644 --- a/make/step1_read_print.mk +++ b/make/step1_read_print.mk @@ -4,6 +4,7 @@ _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk SHELL := /bin/bash INTERACTIVE ?= yes diff --git a/make/step2_eval.mk b/make/step2_eval.mk index 62cd415..96cd98f 100644 --- a/make/step2_eval.mk +++ b/make/step2_eval.mk @@ -4,6 +4,8 @@ _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) 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 diff --git a/make/step3_env.mk b/make/step3_env.mk index 4f3f070..7c505cf 100644 --- a/make/step3_env.mk +++ b/make/step3_env.mk @@ -4,6 +4,9 @@ _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk SHELL := /bin/bash INTERACTIVE ?= yes diff --git a/make/step4_if_fn_do.mk b/make/step4_if_fn_do.mk index d08998d..f45cfa9 100644 --- a/make/step4_if_fn_do.mk +++ b/make/step4_if_fn_do.mk @@ -4,6 +4,9 @@ _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk SHELL := /bin/bash INTERACTIVE ?= yes @@ -71,7 +74,7 @@ $(if $(__ERROR),,\ $(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))))),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ $(foreach el,$(call EVAL_AST,$(1),$(2)),\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ @@ -99,11 +102,11 @@ REP = $(call PRINT,$(strip $(call EVAL,$(strip $(call READ,$(1))),$(REPL_ENV)))) REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call REPL)) # Setup the environment -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call function,$$(call $(2),$$1)))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -# Import types functions -_import_types = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_types,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_types,$(types_ns)) +# Import core namespace +_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)) # Defined in terms of the language itself $(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) diff --git a/make/step6_file.mk b/make/step6_file.mk index 0c72a9c..c791b33 100644 --- a/make/step6_file.mk +++ b/make/step6_file.mk @@ -4,6 +4,9 @@ _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk SHELL := /bin/bash INTERACTIVE ?= yes @@ -71,7 +74,7 @@ $(if $(__ERROR),,\ $(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))))),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ $(foreach el,$(call EVAL_AST,$(1),$(2)),\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ @@ -100,17 +103,17 @@ REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call # Setup the environment _ref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(if $(2),$(2),$(1)))) -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call function,$$(call $(2),$$1)))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -# Import types functions -_import_types = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_types,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_types,$(types_ns)) +# Import core namespace +_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)) -$(call _ref,read-string,$(call function,$$(call READ_STR,$$(1)))) -$(call _ref,eval,$(call function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +$(call _ref,read-string,$(call _function,$$(call READ_STR,$$(1)))) +$(call _ref,eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_slurp = $(call string,$(call _read_file,$(1))) -$(call _ref,slurp,$(call function,$$(call _slurp,$$(call str_decode,$$($$(1)_value))))) +_slurp = $(call _string,$(call _read_file,$(1))) +$(call _ref,slurp,$(call _function,$$(call _slurp,$$(call str_decode,$$($$(1)_value))))) # Defined in terms of the language itself $(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) diff --git a/make/step7_quote.mk b/make/step7_quote.mk index 2a14c11..46e5130 100644 --- a/make/step7_quote.mk +++ b/make/step7_quote.mk @@ -4,6 +4,9 @@ _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk SHELL := /bin/bash INTERACTIVE ?= yes @@ -20,12 +23,12 @@ IS_PAIR = $(if $(call _EQ,list,$(call _obj_type,$(1))),$(if $(call _EQ,0,$(call define QUASIQUOTE $(strip \ $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call list,$(call symbol,quote) $(1)),\ + $(call _list,$(call _symbol,quote) $(1)),\ $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ $(call _nth,$(1),1),\ $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call list,$(call symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call list,$(call symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) + $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ + $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) endef define LET @@ -88,7 +91,7 @@ $(if $(__ERROR),,\ $(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))))),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ $(foreach el,$(call EVAL_AST,$(1),$(2)),\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ @@ -117,17 +120,17 @@ REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call # Setup the environment _ref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(if $(2),$(2),$(1)))) -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call function,$$(call $(2),$$1)))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -# Import types functions -_import_types = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_types,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_types,$(types_ns)) +# Import core namespace +_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)) -$(call _ref,read-string,$(call function,$$(call READ_STR,$$(1)))) -$(call _ref,eval,$(call function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +$(call _ref,read-string,$(call _function,$$(call READ_STR,$$(1)))) +$(call _ref,eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_slurp = $(call string,$(call _read_file,$(1))) -$(call _ref,slurp,$(call function,$$(call _slurp,$$(call str_decode,$$($$(1)_value))))) +_slurp = $(call _string,$(call _read_file,$(1))) +$(call _ref,slurp,$(call _function,$$(call _slurp,$$(call str_decode,$$($$(1)_value))))) # Defined in terms of the language itself $(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) diff --git a/make/step8_macros.mk b/make/step8_macros.mk index 910acb0..fee4bb0 100644 --- a/make/step8_macros.mk +++ b/make/step8_macros.mk @@ -4,6 +4,9 @@ _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk SHELL := /bin/bash INTERACTIVE ?= yes @@ -20,12 +23,12 @@ IS_PAIR = $(if $(call _EQ,list,$(call _obj_type,$(1))),$(if $(call _EQ,0,$(call define QUASIQUOTE $(strip \ $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call list,$(call symbol,quote) $(1)),\ + $(call _list,$(call _symbol,quote) $(1)),\ $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ $(call _nth,$(1),1),\ $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call list,$(call symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call list,$(call symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) + $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ + $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) endef define IS_MACRO_CALL @@ -108,7 +111,7 @@ $(if $(__ERROR),,\ $(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))))),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ $(foreach el,$(call EVAL_AST,$(1),$(2)),\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ @@ -140,17 +143,17 @@ REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call # Setup the environment _ref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(if $(2),$(2),$(1)))) -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call function,$$(call $(2),$$1)))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -# Import types functions -_import_types = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_types,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_types,$(types_ns)) +# Import core namespace +_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)) -$(call _ref,read-string,$(call function,$$(call READ_STR,$$(1)))) -$(call _ref,eval,$(call function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +$(call _ref,read-string,$(call _function,$$(call READ_STR,$$(1)))) +$(call _ref,eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_slurp = $(call string,$(call _read_file,$(1))) -$(call _ref,slurp,$(call function,$$(call _slurp,$$(call str_decode,$$($$(1)_value))))) +_slurp = $(call _string,$(call _read_file,$(1))) +$(call _ref,slurp,$(call _function,$$(call _slurp,$$(call str_decode,$$($$(1)_value))))) # Defined in terms of the language itself $(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) diff --git a/make/step9_interop.mk b/make/step9_interop.mk index 6de228d..4b7eaff 100644 --- a/make/step9_interop.mk +++ b/make/step9_interop.mk @@ -4,6 +4,9 @@ _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk SHELL := /bin/bash INTERACTIVE ?= yes @@ -20,12 +23,12 @@ IS_PAIR = $(if $(call _EQ,list,$(call _obj_type,$(1))),$(if $(call _EQ,0,$(call define QUASIQUOTE $(strip \ $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call list,$(call symbol,quote) $(1)),\ + $(call _list,$(call _symbol,quote) $(1)),\ $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ $(call _nth,$(1),1),\ $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call list,$(call symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call list,$(call symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) + $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ + $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) endef define IS_MACRO_CALL @@ -112,7 +115,7 @@ $(if $(__ERROR),,\ $(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))))),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ $(foreach el,$(call EVAL_AST,$(1),$(2)),\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ @@ -144,17 +147,17 @@ REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call # Setup the environment _ref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(if $(2),$(2),$(1)))) -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call function,$$(call $(2),$$1)))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -# Import types functions -_import_types = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_types,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_types,$(types_ns)) +# Import core namespace +_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)) -$(call _ref,read-string,$(call function,$$(call READ_STR,$$(1)))) -$(call _ref,eval,$(call function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +$(call _ref,read-string,$(call _function,$$(call READ_STR,$$(1)))) +$(call _ref,eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_slurp = $(call string,$(call _read_file,$(1))) -$(call _ref,slurp,$(call function,$$(call _slurp,$$(call str_decode,$$($$(1)_value))))) +_slurp = $(call _string,$(call _read_file,$(1))) +$(call _ref,slurp,$(call _function,$$(call _slurp,$$(call str_decode,$$($$(1)_value))))) # Defined in terms of the language itself $(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) diff --git a/make/stepA_more.mk b/make/stepA_more.mk index 48c0cb2..3cd0d2a 100644 --- a/make/stepA_more.mk +++ b/make/stepA_more.mk @@ -4,6 +4,9 @@ _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)types.mk include $(_TOP_DIR)reader.mk +include $(_TOP_DIR)printer.mk +include $(_TOP_DIR)env.mk +include $(_TOP_DIR)core.mk SHELL := /bin/bash INTERACTIVE ?= yes @@ -20,12 +23,12 @@ IS_PAIR = $(if $(call _EQ,list,$(call _obj_type,$(1))),$(if $(call _EQ,0,$(call define QUASIQUOTE $(strip \ $(if $(call _NOT,$(call IS_PAIR,$(1))),\ - $(call list,$(call symbol,quote) $(1)),\ + $(call _list,$(call _symbol,quote) $(1)),\ $(if $(call _EQ,unquote,$($(call _nth,$(1),0)_value)),\ $(call _nth,$(1),1),\ $(if $(and $(call IS_PAIR,$(call _nth,$(1),0)),$(call _EQ,splice-unquote,$($(call _nth,$(call _nth,$(1),0),0)_value))),\ - $(call list,$(call symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ - $(call list,$(call symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) + $(call _list,$(call _symbol,concat) $(call _nth,$(call _nth,$(1),0),1) $(call QUASIQUOTE,$(call srest,$(1)))),\ + $(call _list,$(call _symbol,cons) $(call QUASIQUOTE,$(call _nth,$(1),0)) $(call QUASIQUOTE,$(call srest,$(1)))))))) endef define IS_MACRO_CALL @@ -109,7 +112,7 @@ $(if $(__ERROR),,\ $(if $(call _EQ,catch*,$($(a20)_value)),\ $(foreach a21,$(call _nth,$(a2),1),\ $(foreach a22,$(call _nth,$(a2),2),\ - $(foreach binds,$(call list,$(a21)),\ + $(foreach binds,$(call _list,$(a21)),\ $(foreach catch_env,$(call ENV,$(2),$(binds),$(__ERROR)),\ $(eval __ERROR :=)\ $(call EVAL,$(a22),$(catch_env)))))),\ @@ -127,7 +130,7 @@ $(if $(__ERROR),,\ $(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))))),\ + $(call _function,$$(call EVAL,$(a2),$$(call ENV,$(2),$(a1),$$1))))),\ $(foreach el,$(call EVAL_AST,$(1),$(2)),\ $(and $(EVAL_DEBUG),$(info invoke: $(call _pr_str,$(el))))\ $(foreach f,$(call sfirst,$(el)),\ @@ -159,18 +162,18 @@ REPL = $(info $(call REP,$(call READLINE,"user> ")))$(if $(READLINE_EOF),,$(call # Setup the environment _ref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(if $(2),$(2),$(1)))) -_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call function,$$(call $(2),$$1)))) +_fref = $(eval REPL_ENV := $(call ENV_SET,$(REPL_ENV),$(1),$(call _function,$$(call $(2),$$1)))) -# Import types functions -_import_types = $(if $(strip $(1)),$(call _fref,$(word 1,$(1)),$(word 2,$(1)))$(call _import_types,$(wordlist 3,$(words $(1)),$(1))),) -$(call _import_types,$(types_ns)) +# Import core namespace +_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)) -$(call _ref,readline,$(call function,$$(foreach res,$$(call string,$$(call READLINE,"$$(call str_decode,$$($$(1)_value))")),$$(if $$(READLINE_EOF),$$(__nil),$$(res))))) -$(call _ref,read-string,$(call function,$$(call READ_STR,$$(1)))) -$(call _ref,eval,$(call function,$$(call EVAL,$$(1),$$(REPL_ENV)))) +$(call _ref,readline,$(call _function,$$(foreach res,$$(call _string,$$(call READLINE,"$$(call str_decode,$$($$(1)_value))")),$$(if $$(READLINE_EOF),$$(__nil),$$(res))))) +$(call _ref,read-string,$(call _function,$$(call READ_STR,$$(1)))) +$(call _ref,eval,$(call _function,$$(call EVAL,$$(1),$$(REPL_ENV)))) -_slurp = $(call string,$(call _read_file,$(1))) -$(call _ref,slurp,$(call function,$$(call _slurp,$$(call str_decode,$$($$(1)_value))))) +_slurp = $(call _string,$(call _read_file,$(1))) +$(call _ref,slurp,$(call _function,$$(call _slurp,$$(call str_decode,$$($$(1)_value))))) # Defined in terms of the language itself $(call do,$(call REP, (def! not (fn* (a) (if a false true))) )) diff --git a/make/tests/types.mk b/make/tests/types.mk index c1c1849..a100afe 100644 --- a/make/tests/types.mk +++ b/make/tests/types.mk @@ -63,9 +63,9 @@ $(call assert_eq,a string value - a string (with parens),$(call str_decode,$($(c $(info Testing function objects) -$(call assert_eq,function,$(call _obj_type,$(call function,abc)),\ +$(call assert_eq,function,$(call _obj_type,$(call _function,abc)),\ (type (function abc)) is not 'function') -FN1 := $(call function,arg1:'$$(word 1,$$(1))' arg2:'$$(word 2,$$(1))') +FN1 := $(call _function,arg1:'$$(word 1,$$(1))' arg2:'$$(word 2,$$(1))') $(call assert_eq,$(__true),$(call function?,$(FN1))) $(call assert_eq,arg1:'A' arg2:'B',$(call apply,$(FN1),$(call list,A B))) @@ -113,7 +113,7 @@ $(call assert_eq,A,$(call sfirst,$(call _nth,$(L4),1)),\ $(info Testing hash_maps) -X := $(call hash_map) +X := $(call _hash_map) $(call assert_eq,$(__true),$(call hash_map?,$(X)),\ (hash_map? $$(X))) $(call assert_eq,$(__false),$(call vector?,$(X)),\ @@ -130,7 +130,7 @@ $(call assert_eq,value of X a,$(call _get,$(X),a),\ $(call assert_eq,$(__true),$(call contains?,$(X) $(mykey)),\ (contains? $$(X),a)) -Y := $(call hash_map) +Y := $(call _hash_map) $(call assert_eq,0,$(call _count,$(Y)),\ (_count $$(Y))) $(call do,$(call _assoc!,$(Y),a,value of Y a)) @@ -241,7 +241,7 @@ $(info Testing smap function) L5 := $(call _conj!,$(call list),$(call number,1) $(call number,2) $(call number,3)) inc = $(call number_plus,$(call number,1) $(1)) $(call assert_eq,(2 3 4),$(call _pr_str,$(call _smap,inc,$(L5)))) -inc_func := $(call function,$$(call number_plus,$$(call number,1) $$(1))) +inc_func := $(call _function,$$(call number_plus,$$(call number,1) $$(1))) $(call assert_eq,(2 3 4),$(call _pr_str,$(call smap,$(inc_func) $(L5)))) diff --git a/make/types.mk b/make/types.mk index 9f03530..b971fb1 100644 --- a/make/types.mk +++ b/make/types.mk @@ -1,5 +1,5 @@ # -# mal (Make Lisp) Object Types and Functions +# mal (Make a Lisp) object types # ifndef __mal_types_included @@ -8,6 +8,9 @@ __mal_types_included := true _TOP_DIR := $(dir $(lastword $(MAKEFILE_LIST))) include $(_TOP_DIR)util.mk + +# Low-level type implemenation + # magic is \u2344 \u204a __obj_magic = ⍄⁊ # \u2256 @@ -25,11 +28,54 @@ __get_obj_values = $(strip \ $(sort $(foreach v,$(filter %_value,$(filter $(1)_%,$(.VARIABLES))),$(if $(call _undefined?,$(v)),,$(v)))),\ $($(1)_value))) + +# 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 gmsl_plus,1,$(__var_idx)))\ + $(foreach lidx,__lidx_$(__var_idx),\ + $(eval $(lidx) := 0)\ + $(foreach val,$($(v)_value),\ + $(call __var_print,$(val),$(2)$(SPACE)$(SPACE)$($(lidx)): )\ + $(eval $(lidx) := $(call gmsl_plus,1,$($(lidx)))))),\ + $(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 _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))) + + +# Errors/Exceptions __ERROR := +_error = $(eval __ERROR := $(call _string,$(1))) + + +# Constant atomic values +__undefined = $(__obj_magic)_undf_0 +__nil = $(__obj_magic)__nil_0 +__true = $(__obj_magic)_true_0 +__false = $(__obj_magic)_fals_0 + -# # General functions -# # Return the type of the object (or "make" if it's not a object _obj_type = $(strip \ @@ -46,22 +92,6 @@ _obj_type = $(strip \ $(if $(filter $(__obj_magic)_hmap_%,$(1)),hash_map,\ $(if $(filter $(__obj_magic)_undf_%,$(1)),undefined,\ make))))))))))))) -obj_type = $(call string,$(call _obj_type,$(1))) - -# 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)))),) - -# 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 = $(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),, ))) _clone_obj = $(strip \ $(foreach new_hcode,$(call __new_obj_hash_code),\ @@ -75,101 +105,50 @@ _clone_obj = $(strip \ $(eval $(new_obj)_value := $(strip $($(1)_value)))))\ $(new_obj)))) -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)) - - -# -# Special atomic values -# -__undefined = $(__obj_magic)_undf_0 -__nil = $(__obj_magic)__nil_0 -__true = $(__obj_magic)_true_0 -__false = $(__obj_magic)_fals_0 +_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 _number?,$(1))),\ + $(call _EQ,$($(1)_value),$($(2)_value)),\ + $(if $(or $(call _vector?,$(1)),$(call _list?,$(1)),$(call _hash_map?,$(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)))) -undefined? = $(if $(call _undefined?,$(1)),$(__true),$(__false)) _nil? = $(if $(filter $(__obj_magic)__nil_%,$(1)),$(__true),) -nil? = $(if $(call _nil?,$(1)),$(__true),$(__false)) -nil_pr_str = nil _true? = $(if $(filter $(__obj_magic)_true_%,$(1)),$(__true),) -true? = $(if $(call _true?,$(1)),$(__true),$(__false)) -true_pr_str = true _false? = $(if $(filter $(__obj_magic)_fals_%,$(1)),$(__true),) -false? = $(if $(call _false?,$(1)),$(__true),$(__false)) -false_pr_str = false -# -# Numbers -# +# 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),) -_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))) +# 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? = $(if $(call _number?,$(1)),$(__true),$(__false)) - -number_pr_str = $(call int_decode,$($(1)_value)) - -number_plus = $(call _pnumber,$(call int_plus,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) -number_subtract = $(call _pnumber,$(call int_subtract,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) -number_multiply = $(call _pnumber,$(call int_multiply,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) -number_divide = $(call _pnumber,$(call int_divide,$($(word 1,$(1))_value),$($(word 2,$(1))_value))) -number_gt = $(if $(call int_gt,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) -number_gte = $(if $(call int_gte,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) -number_lt = $(if $(call int_lt,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) -number_lte = $(if $(call int_lte,$($(word 1,$(1))_value),$($(word 2,$(1))_value)),$(__true),$(__false)) - -# -# 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? = $(if $(call _symbol?,$(1)),$(__true),$(__false)) - -symbol_pr_str = $($(1)_value) - -# # 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 = $(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? = $(if $(call _string?,$(1)),$(__true),$(__false)) - -string_pr_str = $(if $(2),"$(subst $(DQUOTE),$(ESC_DQUOTE),$(subst $(SLASH),$(SLASH)$(SLASH),$(call str_decode,$($(1)_value))))",$(call str_decode,$($(1)_value))) - -subs = $(strip \ - $(foreach start,$(call gmsl_plus,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 objects -# +# 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 = $(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),) -function? = $(if $(call _function?,$(1)),$(__true),$(__false)) - -function_pr_str = <$(if $(word 6,$(value $(1)_value)),$(wordlist 1,5,$(value $(1)_value))...,$(value $(1)_value))> # Takes a function name and a list object of arguments and invokes # the function with space separated arguments @@ -179,25 +158,20 @@ _apply = $(call $(1),$($(2)_value)) # the function with space separated arguments apply = $(call $(1)_value,$($(2)_value)) -# Takes a space separated arguments and invokes the first argument -# (function object) using the remaining arguments. -sapply = $(call $(word 1,$(1))_value,\ - $(strip \ - $(wordlist 2,$(call gmsl_subtract,$(words $(1)),1),$(1)) \ - $($(word $(words $(1)),$(1))_value))) -# -# hash maps (associative arrays) -# +# 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),) -# create a new anonymous empty hash map -_hash_map = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_hmap_$(hcode)$(eval $(__obj_magic)_hmap_$(hcode)_size := 0)) -hash_map = $(word 1,$(foreach new_hmap,$(call _hash_map),$(new_hmap) $(if $(1),$(call _assoc_seq!,$(new_hmap),$(1))))) -_hash_map? = $(if $(filter $(__obj_magic)_hmap_%,$(1)),$(__true),) -hash_map? = $(if $(call _hash_map?,$(1)),$(__true),$(__false)) +# 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),) + -hash_map_pr_str = {$(foreach v,$(call __get_obj_values,$(1)),"$(foreach hcode,$(word 3,$(subst _, ,$(1))),$(patsubst $(1)_%,%,$(v:%_value=%)))" $(call _pr_str,$($(v)),$(2)))} +# 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),) # 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))),) @@ -205,30 +179,9 @@ _assoc_seq! = $(call _assoc!,$(1),$(call str_decode,$($(word 1,$(2))_value)),$(w # set a key/value in the hash map _assoc! = $(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),$(eval $(1)_size := $(call gmsl_plus,$($(1)_size),1)),)$(eval $(1)_$(k)_value := $(3))$(1)) -# 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 a key in the hash map _dissoc! = $(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),,$(eval $(1)_$(k)_value := $(__undefined))$(eval $(1)_size := $(call gmsl_subtract,$($(1)_size),1))))$(1) -# unset keys in a copy of the hash map -# TODO: this could be made more efficient by copying only the -# keys that not being removed. -dissoc = $(word 1,\ - $(foreach hm,$(call _clone_obj,$(word 1,$(1))),\ - $(hm) \ - $(foreach key,$(wordlist 2,$(words $(1)),$(1)),\ - $(call _dissoc!,$(hm),$(call str_decode,$($(key)_value)))))) - -keys = $(foreach new_list,$(call _list),$(new_list)$(eval $(new_list)_value := $(foreach v,$(call __get_obj_values,$(1)),$(call string,$(word 4,$(subst _, ,$(v))))))) - -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 plain string key from the hash map, or @@ -240,104 +193,20 @@ _get = $(strip \ $(word $(call gmsl_plus,1,$(2)),$($(1)_value)),\ ,))) -# retrieve the value of a string key object from the hash map, or -# retrive a vector by number object index -get = $(strip \ - $(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 number_pr_str,$(word 2,$(1)))))) - _contains? = $(strip \ $(if $(call _hash_map?,$(1)),\ $(foreach k,$(subst =,$(__equal),$(2)),$(if $(call _undefined?,$(1)_$(k)_value),,$(__true))),\ $(if $(call _vector?,$(1)),\ $(if $(word $(call gmsl_plus,1,$(2)),$($(1)_value)),$(__true),),\ ,))) -contains? = $(if $(call _contains?,$(word 1,$(1)),$(call str_decode,$($(word 2,$(1))_value))),$(__true),$(__false)) - - -# -# Errors/Exceptions -# -_error = $(eval __ERROR := $(call string,$(1))) -throw = $(eval __ERROR := $(1)) - - -# -# vectors -# - -_vector = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_vect_$(hcode)) -vector = $(word 1,$(foreach new_vect,$(call _vector),$(new_vect) $(eval $(new_vect)_value := $1))) - -_vector? = $(if $(filter $(__obj_magic)_vect_%,$(1)),$(__true),) -vector? = $(if $(call _vector?,$(1)),$(__true),$(__false)) - -vector_pr_str = [$(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))] - -# -# list (same as vectors for now) -# - -_list = $(foreach hcode,$(call __new_obj_hash_code),$(__obj_magic)_list_$(hcode)) -list = $(word 1,$(foreach new_list,$(call _list),$(new_list) $(eval $(new_list)_value := $1))) - -_list? = $(if $(filter $(__obj_magic)_list_%,$(1)),$(__true),) -list? = $(if $(call _list?,$(1)),$(__true),$(__false)) - -list_pr_str = ($(foreach v,$(call __get_obj_values,$(1)),$(call _pr_str,$(v),$(2)))) - -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))))))) -# -# atoms -# -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 $(filter $(__obj_magic)_atom_%,$(1)),$(__true),) -atom? = $(if $(call _atom?,$(1)),$(__true),$(__false)) - -atom_pr_str = (atom $(call _pr_str,$($(1)_value),$(2))) - -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)) - - -# # sequence operations -# _sequential? = $(if $(filter $(__obj_magic)_list_% $(__obj_magic)_vect_%,$(1)),$(__true),) -sequential? = $(if $(call _sequential?,$(1)),$(__true),$(__false)) - -raw_flat = $(foreach val,$(call __get_obj_values,$(1)),$($(val))) _nth = $(word $(call gmsl_plus,1,$(2)),$($(1)_value)) -nth = $(word $(call gmsl_plus,1,$(call int_decode,$($(word 2,$(1))_value))),$($(word 1,$(1))_value)) - -empty? = $(if $(call _EQ,0,$(if $(call _hash_map?,$(1)),$($(1)_size),$(words $($(1)_value)))),$(__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))))))) - -conj = $(word 1,$(foreach new_list,$(call __new_obj_like,$(word 1,$(1))),\ - $(new_list) \ - $(eval $(new_list)_value := $(strip $($(word 1,$(1))_value))) \ - $(if $(call _list?,$(new_list)),\ - $(foreach elem,$(wordlist 2,$(words $(1)),$(1)),\ - $(eval $(new_list)_value := $(strip $(elem) $($(new_list)_value)))),\ - $(eval $(new_list)_value := $(strip $($(new_list)_value) $(wordlist 2,$(words $(1)),$(1))))))) - # conj that mutates a sequence in-place to append the call arguments _conj! = $(eval $(1)_value := $(strip $($(1)_value) $2 $3 $4 $5 $6 $7 $8 $9 $(10) $(11) $(12) $(13) $(14) $(15) $(16) $(17) $(18) $(19) $(20)))$(1) @@ -345,11 +214,6 @@ _count = $(strip \ $(if $(call _hash_map?,$(1)),\ $($(1)_size),\ $(words $($(1)_value)))) -count = $(call number,$(call _count,$(1))) - -sfirst = $(word 1,$($(1)_value)) - -slast = $(word $(words $($(1)_value)),$($(1)_value)) # Creates a new vector/list of the everything after but the first # element @@ -366,135 +230,15 @@ _smap = $(word 1,\ # Same as _smap but returns a vector _smap_vec = $(word 1,\ - $(foreach new_vector,$(call vector),\ + $(foreach new_vector,$(call _vector),\ $(new_vector)\ $(foreach v,$(call __get_obj_values,$(2)),\ $(call _conj!,$(new_vector),$(call $(1),$(v),$(3),$(4)))))) -# Map a function object over a list object -smap = $(strip\ - $(foreach func,$(word 1,$(1)),\ - $(foreach lst,$(word 2,$(1)),\ - $(foreach type,$(word 2,$(subst _, ,$(lst))),\ - $(foreach new_hcode,$(call __new_obj_hash_code),\ - $(foreach sz,$(words $(call __get_obj_values,$(lst))),\ - $(eval $(__obj_magic)_$(type)_$(new_hcode)_value := $(strip \ - $(foreach val,$(call __get_obj_values,$(lst)),\ - $(call $(func)_value,$(val))))))\ - $(__obj_magic)_$(type)_$(new_hcode)))))) - - - -_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 _number?,$(1))),\ - $(call _EQ,$($(1)_value),$($(2)_value)),\ - $(if $(or $(call _vector?,$(1)),$(call _list?,$(1)),$(call _hash_map?,$(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)))))))) - -equal? = $(if $(call _equal?,$(word 1,$(1)),$(word 2,$(1))),$(__true),$(__false)) - -# -# ENV -# - -# 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_FIND = $(strip \ - $(if $(call _contains?,$(1),$(subst =,$(__equal),$(2))),\ - $(1),\ - $(if $(call _EQ,$(__nil),$(call _get,$(1),__outer__)),\ - ,\ - $(call ENV_FIND,$(call _get,$(1),__outer__),$(2))))) - -ENV_GET = $(foreach env,|$(call ENV_FIND,$(1),$(2))|,$(if $(call _EQ,||,$(env)),$(call _error,'$(2)' not found),$(call _get,$(strip $(subst |,,$(env))),$(subst =,$(__equal),$(2))))) - -ENV_SET = $(if $(call _assoc!,$(1),$(subst =,$(__equal),$(2)),$(3)),$(1),) - -# -# 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 gmsl_plus,1,$(__var_idx)))\ - $(foreach lidx,__lidx_$(__var_idx),\ - $(eval $(lidx) := 0)\ - $(foreach val,$($(v)_value),\ - $(call __var_print,$(val),$(2)$(SPACE)$(SPACE)$($(lidx)): )\ - $(eval $(lidx) := $(call gmsl_plus,1,$($(lidx)))))),\ - $(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 _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): ...))))))))) +# atoms -visualize_memory = $(foreach var,$(sort $(foreach vv,$(filter $(__obj_magic)_%,$(.VARIABLES)),$(call __var_name,$(vv)))),$(call __var_print,$(__obj_magic)_$(var))) +_atom? = $(if $(filter $(__obj_magic)_atom_%,$(1)),$(__true),) -# -# Namespace of type functions -# -types_ns = pr-str pr_str str str prn prn println println \ - with-meta with_meta meta meta \ - type obj_type = equal? \ - nil? nil? true? true? false? false? \ - number? number? \ - > number_gt >= number_gte < number_lt <= number_lte \ - + number_plus - number_subtract * number_multiply / number_divide \ - symbol? symbol? function? function? \ - string? string? subs subs \ - hash-map hash_map map? hash_map? assoc assoc dissoc dissoc \ - get get contains? contains? keys keys vals vals \ - throw throw \ - list list list? list? \ - vector vector vector? vector? \ - atom atom atom? atom? deref deref reset! reset! swap! swap! \ - sequential? sequential? \ - cons cons nth nth empty? empty? count count concat concat \ - conj conj first sfirst last slast rest srest \ - apply sapply map smap \ endif diff --git a/mal/Makefile b/mal/Makefile index f90f574..799b691 100644 --- a/mal/Makefile +++ b/mal/Makefile @@ -2,7 +2,7 @@ TESTS = -SOURCES = types.mal env.mal stepA_more.mal +SOURCES = env.mal core.mal stepA_more.mal #.PHONY: stats tests $(TESTS) .PHONY: stats diff --git a/mal/core.mal b/mal/core.mal new file mode 100644 index 0000000..b616603 --- /dev/null +++ b/mal/core.mal @@ -0,0 +1,52 @@ +(def! core_ns + [["=" =] + ["throw" throw] + ["nil?" nil?] + ["true?" true?] + ["false?" false?] + ["symbol?" symbol?] + ["pr-str" pr-str] + ["str" str] + ["prn" prn] + ["println" println] + ["<" <] + ["<=" <=] + [">" >] + [">=" >=] + ["+" +] + ["-" -] + ["*" *] + ["/" /] + + ["list" list] + ["list?" list?] + ["vector" vector] + ["vector?" vector?] + ["hash-map" hash-map] + ["map?" map?] + ["assoc" assoc] + ["dissoc" dissoc] + ["get" get] + ["contains?" contains?] + ["keys" keys] + ["vals" vals] + + ["sequential?" sequential?] + ["cons" cons] + ["concat" concat] + ["nth" nth] + ["first" first] + ["rest" rest] + ["empty?" empty?] + ["count" count] + ["conj" conj] + ["apply" apply] + ["map" map] + + ["with-meta" with-meta] + ["meta" meta] + ["atom" atom] + ["atom?" atom?] + ["deref" deref] + ["reset!" reset!] + ["swap!" swap!]]) diff --git a/mal/step4_if_fn_do.mal b/mal/step4_if_fn_do.mal index 76a3c3a..7107ac4 100644 --- a/mal/step4_if_fn_do.mal +++ b/mal/step4_if_fn_do.mal @@ -1,5 +1,5 @@ -(load-file "../mal/types.mal") (load-file "../mal/env.mal") +(load-file "../mal/core.mal") ;; read (def! READ (fn* [strng] @@ -79,8 +79,8 @@ (def! _ref (fn* [k v] (env-set repl-env k v))) -;; Import types related functions -(map (fn* [data] (_ref (nth data 0) (nth data 1))) types_ns) +;; Import core namespace functions +(map (fn* [data] (_ref (nth data 0) (nth data 1))) core_ns) ;; Defined using the language itself (rep "(def! not (fn* [a] (if a false true)))") diff --git a/mal/step6_file.mal b/mal/step6_file.mal index b5db13b..2f53c4d 100644 --- a/mal/step6_file.mal +++ b/mal/step6_file.mal @@ -1,5 +1,5 @@ -(load-file "../mal/types.mal") (load-file "../mal/env.mal") +(load-file "../mal/core.mal") ;; read (def! READ (fn* [strng] @@ -79,8 +79,8 @@ (def! _ref (fn* [k v] (env-set repl-env k v))) -;; Import types related functions -(map (fn* [data] (_ref (nth data 0) (nth data 1))) types_ns) +;; Import core namespace functions +(map (fn* [data] (_ref (nth data 0) (nth data 1))) core_ns) ;; Defined using the language itself (_ref 'read-string read-string) diff --git a/mal/step7_quote.mal b/mal/step7_quote.mal index 1ea989c..553248c 100644 --- a/mal/step7_quote.mal +++ b/mal/step7_quote.mal @@ -1,5 +1,5 @@ -(load-file "../mal/types.mal") (load-file "../mal/env.mal") +(load-file "../mal/core.mal") ;; read (def! READ (fn* [strng] @@ -107,8 +107,8 @@ (def! _ref (fn* [k v] (env-set repl-env k v))) -;; Import types related functions -(map (fn* [data] (_ref (nth data 0) (nth data 1))) types_ns) +;; Import core namespace functions +(map (fn* [data] (_ref (nth data 0) (nth data 1))) core_ns) ;; Defined using the language itself (_ref 'read-string read-string) diff --git a/mal/step8_macros.mal b/mal/step8_macros.mal index c07c9b7..5c81138 100644 --- a/mal/step8_macros.mal +++ b/mal/step8_macros.mal @@ -1,5 +1,5 @@ -(load-file "../mal/types.mal") (load-file "../mal/env.mal") +(load-file "../mal/core.mal") ;; read (def! READ (fn* [strng] @@ -139,8 +139,8 @@ (def! _ref (fn* [k v] (env-set repl-env k v))) -;; Import types related functions -(map (fn* [data] (_ref (nth data 0) (nth data 1))) types_ns) +;; Import core namespace functions +(map (fn* [data] (_ref (nth data 0) (nth data 1))) core_ns) ;; Defined using the language itself (_ref 'read-string read-string) diff --git a/mal/stepA_more.mal b/mal/stepA_more.mal index 013c1bc..cd1e570 100644 --- a/mal/stepA_more.mal +++ b/mal/stepA_more.mal @@ -1,5 +1,5 @@ -(load-file "../mal/types.mal") (load-file "../mal/env.mal") +(load-file "../mal/core.mal") ;; read (def! READ (fn* [strng] @@ -150,8 +150,8 @@ (def! _ref (fn* [k v] (env-set repl-env k v))) -;; Import types related functions -(map (fn* [data] (_ref (nth data 0) (nth data 1))) types_ns) +;; Import core namespace functions +(map (fn* [data] (_ref (nth data 0) (nth data 1))) core_ns) ;; Defined using the language itself (_ref 'readline readline) diff --git a/mal/types.mal b/mal/types.mal deleted file mode 100644 index 6eaa388..0000000 --- a/mal/types.mal +++ /dev/null @@ -1,16 +0,0 @@ -(def! types_ns - [["pr-str" pr-str] ["str" str] ["prn" prn] ["println" println] - ["with-meta" with-meta] ["meta" meta] ["=" =] - ["nil?" nil?] ["true?" true?] ["false?" false?] ["symbol?" symbol?] - [">" >] [">=" >=] ["<" <] ["<=" <=] ["+" +] ["-" -] ["*" *] ["/" /] - ["hash-map" hash-map] ["map?" map?] - ["assoc" assoc] ["dissoc" dissoc] ["get" get] - ["contains?" contains?] ["keys" keys] ["vals" vals] - ["throw" throw] - ["list" list] ["list?" list?] ["vector" vector] ["vector?" vector?] - ["atom" atom] ["atom?" atom?] ["deref" deref] - ["reset!" reset!] ["swap!" swap!] - ["sequential?" sequential?] ["cons" cons] ["nth" nth] - ["empty?" empty?] ["count" count] ["concat" concat] - ["conj" conj] ["first" first] ["rest" rest] - ["apply" apply] ["map" map]]) diff --git a/php/Makefile b/php/Makefile new file mode 100644 index 0000000..e7ea51d --- /dev/null +++ b/php/Makefile @@ -0,0 +1,16 @@ + +TESTS = + +SOURCES = readline.php types.php reader.php printer.php \ + env.php core.php stepA_more.php + +.PHONY: stats tests $(TESTS) + +stats: $(SOURCES) + @wc $^ + +tests: $(TESTS) + +$(TESTS): + @echo "Running $@"; \ + php $@ || exit 1; \ diff --git a/php/core.php b/php/core.php new file mode 100644 index 0000000..16d34f8 --- /dev/null +++ b/php/core.php @@ -0,0 +1,221 @@ +<?php + +require_once 'types.php'; +require_once 'printer.php'; + +// Error/Exception functions +function mal_throw($obj) { throw new Error($obj); } + + +// String functions +function pr_str() { + $ps = array_map(function ($obj) { return _pr_str($obj, True); }, + func_get_args()); + return implode(" ", $ps); +} + +function str() { + $ps = array_map(function ($obj) { return _pr_str($obj, False); }, + func_get_args()); + return implode("", $ps); +} + +function prn() { + $ps = array_map(function ($obj) { return _pr_str($obj, True); }, + func_get_args()); + print implode(" ", $ps) . "\n"; + return null; +} + +function println() { + $ps = array_map(function ($obj) { return _pr_str($obj, False); }, + func_get_args()); + print implode(" ", $ps) . "\n"; + return null; +} + + +// Hash Map functions +function assoc($src_hm) { + $args = func_get_args(); + $hm = clone $src_hm; + $args[0] = $hm; + return call_user_func_array('_assoc_BANG', $args); +} + +function dissoc($src_hm) { + $args = func_get_args(); + $hm = clone $src_hm; + $args[0] = $hm; + return call_user_func_array('_dissoc_BANG', $args); +} + +function get($hm, $k) { + if ($hm && $hm->offsetExists($k)) { + return $hm[$k]; + } else { + return NULL; + } +} + +function contains_Q($hm, $k) { return array_key_exists($k, $hm); } + +function keys($hm) { + return call_user_func_array('_list', array_keys($hm->getArrayCopy())); +} +function vals($hm) { + return call_user_func_array('_list', array_values($hm->getArrayCopy())); +} + + +// Sequence functions +function cons($a, $b) { + $tmp = $b->getArrayCopy(); + array_unshift($tmp, $a); + $l = new ListClass(); + $l->exchangeArray($tmp); + return $l; +} + +function concat() { + $args = func_get_args(); + $tmp = array(); + foreach ($args as $arg) { + $tmp = array_merge($tmp, $arg->getArrayCopy()); + } + $l = new ListClass(); + $l->exchangeArray($tmp); + return $l; +} + +function nth($seq, $idx) { + return $seq[$idx]; +} + +function first($seq) { + if (count($seq) === 0) { + return NULL; + } else { + return $seq[0]; + } +} + +function rest($seq) { + $l = new ListClass(); + $l->exchangeArray(array_slice($seq->getArrayCopy(), 1)); + return $l; +} + +function empty_Q($seq) { return $seq->count() === 0; } + +function scount($seq) { return ($seq === NULL ? 0 : $seq->count()); } + +function conj($src) { + $args = array_slice(func_get_args(), 1); + $tmp = $src->getArrayCopy(); + if (_list_Q($src)) { + foreach ($args as $arg) { array_unshift($tmp, $arg); } + $s = new ListClass(); + } else { + foreach ($args as $arg) { $tmp[] = $arg; } + $s = new VectorClass(); + } + $s->exchangeArray($tmp); + return $s; +} + +function apply($f) { + $args = array_slice(func_get_args(), 1); + $last_arg = array_pop($args)->getArrayCopy(); + return $f->apply(array_merge($args, $last_arg)); +} + +function map($f, $seq) { + $l = new ListClass(); + $l->exchangeArray(array_map($f, $seq->getArrayCopy())); + return $l; +} + + +// Metadata functions +function with_meta($obj, $m) { + $new_obj = clone $obj; + $new_obj->meta = $m; + return $new_obj; +} + +function meta($obj) { + return $obj->meta; +} + + +// Atom functions +function deref($atm) { return $atm->value; } +function reset_BANG($atm, $val) { return $atm->value = $val; } +function swap_BANG($atm, $f) { + $args = array_slice(func_get_args(),2); + array_unshift($args, $atm->value); + $atm->value = call_user_func_array($f, $args); + return $atm->value; +} + + +// core_ns is namespace of type functions +$core_ns = array( + '='=> function ($a, $b) { return _equal_Q($a, $b); }, + 'throw'=> function ($a) { return mal_throw($a); }, + 'nil?'=> function ($a) { return _nil_Q($a); }, + 'true?'=> function ($a) { return _true_Q($a); }, + 'false?'=> function ($a) { return _false_Q($a); }, + 'symbol'=> function () { return call_user_func_array('_symbol', func_get_args()); }, + 'symbol?'=> function ($a) { return _symbol_Q($a); }, + 'string?'=> function ($a) { return _string_Q($a); }, + 'pr-str'=> function () { return call_user_func_array('pr_str', func_get_args()); }, + 'str'=> function () { return call_user_func_array('str', func_get_args()); }, + 'prn'=> function () { return call_user_func_array('prn', func_get_args()); }, + 'println'=>function () { return call_user_func_array('println', func_get_args()); }, + '<'=> function ($a, $b) { return $a < $b; }, + '<='=> function ($a, $b) { return $a <= $b; }, + '>'=> function ($a, $b) { return $a > $b; }, + '>='=> function ($a, $b) { return $a >= $b; }, + '+'=> function ($a, $b) { return intval($a + $b,10); }, + '-'=> function ($a, $b) { return intval($a - $b,10); }, + '*'=> function ($a, $b) { return intval($a * $b,10); }, + '/'=> function ($a, $b) { return intval($a / $b,10); }, + + 'list'=> function () { return call_user_func_array('_list', func_get_args()); }, + 'list?'=> function ($a) { return _list_Q($a); }, + 'vector'=> function () { return call_user_func_array('_vector', func_get_args()); }, + 'vector?'=> function ($a) { return _vector_Q($a); }, + 'hash-map' => function () { return call_user_func_array('_hash_map', func_get_args()); }, + 'map?'=> function ($a) { return _hash_map_Q($a); }, + 'assoc' => function () { return call_user_func_array('assoc', func_get_args()); }, + 'dissoc' => function () { return call_user_func_array('dissoc', func_get_args()); }, + 'get' => function ($a, $b) { return get($a, $b); }, + 'contains?' => function ($a, $b) { return contains_Q($a, $b); }, + 'keys' => function ($a) { return keys($a); }, + 'vals' => function ($a) { return vals($a); }, + + 'sequential?'=> function ($a) { return _sequential_Q($a); }, + 'cons'=> function ($a, $b) { return cons($a, $b); }, + 'concat'=> function () { return call_user_func_array('concat', func_get_args()); }, + 'nth'=> function ($a, $b) { return nth($a, $b); }, + 'first'=> function ($a) { return first($a); }, + 'rest'=> function ($a) { return rest($a); }, + 'empty?'=> function ($a) { return empty_Q($a); }, + 'count'=> function ($a) { return scount($a); }, + 'conj'=> function () { return call_user_func_array('conj', func_get_args()); }, + 'apply'=> function () { return call_user_func_array('apply', func_get_args()); }, + 'map'=> function ($a, $b) { return map($a, $b); }, + + 'with-meta'=> function ($a, $b) { return with_meta($a, $b); }, + 'meta'=> function ($a) { return meta($a); }, + 'atom'=> function ($a) { return _atom($a); }, + 'atom?'=> function ($a) { return _atom_Q($a); }, + 'deref'=> function ($a) { return deref($a); }, + 'reset!'=> function ($a, $b) { return reset_BANG($a, $b); }, + 'swap!'=> function () { return call_user_func_array('swap_BANG', func_get_args()); }, +); + + +?> diff --git a/php/env.php b/php/env.php new file mode 100644 index 0000000..61bedaf --- /dev/null +++ b/php/env.php @@ -0,0 +1,56 @@ +<?php + +require_once 'types.php'; + +class Env { + public $data = array(); + public $outer = NULL; + public function __construct($outer, $binds=NULL, $exprs=NULL) { + $this->outer = $outer; + if ($binds) { + if (_sequential_Q($exprs)) { + $exprs = $exprs->getArrayCopy(); + } + for ($i=0; $i<count($binds); $i++) { + if ($binds[$i]->value === "&") { + if ($exprs !== NULL && $i < count($exprs)) { + $lst = call_user_func_array('_list', array_slice($exprs, $i)); + } else { + $lst = _list(); + } + $this->data[$binds[$i+1]->value] = $lst; + break; + } else { + if ($exprs !== NULL && $i < count($exprs)) { + $this->data[$binds[$i]->value] = $exprs[$i]; + } else { + $this->data[$binds[$i]->value] = NULL; + } + } + } + } + } + public function find($key) { + if (array_key_exists($key, $this->data)) { + return $this; + } elseif ($this->outer) { + return $this->outer->find($key); + } else { + return NULL; + } + } + public function set($key, $value) { + $this->data[$key] = $value; + return $value; + } + public function get($key) { + $env = $this->find($key); + if (!$env) { + throw new Exception("'" . $key . "' not found"); + } else { + return $env->data[$key]; + } + } +} + +?> diff --git a/php/printer.php b/php/printer.php new file mode 100644 index 0000000..3839931 --- /dev/null +++ b/php/printer.php @@ -0,0 +1,53 @@ +<?php + +require_once 'types.php'; + +function _pr_str($obj, $print_readably=True) { + if (_list_Q($obj)) { + $ret = array(); + foreach ($obj as $e) { + array_push($ret, _pr_str($e, $print_readably)); + } + return "(" . implode(" ", $ret) . ")"; + } elseif (_vector_Q($obj)) { + $ret = array(); + foreach ($obj as $e) { + array_push($ret, _pr_str($e, $print_readably)); + } + return "[" . implode(" ", $ret) . "]"; + } elseif (_hash_map_Q($obj)) { + $ret = array(); + foreach (array_keys($obj->getArrayCopy()) as $k) { + $ret[] = _pr_str($k, $print_readably); + $ret[] = _pr_str($obj[$k], $print_readably); + } + return "{" . implode(" ", $ret) . "}"; + } elseif (is_string($obj)) { + if ($print_readably) { + $obj = preg_replace('/"/', '\\"', preg_replace('/\\\\/', '\\\\\\\\', $obj)); + return '"' . $obj . '"'; + } else { + return $obj; + } + } elseif (is_integer($obj)) { + return $obj; + } elseif ($obj === NULL) { + return "nil"; + } elseif ($obj === true) { + return "true"; + } elseif ($obj === false) { + return "false"; + } elseif (_symbol_Q($obj)) { + return $obj->value; + } elseif (_atom_Q($obj)) { + return "(atom " . _pr_str($obj->value, $print_readably) . ")"; + } elseif (_function_Q($obj)) { + return "(fn* [...] ...)"; + } elseif (is_callable($obj)) { // only step4 and below + return "#<function ...>"; + } else { + throw new Exception("_pr_str unknown type: " . gettype($obj)); + } +} + +?> diff --git a/php/reader.php b/php/reader.php index 0524b31..83e0cff 100644 --- a/php/reader.php +++ b/php/reader.php @@ -10,9 +10,11 @@ class Reader { $this->position = 0; } public function next() { + if ($this->position >= count($this->tokens)) { return null; } return $this->tokens[$this->position++]; } public function peek() { + if ($this->position >= count($this->tokens)) { return null; } return $this->tokens[$this->position]; } } @@ -45,18 +47,18 @@ function read_atom($reader) { } elseif ($token === "false") { return false; } else { - return new_symbol($token); + return _symbol($token); } } -function read_list($reader, $constr='new_list', $start='(', $end=')') { +function read_list($reader, $constr='_list', $start='(', $end=')') { $ast = $constr(); $token = $reader->next(); if ($token !== $start) { throw new Exception("expected '" . $start . "'"); } while (($token = $reader->peek()) !== $end) { - if ($token === "") { + if ($token === "" || $token === null) { throw new Exception("expected '" . $end . "', got EOF"); } $ast[] = read_form($reader); @@ -66,39 +68,39 @@ function read_list($reader, $constr='new_list', $start='(', $end=')') { } function read_hash_map($reader) { - $lst = read_list($reader, 'new_list', '{', '}'); - return call_user_func_array('new_hash_map', $lst->getArrayCopy()); + $lst = read_list($reader, '_list', '{', '}'); + return call_user_func_array('_hash_map', $lst->getArrayCopy()); } function read_form($reader) { $token = $reader->peek(); switch ($token) { case '\'': $reader->next(); - return new_list(new_symbol('quote'), + return _list(_symbol('quote'), read_form($reader)); case '`': $reader->next(); - return new_list(new_symbol('quasiquote'), + return _list(_symbol('quasiquote'), read_form($reader)); case '~': $reader->next(); - return new_list(new_symbol('unquote'), + return _list(_symbol('unquote'), read_form($reader)); case '~@': $reader->next(); - return new_list(new_symbol('splice-unquote'), + return _list(_symbol('splice-unquote'), read_form($reader)); case '^': $reader->next(); $meta = read_form($reader); - return new_list(new_symbol('with-meta'), + return _list(_symbol('with-meta'), read_form($reader), $meta); case '@': $reader->next(); - return new_list(new_symbol('deref'), + return _list(_symbol('deref'), read_form($reader)); case ')': throw new Exception("unexpected ')'"); case '(': return read_list($reader); case ']': throw new Exception("unexpected ']'"); - case '[': return read_list($reader, 'new_vector', '[', ']'); + case '[': return read_list($reader, '_vector', '[', ']'); case '}': throw new Exception("unexpected '}'"); case '{': return read_hash_map($reader); diff --git a/php/step1_read_print.php b/php/step1_read_print.php index 01334e0..808ea09 100644 --- a/php/step1_read_print.php +++ b/php/step1_read_print.php @@ -3,6 +3,7 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; // read function READ($str) { diff --git a/php/step2_eval.php b/php/step2_eval.php index c9c3562..0ef184a 100644 --- a/php/step2_eval.php +++ b/php/step2_eval.php @@ -3,6 +3,7 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; // read function READ($str) { @@ -11,18 +12,18 @@ function READ($str) { // eval function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env[$ast->value]; - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -33,7 +34,7 @@ function eval_ast($ast, $env) { } function MAL_EVAL($ast, $env) { - if (!list_Q($ast)) { + if (!_list_Q($ast)) { return eval_ast($ast, $env); } diff --git a/php/step3_env.php b/php/step3_env.php index 15d7c5c..83ced32 100644 --- a/php/step3_env.php +++ b/php/step3_env.php @@ -3,6 +3,8 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; // read function READ($str) { @@ -11,18 +13,18 @@ function READ($str) { // eval function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -33,13 +35,14 @@ function eval_ast($ast, $env) { } function MAL_EVAL($ast, $env) { - if (!list_Q($ast)) { + #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; + if (!_list_Q($ast)) { return eval_ast($ast, $env); } // apply list $a0 = $ast[0]; - $a0v = (symbol_Q($a0) ? $a0->value : $a0); + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); diff --git a/php/step4_if_fn_do.php b/php/step4_if_fn_do.php index 3b9593d..25ca7c5 100644 --- a/php/step4_if_fn_do.php +++ b/php/step4_if_fn_do.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,18 +14,18 @@ function READ($str) { // eval function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -34,13 +37,13 @@ function eval_ast($ast, $env) { function MAL_EVAL($ast, $env) { #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!list_Q($ast)) { + if (!_list_Q($ast)) { return eval_ast($ast, $env); } // apply list $a0 = $ast[0]; - $a0v = (symbol_Q($a0) ? $a0->value : $a0); + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); switch ($a0v) { case "def!": $res = MAL_EVAL($ast[2], $env); @@ -88,8 +91,8 @@ function rep($str) { return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); } function _ref($k, $v) { global $repl_env; $repl_env->set($k, $v); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } // Defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); diff --git a/php/step5_tco.php b/php/step5_tco.php index 54d7699..0bf55ee 100644 --- a/php/step5_tco.php +++ b/php/step5_tco.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,18 +14,18 @@ function READ($str) { // eval function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -34,54 +37,56 @@ function eval_ast($ast, $env) { function MAL_EVAL($ast, $env) { while (true) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!list_Q($ast)) { - return eval_ast($ast, $env); - } - // apply list - $a0 = $ast[0]; - $a0v = (symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1]->value, $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); - } - return MAL_EVAL($ast[2], $let_env); - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; - case "fn*": - return new_function('MAL_EVAL', 'native', - new_hash_map('exp', $ast[2], - 'env', $env, - 'params', $ast[1])); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->meta['exp']; - $env = new Env($f->meta['env'], $f->meta['params'], $args); - } else { - return $f->apply($args); - } + #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; + if (!_list_Q($ast)) { + return eval_ast($ast, $env); + } + + // apply list + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1]->value, $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); + } + return MAL_EVAL($ast[2], $let_env); + case "do": + eval_ast($ast->slice(1, -1), $env); + $ast = $ast[count($ast)-1]; + break; + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; } + break; + case "fn*": + return _function('MAL_EVAL', 'native', + _hash_map('exp', $ast[2], + 'env', $env, + 'params', $ast[1])); + default: + $el = eval_ast($ast, $env); + $f = $el[0]; + $args = array_slice($el->getArrayCopy(), 1); + if ($f->type === 'native') { + $ast = $f->meta['exp']; + $env = new Env($f->meta['env'], $f->meta['params'], $args); + } else { + return $f->apply($args); + } + } + } } @@ -98,10 +103,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } // Defined using the language itself rep("(def! not (fn* (a) (if a false true)))"); diff --git a/php/step6_file.php b/php/step6_file.php index 37ea3c6..965ff88 100644 --- a/php/step6_file.php +++ b/php/step6_file.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,18 +14,18 @@ function READ($str) { // eval function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -34,54 +37,56 @@ function eval_ast($ast, $env) { function MAL_EVAL($ast, $env) { while (true) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!list_Q($ast)) { - return eval_ast($ast, $env); - } - // apply list - $a0 = $ast[0]; - $a0v = (symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1]->value, $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); - } - return MAL_EVAL($ast[2], $let_env); - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; - case "fn*": - return new_function('MAL_EVAL', 'native', - new_hash_map('exp', $ast[2], - 'env', $env, - 'params', $ast[1])); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->meta['exp']; - $env = new Env($f->meta['env'], $f->meta['params'], $args); - } else { - return $f->apply($args); - } + #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; + if (!_list_Q($ast)) { + return eval_ast($ast, $env); + } + + // apply list + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1]->value, $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); } + return MAL_EVAL($ast[2], $let_env); + case "do": + eval_ast($ast->slice(1, -1), $env); + $ast = $ast[count($ast)-1]; + break; + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; + } + break; + case "fn*": + return _function('MAL_EVAL', 'native', + _hash_map('exp', $ast[2], + 'env', $env, + 'params', $ast[1])); + default: + $el = eval_ast($ast, $env); + $f = $el[0]; + $args = array_slice($el->getArrayCopy(), 1); + if ($f->type === 'native') { + $ast = $f->meta['exp']; + $env = new Env($f->meta['env'], $f->meta['params'], $args); + } else { + return $f->apply($args); + } + } + } } @@ -98,10 +103,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } _ref('read-string', 'read_str'); _ref('eval', function($ast) { diff --git a/php/step7_quote.php b/php/step7_quote.php index b035be0..450f2b5 100644 --- a/php/step7_quote.php +++ b/php/step7_quote.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,37 +14,37 @@ function READ($str) { // eval function is_pair($x) { - return sequential_Q($x) and count($x) > 0; + return _sequential_Q($x) and count($x) > 0; } function quasiquote($ast) { if (!is_pair($ast)) { - return new_list(new_symbol("quote"), $ast); - } elseif (symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { + return _list(_symbol("quote"), $ast); + } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { return $ast[1]; - } elseif (is_pair($ast[0]) && symbol_Q($ast[0][0]) && + } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && $ast[0][0]->value === 'splice-unquote') { - return new_list(new_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); + return _list(_symbol("concat"), $ast[0][1], + quasiquote($ast->slice(1))); } else { - return new_list(new_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + return _list(_symbol("cons"), quasiquote($ast[0]), + quasiquote($ast->slice(1))); } } function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -53,58 +56,60 @@ function eval_ast($ast, $env) { function MAL_EVAL($ast, $env) { while (true) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!list_Q($ast)) { - return eval_ast($ast, $env); - } - // apply list - $a0 = $ast[0]; - $a0v = (symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1]->value, $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); - } - return MAL_EVAL($ast[2], $let_env); - case "quote": - return $ast[1]; - case "quasiquote": - return MAL_EVAL(quasiquote($ast[1]), $env); - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; - case "fn*": - return new_function('MAL_EVAL', 'native', - new_hash_map('exp', $ast[2], - 'env', $env, - 'params', $ast[1])); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->meta['exp']; - $env = new Env($f->meta['env'], $f->meta['params'], $args); - } else { - return $f->apply($args); - } + #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; + if (!_list_Q($ast)) { + return eval_ast($ast, $env); + } + + // apply list + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1]->value, $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); } + return MAL_EVAL($ast[2], $let_env); + case "quote": + return $ast[1]; + case "quasiquote": + return MAL_EVAL(quasiquote($ast[1]), $env); + case "do": + eval_ast($ast->slice(1, -1), $env); + $ast = $ast[count($ast)-1]; + break; + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; + } + break; + case "fn*": + return _function('MAL_EVAL', 'native', + _hash_map('exp', $ast[2], + 'env', $env, + 'params', $ast[1])); + default: + $el = eval_ast($ast, $env); + $f = $el[0]; + $args = array_slice($el->getArrayCopy(), 1); + if ($f->type === 'native') { + $ast = $f->meta['exp']; + $env = new Env($f->meta['env'], $f->meta['params'], $args); + } else { + return $f->apply($args); + } + } + } } @@ -121,10 +126,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } _ref('read-string', 'read_str'); _ref('eval', function($ast) { diff --git a/php/step8_macros.php b/php/step8_macros.php index 28014cd..3dea855 100644 --- a/php/step8_macros.php +++ b/php/step8_macros.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,27 +14,27 @@ function READ($str) { // eval function is_pair($x) { - return sequential_Q($x) and count($x) > 0; + return _sequential_Q($x) and count($x) > 0; } function quasiquote($ast) { if (!is_pair($ast)) { - return new_list(new_symbol("quote"), $ast); - } elseif (symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { + return _list(_symbol("quote"), $ast); + } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { return $ast[1]; - } elseif (is_pair($ast[0]) && symbol_Q($ast[0][0]) && + } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && $ast[0][0]->value === 'splice-unquote') { - return new_list(new_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); + return _list(_symbol("concat"), $ast[0][1], + quasiquote($ast->slice(1))); } else { - return new_list(new_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + return _list(_symbol("cons"), quasiquote($ast[0]), + quasiquote($ast->slice(1))); } } function is_macro_call($ast, $env) { return is_pair($ast) && - symbol_Q($ast[0]) && + _symbol_Q($ast[0]) && $env->find($ast[0]->value) && $env->get($ast[0]->value)->ismacro; } @@ -46,18 +49,18 @@ function macroexpand($ast, $env) { } function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -69,67 +72,69 @@ function eval_ast($ast, $env) { function MAL_EVAL($ast, $env) { while (true) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!list_Q($ast)) { - return eval_ast($ast, $env); - } - // apply list - $ast = macroexpand($ast, $env); - if (!list_Q($ast)) { return $ast; } - - $a0 = $ast[0]; - $a0v = (symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1]->value, $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); - } - return MAL_EVAL($ast[2], $let_env); - case "quote": - return $ast[1]; - case "quasiquote": - return MAL_EVAL(quasiquote($ast[1]), $env); - case "defmacro!": - $func = MAL_EVAL($ast[2], $env); - $func->ismacro = true; - return $env->set($ast[1]->value, $func); - case "macroexpand": - return macroexpand($ast[1], $env); - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; - case "fn*": - return new_function('MAL_EVAL', 'native', - new_hash_map('exp', $ast[2], - 'env', $env, - 'params', $ast[1])); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->meta['exp']; - $env = new Env($f->meta['env'], $f->meta['params'], $args); - } else { - return $f->apply($args); - } + #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; + if (!_list_Q($ast)) { + return eval_ast($ast, $env); + } + + // apply list + $ast = macroexpand($ast, $env); + if (!_list_Q($ast)) { return $ast; } + + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1]->value, $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); } + return MAL_EVAL($ast[2], $let_env); + case "quote": + return $ast[1]; + case "quasiquote": + return MAL_EVAL(quasiquote($ast[1]), $env); + case "defmacro!": + $func = MAL_EVAL($ast[2], $env); + $func->ismacro = true; + return $env->set($ast[1]->value, $func); + case "macroexpand": + return macroexpand($ast[1], $env); + case "do": + eval_ast($ast->slice(1, -1), $env); + $ast = $ast[count($ast)-1]; + break; + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; + } + break; + case "fn*": + return _function('MAL_EVAL', 'native', + _hash_map('exp', $ast[2], + 'env', $env, + 'params', $ast[1])); + default: + $el = eval_ast($ast, $env); + $f = $el[0]; + $args = array_slice($el->getArrayCopy(), 1); + if ($f->type === 'native') { + $ast = $f->meta['exp']; + $env = new Env($f->meta['env'], $f->meta['params'], $args); + } else { + return $f->apply($args); + } + } + } } @@ -146,10 +151,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } _ref('read-string', 'read_str'); _ref('eval', function($ast) { diff --git a/php/step9_interop.php b/php/step9_interop.php index 26e89f0..a699109 100644 --- a/php/step9_interop.php +++ b/php/step9_interop.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,27 +14,27 @@ function READ($str) { // eval function is_pair($x) { - return sequential_Q($x) and count($x) > 0; + return _sequential_Q($x) and count($x) > 0; } function quasiquote($ast) { if (!is_pair($ast)) { - return new_list(new_symbol("quote"), $ast); - } elseif (symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { + return _list(_symbol("quote"), $ast); + } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { return $ast[1]; - } elseif (is_pair($ast[0]) && symbol_Q($ast[0][0]) && + } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && $ast[0][0]->value === 'splice-unquote') { - return new_list(new_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); + return _list(_symbol("concat"), $ast[0][1], + quasiquote($ast->slice(1))); } else { - return new_list(new_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + return _list(_symbol("cons"), quasiquote($ast[0]), + quasiquote($ast->slice(1))); } } function is_macro_call($ast, $env) { return is_pair($ast) && - symbol_Q($ast[0]) && + _symbol_Q($ast[0]) && $env->find($ast[0]->value) && $env->get($ast[0]->value)->ismacro; } @@ -46,18 +49,18 @@ function macroexpand($ast, $env) { } function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -69,69 +72,71 @@ function eval_ast($ast, $env) { function MAL_EVAL($ast, $env) { while (true) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!list_Q($ast)) { - return eval_ast($ast, $env); - } - // apply list - $ast = macroexpand($ast, $env); - if (!list_Q($ast)) { return $ast; } - - $a0 = $ast[0]; - $a0v = (symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1]->value, $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); - } - return MAL_EVAL($ast[2], $let_env); - case "quote": - return $ast[1]; - case "quasiquote": - return MAL_EVAL(quasiquote($ast[1]), $env); - case "defmacro!": - $func = MAL_EVAL($ast[2], $env); - $func->ismacro = true; - return $env->set($ast[1]->value, $func); - case "macroexpand": - return macroexpand($ast[1], $env); - case "php*": - return eval($ast[1]); - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; - case "fn*": - return new_function('MAL_EVAL', 'native', - new_hash_map('exp', $ast[2], - 'env', $env, - 'params', $ast[1])); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->meta['exp']; - $env = new Env($f->meta['env'], $f->meta['params'], $args); - } else { - return $f->apply($args); - } + #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; + if (!_list_Q($ast)) { + return eval_ast($ast, $env); + } + + // apply list + $ast = macroexpand($ast, $env); + if (!_list_Q($ast)) { return $ast; } + + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1]->value, $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); } + return MAL_EVAL($ast[2], $let_env); + case "quote": + return $ast[1]; + case "quasiquote": + return MAL_EVAL(quasiquote($ast[1]), $env); + case "defmacro!": + $func = MAL_EVAL($ast[2], $env); + $func->ismacro = true; + return $env->set($ast[1]->value, $func); + case "macroexpand": + return macroexpand($ast[1], $env); + case "php*": + return eval($ast[1]); + case "do": + eval_ast($ast->slice(1, -1), $env); + $ast = $ast[count($ast)-1]; + break; + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; + } + break; + case "fn*": + return _function('MAL_EVAL', 'native', + _hash_map('exp', $ast[2], + 'env', $env, + 'params', $ast[1])); + default: + $el = eval_ast($ast, $env); + $f = $el[0]; + $args = array_slice($el->getArrayCopy(), 1); + if ($f->type === 'native') { + $ast = $f->meta['exp']; + $env = new Env($f->meta['env'], $f->meta['params'], $args); + } else { + return $f->apply($args); + } + } + } } @@ -148,10 +153,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } _ref('read-string', 'read_str'); _ref('eval', function($ast) { diff --git a/php/stepA_more.php b/php/stepA_more.php index dd004cf..4b8a270 100644 --- a/php/stepA_more.php +++ b/php/stepA_more.php @@ -3,6 +3,9 @@ require_once 'readline.php'; require_once 'types.php'; require_once 'reader.php'; +require_once 'printer.php'; +require_once 'env.php'; +require_once 'core.php'; // read function READ($str) { @@ -11,27 +14,27 @@ function READ($str) { // eval function is_pair($x) { - return sequential_Q($x) and count($x) > 0; + return _sequential_Q($x) and count($x) > 0; } function quasiquote($ast) { if (!is_pair($ast)) { - return new_list(new_symbol("quote"), $ast); - } elseif (symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { + return _list(_symbol("quote"), $ast); + } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { return $ast[1]; - } elseif (is_pair($ast[0]) && symbol_Q($ast[0][0]) && + } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && $ast[0][0]->value === 'splice-unquote') { - return new_list(new_symbol("concat"), $ast[0][1], - quasiquote($ast->slice(1))); + return _list(_symbol("concat"), $ast[0][1], + quasiquote($ast->slice(1))); } else { - return new_list(new_symbol("cons"), quasiquote($ast[0]), - quasiquote($ast->slice(1))); + return _list(_symbol("cons"), quasiquote($ast[0]), + quasiquote($ast->slice(1))); } } function is_macro_call($ast, $env) { return is_pair($ast) && - symbol_Q($ast[0]) && + _symbol_Q($ast[0]) && $env->find($ast[0]->value) && $env->get($ast[0]->value)->ismacro; } @@ -46,18 +49,18 @@ function macroexpand($ast, $env) { } function eval_ast($ast, $env) { - if (symbol_Q($ast)) { + if (_symbol_Q($ast)) { return $env->get($ast->value); - } elseif (list_Q($ast) || vector_Q($ast)) { - if (list_Q($ast)) { - $el = new_list(); + } elseif (_sequential_Q($ast)) { + if (_list_Q($ast)) { + $el = _list(); } else { - $el = new_vector(); + $el = _vector(); } foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } return $el; - } elseif (hash_map_Q($ast)) { - $new_hm = new_hash_map(); + } elseif (_hash_map_Q($ast)) { + $new_hm = _hash_map(); foreach (array_keys($ast->getArrayCopy()) as $key) { $new_hm[$key] = MAL_EVAL($ast[$key], $env); } @@ -69,87 +72,89 @@ function eval_ast($ast, $env) { function MAL_EVAL($ast, $env) { while (true) { - #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; - if (!list_Q($ast)) { - return eval_ast($ast, $env); - } - // apply list - $ast = macroexpand($ast, $env); - if (!list_Q($ast)) { return $ast; } - - $a0 = $ast[0]; - $a0v = (symbol_Q($a0) ? $a0->value : $a0); - switch ($a0v) { - case "def!": - $res = MAL_EVAL($ast[2], $env); - return $env->set($ast[1]->value, $res); - case "let*": - $a1 = $ast[1]; - $let_env = new Env($env); - for ($i=0; $i < count($a1); $i+=2) { - $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); - } - return MAL_EVAL($ast[2], $let_env); - case "quote": - return $ast[1]; - case "quasiquote": - return MAL_EVAL(quasiquote($ast[1]), $env); - case "defmacro!": - $func = MAL_EVAL($ast[2], $env); - $func->ismacro = true; - return $env->set($ast[1]->value, $func); - case "macroexpand": - return macroexpand($ast[1], $env); - case "php*": - return eval($ast[1]); - case "try*": - $a1 = $ast[1]; - $a2 = $ast[2]; - if ($a2[0]->value === "catch*") { - try { - return MAL_EVAL($a1, $env); - } catch (Error $e) { - $catch_env = new Env($env, array($a2[1]), - array($e->obj)); - return MAL_EVAL($a2[2], $catch_env); - } catch (Exception $e) { - $catch_env = new Env($env, array($a2[1]), - array($e->getMessage())); - return MAL_EVAL($a2[2], $catch_env); - } - } else { + #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; + if (!_list_Q($ast)) { + return eval_ast($ast, $env); + } + + // apply list + $ast = macroexpand($ast, $env); + if (!_list_Q($ast)) { return $ast; } + + $a0 = $ast[0]; + $a0v = (_symbol_Q($a0) ? $a0->value : $a0); + switch ($a0v) { + case "def!": + $res = MAL_EVAL($ast[2], $env); + return $env->set($ast[1]->value, $res); + case "let*": + $a1 = $ast[1]; + $let_env = new Env($env); + for ($i=0; $i < count($a1); $i+=2) { + $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); + } + return MAL_EVAL($ast[2], $let_env); + case "quote": + return $ast[1]; + case "quasiquote": + return MAL_EVAL(quasiquote($ast[1]), $env); + case "defmacro!": + $func = MAL_EVAL($ast[2], $env); + $func->ismacro = true; + return $env->set($ast[1]->value, $func); + case "macroexpand": + return macroexpand($ast[1], $env); + case "php*": + return eval($ast[1]); + case "try*": + $a1 = $ast[1]; + $a2 = $ast[2]; + if ($a2[0]->value === "catch*") { + try { return MAL_EVAL($a1, $env); + } catch (Error $e) { + $catch_env = new Env($env, array($a2[1]), + array($e->obj)); + return MAL_EVAL($a2[2], $catch_env); + } catch (Exception $e) { + $catch_env = new Env($env, array($a2[1]), + array($e->getMessage())); + return MAL_EVAL($a2[2], $catch_env); } - case "do": - eval_ast($ast->slice(1, -1), $env); - $ast = $ast[count($ast)-1]; - break; - case "if": - $cond = MAL_EVAL($ast[1], $env); - if ($cond === NULL || $cond === false) { - if (count($ast) === 4) { $ast = $ast[3]; } - else { $ast = NULL; } - } else { - $ast = $ast[2]; - } - break; - case "fn*": - return new_function('MAL_EVAL', 'native', - new_hash_map('exp', $ast[2], - 'env', $env, - 'params', $ast[1])); - default: - $el = eval_ast($ast, $env); - $f = $el[0]; - $args = array_slice($el->getArrayCopy(), 1); - if ($f->type === 'native') { - $ast = $f->meta['exp']; - $env = new Env($f->meta['env'], $f->meta['params'], $args); - } else { - return $f->apply($args); - } + } else { + return MAL_EVAL($a1, $env); + } + case "do": + eval_ast($ast->slice(1, -1), $env); + $ast = $ast[count($ast)-1]; + break; + case "if": + $cond = MAL_EVAL($ast[1], $env); + if ($cond === NULL || $cond === false) { + if (count($ast) === 4) { $ast = $ast[3]; } + else { $ast = NULL; } + } else { + $ast = $ast[2]; } + break; + case "fn*": + return _function('MAL_EVAL', 'native', + _hash_map('exp', $ast[2], + 'env', $env, + 'params', $ast[1])); + default: + $el = eval_ast($ast, $env); + $f = $el[0]; + $args = array_slice($el->getArrayCopy(), 1); + if ($f->type === 'native') { + $ast = $f->meta['exp']; + $env = new Env($f->meta['env'], $f->meta['params'], $args); + } else { + return $f->apply($args); + } + } + } } @@ -166,10 +171,10 @@ function rep($str) { } function _ref($k, $v) { global $repl_env; - $repl_env->set($k, new_function($v)); + $repl_env->set($k, _function($v)); } -// Import types functions -foreach ($types_ns as $k=>$v) { _ref($k, $v); } +// Import core functions +foreach ($core_ns as $k=>$v) { _ref($k, $v); } _ref('readline', 'mal_readline'); _ref('read-string', 'read_str'); diff --git a/php/types.php b/php/types.php index 4486a18..6094558 100644 --- a/php/types.php +++ b/php/types.php @@ -1,101 +1,30 @@ <?php -function _pr_str($obj, $print_readably=True) { - if (list_Q($obj)) { - $ret = array(); - foreach ($obj as $e) { - array_push($ret, _pr_str($e, $print_readably)); - } - return "(" . implode(" ", $ret) . ")"; - } elseif (vector_Q($obj)) { - $ret = array(); - foreach ($obj as $e) { - array_push($ret, _pr_str($e, $print_readably)); - } - return "[" . implode(" ", $ret) . "]"; - } elseif (hash_map_Q($obj)) { - $ret = array(); - foreach (array_keys($obj->getArrayCopy()) as $k) { - $ret[] = _pr_str($k, $print_readably); - $ret[] = _pr_str($obj[$k], $print_readably); - } - return "{" . implode(" ", $ret) . "}"; - } elseif (is_string($obj)) { - if ($print_readably) { - $obj = preg_replace('/"/', '\\"', preg_replace('/\\\\/', '\\\\\\\\', $obj)); - return '"' . $obj . '"'; - } else { - return $obj; - } - } elseif (is_integer($obj)) { - return $obj; - } elseif ($obj === NULL) { - return "nil"; - } elseif ($obj === true) { - return "true"; - } elseif ($obj === false) { - return "false"; - } elseif (symbol_Q($obj)) { - return $obj->value; - } elseif (atom_Q($obj)) { - return "(atom " . _pr_str($obj->value, $print_readably) . ")"; - } elseif (function_Q($obj)) { - return "(fn* [...] ...)"; - } elseif (is_callable($obj)) { // only step4 and below - return "#<function ...>"; - } else { - throw new Exception("_pr_str unknown type: " . gettype($obj)); - } -} -function pr_str() { - $ps = array_map(function ($obj) { return _pr_str($obj, True); }, - func_get_args()); - return implode(" ", $ps); -} - -function str() { - $ps = array_map(function ($obj) { return _pr_str($obj, False); }, - func_get_args()); - return implode("", $ps); -} - -function prn() { - $ps = array_map(function ($obj) { return _pr_str($obj, True); }, - func_get_args()); - print implode(" ", $ps) . "\n"; - return null; -} - -function println() { - $ps = array_map(function ($obj) { return _pr_str($obj, False); }, - func_get_args()); - print implode(" ", $ps) . "\n"; - return null; +// Errors/Exceptions +class Error extends Exception { + public $obj = null; + public function __construct($obj) { + parent::__construct("Mal Error", 0, null); + $this->obj = $obj; + } } -function with_meta($obj, $m) { - $new_obj = clone $obj; - $new_obj->meta = $m; - return $new_obj; -} -function meta($obj) { - return $obj->meta; -} +// General functions -function equal_Q($a, $b) { +function _equal_Q($a, $b) { $ota = gettype($a) === "object" ? get_class($a) : gettype($a); $otb = gettype($b) === "object" ? get_class($b) : gettype($b); - if (!($ota === $otb or (sequential_Q($a) and sequential_Q($b)))) { + if (!($ota === $otb or (_sequential_Q($a) and _sequential_Q($b)))) { return false; - } elseif (symbol_Q($a)) { + } elseif (_symbol_Q($a)) { #print "ota: $ota, otb: $otb\n"; return $a->value === $b->value; - } elseif (list_Q($a) or vector_Q($a)) { + } elseif (_list_Q($a) or _vector_Q($a)) { if ($a->count() !== $b->count()) { return false; } for ($i=0; $i<$a->count(); $i++) { - if (!equal_Q($a[$i], $b[$i])) { return false; } + if (!_equal_Q($a[$i], $b[$i])) { return false; } } return true; } else { @@ -103,14 +32,17 @@ function equal_Q($a, $b) { } } -// nil, true, false, string -function nil_Q($obj) { return $obj === NULL; } -function true_Q($obj) { return $obj === true; } -function false_Q($obj) { return $obj === false; } -function string_Q($obj) { return is_string($obj); } +function _sequential_Q($seq) { return _list_Q($seq) or _vector_Q($seq); } -// symbols +// Scalars +function _nil_Q($obj) { return $obj === NULL; } +function _true_Q($obj) { return $obj === true; } +function _false_Q($obj) { return $obj === false; } +function _string_Q($obj) { return is_string($obj); } + + +// Symbols class SymbolClass { public $value = NULL; public $meta = NULL; @@ -118,10 +50,8 @@ class SymbolClass { $this->value = $value; } } - -function new_symbol($name) { return new SymbolClass($name); } - -function symbol_Q($obj) { return ($obj instanceof SymbolClass); } +function _symbol($name) { return new SymbolClass($name); } +function _symbol_Q($obj) { return ($obj instanceof SymbolClass); } // Functions @@ -152,11 +82,11 @@ class FunctionClass { } } -function new_function($func, $type='platform', $meta=NULL, $ismacro=False) { +function _function($func, $type='platform', $meta=NULL, $ismacro=False) { return new FunctionClass($func, $type, $meta, $ismacro); } +function _function_Q($obj) { return $obj instanceof FunctionClass; } -function function_Q($obj) { return $obj instanceof FunctionClass; } // Parent class of list, vector, hash-map // http://www.php.net/manual/en/class.arrayobject.php @@ -174,24 +104,49 @@ class SeqClass extends ArrayObject { } +// Lists +class ListClass extends SeqClass { + public $meta = NULL; +} + +function _list() { + $v = new ListClass(); + $v->exchangeArray(func_get_args()); + return $v; +} +function _list_Q($obj) { return $obj instanceof ListClass; } + + +// Vectors +class VectorClass extends SeqClass { + public $meta = NULL; +} + +function _vector() { + $v = new VectorClass(); + $v->exchangeArray(func_get_args()); + return $v; +} +function _vector_Q($obj) { return $obj instanceof VectorClass; } + + // Hash Maps class HashMapClass extends ArrayObject { public $meta = NULL; } -function new_hash_map() { +function _hash_map() { $args = func_get_args(); if (count($args) % 2 === 1) { throw new Exception("Odd number of hash map arguments"); } $hm = new HashMapClass(); array_unshift($args, $hm); - return call_user_func_array('assoc_BANG', $args); + return call_user_func_array('_assoc_BANG', $args); } +function _hash_map_Q($obj) { return $obj instanceof HashMapClass; } -function hash_map_Q($obj) { return $obj instanceof HashMapClass; } - -function assoc_BANG($hm) { +function _assoc_BANG($hm) { $args = func_get_args(); if (count($args) % 2 !== 1) { throw new Exception("Odd number of assoc arguments"); @@ -208,14 +163,7 @@ function assoc_BANG($hm) { return $hm; } -function assoc($src_hm) { - $args = func_get_args(); - $hm = clone $src_hm; - $args[0] = $hm; - return call_user_func_array('assoc_BANG', $args); -} - -function dissoc_BANG($hm) { +function _dissoc_BANG($hm) { $args = func_get_args(); for ($i=1; $i<count($args); $i++) { $ktoken = $args[$i]; @@ -224,72 +172,8 @@ function dissoc_BANG($hm) { return $hm; } -function dissoc($src_hm) { - $args = func_get_args(); - $hm = clone $src_hm; - $args[0] = $hm; - return call_user_func_array('dissoc_BANG', $args); -} - -function get($hm, $k) { - if ($hm && $hm->offsetExists($k)) { - return $hm[$k]; - } else { - return NULL; - } -} - -function contains_Q($hm, $k) { return array_key_exists($k, $hm); } - -function keys($hm) { - return call_user_func_array('new_list', array_keys($hm->getArrayCopy())); -} -function vals($hm) { - return call_user_func_array('new_list', array_values($hm->getArrayCopy())); -} - - -// errors/exceptions -class Error extends Exception { - public $obj = null; - public function __construct($obj) { - parent::__construct("Mal Error", 0, null); - $this->obj = $obj; - } -} - -function mal_throw($obj) { throw new Error($obj); } - - -// lists -class ListClass extends SeqClass { - public $meta = NULL; -} - -function new_list() { - $v = new ListClass(); - $v->exchangeArray(func_get_args()); - return $v; -} - -function list_Q($obj) { return $obj instanceof ListClass; } - -// vectors -class VectorClass extends SeqClass { - public $meta = NULL; -} - -function new_vector() { - $v = new VectorClass(); - $v->exchangeArray(func_get_args()); - return $v; -} - -function vector_Q($obj) { return $obj instanceof VectorClass; } - // Atoms - class Atom { public $value = NULL; public $meta = NULL; @@ -297,193 +181,7 @@ class Atom { $this->value = $value; } } -function new_atom($val) { return new Atom($val); } -function atom_Q($atm) { return $atm instanceof Atom; } -function deref($atm) { return $atm->value; } -function reset_BANG($atm, $val) { return $atm->value = $val; } -function swap_BANG($atm, $f) { - $args = array_slice(func_get_args(),2); - array_unshift($args, $atm->value); - $atm->value = call_user_func_array($f, $args); - return $atm->value; -} - - -// Sequence operations -function sequential_Q($seq) { return list_Q($seq) or vector_Q($seq); } - -function scount($seq) { return ($seq === NULL ? 0 : $seq->count()); } - -function empty_Q($seq) { return $seq->count() === 0; } - -function cons($a, $b) { - $tmp = $b->getArrayCopy(); - array_unshift($tmp, $a); - $l = new ListClass(); - $l->exchangeArray($tmp); - return $l; -} - -function concat() { - $args = func_get_args(); - $tmp = array(); - foreach ($args as $arg) { - $tmp = array_merge($tmp, $arg->getArrayCopy()); - } - $l = new ListClass(); - $l->exchangeArray($tmp); - return $l; -} - -function conj($src) { - $args = array_slice(func_get_args(), 1); - $tmp = $src->getArrayCopy(); - if (list_Q($src)) { - foreach ($args as $arg) { array_unshift($tmp, $arg); } - $s = new ListClass(); - } else { - foreach ($args as $arg) { $tmp[] = $arg; } - $s = new VectorClass(); - } - $s->exchangeArray($tmp); - return $s; -} - -function first($seq) { - if (count($seq) === 0) { - return NULL; - } else { - return $seq[0]; - } -} - -function rest($seq) { - $l = new ListClass(); - $l->exchangeArray(array_slice($seq->getArrayCopy(), 1)); - return $l; -} - -function nth($seq, $idx) { - return $seq[$idx]; -} - -function apply($f) { - $args = array_slice(func_get_args(), 1); - $last_arg = array_pop($args)->getArrayCopy(); - return $f->apply(array_merge($args, $last_arg)); -} - -function map($f, $seq) { - $l = new ListClass(); - $l->exchangeArray(array_map($f, $seq->getArrayCopy())); - return $l; -} - - -// Environment -class Env { - public $data = array(); - public $outer = NULL; - public function __construct($outer, $binds=NULL, $exprs=NULL) { - $this->outer = $outer; - if ($binds) { - if (sequential_Q($exprs)) { - $exprs = $exprs->getArrayCopy(); - } - for ($i=0; $i<count($binds); $i++) { - if ($binds[$i]->value === "&") { - if ($exprs !== NULL && $i < count($exprs)) { - $lst = call_user_func_array('new_list', array_slice($exprs, $i)); - } else { - $lst = new_list(); - } - $this->data[$binds[$i+1]->value] = $lst; - break; - } else { - if ($exprs !== NULL && $i < count($exprs)) { - $this->data[$binds[$i]->value] = $exprs[$i]; - } else { - $this->data[$binds[$i]->value] = NULL; - } - } - } - } - } - public function find($key) { - if (array_key_exists($key, $this->data)) { - return $this; - } elseif ($this->outer) { - return $this->outer->find($key); - } else { - return NULL; - } - } - public function set($key, $value) { - $this->data[$key] = $value; - return $value; - } - public function get($key) { - $env = $this->find($key); - if (!$env) { - throw new Exception("'" . $key . "' not found"); - } else { - return $env->data[$key]; - } - } -} - -// types_ns is namespace of type functions -$types_ns = array( - 'pr-str'=> function () { return call_user_func_array('pr_str', func_get_args()); }, - 'str'=> function () { return call_user_func_array('str', func_get_args()); }, - 'prn'=> function () { return call_user_func_array('prn', func_get_args()); }, - 'println'=>function () { return call_user_func_array('println', func_get_args()); }, - 'with-meta'=> function ($a, $b) { return with_meta($a, $b); }, - 'meta'=> function ($a) { return meta($a); }, - '='=> function ($a, $b) { return equal_Q($a, $b); }, - 'nil?'=> function ($a) { return nil_Q($a); }, - 'true?'=> function ($a) { return true_Q($a); }, - 'false?'=> function ($a) { return false_Q($a); }, - '+'=> function ($a, $b) { return intval($a + $b,10); }, - '-'=> function ($a, $b) { return intval($a - $b,10); }, - '*'=> function ($a, $b) { return intval($a * $b,10); }, - '/'=> function ($a, $b) { return intval($a / $b,10); }, - '<'=> function ($a, $b) { return $a < $b; }, - '<='=> function ($a, $b) { return $a <= $b; }, - '>'=> function ($a, $b) { return $a > $b; }, - '>='=> function ($a, $b) { return $a >= $b; }, - 'symbol?'=> function ($a) { return symbol_Q($a); }, - 'string?'=> function ($a) { return string_Q($a); }, - 'hash-map' => function () { return call_user_func_array('new_hash_map', func_get_args()); }, - 'map?'=> function ($a) { return hash_map_Q($a); }, - 'assoc' => function () { return call_user_func_array('assoc', func_get_args()); }, - 'dissoc' => function () { return call_user_func_array('dissoc', func_get_args()); }, - 'get' => function ($a, $b) { return get($a, $b); }, - 'contains?' => function ($a, $b) { return contains_Q($a, $b); }, - 'keys' => function ($a) { return keys($a); }, - 'vals' => function ($a) { return vals($a); }, - 'throw'=> function ($a) { return mal_throw($a); }, - 'list'=> function () { return call_user_func_array('new_list', func_get_args()); }, - 'list?'=> function ($a) { return list_Q($a); }, - 'vector'=> function () { return call_user_func_array('new_vector', func_get_args()); }, - 'vector?'=> function ($a) { return vector_Q($a); }, - 'atom'=> function ($a) { return new_atom($a); }, - 'atom?'=> function ($a) { return atom_Q($a); }, - 'deref'=> function ($a) { return deref($a); }, - 'reset!'=> function ($a, $b) { return reset_BANG($a, $b); }, - 'swap!'=> function () { return call_user_func_array('swap_BANG', func_get_args()); }, - 'sequential?'=> function ($a) { return sequential_Q($a); }, - 'count'=> function ($a) { return scount($a); }, - 'empty?'=> function ($a) { return empty_Q($a); }, - 'cons'=> function ($a, $b) { return cons($a, $b); }, - 'concat'=> function () { return call_user_func_array('concat', func_get_args()); }, - 'conj'=> function () { return call_user_func_array('conj', func_get_args()); }, - 'first'=> function ($a) { return first($a); }, - 'rest'=> function ($a) { return rest($a); }, - 'nth'=> function ($a, $b) { return nth($a, $b); }, - 'apply'=> function () { return call_user_func_array('apply', func_get_args()); }, - 'map'=> function ($a, $b) { return map($a, $b); } -); - +function _atom($val) { return new Atom($val); } +function _atom_Q($atm) { return $atm instanceof Atom; } ?> diff --git a/ps/Makefile b/ps/Makefile index 231e8aa..fd5ca70 100644 --- a/ps/Makefile +++ b/ps/Makefile @@ -1,7 +1,7 @@ TESTS = -SOURCES = types.ps reader.ps step8_macros.ps +SOURCES = types.ps reader.ps printer.ps env.ps core.ps stepA_more.ps .PHONY: stats tests $(TESTS) diff --git a/ps/core.ps b/ps/core.ps new file mode 100644 index 0000000..09bfe2b --- /dev/null +++ b/ps/core.ps @@ -0,0 +1,126 @@ +(in core.ps\n) print + +% requires types.ps + +% Errors/Exceptions + +% data -> throw -> +% Takes an arbitrary data and puts it in $error:/errorinfo. Then calls +% stop to transfer control to end of nearest stopped context. +/throw { + $error exch /errorinfo exch put + $error /command /throw put + stop +} def + + +% sequence functions + +% [obj list] -> cons -> new_list +/cons { + /args exch def + /elem args 0 get def + /lst args 1 get def + lst length 1 add array + dup 0 elem put % first element + dup 1 lst putinterval % rest of the elements +} def + +% [listA listB] -> concat -> [listA... listB...] +/concat { % replaces matric concat + dup length 0 eq { %if just concat + 0 _list + }{ dup length 1 eq { %elseif concat of single item + 0 get % noop + }{ % else + [] exch + { + concatenate + } forall + } ifelse } ifelse +} def + +% [obj ...] -> first -> obj +/first { + 0 get _first +} def + +% [obj objs...] -> first -> [objs..] +/rest { + 0 get _rest +} def + +% [function args... arg_list] -> apply -> result +/apply { 1 dict begin + /args exch def + args 0 get callable % make sure function is callable + args 1 args length 2 sub getinterval + args args length 1 sub get + concatenate args 0 get % stack: args function + exec +end } def + +% [function list] -> _map -> new_list +/map { 1 dict begin + dup 0 get exch 1 get % stack: function list + /args exch def + callable % make sure function is callable + %/new_list args length array def + args { + 1 array astore + exch dup 3 1 roll % stack: fn arg fn + exec exch % stack: result fn + } forall + pop % remove the function + args length array astore +end } def + +/conj { 5 dict begin + /args exch def + /src_list args 0 get def + /new_len src_list length args length 1 sub add def + /new_list new_len array def + new_list new_len src_list length sub src_list putinterval + args length 1 sub -1 1 { + /idx exch def + new_list args length idx sub 1 sub args idx get put + } for + new_list +end } def + + +% core_ns is namespace of core functions + +/core_ns << + (pr-str) { ( ) true _pr_str_args } + (str) { () false _pr_str_args } + (prn) { ( ) true _pr_str_args print (\n) print null } + (println) { () false _pr_str_args print (\n) print null } + (=) { dup 0 get exch 1 get _equal? } + (symbol?) { 0 get _symbol? } + (nil?) { 0 get _nil? } + (true?) { 0 get _true? } + (false?) { 0 get _false? } + (<) { dup 0 get exch 1 get lt } + (<=) { dup 0 get exch 1 get le } + (>) { dup 0 get exch 1 get gt } + (>=) { dup 0 get exch 1 get ge } + (+) { dup 0 get exch 1 get add } + (-) { dup 0 get exch 1 get sub } + (*) { dup 0 get exch 1 get mul } + (/) { dup 0 get exch 1 get idiv } + (throw) { 0 get throw } + (list) { dup pop } % noop + (list?) { 0 get _list? } + (cons) { cons } + (concat) { concat } + (sequential?) { 0 get _sequential? } + (empty?) { 0 get length 0 eq } + (count) { 0 get length } + (nth) { dup 0 get exch 1 get _nth } + (first) { first } + (rest) { rest } + (apply) { apply } + (map) { map } + (conj) { conj } +>> def diff --git a/ps/printer.ps b/ps/printer.ps new file mode 100644 index 0000000..c2e42a5 --- /dev/null +++ b/ps/printer.ps @@ -0,0 +1,61 @@ +(in types.ps\n) print + +% requires types.ps to be included first + +/_pr_str { 4 dict begin + /print_readably exch def + dup + /func? exch xcheck def % executable function + /obj exch cvlit def + obj _mal_function? { % if user defined function + (<\(fn* ) + obj /params get print_readably _pr_str + ( ) + obj /ast get print_readably _pr_str + (\)>) + concatenate concatenate concatenate concatenate + }{ /arraytype obj type eq { % if list or code block + % accumulate an array of strings + func? { (<builtin_fn* { ) }{ (\() } ifelse + obj ( ) print_readably _pr_str_args + concatenate + func? { ( } >) }{ (\)) } ifelse + concatenate + }{ /integertype obj type eq { % if number + /slen obj 10 add log ceiling cvi def + obj 10 slen string cvrs + }{ /stringtype obj type eq { % if string + print_readably { + (") obj (") concatenate concatenate + }{ + obj + } ifelse + }{ null obj eq { % if nil + (nil) + }{ true obj eq { % if true + (true) + }{ false obj eq { % if false + (false) + }{ /nametype obj type eq { % if symbol + obj dup length string cvs + }{ + (<unknown>) + } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse +end } def + +% array delim print_readably -> _pr_str_args -> new_string +/_pr_str_args { 3 dict begin + /print_readably exch def + /delim exch def + /args exch def + () + args length 0 gt { %if any elements + [ + args { %foreach argument in array + print_readably _pr_str + } forall + ] + { concatenate delim concatenate } forall + dup length delim length sub 0 exch getinterval % strip off final delim + } if +end } def diff --git a/ps/reader.ps b/ps/reader.ps index dba2a4a..948bf3b 100644 --- a/ps/reader.ps +++ b/ps/reader.ps @@ -1,5 +1,6 @@ (in reader\n) print +% requires types.ps to be included first /token_delim (;,"` \n{}\(\)[]) def /token_number (0123456789-) def diff --git a/ps/step1_read_print.ps b/ps/step1_read_print.ps index aa2ce25..b4c6275 100644 --- a/ps/step1_read_print.ps +++ b/ps/step1_read_print.ps @@ -1,5 +1,6 @@ (types.ps) run (reader.ps) run +(printer.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def diff --git a/ps/step2_eval.ps b/ps/step2_eval.ps index b353f8e..7b03a99 100644 --- a/ps/step2_eval.ps +++ b/ps/step2_eval.ps @@ -1,5 +1,6 @@ (types.ps) run (reader.ps) run +(printer.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def diff --git a/ps/step3_env.ps b/ps/step3_env.ps index a86e036..49d37c4 100644 --- a/ps/step3_env.ps +++ b/ps/step3_env.ps @@ -1,5 +1,7 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def diff --git a/ps/step4_if_fn_do.ps b/ps/step4_if_fn_do.ps index 11c475f..f703830 100644 --- a/ps/step4_if_fn_do.ps +++ b/ps/step4_if_fn_do.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -113,7 +116,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop diff --git a/ps/step5_tco.ps b/ps/step5_tco.ps index a501b06..2bc898a 100644 --- a/ps/step5_tco.ps +++ b/ps/step5_tco.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -123,7 +126,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop diff --git a/ps/step6_file.ps b/ps/step6_file.ps index b90bac5..f6f4377 100644 --- a/ps/step6_file.ps +++ b/ps/step6_file.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -123,7 +126,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (read-string) { 0 get read_str } _ref (eval) { 0 get repl_env EVAL } _ref diff --git a/ps/step7_quote.ps b/ps/step7_quote.ps index 9ca3eb5..9858b4f 100644 --- a/ps/step7_quote.ps +++ b/ps/step7_quote.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -155,7 +158,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (read-string) { 0 get read_str } _ref (eval) { 0 get repl_env EVAL } _ref diff --git a/ps/step8_macros.ps b/ps/step8_macros.ps index cfce140..869bf96 100644 --- a/ps/step8_macros.ps +++ b/ps/step8_macros.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -198,7 +201,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (read-string) { 0 get read_str } _ref (eval) { 0 get repl_env EVAL } _ref diff --git a/ps/step9_interop.ps b/ps/step9_interop.ps index 743422b..f8d3250 100644 --- a/ps/step9_interop.ps +++ b/ps/step9_interop.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -212,7 +215,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (read-string) { 0 get read_str } _ref (eval) { 0 get repl_env EVAL } _ref diff --git a/ps/stepA_more.ps b/ps/stepA_more.ps index 66494cc..a273c02 100644 --- a/ps/stepA_more.ps +++ b/ps/stepA_more.ps @@ -1,5 +1,8 @@ (types.ps) run (reader.ps) run +(printer.ps) run +(env.ps) run +(core.ps) run % read /_readline { print flush (%stdin) (r) file 99 string readline } def @@ -254,7 +257,7 @@ end } def /REP { READ repl_env EVAL PRINT } def /_ref { repl_env 3 1 roll env_set pop } def -types_ns { _ref } forall +core_ns { _ref } forall (readline) { 0 get _readline not { null } if } _ref (read-string) { 0 get read_str } _ref diff --git a/ps/types.ps b/ps/types.ps index 30019b9..c696d35 100644 --- a/ps/types.ps +++ b/ps/types.ps @@ -1,5 +1,7 @@ (in types.ps\n) print +% General functions + % concatenate: concatenate two strings or two arrays % From Thinking in PostScript 1990 Reid % (string1) (string2) concatenate string3 @@ -30,64 +32,6 @@ ] } bind def -/_pr_str { 4 dict begin - /print_readably exch def - dup - /func? exch xcheck def % executable function - /obj exch cvlit def - obj _mal_function? { % if user defined function - (<\(fn* ) - obj /params get print_readably _pr_str - ( ) - obj /ast get print_readably _pr_str - (\)>) - concatenate concatenate concatenate concatenate - }{ /arraytype obj type eq { % if list or code block - % accumulate an array of strings - func? { (<builtin_fn* { ) }{ (\() } ifelse - obj ( ) print_readably _pr_str_args - concatenate - func? { ( } >) }{ (\)) } ifelse - concatenate - }{ /integertype obj type eq { % if number - /slen obj 10 add log ceiling cvi def - obj 10 slen string cvrs - }{ /stringtype obj type eq { % if string - print_readably { - (") obj (") concatenate concatenate - }{ - obj - } ifelse - }{ null obj eq { % if nil - (nil) - }{ true obj eq { % if true - (true) - }{ false obj eq { % if false - (false) - }{ /nametype obj type eq { % if symbol - obj dup length string cvs - }{ - (<unknown>) - } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse -end } def - -% array delim print_readably -> _pr_str_args -> new_string -/_pr_str_args { 3 dict begin - /print_readably exch def - /delim exch def - /args exch def - () - args length 0 gt { %if any elements - [ - args { %foreach argument in array - print_readably _pr_str - } forall - ] - { concatenate delim concatenate } forall - dup length delim length sub 0 exch getinterval % strip off final delim - } if -end } def - % objA objB -> _equal? -> bool /_equal? { 6 dict begin /b exch def @@ -120,54 +64,22 @@ end } def } ifelse end } def -/_nil? { null eq } def -/_true? { true eq } def -/_false? { false eq } def - +/_sequential? { _list? } def -% -% Symbols -% -/_symbol? { - type /nametype eq +/_first { + dup length 0 gt { 0 get }{ pop null } ifelse } def - -% -% Functions -% -/_mal_function? { - dup type /dicttype eq { - /type get /_maltype_function eq +/_rest { + dup length 0 gt { + dup length 1 sub 1 exch getinterval }{ - pop false + pop 0 array } ifelse } def -% args mal_function -> fload -> ast new_env -% fload: sets up arguments on the stack for an EVAL call -/fload { - dup /ast get 3 1 roll % stack: ast args mal_function - dup /env get 3 1 roll % stack: ast env args mal_function - /params get exch % stack: ast env params args - env_new % stack: ast new_env -} def -% function_or_block -> callable -> block -% if this is a user defined mal function, get its executable block -/callable { dup _mal_function? { /data get } if } def -% % Errors/Exceptions -% - -% data -> throw -> -% Takes an arbitrary data and puts it in $error:/errorinfo. Then calls -% stop to transfer control to end of nearest stopped context. -/throw { - $error exch /errorinfo exch put - $error /command /throw put - stop -} def /errorinfo? { $error /errorinfo known { % if set @@ -198,187 +110,51 @@ end } def } def +% Scalars -% -% list operations -% -/_list { - array astore -} def -/_list? { - dup xcheck not exch type /arraytype eq and -} def -/_nth { get } def +/_nil? { null eq } def +/_true? { true eq } def +/_false? { false eq } def -/_cons { - /lst exch def - /elem exch def - lst length 1 add array - dup 0 elem put % first element - dup 1 lst putinterval % rest of the elements -} def -/concat { % replaces matric concat - dup length 0 eq { %if just concat - 0 _list - }{ dup length 1 eq { %elseif concat of single item - 0 get % noop - }{ % else - [] exch - { - concatenate - } forall - } ifelse } ifelse -} def +% Symbols -% -% Sequence operations -% -/_first { - dup length 0 gt { 0 get }{ pop null } ifelse -} def -/_rest { - dup length 0 gt { - dup length 1 sub 1 exch getinterval - }{ - pop 0 array - } ifelse +/_symbol? { + type /nametype eq } def -% [function args... arg_list] -> apply -> result -/apply { 1 dict begin - /args exch def - args 0 get callable % make sure function is callable - args 1 args length 2 sub getinterval - args args length 1 sub get - concatenate args 0 get % stack: args function - exec -end } def - -% function list -> _map -> new_list -/_map { 1 dict begin - /args exch def - callable % make sure function is callable - %/new_list args length array def - args { - 1 array astore - exch dup 3 1 roll % stack: fn arg fn - exec exch % stack: result fn - } forall - pop % remove the function - args length array astore -end } def -/_sequential? { _list? } def +% Functions -/conj { 5 dict begin - /args exch def - /src_list args 0 get def - /new_len src_list length args length 1 sub add def - /new_list new_len array def - new_list new_len src_list length sub src_list putinterval - args length 1 sub -1 1 { - /idx exch def - new_list args length idx sub 1 sub args idx get put - } for - new_list -end } def +/_mal_function? { + dup type /dicttype eq { + /type get /_maltype_function eq + }{ + pop false + } ifelse +} def +% args mal_function -> fload -> ast new_env +% fload: sets up arguments on the stack for an EVAL call +/fload { + dup /ast get 3 1 roll % stack: ast args mal_function + dup /env get 3 1 roll % stack: ast env args mal_function + /params get exch % stack: ast env params args + env_new % stack: ast new_env +} def -% -% Env implementation -% -% outer binds exprs -> env_new -> new_env -/env_new { 3 dict begin - %(in env_new\n) print - /exprs exch def - /binds exch def - /outer exch def - << - /__outer__ outer - 0 1 binds length 1 sub { - /idx exch def - binds idx get (&) eq { %if & - binds idx 1 add get % key - exprs idx exprs length idx sub getinterval % value - exit - } if - binds idx get % key - exprs idx get % value - } for - >> -end } def +% function_or_block -> callable -> block +% if this is a user defined mal function, get its executable block +/callable { dup _mal_function? { /data get } if } def -/env_find { 2 dict begin - /key exch def - /env exch def - env key known { %if key in env - env - }{ env /__outer__ get null ne { %elseif __outer__ not null - env /__outer__ get key env_find - }{ %else - null - } ifelse } ifelse -end } def -/env_set { 4 dict begin - dup - /func? exch xcheck def % executable function - /val exch cvlit def - /key exch def - /env exch def - env key val func? { cvx } if put - val func? { cvx } if -end } def +% Lists -/env_get { 2 dict begin - /key exch def - /env exch def - env key env_find - dup null eq { - (') - key 99 string cvs - (' not found) - concatenate concatenate - throw - }{ - key get - } ifelse -end } def +/_list { + array astore +} def +/_list? { + dup xcheck not exch type /arraytype eq and +} def +/_nth { get } def -% -% types_ns is namespace of type functions -% -/types_ns << - (pr-str) { ( ) true _pr_str_args } - (str) { () false _pr_str_args } - (prn) { ( ) true _pr_str_args print (\n) print null } - (println) { () false _pr_str_args print (\n) print null } - (=) { dup 0 get exch 1 get _equal? } - (symbol?) { 0 get _symbol? } - (nil?) { 0 get _nil? } - (true?) { 0 get _true? } - (false?) { 0 get _false? } - (<) { dup 0 get exch 1 get lt } - (<=) { dup 0 get exch 1 get le } - (>) { dup 0 get exch 1 get gt } - (>=) { dup 0 get exch 1 get ge } - (+) { dup 0 get exch 1 get add } - (-) { dup 0 get exch 1 get sub } - (*) { dup 0 get exch 1 get mul } - (/) { dup 0 get exch 1 get idiv } - (throw) { 0 get throw } - (list) { dup pop } % noop - (list?) { 0 get _list? } - (cons) { dup 0 get exch 1 get _cons } - (concat) { concat } - (sequential?) { 0 get _sequential? } - (empty?) { 0 get length 0 eq } - (count) { 0 get length } - (nth) { dup 0 get exch 1 get _nth } - (first) { 0 get _first } - (rest) { 0 get _rest } - (apply) { apply } - (map) { dup 0 get exch 1 get _map } - (conj) { conj } ->> def diff --git a/python/Makefile b/python/Makefile index 1c8e467..3985d14 100644 --- a/python/Makefile +++ b/python/Makefile @@ -2,7 +2,8 @@ TESTS = -SOURCES = mal_types.py mal_readline.py reader.py stepA_more.py +SOURCES = mal_readline.py mal_types.py reader.py printer.py \ + env.py core.py stepA_more.py #all: mal.sh # diff --git a/python/core.py b/python/core.py new file mode 100644 index 0000000..92ae3d9 --- /dev/null +++ b/python/core.py @@ -0,0 +1,159 @@ +import copy +from itertools import chain + +import mal_types as types +from mal_types import List, Vector +import printer + +# Errors/Exceptions +def throw(exc): raise Exception(exc) + + +# String functions +def pr_str(*args): + return " ".join(map(lambda exp: printer._pr_str(exp, True), args)) + +def do_str(*args): + return "".join(map(lambda exp: printer._pr_str(exp, False), args)) + +def prn(*args): + print " ".join(map(lambda exp: printer._pr_str(exp, True), args)) + return None + +def println(*args): + line = " ".join(map(lambda exp: printer._pr_str(exp, False), args)) + print line.replace('\\n', '\n') + return None + + +# Hash map functions +def assoc(src_hm, *key_vals): + hm = copy.copy(src_hm) + for i in range(0,len(key_vals),2): hm[key_vals[i]] = key_vals[i+1] + return hm + +def dissoc(src_hm, *keys): + hm = copy.copy(src_hm) + for key in keys: del hm[key] + return hm + +def get(hm, key): + if key in hm: + return hm[key] + else: + return None + +def contains_Q(hm, key): return key in hm + +def keys(hm): return types._list(*hm.keys()) + +def vals(hm): return types._list(*hm.values()) + + +# Sequence functions +def coll_Q(coll): return sequential_Q(coll) or hash_map_Q(coll) + +def cons(x, seq): return List([x]) + List(seq) + +def concat(*lsts): return List(chain(*lsts)) + +def nth(lst, idx): return lst[idx] + +def first(lst): return lst[0] + +def rest(lst): return List(lst[1:]) + +def empty_Q(lst): return len(lst) == 0 + +def count(lst): return len(lst) + +# retains metadata +def conj(lst, *args): + if types._list_Q(lst): + new_lst = List(list(reversed(list(args))) + lst) + else: + new_lst = Vector(lst + list(args)) + if hasattr(lst, "__meta__"): + new_lst.__meta__ = lst.__meta__ + return new_lst + +def apply(f, *args): return f(*(list(args[0:-1])+args[-1])) + +def mapf(f, lst): return List(map(f, lst)) + + +# Metadata functions +def with_meta(obj, meta): + new_obj = copy.copy(obj) + new_obj.__meta__ = meta + return new_obj + +def meta(obj): + if hasattr(obj, "__meta__"): return obj.__meta__ + else: return None + + +# Atoms functions +def deref(atm): return atm.val +def reset_BANG(atm,val): + atm.val = val + return atm.val +def swap_BANG(atm,f,*args): + atm.val = f(atm.val,*args) + return atm.val + + +ns = { + '=': types._equal_Q, + 'throw': throw, + 'nil?': types._nil_Q, + 'true?': types._true_Q, + 'false?': types._false_Q, + 'symbol': types._symbol, + 'symbol?': types._symbol_Q, + 'pr-str': pr_str, + 'str': do_str, + 'prn': prn, + 'println': println, + '<': lambda a,b: a<b, + '<=': lambda a,b: a<=b, + '>': lambda a,b: a>b, + '>=': lambda a,b: a>=b, + '+': lambda a,b: a+b, + '-': lambda a,b: a-b, + '*': lambda a,b: a*b, + '/': lambda a,b: a/b, + + 'list': types._list, + 'list?': types._list_Q, + 'vector': types._vector, + 'vector?': types._vector_Q, + 'hash-map': types._hash_map, + 'map?': types._hash_map_Q, + 'assoc': assoc, + 'dissoc': dissoc, + 'get': get, + 'contains?': contains_Q, + 'keys': keys, + 'vals': vals, + + 'sequential?': types._sequential_Q, + 'cons': cons, + 'concat': concat, + 'nth': nth, + 'first': first, + 'rest': rest, + 'empty?': empty_Q, + 'count': count, + 'conj': conj, + 'apply': apply, + 'map': mapf, + + 'with-meta': with_meta, + 'meta': meta, + 'atom': types._atom, + 'atom?': types._atom_Q, + 'deref': deref, + 'reset!': reset_BANG, + 'swap!': swap_BANG} + diff --git a/python/env.py b/python/env.py new file mode 100644 index 0000000..4cd8e05 --- /dev/null +++ b/python/env.py @@ -0,0 +1,28 @@ +# Environment + +class Env(): + def __init__(self, outer=None, binds=None, exprs=None): + self.data = {} + self.outer = outer or None + + if binds: + for i in range(len(binds)): + if binds[i] == "&": + self.data[binds[i+1]] = exprs[i:] + break + else: + self.data[binds[i]] = exprs[i] + + def find(self, key): + if key in self.data: return self + elif self.outer: return self.outer.find(key) + else: return None + + def set(self, key, value): + self.data[key] = value + return value + + def get(self, key): + env = self.find(key) + if not env: raise Exception("'" + key + "' not found") + return env.data[key] diff --git a/python/mal_types.py b/python/mal_types.py index 401a03b..15e4b6b 100644 --- a/python/mal_types.py +++ b/python/mal_types.py @@ -1,71 +1,17 @@ -import copy -from itertools import chain - # General functions -def _pr_str(obj, print_readably=True): - _r = print_readably - if list_Q(obj): - return "(" + " ".join(map(lambda e: _pr_str(e,_r), obj)) + ")" - elif vector_Q(obj): - return "[" + " ".join(map(lambda e: _pr_str(e,_r), obj)) + "]" - elif hash_map_Q(obj): - ret = [] - for k in obj.keys(): - ret.extend((_pr_str(k), _pr_str(obj[k],_r))) - return "{" + " ".join(ret) + "}" - elif string_Q(obj): - if print_readably: - return '"' + obj.encode('unicode_escape').replace('"', '\\"') + '"' - else: - return obj - elif nil_Q(obj): - return "nil" - elif true_Q(obj): - return "true" - elif false_Q(obj): - return "false" - elif atom_Q(obj): - return "(atom " + _pr_str(obj.val,_r) + ")" - else: - return obj.__str__() - -def pr_str(*args): - return " ".join(map(lambda exp: _pr_str(exp, True), args)) - -def do_str(*args): - return "".join(map(lambda exp: _pr_str(exp, False), args)) - -def prn(*args): - print " ".join(map(lambda exp: _pr_str(exp, True), args)) - return None - -def println(*args): - line = " ".join(map(lambda exp: _pr_str(exp, False), args)) - print line.replace('\\n', '\n') - return None - -def with_meta(obj, meta): - new_obj = copy.copy(obj) - new_obj.__meta__ = meta - return new_obj - -def meta(obj): - if hasattr(obj, "__meta__"): return obj.__meta__ - else: return None - -def equal_Q(a, b): +def _equal_Q(a, b): ota, otb = type(a), type(b) - if not (ota == otb or (sequential_Q(a) and sequential_Q(b))): + if not (ota == otb or (_sequential_Q(a) and _sequential_Q(b))): return False; - if symbol_Q(a): + if _symbol_Q(a): return a == b - elif list_Q(a) or vector_Q(a): + elif _list_Q(a) or _vector_Q(a): if len(a) != len(b): return False for i in range(len(a)): - if not equal_Q(a[i], b[i]): return False + if not _equal_Q(a[i], b[i]): return False return True - elif hash_map_Q(a): + elif _hash_map_Q(a): akeys = a.keys() akeys.sort() bkeys = b.keys() @@ -78,70 +24,26 @@ def equal_Q(a, b): else: return a == b -# nil, true, false -def nil_Q(exp): return exp is None -def true_Q(exp): return exp is True -def false_Q(exp): return exp is False -def string_Q(exp): return type(exp) in [str, unicode] +def _sequential_Q(seq): return _list_Q(seq) or _vector_Q(seq) -# numbers -int_plus = lambda a,b: a+b -int_minus = lambda a,b: a-b -int_multiply = lambda a,b: a*b -int_divide = lambda a,b: a/b -int_lt = lambda a,b: a<b -int_lte = lambda a,b: a<=b -int_gt = lambda a,b: a>b -int_gte = lambda a,b: a>=b +# Scalars +def _nil_Q(exp): return exp is None +def _true_Q(exp): return exp is True +def _false_Q(exp): return exp is False +def _string_Q(exp): return type(exp) in [str, unicode] -# symbols +# Symbols class Symbol(str): pass -def new_symbol(str): return Symbol(str) -def symbol_Q(exp): return type(exp) == Symbol +def _symbol(str): return Symbol(str) +def _symbol_Q(exp): return type(exp) == Symbol - -# functions -def new_function(func, exp, env, params): +# Functions +def _function(Eval, Env, exp, env, params): def f(*args): - return func(exp, Env(env, params, args)) + return Eval(exp, Env(env, params, args)) f.__meta__ = {"exp": exp, "env": env, "params": params} return f -def function_Q(f): return type(f) == type(function_Q) - -# hash maps -class Hash_Map(dict): pass -def new_hash_map(*key_vals): - hm = Hash_Map() - for i in range(0,len(key_vals),2): hm[key_vals[i]] = key_vals[i+1] - return hm -def hash_map_Q(exp): return type(exp) == Hash_Map - -def assoc(src_hm, *key_vals): - hm = copy.copy(src_hm) - for i in range(0,len(key_vals),2): hm[key_vals[i]] = key_vals[i+1] - return hm - -def dissoc(src_hm, *keys): - hm = copy.copy(src_hm) - for key in keys: del hm[key] - return hm - -def get(hm, key): - if key in hm: - return hm[key] - else: - return None - -def contains_Q(hm, key): return key in hm - -def keys(hm): return new_list(*hm.keys()) - -def vals(hm): return new_list(*hm.values()) - - -# errors/exceptions -def throw(exc): raise Exception(exc) - +def _function_Q(f): return type(f) == type(function_Q) # lists class List(list): @@ -151,8 +53,8 @@ class List(list): elif i >= len(self): return None else: return list.__getitem__(self, i) def __getslice__(self, *a): return List(list.__getslice__(self, *a)) -def new_list(*vals): return List(vals) -def list_Q(exp): return type(exp) == List +def _list(*vals): return List(vals) +def _list_Q(exp): return type(exp) == List # vectors @@ -163,109 +65,20 @@ class Vector(list): elif i >= len(self): return None else: return list.__getitem__(self, i) def __getslice__(self, *a): return Vector(list.__getslice__(self, *a)) -def new_vector(*vals): return Vector(vals) -def vector_Q(exp): return type(exp) == Vector +def _vector(*vals): return Vector(vals) +def _vector_Q(exp): return type(exp) == Vector +# Hash maps +class Hash_Map(dict): pass +def _hash_map(*key_vals): + hm = Hash_Map() + for i in range(0,len(key_vals),2): hm[key_vals[i]] = key_vals[i+1] + return hm +def _hash_map_Q(exp): return type(exp) == Hash_Map # atoms class Atom(object): def __init__(self, val): self.val = val -def new_atom(val): return Atom(val) -def atom_Q(exp): return type(exp) == Atom -def deref(atm): return atm.val -def reset_BANG(atm,val): - atm.val = val - return atm.val -def swap_BANG(atm,f,*args): - atm.val = f(atm.val,*args) - return atm.val - - - -# Sequence operations -def sequential_Q(seq): return list_Q(seq) or vector_Q(seq) - -def coll_Q(coll): return sequential_Q(coll) or hash_map_Q(coll) - -def cons(x, seq): return List([x]) + List(seq) - -def nth(lst, idx): return lst[idx] - -def count(lst): return len(lst) - -def empty_Q(lst): return len(lst) == 0 - -def concat(*lsts): return List(chain(*lsts)) - -# retains metadata -def conj(lst, *args): - if list_Q(lst): - new_lst = List(list(reversed(list(args))) + lst) - else: - new_lst = Vector(lst + list(args)) - if hasattr(lst, "__meta__"): - new_lst.__meta__ = lst.__meta__ - return new_lst - -def first(lst): return lst[0] - -def rest(lst): return List(lst[1:]) - -def apply(f, *args): - return f(*(list(args[0:-1])+args[-1])) - -def mapf(f, lst): - return List(map(f, lst)) - - -# Environment - -class Env(): - def __init__(self, outer=None, binds=None, exprs=None): - self.data = {} - self.outer = outer or None - - if binds: - for i in range(len(binds)): - if binds[i] == "&": - self.data[binds[i+1]] = exprs[i:] - break - else: - self.data[binds[i]] = exprs[i] - - def find(self, key): - if key in self.data: return self - elif self.outer: return self.outer.find(key) - else: return None - - def set(self, key, value): - self.data[key] = value - return value - - def get(self, key): - env = self.find(key) - if not env: raise Exception("'" + key + "' not found") - return env.data[key] - -types_ns = { - 'pr-str': pr_str, 'str': do_str, 'prn': prn, 'println': println, - 'with-meta': with_meta, 'meta': meta, - '=': equal_Q, - 'nil?': nil_Q, 'true?': true_Q, 'false?': false_Q, - 'symbol?': symbol_Q, - '<': int_lt, '<=': int_lte, '>': int_gt, '>=': int_gte, - '+': int_plus, '-': int_minus, '*': int_multiply, '/': int_divide, - 'hash-map': new_hash_map, 'map?': hash_map_Q, - 'assoc': assoc, 'dissoc': dissoc, 'get': get, - 'contains?': contains_Q, 'keys': keys, 'vals': vals, - 'throw': throw, - 'list': new_list, 'list?': list_Q, - 'vector': new_vector, 'vector?': vector_Q, - 'atom': new_atom, 'atom?': atom_Q, 'deref': deref, - 'reset!': reset_BANG, 'swap!': swap_BANG, - 'sequential?': sequential_Q, - 'cons': cons, 'nth': nth, 'count': count, 'empty?': empty_Q, - 'concat': concat, "conj": conj, "first": first, "rest": rest, - 'apply': apply, 'map': mapf} - +def _atom(val): return Atom(val) +def _atom_Q(exp): return type(exp) == Atom diff --git a/python/printer.py b/python/printer.py new file mode 100644 index 0000000..d501d60 --- /dev/null +++ b/python/printer.py @@ -0,0 +1,29 @@ +import mal_types as types + +def _pr_str(obj, print_readably=True): + _r = print_readably + if types._list_Q(obj): + return "(" + " ".join(map(lambda e: _pr_str(e,_r), obj)) + ")" + elif types._vector_Q(obj): + return "[" + " ".join(map(lambda e: _pr_str(e,_r), obj)) + "]" + elif types._hash_map_Q(obj): + ret = [] + for k in obj.keys(): + ret.extend((_pr_str(k), _pr_str(obj[k],_r))) + return "{" + " ".join(ret) + "}" + elif types._string_Q(obj): + if print_readably: + return '"' + obj.encode('unicode_escape').replace('"', '\\"') + '"' + else: + return obj + elif types._nil_Q(obj): + return "nil" + elif types._true_Q(obj): + return "true" + elif types._false_Q(obj): + return "false" + elif types._atom_Q(obj): + return "(atom " + _pr_str(obj.val,_r) + ")" + else: + return obj.__str__() + diff --git a/python/reader.py b/python/reader.py index ddd6a32..846e2a8 100644 --- a/python/reader.py +++ b/python/reader.py @@ -1,5 +1,5 @@ import re -from mal_types import (new_symbol, Symbol, new_hash_map, List, new_list, Vector) +from mal_types import (_symbol, _list, _vector, _hash_map) class Blank(Exception): pass @@ -32,7 +32,7 @@ def read_atom(reader): elif token == "nil": return None elif token == "true": return True elif token == "false": return False - else: return Symbol(token) + else: return _symbol(token) def read_sequence(reader, typ=list, start='(', end=')'): ast = typ() @@ -49,13 +49,13 @@ def read_sequence(reader, typ=list, start='(', end=')'): def read_hash_map(reader): lst = read_sequence(reader, list, '{', '}') - return new_hash_map(*lst) + return _hash_map(*lst) def read_list(reader): - return read_sequence(reader, List, '(', ')') + return read_sequence(reader, _list, '(', ')') def read_vector(reader): - return read_sequence(reader, Vector, '[', ']') + return read_sequence(reader, _vector, '[', ']') def read_form(reader): token = reader.peek() @@ -65,23 +65,23 @@ def read_form(reader): return None elif token == '\'': reader.next() - return new_list(Symbol('quote'), read_form(reader)) + return _list(_symbol('quote'), read_form(reader)) elif token == '`': reader.next() - return new_list(Symbol('quasiquote'), read_form(reader)) + return _list(_symbol('quasiquote'), read_form(reader)) elif token == '~': reader.next() - return new_list(Symbol('unquote'), read_form(reader)) + return _list(_symbol('unquote'), read_form(reader)) elif token == '~@': reader.next() - return new_list(Symbol('splice-unquote'), read_form(reader)) + return _list(_symbol('splice-unquote'), read_form(reader)) elif token == '^': reader.next() meta = read_form(reader) - return new_list(Symbol('with-meta'), read_form(reader), meta) + return _list(_symbol('with-meta'), read_form(reader), meta) elif token == '@': reader.next() - return new_list(Symbol('deref'), read_form(reader)) + return _list(_symbol('deref'), read_form(reader)) # list elif token == ')': raise Exception("unexpected ')'") diff --git a/python/step1_read_print.py b/python/step1_read_print.py index 165dfa3..0315cf0 100644 --- a/python/step1_read_print.py +++ b/python/step1_read_print.py @@ -1,21 +1,19 @@ import sys, traceback import mal_readline -from mal_types import (pr_str, sequential_Q, symbol_Q, coll_Q, list_Q, - vector_Q, hash_map_Q, new_symbol, new_function, - new_list, new_vector, new_hash_map, Env, types_ns) -from reader import (read_str, Blank) +import mal_types as types +import reader, printer # read def READ(str): - return read_str(str) + return reader.read_str(str) # eval def EVAL(ast, env): - #print("EVAL %s" % ast) - return ast + #print("EVAL %s" % ast) + return ast def PRINT(exp): - return pr_str(exp) + return printer._pr_str(exp) # repl def REP(str): @@ -27,6 +25,6 @@ while True: if line == None: break if line == "": continue print(REP(line)) - except Blank: continue + except reader.Blank: continue except Exception as e: print "".join(traceback.format_exception(*sys.exc_info())) diff --git a/python/step2_eval.py b/python/step2_eval.py index 65972a2..e50d231 100644 --- a/python/step2_eval.py +++ b/python/step2_eval.py @@ -1,46 +1,44 @@ import sys, traceback import mal_readline -from mal_types import (pr_str, sequential_Q, symbol_Q, coll_Q, list_Q, - vector_Q, hash_map_Q, new_symbol, new_function, - new_list, new_vector, new_hash_map, Env, types_ns) -from reader import (read_str, Blank) +import mal_types as types +import reader, printer # read def READ(str): - return read_str(str) + return reader.read_str(str) # eval def eval_ast(ast, env): - if symbol_Q(ast): + if types._symbol_Q(ast): try: return env[ast] except: raise Exception("'" + ast + "' not found") - elif list_Q(ast): - return new_list(*map(lambda a: EVAL(a, env), ast)) - elif vector_Q(ast): - return new_vector(*map(lambda a: EVAL(a, env), ast)) - elif hash_map_Q(ast): + elif types._list_Q(ast): + return types._list(*map(lambda a: EVAL(a, env), ast)) + elif types._vector_Q(ast): + return types._vector(*map(lambda a: EVAL(a, env), ast)) + elif types._hash_map_Q(ast): keyvals = [] for k in ast.keys(): keyvals.append(EVAL(k, env)) keyvals.append(EVAL(ast[k], env)) - return new_hash_map(*keyvals) + return types._hash_map(*keyvals) else: return ast # primitive value, return unchanged def EVAL(ast, env): - #print("EVAL %s" % ast) - if not list_Q(ast): - return eval_ast(ast, env) + #print("EVAL %s" % ast) + if not types._list_Q(ast): + return eval_ast(ast, env) - # apply list - el = eval_ast(ast, env) - f = el[0] - return f(*el[1:]) + # apply list + el = eval_ast(ast, env) + f = el[0] + return f(*el[1:]) def PRINT(exp): - return pr_str(exp) + return printer._pr_str(exp) # repl repl_env = {} @@ -58,6 +56,6 @@ while True: if line == None: break if line == "": continue print(REP(line)) - except Blank: continue + except reader.Blank: continue except Exception as e: print "".join(traceback.format_exception(*sys.exc_info())) diff --git a/python/step3_env.py b/python/step3_env.py index f95a978..21879d6 100644 --- a/python/step3_env.py +++ b/python/step3_env.py @@ -1,58 +1,57 @@ import sys, traceback import mal_readline -from mal_types import (pr_str, sequential_Q, symbol_Q, coll_Q, list_Q, - vector_Q, hash_map_Q, new_symbol, new_function, - new_list, new_vector, new_hash_map, Env, types_ns) -from reader import (read_str, Blank) +import mal_types as types +import reader, printer +from env import Env # read def READ(str): - return read_str(str) + return reader.read_str(str) # eval def eval_ast(ast, env): - if symbol_Q(ast): + if types._symbol_Q(ast): return env.get(ast) - elif list_Q(ast): - return new_list(*map(lambda a: EVAL(a, env), ast)) - elif vector_Q(ast): - return new_vector(*map(lambda a: EVAL(a, env), ast)) - elif hash_map_Q(ast): + elif types._list_Q(ast): + return types._list(*map(lambda a: EVAL(a, env), ast)) + elif types._vector_Q(ast): + return types._vector(*map(lambda a: EVAL(a, env), ast)) + elif types._hash_map_Q(ast): keyvals = [] for k in ast.keys(): keyvals.append(EVAL(k, env)) keyvals.append(EVAL(ast[k], env)) - return new_hash_map(*keyvals) + return types._hash_map(*keyvals) else: return ast # primitive value, return unchanged def EVAL(ast, env): - #print("EVAL %s" % ast) - if not list_Q(ast): - return eval_ast(ast, env) + #print("EVAL %s" % ast) + if not types._list_Q(ast): + return eval_ast(ast, env) - # apply list - if len(ast) == 0: return ast - a0 = ast[0] + # apply list + if len(ast) == 0: return ast + a0 = ast[0] - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - return EVAL(a2, let_env) - else: - el = eval_ast(ast, env) - f = el[0] - return f(*el[1:]) + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + return EVAL(a2, let_env) + else: + el = eval_ast(ast, env) + f = el[0] + return f(*el[1:]) # print def PRINT(exp): - return pr_str(exp) + return printer._pr_str(exp) # repl repl_env = Env() @@ -71,6 +70,6 @@ while True: if line == None: break if line == "": continue print(REP(line)) - except Blank: continue + except reader.Blank: continue except Exception as e: print "".join(traceback.format_exception(*sys.exc_info())) diff --git a/python/step4_if_fn_do.py b/python/step4_if_fn_do.py index 4b54d8f..d0a7fc3 100644 --- a/python/step4_if_fn_do.py +++ b/python/step4_if_fn_do.py @@ -1,72 +1,72 @@ import sys, traceback import mal_readline -from mal_types import (pr_str, sequential_Q, symbol_Q, coll_Q, list_Q, - vector_Q, hash_map_Q, new_symbol, new_function, - new_list, new_vector, new_hash_map, Env, types_ns) -from reader import (read_str, Blank) +import mal_types as types +import reader, printer +from env import Env +import core # read def READ(str): - return read_str(str) + return reader.read_str(str) # eval def eval_ast(ast, env): - if symbol_Q(ast): + if types._symbol_Q(ast): return env.get(ast) - elif list_Q(ast): - return new_list(*map(lambda a: EVAL(a, env), ast)) - elif vector_Q(ast): - return new_vector(*map(lambda a: EVAL(a, env), ast)) - elif hash_map_Q(ast): + elif types._list_Q(ast): + return types._list(*map(lambda a: EVAL(a, env), ast)) + elif types._vector_Q(ast): + return types._vector(*map(lambda a: EVAL(a, env), ast)) + elif types._hash_map_Q(ast): keyvals = [] for k in ast.keys(): keyvals.append(EVAL(k, env)) keyvals.append(EVAL(ast[k], env)) - return new_hash_map(*keyvals) + return types._hash_map(*keyvals) else: return ast # primitive value, return unchanged def EVAL(ast, env): - #print("EVAL %s" % ast) - if not list_Q(ast): - return eval_ast(ast, env) + #print("EVAL %s" % ast) + if not types._list_Q(ast): + return eval_ast(ast, env) - # apply list - if len(ast) == 0: return ast - a0 = ast[0] + # apply list + if len(ast) == 0: return ast + a0 = ast[0] - if "def!" == a0: - a1, a2 = ast[1], ast[2] - res = EVAL(a2, env) - return env.set(a1, res) - elif "let*" == a0: - a1, a2 = ast[1], ast[2] - let_env = Env(env) - for i in range(0, len(a1), 2): - let_env.set(a1[i], EVAL(a1[i+1], let_env)) - return EVAL(a2, let_env) - elif "do" == a0: - el = eval_ast(ast[1:], env) - return el[-1] - elif "if" == a0: - a1, a2 = ast[1], ast[2] - cond = EVAL(a1, env) - if cond is None or cond is False: - if len(ast) > 3: return EVAL(ast[3], env) - else: return None + if "def!" == a0: + a1, a2 = ast[1], ast[2] + res = EVAL(a2, env) + return env.set(a1, res) + elif "let*" == a0: + a1, a2 = ast[1], ast[2] + let_env = Env(env) + for i in range(0, len(a1), 2): + let_env.set(a1[i], EVAL(a1[i+1], let_env)) + return EVAL(a2, let_env) + elif "do" == a0: + el = eval_ast(ast[1:], env) + return el[-1] + elif "if" == a0: + a1, a2 = ast[1], ast[2] + cond = EVAL(a1, env) + if cond is None or cond is False: + if len(ast) > 3: return EVAL(ast[3], env) + else: return None + else: + return EVAL(a2, env) + elif "fn*" == a0: + a1, a2 = ast[1], ast[2] + return types._function(EVAL, Env, a2, env, a1) else: - return EVAL(a2, env) - elif "fn*" == a0: - a1, a2 = ast[1], ast[2] - return new_function(EVAL, a2, env, a1) - else: - el = eval_ast(ast, env) - f = el[0] - return f(*el[1:]) + el = eval_ast(ast, env) + f = el[0] + return f(*el[1:]) # print def PRINT(exp): - return pr_str(exp) + return printer._pr_str(exp) # repl repl_env = Env() @@ -75,7 +75,7 @@ def REP(str): def _ref(k,v): repl_env.set(k, v) # Import types functions -for name, val in types_ns.items(): _ref(name, val) +for name, val in core.ns.items(): _ref(name, val) # Defined using the language itself REP("(def! not (fn* (a) (if a false true)))") @@ -86,6 +86,6 @@ while True: if line == None: break if line == "": continue print(REP(line)) - except Blank: continue + except reader.Blank: continue except Exception as e: print "".join(traceback.format_exception(*sys.exc_info())) diff --git a/python/step5_tco.py b/python/step5_tco.py index ffde863..4335a96 100644 --- a/python/step5_tco.py +++ b/python/step5_tco.py @@ -1,41 +1,41 @@ import sys, traceback import mal_readline -from mal_types import (pr_str, sequential_Q, symbol_Q, coll_Q, list_Q, - vector_Q, hash_map_Q, new_symbol, new_function, - new_list, new_vector, new_hash_map, Env, types_ns) -from reader import (read_str, Blank) +import mal_types as types +import reader, printer +from env import Env +import core # read def READ(str): - return read_str(str) + return reader.read_str(str) # eval def eval_ast(ast, env): - if symbol_Q(ast): + if types._symbol_Q(ast): return env.get(ast) - elif list_Q(ast): - return new_list(*map(lambda a: EVAL(a, env), ast)) - elif vector_Q(ast): - return new_vector(*map(lambda a: EVAL(a, env), ast)) - elif hash_map_Q(ast): + elif types._list_Q(ast): + return types._list(*map(lambda a: EVAL(a, env), ast)) + elif types._vector_Q(ast): + return types._vector(*map(lambda a: EVAL(a, env), ast)) + elif types._hash_map_Q(ast): keyvals = [] for k in ast.keys(): keyvals.append(EVAL(k, env)) keyvals.append(EVAL(ast[k], env)) - return new_hash_map(*keyvals) + return types._hash_map(*keyvals) else: return ast # primitive value, return unchanged def EVAL(ast, env): while True: #print("EVAL %s" % ast) - if not list_Q(ast): + if not types._list_Q(ast): return eval_ast(ast, env) - + # apply list if len(ast) == 0: return ast - a0 = ast[0] - + a0 = ast[0] + if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -61,7 +61,7 @@ def EVAL(ast, env): # Continue loop (TCO) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - return new_function(EVAL, a2, env, a1) + return types._function(EVAL, Env, a2, env, a1) else: el = eval_ast(ast, env) f = el[0] @@ -74,7 +74,7 @@ def EVAL(ast, env): # print def PRINT(exp): - return pr_str(exp) + return printer._pr_str(exp) # repl repl_env = Env() @@ -83,7 +83,7 @@ def REP(str): def _ref(k,v): repl_env.set(k, v) # Import types functions -for name, val in types_ns.items(): _ref(name, val) +for name, val in core.ns.items(): _ref(name, val) # Defined using the language itself REP("(def! not (fn* (a) (if a false true)))") @@ -94,6 +94,6 @@ while True: if line == None: break if line == "": continue print(REP(line)) - except Blank: continue + except reader.Blank: continue except Exception as e: print "".join(traceback.format_exception(*sys.exc_info())) diff --git a/python/step6_file.py b/python/step6_file.py index 8a3432d..9e0b8cd 100644 --- a/python/step6_file.py +++ b/python/step6_file.py @@ -1,41 +1,41 @@ import sys, traceback import mal_readline -from mal_types import (pr_str, sequential_Q, symbol_Q, coll_Q, list_Q, - vector_Q, hash_map_Q, new_symbol, new_function, - new_list, new_vector, new_hash_map, Env, types_ns) -from reader import (read_str, Blank) +import mal_types as types +import reader, printer +from env import Env +import core # read def READ(str): - return read_str(str) + return reader.read_str(str) # eval def eval_ast(ast, env): - if symbol_Q(ast): + if types._symbol_Q(ast): return env.get(ast) - elif list_Q(ast): - return new_list(*map(lambda a: EVAL(a, env), ast)) - elif vector_Q(ast): - return new_vector(*map(lambda a: EVAL(a, env), ast)) - elif hash_map_Q(ast): + elif types._list_Q(ast): + return types._list(*map(lambda a: EVAL(a, env), ast)) + elif types._vector_Q(ast): + return types._vector(*map(lambda a: EVAL(a, env), ast)) + elif types._hash_map_Q(ast): keyvals = [] for k in ast.keys(): keyvals.append(EVAL(k, env)) keyvals.append(EVAL(ast[k], env)) - return new_hash_map(*keyvals) + return types._hash_map(*keyvals) else: return ast # primitive value, return unchanged def EVAL(ast, env): while True: #print("EVAL %s" % ast) - if not list_Q(ast): + if not types._list_Q(ast): return eval_ast(ast, env) - + # apply list if len(ast) == 0: return ast - a0 = ast[0] - + a0 = ast[0] + if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -61,7 +61,7 @@ def EVAL(ast, env): # Continue loop (TCO) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - return new_function(EVAL, a2, env, a1) + return types._function(EVAL, Env, a2, env, a1) else: el = eval_ast(ast, env) f = el[0] @@ -74,7 +74,7 @@ def EVAL(ast, env): # print def PRINT(exp): - return pr_str(exp) + return printer._pr_str(exp) # repl repl_env = Env() @@ -83,9 +83,9 @@ def REP(str): def _ref(k,v): repl_env.set(k, v) # Import types functions -for name, val in types_ns.items(): _ref(name, val) +for name, val in core.ns.items(): _ref(name, val) -_ref('read-string', read_str) +_ref('read-string', reader.read_str) _ref('eval', lambda ast: EVAL(ast, repl_env)) _ref('slurp', lambda file: open(file).read()) @@ -102,6 +102,6 @@ else: if line == None: break if line == "": continue print(REP(line)) - except Blank: continue + except reader.Blank: continue except Exception as e: print "".join(traceback.format_exception(*sys.exc_info())) diff --git a/python/step7_quote.py b/python/step7_quote.py index 7acc322..3ed6965 100644 --- a/python/step7_quote.py +++ b/python/step7_quote.py @@ -1,54 +1,59 @@ import sys, traceback import mal_readline -from mal_types import (pr_str, sequential_Q, symbol_Q, coll_Q, list_Q, - vector_Q, hash_map_Q, new_symbol, new_function, - new_list, new_vector, new_hash_map, Env, types_ns) -from reader import (read_str, Blank) +import mal_types as types +import reader, printer +from env import Env +import core # read def READ(str): - return read_str(str) + return reader.read_str(str) # eval def is_pair(x): - return sequential_Q(x) and len(x) > 0 + return types._sequential_Q(x) and len(x) > 0 def quasiquote(ast): if not is_pair(ast): - return new_list(new_symbol("quote"), ast) + return types._list(types._symbol("quote"), + ast) elif ast[0] == 'unquote': return ast[1] elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return new_list(new_symbol("concat"), ast[0][1], quasiquote(ast[1:])) + return types._list(types._symbol("concat"), + ast[0][1], + quasiquote(ast[1:])) else: - return new_list(new_symbol("cons"), quasiquote(ast[0]), quasiquote(ast[1:])) + return types._list(types._symbol("cons"), + quasiquote(ast[0]), + quasiquote(ast[1:])) def eval_ast(ast, env): - if symbol_Q(ast): + if types._symbol_Q(ast): return env.get(ast) - elif list_Q(ast): - return new_list(*map(lambda a: EVAL(a, env), ast)) - elif vector_Q(ast): - return new_vector(*map(lambda a: EVAL(a, env), ast)) - elif hash_map_Q(ast): + elif types._list_Q(ast): + return types._list(*map(lambda a: EVAL(a, env), ast)) + elif types._vector_Q(ast): + return types._vector(*map(lambda a: EVAL(a, env), ast)) + elif types._hash_map_Q(ast): keyvals = [] for k in ast.keys(): keyvals.append(EVAL(k, env)) keyvals.append(EVAL(ast[k], env)) - return new_hash_map(*keyvals) + return types._hash_map(*keyvals) else: return ast # primitive value, return unchanged def EVAL(ast, env): while True: #print("EVAL %s" % ast) - if not list_Q(ast): + if not types._list_Q(ast): return eval_ast(ast, env) - + # apply list if len(ast) == 0: return ast - a0 = ast[0] - + a0 = ast[0] + if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -78,7 +83,7 @@ def EVAL(ast, env): # Continue loop (TCO) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - return new_function(EVAL, a2, env, a1) + return types._function(EVAL, Env, a2, env, a1) else: el = eval_ast(ast, env) f = el[0] @@ -91,7 +96,7 @@ def EVAL(ast, env): # print def PRINT(exp): - return pr_str(exp) + return printer._pr_str(exp) # repl repl_env = Env() @@ -100,9 +105,9 @@ def REP(str): def _ref(k,v): repl_env.set(k, v) # Import types functions -for name, val in types_ns.items(): _ref(name, val) +for name, val in core.ns.items(): _ref(name, val) -_ref('read-string', read_str) +_ref('read-string', reader.read_str) _ref('eval', lambda ast: EVAL(ast, repl_env)) _ref('slurp', lambda file: open(file).read()) @@ -119,6 +124,6 @@ else: if line == None: break if line == "": continue print(REP(line)) - except Blank: continue + except reader.Blank: continue except Exception as e: print "".join(traceback.format_exception(*sys.exc_info())) diff --git a/python/step8_macros.py b/python/step8_macros.py index e09942c..6e2bd45 100644 --- a/python/step8_macros.py +++ b/python/step8_macros.py @@ -1,31 +1,36 @@ import sys, traceback import mal_readline -from mal_types import (pr_str, sequential_Q, symbol_Q, coll_Q, list_Q, - vector_Q, hash_map_Q, new_symbol, new_function, - new_list, new_vector, new_hash_map, Env, types_ns) -from reader import (read_str, Blank) +import mal_types as types +import reader, printer +from env import Env +import core # read def READ(str): - return read_str(str) + return reader.read_str(str) # eval def is_pair(x): - return sequential_Q(x) and len(x) > 0 + return types._sequential_Q(x) and len(x) > 0 def quasiquote(ast): if not is_pair(ast): - return new_list(new_symbol("quote"), ast) + return types._list(types._symbol("quote"), + ast) elif ast[0] == 'unquote': return ast[1] elif is_pair(ast[0]) and ast[0][0] == 'splice-unquote': - return new_list(new_symbol("concat"), ast[0][1], quasiquote(ast[1:])) + return types._list(types._symbol("concat"), + ast[0][1], + quasiquote(ast[1:])) else: - return new_list(new_symbol("cons"), quasiquote(ast[0]), quasiquote(ast[1:])) + return types._list(types._symbol("cons"), + quasiquote(ast[0]), + quasiquote(ast[1:])) def is_macro_call(ast, env): - return (list_Q(ast) and - symbol_Q(ast[0]) and + return (types._list_Q(ast) and + types._symbol_Q(ast[0]) and env.find(ast[0]) and hasattr(env.get(ast[0]), '_ismacro_')) @@ -36,33 +41,33 @@ def macroexpand(ast, env): return ast def eval_ast(ast, env): - if symbol_Q(ast): + if types._symbol_Q(ast): return env.get(ast) - elif list_Q(ast): - return new_list(*map(lambda a: EVAL(a, env), ast)) - elif vector_Q(ast): - return new_vector(*map(lambda a: EVAL(a, env), ast)) - elif hash_map_Q(ast): + elif types._list_Q(ast): + return types._list(*map(lambda a: EVAL(a, env), ast)) + elif types._vector_Q(ast): + return types._vector(*map(lambda a: EVAL(a, env), ast)) + elif types._hash_map_Q(ast): keyvals = [] for k in ast.keys(): keyvals.append(EVAL(k, env)) keyvals.append(EVAL(ast[k], env)) - return new_hash_map(*keyvals) + return types._hash_map(*keyvals) else: return ast # primitive value, return unchanged def EVAL(ast, env): while True: #print("EVAL %s" % ast) - if not list_Q(ast): + if not types._list_Q(ast): return eval_ast(ast, env) - + # apply list ast = macroexpand(ast, env) - if not list_Q(ast): return ast + if not types._list_Q(ast): return ast if len(ast) == 0: return ast + a0 = ast[0] - a0 = ast[0] if "def!" == a0: a1, a2 = ast[1], ast[2] res = EVAL(a2, env) @@ -98,7 +103,7 @@ def EVAL(ast, env): # Continue loop (TCO) elif "fn*" == a0: a1, a2 = ast[1], ast[2] - return new_function(EVAL, a2, env, a1) + return types._function(EVAL, Env, a2, env, a1) else: el = eval_ast(ast, env) f = el[0] @@ -111,7 +116,7 @@ def EVAL(ast, env): # print def PRINT(exp): - return pr_str(exp) + return printer._pr_str(exp) # repl repl_env = Env() @@ -120,9 +125,9 @@ def REP(str): def _ref(k,v): repl_env.set(k, v) # Import types functions -for name, val in types_ns.items(): _ref(name, val) +for name, val in core.ns.items(): _ref(name, val) -_ref('read-string', read_str) +_ref('read-string', reader.read_str) _ref('eval', lambda ast: EVAL(ast, repl_env)) _ref('slurp', lambda file: open(file).read()) @@ -139,6 +144,6 @@ else: if line == None: break if line == "": continue print(REP(line)) - except Blank: continue + except reader.Blank: continue except Exception as e: print "".join(traceback.format_exception(*sys.exc_info())) |