Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 185 lines (143 sloc) 5.766 kb
4006f11 Add resfile and resimp
Edwin Brady authored
1
2 -- IO operations which read a resource
3 data Reader : Set -> Set where
4 MkReader : IO a -> Reader a;
5
6 getReader : Reader a -> IO a;
7 getReader (MkReader x) = x;
8
9 ior : IO a -> Reader a;
10 ior = MkReader;
11
12 -- IO operations which update a resource
13 data Updater : Set -> Set where
14 MkUpdater : IO a -> Updater a;
15
16 getUpdater : Updater a -> IO a;
17 getUpdater (MkUpdater x) = x;
18
19 iou : IO a -> Updater a;
20 iou = MkUpdater;
21
22 -- IO operations which create a resource
23 data Creator : Set -> Set where
24 MkCreator : IO a -> Creator a;
25
26 getCreator : Creator a -> IO a;
27 getCreator (MkCreator x) = x;
28
29 ioc : IO a -> Creator a;
30 ioc = MkCreator;
31
d3bb881 Switched to CPS
Edwin Brady authored
32 using (i: Fin n, gam : Vect Ty n, gam' : Vect Ty n, gam'' : Vect Ty n) {
4006f11 Add resfile and resimp
Edwin Brady authored
33
d3bb881 Switched to CPS
Edwin Brady authored
34 infixr 5 :-> ;
4006f11 Add resfile and resimp
Edwin Brady authored
35
d3bb881 Switched to CPS
Edwin Brady authored
36 data Ty = R Set
37 | Val Set
38 | Choice Set Set
39 | (:->) Set Ty;
4006f11 Add resfile and resimp
Edwin Brady authored
40
d3bb881 Switched to CPS
Edwin Brady authored
41 interpTy : Ty -> Set;
42 interpTy (R t) = IO t;
43 interpTy (Val t) = t;
44 interpTy (Choice x y) = Either x y;
898231d Functions in resimp/resfile
Edwin Brady authored
45 interpTy (a :-> b) = a -> interpTy b;
4006f11 Add resfile and resimp
Edwin Brady authored
46
d3bb881 Switched to CPS
Edwin Brady authored
47 data HasType : Vect Ty n -> Fin n -> Ty -> Set where
48 stop : HasType (a :: gam) fO a
49 | pop : HasType gam i b -> HasType (a :: gam) (fS i) b;
4006f11 Add resfile and resimp
Edwin Brady authored
50
d3bb881 Switched to CPS
Edwin Brady authored
51 data Env : Vect Ty n -> Set where
4006f11 Add resfile and resimp
Edwin Brady authored
52 Empty : Env VNil
d3bb881 Switched to CPS
Edwin Brady authored
53 | Extend : interpTy a -> Env gam -> Env (a :: gam);
a3a340a Removed the rather ugly ResFn/Call and replaced it with syntax macros
Edwin Brady authored
54
d3bb881 Switched to CPS
Edwin Brady authored
55 envLookup : HasType gam i a -> Env gam -> interpTy a;
4006f11 Add resfile and resimp
Edwin Brady authored
56 envLookup stop (Extend x xs) = x;
57 envLookup (pop k) (Extend x xs) = envLookup k xs;
58
d3bb881 Switched to CPS
Edwin Brady authored
59 update : (gam : Vect Ty n) -> HasType gam i b -> Ty -> Vect Ty n;
60 update (x :: xs) stop y = y :: xs;
61 update (x :: xs) (pop k) y = x :: update xs k y;
62
63 envUpdate : (p:HasType gam i a) -> (val:interpTy b) ->
4006f11 Add resfile and resimp
Edwin Brady authored
64 Env gam -> Env (update gam p b);
65 envUpdate stop val (Extend x xs) = Extend val xs;
66 envUpdate (pop k) val (Extend x xs) = Extend x (envUpdate k val xs);
67
68 envTail : Env (a :: gam) -> Env gam;
69 envTail (Extend x xs) = xs;
70
898231d Functions in resimp/resfile
Edwin Brady authored
71 data Args : Vect Ty n -> List Set -> Set where
72 ANil : Args gam Nil
73 | ACons : HasType gam i a ->
74 Args gam as -> Args gam (Cons (interpTy a) as);
75
76 funTy : List Set -> Ty -> Ty;
77 funTy Nil t = t;
78 funTy (Cons a as) t = a :-> funTy as t;
79
80 applyArgs : Env gam -> interpTy (funTy as t) -> Args gam as -> interpTy t;
81 applyArgs env f ANil = f;
82 applyArgs env f (ACons x xs) = applyArgs env (f (envLookup x env)) xs;
83
d3bb881 Switched to CPS
Edwin Brady authored
84 data [noElim] Res : Vect Ty n -> Vect Ty n -> Ty -> Set where
85
86 {-- Resource creation and usage. 'Let' creates a resource - the type
87 at the end means that the resource must have been consumed by the time
88 it goes out of scope, where "consumed" simply means that it has been
89 replaced with a value of type '()'. --}
90
91 Let : Creator (interpTy a) ->
a3a340a Removed the rather ugly ResFn/Call and replaced it with syntax macros
Edwin Brady authored
92 Res (a :: gam) (Val () :: gam') (R t) -> Res gam gam' (R t)
d3bb881 Switched to CPS
Edwin Brady authored
93 | Update : (a -> Updater b) -> (p:HasType gam i (Val a)) ->
898231d Functions in resimp/resfile
Edwin Brady authored
94 Res gam (update gam p (Val b)) (R ())
d3bb881 Switched to CPS
Edwin Brady authored
95 | Use : (a -> Reader b) -> HasType gam i (Val a) ->
898231d Functions in resimp/resfile
Edwin Brady authored
96 Res gam gam (R b)
d3bb881 Switched to CPS
Edwin Brady authored
97
98 {-- Control structures --}
99
898231d Functions in resimp/resfile
Edwin Brady authored
100 | Lift' : IO a -> Res gam gam (R a)
d3bb881 Switched to CPS
Edwin Brady authored
101 | Check : (p:HasType gam i (Choice (interpTy a) (interpTy b))) ->
102 (failure:Res (update gam p a) (update gam p c) T) ->
103 (success:Res (update gam p b) (update gam p c) T) ->
104 Res gam (update gam p c) T
898231d Functions in resimp/resfile
Edwin Brady authored
105 | While : Res gam gam (R Bool) ->
106 Res gam gam (R ()) -> Res gam gam (R ())
107 | Return : a -> Res gam gam (R a)
108 | Bind : Res gam gam' (R a) -> (a -> Res gam' gam'' (R t)) ->
109 Res gam gam'' (R t);
110
d3bb881 Switched to CPS
Edwin Brady authored
111 syntax Lift x = Lift' (lazy x); -- workaround for laziness not working on cons
112
113 iofst : IO (a & b) -> IO a;
114 iofst ip = do { p <- ip;
115 return (fst p); };
116
117 interp : Env gam -> Res gam gam' t ->
118 (Env gam' -> interpTy t -> IO u) -> IO u;
898231d Functions in resimp/resfile
Edwin Brady authored
119
120 interp : Env gam -> Res gam gam' t ->
121 (Env gam' -> interpTy t -> IO u) -> IO u;
d3bb881 Switched to CPS
Edwin Brady authored
122 interp env (Let val scope) k
4006f11 Add resfile and resimp
Edwin Brady authored
123 = do { x <- getCreator val;
d3bb881 Switched to CPS
Edwin Brady authored
124 interp (Extend x env) scope
125 (\env', scope' => k (envTail env') scope');
4006f11 Add resfile and resimp
Edwin Brady authored
126 };
d3bb881 Switched to CPS
Edwin Brady authored
127 interp env (Update method x) k
4006f11 Add resfile and resimp
Edwin Brady authored
128 = do { x' <- getUpdater (method (envLookup x env));
898231d Functions in resimp/resfile
Edwin Brady authored
129 k (envUpdate x x' env) (return II);
4006f11 Add resfile and resimp
Edwin Brady authored
130 };
d3bb881 Switched to CPS
Edwin Brady authored
131 interp env (Use method x) k
4006f11 Add resfile and resimp
Edwin Brady authored
132 = do { x' <- getReader (method (envLookup x env));
898231d Functions in resimp/resfile
Edwin Brady authored
133 k env (return x');
4006f11 Add resfile and resimp
Edwin Brady authored
134 };
898231d Functions in resimp/resfile
Edwin Brady authored
135
d3bb881 Switched to CPS
Edwin Brady authored
136 interp env (Lift' io) k
898231d Functions in resimp/resfile
Edwin Brady authored
137 = do { -- v <- io;
138 k env io; };
d3bb881 Switched to CPS
Edwin Brady authored
139 interp env (Check x left right) k =
140 either (envLookup x env)
141 (\a => interp (envUpdate x a env) left k)
142 (\b => interp (envUpdate x b env) right k);
143 interp env (While test body) k
144 = interp env test
145 (\env', result =>
898231d Functions in resimp/resfile
Edwin Brady authored
146 do { r <- result;
147 if (not r)
148 then (k env' (return II))
149 else (interp env' body
150 (\env'', body' =>
151 do { v <- body'; -- make sure it's evalled
152 interp env'' (While test body) k; }));
153 });
154
155 interp env (Return v) k = k env (return v);
d3bb881 Switched to CPS
Edwin Brady authored
156 interp env (Bind v f) k
898231d Functions in resimp/resfile
Edwin Brady authored
157 = interp env v (\env', v' => do { n <- v';
158 interp env' (f n) k; });
d3bb881 Switched to CPS
Edwin Brady authored
159
898231d Functions in resimp/resfile
Edwin Brady authored
160 run : Res VNil VNil (R t) -> IO t;
161 run prog = interp Empty prog (\env, res => res);
4006f11 Add resfile and resimp
Edwin Brady authored
162
163 }
164
165 dsl res {
166 bind = Bind
167 return = Return
168 variable = id
169 let = Let
170 index_first = stop
171 index_next = pop
bcefa05 Minor tweaks
Edwin Brady authored
172 }
173
898231d Functions in resimp/resfile
Edwin Brady authored
174 syntax RES x = #( {gam:Vect Ty n} -> Res gam gam (R x) );
a3a340a Removed the rather ugly ResFn/Call and replaced it with syntax macros
Edwin Brady authored
175
176 infixr 5 :->, |-> ;
177
178 syntax (:->) x y
179 = #( {gam:Vect Ty n} -> HasType gam i (Val x) -> Res gam gam y) ;
180
181 syntax (|->) x y
182 = #( {gam:Vect Ty n} -> (p:HasType gam i (Val x)) ->
183 Res gam (update gam p y) (R ())) ;
4006f11 Add resfile and resimp
Edwin Brady authored
184
Something went wrong with that request. Please try again.