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.
**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`
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 `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))))]