{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Abstract Syntax Tree.
module AST.Test where

import Test.Tasty
-- import Test.Tasty.HUnit

import qualified Data.Ord as Ord
import qualified Data.List as List
import Data.Proxy (Proxy(..))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.MonoTraversable as MT

import Language.Symantic.Lib.Data.Bool
import Language.Symantic.Type
import Language.Symantic.Expr as Expr

tests :: TestTree
tests = testGroup "AST" $
 [
 ]

-- * Type 'AST'
data AST
 =   AST Text [AST]
 deriving (Eq)
-- | Custom 'Show' instance a little bit more readable
-- than the automatically derived one.
instance Show AST where
	showsPrec p ast@(AST f args) =
		let n = Text.unpack f in
		case ast of
		 AST _ [] -> showString n
		 AST "->" [a] ->
				showParen (p Ord.>= prec_arrow) $
				showString ("("++n++") ") .
				showsPrec prec_arrow a
		 AST "->" [a, b] ->
				showParen (p Ord.>= prec_arrow) $
				showsPrec prec_arrow a .
				showString (" "++n++" ") .
				showsPrec prec_arrow b
		 AST "\\" [var, ty, body] ->
				showParen (p Ord.>= prec_lambda) $
				showString ("\\(") .
				showsPrec prec_lambda var .
				showString (":") .
				showsPrec prec_lambda ty .
				showString (") -> ") .
				showsPrec prec_lambda body
		 AST "$" [fun, arg] ->
				showParen (p Ord.>= prec_app) $
				showsPrec prec_app fun .
				showString (" $ ") .
				showsPrec prec_app arg
		 _ ->
			showString n .
			showString "(" .
			showString (List.intercalate ", " $ show Prelude.<$> args) .
			showString ")"
		where prec_arrow  = 1
		      prec_lambda = 1
		      prec_app    = 1

-- ** Parsing utilities
from_ast0
 :: forall ty ast ex hs ret.
 ( ty ~ Type_Root_of_Expr ex
 , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
                   (Error_of_Expr ast (Root_of_Expr ex))
 ) => [ast]
 -> ExprFrom ast ex hs ret
 -> ExprFrom ast ex hs ret
from_ast0 asts k' ex ast ctx k =
	case asts of
	 [] -> k' ex ast ctx k
	 _ -> Left $ error_expr ex $
		Error_Expr_Wrong_number_of_arguments ast 0

from_ast1
 :: forall ty ast ex hs ret.
 ( ty ~ Type_Root_of_Expr ex
 , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
                   (Error_of_Expr ast (Root_of_Expr ex))
 ) => [ast] -> (ast -> ExprFrom ast ex hs ret)
 -> ExprFrom ast ex hs ret
from_ast1 asts k' ex ast ctx k =
	case asts of
	 [ast_0] -> k' ast_0 ex ast ctx k
	 _ -> Left $ error_expr ex $
		Error_Expr_Wrong_number_of_arguments ast 1

from_ast2
 :: forall ty ast ex hs ret.
 ( ty ~ Type_Root_of_Expr ex
 , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
                   (Error_of_Expr ast (Root_of_Expr ex))
 ) => [ast] -> (ast -> ast -> ExprFrom ast ex hs ret)
 -> ExprFrom ast ex hs ret
from_ast2 asts k' ex ast ctx k =
	case asts of
	 [ast_0, ast_1] -> k' ast_0 ast_1 ex ast ctx k
	 _ -> Left $ error_expr ex $
		Error_Expr_Wrong_number_of_arguments ast 2

from_ast3
 :: forall ty ast ex hs ret.
 ( ty ~ Type_Root_of_Expr ex
 , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
                   (Error_of_Expr ast (Root_of_Expr ex))
 ) => [ast] -> (ast -> ast -> ast -> ExprFrom ast ex hs ret)
 -> ExprFrom ast ex hs ret
from_ast3 asts k' ex ast ctx k =
	case asts of
	 [ast_0, ast_1, ast_2] -> k' ast_0 ast_1 ast_2 ex ast ctx k
	 _ -> Left $ error_expr ex $
		Error_Expr_Wrong_number_of_arguments ast 3

lit_from_AST
 :: forall root ty lit ex ast hs ret.
 ( ty ~ Type_Root_of_Expr ex
 , root ~ Root_of_Expr ex
 , ast ~ AST
 , Read lit
 , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
                   (Error_of_Expr ast root)
 ) => (forall repr. Sym_of_Expr ex repr => lit -> repr lit)
 -> ty lit -> [ast]
 -> ExprFrom ast ex hs ret
lit_from_AST op ty_lit asts ex ast ctx k =
	case asts of
	 [AST lit []] -> lit_from op ty_lit lit ex ast ctx k
	 _ -> Left $ error_expr ex $
		Error_Expr_Wrong_number_of_arguments ast 1

op1_from_AST
 :: forall root ty lit ex ast hs ret.
 ( ty ~ Type_Root_of_Expr ex
 , root ~ Root_of_Expr ex
 , ast ~ AST
 , Type0_Eq (Type_Root_of_Expr root)
 , Expr_From ast root
 , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
                   (Error_of_Expr ast root)
 , Root_of_Expr root ~ root
 ) => (forall repr. Sym_of_Expr ex repr => repr lit -> repr lit)
 -> ty lit -> [ast]
 -> ExprFrom ast ex hs ret
op1_from_AST op ty_lit asts ex ast ctx k =
	case asts of
	 [ast_x] -> op1_from op ty_lit ast_x ex ast ctx k
	 _ -> Left $ error_expr ex $
		Error_Expr_Wrong_number_of_arguments ast 1

op2_from_AST
 :: forall root ty lit ex ast hs ret.
 ( ty ~ Type_Root_of_Expr ex
 , root ~ Root_of_Expr ex
 , ast ~ AST
 , Type0_Eq (Type_Root_of_Expr root)
 , Expr_From ast root
 , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
                   (Error_of_Expr ast root)
 , Root_of_Expr root ~ root
 ) => (forall repr. Sym_of_Expr ex repr => repr lit -> repr lit -> repr lit)
 -> ty lit -> [ast]
 -> ExprFrom ast ex hs ret
op2_from_AST op ty_lit asts ex ast ctx k =
	case asts of
	 [ast_x, ast_y] -> op2_from op ty_lit ast_x ast_y ex ast ctx k
	 _ -> Left $ error_expr ex $
		Error_Expr_Wrong_number_of_arguments ast 2

class_op1_from_AST
 :: forall root ty c ex ast hs ret.
 ( ty ~ Type_Root_of_Expr ex
 , root ~ Root_of_Expr ex
 , ast ~ AST
 , Type0_Eq (Type_Root_of_Expr root)
 , Expr_From ast root
 , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
                   (Error_of_Expr ast root)
 , Root_of_Expr root ~ root
 , Type0_Constraint c ty
 ) => (forall lit repr. (c lit, Sym_of_Expr ex repr) => repr lit -> repr lit)
 -> Proxy c -> [ast]
 -> ExprFrom ast ex hs ret
class_op1_from_AST op c asts ex ast ctx k =
	case asts of
	 [ast_x] -> class_op1_from op c ast_x ex ast ctx k
	 _ -> Left $ error_expr ex $
		Error_Expr_Wrong_number_of_arguments ast 1

class_op2_from_AST
 :: forall root ty c ex ast hs ret.
 ( ty ~ Type_Root_of_Expr ex
 , root ~ Root_of_Expr ex
 , ast ~ AST
 , Type0_Eq (Type_Root_of_Expr root)
 , Expr_From ast root
 , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
                   (Error_of_Expr ast root)
 , Root_of_Expr root ~ root
 , Type0_Constraint c ty
 ) => (forall lit repr. (c lit, Sym_of_Expr ex repr) => repr lit -> repr lit -> repr lit)
 -> Proxy c -> [ast]
 -> ExprFrom ast ex hs ret
class_op2_from_AST op c asts ex ast ctx k =
	case asts of
	 [ast_x, ast_y] -> class_op2_from op c ast_x ast_y ex ast ctx k
	 _ -> Left $ error_expr ex $
		Error_Expr_Wrong_number_of_arguments ast 2

instance -- Type0_From AST Type_Var0
 ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Var0 root) root)
 ) => Type0_From AST (Type_Var0 root) where
	type0_from ty ast _k =
		Left $ error_type_unsupported ty ast
	 -- NOTE: no support so far.
instance -- Type0_From AST Type_Var1
 ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Var1 root) root)
 ) => Type0_From AST (Type_Var1 root) where
	type0_from ty ast _k =
		Left $ error_type_unsupported ty ast
	 -- NOTE: no support so far.
instance -- Type0_From AST Type_Unit
 ( Type_Root_Lift Type_Unit root
 , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Unit root) root)
 ) => Type0_From AST (Type_Unit root) where
	type0_from ty ast k =
		case ast of
		 AST "()" asts ->
			case asts of
			 [] -> k type_unit
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 0
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type0_From AST Type_Bool
 ( Type_Root_Lift Type_Bool root
 , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Bool root) root)
 ) => Type0_From AST (Type_Bool root) where
	type0_from ty ast k =
		case ast of
		 AST "Bool" asts ->
			case asts of
			 [] -> k type_bool
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 0
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type0_From AST Type_Char
 ( Type_Root_Lift Type_Char root
 , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Char root) root)
 ) => Type0_From AST (Type_Char root) where
	type0_from ty ast k =
		case ast of
		 AST "Char" asts ->
			case asts of
			 [] -> k type_char
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 0
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type0_From AST Type_Int
 ( Type_Root_Lift Type_Int root
 , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Int root) root)
 ) => Type0_From AST (Type_Int root) where
	type0_from ty ast k =
		case ast of
		 AST "Int" asts ->
			case asts of
			 [] -> k type_int
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 0
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type0_From AST Type_Text
 ( Type_Root_Lift Type_Text root
 , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Text root) root)
 ) => Type0_From AST (Type_Text root) where
	type0_from ty ast k =
		case ast of
		 AST "Text" asts ->
			case asts of
			 [] -> k type_text
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 0
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type0_From AST Type_Ordering
 ( Type_Root_Lift Type_Ordering root
 , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Ordering root) root)
 ) => Type0_From AST (Type_Ordering root) where
	type0_from ty ast k =
		case ast of
		 AST "Ordering" asts ->
			case asts of
			 [] -> k type_ordering
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 0
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type0_From AST Type_Fun
 ( Type0_Eq root
 , Type0_From AST root
 , Type_Root_Lift Type_Fun root
 , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_Fun root) root)
 ) => Type0_From AST (Type_Fun root) where
	type0_from ty ast k =
		case ast of
		 AST "->" asts ->
			case asts of
			 [ast_arg, ast_res] -> type_fun_from ty ast_arg ast_res k
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 2
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type0_From AST Type_Maybe
 ( Type0_Eq root
 , Type0_From AST root
 , Type_Root_Lift Type_Maybe root
 , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_Maybe root) root)
 ) => Type0_From AST (Type_Maybe root) where
	type0_from ty ast k =
		case ast of
		 AST "Maybe" asts ->
			case asts of
			 [ast_a] ->
				type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
				k (type_maybe ty_a)
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 1
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type0_From AST Type_List
 ( Type0_Eq root
 , Type0_From AST root
 , Type_Root_Lift Type_List root
 , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_List root) root)
 ) => Type0_From AST (Type_List root) where
	type0_from ty ast k =
		case ast of
		 AST "[]" asts ->
			case asts of
			 [ast_a] ->
				type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
				k (type_list ty_a)
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 1
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type0_From AST Type_Map
 ( Type0_Eq root
 , Type0_From AST root
 , Type_Root_Lift Type_Map root
 , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 , Type0_Constraint Ord root
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_Map root) root)
 ) => Type0_From AST (Type_Map root) where
	type0_from ty ast k =
		case ast of
		 AST "Map" asts ->
			case asts of
			 [ast_k, ast_a] ->
				type0_from (Proxy::Proxy root) ast_k $ \ty_k ->
				type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
				k (type_map ty_k ty_a)
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 2
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type0_From AST Type_Tuple2
 ( Type0_Eq root
 , Type0_From AST root
 , Type_Root_Lift Type_Tuple2 root
 , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_Tuple2 root) root)
 ) => Type0_From AST (Type_Tuple2 root) where
	type0_from ty ast k =
		case ast of
		 AST "(,)" asts ->
			case asts of
			 [ast_a, ast_b] ->
				type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
				type0_from (Proxy::Proxy root) ast_b $ \ty_b ->
				k (type_tuple2 ty_a ty_b)
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 2
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type0_From AST Type_Either
 ( Type0_Eq root
 , Type0_From AST root
 , Type_Root_Lift Type_Either root
 , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_Either root) root)
 ) => Type0_From AST (Type_Either root) where
	type0_from ty ast k =
		case ast of
		 AST "Either" asts ->
			case asts of
			 [ast_l, ast_r] ->
				type0_from (Proxy::Proxy root) ast_l $ \ty_l ->
				type0_from (Proxy::Proxy root) ast_r $ \ty_r ->
				k (type_either ty_l ty_r)
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 2
		 _ -> Left $ error_type_unsupported ty ast

instance -- Type1_From AST Type_Bool
 ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Bool root) root)
 ) => Type1_From AST (Type_Bool root)
instance -- Type1_From AST Type_Int
 ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Int root) root)
 ) => Type1_From AST (Type_Int root)
instance -- Type1_From AST Type_Unit
 ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Unit root) root)
 ) => Type1_From AST (Type_Unit root)
instance -- Type1_From AST Type_Ordering
 ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Ordering root) root)
 ) => Type1_From AST (Type_Ordering root)
instance -- Type1_From AST Type_Var0
 ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Var0 root) root)
 ) => Type1_From AST (Type_Var0 root)
instance -- Type1_From AST Type_Var1
 ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Var1 root) root)
 ) => Type1_From AST (Type_Var1 root)
instance -- Type1_From AST Type_Maybe
 ( Type0_From AST root
 , Type_Root_Lift Type_Maybe root
 , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_Maybe root) root)
 ) => Type1_From AST (Type_Maybe root) where
	type1_from ty ast k =
		case ast of
		 AST "Maybe" asts ->
			case asts of
			 [] -> k (Proxy::Proxy Maybe) type_maybe
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 0
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type1_From AST Type_List
 ( Type0_Eq root
 , Type0_From AST root
 , Type_Root_Lift Type_List root
 , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_List root) root)
 ) => Type1_From AST (Type_List root) where
	type1_from ty ast k =
		case ast of
		 AST "[]" asts ->
			case asts of
			 [] -> k (Proxy::Proxy []) type_list
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 0
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type1_From AST Type_IO
 ( Type0_Eq root
 , Type0_From AST root
 , Type_Root_Lift Type_IO root
 , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_IO root) root)
 ) => Type1_From AST (Type_IO root) where
	type1_from ty ast k =
		case ast of
		 AST "IO" asts ->
			case asts of
			 [] -> k (Proxy::Proxy IO) type_io
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 0
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type1_From AST Type_Fun
 ( Type0_Eq root
 , Type0_From AST root
 , Type_Root_Lift Type_Fun root
 , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_Fun root) root)
 ) => Type1_From AST (Type_Fun root) where
	type1_from ty ast k =
		case ast of
		 AST "->" asts ->
			case asts of
			 [ast_arg] ->
				type0_from (Proxy::Proxy root) ast_arg $ \(ty_arg::root h_arg) ->
				k (Proxy::Proxy ((->) h_arg)) $
					type_fun ty_arg
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 1
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type1_From AST Type_Either
 ( Type0_Eq root
 , Type0_From AST root
 , Type_Root_Lift Type_Either root
 , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_Either root) root)
 ) => Type1_From AST (Type_Either root) where
	type1_from ty ast k =
		case ast of
		 AST "Either" asts ->
			case asts of
			 [ast_l] ->
				type0_from (Proxy::Proxy root) ast_l $ \(ty_l::root h_l) ->
				k (Proxy::Proxy (Either h_l)) $
					type_either ty_l
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 1
		 _ -> Left $ error_type_unsupported ty ast

instance -- Expr_From AST Expr_Bool
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift   Type_Bool (Type_of_Expr root)
 , Type0_Unlift Type_Bool (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Bool root) root)
 ) => Expr_From AST (Expr_Bool root) where
	expr_from ex ast =
		case ast of
		 AST "bool" asts -> lit_from_AST bool      type_bool asts ex ast
		 AST "not"  asts -> op1_from_AST Expr.not  type_bool asts ex ast
		 AST "&&"   asts -> op2_from_AST (Expr.&&) type_bool asts ex ast
		 AST "||"   asts -> op2_from_AST (Expr.||) type_bool asts ex ast
		 AST "xor"  asts -> op2_from_AST Expr.xor  type_bool asts ex ast
		 _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_If
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift Type_Bool (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_If root) root)
 ) => Expr_From AST (Expr_If root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "if" asts -> from_ast3 asts if_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_When
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift Type_Bool (Type_of_Expr root)
 , Type0_Lift Type_Unit (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_When root) root)
 ) => Expr_From AST (Expr_When root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "when" asts -> from_ast2 asts when_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Int
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift   Type_Int (Type_of_Expr root)
 , Type0_Unlift Type_Int (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Int root) root)
 ) => Expr_From AST (Expr_Int root) where
	expr_from ex ast =
		case ast of
		 AST "int" asts -> lit_from_AST int type_int asts ex ast
		 _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Integer
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift   Type_Integer (Type_of_Expr root)
 , Type0_Unlift Type_Integer (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Integer root) root)
 ) => Expr_From AST (Expr_Integer root) where
	expr_from ex ast =
		case ast of
		 AST "integer" asts -> lit_from_AST integer type_integer asts ex ast
		 _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Num
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Constraint Num (Type_Root_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Num root) root)
 ) => Expr_From AST (Expr_Num root) where
	expr_from ex ast =
		let c = (Proxy :: Proxy Num) in
		case ast of
		 AST "abs"    asts -> class_op1_from_AST Expr.abs    c asts ex ast
		 AST "negate" asts -> class_op1_from_AST Expr.negate c asts ex ast
		 AST "+"      asts -> class_op2_from_AST (Expr.+)    c asts ex ast
		 AST "-"      asts -> class_op2_from_AST (Expr.-)    c asts ex ast
		 AST "*"      asts -> class_op2_from_AST (Expr.*)    c asts ex ast
		 _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Integral
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Constraint Integral (Type_Root_of_Expr root)
 , Type0_Lift Type_Tuple2  (Type_of_Expr root)
 , Type0_Lift Type_Integer (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Integral root) root)
 ) => Expr_From AST (Expr_Integral root) where
	expr_from ex ast ctx k =
		let c = (Proxy :: Proxy Integral) in
		case ast of
		 AST "quot"    asts -> class_op2_from_AST Expr.quot c asts ex ast ctx k
		 AST "div"     asts -> class_op2_from_AST Expr.div  c asts ex ast ctx k
		 AST "rem"     asts -> class_op2_from_AST Expr.rem  c asts ex ast ctx k
		 AST "mod"     asts -> class_op2_from_AST Expr.mod  c asts ex ast ctx k
		 AST "quotRem" asts -> from_ast2 asts quotRem_from         ex ast ctx k
		 AST "divMod"  asts -> from_ast2 asts divMod_from          ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Text
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift   Type_Text (Type_of_Expr root)
 , Type0_Unlift Type_Text (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Text root) root)
 ) => Expr_From AST (Expr_Text root) where
	expr_from ex ast =
		case ast of
		 AST "text" asts ->
			case asts of
			 [AST lit []] -> \_ctx k ->
				k type_text $ Forall_Repr_with_Context $ \_c -> text lit
			 _ -> \_ctx _k -> Left $ error_expr ex $
				Error_Expr_Wrong_number_of_arguments ast 1
		 _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Char
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift   Type_Char (Type_of_Expr root)
 , Type0_Unlift Type_Char (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Char root) root)
 ) => Expr_From AST (Expr_Char root) where
	expr_from ex ast =
		case ast of
		 AST "char" asts ->
			case asts of
			 [AST lit []] ->
				case Text.uncons lit of
				 Just (c, "") -> \_ctx k ->
					k type_char $ Forall_Repr_with_Context $ \_c -> char c
				 _ -> \_ctx _k -> Left $ error_expr ex $
					Error_Expr_Read (Error_Read lit) ast
			 _ -> \_ctx _k -> Left $ error_expr ex $
				Error_Expr_Wrong_number_of_arguments ast 1
		 AST "char_toUpper" asts -> op1_from_AST char_toUpper type_char asts ex ast
		 _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Lambda
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_From AST (Type_Root_of_Expr root)
 , Type0_Lift   Type_Fun (Type_of_Expr root)
 , Type0_Unlift Type_Fun (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_Lambda AST)       (Error_of_Expr AST root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Lambda root) root)
 ) => Expr_From AST (Expr_Lambda root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "var" asts ->
			case asts of
			 [AST name []] -> var_from name ex ast ctx k
			 _ -> Left $ error_expr ex $
				Error_Expr_Wrong_number_of_arguments ast 1
		 AST "$"   asts -> from_ast2 asts app_from ex ast ctx k
		 AST "\\"  asts -> go_lam asts
		 AST "let" asts -> go_let asts
		 _ -> Left $ error_expr_unsupported ex ast
		where
		go_lam asts =
			case asts of
			 [AST name [], ast_ty_arg, ast_body] ->
				lam_from name ast_ty_arg ast_body ex ast ctx k
			 _ -> Left $ error_expr ex $
				Error_Expr_Wrong_number_of_arguments ast 3
		go_let asts =
			case asts of
			 [AST name [], ast_var, ast_body] ->
				let_from name ast_var ast_body ex ast ctx k
			 _ -> Left $ error_expr ex $
				Error_Expr_Wrong_number_of_arguments ast 3
instance -- Expr_From AST Expr_Maybe
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_From AST (Type_Root_of_Expr root)
 , Type0_Lift   Type_Fun   (Type_of_Expr root)
 , Type0_Unlift Type_Fun   (Type_of_Expr root)
 , Type0_Lift   Type_Maybe (Type_of_Expr root)
 , Type0_Unlift Type_Maybe (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Maybe root) root)
 ) => Expr_From AST (Expr_Maybe root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "maybe"   asts -> from_ast3 asts maybe_from   ex ast ctx k
		 AST "nothing" asts -> from_ast1 asts nothing_from ex ast ctx k
		 AST "just"    asts -> from_ast1 asts just_from    ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Eq
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift Type_Bool (Type_of_Expr root)
 , Type0_Constraint Eq (Type_Root_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Eq root) root)
 ) => Expr_From AST (Expr_Eq root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "==" asts -> from_ast2 asts (eq_from (Expr.==)) ex ast ctx k
		 AST "/=" asts -> from_ast2 asts (eq_from (Expr./=)) ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Ord
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift Type_Bool     (Type_of_Expr root)
 , Type0_Lift Type_Ordering (Type_of_Expr root)
 , Type0_Constraint Ord (Type_Root_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Ord root) root)
 ) => Expr_From AST (Expr_Ord root) where
	expr_from ex ast ctx k =
		let c = (Proxy :: Proxy Ord) in
		case ast of
		 AST "compare" asts -> from_ast2 asts compare_from ex ast ctx k
		 AST "<"       asts -> from_ast2 asts (ord_from (Expr.<))  ex ast ctx k
		 AST "<="      asts -> from_ast2 asts (ord_from (Expr.<=)) ex ast ctx k
		 AST ">"       asts -> from_ast2 asts (ord_from (Expr.>))  ex ast ctx k
		 AST ">="      asts -> from_ast2 asts (ord_from (Expr.>=)) ex ast ctx k
		 AST "min"     asts -> class_op2_from_AST Expr.min c asts ex ast ctx k
		 AST "max"     asts -> class_op2_from_AST Expr.max c asts ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_List
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_From AST (Type_Root_of_Expr root)
 , Type0_Lift   Type_Fun  (Type_of_Expr root)
 , Type0_Unlift Type_Fun  (Type_of_Expr root)
 , Type0_Lift   Type_List (Type_of_Expr root)
 , Type0_Unlift Type_List (Type_of_Expr root)
 , Type0_Lift   Type_Bool (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_List root) root)
 ) => Expr_From AST (Expr_List root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "[]"          asts -> from_ast1 asts list_empty_from  ex ast ctx k
		 AST ":"           asts -> from_ast2 asts list_cons_from   ex ast ctx k
		 AST "list_filter" asts -> from_ast2 asts list_filter_from ex ast ctx k
		 AST "list"        asts ->
			case asts of
			 ast_ty_a:asts' -> list_from ast_ty_a asts' ex ast ctx k
			 _ -> Left $ error_expr ex $
				Error_Expr_Wrong_number_of_arguments ast 1
		 AST "list_zipWith" asts -> from_ast3 asts list_zipWith_from ex ast ctx k
		 AST "list_reverse" asts -> from_ast1 asts list_reverse_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Map
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift   Type_Fun    (Type_of_Expr root)
 , Type0_Unlift Type_Fun    (Type_of_Expr root)
 , Type0_Lift   Type_Bool   (Type_of_Expr root)
 , Type0_Unlift Type_Bool   (Type_of_Expr root)
 , Type0_Lift   Type_List   (Type_of_Expr root)
 , Type0_Unlift Type_List   (Type_of_Expr root)
 , Type0_Lift   Type_Map    (Type_of_Expr root)
 , Type0_Unlift Type_Map    (Type_of_Expr root)
 , Type0_Lift   Type_Maybe  (Type_of_Expr root)
 , Type0_Unlift Type_Maybe  (Type_of_Expr root)
 , Type0_Lift   Type_Tuple2 (Type_of_Expr root)
 , Type0_Unlift Type_Tuple2 (Type_of_Expr root)
 , Type0_Constraint Ord (Type_Root_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Map root) root)
 ) => Expr_From AST (Expr_Map root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "map_from_list"    asts -> from_ast1 asts map_from_list_from ex ast ctx k
		 AST "mapWithKey"       asts -> from_ast2 asts mapWithKey_from ex ast ctx k
		 AST "map_lookup"       asts -> from_ast2 asts map_lookup_from ex ast ctx k
		 AST "map_keys"         asts -> from_ast1 asts map_keys_from ex ast ctx k
		 AST "map_member"       asts -> from_ast2 asts map_member_from ex ast ctx k
		 AST "map_insert"       asts -> from_ast3 asts map_insert_from ex ast ctx k
		 AST "map_delete"       asts -> from_ast2 asts map_delete_from ex ast ctx k
		 AST "map_difference"   asts -> from_ast2 asts map_difference_from ex ast ctx k
		 AST "map_foldrWithKey" asts -> from_ast3 asts map_foldrWithKey_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Functor
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift   Type_Fun (Type_of_Expr root)
 , Type0_Unlift Type_Fun (Type_of_Expr root)
 , Type1_Unlift (Type_of_Expr root)
 , Type1_Constraint Functor (Type_Root_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Functor root) root)
 ) => Expr_From AST (Expr_Functor root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "fmap" asts -> from_ast2 asts fmap_from ex ast ctx k
		 AST "<$>"  asts -> from_ast2 asts fmap_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_MonoFunctor
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift   Type_Fun (Type_of_Expr root)
 , Type0_Unlift Type_Fun (Type_of_Expr root)
 , Type1_Unlift (Type_of_Expr root)
 , Type0_Constraint MT.MonoFunctor (Type_Root_of_Expr root)
 , Type0_Family Type_Family_MonoElement (Type_Root_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_MonoFunctor root) root)
 ) => Expr_From AST (Expr_MonoFunctor root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "omap" asts -> from_ast2 asts omap_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Applicative
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type1_From AST (Type_Root_of_Expr root)
 , Type0_Lift   Type_Fun (Type_of_Expr root)
 , Type0_Unlift Type_Fun (Type_of_Expr root)
 , Type1_Eq (Type_Root_of_Expr root)
 , Type1_Unlift (Type_of_Expr root)
 , Type1_Constraint Applicative (Type_Root_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Applicative root) root)
 ) => Expr_From AST (Expr_Applicative root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "pure" asts -> from_ast2 asts pure_from     ex ast ctx k
		 AST "<*>"  asts -> from_ast2 asts ltstargt_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Traversable
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift   Type_Fun (Type_of_Expr root)
 , Type0_Unlift Type_Fun (Type_of_Expr root)
 , Type1_Eq (Type_Root_of_Expr root)
 , Type1_Unlift (Type_of_Expr root)
 , Type1_Constraint Applicative (Type_Root_of_Expr root)
 , Type1_Constraint Traversable (Type_Root_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Traversable root) root)
 ) => Expr_From AST (Expr_Traversable root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "traverse"  asts -> from_ast2 asts traverse_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Foldable
 ( Expr_From AST root
 , Type0_Constraint Eq       (Type_Root_of_Expr root)
 , Type0_Constraint Monoid   (Type_Root_of_Expr root)
 , Type0_Constraint Ord      (Type_Root_of_Expr root)
 , Type0_Eq                  (Type_Root_of_Expr root)
 , Type0_Lift   Type_Bool    (Type_of_Expr root)
 , Type0_Lift   Type_Fun     (Type_of_Expr root)
 , Type0_Lift   Type_Int     (Type_of_Expr root)
 , Type0_Unlift Type_Fun     (Type_of_Expr root)
 , Type1_Constraint Foldable (Type_Root_of_Expr root)
 , Type1_Eq (Type_Root_of_Expr root)
 , Type1_Unlift (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Foldable root) root)
 ) => Expr_From AST (Expr_Foldable root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "foldMap" asts -> from_ast2 asts foldMap_from ex ast ctx k
		 AST "null"    asts -> from_ast1 asts null_from ex ast ctx k
		 AST "length"  asts -> from_ast1 asts length_from ex ast ctx k
		 AST "minimum" asts -> from_ast1 asts minimum_from ex ast ctx k
		 AST "maximum" asts -> from_ast1 asts maximum_from ex ast ctx k
		 AST "elem"    asts -> from_ast2 asts elem_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Monoid
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_From AST (Type_Root_of_Expr root)
 , Type0_Constraint Monoid (Type_Root_of_Expr root)
 , Type0_Lift   Type_Int  (Type_of_Expr root)
 , Type0_Lift   Type_Bool (Type_of_Expr root)
 , Type0_Lift   Type_Fun  (Type_of_Expr root)
 , Type0_Unlift Type_Fun  (Type_of_Expr root)
 , Type1_Unlift (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Monoid root) root)
 ) => Expr_From AST (Expr_Monoid root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "mempty"  asts -> from_ast1 asts mempty_from ex ast ctx k
		 AST "mappend" asts -> from_ast2 asts mappend_from ex ast ctx k
		 AST "<>"      asts -> from_ast2 asts mappend_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Monad
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift   Type_Fun (Type_of_Expr root)
 , Type0_Unlift Type_Fun (Type_of_Expr root)
 , Type1_From AST (Type_Root_of_Expr root)
 , Type1_Constraint Monad (Type_Root_of_Expr root)
 , Type1_Eq (Type_Root_of_Expr root)
 , Type1_Unlift (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Monad root) root)
 ) => Expr_From AST (Expr_Monad root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "return" asts -> from_ast2 asts return_from ex ast ctx k
		 AST ">>="    asts -> from_ast2 asts bind_from   ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Either
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_From AST (Type_Root_of_Expr root)
 , Type0_Lift   Type_Either (Type_of_Expr root)
 , Type0_Unlift Type_Either (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Either root) root)
 ) => Expr_From AST (Expr_Either root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "left"  asts -> from_ast2 asts left_from  ex ast ctx k
		 AST "right" asts -> from_ast2 asts right_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast
instance -- Expr_From AST Expr_Tuple2
 ( Expr_From AST root
 , Type0_Eq (Type_Root_of_Expr root)
 , Type0_Lift   Type_Tuple2 (Type_of_Expr root)
 , Type0_Unlift Type_Tuple2 (Type_of_Expr root)
 , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 , Root_of_Expr root ~ root
 , IBool (Is_Last_Expr (Expr_Tuple2 root) root)
 ) => Expr_From AST (Expr_Tuple2 root) where
	expr_from ex ast ctx k =
		case ast of
		 AST "(,)" asts -> from_ast2 asts tuple2_from ex ast ctx k
		 AST "fst" asts -> from_ast1 asts fst_from ex ast ctx k
		 AST "snd" asts -> from_ast1 asts snd_from ex ast ctx k
		 _ -> Left $ error_expr_unsupported ex ast