From ef5d4f252c74ff111766fce9bef7a2b80e4ab32b Mon Sep 17 00:00:00 2001 From: Moritz Heidkamp Date: Sat, 18 Feb 2012 15:13:34 +0100 Subject: [PATCH 1/7] =?UTF-8?q?implement=20self-quoting=20keywords=20(impl?= =?UTF-8?q?emented=20as=20plain=20symbols=20suffixed=20by=20":"=20=C3=A0?= =?UTF-8?q?=20la=20Chicken=20Scheme)=20and=20add=20`string->keyword`=20to?= =?UTF-8?q?=20the=20library.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/heist/builtin/lib/string.scm | 5 +++++ lib/heist/runtime/scope.rb | 1 + 2 files changed, 6 insertions(+) diff --git a/lib/heist/builtin/lib/string.scm b/lib/heist/builtin/lib/string.scm index 0911bcd..ed54ed7 100644 --- a/lib/heist/builtin/lib/string.scm +++ b/lib/heist/builtin/lib/string.scm @@ -115,3 +115,8 @@ ; Returns a new string formed by concatenating the arguments (define (string-append . strings) (list->string (apply append (map string->list strings)))) + +; (string->keyword string) +; Returns a keyword, i.e. suffixes the string with ":" and turns it into a symbol +(define (string->keyword s) + (string->symbol (string-append s ":"))) diff --git a/lib/heist/runtime/scope.rb b/lib/heist/runtime/scope.rb index 711e1ee..270129b 100644 --- a/lib/heist/runtime/scope.rb +++ b/lib/heist/runtime/scope.rb @@ -38,6 +38,7 @@ def initialize(parent = {}) # def [](name) name = to_name(name) + return Identifier.new(name) if name.end_with?(':') bound = @symbols.has_key?(name) raise UndefinedVariable.new( From 4efc5fe47882df32810a313588cf3ceb1774ea27 Mon Sep 17 00:00:00 2001 From: Moritz Heidkamp Date: Sat, 18 Feb 2012 15:50:24 +0100 Subject: [PATCH 2/7] implement keywords as a proper type; add `keyword?` primitive --- lib/heist/builtin/primitives.rb | 4 ++++ lib/heist/runtime/data/keyword.rb | 18 ++++++++++++++++++ lib/heist/runtime/runtime.rb | 2 +- lib/heist/runtime/scope.rb | 2 +- 4 files changed, 24 insertions(+), 2 deletions(-) create mode 100644 lib/heist/runtime/data/keyword.rb diff --git a/lib/heist/builtin/primitives.rb b/lib/heist/builtin/primitives.rb index efdcb4b..c955249 100644 --- a/lib/heist/builtin/primitives.rb +++ b/lib/heist/builtin/primitives.rb @@ -204,6 +204,10 @@ Vector === value end +define('keyword?') do |value| + Keyword === value +end + #---------------------------------------------------------------- # Numerical functions diff --git a/lib/heist/runtime/data/keyword.rb b/lib/heist/runtime/data/keyword.rb new file mode 100644 index 0000000..cc76ef1 --- /dev/null +++ b/lib/heist/runtime/data/keyword.rb @@ -0,0 +1,18 @@ +module Heist + class Runtime + + # A +Keyword+ is a a self-quoting identifier ending in ":". The + # separate class is merely a convenience for implementing the + # +keyword?+ predicate. + class Keyword < Identifier + + # Since keywords need never be renamed they don't need an + # +original_name+ argument. + def initialize(name) + super(name) + end + end + + end +end + diff --git a/lib/heist/runtime/runtime.rb b/lib/heist/runtime/runtime.rb index 0550b3b..f948885 100644 --- a/lib/heist/runtime/runtime.rb +++ b/lib/heist/runtime/runtime.rb @@ -18,7 +18,7 @@ module Heist # class Runtime - %w[ data/expression data/identifier data/character + %w[ data/expression data/identifier data/character data/keyword data/cons data/vector data/value callable/function callable/syntax callable/macro callable/continuation frame stack stackless diff --git a/lib/heist/runtime/scope.rb b/lib/heist/runtime/scope.rb index 270129b..ad28887 100644 --- a/lib/heist/runtime/scope.rb +++ b/lib/heist/runtime/scope.rb @@ -38,7 +38,7 @@ def initialize(parent = {}) # def [](name) name = to_name(name) - return Identifier.new(name) if name.end_with?(':') + return Keyword.new(name) if name.end_with?(':') bound = @symbols.has_key?(name) raise UndefinedVariable.new( From 6fa19f757e70b5bacde3566046bcb37b70084a6f Mon Sep 17 00:00:00 2001 From: Moritz Heidkamp Date: Sat, 18 Feb 2012 15:51:09 +0100 Subject: [PATCH 3/7] update compiled_library.rb --- lib/heist/builtin/compiled_library.rb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/heist/builtin/compiled_library.rb b/lib/heist/builtin/compiled_library.rb index 812ece0..ed3bda4 100644 --- a/lib/heist/builtin/compiled_library.rb +++ b/lib/heist/builtin/compiled_library.rb @@ -1 +1 @@ -program [[:define, :quit, :exit], [:define, [:newline], [:display, "\n"]], [:define, [:force, :promise], [:promise]], [:define, :"call/cc", :"call-with-current-continuation"], [:define, :eq?, :eqv?], [:define, [:not, :x], [:if, :x, false, true]], [:define, :true, true], [:define, :false, false], [:define, [:boolean?, :x], [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], [:define, :number?, :complex?], [:define, [:exact?, :x], [:or, [:rational?, :x], [:and, [:not, [:zero?, [:"imag-part", :x]]], [:exact?, [:"real-part", :x]], [:exact?, [:"imag-part", :x]]]]], [:define, [:inexact?, :x], [:not, [:exact?, :x]]], [:define, [:"=", :".", :args], [:define, [:iter, :x, :rest], [:if, [:null?, :rest], true, [:let, [[:y, [:car, :rest]]], [:if, [:or, [:not, [:number?, :x]], [:not, [:number?, :y]], [:not, [:equal?, :x, :y]]], false, [:iter, :x, [:cdr, :rest]]]]]], [:iter, [:car, :args], [:cdr, :args]]], [:define, [:zero?, :x], [:eqv?, :x, 0]], [:define, [:positive?, :x], [:>, :x, 0]], [:define, [:negative?, :x], [:<, :x, 0]], [:define, [:odd?, :x], [:"=", 1, [:remainder, :x, 2]]], [:define, [:even?, :x], [:zero?, [:remainder, :x, 2]]], [:define, [:max, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:<=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:abs, :x], [:if, [:negative?, :x], [:-, :x], :x]], [:define, [:quotient, :x, :y], [:let, [[:result, [:/, :x, :y]]], [[:if, [:positive?, :result], :floor, :ceiling], :result]]], [:define, [:remainder, :x, :y], [:-, [:round, :x], [:*, [:round, :y], [:quotient, :x, :y]]]], [:define, [:modulo, :x, :y], [:+, [:remainder, :x, :y], [:if, [:negative?, [:*, :x, :y]], [:round, :y], 0]]], [:define, [:gcd, :x, :y, :".", :rest], [:if, [:null?, :rest], [:if, [:zero?, :y], [:abs, :x], [:gcd, :y, [:remainder, :x, :y]]], [:apply, :gcd, [:cons, [:gcd, :x, :y], :rest]]]], [:define, [:lcm, :x, :y, :".", :rest], [:if, [:null?, :rest], [:/, [:abs, [:*, :x, :y]], [:gcd, :x, :y]], [:apply, :lcm, [:cons, [:lcm, :x, :y], :rest]]]], [:define, :ceiling, :ceil], [:define, [:rationalize, :x, :tolerance], [:cond, [[:rational?, :x], :x], [[:not, [:zero?, [:"imag-part", :x]]], [:"make-rectangular", [:rationalize, [:"real-part", :x], :tolerance], [:rationalize, [:"imag-part", :x], :tolerance]]], [:else, [:"let*", [[:t, [:abs, :tolerance]], [:a, [:-, :x, :t]], [:b, [:+, :x, :t]]], [:do, [[:i, 1, [:+, :i, 1]], [:z, false]], [[:number?, :z], :z], [:let, [[:p, [:ceiling, [:*, :a, :i]]], [:q, [:floor, [:*, :b, :i]]]], [:if, [:<=, :p, :q], [:set!, :z, [:/, [:if, [:positive?, :p], :p, :q], :i]]]]]]]]], [:define, [:"make-polar", :magnitude, :angle], [:let, [[:re, [:*, :magnitude, [:cos, :angle]]], [:im, [:*, :magnitude, [:sin, :angle]]]], [:"make-rectangular", :re, :im]]], [:define, [:magnitude, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:sqrt, [:+, [:*, :re, :re], [:*, :im, :im]]]]], [:define, [:angle, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:atan, :im, :re]]], [:define, [:factorial, :x], [:define, [:iter, :y, :acc], [:if, [:zero?, :y], :acc, [:iter, [:-, :y, 1], [:*, :y, :acc]]]], [:iter, :x, 1]], [:define, [:null?, :object], [:eqv?, [:quote, []], :object]], [:define, [:list?, :object], [:or, [:null?, :object], [:and, [:pair?, :object], [:list?, [:cdr, :object]]]]], [:define, [:list, :".", :args], :args], [:define, [:length, :object], [:define, [:iter, :list, :acc], [:if, [:null?, :list], :acc, [:iter, [:cdr, :list], [:+, 1, :acc]]]], [:iter, :object, 0]], [:define, [:append, :first, :".", :rest], [:cond, [[:null?, :rest], :first], [[:null?, :first], [:apply, :append, :rest]], [:else, [:cons, [:car, :first], [:append, [:cdr, :first], [:apply, :append, :rest]]]]]], [:define, [:reverse, :object], [:if, [:null?, :object], :object, [:append, [:reverse, [:cdr, :object]], [:list, [:car, :object]]]]], [:define, [:"list-tail", :list, :k], [:do, [[:pair, :list, [:cdr, :pair]], [:i, :k, [:-, :i, 1]]], [[:zero?, :i], :pair]]], [:define, [:"list-ref", :list, :k], [:car, [:"list-tail", :list, :k]]], [:define, [:"list-transform-search", :transform], [:lambda, [:predicate], [:lambda, [:object, :list], [:do, [[:pair, :list, [:cdr, :pair]]], [[:or, [:null?, :pair], [:predicate, [:car, [:transform, :pair]], :object]], [:if, [:null?, :pair], false, [:transform, :pair]]]]]]], [:define, :"list-search", [:"list-transform-search", [:lambda, [:x], :x]]], [:define, :memq, [:"list-search", :eq?]], [:define, :memv, [:"list-search", :eqv?]], [:define, :member, [:"list-search", :equal?]], [:define, :"assoc-list-search", [:"list-transform-search", :car]], [:define, :assq, [:"assoc-list-search", :eq?]], [:define, :assv, [:"assoc-list-search", :eqv?]], [:define, :assoc, [:"assoc-list-search", :equal?]], [:define, [:map, :proc, :list1, :".", :list2], [:if, [:null?, :list1], :list1, [:if, [:null?, :list2], [:cons, [:proc, [:car, :list1]], [:map, :proc, [:cdr, :list1]]], [:"let*", [[:all, [:cons, :list1, :list2]], [:args, [:map, :car, :all]], [:rest, [:map, :cdr, :all]]], [:cons, [:apply, :proc, :args], [:apply, :map, [:cons, :proc, :rest]]]]]]], [:define, [:"for-each", :proc, :list1, :".", :list2], [:do, [[:pair, :list1, [:cdr, :pair]], [:others, :list2, [:map, :cdr, :others]]], [[:null?, :pair], [:quote, []]], [:apply, :proc, [:cons, [:car, :pair], [:map, :car, :others]]]]], [:define, [:"fold-right", :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:"fold-right", :proc, :value, [:cdr, :list]]]]], [:define, [:"fold-left", :proc, :value, :list], [:if, [:null?, :list], :value, [:"fold-left", :proc, [:proc, :value, [:car, :list]], [:cdr, :list]]]], [:define, [:sublist, :list, :start, :end], [:cond, [[:null?, :list], [:quote, []]], [[:>, :start, 0], [:sublist, [:cdr, :list], [:-, :start, 1], [:-, :end, 1]]], [[:<=, :end, 0], [:quote, []]], [:else, [:cons, [:car, :list], [:sublist, [:cdr, :list], 0, [:-, :end, 1]]]]]], [:define, [:char, :string], [:if, [:and, [:string?, :string], [:"=", [:"string-length", :string], 1]], [:"string-ref", :string, 0], [:quote, []]]], [:define, [:"char-upper-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 65], [:<=, :code, 90]]]]], [:define, [:"char-lower-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 97], [:<=, :code, 122]]]]], [:define, [:"char-alphabetic?", :char], [:or, [:"char-upper-case?", :char], [:"char-lower-case?", :char]]], [:define, [:"char-numeric?", :char], [:and, [:char?, :char], [:let, [[:code, [:"char->integer", :char]]], [:and, [:>=, :code, 48], [:<=, :code, 57]]]]], [:define, [:"char-whitespace?", :char], [:and, [:char?, :char], [:if, [:member, [:"char->integer", :char], [:quote, [9, 10, 32]]], true, false]]], [:define, [:"char-upcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 97], [:<=, :code, 122]], [:"integer->char", [:-, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-downcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 65], [:<=, :code, 90]], [:"integer->char", [:+, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-compare-ci", :operator], [:lambda, [:x, :y], [:operator, [:"char-downcase", :x], [:"char-downcase", :y]]]], [:define, :"char-ci=?", [:"char-compare-ci", :"char=?"]], [:define, :"char-ci?", [:"char-compare-ci", :"char>?"]], [:define, :"char-ci<=?", [:"char-compare-ci", :"char<=?"]], [:define, :"char-ci>=?", [:"char-compare-ci", :"char>=?"]], [:define, [:string, :".", :chars], [:"list->string", :chars]], [:define, [:"string-compare", :string1, :string2, :"char-less?", :"char-greater?"], [:if, [:or, [:not, [:string?, :string1]], [:not, [:string?, :string2]]], [:error, "Expected two strings as arguments"], [:do, [[:pair1, [:"string->list", :string1], [:cdr, :pair1]], [:pair2, [:"string->list", :string2], [:cdr, :pair2]], [:diff, [:quote, []]]], [[:integer?, :diff], :diff], [:set!, :diff, [:cond, [[:null?, :pair1], [:if, [:null?, :pair2], 0, -1]], [[:null?, :pair2], 1], [:else, [:let, [[:char1, [:car, :pair1]], [:char2, [:car, :pair2]]], [:cond, [[:"char-less?", :char1, :char2], -1], [[:"char-greater?", :char1, :char2], 1], [:else, [:quote, []]]]]]]]]]], [:define, [:"string=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci?"]]], [:define, [:"string?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-cistring", [:sublist, [:"string->list", :string], :start, :end]]], [:define, [:"list->string", :chars], [:"let*", [[:size, [:length, :chars]], [:str, [:"make-string", :size]]], [:do, [[:list, :chars, [:cdr, :list]], [:i, 0, [:+, :i, 1]]], [[:"=", :i, :size], :str], [:"string-set!", :str, :i, [:car, :list]]]]], [:define, [:"string->list", :string], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]], [:list, [:quote, []], [:cons, [:"string-ref", :string, [:-, :i, 1]], :list]]], [[:zero?, :i], :list]]]], [:define, [:"string-copy", :string], [:"list->string", [:"string->list", :string]]], [:define, [:"string-fill!", :string, :char], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]]], [[:zero?, :i], :string], [:"string-set!", :string, [:-, :i, 1], :char]]]], [:define, [:"string-append", :".", :strings], [:"list->string", [:apply, :append, [:map, :"string->list", :strings]]]], [:define, [:vector, :".", :args], [:"list->vector", :args]], [:define, [:"list->vector", :list], [:"let*", [[:size, [:length, :list]], [:"new-vector", [:"make-vector", :size]]], [:do, [[:i, 0, [:+, :i, 1]], [:pair, :list, [:cdr, :pair]]], [[:"=", :i, :size], :"new-vector"], [:"vector-set!", :"new-vector", :i, [:car, :pair]]]]], [:define, [:"vector->list", :vector], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]], [:pair, [:quote, []], [:cons, [:"vector-ref", :vector, [:-, :i, 1]], :pair]]], [[:zero?, :i], :pair]]], [:define, [:"vector-fill!", :vector, :fill], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]]], [[:zero?, :i], :vector], [:"vector-set!", :vector, [:-, :i, 1], :fill]]]] \ No newline at end of file +program [[:define, :quit, :exit], [:define, [:newline], [:display, "\n"]], [:define, [:force, :promise], [:promise]], [:define, :"call/cc", :"call-with-current-continuation"], [:define, :eq?, :eqv?], [:define, [:not, :x], [:if, :x, false, true]], [:define, :true, true], [:define, :false, false], [:define, [:boolean?, :x], [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], [:define, :number?, :complex?], [:define, [:exact?, :x], [:or, [:rational?, :x], [:and, [:not, [:zero?, [:"imag-part", :x]]], [:exact?, [:"real-part", :x]], [:exact?, [:"imag-part", :x]]]]], [:define, [:inexact?, :x], [:not, [:exact?, :x]]], [:define, [:"=", :".", :args], [:define, [:iter, :x, :rest], [:if, [:null?, :rest], true, [:let, [[:y, [:car, :rest]]], [:if, [:or, [:not, [:number?, :x]], [:not, [:number?, :y]], [:not, [:equal?, :x, :y]]], false, [:iter, :x, [:cdr, :rest]]]]]], [:iter, [:car, :args], [:cdr, :args]]], [:define, [:zero?, :x], [:eqv?, :x, 0]], [:define, [:positive?, :x], [:>, :x, 0]], [:define, [:negative?, :x], [:<, :x, 0]], [:define, [:odd?, :x], [:"=", 1, [:remainder, :x, 2]]], [:define, [:even?, :x], [:zero?, [:remainder, :x, 2]]], [:define, [:max, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:<=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:abs, :x], [:if, [:negative?, :x], [:-, :x], :x]], [:define, [:quotient, :x, :y], [:let, [[:result, [:/, :x, :y]]], [[:if, [:positive?, :result], :floor, :ceiling], :result]]], [:define, [:remainder, :x, :y], [:-, [:round, :x], [:*, [:round, :y], [:quotient, :x, :y]]]], [:define, [:modulo, :x, :y], [:+, [:remainder, :x, :y], [:if, [:negative?, [:*, :x, :y]], [:round, :y], 0]]], [:define, [:gcd, :x, :y, :".", :rest], [:if, [:null?, :rest], [:if, [:zero?, :y], [:abs, :x], [:gcd, :y, [:remainder, :x, :y]]], [:apply, :gcd, [:cons, [:gcd, :x, :y], :rest]]]], [:define, [:lcm, :x, :y, :".", :rest], [:if, [:null?, :rest], [:/, [:abs, [:*, :x, :y]], [:gcd, :x, :y]], [:apply, :lcm, [:cons, [:lcm, :x, :y], :rest]]]], [:define, :ceiling, :ceil], [:define, [:rationalize, :x, :tolerance], [:cond, [[:rational?, :x], :x], [[:not, [:zero?, [:"imag-part", :x]]], [:"make-rectangular", [:rationalize, [:"real-part", :x], :tolerance], [:rationalize, [:"imag-part", :x], :tolerance]]], [:else, [:"let*", [[:t, [:abs, :tolerance]], [:a, [:-, :x, :t]], [:b, [:+, :x, :t]]], [:do, [[:i, 1, [:+, :i, 1]], [:z, false]], [[:number?, :z], :z], [:let, [[:p, [:ceiling, [:*, :a, :i]]], [:q, [:floor, [:*, :b, :i]]]], [:if, [:<=, :p, :q], [:set!, :z, [:/, [:if, [:positive?, :p], :p, :q], :i]]]]]]]]], [:define, [:"make-polar", :magnitude, :angle], [:let, [[:re, [:*, :magnitude, [:cos, :angle]]], [:im, [:*, :magnitude, [:sin, :angle]]]], [:"make-rectangular", :re, :im]]], [:define, [:magnitude, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:sqrt, [:+, [:*, :re, :re], [:*, :im, :im]]]]], [:define, [:angle, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:atan, :im, :re]]], [:define, [:factorial, :x], [:define, [:iter, :y, :acc], [:if, [:zero?, :y], :acc, [:iter, [:-, :y, 1], [:*, :y, :acc]]]], [:iter, :x, 1]], [:define, [:null?, :object], [:eqv?, [:quote, []], :object]], [:define, [:list?, :object], [:or, [:null?, :object], [:and, [:pair?, :object], [:list?, [:cdr, :object]]]]], [:define, [:list, :".", :args], :args], [:define, [:length, :object], [:define, [:iter, :list, :acc], [:if, [:null?, :list], :acc, [:iter, [:cdr, :list], [:+, 1, :acc]]]], [:iter, :object, 0]], [:define, [:append, :first, :".", :rest], [:cond, [[:null?, :rest], :first], [[:null?, :first], [:apply, :append, :rest]], [:else, [:cons, [:car, :first], [:append, [:cdr, :first], [:apply, :append, :rest]]]]]], [:define, [:reverse, :object], [:if, [:null?, :object], :object, [:append, [:reverse, [:cdr, :object]], [:list, [:car, :object]]]]], [:define, [:"list-tail", :list, :k], [:do, [[:pair, :list, [:cdr, :pair]], [:i, :k, [:-, :i, 1]]], [[:zero?, :i], :pair]]], [:define, [:"list-ref", :list, :k], [:car, [:"list-tail", :list, :k]]], [:define, [:"list-transform-search", :transform], [:lambda, [:predicate], [:lambda, [:object, :list], [:do, [[:pair, :list, [:cdr, :pair]]], [[:or, [:null?, :pair], [:predicate, [:car, [:transform, :pair]], :object]], [:if, [:null?, :pair], false, [:transform, :pair]]]]]]], [:define, :"list-search", [:"list-transform-search", [:lambda, [:x], :x]]], [:define, :memq, [:"list-search", :eq?]], [:define, :memv, [:"list-search", :eqv?]], [:define, :member, [:"list-search", :equal?]], [:define, :"assoc-list-search", [:"list-transform-search", :car]], [:define, :assq, [:"assoc-list-search", :eq?]], [:define, :assv, [:"assoc-list-search", :eqv?]], [:define, :assoc, [:"assoc-list-search", :equal?]], [:define, [:map, :proc, :list1, :".", :list2], [:if, [:null?, :list1], :list1, [:if, [:null?, :list2], [:cons, [:proc, [:car, :list1]], [:map, :proc, [:cdr, :list1]]], [:"let*", [[:all, [:cons, :list1, :list2]], [:args, [:map, :car, :all]], [:rest, [:map, :cdr, :all]]], [:cons, [:apply, :proc, :args], [:apply, :map, [:cons, :proc, :rest]]]]]]], [:define, [:"for-each", :proc, :list1, :".", :list2], [:do, [[:pair, :list1, [:cdr, :pair]], [:others, :list2, [:map, :cdr, :others]]], [[:null?, :pair], [:quote, []]], [:apply, :proc, [:cons, [:car, :pair], [:map, :car, :others]]]]], [:define, [:"fold-right", :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:"fold-right", :proc, :value, [:cdr, :list]]]]], [:define, [:"fold-left", :proc, :value, :list], [:if, [:null?, :list], :value, [:"fold-left", :proc, [:proc, :value, [:car, :list]], [:cdr, :list]]]], [:define, [:sublist, :list, :start, :end], [:cond, [[:null?, :list], [:quote, []]], [[:>, :start, 0], [:sublist, [:cdr, :list], [:-, :start, 1], [:-, :end, 1]]], [[:<=, :end, 0], [:quote, []]], [:else, [:cons, [:car, :list], [:sublist, [:cdr, :list], 0, [:-, :end, 1]]]]]], [:define, [:char, :string], [:if, [:and, [:string?, :string], [:"=", [:"string-length", :string], 1]], [:"string-ref", :string, 0], [:quote, []]]], [:define, [:"char-upper-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 65], [:<=, :code, 90]]]]], [:define, [:"char-lower-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 97], [:<=, :code, 122]]]]], [:define, [:"char-alphabetic?", :char], [:or, [:"char-upper-case?", :char], [:"char-lower-case?", :char]]], [:define, [:"char-numeric?", :char], [:and, [:char?, :char], [:let, [[:code, [:"char->integer", :char]]], [:and, [:>=, :code, 48], [:<=, :code, 57]]]]], [:define, [:"char-whitespace?", :char], [:and, [:char?, :char], [:if, [:member, [:"char->integer", :char], [:quote, [9, 10, 32]]], true, false]]], [:define, [:"char-upcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 97], [:<=, :code, 122]], [:"integer->char", [:-, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-downcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 65], [:<=, :code, 90]], [:"integer->char", [:+, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-compare-ci", :operator], [:lambda, [:x, :y], [:operator, [:"char-downcase", :x], [:"char-downcase", :y]]]], [:define, :"char-ci=?", [:"char-compare-ci", :"char=?"]], [:define, :"char-ci?", [:"char-compare-ci", :"char>?"]], [:define, :"char-ci<=?", [:"char-compare-ci", :"char<=?"]], [:define, :"char-ci>=?", [:"char-compare-ci", :"char>=?"]], [:define, [:string, :".", :chars], [:"list->string", :chars]], [:define, [:"string-compare", :string1, :string2, :"char-less?", :"char-greater?"], [:if, [:or, [:not, [:string?, :string1]], [:not, [:string?, :string2]]], [:error, "Expected two strings as arguments"], [:do, [[:pair1, [:"string->list", :string1], [:cdr, :pair1]], [:pair2, [:"string->list", :string2], [:cdr, :pair2]], [:diff, [:quote, []]]], [[:integer?, :diff], :diff], [:set!, :diff, [:cond, [[:null?, :pair1], [:if, [:null?, :pair2], 0, -1]], [[:null?, :pair2], 1], [:else, [:let, [[:char1, [:car, :pair1]], [:char2, [:car, :pair2]]], [:cond, [[:"char-less?", :char1, :char2], -1], [[:"char-greater?", :char1, :char2], 1], [:else, [:quote, []]]]]]]]]]], [:define, [:"string=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci?"]]], [:define, [:"string?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-cistring", [:sublist, [:"string->list", :string], :start, :end]]], [:define, [:"list->string", :chars], [:"let*", [[:size, [:length, :chars]], [:str, [:"make-string", :size]]], [:do, [[:list, :chars, [:cdr, :list]], [:i, 0, [:+, :i, 1]]], [[:"=", :i, :size], :str], [:"string-set!", :str, :i, [:car, :list]]]]], [:define, [:"string->list", :string], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]], [:list, [:quote, []], [:cons, [:"string-ref", :string, [:-, :i, 1]], :list]]], [[:zero?, :i], :list]]]], [:define, [:"string-copy", :string], [:"list->string", [:"string->list", :string]]], [:define, [:"string-fill!", :string, :char], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]]], [[:zero?, :i], :string], [:"string-set!", :string, [:-, :i, 1], :char]]]], [:define, [:"string-append", :".", :strings], [:"list->string", [:apply, :append, [:map, :"string->list", :strings]]]], [:define, [:"string->keyword", :s], [:"string->symbol", [:"string-append", :s, ":"]]], [:define, [:vector, :".", :args], [:"list->vector", :args]], [:define, [:"list->vector", :list], [:"let*", [[:size, [:length, :list]], [:"new-vector", [:"make-vector", :size]]], [:do, [[:i, 0, [:+, :i, 1]], [:pair, :list, [:cdr, :pair]]], [[:"=", :i, :size], :"new-vector"], [:"vector-set!", :"new-vector", :i, [:car, :pair]]]]], [:define, [:"vector->list", :vector], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]], [:pair, [:quote, []], [:cons, [:"vector-ref", :vector, [:-, :i, 1]], :pair]]], [[:zero?, :i], :pair]]], [:define, [:"vector-fill!", :vector, :fill], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]]], [[:zero?, :i], :vector], [:"vector-set!", :vector, [:-, :i, 1], :fill]]]] \ No newline at end of file From fcae0827bed77d1a1589fe12b7affc583ff04ad9 Mon Sep 17 00:00:00 2001 From: Moritz Heidkamp Date: Sat, 18 Feb 2012 15:59:36 +0100 Subject: [PATCH 4/7] add `keyword.scm` builtin library containing a `get-keyword` procedure only so far. --- Rakefile | 2 +- lib/heist/builtin/compiled_library.rb | 2 +- lib/heist/builtin/lib/keyword.scm | 12 ++++++++++++ 3 files changed, 14 insertions(+), 2 deletions(-) create mode 100644 lib/heist/builtin/lib/keyword.scm diff --git a/Rakefile b/Rakefile index fe2be10..c2cf14b 100644 --- a/Rakefile +++ b/Rakefile @@ -2,7 +2,7 @@ require 'rubygems' require File.expand_path('../lib/heist', __FILE__) file "lib/heist/builtin/compiled_library.rb" do |t| - library_source = %w[util logic numeric list character string vector]. + library_source = %w[util logic numeric list character string vector keyword]. map { |l| File.read "lib/heist/builtin/lib/#{l}.scm" }. join("\n\n") diff --git a/lib/heist/builtin/compiled_library.rb b/lib/heist/builtin/compiled_library.rb index ed3bda4..112cb8c 100644 --- a/lib/heist/builtin/compiled_library.rb +++ b/lib/heist/builtin/compiled_library.rb @@ -1 +1 @@ -program [[:define, :quit, :exit], [:define, [:newline], [:display, "\n"]], [:define, [:force, :promise], [:promise]], [:define, :"call/cc", :"call-with-current-continuation"], [:define, :eq?, :eqv?], [:define, [:not, :x], [:if, :x, false, true]], [:define, :true, true], [:define, :false, false], [:define, [:boolean?, :x], [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], [:define, :number?, :complex?], [:define, [:exact?, :x], [:or, [:rational?, :x], [:and, [:not, [:zero?, [:"imag-part", :x]]], [:exact?, [:"real-part", :x]], [:exact?, [:"imag-part", :x]]]]], [:define, [:inexact?, :x], [:not, [:exact?, :x]]], [:define, [:"=", :".", :args], [:define, [:iter, :x, :rest], [:if, [:null?, :rest], true, [:let, [[:y, [:car, :rest]]], [:if, [:or, [:not, [:number?, :x]], [:not, [:number?, :y]], [:not, [:equal?, :x, :y]]], false, [:iter, :x, [:cdr, :rest]]]]]], [:iter, [:car, :args], [:cdr, :args]]], [:define, [:zero?, :x], [:eqv?, :x, 0]], [:define, [:positive?, :x], [:>, :x, 0]], [:define, [:negative?, :x], [:<, :x, 0]], [:define, [:odd?, :x], [:"=", 1, [:remainder, :x, 2]]], [:define, [:even?, :x], [:zero?, [:remainder, :x, 2]]], [:define, [:max, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:<=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:abs, :x], [:if, [:negative?, :x], [:-, :x], :x]], [:define, [:quotient, :x, :y], [:let, [[:result, [:/, :x, :y]]], [[:if, [:positive?, :result], :floor, :ceiling], :result]]], [:define, [:remainder, :x, :y], [:-, [:round, :x], [:*, [:round, :y], [:quotient, :x, :y]]]], [:define, [:modulo, :x, :y], [:+, [:remainder, :x, :y], [:if, [:negative?, [:*, :x, :y]], [:round, :y], 0]]], [:define, [:gcd, :x, :y, :".", :rest], [:if, [:null?, :rest], [:if, [:zero?, :y], [:abs, :x], [:gcd, :y, [:remainder, :x, :y]]], [:apply, :gcd, [:cons, [:gcd, :x, :y], :rest]]]], [:define, [:lcm, :x, :y, :".", :rest], [:if, [:null?, :rest], [:/, [:abs, [:*, :x, :y]], [:gcd, :x, :y]], [:apply, :lcm, [:cons, [:lcm, :x, :y], :rest]]]], [:define, :ceiling, :ceil], [:define, [:rationalize, :x, :tolerance], [:cond, [[:rational?, :x], :x], [[:not, [:zero?, [:"imag-part", :x]]], [:"make-rectangular", [:rationalize, [:"real-part", :x], :tolerance], [:rationalize, [:"imag-part", :x], :tolerance]]], [:else, [:"let*", [[:t, [:abs, :tolerance]], [:a, [:-, :x, :t]], [:b, [:+, :x, :t]]], [:do, [[:i, 1, [:+, :i, 1]], [:z, false]], [[:number?, :z], :z], [:let, [[:p, [:ceiling, [:*, :a, :i]]], [:q, [:floor, [:*, :b, :i]]]], [:if, [:<=, :p, :q], [:set!, :z, [:/, [:if, [:positive?, :p], :p, :q], :i]]]]]]]]], [:define, [:"make-polar", :magnitude, :angle], [:let, [[:re, [:*, :magnitude, [:cos, :angle]]], [:im, [:*, :magnitude, [:sin, :angle]]]], [:"make-rectangular", :re, :im]]], [:define, [:magnitude, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:sqrt, [:+, [:*, :re, :re], [:*, :im, :im]]]]], [:define, [:angle, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:atan, :im, :re]]], [:define, [:factorial, :x], [:define, [:iter, :y, :acc], [:if, [:zero?, :y], :acc, [:iter, [:-, :y, 1], [:*, :y, :acc]]]], [:iter, :x, 1]], [:define, [:null?, :object], [:eqv?, [:quote, []], :object]], [:define, [:list?, :object], [:or, [:null?, :object], [:and, [:pair?, :object], [:list?, [:cdr, :object]]]]], [:define, [:list, :".", :args], :args], [:define, [:length, :object], [:define, [:iter, :list, :acc], [:if, [:null?, :list], :acc, [:iter, [:cdr, :list], [:+, 1, :acc]]]], [:iter, :object, 0]], [:define, [:append, :first, :".", :rest], [:cond, [[:null?, :rest], :first], [[:null?, :first], [:apply, :append, :rest]], [:else, [:cons, [:car, :first], [:append, [:cdr, :first], [:apply, :append, :rest]]]]]], [:define, [:reverse, :object], [:if, [:null?, :object], :object, [:append, [:reverse, [:cdr, :object]], [:list, [:car, :object]]]]], [:define, [:"list-tail", :list, :k], [:do, [[:pair, :list, [:cdr, :pair]], [:i, :k, [:-, :i, 1]]], [[:zero?, :i], :pair]]], [:define, [:"list-ref", :list, :k], [:car, [:"list-tail", :list, :k]]], [:define, [:"list-transform-search", :transform], [:lambda, [:predicate], [:lambda, [:object, :list], [:do, [[:pair, :list, [:cdr, :pair]]], [[:or, [:null?, :pair], [:predicate, [:car, [:transform, :pair]], :object]], [:if, [:null?, :pair], false, [:transform, :pair]]]]]]], [:define, :"list-search", [:"list-transform-search", [:lambda, [:x], :x]]], [:define, :memq, [:"list-search", :eq?]], [:define, :memv, [:"list-search", :eqv?]], [:define, :member, [:"list-search", :equal?]], [:define, :"assoc-list-search", [:"list-transform-search", :car]], [:define, :assq, [:"assoc-list-search", :eq?]], [:define, :assv, [:"assoc-list-search", :eqv?]], [:define, :assoc, [:"assoc-list-search", :equal?]], [:define, [:map, :proc, :list1, :".", :list2], [:if, [:null?, :list1], :list1, [:if, [:null?, :list2], [:cons, [:proc, [:car, :list1]], [:map, :proc, [:cdr, :list1]]], [:"let*", [[:all, [:cons, :list1, :list2]], [:args, [:map, :car, :all]], [:rest, [:map, :cdr, :all]]], [:cons, [:apply, :proc, :args], [:apply, :map, [:cons, :proc, :rest]]]]]]], [:define, [:"for-each", :proc, :list1, :".", :list2], [:do, [[:pair, :list1, [:cdr, :pair]], [:others, :list2, [:map, :cdr, :others]]], [[:null?, :pair], [:quote, []]], [:apply, :proc, [:cons, [:car, :pair], [:map, :car, :others]]]]], [:define, [:"fold-right", :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:"fold-right", :proc, :value, [:cdr, :list]]]]], [:define, [:"fold-left", :proc, :value, :list], [:if, [:null?, :list], :value, [:"fold-left", :proc, [:proc, :value, [:car, :list]], [:cdr, :list]]]], [:define, [:sublist, :list, :start, :end], [:cond, [[:null?, :list], [:quote, []]], [[:>, :start, 0], [:sublist, [:cdr, :list], [:-, :start, 1], [:-, :end, 1]]], [[:<=, :end, 0], [:quote, []]], [:else, [:cons, [:car, :list], [:sublist, [:cdr, :list], 0, [:-, :end, 1]]]]]], [:define, [:char, :string], [:if, [:and, [:string?, :string], [:"=", [:"string-length", :string], 1]], [:"string-ref", :string, 0], [:quote, []]]], [:define, [:"char-upper-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 65], [:<=, :code, 90]]]]], [:define, [:"char-lower-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 97], [:<=, :code, 122]]]]], [:define, [:"char-alphabetic?", :char], [:or, [:"char-upper-case?", :char], [:"char-lower-case?", :char]]], [:define, [:"char-numeric?", :char], [:and, [:char?, :char], [:let, [[:code, [:"char->integer", :char]]], [:and, [:>=, :code, 48], [:<=, :code, 57]]]]], [:define, [:"char-whitespace?", :char], [:and, [:char?, :char], [:if, [:member, [:"char->integer", :char], [:quote, [9, 10, 32]]], true, false]]], [:define, [:"char-upcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 97], [:<=, :code, 122]], [:"integer->char", [:-, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-downcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 65], [:<=, :code, 90]], [:"integer->char", [:+, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-compare-ci", :operator], [:lambda, [:x, :y], [:operator, [:"char-downcase", :x], [:"char-downcase", :y]]]], [:define, :"char-ci=?", [:"char-compare-ci", :"char=?"]], [:define, :"char-ci?", [:"char-compare-ci", :"char>?"]], [:define, :"char-ci<=?", [:"char-compare-ci", :"char<=?"]], [:define, :"char-ci>=?", [:"char-compare-ci", :"char>=?"]], [:define, [:string, :".", :chars], [:"list->string", :chars]], [:define, [:"string-compare", :string1, :string2, :"char-less?", :"char-greater?"], [:if, [:or, [:not, [:string?, :string1]], [:not, [:string?, :string2]]], [:error, "Expected two strings as arguments"], [:do, [[:pair1, [:"string->list", :string1], [:cdr, :pair1]], [:pair2, [:"string->list", :string2], [:cdr, :pair2]], [:diff, [:quote, []]]], [[:integer?, :diff], :diff], [:set!, :diff, [:cond, [[:null?, :pair1], [:if, [:null?, :pair2], 0, -1]], [[:null?, :pair2], 1], [:else, [:let, [[:char1, [:car, :pair1]], [:char2, [:car, :pair2]]], [:cond, [[:"char-less?", :char1, :char2], -1], [[:"char-greater?", :char1, :char2], 1], [:else, [:quote, []]]]]]]]]]], [:define, [:"string=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci?"]]], [:define, [:"string?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-cistring", [:sublist, [:"string->list", :string], :start, :end]]], [:define, [:"list->string", :chars], [:"let*", [[:size, [:length, :chars]], [:str, [:"make-string", :size]]], [:do, [[:list, :chars, [:cdr, :list]], [:i, 0, [:+, :i, 1]]], [[:"=", :i, :size], :str], [:"string-set!", :str, :i, [:car, :list]]]]], [:define, [:"string->list", :string], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]], [:list, [:quote, []], [:cons, [:"string-ref", :string, [:-, :i, 1]], :list]]], [[:zero?, :i], :list]]]], [:define, [:"string-copy", :string], [:"list->string", [:"string->list", :string]]], [:define, [:"string-fill!", :string, :char], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]]], [[:zero?, :i], :string], [:"string-set!", :string, [:-, :i, 1], :char]]]], [:define, [:"string-append", :".", :strings], [:"list->string", [:apply, :append, [:map, :"string->list", :strings]]]], [:define, [:"string->keyword", :s], [:"string->symbol", [:"string-append", :s, ":"]]], [:define, [:vector, :".", :args], [:"list->vector", :args]], [:define, [:"list->vector", :list], [:"let*", [[:size, [:length, :list]], [:"new-vector", [:"make-vector", :size]]], [:do, [[:i, 0, [:+, :i, 1]], [:pair, :list, [:cdr, :pair]]], [[:"=", :i, :size], :"new-vector"], [:"vector-set!", :"new-vector", :i, [:car, :pair]]]]], [:define, [:"vector->list", :vector], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]], [:pair, [:quote, []], [:cons, [:"vector-ref", :vector, [:-, :i, 1]], :pair]]], [[:zero?, :i], :pair]]], [:define, [:"vector-fill!", :vector, :fill], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]]], [[:zero?, :i], :vector], [:"vector-set!", :vector, [:-, :i, 1], :fill]]]] \ No newline at end of file +program [[:define, :quit, :exit], [:define, [:newline], [:display, "\n"]], [:define, [:force, :promise], [:promise]], [:define, :"call/cc", :"call-with-current-continuation"], [:define, :eq?, :eqv?], [:define, [:not, :x], [:if, :x, false, true]], [:define, :true, true], [:define, :false, false], [:define, [:boolean?, :x], [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], [:define, :number?, :complex?], [:define, [:exact?, :x], [:or, [:rational?, :x], [:and, [:not, [:zero?, [:"imag-part", :x]]], [:exact?, [:"real-part", :x]], [:exact?, [:"imag-part", :x]]]]], [:define, [:inexact?, :x], [:not, [:exact?, :x]]], [:define, [:"=", :".", :args], [:define, [:iter, :x, :rest], [:if, [:null?, :rest], true, [:let, [[:y, [:car, :rest]]], [:if, [:or, [:not, [:number?, :x]], [:not, [:number?, :y]], [:not, [:equal?, :x, :y]]], false, [:iter, :x, [:cdr, :rest]]]]]], [:iter, [:car, :args], [:cdr, :args]]], [:define, [:zero?, :x], [:eqv?, :x, 0]], [:define, [:positive?, :x], [:>, :x, 0]], [:define, [:negative?, :x], [:<, :x, 0]], [:define, [:odd?, :x], [:"=", 1, [:remainder, :x, 2]]], [:define, [:even?, :x], [:zero?, [:remainder, :x, 2]]], [:define, [:max, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:<=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:abs, :x], [:if, [:negative?, :x], [:-, :x], :x]], [:define, [:quotient, :x, :y], [:let, [[:result, [:/, :x, :y]]], [[:if, [:positive?, :result], :floor, :ceiling], :result]]], [:define, [:remainder, :x, :y], [:-, [:round, :x], [:*, [:round, :y], [:quotient, :x, :y]]]], [:define, [:modulo, :x, :y], [:+, [:remainder, :x, :y], [:if, [:negative?, [:*, :x, :y]], [:round, :y], 0]]], [:define, [:gcd, :x, :y, :".", :rest], [:if, [:null?, :rest], [:if, [:zero?, :y], [:abs, :x], [:gcd, :y, [:remainder, :x, :y]]], [:apply, :gcd, [:cons, [:gcd, :x, :y], :rest]]]], [:define, [:lcm, :x, :y, :".", :rest], [:if, [:null?, :rest], [:/, [:abs, [:*, :x, :y]], [:gcd, :x, :y]], [:apply, :lcm, [:cons, [:lcm, :x, :y], :rest]]]], [:define, :ceiling, :ceil], [:define, [:rationalize, :x, :tolerance], [:cond, [[:rational?, :x], :x], [[:not, [:zero?, [:"imag-part", :x]]], [:"make-rectangular", [:rationalize, [:"real-part", :x], :tolerance], [:rationalize, [:"imag-part", :x], :tolerance]]], [:else, [:"let*", [[:t, [:abs, :tolerance]], [:a, [:-, :x, :t]], [:b, [:+, :x, :t]]], [:do, [[:i, 1, [:+, :i, 1]], [:z, false]], [[:number?, :z], :z], [:let, [[:p, [:ceiling, [:*, :a, :i]]], [:q, [:floor, [:*, :b, :i]]]], [:if, [:<=, :p, :q], [:set!, :z, [:/, [:if, [:positive?, :p], :p, :q], :i]]]]]]]]], [:define, [:"make-polar", :magnitude, :angle], [:let, [[:re, [:*, :magnitude, [:cos, :angle]]], [:im, [:*, :magnitude, [:sin, :angle]]]], [:"make-rectangular", :re, :im]]], [:define, [:magnitude, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:sqrt, [:+, [:*, :re, :re], [:*, :im, :im]]]]], [:define, [:angle, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:atan, :im, :re]]], [:define, [:factorial, :x], [:define, [:iter, :y, :acc], [:if, [:zero?, :y], :acc, [:iter, [:-, :y, 1], [:*, :y, :acc]]]], [:iter, :x, 1]], [:define, [:null?, :object], [:eqv?, [:quote, []], :object]], [:define, [:list?, :object], [:or, [:null?, :object], [:and, [:pair?, :object], [:list?, [:cdr, :object]]]]], [:define, [:list, :".", :args], :args], [:define, [:length, :object], [:define, [:iter, :list, :acc], [:if, [:null?, :list], :acc, [:iter, [:cdr, :list], [:+, 1, :acc]]]], [:iter, :object, 0]], [:define, [:append, :first, :".", :rest], [:cond, [[:null?, :rest], :first], [[:null?, :first], [:apply, :append, :rest]], [:else, [:cons, [:car, :first], [:append, [:cdr, :first], [:apply, :append, :rest]]]]]], [:define, [:reverse, :object], [:if, [:null?, :object], :object, [:append, [:reverse, [:cdr, :object]], [:list, [:car, :object]]]]], [:define, [:"list-tail", :list, :k], [:do, [[:pair, :list, [:cdr, :pair]], [:i, :k, [:-, :i, 1]]], [[:zero?, :i], :pair]]], [:define, [:"list-ref", :list, :k], [:car, [:"list-tail", :list, :k]]], [:define, [:"list-transform-search", :transform], [:lambda, [:predicate], [:lambda, [:object, :list], [:do, [[:pair, :list, [:cdr, :pair]]], [[:or, [:null?, :pair], [:predicate, [:car, [:transform, :pair]], :object]], [:if, [:null?, :pair], false, [:transform, :pair]]]]]]], [:define, :"list-search", [:"list-transform-search", [:lambda, [:x], :x]]], [:define, :memq, [:"list-search", :eq?]], [:define, :memv, [:"list-search", :eqv?]], [:define, :member, [:"list-search", :equal?]], [:define, :"assoc-list-search", [:"list-transform-search", :car]], [:define, :assq, [:"assoc-list-search", :eq?]], [:define, :assv, [:"assoc-list-search", :eqv?]], [:define, :assoc, [:"assoc-list-search", :equal?]], [:define, [:map, :proc, :list1, :".", :list2], [:if, [:null?, :list1], :list1, [:if, [:null?, :list2], [:cons, [:proc, [:car, :list1]], [:map, :proc, [:cdr, :list1]]], [:"let*", [[:all, [:cons, :list1, :list2]], [:args, [:map, :car, :all]], [:rest, [:map, :cdr, :all]]], [:cons, [:apply, :proc, :args], [:apply, :map, [:cons, :proc, :rest]]]]]]], [:define, [:"for-each", :proc, :list1, :".", :list2], [:do, [[:pair, :list1, [:cdr, :pair]], [:others, :list2, [:map, :cdr, :others]]], [[:null?, :pair], [:quote, []]], [:apply, :proc, [:cons, [:car, :pair], [:map, :car, :others]]]]], [:define, [:"fold-right", :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:"fold-right", :proc, :value, [:cdr, :list]]]]], [:define, [:"fold-left", :proc, :value, :list], [:if, [:null?, :list], :value, [:"fold-left", :proc, [:proc, :value, [:car, :list]], [:cdr, :list]]]], [:define, [:sublist, :list, :start, :end], [:cond, [[:null?, :list], [:quote, []]], [[:>, :start, 0], [:sublist, [:cdr, :list], [:-, :start, 1], [:-, :end, 1]]], [[:<=, :end, 0], [:quote, []]], [:else, [:cons, [:car, :list], [:sublist, [:cdr, :list], 0, [:-, :end, 1]]]]]], [:define, [:char, :string], [:if, [:and, [:string?, :string], [:"=", [:"string-length", :string], 1]], [:"string-ref", :string, 0], [:quote, []]]], [:define, [:"char-upper-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 65], [:<=, :code, 90]]]]], [:define, [:"char-lower-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 97], [:<=, :code, 122]]]]], [:define, [:"char-alphabetic?", :char], [:or, [:"char-upper-case?", :char], [:"char-lower-case?", :char]]], [:define, [:"char-numeric?", :char], [:and, [:char?, :char], [:let, [[:code, [:"char->integer", :char]]], [:and, [:>=, :code, 48], [:<=, :code, 57]]]]], [:define, [:"char-whitespace?", :char], [:and, [:char?, :char], [:if, [:member, [:"char->integer", :char], [:quote, [9, 10, 32]]], true, false]]], [:define, [:"char-upcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 97], [:<=, :code, 122]], [:"integer->char", [:-, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-downcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 65], [:<=, :code, 90]], [:"integer->char", [:+, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-compare-ci", :operator], [:lambda, [:x, :y], [:operator, [:"char-downcase", :x], [:"char-downcase", :y]]]], [:define, :"char-ci=?", [:"char-compare-ci", :"char=?"]], [:define, :"char-ci?", [:"char-compare-ci", :"char>?"]], [:define, :"char-ci<=?", [:"char-compare-ci", :"char<=?"]], [:define, :"char-ci>=?", [:"char-compare-ci", :"char>=?"]], [:define, [:string, :".", :chars], [:"list->string", :chars]], [:define, [:"string-compare", :string1, :string2, :"char-less?", :"char-greater?"], [:if, [:or, [:not, [:string?, :string1]], [:not, [:string?, :string2]]], [:error, "Expected two strings as arguments"], [:do, [[:pair1, [:"string->list", :string1], [:cdr, :pair1]], [:pair2, [:"string->list", :string2], [:cdr, :pair2]], [:diff, [:quote, []]]], [[:integer?, :diff], :diff], [:set!, :diff, [:cond, [[:null?, :pair1], [:if, [:null?, :pair2], 0, -1]], [[:null?, :pair2], 1], [:else, [:let, [[:char1, [:car, :pair1]], [:char2, [:car, :pair2]]], [:cond, [[:"char-less?", :char1, :char2], -1], [[:"char-greater?", :char1, :char2], 1], [:else, [:quote, []]]]]]]]]]], [:define, [:"string=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci?"]]], [:define, [:"string?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-cistring", [:sublist, [:"string->list", :string], :start, :end]]], [:define, [:"list->string", :chars], [:"let*", [[:size, [:length, :chars]], [:str, [:"make-string", :size]]], [:do, [[:list, :chars, [:cdr, :list]], [:i, 0, [:+, :i, 1]]], [[:"=", :i, :size], :str], [:"string-set!", :str, :i, [:car, :list]]]]], [:define, [:"string->list", :string], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]], [:list, [:quote, []], [:cons, [:"string-ref", :string, [:-, :i, 1]], :list]]], [[:zero?, :i], :list]]]], [:define, [:"string-copy", :string], [:"list->string", [:"string->list", :string]]], [:define, [:"string-fill!", :string, :char], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]]], [[:zero?, :i], :string], [:"string-set!", :string, [:-, :i, 1], :char]]]], [:define, [:"string-append", :".", :strings], [:"list->string", [:apply, :append, [:map, :"string->list", :strings]]]], [:define, [:"string->keyword", :s], [:"string->symbol", [:"string-append", :s, ":"]]], [:define, [:vector, :".", :args], [:"list->vector", :args]], [:define, [:"list->vector", :list], [:"let*", [[:size, [:length, :list]], [:"new-vector", [:"make-vector", :size]]], [:do, [[:i, 0, [:+, :i, 1]], [:pair, :list, [:cdr, :pair]]], [[:"=", :i, :size], :"new-vector"], [:"vector-set!", :"new-vector", :i, [:car, :pair]]]]], [:define, [:"vector->list", :vector], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]], [:pair, [:quote, []], [:cons, [:"vector-ref", :vector, [:-, :i, 1]], :pair]]], [[:zero?, :i], :pair]]], [:define, [:"vector-fill!", :vector, :fill], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]]], [[:zero?, :i], :vector], [:"vector-set!", :vector, [:-, :i, 1], :fill]]], [:define, [:"get-keyword", :keyword, :args, :".", :thunk], [:let, [[:default, [:if, [:pair?, :thunk], [:car, :thunk], [:lambda, [], false]]]], [:let, :loop, [[:args, :args]], [:cond, [[:null?, :args], [:default]], [[:eq?, :keyword, [:car, :args]], [:cadr, :args]], [:else, [:loop, [:cddr, :args]]]]]]]] \ No newline at end of file diff --git a/lib/heist/builtin/lib/keyword.scm b/lib/heist/builtin/lib/keyword.scm new file mode 100644 index 0000000..a3e7c43 --- /dev/null +++ b/lib/heist/builtin/lib/keyword.scm @@ -0,0 +1,12 @@ +; (get-keyword keyword args [default]) +; Returns the subsequent element to +keyword+ in +args+ if +; present. Otherwise returns the return value of applying the thunk +; +default+ or, if +default+ is not given, returns +#f+. +(define (get-keyword keyword args . thunk) + (let ((default (if (pair? thunk) (car thunk) (lambda () #f)))) + (let loop ((args args)) + (cond ((null? args) (default)) + ((eq? keyword (car args)) + (cadr args)) + (else + (loop (cddr args))))))) From e1428570062ff5104e7e6e1a0ab5e6bb791011f8 Mon Sep 17 00:00:00 2001 From: Moritz Heidkamp Date: Sat, 18 Feb 2012 16:11:35 +0100 Subject: [PATCH 5/7] implement a convenient but inefficient `let-keywords` macro that facilitates turning keyword argument lists into variable bindings. --- lib/heist/builtin/compiled_library.rb | 2 +- lib/heist/builtin/lib/keyword.scm | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/lib/heist/builtin/compiled_library.rb b/lib/heist/builtin/compiled_library.rb index 112cb8c..cb5b9e9 100644 --- a/lib/heist/builtin/compiled_library.rb +++ b/lib/heist/builtin/compiled_library.rb @@ -1 +1 @@ -program [[:define, :quit, :exit], [:define, [:newline], [:display, "\n"]], [:define, [:force, :promise], [:promise]], [:define, :"call/cc", :"call-with-current-continuation"], [:define, :eq?, :eqv?], [:define, [:not, :x], [:if, :x, false, true]], [:define, :true, true], [:define, :false, false], [:define, [:boolean?, :x], [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], [:define, :number?, :complex?], [:define, [:exact?, :x], [:or, [:rational?, :x], [:and, [:not, [:zero?, [:"imag-part", :x]]], [:exact?, [:"real-part", :x]], [:exact?, [:"imag-part", :x]]]]], [:define, [:inexact?, :x], [:not, [:exact?, :x]]], [:define, [:"=", :".", :args], [:define, [:iter, :x, :rest], [:if, [:null?, :rest], true, [:let, [[:y, [:car, :rest]]], [:if, [:or, [:not, [:number?, :x]], [:not, [:number?, :y]], [:not, [:equal?, :x, :y]]], false, [:iter, :x, [:cdr, :rest]]]]]], [:iter, [:car, :args], [:cdr, :args]]], [:define, [:zero?, :x], [:eqv?, :x, 0]], [:define, [:positive?, :x], [:>, :x, 0]], [:define, [:negative?, :x], [:<, :x, 0]], [:define, [:odd?, :x], [:"=", 1, [:remainder, :x, 2]]], [:define, [:even?, :x], [:zero?, [:remainder, :x, 2]]], [:define, [:max, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:<=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:abs, :x], [:if, [:negative?, :x], [:-, :x], :x]], [:define, [:quotient, :x, :y], [:let, [[:result, [:/, :x, :y]]], [[:if, [:positive?, :result], :floor, :ceiling], :result]]], [:define, [:remainder, :x, :y], [:-, [:round, :x], [:*, [:round, :y], [:quotient, :x, :y]]]], [:define, [:modulo, :x, :y], [:+, [:remainder, :x, :y], [:if, [:negative?, [:*, :x, :y]], [:round, :y], 0]]], [:define, [:gcd, :x, :y, :".", :rest], [:if, [:null?, :rest], [:if, [:zero?, :y], [:abs, :x], [:gcd, :y, [:remainder, :x, :y]]], [:apply, :gcd, [:cons, [:gcd, :x, :y], :rest]]]], [:define, [:lcm, :x, :y, :".", :rest], [:if, [:null?, :rest], [:/, [:abs, [:*, :x, :y]], [:gcd, :x, :y]], [:apply, :lcm, [:cons, [:lcm, :x, :y], :rest]]]], [:define, :ceiling, :ceil], [:define, [:rationalize, :x, :tolerance], [:cond, [[:rational?, :x], :x], [[:not, [:zero?, [:"imag-part", :x]]], [:"make-rectangular", [:rationalize, [:"real-part", :x], :tolerance], [:rationalize, [:"imag-part", :x], :tolerance]]], [:else, [:"let*", [[:t, [:abs, :tolerance]], [:a, [:-, :x, :t]], [:b, [:+, :x, :t]]], [:do, [[:i, 1, [:+, :i, 1]], [:z, false]], [[:number?, :z], :z], [:let, [[:p, [:ceiling, [:*, :a, :i]]], [:q, [:floor, [:*, :b, :i]]]], [:if, [:<=, :p, :q], [:set!, :z, [:/, [:if, [:positive?, :p], :p, :q], :i]]]]]]]]], [:define, [:"make-polar", :magnitude, :angle], [:let, [[:re, [:*, :magnitude, [:cos, :angle]]], [:im, [:*, :magnitude, [:sin, :angle]]]], [:"make-rectangular", :re, :im]]], [:define, [:magnitude, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:sqrt, [:+, [:*, :re, :re], [:*, :im, :im]]]]], [:define, [:angle, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:atan, :im, :re]]], [:define, [:factorial, :x], [:define, [:iter, :y, :acc], [:if, [:zero?, :y], :acc, [:iter, [:-, :y, 1], [:*, :y, :acc]]]], [:iter, :x, 1]], [:define, [:null?, :object], [:eqv?, [:quote, []], :object]], [:define, [:list?, :object], [:or, [:null?, :object], [:and, [:pair?, :object], [:list?, [:cdr, :object]]]]], [:define, [:list, :".", :args], :args], [:define, [:length, :object], [:define, [:iter, :list, :acc], [:if, [:null?, :list], :acc, [:iter, [:cdr, :list], [:+, 1, :acc]]]], [:iter, :object, 0]], [:define, [:append, :first, :".", :rest], [:cond, [[:null?, :rest], :first], [[:null?, :first], [:apply, :append, :rest]], [:else, [:cons, [:car, :first], [:append, [:cdr, :first], [:apply, :append, :rest]]]]]], [:define, [:reverse, :object], [:if, [:null?, :object], :object, [:append, [:reverse, [:cdr, :object]], [:list, [:car, :object]]]]], [:define, [:"list-tail", :list, :k], [:do, [[:pair, :list, [:cdr, :pair]], [:i, :k, [:-, :i, 1]]], [[:zero?, :i], :pair]]], [:define, [:"list-ref", :list, :k], [:car, [:"list-tail", :list, :k]]], [:define, [:"list-transform-search", :transform], [:lambda, [:predicate], [:lambda, [:object, :list], [:do, [[:pair, :list, [:cdr, :pair]]], [[:or, [:null?, :pair], [:predicate, [:car, [:transform, :pair]], :object]], [:if, [:null?, :pair], false, [:transform, :pair]]]]]]], [:define, :"list-search", [:"list-transform-search", [:lambda, [:x], :x]]], [:define, :memq, [:"list-search", :eq?]], [:define, :memv, [:"list-search", :eqv?]], [:define, :member, [:"list-search", :equal?]], [:define, :"assoc-list-search", [:"list-transform-search", :car]], [:define, :assq, [:"assoc-list-search", :eq?]], [:define, :assv, [:"assoc-list-search", :eqv?]], [:define, :assoc, [:"assoc-list-search", :equal?]], [:define, [:map, :proc, :list1, :".", :list2], [:if, [:null?, :list1], :list1, [:if, [:null?, :list2], [:cons, [:proc, [:car, :list1]], [:map, :proc, [:cdr, :list1]]], [:"let*", [[:all, [:cons, :list1, :list2]], [:args, [:map, :car, :all]], [:rest, [:map, :cdr, :all]]], [:cons, [:apply, :proc, :args], [:apply, :map, [:cons, :proc, :rest]]]]]]], [:define, [:"for-each", :proc, :list1, :".", :list2], [:do, [[:pair, :list1, [:cdr, :pair]], [:others, :list2, [:map, :cdr, :others]]], [[:null?, :pair], [:quote, []]], [:apply, :proc, [:cons, [:car, :pair], [:map, :car, :others]]]]], [:define, [:"fold-right", :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:"fold-right", :proc, :value, [:cdr, :list]]]]], [:define, [:"fold-left", :proc, :value, :list], [:if, [:null?, :list], :value, [:"fold-left", :proc, [:proc, :value, [:car, :list]], [:cdr, :list]]]], [:define, [:sublist, :list, :start, :end], [:cond, [[:null?, :list], [:quote, []]], [[:>, :start, 0], [:sublist, [:cdr, :list], [:-, :start, 1], [:-, :end, 1]]], [[:<=, :end, 0], [:quote, []]], [:else, [:cons, [:car, :list], [:sublist, [:cdr, :list], 0, [:-, :end, 1]]]]]], [:define, [:char, :string], [:if, [:and, [:string?, :string], [:"=", [:"string-length", :string], 1]], [:"string-ref", :string, 0], [:quote, []]]], [:define, [:"char-upper-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 65], [:<=, :code, 90]]]]], [:define, [:"char-lower-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 97], [:<=, :code, 122]]]]], [:define, [:"char-alphabetic?", :char], [:or, [:"char-upper-case?", :char], [:"char-lower-case?", :char]]], [:define, [:"char-numeric?", :char], [:and, [:char?, :char], [:let, [[:code, [:"char->integer", :char]]], [:and, [:>=, :code, 48], [:<=, :code, 57]]]]], [:define, [:"char-whitespace?", :char], [:and, [:char?, :char], [:if, [:member, [:"char->integer", :char], [:quote, [9, 10, 32]]], true, false]]], [:define, [:"char-upcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 97], [:<=, :code, 122]], [:"integer->char", [:-, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-downcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 65], [:<=, :code, 90]], [:"integer->char", [:+, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-compare-ci", :operator], [:lambda, [:x, :y], [:operator, [:"char-downcase", :x], [:"char-downcase", :y]]]], [:define, :"char-ci=?", [:"char-compare-ci", :"char=?"]], [:define, :"char-ci?", [:"char-compare-ci", :"char>?"]], [:define, :"char-ci<=?", [:"char-compare-ci", :"char<=?"]], [:define, :"char-ci>=?", [:"char-compare-ci", :"char>=?"]], [:define, [:string, :".", :chars], [:"list->string", :chars]], [:define, [:"string-compare", :string1, :string2, :"char-less?", :"char-greater?"], [:if, [:or, [:not, [:string?, :string1]], [:not, [:string?, :string2]]], [:error, "Expected two strings as arguments"], [:do, [[:pair1, [:"string->list", :string1], [:cdr, :pair1]], [:pair2, [:"string->list", :string2], [:cdr, :pair2]], [:diff, [:quote, []]]], [[:integer?, :diff], :diff], [:set!, :diff, [:cond, [[:null?, :pair1], [:if, [:null?, :pair2], 0, -1]], [[:null?, :pair2], 1], [:else, [:let, [[:char1, [:car, :pair1]], [:char2, [:car, :pair2]]], [:cond, [[:"char-less?", :char1, :char2], -1], [[:"char-greater?", :char1, :char2], 1], [:else, [:quote, []]]]]]]]]]], [:define, [:"string=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci?"]]], [:define, [:"string?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-cistring", [:sublist, [:"string->list", :string], :start, :end]]], [:define, [:"list->string", :chars], [:"let*", [[:size, [:length, :chars]], [:str, [:"make-string", :size]]], [:do, [[:list, :chars, [:cdr, :list]], [:i, 0, [:+, :i, 1]]], [[:"=", :i, :size], :str], [:"string-set!", :str, :i, [:car, :list]]]]], [:define, [:"string->list", :string], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]], [:list, [:quote, []], [:cons, [:"string-ref", :string, [:-, :i, 1]], :list]]], [[:zero?, :i], :list]]]], [:define, [:"string-copy", :string], [:"list->string", [:"string->list", :string]]], [:define, [:"string-fill!", :string, :char], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]]], [[:zero?, :i], :string], [:"string-set!", :string, [:-, :i, 1], :char]]]], [:define, [:"string-append", :".", :strings], [:"list->string", [:apply, :append, [:map, :"string->list", :strings]]]], [:define, [:"string->keyword", :s], [:"string->symbol", [:"string-append", :s, ":"]]], [:define, [:vector, :".", :args], [:"list->vector", :args]], [:define, [:"list->vector", :list], [:"let*", [[:size, [:length, :list]], [:"new-vector", [:"make-vector", :size]]], [:do, [[:i, 0, [:+, :i, 1]], [:pair, :list, [:cdr, :pair]]], [[:"=", :i, :size], :"new-vector"], [:"vector-set!", :"new-vector", :i, [:car, :pair]]]]], [:define, [:"vector->list", :vector], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]], [:pair, [:quote, []], [:cons, [:"vector-ref", :vector, [:-, :i, 1]], :pair]]], [[:zero?, :i], :pair]]], [:define, [:"vector-fill!", :vector, :fill], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]]], [[:zero?, :i], :vector], [:"vector-set!", :vector, [:-, :i, 1], :fill]]], [:define, [:"get-keyword", :keyword, :args, :".", :thunk], [:let, [[:default, [:if, [:pair?, :thunk], [:car, :thunk], [:lambda, [], false]]]], [:let, :loop, [[:args, :args]], [:cond, [[:null?, :args], [:default]], [[:eq?, :keyword, [:car, :args]], [:cadr, :args]], [:else, [:loop, [:cddr, :args]]]]]]]] \ No newline at end of file +program [[:define, :quit, :exit], [:define, [:newline], [:display, "\n"]], [:define, [:force, :promise], [:promise]], [:define, :"call/cc", :"call-with-current-continuation"], [:define, :eq?, :eqv?], [:define, [:not, :x], [:if, :x, false, true]], [:define, :true, true], [:define, :false, false], [:define, [:boolean?, :x], [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], [:define, :number?, :complex?], [:define, [:exact?, :x], [:or, [:rational?, :x], [:and, [:not, [:zero?, [:"imag-part", :x]]], [:exact?, [:"real-part", :x]], [:exact?, [:"imag-part", :x]]]]], [:define, [:inexact?, :x], [:not, [:exact?, :x]]], [:define, [:"=", :".", :args], [:define, [:iter, :x, :rest], [:if, [:null?, :rest], true, [:let, [[:y, [:car, :rest]]], [:if, [:or, [:not, [:number?, :x]], [:not, [:number?, :y]], [:not, [:equal?, :x, :y]]], false, [:iter, :x, [:cdr, :rest]]]]]], [:iter, [:car, :args], [:cdr, :args]]], [:define, [:zero?, :x], [:eqv?, :x, 0]], [:define, [:positive?, :x], [:>, :x, 0]], [:define, [:negative?, :x], [:<, :x, 0]], [:define, [:odd?, :x], [:"=", 1, [:remainder, :x, 2]]], [:define, [:even?, :x], [:zero?, [:remainder, :x, 2]]], [:define, [:max, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:<=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:abs, :x], [:if, [:negative?, :x], [:-, :x], :x]], [:define, [:quotient, :x, :y], [:let, [[:result, [:/, :x, :y]]], [[:if, [:positive?, :result], :floor, :ceiling], :result]]], [:define, [:remainder, :x, :y], [:-, [:round, :x], [:*, [:round, :y], [:quotient, :x, :y]]]], [:define, [:modulo, :x, :y], [:+, [:remainder, :x, :y], [:if, [:negative?, [:*, :x, :y]], [:round, :y], 0]]], [:define, [:gcd, :x, :y, :".", :rest], [:if, [:null?, :rest], [:if, [:zero?, :y], [:abs, :x], [:gcd, :y, [:remainder, :x, :y]]], [:apply, :gcd, [:cons, [:gcd, :x, :y], :rest]]]], [:define, [:lcm, :x, :y, :".", :rest], [:if, [:null?, :rest], [:/, [:abs, [:*, :x, :y]], [:gcd, :x, :y]], [:apply, :lcm, [:cons, [:lcm, :x, :y], :rest]]]], [:define, :ceiling, :ceil], [:define, [:rationalize, :x, :tolerance], [:cond, [[:rational?, :x], :x], [[:not, [:zero?, [:"imag-part", :x]]], [:"make-rectangular", [:rationalize, [:"real-part", :x], :tolerance], [:rationalize, [:"imag-part", :x], :tolerance]]], [:else, [:"let*", [[:t, [:abs, :tolerance]], [:a, [:-, :x, :t]], [:b, [:+, :x, :t]]], [:do, [[:i, 1, [:+, :i, 1]], [:z, false]], [[:number?, :z], :z], [:let, [[:p, [:ceiling, [:*, :a, :i]]], [:q, [:floor, [:*, :b, :i]]]], [:if, [:<=, :p, :q], [:set!, :z, [:/, [:if, [:positive?, :p], :p, :q], :i]]]]]]]]], [:define, [:"make-polar", :magnitude, :angle], [:let, [[:re, [:*, :magnitude, [:cos, :angle]]], [:im, [:*, :magnitude, [:sin, :angle]]]], [:"make-rectangular", :re, :im]]], [:define, [:magnitude, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:sqrt, [:+, [:*, :re, :re], [:*, :im, :im]]]]], [:define, [:angle, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:atan, :im, :re]]], [:define, [:factorial, :x], [:define, [:iter, :y, :acc], [:if, [:zero?, :y], :acc, [:iter, [:-, :y, 1], [:*, :y, :acc]]]], [:iter, :x, 1]], [:define, [:null?, :object], [:eqv?, [:quote, []], :object]], [:define, [:list?, :object], [:or, [:null?, :object], [:and, [:pair?, :object], [:list?, [:cdr, :object]]]]], [:define, [:list, :".", :args], :args], [:define, [:length, :object], [:define, [:iter, :list, :acc], [:if, [:null?, :list], :acc, [:iter, [:cdr, :list], [:+, 1, :acc]]]], [:iter, :object, 0]], [:define, [:append, :first, :".", :rest], [:cond, [[:null?, :rest], :first], [[:null?, :first], [:apply, :append, :rest]], [:else, [:cons, [:car, :first], [:append, [:cdr, :first], [:apply, :append, :rest]]]]]], [:define, [:reverse, :object], [:if, [:null?, :object], :object, [:append, [:reverse, [:cdr, :object]], [:list, [:car, :object]]]]], [:define, [:"list-tail", :list, :k], [:do, [[:pair, :list, [:cdr, :pair]], [:i, :k, [:-, :i, 1]]], [[:zero?, :i], :pair]]], [:define, [:"list-ref", :list, :k], [:car, [:"list-tail", :list, :k]]], [:define, [:"list-transform-search", :transform], [:lambda, [:predicate], [:lambda, [:object, :list], [:do, [[:pair, :list, [:cdr, :pair]]], [[:or, [:null?, :pair], [:predicate, [:car, [:transform, :pair]], :object]], [:if, [:null?, :pair], false, [:transform, :pair]]]]]]], [:define, :"list-search", [:"list-transform-search", [:lambda, [:x], :x]]], [:define, :memq, [:"list-search", :eq?]], [:define, :memv, [:"list-search", :eqv?]], [:define, :member, [:"list-search", :equal?]], [:define, :"assoc-list-search", [:"list-transform-search", :car]], [:define, :assq, [:"assoc-list-search", :eq?]], [:define, :assv, [:"assoc-list-search", :eqv?]], [:define, :assoc, [:"assoc-list-search", :equal?]], [:define, [:map, :proc, :list1, :".", :list2], [:if, [:null?, :list1], :list1, [:if, [:null?, :list2], [:cons, [:proc, [:car, :list1]], [:map, :proc, [:cdr, :list1]]], [:"let*", [[:all, [:cons, :list1, :list2]], [:args, [:map, :car, :all]], [:rest, [:map, :cdr, :all]]], [:cons, [:apply, :proc, :args], [:apply, :map, [:cons, :proc, :rest]]]]]]], [:define, [:"for-each", :proc, :list1, :".", :list2], [:do, [[:pair, :list1, [:cdr, :pair]], [:others, :list2, [:map, :cdr, :others]]], [[:null?, :pair], [:quote, []]], [:apply, :proc, [:cons, [:car, :pair], [:map, :car, :others]]]]], [:define, [:"fold-right", :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:"fold-right", :proc, :value, [:cdr, :list]]]]], [:define, [:"fold-left", :proc, :value, :list], [:if, [:null?, :list], :value, [:"fold-left", :proc, [:proc, :value, [:car, :list]], [:cdr, :list]]]], [:define, [:sublist, :list, :start, :end], [:cond, [[:null?, :list], [:quote, []]], [[:>, :start, 0], [:sublist, [:cdr, :list], [:-, :start, 1], [:-, :end, 1]]], [[:<=, :end, 0], [:quote, []]], [:else, [:cons, [:car, :list], [:sublist, [:cdr, :list], 0, [:-, :end, 1]]]]]], [:define, [:char, :string], [:if, [:and, [:string?, :string], [:"=", [:"string-length", :string], 1]], [:"string-ref", :string, 0], [:quote, []]]], [:define, [:"char-upper-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 65], [:<=, :code, 90]]]]], [:define, [:"char-lower-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 97], [:<=, :code, 122]]]]], [:define, [:"char-alphabetic?", :char], [:or, [:"char-upper-case?", :char], [:"char-lower-case?", :char]]], [:define, [:"char-numeric?", :char], [:and, [:char?, :char], [:let, [[:code, [:"char->integer", :char]]], [:and, [:>=, :code, 48], [:<=, :code, 57]]]]], [:define, [:"char-whitespace?", :char], [:and, [:char?, :char], [:if, [:member, [:"char->integer", :char], [:quote, [9, 10, 32]]], true, false]]], [:define, [:"char-upcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 97], [:<=, :code, 122]], [:"integer->char", [:-, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-downcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 65], [:<=, :code, 90]], [:"integer->char", [:+, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-compare-ci", :operator], [:lambda, [:x, :y], [:operator, [:"char-downcase", :x], [:"char-downcase", :y]]]], [:define, :"char-ci=?", [:"char-compare-ci", :"char=?"]], [:define, :"char-ci?", [:"char-compare-ci", :"char>?"]], [:define, :"char-ci<=?", [:"char-compare-ci", :"char<=?"]], [:define, :"char-ci>=?", [:"char-compare-ci", :"char>=?"]], [:define, [:string, :".", :chars], [:"list->string", :chars]], [:define, [:"string-compare", :string1, :string2, :"char-less?", :"char-greater?"], [:if, [:or, [:not, [:string?, :string1]], [:not, [:string?, :string2]]], [:error, "Expected two strings as arguments"], [:do, [[:pair1, [:"string->list", :string1], [:cdr, :pair1]], [:pair2, [:"string->list", :string2], [:cdr, :pair2]], [:diff, [:quote, []]]], [[:integer?, :diff], :diff], [:set!, :diff, [:cond, [[:null?, :pair1], [:if, [:null?, :pair2], 0, -1]], [[:null?, :pair2], 1], [:else, [:let, [[:char1, [:car, :pair1]], [:char2, [:car, :pair2]]], [:cond, [[:"char-less?", :char1, :char2], -1], [[:"char-greater?", :char1, :char2], 1], [:else, [:quote, []]]]]]]]]]], [:define, [:"string=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci?"]]], [:define, [:"string?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-cistring", [:sublist, [:"string->list", :string], :start, :end]]], [:define, [:"list->string", :chars], [:"let*", [[:size, [:length, :chars]], [:str, [:"make-string", :size]]], [:do, [[:list, :chars, [:cdr, :list]], [:i, 0, [:+, :i, 1]]], [[:"=", :i, :size], :str], [:"string-set!", :str, :i, [:car, :list]]]]], [:define, [:"string->list", :string], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]], [:list, [:quote, []], [:cons, [:"string-ref", :string, [:-, :i, 1]], :list]]], [[:zero?, :i], :list]]]], [:define, [:"string-copy", :string], [:"list->string", [:"string->list", :string]]], [:define, [:"string-fill!", :string, :char], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]]], [[:zero?, :i], :string], [:"string-set!", :string, [:-, :i, 1], :char]]]], [:define, [:"string-append", :".", :strings], [:"list->string", [:apply, :append, [:map, :"string->list", :strings]]]], [:define, [:"string->keyword", :s], [:"string->symbol", [:"string-append", :s, ":"]]], [:define, [:vector, :".", :args], [:"list->vector", :args]], [:define, [:"list->vector", :list], [:"let*", [[:size, [:length, :list]], [:"new-vector", [:"make-vector", :size]]], [:do, [[:i, 0, [:+, :i, 1]], [:pair, :list, [:cdr, :pair]]], [[:"=", :i, :size], :"new-vector"], [:"vector-set!", :"new-vector", :i, [:car, :pair]]]]], [:define, [:"vector->list", :vector], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]], [:pair, [:quote, []], [:cons, [:"vector-ref", :vector, [:-, :i, 1]], :pair]]], [[:zero?, :i], :pair]]], [:define, [:"vector-fill!", :vector, :fill], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]]], [[:zero?, :i], :vector], [:"vector-set!", :vector, [:-, :i, 1], :fill]]], [:define, [:"get-keyword", :keyword, :args, :".", :thunk], [:let, [[:default, [:if, [:pair?, :thunk], [:car, :thunk], [:lambda, [], false]]]], [:let, :loop, [[:args, :args]], [:cond, [[:null?, :args], [:default]], [[:eq?, :keyword, [:car, :args]], [:cadr, :args]], [:else, [:loop, [:cddr, :args]]]]]]], [:"define-syntax", :"let-keywords", [:"syntax-rules", [], [[:_, :args, [], :body, :"..."], :body, :"..."], [[:_, :args, [[:keyword, :default], :rest, :"..."], :body, :"..."], [:let, [[:keyword, [:"get-keyword", [:"string->keyword", [:"symbol->string", [:quote, :keyword]]], :args, [:lambda, [], :default]]]], [:"let-keywords", :args, [:rest, :"..."], :body, :"..."]]], [[:_, :args, [:keyword, :rest, :"..."], :body, :"..."], [:"let-keywords", :args, [[:keyword, false], :rest, :"..."], :body, :"..."]]]]] \ No newline at end of file diff --git a/lib/heist/builtin/lib/keyword.scm b/lib/heist/builtin/lib/keyword.scm index a3e7c43..2b5043e 100644 --- a/lib/heist/builtin/lib/keyword.scm +++ b/lib/heist/builtin/lib/keyword.scm @@ -10,3 +10,21 @@ (cadr args)) (else (loop (cddr args))))))) + +; (let-keywords args ((keyword default) keyword ...) body ...) +; Convenience syntax for binding a list of keyword arguments to variables. +; Note that this macro is very inefficient at the moment. +(define-syntax let-keywords + (syntax-rules () + ((_ args () body ...) body ...) + ((_ args ((keyword default) rest ...) body ...) + (let ((keyword (get-keyword + (string->keyword + (symbol->string 'keyword)) + args + (lambda () default)))) + (let-keywords args (rest ...) + body ...))) + ((_ args (keyword rest ...) body ...) + (let-keywords args ((keyword #f) rest ...) + body ...)))) From d7787090569f57c23ec8a530bc98075a7cd4d97d Mon Sep 17 00:00:00 2001 From: Moritz Heidkamp Date: Sat, 18 Feb 2012 16:22:22 +0100 Subject: [PATCH 6/7] turn `string->keyword` and `keyword->string` into primitives; change `Keyword` constructor to accept just the keyword name. --- lib/heist/builtin/compiled_library.rb | 2 +- lib/heist/builtin/lib/string.scm | 5 ----- lib/heist/builtin/primitives.rb | 14 ++++++++++++++ lib/heist/runtime/data/keyword.rb | 6 +++++- lib/heist/runtime/scope.rb | 2 +- 5 files changed, 21 insertions(+), 8 deletions(-) diff --git a/lib/heist/builtin/compiled_library.rb b/lib/heist/builtin/compiled_library.rb index cb5b9e9..ba7f02d 100644 --- a/lib/heist/builtin/compiled_library.rb +++ b/lib/heist/builtin/compiled_library.rb @@ -1 +1 @@ -program [[:define, :quit, :exit], [:define, [:newline], [:display, "\n"]], [:define, [:force, :promise], [:promise]], [:define, :"call/cc", :"call-with-current-continuation"], [:define, :eq?, :eqv?], [:define, [:not, :x], [:if, :x, false, true]], [:define, :true, true], [:define, :false, false], [:define, [:boolean?, :x], [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], [:define, :number?, :complex?], [:define, [:exact?, :x], [:or, [:rational?, :x], [:and, [:not, [:zero?, [:"imag-part", :x]]], [:exact?, [:"real-part", :x]], [:exact?, [:"imag-part", :x]]]]], [:define, [:inexact?, :x], [:not, [:exact?, :x]]], [:define, [:"=", :".", :args], [:define, [:iter, :x, :rest], [:if, [:null?, :rest], true, [:let, [[:y, [:car, :rest]]], [:if, [:or, [:not, [:number?, :x]], [:not, [:number?, :y]], [:not, [:equal?, :x, :y]]], false, [:iter, :x, [:cdr, :rest]]]]]], [:iter, [:car, :args], [:cdr, :args]]], [:define, [:zero?, :x], [:eqv?, :x, 0]], [:define, [:positive?, :x], [:>, :x, 0]], [:define, [:negative?, :x], [:<, :x, 0]], [:define, [:odd?, :x], [:"=", 1, [:remainder, :x, 2]]], [:define, [:even?, :x], [:zero?, [:remainder, :x, 2]]], [:define, [:max, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:<=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:abs, :x], [:if, [:negative?, :x], [:-, :x], :x]], [:define, [:quotient, :x, :y], [:let, [[:result, [:/, :x, :y]]], [[:if, [:positive?, :result], :floor, :ceiling], :result]]], [:define, [:remainder, :x, :y], [:-, [:round, :x], [:*, [:round, :y], [:quotient, :x, :y]]]], [:define, [:modulo, :x, :y], [:+, [:remainder, :x, :y], [:if, [:negative?, [:*, :x, :y]], [:round, :y], 0]]], [:define, [:gcd, :x, :y, :".", :rest], [:if, [:null?, :rest], [:if, [:zero?, :y], [:abs, :x], [:gcd, :y, [:remainder, :x, :y]]], [:apply, :gcd, [:cons, [:gcd, :x, :y], :rest]]]], [:define, [:lcm, :x, :y, :".", :rest], [:if, [:null?, :rest], [:/, [:abs, [:*, :x, :y]], [:gcd, :x, :y]], [:apply, :lcm, [:cons, [:lcm, :x, :y], :rest]]]], [:define, :ceiling, :ceil], [:define, [:rationalize, :x, :tolerance], [:cond, [[:rational?, :x], :x], [[:not, [:zero?, [:"imag-part", :x]]], [:"make-rectangular", [:rationalize, [:"real-part", :x], :tolerance], [:rationalize, [:"imag-part", :x], :tolerance]]], [:else, [:"let*", [[:t, [:abs, :tolerance]], [:a, [:-, :x, :t]], [:b, [:+, :x, :t]]], [:do, [[:i, 1, [:+, :i, 1]], [:z, false]], [[:number?, :z], :z], [:let, [[:p, [:ceiling, [:*, :a, :i]]], [:q, [:floor, [:*, :b, :i]]]], [:if, [:<=, :p, :q], [:set!, :z, [:/, [:if, [:positive?, :p], :p, :q], :i]]]]]]]]], [:define, [:"make-polar", :magnitude, :angle], [:let, [[:re, [:*, :magnitude, [:cos, :angle]]], [:im, [:*, :magnitude, [:sin, :angle]]]], [:"make-rectangular", :re, :im]]], [:define, [:magnitude, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:sqrt, [:+, [:*, :re, :re], [:*, :im, :im]]]]], [:define, [:angle, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:atan, :im, :re]]], [:define, [:factorial, :x], [:define, [:iter, :y, :acc], [:if, [:zero?, :y], :acc, [:iter, [:-, :y, 1], [:*, :y, :acc]]]], [:iter, :x, 1]], [:define, [:null?, :object], [:eqv?, [:quote, []], :object]], [:define, [:list?, :object], [:or, [:null?, :object], [:and, [:pair?, :object], [:list?, [:cdr, :object]]]]], [:define, [:list, :".", :args], :args], [:define, [:length, :object], [:define, [:iter, :list, :acc], [:if, [:null?, :list], :acc, [:iter, [:cdr, :list], [:+, 1, :acc]]]], [:iter, :object, 0]], [:define, [:append, :first, :".", :rest], [:cond, [[:null?, :rest], :first], [[:null?, :first], [:apply, :append, :rest]], [:else, [:cons, [:car, :first], [:append, [:cdr, :first], [:apply, :append, :rest]]]]]], [:define, [:reverse, :object], [:if, [:null?, :object], :object, [:append, [:reverse, [:cdr, :object]], [:list, [:car, :object]]]]], [:define, [:"list-tail", :list, :k], [:do, [[:pair, :list, [:cdr, :pair]], [:i, :k, [:-, :i, 1]]], [[:zero?, :i], :pair]]], [:define, [:"list-ref", :list, :k], [:car, [:"list-tail", :list, :k]]], [:define, [:"list-transform-search", :transform], [:lambda, [:predicate], [:lambda, [:object, :list], [:do, [[:pair, :list, [:cdr, :pair]]], [[:or, [:null?, :pair], [:predicate, [:car, [:transform, :pair]], :object]], [:if, [:null?, :pair], false, [:transform, :pair]]]]]]], [:define, :"list-search", [:"list-transform-search", [:lambda, [:x], :x]]], [:define, :memq, [:"list-search", :eq?]], [:define, :memv, [:"list-search", :eqv?]], [:define, :member, [:"list-search", :equal?]], [:define, :"assoc-list-search", [:"list-transform-search", :car]], [:define, :assq, [:"assoc-list-search", :eq?]], [:define, :assv, [:"assoc-list-search", :eqv?]], [:define, :assoc, [:"assoc-list-search", :equal?]], [:define, [:map, :proc, :list1, :".", :list2], [:if, [:null?, :list1], :list1, [:if, [:null?, :list2], [:cons, [:proc, [:car, :list1]], [:map, :proc, [:cdr, :list1]]], [:"let*", [[:all, [:cons, :list1, :list2]], [:args, [:map, :car, :all]], [:rest, [:map, :cdr, :all]]], [:cons, [:apply, :proc, :args], [:apply, :map, [:cons, :proc, :rest]]]]]]], [:define, [:"for-each", :proc, :list1, :".", :list2], [:do, [[:pair, :list1, [:cdr, :pair]], [:others, :list2, [:map, :cdr, :others]]], [[:null?, :pair], [:quote, []]], [:apply, :proc, [:cons, [:car, :pair], [:map, :car, :others]]]]], [:define, [:"fold-right", :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:"fold-right", :proc, :value, [:cdr, :list]]]]], [:define, [:"fold-left", :proc, :value, :list], [:if, [:null?, :list], :value, [:"fold-left", :proc, [:proc, :value, [:car, :list]], [:cdr, :list]]]], [:define, [:sublist, :list, :start, :end], [:cond, [[:null?, :list], [:quote, []]], [[:>, :start, 0], [:sublist, [:cdr, :list], [:-, :start, 1], [:-, :end, 1]]], [[:<=, :end, 0], [:quote, []]], [:else, [:cons, [:car, :list], [:sublist, [:cdr, :list], 0, [:-, :end, 1]]]]]], [:define, [:char, :string], [:if, [:and, [:string?, :string], [:"=", [:"string-length", :string], 1]], [:"string-ref", :string, 0], [:quote, []]]], [:define, [:"char-upper-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 65], [:<=, :code, 90]]]]], [:define, [:"char-lower-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 97], [:<=, :code, 122]]]]], [:define, [:"char-alphabetic?", :char], [:or, [:"char-upper-case?", :char], [:"char-lower-case?", :char]]], [:define, [:"char-numeric?", :char], [:and, [:char?, :char], [:let, [[:code, [:"char->integer", :char]]], [:and, [:>=, :code, 48], [:<=, :code, 57]]]]], [:define, [:"char-whitespace?", :char], [:and, [:char?, :char], [:if, [:member, [:"char->integer", :char], [:quote, [9, 10, 32]]], true, false]]], [:define, [:"char-upcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 97], [:<=, :code, 122]], [:"integer->char", [:-, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-downcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 65], [:<=, :code, 90]], [:"integer->char", [:+, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-compare-ci", :operator], [:lambda, [:x, :y], [:operator, [:"char-downcase", :x], [:"char-downcase", :y]]]], [:define, :"char-ci=?", [:"char-compare-ci", :"char=?"]], [:define, :"char-ci?", [:"char-compare-ci", :"char>?"]], [:define, :"char-ci<=?", [:"char-compare-ci", :"char<=?"]], [:define, :"char-ci>=?", [:"char-compare-ci", :"char>=?"]], [:define, [:string, :".", :chars], [:"list->string", :chars]], [:define, [:"string-compare", :string1, :string2, :"char-less?", :"char-greater?"], [:if, [:or, [:not, [:string?, :string1]], [:not, [:string?, :string2]]], [:error, "Expected two strings as arguments"], [:do, [[:pair1, [:"string->list", :string1], [:cdr, :pair1]], [:pair2, [:"string->list", :string2], [:cdr, :pair2]], [:diff, [:quote, []]]], [[:integer?, :diff], :diff], [:set!, :diff, [:cond, [[:null?, :pair1], [:if, [:null?, :pair2], 0, -1]], [[:null?, :pair2], 1], [:else, [:let, [[:char1, [:car, :pair1]], [:char2, [:car, :pair2]]], [:cond, [[:"char-less?", :char1, :char2], -1], [[:"char-greater?", :char1, :char2], 1], [:else, [:quote, []]]]]]]]]]], [:define, [:"string=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci?"]]], [:define, [:"string?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-cistring", [:sublist, [:"string->list", :string], :start, :end]]], [:define, [:"list->string", :chars], [:"let*", [[:size, [:length, :chars]], [:str, [:"make-string", :size]]], [:do, [[:list, :chars, [:cdr, :list]], [:i, 0, [:+, :i, 1]]], [[:"=", :i, :size], :str], [:"string-set!", :str, :i, [:car, :list]]]]], [:define, [:"string->list", :string], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]], [:list, [:quote, []], [:cons, [:"string-ref", :string, [:-, :i, 1]], :list]]], [[:zero?, :i], :list]]]], [:define, [:"string-copy", :string], [:"list->string", [:"string->list", :string]]], [:define, [:"string-fill!", :string, :char], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]]], [[:zero?, :i], :string], [:"string-set!", :string, [:-, :i, 1], :char]]]], [:define, [:"string-append", :".", :strings], [:"list->string", [:apply, :append, [:map, :"string->list", :strings]]]], [:define, [:"string->keyword", :s], [:"string->symbol", [:"string-append", :s, ":"]]], [:define, [:vector, :".", :args], [:"list->vector", :args]], [:define, [:"list->vector", :list], [:"let*", [[:size, [:length, :list]], [:"new-vector", [:"make-vector", :size]]], [:do, [[:i, 0, [:+, :i, 1]], [:pair, :list, [:cdr, :pair]]], [[:"=", :i, :size], :"new-vector"], [:"vector-set!", :"new-vector", :i, [:car, :pair]]]]], [:define, [:"vector->list", :vector], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]], [:pair, [:quote, []], [:cons, [:"vector-ref", :vector, [:-, :i, 1]], :pair]]], [[:zero?, :i], :pair]]], [:define, [:"vector-fill!", :vector, :fill], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]]], [[:zero?, :i], :vector], [:"vector-set!", :vector, [:-, :i, 1], :fill]]], [:define, [:"get-keyword", :keyword, :args, :".", :thunk], [:let, [[:default, [:if, [:pair?, :thunk], [:car, :thunk], [:lambda, [], false]]]], [:let, :loop, [[:args, :args]], [:cond, [[:null?, :args], [:default]], [[:eq?, :keyword, [:car, :args]], [:cadr, :args]], [:else, [:loop, [:cddr, :args]]]]]]], [:"define-syntax", :"let-keywords", [:"syntax-rules", [], [[:_, :args, [], :body, :"..."], :body, :"..."], [[:_, :args, [[:keyword, :default], :rest, :"..."], :body, :"..."], [:let, [[:keyword, [:"get-keyword", [:"string->keyword", [:"symbol->string", [:quote, :keyword]]], :args, [:lambda, [], :default]]]], [:"let-keywords", :args, [:rest, :"..."], :body, :"..."]]], [[:_, :args, [:keyword, :rest, :"..."], :body, :"..."], [:"let-keywords", :args, [[:keyword, false], :rest, :"..."], :body, :"..."]]]]] \ No newline at end of file +program [[:define, :quit, :exit], [:define, [:newline], [:display, "\n"]], [:define, [:force, :promise], [:promise]], [:define, :"call/cc", :"call-with-current-continuation"], [:define, :eq?, :eqv?], [:define, [:not, :x], [:if, :x, false, true]], [:define, :true, true], [:define, :false, false], [:define, [:boolean?, :x], [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], [:define, :number?, :complex?], [:define, [:exact?, :x], [:or, [:rational?, :x], [:and, [:not, [:zero?, [:"imag-part", :x]]], [:exact?, [:"real-part", :x]], [:exact?, [:"imag-part", :x]]]]], [:define, [:inexact?, :x], [:not, [:exact?, :x]]], [:define, [:"=", :".", :args], [:define, [:iter, :x, :rest], [:if, [:null?, :rest], true, [:let, [[:y, [:car, :rest]]], [:if, [:or, [:not, [:number?, :x]], [:not, [:number?, :y]], [:not, [:equal?, :x, :y]]], false, [:iter, :x, [:cdr, :rest]]]]]], [:iter, [:car, :args], [:cdr, :args]]], [:define, [:zero?, :x], [:eqv?, :x, 0]], [:define, [:positive?, :x], [:>, :x, 0]], [:define, [:negative?, :x], [:<, :x, 0]], [:define, [:odd?, :x], [:"=", 1, [:remainder, :x, 2]]], [:define, [:even?, :x], [:zero?, [:remainder, :x, 2]]], [:define, [:max, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:<=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:abs, :x], [:if, [:negative?, :x], [:-, :x], :x]], [:define, [:quotient, :x, :y], [:let, [[:result, [:/, :x, :y]]], [[:if, [:positive?, :result], :floor, :ceiling], :result]]], [:define, [:remainder, :x, :y], [:-, [:round, :x], [:*, [:round, :y], [:quotient, :x, :y]]]], [:define, [:modulo, :x, :y], [:+, [:remainder, :x, :y], [:if, [:negative?, [:*, :x, :y]], [:round, :y], 0]]], [:define, [:gcd, :x, :y, :".", :rest], [:if, [:null?, :rest], [:if, [:zero?, :y], [:abs, :x], [:gcd, :y, [:remainder, :x, :y]]], [:apply, :gcd, [:cons, [:gcd, :x, :y], :rest]]]], [:define, [:lcm, :x, :y, :".", :rest], [:if, [:null?, :rest], [:/, [:abs, [:*, :x, :y]], [:gcd, :x, :y]], [:apply, :lcm, [:cons, [:lcm, :x, :y], :rest]]]], [:define, :ceiling, :ceil], [:define, [:rationalize, :x, :tolerance], [:cond, [[:rational?, :x], :x], [[:not, [:zero?, [:"imag-part", :x]]], [:"make-rectangular", [:rationalize, [:"real-part", :x], :tolerance], [:rationalize, [:"imag-part", :x], :tolerance]]], [:else, [:"let*", [[:t, [:abs, :tolerance]], [:a, [:-, :x, :t]], [:b, [:+, :x, :t]]], [:do, [[:i, 1, [:+, :i, 1]], [:z, false]], [[:number?, :z], :z], [:let, [[:p, [:ceiling, [:*, :a, :i]]], [:q, [:floor, [:*, :b, :i]]]], [:if, [:<=, :p, :q], [:set!, :z, [:/, [:if, [:positive?, :p], :p, :q], :i]]]]]]]]], [:define, [:"make-polar", :magnitude, :angle], [:let, [[:re, [:*, :magnitude, [:cos, :angle]]], [:im, [:*, :magnitude, [:sin, :angle]]]], [:"make-rectangular", :re, :im]]], [:define, [:magnitude, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:sqrt, [:+, [:*, :re, :re], [:*, :im, :im]]]]], [:define, [:angle, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:atan, :im, :re]]], [:define, [:factorial, :x], [:define, [:iter, :y, :acc], [:if, [:zero?, :y], :acc, [:iter, [:-, :y, 1], [:*, :y, :acc]]]], [:iter, :x, 1]], [:define, [:null?, :object], [:eqv?, [:quote, []], :object]], [:define, [:list?, :object], [:or, [:null?, :object], [:and, [:pair?, :object], [:list?, [:cdr, :object]]]]], [:define, [:list, :".", :args], :args], [:define, [:length, :object], [:define, [:iter, :list, :acc], [:if, [:null?, :list], :acc, [:iter, [:cdr, :list], [:+, 1, :acc]]]], [:iter, :object, 0]], [:define, [:append, :first, :".", :rest], [:cond, [[:null?, :rest], :first], [[:null?, :first], [:apply, :append, :rest]], [:else, [:cons, [:car, :first], [:append, [:cdr, :first], [:apply, :append, :rest]]]]]], [:define, [:reverse, :object], [:if, [:null?, :object], :object, [:append, [:reverse, [:cdr, :object]], [:list, [:car, :object]]]]], [:define, [:"list-tail", :list, :k], [:do, [[:pair, :list, [:cdr, :pair]], [:i, :k, [:-, :i, 1]]], [[:zero?, :i], :pair]]], [:define, [:"list-ref", :list, :k], [:car, [:"list-tail", :list, :k]]], [:define, [:"list-transform-search", :transform], [:lambda, [:predicate], [:lambda, [:object, :list], [:do, [[:pair, :list, [:cdr, :pair]]], [[:or, [:null?, :pair], [:predicate, [:car, [:transform, :pair]], :object]], [:if, [:null?, :pair], false, [:transform, :pair]]]]]]], [:define, :"list-search", [:"list-transform-search", [:lambda, [:x], :x]]], [:define, :memq, [:"list-search", :eq?]], [:define, :memv, [:"list-search", :eqv?]], [:define, :member, [:"list-search", :equal?]], [:define, :"assoc-list-search", [:"list-transform-search", :car]], [:define, :assq, [:"assoc-list-search", :eq?]], [:define, :assv, [:"assoc-list-search", :eqv?]], [:define, :assoc, [:"assoc-list-search", :equal?]], [:define, [:map, :proc, :list1, :".", :list2], [:if, [:null?, :list1], :list1, [:if, [:null?, :list2], [:cons, [:proc, [:car, :list1]], [:map, :proc, [:cdr, :list1]]], [:"let*", [[:all, [:cons, :list1, :list2]], [:args, [:map, :car, :all]], [:rest, [:map, :cdr, :all]]], [:cons, [:apply, :proc, :args], [:apply, :map, [:cons, :proc, :rest]]]]]]], [:define, [:"for-each", :proc, :list1, :".", :list2], [:do, [[:pair, :list1, [:cdr, :pair]], [:others, :list2, [:map, :cdr, :others]]], [[:null?, :pair], [:quote, []]], [:apply, :proc, [:cons, [:car, :pair], [:map, :car, :others]]]]], [:define, [:"fold-right", :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:"fold-right", :proc, :value, [:cdr, :list]]]]], [:define, [:"fold-left", :proc, :value, :list], [:if, [:null?, :list], :value, [:"fold-left", :proc, [:proc, :value, [:car, :list]], [:cdr, :list]]]], [:define, [:sublist, :list, :start, :end], [:cond, [[:null?, :list], [:quote, []]], [[:>, :start, 0], [:sublist, [:cdr, :list], [:-, :start, 1], [:-, :end, 1]]], [[:<=, :end, 0], [:quote, []]], [:else, [:cons, [:car, :list], [:sublist, [:cdr, :list], 0, [:-, :end, 1]]]]]], [:define, [:char, :string], [:if, [:and, [:string?, :string], [:"=", [:"string-length", :string], 1]], [:"string-ref", :string, 0], [:quote, []]]], [:define, [:"char-upper-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 65], [:<=, :code, 90]]]]], [:define, [:"char-lower-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 97], [:<=, :code, 122]]]]], [:define, [:"char-alphabetic?", :char], [:or, [:"char-upper-case?", :char], [:"char-lower-case?", :char]]], [:define, [:"char-numeric?", :char], [:and, [:char?, :char], [:let, [[:code, [:"char->integer", :char]]], [:and, [:>=, :code, 48], [:<=, :code, 57]]]]], [:define, [:"char-whitespace?", :char], [:and, [:char?, :char], [:if, [:member, [:"char->integer", :char], [:quote, [9, 10, 32]]], true, false]]], [:define, [:"char-upcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 97], [:<=, :code, 122]], [:"integer->char", [:-, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-downcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 65], [:<=, :code, 90]], [:"integer->char", [:+, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-compare-ci", :operator], [:lambda, [:x, :y], [:operator, [:"char-downcase", :x], [:"char-downcase", :y]]]], [:define, :"char-ci=?", [:"char-compare-ci", :"char=?"]], [:define, :"char-ci?", [:"char-compare-ci", :"char>?"]], [:define, :"char-ci<=?", [:"char-compare-ci", :"char<=?"]], [:define, :"char-ci>=?", [:"char-compare-ci", :"char>=?"]], [:define, [:string, :".", :chars], [:"list->string", :chars]], [:define, [:"string-compare", :string1, :string2, :"char-less?", :"char-greater?"], [:if, [:or, [:not, [:string?, :string1]], [:not, [:string?, :string2]]], [:error, "Expected two strings as arguments"], [:do, [[:pair1, [:"string->list", :string1], [:cdr, :pair1]], [:pair2, [:"string->list", :string2], [:cdr, :pair2]], [:diff, [:quote, []]]], [[:integer?, :diff], :diff], [:set!, :diff, [:cond, [[:null?, :pair1], [:if, [:null?, :pair2], 0, -1]], [[:null?, :pair2], 1], [:else, [:let, [[:char1, [:car, :pair1]], [:char2, [:car, :pair2]]], [:cond, [[:"char-less?", :char1, :char2], -1], [[:"char-greater?", :char1, :char2], 1], [:else, [:quote, []]]]]]]]]]], [:define, [:"string=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci?"]]], [:define, [:"string?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-cistring", [:sublist, [:"string->list", :string], :start, :end]]], [:define, [:"list->string", :chars], [:"let*", [[:size, [:length, :chars]], [:str, [:"make-string", :size]]], [:do, [[:list, :chars, [:cdr, :list]], [:i, 0, [:+, :i, 1]]], [[:"=", :i, :size], :str], [:"string-set!", :str, :i, [:car, :list]]]]], [:define, [:"string->list", :string], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]], [:list, [:quote, []], [:cons, [:"string-ref", :string, [:-, :i, 1]], :list]]], [[:zero?, :i], :list]]]], [:define, [:"string-copy", :string], [:"list->string", [:"string->list", :string]]], [:define, [:"string-fill!", :string, :char], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]]], [[:zero?, :i], :string], [:"string-set!", :string, [:-, :i, 1], :char]]]], [:define, [:"string-append", :".", :strings], [:"list->string", [:apply, :append, [:map, :"string->list", :strings]]]], [:define, [:vector, :".", :args], [:"list->vector", :args]], [:define, [:"list->vector", :list], [:"let*", [[:size, [:length, :list]], [:"new-vector", [:"make-vector", :size]]], [:do, [[:i, 0, [:+, :i, 1]], [:pair, :list, [:cdr, :pair]]], [[:"=", :i, :size], :"new-vector"], [:"vector-set!", :"new-vector", :i, [:car, :pair]]]]], [:define, [:"vector->list", :vector], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]], [:pair, [:quote, []], [:cons, [:"vector-ref", :vector, [:-, :i, 1]], :pair]]], [[:zero?, :i], :pair]]], [:define, [:"vector-fill!", :vector, :fill], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]]], [[:zero?, :i], :vector], [:"vector-set!", :vector, [:-, :i, 1], :fill]]], [:define, [:"get-keyword", :keyword, :args, :".", :thunk], [:let, [[:default, [:if, [:pair?, :thunk], [:car, :thunk], [:lambda, [], false]]]], [:let, :loop, [[:args, :args]], [:cond, [[:null?, :args], [:default]], [[:eq?, :keyword, [:car, :args]], [:cadr, :args]], [:else, [:loop, [:cddr, :args]]]]]]], [:"define-syntax", :"let-keywords", [:"syntax-rules", [], [[:_, :args, [], :body, :"..."], :body, :"..."], [[:_, :args, [[:keyword, :default], :rest, :"..."], :body, :"..."], [:let, [[:keyword, [:"get-keyword", [:"string->keyword", [:"symbol->string", [:quote, :keyword]]], :args, [:lambda, [], :default]]]], [:"let-keywords", :args, [:rest, :"..."], :body, :"..."]]], [[:_, :args, [:keyword, :rest, :"..."], :body, :"..."], [:"let-keywords", :args, [[:keyword, false], :rest, :"..."], :body, :"..."]]]]] \ No newline at end of file diff --git a/lib/heist/builtin/lib/string.scm b/lib/heist/builtin/lib/string.scm index ed54ed7..0911bcd 100644 --- a/lib/heist/builtin/lib/string.scm +++ b/lib/heist/builtin/lib/string.scm @@ -115,8 +115,3 @@ ; Returns a new string formed by concatenating the arguments (define (string-append . strings) (list->string (apply append (map string->list strings)))) - -; (string->keyword string) -; Returns a keyword, i.e. suffixes the string with ":" and turns it into a symbol -(define (string->keyword s) - (string->symbol (string-append s ":"))) diff --git a/lib/heist/builtin/primitives.rb b/lib/heist/builtin/primitives.rb index c955249..24e9d50 100644 --- a/lib/heist/builtin/primitives.rb +++ b/lib/heist/builtin/primitives.rb @@ -340,6 +340,20 @@ #---------------------------------------------------------------- +# Keyword functions + +# Returns the string representing the name of the given keyword +define('keyword->string') do |keyword| + keyword.keyword_name +end + +# Returns the keyword whose name is the given string +define('string->keyword') do |string| + Keyword.new(string) +end + +#---------------------------------------------------------------- + # Character functions # Returns true iff the two characters are equal diff --git a/lib/heist/runtime/data/keyword.rb b/lib/heist/runtime/data/keyword.rb index cc76ef1..4cebac5 100644 --- a/lib/heist/runtime/data/keyword.rb +++ b/lib/heist/runtime/data/keyword.rb @@ -6,11 +6,15 @@ class Runtime # +keyword?+ predicate. class Keyword < Identifier + attr_reader :keyword_name + # Since keywords need never be renamed they don't need an # +original_name+ argument. def initialize(name) - super(name) + @keyword_name = name + super("#{name}:") end + end end diff --git a/lib/heist/runtime/scope.rb b/lib/heist/runtime/scope.rb index ad28887..10902ce 100644 --- a/lib/heist/runtime/scope.rb +++ b/lib/heist/runtime/scope.rb @@ -38,7 +38,7 @@ def initialize(parent = {}) # def [](name) name = to_name(name) - return Keyword.new(name) if name.end_with?(':') + return Keyword.new(name[0..-2]) if name.end_with?(':') bound = @symbols.has_key?(name) raise UndefinedVariable.new( From 680f833dab558767efb37613c583f0bf54407236 Mon Sep 17 00:00:00 2001 From: Moritz Heidkamp Date: Sat, 18 Feb 2012 16:49:04 +0100 Subject: [PATCH 7/7] fix bug in `let-keywords` where all but the first expression of `body ...` was dropped. --- lib/heist/builtin/compiled_library.rb | 2 +- lib/heist/builtin/lib/keyword.scm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/heist/builtin/compiled_library.rb b/lib/heist/builtin/compiled_library.rb index ba7f02d..b24e74e 100644 --- a/lib/heist/builtin/compiled_library.rb +++ b/lib/heist/builtin/compiled_library.rb @@ -1 +1 @@ -program [[:define, :quit, :exit], [:define, [:newline], [:display, "\n"]], [:define, [:force, :promise], [:promise]], [:define, :"call/cc", :"call-with-current-continuation"], [:define, :eq?, :eqv?], [:define, [:not, :x], [:if, :x, false, true]], [:define, :true, true], [:define, :false, false], [:define, [:boolean?, :x], [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], [:define, :number?, :complex?], [:define, [:exact?, :x], [:or, [:rational?, :x], [:and, [:not, [:zero?, [:"imag-part", :x]]], [:exact?, [:"real-part", :x]], [:exact?, [:"imag-part", :x]]]]], [:define, [:inexact?, :x], [:not, [:exact?, :x]]], [:define, [:"=", :".", :args], [:define, [:iter, :x, :rest], [:if, [:null?, :rest], true, [:let, [[:y, [:car, :rest]]], [:if, [:or, [:not, [:number?, :x]], [:not, [:number?, :y]], [:not, [:equal?, :x, :y]]], false, [:iter, :x, [:cdr, :rest]]]]]], [:iter, [:car, :args], [:cdr, :args]]], [:define, [:zero?, :x], [:eqv?, :x, 0]], [:define, [:positive?, :x], [:>, :x, 0]], [:define, [:negative?, :x], [:<, :x, 0]], [:define, [:odd?, :x], [:"=", 1, [:remainder, :x, 2]]], [:define, [:even?, :x], [:zero?, [:remainder, :x, 2]]], [:define, [:max, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:<=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:abs, :x], [:if, [:negative?, :x], [:-, :x], :x]], [:define, [:quotient, :x, :y], [:let, [[:result, [:/, :x, :y]]], [[:if, [:positive?, :result], :floor, :ceiling], :result]]], [:define, [:remainder, :x, :y], [:-, [:round, :x], [:*, [:round, :y], [:quotient, :x, :y]]]], [:define, [:modulo, :x, :y], [:+, [:remainder, :x, :y], [:if, [:negative?, [:*, :x, :y]], [:round, :y], 0]]], [:define, [:gcd, :x, :y, :".", :rest], [:if, [:null?, :rest], [:if, [:zero?, :y], [:abs, :x], [:gcd, :y, [:remainder, :x, :y]]], [:apply, :gcd, [:cons, [:gcd, :x, :y], :rest]]]], [:define, [:lcm, :x, :y, :".", :rest], [:if, [:null?, :rest], [:/, [:abs, [:*, :x, :y]], [:gcd, :x, :y]], [:apply, :lcm, [:cons, [:lcm, :x, :y], :rest]]]], [:define, :ceiling, :ceil], [:define, [:rationalize, :x, :tolerance], [:cond, [[:rational?, :x], :x], [[:not, [:zero?, [:"imag-part", :x]]], [:"make-rectangular", [:rationalize, [:"real-part", :x], :tolerance], [:rationalize, [:"imag-part", :x], :tolerance]]], [:else, [:"let*", [[:t, [:abs, :tolerance]], [:a, [:-, :x, :t]], [:b, [:+, :x, :t]]], [:do, [[:i, 1, [:+, :i, 1]], [:z, false]], [[:number?, :z], :z], [:let, [[:p, [:ceiling, [:*, :a, :i]]], [:q, [:floor, [:*, :b, :i]]]], [:if, [:<=, :p, :q], [:set!, :z, [:/, [:if, [:positive?, :p], :p, :q], :i]]]]]]]]], [:define, [:"make-polar", :magnitude, :angle], [:let, [[:re, [:*, :magnitude, [:cos, :angle]]], [:im, [:*, :magnitude, [:sin, :angle]]]], [:"make-rectangular", :re, :im]]], [:define, [:magnitude, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:sqrt, [:+, [:*, :re, :re], [:*, :im, :im]]]]], [:define, [:angle, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:atan, :im, :re]]], [:define, [:factorial, :x], [:define, [:iter, :y, :acc], [:if, [:zero?, :y], :acc, [:iter, [:-, :y, 1], [:*, :y, :acc]]]], [:iter, :x, 1]], [:define, [:null?, :object], [:eqv?, [:quote, []], :object]], [:define, [:list?, :object], [:or, [:null?, :object], [:and, [:pair?, :object], [:list?, [:cdr, :object]]]]], [:define, [:list, :".", :args], :args], [:define, [:length, :object], [:define, [:iter, :list, :acc], [:if, [:null?, :list], :acc, [:iter, [:cdr, :list], [:+, 1, :acc]]]], [:iter, :object, 0]], [:define, [:append, :first, :".", :rest], [:cond, [[:null?, :rest], :first], [[:null?, :first], [:apply, :append, :rest]], [:else, [:cons, [:car, :first], [:append, [:cdr, :first], [:apply, :append, :rest]]]]]], [:define, [:reverse, :object], [:if, [:null?, :object], :object, [:append, [:reverse, [:cdr, :object]], [:list, [:car, :object]]]]], [:define, [:"list-tail", :list, :k], [:do, [[:pair, :list, [:cdr, :pair]], [:i, :k, [:-, :i, 1]]], [[:zero?, :i], :pair]]], [:define, [:"list-ref", :list, :k], [:car, [:"list-tail", :list, :k]]], [:define, [:"list-transform-search", :transform], [:lambda, [:predicate], [:lambda, [:object, :list], [:do, [[:pair, :list, [:cdr, :pair]]], [[:or, [:null?, :pair], [:predicate, [:car, [:transform, :pair]], :object]], [:if, [:null?, :pair], false, [:transform, :pair]]]]]]], [:define, :"list-search", [:"list-transform-search", [:lambda, [:x], :x]]], [:define, :memq, [:"list-search", :eq?]], [:define, :memv, [:"list-search", :eqv?]], [:define, :member, [:"list-search", :equal?]], [:define, :"assoc-list-search", [:"list-transform-search", :car]], [:define, :assq, [:"assoc-list-search", :eq?]], [:define, :assv, [:"assoc-list-search", :eqv?]], [:define, :assoc, [:"assoc-list-search", :equal?]], [:define, [:map, :proc, :list1, :".", :list2], [:if, [:null?, :list1], :list1, [:if, [:null?, :list2], [:cons, [:proc, [:car, :list1]], [:map, :proc, [:cdr, :list1]]], [:"let*", [[:all, [:cons, :list1, :list2]], [:args, [:map, :car, :all]], [:rest, [:map, :cdr, :all]]], [:cons, [:apply, :proc, :args], [:apply, :map, [:cons, :proc, :rest]]]]]]], [:define, [:"for-each", :proc, :list1, :".", :list2], [:do, [[:pair, :list1, [:cdr, :pair]], [:others, :list2, [:map, :cdr, :others]]], [[:null?, :pair], [:quote, []]], [:apply, :proc, [:cons, [:car, :pair], [:map, :car, :others]]]]], [:define, [:"fold-right", :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:"fold-right", :proc, :value, [:cdr, :list]]]]], [:define, [:"fold-left", :proc, :value, :list], [:if, [:null?, :list], :value, [:"fold-left", :proc, [:proc, :value, [:car, :list]], [:cdr, :list]]]], [:define, [:sublist, :list, :start, :end], [:cond, [[:null?, :list], [:quote, []]], [[:>, :start, 0], [:sublist, [:cdr, :list], [:-, :start, 1], [:-, :end, 1]]], [[:<=, :end, 0], [:quote, []]], [:else, [:cons, [:car, :list], [:sublist, [:cdr, :list], 0, [:-, :end, 1]]]]]], [:define, [:char, :string], [:if, [:and, [:string?, :string], [:"=", [:"string-length", :string], 1]], [:"string-ref", :string, 0], [:quote, []]]], [:define, [:"char-upper-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 65], [:<=, :code, 90]]]]], [:define, [:"char-lower-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 97], [:<=, :code, 122]]]]], [:define, [:"char-alphabetic?", :char], [:or, [:"char-upper-case?", :char], [:"char-lower-case?", :char]]], [:define, [:"char-numeric?", :char], [:and, [:char?, :char], [:let, [[:code, [:"char->integer", :char]]], [:and, [:>=, :code, 48], [:<=, :code, 57]]]]], [:define, [:"char-whitespace?", :char], [:and, [:char?, :char], [:if, [:member, [:"char->integer", :char], [:quote, [9, 10, 32]]], true, false]]], [:define, [:"char-upcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 97], [:<=, :code, 122]], [:"integer->char", [:-, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-downcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 65], [:<=, :code, 90]], [:"integer->char", [:+, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-compare-ci", :operator], [:lambda, [:x, :y], [:operator, [:"char-downcase", :x], [:"char-downcase", :y]]]], [:define, :"char-ci=?", [:"char-compare-ci", :"char=?"]], [:define, :"char-ci?", [:"char-compare-ci", :"char>?"]], [:define, :"char-ci<=?", [:"char-compare-ci", :"char<=?"]], [:define, :"char-ci>=?", [:"char-compare-ci", :"char>=?"]], [:define, [:string, :".", :chars], [:"list->string", :chars]], [:define, [:"string-compare", :string1, :string2, :"char-less?", :"char-greater?"], [:if, [:or, [:not, [:string?, :string1]], [:not, [:string?, :string2]]], [:error, "Expected two strings as arguments"], [:do, [[:pair1, [:"string->list", :string1], [:cdr, :pair1]], [:pair2, [:"string->list", :string2], [:cdr, :pair2]], [:diff, [:quote, []]]], [[:integer?, :diff], :diff], [:set!, :diff, [:cond, [[:null?, :pair1], [:if, [:null?, :pair2], 0, -1]], [[:null?, :pair2], 1], [:else, [:let, [[:char1, [:car, :pair1]], [:char2, [:car, :pair2]]], [:cond, [[:"char-less?", :char1, :char2], -1], [[:"char-greater?", :char1, :char2], 1], [:else, [:quote, []]]]]]]]]]], [:define, [:"string=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci?"]]], [:define, [:"string?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-cistring", [:sublist, [:"string->list", :string], :start, :end]]], [:define, [:"list->string", :chars], [:"let*", [[:size, [:length, :chars]], [:str, [:"make-string", :size]]], [:do, [[:list, :chars, [:cdr, :list]], [:i, 0, [:+, :i, 1]]], [[:"=", :i, :size], :str], [:"string-set!", :str, :i, [:car, :list]]]]], [:define, [:"string->list", :string], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]], [:list, [:quote, []], [:cons, [:"string-ref", :string, [:-, :i, 1]], :list]]], [[:zero?, :i], :list]]]], [:define, [:"string-copy", :string], [:"list->string", [:"string->list", :string]]], [:define, [:"string-fill!", :string, :char], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]]], [[:zero?, :i], :string], [:"string-set!", :string, [:-, :i, 1], :char]]]], [:define, [:"string-append", :".", :strings], [:"list->string", [:apply, :append, [:map, :"string->list", :strings]]]], [:define, [:vector, :".", :args], [:"list->vector", :args]], [:define, [:"list->vector", :list], [:"let*", [[:size, [:length, :list]], [:"new-vector", [:"make-vector", :size]]], [:do, [[:i, 0, [:+, :i, 1]], [:pair, :list, [:cdr, :pair]]], [[:"=", :i, :size], :"new-vector"], [:"vector-set!", :"new-vector", :i, [:car, :pair]]]]], [:define, [:"vector->list", :vector], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]], [:pair, [:quote, []], [:cons, [:"vector-ref", :vector, [:-, :i, 1]], :pair]]], [[:zero?, :i], :pair]]], [:define, [:"vector-fill!", :vector, :fill], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]]], [[:zero?, :i], :vector], [:"vector-set!", :vector, [:-, :i, 1], :fill]]], [:define, [:"get-keyword", :keyword, :args, :".", :thunk], [:let, [[:default, [:if, [:pair?, :thunk], [:car, :thunk], [:lambda, [], false]]]], [:let, :loop, [[:args, :args]], [:cond, [[:null?, :args], [:default]], [[:eq?, :keyword, [:car, :args]], [:cadr, :args]], [:else, [:loop, [:cddr, :args]]]]]]], [:"define-syntax", :"let-keywords", [:"syntax-rules", [], [[:_, :args, [], :body, :"..."], :body, :"..."], [[:_, :args, [[:keyword, :default], :rest, :"..."], :body, :"..."], [:let, [[:keyword, [:"get-keyword", [:"string->keyword", [:"symbol->string", [:quote, :keyword]]], :args, [:lambda, [], :default]]]], [:"let-keywords", :args, [:rest, :"..."], :body, :"..."]]], [[:_, :args, [:keyword, :rest, :"..."], :body, :"..."], [:"let-keywords", :args, [[:keyword, false], :rest, :"..."], :body, :"..."]]]]] \ No newline at end of file +program [[:define, :quit, :exit], [:define, [:newline], [:display, "\n"]], [:define, [:force, :promise], [:promise]], [:define, :"call/cc", :"call-with-current-continuation"], [:define, :eq?, :eqv?], [:define, [:not, :x], [:if, :x, false, true]], [:define, :true, true], [:define, :false, false], [:define, [:boolean?, :x], [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], [:define, :number?, :complex?], [:define, [:exact?, :x], [:or, [:rational?, :x], [:and, [:not, [:zero?, [:"imag-part", :x]]], [:exact?, [:"real-part", :x]], [:exact?, [:"imag-part", :x]]]]], [:define, [:inexact?, :x], [:not, [:exact?, :x]]], [:define, [:"=", :".", :args], [:define, [:iter, :x, :rest], [:if, [:null?, :rest], true, [:let, [[:y, [:car, :rest]]], [:if, [:or, [:not, [:number?, :x]], [:not, [:number?, :y]], [:not, [:equal?, :x, :y]]], false, [:iter, :x, [:cdr, :rest]]]]]], [:iter, [:car, :args], [:cdr, :args]]], [:define, [:zero?, :x], [:eqv?, :x, 0]], [:define, [:positive?, :x], [:>, :x, 0]], [:define, [:negative?, :x], [:<, :x, 0]], [:define, [:odd?, :x], [:"=", 1, [:remainder, :x, 2]]], [:define, [:even?, :x], [:zero?, [:remainder, :x, 2]]], [:define, [:max, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:"fold-right", [:lambda, [:a, :b], [:if, [:<=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:abs, :x], [:if, [:negative?, :x], [:-, :x], :x]], [:define, [:quotient, :x, :y], [:let, [[:result, [:/, :x, :y]]], [[:if, [:positive?, :result], :floor, :ceiling], :result]]], [:define, [:remainder, :x, :y], [:-, [:round, :x], [:*, [:round, :y], [:quotient, :x, :y]]]], [:define, [:modulo, :x, :y], [:+, [:remainder, :x, :y], [:if, [:negative?, [:*, :x, :y]], [:round, :y], 0]]], [:define, [:gcd, :x, :y, :".", :rest], [:if, [:null?, :rest], [:if, [:zero?, :y], [:abs, :x], [:gcd, :y, [:remainder, :x, :y]]], [:apply, :gcd, [:cons, [:gcd, :x, :y], :rest]]]], [:define, [:lcm, :x, :y, :".", :rest], [:if, [:null?, :rest], [:/, [:abs, [:*, :x, :y]], [:gcd, :x, :y]], [:apply, :lcm, [:cons, [:lcm, :x, :y], :rest]]]], [:define, :ceiling, :ceil], [:define, [:rationalize, :x, :tolerance], [:cond, [[:rational?, :x], :x], [[:not, [:zero?, [:"imag-part", :x]]], [:"make-rectangular", [:rationalize, [:"real-part", :x], :tolerance], [:rationalize, [:"imag-part", :x], :tolerance]]], [:else, [:"let*", [[:t, [:abs, :tolerance]], [:a, [:-, :x, :t]], [:b, [:+, :x, :t]]], [:do, [[:i, 1, [:+, :i, 1]], [:z, false]], [[:number?, :z], :z], [:let, [[:p, [:ceiling, [:*, :a, :i]]], [:q, [:floor, [:*, :b, :i]]]], [:if, [:<=, :p, :q], [:set!, :z, [:/, [:if, [:positive?, :p], :p, :q], :i]]]]]]]]], [:define, [:"make-polar", :magnitude, :angle], [:let, [[:re, [:*, :magnitude, [:cos, :angle]]], [:im, [:*, :magnitude, [:sin, :angle]]]], [:"make-rectangular", :re, :im]]], [:define, [:magnitude, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:sqrt, [:+, [:*, :re, :re], [:*, :im, :im]]]]], [:define, [:angle, :z], [:let, [[:re, [:"real-part", :z]], [:im, [:"imag-part", :z]]], [:atan, :im, :re]]], [:define, [:factorial, :x], [:define, [:iter, :y, :acc], [:if, [:zero?, :y], :acc, [:iter, [:-, :y, 1], [:*, :y, :acc]]]], [:iter, :x, 1]], [:define, [:null?, :object], [:eqv?, [:quote, []], :object]], [:define, [:list?, :object], [:or, [:null?, :object], [:and, [:pair?, :object], [:list?, [:cdr, :object]]]]], [:define, [:list, :".", :args], :args], [:define, [:length, :object], [:define, [:iter, :list, :acc], [:if, [:null?, :list], :acc, [:iter, [:cdr, :list], [:+, 1, :acc]]]], [:iter, :object, 0]], [:define, [:append, :first, :".", :rest], [:cond, [[:null?, :rest], :first], [[:null?, :first], [:apply, :append, :rest]], [:else, [:cons, [:car, :first], [:append, [:cdr, :first], [:apply, :append, :rest]]]]]], [:define, [:reverse, :object], [:if, [:null?, :object], :object, [:append, [:reverse, [:cdr, :object]], [:list, [:car, :object]]]]], [:define, [:"list-tail", :list, :k], [:do, [[:pair, :list, [:cdr, :pair]], [:i, :k, [:-, :i, 1]]], [[:zero?, :i], :pair]]], [:define, [:"list-ref", :list, :k], [:car, [:"list-tail", :list, :k]]], [:define, [:"list-transform-search", :transform], [:lambda, [:predicate], [:lambda, [:object, :list], [:do, [[:pair, :list, [:cdr, :pair]]], [[:or, [:null?, :pair], [:predicate, [:car, [:transform, :pair]], :object]], [:if, [:null?, :pair], false, [:transform, :pair]]]]]]], [:define, :"list-search", [:"list-transform-search", [:lambda, [:x], :x]]], [:define, :memq, [:"list-search", :eq?]], [:define, :memv, [:"list-search", :eqv?]], [:define, :member, [:"list-search", :equal?]], [:define, :"assoc-list-search", [:"list-transform-search", :car]], [:define, :assq, [:"assoc-list-search", :eq?]], [:define, :assv, [:"assoc-list-search", :eqv?]], [:define, :assoc, [:"assoc-list-search", :equal?]], [:define, [:map, :proc, :list1, :".", :list2], [:if, [:null?, :list1], :list1, [:if, [:null?, :list2], [:cons, [:proc, [:car, :list1]], [:map, :proc, [:cdr, :list1]]], [:"let*", [[:all, [:cons, :list1, :list2]], [:args, [:map, :car, :all]], [:rest, [:map, :cdr, :all]]], [:cons, [:apply, :proc, :args], [:apply, :map, [:cons, :proc, :rest]]]]]]], [:define, [:"for-each", :proc, :list1, :".", :list2], [:do, [[:pair, :list1, [:cdr, :pair]], [:others, :list2, [:map, :cdr, :others]]], [[:null?, :pair], [:quote, []]], [:apply, :proc, [:cons, [:car, :pair], [:map, :car, :others]]]]], [:define, [:"fold-right", :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:"fold-right", :proc, :value, [:cdr, :list]]]]], [:define, [:"fold-left", :proc, :value, :list], [:if, [:null?, :list], :value, [:"fold-left", :proc, [:proc, :value, [:car, :list]], [:cdr, :list]]]], [:define, [:sublist, :list, :start, :end], [:cond, [[:null?, :list], [:quote, []]], [[:>, :start, 0], [:sublist, [:cdr, :list], [:-, :start, 1], [:-, :end, 1]]], [[:<=, :end, 0], [:quote, []]], [:else, [:cons, [:car, :list], [:sublist, [:cdr, :list], 0, [:-, :end, 1]]]]]], [:define, [:char, :string], [:if, [:and, [:string?, :string], [:"=", [:"string-length", :string], 1]], [:"string-ref", :string, 0], [:quote, []]]], [:define, [:"char-upper-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 65], [:<=, :code, 90]]]]], [:define, [:"char-lower-case?", :letter], [:and, [:char?, :letter], [:let, [[:code, [:"char->integer", :letter]]], [:and, [:>=, :code, 97], [:<=, :code, 122]]]]], [:define, [:"char-alphabetic?", :char], [:or, [:"char-upper-case?", :char], [:"char-lower-case?", :char]]], [:define, [:"char-numeric?", :char], [:and, [:char?, :char], [:let, [[:code, [:"char->integer", :char]]], [:and, [:>=, :code, 48], [:<=, :code, 57]]]]], [:define, [:"char-whitespace?", :char], [:and, [:char?, :char], [:if, [:member, [:"char->integer", :char], [:quote, [9, 10, 32]]], true, false]]], [:define, [:"char-upcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 97], [:<=, :code, 122]], [:"integer->char", [:-, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-downcase", :char], [:let, [[:code, [:"char->integer", :char]]], [:if, [:and, [:>=, :code, 65], [:<=, :code, 90]], [:"integer->char", [:+, :code, 32]], [:"integer->char", :code]]]], [:define, [:"char-compare-ci", :operator], [:lambda, [:x, :y], [:operator, [:"char-downcase", :x], [:"char-downcase", :y]]]], [:define, :"char-ci=?", [:"char-compare-ci", :"char=?"]], [:define, :"char-ci?", [:"char-compare-ci", :"char>?"]], [:define, :"char-ci<=?", [:"char-compare-ci", :"char<=?"]], [:define, :"char-ci>=?", [:"char-compare-ci", :"char>=?"]], [:define, [:string, :".", :chars], [:"list->string", :chars]], [:define, [:"string-compare", :string1, :string2, :"char-less?", :"char-greater?"], [:if, [:or, [:not, [:string?, :string1]], [:not, [:string?, :string2]]], [:error, "Expected two strings as arguments"], [:do, [[:pair1, [:"string->list", :string1], [:cdr, :pair1]], [:pair2, [:"string->list", :string2], [:cdr, :pair2]], [:diff, [:quote, []]]], [[:integer?, :diff], :diff], [:set!, :diff, [:cond, [[:null?, :pair1], [:if, [:null?, :pair2], 0, -1]], [[:null?, :pair2], 1], [:else, [:let, [[:char1, [:car, :pair1]], [:char2, [:car, :pair2]]], [:cond, [[:"char-less?", :char1, :char2], -1], [[:"char-greater?", :char1, :char2], 1], [:else, [:quote, []]]]]]]]]]], [:define, [:"string=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci?"]]], [:define, [:"string?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-cistring", [:sublist, [:"string->list", :string], :start, :end]]], [:define, [:"list->string", :chars], [:"let*", [[:size, [:length, :chars]], [:str, [:"make-string", :size]]], [:do, [[:list, :chars, [:cdr, :list]], [:i, 0, [:+, :i, 1]]], [[:"=", :i, :size], :str], [:"string-set!", :str, :i, [:car, :list]]]]], [:define, [:"string->list", :string], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]], [:list, [:quote, []], [:cons, [:"string-ref", :string, [:-, :i, 1]], :list]]], [[:zero?, :i], :list]]]], [:define, [:"string-copy", :string], [:"list->string", [:"string->list", :string]]], [:define, [:"string-fill!", :string, :char], [:let, [[:size, [:"string-length", :string]]], [:do, [[:i, :size, [:-, :i, 1]]], [[:zero?, :i], :string], [:"string-set!", :string, [:-, :i, 1], :char]]]], [:define, [:"string-append", :".", :strings], [:"list->string", [:apply, :append, [:map, :"string->list", :strings]]]], [:define, [:vector, :".", :args], [:"list->vector", :args]], [:define, [:"list->vector", :list], [:"let*", [[:size, [:length, :list]], [:"new-vector", [:"make-vector", :size]]], [:do, [[:i, 0, [:+, :i, 1]], [:pair, :list, [:cdr, :pair]]], [[:"=", :i, :size], :"new-vector"], [:"vector-set!", :"new-vector", :i, [:car, :pair]]]]], [:define, [:"vector->list", :vector], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]], [:pair, [:quote, []], [:cons, [:"vector-ref", :vector, [:-, :i, 1]], :pair]]], [[:zero?, :i], :pair]]], [:define, [:"vector-fill!", :vector, :fill], [:do, [[:i, [:"vector-length", :vector], [:-, :i, 1]]], [[:zero?, :i], :vector], [:"vector-set!", :vector, [:-, :i, 1], :fill]]], [:define, [:"get-keyword", :keyword, :args, :".", :thunk], [:let, [[:default, [:if, [:pair?, :thunk], [:car, :thunk], [:lambda, [], false]]]], [:let, :loop, [[:args, :args]], [:cond, [[:null?, :args], [:default]], [[:eq?, :keyword, [:car, :args]], [:cadr, :args]], [:else, [:loop, [:cddr, :args]]]]]]], [:"define-syntax", :"let-keywords", [:"syntax-rules", [], [[:_, :args, [], :body, :"..."], [:begin, :body, :"..."]], [[:_, :args, [[:keyword, :default], :rest, :"..."], :body, :"..."], [:let, [[:keyword, [:"get-keyword", [:"string->keyword", [:"symbol->string", [:quote, :keyword]]], :args, [:lambda, [], :default]]]], [:"let-keywords", :args, [:rest, :"..."], :body, :"..."]]], [[:_, :args, [:keyword, :rest, :"..."], :body, :"..."], [:"let-keywords", :args, [[:keyword, false], :rest, :"..."], :body, :"..."]]]]] \ No newline at end of file diff --git a/lib/heist/builtin/lib/keyword.scm b/lib/heist/builtin/lib/keyword.scm index 2b5043e..2385508 100644 --- a/lib/heist/builtin/lib/keyword.scm +++ b/lib/heist/builtin/lib/keyword.scm @@ -16,7 +16,7 @@ ; Note that this macro is very inefficient at the moment. (define-syntax let-keywords (syntax-rules () - ((_ args () body ...) body ...) + ((_ args () body ...) (begin body ...)) ((_ args ((keyword default) rest ...) body ...) (let ((keyword (get-keyword (string->keyword