From 4f2c619bb0971153c518f120c8911ce3a94f783d Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 21 Nov 2010 15:43:24 -0500 Subject: Fix a bug in C list unurlification --- lib/ur/list.ur | 14 ++++++++++++++ lib/ur/list.urs | 2 ++ src/cjr_print.sml | 4 ++-- 3 files changed, 18 insertions(+), 2 deletions(-) diff --git a/lib/ur/list.ur b/lib/ur/list.ur index 71d8fa98..354ef132 100644 --- a/lib/ur/list.ur +++ b/lib/ur/list.ur @@ -308,6 +308,20 @@ fun sort [a] (gt : a -> a -> bool) (ls : t a) : t a = sort' ls end +val nth [a] = + let + fun nth (ls : list a) (n : int) : option a = + case ls of + [] => None + | x :: ls' => + if n <= 0 then + Some x + else + nth ls' (n-1) + in + nth + end + fun assoc [a] [b] (_ : eq a) (x : a) = let fun assoc' (ls : list (a * b)) = diff --git a/lib/ur/list.urs b/lib/ur/list.urs index a0cec8fb..c23bf840 100644 --- a/lib/ur/list.urs +++ b/lib/ur/list.urs @@ -71,6 +71,8 @@ val mapQueryPartialM : tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type val sort : a ::: Type -> (a -> a -> bool) (* > predicate *) -> t a -> t a +val nth : a ::: Type -> list a -> int -> option a + (** Association lists *) val assoc : a ::: Type -> b ::: Type -> eq a -> a -> t (a * b) -> option b diff --git a/src/cjr_print.sml b/src/cjr_print.sml index e440a53d..99b42657 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -861,7 +861,7 @@ fun unurlify fromClient env (t, loc) = space, string "+=", space, - string "3, NULL) : ((!strncmp(request, \"Cons\", 4) && (request[4] == 0 ", + string "3, (*request == '/' ? *request++ = 0 : 0), NULL) : ((!strncmp(request, \"Cons\", 4) && (request[4] == 0 ", string "|| request[4] == '/')) ? (request", space, string "+=", @@ -895,7 +895,7 @@ fun unurlify fromClient env (t, loc) = newline, string ":", space, - string ("(uw_error(ctx, FATAL, \"Error unurlifying list\"), NULL))));"), + string ("(uw_error(ctx, FATAL, \"Error unurlifying list: %s\", request), NULL))));"), newline], string "}", newline, -- cgit v1.2.3