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_Maybe
 405  ( Type0_From AST root
 406  , Type_Root_Lift Type_Maybe root
 407  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 408  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 409  , Root_of_Type root ~ root
 410  , IBool (Is_Last_Type (Type_Maybe root) root)
 411  ) => Type1_From AST (Type_Maybe root) where
 412         type1_from ty ast k =
 413                 case ast of
 414                  AST "Maybe" asts ->
 415                         case asts of
 416                          [] -> k (Proxy::Proxy Maybe) type_maybe
 417                          _ -> Left $ error_type_lift $
 418                                 Error_Type_Wrong_number_of_arguments ast 0
 419                  _ -> Left $ error_type_unsupported ty ast
 420 instance -- Type1_From AST Type_List
 421  ( Type0_Eq root
 422  , Type0_From AST root
 423  , Type_Root_Lift Type_List root
 424  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 425  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 426  , Root_of_Type root ~ root
 427  , IBool (Is_Last_Type (Type_List root) root)
 428  ) => Type1_From AST (Type_List root) where
 429         type1_from ty ast k =
 430                 case ast of
 431                  AST "[]" asts ->
 432                         case asts of
 433                          [] -> k (Proxy::Proxy []) type_list
 434                          _ -> Left $ error_type_lift $
 435                                 Error_Type_Wrong_number_of_arguments ast 0
 436                  _ -> Left $ error_type_unsupported ty ast
 437 instance -- Type1_From AST Type_IO
 438  ( Type0_Eq root
 439  , Type0_From AST root
 440  , Type_Root_Lift Type_IO root
 441  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 442  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 443  , Root_of_Type root ~ root
 444  , IBool (Is_Last_Type (Type_IO root) root)
 445  ) => Type1_From AST (Type_IO root) where
 446         type1_from ty ast k =
 447                 case ast of
 448                  AST "IO" asts ->
 449                         case asts of
 450                          [] -> k (Proxy::Proxy IO) type_io
 451                          _ -> Left $ error_type_lift $
 452                                 Error_Type_Wrong_number_of_arguments ast 0
 453                  _ -> Left $ error_type_unsupported ty ast
 454 instance -- Type1_From AST Type_Fun
 455  ( Type0_Eq root
 456  , Type0_From AST root
 457  , Type_Root_Lift Type_Fun root
 458  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 459  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 460  , Root_of_Type root ~ root
 461  , IBool (Is_Last_Type (Type_Fun root) root)
 462  ) => Type1_From AST (Type_Fun root) where
 463         type1_from ty ast k =
 464                 case ast of
 465                  AST "->" asts ->
 466                         case asts of
 467                          [ast_arg] ->
 468                                 type0_from (Proxy::Proxy root) ast_arg $ \(ty_arg::root h_arg) ->
 469                                 k (Proxy::Proxy ((->) h_arg)) $
 470                                         type_fun ty_arg
 471                          _ -> Left $ error_type_lift $
 472                                 Error_Type_Wrong_number_of_arguments ast 1
 473                  _ -> Left $ error_type_unsupported ty ast
 474 instance -- Type1_From AST Type_Either
 475  ( Type0_Eq root
 476  , Type0_From AST root
 477  , Type_Root_Lift Type_Either root
 478  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 479  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 480  , Root_of_Type root ~ root
 481  , IBool (Is_Last_Type (Type_Either root) root)
 482  ) => Type1_From AST (Type_Either root) where
 483         type1_from ty ast k =
 484                 case ast of
 485                  AST "Either" asts ->
 486                         case asts of
 487                          [ast_l] ->
 488                                 type0_from (Proxy::Proxy root) ast_l $ \(ty_l::root h_l) ->
 489                                 k (Proxy::Proxy (Either h_l)) $
 490                                         type_either ty_l
 491                          _ -> Left $ error_type_lift $
 492                                 Error_Type_Wrong_number_of_arguments ast 1
 493                  _ -> Left $ error_type_unsupported ty ast
 494 instance -- Type1_From AST Type_Map
 495  ( Type0_Eq root
 496  , Type0_From AST root
 497  , Type_Root_Lift Type_Map root
 498  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 499  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 500  , Root_of_Type root ~ root
 501  , IBool (Is_Last_Type (Type_Map root) root)
 502  ) => Type1_From AST (Type_Map root) where
 503         type1_from ty ast k =
 504                 case ast of
 505                  AST "Map" asts ->
 506                         case asts of
 507                          [ast_k] ->
 508                                 type0_from (Proxy::Proxy root) ast_k $ \(ty_k::root h_k) ->
 509                                 k (Proxy::Proxy (Map h_k)) $
 510                                         type_map ty_k
 511                          _ -> Left $ error_type_lift $
 512                                 Error_Type_Wrong_number_of_arguments ast 1
 513                  _ -> Left $ error_type_unsupported ty ast
 514 instance -- Type1_From AST Type_Tuple2
 515  ( Type0_Eq root
 516  , Type0_From AST root
 517  , Type_Root_Lift Type_Tuple2 root
 518  , Error_Type_Lift   (Error_Type AST) (Error_of_Type AST root)
 519  , Error_Type_Unlift (Error_Type AST) (Error_of_Type AST root)
 520  , Root_of_Type root ~ root
 521  , IBool (Is_Last_Type (Type_Tuple2 root) root)
 522  ) => Type1_From AST (Type_Tuple2 root) where
 523         type1_from ty ast k =
 524                 case ast of
 525                  AST "(,)" asts ->
 526                         case asts of
 527                          [ast_a] ->
 528                                 type0_from (Proxy::Proxy root) ast_a $ \(ty_a::root h_a) ->
 529                                 k (Proxy::Proxy ((,) h_a)) $
 530                                         type_tuple2 ty_a
 531                          _ -> Left $ error_type_lift $
 532                                 Error_Type_Wrong_number_of_arguments ast 1
 533                  _ -> Left $ error_type_unsupported ty ast
 534
 535 instance -- Expr_From AST Expr_Bool
 536  ( Expr_From AST root
 537  , Type0_Eq (Type_Root_of_Expr root)
 538  , Type0_Lift   Type_Bool (Type_of_Expr root)
 539  , Type0_Unlift Type_Bool (Type_of_Expr root)
 540  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 541  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 542  , Root_of_Expr root ~ root
 543  , IBool (Is_Last_Expr (Expr_Bool root) root)
 544  ) => Expr_From AST (Expr_Bool root) where
 545         expr_from ex ast =
 546                 case ast of
 547                  AST "bool" asts -> lit_from_AST bool t asts ex ast
 548                  AST "not"  asts -> from_ast01  asts (Just $ op1_from0 Expr.not   t) (op1_from Expr.not t) ex ast
 549                  AST "&&"   asts -> from_ast012 asts (Just $ op2_from0 (Expr.&&)  t) (Just $ op2_from1 (Expr.&&) t) (op2_from (Expr.&&) t) ex ast
 550                  AST "||"   asts -> from_ast012 asts (Just $ op2_from0 (Expr.||)  t) (Just $ op2_from1 (Expr.||) t) (op2_from (Expr.||) t) ex ast
 551                  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
 552                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 553                 where t = type_bool
 554 instance -- Expr_From AST Expr_If
 555  ( Expr_From AST root
 556  , Type0_Eq (Type_Root_of_Expr root)
 557  , Type0_Lift Type_Bool (Type_of_Expr root)
 558  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 559  , Root_of_Expr root ~ root
 560  , IBool (Is_Last_Expr (Expr_If root) root)
 561  ) => Expr_From AST (Expr_If root) where
 562         expr_from ex ast ctx k =
 563                 case ast of
 564                  AST "if" asts -> from_ast3 asts if_from ex ast ctx k
 565                  _ -> Left $ error_expr_unsupported ex ast
 566 instance -- Expr_From AST Expr_When
 567  ( Expr_From AST root
 568  , Type0_Eq (Type_Root_of_Expr root)
 569  , Type0_Lift Type_Bool (Type_of_Expr root)
 570  , Type0_Lift Type_Unit (Type_of_Expr root)
 571  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 572  , Root_of_Expr root ~ root
 573  , IBool (Is_Last_Expr (Expr_When root) root)
 574  ) => Expr_From AST (Expr_When root) where
 575         expr_from ex ast ctx k =
 576                 case ast of
 577                  AST "when" asts -> from_ast2 asts when_from ex ast ctx k
 578                  _ -> Left $ error_expr_unsupported ex ast
 579 instance -- Expr_From AST Expr_Int
 580  ( Expr_From AST root
 581  , Type0_Eq (Type_Root_of_Expr root)
 582  , Type0_Lift   Type_Int (Type_of_Expr root)
 583  , Type0_Unlift Type_Int (Type_of_Expr root)
 584  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 585  , Root_of_Expr root ~ root
 586  , IBool (Is_Last_Expr (Expr_Int root) root)
 587  ) => Expr_From AST (Expr_Int root) where
 588         expr_from ex ast =
 589                 case ast of
 590                  AST "int" asts -> lit_from_AST int type_int asts ex ast
 591                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 592 instance -- Expr_From AST Expr_Integer
 593  ( Expr_From AST root
 594  , Type0_Eq (Type_Root_of_Expr root)
 595  , Type0_Lift   Type_Integer (Type_of_Expr root)
 596  , Type0_Unlift Type_Integer (Type_of_Expr root)
 597  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 598  , Root_of_Expr root ~ root
 599  , IBool (Is_Last_Expr (Expr_Integer root) root)
 600  ) => Expr_From AST (Expr_Integer root) where
 601         expr_from ex ast =
 602                 case ast of
 603                  AST "integer" asts -> lit_from_AST integer type_integer asts ex ast
 604                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 605 instance -- Expr_From AST Expr_Num
 606  ( Expr_From AST root
 607  , Type0_Eq (Type_Root_of_Expr root)
 608  , Type0_Constraint Num (Type_Root_of_Expr root)
 609  , Type0_Lift   Type_Integer (Type_of_Expr root)
 610  , Type0_Unlift Type_Integer (Type_of_Expr root)
 611  , Type0_Lift   Type_Fun     (Type_of_Expr root)
 612  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 613  , Root_of_Expr root ~ root
 614  , IBool (Is_Last_Expr (Expr_Num root) root)
 615  ) => Expr_From AST (Expr_Num root) where
 616         expr_from ex ast =
 617                 let c = (Proxy :: Proxy Num) in
 618                 case ast of
 619                  AST "abs"    asts -> from_ast1 asts (class_op1_from Expr.abs    c) ex ast
 620                  AST "negate" asts -> from_ast1 asts (class_op1_from Expr.negate c) ex ast
 621                  AST "signum" asts -> from_ast1 asts (class_op1_from Expr.signum c) ex ast
 622                  AST "+"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.+) c) (class_op2_from (Expr.+) c) ex ast
 623                  AST "-"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.-) c) (class_op2_from (Expr.-) c) ex ast
 624                  AST "*"      asts -> from_ast012 asts Nothing (Just $ class_op2_from1 (Expr.*) c) (class_op2_from (Expr.*) c) ex ast
 625                  AST "fromInteger" asts -> from_ast1 asts fromInteger_from ex ast
 626                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 627 instance -- Expr_From AST Expr_Integral
 628  ( Expr_From AST root
 629  , Type0_Eq (Type_Root_of_Expr root)
 630  , Type0_Constraint Integral (Type_Root_of_Expr root)
 631  , Type0_Lift Type_Fun     (Type_of_Expr root)
 632  , Type0_Lift Type_Integer (Type_of_Expr root)
 633  , Type0_Lift Type_Tuple2  (Type_of_Expr root)
 634  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 635  , Root_of_Expr root ~ root
 636  , IBool (Is_Last_Expr (Expr_Integral root) root)
 637  ) => Expr_From AST (Expr_Integral root) where
 638         expr_from ex ast =
 639                 let c = (Proxy :: Proxy Integral) in
 640                 case ast of
 641                  AST "quot"    asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.quot c) (class_op2_from Expr.quot c) ex ast
 642                  AST "div"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.div  c) (class_op2_from Expr.div  c) ex ast
 643                  AST "rem"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.rem  c) (class_op2_from Expr.rem  c) ex ast
 644                  AST "mod"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.mod  c) (class_op2_from Expr.mod  c) ex ast
 645                  AST "quotRem" asts -> from_ast012 asts Nothing (Just quotRem_from1) quotRem_from ex ast
 646                  AST "divMod"  asts -> from_ast012 asts Nothing (Just divMod_from1)  divMod_from  ex ast
 647                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 648 instance -- Expr_From AST Expr_Text
 649  ( Expr_From AST root
 650  , Type0_Eq (Type_Root_of_Expr root)
 651  , Type0_Lift   Type_Text (Type_of_Expr root)
 652  , Type0_Unlift Type_Text (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_Text root) root)
 656  ) => Expr_From AST (Expr_Text root) where
 657         expr_from ex ast =
 658                 case ast of
 659                  AST "text" asts ->
 660                         case asts of
 661                          [AST lit []] -> \_ctx k ->
 662                                 k type_text $ Forall_Repr_with_Context $ \_c -> text lit
 663                          _ -> \_ctx _k -> Left $ error_expr ex $
 664                                 Error_Expr_Wrong_number_of_arguments ast 1
 665                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 666 instance -- Expr_From AST Expr_Char
 667  ( Expr_From AST root
 668  , Type0_Eq (Type_Root_of_Expr root)
 669  , Type0_Lift   Type_Char (Type_of_Expr root)
 670  , Type0_Unlift Type_Char (Type_of_Expr root)
 671  , Type0_Lift   Type_Fun  (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_Char root) root)
 675  ) => Expr_From AST (Expr_Char root) where
 676         expr_from ex ast =
 677                 case ast of
 678                  AST "char" asts ->
 679                         case asts of
 680                          [AST lit []] ->
 681                                 case Text.uncons lit of
 682                                  Just (c, "") -> \_ctx k ->
 683                                         k type_char $ Forall_Repr_with_Context $ \_c -> char c
 684                                  _ -> \_ctx _k -> Left $ error_expr ex $
 685                                         Error_Expr_Read (Error_Read lit) ast
 686                          _ -> \_ctx _k -> Left $ error_expr ex $
 687                                 Error_Expr_Wrong_number_of_arguments ast 1
 688                  AST "char_toUpper" asts -> from_ast01 asts (Just $ op1_from0 char_toUpper type_char) (op1_from char_toUpper type_char) ex ast
 689                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 690 instance -- Expr_From AST Expr_Lambda
 691  ( Expr_From AST root
 692  , Type0_Eq (Type_Root_of_Expr root)
 693  , Type0_From AST (Type_Root_of_Expr root)
 694  , Type0_Lift   Type_Fun (Type_of_Expr root)
 695  , Type0_Unlift Type_Fun (Type_of_Expr root)
 696  , Error_Expr_Lift (Error_Expr_Lambda AST)       (Error_of_Expr AST root)
 697  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 698  , Root_of_Expr root ~ root
 699  , IBool (Is_Last_Expr (Expr_Lambda root) root)
 700  ) => Expr_From AST (Expr_Lambda root) where
 701         expr_from ex ast ctx k =
 702                 case ast of
 703                  AST "var" asts ->
 704                         case asts of
 705                          [AST name []] -> var_from name ex ast ctx k
 706                          _ -> Left $ error_expr ex $
 707                                 Error_Expr_Wrong_number_of_arguments ast 1
 708                  AST "$"   asts -> from_ast2 asts app_from ex ast ctx k
 709                  AST "\\"  asts -> go_lam asts
 710                  AST "let" asts -> go_let asts
 711                  _ -> Left $ error_expr_unsupported ex ast
 712                 where
 713                 go_lam asts =
 714                         case asts of
 715                          [AST name [], ast_ty_arg, ast_body] ->
 716                                 lam_from name ast_ty_arg ast_body ex ast ctx k
 717                          _ -> Left $ error_expr ex $
 718                                 Error_Expr_Wrong_number_of_arguments ast 3
 719                 go_let asts =
 720                         case asts of
 721                          [AST name [], ast_var, ast_body] ->
 722                                 let_from name ast_var ast_body ex ast ctx k
 723                          _ -> Left $ error_expr ex $
 724                                 Error_Expr_Wrong_number_of_arguments ast 3
 725 instance -- Expr_From AST Expr_Maybe
 726  ( Expr_From AST root
 727  , Type0_Eq (Type_Root_of_Expr root)
 728  , Type0_From AST (Type_Root_of_Expr root)
 729  , Type0_Lift   Type_Fun   (Type_of_Expr root)
 730  , Type0_Unlift Type_Fun   (Type_of_Expr root)
 731  , Type0_Lift   Type_Maybe (Type_of_Expr root)
 732  , Type0_Unlift Type_Maybe (Type_of_Expr 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_Maybe root) root)
 736  ) => Expr_From AST (Expr_Maybe root) where
 737         expr_from ex ast =
 738                 case ast of
 739                  AST "maybe"   asts -> from_ast3 asts maybe_from   ex ast
 740                  AST "nothing" asts -> from_ast1 asts nothing_from ex ast
 741                  AST "just"    asts -> from_ast1 asts just_from    ex ast
 742                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 743 instance -- Expr_From AST Expr_Eq
 744  ( Expr_From AST root
 745  , Type0_Eq (Type_Root_of_Expr root)
 746  , Type0_Lift Type_Bool (Type_of_Expr root)
 747  , Type0_Lift Type_Fun  (Type_of_Expr root)
 748  , Type0_Constraint Eq (Type_Root_of_Expr root)
 749  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 750  , Root_of_Expr root ~ root
 751  , IBool (Is_Last_Expr (Expr_Eq root) root)
 752  ) => Expr_From AST (Expr_Eq root) where
 753         expr_from ex ast =
 754                 case ast of
 755                  AST "==" asts -> from_ast012 asts Nothing (Just (eq_from1 (Expr.==))) (eq_from (Expr.==)) ex ast
 756                  AST "/=" asts -> from_ast012 asts Nothing (Just (eq_from1 (Expr./=))) (eq_from (Expr./=)) ex ast
 757                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 758 instance -- Expr_From AST Expr_Ord
 759  ( Expr_From AST root
 760  , Type0_Eq (Type_Root_of_Expr root)
 761  , Type0_Lift Type_Bool     (Type_of_Expr root)
 762  , Type0_Lift Type_Fun      (Type_of_Expr root)
 763  , Type0_Lift Type_Ordering (Type_of_Expr root)
 764  , Type0_Constraint Ord (Type_Root_of_Expr root)
 765  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 766  , Root_of_Expr root ~ root
 767  , IBool (Is_Last_Expr (Expr_Ord root) root)
 768  ) => Expr_From AST (Expr_Ord root) where
 769         expr_from ex ast =
 770                 let c = (Proxy :: Proxy Ord) in
 771                 case ast of
 772                  AST "compare" asts -> from_ast012 asts Nothing (Just compare_from1) compare_from ex ast
 773                  AST "<"       asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.<))  (ord_from (Expr.<))  ex ast
 774                  AST "<="      asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.<=)) (ord_from (Expr.<=)) ex ast
 775                  AST ">"       asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.>))  (ord_from (Expr.>))  ex ast
 776                  AST ">="      asts -> from_ast012 asts Nothing (Just $ ord_from1 (Expr.>=)) (ord_from (Expr.>=)) ex ast
 777                  AST "min"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.min c) (class_op2_from Expr.min c) ex ast
 778                  AST "max"     asts -> from_ast012 asts Nothing (Just $ class_op2_from1 Expr.max c) (class_op2_from Expr.max c) ex ast
 779                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 780 instance -- Expr_From AST Expr_List
 781  ( Expr_From AST root
 782  , Type0_Eq (Type_Root_of_Expr root)
 783  , Type0_From AST (Type_Root_of_Expr root)
 784  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 785  , Type0_Unlift Type_Fun  (Type_of_Expr root)
 786  , Type0_Lift   Type_List (Type_of_Expr root)
 787  , Type0_Unlift Type_List (Type_of_Expr root)
 788  , Type0_Lift   Type_Bool (Type_of_Expr root)
 789  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 790  , Root_of_Expr root ~ root
 791  , IBool (Is_Last_Expr (Expr_List root) root)
 792  ) => Expr_From AST (Expr_List root) where
 793         expr_from ex ast =
 794                 case ast of
 795                  AST "[]"          asts -> from_ast1 asts list_empty_from  ex ast
 796                  AST ":"           asts -> from_ast2 asts list_cons_from   ex ast
 797                  AST "list_filter" asts -> from_ast2 asts list_filter_from ex ast
 798                  AST "list"        asts -> \ctx k ->
 799                         case asts of
 800                          ast_ty_a:asts' -> list_from ast_ty_a asts' ex ast ctx k
 801                          _ -> Left $ error_expr ex $
 802                                 Error_Expr_Wrong_number_of_arguments ast 1
 803                  AST "list_zipWith" asts -> from_ast3 asts list_zipWith_from ex ast
 804                  AST "list_reverse" asts -> from_ast1 asts list_reverse_from ex ast
 805                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 806 instance -- Expr_From AST Expr_Map
 807  ( Expr_From AST root
 808  , Type0_Eq (Type_Root_of_Expr root)
 809  , Type0_Lift   Type_Fun    (Type_of_Expr root)
 810  , Type0_Unlift Type_Fun    (Type_of_Expr root)
 811  , Type0_Lift   Type_Bool   (Type_of_Expr root)
 812  , Type0_Unlift Type_Bool   (Type_of_Expr root)
 813  , Type0_Lift   Type_List   (Type_of_Expr root)
 814  , Type0_Unlift Type_List   (Type_of_Expr root)
 815  , Type0_Lift   Type_Map    (Type_of_Expr root)
 816  , Type0_Unlift Type_Map    (Type_of_Expr root)
 817  , Type0_Lift   Type_Maybe  (Type_of_Expr root)
 818  , Type0_Unlift Type_Maybe  (Type_of_Expr root)
 819  , Type0_Lift   Type_Tuple2 (Type_of_Expr root)
 820  , Type0_Unlift Type_Tuple2 (Type_of_Expr root)
 821  , Type0_Constraint Ord (Type_Root_of_Expr root)
 822  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 823  , Root_of_Expr root ~ root
 824  , IBool (Is_Last_Expr (Expr_Map root) root)
 825  ) => Expr_From AST (Expr_Map root) where
 826         expr_from ex ast =
 827                 case ast of
 828                  AST "map_from_list"    asts -> from_ast1 asts map_from_list_from ex ast
 829                  AST "mapWithKey"       asts -> from_ast2 asts mapWithKey_from ex ast
 830                  AST "map_lookup"       asts -> from_ast2 asts map_lookup_from ex ast
 831                  AST "map_keys"         asts -> from_ast1 asts map_keys_from ex ast
 832                  AST "map_member"       asts -> from_ast2 asts map_member_from ex ast
 833                  AST "map_insert"       asts -> from_ast3 asts map_insert_from ex ast
 834                  AST "map_delete"       asts -> from_ast2 asts map_delete_from ex ast
 835                  AST "map_difference"   asts -> from_ast2 asts map_difference_from ex ast
 836                  AST "map_foldrWithKey" asts -> from_ast3 asts map_foldrWithKey_from ex ast
 837                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 838 instance -- Expr_From AST Expr_Functor
 839  ( Expr_From AST root
 840  , Type0_Eq (Type_Root_of_Expr root)
 841  , Type0_Lift   Type_Fun (Type_of_Expr root)
 842  , Type0_Unlift Type_Fun (Type_of_Expr root)
 843  , Type1_Unlift (Type_of_Expr root)
 844  , Type1_Constraint Functor (Type_Root_of_Expr root)
 845  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 846  , Root_of_Expr root ~ root
 847  , IBool (Is_Last_Expr (Expr_Functor root) root)
 848  ) => Expr_From AST (Expr_Functor root) where
 849         expr_from ex ast =
 850                 case ast of
 851                  AST "fmap" asts -> from_ast2 asts fmap_from ex ast
 852                  AST "<$>"  asts -> from_ast2 asts fmap_from ex ast
 853                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 854 instance -- Expr_From AST Expr_MonoFunctor
 855  ( Expr_From AST root
 856  , Type0_Eq (Type_Root_of_Expr root)
 857  , Type0_Lift   Type_Fun (Type_of_Expr root)
 858  , Type0_Unlift Type_Fun (Type_of_Expr root)
 859  , Type1_Unlift (Type_of_Expr root)
 860  , Type0_Constraint MT.MonoFunctor (Type_Root_of_Expr root)
 861  , Type0_Family Type_Family_MonoElement (Type_Root_of_Expr root)
 862  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 863  , Root_of_Expr root ~ root
 864  , IBool (Is_Last_Expr (Expr_MonoFunctor root) root)
 865  ) => Expr_From AST (Expr_MonoFunctor root) where
 866         expr_from ex ast ctx k =
 867                 case ast of
 868                  AST "omap" asts -> from_ast2 asts omap_from ex ast ctx k
 869                  _ -> Left $ error_expr_unsupported ex ast
 870 instance -- Expr_From AST Expr_Applicative
 871  ( Expr_From AST root
 872  , Type0_Eq (Type_Root_of_Expr root)
 873  , Type1_From AST (Type_Root_of_Expr root)
 874  , Type0_Lift   Type_Fun (Type_of_Expr root)
 875  , Type0_Unlift Type_Fun (Type_of_Expr root)
 876  , Type1_Eq (Type_Root_of_Expr root)
 877  , Type1_Unlift (Type_of_Expr root)
 878  , Type1_Constraint Applicative (Type_Root_of_Expr root)
 879  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 880  , Root_of_Expr root ~ root
 881  , IBool (Is_Last_Expr (Expr_Applicative root) root)
 882  ) => Expr_From AST (Expr_Applicative root) where
 883         expr_from ex ast =
 884                 case ast of
 885                  AST "pure" asts -> from_ast2 asts pure_from     ex ast
 886                  AST "<*>"  asts -> from_ast2 asts ltstargt_from ex ast
 887                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 888 instance -- Expr_From AST Expr_Traversable
 889  ( Expr_From AST root
 890  , Type0_Eq (Type_Root_of_Expr root)
 891  , Type0_Lift   Type_Fun (Type_of_Expr root)
 892  , Type0_Unlift Type_Fun (Type_of_Expr root)
 893  , Type1_Eq (Type_Root_of_Expr root)
 894  , Type1_Unlift (Type_of_Expr root)
 895  , Type1_Constraint Applicative (Type_Root_of_Expr root)
 896  , Type1_Constraint Traversable (Type_Root_of_Expr root)
 897  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 898  , Root_of_Expr root ~ root
 899  , IBool (Is_Last_Expr (Expr_Traversable root) root)
 900  ) => Expr_From AST (Expr_Traversable root) where
 901         expr_from ex ast ctx k =
 902                 case ast of
 903                  AST "traverse"  asts -> from_ast2 asts traverse_from ex ast ctx k
 904                  _ -> Left $ error_expr_unsupported ex ast
 905 instance -- Expr_From AST Expr_Foldable
 906  ( Expr_From AST root
 907  , Type0_Constraint Eq       (Type_Root_of_Expr root)
 908  , Type0_Constraint Monoid   (Type_Root_of_Expr root)
 909  , Type0_Constraint Num      (Type_Root_of_Expr root)
 910  , Type0_Constraint Ord      (Type_Root_of_Expr root)
 911  , Type0_Eq                  (Type_Root_of_Expr root)
 912  , Type0_Lift   Type_Bool    (Type_of_Expr root)
 913  , Type0_Lift   Type_Fun     (Type_of_Expr root)
 914  , Type0_Lift   Type_Int     (Type_of_Expr root)
 915  , Type0_Lift   Type_List    (Type_of_Expr root)
 916  , Type0_Unlift Type_Fun     (Type_of_Expr root)
 917  , Type1_Constraint Foldable (Type_Root_of_Expr root)
 918  , Type1_Eq (Type_Root_of_Expr root)
 919  , Type1_Unlift (Type_of_Expr root)
 920  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 921  , Root_of_Expr root ~ root
 922  , IBool (Is_Last_Expr (Expr_Foldable root) root)
 923  ) => Expr_From AST (Expr_Foldable root) where
 924         expr_from ex ast =
 925                 case ast of
 926                  AST "foldMap" asts -> from_ast2 asts foldMap_from ex ast
 927                  AST "foldr"   asts -> from_ast3 asts (foldr_from Expr.foldr) ex ast
 928                  AST "foldr'"  asts -> from_ast3 asts (foldr_from Expr.foldr') ex ast
 929                  AST "foldl"   asts -> from_ast3 asts (foldl_from Expr.foldl) ex ast
 930                  AST "foldl'"  asts -> from_ast3 asts (foldl_from Expr.foldl') ex ast
 931                  AST "null"    asts -> from_ast1 asts null_from ex ast
 932                  AST "length"  asts -> from_ast1 asts length_from ex ast
 933                  AST "minimum" asts -> from_ast1 asts minimum_from ex ast
 934                  AST "maximum" asts -> from_ast1 asts maximum_from ex ast
 935                  AST "elem"    asts -> from_ast2 asts elem_from ex ast
 936                  AST "sum"     asts -> from_ast1 asts sum_from ex ast
 937                  AST "product" asts -> from_ast1 asts product_from ex ast
 938                  AST "toList"  asts -> from_ast1 asts toList_from ex ast
 939                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 940 instance -- Expr_From AST Expr_Monoid
 941  ( Expr_From AST root
 942  , Type0_Eq (Type_Root_of_Expr root)
 943  , Type0_From AST (Type_Root_of_Expr root)
 944  , Type0_Constraint Monoid (Type_Root_of_Expr root)
 945  , Type0_Lift   Type_Int  (Type_of_Expr root)
 946  , Type0_Lift   Type_Bool (Type_of_Expr root)
 947  , Type0_Lift   Type_Fun  (Type_of_Expr root)
 948  , Type0_Unlift Type_Fun  (Type_of_Expr root)
 949  , Type1_Unlift (Type_of_Expr root)
 950  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 951  , Root_of_Expr root ~ root
 952  , IBool (Is_Last_Expr (Expr_Monoid root) root)
 953  ) => Expr_From AST (Expr_Monoid root) where
 954         expr_from ex ast =
 955                 case ast of
 956                  AST "mempty"  asts -> from_ast1 asts mempty_from ex ast
 957                  AST "mappend" asts -> from_ast012 asts Nothing (Just mappend_from1) mappend_from ex ast
 958                  AST "<>"      asts -> from_ast012 asts Nothing (Just mappend_from1) mappend_from ex ast
 959                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 960 instance -- Expr_From AST Expr_Monad
 961  ( Expr_From AST root
 962  , Type0_Eq (Type_Root_of_Expr root)
 963  , Type0_Lift   Type_Fun (Type_of_Expr root)
 964  , Type0_Unlift Type_Fun (Type_of_Expr root)
 965  , Type1_From AST (Type_Root_of_Expr root)
 966  , Type1_Constraint Monad (Type_Root_of_Expr root)
 967  , Type1_Eq (Type_Root_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_Monad root) root)
 972  ) => Expr_From AST (Expr_Monad root) where
 973         expr_from ex ast =
 974                 case ast of
 975                  AST "return" asts -> from_ast2 asts return_from ex ast
 976                  AST ">>="    asts -> from_ast2 asts bind_from   ex ast
 977                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 978 instance -- Expr_From AST Expr_Either
 979  ( Expr_From AST root
 980  , Type0_Eq (Type_Root_of_Expr root)
 981  , Type0_From AST (Type_Root_of_Expr root)
 982  , Type0_Lift   Type_Either (Type_of_Expr root)
 983  , Type0_Unlift Type_Either (Type_of_Expr root)
 984  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 985  , Root_of_Expr root ~ root
 986  , IBool (Is_Last_Expr (Expr_Either root) root)
 987  ) => Expr_From AST (Expr_Either root) where
 988         expr_from ex ast =
 989                 case ast of
 990                  AST "left"  asts -> from_ast2 asts left_from  ex ast
 991                  AST "right" asts -> from_ast2 asts right_from ex ast
 992                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast
 993 instance -- Expr_From AST Expr_Tuple2
 994  ( Expr_From AST root
 995  , Type0_Eq (Type_Root_of_Expr root)
 996  , Type0_Lift   Type_Tuple2 (Type_of_Expr root)
 997  , Type0_Unlift Type_Tuple2 (Type_of_Expr root)
 998  , Error_Expr_Lift (Error_Expr_of_Root AST root) (Error_of_Expr AST root)
 999  , Root_of_Expr root ~ root
1000  , IBool (Is_Last_Expr (Expr_Tuple2 root) root)
1001  ) => Expr_From AST (Expr_Tuple2 root) where
1002         expr_from ex ast =
1003                 case ast of
1004                  AST "(,)" asts -> from_ast2 asts tuple2_from ex ast
1005                  AST "fst" asts -> from_ast1 asts fst_from ex ast
1006                  AST "snd" asts -> from_ast1 asts snd_from ex ast
1007                  _ -> \_ctx _k -> Left $ error_expr_unsupported ex ast