Fix bug in error handling where __sub would be clobbered.
diff --git a/.dir-locals.el b/.dir-locals.el
index 0f6ea64..c8688db 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,6 +1,6 @@
((nil . ((eval
. (let ((path (expand-file-name (or buffer-file-name "."))))
(setq-local flycheck-clang-include-path
- (jmk-includes-for path)
- flycheck-clang-args
- (jmk-other-flags-for path)))))))
+ (jmk-includes-for path)
+ flycheck-clang-args
+ (jmk-other-flags-for path)))))))
diff --git a/doc/lisp_reference/lisp_reference.tex b/doc/lisp_reference/lisp_reference.tex
index 580e00f..fb805a6 100644
--- a/doc/lisp_reference/lisp_reference.tex
+++ b/doc/lisp_reference/lisp_reference.tex
@@ -23,9 +23,9 @@
\newcommand{\startexplanation}{$\triangleright$\hskip1.4ex}
\newcommand{\definition}[2]{#1
-\begin{quote}%
+ \begin{quote}%
\startexplanation#2%
-\end{quote}}
+ \end{quote}}
\newcommand{\plus}{\texttt{+}}
\newcommand{\pluses}[1]{\plus{}#1\plus{}}
\newcommand{\earmuff}{\texttt{*}}
@@ -42,8 +42,8 @@
\newcommand{\T}{\texttt{t}}
\newcommand{\nil}{\texttt{nil}}
\newcommand{\default}[1]{\text{\textsubscript{
- \setlength{\fboxsep}{1pt}\setlength{\fboxrule}{0.2bp}%
- \fbox{#1}}}}
+ \setlength{\fboxsep}{1pt}\setlength{\fboxrule}{0.2bp}%
+ \fbox{#1}}}}
\newcommand{\opt}[2]{\text{$[$}\param{#1}\default{#2}\text{$]$}}
\newcommand{\mut}[1]{\text{$\widetilde{#1}$}}
\newcommand{\mighteval}[1]{\text{$\widehat{#1}$}}
@@ -51,20 +51,28 @@
\newcommand{\optlist}[1]{\text{\(
\left\{
- \begin{array}{l}
+ \begin{array}{l}
#1
- \end{array}
+ \end{array}
\right\}
-\)}}
+ \)}}
\makeindex
\makeglossaries
-\newglossaryentry{closure}{name={closure},description={A \type{function-object} that captures certain variables from its defining context}}
+\newglossaryentry{closure}{name={closure},description={A
+ \type{function-object} that captures certain variables from its
+ defining context}}
-\newglossaryentry{lexical-scope}{name={lexical scope},description={A method of scoping where the values in scope at a given time are determined by the static content of the source program, not by the state of the callstack or other execution details. This allows for example closures to \gls{closure}s to capture some of the state of their defining context}}
+\newglossaryentry{lexical-scope}{name={lexical scope},description={A
+ method of scoping where the values in scope at a given time are
+ determined by the static content of the source program, not by the
+ state of the callstack or other execution details. This allows for
+ example closures to \gls{closure}s to capture some of the state of
+ their defining context}}
-\newglossaryentry{truthy}{name={truthy},description={A value that is not \nil}}
+\newglossaryentry{truthy}{name={truthy},description={A value that is
+ not \nil}}
\begin{document}
@@ -73,26 +81,29 @@
\section{Introduction}
-This document provides a brief reference to the Bluejay Lisp language and standard library. It documents every currently valid function, macro, reader macro, and special form supported by the compiler.
+This document provides a brief reference to the Bluejay Lisp language
+and standard library. It documents every currently valid function,
+macro, reader macro, and special form supported by the compiler.
\subsection{Typography}
-The following text styles and symbols are used within this document to indicate particular values or meanings:
+The following text styles and symbols are used within this document to
+indicate particular values or meanings:
\begin{tabular}[t]{p{0.2\linewidth} p{0.64\linewidth}}
- \func{cons} & A function ``cons.'' \\
- \const{\plus{}foo\plus} & A constant ``\plus{}foo\plus.'' \\
- \var{\earmuff{}bar\earmuff} & A global variable ``\earmuff{}bar\earmuff''. \\
- \reader{baz} & A reader macro ``baz.'' \\
- \mac{quux} & A macro ``quux.'' \\
- \param{parameter} & A function argument ``parameter'' \\
- \opt{var}{123} & An optional function argument ``var'' with the default value ``123.'' \\
- \param{args}\more & ``args'' represents the rest of the items in the list. \\
- \mut{\param{mut}} & A function argument ``mut'' that might be mutated. \\
- \mighteval{\param{maybe}} & ``maybe'' may or may not be evaluated. \\
- \ret{value} & Indicates that a form will evaluate to ``value''. \\
- \type{integer} & The type ``integer''. \\
- \optlist{\text{a}\\\text{b}} & One of ``a'' or ``b.''
+ \func{cons} & A function ``cons.'' \\
+ \const{\plus{}foo\plus} & A constant ``\plus{}foo\plus.'' \\
+ \var{\earmuff{}bar\earmuff} & A global variable ``\earmuff{}bar\earmuff''. \\
+ \reader{baz} & A reader macro ``baz.'' \\
+ \mac{quux} & A macro ``quux.'' \\
+ \param{parameter} & A function argument ``parameter'' \\
+ \opt{var}{123} & An optional function argument ``var'' with the default value ``123.'' \\
+ \param{args}\more & ``args'' represents the rest of the items in the list. \\
+ \mut{\param{mut}} & A function argument ``mut'' that might be mutated. \\
+ \mighteval{\param{maybe}} & ``maybe'' may or may not be evaluated. \\
+ \ret{value} & Indicates that a form will evaluate to ``value''. \\
+ \type{integer} & The type ``integer''. \\
+ \optlist{\text{a}\\\text{b}} & One of ``a'' or ``b.''
\end{tabular}
\section{Primitives}
@@ -100,57 +111,77 @@
\subsection{Type Predicates}
\definition{
- (\optlist{
- \func{nilp} \text{ or } \func{not} \\
- \func{integerp}
- } \param{value})\index{nilp}\index{not}
+ (\optlist{
+ \func{nilp} \text{ or } \func{not} \\
+ \func{integerp}
+ } \param{value})\index{nilp}\index{not}
}{
- \ret{\T} if \param{value} is of the specified type, \ret{\nil} otherwise.
+ \ret{\T} if \param{value} is of the specified type, \ret{\nil}
+ otherwise.
}
\subsection{Definitions and Variables}
\definition{
- (\mac{defun} \param{name} (\param{args}\more) \param{body}\more)\index{defun} \\
- (\mac{defmacro} \param{name} (\param{args}\more) \param{body}\more)\index{defmacro}
+ (\mac{defun} \param{name} (\param{args}\more) \param{body}\more)\index{defun} \\
+ (\mac{defmacro} \param{name} (\param{args}\more) \param{body}\more)\index{defmacro}
}{
- Define a function or macro respectively, taking \param{args} arguments and evaluating \param{body} in turn, finally evaluating to \ret{the final entry in \param{body}} or \ret{\nil} if \param{body} is empty.
+ Define a function or macro respectively, taking \param{args}
+ arguments and evaluating \param{body} in turn, finally evaluating to
+ \ret{the final entry in \param{body}} or \ret{\nil} if \param{body}
+ is empty.
}
\definition{
- (\mac{let1} (\param{variable} \param{form}) \param{body}\more)\index{let1}
+ (\mac{let1} (\param{variable} \param{form}) \param{body}\more)\index{let1}
}{
- First evaluate \param{form}, binding it to \param{variable}. Then evaluate \param{body}, finally evaluating to \ret{the final entry in \param{body}} or \ret{\nil} if \param{body} is empty. \param{variable} is no longer in scope after this form ends.
+ First evaluate \param{form}, binding it to \param{variable}. Then
+ evaluate \param{body}, finally evaluating to \ret{the final entry in
+ \param{body}} or \ret{\nil} if \param{body} is
+ empty. \param{variable} is no longer in scope after this form ends.
}
\definition{
- \reader{\textquotesingle}\param{value} \\
- (\mac{quote} \param{value})\index{quote}
+ \reader{\textquotesingle}\param{value} \\
+ (\mac{quote} \param{value})\index{quote}
}{
- \ret{Return \param{value}} as-is, without evaluating it.
+ \ret{Return \param{value}} as-is, without evaluating it.
+}
+
+\definition{
+ \reader{\`}\param{value} \\
+ (\mac{backquote} \param{value})\index{backquote}\index{\`}
+}{
+ Return \ret{\param{value}} as-is, except for any \mac{unquote}
+ and \mac{unquote-splice} forms (and their reader-macro equivalents).
}
\subsection{Control Flow}
\definition{
- (\mac{if} \param{predicate} \param{then} \opt{otherwise}{nil})\index{if} \\
- (\mac{when} \param{predicate} \param{then\more})\index{when} \\
- (\mac{unless} \param{predicate} \param{otherwise\more})\index{unless}
+ (\mac{if} \param{predicate} \param{then} \opt{otherwise}{nil})\index{if} \\
+ (\mac{when} \param{predicate} \param{then\more})\index{when} \\
+ (\mac{unless} \param{predicate} \param{otherwise\more})\index{unless}
}{
- First evaluate \param{predicate}. If it is \gls{truthy} evaluate and return \ret{\param{then}}, otherwise \ret{\param{otherwise}}. If either is not provided return \ret{\nil}.
+ First evaluate \param{predicate}. If it is \gls{truthy} evaluate and
+ return \ret{\param{then}}, otherwise \ret{\param{otherwise}}. If
+ either is not provided return \ret{\nil}.
}
\definition{
- (\mac{progn} \opt{forms\more}{nil})\index{progn}
+ (\mac{progn} \opt{forms\more}{nil})\index{progn}
}{
- Evaluate \param{forms} from first to last, finally returning \ret{the last form}.
+ Evaluate \param{forms} from first to last, finally returning
+ \ret{the last form}.
}
\definition{
- (\mac{and} \param{first} \param{\mighteval{rest}}\more)\index{and} \\
- (\mac{or} \param{first} \param{\mighteval{rest}}\more)\index{or}
+ (\mac{and} \param{first} \param{\mighteval{rest}}\more)\index{and} \\
+ (\mac{or} \param{first} \param{\mighteval{rest}}\more)\index{or}
}{
- Short circuiting $\land$ and $\lor$, respectively. Return the first value that is \nil{} or truthy, respectively, or the last value if all are truthy/\nil{}.
+ Short circuiting $\land$ and $\lor$, respectively. Return the first
+ value that is \nil{} or truthy, respectively, or the last value if
+ all are truthy/\nil{}.
}
\section{Numbers}
@@ -158,46 +189,59 @@
\subsection{Integers}
\definition{
- (\func{$+$} \param{a b})\index{+} \\
- (\func{$-$} \param{a b})\index{-} \\
- (\func{$*$} \param{a b})\index{*} \\
- (\func{$/$} \param{a b})\index{/}
+ (\func{$+$} \param{a b})\index{+} \\
+ (\func{$-$} \param{a b})\index{-} \\
+ (\func{$*$} \param{a b})\index{*} \\
+ (\func{$/$} \param{a b})\index{/}
}{
- The \ret{sum, difference, product, or quotient} of \param{a} and \param{b} as an \type{integer}.
+ The \ret{sum, difference, product, or quotient} of \param{a} and
+ \param{b} as an \type{integer}.
}
\definition{
- (\func{=} \param{a b})
+ (\func{=} \param{a b})
}{
- \ret{\T} if \param{a} and \param{b} hold the same \type{integer} value, \ret{\nil} otherwise.
+ \ret{\T} if \param{a} and \param{b} hold the same \type{integer}
+ value, \ret{\nil} otherwise.
}
\section{Function Manipulation}
\definition{
- (\func{funcall} \param{args}\more)\index{funcall} \\
- (\func{apply} \param{function} \param{args})\index{apply}
+ (\func{funcall} \param{args}\more)\index{funcall} \\
+ (\func{apply} \param{function} \param{args})\index{apply}
}{
- Call the \type{closure} or \type{function-object} \param{function} with \param{args} and evaluate to \ret{its result}. An error occurs if \param{args} are not acceptable.
+ Call the \type{closure} or \type{function-object} \param{function}
+ with \param{args} and evaluate to \ret{its result}. An error occurs
+ if \param{args} are not acceptable.
}
\definition{
- (\mac{function} \param{function-name})\index{function} \\
- \reader{\#\textquotesingle}\param{function-name}\index{\#\textquotesingle}
+ (\func{recurse} \param{args}\more)\index{recurse}
}{
- Create a \ret{\type{function-object} from an existing function or macro}. \param{function} must be a symbol literal at compile time.
+ In a lambda definition, call the current lambda with \param{args}.
}
\definition{
- (\func{lambda} (\param{args}\more) \param{body}\more)\index{lambda}
+ (\mac{function} \param{function-name})\index{function} \\
+ \reader{\#\textquotesingle}\param{function-name}\index{\#\textquotesingle}
}{
- Create a \ret{lexically-scoped \type{\gls{closure}}} taking \param{args} and evaluating to \param{body}.
+ Create a \ret{\type{function-object} from an existing function or
+ macro}. \param{function} must be a symbol literal at compile time.
}
\definition{
- (\func{eval} \param{form})\index{eval}
+ (\func{lambda} (\param{args}\more) \param{body}\more)\index{lambda}
}{
- Evaluate and return \ret{\param{form}} in the current global environment. The evaluated form does not use \gls{lexical-scope}.
+ Create a \ret{lexically-scoped \type{\gls{closure}}} taking
+ \param{args} and evaluating to \param{body}.
+}
+
+\definition{
+ (\func{eval} \param{form})\index{eval}
+}{
+ Evaluate and return \ret{\param{form}} in the current global
+ environment. The evaluated form does not use \gls{lexical-scope}.
}
\section{Lists}
@@ -205,96 +249,112 @@
\subsection{Creating Lists}
\definition{
- (\func{cons} \param{a} \param{b})\index{cons}
+ (\func{cons} \param{a} \param{b})\index{cons}
}{
- Join \param{a} and \param{b} into a \ret{\type{cons} pair}.
+ Join \param{a} and \param{b} into a \ret{\type{cons} pair}.
}
\definition{
- (\func{list} \param{values}\more)\index{list}
+ (\func{list} \param{values}\more)\index{list}
}{
- Construct a \ret{\type{cons}-list of \param{values}}.
+ Construct a \ret{\type{cons}-list of \param{values}}.
}
\subsection{Deconstructing Lists}
\definition{
- (\func{length} \param{list})\index{list}
+ (\func{length} \param{list})\index{list}
}{
- Return the \ret{length of \param{list}} if it is a \type{cons}-list, \nil{} otherwise.
+ Return the \ret{length of \param{list}} if it is a \type{cons}-list,
+ \nil{} otherwise.
}
\definition{
- (\func{car} \param{pair})\index{car} \\
- (\func{cdr} \param{pair})\index{cdr}
+ (\func{car} \param{pair})\index{car} \\
+ (\func{cdr} \param{pair})\index{cdr}
}{
- Return the \ret{first or second item} of \type{cons} \param{pair}, respectively.
+ Return the \ret{first or second item} of \type{cons} \param{pair},
+ respectively.
}
\definition{
- (\optlist{
- \func{caar}\\
- \func{cadr}\\
- \func{caddr}\\
- \func{cadar}\\
- \func{caddar}
- } \param{val})
+ (\optlist{
+ \func{caar}\\
+ \func{cadr}\\
+ \func{caddr}\\
+ \func{cadar}\\
+ \func{caddar}
+ } \param{val})
}{
- Behave like a combination of \func{car} and \func{cdr} would.
+ Behave like a combination of \func{car} and \func{cdr} would.
}
\definition{
- (\func{elt} \param{list} \param{n})\index{elt}
+ (\func{elt} \param{list} \param{n})\index{elt}
}{
- Return the \ret{\param{n}\super{th} element of \param{list}}, starting from 0, or \ret{\nil} if \param{n} $ \ge $ (\func{length} \param{list}) or \param{list} is not a \type{cons}-list or \param{n} is not an \type{integer}.
+ Return the \ret{\param{n}\super{th} element of \param{list}},
+ starting from 0, or \ret{\nil} if \param{n} $ \ge $ (\func{length}
+ \param{list}) or \param{list} is not a \type{cons}-list or \param{n}
+ is not an \type{integer}.
}
\subsection{Operating on Lists}
\definition{
- (\func{mapcar} \param{fun} \param{list})\index{mapcar}
+ (\func{mapcar} \param{fun} \param{list})\index{mapcar}
}{
- Apply \param{fun} to each element of \param{list}, returning a \ret{new \type{cons}-list} containing the results of the respective applications of \param{fun}.
+ Apply \param{fun} to each element of \param{list}, returning a
+ \ret{new \type{cons}-list} containing the results of the respective
+ applications of \param{fun}.
}
\definition{
- (\optlist{\func{remove-if}\\\func{remove-if-not}} \param{predicate} \param{list})\index{remove-if}\index{remove-if-not}
+ (\optlist{\func{remove-if}\\\func{remove-if-not}}
+ \param{predicate} \param{list})\index{remove-if}\index{remove-if-not}
}{
- Return a \ret{new \type{cons}-list} of all the items of \param{list} that either do not or do satisfy \param{predicate}, respectively.
+ Return a \ret{new \type{cons}-list} of all the items of \param{list}
+ that either do not or do satisfy \param{predicate}, respectively.
}
\definition{
- (\func{reduce} \param{fun} \param{list} \opt{initial-value}{\nil})
+ (\func{reduce} \param{fun} \param{list} \opt{initial-value}{\nil})
}{
- Apply \param{fun} to two arguments at a time, starting with \param{initial-value} and (\func{car} \param{list}) and continuing with the result of the previous invocation and the successive element of \param{list}. Return \ret{the result of the final invocation}, or \ret{\param{initial-value}} if \param{list} is empty.
+ Apply \param{fun} to two arguments at a time, starting with
+ \param{initial-value} and (\func{car} \param{list}) and continuing
+ with the result of the previous invocation and the successive
+ element of \param{list}. Return \ret{the result of the final
+ invocation}, or \ret{\param{initial-value}} if \param{list} is
+ empty.
}
\section{Input \& Output}
\definition{
- (\func{print} \param{value})\index{print}
+ (\func{print} \param{value})\index{print}
}{
- Print \param{value} to standard output. Return \ret{\nil}.
+ Print \param{value} to standard output. Return \ret{\nil}.
}
\definition{
- (\func{read})\index{read}
+ (\func{read})\index{read}
}{
- Read and return an \ret{S-expression} from standard input
+ Read and return an \ret{S-expression} from standard input
}
\subsection{Loading Programs}
\definition{
- \const{\pluses{current-file}}\index{\pluses{current-file}}
+ \const{\pluses{current-file}}\index{\pluses{current-file}}
}{
- The current file being compiled, or \nil{} if not compiling a file.
+ The current file being compiled, or \nil{} if not compiling a file.
}
\definition{
- (\func{load} \param{lisp-file})\index{load}
+ (\func{load} \param{lisp-file})\index{load}
}{
- Load and evaluate \type{string} \param{lisp-file} as a local path relative to the current file, or the current working directory if not compiling a file. Return \ret{\nil}.
+ Load and evaluate \type{string} \param{lisp-file} as a local path
+ relative to the current file, or the current working directory if
+ not compiling a file. Return \ret{\nil}.
}
\printindex
diff --git a/lib/lisp/std/std.lisp b/lib/lisp/std/std.lisp
index 774d805..db0cd12 100644
--- a/lib/lisp/std/std.lisp
+++ b/lib/lisp/std/std.lisp
@@ -20,26 +20,21 @@
;; /Boring utilitites
(defun not (val)
+ "Identical to NILP, returns T if VAL is NIL, NIL otherwise."
(nilp val))
;; TODO: make tail recursive (for this `flet` would be nice)
(defun length (list)
- "Returns the length of `list`, or `nil` if it is not a list"
+ "Returns the length of LIST, or NIL if it is not a list"
(if (nilp list)
0
(+ 1 (length (cdr list)))))
(defmacro when (cond & body)
- "Evaluate `body` when `cond` is truthy.
-When `cond` is truthy, evaluates `body` in order, finally evaluating to
-the final item."
(list 'if cond
(cons 'progn body)))
(defmacro unless (cond & body)
- "Evaluate `body` unless `cond` is truthy.
-When `cond` is nil, evaluates `body` in order, finally evaluating to the
-final item."
(list 'if cond
nil
(cons 'progn body)))
@@ -51,4 +46,8 @@
(defun funcall (fun & list)
(apply fun list))
-(load "list-functions.lisp")
+;; (defmacro flet1 (func & body)
+;; `(let1 (,(car func) ,(cons 'lambda (cdr func)))
+;; ,@load))
+
+(list "body-functions.lisp")
diff --git a/share/jmk/dir-locals.el b/share/jmk/dir-locals.el
index 0f6ea64..c8688db 100644
--- a/share/jmk/dir-locals.el
+++ b/share/jmk/dir-locals.el
@@ -1,6 +1,6 @@
((nil . ((eval
. (let ((path (expand-file-name (or buffer-file-name "."))))
(setq-local flycheck-clang-include-path
- (jmk-includes-for path)
- flycheck-clang-args
- (jmk-other-flags-for path)))))))
+ (jmk-includes-for path)
+ flycheck-clang-args
+ (jmk-other-flags-for path)))))))
diff --git a/share/jmk/jmk-flycheck.el b/share/jmk/jmk-flycheck.el
index a1ab539..661f7e3 100644
--- a/share/jmk/jmk-flycheck.el
+++ b/share/jmk/jmk-flycheck.el
@@ -43,3 +43,5 @@
(stripped (mapcar #'string-trim not-includes)))
stripped))
+(provide 'jmk-flycheck)
+;;; jmk-flycheck.el ends here
diff --git a/share/jmk/jmk.m4 b/share/jmk/jmk.m4
index be6fe3d..aa3ad79 100644
--- a/share/jmk/jmk.m4
+++ b/share/jmk/jmk.m4
@@ -45,7 +45,7 @@
$1, `debug', `CFLAGS += -g
ASMFLAGS += -Fdwarf',
$1, `32', `CFLAGS += -m32',
- $1, `warn', `CFLAGS += -Wall -Wno-unused-function -Wno-unused-variable -Wno-incompatible-pointer-types',
+ $1, `warn', `CFLAGS += -Wall -Wextra -Wno-unused-function -Wno-unused-variable -Wno-incompatible-pointer-types',
$1, `nasm', `ASM = nasm',
$1, `glossaries', `LATEX_MAKE_GLOSSARIES = 1',
$1, xelatex, `LATEXC = xelatex')')
diff --git a/src/lisp/Jmk b/src/lisp/Jmk
index 03b0e55..022fcc0 100644
--- a/src/lisp/Jmk
+++ b/src/lisp/Jmk
@@ -54,6 +54,10 @@
status_log(LISP, $(F))
@LISP_LIBRARY_PATH="$(lisp_libpath)" ./lisp $(F)
+repl: lisp
+ status_log(LISP, repl)
+ @LISP_LIBRARY_PATH="$(lisp_libpath)" ./lisp $(ROOT)/lib/lisp/repl/repl.lisp
+
leak-check: lisp
status_log(VALGRIND, lisp $(F))
@LISP_LIBRARY_PATH="$(lisp_libpath)" valgrind --leak-check=full ./lisp $(F)
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index e591ed3..5810f69 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -187,7 +187,7 @@
for (value_t body_ = body; !nilp(body_); body_ = cdr(body_))
{
- walk_and_alloc(&local, car(body_));
+ TRY(walk_and_alloc(env, &local, carref(body_)));
}
| setup (local.num_stack_entries);
@@ -269,11 +269,15 @@
OKAY();
}
-void walk_and_alloc(struct local *local, value_t body)
+struct error walk_and_alloc(struct environment *env, struct local *local, value_t *bp)
{
+ E_INIT();
+
+ value_t body = *bp;
+
// TODO: handle macros
if (!listp(body))
- return;
+ OKAY();
value_t args = cdr(body);
@@ -284,7 +288,7 @@
value_t expr = cdr(args);
for (; !nilp(expr); expr = cdr(expr))
{
- walk_and_alloc(local, car(expr));
+ walk_and_alloc(env, local, carref(expr));
}
local_free(local, slot);
@@ -293,15 +297,40 @@
{
// We don't want to walk the lambda because it's another function. When
// the lambda is compiled it will be walked.
- return;
+ OKAY();
}
else
{
- for (; !nilp(args); args = cdr(args))
+ // Is this a macro?
+
+ struct function *mac = NULL;
+
+ if (symbolp(car(body)))
+ mac = find_function(env, (char *)(car(body) ^ SYMBOL_TAG));
+ else
+ walk_and_alloc(env, local, carref(body));
+
+ if (mac && mac->namespace == NS_MACRO)
{
- walk_and_alloc(local, car(args));
+ unsigned char pool = push_pool(0);
+ value_t form = call_list(mac, args);
+ pop_pool(pool);
+
+ add_to_pool(form);
+ *bp = form;
+
+ walk_and_alloc(env, local, bp);
+ }
+ else
+ {
+ for (; !nilp(args); args = cdr(args))
+ {
+ walk_and_alloc(env, local, carref(args));
+ }
}
}
+
+ OKAY();
}
bool load(struct environment *env, char *path)
@@ -320,16 +349,31 @@
value_t val;
- while (IS_OKAY(read1(is, &val)))
+ struct error read_error;
+
+ while (IS_OKAY((read_error = read1(is, &val))))
{
if (!IS_OKAY(compile_tl(val, env, path)))
- break;
+ {
+ goto failure;
+ }
+ }
+
+ if (!read_error.safe_state)
+ {
+ goto failure;
}
del_fistream(is);
pop_pool(pop);
return true;
+
+failure:
+ del_fistream(is);
+ pop_pool(pool);
+
+ return false;
}
value_t load_relative(struct environment *env, char *to, value_t name)
@@ -411,6 +455,10 @@
TRY(compile_expression(env, local, car(args), false, Dst));
}
+ else if (symstreq(fsym, "unquote-splice"))
+ {
+
+ }
else
{
| push nil;
diff --git a/src/lisp/compiler.h b/src/lisp/compiler.h
index 67c03e6..75abe33 100644
--- a/src/lisp/compiler.h
+++ b/src/lisp/compiler.h
@@ -166,7 +166,7 @@
/**
* Walk `body` and reserve space in `local` for any variable declarations.
*/
-void walk_and_alloc(struct local *local, value_t body);
+struct error walk_and_alloc(struct environment *env, struct local *local, value_t *body);
/**
* Compile a top level definition
diff --git a/src/lisp/error.c b/src/lisp/error.c
index 266f797..bb289e2 100644
--- a/src/lisp/error.c
+++ b/src/lisp/error.c
@@ -42,3 +42,12 @@
}
}
}
+
+void edebug(struct error err, char *file, int line, const char *func, const char *why)
+{
+ if (!err.safe_state)
+ {
+ fprintf(stderr, "\033[43m%s at\033[0m %s:%d %s\n", why, file, line, func);
+ ereport(err);
+ }
+}
diff --git a/src/lisp/error.h b/src/lisp/error.h
index d4c47e8..7f95870 100644
--- a/src/lisp/error.h
+++ b/src/lisp/error.h
@@ -37,56 +37,56 @@
char *message;
};
-#define E_INIT() \
- struct error __error; \
- __error.code = EOK; \
- __error.loc.line = 0; \
- __error.safe_state = false; \
- __error.message = NULL; \
- __error.loc.file = NULL;
-#define NEARVAL(val) \
- __error.loc.line = cons_line(val); \
- __error.loc.file = cons_file(val)
+#define E_DEBUG(_e, _m) // edebug(_e, __FILE__, __LINE__, __func__, _m)
+#define E_INIT() \
+ struct error __error = { 0 };
+#define NEARVAL(val) \
+ __error.loc.line = cons_line(val), \
+ __error.loc.file = cons_file(val)
#define NEARIS(is) (is)->getpos((is), &__error.loc.line, &__error.loc.file)
-#define _TRY(expr, m, c) \
- { \
- struct error __sub = (expr); \
- if (__sub.code) \
- { \
- if (!__sub.loc.file || !__sub.loc.line) \
- __sub.loc.file = __error.loc.file, \
- __sub.loc.line = __error.loc.line; \
- if (c) \
- __sub.code = c; \
- if (m) \
- __sub.message = m; \
- return __sub; \
- } \
+#define _TRY(expr, m, c) \
+ { \
+ struct error __sub = (expr); \
+ if (__sub.code) \
+ { \
+ if (!__sub.loc.file || !__sub.loc.line) \
+ __sub.loc.file = __error.loc.file, \
+ __sub.loc.line = __error.loc.line; \
+ if (c) \
+ __sub.code = c; \
+ char *__m = m; \
+ if (__m) \
+ __sub.message = __m; \
+ E_DEBUG(__sub, #expr); \
+ return __sub; \
+ } \
}
#define TRY(expr) _TRY(expr, NULL, 0)
#define TRY_ELSE(expr, c, ...) _TRY(expr, ehsprintf(__VA_ARGS__), c)
#define OKAY() return __error
-#define THROW(_c, ...) \
- { \
- __error.code = (_c); \
- __error.message = ehsprintf(__VA_ARGS__); \
- return __error; \
+#define THROW(_c, ...) \
+ { \
+ __error.code = (_c); \
+ __error.message = ehsprintf(__VA_ARGS__); \
+ E_DEBUG(__error, "throwing"); \
+ return __error; \
}
-#define THROWSAFE(_c) \
- { \
- __error.code = (_c); \
- __error.safe_state = true; \
- return __error; \
+#define THROWSAFE(_c) \
+ { \
+ __error.code = (_c); \
+ __error.safe_state = true; \
+ E_DEBUG(__error, "safe"); \
+ return __error; \
}
#define IS_OKAY(e) ((e).code == EOK)
-#define OKAY_IF(val) \
- { \
- struct error __sub = (val); \
- if (IS_OKAY(__sub)) \
- OKAY(); \
- if (!__sub.safe_state) \
- TRY(__sub) \
+#define OKAY_IF(val) \
+ { \
+ struct error __sub_of = (val); \
+ if (IS_OKAY(__sub_of)) \
+ OKAY(); \
+ if (!__sub_of.safe_state) \
+ TRY(__sub_of); \
}
#define WARN_UNUSED __attribute__((warn_unused_result))
@@ -96,3 +96,5 @@
char *ehsprintf(const char *msg, ...);
void ereport(struct error err);
+
+void edebug(struct error err, char *file, int line, const char *func, const char *why);
diff --git a/src/lisp/lib/std.c b/src/lisp/lib/std.c
index 5ad02bc..0a203b5 100644
--- a/src/lisp/lib/std.c
+++ b/src/lisp/lib/std.c
@@ -97,7 +97,7 @@
struct istream *is = new_stristream_nt(string);
value_t val = nil;
- struct error err;
+ struct error err = { 0 };
if (!IS_OKAY((err = read1(is, &val))))
{
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index 64ab9ae..e8aed91 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -325,7 +325,8 @@
value_t wrapped;
NEARIS(is);
- TRY_ELSE(read1(is, &wrapped), EEXPECTED, "Expected a form after reader macro char %c", c);
+ struct error read_error = read1(is, &wrapped);
+ TRY_ELSE(read_error, EEXPECTED, "Expected a form after reader macro char %c", c);
value_t symbol = nil;
@@ -577,6 +578,15 @@
return pool != 0;
}
+void add_to_pool(value_t form)
+{
+ if (!heapp(form))
+ return;
+
+ struct alloc *a = (void *)(form & ~0b111);
+ a[-1].pool = current_pool;
+}
+
int cons_line(value_t val)
{
if (!consp(val))
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index 430e526..eff35f9 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -147,6 +147,8 @@
*/
void pop_pool(unsigned char pool);
+void add_to_pool(value_t form);
+
/**
* @returns true if pool is still alive (in scope).
*/
diff --git a/src/lisp/main.c b/src/lisp/main.c
index 07e6d4a..f78b3b1 100644
--- a/src/lisp/main.c
+++ b/src/lisp/main.c
@@ -20,10 +20,11 @@
goto done;
}
- value_t (*lisp_main)() = find_function(env, "main")->def0;
+ struct function *lisp_main_f = find_function(env, "main");
- if (lisp_main)
+ if (lisp_main_f)
{
+ value_t (*lisp_main)() = lisp_main_f->def0;
gc_set_base_here();
lisp_main();
}