another update in support-code.scm
[bugg-scheme-compiler.git] / src / sml / utils.sml
blob438fdd2409b9f09f6adc3523b4cad9948e2c0f79
1 (* Utility functions *)
3 fun andmap f nil = true
4 | andmap f (a :: s) = (f a) andalso (andmap f s);
6 fun ormap f nil = false
7 | ormap f (a :: s) = (f a) orelse (ormap f s);
9 fun makeIsChar(string) =
10 let val chars = explode(string)
12 fn ch => ormap (fn ch' => ch = ch') chars
13 end;
15 fun makeCharInRange(charFrom, charTo) =
16 fn ch : char => (charFrom <= ch) andalso (ch <= charTo);
18 fun stringEqual(string1, string2) =
19 String.compare(string1, string2) = EQUAL;
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
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);
57 exception NotAList of Sexpr;
59 fun schemeListToML Nil = []
60 | schemeListToML (Pair(car, cdr)) = car :: (schemeListToML cdr)
61 | schemeListToML e = raise NotAList(e);
63 fun MLListToScheme [] = Nil
64 | MLListToScheme (a :: s) = Pair(a, (MLListToScheme s));
66 exception ErrorOnlyCombinesPairs of Sexpr;
68 fun combine(Nil, e) = e
69 | combine(Pair(car, cdr), e) = Pair(car, combine(cdr, e))
70 | combine(someSexpr, e) = raise ErrorOnlyCombinesPairs(someSexpr);
72 fun intToCString i = if i<0 then "-"^(Int.toString (~i))
73 else (Int.toString i);