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

EVAL/APPLY now work; COND now works.

Browse source
This commit is contained in:
Simon Brooke 2023-03-27 16:27:05 +01:00
parent fec6a6a73a
commit 163f2845bb
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
4 changed files with 73 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
resources/lisp1.5.lsp
View file

@ -1,11 +1,35 @@
;; Test comment
(DEFINE
(APPEND
(LAMBDA
(X Y)
(COND ((NULL X) Y) (T (CONS (CAR X) (APPEND (CDR X Y)))))))
(CONC
(LAMBDA
(X Y)
(COND ((NULL (CDR X)) (RPLACD X Y)) (T (CONC (CDR X) Y)))
X)))
((NIL . NIL)
(T . T)
;; many functions return 'F on fail, but to make this mean fail I'm binding
;; it to NIL
(F . NIL)
;; Binding all system functions to NIL so that you can see on the OBLIST that
;; they exist
(ADD1 . NIL)
(APPEND . NIL)
(APPLY . NIL)
(ATOM . NIL)
(CAR . NIL)
(CDR . NIL)
(CONS . NIL)
(DEFINE . NIL)
(DIFFERENCE . NIL)
(EQ . NIL)
(EQUAL . NIL)
(EVAL)
(FIXP . NIL)
(INTEROP . NIL)
(NUMBERP . NIL)
(OBLIST . NIL)
(PLUS . NIL)
(PRETTY . NIL)
(QUOTIENT . NIL)
(REMAINDER)
(RPLACA . NIL)
(RPLACD . NIL)
(SET . NIL)
(SYSIN . NIL)
(SYSOUT . NIL)
(TIMES . NIL)
)

25
src/beowulf/bootstrap.clj
View file

@ -347,7 +347,9 @@
return the current value of the object list. Note that in PSL this function
returns a list of the symbols bound, not the whole association list."
[]
(make-beowulf-list (map CAR @oblist)))
(if (instance? ConsCell @oblist)
(make-beowulf-list (map CAR @oblist))
NIL))
(defn DEFINE
"Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten
@ -400,10 +402,12 @@
DEFINE (DEFINE (CAR args))
DIFFERENCE (DIFFERENCE (CAR args) (CADR args))
EQ (apply EQ args)
EQUAL (apply EQUAL args)
;; think about EVAL. Getting the environment right is subtle
FIXP (apply FIXP args)
INTEROP (apply INTEROP args)
NUMBERP (apply NUMBERP args)
OBLIST (OBLIST)
PLUS (apply PLUS args)
PRETTY (apply pretty-print args)
QUOTIENT (apply QUOTIENT args)
@ -469,13 +473,16 @@
(defn- EVCON
"Inner guts of primitive COND. All `clauses` are assumed to be
`beowulf.cons-cell/ConsCell` objects.
See page 13 of the Lisp 1.5 Programmers Manual."
`beowulf.cons-cell/ConsCell` objects. Note that tests in Lisp 1.5
often return `F`, not `NIL`, on failure.
See page 13 of the Lisp 1.5 Programmers Manual."
[clauses env]
(if
(not= (EVAL (CAAR clauses) env) NIL)
(EVAL (CADAR clauses) env)
(EVCON (CDR clauses) env)))
(let [test (EVAL (CAAR clauses) env)]
(if
(and (not= test NIL) (not= test 'F))
(EVAL (CADAR clauses) env)
(EVCON (CDR clauses) env))))
(defn- EVLIS
"Map `EVAL` across this list of `args` in the context of this
@ -490,12 +497,12 @@
(EVLIS (CDR args) env))))
(defn- eval-symbolic [^Symbol s env]
(let [binding (CDR (ASSOC s env))]
(let [binding (ASSOC s env)]
(if (= binding NIL)
(throw (ex-info (format "No binding for symbol `%s`" s)
{:phase :eval
:symbol s}))
binding)))
(CDR binding))))
(defn- eval-internal
"Common guts for both EVAL and traced-eval. Evaluate this `expr`

9
src/beowulf/core.clj
View file

@ -1,6 +1,7 @@
(ns beowulf.core
"Essentially, the `-main` function and the bootstrap read-eval-print loop."
(:require [beowulf.bootstrap :refer [EVAL]]
[beowulf.io :refer [SYSIN]]
[beowulf.read :refer [READ read-from-console]]
[beowulf.oblist :refer [*options* oblist]]
[clojure.java.io :as io]
@ -22,7 +23,8 @@
["-h" "--help"]
["-p PROMPT" "--prompt PROMPT" "Set the REPL prompt to PROMPT"
:default "Sprecan::"]
["-r INITFILE" "--read INITFILE" "Read Lisp functions from the file INITFILE"
["-r INITFILE" "--read INITFILE" "Read Lisp system from file INITFILE"
:default "resources/lisp1.5.lsp"
:validate [#(and
(.exists (io/file %))
(.canRead (io/file %)))
@ -74,7 +76,12 @@
(when (:errors args)
(apply str (interpose "; " (:errors args))))
"\nSprecan '" stop-word "' tó laéfan\n"))
(binding [*options* (:options args)]
(when (:read *options*)
(try (SYSIN (:read *options*))
(catch Throwable any
(println any))))
(try
(repl (str (:prompt (:options args)) " "))
(catch

22
src/beowulf/io.clj
View file

@ -18,6 +18,7 @@
(:require [beowulf.cons-cell :refer [pretty-print]]
[beowulf.oblist :refer [*options* oblist]]
[beowulf.read :refer [READ]]
[clojure.java.io :refer [file resource]]
[clojure.string :refer [ends-with?]]
[java-time.api :refer [local-date local-date-time]]))
@ -57,20 +58,27 @@
(pretty-print @oblist)))))
(defn SYSIN
"Read the contents of the file at this `filepath` into the object list.
"Read the contents of the file at this `filename` into the object list.
If the file is not a valid Beowulf sysout file, this will probably
corrupt the system, you have been warned. File paths will be considered
relative to the filepath set when starting Lisp.
It is intended that sysout files can be read both from resources within
the jar file, and from the file system. If a named file exists in both the
file system and the resources, the file system will be preferred.
**NOTE THAT** if the provided `filepath` does not end with `.lsp` (which,
if you're writing it from the Lisp REPL it won't), the extension `.lsp`
**NOTE THAT** if the provided `filename` does not end with `.lsp` (which,
if you're writing it from the Lisp REPL, it won't), the extension `.lsp`
will be appended."
[filepath]
(let [fp (full-path (str filepath))
content (try (READ (slurp fp))
[filename]
(let [fp (file (full-path (str filename)))
file (when (and (.exists fp) (.canRead fp)) fp)
res (try (resource filename)
(catch Throwable _ nil))
content (try (READ (slurp (or file res)))
(catch Throwable any
(throw (ex-info "Could not read from sysout"
(throw (ex-info "Could not read from file"
{:context "SYSIN"
:filepath fp}
any))))]