rus3 0.1.0

data/lib/rus3/parser/scheme_parser.rb

@@ -0,0 +1,322 @@
+# frozen_string_literal: true
+
+module Rus3::Parser
+
+  # A simple parser to read a s-expression for Scheme.
+  class SchemeParser < Parser
+
+    # Indicates the version of the parser class
+    PARSER_VERSION = "0.1.0"
+
+    # Constructs the version string.
+
+    def version
+      vmsg = "(scheme-parser-version . #{PARSER_VERSION})"
+      vmsg += " (scheme-lexer-version . #{Lexer::LEXER_VERSION})"
+      super + " (#{vmsg})"
+    end
+
+    def initialize
+      super
+    end
+
+    # Set the prompt which includes "scheme" label.
+
+    def prompt=(str)
+      index = str.index(">")
+      @prompt = str[0...index] + "(scheme)" + str[index..-1]
+    end
+
+    # Parses a s-expression then translates it to a expression for Ruby.
+    #
+    # Converts a s-expression (scheme-expression or just S expression)
+    # to an i-expression (intermediate-expression), then translate an
+    # i-expression into a r-expression (ruby-expression).  An
+    # i-expression is represented with an Array object in Ruby.  A
+    # r-expression is a String object which could be directly
+    # evaluated by `Kernel.eval`.
+    #
+    # Supported S-expression type:
+    #
+    #   - primitive expression (s_exp -> r_exp)
+    #     - empty list
+    #       - "()" -> "[]"
+    #
+    #     - variable reference
+    #       - identifier (symbol) -> "foo"
+    #
+    #     - literal expression
+    #       - boolean: #f or #t   -> `false` or `true`
+    #       - string              -> "hoge", "bogo", ...
+    #       - number              -> 1.23, Rational(4, 5), Complex(6, 7), ...
+    #
+    #     - procedure call (s_exp -> i_exp -> r_exp)
+    #       - (+ (* 3 4) (/ 5 6)) ... s_exp
+    #         -> ["add", ["mult", "3", "4"],
+    #             ["div", "5", "6"]] ... i_exp
+    #         -> "add(mul(3, 4), div(5, 6))" ... r_exp
+    #
+    #       - ((lambda (x) (+ x x)) 4) ... s_exp
+    #         -> [["lambda", ["x"], ["add", "x", "x"]], 4] ... i_exp
+    #         -> "lambda { |x| add(x, x) }.call(4)" ... r_exp
+    #
+    #     - procedure (s_exp -> i_exp -> r_exp)
+    #       - (lambda (x) (+ x x)) ... s_exp
+    #         -> ["lambda", ["x"], ["add", "x", "x"]] ... i_exp
+    #         -> "lambda { |x| add(x, x) }" ... r_exp
+    #
+    #     - conditionals (s_exp -> i_exp -> r_exp)
+    #       - (if (= n 0) 1 (* n (- n 1))) ... s_exp
+    #         -> ["if", ["eqv?", "n", "0"],
+    #             "1" ["mul", "n", ["subtract", "n", "1"]]] ... i_exp
+    #         -> "if eqv?(n, 0);
+    #               1;
+    #             else;
+    #               mul(n, subtract(n, 1));
+    #             end" ... r_exp
+    #
+    #     - assignment (s_exp -> i_exp -> r_exp)
+    #       - (set! x 2) ... s_exp
+    #         -> ["set!", "x", "2"] ... i_exp
+    #         -> "x = 2" ... r_exp
+    #
+    #     - define procedure (s_exp -> i_exp -> r_exp)
+    #       - (define (fact n) (if (= n 0) 1 (* n (fact (- n 1))))) ... s_exp
+    #         -> ["define", ["fact", "n"],
+    #              ["if", ["eqv?", "n", "0"], "1",
+    #              ["mul", "n", ["fact", ["subtract", "n", "1"]]]]] ... i_exp
+    #         -> "def fact(n);
+    #                if n == 0;
+    #                  1;
+    #                else;
+    #                  n * fact((n - 1));
+    #             end" ... r_exp
+    #
+    #   - derived expression
+    #     - conditionals (s_exp -> i_exp -> r_exp)
+    #       - (cond ((> 3 2) "greater")
+    #               ((< 3 2) "less")
+    #               (else "equal")) ... s_exp
+    #         -> ["cond", [[["gt?", "3", "2"], "\"greater\""],
+    #                     [["lt?", "3", "2"], "\"less\""],
+    #                     ["else", "\"equal\""]]] ... i_exp
+    #         -> "if gt?(3,2);
+    #               'greater';
+    #             elsif lt?(3,2);
+    #               'less';
+    #             else;
+    #               'equal';
+    #             end" ... r_exp
+    #
+    #     - building construct (s_exp -> i_exp -> r_exp)
+    #       - (let ((x 2) (y 3))
+    #              (* x y)) ... s_exp
+    #         -> ["let", [["x", "2"], ["y", "3"]],
+    #              ["mul", "x", "y"]] ... i_exp
+    #         -> "lambda { |x, y| mul(x, y) }.call(2, 3)" ... r_exp
+    #
+    #  - list (s_exp -> r_exp)
+    #    - (1 2 3 (4 5) (6 7 8) 9 0)
+    #      -> "[1, 2, 3, [4, 5], [6, 7, 8], 9, 0]"
+
+    def parse(s_exp)
+      parse_tokens(Lexer.new(s_exp))
+    end
+
+    def parse_tokens(lexer)     # :nodoc:
+      r_exps = []
+      loop {
+        token = lexer.next
+        if token.type == :lparen
+          i_exp = parse_compound(lexer)
+          r_exps << translate(i_exp)
+        else
+          r_exps << parse_primitive(token)
+        end
+      }
+      r_exps.join("\n")
+    end
+
+    def parse_primitive(token)
+      r_exp = nil
+      case token.type
+      when *Lexer::KEYWORDS.values
+        r_exp = translate_ident(token.literal)
+      when :string
+        r_exp = token.literal
+      when :ident, :boolean, :number, :op_proc
+        trans_method_name = "translate_#{token.type}".intern
+        r_exp = self.send(trans_method_name, token.literal)
+      else
+        raise Rus3::SchemeSyntaxError, token.literal
+      end
+      r_exp
+    end
+
+    def parse_compound(lexer)
+      i_exp = []
+      Kernel.loop {
+        token = lexer.next
+        case token.type
+        when :lparen
+          i_exp << parse_compound(lexer)
+        when :rparen
+          break
+        else
+          i_exp << parse_primitive(token)
+        end
+      }
+      i_exp
+    end
+
+    def translate_ident(s_exp_literal)
+      "#{s_exp_literal}"
+    end
+
+    def translate_boolean(s_exp_literal)
+      # literal == "#f" or #t"
+      (s_exp_literal[1] == "f") ? "false" : "true"
+    end
+
+    def translate_number(s_exp_literal)
+      if s_exp_literal.include?("/") # rational?
+        denominator, numerator = s_exp_literal.split("/").map{|s| Kernel.eval(s)}
+        "Rational(#{denominator}, #{numerator})"
+      else
+        Kernel.eval(s_exp_literal).to_s
+      end
+    end
+
+    OP_PROCS = {
+      "+"  => "add",
+      "-"  => "subtract",
+      "*"  => "mul",
+      "/"  => "div",
+      "%"  => "mod",
+      "<"  => "lt?",
+      "<=" => "le?",
+      ">"  => "gt?",
+      ">=" => "ge?",
+      "==" => "eqv?",
+    }
+
+    def translate_op_proc(s_exp_literal)
+      OP_PROCS[s_exp_literal]
+    end
+
+    def translate(i_exp)
+      r_exp = nil
+
+      if i_exp.instance_of?(Array)
+        return "[]" if i_exp.empty? # an empty list
+
+        case i_exp[0]
+        when "lambda", "if", "set!", "define", "cond", "let"
+          keyword = i_exp[0]
+          trans_method_name = "translate_#{keyword}".intern
+          r_exp = self.send(trans_method_name, i_exp)
+        else                  # procedure call
+          r_exp = translate_proc_call(i_exp)
+        end
+      else
+        r_exp = i_exp
+      end
+      r_exp
+    end
+
+    def translate_proc_call(i_exp)
+      proc = i_exp[0]
+
+      if proc.instance_of?(Array)
+        raise Rus3::SchemeSyntaxError, i_exp if i_exp[0][0] != "lambda"
+        lambda_proc = translate_lambda(proc)
+        proc = "#{lambda_proc}.call"
+      end
+
+      args = i_exp[1..-1].map {|e| translate(e) }
+
+      "#{proc}(#{args.join(', ')})"
+    end
+
+    def translate_lambda(i_exp)
+      formals = i_exp[1]
+      body = i_exp[2..-1]
+
+      if body.instance_of?(Array)
+        body = translate_body(body)
+      end
+
+      "lambda {|#{formals.join(', ')}| #{body}}"
+    end
+
+    def translate_if(i_exp)
+      test = translate(i_exp[1])
+      consequent = translate(i_exp[2])
+      alternate = translate(i_exp[3])
+
+      if_exp = "if #{test}; #{consequent}"
+      if_exp += "; else; #{alternate}" if alternate
+      if_exp += "; end"
+
+      if_exp
+    end
+
+    def translate_set!(i_exp)
+      ident = i_exp[1]
+      value = translate(i_exp[2])
+      "#{ident} = #{value}"
+    end
+
+    def translate_define(i_exp)
+      if i_exp[1].instance_of?(Array)
+        name = i_exp[1][0]
+        params = i_exp[1][1..-1]
+        body = translate_body(i_exp[2..-1])
+
+        "def #{name}(#{params.join(', ')}); #{body}; end"
+      else
+        ident = i_exp[1]
+        value = translate(i_exp[2])
+        "#{ident} = #{value}"
+      end
+    end
+
+    def translate_cond(i_exp)
+      test = translate(i_exp[1][0])
+      exp = translate(i_exp[1][1])
+      r_exp = "if #{test}; #{exp}"
+
+      i_exp[2..-1].each { |clause|
+        exp = translate(clause[1])
+        if clause[0] == "else"
+          r_exp += "; else; #{exp}"
+        else
+          test = translate(clause[0])
+          r_exp += "; elsif #{test}; #{exp}"
+        end
+      }
+      r_exp += "; end"
+
+      r_exp
+    end
+
+    def translate_let(i_exp)
+      bindings = i_exp[1].to_h
+      body = translate(i_exp[2])
+
+      params = bindings.keys.join(", ")
+      args = bindings.values.map{|e| translate(e)}.join(", ")
+
+      "lambda {|#{params}| #{body}}.call(#{args})"
+    end
+
+    def translate_body(i_exps)
+      r_exps = []
+      i_exps.map { |i_exp|
+        r_exps << translate(i_exp)
+      }
+      r_exps.join(";")
+    end
+
+  end
+end

data/lib/rus3/port.rb

@@ -0,0 +1,6 @@
+# frozen_string_literal: true
+
+module Rus3
+  class Port
+  end
+end

data/lib/rus3/printer.rb

@@ -0,0 +1,28 @@
+# frozen_string_literal: true
+
+module Rus3
+  module Printer
+
+    # Indicates the version of the printer module.
+    VERSION = "0.1.0"
+
+    class Printer
+      include Rus3::Procedure::Write
+
+      attr_accessor :verbose
+
+      def initialize
+        @verbose = false
+      end
+
+      def print(obj)
+        display(obj)
+      end
+
+      def version
+        "Printer version #{VERSION}"
+      end
+    end
+
+  end
+end

data/lib/rus3/procedure/control.rb

@@ -0,0 +1,35 @@
+# frozen_string_literal: true
+
+module Rus3::Procedure
+  module Control
+
+    include Predicate
+    include Rus3::EmptyList
+
+    def map(prc, *lists)
+      case lists.size
+      when 0
+        EMPTY_LIST
+      when 1
+        raise Rus3::ListRequiredError, lists[0] unless list?(lists[0])
+        lists[0].map(&prc)
+      else
+        zip(*lists).map {|args|
+          prc.call(*args)
+        }
+      end
+    end
+
+    def zip(*lists)
+      case lists.size
+      when 0
+        EMPTY_LIST
+      when 1
+        lists[0]
+      else
+        lists[0].zip(*lists[1..-1])
+      end
+    end
+
+  end
+end

data/lib/rus3/procedure/list.rb

@@ -0,0 +1,289 @@
+# frozen_string_literal: true
+
+module Rus3::Procedure
+
+  # The module holds list operation proceduress of Scheme.  Most of
+  # those procedures are defined in R(n)RS (the specification of
+  # Scheme language).
+  #
+  #   - R5RS 6.3.2 Pairs and lists
+  #   - R7RS 6.4   Pairs and lists
+
+  module List
+
+    include Predicate
+    include Rus3::EmptyList
+
+    # Constructs a Pair object with arguments.
+    #
+    #   - R5RS procedure: (cons obj1 obj2)
+
+    def cons(obj1, obj2)
+      case obj2
+      when Rus3::Pair
+        if null?(obj2.cdr)    # (foo . ())
+          [obj1, obj2.car]
+        else
+          Rus3::Pair.new(obj1, obj2)
+        end
+      when Array
+        [obj1].concat(obj2)
+      else
+        Rus3::Pair.new(obj1, obj2)
+      end
+    end
+
+    # Returns the CAR part of the argument.  If the arguemnt is not
+    # a pair, raises PairRequiredError.
+    #
+    #   - R5RS procedure: (car pair)
+
+    def car(pair)
+      case pair
+      when Rus3::Pair
+        pair.car
+      when Array
+        raise Rus3::PairOrListRequiredError, pair if pair.empty?
+        pair[0]
+      else
+        raise Rus3::PairOrListRequiredError, pair
+      end
+    end
+
+    # Returns the CDR part of the argument.  If the arguemnt is not
+    # a pair, raises PairRequiredError.
+    #
+    #   - R5RS procedure: (cdr pair)
+
+    def cdr(pair)
+      case pair
+      when Rus3::Pair
+        pair.cdr
+      when Array
+        raise Rus3::PairOrListRequiredError, pair if pair.empty?
+        pair[1..-1]
+      else
+        raise Rus3::PairOrListRequiredError, pair
+      end
+    end
+
+    # Replaces the CAR part with the 2nd argument and returns UNDEF.
+    # If the 1st arguemnt is not a pair, raises PairRequiredError.
+    #
+    #   - R5RS procedure: (set-car! pair obj)
+
+    def set_car!(pair, obj)
+      case pair
+      when Rus3::Pair
+        pair.set_car!(obj)
+      when Array
+        pair[0] = obj
+      else
+        raise Rus3::PairOrListRequiredError, pair
+      end
+      Rus3::UNDEF
+    end
+
+    # Replaces the CDR part with the 2nd argument and returns UNDEF.
+    # If the 1st arguemnt is not a pair, raises PairRequiredError.
+    #
+    #   - R5RS procedure: (set-cdr! pair obj)
+
+    def set_cdr!(pair, obj)
+      case pair
+      when Rus3::Pair
+        pair.set_cdr!(obj)
+      when Array
+        case obj
+        when Array
+          pair.slice!(1, pair.size - 1)
+          pair.concat(obj)
+        else
+          # If `obj` was not a proper list of Scheme, the result of
+          # `set_cdr!` would be a Pair instance.  However, in this
+          # case, the given `pair` is an Array instance, there is no
+          # way to replace it with a new Pair instance.
+          raise UnsupportedFeatureError.new("set_cdr!", obj)
+        end
+      else
+        raise Rus3::PairOrListRequiredError, pair
+      end
+      Rus3::UNDEF
+    end
+
+    # Retrieves the CAR part of the CAR part of the given pair.
+    #
+    #   - R5RS library procedure: (caar pair)
+    #   - R7RS procedure: (caar pair)
+
+    def caar(pair)
+      car(car(pair))
+    end
+
+    # Retrieves the CAR part of the CDR part of the given pair.
+    #
+    #   - R5RS library procedure: (cadr pair)
+    #   - R7RS procedure: (cadr pair)
+
+    def cadr(pair)
+      car(cdr(pair))
+    end
+
+    # Retrieves the CDR part of the CAR part of the given pair.
+    #
+    #   - R5RS library procedure: (cdar pair)
+    #   - R7RS procedure: (cdar pair)
+
+    def cdar(pair)
+      cdr(car(pair))
+    end
+
+    # Retrieves the CDR part of the CDR part of the given pair.
+    #
+    #   - R5RS library procedure: (cddr pair)
+    #   - R7RS procedure: (cddr pair)
+
+    def cddr(pair)
+      cdr(cdr(pair))
+    end
+
+    # :stopdoc:
+
+    #    - R7RS: procedure: (make-list k)
+
+    #    - R7RS: procedure: (make-list k fill)
+
+    # :startdoc:
+
+    # Constructs a list from arguments in its order.
+    #
+    #   - R5RS library procedure: (list obj ...)
+
+    def list(*objs)
+      Array[*objs]
+    end
+
+    # Returns the length of the arguemnt.  If the argument is not a
+    # proper list, raises ListRequiredError.
+    #
+    #   - R5RS library procedure: (length list)
+    #   - R7RS procedure: (length list)
+
+    def length(lst)
+      check_list(lst)
+      lst.size
+    end
+
+    # Concatenates given lists into a single list.  Each argument
+    # must be a proper list, otherwise raises ListRequiredError.
+    #
+    #   - R5RS library procedure: (append list ...)
+    #   - R7RS procedure: (append list ...)
+
+    def append(*lists)
+      lists.each { |lst|
+        check_list(lst)
+      }
+      [].concat(*lists)
+    end
+
+    # Returns a list of the same elements in reverse order.
+    #
+    #   - R5RS library procedure: (reverse list)
+    #   - R7RS procedure: (reverse list)
+
+    def reverse(lst)
+      check_list(lst)
+      lst.sort {|a, b| b <=> a}
+    end
+
+    # Returns the sublist of the arguemnt by omitting the first k
+    # elements.  The 2nd argument, k must be in 0..length(lst),
+    # otherwise raises OutOfRangeError.
+    #
+    # This implementation logic comes from R5RS 6.3.2.
+    #
+    #   - R5RS library procedure: (list-tail list k)
+    #   - R7RS procedure: (list-tail list k)
+
+    def list_tail(lst, k)
+      check_list(lst)
+      check_upper_limit(k, length(lst)+1)
+
+      lst.drop(k)
+    end
+
+    # Returns kth element of the argument.  k must be less than the
+    # length of the list, otherwise, raises OutOfRangeError.
+    #
+    #   - R5RS library procedure: (list-ref list k)
+    #   - R7RS procedure: (list-ref list k)
+
+    def list_ref(lst, k)
+      check_list(lst)
+      check_upper_limit(k, length(lst))
+
+      lst[k]
+    end
+
+    # :stopdoc:
+
+    #   - R7RS procedure: (list-set! list k obj)
+
+    # :startdoc:
+
+    # :stopdpc:
+
+    #   - R5RS library procedure: (memq obj list)
+    #   - R7RS procedure: (memq obj list)
+
+    #   - R5RS library procedure: (memv obj list)
+    #   - R7RS procedure: (memv obj list)
+
+    #   - R5RS library procedure: (member obj list)
+    #   - R7RS procedure: (member obj list)
+
+    #   - R7RS procedure: (member obj list compare)
+
+    # :startdoc:
+
+    # :stopdpc:
+
+    #   - R5RS library procedure: (assq obj alist)
+    #   - R7RS procedure: (assq obj alist)
+
+    #   - R5RS library procedure: (assv obj alist)
+    #   - R7RS procedure: (assv obj alist)
+
+    #   - R5RS library procedure: (assoc obj alist)
+    #   - R7RS procedure: (assoc obj alist)
+
+    #   - R7RS procedure: (assoc obj alist compare)
+
+    # :startdoc:
+
+    # :stopdoc:
+
+    #   - R7RS procedure: (list-copy obj)
+
+    # :startdoc:
+
+    private
+
+    def check_pair(pair)      # :nodoc:
+      if !pair.instance_of?(Rus3::Pair) and !pair.instance_of?(Array)
+        raise Rus3::PairRequiredError, pair
+      end
+    end
+
+    def check_list(lst)       # :nodoc:
+      raise Rus3::ListRequiredError, lst unless list?(lst)
+    end
+
+    # To make sure the number is less than its upper limit.
+    def check_upper_limit(k, limit) # :nodoc:
+      raise Rus3::OutOfRangeError, k if k >= limit
+    end
+
+  end
+end