bbc-basic: Start step 6.

diff --git a/bbc-basic/step6_file.bbc b/bbc-basic/step6_file.bbc
new file mode 100644 (file)
index 0000000..01e8cdf
--- /dev/null
+++ b/bbc-basic/step6_file.bbc
@@ -0,0 +1,130 @@
+REM Step 6 of mal in BBC BASIC
+
+LIBRARY "malio_builtin"
+LIBRARY "types"
+LIBRARY "reader"
+LIBRARY "printer"
+LIBRARY "env"
+LIBRARY "core"
+
+PROCmalio_init
+PROCtypes_init
+
+repl_env% = FNalloc_environment(FNnil)
+PROCcore_ns : REM This sets the data pointer
+REPEAT
+  READ sym$, i%
+  IF sym$ <> "" THEN
+    PROCenv_set(repl_env%, FNalloc_symbol(sym$), FNalloc_corefn(i%))
+  ENDIF
+UNTIL sym$ = ""
+
+val$ = FNrep("(def! not (fn* (a) (if a false true)))")
+
+REPEAT
+  PROCgc_enter
+  sav% = FNgc_save
+  REM  Catch all errors apart from "Escape".
+  ON ERROR LOCAL PRINT REPORT$:IF ERR = 17 THEN END ELSE PROCgc_restore(sav%)
+  line$ = FNmalio_input("user> ")
+  PROCmalio_println(FNrep(line$))
+  PROCgc_exit
+UNTIL FNmalio_eof
+
+END
+
+DEF FNREAD(a$)
+=FNread_str(a$)
+
+DEF FNEVAL(ast%, env%)
+  PROCgc_enter
+=FNgc_exit(FNEVAL_(ast%, env%))
+
+DEF FNEVAL_(ast%, env%)
+  LOCAL args%(), car%, specialform%, val%, bindings%
+  REPEAT
+    PROCgc_keep_only2(ast%, env%)
+    IF NOT FNis_list(ast%) THEN =FNeval_ast(ast%, env%)
+    IF FNis_empty(ast%) THEN =ast%
+    car% = FNlist_car(ast%)
+    specialform% = FALSE
+    IF FNis_symbol(car%) THEN
+      specialform% = TRUE
+      CASE FNunbox_symbol(car%) OF
+        REM  Special forms
+        WHEN "def!"
+          val% = FNEVAL(FNlist_nth(ast%, 3), env%)
+          PROCenv_set(env%, FNlist_nth(ast%, 2), val%)
+          =val%
+        WHEN "let*"
+          env% = FNalloc_environment(env%)
+          bindings% = FNlist_nth(ast%, 2)
+          WHILE NOT FNis_empty(bindings%)
+            PROCenv_set(env%, FNlist_car(bindings%), FNEVAL(FNlist_nth(bindings%, 2), env%))
+            bindings% = FNlist_cdr(FNlist_cdr(bindings%))
+          ENDWHILE
+          ast% = FNlist_nth(ast%, 3)
+          REM  Loop round for tail-call optimisation.
+        WHEN "do"
+          REM  The guide has us call FNeval_ast on the sub-list that excludes
+          REM  the last element of ast%, but that's a bit painful without
+          REM  native list slicing, so it's easier to just re-implement the
+          REM  bit of FNeval_ast that we need.
+          ast% = FNlist_cdr(ast%)
+          WHILE NOT FNis_empty(FNlist_cdr(ast%))
+            val% = FNEVAL(FNlist_car(ast%), env%)
+            ast% = FNlist_cdr(ast%)
+          ENDWHILE
+          ast% = FNlist_car(ast%)
+        WHEN "if"
+          IF FNis_truish(FNEVAL(FNlist_nth(ast%, 2), env%)) THEN
+            ast% = FNlist_nth(ast%, 3)
+          ELSE
+            IF FNlist_len(ast%) = 3 THEN =FNnil ELSE ast% = FNlist_nth(ast%, 4)
+          ENDIF
+          REM  Loop round for tail-call optimisation.
+        WHEN "fn*"
+          =FNalloc_fn(FNlist_nth(ast%, 3), FNlist_nth(ast%, 2), env%)
+        OTHERWISE
+          specialform% = FALSE
+      ENDCASE
+    ENDIF
+    IF NOT specialform% THEN
+      REM  This is the "apply" part.
+      ast% = FNeval_ast(ast%, env%)
+      car% = FNlist_car(ast%)
+      IF FNis_corefn(car%) THEN
+        DIM args%(FNlist_len(FNlist_cdr(ast%)))  
+        PROClist_to_array(FNlist_cdr(ast%), args%())
+        =FNcore_call(FNunbox_corefn(FNlist_car(ast%)), args%())
+      ENDIF
+      IF FNis_fn(car%) THEN
+        env% = FNnew_env(FNfn_env(car%), FNfn_params(car%), FNlist_cdr(ast%))
+        ast% = FNfn_ast(car%)
+        REM  Loop round for tail-call optimisation.
+      ELSE
+        ERROR &40E80918, "Not a function"
+      ENDIF
+    ENDIF
+  UNTIL FALSE
+
+DEF FNPRINT(a%)
+=FNpr_str(a%, TRUE)
+
+DEF FNrep(a$)
+=FNPRINT(FNEVAL(FNREAD(a$), repl_env%))
+
+DEF FNeval_ast(ast%, env%)
+  LOCAL val%, car%, cdr%
+  IF FNis_symbol(ast%) THEN =FNenv_get(env%, ast%)
+  IF FNis_list(ast%) THEN
+    IF FNis_empty(ast%) THEN =ast%
+    car% = FNEVAL(FNlist_car(ast%), env%)
+    cdr% = FNeval_ast(FNlist_cdr(ast%), env%)
+    =FNalloc_pair(car%, cdr%)
+  ENDIF
+=ast%
+
+REM Local Variables:
+REM indent-tabs-mode: nil
+REM End: