Language/Symantic/AST/Test.hs

   1 {-# LANGUAGE ConstraintKinds #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE GADTs #-}
   5 {-# LANGUAGE MultiParamTypeClasses #-}
   6 {-# LANGUAGE OverloadedStrings #-}
   7 {-# LANGUAGE Rank2Types #-}
   8 {-# LANGUAGE ScopedTypeVariables #-}
   9 {-# LANGUAGE TypeFamilies #-}
  10 {-# LANGUAGE TypeOperators #-}
  11 {-# LANGUAGE UndecidableInstances #-}
  12 -- | Abstract Syntax Tree.
  13 module AST.Test where
  14
  15 import Test.Tasty
  16 -- import Test.Tasty.HUnit
  17
  18 import qualified Data.Ord as Ord
  19 import qualified Data.List as List
  20 import Data.Proxy (Proxy(..))
  21 import Data.Text (Text)
  22 import qualified Data.Text as Text
  23 import qualified Data.MonoTraversable as MT
  24
  25 import Language.Symantic.Lib.Data.Bool
  26 import Language.Symantic.Type
  27 import Language.Symantic.Expr as Expr
  28
  29 tests :: TestTree
  30 tests = testGroup "AST" $
  31  [
  32  ]
  33
  34 -- * Type 'AST'
  35 data AST
  36  =   AST Text [AST]
  37  deriving (Eq)
  38 -- | Custom 'Show' instance a little bit more readable
  39 -- than the automatically derived one.
  40 instance Show AST where
  41         showsPrec p ast@(AST f args) =
  42                 let n = Text.unpack f in
  43                 case ast of
  44                  AST _ [] -> showString n
  45                  AST "->" [a] ->
  46                                 showParen (p Ord.>= prec_arrow) $
  47                                 showString ("("++n++") ") .
  48                                 showsPrec prec_arrow a
  49                  AST "->" [a, b] ->
  50                                 showParen (p Ord.>= prec_arrow) $
  51                                 showsPrec prec_arrow a .
  52                                 showString (" "++n++" ") .
  53                                 showsPrec prec_arrow b
  54                  AST "\\" [var, ty, body] ->
  55                                 showParen (p Ord.>= prec_lambda) $
  56                                 showString ("\\(") .
  57                                 showsPrec prec_lambda var .
  58                                 showString (":") .
  59                                 showsPrec prec_lambda ty .
  60                                 showString (") -> ") .
  61                                 showsPrec prec_lambda body
  62                  AST "$" [fun, arg] ->
  63                                 showParen (p Ord.>= prec_app) $
  64                                 showsPrec prec_app fun .
  65                                 showString (" $ ") .
  66                                 showsPrec prec_app arg
  67                  _ ->
  68                         showString n .
  69                         showString "(" .
  70                         showString (List.intercalate ", " $ show Prelude.<$> args) .
  71                         showString ")"
  72                 where prec_arrow  = 1
  73                       prec_lambda = 1
  74                       prec_app    = 1
  75
  76 -- ** Parsing utilities
  77 from_ast0
  78  :: forall ty ast ex hs ret.
  79  ( ty ~ Type_Root_of_Expr ex
  80  , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
  81                    (Error_of_Expr ast (Root_of_Expr ex))
  82  ) => [ast]
  83  -> ExprFrom ast ex hs ret
  84  -> ExprFrom ast ex hs ret
  85 from_ast0 asts from ex ast ctx k =
  86         case asts of
  87          [] -> from ex ast ctx k
  88          _ -> Left $ error_expr ex $
  89                 Error_Expr_Wrong_number_of_arguments ast 0
  90
  91 from_ast1
  92  :: forall ty ast ex hs ret.
  93  ( ty ~ Type_Root_of_Expr ex
  94  , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
  95                    (Error_of_Expr ast (Root_of_Expr ex))
  96  ) => [ast] -> (ast -> ExprFrom ast ex hs ret)
  97  -> ExprFrom ast ex hs ret
  98 from_ast1 asts from ex ast ctx k =
  99         case asts of
 100          [ast_0] -> from ast_0 ex ast ctx k
 101          _ -> Left $ error_expr ex $
 102                 Error_Expr_Wrong_number_of_arguments ast 1
 103
 104 from_ast01
 105  :: forall ty ast ex hs ret.
 106  ( ty ~ Type_Root_of_Expr ex
 107  , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
 108                    (Error_of_Expr ast (Root_of_Expr ex))
 109  ) => [ast]
 110  -> Maybe (ExprFrom ast ex hs ret)
 111  -> (ast -> ExprFrom ast ex hs ret)
 112  -> ExprFrom ast ex hs ret
 113 from_ast01 asts from0 from1 ex ast ctx k =
 114         case asts of
 115          [] | Just from <- from0 -> from ex ast ctx k
 116          [ast_0] -> from1 ast_0 ex ast ctx k
 117          _ -> Left $ error_expr ex $
 118                 Error_Expr_Wrong_number_of_arguments ast 1
 119
 120 from_ast2
 121  :: forall ty ast ex hs ret.
 122  ( ty ~ Type_Root_of_Expr ex
 123  , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
 124                    (Error_of_Expr ast (Root_of_Expr ex))
 125  ) => [ast] -> (ast -> ast -> ExprFrom ast ex hs ret)
 126  -> ExprFrom ast ex hs ret
 127 from_ast2 asts from ex ast ctx k =
 128         case asts of
 129          [ast_0, ast_1] -> from ast_0 ast_1 ex ast ctx k
 130          _ -> Left $ error_expr ex $
 131                 Error_Expr_Wrong_number_of_arguments ast 2
 132
 133 from_ast012
 134  :: forall ty ast ex hs ret.
 135  ( ty ~ Type_Root_of_Expr ex
 136  , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
 137                    (Error_of_Expr ast (Root_of_Expr ex))
 138  ) => [ast]
 139  -> Maybe (        ExprFrom ast ex hs ret)
 140  -> Maybe ( ast -> ExprFrom ast ex hs ret)
 141  -> (ast -> ast -> ExprFrom ast ex hs ret)
 142  -> ExprFrom ast ex hs ret
 143 from_ast012 asts from0 from1 from2 ex ast ctx k =
 144         case asts of
 145          [] | Just from <- from0 -> from ex ast ctx k
 146          [ast_0] | Just from <- from1 -> from ast_0 ex ast ctx k
 147          [ast_0, ast_1] -> from2 ast_0 ast_1 ex ast ctx k
 148          _ -> Left $ error_expr ex $
 149                 Error_Expr_Wrong_number_of_arguments ast 2
 150
 151 from_ast3
 152  :: forall ty ast ex hs ret.
 153  ( ty ~ Type_Root_of_Expr ex
 154  , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
 155                    (Error_of_Expr ast (Root_of_Expr ex))
 156  ) => [ast] -> (ast -> ast -> ast -> ExprFrom ast ex hs ret)
 157  -> ExprFrom ast ex hs ret
 158 from_ast3 asts from ex ast ctx k =
 159         case asts of
 160          [ast_0, ast_1, ast_2] -> from ast_0 ast_1 ast_2 ex ast ctx k
 161          _ -> Left $ error_expr ex $
 162                 Error_Expr_Wrong_number_of_arguments ast 3
 163
 164 lit_from_AST
 165  :: forall root ty lit ex ast hs ret.
 166  ( ty ~ Type_Root_of_Expr ex
 167  , root ~ Root_of_Expr ex
 168  , ast ~ AST
 169  , Read lit
 170  , Error_Expr_Lift (Error_Expr (Error_of_Type ast ty) ty ast)
 171                    (Error_of_Expr ast root)
 172  ) => (forall repr. Sym_of_Expr ex repr => lit -> repr lit)
 173  -> ty lit -> [ast]
 174  -> ExprFrom ast ex hs ret
 175 lit_from_AST op ty_lit asts ex ast ctx k =
 176         case asts of
 177          [AST lit []] -> lit_from op ty_lit lit ex ast ctx k
 178          _ -> Left $ error_expr ex $
 179                 Error_Expr_Wrong_number_of_arguments ast 1
 180
 181 instance -- Type0_From AST Type_Var0
 182  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 183  , IBool (Is_Last_Type (Type_Var0 root) root)
 184  ) => Type0_From AST (Type_Var0 root) where
 185         type0_from ty ast _k =
 186                 Left $ error_type_unsupported ty ast
 187          -- NOTE: no support so far.
 188 instance -- Type0_From AST Type_Var1
 189  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 190  , IBool (Is_Last_Type (Type_Var1 root) root)
 191  ) => Type0_From AST (Type_Var1 root) where
 192         type0_from ty ast _k =
 193                 Left $ error_type_unsupported ty ast
 194          -- NOTE: no support so far.
 195 instance -- Type0_From AST Type_Unit
 196  ( Type_Root_Lift Type_Unit root
 197  , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 198  , IBool (Is_Last_Type (Type_Unit root) root)
 199  ) => Type0_From AST (Type_Unit root) where
 200         type0_from ty ast k =
 201                 case ast of
 202                  AST "()" asts ->
 203                         case asts of
 204                          [] -> k type_unit
 205                          _ -> Left $ error_type_lift $
 206                                 Error_Type_Wrong_number_of_arguments ast 0
 207                  _ -> Left $ error_type_unsupported ty ast
 208 instance -- Type0_From AST Type_Bool
 209  ( Type_Root_Lift Type_Bool root
 210  , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 211  , IBool (Is_Last_Type (Type_Bool root) root)
 212  ) => Type0_From AST (Type_Bool root) where
 213         type0_from ty ast k =
 214                 case ast of
 215                  AST "Bool" asts ->
 216                         case asts of
 217                          [] -> k type_bool
 218                          _ -> Left $ error_type_lift $
 219                                 Error_Type_Wrong_number_of_arguments ast 0
 220                  _ -> Left $ error_type_unsupported ty ast
 221 instance -- Type0_From AST Type_Char
 222  ( Type_Root_Lift Type_Char root
 223  , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 224  , IBool (Is_Last_Type (Type_Char root) root)
 225  ) => Type0_From AST (Type_Char root) where
 226         type0_from ty ast k =
 227                 case ast of
 228                  AST "Char" asts ->
 229                         case asts of
 230                          [] -> k type_char
 231                          _ -> Left $ error_type_lift $
 232                                 Error_Type_Wrong_number_of_arguments ast 0
 233                  _ -> Left $ error_type_unsupported ty ast
 234 instance -- Type0_From AST Type_Int
 235  ( Type_Root_Lift Type_Int root
 236  , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 237  , IBool (Is_Last_Type (Type_Int root) root)
 238  ) => Type0_From AST (Type_Int root) where
 239         type0_from ty ast k =
 240                 case ast of
 241                  AST "Int" asts ->
 242                         case asts of
 243                          [] -> k type_int
 244                          _ -> Left $ error_type_lift $
 245                                 Error_Type_Wrong_number_of_arguments ast 0
 246                  _ -> Left $ error_type_unsupported ty ast
 247 instance -- Type0_From AST Type_Text
 248  ( Type_Root_Lift Type_Text root
 249  , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 250  , IBool (Is_Last_Type (Type_Text root) root)
 251  ) => Type0_From AST (Type_Text root) where
 252         type0_from ty ast k =
 253                 case ast of
 254                  AST "Text" asts ->
 255                         case asts of
 256                          [] -> k type_text
 257                          _ -> Left $ error_type_lift $
 258                                 Error_Type_Wrong_number_of_arguments ast 0
 259                  _ -> Left $ error_type_unsupported ty ast
 260 instance -- Type0_From AST Type_Ordering
 261  ( Type_Root_Lift Type_Ordering root
 262  , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 263  , IBool (Is_Last_Type (Type_Ordering root) root)
 264  ) => Type0_From AST (Type_Ordering root) where
 265         type0_from ty ast k =
 266                 case ast of
 267                  AST "Ordering" asts ->
 268                         case asts of
 269                          [] -> k type_ordering
 270                          _ -> Left $ error_type_lift $
 271                                 Error_Type_Wrong_number_of_arguments ast 0
 272                  _ -> Left $ error_type_unsupported ty ast
 273 instance -- Type0_From AST Type_Fun
 274  ( Type0_Eq root
 275  , Type0_From AST root
 276  , Type_Root_Lift Type_Fun root
 277  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 278  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 279  , Root_of_Type root ~ root
 280  , IBool (Is_Last_Type (Type_Fun root) root)
 281  ) => Type0_From AST (Type_Fun root) where
 282         type0_from ty ast k =
 283                 case ast of
 284                  AST "->" asts ->
 285                         case asts of
 286                          [ast_arg, ast_res] -> type_fun_from ty ast_arg ast_res k
 287                          _ -> Left $ error_type_lift $
 288                                 Error_Type_Wrong_number_of_arguments ast 2
 289                  _ -> Left $ error_type_unsupported ty ast
 290 instance -- Type0_From AST Type_Maybe
 291  ( Type0_Eq root
 292  , Type0_From AST root
 293  , Type_Root_Lift Type_Maybe root
 294  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 295  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 296  , Root_of_Type root ~ root
 297  , IBool (Is_Last_Type (Type_Maybe root) root)
 298  ) => Type0_From AST (Type_Maybe root) where
 299         type0_from ty ast k =
 300                 case ast of
 301                  AST "Maybe" asts ->
 302                         case asts of
 303                          [ast_a] ->
 304                                 type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
 305                                 k (type_maybe ty_a)
 306                          _ -> Left $ error_type_lift $
 307                                 Error_Type_Wrong_number_of_arguments ast 1
 308                  _ -> Left $ error_type_unsupported ty ast
 309 instance -- Type0_From AST Type_List
 310  ( Type0_Eq root
 311  , Type0_From AST root
 312  , Type_Root_Lift Type_List root
 313  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 314  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 315  , Root_of_Type root ~ root
 316  , IBool (Is_Last_Type (Type_List root) root)
 317  ) => Type0_From AST (Type_List root) where
 318         type0_from ty ast k =
 319                 case ast of
 320                  AST "[]" asts ->
 321                         case asts of
 322                          [ast_a] ->
 323                                 type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
 324                                 k (type_list ty_a)
 325                          _ -> Left $ error_type_lift $
 326                                 Error_Type_Wrong_number_of_arguments ast 1
 327                  _ -> Left $ error_type_unsupported ty ast
 328 instance -- Type0_From AST Type_Map
 329  ( Type0_Eq root
 330  , Type0_From AST root
 331  , Type_Root_Lift Type_Map root
 332  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 333  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 334  , Type0_Constraint Ord root
 335  , Root_of_Type root ~ root
 336  , IBool (Is_Last_Type (Type_Map root) root)
 337  ) => Type0_From AST (Type_Map root) where
 338         type0_from ty ast k =
 339                 case ast of
 340                  AST "Map" asts ->
 341                         case asts of
 342                          [ast_k, ast_a] ->
 343                                 type0_from (Proxy::Proxy root) ast_k $ \ty_k ->
 344                                 type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
 345                                 k (type_map ty_k ty_a)
 346                          _ -> Left $ error_type_lift $
 347                                 Error_Type_Wrong_number_of_arguments ast 2
 348                  _ -> Left $ error_type_unsupported ty ast
 349 instance -- Type0_From AST Type_Tuple2
 350  ( Type0_Eq root
 351  , Type0_From AST root
 352  , Type_Root_Lift Type_Tuple2 root
 353  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 354  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 355  , Root_of_Type root ~ root
 356  , IBool (Is_Last_Type (Type_Tuple2 root) root)
 357  ) => Type0_From AST (Type_Tuple2 root) where
 358         type0_from ty ast k =
 359                 case ast of
 360                  AST "(,)" asts ->
 361                         case asts of
 362                          [ast_a, ast_b] ->
 363                                 type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
 364                                 type0_from (Proxy::Proxy root) ast_b $ \ty_b ->
 365                                 k (type_tuple2 ty_a ty_b)
 366                          _ -> Left $ error_type_lift $
 367                                 Error_Type_Wrong_number_of_arguments ast 2
 368                  _ -> Left $ error_type_unsupported ty ast
 369 instance -- Type0_From AST Type_Either
 370  ( Type0_Eq root
 371  , Type0_From AST root
 372  , Type_Root_Lift Type_Either root
 373  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 374  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 375  , Root_of_Type root ~ root
 376  , IBool (Is_Last_Type (Type_Either root) root)
 377  ) => Type0_From AST (Type_Either root) where
 378         type0_from ty ast k =
 379                 case ast of
 380                  AST "Either" asts ->
 381                         case asts of
 382                          [ast_l, ast_r] ->
 383                                 type0_from (Proxy::Proxy root) ast_l $ \ty_l ->
 384                                 type0_from (Proxy::Proxy root) ast_r $ \ty_r ->
 385                                 k (type_either ty_l ty_r)
 386                          _ -> Left $ error_type_lift $
 387                                 Error_Type_Wrong_number_of_arguments ast 2
 388                  _ -> Left $ error_type_unsupported ty ast
 389
 390 instance -- Type1_From AST Type_Bool
 391  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 392  , IBool (Is_Last_Type (Type_Bool root) root)
 393  ) => Type1_From AST (Type_Bool root)
 394 instance -- Type1_From AST Type_Int
 395  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 396  , IBool (Is_Last_Type (Type_Int root) root)
 397  ) => Type1_From AST (Type_Int root)
 398 instance -- Type1_From AST Type_Unit
 399  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 400  , IBool (Is_Last_Type (Type_Unit root) root)
 401  ) => Type1_From AST (Type_Unit root)
 402 instance -- Type1_From AST Type_Ordering
 403  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 404  , IBool (Is_Last_Type (Type_Ordering root) root)
 405  ) => Type1_From AST (Type_Ordering root)
 406 instance -- Type1_From AST Type_Var0
 407  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 408  , IBool (Is_Last_Type (Type_Var0 root) root)
 409  ) => Type1_From AST (Type_Var0 root)
 410 instance -- Type1_From AST Type_Var1
 411  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 412  , IBool (Is_Last_Type (Type_Var1 root) root)
 413  ) => Type1_From AST (Type_Var1 root)
 414 instance -- Type1_From AST Type_Maybe
 415  ( Type0_From AST root
 416  , Type_Root_Lift Type_Maybe root
 417  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 418  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 419  , Root_of_Type root ~ root
 420  , IBool (Is_Last_Type (Type_Maybe root) root)
 421  ) => Type1_From AST (Type_Maybe root) where
 422         type1_from ty ast k =
 423                 case ast of
 424                  AST "Maybe" asts ->
 425                         case asts of
 426                          [] -> k (Proxy::Proxy Maybe) type_maybe
 427                          _ -> Left $ error_type_lift $
 428                                 Error_Type_Wrong_number_of_arguments ast 0
 429                  _ -> Left $ error_type_unsupported ty ast
 430 instance -- Type1_From AST Type_List
 431  ( Type0_Eq root
 432  , Type0_From AST root
 433  , Type_Root_Lift Type_List root
 434  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 435  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 436  , Root_of_Type root ~ root
 437  , IBool (Is_Last_Type (Type_List root) root)
 438  ) => Type1_From AST (Type_List root) where
 439         type1_from ty ast k =
 440                 case ast of
 441                  AST "[]" asts ->
 442                         case asts of
 443                          [] -> k (Proxy::Proxy []) type_list
 444                          _ -> Left $ error_type_lift $
 445                                 Error_Type_Wrong_number_of_arguments ast 0
 446                  _ -> Left $ error_type_unsupported ty ast
 447 instance -- Type1_From AST Type_IO
 448  ( Type0_Eq root
 449  , Type0_From AST root
 450  , Type_Root_Lift Type_IO root
 451  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 452  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 453  , Root_of_Type root ~ root
 454  , IBool (Is_Last_Type (Type_IO root) root)
 455  ) => Type1_From AST (Type_IO root) where
 456         type1_from ty ast k =
 457                 case ast of
 458                  AST "IO" asts ->
 459                         case asts of
 460                          [] -> k (Proxy::Proxy IO) type_io
 461                          _ -> Left $ error_type_lift $
 462                                 Error_Type_Wrong_number_of_arguments ast 0
 463                  _ -> Left $ error_type_unsupported ty ast
 464 instance -- Type1_From AST Type_Fun
 465  ( Type0_Eq root
 466  , Type0_From AST root
 467  , Type_Root_Lift Type_Fun root
 468  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 469  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 470  , Root_of_Type root ~ root
 471  , IBool (Is_Last_Type (Type_Fun root) root)
 472  ) => Type1_From AST (Type_Fun root) where
 473         type1_from ty ast k =
 474                 case ast of
 475                  AST "->" asts ->
 476                         case asts of
 477                          [ast_arg] ->
 478                                 type0_from (Proxy::Proxy root) ast_arg $ \(ty_arg::root h_arg) ->
 479                                 k (Proxy::Proxy ((->) h_arg)) $
 480                                         type_fun ty_arg
 481                          _ -> Left $ error_type_lift $
 482                                 Error_Type_Wrong_number_of_arguments ast 1
 483                  _ -> Left $ error_type_unsupported ty ast
 484 instance -- Type1_From AST Type_Either
 485  ( Type0_Eq root
 486  , Type0_From AST root
 487  , Type_Root_Lift Type_Either root
 488  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 489  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 490  , Root_of_Type root ~ root
 491  , IBool (Is_Last_Type (Type_Either root) root)
 492  ) => Type1_From AST (Type_Either root) where
 493         type1_from ty ast k =
 494                 case ast of
 495                  AST "Either" asts ->
 496                         case asts of
 497                          [ast_l] ->
 498                                 type0_from (Proxy::Proxy root) ast_l $ \(ty_l::root h_l) ->
 499                                 k (Proxy::Proxy (Either h_l)) $
 500                                         type_either ty_l
 501                          _ -> Left $ error_type_lift $
 502                                 Error_Type_Wrong_number_of_arguments ast 1
 503                  _ -> Left $ error_type_unsupported ty ast
 504
 505 instance -- Expr_From AST Expr_Bool
 506  ( Expr_From AST root
 507  , Type0_Eq (Type_Root_of_Expr root)
 508  , Type0_Lift   Type_Bool (Type_of_Expr root)
 509  , Type0_Unlift Type_Bool (Type_of_Expr root)
 510  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 511  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 512  , Root_of_Expr root ~ root
 513  , IBool (Is_Last_Expr (Expr_Bool root) root)
 514  ) => Expr_From AST (Expr_Bool root) where
 515         expr_from ex ast =
 516                 case ast of
 517                  AST "bool" asts -> lit_from_AST bool t asts ex ast
 518                  AST "not"  asts -> from_ast01  asts (Just $ op1_from0 Expr.not   t) (op1_from Expr.not t) ex ast
 519                  AST "&&"   asts -> from_ast012 asts (Just $ op2_from0 (Expr.&&)  t) (Just $ op2_from1 (Expr.&&) t) (op2_from (Expr.&&) t) ex ast
 520                  AST "||"   asts -> from_ast012 asts (Just $ op2_from0 (Expr.||)  t) (Just $ op2_from1 (Expr.||) t) (op2_from (Expr.||) t) ex ast
 521                  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
 522                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 523                 where t = type_bool
 524 instance -- Expr_From AST Expr_If
 525  ( Expr_From AST root
 526  , Type0_Eq (Type_Root_of_Expr root)
 527  , Type0_Lift Type_Bool (Type_of_Expr root)
 528  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 529  , Root_of_Expr root ~ root
 530  , IBool (Is_Last_Expr (Expr_If root) root)
 531  ) => Expr_From AST (Expr_If root) where
 532         expr_from ex ast ctx k =
 533                 case ast of
 534                  AST "if" asts -> from_ast3 asts if_from ex ast ctx k
 535                  _ -> Left $ error_expr_unsupported ex ast
 536 instance -- Expr_From AST Expr_When
 537  ( Expr_From AST root
 538  , Type0_Eq (Type_Root_of_Expr root)
 539  , Type0_Lift Type_Bool (Type_of_Expr root)
 540  , Type0_Lift Type_Unit (Type_of_Expr root)
 541  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 542  , Root_of_Expr root ~ root
 543  , IBool (Is_Last_Expr (Expr_When root) root)
 544  ) => Expr_From AST (Expr_When root) where
 545         expr_from ex ast ctx k =
 546                 case ast of
 547                  AST "when" asts -> from_ast2 asts when_from ex ast ctx k
 548                  _ -> Left $ error_expr_unsupported ex ast
 549 instance -- Expr_From AST Expr_Int
 550  ( Expr_From AST root
 551  , Type0_Eq (Type_Root_of_Expr root)
 552  , Type0_Lift   Type_Int (Type_of_Expr root)
 553  , Type0_Unlift Type_Int (Type_of_Expr root)
 554  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 555  , Root_of_Expr root ~ root
 556  , IBool (Is_Last_Expr (Expr_Int root) root)
 557  ) => Expr_From AST (Expr_Int root) where
 558         expr_from ex ast =
 559                 case ast of
 560                  AST "int" asts -> lit_from_AST int type_int asts ex ast
 561                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 562 instance -- Expr_From AST Expr_Integer
 563  ( Expr_From AST root
 564  , Type0_Eq (Type_Root_of_Expr root)
 565  , Type0_Lift   Type_Integer (Type_of_Expr root)
 566  , Type0_Unlift Type_Integer (Type_of_Expr root)
 567  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 568  , Root_of_Expr root ~ root
 569  , IBool (Is_Last_Expr (Expr_Integer root) root)
 570  ) => Expr_From AST (Expr_Integer root) where
 571         expr_from ex ast =
 572                 case ast of
 573                  AST "integer" asts -> lit_from_AST integer type_integer asts ex ast
 574                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 575 instance -- Expr_From AST Expr_Num
 576  ( Expr_From AST root
 577  , Type0_Eq (Type_Root_of_Expr root)
 578  , Type0_Constraint Num (Type_Root_of_Expr root)
 579  , Type0_Lift   Type_Integer (Type_of_Expr root)
 580  , Type0_Unlift Type_Integer (Type_of_Expr root)
 581  , Type0_Lift   Type_Fun     (Type_of_Expr root)
 582  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 583  , Root_of_Expr root ~ root
 584  , IBool (Is_Last_Expr (Expr_Num root) root)
 585  ) => Expr_From AST (Expr_Num root) where
 586         expr_from ex ast =
 587                 let c = (Proxy :: Proxy Num) in
 588                 case ast of
 589                  AST "abs"    asts -> from_ast1 asts (class_op1_from Expr.abs    c) ex ast
 590                  AST "negate" asts -> from_ast1 asts (class_op1_from Expr.negate c) ex ast
 591                  AST "signum" asts -> from_ast1 asts (class_op1_from Expr.signum c) ex ast
 592                  AST "+"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.+) c) (class_op2_from (Expr.+) c) ex ast
 593                  AST "-"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.-) c) (class_op2_from (Expr.-) c) ex ast
 594                  AST "*"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.*) c) (class_op2_from (Expr.*) c) ex ast
 595                  AST "fromInteger" asts -> from_ast1 asts fromInteger_from ex ast
 596                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 597 instance -- Expr_From AST Expr_Integral
 598  ( Expr_From AST root
 599  , Type0_Eq (Type_Root_of_Expr root)
 600  , Type0_Constraint Integral (Type_Root_of_Expr root)
 601  , Type0_Lift Type_Fun     (Type_of_Expr root)
 602  , Type0_Lift Type_Integer (Type_of_Expr root)
 603  , Type0_Lift Type_Tuple2  (Type_of_Expr root)
 604  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 605  , Root_of_Expr root ~ root
 606  , IBool (Is_Last_Expr (Expr_Integral root) root)
 607  ) => Expr_From AST (Expr_Integral root) where
 608         expr_from ex ast =
 609                 let c = (Proxy :: Proxy Integral) in
 610                 case ast of
 611                  AST "quot"    asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.quot c) (class_op2_from Expr.quot c) ex ast
 612                  AST "div"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.div  c) (class_op2_from Expr.div  c) ex ast
 613                  AST "rem"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.rem  c) (class_op2_from Expr.rem  c) ex ast
 614                  AST "mod"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.mod  c) (class_op2_from Expr.mod  c) ex ast
 615                  AST "quotRem" asts -> from_ast012 asts Nothing (Just quotRem_from1) quotRem_from ex ast
 616                  AST "divMod"  asts -> from_ast012 asts Nothing (Just divMod_from1)  divMod_from  ex ast
 617                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 618 instance -- Expr_From AST Expr_Text
 619  ( Expr_From AST root
 620  , Type0_Eq (Type_Root_of_Expr root)
 621  , Type0_Lift   Type_Text (Type_of_Expr root)
 622  , Type0_Unlift Type_Text (Type_of_Expr root)
 623  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 624  , Root_of_Expr root ~ root
 625  , IBool (Is_Last_Expr (Expr_Text root) root)
 626  ) => Expr_From AST (Expr_Text root) where
 627         expr_from ex ast =
 628                 case ast of
 629                  AST "text" asts ->
 630                         case asts of
 631                          [AST lit []] -> \_ctx k ->
 632                                 k type_text $ Forall_Repr_with_Context $ \_c -> text lit
 633                          _ -> \_ctx _k -> Left $ error_expr ex $
 634                                 Error_Expr_Wrong_number_of_arguments ast 1
 635                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 636 instance -- Expr_From AST Expr_Char
 637  ( Expr_From AST root
 638  , Type0_Eq (Type_Root_of_Expr root)
 639  , Type0_Lift   Type_Char (Type_of_Expr root)
 640  , Type0_Unlift Type_Char (Type_of_Expr root)
 641  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 642  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 643  , Root_of_Expr root ~ root
 644  , IBool (Is_Last_Expr (Expr_Char root) root)
 645  ) => Expr_From AST (Expr_Char root) where
 646         expr_from ex ast =
 647                 case ast of
 648                  AST "char" asts ->
 649                         case asts of
 650                          [AST lit []] ->
 651                                 case Text.uncons lit of
 652                                  Just (c, "") -> \_ctx k ->
 653                                         k type_char $ Forall_Repr_with_Context $ \_c -> char c
 654                                  _ -> \_ctx _k -> Left $ error_expr ex $
 655                                         Error_Expr_Read (Error_Read lit) ast
 656                          _ -> \_ctx _k -> Left $ error_expr ex $
 657                                 Error_Expr_Wrong_number_of_arguments ast 1
 658                  AST "char_toUpper" asts -> from_ast01 asts (Just $ op1_from0 char_toUpper type_char) (op1_from char_toUpper type_char) ex ast
 659                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 660 instance -- Expr_From AST Expr_Lambda
 661  ( Expr_From AST root
 662  , Type0_Eq (Type_Root_of_Expr root)
 663  , Type0_From AST (Type_Root_of_Expr root)
 664  , Type0_Lift   Type_Fun (Type_of_Expr root)
 665  , Type0_Unlift Type_Fun (Type_of_Expr root)
 666  , Error_Expr_Lift (Error_Expr_Lambda AST)       (Error_of_Expr AST root)
 667  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 668  , Root_of_Expr root ~ root
 669  , IBool (Is_Last_Expr (Expr_Lambda root) root)
 670  ) => Expr_From AST (Expr_Lambda root) where
 671         expr_from ex ast ctx k =
 672                 case ast of
 673                  AST "var" asts ->
 674                         case asts of
 675                          [AST name []] -> var_from name ex ast ctx k
 676                          _ -> Left $ error_expr ex $
 677                                 Error_Expr_Wrong_number_of_arguments ast 1
 678                  AST "$"   asts -> from_ast2 asts app_from ex ast ctx k
 679                  AST "\\"  asts -> go_lam asts
 680                  AST "let" asts -> go_let asts
 681                  _ -> Left $ error_expr_unsupported ex ast
 682                 where
 683                 go_lam asts =
 684                         case asts of
 685                          [AST name [], ast_ty_arg, ast_body] ->
 686                                 lam_from name ast_ty_arg ast_body ex ast ctx k
 687                          _ -> Left $ error_expr ex $
 688                                 Error_Expr_Wrong_number_of_arguments ast 3
 689                 go_let asts =
 690                         case asts of
 691                          [AST name [], ast_var, ast_body] ->
 692                                 let_from name ast_var ast_body ex ast ctx k
 693                          _ -> Left $ error_expr ex $
 694                                 Error_Expr_Wrong_number_of_arguments ast 3
 695 instance -- Expr_From AST Expr_Maybe
 696  ( Expr_From AST root
 697  , Type0_Eq (Type_Root_of_Expr root)
 698  , Type0_From AST (Type_Root_of_Expr root)
 699  , Type0_Lift   Type_Fun   (Type_of_Expr root)
 700  , Type0_Unlift Type_Fun   (Type_of_Expr root)
 701  , Type0_Lift   Type_Maybe (Type_of_Expr root)
 702  , Type0_Unlift Type_Maybe (Type_of_Expr root)
 703  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 704  , Root_of_Expr root ~ root
 705  , IBool (Is_Last_Expr (Expr_Maybe root) root)
 706  ) => Expr_From AST (Expr_Maybe root) where
 707         expr_from ex ast =
 708                 case ast of
 709                  AST "maybe"   asts -> from_ast3 asts maybe_from   ex ast
 710                  AST "nothing" asts -> from_ast1 asts nothing_from ex ast
 711                  AST "just"    asts -> from_ast1 asts just_from    ex ast
 712                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 713 instance -- Expr_From AST Expr_Eq
 714  ( Expr_From AST root
 715  , Type0_Eq (Type_Root_of_Expr root)
 716  , Type0_Lift Type_Bool (Type_of_Expr root)
 717  , Type0_Lift Type_Fun  (Type_of_Expr root)
 718  , Type0_Constraint Eq (Type_Root_of_Expr root)
 719  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 720  , Root_of_Expr root ~ root
 721  , IBool (Is_Last_Expr (Expr_Eq root) root)
 722  ) => Expr_From AST (Expr_Eq root) where
 723         expr_from ex ast =
 724                 case ast of
 725                  AST "==" asts -> from_ast012 asts Nothing (Just (eq_from1 (Expr.==))) (eq_from (Expr.==)) ex ast
 726                  AST "/=" asts -> from_ast012 asts Nothing (Just (eq_from1 (Expr./=))) (eq_from (Expr./=)) ex ast
 727                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 728 instance -- Expr_From AST Expr_Ord
 729  ( Expr_From AST root
 730  , Type0_Eq (Type_Root_of_Expr root)
 731  , Type0_Lift Type_Bool     (Type_of_Expr root)
 732  , Type0_Lift Type_Fun      (Type_of_Expr root)
 733  , Type0_Lift Type_Ordering (Type_of_Expr root)
 734  , Type0_Constraint Ord (Type_Root_of_Expr root)
 735  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 736  , Root_of_Expr root ~ root
 737  , IBool (Is_Last_Expr (Expr_Ord root) root)
 738  ) => Expr_From AST (Expr_Ord root) where
 739         expr_from ex ast =
 740                 let c = (Proxy :: Proxy Ord) in
 741                 case ast of
 742                  AST "compare" asts -> from_ast012 asts Nothing (Just compare_from1) compare_from ex ast
 743                  AST "<"       asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.<))  (ord_from (Expr.<))  ex ast
 744                  AST "<="      asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.<=)) (ord_from (Expr.<=)) ex ast
 745                  AST ">"       asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.>))  (ord_from (Expr.>))  ex ast
 746                  AST ">="      asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.>=)) (ord_from (Expr.>=)) ex ast
 747                  AST "min"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.min c) (class_op2_from Expr.min c) ex ast
 748                  AST "max"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.max c) (class_op2_from Expr.max c) ex ast
 749                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 750 instance -- Expr_From AST Expr_List
 751  ( Expr_From AST root
 752  , Type0_Eq (Type_Root_of_Expr root)
 753  , Type0_From AST (Type_Root_of_Expr root)
 754  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 755  , Type0_Unlift Type_Fun  (Type_of_Expr root)
 756  , Type0_Lift   Type_List (Type_of_Expr root)
 757  , Type0_Unlift Type_List (Type_of_Expr root)
 758  , Type0_Lift   Type_Bool (Type_of_Expr root)
 759  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 760  , Root_of_Expr root ~ root
 761  , IBool (Is_Last_Expr (Expr_List root) root)
 762  ) => Expr_From AST (Expr_List root) where
 763         expr_from ex ast =
 764                 case ast of
 765                  AST "[]"          asts -> from_ast1 asts list_empty_from  ex ast
 766                  AST ":"           asts -> from_ast2 asts list_cons_from   ex ast
 767                  AST "list_filter" asts -> from_ast2 asts list_filter_from ex ast
 768                  AST "list"        asts -> \ctx k ->
 769                         case asts of
 770                          ast_ty_a:asts' -> list_from ast_ty_a asts' ex ast ctx k
 771                          _ -> Left $ error_expr ex $
 772                                 Error_Expr_Wrong_number_of_arguments ast 1
 773                  AST "list_zipWith" asts -> from_ast3 asts list_zipWith_from ex ast
 774                  AST "list_reverse" asts -> from_ast1 asts list_reverse_from ex ast
 775                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 776 instance -- Expr_From AST Expr_Map
 777  ( Expr_From AST root
 778  , Type0_Eq (Type_Root_of_Expr root)
 779  , Type0_Lift   Type_Fun    (Type_of_Expr root)
 780  , Type0_Unlift Type_Fun    (Type_of_Expr root)
 781  , Type0_Lift   Type_Bool   (Type_of_Expr root)
 782  , Type0_Unlift Type_Bool   (Type_of_Expr root)
 783  , Type0_Lift   Type_List   (Type_of_Expr root)
 784  , Type0_Unlift Type_List   (Type_of_Expr root)
 785  , Type0_Lift   Type_Map    (Type_of_Expr root)
 786  , Type0_Unlift Type_Map    (Type_of_Expr root)
 787  , Type0_Lift   Type_Maybe  (Type_of_Expr root)
 788  , Type0_Unlift Type_Maybe  (Type_of_Expr root)
 789  , Type0_Lift   Type_Tuple2 (Type_of_Expr root)
 790  , Type0_Unlift Type_Tuple2 (Type_of_Expr root)
 791  , Type0_Constraint Ord (Type_Root_of_Expr root)
 792  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 793  , Root_of_Expr root ~ root
 794  , IBool (Is_Last_Expr (Expr_Map root) root)
 795  ) => Expr_From AST (Expr_Map root) where
 796         expr_from ex ast =
 797                 case ast of
 798                  AST "map_from_list"    asts -> from_ast1 asts map_from_list_from ex ast
 799                  AST "mapWithKey"       asts -> from_ast2 asts mapWithKey_from ex ast
 800                  AST "map_lookup"       asts -> from_ast2 asts map_lookup_from ex ast
 801                  AST "map_keys"         asts -> from_ast1 asts map_keys_from ex ast
 802                  AST "map_member"       asts -> from_ast2 asts map_member_from ex ast
 803                  AST "map_insert"       asts -> from_ast3 asts map_insert_from ex ast
 804                  AST "map_delete"       asts -> from_ast2 asts map_delete_from ex ast
 805                  AST "map_difference"   asts -> from_ast2 asts map_difference_from ex ast
 806                  AST "map_foldrWithKey" asts -> from_ast3 asts map_foldrWithKey_from ex ast
 807                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 808 instance -- Expr_From AST Expr_Functor
 809  ( Expr_From AST root
 810  , Type0_Eq (Type_Root_of_Expr root)
 811  , Type0_Lift   Type_Fun (Type_of_Expr root)
 812  , Type0_Unlift Type_Fun (Type_of_Expr root)
 813  , Type1_Unlift (Type_of_Expr root)
 814  , Type1_Constraint Functor (Type_Root_of_Expr root)
 815  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 816  , Root_of_Expr root ~ root
 817  , IBool (Is_Last_Expr (Expr_Functor root) root)
 818  ) => Expr_From AST (Expr_Functor root) where
 819         expr_from ex ast =
 820                 case ast of
 821                  AST "fmap" asts -> from_ast2 asts fmap_from ex ast
 822                  AST "<$>"  asts -> from_ast2 asts fmap_from ex ast
 823                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 824 instance -- Expr_From AST Expr_MonoFunctor
 825  ( Expr_From AST root
 826  , Type0_Eq (Type_Root_of_Expr root)
 827  , Type0_Lift   Type_Fun (Type_of_Expr root)
 828  , Type0_Unlift Type_Fun (Type_of_Expr root)
 829  , Type1_Unlift (Type_of_Expr root)
 830  , Type0_Constraint MT.MonoFunctor (Type_Root_of_Expr root)
 831  , Type0_Family Type_Family_MonoElement (Type_Root_of_Expr root)
 832  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 833  , Root_of_Expr root ~ root
 834  , IBool (Is_Last_Expr (Expr_MonoFunctor root) root)
 835  ) => Expr_From AST (Expr_MonoFunctor root) where
 836         expr_from ex ast ctx k =
 837                 case ast of
 838                  AST "omap" asts -> from_ast2 asts omap_from ex ast ctx k
 839                  _ -> Left $ error_expr_unsupported ex ast
 840 instance -- Expr_From AST Expr_Applicative
 841  ( Expr_From AST root
 842  , Type0_Eq (Type_Root_of_Expr root)
 843  , Type1_From AST (Type_Root_of_Expr root)
 844  , Type0_Lift   Type_Fun (Type_of_Expr root)
 845  , Type0_Unlift Type_Fun (Type_of_Expr root)
 846  , Type1_Eq (Type_Root_of_Expr root)
 847  , Type1_Unlift (Type_of_Expr root)
 848  , Type1_Constraint Applicative (Type_Root_of_Expr root)
 849  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 850  , Root_of_Expr root ~ root
 851  , IBool (Is_Last_Expr (Expr_Applicative root) root)
 852  ) => Expr_From AST (Expr_Applicative root) where
 853         expr_from ex ast =
 854                 case ast of
 855                  AST "pure" asts -> from_ast2 asts pure_from     ex ast
 856                  AST "<*>"  asts -> from_ast2 asts ltstargt_from ex ast
 857                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 858 instance -- Expr_From AST Expr_Traversable
 859  ( Expr_From AST root
 860  , Type0_Eq (Type_Root_of_Expr root)
 861  , Type0_Lift   Type_Fun (Type_of_Expr root)
 862  , Type0_Unlift Type_Fun (Type_of_Expr root)
 863  , Type1_Eq (Type_Root_of_Expr root)
 864  , Type1_Unlift (Type_of_Expr root)
 865  , Type1_Constraint Applicative (Type_Root_of_Expr root)
 866  , Type1_Constraint Traversable (Type_Root_of_Expr root)
 867  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 868  , Root_of_Expr root ~ root
 869  , IBool (Is_Last_Expr (Expr_Traversable root) root)
 870  ) => Expr_From AST (Expr_Traversable root) where
 871         expr_from ex ast ctx k =
 872                 case ast of
 873                  AST "traverse"  asts -> from_ast2 asts traverse_from ex ast ctx k
 874                  _ -> Left $ error_expr_unsupported ex ast
 875 instance -- Expr_From AST Expr_Foldable
 876  ( Expr_From AST root
 877  , Type0_Constraint Eq       (Type_Root_of_Expr root)
 878  , Type0_Constraint Monoid   (Type_Root_of_Expr root)
 879  , Type0_Constraint Num      (Type_Root_of_Expr root)
 880  , Type0_Constraint Ord      (Type_Root_of_Expr root)
 881  , Type0_Eq                  (Type_Root_of_Expr root)
 882  , Type0_Lift   Type_Bool    (Type_of_Expr root)
 883  , Type0_Lift   Type_Fun     (Type_of_Expr root)
 884  , Type0_Lift   Type_Int     (Type_of_Expr root)
 885  , Type0_Lift   Type_List    (Type_of_Expr root)
 886  , Type0_Unlift Type_Fun     (Type_of_Expr root)
 887  , Type1_Constraint Foldable (Type_Root_of_Expr root)
 888  , Type1_Eq (Type_Root_of_Expr root)
 889  , Type1_Unlift (Type_of_Expr root)
 890  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 891  , Root_of_Expr root ~ root
 892  , IBool (Is_Last_Expr (Expr_Foldable root) root)
 893  ) => Expr_From AST (Expr_Foldable root) where
 894         expr_from ex ast =
 895                 case ast of
 896                  AST "foldMap" asts -> from_ast2 asts foldMap_from ex ast
 897                  AST "foldr"   asts -> from_ast3 asts (foldr_from Expr.foldr) ex ast
 898                  AST "foldr'"  asts -> from_ast3 asts (foldr_from Expr.foldr') ex ast
 899                  AST "foldl"   asts -> from_ast3 asts (foldl_from Expr.foldl) ex ast
 900                  AST "foldl'"  asts -> from_ast3 asts (foldl_from Expr.foldl') ex ast
 901                  AST "null"    asts -> from_ast1 asts null_from ex ast
 902                  AST "length"  asts -> from_ast1 asts length_from ex ast
 903                  AST "minimum" asts -> from_ast1 asts minimum_from ex ast
 904                  AST "maximum" asts -> from_ast1 asts maximum_from ex ast
 905                  AST "elem"    asts -> from_ast2 asts elem_from ex ast
 906                  AST "sum"     asts -> from_ast1 asts sum_from ex ast
 907                  AST "product" asts -> from_ast1 asts product_from ex ast
 908                  AST "toList"  asts -> from_ast1 asts toList_from ex ast
 909                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 910 instance -- Expr_From AST Expr_Monoid
 911  ( Expr_From AST root
 912  , Type0_Eq (Type_Root_of_Expr root)
 913  , Type0_From AST (Type_Root_of_Expr root)
 914  , Type0_Constraint Monoid (Type_Root_of_Expr root)
 915  , Type0_Lift   Type_Int  (Type_of_Expr root)
 916  , Type0_Lift   Type_Bool (Type_of_Expr root)
 917  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 918  , Type0_Unlift Type_Fun  (Type_of_Expr root)
 919  , Type1_Unlift (Type_of_Expr root)
 920  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 921  , Root_of_Expr root ~ root
 922  , IBool (Is_Last_Expr (Expr_Monoid root) root)
 923  ) => Expr_From AST (Expr_Monoid root) where
 924         expr_from ex ast =
 925                 case ast of
 926                  AST "mempty"  asts -> from_ast1 asts mempty_from ex ast
 927                  AST "mappend" asts -> from_ast012 asts Nothing (Just mappend_from1) mappend_from ex ast
 928                  AST "<>"      asts -> from_ast012 asts Nothing (Just mappend_from1) mappend_from ex ast
 929                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 930 instance -- Expr_From AST Expr_Monad
 931  ( Expr_From AST root
 932  , Type0_Eq (Type_Root_of_Expr root)
 933  , Type0_Lift   Type_Fun (Type_of_Expr root)
 934  , Type0_Unlift Type_Fun (Type_of_Expr root)
 935  , Type1_From AST (Type_Root_of_Expr root)
 936  , Type1_Constraint Monad (Type_Root_of_Expr root)
 937  , Type1_Eq (Type_Root_of_Expr root)
 938  , Type1_Unlift (Type_of_Expr root)
 939  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 940  , Root_of_Expr root ~ root
 941  , IBool (Is_Last_Expr (Expr_Monad root) root)
 942  ) => Expr_From AST (Expr_Monad root) where
 943         expr_from ex ast =
 944                 case ast of
 945                  AST "return" asts -> from_ast2 asts return_from ex ast
 946                  AST ">>="    asts -> from_ast2 asts bind_from   ex ast
 947                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 948 instance -- Expr_From AST Expr_Either
 949  ( Expr_From AST root
 950  , Type0_Eq (Type_Root_of_Expr root)
 951  , Type0_From AST (Type_Root_of_Expr root)
 952  , Type0_Lift   Type_Either (Type_of_Expr root)
 953  , Type0_Unlift Type_Either (Type_of_Expr root)
 954  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 955  , Root_of_Expr root ~ root
 956  , IBool (Is_Last_Expr (Expr_Either root) root)
 957  ) => Expr_From AST (Expr_Either root) where
 958         expr_from ex ast =
 959                 case ast of
 960                  AST "left"  asts -> from_ast2 asts left_from  ex ast
 961                  AST "right" asts -> from_ast2 asts right_from ex ast
 962                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 963 instance -- Expr_From AST Expr_Tuple2
 964  ( Expr_From AST root
 965  , Type0_Eq (Type_Root_of_Expr root)
 966  , Type0_Lift   Type_Tuple2 (Type_of_Expr root)
 967  , Type0_Unlift Type_Tuple2 (Type_of_Expr root)
 968  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 969  , Root_of_Expr root ~ root
 970  , IBool (Is_Last_Expr (Expr_Tuple2 root) root)
 971  ) => Expr_From AST (Expr_Tuple2 root) where
 972         expr_from ex ast =
 973                 case ast of
 974                  AST "(,)" asts -> from_ast2 asts tuple2_from ex ast
 975                  AST "fst" asts -> from_ast1 asts fst_from ex ast
 976                  AST "snd" asts -> from_ast1 asts snd_from ex ast
 977                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast