public void Can_import_into_global_symbols()
{
var SExprs = Lisp.Parse("(fib 10)");
var lispCtx = Lisp.CreateInterpreter();
try
{
lispCtx.Eval(SExprs);
Assert.Fail("should throw");
}
catch (LispEvalException e) {}
Lisp.Import(@"
(defun fib (n)
(if (< n 2)
1
(+ (fib (- n 1))
(fib (- n 2)) )
))
");
lispCtx = Lisp.CreateInterpreter();
Assert.That(lispCtx.Eval(SExprs), Is.EqualTo(89));
Lisp.Reset();
lispCtx = Lisp.CreateInterpreter();
try
{
lispCtx.Eval(SExprs);
Assert.Fail("should throw");
}
catch (LispEvalException e) {}
}
public void Can_eval_fib_lisp()
{
var lisp = @"
(defun fib (n)
(if (< n 2)
1
(+ (fib (- n 1))
(fib (- n 2)) )
))
";
try
{
var lispCtx = Lisp.CreateInterpreter();
var sExpressions = Lisp.Parse(lisp);
var x = lispCtx.Eval(sExpressions);
$"{x}".Print();
sExpressions = Lisp.Parse("(fib 15)");
x = lispCtx.Eval(sExpressions);
$"{x}".Print();
Assert.That((int)x, Is.EqualTo(987));
}
catch (Exception e)
{
Console.WriteLine(e);
throw;
}
}
public void Can_min_max_int_long_double_values()
{
var lispCtx = Lisp.CreateInterpreter();
Assert.That((int)lispCtx.Eval(Lisp.Parse("(min 1 2)")), Is.EqualTo(1));
Assert.That((int)lispCtx.Eval(Lisp.Parse("(max 1 2)")), Is.EqualTo(2));
Assert.That((double)lispCtx.Eval(Lisp.Parse("(min 1.0 2.0)")), Is.EqualTo(1.0));
Assert.That((double)lispCtx.Eval(Lisp.Parse("(max 1.0 2.0)")), Is.EqualTo(2.0));
Assert.That((long)lispCtx.Eval(Lisp.Parse($"(min {int.MaxValue + 1L} {int.MaxValue + 2L})")), Is.EqualTo(int.MaxValue + 1L));
Assert.That((long)lispCtx.Eval(Lisp.Parse($"(max {int.MaxValue + 1L} {int.MaxValue + 2L})")), Is.EqualTo(int.MaxValue + 2L));
}
private void HandleConnection(TcpClient client, int id, string remoteIp)
{
try
{
using (client)
{
var interp = Lisp.CreateInterpreter();
var CMD_CLEAR = "\u001B[2J";
var sb = new StringBuilder();
var networkStream = client.GetStream();
var remoteUrl = $"tcp://{remoteIp}";
void write(string msg) => MemoryProvider.Instance.Write(networkStream, msg.AsMemory());
using (var reader = new StreamReader(networkStream, Encoding.UTF8))
{
string line;
if (RequireAuthSecret)
{
MemoryProvider.Instance.Write(networkStream,
$"Authentication required:\n> ".AsMemory());
line = reader.ReadLine();
var authSuccess = !string.IsNullOrEmpty(line) && line == HostContext.Config.AdminAuthSecret;
if (!authSuccess)
{
write($"Authentication failed.\n\n");
client.Close();
return;
}
write(CMD_CLEAR);
}
MemoryProvider.Instance.Write(networkStream,
$"\nWelcome to #Script Lisp! The Server time is: {DateTime.Now.ToShortTimeString()}, type ? for help.\n\n".AsMemory());
while (true)
{
if (listener == null)
{
return;
}
prompt:
write("> ");
sb.Clear();
while ((line = reader.ReadLine()) != null)
{
if (line == "quit" || line == "exit")
{
write($"Goodbye.\n\n");
client.Close();
return;
}
if (line == "verbose")
{
var toggle = interp.GetSymbolValue("verbose") is bool v && v
? null
: Lisp.TRUE;
interp.SetSymbolValue("verbose", toggle);
var mode = toggle != null ? "on" : "off";
write($"verbose mode {mode}\n\n");
goto prompt;
}
if (line == "mode")
{
var toggle = interp.GetSymbolValue("multi-line") is bool v && v
? null
: Lisp.TRUE;
interp.SetSymbolValue("multi-line", toggle);
var mode = toggle != null ? "off" : "on";
write($"single-line mode {mode}\n\n");
goto prompt;
}
if (line == "clear")
{
write(CMD_CLEAR);
goto prompt;
}
if (line == "?")
{
var usage = @"
; verbose - toggle output to indent complex responses
; mode - toggle between single and multi-line modes
; clear - clear screen
; quit - exit session
Learn more about #Script Lisp at: https://sharpscript.net/lisp
";
write(usage);
goto prompt;
}
sb.AppendLine(line);
var multiLine = interp.GetSymbolValue("multi-line");
if (multiLine == null || multiLine is bool b && !b)
{
break;
}
if (line == "") // evaluate on empty new line
{
break;
}
}
var lisp = sb.ToString();
if (lisp.Trim().Length == 0)
{
continue;
}
string output = null;
try
{
var requestArgs = CreateBasicRequest(remoteUrl);
output = interp.ReplEval(ScriptContext, networkStream, lisp, requestArgs);
}
catch (Exception e)
{
var str = (e.InnerException ?? e) + "\n";
MemoryProvider.Instance.Write(networkStream, str.AsMemory());
}
if (!string.IsNullOrEmpty(output))
{
MemoryProvider.Instance.Write(networkStream, output.AsMemory());
MemoryProvider.Instance.Write(networkStream, "\n\n".AsMemory());
networkStream.Flush();
}
}
}
}
}
catch (Exception ex)
{
if (Log.IsDebugEnabled)
{
Log.Debug($"{remoteIp} connection was disconnected. " + ex.Message);
}
}
}
public void Can_eval_lisp_in_lisp()
{
var lisp = @"
;;; A circular Lisp interpreter in Common/Emacs/Nukata Lisp
;;; by SUZUKI Hisao on H28.8/10, H29.3/13
;;; cf. Zick Standard Lisp (https://github.com/zick/ZickStandardLisp)
(progn
;; Expr: (EXPR environment (symbol...) expression...)
;; Subr: (SUBR . function)
;; Environment: ((symbol . value)...)
;; N.B. Expr has its own environment since this Lisp is lexically scoped.
;; Language-specific Hacks
(setq funcall (lambda (f x) (f x))) ; for Nukata Lisp and this Lisp
(setq max-lisp-eval-depth 10000) ; for Emacs Lisp
(setq max-specpdl-size 7000) ; for Emacs Lisp
;; The global environment of this Lisp
(setq global-env
(list '(*version* . (1.2 ""Lisp"" ""circlisp""))
(cons 'car
(cons 'SUBR (lambda (x) (car (car x)))))
(cons 'cdr
(cons 'SUBR (lambda (x) (cdr (car x)))))
(cons 'cons
(cons 'SUBR (lambda (x) (cons (car x) (cadr% x)))))
(cons 'eq
(cons 'SUBR (lambda (x) (eq (car x) (cadr% x)))))
(cons 'atom
(cons 'SUBR (lambda (x) (atom (car x)))))
(cons 'rplaca
(cons 'SUBR (lambda (x) (rplaca (car x) (cadr% x)))))
(cons 'rplacd
(cons 'SUBR (lambda (x) (rplacd (car x) (cadr% x)))))
(cons 'list
(cons 'SUBR (lambda (x) x)))
(cons '+
(cons 'SUBR (lambda (x) (+ (car x) (cadr% x)))))
(cons '*
(cons 'SUBR (lambda (x) (* (car x) (cadr% x)))))
(cons '-
(cons 'SUBR (lambda (x) (- (car x) (cadr% x)))))
(cons 'truncate
(cons 'SUBR (lambda (x) (truncate (car x) (cadr% x)))))
(cons 'mod
(cons 'SUBR (lambda (x) (mod (car x) (cadr% x)))))
(cons '=
(cons 'SUBR (lambda (x) (= (car x) (cadr% x)))))
(cons '<
(cons 'SUBR (lambda (x) (< (car x) (cadr% x)))))
(cons 'print
(cons 'SUBR (lambda (x) (print (car x)))))
(cons 'apply
(cons 'SUBR (lambda (x) (apply% (car x) (cadr% x)))))
(cons 'eval
(cons 'SUBR (lambda (x) (eval% (car x) global-env))))))
(defun caar% (x) (car (car x)))
(defun cadr% (x) (car (cdr x)))
(defun cddr% (x) (cdr (cdr x)))
(defun caddr% (x) (car (cdr (cdr x))))
(defun cdddr% (x) (cdr (cdr (cdr x))))
(defun cadddr% (x) (car (cdr (cdr (cdr x)))))
(defun assq% (key alist) ; cf. Emacs/Nukata Lisp
(if alist
(if (eq key (caar% alist))
(car alist)
(assq% key (cdr alist)))
nil))
(defun pairlis% (keys data alist) ; cf. Common Lisp
(if keys
(cons (cons (car keys) (car data))
(pairlis% (cdr keys) (cdr data) alist))
alist))
;; Define symbol as value in the global environment.
(defun global-def (sym val)
(rplacd global-env
(cons (car global-env)
(cdr global-env)))
(rplaca global-env
(cons sym val)))
(defun eval% (e env)
(if (atom e)
((lambda (var)
(if var
(cdr var)
e))
(assq% e env))
(if (eq (car e) 'quote) ; (quote e)
(cadr% e)
(if (eq (car e) 'if) ; (if e e e)
(if (eval% (cadr% e) env)
(eval% (caddr% e) env)
(eval% (cadddr% e) env))
(if (eq (car e) 'progn) ; (progn e...)
(eval-progn (cdr e) env nil)
(if (eq (car e) 'lambda) ; (lambda (v...) e...)
(make-closure env (cdr e))
(if (eq (car e) 'defun) ; (defun f (v...) e...)
(global-def (cadr% e)
(make-closure env (cddr% e)))
(if (eq (car e) 'setq) ; (setq v e)
((lambda (var value)
(if var
(rplacd var value)
(global-def (cadr% e) value))
value)
(assq% (cadr% e) env)
(eval% (caddr% e) env))
(apply% (eval% (car e) env) ; (f e...)
(evlis (cdr e) env))))))))))
;; (make-closure env '((v...) e...)) => (EXPR env (v...) e...)
(defun make-closure (env ve)
(cons 'EXPR
(cons env ve)))
;; (eval-progn '((+ 1 2) 3 (+ 4 5)) global-env nil) => 9
(defun eval-progn (x env result)
(if x
(if (cdr x)
(eval-progn (cdr x)
env
(eval% (car x) env))
(eval% (car x) env))
result))
;; (evlis '((+ 1 2) 3 (+ 4 5)) global-env) => (3 3 9)
(defun evlis (x env)
(if x
(cons (eval% (car x) env)
(evlis (cdr x) env))
nil))
(defun apply% (fun arg)
(if (eq (car fun) 'EXPR) ; (EXPR env (v...) e...)
(eval-progn (cdddr% fun)
(pairlis% (caddr% fun)
arg
(cadr% fun))
nil)
(if (eq (car fun) 'SUBR) ; (SUBR . f)
(funcall (cdr fun) arg)
fun)))
(defun global-eval (e)
(eval% e global-env))
(global-eval (quote
;; -- WRITE YOUR EXPRESSION HERE --
(progn
(defun fib (n)
(if (< n 2)
1
(+ (fib (- n 1))
(fib (- n 2)))))
(print (fib 10)))
;; --------------------------------
)))
";
try
{
var lispCtx = Lisp.CreateInterpreter();
var sExpressions = Lisp.Parse(lisp);
var x = lispCtx.Eval(sExpressions);
Assert.That((int)x, Is.EqualTo(89));
}
catch (Exception e)
{
Console.WriteLine(e);
throw;
}
}
