ajlisp 0.0.0

data/lib/ajlisp/primitive_load.rb

@@ -0,0 +1,34 @@
+
+module AjLisp
+
+  class PrimitiveLoad < Primitive	
+    private_class_method :new
+      
+    @@instance = nil
+      
+    def self.instance
+      @@instance = new unless @@instance
+      return @@instance
+    end
+
+  	def apply(context, args)       
+      result = nil
+      
+      args.each do |filename|
+        source = FileSource.new filename # File.expand_path(filename, File.dirname(__FILE__))
+        lexer = Lexer.new source
+        parser = Parser.new lexer
+        expr = parser.parseExpression
+        
+        
+        while expr
+          result = AjLisp::evaluate AjLisp::context, expr
+          expr = parser.parseExpression
+        end
+      end
+        
+      return result
+  	end
+  end
+
+end

data/lib/ajlisp/primitive_multiply.rb

@@ -0,0 +1,25 @@
+
+module AjLisp
+
+class PrimitiveMultiply < Primitive	
+    private_class_method :new
+    
+    @@instance = nil
+    
+    def self.instance
+        @@instance = new unless @@instance
+        return @@instance
+    end
+    
+	def apply(context, args)
+		result = 1
+		
+		args.each do |arg|
+			result *= arg
+		end
+		
+		return result
+	end
+end
+
+end

data/lib/ajlisp/primitive_predicates.rb

@@ -0,0 +1,58 @@
+
+module AjLisp
+
+class PrimitiveNilPredicate < Primitive	
+    private_class_method :new
+    
+    @@instance = nil
+    
+    def self.instance
+        @@instance = new unless @@instance
+        return @@instance
+    end
+    
+	def apply(context, args)
+        return ((args[0] == nil) or (args[0].is_a? NilAtom))
+	end
+end
+
+class PrimitiveAtomPredicate < Primitive	
+    private_class_method :new
+    
+    @@instance = nil
+    
+    def self.instance
+        @@instance = new unless @@instance
+        return @@instance
+    end
+    
+	def apply(context, args)
+        if args[0] == nil
+            return false
+        end
+        
+        if args[0].is_a? List
+            return false
+        end
+        
+        return true
+	end
+end
+
+class PrimitiveListPredicate < Primitive	
+    private_class_method :new
+    
+    @@instance = nil
+    
+    def self.instance
+        @@instance = new unless @@instance
+        return @@instance
+    end
+    
+	def apply(context, args)
+        return args[0].is_a? List
+	end
+end
+
+end
+

data/lib/ajlisp/primitive_rest.rb

@@ -0,0 +1,19 @@
+
+module AjLisp
+
+class PrimitiveRest < Primitive	
+    private_class_method :new
+    
+    @@instance = nil
+    
+    def self.instance
+        @@instance = new unless @@instance
+        return @@instance
+    end
+
+	def apply(context, args)
+		return args[0].rest
+	end
+end
+
+end

data/lib/ajlisp/primitive_subtract.rb

@@ -0,0 +1,25 @@
+
+module AjLisp
+
+class PrimitiveSubtract < Primitive	
+    private_class_method :new
+    
+    @@instance = nil
+    
+    def self.instance
+        @@instance = new unless @@instance
+        return @@instance
+    end
+    
+	def apply(context, args)
+		result = args.shift
+		
+		args.each do |arg|
+			result -= arg
+		end
+		
+		return result
+	end
+end
+
+end

data/lib/ajlisp/string_source.rb

@@ -0,0 +1,28 @@
+
+module AjLisp
+
+	class StringSource	
+		def initialize(text)
+			@text = text
+			@position = 0
+			@chars = []
+		end
+		
+		def nextChar
+			char = @chars.pop
+			
+			if char
+				return char
+			end
+		
+			char = @text[@position]
+			@position += 1
+			return char
+		end
+		
+		def pushChar(ch)
+			@chars.push ch
+		end
+	end
+
+end

data/lib/ajlisp/token.rb

@@ -0,0 +1,23 @@
+
+module AjLisp
+
+class Token
+	attr_reader :value
+	attr_reader :type
+	
+	def initialize(value, type)
+		@value = value
+		@type = type
+	end
+end
+
+class TokenType
+	INTEGER = 1
+	REAL = 2
+	STRING = 3
+	ATOM = 4
+	SEPARATOR = 5
+end
+
+end
+

data/lib/core.lsp

@@ -0,0 +1,40 @@
+(define definem (mlambda x (list 'define (first x) (cons 'mlambda (rest x)))))
+
+(define append (x y) (if (nil? x) y (cons (first x) (append (rest x) y))))
+
+(definem cond lst (if (nil? lst) false (list 'if (first (first lst)) (cons 'do (rest (first lst))) (cons 'cond (rest lst)))))
+
+(definem and lst (if (nil? lst) true (list 'cond (list (first lst) (cons 'and (rest lst))) '(true false))))
+
+(define mapcond (fn lst)
+	(if (nil? lst)
+		nil
+		(if (fn (first lst))
+			(cons 
+				(first lst) 
+				(mapcond fn (rest lst))
+			)
+			(mapcond fn (rest lst))
+		)
+	)
+)
+
+(define mapfirst (fn lst)
+  (if (nil? lst)
+    nil
+    (cons
+      (fn (first lst))
+      (mapfirst fn (rest lst))
+    )
+  )
+)
+
+(definem backquote (lst) (cond
+                ((nil? lst) nil)
+                ((atom? lst) (list 'quote lst))
+                ((= (first lst) 'unquote) (first (rest lst)))
+                ((and (list? (first lst)) (= (first (first lst)) 'unquote-slice)) (list 'append (first (rest (first lst))) (list 'backquote (rest lst))))
+                (true (list 'cons (list 'backquote (first lst)) (list 'backquote (rest lst))))
+                ))
+
+                

data/test/and.lsp

@@ -0,0 +1 @@
+(definem and lst (if (nil? lst) true (list 'cond (list (first lst) (cons 'and (rest lst))) '(true false))))

data/test/append.lsp

@@ -0,0 +1 @@
+(define append (x y) (if (nil? x) y (cons (first x) (append (rest x) y))))

data/test/backquote.lsp

@@ -0,0 +1,7 @@
+(definem backquote (lst) (cond
+                ((nil? lst) nil)
+                ((atom? lst) (list 'quote lst))
+                ((= (first lst) 'unquote) (first (rest lst)))
+                ((and (list? (first lst)) (= (first (first lst)) 'unquote-slice)) (list 'append (first (rest (first lst))) (list 'backquote (rest lst))))
+                (true (list 'cons (list 'backquote (first lst)) (list 'backquote (rest lst))))
+                ))

data/test/cond.lsp

@@ -0,0 +1 @@
+(definem cond lst (if (nil? lst) false (list 'if (first (first lst)) (cons 'do (rest (first lst))) (cons 'cond (rest lst)))))

data/test/define123.lsp

@@ -0,0 +1,4 @@
+(define one 1)
+(define two 2)
+(define three 3)
+

data/test/definem.lsp

@@ -0,0 +1 @@
+(define definem (mlambda x (list 'define (first x) (cons 'mlambda (rest x)))))

data/test/dodefine123.lsp

@@ -0,0 +1,5 @@
+(do
+    (define one 1)
+    (define two 2)
+    (define three 3)
+)

data/test/mapcond.lsp

@@ -0,0 +1,13 @@
+(define mapcond (fn lst)
+	(if (nil? lst)
+		nil
+		(if (fn (first lst))
+			(cons 
+				(first lst) 
+				(mapcond fn (rest lst))
+			)
+			(mapcond fn (rest lst))
+		)
+	)
+)
+

data/test/mapfirst.lsp

@@ -0,0 +1,10 @@
+(define mapfirst (fn lst)
+  (if (nil? lst)
+    nil
+    (cons
+      (fn (first lst))
+      (mapfirst fn (rest lst))
+    )
+  )
+)
+

data/test/mycons.lsp

@@ -0,0 +1,3 @@
+(define mycons (a b) (cons a b))
+(mycons (quote a) (quote (b)))
+

data/test/test.rb

@@ -0,0 +1,42 @@
+
+require 'ajlisp'
+require 'test/unit'
+
+require "test_list.rb"
+require "test_named_atom.rb"
+require "test_dot_verb_atom.rb"
+require "test_at_constant_atom.rb"
+require "test_context.rb"
+require "test_string_source.rb"
+require "test_file_source.rb"
+require "test_token.rb"
+require "test_lexer.rb"
+require "test_parser.rb"
+
+require "test_primitive_first.rb"
+require "test_primitive_rest.rb"
+require "test_primitive_cons.rb"
+require "test_primitive_list.rb"
+require "test_primitive_closure.rb"
+
+require "test_primitive_add.rb"
+
+require "test_primitive_eval"
+
+require "test_fprimitive_quote.rb"
+require "test_fprimitive_lambda.rb"
+require "test_fprimitive_let.rb"
+require "test_fprimitive_closure.rb"
+require "test_fprimitive_flambda.rb"
+require "test_fprimitive_mlambda.rb"
+require "test_fprimitive_define.rb"
+require "test_fprimitive_definef.rb"
+require "test_fprimitive_definem.rb"
+require "test_fprimitive_do.rb"
+require "test_fprimitive_if.rb"
+require "test_fprimitive_macro_closure.rb"
+
+require "test_evaluate"
+require "test_evaluate_files"
+require "test_load"
+

data/test/test_at_constant_atom.rb

@@ -0,0 +1,34 @@
+
+require 'ajlisp'
+require 'test/unit'
+
+module AjLisp
+
+class TestAtConstantAtom < Test::Unit::TestCase
+	def test_initialize
+		atom = AjLisp::AtConstantAtom.new("@String")
+		assert_equal "@String".intern, atom.name
+        assert_equal "String", atom.constant
+	end
+
+	def test_initialize_with_colons
+		atom = AjLisp::AtConstantAtom.new("@AjLisp::List")
+		assert_equal "@AjLisp::List".intern, atom.name
+        assert_equal "AjLisp::List", atom.constant
+	end
+
+	def test_evaluate
+		atom = AjLisp::AtConstantAtom.new("@String")
+        result = atom.evaluate nil
+        assert_equal String, result
+	end
+
+	def test_nested_constant
+		atom = AjLisp::AtConstantAtom.new("@AjLisp::List")
+        result = atom.evaluate nil
+        assert_equal AjLisp::List, result
+	end
+end
+
+end
+

data/test/test_context.rb

@@ -0,0 +1,37 @@
+
+require 'ajlisp'
+require 'test/unit'
+
+class TestContext < Test::Unit::TestCase
+	def test_initialize
+		context = AjLisp::Context.new
+		assert_not_nil(context)
+	end
+	
+	def test_not_defined_is_nil
+		context = AjLisp::Context.new
+		assert_nil(context.getValue(:foo))
+	end
+	
+	def test_set_and_get_value
+		context = AjLisp::Context.new
+		context.setValue(:foo, "bar")
+		assert_equal("bar", context.getValue(:foo))
+	end
+	
+	def test_get_value_from_parent
+		parent = AjLisp::Context.new
+		parent.setValue(:foo, "bar")
+		context = AjLisp::Context.new(parent)
+		assert_equal("bar", context.getValue(:foo))
+	end
+	
+	def test_override_value_from_parent
+		parent = AjLisp::Context.new
+		parent.setValue(:foo, "bar")
+		context = AjLisp::Context.new(parent)
+		context.setValue(:foo, "bar2")
+		assert_equal("bar2", context.getValue(:foo))
+		assert_equal("bar", parent.getValue(:foo))
+	end
+end