Lisp
A Lisp interpreter written in C# 7
This is ported from Nuka Lisp in Dart (https://github.com/nukata/lisp-in-dart) except for bignum. It is named after ex-Nukata Town in Japan.
Assembly: ServiceStack.Common.dll
View Source
Declaration
public static class Lisp
Properties
AllowLoadingRemoteScripts
Allow loading of remote scripts
- https://example.org/lib.l
- gist:{gist-id}
- gist:{gist-id}/file.l
- index:{name}
- index:{name}/file.l
This is ported from Nuka Lisp in Dart (https://github.com/nukata/lisp-in-dart) except for bignum. It is named after ex-Nukata Town in Japan.
View Source
Declaration
public static bool AllowLoadingRemoteScripts { get; set; }
IndexGistId
Gist where to resolve index:{name} references from
This is ported from Nuka Lisp in Dart (https://github.com/nukata/lisp-in-dart) except for bignum. It is named after ex-Nukata Town in Japan.
View Source
Declaration
public static string IndexGistId { get; set; }
Fields
TRUE
The symbol of t
This is ported from Nuka Lisp in Dart (https://github.com/nukata/lisp-in-dart) except for bignum. It is named after ex-Nukata Town in Japan.
View Source
Declaration
public static readonly Lisp.Sym TRUE
BOOL_TRUE
View Source
Declaration
public static readonly Lisp.Sym BOOL_TRUE
BOOL_FALSE
View Source
Declaration
public static readonly Lisp.Sym BOOL_FALSE
InitScript
Lisp initialization script
This is ported from Nuka Lisp in Dart (https://github.com/nukata/lisp-in-dart) except for bignum. It is named after ex-Nukata Town in Japan.
View Source
Declaration
public static string InitScript
Prelude
View Source
Declaration
public const string Prelude = "\r\n(setq defmacro\r\n (macro (name args &rest body)\r\n `(progn (setq ,name (macro ,args ,@body))\r\n ',name)))\r\n\r\n(defmacro defun (name args &rest body)\r\n `(progn (setq ,name (lambda ,args ,@body))\r\n ',name))\r\n\r\n(defun caar (x) (car (car x)))\r\n(defun cadr (x) (car (cdr x)))\r\n(defun cdar (x) (cdr (car x)))\r\n(defun cddr (x) (cdr (cdr x)))\r\n(defun caaar (x) (car (car (car x))))\r\n(defun caadr (x) (car (car (cdr x))))\r\n(defun cadar (x) (car (cdr (car x))))\r\n(defun caddr (x) (car (cdr (cdr x))))\r\n(defun cdaar (x) (cdr (car (car x))))\r\n(defun cdadr (x) (cdr (car (cdr x))))\r\n(defun cddar (x) (cdr (cdr (car x))))\r\n(defun cdddr (x) (cdr (cdr (cdr x))))\r\n;(defun not (x) (eq x nil)) ; replaced with native: null || false\r\n(defun cons? (x) (not (atom x)))\r\n(defun identity (x) x)\r\n\r\n(setq\r\n= eql\r\nnull not\r\nsetcar rplaca\r\nsetcdr rplacd)\r\n\r\n(defun > (x y) (< y x))\r\n(defun >= (x y) (not (< x y)))\r\n(defun <= (x y) (not (< y x)))\r\n(defun /= (x y) (not (= x y)))\r\n(defun not= (x y) (not (= x y)))\r\n\r\n(defun equal (x y)\r\n (cond ((atom x) (eql x y))\r\n ((atom y) nil)\r\n ((equal (car x) (car y)) (equal (cdr x) (cdr y)))))\r\n\r\n(defmacro if (test then &rest else)\r\n `(cond (,test ,then)\r\n ,@(cond (else `((t ,@else))))))\r\n\r\n(defmacro when (test &rest body)\r\n `(cond (,test ,@body)))\r\n\r\n(defmacro let (args &rest body)\r\n ((lambda (vars vals)\r\n (defun vars (x)\r\n (cond (x (cons (if (atom (car x))\r\n (car x)\r\n (caar x))\r\n (vars (cdr x))))))\r\n (defun vals (x)\r\n (cond (x (cons (if (atom (car x))\r\n nil\r\n (cadar x))\r\n (vals (cdr x))))))\r\n `((lambda ,(vars args) ,@body) ,@(vals args)))\r\n nil nil))\r\n\r\n(defmacro letrec (args &rest body) ; (letrec ((v e) ...) body...)\r\n (let (vars setqs)\r\n (defun vars (x)\r\n (cond (x (cons (caar x)\r\n (vars (cdr x))))))\r\n (defun sets (x)\r\n (cond (x (cons `(setq ,(caar x) ,(cadar x))\r\n (sets (cdr x))))))\r\n `(let ,(vars args) ,@(sets args) ,@body)))\r\n\r\n(defun _append (x y)\r\n (if (null x)\r\n y\r\n (cons (car x) (_append (cdr x) y))))\r\n(defmacro append (x &rest y)\r\n (if (null y)\r\n x\r\n `(_append ,x (append ,@y))))\r\n\r\n(defmacro and (x &rest y)\r\n (if (null y)\r\n x\r\n `(cond (,x (and ,@y)))))\r\n\r\n(defun mapcar (f x)\r\n (and x (cons (f (car x)) (mapcar f (cdr x)))))\r\n\r\n(defmacro or (x &rest y)\r\n (if (null y)\r\n x\r\n `(cond (,x)\r\n ((or ,@y)))))\r\n\r\n(defun listp (x)\r\n (or (null x) (cons? x))) ; NB (list? (lambda (x) (+ x 1))) => nil\r\n\r\n(defun memq (key x)\r\n (cond ((null x) nil)\r\n ((eq key (car x)) x)\r\n (t (memq key (cdr x)))))\r\n\r\n(defun member (key x)\r\n (cond ((null x) nil)\r\n ((equal key (car x)) x)\r\n (t (member key (cdr x)))))\r\n\r\n(defun assq (key alist)\r\n (cond (alist (let ((e (car alist)))\r\n (if (and (cons? e) (eq key (car e)))\r\n e\r\n (assq key (cdr alist)))))))\r\n\r\n(defun assoc (key alist)\r\n (cond (alist (let ((e (car alist)))\r\n (if (and (cons? e) (equal key (car e)))\r\n e\r\n (assoc key (cdr alist)))))))\r\n\r\n(defun _nreverse (x prev)\r\n (let ((next (cdr x)))\r\n (setcdr x prev)\r\n (if (null next)\r\n x\r\n (_nreverse next x))))\r\n(defun nreverse (L) ; (nreverse '(a b c d)) => (d c b a)\r\n (cond (L (_nreverse L nil))))\r\n\r\n(defun last (L)\r\n (if (atom (cdr L))\r\n L\r\n (last (cdr L))))\r\n\r\n(defun nconc (&rest lists)\r\n (if (null (cdr lists))\r\n (car lists)\r\n (if (null (car lists))\r\n (apply nconc (cdr lists))\r\n (setcdr (last (car lists))\r\n (apply nconc (cdr lists)))\r\n (car lists))))\r\n\r\n(defmacro while (test &rest body)\r\n (let ((loop (gensym)))\r\n `(letrec ((,loop (lambda () (cond (,test ,@body (,loop))))))\r\n (,loop))))\r\n\r\n(defmacro dolist (spec &rest body) ; (dolist (name list [result]) body...)\r\n (let ((name (car spec))\r\n (list (gensym)))\r\n `(let (,name\r\n (,list ,(cadr spec)))\r\n (while ,list\r\n (setq ,name (car ,list))\r\n ,@body\r\n (setq ,list (cdr ,list)))\r\n ,@(if (cddr spec)\r\n `((setq ,name nil)\r\n ,(caddr spec))))))\r\n\r\n(defmacro dotimes (spec &rest body) ; (dotimes (name count [result]) body...)\r\n (let ((name (car spec))\r\n (count (gensym)))\r\n `(let ((,name 0)\r\n (,count ,(cadr spec)))\r\n (while (< ,name ,count)\r\n ,@body\r\n (setq ,name (+ ,name 1)))\r\n ,@(if (cddr spec)\r\n `(,(caddr spec))))))\r\n "
LispCore
Lisp Common Utils
This is ported from Nuka Lisp in Dart (https://github.com/nukata/lisp-in-dart) except for bignum. It is named after ex-Nukata Town in Japan.
View Source
Declaration
public const string LispCore = "\r\n(defmacro def (k v) \r\n (list 'progn (list 'setq k v) nil ))\r\n\r\n(defmacro incf (elem &rest num)\r\n (cond\r\n ((not num) \r\n `(setq ,elem (+ 1 ,elem)) )\r\n (t `(setq ,elem (+ ,@num ,elem))) ))\r\n\r\n(defmacro decf (elem &rest num)\r\n (cond\r\n ((not num) \r\n `(setq ,elem (- ,elem 1)) )\r\n (t `(setq ,elem (- ,elem ,@num))) ))\r\n\r\n(defun 1+ (n) (+ n 1))\r\n(defun 1- (n) (- n 1))\r\n\r\n(defun mapcan (f L)\r\n (apply nconc (mapcar f L)))\r\n\r\n(defun mapc (f L)\r\n (mapcar f L) L)\r\n\r\n(defmacro when (condition &rest body)\r\n `(if ,condition (progn ,@body)))\r\n(defmacro unless (condition &rest body)\r\n `(if (not ,condition) (progn ,@body)))\r\n\r\n(defmacro push-end (e L) ; JS [].push\r\n `(setq ,L (append ,L (list ,e))) )\r\n(defmacro push (e L) ; JS [].unshift\r\n `(setq ,L (cons ,e ,L)))\r\n(defmacro pop (L) ; JS [].shift\r\n `(let ( (v (first ,L)) )\r\n (setq ,L (rest ,L)) \r\n v))\r\n\r\n(defun nthcdr (n L)\r\n (if (zero? n)\r\n L\r\n (nthcdr (- n 1) (cdr L))))\r\n\r\n(defun butlast (L)\r\n (reverse (nthcdr 1 (reverse L))))\r\n(defun nbutlast (L)\r\n (nreverse (nthcdr 1 (nreverse L))))\r\n\r\n(defun remove-if (f L)\r\n (mapcan (fn (e) (if (f e) (list e) nil)) L) )\r\n\r\n(defun some (f L)\r\n (let ((to nil))\r\n (while (and L (not (setq to (f (pop L))))))\r\n to))\r\n\r\n(defun every (f L)\r\n (let ((to nil))\r\n (while (and L (setq to (f (pop L)))))\r\n to))\r\n\r\n(defun reverse (L)\r\n (let ((to '()))\r\n (doseq (e L to)\r\n (push e to))\r\n to))\r\n\r\n(defun elt (L n)\r\n (if (>= n (length L)) (error \"index out of range\"))\r\n (let ((l L))\r\n (dotimes (i n)\r\n (setq l (rest l))\r\n )\r\n (first l)))\r\n\r\n(defun range (&rest args)\r\n (let ( (to '()) )\r\n (cond \r\n ((= (length args) 1) (dotimes (i (car args))\r\n (push i to)))\r\n ((= (length args) 2) (dotimes (i (- (cadr args) (car args)))\r\n (push (+ i (car args)) to))))\r\n (nreverse to)))\r\n\r\n(defun set-difference (L1 L2)\r\n (if L2\r\n (let ((res nil))\r\n (doseq (e L1)\r\n (unless (member e L2)\r\n (push e res)))\r\n res)\r\n L1))\r\n\r\n(defun union (L1 L2)\r\n (if L2\r\n (let ((res nil))\r\n (doseq (e L1)\r\n (unless (member e res)\r\n (push e res)))\r\n (doseq (e L2)\r\n (unless (member e res)\r\n (push e res)))\r\n res)\r\n L1))\r\n"
Extensions
Popular Clojure + nicer UX Utils
This is ported from Nuka Lisp in Dart (https://github.com/nukata/lisp-in-dart) except for bignum. It is named after ex-Nukata Town in Japan.
View Source
Declaration
public const string Extensions = "\r\n\r\n(defmacro defn (name args &rest body)\r\n `(progn (setq ,name (lambda ,args ,@body))\r\n ',name))\r\n\r\n(defmacro doseq (spec &rest body) ; (doseq (name seq [result]) body...)\r\n (let ( (name (first spec)) \r\n (seq (second spec)) \r\n (enum (gensym)) )\r\n `(let ( (,name) (,enum (enumerator ,seq)) )\r\n (while (enumeratorNext ,enum)\r\n (setq ,name (enumeratorCurrent ,enum))\r\n ,@body)\r\n (dispose ,enum)\r\n )))\r\n\r\n(defmacro doseq-while (spec f &rest body) ; (doseq (name seq [result]) body...)\r\n (let ( (name (first spec)) \r\n (seq (second spec)) \r\n (enum (gensym)) )\r\n `(let ( (,name) (,enum (enumerator ,seq)) )\r\n (while (and (enumeratorNext ,enum) (,f (enumeratorCurrent ,enum)))\r\n (setq ,name (enumeratorCurrent ,enum))\r\n ,@body)\r\n (dispose ,enum)\r\n )))\r\n\r\n(defmacro f++ (elem)\r\n `(1- (setq ,elem (+ 1 ,elem))))\r\n\r\n(defun zip (f L1 L2)\r\n (let ( (to) ) \r\n (doseq (a L1) \r\n (doseq (b L2)\r\n (push (f a b) to)))\r\n (nreverse to)\r\n ))\r\n\r\n(defun zip-where (fpred fmap L1 L2)\r\n (let ( (to) ) \r\n (doseq (a L1) \r\n (doseq (b L2)\r\n (if (fpred a b) \r\n (push (fmap a b) to)) ))\r\n (nreverse to)\r\n ))\r\n\r\n(defun skip-while (f L)\r\n (let ( (to) (go) ) \r\n (doseq (e L)\r\n (if (not (f e)) (setq go t)) \r\n (if go (push e to))\r\n )\r\n (nreverse to)\r\n ))\r\n\r\n(defun take-while (f L)\r\n (let ( (to) ) \r\n (doseq-while (e L) #(f %)\r\n (push e to))\r\n (nreverse to)\r\n ))\r\n\r\n(defun assoc-key (k L) (first (assoc k L)))\r\n(defun assoc-value (k L) (second (assoc k L)))\r\n\r\n(defn even? [n] (= (% n 2) 0))\r\n(defn odd? [n] (= (% n 2) 1))\r\n(defn empty? [x] (not (and x (seq? x) (> (count x) 0) )))\r\n\r\n(defun flatmap (f L)\r\n (flatten (map f L)))\r\n\r\n(defun map-index (f L)\r\n (let ( (i -1) )\r\n (map (fn [x] (f x (incf i) )) L) ))\r\n\r\n(defun filter-index (f L)\r\n (let ( (i -1) )\r\n (filter (fn [x] (f x (incf i) )) L) ))\r\n\r\n(defun where-index (f L)\r\n (let ( (i -1) )\r\n (where (fn [x] (f x (incf i) )) L) ))\r\n\r\n(defn globln [a L] (/joinln (glob a L)))\r\n\r\n(setq\r\n 1st first\r\n 2nd second\r\n 3rd third\r\n next rest\r\n inc 1+\r\n dec 1-\r\n it identity\r\n atom? atom\r\n cons? consp\r\n list? listp\r\n end? endp\r\n zero? zerop\r\n every? every\r\n some? some\r\n all? every\r\n any? some\r\n prs printlns\r\n lower-case string-downcase \r\n upper-case string-upcase\r\n\r\n ; clojure\r\n defn defun\r\n filter remove-if\r\n)\r\n"
Methods
Reset()
Reset Global Symbols back to default
View Source
Declaration
public static void Reset()
Import(String)
Load Lisp into Global Symbols, a new CreateInterpreter() starts with a copy of global symbols
View Source
Declaration
public static void Import(string lisp)
Parameters
| Type | Name |
|---|---|
System.String | lisp |
Import(ReadOnlyMemory<Char>)
Load Lisp into Global Symbols, a new CreateInterpreter() starts with a copy of global symbols
View Source
Declaration
public static void Import(ReadOnlyMemory<char> lisp)
Parameters
| Type | Name |
|---|---|
ReadOnlyMemory<System.Char> | lisp |
Set(String, Object)
View Source
Declaration
public static void Set(string symbolName, object value)
Parameters
| Type | Name |
|---|---|
System.String | symbolName |
System.Object | value |
Init()
View Source
Declaration
public static void Init()
CreateInterpreter()
Create a Lisp interpreter initialized pre-configured with Global Symbols.
View Source
Declaration
public static Lisp.Interpreter CreateInterpreter()
Returns
ServiceStack.Script.Lisp.Interpreter
ToCons(IEnumerable)
View Source
Declaration
public static Lisp.Cell ToCons(IEnumerable seq)
Returns
Parameters
| Type | Name |
|---|---|
System.Collections.IEnumerable | seq |
QqExpand(Object)
Expand x of any quqsi-quotation `x into
the equivalent S-expression.
View Source
Declaration
public static object QqExpand(object x)
Returns
System.Object
Parameters
| Type | Name |
|---|---|
System.Object | x |
QqQuote(Object)
Quote x so that the result evaluates to x.
View Source
Declaration
public static object QqQuote(object x)
Returns
System.Object
Parameters
| Type | Name |
|---|---|
System.Object | x |
Parse(String)
Returns List of SExpression's
View Source
Declaration
public static List<object> Parse(string lisp)
Returns
System.Collections.Generic.List<System.Object>
Parameters
| Type | Name |
|---|---|
System.String | lisp |
Parse(ReadOnlyMemory<Char>)
Returns List of SExpression's
View Source
Declaration
public static List<object> Parse(ReadOnlyMemory<char> lisp)
Returns
System.Collections.Generic.List<System.Object>
Parameters
| Type | Name |
|---|---|
ReadOnlyMemory<System.Char> | lisp |
Str(Object, Boolean)
Make a string representation of Lisp expression.
View Source
Declaration
public static string Str(object x, bool quoteString = true)
Returns
System.String
Parameters
| Type | Name | Description |
|---|---|---|
System.Object | x | Lisp expression |
|
| System.Boolean | quoteString | flag whether to quote string
|
RunRepl(ScriptContext)
Run Read-Eval-Print Loop. This never ends, use Ctrl+C to Exit. Exceptions are handled here and not thrown.
View Source
Declaration
public static void RunRepl(ScriptContext context)
Parameters
| Type | Name |
|---|---|
| ServiceStack.Script.ScriptContext | context |