| 4 |
signature OPT_UTILS = |
signature OPT_UTILS = |
| 5 |
sig |
sig |
| 6 |
|
|
| 7 |
|
datatype ('a,'b) either = A of 'a | B of 'b |
| 8 |
|
|
| 9 |
(* takes the fk of a function and returns the fk of the wrapper |
(* takes the fk of a function and returns the fk of the wrapper |
| 10 |
* along with the new fk of the actual body *) |
* along with the new fk of the actual body *) |
| 11 |
val fk_wrap : FLINT.fkind * FLINT.lty list option -> |
val fk_wrap : FLINT.fkind * FLINT.lty list option -> |
| 23 |
local structure F = FLINT |
local structure F = FLINT |
| 24 |
structure LK = LtyKernel |
structure LK = LtyKernel |
| 25 |
in |
in |
| 26 |
|
datatype ('a,'b) either = A of 'a | B of 'b |
| 27 |
|
|
| 28 |
fun bug msg = ErrorMsg.impossible ("OptUtils: "^msg) |
fun bug msg = ErrorMsg.impossible ("OptUtils: "^msg) |
| 29 |
|
|
| 30 |
fun fk_wrap (F.FK_FCT,_) = (F.FK_FCT, F.FK_FCT) |
fun fk_wrap ({inline,known,isrec,cconv},rtys') = |
| 31 |
| fk_wrap (F.FK_FUN{isrec,known,fixed,inline},rtys') = |
let val cconv' = |
| 32 |
let val fixed' = case fixed |
case cconv |
| 33 |
of LK.FF_VAR(f1,f2) => LK.FF_VAR(true, f2) |
of F.CC_FUN(LK.FF_VAR(f1,f2)) => F.CC_FUN(LK.FF_VAR(true, f2)) |
| 34 |
| LK.FF_FIXED => LK.FF_FIXED |
| (F.CC_FCT | F.CC_FUN(LK.FF_FIXED)) => cconv |
| 35 |
in (F.FK_FUN{isrec=isrec, known=known, fixed=fixed, inline=true}, |
val isrec' = Option.map (fn ltys => (ltys, F.LK_UNKNOWN)) rtys' |
| 36 |
F.FK_FUN{isrec=rtys', known=true, fixed=fixed', inline=inline}) |
in ({isrec=isrec, known=known, cconv=cconv, inline=F.IH_ALWAYS}, |
| 37 |
|
{isrec=isrec', known=true, cconv=cconv', inline=inline}) |
| 38 |
end |
end |
| 39 |
|
|
| 40 |
fun filter ([],[]) = [] |
fun filter ([],[]) = [] |
Parent Directory
| 
Revision Log
| 
Patch
