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]
`(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
"Return the item indicated by the first pointer of a pair. NIL is treated
specially: the CAR of NIL is NIL."
@ -392,14 +397,13 @@
(EVAL (CAR args) env)
(EVLIS (CDR args) env))))
(deftrace traced-eval
"Essentially, identical to EVAL except traced."
(defn eval-internal
"Common guts for both EVAL and traced-eval"
[expr env]
(cond
(NUMBERP expr) expr
(=
(ATOM? expr) T)
(CDR (ASSOC expr env))
(= (NUMBERP expr) T) expr
;; (symbol? expr) (CDR (ASSOC expr env))
(= (ATOM? expr) T) (CDR (ASSOC expr env))
(=
(ATOM? (CAR expr))
T) (cond
@ -414,31 +418,32 @@
(EVLIS (CDR expr) 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
"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]
(cond
(true? (:trace *options*))
(if
(:trace *options*)
(traced-eval expr env)
(NUMBERP expr) expr
(=
(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)))
(eval-internal expr env)))

14
src/beowulf/core.clj
View file

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

242
test/beowulf/core_test.clj
View file

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