Differences From Artifact [6a40040679ba714c]:
- File
sample/type.pmy
- 2010-11-27 14:23:54 - part of checkin [005474ba5b] on branch trunk - changed: not to lift _|_ (user: kinaba) [annotate]
To Artifact [e50284fdcde212f7]:
- File
sample/type.pmy
- 2010-11-27 23:46:51 - part of checkin [576c494e53] on branch trunk - fixed: literal "..." is now lifted in user-defined layers (user: kinaba) [annotate]
1 -@@type = fun(x){
2 - if _isint(x): "int"
3 - else if _isstr(x): "str"
4 - else: "any"
5 -};
6 -
7 -def binop(a,b,c) {
8 - fun(x,y){@value(
9 - if( _isbot( @type(x) ) || _isbot( @type(y) ) ) then @type(...) else
10 - if( @type(x)==a && @type(y)==b ) then c else "error"
11 - )}
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 ...
12 14 };
13 15
14 -@type "+" = binop("int", "int", "int");
15 -@type "-" = binop("int", "int", "int");
16 -@type "<" = binop("int", "int", "int");
17 -@type ">" = binop("int", "int", "int");
18 -
19 -def mergeType(a,b) {
20 - if( _isbot(a) ): ( if( _isbot(b) ):"error" else b ) else ( a )
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
21 29 };
22 30
23 -@type "if" = fun(c,t,e) {@value(
24 - if(@type(c)=="int" ): mergeType(@type(t()), @type(e())) else : "error"
25 -)};
26 -
27 -def fib(x)
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)
28 59 {
29 - if x<2 then 1 else fib(x-1) + fib(x-2)
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, {})
30 169 };
31 170
32 -print( @type(fib(10)) );
171 +var xs = cons(1, cons(2, cons(3, nil)));
172 +print( @type( rev(xs) ) );