131 lines
2.8 KiB
Bash
Executable File
131 lines
2.8 KiB
Bash
Executable File
#!/bin/sh
|
|
|
|
# Scheme syntax:
|
|
#
|
|
# ()lrwqicntfexyz
|
|
#
|
|
# ( start list
|
|
# ) end list
|
|
# l lambda
|
|
# r read byte
|
|
# w write byte
|
|
# b quote next byte in the source
|
|
# q quotes its argument
|
|
# i byte to int
|
|
# c cons
|
|
# n null
|
|
# t true
|
|
# f false
|
|
# e eq?
|
|
# x user variable (shadowing not allowed)
|
|
# y user variable (shadowing not allowed)
|
|
# z user variable (shadowing not allowed)
|
|
# TODO: free, GC roots, alloc, function pointers, …
|
|
#
|
|
# sh variables:
|
|
#
|
|
# a answer
|
|
# c lexer current char
|
|
# h heap_max
|
|
# t$i heap_type[$i]
|
|
# v$i heap_value[$i]
|
|
# d$i heap_cdr[$i]
|
|
#
|
|
# heap types:
|
|
#
|
|
# type v d
|
|
# P pair ptr ptr
|
|
# N null "_"
|
|
# F free cell ptr
|
|
# I integer int
|
|
# Y symbol hex
|
|
#
|
|
# Note: hex strings must not contain any spaces.
|
|
|
|
h=0
|
|
s=0
|
|
|
|
heap_sbrk() { h=$(($h+1)); }
|
|
heap_get_type() { eval a=\$t$1; }
|
|
heap_get_val() { eval a=\$v$1; }
|
|
heap_get_cdr() { eval a=\$d$1; }
|
|
heap_set() { eval t$1=$2; eval v$1=$3; }
|
|
heap_set_pair() { eval t$1=$2; eval v$1=$3; eval d$1=$4; }
|
|
|
|
heap_debug() { for heap_debug_i in `seq $h`; do
|
|
printf %s" " $heap_debug_i
|
|
heap_get_type $heap_debug_i; printf %s" " $a
|
|
heap_get_val $heap_debug_i; printf %s" " $a
|
|
heap_get_cdr $heap_debug_i; printf %s\\n $a
|
|
done }
|
|
|
|
stack_debug() { for stack_debug_i in `seq $s`; do
|
|
printf "<%s " $stack_debug_i
|
|
eval a=\$s$stack_debug_i
|
|
printf "%s>" $a
|
|
done
|
|
printf \\n; }
|
|
|
|
rlist() {
|
|
heap_sbrk; heap_set $h N _
|
|
rlist_cdr=$h
|
|
eval a=\$s$s
|
|
while test "$a" != M && test $s -ge 0; do
|
|
heap_sbrk; heap_set_pair $h P $a $rlist_cdr
|
|
rlist_cdr=$h
|
|
s=$(($s-1))
|
|
eval a=\$s$s
|
|
done
|
|
if test $s -lt 0; then
|
|
printf 'Parse error: unbalanced parenthesis'\\n
|
|
exit 1
|
|
fi
|
|
eval s$s=$rlist_cdr
|
|
}
|
|
|
|
debug_print() {
|
|
heap_get_type $1
|
|
if test $a = P; then
|
|
if $2; then printf %s ' '; else printf %s '('; fi
|
|
heap_get_val $1
|
|
debug_print $a false
|
|
heap_get_cdr $1
|
|
debug_print $a true
|
|
if $2; then :; else printf %s ')'; fi
|
|
elif test $a = N; then
|
|
if $2; then :; else printf %s '()'; fi
|
|
elif test $a = Y; then
|
|
if $2; then printf %s '.'; fi
|
|
heap_get_val $1
|
|
printf %s $a | xxd -ps -r
|
|
if $2; then printf %s ')'; fi
|
|
else
|
|
if $2; then printf %s '.'; fi
|
|
printf %s $a
|
|
heap_get_val $1
|
|
printf %s $a
|
|
heap_get_cdr $1
|
|
printf %s $a
|
|
if $2; then printf %s ')'; fi
|
|
fi
|
|
}
|
|
|
|
main() {
|
|
printf '(w((lxx)r))' \
|
|
| od -v -A n -t x1 \
|
|
| sed -e 's/^ //' \
|
|
| tr ' ' \\n \
|
|
| (while read c; do
|
|
echo lex:$c
|
|
case "$c" in
|
|
28) s=$(($s+1)); eval s$s=M ;;
|
|
29) stack_debug; rlist; stack_debug ;;
|
|
*) heap_sbrk; heap_set $h Y $c; s=$(($s+1)); eval s$s=$h ;;
|
|
esac
|
|
done
|
|
heap_debug
|
|
debug_print $h false)
|
|
}
|
|
|
|
if true; then main; exit $?; fi
|