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