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