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_Integer
 249  ( Type_Root_Lift Type_Integer root
 250  , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 251  , IBool (Is_Last_Type (Type_Integer root) root)
 252  ) => Type0_From AST (Type_Integer root) where
 253         type0_from ty ast k =
 254                 case ast of
 255                  AST "Integer" asts ->
 256                         case asts of
 257                          [] -> k type_integer
 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_Text
 262  ( Type_Root_Lift Type_Text root
 263  , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 264  , IBool (Is_Last_Type (Type_Text root) root)
 265  ) => Type0_From AST (Type_Text root) where
 266         type0_from ty ast k =
 267                 case ast of
 268                  AST "Text" asts ->
 269                         case asts of
 270                          [] -> k type_text
 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_Ordering
 275  ( Type_Root_Lift Type_Ordering root
 276  , Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 277  , IBool (Is_Last_Type (Type_Ordering root) root)
 278  ) => Type0_From AST (Type_Ordering root) where
 279         type0_from ty ast k =
 280                 case ast of
 281                  AST "Ordering" asts ->
 282                         case asts of
 283                          [] -> k type_ordering
 284                          _ -> Left $ error_type_lift $
 285                                 Error_Type_Wrong_number_of_arguments ast 0
 286                  _ -> Left $ error_type_unsupported ty ast
 287 instance -- Type0_From AST Type_Fun
 288  ( Type0_Eq root
 289  , Type0_From AST root
 290  , Type_Root_Lift Type_Fun root
 291  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 292  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 293  , Root_of_Type root ~ root
 294  , IBool (Is_Last_Type (Type_Fun root) root)
 295  ) => Type0_From AST (Type_Fun root) where
 296         type0_from ty ast k =
 297                 case ast of
 298                  AST "->" asts ->
 299                         case asts of
 300                          [ast_arg, ast_res] -> type_fun_from ty ast_arg ast_res k
 301                          _ -> Left $ error_type_lift $
 302                                 Error_Type_Wrong_number_of_arguments ast 2
 303                  _ -> Left $ error_type_unsupported ty ast
 304 instance -- Type0_From AST Type_Maybe
 305  ( Type0_Eq root
 306  , Type0_From AST root
 307  , Type_Root_Lift Type_Maybe root
 308  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 309  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 310  , Root_of_Type root ~ root
 311  , IBool (Is_Last_Type (Type_Maybe root) root)
 312  ) => Type0_From AST (Type_Maybe root) where
 313         type0_from ty ast k =
 314                 case ast of
 315                  AST "Maybe" asts ->
 316                         case asts of
 317                          [ast_a] ->
 318                                 type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
 319                                 k (type_maybe ty_a)
 320                          _ -> Left $ error_type_lift $
 321                                 Error_Type_Wrong_number_of_arguments ast 1
 322                  _ -> Left $ error_type_unsupported ty ast
 323 instance -- Type0_From AST Type_List
 324  ( Type0_Eq root
 325  , Type0_From AST root
 326  , Type_Root_Lift Type_List root
 327  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 328  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 329  , Root_of_Type root ~ root
 330  , IBool (Is_Last_Type (Type_List root) root)
 331  ) => Type0_From AST (Type_List root) where
 332         type0_from ty ast k =
 333                 case ast of
 334                  AST "[]" asts ->
 335                         case asts of
 336                          [ast_a] ->
 337                                 type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
 338                                 k (type_list ty_a)
 339                          _ -> Left $ error_type_lift $
 340                                 Error_Type_Wrong_number_of_arguments ast 1
 341                  _ -> Left $ error_type_unsupported ty ast
 342 instance -- Type0_From AST Type_Map
 343  ( Type0_Eq root
 344  , Type0_From AST root
 345  , Type_Root_Lift Type_Map root
 346  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 347  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 348  , Type0_Constraint Ord root
 349  , Root_of_Type root ~ root
 350  , IBool (Is_Last_Type (Type_Map root) root)
 351  ) => Type0_From AST (Type_Map root) where
 352         type0_from ty ast k =
 353                 case ast of
 354                  AST "Map" asts ->
 355                         case asts of
 356                          [ast_k, ast_a] ->
 357                                 type0_from (Proxy::Proxy root) ast_k $ \ty_k ->
 358                                 type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
 359                                 k (type_map ty_k ty_a)
 360                          _ -> Left $ error_type_lift $
 361                                 Error_Type_Wrong_number_of_arguments ast 2
 362                  _ -> Left $ error_type_unsupported ty ast
 363 instance -- Type0_From AST Type_Tuple2
 364  ( Type0_Eq root
 365  , Type0_From AST root
 366  , Type_Root_Lift Type_Tuple2 root
 367  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 368  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 369  , Root_of_Type root ~ root
 370  , IBool (Is_Last_Type (Type_Tuple2 root) root)
 371  ) => Type0_From AST (Type_Tuple2 root) where
 372         type0_from ty ast k =
 373                 case ast of
 374                  AST "(,)" asts ->
 375                         case asts of
 376                          [ast_a, ast_b] ->
 377                                 type0_from (Proxy::Proxy root) ast_a $ \ty_a ->
 378                                 type0_from (Proxy::Proxy root) ast_b $ \ty_b ->
 379                                 k (type_tuple2 ty_a ty_b)
 380                          _ -> Left $ error_type_lift $
 381                                 Error_Type_Wrong_number_of_arguments ast 2
 382                  _ -> Left $ error_type_unsupported ty ast
 383 instance -- Type0_From AST Type_Either
 384  ( Type0_Eq root
 385  , Type0_From AST root
 386  , Type_Root_Lift Type_Either root
 387  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 388  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 389  , Root_of_Type root ~ root
 390  , IBool (Is_Last_Type (Type_Either root) root)
 391  ) => Type0_From AST (Type_Either root) where
 392         type0_from ty ast k =
 393                 case ast of
 394                  AST "Either" asts ->
 395                         case asts of
 396                          [ast_l, ast_r] ->
 397                                 type0_from (Proxy::Proxy root) ast_l $ \ty_l ->
 398                                 type0_from (Proxy::Proxy root) ast_r $ \ty_r ->
 399                                 k (type_either ty_l ty_r)
 400                          _ -> Left $ error_type_lift $
 401                                 Error_Type_Wrong_number_of_arguments ast 2
 402                  _ -> Left $ error_type_unsupported ty ast
 403
 404 instance -- Type1_From AST Type_Bool
 405  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 406  , IBool (Is_Last_Type (Type_Bool root) root)
 407  ) => Type1_From AST (Type_Bool root)
 408 instance -- Type1_From AST Type_Int
 409  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 410  , IBool (Is_Last_Type (Type_Int root) root)
 411  ) => Type1_From AST (Type_Int root)
 412 instance -- Type1_From AST Type_Integer
 413  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 414  , IBool (Is_Last_Type (Type_Integer root) root)
 415  ) => Type1_From AST (Type_Integer root)
 416 instance -- Type1_From AST Type_Unit
 417  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 418  , IBool (Is_Last_Type (Type_Unit root) root)
 419  ) => Type1_From AST (Type_Unit root)
 420 instance -- Type1_From AST Type_Ordering
 421  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 422  , IBool (Is_Last_Type (Type_Ordering root) root)
 423  ) => Type1_From AST (Type_Ordering root)
 424 instance -- Type1_From AST Type_Text
 425  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 426  , IBool (Is_Last_Type (Type_Text root) root)
 427  ) => Type1_From AST (Type_Text root)
 428 instance -- Type1_From AST Type_Char
 429  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 430  , IBool (Is_Last_Type (Type_Char root) root)
 431  ) => Type1_From AST (Type_Char root)
 432 instance -- Type1_From AST Type_Var0
 433  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 434  , IBool (Is_Last_Type (Type_Var0 root) root)
 435  ) => Type1_From AST (Type_Var0 root)
 436 instance -- Type1_From AST Type_Var1
 437  ( Error_Type_Lift (Error_Type AST) (Error_of_Type AST root)
 438  , IBool (Is_Last_Type (Type_Var1 root) root)
 439  ) => Type1_From AST (Type_Var1 root)
 440 instance -- Type1_From AST Type_Maybe
 441  ( Type0_From AST root
 442  , Type_Root_Lift Type_Maybe 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_Maybe root) root)
 447  ) => Type1_From AST (Type_Maybe root) where
 448         type1_from ty ast k =
 449                 case ast of
 450                  AST "Maybe" asts ->
 451                         case asts of
 452                          [] -> k (Proxy::Proxy Maybe) type_maybe
 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_List
 457  ( Type0_Eq root
 458  , Type0_From AST root
 459  , Type_Root_Lift Type_List 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_List root) root)
 464  ) => Type1_From AST (Type_List root) where
 465         type1_from ty ast k =
 466                 case ast of
 467                  AST "[]" asts ->
 468                         case asts of
 469                          [] -> k (Proxy::Proxy []) type_list
 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_IO
 474  ( Type0_Eq root
 475  , Type0_From AST root
 476  , Type_Root_Lift Type_IO 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_IO root) root)
 481  ) => Type1_From AST (Type_IO root) where
 482         type1_from ty ast k =
 483                 case ast of
 484                  AST "IO" asts ->
 485                         case asts of
 486                          [] -> k (Proxy::Proxy IO) type_io
 487                          _ -> Left $ error_type_lift $
 488                                 Error_Type_Wrong_number_of_arguments ast 0
 489                  _ -> Left $ error_type_unsupported ty ast
 490 instance -- Type1_From AST Type_Fun
 491  ( Type0_Eq root
 492  , Type0_From AST root
 493  , Type_Root_Lift Type_Fun root
 494  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 495  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 496  , Root_of_Type root ~ root
 497  , IBool (Is_Last_Type (Type_Fun root) root)
 498  ) => Type1_From AST (Type_Fun root) where
 499         type1_from ty ast k =
 500                 case ast of
 501                  AST "->" asts ->
 502                         case asts of
 503                          [ast_arg] ->
 504                                 type0_from (Proxy::Proxy root) ast_arg $ \(ty_arg::root h_arg) ->
 505                                 k (Proxy::Proxy ((->) h_arg)) $
 506                                         type_fun ty_arg
 507                          _ -> Left $ error_type_lift $
 508                                 Error_Type_Wrong_number_of_arguments ast 1
 509                  _ -> Left $ error_type_unsupported ty ast
 510 instance -- Type1_From AST Type_Either
 511  ( Type0_Eq root
 512  , Type0_From AST root
 513  , Type_Root_Lift Type_Either root
 514  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 515  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 516  , Root_of_Type root ~ root
 517  , IBool (Is_Last_Type (Type_Either root) root)
 518  ) => Type1_From AST (Type_Either root) where
 519         type1_from ty ast k =
 520                 case ast of
 521                  AST "Either" asts ->
 522                         case asts of
 523                          [ast_l] ->
 524                                 type0_from (Proxy::Proxy root) ast_l $ \(ty_l::root h_l) ->
 525                                 k (Proxy::Proxy (Either h_l)) $
 526                                         type_either ty_l
 527                          _ -> Left $ error_type_lift $
 528                                 Error_Type_Wrong_number_of_arguments ast 1
 529                  _ -> Left $ error_type_unsupported ty ast
 530 instance -- Type1_From AST Type_Map
 531  ( Type0_Eq root
 532  , Type0_From AST root
 533  , Type_Root_Lift Type_Map root
 534  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 535  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 536  , Root_of_Type root ~ root
 537  , IBool (Is_Last_Type (Type_Map root) root)
 538  ) => Type1_From AST (Type_Map root) where
 539         type1_from ty ast k =
 540                 case ast of
 541                  AST "Map" asts ->
 542                         case asts of
 543                          [ast_k] ->
 544                                 type0_from (Proxy::Proxy root) ast_k $ \(ty_k::root h_k) ->
 545                                 k (Proxy::Proxy (Map h_k)) $
 546                                         type_map ty_k
 547                          _ -> Left $ error_type_lift $
 548                                 Error_Type_Wrong_number_of_arguments ast 1
 549                  _ -> Left $ error_type_unsupported ty ast
 550 instance -- Type1_From AST Type_Tuple2
 551  ( Type0_Eq root
 552  , Type0_From AST root
 553  , Type_Root_Lift Type_Tuple2 root
 554  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 555  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 556  , Root_of_Type root ~ root
 557  , IBool (Is_Last_Type (Type_Tuple2 root) root)
 558  ) => Type1_From AST (Type_Tuple2 root) where
 559         type1_from ty ast k =
 560                 case ast of
 561                  AST "(,)" asts ->
 562                         case asts of
 563                          [ast_a] ->
 564                                 type0_from (Proxy::Proxy root) ast_a $ \(ty_a::root h_a) ->
 565                                 k (Proxy::Proxy ((,) h_a)) $
 566                                         type_tuple2 ty_a
 567                          _ -> Left $ error_type_lift $
 568                                 Error_Type_Wrong_number_of_arguments ast 1
 569                  _ -> Left $ error_type_unsupported ty ast
 570
 571 instance -- Expr_From AST Expr_Bool
 572  ( Expr_From AST root
 573  , Type0_Eq (Type_Root_of_Expr root)
 574  , Type0_Lift   Type_Bool (Type_of_Expr root)
 575  , Type0_Unlift Type_Bool (Type_of_Expr root)
 576  , Type0_Lift   Type_Fun  (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_Bool root) root)
 580  ) => Expr_From AST (Expr_Bool root) where
 581         expr_from ex ast =
 582                 case ast of
 583                  AST "bool" asts -> lit_from_AST bool t asts ex ast
 584                  AST "not"  asts -> from_ast01  asts (Just $ op1_from0 Expr.not   t) (op1_from Expr.not t) ex ast
 585                  AST "&&"   asts -> from_ast012 asts (Just $ op2_from0 (Expr.&&)  t) (Just $ op2_from1 (Expr.&&) t) (op2_from (Expr.&&) t) ex ast
 586                  AST "||"   asts -> from_ast012 asts (Just $ op2_from0 (Expr.||)  t) (Just $ op2_from1 (Expr.||) t) (op2_from (Expr.||) t) ex ast
 587                  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
 588                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 589                 where t = type_bool
 590 instance -- Expr_From AST Expr_If
 591  ( Expr_From AST root
 592  , Type0_Eq (Type_Root_of_Expr root)
 593  , Type0_Lift Type_Bool (Type_of_Expr root)
 594  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 595  , Root_of_Expr root ~ root
 596  , IBool (Is_Last_Expr (Expr_If root) root)
 597  ) => Expr_From AST (Expr_If root) where
 598         expr_from ex ast ctx k =
 599                 case ast of
 600                  AST "if" asts -> from_ast3 asts if_from ex ast ctx k
 601                  _ -> Left $ error_expr_unsupported ex ast
 602 instance -- Expr_From AST Expr_When
 603  ( Expr_From AST root
 604  , Type0_Eq (Type_Root_of_Expr root)
 605  , Type0_Lift Type_Bool (Type_of_Expr root)
 606  , Type0_Lift Type_Unit (Type_of_Expr root)
 607  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 608  , Root_of_Expr root ~ root
 609  , IBool (Is_Last_Expr (Expr_When root) root)
 610  ) => Expr_From AST (Expr_When root) where
 611         expr_from ex ast ctx k =
 612                 case ast of
 613                  AST "when" asts -> from_ast2 asts when_from ex ast ctx k
 614                  _ -> Left $ error_expr_unsupported ex ast
 615 instance -- Expr_From AST Expr_Int
 616  ( Expr_From AST root
 617  , Type0_Eq (Type_Root_of_Expr root)
 618  , Type0_Lift   Type_Int (Type_of_Expr root)
 619  , Type0_Unlift Type_Int (Type_of_Expr root)
 620  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 621  , Root_of_Expr root ~ root
 622  , IBool (Is_Last_Expr (Expr_Int root) root)
 623  ) => Expr_From AST (Expr_Int root) where
 624         expr_from ex ast =
 625                 case ast of
 626                  AST "int" asts -> lit_from_AST int type_int asts ex ast
 627                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 628 instance -- Expr_From AST Expr_Integer
 629  ( Expr_From AST root
 630  , Type0_Eq (Type_Root_of_Expr root)
 631  , Type0_Lift   Type_Integer (Type_of_Expr root)
 632  , Type0_Unlift Type_Integer (Type_of_Expr root)
 633  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 634  , Root_of_Expr root ~ root
 635  , IBool (Is_Last_Expr (Expr_Integer root) root)
 636  ) => Expr_From AST (Expr_Integer root) where
 637         expr_from ex ast =
 638                 case ast of
 639                  AST "integer" asts -> lit_from_AST integer type_integer asts ex ast
 640                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 641 instance -- Expr_From AST Expr_Num
 642  ( Expr_From AST root
 643  , Type0_Eq (Type_Root_of_Expr root)
 644  , Type0_Constraint Num (Type_Root_of_Expr root)
 645  , Type0_Lift   Type_Integer (Type_of_Expr root)
 646  , Type0_Unlift Type_Integer (Type_of_Expr root)
 647  , Type0_Lift   Type_Fun     (Type_of_Expr root)
 648  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 649  , Root_of_Expr root ~ root
 650  , IBool (Is_Last_Expr (Expr_Num root) root)
 651  ) => Expr_From AST (Expr_Num root) where
 652         expr_from ex ast =
 653                 let c = (Proxy :: Proxy Num) in
 654                 case ast of
 655                  AST "abs"    asts -> from_ast1 asts (class_op1_from Expr.abs    c) ex ast
 656                  AST "negate" asts -> from_ast1 asts (class_op1_from Expr.negate c) ex ast
 657                  AST "signum" asts -> from_ast1 asts (class_op1_from Expr.signum c) ex ast
 658                  AST "+"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.+) c) (class_op2_from (Expr.+) c) ex ast
 659                  AST "-"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.-) c) (class_op2_from (Expr.-) c) ex ast
 660                  AST "*"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.*) c) (class_op2_from (Expr.*) c) ex ast
 661                  AST "fromInteger" asts -> from_ast1 asts fromInteger_from ex ast
 662                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 663 instance -- Expr_From AST Expr_Integral
 664  ( Expr_From AST root
 665  , Type0_Eq (Type_Root_of_Expr root)
 666  , Type0_Constraint Integral (Type_Root_of_Expr root)
 667  , Type0_Lift Type_Fun     (Type_of_Expr root)
 668  , Type0_Lift Type_Integer (Type_of_Expr root)
 669  , Type0_Lift Type_Tuple2  (Type_of_Expr root)
 670  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 671  , Root_of_Expr root ~ root
 672  , IBool (Is_Last_Expr (Expr_Integral root) root)
 673  ) => Expr_From AST (Expr_Integral root) where
 674         expr_from ex ast =
 675                 let c = (Proxy :: Proxy Integral) in
 676                 case ast of
 677                  AST "quot"    asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.quot c) (class_op2_from Expr.quot c) ex ast
 678                  AST "div"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.div  c) (class_op2_from Expr.div  c) ex ast
 679                  AST "rem"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.rem  c) (class_op2_from Expr.rem  c) ex ast
 680                  AST "mod"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.mod  c) (class_op2_from Expr.mod  c) ex ast
 681                  AST "quotRem" asts -> from_ast012 asts Nothing (Just quotRem_from1) quotRem_from ex ast
 682                  AST "divMod"  asts -> from_ast012 asts Nothing (Just divMod_from1)  divMod_from  ex ast
 683                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 684 instance -- Expr_From AST Expr_Text
 685  ( Expr_From AST root
 686  , Type0_Eq (Type_Root_of_Expr root)
 687  , Type0_Lift   Type_Text (Type_of_Expr root)
 688  , Type0_Unlift Type_Text (Type_of_Expr root)
 689  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 690  , Root_of_Expr root ~ root
 691  , IBool (Is_Last_Expr (Expr_Text root) root)
 692  ) => Expr_From AST (Expr_Text root) where
 693         expr_from ex ast =
 694                 case ast of
 695                  AST "text" asts ->
 696                         case asts of
 697                          [AST lit []] -> \_ctx k ->
 698                                 k type_text $ Forall_Repr_with_Context $ \_c -> text lit
 699                          _ -> \_ctx _k -> Left $ error_expr ex $
 700                                 Error_Expr_Wrong_number_of_arguments ast 1
 701                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 702 instance -- Expr_From AST Expr_Char
 703  ( Expr_From AST root
 704  , Type0_Eq (Type_Root_of_Expr root)
 705  , Type0_Lift   Type_Char (Type_of_Expr root)
 706  , Type0_Unlift Type_Char (Type_of_Expr root)
 707  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 708  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 709  , Root_of_Expr root ~ root
 710  , IBool (Is_Last_Expr (Expr_Char root) root)
 711  ) => Expr_From AST (Expr_Char root) where
 712         expr_from ex ast =
 713                 case ast of
 714                  AST "char" asts ->
 715                         case asts of
 716                          [AST lit []] ->
 717                                 case Text.uncons lit of
 718                                  Just (c, "") -> \_ctx k ->
 719                                         k type_char $ Forall_Repr_with_Context $ \_c -> char c
 720                                  _ -> \_ctx _k -> Left $ error_expr ex $
 721                                         Error_Expr_Read (Error_Read lit) ast
 722                          _ -> \_ctx _k -> Left $ error_expr ex $
 723                                 Error_Expr_Wrong_number_of_arguments ast 1
 724                  AST "char_toUpper" asts -> from_ast01 asts (Just $ op1_from0 char_toUpper type_char) (op1_from char_toUpper type_char) ex ast
 725                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 726 instance -- Expr_From AST Expr_Lambda
 727  ( Expr_From AST root
 728  , Type0_Eq (Type_Root_of_Expr root)
 729  , Type0_From AST (Type_Root_of_Expr root)
 730  , Type0_Lift   Type_Fun (Type_of_Expr root)
 731  , Type0_Unlift Type_Fun (Type_of_Expr root)
 732  , Error_Expr_Lift (Error_Expr_Lambda AST)       (Error_of_Expr AST root)
 733  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 734  , Root_of_Expr root ~ root
 735  , IBool (Is_Last_Expr (Expr_Lambda root) root)
 736  ) => Expr_From AST (Expr_Lambda root) where
 737         expr_from ex ast ctx k =
 738                 case ast of
 739                  AST "var" asts ->
 740                         case asts of
 741                          [AST name []] -> var_from name ex ast ctx k
 742                          _ -> Left $ error_expr ex $
 743                                 Error_Expr_Wrong_number_of_arguments ast 1
 744                  AST "$"   asts -> from_ast2 asts app_from ex ast ctx k
 745                  AST "\\"  asts -> go_lam asts
 746                  AST "let" asts -> go_let asts
 747                  _ -> Left $ error_expr_unsupported ex ast
 748                 where
 749                 go_lam asts =
 750                         case asts of
 751                          [AST name [], ast_ty_arg, ast_body] ->
 752                                 lam_from name ast_ty_arg ast_body ex ast ctx k
 753                          _ -> Left $ error_expr ex $
 754                                 Error_Expr_Wrong_number_of_arguments ast 3
 755                 go_let asts =
 756                         case asts of
 757                          [AST name [], ast_var, ast_body] ->
 758                                 let_from name ast_var ast_body ex ast ctx k
 759                          _ -> Left $ error_expr ex $
 760                                 Error_Expr_Wrong_number_of_arguments ast 3
 761 instance -- Expr_From AST Expr_Maybe
 762  ( Expr_From AST root
 763  , Type0_Eq (Type_Root_of_Expr root)
 764  , Type0_From AST (Type_Root_of_Expr root)
 765  , Type0_Lift   Type_Fun   (Type_of_Expr root)
 766  , Type0_Unlift Type_Fun   (Type_of_Expr root)
 767  , Type0_Lift   Type_Maybe (Type_of_Expr root)
 768  , Type0_Unlift Type_Maybe (Type_of_Expr root)
 769  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 770  , Root_of_Expr root ~ root
 771  , IBool (Is_Last_Expr (Expr_Maybe root) root)
 772  ) => Expr_From AST (Expr_Maybe root) where
 773         expr_from ex ast =
 774                 case ast of
 775                  AST "maybe"   asts -> from_ast3 asts maybe_from   ex ast
 776                  AST "nothing" asts -> from_ast1 asts nothing_from ex ast
 777                  AST "just"    asts -> from_ast1 asts just_from    ex ast
 778                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 779 instance -- Expr_From AST Expr_Eq
 780  ( Expr_From AST root
 781  , Type0_Eq (Type_Root_of_Expr root)
 782  , Type0_Lift Type_Bool (Type_of_Expr root)
 783  , Type0_Lift Type_Fun  (Type_of_Expr root)
 784  , Type0_Constraint Eq (Type_Root_of_Expr root)
 785  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 786  , Root_of_Expr root ~ root
 787  , IBool (Is_Last_Expr (Expr_Eq root) root)
 788  ) => Expr_From AST (Expr_Eq root) where
 789         expr_from ex ast =
 790                 case ast of
 791                  AST "==" asts -> from_ast012 asts Nothing (Just (eq_from1 (Expr.==))) (eq_from (Expr.==)) ex ast
 792                  AST "/=" asts -> from_ast012 asts Nothing (Just (eq_from1 (Expr./=))) (eq_from (Expr./=)) ex ast
 793                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 794 instance -- Expr_From AST Expr_Ord
 795  ( Expr_From AST root
 796  , Type0_Eq (Type_Root_of_Expr root)
 797  , Type0_Lift Type_Bool     (Type_of_Expr root)
 798  , Type0_Lift Type_Fun      (Type_of_Expr root)
 799  , Type0_Lift Type_Ordering (Type_of_Expr root)
 800  , Type0_Constraint Ord (Type_Root_of_Expr root)
 801  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 802  , Root_of_Expr root ~ root
 803  , IBool (Is_Last_Expr (Expr_Ord root) root)
 804  ) => Expr_From AST (Expr_Ord root) where
 805         expr_from ex ast =
 806                 let c = (Proxy :: Proxy Ord) in
 807                 case ast of
 808                  AST "compare" asts -> from_ast012 asts Nothing (Just compare_from1) compare_from ex ast
 809                  AST "<"       asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.<))  (ord_from (Expr.<))  ex ast
 810                  AST "<="      asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.<=)) (ord_from (Expr.<=)) ex ast
 811                  AST ">"       asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.>))  (ord_from (Expr.>))  ex ast
 812                  AST ">="      asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.>=)) (ord_from (Expr.>=)) ex ast
 813                  AST "min"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.min c) (class_op2_from Expr.min c) ex ast
 814                  AST "max"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.max c) (class_op2_from Expr.max c) ex ast
 815                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 816 instance -- Expr_From AST Expr_List
 817  ( Expr_From AST root
 818  , Type0_Eq (Type_Root_of_Expr root)
 819  , Type0_From AST (Type_Root_of_Expr root)
 820  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 821  , Type0_Unlift Type_Fun  (Type_of_Expr root)
 822  , Type0_Lift   Type_List (Type_of_Expr root)
 823  , Type0_Unlift Type_List (Type_of_Expr root)
 824  , Type0_Lift   Type_Bool (Type_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_List root) root)
 828  ) => Expr_From AST (Expr_List root) where
 829         expr_from ex ast =
 830                 case ast of
 831                  AST "[]"          asts -> from_ast1 asts list_empty_from  ex ast
 832                  AST ":"           asts -> from_ast2 asts list_cons_from   ex ast
 833                  AST "list_filter" asts -> from_ast2 asts list_filter_from ex ast
 834                  AST "list"        asts -> \ctx k ->
 835                         case asts of
 836                          ast_ty_a:asts' -> list_from ast_ty_a asts' ex ast ctx k
 837                          _ -> Left $ error_expr ex $
 838                                 Error_Expr_Wrong_number_of_arguments ast 1
 839                  AST "list_zipWith" asts -> from_ast3 asts list_zipWith_from ex ast
 840                  AST "list_reverse" asts -> from_ast1 asts list_reverse_from ex ast
 841                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 842 instance -- Expr_From AST Expr_Map
 843  ( Expr_From AST root
 844  , Type0_Eq (Type_Root_of_Expr root)
 845  , Type0_Lift   Type_Fun    (Type_of_Expr root)
 846  , Type0_Unlift Type_Fun    (Type_of_Expr root)
 847  , Type0_Lift   Type_Bool   (Type_of_Expr root)
 848  , Type0_Unlift Type_Bool   (Type_of_Expr root)
 849  , Type0_Lift   Type_List   (Type_of_Expr root)
 850  , Type0_Unlift Type_List   (Type_of_Expr root)
 851  , Type0_Lift   Type_Map    (Type_of_Expr root)
 852  , Type0_Unlift Type_Map    (Type_of_Expr root)
 853  , Type0_Lift   Type_Maybe  (Type_of_Expr root)
 854  , Type0_Unlift Type_Maybe  (Type_of_Expr root)
 855  , Type0_Lift   Type_Tuple2 (Type_of_Expr root)
 856  , Type0_Unlift Type_Tuple2 (Type_of_Expr root)
 857  , Type0_Constraint Ord (Type_Root_of_Expr root)
 858  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 859  , Root_of_Expr root ~ root
 860  , IBool (Is_Last_Expr (Expr_Map root) root)
 861  ) => Expr_From AST (Expr_Map root) where
 862         expr_from ex ast =
 863                 case ast of
 864                  AST "map_from_list"    asts -> from_ast1 asts map_from_list_from ex ast
 865                  AST "mapWithKey"       asts -> from_ast2 asts mapWithKey_from ex ast
 866                  AST "map_lookup"       asts -> from_ast2 asts map_lookup_from ex ast
 867                  AST "map_keys"         asts -> from_ast1 asts map_keys_from ex ast
 868                  AST "map_member"       asts -> from_ast2 asts map_member_from ex ast
 869                  AST "map_insert"       asts -> from_ast3 asts map_insert_from ex ast
 870                  AST "map_delete"       asts -> from_ast2 asts map_delete_from ex ast
 871                  AST "map_difference"   asts -> from_ast2 asts map_difference_from ex ast
 872                  AST "map_foldrWithKey" asts -> from_ast3 asts map_foldrWithKey_from ex ast
 873                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 874 instance -- Expr_From AST Expr_Functor
 875  ( Expr_From AST root
 876  , Type0_Eq (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_Unlift (Type_of_Expr root)
 880  , Type1_Constraint Functor (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_Functor root) root)
 884  ) => Expr_From AST (Expr_Functor root) where
 885         expr_from ex ast =
 886                 case ast of
 887                  AST "fmap" asts -> from_ast2 asts fmap_from ex ast
 888                  AST "<$>"  asts -> from_ast2 asts fmap_from ex ast
 889                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 890 instance -- Expr_From AST Expr_MonoFunctor
 891  ( Expr_From AST root
 892  , Type0_Eq (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_Unlift (Type_of_Expr root)
 896  , Type0_Constraint MT.MonoFunctor (Type_Root_of_Expr root)
 897  , Type0_Family Type_Family_MonoElement (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_MonoFunctor root) root)
 901  ) => Expr_From AST (Expr_MonoFunctor root) where
 902         expr_from ex ast ctx k =
 903                 case ast of
 904                  AST "omap" asts -> from_ast2 asts omap_from ex ast ctx k
 905                  _ -> Left $ error_expr_unsupported ex ast
 906 instance -- Expr_From AST Expr_Applicative
 907  ( Expr_From AST root
 908  , Type0_Eq (Type_Root_of_Expr root)
 909  , Type1_From AST (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  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 916  , Root_of_Expr root ~ root
 917  , IBool (Is_Last_Expr (Expr_Applicative root) root)
 918  ) => Expr_From AST (Expr_Applicative root) where
 919         expr_from ex ast =
 920                 case ast of
 921                  AST "pure" asts -> from_ast2 asts pure_from     ex ast
 922                  AST "<*>"  asts -> from_ast2 asts ltstargt_from ex ast
 923                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 924 instance -- Expr_From AST Expr_Traversable
 925  ( Expr_From AST root
 926  , Type0_Eq (Type_Root_of_Expr root)
 927  , Type0_Lift   Type_Fun (Type_of_Expr root)
 928  , Type0_Unlift Type_Fun (Type_of_Expr root)
 929  , Type1_Eq (Type_Root_of_Expr root)
 930  , Type1_Unlift (Type_of_Expr root)
 931  , Type1_Constraint Applicative (Type_Root_of_Expr root)
 932  , Type1_Constraint Traversable (Type_Root_of_Expr root)
 933  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 934  , Root_of_Expr root ~ root
 935  , IBool (Is_Last_Expr (Expr_Traversable root) root)
 936  ) => Expr_From AST (Expr_Traversable root) where
 937         expr_from ex ast ctx k =
 938                 case ast of
 939                  AST "traverse"  asts -> from_ast2 asts traverse_from ex ast ctx k
 940                  _ -> Left $ error_expr_unsupported ex ast
 941 instance -- Expr_From AST Expr_Foldable
 942  ( Expr_From AST root
 943  , Type0_Constraint Eq       (Type_Root_of_Expr root)
 944  , Type0_Constraint Monoid   (Type_Root_of_Expr root)
 945  , Type0_Constraint Num      (Type_Root_of_Expr root)
 946  , Type0_Constraint Ord      (Type_Root_of_Expr root)
 947  , Type0_Eq                  (Type_Root_of_Expr root)
 948  , Type0_Lift   Type_Bool    (Type_of_Expr root)
 949  , Type0_Lift   Type_Fun     (Type_of_Expr root)
 950  , Type0_Lift   Type_Int     (Type_of_Expr root)
 951  , Type0_Lift   Type_List    (Type_of_Expr root)
 952  , Type0_Unlift Type_Fun     (Type_of_Expr root)
 953  , Type1_Constraint Foldable (Type_Root_of_Expr root)
 954  , Type1_Eq (Type_Root_of_Expr root)
 955  , Type1_Unlift (Type_of_Expr root)
 956  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 957  , Root_of_Expr root ~ root
 958  , IBool (Is_Last_Expr (Expr_Foldable root) root)
 959  ) => Expr_From AST (Expr_Foldable root) where
 960         expr_from ex ast =
 961                 case ast of
 962                  AST "foldMap" asts -> from_ast2 asts foldMap_from ex ast
 963                  AST "foldr"   asts -> from_ast3 asts (foldr_from Expr.foldr) ex ast
 964                  AST "foldr'"  asts -> from_ast3 asts (foldr_from Expr.foldr') ex ast
 965                  AST "foldl"   asts -> from_ast3 asts (foldl_from Expr.foldl) ex ast
 966                  AST "foldl'"  asts -> from_ast3 asts (foldl_from Expr.foldl') ex ast
 967                  AST "null"    asts -> from_ast1 asts null_from ex ast
 968                  AST "length"  asts -> from_ast1 asts length_from ex ast
 969                  AST "minimum" asts -> from_ast1 asts minimum_from ex ast
 970                  AST "maximum" asts -> from_ast1 asts maximum_from ex ast
 971                  AST "elem"    asts -> from_ast2 asts elem_from ex ast
 972                  AST "sum"     asts -> from_ast1 asts sum_from ex ast
 973                  AST "product" asts -> from_ast1 asts product_from ex ast
 974                  AST "toList"  asts -> from_ast1 asts toList_from ex ast
 975                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 976 instance -- Expr_From AST Expr_Monoid
 977  ( Expr_From AST root
 978  , Type0_Eq (Type_Root_of_Expr root)
 979  , Type0_From AST (Type_Root_of_Expr root)
 980  , Type0_Constraint Monoid (Type_Root_of_Expr root)
 981  , Type0_Lift   Type_Int  (Type_of_Expr root)
 982  , Type0_Lift   Type_Bool (Type_of_Expr root)
 983  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 984  , Type0_Unlift Type_Fun  (Type_of_Expr root)
 985  , Type1_Unlift (Type_of_Expr root)
 986  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 987  , Root_of_Expr root ~ root
 988  , IBool (Is_Last_Expr (Expr_Monoid root) root)
 989  ) => Expr_From AST (Expr_Monoid root) where
 990         expr_from ex ast =
 991                 case ast of
 992                  AST "mempty"  asts -> from_ast1 asts mempty_from ex ast
 993                  AST "mappend" asts -> from_ast012 asts Nothing (Just mappend_from1) mappend_from ex ast
 994                  AST "<>"      asts -> from_ast012 asts Nothing (Just mappend_from1) mappend_from ex ast
 995                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 996 instance -- Expr_From AST Expr_Monad
 997  ( Expr_From AST root
 998  , Type0_Eq (Type_Root_of_Expr root)
 999  , Type0_Lift   Type_Fun (Type_of_Expr root)
1000  , Type0_Unlift Type_Fun (Type_of_Expr root)
1001  , Type1_From AST (Type_Root_of_Expr root)
1002  , Type1_Constraint Monad (Type_Root_of_Expr root)
1003  , Type1_Eq (Type_Root_of_Expr root)
1004  , Type1_Unlift (Type_of_Expr root)
1005  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
1006  , Root_of_Expr root ~ root
1007  , IBool (Is_Last_Expr (Expr_Monad root) root)
1008  ) => Expr_From AST (Expr_Monad root) where
1009         expr_from ex ast =
1010                 case ast of
1011                  AST "return" asts -> from_ast2 asts return_from ex ast
1012                  AST ">>="    asts -> from_ast2 asts bind_from   ex ast
1013                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
1014 instance -- Expr_From AST Expr_Either
1015  ( Expr_From AST root
1016  , Type0_Eq (Type_Root_of_Expr root)
1017  , Type0_From AST (Type_Root_of_Expr root)
1018  , Type0_Lift   Type_Either (Type_of_Expr root)
1019  , Type0_Unlift Type_Either (Type_of_Expr root)
1020  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
1021  , Root_of_Expr root ~ root
1022  , IBool (Is_Last_Expr (Expr_Either root) root)
1023  ) => Expr_From AST (Expr_Either root) where
1024         expr_from ex ast =
1025                 case ast of
1026                  AST "left"  asts -> from_ast2 asts left_from  ex ast
1027                  AST "right" asts -> from_ast2 asts right_from ex ast
1028                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
1029 instance -- Expr_From AST Expr_Tuple2
1030  ( Expr_From AST root
1031  , Type0_Eq (Type_Root_of_Expr root)
1032  , Type0_Lift   Type_Tuple2 (Type_of_Expr root)
1033  , Type0_Unlift Type_Tuple2 (Type_of_Expr root)
1034  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
1035  , Root_of_Expr root ~ root
1036  , IBool (Is_Last_Expr (Expr_Tuple2 root) root)
1037  ) => Expr_From AST (Expr_Tuple2 root) where
1038         expr_from ex ast =
1039                 case ast of
1040                  AST "(,)" asts -> from_ast2 asts tuple2_from ex ast
1041                  AST "fst" asts -> from_ast1 asts fst_from ex ast
1042                  AST "snd" asts -> from_ast1 asts snd_from ex ast
1043                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast