Basic: fix step6 arg test. Gensym. Misc cleanup.

- Strip linefeeds in run_argv_test.sh so that step6 arg test passes for basic. - Add gensym and convert or macro. - Add gitignore entries for transpiled basic sources. - Add conj/seq stubs so that step4 self-host loads (if non-step4 functions are commented out in core.mal) - Bump up Z% value space by 256 spaces (1K) - Remove old qb2cbm.sh
2024-09-11 13:55:55 +03:00 · 2016-10-27 23:47:05 -05:00 · 2016-10-27 23:47:05 -05:00 · 4e7d8a1bcf
commit 4e7d8a1bcf
parent c7330b3d69
17 changed files with 44 additions and 145 deletions
--- a/.gitignore
+++ b/.gitignore
@ -106,3 +106,15 @@ vb/*.dll
 vimscript/mal.vim
 clisp/*.fas
 clisp/*.lib
+basic/step0_repl.bas
+basic/step1_read_print.bas
+basic/step2_eval.bas
+basic/step3_env.bas
+basic/step4_if_fn_do.bas
+basic/step5_tco.bas
+basic/step6_file.bas
+basic/step7_quote.bas
+basic/step8_macros.bas
+basic/step9_try.bas
+basic/stepA_mal.bas
+basic/*.prg
--- a/basic/core.in.bas
+++ b/basic/core.in.bas
@ -194,7 +194,7 @@ DO_FUNCTION:
  DO_30_39:
  ON FF-29 GOTO DO_VECTOR_Q,DO_HASH_MAP,DO_MAP_Q,DO_ASSOC,DO_THROW,DO_GET,DO_CONTAINS,DO_KEYS,DO_VALS,DO_SEQUENTIAL_Q
  DO_40_49:
-  ON FF-39 GOTO DO_CONS,DO_CONCAT,DO_NTH,DO_FIRST,DO_REST,DO_EMPTY_Q,DO_COUNT,DO_THROW,DO_THROW,DO_WITH_META
+  ON FF-39 GOTO DO_CONS,DO_CONCAT,DO_NTH,DO_FIRST,DO_REST,DO_EMPTY_Q,DO_COUNT,DO_CONJ,DO_SEQ,DO_WITH_META
  DO_50_59:
  ON FF-49 GOTO DO_META,DO_ATOM,DO_ATOM_Q,DO_DEREF,DO_RESET_BANG,DO_EVAL,DO_READ_FILE
  REM ,DO_PR_MEMORY_SUMMARY
@ -475,6 +475,12 @@ DO_FUNCTION:
    B=AA:GOSUB COUNT
    T=2:L=R:GOSUB ALLOC
    RETURN
+  DO_CONJ:
+    R=0
+    RETURN
+  DO_SEQ:
+    R=0
+    RETURN

  DO_WITH_META:
    T=Z%(AA,0)AND31
@ -585,8 +591,8 @@ INIT_CORE_NS:
  K$="empty?":A=45:GOSUB INIT_CORE_SET_FUNCTION
  K$="count":A=46:GOSUB INIT_CORE_SET_FUNCTION

-  REM K$="conj":A=47:GOSUB INIT_CORE_SET_FUNCTION
-  REM K$="seq":A=48:GOSUB INIT_CORE_SET_FUNCTION
+  K$="conj":A=47:GOSUB INIT_CORE_SET_FUNCTION
+  K$="seq":A=48:GOSUB INIT_CORE_SET_FUNCTION

  K$="with-meta":A=49:GOSUB INIT_CORE_SET_FUNCTION
  K$="meta":A=50:GOSUB INIT_CORE_SET_FUNCTION
--- a/basic/qb2cbm.sh
+++ b/basic/qb2cbm.sh
@ -1,107 +0,0 @@
-#!/bin/bash
-
-set -e
-
-DEBUG=${DEBUG:-}
-KEEP_REM=${KEEP_REM:-1}
-# 0 - drop all REMs
-# 1 - keep LABEL and INCLUDE REMs (and blank lines)
-# 2 - keep LABEL, INCLUDE, and GOTO REMs
-# 3 - keep LABEL, INCLUDE, GOTO, and whole line REMs
-# 4 - keep all REMS (end of line REMs too)
-
-infile=$1
-
-die () {
-    echo >&2 "$*"
-    exit 1
-}
-
-[ "${infile}" ] || die "Usage: <infile>"
-
-input=$(cat ${infile})
-
-[ "${DEBUG}" ] && echo >&2 "Processing includes"
-
-full="${input}"
-declare -A included
-
-while [[ ${input} =~ REM\ \$INCLUDE:\ \'.*\' ]]; do
-    full=""
-    while read -r line; do
-        if [[ ${line} =~ REM\ \$INCLUDE:\ \'.*\' ]]; then
-            include=${line#REM \$INCLUDE: \'}
-            include=${include%\'}
-            # Only include it once
-            if [ "${included[${include}]}" ];then
-                [ "${DEBUG}" ] && echo >&2 "already included: ${include}"
-                continue
-            fi
-            [ "${DEBUG}" ] && echo >&2 "including: ${include}"
-            included[${include}]="done"
-            if [ "${KEEP_REM}" -ge 1 ]; then
-                full="${full}\nREM vvv BEGIN '${include}' vvv\n$(cat ${include})\nREM vvv END '${include}' vvv\n"
-            else
-                full="${full}\n$(cat ${include})\n"
-            fi
-        else
-            full="${full}${line}\n"
-        fi
-    done < <(echo -e "${input}")
-    input="${full}"
-done
-
-
-[ "${DEBUG}" ] && echo >&2 "Renumbering"
-
-data=""
-declare -A labels
-
-lnum=1
-while read -r line; do
-    if [[ ${line} =~ ^\ *# ]]; then
-        [ "${DEBUG}" ] && echo >&2 "ignoring # style comment at $lnum"
-        continue
-    elif [[ "${KEEP_REM}" -lt 3 && ${line} =~ ^\ *REM && \
-            ! ${line} =~ REM\ vvv && ! ${line} =~ REM\ ^^^ ]]; then
-        [ "${DEBUG}" ] && echo >&2 "dropping REM comment: ${line}"
-        continue
-    elif [[ ${line} =~ ^\ *$ ]]; then
-        if [ "${KEEP_REM}" -ge 1 ]; then
-            [ "${DEBUG}" ] && echo >&2 "found blank line at $lnum"
-            data="${data}\n"
-        else
-            [ "${DEBUG}" ] && echo >&2 "ignoring blank line at $lnum"
-        fi
-        continue
-    elif [[ ${line} =~ ^[A-Za-z_][A-Za-z0-9_]*:$ ]]; then
-        label=${line%:}
-        [ "${DEBUG}" ] && echo >&2 "found label ${label} at $lnum"
-        labels[${label}]=$lnum
-        if [ "${KEEP_REM}" -ge 1 ]; then
-            data="${data}${lnum} REM ${label}:\n"
-        else
-            continue
-        fi
-    else
-        data="${data}${lnum} ${line}\n"
-    fi
-    lnum=$(( lnum + 1 ))
-done < <(echo -e "${input}")
-
-if [[ "${KEEP_REM}" -lt 4 ]]; then
-    [ "${DEBUG}" ] && echo >&2 "Dropping line ending REMs"
-    data=$(echo -e "${data}" | sed "s/: REM [^\n]*$//")
-fi
-
-for label in "${!labels[@]}"; do
-    [ "${DEBUG}" ] && echo >&2 "Updating label: ${label}"
-    lnum=${labels[${label}]}
-    if [ "${KEEP_REM}" -ge 2 ]; then
-        data=$(echo "${data}" | sed "s/\(THEN\|GOTO\|GOSUB\) ${label}\>/\1 ${lnum}: REM ${label}/g")
-    else
-        data=$(echo "${data}" | sed "s/\(THEN\|GOTO\|GOSUB\) ${label}\>/\1 ${lnum}/g")
-    fi
-done
-
-echo -e "${data}"
--- a/basic/step0_repl.in.bas
+++ b/basic/step0_repl.in.bas
@ -36,6 +36,6 @@ MAIN:
    GOTO REPL_LOOP

  QUIT:
-    PRINT "Free: "+STR$(FRE(0))
+    REM PRINT "Free: "+STR$(FRE(0))
    END

--- a/basic/step1_read_print.in.bas
+++ b/basic/step1_read_print.in.bas
@ -56,8 +56,7 @@ MAIN:
    GOTO REPL_LOOP

  QUIT:
-    REM P1=ZT: P2=-1: GOSUB PR_MEMORY
-    GOSUB PR_MEMORY_SUMMARY
+    REM GOSUB PR_MEMORY_SUMMARY
    END

  PRINT_ERROR:
--- a/basic/step2_eval.in.bas
+++ b/basic/step2_eval.in.bas
@ -264,8 +264,7 @@ MAIN:
    GOTO REPL_LOOP

  QUIT:
-    REM P1=ZT: P2=-1: GOSUB PR_MEMORY
-    GOSUB PR_MEMORY_SUMMARY
+    REM GOSUB PR_MEMORY_SUMMARY
    END

  PRINT_ERROR:
--- a/basic/step3_env.in.bas
+++ b/basic/step3_env.in.bas
@ -338,8 +338,7 @@ MAIN:
    GOTO REPL_LOOP

  QUIT:
-    REM P1=ZT: P2=-1: GOSUB PR_MEMORY
-    GOSUB PR_MEMORY_SUMMARY
+    REM GOSUB PR_MEMORY_SUMMARY
    END

  PRINT_ERROR:
--- a/basic/step4_if_fn_do.in.bas
+++ b/basic/step4_if_fn_do.in.bas
@ -393,8 +393,7 @@ MAIN:
    GOTO REPL_LOOP

  QUIT:
-    REM P1=ZT: P2=-1: GOSUB PR_MEMORY
-    GOSUB PR_MEMORY_SUMMARY
+    REM GOSUB PR_MEMORY_SUMMARY
    END

  PRINT_ERROR:
--- a/basic/step5_tco.in.bas
+++ b/basic/step5_tco.in.bas
@ -411,8 +411,7 @@ MAIN:
    GOTO REPL_LOOP

  QUIT:
-    REM P1=ZT: P2=-1: GOSUB PR_MEMORY
-    GOSUB PR_MEMORY_SUMMARY
+    REM GOSUB PR_MEMORY_SUMMARY
    END

  PRINT_ERROR:
--- a/basic/step6_file.in.bas
+++ b/basic/step6_file.in.bas
@ -438,8 +438,7 @@ MAIN:
    GOTO REPL_LOOP

  QUIT:
-    REM P1=ZT: P2=-1: GOSUB PR_MEMORY
-    GOSUB PR_MEMORY_SUMMARY
+    REM GOSUB PR_MEMORY_SUMMARY
    END

  PRINT_ERROR:
--- a/basic/step7_quote.in.bas
+++ b/basic/step7_quote.in.bas
@ -529,8 +529,7 @@ MAIN:
    GOTO REPL_LOOP

  QUIT:
-    REM P1=ZT: P2=-1: GOSUB PR_MEMORY
-    GOSUB PR_MEMORY_SUMMARY
+    REM GOSUB PR_MEMORY_SUMMARY
    END

  PRINT_ERROR:
--- a/basic/step8_macros.in.bas
+++ b/basic/step8_macros.in.bas
@ -607,8 +607,7 @@ MAIN:
    GOTO REPL_LOOP

  QUIT:
-    REM P1=ZT: P2=-1: GOSUB PR_MEMORY
-    GOSUB PR_MEMORY_SUMMARY
+    REM GOSUB PR_MEMORY_SUMMARY
    END

  PRINT_ERROR:
--- a/basic/step9_try.in.bas
+++ b/basic/step9_try.in.bas
@ -639,8 +639,7 @@ MAIN:
    GOTO REPL_LOOP

  QUIT:
-    REM P1=ZT: P2=-1: GOSUB PR_MEMORY
-    GOSUB PR_MEMORY_SUMMARY
+    REM GOSUB PR_MEMORY_SUMMARY
    END

  PRINT_ERROR:
--- a/basic/stepA_mal.in.bas
+++ b/basic/stepA_mal.in.bas
@ -603,8 +603,16 @@ MAIN:
  A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
  GOSUB RE:AY=R:GOSUB RELEASE

+  A$="(def! *gensym-counter* (atom 0))"
+  GOSUB RE:AY=R:GOSUB RELEASE
+
+  A$="(def! gensym (fn* [] (symbol (str "+CHR$(34)+"G__"+CHR$(34)
+  A$=A$+" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))"
+  GOSUB RE:AY=R:GOSUB RELEASE
+
  A$="(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs)"
-  A$=A$+" `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
+  A$=A$+" (let* (condvar (gensym)) `(let* (~condvar ~(first xs))"
+  A$=A$+" (if ~condvar ~condvar (or ~@(rest xs)))))))))"
  GOSUB RE:AY=R:GOSUB RELEASE

  REM load the args file
@ -648,8 +656,7 @@ MAIN:
    GOTO REPL_LOOP

  QUIT:
-    REM P1=ZT: P2=-1: GOSUB PR_MEMORY
-    GOSUB PR_MEMORY_SUMMARY
+    REM GOSUB PR_MEMORY_SUMMARY
    END

  PRINT_ERROR:
--- a/basic/types.in.bas
+++ b/basic/types.in.bas
@ -27,7 +27,7 @@ REM                    14  ->  Z% index of metdata object
 INIT_MEMORY:
  T=FRE(0)

-  Z1=2048+1024: REM Z% (boxed memory) size (4 bytes each)
+  Z1=2048+1024+256: REM Z% (boxed memory) size (4 bytes each)
  Z2=256: REM S$ (string memory) size (3 bytes each)
  Z3=256: REM X% (call stack) size (2 bytes each)
  Z4=64: REM Y% (release stack) size (4 bytes each)
--- a/run_argv_test.sh
+++ b/run_argv_test.sh
@ -23,7 +23,7 @@ fi

 root="$(dirname $0)"

-out="$( $@ $root/tests/print_argv.mal aaa bbb ccc )"
+out="$( $@ $root/tests/print_argv.mal aaa bbb ccc | tr -d '\r' )"
 assert_equal '("aaa" "bbb" "ccc")' "$out"

 # Note: The 'make' implementation cannot handle arguments with spaces in them,
@ -32,7 +32,7 @@ assert_equal '("aaa" "bbb" "ccc")' "$out"
 # out="$( $@ $root/tests/print_argv.mal aaa 'bbb ccc' ddd )"
 # assert_equal '("aaa" "bbb ccc" "ddd")' "$out"

-out="$( $@ $root/tests/print_argv.mal )"
+out="$( $@ $root/tests/print_argv.mal | tr -d '\r' )"
 assert_equal '()' "$out"

 echo 'Passed all *ARGV* tests'
--- a/tests/perf3.mal
+++ b/tests/perf3.mal
@ -15,14 +15,4 @@
        (swap! atm (fn* [a] (concat (rest a) (list (first a)))))))
    10))

-;;(def! sumdown (fn* (N) (if (> N 0) (+ N (sumdown  (- N 1))) 0)))
-;;(def! fib (fn* (N) (if (= N 0) 1 (if (= N 1) 1 (+ (fib (- N 1)) (fib (- N 2)))))))
-;;
-;;(println "iters/s:"
-;;  (run-fn-for
-;;    (fn* []
-;;      (do 
-;;        (sumdown 10)
-;;        (fib 12)))
-;;    3))
 ;;(prn "Done: basic macros/atom test")