src/sml/utils.sml~

   1 (* Utility functions *)
   2
   3 fun andmap f nil = true
   4   | andmap f (a :: s) = (f a) andalso (andmap f s);
   5
   6 fun ormap f nil = false
   7   | ormap f (a :: s) = (f a) orelse (ormap f s);
   8
   9 fun makeIsChar(string) =
  10     let val chars = explode(string)
  11     in
  12     fn ch => ormap (fn ch' => ch = ch') chars
  13     end;
  14
  15 fun makeCharInRange(charFrom, charTo) =
  16  fn ch : char => (charFrom <= ch) andalso (ch <= charTo);
  17
  18 fun stringEqual(string1, string2) =
  19     String.compare(string1, string2) = EQUAL;
  20
  21 fun sexprToString'(Void) = "#<void>"
  22   | sexprToString'(Nil) = "()"
  23   | sexprToString'(Number(n)) = Int.toString(n)
  24   | sexprToString'(Char(#" ")) = "#\\space"
  25   | sexprToString'(Char(#"\t")) = "#\\tab"
  26   | sexprToString'(Char(#"\n")) = "#\\newline"
  27   | sexprToString'(Char(#"\r")) = "#\\return"
  28   | sexprToString'(Char(ch)) =
  29     if (ch > #" ") then "#\\" ^ Char.toString(ch)
  30     else let val n = ord(ch)
  31          val o3 = n mod 8
  32          val tmp = n div 8
  33          val o2 = tmp mod 8
  34          val o1 = tmp div 8
  35      in
  36          "#\\" ^
  37          Int.toString(o1) ^
  38          Int.toString(o2) ^
  39          Int.toString(o3)
  40      end
  41   | sexprToString'(Bool(true)) = "#t"
  42   | sexprToString'(Bool(false)) = "#f"
  43   | sexprToString'(String(str)) = "\"" ^ str ^ "\""
  44   | sexprToString'(Symbol(name)) = name
  45   | sexprToString'(Pair(Symbol("quote"),
  46            Pair(e, Nil))) = "'" ^ sexprToString'(e)
  47   | sexprToString'(Pair(car, cdr)) = toStringWithCar(sexprToString'(car), cdr)
  48   | sexprToString'(Vector(s)) =
  49     "#(" ^ (String.concatWith " " (map sexprToString' s)) ^ ")"
  50 and toStringWithCar(car, Nil) = "(" ^ car ^ ")"
  51   | toStringWithCar(car, Pair(first, second)) =
  52     toStringWithCar(car ^ " " ^ sexprToString'(first), second)
  53   | toStringWithCar(car, e) = "(" ^ car ^ " . " ^ sexprToString'(e) ^ ")"
  54 and sexprToString(Void) = ""
  55   | sexprToString(e) = sexprToString'(e);
  56
  57 exception NotAList of Sexpr;
  58
  59 fun schemeListToML Nil = []
  60   | schemeListToML (Pair(car, cdr)) = car :: (schemeListToML cdr)
  61   | schemeListToML e = raise NotAList(e);
  62
  63 fun MLListToScheme [] = Nil
  64   | MLListToScheme (a :: s) = Pair(a, (MLListToScheme s));
  65
  66 exception ErrorOnlyCombinesPairs of Sexpr;
  67
  68 fun combine(Nil, e) = e
  69   | combine(Pair(car, cdr), e) = Pair(car, combine(cdr, e))
  70   | combine(someSexpr, e)      = raise ErrorOnlyCombinesPairs(someSexpr);