init

diff --git a/Language/LOL/Symantic/Expr/Bool.hs b/Language/LOL/Symantic/Expr/Bool.hs
index c76183bc96191eb898d477b974b45d507ee46549..56648339b3675a02b62c7816f7675372d7f75a5e 100644 (file)
--- a/Language/LOL/Symantic/Expr/Bool.hs
+++ b/Language/LOL/Symantic/Expr/Bool.hs
@@ -66,11 +66,10 @@ instance -- Expr_from AST Expr_Bool
  , Type_Root_Lift Type_Bool (Type_Root_of_Expr root)
  , Error_Type_Lift (Error_Type_Fun AST)
                    (Error_of_Type AST (Type_Root_of_Expr root))
- , Error_Expr_Lift (Error_Expr_Lambda (Error_of_Type AST (Type_Root_of_Expr root))
-                                      (                   Type_Root_of_Expr root)
-                                      AST)
+ , Error_Expr_Lift (Error_Expr (Error_of_Type AST (Type_Root_of_Expr root))
+                               (                   Type_Root_of_Expr root)
+                               AST)
                    (Error_of_Expr AST root)
- , Error_Expr_Lift (Error_Expr AST) (Error_of_Expr AST root)
  
  , Type_Unlift Type_Bool (Type_of_Expr root)
  
@@ -84,21 +83,20 @@ instance -- Expr_from AST Expr_Bool
                        case asts of
                         [AST ast_bool []] ->
                                case read_safe ast_bool of
-                                Left err -> Left $ error_expr_lift $ Error_Expr_Read err ast
+                                Left err -> Left $ error_expr $ Error_Expr_Read err ast
                                 Right (i::Bool) ->
                                        k type_bool $ Forall_Repr_with_Context $
                                                const $ bool i
-                        _ -> Left $ error_lambda_lift $
+                        _ -> Left $ error_expr $
                                Error_Expr_Fun_Wrong_number_of_arguments 3 ast
                 AST "not" asts -> unary_from  asts not
                 AST "and" asts -> binary_from asts and
                 AST "or"  asts -> binary_from asts or
                 AST "xor" asts -> binary_from asts xor
-                -- _ -> Left $ error_expr_lift $ Error_Expr_Unsupported_here ast
                 _ -> Left $
                        case hbool :: HBool (Is_Last_Expr (Expr_Bool root) root) of
-                        HTrue  -> error_expr_lift $ Error_Expr_Unsupported ast
-                        HFalse -> error_expr_lift $ Error_Expr_Unsupported_here ast
+                        HTrue  -> error_expr $ Error_Expr_Unsupported ast
+                        HFalse -> error_expr $ Error_Expr_Unsupported_here ast
                where
                unary_from asts
                 (op::forall repr. Sym_Bool repr
@@ -110,11 +108,11 @@ instance -- Expr_from AST Expr_Bool
                                        case type_unlift $ unType_Root ty_x of
                                         Just (Type_Bool::Type_Bool (Type_Root_of_Expr root) h_x) ->
                                                k ty_x $ Forall_Repr_with_Context (op . x)
-                                        _ -> Left $ error_lambda_lift $
+                                        _ -> Left $ error_expr $
                                                Error_Expr_Fun_Argument_mismatch
                                                 (Exists_Type type_bool)
                                                 (Exists_Type ty_x) ast
-                        _ -> Left $ error_lambda_lift $
+                        _ -> Left $ error_expr $
                                Error_Expr_Fun_Wrong_number_of_arguments 1 ast
                binary_from asts
                 (op::forall repr. Sym_Bool repr
@@ -131,20 +129,20 @@ instance -- Expr_from AST Expr_Bool
                                                 Just (Type_Bool::Type_Bool (Type_Root_of_Expr root) h_y) ->
                                                        k ty_x $ Forall_Repr_with_Context $
                                                         \c -> x c `op` y c
-                                                Nothing -> Left $ error_lambda_lift $
+                                                Nothing -> Left $ error_expr $
                                                        Error_Expr_Fun_Argument_mismatch
                                                         (Exists_Type type_bool)
                                                         (Exists_Type ty_y) ast
-                                        Nothing -> Left $ error_lambda_lift $
+                                        Nothing -> Left $ error_expr $
                                                Error_Expr_Fun_Argument_mismatch
                                                 (Exists_Type type_bool)
                                                 (Exists_Type ty_x) ast
-                        _ -> Left $ error_lambda_lift $
+                        _ -> Left $ error_expr $
                                Error_Expr_Fun_Wrong_number_of_arguments 2 ast
-               error_lambda_lift
-                :: Error_Expr_Lambda (Error_of_Type AST (Type_Root_of_Expr root)) (Type_Root_of_Expr root) AST
+               error_expr
+                :: Error_Expr (Error_of_Type AST (Type_Root_of_Expr root)) (Type_Root_of_Expr root) AST
                 -> Error_of_Expr AST root
-               error_lambda_lift = error_expr_lift
+               error_expr = error_expr_lift
 
 -- ** Type 'Expr_Lambda_Bool'
 -- | Convenient alias.

diff --git a/Language/LOL/Symantic/Expr/Bool/Test.hs b/Language/LOL/Symantic/Expr/Bool/Test.hs
index 5978faaea0c3a950f05327748724b3fb47c09c97..41fd3fb077d4eadcd1eb41c29ecf877b1b44cd49 100644 (file)
--- a/Language/LOL/Symantic/Expr/Bool/Test.hs
+++ b/Language/LOL/Symantic/Expr/Bool/Test.hs
@@ -66,7 +66,7 @@ e8 = x `xor` (y `xor` bool True)
         Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
                case ty `type_eq` ty_expected of
                 Nothing -> return $ Left $
-                       error_lambda_lift $ Error_Expr_Type
+                       error_expr $ Error_Expr_Type
                         (error_type_lift $ Error_Type_Unsupported_here raw) raw
                 Just Refl -> do
                        h <- host_from_expr r
@@ -78,13 +78,13 @@ e8 = x `xor` (y `xor` bool True)
                                 -- , (string_from_expr :: Repr_String IO h -> String) r
                                 )
        where
-               error_lambda_lift
+               error_expr
                 :: (root ~ Expr_Lambda_Bool IO)
-                => Error_Expr_Lambda (Error_of_Type raw (Type_Root_of_Expr root))
-                                     (Type_Root_of_Expr root)
-                                     raw
+                => Error_Expr (Error_of_Type raw (Type_Root_of_Expr root))
+                              (Type_Root_of_Expr root)
+                              raw
                 -> Error_of_Expr raw root
-               error_lambda_lift = error_expr_lift
+               error_expr = error_expr_lift
 
 tests :: TestTree
 tests = testGroup "Bool" $

diff --git a/Language/LOL/Symantic/Expr/Common.hs b/Language/LOL/Symantic/Expr/Common.hs
index 2f6f019da98f80859c4007951ca328411a7a7ec0..edeebcdfcdf58d719b44c1fcef3fb08d0257484d 100644 (file)
--- a/Language/LOL/Symantic/Expr/Common.hs
+++ b/Language/LOL/Symantic/Expr/Common.hs
@@ -125,8 +125,10 @@ type instance Type_of_Expr (Expr_Root ex)
  =            Type_of_Expr (ex (Expr_Root ex))
  -- NOTE: require UndecidableInstances.
 type instance Error_of_Expr ast (Expr_Root ex)
- =            Error_Expr_Alt (Error_Expr ast)
-                              (Error_of_Expr ast (ex (Expr_Root ex)))
+ =            Error_Expr_Alt (Error_Expr (Error_of_Type ast (Type_Root_of_Expr (ex (Expr_Root ex))))
+                                         (Type_Root_of_Expr (ex (Expr_Root ex)))
+                                         ast)
+                             (Error_of_Expr ast (ex (Expr_Root ex)))
  -- NOTE: require UndecidableInstances.
 type instance Sym_of_Expr (Expr_Root ex) repr
  =            Sym_of_Expr (ex (Expr_Root ex)) repr
@@ -152,7 +154,7 @@ instance
 -}
 
 -- * Type 'Expr_Alt'
--- | Combine two expressions into one.
+-- | Expression making an alternative between two expressions.
 data Expr_Alt curr next (root:: *)
  =   Expr_Alt_Curr (curr root)
  |   Expr_Alt_Next (next root)
@@ -172,7 +174,9 @@ instance -- Expr_from
  , Expr_from ast (next root)
  , Root_of_Expr (curr root) ~ root
  , Root_of_Expr (next root) ~ root
- , Error_Expr_Unlift (Error_Expr ast) (Error_of_Expr ast root)
+ , Error_Expr_Unlift (Error_Expr (Error_of_Type ast (Type_Root_of_Expr root))
+                                 (Type_Root_of_Expr root) ast)
+                     (Error_of_Expr ast root)
  ) => Expr_from ast (Expr_Alt curr next root) where
        expr_from _px_ex ctx ast k =
                case expr_from (Proxy::Proxy (curr root)) ctx ast $
@@ -181,7 +185,9 @@ instance -- Expr_from
                 Right ret -> ret
                 Left err ->
                        case error_expr_unlift err of
-                        Just (Error_Expr_Unsupported_here (_::ast)) ->
+                        Just (Error_Expr_Unsupported_here _
+                         :: Error_Expr (Error_of_Type ast (Type_Root_of_Expr root))
+                                       (Type_Root_of_Expr root) ast) ->
                                expr_from (Proxy::Proxy (next root)) ctx ast $
                                 \ty (Forall_Repr_with_Context repr) ->
                                        k ty (Forall_Repr_with_Context repr)
@@ -258,8 +264,24 @@ instance
        expr_unliftN _ (Expr_Alt_Curr _) = Nothing
 -}
 
+-- * Type family 'Is_Last_Expr'
+-- | Return whether a given expression is the last one in a given expression stack.
+--
+-- NOTE: each expression parser uses this type family
+-- when it encounters unsupported syntax:
+-- to know if it is the last expression parser component that will be tried
+-- (and thus return 'Error_Expr_Unsupported')
+-- or if some other expression parser component shall be tried
+-- (and thus return 'Error_Expr_Unsupported_here',
+-- which is then handled accordingly by the 'Expr_from' instance of 'Expr_Alt').
+type family Is_Last_Expr (ex:: *) (exs:: *) :: Bool where
+       Is_Last_Expr ex ex                               = 'True
+       Is_Last_Expr ex        (Expr_Root exs)           = Is_Last_Expr ex (exs (Expr_Root exs))
+       Is_Last_Expr (ex root) (Expr_Alt ex   next root) = 'False
+       Is_Last_Expr other     (Expr_Alt curr next root) = Is_Last_Expr other (next root)
+
 -- * Type 'Error_Expr_Alt'
--- | Combine two expression errors into one.
+-- | Error expression making an alternative between two error expressions.
 data Error_Expr_Alt curr next
  =   Error_Expr_Alt_Curr curr
  |   Error_Expr_Alt_Next next
@@ -278,13 +300,6 @@ error_expr_lift
  err -> errs
 error_expr_lift = error_expr_liftN (Proxy::Proxy (Peano_of_Error_Expr err errs))
 
--- * Type family 'Is_Last_Expr'
-type family Is_Last_Expr (ex:: *) (exs:: *) :: Bool where
-       Is_Last_Expr ex ex                                = 'True
-       Is_Last_Expr ex        (Expr_Root exs)            = Is_Last_Expr ex (exs (Expr_Root exs))
-       Is_Last_Expr (ex root) (Expr_Alt ex   next root) = 'False
-       Is_Last_Expr other     (Expr_Alt curr next root) = Is_Last_Expr other (next root)
-
 -- *** Type family 'Peano_of_Error_Expr'
 -- | Return a 'Peano' number derived from the location
 -- of a given error expression within a given error expression stack,
@@ -339,8 +354,11 @@ instance
 
 -- ** Type 'Error_Expr_Read'
 -- | Common expression errors.
-data Error_Expr ast
- =   Error_Expr_Read Error_Read ast
+data Error_Expr err_ty ty ast
+ =   Error_Expr_Fun_Wrong_number_of_arguments Int ast
+ |   Error_Expr_Fun_Argument_mismatch (Exists_Type ty) (Exists_Type ty) ast
+ |   Error_Expr_Read Error_Read ast
+ |   Error_Expr_Type err_ty ast
  |   Error_Expr_Unsupported ast
  -- ^ Given syntax is supported by none
  -- of the expression parser components

diff --git a/Language/LOL/Symantic/Expr/Int.hs b/Language/LOL/Symantic/Expr/Int.hs
index e8c3b67242fb15ae3fe27c09b999e54538729dfc..2bc239b9e26295178864a2bcc3bd4b9462c4e238 100644 (file)
--- a/Language/LOL/Symantic/Expr/Int.hs
+++ b/Language/LOL/Symantic/Expr/Int.hs
@@ -58,11 +58,10 @@ instance -- Expr_from AST Expr_Int
  , Type_Root_Lift Type_Int (Type_Root_of_Expr root)
  , Error_Type_Lift (Error_Type_Fun AST)
                    (Error_of_Type AST (Type_Root_of_Expr root))
- , Error_Expr_Lift (Error_Expr_Lambda (Error_of_Type AST (Type_Root_of_Expr root))
-                                      (                   Type_Root_of_Expr root)
-                                      AST)
+ , Error_Expr_Lift (Error_Expr (Error_of_Type AST (Type_Root_of_Expr root))
+                               (                   Type_Root_of_Expr root)
+                               AST)
                    (Error_of_Expr AST root)
- , Error_Expr_Lift (Error_Expr AST) (Error_of_Expr AST root)
  
  , Type_Unlift Type_Int (Type_of_Expr root)
  
@@ -77,19 +76,18 @@ instance -- Expr_from AST Expr_Int
                        case asts of
                         [AST ast_int []] ->
                                case read_safe ast_int of
-                                Left err -> Left $ error_expr_lift $ Error_Expr_Read err ast
+                                Left err -> Left $ error_expr $ Error_Expr_Read err ast
                                 Right (i::Int) ->
                                        k type_int $ Forall_Repr_with_Context $
                                                const $ int i
-                        _ -> Left $ error_lambda_lift $
+                        _ -> Left $ error_expr $
                                Error_Expr_Fun_Wrong_number_of_arguments 3 ast
                 AST "neg" asts -> unary_from  asts neg
                 AST "add" asts -> binary_from asts add
-                -- _ -> Left $ error_expr_lift $ Error_Expr_Unsupported_here ast
                 _ -> Left $
                        case hbool :: HBool (Is_Last_Expr (Expr_Int root) root) of
-                        HTrue  -> error_expr_lift $ Error_Expr_Unsupported ast
-                        HFalse -> error_expr_lift $ Error_Expr_Unsupported_here ast
+                        HTrue  -> error_expr $ Error_Expr_Unsupported ast
+                        HFalse -> error_expr $ Error_Expr_Unsupported_here ast
                where
                unary_from asts
                 (op::forall repr. Sym_Int repr
@@ -101,11 +99,11 @@ instance -- Expr_from AST Expr_Int
                                        case type_unlift $ unType_Root ty_x of
                                         Just (Type_Int::Type_Int (Type_Root_of_Expr root) h_x) ->
                                                k ty_x $ Forall_Repr_with_Context (op . x)
-                                        _ -> Left $ error_lambda_lift $
+                                        _ -> Left $ error_expr $
                                                Error_Expr_Fun_Argument_mismatch
                                                 (Exists_Type type_int)
                                                 (Exists_Type ty_x) ast
-                        _ -> Left $ error_lambda_lift $
+                        _ -> Left $ error_expr $
                                Error_Expr_Fun_Wrong_number_of_arguments 1 ast
                binary_from asts
                 (op::forall repr. Sym_Int repr
@@ -122,20 +120,20 @@ instance -- Expr_from AST Expr_Int
                                                 Just (Type_Int::Type_Int (Type_Root_of_Expr root) h_y) ->
                                                        k ty_x $ Forall_Repr_with_Context $
                                                         \c -> x c `op` y c
-                                                Nothing -> Left $ error_lambda_lift $
+                                                Nothing -> Left $ error_expr $
                                                        Error_Expr_Fun_Argument_mismatch
                                                         (Exists_Type type_int)
                                                         (Exists_Type ty_y) ast
-                                        Nothing -> Left $ error_lambda_lift $
+                                        Nothing -> Left $ error_expr $
                                                Error_Expr_Fun_Argument_mismatch
                                                 (Exists_Type type_int)
                                                 (Exists_Type ty_x) ast
-                        _ -> Left $ error_lambda_lift $
+                        _ -> Left $ error_expr $
                                Error_Expr_Fun_Wrong_number_of_arguments 2 ast
-               error_lambda_lift
-                :: Error_Expr_Lambda (Error_of_Type AST (Type_Root_of_Expr root)) (Type_Root_of_Expr root) AST
+               error_expr
+                :: Error_Expr (Error_of_Type AST (Type_Root_of_Expr root)) (Type_Root_of_Expr root) AST
                 -> Error_of_Expr AST root
-               error_lambda_lift = error_expr_lift
+               error_expr = error_expr_lift
 
 -- ** Type 'Expr_Lambda_Int'
 -- | Convenient alias.

diff --git a/Language/LOL/Symantic/Expr/Int/Test.hs b/Language/LOL/Symantic/Expr/Int/Test.hs
index 2f75b707d9dbaeb9ef6b11e920637cce70e93297..312c4b23a4542293943acdc200e6cf66b734176d 100644 (file)
--- a/Language/LOL/Symantic/Expr/Int/Test.hs
+++ b/Language/LOL/Symantic/Expr/Int/Test.hs
@@ -59,7 +59,7 @@ e8 = x `add` (y `add` int 1)
         Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
                case ty `type_eq` ty_expected of
                 Nothing -> return $ Left $
-                       error_lambda_lift $ Error_Expr_Type
+                       error_expr $ Error_Expr_Type
                         (error_type_lift $ Error_Type_Unsupported raw) raw
                 Just Refl -> do
                        h <- host_from_expr r
@@ -71,13 +71,13 @@ e8 = x `add` (y `add` int 1)
                                 -- , (string_from_expr :: Repr_String IO h -> String) r
                                 )
        where
-               error_lambda_lift
+               error_expr
                 :: (root ~ Expr_Lambda_Int IO)
-                => Error_Expr_Lambda (Error_of_Type raw (Type_Root_of_Expr root))
-                                     (Type_Root_of_Expr root)
-                                     raw
+                => Error_Expr (Error_of_Type raw (Type_Root_of_Expr root))
+                              (Type_Root_of_Expr root)
+                              raw
                 -> Error_of_Expr raw root
-               error_lambda_lift = error_expr_lift
+               error_expr = error_expr_lift
 
 tests :: TestTree
 tests = testGroup "Int" $

diff --git a/Language/LOL/Symantic/Expr/Lambda.hs b/Language/LOL/Symantic/Expr/Lambda.hs
index 151ad4056cc45e4620bf6f929ae918e3c406d039..be985eda76759400f6e399fb33878b277438aab9 100644 (file)
--- a/Language/LOL/Symantic/Expr/Lambda.hs
+++ b/Language/LOL/Symantic/Expr/Lambda.hs
@@ -107,9 +107,7 @@ type instance Root_of_Expr (Expr_Lambda lam root) = root
 type instance Type_of_Expr (Expr_Lambda lam root) = Type_Fun lam
 type instance Sym_of_Expr (Expr_Lambda lam root) repr = Sym_Lambda lam repr
 type instance Error_of_Expr ast (Expr_Lambda lam root)
- = Error_Expr_Lambda (Error_of_Type ast (Type_Root_of_Expr root))
-                     (Type_Root_of_Expr root)
-                     ast
+ = Error_Expr_Lambda ast
  -- NOTE: require UndecidableInstances.
 
 instance -- Expr_from AST Expr_Lambda
@@ -121,14 +119,18 @@ instance -- Expr_from AST Expr_Lambda
  , Error_Type_Lift (Error_Type_Fun AST)
                    (Error_of_Type AST (Type_Root_of_Expr root))
    -- NOTE: require UndecidableInstances.
- , Error_Expr_Lift (Error_Expr_Lambda (Error_of_Type AST (Type_Root_of_Expr root))
-                                      (                   Type_Root_of_Expr root)
-                                      AST)
+ , Error_Expr_Lift (Error_Expr_Lambda AST)
                    (Error_of_Expr AST root)
    -- NOTE: require UndecidableInstances.
- , Error_Expr_Lift (Error_Expr AST) (Error_of_Expr AST root)
+ , Error_Expr_Lift (Error_Expr (Error_of_Type AST (Type_Root_of_Expr root))
+                               (                   Type_Root_of_Expr root)
+                               AST)
+                   (Error_of_Expr AST root)
    -- NOTE: require UndecidableInstances.
- , Error_Expr_Unlift (Error_Expr AST) (Error_of_Expr AST root)
+ , Error_Expr_Unlift (Error_Expr (Error_of_Type AST (Type_Root_of_Expr root))
+                                 (                   Type_Root_of_Expr root)
+                                 AST)
+                   (Error_of_Expr AST root)
    -- NOTE: require UndecidableInstances.
  
  , Type_Unlift (Type_Fun lam) (Type_of_Expr root)
@@ -155,7 +157,7 @@ instance -- Expr_from AST Expr_Lambda
                                 -> Either (Error_of_Expr AST root) ret
                                go c k' =
                                        case c of
-                                        Context_Empty -> Left $ error_lambda_lift $
+                                        Context_Empty -> Left $ error_expr_lift $
                                                Error_Expr_Lambda_Var_unbound name ast
                                         Var n ty `Context_Alt_Next` _ | n == name ->
                                                k' ty $ Forall_Repr_with_Context $
@@ -164,7 +166,7 @@ instance -- Expr_from AST Expr_Lambda
                                                go ctx' $ \ty (Forall_Repr_with_Context repr) ->
                                                        k' ty $ Forall_Repr_with_Context $
                                                         \(_ `Context_Alt_Next` c') -> repr c'
-                        _ -> Left $ error_lambda_lift $
+                        _ -> Left $ error_expr $
                                Error_Expr_Fun_Wrong_number_of_arguments 1 ast
                 AST "app" asts ->
                        case asts of
@@ -181,13 +183,13 @@ instance -- Expr_from AST Expr_Lambda
                                                 Just Refl ->
                                                        k ty_res $ Forall_Repr_with_Context $
                                                         \c -> lam c `app` arg_actual c
-                                                Nothing -> Left $ error_lambda_lift $
+                                                Nothing -> Left $ error_expr $
                                                        Error_Expr_Fun_Argument_mismatch
                                                         (Exists_Type ty_arg_expected)
                                                         (Exists_Type ty_arg_actual) ast
-                                        Nothing -> Left $ error_lambda_lift $
+                                        Nothing -> Left $ error_expr_lift $
                                                Error_Expr_Lambda_Not_a_lambda ast
-                        _ -> Left $ error_lambda_lift $
+                        _ -> Left $ error_expr $
                                Error_Expr_Type (error_type_lift $
                                        Error_Type_Fun_Wrong_number_of_arguments 2 ast) ast
                 AST "inline" asts -> lambda_from asts inline
@@ -198,8 +200,8 @@ instance -- Expr_from AST Expr_Lambda
                 AST "let_lazy"   asts -> let_from asts let_lazy
                 _ -> Left $
                        case hbool :: HBool (Is_Last_Expr (Expr_Lambda lam root) root) of
-                        HTrue  -> error_expr_lift $ Error_Expr_Unsupported ast
-                        HFalse -> error_expr_lift $ Error_Expr_Unsupported_here ast
+                        HTrue  -> error_expr $ Error_Expr_Unsupported ast
+                        HFalse -> error_expr $ Error_Expr_Unsupported_here ast
                where
                lambda_from asts
                 (lam::forall repr arg res. Sym_Lambda lam repr
@@ -210,7 +212,7 @@ instance -- Expr_from AST Expr_Lambda
                                 (Proxy::Proxy (Type_Root_of_Expr root))
                                 ast_ty_arg
                                 (Right . Exists_Type) of
-                                Left err -> Left $ error_lambda_lift $ Error_Expr_Type err ast
+                                Left err -> Left $ error_expr $ Error_Expr_Type err ast
                                 Right (Exists_Type (ty_arg::Type_Root_of_Expr root h_arg)) ->
                                        expr_from (Proxy::Proxy root)
                                         (Var name ty_arg `Context_Alt_Next` ctx) ast_body $
@@ -221,7 +223,7 @@ instance -- Expr_from AST Expr_Lambda
                                                Forall_Repr_with_Context $
                                                 \c -> lam $
                                                         \arg -> res (arg `Context_Alt_Next` c)
-                        _ -> Left $ error_lambda_lift $
+                        _ -> Left $ error_expr $
                                Error_Expr_Fun_Wrong_number_of_arguments 3 ast
                let_from asts
                 (let_::forall repr var res. Sym_Lambda lam repr
@@ -236,18 +238,15 @@ instance -- Expr_from AST Expr_Lambda
                                                k ty_res $ Forall_Repr_with_Context $
                                                 \c -> let_ (var c) $
                                                         \arg -> res (arg `Context_Alt_Next` c)
-                        _ -> Left $ error_lambda_lift $
+                        _ -> Left $ error_expr $
                                Error_Expr_Fun_Wrong_number_of_arguments 3 ast
-               error_lambda_lift
-                :: Error_Expr_Lambda (Error_of_Type AST (Type_Root_of_Expr root)) (Type_Root_of_Expr root) AST
+               error_expr
+                :: Error_Expr (Error_of_Type AST (Type_Root_of_Expr root)) (Type_Root_of_Expr root) AST
                 -> Error_of_Expr AST root
-               error_lambda_lift = error_expr_lift
+               error_expr = error_expr_lift
 
 -- * Type 'Error_Expr_Lambda'
-data Error_Expr_Lambda err_ty ty ast
+data Error_Expr_Lambda ast
  =   Error_Expr_Lambda_Not_a_lambda ast
  |   Error_Expr_Lambda_Var_unbound Var_Name ast
- |   Error_Expr_Fun_Wrong_number_of_arguments Int ast
- |   Error_Expr_Fun_Argument_mismatch (Exists_Type ty) (Exists_Type ty) ast
- |   Error_Expr_Type err_ty ast
  deriving (Eq, Show)

diff --git a/lol-symantic.cabal b/lol-symantic.cabal
index 7c8ca162b82d5019e5ce59a1c3ff64ec664a381d..62a87a729a6fd96740b04461ad6e44230f085fd2 100644 (file)
--- a/lol-symantic.cabal
+++ b/lol-symantic.cabal
@@ -48,7 +48,7 @@ name: lol-symantic
 stability: experimental
 synopsis: Demo of Typed Tagless-Final Higher-Order Extensible DSL
 tested-with: GHC==7.10.3
-version: 1.20160930
+version: 1.20161002
 
 Source-Repository head
  location: git://git.autogeree.net/lol