diff options
Diffstat (limited to 'src/cjr_print.sml')
| -rw-r--r-- | src/cjr_print.sml | 80 |
1 files changed, 40 insertions, 40 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 5dcfbe89..70ebdf43 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -1014,52 +1014,39 @@ fun urlify env t = let fun urlify' level (t as (_, loc)) = case #1 t of - TFfi ("Basis", "unit") => box [] + TFfi ("Basis", "unit") => box [string "uw_Basis_urlifyString_w(ctx, \"\");", + newline] | TFfi (m, t) => box [string ("uw_" ^ ident m ^ "_urlify" ^ capitalize t ^ "_w(ctx, it" ^ Int.toString level ^ ");"), newline] - | TRecord 0 => box [] + | TRecord 0 => box [string "uw_Basis_urlifyString_w(ctx, \"\");", + newline] | TRecord i => let - fun empty (t, _) = - case t of - TFfi ("Basis", "unit") => true - | TRecord 0 => true - | TRecord j => - List.all (fn (_, t) => empty t) (E.lookupStruct env j) - | _ => false - val xts = E.lookupStruct env i val (blocks, _) = foldl (fn ((x, t), (blocks, printingSinceLastSlash)) => - let - val thisEmpty = empty t - in - if thisEmpty then - (blocks, printingSinceLastSlash) - else - (box [string "{", - newline, - p_typ env t, - space, - string ("it" ^ Int.toString (level + 1)), - space, - string "=", - space, - string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"), - newline, - box (if printingSinceLastSlash then - [string "uw_write(ctx, \"/\");", - newline] - else - []), - urlify' (level + 1) t, - string "}", - newline] :: blocks, - true) - end) + (box [string "{", + newline, + p_typ env t, + space, + string ("it" ^ Int.toString (level + 1)), + space, + string "=", + space, + string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"), + newline, + box (if printingSinceLastSlash then + [string "uw_write(ctx, \"/\");", + newline] + else + []), + urlify' (level + 1) t, + string "}", + newline] :: blocks, + true)) ([], false) xts in box (rev blocks) @@ -3243,10 +3230,11 @@ fun p_file env (ds, ps) = val _ = foldl (fn (d, env) => ((case #1 d of - DDatabase {name = x, expunge = y, initialize = z} => (hasDb := true; - dbstring := x; - expunge := y; - initialize := z) + DDatabase {name = x, expunge = y, initialize = z, ...} => + (hasDb := true; + dbstring := x; + expunge := y; + initialize := z) | DJavaScript _ => hasJs := true | DTable (s, xts, _, _) => tables := (s, map (fn (x, t) => (x, sql_type_in env t)) xts) :: !tables @@ -3766,6 +3754,8 @@ fun declaresAsForeignKey xs s = fun p_sql env (ds, _) = let + val usesSimilar = ref false + val (pps, _) = ListUtil.foldlMap (fn (dAll as (d, _), env) => let @@ -3850,6 +3840,9 @@ fun p_sql env (ds, _) = string ";", newline, newline] + | DDatabase {usesSimilar = s, ...} => + (usesSimilar := s; + box []) | _ => box [] in (pp, E.declBinds env dAll) @@ -3862,6 +3855,13 @@ fun p_sql env (ds, _) = NONE => (ErrorMsg.error "Using file cache with database that doesn't support SHA512"; []) | SOME r => [string (#InitializeDb r), newline, newline]) + @ (if !usesSimilar then + case #supportsSimilar (Settings.currentDbms ()) of + NONE => (ErrorMsg.error "Using SIMILAR with database that doesn't support it"; + []) + | SOME r => [string (#InitializeDb r), newline, newline] + else + []) @ string (#sqlPrefix (Settings.currentDbms ())) :: pps) end |