1 # Lift to types
2 @@type (x)
3 {
4 if _isint(x): "int"
5 else if _isstr(x): "str"
6 else if _isbot(x): "RE"
7 else if _istbl(x):
8 if x.?car && x.?cdr:
9 let xa = x.car in let xd = x.cdr in
10 mergeType( {list: @type(xa)}, @type(xd) )
11 else
12 {list: "RE"} # tenuki
13 else ...
14 };
15
16 # unify two types
17 def mergeType(a, b)
18 {
19 if a == "RE": b
20 else if b == "RE": a
21 else if _istbl(a) && _istbl(b):
22 if a.?list && b.?list:
23 let rt = mergeType(a.list, b.list) in
24 if rt=="TE" || rt=="RE" then rt else {list: rt}
25 else:
26 "TE" # type error
27 else if a == b: a
28 else "TE" # type error
29 };
30
31 # helper function
32 def Tuni(t1, t0)
33 {
34 fun(x) {@value(
35 if @type(x)=="RE": "RE"
36 else if @type(x)=="TE": "TE"
37 else if @type(x)==t1: t0
38 else "TE"
39 )}
40 };
41 def Tuniany(t0)
42 {
43 fun(x) {@value(
44 if @type(x)=="RE": "RE"
45 else if @type(x)=="TE": "TE"
46 else t0
47 )}
48 };
49 def Tbin(t1, t2, t0)
50 {
51 fun(x,y) {@value(
52 if @type(x)=="RE" || @type(y)=="RE": "RE"
53 else if @type(x)=="TE" || @type(y)=="TE": "TE"
54 else if @type(x)==t1 && @type(y)==t2: t0
55 else "TE"
56 )}
57 };
58 def Tbinany(t0)
59 {
60 fun(x,y){@value(
61 if @type(x)=="RE" || @type(y)=="RE": "RE"
62 else if @type(x)=="TE" || @type(y)=="TE": "TE"
63 else t0
64 )}
65 };
66
67 # type annotation for built-in ops
68 @type + = Tbin("int", "int", "int");
69 @type - = Tbin("int", "int", "int");
70 @type * = Tbin("int", "int", "int");
71 @type / = Tbin("int", "int", "int");
72 @type % = Tbin("int", "int", "int");
73 @type && = Tbin("int", "int", "int");
74 @type || = Tbin("int", "int", "int");
75 @type print = fun(x){x};
76 @type gensym = fun(){"str"};
77 @type argv = {list: "str"};
78 @type rand = Tuni("int","int");
79 @type ~ = Tbinany("str");
80 @type < = Tbinany("int");
81 @type <= = Tbinany("int");
82 @type > = Tbinany("int");
83 @type >= = Tbinany("int");
84 @type == = Tbinany("int");
85 @type != = Tbinany("int");
86 @type if (c,t,e) {@value(
87 if @type(c)=="RE": "RE"
88 else if @type(c)!="int": "TE"
89 else mergeType( @type(t()), @type(e()) );
90 )};
91 @type _isint = Tuniany("int");
92 @type _isstr = Tuniany("int");
93 @type _isfun = Tuniany("int");
94 @type _istbl = Tuniany("int");
95 @type _isbot = Tuniany("int");
96
97 ###################################
98
99 # for lists
100 @type "{}"() {@value( {list: "RE"} )};
101 @type .? (t, s) {@value(
102 if @type(t)=="RE": "RE"
103 else if @type(t)=="TE": "TE"
104 else if _istbl( @type(t) ): "int"
105 else "TE"
106 )};
107 @type .= (t, s@value, v) {@value(
108 var tt = @type(t);
109 if tt == "TE": "TE"
110 else if tt == "RE": "RE"
111 else if _istbl(tt) && tt.?list:
112 if s == "car":
113 mergeType(tt, {list: @type(v)})
114 else if s == "cdr":
115 mergeType(tt, @type(v))
116 else:
117 tt
118 else:
119 "TE"
120 )};
121 @type . (t, s@value) {@value(
122 var tt = @type(t);
123 if tt == "TE": "TE"
124 else if tt == "RE": "RE"
125 else if _istbl(tt) && tt.?list:
126 if s == "car":
127 tt.list
128 else if s == "cdr":
129 tt
130 else:
131 "TE"
132 else:
133 "TE"
134 )};
135
136 ###################################
137
138 def fib(x) { if x < 2 then 1 else fib(x-1) + fib(x-2) };
139 def fibE1(x) { if "true!" then 1 else fib(x-1) + fib(x-2) };
140 def fibE2(x) { if x<2 then "ichi" else fib(x-1) + fib(x-2) };
141 def fibE3(x) { if x<2 then 1 else fib(x-1) ~ fib(x-2) };
142 def fibS(x) { if x<2 then "1" else fib(x-1) ~ fib(x-2) };
143 def fibBadButTypeIsOK(x) { if x < "2" then 1 else fib(x-1) + fib(x-2) };
144
145 print( @type(fib(999)) );
146 print( @type(fibE1(999)) );
147 print( @type(fibE2(999)) );
148 print( @type(fibE3(999)) );
149 print( @type(fibS(999)) );
150 print( @type(fibBadButTypeIsOK(999)) );
151
152 ###################################
153
154 def nil = {};
155 def cons(a, d) { {car: a, cdr: d} };
156
157 print( @type(nil) );
158 print( @type(cons(1,nil)) );
159 print( @type(cons("foo",nil)) );
160 print( @type(cons(123, cons("foo",nil))) ); # TE
161
162 def rev(xs) {
163 def revi(xs, ys) {
164 case xs
165 when {car: x, cdr: xs}: revi(xs, cons(x,ys))
166 when {}: ys
167 };
168 revi(xs, {})
169 };
170
171 def str_app(xs, ys) {
172 case xs
173 when {car: x, cdr: xs}: cons(""~x, str_app(xs, ys))
174 when {}: ys
175 };
176
177 var xs = cons(1, cons(2, cons(3, nil)));
178 var ys = cons("four", cons("five", cons("six", nil)));
179 print( @type( rev(xs) ) );
180 print( @type( rev(ys) ) );
181 print( @type( str_app(xs,ys) ) );
182 print( @type( str_app(xs,xs) ) );