Mercurial > urweb
view lib/ur/list.ur @ 1739:c414850f206f
Add support for -boot flag, which allows in-tree execution of Ur/Web
The boot flag rewrites most hardcoded paths to point to the build
directory, and also forces static compilation. This is convenient
for developing Ur/Web, or if you cannot 'sudo make install' Ur/Web.
The following changes were made:
* Header files were moved to include/urweb instead of include;
this lets FFI users point their C_INCLUDE_PATH at this directory
at write <urweb/urweb.h>. For internal Ur/Web executables,
we simply pass -I$PATH/include/urweb as normal.
* Differentiate between LIB and SRCLIB; SRCLIB is Ur and JavaScript
source files, while LIB is compiled products from libtool. For
in-tree compilation these live in different places.
* No longer reference Config for paths; instead use Settings; these
settings can be changed dynamically by Compiler.enableBoot ()
(TODO: add a disableBoot function.)
* config.h is now generated directly in include/urweb/config.h,
for consistency's sake (especially since it gets installed
along with the rest of the headers!)
* All of the autotools build products got updated.
* The linkStatic field in protocols now only contains the name of the
build product, and not the absolute path.
Future users have to be careful not to reference the Settings files
to early, lest they get an old version (this was the source of two
bugs during development of this patch.)
author | Edward Z. Yang <ezyang@mit.edu> |
---|---|
date | Wed, 02 May 2012 17:17:57 -0400 |
parents | f4cb4eebf7ae |
children | a613cae954ca |
line wrap: on
line source
datatype t = datatype Basis.list val show = fn [a] (_ : show a) => let fun show' (ls : list a) = case ls of [] => "[]" | x :: ls => show x ^ " :: " ^ show' ls in mkShow show' end val eq = fn [a] (_ : eq a) => let fun eq' (ls1 : list a) ls2 = case (ls1, ls2) of ([], []) => True | (x1 :: ls1, x2 :: ls2) => x1 = x2 && eq' ls1 ls2 | _ => False in mkEq eq' end fun foldl [a] [b] (f : a -> b -> b) = let fun foldl' acc ls = case ls of [] => acc | x :: ls => foldl' (f x acc) ls in foldl' end val rev = fn [a] => let fun rev' acc (ls : list a) = case ls of [] => acc | x :: ls => rev' (x :: acc) ls in rev' [] end fun foldr [a] [b] f (acc : b) (ls : list a) = foldl f acc (rev ls) fun foldlAbort [a] [b] f = let fun foldlAbort' acc ls = case ls of [] => Some acc | x :: ls => case f x acc of None => None | Some acc' => foldlAbort' acc' ls in foldlAbort' end val length = fn [a] => let fun length' acc (ls : list a) = case ls of [] => acc | _ :: ls => length' (acc + 1) ls in length' 0 end fun foldlMapAbort [a] [b] [c] f = let fun foldlMapAbort' ls' acc ls = case ls of [] => Some (rev ls', acc) | x :: ls => case f x acc of None => None | Some (x', acc') => foldlMapAbort' (x' :: ls') acc' ls in foldlMapAbort' [] end val revAppend = fn [a] => let fun ra (ls : list a) acc = case ls of [] => acc | x :: ls => ra ls (x :: acc) in ra end fun append [a] (ls1 : t a) (ls2 : t a) = revAppend (rev ls1) ls2 fun mp [a] [b] f = let fun mp' acc ls = case ls of [] => rev acc | x :: ls => mp' (f x :: acc) ls in mp' [] end fun mapi [a] [b] f = let fun mp' n acc ls = case ls of [] => rev acc | x :: ls => mp' (n + 1) (f n x :: acc) ls in mp' 0 [] end fun mapPartial [a] [b] f = let fun mp' acc ls = case ls of [] => rev acc | x :: ls => mp' (case f x of None => acc | Some y => y :: acc) ls in mp' [] end fun mapX [a] [ctx ::: {Unit}] f = let fun mapX' ls = case ls of [] => <xml/> | x :: ls => <xml>{f x}{mapX' ls}</xml> in mapX' end fun mapXi [a] [ctx ::: {Unit}] f = let fun mapX' i ls = case ls of [] => <xml/> | x :: ls => <xml>{f i x}{mapX' (i + 1) ls}</xml> in mapX' 0 end fun mapM [m ::: (Type -> Type)] (_ : monad m) [a] [b] f = let fun mapM' acc ls = case ls of [] => return (rev acc) | x :: ls => x' <- f x; mapM' (x' :: acc) ls in mapM' [] end fun mapPartialM [m ::: (Type -> Type)] (_ : monad m) [a] [b] f = let fun mapPartialM' acc ls = case ls of [] => return (rev acc) | x :: ls => v <- f x; mapPartialM' (case v of None => acc | Some x' => x' :: acc) ls in mapPartialM' [] end fun mapXM [m ::: (Type -> Type)] (_ : monad m) [a] [ctx ::: {Unit}] f = let fun mapXM' ls = case ls of [] => return <xml/> | x :: ls => this <- f x; rest <- mapXM' ls; return <xml>{this}{rest}</xml> in mapXM' end fun filter [a] f = let fun fil acc ls = case ls of [] => rev acc | x :: ls => fil (if f x then x :: acc else acc) ls in fil [] end fun exists [a] f = let fun ex ls = case ls of [] => False | x :: ls => if f x then True else ex ls in ex end fun foldlMap [a] [b] [c] f = let fun fold ls' st ls = case ls of [] => (rev ls', st) | x :: ls => case f x st of (y, st) => fold (y :: ls') st ls in fold [] end fun find [a] f = let fun find' ls = case ls of [] => None | x :: ls => if f x then Some x else find' ls in find' end fun search [a] [b] f = let fun search' ls = case ls of [] => None | x :: ls => case f x of None => search' ls | v => v in search' end fun foldlM [m] (_ : monad m) [a] [b] f = let fun foldlM' acc ls = case ls of [] => return acc | x :: ls => acc <- f x acc; foldlM' acc ls in foldlM' end fun foldlMi [m] (_ : monad m) [a] [b] f = let fun foldlMi' i acc ls = case ls of [] => return acc | x :: ls => acc <- f i x acc; foldlMi' (i + 1) acc ls in foldlMi' 0 end fun filterM [m] (_ : monad m) [a] (p : a -> m bool) = let fun filterM' (acc : list a) (xs : list a) : m (list a) = case xs of [] => return (rev acc) | x :: xs => c <- p x; filterM' (if c then x :: acc else acc) xs in filterM' [] end fun all [m] f = let fun all' ls = case ls of [] => True | x :: ls => f x && all' ls in all' end fun app [m] (_ : monad m) [a] f = let fun app' ls = case ls of [] => return () | x :: ls => f x; app' ls in app' end fun mapQuery [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type] [tables ~ exps] (q : sql_query [] [] tables exps) (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> t) = ls <- query q (fn fs acc => return (f fs :: acc)) []; return (rev ls) fun mapQueryM [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type] [tables ~ exps] (q : sql_query [] [] tables exps) (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction t) = ls <- query q (fn fs acc => v <- f fs; return (v :: acc)) []; return (rev ls) fun mapQueryPartialM [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type] [tables ~ exps] (q : sql_query [] [] tables exps) (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction (option t)) = ls <- query q (fn fs acc => v <- f fs; return (case v of None => acc | Some v => v :: acc)) []; return (rev ls) fun sort [a] (gt : a -> a -> bool) (ls : t a) : t a = let fun split ls acc1 acc2 = case ls of [] => (rev acc1, rev acc2) | x :: [] => (rev (x :: acc1), rev acc2) | x1 :: x2 :: ls' => split ls' (x1 :: acc1) (x2 :: acc2) fun merge ls1 ls2 acc = case (ls1, ls2) of ([], _) => revAppend acc ls2 | (_, []) => revAppend acc ls1 | (x1 :: ls1', x2 :: ls2') => if gt x1 x2 then merge ls1 ls2' (x2 :: acc) else merge ls1' ls2 (x1 :: acc) fun sort' ls = case ls of [] => ls | _ :: [] => ls | _ => let val (ls1, ls2) = split ls [] [] in merge (sort' ls1) (sort' ls2) [] end in 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 replaceNth [a] (ls : list a) (n : int) (v : a) : list a = let fun repNth (ls : list a) (n : int) (acc : list a) = case ls of [] => rev acc | x :: ls' => if n <= 0 then revAppend acc (v :: ls') else repNth ls' (n-1) (x :: acc) in repNth ls n [] end fun assoc [a] [b] (_ : eq a) (x : a) = let fun assoc' (ls : list (a * b)) = case ls of [] => None | (y, z) :: ls => if x = y then Some z else assoc' ls in assoc' end fun assocAdd [a] [b] (_ : eq a) (x : a) (y : b) (ls : t (a * b)) = case assoc x ls of None => (x, y) :: ls | Some _ => ls fun recToList [a ::: Type] [r ::: {Unit}] (fl : folder r) = @foldUR [a] [fn _ => list a] (fn [nm ::_] [rest ::_] [[nm] ~ rest] x xs => x :: xs) [] fl fun take [a] (n : int) (xs : list a) : list a = if n <= 0 then [] else case xs of [] => [] | x :: xs => x :: take (n-1) xs fun drop [a] (n : int) (xs : list a) : list a = if n <= 0 then xs else case xs of [] => [] | x :: xs => drop (n-1) xs fun splitAt [a] (n : int) (xs : list a) : list a * list a = (take n xs, drop n xs)