@@ -8,6 +8,7 @@ lib/heist.rb lib/repl.rb lib/trie.rb lib/builtin/library.scm +lib/builtin/library.rb lib/builtin/primitives.rb lib/builtin/syntax.scm lib/parser/nodes.rb Manifest.txt @@ -9,6 +9,13 @@ Hoe.spec('heist') do |p| p.extra_deps = %w(oyster treetop) end +file "lib/builtin/library.rb" => "lib/builtin/library.scm" do |t| + program = Heist.parse(File.read t.prerequisites.first).convert! + File.open(t.name, 'w') { |f| f.write 'program ' + program.to_ruby.inspect } +end + +task :compile => "lib/builtin/library.rb" + namespace :spec do task :r5rs do procedures = Dir['r5rs/*.html']. Rakefile @@ -1,288 +1 @@ -# This file encodes the built-in library functions as Ruby -# data. The idea is that these procedures should be written -# in Scheme, but writing them like this means Heist does not -# have to parse the code and therefore starts up faster. - -program [ - - [:define, :quit, :exit], - - # (newline) - # prints a new-line character - [:define, [:newline], - [:display, "\n"]], - - # (force) - # Extracts the value of a promise created using (delay) - [:define, [:force, :promise], [:promise]], - - # (call/cc) - # Alias for (call-with-current-continuation) - [:define, :'call/cc', :'call-with-current-continuation'], - - # (eq? x y) - # Currently an alias for (eqv? x y). TODO implement properly - [:define, :eq?, :eqv?], - - # (not x) - # Boolean inverse of x - [:define, [:not, :x], - [:if, :x, false, true]], - - # Longhand aliases for boolean constants - [:define, :true, true], - [:define, :false, false], - - # (boolean? x) - # Returns true iff x is a boolean value - [:define, [:boolean?, :x], - [:or, [:eqv?, :x, true], [:eqv?, :x, false]]], - - #---------------------------------------------------------------- - - # Numerical functions - - # (number? x) - # Returns true iff x is any type of number - [:define, :number?, :complex?], - - # (exact? x) - # Returns true iff the given number is exact i.e. an integer, a - # rational, or a complex made of integers or rationals - [:define, [:exact?, :x], - [:or, [:rational?, :x], - [:and, [:not, [:zero?, [:'imag-part', :x]]], - [:exact?, [:'real-part', :x]], - [:exact?, [:'imag-part', :x]]]]], - - # (inexact? x) - # Returns true iff x is not an exact number - [:define, [:inexact?, :x], - [:not, [:exact?, :x]]], - - # (zero? x) - # Returns true iff x is zero - [:define, [:zero?, :x], - [:eqv?, :x, 0]], - - # (positive? x) - # Returns true iff x > 0 - [:define, [:positive?, :x], - [:'>', :x, 0]], - - # (negative? x) - # Returns true iff x < 0 - [:define, [:negative?, :x], - [:'<', :x, 0]], - - # (odd? x) - # Returns true iff x is odd - [:define, [:odd?, :x], - [:'=', 1, [:remainder, :x, 2]]], - - # (even? x) - # Returns true iff x is even - [:define, [:even?, :x], - [:zero?, [:remainder, :x, 2]]], - - # (abs x) - # Returns the absolute value of a number - [:define, [:abs, :x], - [:if, [:negative?, :x], - [:'-', :x], - :x]], - - # (quotient) and (remainder) satisfy - # - # (= n1 (+ (* n2 (quotient n1 n2)) - # (remainder n1 n2))) - - # (quotient x y) - # Returns the quotient of two numbers, i.e. performs n1/n2 - # and rounds toward zero. - [:define, [:quotient, :x, :y], - [:let, [[:result, [:'/', :x, :y]]], - [[:if, [:positive?, :result], - :floor, - :ceiling], - :result]]], - - # (remainder x y) - # Returns the remainder after dividing the first operand - # by the second - [:define, [:remainder, :x, :y], - [:'-', [:round, :x], - [:'*', [:round, :y], - [:quotient, :x, :y]]]], - - # (modulo x y) - # Returns the first operand modulo the second - [:define, [:modulo, :x, :y], - [:'+', [:remainder, :x, :y], - [:if, [:negative?, [:'*', :x, :y]], - [:round, :y], - 0]]], - - [:define, :ceiling, :ceil], - - # (rationalize x tolerance) - # Returns the simplest rational number that differs from x by - # no more than tolerance. Here 'simplest' means the smallest - # possible denominator is found first, and with that set the - # smallest corresponding numerator is chosen. - [: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]]]]]]]]], - - # (make-polar magnitude angle) - # Returns a new complex number with the given - # magnitude and angle - [:define, [:'make-polar', :magnitude, :angle], - [:let, [[:re, [:'*', :magnitude, [:cos, :angle]]], - [:im, [:'*', :magnitude, [:sin, :angle]]]], - [:'make-rectangular', :re, :im]]], - - # (magnitude z) - # Returns the magnitude of a complex number - [:define, [:magnitude, :z], - [:let, [[:re, [:'real-part', :z]], - [:im, [:'imag-part', :z]]], - [:sqrt, [:'+', [:'*', :re, :re], [:'*', :im, :im]]]]], - - # (angle z) - # Returns the angle a complex number makes with the - # real axis when plotted in the complex plane - [:define, [:angle, :z], - [:let, [[:re, [:'real-part', :z]], - [:im, [:'imag-part', :z]]], - [:atan, :im, :re]]], - - # (factorial x) - # Returns factorial of x - [:define, [:factorial, :x], - [:define, [:iter, :y, :acc], - [:if, [:zero?, :y], - :acc, - [:iter, [:'-', :y, 1], [:'*', :y, :acc]]]], - [:iter, :x, 1]], - - #---------------------------------------------------------------- - - # List/pair functions - - # (null? object) - # Returns true iff object is the empty list - [:define, [:null?, :object], - [:eqv?, [:quote, []], :object]], - - # (list? object) - # Returns true iff object is a proper list - [:define, [:list?, :object], - [:or, [:null?, :object], - [:and, [:pair?, :object], - [:list?, [:cdr, :object]]]]], - - # (length object) - # Returns the length of a proper list - [:define, [:length, :object], - [:define, [:iter, :list, :acc], - [:if, [:null?, :list], - :acc, - [:iter, [:cdr, :list], [:'+', 1, :acc]]]], - [:iter, :object, 0]], - - # (reverse list) - # Returns a newly allocated list consisting of the - # elements of list in reverse order. - [:define, [:reverse, :object], - [:if, [:null?, :object], - :object, - [:append, [:reverse, [:cdr, :object]], - [:list, [:car, :object]]]]], - - # (list-tail list k) - # Returns the sublist of list obtained by omitting the - # first k elements. - [:define, [:'list-tail', :list, :k], - [:do, [[:pair, :list, [:cdr, :pair]], - [:i, :k, [:'-', :i, 1]]], - [[:zero?, :i], :pair]]], - - # (list-ref list k) - # Returns the kth element of list. - [:define, [:'list-ref', :list, :k], - [:car, [:'list-tail', :list, :k]]], - - # (memq obj list) - # (memv obj list) - # (member obj list) - # These procedures return the first sublist of list whose - # car is obj, where the sublists of list are the non-empty - # lists returned by (list-tail list k) for k less than the - # length of list. If obj does not occur in list, then #f - # (not the empty list) is returned. Memq uses eq? to compare - # obj with the elements of list, while memv uses eqv? and - # member uses equal?. - - [: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?]], - - # (assq obj alist) - # (assv obj alist) - # (assoc obj alist) - # Alist (for "association list") must be a list of pairs. - # These procedures find the first pair in alist whose car - # field is obj, and returns that pair. If no pair in alist - # has obj as its car, then #f (not the empty list) is - # returned. Assq uses eq? to compare obj with the car fields - # of the pairs in alist, while assv uses eqv? and assoc - # uses 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?]], - - # (foldr proc value list) - [:define, [:foldr, :proc, :value, :list], - [:if, [:null?, :list], - :value, - [:proc, [:car, :list], - [:foldr, :proc, :value, [:cdr, :list]]]]], - - # (sublist list start end) - [: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]]]]]] -] - +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], [:foldr, [:lambda, [:a, :b], [:if, [:>=, :a, :b], :a, :b]], [:car, :values], [:cdr, :values]]], [:define, [:min, :".", :values], [:foldr, [: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, [:foldr, :proc, :value, :list], [:if, [:null?, :list], :value, [:proc, [:car, :list], [:foldr, :proc, :value, [: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, :"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<?", :"char>?"]]], [:define, [:"string-ci=?", :string1, :string2], [:zero?, [:"string-compare", :string1, :string2, :"char-ci<?", :"char-ci>?"]]], [:define, [:"string<?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char<?", :"char>?"], -1]], [:define, [:"string>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char<?", :"char>?"], 1]], [:define, [:"string<=?", :string1, :string2], [:not, [:"string>?", :string1, :string2]]], [:define, [:"string>=?", :string1, :string2], [:not, [:"string<?", :string1, :string2]]], [:define, [:"string-ci<?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci<?", :"char-ci>?"], -1]], [:define, [:"string-ci>?", :string1, :string2], [:"=", [:"string-compare", :string1, :string2, :"char-ci<?", :"char-ci>?"], 1]], [:define, [:"string-ci<=?", :string1, :string2], [:not, [:"string-ci>?", :string1, :string2]]], [:define, [:"string-ci>=?", :string1, :string2], [:not, [:"string-ci<?", :string1, :string2]]], [:define, [:substring, :string, :start, :end], [:"list->string", [: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 lib/builtin/library.rb @@ -2,10 +2,61 @@ ; in Scheme should go here. If at all possible, write ; builtins in Scheme rather than Ruby. +(define quit exit) + +; (newline) +; prints a new-line character +(define (newline) + (display "\n")) + +; (force) +; Extracts the value of a promise created using (delay) +(define (force promise) (promise)) + +; (call/cc) +; Alias for (call-with-current-continuation) +(define call/cc call-with-current-continuation) + +; (eq? x y) +; Currently an alias for (eqv? x y). TODO implement properly +(define eq? eqv?) + +; (not x) +; Boolean inverse of x +(define (not x) + (if x #f #t)) + +; Longhand aliases for boolean constants +(define true #t) +(define false #f) + +; (boolean? x) +; Returns true iff x is a boolean value +(define (boolean? x) + (or (eqv? x #t) (eqv? x #f))) + ;---------------------------------------------------------------- ; Numerical functions +; (number? x) +; Returns true iff x is any type of number +(define number? complex?) + +; (exact? x) +; Returns true iff the given number is exact i.e. an integer, a +; rational, or a complex made of integers or rationals +(define (exact? x) + (or (rational? x) + (and (not (zero? (imag-part x))) + (exact? (real-part x)) + (exact? (imag-part x))))) + +; (inexact? x) +; Returns true iff x is not an exact number +(define (inexact? x) + (not (exact? x))) + ; Returns true iff all arguments are numerically equal (define (= . args) (define (iter x rest) @@ -19,6 +70,31 @@ (iter x (cdr rest)))))) (iter (car args) (cdr args))) +; (zero? x) +; Returns true iff x is zero +(define (zero? x) + (eqv? x 0)) + +; (positive? x) +; Returns true iff x > 0 +(define (positive? x) + (> x 0)) + +; (negative? x) +; Returns true iff x < 0 +(define (negative? x) + (< x 0)) + +; (odd? x) +; Returns true iff x is odd +(define (odd? x) + (= 1 (remainder x 2))) + +; (even? x) +; Returns true iff x is even +(define (even? x) + (zero? (remainder x 2))) + ; (max arg1 arg2 ...) ; Returns the maximum value in the list of arguments (define (max . values) @@ -33,6 +109,44 @@ (car values) (cdr values))) +; (abs x) +; Returns the absolute value of a number +(define (abs x) + (if (negative? x) + (- x) + x)) + +; (quotient) and (remainder) satisfy +; +; (= n1 (+ (* n2 (quotient n1 n2)) +; (remainder n1 n2))) + +; (quotient x y) +; Returns the quotient of two numbers, i.e. performs n1/n2 +; and rounds toward zero. +(define (quotient x y) + (let ([result (/ x y)]) + ((if (positive? result) + floor + ceiling) + result))) + +; (remainder x y) +; Returns the remainder after dividing the first operand +; by the second +(define (remainder x y) + (- (round x) + (* (round y) + (quotient x y)))) + +; (modulo x y) +; Returns the first operand modulo the second +(define (modulo x y) + (+ (remainder x y) + (if (negative? (* x y)) + (round y) + 0))) + ; (gcd x y) ; Returns the greatest common divisor of two numbers ; http://en.wikipedia.org/wiki/Euclidean_algorithm @@ -52,14 +166,93 @@ (gcd x y)) (apply lcm (cons (lcm x y) rest)))) +(define ceiling ceil) + +; (rationalize x tolerance) +; Returns the simplest rational number that differs from x by +; no more than tolerance. Here 'simplest' means the smallest +; possible denominator is found first, and with that set the +; smallest corresponding numerator is chosen. +(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 #f]) + ((number? z) z) + (let ([p (ceiling (* a i))] + [q (floor (* b i))]) + (if (<= p q) + (set! z (/ (if (positive? p) p q) + i))))))])) + +; (make-polar magnitude angle) +; Returns a new complex number with the given +; magnitude and angle +(define (make-polar magnitude angle) + (let ([re (* magnitude (cos angle))] + [im (* magnitude (sin angle))]) + (make-rectangular re im))) + +; (magnitude z) +; Returns the magnitude of a complex number +(define (magnitude z) + (let ([re (real-part z)] + [im (imag-part z)]) + (sqrt (+ (* re re) (* im im))))) + +; (angle z) +; Returns the angle a complex number makes with the +; real axis when plotted in the complex plane +(define (angle z) + (let ([re (real-part z)] + [im (imag-part z)]) + (atan im re))) + +; (factorial x) +; Returns factorial of x +(define (factorial x) + (define (iter y acc) + (if (zero? y) + acc + (iter (- y 1) (* y acc)))) + (iter x 1)) + ;---------------------------------------------------------------- ; List/pair functions +; (null? object) +; Returns true iff object is the empty list +(define (null? object) + (eqv? '() object)) + +; (list? object) +; Returns true iff object is a proper list +(define (list? object) + (or (null? object) + (and (pair? object) + (list? (cdr object))))) + ; (list arg ...) ; Allocates and returns a new list from its arguments (define (list . args) args) +; (length object) +; Returns the length of a proper list +(define (length object) + (define (iter list acc) + (if (null? list) + acc + (iter (cdr list) (+ 1 acc)))) + (iter object 0)) + ; (append list ...) ; Returns a new list formed by concatenating the arguments. ; The final argument is not copied and the return value of @@ -72,6 +265,70 @@ (append (cdr first) (apply append rest)))])) +; (reverse list) +; Returns a newly allocated list consisting of the +; elements of list in reverse order. +(define (reverse object) + (if (null? object) + object + (append (reverse (cdr object)) + (list (car object))))) + +; (list-tail list k) +; Returns the sublist of list obtained by omitting the +; first k elements. +(define (list-tail list k) + (do ([pair list (cdr pair)] + [i k (- i 1)]) + ((zero? i) pair))) + +; (list-ref list k) +; Returns the kth element of list. +(define (list-ref list k) + (car (list-tail list k))) + +; (memq obj list) +; (memv obj list) +; (member obj list) +; These procedures return the first sublist of list whose +; car is obj, where the sublists of list are the non-empty +; lists returned by (list-tail list k) for k less than the +; length of list. If obj does not occur in list, then #f +; (not the empty list) is returned. Memq uses eq? to compare +; obj with the elements of list, while memv uses eqv? and +; member uses equal?. + +(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) + #f + (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?)) + +; (assq obj alist) +; (assv obj alist) +; (assoc obj alist) +; Alist (for "association list") must be a list of pairs. +; These procedures find the first pair in alist whose car +; field is obj, and returns that pair. If no pair in alist +; has obj as its car, then #f (not the empty list) is +; returned. Assq uses eq? to compare obj with the car fields +; of the pairs in alist, while assv uses eqv? and assoc +; uses 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?)) + ; (map proc list1 list2 ...) ; Returns a new list formed by applying proc to each member ; (or set of members) of the given list(s). @@ -98,6 +355,21 @@ (apply proc (cons (car pair) (map car others))))) +; (foldr proc value list) +(define (foldr proc value list) + (if (null? list) + value + (proc (car list) + (foldr proc value (cdr list))))) + +; (sublist list start end) +(define (sublist list start end) + (cond [(null? list) '()] + [(> start 0) (sublist (cdr list) (- start 1) (- end 1))] + [(<= end 0) '()] + [else (cons (car list) + (sublist (cdr list) 0 (- end 1)))])) + ;---------------------------------------------------------------- ; Character functions lib/builtin/library.scm @@ -45,7 +45,6 @@ module Heist run("#{ BUILTIN_PATH }primitives.rb") run("#{ BUILTIN_PATH }syntax.scm") run("#{ BUILTIN_PATH }library.rb") - run("#{ BUILTIN_PATH }library.scm") @start_time = Time.now.to_f end lib/runtime/runtime.rb a586e096dcca344fef6e699f2cddd3007a7da816 James Coglan jcoglan@googlemail.com http://github.com/jcoglan/heist/commit/cd74912e27518fcf736339d838d695235cc60443 cd74912e27518fcf736339d838d695235cc60443 2009-09-01T06:47:49-07:00 2009-09-01T06:47:49-07:00 Compile library.scm to Ruby representation automatically using a Rake task. 2436e1e3f7ba6c36b5e6cb712de45ff19bb0c24e James Coglan jcoglan@googlemail.com