Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /MLRISC/trunk/vararg-ccall/varargs.sml
ViewVC logotype

Annotation of /MLRISC/trunk/vararg-ccall/varargs.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3068 - (view) (download)

1 : mrainey 3062 (* varargs.sml
2 :     *
3 :     * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4 :     *
5 :     * This is an experiment to see if we can implement typed varargs
6 :     * using combinators.
7 :     *
8 :     * call printf str o int o int : string -> int -> int -> unit
9 :     *
10 :     *)
11 :    
12 :     signature VAR_ARGS =
13 :     sig
14 :    
15 :     type 'a valist
16 :     type ('a, 'b) vararg = 'a valist -> ('b -> 'a) valist
17 :    
18 :     val int : ('a, int) vararg
19 :     val real : ('a, real) vararg
20 :     val bool : ('a, bool) vararg
21 :     val str : ('a, string) vararg
22 :    
23 :     type 'a vararg_fn
24 :    
25 :     val call : ('a vararg_fn) -> ('a valist -> 'b valist) -> 'b
26 :    
27 : mrainey 3068 val printf : unit vararg_fn
28 :    
29 : mrainey 3062 end;
30 :    
31 :     structure VarArgs :> VAR_ARGS =
32 :     struct
33 :    
34 :     (* an evaluation engine that serves as a target *)
35 : mrainey 3068 datatype argument = datatype VarargCCall.argument
36 : mrainey 3062
37 :     fun arg2str (I i) = Int.toString i
38 :     | arg2str (R r) = Real.toString r
39 :     | arg2str (B b) = Bool.toString b
40 :     | arg2str (S s) = concat["\"", String.toString s, "\""]
41 :    
42 :     val stk = ref([] : argument list)
43 : mrainey 3068 fun push arg = stk := arg :: !stk
44 :     fun callWithArgs (cFun, x) = let
45 : mrainey 3062 val args = !stk
46 :     in
47 :     stk := [];
48 : mrainey 3068 IA32VarargCCall.callWithArgs (cFun, args);
49 :     x
50 : mrainey 3062 end
51 :    
52 :     type 'a valist = ((unit -> unit) -> 'a)
53 :    
54 :     type ('a, 'b) vararg = 'a valist -> ('b -> 'a) valist
55 :    
56 :     (* combinators *)
57 :    
58 :     fun int k k' i = k(fn () => (push(I i); k'()))
59 :     fun real k k' r = k(fn () => (push(R r); k'()))
60 :     fun bool k k' b = k(fn () => (push(B b); k'()))
61 :     fun str k k' s = k(fn () => (push(S s); k'()))
62 :    
63 :     fun call f spec = spec (fn k => (k(); callWithArgs f)) (fn () => ())
64 :    
65 : mrainey 3068 type 'a vararg_fn = string * 'a
66 : mrainey 3062
67 : mrainey 3068 val printf = ("printf", ())
68 :    
69 : mrainey 3062 end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0