Mercurial > urweb
comparison src/monoize.sml @ 754:8688e01ae469
A view query works
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 28 Apr 2009 15:04:37 -0400 |
parents | d484df4e841a |
children | 8ce31c052dce |
comparison
equal
deleted
inserted
replaced
753:d484df4e841a | 754:8688e01ae469 |
---|---|
2936 fm, | 2936 fm, |
2937 [(L'.DTable (s, xts, pe, ce), loc), | 2937 [(L'.DTable (s, xts, pe, ce), loc), |
2938 (L'.DVal (x, n, t', e_name, s), loc)]) | 2938 (L'.DVal (x, n, t', e_name, s), loc)]) |
2939 end | 2939 end |
2940 | L.DTable _ => poly () | 2940 | L.DTable _ => poly () |
2941 | L.DView (x, n, s, e, (L.CRecord (_, xts), _)) => | |
2942 let | |
2943 val t = (L.CFfi ("Basis", "string"), loc) | |
2944 val t' = (L'.TFfi ("Basis", "string"), loc) | |
2945 val s = "uw_" ^ s | |
2946 val e_name = (L'.EPrim (Prim.String s), loc) | |
2947 | |
2948 val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts | |
2949 | |
2950 val (e, fm) = monoExp (env, St.empty, fm) e | |
2951 val e = (L'.EFfiApp ("Basis", "viewify", [e]), loc) | |
2952 in | |
2953 SOME (Env.pushENamed env x n t NONE s, | |
2954 fm, | |
2955 [(L'.DView (s, xts, e), loc), | |
2956 (L'.DVal (x, n, t', e_name, s), loc)]) | |
2957 end | |
2958 | L.DView _ => poly () | |
2941 | L.DSequence (x, n, s) => | 2959 | L.DSequence (x, n, s) => |
2942 let | 2960 let |
2943 val t = (L.CFfi ("Basis", "string"), loc) | 2961 val t = (L.CFfi ("Basis", "string"), loc) |
2944 val t' = (L'.TFfi ("Basis", "string"), loc) | 2962 val t' = (L'.TFfi ("Basis", "string"), loc) |
2945 val s = "uw_" ^ s | 2963 val s = "uw_" ^ s |