1. Richard Emslie
  2. xlispx

Commits

richard  committed 1e77a51

copy project over to public repo

  • Participants
  • Branches default

Comments (0)

Files changed (49)

File readme.txt

View file
  • Ignore whitespace
+:blog: What is xlispx?
+:date: June 7th 2013
+
+So buyer beware: I don't know lisp very well.
+
+Right now it is just a tiny lisp like language, basically of what I have learned thus far.  I managed to get an
+interpeter running code from reading first few chapters of "Little Schemer", in a day - which I found amazing.  So with
+that I decided to keep going, to see what more I could learn.  There isn't a destination, just a project for me to hack
+on when I have some free time.
+
+If you look, please be nice, I am probably doing some really stupid things.

File src/Makefile

View file
  • Ignore whitespace
+# these are here so don't forget how to run rpython, or tests, or require docs.
+
+all: compile
+
+repl:
+	python main.py
+
+compile:
+	rpython --opt=3 main.py
+
+tests:
+	py.test test
+
+testc:
+	./main-c -t test/conditionals.xlx test/ls_chp2.xlx test/ls_chp4.xlx test/ls_chp5.xlx test/ls_chp6.xlx test/funcs.xlx test/simple.xlx test/closure.xlx test/ls_chp7.xlx test/setbang.xlx test/macro.xlx
+
+benchmarks:
+	pypy main.py - -t benchmark/fib_pure.xlx
+	./main-c -t benchmark/fib_rpython.xlx

File src/baseimport.py

View file
  • Ignore whitespace
+
+__all__ = "isspace lstrip rstrip strip".split()
+
+import os, sys
+try:
+    import pytest
+except:
+    dr = os.path.dirname
+    path = os.path.join(dr(os.path.realpath(__file__)), 'pypy')
+    print "inserting path", path
+    sys.path.insert(0, path)
+
+    from rpython.rlib.rbigint import rbigint
+
+# some utils
+
+def isspace(c):
+    return c in (' ', '\t', '\n', '\r', '\f', '\v')
+
+def lstrip(input):
+    count = 0
+    while count < len(input) and isspace(input[count]):
+        count += 1
+
+    return input[count:]
+
+def rstrip(input):
+    count = len(input) - 1
+    while count >= 0 and isspace(input[count]):
+        count -=1
+
+    index = count + 1
+    assert index >= 0
+    return input[:index]
+
+def strip(input):
+    return rstrip(lstrip(input))
+
+# XXX this probably needs specialized decorator (it is very cool though we can do this in rpython)
+def izip(gen1, gen2):
+    while True:
+        yield gen1.next(), gen2.next()

File src/benchmark/fib.clj

View file
  • Ignore whitespace
+(defn fib1 [n]
+  (if (<= n 1)
+    1
+    (+ (fib1 (dec n)) (fib1 (- n 2)))))
+
+(time (fib1 35))

File src/benchmark/fib.py

View file
  • Ignore whitespace
+def lessthan(m, n):
+    return m <= n
+
+def subtract(m, n):
+    return m - n
+
+def add(m, n):
+    return m + n
+
+def fib(n):
+    t0 = lessthan(n, 1)
+    if t0:
+        return 1
+
+    else:
+        t1 = subtract(n, 1)
+        t2 = fib(t1)
+        t3 = subtract(n, 2)
+        t4 = fib(t3)
+        t5 = add(t2, t4)
+        return t5
+
+def fib2(n):
+    if n <= 1:
+        return 1
+    else:
+        return fib2(n - 1) + fib2(n - 2)
+
+if __name__ == "__main__":
+    #assert fib(32) == 3524578
+    assert fib2(32) == 3524578

File src/benchmark/fib_pure.xlx

View file
  • Ignore whitespace
+(define fib
+  (lambda (n)
+          (cond
+           ((<= n 1) 1)
+           (:else (+ (fib (- n 1)) (fib (- n 2)))))))
+> fib
+
+(define fib
+  (aeval fib))
+> fib
+
+(time (fib 18))
+> 4181
+
+(time (fib 18))
+> 4181
+
+(time (fib 32))
+> 3524578
+
+(time (fib 32))
+> 3524578
+
+

File src/benchmark/fib_rpython.xlx

View file
  • Ignore whitespace
+
+; This is a test for rpython only.
+
+(define fib1
+  (lambda (n)
+          (cond
+           ((.ltequal n 1) 1)
+           (:else (.add (fib1 (.subtract n 1)) (fib1 (.subtract n 2)))))))
+> fib1
+
+(define fib2
+  (lambda (n)
+          (cond
+           ((<= n 1) 1)
+           (:else (+ (fib2 (- n 1)) (fib2 (- n 2)))))))
+
+> fib2
+
+; and finally we run fib!
+
+; only primitives
+(time (fib1 32))
+> 3524578
+
+; silly function indirection
+(time (fib2 32))
+> 3524578
+
+; this one is built in, compiled into rpython.  Super fast.
+(time (rfib1 35))
+> 14930352
+
+(time (rfib1 35))
+> 14930352
+
+(time (rfib1 35))
+> 14930352
+
+(time (rfib2 35))
+> 14930352
+
+(time (rfib2 35))
+> 14930352
+
+(time (rfib2 35))
+> 14930352
+
+

File src/conftest.py

View file
  • Ignore whitespace
+import os, sys
+dr = os.path.dirname
+path = os.path.join(dr(os.path.realpath(__file__)))
+sys.path.insert(0, path)
+
+# how do we skip pypy path? XXX

File src/examples/arity.clj

View file
  • Ignore whitespace
+(defmacro dumb [] '(do (println "hello") 42))
+(defmacro repeat3 [f] `(do (~f ~f ~f)))
+
+(defn list2 ([arg1 & args] (do (println arg1) (println args))))
+
+(defn list3
+  ([arg1] (do (println arg1)))
+  ([arg1 arg2] (do (println arg1 arg2)))
+  ([arg1 arg2 & args] (do (println args) (list3 arg1 arg2))))
+
+(defn list4 ([& args] (println args)))
+
+(defn dodumb [] (dumb))
+
+

File src/examples/atomclosure.clj

View file
  • Ignore whitespace
+(defn make_clojure []
+  (let
+      [x (atom 1)
+       f (fn [y] (swap! x + y))]
+    f))
+
+(defn make_clojure []
+  (letcc
+      [x (atom 1)
+       f (fn [y] (swap! x + y))]
+    f))
+
+((fn [] (do
+         (println "evaled")
+         1)))
+
+(defmacro make_clojured []

File src/examples/closure.clj

View file
  • Ignore whitespace
+(def super_closure1
+  (fn [x] (
+           fn [y] (
+                   fn [] (+ x y)))))
+
+> super_closure1
+
+(((super_closure1 23) 19))
+
+> 42
+
+(((super_closure1 1) 3))
+
+> 4
+
+; super_closure2 - still simple, no shadowing
+(def super_closure2
+  (fn [x] (
+           fn [y] (
+                   fn [z] (* z (+ x y))))))
+> super_closure2
+
+; x = 3 y = 5
+(def secondx ((super_closure2 3) 5))
+> second
+
+(secondx 10)
+> 80
+
+; super_closure3 - simple, shadows x symbol later
+
+(def super_closure3
+  (fn [x] (
+           fn [y] (
+                   fn [x] (+ x y)))))
+> super_closure3
+
+; x = 100 y = 5
+(((super_closure3 100) 21) 21)
+> 42
+
+; super_closure4 - simple, shadows x differently
+(def super_closure4
+  (fn [x] (
+           fn [x] (
+                   fn [] (+ x x)))))
+>super_closure4
+
+(((super_closure4 10) 32))
+> 64

File src/examples/macro.xlx

View file
  • Ignore whitespace
+(defmacrox double_add (form) (list '+ form form))
+> double_add
+
+(double_add (+ 1 1))
+> 4
+
+(define f 42.0)
+> f
+
+(double_add (- (+ f 1) (+ f -1)))
+> 4
+
+(define = (lambda (x y) (.equal x y)))
+
+(defmacrox if (pred dothis elsethis) (list 'cond (list pred dothis) (list ':else elsethis)))
+
+;(defmacro if [pred dothis elsethis] (list 'cond (list pred dothis) (list ':else elsethis)))
+(defmacro ifx [pred dothis elsethis] `(cond (~pred ~dothis) (:else ~elsethis)))
+

File src/examples/scratch.xlx

View file
  • Ignore whitespace
+
+(defmacro f [z] (list 'do '(prn 1 2 3 z) z))
+
+(define f (z) (do (prn '(1 2 3 z)) 42))
+
+(defn f [z] (prn '(1 2 3 z)) 42)
+(f 23)
+
+(defmacrox f (z) (list 'do '(prn 1 2 3 z) z))
+(macroexpand f)
+
+(defn lat? [l]
+  (cond (empty? l) true
+        ((atom? (first l)) (recur (rest l)))
+        :else false))
+
+(define lat?
+  (lambda (l)
+          (cond
+           ((null? l) true)
+           ((atom? (car l)) (lat? (cdr l)))
+           (:else false))))

File src/main.py

View file
  • Ignore whitespace
+'''
+
+seq interfaces (seq? -> empty, first, nth, rest)
+int -> false
+0 -> 
+* rethink truthiness.  Frankly I think python got it right.  (empty, 0, false, nil)
+
+* just wrap function inside SimpleMacro, instead of storing contents (but not there is no evaluation)
+* use a symbol for arity functions
+* use pypackrat for reader.  Maybe we want two readers (one for xlispx, one for clojure like syntax).
+
+new idea
+---------
+* one of the cool things we get with lisp in general is freedom to turn data for code into anyother data for code.  In
+  that way we create entirely new evaluation context's that do things differently.
+
+  Some two things that are really high on the todo list are implementing a bytecode like interpreter, and tail
+  recursoin.  I feel continuations will fall out of this.  This pretty much gives a scheme like implementation of lisp.
+
+  So we have abstract evaluation, the concept of taking our code and reforming into blocks.  This is good.  However : why go the extra distance of creating a bytecode interpreter where we could just create new data structures, that are evaluated differently.
+
+  Thoughts in general:
+    * we have a stack of frames
+    * we don't evaluate a list of things and them populate our stack and then call a function.  We do inside out.
+       * Oh i don't know.  Lets just try and implement something.  If i think too hard the whole thing can be done without abstraction evaluation.
+ 
+
+
+
+Open issues
+-----------
+* Should not go any further doing code transforms if inside a lambda?
+
+scheme todo
+-----------
+* bytecode and tail recursion
+
+* pair
+* quasi-quote
+
+later1
+------
+* multi-functions
+* better macros (arity/polymorphic)
+* cond, and, or -> if/else and macros
+
+* replace all asserts with exceptions or nil?  Make compiliation stage robust
+
+
+later2
+-----
+* core to use seq/first/rest with interface abstraction, instead of car/cdr
+
+* add Environment and namespaces proper
+* split evaluation context, create genlets, or full blown continuatutions
+
+* build more types (at least vector / string / map)
+
+'''
+
+import posix
+
+import baseimport
+
+from xlispx.error import ReaderException, EvalException, CompileException
+from xlispx.reader import reader
+from xlispx.core import create_evaluation_context
+
+###############################################################################
+# rpython entry point
+
+def target(*args):
+    return entry_point, None
+
+def jitpolicy(driver):
+    from rpython.jit.codewriter.policy import JitPolicy
+    return JitPolicy()
+
+def entry_point(args):
+    from xlispx.runfile import run_file
+    ec = create_evaluation_context()
+
+    if len(args) == 1:
+        print "no input"
+        return 0
+
+    if len(args) >= 3 and args[1] == '-t':
+        filenames = args[2:]
+        for filename in filenames:
+            res = run_file(filename)
+            if res != 0:
+                return res
+        # all passed
+        return 0
+
+    eval_string = "".join(args[1:])
+
+    try:
+        sexpr = reader(eval_string)
+
+    except ReaderException, exc:
+        print "Reader Exception for '%s':" % eval_string
+        print exc.msg
+        return 1
+
+    try:
+        res = ec.eval(sexpr)
+        print res.repr()
+
+    except CompileException, exc:
+        print "error in compiling %s: %s" % (sexpr.repr(), exc.msg)
+        return 2
+
+    except EvalException, exc:
+        print "error in %s: %s" % (sexpr.repr(), exc.msg)
+        return 3
+
+    return 0
+
+###############################################################################
+
+def repl():
+    " NOT RPYTHON "
+    ec = create_evaluation_context()
+    import readline
+
+    try:
+        while True:
+            print "=>",
+            eval_string = raw_input()
+            try:
+                sexpr = reader(eval_string)
+                if sexpr is None:
+                    print ""
+                    continue
+
+                from xlispx.codetransforms import bind_symbols
+                expr = bind_symbols(ec, sexpr, [], {})
+                print expr.repr()
+                res = ec.eval(expr)
+                print res.repr()
+
+                ec.get_namespace().set("_", res)
+
+            except ReaderException, exc:
+                print "Reader Exception for '%s':" % eval_string
+                print exc.msg
+
+            except CompileException, exc:
+                print "error in compiling %s: %s" % (sexpr.repr(), exc.msg)
+
+            except EvalException, exc:
+                print "error in %s: %s" % (sexpr.repr(), exc.msg)
+
+    except EOFError:
+        print "Byeeeeeeeeee!"
+
+if __name__ == '__main__':
+    import sys
+    if len(sys.argv) > 1 and sys.argv[1] == '-':
+        args = ['fake-xlispx-c'] + sys.argv[2:]
+        entry_point(args)
+    else:
+        repl()

File src/pypy

View file
  • Ignore whitespace
+/home/rxe/files/project/3rdparty/pypy-2.0.2-src

File src/test/abstract.xlx

View file
  • Ignore whitespace
+(define bla_stuff
+  (lambda (x y z)
+    (.subtract (.add x y) (.add x z))))
+> bla_stuff
+
+
+(define bla_stuff
+  (aeval bla_stuff))
+> bla_stuff
+
+(bla_stuff 0 2 3)
+> -1
+
+(bla_stuff 100 2 3)
+> -1
+
+
+(bla_stuff 100 43 1)
+> 42
+
+
+; same as last, but we call normal function with lookup
+(define bla_stuff2
+  (lambda (x y z)
+    (- (+ x y) (+ x z))))
+> bla_stuff2
+
+(define bla_stuff2
+  (aeval bla_stuff2))
+> bla_stuff2
+
+
+(bla_stuff2 0 2 3)
+> -1
+
+(bla_stuff2 100 2 3)
+> -1
+
+(bla_stuff2 100 43 1)
+> 42
+
+(define fib
+  (lambda (n)
+          (cond
+           ((<= n 1) 1)
+           (:else (+ (fib (- n 1)) (fib (- n 2)))))))
+> fib
+
+; Non-compiled version
+(time (fib 18))
+> 4181
+
+; Compiled low level ops, how fast are we now?  Did we change?
+
+(time (fib 18))
+> 4181
+
+; Compiled fib itself
+
+(define fib
+  (aeval fib))
+> fib
+
+(time (fib 18))
+> 4181

File src/test/abstract2.xlx

View file
  • Ignore whitespace
+; since this broke when we tried it... testing here
+
+(define not (pred)
+ (cond
+  (pred false)
+  (:else true)))
+> not
+
+(define not
+  (aeval not))
+> not
+
+(not nil)
+> true
+
+; define map
+
+(define map
+  (lambda (f l)
+          (cond
+           ((null? l) l)
+           (:else (cons (f (car l)) (map f (cdr l)))))))
+
+> map
+
+(define map
+  (aeval map))
+> map
+
+; a simple inc3 for xxx
+(define inc2
+  (lambda (n)
+          (+ n 2)))
+> inc2
+
+(define inc2
+  (aeval inc2))
+> inc2
+
+(define inc3
+  (lambda (n)
+          (+ n 2)))
+> inc3
+
+(define inc3
+  (aeval inc3))
+> inc3
+
+(map inc2 '(1 2 3 4 5))
+> (3 4 5 6 7)
+
+;; runtime exception
+(map inc3 '(1 2 3 4 5))
+> (3 4 5 6 7)
+
+; This will break... create incrementor - this is a closure
+(define incrementor
+  (lambda (n1 n2)
+          (lambda (x) (+ x (+ n1 n2)))))
+> incrementor
+
+; goal?
+;(define incrementor
+;  (aeval incrementor))
+;> incrementor
+
+(define fib1
+  (lambda (n)
+          (cond
+           ((.ltequal n 1) 1)
+           (:else (.add (fib1 (.subtract n 1)) (fib1 (.subtract n 2)))))))
+> fib1
+
+(define fib1
+  (aeval fib1))
+> fib1
+
+; and finally we run fib!
+
+(time (fib1 32))
+> 3524578
+
+(time (fib1 32))
+> 3524578

File src/test/abstract_more.xlx

View file
  • Ignore whitespace
+(list 1 2 3 4)
+> (1 2 3 4)
+
+(define (r a b c d) (list d c b a))
+> r
+
+(prn r)
+> nil
+
+; first attmept
+(r 1 2 3 4)
+> (4 3 2 1)
+
+(define r
+  (aeval r))
+> r
+
+; second attmept
+(r 1 2 3 4)
+> (4 3 2 1)
+
+; now apply, we create another function to apply r
+(define (ar s)
+  (apply r s))
+> ar
+
+(ar '(1 2 3 4))
+> (4 3 2 1)
+
+; now compile that and see worlds explode
+
+(define ar
+  (aeval ar))
+> ar
+
+(prn ar)
+> nil
+
+(ar '(20 19 18 17))
+> (17 18 19 20)
+
+; bunch of side effects
+(define (stuffs)
+  (begin
+    (prn "HERE")
+    (prn 1 2 3 4)
+    (prn (r 1 2 3 4))
+    42))
+> stuffs
+
+(stuffs)
+> 42
+
+; now compile that and see worlds explode
+
+(define stuffs
+  (aeval stuffs))
+> stuffs
+
+
+(stuffs)
+> 42
+
+(define (stuffs2)
+  (begin
+    (prn '"HERE")
+    (prn '1)
+    (prn '(r 1 2 3 4))
+    (+ 21 21)))
+> stuffs2
+
+(stuffs2)
+> 42
+
+
+; now compile that and see worlds explode.  quote is a special form, yet we don't handle special forms differently from primitives.
+
+
+(define stuffs2
+  (aeval stuffs2))
+> stuffs2
+
+(stuffs2)
+> 42

File src/test/aeval_tricky.xlx

View file
  • Ignore whitespace
+(prn "hello")
+> nil
+
+(define y 74)
+> y
+
+(define t (lambda (x) (cond (true x) (:else y))))
+> t
+
+(define t
+  (aeval t))
+> t
+
+(t 23)
+> 23
+
+(define t2 (lambda (x) x))
+> t2
+
+(define t3 (lambda () y))
+> t3
+
+(define t2
+  (aeval t2))
+> t2
+
+(define t3
+  (aeval t3))
+> t3
+
+((lambda () (- (t3) (t2 32))))
+> 42
+
+((aeval (lambda (quote cond) (quote cond))) list 1)
+> (1)
+
+((aeval (lambda () nil)))
+> nil
+
+; note x does not exist, which doesn't really matter since we are never going to return it.  Hence we create an empty binding.  This is fine, and means rebinding can be removed.
+((aeval (lambda () (cond (false x) (:else nil)))))
+> nil
+
+(define z (aeval (lambda () (cond (true x) (:else nil)))))
+> z
+
+(define x 42)
+> x
+
+(z)
+> 42
+
+
+(define (testcond? v)
+  (cond
+   (v true)
+   (:else false)))
+> testcond?
+
+(define testcond?
+  (aeval testcond?))
+> testcond?
+
+(testcond? 123)
+> false
+

File src/test/better_functions.xlx

View file
  • Ignore whitespace
+(define (add_all & r)
+  (begin
+    (cond
+     ((null? r) 0)
+     (:else (+ (car r) (apply add_all (cdr r)))))))
+
+> add_all
+
+(prn add_all)
+> nil
+
+(add_all 1 2 3 4 5)
+> 15

File src/test/closure.clj

View file
  • Ignore whitespace
+(defn ++ [x y]
+  (+ x y))
+
+(defn incrementor [n1 n2]
+  (fn [x] (+ x (+ n1 n2))))
+
+(def incx1 (incrementor 1 0))
+(def incx2 (incrementor 1 5))
+
+(defn mapx [f l]
+  (if (= l ()) l (cons (f (first l)) (map f (rest l)))))
+
+(mapx incx1 '(1 2 3 4 5))
+(mapx incx2 '(1 2 3 4 5))
+
+(defn super_closure1 [x]
+  (fn [x]
+    (fn [y] (+ x y))))
+
+(defn super_closure2 [x]
+  (fn [x]
+    (fn [x] (+ x x))))
+
+(((super_closure1 1) 2))
+(((super_closure2 1) 2))

File src/test/closure.xlx

View file
  • Ignore whitespace
+(define +
+  (lambda (x y)
+          (.add x y)))
+
+> +
+
+; create incrementor - this is a closure
+(define incrementor
+  (lambda (n1 n2)
+          (lambda (x) (+ x (+ n1 n2)))))
+> incrementor
+
+; incrementor -> creates inc
+(define inc (incrementor 1 0))
+> inc
+
+; test inc
+(inc 22)
+
+> 23
+
+; incrementor -> recreates inc
+
+(define inc2 (incrementor 1 1))
+> inc2
+
+; test
+(inc2 22)
+> 24
+
+; define map
+(define map
+  (lambda (f l)
+          (cond
+           ((null? l) l)
+           (:else (cons (f (car l)) (map f (cdr l)))))))
+> map
+
+; a simple inc3 for xxx
+(define inc3
+  (lambda (n)
+          (+ n 2)))
+> inc3
+
+(map (incrementor 5 5) '(1 2 3 4 5))
+> (11 12 13 14 15)
+
+
+; super_closure were written to show issues in forming closures over more than on lambda in a function.
+
+; super_closure - simple, no shadowing
+
+(define super_closure1
+  (lambda (x) (
+               lambda (y) (
+                           lambda () (+ x y)))))
+
+> super_closure1
+
+(((super_closure1 23) 19))
+
+> 42
+
+(((super_closure1 1) 3))
+
+> 4
+
+; super_closure2 - still simple, no shadowing
+
+(define super_closure2
+  (lambda (x) (
+               lambda (y) (
+                           lambda (z) (* z (+ x y))))))
+> super_closure2
+
+; x = 3 y = 5
+(define second ((super_closure2 3) 5))
+> second
+
+(second 10)
+> 80
+
+; super_closure3 - simple, shadows x symbol later
+
+(define super_closure3
+  (lambda (x) (
+               lambda (y) (
+                           lambda (x) (+ x y)))))
+> super_closure3
+
+; x = 100 y = 5
+(((super_closure3 100) 21) 21)
+> 42
+
+; super_closure4 - simple, shadows x differently
+(define super_closure4
+  (lambda (x) (
+               lambda (x) (
+                           lambda () (+ x x)))))
+>super_closure4
+
+(((super_closure4 10) 32))
+> 64

File src/test/conditionals.xlx

View file
  • Ignore whitespace
+; or t,t -> t
+(or true true)
+> true
+
+; or t,f -> t
+(or true false)
+> true
+
+; or f,t -> t
+(or false true)
+> true
+
+; or f,f -> f
+(or false false)
+> false
+
+
+; and t,t -> t
+(and true true)
+> true
+
+; and f,t -> f
+(and true false)
+> false
+
+; and t,f -> f
+(and false true)
+> false
+
+; and f,f -> f
+(and false false)
+> false
+
+; not true
+(not true)
+> false
+
+; not f -> t
+(not false)
+> true
+
+; what happens when a condtional is not a boolean value
+(define (testcond? v)
+  (cond
+   (v true)
+   (:else false)))
+> testcond?
+
+(testcond? 123)
+> false
+
+; requires macros to work
+(defmacro if (cond then_part else_part) (list 'cond (list cond then_part) (list ':else else_part)))
+> if
+
+(define x 22)
+> x
+
+(if (= x 20) 'true 'false)
+> false
+
+(if (= x 20) 'true (define x 20))
+> x
+
+(if (= x 20) (begin (define x 0) 'nice) (prn x))
+> nice
+
+(if (= x 0) (set! x 12) (define x 0))
+> x
+
+x
+> 12
+; this macro reuses another macro
+(defmacro and2 (l r) (list 'if l (list 'if r 'true 'false) 'false))
+> and2
+
+(define (afn x y)
+  (and2 (= x 0) (= y 0)))
+> afn
+
+(afn 1 0)
+> false
+
+(afn 0 1)
+> false
+
+(afn 0 0)
+> true
+
+(define afn (aeval afn))
+> afn
+
+(afn 0 0)
+> true
+
+(afn 0 1)
+> false
+

File src/test/funcs.xlx

View file
  • Ignore whitespace
+; a first fuction
+
+(define cdar
+  (lambda (l)
+          (cdr (car l))))
+
+> cdar
+
+; and try it out!
+
+(cdar '((1 2 3) (4 5)))
+> (2 3)

File src/test/ls_chp1.xlx

View file
  • Ignore whitespace
+; checking atom? works
+(atom? 'atom)
+> true
+
+; funny symbol
+(atom? '*abc$)
+> true
+
+; a list?
+(list? '(atom))
+> true
+
+; () list?
+(list? ())
+> true
+
+; () atom?
+(atom? ())
+> false
+
+; car - return list
+(car '(((hotdogs)) and pickled relish))
+> ((hotdogs))
+
+; car again - return list
+(car (car '(((hotdogs)) and pickled relish)))
+> (hotdogs)
+
+;eq? on symbols - good
+(eq? 'a 'a)
+> true
+
+;eq? on symbols - false
+(eq? 'a 'b)
+> false
+
+(null? 'abc)
+> nil
+
+(cdr ())
+> nil
+
+(car ())
+> nil

File src/test/ls_chp1_fixme.xlx

  • Ignore whitespace
Empty file added.

File src/test/ls_chp2.clj

View file
  • Ignore whitespace
+(defn insertR [old new l]
+  (if (= l ())
+    l
+    (let [rest_l (insertR old new (rest l))]
+      (cons (first l)
+            (if (= old (first l))
+              (cons new rest_l)
+              rest_l)))))
+
+(insertR '1 'a '(1 2 3 4 5))
+

File src/test/ls_chp2.py

View file
  • Ignore whitespace
+def insertR(old, new, l):
+    new_l = []
+    for ii in l:
+        new_l.append(ii)
+        if ii == old:
+            new_l.append(new)
+    return new_l
+
+insertR(1, 'a', (1,2,3,4,5))

File src/test/ls_chp2.xlx

View file
  • Ignore whitespace
+; define a function called lat
+(define lat?
+  (lambda (l)
+          (cond
+           ((null? l) true)
+           ((atom? (car l)) (lat? (cdr l)))
+           (:else false))))
+> lat?
+
+; test (lat? yum)
+(lat? '(bacon and eggs))
+> true
+
+; test (lat? yuck)
+(lat? '(bacon and '(chocolate coated eggs)))
+> false
+
+; testing or
+(or (null? '()) (null? '(1 2 3)))
+> true
+
+; Writing an insertR
+(define insertR
+  (lambda (old new l)
+          (cond
+           ((null? l) l)
+           (:else (cons (car l)
+                        (cond
+                         ((eq? old (car l)) (cons new (insertR old new (cdr l))))
+                         (:else (insertR old new (cdr l)))))))))
+> insertR
+
+; A test of insertR
+(insertR 'apple 'orange '(pear coconut apple banana))
+> (pear coconut apple orange banana)

File src/test/ls_chp4.xlx

View file
  • Ignore whitespace
+; numbers are atoms
+
+(atom? 1)
+> true
+
+(atom? 0)
+> true
+
+(atom? -1)
+> true
+
+; defining +
+(define +
+  (lambda (n m)
+    (.add n m)))
+> +
+
+; creating add1 sub1
+
+(define add1
+  (lambda (n)
+    (.add n 1)))
+> add1
+
+(add1 41)
+> 42
+
+(define sub1
+  (lambda (n)
+    (.add n -1)))
+> sub1
+
+(sub1 43)
+> 42
+
+(sub1 0)
+> -1
+
+; = and zero?
+
+(define zero?
+  (lambda (n)
+    (= n 0)))
+> zero?
+
+; test zero?
+(zero? 0)
+> true
+
+(zero? 23)
+> false
+
+; my version of times
+
+(define *
+  (lambda (n m)
+    (cond
+     ((zero? m) 0)
+     (:else (+ n (* n (sub1 m)))))))
+> *
+
+(* 7 5)
+> 35
+
+; my version of tup+
+
+(define tup+
+  (lambda (tup1 tup2)
+    (cond
+     ((null? tup1) tup2)
+     ((null? tup2) tup1)
+     (:else (cons (+ (car tup1) (car tup2))
+                  (tup+ (cdr tup1) (cdr tup2)))))))
+>tup+
+
+(tup+ '(1 2 3 4 5) '(10 10 10 10 10 10))
+> (11 12 13 14 15 10)
+
+; length - returns an int for the size of a list
+
+(define length
+  (lambda (l)
+    (cond
+     ((null? l) 0)
+     (:else (+ 1 (length (cdr l)))))))
+
+> length
+
+(length '(1 2 3 4 5))
+> 5
+
+(length '())
+> 0
+
+(define <
+  (lambda (m n)
+    (.lt m n)))
+> <
+
+(define -
+  (lambda (m n)
+    (.add m (.negate n))))
+> -
+
+; divide
+; (/ 15 4) = 1 + (/ 11 4)
+;          = 1 + 1 (/ 7 4)
+;          = 1 + 1 + 1 + (/3 4)
+;          = 1 + 1 + 1 + 0
+
+(define /
+  (lambda (n m)
+    (cond
+     ((< n m) 0)
+     (:else (+ 1 (/ (- n m) m))))))
+
+> /
+
+(/ 15 4)
+> 3
+
+(/ 16 4)
+> 4
+
+; pick returns the nth element of the list
+; starting from 1
+; (pick 3 '(1 2 3 4)) -> 3
+
+(define pick
+  (lambda (n l)
+    (cond
+     ((zero? (- n 1)) (car l))
+     (:else (pick (- n 1) (cdr l))))))
+
+> pick
+
+(pick 3 '(1 2 3 4 5))
+> 3
+
+(pick 1 '(1 2 3 4 5))
+> 1
+
+; rempick removes the nth element of the list
+; (rempick 3 '(1 2 3 4)) -> '(1 2 4)
+
+(define rempick
+  (lambda (n l)
+    (cond
+     ((null? l) '())
+     ((zero? (- n 1)) (cdr l))
+     (:else (cons (car l) (rempick (- n 1) (cdr l)))))))
+
+> rempick
+
+(rempick 1 '(1 2 3 4 5))
+> (2 3 4 5)
+
+(rempick 5 '(1 2 3 4 5))
+> (1 2 3 4)
+
+(rempick 4 '(1 2 3 4 5))
+> (1 2 3 5)
+
+(rempick 25 '(1 2 3 4 5))
+> (1 2 3 4 5)
+
+
+; need to implement this (primitive function)
+(number? 76)
+
+>true
+
+(number? 'a)
+
+>false
+
+(number? ())
+
+>false
+
+; no-nums, removes all the numbers from a list
+
+(define no-nums
+  (lambda (l)
+    (cond
+     ((null? l) '())
+     ((number? (car l)) (no-nums (cdr l)))
+     (:else (cons (car l) (no-nums (cdr l)))))))
+
+> no-nums
+
+(no-nums '(1 2 3 4))
+> ()
+
+(no-nums '(1 2 a 4))
+> (a)
+
+(no-nums '(1 2 a () 5))
+> (a ())
+
+; all-nums, extracts all the numbers from a list
+
+(define all-nums
+  (lambda (l)
+    (cond
+     ((null? l) '())
+     ((not (number? (car l))) (all-nums (cdr l)))
+     (:else (cons (car l) (all-nums (cdr l)))))))
+
+> all-nums
+
+(all-nums '(1 2 3 4))
+> (1 2 3 4)
+
+(all-nums '(1 2 a 4))
+> (1 2 4)
+
+(all-nums '(1 2 a () 5))
+> (1 2 5)
+
+; eqan, returns true if equal symbol or number
+
+(define eqan?
+  (lambda (l r)
+    (or
+     (and (number? l) (number? r) (= l r))
+     (and (symbol? l) (symbol? r) (eq? l r)))))
+> eqan?
+
+(eqan? 1 1)
+> true
+
+(eqan? 1 42)
+> false
+
+(eqan? 'a 'a)
+> true
+
+(eqan? 'a 2)
+> false
+
+(eqan? 'a '2)
+> false
+
+; this one is obscure, but apparently correct? XXX
+(eqan? 2 '2)
+> true
+
+; one? return true if a number is 1
+
+(define one?
+  (lambda (n)
+    (= n 1)))
+
+> one?
+
+(one? 0)
+> false
+
+(one? 1)
+> true
+
+; rewrite rempick using one?... XXX err no, this is too much of a hack
+
+(define rempick
+  (lambda (n l)
+    (cond
+     ((null? l) '())
+     ((one? n) (cdr l))
+     (:else (cons (car l) (rempick (- n 1) (cdr l)))))))
+
+> rempick
+
+(rempick 1 '(1 2 3 4 5))
+> (2 3 4 5)
+

File src/test/ls_chp5.xlx

View file
  • Ignore whitespace
+; write rember* where
+
+(define rember*
+  (lambda (a l)
+    (cond
+     ((null? l) ())
+     ((list? (car l)) (cons (rember* a (car l))
+                            (rember* a (cdr l))))
+     ((eq? a (car l)) (rember* a (cdr l)))
+     (:else (cons (car l)
+                  (rember* a (cdr l)))))))
+
+> rember*
+
+(rember* 'cup '((coffee) cup ((tea) cup) (and (hick)) cup))
+> ((coffee) ((tea)) (and (hick)))
+
+; so they commandment is to ask null?, then atom?, and ask list?.  So try again...
+
+(define rember*
+  (lambda (a l)
+    (cond
+     ((null? l) '())
+     ((atom? (car l))
+      (cond
+       ((eq? a (car l)) (rember* a (cdr l)))
+       (:else (cons (car l)
+                    (rember* a (cdr l))))))
+     (:else (cons (rember* a (car l))
+                  (rember* a (cdr l)))))))
+
+> rember*
+
+(rember* 'cup '((coffee) cup ((tea) cup) (and (hick)) cup))
+> ((coffee) ((tea)) (and (hick)))
+
+; TODO write insertR* taking heed of commandment
+
+;(define insertR*
+;  (lambda (new old l)
+;    (cond
+;     ((null? l) _)
+;     ((atom? (car l)) _)
+;     (:else _))))
+;> insertR*
+
+; so all * functions ask (null? l), (atom? (car l)) and :else.  And then recur on both car and cdr.
+; why?  simply each call is either empty list.  An atom cons-ed onto a list.  Or a list cons-ed onto a list.
+; This is the final version of 4th commandment!
+
+; note to self, why not make this a macro?  
+
+; TODO write occur*
+
+; TODO write subst*
+
+; TODO write insertL*
+
+; TODO write member*
+
+

File src/test/ls_chp6.xlx

View file
  • Ignore whitespace
+; shadows
+
+(define first-sub-exp (aexp)
+  (car (cdr aexp)))
+
+(define second-sub-exp (aexp)
+  (car (cdr (cdr aexp))))
+
+(define operator (aexp)
+  (car aexp)
+
+
+(define value (nexp)
+  (cond
+   ((atom? nexp) nexp)
+   ((eq? (operator nexp) '+)
+    (+ (value (first-sub-exp nexp)) (value (second-sub-exp nexp)))
+   ((eq? (operator nexp) '+)
+    (- (value (first-sub-exp nexp)) (value (second-sub-exp nexp)))
+   ((eq? (operator nexp) '*)
+    (* (value (first-sub-exp nexp)) (value (second-sub-exp nexp)))
+

File src/test/ls_chp7.xlx

View file
  • Ignore whitespace
+(define (eqan? l r)
+  (or
+   (and (number? l) (number? r) (= l r))
+   (and (symbol? l) (symbol? r) (eq? l r))))
+> eqan?
+
+(eqan? 1 2)
+> false
+
+(eqan? 1 1)
+> true
+
+(eqan? 1 'a)
+> false
+
+(eqan? 'a 'a)
+> true
+
+(define (member? e l)
+  (cond
+   ((null? l) false)
+   ((eqan? e (car l)) true)
+   (:else (member? e (cdr l)))))
+> member?
+
+(member? 1 '(2 3 1))
+> true
+(member? 1 '(1 3 2))
+> true
+(member? 1 '(4 3 2))
+> false
+(member? 1 '(a b c))
+> false
+
+(define (set? l)
+  (cond
+   ((null? l) true)
+   ((member? (car l) (cdr l)) false)
+   (:else (set? (cdr l)))))
+> set?
+
+(set? '(2 3 1))
+> true
+
+(set? '(a 3 1))
+> true
+
+(set? '(a 3 a))
+> false
+
+(set? '(a 3 3))
+> false
+
+(define (makeset l)
+  (cond
+   ((null? l) '())
+   ((member? (car l) (cdr l)) (makeset (cdr l)))
+   (:else (cons (car l) (makeset (cdr l))))))
+> makeset
+
+; answer is really reversed as we ignore anything that has dupes, until no dupes
+(makeset '(1 2 3 4 4 3 2 1))
+> (4 3 2 1)
+
+(define (multirember e l)
+  (cond
+   ((null? l) '())
+   ((eqan? e (car l)) (multirember e (cdr l)))
+   (:else (cons (car l) (multirember e (cdr l))))))
+> multirember
+
+(multirember 42 '(1 2 5 42 2 42 2 3 42))
+> (1 2 5 2 2 3)
+
+(define (makeset2 l)
+  (cond
+   ((null? l) '())
+   (:else (cons (car l) (makeset2 (multirember (car l) (cdr l)))))))
+> makeset2
+
+(makeset2 '(1 2 3 4 4 3 2 1))
+> (1 2 3 4)
+
+(define (subset? l1 l2)
+  (cond
+   ((null? l1) true)
+   ((member? (car l1) l2) (subset? (cdr l1) l2))
+   (:else false)))
+
+> subset?
+
+(subset? '(1 2 3) '(4 5 6))
+> false
+
+(subset? '(1 2 4 3) '(4 5 6))
+> false
+
+(subset? '(1 2 3) '(4 3 2 1))
+> true
+
+(define (subset2? l1 l2)
+  (cond
+   ((null? l1) true)
+   (:else (and (member? (car l1) l2) (subset2? (cdr l1) l2)))))
+
+> subset2?
+
+(subset2? '(1 2 3) '(4 5 6))
+> false
+
+(subset2? '(1 2 4 3) '(4 5 6))
+> false
+
+(subset2? '(1 2 3) '(4 3 2 1))
+> true
+
+; defining equal set in terms of subset
+(define (eqset? l1 l2)
+  (and (subset2? l1 l2) (subset2? l2 l1)))
+> eqset?
+
+(eqset? '(1 2 3) '(4 3 2 1))
+> false
+
+(eqset? '(1 2 3 4) '(4 3 2 1))
+> true
+
+; write:
+;(intersect?)
+;(intersect)
+;(union)
+
+;intersectall

File src/test/macro.xlx

View file
  • Ignore whitespace
+(defmacro if (cond good bad) (list 'cond (list cond good) (list ':else bad)))
+> if
+
+(define (afn x)
+  (if (<= x 5) (* x x) 'bad))
+
+> afn
+
+(afn 4)
+> 16
+
+(afn 10)
+> bad
+
+(defmacro let1 (binding setme form)
+  (list
+   (list 'lambda (list binding) form)
+   setme))
+> let1
+
+(macroexpand-1 let1 '(x 1 (+ x x)))
+> ((lambda (x) (+ x x)) 1)
+
+(let1 z "hello"
+      (begin
+        (prn z)
+        (prn z)
+        (prn z)
+        z))
+> "hello"
+
+(defmacro let2 (binding forms)
+  (list
+   (list 'lambda (list (car binding)) (cons 'begin forms))
+   (car (cdr binding))))
+> let2
+
+(let2 (z "helloz")
+  ((prn z)
+   (prn z)
+   (prn z)
+   z))
+> "helloz"
+
+(define (firsts l)
+  (if (null? l)
+      '()
+      (cons (car (car l))
+            (firsts (cdr l)))))
+> firsts
+
+(firsts '((1 a) (2 b) (3 c)))
+> (1 2 3)
+
+
+(define (seconds l)
+  (if (null? l)
+      '()
+      (cons (car (cdr (car l)))
+            (seconds (cdr l)))))
+> seconds
+
+(seconds '((1 a) (2 b) (3 c)))
+> (a b c)
+
+(defmacro let (bindings forms)
+  (begin
+    (cons
+     (list 'lambda (firsts bindings) (cons 'begin forms))
+     (seconds bindings))))
+> let
+
+(let ((x "hello")
+      (y "world")
+      (z (+ 1 1)))
+  ((prn x)
+   (prn y)
+   (prn z)
+   y))
+> "world"
+
+(define (fib)
+  (let ((a 0) (b 1))
+    ; create a lazily evaluated function as a closure!
+    ((lambda ()
+       (let ((tmp (+ a b)))
+         ((set! a b)
+          (set! b tmp)
+          a))))))
+> fib
+
+(define (nth x fn)
+  (if (= x 0)
+      (fn)
+      (begin
+        (fn)
+        (nth (- x 1) fn))))
+> nth
+
+(time (nth 32 (fib)))
+> 3524578

File src/test/setbang.xlx

View file
  • Ignore whitespace
+(define a 43)
+> a
+
+(set! a 42)
+> a
+
+a
+> 42
+
+(define (afn arg)
+  (begin
+    (set! a 55)
+    arg))
+> afn
+
+(afn 20)
+> 20
+
+a
+> 55
+
+(define (afn arg)
+  (begin
+    (set! arg 55)
+    arg))
+> afn
+
+(prn afn)
+> nil
+
+(afn 20)
+> 55
+
+(define (createclosure arg)
+  (lambda ()
+    (begin
+      (set! arg (+ 1 arg))
+      arg)))
+> createclosure
+
+(define aclosure (createclosure 42))
+> aclosure
+
+(aclosure)
+> 43
+
+(aclosure)
+> 44
+
+(define tmp 0)
+> tmp
+
+(define (fib b)
+  (lambda (a)
+    ; this is a let!
+    (lambda ()
+      (begin
+        (set! tmp (+ a b))
+        (set! a b)
+        (set! b tmp)
+        b))))
+> fib
+
+(define g ((fib 0) 1))
+> g
+
+(list (g) (g) (g) (g) (g) (g))
+> (1 1 2 3 5 8)
+
+(define g2 ((fib 0) 1))
+> g2
+
+(list (g2) (g2) (g2) (g2) (g2) (g2))
+> (1 1 2 3 5 8)
+
+(define (nth x fn)
+  (cond
+   ((= x 0) (fn))
+   (:else (begin
+            (fn)
+            (nth (- x 1) fn)))))
+> nth
+
+(time (nth 32 ((fib 0) 1)))
+> 3524578
+
+(define (fib)
+  ; this is a let!
+  ((lambda (tmp a b)
+
+     ; create a lazily evaluated function as a closure!
+     (lambda ()
+       (begin
+         (set! tmp (+ a b))
+         (set! a b)
+         (set! b tmp)
+         a))) 0 0 1))
+> fib
+
+(time (nth 32 (fib)))
+> 3524578

File src/test/simple.xlx

View file
  • Ignore whitespace
+; a define
+(define x '(1 2 3))
+> x
+
+; checking type works
+(type x)
+> #slist
+
+; checking atom? works
+(atom? x)
+> false
+
+; checking list? works
+(list? x)
+> true
+
+; checking car works
+(car x)
+> 1
+
+; checking cdr works
+(cdr x)
+> (2 3)
+
+; checking con and quote works
+(cons 'a '(b c))
+> (a b c)
+
+; more con (with some compound expressions)
+(cons (car x) (cons (car x) (cdr x)))
+> (1 1 2 3)
+
+; redefine x to be something else
+(define x '(10 9 8 7 6 5 4 3 2 1))
+> x
+
+; test x now
+(cons (car x) (cons (car x) (cdr x)))
+> (10 10 9 8 7 6 5 4 3 2 1)
+
+
+; first version of simple cons
+(cons 'a '())
+> (a)
+
+; second version of simple cons
+(cons 'a ())
+> (a)
+
+; null test 1
+(null? '(a))
+> false
+
+; null test 2
+(null? ())
+> true
+
+; test not (the first builtin defined from scheme code)
+
+(not true)
+> false
+
+(not false)
+> true

File src/test/test_reader.py

View file
  • Ignore whitespace
+import os
+import functools
+
+import py.test
+
+from baseimport import *
+
+from xlispx.reader import simple_tokenize, reader
+from xlispx.reader import OPEN_BRACKET, CLOSE_BRACKET, SPECIAL_ATOM, ATOM, STRING
+
+def simple(s):
+    r = list(simple_tokenize(s))
+    assert len(r) == 1
+    return r[0]
+
+def expect(s, expected):
+    print "doing:", s
+    l = list(simple_tokenize(s))
+    for m, n in zip(l, expected):
+        print m, "<-->", n
+        assert m == n
+    assert len(l) == len(expected)
+
+def test_simple():
+    assert simple("hello") == (ATOM, "hello")
+    assert simple("world") == (ATOM, "world")
+    assert simple("(") == (OPEN_BRACKET, "(")
+    assert simple("[") == (OPEN_BRACKET, "[")
+    assert simple('"hello world"') == (STRING, "hello world")
+
+def test_stuffs():
+    expect("hello world", [(ATOM, "hello"),
+                           (ATOM, "world")])
+
+    expect("(hello world)", [(OPEN_BRACKET, "("),
+                             (ATOM, "hello"),
+                             (ATOM, "world"),
+                             (CLOSE_BRACKET, ")")])
+
+    expect('("hello 123" asd(', [(OPEN_BRACKET, "("),
+                                 (STRING, 'hello 123'),
+                                 (ATOM, "asd"),
+                                 (OPEN_BRACKET, "(")])
+def test_reader():
+    s = '(prn "hello world")'
+    assert reader(s).repr() == s

File src/test/test_xlispx.py

View file
  • Ignore whitespace
+import os
+import functools
+