mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
add basics.u sample file and delete a bunch of old .u files
This commit is contained in:
Paul Chiusano
parent
f2e2b9ed7f
commit
7d9deec69a
@ -374,6 +374,7 @@ renderTypeError env e src = AT.AnnotatedDocument . Seq.fromList $ case e of
|
||||
'2' -> "nd"
|
||||
'3' -> "rd"
|
||||
_ -> "th"
|
||||
renderTerm (ABT.Var' v) | Settings.demoHideVarNumber = fromString (Text.unpack $ Var.name v)
|
||||
renderTerm e = let s = show e in -- todo: pretty print
|
||||
if length s > maxTermDisplay
|
||||
then fromString (take maxTermDisplay s <> "...")
|
||||
|
||||
@ -1,277 +0,0 @@
|
||||
identity : ∀ a . a -> a
|
||||
identity a = a
|
||||
|
||||
const x y = x
|
||||
|
||||
and-then : ∀ a b c . (a -> b) -> (b -> c) -> a -> c
|
||||
and-then f1 f2 x = f2 (f1 x)
|
||||
|
||||
(|>) : ∀ a b . a -> (a -> b) -> b
|
||||
a |> f = f a
|
||||
|
||||
(<|) : ∀ a b . (a -> b) -> a -> b
|
||||
f <| a = f a
|
||||
|
||||
flip : ∀ a b c . (a -> b -> c) -> b -> a -> c
|
||||
flip f b a = f a b
|
||||
|
||||
first : ∀ a b . Pair a b -> a
|
||||
first p = Pair.fold const p
|
||||
|
||||
rest : ∀ a b . Pair a b -> b
|
||||
rest p = Pair.fold (x y -> y) p
|
||||
|
||||
1st = first
|
||||
2nd = rest `and-then` first
|
||||
3rd = rest `and-then` (rest `and-then` first)
|
||||
4th = rest `and-then` (rest `and-then` (rest `and-then` first))
|
||||
5th = rest `and-then` (rest `and-then` (rest `and-then` (rest `and-then` first)))
|
||||
|
||||
set-1st : ∀ a a2 b . a2 -> Pair a b -> Pair a2 b
|
||||
set-1st new-1st p = Pair new-1st (rest p)
|
||||
|
||||
Order.compare : ∀ a . Order a -> a -> a -> Comparison
|
||||
Order.compare o a1 a2 = Order.Key.compare (Order.key o a1) (Order.key o a2)
|
||||
|
||||
Order.equal : ∀ a . Order a -> a -> a -> Boolean
|
||||
Order.equal o a a2 =
|
||||
Comparison.fold False True False (Order.compare o a a2)
|
||||
|
||||
Order.tuple2 : ∀ a b . Order a -> Order b -> Order (a,b)
|
||||
Order.tuple2 a b = Pair.Order a (Pair.Order b Unit.Order)
|
||||
|
||||
Order.tuple3 : ∀ a b c . Order a -> Order b -> Order c -> Order (a,b,c)
|
||||
Order.tuple3 a b c = Pair.Order a (Pair.Order b (Pair.Order c Unit.Order))
|
||||
|
||||
Order.by-1st : ∀ a b . Order a -> Order (Pair a b)
|
||||
Order.by-1st a = Pair.Order a Order.ignore
|
||||
|
||||
Order.by-2nd : ∀ a b c . Order b -> Order (Pair a (Pair b c))
|
||||
Order.by-2nd b = Pair.Order Order.ignore (Pair.Order b Order.ignore)
|
||||
|
||||
Order.by-3rd : ∀ a b c d . Order c -> Order (Pair a (Pair b (Pair c d)))
|
||||
Order.by-3rd c = Pair.Order Order.ignore (Pair.Order Order.ignore (Pair.Order c Order.ignore))
|
||||
|
||||
Vector.bind : ∀ a b . (a -> Vector b) -> Vector a -> Vector b
|
||||
Vector.bind f v = Vector.fold-balanced Vector.concatenate Vector.empty (Vector.map f v)
|
||||
|
||||
Vector.pure = Vector.single
|
||||
|
||||
Vector.replicate : ∀ a . Number -> a -> Vector a
|
||||
Vector.replicate n a = Vector.map (const a) (Vector.range 0 n)
|
||||
|
||||
Vector.fold-right : ∀ a b . (a -> b -> b) -> b -> Vector a -> b
|
||||
Vector.fold-right f z vs = Vector.fold-left (flip f) z (Vector.reverse vs)
|
||||
|
||||
Vector.fold-balanced : ∀ a . (a -> a -> a) -> a -> Vector a -> a
|
||||
Vector.fold-balanced plus zero vs = let rec
|
||||
go plus zero vs =
|
||||
if Vector.size vs <=_Number 2
|
||||
then Vector.fold-left plus zero vs
|
||||
else let p = Vector.halve vs
|
||||
go plus zero (1st p) `plus` go plus zero (2nd p)
|
||||
go plus zero vs
|
||||
|
||||
Optional.map : ∀ a b . (a -> b) -> Optional a -> Optional b
|
||||
Optional.map f = Optional.fold None (f `and-then` Some)
|
||||
|
||||
Optional.bind : ∀ a b . (a -> Optional b) -> Optional a -> Optional b
|
||||
Optional.bind f a = Optional.fold None f a
|
||||
|
||||
Optional.pure : ∀ a . a -> Optional a
|
||||
Optional.pure = Some
|
||||
|
||||
Optional.get-or : ∀ a . a -> Optional a -> a
|
||||
Optional.get-or a = Optional.fold a identity
|
||||
|
||||
Optional.somes : ∀ a . Vector (Optional a) -> Vector a
|
||||
Optional.somes = Vector.bind (Optional.fold Vector.empty Vector.single)
|
||||
|
||||
Optional.map2 : ∀ a b c . (a -> b -> c) -> Optional a -> Optional b -> Optional c
|
||||
Optional.map2 f a b = do Optional
|
||||
a := a
|
||||
b := b
|
||||
pure (f a b)
|
||||
|
||||
Optional.lift-or : ∀ a . (a -> a -> a) -> Optional a -> Optional a -> Optional a
|
||||
Optional.lift-or f = a1 a2 ->
|
||||
a1 |> Optional.fold a2 (a1 -> Optional.fold None (a2 -> Some (f a1 a2)) a2)
|
||||
|
||||
Optional.fold' : ∀ a b . (Unit -> b) -> (a -> b) -> Optional a -> Unit -> b
|
||||
Optional.fold' thunk f = Optional.fold thunk (a u -> f a)
|
||||
|
||||
Vector.fold-balanced1 : ∀ a . (a -> a -> a) -> Vector a -> Optional a
|
||||
Vector.fold-balanced1 f v = Vector.fold-balanced (Optional.lift-or f) None (Vector.map Some v)
|
||||
|
||||
Vector.join : ∀ a . Vector (Vector a) -> Vector a
|
||||
Vector.join = Vector.bind identity
|
||||
|
||||
Vector.filter : ∀ a . (a -> Boolean) -> Vector a -> Vector a
|
||||
Vector.filter f = Vector.bind (a -> if f a then [a] else [])
|
||||
|
||||
Vector.all? : ∀ a . (a -> Boolean) -> Vector a -> Boolean
|
||||
Vector.all? f vs = Vector.fold-balanced and True (Vector.map f vs)
|
||||
|
||||
Vector.sort-by : ∀ k a . Order k -> (a -> k) -> Vector a -> Vector a
|
||||
Vector.sort-by ok f v =
|
||||
Vector.sort-keyed <| Vector.map (a -> (Order.key ok (f a), a)) v
|
||||
|
||||
Vector.sort : ∀ a . Order a -> Vector a -> Vector a
|
||||
Vector.sort o = Vector.sort-by o identity
|
||||
|
||||
Vector.last : ∀ a . Vector a -> Optional a
|
||||
Vector.last v = Vector.at (Vector.size v - 1) v
|
||||
|
||||
Vector.1st : ∀ a . Vector a -> Optional a
|
||||
Vector.1st = Vector.at 0
|
||||
|
||||
Vector.drop-right : ∀ a . Number -> Vector a -> Vector a
|
||||
Vector.drop-right n v = Vector.take (Vector.size v - n) v
|
||||
|
||||
Vector.take-right : ∀ a . Number -> Vector a -> Vector a
|
||||
Vector.take-right n v = Vector.drop (Vector.size v - n) v
|
||||
|
||||
Vector.dedup-adjacent : ∀ a . (a -> a -> Boolean) -> Vector a -> Vector a
|
||||
Vector.dedup-adjacent eq v =
|
||||
Vector.fold-balanced
|
||||
(v1 v2 ->
|
||||
if Optional.map2 eq (Vector.last v1) (Vector.1st v2) |> Optional.get-or False
|
||||
then Vector.concatenate v1 (Vector.drop 1 v2)
|
||||
else Vector.concatenate v1 v2)
|
||||
[]
|
||||
(Vector.map Vector.pure v)
|
||||
|
||||
Vector.histogram : ∀ a . Order a -> Vector a -> Vector (a, Number)
|
||||
Vector.histogram o v = let
|
||||
merge-bin b1 b2 = (1st b1, 2nd b1 + 2nd b2)
|
||||
combine bin1 bin2 =
|
||||
Optional.map2 (p1 p2 -> if Order.equal o (1st p1) (1st p2)
|
||||
then [merge-bin p1 p2]
|
||||
else [p1, p2])
|
||||
(Vector.last bin1) (Vector.1st bin2)
|
||||
|> Optional.fold' (u -> Vector.concatenate bin1 bin2)
|
||||
(p -> Vector.join [Vector.drop-right 1 bin1, p, Vector.drop 1 bin2])
|
||||
<| Unit
|
||||
Vector.fold-balanced combine [] (Vector.map (a -> Vector.pure (a, 1)) (Vector.sort o v))
|
||||
|
||||
Vector.ranked-histogram : ∀ a . Order a -> Vector a -> Vector (a, Number)
|
||||
Vector.ranked-histogram o v =
|
||||
Vector.histogram o v |> Vector.sort-by (Order.invert Number.Order) 2nd
|
||||
|
||||
Vector.sum : Vector Number -> Number
|
||||
Vector.sum = Vector.fold-left (+) 0
|
||||
|
||||
Vector.dedup : ∀ a . Order a -> Vector a -> Vector a
|
||||
Vector.dedup o v = Vector.dedup-adjacent (Order.equal o) (Vector.sort o v)
|
||||
|
||||
-- Remote.map : ∀ a b . (a -> b) -> Remote a -> Remote b
|
||||
-- Remote.map f = Remote.bind (f `and-then` Remote.pure)
|
||||
|
||||
Remote.map2 : ∀ a b c . (a -> b -> c) -> Remote a -> Remote b -> Remote c
|
||||
Remote.map2 f a b = do Remote
|
||||
a := a
|
||||
b := b
|
||||
pure (f a b)
|
||||
|
||||
Remote.map2' : ∀ a b c . (a -> b -> Remote c) -> Remote a -> Remote b -> Remote c
|
||||
Remote.map2' f a b = Remote.map2 f a b |> Remote.join
|
||||
|
||||
Remote.join : ∀ a . Remote (Remote a) -> Remote a
|
||||
Remote.join = Remote.bind identity
|
||||
|
||||
Remote.unfold : ∀ s a . s -> (s -> Remote (Optional (a, s))) -> Remote (Vector a)
|
||||
Remote.unfold s f = let rec
|
||||
go s acc = do Remote
|
||||
ht := f s
|
||||
ht |> Optional.fold
|
||||
(pure acc)
|
||||
(ht -> go (2nd ht) (Vector.append (1st ht) acc))
|
||||
go s Vector.empty
|
||||
|
||||
Remote.at' : ∀ a . Node -> Remote a -> Remote a
|
||||
Remote.at' node r = do Remote { Remote.transfer node; r }
|
||||
|
||||
Remote.transfer : Node -> Remote Unit
|
||||
Remote.transfer node = Remote.at node unit
|
||||
|
||||
Remote.replicate : ∀ a . Number -> Remote a -> Remote (Vector a)
|
||||
Remote.replicate n r = Remote.sequence (Vector.replicate n r)
|
||||
|
||||
|
||||
Remote.start : ∀ a . Duration -> Remote a -> Remote (Remote a)
|
||||
Remote.start timeout r = do Remote
|
||||
here := Remote.here
|
||||
c := Remote.channel
|
||||
result := Remote.receive-async c timeout
|
||||
Remote.fork (Remote.at' here (r |> Remote.bind (Remote.send c)))
|
||||
pure result
|
||||
|
||||
Remote.race : ∀ a . Duration -> Vector (Remote a) -> Remote a
|
||||
Remote.race timeout rs = do Remote
|
||||
here := Remote.here
|
||||
c := Remote.channel
|
||||
result := Remote.receive-async c timeout
|
||||
Remote.traverse
|
||||
(r -> Remote.fork <| (do Remote { a := r; Remote.transfer here; Remote.send c a }))
|
||||
rs
|
||||
result
|
||||
|
||||
-- Returns `None` if no response within the provided `timeout`,
|
||||
-- which cannot exceed 500 seconds
|
||||
Remote.timeout : ∀ a . Duration -> Remote a -> Remote (Optional a)
|
||||
Remote.timeout timeout r =
|
||||
Remote.race (Duration.seconds 501) [
|
||||
Remote.map Some r,
|
||||
do Remote { Remote.sleep timeout; pure None }
|
||||
]
|
||||
|
||||
Remote.replicate! : ∀ a . Number -> Remote a -> Remote Unit
|
||||
Remote.replicate! n a = let rec
|
||||
go n =
|
||||
if n <=_Number 0 then Remote.pure Unit
|
||||
else Remote.bind (a -> go (n - 1)) a
|
||||
go n
|
||||
|
||||
Remote.traverse : ∀ a b . (a -> Remote b) -> Vector a -> Remote (Vector b)
|
||||
Remote.traverse f vs =
|
||||
Vector.fold-balanced (Remote.map2 Vector.concatenate)
|
||||
(Remote.pure Vector.empty)
|
||||
(Vector.map (f `and-then` Remote.map Vector.single) vs)
|
||||
|
||||
Remote.sequence : ∀ a . Vector (Remote a) -> Remote (Vector a)
|
||||
Remote.sequence vs =
|
||||
Vector.fold-balanced (Remote.map2 Vector.concatenate)
|
||||
(Remote.pure Vector.empty)
|
||||
(Vector.map (Remote.map Vector.single) vs)
|
||||
|
||||
Remote.parallel-traverse : ∀ a b . Duration -> (a -> Remote b) -> Vector a -> Remote (Vector b)
|
||||
Remote.parallel-traverse timeout f vs = do Remote
|
||||
futures := Remote.traverse (f `and-then` Remote.start timeout) vs
|
||||
Remote.sequence futures
|
||||
|
||||
-- Run several remote computations in parallel, returning once `n` equivalent
|
||||
-- replies come back. Equivalence is based on result of `hash!`.
|
||||
Remote.quorum : ∀ a b . Duration -> Number -> (a -> Remote b) -> Vector a -> Remote b
|
||||
Remote.quorum timeout n = _ -- todo
|
||||
|
||||
Either.map : ∀ a b c . (b -> c) -> Either a b -> Either a c
|
||||
Either.map f = Either.fold Left (f `and-then` Right)
|
||||
|
||||
Either.pure : ∀ a b . b -> Either a b
|
||||
Either.pure = Right
|
||||
|
||||
Either.bind : ∀ a b c . (b -> Either a c) -> Either a b -> Either a c
|
||||
Either.bind = Either.fold Left
|
||||
|
||||
Either.swap : ∀ a b . Either a b -> Either b a
|
||||
Either.swap e = Either.fold Right Left e
|
||||
|
||||
Text.join : Vector Text -> Text
|
||||
Text.join = Vector.fold-balanced Text.concatenate ""
|
||||
|
||||
Text.take-right : Number -> Text -> Text
|
||||
Text.take-right n t = Text.drop (Text.length t - n) t
|
||||
|
||||
Text.ends-with : Text -> Text -> Boolean
|
||||
Text.ends-with suffix overall =
|
||||
Text.take-right (Text.length suffix) overall ==_Text suffix
|
||||
72
unison-src/basics.u
Normal file
72
unison-src/basics.u
Normal file
@ -0,0 +1,72 @@
|
||||
|
||||
-- Unison is a statically typed functional language
|
||||
|
||||
increment : Nat -> Nat -- signature is optional
|
||||
increment n = n + 1
|
||||
|
||||
-- Lines starting with `>` are evaluated and printed on every file save.
|
||||
> increment 99
|
||||
|
||||
replicate : Nat -> a -> [a]
|
||||
replicate n a = to-sequence (take n (constant a))
|
||||
|
||||
-- this is nice for quick testing!
|
||||
|
||||
> replicate 3 "bye"
|
||||
|
||||
-- can ask Unison for the type of any expression just by adding `?` to the end of it
|
||||
|
||||
-- > (replicate 4)?
|
||||
|
||||
-- here's a more interesting example, mergesort -
|
||||
|
||||
-- First we define the merge function, it merges two sorted lists
|
||||
merge : (a -> a -> Boolean) -> [a] -> [a] -> [a]
|
||||
merge lte a b =
|
||||
use Sequence ++
|
||||
use Optional None Some
|
||||
go acc a b = case at 0 a of
|
||||
None -> acc ++ b
|
||||
Some hd1 -> case at 0 b of
|
||||
None -> acc ++ a
|
||||
Some hd2 ->
|
||||
if hd1 `lte` hd2 then go (acc `snoc` hd1) (drop 1 a) b
|
||||
else go (acc `snoc` hd2) a (drop 1 b)
|
||||
go [] a b
|
||||
|
||||
-- let's make sure it works
|
||||
> merge (<) [1,3,4,99,504,799] [0,19,22,23]
|
||||
|
||||
-- looks good, now let's write mergesort
|
||||
|
||||
sort : (a -> a -> Boolean) -> [a] -> [a]
|
||||
sort lte a =
|
||||
if Sequence.size a < 2 then a
|
||||
else
|
||||
l = sort lte (take (size a / 2) a)
|
||||
r = sort lte (drop (size a / 2) a)
|
||||
merge lte l r
|
||||
|
||||
-- let's make sure it works
|
||||
|
||||
> sort (<) [3,2,1,1,2,3,9182,1,2,34,1,80]
|
||||
|
||||
> sort (<) ["Dave", "Carol", "Eve", "Alice", "Bob", "Francis", "Hal", "Illy", "Joanna", "Greg", "Karen"]
|
||||
|
||||
-- SHIP IT!! 🚢
|
||||
|
||||
-- If you make a mistake, we try to have nice friendly error messages, not:
|
||||
-- 🤖 ERROR DETECTED ⚡️ BEEP BOOP ⚡️ PLS RESUBMIT PROGRAM TO MAINFRAME
|
||||
|
||||
-- a few examples of failing programs -
|
||||
|
||||
--err1 =
|
||||
-- a = "3"
|
||||
-- sort (<) [1,2,a]
|
||||
|
||||
-- err1a = sort (<) "not a list"
|
||||
|
||||
--err2 : x -> y -> x
|
||||
--err2 thing1 thing2 =
|
||||
-- if true then thing1
|
||||
-- else thing2
|
||||
@ -1,29 +0,0 @@
|
||||
-- a comment
|
||||
{- {-
|
||||
a multi-line nested comment
|
||||
-} still a comment
|
||||
-}
|
||||
|
||||
type Optional a = None | Some a
|
||||
|
||||
Optional.isEmpty : ∀ a . Optional a -> Boolean
|
||||
Optional.isEmpty o = case o of
|
||||
Optional.None -> true
|
||||
Optional.Some hi@_ -> false
|
||||
|
||||
|
||||
(|>) : forall a b . a -> (a -> b) -> b
|
||||
a |> f = f a
|
||||
|
||||
let
|
||||
foo : Nat -> Nat
|
||||
foo x = case if x >_Nat 1 then x +_Nat 1 else 0
|
||||
x = [1.,2.5]
|
||||
"let case if"
|
||||
|> Text.size
|
||||
|> Stream.from-int
|
||||
|> Stream.take 10
|
||||
|> Stream.fold-left -0 (+_Int)
|
||||
|> Stream.fold-left-0 (+_Int)
|
||||
|> Optional.Some
|
||||
+1.0
|
||||
@ -1,11 +0,0 @@
|
||||
|
||||
do Remote
|
||||
root := Remote.spawn;
|
||||
Remote.transfer root;
|
||||
ind := DIndex.empty;
|
||||
nodes := Remote.replicate 10 Remote.spawn;
|
||||
Remote.traverse (node -> Remote.at' node (DIndex.join ind)) nodes;
|
||||
DIndex.insert "It's..." "ALIIIVE!!!!" ind;
|
||||
-- Remote.parallel-traverse DIndex.Timeout (k -> DIndex.insert k k ind) (Vector.range 0 5);
|
||||
r := DIndex.lookup "It's..." ind;
|
||||
pure (Debug.watch "result" r);;
|
||||
@ -1,88 +0,0 @@
|
||||
-- A distributed index, using Highest Random Weight (HRW) hashing
|
||||
-- to pick which nodes are responsible for which keys. See:
|
||||
-- https://en.wikipedia.org/wiki/Rendezvous_hashing
|
||||
|
||||
DIndex.Replication-Factor = 1
|
||||
DIndex.Timeout = Duration.seconds 10
|
||||
DIndex.Max-Timeout = Duration.seconds 500
|
||||
|
||||
alias DIndex k v = Index Node (Index k v)
|
||||
|
||||
DIndex.empty : ∀ k v . Remote (DIndex k v)
|
||||
DIndex.empty = Index.empty
|
||||
|
||||
-- Pick the nodes responsible for a key, using HRW hashing
|
||||
DIndex.nodesForKey : ∀ k v . k -> DIndex k v -> Remote (Vector Node)
|
||||
DIndex.nodesForKey k ind = do Remote
|
||||
nodes := Index.keys ind
|
||||
hashes := Remote.traverse (node -> hash! (node, k)) nodes
|
||||
(nodes `Vector.zip` hashes)
|
||||
|> Vector.sort-by Hash.Order 2nd
|
||||
|> Vector.take DIndex.Replication-Factor
|
||||
|> Vector.map 1st
|
||||
|> pure
|
||||
|
||||
DIndex.lookup : ∀ k v . k -> DIndex k v -> Remote (Optional v)
|
||||
DIndex.lookup k ind = do Remote
|
||||
nodes := DIndex.nodesForKey k ind
|
||||
localLookup = node -> do Remote
|
||||
nind := Index.lookup node ind
|
||||
-- on slim chance that a Node is removed from the cluster just before
|
||||
-- we do the lookup, it gets treated like a timeout
|
||||
Optional.fold (Remote.map (const None) (Remote.sleep DIndex.Timeout))
|
||||
(Index.lookup k)
|
||||
nind
|
||||
-- todo: use Remote.quorum here
|
||||
Remote.race DIndex.Timeout <| Vector.map localLookup nodes
|
||||
|
||||
DIndex.insert : ∀ k v . k -> v -> DIndex k v -> Remote Unit
|
||||
DIndex.insert k v ind = do Remote
|
||||
nodes := DIndex.nodesForKey k ind
|
||||
localInsert = node -> do Remote
|
||||
nind := Index.lookup node ind
|
||||
Optional.fold (Remote.map (const Unit) (Remote.sleep DIndex.Timeout))
|
||||
(Index.insert k v)
|
||||
nind
|
||||
Remote.race DIndex.Timeout <| Vector.map localInsert nodes
|
||||
|
||||
DIndex.join : ∀ k v . DIndex k v -> Remote Unit
|
||||
DIndex.join ind = do Remote
|
||||
here := Remote.here
|
||||
localInd := Index.empty
|
||||
Index.insert here localInd ind
|
||||
|
||||
DIndex.indicesForKey : ∀ k v . k -> DIndex k v -> Remote (Vector (Index k v))
|
||||
DIndex.indicesForKey k ind = do Remote
|
||||
nodes := DIndex.nodesForKey k ind
|
||||
indices := Remote.traverse (node -> Index.lookup node ind) nodes
|
||||
pure (Optional.somes indices)
|
||||
|
||||
DIndex.rebalance : ∀ k v . k -> DIndex k v -> Remote Unit
|
||||
DIndex.rebalance k ind = do Remote
|
||||
indices := DIndex.indicesForKey k ind
|
||||
t = DIndex.Timeout
|
||||
results := Remote.parallel-traverse DIndex.Max-Timeout (Index.lookup k `and-then` Remote.timeout t) indices
|
||||
resultsHashes := Remote.traverse hash! results
|
||||
uh := hash! None
|
||||
hd = uh `Optional.get-or` Vector.at 0 resultsHashes
|
||||
eq = h1 h2 -> Hash.erase h1 ==_Hash Hash.erase h2
|
||||
if Vector.all? (eq hd) resultsHashes
|
||||
-- all results matched, we're good
|
||||
then pure Unit
|
||||
-- not all results matched, reinsert
|
||||
else do Remote
|
||||
ov := DIndex.lookup k ind
|
||||
Optional.fold (pure Unit)
|
||||
(v -> DIndex.insert k v ind)
|
||||
ov
|
||||
|
||||
DIndex.leave : ∀ k v . Node -> DIndex k v -> Remote Unit
|
||||
DIndex.leave node ind = do Remote
|
||||
local-ind := Index.lookup node ind
|
||||
Index.delete node ind
|
||||
Optional.fold
|
||||
(pure Unit)
|
||||
(local-ind -> do Remote {
|
||||
keys := Index.keys local-ind;
|
||||
Remote.fork <| Remote.traverse (k -> DIndex.rebalance k ind) keys })
|
||||
local-ind
|
||||
@ -1,126 +0,0 @@
|
||||
|
||||
Index.empty : ∀ k v . Remote (Index k v)
|
||||
Index.empty = Remote.map Index.empty# Remote.here
|
||||
|
||||
Index.keys : ∀ k v . Index k v -> Remote (Vector k)
|
||||
Index.keys = Index.from-unsafe Index.keys#
|
||||
|
||||
Index.1st-key : ∀ k v . Index k v -> Remote (Optional k)
|
||||
Index.1st-key = Index.from-unsafe Index.1st-key#
|
||||
|
||||
Index.increment : ∀ k v . k -> Index k v -> Remote (Optional k)
|
||||
Index.increment k = Index.from-unsafe (Index.increment# k)
|
||||
|
||||
Index.lookup : ∀ k v . k -> Index k v -> Remote (Optional v)
|
||||
Index.lookup k = Index.from-unsafe (Index.lookup# k)
|
||||
|
||||
Index.lookup-or : ∀ k v . v -> k -> Index k v -> Remote v
|
||||
Index.lookup-or v k ind =
|
||||
Remote.map (Optional.get-or v) (Index.lookup k ind)
|
||||
|
||||
Index.delete : ∀ k v . k -> Index k v -> Remote Unit
|
||||
Index.delete k = Index.from-unsafe (Index.delete# k)
|
||||
|
||||
Index.insert : ∀ k v . k -> v -> Index k v -> Remote Unit
|
||||
Index.insert k v = Index.from-unsafe (Index.insert# k v)
|
||||
|
||||
Index.inserts : ∀ k v . Vector (k,v) -> Index k v -> Remote Unit
|
||||
Index.inserts vs ind = Remote.map (const Unit) <|
|
||||
Remote.traverse (kv -> Index.insert (1st kv) (2nd kv) ind) vs
|
||||
|
||||
Index.from-unsafe : ∀ k v r . (Text -> r) -> Index k v -> Remote r
|
||||
Index.from-unsafe f ind = let
|
||||
p = Index.representation# ind
|
||||
Remote.map f (Remote.at (1st p) (2nd p))
|
||||
|
||||
|
||||
alias IndexedTraversal k v =
|
||||
( Remote (Optional k) -- first key
|
||||
, k -> Remote (Optional v) -- lookup the value for a key
|
||||
, k -> Remote (Optional k)) -- increment a key
|
||||
|
||||
IndexedTraversal.1st-key : ∀ k v . IndexedTraversal k v -> Remote (Optional k)
|
||||
IndexedTraversal.1st-key t = 1st t
|
||||
|
||||
IndexedTraversal.lookup : ∀ k v . k -> IndexedTraversal k v -> Remote (Optional v)
|
||||
IndexedTraversal.lookup k t = 2nd t k
|
||||
|
||||
-- | Returns the smallest key in the traversal which is > the provided key.
|
||||
IndexedTraversal.increment : ∀ k v . k -> IndexedTraversal k v -> Remote (Optional k)
|
||||
IndexedTraversal.increment k t = 3rd t k
|
||||
|
||||
-- | Returns the smallest key in the traversal which is >= the provided key.
|
||||
IndexedTraversal.ceiling : ∀ k v . k -> IndexedTraversal k v -> Remote (Optional k)
|
||||
IndexedTraversal.ceiling k t =
|
||||
IndexedTraversal.lookup k t |> Remote.bind (
|
||||
Optional.fold (IndexedTraversal.increment k t) (const (pure <| Some k))
|
||||
)
|
||||
|
||||
-- | Returns the smallest key existing in both traversals which is >= the provided key
|
||||
IndexedTraversal.ceiling-both : ∀ k v . k -> IndexedTraversal k v -> IndexedTraversal k v -> Remote (Optional k)
|
||||
IndexedTraversal.ceiling-both k t1 t2 =
|
||||
IndexedTraversal.ceiling k t1 |>
|
||||
Remote.bind (Optional.fold (Remote.pure None) (k -> IndexedTraversal.ceiling k t2))
|
||||
|
||||
Index.traversal : ∀ k v . Index k v -> IndexedTraversal (k, Hash k) v
|
||||
Index.traversal ind = let
|
||||
add-hash = Optional.map (k -> (k, hash# k))
|
||||
( Index.1st-key ind |> Remote.map add-hash
|
||||
, k -> Index.lookup (1st k) ind
|
||||
, k -> Index.increment (1st k) ind |> Remote.map add-hash
|
||||
)
|
||||
|
||||
IndexedTraversal.empty : ∀ k v . IndexedTraversal k v
|
||||
IndexedTraversal.empty =
|
||||
(Remote.pure None, const (Remote.pure None), const (Remote.pure None))
|
||||
|
||||
IndexedTraversal.intersect : ∀ k v . Order k
|
||||
-> IndexedTraversal k v
|
||||
-> IndexedTraversal k v
|
||||
-> IndexedTraversal k v
|
||||
IndexedTraversal.intersect o t1 t2 = let rec
|
||||
align-key k1 k2 = Optional.get-or (Remote.pure None) <| Optional.map2
|
||||
(k1 k2 -> Order.compare o k1 k2 |> Comparison.fold
|
||||
-- k1 < k2
|
||||
(IndexedTraversal.ceiling k2 t1 |> Remote.bind (k1 -> align-key k1 (Some k2)))
|
||||
-- k1 == k2
|
||||
(Remote.pure (Some k1))
|
||||
-- k1 > k2
|
||||
(IndexedTraversal.ceiling k1 t2 |> Remote.bind (k2 -> align-key (Some k1) k2))
|
||||
)
|
||||
k1 k2
|
||||
|
||||
1st-key = Remote.map2' align-key (1st t1) (1st t2)
|
||||
lookup k = 2nd t1 k |> Remote.bind (Optional.fold (Remote.pure None) (a -> 2nd t2 k))
|
||||
increment k = Remote.map2' align-key (3rd t1 k) (3rd t2 k)
|
||||
(1st-key, lookup, increment)
|
||||
|
||||
|
||||
IndexedTraversal.1st-entry : ∀ k v . IndexedTraversal k v -> Remote (Optional (k, v))
|
||||
IndexedTraversal.1st-entry t = IndexedTraversal.entry-at (1st t) t
|
||||
|
||||
IndexedTraversal.entry-at : ∀ k v .
|
||||
Remote (Optional k) -> IndexedTraversal k v -> Remote (Optional (k, v))
|
||||
IndexedTraversal.entry-at k t = do Remote
|
||||
k := k
|
||||
v := Optional.fold (pure None) (2nd t) k
|
||||
pure (Optional.map2 (k v -> (k,v)) k v)
|
||||
|
||||
IndexedTraversal.take : ∀ k v . Number -> IndexedTraversal k v -> Remote (Vector (k,v))
|
||||
IndexedTraversal.take n t =
|
||||
Remote.unfold (t, n) (tn -> let {
|
||||
t = 1st tn;
|
||||
n = 2nd tn;
|
||||
step e = (e, (set-1st (IndexedTraversal.increment (1st e) t) t, n - 1));
|
||||
if n <=_Number 0 then Remote.pure None
|
||||
else IndexedTraversal.1st-entry t |> Remote.map (Optional.map step)
|
||||
})
|
||||
|
||||
IndexedTraversal.take-keys : ∀ k v . Number -> IndexedTraversal k v -> Remote (Vector k)
|
||||
IndexedTraversal.take-keys n t = IndexedTraversal.take n t |> Remote.map (Vector.map 1st)
|
||||
|
||||
Http.get-url : Text -> Remote (Either Text Text)
|
||||
Http.get-url url = Remote.map Http.get-url# (Remote.pure url)
|
||||
|
||||
hash! : ∀ a . a -> Remote (Hash a)
|
||||
hash! a = Remote.map hash# (Remote.pure a)
|
||||
@ -1,5 +0,0 @@
|
||||
do Remote
|
||||
Remote.fork <| Remote.sleep (Duration.seconds 10);
|
||||
Remote.fork <| Remote.sleep (Duration.seconds 10);
|
||||
pure 23;;
|
||||
|
||||
@ -1,4 +0,0 @@
|
||||
-- run from unison root directory
|
||||
-- curl -H "Content-Type: text/plain; charset=UTF-8" --data-binary @node/tests/html.u http://localhost:8081/compute/dummynode909
|
||||
|
||||
Http.get-url "http://unisonweb.org"
|
||||
@ -1,15 +0,0 @@
|
||||
-- run from unison root directory
|
||||
-- curl -H "Content-Type: text/plain; charset=UTF-8" --data-binary @node/tests/index.u http://localhost:8081/compute/dummynode909
|
||||
|
||||
do Remote
|
||||
n1 := Remote.spawn;
|
||||
n2 := Remote.spawn;
|
||||
ind := do Remote
|
||||
Remote.transfer n1;
|
||||
ind := Index.empty;
|
||||
Index.insert "Alice" "Jones" ind;
|
||||
Index.insert "Bob" "Smith" ind;
|
||||
pure ind;;
|
||||
;
|
||||
Remote.transfer n2;
|
||||
Index.lookup "Alice" ind;;
|
||||
@ -1,13 +0,0 @@
|
||||
|
||||
do Remote
|
||||
n := Remote.spawn;
|
||||
Remote.transfer n;
|
||||
ind1 := Index.empty;
|
||||
ind2 := Index.empty;
|
||||
Index.inserts [(1,"a"), (2,"b"), (3,"b"), (9,"c"), (11,"f")] ind1;
|
||||
t1 = Index.traversal ind1;
|
||||
Index.inserts [(9,"c"), (2,"b"), (3,"b"), (7,"d")] ind2;
|
||||
t2 = Index.traversal ind2;
|
||||
t3 = IndexedTraversal.intersect (Order.by-2nd Hash.Order) t1 t2;
|
||||
vs := IndexedTraversal.take 10 t3;
|
||||
pure (Debug.watch "result" vs);;
|
||||
@ -1,17 +0,0 @@
|
||||
-- run from unison root directory
|
||||
-- curl -H "Content-Type: text/plain; charset=UTF-8" --data-binary @unison-src/pingpong.u http://localhost:8081/compute/root
|
||||
|
||||
do Remote
|
||||
n1 := Remote.spawn;
|
||||
n2 := Remote.spawn;
|
||||
let rec
|
||||
ping i = do Remote
|
||||
i := Remote.at n2 (i + 1);
|
||||
if (i >=_Number 5) (pure i) (pong i);;
|
||||
;
|
||||
pong i = do Remote
|
||||
i := Remote.at n1 (i + 1);
|
||||
ping i;;
|
||||
;
|
||||
ping 0;;
|
||||
;;
|
||||
@ -1,6 +0,0 @@
|
||||
do Remote
|
||||
r := Remote.race (Duration.seconds 15) [
|
||||
do Remote pure (Debug.watch "race.winner1" 1),
|
||||
do Remote Remote.sleep (Duration.seconds 10); pure (Debug.watch "race.winner2" 2)
|
||||
]
|
||||
pure <| Debug.watch "result" r
|
||||
@ -1,8 +0,0 @@
|
||||
|
||||
do Remote
|
||||
c := Remote.channel;
|
||||
r := Remote.receive-async c (Duration.seconds 5);
|
||||
Remote.fork (Remote.send c (Debug.watch "sent" 42));
|
||||
-- Remote.send c 42; -- (Debug.watch "sent" 42);
|
||||
r;;
|
||||
|
||||
@ -1,121 +0,0 @@
|
||||
let
|
||||
alias DIndex k v = Index Node (Index k v)
|
||||
alias Set v = Index v Unit
|
||||
|
||||
-- Maps keywords to set of page content hashes with that keyword
|
||||
alias SearchIndex = DIndex Text (Set (Hash Text))
|
||||
|
||||
-- Maps page hash to canonical Url for that hash
|
||||
alias CanonicalUrls = DIndex (Hash Text) Text
|
||||
|
||||
-- Maps page hash to a short, plain text exerpt from that page
|
||||
alias Excerpts = DIndex (Hash Text) Text
|
||||
|
||||
-- Using the search index, returns the list of page hashes (up to limit)
|
||||
-- whose content contains all the keywords of the query
|
||||
search : Number -> Vector Text -> SearchIndex
|
||||
-> Remote (Vector (Hash Text))
|
||||
search limit query ind = do Remote
|
||||
url-sets := Remote.traverse (k -> DIndex.lookup k ind) query
|
||||
url-sets = Vector.map Index.traversal (Optional.somes url-sets)
|
||||
merge = IndexedTraversal.intersect (Order.by-2nd Hash.Order)
|
||||
urls = Optional.get-or IndexedTraversal.empty <| Vector.fold-balanced1 merge url-sets
|
||||
urls := IndexedTraversal.take-keys limit urls
|
||||
pure (Vector.map 1st urls)
|
||||
|
||||
-- Plain-text formating of a set of results
|
||||
format-results : Vector (Hash Text) -> CanonicalUrls -> Excerpts -> Remote Text
|
||||
format-results hs urls excerpts = do Remote
|
||||
urls := Remote.map Optional.somes <| Remote.traverse (h -> DIndex.lookup h urls) hs
|
||||
excerpts := Remote.map Optional.somes <| Remote.traverse (h -> DIndex.lookup h excerpts) hs
|
||||
fmt = p -> Text.join [1st p, Text.newline, 2nd p, Text.newline, "***", Text.newline]
|
||||
pure <| Text.join (Vector.map fmt (urls `Vector.zip` excerpts))
|
||||
|
||||
trim-to-host : Text -> Text
|
||||
trim-to-host url = Optional.get-or url <| do Optional
|
||||
host := Uri.parse-authority url
|
||||
scheme := Uri.parse-scheme url
|
||||
pure (Text.concatenate scheme ("//" `Text.concatenate` host))
|
||||
|
||||
-- | Convert url (possibly relative to parent) to an absolute url
|
||||
resolve-url : Text -> Text -> Text
|
||||
resolve-url parent child =
|
||||
if Text.take 1 child ==_Text "/" then
|
||||
Text.concatenate (trim-to-host parent) child
|
||||
else if (Text.take 5 child ==_Text "http:") `or` (Text.take 6 child ==_Text "https:") then
|
||||
child
|
||||
else Text.join [parent, if Text.ends-with "/" parent then "" else "/", child]
|
||||
|
||||
crawl : Number -> SearchIndex -> CanonicalUrls -> Excerpts -> Text -> Remote Unit
|
||||
crawl depth ind visited excerpts url = let rec
|
||||
insert url keyword = do Remote
|
||||
url-set := DIndex.lookup keyword ind
|
||||
Optional.fold
|
||||
(do Remote {
|
||||
url-set := Index.empty;
|
||||
DIndex.insert keyword url-set ind;
|
||||
insert url keyword
|
||||
})
|
||||
(Index.insert url Unit)
|
||||
url-set
|
||||
|
||||
go depth url =
|
||||
if depth <=_Number 0 then Remote.pure Unit
|
||||
else do Remote
|
||||
page := Remote.map (Debug.log "indexing url" url) (Http.get-url url)
|
||||
page = Either.fold (err -> Debug.log "error fetching" (url, err) "") identity page
|
||||
page-hash := hash! page
|
||||
h := DIndex.lookup page-hash visited
|
||||
Optional.fold
|
||||
(do Remote {
|
||||
page-text = Html.plain-text page;
|
||||
keywords = Text.words page-text
|
||||
|> Vector.map Text.lowercase
|
||||
|> Vector.ranked-histogram Text.Order;
|
||||
summary = Vector.take 100 keywords; -- hacky filter
|
||||
keywords = summary;
|
||||
keywords = Vector.map 1st keywords;
|
||||
links = Html.get-links page;
|
||||
links = Vector.map (Html.get-href `and-then` resolve-url url) links;
|
||||
-- insert all keywords for the page into the map
|
||||
Remote.traverse (insert page-hash) keywords;
|
||||
-- mark page as visited
|
||||
excerpt = Text.take 400 page-text `Text.concatenate` "...";
|
||||
DIndex.insert page-hash excerpt excerpts;
|
||||
Debug.log "finished indexing" url <| DIndex.insert page-hash url visited;
|
||||
-- recurse
|
||||
Remote.traverse (go (depth - 1)) links;
|
||||
pure Unit
|
||||
})
|
||||
(x -> Remote.pure (Debug.log "already visited" url Unit))
|
||||
h
|
||||
go depth url
|
||||
|
||||
do Remote
|
||||
n := Remote.spawn
|
||||
Remote.transfer n
|
||||
|
||||
-- Build DIndex for index state and for crawler state
|
||||
ind := DIndex.empty
|
||||
visited := DIndex.empty
|
||||
excerpts := DIndex.empty
|
||||
ind-nodes := Remote.replicate 3 Remote.spawn
|
||||
visited-nodes := Remote.replicate 3 Remote.spawn
|
||||
excerpts-nodes := Remote.replicate 3 Remote.spawn
|
||||
Remote.traverse (n -> Remote.at' n (DIndex.join ind)) ind-nodes
|
||||
Remote.traverse (n -> Remote.at' n (DIndex.join visited)) visited-nodes
|
||||
Remote.traverse (n -> Remote.at' n (DIndex.join excerpts)) excerpts-nodes
|
||||
|
||||
-- Kick off multiple crawlers
|
||||
Remote.fork <| crawl 5 ind visited excerpts "http://unisonweb.org/design"
|
||||
Remote.fork <| crawl 5 ind visited excerpts "http://www.cnn.com"
|
||||
Remote.fork <| crawl 5 ind visited excerpts "http://lambda-the-ultimate.org/"
|
||||
|
||||
-- Wait a while for crawlers to index a bunch of pages, then do query
|
||||
u = Debug.watch "waiting 2 minutes for indexing before issuing queries..." Unit
|
||||
Remote.sleep (Duration.seconds 120)
|
||||
u = Debug.watch "done waiting for indexing, getting results" Unit
|
||||
results := search 10 ["design", "unison", "programming"] ind
|
||||
results := format-results results visited excerpts
|
||||
pure <| Debug.log results Unit results
|
||||
-- pure <| Debug.watch "results" results
|
||||
Loading…
Reference in New Issue
Block a user