Source code in the objecticon programming language

# -*- ObjectIcon -*-

import io

procedure main ()
  local cf_13_11, cf_22_7, cf_sqrt2, cf_1_div_sqrt2

  cf_13_11 := CF_rational (13, 11)
  cf_22_7 := CF_rational (22, 7)
  cf_sqrt2 := CF_sqrt2()
  cf_1_div_sqrt2 := CF_hfunc (0, 1, 1, 0, cf_sqrt2)

  show ("13/11", cf_13_11)
  show ("22/7", cf_22_7)
  show ("sqrt(2)", cf_sqrt2)
  show ("13/11 + 1/2", CF_hfunc (2, 1, 0, 2, cf_13_11))
  show ("22/7 + 1/2", CF_hfunc (2, 1, 0, 2, cf_22_7))
  show ("(22/7)/4", CF_hfunc (1, 0, 0, 4, cf_22_7))
  show ("1/sqrt(2)", cf_1_div_sqrt2)
  show ("(2 + sqrt(2))/4", CF_hfunc (1, 2, 0, 4, cf_sqrt2))
  show ("(1 + 1/sqrt(2))/2", CF_hfunc (1, 1, 0, 2,
                                       cf_1_div_sqrt2))
end

procedure show (expr, cf)
  io.write (expr, " => ", cf.to_string())
end

class CF ()                  # A continued fraction.

  private terminated         # Are there no more terms to memoize?
  private memo               # Memoized terms.
  private generate           # A co-expression to generate more terms.

  public new (gen)
    terminated := &no
    memo := []
    generate := gen
    return
  end

  public get_term (i)
    local j, term

    if *memo <= i then {
      if \terminated then {
        fail
      } else {
        every j := *memo to i do {
          if term := @generate then {
            put (memo, term)
          } else {
            terminated := &yes
            fail
          }
        }
      }
    }
    return memo[i + 1]
  end

  public to_string (max_terms)
    local s, sep, i, done, term

    /max_terms := 20

    s := "["
    sep := 0
    i := 0
    done := &no
    while /done do {
      if i = max_terms then {
        # We have reached the maximum of terms to print. Stick an
        # ellipsis in the notation.
        s ||:= ",...]"
        done := &yes
      } else if term := get_term (i) then {
        # Getting a term succeeded. Include the term.
        s ||:= sep_str (sep) || term
        sep := min (sep + 1, 2)
        i +:= 1
      } else {
        # Getting a term failed. We are done.
        s ||:= "]"
        done := &yes
      }
    }
    return s
  end

  private sep_str (sep)
    return (if sep = 0 then "" else if sep = 1 then ";" else ",")
  end

end                             # class CF

class CF_sqrt2 (CF)             # A continued fraction for sqrt(2).
  public override new ()
    CF.new (create gen ())
    return
  end

  private gen ()
    suspend 1
    repeat suspend 2
  end
end                             # class CF_sqrt2

class CF_rational (CF)   # A continued fraction for a rational number.
  public override new (numerator, denominator)
    CF.new (create gen (numerator, denominator))
    return
  end

  private gen (n, d)
    local q, r

    repeat {
      if d = 0 then fail
      q := n / d
      r := n % d
      n := d
      d := r
      suspend q
    }
  end
end                             # class CF_rational

class CF_hfunc (CF) # A continued fraction for a homographic function
                    # of some other continued fraction.

  public override new (a1, a, b1, b, other_cf)
    CF.new (create gen (a1, a, b1, b, other_cf))
    return
  end

  private gen (a1, a, b1, b, other_cf)
    local a1_tmp, a_tmp, b1_tmp, b_tmp
    local i, term, skip_getting_a_term
    local q1, q

    i := 0
    repeat {
      skip_getting_a_term := &no
      if b1 = b = 0 then {
        fail
      } else if b1 ~= 0 & b ~= 0 then {
        q1 := a1 / b1
        q := a / b
        if q1 = q then {
          a1_tmp := a1
          a_tmp := a
          b1_tmp := b1
          b_tmp := b
          a1 := b1_tmp
          a := b_tmp
          b1 := a1_tmp - (b1_tmp * q)
          b := a_tmp - (b_tmp * q)
          suspend q
          skip_getting_a_term := &yes
        }
      }
      if /skip_getting_a_term then {
        if term := other_cf.get_term (i) then {
          i +:= 1
          a1_tmp := a1
          a_tmp := a
          b1_tmp := b1
          b_tmp := b
          a1 := a_tmp + (a1_tmp * term)
          a := a1_tmp
          b1 := b_tmp + (b1_tmp * term)
          b := b1_tmp
        } else {
          a := a1
          b := b1
        }
      }
    }
  end

end                             # class CF_hfunc