diff --git a/test/Agda.Builtin.Bool.html b/test/Agda.Builtin.Bool.html new file mode 100644 index 00000000..63da33b2 --- /dev/null +++ b/test/Agda.Builtin.Bool.html @@ -0,0 +1,17 @@ + +Agda.Builtin.Bool
{-# OPTIONS --cubical-compatible --safe --no-universe-polymorphism
+            --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Bool where
+
+data Bool : Set where
+  false true : Bool
+
+{-# BUILTIN BOOL  Bool  #-}
+{-# BUILTIN FALSE false #-}
+{-# BUILTIN TRUE  true  #-}
+
+{-# COMPILE JS Bool  = function (x,v) { return ((x)? v["true"]() : v["false"]()); } #-}
+{-# COMPILE JS false = false #-}
+{-# COMPILE JS true  = true  #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Char.Properties.html b/test/Agda.Builtin.Char.Properties.html new file mode 100644 index 00000000..98373497 --- /dev/null +++ b/test/Agda.Builtin.Char.Properties.html @@ -0,0 +1,12 @@ + +Agda.Builtin.Char.Properties
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Char.Properties where
+
+open import Agda.Builtin.Char
+open import Agda.Builtin.Equality
+
+primitive
+
+  primCharToNatInjective : ∀ a b → primCharToNat a ≡ primCharToNat b → a ≡ b
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Char.html b/test/Agda.Builtin.Char.html new file mode 100644 index 00000000..ec85da80 --- /dev/null +++ b/test/Agda.Builtin.Char.html @@ -0,0 +1,20 @@ + +Agda.Builtin.Char
{-# OPTIONS --cubical-compatible --safe --no-universe-polymorphism
+            --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Char where
+
+open import Agda.Builtin.Nat
+open import Agda.Builtin.Bool
+
+postulate Char : Set
+{-# BUILTIN CHAR Char #-}
+
+primitive
+  primIsLower primIsDigit primIsAlpha primIsSpace primIsAscii
+    primIsLatin1 primIsPrint primIsHexDigit : Char → Bool
+  primToUpper primToLower : Char → Char
+  primCharToNat : Char → Nat
+  primNatToChar : Nat → Char
+  primCharEquality : Char → Char → Bool
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Equality.Erase.html b/test/Agda.Builtin.Equality.Erase.html new file mode 100644 index 00000000..556daf3d --- /dev/null +++ b/test/Agda.Builtin.Equality.Erase.html @@ -0,0 +1,9 @@ + +Agda.Builtin.Equality.Erase
{-# OPTIONS --with-K --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Equality.Erase where
+
+open import Agda.Builtin.Equality
+
+primitive primEraseEquality : ∀ {a} {A : Set a} {x y : A} → x ≡ y → x ≡ y
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Equality.html b/test/Agda.Builtin.Equality.html new file mode 100644 index 00000000..d686af44 --- /dev/null +++ b/test/Agda.Builtin.Equality.html @@ -0,0 +1,11 @@ + +Agda.Builtin.Equality
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Equality where
+
+infix 4 _≡_
+data _≡_ {a} {A : Set a} (x : A) : A → Set a where
+  instance refl : x ≡ x
+
+{-# BUILTIN EQUALITY _≡_ #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Float.html b/test/Agda.Builtin.Float.html new file mode 100644 index 00000000..34c1c528 --- /dev/null +++ b/test/Agda.Builtin.Float.html @@ -0,0 +1,211 @@ + +Agda.Builtin.Float
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Float where
+
+open import Agda.Builtin.Bool
+open import Agda.Builtin.Int
+open import Agda.Builtin.Maybe
+open import Agda.Builtin.Nat
+open import Agda.Builtin.Sigma
+open import Agda.Builtin.String
+open import Agda.Builtin.Word
+
+postulate Float : Set
+{-# BUILTIN FLOAT Float #-}
+
+primitive
+  -- Relations
+  primFloatInequality        : Float → Float → Bool
+  primFloatEquality          : Float → Float → Bool
+  primFloatLess              : Float → Float → Bool
+  primFloatIsInfinite        : Float → Bool
+  primFloatIsNaN             : Float → Bool
+  primFloatIsNegativeZero    : Float → Bool
+  primFloatIsSafeInteger     : Float → Bool
+  -- Conversions
+  primFloatToWord64          : Float → Maybe Word64
+  primNatToFloat             : Nat → Float
+  primIntToFloat             : Int → Float
+  primFloatRound             : Float → Maybe Int
+  primFloatFloor             : Float → Maybe Int
+  primFloatCeiling           : Float → Maybe Int
+  primFloatToRatio           : Float → (Σ Int λ _ → Int)
+  primRatioToFloat           : Int → Int → Float
+  primFloatDecode            : Float → Maybe (Σ Int λ _ → Int)
+  primFloatEncode            : Int → Int → Maybe Float
+  primShowFloat              : Float → String
+  -- Operations
+  primFloatPlus              : Float → Float → Float
+  primFloatMinus             : Float → Float → Float
+  primFloatTimes             : Float → Float → Float
+  primFloatDiv               : Float → Float → Float
+  primFloatPow               : Float → Float → Float
+  primFloatNegate            : Float → Float
+  primFloatSqrt              : Float → Float
+  primFloatExp               : Float → Float
+  primFloatLog               : Float → Float
+  primFloatSin               : Float → Float
+  primFloatCos               : Float → Float
+  primFloatTan               : Float → Float
+  primFloatASin              : Float → Float
+  primFloatACos              : Float → Float
+  primFloatATan              : Float → Float
+  primFloatATan2             : Float → Float → Float
+  primFloatSinh              : Float → Float
+  primFloatCosh              : Float → Float
+  primFloatTanh              : Float → Float
+  primFloatASinh             : Float → Float
+  primFloatACosh             : Float → Float
+  primFloatATanh             : Float → Float
+
+{-# COMPILE JS
+    primFloatRound = function(x) {
+        x = agdaRTS._primFloatRound(x);
+        if (x === null) {
+            return z_jAgda_Agda_Builtin_Maybe["Maybe"]["nothing"];
+        }
+        else {
+            return z_jAgda_Agda_Builtin_Maybe["Maybe"]["just"](x);
+        }
+    };
+#-}
+{-# COMPILE JS
+    primFloatFloor = function(x) {
+        x = agdaRTS._primFloatFloor(x);
+        if (x === null) {
+            return z_jAgda_Agda_Builtin_Maybe["Maybe"]["nothing"];
+        }
+        else {
+            return z_jAgda_Agda_Builtin_Maybe["Maybe"]["just"](x);
+        }
+    };
+#-}
+{-# COMPILE JS
+    primFloatCeiling = function(x) {
+        x = agdaRTS._primFloatCeiling(x);
+        if (x === null) {
+            return z_jAgda_Agda_Builtin_Maybe["Maybe"]["nothing"];
+        }
+        else {
+            return z_jAgda_Agda_Builtin_Maybe["Maybe"]["just"](x);
+        }
+    };
+#-}
+{-# COMPILE JS
+    primFloatToRatio = function(x) {
+        x = agdaRTS._primFloatToRatio(x);
+        return z_jAgda_Agda_Builtin_Sigma["_,_"](x.numerator)(x.denominator);
+    };
+#-}
+{-# COMPILE JS
+    primFloatDecode = function(x) {
+        x = agdaRTS._primFloatDecode(x);
+        if (x === null) {
+            return z_jAgda_Agda_Builtin_Maybe["Maybe"]["nothing"];
+        }
+        else {
+            return z_jAgda_Agda_Builtin_Maybe["Maybe"]["just"](
+                z_jAgda_Agda_Builtin_Sigma["_,_"](x.mantissa)(x.exponent));
+        }
+    };
+#-}
+{-# COMPILE JS
+    primFloatEncode = function(x) {
+        return function (y) {
+            x = agdaRTS.uprimFloatEncode(x, y);
+            if (x === null) {
+                return z_jAgda_Agda_Builtin_Maybe["Maybe"]["nothing"];
+            }
+            else {
+                return z_jAgda_Agda_Builtin_Maybe["Maybe"]["just"](x);
+            }
+        }
+    };
+#-}
+
+primFloatNumericalEquality = primFloatEquality
+{-# WARNING_ON_USAGE primFloatNumericalEquality
+"Warning: primFloatNumericalEquality was deprecated in Agda v2.6.2.
+Please use primFloatEquality instead."
+#-}
+
+primFloatNumericalLess = primFloatLess
+{-# WARNING_ON_USAGE primFloatNumericalLess
+"Warning: primFloatNumericalLess was deprecated in Agda v2.6.2.
+Please use primFloatLess instead."
+#-}
+
+primRound = primFloatRound
+{-# WARNING_ON_USAGE primRound
+"Warning: primRound was deprecated in Agda v2.6.2.
+Please use primFloatRound instead."
+#-}
+
+primFloor = primFloatFloor
+{-# WARNING_ON_USAGE primFloor
+"Warning: primFloor was deprecated in Agda v2.6.2.
+Please use primFloatFloor instead."
+#-}
+
+primCeiling = primFloatCeiling
+{-# WARNING_ON_USAGE primCeiling
+"Warning: primCeiling was deprecated in Agda v2.6.2.
+Please use primFloatCeiling instead."
+#-}
+
+primExp = primFloatExp
+{-# WARNING_ON_USAGE primExp
+"Warning: primExp was deprecated in Agda v2.6.2.
+Please use primFloatExp instead."
+#-}
+
+primLog = primFloatLog
+{-# WARNING_ON_USAGE primLog
+"Warning: primLog was deprecated in Agda v2.6.2.
+Please use primFloatLog instead."
+#-}
+
+primSin = primFloatSin
+{-# WARNING_ON_USAGE primSin
+"Warning: primSin was deprecated in Agda v2.6.2.
+Please use primFloatSin instead."
+#-}
+
+primCos = primFloatCos
+{-# WARNING_ON_USAGE primCos
+"Warning: primCos was deprecated in Agda v2.6.2.
+Please use primFloatCos instead."
+#-}
+
+primTan = primFloatTan
+{-# WARNING_ON_USAGE primTan
+"Warning: primTan was deprecated in Agda v2.6.2.
+Please use primFloatTan instead."
+#-}
+
+primASin = primFloatASin
+{-# WARNING_ON_USAGE primASin
+"Warning: primASin was deprecated in Agda v2.6.2.
+Please use primFloatASin instead."
+#-}
+
+
+primACos = primFloatACos
+{-# WARNING_ON_USAGE primACos
+"Warning: primACos was deprecated in Agda v2.6.2.
+Please use primFloatACos instead."
+#-}
+
+primATan = primFloatATan
+{-# WARNING_ON_USAGE primATan
+"Warning: primATan was deprecated in Agda v2.6.2.
+Please use primFloatATan instead."
+#-}
+
+primATan2 = primFloatATan2
+{-# WARNING_ON_USAGE primATan2
+"Warning: primATan2 was deprecated in Agda v2.6.2.
+Please use primFloatATan2 instead."
+#-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.FromNat.html b/test/Agda.Builtin.FromNat.html new file mode 100644 index 00000000..acfa25ae --- /dev/null +++ b/test/Agda.Builtin.FromNat.html @@ -0,0 +1,18 @@ + +Agda.Builtin.FromNat
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.FromNat where
+
+open import Agda.Primitive
+open import Agda.Builtin.Nat
+
+record Number {a} (A : Set a) : Set (lsuc a) where
+  field
+    Constraint : Nat → Set a
+    fromNat : ∀ n → {{_ : Constraint n}} → A
+
+open Number {{...}} public using (fromNat)
+
+{-# BUILTIN FROMNAT fromNat #-}
+{-# DISPLAY Number.fromNat _ n = fromNat n #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.FromNeg.html b/test/Agda.Builtin.FromNeg.html new file mode 100644 index 00000000..6253b020 --- /dev/null +++ b/test/Agda.Builtin.FromNeg.html @@ -0,0 +1,18 @@ + +Agda.Builtin.FromNeg
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.FromNeg where
+
+open import Agda.Primitive
+open import Agda.Builtin.Nat
+
+record Negative {a} (A : Set a) : Set (lsuc a) where
+  field
+    Constraint : Nat → Set a
+    fromNeg : ∀ n → {{_ : Constraint n}} → A
+
+open Negative {{...}} public using (fromNeg)
+
+{-# BUILTIN FROMNEG fromNeg #-}
+{-# DISPLAY Negative.fromNeg _ n = fromNeg n #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.FromString.html b/test/Agda.Builtin.FromString.html new file mode 100644 index 00000000..0b9dffdc --- /dev/null +++ b/test/Agda.Builtin.FromString.html @@ -0,0 +1,18 @@ + +Agda.Builtin.FromString
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.FromString where
+
+open import Agda.Primitive
+open import Agda.Builtin.String
+
+record IsString {a} (A : Set a) : Set (lsuc a) where
+  field
+    Constraint : String → Set a
+    fromString : (s : String) {{_ : Constraint s}} → A
+
+open IsString {{...}} public using (fromString)
+
+{-# BUILTIN FROMSTRING fromString #-}
+{-# DISPLAY IsString.fromString _ s = fromString s #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Int.html b/test/Agda.Builtin.Int.html new file mode 100644 index 00000000..775af21f --- /dev/null +++ b/test/Agda.Builtin.Int.html @@ -0,0 +1,20 @@ + +Agda.Builtin.Int
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Int where
+
+open import Agda.Builtin.Nat
+open import Agda.Builtin.String
+
+infix 8 pos  -- Standard library uses this as +_
+
+data Int : Set where
+  pos    : (n : Nat) → Int
+  negsuc : (n : Nat) → Int
+
+{-# BUILTIN INTEGER       Int    #-}
+{-# BUILTIN INTEGERPOS    pos    #-}
+{-# BUILTIN INTEGERNEGSUC negsuc #-}
+
+primitive primShowInteger : Int → String
+
\ No newline at end of file diff --git a/test/Agda.Builtin.List.html b/test/Agda.Builtin.List.html new file mode 100644 index 00000000..add6de61 --- /dev/null +++ b/test/Agda.Builtin.List.html @@ -0,0 +1,18 @@ + +Agda.Builtin.List
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.List where
+
+infixr 5 _∷_
+data List {a} (A : Set a) : Set a where
+  []  : List A
+  _∷_ : (x : A) (xs : List A) → List A
+
+{-# BUILTIN LIST List #-}
+
+{-# COMPILE JS  List = function(x,v) {
+  if (x.length < 1) { return v["[]"](); } else { return v["_∷_"](x[0], x.slice(1)); }
+} #-}
+{-# COMPILE JS [] = Array() #-}
+{-# COMPILE JS _∷_ = function (x) { return function(y) { return Array(x).concat(y); }; } #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Maybe.html b/test/Agda.Builtin.Maybe.html new file mode 100644 index 00000000..76d37bd3 --- /dev/null +++ b/test/Agda.Builtin.Maybe.html @@ -0,0 +1,11 @@ + +Agda.Builtin.Maybe
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Maybe where
+
+data Maybe {a} (A : Set a) : Set a where
+  just : A → Maybe A
+  nothing : Maybe A
+
+{-# BUILTIN MAYBE Maybe #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Nat.html b/test/Agda.Builtin.Nat.html new file mode 100644 index 00000000..6ccb7bda --- /dev/null +++ b/test/Agda.Builtin.Nat.html @@ -0,0 +1,136 @@ + +Agda.Builtin.Nat
{-# OPTIONS --cubical-compatible --safe --no-universe-polymorphism
+            --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Nat where
+
+open import Agda.Builtin.Bool
+
+data Nat : Set where
+  zero : Nat
+  suc  : (n : Nat) → Nat
+
+{-# BUILTIN NATURAL Nat #-}
+
+infix  4 _==_ _<_
+infixl 6 _+_ _-_
+infixl 7 _*_
+
+_+_ : Nat → Nat → Nat
+zero  + m = m
+suc n + m = suc (n + m)
+
+{-# BUILTIN NATPLUS _+_ #-}
+
+_-_ : Nat → Nat → Nat
+n     - zero = n
+zero  - suc m = zero
+suc n - suc m = n - m
+
+{-# BUILTIN NATMINUS _-_ #-}
+
+_*_ : Nat → Nat → Nat
+zero  * m = zero
+suc n * m = m + n * m
+
+{-# BUILTIN NATTIMES _*_ #-}
+
+_==_ : Nat → Nat → Bool
+zero  == zero  = true
+suc n == suc m = n == m
+_     == _     = false
+
+{-# BUILTIN NATEQUALS _==_ #-}
+
+_<_ : Nat → Nat → Bool
+_     < zero  = false
+zero  < suc _ = true
+suc n < suc m = n < m
+
+{-# BUILTIN NATLESS _<_ #-}
+
+-- Helper function  div-helper  for Euclidean division.
+---------------------------------------------------------------------------
+--
+-- div-helper computes n / 1+m via iteration on n.
+--
+--   n div (suc m) = div-helper 0 m n m
+--
+-- The state of the iterator has two accumulator variables:
+--
+--   k: The quotient, returned once n=0.  Initialized to 0.
+--
+--   j: A counter, initialized to the divisor m, decreased on each iteration step.
+--      Once it reaches 0, the quotient k is increased and j reset to m,
+--      starting the next countdown.
+--
+-- Under the precondition j ≤ m, the invariant is
+--
+--   div-helper k m n j = k + (n + m - j) div (1 + m)
+
+div-helper : (k m n j : Nat) → Nat
+div-helper k m  zero    j      = k
+div-helper k m (suc n)  zero   = div-helper (suc k) m n m
+div-helper k m (suc n) (suc j) = div-helper k       m n j
+
+{-# BUILTIN NATDIVSUCAUX div-helper #-}
+
+-- Proof of the invariant by induction on n.
+--
+--   clause 1: div-helper k m 0 j
+--           = k                                        by definition
+--           = k + (0 + m - j) div (1 + m)              since m - j < 1 + m
+--
+--   clause 2: div-helper k m (1 + n) 0
+--           = div-helper (1 + k) m n m                 by definition
+--           = 1 + k + (n + m - m) div (1 + m)          by induction hypothesis
+--           = 1 + k +          n  div (1 + m)          by simplification
+--           = k +   (n + (1 + m)) div (1 + m)          by expansion
+--           = k + (1 + n + m - 0) div (1 + m)          by expansion
+--
+--   clause 3: div-helper k m (1 + n) (1 + j)
+--           = div-helper k m n j                       by definition
+--           = k + (n + m - j) div (1 + m)              by induction hypothesis
+--           = k + ((1 + n) + m - (1 + j)) div (1 + m)  by expansion
+--
+-- Q.e.d.
+
+-- Helper function  mod-helper  for the remainder computation.
+---------------------------------------------------------------------------
+--
+-- (Analogous to div-helper.)
+--
+-- mod-helper computes n % 1+m via iteration on n.
+--
+--   n mod (suc m) = mod-helper 0 m n m
+--
+-- The invariant is:
+--
+--   m = k + j  ==>  mod-helper k m n j = (n + k) mod (1 + m).
+
+mod-helper : (k m n j : Nat) → Nat
+mod-helper k m  zero    j      = k
+mod-helper k m (suc n)  zero   = mod-helper 0       m n m
+mod-helper k m (suc n) (suc j) = mod-helper (suc k) m n j
+
+{-# BUILTIN NATMODSUCAUX mod-helper #-}
+
+-- Proof of the invariant by induction on n.
+--
+--   clause 1: mod-helper k m 0 j
+--           = k                               by definition
+--           = (0 + k) mod (1 + m)             since m = k + j, thus k < m
+--
+--   clause 2: mod-helper k m (1 + n) 0
+--           = mod-helper 0 m n m              by definition
+--           = (n + 0)       mod (1 + m)       by induction hypothesis
+--           = (n + (1 + m)) mod (1 + m)       by expansion
+--           = (1 + n) + k)  mod (1 + m)       since k = m (as l = 0)
+--
+--   clause 3: mod-helper k m (1 + n) (1 + j)
+--           = mod-helper (1 + k) m n j        by definition
+--           = (n + (1 + k)) mod (1 + m)       by induction hypothesis
+--           = ((1 + n) + k) mod (1 + m)       by commutativity
+--
+-- Q.e.d.
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Reflection.html b/test/Agda.Builtin.Reflection.html new file mode 100644 index 00000000..e516a77e --- /dev/null +++ b/test/Agda.Builtin.Reflection.html @@ -0,0 +1,472 @@ + +Agda.Builtin.Reflection
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Reflection where
+
+open import Agda.Builtin.Unit
+open import Agda.Builtin.Bool
+open import Agda.Builtin.Nat
+open import Agda.Builtin.Word
+open import Agda.Builtin.List
+open import Agda.Builtin.String
+open import Agda.Builtin.Char
+open import Agda.Builtin.Float
+open import Agda.Builtin.Int
+open import Agda.Builtin.Sigma
+open import Agda.Primitive
+
+-- Names --
+
+postulate Name : Set
+{-# BUILTIN QNAME Name #-}
+
+primitive
+  primQNameEquality : Name → Name → Bool
+  primQNameLess     : Name → Name → Bool
+  primShowQName     : Name → String
+
+-- Fixity --
+
+data Associativity : Set where
+  left-assoc  : Associativity
+  right-assoc : Associativity
+  non-assoc   : Associativity
+
+data Precedence : Set where
+  related   : Float → Precedence
+  unrelated : Precedence
+
+data Fixity : Set where
+  fixity : Associativity → Precedence → Fixity
+
+{-# BUILTIN ASSOC      Associativity #-}
+{-# BUILTIN ASSOCLEFT  left-assoc    #-}
+{-# BUILTIN ASSOCRIGHT right-assoc   #-}
+{-# BUILTIN ASSOCNON   non-assoc     #-}
+
+{-# BUILTIN PRECEDENCE    Precedence #-}
+{-# BUILTIN PRECRELATED   related    #-}
+{-# BUILTIN PRECUNRELATED unrelated  #-}
+
+{-# BUILTIN FIXITY       Fixity #-}
+{-# BUILTIN FIXITYFIXITY fixity #-}
+
+{-# COMPILE GHC Associativity = data MAlonzo.RTE.Assoc (MAlonzo.RTE.LeftAssoc | MAlonzo.RTE.RightAssoc | MAlonzo.RTE.NonAssoc) #-}
+{-# COMPILE GHC Precedence    = data MAlonzo.RTE.Precedence (MAlonzo.RTE.Related | MAlonzo.RTE.Unrelated) #-}
+{-# COMPILE GHC Fixity        = data MAlonzo.RTE.Fixity (MAlonzo.RTE.Fixity) #-}
+
+{-# COMPILE JS Associativity  = function (x,v) { return v[x](); } #-}
+{-# COMPILE JS left-assoc     = "left-assoc"  #-}
+{-# COMPILE JS right-assoc    = "right-assoc" #-}
+{-# COMPILE JS non-assoc      = "non-assoc"   #-}
+
+{-# COMPILE JS Precedence     =
+  function (x,v) {
+    if (x === "unrelated") { return v[x](); } else { return v["related"](x); }} #-}
+{-# COMPILE JS related        = function(x) { return x; } #-}
+{-# COMPILE JS unrelated      = "unrelated"               #-}
+
+{-# COMPILE JS Fixity         = function (x,v) { return v["fixity"](x["assoc"], x["prec"]); } #-}
+{-# COMPILE JS fixity         = function (x) { return function (y) { return { "assoc": x, "prec": y}; }; } #-}
+
+primitive
+  primQNameFixity : Name → Fixity
+  primQNameToWord64s : Name → Σ Word64 (λ _ → Word64)
+
+-- Metavariables --
+
+postulate Meta : Set
+{-# BUILTIN AGDAMETA Meta #-}
+
+primitive
+  primMetaEquality : Meta → Meta → Bool
+  primMetaLess     : Meta → Meta → Bool
+  primShowMeta     : Meta → String
+  primMetaToNat    : Meta → Nat
+
+-- Arguments --
+
+-- Arguments can be (visible), {hidden}, or {{instance}}.
+data Visibility : Set where
+  visible hidden instance′ : Visibility
+
+{-# BUILTIN HIDING   Visibility #-}
+{-# BUILTIN VISIBLE  visible    #-}
+{-# BUILTIN HIDDEN   hidden     #-}
+{-# BUILTIN INSTANCE instance′  #-}
+
+-- Arguments can be relevant or irrelevant.
+data Relevance : Set where
+  relevant irrelevant : Relevance
+
+{-# BUILTIN RELEVANCE  Relevance  #-}
+{-# BUILTIN RELEVANT   relevant   #-}
+{-# BUILTIN IRRELEVANT irrelevant #-}
+
+-- Arguments also have a quantity.
+data Quantity : Set where
+  quantity-0 quantity-ω : Quantity
+
+{-# BUILTIN QUANTITY   Quantity   #-}
+{-# BUILTIN QUANTITY-0 quantity-0 #-}
+{-# BUILTIN QUANTITY-ω quantity-ω #-}
+
+-- Relevance and quantity are combined into a modality.
+data Modality : Set where
+  modality : (r : Relevance) (q : Quantity) → Modality
+
+{-# BUILTIN MODALITY             Modality #-}
+{-# BUILTIN MODALITY-CONSTRUCTOR modality #-}
+
+data ArgInfo : Set where
+  arg-info : (v : Visibility) (m : Modality) → ArgInfo
+
+data Arg {a} (A : Set a) : Set a where
+  arg : (i : ArgInfo) (x : A) → Arg A
+
+{-# BUILTIN ARGINFO    ArgInfo  #-}
+{-# BUILTIN ARGARGINFO arg-info #-}
+{-# BUILTIN ARG        Arg      #-}
+{-# BUILTIN ARGARG     arg      #-}
+
+data Blocker : Set where
+  blockerAny  : List Blocker → Blocker
+  blockerAll  : List Blocker → Blocker
+  blockerMeta : Meta → Blocker
+
+{-# BUILTIN AGDABLOCKER     Blocker #-}
+{-# BUILTIN AGDABLOCKERANY  blockerAny #-}
+{-# BUILTIN AGDABLOCKERALL  blockerAll #-}
+{-# BUILTIN AGDABLOCKERMETA blockerMeta #-}
+
+-- Name abstraction --
+
+data Abs {a} (A : Set a) : Set a where
+  abs : (s : String) (x : A) → Abs A
+
+{-# BUILTIN ABS    Abs #-}
+{-# BUILTIN ABSABS abs #-}
+
+-- Literals --
+
+data Literal : Set where
+  nat    : (n : Nat)    → Literal
+  word64 : (n : Word64) → Literal
+  float  : (x : Float)  → Literal
+  char   : (c : Char)   → Literal
+  string : (s : String) → Literal
+  name   : (x : Name)   → Literal
+  meta   : (x : Meta)   → Literal
+
+{-# BUILTIN AGDALITERAL   Literal #-}
+{-# BUILTIN AGDALITNAT    nat     #-}
+{-# BUILTIN AGDALITWORD64 word64  #-}
+{-# BUILTIN AGDALITFLOAT  float   #-}
+{-# BUILTIN AGDALITCHAR   char    #-}
+{-# BUILTIN AGDALITSTRING string  #-}
+{-# BUILTIN AGDALITQNAME  name    #-}
+{-# BUILTIN AGDALITMETA   meta    #-}
+
+
+-- Terms and patterns --
+
+data Term    : Set
+data Sort    : Set
+data Pattern : Set
+data Clause  : Set
+Type = Term
+Telescope = List (Σ String λ _ → Arg Type)
+
+data Term where
+  var       : (x : Nat) (args : List (Arg Term)) → Term
+  con       : (c : Name) (args : List (Arg Term)) → Term
+  def       : (f : Name) (args : List (Arg Term)) → Term
+  lam       : (v : Visibility) (t : Abs Term) → Term
+  pat-lam   : (cs : List Clause) (args : List (Arg Term)) → Term
+  pi        : (a : Arg Type) (b : Abs Type) → Term
+  agda-sort : (s : Sort) → Term
+  lit       : (l : Literal) → Term
+  meta      : (x : Meta) → List (Arg Term) → Term
+  unknown   : Term
+
+data Sort where
+  set     : (t : Term) → Sort
+  lit     : (n : Nat) → Sort
+  prop    : (t : Term) → Sort
+  propLit : (n : Nat) → Sort
+  inf     : (n : Nat) → Sort
+  unknown : Sort
+
+data Pattern where
+  con    : (c : Name) (ps : List (Arg Pattern)) → Pattern
+  dot    : (t : Term)    → Pattern
+  var    : (x : Nat)     → Pattern
+  lit    : (l : Literal) → Pattern
+  proj   : (f : Name)    → Pattern
+  absurd : (x : Nat)     → Pattern  -- absurd patterns counts as variables
+
+data Clause where
+  clause        : (tel : Telescope) (ps : List (Arg Pattern)) (t : Term) → Clause
+  absurd-clause : (tel : Telescope) (ps : List (Arg Pattern)) → Clause
+
+{-# BUILTIN AGDATERM      Term    #-}
+{-# BUILTIN AGDASORT      Sort    #-}
+{-# BUILTIN AGDAPATTERN   Pattern #-}
+{-# BUILTIN AGDACLAUSE    Clause  #-}
+
+{-# BUILTIN AGDATERMVAR         var       #-}
+{-# BUILTIN AGDATERMCON         con       #-}
+{-# BUILTIN AGDATERMDEF         def       #-}
+{-# BUILTIN AGDATERMMETA        meta      #-}
+{-# BUILTIN AGDATERMLAM         lam       #-}
+{-# BUILTIN AGDATERMEXTLAM      pat-lam   #-}
+{-# BUILTIN AGDATERMPI          pi        #-}
+{-# BUILTIN AGDATERMSORT        agda-sort #-}
+{-# BUILTIN AGDATERMLIT         lit       #-}
+{-# BUILTIN AGDATERMUNSUPPORTED unknown   #-}
+
+{-# BUILTIN AGDASORTSET         set     #-}
+{-# BUILTIN AGDASORTLIT         lit     #-}
+{-# BUILTIN AGDASORTPROP        prop    #-}
+{-# BUILTIN AGDASORTPROPLIT     propLit #-}
+{-# BUILTIN AGDASORTINF         inf     #-}
+{-# BUILTIN AGDASORTUNSUPPORTED unknown #-}
+
+{-# BUILTIN AGDAPATCON    con     #-}
+{-# BUILTIN AGDAPATDOT    dot     #-}
+{-# BUILTIN AGDAPATVAR    var     #-}
+{-# BUILTIN AGDAPATLIT    lit     #-}
+{-# BUILTIN AGDAPATPROJ   proj    #-}
+{-# BUILTIN AGDAPATABSURD absurd  #-}
+
+{-# BUILTIN AGDACLAUSECLAUSE clause        #-}
+{-# BUILTIN AGDACLAUSEABSURD absurd-clause #-}
+
+-- Definitions --
+
+data Definition : Set where
+  function    : (cs : List Clause) → Definition
+  data-type   : (pars : Nat) (cs : List Name) → Definition
+  record-type : (c : Name) (fs : List (Arg Name)) → Definition
+  data-cons   : (d : Name) → Definition
+  axiom       : Definition
+  prim-fun    : Definition
+
+{-# BUILTIN AGDADEFINITION                Definition  #-}
+{-# BUILTIN AGDADEFINITIONFUNDEF          function    #-}
+{-# BUILTIN AGDADEFINITIONDATADEF         data-type   #-}
+{-# BUILTIN AGDADEFINITIONRECORDDEF       record-type #-}
+{-# BUILTIN AGDADEFINITIONDATACONSTRUCTOR data-cons   #-}
+{-# BUILTIN AGDADEFINITIONPOSTULATE       axiom       #-}
+{-# BUILTIN AGDADEFINITIONPRIMITIVE       prim-fun    #-}
+
+-- Errors --
+
+data ErrorPart : Set where
+  strErr  : String → ErrorPart
+  termErr : Term → ErrorPart
+  pattErr : Pattern → ErrorPart
+  nameErr : Name → ErrorPart
+
+{-# BUILTIN AGDAERRORPART       ErrorPart #-}
+{-# BUILTIN AGDAERRORPARTSTRING strErr    #-}
+{-# BUILTIN AGDAERRORPARTTERM   termErr   #-}
+{-# BUILTIN AGDAERRORPARTPATT   pattErr   #-}
+{-# BUILTIN AGDAERRORPARTNAME   nameErr   #-}
+
+-- TC monad --
+
+postulate
+  TC               : ∀ {a} → Set a → Set a
+  returnTC         : ∀ {a} {A : Set a} → A → TC A
+  bindTC           : ∀ {a b} {A : Set a} {B : Set b} → TC A → (A → TC B) → TC B
+  unify            : Term → Term → TC ⊤
+  typeError        : ∀ {a} {A : Set a} → List ErrorPart → TC A
+  inferType        : Term → TC Type
+  checkType        : Term → Type → TC Term
+  normalise        : Term → TC Term
+  reduce           : Term → TC Term
+  catchTC          : ∀ {a} {A : Set a} → TC A → TC A → TC A
+  quoteTC          : ∀ {a} {A : Set a} → A → TC Term
+  unquoteTC        : ∀ {a} {A : Set a} → Term → TC A
+  quoteωTC         : ∀ {A : Setω} → A → TC Term
+  getContext       : TC Telescope
+  extendContext    : ∀ {a} {A : Set a} → String → Arg Type → TC A → TC A
+  inContext        : ∀ {a} {A : Set a} → Telescope → TC A → TC A
+  freshName        : String → TC Name
+  declareDef       : Arg Name → Type → TC ⊤
+  declarePostulate : Arg Name → Type → TC ⊤
+  declareData      : Name → Nat → Type → TC ⊤
+  defineData       : Name → List (Σ Name (λ _ → Type)) → TC ⊤
+  defineFun        : Name → List Clause → TC ⊤
+  getType          : Name → TC Type
+  getDefinition    : Name → TC Definition
+  blockTC          : ∀ {a} {A : Set a} → Blocker → TC A
+  commitTC         : TC ⊤
+  isMacro          : Name → TC Bool
+  pragmaForeign    : String → String → TC ⊤
+  pragmaCompile    : String → Name → String → TC ⊤
+
+  -- If 'true', makes the following primitives also normalise
+  -- their results: inferType, checkType, quoteTC, getType, and getContext
+  withNormalisation : ∀ {a} {A : Set a} → Bool → TC A → TC A
+  askNormalisation  : TC Bool
+
+  -- If 'true', makes the following primitives to reconstruct hidden arguments:
+  -- getDefinition, normalise, reduce, inferType, checkType and getContext
+  withReconstructed : ∀ {a} {A : Set a} → Bool → TC A → TC A
+  askReconstructed  : TC Bool
+
+  -- Whether implicit arguments at the end should be turned into metavariables
+  withExpandLast : ∀ {a} {A : Set a} → Bool → TC A → TC A
+  askExpandLast  : TC Bool
+
+  -- White/blacklist specific definitions for reduction while executing the TC computation
+  -- 'true' for whitelist, 'false' for blacklist
+  withReduceDefs : ∀ {a} {A : Set a} → (Σ Bool λ _ → List Name) → TC A → TC A
+  askReduceDefs  : TC (Σ Bool λ _ → List Name)
+
+  formatErrorParts : List ErrorPart → TC String
+  -- Prints the third argument if the corresponding verbosity level is turned
+  -- on (with the -v flag to Agda).
+  debugPrint : String → Nat → List ErrorPart → TC ⊤
+
+  -- Fail if the given computation gives rise to new, unsolved
+  -- "blocking" constraints.
+  noConstraints : ∀ {a} {A : Set a} → TC A → TC A
+
+  -- Run the given TC action and return the first component. Resets to
+  -- the old TC state if the second component is 'false', or keep the
+  -- new TC state if it is 'true'.
+  runSpeculative : ∀ {a} {A : Set a} → TC (Σ A λ _ → Bool) → TC A
+
+  -- Get a list of all possible instance candidates for the given meta
+  -- variable (it does not have to be an instance meta).
+  getInstances : Meta → TC (List Term)
+
+{-# BUILTIN AGDATCM                           TC                         #-}
+{-# BUILTIN AGDATCMRETURN                     returnTC                   #-}
+{-# BUILTIN AGDATCMBIND                       bindTC                     #-}
+{-# BUILTIN AGDATCMUNIFY                      unify                      #-}
+{-# BUILTIN AGDATCMTYPEERROR                  typeError                  #-}
+{-# BUILTIN AGDATCMINFERTYPE                  inferType                  #-}
+{-# BUILTIN AGDATCMCHECKTYPE                  checkType                  #-}
+{-# BUILTIN AGDATCMNORMALISE                  normalise                  #-}
+{-# BUILTIN AGDATCMREDUCE                     reduce                     #-}
+{-# BUILTIN AGDATCMCATCHERROR                 catchTC                    #-}
+{-# BUILTIN AGDATCMQUOTETERM                  quoteTC                    #-}
+{-# BUILTIN AGDATCMUNQUOTETERM                unquoteTC                  #-}
+{-# BUILTIN AGDATCMQUOTEOMEGATERM             quoteωTC                   #-}
+{-# BUILTIN AGDATCMGETCONTEXT                 getContext                 #-}
+{-# BUILTIN AGDATCMEXTENDCONTEXT              extendContext              #-}
+{-# BUILTIN AGDATCMINCONTEXT                  inContext                  #-}
+{-# BUILTIN AGDATCMFRESHNAME                  freshName                  #-}
+{-# BUILTIN AGDATCMDECLAREDEF                 declareDef                 #-}
+{-# BUILTIN AGDATCMDECLAREPOSTULATE           declarePostulate           #-}
+{-# BUILTIN AGDATCMDECLAREDATA                declareData                #-}
+{-# BUILTIN AGDATCMDEFINEDATA                 defineData                 #-}
+{-# BUILTIN AGDATCMDEFINEFUN                  defineFun                  #-}
+{-# BUILTIN AGDATCMGETTYPE                    getType                    #-}
+{-# BUILTIN AGDATCMGETDEFINITION              getDefinition              #-}
+{-# BUILTIN AGDATCMBLOCK                      blockTC                    #-}
+{-# BUILTIN AGDATCMCOMMIT                     commitTC                   #-}
+{-# BUILTIN AGDATCMISMACRO                    isMacro                    #-}
+{-# BUILTIN AGDATCMPRAGMAFOREIGN              pragmaForeign              #-}
+{-# BUILTIN AGDATCMPRAGMACOMPILE              pragmaCompile              #-}
+{-# BUILTIN AGDATCMWITHNORMALISATION          withNormalisation          #-}
+{-# BUILTIN AGDATCMWITHRECONSTRUCTED          withReconstructed          #-}
+{-# BUILTIN AGDATCMWITHEXPANDLAST             withExpandLast             #-}
+{-# BUILTIN AGDATCMWITHREDUCEDEFS             withReduceDefs             #-}
+{-# BUILTIN AGDATCMASKNORMALISATION           askNormalisation           #-}
+{-# BUILTIN AGDATCMASKRECONSTRUCTED           askReconstructed           #-}
+{-# BUILTIN AGDATCMASKEXPANDLAST              askExpandLast              #-}
+{-# BUILTIN AGDATCMASKREDUCEDEFS              askReduceDefs              #-}
+{-# BUILTIN AGDATCMFORMATERRORPARTS           formatErrorParts           #-}
+{-# BUILTIN AGDATCMDEBUGPRINT                 debugPrint                 #-}
+{-# BUILTIN AGDATCMNOCONSTRAINTS              noConstraints              #-}
+{-# BUILTIN AGDATCMRUNSPECULATIVE             runSpeculative             #-}
+{-# BUILTIN AGDATCMGETINSTANCES               getInstances               #-}
+
+-- All the TC primitives are compiled to functions that return
+-- undefined, rather than just undefined, in an attempt to make sure
+-- that code will run properly.
+{-# COMPILE JS returnTC          = _ => _ => _ =>      undefined #-}
+{-# COMPILE JS bindTC            = _ => _ => _ => _ =>
+                                   _ => _ =>           undefined #-}
+{-# COMPILE JS unify             = _ => _ =>           undefined #-}
+{-# COMPILE JS typeError         = _ => _ => _ =>      undefined #-}
+{-# COMPILE JS inferType         = _ =>                undefined #-}
+{-# COMPILE JS checkType         = _ => _ =>           undefined #-}
+{-# COMPILE JS normalise         = _ =>                undefined #-}
+{-# COMPILE JS reduce            = _ =>                undefined #-}
+{-# COMPILE JS catchTC           = _ => _ => _ => _ => undefined #-}
+{-# COMPILE JS quoteTC           = _ => _ => _ =>      undefined #-}
+{-# COMPILE JS unquoteTC         = _ => _ => _ =>      undefined #-}
+{-# COMPILE JS quoteωTC          = _ => _ =>           undefined #-}
+{-# COMPILE JS getContext        =                     undefined #-}
+{-# COMPILE JS extendContext     = _ => _ => _ => _ => _ => undefined #-}
+{-# COMPILE JS inContext         = _ => _ => _ => _ => undefined #-}
+{-# COMPILE JS freshName         = _ =>                undefined #-}
+{-# COMPILE JS declareDef        = _ => _ =>           undefined #-}
+{-# COMPILE JS declarePostulate  = _ => _ =>           undefined #-}
+{-# COMPILE JS declareData       = _ => _ => _ =>      undefined #-}
+{-# COMPILE JS defineData        = _ => _ =>           undefined #-}
+{-# COMPILE JS defineFun         = _ => _ =>           undefined #-}
+{-# COMPILE JS getType           = _ =>                undefined #-}
+{-# COMPILE JS getDefinition     = _ =>                undefined #-}
+{-# COMPILE JS blockTC           = _ => _ =>           undefined #-}
+{-# COMPILE JS commitTC          =                     undefined #-}
+{-# COMPILE JS isMacro           = _ =>                undefined #-}
+{-# COMPILE JS pragmaForeign     = _ => _ =>           undefined #-}
+{-# COMPILE JS pragmaCompile     = _ => _ => _ =>      undefined #-}
+{-# COMPILE JS withNormalisation = _ => _ => _ => _ => undefined #-}
+{-# COMPILE JS withReconstructed = _ => _ => _ => _ => undefined #-}
+{-# COMPILE JS withExpandLast    = _ => _ => _ => _ => undefined #-}
+{-# COMPILE JS withReduceDefs    = _ => _ => _ => _ => undefined #-}
+{-# COMPILE JS askNormalisation  =                     undefined #-}
+{-# COMPILE JS askReconstructed  =                     undefined #-}
+{-# COMPILE JS askExpandLast     =                     undefined #-}
+{-# COMPILE JS askReduceDefs     =                     undefined #-}
+{-# COMPILE JS debugPrint        = _ => _ => _ =>      undefined #-}
+{-# COMPILE JS noConstraints     = _ => _ => _ =>      undefined #-}
+{-# COMPILE JS runSpeculative    = _ => _ => _ =>      undefined #-}
+{-# COMPILE JS getInstances      = _ =>                undefined #-}
+
+private
+  filter : (Name → Bool) → List Name → List Name
+  filter p [] = []
+  filter p (x ∷ xs) with p x
+  ... | true  = x ∷ filter p xs
+  ... | false = filter p xs
+
+  _∈_ : Name → List Name → Bool
+  n ∈ []      = false
+  n ∈ (n' ∷ l) with primQNameEquality n n'
+  ... | true  = true
+  ... | false = n ∈ l
+
+  _∉_ : Name → List Name → Bool
+  n ∉ l with n ∈ l
+  ... | true  = false
+  ... | false = true
+
+  _++_ : List Name → List Name → List Name
+  [] ++ l       = l
+  (x ∷ xs) ++ l = x ∷ (xs ++ l)
+
+  combineReduceDefs : (Σ Bool λ _ → List Name) → (Σ Bool λ _ → List Name) → (Σ Bool λ _ → List Name)
+  combineReduceDefs (true  , defs₁) (true  , defs₂) = (true  , filter (_∈ defs₁) defs₂)
+  combineReduceDefs (false , defs₁) (true  , defs₂) = (true  , filter (_∉ defs₁) defs₂)
+  combineReduceDefs (true  , defs₁) (false , defs₂) = (true  , filter (_∉ defs₂) defs₁)
+  combineReduceDefs (false , defs₁) (false , defs₂) = (false , defs₁ ++ defs₂)
+
+onlyReduceDefs dontReduceDefs : ∀ {a} {A : Set a} → List Name → TC A → TC A
+onlyReduceDefs defs x = bindTC askReduceDefs (λ exDefs → withReduceDefs (combineReduceDefs (true  , defs) exDefs) x)
+dontReduceDefs defs x = bindTC askReduceDefs (λ exDefs → withReduceDefs (combineReduceDefs (false , defs) exDefs) x)
+
+blockOnMeta   : ∀ {a} {A : Set a} → Meta → TC A
+blockOnMeta m = blockTC (blockerMeta m)
+
+{-# WARNING_ON_USAGE onlyReduceDefs "DEPRECATED: Use `withReduceDefs` instead of `onlyReduceDefs`" #-}
+{-# WARNING_ON_USAGE dontReduceDefs "DEPRECATED: Use `withReduceDefs` instead of `dontReduceDefs`" #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Sigma.html b/test/Agda.Builtin.Sigma.html new file mode 100644 index 00000000..1aa3a993 --- /dev/null +++ b/test/Agda.Builtin.Sigma.html @@ -0,0 +1,19 @@ + +Agda.Builtin.Sigma
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Sigma where
+
+open import Agda.Primitive
+
+record Σ {a b} (A : Set a) (B : A → Set b) : Set (a ⊔ b) where
+  constructor _,_
+  field
+    fst : A
+    snd : B fst
+
+open Σ public
+
+infixr 4 _,_
+
+{-# BUILTIN SIGMA Σ #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Size.html b/test/Agda.Builtin.Size.html new file mode 100644 index 00000000..bcddc47c --- /dev/null +++ b/test/Agda.Builtin.Size.html @@ -0,0 +1,23 @@ + +Agda.Builtin.Size
{-# OPTIONS --cubical-compatible --no-universe-polymorphism --sized-types
+            --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Size where
+
+{-# BUILTIN SIZEUNIV SizeUniv #-}
+{-# BUILTIN SIZE     Size     #-}
+{-# BUILTIN SIZELT   Size<_   #-}
+{-# BUILTIN SIZESUC  ↑_       #-}
+{-# BUILTIN SIZEINF  ∞        #-}
+{-# BUILTIN SIZEMAX  _⊔ˢ_     #-}
+
+{-# FOREIGN GHC
+  type SizeLT i = ()
+  #-}
+
+{-# COMPILE GHC Size   = type ()     #-}
+{-# COMPILE GHC Size<_ = type SizeLT #-}
+{-# COMPILE GHC ↑_     = \_ -> ()    #-}
+{-# COMPILE GHC ∞      = ()          #-}
+{-# COMPILE GHC _⊔ˢ_   = \_ _ -> ()  #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Strict.html b/test/Agda.Builtin.Strict.html new file mode 100644 index 00000000..7b38c5c8 --- /dev/null +++ b/test/Agda.Builtin.Strict.html @@ -0,0 +1,11 @@ + +Agda.Builtin.Strict
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Strict where
+
+open import Agda.Builtin.Equality
+
+primitive
+  primForce      : ∀ {a b} {A : Set a} {B : A → Set b} (x : A) → (∀ x → B x) → B x
+  primForceLemma : ∀ {a b} {A : Set a} {B : A → Set b} (x : A) (f : ∀ x → B x) → primForce x f ≡ f x
+
\ No newline at end of file diff --git a/test/Agda.Builtin.String.html b/test/Agda.Builtin.String.html new file mode 100644 index 00000000..217bfdd4 --- /dev/null +++ b/test/Agda.Builtin.String.html @@ -0,0 +1,38 @@ + +Agda.Builtin.String
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.String where
+
+open import Agda.Builtin.Bool
+open import Agda.Builtin.Char
+open import Agda.Builtin.List
+open import Agda.Builtin.Maybe
+open import Agda.Builtin.Nat using (Nat)
+open import Agda.Builtin.Sigma
+
+postulate String : Set
+{-# BUILTIN STRING String #-}
+
+primitive
+  primStringUncons   : String → Maybe (Σ Char (λ _ → String))
+  primStringToList   : String → List Char
+  primStringFromList : List Char → String
+  primStringAppend   : String → String → String
+  primStringEquality : String → String → Bool
+  primShowChar       : Char → String
+  primShowString     : String → String
+  primShowNat        : Nat → String
+
+{-# COMPILE JS primStringUncons = function(x) {
+   if (x === "") { return z_jAgda_Agda_Builtin_Maybe["Maybe"]["nothing"]; };
+   return z_jAgda_Agda_Builtin_Maybe["Maybe"]["just"](z_jAgda_Agda_Builtin_Sigma["_,_"](x.charAt(0))(x.slice(1)));
+   }
+ #-}
+{-# COMPILE JS primStringToList = function(x) { return x.split(""); } #-}
+{-# COMPILE JS primStringFromList = function(x) { return x.join(""); } #-}
+{-# COMPILE JS primStringAppend = function(x) { return function(y) { return x+y; }; } #-}
+{-# COMPILE JS primStringEquality = function(x) { return function(y) { return x===y; }; } #-}
+{-# COMPILE JS primShowChar = function(x) { return JSON.stringify(x); } #-}
+{-# COMPILE JS primShowString = function(x) { return JSON.stringify(x); } #-}
+{-# COMPILE JS primShowNat = function(x) { return JSON.stringify(x); } #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.TrustMe.html b/test/Agda.Builtin.TrustMe.html new file mode 100644 index 00000000..83786701 --- /dev/null +++ b/test/Agda.Builtin.TrustMe.html @@ -0,0 +1,17 @@ + +Agda.Builtin.TrustMe
{-# OPTIONS --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.TrustMe where
+
+open import Agda.Builtin.Equality
+open import Agda.Builtin.Equality.Erase
+
+private
+  postulate
+    unsafePrimTrustMe : ∀ {a} {A : Set a} {x y : A} → x ≡ y
+
+primTrustMe : ∀ {a} {A : Set a} {x y : A} → x ≡ y
+primTrustMe = primEraseEquality unsafePrimTrustMe
+
+{-# DISPLAY primEraseEquality unsafePrimTrustMe = primTrustMe #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Unit.html b/test/Agda.Builtin.Unit.html new file mode 100644 index 00000000..ef3fcda6 --- /dev/null +++ b/test/Agda.Builtin.Unit.html @@ -0,0 +1,12 @@ + +Agda.Builtin.Unit
{-# OPTIONS --cubical-compatible --safe --no-universe-polymorphism
+            --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Unit where
+
+record ⊤ : Set where
+  instance constructor tt
+
+{-# BUILTIN UNIT ⊤ #-}
+{-# COMPILE GHC ⊤ = data () (()) #-}
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Word.Properties.html b/test/Agda.Builtin.Word.Properties.html new file mode 100644 index 00000000..e5655ddd --- /dev/null +++ b/test/Agda.Builtin.Word.Properties.html @@ -0,0 +1,12 @@ + +Agda.Builtin.Word.Properties
{-# OPTIONS --cubical-compatible --safe --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Word.Properties where
+
+open import Agda.Builtin.Word
+open import Agda.Builtin.Equality
+
+primitive
+
+  primWord64ToNatInjective : ∀ a b → primWord64ToNat a ≡ primWord64ToNat b → a ≡ b
+
\ No newline at end of file diff --git a/test/Agda.Builtin.Word.html b/test/Agda.Builtin.Word.html new file mode 100644 index 00000000..5267ee5b --- /dev/null +++ b/test/Agda.Builtin.Word.html @@ -0,0 +1,15 @@ + +Agda.Builtin.Word
{-# OPTIONS --cubical-compatible --safe --no-universe-polymorphism
+            --no-sized-types --no-guardedness --level-universe #-}
+
+module Agda.Builtin.Word where
+
+open import Agda.Builtin.Nat
+
+postulate Word64 : Set
+{-# BUILTIN WORD64 Word64 #-}
+
+primitive
+  primWord64ToNat   : Word64 → Nat
+  primWord64FromNat : Nat → Word64
+
\ No newline at end of file diff --git a/test/Agda.Primitive.Cubical.html b/test/Agda.Primitive.Cubical.html new file mode 100644 index 00000000..37969eac --- /dev/null +++ b/test/Agda.Primitive.Cubical.html @@ -0,0 +1,80 @@ + +Agda.Primitive.Cubical
{-# OPTIONS --erased-cubical #-}
+
+module Agda.Primitive.Cubical where
+
+{-# BUILTIN CUBEINTERVALUNIV IUniv #-}  -- IUniv : SSet₁
+{-# BUILTIN INTERVAL I  #-}  -- I : IUniv
+
+{-# BUILTIN IZERO    i0 #-}
+{-# BUILTIN IONE     i1 #-}
+
+-- I is treated as the type of booleans.
+{-# COMPILE JS i0 = false #-}
+{-# COMPILE JS i1 = true  #-}
+
+infix  30 primINeg
+infixr 20 primIMin primIMax
+
+primitive
+    primIMin : I → I → I
+    primIMax : I → I → I
+    primINeg : I → I
+
+{-# BUILTIN ISONE    IsOne    #-}  -- IsOne : I → Setω
+
+postulate
+  itIsOne : IsOne i1
+  IsOne1  : ∀ i j → IsOne i → IsOne (primIMax i j)
+  IsOne2  : ∀ i j → IsOne j → IsOne (primIMax i j)
+
+{-# BUILTIN ITISONE  itIsOne  #-}
+{-# BUILTIN ISONE1   IsOne1   #-}
+{-# BUILTIN ISONE2   IsOne2   #-}
+
+-- IsOne i is treated as the unit type.
+{-# COMPILE JS itIsOne = { "tt" : a => a["tt"]() } #-}
+{-# COMPILE JS IsOne1 =
+  _ => _ => _ => { return { "tt" : a => a["tt"]() } }
+  #-}
+{-# COMPILE JS IsOne2 =
+  _ => _ => _ => { return { "tt" : a => a["tt"]() } }
+  #-}
+
+-- Partial : ∀{ℓ} (i : I) (A : Set ℓ) → Set ℓ
+-- Partial i A = IsOne i → A
+
+{-# BUILTIN PARTIAL  Partial  #-}
+{-# BUILTIN PARTIALP PartialP #-}
+
+postulate
+  isOneEmpty : ∀ {ℓ} {A : Partial i0 (Set ℓ)} → PartialP i0 A
+
+{-# BUILTIN ISONEEMPTY isOneEmpty #-}
+
+-- Partial i A and PartialP i A are treated as IsOne i → A.
+{-# COMPILE JS isOneEmpty =
+  _ => x => _ => x({ "tt" : a => a["tt"]() })
+  #-}
+
+primitive
+  primPOr : ∀ {ℓ} (i j : I) {A : Partial (primIMax i j) (Set ℓ)}
+            → (u : PartialP i (λ z → A (IsOne1 i j z)))
+            → (v : PartialP j (λ z → A (IsOne2 i j z)))
+            → PartialP (primIMax i j) A
+
+  -- Computes in terms of primHComp and primTransp
+  primComp : ∀ {ℓ} (A : (i : I) → Set (ℓ i)) {φ : I} (u : ∀ i → Partial φ (A i)) (a : A i0) → A i1
+
+syntax primPOr p q u t = [ p ↦ u , q ↦ t ]
+
+primitive
+  primTransp : ∀ {ℓ} (A : (i : I) → Set (ℓ i)) (φ : I) (a : A i0) → A i1
+  primHComp  : ∀ {ℓ} {A : Set ℓ} {φ : I} (u : ∀ i → Partial φ A) (a : A) → A
+
+
+postulate
+  PathP : ∀ {ℓ} (A : I → Set ℓ) → A i0 → A i1 → Set ℓ
+
+{-# BUILTIN PATHP        PathP     #-}
+
\ No newline at end of file diff --git a/test/Agda.Primitive.html b/test/Agda.Primitive.html new file mode 100644 index 00000000..3f6bab08 --- /dev/null +++ b/test/Agda.Primitive.html @@ -0,0 +1,43 @@ + +Agda.Primitive
-- The Agda primitives (preloaded).
+
+{-# OPTIONS --cubical-compatible --no-import-sorts --level-universe #-}
+
+module Agda.Primitive where
+
+------------------------------------------------------------------------
+-- Universe levels
+------------------------------------------------------------------------
+
+infixl 6 _⊔_
+
+{-# BUILTIN PROP           Prop      #-}
+{-# BUILTIN TYPE           Set       #-}
+{-# BUILTIN STRICTSET      SSet      #-}
+
+{-# BUILTIN PROPOMEGA      Propω     #-}
+{-# BUILTIN SETOMEGA       Setω      #-}
+{-# BUILTIN STRICTSETOMEGA SSetω     #-}
+
+{-# BUILTIN LEVELUNIV      LevelUniv #-}
+
+-- Level is the first thing we need to define.
+-- The other postulates can only be checked if built-in Level is known.
+
+postulate
+  Level : LevelUniv
+
+-- MAlonzo compiles Level to (). This should be safe, because it is
+-- not possible to pattern match on levels.
+
+{-# BUILTIN LEVEL Level #-}
+
+postulate
+  lzero : Level
+  lsuc  : (ℓ : Level) → Level
+  _⊔_   : (ℓ₁ ℓ₂ : Level) → Level
+
+{-# BUILTIN LEVELZERO lzero #-}
+{-# BUILTIN LEVELSUC  lsuc  #-}
+{-# BUILTIN LEVELMAX  _⊔_   #-}
+
\ No newline at end of file diff --git a/test/Agda.css b/test/Agda.css new file mode 100644 index 00000000..9dc0f19e --- /dev/null +++ b/test/Agda.css @@ -0,0 +1,61 @@ +/* Aspects. */ +.Agda .Comment { color: #B22222 } +.Agda .Background {} +.Agda .Markup { color: #000000 } +.Agda .Keyword { color: #CD6600 } +.Agda .String { color: #B22222 } +.Agda .Number { color: #A020F0 } +.Agda .Symbol { color: #404040 } +.Agda .PrimitiveType { color: #0000CD } +.Agda .Pragma { color: black } +.Agda .Operator {} +.Agda .Hole { background: #B4EEB4 } + +/* NameKinds. */ +.Agda .Bound { color: black } +.Agda .Generalizable { color: black } +.Agda .InductiveConstructor { color: #008B00 } +.Agda .CoinductiveConstructor { color: #8B7500 } +.Agda .Datatype { color: #0000CD } +.Agda .Field { color: #EE1289 } +.Agda .Function { color: #0000CD } +.Agda .Module { color: #A020F0 } +.Agda .Postulate { color: #0000CD } +.Agda .Primitive { color: #0000CD } +.Agda .Record { color: #0000CD } + +/* OtherAspects. */ +.Agda .DottedPattern {} +.Agda .UnsolvedMeta { color: black; background: yellow } +.Agda .UnsolvedConstraint { color: black; background: yellow } +.Agda .TerminationProblem { color: black; background: #FFA07A } +.Agda .IncompletePattern { color: black; background: #F5DEB3 } +.Agda .Error { color: red; text-decoration: underline } +.Agda .TypeChecks { color: black; background: #ADD8E6 } +.Agda .Deadcode { color: black; background: #808080 } +.Agda .ShadowingInTelescope { color: black; background: #808080 } + +/* Standard attributes. */ +.Agda a { text-decoration: none } +.Agda a[href]:hover { background-color: #B4EEB4 } +.Agda [href].hover-highlight { background-color: #B4EEB4; } + +/* Translation code panes. */ +.split { + height: 100%; + width: 50%; + position: fixed; + z-index: 1; + overflow-block: auto; + box-sizing: border-box; + padding-left: 20px; + padding-right: 20px; +} + +embed { + height: 100%; + width: 100%; +} + +.left { left: 0 } +.right { right: 0; border-left: 2px solid black } diff --git a/test/AllCubicalTests.html b/test/AllCubicalTests.html new file mode 100644 index 00000000..d8806f01 --- /dev/null +++ b/test/AllCubicalTests.html @@ -0,0 +1,9 @@ + +AllCubicalTests
module AllCubicalTests where
+
+import Cubical.StreamFusion
+
+{-# FOREIGN AGDA2HS
+import Cubical.StreamFusion
+#-}
+
\ No newline at end of file diff --git a/test/AllFailTests.html b/test/AllFailTests.html new file mode 100644 index 00000000..31a28ffb --- /dev/null +++ b/test/AllFailTests.html @@ -0,0 +1,43 @@ + +AllFailTests
{-# OPTIONS --guardedness #-}
+module AllFailTests where
+
+import Fail.ClashingImport
+import Fail.Issue142
+import Fail.MatchOnDelay
+import Fail.NewTypeRecordTwoFields
+import Fail.Issue150
+import Fail.NonCopatternInstance
+import Fail.Issue113a
+import Fail.NonStarRecordIndex
+import Fail.ErasedRecordParameter
+import Fail.Issue146
+import Fail.PartialCase
+import Fail.Issue169-record
+import Fail.Issue113b
+import Fail.Fixities
+import Fail.PartialIf
+import Fail.Inline2
+import Fail.Issue71
+import Fail.Issue223
+import Fail.NewTypeTwoConstructors
+import Fail.MultiArgumentPatternLambda
+import Fail.Inline
+import Fail.ExplicitInstance2
+import Fail.QualifiedRecordProjections
+import Fail.NewTypeTwoFields
+import Fail.InvalidName
+import Fail.Issue185
+import Fail.ExplicitInstance
+import Fail.ClashingImport
+import Fail.Copatterns
+import Fail.Issue154
+import Fail.PartialCaseNoLambda
+import Fail.NonStarDatatypeIndex
+import Fail.NonCanonicalSpecialFunction
+import Fail.TypeLambda
+import Fail.NonCanonicalSuperclass
+import Fail.Issue125
+import Fail.Issue357a
+import Fail.Issue357b
+
\ No newline at end of file diff --git a/test/AllTests.html b/test/AllTests.html new file mode 100644 index 00000000..1a9eed7f --- /dev/null +++ b/test/AllTests.html @@ -0,0 +1,180 @@ + +AllTests
{-# OPTIONS --prop #-}
+module AllTests where
+
+import AllCubicalTests
+
+import Issue14
+import Issue65
+import Issue69
+import Issue73
+import Fixities
+import LanguageConstructs
+import Numbers
+import Pragmas
+import Sections
+import Test
+import Tree
+import Tuples
+import Where
+import TypeSynonyms
+import CanonicalInstance
+import Coinduction
+import ConstrainedInstance
+import Datatypes
+import Records
+import Default
+import DefaultMethods
+import Vector
+import Issue90
+import Issue93
+import QualifiedModule
+import Superclass
+import UnboxPragma
+import ScopedTypeVariables
+import LiteralPatterns
+import Issue92
+import HeightMirror
+import TransparentFun
+import Issue115
+import BangPatterns
+import Issue94
+import Issue107
+import DoNotation
+import NewTypePragma
+import Importer
+import QualifiedImports
+import CommonQualifiedImports
+import RequalifiedImports
+import QualifiedPrelude
+import AutoLambdaCaseInCase
+import AutoLambdaCaseInBind
+import WitnessedFlows
+import Kinds
+import LawfulOrd
+import Deriving
+import ErasedLocalDefinitions
+import TypeOperators
+import ErasedTypeArguments
+import TypeOperatorExport
+import TypeOperatorImport
+import IOFile
+import IOInput
+import Issue200
+import Issue169
+import Issue210
+import TypeSignature
+import ModuleParameters
+import ModuleParametersImports
+import Coerce
+import Inlining
+import EraseType
+import Issue257
+import Delay
+import Issue273
+import TypeDirected
+import ProjLike
+import Issue286
+import NonClassInstance
+import Issue218
+import Issue251
+import TypeBasedUnboxing
+import Issue145
+import Issue264
+import Issue301
+import Issue305
+import Issue302
+import Issue309
+import Issue317
+import ErasedPatternLambda
+import CustomTuples
+import ProjectionLike
+import FunCon
+
+{-# FOREIGN AGDA2HS
+import Issue14
+import Issue65
+import Issue69
+import Issue73
+import Fixities
+import LanguageConstructs
+import Numbers
+import Pragmas
+import Sections
+import Test
+import Tree
+import Tuples
+import Where
+import TypeSynonyms
+import CanonicalInstance
+import Coinduction
+import ConstrainedInstance
+import Datatypes
+import Records
+import Default
+import DefaultMethods
+import Vector
+import Issue90
+import Issue93
+import QualifiedModule
+import Superclass
+import UnboxPragma
+import ScopedTypeVariables
+import LiteralPatterns
+import Issue92
+import HeightMirror
+import TransparentFun
+import Issue115
+import BangPatterns
+import Issue94
+import DoNotation
+import NewTypePragma
+import Importer
+import QualifiedImports
+import CommonQualifiedImports
+import RequalifiedImports
+import QualifiedPrelude
+import AutoLambdaCaseInCase
+import AutoLambdaCaseInBind
+import WitnessedFlows
+import Kinds
+import LawfulOrd
+import Deriving
+import ErasedLocalDefinitions
+import TypeOperators
+import ErasedTypeArguments
+import TypeOperatorExport
+import TypeOperatorImport
+import IOFile
+import IOInput
+import Issue200
+import Issue169
+import Issue210
+import TypeSignature
+import ModuleParameters
+import ModuleParametersImports
+import Coerce
+import Inlining
+import EraseType
+import Delay
+import Issue273
+import TypeDirected
+import ProjLike
+import Issue286
+import NonClassInstance
+import Issue218
+import Issue251
+import TypeBasedUnboxing
+import Issue145
+import Issue264
+import Issue301
+import Issue305
+import Issue302
+import Issue309
+import Issue317
+import ErasedPatternLambda
+import CustomTuples
+import ProjectionLike
+import FunCon
+#-}
+
\ No newline at end of file diff --git a/test/AutoLambdaCaseInBind.html b/test/AutoLambdaCaseInBind.html new file mode 100644 index 00000000..85f19dea --- /dev/null +++ b/test/AutoLambdaCaseInBind.html @@ -0,0 +1,12 @@ + +AutoLambdaCaseInBind
open import Haskell.Prelude
+
+lcaseInsideBind : Maybe (Maybe a) → Maybe a
+lcaseInsideBind mx = do
+  x ← mx
+  let go : Maybe a → Maybe a
+      go = λ where Nothing  → Nothing
+                   (Just _) → Nothing
+  go x
+{-# COMPILE AGDA2HS lcaseInsideBind #-}
+
\ No newline at end of file diff --git a/test/AutoLambdaCaseInCase.html b/test/AutoLambdaCaseInCase.html new file mode 100644 index 00000000..2358f2cb --- /dev/null +++ b/test/AutoLambdaCaseInCase.html @@ -0,0 +1,11 @@ + +AutoLambdaCaseInCase
open import Haskell.Prelude
+
+lcaseInsideCaseOf : List a → (Maybe a → Maybe a)
+lcaseInsideCaseOf xs = case xs of λ where
+  []      → λ where Nothing → Nothing
+                    (Just _) → Nothing
+  (x ∷ _) → λ where Nothing → Nothing
+                    (Just _) → Just x
+{-# COMPILE AGDA2HS lcaseInsideCaseOf #-}
+
\ No newline at end of file diff --git a/test/BangPatterns.html b/test/BangPatterns.html new file mode 100644 index 00000000..554a13c5 --- /dev/null +++ b/test/BangPatterns.html @@ -0,0 +1,34 @@ + +BangPatterns
open import Haskell.Prelude
+open import Haskell.Prim using (ℓ)
+open import Haskell.Prim.Strict
+
+strictId : Strict a → a
+strictId (! x) = x
+
+{-# COMPILE AGDA2HS strictId #-}
+
+myFoldl : (b -> a -> b) -> b -> List a -> b
+myFoldl f x0 [] = x0
+myFoldl f x0 (x ∷ xs) = myFoldl f (f x0 x) xs
+
+{-# COMPILE AGDA2HS myFoldl #-}
+
+foldl' : (b -> a -> b) -> Strict b -> List a -> b
+foldl' f (! x0) [] = x0
+foldl' f (! x0) (x ∷ xs) = foldl' f (! f x0 x) xs
+
+{-# COMPILE AGDA2HS foldl' #-}
+
+data LazyMaybe (a : Set ℓ) : Set ℓ where
+  LazyNothing : LazyMaybe a
+  LazyJust    : a → LazyMaybe a
+
+{-# COMPILE AGDA2HS LazyMaybe #-}
+
+data StrictMaybe (a : Set ℓ) : Set ℓ where
+  StrictNothing : StrictMaybe a
+  StrictJust    : Strict a → StrictMaybe a
+
+{-# COMPILE AGDA2HS StrictMaybe #-}
+
\ No newline at end of file diff --git a/test/CanonicalInstance.html b/test/CanonicalInstance.html new file mode 100644 index 00000000..3bb45cb0 --- /dev/null +++ b/test/CanonicalInstance.html @@ -0,0 +1,23 @@ + +CanonicalInstance
{-# OPTIONS --erase-record-parameters #-}
+
+module _ where
+
+open import Haskell.Prelude
+
+record ClassA (a : Set) : Set where
+  field
+    myA : a
+
+open ClassA ⦃ ... ⦄ public
+{-# COMPILE AGDA2HS ClassA class #-}
+
+record ClassB (b : Set) : Set where
+  field
+    overlap ⦃ super ⦄ : ClassA b
+{-# COMPILE AGDA2HS ClassB class #-}
+
+myB : {{ClassB b}} → b
+myB = myA
+{-# COMPILE AGDA2HS myB #-}
+
\ No newline at end of file diff --git a/test/Coerce.html b/test/Coerce.html new file mode 100644 index 00000000..7176b54b --- /dev/null +++ b/test/Coerce.html @@ -0,0 +1,18 @@ + +Coerce
open import Haskell.Prelude
+
+data A : Set where
+  MkA : Nat → A
+
+data B : Set where
+  MkB : Nat → B
+
+postulate A≡B : A ≡ B
+
+coerceExample : B
+coerceExample = coerce A≡B (MkA 5)
+
+{-# COMPILE AGDA2HS A newtype #-}
+{-# COMPILE AGDA2HS B newtype deriving (Show) #-}
+{-# COMPILE AGDA2HS coerceExample #-}
+
\ No newline at end of file diff --git a/test/Coinduction.html b/test/Coinduction.html new file mode 100644 index 00000000..4e20c6ef --- /dev/null +++ b/test/Coinduction.html @@ -0,0 +1,19 @@ + +Coinduction
{-# OPTIONS --sized-types #-}
+
+module Coinduction where
+
+open import Haskell.Prelude
+open import Haskell.Prim.Thunk
+
+data Colist (a : Set) (@0 i : Size) : Set where
+  Nil  : Colist a i
+  Cons : a -> Thunk (Colist a) i -> Colist a i
+
+{-# COMPILE AGDA2HS Colist #-}
+
+repeater : ∀ {a i} → a → Colist a i
+repeater x = Cons x λ where .force → repeater x
+
+{-# COMPILE AGDA2HS repeater #-}
+
\ No newline at end of file diff --git a/test/CommonQualifiedImports.html b/test/CommonQualifiedImports.html new file mode 100644 index 00000000..4fcffbd4 --- /dev/null +++ b/test/CommonQualifiedImports.html @@ -0,0 +1,15 @@ + +CommonQualifiedImports
{-# FOREIGN AGDA2HS
+-- ** common qualification
+#-}
+
+import Haskell.Prelude as Common
+import Importee as Common
+  using (foo)
+import Importee as Common
+  using (anotherFoo)
+
+foos : Common.Int
+foos = Common.foo Common.+ Common.anotherFoo
+{-# COMPILE AGDA2HS foos #-}
+
\ No newline at end of file diff --git a/test/ConstrainedInstance.html b/test/ConstrainedInstance.html new file mode 100644 index 00000000..afd2dc41 --- /dev/null +++ b/test/ConstrainedInstance.html @@ -0,0 +1,13 @@ + +ConstrainedInstance
+open import Haskell.Prelude
+
+data D (a : Set) : Set where
+  C : a → D a
+{-# COMPILE AGDA2HS D #-}
+
+instance
+  iEqD : {{Eq a}} → Eq (D a)
+  iEqD ._==_ (C x) (C y) = x == y
+{-# COMPILE AGDA2HS iEqD #-}
+
\ No newline at end of file diff --git a/test/Cubical.StreamFusion.html b/test/Cubical.StreamFusion.html new file mode 100644 index 00000000..0e5df667 --- /dev/null +++ b/test/Cubical.StreamFusion.html @@ -0,0 +1,31 @@ + +Cubical.StreamFusion
module Cubical.StreamFusion where
+
+open import Haskell.Prelude
+
+open import Agda.Primitive
+open import Agda.Primitive.Cubical
+open import Agda.Builtin.Equality
+open import Agda.Builtin.Size
+
+variable
+  @0 i : Size
+
+record Stream (a : Set) (@0 i : Size) : Set where
+  pattern; inductive; constructor _:>_
+  field
+    shead : a
+    stail : ∀ {@0 j} → Stream a j
+open Stream public
+
+{-# COMPILE AGDA2HS Stream #-}
+
+smap  : (a → b) → Stream a i → Stream b i
+smap  f (x :> xs) = (f x) :> smap f xs
+
+{-# COMPILE AGDA2HS smap #-}
+
+smap-fusion  : (f : a → b) (g : b → c) (s : Stream a i)
+             → PathP (λ _ → Stream c i) (smap {i = i} g (smap {i = i} f s)) (smap {i = i} (λ x → g (f x)) s)
+smap-fusion  f g (hd :> tl) i = (g (f hd)) :> smap-fusion f g tl i
+
\ No newline at end of file diff --git a/test/CustomTuples.html b/test/CustomTuples.html new file mode 100644 index 00000000..3c031368 --- /dev/null +++ b/test/CustomTuples.html @@ -0,0 +1,65 @@ + +CustomTuples
open import Haskell.Prelude
+
+record Σ (a : Set) (b : @0 a → Set) : Set where
+  constructor _,_
+  field
+    fst : a
+    snd : b fst
+open Σ public
+{-# COMPILE AGDA2HS Σ tuple #-}
+
+test : Σ Int (λ _ → Int) → Int
+test xy = fst xy + snd xy
+
+{-# COMPILE AGDA2HS test #-}
+
+record Stuff (a : Set) : Set where
+  no-eta-equality; pattern
+  constructor stuff
+  field
+    something : Int
+    more : a
+    another : Bool
+
+{-# COMPILE AGDA2HS Stuff unboxed-tuple #-}
+
+foo : Stuff Int → Stuff Bool → Stuff Char
+foo (stuff a b c) (stuff x y z) = stuff (a + b + x) 'x' (or (c ∷ y ∷ z ∷ []))
+
+{-# COMPILE AGDA2HS foo #-}
+
+bare : Int → Char → Bool → Stuff Char
+bare = stuff
+
+{-# COMPILE AGDA2HS bare #-}
+
+section : a → Bool → Stuff a
+section = stuff 42
+
+{-# COMPILE AGDA2HS section #-}
+
+record NoStuff : Set where
+  no-eta-equality; pattern
+  constructor dontlook
+
+{-# COMPILE AGDA2HS NoStuff tuple #-}
+
+bar : NoStuff → NoStuff
+bar dontlook = dontlook
+
+{-# COMPILE AGDA2HS bar #-}
+
+-- This is legal, basically the same as an unboxed record.
+record Legal (a : Set) : Set where
+  constructor mkLegal
+  field
+    theA : a
+
+{-# COMPILE AGDA2HS Legal tuple #-}
+
+baz : Legal Int → Legal Int
+baz (mkLegal x) = mkLegal 42
+
+{-# COMPILE AGDA2HS baz #-}
+
\ No newline at end of file diff --git a/test/Datatypes.html b/test/Datatypes.html new file mode 100644 index 00000000..b850bfcc --- /dev/null +++ b/test/Datatypes.html @@ -0,0 +1,16 @@ + +Datatypes
+open import Agda.Builtin.Bool
+
+data Test : Set where
+  CTest : Bool -> @0 {Bool} -> Test
+{-# COMPILE AGDA2HS Test #-}
+
+getTest : Test → Bool
+getTest (CTest b) = b
+{-# COMPILE AGDA2HS getTest #-}
+
+putTest : Bool → Test → Test
+putTest b (CTest _ {b'}) = CTest b {b'}
+{-# COMPILE AGDA2HS putTest #-}
+
\ No newline at end of file diff --git a/test/Default.html b/test/Default.html new file mode 100644 index 00000000..fc340d97 --- /dev/null +++ b/test/Default.html @@ -0,0 +1,18 @@ + +Default
open import Haskell.Prelude
+
+record HasDefault (a : Set) : Set where
+  field
+    theDefault : a
+open HasDefault {{...}}
+{-# COMPILE AGDA2HS HasDefault class #-}
+
+instance
+  defaultBool : HasDefault Bool
+  defaultBool .theDefault = False
+{-# COMPILE AGDA2HS defaultBool instance #-}
+
+test : Bool
+test = theDefault
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/DefaultMethods.html b/test/DefaultMethods.html new file mode 100644 index 00000000..90460de7 --- /dev/null +++ b/test/DefaultMethods.html @@ -0,0 +1,189 @@ + +DefaultMethods
{-# OPTIONS --no-auto-inline #-}
+module DefaultMethods where
+
+open import Haskell.Prim using (ltNat)
+open import Haskell.Prelude hiding
+  ( Show; Show₁; Show₂; show; showsPrec; showList; defaultShowList
+  ; Ord; _<_; _>_
+  )
+
+{-# FOREIGN AGDA2HS
+{-# LANGUAGE TypeSynonymInstances #-}
+import Prelude hiding (Show, show, showsPrec, showList, Ord, (<), (>))
+#-}
+
+-- ** Ord
+
+record Ord (a : Set) : Set where
+  field
+    _<_ _>_ : a → a → Bool
+
+record Ord₁ (a : Set) : Set where
+  field
+    _<_ : a → a → Bool
+
+  _>_ : a → a → Bool
+  x > y = y < x
+
+record Ord₂ (a : Set) : Set where
+  field
+    _>_ : a → a → Bool
+
+  _<_ : a → a → Bool
+  _<_ = flip _>_
+
+open Ord ⦃ ... ⦄
+
+{-# COMPILE AGDA2HS Ord class Ord₁ Ord₂ #-}
+
+OB : Ord₁ Bool
+OB .Ord₁._<_ False b = b
+OB .Ord₁._<_ True  _ = False
+
+instance
+  OrdBool₀ : Ord Bool
+  OrdBool₀ ._<_ = Ord₁._<_ OB
+  OrdBool₀ ._>_ = Ord₁._>_ OB
+{-# COMPILE AGDA2HS OrdBool₀ #-}
+
+data Bool1 : Set where
+  Mk1 : Bool -> Bool1
+{-# COMPILE AGDA2HS Bool1 #-}
+instance
+  OrdBool₁ : Ord Bool1
+  OrdBool₁ = record {Ord₁ ord₁}
+    where
+      ord₁ : Ord₁ Bool1
+      ord₁ .Ord₁._<_ (Mk1 False) (Mk1 b) = b
+      ord₁ .Ord₁._<_ (Mk1 True)  _       = False
+{-# COMPILE AGDA2HS OrdBool₁ #-}
+
+data Bool2 : Set where
+  Mk2 : Bool -> Bool2
+{-# COMPILE AGDA2HS Bool2 #-}
+instance
+  OrdBool₂ : Ord Bool2
+  OrdBool₂ = record {_<_ = _<:_; _>_ = flip _<:_}
+    where
+      _<:_ : Bool2 → Bool2 → Bool
+      (Mk2 False) <: (Mk2 b) = b
+      (Mk2 True)  <: _       = False
+{-# COMPILE AGDA2HS OrdBool₂ #-}
+
+data Bool3 : Set where
+  Mk3 : Bool -> Bool3
+{-# COMPILE AGDA2HS Bool3 #-}
+instance
+  OrdBool₃ : Ord Bool3
+  OrdBool₃ = record {Ord₁ (λ where .Ord₁._<_ → _<:_)}
+    where
+      _<:_ : Bool3 → Bool3 → Bool
+      (Mk3 False) <: (Mk3 b) = b
+      (Mk3 True)  <: _       = False
+{-# COMPILE AGDA2HS OrdBool₃ #-}
+
+data Bool4 : Set where
+  Mk4 : Bool -> Bool4
+{-# COMPILE AGDA2HS Bool4 #-}
+lift4 : (Bool → Bool → a) → (Bool4 → Bool4 → a)
+lift4 f (Mk4 x) (Mk4 y) = f x y
+{-# COMPILE AGDA2HS lift4 #-}
+instance
+  OrdBool₄ : Ord Bool4
+  OrdBool₄ = record {Ord₁ (λ where .Ord₁._<_ → lift4 (λ x y → not x && y))}
+{-# COMPILE AGDA2HS OrdBool₄ #-}
+
+data Bool5 : Set where
+  Mk5 : Bool -> Bool5
+{-# COMPILE AGDA2HS Bool5 #-}
+instance
+  OrdBool₅ : Ord Bool5
+  OrdBool₅ = record {Ord₂ (λ where .Ord₂._>_ → _>:_)}
+    where
+      _>:_ : Bool5 → Bool5 → Bool
+      (Mk5 False) >: _       = False
+      (Mk5 True)  >: (Mk5 b) = not b
+{-# COMPILE AGDA2HS OrdBool₅ #-}
+
+data Bool6 : Set where
+  Mk6 : Bool -> Bool6
+{-# COMPILE AGDA2HS Bool6 #-}
+instance
+  OrdBool₆ : Ord Bool6
+  OrdBool₆ = record {Ord₂ (λ where .Ord₂._>_ → _>:_); _<_ = flip _>:_}
+    where
+      _>:_ : Bool6 → Bool6 → Bool
+      (Mk6 False) >: _       = False
+      (Mk6 True)  >: (Mk6 b) = not b
+{-# COMPILE AGDA2HS OrdBool₆ #-}
+
+instance
+  Ordℕ : Ord Nat
+  Ordℕ = record {Ord₁ (λ where .Ord₁._<_ → ltNat)}
+-- {-# COMPILE AGDA2HS Ordℕ #-}
+
+defaultShowList : (a → ShowS) → List a → ShowS
+defaultShowList _     []
+  = showString "[]"
+defaultShowList shows (x ∷ xs)
+  = showString "["
+  ∘ foldl (λ s x → s ∘ showString "," ∘ shows x) (shows x) xs
+  ∘ showString "]"
+{-# COMPILE AGDA2HS defaultShowList #-}
+
+record Show (a : Set) : Set where
+  field
+    show : a → String
+    showsPrec : Int → a → ShowS
+    showList : List a → ShowS
+
+record Show₁ (a : Set) : Set where
+  field showsPrec : Int → a → ShowS
+
+  show : a → String
+  show x = showsPrec 0 x ""
+
+  showList : List a → ShowS
+  showList = defaultShowList (showsPrec 0)
+
+record Show₂ (a : Set) : Set where
+  field show : a → String
+
+  showsPrec : Int → a → ShowS
+  showsPrec _ x s = show x ++ s
+
+  showList : List a → ShowS
+  showList = defaultShowList (showsPrec 0)
+
+open Show ⦃ ... ⦄
+
+{-# COMPILE AGDA2HS Show class Show₁ Show₂ #-}
+
+SB : Show₂ Bool
+SB .Show₂.show True  = "True"
+SB .Show₂.show False = "False"
+
+instance
+  ShowBool : Show Bool
+  ShowBool .show      = Show₂.show SB
+  ShowBool .showsPrec = Show₂.showsPrec SB
+  ShowBool .showList []           = showString ""
+  ShowBool .showList (True ∷ bs)  = showString "1" ∘ showList bs
+  ShowBool .showList (False ∷ bs) = showString "0" ∘ showList bs
+{-# COMPILE AGDA2HS ShowBool #-}
+
+instance
+  ShowMaybe : ⦃ Show a ⦄ → Show (Maybe a)
+  ShowMaybe {a = a} = record {Show₁ s₁}
+    where
+      s₁ : Show₁ (Maybe a)
+      s₁ .Show₁.showsPrec n Nothing = showString "nothing"
+      s₁ .Show₁.showsPrec n (Just x) = showParen True {-(9 < n)-} (showString "just " ∘ showsPrec 10 x)
+{-# COMPILE AGDA2HS ShowMaybe #-}
+
+instance
+  ShowList : ⦃ Show a ⦄ → Show (List a)
+  ShowList = record {Show₁ (λ where .Show₁.showsPrec _ → showList)}
+{-# COMPILE AGDA2HS ShowList #-}
+
\ No newline at end of file diff --git a/test/Delay.html b/test/Delay.html new file mode 100644 index 00000000..0cef7fd7 --- /dev/null +++ b/test/Delay.html @@ -0,0 +1,25 @@ + +Delay
+module Delay where
+
+open import Haskell.Prelude
+open import Haskell.Prim.Thunk
+open import Haskell.Extra.Delay
+
+open import Agda.Builtin.Size
+
+postulate
+  div : Int → Int → Int
+  mod : Int → Int → Int
+
+even : Int → Bool
+even x = mod x 2 == 0
+
+collatz : ∀ {@0 j} → Int → Delay Int j
+collatz x = 
+  if x == 0 then now 0
+  else if even x then later (λ where .force → collatz (div x 2))
+  else later λ where .force → collatz (3 * x + 1)
+
+{-# COMPILE AGDA2HS collatz #-}
+
\ No newline at end of file diff --git a/test/Deriving.html b/test/Deriving.html new file mode 100644 index 00000000..08248dff --- /dev/null +++ b/test/Deriving.html @@ -0,0 +1,74 @@ + +Deriving
open import Haskell.Prelude
+
+data Planet : Set where
+  Mercury : Planet
+  Venus   : Planet
+  Earth   : Planet
+  Mars    : Planet
+  Jupiter : Planet
+  Saturn  : Planet
+  Uranus  : Planet
+  Neptune : Planet
+  Pluto   : Planet
+
+{-# COMPILE AGDA2HS Planet deriving ( Read ) #-}
+
+instance
+  iPlanetEq : Eq Planet
+  iPlanetEq ._==_ Mercury Mercury = True
+  iPlanetEq ._==_ Venus   Venus   = True
+  iPlanetEq ._==_ Earth   Earth   = True
+  iPlanetEq ._==_ Mars    Mars    = True
+  iPlanetEq ._==_ Jupiter Jupiter = True
+  iPlanetEq ._==_ Saturn  Saturn  = True
+  iPlanetEq ._==_ Uranus  Uranus  = True
+  iPlanetEq ._==_ Neptune Neptune = True
+  iPlanetEq ._==_ Pluto   Pluto   = True
+  iPlanetEq ._==_ _       _       = False
+
+{-# COMPILE AGDA2HS iPlanetEq derive #-}
+
+postulate instance iPlanetOrd : Ord Planet
+
+{-# COMPILE AGDA2HS iPlanetOrd #-}
+
+postulate instance iPlanetShow : Show Planet
+
+{-# COMPILE AGDA2HS iPlanetShow derive stock #-}
+
+record Clazz (a : Set) : Set where
+  field
+    foo : a → Int
+    bar : a → Bool
+
+open Clazz ⦃...⦄ public
+
+{-# COMPILE AGDA2HS Clazz class #-}
+
+postulate instance iPlanetClazz : Clazz Planet
+
+{-# COMPILE AGDA2HS iPlanetClazz derive anyclass #-}
+
+data Optional (a : Set) : Set where
+  Of    : a → Optional a
+  Empty : Optional a
+
+{-# COMPILE AGDA2HS Optional #-}
+
+postulate instance iOptionalEq : ⦃ Eq a ⦄ → Eq (Optional a)
+
+{-# COMPILE AGDA2HS iOptionalEq #-}
+
+data Duo (a b : Set) : Set where
+  MkDuo : (a × b) → Duo a b
+
+{-# COMPILE AGDA2HS Duo newtype #-}
+
+instance
+  iDuoEq : ⦃ Eq a ⦄ → ⦃ Eq b ⦄ → Eq (Duo a b)
+  iDuoEq ._==_ (MkDuo d1) (MkDuo d2) = fst d1 == fst d2 && snd d1 == snd d2
+
+{-# COMPILE AGDA2HS iDuoEq derive newtype #-}
+
+
\ No newline at end of file diff --git a/test/DoNotation.html b/test/DoNotation.html new file mode 100644 index 00000000..a1769d99 --- /dev/null +++ b/test/DoNotation.html @@ -0,0 +1,54 @@ + +DoNotation
+open import Haskell.Prelude
+
+-- Example from http://learnyouahaskell.com/a-fistful-of-monads#getting-our-feet-wet-with-maybe
+
+Birds = Int
+Pole = Birds × Birds
+
+{-# COMPILE AGDA2HS Birds #-}
+{-# COMPILE AGDA2HS Pole #-}
+
+
+landLeft : Birds → Pole → Maybe Pole
+landLeft n (left , right) =
+  if abs ((left + n) - right) < 4
+  then Just (left + n , right)
+  else Nothing
+
+{-# COMPILE AGDA2HS landLeft #-}
+
+landRight : Birds → Pole → Maybe Pole
+landRight n (left , right) =
+  if abs (left - (right + n)) < 4
+  then Just (left , right + n)
+  else Nothing
+
+{-# COMPILE AGDA2HS landRight #-}
+
+routine : Maybe Pole
+routine = do
+    start ← return (0 , 0)
+    first ← landLeft 2 start
+    second ← landRight 2 first
+    landLeft 1 second
+
+{-# COMPILE AGDA2HS routine #-}
+
+routineWithoutDo : Maybe Pole
+routineWithoutDo =
+    return (0 , 0) Dont.>>= λ start →
+    landLeft 2 start Dont.>>= λ first →
+    landRight 2 first Dont.>>= λ second →
+    landLeft 1 second
+
+{-# COMPILE AGDA2HS routineWithoutDo #-}
+
+swapPolesMaybe : Maybe Pole → Maybe Pole
+swapPolesMaybe x = do
+  (one , two) ← x
+  pure (two , one)
+
+{-# COMPILE AGDA2HS swapPolesMaybe #-}
+
\ No newline at end of file diff --git a/test/EraseType.html b/test/EraseType.html new file mode 100644 index 00000000..9e001456 --- /dev/null +++ b/test/EraseType.html @@ -0,0 +1,36 @@ + +EraseType
module EraseType where
+
+open import Haskell.Prelude
+open import Haskell.Extra.Erase
+
+testErase : Erase Int
+testErase = Erased 42
+
+{-# COMPILE AGDA2HS testErase #-}
+
+testMatch : Erase Int → Erase Int
+testMatch (Erased x) = Erased (x + 1)
+
+{-# COMPILE AGDA2HS testMatch #-}
+
+testRezz : Rezz (get testErase)
+testRezz = rezz 42
+
+{-# COMPILE AGDA2HS testRezz #-}
+
+testRezzErase : Rezz testErase
+testRezzErase = rezzErase
+
+{-# COMPILE AGDA2HS testRezzErase #-}
+
+testCong : Rezz (1 + get testErase)
+testCong = rezzCong (1 +_) testRezz
+
+{-# COMPILE AGDA2HS testCong #-}
+
+rTail : ∀ {@0 x xs} → Rezz {a = List Int} (x ∷ xs) → Rezz xs
+rTail = rezzTail
+
+{-# COMPILE AGDA2HS rTail #-}
+
\ No newline at end of file diff --git a/test/ErasedLocalDefinitions.html b/test/ErasedLocalDefinitions.html new file mode 100644 index 00000000..ed639c80 --- /dev/null +++ b/test/ErasedLocalDefinitions.html @@ -0,0 +1,15 @@ + +ErasedLocalDefinitions
-- See issue #182.
+
+open import Agda.Builtin.Bool
+open import Agda.Builtin.Equality
+
+f : (m : Bool) → Bool
+f m = g m greattruth
+  where
+  @0 greattruth : true ≡ true
+  greattruth = refl
+  g : (m : Bool) (@0 proof : true ≡ true) → Bool
+  g m _ = m
+{-# COMPILE AGDA2HS f #-}
+
\ No newline at end of file diff --git a/test/ErasedPatternLambda.html b/test/ErasedPatternLambda.html new file mode 100644 index 00000000..258dd41d --- /dev/null +++ b/test/ErasedPatternLambda.html @@ -0,0 +1,20 @@ + +ErasedPatternLambda
open import Haskell.Prelude
+
+Scope = List Bool
+
+data Telescope (@0 α : Scope) : @0 Scope → Set where
+  ExtendTel : ∀ {@0 x β} → Bool → Telescope (x ∷ α) β  → Telescope α (x ∷ β)
+{-# COMPILE AGDA2HS Telescope #-}
+
+caseTelBind : ∀ {@0 x α β} (tel : Telescope α (x ∷ β))
+            → ((a : Bool) (rest : Telescope (x ∷ α) β) → @0 tel ≡ ExtendTel a rest → d)
+            → d
+caseTelBind (ExtendTel a tel) f = f a tel refl
+
+{-# COMPILE AGDA2HS caseTelBind #-}
+
+checkSubst : ∀ {@0 x α β} (t : Telescope α (x ∷ β)) → Bool
+checkSubst t = caseTelBind t λ ty rest → λ where refl → True
+{-# COMPILE AGDA2HS checkSubst #-}
+
\ No newline at end of file diff --git a/test/ErasedTypeArguments.html b/test/ErasedTypeArguments.html new file mode 100644 index 00000000..b61c08fa --- /dev/null +++ b/test/ErasedTypeArguments.html @@ -0,0 +1,33 @@ + +ErasedTypeArguments
-- Testing whether erased value arguments in record type signatures
+-- and in lambdas do get erased.
+module ErasedTypeArguments where
+
+open import Agda.Primitive
+open import Agda.Builtin.Unit
+open import Agda.Builtin.Nat
+
+-- A record type which has both members compiled,
+-- but the argument of the lambda is erased;
+-- so that it won't be dependent-typed after compilation.
+record Σ' {i j} (a : Set i) (b : @0 a -> Set j) : Set (i ⊔ j) where
+  constructor _:^:_
+  field
+    proj₁ : a
+    proj₂ : b proj₁
+open Σ' public
+infixr 4 _:^:_
+{-# COMPILE AGDA2HS Σ' #-}
+
+-- Now test lambdas.
+-- Actually, Agda can deduce here that n is erased; probably from the type signature of Σ'.
+test : Nat -> Σ' Nat (λ (n : Nat) -> ⊤)
+test n = n :^: tt
+{-# COMPILE AGDA2HS test #-}
+
+-- Tests a type function that would be accepted anyway,
+-- but the argument is erased.
+data Id {i j} (@0 a : Set i) (f : @0 Set i -> Set j) : Set j where
+  MkId : f a -> Id a f
+{-# COMPILE AGDA2HS Id newtype #-}
+
\ No newline at end of file diff --git a/test/Fail.ClashingImport.html b/test/Fail.ClashingImport.html new file mode 100644 index 00000000..859a05f2 --- /dev/null +++ b/test/Fail.ClashingImport.html @@ -0,0 +1,14 @@ + +Fail.ClashingImport
module Fail.ClashingImport where
+
+open import Importee
+open import OtherImportee
+
+testFoo : Foo
+testFoo = MkFoo
+{-# COMPILE AGDA2HS testFoo #-}
+
+otherFoo : OtherFoo
+otherFoo = MkFoo
+{-# COMPILE AGDA2HS otherFoo #-}
+
\ No newline at end of file diff --git a/test/Fail.Copatterns.html b/test/Fail.Copatterns.html new file mode 100644 index 00000000..7a6af362 --- /dev/null +++ b/test/Fail.Copatterns.html @@ -0,0 +1,19 @@ + +Fail.Copatterns
-- Copatterns are not supported, except in specific cases
+
+module Fail.Copatterns where
+
+open import Haskell.Prelude
+
+record R : Set where
+  field
+    foo : Bool
+open R public
+
+{-# COMPILE AGDA2HS R #-}
+
+test : R
+test .foo = True
+
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Fail.ErasedRecordParameter.html b/test/Fail.ErasedRecordParameter.html new file mode 100644 index 00000000..096e3271 --- /dev/null +++ b/test/Fail.ErasedRecordParameter.html @@ -0,0 +1,10 @@ + +Fail.ErasedRecordParameter
-- c.f. Issue #145, this is the record variant
+module Fail.ErasedRecordParameter where
+
+record Ok (@0 a : Set) : Set where
+  constructor Thing
+  field unThing : a
+open Ok public
+{-# COMPILE AGDA2HS Ok #-}
+
\ No newline at end of file diff --git a/test/Fail.ExplicitInstance.html b/test/Fail.ExplicitInstance.html new file mode 100644 index 00000000..6b60f61d --- /dev/null +++ b/test/Fail.ExplicitInstance.html @@ -0,0 +1,24 @@ + +Fail.ExplicitInstance
+module Fail.ExplicitInstance where
+
+open import Haskell.Prelude
+
+record HasDefault (a : Set) : Set where
+  field
+    theDefault : a
+open HasDefault {{...}}
+{-# COMPILE AGDA2HS HasDefault class #-}
+
+instance
+  defaultBool : HasDefault Bool
+  defaultBool .theDefault = False
+{-# COMPILE AGDA2HS defaultBool instance #-}
+
+test : Bool
+test = theDefault {{λ where .theDefault → True}}
+{-# COMPILE AGDA2HS test #-}
+
+important-theorem : test ≡ True
+important-theorem = refl
+
\ No newline at end of file diff --git a/test/Fail.ExplicitInstance2.html b/test/Fail.ExplicitInstance2.html new file mode 100644 index 00000000..f71b5e72 --- /dev/null +++ b/test/Fail.ExplicitInstance2.html @@ -0,0 +1,17 @@ + +Fail.ExplicitInstance2
+module Fail.ExplicitInstance2 where
+
+open import Haskell.Prelude
+
+record HasDefault (a : Set) : Set where
+  field
+    theDefault : a
+open HasDefault {{...}}
+{-# COMPILE AGDA2HS HasDefault class #-}
+
+-- This should be an error even if there is no instance in scope
+test : Bool
+test = theDefault {{λ where .theDefault → True}}
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Fail.Fixities.html b/test/Fail.Fixities.html new file mode 100644 index 00000000..ec0b709d --- /dev/null +++ b/test/Fail.Fixities.html @@ -0,0 +1,11 @@ + +Fail.Fixities
module Fail.Fixities where
+
+open import Haskell.Prelude
+
+infixl 8.5 _<+>_
+_<+>_ : Int → Int → Int
+x <+> y = x
+
+{-# COMPILE AGDA2HS _<+>_ #-}
+
\ No newline at end of file diff --git a/test/Fail.Inline.html b/test/Fail.Inline.html new file mode 100644 index 00000000..3692102e --- /dev/null +++ b/test/Fail.Inline.html @@ -0,0 +1,10 @@ + +Fail.Inline
module Fail.Inline where
+
+open import Haskell.Prelude
+
+tail' : List a → List a
+tail' (x ∷ xs) = xs
+tail' [] = []
+{-# COMPILE AGDA2HS tail' inline #-}
+
\ No newline at end of file diff --git a/test/Fail.Inline2.html b/test/Fail.Inline2.html new file mode 100644 index 00000000..88d24e48 --- /dev/null +++ b/test/Fail.Inline2.html @@ -0,0 +1,9 @@ + +Fail.Inline2
module Fail.Inline2 where
+
+open import Haskell.Prelude
+
+tail' : (xs : List a) → @0 {{ NonEmpty xs }}  → List a
+tail' (x ∷ xs) = xs
+{-# COMPILE AGDA2HS tail' inline #-}
+
\ No newline at end of file diff --git a/test/Fail.InvalidName.html b/test/Fail.InvalidName.html new file mode 100644 index 00000000..43d76e66 --- /dev/null +++ b/test/Fail.InvalidName.html @@ -0,0 +1,11 @@ + +Fail.InvalidName
+module Fail.InvalidName where
+
+open import Haskell.Prelude
+
+F : Int → Int
+F x = x
+
+{-# COMPILE AGDA2HS F #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue113a.html b/test/Fail.Issue113a.html new file mode 100644 index 00000000..ea4bb0ac --- /dev/null +++ b/test/Fail.Issue113a.html @@ -0,0 +1,16 @@ + +Fail.Issue113a
{-# OPTIONS --guardedness #-}
+
+module Fail.Issue113a where
+
+record Loop : Set where
+  coinductive
+  field force : Loop
+open Loop public
+
+{-# COMPILE AGDA2HS Loop unboxed #-}
+
+loop : Loop
+loop = λ where .force → loop
+{-# COMPILE AGDA2HS loop #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue113b.html b/test/Fail.Issue113b.html new file mode 100644 index 00000000..0e8c774a --- /dev/null +++ b/test/Fail.Issue113b.html @@ -0,0 +1,18 @@ + +Fail.Issue113b
{-# OPTIONS --guardedness #-}
+
+module Fail.Issue113b where
+
+postulate A : Set
+
+record Loop : Set where
+  coinductive
+  field force : Loop
+open Loop public
+
+{-# COMPILE AGDA2HS Loop unboxed #-}
+
+loop : {@0 x : A} → Loop
+loop {x} = λ where .force → loop {x}
+{-# COMPILE AGDA2HS loop #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue125.html b/test/Fail.Issue125.html new file mode 100644 index 00000000..31c11305 --- /dev/null +++ b/test/Fail.Issue125.html @@ -0,0 +1,18 @@ + +Fail.Issue125
module Fail.Issue125 where
+
+data A (a : Set) : Set where
+  ACtr : a -> A a
+
+{-# COMPILE AGDA2HS A #-}
+
+data B : Set where
+  ACtr : B
+
+{-# COMPILE AGDA2HS B #-}
+
+data C : Set where
+  Ca : C
+
+{-# COMPILE AGDA2HS C #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue142.html b/test/Fail.Issue142.html new file mode 100644 index 00000000..4d6857ac --- /dev/null +++ b/test/Fail.Issue142.html @@ -0,0 +1,10 @@ + +Fail.Issue142
module Fail.Issue142 where
+
+open import Haskell.Prelude
+
+-- `coerce` is a primitive but this general structure remains disallowed
+falseCoerce : @0 a ≡ b → a → b
+falseCoerce refl x = x
+{-# COMPILE AGDA2HS falseCoerce #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue146.html b/test/Fail.Issue146.html new file mode 100644 index 00000000..b7cbf7fc --- /dev/null +++ b/test/Fail.Issue146.html @@ -0,0 +1,26 @@ + +Fail.Issue146
module Fail.Issue146 where
+
+open import Haskell.Prelude
+
+record Wrap (a : Set) : Set where
+  constructor MkWrap
+  field wrapped : a
+open Wrap public
+
+{-# COMPILE AGDA2HS Wrap #-}
+
+record Class (a : Set) : Set where
+  field
+    method : Wrap a → Wrap a
+open Class ⦃...⦄ public
+
+{-# COMPILE AGDA2HS Class class #-}
+
+instance
+  BoolClass : Class Bool
+  BoolClass .method (MkWrap x) .wrapped = x
+
+  {-# COMPILE AGDA2HS BoolClass #-}
+
+
\ No newline at end of file diff --git a/test/Fail.Issue150.html b/test/Fail.Issue150.html new file mode 100644 index 00000000..0d0a82cc --- /dev/null +++ b/test/Fail.Issue150.html @@ -0,0 +1,17 @@ + +Fail.Issue150
module Fail.Issue150 where
+
+open import Haskell.Prelude
+
+record Tup (a b : Set) : Set where
+  constructor MkTup
+  field exl : a ; exr : b
+open Tup public
+
+{-# COMPILE AGDA2HS Tup #-}
+
+swap : Tup a b → Tup b a
+swap = λ (MkTup x y) → MkTup y x
+
+{-# COMPILE AGDA2HS swap #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue154.html b/test/Fail.Issue154.html new file mode 100644 index 00000000..9e07e402 --- /dev/null +++ b/test/Fail.Issue154.html @@ -0,0 +1,10 @@ + +Fail.Issue154
module Fail.Issue154 where
+
+open import Haskell.Prelude
+
+foo : Nat → Nat
+foo zero = zero
+foo (suc x) = x
+{-# COMPILE AGDA2HS foo #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue169-record.html b/test/Fail.Issue169-record.html new file mode 100644 index 00000000..fad419fa --- /dev/null +++ b/test/Fail.Issue169-record.html @@ -0,0 +1,27 @@ + +Fail.Issue169-record
-- Using a default method implementation for an instance declaration currently
+-- requires a named definition or an anonymous `λ where` on the Agda side, so a
+-- record is not allowed.
+
+module Fail.Issue169-record where
+
+open import Haskell.Prelude
+
+record Identity (a : Set) : Set where
+    field
+        runIdentity : a
+open Identity public
+
+{-# COMPILE AGDA2HS Identity newtype #-}
+
+showIdentity : ⦃ Show a ⦄ → Identity a → String
+showIdentity record { runIdentity = id } = "Id < " ++ show id ++ " >"
+
+{-# COMPILE AGDA2HS showIdentity #-}
+
+instance
+  iIdentityShow : ⦃ Show a ⦄ → Show (Identity a)
+  iIdentityShow = record {Show₂ record {show = showIdentity}}
+
+{-# COMPILE AGDA2HS iIdentityShow #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue185.html b/test/Fail.Issue185.html new file mode 100644 index 00000000..b14c98a1 --- /dev/null +++ b/test/Fail.Issue185.html @@ -0,0 +1,20 @@ + +Fail.Issue185
module Fail.Issue185 where
+
+open import Agda.Builtin.Bool
+
+record RecordTest : Set where
+  constructor MkRecord
+  field
+    aBool : Bool
+
+  aBoolAsAFunction : Bool
+  aBoolAsAFunction = aBool
+open RecordTest public
+{-# COMPILE AGDA2HS RecordTest newtype #-}
+{-# COMPILE AGDA2HS aBoolAsAFunction #-}
+
+test : Bool
+test = aBoolAsAFunction (MkRecord true)
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue223.html b/test/Fail.Issue223.html new file mode 100644 index 00000000..a1ba31a3 --- /dev/null +++ b/test/Fail.Issue223.html @@ -0,0 +1,10 @@ + +Fail.Issue223
module Fail.Issue223 where
+
+data Void : Set where
+{-# COMPILE AGDA2HS Void #-}
+
+test : {a : Set} → Void → a
+test ()
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue357a.html b/test/Fail.Issue357a.html new file mode 100644 index 00000000..bbb9e2b0 --- /dev/null +++ b/test/Fail.Issue357a.html @@ -0,0 +1,14 @@ + +Fail.Issue357a
open import Haskell.Prelude
+open import Agda.Primitive
+
+module Fail.Issue357a where
+
+k : a → b → a
+k x _ = x
+{-# COMPILE AGDA2HS k #-}
+
+testK : Nat
+testK = k 42 lzero
+{-# COMPILE AGDA2HS testK #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue357b.html b/test/Fail.Issue357b.html new file mode 100644 index 00000000..eb2f817a --- /dev/null +++ b/test/Fail.Issue357b.html @@ -0,0 +1,18 @@ + +Fail.Issue357b
open import Haskell.Prelude
+open import Agda.Primitive
+
+module Fail.Issue357b where
+
+k : a → b → a
+k x _ = x
+{-# COMPILE AGDA2HS k #-}
+
+l : Level → Nat
+l = k 42
+{-# COMPILE AGDA2HS l #-}
+
+testK : Nat
+testK = l lzero
+{-# COMPILE AGDA2HS testK #-}
+
\ No newline at end of file diff --git a/test/Fail.Issue71.html b/test/Fail.Issue71.html new file mode 100644 index 00000000..f2c6925e --- /dev/null +++ b/test/Fail.Issue71.html @@ -0,0 +1,14 @@ + +Fail.Issue71
module Fail.Issue71 where
+
+open import Haskell.Prelude
+
+scanrList : (a → b → b) → b → List a → List b
+scanrList f z [] = z ∷ []
+scanrList f z (x ∷ xs) =
+  case scanrList f z xs of λ {
+    [] -> []
+  ; qs@(q ∷ _) -> f x q ∷ qs
+  }
+{-# COMPILE AGDA2HS scanrList #-}
+
\ No newline at end of file diff --git a/test/Fail.MatchOnDelay.html b/test/Fail.MatchOnDelay.html new file mode 100644 index 00000000..73d43bc1 --- /dev/null +++ b/test/Fail.MatchOnDelay.html @@ -0,0 +1,13 @@ + +Fail.MatchOnDelay
+module Fail.MatchOnDelay where
+
+open import Haskell.Prelude
+open import Haskell.Extra.Delay
+
+bad : Delay a ∞ → Bool
+bad (now x) = True
+bad (later x) = False
+
+{-# COMPILE AGDA2HS bad #-}
+
\ No newline at end of file diff --git a/test/Fail.MultiArgumentPatternLambda.html b/test/Fail.MultiArgumentPatternLambda.html new file mode 100644 index 00000000..365e8399 --- /dev/null +++ b/test/Fail.MultiArgumentPatternLambda.html @@ -0,0 +1,12 @@ + +Fail.MultiArgumentPatternLambda
+module Fail.MultiArgumentPatternLambda where
+
+open import Agda.Builtin.Bool
+
+tooManyPats : Bool → Bool → Bool
+tooManyPats = λ where false false → false
+                      true  true  → false
+                      _     _     → true
+{-# COMPILE AGDA2HS tooManyPats #-}
+
\ No newline at end of file diff --git a/test/Fail.NewTypeRecordTwoFields.html b/test/Fail.NewTypeRecordTwoFields.html new file mode 100644 index 00000000..33435c62 --- /dev/null +++ b/test/Fail.NewTypeRecordTwoFields.html @@ -0,0 +1,15 @@ + +Fail.NewTypeRecordTwoFields
module Fail.NewTypeRecordTwoFields where
+
+open import Haskell.Prelude
+
+record Duo (a b : Set) : Set where
+    constructor MkDuo
+    field
+        left : a
+        right : b
+open Duo public
+
+{-# COMPILE AGDA2HS Duo newtype #-}
+
+
\ No newline at end of file diff --git a/test/Fail.NewTypeTwoConstructors.html b/test/Fail.NewTypeTwoConstructors.html new file mode 100644 index 00000000..a16ba3be --- /dev/null +++ b/test/Fail.NewTypeTwoConstructors.html @@ -0,0 +1,12 @@ + +Fail.NewTypeTwoConstructors
module Fail.NewTypeTwoConstructors where
+
+open import Haskell.Prelude
+
+data Choice (a b  : Set) : Set where
+  A : a → Choice a b
+  B : b → Choice a b
+
+{-# COMPILE AGDA2HS Choice newtype #-}
+
+
\ No newline at end of file diff --git a/test/Fail.NewTypeTwoFields.html b/test/Fail.NewTypeTwoFields.html new file mode 100644 index 00000000..72d7d052 --- /dev/null +++ b/test/Fail.NewTypeTwoFields.html @@ -0,0 +1,11 @@ + +Fail.NewTypeTwoFields
module Fail.NewTypeTwoFields where
+
+open import Haskell.Prelude
+
+data Duo (a b : Set) : Set where
+  MkDuo : a → b → Duo a b
+
+{-# COMPILE AGDA2HS Duo newtype #-}
+
+
\ No newline at end of file diff --git a/test/Fail.NonCanonicalSpecialFunction.html b/test/Fail.NonCanonicalSpecialFunction.html new file mode 100644 index 00000000..18010bb2 --- /dev/null +++ b/test/Fail.NonCanonicalSpecialFunction.html @@ -0,0 +1,25 @@ + +Fail.NonCanonicalSpecialFunction
module Fail.NonCanonicalSpecialFunction where
+
+open import Haskell.Prelude
+
+sneaky : Enum Int
+Enum.BoundedBelowEnum sneaky = Just (record { minBound = 42 })
+Enum.BoundedAboveEnum sneaky = Just (record { maxBound = 42 })
+Enum.fromEnum sneaky = λ _ → 42
+Enum.toEnum sneaky = λ _ → 42
+Enum.succ sneaky = λ _ → 42
+Enum.pred sneaky = λ _ → 42
+Enum.enumFrom sneaky = λ _ → []
+Enum.enumFromTo sneaky = λ _ _ → []
+Enum.enumFromThenTo sneaky = λ _ _ _ → []
+Enum.enumFromThen sneaky = λ _ _ → []
+
+test : List Int
+test = enumFrom {{sneaky}} 5
+
+proof : test ≡ []
+proof = refl
+
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Fail.NonCanonicalSuperclass.html b/test/Fail.NonCanonicalSuperclass.html new file mode 100644 index 00000000..5daf91a7 --- /dev/null +++ b/test/Fail.NonCanonicalSuperclass.html @@ -0,0 +1,34 @@ + +Fail.NonCanonicalSuperclass
+module Fail.NonCanonicalSuperclass where
+
+open import Haskell.Prelude
+
+record Class (a : Set) : Set where
+  field
+    foo : a → a
+open Class {{...}} public
+
+{-# COMPILE AGDA2HS Class class #-}
+
+instance
+  ClassBool : Class Bool
+  ClassBool .foo = not
+
+{-# COMPILE AGDA2HS ClassBool #-}
+
+record Subclass (a : Set) : Set where
+  field
+    overlap {{super}} : Class a
+    bar : a
+open Subclass {{...}} public
+
+{-# COMPILE AGDA2HS Subclass class #-}
+
+instance 
+  SubclassBool : Subclass Bool
+  SubclassBool .super = record { foo = id }
+  SubclassBool .bar = False
+
+{-# COMPILE AGDA2HS SubclassBool #-}
+
\ No newline at end of file diff --git a/test/Fail.NonCopatternInstance.html b/test/Fail.NonCopatternInstance.html new file mode 100644 index 00000000..722b3395 --- /dev/null +++ b/test/Fail.NonCopatternInstance.html @@ -0,0 +1,25 @@ + +Fail.NonCopatternInstance
+module Fail.NonCopatternInstance where
+
+record HasId (a : Set) : Set where
+  field id : a → a
+
+open HasId ⦃ ... ⦄
+
+{-# COMPILE AGDA2HS HasId class #-}
+
+data Unit : Set where
+  MkUnit : Unit
+
+{-# COMPILE AGDA2HS Unit #-}
+
+instance
+  UnitHasId : HasId Unit
+  UnitHasId = r                     -- NOT CORRECT
+    where r = record {id = λ x → x}
+  -- UnitHasId .id x = x                -- CORRECT
+  -- UnitHasId = record {id = λ x → x}  -- CORRECT
+
+{-# COMPILE AGDA2HS UnitHasId #-}
+
\ No newline at end of file diff --git a/test/Fail.NonStarDatatypeIndex.html b/test/Fail.NonStarDatatypeIndex.html new file mode 100644 index 00000000..a50d1faf --- /dev/null +++ b/test/Fail.NonStarDatatypeIndex.html @@ -0,0 +1,9 @@ + +Fail.NonStarDatatypeIndex
module Fail.NonStarDatatypeIndex where
+
+open import Haskell.Prelude
+
+data T (n : Nat) : Set where
+  MkT : T n
+{-# COMPILE AGDA2HS T #-}
+
\ No newline at end of file diff --git a/test/Fail.NonStarRecordIndex.html b/test/Fail.NonStarRecordIndex.html new file mode 100644 index 00000000..a7cdacca --- /dev/null +++ b/test/Fail.NonStarRecordIndex.html @@ -0,0 +1,10 @@ + +Fail.NonStarRecordIndex
module Fail.NonStarRecordIndex where
+
+open import Haskell.Prelude
+
+record T (n : Nat) : Set where
+  field
+    Tb : Bool
+{-# COMPILE AGDA2HS T #-}
+
\ No newline at end of file diff --git a/test/Fail.PartialCase.html b/test/Fail.PartialCase.html new file mode 100644 index 00000000..012a224d --- /dev/null +++ b/test/Fail.PartialCase.html @@ -0,0 +1,9 @@ + +Fail.PartialCase
module Fail.PartialCase where
+
+open import Haskell.Prelude
+
+caseOf : (i : Int) → ((i' : Int) → @0 {{ i ≡ i' }} → Nat) → Nat
+caseOf = case_of_
+{-# COMPILE AGDA2HS caseOf #-}
+
\ No newline at end of file diff --git a/test/Fail.PartialCaseNoLambda.html b/test/Fail.PartialCaseNoLambda.html new file mode 100644 index 00000000..aa5b7d17 --- /dev/null +++ b/test/Fail.PartialCaseNoLambda.html @@ -0,0 +1,9 @@ + +Fail.PartialCaseNoLambda
module Fail.PartialCaseNoLambda where
+
+open import Haskell.Prelude
+
+applyToFalse : ((b : Bool) → @0 {{ False ≡ b }} → Int) → Int
+applyToFalse = case False of_
+{-# COMPILE AGDA2HS applyToFalse #-}
+
\ No newline at end of file diff --git a/test/Fail.PartialIf.html b/test/Fail.PartialIf.html new file mode 100644 index 00000000..5601aaf9 --- /dev/null +++ b/test/Fail.PartialIf.html @@ -0,0 +1,9 @@ + +Fail.PartialIf
module Fail.PartialIf where
+
+open import Haskell.Prelude
+
+if_partial : (flg : Bool) → (@0 {{ flg ≡ True }} → Nat) → (@0 {{ flg ≡ False }} → Nat) → Nat
+if_partial = if_then_else_
+{-# COMPILE AGDA2HS if_partial #-}
+
\ No newline at end of file diff --git a/test/Fail.QualifiedRecordProjections.html b/test/Fail.QualifiedRecordProjections.html new file mode 100644 index 00000000..7b4eca5b --- /dev/null +++ b/test/Fail.QualifiedRecordProjections.html @@ -0,0 +1,9 @@ + +Fail.QualifiedRecordProjections
module Fail.QualifiedRecordProjections where
+
+record Test (a : Set) : Set where
+  field
+    one : a
+
+{-# COMPILE AGDA2HS Test #-}
+
\ No newline at end of file diff --git a/test/Fail.TypeLambda.html b/test/Fail.TypeLambda.html new file mode 100644 index 00000000..5c85c2f8 --- /dev/null +++ b/test/Fail.TypeLambda.html @@ -0,0 +1,11 @@ + +Fail.TypeLambda
+module Fail.TypeLambda where
+
+open import Haskell.Prelude
+
+foo : (f : (Set → Set) → Set) (x : f (λ y → Nat)) (y : f List) → Nat
+foo f x y = 42
+
+{-# COMPILE AGDA2HS foo #-}
+
\ No newline at end of file diff --git a/test/Fixities.html b/test/Fixities.html new file mode 100644 index 00000000..49278305 --- /dev/null +++ b/test/Fixities.html @@ -0,0 +1,41 @@ + +Fixities
+module Fixities where
+
+open import Haskell.Prelude
+
+leftAssoc : Int → List Int
+leftAssoc n = 2 * n + 1
+            ∷ 2 * (n + 1)
+            ∷ 1 + n * 2
+            ∷ (1 + n) * 2
+            ∷ (n + n) + n
+            ∷ n + (n + n)
+            ∷ []
+
+rightAssoc : List Int → List Int
+rightAssoc xs = xs ++ xs ++ ((xs ++ xs) ++ xs) ++ xs
+
+nonAssoc : Bool → Bool
+nonAssoc b = (b == b) == (b == b)
+
+mixedAssoc : Maybe Int → (Int → Maybe Int) → Maybe Int
+mixedAssoc m f = f =<< (((f =<< m) >>= f) >>= f)
+
+{-# COMPILE AGDA2HS leftAssoc  #-}
+{-# COMPILE AGDA2HS rightAssoc #-}
+{-# COMPILE AGDA2HS nonAssoc   #-}
+{-# COMPILE AGDA2HS mixedAssoc #-}
+
+infixl 7 _<+>_
+_<+>_ : Int → Int → Int
+x <+> y = x + y
+
+{-# COMPILE AGDA2HS _<+>_ #-}
+
+infixr 8 _<->_
+_<->_ : Int → Int → Int
+x <-> y = x - y
+
+{-# COMPILE AGDA2HS _<->_ #-}
+
\ No newline at end of file diff --git a/test/FunCon.html b/test/FunCon.html new file mode 100644 index 00000000..9613d09a --- /dev/null +++ b/test/FunCon.html @@ -0,0 +1,24 @@ + +FunCon
+open import Haskell.Prelude
+
+data D1 (t : Set → Set) : Set where
+  C1 : t Bool → D1 t
+
+{-# COMPILE AGDA2HS D1 #-}
+
+f1 : D1 (λ a → Int → a)
+f1 = C1 (_== 0)
+
+{-# COMPILE AGDA2HS f1 #-}
+
+data D2 (t : Set → Set → Set) : Set where
+  C2 : t Int Int → D2 t
+
+{-# COMPILE AGDA2HS D2 #-}
+
+f2 : D2 (λ a b → a → b)
+f2 = C2 (_+ 1)
+
+{-# COMPILE AGDA2HS f2 #-}
+
\ No newline at end of file diff --git a/test/Haskell.Control.Monad.html b/test/Haskell.Control.Monad.html new file mode 100644 index 00000000..e8f6d4d4 --- /dev/null +++ b/test/Haskell.Control.Monad.html @@ -0,0 +1,13 @@ + +Haskell.Control.Monad
module Haskell.Control.Monad where
+
+open import Haskell.Prim
+open import Haskell.Prim.Bool
+open import Haskell.Prim.Monad
+open import Haskell.Prim.String
+open import Haskell.Extra.Erase
+
+guard : {{ MonadFail m }} → (b : Bool) → m (Erase (b ≡ True))
+guard True = return (Erased refl)
+guard False = fail "Guard was not True"
+
\ No newline at end of file diff --git a/test/Haskell.Extra.Dec.html b/test/Haskell.Extra.Dec.html new file mode 100644 index 00000000..c9014bb3 --- /dev/null +++ b/test/Haskell.Extra.Dec.html @@ -0,0 +1,49 @@ + +Haskell.Extra.Dec
module Haskell.Extra.Dec where
+
+open import Haskell.Prelude
+open import Haskell.Extra.Refinement
+open import Agda.Primitive
+
+private variable
+  ℓ : Level
+  P : Set
+
+@0 Reflects : Set ℓ → Bool → Set ℓ
+Reflects P True  = P
+Reflects P False = P → ⊥
+
+of : {b : Bool} → if b then P else (P → ⊥) → Reflects P b
+of {b = False} np = np
+of {b = True}  p  = p
+
+invert : ∀ {b} → Reflects P b → if b then P else (P → ⊥)
+invert {b = False} np = np
+invert {b = True}  p  = p
+
+extractTrue : ∀ { b } → ⦃ true : b ≡ True ⦄ → Reflects P b → P
+extractTrue {b = True} p = p
+
+extractFalse : ∀ { b } → ⦃ true : b ≡ False ⦄ → Reflects P b → (P → ⊥)
+extractFalse {b = False} np = np
+
+mapReflects : ∀ {cond} → (a → b) → (b → a)
+            → Reflects a cond → Reflects b cond
+mapReflects {cond = False} f g x = x ∘ g
+mapReflects {cond = True}  f g x = f x
+
+Dec : ∀ {ℓ} → @0 Set ℓ → Set ℓ
+Dec P = ∃ Bool (Reflects P)
+{-# COMPILE AGDA2HS Dec inline #-}
+
+mapDec : @0 (a → b)
+       → @0 (b → a)
+       → Dec a → Dec b
+mapDec f g (True  ⟨ x ⟩) = True  ⟨ f x   ⟩
+mapDec f g (False ⟨ h ⟩) = False ⟨ h ∘ g ⟩
+{-# COMPILE AGDA2HS mapDec transparent #-}
+
+ifDec : Dec a → (@0 {{a}} → b) → (@0 {{a → ⊥}} → b) → b
+ifDec (b ⟨ p ⟩) x y = if b then (λ where {{refl}} → x {{p}}) else (λ where {{refl}} → y {{p}})
+{-# COMPILE AGDA2HS ifDec inline #-}
+
\ No newline at end of file diff --git a/test/Haskell.Extra.Delay.html b/test/Haskell.Extra.Delay.html new file mode 100644 index 00000000..62bc5b8b --- /dev/null +++ b/test/Haskell.Extra.Delay.html @@ -0,0 +1,41 @@ + +Haskell.Extra.Delay
{-# OPTIONS --sized-types #-}
+
+module Haskell.Extra.Delay where
+
+open import Agda.Builtin.Size public
+
+open import Haskell.Prelude
+open import Haskell.Prim.Thunk
+open import Haskell.Extra.Refinement
+
+private variable
+  x y z : a
+  @0 i : Size
+
+data Delay (a : Set) (@0 i : Size) : Set where
+  now : a → Delay a i
+  later : Thunk (Delay a) i → Delay a i
+
+data HasResult (x : a) : Delay a i → Set where
+  now   : HasResult x (now x)
+  later : HasResult x (y .force) → HasResult x (later y)
+
+runDelay : {@0 x : a} (y : Delay a ∞) → @0 HasResult x y → a
+runDelay (now x) now = x
+runDelay (later y) (later p) = runDelay (y .force) p
+
+runDelaySound : {@0 x : a} (y : Delay a ∞) → (@0 hr : HasResult x y) → runDelay y hr ≡ x
+runDelaySound (now x) now = refl
+runDelaySound (later y) (later hr) = runDelaySound (y .force) hr
+
+-- tryDelay and unDelay cannot and should not be compiled to Haskell,
+-- so they are marked as erased.
+@0 tryDelay : (y : Delay a ∞) → Nat → Maybe (∃ a (λ x → HasResult x y))
+tryDelay (now x)   _       = Just (x ⟨ now ⟩)
+tryDelay (later y) zero    = Nothing
+tryDelay (later y) (suc n) = fmap (mapRefine later) (tryDelay (y .force) n)
+
+@0 unDelay : (y : Delay a ∞) (n : Nat) → @0 {IsJust (tryDelay y n)} → a
+unDelay y n {p} = fromJust (tryDelay y n) {p} .value
+
\ No newline at end of file diff --git a/test/Haskell.Extra.Erase.html b/test/Haskell.Extra.Erase.html new file mode 100644 index 00000000..0791edd1 --- /dev/null +++ b/test/Haskell.Extra.Erase.html @@ -0,0 +1,84 @@ + +Haskell.Extra.Erase
module Haskell.Extra.Erase where
+
+  open import Agda.Primitive
+  open import Agda.Builtin.Sigma
+  open import Agda.Builtin.Equality
+
+  open import Haskell.Prim
+  open import Haskell.Prim.List
+  open import Haskell.Extra.Refinement
+  open import Haskell.Law.Equality
+
+  private variable
+    @0 x y : a
+    @0 xs  : List a
+
+  record Erase (@0 a : Set ℓ) : Set ℓ where
+    instance constructor iErased
+    field @0 {{get}} : a
+  open Erase public
+  {-# COMPILE AGDA2HS Erase tuple #-}
+
+  pattern Erased x = iErased {{x}}
+
+  infixr 4 ⟨_⟩_
+  record Σ0 (@0 a : Set) (b : @0 a → Set) : Set where
+    constructor ⟨_⟩_
+    field
+      @0 proj₁ : a
+      proj₂ : b proj₁
+  open Σ0 public
+  {-# COMPILE AGDA2HS Σ0 unboxed #-}
+
+  pattern <_> x = record { proj₁ = _ ; proj₂ = x }
+
+  -- Resurrection of erased values
+  Rezz : (@0 x : a) → Set
+  Rezz x = ∃ _ (x ≡_)
+
+  {-# COMPILE AGDA2HS Rezz inline #-}
+
+  pattern rezz x = x ⟨ refl ⟩
+
+  instance
+    rezz-id : {x : a} → Rezz x
+    rezz-id = rezz _
+  {-# COMPILE AGDA2HS rezz-id inline #-}
+
+  rezzCong : {@0 a : Set} {@0 x : a} (f : a → b) → Rezz x → Rezz (f x)
+  rezzCong f (x ⟨ p ⟩) = f x ⟨ cong f p ⟩
+  {-# COMPILE AGDA2HS rezzCong inline #-}
+
+  rezzCong2 : (f : a → b → c) → Rezz x → Rezz y → Rezz (f x y)
+  rezzCong2 f (x ⟨ p ⟩) (y ⟨ q ⟩) = f x y ⟨ cong₂ f p q ⟩
+  {-# COMPILE AGDA2HS rezzCong2 inline #-}
+
+  rezzHead : Rezz (x ∷ xs) → Rezz x
+  rezzHead {x = x} (ys ⟨ p ⟩) =
+    head ys
+    ⟨ subst (λ ys → ⦃ @0 _ : NonEmpty ys ⦄ → x ≡ head ys)
+            p refl ⟩
+    where instance @0 ne : NonEmpty ys
+                   ne = subst NonEmpty p itsNonEmpty
+  {-# COMPILE AGDA2HS rezzHead inline #-}
+
+  rezzTail : Rezz (x ∷ xs) → Rezz xs
+  rezzTail {xs = xs} (ys ⟨ p ⟩) =
+    tail ys
+    ⟨ subst (λ ys → ⦃ @0 _ : NonEmpty ys ⦄ → xs ≡ tail ys)
+            p refl ⟩
+    where instance @0 ne : NonEmpty ys
+                   ne = subst NonEmpty p itsNonEmpty
+  {-# COMPILE AGDA2HS rezzTail inline #-}
+
+  rezzErase : {@0 a : Set} {@0 x : a} → Rezz (Erased x)
+  rezzErase {x = x} = Erased x ⟨ refl ⟩
+  {-# COMPILE AGDA2HS rezzErase inline #-}
+
+  erase-injective : Erased x ≡ Erased y → x ≡ y
+  erase-injective refl = refl
+
+  inspect_by_ : (x : a) → (Rezz x → b) → b
+  inspect x by f = f (rezz x)
+
\ No newline at end of file diff --git a/test/Haskell.Extra.Refinement.html b/test/Haskell.Extra.Refinement.html new file mode 100644 index 00000000..8b964e11 --- /dev/null +++ b/test/Haskell.Extra.Refinement.html @@ -0,0 +1,30 @@ + +Haskell.Extra.Refinement
module Haskell.Extra.Refinement where
+
+open import Haskell.Prelude
+open import Agda.Primitive
+
+private variable
+  ℓ ℓ′ : Level
+
+record ∃ (a : Set ℓ) (@0 P : a → Set ℓ′) : Set (ℓ ⊔ ℓ′) where
+  constructor _⟨_⟩
+  field
+    value    : a
+    @0 proof : P value
+open ∃ public
+{-# COMPILE AGDA2HS ∃ unboxed #-}
+
+mapRefine : {@0 P Q : a → Set ℓ} (@0 f : ∀ {x} → P x → Q x) → ∃ a P → ∃ a Q
+mapRefine f (x ⟨ p ⟩) = x ⟨ f p ⟩
+
+{-# COMPILE AGDA2HS mapRefine transparent #-}
+
+refineMaybe : {@0 P : a → Set ℓ} 
+            → (mx : Maybe a) → @0 (∀ {x} → mx ≡ Just x → P x)
+            → Maybe (∃ a P)
+refineMaybe Nothing f = Nothing
+refineMaybe (Just x) f = Just (x ⟨ f refl ⟩)
+
+{-# COMPILE AGDA2HS refineMaybe transparent #-}
+
\ No newline at end of file diff --git a/test/Haskell.Extra.Sigma.html b/test/Haskell.Extra.Sigma.html new file mode 100644 index 00000000..4c265476 --- /dev/null +++ b/test/Haskell.Extra.Sigma.html @@ -0,0 +1,19 @@ + +Haskell.Extra.Sigma
module Haskell.Extra.Sigma where
+
+record Σ (a : Set) (b : @0 a → Set) : Set where
+  constructor _,_
+  field
+    fst : a
+    snd : b fst
+open Σ public
+{-# COMPILE AGDA2HS Σ tuple #-}
+
+infix 2 Σ-syntax
+
+Σ-syntax : (a : Set) → (@0 a → Set) → Set
+Σ-syntax = Σ
+{-# COMPILE AGDA2HS Σ-syntax inline #-}
+
+syntax Σ-syntax a (λ x → b) = Σ[ x ∈ a ] b
+
\ No newline at end of file diff --git a/test/Haskell.Law.Applicative.Def.html b/test/Haskell.Law.Applicative.Def.html new file mode 100644 index 00000000..fcf45f05 --- /dev/null +++ b/test/Haskell.Law.Applicative.Def.html @@ -0,0 +1,43 @@ + +Haskell.Law.Applicative.Def
module Haskell.Law.Applicative.Def where
+
+open import Haskell.Prim
+open import Haskell.Prim.Functor
+
+open import Haskell.Prim.Applicative
+open import Haskell.Prim.Monoid
+open import Haskell.Prim.Tuple
+
+open import Haskell.Law.Functor
+
+record IsLawfulApplicative (F : Set → Set) ⦃ iAppF : Applicative F ⦄ : Set₁ where
+  field
+    overlap ⦃ super ⦄ : IsLawfulFunctor F
+
+    -- Identity: pure id <*> v = v
+    identity : (v : F a) → (pure id <*> v) ≡ v
+
+    -- Composition: pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
+    composition : {a b c : Set} → (u : F (b → c)) (v : F (a → b)) (w : F a)
+      → (pure _∘_ <*> u <*> v <*> w) ≡ (u <*> (v <*> w))
+
+    -- Homomorphism: pure f <*> pure x = pure (f x)
+    homomorphism : {a b : Set} → (f : a → b) (x : a)
+      → (Applicative._<*>_ iAppF (pure f) (pure x)) ≡ (pure (f x))
+
+    -- Interchange: u <*> pure y = pure ($ y) <*> u
+    interchange : {a b : Set} → (u : F (a → b)) (y : a)
+      → (u <*> (pure y)) ≡ (pure (_$ y) <*> u)
+
+    -- fmap f x = pure f <*> x
+    functor : (f : a → b) (x : F a) → (fmap f x) ≡ ((pure f) <*> x)
+
+open IsLawfulApplicative ⦃ ... ⦄ public
+
+instance postulate
+  iLawfulApplicativeFun : IsLawfulApplicative (λ b → a → b)
+
+  iLawfulApplicativeTuple₂ : ⦃ Monoid a ⦄ → Applicative (a ×_)
+
+  iLawfulApplicativeTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Applicative (a × b ×_)
+
\ No newline at end of file diff --git a/test/Haskell.Law.Applicative.Either.html b/test/Haskell.Law.Applicative.Either.html new file mode 100644 index 00000000..c4ef79e5 --- /dev/null +++ b/test/Haskell.Law.Applicative.Either.html @@ -0,0 +1,31 @@ + +Haskell.Law.Applicative.Either
module Haskell.Law.Applicative.Either where
+
+open import Haskell.Prim
+open import Haskell.Prim.Either
+
+open import Haskell.Prim.Applicative
+
+open import Haskell.Law.Applicative.Def
+
+open import Haskell.Law.Functor.Either
+
+instance
+  iLawfulApplicativeEither : IsLawfulApplicative (Either a)
+  -- (λ { true → true ; false → false })
+
+  iLawfulApplicativeEither .identity = λ { (Left _) → refl; (Right _) → refl }
+
+  iLawfulApplicativeEither .composition =
+    λ { (Left _)  _         _         → refl
+      ; (Right _) (Left _)  _         → refl
+      ; (Right _) (Right _) (Left _)  → refl
+      ; (Right _) (Right _) (Right _) → refl
+      }
+
+  iLawfulApplicativeEither .homomorphism _ _ = refl
+
+  iLawfulApplicativeEither .interchange = λ { (Left _) _ → refl; (Right _) _ → refl }
+
+  iLawfulApplicativeEither .functor = λ { _ (Left _) → refl; _ (Right _) → refl }
+
\ No newline at end of file diff --git a/test/Haskell.Law.Applicative.IO.html b/test/Haskell.Law.Applicative.IO.html new file mode 100644 index 00000000..5dc8a992 --- /dev/null +++ b/test/Haskell.Law.Applicative.IO.html @@ -0,0 +1,14 @@ + +Haskell.Law.Applicative.IO
module Haskell.Law.Applicative.IO where
+
+open import Haskell.Prim
+open import Haskell.Prim.IO
+
+open import Haskell.Prim.Applicative
+
+open import Haskell.Law.Applicative.Def
+
+open import Haskell.Law.Functor.IO
+
+instance postulate iLawfulApplicativeIO : IsLawfulApplicative IO
+
\ No newline at end of file diff --git a/test/Haskell.Law.Applicative.List.html b/test/Haskell.Law.Applicative.List.html new file mode 100644 index 00000000..286c3ddd --- /dev/null +++ b/test/Haskell.Law.Applicative.List.html @@ -0,0 +1,56 @@ + +Haskell.Law.Applicative.List
module Haskell.Law.Applicative.List where
+
+open import Haskell.Prim
+open import Haskell.Prim.List
+
+open import Haskell.Prim.Applicative
+open import Haskell.Prim.Functor
+
+open import Haskell.Law.Applicative.Def
+
+open import Haskell.Law.Equality
+open import Haskell.Law.Functor.List
+open import Haskell.Law.List
+
+private
+  identityList : {a : Set} → (v : List a) → (pure id <*> v) ≡ v
+  identityList [] = refl
+  identityList (x ∷ xs)
+    rewrite identityList xs
+    = refl
+
+  compositionList : {a b c : Set} → (u : List (b → c)) (v : List (a → b)) (w : List a)
+    → ((((pure _∘_) <*> u) <*> v) <*> w) ≡ (u <*> (v <*> w))
+  compositionList [] _  _  = refl
+  compositionList (u ∷ us) v w
+    rewrite sym $ concatMap-++-distr (map (u ∘_) v) (((pure _∘_) <*> us) <*> v) (λ f → map f w)
+      | sym $ map-<*>-recomp v w u
+      | compositionList us v w
+    = refl 
+
+  interchangeList : {a b : Set} → (u : List (a → b)) → (y : a)
+    → (u <*> (pure y)) ≡ (pure (_$ y) <*> u)
+  interchangeList [] _ = refl
+  interchangeList (x ∷ xs) y
+      rewrite interchangeList xs y
+      = refl
+
+  functorList : {a b : Set} → (f : a → b) → (x : List a)
+    → (fmap f x) ≡ ((pure f) <*> x)
+  functorList _ [] = refl
+  functorList f (x ∷ xs)
+      rewrite functorList f xs
+        | ++-[] (map f xs)
+        | ++-[] (f x ∷ map f xs)
+      = refl
+
+instance
+  iLawfulApplicativeList : IsLawfulApplicative List
+  iLawfulApplicativeList = λ where
+    .identity → identityList
+    .composition → compositionList
+    .homomorphism _ x → refl
+    .interchange → interchangeList
+    .functor → functorList
+
\ No newline at end of file diff --git a/test/Haskell.Law.Applicative.Maybe.html b/test/Haskell.Law.Applicative.Maybe.html new file mode 100644 index 00000000..5d54818c --- /dev/null +++ b/test/Haskell.Law.Applicative.Maybe.html @@ -0,0 +1,29 @@ + +Haskell.Law.Applicative.Maybe
module Haskell.Law.Applicative.Maybe where
+
+open import Haskell.Prim
+open import Haskell.Prim.Maybe
+
+open import Haskell.Prim.Applicative
+
+open import Haskell.Law.Applicative.Def
+
+open import Haskell.Law.Functor.Maybe
+
+instance
+  iLawfulApplicativeMaybe : IsLawfulApplicative Maybe
+  iLawfulApplicativeMaybe .identity = λ { Nothing → refl; (Just _) → refl }
+
+  iLawfulApplicativeMaybe .composition =
+    λ { Nothing  _        _        → refl
+      ; (Just _) Nothing  _        → refl
+      ; (Just _) (Just _) Nothing  → refl
+      ; (Just _) (Just _) (Just _) → refl
+      }
+
+  iLawfulApplicativeMaybe .homomorphism _ _ = refl
+
+  iLawfulApplicativeMaybe .interchange = λ { Nothing _ → refl; (Just _) _ → refl }
+
+  iLawfulApplicativeMaybe .functor = λ { _ Nothing → refl; _ (Just _) → refl }
+
\ No newline at end of file diff --git a/test/Haskell.Law.Applicative.html b/test/Haskell.Law.Applicative.html new file mode 100644 index 00000000..76061bea --- /dev/null +++ b/test/Haskell.Law.Applicative.html @@ -0,0 +1,9 @@ + +Haskell.Law.Applicative
module Haskell.Law.Applicative where
+
+open import Haskell.Law.Applicative.Def    public
+open import Haskell.Law.Applicative.Either public
+open import Haskell.Law.Applicative.IO     public
+open import Haskell.Law.Applicative.List   public
+open import Haskell.Law.Applicative.Maybe  public
+
\ No newline at end of file diff --git a/test/Haskell.Law.Bool.html b/test/Haskell.Law.Bool.html new file mode 100644 index 00000000..f8148b15 --- /dev/null +++ b/test/Haskell.Law.Bool.html @@ -0,0 +1,78 @@ + +Haskell.Law.Bool
module Haskell.Law.Bool where
+
+open import Haskell.Prim
+open import Haskell.Prim.Bool
+
+open import Haskell.Law.Equality
+
+--------------------------------------------------
+-- &&
+
+&&-sym : ∀ (a b : Bool) → (a && b) ≡ (b && a)
+&&-sym False False = refl
+&&-sym False True = refl
+&&-sym True False = refl
+&&-sym True True = refl
+
+&&-semantics : ∀ (a b : Bool) → a ≡ True → b ≡ True → (a && b) ≡ True
+&&-semantics True True _ _ = refl
+
+&&-leftAssoc : ∀ (a b c : Bool) → (a && b && c) ≡ True → ((a && b) && c) ≡ True
+&&-leftAssoc True True True _ = refl
+
+&&-leftAssoc' : ∀ (a b c : Bool) → (a && b && c) ≡ ((a && b) && c)
+&&-leftAssoc' False b c = refl
+&&-leftAssoc' True b c = refl
+
+&&-leftTrue : ∀ (a b : Bool) → (a && b) ≡ True → a ≡ True
+&&-leftTrue True True _ = refl
+
+&&-leftTrue' : ∀ (a b c : Bool) → a ≡ (b && c) → a ≡ True → c ≡ True
+&&-leftTrue' .True True True _ refl = refl
+
+&&-rightTrue : ∀ (a b : Bool) → (a && b) ≡ True → b ≡ True
+&&-rightTrue True True _ = refl
+
+&&-rightTrue' : ∀ (a b c : Bool) → a ≡ (b && c) → a ≡ True → b ≡ True
+&&-rightTrue' .True True True _ refl = refl
+
+--------------------------------------------------
+-- ||
+
+-- if a then True else b
+
+||-excludedMiddle : ∀ (a b : Bool) → (a || not a) ≡ True
+||-excludedMiddle False _ = refl
+||-excludedMiddle True  _ = refl
+
+||-leftTrue : ∀ (a b : Bool) → a ≡ True → (a || b) ≡ True
+||-leftTrue .True b refl = refl
+
+||-rightTrue : ∀ (a b : Bool) → b ≡ True → (a || b) ≡ True
+||-rightTrue False .True refl = refl
+||-rightTrue True  .True refl = refl
+
+--------------------------------------------------
+-- not
+
+not-not : ∀ (a : Bool) → not (not a) ≡ a
+not-not False = refl
+not-not True = refl
+
+not-involution : ∀ (a b : Bool) → a ≡ not b → not a ≡ b
+not-involution .(not b) b refl = not-not b
+
+--------------------------------------------------
+-- if_then_else_
+
+ifFlip : ∀ (b) (t e : a) → (if b then t else e) ≡ (if not b then e else t)
+ifFlip False _ _ = refl
+ifFlip True  _ _ = refl
+
+ifTrueEqThen : ∀ (b : Bool) {thn els : a} → b ≡ True → (if b then thn else els) ≡ thn
+ifTrueEqThen .True refl = refl
+
+ifFalseEqElse : ∀ (b : Bool) {thn els : a} → b ≡ False → (if b then thn else els) ≡ els
+ifFalseEqElse .False refl = refl
+
\ No newline at end of file diff --git a/test/Haskell.Law.Def.html b/test/Haskell.Law.Def.html new file mode 100644 index 00000000..ae2e53d3 --- /dev/null +++ b/test/Haskell.Law.Def.html @@ -0,0 +1,8 @@ + +Haskell.Law.Def
module Haskell.Law.Def where
+
+open import Haskell.Prim
+
+Injective : (a → b) → Set _
+Injective f = ∀ {x y} → f x ≡ f y → x ≡ y
+
\ No newline at end of file diff --git a/test/Haskell.Law.Either.html b/test/Haskell.Law.Either.html new file mode 100644 index 00000000..6b6caa90 --- /dev/null +++ b/test/Haskell.Law.Either.html @@ -0,0 +1,14 @@ + +Haskell.Law.Either
module Haskell.Law.Either where
+
+open import Haskell.Prim
+open import Haskell.Prim.Either
+
+open import Haskell.Law.Def
+
+Left-injective : Injective (Left {a}{b})
+Left-injective refl = refl
+
+Right-injective : Injective (Right {a}{b})
+Right-injective refl = refl
+
\ No newline at end of file diff --git a/test/Haskell.Law.Eq.Def.html b/test/Haskell.Law.Eq.Def.html new file mode 100644 index 00000000..48ce54e6 --- /dev/null +++ b/test/Haskell.Law.Eq.Def.html @@ -0,0 +1,70 @@ + +Haskell.Law.Eq.Def
module Haskell.Law.Eq.Def where
+
+open import Haskell.Prim
+open import Haskell.Prim.Bool
+open import Haskell.Prim.Double
+
+open import Haskell.Prim.Eq
+
+open import Haskell.Extra.Dec
+
+open import Haskell.Law.Bool
+open import Haskell.Law.Equality
+
+record IsLawfulEq (e : Set) ⦃ iEq : Eq e ⦄ : Set₁ where
+  field
+    isEquality : ∀ (x y : e) → Reflects (x ≡ y) (x == y)
+
+  equality : ∀ (x y : e) → (x == y) ≡ True → x ≡ y
+  equality x y h = extractTrue ⦃ h ⦄ (isEquality x y)
+
+  nequality : ∀ (x y : e) → (x == y) ≡ False → (x ≡ y → ⊥)
+  nequality x y h = extractFalse ⦃ h ⦄ (isEquality x y)
+
+  -- contrapositive of nequality
+  equality' : ∀ (x y : e) → x ≡ y → (x == y) ≡ True
+  equality' x y h with x == y in eq
+  ... | False = magic (nequality x y eq h)
+  ... | True = refl
+
+  -- contrapositive of equality
+  nequality' : ∀ (x y : e) → (x ≡ y → ⊥) → (x == y) ≡ False
+  nequality' x y h with x == y in eq
+  ... | True = magic (h (equality x y eq))
+  ... | False = refl
+
+open IsLawfulEq ⦃ ... ⦄ public
+
+-- Reflexivity: x == x = True
+eqReflexivity : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄
+              → ∀ (x : e) → (x == x) ≡ True
+eqReflexivity x = equality' x x refl
+
+-- Symmetry: x == y = y == x
+eqSymmetry : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄
+           → ∀ (x y : e) → (x == y) ≡ (y == x)
+eqSymmetry x y with x == y in eq
+... | True  = sym (equality' y x (sym (equality x y eq)))
+... | False = sym (nequality' y x (λ qe → (nequality x y eq) (sym qe)))
+
+-- Transitivity: if x == y && y == z = True, then x == z = True
+eqTransitivity : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄
+               → ∀ (x y z : e) → ((x == y) && (y == z)) ≡ True → (x == z) ≡ True
+eqTransitivity x y z h
+  = equality' x z (trans
+    (equality x y (&&-leftTrue (x == y) (y == z) h))
+    (equality y z (&&-rightTrue (x == y) (y == z) h)))
+
+-- Extensionality: if x == y = True and f is a function whose return type is an instance of Eq, then f x == f y = True
+eqExtensionality : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄
+                 → ⦃ iEq : Eq a ⦄ → ⦃ iLawfulEq : IsLawfulEq a ⦄
+                 → ∀ ( x y : e ) ( f : e → a ) → (x == y) ≡ True → (f x == f y) ≡ True
+eqExtensionality x y f h = equality' (f x) (f y) (cong f (equality x y h))
+
+-- Negation: x /= y = not (x == y)
+eqNegation : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄
+           → ∀ { x y : e } → (x /= y) ≡ not (x == y)
+eqNegation = refl
+
+
\ No newline at end of file diff --git a/test/Haskell.Law.Eq.Instances.html b/test/Haskell.Law.Eq.Instances.html new file mode 100644 index 00000000..652069d9 --- /dev/null +++ b/test/Haskell.Law.Eq.Instances.html @@ -0,0 +1,140 @@ + +Haskell.Law.Eq.Instances
module Haskell.Law.Eq.Instances where
+
+open import Agda.Builtin.Char.Properties renaming (primCharToNatInjective to c2n-injective)
+open import Agda.Builtin.Word.Properties renaming (primWord64ToNatInjective to w2n-injective)
+
+open import Haskell.Prim
+open import Haskell.Prim.Eq
+
+open import Haskell.Prim.Either using ( Either; Left; Right )
+open import Haskell.Prim.Int    using ( Int; int64 )
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Ord    using ( Ordering; LT; GT; EQ )
+open import Haskell.Prim.Tuple
+open import Haskell.Prim.Word   using ( Word )
+
+open import Haskell.Extra.Dec   using ( mapReflects )
+
+open import Haskell.Law.Eq.Def
+open import Haskell.Law.Equality
+
+open import Haskell.Law.Either
+open import Haskell.Law.Int
+open import Haskell.Law.Integer
+open import Haskell.Law.List    using ( ∷-injective-left; ∷-injective-right )
+open import Haskell.Law.Maybe
+open import Haskell.Law.Nat
+
+open _×_×_
+
+instance
+  iLawfulEqNat : IsLawfulEq Nat
+  iLawfulEqNat .isEquality zero    zero    = refl
+  iLawfulEqNat .isEquality zero    (suc _) = λ ()
+  iLawfulEqNat .isEquality (suc _) zero    = λ ()
+  iLawfulEqNat .isEquality (suc x) (suc y) = mapReflects
+    (cong suc)
+    suc-injective
+    (isEquality x y)
+
+  iLawfulEqWord : IsLawfulEq Word
+  iLawfulEqWord .isEquality x y
+    with (w2n x) in h₁ | (w2n y) in h₂
+  ... | a | b  = mapReflects
+    (λ h → w2n-injective x y $ sym $ trans (trans h₂ $ sym h) (sym h₁))
+    (λ h → trans (sym $ trans (cong w2n (sym h)) h₁) h₂)
+    (isEquality a b)
+
+  iLawfulEqBool : IsLawfulEq Bool
+  iLawfulEqBool .isEquality False False = refl
+  iLawfulEqBool .isEquality False True  = λ()
+  iLawfulEqBool .isEquality True  False = λ()
+  iLawfulEqBool .isEquality True  True  = refl
+
+  iLawfulEqChar : IsLawfulEq Char
+  iLawfulEqChar .isEquality x y
+    with (c2n x) in h₁ | (c2n y) in h₂
+  ... | a | b  = mapReflects { a ≡ b } { x ≡ y } { eqNat a b }
+    (λ h → c2n-injective x y $ sym $ trans (trans h₂ $ sym h) (sym h₁))
+    (λ h → trans (sym $ trans (cong c2n (sym h)) h₁) h₂)
+    (isEquality a b)
+
+  iLawfulEqEither : ⦃ iEqA : Eq a ⦄ → ⦃ iEqB : Eq b ⦄
+    → ⦃ IsLawfulEq a ⦄ → ⦃ IsLawfulEq b ⦄
+    → IsLawfulEq (Either a b)
+  iLawfulEqEither .isEquality (Left  _) (Right _) = λ ()
+  iLawfulEqEither .isEquality (Right _) (Left  _) = λ ()
+  iLawfulEqEither .isEquality (Left  x) (Left  y) = mapReflects
+    (cong Left) (Left-injective) (isEquality x y)
+  iLawfulEqEither .isEquality (Right x) (Right y) = mapReflects
+    (cong Right) (Right-injective) (isEquality x y)
+
+  iLawfulEqInt : IsLawfulEq Int
+  iLawfulEqInt .isEquality (int64 x) (int64 y) = mapReflects
+    (cong int64) int64-injective (isEquality x y)
+
+  iLawfulEqInteger : IsLawfulEq Integer
+  iLawfulEqInteger .isEquality (pos n)    (pos m)    = mapReflects
+    (cong pos) pos-injective (isEquality n m)
+  iLawfulEqInteger .isEquality (pos _)    (negsuc _) = λ ()
+  iLawfulEqInteger .isEquality (negsuc _) (pos _)    = λ ()
+  iLawfulEqInteger .isEquality (negsuc n) (negsuc m) = mapReflects
+    (cong negsuc) neg-injective (isEquality n m)
+
+  iLawfulEqList : ⦃ iEqA : Eq a ⦄ → ⦃ IsLawfulEq a ⦄ → IsLawfulEq (List a)
+  iLawfulEqList .isEquality []       []      = refl
+  iLawfulEqList .isEquality []       (_ ∷ _) = λ ()
+  iLawfulEqList .isEquality (_ ∷ _)  []      = λ ()
+  iLawfulEqList .isEquality (x ∷ xs) (y ∷ ys)
+    with (x == y) in h₁
+  ... | True  = mapReflects
+    (λ h → cong₂ (_∷_) (equality x y h₁)  h)
+    ∷-injective-right
+    (isEquality xs ys)
+  ... | False = λ h → (nequality x y h₁) (∷-injective-left h)
+
+  iLawfulEqMaybe : ⦃ iEqA : Eq a ⦄ → ⦃ IsLawfulEq a ⦄ → IsLawfulEq (Maybe a)
+  iLawfulEqMaybe .isEquality Nothing  Nothing  = refl
+  iLawfulEqMaybe .isEquality Nothing  (Just _) = λ()
+  iLawfulEqMaybe .isEquality (Just _) Nothing  = λ()
+  iLawfulEqMaybe .isEquality (Just x) (Just y) = mapReflects
+    (cong Just) Just-injective (isEquality x y)
+
+  iLawfulEqOrdering : IsLawfulEq Ordering
+  iLawfulEqOrdering .isEquality LT LT = refl
+  iLawfulEqOrdering .isEquality LT EQ = λ()
+  iLawfulEqOrdering .isEquality LT GT = λ()
+  iLawfulEqOrdering .isEquality EQ LT = λ()
+  iLawfulEqOrdering .isEquality EQ EQ = refl
+  iLawfulEqOrdering .isEquality EQ GT = λ()
+  iLawfulEqOrdering .isEquality GT LT = λ()
+  iLawfulEqOrdering .isEquality GT EQ = λ()
+  iLawfulEqOrdering .isEquality GT GT = refl
+
+  iLawfulEqTuple₂ : ⦃ iEqA : Eq a ⦄ ⦃ iEqB : Eq b ⦄
+    → ⦃ IsLawfulEq a ⦄ → ⦃ IsLawfulEq b ⦄
+    → IsLawfulEq (a × b)
+  iLawfulEqTuple₂ .isEquality (x₁ , x₂) (y₁ , y₂)
+    with (x₁ == y₁) in h₁
+  ... | True  = mapReflects
+    (λ h → cong₂ _,_ (equality x₁ y₁ h₁) h)
+    (cong snd)
+    (isEquality x₂ y₂)
+  ... | False = λ h → exFalso (equality' x₁ y₁ (cong fst h)) h₁
+
+  iLawfulEqTuple₃ : ⦃ iEqA : Eq a ⦄ ⦃ iEqB : Eq b ⦄ ⦃ iEqC : Eq c ⦄
+    → ⦃ IsLawfulEq a ⦄ → ⦃ IsLawfulEq b ⦄ → ⦃ IsLawfulEq c ⦄
+    → IsLawfulEq (a × b × c)
+  iLawfulEqTuple₃ .isEquality (x₁ , x₂ , x₃) (y₁ , y₂ , y₃)
+    with (x₁ == y₁) in h₁
+  ... | True  = mapReflects
+    (λ h → cong₂ (λ a (b , c) → a , b , c) (equality x₁ y₁ h₁) h)
+    (cong λ h → snd3 h , thd3 h)
+    (isEquality (x₂ , x₃) (y₂ , y₃))
+  ... | False = λ h → exFalso (equality' x₁ y₁ (cong fst3 h)) h₁
+
+
+  iLawfulEqUnit : IsLawfulEq ⊤
+  iLawfulEqUnit .isEquality tt tt = refl
+
\ No newline at end of file diff --git a/test/Haskell.Law.Eq.html b/test/Haskell.Law.Eq.html new file mode 100644 index 00000000..078f42d0 --- /dev/null +++ b/test/Haskell.Law.Eq.html @@ -0,0 +1,6 @@ + +Haskell.Law.Eq
module Haskell.Law.Eq where
+
+open import Haskell.Law.Eq.Def       public
+open import Haskell.Law.Eq.Instances public
+
\ No newline at end of file diff --git a/test/Haskell.Law.Equality.html b/test/Haskell.Law.Equality.html new file mode 100644 index 00000000..744d33df --- /dev/null +++ b/test/Haskell.Law.Equality.html @@ -0,0 +1,69 @@ + +Haskell.Law.Equality
module Haskell.Law.Equality where
+
+open import Haskell.Prim
+
+open import Agda.Builtin.TrustMe
+
+_≠_ : {A : Set} → A → A → Set
+_≠_ a b = a ≡ b → ⊥
+
+infix 4 _≠_
+
+--------------------------------------------------
+-- Basic Laws
+
+cong : {A B : Set} → ∀ (f : A → B) {x y} → x ≡ y → f x ≡ f y
+cong f refl = refl
+
+cong₂ : ∀ (f : a → b → c) {x y u v} → x ≡ y → u ≡ v → f x u ≡ f y v
+cong₂ f refl refl = refl
+
+sym : ∀ {A : Set} {x y : A} → x ≡ y → y ≡ x
+sym refl = refl
+
+trans : ∀ {A : Set} {x y z : A} → x ≡ y → y ≡ z → x ≡ z
+trans refl refl = refl
+
+subst : ∀ {A : Set} (P : A → Set) {x y : A} → x ≡ y → P x → P y
+subst P refl z = z
+
+--------------------------------------------------
+-- Scary Things
+
+trustMe : ∀ {a} {A : Set a} {x y : A} → x ≡ y
+trustMe = primTrustMe
+
+--------------------------------------------------
+-- ≡-Reasoning
+
+infix  1 begin_
+infixr 2 _≡⟨⟩_ step-≡ step-≡˘
+infix  3 _∎
+
+begin_ : ∀{x y : a} → x ≡ y → x ≡ y
+begin_ x≡y = x≡y
+
+_≡⟨⟩_ : ∀ (x {y} : a) → x ≡ y → x ≡ y
+_ ≡⟨⟩ x≡y = x≡y
+
+step-≡ : ∀ (x {y z} : a) → y ≡ z → x ≡ y → x ≡ z
+step-≡ _ y≡z x≡y = trans x≡y y≡z
+
+step-≡˘ : ∀ (x {y z} : a) → y ≡ z → y ≡ x → x ≡ z
+step-≡˘ _ y≡z y≡x = trans (sym y≡x) y≡z
+
+_∎ : ∀ (x : a) → x ≡ x
+_∎ _ = refl
+
+syntax step-≡  x y≡z x≡y = x ≡⟨  x≡y ⟩ y≡z
+syntax step-≡˘ x y≡z y≡x = x ≡˘⟨ y≡x ⟩ y≡z
+
+
+-------------------------------------------------
+-- Utility Functions
+
+subst0 : {@0 a : Set} (@0 p : @0 a → Set) {@0 x y : a} → @0 x ≡ y → p x → p y
+subst0 p refl z = z
+{-# COMPILE AGDA2HS subst0 transparent #-}
+
\ No newline at end of file diff --git a/test/Haskell.Law.Functor.Def.html b/test/Haskell.Law.Functor.Def.html new file mode 100644 index 00000000..36b550e7 --- /dev/null +++ b/test/Haskell.Law.Functor.Def.html @@ -0,0 +1,26 @@ + +Haskell.Law.Functor.Def
module Haskell.Law.Functor.Def where
+
+open import Haskell.Prim
+open import Haskell.Prim.Tuple
+
+open import Haskell.Prim.Functor
+
+record IsLawfulFunctor (F : Set → Set) ⦃ iFuncF : Functor F ⦄ : Set₁ where
+  field
+    -- Identity: fmap id == id
+    identity : (fa : F a) → (fmap id) fa ≡ id fa
+
+    -- Composition: fmap (f . g) == fmap f . fmap g
+    composition : (fa : F a) (f : a → b) (g : b → c)
+      → fmap (g ∘ f) fa ≡ (fmap g ∘ fmap f) fa
+
+open IsLawfulFunctor ⦃ ... ⦄ public
+
+instance postulate
+  iLawfulFunctorFun : IsLawfulFunctor (λ b → a → b)
+
+  iLawfulFunctorTuple₂ : IsLawfulFunctor (a ×_)
+
+  iLawfulFunctorTuple₃ : IsLawfulFunctor (a × b ×_)
+
\ No newline at end of file diff --git a/test/Haskell.Law.Functor.Either.html b/test/Haskell.Law.Functor.Either.html new file mode 100644 index 00000000..25648bf3 --- /dev/null +++ b/test/Haskell.Law.Functor.Either.html @@ -0,0 +1,16 @@ + +Haskell.Law.Functor.Either
module Haskell.Law.Functor.Either where
+
+open import Haskell.Prim
+open import Haskell.Prim.Either
+
+open import Haskell.Prim.Functor
+
+open import Haskell.Law.Functor.Def
+
+instance
+  iLawfulFunctorEither : IsLawfulFunctor (Either a)
+  iLawfulFunctorEither .identity = λ { (Left _) → refl; (Right _) → refl }
+
+  iLawfulFunctorEither .composition = λ { (Left _) _ _ → refl; (Right _) _ _ → refl }
+
\ No newline at end of file diff --git a/test/Haskell.Law.Functor.IO.html b/test/Haskell.Law.Functor.IO.html new file mode 100644 index 00000000..1ff3ba6f --- /dev/null +++ b/test/Haskell.Law.Functor.IO.html @@ -0,0 +1,12 @@ + +Haskell.Law.Functor.IO
module Haskell.Law.Functor.IO where
+
+open import Haskell.Prim
+open import Haskell.Prim.IO
+
+open import Haskell.Prim.Functor
+
+open import Haskell.Law.Functor.Def
+
+instance postulate isLawFulFunctorIO : IsLawfulFunctor IO
+
\ No newline at end of file diff --git a/test/Haskell.Law.Functor.List.html b/test/Haskell.Law.Functor.List.html new file mode 100644 index 00000000..ae692c3b --- /dev/null +++ b/test/Haskell.Law.Functor.List.html @@ -0,0 +1,27 @@ + +Haskell.Law.Functor.List
module Haskell.Law.Functor.List where
+
+open import Haskell.Prim
+open import Haskell.Prim.List
+
+open import Haskell.Prim.Functor
+
+open import Haskell.Law.Equality
+open import Haskell.Law.Functor.Def
+
+private
+  identityList : (fa : List a) → (fmap id) fa ≡ id fa
+  identityList [] = refl
+  identityList (x ∷ xs) rewrite identityList xs = refl
+
+  compositionList : (fa : List a) → (f : a → b) → (g : b → c)
+    → fmap (g ∘ f) fa ≡ (fmap g ∘ fmap f) fa
+  compositionList [] _ _ = refl
+  compositionList (x ∷ xs) f g rewrite compositionList xs f g = refl
+
+instance
+  iLawfulFunctorList : IsLawfulFunctor List
+  iLawfulFunctorList = λ where
+    .identity → identityList
+    .composition → compositionList
+
\ No newline at end of file diff --git a/test/Haskell.Law.Functor.Maybe.html b/test/Haskell.Law.Functor.Maybe.html new file mode 100644 index 00000000..5b0cd5be --- /dev/null +++ b/test/Haskell.Law.Functor.Maybe.html @@ -0,0 +1,16 @@ + +Haskell.Law.Functor.Maybe
module Haskell.Law.Functor.Maybe where
+
+open import Haskell.Prim
+open import Haskell.Prim.Maybe
+
+open import Haskell.Prim.Functor
+
+open import Haskell.Law.Functor.Def
+
+instance
+  iLawfulFunctorMaybe : IsLawfulFunctor Maybe
+  iLawfulFunctorMaybe .identity = λ { Nothing → refl; (Just _) → refl }
+
+  iLawfulFunctorMaybe .composition = λ { Nothing _ _ → refl; (Just _) _ _ → refl }
+
\ No newline at end of file diff --git a/test/Haskell.Law.Functor.html b/test/Haskell.Law.Functor.html new file mode 100644 index 00000000..ca31b866 --- /dev/null +++ b/test/Haskell.Law.Functor.html @@ -0,0 +1,9 @@ + +Haskell.Law.Functor
module Haskell.Law.Functor where
+
+open import Haskell.Law.Functor.Def    public
+open import Haskell.Law.Functor.Either public
+open import Haskell.Law.Functor.IO     public
+open import Haskell.Law.Functor.List   public
+open import Haskell.Law.Functor.Maybe  public
+
\ No newline at end of file diff --git a/test/Haskell.Law.Int.html b/test/Haskell.Law.Int.html new file mode 100644 index 00000000..cd2651ee --- /dev/null +++ b/test/Haskell.Law.Int.html @@ -0,0 +1,11 @@ + +Haskell.Law.Int
module Haskell.Law.Int where
+
+open import Haskell.Prim
+open import Haskell.Prim.Int using ( int64 )
+
+open import Haskell.Law.Def
+
+int64-injective : Injective int64
+int64-injective refl = refl 
+
\ No newline at end of file diff --git a/test/Haskell.Law.Integer.html b/test/Haskell.Law.Integer.html new file mode 100644 index 00000000..c8cbd4ce --- /dev/null +++ b/test/Haskell.Law.Integer.html @@ -0,0 +1,13 @@ + +Haskell.Law.Integer
module Haskell.Law.Integer where
+
+open import Haskell.Prim
+
+open import Haskell.Law.Def
+
+pos-injective : Injective pos
+pos-injective refl = refl
+
+neg-injective : Injective negsuc
+neg-injective refl = refl
+
\ No newline at end of file diff --git a/test/Haskell.Law.List.html b/test/Haskell.Law.List.html new file mode 100644 index 00000000..ccedda74 --- /dev/null +++ b/test/Haskell.Law.List.html @@ -0,0 +1,147 @@ + +Haskell.Law.List
module Haskell.Law.List where
+
+open import Haskell.Law.Equality
+open import Haskell.Prim renaming (addNat to _+ₙ_)
+open import Haskell.Prim.Foldable
+open import Haskell.Prim.List
+open import Haskell.Prim.Applicative
+
+[]≠∷ : ∀ x (xs : List a) → [] ≠ x ∷ xs
+[]≠∷ x xs ()
+
+--------------------------------------------------
+-- _∷_
+
+module _ {x y : a} {xs ys : List a} where  
+  ∷-injective-left : x ∷ xs ≡ y ∷ ys → x ≡ y
+  ∷-injective-left refl = refl
+
+  ∷-injective-right : x ∷ xs ≡ y ∷ ys → xs ≡ ys
+  ∷-injective-right refl = refl
+
+--------------------------------------------------
+-- map
+
+map-id : (xs : List a) → map id xs ≡ xs
+map-id []       = refl
+map-id (x ∷ xs) = cong (x ∷_) (map-id xs)
+
+map-++ : ∀ (f : a → b) xs ys → map f (xs ++ ys) ≡ map f xs ++ map f ys
+map-++ f [] ys       = refl
+map-++ f (x ∷ xs) ys = cong (f x ∷_) (map-++ f xs ys)
+
+lengthMap : ∀ (f : a → b) xs → lengthNat (map f xs) ≡ lengthNat xs
+lengthMap f []       = refl
+lengthMap f (x ∷ xs) = cong suc (lengthMap f xs)
+
+map-∘ : ∀ (g : b → c) (f : a → b) xs → map (g ∘ f) xs ≡ (map g ∘ map f) xs
+map-∘ g f []       = refl
+map-∘ g f (x ∷ xs) = cong (_ ∷_) (map-∘ g f xs)
+
+map-concatMap : ∀ (f : a → b) (xs : List a) → (map f xs) ≡ concatMap (λ g → f g ∷ []) xs
+map-concatMap f [] = refl
+map-concatMap f (x ∷ xs) 
+  rewrite map-concatMap f xs
+  = refl
+
+map-<*>-recomp : {a b c : Set} → (xs : List (a → b)) → (ys : List a) → (u : (b → c))  
+  → ((map (u ∘_) xs) <*> ys) ≡ map u (xs <*> ys)
+map-<*>-recomp [] _ _  = refl
+map-<*>-recomp (x ∷ xs) ys u 
+  rewrite map-∘ u x ys
+    | map-++ u (map x ys) (xs <*> ys)
+    | map-<*>-recomp  xs ys u
+  = refl
+
+--------------------------------------------------
+-- _++_
+
+lengthNat-++ : ∀ (xs : List a) {ys} →
+            lengthNat (xs ++ ys) ≡ lengthNat xs +ₙ lengthNat ys
+lengthNat-++ []       = refl
+lengthNat-++ (x ∷ xs) = cong suc (lengthNat-++ xs)
+
+++-[] : ∀ (xs : List a) → xs ++ [] ≡ xs
+++-[] [] = refl
+++-[] (x ∷ xs) rewrite ++-[] xs = refl
+
+[]-++ : ∀ (xs : List a) → [] ++ xs ≡ xs
+[]-++ xs = refl
+
+++-assoc : ∀ (xs ys zs : List a) → (xs ++ ys) ++ zs ≡ xs ++ (ys ++ zs)
+++-assoc [] ys zs = refl
+++-assoc (x ∷ xs) ys zs rewrite ++-assoc xs ys zs = refl
+
+++-∷-assoc : ∀ xs y (ys : List a) → xs ++ y ∷ ys ≡ (xs ++ y ∷ []) ++ ys
+++-∷-assoc [] y ys = refl
+++-∷-assoc (x ∷ xs) y ys = cong (x ∷_) (++-∷-assoc xs y ys)
+
+∷-++-assoc : ∀ x xs (ys : List a) → (x ∷ xs) ++ ys ≡ x ∷ (xs ++ ys)
+∷-++-assoc x xs ys = refl
+
+++-identity-right-unique : ∀ (xs : List a) {ys} → xs ≡ xs ++ ys → ys ≡ []
+++-identity-right-unique []       refl = refl
+++-identity-right-unique (x ∷ xs) eq   =
+  ++-identity-right-unique xs (∷-injective-right eq)
+
+++-identity-left-unique : ∀ {xs} (ys : List a) → xs ≡ ys ++ xs → ys ≡ []
+++-identity-left-unique               []       _  = refl
+++-identity-left-unique {xs = x ∷ xs} (y ∷ ys) eq
+  with ++-identity-left-unique (ys ++ (x ∷ [])) (begin
+        xs                  ≡⟨ ∷-injective-right eq ⟩
+        ys ++ x ∷ xs        ≡⟨ sym (++-assoc ys (x ∷ []) xs) ⟩
+        (ys ++ x ∷ []) ++ xs ∎)
+++-identity-left-unique {xs = x ∷ xs} (y ∷ []   ) eq | ()
+++-identity-left-unique {xs = x ∷ xs} (y ∷ _ ∷ _) eq | ()
+
+++-cancel-left : ∀ (xs ys : List a) {zs} → xs ++ ys ≡ xs ++ zs → ys ≡ zs
+++-cancel-left []       ys eq = eq
+++-cancel-left (x ∷ xs) ys eq = ++-cancel-left xs ys (∷-injective-right eq)
+
+++-cancel-right : ∀ (xs ys : List a) {zs} → xs ++ zs ≡ ys ++ zs → xs ≡ ys
+++-cancel-right []       []       eq = refl
+++-cancel-right (x ∷ xs) []       eq = ++-identity-left-unique (x ∷ xs) (sym eq)
+++-cancel-right []       (y ∷ ys) eq = sym $ ++-identity-left-unique (y ∷ ys) eq
+++-cancel-right (x ∷ xs) (y ∷ ys) eq 
+  rewrite ∷-injective-left eq = cong (y ∷_) $ ++-cancel-right xs ys (∷-injective-right eq)
+
+++-conical-left : (xs ys : List a) → xs ++ ys ≡ [] → xs ≡ []
+++-conical-left [] _ refl = refl
+
+++-conical-right : (xs ys : List a) → xs ++ ys ≡ [] → ys ≡ []
+++-conical-right [] _ refl = refl
+
+∷-not-identity : ∀ x (xs ys : List a) → (x ∷ xs) ++ ys ≡ ys → ⊥
+∷-not-identity x xs ys eq = []≠∷ x xs (sym $ ++-identity-left-unique (x ∷ xs) (sym eq))
+
+concatMap-++-distr : ∀ (xs ys : List a) (f : a → List b) → 
+  ((concatMap f xs) ++ (concatMap f ys)) ≡ (concatMap f (xs ++ ys))
+concatMap-++-distr [] ys f = refl
+concatMap-++-distr (x ∷ xs) ys f
+  rewrite ++-assoc (f x) (concatMap f xs) (concatMap f ys)
+  | concatMap-++-distr xs ys f
+ = refl
+
+--------------------------------------------------
+-- foldr
+
+foldr-universal : ∀ (h : List a → b) f e → (h [] ≡ e) →
+                  (∀ x xs → h (x ∷ xs) ≡ f x (h xs)) →
+                  ∀ xs → h xs ≡ foldr f e xs
+foldr-universal h f e base step []       = base
+foldr-universal h f e base step (x ∷ xs) rewrite step x xs = cong (f x) (foldr-universal h f e base step xs) 
+
+foldr-cong : ∀ {f g : a → b → b} {d e : b} →
+            (∀ x y → f x y ≡ g x y) → d ≡ e →
+             ∀ (xs : List a) → foldr f d xs ≡ foldr g e xs
+foldr-cong f≡g d≡e []       = d≡e
+foldr-cong f≡g d≡e (x ∷ xs) rewrite foldr-cong f≡g d≡e xs = f≡g x _
+
+foldr-fusion : (h : b → c) {f : a → b → b} {g : a → c → c} (e : b) →
+               (∀ x y → h (f x y) ≡ g x (h y)) →
+               ∀ (xs : List a) → h (foldr f e xs) ≡ foldr g (h e) xs
+foldr-fusion h {f} {g} e fuse =
+  foldr-universal (h ∘ foldr f e) g (h e) refl
+                  (λ x xs → fuse x (foldr f e xs))
+
\ No newline at end of file diff --git a/test/Haskell.Law.Maybe.html b/test/Haskell.Law.Maybe.html new file mode 100644 index 00000000..5cb841dd --- /dev/null +++ b/test/Haskell.Law.Maybe.html @@ -0,0 +1,11 @@ + +Haskell.Law.Maybe
module Haskell.Law.Maybe where
+
+open import Haskell.Prim
+open import Haskell.Prim.Maybe
+
+open import Haskell.Law.Def
+
+Just-injective : Injective (Just {a = a})
+Just-injective refl = refl
+
\ No newline at end of file diff --git a/test/Haskell.Law.Monad.Def.html b/test/Haskell.Law.Monad.Def.html new file mode 100644 index 00000000..44df8f6e --- /dev/null +++ b/test/Haskell.Law.Monad.Def.html @@ -0,0 +1,48 @@ + +Haskell.Law.Monad.Def
module Haskell.Law.Monad.Def where
+
+open import Haskell.Prim
+
+open import Haskell.Prim.Applicative
+open import Haskell.Prim.Functor
+open import Haskell.Prim.Monad
+open import Haskell.Prim.Monoid
+open import Haskell.Prim.Tuple
+
+open import Haskell.Law.Applicative
+
+record IsLawfulMonad (F : Set → Set) ⦃ iMonadF : Monad F ⦄ : Set₁ where
+  field
+    overlap ⦃ super ⦄ : IsLawfulApplicative F
+
+    -- Left identity: return a >>= k = k a
+    leftIdentity : {a : Set} → (a' : a) (k : a → F b) → ((return a') >>= k) ≡ k a'
+
+    -- Right identity: m >>= return = m
+    rightIdentity : {a : Set} → (ma : F a) → (ma >>= return) ≡ ma
+
+    -- Associativity: m >>= (\x -> k x >>= h) = (m >>= k) >>= h
+    associativity : {a b c : Set} → (ma : F a) (f : a → F b) (g : b → F c)
+      → (ma >>= (λ x → f x >>= g)) ≡ ((ma >>= f) >>= g)
+
+    -- pure = return
+    pureIsReturn : (a' : a) → pure a' ≡ (Monad.return iMonadF a')
+    -- m1 <*> m2 = m1 >>= (\x1 -> m2 >>= (\x2 -> return (x1 x2)))
+    sequence2bind : {a b : Set} → (mab : F (a → b)) (ma : F a)
+      → (mab <*> ma) ≡ (mab >>= (λ x1 → (ma >>= (λ x2 → return (x1 x2)))))
+
+    -- fmap f xs  =  xs >>= return . f
+    fmap2bind : {a b : Set} → (f : a → b) (ma : F a)
+      → fmap f ma ≡ (ma >>= (return ∘ f))
+    -- (>>) = (*>)
+    rSequence2rBind : (ma : F a) → (mb : F b) → (ma *> mb) ≡ (ma >> mb)
+
+open IsLawfulMonad ⦃ ... ⦄ public
+
+instance postulate
+  iLawfulMonadFun : IsLawfulMonad (λ b → a → b)
+
+  iLawfulMonadTuple₂ : ⦃ Monoid a ⦄ → Monad (a ×_)
+
+  iLawfulMonadTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Monad (a × b ×_)
+
\ No newline at end of file diff --git a/test/Haskell.Law.Monad.Either.html b/test/Haskell.Law.Monad.Either.html new file mode 100644 index 00000000..4153d6d8 --- /dev/null +++ b/test/Haskell.Law.Monad.Either.html @@ -0,0 +1,36 @@ + +Haskell.Law.Monad.Either
module Haskell.Law.Monad.Either where
+
+open import Haskell.Prim
+open import Haskell.Prim.Either
+
+open import Haskell.Prim.Monad
+
+open import Haskell.Law.Monad.Def
+
+open import Haskell.Law.Applicative.Either
+
+instance
+  iLawfulMonadEither : IsLawfulMonad (Either a)
+  iLawfulMonadEither .leftIdentity _ _ = refl
+
+  iLawfulMonadEither .rightIdentity = λ { (Left _) → refl; (Right _) → refl }
+
+  iLawfulMonadEither .associativity = λ { (Left _) _ _ → refl; (Right _) _ _ → refl }
+
+  iLawfulMonadEither .pureIsReturn _ = refl
+
+  iLawfulMonadEither .sequence2bind =
+    λ { (Left _)  _         → refl
+      ; (Right _) (Left _)  → refl
+      ; (Right _) (Right _) → refl
+      }
+
+  iLawfulMonadEither .fmap2bind = λ { _ (Left _) → refl; _ (Right _) → refl }
+
+  iLawfulMonadEither .rSequence2rBind =
+    λ { (Left _)  _         → refl
+      ; (Right _) (Left _)  → refl
+      ; (Right _) (Right _) → refl
+      }
+
\ No newline at end of file diff --git a/test/Haskell.Law.Monad.IO.html b/test/Haskell.Law.Monad.IO.html new file mode 100644 index 00000000..51d1f9b2 --- /dev/null +++ b/test/Haskell.Law.Monad.IO.html @@ -0,0 +1,14 @@ + +Haskell.Law.Monad.IO
module Haskell.Law.Monad.IO where
+
+open import Haskell.Prim
+open import Haskell.Prim.IO
+
+open import Haskell.Prim.Monad
+
+open import Haskell.Law.Monad.Def
+
+open import Haskell.Law.Applicative.IO
+
+instance postulate iLawfulMonadIO : IsLawfulMonad IO
+
\ No newline at end of file diff --git a/test/Haskell.Law.Monad.List.html b/test/Haskell.Law.Monad.List.html new file mode 100644 index 00000000..d14a86bc --- /dev/null +++ b/test/Haskell.Law.Monad.List.html @@ -0,0 +1,50 @@ + +Haskell.Law.Monad.List
module Haskell.Law.Monad.List where
+
+open import Haskell.Prim
+open import Haskell.Prim.List
+
+open import Haskell.Prim.Monad
+
+open import Haskell.Law.Monad.Def
+open import Haskell.Law.List
+
+open import Haskell.Law.Applicative.List
+
+instance
+  iLawfulMonadList :  IsLawfulMonad List
+  iLawfulMonadList .leftIdentity a k 
+    rewrite ++-[] (k a)
+    = refl
+
+  iLawfulMonadList .rightIdentity [] = refl
+  iLawfulMonadList .rightIdentity (_ ∷ xs)
+    rewrite rightIdentity xs
+    = refl
+
+  iLawfulMonadList .associativity [] f g = refl
+  iLawfulMonadList .associativity (x ∷ xs) f g
+    rewrite associativity xs f g
+      | concatMap-++-distr (f x) (xs >>= f) g
+    = refl  
+
+  iLawfulMonadList .pureIsReturn _ = refl
+
+  iLawfulMonadList .sequence2bind [] _ = refl
+  iLawfulMonadList .sequence2bind (f ∷ fs) xs 
+    rewrite sequence2bind fs xs
+      | map-concatMap f xs
+    = refl
+
+  iLawfulMonadList .fmap2bind f [] = refl
+  iLawfulMonadList .fmap2bind f (_ ∷ xs)
+    rewrite fmap2bind f xs
+    = refl
+
+  iLawfulMonadList .rSequence2rBind [] mb = refl
+  iLawfulMonadList .rSequence2rBind (x ∷ ma) mb
+    rewrite rSequence2rBind ma mb 
+      | map-id mb 
+    = refl
+
+
\ No newline at end of file diff --git a/test/Haskell.Law.Monad.Maybe.html b/test/Haskell.Law.Monad.Maybe.html new file mode 100644 index 00000000..f79688f8 --- /dev/null +++ b/test/Haskell.Law.Monad.Maybe.html @@ -0,0 +1,37 @@ + +Haskell.Law.Monad.Maybe
module Haskell.Law.Monad.Maybe where
+
+open import Haskell.Prim
+open import Haskell.Prim.Maybe
+
+open import Haskell.Prim.Monad
+
+open import Haskell.Law.Monad.Def
+
+open import Haskell.Law.Applicative.Maybe
+
+instance
+  iLawfulMonadMaybe : IsLawfulMonad Maybe
+  iLawfulMonadMaybe .leftIdentity _ _ = refl
+
+  iLawfulMonadMaybe .rightIdentity = λ { Nothing → refl; (Just _) → refl }
+
+  iLawfulMonadMaybe .associativity = λ { Nothing _ _ → refl; (Just _) _ _ → refl }
+
+  iLawfulMonadMaybe .pureIsReturn _ = refl
+
+  iLawfulMonadMaybe .sequence2bind =
+    λ { Nothing  _        → refl
+      ; (Just _) Nothing  → refl
+      ; (Just _) (Just _) → refl
+      }
+
+  iLawfulMonadMaybe .fmap2bind = λ { _ Nothing → refl; _ (Just _) → refl }
+
+  iLawfulMonadMaybe .rSequence2rBind =
+    λ { Nothing  _        → refl
+      ; (Just _) Nothing  → refl
+      ; (Just _) (Just _) → refl
+      }
+
+
\ No newline at end of file diff --git a/test/Haskell.Law.Monad.html b/test/Haskell.Law.Monad.html new file mode 100644 index 00000000..783afc32 --- /dev/null +++ b/test/Haskell.Law.Monad.html @@ -0,0 +1,9 @@ + +Haskell.Law.Monad
module Haskell.Law.Monad where
+
+open import Haskell.Law.Monad.Def    public
+open import Haskell.Law.Monad.Either public
+open import Haskell.Law.Monad.IO     public
+open import Haskell.Law.Monad.List   public
+open import Haskell.Law.Monad.Maybe  public
+
\ No newline at end of file diff --git a/test/Haskell.Law.Monoid.Def.html b/test/Haskell.Law.Monoid.Def.html new file mode 100644 index 00000000..77602014 --- /dev/null +++ b/test/Haskell.Law.Monoid.Def.html @@ -0,0 +1,40 @@ + +Haskell.Law.Monoid.Def
module Haskell.Law.Monoid.Def where
+
+open import Haskell.Prim
+open import Haskell.Prim.Tuple
+
+open import Haskell.Prim.Foldable
+open import Haskell.Prim.Monoid
+
+open import Haskell.Law.Semigroup.Def
+
+record IsLawfulMonoid (a : Set) ⦃ iMonoidA : Monoid a ⦄ : Set₁ where
+  field
+    overlap ⦃ super ⦄ : IsLawfulSemigroup a
+
+    -- Right identity: x <> mempty = x
+    rightIdentity : (x : a) → x <> mempty ≡ x
+
+    -- Left identity: mempty <> x = x
+    leftIdentity : (x : a) → mempty <> x ≡ x
+
+    -- Concatenation: mconcat = foldr (<>) mempty
+    concatenation : (xs : List a) → mconcat xs ≡ foldr _<>_ mempty xs
+
+open IsLawfulMonoid ⦃ ... ⦄ public
+
+postulate instance
+  iLawfulMonoidFun : ⦃ iSemB : Monoid b ⦄ → ⦃ IsLawfulMonoid b ⦄ → IsLawfulMonoid (a → b)
+
+  iLawfulMonoidUnit : IsLawfulMonoid ⊤
+
+  iLawfulMonoidTuple₂ : ⦃ iSemA : Monoid a ⦄ ⦃ iSemB : Monoid b ⦄
+                      → ⦃ IsLawfulMonoid a ⦄ → ⦃ IsLawfulMonoid b ⦄
+                      → IsLawfulMonoid (a × b)
+
+  iLawfulMonoidTuple₃ : ⦃ iSemA : Monoid a ⦄ ⦃ iSemB : Monoid b ⦄ ⦃ iSemC : Monoid c ⦄
+                      → ⦃ IsLawfulMonoid a ⦄ → ⦃ IsLawfulMonoid b ⦄ → ⦃ IsLawfulMonoid c ⦄
+                      → IsLawfulMonoid (a × b × c)
+
+
\ No newline at end of file diff --git a/test/Haskell.Law.Monoid.List.html b/test/Haskell.Law.Monoid.List.html new file mode 100644 index 00000000..23c3d9d9 --- /dev/null +++ b/test/Haskell.Law.Monoid.List.html @@ -0,0 +1,31 @@ + +Haskell.Law.Monoid.List
module Haskell.Law.Monoid.List where
+
+open import Haskell.Prim
+open import Haskell.Prim.List
+
+open import Haskell.Prim.Monoid
+
+open import Haskell.Law.List
+open import Haskell.Law.Monoid.Def
+open import Haskell.Law.Semigroup.Def
+open import Haskell.Law.Semigroup.List
+
+instance
+  iLawfulMonoidList : IsLawfulMonoid (List a)
+  iLawfulMonoidList .rightIdentity [] = refl
+  iLawfulMonoidList .rightIdentity (x ∷ xs)
+    rewrite ++-[] (x ∷ xs)
+    = refl
+
+  iLawfulMonoidList .leftIdentity [] = refl
+  iLawfulMonoidList .leftIdentity (x ∷ xs)
+    rewrite ++-[] (x ∷ xs)
+    = refl
+
+  iLawfulMonoidList .concatenation [] = refl
+  iLawfulMonoidList .concatenation (x ∷ xs) 
+    rewrite ++-[] (x ∷ xs)
+      | concatenation xs
+    = refl
+
\ No newline at end of file diff --git a/test/Haskell.Law.Monoid.Maybe.html b/test/Haskell.Law.Monoid.Maybe.html new file mode 100644 index 00000000..4683cdd4 --- /dev/null +++ b/test/Haskell.Law.Monoid.Maybe.html @@ -0,0 +1,23 @@ + +Haskell.Law.Monoid.Maybe
module Haskell.Law.Monoid.Maybe where
+
+open import Haskell.Prim
+open import Haskell.Prim.Maybe
+
+open import Haskell.Prim.Monoid
+
+open import Haskell.Law.Monoid.Def
+open import Haskell.Law.Semigroup.Def
+open import Haskell.Law.Semigroup.Maybe
+
+instance
+  iLawfulMonoidMaybe : ⦃ iMonoidA : Monoid a ⦄ → ⦃ iLawfulMonoidA : IsLawfulMonoid a ⦄ → IsLawfulMonoid (Maybe a)
+  iLawfulMonoidMaybe .rightIdentity = λ { Nothing → refl; (Just _) → refl }
+
+  iLawfulMonoidMaybe .leftIdentity = λ { Nothing → refl; (Just _) → refl }
+
+  iLawfulMonoidMaybe .concatenation [] = refl
+  iLawfulMonoidMaybe .concatenation (x ∷ xs) 
+    rewrite (concatenation xs)
+    = refl
+
\ No newline at end of file diff --git a/test/Haskell.Law.Monoid.html b/test/Haskell.Law.Monoid.html new file mode 100644 index 00000000..616b1cde --- /dev/null +++ b/test/Haskell.Law.Monoid.html @@ -0,0 +1,12 @@ + +Haskell.Law.Monoid
module Haskell.Law.Monoid where
+
+open import Haskell.Law.Semigroup.Def    public
+open import Haskell.Law.Semigroup.Either public
+open import Haskell.Law.Semigroup.List   public
+open import Haskell.Law.Semigroup.Maybe  public
+
+open import Haskell.Law.Monoid.Def       public
+open import Haskell.Law.Monoid.List      public
+open import Haskell.Law.Monoid.Maybe     public
+
\ No newline at end of file diff --git a/test/Haskell.Law.Nat.html b/test/Haskell.Law.Nat.html new file mode 100644 index 00000000..8acdbd85 --- /dev/null +++ b/test/Haskell.Law.Nat.html @@ -0,0 +1,53 @@ + +Haskell.Law.Nat
module Haskell.Law.Nat where
+
+open import Haskell.Prim
+open import Haskell.Prim.Num
+
+open import Haskell.Law.Def
+open import Haskell.Law.Equality
+
+suc-injective : Injective suc
+suc-injective refl = refl
+
+{-|
+The canonical formalization of the
+less-than-or-equal-to relation for natural numbers.
+-}
+data _≤_ : Nat → Nat → Set where
+  z≤n : ∀ {n}                 → zero  ≤ n
+  s≤s : ∀ {m n} (m≤n : m ≤ n) → suc m ≤ suc n
+
+≤-refl : ∀ (x : Nat) → x ≤ x
+≤-refl zero    = z≤n
+≤-refl (suc x) = s≤s (≤-refl x)
+
+≤-antisym : ∀ {x y : Nat}
+  → x ≤ y
+  → y ≤ x
+    -----
+  → x ≡ y
+≤-antisym z≤n       z≤n       = refl
+≤-antisym (s≤s x≤y) (s≤s y≤x) = cong suc (≤-antisym x≤y y≤x)
+
+≤-trans : ∀ {x y z : Nat}
+  → x ≤ y
+  → y ≤ z
+    -----
+  → x ≤ z
+≤-trans z≤n y≤z = z≤n
+≤-trans (s≤s x≤y) (s≤s y≤z) = s≤s (≤-trans x≤y y≤z)
+
+x≤x+1 : ∀ (x : Nat) → x ≤ suc x
+x≤x+1 zero    = z≤n
+x≤x+1 (suc x) = s≤s (x≤x+1 x)
+
+x+[y-x]≡y : ∀ (x y : Nat) → x ≤ y → x + monusNat y x ≡ y
+x+[y-x]≡y   zero       y       x≤y  = refl
+x+[y-x]≡y (suc x) (suc y) (s≤s x≤y) = cong suc (x+[y-x]≡y x y x≤y)
+
+y-x≤y : ∀ (x y : Nat) → monusNat y x ≤ y
+y-x≤y zero         y  = ≤-refl y
+y-x≤y (suc x)   zero  = z≤n
+y-x≤y (suc x) (suc y) = ≤-trans (y-x≤y x y) (x≤x+1 y)
+
\ No newline at end of file diff --git a/test/Haskell.Law.Ord.Bool.html b/test/Haskell.Law.Ord.Bool.html new file mode 100644 index 00000000..35e2f602 --- /dev/null +++ b/test/Haskell.Law.Ord.Bool.html @@ -0,0 +1,70 @@ + +Haskell.Law.Ord.Bool
module Haskell.Law.Ord.Bool where
+
+open import Haskell.Prim
+open import Haskell.Prim.Ord
+
+open import Haskell.Law.Eq
+open import Haskell.Law.Equality
+open import Haskell.Law.Ord.Def
+
+instance
+  iLawfulOrdBool : IsLawfulOrd Bool
+
+  iLawfulOrdBool .comparability False False = refl
+  iLawfulOrdBool .comparability False True  = refl
+  iLawfulOrdBool .comparability True  False = refl
+  iLawfulOrdBool .comparability True  True  = refl
+
+  iLawfulOrdBool .transitivity False False False _ = refl
+  iLawfulOrdBool .transitivity False False True  _ = refl
+  iLawfulOrdBool .transitivity False True  True  _ = refl
+  iLawfulOrdBool .transitivity True  True  True  _ = refl
+
+  iLawfulOrdBool .reflexivity False = refl
+  iLawfulOrdBool .reflexivity True  = refl
+
+  iLawfulOrdBool .antisymmetry False False _ = refl
+  iLawfulOrdBool .antisymmetry True  True  _ = refl
+
+  iLawfulOrdBool .lte2gte False False = refl
+  iLawfulOrdBool .lte2gte False True  = refl
+  iLawfulOrdBool .lte2gte True  False = refl
+  iLawfulOrdBool .lte2gte True  True  = refl
+
+  iLawfulOrdBool .lt2LteNeq False False = refl
+  iLawfulOrdBool .lt2LteNeq False True  = refl
+  iLawfulOrdBool .lt2LteNeq True  False = refl
+  iLawfulOrdBool .lt2LteNeq True  True  = refl
+
+  iLawfulOrdBool .lt2gt False False = refl
+  iLawfulOrdBool .lt2gt False True  = refl
+  iLawfulOrdBool .lt2gt True  False = refl
+  iLawfulOrdBool .lt2gt True  True  = refl
+
+  iLawfulOrdBool .compareLt False False = refl
+  iLawfulOrdBool .compareLt False True  = refl
+  iLawfulOrdBool .compareLt True  False = refl
+  iLawfulOrdBool .compareLt True  True  = refl
+
+  iLawfulOrdBool .compareGt False False = refl
+  iLawfulOrdBool .compareGt False True  = refl
+  iLawfulOrdBool .compareGt True  False = refl
+  iLawfulOrdBool .compareGt True  True  = refl
+
+  iLawfulOrdBool .compareEq False False = refl
+  iLawfulOrdBool .compareEq False True  = refl
+  iLawfulOrdBool .compareEq True  False = refl
+  iLawfulOrdBool .compareEq True  True  = refl
+
+  iLawfulOrdBool .min2if False False = refl
+  iLawfulOrdBool .min2if False True  = refl
+  iLawfulOrdBool .min2if True  False = refl
+  iLawfulOrdBool .min2if True  True  = refl
+
+  iLawfulOrdBool .max2if False False = refl
+  iLawfulOrdBool .max2if False True  = refl
+  iLawfulOrdBool .max2if True  False = refl
+  iLawfulOrdBool .max2if True  True  = refl
+
+
\ No newline at end of file diff --git a/test/Haskell.Law.Ord.Def.html b/test/Haskell.Law.Ord.Def.html new file mode 100644 index 00000000..7c917f89 --- /dev/null +++ b/test/Haskell.Law.Ord.Def.html @@ -0,0 +1,205 @@ + +Haskell.Law.Ord.Def
module Haskell.Law.Ord.Def where
+
+open import Haskell.Prim
+open import Haskell.Prim.Ord
+open import Haskell.Prim.Bool
+open import Haskell.Prim.Int
+open import Haskell.Prim.Word
+open import Haskell.Prim.Integer
+open import Haskell.Prim.Double
+open import Haskell.Prim.Tuple
+open import Haskell.Prim.Monoid
+open import Haskell.Prim.List
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Either
+
+open import Haskell.Prim.Eq
+open import Haskell.Law.Eq
+
+open import Haskell.Law.Bool
+open import Haskell.Law.Equality
+
+record IsLawfulOrd (a : Set) ⦃ iOrd : Ord a ⦄ : Set₁ where
+  field
+    overlap ⦃ super ⦄ : IsLawfulEq a
+
+    -- Comparability: x <= y || y <= x = True
+    comparability : ∀ (x y : a) → (x <= y || y <= x) ≡ True
+
+    -- Transitivity: if x <= y && y <= z = True, then x <= z = True
+    transitivity :  ∀ ( x y z : a ) → ((x <= y) && (y <= z)) ≡ True → (x <= z) ≡ True
+
+    -- Reflexivity: x <= x = True
+    reflexivity : ∀ (x : a) → (x <= x) ≡ True
+
+    -- Antisymmetry: if x <= y && y <= x = True, then x == y = True
+    antisymmetry : ∀ (x y : a) → ((x <= y) && (y <= x)) ≡ True → (x == y) ≡ True
+
+    -- x >= y = y <= x
+    lte2gte : ∀ (x y : a) → (x <= y) ≡ (y >= x)
+
+    -- x < y = x <= y && x /= y
+    lt2LteNeq : ∀ (x y : a) → (x < y) ≡ (x <= y && x /= y)
+
+    -- x > y = y < x
+    lt2gt : ∀ (x y : a) → (x < y) ≡ (y > x)
+
+    -- x < y = compare x y == LT
+    compareLt : ∀ (x y : a) → (x < y) ≡ (compare x y == LT)
+
+    -- x > y = compare x y == GT
+    compareGt : ∀ (x y : a) → (x > y) ≡ (compare x y == GT)
+
+    -- x == y = compare x y == EQ
+    compareEq : ∀ (x y : a) → (x == y) ≡ (compare x y == EQ)
+
+    -- min x y == if x <= y then x else y = True
+    min2if : ∀ (x y : a) → ((min x y) == (if (x <= y) then x else y)) ≡ True
+
+    -- max x y == if x >= y then x else y = True
+    max2if : ∀ (x y : a) → ((max x y) == (if (x >= y) then x else y)) ≡ True
+
+open IsLawfulOrd ⦃ ... ⦄ public
+
+--------------------------------------------------
+-- Some more helper laws
+
+eq2nlt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x == y) ≡ True → (x < y) ≡ False
+eq2nlt x y h
+  rewrite compareEq x y
+    | compareLt x y
+    | equality (compare x y) EQ h
+  = refl
+
+eq2ngt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x == y) ≡ True → (x > y) ≡ False
+eq2ngt x y h
+  rewrite compareEq x y
+    | compareGt x y
+    | equality (compare x y) EQ h
+  = refl
+
+lte2LtEq : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x <= y) ≡ (x < y || x == y)
+lte2LtEq x y 
+  rewrite lt2LteNeq x y
+    | compareEq x y
+  with (x <= y) in h₁ | (compare x y) in h₂
+... | False | LT = refl
+... | False | EQ = magic $ exFalso (reflexivity x) $ begin 
+    (x <= x)  ≡⟨ (cong (x <=_) (equality x y (begin 
+      (x == y)            ≡⟨ compareEq x y ⟩ 
+      (compare x y == EQ) ≡⟨ equality' (compare x y) EQ h₂ ⟩ 
+      True                ∎ ) ) ) ⟩
+    (x <= y)  ≡⟨ h₁ ⟩ 
+    False ∎
+... | False | GT = refl
+... | True  | LT = refl
+... | True  | EQ = refl
+... | True  | GT = refl
+
+gte2GtEq : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x >= y) ≡ (x > y || x == y)
+gte2GtEq x y
+  rewrite sym $ lte2gte y x
+    | lte2LtEq y x
+    | eqSymmetry y x
+    | lt2gt y x
+  = refl
+
+gte2nlt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x >= y) ≡ not (x < y)
+gte2nlt x y
+  rewrite gte2GtEq x y
+    | compareGt x y
+    | compareEq x y
+    | compareLt x y
+  with compare x y
+... | GT = refl 
+... | EQ = refl 
+... | LT = refl 
+
+gte2nLT : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x >= y) ≡ (compare x y /= LT)
+gte2nLT x y
+  rewrite gte2nlt x y
+    | compareLt x y
+  = refl
+
+lte2ngt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x <= y) ≡ not (x > y)
+lte2ngt x y
+  rewrite lte2LtEq x y
+    | compareLt x y
+    | compareEq x y
+    | compareGt x y
+  with compare x y
+... | GT = refl 
+... | EQ = refl 
+... | LT = refl 
+
+lte2nGT : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x <= y) ≡ (compare x y /= GT)
+lte2nGT x y
+  rewrite lte2ngt x y
+    | compareGt x y
+  = refl
+
+eq2lte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x == y) ≡ True → (x <= y) ≡ True
+eq2lte x y h
+  rewrite lte2ngt x y
+    | eq2ngt x y h
+  = refl
+
+lt2lte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x < y) ≡ True → (x <= y) ≡ True
+lt2lte x y h = &&-rightTrue' (x < y) (x <= y) (x /= y) (lt2LteNeq x y) h
+
+eq2gte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x == y) ≡ True → (x >= y) ≡ True
+eq2gte x y h
+  rewrite gte2nlt x y
+    | eq2nlt x y h
+  = refl
+
+gt2gte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → (x > y) ≡ True → (x >= y) ≡ True
+gt2gte x y h
+  rewrite sym (lt2gt y x)
+    | sym (lt2lte y x h)
+    | lte2gte y x
+  = refl
+
+--------------------------------------------------
+-- Postulated instances
+
+postulate instance
+  iLawfulOrdNat : IsLawfulOrd Nat
+
+  iLawfulOrdInteger : IsLawfulOrd Integer
+
+  iLawfulOrdInt : IsLawfulOrd Int
+
+  iLawfulOrdWord : IsLawfulOrd Word
+
+  iLawfulOrdDouble : IsLawfulOrd Double
+
+  iLawfulOrdChar : IsLawfulOrd Char
+
+  iLawfulOrdUnit : IsLawfulOrd ⊤
+
+  iLawfulOrdTuple₂ : ⦃ iOrdA : Ord a ⦄ ⦃ iOrdB : Ord b ⦄
+                   → ⦃ IsLawfulOrd a ⦄ → ⦃ IsLawfulOrd b ⦄
+                   → IsLawfulOrd (a × b)
+
+  iLawfulOrdTuple₃ : ⦃ iOrdA : Ord a ⦄ ⦃ iOrdB : Ord b ⦄ ⦃ iOrdC : Ord c ⦄
+                   → ⦃ IsLawfulOrd a ⦄ → ⦃ IsLawfulOrd b ⦄ → ⦃ IsLawfulOrd c ⦄
+                   → IsLawfulOrd (a × b × c)
+
+  iLawfulOrdList : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄ → IsLawfulOrd (List a)
+
+  iLawfulOrdEither : ⦃ iOrdA : Ord a ⦄ → ⦃ iOrdB : Ord b ⦄ →  ⦃ IsLawfulOrd a ⦄ → ⦃ IsLawfulOrd b ⦄ → IsLawfulOrd (Either a b)
+
\ No newline at end of file diff --git a/test/Haskell.Law.Ord.Maybe.html b/test/Haskell.Law.Ord.Maybe.html new file mode 100644 index 00000000..0af6dfa9 --- /dev/null +++ b/test/Haskell.Law.Ord.Maybe.html @@ -0,0 +1,152 @@ + +Haskell.Law.Ord.Maybe
module Haskell.Law.Ord.Maybe where
+
+open import Haskell.Prim
+open import Haskell.Prim.Bool
+open import Haskell.Prim.Eq
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Ord
+
+open import Haskell.Law.Bool
+open import Haskell.Law.Eq
+open import Haskell.Law.Equality hiding ( trustMe )
+open import Haskell.Law.Maybe
+open import Haskell.Law.Ord.Def
+
+compMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : Maybe a) → (x <= y || y <= x) ≡ True
+compMaybe Nothing  Nothing  = refl
+compMaybe Nothing  (Just _) = refl
+compMaybe (Just _) Nothing  = refl
+compMaybe (Just x) (Just y)
+  rewrite sym (lte2nGT x y)
+    | sym (lte2nGT y x)
+  = comparability x y
+
+transMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ ( x y z : Maybe a ) → ((x <= y) && (y <= z)) ≡ True → (x <= z) ≡ True
+transMaybe Nothing  Nothing  Nothing  _ = refl
+transMaybe Nothing  Nothing  (Just _) _ = refl
+transMaybe Nothing  (Just _) (Just _) _ = refl
+transMaybe (Just x) (Just y) Nothing  h
+  = magic ((nequality (GT /= GT) True refl) (&&-rightTrue (compare x y /= GT) (GT /= GT) h))
+transMaybe (Just x) (Just y) (Just z) h
+  rewrite sym (compareGt x z)
+    | sym (lte2nGT x y)
+    | sym (lte2nGT y z)
+    | sym (lte2ngt x z) -- not (x > z) → (x <= z)
+  = transitivity x y z h
+
+reflMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x : Maybe a) → (x <= x) ≡ True
+reflMaybe Nothing = refl
+reflMaybe (Just x)
+  rewrite (equality (compare x x) EQ (trans (sym (compareEq x x)) (eqReflexivity x)))
+  = refl
+
+antisymmetryMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : Maybe a) → ((x <= y) && (y <= x)) ≡ True → (x == y) ≡ True
+antisymmetryMaybe Nothing  Nothing  _ = refl
+antisymmetryMaybe (Just x) (Just y) h
+  rewrite sym (lte2nGT x y)
+    | sym (lte2nGT y x)
+  = antisymmetry x y h
+
+lte2gteMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : Maybe a) → (x <= y) ≡ (y >= x)
+lte2gteMaybe Nothing  Nothing  = refl
+lte2gteMaybe Nothing  (Just _) = refl
+lte2gteMaybe (Just _) Nothing  = refl
+lte2gteMaybe (Just x) (Just y)
+  rewrite sym (compareGt x y)
+    | sym (lte2ngt x y)
+    | lte2gte x y -- IH
+    | gte2nlt y x
+    | compareLt y x
+  = refl
+
+lt2LteNeqMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : Maybe a) → (x < y) ≡ (x <= y && x /= y)
+lt2LteNeqMaybe Nothing  Nothing  = refl
+lt2LteNeqMaybe Nothing  (Just _) = refl
+lt2LteNeqMaybe (Just _) Nothing  = refl
+lt2LteNeqMaybe (Just x) (Just y)
+  rewrite sym (compareLt x y)
+    | lt2LteNeq x y -- IH
+    | lte2ngt x y
+    | compareGt x y
+  = refl
+
+lt2gtMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : Maybe a) → (x < y) ≡ (y > x)
+lt2gtMaybe Nothing  Nothing  = refl
+lt2gtMaybe Nothing  (Just _) = refl
+lt2gtMaybe (Just _) Nothing  = refl
+lt2gtMaybe (Just x) (Just y)
+  rewrite sym (compareLt x y)
+    | lt2gt x y -- IH
+    | compareGt y x
+  = refl
+
+compareLtMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : Maybe a) → (x < y) ≡ (compare x y == LT)
+compareLtMaybe Nothing  Nothing  = refl
+compareLtMaybe Nothing  (Just _) = refl
+compareLtMaybe (Just _) Nothing  = refl
+compareLtMaybe (Just _) (Just _) = refl
+
+compareGtMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : Maybe a) → (x > y) ≡ (compare x y == GT)
+compareGtMaybe Nothing  Nothing  = refl
+compareGtMaybe Nothing  (Just _) = refl
+compareGtMaybe (Just _) Nothing  = refl
+compareGtMaybe (Just _) (Just _) = refl
+
+compareEqMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ iLawfulOrdA : IsLawfulOrd a ⦄
+  → ∀ (x y : Maybe a) → (x == y) ≡ (compare x y == EQ)
+compareEqMaybe Nothing  Nothing  = refl
+compareEqMaybe Nothing  (Just y) = refl
+compareEqMaybe (Just x) Nothing  = refl
+compareEqMaybe (Just x) (Just y) = compareEq x y
+
+min2ifMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : Maybe a) → ((min x y) == (if (x <= y) then x else y)) ≡ True
+min2ifMaybe Nothing  Nothing  = refl
+min2ifMaybe Nothing  (Just _) = refl
+min2ifMaybe (Just _) Nothing = refl
+min2ifMaybe (Just x) (Just y)
+  rewrite ifFlip (compare x y == GT) (Just y) (Just x)
+  = equality'
+      (if (compare x y /= GT) then Just x else Just y)
+      (if (compare x y /= GT) then Just x else Just y)
+      refl
+
+max2ifMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : Maybe a) → ((max x y) == (if (x >= y) then x else y)) ≡ True
+max2ifMaybe Nothing  Nothing  = refl
+max2ifMaybe Nothing  (Just y) = eqReflexivity y
+max2ifMaybe (Just x) Nothing  = eqReflexivity x
+max2ifMaybe (Just x) (Just y)
+  rewrite ifFlip (compare x y == LT) (Just y) (Just x)
+  = equality'
+    (if (compare x y /= LT) then Just x else Just y)
+    (if (compare x y /= LT) then Just x else Just y)
+    refl
+
+instance
+  iLawfulOrdMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄ → IsLawfulOrd (Maybe a)
+  iLawfulOrdMaybe = λ where
+    .comparability → compMaybe
+    .transitivity → transMaybe
+    .reflexivity → reflMaybe
+    .antisymmetry → antisymmetryMaybe
+    .lte2gte → lte2gteMaybe
+    .lt2LteNeq → lt2LteNeqMaybe
+    .lt2gt → lt2gtMaybe
+    .compareLt → compareLtMaybe
+    .compareGt → compareGtMaybe
+    .compareEq → compareEqMaybe
+    .min2if → min2ifMaybe
+    .max2if → max2ifMaybe
+
+
\ No newline at end of file diff --git a/test/Haskell.Law.Ord.Ordering.html b/test/Haskell.Law.Ord.Ordering.html new file mode 100644 index 00000000..e46c5e4a --- /dev/null +++ b/test/Haskell.Law.Ord.Ordering.html @@ -0,0 +1,123 @@ + +Haskell.Law.Ord.Ordering
module Haskell.Law.Ord.Ordering where
+
+open import Haskell.Prim
+open import Haskell.Prim.Ord
+
+open import Haskell.Law.Eq
+open import Haskell.Law.Equality
+open import Haskell.Law.Ord.Def
+
+instance
+  iLawfulOrdOrdering : IsLawfulOrd Ordering
+
+  iLawfulOrdOrdering .comparability LT LT = refl
+  iLawfulOrdOrdering .comparability LT EQ = refl
+  iLawfulOrdOrdering .comparability LT GT = refl
+  iLawfulOrdOrdering .comparability EQ LT = refl
+  iLawfulOrdOrdering .comparability EQ EQ = refl
+  iLawfulOrdOrdering .comparability EQ GT = refl
+  iLawfulOrdOrdering .comparability GT LT = refl
+  iLawfulOrdOrdering .comparability GT EQ = refl
+  iLawfulOrdOrdering .comparability GT GT = refl
+
+  iLawfulOrdOrdering .transitivity LT LT LT _ = refl
+  iLawfulOrdOrdering .transitivity LT LT EQ _ = refl
+  iLawfulOrdOrdering .transitivity LT LT GT _ = refl
+  iLawfulOrdOrdering .transitivity LT EQ EQ _ = refl
+  iLawfulOrdOrdering .transitivity LT EQ GT _ = refl
+  iLawfulOrdOrdering .transitivity LT GT GT _ = refl
+  iLawfulOrdOrdering .transitivity EQ EQ EQ _ = refl
+  iLawfulOrdOrdering .transitivity EQ EQ GT _ = refl
+  iLawfulOrdOrdering .transitivity EQ GT GT _ = refl
+  iLawfulOrdOrdering .transitivity GT GT GT _ = refl
+
+  iLawfulOrdOrdering .reflexivity LT = refl
+  iLawfulOrdOrdering .reflexivity EQ = refl
+  iLawfulOrdOrdering .reflexivity GT = refl
+
+  iLawfulOrdOrdering .antisymmetry LT LT _ = refl
+  iLawfulOrdOrdering .antisymmetry EQ EQ _ = refl
+  iLawfulOrdOrdering .antisymmetry GT GT _ = refl
+
+  iLawfulOrdOrdering .lte2gte LT LT = refl
+  iLawfulOrdOrdering .lte2gte LT EQ = refl
+  iLawfulOrdOrdering .lte2gte LT GT = refl
+  iLawfulOrdOrdering .lte2gte EQ LT = refl
+  iLawfulOrdOrdering .lte2gte EQ EQ = refl
+  iLawfulOrdOrdering .lte2gte EQ GT = refl
+  iLawfulOrdOrdering .lte2gte GT LT = refl
+  iLawfulOrdOrdering .lte2gte GT EQ = refl
+  iLawfulOrdOrdering .lte2gte GT GT = refl
+
+  iLawfulOrdOrdering .lt2LteNeq LT LT = refl
+  iLawfulOrdOrdering .lt2LteNeq LT EQ = refl
+  iLawfulOrdOrdering .lt2LteNeq LT GT = refl
+  iLawfulOrdOrdering .lt2LteNeq EQ LT = refl
+  iLawfulOrdOrdering .lt2LteNeq EQ EQ = refl
+  iLawfulOrdOrdering .lt2LteNeq EQ GT = refl
+  iLawfulOrdOrdering .lt2LteNeq GT LT = refl
+  iLawfulOrdOrdering .lt2LteNeq GT EQ = refl
+  iLawfulOrdOrdering .lt2LteNeq GT GT = refl
+
+  iLawfulOrdOrdering .lt2gt LT LT = refl
+  iLawfulOrdOrdering .lt2gt LT EQ = refl
+  iLawfulOrdOrdering .lt2gt LT GT = refl
+  iLawfulOrdOrdering .lt2gt EQ LT = refl
+  iLawfulOrdOrdering .lt2gt EQ EQ = refl
+  iLawfulOrdOrdering .lt2gt EQ GT = refl
+  iLawfulOrdOrdering .lt2gt GT LT = refl
+  iLawfulOrdOrdering .lt2gt GT EQ = refl
+  iLawfulOrdOrdering .lt2gt GT GT = refl
+
+  iLawfulOrdOrdering .compareLt LT LT = refl
+  iLawfulOrdOrdering .compareLt LT EQ = refl
+  iLawfulOrdOrdering .compareLt LT GT = refl
+  iLawfulOrdOrdering .compareLt EQ LT = refl
+  iLawfulOrdOrdering .compareLt EQ EQ = refl
+  iLawfulOrdOrdering .compareLt EQ GT = refl
+  iLawfulOrdOrdering .compareLt GT LT = refl
+  iLawfulOrdOrdering .compareLt GT EQ = refl
+  iLawfulOrdOrdering .compareLt GT GT = refl
+
+  iLawfulOrdOrdering .compareGt LT LT = refl
+  iLawfulOrdOrdering .compareGt LT EQ = refl
+  iLawfulOrdOrdering .compareGt LT GT = refl
+  iLawfulOrdOrdering .compareGt EQ LT = refl
+  iLawfulOrdOrdering .compareGt EQ EQ = refl
+  iLawfulOrdOrdering .compareGt EQ GT = refl
+  iLawfulOrdOrdering .compareGt GT LT = refl
+  iLawfulOrdOrdering .compareGt GT EQ = refl
+  iLawfulOrdOrdering .compareGt GT GT = refl
+
+  iLawfulOrdOrdering .compareEq LT LT = refl
+  iLawfulOrdOrdering .compareEq LT EQ = refl
+  iLawfulOrdOrdering .compareEq LT GT = refl
+  iLawfulOrdOrdering .compareEq EQ LT = refl
+  iLawfulOrdOrdering .compareEq EQ EQ = refl
+  iLawfulOrdOrdering .compareEq EQ GT = refl
+  iLawfulOrdOrdering .compareEq GT LT = refl
+  iLawfulOrdOrdering .compareEq GT EQ = refl
+  iLawfulOrdOrdering .compareEq GT GT = refl
+
+  iLawfulOrdOrdering .min2if LT LT = refl
+  iLawfulOrdOrdering .min2if LT EQ = refl
+  iLawfulOrdOrdering .min2if LT GT = refl
+  iLawfulOrdOrdering .min2if EQ LT = refl
+  iLawfulOrdOrdering .min2if EQ EQ = refl
+  iLawfulOrdOrdering .min2if EQ GT = refl
+  iLawfulOrdOrdering .min2if GT LT = refl
+  iLawfulOrdOrdering .min2if GT EQ = refl
+  iLawfulOrdOrdering .min2if GT GT = refl
+
+  iLawfulOrdOrdering .max2if LT LT = refl
+  iLawfulOrdOrdering .max2if LT EQ = refl
+  iLawfulOrdOrdering .max2if LT GT = refl
+  iLawfulOrdOrdering .max2if EQ LT = refl
+  iLawfulOrdOrdering .max2if EQ EQ = refl
+  iLawfulOrdOrdering .max2if EQ GT = refl
+  iLawfulOrdOrdering .max2if GT LT = refl
+  iLawfulOrdOrdering .max2if GT EQ = refl
+  iLawfulOrdOrdering .max2if GT GT = refl
+
+
\ No newline at end of file diff --git a/test/Haskell.Law.Ord.html b/test/Haskell.Law.Ord.html new file mode 100644 index 00000000..ec323500 --- /dev/null +++ b/test/Haskell.Law.Ord.html @@ -0,0 +1,8 @@ + +Haskell.Law.Ord
module Haskell.Law.Ord where
+
+open import Haskell.Law.Ord.Def      public
+open import Haskell.Law.Ord.Bool     public
+open import Haskell.Law.Ord.Maybe    public
+open import Haskell.Law.Ord.Ordering public
+
\ No newline at end of file diff --git a/test/Haskell.Law.Semigroup.Def.html b/test/Haskell.Law.Semigroup.Def.html new file mode 100644 index 00000000..6c8362f4 --- /dev/null +++ b/test/Haskell.Law.Semigroup.Def.html @@ -0,0 +1,29 @@ + +Haskell.Law.Semigroup.Def
module Haskell.Law.Semigroup.Def where
+
+open import Haskell.Prim
+open import Haskell.Prim.Tuple
+
+open import Haskell.Prim.Monoid
+
+record IsLawfulSemigroup (a : Set) ⦃ iSemigroupA : Semigroup a ⦄ : Set₁ where
+  field
+    -- Associativity: x <> (y <> z) = (x <> y) <> z
+    associativity : (x y z : a) → x <> (y <> z) ≡ (x <> y) <> z
+
+open IsLawfulSemigroup ⦃ ... ⦄ public
+
+postulate instance
+  iLawfulSemigroupFun : ⦃ iSemB : Semigroup b ⦄ → ⦃ IsLawfulSemigroup b ⦄ → IsLawfulSemigroup (a → b)
+
+  iLawfulSemigroupUnit : IsLawfulSemigroup ⊤
+
+  iLawfulSemigroupTuple₂ : ⦃ iSemA : Semigroup a ⦄ ⦃ iSemB : Semigroup b ⦄
+                         → ⦃ IsLawfulSemigroup a ⦄ → ⦃ IsLawfulSemigroup b ⦄
+                         → IsLawfulSemigroup (a × b)
+
+  iLawfulSemigroupTuple₃ : ⦃ iSemA : Semigroup a ⦄ ⦃ iSemB : Semigroup b ⦄ ⦃ iSemC : Semigroup c ⦄
+                         → ⦃ IsLawfulSemigroup a ⦄ → ⦃ IsLawfulSemigroup b ⦄ → ⦃ IsLawfulSemigroup c ⦄
+                         → IsLawfulSemigroup (a × b × c)
+
+
\ No newline at end of file diff --git a/test/Haskell.Law.Semigroup.Either.html b/test/Haskell.Law.Semigroup.Either.html new file mode 100644 index 00000000..27cbf95b --- /dev/null +++ b/test/Haskell.Law.Semigroup.Either.html @@ -0,0 +1,15 @@ + +Haskell.Law.Semigroup.Either
module Haskell.Law.Semigroup.Either where
+
+open import Haskell.Prim
+open import Haskell.Prim.Either
+
+open import Haskell.Prim.Monoid
+
+open import Haskell.Law.Equality
+open import Haskell.Law.Semigroup.Def
+
+instance
+  iLawfulSemigroupEither : IsLawfulSemigroup (Either a b)
+  iLawfulSemigroupEither .associativity  = λ { (Left _) _ _ → refl; (Right _) _ _ → refl }
+
\ No newline at end of file diff --git a/test/Haskell.Law.Semigroup.List.html b/test/Haskell.Law.Semigroup.List.html new file mode 100644 index 00000000..0e92e6f6 --- /dev/null +++ b/test/Haskell.Law.Semigroup.List.html @@ -0,0 +1,19 @@ + +Haskell.Law.Semigroup.List
module Haskell.Law.Semigroup.List where
+
+open import Haskell.Prim
+open import Haskell.Prim.List
+
+open import Haskell.Prim.Monoid
+
+open import Haskell.Law.Equality
+open import Haskell.Law.List
+open import Haskell.Law.Semigroup.Def
+
+instance
+  iLawfulSemigroupList : IsLawfulSemigroup (List a)
+  iLawfulSemigroupList .associativity []       _  _  = refl
+  iLawfulSemigroupList .associativity (x ∷ xs) ys zs
+    rewrite sym (++-assoc xs ys zs)
+    = refl
+
\ No newline at end of file diff --git a/test/Haskell.Law.Semigroup.Maybe.html b/test/Haskell.Law.Semigroup.Maybe.html new file mode 100644 index 00000000..1fe837fe --- /dev/null +++ b/test/Haskell.Law.Semigroup.Maybe.html @@ -0,0 +1,20 @@ + +Haskell.Law.Semigroup.Maybe
module Haskell.Law.Semigroup.Maybe where
+
+open import Haskell.Prim
+open import Haskell.Prim.Maybe
+
+open import Haskell.Prim.Monoid
+
+open import Haskell.Law.Equality
+open import Haskell.Law.Semigroup.Def
+
+instance
+  iLawfulSemigroupMaybe : ⦃ iSemA : Semigroup a ⦄ → ⦃ IsLawfulSemigroup a ⦄ → IsLawfulSemigroup (Maybe a)
+  iLawfulSemigroupMaybe .associativity Nothing  _        _        = refl
+  iLawfulSemigroupMaybe .associativity (Just _) Nothing  _        = refl
+  iLawfulSemigroupMaybe .associativity (Just _) (Just _) Nothing  = refl
+  iLawfulSemigroupMaybe .associativity (Just x) (Just y) (Just z)
+    rewrite associativity x y z
+    = refl
+
\ No newline at end of file diff --git a/test/Haskell.Law.html b/test/Haskell.Law.html new file mode 100644 index 00000000..b68f044f --- /dev/null +++ b/test/Haskell.Law.html @@ -0,0 +1,22 @@ + +Haskell.Law
module Haskell.Law where
+
+open import Haskell.Prim
+open import Haskell.Prim.Bool
+
+open import Haskell.Law.Def          public
+open import Haskell.Law.Applicative  public
+open import Haskell.Law.Bool         public
+open import Haskell.Law.Either       public
+open import Haskell.Law.Eq           public
+open import Haskell.Law.Equality     public
+open import Haskell.Law.Functor      public
+open import Haskell.Law.Int          public
+open import Haskell.Law.Integer      public
+open import Haskell.Law.List         public
+open import Haskell.Law.Maybe        public
+open import Haskell.Law.Monad        public
+open import Haskell.Law.Monoid       public
+open import Haskell.Law.Nat          public
+open import Haskell.Law.Ord          public
+
\ No newline at end of file diff --git a/test/Haskell.Prelude.html b/test/Haskell.Prelude.html new file mode 100644 index 00000000..298f3107 --- /dev/null +++ b/test/Haskell.Prelude.html @@ -0,0 +1,144 @@ + +Haskell.Prelude
{-# OPTIONS --no-auto-inline #-}
+module Haskell.Prelude where
+
+open import Haskell.Prim
+open Haskell.Prim public using
+  ( Bool; True; False; Char; Integer;
+    List; []; _∷_; Nat; zero; suc; ⊤; tt;
+    TypeError; ⊥; iNumberNat; lengthNat;
+    IsTrue; IsFalse; NonEmpty;
+    All; allNil; allCons;
+    Any; anyHere; anyThere;
+    id; _∘_; _$_; flip; const;
+    if_then_else_; case_of_;
+    Number; fromNat; Negative; fromNeg;
+    IsString; fromString;
+    _≡_; refl;
+    a; b; c; d; e; f; m; s; t )
+
+open import Haskell.Prim.Absurd      public
+open import Haskell.Prim.Applicative public
+open import Haskell.Prim.Bool        public
+open import Haskell.Prim.Bounded     public
+open import Haskell.Prim.Char        public
+open import Haskell.Prim.Double      public
+open import Haskell.Prim.Either      public
+open import Haskell.Prim.Enum        public
+open import Haskell.Prim.Eq          public
+open import Haskell.Prim.Foldable    public
+open import Haskell.Prim.Functor     public
+open import Haskell.Prim.Int         public
+open import Haskell.Prim.Integer     public
+open import Haskell.Prim.IO          public
+open import Haskell.Prim.List        public
+open import Haskell.Prim.Maybe       public
+open import Haskell.Prim.Monad       public
+open import Haskell.Prim.Monoid      public
+open import Haskell.Prim.Num         public
+open import Haskell.Prim.Ord         public
+open import Haskell.Prim.Show        public
+open import Haskell.Prim.String      public
+open import Haskell.Prim.Traversable public
+open import Haskell.Prim.Tuple       public hiding (first; second; _***_)
+open import Haskell.Prim.Word        public
+
+-- Problematic features
+--  - [Partial]:  Could pass implicit/instance arguments to prove totality.
+--  - [Float]:    Or Float (Agda floats are Doubles)
+--  - [Infinite]: Define colists and map to Haskell lists?
+
+-- Missing from the Haskell Prelude:
+--
+--     Float        [Float]
+--     Rational
+--
+--     Real(toRational),
+--     Integral(quot, rem, div, mod, quotRem, divMod, toInteger),
+--     Fractional((/), recip, fromRational),
+--     Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,
+--              asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),
+--     RealFrac(properFraction, truncate, round, ceiling, floor),
+--     RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,
+--               encodeFloat, exponent, significand, scaleFloat, isNaN,
+--               isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),
+--
+--     subtract, even, odd, gcd, lcm, (^), (^^),
+--     fromIntegral, realToFrac,
+--
+--     foldr1, foldl1, maximum, minimum      [Partial]
+--
+--     until [Partial]
+--
+--     iterate, repeat, cycle          [Infinite]
+--
+--     ReadS, Read(readsPrec, readList),
+--     reads, readParen, read, lex,
+--
+--     IO, putChar, putStr, putStrLn, print,
+--     getChar, getLine, getContents, interact,
+--     FilePath, readFile, writeFile, appendFile, readIO, readLn,
+--     IOError, ioError, userError,
+
+
+--------------------------------------------------
+-- Functions
+
+infixr 0 _$!_
+
+_$!_ : (a → b) → a → b
+_$!_ = _$_
+
+seq : a → b → b
+seq = const id
+
+asTypeOf : a → a → a
+asTypeOf x _ = x
+
+undefined : {@0 @(tactic absurd) i : ⊥} → a
+undefined {i = ()}
+
+error : {@0 @(tactic absurd) i : ⊥} → String → a
+error {i = ()} err
+
+errorWithoutStackTrace : {@0 @(tactic absurd) i : ⊥} → String → a
+errorWithoutStackTrace {i = ()} err
+
+-------------------------------------------------
+-- More List functions
+--   These uses Eq, Ord, or Foldable, so can't go in Prim.List without
+--   turning those dependencies around.
+
+reverse : List a → List a
+reverse = foldl (flip _∷_) []
+
+infixl 9 _!!_ _!!ᴺ_
+
+_!!ᴺ_ : (xs : List a) (n : Nat) → @0 ⦃ IsTrue (n < lengthNat xs) ⦄ → a
+(x ∷ xs) !!ᴺ zero  = x
+(x ∷ xs) !!ᴺ suc n = xs !!ᴺ n
+
+_!!_ : (xs : List a) (n : Int)
+     → ⦃ @0 nn : IsNonNegativeInt n ⦄
+     → ⦃ @0 _  : IsTrue (intToNat n {{nn}} < lengthNat xs) ⦄ → a
+xs !! n = xs !!ᴺ intToNat n
+
+lookup : ⦃ Eq a ⦄ → a → List (a × b) → Maybe b
+lookup x []              = Nothing
+lookup x ((x₁ , y) ∷ xs) = if x == x₁ then Just y else lookup x xs
+
+
+-------------------------------------------------
+-- Unsafe functions
+
+coerce : @0 a ≡ b → a → b
+coerce refl x = x
+
+IsJust : Maybe a → Set
+IsJust Nothing  = ⊥
+IsJust (Just _) = ⊤
+
+fromJust : (x : Maybe a) → @0 {IsJust x} → a
+fromJust Nothing  = error "fromJust Nothing"
+fromJust (Just x) = x
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Absurd.html b/test/Haskell.Prim.Absurd.html new file mode 100644 index 00000000..95feecde --- /dev/null +++ b/test/Haskell.Prim.Absurd.html @@ -0,0 +1,25 @@ + +Haskell.Prim.Absurd
+module Haskell.Prim.Absurd where
+
+open import Haskell.Prim
+
+open import Agda.Builtin.Reflection renaming (bindTC to _>>=_; absurd to absurdP)
+
+private
+
+  pattern vArg x = arg (arg-info visible (modality relevant quantity-ω)) x
+
+  refute : Nat → Term
+  refute i = def (quote _$_) ( vArg (pat-lam (absurd-clause [] (vArg (absurdP 0) ∷ []) ∷ []) [])
+                             ∷ vArg (var i []) ∷ [])
+
+  tryRefute : Nat → Term → TC ⊤
+  tryRefute 0       _    = typeError (strErr "No variable of empty type found in the context" ∷ [])
+  tryRefute (suc n) hole = catchTC (unify hole (refute n)) (tryRefute n hole)
+
+absurd : Term → TC ⊤
+absurd hole = do
+  Γ ← getContext
+  tryRefute (lengthNat Γ) hole
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Applicative.html b/test/Haskell.Prim.Applicative.html new file mode 100644 index 00000000..5ad0150b --- /dev/null +++ b/test/Haskell.Prim.Applicative.html @@ -0,0 +1,94 @@ + +Haskell.Prim.Applicative
module Haskell.Prim.Applicative where
+
+open import Haskell.Prim
+open import Haskell.Prim.Either
+open import Haskell.Prim.Foldable
+open import Haskell.Prim.Functor
+open import Haskell.Prim.IO
+open import Haskell.Prim.List
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Monoid
+open import Haskell.Prim.Tuple
+
+
+--------------------------------------------------
+-- Applicative
+
+-- ** base
+record Applicative (f : Set → Set) : Set₁ where
+  infixl 4 _<*>_ _<*_ _*>_
+  field
+    pure  : a → f a
+    _<*>_ : f (a → b) → f a → f b
+    overlap ⦃ super ⦄ : Functor f
+    _<*_ : f a → f b → f a
+    _*>_ : f a → f b → f b
+-- ** defaults
+record DefaultApplicative (f : Set → Set) : Set₁ where
+  constructor mk
+  infixl 4 _<*>_ _<*_ _*>_
+  field
+    pure  : a → f a
+    _<*>_ : f (a → b) → f a → f b
+    overlap ⦃ super ⦄ : Functor f
+
+  _<*_ : f a → f b → f a
+  x <* y = const <$> x <*> y
+
+  _*>_ : f a → f b → f b
+  x *> y = const id <$> x <*> y
+-- ** export
+open Applicative ⦃...⦄ public
+{-# COMPILE AGDA2HS Applicative existing-class #-}
+-- ** instances
+instance
+  open DefaultApplicative
+
+  iDefaultApplicativeList : DefaultApplicative List
+  iDefaultApplicativeList .pure x = x ∷ []
+  iDefaultApplicativeList ._<*>_ fs xs = concatMap (λ f → map f xs) fs
+
+  iApplicativeList : Applicative List
+  iApplicativeList = record {DefaultApplicative iDefaultApplicativeList}
+
+  iDefaultApplicativeMaybe : DefaultApplicative Maybe
+  iDefaultApplicativeMaybe .pure = Just
+  iDefaultApplicativeMaybe ._<*>_ (Just f) (Just x) = Just (f x)
+  iDefaultApplicativeMaybe ._<*>_ _        _        = Nothing
+
+  iApplicativeMaybe : Applicative Maybe
+  iApplicativeMaybe = record {DefaultApplicative iDefaultApplicativeMaybe}
+
+  iDefaultApplicativeEither : DefaultApplicative (Either a)
+  iDefaultApplicativeEither .pure = Right
+  iDefaultApplicativeEither ._<*>_ (Right f) (Right x) = Right (f x)
+  iDefaultApplicativeEither ._<*>_ (Left e)  _         = Left e
+  iDefaultApplicativeEither ._<*>_ _         (Left e)  = Left e
+
+  iApplicativeEither : Applicative (Either a)
+  iApplicativeEither = record{DefaultApplicative iDefaultApplicativeEither}
+
+  iDefaultApplicativeFun : DefaultApplicative (λ b → a → b)
+  iDefaultApplicativeFun .pure        = const
+  iDefaultApplicativeFun ._<*>_ f g x = f x (g x)
+
+  iApplicativeFun : Applicative (λ b → a → b)
+  iApplicativeFun = record{DefaultApplicative iDefaultApplicativeFun}
+
+  iDefaultApplicativeTuple₂ : ⦃ Monoid a ⦄ → DefaultApplicative (a ×_)
+  iDefaultApplicativeTuple₂ .pure x                = mempty , x
+  iDefaultApplicativeTuple₂ ._<*>_ (a , f) (b , x) = a <> b , f x
+
+  iApplicativeTuple₂ : ⦃ Monoid a ⦄ → Applicative (a ×_)
+  iApplicativeTuple₂ = record{DefaultApplicative iDefaultApplicativeTuple₂}
+
+  iDefaultApplicativeTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → DefaultApplicative (a × b ×_)
+  iDefaultApplicativeTuple₃ .pure x = mempty , mempty , x
+  iDefaultApplicativeTuple₃ ._<*>_ (a , u , f) (b , v , x) = a <> b , u <> v , f x
+
+  iApplicativeTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Applicative (a × b ×_)
+  iApplicativeTuple₃ = record{DefaultApplicative iDefaultApplicativeTuple₃}
+
+instance postulate iApplicativeIO : Applicative IO
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Bool.html b/test/Haskell.Prim.Bool.html new file mode 100644 index 00000000..36ec9c7c --- /dev/null +++ b/test/Haskell.Prim.Bool.html @@ -0,0 +1,26 @@ + +Haskell.Prim.Bool
+module Haskell.Prim.Bool where
+
+open import Haskell.Prim
+
+--------------------------------------------------
+-- Booleans
+
+infixr 3 _&&_
+_&&_ : Bool → Bool → Bool
+False && _ = False
+True  && x = x
+
+infixr 2 _||_
+_||_ : Bool → Bool → Bool
+False || x = x
+True  || _ = True
+
+not : Bool → Bool
+not False = True
+not True  = False
+
+otherwise : Bool
+otherwise = True
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Bounded.html b/test/Haskell.Prim.Bounded.html new file mode 100644 index 00000000..cb15129a --- /dev/null +++ b/test/Haskell.Prim.Bounded.html @@ -0,0 +1,96 @@ + +Haskell.Prim.Bounded
+module Haskell.Prim.Bounded where
+
+open import Haskell.Prim
+open import Haskell.Prim.Eq
+open import Haskell.Prim.Int
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Ord
+open import Haskell.Prim.Tuple
+open import Haskell.Prim.Word
+
+--------------------------------------------------
+-- Bounded
+
+record BoundedBelow (a : Set) : Set where
+  field
+    minBound : a
+
+record BoundedAbove (a : Set) : Set where
+  field
+    maxBound : a
+
+record Bounded (a : Set) : Set where
+  field
+    overlap ⦃ below ⦄ : BoundedBelow a
+    overlap ⦃ above ⦄ : BoundedAbove a
+
+{-# COMPILE AGDA2HS Bounded existing-class #-}
+
+open BoundedBelow ⦃...⦄ public
+open BoundedAbove ⦃...⦄ public
+
+instance
+  iBounded : ⦃ BoundedBelow a ⦄ → ⦃ BoundedAbove a ⦄ → Bounded a
+  iBounded .Bounded.below = it
+  iBounded .Bounded.above = it
+
+instance
+  iBoundedBelowNat : BoundedBelow Nat
+  iBoundedBelowNat .minBound = 0
+
+  iBoundedBelowWord : BoundedBelow Word
+  iBoundedBelowWord .minBound = 0
+  iBoundedAboveWord : BoundedAbove Word
+  iBoundedAboveWord .maxBound = 18446744073709551615
+
+  iBoundedBelowInt : BoundedBelow Int
+  iBoundedBelowInt .minBound = -9223372036854775808
+  iBoundedAboveInt : BoundedAbove Int
+  iBoundedAboveInt .maxBound = 9223372036854775807
+
+  iBoundedBelowBool : BoundedBelow Bool
+  iBoundedBelowBool .minBound = False
+  iBoundedAboveBool : BoundedAbove Bool
+  iBoundedAboveBool .maxBound = True
+
+  iBoundedBelowChar : BoundedBelow Char
+  iBoundedBelowChar .minBound = '\0'
+  iBoundedAboveChar : BoundedAbove Char
+  iBoundedAboveChar .maxBound = '\1114111'
+
+  iBoundedBelowUnit : BoundedBelow ⊤
+  iBoundedBelowUnit .minBound = tt
+
+  iBoundedAboveUnit : BoundedAbove ⊤
+  iBoundedAboveUnit .maxBound = tt
+
+  iBoundedBelowTuple₂ : ⦃ BoundedBelow a ⦄ → ⦃ BoundedBelow b ⦄
+                      → BoundedBelow (a × b)
+  iBoundedBelowTuple₂ .minBound = minBound , minBound
+  iBoundedAboveTuple₂ : ⦃ BoundedAbove a ⦄ → ⦃ BoundedAbove b ⦄
+                      → BoundedAbove (a × b)
+  iBoundedAboveTuple₂ .maxBound = maxBound , maxBound
+
+  iBoundedBelowTuple₃ : ⦃ BoundedBelow a ⦄ → ⦃ BoundedBelow b ⦄ → ⦃ BoundedBelow c ⦄
+                      → BoundedBelow (a × b × c)
+  iBoundedBelowTuple₃ .minBound = minBound , minBound , minBound
+  iBoundedAboveTuple₃ : ⦃ BoundedAbove a ⦄ → ⦃ BoundedAbove b ⦄ → ⦃ BoundedAbove c ⦄
+                      → BoundedAbove (a × b × c)
+  iBoundedAboveTuple₃ .maxBound = maxBound , maxBound , maxBound
+
+  iBoundedBelowOrdering : BoundedBelow Ordering
+  iBoundedBelowOrdering .minBound = LT
+  iBoundedAboveOrdering : BoundedAbove Ordering
+  iBoundedAboveOrdering .maxBound = GT
+
+-- Sanity checks
+
+private
+  _ : addWord maxBound 1 ≡ minBound
+  _ = refl
+
+  _ : addInt maxBound 1 ≡ minBound
+  _ = refl
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Char.html b/test/Haskell.Prim.Char.html new file mode 100644 index 00000000..5cef9fd6 --- /dev/null +++ b/test/Haskell.Prim.Char.html @@ -0,0 +1,11 @@ + +Haskell.Prim.Char
module Haskell.Prim.Char where
+
+open import Haskell.Prim
+
+import Agda.Builtin.Char 
+open Agda.Builtin.Char using (Char)
+    
+eqChar : Char → Char → Bool
+eqChar a b = eqNat (c2n a) (c2n b)
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Double.html b/test/Haskell.Prim.Double.html new file mode 100644 index 00000000..62772ace --- /dev/null +++ b/test/Haskell.Prim.Double.html @@ -0,0 +1,17 @@ + +Haskell.Prim.Double
+module Haskell.Prim.Double where
+
+open import Agda.Builtin.Float public renaming (Float to Double)
+
+open import Haskell.Prim
+
+instance
+  iNumberDouble : Number Double
+  iNumberDouble .Number.Constraint _ = ⊤
+  iNumberDouble .fromNat n = primNatToFloat n
+
+  iNegativeDouble : Negative Double
+  iNegativeDouble .Negative.Constraint _ = ⊤
+  iNegativeDouble .fromNeg n = primFloatMinus 0.0 (fromNat n)
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Either.html b/test/Haskell.Prim.Either.html new file mode 100644 index 00000000..84887f84 --- /dev/null +++ b/test/Haskell.Prim.Either.html @@ -0,0 +1,22 @@ + +Haskell.Prim.Either
+module Haskell.Prim.Either where
+
+open import Haskell.Prim
+open import Haskell.Prim.Bool
+
+--------------------------------------------------
+-- Either
+
+data Either (a b : Set) : Set where
+  Left  : a → Either a b
+  Right : b → Either a b
+
+either : (a → c) → (b → c) → Either a b → c
+either f g (Left  x) = f x
+either f g (Right y) = g y
+
+testBool : (b : Bool) → Either (IsFalse b) (IsTrue b)
+testBool False = Left  itsFalse
+testBool True  = Right itsTrue
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Enum.html b/test/Haskell.Prim.Enum.html new file mode 100644 index 00000000..531d6c3d --- /dev/null +++ b/test/Haskell.Prim.Enum.html @@ -0,0 +1,265 @@ + +Haskell.Prim.Enum
+module Haskell.Prim.Enum where
+
+open import Haskell.Prim
+open import Haskell.Prim.Bool
+open import Haskell.Prim.Bounded
+open import Haskell.Prim.Either
+open import Haskell.Prim.Eq
+open import Haskell.Prim.Functor
+open import Haskell.Prim.Int
+open import Haskell.Prim.Integer
+open import Haskell.Prim.List
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Num
+open import Haskell.Prim.Ord
+open import Haskell.Prim.Tuple
+open import Haskell.Prim.Word
+
+
+--------------------------------------------------
+-- Enum
+--    Assumptions: unbounded enums have no constraints on their
+--    operations and bounded enums should work on all values between
+--    minBound and maxBound. Unbounded enums do not support enumFrom
+--    and enumFromThen (since they return infinite lists).
+
+@0 IfBoundedBelow : Maybe (BoundedBelow a) → (⦃ BoundedBelow a ⦄ → Set) → Set
+IfBoundedBelow Nothing  k = ⊤
+IfBoundedBelow (Just i) k = k ⦃ i ⦄
+
+@0 IfBoundedAbove : Maybe (BoundedAbove a) → (⦃ BoundedAbove a ⦄ → Set) → Set
+IfBoundedAbove Nothing  k = ⊤
+IfBoundedAbove (Just i) k = k ⦃ i ⦄
+
+record Enum (a : Set) : Set₁ where
+  field
+    BoundedBelowEnum : Maybe (BoundedBelow a)
+    BoundedAboveEnum : Maybe (BoundedAbove a)
+    fromEnum         : a → Int
+
+  private
+    @0 IsBoundedBelow : Set
+    IsBoundedBelow = maybe ⊥ (λ _ → ⊤) BoundedBelowEnum
+
+    @0 IsBoundedAbove : Set
+    IsBoundedAbove = maybe ⊥ (λ _ → ⊤) BoundedAboveEnum
+
+    @0 TrueIfLB : (⦃ BoundedBelow a ⦄ → Bool) → Set
+    TrueIfLB C = IfBoundedBelow BoundedBelowEnum (IsTrue C)
+
+    @0 TrueIfUB : (⦃ BoundedAbove a ⦄ → Bool) → Set
+    TrueIfUB C = IfBoundedAbove BoundedAboveEnum (IsTrue C)
+
+    @0 FalseIfLB : (⦃ BoundedBelow a ⦄ → Bool) → Set
+    FalseIfLB C = IfBoundedBelow BoundedBelowEnum (IsFalse C)
+
+    @0 FalseIfUB : (⦃ BoundedAbove a ⦄ → Bool) → Set
+    FalseIfUB C = IfBoundedAbove BoundedAboveEnum (IsFalse C)
+
+    minInt : ⦃ BoundedBelow a ⦄ → Int
+    minInt ⦃ _ ⦄ = fromEnum minBound
+
+    maxInt : ⦃ BoundedAbove a ⦄ → Int
+    maxInt ⦃ _ ⦄ = fromEnum maxBound
+
+  field
+    toEnum : (n : Int) → @0 ⦃ TrueIfLB (minInt <= n) ⦄ → @0 ⦃ TrueIfUB (n <= maxInt) ⦄ → a
+    succ   : (x : a) → @0 ⦃ FalseIfUB (fromEnum x == maxInt) ⦄ → a
+    pred   : (x : a) → @0 ⦃ FalseIfLB (fromEnum x == minInt) ⦄ → a
+
+    enumFrom       : @0 ⦃ IsBoundedAbove ⦄ → a → List a
+    enumFromTo     : a → a → List a
+    -- In the Prelude Enum instances `enumFromThenTo x x y` gives the
+    -- infinite list of `x`s. The constraint is a little bit stronger than it needs to be,
+    -- since it rules out different x and x₁ that maps to the same Int, but this saves us
+    -- requiring an Eq instance for `a`, and it's not a terrible limitation to not be able to
+    -- write [0, 2^64 .. 2^66].
+    enumFromThenTo : (x x₁ : a) → @0 ⦃ IsFalse (fromEnum x == fromEnum x₁) ⦄ → a → List a
+    enumFromThen   : @0 ⦃ IsBoundedBelow ⦄ → @0 ⦃ IsBoundedAbove ⦄ → (x x₁ : a) → @0 ⦃ IsFalse (fromEnum x == fromEnum x₁) ⦄ → List a
+
+open Enum ⦃...⦄ public
+
+{-# COMPILE AGDA2HS Enum existing-class #-}
+
+private
+  divNat : Nat → Nat → Nat
+  divNat a 0       = 0
+  divNat a (suc b) = div-helper 0 b a b
+
+  diff : Integer → Integer → Maybe Nat
+  diff a b =
+    case a - b of λ where
+      (pos n)    → Just n
+      (negsuc _) → Nothing
+
+  unsafeIntegerToNat : Integer → Nat
+  unsafeIntegerToNat (pos n) = n
+  unsafeIntegerToNat (negsuc _) = 0
+
+  integerFromCount : Integer → Integer → Nat → List Integer
+  integerFromCount a step 0       = []
+  integerFromCount a step (suc n) = a ∷ integerFromCount (a + step) step n
+
+  integerFromTo : Integer → Integer → List Integer
+  integerFromTo a b = maybe [] (integerFromCount a 1 ∘ suc) (diff b a)
+
+  integerFromThenTo : (a a₁ : Integer) → @0 ⦃ IsFalse (integerToInt a == integerToInt a₁) ⦄ → Integer → List Integer
+  integerFromThenTo a a₁ b =
+    case compare a a₁ of λ where
+      LT → maybe [] (λ d → integerFromCount a (a₁ - a) (suc (divNat d (unsafeIntegerToNat (a₁ - a))))) (diff b a)
+      EQ → [] -- impossible
+      GT → maybe [] (λ d → integerFromCount a (a₁ - a) (suc (divNat d (unsafeIntegerToNat (a - a₁))))) (diff a b)
+
+instance
+  iEnumInteger : Enum Integer
+  iEnumInteger .BoundedBelowEnum  = Nothing
+  iEnumInteger .BoundedAboveEnum  = Nothing
+  iEnumInteger .fromEnum          = integerToInt
+  iEnumInteger .toEnum          n = intToInteger n
+  iEnumInteger .succ              = _+ 1
+  iEnumInteger .pred              = _- 1
+  iEnumInteger .enumFromTo        = integerFromTo
+  iEnumInteger .enumFromThenTo    = integerFromThenTo
+
+private
+  fromTo : (from : a → Integer) (to : Integer → a)
+         → a → a → List a
+  fromTo from to a b = map to (enumFromTo (from a) (from b))
+
+  fromThenTo : (from : a → Integer) (to : Integer → a)
+             → (x x₁ : a) → @0 ⦃ IsFalse (fromEnum (from x) == fromEnum (from x₁)) ⦄ → a → List a
+  fromThenTo from to a a₁ b = map to (enumFromThenTo (from a) (from a₁) (from b))
+
+
+instance
+  iEnumNat : Enum Nat
+  iEnumNat .BoundedBelowEnum = Just it
+  iEnumNat .BoundedAboveEnum = Nothing
+  iEnumNat .fromEnum = integerToInt ∘ pos
+  iEnumNat .toEnum n = unsafeIntegerToNat (intToInteger n)
+  iEnumNat .succ n = suc n
+  iEnumNat .pred (suc n) = n
+  iEnumNat .enumFromTo = fromTo pos unsafeIntegerToNat
+  iEnumNat .enumFromThenTo = fromThenTo pos unsafeIntegerToNat
+
+  iEnumInt : Enum Int
+  iEnumInt .BoundedBelowEnum      = Just it
+  iEnumInt .BoundedAboveEnum      = Just it
+  iEnumInt .fromEnum              = integerToInt ∘ intToInteger
+  iEnumInt .toEnum         n      = integerToInt (intToInteger n)
+  iEnumInt .succ           x      = integerToInt (intToInteger x + 1)
+  iEnumInt .pred           x      = integerToInt (intToInteger x - 1)
+  iEnumInt .enumFromTo     a b    = fromTo intToInteger integerToInt a b
+  iEnumInt .enumFromThenTo a a₁ b = fromThenTo intToInteger integerToInt a a₁ b
+  iEnumInt .enumFrom       a      = fromTo intToInteger integerToInt a maxBound
+  iEnumInt .enumFromThen   a a₁   =
+    if a < a₁ then fromThenTo intToInteger integerToInt a a₁ maxBound
+              else fromThenTo intToInteger integerToInt a a₁ minBound
+
+  iEnumWord : Enum Word
+  iEnumWord .BoundedBelowEnum      = Just it
+  iEnumWord .BoundedAboveEnum      = Just it
+  iEnumWord .fromEnum              = integerToInt ∘ wordToInteger
+  iEnumWord .toEnum         n      = integerToWord (intToInteger n)
+  iEnumWord .succ           x      = integerToWord (wordToInteger x + 1)
+  iEnumWord .pred           x      = integerToWord (wordToInteger x - 1)
+  iEnumWord .enumFromTo     a b    = fromTo wordToInteger integerToWord a b
+  iEnumWord .enumFromThenTo a a₁ b = fromThenTo wordToInteger integerToWord a a₁ b
+  iEnumWord .enumFrom       a      = fromTo wordToInteger integerToWord a maxBound
+  iEnumWord .enumFromThen   a a₁   =
+    if a < a₁ then fromThenTo wordToInteger integerToWord a a₁ maxBound
+              else fromThenTo wordToInteger integerToWord a a₁ minBound
+
+private
+  fromBool : Bool → Integer
+  fromBool = if_then 1 else 0
+
+  toBool : Integer → Bool
+  toBool = _/= 0
+
+instance
+  iEnumBool : Enum Bool
+  iEnumBool .BoundedBelowEnum      = Just it
+  iEnumBool .BoundedAboveEnum      = Just it
+  iEnumBool .fromEnum              = integerToInt ∘ fromBool
+  iEnumBool .toEnum         n      = toBool (intToInteger n)
+  iEnumBool .succ           x      = toBool (fromBool x + 1)
+  iEnumBool .pred           x      = toBool (fromBool x - 1)
+  iEnumBool .enumFromTo     a b    = fromTo fromBool toBool a b
+  iEnumBool .enumFromThenTo a a₁ b = fromThenTo fromBool toBool a a₁ b
+  iEnumBool .enumFrom       a      = fromTo fromBool toBool a maxBound
+  iEnumBool .enumFromThen   a a₁   =
+    if a < a₁ then fromThenTo fromBool toBool a a₁ maxBound
+              else fromThenTo fromBool toBool a a₁ minBound
+
+private
+  fromOrdering : Ordering → Integer
+  fromOrdering = λ where LT → 0; EQ → 1; GT → 2
+
+  toOrdering : Integer → Ordering
+  toOrdering = λ where (pos 0) → LT; (pos 1) → EQ; _ → GT
+
+instance
+  iEnumOrdering : Enum Ordering
+  iEnumOrdering .BoundedBelowEnum      = Just it
+  iEnumOrdering .BoundedAboveEnum      = Just it
+  iEnumOrdering .fromEnum              = integerToInt ∘ fromOrdering
+  iEnumOrdering .toEnum         n      = toOrdering (intToInteger n)
+  iEnumOrdering .succ           x      = toOrdering (fromOrdering x + 1)
+  iEnumOrdering .pred           x      = toOrdering (fromOrdering x - 1)
+  iEnumOrdering .enumFromTo     a b    = fromTo fromOrdering toOrdering a b
+  iEnumOrdering .enumFromThenTo a a₁ b = fromThenTo fromOrdering toOrdering a a₁ b
+  iEnumOrdering .enumFrom       a      = fromTo fromOrdering toOrdering a maxBound
+  iEnumOrdering .enumFromThen   a a₁   =
+    if a < a₁ then fromThenTo fromOrdering toOrdering a a₁ maxBound
+              else fromThenTo fromOrdering toOrdering a a₁ minBound
+
+private
+  fromUnit : ⊤ → Integer
+  fromUnit _ = 0
+
+  toUnit : Integer → ⊤
+  toUnit _ = tt
+
+instance
+  iEnumUnit : Enum ⊤
+  iEnumUnit .BoundedBelowEnum      = Just it
+  iEnumUnit .BoundedAboveEnum      = Just it
+  iEnumUnit .fromEnum              = integerToInt ∘ fromUnit
+  iEnumUnit .toEnum         n      = toUnit (intToInteger n)
+  iEnumUnit .succ           x      = toUnit (fromUnit x + 1)
+  iEnumUnit .pred           x      = toUnit (fromUnit x - 1)
+  iEnumUnit .enumFromTo     a b    = fromTo fromUnit toUnit a b
+  iEnumUnit .enumFromThenTo a a₁ b = fromThenTo fromUnit toUnit a a₁ b
+  iEnumUnit .enumFrom       a      = fromTo fromUnit toUnit a maxBound
+  iEnumUnit .enumFromThen   a a₁   =
+    if a < a₁ then fromThenTo fromUnit toUnit a a₁ maxBound
+              else fromThenTo fromUnit toUnit a a₁ minBound
+
+private
+  fromChar : Char → Integer
+  fromChar = pos ∘ c2n
+
+  toChar : Integer → Char
+  toChar = λ where (pos n) → primNatToChar n; _ → '_'
+
+instance
+  iEnumChar : Enum Char
+  iEnumChar .BoundedBelowEnum      = Just it
+  iEnumChar .BoundedAboveEnum      = Just it
+  iEnumChar .fromEnum              = integerToInt ∘ fromChar
+  iEnumChar .toEnum         n      = toChar (intToInteger n)
+  iEnumChar .succ           x      = toChar (fromChar x + 1)
+  iEnumChar .pred           x      = toChar (fromChar x - 1)
+  iEnumChar .enumFromTo     a b    = fromTo fromChar toChar a b
+  iEnumChar .enumFromThenTo a a₁ b = fromThenTo fromChar toChar a a₁ b
+  iEnumChar .enumFrom       a      = fromTo fromChar toChar a maxBound
+  iEnumChar .enumFromThen   a a₁   =
+    if a < a₁ then fromThenTo fromChar toChar a a₁ maxBound
+              else fromThenTo fromChar toChar a a₁ minBound
+
+  -- Missing:
+  --  Enum Double  (can't go via Integer)
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Eq.html b/test/Haskell.Prim.Eq.html new file mode 100644 index 00000000..47fb79ea --- /dev/null +++ b/test/Haskell.Prim.Eq.html @@ -0,0 +1,84 @@ + +Haskell.Prim.Eq
+module Haskell.Prim.Eq where
+
+open import Haskell.Prim
+open import Haskell.Prim.Bool
+open import Haskell.Prim.Char
+open import Haskell.Prim.Integer
+open import Haskell.Prim.Int
+open import Haskell.Prim.Word
+open import Haskell.Prim.Double
+open import Haskell.Prim.Tuple
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Either
+
+--------------------------------------------------
+-- Eq
+
+record Eq (a : Set) : Set where
+  infix 4 _==_
+  field
+    _==_ : a → a → Bool
+
+open Eq ⦃...⦄ public
+
+{-# COMPILE AGDA2HS Eq existing-class #-}
+
+_/=_ : {{Eq a}} → a → a → Bool
+x /= y = not (x == y)
+
+infix 4 _/=_
+
+instance
+  iEqNat : Eq Nat
+  iEqNat ._==_ = eqNat
+
+  iEqInteger : Eq Integer
+  iEqInteger ._==_ = eqInteger
+
+  iEqInt : Eq Int
+  iEqInt ._==_ = eqInt
+
+  iEqWord : Eq Word
+  iEqWord ._==_ = eqWord
+
+  iEqDouble : Eq Double
+  iEqDouble ._==_ = primFloatEquality
+
+  iEqBool : Eq Bool
+  iEqBool ._==_ False False = True
+  iEqBool ._==_ True  True  = True
+  iEqBool ._==_ _     _     = False
+
+  iEqChar : Eq Char
+  iEqChar ._==_ = eqChar
+
+  iEqUnit : Eq ⊤
+  iEqUnit ._==_ _ _ = True
+
+  iEqTuple₂ : ⦃ Eq a ⦄ → ⦃ Eq b ⦄ → Eq (a × b)
+  iEqTuple₂ ._==_ (x₁ , y₁) (x₂ , y₂) = x₁ == x₂ && y₁ == y₂
+
+  iEqTuple₃ : ⦃ Eq a ⦄ → ⦃ Eq b ⦄ → ⦃ Eq c ⦄ → Eq (a × b × c)
+  iEqTuple₃ ._==_ (x₁ , y₁ , z₁) (x₂ , y₂ , z₂) = x₁ == x₂ && y₁ == y₂ && z₁ == z₂
+
+  iEqList : ⦃ Eq a ⦄ → Eq (List a)
+  iEqList {a} ._==_ = eqList
+    where
+      eqList : List a → List a → Bool
+      eqList [] [] = True
+      eqList (x ∷ xs) (y ∷ ys) = x == y && eqList xs ys
+      eqList _ _ = False
+
+
+  iEqMaybe : ⦃ Eq a ⦄ → Eq (Maybe a)
+  iEqMaybe ._==_ Nothing  Nothing  = True
+  iEqMaybe ._==_ (Just x) (Just y) = x == y
+  iEqMaybe ._==_ _        _        = False
+
+  iEqEither : ⦃ Eq a ⦄ → ⦃ Eq b ⦄ → Eq (Either a b)
+  iEqEither ._==_ (Left  x) (Left  y) = x == y
+  iEqEither ._==_ (Right x) (Right y) = x == y
+  iEqEither ._==_ _        _          = False
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Foldable.html b/test/Haskell.Prim.Foldable.html new file mode 100644 index 00000000..4cc43298 --- /dev/null +++ b/test/Haskell.Prim.Foldable.html @@ -0,0 +1,124 @@ + +Haskell.Prim.Foldable
+module Haskell.Prim.Foldable where
+
+open import Haskell.Prim
+open import Haskell.Prim.Num hiding (abs)
+open import Haskell.Prim.Eq
+open import Haskell.Prim.List
+open import Haskell.Prim.Int
+open import Haskell.Prim.Bool
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Either
+open import Haskell.Prim.Tuple
+open import Haskell.Prim.Monoid
+
+--------------------------------------------------
+-- Foldable
+
+-- ** base
+record Foldable (t : Set → Set) : Set₁ where
+  field
+    foldMap : ⦃ Monoid b ⦄ → (a → b) → t a → b
+    foldr : (a → b → b) → b → t a → b
+    foldl : (b → a → b) → b → t a → b
+    any : (a → Bool) → t a → Bool
+    all : (a → Bool) → t a → Bool
+    and : t Bool → Bool
+    null : t a → Bool
+    or : t Bool → Bool
+    concat : t (List a) → List a
+    concatMap : (a → List b) → t a → List b
+    elem : ⦃ Eq a ⦄ → a → t a → Bool
+    notElem : ⦃ Eq a ⦄ → a → t a → Bool
+    toList : t a → List a
+    sum : ⦃ iNum : Num a ⦄ → t a → a
+    product : ⦃ iNum : Num a ⦄ → t a → a
+    length : t a → Int
+-- ** defaults
+record DefaultFoldable (t : Set → Set) : Set₁ where
+  module M = Foldable {t = t}
+  field foldMap : ⦃ Monoid b ⦄ → (a → b) → t a → b
+
+  foldr : (a → b → b) → b → t a → b
+  foldr f z t = foldMap ⦃ MonoidEndo ⦄ f t z
+
+  foldl : (b → a → b) → b → t a → b
+  foldl f z t = foldMap ⦃ MonoidEndoᵒᵖ ⦄ (flip f) t z
+
+  any : (a → Bool) → t a → Bool
+  any = foldMap ⦃ MonoidDisj ⦄
+
+  all : (a → Bool) → t a → Bool
+  all = foldMap ⦃ MonoidConj ⦄
+
+  and : t Bool → Bool
+  and = all id
+
+  or : t Bool → Bool
+  or = any id
+
+  null : t a → Bool
+  null = all (const False)
+
+  concat : t (List a) → List a
+  concat = foldMap id
+
+  concatMap : (a → List b) → t a → List b
+  concatMap = foldMap
+
+  elem : ⦃ Eq a ⦄ → a → t a → Bool
+  elem x = foldMap ⦃ MonoidDisj ⦄ (x ==_)
+
+  notElem : ⦃ Eq a ⦄ → a → t a → Bool
+  notElem x t = not (elem x t)
+
+  toList : t a → List a
+  toList = foldr _∷_ []
+
+  sum : ⦃ iNum : Num a ⦄ → t a → a
+  sum = foldMap ⦃ MonoidSum ⦄ id
+
+  product : ⦃ iNum : Num a ⦄ → t a → a
+  product = foldMap ⦃ MonoidProduct ⦄ id
+
+  length : t a → Int
+  length = foldMap ⦃ MonoidSum ⦄ (const 1)
+-- ** export
+open Foldable ⦃...⦄ public
+{-# COMPILE AGDA2HS Foldable existing-class #-}
+
+-- ** instances
+instance
+  iDefaultFoldableList : DefaultFoldable List
+  iDefaultFoldableList .DefaultFoldable.foldMap = foldMapList
+    where
+      foldMapList : ⦃ Monoid b ⦄ → (a → b) → List a → b
+      foldMapList f []       = mempty
+      foldMapList f (x ∷ xs) = f x <> foldMapList f xs
+
+  iFoldableList : Foldable List
+  iFoldableList = record {DefaultFoldable iDefaultFoldableList}
+
+  iDefaultFoldableMaybe : DefaultFoldable Maybe
+  iDefaultFoldableMaybe .DefaultFoldable.foldMap = λ where
+    _ Nothing  → mempty
+    f (Just x) → f x
+
+  iFoldableMaybe : Foldable Maybe
+  iFoldableMaybe = record {DefaultFoldable iDefaultFoldableMaybe}
+
+  iDefaultFoldableEither : DefaultFoldable (Either a)
+  iDefaultFoldableEither .DefaultFoldable.foldMap = λ where
+    _ (Left _)  → mempty
+    f (Right x) → f x
+
+  iFoldableEither : Foldable (Either a)
+  iFoldableEither = record {DefaultFoldable iDefaultFoldableEither}
+
+  iDefaultFoldablePair : DefaultFoldable (a ×_)
+  iDefaultFoldablePair .DefaultFoldable.foldMap = λ f (_ , x) → f x
+
+  iFoldablePair : Foldable (a ×_)
+  iFoldablePair = record {DefaultFoldable iDefaultFoldablePair}
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Functor.html b/test/Haskell.Prim.Functor.html new file mode 100644 index 00000000..95277d4e --- /dev/null +++ b/test/Haskell.Prim.Functor.html @@ -0,0 +1,91 @@ + +Haskell.Prim.Functor
+module Haskell.Prim.Functor where
+
+open import Haskell.Prim
+open import Haskell.Prim.Either
+open import Haskell.Prim.IO
+open import Haskell.Prim.List
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Tuple
+
+--------------------------------------------------
+-- Functor
+
+-- ** base
+record Functor (f : Set → Set) : Set₁ where
+  infixl 4 _<$_
+  field
+    fmap : (a → b) → f a → f b
+    _<$_ : (@0 {{ b }} → a) → f b → f a
+-- ** defaults
+record DefaultFunctor (f : Set → Set) : Set₁ where
+  field fmap : (a → b) → f a → f b
+
+  infixl 4 _<$_
+
+  _<$_ : (@0 {{ b }} → a) → f b → f a
+  x <$ m = fmap (λ b → x {{b}}) m
+
+-- ** export
+open Functor ⦃...⦄ public
+{-# COMPILE AGDA2HS Functor existing-class #-}
+
+_<$>_ : {{Functor f}} → (a → b) → f a → f b
+_<$>_ = fmap
+
+_<&>_ : {{Functor f}} → f a → (a → b) → f b
+m <&> f = fmap f m
+
+_$>_ : {{Functor f}} → f a → (@0 {{ a }} → b) → f b
+m $> x = x <$ m
+
+void : {{Functor f}} → f a → f ⊤
+void = tt <$_
+
+infixl 1 _<&>_
+infixl 4 _<$>_ _$>_
+
+instance
+  iDefaultFunctorList : DefaultFunctor List
+  iDefaultFunctorList .DefaultFunctor.fmap = map
+
+  iFunctorList : Functor List
+  iFunctorList = record{DefaultFunctor iDefaultFunctorList}
+
+  iDefaultFunctorMaybe : DefaultFunctor Maybe
+  iDefaultFunctorMaybe .DefaultFunctor.fmap = λ where
+    f Nothing  → Nothing
+    f (Just x) → Just (f x)
+
+  iFunctorMaybe : Functor Maybe
+  iFunctorMaybe = record{DefaultFunctor iDefaultFunctorMaybe}
+
+  iDefaultFunctorEither : DefaultFunctor (Either a)
+  iDefaultFunctorEither .DefaultFunctor.fmap = λ where
+    f (Left  x) → Left x
+    f (Right y) → Right (f y)
+
+  iFunctorEither : Functor (Either a)
+  iFunctorEither = record{DefaultFunctor iDefaultFunctorEither}
+
+  iDefaultFunctorFun : DefaultFunctor (λ b → a → b)
+  iDefaultFunctorFun .DefaultFunctor.fmap = _∘_
+
+  iFunctorFun : Functor (λ b → a → b)
+  iFunctorFun = record{DefaultFunctor iDefaultFunctorFun}
+
+  iDefaultFunctorTuple₂ : DefaultFunctor (a ×_)
+  iDefaultFunctorTuple₂ .DefaultFunctor.fmap = λ f (x , y) → x , f y
+
+  iFunctorTuple₂ : Functor (a ×_)
+  iFunctorTuple₂ = record{DefaultFunctor iDefaultFunctorTuple₂}
+
+  iDefaultFunctorTuple₃ : DefaultFunctor (a × b ×_)
+  iDefaultFunctorTuple₃ .DefaultFunctor.fmap = λ where f (x , y , z) → x , y , f z
+
+  iFunctorTuple₃ : Functor (a × b ×_)
+  iFunctorTuple₃ = record{DefaultFunctor iDefaultFunctorTuple₃}
+
+instance postulate iFunctorIO : Functor IO
+
\ No newline at end of file diff --git a/test/Haskell.Prim.IO.html b/test/Haskell.Prim.IO.html new file mode 100644 index 00000000..03f84638 --- /dev/null +++ b/test/Haskell.Prim.IO.html @@ -0,0 +1,29 @@ + +Haskell.Prim.IO
module Haskell.Prim.IO where
+
+open import Haskell.Prim
+open import Haskell.Prim.Show
+open import Haskell.Prim.String
+
+postulate IO : ∀{a} → Set a → Set a
+
+FilePath = String
+
+postulate
+  -- Input functions
+  interact       : (String → String) → IO ⊤
+  getContents    : IO String
+  getLine        : IO String
+  getChar        : IO Char
+
+  -- Output functions
+  print          : ⦃ Show a ⦄ → a → IO ⊤
+  putChar        : Char → IO ⊤
+  putStr         : String → IO ⊤
+  putStrLn       : String → IO ⊤
+
+  -- Files
+  readFile       : FilePath → IO String
+  writeFile      : FilePath → String → IO ⊤
+  appendFile     : FilePath → String → IO ⊤
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Int.html b/test/Haskell.Prim.Int.html new file mode 100644 index 00000000..65fd41c2 --- /dev/null +++ b/test/Haskell.Prim.Int.html @@ -0,0 +1,112 @@ + +Haskell.Prim.Int
{-# OPTIONS --no-auto-inline #-}
+
+-- Agda doesn't have an Int type (only Word64). With some work we
+-- can represent signed ints using Word64.
+
+module Haskell.Prim.Int where
+
+open import Haskell.Prim
+open import Haskell.Prim.Word
+open import Haskell.Prim.Integer
+open import Haskell.Prim.Bool
+
+
+--------------------------------------------------
+-- Definition
+
+data Int : Set where
+  int64 : Word64 → Int
+
+intToWord : Int → Word64
+intToWord (int64 a) = a
+
+unsafeIntToNat : Int → Nat
+unsafeIntToNat a = w2n (intToWord a)
+
+
+--------------------------------------------------
+-- Literals
+
+private
+  2⁶⁴ : Nat
+  2⁶⁴ = 18446744073709551616
+
+  2⁶³ : Nat
+  2⁶³ = 9223372036854775808
+
+  maxInt : Nat
+  maxInt = monusNat 2⁶³ 1
+
+instance
+  iNumberInt : Number Int
+  iNumberInt .Number.Constraint n = IsTrue (ltNat n 2⁶³)
+  iNumberInt .fromNat n = int64 (n2w n)
+
+  iNegativeInt : Negative Int
+  iNegativeInt .Negative.Constraint n = IsTrue (ltNat n (addNat 1 2⁶³))
+  iNegativeInt .fromNeg n = int64 (n2w (monusNat 2⁶⁴ n))
+
+
+--------------------------------------------------
+-- Arithmetic
+
+isNegativeInt : Int → Bool
+isNegativeInt (int64 w) = ltNat maxInt (w2n w)
+
+eqInt : Int → Int → Bool
+eqInt (int64 a) (int64 b) = eqNat (w2n a) (w2n b)
+
+negateInt : Int → Int
+negateInt (int64 a) = int64 (n2w (monusNat 2⁶⁴ (w2n a)))
+
+intToInteger : Int → Integer
+intToInteger a = if isNegativeInt a then negsuc (monusNat (unsafeIntToNat (negateInt a)) 1)
+                                    else pos (unsafeIntToNat a)
+
+integerToInt : Integer → Int
+integerToInt (pos    n) = int64 (n2w n)
+integerToInt (negsuc n) = negateInt (int64 (n2w (suc n)))
+
+private
+  ltPosInt : Int → Int → Bool
+  ltPosInt (int64 a) (int64 b) = ltWord a b
+
+ltInt : Int → Int → Bool
+ltInt a b with isNegativeInt a | isNegativeInt b
+... | True  | False = True
+... | False | True  = False
+... | True  | True  = ltPosInt (negateInt b) (negateInt a)
+... | False | False = ltPosInt a b
+
+addInt : Int → Int → Int
+addInt (int64 a) (int64 b) = int64 (addWord a b)
+
+subInt : Int → Int → Int
+subInt a b = addInt a (negateInt b)
+
+mulInt : Int → Int → Int
+mulInt (int64 a) (int64 b) = int64 (mulWord a b)
+
+absInt : Int → Int
+absInt a = if isNegativeInt a then negateInt a else a
+
+signInt : Int → Int
+signInt a = if      isNegativeInt a then -1
+            else if eqInt a 0       then 0 else 1
+
+showInt : Int → List Char
+showInt a = showInteger (intToInteger a)
+
+
+--------------------------------------------------
+-- Constraints
+
+@0 IsNonNegativeInt : Int → Set
+IsNonNegativeInt a@(int64 _) =
+  if isNegativeInt a then TypeError (primStringAppend (primStringFromList (showInt a)) " is negative")
+                     else ⊤
+
+intToNat : (a : Int) → @0 ⦃ IsNonNegativeInt a ⦄ → Nat
+intToNat a = unsafeIntToNat a
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Integer.html b/test/Haskell.Prim.Integer.html new file mode 100644 index 00000000..26a4dd97 --- /dev/null +++ b/test/Haskell.Prim.Integer.html @@ -0,0 +1,108 @@ + +Haskell.Prim.Integer
+module Haskell.Prim.Integer where
+
+open import Haskell.Prim
+open import Haskell.Prim.Bool
+
+{-|
+This module contains functions that should not be used
+within code that is supposed to be translated to Haskell.
+Nevertheless, these functions must be accessible for
+proofs (within the standard library).
+Hence, these functions are not flagged as private but
+instead are collected in a dedicated module that is not
+opened by default.
+-}
+module Internal where
+  negNat : Nat → Integer
+  negNat 0       = pos 0
+  negNat (suc n) = negsuc n
+
+  subNat : Nat → Nat → Integer
+  subNat n       zero    = pos n
+  subNat zero    (suc m) = negsuc m
+  subNat (suc n) (suc m) = subNat n m
+open Internal
+
+--------------------------------------------------
+-- Literals
+
+
+instance
+  iNumberInteger : Number Integer
+  iNumberInteger .Number.Constraint _ = ⊤
+  iNumberInteger .fromNat n = pos n
+
+  iNegativeInteger : Negative Integer
+  iNegativeInteger .Negative.Constraint _ = ⊤
+  iNegativeInteger .fromNeg n = negNat n
+
+
+--------------------------------------------------
+-- Arithmetic
+
+negateInteger : Integer → Integer
+negateInteger (pos 0)       = pos 0
+negateInteger (pos (suc n)) = negsuc n
+negateInteger (negsuc n)    = pos (suc n)
+
+addInteger : Integer → Integer → Integer
+addInteger (pos    n) (pos    m) = pos (addNat n m)
+addInteger (pos    n) (negsuc m) = subNat n (suc m)
+addInteger (negsuc n) (pos    m) = subNat m (suc n)
+addInteger (negsuc n) (negsuc m) = negsuc (suc (addNat n m))
+
+subInteger : Integer → Integer → Integer
+subInteger n m = addInteger n (negateInteger m)
+
+mulInteger : Integer → Integer → Integer
+mulInteger (pos    n) (pos    m) = pos (mulNat n m)
+mulInteger (pos    n) (negsuc m) = negNat (mulNat n (suc m))
+mulInteger (negsuc n) (pos    m) = negNat (mulNat (suc n) m)
+mulInteger (negsuc n) (negsuc m) = pos (mulNat (suc n) (suc m))
+
+absInteger : Integer → Integer
+absInteger (pos    n) = pos n
+absInteger (negsuc n) = pos (suc n)
+
+signInteger : Integer → Integer
+signInteger (pos 0)       = 0
+signInteger (pos (suc _)) = 1
+signInteger (negsuc _)    = -1
+
+
+--------------------------------------------------
+-- Comparisons
+
+eqInteger : Integer → Integer → Bool
+eqInteger (pos n)    (pos m)    = eqNat n m
+eqInteger (negsuc n) (negsuc m) = eqNat n m
+eqInteger _          _          = False
+
+ltInteger : Integer → Integer → Bool
+ltInteger (pos    n) (pos    m) = ltNat n m
+ltInteger (pos    n) (negsuc _) = False
+ltInteger (negsuc n) (pos    _) = True
+ltInteger (negsuc n) (negsuc m) = ltNat m n
+
+
+--------------------------------------------------
+-- Show
+
+showInteger : Integer → List Char
+showInteger n = primStringToList (primShowInteger n)
+
+
+--------------------------------------------------
+-- Constraints
+
+isNegativeInteger : Integer → Bool
+isNegativeInteger (pos _)    = False
+isNegativeInteger (negsuc _) = True
+
+@0 IsNonNegativeInteger : Integer → Set
+IsNonNegativeInteger (pos _)      = ⊤
+IsNonNegativeInteger n@(negsuc _) =
+  TypeError (primStringAppend (primShowInteger n) (" is negative"))
+
\ No newline at end of file diff --git a/test/Haskell.Prim.List.html b/test/Haskell.Prim.List.html new file mode 100644 index 00000000..8ea8afad --- /dev/null +++ b/test/Haskell.Prim.List.html @@ -0,0 +1,130 @@ + +Haskell.Prim.List
+module Haskell.Prim.List where
+
+open import Haskell.Prim
+open import Haskell.Prim.Bool
+open import Haskell.Prim.Tuple
+open import Haskell.Prim.Int
+
+
+--------------------------------------------------
+-- List
+
+map : (a → b) → List a → List b
+map f []       = []
+map f (x ∷ xs) = f x ∷ map f xs
+
+infixr 5 _++_
+_++_ : ∀ {@0 ℓ} {@0 a : Set ℓ} → List a → List a → List a
+[]       ++ ys = ys
+(x ∷ xs) ++ ys = x ∷ xs ++ ys
+
+filter : (a → Bool) → List a → List a
+filter p []       = []
+filter p (x ∷ xs) = if p x then x ∷ filter p xs else filter p xs
+
+scanl : (b → a → b) → b → List a → List b
+scanl f z []       = z ∷ []
+scanl f z (x ∷ xs) = z ∷ scanl f (f z x) xs
+
+scanr : (a → b → b) → b → List a → List b
+scanr f z [] = z ∷ []
+scanr f z (x ∷ xs) =
+  case scanr f z xs of λ where
+    []         → [] -- impossible
+    qs@(q ∷ _) → f x q ∷ qs
+
+scanl1 : (a → a → a) → List a → List a
+scanl1 f []       = []
+scanl1 f (x ∷ xs) = scanl f x xs
+
+scanr1 : (a → a → a) → List a → List a
+scanr1 f []       = []
+scanr1 f (x ∷ []) = x ∷ []
+scanr1 f (x ∷ xs) =
+  case scanr1 f xs of λ where
+    []         → [] -- impossible
+    qs@(q ∷ _) → f x q ∷ qs
+
+takeWhile : (a → Bool) → List a → List a
+takeWhile p [] = []
+takeWhile p (x ∷ xs) = if p x then x ∷ takeWhile p xs else []
+
+dropWhile : (a → Bool) → List a → List a
+dropWhile p [] = []
+dropWhile p (x ∷ xs) = if p x then dropWhile p xs else x ∷ xs
+
+span : (a → Bool) → List a → List a × List a
+span p [] = [] , []
+span p (x ∷ xs) = if p x then first (x ∷_) (span p xs)
+                         else ([] , x ∷ xs)
+
+break : (a → Bool) → List a → List a × List a
+break p = span (not ∘ p)
+
+zipWith : (a → b → c) → List a → List b → List c
+zipWith f []       _        = []
+zipWith f _        []       = []
+zipWith f (x ∷ xs) (y ∷ ys) = f x y ∷ zipWith f xs ys
+
+zip : List a → List b → List (a × b)
+zip = zipWith _,_
+
+zipWith3 : (a → b → c → d) → List a → List b → List c → List d
+zipWith3 f []       _        _        = []
+zipWith3 f _        []       _        = []
+zipWith3 f _        _        []       = []
+zipWith3 f (x ∷ xs) (y ∷ ys) (z ∷ zs) = f x y z ∷ zipWith3 f xs ys zs
+
+zip3 : List a → List b → List c → List (a × b × c)
+zip3 = zipWith3 _,_,_
+
+unzip : List (a × b) → List a × List b
+unzip []              = [] , []
+unzip ((x , y) ∷ xys) = (x ∷_) *** (y ∷_) $ unzip xys
+
+unzip3 : List (a × b × c) → List a × List b × List c
+unzip3 []                   = [] , [] , []
+unzip3 ((x , y , z) ∷ xyzs) =
+  case unzip3 xyzs of λ where
+    (xs , ys , zs) → x ∷ xs , y ∷ ys , z ∷ zs
+
+takeNat : Nat → List a → List a
+takeNat n       [] = []
+takeNat zero    xs = []
+takeNat (suc n) (x ∷ xs) = x ∷ takeNat n xs
+
+take : (n : Int) → @0 ⦃ IsNonNegativeInt n ⦄ → List a → List a
+take n xs = takeNat (intToNat n) xs
+
+dropNat : Nat → List a → List a
+dropNat n       [] = []
+dropNat zero    xs = xs
+dropNat (suc n) (_ ∷ xs) = dropNat n xs
+
+drop : (n : Int) → @0 ⦃ IsNonNegativeInt n ⦄ → List a → List a
+drop n xs = dropNat (intToNat n) xs
+
+splitAtNat : (n : Nat) → List a → List a × List a
+splitAtNat _       []       = [] , []
+splitAtNat 0       xs       = [] , xs
+splitAtNat (suc n) (x ∷ xs) = first (x ∷_) (splitAtNat n xs)
+
+splitAt : (n : Int) → @0 ⦃ IsNonNegativeInt n ⦄ → List a → List a × List a
+splitAt n xs = splitAtNat (intToNat n) xs
+
+head : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → a
+head (x ∷ _) = x
+
+tail : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → List a
+tail (_ ∷ xs) = xs
+
+last : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → a
+last (x ∷ [])         = x
+last (_ ∷ xs@(_ ∷ _)) = last xs
+
+init : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → List a
+init (x ∷ [])         = []
+init (x ∷ xs@(_ ∷ _)) = x ∷ init xs
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Maybe.html b/test/Haskell.Prim.Maybe.html new file mode 100644 index 00000000..e0cd83ca --- /dev/null +++ b/test/Haskell.Prim.Maybe.html @@ -0,0 +1,19 @@ + +Haskell.Prim.Maybe
+module Haskell.Prim.Maybe where
+
+--------------------------------------------------
+-- Maybe
+
+data Maybe {@0 ℓ} (a : Set ℓ) : Set ℓ where
+  Nothing : Maybe a
+  Just    : a -> Maybe a
+
+maybe : ∀ {@0 ℓ₁ ℓ₂} {@0 a : Set ℓ₁} {@0 b : Set ℓ₂} → b → (a → b) → Maybe a → b
+maybe n j Nothing  = n
+maybe n j (Just x) = j x
+
+fromMaybe : {a : Set} → a → Maybe a → a
+fromMaybe d Nothing = d
+fromMaybe _ (Just x) = x
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Monad.html b/test/Haskell.Prim.Monad.html new file mode 100644 index 00000000..b39a38fb --- /dev/null +++ b/test/Haskell.Prim.Monad.html @@ -0,0 +1,131 @@ + +Haskell.Prim.Monad
+module Haskell.Prim.Monad where
+
+open import Haskell.Prim
+open import Haskell.Prim.Applicative
+open import Haskell.Prim.Either
+open import Haskell.Prim.Foldable
+open import Haskell.Prim.Functor
+open import Haskell.Prim.IO
+open import Haskell.Prim.List
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Monoid
+open import Haskell.Prim.String
+open import Haskell.Prim.Tuple
+
+--------------------------------------------------
+-- Monad
+
+module Do where
+
+  -- ** base
+  record Monad (m : Set → Set) : Set₁ where
+    field
+      _>>=_ : m a → (a → m b) → m b
+      overlap ⦃ super ⦄ : Applicative m
+      return : a → m a
+      _>>_ : m a → (@0 {{ a }} → m b) → m b
+  -- ** defaults
+  record DefaultMonad (m : Set → Set) : Set₁ where
+    field
+      _>>=_ : m a → (a → m b) → m b
+      overlap ⦃ super ⦄ : Applicative m
+    return : a → m a
+    return = pure
+
+    _>>_ : m a → (@0 {{ a }} → m b) → m b
+    m >> m₁ = m >>= λ x → m₁ {{x}}
+
+  -- ** export
+  open Monad ⦃...⦄ public
+  {-# COMPILE AGDA2HS Monad existing-class #-}
+
+-- Use `Dont._>>=_` and `Dont._>>_` if you do not want agda2hs to use
+-- do-notation.
+module Dont where
+
+  open Do using (Monad)
+
+  _>>=_ : ⦃ Monad m ⦄ → m a → (a → m b) → m b
+  _>>=_ = Do._>>=_
+
+  _>>_ : ⦃ Monad m ⦄ → m a → (@0 {{ a }} → m b) → m b
+  _>>_ = Do._>>_
+
+open Do public
+
+_=<<_ : {{Monad m}} → (a → m b) → m a → m b
+_=<<_ = flip _>>=_
+
+mapM₋ : ⦃ Monad m ⦄ → ⦃ Foldable t ⦄ → (a → m b) → t a → m ⊤
+mapM₋ f = foldr (λ x k → f x >> k) (pure tt)
+
+sequence₋ : ⦃ Monad m ⦄ → ⦃ Foldable t ⦄ → t (m a) → m ⊤
+sequence₋ = foldr (λ mx my → mx >> my) (pure tt)
+
+-- ** instances
+private
+  mkMonad : DefaultMonad t → Monad t
+  mkMonad x = record {DefaultMonad x}
+
+  infix 0 bind=_
+  bind=_ : ⦃ Applicative m ⦄ → (∀ {a b} → m a → (a → m b) → m b) → Monad m
+  bind= x = record {DefaultMonad (record {_>>=_ = x})}
+instance
+  iDefaultMonadList : DefaultMonad List
+  iDefaultMonadList .DefaultMonad._>>=_ = flip concatMap
+
+  iMonadList : Monad List
+  iMonadList = record {DefaultMonad iDefaultMonadList}
+
+  iDefaultMonadMaybe : DefaultMonad Maybe
+  iDefaultMonadMaybe .DefaultMonad._>>=_ = flip (maybe Nothing)
+
+  iMonadMaybe : Monad Maybe
+  iMonadMaybe = record {DefaultMonad iDefaultMonadMaybe}
+
+  iDefaultMonadEither : DefaultMonad (Either a)
+  iDefaultMonadEither .DefaultMonad._>>=_ = flip (either Left)
+
+  iMonadEither : Monad (Either a)
+  iMonadEither = record {DefaultMonad iDefaultMonadEither}
+
+  iDefaultMonadFun : DefaultMonad (λ b → a → b)
+  iDefaultMonadFun .DefaultMonad._>>=_ = λ f k r → k (f r) r
+
+  iMonadFun : Monad (λ b → a → b)
+  iMonadFun = record {DefaultMonad iDefaultMonadFun}
+
+  iDefaultMonadTuple₂ : ⦃ Monoid a ⦄ → DefaultMonad (a ×_)
+  iDefaultMonadTuple₂ .DefaultMonad._>>=_ = λ (a , x) k → first (a <>_) (k x)
+
+  iMonadTuple₂ : ⦃ Monoid a ⦄ → Monad (a ×_)
+  iMonadTuple₂ = record {DefaultMonad iDefaultMonadTuple₂}
+
+  iDefaultMonadTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → DefaultMonad (a × b ×_)
+  iDefaultMonadTuple₃ .DefaultMonad._>>=_ = λ where
+    (a , b , x) k → case k x of λ where
+      (a₁ , b₁ , y) → a <> a₁ , b <> b₁ , y
+
+  iMonadTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Monad (a × b ×_)
+  iMonadTuple₃ = record {DefaultMonad iDefaultMonadTuple₃}
+
+instance postulate iMonadIO : Monad IO
+
+record MonadFail (m : Set → Set) : Set₁ where
+  field
+    fail : String → m a
+    overlap ⦃ super ⦄ : Monad m
+
+open MonadFail ⦃...⦄ public
+
+{-# COMPILE AGDA2HS MonadFail existing-class #-}
+
+instance
+  MonadFailList : MonadFail List
+  MonadFailList .fail _ = []
+
+  MonadFailMaybe : MonadFail Maybe
+  MonadFailMaybe .fail _ = Nothing
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Monoid.html b/test/Haskell.Prim.Monoid.html new file mode 100644 index 00000000..caa4ce8d --- /dev/null +++ b/test/Haskell.Prim.Monoid.html @@ -0,0 +1,132 @@ + +Haskell.Prim.Monoid
+module Haskell.Prim.Monoid where
+
+open import Haskell.Prim
+open import Haskell.Prim.Bool
+open import Haskell.Prim.List
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Either
+open import Haskell.Prim.Tuple
+
+--------------------------------------------------
+-- Semigroup
+
+record Semigroup (a : Set) : Set where
+  infixr 6 _<>_
+  field _<>_ : a → a → a
+open Semigroup ⦃...⦄ public
+{-# COMPILE AGDA2HS Semigroup existing-class #-}
+
+instance
+  iSemigroupList : Semigroup (List a)
+  iSemigroupList ._<>_ = _++_
+
+  iSemigroupMaybe : ⦃ Semigroup a ⦄ → Semigroup (Maybe a)
+  iSemigroupMaybe ._<>_          Nothing m = m
+  iSemigroupMaybe ._<>_ m        Nothing   = m
+  iSemigroupMaybe ._<>_ (Just x) (Just y)  = Just (x <> y)
+
+  iSemigroupEither : Semigroup (Either a b)
+  iSemigroupEither ._<>_ (Left _) e = e
+  iSemigroupEither ._<>_ e        _ = e
+
+  iSemigroupFun : ⦃ Semigroup b ⦄ → Semigroup (a → b)
+  iSemigroupFun ._<>_ f g x = f x <> g x
+
+  iSemigroupUnit : Semigroup ⊤
+  iSemigroupUnit ._<>_ _ _ = tt
+
+
+  iSemigroupTuple₂ : ⦃ Semigroup a ⦄ → ⦃ Semigroup b ⦄ → Semigroup (a × b)
+  iSemigroupTuple₂ ._<>_ (x₁ , y₁) (x₂ , y₂) = x₁ <> x₂ , y₁ <> y₂
+
+  iSemigroupTuple₃ : ⦃ Semigroup a ⦄ → ⦃ Semigroup b ⦄ → ⦃ Semigroup c ⦄ → Semigroup (a × b × c)
+  iSemigroupTuple₃ ._<>_ (x₁ , y₁ , z₁) (x₂ , y₂ , z₂) = x₁ <> x₂ , y₁ <> y₂ , z₁ <> z₂
+
+
+--------------------------------------------------
+-- Monoid
+
+-- ** base
+record Monoid (a : Set) : Set where
+  field
+    mempty : a
+    overlap ⦃ super ⦄ : Semigroup a
+    mappend : a → a → a
+    mconcat : List a → a
+-- ** defaults
+record DefaultMonoid (a : Set) : Set where
+  field
+    mempty : a
+    overlap ⦃ super ⦄ : Semigroup a
+
+  mappend : a → a → a
+  mappend = _<>_
+
+  mconcat : List a → a
+  mconcat []       = mempty
+  mconcat (x ∷ xs) = x <> mconcat xs
+-- ** export
+open Monoid ⦃...⦄ public
+{-# COMPILE AGDA2HS Monoid existing-class #-}
+-- ** instances
+instance
+  iDefaultMonoidList : DefaultMonoid (List a)
+  iDefaultMonoidList .DefaultMonoid.mempty = []
+
+  iMonoidList : Monoid (List a)
+  iMonoidList = record{DefaultMonoid iDefaultMonoidList}
+
+  iDefaultMonoidMaybe : ⦃ Semigroup a ⦄ → DefaultMonoid (Maybe a)
+  iDefaultMonoidMaybe .DefaultMonoid.mempty = Nothing
+
+  iMonoidMaybe : ⦃ Semigroup a ⦄ → Monoid (Maybe a)
+  iMonoidMaybe = record{DefaultMonoid iDefaultMonoidMaybe}
+
+  iDefaultMonoidFun : ⦃ Monoid b ⦄ → DefaultMonoid (a → b)
+  iDefaultMonoidFun .DefaultMonoid.mempty = λ _ → mempty
+
+  iMonoidFun : ⦃ Monoid b ⦄ → Monoid (a → b)
+  iMonoidFun = record{DefaultMonoid iDefaultMonoidFun}
+
+  iDefaultMonoidUnit : DefaultMonoid ⊤
+  iDefaultMonoidUnit .DefaultMonoid.mempty = tt
+
+  iMonoidUnit : Monoid ⊤
+  iMonoidUnit = record{DefaultMonoid iDefaultMonoidUnit}
+
+  iDefaultMonoidTuple₂ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → DefaultMonoid (a × b)
+  iDefaultMonoidTuple₂ .DefaultMonoid.mempty = (mempty , mempty)
+
+  iMonoidTuple₂ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Monoid (a × b)
+  iMonoidTuple₂ = record{DefaultMonoid iDefaultMonoidTuple₂}
+
+  iDefaultMonoidTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → ⦃ Monoid c ⦄ → DefaultMonoid (a × b × c)
+  iDefaultMonoidTuple₃ .DefaultMonoid.mempty = (mempty , mempty , mempty)
+
+  iMonoidTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → ⦃ Monoid c ⦄ →  Monoid (a × b × c)
+  iMonoidTuple₃ = record{DefaultMonoid iDefaultMonoidTuple₃}
+
+open DefaultMonoid
+
+MonoidEndo : Monoid (a → a)
+MonoidEndo = record {DefaultMonoid (λ where
+      .mempty → id
+      .super ._<>_ → _∘_)}
+
+MonoidEndoᵒᵖ : Monoid (a → a)
+MonoidEndoᵒᵖ = record {DefaultMonoid (λ where
+  .mempty      → id
+  .super ._<>_ → flip _∘_) }
+
+MonoidConj : Monoid Bool
+MonoidConj = record {DefaultMonoid (λ where
+  .mempty      → True
+  .super ._<>_ → _&&_)}
+
+MonoidDisj : Monoid Bool
+MonoidDisj = record {DefaultMonoid (λ where
+  .mempty      → False
+  .super ._<>_ → _||_)}
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Num.html b/test/Haskell.Prim.Num.html new file mode 100644 index 00000000..dc1fb841 --- /dev/null +++ b/test/Haskell.Prim.Num.html @@ -0,0 +1,122 @@ + +Haskell.Prim.Num
{-# OPTIONS --no-auto-inline #-}
+
+module Haskell.Prim.Num where
+
+open import Haskell.Prim
+open import Haskell.Prim.Word
+open import Haskell.Prim.Int
+open import Haskell.Prim.Integer
+open import Haskell.Prim.Double
+open import Haskell.Prim.Eq
+open import Haskell.Prim.Ord
+open import Haskell.Prim.Monoid
+
+--------------------------------------------------
+-- Num
+
+record Num (a : Set) : Set₁ where
+  infixl 6 _+_ _-_
+  infixl 7 _*_
+  field
+    @0 MinusOK       : a → a → Set
+    @0 NegateOK      : a → Set
+    @0 FromIntegerOK : Integer → Set
+    _+_           : a → a → a
+    _-_           : (x y : a) → @0 ⦃ MinusOK x y ⦄ → a
+    _*_           : a → a → a
+    negate        : (x : a) → @0 ⦃ NegateOK x ⦄ → a
+    abs           : a → a
+    signum        : a → a
+    fromInteger   : (n : Integer) → @0 ⦃ FromIntegerOK n ⦄ → a
+    overlap ⦃ number ⦄  : Number a
+    overlap ⦃ numZero ⦄ : number .Number.Constraint 0
+    overlap ⦃ numOne ⦄  : number .Number.Constraint 1
+
+open Num ⦃...⦄ public hiding (FromIntegerOK; number)
+
+{-# COMPILE AGDA2HS Num existing-class #-}
+
+instance
+  iNumNat : Num Nat
+  iNumNat .MinusOK n m      = IsFalse (ltNat n m)
+  iNumNat .NegateOK 0       = ⊤
+  iNumNat .NegateOK (suc _) = ⊥
+  iNumNat .Num.FromIntegerOK (negsuc _) = ⊥
+  iNumNat .Num.FromIntegerOK (pos _) = ⊤
+  iNumNat ._+_ n m = addNat n m
+  iNumNat ._-_ n m = monusNat n m
+  iNumNat ._*_ n m = mulNat n m
+  iNumNat .negate n = n
+  iNumNat .abs    n = n
+  iNumNat .signum 0       = 0
+  iNumNat .signum (suc n) = 1
+  iNumNat .fromInteger (pos n) = n
+  iNumNat .fromInteger (negsuc _) ⦃ () ⦄
+
+  iNumInt : Num Int
+  iNumInt .MinusOK _ _         = ⊤
+  iNumInt .NegateOK _          = ⊤
+  iNumInt .Num.FromIntegerOK _ = ⊤
+  iNumInt ._+_ x y             = addInt x y
+  iNumInt ._-_ x y             = subInt x y
+  iNumInt ._*_ x y             = mulInt x y
+  iNumInt .negate x            = negateInt x
+  iNumInt .abs x               = absInt x
+  iNumInt .signum x            = signInt x
+  iNumInt .fromInteger n       = integerToInt n
+
+  iNumInteger : Num Integer
+  iNumInteger .MinusOK _ _ = ⊤
+  iNumInteger .NegateOK _          = ⊤
+  iNumInteger .Num.FromIntegerOK _ = ⊤
+  iNumInteger ._+_ x y             = addInteger x y
+  iNumInteger ._-_ x y             = subInteger x y
+  iNumInteger ._*_ x y             = mulInteger x y
+  iNumInteger .negate x            = negateInteger x
+  iNumInteger .abs x               = absInteger x
+  iNumInteger .signum x            = signInteger x
+  iNumInteger .fromInteger n       = n
+
+  iNumWord : Num Word
+  iNumWord .MinusOK _ _         = ⊤
+  iNumWord .NegateOK _          = ⊤
+  iNumWord .Num.FromIntegerOK _ = ⊤
+  iNumWord ._+_ x y             = addWord x y
+  iNumWord ._-_ x y             = subWord x y
+  iNumWord ._*_ x y             = mulWord x y
+  iNumWord .negate x            = negateWord x
+  iNumWord .abs x               = x
+  iNumWord .signum x            = if x == 0 then 0 else 1
+  iNumWord .fromInteger n       = integerToWord n
+
+  iNumDouble : Num Double
+  iNumDouble .MinusOK _ _         = ⊤
+  iNumDouble .NegateOK _          = ⊤
+  iNumDouble .Num.FromIntegerOK _ = ⊤
+  iNumDouble ._+_ x y             = primFloatPlus x y
+  iNumDouble ._-_ x y             = primFloatMinus x y
+  iNumDouble ._*_ x y             = primFloatTimes x y
+  iNumDouble .negate x            = primFloatMinus 0.0 x
+  iNumDouble .abs x               = if x < 0.0 then primFloatMinus 0.0 x else x
+  iNumDouble .signum x            = case compare x 0.0 of λ where
+                                      LT → -1.0
+                                      EQ → x
+                                      GT → 1.0
+  iNumDouble .fromInteger (pos    n) = fromNat n
+  iNumDouble .fromInteger (negsuc n) = fromNeg (suc n)
+
+open DefaultMonoid
+
+MonoidSum : ⦃ iNum : Num a ⦄ → Monoid a
+MonoidSum = record {DefaultMonoid (λ where
+  .mempty      → 0
+  .super ._<>_ → _+_
+ )}
+
+MonoidProduct : ⦃ iNum : Num a ⦄ → Monoid a
+MonoidProduct = record {DefaultMonoid (λ where
+  .mempty      → 1
+  .super ._<>_ → _*_
+ )}
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Ord.html b/test/Haskell.Prim.Ord.html new file mode 100644 index 00000000..275bf593 --- /dev/null +++ b/test/Haskell.Prim.Ord.html @@ -0,0 +1,236 @@ + +Haskell.Prim.Ord
+module Haskell.Prim.Ord where
+
+open import Haskell.Prim
+open import Haskell.Prim.Eq
+open import Haskell.Prim.Bool
+open import Haskell.Prim.Int
+open import Haskell.Prim.Word
+open import Haskell.Prim.Integer
+open import Haskell.Prim.Double
+open import Haskell.Prim.Tuple
+open import Haskell.Prim.Monoid
+open import Haskell.Prim.List
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Either
+
+--------------------------------------------------
+-- Ordering
+
+data Ordering : Set where
+  LT EQ GT : Ordering
+
+instance
+  iEqOrdering : Eq Ordering
+  iEqOrdering ._==_ LT LT = True
+  iEqOrdering ._==_ EQ EQ = True
+  iEqOrdering ._==_ GT GT = True
+  iEqOrdering ._==_ _  _  = False
+
+  iSemigroupOrdering : Semigroup Ordering
+  iSemigroupOrdering ._<>_ LT _ = LT
+  iSemigroupOrdering ._<>_ EQ o = o
+  iSemigroupOrdering ._<>_ GT _ = GT
+
+  iMonoidOrdering : Monoid Ordering
+  iMonoidOrdering = record {DefaultMonoid (record {mempty = EQ})}
+
+--------------------------------------------------
+-- Ord
+
+record Ord (a : Set) : Set where
+  field
+    compare : a → a → Ordering
+    _<_  : a → a → Bool
+    _>_  : a → a → Bool
+    _>=_ : a → a → Bool
+    _<=_ : a → a → Bool
+    max  : a → a → a
+    min  : a → a → a
+    overlap ⦃ super ⦄ : Eq a
+
+  infix 4 _<_ _>_ _<=_ _>=_
+
+record OrdFromCompare (a : Set) : Set where
+  field
+    compare : a → a → Ordering
+    overlap ⦃ super ⦄ : Eq a
+
+  _<_  : a → a → Bool
+  x < y = compare x y == LT
+
+  _>_  : a → a → Bool
+  x > y = compare x y == GT
+
+  _>=_ : a → a → Bool
+  x >= y = compare x y /= LT
+
+  _<=_ : a → a → Bool
+  x <= y = compare x y /= GT
+
+  max  : a → a → a
+  max x y = if compare x y == LT then y else x
+
+  min  : a → a → a
+  min x y = if compare x y == GT then y else x
+
+record OrdFromLessThan (a : Set) : Set where
+  field
+    _<_ : a → a → Bool
+    overlap ⦃ super ⦄ : Eq a
+
+  compare : a → a → Ordering
+  compare x y = if x < y then LT else if x == y then EQ else GT
+
+  _>_  : a → a → Bool
+  x > y = y < x
+
+  _>=_ : a → a → Bool
+  x >= y = y < x || x == y
+
+  _<=_ : a → a → Bool
+  x <= y = x < y || x == y
+
+  max  : a → a → a
+  max x y = if x < y then y else x
+
+  min  : a → a → a
+  min x y = if y < x then y else x
+
+
+open Ord ⦃...⦄ public
+
+{-# COMPILE AGDA2HS Ord existing-class #-}
+
+private
+  compareFromLt : ⦃ Eq a ⦄ → (a → a → Bool) → a → a → Ordering
+  compareFromLt _<_ x y = if x < y then LT else if x == y then EQ else GT
+
+private
+  maxNat : Nat → Nat → Nat
+  maxNat zero    y       = y
+  maxNat (suc x) zero    = suc x
+  maxNat (suc x) (suc y) = suc (maxNat x y)
+
+  minNat : Nat → Nat → Nat
+  minNat zero    y       = zero
+  minNat (suc x) zero    = zero
+  minNat (suc x) (suc y) = suc (minNat x y)
+
+instance
+  iOrdFromLessThanNat : OrdFromLessThan Nat
+  iOrdFromLessThanNat .OrdFromLessThan._<_ = ltNat
+
+  iOrdNat : Ord Nat
+  iOrdNat = record
+    { OrdFromLessThan iOrdFromLessThanNat
+    ; max = maxNat
+    ; min = minNat
+    }
+
+  iOrdFromLessThanInteger : OrdFromLessThan Integer
+  iOrdFromLessThanInteger .OrdFromLessThan._<_ = ltInteger
+
+  iOrdInteger : Ord Integer
+  iOrdInteger = record {OrdFromLessThan iOrdFromLessThanInteger}
+
+  iOrdFromLessThanInt : OrdFromLessThan Int
+  iOrdFromLessThanInt .OrdFromLessThan._<_ = ltInt
+
+  iOrdInt : Ord Int
+  iOrdInt = record {OrdFromLessThan iOrdFromLessThanInt}
+
+  iOrdFromLessThanWord : OrdFromLessThan Word
+  iOrdFromLessThanWord .OrdFromLessThan._<_ = ltWord
+
+  iOrdWord : Ord Word
+  iOrdWord = record {OrdFromLessThan iOrdFromLessThanWord}
+
+  iOrdFromLessThanDouble : OrdFromLessThan Double
+  iOrdFromLessThanDouble .OrdFromLessThan._<_ = primFloatLess
+
+  iOrdDouble : Ord Double
+  iOrdDouble = record {OrdFromLessThan iOrdFromLessThanDouble}
+
+  iOrdFromLessThanChar : OrdFromLessThan Char
+  iOrdFromLessThanChar .OrdFromLessThan._<_ x y = c2n x < c2n y
+
+  iOrdChar : Ord Char
+  iOrdChar = record {OrdFromLessThan iOrdFromLessThanChar}
+
+  iOrdFromCompareBool : OrdFromCompare Bool
+  iOrdFromCompareBool .OrdFromCompare.compare = λ where
+    False True  → LT
+    True  False → GT
+    _     _     → EQ
+
+  iOrdBool : Ord Bool
+  iOrdBool = record {OrdFromCompare iOrdFromCompareBool}
+
+  iOrdFromCompareUnit : OrdFromCompare ⊤
+  iOrdFromCompareUnit .OrdFromCompare.compare = λ _ _ → EQ
+
+  iOrdUnit : Ord ⊤
+  iOrdUnit = record {OrdFromCompare iOrdFromCompareUnit}
+
+  iOrdFromCompareTuple₂ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → OrdFromCompare (a × b)
+  iOrdFromCompareTuple₂ .OrdFromCompare.compare = λ where
+    (x₁ , y₁) (x₂ , y₂) → compare x₁ x₂ <> compare y₁ y₂
+
+  iOrdTuple₂ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → Ord (a × b)
+  iOrdTuple₂ = record {OrdFromCompare iOrdFromCompareTuple₂}
+
+  iOrdFromCompareTuple₃ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → ⦃ Ord c ⦄ → OrdFromCompare (a × b × c)
+  iOrdFromCompareTuple₃ .OrdFromCompare.compare = λ where
+    (x₁ , y₁ , z₁) (x₂ , y₂ , z₂) → compare x₁ x₂ <> compare y₁ y₂ <> compare z₁ z₂
+
+  iOrdTuple₃ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → ⦃ Ord c ⦄ → Ord (a × b × c)
+  iOrdTuple₃ = record {OrdFromCompare iOrdFromCompareTuple₃}
+
+compareList : ⦃ Ord a ⦄ → List a → List a → Ordering
+compareList []       []       = EQ
+compareList []       (_ ∷ _)  = LT
+compareList (_ ∷ _)  []       = GT
+compareList (x ∷ xs) (y ∷ ys) = compare x y <> compareList xs ys
+
+instance
+  iOrdFromCompareList : ⦃ Ord a ⦄ → OrdFromCompare (List a)
+  iOrdFromCompareList .OrdFromCompare.compare = compareList
+
+  iOrdList : ⦃ Ord a ⦄ → Ord (List a)
+  iOrdList = record {OrdFromCompare iOrdFromCompareList}
+
+  iOrdFromCompareMaybe : ⦃ Ord a ⦄ → OrdFromCompare (Maybe a)
+  iOrdFromCompareMaybe .OrdFromCompare.compare = λ where
+    Nothing  Nothing  → EQ
+    Nothing  (Just _) → LT
+    (Just _) Nothing  → GT
+    (Just x) (Just y) → compare x y
+
+  iOrdMaybe : ⦃ Ord a ⦄ → Ord (Maybe a)
+  iOrdMaybe = record {OrdFromCompare iOrdFromCompareMaybe}
+
+  iOrdFromCompareEither : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → OrdFromCompare (Either a b)
+  iOrdFromCompareEither .OrdFromCompare.compare = λ where
+    (Left  x) (Left  y) → compare x y
+    (Left  _) (Right _) → LT
+    (Right _) (Left  _) → GT
+    (Right x) (Right y) → compare x y
+
+  iOrdEither : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → Ord (Either a b)
+  iOrdEither = record {OrdFromCompare iOrdFromCompareEither}
+
+  iOrdFromCompareOrdering : OrdFromCompare Ordering
+  iOrdFromCompareOrdering .OrdFromCompare.compare = λ where
+    LT LT → EQ
+    LT _  → LT
+    _  LT → GT
+    EQ EQ → EQ
+    EQ GT → LT
+    GT EQ → GT
+    GT GT → EQ
+
+  iOrdOrdering : Ord Ordering
+  iOrdOrdering = record {OrdFromCompare iOrdFromCompareOrdering}
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Show.html b/test/Haskell.Prim.Show.html new file mode 100644 index 00000000..cca2ad82 --- /dev/null +++ b/test/Haskell.Prim.Show.html @@ -0,0 +1,161 @@ + +Haskell.Prim.Show
+module Haskell.Prim.Show where
+
+open import Haskell.Prim
+open import Haskell.Prim.String
+open import Haskell.Prim.List
+open import Haskell.Prim.Word
+open import Haskell.Prim.Double
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Eq
+open import Haskell.Prim.Tuple
+open import Haskell.Prim.Ord
+open import Haskell.Prim.Either
+open import Haskell.Prim.Integer
+open import Haskell.Prim.Bool
+open import Haskell.Prim.Int
+open import Haskell.Prim.Foldable
+
+
+--------------------------------------------------
+-- Show
+
+ShowS : Set
+ShowS = String → String
+
+showChar : Char → ShowS
+showChar = _∷_
+
+showString : String → ShowS
+showString = _++_
+
+showParen : Bool → ShowS → ShowS
+showParen False s = s
+showParen True  s = showString "(" ∘ s ∘ showString ")"
+
+defaultShowList : (a → ShowS) → List a → ShowS
+defaultShowList shows = λ where
+  []       → showString "[]"
+  (x ∷ xs) → showString "["
+           ∘ foldl (λ s x → s ∘ showString "," ∘ shows x) (shows x) xs
+           ∘ showString "]"
+
+-- ** base
+record Show (a : Set) : Set where
+  field
+    showsPrec : Int → a → ShowS
+    showList  : List a → ShowS
+    show      : a → String
+-- ** export
+record Show₁ (a : Set) : Set where
+  field showsPrec : Int → a → ShowS
+
+  show : a → String
+  show x = showsPrec 0 x ""
+
+  showList : List a → ShowS
+  showList = defaultShowList (showsPrec 0)
+record Show₂ (a : Set) : Set where
+  field show : a → String
+
+  showsPrec : Int → a → ShowS
+  showsPrec _ x s = show x ++ s
+
+  showList : List a → ShowS
+  showList = defaultShowList (showsPrec 0)
+-- ** export
+open Show ⦃...⦄ public
+
+shows : ⦃ Show a ⦄ → a → ShowS
+shows = showsPrec 0
+
+{-# COMPILE AGDA2HS Show existing-class #-}
+
+-- ** instances
+instance
+  iShow₂Nat : Show₂ Nat
+  iShow₂Nat .Show₂.show = primStringToList ∘ primShowNat
+
+  iShowNat : Show Nat
+  iShowNat = record {Show₂ iShow₂Nat}
+
+  iShow₂Integer : Show₂ Integer
+  iShow₂Integer .Show₂.show = showInteger
+
+  iShowInteger : Show Integer
+  iShowInteger = record {Show₂ iShow₂Integer}
+
+  iShow₂Int : Show₂ Int
+  iShow₂Int .Show₂.show = showInt
+
+  iShowInt : Show Int
+  iShowInt = record{Show₂ iShow₂Int}
+
+  iShow₂Word : Show₂ Word
+  iShow₂Word .Show₂.show = showWord
+
+  iShowWord : Show Word
+  iShowWord = record{Show₂ iShow₂Word}
+
+  iShow₂Double : Show₂ Double
+  iShow₂Double .Show₂.show = primStringToList ∘ primShowFloat
+
+  iShowDouble : Show Double
+  iShowDouble = record{Show₂ iShow₂Double}
+
+  iShow₂Bool : Show₂ Bool
+  iShow₂Bool .Show₂.show = λ where False → "False"; True → "True"
+
+  iShowBool : Show Bool
+  iShowBool = record{Show₂ iShow₂Bool}
+
+  iShow₁Char : Show₁ Char
+  iShow₁Char .Show₁.showsPrec _ = showString ∘ primStringToList ∘ primShowChar
+
+  iShowChar : Show Char
+  iShowChar = record{Show₁ iShow₁Char}
+
+  iShow₁List : ⦃ Show a ⦄ → Show₁ (List a)
+  iShow₁List .Show₁.showsPrec _ = showList
+
+  iShowList : ⦃ Show a ⦄ → Show (List a)
+  iShowList = record{Show₁ iShow₁List}
+
+private
+  showApp₁ : ⦃ Show a ⦄ → Int → String → a → ShowS
+  showApp₁ p tag x = showParen (p > 10) $
+    showString tag ∘ showString " " ∘ showsPrec 11 x
+
+instance
+  iShow₁Maybe : ⦃ Show a ⦄ → Show₁ (Maybe a)
+  iShow₁Maybe .Show₁.showsPrec = λ where
+    p Nothing  → showString "Nothing"
+    p (Just x) → showApp₁ p "Just" x
+
+  iShowMaybe : ⦃ Show a ⦄ → Show (Maybe a)
+  iShowMaybe = record{Show₁ iShow₁Maybe}
+
+  iShow₁Either : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show₁ (Either a b)
+  iShow₁Either .Show₁.showsPrec = λ where
+    p (Left  x) → showApp₁ p "Left"  x
+    p (Right y) → showApp₁ p "Right" y
+
+  iShowEither : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show (Either a b)
+  iShowEither = record{Show₁ iShow₁Either}
+
+instance
+  iShow₁Tuple₂ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show₁ (a × b)
+  iShow₁Tuple₂ .Show₁.showsPrec = λ _ → λ where
+    (x , y) → showString "(" ∘ shows x ∘ showString ", " ∘ shows y ∘ showString ")"
+
+  iShowTuple₂ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show (a × b)
+  iShowTuple₂ = record{Show₁ iShow₁Tuple₂}
+
+  iShow₁Tuple₃ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → ⦃ Show c ⦄ → Show₁ (a × b × c)
+  iShow₁Tuple₃ .Show₁.showsPrec = λ _ → λ where
+    (x , y , z) → showString "(" ∘ shows x ∘ showString ", " ∘ shows y ∘ showString ", " ∘ shows z ∘ showString ")"
+
+  iShowTuple₃ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → ⦃ Show c ⦄ → Show (a × b × c)
+  iShowTuple₃ = record{Show₁ iShow₁Tuple₃}
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Strict.html b/test/Haskell.Prim.Strict.html new file mode 100644 index 00000000..d17314ef --- /dev/null +++ b/test/Haskell.Prim.Strict.html @@ -0,0 +1,14 @@ + +Haskell.Prim.Strict
+module Haskell.Prim.Strict where
+
+open import Haskell.Prim
+
+record Strict (a : Set ℓ) : Set ℓ where
+  constructor !_
+  field
+    force : a
+open Strict public
+
+{-# COMPILE AGDA2HS Strict unboxed-strict #-}
+
\ No newline at end of file diff --git a/test/Haskell.Prim.String.html b/test/Haskell.Prim.String.html new file mode 100644 index 00000000..a8ce00a4 --- /dev/null +++ b/test/Haskell.Prim.String.html @@ -0,0 +1,54 @@ + +Haskell.Prim.String
+module Haskell.Prim.String where
+
+open import Haskell.Prim
+open import Haskell.Prim.List
+open import Haskell.Prim.Foldable
+
+--------------------------------------------------
+-- String
+-- This is _not_ the builtin String type of Agda
+-- which is defined by postulates.
+-- `fromString` can be used to convert back
+-- to builtin Agda strings.
+
+String = List Char
+
+instance
+  iIsStringString : IsString String
+  iIsStringString .IsString.Constraint _ = ⊤
+  iIsStringString .fromString s = primStringToList s
+
+private
+  cons : Char → List String → List String
+  cons c []       = (c ∷ []) ∷ []
+  cons c (s ∷ ss) = (c ∷ s) ∷ ss
+
+lines : String → List String
+lines []         = []
+lines ('\n' ∷ s) = [] ∷ lines s
+lines (c    ∷ s) = cons c (lines s)
+
+private
+ mutual
+  space : String → List String
+  space [] = []
+  space (c ∷ s) = if primIsSpace c then space s else cons c (word s)
+
+  word  : String → List String
+  word []      = []
+  word (c ∷ s) = if primIsSpace c then [] ∷ space s else cons c (word s)
+
+words : String → List String
+words [] = []
+words s@(c ∷ s₁) = if primIsSpace c then space s₁ else word s
+
+unlines : List String → String
+unlines = concatMap (_++ "\n")
+
+unwords : List String → String
+unwords [] = ""
+unwords (w ∷ []) = w
+unwords (w ∷ ws) = w ++ ' ' ∷ unwords ws
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Thunk.html b/test/Haskell.Prim.Thunk.html new file mode 100644 index 00000000..1c70e29b --- /dev/null +++ b/test/Haskell.Prim.Thunk.html @@ -0,0 +1,17 @@ + +Haskell.Prim.Thunk
{-# OPTIONS --sized-types #-}
+
+module Haskell.Prim.Thunk where
+
+open import Agda.Builtin.Size public
+
+open import Haskell.Prim
+
+record Thunk {ℓ} (a : @0 Size → Set ℓ) (@0 i : Size) : Set ℓ where
+  constructor delay
+  coinductive
+  field force : {@0 j : Size< i} → a j
+open Thunk public
+
+{-# COMPILE AGDA2HS Thunk unboxed #-}
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Traversable.html b/test/Haskell.Prim.Traversable.html new file mode 100644 index 00000000..6fe2d59b --- /dev/null +++ b/test/Haskell.Prim.Traversable.html @@ -0,0 +1,80 @@ + +Haskell.Prim.Traversable
+
+module Haskell.Prim.Traversable where
+
+open import Haskell.Prim
+open import Haskell.Prim.Applicative
+open import Haskell.Prim.Functor
+open import Haskell.Prim.Foldable
+open import Haskell.Prim.Monad
+open import Haskell.Prim.List
+open import Haskell.Prim.Maybe
+open import Haskell.Prim.Either
+open import Haskell.Prim.Tuple
+
+--------------------------------------------------
+-- Traversable
+
+-- ** base
+record Traversable (t : Set → Set) : Set₁ where
+  field
+    traverse : ⦃ Applicative f ⦄ → (a → f b) → t a → f (t b)
+    overlap ⦃ functor ⦄ : Functor t
+    overlap ⦃ foldable ⦄ : Foldable t
+
+    sequenceA : ⦃ Applicative f ⦄ → t (f a) → f (t a)
+    mapM : ⦃ Monad m ⦄ → (a → m b) → t a → m (t b)
+    sequence : ⦃ Monad m ⦄ → t (m a) → m (t a)
+-- ** defaults
+record DefaultTraversable (t : Set → Set) : Set₁ where
+  field
+    traverse : ⦃ Applicative f ⦄ → (a → f b) → t a → f (t b)
+    overlap ⦃ functor ⦄ : Functor t
+    overlap ⦃ foldable ⦄ : Foldable t
+
+  sequenceA : ⦃ Applicative f ⦄ → t (f a) → f (t a)
+  sequenceA = traverse id
+
+  mapM : ⦃ Monad m ⦄ → (a → m b) → t a → m (t b)
+  mapM = traverse
+
+  sequence : ⦃ Monad m ⦄ → t (m a) → m (t a)
+  sequence = sequenceA
+-- ** export
+open Traversable ⦃...⦄ public
+{-# COMPILE AGDA2HS Traversable existing-class #-}
+-- ** instances
+private
+  mkTraversable : DefaultTraversable t → Traversable t
+  mkTraversable x = record {DefaultTraversable x}
+
+  infix 0 traverse=_
+  traverse=_ : ⦃ Functor t ⦄ → ⦃ Foldable t ⦄
+            → (∀ {f a b} → ⦃ Applicative f ⦄ → (a → f b) → t a → f (t b))
+            → Traversable t
+  traverse= x = record {DefaultTraversable (record {traverse = x})}
+instance
+  open DefaultTraversable
+
+  iTraversableList : Traversable List
+  iTraversableList = traverse= traverseList
+    where
+      traverseList : ⦃ Applicative f ⦄ → (a → f b) → List a → f (List b)
+      traverseList f []       = pure []
+      traverseList f (x ∷ xs) = ⦇ f x ∷ traverseList f xs ⦈
+
+  iTraversableMaybe : Traversable Maybe
+  iTraversableMaybe = traverse= λ where
+    f Nothing  → pure Nothing
+    f (Just x) → Just <$> f x
+
+  iTraversableEither : Traversable (Either a)
+  iTraversableEither = traverse= λ where
+    f (Left  x) → pure (Left x)
+    f (Right y) → Right <$> f y
+
+  iTraversablePair : Traversable (a ×_)
+  iTraversablePair = traverse= λ
+    f (x , y) → (x ,_) <$> f y
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Tuple.html b/test/Haskell.Prim.Tuple.html new file mode 100644 index 00000000..bc5b3a4b --- /dev/null +++ b/test/Haskell.Prim.Tuple.html @@ -0,0 +1,47 @@ + +Haskell.Prim.Tuple
+module Haskell.Prim.Tuple where
+
+open import Haskell.Prim
+
+--------------------------------------------------
+-- Tuples
+
+infix 3 _×_ _×_×_
+
+infix -1 _,_ _,_,_
+
+record _×_ (a b : Set) : Set where
+  constructor _,_
+  field
+    fst : a
+    snd : b
+open _×_ public
+
+{-# COMPILE AGDA2HS _×_ tuple #-}
+
+record _×_×_ (a b c : Set) : Set where
+  no-eta-equality; pattern
+  constructor _,_,_
+  field
+    fst3 : a
+    snd3 : b
+    thd3 : c
+
+{-# COMPILE AGDA2HS _×_×_ tuple #-}
+
+uncurry : (a → b → c) → a × b → c
+uncurry f (x , y) = f x y
+
+curry : (a × b → c) → a → b → c
+curry f x y = f (x , y)
+
+first : (a → b) → a × c → b × c
+first f (x , y) = f x , y
+
+second : (a → b) → c × a → c × b
+second f (x , y) = x , f y
+
+_***_ : (a → b) → (c → d) → a × c → b × d
+(f *** g) (x , y) = f x , g y
+
\ No newline at end of file diff --git a/test/Haskell.Prim.Word.html b/test/Haskell.Prim.Word.html new file mode 100644 index 00000000..2e31aefd --- /dev/null +++ b/test/Haskell.Prim.Word.html @@ -0,0 +1,56 @@ + +Haskell.Prim.Word
+module Haskell.Prim.Word where
+
+open import Haskell.Prim
+open import Haskell.Prim.Integer
+
+import Agda.Builtin.Word renaming (Word64 to Word)
+open Agda.Builtin.Word public using (Word)
+
+
+--------------------------------------------------
+-- Literals
+
+module WordInternal where
+  2⁶⁴ : Nat
+  2⁶⁴ = 18446744073709551616
+open WordInternal
+
+instance
+  iNumberWord : Number Word
+  iNumberWord .Number.Constraint n = IsTrue (ltNat n 2⁶⁴)
+  iNumberWord .fromNat n = n2w n
+
+
+--------------------------------------------------
+-- Arithmetic
+
+negateWord : Word → Word
+negateWord a = n2w (monusNat 2⁶⁴ (w2n a))
+
+addWord : Word → Word → Word
+addWord a b = n2w (addNat (w2n a) (w2n b))
+
+subWord : Word → Word → Word
+subWord a b = addWord a (negateWord b)
+
+mulWord : Word → Word → Word
+mulWord a b = n2w (mulNat (w2n a) (w2n b))
+
+eqWord : Word → Word → Bool
+eqWord a b = eqNat (w2n a) (w2n b)
+
+ltWord : Word → Word → Bool
+ltWord a b = ltNat (w2n a) (w2n b)
+
+showWord : Word → List Char
+showWord a = primStringToList (primShowNat (w2n a))
+
+integerToWord : Integer → Word
+integerToWord (pos n)    = n2w n
+integerToWord (negsuc n) = negateWord (n2w (suc n))
+
+wordToInteger : Word → Integer
+wordToInteger n = pos (w2n n)
+
\ No newline at end of file diff --git a/test/Haskell.Prim.html b/test/Haskell.Prim.html new file mode 100644 index 00000000..a473fe27 --- /dev/null +++ b/test/Haskell.Prim.html @@ -0,0 +1,132 @@ + +Haskell.Prim
{-# OPTIONS --no-auto-inline #-}
+
+-- Basic things needed by other primitive modules.
+-- Note that this module exports types and functions that should not
+-- be used directly in Haskell definitions, so you probably want to
+-- import Haskell.Prelude instead.
+
+module Haskell.Prim where
+
+open import Agda.Primitive          public
+open import Agda.Builtin.Bool       public renaming (true to True; false to False)
+open import Agda.Builtin.Int        public renaming (Int to Integer)
+open import Agda.Builtin.Nat        public renaming (_==_ to eqNat; _<_ to ltNat; _+_ to addNat; _-_ to monusNat; _*_ to mulNat)
+open import Agda.Builtin.Char       public renaming (primCharToNat to c2n)
+open import Agda.Builtin.Unit       public
+open import Agda.Builtin.Equality   public
+open import Agda.Builtin.FromString public
+open import Agda.Builtin.FromNat    public
+open import Agda.Builtin.FromNeg    public
+open import Agda.Builtin.String     public renaming (String to AgdaString)
+open import Agda.Builtin.Word       public renaming (primWord64ToNat to w2n; primWord64FromNat to n2w)
+open import Agda.Builtin.Strict     public
+open import Agda.Builtin.List       public
+
+variable
+  @0 ℓ : Level
+  a b c d e : Set
+  f m s t : Set → Set
+
+
+--------------------------------------------------
+-- Functions
+
+id : a → a
+id x = x
+
+infixr 9 _∘_
+_∘_ : (b → c) → (a → b) → a → c
+(f ∘ g) x = f (g x)
+
+flip : (a → b → c) → b → a → c
+flip f x y = f y x
+
+const : a → b → a
+const x _ = x
+
+infixr 0 _$_
+_$_ : (a → b) → a → b
+f $ x = f x
+
+
+--------------------------------------------------
+-- Language constructs
+
+infix -1 case_of_
+case_of_ : (a' : a) → ((a'' : a) → @0 {{ a' ≡ a'' }} → b) → b
+case x of f = f x
+
+infix -2 if_then_else_
+if_then_else_ : {@0 a : Set ℓ} → (flg : Bool) → (@0 {{ flg ≡ True }} → a) → (@0 {{ flg ≡ False }} → a) → a
+if False then x else y = y
+if True  then x else y = x
+
+-- for explicit type signatures (e. g. `4 :: Integer` is `the Int 4`)
+the : (@0 a : Set ℓ) -> a -> a
+the _ x = x
+
+--------------------------------------------------
+-- Agda strings
+
+instance
+  iIsStringAgdaString : IsString AgdaString
+  iIsStringAgdaString .IsString.Constraint _ = ⊤
+  iIsStringAgdaString .fromString s = s
+
+
+--------------------------------------------------
+-- Numbers
+
+instance
+  iNumberNat : Number Nat
+  iNumberNat .Number.Constraint _ = ⊤
+  iNumberNat .fromNat n = n
+
+
+--------------------------------------------------
+-- Lists
+
+lengthNat : List a → Nat
+lengthNat []       = 0
+lengthNat (_ ∷ xs) = addNat 1 (lengthNat xs)
+
+
+--------------------------------------------------
+-- Proof things
+
+data ⊥ : Set where
+
+magic : {A : Set} → ⊥ → A
+magic ()
+
+--principle of explosion
+exFalso : {x : Bool} → (x ≡ True) → (x ≡ False) → ⊥
+exFalso {False} () b 
+exFalso {True} a ()
+
+-- Use to bundle up constraints
+data All {a b} {A : Set a} (B : A → Set b) : List A → Set (a ⊔ b) where
+  instance
+    allNil  : All B []
+    allCons : ∀ {x xs} ⦃ i : B x ⦄ ⦃ is : All B xs ⦄ → All B (x ∷ xs)
+
+data Any {a b} {A : Set a} (B : A → Set b) : List A → Set (a ⊔ b) where
+  instance
+    anyHere  : ∀ {x xs} ⦃ i : B x ⦄ → Any B (x ∷ xs)
+    anyThere : ∀ {x xs} ⦃ is : Any B xs ⦄ → Any B (x ∷ xs)
+
+data IsTrue : Bool → Set where
+  instance itsTrue : IsTrue True
+
+data IsFalse : Bool → Set where
+  instance itsFalse : IsFalse False
+
+data NonEmpty {a : Set} : List a → Set where
+  instance itsNonEmpty : ∀ {x xs} → NonEmpty (x ∷ xs)
+
+data TypeError (err : AgdaString) : Set where
+
+it : ∀ {@0 ℓ} {@0 a : Set ℓ} → ⦃ a ⦄ → a
+it ⦃ x ⦄ = x
+
\ No newline at end of file diff --git a/test/HeightMirror.html b/test/HeightMirror.html new file mode 100644 index 00000000..27faf41c --- /dev/null +++ b/test/HeightMirror.html @@ -0,0 +1,34 @@ + +HeightMirror
+open import Haskell.Prelude hiding (max)
+open import Haskell.Law.Equality hiding (subst)
+
+subst : {p : @0 a → Set} {@0 m n : a} → @0 m ≡ n → p m → p n
+subst refl t = t
+
+{-# COMPILE AGDA2HS subst transparent #-}
+
+max : Nat → Nat → Nat
+max zero    n       = n
+max (suc m) zero    = suc m
+max (suc m) (suc n) = suc (max m n)
+
+data Tree (a : Set) : (@0 height : Nat) → Set where
+  Tip : Tree a 0
+  Bin : ∀ {@0 l r} (x : a) → Tree a l → Tree a r → Tree a (suc (max l r))
+
+{-# COMPILE AGDA2HS Tree #-}
+
+@0 max-comm : (@0 l r : Nat) → max l r ≡ max r l
+max-comm zero zero = refl
+max-comm zero (suc r) = refl
+max-comm (suc l) zero = refl
+max-comm (suc l) (suc r) = cong suc (max-comm l r)
+
+mirror : ∀ {@0 h} → Tree a h → Tree a h
+mirror Tip = Tip
+mirror {a = a} (Bin {l} {r} x lt rt) =
+  subst {p = Tree a} (cong suc (max-comm r l)) (Bin x (mirror rt) (mirror lt))
+
+{-# COMPILE AGDA2HS mirror #-}
+
\ No newline at end of file diff --git a/test/IOFile.html b/test/IOFile.html new file mode 100644 index 00000000..81ed4ec8 --- /dev/null +++ b/test/IOFile.html @@ -0,0 +1,15 @@ + +IOFile
module IOFile where
+
+open import Haskell.Prelude
+
+main : IO ⊤
+main = do file ← readFile "IOFile.agda"
+          writeFile "IOFile2.agda" file
+          appendFile "IOFile2.agda" "-- Written by appendFile"
+          file2 ← readFile "IOFile2.agda"
+          print file2
+          return tt
+          
+{-# COMPILE AGDA2HS main #-}
+
\ No newline at end of file diff --git a/test/IOInput.html b/test/IOInput.html new file mode 100644 index 00000000..c1ba43bf --- /dev/null +++ b/test/IOInput.html @@ -0,0 +1,13 @@ + +IOInput
module IOInput where
+
+open import Haskell.Prelude
+
+main : IO ⊤
+main = do putStrLn "Write something "
+          x ← getLine
+          putStr $ "You wrote: " ++ x
+          return tt
+
+{-# COMPILE AGDA2HS main #-}
+
\ No newline at end of file diff --git a/test/Importee.html b/test/Importee.html new file mode 100644 index 00000000..03c1c8bc --- /dev/null +++ b/test/Importee.html @@ -0,0 +1,36 @@ + +Importee
open import Haskell.Prelude
+
+foo : Int
+foo = 42
+{-# COMPILE AGDA2HS foo #-}
+
+_!#_ : Int → Int → Int
+x !# y = x + y
+{-# COMPILE AGDA2HS _!#_ #-}
+
+data Foo : Set where
+  MkFoo : Foo
+{-# COMPILE AGDA2HS Foo #-}
+
+-- ** base
+record Fooable (a : Set) : Set where
+  field doTheFoo defaultFoo : a
+-- ** defaults
+record DefaultFooable (a : Set) : Set where
+  field doTheFoo : a
+
+  defaultFoo : a
+  defaultFoo = doTheFoo
+-- ** export
+open Fooable ⦃...⦄ public
+{-# COMPILE AGDA2HS Fooable class DefaultFooable #-}
+-- ** instances
+instance
+  FF : Fooable Foo
+  FF = record {DefaultFooable (λ where .doTheFoo → MkFoo)}
+    where open DefaultFooable
+{-# COMPILE AGDA2HS FF #-}
+
+open import SecondImportee public
+
\ No newline at end of file diff --git a/test/Importer.html b/test/Importer.html new file mode 100644 index 00000000..63628e96 --- /dev/null +++ b/test/Importer.html @@ -0,0 +1,54 @@ + +Importer
open import Haskell.Prelude
+
+{-# FOREIGN AGDA2HS
+-- ** simple imports (possibly with transitive dependencies)
+#-}
+
+open import Importee
+open import OtherImportee using (MkFoo)
+
+bar : Int
+bar = foo
+{-# COMPILE AGDA2HS bar #-}
+
+anotherBar : Int
+anotherBar = anotherFoo
+{-# COMPILE AGDA2HS anotherBar #-}
+
+baz : Int
+baz = 21 !# 21
+{-# COMPILE AGDA2HS baz #-}
+
+mkFoo : Foo
+mkFoo = MkFoo -- This is MkFoo from Importee, NOT from OtherImportee!!
+{-# COMPILE AGDA2HS mkFoo #-}
+
+fooable : Foo
+fooable = doTheFoo
+{-# COMPILE AGDA2HS fooable #-}
+
+{-# FOREIGN AGDA2HS
+-- ** interplay with class default methods
+#-}
+
+defaultBar : Foo
+defaultBar = defaultFoo
+{-# COMPILE AGDA2HS defaultBar #-}
+
+{-# FOREIGN AGDA2HS
+-- ** interplay with methods of existing class
+#-}
+
+testFoldMap : List Nat → List Nat
+testFoldMap = foldMap _∷_ []
+{-# COMPILE AGDA2HS testFoldMap #-}
+
+{-# FOREIGN AGDA2HS
+-- ** interplay with default methods of existing class
+#-}
+
+testFoldr : List Nat → Nat
+testFoldr = foldr (λ _ x → x) 0
+{-# COMPILE AGDA2HS testFoldr #-}
+
\ No newline at end of file diff --git a/test/Inlining.html b/test/Inlining.html new file mode 100644 index 00000000..d3849469 --- /dev/null +++ b/test/Inlining.html @@ -0,0 +1,45 @@ + +Inlining
module Inlining where
+
+open import Haskell.Prelude
+
+Alias : Set
+Alias = Bool
+{-# COMPILE AGDA2HS Alias inline #-}
+
+aliased : Alias
+aliased = True
+{-# COMPILE AGDA2HS aliased #-}
+
+record Wrap (a : Set) : Set where
+  constructor Wrapped
+  field
+    unwrap : a
+open Wrap public
+{-# COMPILE AGDA2HS Wrap unboxed #-}
+
+mapWrap : (f : a → b) → Wrap a → Wrap b
+mapWrap f (Wrapped x) = Wrapped (f x)
+{-# COMPILE AGDA2HS mapWrap inline #-}
+
+mapWrap2 : (f : a → b → c) → Wrap a → Wrap b → Wrap c
+mapWrap2 f (Wrapped x) (Wrapped y) = Wrapped (f x y)
+{-# COMPILE AGDA2HS mapWrap2 inline #-}
+
+test1 : Wrap Int → Wrap Int
+test1 x = mapWrap (1 +_) x
+{-# COMPILE AGDA2HS test1 #-}
+
+test2 : Wrap Int → Wrap Int → Wrap Int
+test2 x y = mapWrap2 _+_ x y
+{-# COMPILE AGDA2HS test2 #-}
+
+-- partial application of inline function
+test3 : Wrap Int → Wrap Int → Wrap Int
+test3 x = mapWrap2 _+_ x
+{-# COMPILE AGDA2HS test3 #-}
+
+test4 : Wrap Int → Wrap Int → Wrap Int
+test4 = mapWrap2 _+_
+{-# COMPILE AGDA2HS test4 #-}
+
\ No newline at end of file diff --git a/test/Issue107.html b/test/Issue107.html new file mode 100644 index 00000000..282b5a61 --- /dev/null +++ b/test/Issue107.html @@ -0,0 +1,10 @@ + +Issue107
+open import Haskell.Prelude
+
+testMax : (x y : Nat) → max (suc x) (suc y) ≡ suc (max x y)
+testMax x y = refl
+
+testMin : (x y : Nat) → min (suc x) (suc y) ≡ suc (min x y)
+testMin x y = refl
+
\ No newline at end of file diff --git a/test/Issue115.html b/test/Issue115.html new file mode 100644 index 00000000..60f95c65 --- /dev/null +++ b/test/Issue115.html @@ -0,0 +1,24 @@ + +Issue115
record Pointed (a : Set) : Set where
+  field
+    it : a
+open Pointed {{...}} public
+{-# COMPILE AGDA2HS Pointed class #-}
+
+data A : Set where A1 : A
+{-# COMPILE AGDA2HS A #-}
+
+instance
+  iPointedA : Pointed A
+  iPointedA .it = A1
+{-# COMPILE AGDA2HS iPointedA #-}
+
+data Delay (a : Set) : Set where
+  Later : Delay a → Delay a
+  Now : a → Delay a
+{-# COMPILE AGDA2HS Delay #-}
+
+test : Delay A
+test = Later λ where → Now it
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Issue14.html b/test/Issue14.html new file mode 100644 index 00000000..b475381b --- /dev/null +++ b/test/Issue14.html @@ -0,0 +1,21 @@ + +Issue14
+module Issue14 where
+
+open import Haskell.Prelude
+
+-- Wrong name for shadowed lambda
+constid : a → b → b
+constid x = λ x → x
+
+{-# COMPILE AGDA2HS constid #-}
+
+sectionTest₁ : Nat → Nat → Nat
+sectionTest₁ n = _+ n
+
+sectionTest₂ : Nat → Nat → Nat
+sectionTest₂ section = _+ section
+
+{-# COMPILE AGDA2HS sectionTest₁ #-}
+{-# COMPILE AGDA2HS sectionTest₂ #-}
+
\ No newline at end of file diff --git a/test/Issue145.html b/test/Issue145.html new file mode 100644 index 00000000..8b4190a3 --- /dev/null +++ b/test/Issue145.html @@ -0,0 +1,31 @@ + +Issue145
module Issue145 where
+
+open import Haskell.Prelude
+open import Haskell.Prim.Strict
+
+-- ** PASS
+
+module _ {a : Set} where
+  it : a → a
+  it x = x
+  {-# COMPILE AGDA2HS it #-}
+
+it' : ⦃ Monoid a ⦄ → a → a
+it' x = x
+{-# COMPILE AGDA2HS it' #-}
+
+data Ok' {ℓ} (a : Set ℓ) : Set ℓ where
+  Thing' : Strict a → Ok' a
+{-# COMPILE AGDA2HS Ok' #-}
+
+-- ** FAIL
+
+data Ok {a : Set} : Set where
+  Thing : a → Ok
+{-# COMPILE AGDA2HS Ok #-}
+
+test : Ok
+test = Thing "ok"
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Issue169.html b/test/Issue169.html new file mode 100644 index 00000000..68f52925 --- /dev/null +++ b/test/Issue169.html @@ -0,0 +1,21 @@ + +Issue169
open import Haskell.Prelude
+
+record Identity (a : Set) : Set where
+    field
+        runIdentity : a
+open Identity public
+
+{-# COMPILE AGDA2HS Identity newtype #-}
+
+showIdentity : ⦃ Show a ⦄ → Identity a → String
+showIdentity record { runIdentity = id } = "Id < " ++ show id ++ " >"
+
+{-# COMPILE AGDA2HS showIdentity #-}
+
+instance
+  iIdentityShow : ⦃ Show a ⦄ → Show (Identity a)
+  iIdentityShow = record {Show₂ (λ where .Show₂.show → showIdentity)}
+
+{-# COMPILE AGDA2HS iIdentityShow #-}
+
\ No newline at end of file diff --git a/test/Issue200.html b/test/Issue200.html new file mode 100644 index 00000000..cf048788 --- /dev/null +++ b/test/Issue200.html @@ -0,0 +1,13 @@ + +Issue200
open import Haskell.Prelude
+
+data Void : Set where
+
+test : Maybe Void → Maybe Void
+test = λ
+    { Nothing → Nothing
+    }
+
+{-# COMPILE AGDA2HS Void #-}
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Issue210.html b/test/Issue210.html new file mode 100644 index 00000000..e7db2445 --- /dev/null +++ b/test/Issue210.html @@ -0,0 +1,37 @@ + +Issue210
open import Haskell.Prelude hiding (f)
+
+record Test (a : Set) : Set₁ where
+  field
+    f : a -> a
+open Test {{...}} public
+{-# COMPILE AGDA2HS Test class #-}
+
+instance
+  testNat : Test Nat
+  Test.f testNat n = h
+    where
+    g : Nat
+    g = 3 + n
+    h : Nat
+    h = n + g
+  {-# COMPILE AGDA2HS testNat #-}
+
+f1 : Nat -> Nat
+f1 n = h1
+  where
+  g1 : Nat
+  g1 = 3 + n
+  h1 : Nat
+  h1 = n + g1
+{-# COMPILE AGDA2HS f1 #-}
+
+f2 : Nat -> Nat
+f2 n = h2 n
+  where
+  g2 : Nat
+  g2 = 3 + n
+  h2 : Nat -> Nat
+  h2 m = n + g2 + m
+{-# COMPILE AGDA2HS f2 #-}
+
\ No newline at end of file diff --git a/test/Issue218.html b/test/Issue218.html new file mode 100644 index 00000000..7eca8823 --- /dev/null +++ b/test/Issue218.html @@ -0,0 +1,20 @@ + +Issue218
+module Issue218 where
+
+open import Haskell.Prelude
+open import Haskell.Extra.Erase
+open import Haskell.Extra.Refinement
+
+module _ (@0 n : Int) where
+
+  foo : {{Rezz n}} → ∃ Int (_≡ n)
+  foo {{rezz n}} = n ⟨ refl ⟩
+
+  {-# COMPILE AGDA2HS foo #-}
+
+bar : ∃ Int (_≡ 42)
+bar = foo _
+
+{-# COMPILE AGDA2HS bar #-}
+
\ No newline at end of file diff --git a/test/Issue251.html b/test/Issue251.html new file mode 100644 index 00000000..26f641b0 --- /dev/null +++ b/test/Issue251.html @@ -0,0 +1,16 @@ + +Issue251
open import Haskell.Prelude
+
+instance
+  favoriteNumber : Int
+  favoriteNumber = 42
+{-# COMPILE AGDA2HS favoriteNumber inline #-}
+
+get : {{Int}} → Int
+get {{x}} = x
+{-# COMPILE AGDA2HS get #-}
+
+test : Int
+test = get
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Issue257.html b/test/Issue257.html new file mode 100644 index 00000000..159c7ae6 --- /dev/null +++ b/test/Issue257.html @@ -0,0 +1,9 @@ + +Issue257
module Issue257 where
+
+open import Haskell.Prelude
+
+record Wrap : Set where
+  field int : Integer
+{-# COMPILE AGDA2HS Wrap unboxed #-}
+
\ No newline at end of file diff --git a/test/Issue264.html b/test/Issue264.html new file mode 100644 index 00000000..eff9bf45 --- /dev/null +++ b/test/Issue264.html @@ -0,0 +1,17 @@ + +Issue264
+module Issue264 (@0 name : Set) where
+
+data Term : @0 Set → Set where
+  Dummy : Term name
+
+{-# COMPILE AGDA2HS Term #-}
+
+reduce : Term name → Term name
+reduce v = go v
+  where
+    go : Term name → Term name
+    go v = v
+
+{-# COMPILE AGDA2HS reduce #-}
+
\ No newline at end of file diff --git a/test/Issue273.html b/test/Issue273.html new file mode 100644 index 00000000..7cd8cf6c --- /dev/null +++ b/test/Issue273.html @@ -0,0 +1,37 @@ + +Issue273
module Issue273 where
+
+open import Haskell.Prelude
+
+test : Int × Int → Int
+test = λ x → snd $ x
+{-# COMPILE AGDA2HS test #-}
+
+mySnd : Int × Int → Int
+mySnd x = snd x
+{-# COMPILE AGDA2HS mySnd #-}
+
+test2 : Int × Int → Int
+test2 = λ x → mySnd $ x
+{-# COMPILE AGDA2HS test2 #-}
+
+test3 : Int × Int → Int
+test3 = λ x → snd x
+{-# COMPILE AGDA2HS test3 #-}
+
+test4 : Int × Int → Int
+test4 = λ x → mySnd x
+{-# COMPILE AGDA2HS test4 #-}
+
+test5 : Int × Int → Int → Int
+test5 = λ x _ → snd $ x
+{-# COMPILE AGDA2HS test5 #-}
+
+test6 : Int → Int
+test6 = _- (1 + 1)
+{-# COMPILE AGDA2HS test6 #-}
+
+test7 : Int → Int
+test7 = _+ (1 - 1)
+{-# COMPILE AGDA2HS test7 #-}
+
\ No newline at end of file diff --git a/test/Issue286.html b/test/Issue286.html new file mode 100644 index 00000000..f0b67359 --- /dev/null +++ b/test/Issue286.html @@ -0,0 +1,16 @@ + +Issue286
open import Haskell.Prelude
+
+instance
+  favoriteNumber : Int
+  favoriteNumber = 42
+{-# COMPILE AGDA2HS favoriteNumber inline #-}
+
+get : {{Int}} → Int
+get {{x}} = x
+{-# COMPILE AGDA2HS get inline #-}
+
+test : Int
+test = get
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Issue301.html b/test/Issue301.html new file mode 100644 index 00000000..1eb6058b --- /dev/null +++ b/test/Issue301.html @@ -0,0 +1,39 @@ + +Issue301
+open import Haskell.Prelude
+open import Haskell.Prim.Monoid
+open import Haskell.Prim.Foldable
+
+data MyData (a : Set) : Set where
+  Nuttin' : MyData a
+{-# COMPILE AGDA2HS MyData #-}
+
+-- notice this does not occur with other classes such as Foldable
+myDataDefaultFoldable : DefaultFoldable MyData
+DefaultFoldable.foldMap myDataDefaultFoldable _ _ = mempty
+
+instance
+  MyDataFoldable : Foldable MyData
+  MyDataFoldable = record {DefaultFoldable myDataDefaultFoldable}
+{-# COMPILE AGDA2HS MyDataFoldable #-}
+
+-- need to create instance for semigroup first
+-- (requires explicitly typed function AFAICT)
+_><_ : {a : Set} -> MyData a -> MyData a -> MyData a
+_ >< _ = Nuttin'
+{-# COMPILE AGDA2HS _><_ #-}
+
+instance
+  MyDataSemigroup : Semigroup (MyData a)
+  MyDataSemigroup ._<>_ = _><_
+{-# COMPILE AGDA2HS MyDataSemigroup #-}
+
+instance
+  myDataDefaultMonoid : DefaultMonoid (MyData a)
+  DefaultMonoid.mempty myDataDefaultMonoid = Nuttin'
+
+instance
+  MyDataMonoid : Monoid (MyData a)
+  MyDataMonoid = record {DefaultMonoid myDataDefaultMonoid}
+{-# COMPILE AGDA2HS MyDataMonoid #-}
+
\ No newline at end of file diff --git a/test/Issue302.html b/test/Issue302.html new file mode 100644 index 00000000..5cf91ffc --- /dev/null +++ b/test/Issue302.html @@ -0,0 +1,7 @@ + +Issue302
open import Haskell.Prelude
+
+not0 : Int → Bool
+not0 n = n /= 0
+{-# COMPILE AGDA2HS not0 #-}
+
\ No newline at end of file diff --git a/test/Issue305.html b/test/Issue305.html new file mode 100644 index 00000000..7d3bbc1d --- /dev/null +++ b/test/Issue305.html @@ -0,0 +1,59 @@ + +Issue305
open import Haskell.Prelude
+
+module Issue305 (@0 X : Set) where
+
+record Class (a : Set) : Set where
+  field
+    foo : a → a
+open Class {{...}} public
+
+{-# COMPILE AGDA2HS Class class #-}
+
+instance
+  ClassInt : Class Int
+  ClassInt .foo = _+ 1
+
+{-# COMPILE AGDA2HS ClassInt #-}
+
+instance
+  ClassBool : Class Bool
+  ClassBool .foo = not
+
+{-# COMPILE AGDA2HS ClassBool #-}
+
+test : Int
+test = foo 41
+
+{-# COMPILE AGDA2HS test #-}
+
+anotherTest : Int
+anotherTest = test
+
+{-# COMPILE AGDA2HS anotherTest #-}
+
+yetAnotherTest : Int
+yetAnotherTest = case Just True of λ where
+  Nothing → error "unreachable"
+  (Just y) → foo 5
+{-# COMPILE AGDA2HS yetAnotherTest #-}
+
+andOneMoreTest : Int → Int
+andOneMoreTest x = foo 5
+{-# COMPILE AGDA2HS andOneMoreTest #-}
+
+record Subclass (a : Set) : Set where
+  field
+    overlap {{super}} : Class a
+    bar : a
+open Subclass {{...}} public
+
+{-# COMPILE AGDA2HS Subclass class #-}
+
+instance 
+  SubclassBool : Subclass Bool
+  SubclassBool .super = ClassBool
+  SubclassBool .bar = False
+
+{-# COMPILE AGDA2HS SubclassBool #-}
+
\ No newline at end of file diff --git a/test/Issue309.html b/test/Issue309.html new file mode 100644 index 00000000..53cd30bb --- /dev/null +++ b/test/Issue309.html @@ -0,0 +1,9 @@ + +Issue309
module Issue309 where
+
+private variable @0 a : Set
+
+Ap : (p : @0 a → Set) → @0 a → Set
+Ap p x = p x
+{-# COMPILE AGDA2HS Ap #-}
+
\ No newline at end of file diff --git a/test/Issue317.html b/test/Issue317.html new file mode 100644 index 00000000..525b05c6 --- /dev/null +++ b/test/Issue317.html @@ -0,0 +1,13 @@ + +Issue317
open import Haskell.Prelude
+
+record D : Set where
+  constructor C
+  field unC : Int
+open D public
+{-# COMPILE AGDA2HS D #-}
+
+test : D → D
+test d = C ∘ unC $ d
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Issue65.html b/test/Issue65.html new file mode 100644 index 00000000..133cfce4 --- /dev/null +++ b/test/Issue65.html @@ -0,0 +1,16 @@ + +Issue65
+module Issue65 where
+
+open import Haskell.Prelude
+
+yeet : (c : Bool) → (@0 {{c ≡ True}} → a) → (@0 {{c ≡ False}} → a) → a
+yeet False x y = y {{refl}}
+yeet True  x y = x {{refl}}
+{-# COMPILE AGDA2HS yeet #-}
+
+-- The branches start with instance lambdas that should be dropped.
+xx : Int
+xx = yeet True 1 2
+{-# COMPILE AGDA2HS xx #-}
+
\ No newline at end of file diff --git a/test/Issue69.html b/test/Issue69.html new file mode 100644 index 00000000..c2fef116 --- /dev/null +++ b/test/Issue69.html @@ -0,0 +1,18 @@ + +Issue69
open import Haskell.Prelude
+
+mutual
+
+  data Map (k : Set) (a : Set) : Set where
+    Bin : (sz : Nat) → (kx : k) → (x : a)
+          → (l : Map k a) → (r : Map k a)
+          → {{@0 szVal : sz ≡ (size l) + (size r) + 1}}
+          → Map k a
+    Tip : Map k a
+  {-# COMPILE AGDA2HS Map #-}
+
+  size : {k a : Set} → Map k a → Nat
+  size Tip = 0
+  size (Bin sz _ _ _ _) = sz
+  {-# COMPILE AGDA2HS size #-}
+
\ No newline at end of file diff --git a/test/Issue73.html b/test/Issue73.html new file mode 100644 index 00000000..ee172d4d --- /dev/null +++ b/test/Issue73.html @@ -0,0 +1,10 @@ + +Issue73
module Issue73 where
+
+record ImplicitField (a : Set) : Set where
+    field
+        aField : a
+        @0 {anImplicitField} : a
+open ImplicitField public
+{-# COMPILE AGDA2HS ImplicitField class #-}
+
\ No newline at end of file diff --git a/test/Issue90.html b/test/Issue90.html new file mode 100644 index 00000000..e85e5139 --- /dev/null +++ b/test/Issue90.html @@ -0,0 +1,80 @@ + +Issue90
module Issue90 where
+
+open import Haskell.Prelude
+
+good : Nat
+good = bar
+  where
+    foo : Nat
+    foo = 42
+
+    bar : Nat
+    bar = foo
+{-# COMPILE AGDA2HS good #-}
+
+bad : Nat
+bad = bar
+  where
+    bar : Nat
+    foo : Nat
+    bar = foo
+    foo = 42
+{-# COMPILE AGDA2HS bad #-}
+
+good2 : Nat
+good2 = bar
+  where
+    foo : Nat
+    foo = 42 + x
+      where
+        x : Nat
+        x = 1
+    bar : Nat
+    bar = foo + x
+      where
+        x : Nat
+        x = 2
+{-# COMPILE AGDA2HS good2 #-}
+
+bad2 : Nat
+bad2 = bar
+  where
+    bar : Nat
+    foo : Nat
+    foo = 42 + x
+      where
+        x : Nat
+        x = 1
+    bar = foo + x
+      where
+        x : Nat
+        x = 2
+{-# COMPILE AGDA2HS bad2 #-}
+
+test : Bool → Nat
+test True = bar
+  where
+    foo : Nat
+    foo = 42 + ted
+      where
+        nes : Nat
+        nes = 1
+        ted : Nat
+        ted = nes + 1
+
+    bar : Nat
+    bar = foo
+test False = bar
+  where
+    bar : Nat
+    foo : Nat
+    foo = 42 + ted
+      where
+        ted : Nat
+        nes : Nat
+        nes = 1
+        ted = nes + 1
+    bar = foo
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/Issue92.html b/test/Issue92.html new file mode 100644 index 00000000..b1bb1939 --- /dev/null +++ b/test/Issue92.html @@ -0,0 +1,17 @@ + +Issue92
open import Haskell.Prelude
+
+postulate Something : Set
+postulate something : Something
+
+module _ {a : Set} where
+  foo : a → a
+  foo x = bar {something}
+    where
+      bar : @0 {Something} → a
+      bar {eq} = baz
+        where
+          baz : a
+          baz = x
+{-# COMPILE AGDA2HS foo #-}
+
\ No newline at end of file diff --git a/test/Issue93.html b/test/Issue93.html new file mode 100644 index 00000000..76f2ec58 --- /dev/null +++ b/test/Issue93.html @@ -0,0 +1,30 @@ + +Issue93
module Issue93 where
+
+open import Haskell.Prelude
+
+fun : Bool → Bool
+fun x = case x of λ where
+          True  → False
+          False → y
+  where
+    y : Bool
+    y = True
+{-# COMPILE AGDA2HS fun #-}
+
+nested : Maybe Bool → Bool
+nested x = case x of λ where
+           (Just b) → (case y of λ where
+                     True →  b
+                     False → z)
+           Nothing  → y
+  where
+    y : Bool
+    y = True
+
+    z : Bool
+    z = case y of λ where
+          True → y
+          False → True
+{-# COMPILE AGDA2HS nested #-}
+
\ No newline at end of file diff --git a/test/Issue94.html b/test/Issue94.html new file mode 100644 index 00000000..437d5664 --- /dev/null +++ b/test/Issue94.html @@ -0,0 +1,12 @@ + +Issue94
module Issue94 where
+
+open import Haskell.Prelude
+
+thing : List a → List a
+thing xs = aux xs
+  where
+    aux : List a → List a
+    aux xs = xs
+{-# COMPILE AGDA2HS thing #-}
+
\ No newline at end of file diff --git a/test/Kinds.html b/test/Kinds.html new file mode 100644 index 00000000..da975c44 --- /dev/null +++ b/test/Kinds.html @@ -0,0 +1,18 @@ + +Kinds
module Kinds where
+
+open import Haskell.Prelude
+
+record ReaderT (r : Set) (m : Set → Set) (a  : Set) : Set where
+  constructor RdrT
+  field runReaderT : r → m a
+open ReaderT public
+
+{-# COMPILE AGDA2HS ReaderT #-}
+
+data Kleisli (m : Set → Set) (a b : Set) : Set where
+  K : (a → m b) → Kleisli m a b
+
+{-# COMPILE AGDA2HS Kleisli #-}
+
+
\ No newline at end of file diff --git a/test/LanguageConstructs.html b/test/LanguageConstructs.html new file mode 100644 index 00000000..dbc55cf4 --- /dev/null +++ b/test/LanguageConstructs.html @@ -0,0 +1,70 @@ + +LanguageConstructs
+module LanguageConstructs where
+
+open import Haskell.Prelude
+
+--------------------------------------------------
+-- Lists
+
+oneTwoThree : List Int
+oneTwoThree = 1 ∷ 2 ∷ 3 ∷ []
+{-# COMPILE AGDA2HS oneTwoThree #-}
+
+exactlyTwo : List a → Maybe (a × a)
+exactlyTwo (x ∷ y ∷ []) = Just (x , y)
+exactlyTwo _            = Nothing
+{-# COMPILE AGDA2HS exactlyTwo #-}
+
+
+--------------------------------------------------
+-- If-then-else
+
+ifThenElse : Int → String
+ifThenElse n = if n >= 10 then "big" else "small"
+{-# COMPILE AGDA2HS ifThenElse #-}
+
+
+--------------------------------------------------
+-- Case
+
+maybeToList : Maybe a → List a
+maybeToList = λ where Nothing  → []
+                      (Just x) → x ∷ []
+{-# COMPILE AGDA2HS maybeToList #-}
+
+mhead : List a → Maybe a
+mhead xs = case xs of λ where
+  []      → Nothing
+  (x ∷ _) → Just x
+{-# COMPILE AGDA2HS mhead #-}
+
+-- Applied to lambda
+plus5minus5 : Int → Int
+plus5minus5 n = case n + 5 of λ m → m - 5
+{-# COMPILE AGDA2HS plus5minus5 #-}
+
+--------------------------------------------------
+-- Enums
+
+
+enum₁ : List Int
+enum₁ = enumFromTo 5 10
+{-# COMPILE AGDA2HS enum₁ #-}
+
+enum₂ : List Integer
+enum₂ = enumFromThenTo 10 20 100
+{-# COMPILE AGDA2HS enum₂ #-}
+
+enum₃ : List Bool
+enum₃ = enumFrom False
+{-# COMPILE AGDA2HS enum₃ #-}
+
+enum₄ : List Ordering
+enum₄ = enumFromThen LT EQ
+{-# COMPILE AGDA2HS enum₄ #-}
+
+underappliedEnum : List Int → List (List Int)
+underappliedEnum = map (enumFromTo 1)
+{-# COMPILE AGDA2HS underappliedEnum #-}
+
\ No newline at end of file diff --git a/test/LawfulOrd.html b/test/LawfulOrd.html new file mode 100644 index 00000000..c057142f --- /dev/null +++ b/test/LawfulOrd.html @@ -0,0 +1,42 @@ + +LawfulOrd
open import Haskell.Prelude
+open import Haskell.Law
+
+data Ordered (a : Set) : Set where
+    Gt : ⦃ @0 iOrd : Ord a ⦄ → (a' : a) → (a'' : a) → ⦃ @0 pf : (a' > a'') ≡ True ⦄ → Ordered a
+    Lt : ⦃ @0 iOrd : Ord a ⦄ → (a' : a) → (a'' : a) → ⦃ @0 pf : (a' < a'') ≡ True ⦄ → Ordered a
+    E :  ⦃ @0 iOrd : Ord a ⦄ → (a' : a) → (a'' : a) → ⦃ @0 pf : a' ≡ a'' ⦄         → Ordered a
+
+{-# COMPILE AGDA2HS Ordered #-}
+
+nLtEq2Gt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄
+  → ∀ (x y : a) → ⦃ (x < y) ≡ False ⦄ → ⦃ (x == y) ≡ False ⦄ → (x > y) ≡ True
+nLtEq2Gt x y ⦃ h1 ⦄ ⦃ h2 ⦄ =
+  begin
+    (x > y)
+  ≡⟨ sym (not-involution (x <= y) (x > y) (lte2ngt x y)) ⟩
+    not (x <= y)
+  ≡⟨ cong not (lte2LtEq x y) ⟩
+    not ((x < y) || (x == y))
+  ≡⟨ cong (λ b → not (b || (x == y))) h1 ⟩
+    not (False || (x == y))
+  ≡⟨ cong (λ b → not (False || b)) h2 ⟩
+    not (False || False)
+  ≡⟨⟩
+    True
+  ∎
+
+order : ⦃ iOrd : Ord a ⦄ → @0 ⦃ IsLawfulOrd a ⦄
+  → (a' : a) → (a'' : a) → Ordered a
+order left right =
+  if left < right then
+    Lt left right
+  else (
+    if left == right then
+      (λ ⦃ h ⦄ → E left right ⦃ equality left right h ⦄)
+    else
+      Gt left right ⦃ nLtEq2Gt left right ⦄
+  )
+
+{-# COMPILE AGDA2HS order #-}
+
\ No newline at end of file diff --git a/test/LiteralPatterns.html b/test/LiteralPatterns.html new file mode 100644 index 00000000..efeee34b --- /dev/null +++ b/test/LiteralPatterns.html @@ -0,0 +1,18 @@ + +LiteralPatterns
+open import Haskell.Prelude
+open import Agda.Builtin.Int using (pos; negsuc)
+
+testInt : Integer → Bool
+testInt (pos 10) = True
+testInt (negsuc 7) = True
+testInt _ = False
+
+{-# COMPILE AGDA2HS testInt #-}
+
+testChar : Char → Bool
+testChar 'c' = True
+testChar _ = False
+
+{-# COMPILE AGDA2HS testChar #-}
+
\ No newline at end of file diff --git a/test/ModuleParameters.html b/test/ModuleParameters.html new file mode 100644 index 00000000..75a8a4e2 --- /dev/null +++ b/test/ModuleParameters.html @@ -0,0 +1,36 @@ + +ModuleParameters
{-# OPTIONS --no-projection-like #-}
+open import Haskell.Prelude hiding (a)
+
+module ModuleParameters
+  (@0 name : Set)
+  (p : @0 name → Set) where
+
+data Scope : Set where
+  Empty : Scope
+  Bind  : (@0 x : name) → p x → Scope → Scope
+{-# COMPILE AGDA2HS Scope #-}
+
+unbind : Scope → Scope
+unbind Empty = Empty
+unbind (Bind _ _ s) = s
+{-# COMPILE AGDA2HS unbind #-}
+
+module _ {a : Set} where
+  thing : a → a
+  thing x = y
+    where y : a
+          y = x
+  {-# COMPILE AGDA2HS thing #-}
+
+  stuff : a → Scope → a
+  stuff x Empty = x
+  stuff x (Bind _ _ _) = x
+  {-# COMPILE AGDA2HS stuff #-}
+
+  module _ {b : Set} where
+    more : b → a → Scope → Scope
+    more _ _ Empty = Empty
+    more _ _ (Bind _ _ s) = s
+    {-# COMPILE AGDA2HS more #-}
+
\ No newline at end of file diff --git a/test/ModuleParametersImports.html b/test/ModuleParametersImports.html new file mode 100644 index 00000000..9c16f3f7 --- /dev/null +++ b/test/ModuleParametersImports.html @@ -0,0 +1,13 @@ + +ModuleParametersImports
{-# OPTIONS --no-projection-like #-}
+module ModuleParametersImports where
+
+open import Haskell.Prelude
+open import ModuleParameters Bool (λ _ → Nat)
+
+scope : Scope
+scope = unbind (Bind True 3 (Bind False 2 Empty))
+{-# COMPILE AGDA2HS scope #-}
+
+
+
\ No newline at end of file diff --git a/test/NewTypePragma.html b/test/NewTypePragma.html new file mode 100644 index 00000000..676b022a --- /dev/null +++ b/test/NewTypePragma.html @@ -0,0 +1,72 @@ + +NewTypePragma
open import Haskell.Prelude using ( Int ; fst ; snd
+                                  ; a ; b
+                                  ; _×_ ; _,_
+                                  ; _≡_; refl
+                                  ; List; map
+                                  )
+
+{-# FOREIGN AGDA2HS
+-- data newtype
+#-}
+
+data Indexed (a : Set) : Set where
+    MkIndexed : Int × a → Indexed a
+
+{-# COMPILE AGDA2HS Indexed newtype #-}
+
+index : Int × a → Indexed a
+index = MkIndexed
+
+{-# COMPILE AGDA2HS index #-}
+
+{-# FOREIGN AGDA2HS
+-- data newtype with deriving
+#-}
+
+data Pair (a b : Set) : Set where
+    MkPair : a × b → Pair a b
+
+{-# COMPILE AGDA2HS Pair newtype deriving ( Show, Eq ) #-}
+
+{-# FOREIGN AGDA2HS
+-- record newtype
+#-}
+
+record Identity (a : Set) : Set where
+    constructor MkIdentity
+    field
+        runIdentity : a
+open Identity public
+
+{-# COMPILE AGDA2HS Identity newtype #-}
+
+{-# FOREIGN AGDA2HS
+-- record newtype with erased proof
+#-}
+
+record Equal (a : Set) : Set where
+    constructor MkEqual
+    field
+        pair : a × a
+        @0 proof : fst pair ≡ snd pair
+open Equal public
+
+{-# COMPILE AGDA2HS Equal newtype #-}
+
+{-# FOREIGN AGDA2HS
+-- record newtype with same name
+#-}
+
+record Duo (a : Set) : Set where
+    field
+        duo : a × a
+open Duo public
+
+{-# COMPILE AGDA2HS Duo newtype #-}
+
+createDuo : a → a → Duo a
+createDuo a b = record { duo = a , b }
+
+{-# COMPILE AGDA2HS createDuo #-}
+
\ No newline at end of file diff --git a/test/NonClassInstance.html b/test/NonClassInstance.html new file mode 100644 index 00000000..9a3c9bd9 --- /dev/null +++ b/test/NonClassInstance.html @@ -0,0 +1,23 @@ + +NonClassInstance
+open import Haskell.Prelude
+open import Haskell.Extra.Dec
+open import Haskell.Extra.Refinement
+
+instance
+  iDecIsTrue : {b : Bool} → Dec (IsTrue b)
+  iDecIsTrue {False} = False ⟨ (λ ()) ⟩
+  iDecIsTrue {True}  = True  ⟨ IsTrue.itsTrue ⟩
+
+{-# COMPILE AGDA2HS iDecIsTrue #-}
+
+foo : (b : Bool) → {{Dec (IsTrue b)}} → Bool
+foo _ {{b ⟨ _ ⟩}} = not b
+
+{-# COMPILE AGDA2HS foo #-}
+
+bar : Bool → Bool
+bar b = foo b
+
+{-# COMPILE AGDA2HS bar #-}
+
\ No newline at end of file diff --git a/test/Numbers.html b/test/Numbers.html new file mode 100644 index 00000000..d45af54c --- /dev/null +++ b/test/Numbers.html @@ -0,0 +1,27 @@ + +Numbers
+module Numbers where
+
+open import Haskell.Prelude
+
+posNatural : Nat
+posNatural = 14
+
+posInteger : Integer
+posInteger = 52
+
+negInteger : Integer
+negInteger = -1001
+
+natToPos : Nat → Integer
+natToPos n = fromNat n
+
+natToNeg : Nat → Integer
+natToNeg n = fromNeg n
+
+{-# COMPILE AGDA2HS posNatural #-}
+{-# COMPILE AGDA2HS posInteger #-}
+{-# COMPILE AGDA2HS negInteger #-}
+{-# COMPILE AGDA2HS natToPos   #-}
+{-# COMPILE AGDA2HS natToNeg   #-}
+
\ No newline at end of file diff --git a/test/OtherImportee.html b/test/OtherImportee.html new file mode 100644 index 00000000..aa5665ae --- /dev/null +++ b/test/OtherImportee.html @@ -0,0 +1,8 @@ + +OtherImportee
open import Haskell.Prelude
+
+data OtherFoo : Set where
+  MkFoo : OtherFoo
+
+{-# COMPILE AGDA2HS OtherFoo #-}
+
\ No newline at end of file diff --git a/test/Pragmas.html b/test/Pragmas.html new file mode 100644 index 00000000..6bba71dd --- /dev/null +++ b/test/Pragmas.html @@ -0,0 +1,17 @@ + +Pragmas
+module Pragmas where
+
+-- Check that Haskell code is parsed with the correct language pragmas
+{-# FOREIGN AGDA2HS
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE LambdaCase #-}
+#-}
+
+{-# FOREIGN AGDA2HS
+foo :: Bool -> a -> (a, Int)
+foo = \ case
+  False -> (, 0)
+  True  -> (, 1)
+#-}
+
\ No newline at end of file diff --git a/test/ProjLike.html b/test/ProjLike.html new file mode 100644 index 00000000..678a9aa1 --- /dev/null +++ b/test/ProjLike.html @@ -0,0 +1,24 @@ + +ProjLike
module ProjLike where
+
+open import Haskell.Prelude
+
+module M (a : Set) where
+
+  data Scope : Set where
+    Empty : Scope
+    Bind  : a → Scope → Scope
+  
+  {-# COMPILE AGDA2HS Scope #-}
+
+  unbind : Scope → Scope
+  unbind Empty      = Empty
+  unbind (Bind _ s) = s
+
+open M Nat public
+
+test : Scope
+test = unbind (Bind 1 (Bind 2 Empty))
+
+{-# COMPILE AGDA2HS test #-}
+
\ No newline at end of file diff --git a/test/ProjectionLike.html b/test/ProjectionLike.html new file mode 100644 index 00000000..325ae2b0 --- /dev/null +++ b/test/ProjectionLike.html @@ -0,0 +1,18 @@ + +ProjectionLike
+open import Haskell.Prelude
+
+module _ (@0 n : Bool) where
+
+record R : Set where
+  field
+    fld : Int
+open R public
+
+{-# COMPILE AGDA2HS R #-}
+
+foo : R → Int
+foo x = fld x
+
+{-# COMPILE AGDA2HS foo #-}
+
\ No newline at end of file diff --git a/test/QualifiedImportee.html b/test/QualifiedImportee.html new file mode 100644 index 00000000..1198b886 --- /dev/null +++ b/test/QualifiedImportee.html @@ -0,0 +1,37 @@ + +QualifiedImportee
open import Haskell.Prelude
+
+foo : Int
+foo = 43
+
+{-# COMPILE AGDA2HS foo #-}
+
+_!#_ : Int → Int → Int
+x !# y = x - y
+
+{-# COMPILE AGDA2HS _!#_ #-}
+
+data Foo : Set where
+  MkFoo : Foo
+
+{-# COMPILE AGDA2HS Foo #-}
+
+-- ** base
+record Fooable (a : Set) : Set where
+  field doTheFoo defaultFoo : a
+-- ** defaults
+record DefaultFooable (a : Set) : Set where
+  field doTheFoo : a
+
+  defaultFoo : a
+  defaultFoo = doTheFoo
+-- ** export
+open Fooable ⦃...⦄ public
+{-# COMPILE AGDA2HS Fooable class DefaultFooable #-}
+-- ** instances
+instance
+  FF : Fooable Foo
+  FF = record {DefaultFooable (λ where .doTheFoo → MkFoo)}
+    where open DefaultFooable
+{-# COMPILE AGDA2HS FF #-}
+
\ No newline at end of file diff --git a/test/QualifiedImports.html b/test/QualifiedImports.html new file mode 100644 index 00000000..cf0c3c39 --- /dev/null +++ b/test/QualifiedImports.html @@ -0,0 +1,43 @@ + +QualifiedImports
open import Haskell.Prelude
+
+{-# FOREIGN AGDA2HS
+-- ** simple qualification
+#-}
+
+import Importee
+
+simpqualBar : Int
+simpqualBar = Importee.foo
+{-# COMPILE AGDA2HS simpqualBar #-}
+
+simpfoo : Importee.Foo
+simpfoo = Importee.Foo.MkFoo
+{-# COMPILE AGDA2HS simpfoo #-}
+
+{-# FOREIGN AGDA2HS
+-- ** qualified imports
+#-}
+
+import QualifiedImportee as Qually
+
+qualBar : Int
+qualBar = Qually.foo
+{-# COMPILE AGDA2HS qualBar #-}
+
+qualBaz : Int
+qualBaz = 2 Qually.!# 2
+{-# COMPILE AGDA2HS qualBaz #-}
+
+qualFooable : Qually.Foo
+qualFooable = Qually.doTheFoo
+{-# COMPILE AGDA2HS qualFooable #-}
+
+qualDefaultBar : Qually.Foo
+qualDefaultBar = Qually.defaultFoo
+{-# COMPILE AGDA2HS qualDefaultBar #-}
+
+Foo : Set
+Foo = Importee.Foo
+{-# COMPILE AGDA2HS Foo #-}
+
\ No newline at end of file diff --git a/test/QualifiedModule.html b/test/QualifiedModule.html new file mode 100644 index 00000000..ca38a1ae --- /dev/null +++ b/test/QualifiedModule.html @@ -0,0 +1,26 @@ + +QualifiedModule
+-- Names of definitions inside a module should not be qualified in the
+-- generated Haskell code!
+
+module _ where
+
+module A where
+
+  data D : Set where
+    C : D
+  {-# COMPILE AGDA2HS D #-}
+
+  f : D → D
+  f C = C
+  {-# COMPILE AGDA2HS f #-}
+
+  g : D
+  g = h
+    where
+      h : D
+      h = C
+  {-# COMPILE AGDA2HS g #-}
+
+open A public
+
\ No newline at end of file diff --git a/test/QualifiedPrelude.html b/test/QualifiedPrelude.html new file mode 100644 index 00000000..fbbdac2d --- /dev/null +++ b/test/QualifiedPrelude.html @@ -0,0 +1,39 @@ + +QualifiedPrelude
{-# FOREIGN AGDA2HS
+-- ** qualifying the Prelude
+#-}
+import Haskell.Prelude as Pre
+
+_+_ : Pre.Nat → Pre.Nat → Pre.Nat
+x + y = x
+{-# COMPILE AGDA2HS _+_ #-}
+
+comp : (Pre.Nat → Pre.Nat) → (Pre.Nat → Pre.Nat) → (Pre.Nat → Pre.Nat)
+comp f g = f Pre.∘ g
+{-# COMPILE AGDA2HS comp #-}
+
+test : Pre.Nat
+test = 0 Pre.+ 1 + 0
+{-# COMPILE AGDA2HS test #-}
+
+testComp : Pre.Nat
+testComp = comp (_+ 0) (Pre._+ 1) 0
+{-# COMPILE AGDA2HS testComp #-}
+
+{-# FOREIGN AGDA2HS
+-- ** interplay with (qualified) default methods of existing class
+#-}
+
+testFoldr : Pre.List Pre.Nat → Pre.Nat
+testFoldr = Pre.foldr (λ _ x → x) 0
+{-# COMPILE AGDA2HS testFoldr #-}
+
+{-# FOREIGN AGDA2HS
+-- ** re-qualifying the Prelude
+#-}
+import Haskell.Prelude as pre
+
+retest : pre.Nat
+retest = 0 pre.+ 1 + 0
+{-# COMPILE AGDA2HS retest #-}
+
\ No newline at end of file diff --git a/test/Records.html b/test/Records.html new file mode 100644 index 00000000..9e6b737a --- /dev/null +++ b/test/Records.html @@ -0,0 +1,50 @@ + +Records
module Records where
+
+open import Haskell.Prelude using (String; Nat)
+
+variable a b : Set
+
+-- parametrized record type exported as an Haskell record
+record Pair (a b : Set) : Set where
+  constructor MkPair
+  field
+    proj₁ : a
+    proj₂ : b
+
+open Pair public
+
+{-# COMPILE AGDA2HS Pair #-}
+
+-- no named constructor means we reuse the record name
+
+record Wrap (a : Set) : Set where
+  field unwrap : a
+open Wrap public
+{-# COMPILE AGDA2HS Wrap #-}
+
+-- record type exported as an Haskell class definition
+record MyMonoid (a : Set) : Set where
+  field
+    mempty  : a
+    mappend : a → a → a
+
+{-# COMPILE AGDA2HS MyMonoid class #-}
+
+swap : Pair a b → Pair b a
+swap (MkPair x y) = MkPair y x
+
+swap₂ : Wrap (Pair a b) → Wrap (Pair b a)
+swap₂ (record {unwrap = p}) = record {unwrap = record { proj₁ = proj₂ p; proj₂ = p .proj₁ } }
+
+{-# COMPILE AGDA2HS swap #-}
+{-# COMPILE AGDA2HS swap₂ #-}
+
+-- record with deriving clause
+record User : Set where
+  field
+    name : String
+    code : Nat
+open User public
+{-# COMPILE AGDA2HS User deriving (Eq, Show) #-}
+
\ No newline at end of file diff --git a/test/RequalifiedImports.html b/test/RequalifiedImports.html new file mode 100644 index 00000000..c60cdf62 --- /dev/null +++ b/test/RequalifiedImports.html @@ -0,0 +1,46 @@ + +RequalifiedImports
open import Haskell.Prelude
+
+{-# FOREIGN AGDA2HS
+-- ** conflicting imports are all replaced with the "smallest" qualifier
+--   * the characters are ordered based on their ASCII value (i.e. capitals first)
+--   * the order of the imports in the file does not matter
+--   * the scope-checker has already replaced previous definitions in the file
+#-}
+
+import QualifiedImportee as C
+
+requalBar : Int
+requalBar = C.foo
+{-# COMPILE AGDA2HS requalBar #-}
+
+import QualifiedImportee as A
+
+requalBaz : Int
+requalBaz = 2 A.!# 2
+{-# COMPILE AGDA2HS requalBaz #-}
+
+requalFooable : A.Foo
+requalFooable = C.doTheFoo
+{-# COMPILE AGDA2HS requalFooable #-}
+
+import QualifiedImportee as B
+
+requalDefaultBar : B.Foo
+requalDefaultBar = B.defaultFoo
+{-# COMPILE AGDA2HS requalDefaultBar #-}
+
+{-# FOREIGN AGDA2HS
+-- ** qualifying an open'ed module has no effect
+#-}
+import Haskell.Prelude as Pre
+import OtherImportee as Other
+open import OtherImportee using (OtherFoo)
+
+T = Pre.Int
+{-# COMPILE AGDA2HS T #-}
+
+otherFoo : OtherFoo
+otherFoo = Other.MkFoo -- this qualification is not retained
+{-# COMPILE AGDA2HS otherFoo #-}
+
\ No newline at end of file diff --git a/test/ScopedTypeVariables.html b/test/ScopedTypeVariables.html new file mode 100644 index 00000000..64e0aabe --- /dev/null +++ b/test/ScopedTypeVariables.html @@ -0,0 +1,31 @@ + +ScopedTypeVariables
open import Haskell.Prelude
+
+module ScopedTypeVariables (@0 x : Bool) where
+
+-- We can encode explicit `forall` quantification by module parameters in Agda.
+module _ {a : Set} {{_ : Eq a}} where
+  foo : a → Bool
+  foo x = it x == x
+    where
+      it : a -> a
+      it = const x
+{-# COMPILE AGDA2HS foo #-}
+
+-- Type arguments should be compiled in the right order.
+module _ {a b : Set} where
+  bar : a → b → (b → b) → b
+  bar x y f = baz y
+    where
+      baz : b → b
+      baz z = f (f z)
+{-# COMPILE AGDA2HS bar #-}
+
+data D : Set where
+  MakeD : (y : Bool) → @0 x ≡ y → D
+{-# COMPILE AGDA2HS D #-}
+
+mybool : Bool
+mybool = False
+{-# COMPILE AGDA2HS mybool #-}
+
\ No newline at end of file diff --git a/test/SecondImportee.html b/test/SecondImportee.html new file mode 100644 index 00000000..e89fb23e --- /dev/null +++ b/test/SecondImportee.html @@ -0,0 +1,9 @@ + +SecondImportee
+open import Haskell.Prelude
+
+anotherFoo : Int
+anotherFoo = 666
+
+{-# COMPILE AGDA2HS anotherFoo #-}
+
\ No newline at end of file diff --git a/test/Sections.html b/test/Sections.html new file mode 100644 index 00000000..0e5ae05c --- /dev/null +++ b/test/Sections.html @@ -0,0 +1,27 @@ + +Sections
+module Sections where
+
+open import Haskell.Prelude
+
+test₁ : Nat → Nat
+test₁ = 5 +_
+
+test₂ : Nat → Nat
+test₂ = _+ 5
+
+test₃ : Nat → Nat
+test₃ = _+_ 5
+
+test₄ : Nat → Nat
+test₄ = λ x → x + 5
+
+test₅ : Nat → Nat
+test₅ = λ x → 5 + x -- Agda eta-contracts this before we get to see it
+
+{-# COMPILE AGDA2HS test₁ #-}
+{-# COMPILE AGDA2HS test₂ #-}
+{-# COMPILE AGDA2HS test₃ #-}
+{-# COMPILE AGDA2HS test₄ #-}
+{-# COMPILE AGDA2HS test₅ #-}
+
\ No newline at end of file diff --git a/test/Superclass.html b/test/Superclass.html new file mode 100644 index 00000000..66350515 --- /dev/null +++ b/test/Superclass.html @@ -0,0 +1,69 @@ + +Superclass
{-# OPTIONS --erase-record-parameters #-}
+open import Haskell.Prelude
+
+record Super (a : Set) : Set where
+  field
+    myFun : a → a
+open Super {{...}}
+{-# COMPILE AGDA2HS Super class #-}
+
+record Sub (a : Set) : Set where
+  field
+    overlap {{super}} : Super a
+open Sub {{...}}
+{-# COMPILE AGDA2HS Sub class #-}
+
+foo : {{Sub a}} → a → a
+foo = myFun ∘ myFun
+{-# COMPILE AGDA2HS foo #-}
+
+-- Trying if diamonds are fine
+record Sub2 (a : Set) : Set where
+  field
+    overlap {{super}} : Super a
+open Sub2 {{...}}
+{-# COMPILE AGDA2HS Sub2 class #-}
+
+record Subber (a : Set) : Set where
+  field
+    overlap {{super}} : Sub a
+    overlap {{super2}} : Sub2 a
+open Subber {{...}}
+{-# COMPILE AGDA2HS Subber class #-}
+
+bar : {{Subber a}} → a → a
+bar = myFun ∘ id
+{-# COMPILE AGDA2HS bar #-}
+
+instance
+  iSuperInt : Super Int
+  iSuperInt .myFun = 1 +_
+{-# COMPILE AGDA2HS iSuperInt #-}
+
+instance
+  iSubInt : Sub Int
+  iSubInt = record{}
+{-# COMPILE AGDA2HS iSubInt #-}
+
+-- Defining a subclass of an existing class from Prelude
+
+record DiscreteOrd (a : Set) : Set where
+  field
+    overlap {{super}} : Ord a
+open DiscreteOrd {{...}}
+{-# COMPILE AGDA2HS DiscreteOrd class #-}
+
+instance
+  iDiscreteOrdBool : DiscreteOrd Bool
+  iDiscreteOrdBool = record {}
+{-# COMPILE AGDA2HS iDiscreteOrdBool #-}
+
+baz : {{DiscreteOrd a}} → a → Bool
+baz x = x < x
+
+usebaz : Bool
+usebaz = baz True
+{-# COMPILE AGDA2HS baz #-}
+{-# COMPILE AGDA2HS usebaz #-}
+
\ No newline at end of file diff --git a/test/Test.html b/test/Test.html new file mode 100644 index 00000000..d031180e --- /dev/null +++ b/test/Test.html @@ -0,0 +1,229 @@ + +Test
{-# OPTIONS --erase-record-parameters #-}
+
+module _ where
+
+open import Haskell.Prelude
+open import Agda.Builtin.Equality
+
+-- ** Foreign HS code
+
+-- language extensions
+{-# FOREIGN AGDA2HS
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleInstances #-}
+#-}
+
+-- imports
+{-# FOREIGN AGDA2HS
+import Data.Monoid
+#-}
+
+-- ** Datatypes & functions
+
+data Exp (v : Set) : Set where
+  Plus : Exp v → Exp v → Exp v
+  Lit : Nat → Exp v
+  Var : v → Exp v
+{-# COMPILE AGDA2HS Exp deriving (Show,Eq) #-}
+
+eval : (a → Nat) → Exp a → Nat
+eval env (Plus a b) = eval env a + eval env b
+eval env (Lit n) = n
+eval env (Var x) = env x
+{-# COMPILE AGDA2HS eval #-}
+
+-- ** Natural numbers
+
+listSum : List Int → Int
+listSum []       = 0
+listSum (x ∷ xs) = x + sum xs
+{-# COMPILE AGDA2HS listSum #-}
+
+monoSum : List Integer → Integer
+monoSum xs = sum xs
+{-# COMPILE AGDA2HS monoSum #-}
+
+polySum : ⦃ iNum : Num a ⦄ → List a → a
+polySum xs = sum xs
+{-# COMPILE AGDA2HS polySum #-}
+
+{-# FOREIGN AGDA2HS
+-- comment
+-- another comment
+bla :: Int -> Int
+bla n = n * 4
+
+{- multi
+   line
+   comment
+-}
+#-}
+
+-- ** Extra builtins
+
+ex_float : Double
+ex_float = 0.0
+{-# COMPILE AGDA2HS ex_float #-}
+
+postulate
+  toInteger : Word → Integer
+
+ex_word : Word
+ex_word = fromInteger 0
+{-# COMPILE AGDA2HS ex_word #-}
+
+ex_char : Char
+ex_char = 'a'
+{-# COMPILE AGDA2HS ex_char #-}
+
+char_d : Char
+char_d = toEnum 100
+{-# COMPILE AGDA2HS char_d #-}
+
+-- ** Polymorphic functions
+
+_+++_ : List a → List a → List a
+[]       +++ ys = ys
+(x ∷ xs) +++ ys = x ∷ (xs +++ ys)
+{-# COMPILE AGDA2HS _+++_ #-}
+
+listMap : (a → b) → List a → List b
+listMap f [] = []
+listMap f (x ∷ xs) = f x ∷ listMap f xs
+{-# COMPILE AGDA2HS listMap #-}
+
+mapTest : List Nat → List Nat
+mapTest = map (id ∘ _+_ 5)
+{-# COMPILE AGDA2HS mapTest #-}
+
+-- ** Lambdas
+
+plus3 : List Nat → List Nat
+plus3 = map (λ n → n + 3)
+{-# COMPILE AGDA2HS plus3 #-}
+
+doubleLambda : Nat → Nat → Nat
+doubleLambda = λ a b → a + 2 * b
+{-# COMPILE AGDA2HS doubleLambda #-}
+
+cnst : a → b → a
+cnst = λ x _ → x
+{-# COMPILE AGDA2HS cnst #-}
+
+-- ** Constraints
+
+second : (b → c) → a × b → a × c
+second f (x , y) = x , f y
+{-# COMPILE AGDA2HS second #-}
+
+doubleTake : (n m : Int) → @0 ⦃ IsNonNegativeInt n ⦄ → @0 ⦃ IsNonNegativeInt m ⦄ → List a → List a × List a
+doubleTake n m = second (take m) ∘ splitAt n
+{-# COMPILE AGDA2HS doubleTake #-}
+
+initLast : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → List a × a
+initLast xs = init xs , last xs
+{-# COMPILE AGDA2HS initLast #-}
+
+-- ** Proofs
+
+assoc : (a b c : Nat) → a + (b + c) ≡ (a + b) + c
+assoc zero    b c = refl
+assoc (suc a) b c rewrite assoc a b c = refl
+
+thm : (xs ys : List Nat) → sum (xs ++ ys) ≡ sum xs + sum ys
+thm []       ys = refl
+thm (x ∷ xs) ys rewrite thm xs ys | assoc x (sum xs) (sum ys) = refl
+
+-- (custom) Monoid class
+
+record MonoidX (a : Set) : Set where
+  field memptyX  : a
+        mappendX : a → a → a
+
+open MonoidX {{...}} public
+
+{-# COMPILE AGDA2HS MonoidX class #-}
+
+instance
+  MonoidNat : MonoidX Nat
+  memptyX  {{MonoidNat}}     = 0
+  mappendX {{MonoidNat}} i j = i + j
+
+{-# COMPILE AGDA2HS MonoidNat #-}
+
+
+instance
+  MonoidFunNat : MonoidX (a → Nat)
+  memptyX  {{MonoidFunNat}}     _ = memptyX
+  mappendX {{MonoidFunNat}} f g x = mappendX (f x) (g x)
+
+{-# COMPILE AGDA2HS MonoidFunNat #-}
+
+instance
+  MonoidFun : {{MonoidX b}} → MonoidX (a → b)
+  memptyX  {{MonoidFun}}     _ = memptyX
+  mappendX {{MonoidFun}} f g x = mappendX (f x) (g x)
+{-# COMPILE AGDA2HS MonoidFun #-}
+
+sumMonX : {{MonoidX a}} → List a → a
+sumMonX []       = memptyX
+sumMonX (x ∷ xs) = mappendX x (sumMonX xs)
+{-# COMPILE AGDA2HS sumMonX #-}
+
+sumMon : {{Monoid a}} → List a → a
+sumMon []       = mempty
+sumMon (x ∷ xs) = x <> sumMon xs
+{-# COMPILE AGDA2HS sumMon #-}
+
+-- Using the Monoid class from the Prelude
+
+data NatSum : Set where
+  MkSum : Nat → NatSum
+
+{-# COMPILE AGDA2HS NatSum #-}
+
+instance
+  SemigroupNatSum : Semigroup NatSum
+  SemigroupNatSum ._<>_ (MkSum a) (MkSum b) = MkSum (a + b)
+
+  MonoidNatSum : Monoid NatSum
+  MonoidNatSum = record {DefaultMonoid (λ where
+    .mempty → MkSum 0
+   )} where open DefaultMonoid
+
+double : ⦃ Monoid a ⦄ → a → a
+double x = x <> x
+
+doubleSum : NatSum → NatSum
+doubleSum = double
+
+{-# COMPILE AGDA2HS SemigroupNatSum #-}
+{-# COMPILE AGDA2HS MonoidNatSum    #-}
+{-# COMPILE AGDA2HS double          #-}
+{-# COMPILE AGDA2HS doubleSum       #-}
+
+-- Instance argument proof obligation that should not turn into a class constraint
+hd : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → a
+hd []      = error "hd: empty list"
+hd (x ∷ _) = x
+{-# COMPILE AGDA2HS hd #-}
+
+five : Int
+five = hd (5 ∷ 3 ∷ [])
+{-# COMPILE AGDA2HS five #-}
+
+-- ** Booleans
+
+ex_bool : Bool
+ex_bool = True
+{-# COMPILE AGDA2HS ex_bool #-}
+
+ex_if : Nat
+ex_if = if True then 1 else 0
+{-# COMPILE AGDA2HS ex_if #-}
+
+if_over : Nat
+if_over = (if True then (λ x → x) else (λ x → x + 1)) 0
+{-# COMPILE AGDA2HS if_over #-}
+
\ No newline at end of file diff --git a/test/TransparentFun.html b/test/TransparentFun.html new file mode 100644 index 00000000..94d660f0 --- /dev/null +++ b/test/TransparentFun.html @@ -0,0 +1,44 @@ + +TransparentFun
+open import Haskell.Prelude
+
+data Unit : Set where
+  unit : Unit
+
+myId : @0 Unit → a → a
+myId unit x = x
+
+{-# COMPILE AGDA2HS myId transparent #-}
+
+testMyId : @0 Unit → Nat
+testMyId u = myId u 42
+
+{-# COMPILE AGDA2HS testMyId #-}
+
+tyId : @0 Unit → Set → Set
+tyId unit a = a
+
+{-# COMPILE AGDA2HS tyId transparent #-}
+
+testTyId : ∀ {@0 u : Unit} → tyId u (tyId u Int → tyId u Int)
+testTyId {unit} n = n
+
+{-# COMPILE AGDA2HS testTyId #-}
+
+data Tree : Set where
+  Tip : Tree
+  Bin : Tree → Tree → Tree
+
+{-# COMPILE AGDA2HS Tree #-}
+
+treeId : Tree → Tree
+treeId Tip = Tip
+treeId (Bin x y) = Bin (treeId x) (treeId y)
+
+{-# COMPILE AGDA2HS treeId transparent #-}
+
+testTreeId : Tree → Tree
+testTreeId = treeId
+
+{-# COMPILE AGDA2HS testTreeId #-}
+
\ No newline at end of file diff --git a/test/Tree.html b/test/Tree.html new file mode 100644 index 00000000..225c4403 --- /dev/null +++ b/test/Tree.html @@ -0,0 +1,13 @@ + +Tree
open import Haskell.Prelude
+
+data _≤_ : Nat → Nat → Set where
+  instance
+    zero-≤ : ∀ {@0 n} → zero ≤ n
+    suc-≤ : ∀ {@0 m n} → @0 {{m ≤ n}} → suc m ≤ suc n
+
+data Tree (@0 l u : Nat) : Set where
+  Leaf  : @0 {{l ≤ u}} → Tree l u
+  Node  : (x : Nat) → Tree l x → Tree x u → Tree l u
+{-# COMPILE AGDA2HS Tree #-}
+
\ No newline at end of file diff --git a/test/Tuples.html b/test/Tuples.html new file mode 100644 index 00000000..16b35a1b --- /dev/null +++ b/test/Tuples.html @@ -0,0 +1,63 @@ + +Tuples
+module Tuples where
+
+open import Haskell.Prelude
+
+swap : a × b → b × a
+swap (a , b) = b , a
+
+{-# COMPILE AGDA2HS swap #-}
+
+data TuplePos : Set where
+  Test : TuplePos × Bool → TuplePos
+
+{-# COMPILE AGDA2HS TuplePos #-}
+
+
+t1 : Bool × Bool × Bool
+t1 = True , False , True
+
+{-# COMPILE AGDA2HS t1 #-}
+
+t2 : (Bool × Bool) × Bool
+t2 = (True , False) , True
+
+{-# COMPILE AGDA2HS t2 #-}
+
+t3 : Bool × (Bool × Bool)
+t3 = True , (False , True)
+
+{-# COMPILE AGDA2HS t3 #-}
+
+pair : Int × Int
+pair = 1 , 2
+
+{-# COMPILE AGDA2HS pair #-}
+
+test : Int
+test = let (x , y) = pair in x + y
+
+{-# COMPILE AGDA2HS test #-}
+
+test2 : Bool
+test2 = case t1 of \where
+  (a , b , c) → c
+
+{-# COMPILE AGDA2HS test2 #-}
+
+open import Haskell.Extra.Sigma as S using (Σ-syntax)
+open import Haskell.Extra.Dec
+open import Haskell.Prim using (itsTrue)
+open import Haskell.Extra.Refinement
+
+t4 : Σ[ n ∈ Nat ] (Dec (IsTrue (n <= 5)))
+t4 = 3 S., (True ⟨ itsTrue ⟩)
+
+{-# COMPILE AGDA2HS t4 #-}
+
+t5 : Σ[ x ∈ a ] b → a
+t5 p = case p of λ where (x S., y) → x
+
+{-# COMPILE AGDA2HS t5 #-}
+
\ No newline at end of file diff --git a/test/TypeBasedUnboxing.html b/test/TypeBasedUnboxing.html new file mode 100644 index 00000000..191ed558 --- /dev/null +++ b/test/TypeBasedUnboxing.html @@ -0,0 +1,25 @@ + +TypeBasedUnboxing
{-# OPTIONS --prop --sized-types #-}
+
+open import Agda.Primitive
+open import Agda.Builtin.Size
+open import Haskell.Prelude
+
+data P : Prop where
+
+record R : Set where
+  field
+    @0 anErasedThing : Bool
+    aRealThing : Int
+    aLevel : Level
+    aProp : P
+    aSize : Size
+open R public
+
+{-# COMPILE AGDA2HS R unboxed #-}
+
+foo : R → Int
+foo = aRealThing
+
+{-# COMPILE AGDA2HS foo #-}
+
\ No newline at end of file diff --git a/test/TypeDirected.html b/test/TypeDirected.html new file mode 100644 index 00000000..a9e334d6 --- /dev/null +++ b/test/TypeDirected.html @@ -0,0 +1,36 @@ + +TypeDirected
{-# OPTIONS --prop #-}
+module TypeDirected where
+
+open import Agda.Builtin.Reflection
+open import Agda.Builtin.Unit
+open import Haskell.Prelude
+
+data MyProp : Prop where
+  true : MyProp
+
+myconst : {a : Set} → MyProp → a → {y : a} → a
+myconst p x = x
+
+{-# COMPILE AGDA2HS myconst #-}
+
+defTrue : Term → TC ⊤
+defTrue hole = unify hole (quoteTerm True)
+
+fn : {@(tactic defTrue) b : Bool} → Int
+fn {False} = 0
+fn {True } = 5
+
+{-# COMPILE AGDA2HS fn #-}
+
+test1 : Int
+test1 = fn
+
+{-# COMPILE AGDA2HS test1 #-}
+
+test2 : Int
+test2 = fn {False}
+
+{-# COMPILE AGDA2HS test2 #-}
+
+
\ No newline at end of file diff --git a/test/TypeOperatorExport.html b/test/TypeOperatorExport.html new file mode 100644 index 00000000..90c05456 --- /dev/null +++ b/test/TypeOperatorExport.html @@ -0,0 +1,23 @@ + +TypeOperatorExport
module TypeOperatorExport where
+
+{-# FOREIGN AGDA2HS {-# LANGUAGE TypeOperators #-} #-}
+
+open import Agda.Primitive
+
+_<_ : Set -> Set -> Set
+a < b = a
+{-# COMPILE AGDA2HS _<_ #-}
+
+data _***_ {i j : Level} (a : Set i) (b : Set j) : Set (i ⊔ j) where
+  _:*:_ : a -> b -> a *** b
+open _***_ public
+{-# COMPILE AGDA2HS _***_ #-}
+
+open import Agda.Builtin.Bool
+
+_&&&_ : Bool -> Bool -> Bool
+false &&& _  = false
+_     &&& b2 = b2
+{-# COMPILE AGDA2HS _&&&_ #-}
+
\ No newline at end of file diff --git a/test/TypeOperatorImport.html b/test/TypeOperatorImport.html new file mode 100644 index 00000000..66e9f8cc --- /dev/null +++ b/test/TypeOperatorImport.html @@ -0,0 +1,22 @@ + +TypeOperatorImport
module TypeOperatorImport where
+
+{-# FOREIGN AGDA2HS {-# LANGUAGE TypeOperators #-} #-}
+
+open import Agda.Builtin.Unit
+open import Agda.Builtin.Bool
+open import Haskell.Prelude using (_∘_)
+open import TypeOperatorExport
+
+not : Bool → Bool
+not true  = false
+not false = true
+
+test1 : ⊤ < Bool
+test1 = tt
+{-# COMPILE AGDA2HS test1 #-}
+
+test2 : Bool -> Bool -> ⊤ *** Bool
+test2 b1 b2 = ((tt :*:_) ∘ not) (b1 &&& b2)
+{-# COMPILE AGDA2HS test2 #-}
+
\ No newline at end of file diff --git a/test/TypeOperators.html b/test/TypeOperators.html new file mode 100644 index 00000000..1f969dfa --- /dev/null +++ b/test/TypeOperators.html @@ -0,0 +1,34 @@ + +TypeOperators
module TypeOperators where
+
+{-# FOREIGN AGDA2HS {-# LANGUAGE TypeOperators #-} #-}
+
+open import Haskell.Prim.Either
+
+open import Agda.Builtin.Nat
+open import Agda.Builtin.Bool
+
+_:++:_ : Set → Set → Set
+_:++:_ = Either
+{-# COMPILE AGDA2HS _:++:_ #-}
+
+mx : Bool :++: Nat
+mx = Left true
+{-# COMPILE AGDA2HS mx #-}
+
+_++++_ : Set → Set → Set
+_++++_ = Either
+{-# COMPILE AGDA2HS _++++_ #-}
+
+mx' : Bool ++++ Nat
+mx' = Left true
+{-# COMPILE AGDA2HS mx' #-}
+
+data _****_ (a b : Set): Set where
+  _:****_ : a → b → a **** b
+{-# COMPILE AGDA2HS _****_ #-}
+
+cross : Bool **** Nat
+cross = true :**** 1
+{-# COMPILE AGDA2HS cross #-}
+
\ No newline at end of file diff --git a/test/TypeSignature.html b/test/TypeSignature.html new file mode 100644 index 00000000..1bef7678 --- /dev/null +++ b/test/TypeSignature.html @@ -0,0 +1,10 @@ + +TypeSignature
module TypeSignature where
+
+open import Agda.Builtin.Nat
+open import Haskell.Prim
+
+five : Nat
+five = the (Nat -> Nat) id 5
+{-# COMPILE AGDA2HS five #-}
+
\ No newline at end of file diff --git a/test/TypeSynonyms.html b/test/TypeSynonyms.html new file mode 100644 index 00000000..ef05a309 --- /dev/null +++ b/test/TypeSynonyms.html @@ -0,0 +1,41 @@ + +TypeSynonyms
+data Nat : Set where
+  Zero : Nat
+  Suc  : Nat → Nat
+{-# COMPILE AGDA2HS Nat #-}
+
+Nat' = Nat
+{-# COMPILE AGDA2HS Nat' #-}
+
+myNat : Nat'
+myNat = Suc (Suc Zero)
+{-# COMPILE AGDA2HS myNat #-}
+
+data List (a : Set) : Set where
+  Nil : List a
+  Cons : a → List a → List a
+{-# COMPILE AGDA2HS List #-}
+
+List' : Set → Set
+List' a = List a
+{-# COMPILE AGDA2HS List' #-}
+
+NatList = List Nat
+{-# COMPILE AGDA2HS NatList #-}
+
+myListFun : List' Nat' → NatList
+myListFun Nil = Nil
+myListFun (Cons x xs) = Cons x (myListFun xs)
+{-# COMPILE AGDA2HS myListFun #-}
+
+ListList : Set → Set
+ListList a = List (List a)
+{-# COMPILE AGDA2HS ListList #-}
+
+flatten : ∀ {a} → ListList a → List a
+flatten Nil = Nil
+flatten (Cons Nil xss) = flatten xss
+flatten (Cons (Cons x xs) xss) = Cons x (flatten (Cons xs xss))
+{-# COMPILE AGDA2HS flatten #-}
+
\ No newline at end of file diff --git a/test/UnboxPragma.html b/test/UnboxPragma.html new file mode 100644 index 00000000..91dbbee0 --- /dev/null +++ b/test/UnboxPragma.html @@ -0,0 +1,57 @@ + +UnboxPragma
+open import Haskell.Prelude
+
+record ∃ (A : Set) (@0 P : A → Set) : Set where
+  constructor _[_]
+  field
+    el : A
+    @0 pf : P el
+open ∃ public
+
+{-# COMPILE AGDA2HS ∃ unboxed #-}
+
+postulate
+  IsSorted : List Int → Set
+  looksfine : {xs : List Int} → IsSorted xs
+
+sort1 : List Int → ∃ (List Int) IsSorted
+sort1 xs = xs [ looksfine ]
+
+{-# COMPILE AGDA2HS sort1 #-}
+
+sort2 : List Int → ∃ (List Int) IsSorted
+sort2 xs .el = xs
+sort2 xs .pf = looksfine
+
+{-# COMPILE AGDA2HS sort2 #-}
+
+sort3 : List Int → ∃ (List Int) IsSorted
+sort3 xs = xs [ sort2 xs .pf ]
+
+{-# COMPILE AGDA2HS sort3 #-}
+
+sortAll : List (List Int)
+sortAll = map el (map (λ xs → xs [ looksfine {xs} ]) ((1 ∷ 2 ∷ []) ∷ (3 ∷ []) ∷ []))
+
+{-# COMPILE AGDA2HS sortAll #-}
+
+record Σ0 (A : Set) (P : @0 A → Set) : Set where
+  constructor _[_]
+  field
+    @0 el : A
+    pf : P el
+open Σ0 public
+
+{-# COMPILE AGDA2HS Σ0 unboxed #-}
+
+Scope : (name : Set) → Set
+Scope name = Σ0 (List name) λ xs → ∃ Int λ n → length xs ≡ n
+
+{-# COMPILE AGDA2HS Scope #-}
+
+emptyScope : {name : Set} → Scope name
+emptyScope = [] [ 0 [ refl ] ]
+
+{-# COMPILE AGDA2HS emptyScope #-}
+
\ No newline at end of file diff --git a/test/Vector.html b/test/Vector.html new file mode 100644 index 00000000..53898603 --- /dev/null +++ b/test/Vector.html @@ -0,0 +1,35 @@ + +Vector
+open import Haskell.Prelude
+
+{- Old style using implicit arguments (no longer supported)
+data Vec (a : Set) : {n : Nat} → Set where
+  Nil : Vec a {0}
+  Cons : {n : Nat} → a → Vec a {n} → Vec a {suc n}
+{-# COMPILE AGDA2HS Vec #-}
+
+mapV : {a b : Set} {n : Nat} (f : a → b) → Vec a {n} → Vec b {n}
+mapV f Nil = Nil
+mapV f (Cons x xs) = Cons (f x) (mapV f xs)
+{-# COMPILE AGDA2HS mapV #-}
+
+tailV : {a : Set} {n : Nat} → Vec a {suc n} → Vec a {n}
+tailV (Cons x xs) = xs
+{-# COMPILE AGDA2HS tailV #-}
+-}
+
+-- New style using erasure instead of implicit arguments
+data Vec (a : Set) : (@0 n : Nat) → Set where
+  Nil : Vec a 0
+  Cons : {@0 n : Nat} → a → Vec a n → Vec a (suc n)
+{-# COMPILE AGDA2HS Vec #-}
+
+mapV : {a b : Set} {@0 n : Nat} (f : a → b) → Vec a n → Vec b n
+mapV f Nil = Nil
+mapV f (Cons x xs) = Cons (f x) (mapV f xs)
+{-# COMPILE AGDA2HS mapV #-}
+
+tailV : {a : Set} {@0 n : Nat} → Vec a (suc n) → Vec a n
+tailV (Cons x xs) = xs
+{-# COMPILE AGDA2HS tailV #-}
+
\ No newline at end of file diff --git a/test/Where.html b/test/Where.html new file mode 100644 index 00000000..69179d2e --- /dev/null +++ b/test/Where.html @@ -0,0 +1,136 @@ + +Where
{-# OPTIONS --no-auto-inline #-}
+module Where where
+
+open import Haskell.Prelude hiding (_+_; _*_; _-_)
+open import Agda.Builtin.Nat
+
+postulate
+  bool2nat : Bool → Nat
+
+-- no outer arguments
+ex1 : Nat
+ex1 = mult num + bool2nat True
+  where
+    num : Nat
+    num = 42
+
+    mult : Nat → Nat
+    mult = _* 100
+
+-- nested where
+ex2 : Nat
+ex2 = mult num + bool2nat True
+  where
+    num : Nat
+    num = 42
+
+    mult : Nat → Nat
+    mult = _⊗ 100
+      where
+        _⊗_ = _*_
+
+-- with outer arguments
+ex3 : Nat → Bool → Nat
+ex3 n b = mult num + bool2nat b
+  where
+    num = 42 + bool2nat b
+
+    mult : Nat → Nat
+    mult = _* n
+
+-- nested where with outer arguments
+ex4 : Bool → Nat
+ex4 b = mult 42
+  where
+    mult : Nat → Nat
+    mult n = bump n (bool2nat b)
+      where
+        bump : Nat → Nat → Nat
+        bump x y = x * y + (n - bool2nat b)
+
+ex4' : Bool → Nat
+ex4' b = mult (bool2nat b)
+  where
+    mult : Nat → Nat
+    mult n = bump n (bool2nat b)
+      where
+        bump : Nat → Nat → Nat
+        bump x y = go (x * y) (n - bool2nat b)
+          where
+            go : Nat → Nat → Nat
+            go z w = z + x + w + y + n + bool2nat b
+
+-- with pattern matching and multiple clauses
+ex5 : List Nat → Nat
+ex5 [] = zro
+  where
+    zro : Nat
+    zro = 0
+ex5 (n ∷ ns) = mult num + 1
+  where
+    num = 42 + ex5 ns
+
+    mult : Nat → Nat
+    mult = _* n
+
+-- mix of patterns + inner multiple clauses + nested where
+ex6 : List Nat → Bool → Nat
+ex6 [] b = zro
+  where
+    zro : Nat
+    zro = 0
+ex6 (n ∷ ns) b = mult (num ∷ 1 ∷ [])
+  where
+    mult : List Nat → Nat
+    mult [] = bump 5 (bool2nat b)
+      where
+        bump : Nat → Nat → Nat
+        bump x y = x * y + n
+    mult (m ∷ ms) = bump n m
+      where
+        bump : Nat → Nat → Nat
+        bump x y = x * y + (m - n)
+
+    num = 42 + ex6 ns True
+
+ex7 : Nat → Nat
+ex7 n₀ = go₁ n₀
+  where
+    go₁ : Nat → Nat
+    go₁ n₁ = go₂ (n₀ + n₁)
+      where
+        go₂ : Nat → Nat
+        go₂ n₂ = n₀ + n₁ + n₂
+
+ex7' : Nat → Nat
+ex7' n₀ = go₁ n₀
+  where
+    go₁ : Nat → Nat
+    go₁ n₁ = go₂ (n₀ + n₁)
+      where
+        go₂ : Nat → Nat
+        go₂ n₂ = go₃ (n₀ + n₁ + n₂)
+          where
+            go₃ : Nat → Nat
+            go₃ n₃ = n₀ + n₁ + n₂ + n₃
+
+ex8 : Nat
+ex8 = n₂
+  where
+    n₁ : Nat
+    n₁ = 1
+    n₂ = n₁ + 1
+
+{-# COMPILE AGDA2HS bool2nat #-}
+{-# COMPILE AGDA2HS ex1 #-}
+{-# COMPILE AGDA2HS ex2 #-}
+{-# COMPILE AGDA2HS ex3 #-}
+{-# COMPILE AGDA2HS ex4 #-}
+{-# COMPILE AGDA2HS ex4' #-}
+{-# COMPILE AGDA2HS ex5 #-}
+{-# COMPILE AGDA2HS ex6 #-}
+{-# COMPILE AGDA2HS ex7 #-}
+{-# COMPILE AGDA2HS ex7' #-}
+{-# COMPILE AGDA2HS ex8 #-}
+
\ No newline at end of file diff --git a/test/WitnessedFlows.html b/test/WitnessedFlows.html new file mode 100644 index 00000000..d09ac8f2 --- /dev/null +++ b/test/WitnessedFlows.html @@ -0,0 +1,45 @@ + +WitnessedFlows
open import Haskell.Prelude
+open import Haskell.Control.Monad
+
+data Range : Set where
+    MkRange : (low high : Int)
+            → {{ @0 h : ((low <= high) ≡ True) }}
+            → Range
+
+{-# COMPILE AGDA2HS Range #-}
+
+createRange : Int → Int → Maybe Range
+createRange low high = if low <= high then Just (MkRange low high) else Nothing
+
+{-# COMPILE AGDA2HS createRange #-}
+
+createRange' : Int → Int → Maybe Range
+createRange' low high =
+    if low <= high then
+        (λ {{ h }} → if low <= high then Just (MkRange low high {{ h }}) else Nothing)
+    else Nothing
+
+{-# COMPILE AGDA2HS createRange' #-}
+
+createRangeCase : Int → Int → Maybe Range
+createRangeCase low high =
+    case low <= high of λ where
+        True → Just (MkRange low high)
+        False → Nothing
+
+{-# COMPILE AGDA2HS createRangeCase #-}
+
+createRangeGuardSeq : Int → Int → Maybe Range
+createRangeGuardSeq low high =
+  do guard (low <= high)
+     pure (MkRange low high)
+
+{-# COMPILE AGDA2HS createRangeGuardSeq #-}
+
+createRangeGuardFmap : Int → Int → Maybe Range
+createRangeGuardFmap low high
+  = MkRange low high <$ guard (low <= high)
+
+{-# COMPILE AGDA2HS createRangeGuardFmap #-}
+
\ No newline at end of file diff --git a/test/build/AllCubicalTests.hs b/test/build/AllCubicalTests.hs new file mode 100644 index 00000000..d1e2f81e --- /dev/null +++ b/test/build/AllCubicalTests.hs @@ -0,0 +1,4 @@ +module AllCubicalTests where + +import Cubical.StreamFusion + diff --git a/test/build/AllCubicalTests.html b/test/build/AllCubicalTests.html new file mode 100644 index 00000000..5c8a3439 --- /dev/null +++ b/test/build/AllCubicalTests.html @@ -0,0 +1,83 @@ + + + + + + + AllCubicalTests + + + +
module AllCubicalTests where
+
+import Cubical.StreamFusion
+ + diff --git a/test/build/AllCubicalTests.md b/test/build/AllCubicalTests.md new file mode 100644 index 00000000..b4b9b072 --- /dev/null +++ b/test/build/AllCubicalTests.md @@ -0,0 +1,6 @@ +```haskell +module AllCubicalTests where + +import Cubical.StreamFusion + +``` diff --git a/test/build/AllTests.hs b/test/build/AllTests.hs new file mode 100644 index 00000000..6ecd2d84 --- /dev/null +++ b/test/build/AllTests.hs @@ -0,0 +1,87 @@ +module AllTests where + +import Issue14 +import Issue65 +import Issue69 +import Issue73 +import Fixities +import LanguageConstructs +import Numbers +import Pragmas +import Sections +import Test +import Tree +import Tuples +import Where +import TypeSynonyms +import CanonicalInstance +import Coinduction +import ConstrainedInstance +import Datatypes +import Records +import Default +import DefaultMethods +import Vector +import Issue90 +import Issue93 +import QualifiedModule +import Superclass +import UnboxPragma +import ScopedTypeVariables +import LiteralPatterns +import Issue92 +import HeightMirror +import TransparentFun +import Issue115 +import BangPatterns +import Issue94 +import DoNotation +import NewTypePragma +import Importer +import QualifiedImports +import CommonQualifiedImports +import RequalifiedImports +import QualifiedPrelude +import AutoLambdaCaseInCase +import AutoLambdaCaseInBind +import WitnessedFlows +import Kinds +import LawfulOrd +import Deriving +import ErasedLocalDefinitions +import TypeOperators +import ErasedTypeArguments +import TypeOperatorExport +import TypeOperatorImport +import IOFile +import IOInput +import Issue200 +import Issue169 +import Issue210 +import TypeSignature +import ModuleParameters +import ModuleParametersImports +import Coerce +import Inlining +import EraseType +import Delay +import Issue273 +import TypeDirected +import ProjLike +import Issue286 +import NonClassInstance +import Issue218 +import Issue251 +import TypeBasedUnboxing +import Issue145 +import Issue264 +import Issue301 +import Issue305 +import Issue302 +import Issue309 +import Issue317 +import ErasedPatternLambda +import CustomTuples +import ProjectionLike +import FunCon + diff --git a/test/build/AllTests.html b/test/build/AllTests.html new file mode 100644 index 00000000..87197d34 --- /dev/null +++ b/test/build/AllTests.html @@ -0,0 +1,166 @@ + + + + + + + AllTests + + + +
module AllTests where
+
+import Issue14
+import Issue65
+import Issue69
+import Issue73
+import Fixities
+import LanguageConstructs
+import Numbers
+import Pragmas
+import Sections
+import Test
+import Tree
+import Tuples
+import Where
+import TypeSynonyms
+import CanonicalInstance
+import Coinduction
+import ConstrainedInstance
+import Datatypes
+import Records
+import Default
+import DefaultMethods
+import Vector
+import Issue90
+import Issue93
+import QualifiedModule
+import Superclass
+import UnboxPragma
+import ScopedTypeVariables
+import LiteralPatterns
+import Issue92
+import HeightMirror
+import TransparentFun
+import Issue115
+import BangPatterns
+import Issue94
+import DoNotation
+import NewTypePragma
+import Importer
+import QualifiedImports
+import CommonQualifiedImports
+import RequalifiedImports
+import QualifiedPrelude
+import AutoLambdaCaseInCase
+import AutoLambdaCaseInBind
+import WitnessedFlows
+import Kinds
+import LawfulOrd
+import Deriving
+import ErasedLocalDefinitions
+import TypeOperators
+import ErasedTypeArguments
+import TypeOperatorExport
+import TypeOperatorImport
+import IOFile
+import IOInput
+import Issue200
+import Issue169
+import Issue210
+import TypeSignature
+import ModuleParameters
+import ModuleParametersImports
+import Coerce
+import Inlining
+import EraseType
+import Delay
+import Issue273
+import TypeDirected
+import ProjLike
+import Issue286
+import NonClassInstance
+import Issue218
+import Issue251
+import TypeBasedUnboxing
+import Issue145
+import Issue264
+import Issue301
+import Issue305
+import Issue302
+import Issue309
+import Issue317
+import ErasedPatternLambda
+import CustomTuples
+import ProjectionLike
+import FunCon
+ + diff --git a/test/build/AllTests.md b/test/build/AllTests.md new file mode 100644 index 00000000..1d7e275b --- /dev/null +++ b/test/build/AllTests.md @@ -0,0 +1,89 @@ +```haskell +module AllTests where + +import Issue14 +import Issue65 +import Issue69 +import Issue73 +import Fixities +import LanguageConstructs +import Numbers +import Pragmas +import Sections +import Test +import Tree +import Tuples +import Where +import TypeSynonyms +import CanonicalInstance +import Coinduction +import ConstrainedInstance +import Datatypes +import Records +import Default +import DefaultMethods +import Vector +import Issue90 +import Issue93 +import QualifiedModule +import Superclass +import UnboxPragma +import ScopedTypeVariables +import LiteralPatterns +import Issue92 +import HeightMirror +import TransparentFun +import Issue115 +import BangPatterns +import Issue94 +import DoNotation +import NewTypePragma +import Importer +import QualifiedImports +import CommonQualifiedImports +import RequalifiedImports +import QualifiedPrelude +import AutoLambdaCaseInCase +import AutoLambdaCaseInBind +import WitnessedFlows +import Kinds +import LawfulOrd +import Deriving +import ErasedLocalDefinitions +import TypeOperators +import ErasedTypeArguments +import TypeOperatorExport +import TypeOperatorImport +import IOFile +import IOInput +import Issue200 +import Issue169 +import Issue210 +import TypeSignature +import ModuleParameters +import ModuleParametersImports +import Coerce +import Inlining +import EraseType +import Delay +import Issue273 +import TypeDirected +import ProjLike +import Issue286 +import NonClassInstance +import Issue218 +import Issue251 +import TypeBasedUnboxing +import Issue145 +import Issue264 +import Issue301 +import Issue305 +import Issue302 +import Issue309 +import Issue317 +import ErasedPatternLambda +import CustomTuples +import ProjectionLike +import FunCon + +``` diff --git a/test/build/AutoLambdaCaseInBind.hs b/test/build/AutoLambdaCaseInBind.hs new file mode 100644 index 00000000..9304c5fb --- /dev/null +++ b/test/build/AutoLambdaCaseInBind.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE LambdaCase #-} +module AutoLambdaCaseInBind where + +lcaseInsideBind :: Maybe (Maybe a) -> Maybe a +lcaseInsideBind mx + = do x <- mx + (\case + Nothing -> Nothing + Just _ -> Nothing) + x + diff --git a/test/build/AutoLambdaCaseInBind.html b/test/build/AutoLambdaCaseInBind.html new file mode 100644 index 00000000..b3afe91a --- /dev/null +++ b/test/build/AutoLambdaCaseInBind.html @@ -0,0 +1,90 @@ + + + + + + + AutoLambdaCaseInBind + + + +
{-# LANGUAGE LambdaCase #-}
+module AutoLambdaCaseInBind where
+
+lcaseInsideBind :: Maybe (Maybe a) -> Maybe a
+lcaseInsideBind mx
+  = do x <- mx
+       (\case
+            Nothing -> Nothing
+            Just _ -> Nothing)
+         x
+ + diff --git a/test/build/AutoLambdaCaseInBind.md b/test/build/AutoLambdaCaseInBind.md new file mode 100644 index 00000000..70330de6 --- /dev/null +++ b/test/build/AutoLambdaCaseInBind.md @@ -0,0 +1,13 @@ +```haskell +{-# LANGUAGE LambdaCase #-} +module AutoLambdaCaseInBind where + +lcaseInsideBind :: Maybe (Maybe a) -> Maybe a +lcaseInsideBind mx + = do x <- mx + (\case + Nothing -> Nothing + Just _ -> Nothing) + x + +``` diff --git a/test/build/AutoLambdaCaseInCase.hs b/test/build/AutoLambdaCaseInCase.hs new file mode 100644 index 00000000..061ef72a --- /dev/null +++ b/test/build/AutoLambdaCaseInCase.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE LambdaCase #-} +module AutoLambdaCaseInCase where + +lcaseInsideCaseOf :: [a] -> Maybe a -> Maybe a +lcaseInsideCaseOf xs + = case xs of + [] -> \case + Nothing -> Nothing + Just _ -> Nothing + x : _ -> \case + Nothing -> Nothing + Just _ -> Just x + diff --git a/test/build/AutoLambdaCaseInCase.html b/test/build/AutoLambdaCaseInCase.html new file mode 100644 index 00000000..9c702ba1 --- /dev/null +++ b/test/build/AutoLambdaCaseInCase.html @@ -0,0 +1,92 @@ + + + + + + + AutoLambdaCaseInCase + + + +
{-# LANGUAGE LambdaCase #-}
+module AutoLambdaCaseInCase where
+
+lcaseInsideCaseOf :: [a] -> Maybe a -> Maybe a
+lcaseInsideCaseOf xs
+  = case xs of
+        [] -> \case
+                  Nothing -> Nothing
+                  Just _ -> Nothing
+        x : _ -> \case
+                     Nothing -> Nothing
+                     Just _ -> Just x
+ + diff --git a/test/build/AutoLambdaCaseInCase.md b/test/build/AutoLambdaCaseInCase.md new file mode 100644 index 00000000..078e1ae9 --- /dev/null +++ b/test/build/AutoLambdaCaseInCase.md @@ -0,0 +1,15 @@ +```haskell +{-# LANGUAGE LambdaCase #-} +module AutoLambdaCaseInCase where + +lcaseInsideCaseOf :: [a] -> Maybe a -> Maybe a +lcaseInsideCaseOf xs + = case xs of + [] -> \case + Nothing -> Nothing + Just _ -> Nothing + x : _ -> \case + Nothing -> Nothing + Just _ -> Just x + +``` diff --git a/test/build/BangPatterns.hs b/test/build/BangPatterns.hs new file mode 100644 index 00000000..966d0add --- /dev/null +++ b/test/build/BangPatterns.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE BangPatterns #-} +module BangPatterns where + +strictId :: a -> a +strictId !x = x + +myFoldl :: (b -> a -> b) -> b -> [a] -> b +myFoldl f x0 [] = x0 +myFoldl f x0 (x : xs) = myFoldl f (f x0 x) xs + +foldl' :: (b -> a -> b) -> b -> [a] -> b +foldl' f !x0 [] = x0 +foldl' f !x0 (x : xs) = foldl' f (f x0 x) xs + +data LazyMaybe a = LazyNothing + | LazyJust a + +data StrictMaybe a = StrictNothing + | StrictJust !a + diff --git a/test/build/BangPatterns.html b/test/build/BangPatterns.html new file mode 100644 index 00000000..c61dd89b --- /dev/null +++ b/test/build/BangPatterns.html @@ -0,0 +1,99 @@ + + + + + + + BangPatterns + + + +
{-# LANGUAGE BangPatterns #-}
+module BangPatterns where
+
+strictId :: a -> a
+strictId !x = x
+
+myFoldl :: (b -> a -> b) -> b -> [a] -> b
+myFoldl f x0 [] = x0
+myFoldl f x0 (x : xs) = myFoldl f (f x0 x) xs
+
+foldl' :: (b -> a -> b) -> b -> [a] -> b
+foldl' f !x0 [] = x0
+foldl' f !x0 (x : xs) = foldl' f (f x0 x) xs
+
+data LazyMaybe a = LazyNothing
+                 | LazyJust a
+
+data StrictMaybe a = StrictNothing
+                   | StrictJust !a
+ + diff --git a/test/build/BangPatterns.md b/test/build/BangPatterns.md new file mode 100644 index 00000000..4fa13658 --- /dev/null +++ b/test/build/BangPatterns.md @@ -0,0 +1,22 @@ +```haskell +{-# LANGUAGE BangPatterns #-} +module BangPatterns where + +strictId :: a -> a +strictId !x = x + +myFoldl :: (b -> a -> b) -> b -> [a] -> b +myFoldl f x0 [] = x0 +myFoldl f x0 (x : xs) = myFoldl f (f x0 x) xs + +foldl' :: (b -> a -> b) -> b -> [a] -> b +foldl' f !x0 [] = x0 +foldl' f !x0 (x : xs) = foldl' f (f x0 x) xs + +data LazyMaybe a = LazyNothing + | LazyJust a + +data StrictMaybe a = StrictNothing + | StrictJust !a + +``` diff --git a/test/build/CanonicalInstance.hs b/test/build/CanonicalInstance.hs new file mode 100644 index 00000000..77b5a126 --- /dev/null +++ b/test/build/CanonicalInstance.hs @@ -0,0 +1,10 @@ +module CanonicalInstance where + +class ClassA a where + myA :: a + +class ClassA b => ClassB b where + +myB :: ClassB b => b +myB = myA + diff --git a/test/build/CanonicalInstance.html b/test/build/CanonicalInstance.html new file mode 100644 index 00000000..fca8e624 --- /dev/null +++ b/test/build/CanonicalInstance.html @@ -0,0 +1,89 @@ + + + + + + + CanonicalInstance + + + +
module CanonicalInstance where
+
+class ClassA a where
+    myA :: a
+
+class ClassA b => ClassB b where
+
+myB :: ClassB b => b
+myB = myA
+ + diff --git a/test/build/CanonicalInstance.md b/test/build/CanonicalInstance.md new file mode 100644 index 00000000..3ba57e6d --- /dev/null +++ b/test/build/CanonicalInstance.md @@ -0,0 +1,12 @@ +```haskell +module CanonicalInstance where + +class ClassA a where + myA :: a + +class ClassA b => ClassB b where + +myB :: ClassB b => b +myB = myA + +``` diff --git a/test/build/ClashingImport.err b/test/build/ClashingImport.err new file mode 100644 index 00000000..27147351 --- /dev/null +++ b/test/build/ClashingImport.err @@ -0,0 +1 @@ +Clashing import: MkFoo (both from Foo and OtherFoo) diff --git a/test/build/ClashingImport.html b/test/build/ClashingImport.html new file mode 100644 index 00000000..5bed87e5 --- /dev/null +++ b/test/build/ClashingImport.html @@ -0,0 +1,20 @@ + + + + + + + ClashingImport + + + +
Clashing import: MkFoo (both from Foo and OtherFoo)
+ + diff --git a/test/build/ClashingImport.md b/test/build/ClashingImport.md new file mode 100644 index 00000000..2c903662 --- /dev/null +++ b/test/build/ClashingImport.md @@ -0,0 +1,3 @@ +``` +Clashing import: MkFoo (both from Foo and OtherFoo) +``` diff --git a/test/build/Coerce.hs b/test/build/Coerce.hs new file mode 100644 index 00000000..c298c0da --- /dev/null +++ b/test/build/Coerce.hs @@ -0,0 +1,13 @@ +module Coerce where + +import Numeric.Natural (Natural) +import Unsafe.Coerce (unsafeCoerce) + +newtype A = MkA Natural + +newtype B = MkB Natural + deriving (Show) + +coerceExample :: B +coerceExample = unsafeCoerce (MkA 5) + diff --git a/test/build/Coerce.html b/test/build/Coerce.html new file mode 100644 index 00000000..979fa276 --- /dev/null +++ b/test/build/Coerce.html @@ -0,0 +1,92 @@ + + + + + + + Coerce + + + +
module Coerce where
+
+import Numeric.Natural (Natural)
+import Unsafe.Coerce (unsafeCoerce)
+
+newtype A = MkA Natural
+
+newtype B = MkB Natural
+              deriving (Show)
+
+coerceExample :: B
+coerceExample = unsafeCoerce (MkA 5)
+ + diff --git a/test/build/Coerce.md b/test/build/Coerce.md new file mode 100644 index 00000000..bb24f62a --- /dev/null +++ b/test/build/Coerce.md @@ -0,0 +1,15 @@ +```haskell +module Coerce where + +import Numeric.Natural (Natural) +import Unsafe.Coerce (unsafeCoerce) + +newtype A = MkA Natural + +newtype B = MkB Natural + deriving (Show) + +coerceExample :: B +coerceExample = unsafeCoerce (MkA 5) + +``` diff --git a/test/build/Coinduction.hs b/test/build/Coinduction.hs new file mode 100644 index 00000000..1b4bb577 --- /dev/null +++ b/test/build/Coinduction.hs @@ -0,0 +1,8 @@ +module Coinduction where + +data Colist a = Nil + | Cons a (Colist a) + +repeater :: a -> Colist a +repeater x = Cons x (repeater x) + diff --git a/test/build/Coinduction.html b/test/build/Coinduction.html new file mode 100644 index 00000000..1086d5b1 --- /dev/null +++ b/test/build/Coinduction.html @@ -0,0 +1,87 @@ + + + + + + + Coinduction + + + +
module Coinduction where
+
+data Colist a = Nil
+              | Cons a (Colist a)
+
+repeater :: a -> Colist a
+repeater x = Cons x (repeater x)
+ + diff --git a/test/build/Coinduction.md b/test/build/Coinduction.md new file mode 100644 index 00000000..715a20c4 --- /dev/null +++ b/test/build/Coinduction.md @@ -0,0 +1,10 @@ +```haskell +module Coinduction where + +data Colist a = Nil + | Cons a (Colist a) + +repeater :: a -> Colist a +repeater x = Cons x (repeater x) + +``` diff --git a/test/build/CommonQualifiedImports.hs b/test/build/CommonQualifiedImports.hs new file mode 100644 index 00000000..f8d8715b --- /dev/null +++ b/test/build/CommonQualifiedImports.hs @@ -0,0 +1,11 @@ +module CommonQualifiedImports where + +import qualified Importee as Common (foo) +import qualified Prelude as Common (Int, (+)) +import qualified SecondImportee as Common (anotherFoo) + +-- ** common qualification + +foos :: Common.Int +foos = (Common.+) Common.foo Common.anotherFoo + diff --git a/test/build/CommonQualifiedImports.html b/test/build/CommonQualifiedImports.html new file mode 100644 index 00000000..a43cdb90 --- /dev/null +++ b/test/build/CommonQualifiedImports.html @@ -0,0 +1,90 @@ + + + + + + + CommonQualifiedImports + + + +
module CommonQualifiedImports where
+
+import qualified Importee as Common (foo)
+import qualified Prelude as Common (Int, (+))
+import qualified SecondImportee as Common (anotherFoo)
+
+-- ** common qualification
+
+foos :: Common.Int
+foos = (Common.+) Common.foo Common.anotherFoo
+ + diff --git a/test/build/CommonQualifiedImports.md b/test/build/CommonQualifiedImports.md new file mode 100644 index 00000000..dc2c234e --- /dev/null +++ b/test/build/CommonQualifiedImports.md @@ -0,0 +1,13 @@ +```haskell +module CommonQualifiedImports where + +import qualified Importee as Common (foo) +import qualified Prelude as Common (Int, (+)) +import qualified SecondImportee as Common (anotherFoo) + +-- ** common qualification + +foos :: Common.Int +foos = (Common.+) Common.foo Common.anotherFoo + +``` diff --git a/test/build/ConstrainedInstance.hs b/test/build/ConstrainedInstance.hs new file mode 100644 index 00000000..84fc10d1 --- /dev/null +++ b/test/build/ConstrainedInstance.hs @@ -0,0 +1,7 @@ +module ConstrainedInstance where + +data D a = C a + +instance (Eq a) => Eq (D a) where + C x == C y = x == y + diff --git a/test/build/ConstrainedInstance.html b/test/build/ConstrainedInstance.html new file mode 100644 index 00000000..8e80c0ad --- /dev/null +++ b/test/build/ConstrainedInstance.html @@ -0,0 +1,86 @@ + + + + + + + ConstrainedInstance + + + +
module ConstrainedInstance where
+
+data D a = C a
+
+instance (Eq a) => Eq (D a) where
+    C x == C y = x == y
+ + diff --git a/test/build/ConstrainedInstance.md b/test/build/ConstrainedInstance.md new file mode 100644 index 00000000..429604b2 --- /dev/null +++ b/test/build/ConstrainedInstance.md @@ -0,0 +1,9 @@ +```haskell +module ConstrainedInstance where + +data D a = C a + +instance (Eq a) => Eq (D a) where + C x == C y = x == y + +``` diff --git a/test/build/Copatterns.err b/test/build/Copatterns.err new file mode 100644 index 00000000..87cdc125 --- /dev/null +++ b/test/build/Copatterns.err @@ -0,0 +1,2 @@ +test/Fail/Copatterns.agda:14,1-5 +not supported in Haskell: copatterns diff --git a/test/build/Copatterns.html b/test/build/Copatterns.html new file mode 100644 index 00000000..f0228b97 --- /dev/null +++ b/test/build/Copatterns.html @@ -0,0 +1,21 @@ + + + + + + + Copatterns + + + +
test/Fail/Copatterns.agda:14,1-5
+not supported in Haskell: copatterns
+ + diff --git a/test/build/Copatterns.md b/test/build/Copatterns.md new file mode 100644 index 00000000..8710c316 --- /dev/null +++ b/test/build/Copatterns.md @@ -0,0 +1,4 @@ +``` +test/Fail/Copatterns.agda:14,1-5 +not supported in Haskell: copatterns +``` diff --git a/test/build/Cubical/StreamFusion.hs b/test/build/Cubical/StreamFusion.hs new file mode 100644 index 00000000..20b64030 --- /dev/null +++ b/test/build/Cubical/StreamFusion.hs @@ -0,0 +1,7 @@ +module Cubical.StreamFusion where + +data Stream a = (:>){shead :: a, stail :: Stream a} + +smap :: (a -> b) -> Stream a -> Stream b +smap f (x :> xs) = f x :> smap f xs + diff --git a/test/build/Cubical/StreamFusion.html b/test/build/Cubical/StreamFusion.html new file mode 100644 index 00000000..411bd599 --- /dev/null +++ b/test/build/Cubical/StreamFusion.html @@ -0,0 +1,86 @@ + + + + + + + StreamFusion + + + +
module Cubical.StreamFusion where
+
+data Stream a = (:>){shead :: a, stail :: Stream a}
+
+smap :: (a -> b) -> Stream a -> Stream b
+smap f (x :> xs) = f x :> smap f xs
+ + diff --git a/test/build/Cubical/StreamFusion.md b/test/build/Cubical/StreamFusion.md new file mode 100644 index 00000000..3001cb91 --- /dev/null +++ b/test/build/Cubical/StreamFusion.md @@ -0,0 +1,9 @@ +```haskell +module Cubical.StreamFusion where + +data Stream a = (:>){shead :: a, stail :: Stream a} + +smap :: (a -> b) -> Stream a -> Stream b +smap f (x :> xs) = f x :> smap f xs + +``` diff --git a/test/build/CustomTuples.hs b/test/build/CustomTuples.hs new file mode 100644 index 00000000..e311440e --- /dev/null +++ b/test/build/CustomTuples.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE UnboxedTuples, TupleSections #-} +module CustomTuples where + +test :: (Int, Int) -> Int +test xy = fst xy + snd xy + +foo :: + (# Int, Int, Bool #) -> + (# Int, Bool, Bool #) -> (# Int, Char, Bool #) +foo (# a, b, c #) (# x, y, z #) + = (# a + b + x, 'x', or [c, y, z] #) + +bare :: Int -> Char -> Bool -> (# Int, Char, Bool #) +bare = (# ,, #) + +section :: a -> Bool -> (# Int, a, Bool #) +section = (# 42, , #) + +bar :: () -> () +bar () = () + +baz :: (Int) -> (Int) +baz (x) = (42) + diff --git a/test/build/CustomTuples.html b/test/build/CustomTuples.html new file mode 100644 index 00000000..8ee7fc50 --- /dev/null +++ b/test/build/CustomTuples.html @@ -0,0 +1,103 @@ + + + + + + + CustomTuples + + + +
{-# LANGUAGE UnboxedTuples, TupleSections #-}
+module CustomTuples where
+
+test :: (Int, Int) -> Int
+test xy = fst xy + snd xy
+
+foo ::
+    (# Int, Int, Bool #) ->
+      (# Int, Bool, Bool #) -> (# Int, Char, Bool #)
+foo (# a, b, c #) (# x, y, z #)
+  = (# a + b + x, 'x', or [c, y, z] #)
+
+bare :: Int -> Char -> Bool -> (# Int, Char, Bool #)
+bare = (# ,, #)
+
+section :: a -> Bool -> (# Int, a, Bool #)
+section = (# 42, , #)
+
+bar :: () -> ()
+bar () = ()
+
+baz :: (Int) -> (Int)
+baz (x) = (42)
+ + diff --git a/test/build/CustomTuples.md b/test/build/CustomTuples.md new file mode 100644 index 00000000..febd899e --- /dev/null +++ b/test/build/CustomTuples.md @@ -0,0 +1,26 @@ +```haskell +{-# LANGUAGE UnboxedTuples, TupleSections #-} +module CustomTuples where + +test :: (Int, Int) -> Int +test xy = fst xy + snd xy + +foo :: + (# Int, Int, Bool #) -> + (# Int, Bool, Bool #) -> (# Int, Char, Bool #) +foo (# a, b, c #) (# x, y, z #) + = (# a + b + x, 'x', or [c, y, z] #) + +bare :: Int -> Char -> Bool -> (# Int, Char, Bool #) +bare = (# ,, #) + +section :: a -> Bool -> (# Int, a, Bool #) +section = (# 42, , #) + +bar :: () -> () +bar () = () + +baz :: (Int) -> (Int) +baz (x) = (42) + +``` diff --git a/test/build/Datatypes.hs b/test/build/Datatypes.hs new file mode 100644 index 00000000..67e50a0c --- /dev/null +++ b/test/build/Datatypes.hs @@ -0,0 +1,10 @@ +module Datatypes where + +data Test = CTest Bool + +getTest :: Test -> Bool +getTest (CTest b) = b + +putTest :: Bool -> Test -> Test +putTest b (CTest _) = CTest b + diff --git a/test/build/Datatypes.html b/test/build/Datatypes.html new file mode 100644 index 00000000..8063c0fe --- /dev/null +++ b/test/build/Datatypes.html @@ -0,0 +1,89 @@ + + + + + + + Datatypes + + + +
module Datatypes where
+
+data Test = CTest Bool
+
+getTest :: Test -> Bool
+getTest (CTest b) = b
+
+putTest :: Bool -> Test -> Test
+putTest b (CTest _) = CTest b
+ + diff --git a/test/build/Datatypes.md b/test/build/Datatypes.md new file mode 100644 index 00000000..e3c5f6cd --- /dev/null +++ b/test/build/Datatypes.md @@ -0,0 +1,12 @@ +```haskell +module Datatypes where + +data Test = CTest Bool + +getTest :: Test -> Bool +getTest (CTest b) = b + +putTest :: Bool -> Test -> Test +putTest b (CTest _) = CTest b + +``` diff --git a/test/build/Default.hs b/test/build/Default.hs new file mode 100644 index 00000000..a93a13b4 --- /dev/null +++ b/test/build/Default.hs @@ -0,0 +1,11 @@ +module Default where + +class HasDefault a where + theDefault :: a + +instance HasDefault Bool where + theDefault = False + +test :: Bool +test = theDefault + diff --git a/test/build/Default.html b/test/build/Default.html new file mode 100644 index 00000000..09494643 --- /dev/null +++ b/test/build/Default.html @@ -0,0 +1,90 @@ + + + + + + + Default + + + +
module Default where
+
+class HasDefault a where
+    theDefault :: a
+
+instance HasDefault Bool where
+    theDefault = False
+
+test :: Bool
+test = theDefault
+ + diff --git a/test/build/Default.md b/test/build/Default.md new file mode 100644 index 00000000..d540d647 --- /dev/null +++ b/test/build/Default.md @@ -0,0 +1,13 @@ +```haskell +module Default where + +class HasDefault a where + theDefault :: a + +instance HasDefault Bool where + theDefault = False + +test :: Bool +test = theDefault + +``` diff --git a/test/build/DefaultMethods.hs b/test/build/DefaultMethods.hs new file mode 100644 index 00000000..99b39f84 --- /dev/null +++ b/test/build/DefaultMethods.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE TypeSynonymInstances #-} + +module DefaultMethods where + + +import Prelude hiding (Show, show, showsPrec, showList, Ord, (<), (>)) + +class Ord a where + (<) :: a -> a -> Bool + (>) :: a -> a -> Bool + {-# MINIMAL (<) | (>) #-} + (<) = flip (>) + x > y = y < x + +instance Ord Bool where + False < b = b + True < _ = False + +data Bool1 = Mk1 Bool + +instance Ord Bool1 where + Mk1 False < Mk1 b = b + Mk1 True < _ = False + +data Bool2 = Mk2 Bool + +instance Ord Bool2 where + (<) = (<:) + where + (<:) :: Bool2 -> Bool2 -> Bool + Mk2 False <: Mk2 b = b + Mk2 True <: _ = False + (>) = flip (<:) + where + (<:) :: Bool2 -> Bool2 -> Bool + Mk2 False <: Mk2 b = b + Mk2 True <: _ = False + +data Bool3 = Mk3 Bool + +instance Ord Bool3 where + (<) = (<:) + where + (<:) :: Bool3 -> Bool3 -> Bool + Mk3 False <: Mk3 b = b + Mk3 True <: _ = False + +data Bool4 = Mk4 Bool + +lift4 :: (Bool -> Bool -> a) -> Bool4 -> Bool4 -> a +lift4 f (Mk4 x) (Mk4 y) = f x y + +instance Ord Bool4 where + (<) = lift4 (\ x -> (not x &&)) + +data Bool5 = Mk5 Bool + +instance Ord Bool5 where + (>) = (>:) + where + (>:) :: Bool5 -> Bool5 -> Bool + Mk5 False >: _ = False + Mk5 True >: Mk5 b = not b + +data Bool6 = Mk6 Bool + +instance Ord Bool6 where + (<) = flip (>:) + where + (>:) :: Bool6 -> Bool6 -> Bool + Mk6 False >: _ = False + Mk6 True >: Mk6 b = not b + (>) = (>:) + where + (>:) :: Bool6 -> Bool6 -> Bool + Mk6 False >: _ = False + Mk6 True >: Mk6 b = not b + +defaultShowList :: (a -> ShowS) -> [a] -> ShowS +defaultShowList _ [] = showString "[]" +defaultShowList shows (x : xs) + = showString "[" . + foldl (\ s x -> s . showString "," . shows x) (shows x) xs . + showString "]" + +class Show a where + show :: a -> String + showsPrec :: Int -> a -> ShowS + showList :: [a] -> ShowS + {-# MINIMAL showsPrec | show #-} + show x = showsPrec 0 x "" + showList = defaultShowList (showsPrec 0) + showsPrec _ x s = show x ++ s + +instance Show Bool where + show True = "True" + show False = "False" + showList [] = showString "" + showList (True : bs) = showString "1" . showList bs + showList (False : bs) = showString "0" . showList bs + +instance (Show a) => Show (Maybe a) where + showsPrec n Nothing = showString "nothing" + showsPrec n (Just x) + = showParen True (showString "just " . showsPrec 10 x) + +instance (Show a) => Show ([a]) where + showsPrec _ = showList + diff --git a/test/build/DefaultMethods.html b/test/build/DefaultMethods.html new file mode 100644 index 00000000..e57182a3 --- /dev/null +++ b/test/build/DefaultMethods.html @@ -0,0 +1,188 @@ + + + + + + + DefaultMethods + + + +
{-# LANGUAGE TypeSynonymInstances #-}
+
+module DefaultMethods where
+
+
+import Prelude hiding (Show, show, showsPrec, showList, Ord, (<), (>))
+
+class Ord a where
+    (<) :: a -> a -> Bool
+    (>) :: a -> a -> Bool
+    {-# MINIMAL (<) | (>) #-}
+    (<) = flip (>)
+    x > y = y < x
+
+instance Ord Bool where
+    False < b = b
+    True < _ = False
+
+data Bool1 = Mk1 Bool
+
+instance Ord Bool1 where
+    Mk1 False < Mk1 b = b
+    Mk1 True < _ = False
+
+data Bool2 = Mk2 Bool
+
+instance Ord Bool2 where
+    (<) = (<:)
+      where
+        (<:) :: Bool2 -> Bool2 -> Bool
+        Mk2 False <: Mk2 b = b
+        Mk2 True <: _ = False
+    (>) = flip (<:)
+      where
+        (<:) :: Bool2 -> Bool2 -> Bool
+        Mk2 False <: Mk2 b = b
+        Mk2 True <: _ = False
+
+data Bool3 = Mk3 Bool
+
+instance Ord Bool3 where
+    (<) = (<:)
+      where
+        (<:) :: Bool3 -> Bool3 -> Bool
+        Mk3 False <: Mk3 b = b
+        Mk3 True <: _ = False
+
+data Bool4 = Mk4 Bool
+
+lift4 :: (Bool -> Bool -> a) -> Bool4 -> Bool4 -> a
+lift4 f (Mk4 x) (Mk4 y) = f x y
+
+instance Ord Bool4 where
+    (<) = lift4 (\ x -> (not x &&))
+
+data Bool5 = Mk5 Bool
+
+instance Ord Bool5 where
+    (>) = (>:)
+      where
+        (>:) :: Bool5 -> Bool5 -> Bool
+        Mk5 False >: _ = False
+        Mk5 True >: Mk5 b = not b
+
+data Bool6 = Mk6 Bool
+
+instance Ord Bool6 where
+    (<) = flip (>:)
+      where
+        (>:) :: Bool6 -> Bool6 -> Bool
+        Mk6 False >: _ = False
+        Mk6 True >: Mk6 b = not b
+    (>) = (>:)
+      where
+        (>:) :: Bool6 -> Bool6 -> Bool
+        Mk6 False >: _ = False
+        Mk6 True >: Mk6 b = not b
+
+defaultShowList :: (a -> ShowS) -> [a] -> ShowS
+defaultShowList _ [] = showString "[]"
+defaultShowList shows (x : xs)
+  = showString "[" .
+      foldl (\ s x -> s . showString "," . shows x) (shows x) xs .
+        showString "]"
+
+class Show a where
+    show :: a -> String
+    showsPrec :: Int -> a -> ShowS
+    showList :: [a] -> ShowS
+    {-# MINIMAL showsPrec | show #-}
+    show x = showsPrec 0 x ""
+    showList = defaultShowList (showsPrec 0)
+    showsPrec _ x s = show x ++ s
+
+instance Show Bool where
+    show True = "True"
+    show False = "False"
+    showList [] = showString ""
+    showList (True : bs) = showString "1" . showList bs
+    showList (False : bs) = showString "0" . showList bs
+
+instance (Show a) => Show (Maybe a) where
+    showsPrec n Nothing = showString "nothing"
+    showsPrec n (Just x)
+      = showParen True (showString "just " . showsPrec 10 x)
+
+instance (Show a) => Show ([a]) where
+    showsPrec _ = showList
+ + diff --git a/test/build/DefaultMethods.md b/test/build/DefaultMethods.md new file mode 100644 index 00000000..4a7fdd23 --- /dev/null +++ b/test/build/DefaultMethods.md @@ -0,0 +1,111 @@ +```haskell +{-# LANGUAGE TypeSynonymInstances #-} + +module DefaultMethods where + + +import Prelude hiding (Show, show, showsPrec, showList, Ord, (<), (>)) + +class Ord a where + (<) :: a -> a -> Bool + (>) :: a -> a -> Bool + {-# MINIMAL (<) | (>) #-} + (<) = flip (>) + x > y = y < x + +instance Ord Bool where + False < b = b + True < _ = False + +data Bool1 = Mk1 Bool + +instance Ord Bool1 where + Mk1 False < Mk1 b = b + Mk1 True < _ = False + +data Bool2 = Mk2 Bool + +instance Ord Bool2 where + (<) = (<:) + where + (<:) :: Bool2 -> Bool2 -> Bool + Mk2 False <: Mk2 b = b + Mk2 True <: _ = False + (>) = flip (<:) + where + (<:) :: Bool2 -> Bool2 -> Bool + Mk2 False <: Mk2 b = b + Mk2 True <: _ = False + +data Bool3 = Mk3 Bool + +instance Ord Bool3 where + (<) = (<:) + where + (<:) :: Bool3 -> Bool3 -> Bool + Mk3 False <: Mk3 b = b + Mk3 True <: _ = False + +data Bool4 = Mk4 Bool + +lift4 :: (Bool -> Bool -> a) -> Bool4 -> Bool4 -> a +lift4 f (Mk4 x) (Mk4 y) = f x y + +instance Ord Bool4 where + (<) = lift4 (\ x -> (not x &&)) + +data Bool5 = Mk5 Bool + +instance Ord Bool5 where + (>) = (>:) + where + (>:) :: Bool5 -> Bool5 -> Bool + Mk5 False >: _ = False + Mk5 True >: Mk5 b = not b + +data Bool6 = Mk6 Bool + +instance Ord Bool6 where + (<) = flip (>:) + where + (>:) :: Bool6 -> Bool6 -> Bool + Mk6 False >: _ = False + Mk6 True >: Mk6 b = not b + (>) = (>:) + where + (>:) :: Bool6 -> Bool6 -> Bool + Mk6 False >: _ = False + Mk6 True >: Mk6 b = not b + +defaultShowList :: (a -> ShowS) -> [a] -> ShowS +defaultShowList _ [] = showString "[]" +defaultShowList shows (x : xs) + = showString "[" . + foldl (\ s x -> s . showString "," . shows x) (shows x) xs . + showString "]" + +class Show a where + show :: a -> String + showsPrec :: Int -> a -> ShowS + showList :: [a] -> ShowS + {-# MINIMAL showsPrec | show #-} + show x = showsPrec 0 x "" + showList = defaultShowList (showsPrec 0) + showsPrec _ x s = show x ++ s + +instance Show Bool where + show True = "True" + show False = "False" + showList [] = showString "" + showList (True : bs) = showString "1" . showList bs + showList (False : bs) = showString "0" . showList bs + +instance (Show a) => Show (Maybe a) where + showsPrec n Nothing = showString "nothing" + showsPrec n (Just x) + = showParen True (showString "just " . showsPrec 10 x) + +instance (Show a) => Show ([a]) where + showsPrec _ = showList + +``` diff --git a/test/build/Delay.hs b/test/build/Delay.hs new file mode 100644 index 00000000..6eeaad90 --- /dev/null +++ b/test/build/Delay.hs @@ -0,0 +1,7 @@ +module Delay where + +collatz :: Int -> Int +collatz x + = if x == 0 then 0 else + if even x then collatz (div x 2) else collatz (3 * x + 1) + diff --git a/test/build/Delay.html b/test/build/Delay.html new file mode 100644 index 00000000..6c1c7eda --- /dev/null +++ b/test/build/Delay.html @@ -0,0 +1,86 @@ + + + + + + + Delay + + + +
module Delay where
+
+collatz :: Int -> Int
+collatz x
+  = if x == 0 then 0 else
+      if even x then collatz (div x 2) else collatz (3 * x + 1)
+ + diff --git a/test/build/Delay.md b/test/build/Delay.md new file mode 100644 index 00000000..2bdbf089 --- /dev/null +++ b/test/build/Delay.md @@ -0,0 +1,9 @@ +```haskell +module Delay where + +collatz :: Int -> Int +collatz x + = if x == 0 then 0 else + if even x then collatz (div x 2) else collatz (3 * x + 1) + +``` diff --git a/test/build/Deriving.hs b/test/build/Deriving.hs new file mode 100644 index 00000000..b27d1d6a --- /dev/null +++ b/test/build/Deriving.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE StandaloneDeriving, DerivingStrategies, + DeriveAnyClass, GeneralizedNewtypeDeriving #-} +module Deriving where + +data Planet = Mercury + | Venus + | Earth + | Mars + | Jupiter + | Saturn + | Uranus + | Neptune + | Pluto + deriving (Read) + +deriving instance Eq Planet + +deriving instance Ord Planet + +deriving stock instance Show Planet + +class Clazz a where + foo :: a -> Int + bar :: a -> Bool + +deriving anyclass instance Clazz Planet + +data Optional a = Of a + | Empty + +deriving instance (Eq a) => Eq (Optional a) + +newtype Duo a b = MkDuo (a, b) + +deriving newtype instance (Eq a, Eq b) => Eq (Duo a b) + diff --git a/test/build/Deriving.html b/test/build/Deriving.html new file mode 100644 index 00000000..b0dd60e0 --- /dev/null +++ b/test/build/Deriving.html @@ -0,0 +1,115 @@ + + + + + + + Deriving + + + +
{-# LANGUAGE StandaloneDeriving, DerivingStrategies,
+  DeriveAnyClass, GeneralizedNewtypeDeriving #-}
+module Deriving where
+
+data Planet = Mercury
+            | Venus
+            | Earth
+            | Mars
+            | Jupiter
+            | Saturn
+            | Uranus
+            | Neptune
+            | Pluto
+                deriving (Read)
+
+deriving instance Eq Planet
+
+deriving instance Ord Planet
+
+deriving stock instance Show Planet
+
+class Clazz a where
+    foo :: a -> Int
+    bar :: a -> Bool
+
+deriving anyclass instance Clazz Planet
+
+data Optional a = Of a
+                | Empty
+
+deriving instance (Eq a) => Eq (Optional a)
+
+newtype Duo a b = MkDuo (a, b)
+
+deriving newtype instance (Eq a, Eq b) => Eq (Duo a b)
+ + diff --git a/test/build/Deriving.md b/test/build/Deriving.md new file mode 100644 index 00000000..dd76e125 --- /dev/null +++ b/test/build/Deriving.md @@ -0,0 +1,38 @@ +```haskell +{-# LANGUAGE StandaloneDeriving, DerivingStrategies, + DeriveAnyClass, GeneralizedNewtypeDeriving #-} +module Deriving where + +data Planet = Mercury + | Venus + | Earth + | Mars + | Jupiter + | Saturn + | Uranus + | Neptune + | Pluto + deriving (Read) + +deriving instance Eq Planet + +deriving instance Ord Planet + +deriving stock instance Show Planet + +class Clazz a where + foo :: a -> Int + bar :: a -> Bool + +deriving anyclass instance Clazz Planet + +data Optional a = Of a + | Empty + +deriving instance (Eq a) => Eq (Optional a) + +newtype Duo a b = MkDuo (a, b) + +deriving newtype instance (Eq a, Eq b) => Eq (Duo a b) + +``` diff --git a/test/build/DoNotation.hs b/test/build/DoNotation.hs new file mode 100644 index 00000000..b61f4fb8 --- /dev/null +++ b/test/build/DoNotation.hs @@ -0,0 +1,33 @@ +module DoNotation where + +type Birds = Int + +type Pole = (Birds, Birds) + +landLeft :: Birds -> Pole -> Maybe Pole +landLeft n (left, right) + = if abs (left + n - right) < 4 then Just (left + n, right) else + Nothing + +landRight :: Birds -> Pole -> Maybe Pole +landRight n (left, right) + = if abs (left - (right + n)) < 4 then Just (left, right + n) else + Nothing + +routine :: Maybe Pole +routine + = do start <- return (0, 0) + first <- landLeft 2 start + landRight 2 first >>= landLeft 1 + +routineWithoutDo :: Maybe Pole +routineWithoutDo + = return (0, 0) >>= + \ start -> + landLeft 2 start >>= \ first -> landRight 2 first >>= landLeft 1 + +swapPolesMaybe :: Maybe Pole -> Maybe Pole +swapPolesMaybe x + = do (one, two) <- x + pure (two, one) + diff --git a/test/build/DoNotation.html b/test/build/DoNotation.html new file mode 100644 index 00000000..d2dae30f --- /dev/null +++ b/test/build/DoNotation.html @@ -0,0 +1,112 @@ + + + + + + + DoNotation + + + +
module DoNotation where
+
+type Birds = Int
+
+type Pole = (Birds, Birds)
+
+landLeft :: Birds -> Pole -> Maybe Pole
+landLeft n (left, right)
+  = if abs (left + n - right) < 4 then Just (left + n, right) else
+      Nothing
+
+landRight :: Birds -> Pole -> Maybe Pole
+landRight n (left, right)
+  = if abs (left - (right + n)) < 4 then Just (left, right + n) else
+      Nothing
+
+routine :: Maybe Pole
+routine
+  = do start <- return (0, 0)
+       first <- landLeft 2 start
+       landRight 2 first >>= landLeft 1
+
+routineWithoutDo :: Maybe Pole
+routineWithoutDo
+  = return (0, 0) >>=
+      \ start ->
+        landLeft 2 start >>= \ first -> landRight 2 first >>= landLeft 1
+
+swapPolesMaybe :: Maybe Pole -> Maybe Pole
+swapPolesMaybe x
+  = do (one, two) <- x
+       pure (two, one)
+ + diff --git a/test/build/DoNotation.md b/test/build/DoNotation.md new file mode 100644 index 00000000..60a37040 --- /dev/null +++ b/test/build/DoNotation.md @@ -0,0 +1,35 @@ +```haskell +module DoNotation where + +type Birds = Int + +type Pole = (Birds, Birds) + +landLeft :: Birds -> Pole -> Maybe Pole +landLeft n (left, right) + = if abs (left + n - right) < 4 then Just (left + n, right) else + Nothing + +landRight :: Birds -> Pole -> Maybe Pole +landRight n (left, right) + = if abs (left - (right + n)) < 4 then Just (left, right + n) else + Nothing + +routine :: Maybe Pole +routine + = do start <- return (0, 0) + first <- landLeft 2 start + landRight 2 first >>= landLeft 1 + +routineWithoutDo :: Maybe Pole +routineWithoutDo + = return (0, 0) >>= + \ start -> + landLeft 2 start >>= \ first -> landRight 2 first >>= landLeft 1 + +swapPolesMaybe :: Maybe Pole -> Maybe Pole +swapPolesMaybe x + = do (one, two) <- x + pure (two, one) + +``` diff --git a/test/build/EraseType.hs b/test/build/EraseType.hs new file mode 100644 index 00000000..a5309b08 --- /dev/null +++ b/test/build/EraseType.hs @@ -0,0 +1,20 @@ +module EraseType where + +testErase :: () +testErase = () + +testMatch :: () -> () +testMatch () = () + +testRezz :: Int +testRezz = 42 + +testRezzErase :: () +testRezzErase = () + +testCong :: Int +testCong = 1 + testRezz + +rTail :: [Int] -> [Int] +rTail = \ ys -> tail ys + diff --git a/test/build/EraseType.html b/test/build/EraseType.html new file mode 100644 index 00000000..b3fadb28 --- /dev/null +++ b/test/build/EraseType.html @@ -0,0 +1,99 @@ + + + + + + + EraseType + + + +
module EraseType where
+
+testErase :: ()
+testErase = ()
+
+testMatch :: () -> ()
+testMatch () = ()
+
+testRezz :: Int
+testRezz = 42
+
+testRezzErase :: ()
+testRezzErase = ()
+
+testCong :: Int
+testCong = 1 + testRezz
+
+rTail :: [Int] -> [Int]
+rTail = \ ys -> tail ys
+ + diff --git a/test/build/EraseType.md b/test/build/EraseType.md new file mode 100644 index 00000000..ad4c5fa9 --- /dev/null +++ b/test/build/EraseType.md @@ -0,0 +1,22 @@ +```haskell +module EraseType where + +testErase :: () +testErase = () + +testMatch :: () -> () +testMatch () = () + +testRezz :: Int +testRezz = 42 + +testRezzErase :: () +testRezzErase = () + +testCong :: Int +testCong = 1 + testRezz + +rTail :: [Int] -> [Int] +rTail = \ ys -> tail ys + +``` diff --git a/test/build/ErasedLocalDefinitions.hs b/test/build/ErasedLocalDefinitions.hs new file mode 100644 index 00000000..30735ae5 --- /dev/null +++ b/test/build/ErasedLocalDefinitions.hs @@ -0,0 +1,8 @@ +module ErasedLocalDefinitions where + +f :: Bool -> Bool +f m = g m + where + g :: Bool -> Bool + g m = m + diff --git a/test/build/ErasedLocalDefinitions.html b/test/build/ErasedLocalDefinitions.html new file mode 100644 index 00000000..de293d0d --- /dev/null +++ b/test/build/ErasedLocalDefinitions.html @@ -0,0 +1,87 @@ + + + + + + + ErasedLocalDefinitions + + + +
module ErasedLocalDefinitions where
+
+f :: Bool -> Bool
+f m = g m
+  where
+    g :: Bool -> Bool
+    g m = m
+ + diff --git a/test/build/ErasedLocalDefinitions.md b/test/build/ErasedLocalDefinitions.md new file mode 100644 index 00000000..9e7ee6a4 --- /dev/null +++ b/test/build/ErasedLocalDefinitions.md @@ -0,0 +1,10 @@ +```haskell +module ErasedLocalDefinitions where + +f :: Bool -> Bool +f m = g m + where + g :: Bool -> Bool + g m = m + +``` diff --git a/test/build/ErasedPatternLambda.hs b/test/build/ErasedPatternLambda.hs new file mode 100644 index 00000000..62c0cf9e --- /dev/null +++ b/test/build/ErasedPatternLambda.hs @@ -0,0 +1,10 @@ +module ErasedPatternLambda where + +data Telescope = ExtendTel Bool Telescope + +caseTelBind :: Telescope -> (Bool -> Telescope -> d) -> d +caseTelBind (ExtendTel a tel) f = f a tel + +checkSubst :: Telescope -> Bool +checkSubst t = caseTelBind t (\ ty rest -> True) + diff --git a/test/build/ErasedPatternLambda.html b/test/build/ErasedPatternLambda.html new file mode 100644 index 00000000..5c149ecb --- /dev/null +++ b/test/build/ErasedPatternLambda.html @@ -0,0 +1,89 @@ + + + + + + + ErasedPatternLambda + + + +
module ErasedPatternLambda where
+
+data Telescope = ExtendTel Bool Telescope
+
+caseTelBind :: Telescope -> (Bool -> Telescope -> d) -> d
+caseTelBind (ExtendTel a tel) f = f a tel
+
+checkSubst :: Telescope -> Bool
+checkSubst t = caseTelBind t (\ ty rest -> True)
+ + diff --git a/test/build/ErasedPatternLambda.md b/test/build/ErasedPatternLambda.md new file mode 100644 index 00000000..d556f9b0 --- /dev/null +++ b/test/build/ErasedPatternLambda.md @@ -0,0 +1,12 @@ +```haskell +module ErasedPatternLambda where + +data Telescope = ExtendTel Bool Telescope + +caseTelBind :: Telescope -> (Bool -> Telescope -> d) -> d +caseTelBind (ExtendTel a tel) f = f a tel + +checkSubst :: Telescope -> Bool +checkSubst t = caseTelBind t (\ ty rest -> True) + +``` diff --git a/test/build/ErasedRecordParameter.err b/test/build/ErasedRecordParameter.err new file mode 100644 index 00000000..fcd7e22e --- /dev/null +++ b/test/build/ErasedRecordParameter.err @@ -0,0 +1,2 @@ +test/Fail/ErasedRecordParameter.agda:4,8-10 +Cannot use erased variable a in Haskell type diff --git a/test/build/ErasedRecordParameter.html b/test/build/ErasedRecordParameter.html new file mode 100644 index 00000000..4a36641d --- /dev/null +++ b/test/build/ErasedRecordParameter.html @@ -0,0 +1,21 @@ + + + + + + + ErasedRecordParameter + + + +
test/Fail/ErasedRecordParameter.agda:4,8-10
+Cannot use erased variable a in Haskell type
+ + diff --git a/test/build/ErasedRecordParameter.md b/test/build/ErasedRecordParameter.md new file mode 100644 index 00000000..399a277c --- /dev/null +++ b/test/build/ErasedRecordParameter.md @@ -0,0 +1,4 @@ +``` +test/Fail/ErasedRecordParameter.agda:4,8-10 +Cannot use erased variable a in Haskell type +``` diff --git a/test/build/ErasedTypeArguments.hs b/test/build/ErasedTypeArguments.hs new file mode 100644 index 00000000..da07ad41 --- /dev/null +++ b/test/build/ErasedTypeArguments.hs @@ -0,0 +1,11 @@ +module ErasedTypeArguments where + +import Numeric.Natural (Natural) + +data Σ' a b = (:^:){proj₁ :: a, proj₂ :: b} + +test :: Natural -> Σ' Natural () +test n = n :^: () + +newtype Id f = MkId f + diff --git a/test/build/ErasedTypeArguments.html b/test/build/ErasedTypeArguments.html new file mode 100644 index 00000000..0addfae9 --- /dev/null +++ b/test/build/ErasedTypeArguments.html @@ -0,0 +1,90 @@ + + + + + + + ErasedTypeArguments + + + +
module ErasedTypeArguments where
+
+import Numeric.Natural (Natural)
+
+data Σ' a b = (:^:){proj₁ :: a, proj₂ :: b}
+
+test :: Natural -> Σ' Natural ()
+test n = n :^: ()
+
+newtype Id f = MkId f
+ + diff --git a/test/build/ErasedTypeArguments.md b/test/build/ErasedTypeArguments.md new file mode 100644 index 00000000..b7100638 --- /dev/null +++ b/test/build/ErasedTypeArguments.md @@ -0,0 +1,13 @@ +```haskell +module ErasedTypeArguments where + +import Numeric.Natural (Natural) + +data Σ' a b = (:^:){proj₁ :: a, proj₂ :: b} + +test :: Natural -> Σ' Natural () +test n = n :^: () + +newtype Id f = MkId f + +``` diff --git a/test/build/ExplicitInstance.err b/test/build/ExplicitInstance.err new file mode 100644 index 00000000..ef202587 --- /dev/null +++ b/test/build/ExplicitInstance.err @@ -0,0 +1,2 @@ +test/Fail/ExplicitInstance.agda:17,1-5 +illegal instance: λ { .Fail.ExplicitInstance.theDefault → True } diff --git a/test/build/ExplicitInstance.html b/test/build/ExplicitInstance.html new file mode 100644 index 00000000..6a34314b --- /dev/null +++ b/test/build/ExplicitInstance.html @@ -0,0 +1,21 @@ + + + + + + + ExplicitInstance + + + +
test/Fail/ExplicitInstance.agda:17,1-5
+illegal instance:  λ { .Fail.ExplicitInstance.theDefault → True }
+ + diff --git a/test/build/ExplicitInstance.md b/test/build/ExplicitInstance.md new file mode 100644 index 00000000..4f0b7ec1 --- /dev/null +++ b/test/build/ExplicitInstance.md @@ -0,0 +1,4 @@ +``` +test/Fail/ExplicitInstance.agda:17,1-5 +illegal instance: λ { .Fail.ExplicitInstance.theDefault → True } +``` diff --git a/test/build/ExplicitInstance2.err b/test/build/ExplicitInstance2.err new file mode 100644 index 00000000..2a4c6567 --- /dev/null +++ b/test/build/ExplicitInstance2.err @@ -0,0 +1,2 @@ +test/Fail/ExplicitInstance2.agda:13,1-5 +illegal instance: λ { .Fail.ExplicitInstance2.theDefault → True } diff --git a/test/build/ExplicitInstance2.html b/test/build/ExplicitInstance2.html new file mode 100644 index 00000000..42bca264 --- /dev/null +++ b/test/build/ExplicitInstance2.html @@ -0,0 +1,21 @@ + + + + + + + ExplicitInstance2 + + + +
test/Fail/ExplicitInstance2.agda:13,1-5
+illegal instance:  λ { .Fail.ExplicitInstance2.theDefault → True }
+ + diff --git a/test/build/ExplicitInstance2.md b/test/build/ExplicitInstance2.md new file mode 100644 index 00000000..44ab5dad --- /dev/null +++ b/test/build/ExplicitInstance2.md @@ -0,0 +1,4 @@ +``` +test/Fail/ExplicitInstance2.agda:13,1-5 +illegal instance: λ { .Fail.ExplicitInstance2.theDefault → True } +``` diff --git a/test/build/Fixities.err b/test/build/Fixities.err new file mode 100644 index 00000000..828a3458 --- /dev/null +++ b/test/build/Fixities.err @@ -0,0 +1,2 @@ +test/Fail/Fixities.agda:6,1-6 +Invalid fixity 8.5 for operator _<+>_ diff --git a/test/build/Fixities.hs b/test/build/Fixities.hs new file mode 100644 index 00000000..19097fb3 --- /dev/null +++ b/test/build/Fixities.hs @@ -0,0 +1,24 @@ +module Fixities where + +leftAssoc :: Int -> [Int] +leftAssoc n + = [2 * n + 1, 2 * (n + 1), 1 + n * 2, (1 + n) * 2, n + n + n, + n + (n + n)] + +rightAssoc :: [Int] -> [Int] +rightAssoc xs = xs ++ xs ++ ((xs ++ xs) ++ xs) ++ xs + +nonAssoc :: Bool -> Bool +nonAssoc b = (b == b) == (b == b) + +mixedAssoc :: Maybe Int -> (Int -> Maybe Int) -> Maybe Int +mixedAssoc m f = f =<< ((f =<< m) >>= f >>= f) + +infixl 7 <+> +(<+>) :: Int -> Int -> Int +x <+> y = x + y + +infixr 8 <-> +(<->) :: Int -> Int -> Int +x <-> y = x - y + diff --git a/test/build/Fixities.html b/test/build/Fixities.html new file mode 100644 index 00000000..c05b26f7 --- /dev/null +++ b/test/build/Fixities.html @@ -0,0 +1,103 @@ + + + + + + + Fixities + + + +
module Fixities where
+
+leftAssoc :: Int -> [Int]
+leftAssoc n
+  = [2 * n + 1, 2 * (n + 1), 1 + n * 2, (1 + n) * 2, n + n + n,
+     n + (n + n)]
+
+rightAssoc :: [Int] -> [Int]
+rightAssoc xs = xs ++ xs ++ ((xs ++ xs) ++ xs) ++ xs
+
+nonAssoc :: Bool -> Bool
+nonAssoc b = (b == b) == (b == b)
+
+mixedAssoc :: Maybe Int -> (Int -> Maybe Int) -> Maybe Int
+mixedAssoc m f = f =<< ((f =<< m) >>= f >>= f)
+
+infixl 7 <+>
+(<+>) :: Int -> Int -> Int
+x <+> y = x + y
+
+infixr 8 <->
+(<->) :: Int -> Int -> Int
+x <-> y = x - y
+ + diff --git a/test/build/Fixities.md b/test/build/Fixities.md new file mode 100644 index 00000000..461faa24 --- /dev/null +++ b/test/build/Fixities.md @@ -0,0 +1,26 @@ +```haskell +module Fixities where + +leftAssoc :: Int -> [Int] +leftAssoc n + = [2 * n + 1, 2 * (n + 1), 1 + n * 2, (1 + n) * 2, n + n + n, + n + (n + n)] + +rightAssoc :: [Int] -> [Int] +rightAssoc xs = xs ++ xs ++ ((xs ++ xs) ++ xs) ++ xs + +nonAssoc :: Bool -> Bool +nonAssoc b = (b == b) == (b == b) + +mixedAssoc :: Maybe Int -> (Int -> Maybe Int) -> Maybe Int +mixedAssoc m f = f =<< ((f =<< m) >>= f >>= f) + +infixl 7 <+> +(<+>) :: Int -> Int -> Int +x <+> y = x + y + +infixr 8 <-> +(<->) :: Int -> Int -> Int +x <-> y = x - y + +``` diff --git a/test/build/FunCon.hs b/test/build/FunCon.hs new file mode 100644 index 00000000..339323e7 --- /dev/null +++ b/test/build/FunCon.hs @@ -0,0 +1,12 @@ +module FunCon where + +data D1 t = C1 (t Bool) + +f1 :: D1 ((->) Int) +f1 = C1 (== 0) + +data D2 t = C2 (t Int Int) + +f2 :: D2 (->) +f2 = C2 (+ 1) + diff --git a/test/build/FunCon.html b/test/build/FunCon.html new file mode 100644 index 00000000..08813074 --- /dev/null +++ b/test/build/FunCon.html @@ -0,0 +1,91 @@ + + + + + + + FunCon + + + +
module FunCon where
+
+data D1 t = C1 (t Bool)
+
+f1 :: D1 ((->) Int)
+f1 = C1 (== 0)
+
+data D2 t = C2 (t Int Int)
+
+f2 :: D2 (->)
+f2 = C2 (+ 1)
+ + diff --git a/test/build/FunCon.md b/test/build/FunCon.md new file mode 100644 index 00000000..84d76ffb --- /dev/null +++ b/test/build/FunCon.md @@ -0,0 +1,14 @@ +```haskell +module FunCon where + +data D1 t = C1 (t Bool) + +f1 :: D1 ((->) Int) +f1 = C1 (== 0) + +data D2 t = C2 (t Int Int) + +f2 :: D2 (->) +f2 = C2 (+ 1) + +``` diff --git a/test/build/HeightMirror.hs b/test/build/HeightMirror.hs new file mode 100644 index 00000000..3df1bfdb --- /dev/null +++ b/test/build/HeightMirror.hs @@ -0,0 +1,9 @@ +module HeightMirror where + +data Tree a = Tip + | Bin a (Tree a) (Tree a) + +mirror :: Tree a -> Tree a +mirror Tip = Tip +mirror (Bin x lt rt) = Bin x (mirror rt) (mirror lt) + diff --git a/test/build/HeightMirror.html b/test/build/HeightMirror.html new file mode 100644 index 00000000..12619b69 --- /dev/null +++ b/test/build/HeightMirror.html @@ -0,0 +1,88 @@ + + + + + + + HeightMirror + + + +
module HeightMirror where
+
+data Tree a = Tip
+            | Bin a (Tree a) (Tree a)
+
+mirror :: Tree a -> Tree a
+mirror Tip = Tip
+mirror (Bin x lt rt) = Bin x (mirror rt) (mirror lt)
+ + diff --git a/test/build/HeightMirror.md b/test/build/HeightMirror.md new file mode 100644 index 00000000..dd353fe0 --- /dev/null +++ b/test/build/HeightMirror.md @@ -0,0 +1,11 @@ +```haskell +module HeightMirror where + +data Tree a = Tip + | Bin a (Tree a) (Tree a) + +mirror :: Tree a -> Tree a +mirror Tip = Tip +mirror (Bin x lt rt) = Bin x (mirror rt) (mirror lt) + +``` diff --git a/test/build/IOFile.hs b/test/build/IOFile.hs new file mode 100644 index 00000000..5a6abf5a --- /dev/null +++ b/test/build/IOFile.hs @@ -0,0 +1,11 @@ +module IOFile where + +main :: IO () +main + = do file <- readFile "IOFile.agda" + writeFile "IOFile2.agda" file + appendFile "IOFile2.agda" "-- Written by appendFile" + file2 <- readFile "IOFile2.agda" + print file2 + return () + diff --git a/test/build/IOFile.html b/test/build/IOFile.html new file mode 100644 index 00000000..0da1b91e --- /dev/null +++ b/test/build/IOFile.html @@ -0,0 +1,90 @@ + + + + + + + IOFile + + + +
module IOFile where
+
+main :: IO ()
+main
+  = do file <- readFile "IOFile.agda"
+       writeFile "IOFile2.agda" file
+       appendFile "IOFile2.agda" "-- Written by appendFile"
+       file2 <- readFile "IOFile2.agda"
+       print file2
+       return ()
+ + diff --git a/test/build/IOFile.md b/test/build/IOFile.md new file mode 100644 index 00000000..03bb7f85 --- /dev/null +++ b/test/build/IOFile.md @@ -0,0 +1,13 @@ +```haskell +module IOFile where + +main :: IO () +main + = do file <- readFile "IOFile.agda" + writeFile "IOFile2.agda" file + appendFile "IOFile2.agda" "-- Written by appendFile" + file2 <- readFile "IOFile2.agda" + print file2 + return () + +``` diff --git a/test/build/IOInput.hs b/test/build/IOInput.hs new file mode 100644 index 00000000..bfafd7e7 --- /dev/null +++ b/test/build/IOInput.hs @@ -0,0 +1,9 @@ +module IOInput where + +main :: IO () +main + = do putStrLn "Write something " + x <- getLine + putStr $ "You wrote: " ++ x + return () + diff --git a/test/build/IOInput.html b/test/build/IOInput.html new file mode 100644 index 00000000..f3b9eb2d --- /dev/null +++ b/test/build/IOInput.html @@ -0,0 +1,88 @@ + + + + + + + IOInput + + + +
module IOInput where
+
+main :: IO ()
+main
+  = do putStrLn "Write something "
+       x <- getLine
+       putStr $ "You wrote: " ++ x
+       return ()
+ + diff --git a/test/build/IOInput.md b/test/build/IOInput.md new file mode 100644 index 00000000..78319e30 --- /dev/null +++ b/test/build/IOInput.md @@ -0,0 +1,11 @@ +```haskell +module IOInput where + +main :: IO () +main + = do putStrLn "Write something " + x <- getLine + putStr $ "You wrote: " ++ x + return () + +``` diff --git a/test/build/Importee.hs b/test/build/Importee.hs new file mode 100644 index 00000000..c8fd9109 --- /dev/null +++ b/test/build/Importee.hs @@ -0,0 +1,19 @@ +module Importee where + +foo :: Int +foo = 42 + +(!#) :: Int -> Int -> Int +x !# y = x + y + +data Foo = MkFoo + +class Fooable a where + doTheFoo :: a + defaultFoo :: a + {-# MINIMAL doTheFoo #-} + defaultFoo = doTheFoo + +instance Fooable Foo where + doTheFoo = MkFoo + diff --git a/test/build/Importee.html b/test/build/Importee.html new file mode 100644 index 00000000..532f2fea --- /dev/null +++ b/test/build/Importee.html @@ -0,0 +1,98 @@ + + + + + + + Importee + + + +
module Importee where
+
+foo :: Int
+foo = 42
+
+(!#) :: Int -> Int -> Int
+x !# y = x + y
+
+data Foo = MkFoo
+
+class Fooable a where
+    doTheFoo :: a
+    defaultFoo :: a
+    {-# MINIMAL doTheFoo #-}
+    defaultFoo = doTheFoo
+
+instance Fooable Foo where
+    doTheFoo = MkFoo
+ + diff --git a/test/build/Importee.md b/test/build/Importee.md new file mode 100644 index 00000000..a551997e --- /dev/null +++ b/test/build/Importee.md @@ -0,0 +1,21 @@ +```haskell +module Importee where + +foo :: Int +foo = 42 + +(!#) :: Int -> Int -> Int +x !# y = x + y + +data Foo = MkFoo + +class Fooable a where + doTheFoo :: a + defaultFoo :: a + {-# MINIMAL doTheFoo #-} + defaultFoo = doTheFoo + +instance Fooable Foo where + doTheFoo = MkFoo + +``` diff --git a/test/build/Importer.hs b/test/build/Importer.hs new file mode 100644 index 00000000..17aff23c --- /dev/null +++ b/test/build/Importer.hs @@ -0,0 +1,38 @@ +module Importer where + +import Importee (Foo(MkFoo), Fooable(defaultFoo, doTheFoo), foo, (!#)) +import Numeric.Natural (Natural) +import SecondImportee (anotherFoo) + +-- ** simple imports (possibly with transitive dependencies) + +bar :: Int +bar = foo + +anotherBar :: Int +anotherBar = anotherFoo + +baz :: Int +baz = 21 !# 21 + +mkFoo :: Foo +mkFoo = MkFoo + +fooable :: Foo +fooable = doTheFoo + +-- ** interplay with class default methods + +defaultBar :: Foo +defaultBar = defaultFoo + +-- ** interplay with methods of existing class + +testFoldMap :: [Natural] -> [Natural] +testFoldMap = foldMap (:) [] + +-- ** interplay with default methods of existing class + +testFoldr :: [Natural] -> Natural +testFoldr = foldr (\ _ x -> x) 0 + diff --git a/test/build/Importer.html b/test/build/Importer.html new file mode 100644 index 00000000..a65086e4 --- /dev/null +++ b/test/build/Importer.html @@ -0,0 +1,117 @@ + + + + + + + Importer + + + +
module Importer where
+
+import Importee (Foo(MkFoo), Fooable(defaultFoo, doTheFoo), foo, (!#))
+import Numeric.Natural (Natural)
+import SecondImportee (anotherFoo)
+
+-- ** simple imports (possibly with transitive dependencies)
+
+bar :: Int
+bar = foo
+
+anotherBar :: Int
+anotherBar = anotherFoo
+
+baz :: Int
+baz = 21 !# 21
+
+mkFoo :: Foo
+mkFoo = MkFoo
+
+fooable :: Foo
+fooable = doTheFoo
+
+-- ** interplay with class default methods
+
+defaultBar :: Foo
+defaultBar = defaultFoo
+
+-- ** interplay with methods of existing class
+
+testFoldMap :: [Natural] -> [Natural]
+testFoldMap = foldMap (:) []
+
+-- ** interplay with default methods of existing class
+
+testFoldr :: [Natural] -> Natural
+testFoldr = foldr (\ _ x -> x) 0
+ + diff --git a/test/build/Importer.md b/test/build/Importer.md new file mode 100644 index 00000000..c38c36ca --- /dev/null +++ b/test/build/Importer.md @@ -0,0 +1,40 @@ +```haskell +module Importer where + +import Importee (Foo(MkFoo), Fooable(defaultFoo, doTheFoo), foo, (!#)) +import Numeric.Natural (Natural) +import SecondImportee (anotherFoo) + +-- ** simple imports (possibly with transitive dependencies) + +bar :: Int +bar = foo + +anotherBar :: Int +anotherBar = anotherFoo + +baz :: Int +baz = 21 !# 21 + +mkFoo :: Foo +mkFoo = MkFoo + +fooable :: Foo +fooable = doTheFoo + +-- ** interplay with class default methods + +defaultBar :: Foo +defaultBar = defaultFoo + +-- ** interplay with methods of existing class + +testFoldMap :: [Natural] -> [Natural] +testFoldMap = foldMap (:) [] + +-- ** interplay with default methods of existing class + +testFoldr :: [Natural] -> Natural +testFoldr = foldr (\ _ x -> x) 0 + +``` diff --git a/test/build/Inline.err b/test/build/Inline.err new file mode 100644 index 00000000..2bd96c63 --- /dev/null +++ b/test/build/Inline.err @@ -0,0 +1,2 @@ +test/Fail/Inline.agda:5,1-6 +Cannot make function tail' inlinable. An inline function must have exactly one clause. diff --git a/test/build/Inline.html b/test/build/Inline.html new file mode 100644 index 00000000..fcffcf7d --- /dev/null +++ b/test/build/Inline.html @@ -0,0 +1,21 @@ + + + + + + + Inline + + + +
test/Fail/Inline.agda:5,1-6
+Cannot make function tail' inlinable. An inline function must have exactly one clause.
+ + diff --git a/test/build/Inline.md b/test/build/Inline.md new file mode 100644 index 00000000..14c8bbbd --- /dev/null +++ b/test/build/Inline.md @@ -0,0 +1,4 @@ +``` +test/Fail/Inline.agda:5,1-6 +Cannot make function tail' inlinable. An inline function must have exactly one clause. +``` diff --git a/test/build/Inline2.err b/test/build/Inline2.err new file mode 100644 index 00000000..e8fb8038 --- /dev/null +++ b/test/build/Inline2.err @@ -0,0 +1,2 @@ +test/Fail/Inline2.agda:5,1-6 +Cannot make function tail' inlinable. Inline functions can only use variable patterns or transparent record constructor patterns. diff --git a/test/build/Inline2.html b/test/build/Inline2.html new file mode 100644 index 00000000..1576bf03 --- /dev/null +++ b/test/build/Inline2.html @@ -0,0 +1,21 @@ + + + + + + + Inline2 + + + +
test/Fail/Inline2.agda:5,1-6
+Cannot make function tail' inlinable. Inline functions can only use variable patterns or transparent record constructor patterns.
+ + diff --git a/test/build/Inline2.md b/test/build/Inline2.md new file mode 100644 index 00000000..2fafd8a7 --- /dev/null +++ b/test/build/Inline2.md @@ -0,0 +1,4 @@ +``` +test/Fail/Inline2.agda:5,1-6 +Cannot make function tail' inlinable. Inline functions can only use variable patterns or transparent record constructor patterns. +``` diff --git a/test/build/Inlining.hs b/test/build/Inlining.hs new file mode 100644 index 00000000..6df0af7f --- /dev/null +++ b/test/build/Inlining.hs @@ -0,0 +1,17 @@ +module Inlining where + +aliased :: Bool +aliased = True + +test1 :: Int -> Int +test1 x = 1 + x + +test2 :: Int -> Int -> Int +test2 x y = x + y + +test3 :: Int -> Int -> Int +test3 x = \ y -> x + y + +test4 :: Int -> Int -> Int +test4 = \ x y -> x + y + diff --git a/test/build/Inlining.html b/test/build/Inlining.html new file mode 100644 index 00000000..ecc2b566 --- /dev/null +++ b/test/build/Inlining.html @@ -0,0 +1,96 @@ + + + + + + + Inlining + + + +
module Inlining where
+
+aliased :: Bool
+aliased = True
+
+test1 :: Int -> Int
+test1 x = 1 + x
+
+test2 :: Int -> Int -> Int
+test2 x y = x + y
+
+test3 :: Int -> Int -> Int
+test3 x = \ y -> x + y
+
+test4 :: Int -> Int -> Int
+test4 = \ x y -> x + y
+ + diff --git a/test/build/Inlining.md b/test/build/Inlining.md new file mode 100644 index 00000000..04daf821 --- /dev/null +++ b/test/build/Inlining.md @@ -0,0 +1,19 @@ +```haskell +module Inlining where + +aliased :: Bool +aliased = True + +test1 :: Int -> Int +test1 x = 1 + x + +test2 :: Int -> Int -> Int +test2 x y = x + y + +test3 :: Int -> Int -> Int +test3 x = \ y -> x + y + +test4 :: Int -> Int -> Int +test4 = \ x y -> x + y + +``` diff --git a/test/build/InvalidName.err b/test/build/InvalidName.err new file mode 100644 index 00000000..db42cd21 --- /dev/null +++ b/test/build/InvalidName.err @@ -0,0 +1,2 @@ +test/Fail/InvalidName.agda:6,1-2 +Invalid name for Haskell function: F diff --git a/test/build/InvalidName.html b/test/build/InvalidName.html new file mode 100644 index 00000000..cf73b5f3 --- /dev/null +++ b/test/build/InvalidName.html @@ -0,0 +1,21 @@ + + + + + + + InvalidName + + + +
test/Fail/InvalidName.agda:6,1-2
+Invalid name for Haskell function:  F
+ + diff --git a/test/build/InvalidName.md b/test/build/InvalidName.md new file mode 100644 index 00000000..c8a3edd9 --- /dev/null +++ b/test/build/InvalidName.md @@ -0,0 +1,4 @@ +``` +test/Fail/InvalidName.agda:6,1-2 +Invalid name for Haskell function: F +``` diff --git a/test/build/Issue113a.err b/test/build/Issue113a.err new file mode 100644 index 00000000..8fef39b0 --- /dev/null +++ b/test/build/Issue113a.err @@ -0,0 +1,2 @@ +test/Fail/Issue113a.agda:5,8-12 +Unboxed record Loop cannot be recursive diff --git a/test/build/Issue113a.html b/test/build/Issue113a.html new file mode 100644 index 00000000..067530eb --- /dev/null +++ b/test/build/Issue113a.html @@ -0,0 +1,21 @@ + + + + + + + Issue113a + + + +
test/Fail/Issue113a.agda:5,8-12
+Unboxed record Loop cannot be recursive
+ + diff --git a/test/build/Issue113a.md b/test/build/Issue113a.md new file mode 100644 index 00000000..e3bce949 --- /dev/null +++ b/test/build/Issue113a.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue113a.agda:5,8-12 +Unboxed record Loop cannot be recursive +``` diff --git a/test/build/Issue113b.err b/test/build/Issue113b.err new file mode 100644 index 00000000..95bceec2 --- /dev/null +++ b/test/build/Issue113b.err @@ -0,0 +1,2 @@ +test/Fail/Issue113b.agda:7,8-12 +Unboxed record Loop cannot be recursive diff --git a/test/build/Issue113b.html b/test/build/Issue113b.html new file mode 100644 index 00000000..83de3f28 --- /dev/null +++ b/test/build/Issue113b.html @@ -0,0 +1,21 @@ + + + + + + + Issue113b + + + +
test/Fail/Issue113b.agda:7,8-12
+Unboxed record Loop cannot be recursive
+ + diff --git a/test/build/Issue113b.md b/test/build/Issue113b.md new file mode 100644 index 00000000..a5b5b9d3 --- /dev/null +++ b/test/build/Issue113b.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue113b.agda:7,8-12 +Unboxed record Loop cannot be recursive +``` diff --git a/test/build/Issue115.hs b/test/build/Issue115.hs new file mode 100644 index 00000000..17df797e --- /dev/null +++ b/test/build/Issue115.hs @@ -0,0 +1,16 @@ +module Issue115 where + +class Pointed a where + it :: a + +data A = A1 + +instance Pointed A where + it = A1 + +data Delay a = Later (Delay a) + | Now a + +test :: Delay A +test = Later (Now it) + diff --git a/test/build/Issue115.html b/test/build/Issue115.html new file mode 100644 index 00000000..9fc0e15b --- /dev/null +++ b/test/build/Issue115.html @@ -0,0 +1,95 @@ + + + + + + + Issue115 + + + +
module Issue115 where
+
+class Pointed a where
+    it :: a
+
+data A = A1
+
+instance Pointed A where
+    it = A1
+
+data Delay a = Later (Delay a)
+             | Now a
+
+test :: Delay A
+test = Later (Now it)
+ + diff --git a/test/build/Issue115.md b/test/build/Issue115.md new file mode 100644 index 00000000..1b0dc061 --- /dev/null +++ b/test/build/Issue115.md @@ -0,0 +1,18 @@ +```haskell +module Issue115 where + +class Pointed a where + it :: a + +data A = A1 + +instance Pointed A where + it = A1 + +data Delay a = Later (Delay a) + | Now a + +test :: Delay A +test = Later (Now it) + +``` diff --git a/test/build/Issue125.err b/test/build/Issue125.err new file mode 100644 index 00000000..1b7c67c9 --- /dev/null +++ b/test/build/Issue125.err @@ -0,0 +1 @@ +Cannot generate multiple constructors with the same identifier: ACtr diff --git a/test/build/Issue125.html b/test/build/Issue125.html new file mode 100644 index 00000000..5d952df3 --- /dev/null +++ b/test/build/Issue125.html @@ -0,0 +1,20 @@ + + + + + + + Issue125 + + + +
Cannot generate multiple constructors with the same identifier: ACtr
+ + diff --git a/test/build/Issue125.md b/test/build/Issue125.md new file mode 100644 index 00000000..9a58fba9 --- /dev/null +++ b/test/build/Issue125.md @@ -0,0 +1,3 @@ +``` +Cannot generate multiple constructors with the same identifier: ACtr +``` diff --git a/test/build/Issue14.hs b/test/build/Issue14.hs new file mode 100644 index 00000000..41d3691f --- /dev/null +++ b/test/build/Issue14.hs @@ -0,0 +1,13 @@ +module Issue14 where + +import Numeric.Natural (Natural) + +constid :: a -> b -> b +constid x = \ x -> x + +sectionTest₁ :: Natural -> Natural -> Natural +sectionTest₁ n = (+ n) + +sectionTest₂ :: Natural -> Natural -> Natural +sectionTest₂ section = (+ section) + diff --git a/test/build/Issue14.html b/test/build/Issue14.html new file mode 100644 index 00000000..a3a43ceb --- /dev/null +++ b/test/build/Issue14.html @@ -0,0 +1,92 @@ + + + + + + + Issue14 + + + +
module Issue14 where
+
+import Numeric.Natural (Natural)
+
+constid :: a -> b -> b
+constid x = \ x -> x
+
+sectionTest₁ :: Natural -> Natural -> Natural
+sectionTest₁ n = (+ n)
+
+sectionTest₂ :: Natural -> Natural -> Natural
+sectionTest₂ section = (+ section)
+ + diff --git a/test/build/Issue14.md b/test/build/Issue14.md new file mode 100644 index 00000000..a21b8db5 --- /dev/null +++ b/test/build/Issue14.md @@ -0,0 +1,15 @@ +```haskell +module Issue14 where + +import Numeric.Natural (Natural) + +constid :: a -> b -> b +constid x = \ x -> x + +sectionTest₁ :: Natural -> Natural -> Natural +sectionTest₁ n = (+ n) + +sectionTest₂ :: Natural -> Natural -> Natural +sectionTest₂ section = (+ section) + +``` diff --git a/test/build/Issue142.err b/test/build/Issue142.err new file mode 100644 index 00000000..7ddab292 --- /dev/null +++ b/test/build/Issue142.err @@ -0,0 +1,2 @@ +test/Fail/Issue142.agda:6,1-12 +not supported by agda2hs: forced (dot) patterns in non-erased positions diff --git a/test/build/Issue142.html b/test/build/Issue142.html new file mode 100644 index 00000000..f1ff21ce --- /dev/null +++ b/test/build/Issue142.html @@ -0,0 +1,21 @@ + + + + + + + Issue142 + + + +
test/Fail/Issue142.agda:6,1-12
+not supported by agda2hs: forced (dot) patterns in non-erased positions
+ + diff --git a/test/build/Issue142.md b/test/build/Issue142.md new file mode 100644 index 00000000..ff5ab181 --- /dev/null +++ b/test/build/Issue142.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue142.agda:6,1-12 +not supported by agda2hs: forced (dot) patterns in non-erased positions +``` diff --git a/test/build/Issue145.hs b/test/build/Issue145.hs new file mode 100644 index 00000000..f18013ae --- /dev/null +++ b/test/build/Issue145.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ScopedTypeVariables, BangPatterns #-} +module Issue145 where + +it :: forall a . a -> a +it x = x + +it' :: Monoid a => a -> a +it' x = x + +data Ok' a = Thing' !a + +data Ok a = Thing a + +test :: Ok String +test = Thing "ok" + diff --git a/test/build/Issue145.html b/test/build/Issue145.html new file mode 100644 index 00000000..c9f1c393 --- /dev/null +++ b/test/build/Issue145.html @@ -0,0 +1,95 @@ + + + + + + + Issue145 + + + +
{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}
+module Issue145 where
+
+it :: forall a . a -> a
+it x = x
+
+it' :: Monoid a => a -> a
+it' x = x
+
+data Ok' a = Thing' !a
+
+data Ok a = Thing a
+
+test :: Ok String
+test = Thing "ok"
+ + diff --git a/test/build/Issue145.md b/test/build/Issue145.md new file mode 100644 index 00000000..8f3269f3 --- /dev/null +++ b/test/build/Issue145.md @@ -0,0 +1,18 @@ +```haskell +{-# LANGUAGE ScopedTypeVariables, BangPatterns #-} +module Issue145 where + +it :: forall a . a -> a +it x = x + +it' :: Monoid a => a -> a +it' x = x + +data Ok' a = Thing' !a + +data Ok a = Thing a + +test :: Ok String +test = Thing "ok" + +``` diff --git a/test/build/Issue146.err b/test/build/Issue146.err new file mode 100644 index 00000000..e7cf7811 --- /dev/null +++ b/test/build/Issue146.err @@ -0,0 +1,2 @@ +test/Fail/Issue146.agda:20,3-12 +not supported in Haskell: copatterns diff --git a/test/build/Issue146.html b/test/build/Issue146.html new file mode 100644 index 00000000..33ac8e8f --- /dev/null +++ b/test/build/Issue146.html @@ -0,0 +1,21 @@ + + + + + + + Issue146 + + + +
test/Fail/Issue146.agda:20,3-12
+not supported in Haskell: copatterns
+ + diff --git a/test/build/Issue146.md b/test/build/Issue146.md new file mode 100644 index 00000000..d0106049 --- /dev/null +++ b/test/build/Issue146.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue146.agda:20,3-12 +not supported in Haskell: copatterns +``` diff --git a/test/build/Issue150.err b/test/build/Issue150.err new file mode 100644 index 00000000..66cb57b3 --- /dev/null +++ b/test/build/Issue150.err @@ -0,0 +1,2 @@ +test/Fail/Issue150.agda:12,1-5 +Record pattern translation not supported. Use a pattern matching lambda instead. diff --git a/test/build/Issue150.html b/test/build/Issue150.html new file mode 100644 index 00000000..fc1cfd2f --- /dev/null +++ b/test/build/Issue150.html @@ -0,0 +1,21 @@ + + + + + + + Issue150 + + + +
test/Fail/Issue150.agda:12,1-5
+Record pattern translation not supported. Use a pattern matching lambda instead.
+ + diff --git a/test/build/Issue150.md b/test/build/Issue150.md new file mode 100644 index 00000000..f822f5df --- /dev/null +++ b/test/build/Issue150.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue150.agda:12,1-5 +Record pattern translation not supported. Use a pattern matching lambda instead. +``` diff --git a/test/build/Issue154.err b/test/build/Issue154.err new file mode 100644 index 00000000..2ed96fff --- /dev/null +++ b/test/build/Issue154.err @@ -0,0 +1,2 @@ +test/Fail/Issue154.agda:5,1-4 +constructor `zero` not supported in patterns diff --git a/test/build/Issue154.html b/test/build/Issue154.html new file mode 100644 index 00000000..5232011c --- /dev/null +++ b/test/build/Issue154.html @@ -0,0 +1,21 @@ + + + + + + + Issue154 + + + +
test/Fail/Issue154.agda:5,1-4
+constructor `zero` not supported in patterns
+ + diff --git a/test/build/Issue154.md b/test/build/Issue154.md new file mode 100644 index 00000000..03bca1f8 --- /dev/null +++ b/test/build/Issue154.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue154.agda:5,1-4 +constructor `zero` not supported in patterns +``` diff --git a/test/build/Issue169-record.err b/test/build/Issue169-record.err new file mode 100644 index 00000000..0a6f399d --- /dev/null +++ b/test/build/Issue169-record.err @@ -0,0 +1,2 @@ +test/Fail/Issue169-record.agda:22,3-16 +illegal instance declaration: instances using default methods should use a named definition or an anonymous `λ where`. diff --git a/test/build/Issue169-record.html b/test/build/Issue169-record.html new file mode 100644 index 00000000..73eb0ec8 --- /dev/null +++ b/test/build/Issue169-record.html @@ -0,0 +1,21 @@ + + + + + + + Issue169-record + + + +
test/Fail/Issue169-record.agda:22,3-16
+illegal instance declaration: instances using default methods should use a named definition or an anonymous `λ where`.
+ + diff --git a/test/build/Issue169-record.md b/test/build/Issue169-record.md new file mode 100644 index 00000000..53b459b5 --- /dev/null +++ b/test/build/Issue169-record.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue169-record.agda:22,3-16 +illegal instance declaration: instances using default methods should use a named definition or an anonymous `λ where`. +``` diff --git a/test/build/Issue169.hs b/test/build/Issue169.hs new file mode 100644 index 00000000..4577a9fb --- /dev/null +++ b/test/build/Issue169.hs @@ -0,0 +1,10 @@ +module Issue169 where + +newtype Identity a = Identity{runIdentity :: a} + +showIdentity :: Show a => Identity a -> String +showIdentity (Identity id) = "Id < " ++ show id ++ " >" + +instance (Show a) => Show (Identity a) where + show = showIdentity + diff --git a/test/build/Issue169.html b/test/build/Issue169.html new file mode 100644 index 00000000..802cdde9 --- /dev/null +++ b/test/build/Issue169.html @@ -0,0 +1,89 @@ + + + + + + + Issue169 + + + +
module Issue169 where
+
+newtype Identity a = Identity{runIdentity :: a}
+
+showIdentity :: Show a => Identity a -> String
+showIdentity (Identity id) = "Id < " ++ show id ++ " >"
+
+instance (Show a) => Show (Identity a) where
+    show = showIdentity
+ + diff --git a/test/build/Issue169.md b/test/build/Issue169.md new file mode 100644 index 00000000..17a997c8 --- /dev/null +++ b/test/build/Issue169.md @@ -0,0 +1,12 @@ +```haskell +module Issue169 where + +newtype Identity a = Identity{runIdentity :: a} + +showIdentity :: Show a => Identity a -> String +showIdentity (Identity id) = "Id < " ++ show id ++ " >" + +instance (Show a) => Show (Identity a) where + show = showIdentity + +``` diff --git a/test/build/Issue185.err b/test/build/Issue185.err new file mode 100644 index 00000000..232fdb0d --- /dev/null +++ b/test/build/Issue185.err @@ -0,0 +1,2 @@ +test/Fail/Issue185.agda:10,3-19 +not supported by agda2hs: functions inside a record module diff --git a/test/build/Issue185.html b/test/build/Issue185.html new file mode 100644 index 00000000..f9e39356 --- /dev/null +++ b/test/build/Issue185.html @@ -0,0 +1,21 @@ + + + + + + + Issue185 + + + +
test/Fail/Issue185.agda:10,3-19
+not supported by agda2hs: functions inside a record module
+ + diff --git a/test/build/Issue185.md b/test/build/Issue185.md new file mode 100644 index 00000000..d544cc41 --- /dev/null +++ b/test/build/Issue185.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue185.agda:10,3-19 +not supported by agda2hs: functions inside a record module +``` diff --git a/test/build/Issue200.hs b/test/build/Issue200.hs new file mode 100644 index 00000000..7836e2d9 --- /dev/null +++ b/test/build/Issue200.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE LambdaCase #-} +module Issue200 where + +data Void + +test :: Maybe Void -> Maybe Void +test + = \case + Nothing -> Nothing + diff --git a/test/build/Issue200.html b/test/build/Issue200.html new file mode 100644 index 00000000..fa78aac5 --- /dev/null +++ b/test/build/Issue200.html @@ -0,0 +1,89 @@ + + + + + + + Issue200 + + + +
{-# LANGUAGE LambdaCase #-}
+module Issue200 where
+
+data Void
+
+test :: Maybe Void -> Maybe Void
+test
+  = \case
+        Nothing -> Nothing
+ + diff --git a/test/build/Issue200.md b/test/build/Issue200.md new file mode 100644 index 00000000..ee70716b --- /dev/null +++ b/test/build/Issue200.md @@ -0,0 +1,12 @@ +```haskell +{-# LANGUAGE LambdaCase #-} +module Issue200 where + +data Void + +test :: Maybe Void -> Maybe Void +test + = \case + Nothing -> Nothing + +``` diff --git a/test/build/Issue210.hs b/test/build/Issue210.hs new file mode 100644 index 00000000..6c874c21 --- /dev/null +++ b/test/build/Issue210.hs @@ -0,0 +1,31 @@ +module Issue210 where + +import Numeric.Natural (Natural) + +class Test a where + f :: a -> a + +instance Test Natural where + f n = h + where + g :: Natural + g = 3 + n + h :: Natural + h = n + g + +f1 :: Natural -> Natural +f1 n = h1 + where + g1 :: Natural + g1 = 3 + n + h1 :: Natural + h1 = n + g1 + +f2 :: Natural -> Natural +f2 n = h2 n + where + g2 :: Natural + g2 = 3 + n + h2 :: Natural -> Natural + h2 m = n + g2 + m + diff --git a/test/build/Issue210.html b/test/build/Issue210.html new file mode 100644 index 00000000..bcba604c --- /dev/null +++ b/test/build/Issue210.html @@ -0,0 +1,110 @@ + + + + + + + Issue210 + + + +
module Issue210 where
+
+import Numeric.Natural (Natural)
+
+class Test a where
+    f :: a -> a
+
+instance Test Natural where
+    f n = h
+      where
+        g :: Natural
+        g = 3 + n
+        h :: Natural
+        h = n + g
+
+f1 :: Natural -> Natural
+f1 n = h1
+  where
+    g1 :: Natural
+    g1 = 3 + n
+    h1 :: Natural
+    h1 = n + g1
+
+f2 :: Natural -> Natural
+f2 n = h2 n
+  where
+    g2 :: Natural
+    g2 = 3 + n
+    h2 :: Natural -> Natural
+    h2 m = n + g2 + m
+ + diff --git a/test/build/Issue210.md b/test/build/Issue210.md new file mode 100644 index 00000000..24a84d00 --- /dev/null +++ b/test/build/Issue210.md @@ -0,0 +1,33 @@ +```haskell +module Issue210 where + +import Numeric.Natural (Natural) + +class Test a where + f :: a -> a + +instance Test Natural where + f n = h + where + g :: Natural + g = 3 + n + h :: Natural + h = n + g + +f1 :: Natural -> Natural +f1 n = h1 + where + g1 :: Natural + g1 = 3 + n + h1 :: Natural + h1 = n + g1 + +f2 :: Natural -> Natural +f2 n = h2 n + where + g2 :: Natural + g2 = 3 + n + h2 :: Natural -> Natural + h2 m = n + g2 + m + +``` diff --git a/test/build/Issue218.hs b/test/build/Issue218.hs new file mode 100644 index 00000000..9366ab00 --- /dev/null +++ b/test/build/Issue218.hs @@ -0,0 +1,8 @@ +module Issue218 where + +foo :: Int -> Int +foo n = n + +bar :: Int +bar = foo 42 + diff --git a/test/build/Issue218.html b/test/build/Issue218.html new file mode 100644 index 00000000..69c186c6 --- /dev/null +++ b/test/build/Issue218.html @@ -0,0 +1,87 @@ + + + + + + + Issue218 + + + +
module Issue218 where
+
+foo :: Int -> Int
+foo n = n
+
+bar :: Int
+bar = foo 42
+ + diff --git a/test/build/Issue218.md b/test/build/Issue218.md new file mode 100644 index 00000000..a35a28ea --- /dev/null +++ b/test/build/Issue218.md @@ -0,0 +1,10 @@ +```haskell +module Issue218 where + +foo :: Int -> Int +foo n = n + +bar :: Int +bar = foo 42 + +``` diff --git a/test/build/Issue223.err b/test/build/Issue223.err new file mode 100644 index 00000000..868557d3 --- /dev/null +++ b/test/build/Issue223.err @@ -0,0 +1,2 @@ +test/Fail/Issue223.agda:6,1-5 +Functions defined with absurd patterns exclusively are not supported. Use function `error` from the Haskell.Prelude instead. diff --git a/test/build/Issue223.html b/test/build/Issue223.html new file mode 100644 index 00000000..78965685 --- /dev/null +++ b/test/build/Issue223.html @@ -0,0 +1,21 @@ + + + + + + + Issue223 + + + +
test/Fail/Issue223.agda:6,1-5
+Functions defined with absurd patterns exclusively are not supported. Use function `error` from the Haskell.Prelude instead.
+ + diff --git a/test/build/Issue223.md b/test/build/Issue223.md new file mode 100644 index 00000000..345063ee --- /dev/null +++ b/test/build/Issue223.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue223.agda:6,1-5 +Functions defined with absurd patterns exclusively are not supported. Use function `error` from the Haskell.Prelude instead. +``` diff --git a/test/build/Issue251.hs b/test/build/Issue251.hs new file mode 100644 index 00000000..4716ca47 --- /dev/null +++ b/test/build/Issue251.hs @@ -0,0 +1,8 @@ +module Issue251 where + +get :: Int -> Int +get x = x + +test :: Int +test = get 42 + diff --git a/test/build/Issue251.html b/test/build/Issue251.html new file mode 100644 index 00000000..98cf9cac --- /dev/null +++ b/test/build/Issue251.html @@ -0,0 +1,87 @@ + + + + + + + Issue251 + + + +
module Issue251 where
+
+get :: Int -> Int
+get x = x
+
+test :: Int
+test = get 42
+ + diff --git a/test/build/Issue251.md b/test/build/Issue251.md new file mode 100644 index 00000000..3fb4dedb --- /dev/null +++ b/test/build/Issue251.md @@ -0,0 +1,10 @@ +```haskell +module Issue251 where + +get :: Int -> Int +get x = x + +test :: Int +test = get 42 + +``` diff --git a/test/build/Issue264.hs b/test/build/Issue264.hs new file mode 100644 index 00000000..f1fd847f --- /dev/null +++ b/test/build/Issue264.hs @@ -0,0 +1,10 @@ +module Issue264 where + +data Term = Dummy + +reduce :: Term -> Term +reduce v = go v + where + go :: Term -> Term + go v = v + diff --git a/test/build/Issue264.html b/test/build/Issue264.html new file mode 100644 index 00000000..84d160b3 --- /dev/null +++ b/test/build/Issue264.html @@ -0,0 +1,89 @@ + + + + + + + Issue264 + + + +
module Issue264 where
+
+data Term = Dummy
+
+reduce :: Term -> Term
+reduce v = go v
+  where
+    go :: Term -> Term
+    go v = v
+ + diff --git a/test/build/Issue264.md b/test/build/Issue264.md new file mode 100644 index 00000000..4f6cb2ee --- /dev/null +++ b/test/build/Issue264.md @@ -0,0 +1,12 @@ +```haskell +module Issue264 where + +data Term = Dummy + +reduce :: Term -> Term +reduce v = go v + where + go :: Term -> Term + go v = v + +``` diff --git a/test/build/Issue273.hs b/test/build/Issue273.hs new file mode 100644 index 00000000..59a46f46 --- /dev/null +++ b/test/build/Issue273.hs @@ -0,0 +1,26 @@ +module Issue273 where + +test :: (Int, Int) -> Int +test = ((\ r -> snd r) $) + +mySnd :: (Int, Int) -> Int +mySnd x = snd x + +test2 :: (Int, Int) -> Int +test2 = (mySnd $) + +test3 :: (Int, Int) -> Int +test3 = \ x -> snd x + +test4 :: (Int, Int) -> Int +test4 = mySnd + +test5 :: (Int, Int) -> Int -> Int +test5 = \ x _ -> (\ r -> snd r) $ x + +test6 :: Int -> Int +test6 = ((1 + 1) `subtract`) + +test7 :: Int -> Int +test7 = (+ (1 - 1)) + diff --git a/test/build/Issue273.html b/test/build/Issue273.html new file mode 100644 index 00000000..95ca3147 --- /dev/null +++ b/test/build/Issue273.html @@ -0,0 +1,105 @@ + + + + + + + Issue273 + + + +
module Issue273 where
+
+test :: (Int, Int) -> Int
+test = ((\ r -> snd r) $)
+
+mySnd :: (Int, Int) -> Int
+mySnd x = snd x
+
+test2 :: (Int, Int) -> Int
+test2 = (mySnd $)
+
+test3 :: (Int, Int) -> Int
+test3 = \ x -> snd x
+
+test4 :: (Int, Int) -> Int
+test4 = mySnd
+
+test5 :: (Int, Int) -> Int -> Int
+test5 = \ x _ -> (\ r -> snd r) $ x
+
+test6 :: Int -> Int
+test6 = ((1 + 1) `subtract`)
+
+test7 :: Int -> Int
+test7 = (+ (1 - 1))
+ + diff --git a/test/build/Issue273.md b/test/build/Issue273.md new file mode 100644 index 00000000..7be1637b --- /dev/null +++ b/test/build/Issue273.md @@ -0,0 +1,28 @@ +```haskell +module Issue273 where + +test :: (Int, Int) -> Int +test = ((\ r -> snd r) $) + +mySnd :: (Int, Int) -> Int +mySnd x = snd x + +test2 :: (Int, Int) -> Int +test2 = (mySnd $) + +test3 :: (Int, Int) -> Int +test3 = \ x -> snd x + +test4 :: (Int, Int) -> Int +test4 = mySnd + +test5 :: (Int, Int) -> Int -> Int +test5 = \ x _ -> (\ r -> snd r) $ x + +test6 :: Int -> Int +test6 = ((1 + 1) `subtract`) + +test7 :: Int -> Int +test7 = (+ (1 - 1)) + +``` diff --git a/test/build/Issue286.hs b/test/build/Issue286.hs new file mode 100644 index 00000000..e7788051 --- /dev/null +++ b/test/build/Issue286.hs @@ -0,0 +1,5 @@ +module Issue286 where + +test :: Int +test = 42 + diff --git a/test/build/Issue286.html b/test/build/Issue286.html new file mode 100644 index 00000000..a5e1ddcc --- /dev/null +++ b/test/build/Issue286.html @@ -0,0 +1,84 @@ + + + + + + + Issue286 + + + +
module Issue286 where
+
+test :: Int
+test = 42
+ + diff --git a/test/build/Issue286.md b/test/build/Issue286.md new file mode 100644 index 00000000..8ca7771b --- /dev/null +++ b/test/build/Issue286.md @@ -0,0 +1,7 @@ +```haskell +module Issue286 where + +test :: Int +test = 42 + +``` diff --git a/test/build/Issue301.hs b/test/build/Issue301.hs new file mode 100644 index 00000000..0b4061ce --- /dev/null +++ b/test/build/Issue301.hs @@ -0,0 +1,16 @@ +module Issue301 where + +data MyData a = Nuttin' + +instance Foldable MyData where + foldMap _ _ = mempty + +(><) :: MyData a -> MyData a -> MyData a +_ >< _ = Nuttin' + +instance Semigroup (MyData a) where + (<>) = (><) + +instance Monoid (MyData a) where + mempty = Nuttin' + diff --git a/test/build/Issue301.html b/test/build/Issue301.html new file mode 100644 index 00000000..f40f5048 --- /dev/null +++ b/test/build/Issue301.html @@ -0,0 +1,95 @@ + + + + + + + Issue301 + + + +
module Issue301 where
+
+data MyData a = Nuttin'
+
+instance Foldable MyData where
+    foldMap _ _ = mempty
+
+(><) :: MyData a -> MyData a -> MyData a
+_ >< _ = Nuttin'
+
+instance Semigroup (MyData a) where
+    (<>) = (><)
+
+instance Monoid (MyData a) where
+    mempty = Nuttin'
+ + diff --git a/test/build/Issue301.md b/test/build/Issue301.md new file mode 100644 index 00000000..66236f68 --- /dev/null +++ b/test/build/Issue301.md @@ -0,0 +1,18 @@ +```haskell +module Issue301 where + +data MyData a = Nuttin' + +instance Foldable MyData where + foldMap _ _ = mempty + +(><) :: MyData a -> MyData a -> MyData a +_ >< _ = Nuttin' + +instance Semigroup (MyData a) where + (<>) = (><) + +instance Monoid (MyData a) where + mempty = Nuttin' + +``` diff --git a/test/build/Issue302.hs b/test/build/Issue302.hs new file mode 100644 index 00000000..03305844 --- /dev/null +++ b/test/build/Issue302.hs @@ -0,0 +1,5 @@ +module Issue302 where + +not0 :: Int -> Bool +not0 n = n /= 0 + diff --git a/test/build/Issue302.html b/test/build/Issue302.html new file mode 100644 index 00000000..399fc650 --- /dev/null +++ b/test/build/Issue302.html @@ -0,0 +1,84 @@ + + + + + + + Issue302 + + + +
module Issue302 where
+
+not0 :: Int -> Bool
+not0 n = n /= 0
+ + diff --git a/test/build/Issue302.md b/test/build/Issue302.md new file mode 100644 index 00000000..ab9550dc --- /dev/null +++ b/test/build/Issue302.md @@ -0,0 +1,7 @@ +```haskell +module Issue302 where + +not0 :: Int -> Bool +not0 n = n /= 0 + +``` diff --git a/test/build/Issue305.hs b/test/build/Issue305.hs new file mode 100644 index 00000000..b03a9189 --- /dev/null +++ b/test/build/Issue305.hs @@ -0,0 +1,32 @@ +module Issue305 where + +class Class a where + foo :: a -> a + +instance Class Int where + foo = (+ 1) + +instance Class Bool where + foo = not + +test :: Int +test = foo 41 + +anotherTest :: Int +anotherTest = test + +yetAnotherTest :: Int +yetAnotherTest + = case Just True of + Nothing -> error "unreachable" + Just y -> foo 5 + +andOneMoreTest :: Int -> Int +andOneMoreTest x = foo 5 + +class Class a => Subclass a where + bar :: a + +instance Subclass Bool where + bar = False + diff --git a/test/build/Issue305.html b/test/build/Issue305.html new file mode 100644 index 00000000..8c430a0b --- /dev/null +++ b/test/build/Issue305.html @@ -0,0 +1,111 @@ + + + + + + + Issue305 + + + +
module Issue305 where
+
+class Class a where
+    foo :: a -> a
+
+instance Class Int where
+    foo = (+ 1)
+
+instance Class Bool where
+    foo = not
+
+test :: Int
+test = foo 41
+
+anotherTest :: Int
+anotherTest = test
+
+yetAnotherTest :: Int
+yetAnotherTest
+  = case Just True of
+        Nothing -> error "unreachable"
+        Just y -> foo 5
+
+andOneMoreTest :: Int -> Int
+andOneMoreTest x = foo 5
+
+class Class a => Subclass a where
+    bar :: a
+
+instance Subclass Bool where
+    bar = False
+ + diff --git a/test/build/Issue305.md b/test/build/Issue305.md new file mode 100644 index 00000000..2714b624 --- /dev/null +++ b/test/build/Issue305.md @@ -0,0 +1,34 @@ +```haskell +module Issue305 where + +class Class a where + foo :: a -> a + +instance Class Int where + foo = (+ 1) + +instance Class Bool where + foo = not + +test :: Int +test = foo 41 + +anotherTest :: Int +anotherTest = test + +yetAnotherTest :: Int +yetAnotherTest + = case Just True of + Nothing -> error "unreachable" + Just y -> foo 5 + +andOneMoreTest :: Int -> Int +andOneMoreTest x = foo 5 + +class Class a => Subclass a where + bar :: a + +instance Subclass Bool where + bar = False + +``` diff --git a/test/build/Issue309.hs b/test/build/Issue309.hs new file mode 100644 index 00000000..f9dd5e19 --- /dev/null +++ b/test/build/Issue309.hs @@ -0,0 +1,4 @@ +module Issue309 where + +type Ap p = p + diff --git a/test/build/Issue309.html b/test/build/Issue309.html new file mode 100644 index 00000000..7ec07b8a --- /dev/null +++ b/test/build/Issue309.html @@ -0,0 +1,83 @@ + + + + + + + Issue309 + + + +
module Issue309 where
+
+type Ap p = p
+ + diff --git a/test/build/Issue309.md b/test/build/Issue309.md new file mode 100644 index 00000000..9cbab6b9 --- /dev/null +++ b/test/build/Issue309.md @@ -0,0 +1,6 @@ +```haskell +module Issue309 where + +type Ap p = p + +``` diff --git a/test/build/Issue317.hs b/test/build/Issue317.hs new file mode 100644 index 00000000..d9a23a06 --- /dev/null +++ b/test/build/Issue317.hs @@ -0,0 +1,7 @@ +module Issue317 where + +data D = C{unC :: Int} + +test :: D -> D +test d = (C . \ r -> unC r) $ d + diff --git a/test/build/Issue317.html b/test/build/Issue317.html new file mode 100644 index 00000000..f580e845 --- /dev/null +++ b/test/build/Issue317.html @@ -0,0 +1,86 @@ + + + + + + + Issue317 + + + +
module Issue317 where
+
+data D = C{unC :: Int}
+
+test :: D -> D
+test d = (C . \ r -> unC r) $ d
+ + diff --git a/test/build/Issue317.md b/test/build/Issue317.md new file mode 100644 index 00000000..040bc970 --- /dev/null +++ b/test/build/Issue317.md @@ -0,0 +1,9 @@ +```haskell +module Issue317 where + +data D = C{unC :: Int} + +test :: D -> D +test d = (C . \ r -> unC r) $ d + +``` diff --git a/test/build/Issue357a.err b/test/build/Issue357a.err new file mode 100644 index 00000000..eb7dfc0d --- /dev/null +++ b/test/build/Issue357a.err @@ -0,0 +1,2 @@ +test/Fail/Issue357a.agda:10,1-6 +Bad Haskell type: Level diff --git a/test/build/Issue357a.html b/test/build/Issue357a.html new file mode 100644 index 00000000..5389e0e0 --- /dev/null +++ b/test/build/Issue357a.html @@ -0,0 +1,21 @@ + + + + + + + Issue357a + + + +
test/Fail/Issue357a.agda:10,1-6
+Bad Haskell type: Level
+ + diff --git a/test/build/Issue357a.md b/test/build/Issue357a.md new file mode 100644 index 00000000..4ed18f33 --- /dev/null +++ b/test/build/Issue357a.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue357a.agda:10,1-6 +Bad Haskell type: Level +``` diff --git a/test/build/Issue357b.err b/test/build/Issue357b.err new file mode 100644 index 00000000..8a7dac2a --- /dev/null +++ b/test/build/Issue357b.err @@ -0,0 +1,2 @@ +test/Fail/Issue357b.agda:10,1-2 +Bad Haskell type: Level diff --git a/test/build/Issue357b.html b/test/build/Issue357b.html new file mode 100644 index 00000000..0986681c --- /dev/null +++ b/test/build/Issue357b.html @@ -0,0 +1,21 @@ + + + + + + + Issue357b + + + +
test/Fail/Issue357b.agda:10,1-2
+Bad Haskell type: Level
+ + diff --git a/test/build/Issue357b.md b/test/build/Issue357b.md new file mode 100644 index 00000000..b5cd771a --- /dev/null +++ b/test/build/Issue357b.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue357b.agda:10,1-2 +Bad Haskell type: Level +``` diff --git a/test/build/Issue65.hs b/test/build/Issue65.hs new file mode 100644 index 00000000..4eabddb3 --- /dev/null +++ b/test/build/Issue65.hs @@ -0,0 +1,9 @@ +module Issue65 where + +yeet :: Bool -> a -> a -> a +yeet False x y = y +yeet True x y = x + +xx :: Int +xx = yeet True 1 2 + diff --git a/test/build/Issue65.html b/test/build/Issue65.html new file mode 100644 index 00000000..6f5099f6 --- /dev/null +++ b/test/build/Issue65.html @@ -0,0 +1,88 @@ + + + + + + + Issue65 + + + +
module Issue65 where
+
+yeet :: Bool -> a -> a -> a
+yeet False x y = y
+yeet True x y = x
+
+xx :: Int
+xx = yeet True 1 2
+ + diff --git a/test/build/Issue65.md b/test/build/Issue65.md new file mode 100644 index 00000000..f20e71ec --- /dev/null +++ b/test/build/Issue65.md @@ -0,0 +1,11 @@ +```haskell +module Issue65 where + +yeet :: Bool -> a -> a -> a +yeet False x y = y +yeet True x y = x + +xx :: Int +xx = yeet True 1 2 + +``` diff --git a/test/build/Issue69.hs b/test/build/Issue69.hs new file mode 100644 index 00000000..7c8d5ef7 --- /dev/null +++ b/test/build/Issue69.hs @@ -0,0 +1,11 @@ +module Issue69 where + +import Numeric.Natural (Natural) + +data Map k a = Bin Natural k a (Map k a) (Map k a) + | Tip + +size :: Map k a -> Natural +size Tip = 0 +size (Bin sz _ _ _ _) = sz + diff --git a/test/build/Issue69.html b/test/build/Issue69.html new file mode 100644 index 00000000..977cbe45 --- /dev/null +++ b/test/build/Issue69.html @@ -0,0 +1,90 @@ + + + + + + + Issue69 + + + +
module Issue69 where
+
+import Numeric.Natural (Natural)
+
+data Map k a = Bin Natural k a (Map k a) (Map k a)
+             | Tip
+
+size :: Map k a -> Natural
+size Tip = 0
+size (Bin sz _ _ _ _) = sz
+ + diff --git a/test/build/Issue69.md b/test/build/Issue69.md new file mode 100644 index 00000000..de04a0c3 --- /dev/null +++ b/test/build/Issue69.md @@ -0,0 +1,13 @@ +```haskell +module Issue69 where + +import Numeric.Natural (Natural) + +data Map k a = Bin Natural k a (Map k a) (Map k a) + | Tip + +size :: Map k a -> Natural +size Tip = 0 +size (Bin sz _ _ _ _) = sz + +``` diff --git a/test/build/Issue71.err b/test/build/Issue71.err new file mode 100644 index 00000000..256c6a8c --- /dev/null +++ b/test/build/Issue71.err @@ -0,0 +1,2 @@ +test/Fail/Issue71.agda:8,28-11,4 +not supported by agda2hs: as patterns diff --git a/test/build/Issue71.html b/test/build/Issue71.html new file mode 100644 index 00000000..3ef940df --- /dev/null +++ b/test/build/Issue71.html @@ -0,0 +1,21 @@ + + + + + + + Issue71 + + + +
test/Fail/Issue71.agda:8,28-11,4
+not supported by agda2hs: as patterns
+ + diff --git a/test/build/Issue71.md b/test/build/Issue71.md new file mode 100644 index 00000000..a4be0ca9 --- /dev/null +++ b/test/build/Issue71.md @@ -0,0 +1,4 @@ +``` +test/Fail/Issue71.agda:8,28-11,4 +not supported by agda2hs: as patterns +``` diff --git a/test/build/Issue73.hs b/test/build/Issue73.hs new file mode 100644 index 00000000..705c8b86 --- /dev/null +++ b/test/build/Issue73.hs @@ -0,0 +1,5 @@ +module Issue73 where + +class ImplicitField a where + aField :: a + diff --git a/test/build/Issue73.html b/test/build/Issue73.html new file mode 100644 index 00000000..9b933c29 --- /dev/null +++ b/test/build/Issue73.html @@ -0,0 +1,84 @@ + + + + + + + Issue73 + + + +
module Issue73 where
+
+class ImplicitField a where
+    aField :: a
+ + diff --git a/test/build/Issue73.md b/test/build/Issue73.md new file mode 100644 index 00000000..e2330489 --- /dev/null +++ b/test/build/Issue73.md @@ -0,0 +1,7 @@ +```haskell +module Issue73 where + +class ImplicitField a where + aField :: a + +``` diff --git a/test/build/Issue90.hs b/test/build/Issue90.hs new file mode 100644 index 00000000..76af7d63 --- /dev/null +++ b/test/build/Issue90.hs @@ -0,0 +1,72 @@ +module Issue90 where + +import Numeric.Natural (Natural) + +good :: Natural +good = bar + where + foo :: Natural + foo = 42 + bar :: Natural + bar = foo + +bad :: Natural +bad = bar + where + bar :: Natural + bar = foo + foo :: Natural + foo = 42 + +good2 :: Natural +good2 = bar + where + foo :: Natural + foo = 42 + x + where + x :: Natural + x = 1 + bar :: Natural + bar = foo + x + where + x :: Natural + x = 2 + +bad2 :: Natural +bad2 = bar + where + bar :: Natural + bar = foo + x + where + x :: Natural + x = 2 + foo :: Natural + foo = 42 + x + where + x :: Natural + x = 1 + +test :: Bool -> Natural +test True = bar + where + foo :: Natural + foo = 42 + ted + where + nes :: Natural + nes = 1 + ted :: Natural + ted = nes + 1 + bar :: Natural + bar = foo +test False = bar + where + bar :: Natural + bar = foo + foo :: Natural + foo = 42 + ted + where + ted :: Natural + ted = nes + 1 + nes :: Natural + nes = 1 + diff --git a/test/build/Issue90.html b/test/build/Issue90.html new file mode 100644 index 00000000..f0b29acc --- /dev/null +++ b/test/build/Issue90.html @@ -0,0 +1,151 @@ + + + + + + + Issue90 + + + +
module Issue90 where
+
+import Numeric.Natural (Natural)
+
+good :: Natural
+good = bar
+  where
+    foo :: Natural
+    foo = 42
+    bar :: Natural
+    bar = foo
+
+bad :: Natural
+bad = bar
+  where
+    bar :: Natural
+    bar = foo
+    foo :: Natural
+    foo = 42
+
+good2 :: Natural
+good2 = bar
+  where
+    foo :: Natural
+    foo = 42 + x
+      where
+        x :: Natural
+        x = 1
+    bar :: Natural
+    bar = foo + x
+      where
+        x :: Natural
+        x = 2
+
+bad2 :: Natural
+bad2 = bar
+  where
+    bar :: Natural
+    bar = foo + x
+      where
+        x :: Natural
+        x = 2
+    foo :: Natural
+    foo = 42 + x
+      where
+        x :: Natural
+        x = 1
+
+test :: Bool -> Natural
+test True = bar
+  where
+    foo :: Natural
+    foo = 42 + ted
+      where
+        nes :: Natural
+        nes = 1
+        ted :: Natural
+        ted = nes + 1
+    bar :: Natural
+    bar = foo
+test False = bar
+  where
+    bar :: Natural
+    bar = foo
+    foo :: Natural
+    foo = 42 + ted
+      where
+        ted :: Natural
+        ted = nes + 1
+        nes :: Natural
+        nes = 1
+ + diff --git a/test/build/Issue90.md b/test/build/Issue90.md new file mode 100644 index 00000000..013c8eb2 --- /dev/null +++ b/test/build/Issue90.md @@ -0,0 +1,74 @@ +```haskell +module Issue90 where + +import Numeric.Natural (Natural) + +good :: Natural +good = bar + where + foo :: Natural + foo = 42 + bar :: Natural + bar = foo + +bad :: Natural +bad = bar + where + bar :: Natural + bar = foo + foo :: Natural + foo = 42 + +good2 :: Natural +good2 = bar + where + foo :: Natural + foo = 42 + x + where + x :: Natural + x = 1 + bar :: Natural + bar = foo + x + where + x :: Natural + x = 2 + +bad2 :: Natural +bad2 = bar + where + bar :: Natural + bar = foo + x + where + x :: Natural + x = 2 + foo :: Natural + foo = 42 + x + where + x :: Natural + x = 1 + +test :: Bool -> Natural +test True = bar + where + foo :: Natural + foo = 42 + ted + where + nes :: Natural + nes = 1 + ted :: Natural + ted = nes + 1 + bar :: Natural + bar = foo +test False = bar + where + bar :: Natural + bar = foo + foo :: Natural + foo = 42 + ted + where + ted :: Natural + ted = nes + 1 + nes :: Natural + nes = 1 + +``` diff --git a/test/build/Issue92.hs b/test/build/Issue92.hs new file mode 100644 index 00000000..b932f288 --- /dev/null +++ b/test/build/Issue92.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Issue92 where + +foo :: forall a . a -> a +foo x = bar + where + bar :: a + bar = baz + where + baz :: a + baz = x + diff --git a/test/build/Issue92.html b/test/build/Issue92.html new file mode 100644 index 00000000..58133a06 --- /dev/null +++ b/test/build/Issue92.html @@ -0,0 +1,91 @@ + + + + + + + Issue92 + + + +
{-# LANGUAGE ScopedTypeVariables #-}
+module Issue92 where
+
+foo :: forall a . a -> a
+foo x = bar
+  where
+    bar :: a
+    bar = baz
+      where
+        baz :: a
+        baz = x
+ + diff --git a/test/build/Issue92.md b/test/build/Issue92.md new file mode 100644 index 00000000..ad18d33f --- /dev/null +++ b/test/build/Issue92.md @@ -0,0 +1,14 @@ +```haskell +{-# LANGUAGE ScopedTypeVariables #-} +module Issue92 where + +foo :: forall a . a -> a +foo x = bar + where + bar :: a + bar = baz + where + baz :: a + baz = x + +``` diff --git a/test/build/Issue93.hs b/test/build/Issue93.hs new file mode 100644 index 00000000..a6de6f80 --- /dev/null +++ b/test/build/Issue93.hs @@ -0,0 +1,26 @@ +module Issue93 where + +fun :: Bool -> Bool +fun x + = case x of + True -> False + False -> y + where + y :: Bool + y = True + +nested :: Maybe Bool -> Bool +nested x + = case x of + Just b -> case y of + True -> b + False -> z + Nothing -> y + where + y :: Bool + y = True + z :: Bool + z = case y of + True -> y + False -> True + diff --git a/test/build/Issue93.html b/test/build/Issue93.html new file mode 100644 index 00000000..21e6049e --- /dev/null +++ b/test/build/Issue93.html @@ -0,0 +1,105 @@ + + + + + + + Issue93 + + + +
module Issue93 where
+
+fun :: Bool -> Bool
+fun x
+  = case x of
+        True -> False
+        False -> y
+  where
+    y :: Bool
+    y = True
+
+nested :: Maybe Bool -> Bool
+nested x
+  = case x of
+        Just b -> case y of
+                      True -> b
+                      False -> z
+        Nothing -> y
+  where
+    y :: Bool
+    y = True
+    z :: Bool
+    z = case y of
+            True -> y
+            False -> True
+ + diff --git a/test/build/Issue93.md b/test/build/Issue93.md new file mode 100644 index 00000000..d60f07dc --- /dev/null +++ b/test/build/Issue93.md @@ -0,0 +1,28 @@ +```haskell +module Issue93 where + +fun :: Bool -> Bool +fun x + = case x of + True -> False + False -> y + where + y :: Bool + y = True + +nested :: Maybe Bool -> Bool +nested x + = case x of + Just b -> case y of + True -> b + False -> z + Nothing -> y + where + y :: Bool + y = True + z :: Bool + z = case y of + True -> y + False -> True + +``` diff --git a/test/build/Issue94.hs b/test/build/Issue94.hs new file mode 100644 index 00000000..434e9c80 --- /dev/null +++ b/test/build/Issue94.hs @@ -0,0 +1,8 @@ +module Issue94 where + +thing :: [a] -> [a] +thing xs = aux xs + where + aux :: [a] -> [a] + aux xs = xs + diff --git a/test/build/Issue94.html b/test/build/Issue94.html new file mode 100644 index 00000000..578d8e32 --- /dev/null +++ b/test/build/Issue94.html @@ -0,0 +1,87 @@ + + + + + + + Issue94 + + + +
module Issue94 where
+
+thing :: [a] -> [a]
+thing xs = aux xs
+  where
+    aux :: [a] -> [a]
+    aux xs = xs
+ + diff --git a/test/build/Issue94.md b/test/build/Issue94.md new file mode 100644 index 00000000..ec972f39 --- /dev/null +++ b/test/build/Issue94.md @@ -0,0 +1,10 @@ +```haskell +module Issue94 where + +thing :: [a] -> [a] +thing xs = aux xs + where + aux :: [a] -> [a] + aux xs = xs + +``` diff --git a/test/build/Kinds.hs b/test/build/Kinds.hs new file mode 100644 index 00000000..9c14987b --- /dev/null +++ b/test/build/Kinds.hs @@ -0,0 +1,6 @@ +module Kinds where + +data ReaderT r m a = RdrT{runReaderT :: r -> m a} + +data Kleisli m a b = K (a -> m b) + diff --git a/test/build/Kinds.html b/test/build/Kinds.html new file mode 100644 index 00000000..b7d5016a --- /dev/null +++ b/test/build/Kinds.html @@ -0,0 +1,85 @@ + + + + + + + Kinds + + + +
module Kinds where
+
+data ReaderT r m a = RdrT{runReaderT :: r -> m a}
+
+data Kleisli m a b = K (a -> m b)
+ + diff --git a/test/build/Kinds.md b/test/build/Kinds.md new file mode 100644 index 00000000..d67e5fde --- /dev/null +++ b/test/build/Kinds.md @@ -0,0 +1,8 @@ +```haskell +module Kinds where + +data ReaderT r m a = RdrT{runReaderT :: r -> m a} + +data Kleisli m a b = K (a -> m b) + +``` diff --git a/test/build/LanguageConstructs.hs b/test/build/LanguageConstructs.hs new file mode 100644 index 00000000..9220862f --- /dev/null +++ b/test/build/LanguageConstructs.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE LambdaCase #-} +module LanguageConstructs where + +oneTwoThree :: [Int] +oneTwoThree = [1, 2, 3] + +exactlyTwo :: [a] -> Maybe (a, a) +exactlyTwo [x, y] = Just (x, y) +exactlyTwo _ = Nothing + +ifThenElse :: Int -> String +ifThenElse n = if n >= 10 then "big" else "small" + +maybeToList :: Maybe a -> [a] +maybeToList + = \case + Nothing -> [] + Just x -> [x] + +mhead :: [a] -> Maybe a +mhead xs + = case xs of + [] -> Nothing + x : _ -> Just x + +plus5minus5 :: Int -> Int +plus5minus5 n + = case n + 5 of + m -> m - 5 + +enum₁ :: [Int] +enum₁ = [5 .. 10] + +enum₂ :: [Integer] +enum₂ = [10, 20 .. 100] + +enum₃ :: [Bool] +enum₃ = [False ..] + +enum₄ :: [Ordering] +enum₄ = [LT, EQ ..] + +underappliedEnum :: [Int] -> [[Int]] +underappliedEnum = map (enumFromTo 1) + diff --git a/test/build/LanguageConstructs.html b/test/build/LanguageConstructs.html new file mode 100644 index 00000000..a45d1e66 --- /dev/null +++ b/test/build/LanguageConstructs.html @@ -0,0 +1,124 @@ + + + + + + + LanguageConstructs + + + +
{-# LANGUAGE LambdaCase #-}
+module LanguageConstructs where
+
+oneTwoThree :: [Int]
+oneTwoThree = [1, 2, 3]
+
+exactlyTwo :: [a] -> Maybe (a, a)
+exactlyTwo [x, y] = Just (x, y)
+exactlyTwo _ = Nothing
+
+ifThenElse :: Int -> String
+ifThenElse n = if n >= 10 then "big" else "small"
+
+maybeToList :: Maybe a -> [a]
+maybeToList
+  = \case
+        Nothing -> []
+        Just x -> [x]
+
+mhead :: [a] -> Maybe a
+mhead xs
+  = case xs of
+        [] -> Nothing
+        x : _ -> Just x
+
+plus5minus5 :: Int -> Int
+plus5minus5 n
+  = case n + 5 of
+        m -> m - 5
+
+enum₁ :: [Int]
+enum₁ = [5 .. 10]
+
+enum₂ :: [Integer]
+enum₂ = [10, 20 .. 100]
+
+enum₃ :: [Bool]
+enum₃ = [False ..]
+
+enum₄ :: [Ordering]
+enum₄ = [LT, EQ ..]
+
+underappliedEnum :: [Int] -> [[Int]]
+underappliedEnum = map (enumFromTo 1)
+ + diff --git a/test/build/LanguageConstructs.md b/test/build/LanguageConstructs.md new file mode 100644 index 00000000..f61de409 --- /dev/null +++ b/test/build/LanguageConstructs.md @@ -0,0 +1,47 @@ +```haskell +{-# LANGUAGE LambdaCase #-} +module LanguageConstructs where + +oneTwoThree :: [Int] +oneTwoThree = [1, 2, 3] + +exactlyTwo :: [a] -> Maybe (a, a) +exactlyTwo [x, y] = Just (x, y) +exactlyTwo _ = Nothing + +ifThenElse :: Int -> String +ifThenElse n = if n >= 10 then "big" else "small" + +maybeToList :: Maybe a -> [a] +maybeToList + = \case + Nothing -> [] + Just x -> [x] + +mhead :: [a] -> Maybe a +mhead xs + = case xs of + [] -> Nothing + x : _ -> Just x + +plus5minus5 :: Int -> Int +plus5minus5 n + = case n + 5 of + m -> m - 5 + +enum₁ :: [Int] +enum₁ = [5 .. 10] + +enum₂ :: [Integer] +enum₂ = [10, 20 .. 100] + +enum₃ :: [Bool] +enum₃ = [False ..] + +enum₄ :: [Ordering] +enum₄ = [LT, EQ ..] + +underappliedEnum :: [Int] -> [[Int]] +underappliedEnum = map (enumFromTo 1) + +``` diff --git a/test/build/LawfulOrd.hs b/test/build/LawfulOrd.hs new file mode 100644 index 00000000..07efa120 --- /dev/null +++ b/test/build/LawfulOrd.hs @@ -0,0 +1,11 @@ +module LawfulOrd where + +data Ordered a = Gt a a + | Lt a a + | E a a + +order :: Ord a => a -> a -> Ordered a +order left right + = if left < right then Lt left right else + if left == right then E left right else Gt left right + diff --git a/test/build/LawfulOrd.html b/test/build/LawfulOrd.html new file mode 100644 index 00000000..a2a584e9 --- /dev/null +++ b/test/build/LawfulOrd.html @@ -0,0 +1,90 @@ + + + + + + + LawfulOrd + + + +
module LawfulOrd where
+
+data Ordered a = Gt a a
+               | Lt a a
+               | E a a
+
+order :: Ord a => a -> a -> Ordered a
+order left right
+  = if left < right then Lt left right else
+      if left == right then E left right else Gt left right
+ + diff --git a/test/build/LawfulOrd.md b/test/build/LawfulOrd.md new file mode 100644 index 00000000..4a9658b9 --- /dev/null +++ b/test/build/LawfulOrd.md @@ -0,0 +1,13 @@ +```haskell +module LawfulOrd where + +data Ordered a = Gt a a + | Lt a a + | E a a + +order :: Ord a => a -> a -> Ordered a +order left right + = if left < right then Lt left right else + if left == right then E left right else Gt left right + +``` diff --git a/test/build/LiteralPatterns.hs b/test/build/LiteralPatterns.hs new file mode 100644 index 00000000..185630bd --- /dev/null +++ b/test/build/LiteralPatterns.hs @@ -0,0 +1,11 @@ +module LiteralPatterns where + +testInt :: Integer -> Bool +testInt 10 = True +testInt (-8) = True +testInt _ = False + +testChar :: Char -> Bool +testChar 'c' = True +testChar _ = False + diff --git a/test/build/LiteralPatterns.html b/test/build/LiteralPatterns.html new file mode 100644 index 00000000..42e5df99 --- /dev/null +++ b/test/build/LiteralPatterns.html @@ -0,0 +1,90 @@ + + + + + + + LiteralPatterns + + + +
module LiteralPatterns where
+
+testInt :: Integer -> Bool
+testInt 10 = True
+testInt (-8) = True
+testInt _ = False
+
+testChar :: Char -> Bool
+testChar 'c' = True
+testChar _ = False
+ + diff --git a/test/build/LiteralPatterns.md b/test/build/LiteralPatterns.md new file mode 100644 index 00000000..6d297568 --- /dev/null +++ b/test/build/LiteralPatterns.md @@ -0,0 +1,13 @@ +```haskell +module LiteralPatterns where + +testInt :: Integer -> Bool +testInt 10 = True +testInt (-8) = True +testInt _ = False + +testChar :: Char -> Bool +testChar 'c' = True +testChar _ = False + +``` diff --git a/test/build/MatchOnDelay.err b/test/build/MatchOnDelay.err new file mode 100644 index 00000000..468a5242 --- /dev/null +++ b/test/build/MatchOnDelay.err @@ -0,0 +1,2 @@ +test/Fail/MatchOnDelay.agda:7,1-4 +constructor `now` not supported in patterns diff --git a/test/build/MatchOnDelay.html b/test/build/MatchOnDelay.html new file mode 100644 index 00000000..d9e489ae --- /dev/null +++ b/test/build/MatchOnDelay.html @@ -0,0 +1,21 @@ + + + + + + + MatchOnDelay + + + +
test/Fail/MatchOnDelay.agda:7,1-4
+constructor `now` not supported in patterns
+ + diff --git a/test/build/MatchOnDelay.md b/test/build/MatchOnDelay.md new file mode 100644 index 00000000..a9280183 --- /dev/null +++ b/test/build/MatchOnDelay.md @@ -0,0 +1,4 @@ +``` +test/Fail/MatchOnDelay.agda:7,1-4 +constructor `now` not supported in patterns +``` diff --git a/test/build/ModuleParameters.hs b/test/build/ModuleParameters.hs new file mode 100644 index 00000000..8705650c --- /dev/null +++ b/test/build/ModuleParameters.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module ModuleParameters where + +data Scope p = Empty + | Bind p (Scope p) + +unbind :: forall p . Scope p -> Scope p +unbind Empty = Empty +unbind (Bind _ s) = s + +thing :: forall p a . a -> a +thing x = y + where + y :: a + y = x + +stuff :: forall p a . a -> Scope p -> a +stuff x Empty = x +stuff x (Bind _ _) = x + +more :: forall p a b . b -> a -> Scope p -> Scope p +more _ _ Empty = Empty +more _ _ (Bind _ s) = s + diff --git a/test/build/ModuleParameters.html b/test/build/ModuleParameters.html new file mode 100644 index 00000000..a290b074 --- /dev/null +++ b/test/build/ModuleParameters.html @@ -0,0 +1,103 @@ + + + + + + + ModuleParameters + + + +
{-# LANGUAGE ScopedTypeVariables #-}
+module ModuleParameters where
+
+data Scope p = Empty
+             | Bind p (Scope p)
+
+unbind :: forall p . Scope p -> Scope p
+unbind Empty = Empty
+unbind (Bind _ s) = s
+
+thing :: forall p a . a -> a
+thing x = y
+  where
+    y :: a
+    y = x
+
+stuff :: forall p a . a -> Scope p -> a
+stuff x Empty = x
+stuff x (Bind _ _) = x
+
+more :: forall p a b . b -> a -> Scope p -> Scope p
+more _ _ Empty = Empty
+more _ _ (Bind _ s) = s
+ + diff --git a/test/build/ModuleParameters.md b/test/build/ModuleParameters.md new file mode 100644 index 00000000..8c5f52f1 --- /dev/null +++ b/test/build/ModuleParameters.md @@ -0,0 +1,26 @@ +```haskell +{-# LANGUAGE ScopedTypeVariables #-} +module ModuleParameters where + +data Scope p = Empty + | Bind p (Scope p) + +unbind :: forall p . Scope p -> Scope p +unbind Empty = Empty +unbind (Bind _ s) = s + +thing :: forall p a . a -> a +thing x = y + where + y :: a + y = x + +stuff :: forall p a . a -> Scope p -> a +stuff x Empty = x +stuff x (Bind _ _) = x + +more :: forall p a b . b -> a -> Scope p -> Scope p +more _ _ Empty = Empty +more _ _ (Bind _ s) = s + +``` diff --git a/test/build/ModuleParametersImports.hs b/test/build/ModuleParametersImports.hs new file mode 100644 index 00000000..83c2c5be --- /dev/null +++ b/test/build/ModuleParametersImports.hs @@ -0,0 +1,11 @@ +module ModuleParametersImports where + +import qualified ModuleParameters (Scope(Bind, Empty), unbind) +import Numeric.Natural (Natural) + +scope :: ModuleParameters.Scope Natural +scope + = ModuleParameters.unbind + (ModuleParameters.Bind 3 + (ModuleParameters.Bind 2 ModuleParameters.Empty)) + diff --git a/test/build/ModuleParametersImports.html b/test/build/ModuleParametersImports.html new file mode 100644 index 00000000..91d15583 --- /dev/null +++ b/test/build/ModuleParametersImports.html @@ -0,0 +1,90 @@ + + + + + + + ModuleParametersImports + + + +
module ModuleParametersImports where
+
+import qualified ModuleParameters (Scope(Bind, Empty), unbind)
+import Numeric.Natural (Natural)
+
+scope :: ModuleParameters.Scope Natural
+scope
+  = ModuleParameters.unbind
+      (ModuleParameters.Bind 3
+         (ModuleParameters.Bind 2 ModuleParameters.Empty))
+ + diff --git a/test/build/ModuleParametersImports.md b/test/build/ModuleParametersImports.md new file mode 100644 index 00000000..4c8ef884 --- /dev/null +++ b/test/build/ModuleParametersImports.md @@ -0,0 +1,13 @@ +```haskell +module ModuleParametersImports where + +import qualified ModuleParameters (Scope(Bind, Empty), unbind) +import Numeric.Natural (Natural) + +scope :: ModuleParameters.Scope Natural +scope + = ModuleParameters.unbind + (ModuleParameters.Bind 3 + (ModuleParameters.Bind 2 ModuleParameters.Empty)) + +``` diff --git a/test/build/MultiArgumentPatternLambda.err b/test/build/MultiArgumentPatternLambda.err new file mode 100644 index 00000000..459d3626 --- /dev/null +++ b/test/build/MultiArgumentPatternLambda.err @@ -0,0 +1,2 @@ +test/Fail/MultiArgumentPatternLambda.agda:7,15-9,41 +Pattern matching lambdas must take a single argument diff --git a/test/build/MultiArgumentPatternLambda.html b/test/build/MultiArgumentPatternLambda.html new file mode 100644 index 00000000..cbd5a50f --- /dev/null +++ b/test/build/MultiArgumentPatternLambda.html @@ -0,0 +1,21 @@ + + + + + + + MultiArgumentPatternLambda + + + +
test/Fail/MultiArgumentPatternLambda.agda:7,15-9,41
+Pattern matching lambdas must take a single argument
+ + diff --git a/test/build/MultiArgumentPatternLambda.md b/test/build/MultiArgumentPatternLambda.md new file mode 100644 index 00000000..bfe769db --- /dev/null +++ b/test/build/MultiArgumentPatternLambda.md @@ -0,0 +1,4 @@ +``` +test/Fail/MultiArgumentPatternLambda.agda:7,15-9,41 +Pattern matching lambdas must take a single argument +``` diff --git a/test/build/NewTypePragma.hs b/test/build/NewTypePragma.hs new file mode 100644 index 00000000..ece73161 --- /dev/null +++ b/test/build/NewTypePragma.hs @@ -0,0 +1,29 @@ +module NewTypePragma where + +-- data newtype + +newtype Indexed a = MkIndexed (Int, a) + +index :: (Int, a) -> Indexed a +index = MkIndexed + +-- data newtype with deriving + +newtype Pair a b = MkPair (a, b) + deriving (Show, Eq) + +-- record newtype + +newtype Identity a = MkIdentity{runIdentity :: a} + +-- record newtype with erased proof + +newtype Equal a = MkEqual{pair :: (a, a)} + +-- record newtype with same name + +newtype Duo a = Duo{duo :: (a, a)} + +createDuo :: a -> a -> Duo a +createDuo a b = Duo (a, b) + diff --git a/test/build/NewTypePragma.html b/test/build/NewTypePragma.html new file mode 100644 index 00000000..2ab38a90 --- /dev/null +++ b/test/build/NewTypePragma.html @@ -0,0 +1,108 @@ + + + + + + + NewTypePragma + + + +
module NewTypePragma where
+
+-- data newtype
+
+newtype Indexed a = MkIndexed (Int, a)
+
+index :: (Int, a) -> Indexed a
+index = MkIndexed
+
+-- data newtype with deriving
+
+newtype Pair a b = MkPair (a, b)
+                     deriving (Show, Eq)
+
+-- record newtype
+
+newtype Identity a = MkIdentity{runIdentity :: a}
+
+-- record newtype with erased proof
+
+newtype Equal a = MkEqual{pair :: (a, a)}
+
+-- record newtype with same name
+
+newtype Duo a = Duo{duo :: (a, a)}
+
+createDuo :: a -> a -> Duo a
+createDuo a b = Duo (a, b)
+ + diff --git a/test/build/NewTypePragma.md b/test/build/NewTypePragma.md new file mode 100644 index 00000000..8e9a5a80 --- /dev/null +++ b/test/build/NewTypePragma.md @@ -0,0 +1,31 @@ +```haskell +module NewTypePragma where + +-- data newtype + +newtype Indexed a = MkIndexed (Int, a) + +index :: (Int, a) -> Indexed a +index = MkIndexed + +-- data newtype with deriving + +newtype Pair a b = MkPair (a, b) + deriving (Show, Eq) + +-- record newtype + +newtype Identity a = MkIdentity{runIdentity :: a} + +-- record newtype with erased proof + +newtype Equal a = MkEqual{pair :: (a, a)} + +-- record newtype with same name + +newtype Duo a = Duo{duo :: (a, a)} + +createDuo :: a -> a -> Duo a +createDuo a b = Duo (a, b) + +``` diff --git a/test/build/NewTypeRecordTwoFields.err b/test/build/NewTypeRecordTwoFields.err new file mode 100644 index 00000000..082d404a --- /dev/null +++ b/test/build/NewTypeRecordTwoFields.err @@ -0,0 +1,2 @@ +test/Fail/NewTypeRecordTwoFields.agda:5,8-11 +Newtype must have exactly one field in constructor: MkDuo diff --git a/test/build/NewTypeRecordTwoFields.html b/test/build/NewTypeRecordTwoFields.html new file mode 100644 index 00000000..71d969ed --- /dev/null +++ b/test/build/NewTypeRecordTwoFields.html @@ -0,0 +1,21 @@ + + + + + + + NewTypeRecordTwoFields + + + +
test/Fail/NewTypeRecordTwoFields.agda:5,8-11
+Newtype must have exactly one field in constructor: MkDuo
+ + diff --git a/test/build/NewTypeRecordTwoFields.md b/test/build/NewTypeRecordTwoFields.md new file mode 100644 index 00000000..c8b4ae3a --- /dev/null +++ b/test/build/NewTypeRecordTwoFields.md @@ -0,0 +1,4 @@ +``` +test/Fail/NewTypeRecordTwoFields.agda:5,8-11 +Newtype must have exactly one field in constructor: MkDuo +``` diff --git a/test/build/NewTypeTwoConstructors.err b/test/build/NewTypeTwoConstructors.err new file mode 100644 index 00000000..2f3d0cdf --- /dev/null +++ b/test/build/NewTypeTwoConstructors.err @@ -0,0 +1,2 @@ +test/Fail/NewTypeTwoConstructors.agda:5,6-12 +Newtype must have exactly one constructor in definition: Choice diff --git a/test/build/NewTypeTwoConstructors.html b/test/build/NewTypeTwoConstructors.html new file mode 100644 index 00000000..0cf4df7d --- /dev/null +++ b/test/build/NewTypeTwoConstructors.html @@ -0,0 +1,21 @@ + + + + + + + NewTypeTwoConstructors + + + +
test/Fail/NewTypeTwoConstructors.agda:5,6-12
+Newtype must have exactly one constructor in definition: Choice
+ + diff --git a/test/build/NewTypeTwoConstructors.md b/test/build/NewTypeTwoConstructors.md new file mode 100644 index 00000000..7914d718 --- /dev/null +++ b/test/build/NewTypeTwoConstructors.md @@ -0,0 +1,4 @@ +``` +test/Fail/NewTypeTwoConstructors.agda:5,6-12 +Newtype must have exactly one constructor in definition: Choice +``` diff --git a/test/build/NewTypeTwoFields.err b/test/build/NewTypeTwoFields.err new file mode 100644 index 00000000..542c1355 --- /dev/null +++ b/test/build/NewTypeTwoFields.err @@ -0,0 +1,2 @@ +test/Fail/NewTypeTwoFields.agda:5,6-9 +Newtype must have exactly one field in constructor: MkDuo diff --git a/test/build/NewTypeTwoFields.html b/test/build/NewTypeTwoFields.html new file mode 100644 index 00000000..95b8a655 --- /dev/null +++ b/test/build/NewTypeTwoFields.html @@ -0,0 +1,21 @@ + + + + + + + NewTypeTwoFields + + + +
test/Fail/NewTypeTwoFields.agda:5,6-9
+Newtype must have exactly one field in constructor: MkDuo
+ + diff --git a/test/build/NewTypeTwoFields.md b/test/build/NewTypeTwoFields.md new file mode 100644 index 00000000..fb1ae648 --- /dev/null +++ b/test/build/NewTypeTwoFields.md @@ -0,0 +1,4 @@ +``` +test/Fail/NewTypeTwoFields.agda:5,6-9 +Newtype must have exactly one field in constructor: MkDuo +``` diff --git a/test/build/NonCanonicalSpecialFunction.err b/test/build/NonCanonicalSpecialFunction.err new file mode 100644 index 00000000..e6194feb --- /dev/null +++ b/test/build/NonCanonicalSpecialFunction.err @@ -0,0 +1,2 @@ +test/Fail/NonCanonicalSpecialFunction.agda:17,1-5 +illegal instance: sneaky diff --git a/test/build/NonCanonicalSpecialFunction.html b/test/build/NonCanonicalSpecialFunction.html new file mode 100644 index 00000000..30c07370 --- /dev/null +++ b/test/build/NonCanonicalSpecialFunction.html @@ -0,0 +1,21 @@ + + + + + + + NonCanonicalSpecialFunction + + + +
test/Fail/NonCanonicalSpecialFunction.agda:17,1-5
+illegal instance:  sneaky
+ + diff --git a/test/build/NonCanonicalSpecialFunction.md b/test/build/NonCanonicalSpecialFunction.md new file mode 100644 index 00000000..108a66c3 --- /dev/null +++ b/test/build/NonCanonicalSpecialFunction.md @@ -0,0 +1,4 @@ +``` +test/Fail/NonCanonicalSpecialFunction.agda:17,1-5 +illegal instance: sneaky +``` diff --git a/test/build/NonCanonicalSuperclass.err b/test/build/NonCanonicalSuperclass.err new file mode 100644 index 00000000..1cc20e94 --- /dev/null +++ b/test/build/NonCanonicalSuperclass.err @@ -0,0 +1,2 @@ +test/Fail/NonCanonicalSuperclass.agda:28,3-15 +illegal instance: record { foo = id } diff --git a/test/build/NonCanonicalSuperclass.html b/test/build/NonCanonicalSuperclass.html new file mode 100644 index 00000000..b639c3cb --- /dev/null +++ b/test/build/NonCanonicalSuperclass.html @@ -0,0 +1,21 @@ + + + + + + + NonCanonicalSuperclass + + + +
test/Fail/NonCanonicalSuperclass.agda:28,3-15
+illegal instance:  record { foo = id }
+ + diff --git a/test/build/NonCanonicalSuperclass.md b/test/build/NonCanonicalSuperclass.md new file mode 100644 index 00000000..952e3a98 --- /dev/null +++ b/test/build/NonCanonicalSuperclass.md @@ -0,0 +1,4 @@ +``` +test/Fail/NonCanonicalSuperclass.agda:28,3-15 +illegal instance: record { foo = id } +``` diff --git a/test/build/NonClassInstance.hs b/test/build/NonClassInstance.hs new file mode 100644 index 00000000..d3baa724 --- /dev/null +++ b/test/build/NonClassInstance.hs @@ -0,0 +1,12 @@ +module NonClassInstance where + +iDecIsTrue :: Bool -> Bool +iDecIsTrue False = False +iDecIsTrue True = True + +foo :: Bool -> Bool -> Bool +foo _ b = not b + +bar :: Bool -> Bool +bar b = foo b (iDecIsTrue b) + diff --git a/test/build/NonClassInstance.html b/test/build/NonClassInstance.html new file mode 100644 index 00000000..d1872ec3 --- /dev/null +++ b/test/build/NonClassInstance.html @@ -0,0 +1,91 @@ + + + + + + + NonClassInstance + + + +
module NonClassInstance where
+
+iDecIsTrue :: Bool -> Bool
+iDecIsTrue False = False
+iDecIsTrue True = True
+
+foo :: Bool -> Bool -> Bool
+foo _ b = not b
+
+bar :: Bool -> Bool
+bar b = foo b (iDecIsTrue b)
+ + diff --git a/test/build/NonClassInstance.md b/test/build/NonClassInstance.md new file mode 100644 index 00000000..d7bea020 --- /dev/null +++ b/test/build/NonClassInstance.md @@ -0,0 +1,14 @@ +```haskell +module NonClassInstance where + +iDecIsTrue :: Bool -> Bool +iDecIsTrue False = False +iDecIsTrue True = True + +foo :: Bool -> Bool -> Bool +foo _ b = not b + +bar :: Bool -> Bool +bar b = foo b (iDecIsTrue b) + +``` diff --git a/test/build/NonCopatternInstance.err b/test/build/NonCopatternInstance.err new file mode 100644 index 00000000..385315f4 --- /dev/null +++ b/test/build/NonCopatternInstance.err @@ -0,0 +1,3 @@ +test/Fail/NonCopatternInstance.agda:17,3-12 +Type class instances must be defined using copatterns (or top-level +records) and cannot be defined using helper functions. diff --git a/test/build/NonCopatternInstance.html b/test/build/NonCopatternInstance.html new file mode 100644 index 00000000..50d7dafb --- /dev/null +++ b/test/build/NonCopatternInstance.html @@ -0,0 +1,22 @@ + + + + + + + NonCopatternInstance + + + +
test/Fail/NonCopatternInstance.agda:17,3-12
+Type class instances must be defined using copatterns (or top-level
+records) and cannot be defined using helper functions.
+ + diff --git a/test/build/NonCopatternInstance.md b/test/build/NonCopatternInstance.md new file mode 100644 index 00000000..75a148fc --- /dev/null +++ b/test/build/NonCopatternInstance.md @@ -0,0 +1,5 @@ +``` +test/Fail/NonCopatternInstance.agda:17,3-12 +Type class instances must be defined using copatterns (or top-level +records) and cannot be defined using helper functions. +``` diff --git a/test/build/NonStarDatatypeIndex.err b/test/build/NonStarDatatypeIndex.err new file mode 100644 index 00000000..71835141 --- /dev/null +++ b/test/build/NonStarDatatypeIndex.err @@ -0,0 +1,2 @@ +test/Fail/NonStarDatatypeIndex.agda:5,6-7 +Term variable in type parameter not supported: (n : Nat) diff --git a/test/build/NonStarDatatypeIndex.html b/test/build/NonStarDatatypeIndex.html new file mode 100644 index 00000000..b18141f4 --- /dev/null +++ b/test/build/NonStarDatatypeIndex.html @@ -0,0 +1,21 @@ + + + + + + + NonStarDatatypeIndex + + + +
test/Fail/NonStarDatatypeIndex.agda:5,6-7
+Term variable in type parameter not supported: (n : Nat)
+ + diff --git a/test/build/NonStarDatatypeIndex.md b/test/build/NonStarDatatypeIndex.md new file mode 100644 index 00000000..fa303310 --- /dev/null +++ b/test/build/NonStarDatatypeIndex.md @@ -0,0 +1,4 @@ +``` +test/Fail/NonStarDatatypeIndex.agda:5,6-7 +Term variable in type parameter not supported: (n : Nat) +``` diff --git a/test/build/NonStarRecordIndex.err b/test/build/NonStarRecordIndex.err new file mode 100644 index 00000000..6803b92c --- /dev/null +++ b/test/build/NonStarRecordIndex.err @@ -0,0 +1,2 @@ +test/Fail/NonStarRecordIndex.agda:5,8-9 +Term variable in type parameter not supported: (n : Nat) diff --git a/test/build/NonStarRecordIndex.html b/test/build/NonStarRecordIndex.html new file mode 100644 index 00000000..a0487633 --- /dev/null +++ b/test/build/NonStarRecordIndex.html @@ -0,0 +1,21 @@ + + + + + + + NonStarRecordIndex + + + +
test/Fail/NonStarRecordIndex.agda:5,8-9
+Term variable in type parameter not supported: (n : Nat)
+ + diff --git a/test/build/NonStarRecordIndex.md b/test/build/NonStarRecordIndex.md new file mode 100644 index 00000000..4a890448 --- /dev/null +++ b/test/build/NonStarRecordIndex.md @@ -0,0 +1,4 @@ +``` +test/Fail/NonStarRecordIndex.agda:5,8-9 +Term variable in type parameter not supported: (n : Nat) +``` diff --git a/test/build/Numbers.hs b/test/build/Numbers.hs new file mode 100644 index 00000000..d970305c --- /dev/null +++ b/test/build/Numbers.hs @@ -0,0 +1,19 @@ +module Numbers where + +import Numeric.Natural (Natural) + +posNatural :: Natural +posNatural = 14 + +posInteger :: Integer +posInteger = 52 + +negInteger :: Integer +negInteger = -1001 + +natToPos :: Natural -> Integer +natToPos n = fromIntegral n + +natToNeg :: Natural -> Integer +natToNeg n = (negate . fromIntegral) n + diff --git a/test/build/Numbers.html b/test/build/Numbers.html new file mode 100644 index 00000000..667e48ef --- /dev/null +++ b/test/build/Numbers.html @@ -0,0 +1,98 @@ + + + + + + + Numbers + + + +
module Numbers where
+
+import Numeric.Natural (Natural)
+
+posNatural :: Natural
+posNatural = 14
+
+posInteger :: Integer
+posInteger = 52
+
+negInteger :: Integer
+negInteger = -1001
+
+natToPos :: Natural -> Integer
+natToPos n = fromIntegral n
+
+natToNeg :: Natural -> Integer
+natToNeg n = (negate . fromIntegral) n
+ + diff --git a/test/build/Numbers.md b/test/build/Numbers.md new file mode 100644 index 00000000..e6f89c86 --- /dev/null +++ b/test/build/Numbers.md @@ -0,0 +1,21 @@ +```haskell +module Numbers where + +import Numeric.Natural (Natural) + +posNatural :: Natural +posNatural = 14 + +posInteger :: Integer +posInteger = 52 + +negInteger :: Integer +negInteger = -1001 + +natToPos :: Natural -> Integer +natToPos n = fromIntegral n + +natToNeg :: Natural -> Integer +natToNeg n = (negate . fromIntegral) n + +``` diff --git a/test/build/OtherImportee.hs b/test/build/OtherImportee.hs new file mode 100644 index 00000000..ec39bb97 --- /dev/null +++ b/test/build/OtherImportee.hs @@ -0,0 +1,4 @@ +module OtherImportee where + +data OtherFoo = MkFoo + diff --git a/test/build/OtherImportee.html b/test/build/OtherImportee.html new file mode 100644 index 00000000..3de9030b --- /dev/null +++ b/test/build/OtherImportee.html @@ -0,0 +1,83 @@ + + + + + + + OtherImportee + + + +
module OtherImportee where
+
+data OtherFoo = MkFoo
+ + diff --git a/test/build/OtherImportee.md b/test/build/OtherImportee.md new file mode 100644 index 00000000..0dd0a421 --- /dev/null +++ b/test/build/OtherImportee.md @@ -0,0 +1,6 @@ +```haskell +module OtherImportee where + +data OtherFoo = MkFoo + +``` diff --git a/test/build/PartialCase.err b/test/build/PartialCase.err new file mode 100644 index 00000000..3be25cb8 --- /dev/null +++ b/test/build/PartialCase.err @@ -0,0 +1,2 @@ +test/Fail/PartialCase.agda:5,1-7 +case_of_ must be fully applied to a lambda term diff --git a/test/build/PartialCase.html b/test/build/PartialCase.html new file mode 100644 index 00000000..2e573cf8 --- /dev/null +++ b/test/build/PartialCase.html @@ -0,0 +1,21 @@ + + + + + + + PartialCase + + + +
test/Fail/PartialCase.agda:5,1-7
+case_of_ must be fully applied to a lambda term
+ + diff --git a/test/build/PartialCase.md b/test/build/PartialCase.md new file mode 100644 index 00000000..d9182ab4 --- /dev/null +++ b/test/build/PartialCase.md @@ -0,0 +1,4 @@ +``` +test/Fail/PartialCase.agda:5,1-7 +case_of_ must be fully applied to a lambda term +``` diff --git a/test/build/PartialCaseNoLambda.err b/test/build/PartialCaseNoLambda.err new file mode 100644 index 00000000..17033152 --- /dev/null +++ b/test/build/PartialCaseNoLambda.err @@ -0,0 +1,2 @@ +test/Fail/PartialCaseNoLambda.agda:5,1-13 +case_of_ must be fully applied to a lambda term diff --git a/test/build/PartialCaseNoLambda.html b/test/build/PartialCaseNoLambda.html new file mode 100644 index 00000000..c208e124 --- /dev/null +++ b/test/build/PartialCaseNoLambda.html @@ -0,0 +1,21 @@ + + + + + + + PartialCaseNoLambda + + + +
test/Fail/PartialCaseNoLambda.agda:5,1-13
+case_of_ must be fully applied to a lambda term
+ + diff --git a/test/build/PartialCaseNoLambda.md b/test/build/PartialCaseNoLambda.md new file mode 100644 index 00000000..e3e2cfb8 --- /dev/null +++ b/test/build/PartialCaseNoLambda.md @@ -0,0 +1,4 @@ +``` +test/Fail/PartialCaseNoLambda.agda:5,1-13 +case_of_ must be fully applied to a lambda term +``` diff --git a/test/build/PartialIf.err b/test/build/PartialIf.err new file mode 100644 index 00000000..783afb76 --- /dev/null +++ b/test/build/PartialIf.err @@ -0,0 +1,2 @@ +test/Fail/PartialIf.agda:5,1-11 +if_then_else_ must be fully applied diff --git a/test/build/PartialIf.html b/test/build/PartialIf.html new file mode 100644 index 00000000..1bde79b5 --- /dev/null +++ b/test/build/PartialIf.html @@ -0,0 +1,21 @@ + + + + + + + PartialIf + + + +
test/Fail/PartialIf.agda:5,1-11
+if_then_else_ must be fully applied
+ + diff --git a/test/build/PartialIf.md b/test/build/PartialIf.md new file mode 100644 index 00000000..b94ee7fc --- /dev/null +++ b/test/build/PartialIf.md @@ -0,0 +1,4 @@ +``` +test/Fail/PartialIf.agda:5,1-11 +if_then_else_ must be fully applied +``` diff --git a/test/build/Pragmas.hs b/test/build/Pragmas.hs new file mode 100644 index 00000000..78875115 --- /dev/null +++ b/test/build/Pragmas.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE LambdaCase #-} + +module Pragmas where + +foo :: Bool -> a -> (a, Int) +foo = \ case + False -> (, 0) + True -> (, 1) + diff --git a/test/build/Pragmas.html b/test/build/Pragmas.html new file mode 100644 index 00000000..1927ac42 --- /dev/null +++ b/test/build/Pragmas.html @@ -0,0 +1,89 @@ + + + + + + + Pragmas + + + +
{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Pragmas where
+
+foo :: Bool -> a -> (a, Int)
+foo = \ case
+  False -> (, 0)
+  True  -> (, 1)
+ + diff --git a/test/build/Pragmas.md b/test/build/Pragmas.md new file mode 100644 index 00000000..4d808bb6 --- /dev/null +++ b/test/build/Pragmas.md @@ -0,0 +1,12 @@ +```haskell +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE LambdaCase #-} + +module Pragmas where + +foo :: Bool -> a -> (a, Int) +foo = \ case + False -> (, 0) + True -> (, 1) + +``` diff --git a/test/build/ProjLike.hs b/test/build/ProjLike.hs new file mode 100644 index 00000000..57b56502 --- /dev/null +++ b/test/build/ProjLike.hs @@ -0,0 +1,10 @@ +module ProjLike where + +import Numeric.Natural (Natural) + +data Scope a = Empty + | Bind a (Scope a) + +test :: Scope Natural +test = Bind 2 Empty + diff --git a/test/build/ProjLike.html b/test/build/ProjLike.html new file mode 100644 index 00000000..38ec1cd8 --- /dev/null +++ b/test/build/ProjLike.html @@ -0,0 +1,89 @@ + + + + + + + ProjLike + + + +
module ProjLike where
+
+import Numeric.Natural (Natural)
+
+data Scope a = Empty
+             | Bind a (Scope a)
+
+test :: Scope Natural
+test = Bind 2 Empty
+ + diff --git a/test/build/ProjLike.md b/test/build/ProjLike.md new file mode 100644 index 00000000..e8c9420e --- /dev/null +++ b/test/build/ProjLike.md @@ -0,0 +1,12 @@ +```haskell +module ProjLike where + +import Numeric.Natural (Natural) + +data Scope a = Empty + | Bind a (Scope a) + +test :: Scope Natural +test = Bind 2 Empty + +``` diff --git a/test/build/ProjectionLike.hs b/test/build/ProjectionLike.hs new file mode 100644 index 00000000..dbd78096 --- /dev/null +++ b/test/build/ProjectionLike.hs @@ -0,0 +1,7 @@ +module ProjectionLike where + +data R = R{fld :: Int} + +foo :: R -> Int +foo x = fld x + diff --git a/test/build/ProjectionLike.html b/test/build/ProjectionLike.html new file mode 100644 index 00000000..155216d7 --- /dev/null +++ b/test/build/ProjectionLike.html @@ -0,0 +1,86 @@ + + + + + + + ProjectionLike + + + +
module ProjectionLike where
+
+data R = R{fld :: Int}
+
+foo :: R -> Int
+foo x = fld x
+ + diff --git a/test/build/ProjectionLike.md b/test/build/ProjectionLike.md new file mode 100644 index 00000000..e0822618 --- /dev/null +++ b/test/build/ProjectionLike.md @@ -0,0 +1,9 @@ +```haskell +module ProjectionLike where + +data R = R{fld :: Int} + +foo :: R -> Int +foo x = fld x + +``` diff --git a/test/build/QualifiedImportee.hs b/test/build/QualifiedImportee.hs new file mode 100644 index 00000000..666eb789 --- /dev/null +++ b/test/build/QualifiedImportee.hs @@ -0,0 +1,19 @@ +module QualifiedImportee where + +foo :: Int +foo = 43 + +(!#) :: Int -> Int -> Int +x !# y = x - y + +data Foo = MkFoo + +class Fooable a where + doTheFoo :: a + defaultFoo :: a + {-# MINIMAL doTheFoo #-} + defaultFoo = doTheFoo + +instance Fooable Foo where + doTheFoo = MkFoo + diff --git a/test/build/QualifiedImportee.html b/test/build/QualifiedImportee.html new file mode 100644 index 00000000..269a0b3a --- /dev/null +++ b/test/build/QualifiedImportee.html @@ -0,0 +1,98 @@ + + + + + + + QualifiedImportee + + + +
module QualifiedImportee where
+
+foo :: Int
+foo = 43
+
+(!#) :: Int -> Int -> Int
+x !# y = x - y
+
+data Foo = MkFoo
+
+class Fooable a where
+    doTheFoo :: a
+    defaultFoo :: a
+    {-# MINIMAL doTheFoo #-}
+    defaultFoo = doTheFoo
+
+instance Fooable Foo where
+    doTheFoo = MkFoo
+ + diff --git a/test/build/QualifiedImportee.md b/test/build/QualifiedImportee.md new file mode 100644 index 00000000..277189df --- /dev/null +++ b/test/build/QualifiedImportee.md @@ -0,0 +1,21 @@ +```haskell +module QualifiedImportee where + +foo :: Int +foo = 43 + +(!#) :: Int -> Int -> Int +x !# y = x - y + +data Foo = MkFoo + +class Fooable a where + doTheFoo :: a + defaultFoo :: a + {-# MINIMAL doTheFoo #-} + defaultFoo = doTheFoo + +instance Fooable Foo where + doTheFoo = MkFoo + +``` diff --git a/test/build/QualifiedImports.hs b/test/build/QualifiedImports.hs new file mode 100644 index 00000000..96c2c666 --- /dev/null +++ b/test/build/QualifiedImports.hs @@ -0,0 +1,29 @@ +module QualifiedImports where + +import qualified Importee (Foo(MkFoo), foo) +import qualified QualifiedImportee as Qually (Foo, Fooable(defaultFoo, doTheFoo), foo, (!#)) + +-- ** simple qualification + +simpqualBar :: Int +simpqualBar = Importee.foo + +simpfoo :: Importee.Foo +simpfoo = Importee.MkFoo + +-- ** qualified imports + +qualBar :: Int +qualBar = Qually.foo + +qualBaz :: Int +qualBaz = (Qually.!#) 2 2 + +qualFooable :: Qually.Foo +qualFooable = Qually.doTheFoo + +qualDefaultBar :: Qually.Foo +qualDefaultBar = Qually.defaultFoo + +type Foo = Importee.Foo + diff --git a/test/build/QualifiedImports.html b/test/build/QualifiedImports.html new file mode 100644 index 00000000..a844a5dd --- /dev/null +++ b/test/build/QualifiedImports.html @@ -0,0 +1,108 @@ + + + + + + + QualifiedImports + + + +
module QualifiedImports where
+
+import qualified Importee (Foo(MkFoo), foo)
+import qualified QualifiedImportee as Qually (Foo, Fooable(defaultFoo, doTheFoo), foo, (!#))
+
+-- ** simple qualification
+
+simpqualBar :: Int
+simpqualBar = Importee.foo
+
+simpfoo :: Importee.Foo
+simpfoo = Importee.MkFoo
+
+-- ** qualified imports
+
+qualBar :: Int
+qualBar = Qually.foo
+
+qualBaz :: Int
+qualBaz = (Qually.!#) 2 2
+
+qualFooable :: Qually.Foo
+qualFooable = Qually.doTheFoo
+
+qualDefaultBar :: Qually.Foo
+qualDefaultBar = Qually.defaultFoo
+
+type Foo = Importee.Foo
+ + diff --git a/test/build/QualifiedImports.md b/test/build/QualifiedImports.md new file mode 100644 index 00000000..803900d9 --- /dev/null +++ b/test/build/QualifiedImports.md @@ -0,0 +1,31 @@ +```haskell +module QualifiedImports where + +import qualified Importee (Foo(MkFoo), foo) +import qualified QualifiedImportee as Qually (Foo, Fooable(defaultFoo, doTheFoo), foo, (!#)) + +-- ** simple qualification + +simpqualBar :: Int +simpqualBar = Importee.foo + +simpfoo :: Importee.Foo +simpfoo = Importee.MkFoo + +-- ** qualified imports + +qualBar :: Int +qualBar = Qually.foo + +qualBaz :: Int +qualBaz = (Qually.!#) 2 2 + +qualFooable :: Qually.Foo +qualFooable = Qually.doTheFoo + +qualDefaultBar :: Qually.Foo +qualDefaultBar = Qually.defaultFoo + +type Foo = Importee.Foo + +``` diff --git a/test/build/QualifiedModule.hs b/test/build/QualifiedModule.hs new file mode 100644 index 00000000..841dfda3 --- /dev/null +++ b/test/build/QualifiedModule.hs @@ -0,0 +1,13 @@ +module QualifiedModule where + +data D = C + +f :: D -> D +f C = C + +g :: D +g = h + where + h :: D + h = C + diff --git a/test/build/QualifiedModule.html b/test/build/QualifiedModule.html new file mode 100644 index 00000000..4680cafd --- /dev/null +++ b/test/build/QualifiedModule.html @@ -0,0 +1,92 @@ + + + + + + + QualifiedModule + + + +
module QualifiedModule where
+
+data D = C
+
+f :: D -> D
+f C = C
+
+g :: D
+g = h
+  where
+    h :: D
+    h = C
+ + diff --git a/test/build/QualifiedModule.md b/test/build/QualifiedModule.md new file mode 100644 index 00000000..44aea327 --- /dev/null +++ b/test/build/QualifiedModule.md @@ -0,0 +1,15 @@ +```haskell +module QualifiedModule where + +data D = C + +f :: D -> D +f C = C + +g :: D +g = h + where + h :: D + h = C + +``` diff --git a/test/build/QualifiedPrelude.hs b/test/build/QualifiedPrelude.hs new file mode 100644 index 00000000..b8bd4add --- /dev/null +++ b/test/build/QualifiedPrelude.hs @@ -0,0 +1,30 @@ +module QualifiedPrelude where + +import Numeric.Natural (Natural) +import qualified Prelude as Pre (foldr, (+), (.)) + +-- ** qualifying the Prelude + +(+) :: Natural -> Natural -> Natural +x + y = x + +comp :: + (Natural -> Natural) -> (Natural -> Natural) -> Natural -> Natural +comp f g = (Pre..) f g + +test :: Natural +test = (Pre.+) 0 (1 + 0) + +testComp :: Natural +testComp = comp (+ 0) (\ section -> (Pre.+) section 1) 0 + +-- ** interplay with (qualified) default methods of existing class + +testFoldr :: [Natural] -> Natural +testFoldr = Pre.foldr (\ _ x -> x) 0 + +-- ** re-qualifying the Prelude + +retest :: Natural +retest = (Pre.+) 0 (1 + 0) + diff --git a/test/build/QualifiedPrelude.html b/test/build/QualifiedPrelude.html new file mode 100644 index 00000000..7a35c2c5 --- /dev/null +++ b/test/build/QualifiedPrelude.html @@ -0,0 +1,109 @@ + + + + + + + QualifiedPrelude + + + +
module QualifiedPrelude where
+
+import Numeric.Natural (Natural)
+import qualified Prelude as Pre (foldr, (+), (.))
+
+-- ** qualifying the Prelude
+
+(+) :: Natural -> Natural -> Natural
+x + y = x
+
+comp ::
+     (Natural -> Natural) -> (Natural -> Natural) -> Natural -> Natural
+comp f g = (Pre..) f g
+
+test :: Natural
+test = (Pre.+) 0 (1 + 0)
+
+testComp :: Natural
+testComp = comp (+ 0) (\ section -> (Pre.+) section 1) 0
+
+-- ** interplay with (qualified) default methods of existing class
+
+testFoldr :: [Natural] -> Natural
+testFoldr = Pre.foldr (\ _ x -> x) 0
+
+-- ** re-qualifying the Prelude
+
+retest :: Natural
+retest = (Pre.+) 0 (1 + 0)
+ + diff --git a/test/build/QualifiedPrelude.md b/test/build/QualifiedPrelude.md new file mode 100644 index 00000000..b25c10ef --- /dev/null +++ b/test/build/QualifiedPrelude.md @@ -0,0 +1,32 @@ +```haskell +module QualifiedPrelude where + +import Numeric.Natural (Natural) +import qualified Prelude as Pre (foldr, (+), (.)) + +-- ** qualifying the Prelude + +(+) :: Natural -> Natural -> Natural +x + y = x + +comp :: + (Natural -> Natural) -> (Natural -> Natural) -> Natural -> Natural +comp f g = (Pre..) f g + +test :: Natural +test = (Pre.+) 0 (1 + 0) + +testComp :: Natural +testComp = comp (+ 0) (\ section -> (Pre.+) section 1) 0 + +-- ** interplay with (qualified) default methods of existing class + +testFoldr :: [Natural] -> Natural +testFoldr = Pre.foldr (\ _ x -> x) 0 + +-- ** re-qualifying the Prelude + +retest :: Natural +retest = (Pre.+) 0 (1 + 0) + +``` diff --git a/test/build/QualifiedRecordProjections.err b/test/build/QualifiedRecordProjections.err new file mode 100644 index 00000000..4c803b97 --- /dev/null +++ b/test/build/QualifiedRecordProjections.err @@ -0,0 +1,4 @@ +test/Fail/QualifiedRecordProjections.agda:5,5-8 +Record projections (`one` in this case) must be brought into scope +when compiling to Haskell record types. Add `open Test public` +after the record declaration to fix this. diff --git a/test/build/QualifiedRecordProjections.html b/test/build/QualifiedRecordProjections.html new file mode 100644 index 00000000..8011f088 --- /dev/null +++ b/test/build/QualifiedRecordProjections.html @@ -0,0 +1,23 @@ + + + + + + + QualifiedRecordProjections + + + +
test/Fail/QualifiedRecordProjections.agda:5,5-8
+Record projections (`one` in this case) must be brought into scope
+when compiling to Haskell record types. Add `open Test public`
+after the record declaration to fix this.
+ + diff --git a/test/build/QualifiedRecordProjections.md b/test/build/QualifiedRecordProjections.md new file mode 100644 index 00000000..dff8442f --- /dev/null +++ b/test/build/QualifiedRecordProjections.md @@ -0,0 +1,6 @@ +``` +test/Fail/QualifiedRecordProjections.agda:5,5-8 +Record projections (`one` in this case) must be brought into scope +when compiling to Haskell record types. Add `open Test public` +after the record declaration to fix this. +``` diff --git a/test/build/Records.hs b/test/build/Records.hs new file mode 100644 index 00000000..de25976e --- /dev/null +++ b/test/build/Records.hs @@ -0,0 +1,21 @@ +module Records where + +import Numeric.Natural (Natural) + +data Pair a b = MkPair{proj₁ :: a, proj₂ :: b} + +data Wrap a = Wrap{unwrap :: a} + +class MyMonoid a where + mempty :: a + mappend :: a -> a -> a + +swap :: Pair a b -> Pair b a +swap (MkPair x y) = MkPair y x + +swap₂ :: Wrap (Pair a b) -> Wrap (Pair b a) +swap₂ (Wrap p) = Wrap (MkPair (proj₂ p) (proj₁ p)) + +data User = User{name :: String, code :: Natural} + deriving (Eq, Show) + diff --git a/test/build/Records.html b/test/build/Records.html new file mode 100644 index 00000000..6f64fd11 --- /dev/null +++ b/test/build/Records.html @@ -0,0 +1,100 @@ + + + + + + + Records + + + +
module Records where
+
+import Numeric.Natural (Natural)
+
+data Pair a b = MkPair{proj₁ :: a, proj₂ :: b}
+
+data Wrap a = Wrap{unwrap :: a}
+
+class MyMonoid a where
+    mempty :: a
+    mappend :: a -> a -> a
+
+swap :: Pair a b -> Pair b a
+swap (MkPair x y) = MkPair y x
+
+swap₂ :: Wrap (Pair a b) -> Wrap (Pair b a)
+swap₂ (Wrap p) = Wrap (MkPair (proj₂ p) (proj₁ p))
+
+data User = User{name :: String, code :: Natural}
+              deriving (Eq, Show)
+ + diff --git a/test/build/Records.md b/test/build/Records.md new file mode 100644 index 00000000..fa3475d3 --- /dev/null +++ b/test/build/Records.md @@ -0,0 +1,23 @@ +```haskell +module Records where + +import Numeric.Natural (Natural) + +data Pair a b = MkPair{proj₁ :: a, proj₂ :: b} + +data Wrap a = Wrap{unwrap :: a} + +class MyMonoid a where + mempty :: a + mappend :: a -> a -> a + +swap :: Pair a b -> Pair b a +swap (MkPair x y) = MkPair y x + +swap₂ :: Wrap (Pair a b) -> Wrap (Pair b a) +swap₂ (Wrap p) = Wrap (MkPair (proj₂ p) (proj₁ p)) + +data User = User{name :: String, code :: Natural} + deriving (Eq, Show) + +``` diff --git a/test/build/RequalifiedImports.hs b/test/build/RequalifiedImports.hs new file mode 100644 index 00000000..977169e0 --- /dev/null +++ b/test/build/RequalifiedImports.hs @@ -0,0 +1,29 @@ +module RequalifiedImports where + +import OtherImportee (OtherFoo(MkFoo)) +import qualified QualifiedImportee as A (Foo, Fooable(defaultFoo, doTheFoo), foo, (!#)) + +-- ** conflicting imports are all replaced with the "smallest" qualifier +-- * the characters are ordered based on their ASCII value (i.e. capitals first) +-- * the order of the imports in the file does not matter +-- * the scope-checker has already replaced previous definitions in the file + +requalBar :: Int +requalBar = A.foo + +requalBaz :: Int +requalBaz = (A.!#) 2 2 + +requalFooable :: A.Foo +requalFooable = A.doTheFoo + +requalDefaultBar :: A.Foo +requalDefaultBar = A.defaultFoo + +-- ** qualifying an open'ed module has no effect + +type T = Int + +otherFoo :: OtherFoo +otherFoo = MkFoo + diff --git a/test/build/RequalifiedImports.html b/test/build/RequalifiedImports.html new file mode 100644 index 00000000..922d2273 --- /dev/null +++ b/test/build/RequalifiedImports.html @@ -0,0 +1,108 @@ + + + + + + + RequalifiedImports + + + +
module RequalifiedImports where
+
+import OtherImportee (OtherFoo(MkFoo))
+import qualified QualifiedImportee as A (Foo, Fooable(defaultFoo, doTheFoo), foo, (!#))
+
+-- ** conflicting imports are all replaced with the "smallest" qualifier
+--   * the characters are ordered based on their ASCII value (i.e. capitals first)
+--   * the order of the imports in the file does not matter
+--   * the scope-checker has already replaced previous definitions in the file
+
+requalBar :: Int
+requalBar = A.foo
+
+requalBaz :: Int
+requalBaz = (A.!#) 2 2
+
+requalFooable :: A.Foo
+requalFooable = A.doTheFoo
+
+requalDefaultBar :: A.Foo
+requalDefaultBar = A.defaultFoo
+
+-- ** qualifying an open'ed module has no effect
+
+type T = Int
+
+otherFoo :: OtherFoo
+otherFoo = MkFoo
+ + diff --git a/test/build/RequalifiedImports.md b/test/build/RequalifiedImports.md new file mode 100644 index 00000000..a8bbdc8a --- /dev/null +++ b/test/build/RequalifiedImports.md @@ -0,0 +1,31 @@ +```haskell +module RequalifiedImports where + +import OtherImportee (OtherFoo(MkFoo)) +import qualified QualifiedImportee as A (Foo, Fooable(defaultFoo, doTheFoo), foo, (!#)) + +-- ** conflicting imports are all replaced with the "smallest" qualifier +-- * the characters are ordered based on their ASCII value (i.e. capitals first) +-- * the order of the imports in the file does not matter +-- * the scope-checker has already replaced previous definitions in the file + +requalBar :: Int +requalBar = A.foo + +requalBaz :: Int +requalBaz = (A.!#) 2 2 + +requalFooable :: A.Foo +requalFooable = A.doTheFoo + +requalDefaultBar :: A.Foo +requalDefaultBar = A.defaultFoo + +-- ** qualifying an open'ed module has no effect + +type T = Int + +otherFoo :: OtherFoo +otherFoo = MkFoo + +``` diff --git a/test/build/ScopedTypeVariables.hs b/test/build/ScopedTypeVariables.hs new file mode 100644 index 00000000..4a475499 --- /dev/null +++ b/test/build/ScopedTypeVariables.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module ScopedTypeVariables where + +foo :: forall a . Eq a => a -> Bool +foo x = it x == x + where + it :: a -> a + it = const x + +bar :: forall a b . a -> b -> (b -> b) -> b +bar x y f = baz y + where + baz :: b -> b + baz z = f (f z) + +data D = MakeD Bool + +mybool :: Bool +mybool = False + diff --git a/test/build/ScopedTypeVariables.html b/test/build/ScopedTypeVariables.html new file mode 100644 index 00000000..8e7f0fc7 --- /dev/null +++ b/test/build/ScopedTypeVariables.html @@ -0,0 +1,99 @@ + + + + + + + ScopedTypeVariables + + + +
{-# LANGUAGE ScopedTypeVariables #-}
+module ScopedTypeVariables where
+
+foo :: forall a . Eq a => a -> Bool
+foo x = it x == x
+  where
+    it :: a -> a
+    it = const x
+
+bar :: forall a b . a -> b -> (b -> b) -> b
+bar x y f = baz y
+  where
+    baz :: b -> b
+    baz z = f (f z)
+
+data D = MakeD Bool
+
+mybool :: Bool
+mybool = False
+ + diff --git a/test/build/ScopedTypeVariables.md b/test/build/ScopedTypeVariables.md new file mode 100644 index 00000000..6eaebf7c --- /dev/null +++ b/test/build/ScopedTypeVariables.md @@ -0,0 +1,22 @@ +```haskell +{-# LANGUAGE ScopedTypeVariables #-} +module ScopedTypeVariables where + +foo :: forall a . Eq a => a -> Bool +foo x = it x == x + where + it :: a -> a + it = const x + +bar :: forall a b . a -> b -> (b -> b) -> b +bar x y f = baz y + where + baz :: b -> b + baz z = f (f z) + +data D = MakeD Bool + +mybool :: Bool +mybool = False + +``` diff --git a/test/build/SecondImportee.hs b/test/build/SecondImportee.hs new file mode 100644 index 00000000..7e3a11b9 --- /dev/null +++ b/test/build/SecondImportee.hs @@ -0,0 +1,5 @@ +module SecondImportee where + +anotherFoo :: Int +anotherFoo = 666 + diff --git a/test/build/SecondImportee.html b/test/build/SecondImportee.html new file mode 100644 index 00000000..b24d2bb6 --- /dev/null +++ b/test/build/SecondImportee.html @@ -0,0 +1,84 @@ + + + + + + + SecondImportee + + + +
module SecondImportee where
+
+anotherFoo :: Int
+anotherFoo = 666
+ + diff --git a/test/build/SecondImportee.md b/test/build/SecondImportee.md new file mode 100644 index 00000000..7bb5f106 --- /dev/null +++ b/test/build/SecondImportee.md @@ -0,0 +1,7 @@ +```haskell +module SecondImportee where + +anotherFoo :: Int +anotherFoo = 666 + +``` diff --git a/test/build/Sections.hs b/test/build/Sections.hs new file mode 100644 index 00000000..9d85d801 --- /dev/null +++ b/test/build/Sections.hs @@ -0,0 +1,19 @@ +module Sections where + +import Numeric.Natural (Natural) + +test₁ :: Natural -> Natural +test₁ = (5 +) + +test₂ :: Natural -> Natural +test₂ = (+ 5) + +test₃ :: Natural -> Natural +test₃ = (5 +) + +test₄ :: Natural -> Natural +test₄ = \ x -> x + 5 + +test₅ :: Natural -> Natural +test₅ = (5 +) + diff --git a/test/build/Sections.html b/test/build/Sections.html new file mode 100644 index 00000000..429420dc --- /dev/null +++ b/test/build/Sections.html @@ -0,0 +1,98 @@ + + + + + + + Sections + + + +
module Sections where
+
+import Numeric.Natural (Natural)
+
+test₁ :: Natural -> Natural
+test₁ = (5 +)
+
+test₂ :: Natural -> Natural
+test₂ = (+ 5)
+
+test₃ :: Natural -> Natural
+test₃ = (5 +)
+
+test₄ :: Natural -> Natural
+test₄ = \ x -> x + 5
+
+test₅ :: Natural -> Natural
+test₅ = (5 +)
+ + diff --git a/test/build/Sections.md b/test/build/Sections.md new file mode 100644 index 00000000..6226f9f4 --- /dev/null +++ b/test/build/Sections.md @@ -0,0 +1,21 @@ +```haskell +module Sections where + +import Numeric.Natural (Natural) + +test₁ :: Natural -> Natural +test₁ = (5 +) + +test₂ :: Natural -> Natural +test₂ = (+ 5) + +test₃ :: Natural -> Natural +test₃ = (5 +) + +test₄ :: Natural -> Natural +test₄ = \ x -> x + 5 + +test₅ :: Natural -> Natural +test₅ = (5 +) + +``` diff --git a/test/build/Superclass.hs b/test/build/Superclass.hs new file mode 100644 index 00000000..432e632e --- /dev/null +++ b/test/build/Superclass.hs @@ -0,0 +1,32 @@ +module Superclass where + +class Super a where + myFun :: a -> a + +class Super a => Sub a where + +foo :: Sub a => a -> a +foo = myFun . myFun + +class Super a => Sub2 a where + +class (Sub a, Sub2 a) => Subber a where + +bar :: Subber a => a -> a +bar = myFun . id + +instance Super Int where + myFun = (1 +) + +instance Sub Int where + +class Ord a => DiscreteOrd a where + +instance DiscreteOrd Bool where + +baz :: DiscreteOrd a => a -> Bool +baz x = x < x + +usebaz :: Bool +usebaz = baz True + diff --git a/test/build/Superclass.html b/test/build/Superclass.html new file mode 100644 index 00000000..5c5e8327 --- /dev/null +++ b/test/build/Superclass.html @@ -0,0 +1,111 @@ + + + + + + + Superclass + + + +
module Superclass where
+
+class Super a where
+    myFun :: a -> a
+
+class Super a => Sub a where
+
+foo :: Sub a => a -> a
+foo = myFun . myFun
+
+class Super a => Sub2 a where
+
+class (Sub a, Sub2 a) => Subber a where
+
+bar :: Subber a => a -> a
+bar = myFun . id
+
+instance Super Int where
+    myFun = (1 +)
+
+instance Sub Int where
+
+class Ord a => DiscreteOrd a where
+
+instance DiscreteOrd Bool where
+
+baz :: DiscreteOrd a => a -> Bool
+baz x = x < x
+
+usebaz :: Bool
+usebaz = baz True
+ + diff --git a/test/build/Superclass.md b/test/build/Superclass.md new file mode 100644 index 00000000..845f41cb --- /dev/null +++ b/test/build/Superclass.md @@ -0,0 +1,34 @@ +```haskell +module Superclass where + +class Super a where + myFun :: a -> a + +class Super a => Sub a where + +foo :: Sub a => a -> a +foo = myFun . myFun + +class Super a => Sub2 a where + +class (Sub a, Sub2 a) => Subber a where + +bar :: Subber a => a -> a +bar = myFun . id + +instance Super Int where + myFun = (1 +) + +instance Sub Int where + +class Ord a => DiscreteOrd a where + +instance DiscreteOrd Bool where + +baz :: DiscreteOrd a => a -> Bool +baz x = x < x + +usebaz :: Bool +usebaz = baz True + +``` diff --git a/test/build/Test.hs b/test/build/Test.hs new file mode 100644 index 00000000..69574360 --- /dev/null +++ b/test/build/Test.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleInstances #-} + +module Test where + +import Numeric.Natural (Natural) + +import Data.Monoid + +data Exp v = Plus (Exp v) (Exp v) + | Lit Natural + | Var v + deriving (Show, Eq) + +eval :: (a -> Natural) -> Exp a -> Natural +eval env (Plus a b) = eval env a + eval env b +eval env (Lit n) = n +eval env (Var x) = env x + +listSum :: [Int] -> Int +listSum [] = 0 +listSum (x : xs) = x + sum xs + +monoSum :: [Integer] -> Integer +monoSum xs = sum xs + +polySum :: Num a => [a] -> a +polySum xs = sum xs + +-- comment +-- another comment +bla :: Int -> Int +bla n = n * 4 + +{- multi + line + comment +-} + +ex_float :: Double +ex_float = 0.0 + +ex_word :: Word +ex_word = fromInteger 0 + +ex_char :: Char +ex_char = 'a' + +char_d :: Char +char_d = toEnum 100 + +(+++) :: [a] -> [a] -> [a] +[] +++ ys = ys +(x : xs) +++ ys = x : (xs +++ ys) + +listMap :: (a -> b) -> [a] -> [b] +listMap f [] = [] +listMap f (x : xs) = f x : listMap f xs + +mapTest :: [Natural] -> [Natural] +mapTest = map (id . (5 +)) + +plus3 :: [Natural] -> [Natural] +plus3 = map (\ n -> n + 3) + +doubleLambda :: Natural -> Natural -> Natural +doubleLambda = \ a b -> a + 2 * b + +cnst :: a -> b -> a +cnst = \ x _ -> x + +second :: (b -> c) -> (a, b) -> (a, c) +second f (x, y) = (x, f y) + +doubleTake :: Int -> Int -> [a] -> ([a], [a]) +doubleTake n m = second (take m) . splitAt n + +initLast :: [a] -> ([a], a) +initLast xs = (init xs, last xs) + +class MonoidX a where + memptyX :: a + mappendX :: a -> a -> a + +instance MonoidX Natural where + memptyX = 0 + mappendX i j = i + j + +instance MonoidX (a -> Natural) where + memptyX _ = memptyX + mappendX f g x = mappendX (f x) (g x) + +instance (MonoidX b) => MonoidX (a -> b) where + memptyX _ = memptyX + mappendX f g x = mappendX (f x) (g x) + +sumMonX :: MonoidX a => [a] -> a +sumMonX [] = memptyX +sumMonX (x : xs) = mappendX x (sumMonX xs) + +sumMon :: Monoid a => [a] -> a +sumMon [] = mempty +sumMon (x : xs) = x <> sumMon xs + +data NatSum = MkSum Natural + +instance Semigroup NatSum where + MkSum a <> MkSum b = MkSum (a + b) + +instance Monoid NatSum where + mempty = MkSum 0 + +double :: Monoid a => a -> a +double x = x <> x + +doubleSum :: NatSum -> NatSum +doubleSum = double + +hd :: [a] -> a +hd [] = error "hd: empty list" +hd (x : _) = x + +five :: Int +five = hd [5, 3] + +ex_bool :: Bool +ex_bool = True + +ex_if :: Natural +ex_if = if True then 1 else 0 + +if_over :: Natural +if_over = (if True then \ x -> x else \ x -> x + 1) 0 + diff --git a/test/build/Test.html b/test/build/Test.html new file mode 100644 index 00000000..6b4ab5ab --- /dev/null +++ b/test/build/Test.html @@ -0,0 +1,213 @@ + + + + + + + Test + + + +
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Test where
+
+import Numeric.Natural (Natural)
+
+import Data.Monoid
+
+data Exp v = Plus (Exp v) (Exp v)
+           | Lit Natural
+           | Var v
+               deriving (Show, Eq)
+
+eval :: (a -> Natural) -> Exp a -> Natural
+eval env (Plus a b) = eval env a + eval env b
+eval env (Lit n) = n
+eval env (Var x) = env x
+
+listSum :: [Int] -> Int
+listSum [] = 0
+listSum (x : xs) = x + sum xs
+
+monoSum :: [Integer] -> Integer
+monoSum xs = sum xs
+
+polySum :: Num a => [a] -> a
+polySum xs = sum xs
+
+-- comment
+-- another comment
+bla :: Int -> Int
+bla n = n * 4
+
+{- multi
+   line
+   comment
+-}
+
+ex_float :: Double
+ex_float = 0.0
+
+ex_word :: Word
+ex_word = fromInteger 0
+
+ex_char :: Char
+ex_char = 'a'
+
+char_d :: Char
+char_d = toEnum 100
+
+(+++) :: [a] -> [a] -> [a]
+[] +++ ys = ys
+(x : xs) +++ ys = x : (xs +++ ys)
+
+listMap :: (a -> b) -> [a] -> [b]
+listMap f [] = []
+listMap f (x : xs) = f x : listMap f xs
+
+mapTest :: [Natural] -> [Natural]
+mapTest = map (id . (5 +))
+
+plus3 :: [Natural] -> [Natural]
+plus3 = map (\ n -> n + 3)
+
+doubleLambda :: Natural -> Natural -> Natural
+doubleLambda = \ a b -> a + 2 * b
+
+cnst :: a -> b -> a
+cnst = \ x _ -> x
+
+second :: (b -> c) -> (a, b) -> (a, c)
+second f (x, y) = (x, f y)
+
+doubleTake :: Int -> Int -> [a] -> ([a], [a])
+doubleTake n m = second (take m) . splitAt n
+
+initLast :: [a] -> ([a], a)
+initLast xs = (init xs, last xs)
+
+class MonoidX a where
+    memptyX :: a
+    mappendX :: a -> a -> a
+
+instance MonoidX Natural where
+    memptyX = 0
+    mappendX i j = i + j
+
+instance MonoidX (a -> Natural) where
+    memptyX _ = memptyX
+    mappendX f g x = mappendX (f x) (g x)
+
+instance (MonoidX b) => MonoidX (a -> b) where
+    memptyX _ = memptyX
+    mappendX f g x = mappendX (f x) (g x)
+
+sumMonX :: MonoidX a => [a] -> a
+sumMonX [] = memptyX
+sumMonX (x : xs) = mappendX x (sumMonX xs)
+
+sumMon :: Monoid a => [a] -> a
+sumMon [] = mempty
+sumMon (x : xs) = x <> sumMon xs
+
+data NatSum = MkSum Natural
+
+instance Semigroup NatSum where
+    MkSum a <> MkSum b = MkSum (a + b)
+
+instance Monoid NatSum where
+    mempty = MkSum 0
+
+double :: Monoid a => a -> a
+double x = x <> x
+
+doubleSum :: NatSum -> NatSum
+doubleSum = double
+
+hd :: [a] -> a
+hd [] = error "hd: empty list"
+hd (x : _) = x
+
+five :: Int
+five = hd [5, 3]
+
+ex_bool :: Bool
+ex_bool = True
+
+ex_if :: Natural
+ex_if = if True then 1 else 0
+
+if_over :: Natural
+if_over = (if True then \ x -> x else \ x -> x + 1) 0
+ + diff --git a/test/build/Test.md b/test/build/Test.md new file mode 100644 index 00000000..44889487 --- /dev/null +++ b/test/build/Test.md @@ -0,0 +1,136 @@ +```haskell +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleInstances #-} + +module Test where + +import Numeric.Natural (Natural) + +import Data.Monoid + +data Exp v = Plus (Exp v) (Exp v) + | Lit Natural + | Var v + deriving (Show, Eq) + +eval :: (a -> Natural) -> Exp a -> Natural +eval env (Plus a b) = eval env a + eval env b +eval env (Lit n) = n +eval env (Var x) = env x + +listSum :: [Int] -> Int +listSum [] = 0 +listSum (x : xs) = x + sum xs + +monoSum :: [Integer] -> Integer +monoSum xs = sum xs + +polySum :: Num a => [a] -> a +polySum xs = sum xs + +-- comment +-- another comment +bla :: Int -> Int +bla n = n * 4 + +{- multi + line + comment +-} + +ex_float :: Double +ex_float = 0.0 + +ex_word :: Word +ex_word = fromInteger 0 + +ex_char :: Char +ex_char = 'a' + +char_d :: Char +char_d = toEnum 100 + +(+++) :: [a] -> [a] -> [a] +[] +++ ys = ys +(x : xs) +++ ys = x : (xs +++ ys) + +listMap :: (a -> b) -> [a] -> [b] +listMap f [] = [] +listMap f (x : xs) = f x : listMap f xs + +mapTest :: [Natural] -> [Natural] +mapTest = map (id . (5 +)) + +plus3 :: [Natural] -> [Natural] +plus3 = map (\ n -> n + 3) + +doubleLambda :: Natural -> Natural -> Natural +doubleLambda = \ a b -> a + 2 * b + +cnst :: a -> b -> a +cnst = \ x _ -> x + +second :: (b -> c) -> (a, b) -> (a, c) +second f (x, y) = (x, f y) + +doubleTake :: Int -> Int -> [a] -> ([a], [a]) +doubleTake n m = second (take m) . splitAt n + +initLast :: [a] -> ([a], a) +initLast xs = (init xs, last xs) + +class MonoidX a where + memptyX :: a + mappendX :: a -> a -> a + +instance MonoidX Natural where + memptyX = 0 + mappendX i j = i + j + +instance MonoidX (a -> Natural) where + memptyX _ = memptyX + mappendX f g x = mappendX (f x) (g x) + +instance (MonoidX b) => MonoidX (a -> b) where + memptyX _ = memptyX + mappendX f g x = mappendX (f x) (g x) + +sumMonX :: MonoidX a => [a] -> a +sumMonX [] = memptyX +sumMonX (x : xs) = mappendX x (sumMonX xs) + +sumMon :: Monoid a => [a] -> a +sumMon [] = mempty +sumMon (x : xs) = x <> sumMon xs + +data NatSum = MkSum Natural + +instance Semigroup NatSum where + MkSum a <> MkSum b = MkSum (a + b) + +instance Monoid NatSum where + mempty = MkSum 0 + +double :: Monoid a => a -> a +double x = x <> x + +doubleSum :: NatSum -> NatSum +doubleSum = double + +hd :: [a] -> a +hd [] = error "hd: empty list" +hd (x : _) = x + +five :: Int +five = hd [5, 3] + +ex_bool :: Bool +ex_bool = True + +ex_if :: Natural +ex_if = if True then 1 else 0 + +if_over :: Natural +if_over = (if True then \ x -> x else \ x -> x + 1) 0 + +``` diff --git a/test/build/TransparentFun.hs b/test/build/TransparentFun.hs new file mode 100644 index 00000000..0bc9635d --- /dev/null +++ b/test/build/TransparentFun.hs @@ -0,0 +1,16 @@ +module TransparentFun where + +import Numeric.Natural (Natural) + +testMyId :: Natural +testMyId = 42 + +testTyId :: Int -> Int +testTyId n = n + +data Tree = Tip + | Bin Tree Tree + +testTreeId :: Tree -> Tree +testTreeId = id + diff --git a/test/build/TransparentFun.html b/test/build/TransparentFun.html new file mode 100644 index 00000000..15c41aa8 --- /dev/null +++ b/test/build/TransparentFun.html @@ -0,0 +1,95 @@ + + + + + + + TransparentFun + + + +
module TransparentFun where
+
+import Numeric.Natural (Natural)
+
+testMyId :: Natural
+testMyId = 42
+
+testTyId :: Int -> Int
+testTyId n = n
+
+data Tree = Tip
+          | Bin Tree Tree
+
+testTreeId :: Tree -> Tree
+testTreeId = id
+ + diff --git a/test/build/TransparentFun.md b/test/build/TransparentFun.md new file mode 100644 index 00000000..fc52fe2b --- /dev/null +++ b/test/build/TransparentFun.md @@ -0,0 +1,18 @@ +```haskell +module TransparentFun where + +import Numeric.Natural (Natural) + +testMyId :: Natural +testMyId = 42 + +testTyId :: Int -> Int +testTyId n = n + +data Tree = Tip + | Bin Tree Tree + +testTreeId :: Tree -> Tree +testTreeId = id + +``` diff --git a/test/build/Tree.hs b/test/build/Tree.hs new file mode 100644 index 00000000..9cfb8fe5 --- /dev/null +++ b/test/build/Tree.hs @@ -0,0 +1,7 @@ +module Tree where + +import Numeric.Natural (Natural) + +data Tree = Leaf + | Node Natural Tree Tree + diff --git a/test/build/Tree.html b/test/build/Tree.html new file mode 100644 index 00000000..4055125c --- /dev/null +++ b/test/build/Tree.html @@ -0,0 +1,86 @@ + + + + + + + Tree + + + +
module Tree where
+
+import Numeric.Natural (Natural)
+
+data Tree = Leaf
+          | Node Natural Tree Tree
+ + diff --git a/test/build/Tree.md b/test/build/Tree.md new file mode 100644 index 00000000..499b6981 --- /dev/null +++ b/test/build/Tree.md @@ -0,0 +1,9 @@ +```haskell +module Tree where + +import Numeric.Natural (Natural) + +data Tree = Leaf + | Node Natural Tree Tree + +``` diff --git a/test/build/Tuples.hs b/test/build/Tuples.hs new file mode 100644 index 00000000..d87f1cc8 --- /dev/null +++ b/test/build/Tuples.hs @@ -0,0 +1,37 @@ +module Tuples where + +import Numeric.Natural (Natural) + +swap :: (a, b) -> (b, a) +swap (a, b) = (b, a) + +data TuplePos = Test (TuplePos, Bool) + +t1 :: (Bool, Bool, Bool) +t1 = (True, False, True) + +t2 :: ((Bool, Bool), Bool) +t2 = ((True, False), True) + +t3 :: (Bool, (Bool, Bool)) +t3 = (True, (False, True)) + +pair :: (Int, Int) +pair = (1, 2) + +test :: Int +test = fst pair + snd pair + +test2 :: Bool +test2 + = case t1 of + (a, b, c) -> c + +t4 :: (Natural, Bool) +t4 = (3, True) + +t5 :: (a, b) -> a +t5 p + = case p of + (x, y) -> x + diff --git a/test/build/Tuples.html b/test/build/Tuples.html new file mode 100644 index 00000000..846d5131 --- /dev/null +++ b/test/build/Tuples.html @@ -0,0 +1,116 @@ + + + + + + + Tuples + + + +
module Tuples where
+
+import Numeric.Natural (Natural)
+
+swap :: (a, b) -> (b, a)
+swap (a, b) = (b, a)
+
+data TuplePos = Test (TuplePos, Bool)
+
+t1 :: (Bool, Bool, Bool)
+t1 = (True, False, True)
+
+t2 :: ((Bool, Bool), Bool)
+t2 = ((True, False), True)
+
+t3 :: (Bool, (Bool, Bool))
+t3 = (True, (False, True))
+
+pair :: (Int, Int)
+pair = (1, 2)
+
+test :: Int
+test = fst pair + snd pair
+
+test2 :: Bool
+test2
+  = case t1 of
+        (a, b, c) -> c
+
+t4 :: (Natural, Bool)
+t4 = (3, True)
+
+t5 :: (a, b) -> a
+t5 p
+  = case p of
+        (x, y) -> x
+ + diff --git a/test/build/Tuples.md b/test/build/Tuples.md new file mode 100644 index 00000000..fd64fd4b --- /dev/null +++ b/test/build/Tuples.md @@ -0,0 +1,39 @@ +```haskell +module Tuples where + +import Numeric.Natural (Natural) + +swap :: (a, b) -> (b, a) +swap (a, b) = (b, a) + +data TuplePos = Test (TuplePos, Bool) + +t1 :: (Bool, Bool, Bool) +t1 = (True, False, True) + +t2 :: ((Bool, Bool), Bool) +t2 = ((True, False), True) + +t3 :: (Bool, (Bool, Bool)) +t3 = (True, (False, True)) + +pair :: (Int, Int) +pair = (1, 2) + +test :: Int +test = fst pair + snd pair + +test2 :: Bool +test2 + = case t1 of + (a, b, c) -> c + +t4 :: (Natural, Bool) +t4 = (3, True) + +t5 :: (a, b) -> a +t5 p + = case p of + (x, y) -> x + +``` diff --git a/test/build/TypeBasedUnboxing.hs b/test/build/TypeBasedUnboxing.hs new file mode 100644 index 00000000..f71a61a0 --- /dev/null +++ b/test/build/TypeBasedUnboxing.hs @@ -0,0 +1,5 @@ +module TypeBasedUnboxing where + +foo :: Int -> Int +foo = \ r -> r + diff --git a/test/build/TypeBasedUnboxing.html b/test/build/TypeBasedUnboxing.html new file mode 100644 index 00000000..a42b6d2c --- /dev/null +++ b/test/build/TypeBasedUnboxing.html @@ -0,0 +1,84 @@ + + + + + + + TypeBasedUnboxing + + + +
module TypeBasedUnboxing where
+
+foo :: Int -> Int
+foo = \ r -> r
+ + diff --git a/test/build/TypeBasedUnboxing.md b/test/build/TypeBasedUnboxing.md new file mode 100644 index 00000000..6bdac0df --- /dev/null +++ b/test/build/TypeBasedUnboxing.md @@ -0,0 +1,7 @@ +```haskell +module TypeBasedUnboxing where + +foo :: Int -> Int +foo = \ r -> r + +``` diff --git a/test/build/TypeDirected.hs b/test/build/TypeDirected.hs new file mode 100644 index 00000000..0a508352 --- /dev/null +++ b/test/build/TypeDirected.hs @@ -0,0 +1,15 @@ +module TypeDirected where + +myconst :: a -> a -> a +myconst x y = x + +fn :: Bool -> Int +fn False = 0 +fn True = 5 + +test1 :: Int +test1 = fn True + +test2 :: Int +test2 = fn False + diff --git a/test/build/TypeDirected.html b/test/build/TypeDirected.html new file mode 100644 index 00000000..a1d13183 --- /dev/null +++ b/test/build/TypeDirected.html @@ -0,0 +1,94 @@ + + + + + + + TypeDirected + + + +
module TypeDirected where
+
+myconst :: a -> a -> a
+myconst x y = x
+
+fn :: Bool -> Int
+fn False = 0
+fn True = 5
+
+test1 :: Int
+test1 = fn True
+
+test2 :: Int
+test2 = fn False
+ + diff --git a/test/build/TypeDirected.md b/test/build/TypeDirected.md new file mode 100644 index 00000000..8b91a67c --- /dev/null +++ b/test/build/TypeDirected.md @@ -0,0 +1,17 @@ +```haskell +module TypeDirected where + +myconst :: a -> a -> a +myconst x y = x + +fn :: Bool -> Int +fn False = 0 +fn True = 5 + +test1 :: Int +test1 = fn True + +test2 :: Int +test2 = fn False + +``` diff --git a/test/build/TypeLambda.err b/test/build/TypeLambda.err new file mode 100644 index 00000000..3ccb3eab --- /dev/null +++ b/test/build/TypeLambda.err @@ -0,0 +1,2 @@ +test/Fail/TypeLambda.agda:6,1-4 +Not supported: type-level lambda λ y → Nat diff --git a/test/build/TypeLambda.html b/test/build/TypeLambda.html new file mode 100644 index 00000000..32fd1128 --- /dev/null +++ b/test/build/TypeLambda.html @@ -0,0 +1,21 @@ + + + + + + + TypeLambda + + + +
test/Fail/TypeLambda.agda:6,1-4
+Not supported: type-level lambda λ y → Nat
+ + diff --git a/test/build/TypeLambda.md b/test/build/TypeLambda.md new file mode 100644 index 00000000..94ac62de --- /dev/null +++ b/test/build/TypeLambda.md @@ -0,0 +1,4 @@ +``` +test/Fail/TypeLambda.agda:6,1-4 +Not supported: type-level lambda λ y → Nat +``` diff --git a/test/build/TypeOperatorExport.hs b/test/build/TypeOperatorExport.hs new file mode 100644 index 00000000..ab9c3dc8 --- /dev/null +++ b/test/build/TypeOperatorExport.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeOperators #-} + +module TypeOperatorExport where + +type (<) a b = a + +data (***) a b = (:*:) a b + +(&&&) :: Bool -> Bool -> Bool +False &&& _ = False +_ &&& b2 = b2 + diff --git a/test/build/TypeOperatorExport.html b/test/build/TypeOperatorExport.html new file mode 100644 index 00000000..3cf23a5f --- /dev/null +++ b/test/build/TypeOperatorExport.html @@ -0,0 +1,91 @@ + + + + + + + TypeOperatorExport + + + +
{-# LANGUAGE TypeOperators #-}
+
+module TypeOperatorExport where
+
+type (<) a b = a
+
+data (***) a b = (:*:) a b
+
+(&&&) :: Bool -> Bool -> Bool
+False &&& _ = False
+_ &&& b2 = b2
+ + diff --git a/test/build/TypeOperatorExport.md b/test/build/TypeOperatorExport.md new file mode 100644 index 00000000..92cd767a --- /dev/null +++ b/test/build/TypeOperatorExport.md @@ -0,0 +1,14 @@ +```haskell +{-# LANGUAGE TypeOperators #-} + +module TypeOperatorExport where + +type (<) a b = a + +data (***) a b = (:*:) a b + +(&&&) :: Bool -> Bool -> Bool +False &&& _ = False +_ &&& b2 = b2 + +``` diff --git a/test/build/TypeOperatorImport.hs b/test/build/TypeOperatorImport.hs new file mode 100644 index 00000000..cd0beab7 --- /dev/null +++ b/test/build/TypeOperatorImport.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeOperators #-} + +module TypeOperatorImport where + +import TypeOperatorExport ((&&&), type (***)((:*:)), type (<)) + +test1 :: (<) () Bool +test1 = () + +test2 :: Bool -> Bool -> (***) () Bool +test2 b1 b2 = ((() :*:) . not) (b1 &&& b2) + diff --git a/test/build/TypeOperatorImport.html b/test/build/TypeOperatorImport.html new file mode 100644 index 00000000..ea53c9d9 --- /dev/null +++ b/test/build/TypeOperatorImport.html @@ -0,0 +1,91 @@ + + + + + + + TypeOperatorImport + + + +
{-# LANGUAGE TypeOperators #-}
+
+module TypeOperatorImport where
+
+import TypeOperatorExport ((&&&), type (***)((:*:)), type (<))
+
+test1 :: (<) () Bool
+test1 = ()
+
+test2 :: Bool -> Bool -> (***) () Bool
+test2 b1 b2 = ((() :*:) . not) (b1 &&& b2)
+ + diff --git a/test/build/TypeOperatorImport.md b/test/build/TypeOperatorImport.md new file mode 100644 index 00000000..378e3196 --- /dev/null +++ b/test/build/TypeOperatorImport.md @@ -0,0 +1,14 @@ +```haskell +{-# LANGUAGE TypeOperators #-} + +module TypeOperatorImport where + +import TypeOperatorExport ((&&&), type (***)((:*:)), type (<)) + +test1 :: (<) () Bool +test1 = () + +test2 :: Bool -> Bool -> (***) () Bool +test2 b1 b2 = ((() :*:) . not) (b1 &&& b2) + +``` diff --git a/test/build/TypeOperators.hs b/test/build/TypeOperators.hs new file mode 100644 index 00000000..5b46ad59 --- /dev/null +++ b/test/build/TypeOperators.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TypeOperators #-} + +module TypeOperators where + +import Numeric.Natural (Natural) + +type (:++:) = Either + +mx :: (:++:) Bool Natural +mx = Left True + +type (++++) = Either + +mx' :: (++++) Bool Natural +mx' = Left True + +data (****) a b = (:****) a b + +cross :: (****) Bool Natural +cross = True :**** 1 + diff --git a/test/build/TypeOperators.html b/test/build/TypeOperators.html new file mode 100644 index 00000000..6a0a69f6 --- /dev/null +++ b/test/build/TypeOperators.html @@ -0,0 +1,100 @@ + + + + + + + TypeOperators + + + +
{-# LANGUAGE TypeOperators #-}
+
+module TypeOperators where
+
+import Numeric.Natural (Natural)
+
+type (:++:) = Either
+
+mx :: (:++:) Bool Natural
+mx = Left True
+
+type (++++) = Either
+
+mx' :: (++++) Bool Natural
+mx' = Left True
+
+data (****) a b = (:****) a b
+
+cross :: (****) Bool Natural
+cross = True :**** 1
+ + diff --git a/test/build/TypeOperators.md b/test/build/TypeOperators.md new file mode 100644 index 00000000..23d62845 --- /dev/null +++ b/test/build/TypeOperators.md @@ -0,0 +1,23 @@ +```haskell +{-# LANGUAGE TypeOperators #-} + +module TypeOperators where + +import Numeric.Natural (Natural) + +type (:++:) = Either + +mx :: (:++:) Bool Natural +mx = Left True + +type (++++) = Either + +mx' :: (++++) Bool Natural +mx' = Left True + +data (****) a b = (:****) a b + +cross :: (****) Bool Natural +cross = True :**** 1 + +``` diff --git a/test/build/TypeSignature.hs b/test/build/TypeSignature.hs new file mode 100644 index 00000000..0e50c5cb --- /dev/null +++ b/test/build/TypeSignature.hs @@ -0,0 +1,7 @@ +module TypeSignature where + +import Numeric.Natural (Natural) + +five :: Natural +five = (id :: Natural -> Natural) 5 + diff --git a/test/build/TypeSignature.html b/test/build/TypeSignature.html new file mode 100644 index 00000000..60024a1c --- /dev/null +++ b/test/build/TypeSignature.html @@ -0,0 +1,86 @@ + + + + + + + TypeSignature + + + +
module TypeSignature where
+
+import Numeric.Natural (Natural)
+
+five :: Natural
+five = (id :: Natural -> Natural) 5
+ + diff --git a/test/build/TypeSignature.md b/test/build/TypeSignature.md new file mode 100644 index 00000000..8b5ee7a4 --- /dev/null +++ b/test/build/TypeSignature.md @@ -0,0 +1,9 @@ +```haskell +module TypeSignature where + +import Numeric.Natural (Natural) + +five :: Natural +five = (id :: Natural -> Natural) 5 + +``` diff --git a/test/build/TypeSynonyms.hs b/test/build/TypeSynonyms.hs new file mode 100644 index 00000000..cbfcbafa --- /dev/null +++ b/test/build/TypeSynonyms.hs @@ -0,0 +1,28 @@ +module TypeSynonyms where + +data Nat = Zero + | Suc Nat + +type Nat' = Nat + +myNat :: Nat' +myNat = Suc (Suc Zero) + +data List a = Nil + | Cons a (List a) + +type List' a = List a + +type NatList = List Nat + +myListFun :: List' Nat' -> NatList +myListFun Nil = Nil +myListFun (Cons x xs) = Cons x (myListFun xs) + +type ListList a = List (List a) + +flatten :: ListList a -> List a +flatten Nil = Nil +flatten (Cons Nil xss) = flatten xss +flatten (Cons (Cons x xs) xss) = Cons x (flatten (Cons xs xss)) + diff --git a/test/build/TypeSynonyms.html b/test/build/TypeSynonyms.html new file mode 100644 index 00000000..9c2f5ea5 --- /dev/null +++ b/test/build/TypeSynonyms.html @@ -0,0 +1,107 @@ + + + + + + + TypeSynonyms + + + +
module TypeSynonyms where
+
+data Nat = Zero
+         | Suc Nat
+
+type Nat' = Nat
+
+myNat :: Nat'
+myNat = Suc (Suc Zero)
+
+data List a = Nil
+            | Cons a (List a)
+
+type List' a = List a
+
+type NatList = List Nat
+
+myListFun :: List' Nat' -> NatList
+myListFun Nil = Nil
+myListFun (Cons x xs) = Cons x (myListFun xs)
+
+type ListList a = List (List a)
+
+flatten :: ListList a -> List a
+flatten Nil = Nil
+flatten (Cons Nil xss) = flatten xss
+flatten (Cons (Cons x xs) xss) = Cons x (flatten (Cons xs xss))
+ + diff --git a/test/build/TypeSynonyms.md b/test/build/TypeSynonyms.md new file mode 100644 index 00000000..b25dd5f2 --- /dev/null +++ b/test/build/TypeSynonyms.md @@ -0,0 +1,30 @@ +```haskell +module TypeSynonyms where + +data Nat = Zero + | Suc Nat + +type Nat' = Nat + +myNat :: Nat' +myNat = Suc (Suc Zero) + +data List a = Nil + | Cons a (List a) + +type List' a = List a + +type NatList = List Nat + +myListFun :: List' Nat' -> NatList +myListFun Nil = Nil +myListFun (Cons x xs) = Cons x (myListFun xs) + +type ListList a = List (List a) + +flatten :: ListList a -> List a +flatten Nil = Nil +flatten (Cons Nil xss) = flatten xss +flatten (Cons (Cons x xs) xss) = Cons x (flatten (Cons xs xss)) + +``` diff --git a/test/build/UnboxPragma.hs b/test/build/UnboxPragma.hs new file mode 100644 index 00000000..1f3370d9 --- /dev/null +++ b/test/build/UnboxPragma.hs @@ -0,0 +1,19 @@ +module UnboxPragma where + +sort1 :: [Int] -> [Int] +sort1 xs = xs + +sort2 :: [Int] -> [Int] +sort2 xs = xs + +sort3 :: [Int] -> [Int] +sort3 xs = xs + +sortAll :: [[Int]] +sortAll = map (\ r -> r) (map (\ xs -> xs) [[1, 2], [3]]) + +type Scope name = Int + +emptyScope :: Scope name +emptyScope = 0 + diff --git a/test/build/UnboxPragma.html b/test/build/UnboxPragma.html new file mode 100644 index 00000000..f122a912 --- /dev/null +++ b/test/build/UnboxPragma.html @@ -0,0 +1,98 @@ + + + + + + + UnboxPragma + + + +
module UnboxPragma where
+
+sort1 :: [Int] -> [Int]
+sort1 xs = xs
+
+sort2 :: [Int] -> [Int]
+sort2 xs = xs
+
+sort3 :: [Int] -> [Int]
+sort3 xs = xs
+
+sortAll :: [[Int]]
+sortAll = map (\ r -> r) (map (\ xs -> xs) [[1, 2], [3]])
+
+type Scope name = Int
+
+emptyScope :: Scope name
+emptyScope = 0
+ + diff --git a/test/build/UnboxPragma.md b/test/build/UnboxPragma.md new file mode 100644 index 00000000..d6547e11 --- /dev/null +++ b/test/build/UnboxPragma.md @@ -0,0 +1,21 @@ +```haskell +module UnboxPragma where + +sort1 :: [Int] -> [Int] +sort1 xs = xs + +sort2 :: [Int] -> [Int] +sort2 xs = xs + +sort3 :: [Int] -> [Int] +sort3 xs = xs + +sortAll :: [[Int]] +sortAll = map (\ r -> r) (map (\ xs -> xs) [[1, 2], [3]]) + +type Scope name = Int + +emptyScope :: Scope name +emptyScope = 0 + +``` diff --git a/test/build/Vector.hs b/test/build/Vector.hs new file mode 100644 index 00000000..88d4f868 --- /dev/null +++ b/test/build/Vector.hs @@ -0,0 +1,12 @@ +module Vector where + +data Vec a = Nil + | Cons a (Vec a) + +mapV :: (a -> b) -> Vec a -> Vec b +mapV f Nil = Nil +mapV f (Cons x xs) = Cons (f x) (mapV f xs) + +tailV :: Vec a -> Vec a +tailV (Cons x xs) = xs + diff --git a/test/build/Vector.html b/test/build/Vector.html new file mode 100644 index 00000000..07d56c70 --- /dev/null +++ b/test/build/Vector.html @@ -0,0 +1,91 @@ + + + + + + + Vector + + + +
module Vector where
+
+data Vec a = Nil
+           | Cons a (Vec a)
+
+mapV :: (a -> b) -> Vec a -> Vec b
+mapV f Nil = Nil
+mapV f (Cons x xs) = Cons (f x) (mapV f xs)
+
+tailV :: Vec a -> Vec a
+tailV (Cons x xs) = xs
+ + diff --git a/test/build/Vector.md b/test/build/Vector.md new file mode 100644 index 00000000..635005cb --- /dev/null +++ b/test/build/Vector.md @@ -0,0 +1,14 @@ +```haskell +module Vector where + +data Vec a = Nil + | Cons a (Vec a) + +mapV :: (a -> b) -> Vec a -> Vec b +mapV f Nil = Nil +mapV f (Cons x xs) = Cons (f x) (mapV f xs) + +tailV :: Vec a -> Vec a +tailV (Cons x xs) = xs + +``` diff --git a/test/build/Where.hs b/test/build/Where.hs new file mode 100644 index 00000000..50de44fd --- /dev/null +++ b/test/build/Where.hs @@ -0,0 +1,115 @@ +module Where where + +import Numeric.Natural (Natural) + +bool2nat :: Bool -> Natural +bool2nat = error "postulate: Bool -> Natural" + +ex1 :: Natural +ex1 = mult num + bool2nat True + where + num :: Natural + num = 42 + mult :: Natural -> Natural + mult = (* 100) + +ex2 :: Natural +ex2 = mult num + bool2nat True + where + num :: Natural + num = 42 + mult :: Natural -> Natural + mult = (⊗ 100) + where + (⊗) :: Natural -> Natural -> Natural + (⊗) = (*) + +ex3 :: Natural -> Bool -> Natural +ex3 n b = mult num + bool2nat b + where + num :: Natural + num = 42 + bool2nat b + mult :: Natural -> Natural + mult = (* n) + +ex4 :: Bool -> Natural +ex4 b = mult 42 + where + mult :: Natural -> Natural + mult n = bump n (bool2nat b) + where + bump :: Natural -> Natural -> Natural + bump x y = x * y + (n - bool2nat b) + +ex4' :: Bool -> Natural +ex4' b = mult (bool2nat b) + where + mult :: Natural -> Natural + mult n = bump n (bool2nat b) + where + bump :: Natural -> Natural -> Natural + bump x y = go (x * y) (n - bool2nat b) + where + go :: Natural -> Natural -> Natural + go z w = z + x + w + y + n + bool2nat b + +ex5 :: [Natural] -> Natural +ex5 [] = zro + where + zro :: Natural + zro = 0 +ex5 (n : ns) = mult num + 1 + where + num :: Natural + num = 42 + ex5 ns + mult :: Natural -> Natural + mult = (* n) + +ex6 :: [Natural] -> Bool -> Natural +ex6 [] b = zro + where + zro :: Natural + zro = 0 +ex6 (n : ns) b = mult [num, 1] + where + mult :: [Natural] -> Natural + mult [] = bump 5 (bool2nat b) + where + bump :: Natural -> Natural -> Natural + bump x y = x * y + n + mult (m : ms) = bump n m + where + bump :: Natural -> Natural -> Natural + bump x y = x * y + (m - n) + num :: Natural + num = 42 + ex6 ns True + +ex7 :: Natural -> Natural +ex7 n₀ = go₁ n₀ + where + go₁ :: Natural -> Natural + go₁ n₁ = go₂ (n₀ + n₁) + where + go₂ :: Natural -> Natural + go₂ n₂ = n₀ + n₁ + n₂ + +ex7' :: Natural -> Natural +ex7' n₀ = go₁ n₀ + where + go₁ :: Natural -> Natural + go₁ n₁ = go₂ (n₀ + n₁) + where + go₂ :: Natural -> Natural + go₂ n₂ = go₃ (n₀ + n₁ + n₂) + where + go₃ :: Natural -> Natural + go₃ n₃ = n₀ + n₁ + n₂ + n₃ + +ex8 :: Natural +ex8 = n₂ + where + n₁ :: Natural + n₁ = 1 + n₂ :: Natural + n₂ = n₁ + 1 + diff --git a/test/build/Where.html b/test/build/Where.html new file mode 100644 index 00000000..2f33e441 --- /dev/null +++ b/test/build/Where.html @@ -0,0 +1,194 @@ + + + + + + + Where + + + +
module Where where
+
+import Numeric.Natural (Natural)
+
+bool2nat :: Bool -> Natural
+bool2nat = error "postulate: Bool -> Natural"
+
+ex1 :: Natural
+ex1 = mult num + bool2nat True
+  where
+    num :: Natural
+    num = 42
+    mult :: Natural -> Natural
+    mult = (* 100)
+
+ex2 :: Natural
+ex2 = mult num + bool2nat True
+  where
+    num :: Natural
+    num = 42
+    mult :: Natural -> Natural
+    mult = (⊗ 100)
+      where
+        (⊗) :: Natural -> Natural -> Natural
+        (⊗) = (*)
+
+ex3 :: Natural -> Bool -> Natural
+ex3 n b = mult num + bool2nat b
+  where
+    num :: Natural
+    num = 42 + bool2nat b
+    mult :: Natural -> Natural
+    mult = (* n)
+
+ex4 :: Bool -> Natural
+ex4 b = mult 42
+  where
+    mult :: Natural -> Natural
+    mult n = bump n (bool2nat b)
+      where
+        bump :: Natural -> Natural -> Natural
+        bump x y = x * y + (n - bool2nat b)
+
+ex4' :: Bool -> Natural
+ex4' b = mult (bool2nat b)
+  where
+    mult :: Natural -> Natural
+    mult n = bump n (bool2nat b)
+      where
+        bump :: Natural -> Natural -> Natural
+        bump x y = go (x * y) (n - bool2nat b)
+          where
+            go :: Natural -> Natural -> Natural
+            go z w = z + x + w + y + n + bool2nat b
+
+ex5 :: [Natural] -> Natural
+ex5 [] = zro
+  where
+    zro :: Natural
+    zro = 0
+ex5 (n : ns) = mult num + 1
+  where
+    num :: Natural
+    num = 42 + ex5 ns
+    mult :: Natural -> Natural
+    mult = (* n)
+
+ex6 :: [Natural] -> Bool -> Natural
+ex6 [] b = zro
+  where
+    zro :: Natural
+    zro = 0
+ex6 (n : ns) b = mult [num, 1]
+  where
+    mult :: [Natural] -> Natural
+    mult [] = bump 5 (bool2nat b)
+      where
+        bump :: Natural -> Natural -> Natural
+        bump x y = x * y + n
+    mult (m : ms) = bump n m
+      where
+        bump :: Natural -> Natural -> Natural
+        bump x y = x * y + (m - n)
+    num :: Natural
+    num = 42 + ex6 ns True
+
+ex7 :: Natural -> Natural
+ex7 n₀ = go₁ n₀
+  where
+    go₁ :: Natural -> Natural
+    go₁ n₁ = go₂ (n₀ + n₁)
+      where
+        go₂ :: Natural -> Natural
+        go₂ n₂ = n₀ + n₁ + n₂
+
+ex7' :: Natural -> Natural
+ex7' n₀ = go₁ n₀
+  where
+    go₁ :: Natural -> Natural
+    go₁ n₁ = go₂ (n₀ + n₁)
+      where
+        go₂ :: Natural -> Natural
+        go₂ n₂ = go₃ (n₀ + n₁ + n₂)
+          where
+            go₃ :: Natural -> Natural
+            go₃ n₃ = n₀ + n₁ + n₂ + n₃
+
+ex8 :: Natural
+ex8 = n₂
+  where
+    n₁ :: Natural
+    n₁ = 1
+    n₂ :: Natural
+    n₂ = n₁ + 1
+ + diff --git a/test/build/Where.md b/test/build/Where.md new file mode 100644 index 00000000..b7b9f9fa --- /dev/null +++ b/test/build/Where.md @@ -0,0 +1,117 @@ +```haskell +module Where where + +import Numeric.Natural (Natural) + +bool2nat :: Bool -> Natural +bool2nat = error "postulate: Bool -> Natural" + +ex1 :: Natural +ex1 = mult num + bool2nat True + where + num :: Natural + num = 42 + mult :: Natural -> Natural + mult = (* 100) + +ex2 :: Natural +ex2 = mult num + bool2nat True + where + num :: Natural + num = 42 + mult :: Natural -> Natural + mult = (⊗ 100) + where + (⊗) :: Natural -> Natural -> Natural + (⊗) = (*) + +ex3 :: Natural -> Bool -> Natural +ex3 n b = mult num + bool2nat b + where + num :: Natural + num = 42 + bool2nat b + mult :: Natural -> Natural + mult = (* n) + +ex4 :: Bool -> Natural +ex4 b = mult 42 + where + mult :: Natural -> Natural + mult n = bump n (bool2nat b) + where + bump :: Natural -> Natural -> Natural + bump x y = x * y + (n - bool2nat b) + +ex4' :: Bool -> Natural +ex4' b = mult (bool2nat b) + where + mult :: Natural -> Natural + mult n = bump n (bool2nat b) + where + bump :: Natural -> Natural -> Natural + bump x y = go (x * y) (n - bool2nat b) + where + go :: Natural -> Natural -> Natural + go z w = z + x + w + y + n + bool2nat b + +ex5 :: [Natural] -> Natural +ex5 [] = zro + where + zro :: Natural + zro = 0 +ex5 (n : ns) = mult num + 1 + where + num :: Natural + num = 42 + ex5 ns + mult :: Natural -> Natural + mult = (* n) + +ex6 :: [Natural] -> Bool -> Natural +ex6 [] b = zro + where + zro :: Natural + zro = 0 +ex6 (n : ns) b = mult [num, 1] + where + mult :: [Natural] -> Natural + mult [] = bump 5 (bool2nat b) + where + bump :: Natural -> Natural -> Natural + bump x y = x * y + n + mult (m : ms) = bump n m + where + bump :: Natural -> Natural -> Natural + bump x y = x * y + (m - n) + num :: Natural + num = 42 + ex6 ns True + +ex7 :: Natural -> Natural +ex7 n₀ = go₁ n₀ + where + go₁ :: Natural -> Natural + go₁ n₁ = go₂ (n₀ + n₁) + where + go₂ :: Natural -> Natural + go₂ n₂ = n₀ + n₁ + n₂ + +ex7' :: Natural -> Natural +ex7' n₀ = go₁ n₀ + where + go₁ :: Natural -> Natural + go₁ n₁ = go₂ (n₀ + n₁) + where + go₂ :: Natural -> Natural + go₂ n₂ = go₃ (n₀ + n₁ + n₂) + where + go₃ :: Natural -> Natural + go₃ n₃ = n₀ + n₁ + n₂ + n₃ + +ex8 :: Natural +ex8 = n₂ + where + n₁ :: Natural + n₁ = 1 + n₂ :: Natural + n₂ = n₁ + 1 + +``` diff --git a/test/build/WitnessedFlows.hs b/test/build/WitnessedFlows.hs new file mode 100644 index 00000000..05b9fe92 --- /dev/null +++ b/test/build/WitnessedFlows.hs @@ -0,0 +1,31 @@ +module WitnessedFlows where + +import Control.Monad (guard) + +data Range = MkRange Int Int + +createRange :: Int -> Int -> Maybe Range +createRange low high + = if low <= high then Just (MkRange low high) else Nothing + +createRange' :: Int -> Int -> Maybe Range +createRange' low high + = if low <= high then + if low <= high then Just (MkRange low high) else Nothing else + Nothing + +createRangeCase :: Int -> Int -> Maybe Range +createRangeCase low high + = case low <= high of + True -> Just (MkRange low high) + False -> Nothing + +createRangeGuardSeq :: Int -> Int -> Maybe Range +createRangeGuardSeq low high + = do guard (low <= high) + pure (MkRange low high) + +createRangeGuardFmap :: Int -> Int -> Maybe Range +createRangeGuardFmap low high + = MkRange low high <$ guard (low <= high) + diff --git a/test/build/WitnessedFlows.html b/test/build/WitnessedFlows.html new file mode 100644 index 00000000..fa1ca275 --- /dev/null +++ b/test/build/WitnessedFlows.html @@ -0,0 +1,110 @@ + + + + + + + WitnessedFlows + + + +
module WitnessedFlows where
+
+import Control.Monad (guard)
+
+data Range = MkRange Int Int
+
+createRange :: Int -> Int -> Maybe Range
+createRange low high
+  = if low <= high then Just (MkRange low high) else Nothing
+
+createRange' :: Int -> Int -> Maybe Range
+createRange' low high
+  = if low <= high then
+      if low <= high then Just (MkRange low high) else Nothing else
+      Nothing
+
+createRangeCase :: Int -> Int -> Maybe Range
+createRangeCase low high
+  = case low <= high of
+        True -> Just (MkRange low high)
+        False -> Nothing
+
+createRangeGuardSeq :: Int -> Int -> Maybe Range
+createRangeGuardSeq low high
+  = do guard (low <= high)
+       pure (MkRange low high)
+
+createRangeGuardFmap :: Int -> Int -> Maybe Range
+createRangeGuardFmap low high
+  = MkRange low high <$ guard (low <= high)
+ + diff --git a/test/build/WitnessedFlows.md b/test/build/WitnessedFlows.md new file mode 100644 index 00000000..cc1b23ad --- /dev/null +++ b/test/build/WitnessedFlows.md @@ -0,0 +1,33 @@ +```haskell +module WitnessedFlows where + +import Control.Monad (guard) + +data Range = MkRange Int Int + +createRange :: Int -> Int -> Maybe Range +createRange low high + = if low <= high then Just (MkRange low high) else Nothing + +createRange' :: Int -> Int -> Maybe Range +createRange' low high + = if low <= high then + if low <= high then Just (MkRange low high) else Nothing else + Nothing + +createRangeCase :: Int -> Int -> Maybe Range +createRangeCase low high + = case low <= high of + True -> Just (MkRange low high) + False -> Nothing + +createRangeGuardSeq :: Int -> Int -> Maybe Range +createRangeGuardSeq low high + = do guard (low <= high) + pure (MkRange low high) + +createRangeGuardFmap :: Int -> Int -> Maybe Range +createRangeGuardFmap low high + = MkRange low high <$ guard (low <= high) + +``` diff --git a/test/fail/index.html b/test/fail/index.html new file mode 100644 index 00000000..71d9de6b --- /dev/null +++ b/test/fail/index.html @@ -0,0 +1 @@ + diff --git a/test/index.html b/test/index.html new file mode 100644 index 00000000..c7c2766e --- /dev/null +++ b/test/index.html @@ -0,0 +1 @@ +