James Eversole
bf30d5945e
Perhaps the first webserver in Tree Calculus? Sure, it's married to a Haskell IO runtime... but we're managing all of the actual webserver semantics in tricu! This includes a demo Arboricx application server that is capable of storing and serving bundles.
218 lines
4.0 KiB
Plaintext
218 lines
4.0 KiB
Plaintext
false = t
|
|
_ = t
|
|
true = t t
|
|
id = a : a
|
|
const = a b : a
|
|
pair = t
|
|
if = cond then else : t (t else (t t then)) t cond
|
|
|
|
y = ((mut wait fun : wait mut (x : fun (wait mut x)))
|
|
(x : x x)
|
|
(a0 a1 a2 : t (t a0) (t t a2) a1))
|
|
|
|
compose = f g x : f (g x)
|
|
|
|
triage = leaf stem fork : t (t leaf stem) fork
|
|
test = triage "Leaf" (_ : "Stem") (_ _ : "Fork")
|
|
|
|
matchBool = (ot of : triage
|
|
of
|
|
(_ : ot)
|
|
(_ _ : ot)
|
|
)
|
|
|
|
lAnd = (triage
|
|
(_ : false)
|
|
(_ x : x)
|
|
(_ _ x : x))
|
|
|
|
lOr = (triage
|
|
(x : x)
|
|
(_ _ : true)
|
|
(_ _ _ : true))
|
|
|
|
matchPair = a : triage _ _ a
|
|
|
|
fst = p : matchPair (a b : a) p
|
|
snd = p : matchPair (a b : b) p
|
|
|
|
resultIsOk = result :
|
|
matchResult (err rest : false) (val rest : true) result
|
|
|
|
resultIsErr = result :
|
|
matchResult (err rest : true) (val rest : false) result
|
|
|
|
not? = matchBool false true
|
|
and? = matchBool id (_ : false)
|
|
|
|
or? = (x z :
|
|
matchBool
|
|
(matchBool true true z)
|
|
(matchBool true false z)
|
|
x)
|
|
|
|
xor? = (x z :
|
|
matchBool
|
|
(matchBool false true z)
|
|
(matchBool true false z)
|
|
x)
|
|
|
|
equal? = y (self : triage
|
|
(triage
|
|
true
|
|
(_ : false)
|
|
(_ _ : false))
|
|
(ax :
|
|
triage
|
|
false
|
|
(self ax)
|
|
(_ _ : false))
|
|
(ax ay :
|
|
triage
|
|
false
|
|
(_ : false)
|
|
(bx by : lAnd (self ax bx) (self ay by))))
|
|
|
|
succ = y (self :
|
|
triage
|
|
1
|
|
t
|
|
(triage
|
|
(t (t t))
|
|
(_ tail : t t (self tail))
|
|
t))
|
|
|
|
ok = value rest : pair true (pair value rest)
|
|
err = msg rest : pair false (pair msg rest)
|
|
|
|
matchResult = (errCase okCase result :
|
|
matchPair
|
|
(tag payload :
|
|
matchPair
|
|
(value rest :
|
|
matchBool
|
|
(okCase value rest)
|
|
(errCase value rest)
|
|
tag)
|
|
payload)
|
|
result)
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Maybe / Option type
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
nothing = t
|
|
just = x : t x
|
|
|
|
matchMaybe = (nothingCase justCase maybe :
|
|
triage
|
|
nothingCase
|
|
justCase
|
|
(_ _ : nothingCase)
|
|
maybe)
|
|
|
|
maybe = default f m : matchMaybe default f m
|
|
maybeMap = f m : matchMaybe nothing (x : just (f x)) m
|
|
maybeBind = m f : matchMaybe nothing f m
|
|
maybeOr = default m : matchMaybe default id m
|
|
maybe? = matchMaybe false (_ : true)
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Basic arithmetic
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
ifLazy = (cond thenK elseK :
|
|
matchBool
|
|
(thenK t)
|
|
(elseK t)
|
|
cond)
|
|
|
|
andLazy? = (a bK :
|
|
ifLazy
|
|
a
|
|
bK
|
|
(_ : false))
|
|
|
|
pred = y (self : triage
|
|
0
|
|
(_ : 0)
|
|
(bit rest :
|
|
matchBool
|
|
(matchBool
|
|
0
|
|
(pair 0 rest)
|
|
(equal? rest 0))
|
|
(matchBool
|
|
0
|
|
(pair 1 (self rest))
|
|
(equal? rest 0))
|
|
bit))
|
|
|
|
isZero? = triage true (_ : false) (_ _ : false)
|
|
|
|
add = y (self x y :
|
|
triage
|
|
y
|
|
(_ : succ y)
|
|
(_ _ : succ (self (pred x) y))
|
|
x)
|
|
|
|
sub = y (self a b :
|
|
ifLazy
|
|
(isZero? b)
|
|
(_ : a)
|
|
(_ : self (pred a) (pred b)))
|
|
|
|
lte? = y (self a b :
|
|
ifLazy
|
|
(isZero? a)
|
|
(_ : true)
|
|
(_ :
|
|
ifLazy
|
|
(isZero? b)
|
|
(_ : false)
|
|
(_ : self (pred a) (pred b))))
|
|
|
|
gte? = a b :
|
|
lte? b a
|
|
|
|
lt? = a b :
|
|
and? (lte? a b) (not? (equal? a b))
|
|
|
|
gt? = a b :
|
|
lt? b a
|
|
|
|
mul = y (self a b :
|
|
ifLazy
|
|
(isZero? b)
|
|
(_ : 0)
|
|
(_ : add a (self a (pred b))))
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Result combinators
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
mapResult = (f result :
|
|
matchResult
|
|
(code rest : err code rest)
|
|
(value rest : ok (f value) rest)
|
|
result)
|
|
|
|
bindResult = (result f :
|
|
matchResult
|
|
(code rest : err code rest)
|
|
(value rest : f value rest)
|
|
result)
|
|
|
|
resultOr = (default result :
|
|
matchResult
|
|
(_ _ : default)
|
|
(value _ : value)
|
|
result)
|
|
|
|
resultMapErr = (f result :
|
|
matchResult
|
|
(code rest : err (f code) rest)
|
|
(value rest : ok value rest)
|
|
result)
|