{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Strict #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE ViewPatterns #-} module Backend.Sequent where import Control.Monad.Except import Control.Parallel import Environment import Core.Primitives as Primitives import Backend.Utils import Core.Types import Core.Utils import Wrap import Backend.Toplevel import Backend.Core import Backend.Sys {- Copyright (c) 2015, Mark Tarver All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of Mark Tarver may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} kl_shen_datatype_error :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_datatype_error (!kl_V2440) = do !kl_if_0 <- let pat_cond_1 kl_V2440 kl_V2440h kl_V2440t = do !kl_if_2 <- let pat_cond_3 kl_V2440t kl_V2440th kl_V2440tt = do let !appl_4 = Atom Nil !kl_if_5 <- appl_4 `pseq` (kl_V2440tt `pseq` eq appl_4 kl_V2440tt) case kl_if_5 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_6 = do do return (Atom (B False)) in case kl_V2440t of !(kl_V2440t@(Cons (!kl_V2440th) (!kl_V2440tt))) -> pat_cond_3 kl_V2440t kl_V2440th kl_V2440tt _ -> pat_cond_6 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_7 = do do return (Atom (B False)) in case kl_V2440 of !(kl_V2440@(Cons (!kl_V2440h) (!kl_V2440t))) -> pat_cond_1 kl_V2440 kl_V2440h kl_V2440t _ -> pat_cond_7 case kl_if_0 of Atom (B (True)) -> do !appl_8 <- kl_V2440 `pseq` hd kl_V2440 let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.next-50") !appl_10 <- appl_8 `pseq` applyWrapper aw_9 [Core.Types.Atom (Core.Types.N (Core.Types.KI 50)), appl_8] let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") !appl_12 <- appl_10 `pseq` applyWrapper aw_11 [appl_10, Core.Types.Atom (Core.Types.Str "\n"), Core.Types.Atom (Core.Types.UnboundSym "shen.a")] !appl_13 <- appl_12 `pseq` cn (Core.Types.Atom (Core.Types.Str "datatype syntax error here:\n\n ")) appl_12 appl_13 `pseq` simpleError appl_13 Atom (B (False)) -> do do let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_14 [ApplC (wrapNamed "shen.datatype-error" kl_shen_datatype_error)] _ -> throwError "if: expected boolean" kl_shen_LBdatatype_rulesRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBdatatype_rulesRB (!kl_V2442) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) case kl_if_3 of Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !appl_7 <- appl_6 `pseq` (kl_Parse_LBeRB `pseq` eq appl_6 kl_Parse_LBeRB) !kl_if_8 <- appl_7 `pseq` kl_not appl_7 case kl_if_8 of Atom (B (True)) -> do !appl_9 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB let !appl_10 = Atom Nil let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_9 `pseq` (appl_10 `pseq` applyWrapper aw_11 [appl_9, appl_10]) Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_12 [] _ -> throwError "if: expected boolean"))) let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "") !appl_14 <- kl_V2442 `pseq` applyWrapper aw_13 [kl_V2442] appl_14 `pseq` applyWrapper appl_4 [appl_14] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdatatype_ruleRB) -> do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_17 <- applyWrapper aw_16 [] !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBdatatype_ruleRB `pseq` eq appl_17 kl_Parse_shen_LBdatatype_ruleRB) !kl_if_19 <- appl_18 `pseq` kl_not appl_18 case kl_if_19 of Atom (B (True)) -> do let !appl_20 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdatatype_rulesRB) -> do let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_22 <- applyWrapper aw_21 [] !appl_23 <- appl_22 `pseq` (kl_Parse_shen_LBdatatype_rulesRB `pseq` eq appl_22 kl_Parse_shen_LBdatatype_rulesRB) !kl_if_24 <- appl_23 `pseq` kl_not appl_23 case kl_if_24 of Atom (B (True)) -> do !appl_25 <- kl_Parse_shen_LBdatatype_rulesRB `pseq` hd kl_Parse_shen_LBdatatype_rulesRB let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_27 <- kl_Parse_shen_LBdatatype_ruleRB `pseq` applyWrapper aw_26 [kl_Parse_shen_LBdatatype_ruleRB] let !aw_28 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_29 <- kl_Parse_shen_LBdatatype_rulesRB `pseq` applyWrapper aw_28 [kl_Parse_shen_LBdatatype_rulesRB] !appl_30 <- appl_27 `pseq` (appl_29 `pseq` klCons appl_27 appl_29) let !aw_31 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_25 `pseq` (appl_30 `pseq` applyWrapper aw_31 [appl_25, appl_30]) Atom (B (False)) -> do do let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_32 [] _ -> throwError "if: expected boolean"))) !appl_33 <- kl_Parse_shen_LBdatatype_ruleRB `pseq` kl_shen_LBdatatype_rulesRB kl_Parse_shen_LBdatatype_ruleRB appl_33 `pseq` applyWrapper appl_20 [appl_33] Atom (B (False)) -> do do let !aw_34 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_34 [] _ -> throwError "if: expected boolean"))) !appl_35 <- kl_V2442 `pseq` kl_shen_LBdatatype_ruleRB kl_V2442 !appl_36 <- appl_35 `pseq` applyWrapper appl_15 [appl_35] appl_36 `pseq` applyWrapper appl_0 [appl_36] kl_shen_LBdatatype_ruleRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBdatatype_ruleRB (!kl_V2444) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) case kl_if_3 of Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBside_conditionsRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !appl_7 <- appl_6 `pseq` (kl_Parse_shen_LBside_conditionsRB `pseq` eq appl_6 kl_Parse_shen_LBside_conditionsRB) !kl_if_8 <- appl_7 `pseq` kl_not appl_7 case kl_if_8 of Atom (B (True)) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremisesRB) -> do let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_11 <- applyWrapper aw_10 [] !appl_12 <- appl_11 `pseq` (kl_Parse_shen_LBpremisesRB `pseq` eq appl_11 kl_Parse_shen_LBpremisesRB) !kl_if_13 <- appl_12 `pseq` kl_not appl_12 case kl_if_13 of Atom (B (True)) -> do let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdoubleunderlineRB) -> do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_16 <- applyWrapper aw_15 [] !appl_17 <- appl_16 `pseq` (kl_Parse_shen_LBdoubleunderlineRB `pseq` eq appl_16 kl_Parse_shen_LBdoubleunderlineRB) !kl_if_18 <- appl_17 `pseq` kl_not appl_17 case kl_if_18 of Atom (B (True)) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBconclusionRB) -> do let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_21 <- applyWrapper aw_20 [] !appl_22 <- appl_21 `pseq` (kl_Parse_shen_LBconclusionRB `pseq` eq appl_21 kl_Parse_shen_LBconclusionRB) !kl_if_23 <- appl_22 `pseq` kl_not appl_22 case kl_if_23 of Atom (B (True)) -> do !appl_24 <- kl_Parse_shen_LBconclusionRB `pseq` hd kl_Parse_shen_LBconclusionRB let !aw_25 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_26 <- kl_Parse_shen_LBside_conditionsRB `pseq` applyWrapper aw_25 [kl_Parse_shen_LBside_conditionsRB] let !aw_27 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_28 <- kl_Parse_shen_LBpremisesRB `pseq` applyWrapper aw_27 [kl_Parse_shen_LBpremisesRB] let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_30 <- kl_Parse_shen_LBconclusionRB `pseq` applyWrapper aw_29 [kl_Parse_shen_LBconclusionRB] let !appl_31 = Atom Nil !appl_32 <- appl_30 `pseq` (appl_31 `pseq` klCons appl_30 appl_31) !appl_33 <- appl_28 `pseq` (appl_32 `pseq` klCons appl_28 appl_32) !appl_34 <- appl_26 `pseq` (appl_33 `pseq` klCons appl_26 appl_33) !appl_35 <- appl_34 `pseq` kl_shen_sequent (Core.Types.Atom (Core.Types.UnboundSym "shen.double")) appl_34 let !aw_36 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_24 `pseq` (appl_35 `pseq` applyWrapper aw_36 [appl_24, appl_35]) Atom (B (False)) -> do do let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_37 [] _ -> throwError "if: expected boolean"))) !appl_38 <- kl_Parse_shen_LBdoubleunderlineRB `pseq` kl_shen_LBconclusionRB kl_Parse_shen_LBdoubleunderlineRB appl_38 `pseq` applyWrapper appl_19 [appl_38] Atom (B (False)) -> do do let !aw_39 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_39 [] _ -> throwError "if: expected boolean"))) !appl_40 <- kl_Parse_shen_LBpremisesRB `pseq` kl_shen_LBdoubleunderlineRB kl_Parse_shen_LBpremisesRB appl_40 `pseq` applyWrapper appl_14 [appl_40] Atom (B (False)) -> do do let !aw_41 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_41 [] _ -> throwError "if: expected boolean"))) !appl_42 <- kl_Parse_shen_LBside_conditionsRB `pseq` kl_shen_LBpremisesRB kl_Parse_shen_LBside_conditionsRB appl_42 `pseq` applyWrapper appl_9 [appl_42] Atom (B (False)) -> do do let !aw_43 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_43 [] _ -> throwError "if: expected boolean"))) !appl_44 <- kl_V2444 `pseq` kl_shen_LBside_conditionsRB kl_V2444 appl_44 `pseq` applyWrapper appl_4 [appl_44] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_45 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBside_conditionsRB) -> do let !aw_46 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_47 <- applyWrapper aw_46 [] !appl_48 <- appl_47 `pseq` (kl_Parse_shen_LBside_conditionsRB `pseq` eq appl_47 kl_Parse_shen_LBside_conditionsRB) !kl_if_49 <- appl_48 `pseq` kl_not appl_48 case kl_if_49 of Atom (B (True)) -> do let !appl_50 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremisesRB) -> do let !aw_51 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_52 <- applyWrapper aw_51 [] !appl_53 <- appl_52 `pseq` (kl_Parse_shen_LBpremisesRB `pseq` eq appl_52 kl_Parse_shen_LBpremisesRB) !kl_if_54 <- appl_53 `pseq` kl_not appl_53 case kl_if_54 of Atom (B (True)) -> do let !appl_55 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsingleunderlineRB) -> do let !aw_56 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_57 <- applyWrapper aw_56 [] !appl_58 <- appl_57 `pseq` (kl_Parse_shen_LBsingleunderlineRB `pseq` eq appl_57 kl_Parse_shen_LBsingleunderlineRB) !kl_if_59 <- appl_58 `pseq` kl_not appl_58 case kl_if_59 of Atom (B (True)) -> do let !appl_60 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBconclusionRB) -> do let !aw_61 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_62 <- applyWrapper aw_61 [] !appl_63 <- appl_62 `pseq` (kl_Parse_shen_LBconclusionRB `pseq` eq appl_62 kl_Parse_shen_LBconclusionRB) !kl_if_64 <- appl_63 `pseq` kl_not appl_63 case kl_if_64 of Atom (B (True)) -> do !appl_65 <- kl_Parse_shen_LBconclusionRB `pseq` hd kl_Parse_shen_LBconclusionRB let !aw_66 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_67 <- kl_Parse_shen_LBside_conditionsRB `pseq` applyWrapper aw_66 [kl_Parse_shen_LBside_conditionsRB] let !aw_68 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_69 <- kl_Parse_shen_LBpremisesRB `pseq` applyWrapper aw_68 [kl_Parse_shen_LBpremisesRB] let !aw_70 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_71 <- kl_Parse_shen_LBconclusionRB `pseq` applyWrapper aw_70 [kl_Parse_shen_LBconclusionRB] let !appl_72 = Atom Nil !appl_73 <- appl_71 `pseq` (appl_72 `pseq` klCons appl_71 appl_72) !appl_74 <- appl_69 `pseq` (appl_73 `pseq` klCons appl_69 appl_73) !appl_75 <- appl_67 `pseq` (appl_74 `pseq` klCons appl_67 appl_74) !appl_76 <- appl_75 `pseq` kl_shen_sequent (Core.Types.Atom (Core.Types.UnboundSym "shen.single")) appl_75 let !aw_77 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_65 `pseq` (appl_76 `pseq` applyWrapper aw_77 [appl_65, appl_76]) Atom (B (False)) -> do do let !aw_78 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_78 [] _ -> throwError "if: expected boolean"))) !appl_79 <- kl_Parse_shen_LBsingleunderlineRB `pseq` kl_shen_LBconclusionRB kl_Parse_shen_LBsingleunderlineRB appl_79 `pseq` applyWrapper appl_60 [appl_79] Atom (B (False)) -> do do let !aw_80 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_80 [] _ -> throwError "if: expected boolean"))) !appl_81 <- kl_Parse_shen_LBpremisesRB `pseq` kl_shen_LBsingleunderlineRB kl_Parse_shen_LBpremisesRB appl_81 `pseq` applyWrapper appl_55 [appl_81] Atom (B (False)) -> do do let !aw_82 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_82 [] _ -> throwError "if: expected boolean"))) !appl_83 <- kl_Parse_shen_LBside_conditionsRB `pseq` kl_shen_LBpremisesRB kl_Parse_shen_LBside_conditionsRB appl_83 `pseq` applyWrapper appl_50 [appl_83] Atom (B (False)) -> do do let !aw_84 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_84 [] _ -> throwError "if: expected boolean"))) !appl_85 <- kl_V2444 `pseq` kl_shen_LBside_conditionsRB kl_V2444 !appl_86 <- appl_85 `pseq` applyWrapper appl_45 [appl_85] appl_86 `pseq` applyWrapper appl_0 [appl_86] kl_shen_LBside_conditionsRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBside_conditionsRB (!kl_V2446) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) case kl_if_3 of Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !appl_7 <- appl_6 `pseq` (kl_Parse_LBeRB `pseq` eq appl_6 kl_Parse_LBeRB) !kl_if_8 <- appl_7 `pseq` kl_not appl_7 case kl_if_8 of Atom (B (True)) -> do !appl_9 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB let !appl_10 = Atom Nil let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_9 `pseq` (appl_10 `pseq` applyWrapper aw_11 [appl_9, appl_10]) Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_12 [] _ -> throwError "if: expected boolean"))) let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "") !appl_14 <- kl_V2446 `pseq` applyWrapper aw_13 [kl_V2446] appl_14 `pseq` applyWrapper appl_4 [appl_14] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBside_conditionRB) -> do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_17 <- applyWrapper aw_16 [] !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBside_conditionRB `pseq` eq appl_17 kl_Parse_shen_LBside_conditionRB) !kl_if_19 <- appl_18 `pseq` kl_not appl_18 case kl_if_19 of Atom (B (True)) -> do let !appl_20 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBside_conditionsRB) -> do let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_22 <- applyWrapper aw_21 [] !appl_23 <- appl_22 `pseq` (kl_Parse_shen_LBside_conditionsRB `pseq` eq appl_22 kl_Parse_shen_LBside_conditionsRB) !kl_if_24 <- appl_23 `pseq` kl_not appl_23 case kl_if_24 of Atom (B (True)) -> do !appl_25 <- kl_Parse_shen_LBside_conditionsRB `pseq` hd kl_Parse_shen_LBside_conditionsRB let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_27 <- kl_Parse_shen_LBside_conditionRB `pseq` applyWrapper aw_26 [kl_Parse_shen_LBside_conditionRB] let !aw_28 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_29 <- kl_Parse_shen_LBside_conditionsRB `pseq` applyWrapper aw_28 [kl_Parse_shen_LBside_conditionsRB] !appl_30 <- appl_27 `pseq` (appl_29 `pseq` klCons appl_27 appl_29) let !aw_31 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_25 `pseq` (appl_30 `pseq` applyWrapper aw_31 [appl_25, appl_30]) Atom (B (False)) -> do do let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_32 [] _ -> throwError "if: expected boolean"))) !appl_33 <- kl_Parse_shen_LBside_conditionRB `pseq` kl_shen_LBside_conditionsRB kl_Parse_shen_LBside_conditionRB appl_33 `pseq` applyWrapper appl_20 [appl_33] Atom (B (False)) -> do do let !aw_34 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_34 [] _ -> throwError "if: expected boolean"))) !appl_35 <- kl_V2446 `pseq` kl_shen_LBside_conditionRB kl_V2446 !appl_36 <- appl_35 `pseq` applyWrapper appl_15 [appl_35] appl_36 `pseq` applyWrapper appl_0 [appl_36] kl_shen_LBside_conditionRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBside_conditionRB (!kl_V2448) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) case kl_if_3 of Atom (B (True)) -> do !appl_4 <- kl_V2448 `pseq` hd kl_V2448 !kl_if_5 <- appl_4 `pseq` consP appl_4 !kl_if_6 <- case kl_if_5 of Atom (B (True)) -> do !appl_7 <- kl_V2448 `pseq` hd kl_V2448 !appl_8 <- appl_7 `pseq` hd appl_7 !kl_if_9 <- appl_8 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_8 case kl_if_9 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_6 of Atom (B (True)) -> do let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBvariablePRB) -> do let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_12 <- applyWrapper aw_11 [] !appl_13 <- appl_12 `pseq` (kl_Parse_shen_LBvariablePRB `pseq` eq appl_12 kl_Parse_shen_LBvariablePRB) !kl_if_14 <- appl_13 `pseq` kl_not appl_13 case kl_if_14 of Atom (B (True)) -> do let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_17 <- applyWrapper aw_16 [] !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_17 kl_Parse_shen_LBexprRB) !kl_if_19 <- appl_18 `pseq` kl_not appl_18 case kl_if_19 of Atom (B (True)) -> do !appl_20 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_22 <- kl_Parse_shen_LBvariablePRB `pseq` applyWrapper aw_21 [kl_Parse_shen_LBvariablePRB] let !aw_23 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_24 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_23 [kl_Parse_shen_LBexprRB] let !appl_25 = Atom Nil !appl_26 <- appl_24 `pseq` (appl_25 `pseq` klCons appl_24 appl_25) !appl_27 <- appl_22 `pseq` (appl_26 `pseq` klCons appl_22 appl_26) !appl_28 <- appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_27 let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_20 `pseq` (appl_28 `pseq` applyWrapper aw_29 [appl_20, appl_28]) Atom (B (False)) -> do do let !aw_30 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_30 [] _ -> throwError "if: expected boolean"))) !appl_31 <- kl_Parse_shen_LBvariablePRB `pseq` kl_shen_LBexprRB kl_Parse_shen_LBvariablePRB appl_31 `pseq` applyWrapper appl_15 [appl_31] Atom (B (False)) -> do do let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_32 [] _ -> throwError "if: expected boolean"))) !appl_33 <- kl_V2448 `pseq` hd kl_V2448 !appl_34 <- appl_33 `pseq` tl appl_33 let !aw_35 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_36 <- kl_V2448 `pseq` applyWrapper aw_35 [kl_V2448] let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_38 <- appl_34 `pseq` (appl_36 `pseq` applyWrapper aw_37 [appl_34, appl_36]) !appl_39 <- appl_38 `pseq` kl_shen_LBvariablePRB appl_38 appl_39 `pseq` applyWrapper appl_10 [appl_39] Atom (B (False)) -> do do let !aw_40 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_40 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) !appl_41 <- kl_V2448 `pseq` hd kl_V2448 !kl_if_42 <- appl_41 `pseq` consP appl_41 !kl_if_43 <- case kl_if_42 of Atom (B (True)) -> do !appl_44 <- kl_V2448 `pseq` hd kl_V2448 !appl_45 <- appl_44 `pseq` hd appl_44 !kl_if_46 <- appl_45 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_45 case kl_if_46 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" !appl_47 <- case kl_if_43 of Atom (B (True)) -> do let !appl_48 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_49 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_50 <- applyWrapper aw_49 [] !appl_51 <- appl_50 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_50 kl_Parse_shen_LBexprRB) !kl_if_52 <- appl_51 `pseq` kl_not appl_51 case kl_if_52 of Atom (B (True)) -> do !appl_53 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_55 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_54 [kl_Parse_shen_LBexprRB] let !appl_56 = Atom Nil !appl_57 <- appl_55 `pseq` (appl_56 `pseq` klCons appl_55 appl_56) !appl_58 <- appl_57 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_57 let !aw_59 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_53 `pseq` (appl_58 `pseq` applyWrapper aw_59 [appl_53, appl_58]) Atom (B (False)) -> do do let !aw_60 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_60 [] _ -> throwError "if: expected boolean"))) !appl_61 <- kl_V2448 `pseq` hd kl_V2448 !appl_62 <- appl_61 `pseq` tl appl_61 let !aw_63 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_64 <- kl_V2448 `pseq` applyWrapper aw_63 [kl_V2448] let !aw_65 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_66 <- appl_62 `pseq` (appl_64 `pseq` applyWrapper aw_65 [appl_62, appl_64]) !appl_67 <- appl_66 `pseq` kl_shen_LBexprRB appl_66 appl_67 `pseq` applyWrapper appl_48 [appl_67] Atom (B (False)) -> do do let !aw_68 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_68 [] _ -> throwError "if: expected boolean" appl_47 `pseq` applyWrapper appl_0 [appl_47] kl_shen_LBvariablePRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBvariablePRB (!kl_V2450) = do !appl_0 <- kl_V2450 `pseq` hd kl_V2450 !kl_if_1 <- appl_0 `pseq` consP appl_0 case kl_if_1 of Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !kl_if_3 <- kl_Parse_X `pseq` kl_variableP kl_Parse_X case kl_if_3 of Atom (B (True)) -> do !appl_4 <- kl_V2450 `pseq` hd kl_V2450 !appl_5 <- appl_4 `pseq` tl appl_4 let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_7 <- kl_V2450 `pseq` applyWrapper aw_6 [kl_V2450] let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, appl_7]) !appl_10 <- appl_9 `pseq` hd appl_9 let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_10 `pseq` (kl_Parse_X `pseq` applyWrapper aw_11 [appl_10, kl_Parse_X]) Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_12 [] _ -> throwError "if: expected boolean"))) !appl_13 <- kl_V2450 `pseq` hd kl_V2450 !appl_14 <- appl_13 `pseq` hd appl_13 appl_14 `pseq` applyWrapper appl_2 [appl_14] Atom (B (False)) -> do do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_15 [] _ -> throwError "if: expected boolean" kl_shen_LBexprRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBexprRB (!kl_V2452) = do !appl_0 <- kl_V2452 `pseq` hd kl_V2452 !kl_if_1 <- appl_0 `pseq` consP appl_0 case kl_if_1 of Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let !appl_3 = Atom Nil !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ";")) appl_3 !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ">>")) appl_4 !kl_if_6 <- kl_Parse_X `pseq` (appl_5 `pseq` kl_elementP kl_Parse_X appl_5) !appl_7 <- case kl_if_6 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do !kl_if_8 <- kl_Parse_X `pseq` kl_shen_singleunderlineP kl_Parse_X !kl_if_9 <- case kl_if_8 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do !kl_if_10 <- kl_Parse_X `pseq` kl_shen_doubleunderlineP kl_Parse_X case kl_if_10 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" case kl_if_9 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" !kl_if_11 <- appl_7 `pseq` kl_not appl_7 case kl_if_11 of Atom (B (True)) -> do !appl_12 <- kl_V2452 `pseq` hd kl_V2452 !appl_13 <- appl_12 `pseq` tl appl_12 let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_15 <- kl_V2452 `pseq` applyWrapper aw_14 [kl_V2452] let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_17 <- appl_13 `pseq` (appl_15 `pseq` applyWrapper aw_16 [appl_13, appl_15]) !appl_18 <- appl_17 `pseq` hd appl_17 !appl_19 <- kl_Parse_X `pseq` kl_shen_remove_bar kl_Parse_X let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_18 `pseq` (appl_19 `pseq` applyWrapper aw_20 [appl_18, appl_19]) Atom (B (False)) -> do do let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_21 [] _ -> throwError "if: expected boolean"))) !appl_22 <- kl_V2452 `pseq` hd kl_V2452 !appl_23 <- appl_22 `pseq` hd appl_22 appl_23 `pseq` applyWrapper appl_2 [appl_23] Atom (B (False)) -> do do let !aw_24 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_24 [] _ -> throwError "if: expected boolean" kl_shen_remove_bar :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_remove_bar (!kl_V2454) = do !kl_if_0 <- let pat_cond_1 kl_V2454 kl_V2454h kl_V2454t = do !kl_if_2 <- let pat_cond_3 kl_V2454t kl_V2454th kl_V2454tt = do !kl_if_4 <- let pat_cond_5 kl_V2454tt kl_V2454tth kl_V2454ttt = do let !appl_6 = Atom Nil !kl_if_7 <- appl_6 `pseq` (kl_V2454ttt `pseq` eq appl_6 kl_V2454ttt) !kl_if_8 <- case kl_if_7 of Atom (B (True)) -> do let pat_cond_9 = do return (Atom (B True)) pat_cond_10 = do do return (Atom (B False)) in case kl_V2454th of kl_V2454th@(Atom (UnboundSym "bar!")) -> pat_cond_9 kl_V2454th@(ApplC (PL "bar!" _)) -> pat_cond_9 kl_V2454th@(ApplC (Func "bar!" _)) -> pat_cond_9 _ -> pat_cond_10 Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_8 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_11 = do do return (Atom (B False)) in case kl_V2454tt of !(kl_V2454tt@(Cons (!kl_V2454tth) (!kl_V2454ttt))) -> pat_cond_5 kl_V2454tt kl_V2454tth kl_V2454ttt _ -> pat_cond_11 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_12 = do do return (Atom (B False)) in case kl_V2454t of !(kl_V2454t@(Cons (!kl_V2454th) (!kl_V2454tt))) -> pat_cond_3 kl_V2454t kl_V2454th kl_V2454tt _ -> pat_cond_12 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_13 = do do return (Atom (B False)) in case kl_V2454 of !(kl_V2454@(Cons (!kl_V2454h) (!kl_V2454t))) -> pat_cond_1 kl_V2454 kl_V2454h kl_V2454t _ -> pat_cond_13 case kl_if_0 of Atom (B (True)) -> do !appl_14 <- kl_V2454 `pseq` hd kl_V2454 !appl_15 <- kl_V2454 `pseq` tl kl_V2454 !appl_16 <- appl_15 `pseq` tl appl_15 !appl_17 <- appl_16 `pseq` hd appl_16 appl_14 `pseq` (appl_17 `pseq` klCons appl_14 appl_17) Atom (B (False)) -> do let pat_cond_18 kl_V2454 kl_V2454h kl_V2454t = do !appl_19 <- kl_V2454h `pseq` kl_shen_remove_bar kl_V2454h !appl_20 <- kl_V2454t `pseq` kl_shen_remove_bar kl_V2454t appl_19 `pseq` (appl_20 `pseq` klCons appl_19 appl_20) pat_cond_21 = do do return kl_V2454 in case kl_V2454 of !(kl_V2454@(Cons (!kl_V2454h) (!kl_V2454t))) -> pat_cond_18 kl_V2454 kl_V2454h kl_V2454t _ -> pat_cond_21 _ -> throwError "if: expected boolean" kl_shen_LBpremisesRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBpremisesRB (!kl_V2456) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) case kl_if_3 of Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !appl_7 <- appl_6 `pseq` (kl_Parse_LBeRB `pseq` eq appl_6 kl_Parse_LBeRB) !kl_if_8 <- appl_7 `pseq` kl_not appl_7 case kl_if_8 of Atom (B (True)) -> do !appl_9 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB let !appl_10 = Atom Nil let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_9 `pseq` (appl_10 `pseq` applyWrapper aw_11 [appl_9, appl_10]) Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_12 [] _ -> throwError "if: expected boolean"))) let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "") !appl_14 <- kl_V2456 `pseq` applyWrapper aw_13 [kl_V2456] appl_14 `pseq` applyWrapper appl_4 [appl_14] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremiseRB) -> do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_17 <- applyWrapper aw_16 [] !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBpremiseRB `pseq` eq appl_17 kl_Parse_shen_LBpremiseRB) !kl_if_19 <- appl_18 `pseq` kl_not appl_18 case kl_if_19 of Atom (B (True)) -> do let !appl_20 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsemicolon_symbolRB) -> do let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_22 <- applyWrapper aw_21 [] !appl_23 <- appl_22 `pseq` (kl_Parse_shen_LBsemicolon_symbolRB `pseq` eq appl_22 kl_Parse_shen_LBsemicolon_symbolRB) !kl_if_24 <- appl_23 `pseq` kl_not appl_23 case kl_if_24 of Atom (B (True)) -> do let !appl_25 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremisesRB) -> do let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_27 <- applyWrapper aw_26 [] !appl_28 <- appl_27 `pseq` (kl_Parse_shen_LBpremisesRB `pseq` eq appl_27 kl_Parse_shen_LBpremisesRB) !kl_if_29 <- appl_28 `pseq` kl_not appl_28 case kl_if_29 of Atom (B (True)) -> do !appl_30 <- kl_Parse_shen_LBpremisesRB `pseq` hd kl_Parse_shen_LBpremisesRB let !aw_31 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_32 <- kl_Parse_shen_LBpremiseRB `pseq` applyWrapper aw_31 [kl_Parse_shen_LBpremiseRB] let !aw_33 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_34 <- kl_Parse_shen_LBpremisesRB `pseq` applyWrapper aw_33 [kl_Parse_shen_LBpremisesRB] !appl_35 <- appl_32 `pseq` (appl_34 `pseq` klCons appl_32 appl_34) let !aw_36 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_30 `pseq` (appl_35 `pseq` applyWrapper aw_36 [appl_30, appl_35]) Atom (B (False)) -> do do let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_37 [] _ -> throwError "if: expected boolean"))) !appl_38 <- kl_Parse_shen_LBsemicolon_symbolRB `pseq` kl_shen_LBpremisesRB kl_Parse_shen_LBsemicolon_symbolRB appl_38 `pseq` applyWrapper appl_25 [appl_38] Atom (B (False)) -> do do let !aw_39 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_39 [] _ -> throwError "if: expected boolean"))) !appl_40 <- kl_Parse_shen_LBpremiseRB `pseq` kl_shen_LBsemicolon_symbolRB kl_Parse_shen_LBpremiseRB appl_40 `pseq` applyWrapper appl_20 [appl_40] Atom (B (False)) -> do do let !aw_41 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_41 [] _ -> throwError "if: expected boolean"))) !appl_42 <- kl_V2456 `pseq` kl_shen_LBpremiseRB kl_V2456 !appl_43 <- appl_42 `pseq` applyWrapper appl_15 [appl_42] appl_43 `pseq` applyWrapper appl_0 [appl_43] kl_shen_LBsemicolon_symbolRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBsemicolon_symbolRB (!kl_V2458) = do !appl_0 <- kl_V2458 `pseq` hd kl_V2458 !kl_if_1 <- appl_0 `pseq` consP appl_0 case kl_if_1 of Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let pat_cond_3 = do !appl_4 <- kl_V2458 `pseq` hd kl_V2458 !appl_5 <- appl_4 `pseq` tl appl_4 let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_7 <- kl_V2458 `pseq` applyWrapper aw_6 [kl_V2458] let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, appl_7]) !appl_10 <- appl_9 `pseq` hd appl_9 let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_10 `pseq` applyWrapper aw_11 [appl_10, Core.Types.Atom (Core.Types.UnboundSym "shen.skip")] pat_cond_12 = do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_13 [] in case kl_Parse_X of kl_Parse_X@(Atom (UnboundSym ";")) -> pat_cond_3 kl_Parse_X@(ApplC (PL ";" _)) -> pat_cond_3 kl_Parse_X@(ApplC (Func ";" _)) -> pat_cond_3 _ -> pat_cond_12))) !appl_14 <- kl_V2458 `pseq` hd kl_V2458 !appl_15 <- appl_14 `pseq` hd appl_14 appl_15 `pseq` applyWrapper appl_2 [appl_15] Atom (B (False)) -> do do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_16 [] _ -> throwError "if: expected boolean" kl_shen_LBpremiseRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBpremiseRB (!kl_V2460) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) case kl_if_3 of Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !kl_if_7 <- kl_YaccParse `pseq` (appl_6 `pseq` eq kl_YaccParse appl_6) case kl_if_7 of Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_10 <- applyWrapper aw_9 [] !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_10 kl_Parse_shen_LBformulaRB) !kl_if_12 <- appl_11 `pseq` kl_not appl_11 case kl_if_12 of Atom (B (True)) -> do !appl_13 <- kl_Parse_shen_LBformulaRB `pseq` hd kl_Parse_shen_LBformulaRB let !appl_14 = Atom Nil let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_16 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_15 [kl_Parse_shen_LBformulaRB] !appl_17 <- appl_14 `pseq` (appl_16 `pseq` kl_shen_sequent appl_14 appl_16) let !aw_18 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_13 `pseq` (appl_17 `pseq` applyWrapper aw_18 [appl_13, appl_17]) Atom (B (False)) -> do do let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_19 [] _ -> throwError "if: expected boolean"))) !appl_20 <- kl_V2460 `pseq` kl_shen_LBformulaRB kl_V2460 appl_20 `pseq` applyWrapper appl_8 [appl_20] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_21 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaeRB) -> do let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_23 <- applyWrapper aw_22 [] !appl_24 <- appl_23 `pseq` (kl_Parse_shen_LBformulaeRB `pseq` eq appl_23 kl_Parse_shen_LBformulaeRB) !kl_if_25 <- appl_24 `pseq` kl_not appl_24 case kl_if_25 of Atom (B (True)) -> do !appl_26 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB !kl_if_27 <- appl_26 `pseq` consP appl_26 !kl_if_28 <- case kl_if_27 of Atom (B (True)) -> do !appl_29 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB !appl_30 <- appl_29 `pseq` hd appl_29 !kl_if_31 <- appl_30 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym ">>")) appl_30 case kl_if_31 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_28 of Atom (B (True)) -> do let !appl_32 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_33 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_34 <- applyWrapper aw_33 [] !appl_35 <- appl_34 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_34 kl_Parse_shen_LBformulaRB) !kl_if_36 <- appl_35 `pseq` kl_not appl_35 case kl_if_36 of Atom (B (True)) -> do !appl_37 <- kl_Parse_shen_LBformulaRB `pseq` hd kl_Parse_shen_LBformulaRB let !aw_38 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_39 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_38 [kl_Parse_shen_LBformulaeRB] let !aw_40 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_41 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_40 [kl_Parse_shen_LBformulaRB] !appl_42 <- appl_39 `pseq` (appl_41 `pseq` kl_shen_sequent appl_39 appl_41) let !aw_43 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_37 `pseq` (appl_42 `pseq` applyWrapper aw_43 [appl_37, appl_42]) Atom (B (False)) -> do do let !aw_44 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_44 [] _ -> throwError "if: expected boolean"))) !appl_45 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB !appl_46 <- appl_45 `pseq` tl appl_45 let !aw_47 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_48 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_47 [kl_Parse_shen_LBformulaeRB] let !aw_49 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_50 <- appl_46 `pseq` (appl_48 `pseq` applyWrapper aw_49 [appl_46, appl_48]) !appl_51 <- appl_50 `pseq` kl_shen_LBformulaRB appl_50 appl_51 `pseq` applyWrapper appl_32 [appl_51] Atom (B (False)) -> do do let !aw_52 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_52 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_53 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_53 [] _ -> throwError "if: expected boolean"))) !appl_54 <- kl_V2460 `pseq` kl_shen_LBformulaeRB kl_V2460 !appl_55 <- appl_54 `pseq` applyWrapper appl_21 [appl_54] appl_55 `pseq` applyWrapper appl_4 [appl_55] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) !appl_56 <- kl_V2460 `pseq` hd kl_V2460 !kl_if_57 <- appl_56 `pseq` consP appl_56 !kl_if_58 <- case kl_if_57 of Atom (B (True)) -> do !appl_59 <- kl_V2460 `pseq` hd kl_V2460 !appl_60 <- appl_59 `pseq` hd appl_59 !kl_if_61 <- appl_60 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "!")) appl_60 case kl_if_61 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" !appl_62 <- case kl_if_58 of Atom (B (True)) -> do !appl_63 <- kl_V2460 `pseq` hd kl_V2460 !appl_64 <- appl_63 `pseq` tl appl_63 let !aw_65 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_66 <- kl_V2460 `pseq` applyWrapper aw_65 [kl_V2460] let !aw_67 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_68 <- appl_64 `pseq` (appl_66 `pseq` applyWrapper aw_67 [appl_64, appl_66]) !appl_69 <- appl_68 `pseq` hd appl_68 let !aw_70 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_69 `pseq` applyWrapper aw_70 [appl_69, Core.Types.Atom (Core.Types.UnboundSym "!")] Atom (B (False)) -> do do let !aw_71 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_71 [] _ -> throwError "if: expected boolean" appl_62 `pseq` applyWrapper appl_0 [appl_62] kl_shen_LBconclusionRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBconclusionRB (!kl_V2462) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) case kl_if_3 of Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !appl_7 <- appl_6 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_6 kl_Parse_shen_LBformulaRB) !kl_if_8 <- appl_7 `pseq` kl_not appl_7 case kl_if_8 of Atom (B (True)) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsemicolon_symbolRB) -> do let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_11 <- applyWrapper aw_10 [] !appl_12 <- appl_11 `pseq` (kl_Parse_shen_LBsemicolon_symbolRB `pseq` eq appl_11 kl_Parse_shen_LBsemicolon_symbolRB) !kl_if_13 <- appl_12 `pseq` kl_not appl_12 case kl_if_13 of Atom (B (True)) -> do !appl_14 <- kl_Parse_shen_LBsemicolon_symbolRB `pseq` hd kl_Parse_shen_LBsemicolon_symbolRB let !appl_15 = Atom Nil let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_17 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_16 [kl_Parse_shen_LBformulaRB] !appl_18 <- appl_15 `pseq` (appl_17 `pseq` kl_shen_sequent appl_15 appl_17) let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_14 `pseq` (appl_18 `pseq` applyWrapper aw_19 [appl_14, appl_18]) Atom (B (False)) -> do do let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_20 [] _ -> throwError "if: expected boolean"))) !appl_21 <- kl_Parse_shen_LBformulaRB `pseq` kl_shen_LBsemicolon_symbolRB kl_Parse_shen_LBformulaRB appl_21 `pseq` applyWrapper appl_9 [appl_21] Atom (B (False)) -> do do let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_22 [] _ -> throwError "if: expected boolean"))) !appl_23 <- kl_V2462 `pseq` kl_shen_LBformulaRB kl_V2462 appl_23 `pseq` applyWrapper appl_4 [appl_23] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaeRB) -> do let !aw_25 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_26 <- applyWrapper aw_25 [] !appl_27 <- appl_26 `pseq` (kl_Parse_shen_LBformulaeRB `pseq` eq appl_26 kl_Parse_shen_LBformulaeRB) !kl_if_28 <- appl_27 `pseq` kl_not appl_27 case kl_if_28 of Atom (B (True)) -> do !appl_29 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB !kl_if_30 <- appl_29 `pseq` consP appl_29 !kl_if_31 <- case kl_if_30 of Atom (B (True)) -> do !appl_32 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB !appl_33 <- appl_32 `pseq` hd appl_32 !kl_if_34 <- appl_33 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym ">>")) appl_33 case kl_if_34 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_31 of Atom (B (True)) -> do let !appl_35 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_36 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_37 <- applyWrapper aw_36 [] !appl_38 <- appl_37 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_37 kl_Parse_shen_LBformulaRB) !kl_if_39 <- appl_38 `pseq` kl_not appl_38 case kl_if_39 of Atom (B (True)) -> do let !appl_40 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsemicolon_symbolRB) -> do let !aw_41 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_42 <- applyWrapper aw_41 [] !appl_43 <- appl_42 `pseq` (kl_Parse_shen_LBsemicolon_symbolRB `pseq` eq appl_42 kl_Parse_shen_LBsemicolon_symbolRB) !kl_if_44 <- appl_43 `pseq` kl_not appl_43 case kl_if_44 of Atom (B (True)) -> do !appl_45 <- kl_Parse_shen_LBsemicolon_symbolRB `pseq` hd kl_Parse_shen_LBsemicolon_symbolRB let !aw_46 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_47 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_46 [kl_Parse_shen_LBformulaeRB] let !aw_48 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_49 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_48 [kl_Parse_shen_LBformulaRB] !appl_50 <- appl_47 `pseq` (appl_49 `pseq` kl_shen_sequent appl_47 appl_49) let !aw_51 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_45 `pseq` (appl_50 `pseq` applyWrapper aw_51 [appl_45, appl_50]) Atom (B (False)) -> do do let !aw_52 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_52 [] _ -> throwError "if: expected boolean"))) !appl_53 <- kl_Parse_shen_LBformulaRB `pseq` kl_shen_LBsemicolon_symbolRB kl_Parse_shen_LBformulaRB appl_53 `pseq` applyWrapper appl_40 [appl_53] Atom (B (False)) -> do do let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_54 [] _ -> throwError "if: expected boolean"))) !appl_55 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB !appl_56 <- appl_55 `pseq` tl appl_55 let !aw_57 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_58 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_57 [kl_Parse_shen_LBformulaeRB] let !aw_59 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_60 <- appl_56 `pseq` (appl_58 `pseq` applyWrapper aw_59 [appl_56, appl_58]) !appl_61 <- appl_60 `pseq` kl_shen_LBformulaRB appl_60 appl_61 `pseq` applyWrapper appl_35 [appl_61] Atom (B (False)) -> do do let !aw_62 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_62 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_63 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_63 [] _ -> throwError "if: expected boolean"))) !appl_64 <- kl_V2462 `pseq` kl_shen_LBformulaeRB kl_V2462 !appl_65 <- appl_64 `pseq` applyWrapper appl_24 [appl_64] appl_65 `pseq` applyWrapper appl_0 [appl_65] kl_shen_sequent :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_sequent (!kl_V2465) (!kl_V2466) = do kl_V2465 `pseq` (kl_V2466 `pseq` kl_Atp kl_V2465 kl_V2466) kl_shen_LBformulaeRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBformulaeRB (!kl_V2468) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) case kl_if_3 of Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !kl_if_7 <- kl_YaccParse `pseq` (appl_6 `pseq` eq kl_YaccParse appl_6) case kl_if_7 of Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_10 <- applyWrapper aw_9 [] !appl_11 <- appl_10 `pseq` (kl_Parse_LBeRB `pseq` eq appl_10 kl_Parse_LBeRB) !kl_if_12 <- appl_11 `pseq` kl_not appl_11 case kl_if_12 of Atom (B (True)) -> do !appl_13 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB let !appl_14 = Atom Nil let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_13 `pseq` (appl_14 `pseq` applyWrapper aw_15 [appl_13, appl_14]) Atom (B (False)) -> do do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_16 [] _ -> throwError "if: expected boolean"))) let !aw_17 = Core.Types.Atom (Core.Types.UnboundSym "") !appl_18 <- kl_V2468 `pseq` applyWrapper aw_17 [kl_V2468] appl_18 `pseq` applyWrapper appl_8 [appl_18] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_21 <- applyWrapper aw_20 [] !appl_22 <- appl_21 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_21 kl_Parse_shen_LBformulaRB) !kl_if_23 <- appl_22 `pseq` kl_not appl_22 case kl_if_23 of Atom (B (True)) -> do !appl_24 <- kl_Parse_shen_LBformulaRB `pseq` hd kl_Parse_shen_LBformulaRB let !aw_25 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_26 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_25 [kl_Parse_shen_LBformulaRB] let !appl_27 = Atom Nil !appl_28 <- appl_26 `pseq` (appl_27 `pseq` klCons appl_26 appl_27) let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_24 `pseq` (appl_28 `pseq` applyWrapper aw_29 [appl_24, appl_28]) Atom (B (False)) -> do do let !aw_30 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_30 [] _ -> throwError "if: expected boolean"))) !appl_31 <- kl_V2468 `pseq` kl_shen_LBformulaRB kl_V2468 !appl_32 <- appl_31 `pseq` applyWrapper appl_19 [appl_31] appl_32 `pseq` applyWrapper appl_4 [appl_32] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_33 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_34 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_35 <- applyWrapper aw_34 [] !appl_36 <- appl_35 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_35 kl_Parse_shen_LBformulaRB) !kl_if_37 <- appl_36 `pseq` kl_not appl_36 case kl_if_37 of Atom (B (True)) -> do let !appl_38 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcomma_symbolRB) -> do let !aw_39 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_40 <- applyWrapper aw_39 [] !appl_41 <- appl_40 `pseq` (kl_Parse_shen_LBcomma_symbolRB `pseq` eq appl_40 kl_Parse_shen_LBcomma_symbolRB) !kl_if_42 <- appl_41 `pseq` kl_not appl_41 case kl_if_42 of Atom (B (True)) -> do let !appl_43 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaeRB) -> do let !aw_44 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_45 <- applyWrapper aw_44 [] !appl_46 <- appl_45 `pseq` (kl_Parse_shen_LBformulaeRB `pseq` eq appl_45 kl_Parse_shen_LBformulaeRB) !kl_if_47 <- appl_46 `pseq` kl_not appl_46 case kl_if_47 of Atom (B (True)) -> do !appl_48 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB let !aw_49 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_50 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_49 [kl_Parse_shen_LBformulaRB] let !aw_51 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_52 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_51 [kl_Parse_shen_LBformulaeRB] !appl_53 <- appl_50 `pseq` (appl_52 `pseq` klCons appl_50 appl_52) let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_48 `pseq` (appl_53 `pseq` applyWrapper aw_54 [appl_48, appl_53]) Atom (B (False)) -> do do let !aw_55 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_55 [] _ -> throwError "if: expected boolean"))) !appl_56 <- kl_Parse_shen_LBcomma_symbolRB `pseq` kl_shen_LBformulaeRB kl_Parse_shen_LBcomma_symbolRB appl_56 `pseq` applyWrapper appl_43 [appl_56] Atom (B (False)) -> do do let !aw_57 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_57 [] _ -> throwError "if: expected boolean"))) !appl_58 <- kl_Parse_shen_LBformulaRB `pseq` kl_shen_LBcomma_symbolRB kl_Parse_shen_LBformulaRB appl_58 `pseq` applyWrapper appl_38 [appl_58] Atom (B (False)) -> do do let !aw_59 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_59 [] _ -> throwError "if: expected boolean"))) !appl_60 <- kl_V2468 `pseq` kl_shen_LBformulaRB kl_V2468 !appl_61 <- appl_60 `pseq` applyWrapper appl_33 [appl_60] appl_61 `pseq` applyWrapper appl_0 [appl_61] kl_shen_LBcomma_symbolRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBcomma_symbolRB (!kl_V2470) = do !appl_0 <- kl_V2470 `pseq` hd kl_V2470 !kl_if_1 <- appl_0 `pseq` consP appl_0 case kl_if_1 of Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !appl_3 <- intern (Core.Types.Atom (Core.Types.Str ",")) !kl_if_4 <- kl_Parse_X `pseq` (appl_3 `pseq` eq kl_Parse_X appl_3) case kl_if_4 of Atom (B (True)) -> do !appl_5 <- kl_V2470 `pseq` hd kl_V2470 !appl_6 <- appl_5 `pseq` tl appl_5 let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_8 <- kl_V2470 `pseq` applyWrapper aw_7 [kl_V2470] let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_10 <- appl_6 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_6, appl_8]) !appl_11 <- appl_10 `pseq` hd appl_10 let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_11 `pseq` applyWrapper aw_12 [appl_11, Core.Types.Atom (Core.Types.UnboundSym "shen.skip")] Atom (B (False)) -> do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_13 [] _ -> throwError "if: expected boolean"))) !appl_14 <- kl_V2470 `pseq` hd kl_V2470 !appl_15 <- appl_14 `pseq` hd appl_14 appl_15 `pseq` applyWrapper appl_2 [appl_15] Atom (B (False)) -> do do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_16 [] _ -> throwError "if: expected boolean" kl_shen_LBformulaRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBformulaRB (!kl_V2472) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) case kl_if_3 of Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !appl_7 <- appl_6 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_6 kl_Parse_shen_LBexprRB) !kl_if_8 <- appl_7 `pseq` kl_not appl_7 case kl_if_8 of Atom (B (True)) -> do !appl_9 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_11 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_10 [kl_Parse_shen_LBexprRB] let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_9 `pseq` (appl_11 `pseq` applyWrapper aw_12 [appl_9, appl_11]) Atom (B (False)) -> do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_13 [] _ -> throwError "if: expected boolean"))) !appl_14 <- kl_V2472 `pseq` kl_shen_LBexprRB kl_V2472 appl_14 `pseq` applyWrapper appl_4 [appl_14] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_17 <- applyWrapper aw_16 [] !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_17 kl_Parse_shen_LBexprRB) !kl_if_19 <- appl_18 `pseq` kl_not appl_18 case kl_if_19 of Atom (B (True)) -> do !appl_20 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB !kl_if_21 <- appl_20 `pseq` consP appl_20 !kl_if_22 <- case kl_if_21 of Atom (B (True)) -> do !appl_23 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB !appl_24 <- appl_23 `pseq` hd appl_23 !kl_if_25 <- appl_24 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym ":")) appl_24 case kl_if_25 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_22 of Atom (B (True)) -> do let !appl_26 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBtypeRB) -> do let !aw_27 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_28 <- applyWrapper aw_27 [] !appl_29 <- appl_28 `pseq` (kl_Parse_shen_LBtypeRB `pseq` eq appl_28 kl_Parse_shen_LBtypeRB) !kl_if_30 <- appl_29 `pseq` kl_not appl_29 case kl_if_30 of Atom (B (True)) -> do !appl_31 <- kl_Parse_shen_LBtypeRB `pseq` hd kl_Parse_shen_LBtypeRB let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_33 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_32 [kl_Parse_shen_LBexprRB] let !aw_34 = Core.Types.Atom (Core.Types.UnboundSym "shen.curry") !appl_35 <- appl_33 `pseq` applyWrapper aw_34 [appl_33] let !aw_36 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_37 <- kl_Parse_shen_LBtypeRB `pseq` applyWrapper aw_36 [kl_Parse_shen_LBtypeRB] let !aw_38 = Core.Types.Atom (Core.Types.UnboundSym "shen.demodulate") !appl_39 <- appl_37 `pseq` applyWrapper aw_38 [appl_37] let !appl_40 = Atom Nil !appl_41 <- appl_39 `pseq` (appl_40 `pseq` klCons appl_39 appl_40) !appl_42 <- appl_41 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":")) appl_41 !appl_43 <- appl_35 `pseq` (appl_42 `pseq` klCons appl_35 appl_42) let !aw_44 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_31 `pseq` (appl_43 `pseq` applyWrapper aw_44 [appl_31, appl_43]) Atom (B (False)) -> do do let !aw_45 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_45 [] _ -> throwError "if: expected boolean"))) !appl_46 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB !appl_47 <- appl_46 `pseq` tl appl_46 let !aw_48 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_49 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_48 [kl_Parse_shen_LBexprRB] let !aw_50 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_51 <- appl_47 `pseq` (appl_49 `pseq` applyWrapper aw_50 [appl_47, appl_49]) !appl_52 <- appl_51 `pseq` kl_shen_LBtypeRB appl_51 appl_52 `pseq` applyWrapper appl_26 [appl_52] Atom (B (False)) -> do do let !aw_53 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_53 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_54 [] _ -> throwError "if: expected boolean"))) !appl_55 <- kl_V2472 `pseq` kl_shen_LBexprRB kl_V2472 !appl_56 <- appl_55 `pseq` applyWrapper appl_15 [appl_55] appl_56 `pseq` applyWrapper appl_0 [appl_56] kl_shen_LBtypeRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBtypeRB (!kl_V2474) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !appl_3 <- appl_2 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_2 kl_Parse_shen_LBexprRB) !kl_if_4 <- appl_3 `pseq` kl_not appl_3 case kl_if_4 of Atom (B (True)) -> do !appl_5 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_7 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_6 [kl_Parse_shen_LBexprRB] !appl_8 <- appl_7 `pseq` kl_shen_curry_type appl_7 let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_5 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_5, appl_8]) Atom (B (False)) -> do do let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_10 [] _ -> throwError "if: expected boolean"))) !appl_11 <- kl_V2474 `pseq` kl_shen_LBexprRB kl_V2474 appl_11 `pseq` applyWrapper appl_0 [appl_11] kl_shen_LBdoubleunderlineRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBdoubleunderlineRB (!kl_V2476) = do !appl_0 <- kl_V2476 `pseq` hd kl_V2476 !kl_if_1 <- appl_0 `pseq` consP appl_0 case kl_if_1 of Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !kl_if_3 <- kl_Parse_X `pseq` kl_shen_doubleunderlineP kl_Parse_X case kl_if_3 of Atom (B (True)) -> do !appl_4 <- kl_V2476 `pseq` hd kl_V2476 !appl_5 <- appl_4 `pseq` tl appl_4 let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_7 <- kl_V2476 `pseq` applyWrapper aw_6 [kl_V2476] let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, appl_7]) !appl_10 <- appl_9 `pseq` hd appl_9 let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_10 `pseq` (kl_Parse_X `pseq` applyWrapper aw_11 [appl_10, kl_Parse_X]) Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_12 [] _ -> throwError "if: expected boolean"))) !appl_13 <- kl_V2476 `pseq` hd kl_V2476 !appl_14 <- appl_13 `pseq` hd appl_13 appl_14 `pseq` applyWrapper appl_2 [appl_14] Atom (B (False)) -> do do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_15 [] _ -> throwError "if: expected boolean" kl_shen_LBsingleunderlineRB :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_LBsingleunderlineRB (!kl_V2478) = do !appl_0 <- kl_V2478 `pseq` hd kl_V2478 !kl_if_1 <- appl_0 `pseq` consP appl_0 case kl_if_1 of Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !kl_if_3 <- kl_Parse_X `pseq` kl_shen_singleunderlineP kl_Parse_X case kl_if_3 of Atom (B (True)) -> do !appl_4 <- kl_V2478 `pseq` hd kl_V2478 !appl_5 <- appl_4 `pseq` tl appl_4 let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") !appl_7 <- kl_V2478 `pseq` applyWrapper aw_6 [kl_V2478] let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, appl_7]) !appl_10 <- appl_9 `pseq` hd appl_9 let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") appl_10 `pseq` (kl_Parse_X `pseq` applyWrapper aw_11 [appl_10, kl_Parse_X]) Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_12 [] _ -> throwError "if: expected boolean"))) !appl_13 <- kl_V2478 `pseq` hd kl_V2478 !appl_14 <- appl_13 `pseq` hd appl_13 appl_14 `pseq` applyWrapper appl_2 [appl_14] Atom (B (False)) -> do do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "fail") applyWrapper aw_15 [] _ -> throwError "if: expected boolean" kl_shen_singleunderlineP :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_singleunderlineP (!kl_V2480) = do !kl_if_0 <- kl_V2480 `pseq` kl_symbolP kl_V2480 case kl_if_0 of Atom (B (True)) -> do !appl_1 <- kl_V2480 `pseq` str kl_V2480 !kl_if_2 <- appl_1 `pseq` kl_shen_shP appl_1 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" kl_shen_shP :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_shP (!kl_V2482) = do let pat_cond_0 = do return (Atom (B True)) pat_cond_1 = do do !appl_2 <- kl_V2482 `pseq` pos kl_V2482 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) !kl_if_3 <- appl_2 `pseq` eq appl_2 (Core.Types.Atom (Core.Types.Str "_")) case kl_if_3 of Atom (B (True)) -> do !appl_4 <- kl_V2482 `pseq` tlstr kl_V2482 !kl_if_5 <- appl_4 `pseq` kl_shen_shP appl_4 case kl_if_5 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" in case kl_V2482 of kl_V2482@(Atom (Str "_")) -> pat_cond_0 _ -> pat_cond_1 kl_shen_doubleunderlineP :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_doubleunderlineP (!kl_V2484) = do !kl_if_0 <- kl_V2484 `pseq` kl_symbolP kl_V2484 case kl_if_0 of Atom (B (True)) -> do !appl_1 <- kl_V2484 `pseq` str kl_V2484 !kl_if_2 <- appl_1 `pseq` kl_shen_dhP appl_1 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" kl_shen_dhP :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_dhP (!kl_V2486) = do let pat_cond_0 = do return (Atom (B True)) pat_cond_1 = do do !appl_2 <- kl_V2486 `pseq` pos kl_V2486 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) !kl_if_3 <- appl_2 `pseq` eq appl_2 (Core.Types.Atom (Core.Types.Str "=")) case kl_if_3 of Atom (B (True)) -> do !appl_4 <- kl_V2486 `pseq` tlstr kl_V2486 !kl_if_5 <- appl_4 `pseq` kl_shen_dhP appl_4 case kl_if_5 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" in case kl_V2486 of kl_V2486@(Atom (Str "=")) -> pat_cond_0 _ -> pat_cond_1 kl_shen_process_datatype :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_process_datatype (!kl_V2489) (!kl_V2490) = do !appl_0 <- kl_V2489 `pseq` (kl_V2490 `pseq` kl_shen_rules_RBhorn_clauses kl_V2489 kl_V2490) let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.s-prolog") !appl_2 <- appl_0 `pseq` applyWrapper aw_1 [appl_0] appl_2 `pseq` kl_shen_remember_datatype appl_2 kl_shen_remember_datatype :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_remember_datatype (!kl_V2496) = do let pat_cond_0 kl_V2496 kl_V2496h kl_V2496t = do !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "adjoin") !appl_3 <- kl_V2496h `pseq` (appl_1 `pseq` applyWrapper aw_2 [kl_V2496h, appl_1]) !appl_4 <- appl_3 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) appl_3 !appl_5 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*alldatatypes*")) let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "adjoin") !appl_7 <- kl_V2496h `pseq` (appl_5 `pseq` applyWrapper aw_6 [kl_V2496h, appl_5]) !appl_8 <- appl_7 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*alldatatypes*")) appl_7 !appl_9 <- appl_8 `pseq` (kl_V2496h `pseq` kl_do appl_8 kl_V2496h) appl_4 `pseq` (appl_9 `pseq` kl_do appl_4 appl_9) pat_cond_10 = do do let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_11 [ApplC (wrapNamed "shen.remember-datatype" kl_shen_remember_datatype)] in case kl_V2496 of !(kl_V2496@(Cons (!kl_V2496h) (!kl_V2496t))) -> pat_cond_0 kl_V2496 kl_V2496h kl_V2496t _ -> pat_cond_10 kl_shen_rules_RBhorn_clauses :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_rules_RBhorn_clauses (!kl_V2501) (!kl_V2502) = do let !appl_0 = Atom Nil !kl_if_1 <- appl_0 `pseq` (kl_V2502 `pseq` eq appl_0 kl_V2502) case kl_if_1 of Atom (B (True)) -> do return (Atom Nil) Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V2502 kl_V2502h kl_V2502t = do !kl_if_4 <- kl_V2502h `pseq` kl_tupleP kl_V2502h !kl_if_5 <- case kl_if_4 of Atom (B (True)) -> do !appl_6 <- kl_V2502h `pseq` kl_fst kl_V2502h !kl_if_7 <- appl_6 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "shen.single")) appl_6 case kl_if_7 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_5 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_8 = do do return (Atom (B False)) in case kl_V2502 of !(kl_V2502@(Cons (!kl_V2502h) (!kl_V2502t))) -> pat_cond_3 kl_V2502 kl_V2502h kl_V2502t _ -> pat_cond_8 case kl_if_2 of Atom (B (True)) -> do !appl_9 <- kl_V2502 `pseq` hd kl_V2502 !appl_10 <- appl_9 `pseq` kl_snd appl_9 !appl_11 <- kl_V2501 `pseq` (appl_10 `pseq` kl_shen_rule_RBhorn_clause kl_V2501 appl_10) !appl_12 <- kl_V2502 `pseq` tl kl_V2502 !appl_13 <- kl_V2501 `pseq` (appl_12 `pseq` kl_shen_rules_RBhorn_clauses kl_V2501 appl_12) appl_11 `pseq` (appl_13 `pseq` klCons appl_11 appl_13) Atom (B (False)) -> do !kl_if_14 <- let pat_cond_15 kl_V2502 kl_V2502h kl_V2502t = do !kl_if_16 <- kl_V2502h `pseq` kl_tupleP kl_V2502h !kl_if_17 <- case kl_if_16 of Atom (B (True)) -> do !appl_18 <- kl_V2502h `pseq` kl_fst kl_V2502h !kl_if_19 <- appl_18 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "shen.double")) appl_18 case kl_if_19 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_17 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_20 = do do return (Atom (B False)) in case kl_V2502 of !(kl_V2502@(Cons (!kl_V2502h) (!kl_V2502t))) -> pat_cond_15 kl_V2502 kl_V2502h kl_V2502t _ -> pat_cond_20 case kl_if_14 of Atom (B (True)) -> do !appl_21 <- kl_V2502 `pseq` hd kl_V2502 !appl_22 <- appl_21 `pseq` kl_snd appl_21 !appl_23 <- appl_22 `pseq` kl_shen_double_RBsingles appl_22 !appl_24 <- kl_V2502 `pseq` tl kl_V2502 !appl_25 <- appl_23 `pseq` (appl_24 `pseq` kl_append appl_23 appl_24) kl_V2501 `pseq` (appl_25 `pseq` kl_shen_rules_RBhorn_clauses kl_V2501 appl_25) Atom (B (False)) -> do do let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_26 [ApplC (wrapNamed "shen.rules->horn-clauses" kl_shen_rules_RBhorn_clauses)] _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" kl_shen_double_RBsingles :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_double_RBsingles (!kl_V2504) = do !appl_0 <- kl_V2504 `pseq` kl_shen_right_rule kl_V2504 !appl_1 <- kl_V2504 `pseq` kl_shen_left_rule kl_V2504 let !appl_2 = Atom Nil !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) appl_0 `pseq` (appl_3 `pseq` klCons appl_0 appl_3) kl_shen_right_rule :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_right_rule (!kl_V2506) = do kl_V2506 `pseq` kl_Atp (Core.Types.Atom (Core.Types.UnboundSym "shen.single")) kl_V2506 kl_shen_left_rule :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_left_rule (!kl_V2508) = do !kl_if_0 <- let pat_cond_1 kl_V2508 kl_V2508h kl_V2508t = do !kl_if_2 <- let pat_cond_3 kl_V2508t kl_V2508th kl_V2508tt = do !kl_if_4 <- let pat_cond_5 kl_V2508tt kl_V2508tth kl_V2508ttt = do !kl_if_6 <- kl_V2508tth `pseq` kl_tupleP kl_V2508tth !kl_if_7 <- case kl_if_6 of Atom (B (True)) -> do let !appl_8 = Atom Nil !appl_9 <- kl_V2508tth `pseq` kl_fst kl_V2508tth !kl_if_10 <- appl_8 `pseq` (appl_9 `pseq` eq appl_8 appl_9) !kl_if_11 <- case kl_if_10 of Atom (B (True)) -> do let !appl_12 = Atom Nil !kl_if_13 <- appl_12 `pseq` (kl_V2508ttt `pseq` eq appl_12 kl_V2508ttt) case kl_if_13 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_11 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_7 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_14 = do do return (Atom (B False)) in case kl_V2508tt of !(kl_V2508tt@(Cons (!kl_V2508tth) (!kl_V2508ttt))) -> pat_cond_5 kl_V2508tt kl_V2508tth kl_V2508ttt _ -> pat_cond_14 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_15 = do do return (Atom (B False)) in case kl_V2508t of !(kl_V2508t@(Cons (!kl_V2508th) (!kl_V2508tt))) -> pat_cond_3 kl_V2508t kl_V2508th kl_V2508tt _ -> pat_cond_15 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_16 = do do return (Atom (B False)) in case kl_V2508 of !(kl_V2508@(Cons (!kl_V2508h) (!kl_V2508t))) -> pat_cond_1 kl_V2508 kl_V2508h kl_V2508t _ -> pat_cond_16 case kl_if_0 of Atom (B (True)) -> do let !appl_17 = ApplC (Func "lambda" (Context (\(!kl_Q) -> do let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_NewConclusion) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_NewPremises) -> do !appl_20 <- kl_V2508 `pseq` hd kl_V2508 let !appl_21 = Atom Nil !appl_22 <- kl_NewConclusion `pseq` (appl_21 `pseq` klCons kl_NewConclusion appl_21) !appl_23 <- kl_NewPremises `pseq` (appl_22 `pseq` klCons kl_NewPremises appl_22) !appl_24 <- appl_20 `pseq` (appl_23 `pseq` klCons appl_20 appl_23) appl_24 `pseq` kl_Atp (Core.Types.Atom (Core.Types.UnboundSym "shen.single")) appl_24))) let !appl_25 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_right_RBleft kl_X))) !appl_26 <- kl_V2508 `pseq` tl kl_V2508 !appl_27 <- appl_26 `pseq` hd appl_26 !appl_28 <- appl_25 `pseq` (appl_27 `pseq` kl_map appl_25 appl_27) !appl_29 <- appl_28 `pseq` (kl_Q `pseq` kl_Atp appl_28 kl_Q) let !appl_30 = Atom Nil !appl_31 <- appl_29 `pseq` (appl_30 `pseq` klCons appl_29 appl_30) appl_31 `pseq` applyWrapper appl_19 [appl_31]))) !appl_32 <- kl_V2508 `pseq` tl kl_V2508 !appl_33 <- appl_32 `pseq` tl appl_32 !appl_34 <- appl_33 `pseq` hd appl_33 !appl_35 <- appl_34 `pseq` kl_snd appl_34 let !appl_36 = Atom Nil !appl_37 <- appl_35 `pseq` (appl_36 `pseq` klCons appl_35 appl_36) !appl_38 <- appl_37 `pseq` (kl_Q `pseq` kl_Atp appl_37 kl_Q) appl_38 `pseq` applyWrapper appl_18 [appl_38]))) !appl_39 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "Qv")) appl_39 `pseq` applyWrapper appl_17 [appl_39] Atom (B (False)) -> do do let !aw_40 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_40 [ApplC (wrapNamed "shen.left-rule" kl_shen_left_rule)] _ -> throwError "if: expected boolean" kl_shen_right_RBleft :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_right_RBleft (!kl_V2514) = do !kl_if_0 <- kl_V2514 `pseq` kl_tupleP kl_V2514 !kl_if_1 <- case kl_if_0 of Atom (B (True)) -> do let !appl_2 = Atom Nil !appl_3 <- kl_V2514 `pseq` kl_fst kl_V2514 !kl_if_4 <- appl_2 `pseq` (appl_3 `pseq` eq appl_2 appl_3) case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_1 of Atom (B (True)) -> do kl_V2514 `pseq` kl_snd kl_V2514 Atom (B (False)) -> do do simpleError (Core.Types.Atom (Core.Types.Str "syntax error with ==========\n")) _ -> throwError "if: expected boolean" kl_shen_rule_RBhorn_clause :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_rule_RBhorn_clause (!kl_V2517) (!kl_V2518) = do !kl_if_0 <- let pat_cond_1 kl_V2518 kl_V2518h kl_V2518t = do !kl_if_2 <- let pat_cond_3 kl_V2518t kl_V2518th kl_V2518tt = do !kl_if_4 <- let pat_cond_5 kl_V2518tt kl_V2518tth kl_V2518ttt = do !kl_if_6 <- kl_V2518tth `pseq` kl_tupleP kl_V2518tth !kl_if_7 <- case kl_if_6 of Atom (B (True)) -> do let !appl_8 = Atom Nil !kl_if_9 <- appl_8 `pseq` (kl_V2518ttt `pseq` eq appl_8 kl_V2518ttt) case kl_if_9 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_7 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_10 = do do return (Atom (B False)) in case kl_V2518tt of !(kl_V2518tt@(Cons (!kl_V2518tth) (!kl_V2518ttt))) -> pat_cond_5 kl_V2518tt kl_V2518tth kl_V2518ttt _ -> pat_cond_10 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_11 = do do return (Atom (B False)) in case kl_V2518t of !(kl_V2518t@(Cons (!kl_V2518th) (!kl_V2518tt))) -> pat_cond_3 kl_V2518t kl_V2518th kl_V2518tt _ -> pat_cond_11 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_12 = do do return (Atom (B False)) in case kl_V2518 of !(kl_V2518@(Cons (!kl_V2518h) (!kl_V2518t))) -> pat_cond_1 kl_V2518 kl_V2518h kl_V2518t _ -> pat_cond_12 case kl_if_0 of Atom (B (True)) -> do !appl_13 <- kl_V2518 `pseq` tl kl_V2518 !appl_14 <- appl_13 `pseq` tl appl_13 !appl_15 <- appl_14 `pseq` hd appl_14 !appl_16 <- appl_15 `pseq` kl_snd appl_15 !appl_17 <- kl_V2517 `pseq` (appl_16 `pseq` kl_shen_rule_RBhorn_clause_head kl_V2517 appl_16) !appl_18 <- kl_V2518 `pseq` hd kl_V2518 !appl_19 <- kl_V2518 `pseq` tl kl_V2518 !appl_20 <- appl_19 `pseq` hd appl_19 !appl_21 <- kl_V2518 `pseq` tl kl_V2518 !appl_22 <- appl_21 `pseq` tl appl_21 !appl_23 <- appl_22 `pseq` hd appl_22 !appl_24 <- appl_23 `pseq` kl_fst appl_23 !appl_25 <- appl_18 `pseq` (appl_20 `pseq` (appl_24 `pseq` kl_shen_rule_RBhorn_clause_body appl_18 appl_20 appl_24)) let !appl_26 = Atom Nil !appl_27 <- appl_25 `pseq` (appl_26 `pseq` klCons appl_25 appl_26) !appl_28 <- appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":-")) appl_27 appl_17 `pseq` (appl_28 `pseq` klCons appl_17 appl_28) Atom (B (False)) -> do do let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_29 [ApplC (wrapNamed "shen.rule->horn-clause" kl_shen_rule_RBhorn_clause)] _ -> throwError "if: expected boolean" kl_shen_rule_RBhorn_clause_head :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_rule_RBhorn_clause_head (!kl_V2521) (!kl_V2522) = do !appl_0 <- kl_V2522 `pseq` kl_shen_mode_ify kl_V2522 let !appl_1 = Atom Nil !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Context_1957")) appl_1 !appl_3 <- appl_0 `pseq` (appl_2 `pseq` klCons appl_0 appl_2) kl_V2521 `pseq` (appl_3 `pseq` klCons kl_V2521 appl_3) kl_shen_mode_ify :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_mode_ify (!kl_V2524) = do !kl_if_0 <- let pat_cond_1 kl_V2524 kl_V2524h kl_V2524t = do !kl_if_2 <- let pat_cond_3 kl_V2524t kl_V2524th kl_V2524tt = do !kl_if_4 <- let pat_cond_5 = do !kl_if_6 <- let pat_cond_7 kl_V2524tt kl_V2524tth kl_V2524ttt = do let !appl_8 = Atom Nil !kl_if_9 <- appl_8 `pseq` (kl_V2524ttt `pseq` eq appl_8 kl_V2524ttt) case kl_if_9 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_10 = do do return (Atom (B False)) in case kl_V2524tt of !(kl_V2524tt@(Cons (!kl_V2524tth) (!kl_V2524ttt))) -> pat_cond_7 kl_V2524tt kl_V2524tth kl_V2524ttt _ -> pat_cond_10 case kl_if_6 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_11 = do do return (Atom (B False)) in case kl_V2524th of kl_V2524th@(Atom (UnboundSym ":")) -> pat_cond_5 kl_V2524th@(ApplC (PL ":" _)) -> pat_cond_5 kl_V2524th@(ApplC (Func ":" _)) -> pat_cond_5 _ -> pat_cond_11 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_12 = do do return (Atom (B False)) in case kl_V2524t of !(kl_V2524t@(Cons (!kl_V2524th) (!kl_V2524tt))) -> pat_cond_3 kl_V2524t kl_V2524th kl_V2524tt _ -> pat_cond_12 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_13 = do do return (Atom (B False)) in case kl_V2524 of !(kl_V2524@(Cons (!kl_V2524h) (!kl_V2524t))) -> pat_cond_1 kl_V2524 kl_V2524h kl_V2524t _ -> pat_cond_13 case kl_if_0 of Atom (B (True)) -> do !appl_14 <- kl_V2524 `pseq` hd kl_V2524 !appl_15 <- kl_V2524 `pseq` tl kl_V2524 !appl_16 <- appl_15 `pseq` tl appl_15 !appl_17 <- appl_16 `pseq` hd appl_16 let !appl_18 = Atom Nil !appl_19 <- appl_18 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_18 !appl_20 <- appl_17 `pseq` (appl_19 `pseq` klCons appl_17 appl_19) !appl_21 <- appl_20 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "mode")) appl_20 let !appl_22 = Atom Nil !appl_23 <- appl_21 `pseq` (appl_22 `pseq` klCons appl_21 appl_22) !appl_24 <- appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":")) appl_23 !appl_25 <- appl_14 `pseq` (appl_24 `pseq` klCons appl_14 appl_24) let !appl_26 = Atom Nil !appl_27 <- appl_26 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_26 !appl_28 <- appl_25 `pseq` (appl_27 `pseq` klCons appl_25 appl_27) appl_28 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "mode")) appl_28 Atom (B (False)) -> do do return kl_V2524 _ -> throwError "if: expected boolean" kl_shen_rule_RBhorn_clause_body :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_rule_RBhorn_clause_body (!kl_V2528) (!kl_V2529) (!kl_V2530) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Variables) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Predicates) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_SearchLiterals) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_SearchClauses) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_SideLiterals) -> do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_PremissLiterals) -> do !appl_6 <- kl_SideLiterals `pseq` (kl_PremissLiterals `pseq` kl_append kl_SideLiterals kl_PremissLiterals) kl_SearchLiterals `pseq` (appl_6 `pseq` kl_append kl_SearchLiterals appl_6)))) let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_8 <- kl_V2530 `pseq` kl_emptyP kl_V2530 kl_X `pseq` (appl_8 `pseq` kl_shen_construct_premiss_literal kl_X appl_8)))) !appl_9 <- appl_7 `pseq` (kl_V2529 `pseq` kl_map appl_7 kl_V2529) appl_9 `pseq` applyWrapper appl_5 [appl_9]))) !appl_10 <- kl_V2528 `pseq` kl_shen_construct_side_literals kl_V2528 appl_10 `pseq` applyWrapper appl_4 [appl_10]))) !appl_11 <- kl_Predicates `pseq` (kl_V2530 `pseq` (kl_Variables `pseq` kl_shen_construct_search_clauses kl_Predicates kl_V2530 kl_Variables)) appl_11 `pseq` applyWrapper appl_3 [appl_11]))) !appl_12 <- kl_Predicates `pseq` (kl_Variables `pseq` kl_shen_construct_search_literals kl_Predicates kl_Variables (Core.Types.Atom (Core.Types.UnboundSym "Context_1957")) (Core.Types.Atom (Core.Types.UnboundSym "Context1_1957"))) appl_12 `pseq` applyWrapper appl_2 [appl_12]))) let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "shen.cl"))))) !appl_14 <- appl_13 `pseq` (kl_V2530 `pseq` kl_map appl_13 kl_V2530) appl_14 `pseq` applyWrapper appl_1 [appl_14]))) let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_extract_vars kl_X))) !appl_16 <- appl_15 `pseq` (kl_V2530 `pseq` kl_map appl_15 kl_V2530) appl_16 `pseq` applyWrapper appl_0 [appl_16] kl_shen_construct_search_literals :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_construct_search_literals (!kl_V2539) (!kl_V2540) (!kl_V2541) (!kl_V2542) = do let !appl_0 = Atom Nil !kl_if_1 <- appl_0 `pseq` (kl_V2539 `pseq` eq appl_0 kl_V2539) !kl_if_2 <- case kl_if_1 of Atom (B (True)) -> do let !appl_3 = Atom Nil !kl_if_4 <- appl_3 `pseq` (kl_V2540 `pseq` eq appl_3 kl_V2540) case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_2 of Atom (B (True)) -> do return (Atom Nil) Atom (B (False)) -> do do kl_V2539 `pseq` (kl_V2540 `pseq` (kl_V2541 `pseq` (kl_V2542 `pseq` kl_shen_csl_help kl_V2539 kl_V2540 kl_V2541 kl_V2542))) _ -> throwError "if: expected boolean" kl_shen_csl_help :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_csl_help (!kl_V2549) (!kl_V2550) (!kl_V2551) (!kl_V2552) = do let !appl_0 = Atom Nil !kl_if_1 <- appl_0 `pseq` (kl_V2549 `pseq` eq appl_0 kl_V2549) !kl_if_2 <- case kl_if_1 of Atom (B (True)) -> do let !appl_3 = Atom Nil !kl_if_4 <- appl_3 `pseq` (kl_V2550 `pseq` eq appl_3 kl_V2550) case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_2 of Atom (B (True)) -> do let !appl_5 = Atom Nil !appl_6 <- kl_V2551 `pseq` (appl_5 `pseq` klCons kl_V2551 appl_5) !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "ContextOut_1957")) appl_6 !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "bind")) appl_7 let !appl_9 = Atom Nil appl_8 `pseq` (appl_9 `pseq` klCons appl_8 appl_9) Atom (B (False)) -> do !kl_if_10 <- let pat_cond_11 kl_V2549 kl_V2549h kl_V2549t = do let pat_cond_12 kl_V2550 kl_V2550h kl_V2550t = do return (Atom (B True)) pat_cond_13 = do do return (Atom (B False)) in case kl_V2550 of !(kl_V2550@(Cons (!kl_V2550h) (!kl_V2550t))) -> pat_cond_12 kl_V2550 kl_V2550h kl_V2550t _ -> pat_cond_13 pat_cond_14 = do do return (Atom (B False)) in case kl_V2549 of !(kl_V2549@(Cons (!kl_V2549h) (!kl_V2549t))) -> pat_cond_11 kl_V2549 kl_V2549h kl_V2549t _ -> pat_cond_14 case kl_if_10 of Atom (B (True)) -> do !appl_15 <- kl_V2549 `pseq` hd kl_V2549 !appl_16 <- kl_V2550 `pseq` hd kl_V2550 !appl_17 <- kl_V2552 `pseq` (appl_16 `pseq` klCons kl_V2552 appl_16) !appl_18 <- kl_V2551 `pseq` (appl_17 `pseq` klCons kl_V2551 appl_17) !appl_19 <- appl_15 `pseq` (appl_18 `pseq` klCons appl_15 appl_18) !appl_20 <- kl_V2549 `pseq` tl kl_V2549 !appl_21 <- kl_V2550 `pseq` tl kl_V2550 !appl_22 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "Context")) !appl_23 <- appl_20 `pseq` (appl_21 `pseq` (kl_V2552 `pseq` (appl_22 `pseq` kl_shen_csl_help appl_20 appl_21 kl_V2552 appl_22))) appl_19 `pseq` (appl_23 `pseq` klCons appl_19 appl_23) Atom (B (False)) -> do do let !aw_24 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_24 [ApplC (wrapNamed "shen.csl-help" kl_shen_csl_help)] _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" kl_shen_construct_search_clauses :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_construct_search_clauses (!kl_V2556) (!kl_V2557) (!kl_V2558) = do let !appl_0 = Atom Nil !kl_if_1 <- appl_0 `pseq` (kl_V2556 `pseq` eq appl_0 kl_V2556) !kl_if_2 <- case kl_if_1 of Atom (B (True)) -> do let !appl_3 = Atom Nil !kl_if_4 <- appl_3 `pseq` (kl_V2557 `pseq` eq appl_3 kl_V2557) !kl_if_5 <- case kl_if_4 of Atom (B (True)) -> do let !appl_6 = Atom Nil !kl_if_7 <- appl_6 `pseq` (kl_V2558 `pseq` eq appl_6 kl_V2558) case kl_if_7 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_5 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_2 of Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) Atom (B (False)) -> do !kl_if_8 <- let pat_cond_9 kl_V2556 kl_V2556h kl_V2556t = do !kl_if_10 <- let pat_cond_11 kl_V2557 kl_V2557h kl_V2557t = do let pat_cond_12 kl_V2558 kl_V2558h kl_V2558t = do return (Atom (B True)) pat_cond_13 = do do return (Atom (B False)) in case kl_V2558 of !(kl_V2558@(Cons (!kl_V2558h) (!kl_V2558t))) -> pat_cond_12 kl_V2558 kl_V2558h kl_V2558t _ -> pat_cond_13 pat_cond_14 = do do return (Atom (B False)) in case kl_V2557 of !(kl_V2557@(Cons (!kl_V2557h) (!kl_V2557t))) -> pat_cond_11 kl_V2557 kl_V2557h kl_V2557t _ -> pat_cond_14 case kl_if_10 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_15 = do do return (Atom (B False)) in case kl_V2556 of !(kl_V2556@(Cons (!kl_V2556h) (!kl_V2556t))) -> pat_cond_9 kl_V2556 kl_V2556h kl_V2556t _ -> pat_cond_15 case kl_if_8 of Atom (B (True)) -> do !appl_16 <- kl_V2556 `pseq` hd kl_V2556 !appl_17 <- kl_V2557 `pseq` hd kl_V2557 !appl_18 <- kl_V2558 `pseq` hd kl_V2558 !appl_19 <- appl_16 `pseq` (appl_17 `pseq` (appl_18 `pseq` kl_shen_construct_search_clause appl_16 appl_17 appl_18)) !appl_20 <- kl_V2556 `pseq` tl kl_V2556 !appl_21 <- kl_V2557 `pseq` tl kl_V2557 !appl_22 <- kl_V2558 `pseq` tl kl_V2558 !appl_23 <- appl_20 `pseq` (appl_21 `pseq` (appl_22 `pseq` kl_shen_construct_search_clauses appl_20 appl_21 appl_22)) appl_19 `pseq` (appl_23 `pseq` kl_do appl_19 appl_23) Atom (B (False)) -> do do let !aw_24 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_24 [ApplC (wrapNamed "shen.construct-search-clauses" kl_shen_construct_search_clauses)] _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" kl_shen_construct_search_clause :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_construct_search_clause (!kl_V2562) (!kl_V2563) (!kl_V2564) = do !appl_0 <- kl_V2562 `pseq` (kl_V2563 `pseq` (kl_V2564 `pseq` kl_shen_construct_base_search_clause kl_V2562 kl_V2563 kl_V2564)) !appl_1 <- kl_V2562 `pseq` (kl_V2563 `pseq` (kl_V2564 `pseq` kl_shen_construct_recursive_search_clause kl_V2562 kl_V2563 kl_V2564)) let !appl_2 = Atom Nil !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) !appl_4 <- appl_0 `pseq` (appl_3 `pseq` klCons appl_0 appl_3) let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.s-prolog") appl_4 `pseq` applyWrapper aw_5 [appl_4] kl_shen_construct_base_search_clause :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_construct_base_search_clause (!kl_V2568) (!kl_V2569) (!kl_V2570) = do !appl_0 <- kl_V2569 `pseq` kl_shen_mode_ify kl_V2569 !appl_1 <- appl_0 `pseq` klCons appl_0 (Core.Types.Atom (Core.Types.UnboundSym "In_1957")) !appl_2 <- kl_V2570 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "In_1957")) kl_V2570 !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) !appl_4 <- kl_V2568 `pseq` (appl_3 `pseq` klCons kl_V2568 appl_3) let !appl_5 = Atom Nil let !appl_6 = Atom Nil !appl_7 <- appl_5 `pseq` (appl_6 `pseq` klCons appl_5 appl_6) !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":-")) appl_7 appl_4 `pseq` (appl_8 `pseq` klCons appl_4 appl_8) kl_shen_construct_recursive_search_clause :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_construct_recursive_search_clause (!kl_V2574) (!kl_V2575) (!kl_V2576) = do !appl_0 <- klCons (Core.Types.Atom (Core.Types.UnboundSym "Assumption_1957")) (Core.Types.Atom (Core.Types.UnboundSym "Assumptions_1957")) !appl_1 <- klCons (Core.Types.Atom (Core.Types.UnboundSym "Assumption_1957")) (Core.Types.Atom (Core.Types.UnboundSym "Out_1957")) !appl_2 <- appl_1 `pseq` (kl_V2576 `pseq` klCons appl_1 kl_V2576) !appl_3 <- appl_0 `pseq` (appl_2 `pseq` klCons appl_0 appl_2) !appl_4 <- kl_V2574 `pseq` (appl_3 `pseq` klCons kl_V2574 appl_3) !appl_5 <- kl_V2576 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Out_1957")) kl_V2576 !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Assumptions_1957")) appl_5 !appl_7 <- kl_V2574 `pseq` (appl_6 `pseq` klCons kl_V2574 appl_6) let !appl_8 = Atom Nil !appl_9 <- appl_7 `pseq` (appl_8 `pseq` klCons appl_7 appl_8) let !appl_10 = Atom Nil !appl_11 <- appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":-")) appl_11 appl_4 `pseq` (appl_12 `pseq` klCons appl_4 appl_12) kl_shen_construct_side_literals :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_construct_side_literals (!kl_V2582) = do let !appl_0 = Atom Nil !kl_if_1 <- appl_0 `pseq` (kl_V2582 `pseq` eq appl_0 kl_V2582) case kl_if_1 of Atom (B (True)) -> do return (Atom Nil) Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V2582 kl_V2582h kl_V2582t = do !kl_if_4 <- let pat_cond_5 kl_V2582h kl_V2582hh kl_V2582ht = do !kl_if_6 <- let pat_cond_7 = do !kl_if_8 <- let pat_cond_9 kl_V2582ht kl_V2582hth kl_V2582htt = do let !appl_10 = Atom Nil !kl_if_11 <- appl_10 `pseq` (kl_V2582htt `pseq` eq appl_10 kl_V2582htt) case kl_if_11 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_12 = do do return (Atom (B False)) in case kl_V2582ht of !(kl_V2582ht@(Cons (!kl_V2582hth) (!kl_V2582htt))) -> pat_cond_9 kl_V2582ht kl_V2582hth kl_V2582htt _ -> pat_cond_12 case kl_if_8 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_13 = do do return (Atom (B False)) in case kl_V2582hh of kl_V2582hh@(Atom (UnboundSym "if")) -> pat_cond_7 kl_V2582hh@(ApplC (PL "if" _)) -> pat_cond_7 kl_V2582hh@(ApplC (Func "if" _)) -> pat_cond_7 _ -> pat_cond_13 case kl_if_6 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_14 = do do return (Atom (B False)) in case kl_V2582h of !(kl_V2582h@(Cons (!kl_V2582hh) (!kl_V2582ht))) -> pat_cond_5 kl_V2582h kl_V2582hh kl_V2582ht _ -> pat_cond_14 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_15 = do do return (Atom (B False)) in case kl_V2582 of !(kl_V2582@(Cons (!kl_V2582h) (!kl_V2582t))) -> pat_cond_3 kl_V2582 kl_V2582h kl_V2582t _ -> pat_cond_15 case kl_if_2 of Atom (B (True)) -> do !appl_16 <- kl_V2582 `pseq` hd kl_V2582 !appl_17 <- appl_16 `pseq` tl appl_16 !appl_18 <- appl_17 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "when")) appl_17 !appl_19 <- kl_V2582 `pseq` tl kl_V2582 !appl_20 <- appl_19 `pseq` kl_shen_construct_side_literals appl_19 appl_18 `pseq` (appl_20 `pseq` klCons appl_18 appl_20) Atom (B (False)) -> do !kl_if_21 <- let pat_cond_22 kl_V2582 kl_V2582h kl_V2582t = do !kl_if_23 <- let pat_cond_24 kl_V2582h kl_V2582hh kl_V2582ht = do !kl_if_25 <- let pat_cond_26 = do !kl_if_27 <- let pat_cond_28 kl_V2582ht kl_V2582hth kl_V2582htt = do !kl_if_29 <- let pat_cond_30 kl_V2582htt kl_V2582htth kl_V2582httt = do let !appl_31 = Atom Nil !kl_if_32 <- appl_31 `pseq` (kl_V2582httt `pseq` eq appl_31 kl_V2582httt) case kl_if_32 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_33 = do do return (Atom (B False)) in case kl_V2582htt of !(kl_V2582htt@(Cons (!kl_V2582htth) (!kl_V2582httt))) -> pat_cond_30 kl_V2582htt kl_V2582htth kl_V2582httt _ -> pat_cond_33 case kl_if_29 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_34 = do do return (Atom (B False)) in case kl_V2582ht of !(kl_V2582ht@(Cons (!kl_V2582hth) (!kl_V2582htt))) -> pat_cond_28 kl_V2582ht kl_V2582hth kl_V2582htt _ -> pat_cond_34 case kl_if_27 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_35 = do do return (Atom (B False)) in case kl_V2582hh of kl_V2582hh@(Atom (UnboundSym "let")) -> pat_cond_26 kl_V2582hh@(ApplC (PL "let" _)) -> pat_cond_26 kl_V2582hh@(ApplC (Func "let" _)) -> pat_cond_26 _ -> pat_cond_35 case kl_if_25 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_36 = do do return (Atom (B False)) in case kl_V2582h of !(kl_V2582h@(Cons (!kl_V2582hh) (!kl_V2582ht))) -> pat_cond_24 kl_V2582h kl_V2582hh kl_V2582ht _ -> pat_cond_36 case kl_if_23 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_37 = do do return (Atom (B False)) in case kl_V2582 of !(kl_V2582@(Cons (!kl_V2582h) (!kl_V2582t))) -> pat_cond_22 kl_V2582 kl_V2582h kl_V2582t _ -> pat_cond_37 case kl_if_21 of Atom (B (True)) -> do !appl_38 <- kl_V2582 `pseq` hd kl_V2582 !appl_39 <- appl_38 `pseq` tl appl_38 !appl_40 <- appl_39 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "is")) appl_39 !appl_41 <- kl_V2582 `pseq` tl kl_V2582 !appl_42 <- appl_41 `pseq` kl_shen_construct_side_literals appl_41 appl_40 `pseq` (appl_42 `pseq` klCons appl_40 appl_42) Atom (B (False)) -> do let pat_cond_43 kl_V2582 kl_V2582h kl_V2582t = do kl_V2582t `pseq` kl_shen_construct_side_literals kl_V2582t pat_cond_44 = do do let !aw_45 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_45 [ApplC (wrapNamed "shen.construct-side-literals" kl_shen_construct_side_literals)] in case kl_V2582 of !(kl_V2582@(Cons (!kl_V2582h) (!kl_V2582t))) -> pat_cond_43 kl_V2582 kl_V2582h kl_V2582t _ -> pat_cond_44 _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" kl_shen_construct_premiss_literal :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_construct_premiss_literal (!kl_V2589) (!kl_V2590) = do !kl_if_0 <- kl_V2589 `pseq` kl_tupleP kl_V2589 case kl_if_0 of Atom (B (True)) -> do !appl_1 <- kl_V2589 `pseq` kl_snd kl_V2589 !appl_2 <- appl_1 `pseq` kl_shen_recursive_cons_form appl_1 !appl_3 <- kl_V2589 `pseq` kl_fst kl_V2589 !appl_4 <- kl_V2590 `pseq` (appl_3 `pseq` kl_shen_construct_context kl_V2590 appl_3) let !appl_5 = Atom Nil !appl_6 <- appl_4 `pseq` (appl_5 `pseq` klCons appl_4 appl_5) !appl_7 <- appl_2 `pseq` (appl_6 `pseq` klCons appl_2 appl_6) appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.t*")) appl_7 Atom (B (False)) -> do let pat_cond_8 = do let !appl_9 = Atom Nil !appl_10 <- appl_9 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Throwcontrol")) appl_9 appl_10 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "cut")) appl_10 pat_cond_11 = do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_12 [ApplC (wrapNamed "shen.construct-premiss-literal" kl_shen_construct_premiss_literal)] in case kl_V2589 of kl_V2589@(Atom (UnboundSym "!")) -> pat_cond_8 kl_V2589@(ApplC (PL "!" _)) -> pat_cond_8 kl_V2589@(ApplC (Func "!" _)) -> pat_cond_8 _ -> pat_cond_11 _ -> throwError "if: expected boolean" kl_shen_construct_context :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_construct_context (!kl_V2593) (!kl_V2594) = do !kl_if_0 <- let pat_cond_1 = do let !appl_2 = Atom Nil !kl_if_3 <- appl_2 `pseq` (kl_V2594 `pseq` eq appl_2 kl_V2594) case kl_if_3 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_4 = do do return (Atom (B False)) in case kl_V2593 of kl_V2593@(Atom (UnboundSym "true")) -> pat_cond_1 kl_V2593@(Atom (B (True))) -> pat_cond_1 _ -> pat_cond_4 case kl_if_0 of Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "Context_1957")) Atom (B (False)) -> do !kl_if_5 <- let pat_cond_6 = do let !appl_7 = Atom Nil !kl_if_8 <- appl_7 `pseq` (kl_V2594 `pseq` eq appl_7 kl_V2594) case kl_if_8 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_9 = do do return (Atom (B False)) in case kl_V2593 of kl_V2593@(Atom (UnboundSym "false")) -> pat_cond_6 kl_V2593@(Atom (B (False))) -> pat_cond_6 _ -> pat_cond_9 case kl_if_5 of Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "ContextOut_1957")) Atom (B (False)) -> do let pat_cond_10 kl_V2594 kl_V2594h kl_V2594t = do !appl_11 <- kl_V2594h `pseq` kl_shen_recursive_cons_form kl_V2594h !appl_12 <- kl_V2593 `pseq` (kl_V2594t `pseq` kl_shen_construct_context kl_V2593 kl_V2594t) let !appl_13 = Atom Nil !appl_14 <- appl_12 `pseq` (appl_13 `pseq` klCons appl_12 appl_13) !appl_15 <- appl_11 `pseq` (appl_14 `pseq` klCons appl_11 appl_14) appl_15 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_15 pat_cond_16 = do do let !aw_17 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_17 [ApplC (wrapNamed "shen.construct-context" kl_shen_construct_context)] in case kl_V2594 of !(kl_V2594@(Cons (!kl_V2594h) (!kl_V2594t))) -> pat_cond_10 kl_V2594 kl_V2594h kl_V2594t _ -> pat_cond_16 _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" kl_shen_recursive_cons_form :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_recursive_cons_form (!kl_V2596) = do let pat_cond_0 kl_V2596 kl_V2596h kl_V2596t = do !appl_1 <- kl_V2596h `pseq` kl_shen_recursive_cons_form kl_V2596h !appl_2 <- kl_V2596t `pseq` kl_shen_recursive_cons_form kl_V2596t let !appl_3 = Atom Nil !appl_4 <- appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) !appl_5 <- appl_1 `pseq` (appl_4 `pseq` klCons appl_1 appl_4) appl_5 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_5 pat_cond_6 = do do return kl_V2596 in case kl_V2596 of !(kl_V2596@(Cons (!kl_V2596h) (!kl_V2596t))) -> pat_cond_0 kl_V2596 kl_V2596h kl_V2596t _ -> pat_cond_6 kl_preclude :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_preclude (!kl_V2598) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.intern-type") kl_X `pseq` applyWrapper aw_1 [kl_X]))) !appl_2 <- appl_0 `pseq` (kl_V2598 `pseq` kl_map appl_0 kl_V2598) appl_2 `pseq` kl_shen_preclude_h appl_2 kl_shen_preclude_h :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_preclude_h (!kl_V2600) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_FilterDatatypes) -> do value (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*"))))) !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) !appl_2 <- appl_1 `pseq` (kl_V2600 `pseq` kl_difference appl_1 kl_V2600) !appl_3 <- appl_2 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) appl_2 appl_3 `pseq` applyWrapper appl_0 [appl_3] kl_include :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_include (!kl_V2602) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.intern-type") kl_X `pseq` applyWrapper aw_1 [kl_X]))) !appl_2 <- appl_0 `pseq` (kl_V2602 `pseq` kl_map appl_0 kl_V2602) appl_2 `pseq` kl_shen_include_h appl_2 kl_shen_include_h :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_include_h (!kl_V2604) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_ValidTypes) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_NewDatatypes) -> do value (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*"))))) !appl_2 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) !appl_3 <- kl_ValidTypes `pseq` (appl_2 `pseq` kl_union kl_ValidTypes appl_2) !appl_4 <- appl_3 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) appl_3 appl_4 `pseq` applyWrapper appl_1 [appl_4]))) !appl_5 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*alldatatypes*")) !appl_6 <- kl_V2604 `pseq` (appl_5 `pseq` kl_intersection kl_V2604 appl_5) appl_6 `pseq` applyWrapper appl_0 [appl_6] kl_preclude_all_but :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_preclude_all_but (!kl_V2606) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*alldatatypes*")) let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.intern-type") kl_X `pseq` applyWrapper aw_2 [kl_X]))) !appl_3 <- appl_1 `pseq` (kl_V2606 `pseq` kl_map appl_1 kl_V2606) !appl_4 <- appl_0 `pseq` (appl_3 `pseq` kl_difference appl_0 appl_3) appl_4 `pseq` kl_shen_preclude_h appl_4 kl_include_all_but :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_include_all_but (!kl_V2608) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*alldatatypes*")) let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.intern-type") kl_X `pseq` applyWrapper aw_2 [kl_X]))) !appl_3 <- appl_1 `pseq` (kl_V2608 `pseq` kl_map appl_1 kl_V2608) !appl_4 <- appl_0 `pseq` (appl_3 `pseq` kl_difference appl_0 appl_3) appl_4 `pseq` kl_shen_include_h appl_4 kl_shen_synonyms_help :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_synonyms_help (!kl_V2614) = do let !appl_0 = Atom Nil !kl_if_1 <- appl_0 `pseq` (kl_V2614 `pseq` eq appl_0 kl_V2614) case kl_if_1 of Atom (B (True)) -> do !appl_2 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*tc*")) let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_demod_rule kl_X))) !appl_4 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*synonyms*")) !appl_5 <- appl_3 `pseq` (appl_4 `pseq` kl_mapcan appl_3 appl_4) appl_2 `pseq` (appl_5 `pseq` kl_shen_update_demodulation_function appl_2 appl_5) Atom (B (False)) -> do let pat_cond_6 kl_V2614 kl_V2614h kl_V2614t kl_V2614th kl_V2614tt = do let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_Vs) -> do !kl_if_8 <- kl_Vs `pseq` kl_emptyP kl_Vs case kl_if_8 of Atom (B (True)) -> do let !appl_9 = Atom Nil !appl_10 <- kl_V2614th `pseq` (appl_9 `pseq` klCons kl_V2614th appl_9) !appl_11 <- kl_V2614h `pseq` (appl_10 `pseq` klCons kl_V2614h appl_10) !appl_12 <- appl_11 `pseq` kl_shen_pushnew appl_11 (Core.Types.Atom (Core.Types.UnboundSym "shen.*synonyms*")) !appl_13 <- kl_V2614tt `pseq` kl_shen_synonyms_help kl_V2614tt appl_12 `pseq` (appl_13 `pseq` kl_do appl_12 appl_13) Atom (B (False)) -> do do kl_V2614th `pseq` (kl_Vs `pseq` kl_shen_free_variable_warnings kl_V2614th kl_Vs) _ -> throwError "if: expected boolean"))) !appl_14 <- kl_V2614th `pseq` kl_shen_extract_vars kl_V2614th !appl_15 <- kl_V2614h `pseq` kl_shen_extract_vars kl_V2614h !appl_16 <- appl_14 `pseq` (appl_15 `pseq` kl_difference appl_14 appl_15) appl_16 `pseq` applyWrapper appl_7 [appl_16] pat_cond_17 = do do simpleError (Core.Types.Atom (Core.Types.Str "odd number of synonyms\n")) in case kl_V2614 of !(kl_V2614@(Cons (!kl_V2614h) (!(kl_V2614t@(Cons (!kl_V2614th) (!kl_V2614tt)))))) -> pat_cond_6 kl_V2614 kl_V2614h kl_V2614t kl_V2614th kl_V2614tt _ -> pat_cond_17 _ -> throwError "if: expected boolean" kl_shen_pushnew :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_pushnew (!kl_V2617) (!kl_V2618) = do !appl_0 <- kl_V2618 `pseq` value kl_V2618 !kl_if_1 <- kl_V2617 `pseq` (appl_0 `pseq` kl_elementP kl_V2617 appl_0) case kl_if_1 of Atom (B (True)) -> do kl_V2618 `pseq` value kl_V2618 Atom (B (False)) -> do do !appl_2 <- kl_V2618 `pseq` value kl_V2618 !appl_3 <- kl_V2617 `pseq` (appl_2 `pseq` klCons kl_V2617 appl_2) kl_V2618 `pseq` (appl_3 `pseq` klSet kl_V2618 appl_3) _ -> throwError "if: expected boolean" kl_shen_demod_rule :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_demod_rule (!kl_V2620) = do !kl_if_0 <- let pat_cond_1 kl_V2620 kl_V2620h kl_V2620t = do !kl_if_2 <- let pat_cond_3 kl_V2620t kl_V2620th kl_V2620tt = do let !appl_4 = Atom Nil !kl_if_5 <- appl_4 `pseq` (kl_V2620tt `pseq` eq appl_4 kl_V2620tt) case kl_if_5 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_6 = do do return (Atom (B False)) in case kl_V2620t of !(kl_V2620t@(Cons (!kl_V2620th) (!kl_V2620tt))) -> pat_cond_3 kl_V2620t kl_V2620th kl_V2620tt _ -> pat_cond_6 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_7 = do do return (Atom (B False)) in case kl_V2620 of !(kl_V2620@(Cons (!kl_V2620h) (!kl_V2620t))) -> pat_cond_1 kl_V2620 kl_V2620h kl_V2620t _ -> pat_cond_7 case kl_if_0 of Atom (B (True)) -> do !appl_8 <- kl_V2620 `pseq` hd kl_V2620 let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.rcons_form") !appl_10 <- appl_8 `pseq` applyWrapper aw_9 [appl_8] !appl_11 <- kl_V2620 `pseq` tl kl_V2620 !appl_12 <- appl_11 `pseq` hd appl_11 let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "shen.rcons_form") !appl_14 <- appl_12 `pseq` applyWrapper aw_13 [appl_12] let !appl_15 = Atom Nil !appl_16 <- appl_14 `pseq` (appl_15 `pseq` klCons appl_14 appl_15) !appl_17 <- appl_16 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "->")) appl_16 appl_10 `pseq` (appl_17 `pseq` klCons appl_10 appl_17) Atom (B (False)) -> do do let !aw_18 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_18 [ApplC (wrapNamed "shen.demod-rule" kl_shen_demod_rule)] _ -> throwError "if: expected boolean" kl_shen_lambda_of_defun :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_lambda_of_defun (!kl_V2626) = do !kl_if_0 <- let pat_cond_1 kl_V2626 kl_V2626h kl_V2626t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V2626t kl_V2626th kl_V2626tt = do !kl_if_6 <- let pat_cond_7 kl_V2626tt kl_V2626tth kl_V2626ttt = do !kl_if_8 <- let pat_cond_9 kl_V2626tth kl_V2626tthh kl_V2626ttht = do let !appl_10 = Atom Nil !kl_if_11 <- appl_10 `pseq` (kl_V2626ttht `pseq` eq appl_10 kl_V2626ttht) !kl_if_12 <- case kl_if_11 of Atom (B (True)) -> do !kl_if_13 <- let pat_cond_14 kl_V2626ttt kl_V2626ttth kl_V2626tttt = do let !appl_15 = Atom Nil !kl_if_16 <- appl_15 `pseq` (kl_V2626tttt `pseq` eq appl_15 kl_V2626tttt) case kl_if_16 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_17 = do do return (Atom (B False)) in case kl_V2626ttt of !(kl_V2626ttt@(Cons (!kl_V2626ttth) (!kl_V2626tttt))) -> pat_cond_14 kl_V2626ttt kl_V2626ttth kl_V2626tttt _ -> pat_cond_17 case kl_if_13 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_12 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_18 = do do return (Atom (B False)) in case kl_V2626tth of !(kl_V2626tth@(Cons (!kl_V2626tthh) (!kl_V2626ttht))) -> pat_cond_9 kl_V2626tth kl_V2626tthh kl_V2626ttht _ -> pat_cond_18 case kl_if_8 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_19 = do do return (Atom (B False)) in case kl_V2626tt of !(kl_V2626tt@(Cons (!kl_V2626tth) (!kl_V2626ttt))) -> pat_cond_7 kl_V2626tt kl_V2626tth kl_V2626ttt _ -> pat_cond_19 case kl_if_6 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_20 = do do return (Atom (B False)) in case kl_V2626t of !(kl_V2626t@(Cons (!kl_V2626th) (!kl_V2626tt))) -> pat_cond_5 kl_V2626t kl_V2626th kl_V2626tt _ -> pat_cond_20 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_21 = do do return (Atom (B False)) in case kl_V2626h of kl_V2626h@(Atom (UnboundSym "defun")) -> pat_cond_3 kl_V2626h@(ApplC (PL "defun" _)) -> pat_cond_3 kl_V2626h@(ApplC (Func "defun" _)) -> pat_cond_3 _ -> pat_cond_21 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_22 = do do return (Atom (B False)) in case kl_V2626 of !(kl_V2626@(Cons (!kl_V2626h) (!kl_V2626t))) -> pat_cond_1 kl_V2626 kl_V2626h kl_V2626t _ -> pat_cond_22 case kl_if_0 of Atom (B (True)) -> do !appl_23 <- kl_V2626 `pseq` tl kl_V2626 !appl_24 <- appl_23 `pseq` tl appl_23 !appl_25 <- appl_24 `pseq` hd appl_24 !appl_26 <- appl_25 `pseq` hd appl_25 !appl_27 <- kl_V2626 `pseq` tl kl_V2626 !appl_28 <- appl_27 `pseq` tl appl_27 !appl_29 <- appl_28 `pseq` tl appl_28 !appl_30 <- appl_26 `pseq` (appl_29 `pseq` klCons appl_26 appl_29) !appl_31 <- appl_30 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_30 appl_31 `pseq` kl_eval appl_31 Atom (B (False)) -> do do let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") applyWrapper aw_32 [ApplC (wrapNamed "shen.lambda-of-defun" kl_shen_lambda_of_defun)] _ -> throwError "if: expected boolean" kl_shen_update_demodulation_function :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_update_demodulation_function (!kl_V2629) (!kl_V2630) = do !appl_0 <- kl_tc (ApplC (wrapNamed "-" Primitives.subtract)) !appl_1 <- kl_shen_default_rule !appl_2 <- kl_V2630 `pseq` (appl_1 `pseq` kl_append kl_V2630 appl_1) !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.demod")) appl_2 !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "define")) appl_3 !appl_5 <- appl_4 `pseq` kl_shen_elim_def appl_4 !appl_6 <- appl_5 `pseq` kl_shen_lambda_of_defun appl_5 !appl_7 <- appl_6 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*demodulation-function*")) appl_6 !appl_8 <- case kl_V2629 of Atom (B (True)) -> do kl_tc (ApplC (wrapNamed "+" add)) Atom (B (False)) -> do do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) _ -> throwError "if: expected boolean" !appl_9 <- appl_8 `pseq` kl_do appl_8 (Core.Types.Atom (Core.Types.UnboundSym "synonyms")) !appl_10 <- appl_7 `pseq` (appl_9 `pseq` kl_do appl_7 appl_9) appl_0 `pseq` (appl_10 `pseq` kl_do appl_0 appl_10) kl_shen_default_rule :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_default_rule = do let !appl_0 = Atom Nil !appl_1 <- appl_0 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_0 !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "->")) appl_1 appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_2 expr3 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue expr3 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E")))