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_Fun (Type_of_Expr root)
 580  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 581  , Root_of_Expr root ~ root
 582  , IBool (Is_Last_Expr (Expr_Num root) root)
 583  ) => Expr_From AST (Expr_Num root) where
 584         expr_from ex ast =
 585                 let c = (Proxy :: Proxy Num) in
 586                 case ast of
 587                  AST "abs"    asts -> from_ast1 asts (class_op1_from Expr.abs    c) ex ast
 588                  AST "negate" asts -> from_ast1 asts (class_op1_from Expr.negate c) ex ast
 589                  AST "+"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.+) c) (class_op2_from (Expr.+) c) ex ast
 590                  AST "-"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.-) c) (class_op2_from (Expr.-) c) ex ast
 591                  AST "*"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.*) c) (class_op2_from (Expr.*) c) ex ast
 592                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 593 instance -- Expr_From AST Expr_Integral
 594  ( Expr_From AST root
 595  , Type0_Eq (Type_Root_of_Expr root)
 596  , Type0_Constraint Integral (Type_Root_of_Expr root)
 597  , Type0_Lift Type_Fun     (Type_of_Expr root)
 598  , Type0_Lift Type_Integer (Type_of_Expr root)
 599  , Type0_Lift Type_Tuple2  (Type_of_Expr root)
 600  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 601  , Root_of_Expr root ~ root
 602  , IBool (Is_Last_Expr (Expr_Integral root) root)
 603  ) => Expr_From AST (Expr_Integral root) where
 604         expr_from ex ast =
 605                 let c = (Proxy :: Proxy Integral) in
 606                 case ast of
 607                  AST "quot"    asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.quot c) (class_op2_from Expr.quot c) ex ast
 608                  AST "div"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.div  c) (class_op2_from Expr.div  c) ex ast
 609                  AST "rem"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.rem  c) (class_op2_from Expr.rem  c) ex ast
 610                  AST "mod"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.mod  c) (class_op2_from Expr.mod  c) ex ast
 611                  AST "quotRem" asts -> from_ast012 asts Nothing (Just quotRem_from1) quotRem_from ex ast
 612                  AST "divMod"  asts -> from_ast012 asts Nothing (Just divMod_from1)  divMod_from  ex ast
 613                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 614 instance -- Expr_From AST Expr_Text
 615  ( Expr_From AST root
 616  , Type0_Eq (Type_Root_of_Expr root)
 617  , Type0_Lift   Type_Text (Type_of_Expr root)
 618  , Type0_Unlift Type_Text (Type_of_Expr root)
 619  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 620  , Root_of_Expr root ~ root
 621  , IBool (Is_Last_Expr (Expr_Text root) root)
 622  ) => Expr_From AST (Expr_Text root) where
 623         expr_from ex ast =
 624                 case ast of
 625                  AST "text" asts ->
 626                         case asts of
 627                          [AST lit []] -> \_ctx k ->
 628                                 k type_text $ Forall_Repr_with_Context $ \_c -> text lit
 629                          _ -> \_ctx _k -> Left $ error_expr ex $
 630                                 Error_Expr_Wrong_number_of_arguments ast 1
 631                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 632 instance -- Expr_From AST Expr_Char
 633  ( Expr_From AST root
 634  , Type0_Eq (Type_Root_of_Expr root)
 635  , Type0_Lift   Type_Char (Type_of_Expr root)
 636  , Type0_Unlift Type_Char (Type_of_Expr root)
 637  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 638  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 639  , Root_of_Expr root ~ root
 640  , IBool (Is_Last_Expr (Expr_Char root) root)
 641  ) => Expr_From AST (Expr_Char root) where
 642         expr_from ex ast =
 643                 case ast of
 644                  AST "char" asts ->
 645                         case asts of
 646                          [AST lit []] ->
 647                                 case Text.uncons lit of
 648                                  Just (c, "") -> \_ctx k ->
 649                                         k type_char $ Forall_Repr_with_Context $ \_c -> char c
 650                                  _ -> \_ctx _k -> Left $ error_expr ex $
 651                                         Error_Expr_Read (Error_Read lit) ast
 652                          _ -> \_ctx _k -> Left $ error_expr ex $
 653                                 Error_Expr_Wrong_number_of_arguments ast 1
 654                  AST "char_toUpper" asts -> from_ast01 asts (Just $ op1_from0 char_toUpper type_char) (op1_from char_toUpper type_char) ex ast
 655                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 656 instance -- Expr_From AST Expr_Lambda
 657  ( Expr_From AST root
 658  , Type0_Eq (Type_Root_of_Expr root)
 659  , Type0_From AST (Type_Root_of_Expr root)
 660  , Type0_Lift   Type_Fun (Type_of_Expr root)
 661  , Type0_Unlift Type_Fun (Type_of_Expr root)
 662  , Error_Expr_Lift (Error_Expr_Lambda AST)       (Error_of_Expr AST root)
 663  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 664  , Root_of_Expr root ~ root
 665  , IBool (Is_Last_Expr (Expr_Lambda root) root)
 666  ) => Expr_From AST (Expr_Lambda root) where
 667         expr_from ex ast ctx k =
 668                 case ast of
 669                  AST "var" asts ->
 670                         case asts of
 671                          [AST name []] -> var_from name ex ast ctx k
 672                          _ -> Left $ error_expr ex $
 673                                 Error_Expr_Wrong_number_of_arguments ast 1
 674                  AST "$"   asts -> from_ast2 asts app_from ex ast ctx k
 675                  AST "\\"  asts -> go_lam asts
 676                  AST "let" asts -> go_let asts
 677                  _ -> Left $ error_expr_unsupported ex ast
 678                 where
 679                 go_lam asts =
 680                         case asts of
 681                          [AST name [], ast_ty_arg, ast_body] ->
 682                                 lam_from name ast_ty_arg ast_body ex ast ctx k
 683                          _ -> Left $ error_expr ex $
 684                                 Error_Expr_Wrong_number_of_arguments ast 3
 685                 go_let asts =
 686                         case asts of
 687                          [AST name [], ast_var, ast_body] ->
 688                                 let_from name ast_var ast_body ex ast ctx k
 689                          _ -> Left $ error_expr ex $
 690                                 Error_Expr_Wrong_number_of_arguments ast 3
 691 instance -- Expr_From AST Expr_Maybe
 692  ( Expr_From AST root
 693  , Type0_Eq (Type_Root_of_Expr root)
 694  , Type0_From AST (Type_Root_of_Expr root)
 695  , Type0_Lift   Type_Fun   (Type_of_Expr root)
 696  , Type0_Unlift Type_Fun   (Type_of_Expr root)
 697  , Type0_Lift   Type_Maybe (Type_of_Expr root)
 698  , Type0_Unlift Type_Maybe (Type_of_Expr root)
 699  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 700  , Root_of_Expr root ~ root
 701  , IBool (Is_Last_Expr (Expr_Maybe root) root)
 702  ) => Expr_From AST (Expr_Maybe root) where
 703         expr_from ex ast ctx k =
 704                 case ast of
 705                  AST "maybe"   asts -> from_ast3 asts maybe_from   ex ast ctx k
 706                  AST "nothing" asts -> from_ast1 asts nothing_from ex ast ctx k
 707                  AST "just"    asts -> from_ast1 asts just_from    ex ast ctx k
 708                  _ -> Left $ error_expr_unsupported ex ast
 709 instance -- Expr_From AST Expr_Eq
 710  ( Expr_From AST root
 711  , Type0_Eq (Type_Root_of_Expr root)
 712  , Type0_Lift Type_Bool (Type_of_Expr root)
 713  , Type0_Lift Type_Fun  (Type_of_Expr root)
 714  , Type0_Constraint Eq (Type_Root_of_Expr root)
 715  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 716  , Root_of_Expr root ~ root
 717  , IBool (Is_Last_Expr (Expr_Eq root) root)
 718  ) => Expr_From AST (Expr_Eq root) where
 719         expr_from ex ast ctx k =
 720                 case ast of
 721                  AST "==" asts -> from_ast012 asts Nothing (Just (eq_from1 (Expr.==))) (eq_from (Expr.==)) ex ast ctx k
 722                  AST "/=" asts -> from_ast012 asts Nothing (Just (eq_from1 (Expr./=))) (eq_from (Expr./=)) ex ast ctx k
 723                  _ -> Left $ error_expr_unsupported ex ast
 724 instance -- Expr_From AST Expr_Ord
 725  ( Expr_From AST root
 726  , Type0_Eq (Type_Root_of_Expr root)
 727  , Type0_Lift Type_Bool     (Type_of_Expr root)
 728  , Type0_Lift Type_Fun      (Type_of_Expr root)
 729  , Type0_Lift Type_Ordering (Type_of_Expr root)
 730  , Type0_Constraint Ord (Type_Root_of_Expr root)
 731  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 732  , Root_of_Expr root ~ root
 733  , IBool (Is_Last_Expr (Expr_Ord root) root)
 734  ) => Expr_From AST (Expr_Ord root) where
 735         expr_from ex ast ctx k =
 736                 let c = (Proxy :: Proxy Ord) in
 737                 case ast of
 738                  AST "compare" asts -> from_ast012 asts Nothing (Just compare_from1) compare_from ex ast ctx k
 739                  AST "<"       asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.<))  (ord_from (Expr.<))  ex ast ctx k
 740                  AST "<="      asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.<=)) (ord_from (Expr.<=)) ex ast ctx k
 741                  AST ">"       asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.>))  (ord_from (Expr.>))  ex ast ctx k
 742                  AST ">="      asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.>=)) (ord_from (Expr.>=)) ex ast ctx k
 743                  AST "min"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.min c) (class_op2_from Expr.min c) ex ast ctx k
 744                  AST "max"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.max c) (class_op2_from Expr.max c) ex ast ctx k
 745                  _ -> Left $ error_expr_unsupported ex ast
 746 instance -- Expr_From AST Expr_List
 747  ( Expr_From AST root
 748  , Type0_Eq (Type_Root_of_Expr root)
 749  , Type0_From AST (Type_Root_of_Expr root)
 750  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 751  , Type0_Unlift Type_Fun  (Type_of_Expr root)
 752  , Type0_Lift   Type_List (Type_of_Expr root)
 753  , Type0_Unlift Type_List (Type_of_Expr root)
 754  , Type0_Lift   Type_Bool (Type_of_Expr root)
 755  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 756  , Root_of_Expr root ~ root
 757  , IBool (Is_Last_Expr (Expr_List root) root)
 758  ) => Expr_From AST (Expr_List root) where
 759         expr_from ex ast ctx k =
 760                 case ast of
 761                  AST "[]"          asts -> from_ast1 asts list_empty_from  ex ast ctx k
 762                  AST ":"           asts -> from_ast2 asts list_cons_from   ex ast ctx k
 763                  AST "list_filter" asts -> from_ast2 asts list_filter_from ex ast ctx k
 764                  AST "list"        asts ->
 765                         case asts of
 766                          ast_ty_a:asts' -> list_from ast_ty_a asts' ex ast ctx k
 767                          _ -> Left $ error_expr ex $
 768                                 Error_Expr_Wrong_number_of_arguments ast 1
 769                  AST "list_zipWith" asts -> from_ast3 asts list_zipWith_from ex ast ctx k
 770                  AST "list_reverse" asts -> from_ast1 asts list_reverse_from ex ast ctx k
 771                  _ -> Left $ error_expr_unsupported ex ast
 772 instance -- Expr_From AST Expr_Map
 773  ( Expr_From AST root
 774  , Type0_Eq (Type_Root_of_Expr root)
 775  , Type0_Lift   Type_Fun    (Type_of_Expr root)
 776  , Type0_Unlift Type_Fun    (Type_of_Expr root)
 777  , Type0_Lift   Type_Bool   (Type_of_Expr root)
 778  , Type0_Unlift Type_Bool   (Type_of_Expr root)
 779  , Type0_Lift   Type_List   (Type_of_Expr root)
 780  , Type0_Unlift Type_List   (Type_of_Expr root)
 781  , Type0_Lift   Type_Map    (Type_of_Expr root)
 782  , Type0_Unlift Type_Map    (Type_of_Expr root)
 783  , Type0_Lift   Type_Maybe  (Type_of_Expr root)
 784  , Type0_Unlift Type_Maybe  (Type_of_Expr root)
 785  , Type0_Lift   Type_Tuple2 (Type_of_Expr root)
 786  , Type0_Unlift Type_Tuple2 (Type_of_Expr root)
 787  , Type0_Constraint Ord (Type_Root_of_Expr root)
 788  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 789  , Root_of_Expr root ~ root
 790  , IBool (Is_Last_Expr (Expr_Map root) root)
 791  ) => Expr_From AST (Expr_Map root) where
 792         expr_from ex ast ctx k =
 793                 case ast of
 794                  AST "map_from_list"    asts -> from_ast1 asts map_from_list_from ex ast ctx k
 795                  AST "mapWithKey"       asts -> from_ast2 asts mapWithKey_from ex ast ctx k
 796                  AST "map_lookup"       asts -> from_ast2 asts map_lookup_from ex ast ctx k
 797                  AST "map_keys"         asts -> from_ast1 asts map_keys_from ex ast ctx k
 798                  AST "map_member"       asts -> from_ast2 asts map_member_from ex ast ctx k
 799                  AST "map_insert"       asts -> from_ast3 asts map_insert_from ex ast ctx k
 800                  AST "map_delete"       asts -> from_ast2 asts map_delete_from ex ast ctx k
 801                  AST "map_difference"   asts -> from_ast2 asts map_difference_from ex ast ctx k
 802                  AST "map_foldrWithKey" asts -> from_ast3 asts map_foldrWithKey_from ex ast ctx k
 803                  _ -> Left $ error_expr_unsupported ex ast
 804 instance -- Expr_From AST Expr_Functor
 805  ( Expr_From AST root
 806  , Type0_Eq (Type_Root_of_Expr root)
 807  , Type0_Lift   Type_Fun (Type_of_Expr root)
 808  , Type0_Unlift Type_Fun (Type_of_Expr root)
 809  , Type1_Unlift (Type_of_Expr root)
 810  , Type1_Constraint Functor (Type_Root_of_Expr root)
 811  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 812  , Root_of_Expr root ~ root
 813  , IBool (Is_Last_Expr (Expr_Functor root) root)
 814  ) => Expr_From AST (Expr_Functor root) where
 815         expr_from ex ast ctx k =
 816                 case ast of
 817                  AST "fmap" asts -> from_ast2 asts fmap_from ex ast ctx k
 818                  AST "<$>"  asts -> from_ast2 asts fmap_from ex ast ctx k
 819                  _ -> Left $ error_expr_unsupported ex ast
 820 instance -- Expr_From AST Expr_MonoFunctor
 821  ( Expr_From AST root
 822  , Type0_Eq (Type_Root_of_Expr root)
 823  , Type0_Lift   Type_Fun (Type_of_Expr root)
 824  , Type0_Unlift Type_Fun (Type_of_Expr root)
 825  , Type1_Unlift (Type_of_Expr root)
 826  , Type0_Constraint MT.MonoFunctor (Type_Root_of_Expr root)
 827  , Type0_Family Type_Family_MonoElement (Type_Root_of_Expr root)
 828  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 829  , Root_of_Expr root ~ root
 830  , IBool (Is_Last_Expr (Expr_MonoFunctor root) root)
 831  ) => Expr_From AST (Expr_MonoFunctor root) where
 832         expr_from ex ast ctx k =
 833                 case ast of
 834                  AST "omap" asts -> from_ast2 asts omap_from ex ast ctx k
 835                  _ -> Left $ error_expr_unsupported ex ast
 836 instance -- Expr_From AST Expr_Applicative
 837  ( Expr_From AST root
 838  , Type0_Eq (Type_Root_of_Expr root)
 839  , Type1_From AST (Type_Root_of_Expr root)
 840  , Type0_Lift   Type_Fun (Type_of_Expr root)
 841  , Type0_Unlift Type_Fun (Type_of_Expr root)
 842  , Type1_Eq (Type_Root_of_Expr root)
 843  , Type1_Unlift (Type_of_Expr root)
 844  , Type1_Constraint Applicative (Type_Root_of_Expr root)
 845  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 846  , Root_of_Expr root ~ root
 847  , IBool (Is_Last_Expr (Expr_Applicative root) root)
 848  ) => Expr_From AST (Expr_Applicative root) where
 849         expr_from ex ast ctx k =
 850                 case ast of
 851                  AST "pure" asts -> from_ast2 asts pure_from     ex ast ctx k
 852                  AST "<*>"  asts -> from_ast2 asts ltstargt_from ex ast ctx k
 853                  _ -> Left $ error_expr_unsupported ex ast
 854 instance -- Expr_From AST Expr_Traversable
 855  ( Expr_From AST root
 856  , Type0_Eq (Type_Root_of_Expr root)
 857  , Type0_Lift   Type_Fun (Type_of_Expr root)
 858  , Type0_Unlift Type_Fun (Type_of_Expr root)
 859  , Type1_Eq (Type_Root_of_Expr root)
 860  , Type1_Unlift (Type_of_Expr root)
 861  , Type1_Constraint Applicative (Type_Root_of_Expr root)
 862  , Type1_Constraint Traversable (Type_Root_of_Expr root)
 863  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 864  , Root_of_Expr root ~ root
 865  , IBool (Is_Last_Expr (Expr_Traversable root) root)
 866  ) => Expr_From AST (Expr_Traversable root) where
 867         expr_from ex ast ctx k =
 868                 case ast of
 869                  AST "traverse"  asts -> from_ast2 asts traverse_from ex ast ctx k
 870                  _ -> Left $ error_expr_unsupported ex ast
 871 instance -- Expr_From AST Expr_Foldable
 872  ( Expr_From AST root
 873  , Type0_Constraint Eq       (Type_Root_of_Expr root)
 874  , Type0_Constraint Monoid   (Type_Root_of_Expr root)
 875  , Type0_Constraint Ord      (Type_Root_of_Expr root)
 876  , Type0_Eq                  (Type_Root_of_Expr root)
 877  , Type0_Lift   Type_Bool    (Type_of_Expr root)
 878  , Type0_Lift   Type_Fun     (Type_of_Expr root)
 879  , Type0_Lift   Type_Int     (Type_of_Expr root)
 880  , Type0_Unlift Type_Fun     (Type_of_Expr root)
 881  , Type1_Constraint Foldable (Type_Root_of_Expr root)
 882  , Type1_Eq (Type_Root_of_Expr root)
 883  , Type1_Unlift (Type_of_Expr root)
 884  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 885  , Root_of_Expr root ~ root
 886  , IBool (Is_Last_Expr (Expr_Foldable root) root)
 887  ) => Expr_From AST (Expr_Foldable root) where
 888         expr_from ex ast ctx k =
 889                 case ast of
 890                  AST "foldMap" asts -> from_ast2 asts foldMap_from ex ast ctx k
 891                  AST "null"    asts -> from_ast1 asts null_from ex ast ctx k
 892                  AST "length"  asts -> from_ast1 asts length_from ex ast ctx k
 893                  AST "minimum" asts -> from_ast1 asts minimum_from ex ast ctx k
 894                  AST "maximum" asts -> from_ast1 asts maximum_from ex ast ctx k
 895                  AST "elem"    asts -> from_ast2 asts elem_from ex ast ctx k
 896                  _ -> Left $ error_expr_unsupported ex ast
 897 instance -- Expr_From AST Expr_Monoid
 898  ( Expr_From AST root
 899  , Type0_Eq (Type_Root_of_Expr root)
 900  , Type0_From AST (Type_Root_of_Expr root)
 901  , Type0_Constraint Monoid (Type_Root_of_Expr root)
 902  , Type0_Lift   Type_Int  (Type_of_Expr root)
 903  , Type0_Lift   Type_Bool (Type_of_Expr root)
 904  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 905  , Type0_Unlift Type_Fun  (Type_of_Expr root)
 906  , Type1_Unlift (Type_of_Expr root)
 907  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 908  , Root_of_Expr root ~ root
 909  , IBool (Is_Last_Expr (Expr_Monoid root) root)
 910  ) => Expr_From AST (Expr_Monoid root) where
 911         expr_from ex ast ctx k =
 912                 case ast of
 913                  AST "mempty"  asts -> from_ast1 asts mempty_from ex ast ctx k
 914                  AST "mappend" asts -> from_ast012 asts Nothing (Just mappend_from1) mappend_from ex ast ctx k
 915                  AST "<>"      asts -> from_ast012 asts Nothing (Just mappend_from1) mappend_from ex ast ctx k
 916                  _ -> Left $ error_expr_unsupported ex ast
 917 instance -- Expr_From AST Expr_Monad
 918  ( Expr_From AST root
 919  , Type0_Eq (Type_Root_of_Expr root)
 920  , Type0_Lift   Type_Fun (Type_of_Expr root)
 921  , Type0_Unlift Type_Fun (Type_of_Expr root)
 922  , Type1_From AST (Type_Root_of_Expr root)
 923  , Type1_Constraint Monad (Type_Root_of_Expr root)
 924  , Type1_Eq (Type_Root_of_Expr root)
 925  , Type1_Unlift (Type_of_Expr root)
 926  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 927  , Root_of_Expr root ~ root
 928  , IBool (Is_Last_Expr (Expr_Monad root) root)
 929  ) => Expr_From AST (Expr_Monad root) where
 930         expr_from ex ast ctx k =
 931                 case ast of
 932                  AST "return" asts -> from_ast2 asts return_from ex ast ctx k
 933                  AST ">>="    asts -> from_ast2 asts bind_from   ex ast ctx k
 934                  _ -> Left $ error_expr_unsupported ex ast
 935 instance -- Expr_From AST Expr_Either
 936  ( Expr_From AST root
 937  , Type0_Eq (Type_Root_of_Expr root)
 938  , Type0_From AST (Type_Root_of_Expr root)
 939  , Type0_Lift   Type_Either (Type_of_Expr root)
 940  , Type0_Unlift Type_Either (Type_of_Expr root)
 941  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 942  , Root_of_Expr root ~ root
 943  , IBool (Is_Last_Expr (Expr_Either root) root)
 944  ) => Expr_From AST (Expr_Either root) where
 945         expr_from ex ast ctx k =
 946                 case ast of
 947                  AST "left"  asts -> from_ast2 asts left_from  ex ast ctx k
 948                  AST "right" asts -> from_ast2 asts right_from ex ast ctx k
 949                  _ -> Left $ error_expr_unsupported ex ast
 950 instance -- Expr_From AST Expr_Tuple2
 951  ( Expr_From AST root
 952  , Type0_Eq (Type_Root_of_Expr root)
 953  , Type0_Lift   Type_Tuple2 (Type_of_Expr root)
 954  , Type0_Unlift Type_Tuple2 (Type_of_Expr root)
 955  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 956  , Root_of_Expr root ~ root
 957  , IBool (Is_Last_Expr (Expr_Tuple2 root) root)
 958  ) => Expr_From AST (Expr_Tuple2 root) where
 959         expr_from ex ast ctx k =
 960                 case ast of
 961                  AST "(,)" asts -> from_ast2 asts tuple2_from ex ast ctx k
 962                  AST "fst" asts -> from_ast1 asts fst_from ex ast ctx k
 963                  AST "snd" asts -> from_ast1 asts snd_from ex ast ctx k
 964                  _ -> Left $ error_expr_unsupported ex ast