(*
** Course: Concepts of Programming Languages (BU CAS CS 320)
** Semester: Summer I, 2009
** Instructor: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
*)

//
// Author: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
// Time: May, 2009
//

(*
// 1. polymorphism, templates
// 2. some list functions
// 3. mergesort
*)

//
// this code is prepared for Lecture 3 but it is not actually used
//

(* ****** ****** *)

staload _ = "prelude/DATS/list.dats"
staload _ = "prelude/DATS/list0.dats"

#include "BUCASCS320.hats"

extern fun string_append
  (s1: string, s2: string): string = "string_append"

implement string_append (s1, s2) = let
  val cs1 = string_explode s1
  val cs2 = string_explode s2
  val cs = list0_append<char> (cs1, cs2)
in
  string_implode (cs)
end // end of [string_append]

extern
fun string_prefix_test
  (prfx: string, word: string): bool = "string_prefix_test"

implement string_prefix_test
  (prfx, word) = loop (prfx, word) where {
  val prfx = string_explode prfx
  val word = string_explode word
  fun loop (cs1: list0 char, cs2: list0 char): bool =
    case+ (cs1, cs2) of
    | (list0_cons (c1, cs1), list0_cons (c2, cs2)) =>
        if c1 = c2 then loop (cs1, cs2) else false
      // end of [list0_cons, list0_cons]
    | (list0_nil (), _) => true
    | (_, list0_nil ()) => false
} // end of [string_prefix_test]
  
(* ****** ****** *)

#define :: list0_cons
#define cons list0_cons
#define nil list0_nil

extern
fun charlst_mergesort (cs: list0 char): list0 char

implement charlst_mergesort (cs) = let
  fun merge
    (cs1: list0 char, cs2: list0 char): list0 char =
    case (cs1, cs2) of
    | (c1 :: cs1_tl, c2 :: cs2_tl) => begin
        if c1 <= c2 then c1 :: merge (cs1_tl, cs2) else c2 :: merge (cs1, cs2_tl)
      end // end of [::, ::]
    | (nil (), _) => cs2
    | (_, nil ()) => cs1
  // end of [merge]
  fun split_at (cs: list0 char, n: int): (list0 char, list0 char) =
    if n > 0 then begin case cs of
      | c :: cs => let
          val (cs1, cs2) = split_at (cs, n-1)
        in
          (c :: cs1, cs2)
        end // end of [::]
      | nil () => (nil (), nil ())
    end else begin
      (nil (), cs)
    end // end of [if]
  // end of [split_at]
  fun mrgsrt (cs: list0 char, n: int): list0 char =
    if n >= 2 then let
      val n2 = n / 2
      val (cs1, cs2) = split_at (cs, n2)
      val cs1 = mrgsrt (cs1, n2)
      val cs2 = mrgsrt (cs2, n - n2)
    in
      merge (cs1, cs2)
    end else begin
      cs // empty or singleton list
    end (* end of if *)
  // end of [mrgsrt]
in
  mrgsrt (cs, list0_length<char> cs)
end // end of [charlst_mergesort]

(* ****** ****** *)

extern
fun string_normalize (str: string): string

implement string_normalize (str) =
  string_implode (charlst_mergesort (string_explode str))

(* ****** ****** *)

implement main (argc, argv) = let
  var i: Nat // uninitialized
  val () = for
    (i := 0; i < argc; i := i + 1)
    (print (string_normalize argv.[i]); print_newline ())
  // end of [val]
in
  // empty
end // end of [main]

(* ****** ****** *)

(* end of [lecture03.dats] *)