Useful but limited polymorphism
This commit is contained in:
178
lib/base.tri
178
lib/base.tri
@@ -1,8 +1,8 @@
|
||||
false = t
|
||||
_ = t
|
||||
true = t t
|
||||
id a = a
|
||||
const a b = a
|
||||
id a@_a =@_a a
|
||||
const a@_a b@_b =@_a a
|
||||
pair = t
|
||||
if cond then else = t (t else (t t then)) t cond
|
||||
|
||||
@@ -10,7 +10,7 @@ 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)
|
||||
compose f@(Fn [_b] _c) g@(Fn [_a] _b) x@_a =@_c f (g x)
|
||||
|
||||
triage leaf stem fork = t (t leaf stem) fork
|
||||
test = triage "Leaf" (_ : "Stem") (_ _ : "Fork")
|
||||
@@ -114,9 +114,9 @@ matchMaybe nothingCase justCase maybe =
|
||||
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
|
||||
maybeMap f@(Fn [_a] _b) m@(Maybe _a) =@(Maybe _b) matchMaybe nothing (compose just f) m
|
||||
maybeBind m@(Maybe _a) f@(Fn [_a] (Maybe _b)) =@(Maybe _b) matchMaybe nothing f m
|
||||
maybeOr default@_a m@(Maybe _a) =@_a matchMaybe default id m
|
||||
maybe? = matchMaybe false (_ : true)
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
@@ -217,3 +217,169 @@ resultMapErr = (f result :
|
||||
(code rest : err (f code) rest)
|
||||
(value rest : ok value rest)
|
||||
result)
|
||||
|
||||
-- ---------------------------------------------------------------------------
|
||||
-- View facts
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
factsFact name provenance view = pair name (pair provenance view)
|
||||
factsChecked = 0
|
||||
factsTrusted = 1
|
||||
factsUnchecked = 2
|
||||
factsField tag value = pair tag value
|
||||
factsRecord tag fields = pair tag fields
|
||||
factsVar id = factsRecord 8 [(factsField 10 id)]
|
||||
factsForall binders body =
|
||||
factsRecord 9 [(factsField 11 binders) (factsField 12 body)]
|
||||
factsFn args result =
|
||||
factsRecord 1 [(factsField 0 args) (factsField 1 result)]
|
||||
factsAny = factsRecord 0 []
|
||||
factsRef symbol = factsRecord 2 [(factsField 2 symbol)]
|
||||
factsBool = factsRef 0
|
||||
factsString = factsRef 1
|
||||
factsByte = factsRef 2
|
||||
factsUnit = factsRef 3
|
||||
factsMaybe elem = factsRecord 4 [(factsField 3 elem)]
|
||||
factsList elem = factsRecord 3 [(factsField 3 elem)]
|
||||
factsPair left right = factsRecord 5 [(factsField 4 left) (factsField 5 right)]
|
||||
factsResult err ok = factsRecord 6 [(factsField 6 err) (factsField 7 ok)]
|
||||
|
||||
viewFacts =
|
||||
[ (factsFact "pair" factsTrusted
|
||||
(factsForall [0]
|
||||
(factsFn
|
||||
[(factsVar 0) (factsList (factsVar 0))]
|
||||
(factsList (factsVar 0)))))
|
||||
(factsFact "nothing" factsTrusted
|
||||
(factsForall [0]
|
||||
(factsMaybe (factsVar 0))))
|
||||
(factsFact "just" factsTrusted
|
||||
(factsForall [0]
|
||||
(factsFn [(factsVar 0)] (factsMaybe (factsVar 0)))))
|
||||
(factsFact "false" factsTrusted factsBool)
|
||||
(factsFact "true" factsTrusted factsBool)
|
||||
(factsFact "if" factsTrusted
|
||||
(factsForall [0]
|
||||
(factsFn [factsBool (factsVar 0) (factsVar 0)] (factsVar 0))))
|
||||
(factsFact "triage" factsTrusted
|
||||
(factsForall [0]
|
||||
(factsFn [factsAny factsAny factsAny factsAny] (factsVar 0))))
|
||||
(factsFact "test" factsTrusted factsString)
|
||||
(factsFact "matchBool" factsTrusted
|
||||
(factsForall [0]
|
||||
(factsFn
|
||||
[(factsVar 0) (factsVar 0) factsBool]
|
||||
(factsVar 0))))
|
||||
(factsFact "lAnd" factsTrusted
|
||||
(factsFn [factsBool factsBool] factsBool))
|
||||
(factsFact "lOr" factsTrusted
|
||||
(factsFn [factsBool factsBool] factsBool))
|
||||
(factsFact "matchPair" factsTrusted
|
||||
(factsForall [0 1 2]
|
||||
(factsFn
|
||||
[(factsFn [(factsVar 0) (factsVar 1)] (factsVar 2))
|
||||
(factsPair (factsVar 0) (factsVar 1))]
|
||||
(factsVar 2))))
|
||||
(factsFact "fst" factsTrusted
|
||||
(factsForall [0 1]
|
||||
(factsFn [(factsPair (factsVar 0) (factsVar 1))] (factsVar 0))))
|
||||
(factsFact "snd" factsTrusted
|
||||
(factsForall [0 1]
|
||||
(factsFn [(factsPair (factsVar 0) (factsVar 1))] (factsVar 1))))
|
||||
(factsFact "not?" factsTrusted
|
||||
(factsFn [factsBool] factsBool))
|
||||
(factsFact "and?" factsTrusted
|
||||
(factsFn [factsBool factsBool] factsBool))
|
||||
(factsFact "or?" factsTrusted
|
||||
(factsFn [factsBool factsBool] factsBool))
|
||||
(factsFact "xor?" factsTrusted
|
||||
(factsFn [factsBool factsBool] factsBool))
|
||||
(factsFact "equal?" factsTrusted
|
||||
(factsForall [0]
|
||||
(factsFn [(factsVar 0) (factsVar 0)] factsBool)))
|
||||
(factsFact "succ" factsTrusted
|
||||
(factsFn [factsByte] factsByte))
|
||||
(factsFact "pred" factsTrusted
|
||||
(factsFn [factsByte] factsByte))
|
||||
(factsFact "isZero?" factsTrusted
|
||||
(factsFn [factsByte] factsBool))
|
||||
(factsFact "add" factsTrusted
|
||||
(factsFn [factsByte factsByte] factsByte))
|
||||
(factsFact "sub" factsTrusted
|
||||
(factsFn [factsByte factsByte] factsByte))
|
||||
(factsFact "lte?" factsTrusted
|
||||
(factsFn [factsByte factsByte] factsBool))
|
||||
(factsFact "gte?" factsTrusted
|
||||
(factsFn [factsByte factsByte] factsBool))
|
||||
(factsFact "lt?" factsTrusted
|
||||
(factsFn [factsByte factsByte] factsBool))
|
||||
(factsFact "gt?" factsTrusted
|
||||
(factsFn [factsByte factsByte] factsBool))
|
||||
(factsFact "mul" factsTrusted
|
||||
(factsFn [factsByte factsByte] factsByte))
|
||||
(factsFact "matchMaybe" factsTrusted
|
||||
(factsForall [0 1]
|
||||
(factsFn
|
||||
[(factsVar 1)
|
||||
(factsFn [(factsVar 0)] (factsVar 1))
|
||||
(factsMaybe (factsVar 0))]
|
||||
(factsVar 1))))
|
||||
(factsFact "maybe" factsTrusted
|
||||
(factsForall [0 1]
|
||||
(factsFn
|
||||
[(factsVar 1)
|
||||
(factsFn [(factsVar 0)] (factsVar 1))
|
||||
(factsMaybe (factsVar 0))]
|
||||
(factsVar 1))))
|
||||
(factsFact "maybe?" factsTrusted
|
||||
(factsForall [0]
|
||||
(factsFn [(factsMaybe (factsVar 0))] factsBool)))
|
||||
(factsFact "ifLazy" factsTrusted
|
||||
(factsForall [0]
|
||||
(factsFn
|
||||
[factsBool
|
||||
(factsFn [factsUnit] (factsVar 0))
|
||||
(factsFn [factsUnit] (factsVar 0))]
|
||||
(factsVar 0))))
|
||||
(factsFact "andLazy?" factsTrusted
|
||||
(factsFn [factsBool (factsFn [factsUnit] factsBool)] factsBool))
|
||||
(factsFact "ok" factsTrusted
|
||||
(factsForall [0 1]
|
||||
(factsFn [(factsVar 1) factsAny] (factsResult (factsVar 0) (factsVar 1)))))
|
||||
(factsFact "err" factsTrusted
|
||||
(factsForall [0 1]
|
||||
(factsFn [(factsVar 0) factsAny] (factsResult (factsVar 0) (factsVar 1)))))
|
||||
(factsFact "matchResult" factsTrusted
|
||||
(factsForall [0 1 2]
|
||||
(factsFn
|
||||
[(factsFn [(factsVar 0) factsAny] (factsVar 2))
|
||||
(factsFn [(factsVar 1) factsAny] (factsVar 2))
|
||||
(factsResult (factsVar 0) (factsVar 1))]
|
||||
(factsVar 2))))
|
||||
(factsFact "resultIsOk" factsTrusted
|
||||
(factsForall [0 1]
|
||||
(factsFn [(factsResult (factsVar 0) (factsVar 1))] factsBool)))
|
||||
(factsFact "resultIsErr" factsTrusted
|
||||
(factsForall [0 1]
|
||||
(factsFn [(factsResult (factsVar 0) (factsVar 1))] factsBool)))
|
||||
(factsFact "mapResult" factsTrusted
|
||||
(factsForall [0 1 2]
|
||||
(factsFn
|
||||
[(factsFn [(factsVar 1)] (factsVar 2))
|
||||
(factsResult (factsVar 0) (factsVar 1))]
|
||||
(factsResult (factsVar 0) (factsVar 2)))))
|
||||
(factsFact "bindResult" factsTrusted
|
||||
(factsForall [0 1 2]
|
||||
(factsFn
|
||||
[(factsResult (factsVar 0) (factsVar 1))
|
||||
(factsFn [(factsVar 1)] (factsResult (factsVar 0) (factsVar 2)))]
|
||||
(factsResult (factsVar 0) (factsVar 2)))))
|
||||
(factsFact "resultOr" factsTrusted
|
||||
(factsForall [0 1]
|
||||
(factsFn [(factsVar 1) (factsResult (factsVar 0) (factsVar 1))] (factsVar 1))))
|
||||
(factsFact "resultMapErr" factsTrusted
|
||||
(factsForall [0 1 2]
|
||||
(factsFn
|
||||
[(factsFn [(factsVar 0)] (factsVar 2))
|
||||
(factsResult (factsVar 0) (factsVar 1))]
|
||||
(factsResult (factsVar 2) (factsVar 1)))))]
|
||||
|
||||
Reference in New Issue
Block a user