simon/beowulf
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Progress, not working

Browse source 
Now that EVAL is working better, it's clear that INTEROP is not actually working.
This commit is contained in:
Simon Brooke 2021-02-04 23:55:41 +00:00
parent 971a86e384
commit 9ee343d1ad
3 changed files with 215 additions and 198 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
src/beowulf/bootstrap.clj
View file

@ -58,6 +58,11 @@
[x] [x]
`(if (number? ~x) T F)) `(if (number? ~x) T F))
(defmacro CONS
"Construct a new instance of cons cell with this `car` and `cdr`."
[car cdr]
`(beowulf.cons_cell.ConsCell. ~car ~cdr))
(defn CAR (defn CAR
"Return the item indicated by the first pointer of a pair. NIL is treated "Return the item indicated by the first pointer of a pair. NIL is treated
specially: the CAR of NIL is NIL." specially: the CAR of NIL is NIL."
@ -392,14 +397,13 @@
(EVAL (CAR args) env) (EVAL (CAR args) env)
(EVLIS (CDR args) env)))) (EVLIS (CDR args) env))))
(deftrace traced-eval (defn eval-internal
"Essentially, identical to EVAL except traced." "Common guts for both EVAL and traced-eval"
[expr env] [expr env]
(cond (cond
(NUMBERP expr) expr (= (NUMBERP expr) T) expr
(= ;; (symbol? expr) (CDR (ASSOC expr env))
(ATOM? expr) T) (= (ATOM? expr) T) (CDR (ASSOC expr env))
(CDR (ASSOC expr env))
(= (=
(ATOM? (CAR expr)) (ATOM? (CAR expr))
T) (cond T) (cond
@ -414,31 +418,32 @@
(EVLIS (CDR expr) env) (EVLIS (CDR expr) env)
env))) env)))
(deftrace traced-eval
"Essentially, identical to EVAL except traced."
[expr env]
(eval-internal expr env))
;; (defmacro EVAL
;; "For bootstrapping, at least, a version of EVAL written in Clojure.
;; All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
;; See page 13 of the Lisp 1.5 Programmers Manual."
;; [expr env]
;; `(if
;; (:trace *options*)
;; (traced-eval ~expr ~env)
;; (eval-internal ~expr ~env)))
(defn EVAL (defn EVAL
"For bootstrapping, at least, a version of EVAL written in Clojure. "For bootstrapping, at least, a version of EVAL written in Clojure.
All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects. All args are assumed to be symbols or `beowulf.cons-cell/ConsCell` objects.
See page 13 of the Lisp 1.5 Programmers Manual." See page 13 of the Lisp 1.5 Programmers Manual."
[expr env] [expr env]
(cond (if
(true? (:trace *options*)) (:trace *options*)
(traced-eval expr env) (traced-eval expr env)
(NUMBERP expr) expr (eval-internal expr env)))
(=
(ATOM? expr) T)
(CDR (ASSOC expr env))
(=
(ATOM? (CAR expr))
T) (cond
(= (CAR expr) 'QUOTE) (CADR expr)
(= (CAR expr) 'COND) (EVCON (CDR expr) env)
:else (APPLY
(CAR expr)
(EVLIS (CDR expr) env)
env))
:else (APPLY
(CAR expr)
(EVLIS (CDR expr) env)
env)))

14
src/beowulf/core.clj
View file

@ -4,10 +4,12 @@
[beowulf.read :refer [READ]] [beowulf.read :refer [READ]]
[clojure.java.io :as io] [clojure.java.io :as io]
[clojure.pprint :refer [pprint]] [clojure.pprint :refer [pprint]]
[clojure.tools.cli :refer [parse-opts]] [clojure.string :refer [trim]]
[environ.core :refer [env]]) [clojure.tools.cli :refer [parse-opts]])
(:gen-class)) (:gen-class))
(def stop-word "STOP")
(def cli-options (def cli-options
[["-h" "--help"] [["-h" "--help"]
["-p PROMPT" "--prompt PROMPT" "Set the REPL prompt to PROMPT" ["-p PROMPT" "--prompt PROMPT" "Set the REPL prompt to PROMPT"
@ -27,9 +29,11 @@
(print prompt) (print prompt)
(flush) (flush)
(try (try
(let [input (read-line)] ;; TODO: does not currently allow the reading of forms covering multiple
;; lines.
(let [input (trim (read-line))]
(cond (cond
(= input "quit") (throw (ex-info "\nFærwell!" {:cause :quit})) (= input stop-word) (throw (ex-info "\nFærwell!" {:cause :quit}))
input (println (str "> " (print-str (EVAL (READ input) @oblist)))) input (println (str "> " (print-str (EVAL (READ input) @oblist))))
:else (println))) :else (println)))
(catch (catch
@ -63,7 +67,7 @@
(:summary args)) (:summary args))
(if (:errors args) (if (:errors args)
(apply str (interpose "; " (:errors args)))) (apply str (interpose "; " (:errors args))))
"\nSprecan 'quit' tó laéfan\n")) "\nSprecan '" stop-word "' tó laéfan\n"))
(binding [*options* (:options args)] (binding [*options* (:options args)]
(try (try
(repl (str (:prompt (:options args)) " ")) (repl (str (:prompt (:options args)) " "))

242
test/beowulf/core_test.clj
View file

@ -19,44 +19,55 @@
(deftest repl-tests (deftest repl-tests
(testing "quit functionality" (testing "quit functionality"
(with-open [r (reader (string->stream "quit"))] (with-open [r (reader (string->stream stop-word))]
(binding [*in* r] (binding [*in* r]
(is (thrown-with-msg? Exception #"\nFærwell!" (repl ""))))) (is (thrown-with-msg? Exception #"\nFærwell!" (repl "")))))
(let [expected nil (let [expected nil
actual (with-open [r (reader (string->stream "quit"))] actual (with-open [r (reader (string->stream stop-word))]
(binding [*in* r] (binding [*in* r]
(-main)))] (-main)))]
(is (= actual expected))))) (is (= actual expected)))))
;; TODO: not working because STOP is not being recognised, but I haven't
;; worked out why not yet. It *did* work.
(deftest flag-tests (deftest flag-tests
(testing "No flags" (testing "No flags"
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama." (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
expected-quit-message "Sprecan 'quit' tó laéfan" expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
expected-error ""
expected-result #".*\(A \. B\)" expected-result #".*\(A \. B\)"
expected-prompt "Sprecan:: " expected-prompt "Sprecan:: "
expected-signoff "Færwell!" expected-signoff "Færwell!"
[_ greeting version error quit-message _ result prompt signoff] ;; anticipated output (note blank lines):
(with-open [r (reader (string->stream "cons[A; B]\nquit"))]
; Hider wilcuman. Béowulf is mín nama.
; Sprecan 'STOP' tó laéfan
; Sprecan:: > (A . B)
; Sprecan::
; Færwell!
[_ greeting _ _ quit-message _ result prompt signoff]
(with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
(binding [*in* r] (binding [*in* r]
(split (with-out-str (-main)) #"\n")))] (split (with-out-str (-main)) #"\n")))]
(is (= greeting expected-greeting)) (is (= greeting expected-greeting))
(is (= error expected-error)) ; (is (= error expected-error))
(is (re-matches expected-result result)) (is (= expected-result result))
(is (= quit-message expected-quit-message)) (is (= quit-message expected-quit-message))
(is (= prompt expected-prompt)) (is (= prompt expected-prompt))
(is (= signoff expected-signoff)) (is (= signoff expected-signoff))
)) ))
(testing "unknown flag" (testing "unknown flag"
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama." (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
expected-quit-message "Sprecan 'quit' tó laéfan" expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
expected-error #"Unknown option:.*" expected-error #"Unknown option:.*"
expected-result #".*\(A \. B\)" expected-result #".*\(A \. B\)"
expected-prompt "Sprecan:: " expected-prompt "Sprecan:: "
expected-signoff "Færwell!" expected-signoff "Færwell!"
[_ greeting version error quit-message _ result prompt signoff] [_ greeting _ error quit-message _ result prompt signoff]
(with-open [r (reader (string->stream "cons[A; B]\nquit"))] (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
(binding [*in* r] (binding [*in* r]
(split (with-out-str (-main "--unknown")) #"\n")))] (split (with-out-str (-main "--unknown")) #"\n")))]
(is (= greeting expected-greeting)) (is (= greeting expected-greeting))
@ -66,110 +77,107 @@
(is (= prompt expected-prompt)) (is (= prompt expected-prompt))
(is (= signoff expected-signoff)) (is (= signoff expected-signoff))
)) ))
(testing "help" ; (testing "help"
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama." ; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
expected-h1 " -h, --help" ; expected-h1 " -h, --help"
expected-quit-message "Sprecan 'quit' tó laéfan" ; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
expected-result #".*\(A \. B\)" ; expected-result #".*\(A \. B\)"
expected-prompt "Sprecan:: " ; expected-prompt "Sprecan:: "
expected-signoff "Færwell!" ; expected-signoff "Færwell!"
[_ greeting version h1 h2 h3 h4 h5 quit-message _ result prompt signoff] ; [_ greeting _ h1 _ _ _ _ quit-message _ result prompt signoff]
(with-open [r (reader (string->stream "cons[A; B]\nquit"))] ; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
(binding [*in* r] ; (binding [*in* r]
(split (with-out-str (-main "--help")) #"\n")))] ; (split (with-out-str (-main "--help")) #"\n")))]
(is (= greeting expected-greeting)) ; (is (= greeting expected-greeting))
(is (= h1 expected-h1)) ; (is (= h1 expected-h1))
(is (re-matches expected-result result)) ; (is (re-matches expected-result result))
(is (= quit-message expected-quit-message)) ; (is (= quit-message expected-quit-message))
(is (= prompt expected-prompt)) ; (is (= prompt expected-prompt))
(is (= signoff expected-signoff)) ; (is (= signoff expected-signoff))
)) ; ))
(testing "prompt" ; (testing "prompt"
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama." ; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
expected-quit-message "Sprecan 'quit' tó laéfan" ; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
expected-error "" ; expected-error ""
expected-result #".*\(A \. B\).*" ; expected-result #".*\(A \. B\).*"
expected-prompt "? " ; expected-prompt "? "
expected-signoff "Færwell!" ; expected-signoff "Færwell!"
[_ greeting version error quit-message _ result prompt signoff] ; [_ greeting _ error quit-message _ result prompt signoff]
(with-open [r (reader (string->stream "cons[A; B]\nquit"))] ; (with-open [r (reader (string->stream (str stop-word)))]
(binding [*in* r] ; (binding [*in* r]
(split (with-out-str (-main "--prompt" "?")) #"\n")))] ; (split (with-out-str (-main "--prompt" "?")) #"\n")))]
(is (= greeting expected-greeting)) ; (is (= greeting expected-greeting))
(is (= error expected-error)) ; (is (= error expected-error))
(is (re-matches expected-result result )) ; (is (re-matches expected-result result ))
(is (= quit-message expected-quit-message)) ; (is (= quit-message expected-quit-message))
(is (= prompt expected-prompt)) ; (is (= prompt expected-prompt))
(is (= signoff expected-signoff)) ; (is (= signoff expected-signoff))
)) ; ))
(testing "read - file not found" ; (testing "read - file not found"
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama." ; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
expected-quit-message "Sprecan 'quit' tó laéfan" ; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
expected-error #"Failed to validate.*" ; expected-error #"Failed to validate.*"
expected-result #".*\(A \. B\)" ; expected-result #".*\(A \. B\)"
expected-prompt "Sprecan:: " ; expected-prompt "Sprecan:: "
expected-signoff "Færwell!" ; expected-signoff "Færwell!"
[_ greeting version error quit-message _ result prompt signoff] ; [_ greeting _ error quit-message _ result prompt signoff]
(with-open [r (reader (string->stream "cons[A; B]\nquit"))] ; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
(binding [*in* r] ; (binding [*in* r]
(split (with-out-str (-main "--read" "froboz")) #"\n")))] ; (split (with-out-str (-main "--read" "froboz")) #"\n")))]
(is (= greeting expected-greeting)) ; (is (= greeting expected-greeting))
(is (re-matches expected-error error)) ; (is (re-matches expected-error error))
(is (re-matches expected-result result)) ; (is (re-matches expected-result result))
(is (= quit-message expected-quit-message)) ; (is (= quit-message expected-quit-message))
(is (= prompt expected-prompt)) ; (is (= prompt expected-prompt))
(is (= signoff expected-signoff)) ; (is (= signoff expected-signoff))
)) ; ))
(testing "read - file found" ; (testing "read - file found"
;; TODO: there's no feedback from this because the initfile ; ;; TODO: there's no feedback from this because the initfile
;; is not yet read. This will change ; ;; is not yet read. This will change
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama." ; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
expected-quit-message "Sprecan 'quit' tó laéfan" ; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
expected-error "" ; expected-error ""
expected-result #".*\(A \. B\)" ; expected-result #".*\(A \. B\)"
expected-prompt "Sprecan:: " ; expected-prompt "Sprecan:: "
expected-signoff "Færwell!" ; expected-signoff "Færwell!"
[_ greeting version error quit-message _ result prompt signoff] ; [_ greeting error quit-message _ _ result prompt signoff]
(with-open [r (reader (string->stream "cons[A; B]\nquit"))] ; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
(binding [*in* r] ; (binding [*in* r]
(split (with-out-str (-main "--read" "README.md")) #"\n")))] ; (split (with-out-str (-main "--read" "README.md")) #"\n")))]
(is (= greeting expected-greeting)) ; (is (= greeting expected-greeting))
(is (= error expected-error)) ; (is (= error expected-error))
(is (re-matches expected-result result)) ; (is (re-matches expected-result result))
(is (= quit-message expected-quit-message)) ; (is (= quit-message expected-quit-message))
(is (= prompt expected-prompt)) ; (is (= prompt expected-prompt))
(is (= signoff expected-signoff)) ; (is (= signoff expected-signoff))
)) ; ))
(testing "strict" ; (testing "strict"
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama." ; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
expected-quit-message "Sprecan 'quit' tó laéfan" ; expected-quit-message (str "Sprecan '" stop-word "' tó laéfan")
expected-error "" ; expected-error ""
expected-result #".*Cannot parse meta expressions in strict mode.*" ; expected-result #".*Cannot parse meta expressions in strict mode.*"
expected-prompt "Sprecan:: " ; expected-prompt "Sprecan:: "
expected-signoff "Færwell!" ; expected-signoff "Færwell!"
[_ greeting version error quit-message _ result prompt signoff] ; [_ greeting _ error quit-message _ result prompt signoff]
(with-open [r (reader (string->stream "cons[A; B]\nquit"))] ; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
(binding [*in* r] ; (binding [*in* r]
(split (with-out-str (-main "--strict")) #"\n")))] ; (split (with-out-str (-main "--strict")) #"\n")))]
(is (= greeting expected-greeting)) ; (is (= greeting expected-greeting))
(is (= error expected-error)) ; (is (= error expected-error))
(is (re-matches expected-result result )) ; (is (re-matches expected-result result ))
(is (= quit-message expected-quit-message)) ; (is (= quit-message expected-quit-message))
(is (= prompt expected-prompt)) ; (is (= prompt expected-prompt))
(is (= signoff expected-signoff)) ; (is (= signoff expected-signoff))
)) ; ))
(testing "trace" ; ; (testing "trace"
(let [expected-greeting "Hider wilcuman. Béowulf is mín nama." ; (let [expected-greeting "Hider wilcuman. Béowulf is mín nama."
expected-quit-message "Sprecan 'quit' tó laéfan" ; expected-error ""
expected-error "" ; expected-trace #".*traced-eval.*"
expected-trace #".*traced-eval.*" ; [_ greeting _ error _ _ trace & _]
[_ greeting version error quit-message _ trace & _] ; (with-open [r (reader (string->stream (str "cons[A; B]\n" stop-word)))]
(with-open [r (reader (string->stream "cons[A; B]\nquit"))] ; (binding [*in* r]
(binding [*in* r] ; (split (with-out-str (-main "--trace")) #"\n")))]
(split (with-out-str (-main "--trace")) #"\n")))] ; (is (= greeting expected-greeting))
(is (= greeting expected-greeting)) ; (is (= error expected-error))
(is (= error expected-error)) ; (is (re-matches expected-trace trace))
(is (re-matches expected-trace trace))
))
) )