@@ -1,8 +1,24 @@ -(define post (lambda (id title body timestamp) - (defresource (+ "/" (number->string id)) - ;; Gah; i need quasiquote! - (list 'html (list 'head (list 'title title)) - (list 'body - (list 'div - (list 'h1 title) - body)))))) +(define blog-posts ()) + +(define post + (lambda (id title body timestamp tags) + (define blog-posts (cons + (defresource (+ "/" + (number->string id)) + ;; Gah; i need quasiquote! + (list 'html (list 'head + (list p'title + title)) + (list 'body + (list 'div 'class "post" + (list 'h1 title) + body)))) + blog-posts)))) + +(defresource "/" (lambda (env) + (map (lambda (post) + (list 'div 'class "post" + (list 'h1 (post 'title)) + (post 'body))) + (resources-list)))) + examples/blog.scm @@ -21,6 +21,7 @@ module BusScheme define 'list', primitive { |*members| members.to_list } define 'vector', primitive { |*members| members.to_a } define 'map', primitive { |fn, list| list.map(lambda { |n| fn.call(n) }).sexp } + # TODO: test these define 'now', primitive { Time.now } define 'regex', primitive { |r| Regexp.new(Regexp.escape(r)) } @@ -43,6 +44,12 @@ module BusScheme # TODO: hacky to coerce everything to sexps... won't work once we start using vectors special_form 'quote', primitive { |arg| arg.sexp } + + # TODO: write + special_form 'quasiquote', primitive { } + special_form 'unquote', primitive { } + special_form 'unquote-splicing', primitive { } + special_form 'if', primitive { |q, yes, *no| eval(eval(q) ? yes : [:begin.sym] + no) } special_form 'begin', primitive { |*args| args.map{ |arg| eval(arg) }.last } special_form 'top-level', BusScheme[:begin.sym] @@ -50,6 +57,7 @@ module BusScheme # TODO: define doesn't always create a top-level binding special_form 'define', primitive { |sym, value| BusScheme::SYMBOL_TABLE[sym] = eval(value); sym } special_form 'set!', primitive { |sym, value| raise EvalError.new unless BusScheme.in_scope?(sym) + # TODO: set-able "places" BusScheme[sym.sym] = value } # TODO: once we have macros, this can be defined in scheme lib/bus_scheme/primitives.rb @@ -1,3 +1,10 @@ +(define select + (lambda (fn lst) + (if lst + (if (fn (car lst)) + (cons (car lst) (select fn (cdr lst))) + (select fn (cdr lst)))))) + (define length (lambda (l) (if (null? l) 0 (+ 1 (length (cdr l)))))) lib/bus_scheme/scheme/list.scm @@ -1,8 +1,10 @@ module BusScheme - define 'defresource', primitive {|*args| Web::Resource.new(*args)} + define 'defresource', primitive {|*args| Web::Resource.new(*args) } + define 'resources-list', primitive { BusScheme['resources'].values.to_list } module Web class Forbidden < BusSchemeError; end - + + # TODO: way more of this stuff belongs in Scheme class Resource attr_reader :path, :contents @@default_headers = {'Content-Type' => 'text/html'} @@ -59,6 +61,10 @@ module BusScheme def link(text) Xml.create [:a.sym, :href.sym, @path, text] end + + def inspect + "<Resource at \"#{@path}\">" + end def self.not_found_handler lambda { |e| [404, @@default_headers, "<h1>404 Not Found</h1>"] } lib/bus_scheme/web/resource.rb @@ -8,5 +8,5 @@ (quote (p "this is my" (b "second") "post")) (now)) -(assert-equal ((http-get "http://localhost:2000/1") 'body) - "This is my bus scheme blog") \ No newline at end of file +;; (assert-equal ((http-get "http://localhost:2000/1") 'body) +;; "This is my bus scheme blog") \ No newline at end of file test/test_blog.scm @@ -87,6 +87,11 @@ class BusSchemeEvalTest < Test::Unit::TestCase assert_evals_to 3, "((hash (1 1) (2 2) (3 3)) 3)" end + def test_evals_string_ending_in_comment + assert_evals_to 3, "(+ 2 2) + ;; should be four" + end + # def test_tail_call_optimization # Timeout.timeout(1) do # assert_nothing_raised { eval "((lambda (x) (x x)) (lambda (x) (x x)))" } test/test_eval.rb @@ -13,4 +13,7 @@ (assert-equal (length "abc") 3) (assert-equal (length "ab") 2) -(assert-equal (length "a") 1) \ No newline at end of file +(assert-equal (length "a") 1) + +(assert-equal (list 4 5 6) + (select (lambda (n) (> n 3)) (list 1 2 3 4 5 6 1))) \ No newline at end of file test/test_list_functions.scm 6dc5192a65414ea962694230c3b16a40c3eb9f15 Phil Hagelberg technomancy@gmail.com http://github.com/technomancy/bus-scheme/commit/759caea5faaecc242a6dad0c37928b2f0d4f4243 759caea5faaecc242a6dad0c37928b2f0d4f4243 2008-05-28T22:37:24-07:00 2008-05-28T22:37:24-07:00 failing test for comments at the end of an eval string (written on the train) 4854e162ca07def4a50286fa802c32f72ea1a31d Phil Hagelberg technomancy@gmail.com