{-# 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.Map.Strict (Map)
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 from ex ast ctx k =
	case asts of
	 [] -> from 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 from ex ast ctx k =
	case asts of
	 [ast_0] -> from ast_0 ex ast ctx k
	 _ -> Left $ error_expr ex $
		Error_Expr_Wrong_number_of_arguments ast 1

from_ast01
 :: 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]
 -> Maybe (ExprFrom ast ex hs ret)
 -> (ast -> ExprFrom ast ex hs ret)
 -> ExprFrom ast ex hs ret
from_ast01 asts from0 from1 ex ast ctx k =
	case asts of
	 [] | Just from <- from0 -> from ex ast ctx k
	 [ast_0] -> from1 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 from ex ast ctx k =
	case asts of
	 [ast_0, ast_1] -> from ast_0 ast_1 ex ast ctx k
	 _ -> Left $ error_expr ex $
		Error_Expr_Wrong_number_of_arguments ast 2

from_ast012
 :: 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]
 -> Maybe (        ExprFrom ast ex hs ret)
 -> Maybe ( ast -> ExprFrom ast ex hs ret)
 -> (ast -> ast -> ExprFrom ast ex hs ret)
 -> ExprFrom ast ex hs ret
from_ast012 asts from0 from1 from2 ex ast ctx k =
	case asts of
	 [] | Just from <- from0 -> from ex ast ctx k
	 [ast_0] | Just from <- from1 -> from ast_0 ex ast ctx k
	 [ast_0, ast_1] -> from2 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 from ex ast ctx k =
	case asts of
	 [ast_0, ast_1, ast_2] -> from 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

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_Integer
 ( Type_Root_Lift Type_Integer root
 , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 , IBool (Is_Last_Type (Type_Integer root) root)
 ) => Type0_From AST (Type_Integer root) where
	type0_from ty ast k =
		case ast of
		 AST "Integer" asts ->
			case asts of
			 [] -> k type_integer
			 _ -> 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_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 -- Type1_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)
 , Root_of_Type root ~ root
 , IBool (Is_Last_Type (Type_Map root) root)
 ) => Type1_From AST (Type_Map root) where
	type1_from ty ast k =
		case ast of
		 AST "Map" asts ->
			case asts of
			 [ast_k] ->
				type0_from (Proxy::Proxy root) ast_k $ \(ty_k::root h_k) ->
				k (Proxy::Proxy (Map h_k)) $
					type_map ty_k
			 _ -> Left $ error_type_lift $
				Error_Type_Wrong_number_of_arguments ast 1
		 _ -> Left $ error_type_unsupported ty ast
instance -- Type1_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)
 ) => Type1_From AST (Type_Tuple2 root) where
	type1_from ty ast k =
		case ast of
		 AST "(,)" asts ->
			case asts of
			 [ast_a] ->
				type0_from (Proxy::Proxy root) ast_a $ \(ty_a::root h_a) ->
				k (Proxy::Proxy ((,) h_a)) $
					type_tuple2 ty_a
			 _ -> 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)
 , Type0_Lift   Type_Fun  (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 t asts ex ast
		 AST "not"  asts -> from_ast01  asts (Just $ op1_from0 Expr.not   t) (op1_from Expr.not t) ex ast
		 AST "&&"   asts -> from_ast012 asts (Just $ op2_from0 (Expr.&&)  t) (Just $ op2_from1 (Expr.&&) t) (op2_from (Expr.&&) t) ex ast
		 AST "||"   asts -> from_ast012 asts (Just $ op2_from0 (Expr.||)  t) (Just $ op2_from1 (Expr.||) t) (op2_from (Expr.||) t) ex ast
		 AST "xor"  asts -> from_ast012 asts (Just $ op2_from0 (Expr.xor) t) (Just $ op2_from1 Expr.xor  t) (op2_from Expr.xor  t) ex ast
		 _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
		where t = type_bool
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)
 , Type0_Lift   Type_Integer (Type_of_Expr root)
 , Type0_Unlift Type_Integer (Type_of_Expr root)
 , Type0_Lift   Type_Fun     (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_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 -> from_ast1 asts (class_op1_from Expr.abs    c) ex ast
		 AST "negate" asts -> from_ast1 asts (class_op1_from Expr.negate c) ex ast
		 AST "signum" asts -> from_ast1 asts (class_op1_from Expr.signum c) ex ast
		 AST "+"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.+) c) (class_op2_from (Expr.+) c) ex ast
		 AST "-"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.-) c) (class_op2_from (Expr.-) c) ex ast
		 AST "*"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.*) c) (class_op2_from (Expr.*) c) ex ast
		 AST "fromInteger" asts -> from_ast1 asts fromInteger_from 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_Fun     (Type_of_Expr root)
 , Type0_Lift Type_Integer (Type_of_Expr root)
 , Type0_Lift 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_Integral root) root)
 ) => Expr_From AST (Expr_Integral root) where
	expr_from ex ast =
		let c = (Proxy :: Proxy Integral) in
		case ast of
		 AST "quot"    asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.quot c) (class_op2_from Expr.quot c) ex ast
		 AST "div"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.div  c) (class_op2_from Expr.div  c) ex ast
		 AST "rem"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.rem  c) (class_op2_from Expr.rem  c) ex ast
		 AST "mod"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.mod  c) (class_op2_from Expr.mod  c) ex ast
		 AST "quotRem" asts -> from_ast012 asts Nothing (Just quotRem_from1) quotRem_from ex ast
		 AST "divMod"  asts -> from_ast012 asts Nothing (Just divMod_from1)  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)
 , Type0_Lift   Type_Fun  (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 -> from_ast01 asts (Just $ op1_from0 char_toUpper type_char) (op1_from char_toUpper type_char) 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 =
		case ast of
		 AST "maybe"   asts -> from_ast3 asts maybe_from   ex ast
		 AST "nothing" asts -> from_ast1 asts nothing_from ex ast
		 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_Lift Type_Fun  (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 =
		case ast of
		 AST "==" asts -> from_ast012 asts Nothing (Just (eq_from1 (Expr.==))) (eq_from (Expr.==)) ex ast
		 AST "/=" asts -> from_ast012 asts Nothing (Just (eq_from1 (Expr./=))) (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_Fun      (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 =
		let c = (Proxy :: Proxy Ord) in
		case ast of
		 AST "compare" asts -> from_ast012 asts Nothing (Just compare_from1) compare_from ex ast
		 AST "<"       asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.<))  (ord_from (Expr.<))  ex ast
		 AST "<="      asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.<=)) (ord_from (Expr.<=)) ex ast
		 AST ">"       asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.>))  (ord_from (Expr.>))  ex ast
		 AST ">="      asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.>=)) (ord_from (Expr.>=)) ex ast
		 AST "min"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.min c) (class_op2_from Expr.min c) ex ast
		 AST "max"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.max c) (class_op2_from Expr.max c) 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 =
		case ast of
		 AST "[]"          asts -> from_ast1 asts list_empty_from  ex ast
		 AST ":"           asts -> from_ast2 asts list_cons_from   ex ast
		 AST "list_filter" asts -> from_ast2 asts list_filter_from ex ast
		 AST "list"        asts -> \ctx k ->
			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
		 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 =
		case ast of
		 AST "map_from_list"    asts -> from_ast1 asts map_from_list_from ex ast
		 AST "mapWithKey"       asts -> from_ast2 asts mapWithKey_from ex ast
		 AST "map_lookup"       asts -> from_ast2 asts map_lookup_from ex ast
		 AST "map_keys"         asts -> from_ast1 asts map_keys_from ex ast
		 AST "map_member"       asts -> from_ast2 asts map_member_from ex ast
		 AST "map_insert"       asts -> from_ast3 asts map_insert_from ex ast
		 AST "map_delete"       asts -> from_ast2 asts map_delete_from ex ast
		 AST "map_difference"   asts -> from_ast2 asts map_difference_from ex ast
		 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 =
		case ast of
		 AST "fmap" asts -> from_ast2 asts fmap_from ex ast
		 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 =
		case ast of
		 AST "pure" asts -> from_ast2 asts pure_from     ex ast
		 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 Num      (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_Lift   Type_List    (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 =
		case ast of
		 AST "foldMap" asts -> from_ast2 asts foldMap_from ex ast
		 AST "foldr"   asts -> from_ast3 asts (foldr_from Expr.foldr) ex ast
		 AST "foldr'"  asts -> from_ast3 asts (foldr_from Expr.foldr') ex ast
		 AST "foldl"   asts -> from_ast3 asts (foldl_from Expr.foldl) ex ast
		 AST "foldl'"  asts -> from_ast3 asts (foldl_from Expr.foldl') ex ast
		 AST "null"    asts -> from_ast1 asts null_from ex ast
		 AST "length"  asts -> from_ast1 asts length_from ex ast
		 AST "minimum" asts -> from_ast1 asts minimum_from ex ast
		 AST "maximum" asts -> from_ast1 asts maximum_from ex ast
		 AST "elem"    asts -> from_ast2 asts elem_from ex ast
		 AST "sum"     asts -> from_ast1 asts sum_from ex ast
		 AST "product" asts -> from_ast1 asts product_from ex ast
		 AST "toList"  asts -> from_ast1 asts toList_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 =
		case ast of
		 AST "mempty"  asts -> from_ast1 asts mempty_from ex ast
		 AST "mappend" asts -> from_ast012 asts Nothing (Just mappend_from1) mappend_from ex ast
		 AST "<>"      asts -> from_ast012 asts Nothing (Just mappend_from1) 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 =
		case ast of
		 AST "return" asts -> from_ast2 asts return_from ex ast
		 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 =
		case ast of
		 AST "left"  asts -> from_ast2 asts left_from  ex ast
		 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 =
		case ast of
		 AST "(,)" asts -> from_ast2 asts tuple2_from ex ast
		 AST "fst" asts -> from_ast1 asts fst_from ex ast
		 AST "snd" asts -> from_ast1 asts snd_from ex ast
		 _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast