{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Strict #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE ViewPatterns #-} module Backend.Core where import Control.Monad.Except import Control.Parallel import Environment import Primitives as Primitives import Backend.Utils import Types as Types import Utils import Wrap import Backend.Toplevel {- 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_shen_RBkl :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_shen_RBkl (!kl_V1186) (!kl_V1187) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBdefineRB kl_X))) !appl_1 <- kl_V1186 `pseq` (kl_V1187 `pseq` klCons kl_V1186 kl_V1187) let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_V1186 `pseq` (kl_X `pseq` kl_shen_shen_syntax_error kl_V1186 kl_X)))) let !aw_3 = Types.Atom (Types.UnboundSym "compile") appl_0 `pseq` (appl_1 `pseq` (appl_2 `pseq` applyWrapper aw_3 [appl_0, appl_1, appl_2])) kl_shen_shen_syntax_error :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_shen_syntax_error (!kl_V1190) (!kl_V1191) = do let !aw_0 = Types.Atom (Types.UnboundSym "shen.next-50") !appl_1 <- kl_V1191 `pseq` applyWrapper aw_0 [Types.Atom (Types.N (Types.KI 50)), kl_V1191] let !aw_2 = Types.Atom (Types.UnboundSym "shen.app") !appl_3 <- appl_1 `pseq` applyWrapper aw_2 [appl_1, Types.Atom (Types.Str "\n"), Types.Atom (Types.UnboundSym "shen.a")] !appl_4 <- appl_3 `pseq` cn (Types.Atom (Types.Str " here:\n\n ")) appl_3 let !aw_5 = Types.Atom (Types.UnboundSym "shen.app") !appl_6 <- kl_V1190 `pseq` (appl_4 `pseq` applyWrapper aw_5 [kl_V1190, appl_4, Types.Atom (Types.UnboundSym "shen.a")]) !appl_7 <- appl_6 `pseq` cn (Types.Atom (Types.Str "syntax error in ")) appl_6 appl_7 `pseq` simpleError appl_7 kl_shen_LBdefineRB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBdefineRB (!kl_V1193) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Types.Atom (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_LBnameRB) -> do let !aw_5 = Types.Atom (Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !appl_7 <- appl_6 `pseq` (kl_Parse_shen_LBnameRB `pseq` eq appl_6 kl_Parse_shen_LBnameRB) let !aw_8 = Types.Atom (Types.UnboundSym "not") !kl_if_9 <- appl_7 `pseq` applyWrapper aw_8 [appl_7] case kl_if_9 of Atom (B (True)) -> do let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBrulesRB) -> do let !aw_11 = Types.Atom (Types.UnboundSym "fail") !appl_12 <- applyWrapper aw_11 [] !appl_13 <- appl_12 `pseq` (kl_Parse_shen_LBrulesRB `pseq` eq appl_12 kl_Parse_shen_LBrulesRB) let !aw_14 = Types.Atom (Types.UnboundSym "not") !kl_if_15 <- appl_13 `pseq` applyWrapper aw_14 [appl_13] case kl_if_15 of Atom (B (True)) -> do !appl_16 <- kl_Parse_shen_LBrulesRB `pseq` hd kl_Parse_shen_LBrulesRB let !aw_17 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_18 <- kl_Parse_shen_LBnameRB `pseq` applyWrapper aw_17 [kl_Parse_shen_LBnameRB] let !aw_19 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_20 <- kl_Parse_shen_LBrulesRB `pseq` applyWrapper aw_19 [kl_Parse_shen_LBrulesRB] !appl_21 <- appl_18 `pseq` (appl_20 `pseq` kl_shen_compile_to_machine_code appl_18 appl_20) let !aw_22 = Types.Atom (Types.UnboundSym "shen.pair") appl_16 `pseq` (appl_21 `pseq` applyWrapper aw_22 [appl_16, appl_21]) Atom (B (False)) -> do do let !aw_23 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_23 [] _ -> throwError "if: expected boolean"))) !appl_24 <- kl_Parse_shen_LBnameRB `pseq` kl_shen_LBrulesRB kl_Parse_shen_LBnameRB appl_24 `pseq` applyWrapper appl_10 [appl_24] Atom (B (False)) -> do do let !aw_25 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_25 [] _ -> throwError "if: expected boolean"))) !appl_26 <- kl_V1193 `pseq` kl_shen_LBnameRB kl_V1193 appl_26 `pseq` applyWrapper appl_4 [appl_26] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_27 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnameRB) -> do let !aw_28 = Types.Atom (Types.UnboundSym "fail") !appl_29 <- applyWrapper aw_28 [] !appl_30 <- appl_29 `pseq` (kl_Parse_shen_LBnameRB `pseq` eq appl_29 kl_Parse_shen_LBnameRB) let !aw_31 = Types.Atom (Types.UnboundSym "not") !kl_if_32 <- appl_30 `pseq` applyWrapper aw_31 [appl_30] case kl_if_32 of Atom (B (True)) -> do let !appl_33 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsignatureRB) -> do let !aw_34 = Types.Atom (Types.UnboundSym "fail") !appl_35 <- applyWrapper aw_34 [] !appl_36 <- appl_35 `pseq` (kl_Parse_shen_LBsignatureRB `pseq` eq appl_35 kl_Parse_shen_LBsignatureRB) let !aw_37 = Types.Atom (Types.UnboundSym "not") !kl_if_38 <- appl_36 `pseq` applyWrapper aw_37 [appl_36] case kl_if_38 of Atom (B (True)) -> do let !appl_39 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBrulesRB) -> do let !aw_40 = Types.Atom (Types.UnboundSym "fail") !appl_41 <- applyWrapper aw_40 [] !appl_42 <- appl_41 `pseq` (kl_Parse_shen_LBrulesRB `pseq` eq appl_41 kl_Parse_shen_LBrulesRB) let !aw_43 = Types.Atom (Types.UnboundSym "not") !kl_if_44 <- appl_42 `pseq` applyWrapper aw_43 [appl_42] case kl_if_44 of Atom (B (True)) -> do !appl_45 <- kl_Parse_shen_LBrulesRB `pseq` hd kl_Parse_shen_LBrulesRB let !aw_46 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_47 <- kl_Parse_shen_LBnameRB `pseq` applyWrapper aw_46 [kl_Parse_shen_LBnameRB] let !aw_48 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_49 <- kl_Parse_shen_LBrulesRB `pseq` applyWrapper aw_48 [kl_Parse_shen_LBrulesRB] !appl_50 <- appl_47 `pseq` (appl_49 `pseq` kl_shen_compile_to_machine_code appl_47 appl_49) let !aw_51 = Types.Atom (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 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_52 [] _ -> throwError "if: expected boolean"))) !appl_53 <- kl_Parse_shen_LBsignatureRB `pseq` kl_shen_LBrulesRB kl_Parse_shen_LBsignatureRB appl_53 `pseq` applyWrapper appl_39 [appl_53] Atom (B (False)) -> do do let !aw_54 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_54 [] _ -> throwError "if: expected boolean"))) !appl_55 <- kl_Parse_shen_LBnameRB `pseq` kl_shen_LBsignatureRB kl_Parse_shen_LBnameRB appl_55 `pseq` applyWrapper appl_33 [appl_55] Atom (B (False)) -> do do let !aw_56 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_56 [] _ -> throwError "if: expected boolean"))) !appl_57 <- kl_V1193 `pseq` kl_shen_LBnameRB kl_V1193 !appl_58 <- appl_57 `pseq` applyWrapper appl_27 [appl_57] appl_58 `pseq` applyWrapper appl_0 [appl_58] kl_shen_LBnameRB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBnameRB (!kl_V1195) = do !appl_0 <- kl_V1195 `pseq` hd kl_V1195 !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 <- kl_V1195 `pseq` hd kl_V1195 !appl_4 <- appl_3 `pseq` tl appl_3 let !aw_5 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_6 <- kl_V1195 `pseq` applyWrapper aw_5 [kl_V1195] let !aw_7 = Types.Atom (Types.UnboundSym "shen.pair") !appl_8 <- appl_4 `pseq` (appl_6 `pseq` applyWrapper aw_7 [appl_4, appl_6]) !appl_9 <- appl_8 `pseq` hd appl_8 let !aw_10 = Types.Atom (Types.UnboundSym "symbol?") !kl_if_11 <- kl_Parse_X `pseq` applyWrapper aw_10 [kl_Parse_X] !kl_if_12 <- case kl_if_11 of Atom (B (True)) -> do !appl_13 <- kl_Parse_X `pseq` kl_shen_sysfuncP kl_Parse_X let !aw_14 = Types.Atom (Types.UnboundSym "not") !kl_if_15 <- appl_13 `pseq` applyWrapper aw_14 [appl_13] case kl_if_15 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_16 <- case kl_if_12 of Atom (B (True)) -> do return kl_Parse_X Atom (B (False)) -> do do let !aw_17 = Types.Atom (Types.UnboundSym "shen.app") !appl_18 <- kl_Parse_X `pseq` applyWrapper aw_17 [kl_Parse_X, Types.Atom (Types.Str " is not a legitimate function name.\n"), Types.Atom (Types.UnboundSym "shen.a")] appl_18 `pseq` simpleError appl_18 _ -> throwError "if: expected boolean" let !aw_19 = Types.Atom (Types.UnboundSym "shen.pair") appl_9 `pseq` (appl_16 `pseq` applyWrapper aw_19 [appl_9, appl_16])))) !appl_20 <- kl_V1195 `pseq` hd kl_V1195 !appl_21 <- appl_20 `pseq` hd appl_20 appl_21 `pseq` applyWrapper appl_2 [appl_21] Atom (B (False)) -> do do let !aw_22 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_22 [] _ -> throwError "if: expected boolean" kl_shen_sysfuncP :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_sysfuncP (!kl_V1197) = do !appl_0 <- intern (Types.Atom (Types.Str "shen")) !appl_1 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) let !aw_2 = Types.Atom (Types.UnboundSym "get") !appl_3 <- appl_0 `pseq` (appl_1 `pseq` applyWrapper aw_2 [appl_0, Types.Atom (Types.UnboundSym "shen.external-symbols"), appl_1]) let !aw_4 = Types.Atom (Types.UnboundSym "element?") kl_V1197 `pseq` (appl_3 `pseq` applyWrapper aw_4 [kl_V1197, appl_3]) kl_shen_LBsignatureRB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBsignatureRB (!kl_V1199) = do !appl_0 <- kl_V1199 `pseq` hd kl_V1199 !kl_if_1 <- appl_0 `pseq` consP appl_0 !kl_if_2 <- case kl_if_1 of Atom (B (True)) -> do !appl_3 <- kl_V1199 `pseq` hd kl_V1199 !appl_4 <- appl_3 `pseq` hd appl_3 !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.UnboundSym "{")) 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" case kl_if_2 of Atom (B (True)) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsignature_helpRB) -> do let !aw_7 = Types.Atom (Types.UnboundSym "fail") !appl_8 <- applyWrapper aw_7 [] !appl_9 <- appl_8 `pseq` (kl_Parse_shen_LBsignature_helpRB `pseq` eq appl_8 kl_Parse_shen_LBsignature_helpRB) let !aw_10 = Types.Atom (Types.UnboundSym "not") !kl_if_11 <- appl_9 `pseq` applyWrapper aw_10 [appl_9] case kl_if_11 of Atom (B (True)) -> do !appl_12 <- kl_Parse_shen_LBsignature_helpRB `pseq` hd kl_Parse_shen_LBsignature_helpRB !kl_if_13 <- appl_12 `pseq` consP appl_12 !kl_if_14 <- case kl_if_13 of Atom (B (True)) -> do !appl_15 <- kl_Parse_shen_LBsignature_helpRB `pseq` hd kl_Parse_shen_LBsignature_helpRB !appl_16 <- appl_15 `pseq` hd appl_15 !kl_if_17 <- appl_16 `pseq` eq (Types.Atom (Types.UnboundSym "}")) appl_16 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" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_14 of Atom (B (True)) -> do !appl_18 <- kl_Parse_shen_LBsignature_helpRB `pseq` hd kl_Parse_shen_LBsignature_helpRB !appl_19 <- appl_18 `pseq` tl appl_18 let !aw_20 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_21 <- kl_Parse_shen_LBsignature_helpRB `pseq` applyWrapper aw_20 [kl_Parse_shen_LBsignature_helpRB] let !aw_22 = Types.Atom (Types.UnboundSym "shen.pair") !appl_23 <- appl_19 `pseq` (appl_21 `pseq` applyWrapper aw_22 [appl_19, appl_21]) !appl_24 <- appl_23 `pseq` hd appl_23 let !aw_25 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_26 <- kl_Parse_shen_LBsignature_helpRB `pseq` applyWrapper aw_25 [kl_Parse_shen_LBsignature_helpRB] !appl_27 <- appl_26 `pseq` kl_shen_curry_type appl_26 let !aw_28 = Types.Atom (Types.UnboundSym "shen.demodulate") !appl_29 <- appl_27 `pseq` applyWrapper aw_28 [appl_27] let !aw_30 = Types.Atom (Types.UnboundSym "shen.pair") appl_24 `pseq` (appl_29 `pseq` applyWrapper aw_30 [appl_24, appl_29]) Atom (B (False)) -> do do let !aw_31 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_31 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_32 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_32 [] _ -> throwError "if: expected boolean"))) !appl_33 <- kl_V1199 `pseq` hd kl_V1199 !appl_34 <- appl_33 `pseq` tl appl_33 let !aw_35 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_36 <- kl_V1199 `pseq` applyWrapper aw_35 [kl_V1199] let !aw_37 = Types.Atom (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_LBsignature_helpRB appl_38 appl_39 `pseq` applyWrapper appl_6 [appl_39] Atom (B (False)) -> do do let !aw_40 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_40 [] _ -> throwError "if: expected boolean" kl_shen_curry_type :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_curry_type (!kl_V1201) = do let pat_cond_0 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt = do !appl_1 <- kl_V1201tt `pseq` klCons kl_V1201tt (Types.Atom Types.Nil) !appl_2 <- appl_1 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_1 !appl_3 <- kl_V1201h `pseq` (appl_2 `pseq` klCons kl_V1201h appl_2) appl_3 `pseq` kl_shen_curry_type appl_3 pat_cond_4 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt = do !appl_5 <- kl_V1201tt `pseq` klCons kl_V1201tt (Types.Atom Types.Nil) !appl_6 <- appl_5 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_5 !appl_7 <- kl_V1201h `pseq` (appl_6 `pseq` klCons kl_V1201h appl_6) appl_7 `pseq` kl_shen_curry_type appl_7 pat_cond_8 kl_V1201 kl_V1201h kl_V1201t = do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_curry_type kl_Z))) let !aw_10 = Types.Atom (Types.UnboundSym "map") appl_9 `pseq` (kl_V1201 `pseq` applyWrapper aw_10 [appl_9, kl_V1201]) pat_cond_11 = do do return kl_V1201 in case kl_V1201 of !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (Atom (UnboundSym "-->")) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (Atom (UnboundSym "-->")) (!kl_V1201tttt)))))))))))) -> pat_cond_0 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (Atom (UnboundSym "-->")) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (PL "-->" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_0 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (Atom (UnboundSym "-->")) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (Func "-->" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_0 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (PL "-->" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (Atom (UnboundSym "-->")) (!kl_V1201tttt)))))))))))) -> pat_cond_0 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (PL "-->" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (PL "-->" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_0 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (PL "-->" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (Func "-->" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_0 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (Func "-->" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (Atom (UnboundSym "-->")) (!kl_V1201tttt)))))))))))) -> pat_cond_0 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (Func "-->" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (PL "-->" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_0 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (Func "-->" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (Func "-->" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_0 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (Atom (UnboundSym "*")) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (Atom (UnboundSym "*")) (!kl_V1201tttt)))))))))))) -> pat_cond_4 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (Atom (UnboundSym "*")) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (PL "*" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_4 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (Atom (UnboundSym "*")) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (Func "*" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_4 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (PL "*" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (Atom (UnboundSym "*")) (!kl_V1201tttt)))))))))))) -> pat_cond_4 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (PL "*" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (PL "*" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_4 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (PL "*" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (Func "*" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_4 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (Func "*" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (Atom (UnboundSym "*")) (!kl_V1201tttt)))))))))))) -> pat_cond_4 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (Func "*" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (PL "*" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_4 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!(kl_V1201t@(Cons (ApplC (Func "*" _)) (!(kl_V1201tt@(Cons (!kl_V1201tth) (!(kl_V1201ttt@(Cons (ApplC (Func "*" _)) (!kl_V1201tttt)))))))))))) -> pat_cond_4 kl_V1201 kl_V1201h kl_V1201t kl_V1201tt kl_V1201tth kl_V1201ttt kl_V1201tttt !(kl_V1201@(Cons (!kl_V1201h) (!kl_V1201t))) -> pat_cond_8 kl_V1201 kl_V1201h kl_V1201t _ -> pat_cond_11 kl_shen_LBsignature_helpRB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBsignature_helpRB (!kl_V1203) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Types.Atom (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 = Types.Atom (Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !appl_7 <- appl_6 `pseq` (kl_Parse_LBeRB `pseq` eq appl_6 kl_Parse_LBeRB) let !aw_8 = Types.Atom (Types.UnboundSym "not") !kl_if_9 <- appl_7 `pseq` applyWrapper aw_8 [appl_7] case kl_if_9 of Atom (B (True)) -> do !appl_10 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB let !aw_11 = Types.Atom (Types.UnboundSym "shen.pair") appl_10 `pseq` applyWrapper aw_11 [appl_10, Types.Atom Types.Nil] Atom (B (False)) -> do do let !aw_12 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_12 [] _ -> throwError "if: expected boolean"))) let !aw_13 = Types.Atom (Types.UnboundSym "") !appl_14 <- kl_V1203 `pseq` applyWrapper aw_13 [kl_V1203] appl_14 `pseq` applyWrapper appl_4 [appl_14] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) !appl_15 <- kl_V1203 `pseq` hd kl_V1203 !kl_if_16 <- appl_15 `pseq` consP appl_15 !appl_17 <- case kl_if_16 of Atom (B (True)) -> do let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsignature_helpRB) -> do let !aw_20 = Types.Atom (Types.UnboundSym "fail") !appl_21 <- applyWrapper aw_20 [] !appl_22 <- appl_21 `pseq` (kl_Parse_shen_LBsignature_helpRB `pseq` eq appl_21 kl_Parse_shen_LBsignature_helpRB) let !aw_23 = Types.Atom (Types.UnboundSym "not") !kl_if_24 <- appl_22 `pseq` applyWrapper aw_23 [appl_22] case kl_if_24 of Atom (B (True)) -> do !appl_25 <- klCons (Types.Atom (Types.UnboundSym "}")) (Types.Atom Types.Nil) !appl_26 <- appl_25 `pseq` klCons (Types.Atom (Types.UnboundSym "{")) appl_25 let !aw_27 = Types.Atom (Types.UnboundSym "element?") !appl_28 <- kl_Parse_X `pseq` (appl_26 `pseq` applyWrapper aw_27 [kl_Parse_X, appl_26]) let !aw_29 = Types.Atom (Types.UnboundSym "not") !kl_if_30 <- appl_28 `pseq` applyWrapper aw_29 [appl_28] case kl_if_30 of Atom (B (True)) -> do !appl_31 <- kl_Parse_shen_LBsignature_helpRB `pseq` hd kl_Parse_shen_LBsignature_helpRB let !aw_32 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_33 <- kl_Parse_shen_LBsignature_helpRB `pseq` applyWrapper aw_32 [kl_Parse_shen_LBsignature_helpRB] !appl_34 <- kl_Parse_X `pseq` (appl_33 `pseq` klCons kl_Parse_X appl_33) let !aw_35 = Types.Atom (Types.UnboundSym "shen.pair") appl_31 `pseq` (appl_34 `pseq` applyWrapper aw_35 [appl_31, appl_34]) Atom (B (False)) -> do do let !aw_36 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_36 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_37 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_37 [] _ -> throwError "if: expected boolean"))) !appl_38 <- kl_V1203 `pseq` hd kl_V1203 !appl_39 <- appl_38 `pseq` tl appl_38 let !aw_40 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_41 <- kl_V1203 `pseq` applyWrapper aw_40 [kl_V1203] let !aw_42 = Types.Atom (Types.UnboundSym "shen.pair") !appl_43 <- appl_39 `pseq` (appl_41 `pseq` applyWrapper aw_42 [appl_39, appl_41]) !appl_44 <- appl_43 `pseq` kl_shen_LBsignature_helpRB appl_43 appl_44 `pseq` applyWrapper appl_19 [appl_44]))) !appl_45 <- kl_V1203 `pseq` hd kl_V1203 !appl_46 <- appl_45 `pseq` hd appl_45 appl_46 `pseq` applyWrapper appl_18 [appl_46] Atom (B (False)) -> do do let !aw_47 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_47 [] _ -> throwError "if: expected boolean" appl_17 `pseq` applyWrapper appl_0 [appl_17] kl_shen_LBrulesRB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBrulesRB (!kl_V1205) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Types.Atom (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_LBruleRB) -> do let !aw_5 = Types.Atom (Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !appl_7 <- appl_6 `pseq` (kl_Parse_shen_LBruleRB `pseq` eq appl_6 kl_Parse_shen_LBruleRB) let !aw_8 = Types.Atom (Types.UnboundSym "not") !kl_if_9 <- appl_7 `pseq` applyWrapper aw_8 [appl_7] case kl_if_9 of Atom (B (True)) -> do !appl_10 <- kl_Parse_shen_LBruleRB `pseq` hd kl_Parse_shen_LBruleRB let !aw_11 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_12 <- kl_Parse_shen_LBruleRB `pseq` applyWrapper aw_11 [kl_Parse_shen_LBruleRB] !appl_13 <- appl_12 `pseq` kl_shen_linearise appl_12 !appl_14 <- appl_13 `pseq` klCons appl_13 (Types.Atom Types.Nil) let !aw_15 = Types.Atom (Types.UnboundSym "shen.pair") appl_10 `pseq` (appl_14 `pseq` applyWrapper aw_15 [appl_10, appl_14]) Atom (B (False)) -> do do let !aw_16 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_16 [] _ -> throwError "if: expected boolean"))) !appl_17 <- kl_V1205 `pseq` kl_shen_LBruleRB kl_V1205 appl_17 `pseq` applyWrapper appl_4 [appl_17] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBruleRB) -> do let !aw_19 = Types.Atom (Types.UnboundSym "fail") !appl_20 <- applyWrapper aw_19 [] !appl_21 <- appl_20 `pseq` (kl_Parse_shen_LBruleRB `pseq` eq appl_20 kl_Parse_shen_LBruleRB) let !aw_22 = Types.Atom (Types.UnboundSym "not") !kl_if_23 <- appl_21 `pseq` applyWrapper aw_22 [appl_21] case kl_if_23 of Atom (B (True)) -> do let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBrulesRB) -> do let !aw_25 = Types.Atom (Types.UnboundSym "fail") !appl_26 <- applyWrapper aw_25 [] !appl_27 <- appl_26 `pseq` (kl_Parse_shen_LBrulesRB `pseq` eq appl_26 kl_Parse_shen_LBrulesRB) let !aw_28 = Types.Atom (Types.UnboundSym "not") !kl_if_29 <- appl_27 `pseq` applyWrapper aw_28 [appl_27] case kl_if_29 of Atom (B (True)) -> do !appl_30 <- kl_Parse_shen_LBrulesRB `pseq` hd kl_Parse_shen_LBrulesRB let !aw_31 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_32 <- kl_Parse_shen_LBruleRB `pseq` applyWrapper aw_31 [kl_Parse_shen_LBruleRB] !appl_33 <- appl_32 `pseq` kl_shen_linearise appl_32 let !aw_34 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_35 <- kl_Parse_shen_LBrulesRB `pseq` applyWrapper aw_34 [kl_Parse_shen_LBrulesRB] !appl_36 <- appl_33 `pseq` (appl_35 `pseq` klCons appl_33 appl_35) let !aw_37 = Types.Atom (Types.UnboundSym "shen.pair") appl_30 `pseq` (appl_36 `pseq` applyWrapper aw_37 [appl_30, appl_36]) Atom (B (False)) -> do do let !aw_38 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_38 [] _ -> throwError "if: expected boolean"))) !appl_39 <- kl_Parse_shen_LBruleRB `pseq` kl_shen_LBrulesRB kl_Parse_shen_LBruleRB appl_39 `pseq` applyWrapper appl_24 [appl_39] Atom (B (False)) -> do do let !aw_40 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_40 [] _ -> throwError "if: expected boolean"))) !appl_41 <- kl_V1205 `pseq` kl_shen_LBruleRB kl_V1205 !appl_42 <- appl_41 `pseq` applyWrapper appl_18 [appl_41] appl_42 `pseq` applyWrapper appl_0 [appl_42] kl_shen_LBruleRB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBruleRB (!kl_V1207) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Types.Atom (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 = Types.Atom (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_YaccParse) -> do let !aw_9 = Types.Atom (Types.UnboundSym "fail") !appl_10 <- applyWrapper aw_9 [] !kl_if_11 <- kl_YaccParse `pseq` (appl_10 `pseq` eq kl_YaccParse appl_10) case kl_if_11 of Atom (B (True)) -> do let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternsRB) -> do let !aw_13 = Types.Atom (Types.UnboundSym "fail") !appl_14 <- applyWrapper aw_13 [] !appl_15 <- appl_14 `pseq` (kl_Parse_shen_LBpatternsRB `pseq` eq appl_14 kl_Parse_shen_LBpatternsRB) let !aw_16 = Types.Atom (Types.UnboundSym "not") !kl_if_17 <- appl_15 `pseq` applyWrapper aw_16 [appl_15] case kl_if_17 of Atom (B (True)) -> do !appl_18 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !kl_if_19 <- appl_18 `pseq` consP appl_18 !kl_if_20 <- case kl_if_19 of Atom (B (True)) -> do !appl_21 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !appl_22 <- appl_21 `pseq` hd appl_21 !kl_if_23 <- appl_22 `pseq` eq (Types.Atom (Types.UnboundSym "<-")) appl_22 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" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_20 of Atom (B (True)) -> do let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBactionRB) -> do let !aw_25 = Types.Atom (Types.UnboundSym "fail") !appl_26 <- applyWrapper aw_25 [] !appl_27 <- appl_26 `pseq` (kl_Parse_shen_LBactionRB `pseq` eq appl_26 kl_Parse_shen_LBactionRB) let !aw_28 = Types.Atom (Types.UnboundSym "not") !kl_if_29 <- appl_27 `pseq` applyWrapper aw_28 [appl_27] case kl_if_29 of Atom (B (True)) -> do !appl_30 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB let !aw_31 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_32 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_31 [kl_Parse_shen_LBpatternsRB] let !aw_33 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_34 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_33 [kl_Parse_shen_LBactionRB] !appl_35 <- appl_34 `pseq` klCons appl_34 (Types.Atom Types.Nil) !appl_36 <- appl_35 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.choicepoint!")) appl_35 !appl_37 <- appl_36 `pseq` klCons appl_36 (Types.Atom Types.Nil) !appl_38 <- appl_32 `pseq` (appl_37 `pseq` klCons appl_32 appl_37) let !aw_39 = Types.Atom (Types.UnboundSym "shen.pair") appl_30 `pseq` (appl_38 `pseq` applyWrapper aw_39 [appl_30, appl_38]) Atom (B (False)) -> do do let !aw_40 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_40 [] _ -> throwError "if: expected boolean"))) !appl_41 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !appl_42 <- appl_41 `pseq` tl appl_41 let !aw_43 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_44 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_43 [kl_Parse_shen_LBpatternsRB] let !aw_45 = Types.Atom (Types.UnboundSym "shen.pair") !appl_46 <- appl_42 `pseq` (appl_44 `pseq` applyWrapper aw_45 [appl_42, appl_44]) !appl_47 <- appl_46 `pseq` kl_shen_LBactionRB appl_46 appl_47 `pseq` applyWrapper appl_24 [appl_47] Atom (B (False)) -> do do let !aw_48 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_48 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_49 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_49 [] _ -> throwError "if: expected boolean"))) !appl_50 <- kl_V1207 `pseq` kl_shen_LBpatternsRB kl_V1207 appl_50 `pseq` applyWrapper appl_12 [appl_50] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_51 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternsRB) -> do let !aw_52 = Types.Atom (Types.UnboundSym "fail") !appl_53 <- applyWrapper aw_52 [] !appl_54 <- appl_53 `pseq` (kl_Parse_shen_LBpatternsRB `pseq` eq appl_53 kl_Parse_shen_LBpatternsRB) let !aw_55 = Types.Atom (Types.UnboundSym "not") !kl_if_56 <- appl_54 `pseq` applyWrapper aw_55 [appl_54] case kl_if_56 of Atom (B (True)) -> do !appl_57 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !kl_if_58 <- appl_57 `pseq` consP appl_57 !kl_if_59 <- case kl_if_58 of Atom (B (True)) -> do !appl_60 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !appl_61 <- appl_60 `pseq` hd appl_60 !kl_if_62 <- appl_61 `pseq` eq (Types.Atom (Types.UnboundSym "<-")) appl_61 case kl_if_62 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_59 of Atom (B (True)) -> do let !appl_63 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBactionRB) -> do let !aw_64 = Types.Atom (Types.UnboundSym "fail") !appl_65 <- applyWrapper aw_64 [] !appl_66 <- appl_65 `pseq` (kl_Parse_shen_LBactionRB `pseq` eq appl_65 kl_Parse_shen_LBactionRB) let !aw_67 = Types.Atom (Types.UnboundSym "not") !kl_if_68 <- appl_66 `pseq` applyWrapper aw_67 [appl_66] case kl_if_68 of Atom (B (True)) -> do !appl_69 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB !kl_if_70 <- appl_69 `pseq` consP appl_69 !kl_if_71 <- case kl_if_70 of Atom (B (True)) -> do !appl_72 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB !appl_73 <- appl_72 `pseq` hd appl_72 !kl_if_74 <- appl_73 `pseq` eq (Types.Atom (Types.UnboundSym "where")) appl_73 case kl_if_74 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_71 of Atom (B (True)) -> do let !appl_75 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBguardRB) -> do let !aw_76 = Types.Atom (Types.UnboundSym "fail") !appl_77 <- applyWrapper aw_76 [] !appl_78 <- appl_77 `pseq` (kl_Parse_shen_LBguardRB `pseq` eq appl_77 kl_Parse_shen_LBguardRB) let !aw_79 = Types.Atom (Types.UnboundSym "not") !kl_if_80 <- appl_78 `pseq` applyWrapper aw_79 [appl_78] case kl_if_80 of Atom (B (True)) -> do !appl_81 <- kl_Parse_shen_LBguardRB `pseq` hd kl_Parse_shen_LBguardRB let !aw_82 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_83 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_82 [kl_Parse_shen_LBpatternsRB] let !aw_84 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_85 <- kl_Parse_shen_LBguardRB `pseq` applyWrapper aw_84 [kl_Parse_shen_LBguardRB] let !aw_86 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_87 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_86 [kl_Parse_shen_LBactionRB] !appl_88 <- appl_87 `pseq` klCons appl_87 (Types.Atom Types.Nil) !appl_89 <- appl_88 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.choicepoint!")) appl_88 !appl_90 <- appl_89 `pseq` klCons appl_89 (Types.Atom Types.Nil) !appl_91 <- appl_85 `pseq` (appl_90 `pseq` klCons appl_85 appl_90) !appl_92 <- appl_91 `pseq` klCons (Types.Atom (Types.UnboundSym "where")) appl_91 !appl_93 <- appl_92 `pseq` klCons appl_92 (Types.Atom Types.Nil) !appl_94 <- appl_83 `pseq` (appl_93 `pseq` klCons appl_83 appl_93) let !aw_95 = Types.Atom (Types.UnboundSym "shen.pair") appl_81 `pseq` (appl_94 `pseq` applyWrapper aw_95 [appl_81, appl_94]) Atom (B (False)) -> do do let !aw_96 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_96 [] _ -> throwError "if: expected boolean"))) !appl_97 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB !appl_98 <- appl_97 `pseq` tl appl_97 let !aw_99 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_100 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_99 [kl_Parse_shen_LBactionRB] let !aw_101 = Types.Atom (Types.UnboundSym "shen.pair") !appl_102 <- appl_98 `pseq` (appl_100 `pseq` applyWrapper aw_101 [appl_98, appl_100]) !appl_103 <- appl_102 `pseq` kl_shen_LBguardRB appl_102 appl_103 `pseq` applyWrapper appl_75 [appl_103] Atom (B (False)) -> do do let !aw_104 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_104 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_105 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_105 [] _ -> throwError "if: expected boolean"))) !appl_106 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !appl_107 <- appl_106 `pseq` tl appl_106 let !aw_108 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_109 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_108 [kl_Parse_shen_LBpatternsRB] let !aw_110 = Types.Atom (Types.UnboundSym "shen.pair") !appl_111 <- appl_107 `pseq` (appl_109 `pseq` applyWrapper aw_110 [appl_107, appl_109]) !appl_112 <- appl_111 `pseq` kl_shen_LBactionRB appl_111 appl_112 `pseq` applyWrapper appl_63 [appl_112] Atom (B (False)) -> do do let !aw_113 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_113 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_114 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_114 [] _ -> throwError "if: expected boolean"))) !appl_115 <- kl_V1207 `pseq` kl_shen_LBpatternsRB kl_V1207 !appl_116 <- appl_115 `pseq` applyWrapper appl_51 [appl_115] appl_116 `pseq` applyWrapper appl_8 [appl_116] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_117 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternsRB) -> do let !aw_118 = Types.Atom (Types.UnboundSym "fail") !appl_119 <- applyWrapper aw_118 [] !appl_120 <- appl_119 `pseq` (kl_Parse_shen_LBpatternsRB `pseq` eq appl_119 kl_Parse_shen_LBpatternsRB) let !aw_121 = Types.Atom (Types.UnboundSym "not") !kl_if_122 <- appl_120 `pseq` applyWrapper aw_121 [appl_120] case kl_if_122 of Atom (B (True)) -> do !appl_123 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !kl_if_124 <- appl_123 `pseq` consP appl_123 !kl_if_125 <- case kl_if_124 of Atom (B (True)) -> do !appl_126 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !appl_127 <- appl_126 `pseq` hd appl_126 !kl_if_128 <- appl_127 `pseq` eq (Types.Atom (Types.UnboundSym "->")) appl_127 case kl_if_128 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_125 of Atom (B (True)) -> do let !appl_129 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBactionRB) -> do let !aw_130 = Types.Atom (Types.UnboundSym "fail") !appl_131 <- applyWrapper aw_130 [] !appl_132 <- appl_131 `pseq` (kl_Parse_shen_LBactionRB `pseq` eq appl_131 kl_Parse_shen_LBactionRB) let !aw_133 = Types.Atom (Types.UnboundSym "not") !kl_if_134 <- appl_132 `pseq` applyWrapper aw_133 [appl_132] case kl_if_134 of Atom (B (True)) -> do !appl_135 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB let !aw_136 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_137 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_136 [kl_Parse_shen_LBpatternsRB] let !aw_138 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_139 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_138 [kl_Parse_shen_LBactionRB] !appl_140 <- appl_139 `pseq` klCons appl_139 (Types.Atom Types.Nil) !appl_141 <- appl_137 `pseq` (appl_140 `pseq` klCons appl_137 appl_140) let !aw_142 = Types.Atom (Types.UnboundSym "shen.pair") appl_135 `pseq` (appl_141 `pseq` applyWrapper aw_142 [appl_135, appl_141]) Atom (B (False)) -> do do let !aw_143 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_143 [] _ -> throwError "if: expected boolean"))) !appl_144 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !appl_145 <- appl_144 `pseq` tl appl_144 let !aw_146 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_147 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_146 [kl_Parse_shen_LBpatternsRB] let !aw_148 = Types.Atom (Types.UnboundSym "shen.pair") !appl_149 <- appl_145 `pseq` (appl_147 `pseq` applyWrapper aw_148 [appl_145, appl_147]) !appl_150 <- appl_149 `pseq` kl_shen_LBactionRB appl_149 appl_150 `pseq` applyWrapper appl_129 [appl_150] Atom (B (False)) -> do do let !aw_151 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_151 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_152 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_152 [] _ -> throwError "if: expected boolean"))) !appl_153 <- kl_V1207 `pseq` kl_shen_LBpatternsRB kl_V1207 !appl_154 <- appl_153 `pseq` applyWrapper appl_117 [appl_153] appl_154 `pseq` applyWrapper appl_4 [appl_154] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) let !appl_155 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternsRB) -> do let !aw_156 = Types.Atom (Types.UnboundSym "fail") !appl_157 <- applyWrapper aw_156 [] !appl_158 <- appl_157 `pseq` (kl_Parse_shen_LBpatternsRB `pseq` eq appl_157 kl_Parse_shen_LBpatternsRB) let !aw_159 = Types.Atom (Types.UnboundSym "not") !kl_if_160 <- appl_158 `pseq` applyWrapper aw_159 [appl_158] case kl_if_160 of Atom (B (True)) -> do !appl_161 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !kl_if_162 <- appl_161 `pseq` consP appl_161 !kl_if_163 <- case kl_if_162 of Atom (B (True)) -> do !appl_164 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !appl_165 <- appl_164 `pseq` hd appl_164 !kl_if_166 <- appl_165 `pseq` eq (Types.Atom (Types.UnboundSym "->")) appl_165 case kl_if_166 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_163 of Atom (B (True)) -> do let !appl_167 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBactionRB) -> do let !aw_168 = Types.Atom (Types.UnboundSym "fail") !appl_169 <- applyWrapper aw_168 [] !appl_170 <- appl_169 `pseq` (kl_Parse_shen_LBactionRB `pseq` eq appl_169 kl_Parse_shen_LBactionRB) let !aw_171 = Types.Atom (Types.UnboundSym "not") !kl_if_172 <- appl_170 `pseq` applyWrapper aw_171 [appl_170] case kl_if_172 of Atom (B (True)) -> do !appl_173 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB !kl_if_174 <- appl_173 `pseq` consP appl_173 !kl_if_175 <- case kl_if_174 of Atom (B (True)) -> do !appl_176 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB !appl_177 <- appl_176 `pseq` hd appl_176 !kl_if_178 <- appl_177 `pseq` eq (Types.Atom (Types.UnboundSym "where")) appl_177 case kl_if_178 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_175 of Atom (B (True)) -> do let !appl_179 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBguardRB) -> do let !aw_180 = Types.Atom (Types.UnboundSym "fail") !appl_181 <- applyWrapper aw_180 [] !appl_182 <- appl_181 `pseq` (kl_Parse_shen_LBguardRB `pseq` eq appl_181 kl_Parse_shen_LBguardRB) let !aw_183 = Types.Atom (Types.UnboundSym "not") !kl_if_184 <- appl_182 `pseq` applyWrapper aw_183 [appl_182] case kl_if_184 of Atom (B (True)) -> do !appl_185 <- kl_Parse_shen_LBguardRB `pseq` hd kl_Parse_shen_LBguardRB let !aw_186 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_187 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_186 [kl_Parse_shen_LBpatternsRB] let !aw_188 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_189 <- kl_Parse_shen_LBguardRB `pseq` applyWrapper aw_188 [kl_Parse_shen_LBguardRB] let !aw_190 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_191 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_190 [kl_Parse_shen_LBactionRB] !appl_192 <- appl_191 `pseq` klCons appl_191 (Types.Atom Types.Nil) !appl_193 <- appl_189 `pseq` (appl_192 `pseq` klCons appl_189 appl_192) !appl_194 <- appl_193 `pseq` klCons (Types.Atom (Types.UnboundSym "where")) appl_193 !appl_195 <- appl_194 `pseq` klCons appl_194 (Types.Atom Types.Nil) !appl_196 <- appl_187 `pseq` (appl_195 `pseq` klCons appl_187 appl_195) let !aw_197 = Types.Atom (Types.UnboundSym "shen.pair") appl_185 `pseq` (appl_196 `pseq` applyWrapper aw_197 [appl_185, appl_196]) Atom (B (False)) -> do do let !aw_198 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_198 [] _ -> throwError "if: expected boolean"))) !appl_199 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB !appl_200 <- appl_199 `pseq` tl appl_199 let !aw_201 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_202 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_201 [kl_Parse_shen_LBactionRB] let !aw_203 = Types.Atom (Types.UnboundSym "shen.pair") !appl_204 <- appl_200 `pseq` (appl_202 `pseq` applyWrapper aw_203 [appl_200, appl_202]) !appl_205 <- appl_204 `pseq` kl_shen_LBguardRB appl_204 appl_205 `pseq` applyWrapper appl_179 [appl_205] Atom (B (False)) -> do do let !aw_206 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_206 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_207 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_207 [] _ -> throwError "if: expected boolean"))) !appl_208 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB !appl_209 <- appl_208 `pseq` tl appl_208 let !aw_210 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_211 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_210 [kl_Parse_shen_LBpatternsRB] let !aw_212 = Types.Atom (Types.UnboundSym "shen.pair") !appl_213 <- appl_209 `pseq` (appl_211 `pseq` applyWrapper aw_212 [appl_209, appl_211]) !appl_214 <- appl_213 `pseq` kl_shen_LBactionRB appl_213 appl_214 `pseq` applyWrapper appl_167 [appl_214] Atom (B (False)) -> do do let !aw_215 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_215 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_216 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_216 [] _ -> throwError "if: expected boolean"))) !appl_217 <- kl_V1207 `pseq` kl_shen_LBpatternsRB kl_V1207 !appl_218 <- appl_217 `pseq` applyWrapper appl_155 [appl_217] appl_218 `pseq` applyWrapper appl_0 [appl_218] kl_shen_fail_if :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_fail_if (!kl_V1210) (!kl_V1211) = do !kl_if_0 <- kl_V1211 `pseq` applyWrapper kl_V1210 [kl_V1211] case kl_if_0 of Atom (B (True)) -> do let !aw_1 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_1 [] Atom (B (False)) -> do do return kl_V1211 _ -> throwError "if: expected boolean" kl_shen_succeedsP :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_succeedsP (!kl_V1217) = do let !aw_0 = Types.Atom (Types.UnboundSym "fail") !appl_1 <- applyWrapper aw_0 [] !kl_if_2 <- kl_V1217 `pseq` (appl_1 `pseq` eq kl_V1217 appl_1) case kl_if_2 of Atom (B (True)) -> do return (Atom (B False)) Atom (B (False)) -> do do return (Atom (B True)) _ -> throwError "if: expected boolean" kl_shen_LBpatternsRB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBpatternsRB (!kl_V1219) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Types.Atom (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 = Types.Atom (Types.UnboundSym "fail") !appl_6 <- applyWrapper aw_5 [] !appl_7 <- appl_6 `pseq` (kl_Parse_LBeRB `pseq` eq appl_6 kl_Parse_LBeRB) let !aw_8 = Types.Atom (Types.UnboundSym "not") !kl_if_9 <- appl_7 `pseq` applyWrapper aw_8 [appl_7] case kl_if_9 of Atom (B (True)) -> do !appl_10 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB let !aw_11 = Types.Atom (Types.UnboundSym "shen.pair") appl_10 `pseq` applyWrapper aw_11 [appl_10, Types.Atom Types.Nil] Atom (B (False)) -> do do let !aw_12 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_12 [] _ -> throwError "if: expected boolean"))) let !aw_13 = Types.Atom (Types.UnboundSym "") !appl_14 <- kl_V1219 `pseq` applyWrapper aw_13 [kl_V1219] 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_LBpatternRB) -> do let !aw_16 = Types.Atom (Types.UnboundSym "fail") !appl_17 <- applyWrapper aw_16 [] !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBpatternRB `pseq` eq appl_17 kl_Parse_shen_LBpatternRB) let !aw_19 = Types.Atom (Types.UnboundSym "not") !kl_if_20 <- appl_18 `pseq` applyWrapper aw_19 [appl_18] case kl_if_20 of Atom (B (True)) -> do let !appl_21 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternsRB) -> do let !aw_22 = Types.Atom (Types.UnboundSym "fail") !appl_23 <- applyWrapper aw_22 [] !appl_24 <- appl_23 `pseq` (kl_Parse_shen_LBpatternsRB `pseq` eq appl_23 kl_Parse_shen_LBpatternsRB) let !aw_25 = Types.Atom (Types.UnboundSym "not") !kl_if_26 <- appl_24 `pseq` applyWrapper aw_25 [appl_24] case kl_if_26 of Atom (B (True)) -> do !appl_27 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB let !aw_28 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_29 <- kl_Parse_shen_LBpatternRB `pseq` applyWrapper aw_28 [kl_Parse_shen_LBpatternRB] let !aw_30 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_31 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_30 [kl_Parse_shen_LBpatternsRB] !appl_32 <- appl_29 `pseq` (appl_31 `pseq` klCons appl_29 appl_31) let !aw_33 = Types.Atom (Types.UnboundSym "shen.pair") appl_27 `pseq` (appl_32 `pseq` applyWrapper aw_33 [appl_27, appl_32]) Atom (B (False)) -> do do let !aw_34 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_34 [] _ -> throwError "if: expected boolean"))) !appl_35 <- kl_Parse_shen_LBpatternRB `pseq` kl_shen_LBpatternsRB kl_Parse_shen_LBpatternRB appl_35 `pseq` applyWrapper appl_21 [appl_35] Atom (B (False)) -> do do let !aw_36 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_36 [] _ -> throwError "if: expected boolean"))) !appl_37 <- kl_V1219 `pseq` kl_shen_LBpatternRB kl_V1219 !appl_38 <- appl_37 `pseq` applyWrapper appl_15 [appl_37] appl_38 `pseq` applyWrapper appl_0 [appl_38] kl_shen_LBpatternRB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBpatternRB (!kl_V1226) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Types.Atom (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 = Types.Atom (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_YaccParse) -> do let !aw_9 = Types.Atom (Types.UnboundSym "fail") !appl_10 <- applyWrapper aw_9 [] !kl_if_11 <- kl_YaccParse `pseq` (appl_10 `pseq` eq kl_YaccParse appl_10) case kl_if_11 of Atom (B (True)) -> do let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_13 = Types.Atom (Types.UnboundSym "fail") !appl_14 <- applyWrapper aw_13 [] !kl_if_15 <- kl_YaccParse `pseq` (appl_14 `pseq` eq kl_YaccParse appl_14) case kl_if_15 of Atom (B (True)) -> do let !appl_16 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_17 = Types.Atom (Types.UnboundSym "fail") !appl_18 <- applyWrapper aw_17 [] !kl_if_19 <- kl_YaccParse `pseq` (appl_18 `pseq` eq kl_YaccParse appl_18) case kl_if_19 of Atom (B (True)) -> do let !appl_20 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_21 = Types.Atom (Types.UnboundSym "fail") !appl_22 <- applyWrapper aw_21 [] !kl_if_23 <- kl_YaccParse `pseq` (appl_22 `pseq` eq kl_YaccParse appl_22) case kl_if_23 of Atom (B (True)) -> do let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsimple_patternRB) -> do let !aw_25 = Types.Atom (Types.UnboundSym "fail") !appl_26 <- applyWrapper aw_25 [] !appl_27 <- appl_26 `pseq` (kl_Parse_shen_LBsimple_patternRB `pseq` eq appl_26 kl_Parse_shen_LBsimple_patternRB) let !aw_28 = Types.Atom (Types.UnboundSym "not") !kl_if_29 <- appl_27 `pseq` applyWrapper aw_28 [appl_27] case kl_if_29 of Atom (B (True)) -> do !appl_30 <- kl_Parse_shen_LBsimple_patternRB `pseq` hd kl_Parse_shen_LBsimple_patternRB let !aw_31 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_32 <- kl_Parse_shen_LBsimple_patternRB `pseq` applyWrapper aw_31 [kl_Parse_shen_LBsimple_patternRB] let !aw_33 = Types.Atom (Types.UnboundSym "shen.pair") appl_30 `pseq` (appl_32 `pseq` applyWrapper aw_33 [appl_30, appl_32]) Atom (B (False)) -> do do let !aw_34 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_34 [] _ -> throwError "if: expected boolean"))) !appl_35 <- kl_V1226 `pseq` kl_shen_LBsimple_patternRB kl_V1226 appl_35 `pseq` applyWrapper appl_24 [appl_35] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) !appl_36 <- kl_V1226 `pseq` hd kl_V1226 !kl_if_37 <- appl_36 `pseq` consP appl_36 !appl_38 <- case kl_if_37 of Atom (B (True)) -> do let !appl_39 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let pat_cond_40 kl_Parse_X kl_Parse_Xh kl_Parse_Xt = do !appl_41 <- kl_V1226 `pseq` hd kl_V1226 !appl_42 <- appl_41 `pseq` tl appl_41 let !aw_43 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_44 <- kl_V1226 `pseq` applyWrapper aw_43 [kl_V1226] let !aw_45 = Types.Atom (Types.UnboundSym "shen.pair") !appl_46 <- appl_42 `pseq` (appl_44 `pseq` applyWrapper aw_45 [appl_42, appl_44]) !appl_47 <- appl_46 `pseq` hd appl_46 !appl_48 <- kl_Parse_X `pseq` kl_shen_constructor_error kl_Parse_X let !aw_49 = Types.Atom (Types.UnboundSym "shen.pair") appl_47 `pseq` (appl_48 `pseq` applyWrapper aw_49 [appl_47, appl_48]) pat_cond_50 = do do let !aw_51 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_51 [] in case kl_Parse_X of !(kl_Parse_X@(Cons (!kl_Parse_Xh) (!kl_Parse_Xt))) -> pat_cond_40 kl_Parse_X kl_Parse_Xh kl_Parse_Xt _ -> pat_cond_50))) !appl_52 <- kl_V1226 `pseq` hd kl_V1226 !appl_53 <- appl_52 `pseq` hd appl_52 appl_53 `pseq` applyWrapper appl_39 [appl_53] Atom (B (False)) -> do do let !aw_54 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_54 [] _ -> throwError "if: expected boolean" appl_38 `pseq` applyWrapper appl_20 [appl_38] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) !appl_55 <- kl_V1226 `pseq` hd kl_V1226 !kl_if_56 <- appl_55 `pseq` consP appl_55 !kl_if_57 <- case kl_if_56 of Atom (B (True)) -> do !appl_58 <- kl_V1226 `pseq` hd kl_V1226 !appl_59 <- appl_58 `pseq` hd appl_58 !kl_if_60 <- appl_59 `pseq` consP appl_59 case kl_if_60 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_61 <- case kl_if_57 of Atom (B (True)) -> do !appl_62 <- kl_V1226 `pseq` hd kl_V1226 !appl_63 <- appl_62 `pseq` hd appl_62 !appl_64 <- kl_V1226 `pseq` tl kl_V1226 !appl_65 <- appl_64 `pseq` hd appl_64 let !aw_66 = Types.Atom (Types.UnboundSym "shen.pair") !appl_67 <- appl_63 `pseq` (appl_65 `pseq` applyWrapper aw_66 [appl_63, appl_65]) !appl_68 <- appl_67 `pseq` hd appl_67 !kl_if_69 <- appl_68 `pseq` consP appl_68 !kl_if_70 <- case kl_if_69 of Atom (B (True)) -> do !appl_71 <- kl_V1226 `pseq` hd kl_V1226 !appl_72 <- appl_71 `pseq` hd appl_71 !appl_73 <- kl_V1226 `pseq` tl kl_V1226 !appl_74 <- appl_73 `pseq` hd appl_73 let !aw_75 = Types.Atom (Types.UnboundSym "shen.pair") !appl_76 <- appl_72 `pseq` (appl_74 `pseq` applyWrapper aw_75 [appl_72, appl_74]) !appl_77 <- appl_76 `pseq` hd appl_76 !appl_78 <- appl_77 `pseq` hd appl_77 !kl_if_79 <- appl_78 `pseq` eq (Types.Atom (Types.UnboundSym "vector")) appl_78 case kl_if_79 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_70 of Atom (B (True)) -> do !appl_80 <- kl_V1226 `pseq` hd kl_V1226 !appl_81 <- appl_80 `pseq` hd appl_80 !appl_82 <- kl_V1226 `pseq` tl kl_V1226 !appl_83 <- appl_82 `pseq` hd appl_82 let !aw_84 = Types.Atom (Types.UnboundSym "shen.pair") !appl_85 <- appl_81 `pseq` (appl_83 `pseq` applyWrapper aw_84 [appl_81, appl_83]) !appl_86 <- appl_85 `pseq` hd appl_85 !appl_87 <- appl_86 `pseq` tl appl_86 !appl_88 <- kl_V1226 `pseq` hd kl_V1226 !appl_89 <- appl_88 `pseq` hd appl_88 !appl_90 <- kl_V1226 `pseq` tl kl_V1226 !appl_91 <- appl_90 `pseq` hd appl_90 let !aw_92 = Types.Atom (Types.UnboundSym "shen.pair") !appl_93 <- appl_89 `pseq` (appl_91 `pseq` applyWrapper aw_92 [appl_89, appl_91]) let !aw_94 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_95 <- appl_93 `pseq` applyWrapper aw_94 [appl_93] let !aw_96 = Types.Atom (Types.UnboundSym "shen.pair") !appl_97 <- appl_87 `pseq` (appl_95 `pseq` applyWrapper aw_96 [appl_87, appl_95]) !appl_98 <- appl_97 `pseq` hd appl_97 !kl_if_99 <- appl_98 `pseq` consP appl_98 !kl_if_100 <- case kl_if_99 of Atom (B (True)) -> do !appl_101 <- kl_V1226 `pseq` hd kl_V1226 !appl_102 <- appl_101 `pseq` hd appl_101 !appl_103 <- kl_V1226 `pseq` tl kl_V1226 !appl_104 <- appl_103 `pseq` hd appl_103 let !aw_105 = Types.Atom (Types.UnboundSym "shen.pair") !appl_106 <- appl_102 `pseq` (appl_104 `pseq` applyWrapper aw_105 [appl_102, appl_104]) !appl_107 <- appl_106 `pseq` hd appl_106 !appl_108 <- appl_107 `pseq` tl appl_107 !appl_109 <- kl_V1226 `pseq` hd kl_V1226 !appl_110 <- appl_109 `pseq` hd appl_109 !appl_111 <- kl_V1226 `pseq` tl kl_V1226 !appl_112 <- appl_111 `pseq` hd appl_111 let !aw_113 = Types.Atom (Types.UnboundSym "shen.pair") !appl_114 <- appl_110 `pseq` (appl_112 `pseq` applyWrapper aw_113 [appl_110, appl_112]) let !aw_115 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_116 <- appl_114 `pseq` applyWrapper aw_115 [appl_114] let !aw_117 = Types.Atom (Types.UnboundSym "shen.pair") !appl_118 <- appl_108 `pseq` (appl_116 `pseq` applyWrapper aw_117 [appl_108, appl_116]) !appl_119 <- appl_118 `pseq` hd appl_118 !appl_120 <- appl_119 `pseq` hd appl_119 !kl_if_121 <- appl_120 `pseq` eq (Types.Atom (Types.N (Types.KI 0))) appl_120 case kl_if_121 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_100 of Atom (B (True)) -> do !appl_122 <- kl_V1226 `pseq` hd kl_V1226 !appl_123 <- appl_122 `pseq` tl appl_122 !appl_124 <- kl_V1226 `pseq` tl kl_V1226 !appl_125 <- appl_124 `pseq` hd appl_124 let !aw_126 = Types.Atom (Types.UnboundSym "shen.pair") !appl_127 <- appl_123 `pseq` (appl_125 `pseq` applyWrapper aw_126 [appl_123, appl_125]) !appl_128 <- appl_127 `pseq` hd appl_127 !appl_129 <- klCons (Types.Atom (Types.N (Types.KI 0))) (Types.Atom Types.Nil) !appl_130 <- appl_129 `pseq` klCons (Types.Atom (Types.UnboundSym "vector")) appl_129 let !aw_131 = Types.Atom (Types.UnboundSym "shen.pair") appl_128 `pseq` (appl_130 `pseq` applyWrapper aw_131 [appl_128, appl_130]) Atom (B (False)) -> do do let !aw_132 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_132 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_133 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_133 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_134 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_134 [] _ -> throwError "if: expected boolean" appl_61 `pseq` applyWrapper appl_16 [appl_61] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) !appl_135 <- kl_V1226 `pseq` hd kl_V1226 !kl_if_136 <- appl_135 `pseq` consP appl_135 !kl_if_137 <- case kl_if_136 of Atom (B (True)) -> do !appl_138 <- kl_V1226 `pseq` hd kl_V1226 !appl_139 <- appl_138 `pseq` hd appl_138 !kl_if_140 <- appl_139 `pseq` consP appl_139 case kl_if_140 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_141 <- case kl_if_137 of Atom (B (True)) -> do !appl_142 <- kl_V1226 `pseq` hd kl_V1226 !appl_143 <- appl_142 `pseq` hd appl_142 !appl_144 <- kl_V1226 `pseq` tl kl_V1226 !appl_145 <- appl_144 `pseq` hd appl_144 let !aw_146 = Types.Atom (Types.UnboundSym "shen.pair") !appl_147 <- appl_143 `pseq` (appl_145 `pseq` applyWrapper aw_146 [appl_143, appl_145]) !appl_148 <- appl_147 `pseq` hd appl_147 !kl_if_149 <- appl_148 `pseq` consP appl_148 !kl_if_150 <- case kl_if_149 of Atom (B (True)) -> do !appl_151 <- kl_V1226 `pseq` hd kl_V1226 !appl_152 <- appl_151 `pseq` hd appl_151 !appl_153 <- kl_V1226 `pseq` tl kl_V1226 !appl_154 <- appl_153 `pseq` hd appl_153 let !aw_155 = Types.Atom (Types.UnboundSym "shen.pair") !appl_156 <- appl_152 `pseq` (appl_154 `pseq` applyWrapper aw_155 [appl_152, appl_154]) !appl_157 <- appl_156 `pseq` hd appl_156 !appl_158 <- appl_157 `pseq` hd appl_157 !kl_if_159 <- appl_158 `pseq` eq (Types.Atom (Types.UnboundSym "@s")) appl_158 case kl_if_159 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_150 of Atom (B (True)) -> do let !appl_160 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern1RB) -> do let !aw_161 = Types.Atom (Types.UnboundSym "fail") !appl_162 <- applyWrapper aw_161 [] !appl_163 <- appl_162 `pseq` (kl_Parse_shen_LBpattern1RB `pseq` eq appl_162 kl_Parse_shen_LBpattern1RB) let !aw_164 = Types.Atom (Types.UnboundSym "not") !kl_if_165 <- appl_163 `pseq` applyWrapper aw_164 [appl_163] case kl_if_165 of Atom (B (True)) -> do let !appl_166 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern2RB) -> do let !aw_167 = Types.Atom (Types.UnboundSym "fail") !appl_168 <- applyWrapper aw_167 [] !appl_169 <- appl_168 `pseq` (kl_Parse_shen_LBpattern2RB `pseq` eq appl_168 kl_Parse_shen_LBpattern2RB) let !aw_170 = Types.Atom (Types.UnboundSym "not") !kl_if_171 <- appl_169 `pseq` applyWrapper aw_170 [appl_169] case kl_if_171 of Atom (B (True)) -> do !appl_172 <- kl_V1226 `pseq` hd kl_V1226 !appl_173 <- appl_172 `pseq` tl appl_172 !appl_174 <- kl_V1226 `pseq` tl kl_V1226 !appl_175 <- appl_174 `pseq` hd appl_174 let !aw_176 = Types.Atom (Types.UnboundSym "shen.pair") !appl_177 <- appl_173 `pseq` (appl_175 `pseq` applyWrapper aw_176 [appl_173, appl_175]) !appl_178 <- appl_177 `pseq` hd appl_177 let !aw_179 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_180 <- kl_Parse_shen_LBpattern1RB `pseq` applyWrapper aw_179 [kl_Parse_shen_LBpattern1RB] let !aw_181 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_182 <- kl_Parse_shen_LBpattern2RB `pseq` applyWrapper aw_181 [kl_Parse_shen_LBpattern2RB] !appl_183 <- appl_182 `pseq` klCons appl_182 (Types.Atom Types.Nil) !appl_184 <- appl_180 `pseq` (appl_183 `pseq` klCons appl_180 appl_183) !appl_185 <- appl_184 `pseq` klCons (Types.Atom (Types.UnboundSym "@s")) appl_184 let !aw_186 = Types.Atom (Types.UnboundSym "shen.pair") appl_178 `pseq` (appl_185 `pseq` applyWrapper aw_186 [appl_178, appl_185]) Atom (B (False)) -> do do let !aw_187 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_187 [] _ -> throwError "if: expected boolean"))) !appl_188 <- kl_Parse_shen_LBpattern1RB `pseq` kl_shen_LBpattern2RB kl_Parse_shen_LBpattern1RB appl_188 `pseq` applyWrapper appl_166 [appl_188] Atom (B (False)) -> do do let !aw_189 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_189 [] _ -> throwError "if: expected boolean"))) !appl_190 <- kl_V1226 `pseq` hd kl_V1226 !appl_191 <- appl_190 `pseq` hd appl_190 !appl_192 <- kl_V1226 `pseq` tl kl_V1226 !appl_193 <- appl_192 `pseq` hd appl_192 let !aw_194 = Types.Atom (Types.UnboundSym "shen.pair") !appl_195 <- appl_191 `pseq` (appl_193 `pseq` applyWrapper aw_194 [appl_191, appl_193]) !appl_196 <- appl_195 `pseq` hd appl_195 !appl_197 <- appl_196 `pseq` tl appl_196 !appl_198 <- kl_V1226 `pseq` hd kl_V1226 !appl_199 <- appl_198 `pseq` hd appl_198 !appl_200 <- kl_V1226 `pseq` tl kl_V1226 !appl_201 <- appl_200 `pseq` hd appl_200 let !aw_202 = Types.Atom (Types.UnboundSym "shen.pair") !appl_203 <- appl_199 `pseq` (appl_201 `pseq` applyWrapper aw_202 [appl_199, appl_201]) let !aw_204 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_205 <- appl_203 `pseq` applyWrapper aw_204 [appl_203] let !aw_206 = Types.Atom (Types.UnboundSym "shen.pair") !appl_207 <- appl_197 `pseq` (appl_205 `pseq` applyWrapper aw_206 [appl_197, appl_205]) !appl_208 <- appl_207 `pseq` kl_shen_LBpattern1RB appl_207 appl_208 `pseq` applyWrapper appl_160 [appl_208] Atom (B (False)) -> do do let !aw_209 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_209 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_210 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_210 [] _ -> throwError "if: expected boolean" appl_141 `pseq` applyWrapper appl_12 [appl_141] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) !appl_211 <- kl_V1226 `pseq` hd kl_V1226 !kl_if_212 <- appl_211 `pseq` consP appl_211 !kl_if_213 <- case kl_if_212 of Atom (B (True)) -> do !appl_214 <- kl_V1226 `pseq` hd kl_V1226 !appl_215 <- appl_214 `pseq` hd appl_214 !kl_if_216 <- appl_215 `pseq` consP appl_215 case kl_if_216 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_217 <- case kl_if_213 of Atom (B (True)) -> do !appl_218 <- kl_V1226 `pseq` hd kl_V1226 !appl_219 <- appl_218 `pseq` hd appl_218 !appl_220 <- kl_V1226 `pseq` tl kl_V1226 !appl_221 <- appl_220 `pseq` hd appl_220 let !aw_222 = Types.Atom (Types.UnboundSym "shen.pair") !appl_223 <- appl_219 `pseq` (appl_221 `pseq` applyWrapper aw_222 [appl_219, appl_221]) !appl_224 <- appl_223 `pseq` hd appl_223 !kl_if_225 <- appl_224 `pseq` consP appl_224 !kl_if_226 <- case kl_if_225 of Atom (B (True)) -> do !appl_227 <- kl_V1226 `pseq` hd kl_V1226 !appl_228 <- appl_227 `pseq` hd appl_227 !appl_229 <- kl_V1226 `pseq` tl kl_V1226 !appl_230 <- appl_229 `pseq` hd appl_229 let !aw_231 = Types.Atom (Types.UnboundSym "shen.pair") !appl_232 <- appl_228 `pseq` (appl_230 `pseq` applyWrapper aw_231 [appl_228, appl_230]) !appl_233 <- appl_232 `pseq` hd appl_232 !appl_234 <- appl_233 `pseq` hd appl_233 !kl_if_235 <- appl_234 `pseq` eq (Types.Atom (Types.UnboundSym "@v")) appl_234 case kl_if_235 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_226 of Atom (B (True)) -> do let !appl_236 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern1RB) -> do let !aw_237 = Types.Atom (Types.UnboundSym "fail") !appl_238 <- applyWrapper aw_237 [] !appl_239 <- appl_238 `pseq` (kl_Parse_shen_LBpattern1RB `pseq` eq appl_238 kl_Parse_shen_LBpattern1RB) let !aw_240 = Types.Atom (Types.UnboundSym "not") !kl_if_241 <- appl_239 `pseq` applyWrapper aw_240 [appl_239] case kl_if_241 of Atom (B (True)) -> do let !appl_242 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern2RB) -> do let !aw_243 = Types.Atom (Types.UnboundSym "fail") !appl_244 <- applyWrapper aw_243 [] !appl_245 <- appl_244 `pseq` (kl_Parse_shen_LBpattern2RB `pseq` eq appl_244 kl_Parse_shen_LBpattern2RB) let !aw_246 = Types.Atom (Types.UnboundSym "not") !kl_if_247 <- appl_245 `pseq` applyWrapper aw_246 [appl_245] case kl_if_247 of Atom (B (True)) -> do !appl_248 <- kl_V1226 `pseq` hd kl_V1226 !appl_249 <- appl_248 `pseq` tl appl_248 !appl_250 <- kl_V1226 `pseq` tl kl_V1226 !appl_251 <- appl_250 `pseq` hd appl_250 let !aw_252 = Types.Atom (Types.UnboundSym "shen.pair") !appl_253 <- appl_249 `pseq` (appl_251 `pseq` applyWrapper aw_252 [appl_249, appl_251]) !appl_254 <- appl_253 `pseq` hd appl_253 let !aw_255 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_256 <- kl_Parse_shen_LBpattern1RB `pseq` applyWrapper aw_255 [kl_Parse_shen_LBpattern1RB] let !aw_257 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_258 <- kl_Parse_shen_LBpattern2RB `pseq` applyWrapper aw_257 [kl_Parse_shen_LBpattern2RB] !appl_259 <- appl_258 `pseq` klCons appl_258 (Types.Atom Types.Nil) !appl_260 <- appl_256 `pseq` (appl_259 `pseq` klCons appl_256 appl_259) !appl_261 <- appl_260 `pseq` klCons (Types.Atom (Types.UnboundSym "@v")) appl_260 let !aw_262 = Types.Atom (Types.UnboundSym "shen.pair") appl_254 `pseq` (appl_261 `pseq` applyWrapper aw_262 [appl_254, appl_261]) Atom (B (False)) -> do do let !aw_263 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_263 [] _ -> throwError "if: expected boolean"))) !appl_264 <- kl_Parse_shen_LBpattern1RB `pseq` kl_shen_LBpattern2RB kl_Parse_shen_LBpattern1RB appl_264 `pseq` applyWrapper appl_242 [appl_264] Atom (B (False)) -> do do let !aw_265 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_265 [] _ -> throwError "if: expected boolean"))) !appl_266 <- kl_V1226 `pseq` hd kl_V1226 !appl_267 <- appl_266 `pseq` hd appl_266 !appl_268 <- kl_V1226 `pseq` tl kl_V1226 !appl_269 <- appl_268 `pseq` hd appl_268 let !aw_270 = Types.Atom (Types.UnboundSym "shen.pair") !appl_271 <- appl_267 `pseq` (appl_269 `pseq` applyWrapper aw_270 [appl_267, appl_269]) !appl_272 <- appl_271 `pseq` hd appl_271 !appl_273 <- appl_272 `pseq` tl appl_272 !appl_274 <- kl_V1226 `pseq` hd kl_V1226 !appl_275 <- appl_274 `pseq` hd appl_274 !appl_276 <- kl_V1226 `pseq` tl kl_V1226 !appl_277 <- appl_276 `pseq` hd appl_276 let !aw_278 = Types.Atom (Types.UnboundSym "shen.pair") !appl_279 <- appl_275 `pseq` (appl_277 `pseq` applyWrapper aw_278 [appl_275, appl_277]) let !aw_280 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_281 <- appl_279 `pseq` applyWrapper aw_280 [appl_279] let !aw_282 = Types.Atom (Types.UnboundSym "shen.pair") !appl_283 <- appl_273 `pseq` (appl_281 `pseq` applyWrapper aw_282 [appl_273, appl_281]) !appl_284 <- appl_283 `pseq` kl_shen_LBpattern1RB appl_283 appl_284 `pseq` applyWrapper appl_236 [appl_284] Atom (B (False)) -> do do let !aw_285 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_285 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_286 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_286 [] _ -> throwError "if: expected boolean" appl_217 `pseq` applyWrapper appl_8 [appl_217] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) !appl_287 <- kl_V1226 `pseq` hd kl_V1226 !kl_if_288 <- appl_287 `pseq` consP appl_287 !kl_if_289 <- case kl_if_288 of Atom (B (True)) -> do !appl_290 <- kl_V1226 `pseq` hd kl_V1226 !appl_291 <- appl_290 `pseq` hd appl_290 !kl_if_292 <- appl_291 `pseq` consP appl_291 case kl_if_292 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_293 <- case kl_if_289 of Atom (B (True)) -> do !appl_294 <- kl_V1226 `pseq` hd kl_V1226 !appl_295 <- appl_294 `pseq` hd appl_294 !appl_296 <- kl_V1226 `pseq` tl kl_V1226 !appl_297 <- appl_296 `pseq` hd appl_296 let !aw_298 = Types.Atom (Types.UnboundSym "shen.pair") !appl_299 <- appl_295 `pseq` (appl_297 `pseq` applyWrapper aw_298 [appl_295, appl_297]) !appl_300 <- appl_299 `pseq` hd appl_299 !kl_if_301 <- appl_300 `pseq` consP appl_300 !kl_if_302 <- case kl_if_301 of Atom (B (True)) -> do !appl_303 <- kl_V1226 `pseq` hd kl_V1226 !appl_304 <- appl_303 `pseq` hd appl_303 !appl_305 <- kl_V1226 `pseq` tl kl_V1226 !appl_306 <- appl_305 `pseq` hd appl_305 let !aw_307 = Types.Atom (Types.UnboundSym "shen.pair") !appl_308 <- appl_304 `pseq` (appl_306 `pseq` applyWrapper aw_307 [appl_304, appl_306]) !appl_309 <- appl_308 `pseq` hd appl_308 !appl_310 <- appl_309 `pseq` hd appl_309 !kl_if_311 <- appl_310 `pseq` eq (ApplC (wrapNamed "cons" klCons)) appl_310 case kl_if_311 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_302 of Atom (B (True)) -> do let !appl_312 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern1RB) -> do let !aw_313 = Types.Atom (Types.UnboundSym "fail") !appl_314 <- applyWrapper aw_313 [] !appl_315 <- appl_314 `pseq` (kl_Parse_shen_LBpattern1RB `pseq` eq appl_314 kl_Parse_shen_LBpattern1RB) let !aw_316 = Types.Atom (Types.UnboundSym "not") !kl_if_317 <- appl_315 `pseq` applyWrapper aw_316 [appl_315] case kl_if_317 of Atom (B (True)) -> do let !appl_318 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern2RB) -> do let !aw_319 = Types.Atom (Types.UnboundSym "fail") !appl_320 <- applyWrapper aw_319 [] !appl_321 <- appl_320 `pseq` (kl_Parse_shen_LBpattern2RB `pseq` eq appl_320 kl_Parse_shen_LBpattern2RB) let !aw_322 = Types.Atom (Types.UnboundSym "not") !kl_if_323 <- appl_321 `pseq` applyWrapper aw_322 [appl_321] case kl_if_323 of Atom (B (True)) -> do !appl_324 <- kl_V1226 `pseq` hd kl_V1226 !appl_325 <- appl_324 `pseq` tl appl_324 !appl_326 <- kl_V1226 `pseq` tl kl_V1226 !appl_327 <- appl_326 `pseq` hd appl_326 let !aw_328 = Types.Atom (Types.UnboundSym "shen.pair") !appl_329 <- appl_325 `pseq` (appl_327 `pseq` applyWrapper aw_328 [appl_325, appl_327]) !appl_330 <- appl_329 `pseq` hd appl_329 let !aw_331 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_332 <- kl_Parse_shen_LBpattern1RB `pseq` applyWrapper aw_331 [kl_Parse_shen_LBpattern1RB] let !aw_333 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_334 <- kl_Parse_shen_LBpattern2RB `pseq` applyWrapper aw_333 [kl_Parse_shen_LBpattern2RB] !appl_335 <- appl_334 `pseq` klCons appl_334 (Types.Atom Types.Nil) !appl_336 <- appl_332 `pseq` (appl_335 `pseq` klCons appl_332 appl_335) !appl_337 <- appl_336 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_336 let !aw_338 = Types.Atom (Types.UnboundSym "shen.pair") appl_330 `pseq` (appl_337 `pseq` applyWrapper aw_338 [appl_330, appl_337]) Atom (B (False)) -> do do let !aw_339 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_339 [] _ -> throwError "if: expected boolean"))) !appl_340 <- kl_Parse_shen_LBpattern1RB `pseq` kl_shen_LBpattern2RB kl_Parse_shen_LBpattern1RB appl_340 `pseq` applyWrapper appl_318 [appl_340] Atom (B (False)) -> do do let !aw_341 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_341 [] _ -> throwError "if: expected boolean"))) !appl_342 <- kl_V1226 `pseq` hd kl_V1226 !appl_343 <- appl_342 `pseq` hd appl_342 !appl_344 <- kl_V1226 `pseq` tl kl_V1226 !appl_345 <- appl_344 `pseq` hd appl_344 let !aw_346 = Types.Atom (Types.UnboundSym "shen.pair") !appl_347 <- appl_343 `pseq` (appl_345 `pseq` applyWrapper aw_346 [appl_343, appl_345]) !appl_348 <- appl_347 `pseq` hd appl_347 !appl_349 <- appl_348 `pseq` tl appl_348 !appl_350 <- kl_V1226 `pseq` hd kl_V1226 !appl_351 <- appl_350 `pseq` hd appl_350 !appl_352 <- kl_V1226 `pseq` tl kl_V1226 !appl_353 <- appl_352 `pseq` hd appl_352 let !aw_354 = Types.Atom (Types.UnboundSym "shen.pair") !appl_355 <- appl_351 `pseq` (appl_353 `pseq` applyWrapper aw_354 [appl_351, appl_353]) let !aw_356 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_357 <- appl_355 `pseq` applyWrapper aw_356 [appl_355] let !aw_358 = Types.Atom (Types.UnboundSym "shen.pair") !appl_359 <- appl_349 `pseq` (appl_357 `pseq` applyWrapper aw_358 [appl_349, appl_357]) !appl_360 <- appl_359 `pseq` kl_shen_LBpattern1RB appl_359 appl_360 `pseq` applyWrapper appl_312 [appl_360] Atom (B (False)) -> do do let !aw_361 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_361 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_362 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_362 [] _ -> throwError "if: expected boolean" appl_293 `pseq` applyWrapper appl_4 [appl_293] Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) !appl_363 <- kl_V1226 `pseq` hd kl_V1226 !kl_if_364 <- appl_363 `pseq` consP appl_363 !kl_if_365 <- case kl_if_364 of Atom (B (True)) -> do !appl_366 <- kl_V1226 `pseq` hd kl_V1226 !appl_367 <- appl_366 `pseq` hd appl_366 !kl_if_368 <- appl_367 `pseq` consP appl_367 case kl_if_368 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_369 <- case kl_if_365 of Atom (B (True)) -> do !appl_370 <- kl_V1226 `pseq` hd kl_V1226 !appl_371 <- appl_370 `pseq` hd appl_370 !appl_372 <- kl_V1226 `pseq` tl kl_V1226 !appl_373 <- appl_372 `pseq` hd appl_372 let !aw_374 = Types.Atom (Types.UnboundSym "shen.pair") !appl_375 <- appl_371 `pseq` (appl_373 `pseq` applyWrapper aw_374 [appl_371, appl_373]) !appl_376 <- appl_375 `pseq` hd appl_375 !kl_if_377 <- appl_376 `pseq` consP appl_376 !kl_if_378 <- case kl_if_377 of Atom (B (True)) -> do !appl_379 <- kl_V1226 `pseq` hd kl_V1226 !appl_380 <- appl_379 `pseq` hd appl_379 !appl_381 <- kl_V1226 `pseq` tl kl_V1226 !appl_382 <- appl_381 `pseq` hd appl_381 let !aw_383 = Types.Atom (Types.UnboundSym "shen.pair") !appl_384 <- appl_380 `pseq` (appl_382 `pseq` applyWrapper aw_383 [appl_380, appl_382]) !appl_385 <- appl_384 `pseq` hd appl_384 !appl_386 <- appl_385 `pseq` hd appl_385 !kl_if_387 <- appl_386 `pseq` eq (Types.Atom (Types.UnboundSym "@p")) appl_386 case kl_if_387 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_378 of Atom (B (True)) -> do let !appl_388 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern1RB) -> do let !aw_389 = Types.Atom (Types.UnboundSym "fail") !appl_390 <- applyWrapper aw_389 [] !appl_391 <- appl_390 `pseq` (kl_Parse_shen_LBpattern1RB `pseq` eq appl_390 kl_Parse_shen_LBpattern1RB) let !aw_392 = Types.Atom (Types.UnboundSym "not") !kl_if_393 <- appl_391 `pseq` applyWrapper aw_392 [appl_391] case kl_if_393 of Atom (B (True)) -> do let !appl_394 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern2RB) -> do let !aw_395 = Types.Atom (Types.UnboundSym "fail") !appl_396 <- applyWrapper aw_395 [] !appl_397 <- appl_396 `pseq` (kl_Parse_shen_LBpattern2RB `pseq` eq appl_396 kl_Parse_shen_LBpattern2RB) let !aw_398 = Types.Atom (Types.UnboundSym "not") !kl_if_399 <- appl_397 `pseq` applyWrapper aw_398 [appl_397] case kl_if_399 of Atom (B (True)) -> do !appl_400 <- kl_V1226 `pseq` hd kl_V1226 !appl_401 <- appl_400 `pseq` tl appl_400 !appl_402 <- kl_V1226 `pseq` tl kl_V1226 !appl_403 <- appl_402 `pseq` hd appl_402 let !aw_404 = Types.Atom (Types.UnboundSym "shen.pair") !appl_405 <- appl_401 `pseq` (appl_403 `pseq` applyWrapper aw_404 [appl_401, appl_403]) !appl_406 <- appl_405 `pseq` hd appl_405 let !aw_407 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_408 <- kl_Parse_shen_LBpattern1RB `pseq` applyWrapper aw_407 [kl_Parse_shen_LBpattern1RB] let !aw_409 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_410 <- kl_Parse_shen_LBpattern2RB `pseq` applyWrapper aw_409 [kl_Parse_shen_LBpattern2RB] !appl_411 <- appl_410 `pseq` klCons appl_410 (Types.Atom Types.Nil) !appl_412 <- appl_408 `pseq` (appl_411 `pseq` klCons appl_408 appl_411) !appl_413 <- appl_412 `pseq` klCons (Types.Atom (Types.UnboundSym "@p")) appl_412 let !aw_414 = Types.Atom (Types.UnboundSym "shen.pair") appl_406 `pseq` (appl_413 `pseq` applyWrapper aw_414 [appl_406, appl_413]) Atom (B (False)) -> do do let !aw_415 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_415 [] _ -> throwError "if: expected boolean"))) !appl_416 <- kl_Parse_shen_LBpattern1RB `pseq` kl_shen_LBpattern2RB kl_Parse_shen_LBpattern1RB appl_416 `pseq` applyWrapper appl_394 [appl_416] Atom (B (False)) -> do do let !aw_417 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_417 [] _ -> throwError "if: expected boolean"))) !appl_418 <- kl_V1226 `pseq` hd kl_V1226 !appl_419 <- appl_418 `pseq` hd appl_418 !appl_420 <- kl_V1226 `pseq` tl kl_V1226 !appl_421 <- appl_420 `pseq` hd appl_420 let !aw_422 = Types.Atom (Types.UnboundSym "shen.pair") !appl_423 <- appl_419 `pseq` (appl_421 `pseq` applyWrapper aw_422 [appl_419, appl_421]) !appl_424 <- appl_423 `pseq` hd appl_423 !appl_425 <- appl_424 `pseq` tl appl_424 !appl_426 <- kl_V1226 `pseq` hd kl_V1226 !appl_427 <- appl_426 `pseq` hd appl_426 !appl_428 <- kl_V1226 `pseq` tl kl_V1226 !appl_429 <- appl_428 `pseq` hd appl_428 let !aw_430 = Types.Atom (Types.UnboundSym "shen.pair") !appl_431 <- appl_427 `pseq` (appl_429 `pseq` applyWrapper aw_430 [appl_427, appl_429]) let !aw_432 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_433 <- appl_431 `pseq` applyWrapper aw_432 [appl_431] let !aw_434 = Types.Atom (Types.UnboundSym "shen.pair") !appl_435 <- appl_425 `pseq` (appl_433 `pseq` applyWrapper aw_434 [appl_425, appl_433]) !appl_436 <- appl_435 `pseq` kl_shen_LBpattern1RB appl_435 appl_436 `pseq` applyWrapper appl_388 [appl_436] Atom (B (False)) -> do do let !aw_437 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_437 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do let !aw_438 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_438 [] _ -> throwError "if: expected boolean" appl_369 `pseq` applyWrapper appl_0 [appl_369] kl_shen_constructor_error :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_constructor_error (!kl_V1228) = do let !aw_0 = Types.Atom (Types.UnboundSym "shen.app") !appl_1 <- kl_V1228 `pseq` applyWrapper aw_0 [kl_V1228, Types.Atom (Types.Str " is not a legitimate constructor\n"), Types.Atom (Types.UnboundSym "shen.a")] appl_1 `pseq` simpleError appl_1 kl_shen_LBsimple_patternRB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBsimple_patternRB (!kl_V1230) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Types.Atom (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_V1230 `pseq` hd kl_V1230 !kl_if_5 <- appl_4 `pseq` consP appl_4 case kl_if_5 of Atom (B (True)) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !appl_7 <- klCons (Types.Atom (Types.UnboundSym "<-")) (Types.Atom Types.Nil) !appl_8 <- appl_7 `pseq` klCons (Types.Atom (Types.UnboundSym "->")) appl_7 let !aw_9 = Types.Atom (Types.UnboundSym "element?") !appl_10 <- kl_Parse_X `pseq` (appl_8 `pseq` applyWrapper aw_9 [kl_Parse_X, appl_8]) let !aw_11 = Types.Atom (Types.UnboundSym "not") !kl_if_12 <- appl_10 `pseq` applyWrapper aw_11 [appl_10] case kl_if_12 of Atom (B (True)) -> do !appl_13 <- kl_V1230 `pseq` hd kl_V1230 !appl_14 <- appl_13 `pseq` tl appl_13 let !aw_15 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_16 <- kl_V1230 `pseq` applyWrapper aw_15 [kl_V1230] let !aw_17 = Types.Atom (Types.UnboundSym "shen.pair") !appl_18 <- appl_14 `pseq` (appl_16 `pseq` applyWrapper aw_17 [appl_14, appl_16]) !appl_19 <- appl_18 `pseq` hd appl_18 let !aw_20 = Types.Atom (Types.UnboundSym "shen.pair") appl_19 `pseq` (kl_Parse_X `pseq` applyWrapper aw_20 [appl_19, kl_Parse_X]) Atom (B (False)) -> do do let !aw_21 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_21 [] _ -> throwError "if: expected boolean"))) !appl_22 <- kl_V1230 `pseq` hd kl_V1230 !appl_23 <- appl_22 `pseq` hd appl_22 appl_23 `pseq` applyWrapper appl_6 [appl_23] Atom (B (False)) -> do do let !aw_24 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_24 [] _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return kl_YaccParse _ -> throwError "if: expected boolean"))) !appl_25 <- kl_V1230 `pseq` hd kl_V1230 !kl_if_26 <- appl_25 `pseq` consP appl_25 !appl_27 <- case kl_if_26 of Atom (B (True)) -> do let !appl_28 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let pat_cond_29 = do !appl_30 <- kl_V1230 `pseq` hd kl_V1230 !appl_31 <- appl_30 `pseq` tl appl_30 let !aw_32 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_33 <- kl_V1230 `pseq` applyWrapper aw_32 [kl_V1230] let !aw_34 = Types.Atom (Types.UnboundSym "shen.pair") !appl_35 <- appl_31 `pseq` (appl_33 `pseq` applyWrapper aw_34 [appl_31, appl_33]) !appl_36 <- appl_35 `pseq` hd appl_35 let !aw_37 = Types.Atom (Types.UnboundSym "gensym") !appl_38 <- applyWrapper aw_37 [Types.Atom (Types.UnboundSym "Parse_Y")] let !aw_39 = Types.Atom (Types.UnboundSym "shen.pair") appl_36 `pseq` (appl_38 `pseq` applyWrapper aw_39 [appl_36, appl_38]) pat_cond_40 = do do let !aw_41 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_41 [] in case kl_Parse_X of kl_Parse_X@(Atom (UnboundSym "_")) -> pat_cond_29 kl_Parse_X@(ApplC (PL "_" _)) -> pat_cond_29 kl_Parse_X@(ApplC (Func "_" _)) -> pat_cond_29 _ -> pat_cond_40))) !appl_42 <- kl_V1230 `pseq` hd kl_V1230 !appl_43 <- appl_42 `pseq` hd appl_42 appl_43 `pseq` applyWrapper appl_28 [appl_43] Atom (B (False)) -> do do let !aw_44 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_44 [] _ -> throwError "if: expected boolean" appl_27 `pseq` applyWrapper appl_0 [appl_27] kl_shen_LBpattern1RB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBpattern1RB (!kl_V1232) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternRB) -> do let !aw_1 = Types.Atom (Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !appl_3 <- appl_2 `pseq` (kl_Parse_shen_LBpatternRB `pseq` eq appl_2 kl_Parse_shen_LBpatternRB) let !aw_4 = Types.Atom (Types.UnboundSym "not") !kl_if_5 <- appl_3 `pseq` applyWrapper aw_4 [appl_3] case kl_if_5 of Atom (B (True)) -> do !appl_6 <- kl_Parse_shen_LBpatternRB `pseq` hd kl_Parse_shen_LBpatternRB let !aw_7 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_8 <- kl_Parse_shen_LBpatternRB `pseq` applyWrapper aw_7 [kl_Parse_shen_LBpatternRB] let !aw_9 = Types.Atom (Types.UnboundSym "shen.pair") appl_6 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_6, appl_8]) Atom (B (False)) -> do do let !aw_10 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_10 [] _ -> throwError "if: expected boolean"))) !appl_11 <- kl_V1232 `pseq` kl_shen_LBpatternRB kl_V1232 appl_11 `pseq` applyWrapper appl_0 [appl_11] kl_shen_LBpattern2RB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBpattern2RB (!kl_V1234) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternRB) -> do let !aw_1 = Types.Atom (Types.UnboundSym "fail") !appl_2 <- applyWrapper aw_1 [] !appl_3 <- appl_2 `pseq` (kl_Parse_shen_LBpatternRB `pseq` eq appl_2 kl_Parse_shen_LBpatternRB) let !aw_4 = Types.Atom (Types.UnboundSym "not") !kl_if_5 <- appl_3 `pseq` applyWrapper aw_4 [appl_3] case kl_if_5 of Atom (B (True)) -> do !appl_6 <- kl_Parse_shen_LBpatternRB `pseq` hd kl_Parse_shen_LBpatternRB let !aw_7 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_8 <- kl_Parse_shen_LBpatternRB `pseq` applyWrapper aw_7 [kl_Parse_shen_LBpatternRB] let !aw_9 = Types.Atom (Types.UnboundSym "shen.pair") appl_6 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_6, appl_8]) Atom (B (False)) -> do do let !aw_10 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_10 [] _ -> throwError "if: expected boolean"))) !appl_11 <- kl_V1234 `pseq` kl_shen_LBpatternRB kl_V1234 appl_11 `pseq` applyWrapper appl_0 [appl_11] kl_shen_LBactionRB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBactionRB (!kl_V1236) = do !appl_0 <- kl_V1236 `pseq` hd kl_V1236 !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 <- kl_V1236 `pseq` hd kl_V1236 !appl_4 <- appl_3 `pseq` tl appl_3 let !aw_5 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_6 <- kl_V1236 `pseq` applyWrapper aw_5 [kl_V1236] let !aw_7 = Types.Atom (Types.UnboundSym "shen.pair") !appl_8 <- appl_4 `pseq` (appl_6 `pseq` applyWrapper aw_7 [appl_4, appl_6]) !appl_9 <- appl_8 `pseq` hd appl_8 let !aw_10 = Types.Atom (Types.UnboundSym "shen.pair") appl_9 `pseq` (kl_Parse_X `pseq` applyWrapper aw_10 [appl_9, kl_Parse_X])))) !appl_11 <- kl_V1236 `pseq` hd kl_V1236 !appl_12 <- appl_11 `pseq` hd appl_11 appl_12 `pseq` applyWrapper appl_2 [appl_12] Atom (B (False)) -> do do let !aw_13 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_13 [] _ -> throwError "if: expected boolean" kl_shen_LBguardRB :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_LBguardRB (!kl_V1238) = do !appl_0 <- kl_V1238 `pseq` hd kl_V1238 !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 <- kl_V1238 `pseq` hd kl_V1238 !appl_4 <- appl_3 `pseq` tl appl_3 let !aw_5 = Types.Atom (Types.UnboundSym "shen.hdtl") !appl_6 <- kl_V1238 `pseq` applyWrapper aw_5 [kl_V1238] let !aw_7 = Types.Atom (Types.UnboundSym "shen.pair") !appl_8 <- appl_4 `pseq` (appl_6 `pseq` applyWrapper aw_7 [appl_4, appl_6]) !appl_9 <- appl_8 `pseq` hd appl_8 let !aw_10 = Types.Atom (Types.UnboundSym "shen.pair") appl_9 `pseq` (kl_Parse_X `pseq` applyWrapper aw_10 [appl_9, kl_Parse_X])))) !appl_11 <- kl_V1238 `pseq` hd kl_V1238 !appl_12 <- appl_11 `pseq` hd appl_11 appl_12 `pseq` applyWrapper appl_2 [appl_12] Atom (B (False)) -> do do let !aw_13 = Types.Atom (Types.UnboundSym "fail") applyWrapper aw_13 [] _ -> throwError "if: expected boolean" kl_shen_compile_to_machine_code :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_compile_to_machine_code (!kl_V1241) (!kl_V1242) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_LambdaPlus) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_KL) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Record) -> do return kl_KL))) !appl_3 <- kl_V1241 `pseq` (kl_KL `pseq` kl_shen_record_source kl_V1241 kl_KL) appl_3 `pseq` applyWrapper appl_2 [appl_3]))) !appl_4 <- kl_V1241 `pseq` (kl_LambdaPlus `pseq` kl_shen_compile_to_kl kl_V1241 kl_LambdaPlus) appl_4 `pseq` applyWrapper appl_1 [appl_4]))) !appl_5 <- kl_V1241 `pseq` (kl_V1242 `pseq` kl_shen_compile_to_lambdaPlus kl_V1241 kl_V1242) appl_5 `pseq` applyWrapper appl_0 [appl_5] kl_shen_record_source :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_record_source (!kl_V1247) (!kl_V1248) = do !kl_if_0 <- value (Types.Atom (Types.UnboundSym "shen.*installing-kl*")) case kl_if_0 of Atom (B (True)) -> do return (Types.Atom (Types.UnboundSym "shen.skip")) Atom (B (False)) -> do do !appl_1 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) let !aw_2 = Types.Atom (Types.UnboundSym "put") kl_V1247 `pseq` (kl_V1248 `pseq` (appl_1 `pseq` applyWrapper aw_2 [kl_V1247, Types.Atom (Types.UnboundSym "shen.source"), kl_V1248, appl_1])) _ -> throwError "if: expected boolean" kl_shen_compile_to_lambdaPlus :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_compile_to_lambdaPlus (!kl_V1251) (!kl_V1252) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Arity) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_UpDateSymbolTable) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Free) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Variables) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Strip) -> do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_Abstractions) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_Applications) -> do !appl_7 <- kl_Applications `pseq` klCons kl_Applications (Types.Atom Types.Nil) kl_Variables `pseq` (appl_7 `pseq` klCons kl_Variables appl_7)))) let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_Variables `pseq` (kl_X `pseq` kl_shen_application_build kl_Variables kl_X)))) let !aw_9 = Types.Atom (Types.UnboundSym "map") !appl_10 <- appl_8 `pseq` (kl_Abstractions `pseq` applyWrapper aw_9 [appl_8, kl_Abstractions]) appl_10 `pseq` applyWrapper appl_6 [appl_10]))) let !appl_11 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_abstract_rule kl_X))) let !aw_12 = Types.Atom (Types.UnboundSym "map") !appl_13 <- appl_11 `pseq` (kl_Strip `pseq` applyWrapper aw_12 [appl_11, kl_Strip]) appl_13 `pseq` applyWrapper appl_5 [appl_13]))) let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_strip_protect kl_X))) let !aw_15 = Types.Atom (Types.UnboundSym "map") !appl_16 <- appl_14 `pseq` (kl_V1252 `pseq` applyWrapper aw_15 [appl_14, kl_V1252]) appl_16 `pseq` applyWrapper appl_4 [appl_16]))) !appl_17 <- kl_Arity `pseq` kl_shen_parameters kl_Arity appl_17 `pseq` applyWrapper appl_3 [appl_17]))) let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_Rule) -> do kl_V1251 `pseq` (kl_Rule `pseq` kl_shen_free_variable_check kl_V1251 kl_Rule)))) let !aw_19 = Types.Atom (Types.UnboundSym "map") !appl_20 <- appl_18 `pseq` (kl_V1252 `pseq` applyWrapper aw_19 [appl_18, kl_V1252]) appl_20 `pseq` applyWrapper appl_2 [appl_20]))) !appl_21 <- kl_V1251 `pseq` (kl_Arity `pseq` kl_shen_update_symbol_table kl_V1251 kl_Arity) appl_21 `pseq` applyWrapper appl_1 [appl_21]))) !appl_22 <- kl_V1251 `pseq` (kl_V1252 `pseq` kl_shen_aritycheck kl_V1251 kl_V1252) appl_22 `pseq` applyWrapper appl_0 [appl_22] kl_shen_update_symbol_table :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_update_symbol_table (!kl_V1255) (!kl_V1256) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*symbol-table*")) !appl_1 <- kl_V1255 `pseq` (kl_V1256 `pseq` (appl_0 `pseq` kl_shen_update_symbol_table_h kl_V1255 kl_V1256 appl_0 (Types.Atom Types.Nil))) appl_1 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*symbol-table*")) appl_1 kl_shen_update_symbol_table_h :: Types.KLValue -> Types.KLValue -> Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_update_symbol_table_h (!kl_V1264) (!kl_V1265) (!kl_V1266) (!kl_V1267) = do let pat_cond_0 = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_NewEntry) -> do kl_NewEntry `pseq` (kl_V1267 `pseq` klCons kl_NewEntry kl_V1267)))) let !aw_2 = Types.Atom (Types.UnboundSym "shen.lambda-form") !appl_3 <- kl_V1264 `pseq` (kl_V1265 `pseq` applyWrapper aw_2 [kl_V1264, kl_V1265]) !appl_4 <- appl_3 `pseq` evalKL appl_3 !appl_5 <- kl_V1264 `pseq` (appl_4 `pseq` klCons kl_V1264 appl_4) appl_5 `pseq` applyWrapper appl_1 [appl_5] pat_cond_6 kl_V1266 kl_V1266h kl_V1266hh kl_V1266ht kl_V1266t = do let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_ChangedEntry) -> do !appl_8 <- kl_ChangedEntry `pseq` (kl_V1267 `pseq` klCons kl_ChangedEntry kl_V1267) let !aw_9 = Types.Atom (Types.UnboundSym "append") kl_V1266t `pseq` (appl_8 `pseq` applyWrapper aw_9 [kl_V1266t, appl_8])))) let !aw_10 = Types.Atom (Types.UnboundSym "shen.lambda-form") !appl_11 <- kl_V1266hh `pseq` (kl_V1265 `pseq` applyWrapper aw_10 [kl_V1266hh, kl_V1265]) !appl_12 <- appl_11 `pseq` evalKL appl_11 !appl_13 <- kl_V1266hh `pseq` (appl_12 `pseq` klCons kl_V1266hh appl_12) appl_13 `pseq` applyWrapper appl_7 [appl_13] pat_cond_14 kl_V1266 kl_V1266h kl_V1266t = do !appl_15 <- kl_V1266h `pseq` (kl_V1267 `pseq` klCons kl_V1266h kl_V1267) kl_V1264 `pseq` (kl_V1265 `pseq` (kl_V1266t `pseq` (appl_15 `pseq` kl_shen_update_symbol_table_h kl_V1264 kl_V1265 kl_V1266t appl_15))) pat_cond_16 = do do let !aw_17 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_17 [ApplC (wrapNamed "shen.update-symbol-table-h" kl_shen_update_symbol_table_h)] in case kl_V1266 of kl_V1266@(Atom (Nil)) -> pat_cond_0 !(kl_V1266@(Cons (!(kl_V1266h@(Cons (!kl_V1266hh) (!kl_V1266ht)))) (!kl_V1266t))) | eqCore kl_V1266hh kl_V1264 -> pat_cond_6 kl_V1266 kl_V1266h kl_V1266hh kl_V1266ht kl_V1266t !(kl_V1266@(Cons (!kl_V1266h) (!kl_V1266t))) -> pat_cond_14 kl_V1266 kl_V1266h kl_V1266t _ -> pat_cond_16 kl_shen_free_variable_check :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_free_variable_check (!kl_V1270) (!kl_V1271) = do let pat_cond_0 kl_V1271 kl_V1271h kl_V1271t kl_V1271th = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Bound) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Free) -> do kl_V1270 `pseq` (kl_Free `pseq` kl_shen_free_variable_warnings kl_V1270 kl_Free)))) !appl_3 <- kl_Bound `pseq` (kl_V1271th `pseq` kl_shen_extract_free_vars kl_Bound kl_V1271th) appl_3 `pseq` applyWrapper appl_2 [appl_3]))) !appl_4 <- kl_V1271h `pseq` kl_shen_extract_vars kl_V1271h appl_4 `pseq` applyWrapper appl_1 [appl_4] pat_cond_5 = do do let !aw_6 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_6 [ApplC (wrapNamed "shen.free_variable_check" kl_shen_free_variable_check)] in case kl_V1271 of !(kl_V1271@(Cons (!kl_V1271h) (!(kl_V1271t@(Cons (!kl_V1271th) (Atom (Nil))))))) -> pat_cond_0 kl_V1271 kl_V1271h kl_V1271t kl_V1271th _ -> pat_cond_5 kl_shen_extract_vars :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_extract_vars (!kl_V1273) = do let !aw_0 = Types.Atom (Types.UnboundSym "variable?") !kl_if_1 <- kl_V1273 `pseq` applyWrapper aw_0 [kl_V1273] case kl_if_1 of Atom (B (True)) -> do kl_V1273 `pseq` klCons kl_V1273 (Types.Atom Types.Nil) Atom (B (False)) -> do let pat_cond_2 kl_V1273 kl_V1273h kl_V1273t = do !appl_3 <- kl_V1273h `pseq` kl_shen_extract_vars kl_V1273h !appl_4 <- kl_V1273t `pseq` kl_shen_extract_vars kl_V1273t let !aw_5 = Types.Atom (Types.UnboundSym "union") appl_3 `pseq` (appl_4 `pseq` applyWrapper aw_5 [appl_3, appl_4]) pat_cond_6 = do do return (Types.Atom Types.Nil) in case kl_V1273 of !(kl_V1273@(Cons (!kl_V1273h) (!kl_V1273t))) -> pat_cond_2 kl_V1273 kl_V1273h kl_V1273t _ -> pat_cond_6 _ -> throwError "if: expected boolean" kl_shen_extract_free_vars :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_extract_free_vars (!kl_V1285) (!kl_V1286) = do let pat_cond_0 kl_V1286 kl_V1286t kl_V1286th = do return (Types.Atom Types.Nil) pat_cond_1 = do let !aw_2 = Types.Atom (Types.UnboundSym "variable?") !kl_if_3 <- kl_V1286 `pseq` applyWrapper aw_2 [kl_V1286] !kl_if_4 <- case kl_if_3 of Atom (B (True)) -> do let !aw_5 = Types.Atom (Types.UnboundSym "element?") !appl_6 <- kl_V1286 `pseq` (kl_V1285 `pseq` applyWrapper aw_5 [kl_V1286, kl_V1285]) let !aw_7 = Types.Atom (Types.UnboundSym "not") !kl_if_8 <- appl_6 `pseq` applyWrapper aw_7 [appl_6] 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" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_4 of Atom (B (True)) -> do kl_V1286 `pseq` klCons kl_V1286 (Types.Atom Types.Nil) Atom (B (False)) -> do let pat_cond_9 kl_V1286 kl_V1286t kl_V1286th kl_V1286tt kl_V1286tth = do !appl_10 <- kl_V1286th `pseq` (kl_V1285 `pseq` klCons kl_V1286th kl_V1285) appl_10 `pseq` (kl_V1286tth `pseq` kl_shen_extract_free_vars appl_10 kl_V1286tth) pat_cond_11 kl_V1286 kl_V1286t kl_V1286th kl_V1286tt kl_V1286tth kl_V1286ttt kl_V1286ttth = do !appl_12 <- kl_V1285 `pseq` (kl_V1286tth `pseq` kl_shen_extract_free_vars kl_V1285 kl_V1286tth) !appl_13 <- kl_V1286th `pseq` (kl_V1285 `pseq` klCons kl_V1286th kl_V1285) !appl_14 <- appl_13 `pseq` (kl_V1286ttth `pseq` kl_shen_extract_free_vars appl_13 kl_V1286ttth) let !aw_15 = Types.Atom (Types.UnboundSym "union") appl_12 `pseq` (appl_14 `pseq` applyWrapper aw_15 [appl_12, appl_14]) pat_cond_16 kl_V1286 kl_V1286h kl_V1286t = do !appl_17 <- kl_V1285 `pseq` (kl_V1286h `pseq` kl_shen_extract_free_vars kl_V1285 kl_V1286h) !appl_18 <- kl_V1285 `pseq` (kl_V1286t `pseq` kl_shen_extract_free_vars kl_V1285 kl_V1286t) let !aw_19 = Types.Atom (Types.UnboundSym "union") appl_17 `pseq` (appl_18 `pseq` applyWrapper aw_19 [appl_17, appl_18]) pat_cond_20 = do do return (Types.Atom Types.Nil) in case kl_V1286 of !(kl_V1286@(Cons (Atom (UnboundSym "lambda")) (!(kl_V1286t@(Cons (!kl_V1286th) (!(kl_V1286tt@(Cons (!kl_V1286tth) (Atom (Nil)))))))))) -> pat_cond_9 kl_V1286 kl_V1286t kl_V1286th kl_V1286tt kl_V1286tth !(kl_V1286@(Cons (ApplC (PL "lambda" _)) (!(kl_V1286t@(Cons (!kl_V1286th) (!(kl_V1286tt@(Cons (!kl_V1286tth) (Atom (Nil)))))))))) -> pat_cond_9 kl_V1286 kl_V1286t kl_V1286th kl_V1286tt kl_V1286tth !(kl_V1286@(Cons (ApplC (Func "lambda" _)) (!(kl_V1286t@(Cons (!kl_V1286th) (!(kl_V1286tt@(Cons (!kl_V1286tth) (Atom (Nil)))))))))) -> pat_cond_9 kl_V1286 kl_V1286t kl_V1286th kl_V1286tt kl_V1286tth !(kl_V1286@(Cons (Atom (UnboundSym "let")) (!(kl_V1286t@(Cons (!kl_V1286th) (!(kl_V1286tt@(Cons (!kl_V1286tth) (!(kl_V1286ttt@(Cons (!kl_V1286ttth) (Atom (Nil))))))))))))) -> pat_cond_11 kl_V1286 kl_V1286t kl_V1286th kl_V1286tt kl_V1286tth kl_V1286ttt kl_V1286ttth !(kl_V1286@(Cons (ApplC (PL "let" _)) (!(kl_V1286t@(Cons (!kl_V1286th) (!(kl_V1286tt@(Cons (!kl_V1286tth) (!(kl_V1286ttt@(Cons (!kl_V1286ttth) (Atom (Nil))))))))))))) -> pat_cond_11 kl_V1286 kl_V1286t kl_V1286th kl_V1286tt kl_V1286tth kl_V1286ttt kl_V1286ttth !(kl_V1286@(Cons (ApplC (Func "let" _)) (!(kl_V1286t@(Cons (!kl_V1286th) (!(kl_V1286tt@(Cons (!kl_V1286tth) (!(kl_V1286ttt@(Cons (!kl_V1286ttth) (Atom (Nil))))))))))))) -> pat_cond_11 kl_V1286 kl_V1286t kl_V1286th kl_V1286tt kl_V1286tth kl_V1286ttt kl_V1286ttth !(kl_V1286@(Cons (!kl_V1286h) (!kl_V1286t))) -> pat_cond_16 kl_V1286 kl_V1286h kl_V1286t _ -> pat_cond_20 _ -> throwError "if: expected boolean" in case kl_V1286 of !(kl_V1286@(Cons (Atom (UnboundSym "protect")) (!(kl_V1286t@(Cons (!kl_V1286th) (Atom (Nil))))))) -> pat_cond_0 kl_V1286 kl_V1286t kl_V1286th !(kl_V1286@(Cons (ApplC (PL "protect" _)) (!(kl_V1286t@(Cons (!kl_V1286th) (Atom (Nil))))))) -> pat_cond_0 kl_V1286 kl_V1286t kl_V1286th !(kl_V1286@(Cons (ApplC (Func "protect" _)) (!(kl_V1286t@(Cons (!kl_V1286th) (Atom (Nil))))))) -> pat_cond_0 kl_V1286 kl_V1286t kl_V1286th _ -> pat_cond_1 kl_shen_free_variable_warnings :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_free_variable_warnings (!kl_V1291) (!kl_V1292) = do let pat_cond_0 = do return (Types.Atom (Types.UnboundSym "_")) pat_cond_1 = do do !appl_2 <- kl_V1292 `pseq` kl_shen_list_variables kl_V1292 let !aw_3 = Types.Atom (Types.UnboundSym "shen.app") !appl_4 <- appl_2 `pseq` applyWrapper aw_3 [appl_2, Types.Atom (Types.Str ""), Types.Atom (Types.UnboundSym "shen.a")] !appl_5 <- appl_4 `pseq` cn (Types.Atom (Types.Str ": ")) appl_4 let !aw_6 = Types.Atom (Types.UnboundSym "shen.app") !appl_7 <- kl_V1291 `pseq` (appl_5 `pseq` applyWrapper aw_6 [kl_V1291, appl_5, Types.Atom (Types.UnboundSym "shen.a")]) !appl_8 <- appl_7 `pseq` cn (Types.Atom (Types.Str "error: the following variables are free in ")) appl_7 appl_8 `pseq` simpleError appl_8 in case kl_V1292 of kl_V1292@(Atom (Nil)) -> pat_cond_0 _ -> pat_cond_1 kl_shen_list_variables :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_list_variables (!kl_V1294) = do let pat_cond_0 kl_V1294 kl_V1294h = do !appl_1 <- kl_V1294h `pseq` str kl_V1294h appl_1 `pseq` cn appl_1 (Types.Atom (Types.Str ".")) pat_cond_2 kl_V1294 kl_V1294h kl_V1294t = do !appl_3 <- kl_V1294h `pseq` str kl_V1294h !appl_4 <- kl_V1294t `pseq` kl_shen_list_variables kl_V1294t !appl_5 <- appl_4 `pseq` cn (Types.Atom (Types.Str ", ")) appl_4 appl_3 `pseq` (appl_5 `pseq` cn appl_3 appl_5) pat_cond_6 = do do let !aw_7 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_7 [ApplC (wrapNamed "shen.list_variables" kl_shen_list_variables)] in case kl_V1294 of !(kl_V1294@(Cons (!kl_V1294h) (Atom (Nil)))) -> pat_cond_0 kl_V1294 kl_V1294h !(kl_V1294@(Cons (!kl_V1294h) (!kl_V1294t))) -> pat_cond_2 kl_V1294 kl_V1294h kl_V1294t _ -> pat_cond_6 kl_shen_strip_protect :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_strip_protect (!kl_V1296) = do let pat_cond_0 kl_V1296 kl_V1296t kl_V1296th = do kl_V1296th `pseq` kl_shen_strip_protect kl_V1296th pat_cond_1 kl_V1296 kl_V1296h kl_V1296t = do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_strip_protect kl_Z))) let !aw_3 = Types.Atom (Types.UnboundSym "map") appl_2 `pseq` (kl_V1296 `pseq` applyWrapper aw_3 [appl_2, kl_V1296]) pat_cond_4 = do do return kl_V1296 in case kl_V1296 of !(kl_V1296@(Cons (Atom (UnboundSym "protect")) (!(kl_V1296t@(Cons (!kl_V1296th) (Atom (Nil))))))) -> pat_cond_0 kl_V1296 kl_V1296t kl_V1296th !(kl_V1296@(Cons (ApplC (PL "protect" _)) (!(kl_V1296t@(Cons (!kl_V1296th) (Atom (Nil))))))) -> pat_cond_0 kl_V1296 kl_V1296t kl_V1296th !(kl_V1296@(Cons (ApplC (Func "protect" _)) (!(kl_V1296t@(Cons (!kl_V1296th) (Atom (Nil))))))) -> pat_cond_0 kl_V1296 kl_V1296t kl_V1296th !(kl_V1296@(Cons (!kl_V1296h) (!kl_V1296t))) -> pat_cond_1 kl_V1296 kl_V1296h kl_V1296t _ -> pat_cond_4 kl_shen_linearise :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_linearise (!kl_V1298) = do let pat_cond_0 kl_V1298 kl_V1298h kl_V1298t kl_V1298th = do !appl_1 <- kl_V1298h `pseq` kl_shen_flatten kl_V1298h appl_1 `pseq` (kl_V1298h `pseq` (kl_V1298th `pseq` kl_shen_linearise_help appl_1 kl_V1298h kl_V1298th)) pat_cond_2 = do do let !aw_3 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_3 [ApplC (wrapNamed "shen.linearise" kl_shen_linearise)] in case kl_V1298 of !(kl_V1298@(Cons (!kl_V1298h) (!(kl_V1298t@(Cons (!kl_V1298th) (Atom (Nil))))))) -> pat_cond_0 kl_V1298 kl_V1298h kl_V1298t kl_V1298th _ -> pat_cond_2 kl_shen_flatten :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_flatten (!kl_V1300) = do let pat_cond_0 = do return (Types.Atom Types.Nil) pat_cond_1 kl_V1300 kl_V1300h kl_V1300t = do !appl_2 <- kl_V1300h `pseq` kl_shen_flatten kl_V1300h !appl_3 <- kl_V1300t `pseq` kl_shen_flatten kl_V1300t let !aw_4 = Types.Atom (Types.UnboundSym "append") appl_2 `pseq` (appl_3 `pseq` applyWrapper aw_4 [appl_2, appl_3]) pat_cond_5 = do do kl_V1300 `pseq` klCons kl_V1300 (Types.Atom Types.Nil) in case kl_V1300 of kl_V1300@(Atom (Nil)) -> pat_cond_0 !(kl_V1300@(Cons (!kl_V1300h) (!kl_V1300t))) -> pat_cond_1 kl_V1300 kl_V1300h kl_V1300t _ -> pat_cond_5 kl_shen_linearise_help :: Types.KLValue -> Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_linearise_help (!kl_V1304) (!kl_V1305) (!kl_V1306) = do let pat_cond_0 = do !appl_1 <- kl_V1306 `pseq` klCons kl_V1306 (Types.Atom Types.Nil) kl_V1305 `pseq` (appl_1 `pseq` klCons kl_V1305 appl_1) pat_cond_2 kl_V1304 kl_V1304h kl_V1304t = do let !aw_3 = Types.Atom (Types.UnboundSym "variable?") !kl_if_4 <- kl_V1304h `pseq` applyWrapper aw_3 [kl_V1304h] !kl_if_5 <- case kl_if_4 of Atom (B (True)) -> do let !aw_6 = Types.Atom (Types.UnboundSym "element?") !kl_if_7 <- kl_V1304h `pseq` (kl_V1304t `pseq` applyWrapper aw_6 [kl_V1304h, kl_V1304t]) 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 let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Var) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_NewAction) -> do let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_NewPatts) -> do kl_V1304t `pseq` (kl_NewPatts `pseq` (kl_NewAction `pseq` kl_shen_linearise_help kl_V1304t kl_NewPatts kl_NewAction))))) !appl_11 <- kl_V1304h `pseq` (kl_Var `pseq` (kl_V1305 `pseq` kl_shen_linearise_X kl_V1304h kl_Var kl_V1305)) appl_11 `pseq` applyWrapper appl_10 [appl_11]))) !appl_12 <- kl_Var `pseq` klCons kl_Var (Types.Atom Types.Nil) !appl_13 <- kl_V1304h `pseq` (appl_12 `pseq` klCons kl_V1304h appl_12) !appl_14 <- appl_13 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_13 !appl_15 <- kl_V1306 `pseq` klCons kl_V1306 (Types.Atom Types.Nil) !appl_16 <- appl_14 `pseq` (appl_15 `pseq` klCons appl_14 appl_15) !appl_17 <- appl_16 `pseq` klCons (Types.Atom (Types.UnboundSym "where")) appl_16 appl_17 `pseq` applyWrapper appl_9 [appl_17]))) let !aw_18 = Types.Atom (Types.UnboundSym "gensym") !appl_19 <- kl_V1304h `pseq` applyWrapper aw_18 [kl_V1304h] appl_19 `pseq` applyWrapper appl_8 [appl_19] Atom (B (False)) -> do do kl_V1304t `pseq` (kl_V1305 `pseq` (kl_V1306 `pseq` kl_shen_linearise_help kl_V1304t kl_V1305 kl_V1306)) _ -> throwError "if: expected boolean" pat_cond_20 = do do let !aw_21 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_21 [ApplC (wrapNamed "shen.linearise_help" kl_shen_linearise_help)] in case kl_V1304 of kl_V1304@(Atom (Nil)) -> pat_cond_0 !(kl_V1304@(Cons (!kl_V1304h) (!kl_V1304t))) -> pat_cond_2 kl_V1304 kl_V1304h kl_V1304t _ -> pat_cond_20 kl_shen_linearise_X :: Types.KLValue -> Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_linearise_X (!kl_V1319) (!kl_V1320) (!kl_V1321) = do !kl_if_0 <- kl_V1321 `pseq` (kl_V1319 `pseq` eq kl_V1321 kl_V1319) case kl_if_0 of Atom (B (True)) -> do return kl_V1320 Atom (B (False)) -> do let pat_cond_1 kl_V1321 kl_V1321h kl_V1321t = do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_L) -> do !kl_if_3 <- kl_L `pseq` (kl_V1321h `pseq` eq kl_L kl_V1321h) case kl_if_3 of Atom (B (True)) -> do !appl_4 <- kl_V1319 `pseq` (kl_V1320 `pseq` (kl_V1321t `pseq` kl_shen_linearise_X kl_V1319 kl_V1320 kl_V1321t)) kl_V1321h `pseq` (appl_4 `pseq` klCons kl_V1321h appl_4) Atom (B (False)) -> do do kl_L `pseq` (kl_V1321t `pseq` klCons kl_L kl_V1321t) _ -> throwError "if: expected boolean"))) !appl_5 <- kl_V1319 `pseq` (kl_V1320 `pseq` (kl_V1321h `pseq` kl_shen_linearise_X kl_V1319 kl_V1320 kl_V1321h)) appl_5 `pseq` applyWrapper appl_2 [appl_5] pat_cond_6 = do do return kl_V1321 in case kl_V1321 of !(kl_V1321@(Cons (!kl_V1321h) (!kl_V1321t))) -> pat_cond_1 kl_V1321 kl_V1321h kl_V1321t _ -> pat_cond_6 _ -> throwError "if: expected boolean" kl_shen_aritycheck :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_aritycheck (!kl_V1324) (!kl_V1325) = do let pat_cond_0 kl_V1325 kl_V1325h kl_V1325hh kl_V1325ht kl_V1325hth = do !appl_1 <- kl_V1325hth `pseq` kl_shen_aritycheck_action kl_V1325hth let !aw_2 = Types.Atom (Types.UnboundSym "arity") !appl_3 <- kl_V1324 `pseq` applyWrapper aw_2 [kl_V1324] let !aw_4 = Types.Atom (Types.UnboundSym "length") !appl_5 <- kl_V1325hh `pseq` applyWrapper aw_4 [kl_V1325hh] !appl_6 <- kl_V1324 `pseq` (appl_3 `pseq` (appl_5 `pseq` kl_shen_aritycheck_name kl_V1324 appl_3 appl_5)) let !aw_7 = Types.Atom (Types.UnboundSym "do") appl_1 `pseq` (appl_6 `pseq` applyWrapper aw_7 [appl_1, appl_6]) pat_cond_8 kl_V1325 kl_V1325h kl_V1325hh kl_V1325ht kl_V1325hth kl_V1325t kl_V1325th kl_V1325thh kl_V1325tht kl_V1325thth kl_V1325tt = do let !aw_9 = Types.Atom (Types.UnboundSym "length") !appl_10 <- kl_V1325hh `pseq` applyWrapper aw_9 [kl_V1325hh] let !aw_11 = Types.Atom (Types.UnboundSym "length") !appl_12 <- kl_V1325thh `pseq` applyWrapper aw_11 [kl_V1325thh] !kl_if_13 <- appl_10 `pseq` (appl_12 `pseq` eq appl_10 appl_12) case kl_if_13 of Atom (B (True)) -> do !appl_14 <- kl_V1325hth `pseq` kl_shen_aritycheck_action kl_V1325hth !appl_15 <- kl_V1324 `pseq` (kl_V1325t `pseq` kl_shen_aritycheck kl_V1324 kl_V1325t) let !aw_16 = Types.Atom (Types.UnboundSym "do") appl_14 `pseq` (appl_15 `pseq` applyWrapper aw_16 [appl_14, appl_15]) Atom (B (False)) -> do do let !aw_17 = Types.Atom (Types.UnboundSym "shen.app") !appl_18 <- kl_V1324 `pseq` applyWrapper aw_17 [kl_V1324, Types.Atom (Types.Str "\n"), Types.Atom (Types.UnboundSym "shen.a")] !appl_19 <- appl_18 `pseq` cn (Types.Atom (Types.Str "arity error in ")) appl_18 appl_19 `pseq` simpleError appl_19 _ -> throwError "if: expected boolean" pat_cond_20 = do do let !aw_21 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_21 [ApplC (wrapNamed "shen.aritycheck" kl_shen_aritycheck)] in case kl_V1325 of !(kl_V1325@(Cons (!(kl_V1325h@(Cons (!kl_V1325hh) (!(kl_V1325ht@(Cons (!kl_V1325hth) (Atom (Nil)))))))) (Atom (Nil)))) -> pat_cond_0 kl_V1325 kl_V1325h kl_V1325hh kl_V1325ht kl_V1325hth !(kl_V1325@(Cons (!(kl_V1325h@(Cons (!kl_V1325hh) (!(kl_V1325ht@(Cons (!kl_V1325hth) (Atom (Nil)))))))) (!(kl_V1325t@(Cons (!(kl_V1325th@(Cons (!kl_V1325thh) (!(kl_V1325tht@(Cons (!kl_V1325thth) (Atom (Nil)))))))) (!kl_V1325tt)))))) -> pat_cond_8 kl_V1325 kl_V1325h kl_V1325hh kl_V1325ht kl_V1325hth kl_V1325t kl_V1325th kl_V1325thh kl_V1325tht kl_V1325thth kl_V1325tt _ -> pat_cond_20 kl_shen_aritycheck_name :: Types.KLValue -> Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_aritycheck_name (!kl_V1338) (!kl_V1339) (!kl_V1340) = do let pat_cond_0 = do return kl_V1340 pat_cond_1 = do !kl_if_2 <- kl_V1340 `pseq` (kl_V1339 `pseq` eq kl_V1340 kl_V1339) case kl_if_2 of Atom (B (True)) -> do return kl_V1340 Atom (B (False)) -> do do let !aw_3 = Types.Atom (Types.UnboundSym "shen.app") !appl_4 <- kl_V1338 `pseq` applyWrapper aw_3 [kl_V1338, Types.Atom (Types.Str " can cause errors.\n"), Types.Atom (Types.UnboundSym "shen.a")] !appl_5 <- appl_4 `pseq` cn (Types.Atom (Types.Str "\nwarning: changing the arity of ")) appl_4 let !aw_6 = Types.Atom (Types.UnboundSym "stoutput") !appl_7 <- applyWrapper aw_6 [] let !aw_8 = Types.Atom (Types.UnboundSym "shen.prhush") !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, appl_7]) let !aw_10 = Types.Atom (Types.UnboundSym "do") appl_9 `pseq` (kl_V1340 `pseq` applyWrapper aw_10 [appl_9, kl_V1340]) _ -> throwError "if: expected boolean" in case kl_V1339 of kl_V1339@(Atom (N (KI (-1)))) -> pat_cond_0 _ -> pat_cond_1 kl_shen_aritycheck_action :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_aritycheck_action (!kl_V1346) = do let pat_cond_0 kl_V1346 kl_V1346h kl_V1346t = do !appl_1 <- kl_V1346h `pseq` (kl_V1346t `pseq` kl_shen_aah kl_V1346h kl_V1346t) let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do kl_Y `pseq` kl_shen_aritycheck_action kl_Y))) let !aw_3 = Types.Atom (Types.UnboundSym "map") !appl_4 <- appl_2 `pseq` (kl_V1346 `pseq` applyWrapper aw_3 [appl_2, kl_V1346]) let !aw_5 = Types.Atom (Types.UnboundSym "do") appl_1 `pseq` (appl_4 `pseq` applyWrapper aw_5 [appl_1, appl_4]) pat_cond_6 = do do return (Types.Atom (Types.UnboundSym "shen.skip")) in case kl_V1346 of !(kl_V1346@(Cons (!kl_V1346h) (!kl_V1346t))) -> pat_cond_0 kl_V1346 kl_V1346h kl_V1346t _ -> pat_cond_6 kl_shen_aah :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_aah (!kl_V1349) (!kl_V1350) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Arity) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Len) -> do !kl_if_2 <- kl_Arity `pseq` greaterThan kl_Arity (Types.Atom (Types.N (Types.KI (-1)))) !kl_if_3 <- case kl_if_2 of Atom (B (True)) -> do !kl_if_4 <- kl_Len `pseq` (kl_Arity `pseq` greaterThan kl_Len kl_Arity) 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_3 of Atom (B (True)) -> do !kl_if_5 <- kl_Len `pseq` greaterThan kl_Len (Types.Atom (Types.N (Types.KI 1))) !appl_6 <- case kl_if_5 of Atom (B (True)) -> do return (Types.Atom (Types.Str "s")) Atom (B (False)) -> do do return (Types.Atom (Types.Str "")) _ -> throwError "if: expected boolean" let !aw_7 = Types.Atom (Types.UnboundSym "shen.app") !appl_8 <- appl_6 `pseq` applyWrapper aw_7 [appl_6, Types.Atom (Types.Str ".\n"), Types.Atom (Types.UnboundSym "shen.a")] !appl_9 <- appl_8 `pseq` cn (Types.Atom (Types.Str " argument")) appl_8 let !aw_10 = Types.Atom (Types.UnboundSym "shen.app") !appl_11 <- kl_Len `pseq` (appl_9 `pseq` applyWrapper aw_10 [kl_Len, appl_9, Types.Atom (Types.UnboundSym "shen.a")]) !appl_12 <- appl_11 `pseq` cn (Types.Atom (Types.Str " might not like ")) appl_11 let !aw_13 = Types.Atom (Types.UnboundSym "shen.app") !appl_14 <- kl_V1349 `pseq` (appl_12 `pseq` applyWrapper aw_13 [kl_V1349, appl_12, Types.Atom (Types.UnboundSym "shen.a")]) !appl_15 <- appl_14 `pseq` cn (Types.Atom (Types.Str "warning: ")) appl_14 let !aw_16 = Types.Atom (Types.UnboundSym "stoutput") !appl_17 <- applyWrapper aw_16 [] let !aw_18 = Types.Atom (Types.UnboundSym "shen.prhush") appl_15 `pseq` (appl_17 `pseq` applyWrapper aw_18 [appl_15, appl_17]) Atom (B (False)) -> do do return (Types.Atom (Types.UnboundSym "shen.skip")) _ -> throwError "if: expected boolean"))) let !aw_19 = Types.Atom (Types.UnboundSym "length") !appl_20 <- kl_V1350 `pseq` applyWrapper aw_19 [kl_V1350] appl_20 `pseq` applyWrapper appl_1 [appl_20]))) let !aw_21 = Types.Atom (Types.UnboundSym "arity") !appl_22 <- kl_V1349 `pseq` applyWrapper aw_21 [kl_V1349] appl_22 `pseq` applyWrapper appl_0 [appl_22] kl_shen_abstract_rule :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_abstract_rule (!kl_V1352) = do let pat_cond_0 kl_V1352 kl_V1352h kl_V1352t kl_V1352th = do kl_V1352h `pseq` (kl_V1352th `pseq` kl_shen_abstraction_build kl_V1352h kl_V1352th) pat_cond_1 = do do let !aw_2 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_2 [ApplC (wrapNamed "shen.abstract_rule" kl_shen_abstract_rule)] in case kl_V1352 of !(kl_V1352@(Cons (!kl_V1352h) (!(kl_V1352t@(Cons (!kl_V1352th) (Atom (Nil))))))) -> pat_cond_0 kl_V1352 kl_V1352h kl_V1352t kl_V1352th _ -> pat_cond_1 kl_shen_abstraction_build :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_abstraction_build (!kl_V1355) (!kl_V1356) = do let pat_cond_0 = do return kl_V1356 pat_cond_1 kl_V1355 kl_V1355h kl_V1355t = do !appl_2 <- kl_V1355t `pseq` (kl_V1356 `pseq` kl_shen_abstraction_build kl_V1355t kl_V1356) !appl_3 <- appl_2 `pseq` klCons appl_2 (Types.Atom Types.Nil) !appl_4 <- kl_V1355h `pseq` (appl_3 `pseq` klCons kl_V1355h appl_3) appl_4 `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) appl_4 pat_cond_5 = do do let !aw_6 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_6 [ApplC (wrapNamed "shen.abstraction_build" kl_shen_abstraction_build)] in case kl_V1355 of kl_V1355@(Atom (Nil)) -> pat_cond_0 !(kl_V1355@(Cons (!kl_V1355h) (!kl_V1355t))) -> pat_cond_1 kl_V1355 kl_V1355h kl_V1355t _ -> pat_cond_5 kl_shen_parameters :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_parameters (!kl_V1358) = do let pat_cond_0 = do return (Types.Atom Types.Nil) pat_cond_1 = do do let !aw_2 = Types.Atom (Types.UnboundSym "gensym") !appl_3 <- applyWrapper aw_2 [Types.Atom (Types.UnboundSym "V")] !appl_4 <- kl_V1358 `pseq` Primitives.subtract kl_V1358 (Types.Atom (Types.N (Types.KI 1))) !appl_5 <- appl_4 `pseq` kl_shen_parameters appl_4 appl_3 `pseq` (appl_5 `pseq` klCons appl_3 appl_5) in case kl_V1358 of kl_V1358@(Atom (N (KI 0))) -> pat_cond_0 _ -> pat_cond_1 kl_shen_application_build :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_application_build (!kl_V1361) (!kl_V1362) = do let pat_cond_0 = do return kl_V1362 pat_cond_1 kl_V1361 kl_V1361h kl_V1361t = do !appl_2 <- kl_V1361h `pseq` klCons kl_V1361h (Types.Atom Types.Nil) !appl_3 <- kl_V1362 `pseq` (appl_2 `pseq` klCons kl_V1362 appl_2) kl_V1361t `pseq` (appl_3 `pseq` kl_shen_application_build kl_V1361t appl_3) pat_cond_4 = do do let !aw_5 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_5 [ApplC (wrapNamed "shen.application_build" kl_shen_application_build)] in case kl_V1361 of kl_V1361@(Atom (Nil)) -> pat_cond_0 !(kl_V1361@(Cons (!kl_V1361h) (!kl_V1361t))) -> pat_cond_1 kl_V1361 kl_V1361h kl_V1361t _ -> pat_cond_4 kl_shen_compile_to_kl :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_compile_to_kl (!kl_V1365) (!kl_V1366) = do let pat_cond_0 kl_V1366 kl_V1366h kl_V1366t kl_V1366th = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Arity) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Reduce) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_CondExpression) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_TypeTable) -> do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_TypedCondExpression) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_KL) -> do return kl_KL))) !appl_7 <- kl_TypedCondExpression `pseq` klCons kl_TypedCondExpression (Types.Atom Types.Nil) !appl_8 <- kl_V1366h `pseq` (appl_7 `pseq` klCons kl_V1366h appl_7) !appl_9 <- kl_V1365 `pseq` (appl_8 `pseq` klCons kl_V1365 appl_8) !appl_10 <- appl_9 `pseq` klCons (Types.Atom (Types.UnboundSym "defun")) appl_9 appl_10 `pseq` applyWrapper appl_6 [appl_10]))) !kl_if_11 <- value (Types.Atom (Types.UnboundSym "shen.*optimise*")) !appl_12 <- case kl_if_11 of Atom (B (True)) -> do kl_V1366h `pseq` (kl_TypeTable `pseq` (kl_CondExpression `pseq` kl_shen_assign_types kl_V1366h kl_TypeTable kl_CondExpression)) Atom (B (False)) -> do do return kl_CondExpression _ -> throwError "if: expected boolean" appl_12 `pseq` applyWrapper appl_5 [appl_12]))) !kl_if_13 <- value (Types.Atom (Types.UnboundSym "shen.*optimise*")) !appl_14 <- case kl_if_13 of Atom (B (True)) -> do !appl_15 <- kl_V1365 `pseq` kl_shen_get_type kl_V1365 appl_15 `pseq` (kl_V1366h `pseq` kl_shen_typextable appl_15 kl_V1366h) Atom (B (False)) -> do do return (Types.Atom (Types.UnboundSym "shen.skip")) _ -> throwError "if: expected boolean" appl_14 `pseq` applyWrapper appl_4 [appl_14]))) !appl_16 <- kl_V1365 `pseq` (kl_V1366h `pseq` (kl_Reduce `pseq` kl_shen_cond_expression kl_V1365 kl_V1366h kl_Reduce)) appl_16 `pseq` applyWrapper appl_3 [appl_16]))) let !appl_17 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_reduce kl_X))) let !aw_18 = Types.Atom (Types.UnboundSym "map") !appl_19 <- appl_17 `pseq` (kl_V1366th `pseq` applyWrapper aw_18 [appl_17, kl_V1366th]) appl_19 `pseq` applyWrapper appl_2 [appl_19]))) let !aw_20 = Types.Atom (Types.UnboundSym "length") !appl_21 <- kl_V1366h `pseq` applyWrapper aw_20 [kl_V1366h] !appl_22 <- kl_V1365 `pseq` (appl_21 `pseq` kl_shen_store_arity kl_V1365 appl_21) appl_22 `pseq` applyWrapper appl_1 [appl_22] pat_cond_23 = do do let !aw_24 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_24 [ApplC (wrapNamed "shen.compile_to_kl" kl_shen_compile_to_kl)] in case kl_V1366 of !(kl_V1366@(Cons (!kl_V1366h) (!(kl_V1366t@(Cons (!kl_V1366th) (Atom (Nil))))))) -> pat_cond_0 kl_V1366 kl_V1366h kl_V1366t kl_V1366th _ -> pat_cond_23 kl_shen_get_type :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_get_type (!kl_V1372) = do let pat_cond_0 kl_V1372 kl_V1372h kl_V1372t = do return (Types.Atom (Types.UnboundSym "shen.skip")) pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_FType) -> do let !aw_3 = Types.Atom (Types.UnboundSym "empty?") !kl_if_4 <- kl_FType `pseq` applyWrapper aw_3 [kl_FType] case kl_if_4 of Atom (B (True)) -> do return (Types.Atom (Types.UnboundSym "shen.skip")) Atom (B (False)) -> do do kl_FType `pseq` tl kl_FType _ -> throwError "if: expected boolean"))) !appl_5 <- value (Types.Atom (Types.UnboundSym "shen.*signedfuncs*")) let !aw_6 = Types.Atom (Types.UnboundSym "assoc") !appl_7 <- kl_V1372 `pseq` (appl_5 `pseq` applyWrapper aw_6 [kl_V1372, appl_5]) appl_7 `pseq` applyWrapper appl_2 [appl_7] in case kl_V1372 of !(kl_V1372@(Cons (!kl_V1372h) (!kl_V1372t))) -> pat_cond_0 kl_V1372 kl_V1372h kl_V1372t _ -> pat_cond_1 kl_shen_typextable :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_typextable (!kl_V1383) (!kl_V1384) = do !kl_if_0 <- let pat_cond_1 kl_V1383 kl_V1383h kl_V1383t = do !kl_if_2 <- let pat_cond_3 kl_V1383t kl_V1383th kl_V1383tt = do !kl_if_4 <- let pat_cond_5 = do !kl_if_6 <- let pat_cond_7 kl_V1383tt kl_V1383tth kl_V1383ttt = do !kl_if_8 <- let pat_cond_9 = do let pat_cond_10 kl_V1384 kl_V1384h kl_V1384t = do return (Atom (B True)) pat_cond_11 = do do return (Atom (B False)) in case kl_V1384 of !(kl_V1384@(Cons (!kl_V1384h) (!kl_V1384t))) -> pat_cond_10 kl_V1384 kl_V1384h kl_V1384t _ -> pat_cond_11 pat_cond_12 = do do return (Atom (B False)) in case kl_V1383ttt of kl_V1383ttt@(Atom (Nil)) -> pat_cond_9 _ -> 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_V1383tt of !(kl_V1383tt@(Cons (!kl_V1383tth) (!kl_V1383ttt))) -> pat_cond_7 kl_V1383tt kl_V1383tth kl_V1383ttt _ -> 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_V1383th of kl_V1383th@(Atom (UnboundSym "-->")) -> pat_cond_5 kl_V1383th@(ApplC (PL "-->" _)) -> pat_cond_5 kl_V1383th@(ApplC (Func "-->" _)) -> pat_cond_5 _ -> 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_V1383t of !(kl_V1383t@(Cons (!kl_V1383th) (!kl_V1383tt))) -> pat_cond_3 kl_V1383t kl_V1383th kl_V1383tt _ -> 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_V1383 of !(kl_V1383@(Cons (!kl_V1383h) (!kl_V1383t))) -> pat_cond_1 kl_V1383 kl_V1383h kl_V1383t _ -> pat_cond_16 case kl_if_0 of Atom (B (True)) -> do !appl_17 <- kl_V1383 `pseq` hd kl_V1383 let !aw_18 = Types.Atom (Types.UnboundSym "variable?") !kl_if_19 <- appl_17 `pseq` applyWrapper aw_18 [appl_17] case kl_if_19 of Atom (B (True)) -> do !appl_20 <- kl_V1383 `pseq` tl kl_V1383 !appl_21 <- appl_20 `pseq` tl appl_20 !appl_22 <- appl_21 `pseq` hd appl_21 !appl_23 <- kl_V1384 `pseq` tl kl_V1384 appl_22 `pseq` (appl_23 `pseq` kl_shen_typextable appl_22 appl_23) Atom (B (False)) -> do do !appl_24 <- kl_V1384 `pseq` hd kl_V1384 !appl_25 <- kl_V1383 `pseq` hd kl_V1383 !appl_26 <- appl_24 `pseq` (appl_25 `pseq` klCons appl_24 appl_25) !appl_27 <- kl_V1383 `pseq` tl kl_V1383 !appl_28 <- appl_27 `pseq` tl appl_27 !appl_29 <- appl_28 `pseq` hd appl_28 !appl_30 <- kl_V1384 `pseq` tl kl_V1384 !appl_31 <- appl_29 `pseq` (appl_30 `pseq` kl_shen_typextable appl_29 appl_30) appl_26 `pseq` (appl_31 `pseq` klCons appl_26 appl_31) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Types.Atom Types.Nil) _ -> throwError "if: expected boolean" kl_shen_assign_types :: Types.KLValue -> Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_assign_types (!kl_V1388) (!kl_V1389) (!kl_V1390) = do let pat_cond_0 kl_V1390 kl_V1390t kl_V1390th kl_V1390tt kl_V1390tth kl_V1390ttt kl_V1390ttth = do !appl_1 <- kl_V1388 `pseq` (kl_V1389 `pseq` (kl_V1390tth `pseq` kl_shen_assign_types kl_V1388 kl_V1389 kl_V1390tth)) !appl_2 <- kl_V1390th `pseq` (kl_V1388 `pseq` klCons kl_V1390th kl_V1388) !appl_3 <- appl_2 `pseq` (kl_V1389 `pseq` (kl_V1390ttth `pseq` kl_shen_assign_types appl_2 kl_V1389 kl_V1390ttth)) !appl_4 <- appl_3 `pseq` klCons appl_3 (Types.Atom Types.Nil) !appl_5 <- appl_1 `pseq` (appl_4 `pseq` klCons appl_1 appl_4) !appl_6 <- kl_V1390th `pseq` (appl_5 `pseq` klCons kl_V1390th appl_5) appl_6 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_6 pat_cond_7 kl_V1390 kl_V1390t kl_V1390th kl_V1390tt kl_V1390tth = do !appl_8 <- kl_V1390th `pseq` (kl_V1388 `pseq` klCons kl_V1390th kl_V1388) !appl_9 <- appl_8 `pseq` (kl_V1389 `pseq` (kl_V1390tth `pseq` kl_shen_assign_types appl_8 kl_V1389 kl_V1390tth)) !appl_10 <- appl_9 `pseq` klCons appl_9 (Types.Atom Types.Nil) !appl_11 <- kl_V1390th `pseq` (appl_10 `pseq` klCons kl_V1390th appl_10) appl_11 `pseq` klCons (Types.Atom (Types.UnboundSym "lambda")) appl_11 pat_cond_12 kl_V1390 kl_V1390t = do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do !appl_14 <- kl_Y `pseq` hd kl_Y !appl_15 <- kl_V1388 `pseq` (kl_V1389 `pseq` (appl_14 `pseq` kl_shen_assign_types kl_V1388 kl_V1389 appl_14)) !appl_16 <- kl_Y `pseq` tl kl_Y !appl_17 <- appl_16 `pseq` hd appl_16 !appl_18 <- kl_V1388 `pseq` (kl_V1389 `pseq` (appl_17 `pseq` kl_shen_assign_types kl_V1388 kl_V1389 appl_17)) !appl_19 <- appl_18 `pseq` klCons appl_18 (Types.Atom Types.Nil) appl_15 `pseq` (appl_19 `pseq` klCons appl_15 appl_19)))) let !aw_20 = Types.Atom (Types.UnboundSym "map") !appl_21 <- appl_13 `pseq` (kl_V1390t `pseq` applyWrapper aw_20 [appl_13, kl_V1390t]) appl_21 `pseq` klCons (Types.Atom (Types.UnboundSym "cond")) appl_21 pat_cond_22 kl_V1390 kl_V1390h kl_V1390t = do let !appl_23 = ApplC (Func "lambda" (Context (\(!kl_NewTable) -> do let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do let !aw_25 = Types.Atom (Types.UnboundSym "append") !appl_26 <- kl_V1389 `pseq` (kl_NewTable `pseq` applyWrapper aw_25 [kl_V1389, kl_NewTable]) kl_V1388 `pseq` (appl_26 `pseq` (kl_Y `pseq` kl_shen_assign_types kl_V1388 appl_26 kl_Y))))) let !aw_27 = Types.Atom (Types.UnboundSym "map") !appl_28 <- appl_24 `pseq` (kl_V1390t `pseq` applyWrapper aw_27 [appl_24, kl_V1390t]) kl_V1390h `pseq` (appl_28 `pseq` klCons kl_V1390h appl_28)))) !appl_29 <- kl_V1390h `pseq` kl_shen_get_type kl_V1390h !appl_30 <- appl_29 `pseq` (kl_V1390t `pseq` kl_shen_typextable appl_29 kl_V1390t) appl_30 `pseq` applyWrapper appl_23 [appl_30] pat_cond_31 = do do let !appl_32 = ApplC (Func "lambda" (Context (\(!kl_AtomType) -> do let pat_cond_33 kl_AtomType kl_AtomTypeh kl_AtomTypet = do !appl_34 <- kl_AtomTypet `pseq` klCons kl_AtomTypet (Types.Atom Types.Nil) !appl_35 <- kl_V1390 `pseq` (appl_34 `pseq` klCons kl_V1390 appl_34) appl_35 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_35 pat_cond_36 = do do let !aw_37 = Types.Atom (Types.UnboundSym "element?") !kl_if_38 <- kl_V1390 `pseq` (kl_V1388 `pseq` applyWrapper aw_37 [kl_V1390, kl_V1388]) case kl_if_38 of Atom (B (True)) -> do return kl_V1390 Atom (B (False)) -> do do kl_V1390 `pseq` kl_shen_atom_type kl_V1390 _ -> throwError "if: expected boolean" in case kl_AtomType of !(kl_AtomType@(Cons (!kl_AtomTypeh) (!kl_AtomTypet))) -> pat_cond_33 kl_AtomType kl_AtomTypeh kl_AtomTypet _ -> pat_cond_36))) let !aw_39 = Types.Atom (Types.UnboundSym "assoc") !appl_40 <- kl_V1390 `pseq` (kl_V1389 `pseq` applyWrapper aw_39 [kl_V1390, kl_V1389]) appl_40 `pseq` applyWrapper appl_32 [appl_40] in case kl_V1390 of !(kl_V1390@(Cons (Atom (UnboundSym "let")) (!(kl_V1390t@(Cons (!kl_V1390th) (!(kl_V1390tt@(Cons (!kl_V1390tth) (!(kl_V1390ttt@(Cons (!kl_V1390ttth) (Atom (Nil))))))))))))) -> pat_cond_0 kl_V1390 kl_V1390t kl_V1390th kl_V1390tt kl_V1390tth kl_V1390ttt kl_V1390ttth !(kl_V1390@(Cons (ApplC (PL "let" _)) (!(kl_V1390t@(Cons (!kl_V1390th) (!(kl_V1390tt@(Cons (!kl_V1390tth) (!(kl_V1390ttt@(Cons (!kl_V1390ttth) (Atom (Nil))))))))))))) -> pat_cond_0 kl_V1390 kl_V1390t kl_V1390th kl_V1390tt kl_V1390tth kl_V1390ttt kl_V1390ttth !(kl_V1390@(Cons (ApplC (Func "let" _)) (!(kl_V1390t@(Cons (!kl_V1390th) (!(kl_V1390tt@(Cons (!kl_V1390tth) (!(kl_V1390ttt@(Cons (!kl_V1390ttth) (Atom (Nil))))))))))))) -> pat_cond_0 kl_V1390 kl_V1390t kl_V1390th kl_V1390tt kl_V1390tth kl_V1390ttt kl_V1390ttth !(kl_V1390@(Cons (Atom (UnboundSym "lambda")) (!(kl_V1390t@(Cons (!kl_V1390th) (!(kl_V1390tt@(Cons (!kl_V1390tth) (Atom (Nil)))))))))) -> pat_cond_7 kl_V1390 kl_V1390t kl_V1390th kl_V1390tt kl_V1390tth !(kl_V1390@(Cons (ApplC (PL "lambda" _)) (!(kl_V1390t@(Cons (!kl_V1390th) (!(kl_V1390tt@(Cons (!kl_V1390tth) (Atom (Nil)))))))))) -> pat_cond_7 kl_V1390 kl_V1390t kl_V1390th kl_V1390tt kl_V1390tth !(kl_V1390@(Cons (ApplC (Func "lambda" _)) (!(kl_V1390t@(Cons (!kl_V1390th) (!(kl_V1390tt@(Cons (!kl_V1390tth) (Atom (Nil)))))))))) -> pat_cond_7 kl_V1390 kl_V1390t kl_V1390th kl_V1390tt kl_V1390tth !(kl_V1390@(Cons (Atom (UnboundSym "cond")) (!kl_V1390t))) -> pat_cond_12 kl_V1390 kl_V1390t !(kl_V1390@(Cons (ApplC (PL "cond" _)) (!kl_V1390t))) -> pat_cond_12 kl_V1390 kl_V1390t !(kl_V1390@(Cons (ApplC (Func "cond" _)) (!kl_V1390t))) -> pat_cond_12 kl_V1390 kl_V1390t !(kl_V1390@(Cons (!kl_V1390h) (!kl_V1390t))) -> pat_cond_22 kl_V1390 kl_V1390h kl_V1390t _ -> pat_cond_31 kl_shen_atom_type :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_atom_type (!kl_V1392) = do !kl_if_0 <- kl_V1392 `pseq` stringP kl_V1392 case kl_if_0 of Atom (B (True)) -> do !appl_1 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) !appl_2 <- kl_V1392 `pseq` (appl_1 `pseq` klCons kl_V1392 appl_1) appl_2 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_2 Atom (B (False)) -> do do !kl_if_3 <- kl_V1392 `pseq` numberP kl_V1392 case kl_if_3 of Atom (B (True)) -> do !appl_4 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) !appl_5 <- kl_V1392 `pseq` (appl_4 `pseq` klCons kl_V1392 appl_4) appl_5 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_5 Atom (B (False)) -> do do let !aw_6 = Types.Atom (Types.UnboundSym "boolean?") !kl_if_7 <- kl_V1392 `pseq` applyWrapper aw_6 [kl_V1392] case kl_if_7 of Atom (B (True)) -> do !appl_8 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) !appl_9 <- kl_V1392 `pseq` (appl_8 `pseq` klCons kl_V1392 appl_8) appl_9 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_9 Atom (B (False)) -> do do let !aw_10 = Types.Atom (Types.UnboundSym "symbol?") !kl_if_11 <- kl_V1392 `pseq` applyWrapper aw_10 [kl_V1392] case kl_if_11 of Atom (B (True)) -> do !appl_12 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) !appl_13 <- kl_V1392 `pseq` (appl_12 `pseq` klCons kl_V1392 appl_12) appl_13 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_13 Atom (B (False)) -> do do return kl_V1392 _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" kl_shen_store_arity :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_store_arity (!kl_V1397) (!kl_V1398) = do !kl_if_0 <- value (Types.Atom (Types.UnboundSym "shen.*installing-kl*")) case kl_if_0 of Atom (B (True)) -> do return (Types.Atom (Types.UnboundSym "shen.skip")) Atom (B (False)) -> do do !appl_1 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) let !aw_2 = Types.Atom (Types.UnboundSym "put") kl_V1397 `pseq` (kl_V1398 `pseq` (appl_1 `pseq` applyWrapper aw_2 [kl_V1397, Types.Atom (Types.UnboundSym "arity"), kl_V1398, appl_1])) _ -> throwError "if: expected boolean" kl_shen_reduce :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_reduce (!kl_V1400) = do !appl_0 <- klSet (Types.Atom (Types.UnboundSym "shen.*teststack*")) (Types.Atom Types.Nil) let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Result) -> do !appl_2 <- value (Types.Atom (Types.UnboundSym "shen.*teststack*")) let !aw_3 = Types.Atom (Types.UnboundSym "reverse") !appl_4 <- appl_2 `pseq` applyWrapper aw_3 [appl_2] !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.tests")) appl_4 !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym ":")) appl_5 !appl_7 <- kl_Result `pseq` klCons kl_Result (Types.Atom Types.Nil) appl_6 `pseq` (appl_7 `pseq` klCons appl_6 appl_7)))) !appl_8 <- kl_V1400 `pseq` kl_shen_reduce_help kl_V1400 !appl_9 <- appl_8 `pseq` applyWrapper appl_1 [appl_8] let !aw_10 = Types.Atom (Types.UnboundSym "do") appl_0 `pseq` (appl_9 `pseq` applyWrapper aw_10 [appl_0, appl_9]) kl_shen_reduce_help :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_reduce_help (!kl_V1402) = do let pat_cond_0 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th = do !appl_1 <- kl_V1402t `pseq` klCons (ApplC (wrapNamed "cons?" consP)) kl_V1402t !appl_2 <- appl_1 `pseq` kl_shen_add_test appl_1 let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Abstraction) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Application) -> do kl_Application `pseq` kl_shen_reduce_help kl_Application))) !appl_5 <- kl_V1402t `pseq` klCons (ApplC (wrapNamed "hd" hd)) kl_V1402t !appl_6 <- appl_5 `pseq` klCons appl_5 (Types.Atom Types.Nil) !appl_7 <- kl_Abstraction `pseq` (appl_6 `pseq` klCons kl_Abstraction appl_6) !appl_8 <- kl_V1402t `pseq` klCons (ApplC (wrapNamed "tl" tl)) kl_V1402t !appl_9 <- appl_8 `pseq` klCons appl_8 (Types.Atom Types.Nil) !appl_10 <- appl_7 `pseq` (appl_9 `pseq` klCons appl_7 appl_9) appl_10 `pseq` applyWrapper appl_4 [appl_10]))) !appl_11 <- kl_V1402th `pseq` (kl_V1402hth `pseq` (kl_V1402htth `pseq` kl_shen_ebr kl_V1402th kl_V1402hth kl_V1402htth)) !appl_12 <- appl_11 `pseq` klCons appl_11 (Types.Atom Types.Nil) !appl_13 <- kl_V1402hthtth `pseq` (appl_12 `pseq` klCons kl_V1402hthtth appl_12) !appl_14 <- appl_13 `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) appl_13 !appl_15 <- appl_14 `pseq` klCons appl_14 (Types.Atom Types.Nil) !appl_16 <- kl_V1402hthth `pseq` (appl_15 `pseq` klCons kl_V1402hthth appl_15) !appl_17 <- appl_16 `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) appl_16 !appl_18 <- appl_17 `pseq` applyWrapper appl_3 [appl_17] let !aw_19 = Types.Atom (Types.UnboundSym "do") appl_2 `pseq` (appl_18 `pseq` applyWrapper aw_19 [appl_2, appl_18]) pat_cond_20 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th = do !appl_21 <- kl_V1402t `pseq` klCons (Types.Atom (Types.UnboundSym "tuple?")) kl_V1402t !appl_22 <- appl_21 `pseq` kl_shen_add_test appl_21 let !appl_23 = ApplC (Func "lambda" (Context (\(!kl_Abstraction) -> do let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_Application) -> do kl_Application `pseq` kl_shen_reduce_help kl_Application))) !appl_25 <- kl_V1402t `pseq` klCons (Types.Atom (Types.UnboundSym "fst")) kl_V1402t !appl_26 <- appl_25 `pseq` klCons appl_25 (Types.Atom Types.Nil) !appl_27 <- kl_Abstraction `pseq` (appl_26 `pseq` klCons kl_Abstraction appl_26) !appl_28 <- kl_V1402t `pseq` klCons (Types.Atom (Types.UnboundSym "snd")) kl_V1402t !appl_29 <- appl_28 `pseq` klCons appl_28 (Types.Atom Types.Nil) !appl_30 <- appl_27 `pseq` (appl_29 `pseq` klCons appl_27 appl_29) appl_30 `pseq` applyWrapper appl_24 [appl_30]))) !appl_31 <- kl_V1402th `pseq` (kl_V1402hth `pseq` (kl_V1402htth `pseq` kl_shen_ebr kl_V1402th kl_V1402hth kl_V1402htth)) !appl_32 <- appl_31 `pseq` klCons appl_31 (Types.Atom Types.Nil) !appl_33 <- kl_V1402hthtth `pseq` (appl_32 `pseq` klCons kl_V1402hthtth appl_32) !appl_34 <- appl_33 `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) appl_33 !appl_35 <- appl_34 `pseq` klCons appl_34 (Types.Atom Types.Nil) !appl_36 <- kl_V1402hthth `pseq` (appl_35 `pseq` klCons kl_V1402hthth appl_35) !appl_37 <- appl_36 `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) appl_36 !appl_38 <- appl_37 `pseq` applyWrapper appl_23 [appl_37] let !aw_39 = Types.Atom (Types.UnboundSym "do") appl_22 `pseq` (appl_38 `pseq` applyWrapper aw_39 [appl_22, appl_38]) pat_cond_40 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th = do !appl_41 <- kl_V1402t `pseq` klCons (Types.Atom (Types.UnboundSym "shen.+vector?")) kl_V1402t !appl_42 <- appl_41 `pseq` kl_shen_add_test appl_41 let !appl_43 = ApplC (Func "lambda" (Context (\(!kl_Abstraction) -> do let !appl_44 = ApplC (Func "lambda" (Context (\(!kl_Application) -> do kl_Application `pseq` kl_shen_reduce_help kl_Application))) !appl_45 <- kl_V1402t `pseq` klCons (Types.Atom (Types.UnboundSym "hdv")) kl_V1402t !appl_46 <- appl_45 `pseq` klCons appl_45 (Types.Atom Types.Nil) !appl_47 <- kl_Abstraction `pseq` (appl_46 `pseq` klCons kl_Abstraction appl_46) !appl_48 <- kl_V1402t `pseq` klCons (Types.Atom (Types.UnboundSym "tlv")) kl_V1402t !appl_49 <- appl_48 `pseq` klCons appl_48 (Types.Atom Types.Nil) !appl_50 <- appl_47 `pseq` (appl_49 `pseq` klCons appl_47 appl_49) appl_50 `pseq` applyWrapper appl_44 [appl_50]))) !appl_51 <- kl_V1402th `pseq` (kl_V1402hth `pseq` (kl_V1402htth `pseq` kl_shen_ebr kl_V1402th kl_V1402hth kl_V1402htth)) !appl_52 <- appl_51 `pseq` klCons appl_51 (Types.Atom Types.Nil) !appl_53 <- kl_V1402hthtth `pseq` (appl_52 `pseq` klCons kl_V1402hthtth appl_52) !appl_54 <- appl_53 `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) appl_53 !appl_55 <- appl_54 `pseq` klCons appl_54 (Types.Atom Types.Nil) !appl_56 <- kl_V1402hthth `pseq` (appl_55 `pseq` klCons kl_V1402hthth appl_55) !appl_57 <- appl_56 `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) appl_56 !appl_58 <- appl_57 `pseq` applyWrapper appl_43 [appl_57] let !aw_59 = Types.Atom (Types.UnboundSym "do") appl_42 `pseq` (appl_58 `pseq` applyWrapper aw_59 [appl_42, appl_58]) pat_cond_60 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th = do !appl_61 <- kl_V1402t `pseq` klCons (ApplC (wrapNamed "shen.+string?" kl_shen_PlusstringP)) kl_V1402t !appl_62 <- appl_61 `pseq` kl_shen_add_test appl_61 let !appl_63 = ApplC (Func "lambda" (Context (\(!kl_Abstraction) -> do let !appl_64 = ApplC (Func "lambda" (Context (\(!kl_Application) -> do kl_Application `pseq` kl_shen_reduce_help kl_Application))) !appl_65 <- klCons (Types.Atom (Types.N (Types.KI 0))) (Types.Atom Types.Nil) !appl_66 <- kl_V1402th `pseq` (appl_65 `pseq` klCons kl_V1402th appl_65) !appl_67 <- appl_66 `pseq` klCons (ApplC (wrapNamed "pos" pos)) appl_66 !appl_68 <- appl_67 `pseq` klCons appl_67 (Types.Atom Types.Nil) !appl_69 <- kl_Abstraction `pseq` (appl_68 `pseq` klCons kl_Abstraction appl_68) !appl_70 <- kl_V1402t `pseq` klCons (ApplC (wrapNamed "tlstr" tlstr)) kl_V1402t !appl_71 <- appl_70 `pseq` klCons appl_70 (Types.Atom Types.Nil) !appl_72 <- appl_69 `pseq` (appl_71 `pseq` klCons appl_69 appl_71) appl_72 `pseq` applyWrapper appl_64 [appl_72]))) !appl_73 <- kl_V1402th `pseq` (kl_V1402hth `pseq` (kl_V1402htth `pseq` kl_shen_ebr kl_V1402th kl_V1402hth kl_V1402htth)) !appl_74 <- appl_73 `pseq` klCons appl_73 (Types.Atom Types.Nil) !appl_75 <- kl_V1402hthtth `pseq` (appl_74 `pseq` klCons kl_V1402hthtth appl_74) !appl_76 <- appl_75 `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) appl_75 !appl_77 <- appl_76 `pseq` klCons appl_76 (Types.Atom Types.Nil) !appl_78 <- kl_V1402hthth `pseq` (appl_77 `pseq` klCons kl_V1402hthth appl_77) !appl_79 <- appl_78 `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) appl_78 !appl_80 <- appl_79 `pseq` applyWrapper appl_63 [appl_79] let !aw_81 = Types.Atom (Types.UnboundSym "do") appl_62 `pseq` (appl_80 `pseq` applyWrapper aw_81 [appl_62, appl_80]) pat_cond_82 = do !kl_if_83 <- let pat_cond_84 kl_V1402 kl_V1402h kl_V1402t = do !kl_if_85 <- let pat_cond_86 kl_V1402h kl_V1402hh kl_V1402ht = do !kl_if_87 <- let pat_cond_88 = do !kl_if_89 <- let pat_cond_90 kl_V1402ht kl_V1402hth kl_V1402htt = do !kl_if_91 <- let pat_cond_92 kl_V1402htt kl_V1402htth kl_V1402httt = do !kl_if_93 <- let pat_cond_94 = do !kl_if_95 <- let pat_cond_96 kl_V1402t kl_V1402th kl_V1402tt = do !kl_if_97 <- let pat_cond_98 = do let !aw_99 = Types.Atom (Types.UnboundSym "variable?") !appl_100 <- kl_V1402hth `pseq` applyWrapper aw_99 [kl_V1402hth] let !aw_101 = Types.Atom (Types.UnboundSym "not") !kl_if_102 <- appl_100 `pseq` applyWrapper aw_101 [appl_100] case kl_if_102 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_103 = do do return (Atom (B False)) in case kl_V1402tt of kl_V1402tt@(Atom (Nil)) -> pat_cond_98 _ -> pat_cond_103 case kl_if_97 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_104 = do do return (Atom (B False)) in case kl_V1402t of !(kl_V1402t@(Cons (!kl_V1402th) (!kl_V1402tt))) -> pat_cond_96 kl_V1402t kl_V1402th kl_V1402tt _ -> pat_cond_104 case kl_if_95 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_105 = do do return (Atom (B False)) in case kl_V1402httt of kl_V1402httt@(Atom (Nil)) -> pat_cond_94 _ -> pat_cond_105 case kl_if_93 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_106 = do do return (Atom (B False)) in case kl_V1402htt of !(kl_V1402htt@(Cons (!kl_V1402htth) (!kl_V1402httt))) -> pat_cond_92 kl_V1402htt kl_V1402htth kl_V1402httt _ -> pat_cond_106 case kl_if_91 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_107 = do do return (Atom (B False)) in case kl_V1402ht of !(kl_V1402ht@(Cons (!kl_V1402hth) (!kl_V1402htt))) -> pat_cond_90 kl_V1402ht kl_V1402hth kl_V1402htt _ -> pat_cond_107 case kl_if_89 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_108 = do do return (Atom (B False)) in case kl_V1402hh of kl_V1402hh@(Atom (UnboundSym "/.")) -> pat_cond_88 kl_V1402hh@(ApplC (PL "/." _)) -> pat_cond_88 kl_V1402hh@(ApplC (Func "/." _)) -> pat_cond_88 _ -> pat_cond_108 case kl_if_87 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_109 = do do return (Atom (B False)) in case kl_V1402h of !(kl_V1402h@(Cons (!kl_V1402hh) (!kl_V1402ht))) -> pat_cond_86 kl_V1402h kl_V1402hh kl_V1402ht _ -> pat_cond_109 case kl_if_85 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_110 = do do return (Atom (B False)) in case kl_V1402 of !(kl_V1402@(Cons (!kl_V1402h) (!kl_V1402t))) -> pat_cond_84 kl_V1402 kl_V1402h kl_V1402t _ -> pat_cond_110 case kl_if_83 of Atom (B (True)) -> do !appl_111 <- kl_V1402 `pseq` hd kl_V1402 !appl_112 <- appl_111 `pseq` tl appl_111 !appl_113 <- appl_112 `pseq` hd appl_112 !appl_114 <- kl_V1402 `pseq` tl kl_V1402 !appl_115 <- appl_113 `pseq` (appl_114 `pseq` klCons appl_113 appl_114) !appl_116 <- appl_115 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_115 !appl_117 <- appl_116 `pseq` kl_shen_add_test appl_116 !appl_118 <- kl_V1402 `pseq` hd kl_V1402 !appl_119 <- appl_118 `pseq` tl appl_118 !appl_120 <- appl_119 `pseq` tl appl_119 !appl_121 <- appl_120 `pseq` hd appl_120 !appl_122 <- appl_121 `pseq` kl_shen_reduce_help appl_121 let !aw_123 = Types.Atom (Types.UnboundSym "do") appl_117 `pseq` (appl_122 `pseq` applyWrapper aw_123 [appl_117, appl_122]) Atom (B (False)) -> do let pat_cond_124 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th = do !appl_125 <- kl_V1402th `pseq` (kl_V1402hth `pseq` (kl_V1402htth `pseq` kl_shen_ebr kl_V1402th kl_V1402hth kl_V1402htth)) appl_125 `pseq` kl_shen_reduce_help appl_125 pat_cond_126 kl_V1402 kl_V1402t kl_V1402th kl_V1402tt kl_V1402tth = do !appl_127 <- kl_V1402th `pseq` kl_shen_add_test kl_V1402th !appl_128 <- kl_V1402tth `pseq` kl_shen_reduce_help kl_V1402tth let !aw_129 = Types.Atom (Types.UnboundSym "do") appl_127 `pseq` (appl_128 `pseq` applyWrapper aw_129 [appl_127, appl_128]) pat_cond_130 kl_V1402 kl_V1402h kl_V1402t kl_V1402th = do let !appl_131 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do !kl_if_132 <- kl_V1402h `pseq` (kl_Z `pseq` eq kl_V1402h kl_Z) case kl_if_132 of Atom (B (True)) -> do return kl_V1402 Atom (B (False)) -> do do !appl_133 <- kl_Z `pseq` (kl_V1402t `pseq` klCons kl_Z kl_V1402t) appl_133 `pseq` kl_shen_reduce_help appl_133 _ -> throwError "if: expected boolean"))) !appl_134 <- kl_V1402h `pseq` kl_shen_reduce_help kl_V1402h appl_134 `pseq` applyWrapper appl_131 [appl_134] pat_cond_135 = do do return kl_V1402 in case kl_V1402 of !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!kl_V1402hth) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_124 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!kl_V1402hth) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_124 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!kl_V1402hth) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_124 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (Atom (UnboundSym "where")) (!(kl_V1402t@(Cons (!kl_V1402th) (!(kl_V1402tt@(Cons (!kl_V1402tth) (Atom (Nil)))))))))) -> pat_cond_126 kl_V1402 kl_V1402t kl_V1402th kl_V1402tt kl_V1402tth !(kl_V1402@(Cons (ApplC (PL "where" _)) (!(kl_V1402t@(Cons (!kl_V1402th) (!(kl_V1402tt@(Cons (!kl_V1402tth) (Atom (Nil)))))))))) -> pat_cond_126 kl_V1402 kl_V1402t kl_V1402th kl_V1402tt kl_V1402tth !(kl_V1402@(Cons (ApplC (Func "where" _)) (!(kl_V1402t@(Cons (!kl_V1402th) (!(kl_V1402tt@(Cons (!kl_V1402tth) (Atom (Nil)))))))))) -> pat_cond_126 kl_V1402 kl_V1402t kl_V1402th kl_V1402tt kl_V1402tth !(kl_V1402@(Cons (!kl_V1402h) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_130 kl_V1402 kl_V1402h kl_V1402t kl_V1402th _ -> pat_cond_135 _ -> throwError "if: expected boolean" in case kl_V1402 of !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "cons")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_0 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "cons" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_0 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "cons" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_0 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "cons")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_0 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "cons" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_0 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "cons" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_0 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "cons")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_0 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "cons" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_0 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "cons" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_0 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "@p")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_20 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "@p" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_20 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "@p" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_20 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "@p")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_20 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "@p" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_20 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "@p" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_20 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "@p")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_20 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "@p" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_20 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "@p" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_20 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "@v")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_40 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "@v" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_40 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "@v" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_40 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "@v")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_40 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "@v" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_40 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "@v" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_40 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "@v")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_40 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "@v" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_40 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "@v" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_40 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "@s")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_60 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "@s" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_60 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (Atom (UnboundSym "/.")) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "@s" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_60 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "@s")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_60 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "@s" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_60 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (PL "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "@s" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_60 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (Atom (UnboundSym "@s")) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_60 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (PL "@s" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_60 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th !(kl_V1402@(Cons (!(kl_V1402h@(Cons (ApplC (Func "/." _)) (!(kl_V1402ht@(Cons (!(kl_V1402hth@(Cons (ApplC (Func "@s" _)) (!(kl_V1402htht@(Cons (!kl_V1402hthth) (!(kl_V1402hthtt@(Cons (!kl_V1402hthtth) (Atom (Nil))))))))))) (!(kl_V1402htt@(Cons (!kl_V1402htth) (Atom (Nil))))))))))) (!(kl_V1402t@(Cons (!kl_V1402th) (Atom (Nil))))))) -> pat_cond_60 kl_V1402 kl_V1402h kl_V1402ht kl_V1402hth kl_V1402htht kl_V1402hthth kl_V1402hthtt kl_V1402hthtth kl_V1402htt kl_V1402htth kl_V1402t kl_V1402th _ -> pat_cond_82 kl_shen_PlusstringP :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_PlusstringP (!kl_V1404) = do let pat_cond_0 = do return (Atom (B False)) pat_cond_1 = do do kl_V1404 `pseq` stringP kl_V1404 in case kl_V1404 of kl_V1404@(Atom (Str "")) -> pat_cond_0 _ -> pat_cond_1 kl_shen_Plusvector :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_Plusvector (!kl_V1406) = do let !aw_0 = Types.Atom (Types.UnboundSym "vector") !appl_1 <- applyWrapper aw_0 [Types.Atom (Types.N (Types.KI 0))] !kl_if_2 <- kl_V1406 `pseq` (appl_1 `pseq` eq kl_V1406 appl_1) case kl_if_2 of Atom (B (True)) -> do return (Atom (B False)) Atom (B (False)) -> do do let !aw_3 = Types.Atom (Types.UnboundSym "vector?") kl_V1406 `pseq` applyWrapper aw_3 [kl_V1406] _ -> throwError "if: expected boolean" kl_shen_ebr :: Types.KLValue -> Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_ebr (!kl_V1420) (!kl_V1421) (!kl_V1422) = do !kl_if_0 <- kl_V1422 `pseq` (kl_V1421 `pseq` eq kl_V1422 kl_V1421) case kl_if_0 of Atom (B (True)) -> do return kl_V1420 Atom (B (False)) -> do !kl_if_1 <- let pat_cond_2 kl_V1422 kl_V1422h kl_V1422t = do !kl_if_3 <- let pat_cond_4 = do !kl_if_5 <- let pat_cond_6 kl_V1422t kl_V1422th kl_V1422tt = do !kl_if_7 <- let pat_cond_8 kl_V1422tt kl_V1422tth kl_V1422ttt = do !kl_if_9 <- let pat_cond_10 = do let !aw_11 = Types.Atom (Types.UnboundSym "occurrences") !appl_12 <- kl_V1421 `pseq` (kl_V1422th `pseq` applyWrapper aw_11 [kl_V1421, kl_V1422th]) !kl_if_13 <- appl_12 `pseq` greaterThan appl_12 (Types.Atom (Types.N (Types.KI 0))) 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" pat_cond_14 = do do return (Atom (B False)) in case kl_V1422ttt of kl_V1422ttt@(Atom (Nil)) -> pat_cond_10 _ -> pat_cond_14 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_15 = do do return (Atom (B False)) in case kl_V1422tt of !(kl_V1422tt@(Cons (!kl_V1422tth) (!kl_V1422ttt))) -> pat_cond_8 kl_V1422tt kl_V1422tth kl_V1422ttt _ -> pat_cond_15 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_16 = do do return (Atom (B False)) in case kl_V1422t of !(kl_V1422t@(Cons (!kl_V1422th) (!kl_V1422tt))) -> pat_cond_6 kl_V1422t kl_V1422th kl_V1422tt _ -> pat_cond_16 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_17 = do do return (Atom (B False)) in case kl_V1422h of kl_V1422h@(Atom (UnboundSym "/.")) -> pat_cond_4 kl_V1422h@(ApplC (PL "/." _)) -> pat_cond_4 kl_V1422h@(ApplC (Func "/." _)) -> pat_cond_4 _ -> pat_cond_17 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_18 = do do return (Atom (B False)) in case kl_V1422 of !(kl_V1422@(Cons (!kl_V1422h) (!kl_V1422t))) -> pat_cond_2 kl_V1422 kl_V1422h kl_V1422t _ -> pat_cond_18 case kl_if_1 of Atom (B (True)) -> do return kl_V1422 Atom (B (False)) -> do !kl_if_19 <- let pat_cond_20 kl_V1422 kl_V1422h kl_V1422t = do !kl_if_21 <- let pat_cond_22 = do !kl_if_23 <- let pat_cond_24 kl_V1422t kl_V1422th kl_V1422tt = do !kl_if_25 <- let pat_cond_26 kl_V1422tt kl_V1422tth kl_V1422ttt = do !kl_if_27 <- let pat_cond_28 = do let !aw_29 = Types.Atom (Types.UnboundSym "occurrences") !appl_30 <- kl_V1421 `pseq` (kl_V1422th `pseq` applyWrapper aw_29 [kl_V1421, kl_V1422th]) !kl_if_31 <- appl_30 `pseq` greaterThan appl_30 (Types.Atom (Types.N (Types.KI 0))) 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" pat_cond_32 = do do return (Atom (B False)) in case kl_V1422ttt of kl_V1422ttt@(Atom (Nil)) -> pat_cond_28 _ -> pat_cond_32 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_33 = do do return (Atom (B False)) in case kl_V1422tt of !(kl_V1422tt@(Cons (!kl_V1422tth) (!kl_V1422ttt))) -> pat_cond_26 kl_V1422tt kl_V1422tth kl_V1422ttt _ -> pat_cond_33 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_34 = do do return (Atom (B False)) in case kl_V1422t of !(kl_V1422t@(Cons (!kl_V1422th) (!kl_V1422tt))) -> pat_cond_24 kl_V1422t kl_V1422th kl_V1422tt _ -> pat_cond_34 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_35 = do do return (Atom (B False)) in case kl_V1422h of kl_V1422h@(Atom (UnboundSym "lambda")) -> pat_cond_22 kl_V1422h@(ApplC (PL "lambda" _)) -> pat_cond_22 kl_V1422h@(ApplC (Func "lambda" _)) -> pat_cond_22 _ -> pat_cond_35 case kl_if_21 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_V1422 of !(kl_V1422@(Cons (!kl_V1422h) (!kl_V1422t))) -> pat_cond_20 kl_V1422 kl_V1422h kl_V1422t _ -> pat_cond_36 case kl_if_19 of Atom (B (True)) -> do return kl_V1422 Atom (B (False)) -> do let pat_cond_37 kl_V1422 kl_V1422t kl_V1422th kl_V1422tt kl_V1422tth kl_V1422ttt kl_V1422ttth = do !appl_38 <- kl_V1420 `pseq` (kl_V1422th `pseq` (kl_V1422tth `pseq` kl_shen_ebr kl_V1420 kl_V1422th kl_V1422tth)) !appl_39 <- appl_38 `pseq` (kl_V1422ttt `pseq` klCons appl_38 kl_V1422ttt) !appl_40 <- kl_V1422th `pseq` (appl_39 `pseq` klCons kl_V1422th appl_39) appl_40 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_40 pat_cond_41 kl_V1422 kl_V1422h kl_V1422t = do !appl_42 <- kl_V1420 `pseq` (kl_V1421 `pseq` (kl_V1422h `pseq` kl_shen_ebr kl_V1420 kl_V1421 kl_V1422h)) !appl_43 <- kl_V1420 `pseq` (kl_V1421 `pseq` (kl_V1422t `pseq` kl_shen_ebr kl_V1420 kl_V1421 kl_V1422t)) appl_42 `pseq` (appl_43 `pseq` klCons appl_42 appl_43) pat_cond_44 = do do return kl_V1422 in case kl_V1422 of !(kl_V1422@(Cons (Atom (UnboundSym "let")) (!(kl_V1422t@(Cons (!kl_V1422th) (!(kl_V1422tt@(Cons (!kl_V1422tth) (!(kl_V1422ttt@(Cons (!kl_V1422ttth) (Atom (Nil))))))))))))) | eqCore kl_V1422th kl_V1421 -> pat_cond_37 kl_V1422 kl_V1422t kl_V1422th kl_V1422tt kl_V1422tth kl_V1422ttt kl_V1422ttth !(kl_V1422@(Cons (ApplC (PL "let" _)) (!(kl_V1422t@(Cons (!kl_V1422th) (!(kl_V1422tt@(Cons (!kl_V1422tth) (!(kl_V1422ttt@(Cons (!kl_V1422ttth) (Atom (Nil))))))))))))) | eqCore kl_V1422th kl_V1421 -> pat_cond_37 kl_V1422 kl_V1422t kl_V1422th kl_V1422tt kl_V1422tth kl_V1422ttt kl_V1422ttth !(kl_V1422@(Cons (ApplC (Func "let" _)) (!(kl_V1422t@(Cons (!kl_V1422th) (!(kl_V1422tt@(Cons (!kl_V1422tth) (!(kl_V1422ttt@(Cons (!kl_V1422ttth) (Atom (Nil))))))))))))) | eqCore kl_V1422th kl_V1421 -> pat_cond_37 kl_V1422 kl_V1422t kl_V1422th kl_V1422tt kl_V1422tth kl_V1422ttt kl_V1422ttth !(kl_V1422@(Cons (!kl_V1422h) (!kl_V1422t))) -> pat_cond_41 kl_V1422 kl_V1422h kl_V1422t _ -> pat_cond_44 _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" kl_shen_add_test :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_add_test (!kl_V1424) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*teststack*")) !appl_1 <- kl_V1424 `pseq` (appl_0 `pseq` klCons kl_V1424 appl_0) appl_1 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*teststack*")) appl_1 kl_shen_cond_expression :: Types.KLValue -> Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_cond_expression (!kl_V1428) (!kl_V1429) (!kl_V1430) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Err) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Cases) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_EncodeChoices) -> do kl_EncodeChoices `pseq` kl_shen_cond_form kl_EncodeChoices))) !appl_3 <- kl_Cases `pseq` (kl_V1428 `pseq` kl_shen_encode_choices kl_Cases kl_V1428) appl_3 `pseq` applyWrapper appl_2 [appl_3]))) !appl_4 <- kl_V1430 `pseq` (kl_Err `pseq` kl_shen_case_form kl_V1430 kl_Err) appl_4 `pseq` applyWrapper appl_1 [appl_4]))) !appl_5 <- kl_V1428 `pseq` kl_shen_err_condition kl_V1428 appl_5 `pseq` applyWrapper appl_0 [appl_5] kl_shen_cond_form :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_cond_form (!kl_V1434) = do let pat_cond_0 kl_V1434 kl_V1434h kl_V1434ht kl_V1434hth kl_V1434t = do return kl_V1434hth pat_cond_1 = do do kl_V1434 `pseq` klCons (Types.Atom (Types.UnboundSym "cond")) kl_V1434 in case kl_V1434 of !(kl_V1434@(Cons (!(kl_V1434h@(Cons (Atom (UnboundSym "true")) (!(kl_V1434ht@(Cons (!kl_V1434hth) (Atom (Nil)))))))) (!kl_V1434t))) -> pat_cond_0 kl_V1434 kl_V1434h kl_V1434ht kl_V1434hth kl_V1434t !(kl_V1434@(Cons (!(kl_V1434h@(Cons (Atom (B (True))) (!(kl_V1434ht@(Cons (!kl_V1434hth) (Atom (Nil)))))))) (!kl_V1434t))) -> pat_cond_0 kl_V1434 kl_V1434h kl_V1434ht kl_V1434hth kl_V1434t _ -> pat_cond_1 kl_shen_encode_choices :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_encode_choices (!kl_V1439) (!kl_V1440) = do let pat_cond_0 = do return (Types.Atom Types.Nil) pat_cond_1 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth = do !appl_2 <- klCons (Types.Atom (Types.UnboundSym "fail")) (Types.Atom Types.Nil) !appl_3 <- appl_2 `pseq` klCons appl_2 (Types.Atom Types.Nil) !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.UnboundSym "Result")) appl_3 !appl_5 <- appl_4 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_4 !kl_if_6 <- value (Types.Atom (Types.UnboundSym "shen.*installing-kl*")) !appl_7 <- case kl_if_6 of Atom (B (True)) -> do !appl_8 <- kl_V1440 `pseq` klCons kl_V1440 (Types.Atom Types.Nil) appl_8 `pseq` klCons (ApplC (wrapNamed "shen.sys-error" kl_shen_sys_error)) appl_8 Atom (B (False)) -> do do !appl_9 <- kl_V1440 `pseq` klCons kl_V1440 (Types.Atom Types.Nil) appl_9 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.f_error")) appl_9 _ -> throwError "if: expected boolean" !appl_10 <- klCons (Types.Atom (Types.UnboundSym "Result")) (Types.Atom Types.Nil) !appl_11 <- appl_7 `pseq` (appl_10 `pseq` klCons appl_7 appl_10) !appl_12 <- appl_5 `pseq` (appl_11 `pseq` klCons appl_5 appl_11) !appl_13 <- appl_12 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_12 !appl_14 <- appl_13 `pseq` klCons appl_13 (Types.Atom Types.Nil) !appl_15 <- kl_V1439hthth `pseq` (appl_14 `pseq` klCons kl_V1439hthth appl_14) !appl_16 <- appl_15 `pseq` klCons (Types.Atom (Types.UnboundSym "Result")) appl_15 !appl_17 <- appl_16 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_16 !appl_18 <- appl_17 `pseq` klCons appl_17 (Types.Atom Types.Nil) !appl_19 <- appl_18 `pseq` klCons (Atom (B True)) appl_18 appl_19 `pseq` klCons appl_19 (Types.Atom Types.Nil) pat_cond_20 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth kl_V1439t = do !appl_21 <- klCons (Types.Atom (Types.UnboundSym "fail")) (Types.Atom Types.Nil) !appl_22 <- appl_21 `pseq` klCons appl_21 (Types.Atom Types.Nil) !appl_23 <- appl_22 `pseq` klCons (Types.Atom (Types.UnboundSym "Result")) appl_22 !appl_24 <- appl_23 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_23 !appl_25 <- kl_V1439t `pseq` (kl_V1440 `pseq` kl_shen_encode_choices kl_V1439t kl_V1440) !appl_26 <- appl_25 `pseq` kl_shen_cond_form appl_25 !appl_27 <- klCons (Types.Atom (Types.UnboundSym "Result")) (Types.Atom Types.Nil) !appl_28 <- appl_26 `pseq` (appl_27 `pseq` klCons appl_26 appl_27) !appl_29 <- appl_24 `pseq` (appl_28 `pseq` klCons appl_24 appl_28) !appl_30 <- appl_29 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_29 !appl_31 <- appl_30 `pseq` klCons appl_30 (Types.Atom Types.Nil) !appl_32 <- kl_V1439hthth `pseq` (appl_31 `pseq` klCons kl_V1439hthth appl_31) !appl_33 <- appl_32 `pseq` klCons (Types.Atom (Types.UnboundSym "Result")) appl_32 !appl_34 <- appl_33 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_33 !appl_35 <- appl_34 `pseq` klCons appl_34 (Types.Atom Types.Nil) !appl_36 <- appl_35 `pseq` klCons (Atom (B True)) appl_35 appl_36 `pseq` klCons appl_36 (Types.Atom Types.Nil) pat_cond_37 kl_V1439 kl_V1439h kl_V1439hh kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth kl_V1439t = do !appl_38 <- kl_V1439t `pseq` (kl_V1440 `pseq` kl_shen_encode_choices kl_V1439t kl_V1440) !appl_39 <- appl_38 `pseq` kl_shen_cond_form appl_38 !appl_40 <- appl_39 `pseq` klCons appl_39 (Types.Atom Types.Nil) !appl_41 <- appl_40 `pseq` klCons (Types.Atom (Types.UnboundSym "freeze")) appl_40 !appl_42 <- klCons (Types.Atom (Types.UnboundSym "fail")) (Types.Atom Types.Nil) !appl_43 <- appl_42 `pseq` klCons appl_42 (Types.Atom Types.Nil) !appl_44 <- appl_43 `pseq` klCons (Types.Atom (Types.UnboundSym "Result")) appl_43 !appl_45 <- appl_44 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_44 !appl_46 <- klCons (Types.Atom (Types.UnboundSym "Freeze")) (Types.Atom Types.Nil) !appl_47 <- appl_46 `pseq` klCons (Types.Atom (Types.UnboundSym "thaw")) appl_46 !appl_48 <- klCons (Types.Atom (Types.UnboundSym "Result")) (Types.Atom Types.Nil) !appl_49 <- appl_47 `pseq` (appl_48 `pseq` klCons appl_47 appl_48) !appl_50 <- appl_45 `pseq` (appl_49 `pseq` klCons appl_45 appl_49) !appl_51 <- appl_50 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_50 !appl_52 <- appl_51 `pseq` klCons appl_51 (Types.Atom Types.Nil) !appl_53 <- kl_V1439hthth `pseq` (appl_52 `pseq` klCons kl_V1439hthth appl_52) !appl_54 <- appl_53 `pseq` klCons (Types.Atom (Types.UnboundSym "Result")) appl_53 !appl_55 <- appl_54 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_54 !appl_56 <- klCons (Types.Atom (Types.UnboundSym "Freeze")) (Types.Atom Types.Nil) !appl_57 <- appl_56 `pseq` klCons (Types.Atom (Types.UnboundSym "thaw")) appl_56 !appl_58 <- appl_57 `pseq` klCons appl_57 (Types.Atom Types.Nil) !appl_59 <- appl_55 `pseq` (appl_58 `pseq` klCons appl_55 appl_58) !appl_60 <- kl_V1439hh `pseq` (appl_59 `pseq` klCons kl_V1439hh appl_59) !appl_61 <- appl_60 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_60 !appl_62 <- appl_61 `pseq` klCons appl_61 (Types.Atom Types.Nil) !appl_63 <- appl_41 `pseq` (appl_62 `pseq` klCons appl_41 appl_62) !appl_64 <- appl_63 `pseq` klCons (Types.Atom (Types.UnboundSym "Freeze")) appl_63 !appl_65 <- appl_64 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_64 !appl_66 <- appl_65 `pseq` klCons appl_65 (Types.Atom Types.Nil) !appl_67 <- appl_66 `pseq` klCons (Atom (B True)) appl_66 appl_67 `pseq` klCons appl_67 (Types.Atom Types.Nil) pat_cond_68 kl_V1439 kl_V1439h kl_V1439hh kl_V1439ht kl_V1439hth kl_V1439t = do !appl_69 <- kl_V1439t `pseq` (kl_V1440 `pseq` kl_shen_encode_choices kl_V1439t kl_V1440) kl_V1439h `pseq` (appl_69 `pseq` klCons kl_V1439h appl_69) pat_cond_70 = do do let !aw_71 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_71 [ApplC (wrapNamed "shen.encode-choices" kl_shen_encode_choices)] in case kl_V1439 of kl_V1439@(Atom (Nil)) -> pat_cond_0 !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (UnboundSym "true")) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (Atom (Nil)))) -> pat_cond_1 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (UnboundSym "true")) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (Atom (Nil)))) -> pat_cond_1 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (UnboundSym "true")) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (Atom (Nil)))) -> pat_cond_1 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (B (True))) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (Atom (Nil)))) -> pat_cond_1 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (B (True))) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (Atom (Nil)))) -> pat_cond_1 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (B (True))) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (Atom (Nil)))) -> pat_cond_1 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (UnboundSym "true")) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1439t))) -> pat_cond_20 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth kl_V1439t !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (UnboundSym "true")) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1439t))) -> pat_cond_20 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth kl_V1439t !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (UnboundSym "true")) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1439t))) -> pat_cond_20 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth kl_V1439t !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (B (True))) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1439t))) -> pat_cond_20 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth kl_V1439t !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (B (True))) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1439t))) -> pat_cond_20 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth kl_V1439t !(kl_V1439@(Cons (!(kl_V1439h@(Cons (Atom (B (True))) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1439t))) -> pat_cond_20 kl_V1439 kl_V1439h kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth kl_V1439t !(kl_V1439@(Cons (!(kl_V1439h@(Cons (!kl_V1439hh) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1439t))) -> pat_cond_37 kl_V1439 kl_V1439h kl_V1439hh kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth kl_V1439t !(kl_V1439@(Cons (!(kl_V1439h@(Cons (!kl_V1439hh) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1439t))) -> pat_cond_37 kl_V1439 kl_V1439h kl_V1439hh kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth kl_V1439t !(kl_V1439@(Cons (!(kl_V1439h@(Cons (!kl_V1439hh) (!(kl_V1439ht@(Cons (!(kl_V1439hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1439htht@(Cons (!kl_V1439hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1439t))) -> pat_cond_37 kl_V1439 kl_V1439h kl_V1439hh kl_V1439ht kl_V1439hth kl_V1439htht kl_V1439hthth kl_V1439t !(kl_V1439@(Cons (!(kl_V1439h@(Cons (!kl_V1439hh) (!(kl_V1439ht@(Cons (!kl_V1439hth) (Atom (Nil)))))))) (!kl_V1439t))) -> pat_cond_68 kl_V1439 kl_V1439h kl_V1439hh kl_V1439ht kl_V1439hth kl_V1439t _ -> pat_cond_70 kl_shen_case_form :: Types.KLValue -> Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_case_form (!kl_V1447) (!kl_V1448) = do let pat_cond_0 = do kl_V1448 `pseq` klCons kl_V1448 (Types.Atom Types.Nil) pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t = do !appl_2 <- kl_V1447ht `pseq` klCons (Atom (B True)) kl_V1447ht !appl_3 <- kl_V1447t `pseq` (kl_V1448 `pseq` kl_shen_case_form kl_V1447t kl_V1448) appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) pat_cond_4 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447t = do !appl_5 <- kl_V1447ht `pseq` klCons (Atom (B True)) kl_V1447ht appl_5 `pseq` klCons appl_5 (Types.Atom Types.Nil) pat_cond_6 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447hhtt kl_V1447ht kl_V1447hth kl_V1447t = do !appl_7 <- kl_V1447hhtt `pseq` kl_shen_embed_and kl_V1447hhtt !appl_8 <- appl_7 `pseq` (kl_V1447ht `pseq` klCons appl_7 kl_V1447ht) !appl_9 <- kl_V1447t `pseq` (kl_V1448 `pseq` kl_shen_case_form kl_V1447t kl_V1448) appl_8 `pseq` (appl_9 `pseq` klCons appl_8 appl_9) pat_cond_10 = do do let !aw_11 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_11 [ApplC (wrapNamed "shen.case-form" kl_shen_case_form)] in case kl_V1447 of kl_V1447@(Atom (Nil)) -> pat_cond_0 !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (Atom (UnboundSym "shen.choicepoint!")) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (PL "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!(kl_V1447hth@(Cons (ApplC (Func "shen.choicepoint!" _)) (!(kl_V1447htht@(Cons (!kl_V1447hthth) (Atom (Nil)))))))) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_1 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447htht kl_V1447hthth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_4 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_4 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_4 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_4 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_4 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_4 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_4 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_4 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (Atom (Nil)))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_4 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (!kl_V1447hhtt))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_6 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447hhtt kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (!kl_V1447hhtt))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_6 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447hhtt kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (Atom (UnboundSym ":")) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (!kl_V1447hhtt))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_6 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447hhtt kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (!kl_V1447hhtt))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_6 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447hhtt kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (!kl_V1447hhtt))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_6 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447hhtt kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (PL ":" _)) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (!kl_V1447hhtt))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_6 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447hhtt kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (Atom (UnboundSym "shen.tests")) (!kl_V1447hhtt))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_6 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447hhtt kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (ApplC (PL "shen.tests" _)) (!kl_V1447hhtt))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_6 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447hhtt kl_V1447ht kl_V1447hth kl_V1447t !(kl_V1447@(Cons (!(kl_V1447h@(Cons (!(kl_V1447hh@(Cons (ApplC (Func ":" _)) (!(kl_V1447hht@(Cons (ApplC (Func "shen.tests" _)) (!kl_V1447hhtt))))))) (!(kl_V1447ht@(Cons (!kl_V1447hth) (Atom (Nil)))))))) (!kl_V1447t))) -> pat_cond_6 kl_V1447 kl_V1447h kl_V1447hh kl_V1447hht kl_V1447hhtt kl_V1447ht kl_V1447hth kl_V1447t _ -> pat_cond_10 kl_shen_embed_and :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_embed_and (!kl_V1450) = do let pat_cond_0 kl_V1450 kl_V1450h = do return kl_V1450h pat_cond_1 kl_V1450 kl_V1450h kl_V1450t = do !appl_2 <- kl_V1450t `pseq` kl_shen_embed_and kl_V1450t !appl_3 <- appl_2 `pseq` klCons appl_2 (Types.Atom Types.Nil) !appl_4 <- kl_V1450h `pseq` (appl_3 `pseq` klCons kl_V1450h appl_3) appl_4 `pseq` klCons (Types.Atom (Types.UnboundSym "and")) appl_4 pat_cond_5 = do do let !aw_6 = Types.Atom (Types.UnboundSym "shen.f_error") applyWrapper aw_6 [ApplC (wrapNamed "shen.embed-and" kl_shen_embed_and)] in case kl_V1450 of !(kl_V1450@(Cons (!kl_V1450h) (Atom (Nil)))) -> pat_cond_0 kl_V1450 kl_V1450h !(kl_V1450@(Cons (!kl_V1450h) (!kl_V1450t))) -> pat_cond_1 kl_V1450 kl_V1450h kl_V1450t _ -> pat_cond_5 kl_shen_err_condition :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_err_condition (!kl_V1452) = do !appl_0 <- kl_V1452 `pseq` klCons kl_V1452 (Types.Atom Types.Nil) !appl_1 <- appl_0 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.f_error")) appl_0 !appl_2 <- appl_1 `pseq` klCons appl_1 (Types.Atom Types.Nil) appl_2 `pseq` klCons (Atom (B True)) appl_2 kl_shen_sys_error :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue kl_shen_sys_error (!kl_V1454) = do let !aw_0 = Types.Atom (Types.UnboundSym "shen.app") !appl_1 <- kl_V1454 `pseq` applyWrapper aw_0 [kl_V1454, Types.Atom (Types.Str ": unexpected argument\n"), Types.Atom (Types.UnboundSym "shen.a")] !appl_2 <- appl_1 `pseq` cn (Types.Atom (Types.Str "system function ")) appl_1 appl_2 `pseq` simpleError appl_2 expr1 :: Types.KLContext Types.Env Types.KLValue expr1 = do (do return (Types.Atom (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 (Types.Atom (Types.Str "E")))