├── .gitignore ├── src ├── IO.agda ├── Empty.agda ├── Unit.agda ├── Fin.agda ├── Test.agda ├── Vector.agda ├── Bool.agda ├── Int.agda ├── Example.agda ├── JS.agda ├── Char.agda ├── String.agda ├── List.agda ├── STLC.agda ├── Float.agda ├── Nat.agda ├── Base.agda └── EAC.agda ├── README.md └── run /.gitignore: -------------------------------------------------------------------------------- 1 | *.agdai 2 | node_modules 3 | .DS_Store 4 | -------------------------------------------------------------------------------- /src/IO.agda: -------------------------------------------------------------------------------- 1 | module IO where 2 | 3 | postulate IO : ∀ {a} → Set a → Set a 4 | {-# BUILTIN IO IO #-} 5 | -------------------------------------------------------------------------------- /src/Empty.agda: -------------------------------------------------------------------------------- 1 | module Empty where 2 | 3 | data Empty : Set where 4 | 5 | void : ∀ {P : Set} → Empty → P 6 | void () 7 | -------------------------------------------------------------------------------- /src/Unit.agda: -------------------------------------------------------------------------------- 1 | module Unit where 2 | 3 | -- Do I need a record and the built-in ⊤? Why? 4 | data Unit : Set where 5 | unit : Unit 6 | -------------------------------------------------------------------------------- /src/Fin.agda: -------------------------------------------------------------------------------- 1 | module Fin where 2 | 3 | open import Nat 4 | 5 | data Fin : Nat -> Set where 6 | zero : ∀ {n} → Fin (suc n) 7 | suc : ∀ {n} → Fin n → Fin (suc n) 8 | -------------------------------------------------------------------------------- /src/Test.agda: -------------------------------------------------------------------------------- 1 | module Test where 2 | 3 | open import Base 4 | 5 | sum : Nat → Nat 6 | sum i = 7 | init 0 8 | for i from 0 to i do: 9 | λ result → result + i 10 | -------------------------------------------------------------------------------- /src/Vector.agda: -------------------------------------------------------------------------------- 1 | module Vector where 2 | 3 | open import Nat 4 | 5 | data Vector (A : Set) : (n : Nat) → Set where 6 | _,_ : ∀ n → (x : A) (xs : Vector A n) → Vector A (suc n) 7 | end : Vector A zero 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Moonad's Agda-lib 2 | 3 | Agda libraries relevant to Moonad. 4 | 5 | ``` 6 | # must disable the agda-stdlib by editing ~/.agda/defaults 7 | agda --js --compile-dir=node_modules src/Example.agda 8 | node node_modules/jAgda.Example.js 9 | ``` 10 | -------------------------------------------------------------------------------- /run: -------------------------------------------------------------------------------- 1 | # !/bin/bash 2 | # Runs the script in the current folder 3 | DIR=$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd ) 4 | cd "${DIR}" 5 | 6 | # Agda code to JavaScript 7 | agda --js --compile-dir=node_modules ./src/Example.agda 8 | node node_modules/jAgda.Example.js 9 | -------------------------------------------------------------------------------- /src/Bool.agda: -------------------------------------------------------------------------------- 1 | module Bool where 2 | 3 | data Bool : Set where 4 | false true : Bool 5 | 6 | {-# BUILTIN BOOL Bool #-} 7 | {-# BUILTIN FALSE false #-} 8 | {-# BUILTIN TRUE true #-} 9 | 10 | {-# COMPILE JS Bool = function (x,v) { return ((x) ? v["true"]() : v["false"]()); } #-} 11 | {-# COMPILE JS false = false #-} 12 | {-# COMPILE JS true = true #-} 13 | -------------------------------------------------------------------------------- /src/Int.agda: -------------------------------------------------------------------------------- 1 | module Int where 2 | 3 | open import Nat 4 | open import String 5 | 6 | infix 8 pos 7 | 8 | data Int : Set where 9 | pos : (n : Nat) → Int 10 | negsuc : (n : Nat) → Int 11 | 12 | {-# BUILTIN INTEGER Int #-} 13 | {-# BUILTIN INTEGERPOS pos #-} 14 | {-# BUILTIN INTEGERNEGSUC negsuc #-} 15 | 16 | primitive primShowInteger : Int → String 17 | -------------------------------------------------------------------------------- /src/Example.agda: -------------------------------------------------------------------------------- 1 | module Example where 2 | 3 | open import Humanity 4 | 5 | main : Program 6 | main _ = do 7 | 8 | print "Hello, world!" 9 | 10 | for i from 0 to 10 do: 11 | print ("i: " ++ show i) 12 | 13 | if (2 == 2) 14 | (then: print "foo") 15 | (else: print "bar") 16 | 17 | let num = 18 | init 0.0 19 | for i from 0 to 1000000 do: 20 | λ result → result f+ 1.0 21 | 22 | print (primShowFloat num) 23 | -------------------------------------------------------------------------------- /src/JS.agda: -------------------------------------------------------------------------------- 1 | module JS where 2 | 3 | open import Unit 4 | open import String 5 | open import IO 6 | 7 | infixl 1 _>>=_ 8 | 9 | postulate 10 | return : ∀ {a} {A : Set a} → A → IO A 11 | _>>=_ : ∀ {a b} {A : Set a} {B : Set b} → IO A → (A → IO B) → IO B 12 | _>>_ : ∀ {a b} {A : Set a} {B : Set b} → IO A → IO B → IO B 13 | print : String → IO Unit 14 | 15 | {-# COMPILE JS return = a => b => c => c #-} 16 | {-# COMPILE JS _>>=_ = a => b => c => d => f => x => f(x) #-} 17 | {-# COMPILE JS _>>_ = a => b => c => d => f => x => x #-} 18 | {-# COMPILE JS print = s => console.log(s) #-} 19 | -------------------------------------------------------------------------------- /src/Char.agda: -------------------------------------------------------------------------------- 1 | module Char where 2 | 3 | open import Nat 4 | open import Bool 5 | 6 | postulate Char : Set 7 | {-# BUILTIN CHAR Char #-} 8 | 9 | primitive 10 | primIsLower : Char → Bool 11 | primIsDigit : Char → Bool 12 | primIsAlpha : Char → Bool 13 | primIsSpace : Char → Bool 14 | primIsAscii : Char → Bool 15 | primIsLatin1 : Char → Bool 16 | primIsPrint : Char → Bool 17 | primIsHexDigit : Char → Bool 18 | primToUpper primToLower : Char → Char 19 | primCharToNat : Char → Nat 20 | primNatToChar : Nat → Char 21 | primCharEquality : Char → Char → Bool 22 | -------------------------------------------------------------------------------- /src/String.agda: -------------------------------------------------------------------------------- 1 | module String where 2 | 3 | open import Bool 4 | open import List renaming ( length to llength ) 5 | open import Char 6 | open import Nat 7 | 8 | postulate String : Set 9 | {-# BUILTIN STRING String #-} 10 | 11 | primitive 12 | primStringToList : String → List Char 13 | primStringFromList : List Char → String 14 | primStringAppend : String → String → String 15 | primStringEquality : String → String → Bool 16 | primShowChar : Char → String 17 | primShowString : String → String 18 | 19 | {-# COMPILE JS primStringToList = function(x) { return x.split(""); } #-} 20 | {-# COMPILE JS primStringFromList = function(x) { return x.join(""); } #-} 21 | {-# COMPILE JS primStringAppend = function(x) { return function(y) { return x+y; }; } #-} 22 | {-# COMPILE JS primStringEquality = function(x) { return function(y) { return x===y; }; } #-} 23 | {-# COMPILE JS primShowChar = function(x) { return JSON.stringify(x); } #-} 24 | {-# COMPILE JS primShowString = function(x) { return JSON.stringify(x); } #-} 25 | -------------------------------------------------------------------------------- /src/List.agda: -------------------------------------------------------------------------------- 1 | module List where 2 | 3 | open import Nat 4 | open import Bool 5 | 6 | infixr 5 _,_ 7 | data List {a} (A : Set a) : Set a where 8 | end : List A 9 | _,_ : (x : A) (xs : List A) → List A 10 | 11 | {-# BUILTIN LIST List #-} 12 | 13 | {-# COMPILE JS List = function(x,v) { if (x.length < 1) { return v["[]"](); } else { return v["_∷_"](x[0], x.slice(1)); } } #-} 14 | {-# COMPILE JS end = Array() #-} 15 | {-# COMPILE JS _,_ = function (x) { return function(y) { return Array(x).concat(y); }; } #-} 16 | 17 | foldr : ∀ {A : Set} {B : Set} → (A → B → B) → B → List A → B 18 | foldr c n end = n 19 | foldr c n (x , xs) = c x (foldr c n xs) 20 | 21 | length : ∀ {A : Set} → List A → Nat 22 | length = foldr (λ a n → suc n) zero 23 | 24 | map : ∀ {A : Set} {B : Set} → (f : A → B) → List A → List B 25 | map f end = end 26 | map f (x , xs) = (f x) , (map f xs) 27 | 28 | filter : {A : Set} → (A → Bool) → List A → List A 29 | filter p end = end 30 | filter p (x , l) with p x 31 | ... | true = x , (filter p l) 32 | ... | false = filter p l 33 | 34 | sum : List Nat → Nat 35 | sum end = zero 36 | sum (x , l) = x + (sum l) 37 | -------------------------------------------------------------------------------- /src/STLC.agda: -------------------------------------------------------------------------------- 1 | module STLC where 2 | 3 | open import Nat 4 | open import Fin 5 | 6 | data Term : Nat → Set where 7 | one : ∀ {n} → Term n 8 | var : ∀ {n} → Fin n → Term n 9 | app : ∀ {n} → Term n → Term n → Term n 10 | lam : ∀ {n} → Term (suc n) → Term n 11 | 12 | data Type : Set where 13 | uni : Type 14 | arr : Type → Type → Type 15 | 16 | Γ : Nat → Set 17 | Γ n = ∀ (i : Fin n) → Type 18 | 19 | _,_ : ∀ {n} → Γ n → Type → Γ (suc n) 20 | _,_ Γ t = λ { zero → t; (suc n) → Γ n } 21 | 22 | data _⊢_∷_ : {n : Nat} → Γ n → Term n → Type → Set where 23 | one-T : ∀ {n} (Γ : Γ n) → Γ ⊢ one ∷ uni 24 | lam-T : ∀ {n} a A B (Γ : Γ n) → (Γ , A) ⊢ a ∷ B → Γ ⊢ lam a ∷ arr A B 25 | app-T : ∀ {n} f x A B (Γ : Γ n) → Γ ⊢ f ∷ arr A B → Γ ⊢ x ∷ A → Γ ⊢ app f x ∷ B 26 | var-T : ∀ {n} i (Γ : Γ n) → Γ ⊢ var i ∷ Γ i 27 | 28 | Subst : Nat → Set 29 | Subst n = ∀ (i : Fin n) → Term n 30 | 31 | subst : ∀ {n} → Subst n → Term n → Term n 32 | subst s one = one 33 | subst s (var i) = s i 34 | subst s (app f x) = app (subst s f) (subst s x) 35 | subst s (lam t) = lam (subst (λ { zero → var zero; (suc m) → ? }) t) 36 | 37 | -- data _~>_ : {n : Nat} → Term n → Term n → Set where 38 | 39 | -------------------------------------------------------------------------------- /src/Float.agda: -------------------------------------------------------------------------------- 1 | module Float where 2 | 3 | open import Bool 4 | open import Nat 5 | open import Int 6 | open import String 7 | 8 | postulate Float : Set 9 | {-# BUILTIN FLOAT Float #-} 10 | 11 | primitive 12 | primFloatEquality : Float → Float → Bool 13 | primFloatLess : Float → Float → Bool 14 | primFloatNumericalEquality : Float → Float → Bool 15 | primFloatNumericalLess : Float → Float → Bool 16 | primNatToFloat : Nat → Float 17 | primFloatPlus : Float → Float → Float 18 | primFloatMinus : Float → Float → Float 19 | primFloatTimes : Float → Float → Float 20 | primFloatNegate : Float → Float 21 | primFloatDiv : Float → Float → Float 22 | primFloatSqrt : Float → Float 23 | primRound : Float → Int 24 | primFloor : Float → Int 25 | primCeiling : Float → Int 26 | primExp : Float → Float 27 | primLog : Float → Float 28 | primSin : Float → Float 29 | primCos : Float → Float 30 | primTan : Float → Float 31 | primASin : Float → Float 32 | primACos : Float → Float 33 | primATan : Float → Float 34 | primATan2 : Float → Float → Float 35 | primShowFloat : Float → String 36 | -------------------------------------------------------------------------------- /src/Nat.agda: -------------------------------------------------------------------------------- 1 | module Nat where 2 | 3 | open import Bool 4 | 5 | data Nat : Set where 6 | zero : Nat 7 | suc : Nat → Nat 8 | 9 | {-# BUILTIN NATURAL Nat #-} 10 | 11 | infix 4 _==_ _<_ 12 | infixl 6 _+_ _-_ 13 | infixl 7 _*_ 14 | 15 | _+_ : Nat → Nat → Nat 16 | zero + m = m 17 | suc n + m = suc (n + m) 18 | 19 | {-# BUILTIN NATPLUS _+_ #-} 20 | 21 | _-_ : Nat → Nat → Nat 22 | n - zero = n 23 | zero - suc m = zero 24 | suc n - suc m = n - m 25 | 26 | {-# BUILTIN NATMINUS _-_ #-} 27 | 28 | _*_ : Nat → Nat → Nat 29 | zero * m = zero 30 | suc n * m = m + n * m 31 | 32 | {-# BUILTIN NATTIMES _*_ #-} 33 | 34 | _==_ : Nat → Nat → Bool 35 | zero == zero = true 36 | suc n == suc m = n == m 37 | _ == _ = false 38 | 39 | {-# BUILTIN NATEQUALS _==_ #-} 40 | 41 | _<_ : Nat → Nat → Bool 42 | _ < zero = false 43 | zero < suc _ = true 44 | suc n < suc m = n < m 45 | 46 | {-# BUILTIN NATLESS _<_ #-} 47 | 48 | _>_ : Nat → Nat → Bool 49 | zero > zero = false 50 | _ > zero = true 51 | zero > suc _ = false 52 | suc n > suc m = n > m 53 | 54 | div-helper : (k m n j : Nat) → Nat 55 | div-helper k m zero j = k 56 | div-helper k m (suc n) zero = div-helper (suc k) m n m 57 | div-helper k m (suc n) (suc j) = div-helper k m n j 58 | 59 | {-# BUILTIN NATDIVSUCAUX div-helper #-} 60 | 61 | mod-helper : (k m n j : Nat) → Nat 62 | mod-helper k m zero j = k 63 | mod-helper k m (suc n) zero = mod-helper 0 m n m 64 | mod-helper k m (suc n) (suc j) = mod-helper (suc k) m n j 65 | 66 | {-# BUILTIN NATMODSUCAUX mod-helper #-} 67 | 68 | min : Nat → Nat → Nat 69 | min x y with x < y 70 | ... | true = x 71 | ... | false = y 72 | 73 | max : Nat → Nat → Nat 74 | max x y with x < y 75 | ... | true = y 76 | ... | false = x 77 | -------------------------------------------------------------------------------- /src/Base.agda: -------------------------------------------------------------------------------- 1 | module Base where 2 | 3 | -- Use agda-prelude instead of agda-stdlib? 4 | 5 | open import JS public 6 | open import Unit public 7 | open import Nat public 8 | open import List public 9 | open import Bool public 10 | open import String public 11 | open import IO public 12 | open import Float public 13 | open import Int public 14 | 15 | Lazy : ∀ (A : Set) → Set 16 | Lazy A = Unit → A 17 | 18 | then:_ : ∀ {A : Set} → A → Lazy A 19 | then: a = λ x → a 20 | 21 | else:_ : ∀ {A : Set} → A → Lazy A 22 | else: a = λ x → a 23 | 24 | if : ∀ {A : Set} → Bool → Lazy A → Lazy A → A 25 | if true t f = t unit 26 | if false t f = f unit 27 | 28 | {-# COMPILE JS if = A => c => t => f => (c ? t() : f()) #-} 29 | 30 | init-to : ∀ {A : Set} → Nat → A → (Nat → A → A) → A 31 | init-to zero x fn = x 32 | init-to (suc i) x fn = init-to i (fn zero x) (λ i → fn (suc i)) 33 | 34 | {-# COMPILE JS init-to = A => n => x => fn => { for (var i = 0, l = n.toJSValue(); i < l; ++i) x = fn(agdaRTS.primIntegerFromString(String(i)))(x); return x; } #-} 35 | 36 | {-# TERMINATING #-} 37 | init-to-f : ∀ {A : Set} → Float → A → (Float → A → A) → A 38 | init-to-f 0.0 x fn = x 39 | init-to-f i x fn = init-to-f (primFloatMinus i 1.0) (fn 0.0 x) (λ i → fn (primFloatPlus i 1.0)) 40 | 41 | foo : Nat 42 | foo = init-to-f 10.3 0 (λ f i → suc i) 43 | 44 | syntax init-to m x (λ i → b) = init x for i to m do: b 45 | 46 | init-from-to : ∀ {A : Set} → Nat → A → Nat → (Nat → A → A) → A 47 | init-from-to n x m f = init-to (m - n) x (λ i x → f (n + i) x) 48 | 49 | syntax init-from-to n x m (λ i → b) = init x for i from n to m do: b 50 | 51 | for-to : Nat → (Nat → IO Unit) → IO Unit 52 | for-to zero act = return unit 53 | for-to (suc n) act = act zero >> for-to n (λ i → act (suc i)) 54 | 55 | syntax for-from-to n m (λ i → b) = for i from n to m do: b 56 | 57 | for-from-to : Nat → Nat → (Nat → IO Unit) → IO Unit 58 | for-from-to n m f = for-to (m - n) (λ i → f (n + i)) 59 | 60 | syntax for-to m (λ i → b) = for i to m do: b 61 | 62 | _++_ : String → String → String 63 | _++_ = primStringAppend 64 | 65 | show : Nat → String 66 | show zero = "Z" 67 | show (suc n) = "S" ++ show n 68 | 69 | Program : Set 70 | Program = Lazy (IO Unit) 71 | 72 | _f+_ : Float → Float → Float 73 | _f+_ = primFloatPlus 74 | -------------------------------------------------------------------------------- /src/EAC.agda: -------------------------------------------------------------------------------- 1 | module EAC where 2 | 3 | open import Bool 4 | open import Nat 5 | 6 | data Vec (A : Set) : (n : Nat) -> Set where 7 | _,_ : ∀ {n} -> A -> Vec A n -> Vec A (suc n) 8 | [] : Vec A zero 9 | 10 | data Sig (A : Set) (B : A → Set) : Set where 11 | sig : (a : A) → B a → Sig A B 12 | 13 | Exists : ∀ {A : Set} → (A → Set) → Set 14 | Exists = Sig _ 15 | 16 | Pair : ∀ (A B : Set) → Set 17 | Pair A B = Sig A (λ x → B) 18 | 19 | -- variable 20 | -- m n : Nat 21 | -- b : Bool 22 | -- Γ Δ Ξ T I O : Vec Bool n 23 | 24 | -- A Linear term has an output and an output usage annotation 25 | -- For each variable (i.e. index in the Vec): 26 | -- * true: available 27 | -- * false: already consumed 28 | Linear : Set₁ 29 | Linear = ∀ n (Γa Γb : Vec Bool n) → Set 30 | 31 | data Var : Linear where 32 | z : ∀ {n Γ} → Var (suc n) (true , Γ) (false , Γ) 33 | s : ∀ {n Γa Γb x} → Var n Γa Γb → Var (suc n) (x , Γa) (x , Γb) 34 | 35 | data Lam : Linear where 36 | var : ∀ {n Γa Γb} → Var n Γa Γb → Lam n Γa Γb 37 | app : ∀ {n Γa Γb Γc} → Lam n Γa Γb → Lam n Γb Γc → Lam n Γa Γc 38 | lam : ∀ {n Γa Γb} → Lam (suc n) (true , Γa) (false , Γb) → Lam n Γa Γb 39 | 40 | -- Γi Γo: input and output usage of the env 41 | -- Γt: target usage covered by the content of the env 42 | data Env : ∀ n m → (Γi Γo : Vec Bool n) (Γt : Vec Bool m) → Set where 43 | -- empty environment 44 | [] : ∀ {n Γi Γo} → Env n zero Γi Γo [] 45 | -- 0th variable is available so we have a value for it 46 | _,_ : ∀ {n m Γi Γm Γo Γt} → Lam n Γi Γm → Env n m Γm Γo Γt → Env n (suc m) Γi Γo (true , Γt) 47 | -- -- 0th variable has already been consumed: we don't have a term for it anymore 48 | ─,_ : ∀ {n m Γi Γo Γt} → Env n m Γi Γo Γt → Env n (suc m) Γi Γo (false , Γt) 49 | -- -- When we go under binders, we need to be able to extend the input/output 50 | -- -- context to cope with the extended context 51 | [v]∷_ : ∀ {n m Γi Γo Γt} → Env n m Γi Γo Γt → Env (suc n) (suc m) (true , Γi) (false , Γo) (false , Γt) 52 | ]v[∷_ : ∀ {n m Γi Γo Γt} → Env n m Γi Γo Γt → Env (suc n) (suc m) (false , Γi) (false , Γo) (false , Γt) 53 | 54 | -- Input/output usage pairs that have the same consumption pattern 55 | data Equiv : ∀ n → (Γ0i Γ0o Γ1i Γ1o : Vec Bool n) → Set where 56 | -- Empty pairs have the same consumption pattern 57 | empty : Equiv zero [] [] [] [] 58 | -- If a resource is untouched in one side, then it must be untouched on the other 59 | skip : ∀ {n} Γ0i Γ0o Γ1i Γ1o A B → Equiv (suc n) (A , Γ0i) (A , Γ0o) (B , Γ1i) (B , Γ1o) 60 | -- If a resource is used in one side, then it must be used on the other 61 | consume : ∀ {n} Γ0i Γ0o Γ1i Γ1o → Equiv (suc n) (true , Γ0i) (false , Γ0o) (true , Γ1i) (false , Γ1o) 62 | 63 | 64 | -- R: target of the substitution 65 | -- V: output (e.g. substituting for vars yields terms) 66 | Subst : (R : Linear) (V : Linear) → Set 67 | Subst R V = ∀ {n m Γi Γo I O} 68 | -- environment targetting I 69 | → Env n m Γi Γo I 70 | -- R consuming resources in I, returning O leftovers 71 | → R m I O 72 | -- the result is a usage annotation, a value V consuming in the input, returning M leftovers, an environment of leftovers for whatever is still true in O 73 | → Exists (λ M → Pair (V n Γi M) (Env n m M Γo O)) 74 | 75 | -- substVar : Subst Var Lam 76 | -- substVar (t ∷ ρ) z = -, t , ─∷ ρ 77 | -- substVar (x ∷ ρ) (s v) = {!!} 78 | -- substVar (─∷ ρ) (s v) = {!!} 79 | -- substVar ([v]∷ ρ) (s v) = {!!} 80 | --------------------------------------------------------------------------------