vagston’s blog

Tiny proof assistant in Clean without Curry-Howard Isomorphism

nobody@vox.com(vagston) — Thu, 09 Jul 2009 01:55:39 -0700


module tst

import StdGeneric, GenEq, StdMisc
from StdEnv import
 instance == {#Char}, instance == Int, instance == Real,
 &&, class == (..), instance == [a] | == a

Start = let p = pvar "P" in [notI2 p,notE2_nc p,notE3 p,notE3_nc p,errNotE2 p]
where
 impOpen r p = impE r (assum p)
 mix a b
  # r = andI a b
  # r = andE r
  = r
 mix` a b
  # r = andI a b
  # r = andE` r
  = r
 /*
        p, p -> _|_ |- _|_
  -----------------------------
   p |- (p -> _|_) -> _|_
 */
 notI2 p
  # a = assum p
  # b = assum (p --> B)
  # r = mix` a b
  # r = impOpen r p
  # r = impI r (p --> B)
  = r

 /*
  ~p,~~p |- ~p /\ ~~p
  --------------- assum(~p),assum(~~p),andI,contra,absurd(p)
   ~p
 */
 notE2_nc p // !!!!!! [!] !!!!!!!
  # np = ~ p
  # nnp = ~ np
  # a = assum np
  # b = assum nnp
  # r = contra a b
  # r = absurd r p
  = r

 /*
   P |- (P --> _|_) --> _|_
   ((P --> _|_) --> _|_) --> _|_ |- ((P --> _|_) --> _|_) --> _|_
   ((P --> _|_) --> _|_) --> _|_, P |- _|_
  -------------------------------------------------
   ((P --> _|_) --> _|_) --> _|_ |- P --> _|_
 */
 notE3 p
  # n3 = ((p --> B) --> B) --> B
  # a = notI2 p
  # b = assum n3
  # r = contra a b
  # r = impI r p
  = r

 notE3_nc p
  # np = ~ p
  # nnp = ~ np
  # nnnp = ~ nnp
  # a = assum nnp
  # b = assum nnnp
  # r = contra a b
  # r = absurd r np
  = r

 /* doubleNot:
  ~~~p,p,... |- q /\ ~q
  ------------- weak(p),contra,notI3,absurd
   p |- ~~p
 */
 errNotE2 p
  # np = ~ p
  # nnp = ~ np
  # nnnp = ~ nnp
  # r = assum (nnp /\ nnnp)
  # a = andE r
  # b = andE` r
  # r = contra a b
  // r = absurd r nnp
  = r

pvar a = PV a
tvar a = TV a

/* ----------------- TCB (so must be in separate module with ::Deduced as abstract type ----------------------- */

start => EMPTY |- T
assum p => p$ EMPTY WITH p |- p
weak (v |- p) q => q$ v WITH q |- p
impI (v |- p) q | q IN v => q$ v WITHOUT q |- q --> p
impE (v |- p --> q) (w |- p`) | p == p` => v AND w |- q
andI (v |- p) (w |- q) => v AND w |- p /\ q
andE (v |- p /\ q) => v |- p
andE` (v |- p /\ q) => v |- q
orI (v |- p) q => p$ v |- p \/ q
orI` (v |- p) q => q$ v |- q \/ p
orE (v |- r) (w |- r`) (y |- p /\ q) | r == r` && p IN v && q IN w => (v WITHOUT p) AND (w WITHOUT q) AND y |- r
//notI (v |- p) => v |- ~ (~ p)
contra (v |- p) (w |- ~p`) | p == p` => v AND w |- B
contra (v |- p) (w |- p` --> B) | p == p` => v AND w |- B
/* --------- NONCONSTRUCTIVE PART --------------- */
absurd (v |- B) p | ~p IN v => p$ v WITHOUT ~p |- p
botE (v |- B) p => p$ v |- p
midE p => p$ EMPTY |- p \/ ~p

:: Deduced
 = (|-) infix 1 (Set Prop) Prop

/* -------------------------------------------- END OF TCB ------------------------------------- */

:: Prop
 = (====) infix 4 Term Term | (<) infix 4 Term Term | (>) infix 4 Term Term
 | (=<) infix 4 Term Term | (>=) infix 4 Term Term | (-->) infix 5 Prop Prop
    | (<--) infix 5 Prop Prop | (<->) infix 5 Prop Prop | (\/) infixr 6 Prop Prop
    | (/\) infixr 6 Prop Prop | ~ Prop | A [String] Prop | E [String] Prop
    | B /* bottom */ | T /* truth */ | PV String

derive gEq Prop ; instance == Prop where (==) a b = gEq{|*|} a b

:: Term
 = I Int | F Real | S String | C String | TV String | (+) infixl 6 Term Term
 | (-) infixl 6 Term Term | (*) infixl 7 Term Term | (/) infixl 7 Term Term
 | (%) infixl 9 Term Term | (++) infixr 5 Term Term | (^) infixr 8 Term Term

derive gEq Term ; instance == Term where (==) a b = gEq{|*|} a b

:: Set a :== [a]

EMPTY = []
(WITH) infixl 3 :: [Prop] Prop -> [Prop]
(WITH) w p = [p:w WITHOUT p]
(WITHOUT) infixl 3 :: [Prop] Prop -> [Prop]
(WITHOUT) [w:ws] p | w == p = ws ; = [w:ws WITHOUT p]
(WITHOUT) [] _ = []
(AND) infixl 2 :: [Prop] [Prop] -> [Prop]
(AND) w [v:vs] = (w WITH v) AND vs // remove pars?
(AND) w [] = w
(IN) infix 9 :: Prop [Prop] -> Bool
(IN) p [w:ws] | w == p = True ; = p IN ws
(IN) _ [] = False

($) infixr 0 :: Prop a -> a
($) p r | valid p = r ; = abort "SYNTAX"
valid a = True

Read and post comments | Send to a friend

Tiny proof assistant in Clean using Curry-Howard Isomorphism

nobody@vox.com(vagston) — Thu, 09 Jul 2009 01:51:15 -0700


module CHI

Start = notE3 (|- (((P --> Bot) --> Bot) --> Bot)) (Wff P)  //notI2 (|- P) (Wff P)
where
    notE3 n3 wff_p = impI (hlp1 n3) wff_p
    where
        hlp1 n3 p = nd_contra (notI2 p wff_p) n3

    notI2 p wff_p = impI (hlp p) (nd_not wff_p)
    where
        hlp p pb = impE pb p

    nd_contra p pb = contra p (nd_not_def` pb)
    nd_not wff_p = wff_imp wff_p wff_bot

/* ======================== TCB ========================== */

/* must be hidden in separate module */

/* ------- SYNTAX --------- */

wff_a :: Wff CstA ; wff_a = Wff A ; wff_b :: Wff CstB ; wff_b = Wff B ; wff_p :: Wff CstP ; wff_p = Wff P
wff_c :: Wff CstC ; wff_c = Wff C ; wff_d :: Wff CstD ; wff_d = Wff D ; wff_q :: Wff CstQ ; wff_q = Wff Q

wff_bot :: Wff Bot
wff_bot = Wff Bot

wff_true :: Wff TRUE
wff_true = Wff TRUE

wff_not :: (Wff p) -> Wff (Not p)
wff_not (Wff p) => Wff (~ p)

wff_and :: (Wff p) (Wff q) -> Wff (And p q)
wff_and (Wff p) (Wff q) => Wff (p /\ q)

wff_or :: (Wff p) (Wff q) -> Wff (Or p q)
wff_or (Wff p) (Wff q) => Wff (p \/ q)

wff_imp :: (Wff p) (Wff q) -> Wff (Imp p q)
wff_imp (Wff p) (Wff q) => Wff (p --> q)

/* ----------- CONSTRUCTIVE ---------- */

impI :: ((Deduced p) -> Deduced q) (Wff p) -> Deduced (Imp p q)
impI f (Wff p) => case f (|- p) of |- q -> |- (p --> q)

impE :: (Deduced (Imp p q)) (Deduced p) -> Deduced q
impE (|- (p --> q)) (|- p`) => |- q

andI :: (Deduced p) (Deduced q) -> Deduced (And p q)
andI (|- p) (|- q) => |- (p /\ q)

andE :: (Deduced (And p q)) -> Deduced p
andE (|- (p /\ q)) => |- p

andE` :: (Deduced (And p q)) -> Deduced q
andE` (|- (p /\ q)) => |- q

orI :: (Deduced p) (Wff q) -> Deduced (Or p q)
orI (|- p) (Wff q) => |- (p \/ q)

orI` :: (Deduced p) (Wff q) -> Deduced (Or p q)
orI` (|- p) (Wff q) => |- (p \/ q)

contra :: (Deduced p) (Deduced (Not p)) -> Deduced Bot
contra (|- p) (|- (~ q)) => |- Bot

mp p q = impE p q
nd_not_def (|- (~ p) ) = |- (p --> Bot)
nd_not_def` (|- (p --> Bot)) = |- (~ p)

/* ----------- NONCONSTRUCTIVE (move to separate module) --------- */

absurd :: ((Deduced (Not p)) -> Deduced Bot) (Wff p) -> Deduced p
absurd _ (Wff p) => |- p

bottom_complete :: (Deduced Bot) (Wff p) -> Deduced p
bottom_complete (|- Bot) (Wff p) => |- p

tertium :: (Wff p) -> Deduced (Or p (Not p))
tertium (Wff p) => |- (p \/ ~ p)

:: Deduced p = |- p /* *MUST* be abstract type! */

:: Wff a = Wff a /* *MUST* be abstract type! */

/* ======================== END OF TCB ========================== */

:: CstA = A ; :: CstB = B ; :: CstC = C ; :: CstD = D ; :: CstE = E ; :: CstP = P ; :: CstQ = Q
:: Not a = ~ a
:: Imp a b = (-->) infix 5 a b
:: And a b = (/\) infixr 6 a b
:: Or a b = (\/) infixr 6 a b
:: Bot = Bot
:: TRUE = TRUE

Read and post comments | Send to a friend

Tiny proof assistant in Clean using Curry-Howard Isomorphism

nobody@vox.com(vagston) — Thu, 09 Jul 2009 01:50:48 -0700

<pre>
module CHI

Start = notE3 (|- (((P --> Bot) --> Bot) --> Bot)) (Wff P) //notI2 (|- P) (Wff P)
where
   notE3 n3 wff_p = impI (hlp1 n3) wff_p
   where
       hlp1 n3 p = nd_contra (notI2 p wff_p) n3

   notI2 p wff_p = impI (hlp p) (nd_not wff_p)
   where
       hlp p pb = impE pb p

nd_contra p pb = contra p (nd_not_def` pb)
nd_not wff_p = wff_imp wff_p wff_bot

/* ======================== TCB ========================== */

/* must be hidden in separate module */

/* ------- SYNTAX --------- */

wff_a :: Wff CstA ; wff_a = Wff A ; wff_b :: Wff CstB ; wff_b = Wff B ; wff_p :: Wff CstP ; wff_p = Wff P
wff_c :: Wff CstC ; wff_c = Wff C ; wff_d :: Wff CstD ; wff_d = Wff D ; wff_q :: Wff CstQ ; wff_q = Wff Q

wff_bot :: Wff Bot
wff_bot = Wff Bot

wff_true :: Wff TRUE
wff_true = Wff TRUE

wff_not :: (Wff p) -> Wff (Not p)
wff_not (Wff p) => Wff (~ p)

wff_and :: (Wff p) (Wff q) -> Wff (And p q)
wff_and (Wff p) (Wff q) => Wff (p /\ q)

wff_or :: (Wff p) (Wff q) -> Wff (Or p q)
wff_or (Wff p) (Wff q) => Wff (p \/ q)

wff_imp :: (Wff p) (Wff q) -> Wff (Imp p q)
wff_imp (Wff p) (Wff q) => Wff (p --> q)

/* ----------- CONSTRUCTIVE ---------- */

impI :: ((Deduced p) -> Deduced q) (Wff p) -> Deduced (Imp p q)
impI f (Wff p) => case f (|- p) of |- q -> |- (p --> q)

impE :: (Deduced (Imp p q)) (Deduced p) -> Deduced q
impE (|- (p --> q)) (|- p`) => |- q

andI :: (Deduced p) (Deduced q) -> Deduced (And p q)
andI (|- p) (|- q) => |- (p /\ q)

andE :: (Deduced (And p q)) -> Deduced p
andE (|- (p /\ q)) => |- p

andE` :: (Deduced (And p q)) -> Deduced q
andE` (|- (p /\ q)) => |- q

orI :: (Deduced p) (Wff q) -> Deduced (Or p q)
orI (|- p) (Wff q) => |- (p \/ q)

orI` :: (Deduced p) (Wff q) -> Deduced (Or p q)
orI` (|- p) (Wff q) => |- (p \/ q)

contra :: (Deduced p) (Deduced (Not p)) -> Deduced Bot
contra (|- p) (|- (~ q)) => |- Bot

mp p q = impE p q
nd_not_def (|- (~ p) ) = |- (p --> Bot)
nd_not_def` (|- (p --> Bot)) = |- (~ p)

/* ----------- NONCONSTRUCTIVE (move to separate module) --------- */

absurd :: ((Deduced (Not p)) -> Deduced Bot) (Wff p) -> Deduced p
absurd _ (Wff p) => |- p

bottom_complete :: (Deduced Bot) (Wff p) -> Deduced p
bottom_complete (|- Bot) (Wff p) => |- p

tertium :: (Wff p) -> Deduced (Or p (Not p))
tertium (Wff p) => |- (p \/ ~ p)

:: Deduced p = |- p /* *MUST* be abstract type! */

:: Wff a = Wff a /* *MUST* be abstract type! */

/* ======================== END OF TCB ========================== */

:: CstA = A ; :: CstB = B ; :: CstC = C ; :: CstD = D ; :: CstE = E ; :: CstP = P ; :: CstQ = Q
:: Not a = ~ a
:: Imp a b = (-->) infix 5 a b
:: And a b = (/\) infixr 6 a b
:: Or a b = (\/) infixr 6 a b
:: Bot = Bot
:: TRUE = TRUE

</pre>

Read and post comments | Send to a friend

Read Only Graph Builder In Functional Language

nobody@vox.com(vagston) — Tue, 03 Mar 2009 02:05:10 -0800



:: ROGraph a = ROGraph a [ROGraph a]
:: RODGraph a = RODGraph a [RODGraph a] [RODGraph a]

buildROGraph :: (a b (c,[b])) -> Map b (ROGraph c) | Lookup MapOnList b & UpdateDefault MapOnList b & Pairs a
buildROGraph m = buildGraph m \ id val fws bws = ROGraph val fws
buildRODGraph m = buildGraph m \ id val fws bws = RODGraph val fws bws

buildGraph rawGraph constructor = futureIndex
where
    raw = pairs rawGraph
    forwards = buildFastMap $ flip map raw \ (id,(a,fws)) = (id,fws)
    backwards = buildBackwards forwards
    futureIndex = buildFastMap $ flip map raw \ (id,(a,fws)) = (id,build id a fws)
    fromFuture ids = map (fromJustXXX o lookup futureIndex) ids
    build nodeId contents forwards
        # backwards = case lookup backwards nodeId of Just x -> x ; _ -> []
        = constructor nodeId contents (fromFuture forwards) (fromFuture backwards)

buildBackwards :: (a b [c]) -> a c [b] | Empty (a c [b]) & Pairs a & UpdateDefault a c
buildBackwards graph = seqMap processNode (pairs graph) empty
where
    processNode (id,forwards) = seqMapLFA forwards \ fr m = snd $ updateDefault fr (cons id) [] m

testGraph :: Map Int (Int,[Int])
testGraph = fromPairs [ @1 [2,3,4], @2 [4,1], @3 [1,2], @4 [3,4] ]
where
    @ a b = (a,(a,b))

Start = printRODGraph $ fromJust $ lookup (buildRODGraph testGraph) 1

Read and post comments | Send to a friend

Adding Pluggable Search Strategies to Your Favourite Functional Programming Language

nobody@vox.com(vagston) — Sat, 17 Jan 2009 17:57:55 -0800

<pre> search3 :: !Bool !(u:a -> .(v:([u:a] -> w:[.b]) -> x:[.b])) u:a -> y:[.b], [v <= u,x v <= w,x v <= y] search3 kind explorer root | kind = do_all_depth [root] [] = do_all_breadth [root] [] where do_all_depth [] t = t do_all_depth [v:vs] t = explorer v \ vs` = do_all_depth vs` (do_all_depth vs t) do_all_breadth [] t = t do_all_breadth [v:vs] t = explorer v \ vs` = do_all_breadth vs (do_all_breadth vs` t) </pre>

Read and post comments | Send to a friend

Purely Functional Queue with Constant Operation Times (Credits to Okasaki)

nobody@vox.com(vagston) — Thu, 15 Jan 2009 20:00:47 -0800

<pre> :: Queue a = Queue !Int !.[a] !Int !.[.[a]] /* enqLen enqList deqLen deqList */ adjust :: !u:(Queue .a) -> v:(Queue .a), [u <= v] adjust q=:(Queue enqLen enqList deqLen deqList) | enqLen > 3 && enqLen >= deqLen = Queue 0 [] (enqLen + deqLen) (deqList ++ [reverse enqList]) | otherwise = q enq :: .a !u:(Queue .a) -> v:(Queue .a), [u <= v] enq a (Queue enqLen enqList deqLen deqList) = adjust (Queue (enqLen + 1) [a:enqList] deqLen deqList) deq :: !u:(Queue .a) -> (.a, !v:(Queue .a)), [u <= v] deq (Queue enqLen enqList deqLen [[]:deqList]) = deq (Queue enqLen enqList deqLen deqList) deq (Queue enqLen enqList deqLen [[a:as]:deqList]) = (a, adjust (Queue enqLen enqList (deqLen - 1) [as:deqList])) deq (Queue enqLen enqList 0 deqList) = deq (Queue 0 [] enqLen [reverse enqList]) newq :: .(Queue .a) newq = Queue 0 [] 0 [] emptyq :: !.(Queue .a) -> .Bool emptyq (Queue 0 _ 0 _) = True emptyq _ = False </pre>

Read and post comments | Send to a friend

Introductory Course In Applied Math: No Background Needed

nobody@vox.com(vagston) — Tue, 11 Nov 2008 00:43:17 -0800

1. Notion of representation 2. Notion of encoding 3. Requirements to glyphs: equality, recognisability, one might always realise where one ends and another begins 4. Deductive apparatus, mathematical theories 5. Interpretations of mathematical theories, constants 6. Variables, historic excursion into prop calc, difference between variables and constants; quantors; variable substitution and its pitfalls 7. Soundness, completeness, consistency 8. Proof theory 9. Model theory 10. What is Existence 11. What is Truth 12. Art of proof (12 lessons, first two or three are short and may be conducted together)

Read and post comments | Send to a friend

Monadic Arithmetics

nobody@vox.com(vagston) — Tue, 11 Nov 2008 00:42:31 -0800

/* Stop >>= \a -> >>= \b insane! */

instance + (m a) | + a & Monad m
where
 (+) ma mb = ma >>= \a -> mb >>= \b -> return $! a + b

instance - (m a) | - a & Monad m
where
 (-) ma mb = ma >>= \a -> mb >>= \b -> return $! a - b

instance * (m a) | * a & Monad m
where
 (*) ma mb = ma >>= \a -> mb >>= \b -> return $! a * b

instance / (m a) | / a & Monad m
where
 (/) ma mb = ma >>= \a -> mb >>= \b -> return $! a / b

instance mod (m a) | mod a & Monad m
where
 (mod) ma mb = ma >>= \a -> mb >>= \b -> return $! a mod b

instance rem (m a) | rem a & Monad m
where
 (rem) ma mb = ma >>= \a -> mb >>= \b -> return $! a rem b

/* http://hpaste.org/10673 */

Read and post comments | Send to a friend

My Desktop 2008

nobody@vox.com(vagston) — Thu, 24 Jul 2008 10:10:55 -0700

MyDesktop

Read and post comments | Send to a friend

Fascinating excursion in monads history

nobody@vox.com(vagston) — Tue, 03 Jun 2008 15:30:02 -0700

Fascinating excursion in monads history

The notion of monad comes from category theory. It first arose in the area of homological algebra, but later was recognised (due to the work of Kleisli and of Eilenberg and Moore) to have much wider applications.

Its importance emerged slowly: in early days, it was not even given a proper name, but called simply a "standard construction" or a "triple". The formulation used here is due to Kleisli.

Eugenio Moggi proposed that monads provide a useful structuring tool for denotational semantics. He showed how lambda calculus could be given call-by-value and call-by-name semantics in an arbitrary monad, and how monads could encapsulate
a wide variety of programming language features such as state, exception handling, and continuations.

Independent of Moggi, but at about the same time, Michael Spivey proposed that monads provide a useful structuring tool for exception handling in pure functional languages, and demonstrated this thesis with an elegant program for term rewriting. He showed how monads could treat exceptions and non-deterministic choice in a common framework, thus capturing precisely a notion that I had groped towards years earlier.

Inspired byMoggi and Spivey, I proposed monads as a general technique for structuring functional programs. My early proposals were based on a special syntax for monads, that generalised list comprehensions. This was unfortunate, in that it led many to think a special syntax was needed.

This new presentation is designed to convey that monads can be profitably applied to structure programs today with existing languages.

A key observation of Moggi's was that values and computations should be assigned different types: the value type a is distinct from the computation type M a. In a call-by-value language, functions take values into computations (as in a -> M b); in a call-by-name language, functions take computations into computations (as in M a -> M b).

John Reynolds made exactly the same point a decade ago. The essence of Algol, according to Reynolds, is a programming language that distinguishes data types from phrase types. In his work data types (such as int) play the roles of values, and phrase types (such as int exp) play the role of computations, and the same distinction between call-by-value and call-by-name appears. These ideas form the basis for the design of Forsythe. But the vital unitM and bindM operations do not appear in Reynolds' work.

This is not the only time that John Reynolds has been a decade ahead of the rest of us. Among other things, he was an early promoter of continuation-passing style and the first to apply category theory to language design. One intriguing aspect of his recent work is the use of intersection types, so perhaps we should expect an upsurge of interest in that topic early in the next millenium.

-- "The essence of functional programming", Philip Wadler, University of Glasgow.

Read and post comments | Send to a friend