diff --git a/Shentong/Backend/Core.hs b/Shentong/Backend/Core.hs --- a/Shentong/Backend/Core.hs +++ b/Shentong/Backend/Core.hs @@ -1,4004 +1,5019 @@ -{-# 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"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Core where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel + +{- +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_RBkl :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_RBkl (!kl_V1193) (!kl_V1194) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBdefineRB kl_X))) + !appl_1 <- kl_V1193 `pseq` (kl_V1194 `pseq` klCons kl_V1193 kl_V1194) + let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_V1193 `pseq` (kl_X `pseq` kl_shen_syntax_error kl_V1193 kl_X)))) + let !aw_3 = Core.Types.Atom (Core.Types.UnboundSym "compile") + appl_0 `pseq` (appl_1 `pseq` (appl_2 `pseq` applyWrapper aw_3 [appl_0, + appl_1, + appl_2])) + +kl_shen_syntax_error :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_syntax_error (!kl_V1201) (!kl_V1202) = do let pat_cond_0 kl_V1202 kl_V1202h kl_V1202t = do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.next-50") + !appl_2 <- kl_V1202h `pseq` applyWrapper aw_1 [Core.Types.Atom (Core.Types.N (Core.Types.KI 50)), + kl_V1202h] + let !aw_3 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_4 <- appl_2 `pseq` applyWrapper aw_3 [appl_2, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_5 <- appl_4 `pseq` cn (Core.Types.Atom (Core.Types.Str " here:\n\n ")) appl_4 + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_7 <- kl_V1201 `pseq` (appl_5 `pseq` applyWrapper aw_6 [kl_V1201, + appl_5, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_8 <- appl_7 `pseq` cn (Core.Types.Atom (Core.Types.Str "syntax error in ")) appl_7 + appl_8 `pseq` simpleError appl_8 + pat_cond_9 = do do let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_11 <- kl_V1201 `pseq` applyWrapper aw_10 [kl_V1201, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_12 <- appl_11 `pseq` cn (Core.Types.Atom (Core.Types.Str "syntax error in ")) appl_11 + appl_12 `pseq` simpleError appl_12 + in case kl_V1202 of + !(kl_V1202@(Cons (!kl_V1202h) + (!kl_V1202t))) -> pat_cond_0 kl_V1202 kl_V1202h kl_V1202t + _ -> pat_cond_9 + +kl_shen_LBdefineRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBdefineRB (!kl_V1204) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnameRB) -> do let !aw_5 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_18 <- kl_Parse_shen_LBnameRB `pseq` applyWrapper aw_17 [kl_Parse_shen_LBnameRB] + let !aw_19 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_25 [] + _ -> throwError "if: expected boolean"))) + !appl_26 <- kl_V1204 `pseq` kl_shen_LBnameRB kl_V1204 + 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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_47 <- kl_Parse_shen_LBnameRB `pseq` applyWrapper aw_46 [kl_Parse_shen_LBnameRB] + let !aw_48 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_45 `pseq` (appl_50 `pseq` applyWrapper aw_51 [appl_45, + appl_50]) + Atom (B (False)) -> do do let !aw_52 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_52 [] + _ -> throwError "if: expected boolean"))) + !appl_53 <- kl_Parse_shen_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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_56 [] + _ -> throwError "if: expected boolean"))) + !appl_57 <- kl_V1204 `pseq` kl_shen_LBnameRB kl_V1204 + !appl_58 <- appl_57 `pseq` applyWrapper appl_27 [appl_57] + appl_58 `pseq` applyWrapper appl_0 [appl_58] + +kl_shen_LBnameRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBnameRB (!kl_V1206) = do !appl_0 <- kl_V1206 `pseq` hd kl_V1206 + !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_V1206 `pseq` hd kl_V1206 + !appl_4 <- appl_3 `pseq` tl appl_3 + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_6 <- kl_V1206 `pseq` applyWrapper aw_5 [kl_V1206] + let !aw_7 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_18 <- kl_Parse_X `pseq` applyWrapper aw_17 [kl_Parse_X, + Core.Types.Atom (Core.Types.Str " is not a legitimate function name.\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + appl_18 `pseq` simpleError appl_18 + _ -> throwError "if: expected boolean" + let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_9 `pseq` (appl_16 `pseq` applyWrapper aw_19 [appl_9, + appl_16])))) + !appl_20 <- kl_V1206 `pseq` hd kl_V1206 + !appl_21 <- appl_20 `pseq` hd appl_20 + appl_21 `pseq` applyWrapper appl_2 [appl_21] + Atom (B (False)) -> do do let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_22 [] + _ -> throwError "if: expected boolean" + +kl_shen_sysfuncP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_sysfuncP (!kl_V1208) = do !appl_0 <- intern (Core.Types.Atom (Core.Types.Str "shen")) + !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "get") + !appl_3 <- appl_0 `pseq` (appl_1 `pseq` applyWrapper aw_2 [appl_0, + Core.Types.Atom (Core.Types.UnboundSym "shen.external-symbols"), + appl_1]) + let !aw_4 = Core.Types.Atom (Core.Types.UnboundSym "element?") + kl_V1208 `pseq` (appl_3 `pseq` applyWrapper aw_4 [kl_V1208, + appl_3]) + +kl_shen_LBsignatureRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBsignatureRB (!kl_V1210) = do !appl_0 <- kl_V1210 `pseq` hd kl_V1210 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V1210 `pseq` hd kl_V1210 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 (Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_21 <- kl_Parse_shen_LBsignature_helpRB `pseq` applyWrapper aw_20 [kl_Parse_shen_LBsignature_helpRB] + let !aw_22 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.demodulate") + !appl_29 <- appl_27 `pseq` applyWrapper aw_28 [appl_27] + let !aw_30 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_31 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_32 [] + _ -> throwError "if: expected boolean"))) + !appl_33 <- kl_V1210 `pseq` hd kl_V1210 + !appl_34 <- appl_33 `pseq` tl appl_33 + let !aw_35 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_36 <- kl_V1210 `pseq` applyWrapper aw_35 [kl_V1210] + let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_38 <- appl_34 `pseq` (appl_36 `pseq` applyWrapper aw_37 [appl_34, + appl_36]) + !appl_39 <- appl_38 `pseq` kl_shen_LBsignature_helpRB appl_38 + appl_39 `pseq` applyWrapper appl_6 [appl_39] + Atom (B (False)) -> do do let !aw_40 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_40 [] + _ -> throwError "if: expected boolean" + +kl_shen_curry_type :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_curry_type (!kl_V1212) = do let pat_cond_0 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt = do let !appl_1 = Atom Nil + !appl_2 <- kl_V1212tt `pseq` (appl_1 `pseq` klCons kl_V1212tt appl_1) + !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_2 + !appl_4 <- kl_V1212h `pseq` (appl_3 `pseq` klCons kl_V1212h appl_3) + appl_4 `pseq` kl_shen_curry_type appl_4 + pat_cond_5 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt = do let !appl_6 = Atom Nil + !appl_7 <- kl_V1212tt `pseq` (appl_6 `pseq` klCons kl_V1212tt appl_6) + !appl_8 <- appl_7 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_7 + !appl_9 <- kl_V1212h `pseq` (appl_8 `pseq` klCons kl_V1212h appl_8) + appl_9 `pseq` kl_shen_curry_type appl_9 + pat_cond_10 kl_V1212 kl_V1212h kl_V1212t = do let !appl_11 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_curry_type kl_Z))) + let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "map") + appl_11 `pseq` (kl_V1212 `pseq` applyWrapper aw_12 [appl_11, + kl_V1212]) + pat_cond_13 = do do return kl_V1212 + in case kl_V1212 of + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (Atom (UnboundSym "-->")) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (Atom (UnboundSym "-->")) + (!kl_V1212tttt)))))))))))) -> pat_cond_0 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (Atom (UnboundSym "-->")) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (PL "-->" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_0 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (Atom (UnboundSym "-->")) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (Func "-->" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_0 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (PL "-->" _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (Atom (UnboundSym "-->")) + (!kl_V1212tttt)))))))))))) -> pat_cond_0 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (PL "-->" _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (PL "-->" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_0 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (PL "-->" _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (Func "-->" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_0 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (Func "-->" + _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (Atom (UnboundSym "-->")) + (!kl_V1212tttt)))))))))))) -> pat_cond_0 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (Func "-->" + _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (PL "-->" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_0 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (Func "-->" + _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (Func "-->" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_0 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (Atom (UnboundSym "*")) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (Atom (UnboundSym "*")) + (!kl_V1212tttt)))))))))))) -> pat_cond_5 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (Atom (UnboundSym "*")) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (PL "*" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_5 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (Atom (UnboundSym "*")) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (Func "*" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_5 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (PL "*" _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (Atom (UnboundSym "*")) + (!kl_V1212tttt)))))))))))) -> pat_cond_5 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (PL "*" _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (PL "*" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_5 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (PL "*" _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (Func "*" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_5 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (Func "*" _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (Atom (UnboundSym "*")) + (!kl_V1212tttt)))))))))))) -> pat_cond_5 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (Func "*" _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (PL "*" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_5 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!(kl_V1212t@(Cons (ApplC (Func "*" _)) + (!(kl_V1212tt@(Cons (!kl_V1212tth) + (!(kl_V1212ttt@(Cons (ApplC (Func "*" + _)) + (!kl_V1212tttt)))))))))))) -> pat_cond_5 kl_V1212 kl_V1212h kl_V1212t kl_V1212tt kl_V1212tth kl_V1212ttt kl_V1212tttt + !(kl_V1212@(Cons (!kl_V1212h) + (!kl_V1212t))) -> pat_cond_10 kl_V1212 kl_V1212h kl_V1212t + _ -> pat_cond_13 + +kl_shen_LBsignature_helpRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBsignature_helpRB (!kl_V1214) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !appl_7 <- appl_6 `pseq` (kl_Parse_LBeRB `pseq` eq appl_6 kl_Parse_LBeRB) + let !aw_8 = Core.Types.Atom (Core.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 !appl_11 = Atom Nil + let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_10 `pseq` (appl_11 `pseq` applyWrapper aw_12 [appl_10, + appl_11]) + Atom (B (False)) -> do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_13 [] + _ -> throwError "if: expected boolean"))) + let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "") + !appl_15 <- kl_V1214 `pseq` applyWrapper aw_14 [kl_V1214] + appl_15 `pseq` applyWrapper appl_4 [appl_15] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + !appl_16 <- kl_V1214 `pseq` hd kl_V1214 + !kl_if_17 <- appl_16 `pseq` consP appl_16 + !appl_18 <- case kl_if_17 of + Atom (B (True)) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let !appl_20 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsignature_helpRB) -> do let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_22 <- applyWrapper aw_21 [] + !appl_23 <- appl_22 `pseq` (kl_Parse_shen_LBsignature_helpRB `pseq` eq appl_22 kl_Parse_shen_LBsignature_helpRB) + let !aw_24 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_25 <- appl_23 `pseq` applyWrapper aw_24 [appl_23] + case kl_if_25 of + Atom (B (True)) -> do let !appl_26 = Atom Nil + !appl_27 <- appl_26 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "}")) appl_26 + !appl_28 <- appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "{")) appl_27 + let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "element?") + !appl_30 <- kl_Parse_X `pseq` (appl_28 `pseq` applyWrapper aw_29 [kl_Parse_X, + appl_28]) + let !aw_31 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_32 <- appl_30 `pseq` applyWrapper aw_31 [appl_30] + case kl_if_32 of + Atom (B (True)) -> do !appl_33 <- kl_Parse_shen_LBsignature_helpRB `pseq` hd kl_Parse_shen_LBsignature_helpRB + let !aw_34 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_35 <- kl_Parse_shen_LBsignature_helpRB `pseq` applyWrapper aw_34 [kl_Parse_shen_LBsignature_helpRB] + !appl_36 <- kl_Parse_X `pseq` (appl_35 `pseq` klCons kl_Parse_X appl_35) + let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_33 `pseq` (appl_36 `pseq` applyWrapper aw_37 [appl_33, + appl_36]) + Atom (B (False)) -> do do let !aw_38 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_38 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_39 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_39 [] + _ -> throwError "if: expected boolean"))) + !appl_40 <- kl_V1214 `pseq` hd kl_V1214 + !appl_41 <- appl_40 `pseq` tl appl_40 + let !aw_42 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_43 <- kl_V1214 `pseq` applyWrapper aw_42 [kl_V1214] + let !aw_44 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_45 <- appl_41 `pseq` (appl_43 `pseq` applyWrapper aw_44 [appl_41, + appl_43]) + !appl_46 <- appl_45 `pseq` kl_shen_LBsignature_helpRB appl_45 + appl_46 `pseq` applyWrapper appl_20 [appl_46]))) + !appl_47 <- kl_V1214 `pseq` hd kl_V1214 + !appl_48 <- appl_47 `pseq` hd appl_47 + appl_48 `pseq` applyWrapper appl_19 [appl_48] + Atom (B (False)) -> do do let !aw_49 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_49 [] + _ -> throwError "if: expected boolean" + appl_18 `pseq` applyWrapper appl_0 [appl_18] + +kl_shen_LBrulesRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBrulesRB (!kl_V1216) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBruleRB) -> do let !aw_5 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 + let !appl_14 = Atom Nil + !appl_15 <- appl_13 `pseq` (appl_14 `pseq` klCons appl_13 appl_14) + let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_10 `pseq` (appl_15 `pseq` applyWrapper aw_16 [appl_10, + appl_15]) + Atom (B (False)) -> do do let !aw_17 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_17 [] + _ -> throwError "if: expected boolean"))) + !appl_18 <- kl_V1216 `pseq` kl_shen_LBruleRB kl_V1216 + appl_18 `pseq` applyWrapper appl_4 [appl_18] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBruleRB) -> do let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_21 <- applyWrapper aw_20 [] + !appl_22 <- appl_21 `pseq` (kl_Parse_shen_LBruleRB `pseq` eq appl_21 kl_Parse_shen_LBruleRB) + let !aw_23 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_24 <- appl_22 `pseq` applyWrapper aw_23 [appl_22] + case kl_if_24 of + Atom (B (True)) -> do let !appl_25 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBrulesRB) -> do let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_27 <- applyWrapper aw_26 [] + !appl_28 <- appl_27 `pseq` (kl_Parse_shen_LBrulesRB `pseq` eq appl_27 kl_Parse_shen_LBrulesRB) + let !aw_29 = Core.Types.Atom (Core.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_LBrulesRB `pseq` hd kl_Parse_shen_LBrulesRB + let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_33 <- kl_Parse_shen_LBruleRB `pseq` applyWrapper aw_32 [kl_Parse_shen_LBruleRB] + !appl_34 <- appl_33 `pseq` kl_shen_linearise appl_33 + let !aw_35 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_36 <- kl_Parse_shen_LBrulesRB `pseq` applyWrapper aw_35 [kl_Parse_shen_LBrulesRB] + !appl_37 <- appl_34 `pseq` (appl_36 `pseq` klCons appl_34 appl_36) + let !aw_38 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_31 `pseq` (appl_37 `pseq` applyWrapper aw_38 [appl_31, + appl_37]) + Atom (B (False)) -> do do let !aw_39 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_39 [] + _ -> throwError "if: expected boolean"))) + !appl_40 <- kl_Parse_shen_LBruleRB `pseq` kl_shen_LBrulesRB kl_Parse_shen_LBruleRB + appl_40 `pseq` applyWrapper appl_25 [appl_40] + Atom (B (False)) -> do do let !aw_41 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_41 [] + _ -> throwError "if: expected boolean"))) + !appl_42 <- kl_V1216 `pseq` kl_shen_LBruleRB kl_V1216 + !appl_43 <- appl_42 `pseq` applyWrapper appl_19 [appl_42] + appl_43 `pseq` applyWrapper appl_0 [appl_43] + +kl_shen_LBruleRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBruleRB (!kl_V1218) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !kl_if_7 <- kl_YaccParse `pseq` (appl_6 `pseq` eq kl_YaccParse appl_6) + case kl_if_7 of + Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_9 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 (Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_32 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_31 [kl_Parse_shen_LBpatternsRB] + let !aw_33 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_34 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_33 [kl_Parse_shen_LBactionRB] + let !appl_35 = Atom Nil + !appl_36 <- appl_34 `pseq` (appl_35 `pseq` klCons appl_34 appl_35) + !appl_37 <- appl_36 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.choicepoint!")) appl_36 + let !appl_38 = Atom Nil + !appl_39 <- appl_37 `pseq` (appl_38 `pseq` klCons appl_37 appl_38) + !appl_40 <- appl_32 `pseq` (appl_39 `pseq` klCons appl_32 appl_39) + let !aw_41 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_30 `pseq` (appl_40 `pseq` applyWrapper aw_41 [appl_30, + appl_40]) + Atom (B (False)) -> do do let !aw_42 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_42 [] + _ -> throwError "if: expected boolean"))) + !appl_43 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB + !appl_44 <- appl_43 `pseq` tl appl_43 + let !aw_45 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_46 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_45 [kl_Parse_shen_LBpatternsRB] + let !aw_47 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_48 <- appl_44 `pseq` (appl_46 `pseq` applyWrapper aw_47 [appl_44, + appl_46]) + !appl_49 <- appl_48 `pseq` kl_shen_LBactionRB appl_48 + appl_49 `pseq` applyWrapper appl_24 [appl_49] + Atom (B (False)) -> do do let !aw_50 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_50 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_51 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_51 [] + _ -> throwError "if: expected boolean"))) + !appl_52 <- kl_V1218 `pseq` kl_shen_LBpatternsRB kl_V1218 + appl_52 `pseq` applyWrapper appl_12 [appl_52] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_53 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternsRB) -> do let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_55 <- applyWrapper aw_54 [] + !appl_56 <- appl_55 `pseq` (kl_Parse_shen_LBpatternsRB `pseq` eq appl_55 kl_Parse_shen_LBpatternsRB) + let !aw_57 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_58 <- appl_56 `pseq` applyWrapper aw_57 [appl_56] + case kl_if_58 of + Atom (B (True)) -> do !appl_59 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB + !kl_if_60 <- appl_59 `pseq` consP appl_59 + !kl_if_61 <- case kl_if_60 of + Atom (B (True)) -> do !appl_62 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB + !appl_63 <- appl_62 `pseq` hd appl_62 + !kl_if_64 <- appl_63 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "<-")) appl_63 + case kl_if_64 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_61 of + Atom (B (True)) -> do let !appl_65 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBactionRB) -> do let !aw_66 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_67 <- applyWrapper aw_66 [] + !appl_68 <- appl_67 `pseq` (kl_Parse_shen_LBactionRB `pseq` eq appl_67 kl_Parse_shen_LBactionRB) + let !aw_69 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_70 <- appl_68 `pseq` applyWrapper aw_69 [appl_68] + case kl_if_70 of + Atom (B (True)) -> do !appl_71 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB + !kl_if_72 <- appl_71 `pseq` consP appl_71 + !kl_if_73 <- case kl_if_72 of + Atom (B (True)) -> do !appl_74 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB + !appl_75 <- appl_74 `pseq` hd appl_74 + !kl_if_76 <- appl_75 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "where")) appl_75 + case kl_if_76 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_73 of + Atom (B (True)) -> do let !appl_77 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBguardRB) -> do let !aw_78 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_79 <- applyWrapper aw_78 [] + !appl_80 <- appl_79 `pseq` (kl_Parse_shen_LBguardRB `pseq` eq appl_79 kl_Parse_shen_LBguardRB) + let !aw_81 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_82 <- appl_80 `pseq` applyWrapper aw_81 [appl_80] + case kl_if_82 of + Atom (B (True)) -> do !appl_83 <- kl_Parse_shen_LBguardRB `pseq` hd kl_Parse_shen_LBguardRB + let !aw_84 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_85 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_84 [kl_Parse_shen_LBpatternsRB] + let !aw_86 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_87 <- kl_Parse_shen_LBguardRB `pseq` applyWrapper aw_86 [kl_Parse_shen_LBguardRB] + let !aw_88 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_89 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_88 [kl_Parse_shen_LBactionRB] + let !appl_90 = Atom Nil + !appl_91 <- appl_89 `pseq` (appl_90 `pseq` klCons appl_89 appl_90) + !appl_92 <- appl_91 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.choicepoint!")) appl_91 + let !appl_93 = Atom Nil + !appl_94 <- appl_92 `pseq` (appl_93 `pseq` klCons appl_92 appl_93) + !appl_95 <- appl_87 `pseq` (appl_94 `pseq` klCons appl_87 appl_94) + !appl_96 <- appl_95 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "where")) appl_95 + let !appl_97 = Atom Nil + !appl_98 <- appl_96 `pseq` (appl_97 `pseq` klCons appl_96 appl_97) + !appl_99 <- appl_85 `pseq` (appl_98 `pseq` klCons appl_85 appl_98) + let !aw_100 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_83 `pseq` (appl_99 `pseq` applyWrapper aw_100 [appl_83, + appl_99]) + Atom (B (False)) -> do do let !aw_101 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_101 [] + _ -> throwError "if: expected boolean"))) + !appl_102 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB + !appl_103 <- appl_102 `pseq` tl appl_102 + let !aw_104 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_105 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_104 [kl_Parse_shen_LBactionRB] + let !aw_106 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_107 <- appl_103 `pseq` (appl_105 `pseq` applyWrapper aw_106 [appl_103, + appl_105]) + !appl_108 <- appl_107 `pseq` kl_shen_LBguardRB appl_107 + appl_108 `pseq` applyWrapper appl_77 [appl_108] + Atom (B (False)) -> do do let !aw_109 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_109 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_110 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_110 [] + _ -> throwError "if: expected boolean"))) + !appl_111 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB + !appl_112 <- appl_111 `pseq` tl appl_111 + let !aw_113 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_114 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_113 [kl_Parse_shen_LBpatternsRB] + let !aw_115 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_116 <- appl_112 `pseq` (appl_114 `pseq` applyWrapper aw_115 [appl_112, + appl_114]) + !appl_117 <- appl_116 `pseq` kl_shen_LBactionRB appl_116 + appl_117 `pseq` applyWrapper appl_65 [appl_117] + Atom (B (False)) -> do do let !aw_118 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_118 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_119 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_119 [] + _ -> throwError "if: expected boolean"))) + !appl_120 <- kl_V1218 `pseq` kl_shen_LBpatternsRB kl_V1218 + !appl_121 <- appl_120 `pseq` applyWrapper appl_53 [appl_120] + appl_121 `pseq` applyWrapper appl_8 [appl_121] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_122 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternsRB) -> do let !aw_123 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_124 <- applyWrapper aw_123 [] + !appl_125 <- appl_124 `pseq` (kl_Parse_shen_LBpatternsRB `pseq` eq appl_124 kl_Parse_shen_LBpatternsRB) + let !aw_126 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_127 <- appl_125 `pseq` applyWrapper aw_126 [appl_125] + case kl_if_127 of + Atom (B (True)) -> do !appl_128 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB + !kl_if_129 <- appl_128 `pseq` consP appl_128 + !kl_if_130 <- case kl_if_129 of + Atom (B (True)) -> do !appl_131 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB + !appl_132 <- appl_131 `pseq` hd appl_131 + !kl_if_133 <- appl_132 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "->")) appl_132 + case kl_if_133 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_130 of + Atom (B (True)) -> do let !appl_134 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBactionRB) -> do let !aw_135 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_136 <- applyWrapper aw_135 [] + !appl_137 <- appl_136 `pseq` (kl_Parse_shen_LBactionRB `pseq` eq appl_136 kl_Parse_shen_LBactionRB) + let !aw_138 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_139 <- appl_137 `pseq` applyWrapper aw_138 [appl_137] + case kl_if_139 of + Atom (B (True)) -> do !appl_140 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB + let !aw_141 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_142 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_141 [kl_Parse_shen_LBpatternsRB] + let !aw_143 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_144 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_143 [kl_Parse_shen_LBactionRB] + let !appl_145 = Atom Nil + !appl_146 <- appl_144 `pseq` (appl_145 `pseq` klCons appl_144 appl_145) + !appl_147 <- appl_142 `pseq` (appl_146 `pseq` klCons appl_142 appl_146) + let !aw_148 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_140 `pseq` (appl_147 `pseq` applyWrapper aw_148 [appl_140, + appl_147]) + Atom (B (False)) -> do do let !aw_149 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_149 [] + _ -> throwError "if: expected boolean"))) + !appl_150 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB + !appl_151 <- appl_150 `pseq` tl appl_150 + let !aw_152 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_153 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_152 [kl_Parse_shen_LBpatternsRB] + let !aw_154 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_155 <- appl_151 `pseq` (appl_153 `pseq` applyWrapper aw_154 [appl_151, + appl_153]) + !appl_156 <- appl_155 `pseq` kl_shen_LBactionRB appl_155 + appl_156 `pseq` applyWrapper appl_134 [appl_156] + Atom (B (False)) -> do do let !aw_157 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_157 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_158 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_158 [] + _ -> throwError "if: expected boolean"))) + !appl_159 <- kl_V1218 `pseq` kl_shen_LBpatternsRB kl_V1218 + !appl_160 <- appl_159 `pseq` applyWrapper appl_122 [appl_159] + appl_160 `pseq` applyWrapper appl_4 [appl_160] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_161 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternsRB) -> do let !aw_162 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_163 <- applyWrapper aw_162 [] + !appl_164 <- appl_163 `pseq` (kl_Parse_shen_LBpatternsRB `pseq` eq appl_163 kl_Parse_shen_LBpatternsRB) + let !aw_165 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_166 <- appl_164 `pseq` applyWrapper aw_165 [appl_164] + case kl_if_166 of + Atom (B (True)) -> do !appl_167 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB + !kl_if_168 <- appl_167 `pseq` consP appl_167 + !kl_if_169 <- case kl_if_168 of + Atom (B (True)) -> do !appl_170 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB + !appl_171 <- appl_170 `pseq` hd appl_170 + !kl_if_172 <- appl_171 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "->")) appl_171 + case kl_if_172 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_169 of + Atom (B (True)) -> do let !appl_173 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBactionRB) -> do let !aw_174 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_175 <- applyWrapper aw_174 [] + !appl_176 <- appl_175 `pseq` (kl_Parse_shen_LBactionRB `pseq` eq appl_175 kl_Parse_shen_LBactionRB) + let !aw_177 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_178 <- appl_176 `pseq` applyWrapper aw_177 [appl_176] + case kl_if_178 of + Atom (B (True)) -> do !appl_179 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB + !kl_if_180 <- appl_179 `pseq` consP appl_179 + !kl_if_181 <- case kl_if_180 of + Atom (B (True)) -> do !appl_182 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB + !appl_183 <- appl_182 `pseq` hd appl_182 + !kl_if_184 <- appl_183 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "where")) appl_183 + case kl_if_184 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_181 of + Atom (B (True)) -> do let !appl_185 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBguardRB) -> do let !aw_186 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_187 <- applyWrapper aw_186 [] + !appl_188 <- appl_187 `pseq` (kl_Parse_shen_LBguardRB `pseq` eq appl_187 kl_Parse_shen_LBguardRB) + let !aw_189 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_190 <- appl_188 `pseq` applyWrapper aw_189 [appl_188] + case kl_if_190 of + Atom (B (True)) -> do !appl_191 <- kl_Parse_shen_LBguardRB `pseq` hd kl_Parse_shen_LBguardRB + let !aw_192 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_193 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_192 [kl_Parse_shen_LBpatternsRB] + let !aw_194 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_195 <- kl_Parse_shen_LBguardRB `pseq` applyWrapper aw_194 [kl_Parse_shen_LBguardRB] + let !aw_196 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_197 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_196 [kl_Parse_shen_LBactionRB] + let !appl_198 = Atom Nil + !appl_199 <- appl_197 `pseq` (appl_198 `pseq` klCons appl_197 appl_198) + !appl_200 <- appl_195 `pseq` (appl_199 `pseq` klCons appl_195 appl_199) + !appl_201 <- appl_200 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "where")) appl_200 + let !appl_202 = Atom Nil + !appl_203 <- appl_201 `pseq` (appl_202 `pseq` klCons appl_201 appl_202) + !appl_204 <- appl_193 `pseq` (appl_203 `pseq` klCons appl_193 appl_203) + let !aw_205 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_191 `pseq` (appl_204 `pseq` applyWrapper aw_205 [appl_191, + appl_204]) + Atom (B (False)) -> do do let !aw_206 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_206 [] + _ -> throwError "if: expected boolean"))) + !appl_207 <- kl_Parse_shen_LBactionRB `pseq` hd kl_Parse_shen_LBactionRB + !appl_208 <- appl_207 `pseq` tl appl_207 + let !aw_209 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_210 <- kl_Parse_shen_LBactionRB `pseq` applyWrapper aw_209 [kl_Parse_shen_LBactionRB] + let !aw_211 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_212 <- appl_208 `pseq` (appl_210 `pseq` applyWrapper aw_211 [appl_208, + appl_210]) + !appl_213 <- appl_212 `pseq` kl_shen_LBguardRB appl_212 + appl_213 `pseq` applyWrapper appl_185 [appl_213] + Atom (B (False)) -> do do let !aw_214 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_214 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_215 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_215 [] + _ -> throwError "if: expected boolean"))) + !appl_216 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB + !appl_217 <- appl_216 `pseq` tl appl_216 + let !aw_218 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_219 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_218 [kl_Parse_shen_LBpatternsRB] + let !aw_220 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_221 <- appl_217 `pseq` (appl_219 `pseq` applyWrapper aw_220 [appl_217, + appl_219]) + !appl_222 <- appl_221 `pseq` kl_shen_LBactionRB appl_221 + appl_222 `pseq` applyWrapper appl_173 [appl_222] + Atom (B (False)) -> do do let !aw_223 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_223 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_224 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_224 [] + _ -> throwError "if: expected boolean"))) + !appl_225 <- kl_V1218 `pseq` kl_shen_LBpatternsRB kl_V1218 + !appl_226 <- appl_225 `pseq` applyWrapper appl_161 [appl_225] + appl_226 `pseq` applyWrapper appl_0 [appl_226] + +kl_shen_fail_if :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_fail_if (!kl_V1221) (!kl_V1222) = do !kl_if_0 <- kl_V1222 `pseq` applyWrapper kl_V1221 [kl_V1222] + case kl_if_0 of + Atom (B (True)) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_1 [] + Atom (B (False)) -> do do return kl_V1222 + _ -> throwError "if: expected boolean" + +kl_shen_succeedsP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_succeedsP (!kl_V1228) = do let !aw_0 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_1 <- applyWrapper aw_0 [] + !kl_if_2 <- kl_V1228 `pseq` (appl_1 `pseq` eq kl_V1228 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 :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBpatternsRB (!kl_V1230) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !appl_7 <- appl_6 `pseq` (kl_Parse_LBeRB `pseq` eq appl_6 kl_Parse_LBeRB) + let !aw_8 = Core.Types.Atom (Core.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 !appl_11 = Atom Nil + let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_10 `pseq` (appl_11 `pseq` applyWrapper aw_12 [appl_10, + appl_11]) + Atom (B (False)) -> do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_13 [] + _ -> throwError "if: expected boolean"))) + let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "") + !appl_15 <- kl_V1230 `pseq` applyWrapper aw_14 [kl_V1230] + appl_15 `pseq` applyWrapper appl_4 [appl_15] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_16 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternRB) -> do let !aw_17 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_18 <- applyWrapper aw_17 [] + !appl_19 <- appl_18 `pseq` (kl_Parse_shen_LBpatternRB `pseq` eq appl_18 kl_Parse_shen_LBpatternRB) + let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_21 <- appl_19 `pseq` applyWrapper aw_20 [appl_19] + case kl_if_21 of + Atom (B (True)) -> do let !appl_22 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternsRB) -> do let !aw_23 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_24 <- applyWrapper aw_23 [] + !appl_25 <- appl_24 `pseq` (kl_Parse_shen_LBpatternsRB `pseq` eq appl_24 kl_Parse_shen_LBpatternsRB) + let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_27 <- appl_25 `pseq` applyWrapper aw_26 [appl_25] + case kl_if_27 of + Atom (B (True)) -> do !appl_28 <- kl_Parse_shen_LBpatternsRB `pseq` hd kl_Parse_shen_LBpatternsRB + let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_30 <- kl_Parse_shen_LBpatternRB `pseq` applyWrapper aw_29 [kl_Parse_shen_LBpatternRB] + let !aw_31 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_32 <- kl_Parse_shen_LBpatternsRB `pseq` applyWrapper aw_31 [kl_Parse_shen_LBpatternsRB] + !appl_33 <- appl_30 `pseq` (appl_32 `pseq` klCons appl_30 appl_32) + let !aw_34 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_28 `pseq` (appl_33 `pseq` applyWrapper aw_34 [appl_28, + appl_33]) + Atom (B (False)) -> do do let !aw_35 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_35 [] + _ -> throwError "if: expected boolean"))) + !appl_36 <- kl_Parse_shen_LBpatternRB `pseq` kl_shen_LBpatternsRB kl_Parse_shen_LBpatternRB + appl_36 `pseq` applyWrapper appl_22 [appl_36] + Atom (B (False)) -> do do let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_37 [] + _ -> throwError "if: expected boolean"))) + !appl_38 <- kl_V1230 `pseq` kl_shen_LBpatternRB kl_V1230 + !appl_39 <- appl_38 `pseq` applyWrapper appl_16 [appl_38] + appl_39 `pseq` applyWrapper appl_0 [appl_39] + +kl_shen_LBpatternRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBpatternRB (!kl_V1237) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !kl_if_7 <- kl_YaccParse `pseq` (appl_6 `pseq` eq kl_YaccParse appl_6) + case kl_if_7 of + Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_9 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_32 <- kl_Parse_shen_LBsimple_patternRB `pseq` applyWrapper aw_31 [kl_Parse_shen_LBsimple_patternRB] + let !aw_33 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_34 [] + _ -> throwError "if: expected boolean"))) + !appl_35 <- kl_V1237 `pseq` kl_shen_LBsimple_patternRB kl_V1237 + appl_35 `pseq` applyWrapper appl_24 [appl_35] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + !appl_36 <- kl_V1237 `pseq` hd kl_V1237 + !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_V1237 `pseq` hd kl_V1237 + !appl_42 <- appl_41 `pseq` tl appl_41 + let !aw_43 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_44 <- kl_V1237 `pseq` applyWrapper aw_43 [kl_V1237] + let !aw_45 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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_V1237 `pseq` hd kl_V1237 + !appl_53 <- appl_52 `pseq` hd appl_52 + appl_53 `pseq` applyWrapper appl_39 [appl_53] + Atom (B (False)) -> do do let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_54 [] + _ -> throwError "if: expected boolean" + appl_38 `pseq` applyWrapper appl_20 [appl_38] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + !appl_55 <- kl_V1237 `pseq` hd kl_V1237 + !kl_if_56 <- appl_55 `pseq` consP appl_55 + !kl_if_57 <- case kl_if_56 of + Atom (B (True)) -> do !appl_58 <- kl_V1237 `pseq` hd kl_V1237 + !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_V1237 `pseq` hd kl_V1237 + !appl_63 <- appl_62 `pseq` hd appl_62 + !appl_64 <- kl_V1237 `pseq` tl kl_V1237 + !appl_65 <- appl_64 `pseq` hd appl_64 + let !aw_66 = Core.Types.Atom (Core.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_V1237 `pseq` hd kl_V1237 + !appl_72 <- appl_71 `pseq` hd appl_71 + !appl_73 <- kl_V1237 `pseq` tl kl_V1237 + !appl_74 <- appl_73 `pseq` hd appl_73 + let !aw_75 = Core.Types.Atom (Core.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 (Core.Types.Atom (Core.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_V1237 `pseq` hd kl_V1237 + !appl_81 <- appl_80 `pseq` hd appl_80 + !appl_82 <- kl_V1237 `pseq` tl kl_V1237 + !appl_83 <- appl_82 `pseq` hd appl_82 + let !aw_84 = Core.Types.Atom (Core.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_V1237 `pseq` hd kl_V1237 + !appl_89 <- appl_88 `pseq` hd appl_88 + !appl_90 <- kl_V1237 `pseq` tl kl_V1237 + !appl_91 <- appl_90 `pseq` hd appl_90 + let !aw_92 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_93 <- appl_89 `pseq` (appl_91 `pseq` applyWrapper aw_92 [appl_89, + appl_91]) + let !aw_94 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_95 <- appl_93 `pseq` applyWrapper aw_94 [appl_93] + let !aw_96 = Core.Types.Atom (Core.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_V1237 `pseq` hd kl_V1237 + !appl_102 <- appl_101 `pseq` hd appl_101 + !appl_103 <- kl_V1237 `pseq` tl kl_V1237 + !appl_104 <- appl_103 `pseq` hd appl_103 + let !aw_105 = Core.Types.Atom (Core.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_V1237 `pseq` hd kl_V1237 + !appl_110 <- appl_109 `pseq` hd appl_109 + !appl_111 <- kl_V1237 `pseq` tl kl_V1237 + !appl_112 <- appl_111 `pseq` hd appl_111 + let !aw_113 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_114 <- appl_110 `pseq` (appl_112 `pseq` applyWrapper aw_113 [appl_110, + appl_112]) + let !aw_115 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_116 <- appl_114 `pseq` applyWrapper aw_115 [appl_114] + let !aw_117 = Core.Types.Atom (Core.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 (Core.Types.Atom (Core.Types.N (Core.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_V1237 `pseq` hd kl_V1237 + !appl_123 <- appl_122 `pseq` tl appl_122 + !appl_124 <- kl_V1237 `pseq` tl kl_V1237 + !appl_125 <- appl_124 `pseq` hd appl_124 + let !aw_126 = Core.Types.Atom (Core.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 + let !appl_129 = Atom Nil + !appl_130 <- appl_129 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_129 + !appl_131 <- appl_130 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "vector")) appl_130 + let !aw_132 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_128 `pseq` (appl_131 `pseq` applyWrapper aw_132 [appl_128, + appl_131]) + Atom (B (False)) -> do do let !aw_133 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_133 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_134 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_134 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_135 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_135 [] + _ -> 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_136 <- kl_V1237 `pseq` hd kl_V1237 + !kl_if_137 <- appl_136 `pseq` consP appl_136 + !kl_if_138 <- case kl_if_137 of + Atom (B (True)) -> do !appl_139 <- kl_V1237 `pseq` hd kl_V1237 + !appl_140 <- appl_139 `pseq` hd appl_139 + !kl_if_141 <- appl_140 `pseq` consP appl_140 + case kl_if_141 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_142 <- case kl_if_138 of + Atom (B (True)) -> do !appl_143 <- kl_V1237 `pseq` hd kl_V1237 + !appl_144 <- appl_143 `pseq` hd appl_143 + !appl_145 <- kl_V1237 `pseq` tl kl_V1237 + !appl_146 <- appl_145 `pseq` hd appl_145 + let !aw_147 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_148 <- appl_144 `pseq` (appl_146 `pseq` applyWrapper aw_147 [appl_144, + appl_146]) + !appl_149 <- appl_148 `pseq` hd appl_148 + !kl_if_150 <- appl_149 `pseq` consP appl_149 + !kl_if_151 <- case kl_if_150 of + Atom (B (True)) -> do !appl_152 <- kl_V1237 `pseq` hd kl_V1237 + !appl_153 <- appl_152 `pseq` hd appl_152 + !appl_154 <- kl_V1237 `pseq` tl kl_V1237 + !appl_155 <- appl_154 `pseq` hd appl_154 + let !aw_156 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_157 <- appl_153 `pseq` (appl_155 `pseq` applyWrapper aw_156 [appl_153, + appl_155]) + !appl_158 <- appl_157 `pseq` hd appl_157 + !appl_159 <- appl_158 `pseq` hd appl_158 + !kl_if_160 <- appl_159 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "@s")) appl_159 + case kl_if_160 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_151 of + Atom (B (True)) -> do let !appl_161 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern1RB) -> do let !aw_162 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_163 <- applyWrapper aw_162 [] + !appl_164 <- appl_163 `pseq` (kl_Parse_shen_LBpattern1RB `pseq` eq appl_163 kl_Parse_shen_LBpattern1RB) + let !aw_165 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_166 <- appl_164 `pseq` applyWrapper aw_165 [appl_164] + case kl_if_166 of + Atom (B (True)) -> do let !appl_167 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern2RB) -> do let !aw_168 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_169 <- applyWrapper aw_168 [] + !appl_170 <- appl_169 `pseq` (kl_Parse_shen_LBpattern2RB `pseq` eq appl_169 kl_Parse_shen_LBpattern2RB) + let !aw_171 = Core.Types.Atom (Core.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_V1237 `pseq` hd kl_V1237 + !appl_174 <- appl_173 `pseq` tl appl_173 + !appl_175 <- kl_V1237 `pseq` tl kl_V1237 + !appl_176 <- appl_175 `pseq` hd appl_175 + let !aw_177 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_178 <- appl_174 `pseq` (appl_176 `pseq` applyWrapper aw_177 [appl_174, + appl_176]) + !appl_179 <- appl_178 `pseq` hd appl_178 + let !aw_180 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_181 <- kl_Parse_shen_LBpattern1RB `pseq` applyWrapper aw_180 [kl_Parse_shen_LBpattern1RB] + let !aw_182 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_183 <- kl_Parse_shen_LBpattern2RB `pseq` applyWrapper aw_182 [kl_Parse_shen_LBpattern2RB] + let !appl_184 = Atom Nil + !appl_185 <- appl_183 `pseq` (appl_184 `pseq` klCons appl_183 appl_184) + !appl_186 <- appl_181 `pseq` (appl_185 `pseq` klCons appl_181 appl_185) + !appl_187 <- appl_186 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "@s")) appl_186 + let !aw_188 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_179 `pseq` (appl_187 `pseq` applyWrapper aw_188 [appl_179, + appl_187]) + Atom (B (False)) -> do do let !aw_189 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_189 [] + _ -> throwError "if: expected boolean"))) + !appl_190 <- kl_Parse_shen_LBpattern1RB `pseq` kl_shen_LBpattern2RB kl_Parse_shen_LBpattern1RB + appl_190 `pseq` applyWrapper appl_167 [appl_190] + Atom (B (False)) -> do do let !aw_191 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_191 [] + _ -> throwError "if: expected boolean"))) + !appl_192 <- kl_V1237 `pseq` hd kl_V1237 + !appl_193 <- appl_192 `pseq` hd appl_192 + !appl_194 <- kl_V1237 `pseq` tl kl_V1237 + !appl_195 <- appl_194 `pseq` hd appl_194 + let !aw_196 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_197 <- appl_193 `pseq` (appl_195 `pseq` applyWrapper aw_196 [appl_193, + appl_195]) + !appl_198 <- appl_197 `pseq` hd appl_197 + !appl_199 <- appl_198 `pseq` tl appl_198 + !appl_200 <- kl_V1237 `pseq` hd kl_V1237 + !appl_201 <- appl_200 `pseq` hd appl_200 + !appl_202 <- kl_V1237 `pseq` tl kl_V1237 + !appl_203 <- appl_202 `pseq` hd appl_202 + let !aw_204 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_205 <- appl_201 `pseq` (appl_203 `pseq` applyWrapper aw_204 [appl_201, + appl_203]) + let !aw_206 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_207 <- appl_205 `pseq` applyWrapper aw_206 [appl_205] + let !aw_208 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_209 <- appl_199 `pseq` (appl_207 `pseq` applyWrapper aw_208 [appl_199, + appl_207]) + !appl_210 <- appl_209 `pseq` kl_shen_LBpattern1RB appl_209 + appl_210 `pseq` applyWrapper appl_161 [appl_210] + Atom (B (False)) -> do do let !aw_211 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_211 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_212 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_212 [] + _ -> throwError "if: expected boolean" + appl_142 `pseq` applyWrapper appl_12 [appl_142] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + !appl_213 <- kl_V1237 `pseq` hd kl_V1237 + !kl_if_214 <- appl_213 `pseq` consP appl_213 + !kl_if_215 <- case kl_if_214 of + Atom (B (True)) -> do !appl_216 <- kl_V1237 `pseq` hd kl_V1237 + !appl_217 <- appl_216 `pseq` hd appl_216 + !kl_if_218 <- appl_217 `pseq` consP appl_217 + case kl_if_218 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_219 <- case kl_if_215 of + Atom (B (True)) -> do !appl_220 <- kl_V1237 `pseq` hd kl_V1237 + !appl_221 <- appl_220 `pseq` hd appl_220 + !appl_222 <- kl_V1237 `pseq` tl kl_V1237 + !appl_223 <- appl_222 `pseq` hd appl_222 + let !aw_224 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_225 <- appl_221 `pseq` (appl_223 `pseq` applyWrapper aw_224 [appl_221, + appl_223]) + !appl_226 <- appl_225 `pseq` hd appl_225 + !kl_if_227 <- appl_226 `pseq` consP appl_226 + !kl_if_228 <- case kl_if_227 of + Atom (B (True)) -> do !appl_229 <- kl_V1237 `pseq` hd kl_V1237 + !appl_230 <- appl_229 `pseq` hd appl_229 + !appl_231 <- kl_V1237 `pseq` tl kl_V1237 + !appl_232 <- appl_231 `pseq` hd appl_231 + let !aw_233 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_234 <- appl_230 `pseq` (appl_232 `pseq` applyWrapper aw_233 [appl_230, + appl_232]) + !appl_235 <- appl_234 `pseq` hd appl_234 + !appl_236 <- appl_235 `pseq` hd appl_235 + !kl_if_237 <- appl_236 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "@v")) appl_236 + case kl_if_237 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_228 of + Atom (B (True)) -> do let !appl_238 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern1RB) -> do let !aw_239 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_240 <- applyWrapper aw_239 [] + !appl_241 <- appl_240 `pseq` (kl_Parse_shen_LBpattern1RB `pseq` eq appl_240 kl_Parse_shen_LBpattern1RB) + let !aw_242 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_243 <- appl_241 `pseq` applyWrapper aw_242 [appl_241] + case kl_if_243 of + Atom (B (True)) -> do let !appl_244 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern2RB) -> do let !aw_245 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_246 <- applyWrapper aw_245 [] + !appl_247 <- appl_246 `pseq` (kl_Parse_shen_LBpattern2RB `pseq` eq appl_246 kl_Parse_shen_LBpattern2RB) + let !aw_248 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_249 <- appl_247 `pseq` applyWrapper aw_248 [appl_247] + case kl_if_249 of + Atom (B (True)) -> do !appl_250 <- kl_V1237 `pseq` hd kl_V1237 + !appl_251 <- appl_250 `pseq` tl appl_250 + !appl_252 <- kl_V1237 `pseq` tl kl_V1237 + !appl_253 <- appl_252 `pseq` hd appl_252 + let !aw_254 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_255 <- appl_251 `pseq` (appl_253 `pseq` applyWrapper aw_254 [appl_251, + appl_253]) + !appl_256 <- appl_255 `pseq` hd appl_255 + let !aw_257 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_258 <- kl_Parse_shen_LBpattern1RB `pseq` applyWrapper aw_257 [kl_Parse_shen_LBpattern1RB] + let !aw_259 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_260 <- kl_Parse_shen_LBpattern2RB `pseq` applyWrapper aw_259 [kl_Parse_shen_LBpattern2RB] + let !appl_261 = Atom Nil + !appl_262 <- appl_260 `pseq` (appl_261 `pseq` klCons appl_260 appl_261) + !appl_263 <- appl_258 `pseq` (appl_262 `pseq` klCons appl_258 appl_262) + !appl_264 <- appl_263 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "@v")) appl_263 + let !aw_265 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_256 `pseq` (appl_264 `pseq` applyWrapper aw_265 [appl_256, + appl_264]) + Atom (B (False)) -> do do let !aw_266 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_266 [] + _ -> throwError "if: expected boolean"))) + !appl_267 <- kl_Parse_shen_LBpattern1RB `pseq` kl_shen_LBpattern2RB kl_Parse_shen_LBpattern1RB + appl_267 `pseq` applyWrapper appl_244 [appl_267] + Atom (B (False)) -> do do let !aw_268 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_268 [] + _ -> throwError "if: expected boolean"))) + !appl_269 <- kl_V1237 `pseq` hd kl_V1237 + !appl_270 <- appl_269 `pseq` hd appl_269 + !appl_271 <- kl_V1237 `pseq` tl kl_V1237 + !appl_272 <- appl_271 `pseq` hd appl_271 + let !aw_273 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_274 <- appl_270 `pseq` (appl_272 `pseq` applyWrapper aw_273 [appl_270, + appl_272]) + !appl_275 <- appl_274 `pseq` hd appl_274 + !appl_276 <- appl_275 `pseq` tl appl_275 + !appl_277 <- kl_V1237 `pseq` hd kl_V1237 + !appl_278 <- appl_277 `pseq` hd appl_277 + !appl_279 <- kl_V1237 `pseq` tl kl_V1237 + !appl_280 <- appl_279 `pseq` hd appl_279 + let !aw_281 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_282 <- appl_278 `pseq` (appl_280 `pseq` applyWrapper aw_281 [appl_278, + appl_280]) + let !aw_283 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_284 <- appl_282 `pseq` applyWrapper aw_283 [appl_282] + let !aw_285 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_286 <- appl_276 `pseq` (appl_284 `pseq` applyWrapper aw_285 [appl_276, + appl_284]) + !appl_287 <- appl_286 `pseq` kl_shen_LBpattern1RB appl_286 + appl_287 `pseq` applyWrapper appl_238 [appl_287] + Atom (B (False)) -> do do let !aw_288 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_288 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_289 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_289 [] + _ -> throwError "if: expected boolean" + appl_219 `pseq` applyWrapper appl_8 [appl_219] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + !appl_290 <- kl_V1237 `pseq` hd kl_V1237 + !kl_if_291 <- appl_290 `pseq` consP appl_290 + !kl_if_292 <- case kl_if_291 of + Atom (B (True)) -> do !appl_293 <- kl_V1237 `pseq` hd kl_V1237 + !appl_294 <- appl_293 `pseq` hd appl_293 + !kl_if_295 <- appl_294 `pseq` consP appl_294 + case kl_if_295 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_296 <- case kl_if_292 of + Atom (B (True)) -> do !appl_297 <- kl_V1237 `pseq` hd kl_V1237 + !appl_298 <- appl_297 `pseq` hd appl_297 + !appl_299 <- kl_V1237 `pseq` tl kl_V1237 + !appl_300 <- appl_299 `pseq` hd appl_299 + let !aw_301 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_302 <- appl_298 `pseq` (appl_300 `pseq` applyWrapper aw_301 [appl_298, + appl_300]) + !appl_303 <- appl_302 `pseq` hd appl_302 + !kl_if_304 <- appl_303 `pseq` consP appl_303 + !kl_if_305 <- case kl_if_304 of + Atom (B (True)) -> do !appl_306 <- kl_V1237 `pseq` hd kl_V1237 + !appl_307 <- appl_306 `pseq` hd appl_306 + !appl_308 <- kl_V1237 `pseq` tl kl_V1237 + !appl_309 <- appl_308 `pseq` hd appl_308 + let !aw_310 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_311 <- appl_307 `pseq` (appl_309 `pseq` applyWrapper aw_310 [appl_307, + appl_309]) + !appl_312 <- appl_311 `pseq` hd appl_311 + !appl_313 <- appl_312 `pseq` hd appl_312 + !kl_if_314 <- appl_313 `pseq` eq (ApplC (wrapNamed "cons" klCons)) appl_313 + case kl_if_314 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_305 of + Atom (B (True)) -> do let !appl_315 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern1RB) -> do let !aw_316 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_317 <- applyWrapper aw_316 [] + !appl_318 <- appl_317 `pseq` (kl_Parse_shen_LBpattern1RB `pseq` eq appl_317 kl_Parse_shen_LBpattern1RB) + let !aw_319 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_320 <- appl_318 `pseq` applyWrapper aw_319 [appl_318] + case kl_if_320 of + Atom (B (True)) -> do let !appl_321 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern2RB) -> do let !aw_322 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_323 <- applyWrapper aw_322 [] + !appl_324 <- appl_323 `pseq` (kl_Parse_shen_LBpattern2RB `pseq` eq appl_323 kl_Parse_shen_LBpattern2RB) + let !aw_325 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_326 <- appl_324 `pseq` applyWrapper aw_325 [appl_324] + case kl_if_326 of + Atom (B (True)) -> do !appl_327 <- kl_V1237 `pseq` hd kl_V1237 + !appl_328 <- appl_327 `pseq` tl appl_327 + !appl_329 <- kl_V1237 `pseq` tl kl_V1237 + !appl_330 <- appl_329 `pseq` hd appl_329 + let !aw_331 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_332 <- appl_328 `pseq` (appl_330 `pseq` applyWrapper aw_331 [appl_328, + appl_330]) + !appl_333 <- appl_332 `pseq` hd appl_332 + let !aw_334 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_335 <- kl_Parse_shen_LBpattern1RB `pseq` applyWrapper aw_334 [kl_Parse_shen_LBpattern1RB] + let !aw_336 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_337 <- kl_Parse_shen_LBpattern2RB `pseq` applyWrapper aw_336 [kl_Parse_shen_LBpattern2RB] + let !appl_338 = Atom Nil + !appl_339 <- appl_337 `pseq` (appl_338 `pseq` klCons appl_337 appl_338) + !appl_340 <- appl_335 `pseq` (appl_339 `pseq` klCons appl_335 appl_339) + !appl_341 <- appl_340 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_340 + let !aw_342 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_333 `pseq` (appl_341 `pseq` applyWrapper aw_342 [appl_333, + appl_341]) + Atom (B (False)) -> do do let !aw_343 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_343 [] + _ -> throwError "if: expected boolean"))) + !appl_344 <- kl_Parse_shen_LBpattern1RB `pseq` kl_shen_LBpattern2RB kl_Parse_shen_LBpattern1RB + appl_344 `pseq` applyWrapper appl_321 [appl_344] + Atom (B (False)) -> do do let !aw_345 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_345 [] + _ -> throwError "if: expected boolean"))) + !appl_346 <- kl_V1237 `pseq` hd kl_V1237 + !appl_347 <- appl_346 `pseq` hd appl_346 + !appl_348 <- kl_V1237 `pseq` tl kl_V1237 + !appl_349 <- appl_348 `pseq` hd appl_348 + let !aw_350 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_351 <- appl_347 `pseq` (appl_349 `pseq` applyWrapper aw_350 [appl_347, + appl_349]) + !appl_352 <- appl_351 `pseq` hd appl_351 + !appl_353 <- appl_352 `pseq` tl appl_352 + !appl_354 <- kl_V1237 `pseq` hd kl_V1237 + !appl_355 <- appl_354 `pseq` hd appl_354 + !appl_356 <- kl_V1237 `pseq` tl kl_V1237 + !appl_357 <- appl_356 `pseq` hd appl_356 + let !aw_358 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_359 <- appl_355 `pseq` (appl_357 `pseq` applyWrapper aw_358 [appl_355, + appl_357]) + let !aw_360 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_361 <- appl_359 `pseq` applyWrapper aw_360 [appl_359] + let !aw_362 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_363 <- appl_353 `pseq` (appl_361 `pseq` applyWrapper aw_362 [appl_353, + appl_361]) + !appl_364 <- appl_363 `pseq` kl_shen_LBpattern1RB appl_363 + appl_364 `pseq` applyWrapper appl_315 [appl_364] + Atom (B (False)) -> do do let !aw_365 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_365 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_366 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_366 [] + _ -> throwError "if: expected boolean" + appl_296 `pseq` applyWrapper appl_4 [appl_296] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + !appl_367 <- kl_V1237 `pseq` hd kl_V1237 + !kl_if_368 <- appl_367 `pseq` consP appl_367 + !kl_if_369 <- case kl_if_368 of + Atom (B (True)) -> do !appl_370 <- kl_V1237 `pseq` hd kl_V1237 + !appl_371 <- appl_370 `pseq` hd appl_370 + !kl_if_372 <- appl_371 `pseq` consP appl_371 + case kl_if_372 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_373 <- case kl_if_369 of + Atom (B (True)) -> do !appl_374 <- kl_V1237 `pseq` hd kl_V1237 + !appl_375 <- appl_374 `pseq` hd appl_374 + !appl_376 <- kl_V1237 `pseq` tl kl_V1237 + !appl_377 <- appl_376 `pseq` hd appl_376 + let !aw_378 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_379 <- appl_375 `pseq` (appl_377 `pseq` applyWrapper aw_378 [appl_375, + appl_377]) + !appl_380 <- appl_379 `pseq` hd appl_379 + !kl_if_381 <- appl_380 `pseq` consP appl_380 + !kl_if_382 <- case kl_if_381 of + Atom (B (True)) -> do !appl_383 <- kl_V1237 `pseq` hd kl_V1237 + !appl_384 <- appl_383 `pseq` hd appl_383 + !appl_385 <- kl_V1237 `pseq` tl kl_V1237 + !appl_386 <- appl_385 `pseq` hd appl_385 + let !aw_387 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_388 <- appl_384 `pseq` (appl_386 `pseq` applyWrapper aw_387 [appl_384, + appl_386]) + !appl_389 <- appl_388 `pseq` hd appl_388 + !appl_390 <- appl_389 `pseq` hd appl_389 + !kl_if_391 <- appl_390 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "@p")) appl_390 + case kl_if_391 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_382 of + Atom (B (True)) -> do let !appl_392 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern1RB) -> do let !aw_393 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_394 <- applyWrapper aw_393 [] + !appl_395 <- appl_394 `pseq` (kl_Parse_shen_LBpattern1RB `pseq` eq appl_394 kl_Parse_shen_LBpattern1RB) + let !aw_396 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_397 <- appl_395 `pseq` applyWrapper aw_396 [appl_395] + case kl_if_397 of + Atom (B (True)) -> do let !appl_398 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpattern2RB) -> do let !aw_399 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_400 <- applyWrapper aw_399 [] + !appl_401 <- appl_400 `pseq` (kl_Parse_shen_LBpattern2RB `pseq` eq appl_400 kl_Parse_shen_LBpattern2RB) + let !aw_402 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_403 <- appl_401 `pseq` applyWrapper aw_402 [appl_401] + case kl_if_403 of + Atom (B (True)) -> do !appl_404 <- kl_V1237 `pseq` hd kl_V1237 + !appl_405 <- appl_404 `pseq` tl appl_404 + !appl_406 <- kl_V1237 `pseq` tl kl_V1237 + !appl_407 <- appl_406 `pseq` hd appl_406 + let !aw_408 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_409 <- appl_405 `pseq` (appl_407 `pseq` applyWrapper aw_408 [appl_405, + appl_407]) + !appl_410 <- appl_409 `pseq` hd appl_409 + let !aw_411 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_412 <- kl_Parse_shen_LBpattern1RB `pseq` applyWrapper aw_411 [kl_Parse_shen_LBpattern1RB] + let !aw_413 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_414 <- kl_Parse_shen_LBpattern2RB `pseq` applyWrapper aw_413 [kl_Parse_shen_LBpattern2RB] + let !appl_415 = Atom Nil + !appl_416 <- appl_414 `pseq` (appl_415 `pseq` klCons appl_414 appl_415) + !appl_417 <- appl_412 `pseq` (appl_416 `pseq` klCons appl_412 appl_416) + !appl_418 <- appl_417 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "@p")) appl_417 + let !aw_419 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_410 `pseq` (appl_418 `pseq` applyWrapper aw_419 [appl_410, + appl_418]) + Atom (B (False)) -> do do let !aw_420 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_420 [] + _ -> throwError "if: expected boolean"))) + !appl_421 <- kl_Parse_shen_LBpattern1RB `pseq` kl_shen_LBpattern2RB kl_Parse_shen_LBpattern1RB + appl_421 `pseq` applyWrapper appl_398 [appl_421] + Atom (B (False)) -> do do let !aw_422 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_422 [] + _ -> throwError "if: expected boolean"))) + !appl_423 <- kl_V1237 `pseq` hd kl_V1237 + !appl_424 <- appl_423 `pseq` hd appl_423 + !appl_425 <- kl_V1237 `pseq` tl kl_V1237 + !appl_426 <- appl_425 `pseq` hd appl_425 + let !aw_427 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_428 <- appl_424 `pseq` (appl_426 `pseq` applyWrapper aw_427 [appl_424, + appl_426]) + !appl_429 <- appl_428 `pseq` hd appl_428 + !appl_430 <- appl_429 `pseq` tl appl_429 + !appl_431 <- kl_V1237 `pseq` hd kl_V1237 + !appl_432 <- appl_431 `pseq` hd appl_431 + !appl_433 <- kl_V1237 `pseq` tl kl_V1237 + !appl_434 <- appl_433 `pseq` hd appl_433 + let !aw_435 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_436 <- appl_432 `pseq` (appl_434 `pseq` applyWrapper aw_435 [appl_432, + appl_434]) + let !aw_437 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_438 <- appl_436 `pseq` applyWrapper aw_437 [appl_436] + let !aw_439 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_440 <- appl_430 `pseq` (appl_438 `pseq` applyWrapper aw_439 [appl_430, + appl_438]) + !appl_441 <- appl_440 `pseq` kl_shen_LBpattern1RB appl_440 + appl_441 `pseq` applyWrapper appl_392 [appl_441] + Atom (B (False)) -> do do let !aw_442 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_442 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_443 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_443 [] + _ -> throwError "if: expected boolean" + appl_373 `pseq` applyWrapper appl_0 [appl_373] + +kl_shen_constructor_error :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_constructor_error (!kl_V1239) = do let !aw_0 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_1 <- kl_V1239 `pseq` applyWrapper aw_0 [kl_V1239, + Core.Types.Atom (Core.Types.Str " is not a legitimate constructor\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + appl_1 `pseq` simpleError appl_1 + +kl_shen_LBsimple_patternRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBsimple_patternRB (!kl_V1241) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_V1241 `pseq` hd kl_V1241 + !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 let !appl_7 = Atom Nil + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "<-")) appl_7 + !appl_9 <- appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "->")) appl_8 + let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "element?") + !appl_11 <- kl_Parse_X `pseq` (appl_9 `pseq` applyWrapper aw_10 [kl_Parse_X, + appl_9]) + let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_13 <- appl_11 `pseq` applyWrapper aw_12 [appl_11] + case kl_if_13 of + Atom (B (True)) -> do !appl_14 <- kl_V1241 `pseq` hd kl_V1241 + !appl_15 <- appl_14 `pseq` tl appl_14 + let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_17 <- kl_V1241 `pseq` applyWrapper aw_16 [kl_V1241] + let !aw_18 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_19 <- appl_15 `pseq` (appl_17 `pseq` applyWrapper aw_18 [appl_15, + appl_17]) + !appl_20 <- appl_19 `pseq` hd appl_19 + let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_20 `pseq` (kl_Parse_X `pseq` applyWrapper aw_21 [appl_20, + kl_Parse_X]) + Atom (B (False)) -> do do let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_22 [] + _ -> throwError "if: expected boolean"))) + !appl_23 <- kl_V1241 `pseq` hd kl_V1241 + !appl_24 <- appl_23 `pseq` hd appl_23 + appl_24 `pseq` applyWrapper appl_6 [appl_24] + Atom (B (False)) -> do do let !aw_25 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_25 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + !appl_26 <- kl_V1241 `pseq` hd kl_V1241 + !kl_if_27 <- appl_26 `pseq` consP appl_26 + !appl_28 <- case kl_if_27 of + Atom (B (True)) -> do let !appl_29 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let pat_cond_30 = do !appl_31 <- kl_V1241 `pseq` hd kl_V1241 + !appl_32 <- appl_31 `pseq` tl appl_31 + let !aw_33 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_34 <- kl_V1241 `pseq` applyWrapper aw_33 [kl_V1241] + let !aw_35 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_36 <- appl_32 `pseq` (appl_34 `pseq` applyWrapper aw_35 [appl_32, + appl_34]) + !appl_37 <- appl_36 `pseq` hd appl_36 + let !aw_38 = Core.Types.Atom (Core.Types.UnboundSym "gensym") + !appl_39 <- applyWrapper aw_38 [Core.Types.Atom (Core.Types.UnboundSym "Parse_Y")] + let !aw_40 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_37 `pseq` (appl_39 `pseq` applyWrapper aw_40 [appl_37, + appl_39]) + pat_cond_41 = do do let !aw_42 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_42 [] + in case kl_Parse_X of + kl_Parse_X@(Atom (UnboundSym "_")) -> pat_cond_30 + kl_Parse_X@(ApplC (PL "_" + _)) -> pat_cond_30 + kl_Parse_X@(ApplC (Func "_" + _)) -> pat_cond_30 + _ -> pat_cond_41))) + !appl_43 <- kl_V1241 `pseq` hd kl_V1241 + !appl_44 <- appl_43 `pseq` hd appl_43 + appl_44 `pseq` applyWrapper appl_29 [appl_44] + Atom (B (False)) -> do do let !aw_45 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_45 [] + _ -> throwError "if: expected boolean" + appl_28 `pseq` applyWrapper appl_0 [appl_28] + +kl_shen_LBpattern1RB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBpattern1RB (!kl_V1243) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternRB) -> do let !aw_1 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_8 <- kl_Parse_shen_LBpatternRB `pseq` applyWrapper aw_7 [kl_Parse_shen_LBpatternRB] + let !aw_9 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_10 [] + _ -> throwError "if: expected boolean"))) + !appl_11 <- kl_V1243 `pseq` kl_shen_LBpatternRB kl_V1243 + appl_11 `pseq` applyWrapper appl_0 [appl_11] + +kl_shen_LBpattern2RB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBpattern2RB (!kl_V1245) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpatternRB) -> do let !aw_1 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_8 <- kl_Parse_shen_LBpatternRB `pseq` applyWrapper aw_7 [kl_Parse_shen_LBpatternRB] + let !aw_9 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_10 [] + _ -> throwError "if: expected boolean"))) + !appl_11 <- kl_V1245 `pseq` kl_shen_LBpatternRB kl_V1245 + appl_11 `pseq` applyWrapper appl_0 [appl_11] + +kl_shen_LBactionRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBactionRB (!kl_V1247) = do !appl_0 <- kl_V1247 `pseq` hd kl_V1247 + !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_V1247 `pseq` hd kl_V1247 + !appl_4 <- appl_3 `pseq` tl appl_3 + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_6 <- kl_V1247 `pseq` applyWrapper aw_5 [kl_V1247] + let !aw_7 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_9 `pseq` (kl_Parse_X `pseq` applyWrapper aw_10 [appl_9, + kl_Parse_X])))) + !appl_11 <- kl_V1247 `pseq` hd kl_V1247 + !appl_12 <- appl_11 `pseq` hd appl_11 + appl_12 `pseq` applyWrapper appl_2 [appl_12] + Atom (B (False)) -> do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_13 [] + _ -> throwError "if: expected boolean" + +kl_shen_LBguardRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBguardRB (!kl_V1249) = do !appl_0 <- kl_V1249 `pseq` hd kl_V1249 + !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_V1249 `pseq` hd kl_V1249 + !appl_4 <- appl_3 `pseq` tl appl_3 + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_6 <- kl_V1249 `pseq` applyWrapper aw_5 [kl_V1249] + let !aw_7 = Core.Types.Atom (Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_9 `pseq` (kl_Parse_X `pseq` applyWrapper aw_10 [appl_9, + kl_Parse_X])))) + !appl_11 <- kl_V1249 `pseq` hd kl_V1249 + !appl_12 <- appl_11 `pseq` hd appl_11 + appl_12 `pseq` applyWrapper appl_2 [appl_12] + Atom (B (False)) -> do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_13 [] + _ -> throwError "if: expected boolean" + +kl_shen_compile_to_machine_code :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_compile_to_machine_code (!kl_V1252) (!kl_V1253) = 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_V1252 `pseq` (kl_KL `pseq` kl_shen_record_source kl_V1252 kl_KL) + appl_3 `pseq` applyWrapper appl_2 [appl_3]))) + !appl_4 <- kl_V1252 `pseq` (kl_LambdaPlus `pseq` kl_shen_compile_to_kl kl_V1252 kl_LambdaPlus) + appl_4 `pseq` applyWrapper appl_1 [appl_4]))) + !appl_5 <- kl_V1252 `pseq` (kl_V1253 `pseq` kl_shen_compile_to_lambdaPlus kl_V1252 kl_V1253) + appl_5 `pseq` applyWrapper appl_0 [appl_5] + +kl_shen_record_source :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_record_source (!kl_V1258) (!kl_V1259) = do !kl_if_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*installing-kl*")) + case kl_if_0 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "put") + kl_V1258 `pseq` (kl_V1259 `pseq` (appl_1 `pseq` applyWrapper aw_2 [kl_V1258, + Core.Types.Atom (Core.Types.UnboundSym "shen.source"), + kl_V1259, + appl_1])) + _ -> throwError "if: expected boolean" + +kl_shen_compile_to_lambdaPlus :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_compile_to_lambdaPlus (!kl_V1262) (!kl_V1263) = 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 let !appl_7 = Atom Nil + !appl_8 <- kl_Applications `pseq` (appl_7 `pseq` klCons kl_Applications appl_7) + kl_Variables `pseq` (appl_8 `pseq` klCons kl_Variables appl_8)))) + let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_Variables `pseq` (kl_X `pseq` kl_shen_application_build kl_Variables kl_X)))) + let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "map") + !appl_11 <- appl_9 `pseq` (kl_Abstractions `pseq` applyWrapper aw_10 [appl_9, + kl_Abstractions]) + appl_11 `pseq` applyWrapper appl_6 [appl_11]))) + let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_abstract_rule kl_X))) + let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "map") + !appl_14 <- appl_12 `pseq` (kl_Strip `pseq` applyWrapper aw_13 [appl_12, + kl_Strip]) + appl_14 `pseq` applyWrapper appl_5 [appl_14]))) + let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_strip_protect kl_X))) + let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "map") + !appl_17 <- appl_15 `pseq` (kl_V1263 `pseq` applyWrapper aw_16 [appl_15, + kl_V1263]) + appl_17 `pseq` applyWrapper appl_4 [appl_17]))) + !appl_18 <- kl_Arity `pseq` kl_shen_parameters kl_Arity + appl_18 `pseq` applyWrapper appl_3 [appl_18]))) + let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Rule) -> do kl_V1262 `pseq` (kl_Rule `pseq` kl_shen_free_variable_check kl_V1262 kl_Rule)))) + let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "for-each") + !appl_21 <- appl_19 `pseq` (kl_V1263 `pseq` applyWrapper aw_20 [appl_19, + kl_V1263]) + appl_21 `pseq` applyWrapper appl_2 [appl_21]))) + !appl_22 <- kl_V1262 `pseq` (kl_Arity `pseq` kl_shen_update_symbol_table kl_V1262 kl_Arity) + appl_22 `pseq` applyWrapper appl_1 [appl_22]))) + !appl_23 <- kl_V1262 `pseq` (kl_V1263 `pseq` kl_shen_aritycheck kl_V1262 kl_V1263) + appl_23 `pseq` applyWrapper appl_0 [appl_23] + +kl_shen_update_symbol_table :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_update_symbol_table (!kl_V1266) (!kl_V1267) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + pat_cond_1 = do do let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.lambda-form") + !appl_3 <- kl_V1266 `pseq` (kl_V1267 `pseq` applyWrapper aw_2 [kl_V1266, + kl_V1267]) + !appl_4 <- appl_3 `pseq` evalKL appl_3 + !appl_5 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "put") + kl_V1266 `pseq` (appl_4 `pseq` (appl_5 `pseq` applyWrapper aw_6 [kl_V1266, + Core.Types.Atom (Core.Types.UnboundSym "shen.lambda-form"), + appl_4, + appl_5])) + in case kl_V1267 of + kl_V1267@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_free_variable_check :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_free_variable_check (!kl_V1270) (!kl_V1271) = do !kl_if_0 <- let pat_cond_1 kl_V1271 kl_V1271h kl_V1271t = do !kl_if_2 <- let pat_cond_3 kl_V1271t kl_V1271th kl_V1271tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V1271tt `pseq` eq appl_4 kl_V1271tt) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V1271t of + !(kl_V1271t@(Cons (!kl_V1271th) + (!kl_V1271tt))) -> pat_cond_3 kl_V1271t kl_V1271th kl_V1271tt + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V1271 of + !(kl_V1271@(Cons (!kl_V1271h) + (!kl_V1271t))) -> pat_cond_1 kl_V1271 kl_V1271h kl_V1271t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Bound) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Free) -> do kl_V1270 `pseq` (kl_Free `pseq` kl_shen_free_variable_warnings kl_V1270 kl_Free)))) + !appl_10 <- kl_V1271 `pseq` tl kl_V1271 + !appl_11 <- appl_10 `pseq` hd appl_10 + !appl_12 <- kl_Bound `pseq` (appl_11 `pseq` kl_shen_extract_free_vars kl_Bound appl_11) + appl_12 `pseq` applyWrapper appl_9 [appl_12]))) + !appl_13 <- kl_V1271 `pseq` hd kl_V1271 + !appl_14 <- appl_13 `pseq` kl_shen_extract_vars appl_13 + appl_14 `pseq` applyWrapper appl_8 [appl_14] + Atom (B (False)) -> do do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_15 [ApplC (wrapNamed "shen.free_variable_check" kl_shen_free_variable_check)] + _ -> throwError "if: expected boolean" + +kl_shen_extract_vars :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_extract_vars (!kl_V1273) = do let !aw_0 = Core.Types.Atom (Core.Types.UnboundSym "variable?") + !kl_if_1 <- kl_V1273 `pseq` applyWrapper aw_0 [kl_V1273] + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = Atom Nil + kl_V1273 `pseq` (appl_2 `pseq` klCons kl_V1273 appl_2) + Atom (B (False)) -> do let pat_cond_3 kl_V1273 kl_V1273h kl_V1273t = do !appl_4 <- kl_V1273h `pseq` kl_shen_extract_vars kl_V1273h + !appl_5 <- kl_V1273t `pseq` kl_shen_extract_vars kl_V1273t + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "union") + appl_4 `pseq` (appl_5 `pseq` applyWrapper aw_6 [appl_4, + appl_5]) + pat_cond_7 = do do return (Atom Nil) + in case kl_V1273 of + !(kl_V1273@(Cons (!kl_V1273h) + (!kl_V1273t))) -> pat_cond_3 kl_V1273 kl_V1273h kl_V1273t + _ -> pat_cond_7 + _ -> throwError "if: expected boolean" + +kl_shen_extract_free_vars :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_extract_free_vars (!kl_V1285) (!kl_V1286) = do !kl_if_0 <- let pat_cond_1 kl_V1286 kl_V1286h kl_V1286t = do !kl_if_2 <- let pat_cond_3 kl_V1286t kl_V1286th kl_V1286tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V1286tt `pseq` eq appl_4 kl_V1286tt) + !kl_if_6 <- case kl_if_5 of + Atom (B (True)) -> do let pat_cond_7 = do return (Atom (B True)) + pat_cond_8 = do do return (Atom (B False)) + in case kl_V1286h of + kl_V1286h@(Atom (UnboundSym "protect")) -> pat_cond_7 + kl_V1286h@(ApplC (PL "protect" + _)) -> pat_cond_7 + kl_V1286h@(ApplC (Func "protect" + _)) -> pat_cond_7 + _ -> pat_cond_8 + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + 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_9 = do do return (Atom (B False)) + in case kl_V1286t of + !(kl_V1286t@(Cons (!kl_V1286th) + (!kl_V1286tt))) -> pat_cond_3 kl_V1286t kl_V1286th kl_V1286tt + _ -> pat_cond_9 + 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_10 = do do return (Atom (B False)) + in case kl_V1286 of + !(kl_V1286@(Cons (!kl_V1286h) + (!kl_V1286t))) -> pat_cond_1 kl_V1286 kl_V1286h kl_V1286t + _ -> pat_cond_10 + case kl_if_0 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "variable?") + !kl_if_12 <- kl_V1286 `pseq` applyWrapper aw_11 [kl_V1286] + !kl_if_13 <- case kl_if_12 of + Atom (B (True)) -> do let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "element?") + !appl_15 <- kl_V1286 `pseq` (kl_V1285 `pseq` applyWrapper aw_14 [kl_V1286, + kl_V1285]) + let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_17 <- appl_15 `pseq` applyWrapper aw_16 [appl_15] + 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_13 of + Atom (B (True)) -> do let !appl_18 = Atom Nil + kl_V1286 `pseq` (appl_18 `pseq` klCons kl_V1286 appl_18) + Atom (B (False)) -> do !kl_if_19 <- let pat_cond_20 kl_V1286 kl_V1286h kl_V1286t = do !kl_if_21 <- let pat_cond_22 = do !kl_if_23 <- let pat_cond_24 kl_V1286t kl_V1286th kl_V1286tt = do !kl_if_25 <- let pat_cond_26 kl_V1286tt kl_V1286tth kl_V1286ttt = do let !appl_27 = Atom Nil + !kl_if_28 <- appl_27 `pseq` (kl_V1286ttt `pseq` eq appl_27 kl_V1286ttt) + case kl_if_28 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_29 = do do return (Atom (B False)) + in case kl_V1286tt of + !(kl_V1286tt@(Cons (!kl_V1286tth) + (!kl_V1286ttt))) -> pat_cond_26 kl_V1286tt kl_V1286tth kl_V1286ttt + _ -> pat_cond_29 + 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_30 = do do return (Atom (B False)) + in case kl_V1286t of + !(kl_V1286t@(Cons (!kl_V1286th) + (!kl_V1286tt))) -> pat_cond_24 kl_V1286t kl_V1286th kl_V1286tt + _ -> pat_cond_30 + 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_31 = do do return (Atom (B False)) + in case kl_V1286h of + kl_V1286h@(Atom (UnboundSym "lambda")) -> pat_cond_22 + kl_V1286h@(ApplC (PL "lambda" + _)) -> pat_cond_22 + kl_V1286h@(ApplC (Func "lambda" + _)) -> pat_cond_22 + _ -> pat_cond_31 + 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_32 = do do return (Atom (B False)) + in case kl_V1286 of + !(kl_V1286@(Cons (!kl_V1286h) + (!kl_V1286t))) -> pat_cond_20 kl_V1286 kl_V1286h kl_V1286t + _ -> pat_cond_32 + case kl_if_19 of + Atom (B (True)) -> do !appl_33 <- kl_V1286 `pseq` tl kl_V1286 + !appl_34 <- appl_33 `pseq` hd appl_33 + !appl_35 <- appl_34 `pseq` (kl_V1285 `pseq` klCons appl_34 kl_V1285) + !appl_36 <- kl_V1286 `pseq` tl kl_V1286 + !appl_37 <- appl_36 `pseq` tl appl_36 + !appl_38 <- appl_37 `pseq` hd appl_37 + appl_35 `pseq` (appl_38 `pseq` kl_shen_extract_free_vars appl_35 appl_38) + Atom (B (False)) -> do !kl_if_39 <- let pat_cond_40 kl_V1286 kl_V1286h kl_V1286t = do !kl_if_41 <- let pat_cond_42 = do !kl_if_43 <- let pat_cond_44 kl_V1286t kl_V1286th kl_V1286tt = do !kl_if_45 <- let pat_cond_46 kl_V1286tt kl_V1286tth kl_V1286ttt = do !kl_if_47 <- let pat_cond_48 kl_V1286ttt kl_V1286ttth kl_V1286tttt = do let !appl_49 = Atom Nil + !kl_if_50 <- appl_49 `pseq` (kl_V1286tttt `pseq` eq appl_49 kl_V1286tttt) + case kl_if_50 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_51 = do do return (Atom (B False)) + in case kl_V1286ttt of + !(kl_V1286ttt@(Cons (!kl_V1286ttth) + (!kl_V1286tttt))) -> pat_cond_48 kl_V1286ttt kl_V1286ttth kl_V1286tttt + _ -> pat_cond_51 + case kl_if_47 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_52 = do do return (Atom (B False)) + in case kl_V1286tt of + !(kl_V1286tt@(Cons (!kl_V1286tth) + (!kl_V1286ttt))) -> pat_cond_46 kl_V1286tt kl_V1286tth kl_V1286ttt + _ -> pat_cond_52 + case kl_if_45 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_53 = do do return (Atom (B False)) + in case kl_V1286t of + !(kl_V1286t@(Cons (!kl_V1286th) + (!kl_V1286tt))) -> pat_cond_44 kl_V1286t kl_V1286th kl_V1286tt + _ -> pat_cond_53 + case kl_if_43 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_54 = do do return (Atom (B False)) + in case kl_V1286h of + kl_V1286h@(Atom (UnboundSym "let")) -> pat_cond_42 + kl_V1286h@(ApplC (PL "let" + _)) -> pat_cond_42 + kl_V1286h@(ApplC (Func "let" + _)) -> pat_cond_42 + _ -> pat_cond_54 + case kl_if_41 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_55 = do do return (Atom (B False)) + in case kl_V1286 of + !(kl_V1286@(Cons (!kl_V1286h) + (!kl_V1286t))) -> pat_cond_40 kl_V1286 kl_V1286h kl_V1286t + _ -> pat_cond_55 + case kl_if_39 of + Atom (B (True)) -> do !appl_56 <- kl_V1286 `pseq` tl kl_V1286 + !appl_57 <- appl_56 `pseq` tl appl_56 + !appl_58 <- appl_57 `pseq` hd appl_57 + !appl_59 <- kl_V1285 `pseq` (appl_58 `pseq` kl_shen_extract_free_vars kl_V1285 appl_58) + !appl_60 <- kl_V1286 `pseq` tl kl_V1286 + !appl_61 <- appl_60 `pseq` hd appl_60 + !appl_62 <- appl_61 `pseq` (kl_V1285 `pseq` klCons appl_61 kl_V1285) + !appl_63 <- kl_V1286 `pseq` tl kl_V1286 + !appl_64 <- appl_63 `pseq` tl appl_63 + !appl_65 <- appl_64 `pseq` tl appl_64 + !appl_66 <- appl_65 `pseq` hd appl_65 + !appl_67 <- appl_62 `pseq` (appl_66 `pseq` kl_shen_extract_free_vars appl_62 appl_66) + let !aw_68 = Core.Types.Atom (Core.Types.UnboundSym "union") + appl_59 `pseq` (appl_67 `pseq` applyWrapper aw_68 [appl_59, + appl_67]) + Atom (B (False)) -> do let pat_cond_69 kl_V1286 kl_V1286h kl_V1286t = do !appl_70 <- kl_V1285 `pseq` (kl_V1286h `pseq` kl_shen_extract_free_vars kl_V1285 kl_V1286h) + !appl_71 <- kl_V1285 `pseq` (kl_V1286t `pseq` kl_shen_extract_free_vars kl_V1285 kl_V1286t) + let !aw_72 = Core.Types.Atom (Core.Types.UnboundSym "union") + appl_70 `pseq` (appl_71 `pseq` applyWrapper aw_72 [appl_70, + appl_71]) + pat_cond_73 = do do return (Atom Nil) + in case kl_V1286 of + !(kl_V1286@(Cons (!kl_V1286h) + (!kl_V1286t))) -> pat_cond_69 kl_V1286 kl_V1286h kl_V1286t + _ -> pat_cond_73 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_free_variable_warnings :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_free_variable_warnings (!kl_V1291) (!kl_V1292) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1292 `pseq` eq appl_0 kl_V1292) + case kl_if_1 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "_")) + Atom (B (False)) -> do do !appl_2 <- kl_V1292 `pseq` kl_shen_list_variables kl_V1292 + let !aw_3 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_4 <- appl_2 `pseq` applyWrapper aw_3 [appl_2, + Core.Types.Atom (Core.Types.Str ""), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_5 <- appl_4 `pseq` cn (Core.Types.Atom (Core.Types.Str ": ")) appl_4 + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_7 <- kl_V1291 `pseq` (appl_5 `pseq` applyWrapper aw_6 [kl_V1291, + appl_5, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_8 <- appl_7 `pseq` cn (Core.Types.Atom (Core.Types.Str "error: the following variables are free in ")) appl_7 + appl_8 `pseq` simpleError appl_8 + _ -> throwError "if: expected boolean" + +kl_shen_list_variables :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_list_variables (!kl_V1294) = do !kl_if_0 <- let pat_cond_1 kl_V1294 kl_V1294h kl_V1294t = do let !appl_2 = Atom Nil + !kl_if_3 <- appl_2 `pseq` (kl_V1294t `pseq` eq appl_2 kl_V1294t) + case kl_if_3 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_4 = do do return (Atom (B False)) + in case kl_V1294 of + !(kl_V1294@(Cons (!kl_V1294h) + (!kl_V1294t))) -> pat_cond_1 kl_V1294 kl_V1294h kl_V1294t + _ -> pat_cond_4 + case kl_if_0 of + Atom (B (True)) -> do !appl_5 <- kl_V1294 `pseq` hd kl_V1294 + !appl_6 <- appl_5 `pseq` str appl_5 + appl_6 `pseq` cn appl_6 (Core.Types.Atom (Core.Types.Str ".")) + Atom (B (False)) -> do let pat_cond_7 kl_V1294 kl_V1294h kl_V1294t = do !appl_8 <- kl_V1294h `pseq` str kl_V1294h + !appl_9 <- kl_V1294t `pseq` kl_shen_list_variables kl_V1294t + !appl_10 <- appl_9 `pseq` cn (Core.Types.Atom (Core.Types.Str ", ")) appl_9 + appl_8 `pseq` (appl_10 `pseq` cn appl_8 appl_10) + pat_cond_11 = do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_12 [ApplC (wrapNamed "shen.list_variables" kl_shen_list_variables)] + in case kl_V1294 of + !(kl_V1294@(Cons (!kl_V1294h) + (!kl_V1294t))) -> pat_cond_7 kl_V1294 kl_V1294h kl_V1294t + _ -> pat_cond_11 + _ -> throwError "if: expected boolean" + +kl_shen_strip_protect :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_strip_protect (!kl_V1296) = do !kl_if_0 <- let pat_cond_1 kl_V1296 kl_V1296h kl_V1296t = do !kl_if_2 <- let pat_cond_3 kl_V1296t kl_V1296th kl_V1296tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V1296tt `pseq` eq appl_4 kl_V1296tt) + !kl_if_6 <- case kl_if_5 of + Atom (B (True)) -> do let pat_cond_7 = do return (Atom (B True)) + pat_cond_8 = do do return (Atom (B False)) + in case kl_V1296h of + kl_V1296h@(Atom (UnboundSym "protect")) -> pat_cond_7 + kl_V1296h@(ApplC (PL "protect" + _)) -> pat_cond_7 + kl_V1296h@(ApplC (Func "protect" + _)) -> pat_cond_7 + _ -> pat_cond_8 + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + 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_9 = do do return (Atom (B False)) + in case kl_V1296t of + !(kl_V1296t@(Cons (!kl_V1296th) + (!kl_V1296tt))) -> pat_cond_3 kl_V1296t kl_V1296th kl_V1296tt + _ -> pat_cond_9 + 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_10 = do do return (Atom (B False)) + in case kl_V1296 of + !(kl_V1296@(Cons (!kl_V1296h) + (!kl_V1296t))) -> pat_cond_1 kl_V1296 kl_V1296h kl_V1296t + _ -> pat_cond_10 + case kl_if_0 of + Atom (B (True)) -> do !appl_11 <- kl_V1296 `pseq` tl kl_V1296 + !appl_12 <- appl_11 `pseq` hd appl_11 + appl_12 `pseq` kl_shen_strip_protect appl_12 + Atom (B (False)) -> do let pat_cond_13 kl_V1296 kl_V1296h kl_V1296t = do let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_strip_protect kl_Z))) + let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "map") + appl_14 `pseq` (kl_V1296 `pseq` applyWrapper aw_15 [appl_14, + kl_V1296]) + pat_cond_16 = do do return kl_V1296 + in case kl_V1296 of + !(kl_V1296@(Cons (!kl_V1296h) + (!kl_V1296t))) -> pat_cond_13 kl_V1296 kl_V1296h kl_V1296t + _ -> pat_cond_16 + _ -> throwError "if: expected boolean" + +kl_shen_linearise :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_linearise (!kl_V1298) = do !kl_if_0 <- let pat_cond_1 kl_V1298 kl_V1298h kl_V1298t = do !kl_if_2 <- let pat_cond_3 kl_V1298t kl_V1298th kl_V1298tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V1298tt `pseq` eq appl_4 kl_V1298tt) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V1298t of + !(kl_V1298t@(Cons (!kl_V1298th) + (!kl_V1298tt))) -> pat_cond_3 kl_V1298t kl_V1298th kl_V1298tt + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V1298 of + !(kl_V1298@(Cons (!kl_V1298h) + (!kl_V1298t))) -> pat_cond_1 kl_V1298 kl_V1298h kl_V1298t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do !appl_8 <- kl_V1298 `pseq` hd kl_V1298 + !appl_9 <- appl_8 `pseq` kl_shen_flatten appl_8 + !appl_10 <- kl_V1298 `pseq` hd kl_V1298 + !appl_11 <- kl_V1298 `pseq` tl kl_V1298 + !appl_12 <- appl_11 `pseq` hd appl_11 + appl_9 `pseq` (appl_10 `pseq` (appl_12 `pseq` kl_shen_linearise_help appl_9 appl_10 appl_12)) + Atom (B (False)) -> do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_13 [ApplC (wrapNamed "shen.linearise" kl_shen_linearise)] + _ -> throwError "if: expected boolean" + +kl_shen_flatten :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_flatten (!kl_V1300) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1300 `pseq` eq appl_0 kl_V1300) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let pat_cond_2 kl_V1300 kl_V1300h kl_V1300t = do !appl_3 <- kl_V1300h `pseq` kl_shen_flatten kl_V1300h + !appl_4 <- kl_V1300t `pseq` kl_shen_flatten kl_V1300t + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "append") + appl_3 `pseq` (appl_4 `pseq` applyWrapper aw_5 [appl_3, + appl_4]) + pat_cond_6 = do do let !appl_7 = Atom Nil + kl_V1300 `pseq` (appl_7 `pseq` klCons kl_V1300 appl_7) + in case kl_V1300 of + !(kl_V1300@(Cons (!kl_V1300h) + (!kl_V1300t))) -> pat_cond_2 kl_V1300 kl_V1300h kl_V1300t + _ -> pat_cond_6 + _ -> throwError "if: expected boolean" + +kl_shen_linearise_help :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_linearise_help (!kl_V1304) (!kl_V1305) (!kl_V1306) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1304 `pseq` eq appl_0 kl_V1304) + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = Atom Nil + !appl_3 <- kl_V1306 `pseq` (appl_2 `pseq` klCons kl_V1306 appl_2) + kl_V1305 `pseq` (appl_3 `pseq` klCons kl_V1305 appl_3) + Atom (B (False)) -> do let pat_cond_4 kl_V1304 kl_V1304h kl_V1304t = do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "variable?") + !kl_if_6 <- kl_V1304h `pseq` applyWrapper aw_5 [kl_V1304h] + !kl_if_7 <- case kl_if_6 of + Atom (B (True)) -> do let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "element?") + !kl_if_9 <- kl_V1304h `pseq` (kl_V1304t `pseq` applyWrapper aw_8 [kl_V1304h, + kl_V1304t]) + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_7 of + Atom (B (True)) -> do let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Var) -> do let !appl_11 = ApplC (Func "lambda" (Context (\(!kl_NewAction) -> do let !appl_12 = 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_13 <- kl_V1304h `pseq` (kl_Var `pseq` (kl_V1305 `pseq` kl_shen_linearise_X kl_V1304h kl_Var kl_V1305)) + appl_13 `pseq` applyWrapper appl_12 [appl_13]))) + let !appl_14 = Atom Nil + !appl_15 <- kl_Var `pseq` (appl_14 `pseq` klCons kl_Var appl_14) + !appl_16 <- kl_V1304h `pseq` (appl_15 `pseq` klCons kl_V1304h appl_15) + !appl_17 <- appl_16 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_16 + let !appl_18 = Atom Nil + !appl_19 <- kl_V1306 `pseq` (appl_18 `pseq` klCons kl_V1306 appl_18) + !appl_20 <- appl_17 `pseq` (appl_19 `pseq` klCons appl_17 appl_19) + !appl_21 <- appl_20 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "where")) appl_20 + appl_21 `pseq` applyWrapper appl_11 [appl_21]))) + let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "gensym") + !appl_23 <- kl_V1304h `pseq` applyWrapper aw_22 [kl_V1304h] + appl_23 `pseq` applyWrapper appl_10 [appl_23] + 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_24 = do do let !aw_25 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_25 [ApplC (wrapNamed "shen.linearise_help" kl_shen_linearise_help)] + in case kl_V1304 of + !(kl_V1304@(Cons (!kl_V1304h) + (!kl_V1304t))) -> pat_cond_4 kl_V1304 kl_V1304h kl_V1304t + _ -> pat_cond_24 + _ -> throwError "if: expected boolean" + +kl_shen_linearise_X :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.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 :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_aritycheck (!kl_V1324) (!kl_V1325) = do !kl_if_0 <- let pat_cond_1 kl_V1325 kl_V1325h kl_V1325t = do !kl_if_2 <- let pat_cond_3 kl_V1325h kl_V1325hh kl_V1325ht = do !kl_if_4 <- let pat_cond_5 kl_V1325ht kl_V1325hth kl_V1325htt = do let !appl_6 = Atom Nil + !kl_if_7 <- appl_6 `pseq` (kl_V1325htt `pseq` eq appl_6 kl_V1325htt) + !kl_if_8 <- case kl_if_7 of + Atom (B (True)) -> do let !appl_9 = Atom Nil + !kl_if_10 <- appl_9 `pseq` (kl_V1325t `pseq` eq appl_9 kl_V1325t) + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_8 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_11 = do do return (Atom (B False)) + in case kl_V1325ht of + !(kl_V1325ht@(Cons (!kl_V1325hth) + (!kl_V1325htt))) -> pat_cond_5 kl_V1325ht kl_V1325hth kl_V1325htt + _ -> pat_cond_11 + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V1325h of + !(kl_V1325h@(Cons (!kl_V1325hh) + (!kl_V1325ht))) -> pat_cond_3 kl_V1325h kl_V1325hh kl_V1325ht + _ -> pat_cond_12 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_13 = do do return (Atom (B False)) + in case kl_V1325 of + !(kl_V1325@(Cons (!kl_V1325h) + (!kl_V1325t))) -> pat_cond_1 kl_V1325 kl_V1325h kl_V1325t + _ -> pat_cond_13 + case kl_if_0 of + Atom (B (True)) -> do !appl_14 <- kl_V1325 `pseq` hd kl_V1325 + !appl_15 <- appl_14 `pseq` tl appl_14 + !appl_16 <- appl_15 `pseq` hd appl_15 + !appl_17 <- appl_16 `pseq` kl_shen_aritycheck_action appl_16 + let !aw_18 = Core.Types.Atom (Core.Types.UnboundSym "arity") + !appl_19 <- kl_V1324 `pseq` applyWrapper aw_18 [kl_V1324] + !appl_20 <- kl_V1325 `pseq` hd kl_V1325 + !appl_21 <- appl_20 `pseq` hd appl_20 + let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "length") + !appl_23 <- appl_21 `pseq` applyWrapper aw_22 [appl_21] + !appl_24 <- kl_V1324 `pseq` (appl_19 `pseq` (appl_23 `pseq` kl_shen_aritycheck_name kl_V1324 appl_19 appl_23)) + let !aw_25 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_17 `pseq` (appl_24 `pseq` applyWrapper aw_25 [appl_17, + appl_24]) + Atom (B (False)) -> do !kl_if_26 <- let pat_cond_27 kl_V1325 kl_V1325h kl_V1325t = do !kl_if_28 <- let pat_cond_29 kl_V1325h kl_V1325hh kl_V1325ht = do !kl_if_30 <- let pat_cond_31 kl_V1325ht kl_V1325hth kl_V1325htt = do let !appl_32 = Atom Nil + !kl_if_33 <- appl_32 `pseq` (kl_V1325htt `pseq` eq appl_32 kl_V1325htt) + !kl_if_34 <- case kl_if_33 of + Atom (B (True)) -> do !kl_if_35 <- let pat_cond_36 kl_V1325t kl_V1325th kl_V1325tt = do !kl_if_37 <- let pat_cond_38 kl_V1325th kl_V1325thh kl_V1325tht = do !kl_if_39 <- let pat_cond_40 kl_V1325tht kl_V1325thth kl_V1325thtt = do let !appl_41 = Atom Nil + !kl_if_42 <- appl_41 `pseq` (kl_V1325thtt `pseq` eq appl_41 kl_V1325thtt) + case kl_if_42 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_43 = do do return (Atom (B False)) + in case kl_V1325tht of + !(kl_V1325tht@(Cons (!kl_V1325thth) + (!kl_V1325thtt))) -> pat_cond_40 kl_V1325tht kl_V1325thth kl_V1325thtt + _ -> pat_cond_43 + case kl_if_39 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_44 = do do return (Atom (B False)) + in case kl_V1325th of + !(kl_V1325th@(Cons (!kl_V1325thh) + (!kl_V1325tht))) -> pat_cond_38 kl_V1325th kl_V1325thh kl_V1325tht + _ -> pat_cond_44 + case kl_if_37 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_45 = do do return (Atom (B False)) + in case kl_V1325t of + !(kl_V1325t@(Cons (!kl_V1325th) + (!kl_V1325tt))) -> pat_cond_36 kl_V1325t kl_V1325th kl_V1325tt + _ -> pat_cond_45 + case kl_if_35 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_34 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_46 = do do return (Atom (B False)) + in case kl_V1325ht of + !(kl_V1325ht@(Cons (!kl_V1325hth) + (!kl_V1325htt))) -> pat_cond_31 kl_V1325ht kl_V1325hth kl_V1325htt + _ -> pat_cond_46 + case kl_if_30 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_47 = do do return (Atom (B False)) + in case kl_V1325h of + !(kl_V1325h@(Cons (!kl_V1325hh) + (!kl_V1325ht))) -> pat_cond_29 kl_V1325h kl_V1325hh kl_V1325ht + _ -> pat_cond_47 + case kl_if_28 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_48 = do do return (Atom (B False)) + in case kl_V1325 of + !(kl_V1325@(Cons (!kl_V1325h) + (!kl_V1325t))) -> pat_cond_27 kl_V1325 kl_V1325h kl_V1325t + _ -> pat_cond_48 + case kl_if_26 of + Atom (B (True)) -> do !appl_49 <- kl_V1325 `pseq` hd kl_V1325 + !appl_50 <- appl_49 `pseq` hd appl_49 + let !aw_51 = Core.Types.Atom (Core.Types.UnboundSym "length") + !appl_52 <- appl_50 `pseq` applyWrapper aw_51 [appl_50] + !appl_53 <- kl_V1325 `pseq` tl kl_V1325 + !appl_54 <- appl_53 `pseq` hd appl_53 + !appl_55 <- appl_54 `pseq` hd appl_54 + let !aw_56 = Core.Types.Atom (Core.Types.UnboundSym "length") + !appl_57 <- appl_55 `pseq` applyWrapper aw_56 [appl_55] + !kl_if_58 <- appl_52 `pseq` (appl_57 `pseq` eq appl_52 appl_57) + case kl_if_58 of + Atom (B (True)) -> do !appl_59 <- kl_V1325 `pseq` hd kl_V1325 + !appl_60 <- appl_59 `pseq` tl appl_59 + !appl_61 <- appl_60 `pseq` hd appl_60 + !appl_62 <- appl_61 `pseq` kl_shen_aritycheck_action appl_61 + !appl_63 <- kl_V1325 `pseq` tl kl_V1325 + !appl_64 <- kl_V1324 `pseq` (appl_63 `pseq` kl_shen_aritycheck kl_V1324 appl_63) + let !aw_65 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_62 `pseq` (appl_64 `pseq` applyWrapper aw_65 [appl_62, + appl_64]) + Atom (B (False)) -> do do let !aw_66 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_67 <- kl_V1324 `pseq` applyWrapper aw_66 [kl_V1324, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_68 <- appl_67 `pseq` cn (Core.Types.Atom (Core.Types.Str "arity error in ")) appl_67 + appl_68 `pseq` simpleError appl_68 + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_69 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_69 [ApplC (wrapNamed "shen.aritycheck" kl_shen_aritycheck)] + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_aritycheck_name :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.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 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_4 <- kl_V1338 `pseq` applyWrapper aw_3 [kl_V1338, + Core.Types.Atom (Core.Types.Str " can cause errors.\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_5 <- appl_4 `pseq` cn (Core.Types.Atom (Core.Types.Str "\nwarning: changing the arity of ")) appl_4 + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_7 <- applyWrapper aw_6 [] + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, + appl_7]) + let !aw_10 = Core.Types.Atom (Core.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 :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.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 = Core.Types.Atom (Core.Types.UnboundSym "for-each") + !appl_4 <- appl_2 `pseq` (kl_V1346 `pseq` applyWrapper aw_3 [appl_2, + kl_V1346]) + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_1 `pseq` (appl_4 `pseq` applyWrapper aw_5 [appl_1, + appl_4]) + pat_cond_6 = do do return (Core.Types.Atom (Core.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 :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.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 (Core.Types.Atom (Core.Types.N (Core.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 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_6 <- case kl_if_5 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.Str "s")) + Atom (B (False)) -> do do return (Core.Types.Atom (Core.Types.Str "")) + _ -> throwError "if: expected boolean" + let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_8 <- appl_6 `pseq` applyWrapper aw_7 [appl_6, + Core.Types.Atom (Core.Types.Str ".\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_9 <- appl_8 `pseq` cn (Core.Types.Atom (Core.Types.Str " argument")) appl_8 + let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_11 <- kl_Len `pseq` (appl_9 `pseq` applyWrapper aw_10 [kl_Len, + appl_9, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_12 <- appl_11 `pseq` cn (Core.Types.Atom (Core.Types.Str " might not like ")) appl_11 + let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_14 <- kl_V1349 `pseq` (appl_12 `pseq` applyWrapper aw_13 [kl_V1349, + appl_12, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_15 <- appl_14 `pseq` cn (Core.Types.Atom (Core.Types.Str "warning: ")) appl_14 + let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_17 <- applyWrapper aw_16 [] + let !aw_18 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + appl_15 `pseq` (appl_17 `pseq` applyWrapper aw_18 [appl_15, + appl_17]) + Atom (B (False)) -> do do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + _ -> throwError "if: expected boolean"))) + let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "length") + !appl_20 <- kl_V1350 `pseq` applyWrapper aw_19 [kl_V1350] + appl_20 `pseq` applyWrapper appl_1 [appl_20]))) + let !aw_21 = Core.Types.Atom (Core.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 :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_abstract_rule (!kl_V1352) = do !kl_if_0 <- let pat_cond_1 kl_V1352 kl_V1352h kl_V1352t = do !kl_if_2 <- let pat_cond_3 kl_V1352t kl_V1352th kl_V1352tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V1352tt `pseq` eq appl_4 kl_V1352tt) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V1352t of + !(kl_V1352t@(Cons (!kl_V1352th) + (!kl_V1352tt))) -> pat_cond_3 kl_V1352t kl_V1352th kl_V1352tt + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V1352 of + !(kl_V1352@(Cons (!kl_V1352h) + (!kl_V1352t))) -> pat_cond_1 kl_V1352 kl_V1352h kl_V1352t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do !appl_8 <- kl_V1352 `pseq` hd kl_V1352 + !appl_9 <- kl_V1352 `pseq` tl kl_V1352 + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_8 `pseq` (appl_10 `pseq` kl_shen_abstraction_build appl_8 appl_10) + Atom (B (False)) -> do do let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_11 [ApplC (wrapNamed "shen.abstract_rule" kl_shen_abstract_rule)] + _ -> throwError "if: expected boolean" + +kl_shen_abstraction_build :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_abstraction_build (!kl_V1355) (!kl_V1356) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1355 `pseq` eq appl_0 kl_V1355) + case kl_if_1 of + Atom (B (True)) -> do return kl_V1356 + Atom (B (False)) -> do let pat_cond_2 kl_V1355 kl_V1355h kl_V1355t = do !appl_3 <- kl_V1355t `pseq` (kl_V1356 `pseq` kl_shen_abstraction_build kl_V1355t kl_V1356) + let !appl_4 = Atom Nil + !appl_5 <- appl_3 `pseq` (appl_4 `pseq` klCons appl_3 appl_4) + !appl_6 <- kl_V1355h `pseq` (appl_5 `pseq` klCons kl_V1355h appl_5) + appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_6 + pat_cond_7 = do do let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_8 [ApplC (wrapNamed "shen.abstraction_build" kl_shen_abstraction_build)] + in case kl_V1355 of + !(kl_V1355@(Cons (!kl_V1355h) + (!kl_V1355t))) -> pat_cond_2 kl_V1355 kl_V1355h kl_V1355t + _ -> pat_cond_7 + _ -> throwError "if: expected boolean" + +kl_shen_parameters :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_parameters (!kl_V1358) = do let pat_cond_0 = do return (Atom Nil) + pat_cond_1 = do do let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "gensym") + !appl_3 <- applyWrapper aw_2 [Core.Types.Atom (Core.Types.UnboundSym "V")] + !appl_4 <- kl_V1358 `pseq` Primitives.subtract kl_V1358 (Core.Types.Atom (Core.Types.N (Core.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 :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_application_build (!kl_V1361) (!kl_V1362) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1361 `pseq` eq appl_0 kl_V1361) + case kl_if_1 of + Atom (B (True)) -> do return kl_V1362 + Atom (B (False)) -> do let pat_cond_2 kl_V1361 kl_V1361h kl_V1361t = do let !appl_3 = Atom Nil + !appl_4 <- kl_V1361h `pseq` (appl_3 `pseq` klCons kl_V1361h appl_3) + !appl_5 <- kl_V1362 `pseq` (appl_4 `pseq` klCons kl_V1362 appl_4) + kl_V1361t `pseq` (appl_5 `pseq` kl_shen_application_build kl_V1361t appl_5) + pat_cond_6 = do do let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_7 [ApplC (wrapNamed "shen.application_build" kl_shen_application_build)] + in case kl_V1361 of + !(kl_V1361@(Cons (!kl_V1361h) + (!kl_V1361t))) -> pat_cond_2 kl_V1361 kl_V1361h kl_V1361t + _ -> pat_cond_6 + _ -> throwError "if: expected boolean" + +kl_shen_compile_to_kl :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_compile_to_kl (!kl_V1365) (!kl_V1366) = do !kl_if_0 <- let pat_cond_1 kl_V1366 kl_V1366h kl_V1366t = do !kl_if_2 <- let pat_cond_3 kl_V1366t kl_V1366th kl_V1366tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V1366tt `pseq` eq appl_4 kl_V1366tt) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V1366t of + !(kl_V1366t@(Cons (!kl_V1366th) + (!kl_V1366tt))) -> pat_cond_3 kl_V1366t kl_V1366th kl_V1366tt + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V1366 of + !(kl_V1366@(Cons (!kl_V1366h) + (!kl_V1366t))) -> pat_cond_1 kl_V1366 kl_V1366h kl_V1366t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Arity) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Reduce) -> do let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_CondExpression) -> do let !appl_11 = ApplC (Func "lambda" (Context (\(!kl_TypeTable) -> do let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_TypedCondExpression) -> do !appl_13 <- kl_V1366 `pseq` hd kl_V1366 + let !appl_14 = Atom Nil + !appl_15 <- kl_TypedCondExpression `pseq` (appl_14 `pseq` klCons kl_TypedCondExpression appl_14) + !appl_16 <- appl_13 `pseq` (appl_15 `pseq` klCons appl_13 appl_15) + !appl_17 <- kl_V1365 `pseq` (appl_16 `pseq` klCons kl_V1365 appl_16) + appl_17 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defun")) appl_17))) + !kl_if_18 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*optimise*")) + !appl_19 <- case kl_if_18 of + Atom (B (True)) -> do !appl_20 <- kl_V1366 `pseq` hd kl_V1366 + appl_20 `pseq` (kl_TypeTable `pseq` (kl_CondExpression `pseq` kl_shen_assign_types appl_20 kl_TypeTable kl_CondExpression)) + Atom (B (False)) -> do do return kl_CondExpression + _ -> throwError "if: expected boolean" + appl_19 `pseq` applyWrapper appl_12 [appl_19]))) + !kl_if_21 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*optimise*")) + !appl_22 <- case kl_if_21 of + Atom (B (True)) -> do !appl_23 <- kl_V1365 `pseq` kl_shen_get_type kl_V1365 + !appl_24 <- kl_V1366 `pseq` hd kl_V1366 + appl_23 `pseq` (appl_24 `pseq` kl_shen_typextable appl_23 appl_24) + Atom (B (False)) -> do do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + _ -> throwError "if: expected boolean" + appl_22 `pseq` applyWrapper appl_11 [appl_22]))) + !appl_25 <- kl_V1366 `pseq` hd kl_V1366 + !appl_26 <- kl_V1365 `pseq` (appl_25 `pseq` (kl_Reduce `pseq` kl_shen_cond_expression kl_V1365 appl_25 kl_Reduce)) + appl_26 `pseq` applyWrapper appl_10 [appl_26]))) + let !appl_27 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_reduce kl_X))) + !appl_28 <- kl_V1366 `pseq` tl kl_V1366 + !appl_29 <- appl_28 `pseq` hd appl_28 + let !aw_30 = Core.Types.Atom (Core.Types.UnboundSym "map") + !appl_31 <- appl_27 `pseq` (appl_29 `pseq` applyWrapper aw_30 [appl_27, + appl_29]) + appl_31 `pseq` applyWrapper appl_9 [appl_31]))) + !appl_32 <- kl_V1366 `pseq` hd kl_V1366 + let !aw_33 = Core.Types.Atom (Core.Types.UnboundSym "length") + !appl_34 <- appl_32 `pseq` applyWrapper aw_33 [appl_32] + !appl_35 <- kl_V1365 `pseq` (appl_34 `pseq` kl_shen_store_arity kl_V1365 appl_34) + appl_35 `pseq` applyWrapper appl_8 [appl_35] + Atom (B (False)) -> do do let !aw_36 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_36 [ApplC (wrapNamed "shen.compile_to_kl" kl_shen_compile_to_kl)] + _ -> throwError "if: expected boolean" + +kl_shen_get_type :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_get_type (!kl_V1372) = do let pat_cond_0 kl_V1372 kl_V1372h kl_V1372t = do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_FType) -> do let !aw_3 = Core.Types.Atom (Core.Types.UnboundSym "empty?") + !kl_if_4 <- kl_FType `pseq` applyWrapper aw_3 [kl_FType] + case kl_if_4 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_FType `pseq` tl kl_FType + _ -> throwError "if: expected boolean"))) + !appl_5 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*signedfuncs*")) + let !aw_6 = Core.Types.Atom (Core.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 :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.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 let !appl_8 = Atom Nil + !kl_if_9 <- appl_8 `pseq` (kl_V1383ttt `pseq` eq appl_8 kl_V1383ttt) + !kl_if_10 <- case kl_if_9 of + Atom (B (True)) -> do let pat_cond_11 kl_V1384 kl_V1384h kl_V1384t = do return (Atom (B True)) + pat_cond_12 = do do return (Atom (B False)) + in case kl_V1384 of + !(kl_V1384@(Cons (!kl_V1384h) + (!kl_V1384t))) -> pat_cond_11 kl_V1384 kl_V1384h kl_V1384t + _ -> pat_cond_12 + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_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 = Core.Types.Atom (Core.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 (Atom Nil) + _ -> throwError "if: expected boolean" + +kl_shen_assign_types :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_assign_types (!kl_V1388) (!kl_V1389) (!kl_V1390) = do !kl_if_0 <- let pat_cond_1 kl_V1390 kl_V1390h kl_V1390t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V1390t kl_V1390th kl_V1390tt = do !kl_if_6 <- let pat_cond_7 kl_V1390tt kl_V1390tth kl_V1390ttt = do !kl_if_8 <- let pat_cond_9 kl_V1390ttt kl_V1390ttth kl_V1390tttt = do let !appl_10 = Atom Nil + !kl_if_11 <- appl_10 `pseq` (kl_V1390tttt `pseq` eq appl_10 kl_V1390tttt) + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V1390ttt of + !(kl_V1390ttt@(Cons (!kl_V1390ttth) + (!kl_V1390tttt))) -> pat_cond_9 kl_V1390ttt kl_V1390ttth kl_V1390tttt + _ -> 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_V1390tt of + !(kl_V1390tt@(Cons (!kl_V1390tth) + (!kl_V1390ttt))) -> pat_cond_7 kl_V1390tt kl_V1390tth kl_V1390ttt + _ -> 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_V1390t of + !(kl_V1390t@(Cons (!kl_V1390th) + (!kl_V1390tt))) -> pat_cond_5 kl_V1390t kl_V1390th kl_V1390tt + _ -> 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_V1390h of + kl_V1390h@(Atom (UnboundSym "let")) -> pat_cond_3 + kl_V1390h@(ApplC (PL "let" + _)) -> pat_cond_3 + kl_V1390h@(ApplC (Func "let" + _)) -> pat_cond_3 + _ -> 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_V1390 of + !(kl_V1390@(Cons (!kl_V1390h) + (!kl_V1390t))) -> pat_cond_1 kl_V1390 kl_V1390h kl_V1390t + _ -> pat_cond_16 + case kl_if_0 of + Atom (B (True)) -> do !appl_17 <- kl_V1390 `pseq` tl kl_V1390 + !appl_18 <- appl_17 `pseq` hd appl_17 + !appl_19 <- kl_V1390 `pseq` tl kl_V1390 + !appl_20 <- appl_19 `pseq` tl appl_19 + !appl_21 <- appl_20 `pseq` hd appl_20 + !appl_22 <- kl_V1388 `pseq` (kl_V1389 `pseq` (appl_21 `pseq` kl_shen_assign_types kl_V1388 kl_V1389 appl_21)) + !appl_23 <- kl_V1390 `pseq` tl kl_V1390 + !appl_24 <- appl_23 `pseq` hd appl_23 + !appl_25 <- appl_24 `pseq` (kl_V1388 `pseq` klCons appl_24 kl_V1388) + !appl_26 <- kl_V1390 `pseq` tl kl_V1390 + !appl_27 <- appl_26 `pseq` tl appl_26 + !appl_28 <- appl_27 `pseq` tl appl_27 + !appl_29 <- appl_28 `pseq` hd appl_28 + !appl_30 <- appl_25 `pseq` (kl_V1389 `pseq` (appl_29 `pseq` kl_shen_assign_types appl_25 kl_V1389 appl_29)) + let !appl_31 = Atom Nil + !appl_32 <- appl_30 `pseq` (appl_31 `pseq` klCons appl_30 appl_31) + !appl_33 <- appl_22 `pseq` (appl_32 `pseq` klCons appl_22 appl_32) + !appl_34 <- appl_18 `pseq` (appl_33 `pseq` klCons appl_18 appl_33) + appl_34 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_34 + Atom (B (False)) -> do !kl_if_35 <- let pat_cond_36 kl_V1390 kl_V1390h kl_V1390t = do !kl_if_37 <- let pat_cond_38 = do !kl_if_39 <- let pat_cond_40 kl_V1390t kl_V1390th kl_V1390tt = do !kl_if_41 <- let pat_cond_42 kl_V1390tt kl_V1390tth kl_V1390ttt = do let !appl_43 = Atom Nil + !kl_if_44 <- appl_43 `pseq` (kl_V1390ttt `pseq` eq appl_43 kl_V1390ttt) + case kl_if_44 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_45 = do do return (Atom (B False)) + in case kl_V1390tt of + !(kl_V1390tt@(Cons (!kl_V1390tth) + (!kl_V1390ttt))) -> pat_cond_42 kl_V1390tt kl_V1390tth kl_V1390ttt + _ -> pat_cond_45 + case kl_if_41 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_46 = do do return (Atom (B False)) + in case kl_V1390t of + !(kl_V1390t@(Cons (!kl_V1390th) + (!kl_V1390tt))) -> pat_cond_40 kl_V1390t kl_V1390th kl_V1390tt + _ -> pat_cond_46 + case kl_if_39 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_47 = do do return (Atom (B False)) + in case kl_V1390h of + kl_V1390h@(Atom (UnboundSym "lambda")) -> pat_cond_38 + kl_V1390h@(ApplC (PL "lambda" + _)) -> pat_cond_38 + kl_V1390h@(ApplC (Func "lambda" + _)) -> pat_cond_38 + _ -> pat_cond_47 + case kl_if_37 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_48 = do do return (Atom (B False)) + in case kl_V1390 of + !(kl_V1390@(Cons (!kl_V1390h) + (!kl_V1390t))) -> pat_cond_36 kl_V1390 kl_V1390h kl_V1390t + _ -> pat_cond_48 + case kl_if_35 of + Atom (B (True)) -> do !appl_49 <- kl_V1390 `pseq` tl kl_V1390 + !appl_50 <- appl_49 `pseq` hd appl_49 + !appl_51 <- kl_V1390 `pseq` tl kl_V1390 + !appl_52 <- appl_51 `pseq` hd appl_51 + !appl_53 <- appl_52 `pseq` (kl_V1388 `pseq` klCons appl_52 kl_V1388) + !appl_54 <- kl_V1390 `pseq` tl kl_V1390 + !appl_55 <- appl_54 `pseq` tl appl_54 + !appl_56 <- appl_55 `pseq` hd appl_55 + !appl_57 <- appl_53 `pseq` (kl_V1389 `pseq` (appl_56 `pseq` kl_shen_assign_types appl_53 kl_V1389 appl_56)) + let !appl_58 = Atom Nil + !appl_59 <- appl_57 `pseq` (appl_58 `pseq` klCons appl_57 appl_58) + !appl_60 <- appl_50 `pseq` (appl_59 `pseq` klCons appl_50 appl_59) + appl_60 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_60 + Atom (B (False)) -> do let pat_cond_61 kl_V1390 kl_V1390t = do let !appl_62 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do !appl_63 <- kl_Y `pseq` hd kl_Y + !appl_64 <- kl_V1388 `pseq` (kl_V1389 `pseq` (appl_63 `pseq` kl_shen_assign_types kl_V1388 kl_V1389 appl_63)) + !appl_65 <- kl_Y `pseq` tl kl_Y + !appl_66 <- appl_65 `pseq` hd appl_65 + !appl_67 <- kl_V1388 `pseq` (kl_V1389 `pseq` (appl_66 `pseq` kl_shen_assign_types kl_V1388 kl_V1389 appl_66)) + let !appl_68 = Atom Nil + !appl_69 <- appl_67 `pseq` (appl_68 `pseq` klCons appl_67 appl_68) + appl_64 `pseq` (appl_69 `pseq` klCons appl_64 appl_69)))) + let !aw_70 = Core.Types.Atom (Core.Types.UnboundSym "map") + !appl_71 <- appl_62 `pseq` (kl_V1390t `pseq` applyWrapper aw_70 [appl_62, + kl_V1390t]) + appl_71 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "cond")) appl_71 + pat_cond_72 kl_V1390 kl_V1390h kl_V1390t = do let !appl_73 = ApplC (Func "lambda" (Context (\(!kl_NewTable) -> do let !appl_74 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do let !aw_75 = Core.Types.Atom (Core.Types.UnboundSym "append") + !appl_76 <- kl_V1389 `pseq` (kl_NewTable `pseq` applyWrapper aw_75 [kl_V1389, + kl_NewTable]) + kl_V1388 `pseq` (appl_76 `pseq` (kl_Y `pseq` kl_shen_assign_types kl_V1388 appl_76 kl_Y))))) + let !aw_77 = Core.Types.Atom (Core.Types.UnboundSym "map") + !appl_78 <- appl_74 `pseq` (kl_V1390t `pseq` applyWrapper aw_77 [appl_74, + kl_V1390t]) + kl_V1390h `pseq` (appl_78 `pseq` klCons kl_V1390h appl_78)))) + !appl_79 <- kl_V1390h `pseq` kl_shen_get_type kl_V1390h + !appl_80 <- appl_79 `pseq` (kl_V1390t `pseq` kl_shen_typextable appl_79 kl_V1390t) + appl_80 `pseq` applyWrapper appl_73 [appl_80] + pat_cond_81 = do do let !appl_82 = ApplC (Func "lambda" (Context (\(!kl_AtomType) -> do let pat_cond_83 kl_AtomType kl_AtomTypeh kl_AtomTypet = do let !appl_84 = Atom Nil + !appl_85 <- kl_AtomTypet `pseq` (appl_84 `pseq` klCons kl_AtomTypet appl_84) + !appl_86 <- kl_V1390 `pseq` (appl_85 `pseq` klCons kl_V1390 appl_85) + appl_86 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_86 + pat_cond_87 = do do let !aw_88 = Core.Types.Atom (Core.Types.UnboundSym "element?") + !kl_if_89 <- kl_V1390 `pseq` (kl_V1388 `pseq` applyWrapper aw_88 [kl_V1390, + kl_V1388]) + case kl_if_89 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_83 kl_AtomType kl_AtomTypeh kl_AtomTypet + _ -> pat_cond_87))) + let !aw_90 = Core.Types.Atom (Core.Types.UnboundSym "assoc") + !appl_91 <- kl_V1390 `pseq` (kl_V1389 `pseq` applyWrapper aw_90 [kl_V1390, + kl_V1389]) + appl_91 `pseq` applyWrapper appl_82 [appl_91] + in case kl_V1390 of + !(kl_V1390@(Cons (Atom (UnboundSym "cond")) + (!kl_V1390t))) -> pat_cond_61 kl_V1390 kl_V1390t + !(kl_V1390@(Cons (ApplC (PL "cond" + _)) + (!kl_V1390t))) -> pat_cond_61 kl_V1390 kl_V1390t + !(kl_V1390@(Cons (ApplC (Func "cond" + _)) + (!kl_V1390t))) -> pat_cond_61 kl_V1390 kl_V1390t + !(kl_V1390@(Cons (!kl_V1390h) + (!kl_V1390t))) -> pat_cond_72 kl_V1390 kl_V1390h kl_V1390t + _ -> pat_cond_81 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_atom_type :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.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 let !appl_1 = Atom Nil + !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_1 + !appl_3 <- kl_V1392 `pseq` (appl_2 `pseq` klCons kl_V1392 appl_2) + appl_3 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_3 + Atom (B (False)) -> do do !kl_if_4 <- kl_V1392 `pseq` numberP kl_V1392 + case kl_if_4 of + Atom (B (True)) -> do let !appl_5 = Atom Nil + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_5 + !appl_7 <- kl_V1392 `pseq` (appl_6 `pseq` klCons kl_V1392 appl_6) + appl_7 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_7 + Atom (B (False)) -> do do let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "boolean?") + !kl_if_9 <- kl_V1392 `pseq` applyWrapper aw_8 [kl_V1392] + case kl_if_9 of + Atom (B (True)) -> do let !appl_10 = Atom Nil + !appl_11 <- appl_10 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_10 + !appl_12 <- kl_V1392 `pseq` (appl_11 `pseq` klCons kl_V1392 appl_11) + appl_12 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_12 + Atom (B (False)) -> do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "symbol?") + !kl_if_14 <- kl_V1392 `pseq` applyWrapper aw_13 [kl_V1392] + case kl_if_14 of + Atom (B (True)) -> do let !appl_15 = Atom Nil + !appl_16 <- appl_15 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_15 + !appl_17 <- kl_V1392 `pseq` (appl_16 `pseq` klCons kl_V1392 appl_16) + appl_17 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_17 + 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 :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_store_arity (!kl_V1397) (!kl_V1398) = do !kl_if_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*installing-kl*")) + case kl_if_0 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "put") + kl_V1397 `pseq` (kl_V1398 `pseq` (appl_1 `pseq` applyWrapper aw_2 [kl_V1397, + Core.Types.Atom (Core.Types.UnboundSym "arity"), + kl_V1398, + appl_1])) + _ -> throwError "if: expected boolean" + +kl_shen_reduce :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_reduce (!kl_V1400) = do let !appl_0 = Atom Nil + !appl_1 <- appl_0 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*teststack*")) appl_0 + let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Result) -> do !appl_3 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*teststack*")) + let !aw_4 = Core.Types.Atom (Core.Types.UnboundSym "reverse") + !appl_5 <- appl_3 `pseq` applyWrapper aw_4 [appl_3] + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.tests")) appl_5 + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":")) appl_6 + let !appl_8 = Atom Nil + !appl_9 <- kl_Result `pseq` (appl_8 `pseq` klCons kl_Result appl_8) + appl_7 `pseq` (appl_9 `pseq` klCons appl_7 appl_9)))) + !appl_10 <- kl_V1400 `pseq` kl_shen_reduce_help kl_V1400 + !appl_11 <- appl_10 `pseq` applyWrapper appl_2 [appl_10] + let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_1 `pseq` (appl_11 `pseq` applyWrapper aw_12 [appl_1, appl_11]) + +kl_shen_reduce_help :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_reduce_help (!kl_V1402) = do !kl_if_0 <- let pat_cond_1 kl_V1402 kl_V1402h kl_V1402t = do !kl_if_2 <- let pat_cond_3 kl_V1402h kl_V1402hh kl_V1402ht = do !kl_if_4 <- let pat_cond_5 = do !kl_if_6 <- let pat_cond_7 kl_V1402ht kl_V1402hth kl_V1402htt = do !kl_if_8 <- let pat_cond_9 kl_V1402hth kl_V1402hthh kl_V1402htht = do !kl_if_10 <- let pat_cond_11 = do !kl_if_12 <- let pat_cond_13 kl_V1402htht kl_V1402hthth kl_V1402hthtt = do !kl_if_14 <- let pat_cond_15 kl_V1402hthtt kl_V1402hthtth kl_V1402hthttt = do let !appl_16 = Atom Nil + !kl_if_17 <- appl_16 `pseq` (kl_V1402hthttt `pseq` eq appl_16 kl_V1402hthttt) + !kl_if_18 <- case kl_if_17 of + Atom (B (True)) -> do !kl_if_19 <- let pat_cond_20 kl_V1402htt kl_V1402htth kl_V1402httt = do let !appl_21 = Atom Nil + !kl_if_22 <- appl_21 `pseq` (kl_V1402httt `pseq` eq appl_21 kl_V1402httt) + !kl_if_23 <- case kl_if_22 of + Atom (B (True)) -> do !kl_if_24 <- let pat_cond_25 kl_V1402t kl_V1402th kl_V1402tt = do let !appl_26 = Atom Nil + !kl_if_27 <- appl_26 `pseq` (kl_V1402tt `pseq` eq appl_26 kl_V1402tt) + 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_28 = do do return (Atom (B False)) + in case kl_V1402t of + !(kl_V1402t@(Cons (!kl_V1402th) + (!kl_V1402tt))) -> pat_cond_25 kl_V1402t kl_V1402th kl_V1402tt + _ -> pat_cond_28 + case kl_if_24 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_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_29 = do do return (Atom (B False)) + in case kl_V1402htt of + !(kl_V1402htt@(Cons (!kl_V1402htth) + (!kl_V1402httt))) -> pat_cond_20 kl_V1402htt kl_V1402htth kl_V1402httt + _ -> pat_cond_29 + case kl_if_19 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_18 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_30 = do do return (Atom (B False)) + in case kl_V1402hthtt of + !(kl_V1402hthtt@(Cons (!kl_V1402hthtth) + (!kl_V1402hthttt))) -> pat_cond_15 kl_V1402hthtt kl_V1402hthtth kl_V1402hthttt + _ -> pat_cond_30 + case kl_if_14 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_31 = do do return (Atom (B False)) + in case kl_V1402htht of + !(kl_V1402htht@(Cons (!kl_V1402hthth) + (!kl_V1402hthtt))) -> pat_cond_13 kl_V1402htht kl_V1402hthth kl_V1402hthtt + _ -> pat_cond_31 + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_32 = do do return (Atom (B False)) + in case kl_V1402hthh of + kl_V1402hthh@(Atom (UnboundSym "cons")) -> pat_cond_11 + kl_V1402hthh@(ApplC (PL "cons" + _)) -> pat_cond_11 + kl_V1402hthh@(ApplC (Func "cons" + _)) -> pat_cond_11 + _ -> pat_cond_32 + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_33 = do do return (Atom (B False)) + in case kl_V1402hth of + !(kl_V1402hth@(Cons (!kl_V1402hthh) + (!kl_V1402htht))) -> pat_cond_9 kl_V1402hth kl_V1402hthh kl_V1402htht + _ -> pat_cond_33 + 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_34 = do do return (Atom (B False)) + in case kl_V1402ht of + !(kl_V1402ht@(Cons (!kl_V1402hth) + (!kl_V1402htt))) -> pat_cond_7 kl_V1402ht kl_V1402hth kl_V1402htt + _ -> pat_cond_34 + 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_35 = do do return (Atom (B False)) + in case kl_V1402hh of + kl_V1402hh@(Atom (UnboundSym "/.")) -> pat_cond_5 + kl_V1402hh@(ApplC (PL "/." + _)) -> pat_cond_5 + kl_V1402hh@(ApplC (Func "/." + _)) -> pat_cond_5 + _ -> pat_cond_35 + 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_36 = do do return (Atom (B False)) + in case kl_V1402h of + !(kl_V1402h@(Cons (!kl_V1402hh) + (!kl_V1402ht))) -> pat_cond_3 kl_V1402h kl_V1402hh kl_V1402ht + _ -> pat_cond_36 + 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_37 = do do return (Atom (B False)) + in case kl_V1402 of + !(kl_V1402@(Cons (!kl_V1402h) + (!kl_V1402t))) -> pat_cond_1 kl_V1402 kl_V1402h kl_V1402t + _ -> pat_cond_37 + case kl_if_0 of + Atom (B (True)) -> do !appl_38 <- kl_V1402 `pseq` tl kl_V1402 + !appl_39 <- appl_38 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_38 + !appl_40 <- appl_39 `pseq` kl_shen_add_test appl_39 + let !appl_41 = ApplC (Func "lambda" (Context (\(!kl_Abstraction) -> do let !appl_42 = ApplC (Func "lambda" (Context (\(!kl_Application) -> do kl_Application `pseq` kl_shen_reduce_help kl_Application))) + !appl_43 <- kl_V1402 `pseq` tl kl_V1402 + !appl_44 <- appl_43 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_43 + let !appl_45 = Atom Nil + !appl_46 <- appl_44 `pseq` (appl_45 `pseq` klCons appl_44 appl_45) + !appl_47 <- kl_Abstraction `pseq` (appl_46 `pseq` klCons kl_Abstraction appl_46) + !appl_48 <- kl_V1402 `pseq` tl kl_V1402 + !appl_49 <- appl_48 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_48 + let !appl_50 = Atom Nil + !appl_51 <- appl_49 `pseq` (appl_50 `pseq` klCons appl_49 appl_50) + !appl_52 <- appl_47 `pseq` (appl_51 `pseq` klCons appl_47 appl_51) + appl_52 `pseq` applyWrapper appl_42 [appl_52]))) + !appl_53 <- kl_V1402 `pseq` hd kl_V1402 + !appl_54 <- appl_53 `pseq` tl appl_53 + !appl_55 <- appl_54 `pseq` hd appl_54 + !appl_56 <- appl_55 `pseq` tl appl_55 + !appl_57 <- appl_56 `pseq` hd appl_56 + !appl_58 <- kl_V1402 `pseq` hd kl_V1402 + !appl_59 <- appl_58 `pseq` tl appl_58 + !appl_60 <- appl_59 `pseq` hd appl_59 + !appl_61 <- appl_60 `pseq` tl appl_60 + !appl_62 <- appl_61 `pseq` tl appl_61 + !appl_63 <- appl_62 `pseq` hd appl_62 + !appl_64 <- kl_V1402 `pseq` tl kl_V1402 + !appl_65 <- appl_64 `pseq` hd appl_64 + !appl_66 <- kl_V1402 `pseq` hd kl_V1402 + !appl_67 <- appl_66 `pseq` tl appl_66 + !appl_68 <- appl_67 `pseq` hd appl_67 + !appl_69 <- kl_V1402 `pseq` hd kl_V1402 + !appl_70 <- appl_69 `pseq` tl appl_69 + !appl_71 <- appl_70 `pseq` tl appl_70 + !appl_72 <- appl_71 `pseq` hd appl_71 + !appl_73 <- appl_65 `pseq` (appl_68 `pseq` (appl_72 `pseq` kl_shen_ebr appl_65 appl_68 appl_72)) + let !appl_74 = Atom Nil + !appl_75 <- appl_73 `pseq` (appl_74 `pseq` klCons appl_73 appl_74) + !appl_76 <- appl_63 `pseq` (appl_75 `pseq` klCons appl_63 appl_75) + !appl_77 <- appl_76 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_76 + let !appl_78 = Atom Nil + !appl_79 <- appl_77 `pseq` (appl_78 `pseq` klCons appl_77 appl_78) + !appl_80 <- appl_57 `pseq` (appl_79 `pseq` klCons appl_57 appl_79) + !appl_81 <- appl_80 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_80 + !appl_82 <- appl_81 `pseq` applyWrapper appl_41 [appl_81] + let !aw_83 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_40 `pseq` (appl_82 `pseq` applyWrapper aw_83 [appl_40, + appl_82]) + Atom (B (False)) -> do !kl_if_84 <- let pat_cond_85 kl_V1402 kl_V1402h kl_V1402t = do !kl_if_86 <- let pat_cond_87 kl_V1402h kl_V1402hh kl_V1402ht = do !kl_if_88 <- let pat_cond_89 = do !kl_if_90 <- let pat_cond_91 kl_V1402ht kl_V1402hth kl_V1402htt = do !kl_if_92 <- let pat_cond_93 kl_V1402hth kl_V1402hthh kl_V1402htht = do !kl_if_94 <- let pat_cond_95 = do !kl_if_96 <- let pat_cond_97 kl_V1402htht kl_V1402hthth kl_V1402hthtt = do !kl_if_98 <- let pat_cond_99 kl_V1402hthtt kl_V1402hthtth kl_V1402hthttt = do let !appl_100 = Atom Nil + !kl_if_101 <- appl_100 `pseq` (kl_V1402hthttt `pseq` eq appl_100 kl_V1402hthttt) + !kl_if_102 <- case kl_if_101 of + Atom (B (True)) -> do !kl_if_103 <- let pat_cond_104 kl_V1402htt kl_V1402htth kl_V1402httt = do let !appl_105 = Atom Nil + !kl_if_106 <- appl_105 `pseq` (kl_V1402httt `pseq` eq appl_105 kl_V1402httt) + !kl_if_107 <- case kl_if_106 of + Atom (B (True)) -> do !kl_if_108 <- let pat_cond_109 kl_V1402t kl_V1402th kl_V1402tt = do let !appl_110 = Atom Nil + !kl_if_111 <- appl_110 `pseq` (kl_V1402tt `pseq` eq appl_110 kl_V1402tt) + case kl_if_111 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_112 = do do return (Atom (B False)) + in case kl_V1402t of + !(kl_V1402t@(Cons (!kl_V1402th) + (!kl_V1402tt))) -> pat_cond_109 kl_V1402t kl_V1402th kl_V1402tt + _ -> pat_cond_112 + case kl_if_108 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_107 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_113 = do do return (Atom (B False)) + in case kl_V1402htt of + !(kl_V1402htt@(Cons (!kl_V1402htth) + (!kl_V1402httt))) -> pat_cond_104 kl_V1402htt kl_V1402htth kl_V1402httt + _ -> pat_cond_113 + case kl_if_103 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_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_114 = do do return (Atom (B False)) + in case kl_V1402hthtt of + !(kl_V1402hthtt@(Cons (!kl_V1402hthtth) + (!kl_V1402hthttt))) -> pat_cond_99 kl_V1402hthtt kl_V1402hthtth kl_V1402hthttt + _ -> pat_cond_114 + case kl_if_98 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_115 = do do return (Atom (B False)) + in case kl_V1402htht of + !(kl_V1402htht@(Cons (!kl_V1402hthth) + (!kl_V1402hthtt))) -> pat_cond_97 kl_V1402htht kl_V1402hthth kl_V1402hthtt + _ -> pat_cond_115 + case kl_if_96 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_116 = do do return (Atom (B False)) + in case kl_V1402hthh of + kl_V1402hthh@(Atom (UnboundSym "@p")) -> pat_cond_95 + kl_V1402hthh@(ApplC (PL "@p" + _)) -> pat_cond_95 + kl_V1402hthh@(ApplC (Func "@p" + _)) -> pat_cond_95 + _ -> pat_cond_116 + case kl_if_94 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_117 = do do return (Atom (B False)) + in case kl_V1402hth of + !(kl_V1402hth@(Cons (!kl_V1402hthh) + (!kl_V1402htht))) -> pat_cond_93 kl_V1402hth kl_V1402hthh kl_V1402htht + _ -> pat_cond_117 + case kl_if_92 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_118 = do do return (Atom (B False)) + in case kl_V1402ht of + !(kl_V1402ht@(Cons (!kl_V1402hth) + (!kl_V1402htt))) -> pat_cond_91 kl_V1402ht kl_V1402hth kl_V1402htt + _ -> pat_cond_118 + case kl_if_90 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_119 = do do return (Atom (B False)) + in case kl_V1402hh of + kl_V1402hh@(Atom (UnboundSym "/.")) -> pat_cond_89 + kl_V1402hh@(ApplC (PL "/." + _)) -> pat_cond_89 + kl_V1402hh@(ApplC (Func "/." + _)) -> pat_cond_89 + _ -> pat_cond_119 + case kl_if_88 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_120 = do do return (Atom (B False)) + in case kl_V1402h of + !(kl_V1402h@(Cons (!kl_V1402hh) + (!kl_V1402ht))) -> pat_cond_87 kl_V1402h kl_V1402hh kl_V1402ht + _ -> pat_cond_120 + case kl_if_86 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_121 = do do return (Atom (B False)) + in case kl_V1402 of + !(kl_V1402@(Cons (!kl_V1402h) + (!kl_V1402t))) -> pat_cond_85 kl_V1402 kl_V1402h kl_V1402t + _ -> pat_cond_121 + case kl_if_84 of + Atom (B (True)) -> do !appl_122 <- kl_V1402 `pseq` tl kl_V1402 + !appl_123 <- appl_122 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "tuple?")) appl_122 + !appl_124 <- appl_123 `pseq` kl_shen_add_test appl_123 + let !appl_125 = ApplC (Func "lambda" (Context (\(!kl_Abstraction) -> do let !appl_126 = ApplC (Func "lambda" (Context (\(!kl_Application) -> do kl_Application `pseq` kl_shen_reduce_help kl_Application))) + !appl_127 <- kl_V1402 `pseq` tl kl_V1402 + !appl_128 <- appl_127 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "fst")) appl_127 + let !appl_129 = Atom Nil + !appl_130 <- appl_128 `pseq` (appl_129 `pseq` klCons appl_128 appl_129) + !appl_131 <- kl_Abstraction `pseq` (appl_130 `pseq` klCons kl_Abstraction appl_130) + !appl_132 <- kl_V1402 `pseq` tl kl_V1402 + !appl_133 <- appl_132 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "snd")) appl_132 + let !appl_134 = Atom Nil + !appl_135 <- appl_133 `pseq` (appl_134 `pseq` klCons appl_133 appl_134) + !appl_136 <- appl_131 `pseq` (appl_135 `pseq` klCons appl_131 appl_135) + appl_136 `pseq` applyWrapper appl_126 [appl_136]))) + !appl_137 <- kl_V1402 `pseq` hd kl_V1402 + !appl_138 <- appl_137 `pseq` tl appl_137 + !appl_139 <- appl_138 `pseq` hd appl_138 + !appl_140 <- appl_139 `pseq` tl appl_139 + !appl_141 <- appl_140 `pseq` hd appl_140 + !appl_142 <- kl_V1402 `pseq` hd kl_V1402 + !appl_143 <- appl_142 `pseq` tl appl_142 + !appl_144 <- appl_143 `pseq` hd appl_143 + !appl_145 <- appl_144 `pseq` tl appl_144 + !appl_146 <- appl_145 `pseq` tl appl_145 + !appl_147 <- appl_146 `pseq` hd appl_146 + !appl_148 <- kl_V1402 `pseq` tl kl_V1402 + !appl_149 <- appl_148 `pseq` hd appl_148 + !appl_150 <- kl_V1402 `pseq` hd kl_V1402 + !appl_151 <- appl_150 `pseq` tl appl_150 + !appl_152 <- appl_151 `pseq` hd appl_151 + !appl_153 <- kl_V1402 `pseq` hd kl_V1402 + !appl_154 <- appl_153 `pseq` tl appl_153 + !appl_155 <- appl_154 `pseq` tl appl_154 + !appl_156 <- appl_155 `pseq` hd appl_155 + !appl_157 <- appl_149 `pseq` (appl_152 `pseq` (appl_156 `pseq` kl_shen_ebr appl_149 appl_152 appl_156)) + let !appl_158 = Atom Nil + !appl_159 <- appl_157 `pseq` (appl_158 `pseq` klCons appl_157 appl_158) + !appl_160 <- appl_147 `pseq` (appl_159 `pseq` klCons appl_147 appl_159) + !appl_161 <- appl_160 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_160 + let !appl_162 = Atom Nil + !appl_163 <- appl_161 `pseq` (appl_162 `pseq` klCons appl_161 appl_162) + !appl_164 <- appl_141 `pseq` (appl_163 `pseq` klCons appl_141 appl_163) + !appl_165 <- appl_164 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_164 + !appl_166 <- appl_165 `pseq` applyWrapper appl_125 [appl_165] + let !aw_167 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_124 `pseq` (appl_166 `pseq` applyWrapper aw_167 [appl_124, + appl_166]) + Atom (B (False)) -> do !kl_if_168 <- let pat_cond_169 kl_V1402 kl_V1402h kl_V1402t = do !kl_if_170 <- let pat_cond_171 kl_V1402h kl_V1402hh kl_V1402ht = do !kl_if_172 <- let pat_cond_173 = do !kl_if_174 <- let pat_cond_175 kl_V1402ht kl_V1402hth kl_V1402htt = do !kl_if_176 <- let pat_cond_177 kl_V1402hth kl_V1402hthh kl_V1402htht = do !kl_if_178 <- let pat_cond_179 = do !kl_if_180 <- let pat_cond_181 kl_V1402htht kl_V1402hthth kl_V1402hthtt = do !kl_if_182 <- let pat_cond_183 kl_V1402hthtt kl_V1402hthtth kl_V1402hthttt = do let !appl_184 = Atom Nil + !kl_if_185 <- appl_184 `pseq` (kl_V1402hthttt `pseq` eq appl_184 kl_V1402hthttt) + !kl_if_186 <- case kl_if_185 of + Atom (B (True)) -> do !kl_if_187 <- let pat_cond_188 kl_V1402htt kl_V1402htth kl_V1402httt = do let !appl_189 = Atom Nil + !kl_if_190 <- appl_189 `pseq` (kl_V1402httt `pseq` eq appl_189 kl_V1402httt) + !kl_if_191 <- case kl_if_190 of + Atom (B (True)) -> do !kl_if_192 <- let pat_cond_193 kl_V1402t kl_V1402th kl_V1402tt = do let !appl_194 = Atom Nil + !kl_if_195 <- appl_194 `pseq` (kl_V1402tt `pseq` eq appl_194 kl_V1402tt) + case kl_if_195 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_196 = do do return (Atom (B False)) + in case kl_V1402t of + !(kl_V1402t@(Cons (!kl_V1402th) + (!kl_V1402tt))) -> pat_cond_193 kl_V1402t kl_V1402th kl_V1402tt + _ -> pat_cond_196 + case kl_if_192 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_191 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_197 = do do return (Atom (B False)) + in case kl_V1402htt of + !(kl_V1402htt@(Cons (!kl_V1402htth) + (!kl_V1402httt))) -> pat_cond_188 kl_V1402htt kl_V1402htth kl_V1402httt + _ -> pat_cond_197 + case kl_if_187 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_186 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_198 = do do return (Atom (B False)) + in case kl_V1402hthtt of + !(kl_V1402hthtt@(Cons (!kl_V1402hthtth) + (!kl_V1402hthttt))) -> pat_cond_183 kl_V1402hthtt kl_V1402hthtth kl_V1402hthttt + _ -> pat_cond_198 + case kl_if_182 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_199 = do do return (Atom (B False)) + in case kl_V1402htht of + !(kl_V1402htht@(Cons (!kl_V1402hthth) + (!kl_V1402hthtt))) -> pat_cond_181 kl_V1402htht kl_V1402hthth kl_V1402hthtt + _ -> pat_cond_199 + case kl_if_180 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_200 = do do return (Atom (B False)) + in case kl_V1402hthh of + kl_V1402hthh@(Atom (UnboundSym "@v")) -> pat_cond_179 + kl_V1402hthh@(ApplC (PL "@v" + _)) -> pat_cond_179 + kl_V1402hthh@(ApplC (Func "@v" + _)) -> pat_cond_179 + _ -> pat_cond_200 + 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" + pat_cond_201 = do do return (Atom (B False)) + in case kl_V1402hth of + !(kl_V1402hth@(Cons (!kl_V1402hthh) + (!kl_V1402htht))) -> pat_cond_177 kl_V1402hth kl_V1402hthh kl_V1402htht + _ -> pat_cond_201 + case kl_if_176 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_202 = do do return (Atom (B False)) + in case kl_V1402ht of + !(kl_V1402ht@(Cons (!kl_V1402hth) + (!kl_V1402htt))) -> pat_cond_175 kl_V1402ht kl_V1402hth kl_V1402htt + _ -> pat_cond_202 + case kl_if_174 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_203 = do do return (Atom (B False)) + in case kl_V1402hh of + kl_V1402hh@(Atom (UnboundSym "/.")) -> pat_cond_173 + kl_V1402hh@(ApplC (PL "/." + _)) -> pat_cond_173 + kl_V1402hh@(ApplC (Func "/." + _)) -> pat_cond_173 + _ -> pat_cond_203 + case kl_if_172 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_204 = do do return (Atom (B False)) + in case kl_V1402h of + !(kl_V1402h@(Cons (!kl_V1402hh) + (!kl_V1402ht))) -> pat_cond_171 kl_V1402h kl_V1402hh kl_V1402ht + _ -> pat_cond_204 + case kl_if_170 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_205 = do do return (Atom (B False)) + in case kl_V1402 of + !(kl_V1402@(Cons (!kl_V1402h) + (!kl_V1402t))) -> pat_cond_169 kl_V1402 kl_V1402h kl_V1402t + _ -> pat_cond_205 + case kl_if_168 of + Atom (B (True)) -> do !appl_206 <- kl_V1402 `pseq` tl kl_V1402 + !appl_207 <- appl_206 `pseq` klCons (ApplC (wrapNamed "shen.+vector?" kl_shen_PlusvectorP)) appl_206 + !appl_208 <- appl_207 `pseq` kl_shen_add_test appl_207 + let !appl_209 = ApplC (Func "lambda" (Context (\(!kl_Abstraction) -> do let !appl_210 = ApplC (Func "lambda" (Context (\(!kl_Application) -> do kl_Application `pseq` kl_shen_reduce_help kl_Application))) + !appl_211 <- kl_V1402 `pseq` tl kl_V1402 + !appl_212 <- appl_211 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "hdv")) appl_211 + let !appl_213 = Atom Nil + !appl_214 <- appl_212 `pseq` (appl_213 `pseq` klCons appl_212 appl_213) + !appl_215 <- kl_Abstraction `pseq` (appl_214 `pseq` klCons kl_Abstraction appl_214) + !appl_216 <- kl_V1402 `pseq` tl kl_V1402 + !appl_217 <- appl_216 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "tlv")) appl_216 + let !appl_218 = Atom Nil + !appl_219 <- appl_217 `pseq` (appl_218 `pseq` klCons appl_217 appl_218) + !appl_220 <- appl_215 `pseq` (appl_219 `pseq` klCons appl_215 appl_219) + appl_220 `pseq` applyWrapper appl_210 [appl_220]))) + !appl_221 <- kl_V1402 `pseq` hd kl_V1402 + !appl_222 <- appl_221 `pseq` tl appl_221 + !appl_223 <- appl_222 `pseq` hd appl_222 + !appl_224 <- appl_223 `pseq` tl appl_223 + !appl_225 <- appl_224 `pseq` hd appl_224 + !appl_226 <- kl_V1402 `pseq` hd kl_V1402 + !appl_227 <- appl_226 `pseq` tl appl_226 + !appl_228 <- appl_227 `pseq` hd appl_227 + !appl_229 <- appl_228 `pseq` tl appl_228 + !appl_230 <- appl_229 `pseq` tl appl_229 + !appl_231 <- appl_230 `pseq` hd appl_230 + !appl_232 <- kl_V1402 `pseq` tl kl_V1402 + !appl_233 <- appl_232 `pseq` hd appl_232 + !appl_234 <- kl_V1402 `pseq` hd kl_V1402 + !appl_235 <- appl_234 `pseq` tl appl_234 + !appl_236 <- appl_235 `pseq` hd appl_235 + !appl_237 <- kl_V1402 `pseq` hd kl_V1402 + !appl_238 <- appl_237 `pseq` tl appl_237 + !appl_239 <- appl_238 `pseq` tl appl_238 + !appl_240 <- appl_239 `pseq` hd appl_239 + !appl_241 <- appl_233 `pseq` (appl_236 `pseq` (appl_240 `pseq` kl_shen_ebr appl_233 appl_236 appl_240)) + let !appl_242 = Atom Nil + !appl_243 <- appl_241 `pseq` (appl_242 `pseq` klCons appl_241 appl_242) + !appl_244 <- appl_231 `pseq` (appl_243 `pseq` klCons appl_231 appl_243) + !appl_245 <- appl_244 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_244 + let !appl_246 = Atom Nil + !appl_247 <- appl_245 `pseq` (appl_246 `pseq` klCons appl_245 appl_246) + !appl_248 <- appl_225 `pseq` (appl_247 `pseq` klCons appl_225 appl_247) + !appl_249 <- appl_248 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_248 + !appl_250 <- appl_249 `pseq` applyWrapper appl_209 [appl_249] + let !aw_251 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_208 `pseq` (appl_250 `pseq` applyWrapper aw_251 [appl_208, + appl_250]) + Atom (B (False)) -> do !kl_if_252 <- let pat_cond_253 kl_V1402 kl_V1402h kl_V1402t = do !kl_if_254 <- let pat_cond_255 kl_V1402h kl_V1402hh kl_V1402ht = do !kl_if_256 <- let pat_cond_257 = do !kl_if_258 <- let pat_cond_259 kl_V1402ht kl_V1402hth kl_V1402htt = do !kl_if_260 <- let pat_cond_261 kl_V1402hth kl_V1402hthh kl_V1402htht = do !kl_if_262 <- let pat_cond_263 = do !kl_if_264 <- let pat_cond_265 kl_V1402htht kl_V1402hthth kl_V1402hthtt = do !kl_if_266 <- let pat_cond_267 kl_V1402hthtt kl_V1402hthtth kl_V1402hthttt = do let !appl_268 = Atom Nil + !kl_if_269 <- appl_268 `pseq` (kl_V1402hthttt `pseq` eq appl_268 kl_V1402hthttt) + !kl_if_270 <- case kl_if_269 of + Atom (B (True)) -> do !kl_if_271 <- let pat_cond_272 kl_V1402htt kl_V1402htth kl_V1402httt = do let !appl_273 = Atom Nil + !kl_if_274 <- appl_273 `pseq` (kl_V1402httt `pseq` eq appl_273 kl_V1402httt) + !kl_if_275 <- case kl_if_274 of + Atom (B (True)) -> do !kl_if_276 <- let pat_cond_277 kl_V1402t kl_V1402th kl_V1402tt = do let !appl_278 = Atom Nil + !kl_if_279 <- appl_278 `pseq` (kl_V1402tt `pseq` eq appl_278 kl_V1402tt) + case kl_if_279 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_280 = do do return (Atom (B False)) + in case kl_V1402t of + !(kl_V1402t@(Cons (!kl_V1402th) + (!kl_V1402tt))) -> pat_cond_277 kl_V1402t kl_V1402th kl_V1402tt + _ -> pat_cond_280 + case kl_if_276 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_275 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_281 = do do return (Atom (B False)) + in case kl_V1402htt of + !(kl_V1402htt@(Cons (!kl_V1402htth) + (!kl_V1402httt))) -> pat_cond_272 kl_V1402htt kl_V1402htth kl_V1402httt + _ -> pat_cond_281 + case kl_if_271 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_270 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_282 = do do return (Atom (B False)) + in case kl_V1402hthtt of + !(kl_V1402hthtt@(Cons (!kl_V1402hthtth) + (!kl_V1402hthttt))) -> pat_cond_267 kl_V1402hthtt kl_V1402hthtth kl_V1402hthttt + _ -> pat_cond_282 + case kl_if_266 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_283 = do do return (Atom (B False)) + in case kl_V1402htht of + !(kl_V1402htht@(Cons (!kl_V1402hthth) + (!kl_V1402hthtt))) -> pat_cond_265 kl_V1402htht kl_V1402hthth kl_V1402hthtt + _ -> pat_cond_283 + case kl_if_264 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_284 = do do return (Atom (B False)) + in case kl_V1402hthh of + kl_V1402hthh@(Atom (UnboundSym "@s")) -> pat_cond_263 + kl_V1402hthh@(ApplC (PL "@s" + _)) -> pat_cond_263 + kl_V1402hthh@(ApplC (Func "@s" + _)) -> pat_cond_263 + _ -> pat_cond_284 + case kl_if_262 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_285 = do do return (Atom (B False)) + in case kl_V1402hth of + !(kl_V1402hth@(Cons (!kl_V1402hthh) + (!kl_V1402htht))) -> pat_cond_261 kl_V1402hth kl_V1402hthh kl_V1402htht + _ -> pat_cond_285 + case kl_if_260 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_286 = do do return (Atom (B False)) + in case kl_V1402ht of + !(kl_V1402ht@(Cons (!kl_V1402hth) + (!kl_V1402htt))) -> pat_cond_259 kl_V1402ht kl_V1402hth kl_V1402htt + _ -> pat_cond_286 + case kl_if_258 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_287 = do do return (Atom (B False)) + in case kl_V1402hh of + kl_V1402hh@(Atom (UnboundSym "/.")) -> pat_cond_257 + kl_V1402hh@(ApplC (PL "/." + _)) -> pat_cond_257 + kl_V1402hh@(ApplC (Func "/." + _)) -> pat_cond_257 + _ -> pat_cond_287 + case kl_if_256 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_288 = do do return (Atom (B False)) + in case kl_V1402h of + !(kl_V1402h@(Cons (!kl_V1402hh) + (!kl_V1402ht))) -> pat_cond_255 kl_V1402h kl_V1402hh kl_V1402ht + _ -> pat_cond_288 + case kl_if_254 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_289 = do do return (Atom (B False)) + in case kl_V1402 of + !(kl_V1402@(Cons (!kl_V1402h) + (!kl_V1402t))) -> pat_cond_253 kl_V1402 kl_V1402h kl_V1402t + _ -> pat_cond_289 + case kl_if_252 of + Atom (B (True)) -> do !appl_290 <- kl_V1402 `pseq` tl kl_V1402 + !appl_291 <- appl_290 `pseq` klCons (ApplC (wrapNamed "shen.+string?" kl_shen_PlusstringP)) appl_290 + !appl_292 <- appl_291 `pseq` kl_shen_add_test appl_291 + let !appl_293 = ApplC (Func "lambda" (Context (\(!kl_Abstraction) -> do let !appl_294 = ApplC (Func "lambda" (Context (\(!kl_Application) -> do kl_Application `pseq` kl_shen_reduce_help kl_Application))) + !appl_295 <- kl_V1402 `pseq` tl kl_V1402 + !appl_296 <- appl_295 `pseq` hd appl_295 + let !appl_297 = Atom Nil + !appl_298 <- appl_297 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_297 + !appl_299 <- appl_296 `pseq` (appl_298 `pseq` klCons appl_296 appl_298) + !appl_300 <- appl_299 `pseq` klCons (ApplC (wrapNamed "pos" pos)) appl_299 + let !appl_301 = Atom Nil + !appl_302 <- appl_300 `pseq` (appl_301 `pseq` klCons appl_300 appl_301) + !appl_303 <- kl_Abstraction `pseq` (appl_302 `pseq` klCons kl_Abstraction appl_302) + !appl_304 <- kl_V1402 `pseq` tl kl_V1402 + !appl_305 <- appl_304 `pseq` klCons (ApplC (wrapNamed "tlstr" tlstr)) appl_304 + let !appl_306 = Atom Nil + !appl_307 <- appl_305 `pseq` (appl_306 `pseq` klCons appl_305 appl_306) + !appl_308 <- appl_303 `pseq` (appl_307 `pseq` klCons appl_303 appl_307) + appl_308 `pseq` applyWrapper appl_294 [appl_308]))) + !appl_309 <- kl_V1402 `pseq` hd kl_V1402 + !appl_310 <- appl_309 `pseq` tl appl_309 + !appl_311 <- appl_310 `pseq` hd appl_310 + !appl_312 <- appl_311 `pseq` tl appl_311 + !appl_313 <- appl_312 `pseq` hd appl_312 + !appl_314 <- kl_V1402 `pseq` hd kl_V1402 + !appl_315 <- appl_314 `pseq` tl appl_314 + !appl_316 <- appl_315 `pseq` hd appl_315 + !appl_317 <- appl_316 `pseq` tl appl_316 + !appl_318 <- appl_317 `pseq` tl appl_317 + !appl_319 <- appl_318 `pseq` hd appl_318 + !appl_320 <- kl_V1402 `pseq` tl kl_V1402 + !appl_321 <- appl_320 `pseq` hd appl_320 + !appl_322 <- kl_V1402 `pseq` hd kl_V1402 + !appl_323 <- appl_322 `pseq` tl appl_322 + !appl_324 <- appl_323 `pseq` hd appl_323 + !appl_325 <- kl_V1402 `pseq` hd kl_V1402 + !appl_326 <- appl_325 `pseq` tl appl_325 + !appl_327 <- appl_326 `pseq` tl appl_326 + !appl_328 <- appl_327 `pseq` hd appl_327 + !appl_329 <- appl_321 `pseq` (appl_324 `pseq` (appl_328 `pseq` kl_shen_ebr appl_321 appl_324 appl_328)) + let !appl_330 = Atom Nil + !appl_331 <- appl_329 `pseq` (appl_330 `pseq` klCons appl_329 appl_330) + !appl_332 <- appl_319 `pseq` (appl_331 `pseq` klCons appl_319 appl_331) + !appl_333 <- appl_332 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_332 + let !appl_334 = Atom Nil + !appl_335 <- appl_333 `pseq` (appl_334 `pseq` klCons appl_333 appl_334) + !appl_336 <- appl_313 `pseq` (appl_335 `pseq` klCons appl_313 appl_335) + !appl_337 <- appl_336 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_336 + !appl_338 <- appl_337 `pseq` applyWrapper appl_293 [appl_337] + let !aw_339 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_292 `pseq` (appl_338 `pseq` applyWrapper aw_339 [appl_292, + appl_338]) + Atom (B (False)) -> do !kl_if_340 <- let pat_cond_341 kl_V1402 kl_V1402h kl_V1402t = do !kl_if_342 <- let pat_cond_343 kl_V1402h kl_V1402hh kl_V1402ht = do !kl_if_344 <- let pat_cond_345 = do !kl_if_346 <- let pat_cond_347 kl_V1402ht kl_V1402hth kl_V1402htt = do !kl_if_348 <- let pat_cond_349 kl_V1402htt kl_V1402htth kl_V1402httt = do let !appl_350 = Atom Nil + !kl_if_351 <- appl_350 `pseq` (kl_V1402httt `pseq` eq appl_350 kl_V1402httt) + !kl_if_352 <- case kl_if_351 of + Atom (B (True)) -> do !kl_if_353 <- let pat_cond_354 kl_V1402t kl_V1402th kl_V1402tt = do let !appl_355 = Atom Nil + !kl_if_356 <- appl_355 `pseq` (kl_V1402tt `pseq` eq appl_355 kl_V1402tt) + !kl_if_357 <- case kl_if_356 of + Atom (B (True)) -> do let !aw_358 = Core.Types.Atom (Core.Types.UnboundSym "variable?") + !appl_359 <- kl_V1402hth `pseq` applyWrapper aw_358 [kl_V1402hth] + let !aw_360 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_361 <- appl_359 `pseq` applyWrapper aw_360 [appl_359] + case kl_if_361 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_357 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_362 = do do return (Atom (B False)) + in case kl_V1402t of + !(kl_V1402t@(Cons (!kl_V1402th) + (!kl_V1402tt))) -> pat_cond_354 kl_V1402t kl_V1402th kl_V1402tt + _ -> pat_cond_362 + case kl_if_353 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_352 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_363 = do do return (Atom (B False)) + in case kl_V1402htt of + !(kl_V1402htt@(Cons (!kl_V1402htth) + (!kl_V1402httt))) -> pat_cond_349 kl_V1402htt kl_V1402htth kl_V1402httt + _ -> pat_cond_363 + case kl_if_348 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_364 = do do return (Atom (B False)) + in case kl_V1402ht of + !(kl_V1402ht@(Cons (!kl_V1402hth) + (!kl_V1402htt))) -> pat_cond_347 kl_V1402ht kl_V1402hth kl_V1402htt + _ -> pat_cond_364 + case kl_if_346 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_365 = do do return (Atom (B False)) + in case kl_V1402hh of + kl_V1402hh@(Atom (UnboundSym "/.")) -> pat_cond_345 + kl_V1402hh@(ApplC (PL "/." + _)) -> pat_cond_345 + kl_V1402hh@(ApplC (Func "/." + _)) -> pat_cond_345 + _ -> pat_cond_365 + case kl_if_344 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_366 = do do return (Atom (B False)) + in case kl_V1402h of + !(kl_V1402h@(Cons (!kl_V1402hh) + (!kl_V1402ht))) -> pat_cond_343 kl_V1402h kl_V1402hh kl_V1402ht + _ -> pat_cond_366 + case kl_if_342 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_367 = do do return (Atom (B False)) + in case kl_V1402 of + !(kl_V1402@(Cons (!kl_V1402h) + (!kl_V1402t))) -> pat_cond_341 kl_V1402 kl_V1402h kl_V1402t + _ -> pat_cond_367 + case kl_if_340 of + Atom (B (True)) -> do !appl_368 <- kl_V1402 `pseq` hd kl_V1402 + !appl_369 <- appl_368 `pseq` tl appl_368 + !appl_370 <- appl_369 `pseq` hd appl_369 + !appl_371 <- kl_V1402 `pseq` tl kl_V1402 + !appl_372 <- appl_370 `pseq` (appl_371 `pseq` klCons appl_370 appl_371) + !appl_373 <- appl_372 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_372 + !appl_374 <- appl_373 `pseq` kl_shen_add_test appl_373 + !appl_375 <- kl_V1402 `pseq` hd kl_V1402 + !appl_376 <- appl_375 `pseq` tl appl_375 + !appl_377 <- appl_376 `pseq` tl appl_376 + !appl_378 <- appl_377 `pseq` hd appl_377 + !appl_379 <- appl_378 `pseq` kl_shen_reduce_help appl_378 + let !aw_380 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_374 `pseq` (appl_379 `pseq` applyWrapper aw_380 [appl_374, + appl_379]) + Atom (B (False)) -> do !kl_if_381 <- let pat_cond_382 kl_V1402 kl_V1402h kl_V1402t = do !kl_if_383 <- let pat_cond_384 kl_V1402h kl_V1402hh kl_V1402ht = do !kl_if_385 <- let pat_cond_386 = do !kl_if_387 <- let pat_cond_388 kl_V1402ht kl_V1402hth kl_V1402htt = do !kl_if_389 <- let pat_cond_390 kl_V1402htt kl_V1402htth kl_V1402httt = do let !appl_391 = Atom Nil + !kl_if_392 <- appl_391 `pseq` (kl_V1402httt `pseq` eq appl_391 kl_V1402httt) + !kl_if_393 <- case kl_if_392 of + Atom (B (True)) -> do !kl_if_394 <- let pat_cond_395 kl_V1402t kl_V1402th kl_V1402tt = do let !appl_396 = Atom Nil + !kl_if_397 <- appl_396 `pseq` (kl_V1402tt `pseq` eq appl_396 kl_V1402tt) + case kl_if_397 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_398 = do do return (Atom (B False)) + in case kl_V1402t of + !(kl_V1402t@(Cons (!kl_V1402th) + (!kl_V1402tt))) -> pat_cond_395 kl_V1402t kl_V1402th kl_V1402tt + _ -> pat_cond_398 + case kl_if_394 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_393 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_399 = do do return (Atom (B False)) + in case kl_V1402htt of + !(kl_V1402htt@(Cons (!kl_V1402htth) + (!kl_V1402httt))) -> pat_cond_390 kl_V1402htt kl_V1402htth kl_V1402httt + _ -> pat_cond_399 + case kl_if_389 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_400 = do do return (Atom (B False)) + in case kl_V1402ht of + !(kl_V1402ht@(Cons (!kl_V1402hth) + (!kl_V1402htt))) -> pat_cond_388 kl_V1402ht kl_V1402hth kl_V1402htt + _ -> pat_cond_400 + 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" + pat_cond_401 = do do return (Atom (B False)) + in case kl_V1402hh of + kl_V1402hh@(Atom (UnboundSym "/.")) -> pat_cond_386 + kl_V1402hh@(ApplC (PL "/." + _)) -> pat_cond_386 + kl_V1402hh@(ApplC (Func "/." + _)) -> pat_cond_386 + _ -> pat_cond_401 + case kl_if_385 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_402 = do do return (Atom (B False)) + in case kl_V1402h of + !(kl_V1402h@(Cons (!kl_V1402hh) + (!kl_V1402ht))) -> pat_cond_384 kl_V1402h kl_V1402hh kl_V1402ht + _ -> pat_cond_402 + case kl_if_383 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_403 = do do return (Atom (B False)) + in case kl_V1402 of + !(kl_V1402@(Cons (!kl_V1402h) + (!kl_V1402t))) -> pat_cond_382 kl_V1402 kl_V1402h kl_V1402t + _ -> pat_cond_403 + case kl_if_381 of + Atom (B (True)) -> do !appl_404 <- kl_V1402 `pseq` tl kl_V1402 + !appl_405 <- appl_404 `pseq` hd appl_404 + !appl_406 <- kl_V1402 `pseq` hd kl_V1402 + !appl_407 <- appl_406 `pseq` tl appl_406 + !appl_408 <- appl_407 `pseq` hd appl_407 + !appl_409 <- kl_V1402 `pseq` hd kl_V1402 + !appl_410 <- appl_409 `pseq` tl appl_409 + !appl_411 <- appl_410 `pseq` tl appl_410 + !appl_412 <- appl_411 `pseq` hd appl_411 + !appl_413 <- appl_405 `pseq` (appl_408 `pseq` (appl_412 `pseq` kl_shen_ebr appl_405 appl_408 appl_412)) + appl_413 `pseq` kl_shen_reduce_help appl_413 + Atom (B (False)) -> do !kl_if_414 <- let pat_cond_415 kl_V1402 kl_V1402h kl_V1402t = do !kl_if_416 <- let pat_cond_417 = do !kl_if_418 <- let pat_cond_419 kl_V1402t kl_V1402th kl_V1402tt = do !kl_if_420 <- let pat_cond_421 kl_V1402tt kl_V1402tth kl_V1402ttt = do let !appl_422 = Atom Nil + !kl_if_423 <- appl_422 `pseq` (kl_V1402ttt `pseq` eq appl_422 kl_V1402ttt) + case kl_if_423 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_424 = do do return (Atom (B False)) + in case kl_V1402tt of + !(kl_V1402tt@(Cons (!kl_V1402tth) + (!kl_V1402ttt))) -> pat_cond_421 kl_V1402tt kl_V1402tth kl_V1402ttt + _ -> pat_cond_424 + case kl_if_420 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_425 = do do return (Atom (B False)) + in case kl_V1402t of + !(kl_V1402t@(Cons (!kl_V1402th) + (!kl_V1402tt))) -> pat_cond_419 kl_V1402t kl_V1402th kl_V1402tt + _ -> pat_cond_425 + case kl_if_418 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_426 = do do return (Atom (B False)) + in case kl_V1402h of + kl_V1402h@(Atom (UnboundSym "where")) -> pat_cond_417 + kl_V1402h@(ApplC (PL "where" + _)) -> pat_cond_417 + kl_V1402h@(ApplC (Func "where" + _)) -> pat_cond_417 + _ -> pat_cond_426 + case kl_if_416 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_427 = do do return (Atom (B False)) + in case kl_V1402 of + !(kl_V1402@(Cons (!kl_V1402h) + (!kl_V1402t))) -> pat_cond_415 kl_V1402 kl_V1402h kl_V1402t + _ -> pat_cond_427 + case kl_if_414 of + Atom (B (True)) -> do !appl_428 <- kl_V1402 `pseq` tl kl_V1402 + !appl_429 <- appl_428 `pseq` hd appl_428 + !appl_430 <- appl_429 `pseq` kl_shen_add_test appl_429 + !appl_431 <- kl_V1402 `pseq` tl kl_V1402 + !appl_432 <- appl_431 `pseq` tl appl_431 + !appl_433 <- appl_432 `pseq` hd appl_432 + !appl_434 <- appl_433 `pseq` kl_shen_reduce_help appl_433 + let !aw_435 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_430 `pseq` (appl_434 `pseq` applyWrapper aw_435 [appl_430, + appl_434]) + Atom (B (False)) -> do !kl_if_436 <- let pat_cond_437 kl_V1402 kl_V1402h kl_V1402t = do !kl_if_438 <- let pat_cond_439 kl_V1402t kl_V1402th kl_V1402tt = do let !appl_440 = Atom Nil + !kl_if_441 <- appl_440 `pseq` (kl_V1402tt `pseq` eq appl_440 kl_V1402tt) + case kl_if_441 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_442 = do do return (Atom (B False)) + in case kl_V1402t of + !(kl_V1402t@(Cons (!kl_V1402th) + (!kl_V1402tt))) -> pat_cond_439 kl_V1402t kl_V1402th kl_V1402tt + _ -> pat_cond_442 + case kl_if_438 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_443 = do do return (Atom (B False)) + in case kl_V1402 of + !(kl_V1402@(Cons (!kl_V1402h) + (!kl_V1402t))) -> pat_cond_437 kl_V1402 kl_V1402h kl_V1402t + _ -> pat_cond_443 + case kl_if_436 of + Atom (B (True)) -> do let !appl_444 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do !appl_445 <- kl_V1402 `pseq` hd kl_V1402 + !kl_if_446 <- appl_445 `pseq` (kl_Z `pseq` eq appl_445 kl_Z) + case kl_if_446 of + Atom (B (True)) -> do return kl_V1402 + Atom (B (False)) -> do do !appl_447 <- kl_V1402 `pseq` tl kl_V1402 + !appl_448 <- kl_Z `pseq` (appl_447 `pseq` klCons kl_Z appl_447) + appl_448 `pseq` kl_shen_reduce_help appl_448 + _ -> throwError "if: expected boolean"))) + !appl_449 <- kl_V1402 `pseq` hd kl_V1402 + !appl_450 <- appl_449 `pseq` kl_shen_reduce_help appl_449 + appl_450 `pseq` applyWrapper appl_444 [appl_450] + Atom (B (False)) -> do do return kl_V1402 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_PlusstringP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.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_PlusvectorP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_PlusvectorP (!kl_V1406) = do !kl_if_0 <- kl_V1406 `pseq` absvectorP kl_V1406 + case kl_if_0 of + Atom (B (True)) -> do !appl_1 <- kl_V1406 `pseq` addressFrom kl_V1406 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_2 <- appl_1 `pseq` greaterThan appl_1 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + +kl_shen_ebr :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.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 let !appl_9 = Atom Nil + !kl_if_10 <- appl_9 `pseq` (kl_V1422ttt `pseq` eq appl_9 kl_V1422ttt) + !kl_if_11 <- case kl_if_10 of + Atom (B (True)) -> do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "occurrences") + !appl_13 <- kl_V1421 `pseq` (kl_V1422th `pseq` applyWrapper aw_12 [kl_V1421, + kl_V1422th]) + !kl_if_14 <- appl_13 `pseq` greaterThan appl_13 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + case kl_if_14 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + 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 let !appl_27 = Atom Nil + !kl_if_28 <- appl_27 `pseq` (kl_V1422ttt `pseq` eq appl_27 kl_V1422ttt) + !kl_if_29 <- case kl_if_28 of + Atom (B (True)) -> do let !aw_30 = Core.Types.Atom (Core.Types.UnboundSym "occurrences") + !appl_31 <- kl_V1421 `pseq` (kl_V1422th `pseq` applyWrapper aw_30 [kl_V1421, + kl_V1422th]) + !kl_if_32 <- appl_31 `pseq` greaterThan appl_31 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + case kl_if_32 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_29 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_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 !kl_if_37 <- let pat_cond_38 kl_V1422 kl_V1422h kl_V1422t = do !kl_if_39 <- let pat_cond_40 = do !kl_if_41 <- let pat_cond_42 kl_V1422t kl_V1422th kl_V1422tt = do !kl_if_43 <- let pat_cond_44 kl_V1422tt kl_V1422tth kl_V1422ttt = do !kl_if_45 <- let pat_cond_46 kl_V1422ttt kl_V1422ttth kl_V1422tttt = do let !appl_47 = Atom Nil + !kl_if_48 <- appl_47 `pseq` (kl_V1422tttt `pseq` eq appl_47 kl_V1422tttt) + !kl_if_49 <- case kl_if_48 of + Atom (B (True)) -> do !kl_if_50 <- kl_V1422th `pseq` (kl_V1421 `pseq` eq kl_V1422th kl_V1421) + case kl_if_50 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_49 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_51 = do do return (Atom (B False)) + in case kl_V1422ttt of + !(kl_V1422ttt@(Cons (!kl_V1422ttth) + (!kl_V1422tttt))) -> pat_cond_46 kl_V1422ttt kl_V1422ttth kl_V1422tttt + _ -> pat_cond_51 + case kl_if_45 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_52 = do do return (Atom (B False)) + in case kl_V1422tt of + !(kl_V1422tt@(Cons (!kl_V1422tth) + (!kl_V1422ttt))) -> pat_cond_44 kl_V1422tt kl_V1422tth kl_V1422ttt + _ -> pat_cond_52 + case kl_if_43 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_53 = do do return (Atom (B False)) + in case kl_V1422t of + !(kl_V1422t@(Cons (!kl_V1422th) + (!kl_V1422tt))) -> pat_cond_42 kl_V1422t kl_V1422th kl_V1422tt + _ -> pat_cond_53 + case kl_if_41 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_54 = do do return (Atom (B False)) + in case kl_V1422h of + kl_V1422h@(Atom (UnboundSym "let")) -> pat_cond_40 + kl_V1422h@(ApplC (PL "let" + _)) -> pat_cond_40 + kl_V1422h@(ApplC (Func "let" + _)) -> pat_cond_40 + _ -> pat_cond_54 + case kl_if_39 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_55 = do do return (Atom (B False)) + in case kl_V1422 of + !(kl_V1422@(Cons (!kl_V1422h) + (!kl_V1422t))) -> pat_cond_38 kl_V1422 kl_V1422h kl_V1422t + _ -> pat_cond_55 + case kl_if_37 of + Atom (B (True)) -> do !appl_56 <- kl_V1422 `pseq` tl kl_V1422 + !appl_57 <- appl_56 `pseq` hd appl_56 + !appl_58 <- kl_V1422 `pseq` tl kl_V1422 + !appl_59 <- appl_58 `pseq` hd appl_58 + !appl_60 <- kl_V1422 `pseq` tl kl_V1422 + !appl_61 <- appl_60 `pseq` tl appl_60 + !appl_62 <- appl_61 `pseq` hd appl_61 + !appl_63 <- kl_V1420 `pseq` (appl_59 `pseq` (appl_62 `pseq` kl_shen_ebr kl_V1420 appl_59 appl_62)) + !appl_64 <- kl_V1422 `pseq` tl kl_V1422 + !appl_65 <- appl_64 `pseq` tl appl_64 + !appl_66 <- appl_65 `pseq` tl appl_65 + !appl_67 <- appl_63 `pseq` (appl_66 `pseq` klCons appl_63 appl_66) + !appl_68 <- appl_57 `pseq` (appl_67 `pseq` klCons appl_57 appl_67) + appl_68 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_68 + Atom (B (False)) -> do let pat_cond_69 kl_V1422 kl_V1422h kl_V1422t = do !appl_70 <- kl_V1420 `pseq` (kl_V1421 `pseq` (kl_V1422h `pseq` kl_shen_ebr kl_V1420 kl_V1421 kl_V1422h)) + !appl_71 <- kl_V1420 `pseq` (kl_V1421 `pseq` (kl_V1422t `pseq` kl_shen_ebr kl_V1420 kl_V1421 kl_V1422t)) + appl_70 `pseq` (appl_71 `pseq` klCons appl_70 appl_71) + pat_cond_72 = do do return kl_V1422 + in case kl_V1422 of + !(kl_V1422@(Cons (!kl_V1422h) + (!kl_V1422t))) -> pat_cond_69 kl_V1422 kl_V1422h kl_V1422t + _ -> pat_cond_72 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_add_test :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_add_test (!kl_V1424) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*teststack*")) + !appl_1 <- kl_V1424 `pseq` (appl_0 `pseq` klCons kl_V1424 appl_0) + appl_1 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*teststack*")) appl_1 + +kl_shen_cond_expression :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.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 :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_cond_form (!kl_V1434) = do !kl_if_0 <- let pat_cond_1 kl_V1434 kl_V1434h kl_V1434t = do !kl_if_2 <- let pat_cond_3 kl_V1434h kl_V1434hh kl_V1434ht = do !kl_if_4 <- let pat_cond_5 = do !kl_if_6 <- let pat_cond_7 kl_V1434ht kl_V1434hth kl_V1434htt = do let !appl_8 = Atom Nil + !kl_if_9 <- appl_8 `pseq` (kl_V1434htt `pseq` eq appl_8 kl_V1434htt) + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_10 = do do return (Atom (B False)) + in case kl_V1434ht of + !(kl_V1434ht@(Cons (!kl_V1434hth) + (!kl_V1434htt))) -> pat_cond_7 kl_V1434ht kl_V1434hth kl_V1434htt + _ -> pat_cond_10 + case kl_if_6 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_11 = do do return (Atom (B False)) + in case kl_V1434hh of + kl_V1434hh@(Atom (UnboundSym "true")) -> pat_cond_5 + kl_V1434hh@(Atom (B (True))) -> pat_cond_5 + _ -> pat_cond_11 + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V1434h of + !(kl_V1434h@(Cons (!kl_V1434hh) + (!kl_V1434ht))) -> pat_cond_3 kl_V1434h kl_V1434hh kl_V1434ht + _ -> pat_cond_12 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_13 = do do return (Atom (B False)) + in case kl_V1434 of + !(kl_V1434@(Cons (!kl_V1434h) + (!kl_V1434t))) -> pat_cond_1 kl_V1434 kl_V1434h kl_V1434t + _ -> pat_cond_13 + case kl_if_0 of + Atom (B (True)) -> do !appl_14 <- kl_V1434 `pseq` hd kl_V1434 + !appl_15 <- appl_14 `pseq` tl appl_14 + appl_15 `pseq` hd appl_15 + Atom (B (False)) -> do do kl_V1434 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "cond")) kl_V1434 + _ -> throwError "if: expected boolean" + +kl_shen_encode_choices :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_encode_choices (!kl_V1439) (!kl_V1440) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1439 `pseq` eq appl_0 kl_V1439) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V1439 kl_V1439h kl_V1439t = do !kl_if_4 <- let pat_cond_5 kl_V1439h kl_V1439hh kl_V1439ht = do !kl_if_6 <- let pat_cond_7 = do !kl_if_8 <- let pat_cond_9 kl_V1439ht kl_V1439hth kl_V1439htt = do !kl_if_10 <- let pat_cond_11 kl_V1439hth kl_V1439hthh kl_V1439htht = do !kl_if_12 <- let pat_cond_13 = do !kl_if_14 <- let pat_cond_15 kl_V1439htht kl_V1439hthth kl_V1439hthtt = do let !appl_16 = Atom Nil + !kl_if_17 <- appl_16 `pseq` (kl_V1439hthtt `pseq` eq appl_16 kl_V1439hthtt) + !kl_if_18 <- case kl_if_17 of + Atom (B (True)) -> do let !appl_19 = Atom Nil + !kl_if_20 <- appl_19 `pseq` (kl_V1439htt `pseq` eq appl_19 kl_V1439htt) + !kl_if_21 <- case kl_if_20 of + Atom (B (True)) -> do let !appl_22 = Atom Nil + !kl_if_23 <- appl_22 `pseq` (kl_V1439t `pseq` eq appl_22 kl_V1439t) + 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_21 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_18 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_24 = do do return (Atom (B False)) + in case kl_V1439htht of + !(kl_V1439htht@(Cons (!kl_V1439hthth) + (!kl_V1439hthtt))) -> pat_cond_15 kl_V1439htht kl_V1439hthth kl_V1439hthtt + _ -> pat_cond_24 + case kl_if_14 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_25 = do do return (Atom (B False)) + in case kl_V1439hthh of + kl_V1439hthh@(Atom (UnboundSym "shen.choicepoint!")) -> pat_cond_13 + kl_V1439hthh@(ApplC (PL "shen.choicepoint!" + _)) -> pat_cond_13 + kl_V1439hthh@(ApplC (Func "shen.choicepoint!" + _)) -> pat_cond_13 + _ -> pat_cond_25 + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_26 = do do return (Atom (B False)) + in case kl_V1439hth of + !(kl_V1439hth@(Cons (!kl_V1439hthh) + (!kl_V1439htht))) -> pat_cond_11 kl_V1439hth kl_V1439hthh kl_V1439htht + _ -> pat_cond_26 + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_27 = do do return (Atom (B False)) + in case kl_V1439ht of + !(kl_V1439ht@(Cons (!kl_V1439hth) + (!kl_V1439htt))) -> pat_cond_9 kl_V1439ht kl_V1439hth kl_V1439htt + _ -> pat_cond_27 + 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_28 = do do return (Atom (B False)) + in case kl_V1439hh of + kl_V1439hh@(Atom (UnboundSym "true")) -> pat_cond_7 + kl_V1439hh@(Atom (B (True))) -> pat_cond_7 + _ -> pat_cond_28 + 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_29 = do do return (Atom (B False)) + in case kl_V1439h of + !(kl_V1439h@(Cons (!kl_V1439hh) + (!kl_V1439ht))) -> pat_cond_5 kl_V1439h kl_V1439hh kl_V1439ht + _ -> pat_cond_29 + 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_30 = do do return (Atom (B False)) + in case kl_V1439 of + !(kl_V1439@(Cons (!kl_V1439h) + (!kl_V1439t))) -> pat_cond_3 kl_V1439 kl_V1439h kl_V1439t + _ -> pat_cond_30 + case kl_if_2 of + Atom (B (True)) -> do !appl_31 <- kl_V1439 `pseq` hd kl_V1439 + !appl_32 <- appl_31 `pseq` tl appl_31 + !appl_33 <- appl_32 `pseq` hd appl_32 + !appl_34 <- appl_33 `pseq` tl appl_33 + !appl_35 <- appl_34 `pseq` hd appl_34 + let !appl_36 = Atom Nil + !appl_37 <- appl_36 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "fail")) appl_36 + let !appl_38 = Atom Nil + !appl_39 <- appl_37 `pseq` (appl_38 `pseq` klCons appl_37 appl_38) + !appl_40 <- appl_39 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_39 + !appl_41 <- appl_40 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_40 + !kl_if_42 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*installing-kl*")) + !appl_43 <- case kl_if_42 of + Atom (B (True)) -> do let !appl_44 = Atom Nil + !appl_45 <- kl_V1440 `pseq` (appl_44 `pseq` klCons kl_V1440 appl_44) + appl_45 `pseq` klCons (ApplC (wrapNamed "shen.sys-error" kl_shen_sys_error)) appl_45 + Atom (B (False)) -> do do let !appl_46 = Atom Nil + !appl_47 <- kl_V1440 `pseq` (appl_46 `pseq` klCons kl_V1440 appl_46) + appl_47 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.f_error")) appl_47 + _ -> throwError "if: expected boolean" + let !appl_48 = Atom Nil + !appl_49 <- appl_48 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_48 + !appl_50 <- appl_43 `pseq` (appl_49 `pseq` klCons appl_43 appl_49) + !appl_51 <- appl_41 `pseq` (appl_50 `pseq` klCons appl_41 appl_50) + !appl_52 <- appl_51 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_51 + let !appl_53 = Atom Nil + !appl_54 <- appl_52 `pseq` (appl_53 `pseq` klCons appl_52 appl_53) + !appl_55 <- appl_35 `pseq` (appl_54 `pseq` klCons appl_35 appl_54) + !appl_56 <- appl_55 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_55 + !appl_57 <- appl_56 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_56 + let !appl_58 = Atom Nil + !appl_59 <- appl_57 `pseq` (appl_58 `pseq` klCons appl_57 appl_58) + !appl_60 <- appl_59 `pseq` klCons (Atom (B True)) appl_59 + let !appl_61 = Atom Nil + appl_60 `pseq` (appl_61 `pseq` klCons appl_60 appl_61) + Atom (B (False)) -> do !kl_if_62 <- let pat_cond_63 kl_V1439 kl_V1439h kl_V1439t = do !kl_if_64 <- let pat_cond_65 kl_V1439h kl_V1439hh kl_V1439ht = do !kl_if_66 <- let pat_cond_67 = do !kl_if_68 <- let pat_cond_69 kl_V1439ht kl_V1439hth kl_V1439htt = do !kl_if_70 <- let pat_cond_71 kl_V1439hth kl_V1439hthh kl_V1439htht = do !kl_if_72 <- let pat_cond_73 = do !kl_if_74 <- let pat_cond_75 kl_V1439htht kl_V1439hthth kl_V1439hthtt = do let !appl_76 = Atom Nil + !kl_if_77 <- appl_76 `pseq` (kl_V1439hthtt `pseq` eq appl_76 kl_V1439hthtt) + !kl_if_78 <- case kl_if_77 of + Atom (B (True)) -> do let !appl_79 = Atom Nil + !kl_if_80 <- appl_79 `pseq` (kl_V1439htt `pseq` eq appl_79 kl_V1439htt) + case kl_if_80 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_78 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_81 = do do return (Atom (B False)) + in case kl_V1439htht of + !(kl_V1439htht@(Cons (!kl_V1439hthth) + (!kl_V1439hthtt))) -> pat_cond_75 kl_V1439htht kl_V1439hthth kl_V1439hthtt + _ -> pat_cond_81 + 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" + pat_cond_82 = do do return (Atom (B False)) + in case kl_V1439hthh of + kl_V1439hthh@(Atom (UnboundSym "shen.choicepoint!")) -> pat_cond_73 + kl_V1439hthh@(ApplC (PL "shen.choicepoint!" + _)) -> pat_cond_73 + kl_V1439hthh@(ApplC (Func "shen.choicepoint!" + _)) -> pat_cond_73 + _ -> pat_cond_82 + case kl_if_72 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_83 = do do return (Atom (B False)) + in case kl_V1439hth of + !(kl_V1439hth@(Cons (!kl_V1439hthh) + (!kl_V1439htht))) -> pat_cond_71 kl_V1439hth kl_V1439hthh kl_V1439htht + _ -> pat_cond_83 + case kl_if_70 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_84 = do do return (Atom (B False)) + in case kl_V1439ht of + !(kl_V1439ht@(Cons (!kl_V1439hth) + (!kl_V1439htt))) -> pat_cond_69 kl_V1439ht kl_V1439hth kl_V1439htt + _ -> pat_cond_84 + case kl_if_68 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_85 = do do return (Atom (B False)) + in case kl_V1439hh of + kl_V1439hh@(Atom (UnboundSym "true")) -> pat_cond_67 + kl_V1439hh@(Atom (B (True))) -> pat_cond_67 + _ -> pat_cond_85 + case kl_if_66 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_86 = do do return (Atom (B False)) + in case kl_V1439h of + !(kl_V1439h@(Cons (!kl_V1439hh) + (!kl_V1439ht))) -> pat_cond_65 kl_V1439h kl_V1439hh kl_V1439ht + _ -> pat_cond_86 + case kl_if_64 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_87 = do do return (Atom (B False)) + in case kl_V1439 of + !(kl_V1439@(Cons (!kl_V1439h) + (!kl_V1439t))) -> pat_cond_63 kl_V1439 kl_V1439h kl_V1439t + _ -> pat_cond_87 + case kl_if_62 of + Atom (B (True)) -> do !appl_88 <- kl_V1439 `pseq` hd kl_V1439 + !appl_89 <- appl_88 `pseq` tl appl_88 + !appl_90 <- appl_89 `pseq` hd appl_89 + !appl_91 <- appl_90 `pseq` tl appl_90 + !appl_92 <- appl_91 `pseq` hd appl_91 + let !appl_93 = Atom Nil + !appl_94 <- appl_93 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "fail")) appl_93 + let !appl_95 = Atom Nil + !appl_96 <- appl_94 `pseq` (appl_95 `pseq` klCons appl_94 appl_95) + !appl_97 <- appl_96 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_96 + !appl_98 <- appl_97 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_97 + !appl_99 <- kl_V1439 `pseq` tl kl_V1439 + !appl_100 <- appl_99 `pseq` (kl_V1440 `pseq` kl_shen_encode_choices appl_99 kl_V1440) + !appl_101 <- appl_100 `pseq` kl_shen_cond_form appl_100 + let !appl_102 = Atom Nil + !appl_103 <- appl_102 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_102 + !appl_104 <- appl_101 `pseq` (appl_103 `pseq` klCons appl_101 appl_103) + !appl_105 <- appl_98 `pseq` (appl_104 `pseq` klCons appl_98 appl_104) + !appl_106 <- appl_105 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_105 + let !appl_107 = Atom Nil + !appl_108 <- appl_106 `pseq` (appl_107 `pseq` klCons appl_106 appl_107) + !appl_109 <- appl_92 `pseq` (appl_108 `pseq` klCons appl_92 appl_108) + !appl_110 <- appl_109 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_109 + !appl_111 <- appl_110 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_110 + let !appl_112 = Atom Nil + !appl_113 <- appl_111 `pseq` (appl_112 `pseq` klCons appl_111 appl_112) + !appl_114 <- appl_113 `pseq` klCons (Atom (B True)) appl_113 + let !appl_115 = Atom Nil + appl_114 `pseq` (appl_115 `pseq` klCons appl_114 appl_115) + Atom (B (False)) -> do !kl_if_116 <- let pat_cond_117 kl_V1439 kl_V1439h kl_V1439t = do !kl_if_118 <- let pat_cond_119 kl_V1439h kl_V1439hh kl_V1439ht = do !kl_if_120 <- let pat_cond_121 kl_V1439ht kl_V1439hth kl_V1439htt = do !kl_if_122 <- let pat_cond_123 kl_V1439hth kl_V1439hthh kl_V1439htht = do !kl_if_124 <- let pat_cond_125 = do !kl_if_126 <- let pat_cond_127 kl_V1439htht kl_V1439hthth kl_V1439hthtt = do let !appl_128 = Atom Nil + !kl_if_129 <- appl_128 `pseq` (kl_V1439hthtt `pseq` eq appl_128 kl_V1439hthtt) + !kl_if_130 <- case kl_if_129 of + Atom (B (True)) -> do let !appl_131 = Atom Nil + !kl_if_132 <- appl_131 `pseq` (kl_V1439htt `pseq` eq appl_131 kl_V1439htt) + case kl_if_132 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_130 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_133 = do do return (Atom (B False)) + in case kl_V1439htht of + !(kl_V1439htht@(Cons (!kl_V1439hthth) + (!kl_V1439hthtt))) -> pat_cond_127 kl_V1439htht kl_V1439hthth kl_V1439hthtt + _ -> pat_cond_133 + case kl_if_126 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_134 = do do return (Atom (B False)) + in case kl_V1439hthh of + kl_V1439hthh@(Atom (UnboundSym "shen.choicepoint!")) -> pat_cond_125 + kl_V1439hthh@(ApplC (PL "shen.choicepoint!" + _)) -> pat_cond_125 + kl_V1439hthh@(ApplC (Func "shen.choicepoint!" + _)) -> pat_cond_125 + _ -> pat_cond_134 + case kl_if_124 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_135 = do do return (Atom (B False)) + in case kl_V1439hth of + !(kl_V1439hth@(Cons (!kl_V1439hthh) + (!kl_V1439htht))) -> pat_cond_123 kl_V1439hth kl_V1439hthh kl_V1439htht + _ -> pat_cond_135 + case kl_if_122 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_136 = do do return (Atom (B False)) + in case kl_V1439ht of + !(kl_V1439ht@(Cons (!kl_V1439hth) + (!kl_V1439htt))) -> pat_cond_121 kl_V1439ht kl_V1439hth kl_V1439htt + _ -> pat_cond_136 + case kl_if_120 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_137 = do do return (Atom (B False)) + in case kl_V1439h of + !(kl_V1439h@(Cons (!kl_V1439hh) + (!kl_V1439ht))) -> pat_cond_119 kl_V1439h kl_V1439hh kl_V1439ht + _ -> pat_cond_137 + case kl_if_118 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_138 = do do return (Atom (B False)) + in case kl_V1439 of + !(kl_V1439@(Cons (!kl_V1439h) + (!kl_V1439t))) -> pat_cond_117 kl_V1439 kl_V1439h kl_V1439t + _ -> pat_cond_138 + case kl_if_116 of + Atom (B (True)) -> do !appl_139 <- kl_V1439 `pseq` tl kl_V1439 + !appl_140 <- appl_139 `pseq` (kl_V1440 `pseq` kl_shen_encode_choices appl_139 kl_V1440) + !appl_141 <- appl_140 `pseq` kl_shen_cond_form appl_140 + let !appl_142 = Atom Nil + !appl_143 <- appl_141 `pseq` (appl_142 `pseq` klCons appl_141 appl_142) + !appl_144 <- appl_143 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "freeze")) appl_143 + !appl_145 <- kl_V1439 `pseq` hd kl_V1439 + !appl_146 <- appl_145 `pseq` hd appl_145 + !appl_147 <- kl_V1439 `pseq` hd kl_V1439 + !appl_148 <- appl_147 `pseq` tl appl_147 + !appl_149 <- appl_148 `pseq` hd appl_148 + !appl_150 <- appl_149 `pseq` tl appl_149 + !appl_151 <- appl_150 `pseq` hd appl_150 + let !appl_152 = Atom Nil + !appl_153 <- appl_152 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "fail")) appl_152 + let !appl_154 = Atom Nil + !appl_155 <- appl_153 `pseq` (appl_154 `pseq` klCons appl_153 appl_154) + !appl_156 <- appl_155 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_155 + !appl_157 <- appl_156 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_156 + let !appl_158 = Atom Nil + !appl_159 <- appl_158 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Freeze")) appl_158 + !appl_160 <- appl_159 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "thaw")) appl_159 + let !appl_161 = Atom Nil + !appl_162 <- appl_161 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_161 + !appl_163 <- appl_160 `pseq` (appl_162 `pseq` klCons appl_160 appl_162) + !appl_164 <- appl_157 `pseq` (appl_163 `pseq` klCons appl_157 appl_163) + !appl_165 <- appl_164 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_164 + let !appl_166 = Atom Nil + !appl_167 <- appl_165 `pseq` (appl_166 `pseq` klCons appl_165 appl_166) + !appl_168 <- appl_151 `pseq` (appl_167 `pseq` klCons appl_151 appl_167) + !appl_169 <- appl_168 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_168 + !appl_170 <- appl_169 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_169 + let !appl_171 = Atom Nil + !appl_172 <- appl_171 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Freeze")) appl_171 + !appl_173 <- appl_172 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "thaw")) appl_172 + let !appl_174 = Atom Nil + !appl_175 <- appl_173 `pseq` (appl_174 `pseq` klCons appl_173 appl_174) + !appl_176 <- appl_170 `pseq` (appl_175 `pseq` klCons appl_170 appl_175) + !appl_177 <- appl_146 `pseq` (appl_176 `pseq` klCons appl_146 appl_176) + !appl_178 <- appl_177 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_177 + let !appl_179 = Atom Nil + !appl_180 <- appl_178 `pseq` (appl_179 `pseq` klCons appl_178 appl_179) + !appl_181 <- appl_144 `pseq` (appl_180 `pseq` klCons appl_144 appl_180) + !appl_182 <- appl_181 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Freeze")) appl_181 + !appl_183 <- appl_182 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_182 + let !appl_184 = Atom Nil + !appl_185 <- appl_183 `pseq` (appl_184 `pseq` klCons appl_183 appl_184) + !appl_186 <- appl_185 `pseq` klCons (Atom (B True)) appl_185 + let !appl_187 = Atom Nil + appl_186 `pseq` (appl_187 `pseq` klCons appl_186 appl_187) + Atom (B (False)) -> do !kl_if_188 <- let pat_cond_189 kl_V1439 kl_V1439h kl_V1439t = do !kl_if_190 <- let pat_cond_191 kl_V1439h kl_V1439hh kl_V1439ht = do !kl_if_192 <- let pat_cond_193 kl_V1439ht kl_V1439hth kl_V1439htt = do let !appl_194 = Atom Nil + !kl_if_195 <- appl_194 `pseq` (kl_V1439htt `pseq` eq appl_194 kl_V1439htt) + case kl_if_195 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_196 = do do return (Atom (B False)) + in case kl_V1439ht of + !(kl_V1439ht@(Cons (!kl_V1439hth) + (!kl_V1439htt))) -> pat_cond_193 kl_V1439ht kl_V1439hth kl_V1439htt + _ -> pat_cond_196 + case kl_if_192 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_197 = do do return (Atom (B False)) + in case kl_V1439h of + !(kl_V1439h@(Cons (!kl_V1439hh) + (!kl_V1439ht))) -> pat_cond_191 kl_V1439h kl_V1439hh kl_V1439ht + _ -> pat_cond_197 + case kl_if_190 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_198 = do do return (Atom (B False)) + in case kl_V1439 of + !(kl_V1439@(Cons (!kl_V1439h) + (!kl_V1439t))) -> pat_cond_189 kl_V1439 kl_V1439h kl_V1439t + _ -> pat_cond_198 + case kl_if_188 of + Atom (B (True)) -> do !appl_199 <- kl_V1439 `pseq` hd kl_V1439 + !appl_200 <- kl_V1439 `pseq` tl kl_V1439 + !appl_201 <- appl_200 `pseq` (kl_V1440 `pseq` kl_shen_encode_choices appl_200 kl_V1440) + appl_199 `pseq` (appl_201 `pseq` klCons appl_199 appl_201) + Atom (B (False)) -> do do let !aw_202 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_202 [ApplC (wrapNamed "shen.encode-choices" kl_shen_encode_choices)] + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_case_form :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_case_form (!kl_V1447) (!kl_V1448) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1447 `pseq` eq appl_0 kl_V1447) + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = Atom Nil + kl_V1448 `pseq` (appl_2 `pseq` klCons kl_V1448 appl_2) + Atom (B (False)) -> do !kl_if_3 <- let pat_cond_4 kl_V1447 kl_V1447h kl_V1447t = do !kl_if_5 <- let pat_cond_6 kl_V1447h kl_V1447hh kl_V1447ht = do !kl_if_7 <- let pat_cond_8 kl_V1447hh kl_V1447hhh kl_V1447hht = do !kl_if_9 <- let pat_cond_10 = do !kl_if_11 <- let pat_cond_12 kl_V1447hht kl_V1447hhth kl_V1447hhtt = do !kl_if_13 <- let pat_cond_14 = do let !appl_15 = Atom Nil + !kl_if_16 <- appl_15 `pseq` (kl_V1447hhtt `pseq` eq appl_15 kl_V1447hhtt) + !kl_if_17 <- case kl_if_16 of + Atom (B (True)) -> do !kl_if_18 <- let pat_cond_19 kl_V1447ht kl_V1447hth kl_V1447htt = do !kl_if_20 <- let pat_cond_21 kl_V1447hth kl_V1447hthh kl_V1447htht = do !kl_if_22 <- let pat_cond_23 = do !kl_if_24 <- let pat_cond_25 kl_V1447htht kl_V1447hthth kl_V1447hthtt = do let !appl_26 = Atom Nil + !kl_if_27 <- appl_26 `pseq` (kl_V1447hthtt `pseq` eq appl_26 kl_V1447hthtt) + !kl_if_28 <- case kl_if_27 of + Atom (B (True)) -> do let !appl_29 = Atom Nil + !kl_if_30 <- appl_29 `pseq` (kl_V1447htt `pseq` eq appl_29 kl_V1447htt) + case kl_if_30 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_28 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_31 = do do return (Atom (B False)) + in case kl_V1447htht of + !(kl_V1447htht@(Cons (!kl_V1447hthth) + (!kl_V1447hthtt))) -> pat_cond_25 kl_V1447htht kl_V1447hthth kl_V1447hthtt + _ -> pat_cond_31 + case kl_if_24 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_V1447hthh of + kl_V1447hthh@(Atom (UnboundSym "shen.choicepoint!")) -> pat_cond_23 + kl_V1447hthh@(ApplC (PL "shen.choicepoint!" + _)) -> pat_cond_23 + kl_V1447hthh@(ApplC (Func "shen.choicepoint!" + _)) -> pat_cond_23 + _ -> pat_cond_32 + case kl_if_22 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_V1447hth of + !(kl_V1447hth@(Cons (!kl_V1447hthh) + (!kl_V1447htht))) -> pat_cond_21 kl_V1447hth kl_V1447hthh kl_V1447htht + _ -> pat_cond_33 + case kl_if_20 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_V1447ht of + !(kl_V1447ht@(Cons (!kl_V1447hth) + (!kl_V1447htt))) -> pat_cond_19 kl_V1447ht kl_V1447hth kl_V1447htt + _ -> pat_cond_34 + case kl_if_18 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_17 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_35 = do do return (Atom (B False)) + in case kl_V1447hhth of + kl_V1447hhth@(Atom (UnboundSym "shen.tests")) -> pat_cond_14 + kl_V1447hhth@(ApplC (PL "shen.tests" + _)) -> pat_cond_14 + kl_V1447hhth@(ApplC (Func "shen.tests" + _)) -> pat_cond_14 + _ -> pat_cond_35 + 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_36 = do do return (Atom (B False)) + in case kl_V1447hht of + !(kl_V1447hht@(Cons (!kl_V1447hhth) + (!kl_V1447hhtt))) -> pat_cond_12 kl_V1447hht kl_V1447hhth kl_V1447hhtt + _ -> pat_cond_36 + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_37 = do do return (Atom (B False)) + in case kl_V1447hhh of + kl_V1447hhh@(Atom (UnboundSym ":")) -> pat_cond_10 + kl_V1447hhh@(ApplC (PL ":" + _)) -> pat_cond_10 + kl_V1447hhh@(ApplC (Func ":" + _)) -> pat_cond_10 + _ -> pat_cond_37 + 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_38 = do do return (Atom (B False)) + in case kl_V1447hh of + !(kl_V1447hh@(Cons (!kl_V1447hhh) + (!kl_V1447hht))) -> pat_cond_8 kl_V1447hh kl_V1447hhh kl_V1447hht + _ -> pat_cond_38 + 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_39 = do do return (Atom (B False)) + in case kl_V1447h of + !(kl_V1447h@(Cons (!kl_V1447hh) + (!kl_V1447ht))) -> pat_cond_6 kl_V1447h kl_V1447hh kl_V1447ht + _ -> pat_cond_39 + 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_40 = do do return (Atom (B False)) + in case kl_V1447 of + !(kl_V1447@(Cons (!kl_V1447h) + (!kl_V1447t))) -> pat_cond_4 kl_V1447 kl_V1447h kl_V1447t + _ -> pat_cond_40 + case kl_if_3 of + Atom (B (True)) -> do !appl_41 <- kl_V1447 `pseq` hd kl_V1447 + !appl_42 <- appl_41 `pseq` tl appl_41 + !appl_43 <- appl_42 `pseq` klCons (Atom (B True)) appl_42 + !appl_44 <- kl_V1447 `pseq` tl kl_V1447 + !appl_45 <- appl_44 `pseq` (kl_V1448 `pseq` kl_shen_case_form appl_44 kl_V1448) + appl_43 `pseq` (appl_45 `pseq` klCons appl_43 appl_45) + Atom (B (False)) -> do !kl_if_46 <- let pat_cond_47 kl_V1447 kl_V1447h kl_V1447t = do !kl_if_48 <- let pat_cond_49 kl_V1447h kl_V1447hh kl_V1447ht = do !kl_if_50 <- let pat_cond_51 kl_V1447hh kl_V1447hhh kl_V1447hht = do !kl_if_52 <- let pat_cond_53 = do !kl_if_54 <- let pat_cond_55 kl_V1447hht kl_V1447hhth kl_V1447hhtt = do !kl_if_56 <- let pat_cond_57 = do let !appl_58 = Atom Nil + !kl_if_59 <- appl_58 `pseq` (kl_V1447hhtt `pseq` eq appl_58 kl_V1447hhtt) + !kl_if_60 <- case kl_if_59 of + Atom (B (True)) -> do !kl_if_61 <- let pat_cond_62 kl_V1447ht kl_V1447hth kl_V1447htt = do let !appl_63 = Atom Nil + !kl_if_64 <- appl_63 `pseq` (kl_V1447htt `pseq` eq appl_63 kl_V1447htt) + case kl_if_64 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_65 = do do return (Atom (B False)) + in case kl_V1447ht of + !(kl_V1447ht@(Cons (!kl_V1447hth) + (!kl_V1447htt))) -> pat_cond_62 kl_V1447ht kl_V1447hth kl_V1447htt + _ -> pat_cond_65 + case kl_if_61 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + 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" + pat_cond_66 = do do return (Atom (B False)) + in case kl_V1447hhth of + kl_V1447hhth@(Atom (UnboundSym "shen.tests")) -> pat_cond_57 + kl_V1447hhth@(ApplC (PL "shen.tests" + _)) -> pat_cond_57 + kl_V1447hhth@(ApplC (Func "shen.tests" + _)) -> pat_cond_57 + _ -> pat_cond_66 + case kl_if_56 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_67 = do do return (Atom (B False)) + in case kl_V1447hht of + !(kl_V1447hht@(Cons (!kl_V1447hhth) + (!kl_V1447hhtt))) -> pat_cond_55 kl_V1447hht kl_V1447hhth kl_V1447hhtt + _ -> pat_cond_67 + case kl_if_54 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_68 = do do return (Atom (B False)) + in case kl_V1447hhh of + kl_V1447hhh@(Atom (UnboundSym ":")) -> pat_cond_53 + kl_V1447hhh@(ApplC (PL ":" + _)) -> pat_cond_53 + kl_V1447hhh@(ApplC (Func ":" + _)) -> pat_cond_53 + _ -> pat_cond_68 + case kl_if_52 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_69 = do do return (Atom (B False)) + in case kl_V1447hh of + !(kl_V1447hh@(Cons (!kl_V1447hhh) + (!kl_V1447hht))) -> pat_cond_51 kl_V1447hh kl_V1447hhh kl_V1447hht + _ -> pat_cond_69 + case kl_if_50 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_70 = do do return (Atom (B False)) + in case kl_V1447h of + !(kl_V1447h@(Cons (!kl_V1447hh) + (!kl_V1447ht))) -> pat_cond_49 kl_V1447h kl_V1447hh kl_V1447ht + _ -> pat_cond_70 + case kl_if_48 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_71 = do do return (Atom (B False)) + in case kl_V1447 of + !(kl_V1447@(Cons (!kl_V1447h) + (!kl_V1447t))) -> pat_cond_47 kl_V1447 kl_V1447h kl_V1447t + _ -> pat_cond_71 + case kl_if_46 of + Atom (B (True)) -> do !appl_72 <- kl_V1447 `pseq` hd kl_V1447 + !appl_73 <- appl_72 `pseq` tl appl_72 + !appl_74 <- appl_73 `pseq` klCons (Atom (B True)) appl_73 + let !appl_75 = Atom Nil + appl_74 `pseq` (appl_75 `pseq` klCons appl_74 appl_75) + Atom (B (False)) -> do !kl_if_76 <- let pat_cond_77 kl_V1447 kl_V1447h kl_V1447t = do !kl_if_78 <- let pat_cond_79 kl_V1447h kl_V1447hh kl_V1447ht = do !kl_if_80 <- let pat_cond_81 kl_V1447hh kl_V1447hhh kl_V1447hht = do !kl_if_82 <- let pat_cond_83 = do !kl_if_84 <- let pat_cond_85 kl_V1447hht kl_V1447hhth kl_V1447hhtt = do !kl_if_86 <- let pat_cond_87 = do !kl_if_88 <- let pat_cond_89 kl_V1447ht kl_V1447hth kl_V1447htt = do let !appl_90 = Atom Nil + !kl_if_91 <- appl_90 `pseq` (kl_V1447htt `pseq` eq appl_90 kl_V1447htt) + 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_92 = do do return (Atom (B False)) + in case kl_V1447ht of + !(kl_V1447ht@(Cons (!kl_V1447hth) + (!kl_V1447htt))) -> pat_cond_89 kl_V1447ht kl_V1447hth kl_V1447htt + _ -> pat_cond_92 + case kl_if_88 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_93 = do do return (Atom (B False)) + in case kl_V1447hhth of + kl_V1447hhth@(Atom (UnboundSym "shen.tests")) -> pat_cond_87 + kl_V1447hhth@(ApplC (PL "shen.tests" + _)) -> pat_cond_87 + kl_V1447hhth@(ApplC (Func "shen.tests" + _)) -> pat_cond_87 + _ -> pat_cond_93 + case kl_if_86 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_94 = do do return (Atom (B False)) + in case kl_V1447hht of + !(kl_V1447hht@(Cons (!kl_V1447hhth) + (!kl_V1447hhtt))) -> pat_cond_85 kl_V1447hht kl_V1447hhth kl_V1447hhtt + _ -> pat_cond_94 + case kl_if_84 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_95 = do do return (Atom (B False)) + in case kl_V1447hhh of + kl_V1447hhh@(Atom (UnboundSym ":")) -> pat_cond_83 + kl_V1447hhh@(ApplC (PL ":" + _)) -> pat_cond_83 + kl_V1447hhh@(ApplC (Func ":" + _)) -> pat_cond_83 + _ -> pat_cond_95 + case kl_if_82 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_96 = do do return (Atom (B False)) + in case kl_V1447hh of + !(kl_V1447hh@(Cons (!kl_V1447hhh) + (!kl_V1447hht))) -> pat_cond_81 kl_V1447hh kl_V1447hhh kl_V1447hht + _ -> pat_cond_96 + case kl_if_80 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_97 = do do return (Atom (B False)) + in case kl_V1447h of + !(kl_V1447h@(Cons (!kl_V1447hh) + (!kl_V1447ht))) -> pat_cond_79 kl_V1447h kl_V1447hh kl_V1447ht + _ -> pat_cond_97 + case kl_if_78 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_98 = do do return (Atom (B False)) + in case kl_V1447 of + !(kl_V1447@(Cons (!kl_V1447h) + (!kl_V1447t))) -> pat_cond_77 kl_V1447 kl_V1447h kl_V1447t + _ -> pat_cond_98 + case kl_if_76 of + Atom (B (True)) -> do !appl_99 <- kl_V1447 `pseq` hd kl_V1447 + !appl_100 <- appl_99 `pseq` hd appl_99 + !appl_101 <- appl_100 `pseq` tl appl_100 + !appl_102 <- appl_101 `pseq` tl appl_101 + !appl_103 <- appl_102 `pseq` kl_shen_embed_and appl_102 + !appl_104 <- kl_V1447 `pseq` hd kl_V1447 + !appl_105 <- appl_104 `pseq` tl appl_104 + !appl_106 <- appl_103 `pseq` (appl_105 `pseq` klCons appl_103 appl_105) + !appl_107 <- kl_V1447 `pseq` tl kl_V1447 + !appl_108 <- appl_107 `pseq` (kl_V1448 `pseq` kl_shen_case_form appl_107 kl_V1448) + appl_106 `pseq` (appl_108 `pseq` klCons appl_106 appl_108) + Atom (B (False)) -> do do let !aw_109 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_109 [ApplC (wrapNamed "shen.case-form" kl_shen_case_form)] + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_embed_and :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_embed_and (!kl_V1450) = do !kl_if_0 <- let pat_cond_1 kl_V1450 kl_V1450h kl_V1450t = do let !appl_2 = Atom Nil + !kl_if_3 <- appl_2 `pseq` (kl_V1450t `pseq` eq appl_2 kl_V1450t) + case kl_if_3 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_4 = do do return (Atom (B False)) + in case kl_V1450 of + !(kl_V1450@(Cons (!kl_V1450h) + (!kl_V1450t))) -> pat_cond_1 kl_V1450 kl_V1450h kl_V1450t + _ -> pat_cond_4 + case kl_if_0 of + Atom (B (True)) -> do kl_V1450 `pseq` hd kl_V1450 + Atom (B (False)) -> do let pat_cond_5 kl_V1450 kl_V1450h kl_V1450t = do !appl_6 <- kl_V1450t `pseq` kl_shen_embed_and kl_V1450t + let !appl_7 = Atom Nil + !appl_8 <- appl_6 `pseq` (appl_7 `pseq` klCons appl_6 appl_7) + !appl_9 <- kl_V1450h `pseq` (appl_8 `pseq` klCons kl_V1450h appl_8) + appl_9 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "and")) appl_9 + pat_cond_10 = do do let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_11 [ApplC (wrapNamed "shen.embed-and" kl_shen_embed_and)] + in case kl_V1450 of + !(kl_V1450@(Cons (!kl_V1450h) + (!kl_V1450t))) -> pat_cond_5 kl_V1450 kl_V1450h kl_V1450t + _ -> pat_cond_10 + _ -> throwError "if: expected boolean" + +kl_shen_err_condition :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_err_condition (!kl_V1452) = do let !appl_0 = Atom Nil + !appl_1 <- kl_V1452 `pseq` (appl_0 `pseq` klCons kl_V1452 appl_0) + !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.f_error")) appl_1 + let !appl_3 = Atom Nil + !appl_4 <- appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) + appl_4 `pseq` klCons (Atom (B True)) appl_4 + +kl_shen_sys_error :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_sys_error (!kl_V1454) = do let !aw_0 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_1 <- kl_V1454 `pseq` applyWrapper aw_0 [kl_V1454, + Core.Types.Atom (Core.Types.Str ": unexpected argument\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_2 <- appl_1 `pseq` cn (Core.Types.Atom (Core.Types.Str "system function ")) appl_1 + appl_2 `pseq` simpleError appl_2 + +expr1 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr1 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Backend/Declarations.hs b/Shentong/Backend/Declarations.hs --- a/Shentong/Backend/Declarations.hs +++ b/Shentong/Backend/Declarations.hs @@ -1,866 +1,1021 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} - -module Backend.Declarations 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 -import Backend.Core -import Backend.Sys -import Backend.Sequent -import Backend.Yacc -import Backend.Reader -import Backend.Prolog -import Backend.Track -import Backend.Load -import Backend.Writer -import Backend.Macros - -{- -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_initialise_arity_table :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_initialise_arity_table (!kl_V1456) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V1456 kl_V1456h kl_V1456t kl_V1456th kl_V1456tt = do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_DecArity) -> do kl_V1456tt `pseq` kl_shen_initialise_arity_table kl_V1456tt))) - !appl_3 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - !appl_4 <- kl_V1456h `pseq` (kl_V1456th `pseq` (appl_3 `pseq` kl_put kl_V1456h (ApplC (wrapNamed "arity" kl_arity)) kl_V1456th appl_3)) - appl_4 `pseq` applyWrapper appl_2 [appl_4] - pat_cond_5 = do do kl_shen_f_error (ApplC (wrapNamed "shen.initialise_arity_table" kl_shen_initialise_arity_table)) - in case kl_V1456 of - kl_V1456@(Atom (Nil)) -> pat_cond_0 - !(kl_V1456@(Cons (!kl_V1456h) - (!(kl_V1456t@(Cons (!kl_V1456th) - (!kl_V1456tt)))))) -> pat_cond_1 kl_V1456 kl_V1456h kl_V1456t kl_V1456th kl_V1456tt - _ -> pat_cond_5 - -kl_arity :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_arity (!kl_V1458) = do (do !appl_0 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - kl_V1458 `pseq` (appl_0 `pseq` kl_get kl_V1458 (ApplC (wrapNamed "arity" kl_arity)) appl_0)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.N (Types.KI (-1))))) - -kl_systemf :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_systemf (!kl_V1460) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Shen) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_External) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Place) -> do return kl_V1460))) - !appl_3 <- kl_V1460 `pseq` (kl_External `pseq` kl_adjoin kl_V1460 kl_External) - !appl_4 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - !appl_5 <- kl_Shen `pseq` (appl_3 `pseq` (appl_4 `pseq` kl_put kl_Shen (Types.Atom (Types.UnboundSym "shen.external-symbols")) appl_3 appl_4)) - appl_5 `pseq` applyWrapper appl_2 [appl_5]))) - !appl_6 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - !appl_7 <- kl_Shen `pseq` (appl_6 `pseq` kl_get kl_Shen (Types.Atom (Types.UnboundSym "shen.external-symbols")) appl_6) - appl_7 `pseq` applyWrapper appl_1 [appl_7]))) - !appl_8 <- intern (Types.Atom (Types.Str "shen")) - appl_8 `pseq` applyWrapper appl_0 [appl_8] - -kl_adjoin :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_adjoin (!kl_V1463) (!kl_V1464) = do !kl_if_0 <- kl_V1463 `pseq` (kl_V1464 `pseq` kl_elementP kl_V1463 kl_V1464) - case kl_if_0 of - Atom (B (True)) -> do return kl_V1464 - Atom (B (False)) -> do do kl_V1463 `pseq` (kl_V1464 `pseq` klCons kl_V1463 kl_V1464) - _ -> throwError "if: expected boolean" - -kl_shen_symbol_table_entry :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_symbol_table_entry (!kl_V1466) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_ArityF) -> do let pat_cond_1 = do return (Types.Atom Types.Nil) - pat_cond_2 = do do let pat_cond_3 = do return (Types.Atom Types.Nil) - pat_cond_4 = do do !appl_5 <- kl_V1466 `pseq` (kl_ArityF `pseq` kl_shen_lambda_form kl_V1466 kl_ArityF) - !appl_6 <- appl_5 `pseq` evalKL appl_5 - !appl_7 <- kl_V1466 `pseq` (appl_6 `pseq` klCons kl_V1466 appl_6) - appl_7 `pseq` klCons appl_7 (Types.Atom Types.Nil) - in case kl_ArityF of - kl_ArityF@(Atom (N (KI 0))) -> pat_cond_3 - _ -> pat_cond_4 - in case kl_ArityF of - kl_ArityF@(Atom (N (KI (-1)))) -> pat_cond_1 - _ -> pat_cond_2))) - !appl_8 <- kl_V1466 `pseq` kl_arity kl_V1466 - appl_8 `pseq` applyWrapper appl_0 [appl_8] - -kl_shen_lambda_form :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_lambda_form (!kl_V1469) (!kl_V1470) = do let pat_cond_0 = do return kl_V1469 - pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_3 <- kl_V1469 `pseq` (kl_X `pseq` kl_shen_add_end kl_V1469 kl_X) - !appl_4 <- kl_V1470 `pseq` Primitives.subtract kl_V1470 (Types.Atom (Types.N (Types.KI 1))) - !appl_5 <- appl_3 `pseq` (appl_4 `pseq` kl_shen_lambda_form appl_3 appl_4) - !appl_6 <- appl_5 `pseq` klCons appl_5 (Types.Atom Types.Nil) - !appl_7 <- kl_X `pseq` (appl_6 `pseq` klCons kl_X appl_6) - appl_7 `pseq` klCons (Types.Atom (Types.UnboundSym "lambda")) appl_7))) - !appl_8 <- kl_gensym (Types.Atom (Types.UnboundSym "V")) - appl_8 `pseq` applyWrapper appl_2 [appl_8] - in case kl_V1470 of - kl_V1470@(Atom (N (KI 0))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_add_end :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_add_end (!kl_V1473) (!kl_V1474) = do let pat_cond_0 kl_V1473 kl_V1473h kl_V1473t = do !appl_1 <- kl_V1474 `pseq` klCons kl_V1474 (Types.Atom Types.Nil) - kl_V1473 `pseq` (appl_1 `pseq` kl_append kl_V1473 appl_1) - pat_cond_2 = do do !appl_3 <- kl_V1474 `pseq` klCons kl_V1474 (Types.Atom Types.Nil) - kl_V1473 `pseq` (appl_3 `pseq` klCons kl_V1473 appl_3) - in case kl_V1473 of - !(kl_V1473@(Cons (!kl_V1473h) - (!kl_V1473t))) -> pat_cond_0 kl_V1473 kl_V1473h kl_V1473t - _ -> pat_cond_2 - -kl_specialise :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_specialise (!kl_V1476) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*special*")) - !appl_1 <- kl_V1476 `pseq` (appl_0 `pseq` klCons kl_V1476 appl_0) - !appl_2 <- appl_1 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*special*")) appl_1 - appl_2 `pseq` (kl_V1476 `pseq` kl_do appl_2 kl_V1476) - -kl_unspecialise :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_unspecialise (!kl_V1478) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*special*")) - !appl_1 <- kl_V1478 `pseq` (appl_0 `pseq` kl_remove kl_V1478 appl_0) - !appl_2 <- appl_1 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*special*")) appl_1 - appl_2 `pseq` (kl_V1478 `pseq` kl_do appl_2 kl_V1478) - -expr11 :: Types.KLContext Types.Env Types.KLValue -expr11 = 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"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*installing-kl*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*history*")) (Types.Atom Types.Nil)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*tc*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_0 <- kl_vector (Types.Atom (Types.N (Types.KI 20000))) - appl_0 `pseq` klSet (Types.Atom (Types.UnboundSym "*property-vector*")) appl_0) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*process-counter*")) (Types.Atom (Types.N (Types.KI 0)))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_1 <- kl_vector (Types.Atom (Types.N (Types.KI 1000))) - appl_1 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*varcounter*")) appl_1) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_2 <- kl_vector (Types.Atom (Types.N (Types.KI 1000))) - appl_2 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*prologvectors*")) appl_2) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_3 <- klCons (ApplC (wrapNamed "shen.function-macro" kl_shen_function_macro)) (Types.Atom Types.Nil) - !appl_4 <- appl_3 `pseq` klCons (ApplC (wrapNamed "shen.defprolog-macro" kl_shen_defprolog_macro)) appl_3 - !appl_5 <- appl_4 `pseq` klCons (ApplC (wrapNamed "shen.@s-macro" kl_shen_Ats_macro)) appl_4 - !appl_6 <- appl_5 `pseq` klCons (ApplC (wrapNamed "shen.nl-macro" kl_shen_nl_macro)) appl_5 - !appl_7 <- appl_6 `pseq` klCons (ApplC (wrapNamed "shen.synonyms-macro" kl_shen_synonyms_macro)) appl_6 - !appl_8 <- appl_7 `pseq` klCons (ApplC (wrapNamed "shen.prolog-macro" kl_shen_prolog_macro)) appl_7 - !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "shen.error-macro" kl_shen_error_macro)) appl_8 - !appl_10 <- appl_9 `pseq` klCons (ApplC (wrapNamed "shen.input-macro" kl_shen_input_macro)) appl_9 - !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "shen.output-macro" kl_shen_output_macro)) appl_10 - !appl_12 <- appl_11 `pseq` klCons (ApplC (wrapNamed "shen.make-string-macro" kl_shen_make_string_macro)) appl_11 - !appl_13 <- appl_12 `pseq` klCons (ApplC (wrapNamed "shen.assoc-macro" kl_shen_assoc_macro)) appl_12 - !appl_14 <- appl_13 `pseq` klCons (ApplC (wrapNamed "shen.let-macro" kl_shen_let_macro)) appl_13 - !appl_15 <- appl_14 `pseq` klCons (ApplC (wrapNamed "shen.datatype-macro" kl_shen_datatype_macro)) appl_14 - !appl_16 <- appl_15 `pseq` klCons (ApplC (wrapNamed "shen.compile-macro" kl_shen_compile_macro)) appl_15 - !appl_17 <- appl_16 `pseq` klCons (ApplC (wrapNamed "shen.put/get-macro" kl_shen_putDivget_macro)) appl_16 - !appl_18 <- appl_17 `pseq` klCons (ApplC (wrapNamed "shen.abs-macro" kl_shen_abs_macro)) appl_17 - !appl_19 <- appl_18 `pseq` klCons (ApplC (wrapNamed "shen.cases-macro" kl_shen_cases_macro)) appl_18 - !appl_20 <- appl_19 `pseq` klCons (ApplC (wrapNamed "shen.timer-macro" kl_shen_timer_macro)) appl_19 - appl_20 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*macroreg*")) appl_20) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do let !appl_21 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_timer_macro kl_X))) - let !appl_22 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_cases_macro kl_X))) - let !appl_23 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_abs_macro kl_X))) - let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_putDivget_macro kl_X))) - let !appl_25 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_compile_macro kl_X))) - let !appl_26 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_datatype_macro kl_X))) - let !appl_27 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_let_macro kl_X))) - let !appl_28 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_assoc_macro kl_X))) - let !appl_29 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_make_string_macro kl_X))) - let !appl_30 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_output_macro kl_X))) - let !appl_31 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_input_macro kl_X))) - let !appl_32 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_error_macro kl_X))) - let !appl_33 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_prolog_macro kl_X))) - let !appl_34 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_synonyms_macro kl_X))) - let !appl_35 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_nl_macro kl_X))) - let !appl_36 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_Ats_macro kl_X))) - let !appl_37 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_defprolog_macro kl_X))) - let !appl_38 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_function_macro kl_X))) - !appl_39 <- appl_38 `pseq` klCons appl_38 (Types.Atom Types.Nil) - !appl_40 <- appl_37 `pseq` (appl_39 `pseq` klCons appl_37 appl_39) - !appl_41 <- appl_36 `pseq` (appl_40 `pseq` klCons appl_36 appl_40) - !appl_42 <- appl_35 `pseq` (appl_41 `pseq` klCons appl_35 appl_41) - !appl_43 <- appl_34 `pseq` (appl_42 `pseq` klCons appl_34 appl_42) - !appl_44 <- appl_33 `pseq` (appl_43 `pseq` klCons appl_33 appl_43) - !appl_45 <- appl_32 `pseq` (appl_44 `pseq` klCons appl_32 appl_44) - !appl_46 <- appl_31 `pseq` (appl_45 `pseq` klCons appl_31 appl_45) - !appl_47 <- appl_30 `pseq` (appl_46 `pseq` klCons appl_30 appl_46) - !appl_48 <- appl_29 `pseq` (appl_47 `pseq` klCons appl_29 appl_47) - !appl_49 <- appl_28 `pseq` (appl_48 `pseq` klCons appl_28 appl_48) - !appl_50 <- appl_27 `pseq` (appl_49 `pseq` klCons appl_27 appl_49) - !appl_51 <- appl_26 `pseq` (appl_50 `pseq` klCons appl_26 appl_50) - !appl_52 <- appl_25 `pseq` (appl_51 `pseq` klCons appl_25 appl_51) - !appl_53 <- appl_24 `pseq` (appl_52 `pseq` klCons appl_24 appl_52) - !appl_54 <- appl_23 `pseq` (appl_53 `pseq` klCons appl_23 appl_53) - !appl_55 <- appl_22 `pseq` (appl_54 `pseq` klCons appl_22 appl_54) - !appl_56 <- appl_21 `pseq` (appl_55 `pseq` klCons appl_21 appl_55) - appl_56 `pseq` klSet (Types.Atom (Types.UnboundSym "*macros*")) appl_56) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "*home-directory*")) (Types.Atom Types.Nil)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*gensym*")) (Types.Atom (Types.N (Types.KI 0)))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*tracking*")) (Types.Atom Types.Nil)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "*home-directory*")) (Types.Atom (Types.Str ""))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_57 <- klCons (Types.Atom (Types.UnboundSym "Z")) (Types.Atom Types.Nil) - !appl_58 <- appl_57 `pseq` klCons (Types.Atom (Types.UnboundSym "Y")) appl_57 - !appl_59 <- appl_58 `pseq` klCons (Types.Atom (Types.UnboundSym "X")) appl_58 - !appl_60 <- appl_59 `pseq` klCons (Types.Atom (Types.UnboundSym "W")) appl_59 - !appl_61 <- appl_60 `pseq` klCons (Types.Atom (Types.UnboundSym "V")) appl_60 - !appl_62 <- appl_61 `pseq` klCons (Types.Atom (Types.UnboundSym "U")) appl_61 - !appl_63 <- appl_62 `pseq` klCons (Types.Atom (Types.UnboundSym "T")) appl_62 - !appl_64 <- appl_63 `pseq` klCons (Types.Atom (Types.UnboundSym "S")) appl_63 - !appl_65 <- appl_64 `pseq` klCons (Types.Atom (Types.UnboundSym "R")) appl_64 - !appl_66 <- appl_65 `pseq` klCons (Types.Atom (Types.UnboundSym "Q")) appl_65 - !appl_67 <- appl_66 `pseq` klCons (Types.Atom (Types.UnboundSym "P")) appl_66 - !appl_68 <- appl_67 `pseq` klCons (Types.Atom (Types.UnboundSym "O")) appl_67 - !appl_69 <- appl_68 `pseq` klCons (Types.Atom (Types.UnboundSym "N")) appl_68 - !appl_70 <- appl_69 `pseq` klCons (Types.Atom (Types.UnboundSym "M")) appl_69 - !appl_71 <- appl_70 `pseq` klCons (Types.Atom (Types.UnboundSym "L")) appl_70 - !appl_72 <- appl_71 `pseq` klCons (Types.Atom (Types.UnboundSym "K")) appl_71 - !appl_73 <- appl_72 `pseq` klCons (Types.Atom (Types.UnboundSym "J")) appl_72 - !appl_74 <- appl_73 `pseq` klCons (Types.Atom (Types.UnboundSym "I")) appl_73 - !appl_75 <- appl_74 `pseq` klCons (Types.Atom (Types.UnboundSym "H")) appl_74 - !appl_76 <- appl_75 `pseq` klCons (Types.Atom (Types.UnboundSym "G")) appl_75 - !appl_77 <- appl_76 `pseq` klCons (Types.Atom (Types.UnboundSym "F")) appl_76 - !appl_78 <- appl_77 `pseq` klCons (Types.Atom (Types.UnboundSym "E")) appl_77 - !appl_79 <- appl_78 `pseq` klCons (Types.Atom (Types.UnboundSym "D")) appl_78 - !appl_80 <- appl_79 `pseq` klCons (Types.Atom (Types.UnboundSym "C")) appl_79 - !appl_81 <- appl_80 `pseq` klCons (Types.Atom (Types.UnboundSym "B")) appl_80 - !appl_82 <- appl_81 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_81 - appl_82 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*alphabet*")) appl_82) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_83 <- klCons (ApplC (wrapNamed "open" openStream)) (Types.Atom Types.Nil) - !appl_84 <- appl_83 `pseq` klCons (ApplC (wrapNamed "set" klSet)) appl_83 - !appl_85 <- appl_84 `pseq` klCons (Types.Atom (Types.UnboundSym "where")) appl_84 - !appl_86 <- appl_85 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_85 - !appl_87 <- appl_86 `pseq` klCons (Types.Atom (Types.UnboundSym "lambda")) appl_86 - !appl_88 <- appl_87 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_87 - !appl_89 <- appl_88 `pseq` klCons (ApplC (wrapNamed "@v" kl_Atv)) appl_88 - !appl_90 <- appl_89 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_89 - !appl_91 <- appl_90 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_90 - appl_91 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*special*")) appl_91) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_92 <- klCons (Types.Atom (Types.UnboundSym "defmacro")) (Types.Atom Types.Nil) - !appl_93 <- appl_92 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.read+")) appl_92 - !appl_94 <- appl_93 `pseq` klCons (Types.Atom (Types.UnboundSym "defcc")) appl_93 - !appl_95 <- appl_94 `pseq` klCons (ApplC (wrapNamed "input+" kl_inputPlus)) appl_94 - !appl_96 <- appl_95 `pseq` klCons (ApplC (wrapNamed "shen.process-datatype" kl_shen_process_datatype)) appl_95 - !appl_97 <- appl_96 `pseq` klCons (Types.Atom (Types.UnboundSym "define")) appl_96 - appl_97 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*extraspecial*")) appl_97) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*spy*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*datatypes*")) (Types.Atom Types.Nil)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*alldatatypes*")) (Types.Atom Types.Nil)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*shen-type-theory-enabled?*")) (Atom (B True))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*synonyms*")) (Types.Atom Types.Nil)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*system*")) (Types.Atom Types.Nil)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*signedfuncs*")) (Types.Atom Types.Nil)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*maxcomplexity*")) (Types.Atom (Types.N (Types.KI 128)))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*occurs*")) (Atom (B True))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*maxinferences*")) (Types.Atom (Types.N (Types.KI 1000000)))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "*maximum-print-sequence-size*")) (Types.Atom (Types.N (Types.KI 20)))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*catch*")) (Types.Atom (Types.N (Types.KI 0)))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*call*")) (Types.Atom (Types.N (Types.KI 0)))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*infs*")) (Types.Atom (Types.N (Types.KI 0)))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "*hush*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*optimise*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "*version*")) (Types.Atom (Types.Str "Shen 19.1"))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_98 <- klCons (Types.Atom (Types.N (Types.KI 1))) (Types.Atom Types.Nil) - !appl_99 <- appl_98 `pseq` klCons (ApplC (wrapNamed "include-all-but" kl_include_all_but)) appl_98 - !appl_100 <- appl_99 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_99 - !appl_101 <- appl_100 `pseq` klCons (ApplC (wrapNamed "preclude-all-but" kl_preclude_all_but)) appl_100 - !appl_102 <- appl_101 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_101 - !appl_103 <- appl_102 `pseq` klCons (ApplC (wrapNamed "include" kl_include)) appl_102 - !appl_104 <- appl_103 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_103 - !appl_105 <- appl_104 `pseq` klCons (ApplC (wrapNamed "preclude" kl_preclude)) appl_104 - !appl_106 <- appl_105 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_105 - !appl_107 <- appl_106 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_106 - !appl_108 <- appl_107 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_107 - !appl_109 <- appl_108 `pseq` klCons (ApplC (wrapNamed "@v" kl_Atv)) appl_108 - !appl_110 <- appl_109 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_109 - !appl_111 <- appl_110 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_110 - !appl_112 <- appl_111 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_111 - !appl_113 <- appl_112 `pseq` klCons (ApplC (wrapNamed "" kl_LBeRB)) appl_112 - !appl_114 <- appl_113 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_113 - !appl_115 <- appl_114 `pseq` klCons (ApplC (wrapNamed "==" kl_EqEq)) appl_114 - !appl_116 <- appl_115 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_115 - !appl_117 <- appl_116 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_116 - !appl_118 <- appl_117 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_117 - !appl_119 <- appl_118 `pseq` klCons (ApplC (wrapNamed "/" divide)) appl_118 - !appl_120 <- appl_119 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_119 - !appl_121 <- appl_120 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_120 - !appl_122 <- appl_121 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_121 - !appl_123 <- appl_122 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_122 - !appl_124 <- appl_123 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_123 - !appl_125 <- appl_124 `pseq` klCons (ApplC (wrapNamed "y-or-n?" kl_y_or_nP)) appl_124 - !appl_126 <- appl_125 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_125 - !appl_127 <- appl_126 `pseq` klCons (ApplC (wrapNamed "write-to-file" kl_write_to_file)) appl_126 - !appl_128 <- appl_127 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_127 - !appl_129 <- appl_128 `pseq` klCons (ApplC (wrapNamed "write-byte" writeByte)) appl_128 - !appl_130 <- appl_129 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_129 - !appl_131 <- appl_130 `pseq` klCons (ApplC (PL "version" kl_version)) appl_130 - !appl_132 <- appl_131 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_131 - !appl_133 <- appl_132 `pseq` klCons (ApplC (wrapNamed "variable?" kl_variableP)) appl_132 - !appl_134 <- appl_133 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_133 - !appl_135 <- appl_134 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_134 - !appl_136 <- appl_135 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_135 - !appl_137 <- appl_136 `pseq` klCons (ApplC (wrapNamed "vector->" kl_vector_RB)) appl_136 - !appl_138 <- appl_137 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_137 - !appl_139 <- appl_138 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_138 - !appl_140 <- appl_139 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_139 - !appl_141 <- appl_140 `pseq` klCons (ApplC (wrapNamed "undefmacro" kl_undefmacro)) appl_140 - !appl_142 <- appl_141 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_141 - !appl_143 <- appl_142 `pseq` klCons (ApplC (wrapNamed "unspecialise" kl_unspecialise)) appl_142 - !appl_144 <- appl_143 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_143 - !appl_145 <- appl_144 `pseq` klCons (ApplC (wrapNamed "untrack" kl_untrack)) appl_144 - !appl_146 <- appl_145 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_145 - !appl_147 <- appl_146 `pseq` klCons (ApplC (wrapNamed "union" kl_union)) appl_146 - !appl_148 <- appl_147 `pseq` klCons (Types.Atom (Types.N (Types.KI 4))) appl_147 - !appl_149 <- appl_148 `pseq` klCons (ApplC (wrapNamed "unify!" kl_unifyExcl)) appl_148 - !appl_150 <- appl_149 `pseq` klCons (Types.Atom (Types.N (Types.KI 4))) appl_149 - !appl_151 <- appl_150 `pseq` klCons (ApplC (wrapNamed "unify" kl_unify)) appl_150 - !appl_152 <- appl_151 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_151 - !appl_153 <- appl_152 `pseq` klCons (ApplC (wrapNamed "unprofile" kl_unprofile)) appl_152 - !appl_154 <- appl_153 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_153 - !appl_155 <- appl_154 `pseq` klCons (ApplC (wrapNamed "unput" kl_unput)) appl_154 - !appl_156 <- appl_155 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_155 - !appl_157 <- appl_156 `pseq` klCons (ApplC (wrapNamed "undefmacro" kl_undefmacro)) appl_156 - !appl_158 <- appl_157 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_157 - !appl_159 <- appl_158 `pseq` klCons (ApplC (wrapNamed "return" kl_return)) appl_158 - !appl_160 <- appl_159 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_159 - !appl_161 <- appl_160 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_160 - !appl_162 <- appl_161 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_161 - !appl_163 <- appl_162 `pseq` klCons (ApplC (wrapNamed "tuple?" kl_tupleP)) appl_162 - !appl_164 <- appl_163 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_163 - !appl_165 <- appl_164 `pseq` klCons (Types.Atom (Types.UnboundSym "trap-error")) appl_164 - !appl_166 <- appl_165 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_165 - !appl_167 <- appl_166 `pseq` klCons (ApplC (wrapNamed "track" kl_track)) appl_166 - !appl_168 <- appl_167 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_167 - !appl_169 <- appl_168 `pseq` klCons (ApplC (wrapNamed "tlstr" tlstr)) appl_168 - !appl_170 <- appl_169 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_169 - !appl_171 <- appl_170 `pseq` klCons (ApplC (wrapNamed "thaw" kl_thaw)) appl_170 - !appl_172 <- appl_171 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_171 - !appl_173 <- appl_172 `pseq` klCons (ApplC (PL "tc?" kl_tcP)) appl_172 - !appl_174 <- appl_173 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_173 - !appl_175 <- appl_174 `pseq` klCons (ApplC (wrapNamed "tc" kl_tc)) appl_174 - !appl_176 <- appl_175 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_175 - !appl_177 <- appl_176 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_176 - !appl_178 <- appl_177 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_177 - !appl_179 <- appl_178 `pseq` klCons (ApplC (wrapNamed "tail" kl_tail)) appl_178 - !appl_180 <- appl_179 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_179 - !appl_181 <- appl_180 `pseq` klCons (ApplC (wrapNamed "systemf" kl_systemf)) appl_180 - !appl_182 <- appl_181 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_181 - !appl_183 <- appl_182 `pseq` klCons (ApplC (wrapNamed "symbol?" kl_symbolP)) appl_182 - !appl_184 <- appl_183 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_183 - !appl_185 <- appl_184 `pseq` klCons (ApplC (wrapNamed "sum" kl_sum)) appl_184 - !appl_186 <- appl_185 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_185 - !appl_187 <- appl_186 `pseq` klCons (ApplC (wrapNamed "subst" kl_subst)) appl_186 - !appl_188 <- appl_187 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_187 - !appl_189 <- appl_188 `pseq` klCons (ApplC (wrapNamed "string?" stringP)) appl_188 - !appl_190 <- appl_189 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_189 - !appl_191 <- appl_190 `pseq` klCons (ApplC (wrapNamed "string->symbol" kl_string_RBsymbol)) appl_190 - !appl_192 <- appl_191 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_191 - !appl_193 <- appl_192 `pseq` klCons (ApplC (wrapNamed "string->n" stringToN)) appl_192 - !appl_194 <- appl_193 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_193 - !appl_195 <- appl_194 `pseq` klCons (ApplC (PL "stoutput" kl_stoutput)) appl_194 - !appl_196 <- appl_195 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_195 - !appl_197 <- appl_196 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_196 - !appl_198 <- appl_197 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_197 - !appl_199 <- appl_198 `pseq` klCons (ApplC (wrapNamed "step" kl_step)) appl_198 - !appl_200 <- appl_199 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_199 - !appl_201 <- appl_200 `pseq` klCons (ApplC (wrapNamed "spy" kl_spy)) appl_200 - !appl_202 <- appl_201 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_201 - !appl_203 <- appl_202 `pseq` klCons (ApplC (wrapNamed "specialise" kl_specialise)) appl_202 - !appl_204 <- appl_203 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_203 - !appl_205 <- appl_204 `pseq` klCons (ApplC (wrapNamed "snd" kl_snd)) appl_204 - !appl_206 <- appl_205 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_205 - !appl_207 <- appl_206 `pseq` klCons (ApplC (wrapNamed "simple-error" simpleError)) appl_206 - !appl_208 <- appl_207 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_207 - !appl_209 <- appl_208 `pseq` klCons (ApplC (wrapNamed "set" klSet)) appl_208 - !appl_210 <- appl_209 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_209 - !appl_211 <- appl_210 `pseq` klCons (ApplC (wrapNamed "reverse" kl_reverse)) appl_210 - !appl_212 <- appl_211 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_211 - !appl_213 <- appl_212 `pseq` klCons (Types.Atom (Types.UnboundSym "require")) appl_212 - !appl_214 <- appl_213 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_213 - !appl_215 <- appl_214 `pseq` klCons (ApplC (wrapNamed "remove" kl_remove)) appl_214 - !appl_216 <- appl_215 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_215 - !appl_217 <- appl_216 `pseq` klCons (ApplC (PL "release" kl_release)) appl_216 - !appl_218 <- appl_217 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_217 - !appl_219 <- appl_218 `pseq` klCons (ApplC (wrapNamed "read-from-string" kl_read_from_string)) appl_218 - !appl_220 <- appl_219 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_219 - !appl_221 <- appl_220 `pseq` klCons (ApplC (wrapNamed "read-byte" readByte)) appl_220 - !appl_222 <- appl_221 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_221 - !appl_223 <- appl_222 `pseq` klCons (ApplC (wrapNamed "read" kl_read)) appl_222 - !appl_224 <- appl_223 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_223 - !appl_225 <- appl_224 `pseq` klCons (ApplC (wrapNamed "read-file" kl_read_file)) appl_224 - !appl_226 <- appl_225 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_225 - !appl_227 <- appl_226 `pseq` klCons (ApplC (wrapNamed "read-file-as-string" kl_read_file_as_string)) appl_226 - !appl_228 <- appl_227 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_227 - !appl_229 <- appl_228 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.reassemble")) appl_228 - !appl_230 <- appl_229 `pseq` klCons (Types.Atom (Types.N (Types.KI 4))) appl_229 - !appl_231 <- appl_230 `pseq` klCons (ApplC (wrapNamed "put" kl_put)) appl_230 - !appl_232 <- appl_231 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_231 - !appl_233 <- appl_232 `pseq` klCons (ApplC (wrapNamed "address->" addressTo)) appl_232 - !appl_234 <- appl_233 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_233 - !appl_235 <- appl_234 `pseq` klCons (ApplC (wrapNamed "protect" kl_protect)) appl_234 - !appl_236 <- appl_235 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_235 - !appl_237 <- appl_236 `pseq` klCons (ApplC (wrapNamed "preclude-all-but" kl_preclude_all_but)) appl_236 - !appl_238 <- appl_237 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_237 - !appl_239 <- appl_238 `pseq` klCons (ApplC (wrapNamed "preclude" kl_preclude)) appl_238 - !appl_240 <- appl_239 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_239 - !appl_241 <- appl_240 `pseq` klCons (ApplC (wrapNamed "ps" kl_ps)) appl_240 - !appl_242 <- appl_241 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_241 - !appl_243 <- appl_242 `pseq` klCons (ApplC (wrapNamed "pr" kl_pr)) appl_242 - !appl_244 <- appl_243 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_243 - !appl_245 <- appl_244 `pseq` klCons (ApplC (wrapNamed "profile-results" kl_profile_results)) appl_244 - !appl_246 <- appl_245 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_245 - !appl_247 <- appl_246 `pseq` klCons (ApplC (wrapNamed "profile" kl_profile)) appl_246 - !appl_248 <- appl_247 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_247 - !appl_249 <- appl_248 `pseq` klCons (ApplC (wrapNamed "print" kl_print)) appl_248 - !appl_250 <- appl_249 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_249 - !appl_251 <- appl_250 `pseq` klCons (ApplC (wrapNamed "pos" pos)) appl_250 - !appl_252 <- appl_251 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_251 - !appl_253 <- appl_252 `pseq` klCons (ApplC (PL "porters" kl_porters)) appl_252 - !appl_254 <- appl_253 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_253 - !appl_255 <- appl_254 `pseq` klCons (ApplC (PL "port" kl_port)) appl_254 - !appl_256 <- appl_255 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_255 - !appl_257 <- appl_256 `pseq` klCons (ApplC (wrapNamed "package?" kl_packageP)) appl_256 - !appl_258 <- appl_257 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_257 - !appl_259 <- appl_258 `pseq` klCons (Types.Atom (Types.UnboundSym "package")) appl_258 - !appl_260 <- appl_259 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_259 - !appl_261 <- appl_260 `pseq` klCons (ApplC (PL "os" kl_os)) appl_260 - !appl_262 <- appl_261 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_261 - !appl_263 <- appl_262 `pseq` klCons (Types.Atom (Types.UnboundSym "or")) appl_262 - !appl_264 <- appl_263 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_263 - !appl_265 <- appl_264 `pseq` klCons (ApplC (wrapNamed "optimise" kl_optimise)) appl_264 - !appl_266 <- appl_265 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_265 - !appl_267 <- appl_266 `pseq` klCons (ApplC (wrapNamed "occurs-check" kl_occurs_check)) appl_266 - !appl_268 <- appl_267 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_267 - !appl_269 <- appl_268 `pseq` klCons (ApplC (wrapNamed "occurrences" kl_occurrences)) appl_268 - !appl_270 <- appl_269 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_269 - !appl_271 <- appl_270 `pseq` klCons (ApplC (wrapNamed "occurs-check" kl_occurs_check)) appl_270 - !appl_272 <- appl_271 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_271 - !appl_273 <- appl_272 `pseq` klCons (ApplC (wrapNamed "number?" numberP)) appl_272 - !appl_274 <- appl_273 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_273 - !appl_275 <- appl_274 `pseq` klCons (ApplC (wrapNamed "n->string" nToString)) appl_274 - !appl_276 <- appl_275 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_275 - !appl_277 <- appl_276 `pseq` klCons (ApplC (wrapNamed "nth" kl_nth)) appl_276 - !appl_278 <- appl_277 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_277 - !appl_279 <- appl_278 `pseq` klCons (ApplC (wrapNamed "not" kl_not)) appl_278 - !appl_280 <- appl_279 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_279 - !appl_281 <- appl_280 `pseq` klCons (ApplC (wrapNamed "maxinferences" kl_maxinferences)) appl_280 - !appl_282 <- appl_281 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_281 - !appl_283 <- appl_282 `pseq` klCons (ApplC (wrapNamed "mapcan" kl_mapcan)) appl_282 - !appl_284 <- appl_283 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_283 - !appl_285 <- appl_284 `pseq` klCons (ApplC (wrapNamed "map" kl_map)) appl_284 - !appl_286 <- appl_285 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_285 - !appl_287 <- appl_286 `pseq` klCons (ApplC (wrapNamed "macroexpand" kl_macroexpand)) appl_286 - !appl_288 <- appl_287 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_287 - !appl_289 <- appl_288 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_288 - !appl_290 <- appl_289 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_289 - !appl_291 <- appl_290 `pseq` klCons (ApplC (wrapNamed "<=" lessThanOrEqualTo)) appl_290 - !appl_292 <- appl_291 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_291 - !appl_293 <- appl_292 `pseq` klCons (ApplC (wrapNamed "<" lessThan)) appl_292 - !appl_294 <- appl_293 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_293 - !appl_295 <- appl_294 `pseq` klCons (ApplC (wrapNamed "load" kl_load)) appl_294 - !appl_296 <- appl_295 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_295 - !appl_297 <- appl_296 `pseq` klCons (ApplC (wrapNamed "lineread" kl_lineread)) appl_296 - !appl_298 <- appl_297 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_297 - !appl_299 <- appl_298 `pseq` klCons (ApplC (wrapNamed "length" kl_length)) appl_298 - !appl_300 <- appl_299 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_299 - !appl_301 <- appl_300 `pseq` klCons (ApplC (PL "language" kl_language)) appl_300 - !appl_302 <- appl_301 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_301 - !appl_303 <- appl_302 `pseq` klCons (ApplC (PL "kill" kl_kill)) appl_302 - !appl_304 <- appl_303 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_303 - !appl_305 <- appl_304 `pseq` klCons (ApplC (PL "it" kl_it)) appl_304 - !appl_306 <- appl_305 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_305 - !appl_307 <- appl_306 `pseq` klCons (ApplC (wrapNamed "internal" kl_internal)) appl_306 - !appl_308 <- appl_307 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_307 - !appl_309 <- appl_308 `pseq` klCons (ApplC (wrapNamed "intersection" kl_intersection)) appl_308 - !appl_310 <- appl_309 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_309 - !appl_311 <- appl_310 `pseq` klCons (ApplC (PL "implementation" kl_implementation)) appl_310 - !appl_312 <- appl_311 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_311 - !appl_313 <- appl_312 `pseq` klCons (ApplC (wrapNamed "input+" kl_inputPlus)) appl_312 - !appl_314 <- appl_313 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_313 - !appl_315 <- appl_314 `pseq` klCons (ApplC (wrapNamed "input" kl_input)) appl_314 - !appl_316 <- appl_315 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_315 - !appl_317 <- appl_316 `pseq` klCons (ApplC (PL "inferences" kl_inferences)) appl_316 - !appl_318 <- appl_317 `pseq` klCons (Types.Atom (Types.N (Types.KI 4))) appl_317 - !appl_319 <- appl_318 `pseq` klCons (ApplC (wrapNamed "identical" kl_identical)) appl_318 - !appl_320 <- appl_319 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_319 - !appl_321 <- appl_320 `pseq` klCons (ApplC (wrapNamed "intern" intern)) appl_320 - !appl_322 <- appl_321 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_321 - !appl_323 <- appl_322 `pseq` klCons (ApplC (wrapNamed "integer?" kl_integerP)) appl_322 - !appl_324 <- appl_323 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_323 - !appl_325 <- appl_324 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_324 - !appl_326 <- appl_325 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_325 - !appl_327 <- appl_326 `pseq` klCons (ApplC (wrapNamed "head" kl_head)) appl_326 - !appl_328 <- appl_327 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_327 - !appl_329 <- appl_328 `pseq` klCons (ApplC (wrapNamed "hdstr" kl_hdstr)) appl_328 - !appl_330 <- appl_329 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_329 - !appl_331 <- appl_330 `pseq` klCons (ApplC (wrapNamed "hdv" kl_hdv)) appl_330 - !appl_332 <- appl_331 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_331 - !appl_333 <- appl_332 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_332 - !appl_334 <- appl_333 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_333 - !appl_335 <- appl_334 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_334 - !appl_336 <- appl_335 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_335 - !appl_337 <- appl_336 `pseq` klCons (ApplC (wrapNamed ">=" greaterThanOrEqualTo)) appl_336 - !appl_338 <- appl_337 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_337 - !appl_339 <- appl_338 `pseq` klCons (ApplC (wrapNamed ">" greaterThan)) appl_338 - !appl_340 <- appl_339 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_339 - !appl_341 <- appl_340 `pseq` klCons (ApplC (wrapNamed "<-vector" kl_LB_vector)) appl_340 - !appl_342 <- appl_341 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_341 - !appl_343 <- appl_342 `pseq` klCons (ApplC (wrapNamed "<-address" addressFrom)) appl_342 - !appl_344 <- appl_343 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_343 - !appl_345 <- appl_344 `pseq` klCons (ApplC (wrapNamed "address->" addressTo)) appl_344 - !appl_346 <- appl_345 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_345 - !appl_347 <- appl_346 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_346 - !appl_348 <- appl_347 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_347 - !appl_349 <- appl_348 `pseq` klCons (ApplC (wrapNamed "get" kl_get)) appl_348 - !appl_350 <- appl_349 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_349 - !appl_351 <- appl_350 `pseq` klCons (ApplC (wrapNamed "gensym" kl_gensym)) appl_350 - !appl_352 <- appl_351 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_351 - !appl_353 <- appl_352 `pseq` klCons (ApplC (wrapNamed "fst" kl_fst)) appl_352 - !appl_354 <- appl_353 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_353 - !appl_355 <- appl_354 `pseq` klCons (Types.Atom (Types.UnboundSym "freeze")) appl_354 - !appl_356 <- appl_355 `pseq` klCons (Types.Atom (Types.N (Types.KI 5))) appl_355 - !appl_357 <- appl_356 `pseq` klCons (Types.Atom (Types.UnboundSym "findall")) appl_356 - !appl_358 <- appl_357 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_357 - !appl_359 <- appl_358 `pseq` klCons (ApplC (wrapNamed "fix" kl_fix)) appl_358 - !appl_360 <- appl_359 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_359 - !appl_361 <- appl_360 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_360 - !appl_362 <- appl_361 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_361 - !appl_363 <- appl_362 `pseq` klCons (ApplC (wrapNamed "fail-if" kl_fail_if)) appl_362 - !appl_364 <- appl_363 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_363 - !appl_365 <- appl_364 `pseq` klCons (ApplC (wrapNamed "external" kl_external)) appl_364 - !appl_366 <- appl_365 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_365 - !appl_367 <- appl_366 `pseq` klCons (ApplC (wrapNamed "explode" kl_explode)) appl_366 - !appl_368 <- appl_367 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_367 - !appl_369 <- appl_368 `pseq` klCons (ApplC (wrapNamed "eval-kl" evalKL)) appl_368 - !appl_370 <- appl_369 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_369 - !appl_371 <- appl_370 `pseq` klCons (ApplC (wrapNamed "eval" kl_eval)) appl_370 - !appl_372 <- appl_371 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_371 - !appl_373 <- appl_372 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.interror")) appl_372 - !appl_374 <- appl_373 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_373 - !appl_375 <- appl_374 `pseq` klCons (Types.Atom (Types.UnboundSym "enable-type-theory")) appl_374 - !appl_376 <- appl_375 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_375 - !appl_377 <- appl_376 `pseq` klCons (ApplC (wrapNamed "empty?" kl_emptyP)) appl_376 - !appl_378 <- appl_377 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_377 - !appl_379 <- appl_378 `pseq` klCons (ApplC (wrapNamed "element?" kl_elementP)) appl_378 - !appl_380 <- appl_379 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_379 - !appl_381 <- appl_380 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_380 - !appl_382 <- appl_381 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_381 - !appl_383 <- appl_382 `pseq` klCons (ApplC (wrapNamed "difference" kl_difference)) appl_382 - !appl_384 <- appl_383 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_383 - !appl_385 <- appl_384 `pseq` klCons (ApplC (wrapNamed "destroy" kl_destroy)) appl_384 - !appl_386 <- appl_385 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_385 - !appl_387 <- appl_386 `pseq` klCons (Types.Atom (Types.UnboundSym "declare")) appl_386 - !appl_388 <- appl_387 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_387 - !appl_389 <- appl_388 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_388 - !appl_390 <- appl_389 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_389 - !appl_391 <- appl_390 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_390 - !appl_392 <- appl_391 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_391 - !appl_393 <- appl_392 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_392 - !appl_394 <- appl_393 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_393 - !appl_395 <- appl_394 `pseq` klCons (ApplC (wrapNamed "concat" kl_concat)) appl_394 - !appl_396 <- appl_395 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_395 - !appl_397 <- appl_396 `pseq` klCons (ApplC (wrapNamed "compile" kl_compile)) appl_396 - !appl_398 <- appl_397 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_397 - !appl_399 <- appl_398 `pseq` klCons (ApplC (wrapNamed "cd" kl_cd)) appl_398 - !appl_400 <- appl_399 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_399 - !appl_401 <- appl_400 `pseq` klCons (ApplC (wrapNamed "boolean?" kl_booleanP)) appl_400 - !appl_402 <- appl_401 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_401 - !appl_403 <- appl_402 `pseq` klCons (ApplC (wrapNamed "assoc" kl_assoc)) appl_402 - !appl_404 <- appl_403 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_403 - !appl_405 <- appl_404 `pseq` klCons (ApplC (wrapNamed "arity" kl_arity)) appl_404 - !appl_406 <- appl_405 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_405 - !appl_407 <- appl_406 `pseq` klCons (ApplC (wrapNamed "append" kl_append)) appl_406 - !appl_408 <- appl_407 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_407 - !appl_409 <- appl_408 `pseq` klCons (Types.Atom (Types.UnboundSym "and")) appl_408 - !appl_410 <- appl_409 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_409 - !appl_411 <- appl_410 `pseq` klCons (ApplC (wrapNamed "adjoin" kl_adjoin)) appl_410 - !appl_412 <- appl_411 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_411 - !appl_413 <- appl_412 `pseq` klCons (ApplC (wrapNamed "absvector" absvector)) appl_412 - !appl_414 <- appl_413 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_413 - !appl_415 <- appl_414 `pseq` klCons (ApplC (wrapNamed "absvector?" absvectorP)) appl_414 - !appl_416 <- appl_415 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_415 - !appl_417 <- appl_416 `pseq` klCons (ApplC (PL "abort" kl_abort)) appl_416 - appl_417 `pseq` kl_shen_initialise_arity_table appl_417) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_418 <- intern (Types.Atom (Types.Str "shen")) - !appl_419 <- kl_vector (Types.Atom (Types.N (Types.KI 0))) - !appl_420 <- klCons (ApplC (PL "abort" kl_abort)) (Types.Atom Types.Nil) - !appl_421 <- appl_420 `pseq` klCons (ApplC (wrapNamed "absvector" absvector)) appl_420 - !appl_422 <- appl_421 `pseq` klCons (ApplC (wrapNamed "absvector?" absvectorP)) appl_421 - !appl_423 <- appl_422 `pseq` klCons (ApplC (wrapNamed "address->" addressTo)) appl_422 - !appl_424 <- appl_423 `pseq` klCons (ApplC (wrapNamed "<-address" addressFrom)) appl_423 - !appl_425 <- appl_424 `pseq` klCons (ApplC (wrapNamed "adjoin" kl_adjoin)) appl_424 - !appl_426 <- appl_425 `pseq` klCons (Types.Atom (Types.UnboundSym "and")) appl_425 - !appl_427 <- appl_426 `pseq` klCons (ApplC (wrapNamed "append" kl_append)) appl_426 - !appl_428 <- appl_427 `pseq` klCons (ApplC (wrapNamed "arity" kl_arity)) appl_427 - !appl_429 <- appl_428 `pseq` klCons (ApplC (wrapNamed "assoc" kl_assoc)) appl_428 - !appl_430 <- appl_429 `pseq` klCons (Types.Atom (Types.UnboundSym "bar!")) appl_429 - !appl_431 <- appl_430 `pseq` klCons (Types.Atom (Types.UnboundSym "boolean")) appl_430 - !appl_432 <- appl_431 `pseq` klCons (ApplC (wrapNamed "boolean?" kl_booleanP)) appl_431 - !appl_433 <- appl_432 `pseq` klCons (ApplC (wrapNamed "bound?" kl_boundP)) appl_432 - !appl_434 <- appl_433 `pseq` klCons (ApplC (wrapNamed "bind" kl_bind)) appl_433 - !appl_435 <- appl_434 `pseq` klCons (ApplC (wrapNamed "close" closeStream)) appl_434 - !appl_436 <- appl_435 `pseq` klCons (ApplC (wrapNamed "call" kl_call)) appl_435 - !appl_437 <- appl_436 `pseq` klCons (Types.Atom (Types.UnboundSym "cases")) appl_436 - !appl_438 <- appl_437 `pseq` klCons (ApplC (wrapNamed "cd" kl_cd)) appl_437 - !appl_439 <- appl_438 `pseq` klCons (ApplC (wrapNamed "compile" kl_compile)) appl_438 - !appl_440 <- appl_439 `pseq` klCons (ApplC (wrapNamed "concat" kl_concat)) appl_439 - !appl_441 <- appl_440 `pseq` klCons (Types.Atom (Types.UnboundSym "cond")) appl_440 - !appl_442 <- appl_441 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_441 - !appl_443 <- appl_442 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_442 - !appl_444 <- appl_443 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_443 - !appl_445 <- appl_444 `pseq` klCons (ApplC (wrapNamed "cut" kl_cut)) appl_444 - !appl_446 <- appl_445 `pseq` klCons (Types.Atom (Types.UnboundSym "datatype")) appl_445 - !appl_447 <- appl_446 `pseq` klCons (Types.Atom (Types.UnboundSym "declare")) appl_446 - !appl_448 <- appl_447 `pseq` klCons (Types.Atom (Types.UnboundSym "defprolog")) appl_447 - !appl_449 <- appl_448 `pseq` klCons (Types.Atom (Types.UnboundSym "defcc")) appl_448 - !appl_450 <- appl_449 `pseq` klCons (Types.Atom (Types.UnboundSym "defmacro")) appl_449 - !appl_451 <- appl_450 `pseq` klCons (Types.Atom (Types.UnboundSym "define")) appl_450 - !appl_452 <- appl_451 `pseq` klCons (Types.Atom (Types.UnboundSym "defun")) appl_451 - !appl_453 <- appl_452 `pseq` klCons (ApplC (wrapNamed "destroy" kl_destroy)) appl_452 - !appl_454 <- appl_453 `pseq` klCons (ApplC (wrapNamed "difference" kl_difference)) appl_453 - !appl_455 <- appl_454 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_454 - !appl_456 <- appl_455 `pseq` klCons (ApplC (wrapNamed "element?" kl_elementP)) appl_455 - !appl_457 <- appl_456 `pseq` klCons (ApplC (wrapNamed "empty?" kl_emptyP)) appl_456 - !appl_458 <- appl_457 `pseq` klCons (Types.Atom (Types.UnboundSym "error")) appl_457 - !appl_459 <- appl_458 `pseq` klCons (ApplC (wrapNamed "error-to-string" errorToString)) appl_458 - !appl_460 <- appl_459 `pseq` klCons (ApplC (wrapNamed "eval" kl_eval)) appl_459 - !appl_461 <- appl_460 `pseq` klCons (ApplC (wrapNamed "eval-kl" evalKL)) appl_460 - !appl_462 <- appl_461 `pseq` klCons (Types.Atom (Types.UnboundSym "exception")) appl_461 - !appl_463 <- appl_462 `pseq` klCons (ApplC (wrapNamed "external" kl_external)) appl_462 - !appl_464 <- appl_463 `pseq` klCons (ApplC (wrapNamed "explode" kl_explode)) appl_463 - !appl_465 <- appl_464 `pseq` klCons (Types.Atom (Types.UnboundSym "enable-type-theory")) appl_464 - !appl_466 <- appl_465 `pseq` klCons (Atom (B False)) appl_465 - !appl_467 <- appl_466 `pseq` klCons (Types.Atom (Types.UnboundSym "findall")) appl_466 - !appl_468 <- appl_467 `pseq` klCons (ApplC (wrapNamed "fwhen" kl_fwhen)) appl_467 - !appl_469 <- appl_468 `pseq` klCons (ApplC (wrapNamed "fail-if" kl_fail_if)) appl_468 - !appl_470 <- appl_469 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_469 - !appl_471 <- appl_470 `pseq` klCons (Types.Atom (Types.UnboundSym "file")) appl_470 - !appl_472 <- appl_471 `pseq` klCons (ApplC (wrapNamed "fix" kl_fix)) appl_471 - !appl_473 <- appl_472 `pseq` klCons (Types.Atom (Types.UnboundSym "freeze")) appl_472 - !appl_474 <- appl_473 `pseq` klCons (ApplC (wrapNamed "fst" kl_fst)) appl_473 - !appl_475 <- appl_474 `pseq` klCons (ApplC (wrapNamed "function" kl_function)) appl_474 - !appl_476 <- appl_475 `pseq` klCons (ApplC (wrapNamed "gensym" kl_gensym)) appl_475 - !appl_477 <- appl_476 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_476 - !appl_478 <- appl_477 `pseq` klCons (ApplC (wrapNamed "get" kl_get)) appl_477 - !appl_479 <- appl_478 `pseq` klCons (ApplC (wrapNamed "hash" kl_hash)) appl_478 - !appl_480 <- appl_479 `pseq` klCons (ApplC (wrapNamed "hdstr" kl_hdstr)) appl_479 - !appl_481 <- appl_480 `pseq` klCons (ApplC (wrapNamed "hdv" kl_hdv)) appl_480 - !appl_482 <- appl_481 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_481 - !appl_483 <- appl_482 `pseq` klCons (ApplC (wrapNamed "head" kl_head)) appl_482 - !appl_484 <- appl_483 `pseq` klCons (ApplC (wrapNamed "identical" kl_identical)) appl_483 - !appl_485 <- appl_484 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_484 - !appl_486 <- appl_485 `pseq` klCons (ApplC (PL "implementation" kl_implementation)) appl_485 - !appl_487 <- appl_486 `pseq` klCons (ApplC (wrapNamed "internal" kl_internal)) appl_486 - !appl_488 <- appl_487 `pseq` klCons (Types.Atom (Types.UnboundSym "in")) appl_487 - !appl_489 <- appl_488 `pseq` klCons (ApplC (PL "it" kl_it)) appl_488 - !appl_490 <- appl_489 `pseq` klCons (ApplC (wrapNamed "include-all-but" kl_include_all_but)) appl_489 - !appl_491 <- appl_490 `pseq` klCons (ApplC (wrapNamed "include" kl_include)) appl_490 - !appl_492 <- appl_491 `pseq` klCons (ApplC (wrapNamed "input+" kl_inputPlus)) appl_491 - !appl_493 <- appl_492 `pseq` klCons (ApplC (wrapNamed "input" kl_input)) appl_492 - !appl_494 <- appl_493 `pseq` klCons (ApplC (wrapNamed "integer?" kl_integerP)) appl_493 - !appl_495 <- appl_494 `pseq` klCons (ApplC (wrapNamed "intern" intern)) appl_494 - !appl_496 <- appl_495 `pseq` klCons (ApplC (PL "inferences" kl_inferences)) appl_495 - !appl_497 <- appl_496 `pseq` klCons (ApplC (wrapNamed "intersection" kl_intersection)) appl_496 - !appl_498 <- appl_497 `pseq` klCons (Types.Atom (Types.UnboundSym "is")) appl_497 - !appl_499 <- appl_498 `pseq` klCons (ApplC (PL "kill" kl_kill)) appl_498 - !appl_500 <- appl_499 `pseq` klCons (ApplC (PL "language" kl_language)) appl_499 - !appl_501 <- appl_500 `pseq` klCons (Types.Atom (Types.UnboundSym "lambda")) appl_500 - !appl_502 <- appl_501 `pseq` klCons (Types.Atom (Types.UnboundSym "lazy")) appl_501 - !appl_503 <- appl_502 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_502 - !appl_504 <- appl_503 `pseq` klCons (ApplC (wrapNamed "length" kl_length)) appl_503 - !appl_505 <- appl_504 `pseq` klCons (ApplC (wrapNamed "limit" kl_limit)) appl_504 - !appl_506 <- appl_505 `pseq` klCons (ApplC (wrapNamed "lineread" kl_lineread)) appl_505 - !appl_507 <- appl_506 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_506 - !appl_508 <- appl_507 `pseq` klCons (Types.Atom (Types.UnboundSym "loaded")) appl_507 - !appl_509 <- appl_508 `pseq` klCons (ApplC (wrapNamed "load" kl_load)) appl_508 - !appl_510 <- appl_509 `pseq` klCons (Types.Atom (Types.UnboundSym "make-string")) appl_509 - !appl_511 <- appl_510 `pseq` klCons (ApplC (wrapNamed "map" kl_map)) appl_510 - !appl_512 <- appl_511 `pseq` klCons (ApplC (wrapNamed "mapcan" kl_mapcan)) appl_511 - !appl_513 <- appl_512 `pseq` klCons (ApplC (wrapNamed "maxinferences" kl_maxinferences)) appl_512 - !appl_514 <- appl_513 `pseq` klCons (ApplC (wrapNamed "macroexpand" kl_macroexpand)) appl_513 - !appl_515 <- appl_514 `pseq` klCons (Types.Atom (Types.UnboundSym "mode")) appl_514 - !appl_516 <- appl_515 `pseq` klCons (ApplC (wrapNamed "nl" kl_nl)) appl_515 - !appl_517 <- appl_516 `pseq` klCons (ApplC (wrapNamed "not" kl_not)) appl_516 - !appl_518 <- appl_517 `pseq` klCons (ApplC (wrapNamed "nth" kl_nth)) appl_517 - !appl_519 <- appl_518 `pseq` klCons (Types.Atom (Types.UnboundSym "null")) appl_518 - !appl_520 <- appl_519 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_519 - !appl_521 <- appl_520 `pseq` klCons (ApplC (wrapNamed "number?" numberP)) appl_520 - !appl_522 <- appl_521 `pseq` klCons (ApplC (wrapNamed "n->string" nToString)) appl_521 - !appl_523 <- appl_522 `pseq` klCons (ApplC (wrapNamed "occurs-check" kl_occurs_check)) appl_522 - !appl_524 <- appl_523 `pseq` klCons (ApplC (wrapNamed "occurrences" kl_occurrences)) appl_523 - !appl_525 <- appl_524 `pseq` klCons (ApplC (wrapNamed "open" openStream)) appl_524 - !appl_526 <- appl_525 `pseq` klCons (ApplC (wrapNamed "optimise" kl_optimise)) appl_525 - !appl_527 <- appl_526 `pseq` klCons (Types.Atom (Types.UnboundSym "or")) appl_526 - !appl_528 <- appl_527 `pseq` klCons (ApplC (PL "os" kl_os)) appl_527 - !appl_529 <- appl_528 `pseq` klCons (Types.Atom (Types.UnboundSym "out")) appl_528 - !appl_530 <- appl_529 `pseq` klCons (Types.Atom (Types.UnboundSym "output")) appl_529 - !appl_531 <- appl_530 `pseq` klCons (Types.Atom (Types.UnboundSym "package")) appl_530 - !appl_532 <- appl_531 `pseq` klCons (ApplC (PL "port" kl_port)) appl_531 - !appl_533 <- appl_532 `pseq` klCons (ApplC (PL "porters" kl_porters)) appl_532 - !appl_534 <- appl_533 `pseq` klCons (ApplC (wrapNamed "pos" pos)) appl_533 - !appl_535 <- appl_534 `pseq` klCons (ApplC (wrapNamed "pr" kl_pr)) appl_534 - !appl_536 <- appl_535 `pseq` klCons (ApplC (wrapNamed "print" kl_print)) appl_535 - !appl_537 <- appl_536 `pseq` klCons (ApplC (wrapNamed "profile" kl_profile)) appl_536 - !appl_538 <- appl_537 `pseq` klCons (ApplC (wrapNamed "profile-results" kl_profile_results)) appl_537 - !appl_539 <- appl_538 `pseq` klCons (ApplC (wrapNamed "protect" kl_protect)) appl_538 - !appl_540 <- appl_539 `pseq` klCons (Types.Atom (Types.UnboundSym "prolog?")) appl_539 - !appl_541 <- appl_540 `pseq` klCons (ApplC (wrapNamed "ps" kl_ps)) appl_540 - !appl_542 <- appl_541 `pseq` klCons (ApplC (wrapNamed "preclude-all-but" kl_preclude_all_but)) appl_541 - !appl_543 <- appl_542 `pseq` klCons (ApplC (wrapNamed "preclude" kl_preclude)) appl_542 - !appl_544 <- appl_543 `pseq` klCons (ApplC (wrapNamed "put" kl_put)) appl_543 - !appl_545 <- appl_544 `pseq` klCons (ApplC (wrapNamed "package?" kl_packageP)) appl_544 - !appl_546 <- appl_545 `pseq` klCons (ApplC (wrapNamed "read-from-string" kl_read_from_string)) appl_545 - !appl_547 <- appl_546 `pseq` klCons (ApplC (wrapNamed "read-byte" readByte)) appl_546 - !appl_548 <- appl_547 `pseq` klCons (ApplC (wrapNamed "read-file-as-string" kl_read_file_as_string)) appl_547 - !appl_549 <- appl_548 `pseq` klCons (ApplC (wrapNamed "read-file-as-bytelist" kl_read_file_as_bytelist)) appl_548 - !appl_550 <- appl_549 `pseq` klCons (ApplC (wrapNamed "read-file" kl_read_file)) appl_549 - !appl_551 <- appl_550 `pseq` klCons (ApplC (wrapNamed "read" kl_read)) appl_550 - !appl_552 <- appl_551 `pseq` klCons (ApplC (PL "release" kl_release)) appl_551 - !appl_553 <- appl_552 `pseq` klCons (ApplC (wrapNamed "remove" kl_remove)) appl_552 - !appl_554 <- appl_553 `pseq` klCons (ApplC (wrapNamed "reverse" kl_reverse)) appl_553 - !appl_555 <- appl_554 `pseq` klCons (Types.Atom (Types.UnboundSym "run")) appl_554 - !appl_556 <- appl_555 `pseq` klCons (ApplC (wrapNamed "str" str)) appl_555 - !appl_557 <- appl_556 `pseq` klCons (Types.Atom (Types.UnboundSym "save")) appl_556 - !appl_558 <- appl_557 `pseq` klCons (ApplC (wrapNamed "set" klSet)) appl_557 - !appl_559 <- appl_558 `pseq` klCons (ApplC (wrapNamed "simple-error" simpleError)) appl_558 - !appl_560 <- appl_559 `pseq` klCons (ApplC (wrapNamed "snd" kl_snd)) appl_559 - !appl_561 <- appl_560 `pseq` klCons (ApplC (wrapNamed "specialise" kl_specialise)) appl_560 - !appl_562 <- appl_561 `pseq` klCons (ApplC (wrapNamed "spy" kl_spy)) appl_561 - !appl_563 <- appl_562 `pseq` klCons (ApplC (wrapNamed "step" kl_step)) appl_562 - !appl_564 <- appl_563 `pseq` klCons (ApplC (PL "stoutput" kl_stoutput)) appl_563 - !appl_565 <- appl_564 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_564 - !appl_566 <- appl_565 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_565 - !appl_567 <- appl_566 `pseq` klCons (Types.Atom (Types.UnboundSym "stream")) appl_566 - !appl_568 <- appl_567 `pseq` klCons (ApplC (wrapNamed "string->n" stringToN)) appl_567 - !appl_569 <- appl_568 `pseq` klCons (ApplC (wrapNamed "string?" stringP)) appl_568 - !appl_570 <- appl_569 `pseq` klCons (ApplC (wrapNamed "subst" kl_subst)) appl_569 - !appl_571 <- appl_570 `pseq` klCons (ApplC (wrapNamed "sum" kl_sum)) appl_570 - !appl_572 <- appl_571 `pseq` klCons (ApplC (wrapNamed "string->symbol" kl_string_RBsymbol)) appl_571 - !appl_573 <- appl_572 `pseq` klCons (ApplC (wrapNamed "symbol?" kl_symbolP)) appl_572 - !appl_574 <- appl_573 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_573 - !appl_575 <- appl_574 `pseq` klCons (Types.Atom (Types.UnboundSym "synonyms")) appl_574 - !appl_576 <- appl_575 `pseq` klCons (ApplC (wrapNamed "systemf" kl_systemf)) appl_575 - !appl_577 <- appl_576 `pseq` klCons (ApplC (wrapNamed "tail" kl_tail)) appl_576 - !appl_578 <- appl_577 `pseq` klCons (ApplC (wrapNamed "tlv" kl_tlv)) appl_577 - !appl_579 <- appl_578 `pseq` klCons (ApplC (wrapNamed "tlstr" tlstr)) appl_578 - !appl_580 <- appl_579 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_579 - !appl_581 <- appl_580 `pseq` klCons (ApplC (wrapNamed "tc" kl_tc)) appl_580 - !appl_582 <- appl_581 `pseq` klCons (ApplC (PL "tc?" kl_tcP)) appl_581 - !appl_583 <- appl_582 `pseq` klCons (ApplC (wrapNamed "thaw" kl_thaw)) appl_582 - !appl_584 <- appl_583 `pseq` klCons (Types.Atom (Types.UnboundSym "time")) appl_583 - !appl_585 <- appl_584 `pseq` klCons (ApplC (wrapNamed "track" kl_track)) appl_584 - !appl_586 <- appl_585 `pseq` klCons (Types.Atom (Types.UnboundSym "trap-error")) appl_585 - !appl_587 <- appl_586 `pseq` klCons (Atom (B True)) appl_586 - !appl_588 <- appl_587 `pseq` klCons (ApplC (wrapNamed "tuple?" kl_tupleP)) appl_587 - !appl_589 <- appl_588 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_588 - !appl_590 <- appl_589 `pseq` klCons (ApplC (wrapNamed "return" kl_return)) appl_589 - !appl_591 <- appl_590 `pseq` klCons (ApplC (wrapNamed "undefmacro" kl_undefmacro)) appl_590 - !appl_592 <- appl_591 `pseq` klCons (ApplC (wrapNamed "unprofile" kl_unprofile)) appl_591 - !appl_593 <- appl_592 `pseq` klCons (ApplC (wrapNamed "unput" kl_unput)) appl_592 - !appl_594 <- appl_593 `pseq` klCons (ApplC (wrapNamed "unify!" kl_unifyExcl)) appl_593 - !appl_595 <- appl_594 `pseq` klCons (ApplC (wrapNamed "unify" kl_unify)) appl_594 - !appl_596 <- appl_595 `pseq` klCons (ApplC (wrapNamed "union" kl_union)) appl_595 - !appl_597 <- appl_596 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.unix")) appl_596 - !appl_598 <- appl_597 `pseq` klCons (Types.Atom (Types.UnboundSym "unit")) appl_597 - !appl_599 <- appl_598 `pseq` klCons (ApplC (wrapNamed "untrack" kl_untrack)) appl_598 - !appl_600 <- appl_599 `pseq` klCons (ApplC (wrapNamed "unspecialise" kl_unspecialise)) appl_599 - !appl_601 <- appl_600 `pseq` klCons (ApplC (wrapNamed "vector?" kl_vectorP)) appl_600 - !appl_602 <- appl_601 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_601 - !appl_603 <- appl_602 `pseq` klCons (ApplC (wrapNamed "<-vector" kl_LB_vector)) appl_602 - !appl_604 <- appl_603 `pseq` klCons (ApplC (wrapNamed "vector->" kl_vector_RB)) appl_603 - !appl_605 <- appl_604 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_604 - !appl_606 <- appl_605 `pseq` klCons (ApplC (wrapNamed "variable?" kl_variableP)) appl_605 - !appl_607 <- appl_606 `pseq` klCons (Types.Atom (Types.UnboundSym "verified")) appl_606 - !appl_608 <- appl_607 `pseq` klCons (ApplC (PL "version" kl_version)) appl_607 - !appl_609 <- appl_608 `pseq` klCons (Types.Atom (Types.UnboundSym "warn")) appl_608 - !appl_610 <- appl_609 `pseq` klCons (Types.Atom (Types.UnboundSym "when")) appl_609 - !appl_611 <- appl_610 `pseq` klCons (Types.Atom (Types.UnboundSym "where")) appl_610 - !appl_612 <- appl_611 `pseq` klCons (ApplC (wrapNamed "write-byte" writeByte)) appl_611 - !appl_613 <- appl_612 `pseq` klCons (ApplC (wrapNamed "write-to-file" kl_write_to_file)) appl_612 - !appl_614 <- appl_613 `pseq` klCons (ApplC (wrapNamed "y-or-n?" kl_y_or_nP)) appl_613 - !appl_615 <- appl_419 `pseq` (appl_614 `pseq` klCons appl_419 appl_614) - !appl_616 <- appl_615 `pseq` klCons (Types.Atom (Types.UnboundSym ">>")) appl_615 - !appl_617 <- appl_616 `pseq` klCons (ApplC (wrapNamed "<" lessThan)) appl_616 - !appl_618 <- appl_617 `pseq` klCons (ApplC (wrapNamed "<=" lessThanOrEqualTo)) appl_617 - !appl_619 <- appl_618 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_618 - !appl_620 <- appl_619 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_619 - !appl_621 <- appl_620 `pseq` klCons (ApplC (wrapNamed "/" divide)) appl_620 - !appl_622 <- appl_621 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_621 - !appl_623 <- appl_622 `pseq` klCons (Types.Atom (Types.UnboundSym "$")) appl_622 - !appl_624 <- appl_623 `pseq` klCons (Types.Atom (Types.UnboundSym "=!")) appl_623 - !appl_625 <- appl_624 `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) appl_624 - !appl_626 <- appl_625 `pseq` klCons (ApplC (wrapNamed ">" greaterThan)) appl_625 - !appl_627 <- appl_626 `pseq` klCons (ApplC (wrapNamed ">=" greaterThanOrEqualTo)) appl_626 - !appl_628 <- appl_627 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_627 - !appl_629 <- appl_628 `pseq` klCons (ApplC (wrapNamed "==" kl_EqEq)) appl_628 - !appl_630 <- appl_629 `pseq` klCons (ApplC (wrapNamed "" kl_LBeRB)) appl_629 - !appl_631 <- appl_630 `pseq` klCons (Types.Atom (Types.UnboundSym "->")) appl_630 - !appl_632 <- appl_631 `pseq` klCons (Types.Atom (Types.UnboundSym "<-")) appl_631 - !appl_633 <- appl_632 `pseq` klCons (Types.Atom (Types.UnboundSym "*hush*")) appl_632 - !appl_634 <- appl_633 `pseq` klCons (Types.Atom (Types.UnboundSym "*porters*")) appl_633 - !appl_635 <- appl_634 `pseq` klCons (Types.Atom (Types.UnboundSym "*port*")) appl_634 - !appl_636 <- appl_635 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_635 - !appl_637 <- appl_636 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_636 - !appl_638 <- appl_637 `pseq` klCons (ApplC (wrapNamed "@v" kl_Atv)) appl_637 - !appl_639 <- appl_638 `pseq` klCons (Types.Atom (Types.UnboundSym "*property-vector*")) appl_638 - !appl_640 <- appl_639 `pseq` klCons (Types.Atom (Types.UnboundSym "*release*")) appl_639 - !appl_641 <- appl_640 `pseq` klCons (Types.Atom (Types.UnboundSym "*os*")) appl_640 - !appl_642 <- appl_641 `pseq` klCons (Types.Atom (Types.UnboundSym "*macros*")) appl_641 - !appl_643 <- appl_642 `pseq` klCons (Types.Atom (Types.UnboundSym "*maximum-print-sequence-size*")) appl_642 - !appl_644 <- appl_643 `pseq` klCons (Types.Atom (Types.UnboundSym "*version*")) appl_643 - !appl_645 <- appl_644 `pseq` klCons (Types.Atom (Types.UnboundSym "*home-directory*")) appl_644 - !appl_646 <- appl_645 `pseq` klCons (Types.Atom (Types.UnboundSym "*stoutput*")) appl_645 - !appl_647 <- appl_646 `pseq` klCons (Types.Atom (Types.UnboundSym "*stinput*")) appl_646 - !appl_648 <- appl_647 `pseq` klCons (Types.Atom (Types.UnboundSym "*implementation*")) appl_647 - !appl_649 <- appl_648 `pseq` klCons (Types.Atom (Types.UnboundSym "*language*")) appl_648 - !appl_650 <- appl_649 `pseq` klCons (Types.Atom (Types.UnboundSym "_")) appl_649 - !appl_651 <- appl_650 `pseq` klCons (Types.Atom (Types.UnboundSym ":=")) appl_650 - !appl_652 <- appl_651 `pseq` klCons (Types.Atom (Types.UnboundSym ":-")) appl_651 - !appl_653 <- appl_652 `pseq` klCons (Types.Atom (Types.UnboundSym ";")) appl_652 - !appl_654 <- appl_653 `pseq` klCons (Types.Atom (Types.UnboundSym ":")) appl_653 - !appl_655 <- appl_654 `pseq` klCons (Types.Atom (Types.UnboundSym "&&")) appl_654 - !appl_656 <- appl_655 `pseq` klCons (Types.Atom (Types.UnboundSym "<--")) appl_655 - !appl_657 <- appl_656 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_656 - !appl_658 <- appl_657 `pseq` klCons (Types.Atom (Types.UnboundSym "{")) appl_657 - !appl_659 <- appl_658 `pseq` klCons (Types.Atom (Types.UnboundSym "}")) appl_658 - !appl_660 <- appl_659 `pseq` klCons (Types.Atom (Types.UnboundSym "!")) appl_659 - !appl_661 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - appl_418 `pseq` (appl_660 `pseq` (appl_661 `pseq` kl_put appl_418 (Types.Atom (Types.UnboundSym "shen.external-symbols")) appl_660 appl_661))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do let !appl_662 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_datatype_error kl_X))) - !appl_663 <- appl_662 `pseq` klCons (ApplC (wrapNamed "shen.datatype-error" kl_shen_datatype_error)) appl_662 - let !appl_664 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_tuple kl_X))) - !appl_665 <- appl_664 `pseq` klCons (ApplC (wrapNamed "shen.tuple" kl_shen_tuple)) appl_664 - let !appl_666 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_pvar kl_X))) - !appl_667 <- appl_666 `pseq` klCons (ApplC (wrapNamed "shen.pvar" kl_shen_pvar)) appl_666 - let !appl_668 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_symbol_table_entry kl_X))) - !appl_669 <- intern (Types.Atom (Types.Str "shen")) - !appl_670 <- appl_669 `pseq` kl_external appl_669 - !appl_671 <- appl_668 `pseq` (appl_670 `pseq` kl_mapcan appl_668 appl_670) - !appl_672 <- appl_667 `pseq` (appl_671 `pseq` klCons appl_667 appl_671) - !appl_673 <- appl_665 `pseq` (appl_672 `pseq` klCons appl_665 appl_672) - !appl_674 <- appl_663 `pseq` (appl_673 `pseq` klCons appl_663 appl_673) - appl_674 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*symbol-table*")) appl_674) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Declarations where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel +import Backend.Core +import Backend.Sys +import Backend.Sequent +import Backend.Yacc +import Backend.Reader +import Backend.Prolog +import Backend.Track +import Backend.Load +import Backend.Writer +import Backend.Macros + +{- +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_initialise_arity_table :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_initialise_arity_table (!kl_V1456) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1456 `pseq` eq appl_0 kl_V1456) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let pat_cond_2 kl_V1456 kl_V1456h kl_V1456t kl_V1456th kl_V1456tt = do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_DecArity) -> do kl_V1456tt `pseq` kl_shen_initialise_arity_table kl_V1456tt))) + !appl_4 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + !appl_5 <- kl_V1456h `pseq` (kl_V1456th `pseq` (appl_4 `pseq` kl_put kl_V1456h (ApplC (wrapNamed "arity" kl_arity)) kl_V1456th appl_4)) + appl_5 `pseq` applyWrapper appl_3 [appl_5] + pat_cond_6 = do do kl_shen_f_error (ApplC (wrapNamed "shen.initialise_arity_table" kl_shen_initialise_arity_table)) + in case kl_V1456 of + !(kl_V1456@(Cons (!kl_V1456h) + (!(kl_V1456t@(Cons (!kl_V1456th) + (!kl_V1456tt)))))) -> pat_cond_2 kl_V1456 kl_V1456h kl_V1456t kl_V1456th kl_V1456tt + _ -> pat_cond_6 + _ -> throwError "if: expected boolean" + +kl_arity :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_arity (!kl_V1458) = do let !appl_0 = ApplC (PL "thunk" (do return (Core.Types.Atom (Core.Types.N (Core.Types.KI (-1)))))) + !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + kl_V1458 `pseq` (appl_0 `pseq` (appl_1 `pseq` kl_getDivor kl_V1458 (ApplC (wrapNamed "arity" kl_arity)) appl_0 appl_1)) + +kl_systemf :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_systemf (!kl_V1460) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Shen) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_External) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Place) -> do return kl_V1460))) + !appl_3 <- kl_V1460 `pseq` (kl_External `pseq` kl_adjoin kl_V1460 kl_External) + !appl_4 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + !appl_5 <- kl_Shen `pseq` (appl_3 `pseq` (appl_4 `pseq` kl_put kl_Shen (Core.Types.Atom (Core.Types.UnboundSym "shen.external-symbols")) appl_3 appl_4)) + appl_5 `pseq` applyWrapper appl_2 [appl_5]))) + !appl_6 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + !appl_7 <- kl_Shen `pseq` (appl_6 `pseq` kl_get kl_Shen (Core.Types.Atom (Core.Types.UnboundSym "shen.external-symbols")) appl_6) + appl_7 `pseq` applyWrapper appl_1 [appl_7]))) + !appl_8 <- intern (Core.Types.Atom (Core.Types.Str "shen")) + appl_8 `pseq` applyWrapper appl_0 [appl_8] + +kl_adjoin :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_adjoin (!kl_V1463) (!kl_V1464) = do !kl_if_0 <- kl_V1463 `pseq` (kl_V1464 `pseq` kl_elementP kl_V1463 kl_V1464) + case kl_if_0 of + Atom (B (True)) -> do return kl_V1464 + Atom (B (False)) -> do do kl_V1463 `pseq` (kl_V1464 `pseq` klCons kl_V1463 kl_V1464) + _ -> throwError "if: expected boolean" + +kl_shen_lambda_form_entry :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_lambda_form_entry (!kl_V1466) = do let pat_cond_0 = do return (Atom Nil) + pat_cond_1 = do return (Atom Nil) + pat_cond_2 = do do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_ArityF) -> do let pat_cond_4 = do return (Atom Nil) + pat_cond_5 = do do let pat_cond_6 = do return (Atom Nil) + pat_cond_7 = do do !appl_8 <- kl_V1466 `pseq` (kl_ArityF `pseq` kl_shen_lambda_form kl_V1466 kl_ArityF) + !appl_9 <- appl_8 `pseq` evalKL appl_8 + !appl_10 <- kl_V1466 `pseq` (appl_9 `pseq` klCons kl_V1466 appl_9) + let !appl_11 = Atom Nil + appl_10 `pseq` (appl_11 `pseq` klCons appl_10 appl_11) + in case kl_ArityF of + kl_ArityF@(Atom (N (KI 0))) -> pat_cond_6 + _ -> pat_cond_7 + in case kl_ArityF of + kl_ArityF@(Atom (N (KI (-1)))) -> pat_cond_4 + _ -> pat_cond_5))) + !appl_12 <- kl_V1466 `pseq` kl_arity kl_V1466 + appl_12 `pseq` applyWrapper appl_3 [appl_12] + in case kl_V1466 of + kl_V1466@(Atom (UnboundSym "package")) -> pat_cond_0 + kl_V1466@(ApplC (PL "package" _)) -> pat_cond_0 + kl_V1466@(ApplC (Func "package" _)) -> pat_cond_0 + kl_V1466@(Atom (UnboundSym "receive")) -> pat_cond_1 + kl_V1466@(ApplC (PL "receive" _)) -> pat_cond_1 + kl_V1466@(ApplC (Func "receive" _)) -> pat_cond_1 + _ -> pat_cond_2 + +kl_shen_lambda_form :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_lambda_form (!kl_V1469) (!kl_V1470) = do let pat_cond_0 = do return kl_V1469 + pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_3 <- kl_V1469 `pseq` (kl_X `pseq` kl_shen_add_end kl_V1469 kl_X) + !appl_4 <- kl_V1470 `pseq` Primitives.subtract kl_V1470 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_5 <- appl_3 `pseq` (appl_4 `pseq` kl_shen_lambda_form appl_3 appl_4) + let !appl_6 = Atom Nil + !appl_7 <- appl_5 `pseq` (appl_6 `pseq` klCons appl_5 appl_6) + !appl_8 <- kl_X `pseq` (appl_7 `pseq` klCons kl_X appl_7) + appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_8))) + !appl_9 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "V")) + appl_9 `pseq` applyWrapper appl_2 [appl_9] + in case kl_V1470 of + kl_V1470@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_add_end :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_add_end (!kl_V1473) (!kl_V1474) = do let pat_cond_0 kl_V1473 kl_V1473h kl_V1473t = do let !appl_1 = Atom Nil + !appl_2 <- kl_V1474 `pseq` (appl_1 `pseq` klCons kl_V1474 appl_1) + kl_V1473 `pseq` (appl_2 `pseq` kl_append kl_V1473 appl_2) + pat_cond_3 = do do let !appl_4 = Atom Nil + !appl_5 <- kl_V1474 `pseq` (appl_4 `pseq` klCons kl_V1474 appl_4) + kl_V1473 `pseq` (appl_5 `pseq` klCons kl_V1473 appl_5) + in case kl_V1473 of + !(kl_V1473@(Cons (!kl_V1473h) + (!kl_V1473t))) -> pat_cond_0 kl_V1473 kl_V1473h kl_V1473t + _ -> pat_cond_3 + +kl_shen_set_lambda_form_entry :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_set_lambda_form_entry (!kl_V1476) = do let pat_cond_0 kl_V1476 kl_V1476h kl_V1476t = do !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + kl_V1476h `pseq` (kl_V1476t `pseq` (appl_1 `pseq` kl_put kl_V1476h (ApplC (wrapNamed "shen.lambda-form" kl_shen_lambda_form)) kl_V1476t appl_1)) + pat_cond_2 = do do kl_shen_f_error (ApplC (wrapNamed "shen.set-lambda-form-entry" kl_shen_set_lambda_form_entry)) + in case kl_V1476 of + !(kl_V1476@(Cons (!kl_V1476h) + (!kl_V1476t))) -> pat_cond_0 kl_V1476 kl_V1476h kl_V1476t + _ -> pat_cond_2 + +kl_specialise :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_specialise (!kl_V1478) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*special*")) + !appl_1 <- kl_V1478 `pseq` (appl_0 `pseq` klCons kl_V1478 appl_0) + !appl_2 <- appl_1 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*special*")) appl_1 + appl_2 `pseq` (kl_V1478 `pseq` kl_do appl_2 kl_V1478) + +kl_unspecialise :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_unspecialise (!kl_V1480) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*special*")) + !appl_1 <- kl_V1480 `pseq` (appl_0 `pseq` kl_remove kl_V1480 appl_0) + !appl_2 <- appl_1 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*special*")) appl_1 + appl_2 `pseq` (kl_V1480 `pseq` kl_do appl_2 kl_V1480) + +expr11 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr11 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*installing-kl*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_0 = Atom Nil + appl_0 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*history*")) appl_0) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*tc*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do !appl_1 <- kl_dict (Core.Types.Atom (Core.Types.N (Core.Types.KI 20000))) + appl_1 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) appl_1) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*process-counter*")) (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do !appl_2 <- kl_vector (Core.Types.Atom (Core.Types.N (Core.Types.KI 1000))) + appl_2 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*varcounter*")) appl_2) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do !appl_3 <- kl_vector (Core.Types.Atom (Core.Types.N (Core.Types.KI 1000))) + appl_3 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*prologvectors*")) appl_3) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_X) -> do return kl_X))) + appl_4 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*demodulation-function*")) appl_4) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_5 = Atom Nil + !appl_6 <- appl_5 `pseq` klCons (ApplC (wrapNamed "shen.function-macro" kl_shen_function_macro)) appl_5 + !appl_7 <- appl_6 `pseq` klCons (ApplC (wrapNamed "shen.defprolog-macro" kl_shen_defprolog_macro)) appl_6 + !appl_8 <- appl_7 `pseq` klCons (ApplC (wrapNamed "shen.@s-macro" kl_shen_Ats_macro)) appl_7 + !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "shen.nl-macro" kl_shen_nl_macro)) appl_8 + !appl_10 <- appl_9 `pseq` klCons (ApplC (wrapNamed "shen.synonyms-macro" kl_shen_synonyms_macro)) appl_9 + !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "shen.prolog-macro" kl_shen_prolog_macro)) appl_10 + !appl_12 <- appl_11 `pseq` klCons (ApplC (wrapNamed "shen.error-macro" kl_shen_error_macro)) appl_11 + !appl_13 <- appl_12 `pseq` klCons (ApplC (wrapNamed "shen.input-macro" kl_shen_input_macro)) appl_12 + !appl_14 <- appl_13 `pseq` klCons (ApplC (wrapNamed "shen.output-macro" kl_shen_output_macro)) appl_13 + !appl_15 <- appl_14 `pseq` klCons (ApplC (wrapNamed "shen.make-string-macro" kl_shen_make_string_macro)) appl_14 + !appl_16 <- appl_15 `pseq` klCons (ApplC (wrapNamed "shen.assoc-macro" kl_shen_assoc_macro)) appl_15 + !appl_17 <- appl_16 `pseq` klCons (ApplC (wrapNamed "shen.let-macro" kl_shen_let_macro)) appl_16 + !appl_18 <- appl_17 `pseq` klCons (ApplC (wrapNamed "shen.datatype-macro" kl_shen_datatype_macro)) appl_17 + !appl_19 <- appl_18 `pseq` klCons (ApplC (wrapNamed "shen.compile-macro" kl_shen_compile_macro)) appl_18 + !appl_20 <- appl_19 `pseq` klCons (ApplC (wrapNamed "shen.put/get-macro" kl_shen_putDivget_macro)) appl_19 + !appl_21 <- appl_20 `pseq` klCons (ApplC (wrapNamed "shen.abs-macro" kl_shen_abs_macro)) appl_20 + !appl_22 <- appl_21 `pseq` klCons (ApplC (wrapNamed "shen.cases-macro" kl_shen_cases_macro)) appl_21 + !appl_23 <- appl_22 `pseq` klCons (ApplC (wrapNamed "shen.timer-macro" kl_shen_timer_macro)) appl_22 + appl_23 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*macroreg*")) appl_23) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_timer_macro kl_X))) + let !appl_25 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_cases_macro kl_X))) + let !appl_26 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_abs_macro kl_X))) + let !appl_27 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_putDivget_macro kl_X))) + let !appl_28 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_compile_macro kl_X))) + let !appl_29 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_datatype_macro kl_X))) + let !appl_30 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_let_macro kl_X))) + let !appl_31 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_assoc_macro kl_X))) + let !appl_32 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_make_string_macro kl_X))) + let !appl_33 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_output_macro kl_X))) + let !appl_34 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_input_macro kl_X))) + let !appl_35 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_error_macro kl_X))) + let !appl_36 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_prolog_macro kl_X))) + let !appl_37 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_synonyms_macro kl_X))) + let !appl_38 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_nl_macro kl_X))) + let !appl_39 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_Ats_macro kl_X))) + let !appl_40 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_defprolog_macro kl_X))) + let !appl_41 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_function_macro kl_X))) + let !appl_42 = Atom Nil + !appl_43 <- appl_41 `pseq` (appl_42 `pseq` klCons appl_41 appl_42) + !appl_44 <- appl_40 `pseq` (appl_43 `pseq` klCons appl_40 appl_43) + !appl_45 <- appl_39 `pseq` (appl_44 `pseq` klCons appl_39 appl_44) + !appl_46 <- appl_38 `pseq` (appl_45 `pseq` klCons appl_38 appl_45) + !appl_47 <- appl_37 `pseq` (appl_46 `pseq` klCons appl_37 appl_46) + !appl_48 <- appl_36 `pseq` (appl_47 `pseq` klCons appl_36 appl_47) + !appl_49 <- appl_35 `pseq` (appl_48 `pseq` klCons appl_35 appl_48) + !appl_50 <- appl_34 `pseq` (appl_49 `pseq` klCons appl_34 appl_49) + !appl_51 <- appl_33 `pseq` (appl_50 `pseq` klCons appl_33 appl_50) + !appl_52 <- appl_32 `pseq` (appl_51 `pseq` klCons appl_32 appl_51) + !appl_53 <- appl_31 `pseq` (appl_52 `pseq` klCons appl_31 appl_52) + !appl_54 <- appl_30 `pseq` (appl_53 `pseq` klCons appl_30 appl_53) + !appl_55 <- appl_29 `pseq` (appl_54 `pseq` klCons appl_29 appl_54) + !appl_56 <- appl_28 `pseq` (appl_55 `pseq` klCons appl_28 appl_55) + !appl_57 <- appl_27 `pseq` (appl_56 `pseq` klCons appl_27 appl_56) + !appl_58 <- appl_26 `pseq` (appl_57 `pseq` klCons appl_26 appl_57) + !appl_59 <- appl_25 `pseq` (appl_58 `pseq` klCons appl_25 appl_58) + !appl_60 <- appl_24 `pseq` (appl_59 `pseq` klCons appl_24 appl_59) + appl_60 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "*macros*")) appl_60) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*gensym*")) (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_61 = Atom Nil + appl_61 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*tracking*")) appl_61) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_62 = Atom Nil + !appl_63 <- appl_62 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Z")) appl_62 + !appl_64 <- appl_63 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Y")) appl_63 + !appl_65 <- appl_64 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_64 + !appl_66 <- appl_65 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "W")) appl_65 + !appl_67 <- appl_66 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_66 + !appl_68 <- appl_67 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "U")) appl_67 + !appl_69 <- appl_68 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "T")) appl_68 + !appl_70 <- appl_69 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "S")) appl_69 + !appl_71 <- appl_70 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "R")) appl_70 + !appl_72 <- appl_71 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Q")) appl_71 + !appl_73 <- appl_72 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "P")) appl_72 + !appl_74 <- appl_73 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "O")) appl_73 + !appl_75 <- appl_74 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "N")) appl_74 + !appl_76 <- appl_75 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "M")) appl_75 + !appl_77 <- appl_76 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "L")) appl_76 + !appl_78 <- appl_77 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_77 + !appl_79 <- appl_78 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "J")) appl_78 + !appl_80 <- appl_79 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "I")) appl_79 + !appl_81 <- appl_80 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "H")) appl_80 + !appl_82 <- appl_81 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "G")) appl_81 + !appl_83 <- appl_82 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "F")) appl_82 + !appl_84 <- appl_83 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "E")) appl_83 + !appl_85 <- appl_84 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "D")) appl_84 + !appl_86 <- appl_85 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "C")) appl_85 + !appl_87 <- appl_86 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_86 + !appl_88 <- appl_87 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_87 + appl_88 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*alphabet*")) appl_88) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_89 = Atom Nil + !appl_90 <- appl_89 `pseq` klCons (ApplC (wrapNamed "open" openStream)) appl_89 + !appl_91 <- appl_90 `pseq` klCons (ApplC (wrapNamed "set" klSet)) appl_90 + !appl_92 <- appl_91 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "where")) appl_91 + !appl_93 <- appl_92 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_92 + !appl_94 <- appl_93 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_93 + !appl_95 <- appl_94 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_94 + !appl_96 <- appl_95 `pseq` klCons (ApplC (wrapNamed "@v" kl_Atv)) appl_95 + !appl_97 <- appl_96 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_96 + !appl_98 <- appl_97 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_97 + appl_98 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*special*")) appl_98) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_99 = Atom Nil + !appl_100 <- appl_99 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defmacro")) appl_99 + !appl_101 <- appl_100 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.read+")) appl_100 + !appl_102 <- appl_101 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defcc")) appl_101 + !appl_103 <- appl_102 `pseq` klCons (ApplC (wrapNamed "input+" kl_inputPlus)) appl_102 + !appl_104 <- appl_103 `pseq` klCons (ApplC (wrapNamed "shen.process-datatype" kl_shen_process_datatype)) appl_103 + !appl_105 <- appl_104 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "define")) appl_104 + appl_105 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*extraspecial*")) appl_105) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*spy*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_106 = Atom Nil + appl_106 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) appl_106) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_107 = Atom Nil + appl_107 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*alldatatypes*")) appl_107) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*shen-type-theory-enabled?*")) (Atom (B True))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_108 = Atom Nil + appl_108 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*synonyms*")) appl_108) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_109 = Atom Nil + appl_109 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*system*")) appl_109) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_110 = Atom Nil + appl_110 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*signedfuncs*")) appl_110) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*maxcomplexity*")) (Core.Types.Atom (Core.Types.N (Core.Types.KI 128)))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*occurs*")) (Atom (B True))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*maxinferences*")) (Core.Types.Atom (Core.Types.N (Core.Types.KI 1000000)))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "*maximum-print-sequence-size*")) (Core.Types.Atom (Core.Types.N (Core.Types.KI 20)))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*catch*")) (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*call*")) (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*infs*")) (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "*hush*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*optimise*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "*version*")) (Core.Types.Atom (Core.Types.Str "Shen 20.0"))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do !appl_111 <- kl_boundP (Core.Types.Atom (Core.Types.UnboundSym "*home-directory*")) + !kl_if_112 <- appl_111 `pseq` kl_not appl_111 + case kl_if_112 of + Atom (B (True)) -> do klSet (Core.Types.Atom (Core.Types.UnboundSym "*home-directory*")) (Core.Types.Atom (Core.Types.Str "")) + Atom (B (False)) -> do do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + _ -> throwError "if: expected boolean") `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do !appl_113 <- kl_boundP (Core.Types.Atom (Core.Types.UnboundSym "shen.*sterror*")) + !kl_if_114 <- appl_113 `pseq` kl_not appl_113 + case kl_if_114 of + Atom (B (True)) -> do !appl_115 <- value (Core.Types.Atom (Core.Types.UnboundSym "*stoutput*")) + appl_115 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*sterror*")) appl_115 + Atom (B (False)) -> do do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + _ -> throwError "if: expected boolean") `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_116 = Atom Nil + !appl_117 <- appl_116 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_116 + !appl_118 <- appl_117 `pseq` klCons (ApplC (wrapNamed "dict-values" kl_dict_values)) appl_117 + !appl_119 <- appl_118 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_118 + !appl_120 <- appl_119 `pseq` klCons (ApplC (wrapNamed "dict-keys" kl_dict_keys)) appl_119 + !appl_121 <- appl_120 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_120 + !appl_122 <- appl_121 `pseq` klCons (ApplC (wrapNamed "dict-fold" kl_dict_fold)) appl_121 + !appl_123 <- appl_122 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_122 + !appl_124 <- appl_123 `pseq` klCons (ApplC (wrapNamed "dict-rm" kl_dict_rm)) appl_123 + !appl_125 <- appl_124 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_124 + !appl_126 <- appl_125 `pseq` klCons (ApplC (wrapNamed "<-dict" kl_LB_dict)) appl_125 + !appl_127 <- appl_126 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_126 + !appl_128 <- appl_127 `pseq` klCons (ApplC (wrapNamed "<-dict/or" kl_LB_dictDivor)) appl_127 + !appl_129 <- appl_128 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_128 + !appl_130 <- appl_129 `pseq` klCons (ApplC (wrapNamed "dict->" kl_dict_RB)) appl_129 + !appl_131 <- appl_130 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_130 + !appl_132 <- appl_131 `pseq` klCons (ApplC (wrapNamed "dict-count" kl_dict_count)) appl_131 + !appl_133 <- appl_132 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_132 + !appl_134 <- appl_133 `pseq` klCons (ApplC (wrapNamed "dict?" kl_dictP)) appl_133 + !appl_135 <- appl_134 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_134 + !appl_136 <- appl_135 `pseq` klCons (ApplC (wrapNamed "dict" kl_dict)) appl_135 + !appl_137 <- appl_136 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_136 + !appl_138 <- appl_137 `pseq` klCons (ApplC (wrapNamed "include-all-but" kl_include_all_but)) appl_137 + !appl_139 <- appl_138 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_138 + !appl_140 <- appl_139 `pseq` klCons (ApplC (wrapNamed "preclude-all-but" kl_preclude_all_but)) appl_139 + !appl_141 <- appl_140 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_140 + !appl_142 <- appl_141 `pseq` klCons (ApplC (wrapNamed "include" kl_include)) appl_141 + !appl_143 <- appl_142 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_142 + !appl_144 <- appl_143 `pseq` klCons (ApplC (wrapNamed "preclude" kl_preclude)) appl_143 + !appl_145 <- appl_144 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_144 + !appl_146 <- appl_145 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_145 + !appl_147 <- appl_146 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_146 + !appl_148 <- appl_147 `pseq` klCons (ApplC (wrapNamed "@v" kl_Atv)) appl_147 + !appl_149 <- appl_148 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_148 + !appl_150 <- appl_149 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_149 + !appl_151 <- appl_150 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_150 + !appl_152 <- appl_151 `pseq` klCons (ApplC (wrapNamed "" kl_LBExclRB)) appl_151 + !appl_153 <- appl_152 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_152 + !appl_154 <- appl_153 `pseq` klCons (ApplC (wrapNamed "" kl_LBeRB)) appl_153 + !appl_155 <- appl_154 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_154 + !appl_156 <- appl_155 `pseq` klCons (ApplC (wrapNamed "==" kl_EqEq)) appl_155 + !appl_157 <- appl_156 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_156 + !appl_158 <- appl_157 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_157 + !appl_159 <- appl_158 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_158 + !appl_160 <- appl_159 `pseq` klCons (ApplC (wrapNamed "/" divide)) appl_159 + !appl_161 <- appl_160 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_160 + !appl_162 <- appl_161 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_161 + !appl_163 <- appl_162 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_162 + !appl_164 <- appl_163 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_163 + !appl_165 <- appl_164 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_164 + !appl_166 <- appl_165 `pseq` klCons (ApplC (wrapNamed "y-or-n?" kl_y_or_nP)) appl_165 + !appl_167 <- appl_166 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_166 + !appl_168 <- appl_167 `pseq` klCons (ApplC (wrapNamed "write-to-file" kl_write_to_file)) appl_167 + !appl_169 <- appl_168 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_168 + !appl_170 <- appl_169 `pseq` klCons (ApplC (wrapNamed "write-byte" writeByte)) appl_169 + !appl_171 <- appl_170 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_170 + !appl_172 <- appl_171 `pseq` klCons (ApplC (PL "version" kl_version)) appl_171 + !appl_173 <- appl_172 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_172 + !appl_174 <- appl_173 `pseq` klCons (ApplC (wrapNamed "variable?" kl_variableP)) appl_173 + !appl_175 <- appl_174 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_174 + !appl_176 <- appl_175 `pseq` klCons (ApplC (wrapNamed "value/or" kl_valueDivor)) appl_175 + !appl_177 <- appl_176 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_176 + !appl_178 <- appl_177 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_177 + !appl_179 <- appl_178 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_178 + !appl_180 <- appl_179 `pseq` klCons (ApplC (wrapNamed "vector->" kl_vector_RB)) appl_179 + !appl_181 <- appl_180 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_180 + !appl_182 <- appl_181 `pseq` klCons (ApplC (wrapNamed "vector?" kl_vectorP)) appl_181 + !appl_183 <- appl_182 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_182 + !appl_184 <- appl_183 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_183 + !appl_185 <- appl_184 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_184 + !appl_186 <- appl_185 `pseq` klCons (ApplC (wrapNamed "undefmacro" kl_undefmacro)) appl_185 + !appl_187 <- appl_186 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_186 + !appl_188 <- appl_187 `pseq` klCons (ApplC (wrapNamed "unspecialise" kl_unspecialise)) appl_187 + !appl_189 <- appl_188 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_188 + !appl_190 <- appl_189 `pseq` klCons (ApplC (wrapNamed "untrack" kl_untrack)) appl_189 + !appl_191 <- appl_190 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_190 + !appl_192 <- appl_191 `pseq` klCons (ApplC (wrapNamed "union" kl_union)) appl_191 + !appl_193 <- appl_192 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 4))) appl_192 + !appl_194 <- appl_193 `pseq` klCons (ApplC (wrapNamed "unify!" kl_unifyExcl)) appl_193 + !appl_195 <- appl_194 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 4))) appl_194 + !appl_196 <- appl_195 `pseq` klCons (ApplC (wrapNamed "unify" kl_unify)) appl_195 + !appl_197 <- appl_196 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_196 + !appl_198 <- appl_197 `pseq` klCons (ApplC (wrapNamed "unprofile" kl_unprofile)) appl_197 + !appl_199 <- appl_198 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_198 + !appl_200 <- appl_199 `pseq` klCons (ApplC (wrapNamed "unput" kl_unput)) appl_199 + !appl_201 <- appl_200 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_200 + !appl_202 <- appl_201 `pseq` klCons (ApplC (wrapNamed "undefmacro" kl_undefmacro)) appl_201 + !appl_203 <- appl_202 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_202 + !appl_204 <- appl_203 `pseq` klCons (ApplC (wrapNamed "return" kl_return)) appl_203 + !appl_205 <- appl_204 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_204 + !appl_206 <- appl_205 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_205 + !appl_207 <- appl_206 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_206 + !appl_208 <- appl_207 `pseq` klCons (ApplC (wrapNamed "tuple?" kl_tupleP)) appl_207 + !appl_209 <- appl_208 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_208 + !appl_210 <- appl_209 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "trap-error")) appl_209 + !appl_211 <- appl_210 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_210 + !appl_212 <- appl_211 `pseq` klCons (ApplC (wrapNamed "track" kl_track)) appl_211 + !appl_213 <- appl_212 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_212 + !appl_214 <- appl_213 `pseq` klCons (ApplC (wrapNamed "tlstr" tlstr)) appl_213 + !appl_215 <- appl_214 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_214 + !appl_216 <- appl_215 `pseq` klCons (ApplC (wrapNamed "thaw" kl_thaw)) appl_215 + !appl_217 <- appl_216 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_216 + !appl_218 <- appl_217 `pseq` klCons (ApplC (PL "tc?" kl_tcP)) appl_217 + !appl_219 <- appl_218 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_218 + !appl_220 <- appl_219 `pseq` klCons (ApplC (wrapNamed "tc" kl_tc)) appl_219 + !appl_221 <- appl_220 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_220 + !appl_222 <- appl_221 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_221 + !appl_223 <- appl_222 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_222 + !appl_224 <- appl_223 `pseq` klCons (ApplC (wrapNamed "tail" kl_tail)) appl_223 + !appl_225 <- appl_224 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_224 + !appl_226 <- appl_225 `pseq` klCons (ApplC (wrapNamed "systemf" kl_systemf)) appl_225 + !appl_227 <- appl_226 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_226 + !appl_228 <- appl_227 `pseq` klCons (ApplC (wrapNamed "symbol?" kl_symbolP)) appl_227 + !appl_229 <- appl_228 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_228 + !appl_230 <- appl_229 `pseq` klCons (ApplC (wrapNamed "sum" kl_sum)) appl_229 + !appl_231 <- appl_230 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_230 + !appl_232 <- appl_231 `pseq` klCons (ApplC (wrapNamed "subst" kl_subst)) appl_231 + !appl_233 <- appl_232 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_232 + !appl_234 <- appl_233 `pseq` klCons (ApplC (wrapNamed "str" str)) appl_233 + !appl_235 <- appl_234 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_234 + !appl_236 <- appl_235 `pseq` klCons (ApplC (wrapNamed "string?" stringP)) appl_235 + !appl_237 <- appl_236 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_236 + !appl_238 <- appl_237 `pseq` klCons (ApplC (wrapNamed "string->symbol" kl_string_RBsymbol)) appl_237 + !appl_239 <- appl_238 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_238 + !appl_240 <- appl_239 `pseq` klCons (ApplC (wrapNamed "string->n" stringToN)) appl_239 + !appl_241 <- appl_240 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_240 + !appl_242 <- appl_241 `pseq` klCons (ApplC (PL "sterror" kl_sterror)) appl_241 + !appl_243 <- appl_242 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_242 + !appl_244 <- appl_243 `pseq` klCons (ApplC (PL "stoutput" kl_stoutput)) appl_243 + !appl_245 <- appl_244 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_244 + !appl_246 <- appl_245 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_245 + !appl_247 <- appl_246 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_246 + !appl_248 <- appl_247 `pseq` klCons (ApplC (wrapNamed "step" kl_step)) appl_247 + !appl_249 <- appl_248 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_248 + !appl_250 <- appl_249 `pseq` klCons (ApplC (wrapNamed "spy" kl_spy)) appl_249 + !appl_251 <- appl_250 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_250 + !appl_252 <- appl_251 `pseq` klCons (ApplC (wrapNamed "specialise" kl_specialise)) appl_251 + !appl_253 <- appl_252 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_252 + !appl_254 <- appl_253 `pseq` klCons (ApplC (wrapNamed "snd" kl_snd)) appl_253 + !appl_255 <- appl_254 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_254 + !appl_256 <- appl_255 `pseq` klCons (ApplC (wrapNamed "simple-error" simpleError)) appl_255 + !appl_257 <- appl_256 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_256 + !appl_258 <- appl_257 `pseq` klCons (ApplC (wrapNamed "set" klSet)) appl_257 + !appl_259 <- appl_258 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_258 + !appl_260 <- appl_259 `pseq` klCons (ApplC (wrapNamed "reverse" kl_reverse)) appl_259 + !appl_261 <- appl_260 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_260 + !appl_262 <- appl_261 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.require")) appl_261 + !appl_263 <- appl_262 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_262 + !appl_264 <- appl_263 `pseq` klCons (ApplC (wrapNamed "remove" kl_remove)) appl_263 + !appl_265 <- appl_264 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_264 + !appl_266 <- appl_265 `pseq` klCons (ApplC (PL "release" kl_release)) appl_265 + !appl_267 <- appl_266 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_266 + !appl_268 <- appl_267 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "receive")) appl_267 + !appl_269 <- appl_268 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_268 + !appl_270 <- appl_269 `pseq` klCons (ApplC (wrapNamed "read-char-code" kl_read_char_code)) appl_269 + !appl_271 <- appl_270 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_270 + !appl_272 <- appl_271 `pseq` klCons (ApplC (wrapNamed "read-from-string" kl_read_from_string)) appl_271 + !appl_273 <- appl_272 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_272 + !appl_274 <- appl_273 `pseq` klCons (ApplC (wrapNamed "read-byte" readByte)) appl_273 + !appl_275 <- appl_274 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_274 + !appl_276 <- appl_275 `pseq` klCons (ApplC (wrapNamed "read" kl_read)) appl_275 + !appl_277 <- appl_276 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_276 + !appl_278 <- appl_277 `pseq` klCons (ApplC (wrapNamed "read-file-as-bytelist" kl_read_file_as_bytelist)) appl_277 + !appl_279 <- appl_278 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_278 + !appl_280 <- appl_279 `pseq` klCons (ApplC (wrapNamed "read-file-as-charlist" kl_read_file_as_charlist)) appl_279 + !appl_281 <- appl_280 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_280 + !appl_282 <- appl_281 `pseq` klCons (ApplC (wrapNamed "read-file" kl_read_file)) appl_281 + !appl_283 <- appl_282 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_282 + !appl_284 <- appl_283 `pseq` klCons (ApplC (wrapNamed "read-file-as-string" kl_read_file_as_string)) appl_283 + !appl_285 <- appl_284 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_284 + !appl_286 <- appl_285 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.reassemble")) appl_285 + !appl_287 <- appl_286 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 4))) appl_286 + !appl_288 <- appl_287 `pseq` klCons (ApplC (wrapNamed "put" kl_put)) appl_287 + !appl_289 <- appl_288 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_288 + !appl_290 <- appl_289 `pseq` klCons (ApplC (wrapNamed "address->" addressTo)) appl_289 + !appl_291 <- appl_290 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_290 + !appl_292 <- appl_291 `pseq` klCons (ApplC (wrapNamed "protect" kl_protect)) appl_291 + !appl_293 <- appl_292 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_292 + !appl_294 <- appl_293 `pseq` klCons (ApplC (wrapNamed "preclude-all-but" kl_preclude_all_but)) appl_293 + !appl_295 <- appl_294 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_294 + !appl_296 <- appl_295 `pseq` klCons (ApplC (wrapNamed "preclude" kl_preclude)) appl_295 + !appl_297 <- appl_296 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_296 + !appl_298 <- appl_297 `pseq` klCons (ApplC (wrapNamed "ps" kl_ps)) appl_297 + !appl_299 <- appl_298 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_298 + !appl_300 <- appl_299 `pseq` klCons (ApplC (wrapNamed "pr" kl_pr)) appl_299 + !appl_301 <- appl_300 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_300 + !appl_302 <- appl_301 `pseq` klCons (ApplC (wrapNamed "profile-results" kl_profile_results)) appl_301 + !appl_303 <- appl_302 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_302 + !appl_304 <- appl_303 `pseq` klCons (ApplC (wrapNamed "profile" kl_profile)) appl_303 + !appl_305 <- appl_304 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_304 + !appl_306 <- appl_305 `pseq` klCons (ApplC (wrapNamed "print" kl_print)) appl_305 + !appl_307 <- appl_306 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_306 + !appl_308 <- appl_307 `pseq` klCons (ApplC (wrapNamed "pos" pos)) appl_307 + !appl_309 <- appl_308 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_308 + !appl_310 <- appl_309 `pseq` klCons (ApplC (PL "porters" kl_porters)) appl_309 + !appl_311 <- appl_310 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_310 + !appl_312 <- appl_311 `pseq` klCons (ApplC (PL "port" kl_port)) appl_311 + !appl_313 <- appl_312 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_312 + !appl_314 <- appl_313 `pseq` klCons (ApplC (wrapNamed "package?" kl_packageP)) appl_313 + !appl_315 <- appl_314 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_314 + !appl_316 <- appl_315 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "package")) appl_315 + !appl_317 <- appl_316 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_316 + !appl_318 <- appl_317 `pseq` klCons (ApplC (PL "os" kl_os)) appl_317 + !appl_319 <- appl_318 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_318 + !appl_320 <- appl_319 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "or")) appl_319 + !appl_321 <- appl_320 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_320 + !appl_322 <- appl_321 `pseq` klCons (ApplC (wrapNamed "optimise" kl_optimise)) appl_321 + !appl_323 <- appl_322 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_322 + !appl_324 <- appl_323 `pseq` klCons (ApplC (wrapNamed "open" openStream)) appl_323 + !appl_325 <- appl_324 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_324 + !appl_326 <- appl_325 `pseq` klCons (ApplC (wrapNamed "occurs-check" kl_occurs_check)) appl_325 + !appl_327 <- appl_326 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_326 + !appl_328 <- appl_327 `pseq` klCons (ApplC (wrapNamed "occurrences" kl_occurrences)) appl_327 + !appl_329 <- appl_328 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_328 + !appl_330 <- appl_329 `pseq` klCons (ApplC (wrapNamed "occurs-check" kl_occurs_check)) appl_329 + !appl_331 <- appl_330 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_330 + !appl_332 <- appl_331 `pseq` klCons (ApplC (wrapNamed "number?" numberP)) appl_331 + !appl_333 <- appl_332 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_332 + !appl_334 <- appl_333 `pseq` klCons (ApplC (wrapNamed "n->string" nToString)) appl_333 + !appl_335 <- appl_334 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_334 + !appl_336 <- appl_335 `pseq` klCons (ApplC (wrapNamed "nth" kl_nth)) appl_335 + !appl_337 <- appl_336 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_336 + !appl_338 <- appl_337 `pseq` klCons (ApplC (wrapNamed "not" kl_not)) appl_337 + !appl_339 <- appl_338 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_338 + !appl_340 <- appl_339 `pseq` klCons (ApplC (wrapNamed "nl" kl_nl)) appl_339 + !appl_341 <- appl_340 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_340 + !appl_342 <- appl_341 `pseq` klCons (ApplC (wrapNamed "maxinferences" kl_maxinferences)) appl_341 + !appl_343 <- appl_342 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_342 + !appl_344 <- appl_343 `pseq` klCons (ApplC (wrapNamed "mapcan" kl_mapcan)) appl_343 + !appl_345 <- appl_344 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_344 + !appl_346 <- appl_345 `pseq` klCons (ApplC (wrapNamed "map" kl_map)) appl_345 + !appl_347 <- appl_346 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_346 + !appl_348 <- appl_347 `pseq` klCons (ApplC (wrapNamed "macroexpand" kl_macroexpand)) appl_347 + !appl_349 <- appl_348 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_348 + !appl_350 <- appl_349 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_349 + !appl_351 <- appl_350 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_350 + !appl_352 <- appl_351 `pseq` klCons (ApplC (wrapNamed "<=" lessThanOrEqualTo)) appl_351 + !appl_353 <- appl_352 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_352 + !appl_354 <- appl_353 `pseq` klCons (ApplC (wrapNamed "<" lessThan)) appl_353 + !appl_355 <- appl_354 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_354 + !appl_356 <- appl_355 `pseq` klCons (ApplC (wrapNamed "load" kl_load)) appl_355 + !appl_357 <- appl_356 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_356 + !appl_358 <- appl_357 `pseq` klCons (ApplC (wrapNamed "lineread" kl_lineread)) appl_357 + !appl_359 <- appl_358 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_358 + !appl_360 <- appl_359 `pseq` klCons (ApplC (wrapNamed "limit" kl_limit)) appl_359 + !appl_361 <- appl_360 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_360 + !appl_362 <- appl_361 `pseq` klCons (ApplC (wrapNamed "length" kl_length)) appl_361 + !appl_363 <- appl_362 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_362 + !appl_364 <- appl_363 `pseq` klCons (ApplC (PL "language" kl_language)) appl_363 + !appl_365 <- appl_364 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_364 + !appl_366 <- appl_365 `pseq` klCons (ApplC (PL "kill" kl_kill)) appl_365 + !appl_367 <- appl_366 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_366 + !appl_368 <- appl_367 `pseq` klCons (ApplC (PL "it" kl_it)) appl_367 + !appl_369 <- appl_368 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_368 + !appl_370 <- appl_369 `pseq` klCons (ApplC (wrapNamed "internal" kl_internal)) appl_369 + !appl_371 <- appl_370 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_370 + !appl_372 <- appl_371 `pseq` klCons (ApplC (wrapNamed "intersection" kl_intersection)) appl_371 + !appl_373 <- appl_372 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_372 + !appl_374 <- appl_373 `pseq` klCons (ApplC (PL "implementation" kl_implementation)) appl_373 + !appl_375 <- appl_374 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_374 + !appl_376 <- appl_375 `pseq` klCons (ApplC (wrapNamed "input+" kl_inputPlus)) appl_375 + !appl_377 <- appl_376 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_376 + !appl_378 <- appl_377 `pseq` klCons (ApplC (wrapNamed "input" kl_input)) appl_377 + !appl_379 <- appl_378 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_378 + !appl_380 <- appl_379 `pseq` klCons (ApplC (PL "inferences" kl_inferences)) appl_379 + !appl_381 <- appl_380 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 4))) appl_380 + !appl_382 <- appl_381 `pseq` klCons (ApplC (wrapNamed "identical" kl_identical)) appl_381 + !appl_383 <- appl_382 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_382 + !appl_384 <- appl_383 `pseq` klCons (ApplC (wrapNamed "intern" intern)) appl_383 + !appl_385 <- appl_384 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_384 + !appl_386 <- appl_385 `pseq` klCons (ApplC (wrapNamed "integer?" kl_integerP)) appl_385 + !appl_387 <- appl_386 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_386 + !appl_388 <- appl_387 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_387 + !appl_389 <- appl_388 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_388 + !appl_390 <- appl_389 `pseq` klCons (ApplC (wrapNamed "head" kl_head)) appl_389 + !appl_391 <- appl_390 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_390 + !appl_392 <- appl_391 `pseq` klCons (ApplC (wrapNamed "hdstr" kl_hdstr)) appl_391 + !appl_393 <- appl_392 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_392 + !appl_394 <- appl_393 `pseq` klCons (ApplC (wrapNamed "hdv" kl_hdv)) appl_393 + !appl_395 <- appl_394 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_394 + !appl_396 <- appl_395 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_395 + !appl_397 <- appl_396 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_396 + !appl_398 <- appl_397 `pseq` klCons (ApplC (wrapNamed "hash" kl_hash)) appl_397 + !appl_399 <- appl_398 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_398 + !appl_400 <- appl_399 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_399 + !appl_401 <- appl_400 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_400 + !appl_402 <- appl_401 `pseq` klCons (ApplC (wrapNamed ">=" greaterThanOrEqualTo)) appl_401 + !appl_403 <- appl_402 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_402 + !appl_404 <- appl_403 `pseq` klCons (ApplC (wrapNamed ">" greaterThan)) appl_403 + !appl_405 <- appl_404 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_404 + !appl_406 <- appl_405 `pseq` klCons (ApplC (wrapNamed "<-vector/or" kl_LB_vectorDivor)) appl_405 + !appl_407 <- appl_406 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_406 + !appl_408 <- appl_407 `pseq` klCons (ApplC (wrapNamed "<-vector" kl_LB_vector)) appl_407 + !appl_409 <- appl_408 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_408 + !appl_410 <- appl_409 `pseq` klCons (ApplC (wrapNamed "<-address/or" kl_LB_addressDivor)) appl_409 + !appl_411 <- appl_410 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_410 + !appl_412 <- appl_411 `pseq` klCons (ApplC (wrapNamed "<-address" addressFrom)) appl_411 + !appl_413 <- appl_412 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_412 + !appl_414 <- appl_413 `pseq` klCons (ApplC (wrapNamed "address->" addressTo)) appl_413 + !appl_415 <- appl_414 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_414 + !appl_416 <- appl_415 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_415 + !appl_417 <- appl_416 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 4))) appl_416 + !appl_418 <- appl_417 `pseq` klCons (ApplC (wrapNamed "get/or" kl_getDivor)) appl_417 + !appl_419 <- appl_418 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_418 + !appl_420 <- appl_419 `pseq` klCons (ApplC (wrapNamed "get" kl_get)) appl_419 + !appl_421 <- appl_420 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_420 + !appl_422 <- appl_421 `pseq` klCons (ApplC (wrapNamed "gensym" kl_gensym)) appl_421 + !appl_423 <- appl_422 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_422 + !appl_424 <- appl_423 `pseq` klCons (ApplC (wrapNamed "fst" kl_fst)) appl_423 + !appl_425 <- appl_424 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_424 + !appl_426 <- appl_425 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "freeze")) appl_425 + !appl_427 <- appl_426 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 5))) appl_426 + !appl_428 <- appl_427 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "findall")) appl_427 + !appl_429 <- appl_428 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_428 + !appl_430 <- appl_429 `pseq` klCons (ApplC (wrapNamed "for-each" kl_for_each)) appl_429 + !appl_431 <- appl_430 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_430 + !appl_432 <- appl_431 `pseq` klCons (ApplC (wrapNamed "filter" kl_filter)) appl_431 + !appl_433 <- appl_432 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_432 + !appl_434 <- appl_433 `pseq` klCons (ApplC (wrapNamed "fold-right" kl_fold_right)) appl_433 + !appl_435 <- appl_434 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_434 + !appl_436 <- appl_435 `pseq` klCons (ApplC (wrapNamed "fold-left" kl_fold_left)) appl_435 + !appl_437 <- appl_436 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_436 + !appl_438 <- appl_437 `pseq` klCons (ApplC (wrapNamed "fix" kl_fix)) appl_437 + !appl_439 <- appl_438 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_438 + !appl_440 <- appl_439 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_439 + !appl_441 <- appl_440 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_440 + !appl_442 <- appl_441 `pseq` klCons (ApplC (wrapNamed "fail-if" kl_fail_if)) appl_441 + !appl_443 <- appl_442 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_442 + !appl_444 <- appl_443 `pseq` klCons (ApplC (wrapNamed "external" kl_external)) appl_443 + !appl_445 <- appl_444 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_444 + !appl_446 <- appl_445 `pseq` klCons (ApplC (wrapNamed "explode" kl_explode)) appl_445 + !appl_447 <- appl_446 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_446 + !appl_448 <- appl_447 `pseq` klCons (ApplC (wrapNamed "exit" kl_exit)) appl_447 + !appl_449 <- appl_448 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_448 + !appl_450 <- appl_449 `pseq` klCons (ApplC (wrapNamed "eval-kl" evalKL)) appl_449 + !appl_451 <- appl_450 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_450 + !appl_452 <- appl_451 `pseq` klCons (ApplC (wrapNamed "eval" kl_eval)) appl_451 + !appl_453 <- appl_452 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_452 + !appl_454 <- appl_453 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.interror")) appl_453 + !appl_455 <- appl_454 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_454 + !appl_456 <- appl_455 `pseq` klCons (ApplC (wrapNamed "error-to-string" errorToString)) appl_455 + !appl_457 <- appl_456 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_456 + !appl_458 <- appl_457 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "enable-type-theory")) appl_457 + !appl_459 <- appl_458 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_458 + !appl_460 <- appl_459 `pseq` klCons (ApplC (wrapNamed "empty?" kl_emptyP)) appl_459 + !appl_461 <- appl_460 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_460 + !appl_462 <- appl_461 `pseq` klCons (ApplC (wrapNamed "element?" kl_elementP)) appl_461 + !appl_463 <- appl_462 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_462 + !appl_464 <- appl_463 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_463 + !appl_465 <- appl_464 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_464 + !appl_466 <- appl_465 `pseq` klCons (ApplC (wrapNamed "difference" kl_difference)) appl_465 + !appl_467 <- appl_466 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_466 + !appl_468 <- appl_467 `pseq` klCons (ApplC (wrapNamed "destroy" kl_destroy)) appl_467 + !appl_469 <- appl_468 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_468 + !appl_470 <- appl_469 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "declare")) appl_469 + !appl_471 <- appl_470 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_470 + !appl_472 <- appl_471 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_471 + !appl_473 <- appl_472 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_472 + !appl_474 <- appl_473 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_473 + !appl_475 <- appl_474 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_474 + !appl_476 <- appl_475 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_475 + !appl_477 <- appl_476 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_476 + !appl_478 <- appl_477 `pseq` klCons (ApplC (wrapNamed "concat" kl_concat)) appl_477 + !appl_479 <- appl_478 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_478 + !appl_480 <- appl_479 `pseq` klCons (ApplC (wrapNamed "compile" kl_compile)) appl_479 + !appl_481 <- appl_480 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_480 + !appl_482 <- appl_481 `pseq` klCons (ApplC (wrapNamed "close" closeStream)) appl_481 + !appl_483 <- appl_482 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_482 + !appl_484 <- appl_483 `pseq` klCons (ApplC (wrapNamed "cd" kl_cd)) appl_483 + !appl_485 <- appl_484 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_484 + !appl_486 <- appl_485 `pseq` klCons (ApplC (wrapNamed "bound?" kl_boundP)) appl_485 + !appl_487 <- appl_486 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_486 + !appl_488 <- appl_487 `pseq` klCons (ApplC (wrapNamed "boolean?" kl_booleanP)) appl_487 + !appl_489 <- appl_488 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_488 + !appl_490 <- appl_489 `pseq` klCons (ApplC (wrapNamed "assoc" kl_assoc)) appl_489 + !appl_491 <- appl_490 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_490 + !appl_492 <- appl_491 `pseq` klCons (ApplC (wrapNamed "arity" kl_arity)) appl_491 + !appl_493 <- appl_492 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_492 + !appl_494 <- appl_493 `pseq` klCons (ApplC (wrapNamed "append" kl_append)) appl_493 + !appl_495 <- appl_494 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_494 + !appl_496 <- appl_495 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "and")) appl_495 + !appl_497 <- appl_496 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_496 + !appl_498 <- appl_497 `pseq` klCons (ApplC (wrapNamed "adjoin" kl_adjoin)) appl_497 + !appl_499 <- appl_498 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_498 + !appl_500 <- appl_499 `pseq` klCons (ApplC (wrapNamed "absvector" absvector)) appl_499 + !appl_501 <- appl_500 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_500 + !appl_502 <- appl_501 `pseq` klCons (ApplC (wrapNamed "absvector?" absvectorP)) appl_501 + !appl_503 <- appl_502 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_502 + !appl_504 <- appl_503 `pseq` klCons (ApplC (PL "abort" kl_abort)) appl_503 + appl_504 `pseq` kl_shen_initialise_arity_table appl_504) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do !appl_505 <- intern (Core.Types.Atom (Core.Types.Str "shen")) + !appl_506 <- kl_vector (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + let !appl_507 = Atom Nil + !appl_508 <- appl_507 `pseq` klCons (ApplC (wrapNamed "dict-values" kl_dict_values)) appl_507 + !appl_509 <- appl_508 `pseq` klCons (ApplC (wrapNamed "dict-keys" kl_dict_keys)) appl_508 + !appl_510 <- appl_509 `pseq` klCons (ApplC (wrapNamed "dict-fold" kl_dict_fold)) appl_509 + !appl_511 <- appl_510 `pseq` klCons (ApplC (wrapNamed "dict-rm" kl_dict_rm)) appl_510 + !appl_512 <- appl_511 `pseq` klCons (ApplC (wrapNamed "<-dict" kl_LB_dict)) appl_511 + !appl_513 <- appl_512 `pseq` klCons (ApplC (wrapNamed "<-dict/or" kl_LB_dictDivor)) appl_512 + !appl_514 <- appl_513 `pseq` klCons (ApplC (wrapNamed "dict->" kl_dict_RB)) appl_513 + !appl_515 <- appl_514 `pseq` klCons (ApplC (wrapNamed "dict-count" kl_dict_count)) appl_514 + !appl_516 <- appl_515 `pseq` klCons (ApplC (wrapNamed "dict?" kl_dictP)) appl_515 + !appl_517 <- appl_516 `pseq` klCons (ApplC (wrapNamed "dict" kl_dict)) appl_516 + !appl_518 <- appl_517 `pseq` klCons (ApplC (wrapNamed "absvector" absvector)) appl_517 + !appl_519 <- appl_518 `pseq` klCons (ApplC (wrapNamed "absvector?" absvectorP)) appl_518 + !appl_520 <- appl_519 `pseq` klCons (ApplC (wrapNamed "address->" addressTo)) appl_519 + !appl_521 <- appl_520 `pseq` klCons (ApplC (wrapNamed "<-address/or" kl_LB_addressDivor)) appl_520 + !appl_522 <- appl_521 `pseq` klCons (ApplC (wrapNamed "<-address" addressFrom)) appl_521 + !appl_523 <- appl_522 `pseq` klCons (ApplC (wrapNamed "adjoin" kl_adjoin)) appl_522 + !appl_524 <- appl_523 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "and")) appl_523 + !appl_525 <- appl_524 `pseq` klCons (ApplC (wrapNamed "append" kl_append)) appl_524 + !appl_526 <- appl_525 `pseq` klCons (ApplC (PL "abort" kl_abort)) appl_525 + !appl_527 <- appl_526 `pseq` klCons (ApplC (wrapNamed "arity" kl_arity)) appl_526 + !appl_528 <- appl_527 `pseq` klCons (ApplC (wrapNamed "assoc" kl_assoc)) appl_527 + !appl_529 <- appl_528 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "bar!")) appl_528 + !appl_530 <- appl_529 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_529 + !appl_531 <- appl_530 `pseq` klCons (ApplC (wrapNamed "boolean?" kl_booleanP)) appl_530 + !appl_532 <- appl_531 `pseq` klCons (ApplC (wrapNamed "bound?" kl_boundP)) appl_531 + !appl_533 <- appl_532 `pseq` klCons (ApplC (wrapNamed "bind" kl_bind)) appl_532 + !appl_534 <- appl_533 `pseq` klCons (ApplC (wrapNamed "close" closeStream)) appl_533 + !appl_535 <- appl_534 `pseq` klCons (ApplC (wrapNamed "call" kl_call)) appl_534 + !appl_536 <- appl_535 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "cases")) appl_535 + !appl_537 <- appl_536 `pseq` klCons (ApplC (wrapNamed "cd" kl_cd)) appl_536 + !appl_538 <- appl_537 `pseq` klCons (ApplC (wrapNamed "compile" kl_compile)) appl_537 + !appl_539 <- appl_538 `pseq` klCons (ApplC (wrapNamed "concat" kl_concat)) appl_538 + !appl_540 <- appl_539 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "cond")) appl_539 + !appl_541 <- appl_540 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_540 + !appl_542 <- appl_541 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_541 + !appl_543 <- appl_542 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_542 + !appl_544 <- appl_543 `pseq` klCons (ApplC (wrapNamed "cut" kl_cut)) appl_543 + !appl_545 <- appl_544 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "datatype")) appl_544 + !appl_546 <- appl_545 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "declare")) appl_545 + !appl_547 <- appl_546 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defprolog")) appl_546 + !appl_548 <- appl_547 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defcc")) appl_547 + !appl_549 <- appl_548 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defmacro")) appl_548 + !appl_550 <- appl_549 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "define")) appl_549 + !appl_551 <- appl_550 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defun")) appl_550 + !appl_552 <- appl_551 `pseq` klCons (ApplC (wrapNamed "destroy" kl_destroy)) appl_551 + !appl_553 <- appl_552 `pseq` klCons (ApplC (wrapNamed "difference" kl_difference)) appl_552 + !appl_554 <- appl_553 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_553 + !appl_555 <- appl_554 `pseq` klCons (ApplC (wrapNamed "element?" kl_elementP)) appl_554 + !appl_556 <- appl_555 `pseq` klCons (ApplC (wrapNamed "exit" kl_exit)) appl_555 + !appl_557 <- appl_556 `pseq` klCons (ApplC (wrapNamed "empty?" kl_emptyP)) appl_556 + !appl_558 <- appl_557 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "error")) appl_557 + !appl_559 <- appl_558 `pseq` klCons (ApplC (wrapNamed "error-to-string" errorToString)) appl_558 + !appl_560 <- appl_559 `pseq` klCons (ApplC (wrapNamed "eval" kl_eval)) appl_559 + !appl_561 <- appl_560 `pseq` klCons (ApplC (wrapNamed "eval-kl" evalKL)) appl_560 + !appl_562 <- appl_561 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "exception")) appl_561 + !appl_563 <- appl_562 `pseq` klCons (ApplC (wrapNamed "external" kl_external)) appl_562 + !appl_564 <- appl_563 `pseq` klCons (ApplC (wrapNamed "explode" kl_explode)) appl_563 + !appl_565 <- appl_564 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "enable-type-theory")) appl_564 + !appl_566 <- appl_565 `pseq` klCons (Atom (B False)) appl_565 + !appl_567 <- appl_566 `pseq` klCons (ApplC (wrapNamed "filter" kl_filter)) appl_566 + !appl_568 <- appl_567 `pseq` klCons (ApplC (wrapNamed "fold-left" kl_fold_left)) appl_567 + !appl_569 <- appl_568 `pseq` klCons (ApplC (wrapNamed "fold-right" kl_fold_right)) appl_568 + !appl_570 <- appl_569 `pseq` klCons (ApplC (wrapNamed "for-each" kl_for_each)) appl_569 + !appl_571 <- appl_570 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "findall")) appl_570 + !appl_572 <- appl_571 `pseq` klCons (ApplC (wrapNamed "fwhen" kl_fwhen)) appl_571 + !appl_573 <- appl_572 `pseq` klCons (ApplC (wrapNamed "fail-if" kl_fail_if)) appl_572 + !appl_574 <- appl_573 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_573 + !appl_575 <- appl_574 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "file")) appl_574 + !appl_576 <- appl_575 `pseq` klCons (ApplC (wrapNamed "fix" kl_fix)) appl_575 + !appl_577 <- appl_576 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "freeze")) appl_576 + !appl_578 <- appl_577 `pseq` klCons (ApplC (wrapNamed "fst" kl_fst)) appl_577 + !appl_579 <- appl_578 `pseq` klCons (ApplC (wrapNamed "function" kl_function)) appl_578 + !appl_580 <- appl_579 `pseq` klCons (ApplC (wrapNamed "gensym" kl_gensym)) appl_579 + !appl_581 <- appl_580 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_580 + !appl_582 <- appl_581 `pseq` klCons (ApplC (wrapNamed "get/or" kl_getDivor)) appl_581 + !appl_583 <- appl_582 `pseq` klCons (ApplC (wrapNamed "get" kl_get)) appl_582 + !appl_584 <- appl_583 `pseq` klCons (ApplC (wrapNamed "hash" kl_hash)) appl_583 + !appl_585 <- appl_584 `pseq` klCons (ApplC (wrapNamed "hdstr" kl_hdstr)) appl_584 + !appl_586 <- appl_585 `pseq` klCons (ApplC (wrapNamed "hdv" kl_hdv)) appl_585 + !appl_587 <- appl_586 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_586 + !appl_588 <- appl_587 `pseq` klCons (ApplC (wrapNamed "head" kl_head)) appl_587 + !appl_589 <- appl_588 `pseq` klCons (ApplC (wrapNamed "identical" kl_identical)) appl_588 + !appl_590 <- appl_589 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_589 + !appl_591 <- appl_590 `pseq` klCons (ApplC (PL "implementation" kl_implementation)) appl_590 + !appl_592 <- appl_591 `pseq` klCons (ApplC (wrapNamed "internal" kl_internal)) appl_591 + !appl_593 <- appl_592 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "in")) appl_592 + !appl_594 <- appl_593 `pseq` klCons (ApplC (PL "it" kl_it)) appl_593 + !appl_595 <- appl_594 `pseq` klCons (ApplC (wrapNamed "include-all-but" kl_include_all_but)) appl_594 + !appl_596 <- appl_595 `pseq` klCons (ApplC (wrapNamed "include" kl_include)) appl_595 + !appl_597 <- appl_596 `pseq` klCons (ApplC (wrapNamed "input+" kl_inputPlus)) appl_596 + !appl_598 <- appl_597 `pseq` klCons (ApplC (wrapNamed "input" kl_input)) appl_597 + !appl_599 <- appl_598 `pseq` klCons (ApplC (wrapNamed "integer?" kl_integerP)) appl_598 + !appl_600 <- appl_599 `pseq` klCons (ApplC (wrapNamed "intern" intern)) appl_599 + !appl_601 <- appl_600 `pseq` klCons (ApplC (PL "inferences" kl_inferences)) appl_600 + !appl_602 <- appl_601 `pseq` klCons (ApplC (wrapNamed "intersection" kl_intersection)) appl_601 + !appl_603 <- appl_602 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "is")) appl_602 + !appl_604 <- appl_603 `pseq` klCons (ApplC (PL "kill" kl_kill)) appl_603 + !appl_605 <- appl_604 `pseq` klCons (ApplC (PL "language" kl_language)) appl_604 + !appl_606 <- appl_605 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_605 + !appl_607 <- appl_606 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lazy")) appl_606 + !appl_608 <- appl_607 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_607 + !appl_609 <- appl_608 `pseq` klCons (ApplC (wrapNamed "length" kl_length)) appl_608 + !appl_610 <- appl_609 `pseq` klCons (ApplC (wrapNamed "limit" kl_limit)) appl_609 + !appl_611 <- appl_610 `pseq` klCons (ApplC (wrapNamed "lineread" kl_lineread)) appl_610 + !appl_612 <- appl_611 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_611 + !appl_613 <- appl_612 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "loaded")) appl_612 + !appl_614 <- appl_613 `pseq` klCons (ApplC (wrapNamed "load" kl_load)) appl_613 + !appl_615 <- appl_614 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "make-string")) appl_614 + !appl_616 <- appl_615 `pseq` klCons (ApplC (wrapNamed "map" kl_map)) appl_615 + !appl_617 <- appl_616 `pseq` klCons (ApplC (wrapNamed "mapcan" kl_mapcan)) appl_616 + !appl_618 <- appl_617 `pseq` klCons (ApplC (wrapNamed "maxinferences" kl_maxinferences)) appl_617 + !appl_619 <- appl_618 `pseq` klCons (ApplC (wrapNamed "macroexpand" kl_macroexpand)) appl_618 + !appl_620 <- appl_619 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "mode")) appl_619 + !appl_621 <- appl_620 `pseq` klCons (ApplC (wrapNamed "nl" kl_nl)) appl_620 + !appl_622 <- appl_621 `pseq` klCons (ApplC (wrapNamed "not" kl_not)) appl_621 + !appl_623 <- appl_622 `pseq` klCons (ApplC (wrapNamed "nth" kl_nth)) appl_622 + !appl_624 <- appl_623 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "null")) appl_623 + !appl_625 <- appl_624 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_624 + !appl_626 <- appl_625 `pseq` klCons (ApplC (wrapNamed "number?" numberP)) appl_625 + !appl_627 <- appl_626 `pseq` klCons (ApplC (wrapNamed "n->string" nToString)) appl_626 + !appl_628 <- appl_627 `pseq` klCons (ApplC (wrapNamed "occurs-check" kl_occurs_check)) appl_627 + !appl_629 <- appl_628 `pseq` klCons (ApplC (wrapNamed "occurrences" kl_occurrences)) appl_628 + !appl_630 <- appl_629 `pseq` klCons (ApplC (wrapNamed "open" openStream)) appl_629 + !appl_631 <- appl_630 `pseq` klCons (ApplC (wrapNamed "optimise" kl_optimise)) appl_630 + !appl_632 <- appl_631 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "or")) appl_631 + !appl_633 <- appl_632 `pseq` klCons (ApplC (PL "os" kl_os)) appl_632 + !appl_634 <- appl_633 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "out")) appl_633 + !appl_635 <- appl_634 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "output")) appl_634 + !appl_636 <- appl_635 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "package")) appl_635 + !appl_637 <- appl_636 `pseq` klCons (ApplC (PL "port" kl_port)) appl_636 + !appl_638 <- appl_637 `pseq` klCons (ApplC (PL "porters" kl_porters)) appl_637 + !appl_639 <- appl_638 `pseq` klCons (ApplC (wrapNamed "pos" pos)) appl_638 + !appl_640 <- appl_639 `pseq` klCons (ApplC (wrapNamed "pr" kl_pr)) appl_639 + !appl_641 <- appl_640 `pseq` klCons (ApplC (wrapNamed "print" kl_print)) appl_640 + !appl_642 <- appl_641 `pseq` klCons (ApplC (wrapNamed "profile" kl_profile)) appl_641 + !appl_643 <- appl_642 `pseq` klCons (ApplC (wrapNamed "profile-results" kl_profile_results)) appl_642 + !appl_644 <- appl_643 `pseq` klCons (ApplC (wrapNamed "protect" kl_protect)) appl_643 + !appl_645 <- appl_644 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "prolog?")) appl_644 + !appl_646 <- appl_645 `pseq` klCons (ApplC (wrapNamed "ps" kl_ps)) appl_645 + !appl_647 <- appl_646 `pseq` klCons (ApplC (wrapNamed "preclude-all-but" kl_preclude_all_but)) appl_646 + !appl_648 <- appl_647 `pseq` klCons (ApplC (wrapNamed "preclude" kl_preclude)) appl_647 + !appl_649 <- appl_648 `pseq` klCons (ApplC (wrapNamed "put" kl_put)) appl_648 + !appl_650 <- appl_649 `pseq` klCons (ApplC (wrapNamed "package?" kl_packageP)) appl_649 + !appl_651 <- appl_650 `pseq` klCons (ApplC (wrapNamed "read-from-string" kl_read_from_string)) appl_650 + !appl_652 <- appl_651 `pseq` klCons (ApplC (wrapNamed "read-char-code" kl_read_char_code)) appl_651 + !appl_653 <- appl_652 `pseq` klCons (ApplC (wrapNamed "read-file-as-charlist" kl_read_file_as_charlist)) appl_652 + !appl_654 <- appl_653 `pseq` klCons (ApplC (wrapNamed "read-byte" readByte)) appl_653 + !appl_655 <- appl_654 `pseq` klCons (ApplC (wrapNamed "read-file-as-string" kl_read_file_as_string)) appl_654 + !appl_656 <- appl_655 `pseq` klCons (ApplC (wrapNamed "read-file-as-bytelist" kl_read_file_as_bytelist)) appl_655 + !appl_657 <- appl_656 `pseq` klCons (ApplC (wrapNamed "read-file" kl_read_file)) appl_656 + !appl_658 <- appl_657 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "receive")) appl_657 + !appl_659 <- appl_658 `pseq` klCons (ApplC (wrapNamed "read" kl_read)) appl_658 + !appl_660 <- appl_659 `pseq` klCons (ApplC (PL "release" kl_release)) appl_659 + !appl_661 <- appl_660 `pseq` klCons (ApplC (wrapNamed "remove" kl_remove)) appl_660 + !appl_662 <- appl_661 `pseq` klCons (ApplC (wrapNamed "reverse" kl_reverse)) appl_661 + !appl_663 <- appl_662 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "run")) appl_662 + !appl_664 <- appl_663 `pseq` klCons (ApplC (wrapNamed "str" str)) appl_663 + !appl_665 <- appl_664 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "save")) appl_664 + !appl_666 <- appl_665 `pseq` klCons (ApplC (wrapNamed "set" klSet)) appl_665 + !appl_667 <- appl_666 `pseq` klCons (ApplC (wrapNamed "simple-error" simpleError)) appl_666 + !appl_668 <- appl_667 `pseq` klCons (ApplC (wrapNamed "snd" kl_snd)) appl_667 + !appl_669 <- appl_668 `pseq` klCons (ApplC (wrapNamed "specialise" kl_specialise)) appl_668 + !appl_670 <- appl_669 `pseq` klCons (ApplC (wrapNamed "spy" kl_spy)) appl_669 + !appl_671 <- appl_670 `pseq` klCons (ApplC (wrapNamed "step" kl_step)) appl_670 + !appl_672 <- appl_671 `pseq` klCons (ApplC (PL "stoutput" kl_stoutput)) appl_671 + !appl_673 <- appl_672 `pseq` klCons (ApplC (PL "sterror" kl_sterror)) appl_672 + !appl_674 <- appl_673 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_673 + !appl_675 <- appl_674 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_674 + !appl_676 <- appl_675 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "stream")) appl_675 + !appl_677 <- appl_676 `pseq` klCons (ApplC (wrapNamed "string->n" stringToN)) appl_676 + !appl_678 <- appl_677 `pseq` klCons (ApplC (wrapNamed "string?" stringP)) appl_677 + !appl_679 <- appl_678 `pseq` klCons (ApplC (wrapNamed "subst" kl_subst)) appl_678 + !appl_680 <- appl_679 `pseq` klCons (ApplC (wrapNamed "sum" kl_sum)) appl_679 + !appl_681 <- appl_680 `pseq` klCons (ApplC (wrapNamed "string->symbol" kl_string_RBsymbol)) appl_680 + !appl_682 <- appl_681 `pseq` klCons (ApplC (wrapNamed "symbol?" kl_symbolP)) appl_681 + !appl_683 <- appl_682 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_682 + !appl_684 <- appl_683 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "synonyms")) appl_683 + !appl_685 <- appl_684 `pseq` klCons (ApplC (wrapNamed "systemf" kl_systemf)) appl_684 + !appl_686 <- appl_685 `pseq` klCons (ApplC (wrapNamed "tail" kl_tail)) appl_685 + !appl_687 <- appl_686 `pseq` klCons (ApplC (wrapNamed "tlv" kl_tlv)) appl_686 + !appl_688 <- appl_687 `pseq` klCons (ApplC (wrapNamed "tlstr" tlstr)) appl_687 + !appl_689 <- appl_688 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_688 + !appl_690 <- appl_689 `pseq` klCons (ApplC (wrapNamed "tc" kl_tc)) appl_689 + !appl_691 <- appl_690 `pseq` klCons (ApplC (PL "tc?" kl_tcP)) appl_690 + !appl_692 <- appl_691 `pseq` klCons (ApplC (wrapNamed "thaw" kl_thaw)) appl_691 + !appl_693 <- appl_692 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "time")) appl_692 + !appl_694 <- appl_693 `pseq` klCons (ApplC (wrapNamed "track" kl_track)) appl_693 + !appl_695 <- appl_694 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "trap-error")) appl_694 + !appl_696 <- appl_695 `pseq` klCons (Atom (B True)) appl_695 + !appl_697 <- appl_696 `pseq` klCons (ApplC (wrapNamed "tuple?" kl_tupleP)) appl_696 + !appl_698 <- appl_697 `pseq` klCons (ApplC (wrapNamed "type" typeA)) appl_697 + !appl_699 <- appl_698 `pseq` klCons (ApplC (wrapNamed "return" kl_return)) appl_698 + !appl_700 <- appl_699 `pseq` klCons (ApplC (wrapNamed "undefmacro" kl_undefmacro)) appl_699 + !appl_701 <- appl_700 `pseq` klCons (ApplC (wrapNamed "unprofile" kl_unprofile)) appl_700 + !appl_702 <- appl_701 `pseq` klCons (ApplC (wrapNamed "unput" kl_unput)) appl_701 + !appl_703 <- appl_702 `pseq` klCons (ApplC (wrapNamed "unify!" kl_unifyExcl)) appl_702 + !appl_704 <- appl_703 `pseq` klCons (ApplC (wrapNamed "unify" kl_unify)) appl_703 + !appl_705 <- appl_704 `pseq` klCons (ApplC (wrapNamed "union" kl_union)) appl_704 + !appl_706 <- appl_705 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.unix")) appl_705 + !appl_707 <- appl_706 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "unit")) appl_706 + !appl_708 <- appl_707 `pseq` klCons (ApplC (wrapNamed "untrack" kl_untrack)) appl_707 + !appl_709 <- appl_708 `pseq` klCons (ApplC (wrapNamed "unspecialise" kl_unspecialise)) appl_708 + !appl_710 <- appl_709 `pseq` klCons (ApplC (wrapNamed "vector?" kl_vectorP)) appl_709 + !appl_711 <- appl_710 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_710 + !appl_712 <- appl_711 `pseq` klCons (ApplC (wrapNamed "<-vector/or" kl_LB_vectorDivor)) appl_711 + !appl_713 <- appl_712 `pseq` klCons (ApplC (wrapNamed "<-vector" kl_LB_vector)) appl_712 + !appl_714 <- appl_713 `pseq` klCons (ApplC (wrapNamed "vector->" kl_vector_RB)) appl_713 + !appl_715 <- appl_714 `pseq` klCons (ApplC (wrapNamed "value/or" kl_valueDivor)) appl_714 + !appl_716 <- appl_715 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_715 + !appl_717 <- appl_716 `pseq` klCons (ApplC (wrapNamed "variable?" kl_variableP)) appl_716 + !appl_718 <- appl_717 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "verified")) appl_717 + !appl_719 <- appl_718 `pseq` klCons (ApplC (PL "version" kl_version)) appl_718 + !appl_720 <- appl_719 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "warn")) appl_719 + !appl_721 <- appl_720 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "when")) appl_720 + !appl_722 <- appl_721 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "where")) appl_721 + !appl_723 <- appl_722 `pseq` klCons (ApplC (wrapNamed "write-byte" writeByte)) appl_722 + !appl_724 <- appl_723 `pseq` klCons (ApplC (wrapNamed "write-to-file" kl_write_to_file)) appl_723 + !appl_725 <- appl_724 `pseq` klCons (ApplC (wrapNamed "y-or-n?" kl_y_or_nP)) appl_724 + !appl_726 <- appl_506 `pseq` (appl_725 `pseq` klCons appl_506 appl_725) + !appl_727 <- appl_726 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ">>")) appl_726 + !appl_728 <- appl_727 `pseq` klCons (ApplC (wrapNamed "<" lessThan)) appl_727 + !appl_729 <- appl_728 `pseq` klCons (ApplC (wrapNamed "<=" lessThanOrEqualTo)) appl_728 + !appl_730 <- appl_729 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_729 + !appl_731 <- appl_730 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_730 + !appl_732 <- appl_731 `pseq` klCons (ApplC (wrapNamed "/" divide)) appl_731 + !appl_733 <- appl_732 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_732 + !appl_734 <- appl_733 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "$")) appl_733 + !appl_735 <- appl_734 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "=!")) appl_734 + !appl_736 <- appl_735 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_735 + !appl_737 <- appl_736 `pseq` klCons (ApplC (wrapNamed ">" greaterThan)) appl_736 + !appl_738 <- appl_737 `pseq` klCons (ApplC (wrapNamed ">=" greaterThanOrEqualTo)) appl_737 + !appl_739 <- appl_738 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_738 + !appl_740 <- appl_739 `pseq` klCons (ApplC (wrapNamed "==" kl_EqEq)) appl_739 + !appl_741 <- appl_740 `pseq` klCons (ApplC (wrapNamed "" kl_LBExclRB)) appl_740 + !appl_742 <- appl_741 `pseq` klCons (ApplC (wrapNamed "" kl_LBeRB)) appl_741 + !appl_743 <- appl_742 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "->")) appl_742 + !appl_744 <- appl_743 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "<-")) appl_743 + !appl_745 <- appl_744 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_744 + !appl_746 <- appl_745 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_745 + !appl_747 <- appl_746 `pseq` klCons (ApplC (wrapNamed "@v" kl_Atv)) appl_746 + !appl_748 <- appl_747 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*hush*")) appl_747 + !appl_749 <- appl_748 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*porters*")) appl_748 + !appl_750 <- appl_749 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*port*")) appl_749 + !appl_751 <- appl_750 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) appl_750 + !appl_752 <- appl_751 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*release*")) appl_751 + !appl_753 <- appl_752 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*os*")) appl_752 + !appl_754 <- appl_753 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*macros*")) appl_753 + !appl_755 <- appl_754 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*maximum-print-sequence-size*")) appl_754 + !appl_756 <- appl_755 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*version*")) appl_755 + !appl_757 <- appl_756 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*home-directory*")) appl_756 + !appl_758 <- appl_757 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.*sterror*")) appl_757 + !appl_759 <- appl_758 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*stoutput*")) appl_758 + !appl_760 <- appl_759 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*stinput*")) appl_759 + !appl_761 <- appl_760 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*implementation*")) appl_760 + !appl_762 <- appl_761 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*language*")) appl_761 + !appl_763 <- appl_762 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "_")) appl_762 + !appl_764 <- appl_763 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":=")) appl_763 + !appl_765 <- appl_764 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":-")) appl_764 + !appl_766 <- appl_765 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ";")) appl_765 + !appl_767 <- appl_766 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":")) appl_766 + !appl_768 <- appl_767 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "&&")) appl_767 + !appl_769 <- appl_768 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "<--")) appl_768 + !appl_770 <- appl_769 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_769 + !appl_771 <- appl_770 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "{")) appl_770 + !appl_772 <- appl_771 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "}")) appl_771 + !appl_773 <- appl_772 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "!")) appl_772 + !appl_774 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + appl_505 `pseq` (appl_773 `pseq` (appl_774 `pseq` kl_put appl_505 (Core.Types.Atom (Core.Types.UnboundSym "shen.external-symbols")) appl_773 appl_774))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_775 = ApplC (Func "lambda" (Context (\(!kl_Entry) -> do kl_Entry `pseq` kl_shen_set_lambda_form_entry kl_Entry))) + let !appl_776 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_datatype_error kl_X))) + !appl_777 <- appl_776 `pseq` klCons (ApplC (wrapNamed "shen.datatype-error" kl_shen_datatype_error)) appl_776 + let !appl_778 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_tuple kl_X))) + !appl_779 <- appl_778 `pseq` klCons (ApplC (wrapNamed "shen.tuple" kl_shen_tuple)) appl_778 + let !appl_780 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_pvar kl_X))) + !appl_781 <- appl_780 `pseq` klCons (ApplC (wrapNamed "shen.pvar" kl_shen_pvar)) appl_780 + let !appl_782 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_dictionary kl_X))) + !appl_783 <- appl_782 `pseq` klCons (ApplC (wrapNamed "shen.dictionary" kl_shen_dictionary)) appl_782 + let !appl_784 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_lambda_form_entry kl_X))) + !appl_785 <- intern (Core.Types.Atom (Core.Types.Str "shen")) + !appl_786 <- appl_785 `pseq` kl_external appl_785 + !appl_787 <- appl_784 `pseq` (appl_786 `pseq` kl_mapcan appl_784 appl_786) + !appl_788 <- appl_783 `pseq` (appl_787 `pseq` klCons appl_783 appl_787) + !appl_789 <- appl_781 `pseq` (appl_788 `pseq` klCons appl_781 appl_788) + !appl_790 <- appl_779 `pseq` (appl_789 `pseq` klCons appl_779 appl_789) + !appl_791 <- appl_777 `pseq` (appl_790 `pseq` klCons appl_777 appl_790) + appl_775 `pseq` (appl_791 `pseq` kl_for_each appl_775 appl_791)) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Backend/FunctionTable.hs b/Shentong/Backend/FunctionTable.hs --- a/Shentong/Backend/FunctionTable.hs +++ b/Shentong/Backend/FunctionTable.hs @@ -1,674 +1,708 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} - -module Backend.FunctionTable 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 -import Backend.Core -import Backend.Sys -import Backend.Sequent -import Backend.Yacc -import Backend.Reader -import Backend.Prolog -import Backend.Track -import Backend.Load -import Backend.Writer -import Backend.Macros -import Backend.Declarations -import Backend.Types -import Backend.TStar -import Backend.PortInfo -import Backend.LoadShen - -{- -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. --} - -functions = do insertFunction "shen.shen" (PL "shen.shen" kl_shen_shen) - insertFunction "shen.loop" (PL "shen.loop" kl_shen_loop) - insertFunction "shen.credits" (PL "shen.credits" kl_shen_credits) - insertFunction "shen.initialise_environment" (PL "shen.initialise_environment" kl_shen_initialise_environment) - insertFunction "shen.multiple-set" (wrapNamed "shen.multiple-set" kl_shen_multiple_set) - insertFunction "destroy" (wrapNamed "destroy" kl_destroy) - insertFunction "shen.read-evaluate-print" (PL "shen.read-evaluate-print" kl_shen_read_evaluate_print) - insertFunction "shen.retrieve-from-history-if-needed" (wrapNamed "shen.retrieve-from-history-if-needed" kl_shen_retrieve_from_history_if_needed) - insertFunction "shen.percent" (PL "shen.percent" kl_shen_percent) - insertFunction "shen.exclamation" (PL "shen.exclamation" kl_shen_exclamation) - insertFunction "shen.prbytes" (wrapNamed "shen.prbytes" kl_shen_prbytes) - insertFunction "shen.update_history" (wrapNamed "shen.update_history" kl_shen_update_history) - insertFunction "shen.toplineread" (PL "shen.toplineread" kl_shen_toplineread) - insertFunction "shen.toplineread_loop" (wrapNamed "shen.toplineread_loop" kl_shen_toplineread_loop) - insertFunction "shen.hat" (PL "shen.hat" kl_shen_hat) - insertFunction "shen.newline" (PL "shen.newline" kl_shen_newline) - insertFunction "shen.carriage-return" (PL "shen.carriage-return" kl_shen_carriage_return) - insertFunction "tc" (wrapNamed "tc" kl_tc) - insertFunction "shen.prompt" (PL "shen.prompt" kl_shen_prompt) - insertFunction "shen.toplevel" (wrapNamed "shen.toplevel" kl_shen_toplevel) - insertFunction "shen.find-past-inputs" (wrapNamed "shen.find-past-inputs" kl_shen_find_past_inputs) - insertFunction "shen.make-key" (wrapNamed "shen.make-key" kl_shen_make_key) - insertFunction "shen.trim-gubbins" (wrapNamed "shen.trim-gubbins" kl_shen_trim_gubbins) - insertFunction "shen.space" (PL "shen.space" kl_shen_space) - insertFunction "shen.tab" (PL "shen.tab" kl_shen_tab) - insertFunction "shen.left-round" (PL "shen.left-round" kl_shen_left_round) - insertFunction "shen.find" (wrapNamed "shen.find" kl_shen_find) - insertFunction "shen.prefix?" (wrapNamed "shen.prefix?" kl_shen_prefixP) - insertFunction "shen.print-past-inputs" (wrapNamed "shen.print-past-inputs" kl_shen_print_past_inputs) - insertFunction "shen.toplevel_evaluate" (wrapNamed "shen.toplevel_evaluate" kl_shen_toplevel_evaluate) - insertFunction "shen.typecheck-and-evaluate" (wrapNamed "shen.typecheck-and-evaluate" kl_shen_typecheck_and_evaluate) - insertFunction "shen.pretty-type" (wrapNamed "shen.pretty-type" kl_shen_pretty_type) - insertFunction "shen.extract-pvars" (wrapNamed "shen.extract-pvars" kl_shen_extract_pvars) - insertFunction "shen.mult_subst" (wrapNamed "shen.mult_subst" kl_shen_mult_subst) - insertFunction "shen.shen->kl" (wrapNamed "shen.shen->kl" kl_shen_shen_RBkl) - insertFunction "shen.shen-syntax-error" (wrapNamed "shen.shen-syntax-error" kl_shen_shen_syntax_error) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBdefineRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBnameRB) - insertFunction "shen.sysfunc?" (wrapNamed "shen.sysfunc?" kl_shen_sysfuncP) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBsignatureRB) - insertFunction "shen.curry-type" (wrapNamed "shen.curry-type" kl_shen_curry_type) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBsignature_helpRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBrulesRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBruleRB) - insertFunction "shen.fail_if" (wrapNamed "shen.fail_if" kl_shen_fail_if) - insertFunction "shen.succeeds?" (wrapNamed "shen.succeeds?" kl_shen_succeedsP) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBpatternsRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBpatternRB) - insertFunction "shen.constructor-error" (wrapNamed "shen.constructor-error" kl_shen_constructor_error) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBsimple_patternRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBpattern1RB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBpattern2RB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBactionRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBguardRB) - insertFunction "shen.compile_to_machine_code" (wrapNamed "shen.compile_to_machine_code" kl_shen_compile_to_machine_code) - insertFunction "shen.record-source" (wrapNamed "shen.record-source" kl_shen_record_source) - insertFunction "shen.compile_to_lambda+" (wrapNamed "shen.compile_to_lambda+" kl_shen_compile_to_lambdaPlus) - insertFunction "shen.update-symbol-table" (wrapNamed "shen.update-symbol-table" kl_shen_update_symbol_table) - insertFunction "shen.update-symbol-table-h" (wrapNamed "shen.update-symbol-table-h" kl_shen_update_symbol_table_h) - insertFunction "shen.free_variable_check" (wrapNamed "shen.free_variable_check" kl_shen_free_variable_check) - insertFunction "shen.extract_vars" (wrapNamed "shen.extract_vars" kl_shen_extract_vars) - insertFunction "shen.extract_free_vars" (wrapNamed "shen.extract_free_vars" kl_shen_extract_free_vars) - insertFunction "shen.free_variable_warnings" (wrapNamed "shen.free_variable_warnings" kl_shen_free_variable_warnings) - insertFunction "shen.list_variables" (wrapNamed "shen.list_variables" kl_shen_list_variables) - insertFunction "shen.strip-protect" (wrapNamed "shen.strip-protect" kl_shen_strip_protect) - insertFunction "shen.linearise" (wrapNamed "shen.linearise" kl_shen_linearise) - insertFunction "shen.flatten" (wrapNamed "shen.flatten" kl_shen_flatten) - insertFunction "shen.linearise_help" (wrapNamed "shen.linearise_help" kl_shen_linearise_help) - insertFunction "shen.linearise_X" (wrapNamed "shen.linearise_X" kl_shen_linearise_X) - insertFunction "shen.aritycheck" (wrapNamed "shen.aritycheck" kl_shen_aritycheck) - insertFunction "shen.aritycheck-name" (wrapNamed "shen.aritycheck-name" kl_shen_aritycheck_name) - insertFunction "shen.aritycheck-action" (wrapNamed "shen.aritycheck-action" kl_shen_aritycheck_action) - insertFunction "shen.aah" (wrapNamed "shen.aah" kl_shen_aah) - insertFunction "shen.abstract_rule" (wrapNamed "shen.abstract_rule" kl_shen_abstract_rule) - insertFunction "shen.abstraction_build" (wrapNamed "shen.abstraction_build" kl_shen_abstraction_build) - insertFunction "shen.parameters" (wrapNamed "shen.parameters" kl_shen_parameters) - insertFunction "shen.application_build" (wrapNamed "shen.application_build" kl_shen_application_build) - insertFunction "shen.compile_to_kl" (wrapNamed "shen.compile_to_kl" kl_shen_compile_to_kl) - insertFunction "shen.get-type" (wrapNamed "shen.get-type" kl_shen_get_type) - insertFunction "shen.typextable" (wrapNamed "shen.typextable" kl_shen_typextable) - insertFunction "shen.assign-types" (wrapNamed "shen.assign-types" kl_shen_assign_types) - insertFunction "shen.atom-type" (wrapNamed "shen.atom-type" kl_shen_atom_type) - insertFunction "shen.store-arity" (wrapNamed "shen.store-arity" kl_shen_store_arity) - insertFunction "shen.reduce" (wrapNamed "shen.reduce" kl_shen_reduce) - insertFunction "shen.reduce_help" (wrapNamed "shen.reduce_help" kl_shen_reduce_help) - insertFunction "shen.+string?" (wrapNamed "shen.+string?" kl_shen_PlusstringP) - insertFunction "shen.+vector" (wrapNamed "shen.+vector" kl_shen_Plusvector) - insertFunction "shen.ebr" (wrapNamed "shen.ebr" kl_shen_ebr) - insertFunction "shen.add_test" (wrapNamed "shen.add_test" kl_shen_add_test) - insertFunction "shen.cond-expression" (wrapNamed "shen.cond-expression" kl_shen_cond_expression) - insertFunction "shen.cond-form" (wrapNamed "shen.cond-form" kl_shen_cond_form) - insertFunction "shen.encode-choices" (wrapNamed "shen.encode-choices" kl_shen_encode_choices) - insertFunction "shen.case-form" (wrapNamed "shen.case-form" kl_shen_case_form) - insertFunction "shen.embed-and" (wrapNamed "shen.embed-and" kl_shen_embed_and) - insertFunction "shen.err-condition" (wrapNamed "shen.err-condition" kl_shen_err_condition) - insertFunction "shen.sys-error" (wrapNamed "shen.sys-error" kl_shen_sys_error) - insertFunction "thaw" (wrapNamed "thaw" kl_thaw) - insertFunction "eval" (wrapNamed "eval" kl_eval) - insertFunction "shen.eval-without-macros" (wrapNamed "shen.eval-without-macros" kl_shen_eval_without_macros) - insertFunction "shen.proc-input+" (wrapNamed "shen.proc-input+" kl_shen_proc_inputPlus) - insertFunction "shen.elim-def" (wrapNamed "shen.elim-def" kl_shen_elim_def) - insertFunction "shen.add-macro" (wrapNamed "shen.add-macro" kl_shen_add_macro) - insertFunction "shen.packaged?" (wrapNamed "shen.packaged?" kl_shen_packagedP) - insertFunction "external" (wrapNamed "external" kl_external) - insertFunction "shen.package-contents" (wrapNamed "shen.package-contents" kl_shen_package_contents) - insertFunction "shen.walk" (wrapNamed "shen.walk" kl_shen_walk) - insertFunction "compile" (wrapNamed "compile" kl_compile) - insertFunction "fail-if" (wrapNamed "fail-if" kl_fail_if) - insertFunction "@s" (wrapNamed "@s" kl_Ats) - insertFunction "tc?" (PL "tc?" kl_tcP) - insertFunction "ps" (wrapNamed "ps" kl_ps) - insertFunction "stinput" (PL "stinput" kl_stinput) - insertFunction "shen.+vector?" (wrapNamed "shen.+vector?" kl_shen_PlusvectorP) - insertFunction "vector" (wrapNamed "vector" kl_vector) - insertFunction "shen.fillvector" (wrapNamed "shen.fillvector" kl_shen_fillvector) - insertFunction "vector?" (wrapNamed "vector?" kl_vectorP) - insertFunction "vector->" (wrapNamed "vector->" kl_vector_RB) - insertFunction "<-vector" (wrapNamed "<-vector" kl_LB_vector) - insertFunction "shen.posint?" (wrapNamed "shen.posint?" kl_shen_posintP) - insertFunction "limit" (wrapNamed "limit" kl_limit) - insertFunction "symbol?" (wrapNamed "symbol?" kl_symbolP) - insertFunction "shen.analyse-symbol?" (wrapNamed "shen.analyse-symbol?" kl_shen_analyse_symbolP) - insertFunction "shen.alpha?" (wrapNamed "shen.alpha?" kl_shen_alphaP) - insertFunction "shen.alphanums?" (wrapNamed "shen.alphanums?" kl_shen_alphanumsP) - insertFunction "shen.alphanum?" (wrapNamed "shen.alphanum?" kl_shen_alphanumP) - insertFunction "shen.digit?" (wrapNamed "shen.digit?" kl_shen_digitP) - insertFunction "variable?" (wrapNamed "variable?" kl_variableP) - insertFunction "shen.analyse-variable?" (wrapNamed "shen.analyse-variable?" kl_shen_analyse_variableP) - insertFunction "shen.uppercase?" (wrapNamed "shen.uppercase?" kl_shen_uppercaseP) - insertFunction "gensym" (wrapNamed "gensym" kl_gensym) - insertFunction "concat" (wrapNamed "concat" kl_concat) - insertFunction "@p" (wrapNamed "@p" kl_Atp) - insertFunction "fst" (wrapNamed "fst" kl_fst) - insertFunction "snd" (wrapNamed "snd" kl_snd) - insertFunction "tuple?" (wrapNamed "tuple?" kl_tupleP) - insertFunction "append" (wrapNamed "append" kl_append) - insertFunction "@v" (wrapNamed "@v" kl_Atv) - insertFunction "shen.@v-help" (wrapNamed "shen.@v-help" kl_shen_Atv_help) - insertFunction "shen.copyfromvector" (wrapNamed "shen.copyfromvector" kl_shen_copyfromvector) - insertFunction "hdv" (wrapNamed "hdv" kl_hdv) - insertFunction "tlv" (wrapNamed "tlv" kl_tlv) - insertFunction "shen.tlv-help" (wrapNamed "shen.tlv-help" kl_shen_tlv_help) - insertFunction "assoc" (wrapNamed "assoc" kl_assoc) - insertFunction "boolean?" (wrapNamed "boolean?" kl_booleanP) - insertFunction "nl" (wrapNamed "nl" kl_nl) - insertFunction "difference" (wrapNamed "difference" kl_difference) - insertFunction "do" (wrapNamed "do" kl_do) - insertFunction "element?" (wrapNamed "element?" kl_elementP) - insertFunction "empty?" (wrapNamed "empty?" kl_emptyP) - insertFunction "fix" (wrapNamed "fix" kl_fix) - insertFunction "shen.fix-help" (wrapNamed "shen.fix-help" kl_shen_fix_help) - insertFunction "put" (wrapNamed "put" kl_put) - insertFunction "unput" (wrapNamed "unput" kl_unput) - insertFunction "shen.remove-pointer" (wrapNamed "shen.remove-pointer" kl_shen_remove_pointer) - insertFunction "shen.change-pointer-value" (wrapNamed "shen.change-pointer-value" kl_shen_change_pointer_value) - insertFunction "get" (wrapNamed "get" kl_get) - insertFunction "hash" (wrapNamed "hash" kl_hash) - insertFunction "shen.mod" (wrapNamed "shen.mod" kl_shen_mod) - insertFunction "shen.multiples" (wrapNamed "shen.multiples" kl_shen_multiples) - insertFunction "shen.modh" (wrapNamed "shen.modh" kl_shen_modh) - insertFunction "sum" (wrapNamed "sum" kl_sum) - insertFunction "head" (wrapNamed "head" kl_head) - insertFunction "tail" (wrapNamed "tail" kl_tail) - insertFunction "hdstr" (wrapNamed "hdstr" kl_hdstr) - insertFunction "intersection" (wrapNamed "intersection" kl_intersection) - insertFunction "reverse" (wrapNamed "reverse" kl_reverse) - insertFunction "shen.reverse_help" (wrapNamed "shen.reverse_help" kl_shen_reverse_help) - insertFunction "union" (wrapNamed "union" kl_union) - insertFunction "y-or-n?" (wrapNamed "y-or-n?" kl_y_or_nP) - insertFunction "not" (wrapNamed "not" kl_not) - insertFunction "subst" (wrapNamed "subst" kl_subst) - insertFunction "explode" (wrapNamed "explode" kl_explode) - insertFunction "shen.explode-h" (wrapNamed "shen.explode-h" kl_shen_explode_h) - insertFunction "cd" (wrapNamed "cd" kl_cd) - insertFunction "map" (wrapNamed "map" kl_map) - insertFunction "shen.map-h" (wrapNamed "shen.map-h" kl_shen_map_h) - insertFunction "length" (wrapNamed "length" kl_length) - insertFunction "shen.length-h" (wrapNamed "shen.length-h" kl_shen_length_h) - insertFunction "occurrences" (wrapNamed "occurrences" kl_occurrences) - insertFunction "nth" (wrapNamed "nth" kl_nth) - insertFunction "integer?" (wrapNamed "integer?" kl_integerP) - insertFunction "shen.abs" (wrapNamed "shen.abs" kl_shen_abs) - insertFunction "shen.magless" (wrapNamed "shen.magless" kl_shen_magless) - insertFunction "shen.integer-test?" (wrapNamed "shen.integer-test?" kl_shen_integer_testP) - insertFunction "mapcan" (wrapNamed "mapcan" kl_mapcan) - insertFunction "==" (wrapNamed "==" kl_EqEq) - insertFunction "abort" (PL "abort" kl_abort) - insertFunction "bound?" (wrapNamed "bound?" kl_boundP) - insertFunction "shen.string->bytes" (wrapNamed "shen.string->bytes" kl_shen_string_RBbytes) - insertFunction "maxinferences" (wrapNamed "maxinferences" kl_maxinferences) - insertFunction "inferences" (PL "inferences" kl_inferences) - insertFunction "protect" (wrapNamed "protect" kl_protect) - insertFunction "stoutput" (PL "stoutput" kl_stoutput) - insertFunction "string->symbol" (wrapNamed "string->symbol" kl_string_RBsymbol) - insertFunction "optimise" (wrapNamed "optimise" kl_optimise) - insertFunction "os" (PL "os" kl_os) - insertFunction "language" (PL "language" kl_language) - insertFunction "version" (PL "version" kl_version) - insertFunction "port" (PL "port" kl_port) - insertFunction "porters" (PL "porters" kl_porters) - insertFunction "implementation" (PL "implementation" kl_implementation) - insertFunction "release" (PL "release" kl_release) - insertFunction "package?" (wrapNamed "package?" kl_packageP) - insertFunction "function" (wrapNamed "function" kl_function) - insertFunction "shen.lookup-func" (wrapNamed "shen.lookup-func" kl_shen_lookup_func) - insertFunction "shen.datatype-error" (wrapNamed "shen.datatype-error" kl_shen_datatype_error) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBdatatype_rulesRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBdatatype_ruleRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBside_conditionsRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBside_conditionRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBvariablePRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBexprRB) - insertFunction "shen.remove-bar" (wrapNamed "shen.remove-bar" kl_shen_remove_bar) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBpremisesRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBsemicolon_symbolRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBpremiseRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBconclusionRB) - insertFunction "shen.sequent" (wrapNamed "shen.sequent" kl_shen_sequent) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBformulaeRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBcomma_symbolRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBformulaRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBtypeRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBdoubleunderlineRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBsingleunderlineRB) - insertFunction "shen.singleunderline?" (wrapNamed "shen.singleunderline?" kl_shen_singleunderlineP) - insertFunction "shen.sh?" (wrapNamed "shen.sh?" kl_shen_shP) - insertFunction "shen.doubleunderline?" (wrapNamed "shen.doubleunderline?" kl_shen_doubleunderlineP) - insertFunction "shen.dh?" (wrapNamed "shen.dh?" kl_shen_dhP) - insertFunction "shen.process-datatype" (wrapNamed "shen.process-datatype" kl_shen_process_datatype) - insertFunction "shen.remember-datatype" (wrapNamed "shen.remember-datatype" kl_shen_remember_datatype) - insertFunction "shen.rules->horn-clauses" (wrapNamed "shen.rules->horn-clauses" kl_shen_rules_RBhorn_clauses) - insertFunction "shen.double->singles" (wrapNamed "shen.double->singles" kl_shen_double_RBsingles) - insertFunction "shen.right-rule" (wrapNamed "shen.right-rule" kl_shen_right_rule) - insertFunction "shen.left-rule" (wrapNamed "shen.left-rule" kl_shen_left_rule) - insertFunction "shen.right->left" (wrapNamed "shen.right->left" kl_shen_right_RBleft) - insertFunction "shen.rule->horn-clause" (wrapNamed "shen.rule->horn-clause" kl_shen_rule_RBhorn_clause) - insertFunction "shen.rule->horn-clause-head" (wrapNamed "shen.rule->horn-clause-head" kl_shen_rule_RBhorn_clause_head) - insertFunction "shen.mode-ify" (wrapNamed "shen.mode-ify" kl_shen_mode_ify) - insertFunction "shen.rule->horn-clause-body" (wrapNamed "shen.rule->horn-clause-body" kl_shen_rule_RBhorn_clause_body) - insertFunction "shen.construct-search-literals" (wrapNamed "shen.construct-search-literals" kl_shen_construct_search_literals) - insertFunction "shen.csl-help" (wrapNamed "shen.csl-help" kl_shen_csl_help) - insertFunction "shen.construct-search-clauses" (wrapNamed "shen.construct-search-clauses" kl_shen_construct_search_clauses) - insertFunction "shen.construct-search-clause" (wrapNamed "shen.construct-search-clause" kl_shen_construct_search_clause) - insertFunction "shen.construct-base-search-clause" (wrapNamed "shen.construct-base-search-clause" kl_shen_construct_base_search_clause) - insertFunction "shen.construct-recursive-search-clause" (wrapNamed "shen.construct-recursive-search-clause" kl_shen_construct_recursive_search_clause) - insertFunction "shen.construct-side-literals" (wrapNamed "shen.construct-side-literals" kl_shen_construct_side_literals) - insertFunction "shen.construct-premiss-literal" (wrapNamed "shen.construct-premiss-literal" kl_shen_construct_premiss_literal) - insertFunction "shen.construct-context" (wrapNamed "shen.construct-context" kl_shen_construct_context) - insertFunction "shen.recursive_cons_form" (wrapNamed "shen.recursive_cons_form" kl_shen_recursive_cons_form) - insertFunction "preclude" (wrapNamed "preclude" kl_preclude) - insertFunction "shen.preclude-h" (wrapNamed "shen.preclude-h" kl_shen_preclude_h) - insertFunction "include" (wrapNamed "include" kl_include) - insertFunction "shen.include-h" (wrapNamed "shen.include-h" kl_shen_include_h) - insertFunction "preclude-all-but" (wrapNamed "preclude-all-but" kl_preclude_all_but) - insertFunction "include-all-but" (wrapNamed "include-all-but" kl_include_all_but) - insertFunction "shen.synonyms-help" (wrapNamed "shen.synonyms-help" kl_shen_synonyms_help) - insertFunction "shen.pushnew" (wrapNamed "shen.pushnew" kl_shen_pushnew) - insertFunction "shen.demod-rule" (wrapNamed "shen.demod-rule" kl_shen_demod_rule) - insertFunction "shen.demodulation-function" (wrapNamed "shen.demodulation-function" kl_shen_demodulation_function) - insertFunction "shen.default-rule" (PL "shen.default-rule" kl_shen_default_rule) - insertFunction "shen.yacc" (wrapNamed "shen.yacc" kl_shen_yacc) - insertFunction "shen.yacc->shen" (wrapNamed "shen.yacc->shen" kl_shen_yacc_RBshen) - insertFunction "shen.kill-code" (wrapNamed "shen.kill-code" kl_shen_kill_code) - insertFunction "kill" (PL "kill" kl_kill) - insertFunction "shen.analyse-kill" (wrapNamed "shen.analyse-kill" kl_shen_analyse_kill) - insertFunction "shen.split_cc_rules" (wrapNamed "shen.split_cc_rules" kl_shen_split_cc_rules) - insertFunction "shen.split_cc_rule" (wrapNamed "shen.split_cc_rule" kl_shen_split_cc_rule) - insertFunction "shen.semantic-completion-warning" (wrapNamed "shen.semantic-completion-warning" kl_shen_semantic_completion_warning) - insertFunction "shen.default_semantics" (wrapNamed "shen.default_semantics" kl_shen_default_semantics) - insertFunction "shen.grammar_symbol?" (wrapNamed "shen.grammar_symbol?" kl_shen_grammar_symbolP) - insertFunction "shen.yacc_cases" (wrapNamed "shen.yacc_cases" kl_shen_yacc_cases) - insertFunction "shen.cc_body" (wrapNamed "shen.cc_body" kl_shen_cc_body) - insertFunction "shen.syntax" (wrapNamed "shen.syntax" kl_shen_syntax) - insertFunction "shen.list-stream" (wrapNamed "shen.list-stream" kl_shen_list_stream) - insertFunction "shen.decons" (wrapNamed "shen.decons" kl_shen_decons) - insertFunction "shen.insert-runon" (wrapNamed "shen.insert-runon" kl_shen_insert_runon) - insertFunction "shen.strip-pathname" (wrapNamed "shen.strip-pathname" kl_shen_strip_pathname) - insertFunction "shen.recursive_descent" (wrapNamed "shen.recursive_descent" kl_shen_recursive_descent) - insertFunction "shen.variable-match" (wrapNamed "shen.variable-match" kl_shen_variable_match) - insertFunction "shen.terminal?" (wrapNamed "shen.terminal?" kl_shen_terminalP) - insertFunction "shen.jump_stream?" (wrapNamed "shen.jump_stream?" kl_shen_jump_streamP) - insertFunction "shen.check_stream" (wrapNamed "shen.check_stream" kl_shen_check_stream) - insertFunction "shen.jump_stream" (wrapNamed "shen.jump_stream" kl_shen_jump_stream) - insertFunction "shen.semantics" (wrapNamed "shen.semantics" kl_shen_semantics) - insertFunction "shen.snd-or-fail" (wrapNamed "shen.snd-or-fail" kl_shen_snd_or_fail) - insertFunction "fail" (PL "fail" kl_fail) - insertFunction "shen.pair" (wrapNamed "shen.pair" kl_shen_pair) - insertFunction "shen.hdtl" (wrapNamed "shen.hdtl" kl_shen_hdtl) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBExclRB) - insertFunction "" (wrapNamed "" kl_LBeRB) - insertFunction "read-file-as-bytelist" (wrapNamed "read-file-as-bytelist" kl_read_file_as_bytelist) - insertFunction "shen.read-file-as-bytelist-help" (wrapNamed "shen.read-file-as-bytelist-help" kl_shen_read_file_as_bytelist_help) - insertFunction "read-file-as-string" (wrapNamed "read-file-as-string" kl_read_file_as_string) - insertFunction "shen.rfas-h" (wrapNamed "shen.rfas-h" kl_shen_rfas_h) - insertFunction "input" (wrapNamed "input" kl_input) - insertFunction "input+" (wrapNamed "input+" kl_inputPlus) - insertFunction "shen.monotype" (wrapNamed "shen.monotype" kl_shen_monotype) - insertFunction "read" (wrapNamed "read" kl_read) - insertFunction "it" (PL "it" kl_it) - insertFunction "shen.read-loop" (wrapNamed "shen.read-loop" kl_shen_read_loop) - insertFunction "shen.terminator?" (wrapNamed "shen.terminator?" kl_shen_terminatorP) - insertFunction "lineread" (wrapNamed "lineread" kl_lineread) - insertFunction "shen.lineread-loop" (wrapNamed "shen.lineread-loop" kl_shen_lineread_loop) - insertFunction "shen.record-it" (wrapNamed "shen.record-it" kl_shen_record_it) - insertFunction "shen.trim-whitespace" (wrapNamed "shen.trim-whitespace" kl_shen_trim_whitespace) - insertFunction "shen.record-it-h" (wrapNamed "shen.record-it-h" kl_shen_record_it_h) - insertFunction "shen.cn-all" (wrapNamed "shen.cn-all" kl_shen_cn_all) - insertFunction "read-file" (wrapNamed "read-file" kl_read_file) - insertFunction "read-from-string" (wrapNamed "read-from-string" kl_read_from_string) - insertFunction "shen.read-error" (wrapNamed "shen.read-error" kl_shen_read_error) - insertFunction "shen.compress-50" (wrapNamed "shen.compress-50" kl_shen_compress_50) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBst_inputRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBlsbRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBrsbRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBlcurlyRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBrcurlyRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBbarRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBsemicolonRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBcolonRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBcommaRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBequalRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBminusRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBlrbRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBrrbRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBatomRB) - insertFunction "shen.control-chars" (wrapNamed "shen.control-chars" kl_shen_control_chars) - insertFunction "shen.code-point" (wrapNamed "shen.code-point" kl_shen_code_point) - insertFunction "shen.after-codepoint" (wrapNamed "shen.after-codepoint" kl_shen_after_codepoint) - insertFunction "shen.decimalise" (wrapNamed "shen.decimalise" kl_shen_decimalise) - insertFunction "shen.digits->integers" (wrapNamed "shen.digits->integers" kl_shen_digits_RBintegers) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBsymRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBalphanumsRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBalphanumRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBnumRB) - insertFunction "shen.numbyte?" (wrapNamed "shen.numbyte?" kl_shen_numbyteP) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBalphaRB) - insertFunction "shen.symbol-code?" (wrapNamed "shen.symbol-code?" kl_shen_symbol_codeP) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBstrRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBdbqRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBstrcontentsRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBbyteRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBstrcRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBnumberRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBERB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBlog10RB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBplusRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBstopRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBpredigitsRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBpostdigitsRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBdigitsRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBdigitRB) - insertFunction "shen.byte->digit" (wrapNamed "shen.byte->digit" kl_shen_byte_RBdigit) - insertFunction "shen.pre" (wrapNamed "shen.pre" kl_shen_pre) - insertFunction "shen.post" (wrapNamed "shen.post" kl_shen_post) - insertFunction "shen.expt" (wrapNamed "shen.expt" kl_shen_expt) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBst_input1RB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBst_input2RB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBcommentRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBsinglelineRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBbackslashRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBanysingleRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBnon_returnRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBreturnRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBmultilineRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBtimesRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBanymultiRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBwhitespacesRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBwhitespaceRB) - insertFunction "shen.cons_form" (wrapNamed "shen.cons_form" kl_shen_cons_form) - insertFunction "shen.package-macro" (wrapNamed "shen.package-macro" kl_shen_package_macro) - insertFunction "shen.record-exceptions" (wrapNamed "shen.record-exceptions" kl_shen_record_exceptions) - insertFunction "shen.packageh" (wrapNamed "shen.packageh" kl_shen_packageh) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBdefprologRB) - insertFunction "shen.prolog-error" (wrapNamed "shen.prolog-error" kl_shen_prolog_error) - insertFunction "shen.next-50" (wrapNamed "shen.next-50" kl_shen_next_50) - insertFunction "shen.decons-string" (wrapNamed "shen.decons-string" kl_shen_decons_string) - insertFunction "shen.insert-predicate" (wrapNamed "shen.insert-predicate" kl_shen_insert_predicate) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBpredicateMultRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBclausesMultRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBclauseMultRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBheadMultRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBtermMultRB) - insertFunction "shen.legitimate-term?" (wrapNamed "shen.legitimate-term?" kl_shen_legitimate_termP) - insertFunction "shen.eval-cons" (wrapNamed "shen.eval-cons" kl_shen_eval_cons) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBbodyMultRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBliteralMultRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBendMultRB) - insertFunction "cut" (wrapNamed "cut" kl_cut) - insertFunction "shen.insert_modes" (wrapNamed "shen.insert_modes" kl_shen_insert_modes) - insertFunction "shen.s-prolog" (wrapNamed "shen.s-prolog" kl_shen_s_prolog) - insertFunction "shen.prolog->shen" (wrapNamed "shen.prolog->shen" kl_shen_prolog_RBshen) - insertFunction "shen.s-prolog_clause" (wrapNamed "shen.s-prolog_clause" kl_shen_s_prolog_clause) - insertFunction "shen.head_abstraction" (wrapNamed "shen.head_abstraction" kl_shen_head_abstraction) - insertFunction "shen.complexity_head" (wrapNamed "shen.complexity_head" kl_shen_complexity_head) - insertFunction "shen.complexity" (wrapNamed "shen.complexity" kl_shen_complexity) - insertFunction "shen.product" (wrapNamed "shen.product" kl_shen_product) - insertFunction "shen.s-prolog_literal" (wrapNamed "shen.s-prolog_literal" kl_shen_s_prolog_literal) - insertFunction "shen.insert_deref" (wrapNamed "shen.insert_deref" kl_shen_insert_deref) - insertFunction "shen.insert_lazyderef" (wrapNamed "shen.insert_lazyderef" kl_shen_insert_lazyderef) - insertFunction "shen.group_clauses" (wrapNamed "shen.group_clauses" kl_shen_group_clauses) - insertFunction "shen.collect" (wrapNamed "shen.collect" kl_shen_collect) - insertFunction "shen.same_predicate?" (wrapNamed "shen.same_predicate?" kl_shen_same_predicateP) - insertFunction "shen.compile_prolog_procedure" (wrapNamed "shen.compile_prolog_procedure" kl_shen_compile_prolog_procedure) - insertFunction "shen.procedure_name" (wrapNamed "shen.procedure_name" kl_shen_procedure_name) - insertFunction "shen.clauses-to-shen" (wrapNamed "shen.clauses-to-shen" kl_shen_clauses_to_shen) - insertFunction "shen.catch-cut" (wrapNamed "shen.catch-cut" kl_shen_catch_cut) - insertFunction "shen.catchpoint" (PL "shen.catchpoint" kl_shen_catchpoint) - insertFunction "shen.cutpoint" (wrapNamed "shen.cutpoint" kl_shen_cutpoint) - insertFunction "shen.nest-disjunct" (wrapNamed "shen.nest-disjunct" kl_shen_nest_disjunct) - insertFunction "shen.lisp-or" (wrapNamed "shen.lisp-or" kl_shen_lisp_or) - insertFunction "shen.prolog-aritycheck" (wrapNamed "shen.prolog-aritycheck" kl_shen_prolog_aritycheck) - insertFunction "shen.linearise-clause" (wrapNamed "shen.linearise-clause" kl_shen_linearise_clause) - insertFunction "shen.clause_form" (wrapNamed "shen.clause_form" kl_shen_clause_form) - insertFunction "shen.explicit_modes" (wrapNamed "shen.explicit_modes" kl_shen_explicit_modes) - insertFunction "shen.em_help" (wrapNamed "shen.em_help" kl_shen_em_help) - insertFunction "shen.cf_help" (wrapNamed "shen.cf_help" kl_shen_cf_help) - insertFunction "occurs-check" (wrapNamed "occurs-check" kl_occurs_check) - insertFunction "shen.aum" (wrapNamed "shen.aum" kl_shen_aum) - insertFunction "shen.continuation_call" (wrapNamed "shen.continuation_call" kl_shen_continuation_call) - insertFunction "remove" (wrapNamed "remove" kl_remove) - insertFunction "shen.remove-h" (wrapNamed "shen.remove-h" kl_shen_remove_h) - insertFunction "shen.cc_help" (wrapNamed "shen.cc_help" kl_shen_cc_help) - insertFunction "shen.make_mu_application" (wrapNamed "shen.make_mu_application" kl_shen_make_mu_application) - insertFunction "shen.mu_reduction" (wrapNamed "shen.mu_reduction" kl_shen_mu_reduction) - insertFunction "shen.rcons_form" (wrapNamed "shen.rcons_form" kl_shen_rcons_form) - insertFunction "shen.remove_modes" (wrapNamed "shen.remove_modes" kl_shen_remove_modes) - insertFunction "shen.ephemeral_variable?" (wrapNamed "shen.ephemeral_variable?" kl_shen_ephemeral_variableP) - insertFunction "shen.prolog_constant?" (wrapNamed "shen.prolog_constant?" kl_shen_prolog_constantP) - insertFunction "shen.aum_to_shen" (wrapNamed "shen.aum_to_shen" kl_shen_aum_to_shen) - insertFunction "shen.chwild" (wrapNamed "shen.chwild" kl_shen_chwild) - insertFunction "shen.newpv" (wrapNamed "shen.newpv" kl_shen_newpv) - insertFunction "shen.resizeprocessvector" (wrapNamed "shen.resizeprocessvector" kl_shen_resizeprocessvector) - insertFunction "shen.resize-vector" (wrapNamed "shen.resize-vector" kl_shen_resize_vector) - insertFunction "shen.copy-vector" (wrapNamed "shen.copy-vector" kl_shen_copy_vector) - insertFunction "shen.copy-vector-stage-1" (wrapNamed "shen.copy-vector-stage-1" kl_shen_copy_vector_stage_1) - insertFunction "shen.copy-vector-stage-2" (wrapNamed "shen.copy-vector-stage-2" kl_shen_copy_vector_stage_2) - insertFunction "shen.mk-pvar" (wrapNamed "shen.mk-pvar" kl_shen_mk_pvar) - insertFunction "shen.pvar?" (wrapNamed "shen.pvar?" kl_shen_pvarP) - insertFunction "shen.bindv" (wrapNamed "shen.bindv" kl_shen_bindv) - insertFunction "shen.unbindv" (wrapNamed "shen.unbindv" kl_shen_unbindv) - insertFunction "shen.incinfs" (PL "shen.incinfs" kl_shen_incinfs) - insertFunction "shen.call_the_continuation" (wrapNamed "shen.call_the_continuation" kl_shen_call_the_continuation) - insertFunction "shen.newcontinuation" (wrapNamed "shen.newcontinuation" kl_shen_newcontinuation) - insertFunction "return" (wrapNamed "return" kl_return) - insertFunction "shen.measure&return" (wrapNamed "shen.measure&return" kl_shen_measureAndreturn) - insertFunction "unify" (wrapNamed "unify" kl_unify) - insertFunction "shen.lzy=" (wrapNamed "shen.lzy=" kl_shen_lzyEq) - insertFunction "shen.deref" (wrapNamed "shen.deref" kl_shen_deref) - insertFunction "shen.lazyderef" (wrapNamed "shen.lazyderef" kl_shen_lazyderef) - insertFunction "shen.valvector" (wrapNamed "shen.valvector" kl_shen_valvector) - insertFunction "unify!" (wrapNamed "unify!" kl_unifyExcl) - insertFunction "shen.lzy=!" (wrapNamed "shen.lzy=!" kl_shen_lzyEqExcl) - insertFunction "shen.occurs?" (wrapNamed "shen.occurs?" kl_shen_occursP) - insertFunction "identical" (wrapNamed "identical" kl_identical) - insertFunction "shen.lzy==" (wrapNamed "shen.lzy==" kl_shen_lzyEqEq) - insertFunction "shen.pvar" (wrapNamed "shen.pvar" kl_shen_pvar) - insertFunction "bind" (wrapNamed "bind" kl_bind) - insertFunction "fwhen" (wrapNamed "fwhen" kl_fwhen) - insertFunction "call" (wrapNamed "call" kl_call) - insertFunction "shen.call-help" (wrapNamed "shen.call-help" kl_shen_call_help) - insertFunction "shen.intprolog" (wrapNamed "shen.intprolog" kl_shen_intprolog) - insertFunction "shen.intprolog-help" (wrapNamed "shen.intprolog-help" kl_shen_intprolog_help) - insertFunction "shen.intprolog-help-help" (wrapNamed "shen.intprolog-help-help" kl_shen_intprolog_help_help) - insertFunction "shen.call-rest" (wrapNamed "shen.call-rest" kl_shen_call_rest) - insertFunction "shen.start-new-prolog-process" (PL "shen.start-new-prolog-process" kl_shen_start_new_prolog_process) - insertFunction "shen.insert-prolog-variables" (wrapNamed "shen.insert-prolog-variables" kl_shen_insert_prolog_variables) - insertFunction "shen.insert-prolog-variables-help" (wrapNamed "shen.insert-prolog-variables-help" kl_shen_insert_prolog_variables_help) - insertFunction "shen.initialise-prolog" (wrapNamed "shen.initialise-prolog" kl_shen_initialise_prolog) - insertFunction "shen.f_error" (wrapNamed "shen.f_error" kl_shen_f_error) - insertFunction "shen.tracked?" (wrapNamed "shen.tracked?" kl_shen_trackedP) - insertFunction "track" (wrapNamed "track" kl_track) - insertFunction "shen.track-function" (wrapNamed "shen.track-function" kl_shen_track_function) - insertFunction "shen.insert-tracking-code" (wrapNamed "shen.insert-tracking-code" kl_shen_insert_tracking_code) - insertFunction "step" (wrapNamed "step" kl_step) - insertFunction "spy" (wrapNamed "spy" kl_spy) - insertFunction "shen.terpri-or-read-char" (PL "shen.terpri-or-read-char" kl_shen_terpri_or_read_char) - insertFunction "shen.check-byte" (wrapNamed "shen.check-byte" kl_shen_check_byte) - insertFunction "shen.input-track" (wrapNamed "shen.input-track" kl_shen_input_track) - insertFunction "shen.recursively-print" (wrapNamed "shen.recursively-print" kl_shen_recursively_print) - insertFunction "shen.spaces" (wrapNamed "shen.spaces" kl_shen_spaces) - insertFunction "shen.output-track" (wrapNamed "shen.output-track" kl_shen_output_track) - insertFunction "untrack" (wrapNamed "untrack" kl_untrack) - insertFunction "profile" (wrapNamed "profile" kl_profile) - insertFunction "shen.profile-help" (wrapNamed "shen.profile-help" kl_shen_profile_help) - insertFunction "unprofile" (wrapNamed "unprofile" kl_unprofile) - insertFunction "shen.profile-func" (wrapNamed "shen.profile-func" kl_shen_profile_func) - insertFunction "profile-results" (wrapNamed "profile-results" kl_profile_results) - insertFunction "shen.get-profile" (wrapNamed "shen.get-profile" kl_shen_get_profile) - insertFunction "shen.put-profile" (wrapNamed "shen.put-profile" kl_shen_put_profile) - insertFunction "load" (wrapNamed "load" kl_load) - insertFunction "shen.load-help" (wrapNamed "shen.load-help" kl_shen_load_help) - insertFunction "shen.remove-synonyms" (wrapNamed "shen.remove-synonyms" kl_shen_remove_synonyms) - insertFunction "shen.typecheck-and-load" (wrapNamed "shen.typecheck-and-load" kl_shen_typecheck_and_load) - insertFunction "shen.typetable" (wrapNamed "shen.typetable" kl_shen_typetable) - insertFunction "shen.assumetype" (wrapNamed "shen.assumetype" kl_shen_assumetype) - insertFunction "shen.unwind-types" (wrapNamed "shen.unwind-types" kl_shen_unwind_types) - insertFunction "shen.remtype" (wrapNamed "shen.remtype" kl_shen_remtype) - insertFunction "shen.removetype" (wrapNamed "shen.removetype" kl_shen_removetype) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBsigPlusrestRB) - insertFunction "write-to-file" (wrapNamed "write-to-file" kl_write_to_file) - insertFunction "pr" (wrapNamed "pr" kl_pr) - insertFunction "shen.prh" (wrapNamed "shen.prh" kl_shen_prh) - insertFunction "shen.write-char-and-inc" (wrapNamed "shen.write-char-and-inc" kl_shen_write_char_and_inc) - insertFunction "print" (wrapNamed "print" kl_print) - insertFunction "shen.prhush" (wrapNamed "shen.prhush" kl_shen_prhush) - insertFunction "shen.mkstr" (wrapNamed "shen.mkstr" kl_shen_mkstr) - insertFunction "shen.mkstr-l" (wrapNamed "shen.mkstr-l" kl_shen_mkstr_l) - insertFunction "shen.insert-l" (wrapNamed "shen.insert-l" kl_shen_insert_l) - insertFunction "shen.factor-cn" (wrapNamed "shen.factor-cn" kl_shen_factor_cn) - insertFunction "shen.proc-nl" (wrapNamed "shen.proc-nl" kl_shen_proc_nl) - insertFunction "shen.mkstr-r" (wrapNamed "shen.mkstr-r" kl_shen_mkstr_r) - insertFunction "shen.insert" (wrapNamed "shen.insert" kl_shen_insert) - insertFunction "shen.insert-h" (wrapNamed "shen.insert-h" kl_shen_insert_h) - insertFunction "shen.app" (wrapNamed "shen.app" kl_shen_app) - insertFunction "shen.arg->str" (wrapNamed "shen.arg->str" kl_shen_arg_RBstr) - insertFunction "shen.list->str" (wrapNamed "shen.list->str" kl_shen_list_RBstr) - insertFunction "shen.maxseq" (PL "shen.maxseq" kl_shen_maxseq) - insertFunction "shen.iter-list" (wrapNamed "shen.iter-list" kl_shen_iter_list) - insertFunction "shen.str->str" (wrapNamed "shen.str->str" kl_shen_str_RBstr) - insertFunction "shen.vector->str" (wrapNamed "shen.vector->str" kl_shen_vector_RBstr) - insertFunction "shen.print-vector?" (wrapNamed "shen.print-vector?" kl_shen_print_vectorP) - insertFunction "shen.fbound?" (wrapNamed "shen.fbound?" kl_shen_fboundP) - insertFunction "shen.tuple" (wrapNamed "shen.tuple" kl_shen_tuple) - insertFunction "shen.iter-vector" (wrapNamed "shen.iter-vector" kl_shen_iter_vector) - insertFunction "shen.atom->str" (wrapNamed "shen.atom->str" kl_shen_atom_RBstr) - insertFunction "shen.funexstring" (PL "shen.funexstring" kl_shen_funexstring) - insertFunction "shen.list?" (wrapNamed "shen.list?" kl_shen_listP) - insertFunction "macroexpand" (wrapNamed "macroexpand" kl_macroexpand) - insertFunction "shen.error-macro" (wrapNamed "shen.error-macro" kl_shen_error_macro) - insertFunction "shen.output-macro" (wrapNamed "shen.output-macro" kl_shen_output_macro) - insertFunction "shen.make-string-macro" (wrapNamed "shen.make-string-macro" kl_shen_make_string_macro) - insertFunction "shen.input-macro" (wrapNamed "shen.input-macro" kl_shen_input_macro) - insertFunction "shen.compose" (wrapNamed "shen.compose" kl_shen_compose) - insertFunction "shen.compile-macro" (wrapNamed "shen.compile-macro" kl_shen_compile_macro) - insertFunction "shen.prolog-macro" (wrapNamed "shen.prolog-macro" kl_shen_prolog_macro) - insertFunction "shen.receive-terms" (wrapNamed "shen.receive-terms" kl_shen_receive_terms) - insertFunction "shen.pass-literals" (wrapNamed "shen.pass-literals" kl_shen_pass_literals) - insertFunction "shen.defprolog-macro" (wrapNamed "shen.defprolog-macro" kl_shen_defprolog_macro) - insertFunction "shen.datatype-macro" (wrapNamed "shen.datatype-macro" kl_shen_datatype_macro) - insertFunction "shen.intern-type" (wrapNamed "shen.intern-type" kl_shen_intern_type) - insertFunction "shen.@s-macro" (wrapNamed "shen.@s-macro" kl_shen_Ats_macro) - insertFunction "shen.synonyms-macro" (wrapNamed "shen.synonyms-macro" kl_shen_synonyms_macro) - insertFunction "shen.curry-synonyms" (wrapNamed "shen.curry-synonyms" kl_shen_curry_synonyms) - insertFunction "shen.nl-macro" (wrapNamed "shen.nl-macro" kl_shen_nl_macro) - insertFunction "shen.assoc-macro" (wrapNamed "shen.assoc-macro" kl_shen_assoc_macro) - insertFunction "shen.let-macro" (wrapNamed "shen.let-macro" kl_shen_let_macro) - insertFunction "shen.abs-macro" (wrapNamed "shen.abs-macro" kl_shen_abs_macro) - insertFunction "shen.cases-macro" (wrapNamed "shen.cases-macro" kl_shen_cases_macro) - insertFunction "shen.timer-macro" (wrapNamed "shen.timer-macro" kl_shen_timer_macro) - insertFunction "shen.tuple-up" (wrapNamed "shen.tuple-up" kl_shen_tuple_up) - insertFunction "shen.put/get-macro" (wrapNamed "shen.put/get-macro" kl_shen_putDivget_macro) - insertFunction "shen.function-macro" (wrapNamed "shen.function-macro" kl_shen_function_macro) - insertFunction "shen.function-abstraction" (wrapNamed "shen.function-abstraction" kl_shen_function_abstraction) - insertFunction "shen.function-abstraction-help" (wrapNamed "shen.function-abstraction-help" kl_shen_function_abstraction_help) - insertFunction "undefmacro" (wrapNamed "undefmacro" kl_undefmacro) - insertFunction "shen.findpos" (wrapNamed "shen.findpos" kl_shen_findpos) - insertFunction "shen.remove-nth" (wrapNamed "shen.remove-nth" kl_shen_remove_nth) - insertFunction "shen.initialise_arity_table" (wrapNamed "shen.initialise_arity_table" kl_shen_initialise_arity_table) - insertFunction "arity" (wrapNamed "arity" kl_arity) - insertFunction "systemf" (wrapNamed "systemf" kl_systemf) - insertFunction "adjoin" (wrapNamed "adjoin" kl_adjoin) - insertFunction "shen.symbol-table-entry" (wrapNamed "shen.symbol-table-entry" kl_shen_symbol_table_entry) - insertFunction "shen.lambda-form" (wrapNamed "shen.lambda-form" kl_shen_lambda_form) - insertFunction "shen.add-end" (wrapNamed "shen.add-end" kl_shen_add_end) - insertFunction "specialise" (wrapNamed "specialise" kl_specialise) - insertFunction "unspecialise" (wrapNamed "unspecialise" kl_unspecialise) - insertFunction "declare" (wrapNamed "declare" kl_declare) - insertFunction "shen.demodulate" (wrapNamed "shen.demodulate" kl_shen_demodulate) - insertFunction "shen.variancy-test" (wrapNamed "shen.variancy-test" kl_shen_variancy_test) - insertFunction "shen.variant?" (wrapNamed "shen.variant?" kl_shen_variantP) - insertFunction "shen.typecheck" (wrapNamed "shen.typecheck" kl_shen_typecheck) - insertFunction "shen.curry" (wrapNamed "shen.curry" kl_shen_curry) - insertFunction "shen.special?" (wrapNamed "shen.special?" kl_shen_specialP) - insertFunction "shen.extraspecial?" (wrapNamed "shen.extraspecial?" kl_shen_extraspecialP) - insertFunction "shen.t*" (wrapNamed "shen.t*" kl_shen_tMult) - insertFunction "shen.type-theory-enabled?" (PL "shen.type-theory-enabled?" kl_shen_type_theory_enabledP) - insertFunction "enable-type-theory" (wrapNamed "enable-type-theory" kl_enable_type_theory) - insertFunction "shen.prolog-failure" (wrapNamed "shen.prolog-failure" kl_shen_prolog_failure) - insertFunction "shen.maxinfexceeded?" (PL "shen.maxinfexceeded?" kl_shen_maxinfexceededP) - insertFunction "shen.errormaxinfs" (PL "shen.errormaxinfs" kl_shen_errormaxinfs) - insertFunction "shen.udefs*" (wrapNamed "shen.udefs*" kl_shen_udefsMult) - insertFunction "shen.th*" (wrapNamed "shen.th*" kl_shen_thMult) - insertFunction "shen.t*-hyps" (wrapNamed "shen.t*-hyps" kl_shen_tMult_hyps) - insertFunction "shen.show" (wrapNamed "shen.show" kl_shen_show) - insertFunction "shen.line" (PL "shen.line" kl_shen_line) - insertFunction "shen.show-p" (wrapNamed "shen.show-p" kl_shen_show_p) - insertFunction "shen.show-assumptions" (wrapNamed "shen.show-assumptions" kl_shen_show_assumptions) - insertFunction "shen.pause-for-user" (PL "shen.pause-for-user" kl_shen_pause_for_user) - insertFunction "shen.typedf?" (wrapNamed "shen.typedf?" kl_shen_typedfP) - insertFunction "shen.sigf" (wrapNamed "shen.sigf" kl_shen_sigf) - insertFunction "shen.placeholder" (PL "shen.placeholder" kl_shen_placeholder) - insertFunction "shen.base" (wrapNamed "shen.base" kl_shen_base) - insertFunction "shen.by_hypothesis" (wrapNamed "shen.by_hypothesis" kl_shen_by_hypothesis) - insertFunction "shen.t*-def" (wrapNamed "shen.t*-def" kl_shen_tMult_def) - insertFunction "shen.t*-defh" (wrapNamed "shen.t*-defh" kl_shen_tMult_defh) - insertFunction "shen.t*-defhh" (wrapNamed "shen.t*-defhh" kl_shen_tMult_defhh) - insertFunction "shen.memo" (wrapNamed "shen.memo" kl_shen_memo) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBsigPlusrulesRB) - insertFunction "shen." (wrapNamed "shen." kl_shen_LBnon_ll_rulesRB) - insertFunction "shen.ue" (wrapNamed "shen.ue" kl_shen_ue) - insertFunction "shen.ue-sig" (wrapNamed "shen.ue-sig" kl_shen_ue_sig) - insertFunction "shen.ues" (wrapNamed "shen.ues" kl_shen_ues) - insertFunction "shen.ue?" (wrapNamed "shen.ue?" kl_shen_ueP) - insertFunction "shen.ue-h?" (wrapNamed "shen.ue-h?" kl_shen_ue_hP) - insertFunction "shen.t*-rules" (wrapNamed "shen.t*-rules" kl_shen_tMult_rules) - insertFunction "shen.t*-rule" (wrapNamed "shen.t*-rule" kl_shen_tMult_rule) - insertFunction "shen.placeholders" (wrapNamed "shen.placeholders" kl_shen_placeholders) - insertFunction "shen.newhyps" (wrapNamed "shen.newhyps" kl_shen_newhyps) - insertFunction "shen.patthyps" (wrapNamed "shen.patthyps" kl_shen_patthyps) - insertFunction "shen.result-type" (wrapNamed "shen.result-type" kl_shen_result_type) - insertFunction "shen.t*-patterns" (wrapNamed "shen.t*-patterns" kl_shen_tMult_patterns) - insertFunction "shen.t*-action" (wrapNamed "shen.t*-action" kl_shen_tMult_action) - insertFunction "findall" (wrapNamed "findall" kl_findall) - insertFunction "shen.findallhelp" (wrapNamed "shen.findallhelp" kl_shen_findallhelp) - insertFunction "shen.remember" (wrapNamed "shen.remember" kl_shen_remember) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.FunctionTable where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel +import Backend.Core +import Backend.Sys +import Backend.Sequent +import Backend.Yacc +import Backend.Reader +import Backend.Prolog +import Backend.Track +import Backend.Load +import Backend.Writer +import Backend.Macros +import Backend.Declarations +import Backend.Types +import Backend.TStar + +{- +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. +-} + +functions = do insertFunction "shen.shen" (PL "shen.shen" kl_shen_shen) + insertFunction "exit" (wrapNamed "exit" kl_exit) + insertFunction "shen.loop" (PL "shen.loop" kl_shen_loop) + insertFunction "shen.credits" (PL "shen.credits" kl_shen_credits) + insertFunction "shen.initialise_environment" (PL "shen.initialise_environment" kl_shen_initialise_environment) + insertFunction "shen.multiple-set" (wrapNamed "shen.multiple-set" kl_shen_multiple_set) + insertFunction "destroy" (wrapNamed "destroy" kl_destroy) + insertFunction "shen.read-evaluate-print" (PL "shen.read-evaluate-print" kl_shen_read_evaluate_print) + insertFunction "shen.retrieve-from-history-if-needed" (wrapNamed "shen.retrieve-from-history-if-needed" kl_shen_retrieve_from_history_if_needed) + insertFunction "shen.percent" (PL "shen.percent" kl_shen_percent) + insertFunction "shen.exclamation" (PL "shen.exclamation" kl_shen_exclamation) + insertFunction "shen.prbytes" (wrapNamed "shen.prbytes" kl_shen_prbytes) + insertFunction "shen.update_history" (wrapNamed "shen.update_history" kl_shen_update_history) + insertFunction "shen.toplineread" (PL "shen.toplineread" kl_shen_toplineread) + insertFunction "shen.toplineread_loop" (wrapNamed "shen.toplineread_loop" kl_shen_toplineread_loop) + insertFunction "shen.hat" (PL "shen.hat" kl_shen_hat) + insertFunction "shen.newline" (PL "shen.newline" kl_shen_newline) + insertFunction "shen.carriage-return" (PL "shen.carriage-return" kl_shen_carriage_return) + insertFunction "tc" (wrapNamed "tc" kl_tc) + insertFunction "shen.prompt" (PL "shen.prompt" kl_shen_prompt) + insertFunction "shen.toplevel" (wrapNamed "shen.toplevel" kl_shen_toplevel) + insertFunction "shen.find-past-inputs" (wrapNamed "shen.find-past-inputs" kl_shen_find_past_inputs) + insertFunction "shen.make-key" (wrapNamed "shen.make-key" kl_shen_make_key) + insertFunction "shen.trim-gubbins" (wrapNamed "shen.trim-gubbins" kl_shen_trim_gubbins) + insertFunction "shen.space" (PL "shen.space" kl_shen_space) + insertFunction "shen.tab" (PL "shen.tab" kl_shen_tab) + insertFunction "shen.left-round" (PL "shen.left-round" kl_shen_left_round) + insertFunction "shen.find" (wrapNamed "shen.find" kl_shen_find) + insertFunction "shen.prefix?" (wrapNamed "shen.prefix?" kl_shen_prefixP) + insertFunction "shen.print-past-inputs" (wrapNamed "shen.print-past-inputs" kl_shen_print_past_inputs) + insertFunction "shen.toplevel_evaluate" (wrapNamed "shen.toplevel_evaluate" kl_shen_toplevel_evaluate) + insertFunction "shen.typecheck-and-evaluate" (wrapNamed "shen.typecheck-and-evaluate" kl_shen_typecheck_and_evaluate) + insertFunction "shen.pretty-type" (wrapNamed "shen.pretty-type" kl_shen_pretty_type) + insertFunction "shen.extract-pvars" (wrapNamed "shen.extract-pvars" kl_shen_extract_pvars) + insertFunction "shen.mult_subst" (wrapNamed "shen.mult_subst" kl_shen_mult_subst) + insertFunction "shen->kl" (wrapNamed "shen->kl" kl_shen_RBkl) + insertFunction "shen-syntax-error" (wrapNamed "shen-syntax-error" kl_shen_syntax_error) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBdefineRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBnameRB) + insertFunction "shen.sysfunc?" (wrapNamed "shen.sysfunc?" kl_shen_sysfuncP) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBsignatureRB) + insertFunction "shen.curry-type" (wrapNamed "shen.curry-type" kl_shen_curry_type) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBsignature_helpRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBrulesRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBruleRB) + insertFunction "shen.fail_if" (wrapNamed "shen.fail_if" kl_shen_fail_if) + insertFunction "shen.succeeds?" (wrapNamed "shen.succeeds?" kl_shen_succeedsP) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBpatternsRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBpatternRB) + insertFunction "shen.constructor-error" (wrapNamed "shen.constructor-error" kl_shen_constructor_error) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBsimple_patternRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBpattern1RB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBpattern2RB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBactionRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBguardRB) + insertFunction "shen.compile_to_machine_code" (wrapNamed "shen.compile_to_machine_code" kl_shen_compile_to_machine_code) + insertFunction "shen.record-source" (wrapNamed "shen.record-source" kl_shen_record_source) + insertFunction "shen.compile_to_lambda+" (wrapNamed "shen.compile_to_lambda+" kl_shen_compile_to_lambdaPlus) + insertFunction "shen.update-symbol-table" (wrapNamed "shen.update-symbol-table" kl_shen_update_symbol_table) + insertFunction "shen.free_variable_check" (wrapNamed "shen.free_variable_check" kl_shen_free_variable_check) + insertFunction "shen.extract_vars" (wrapNamed "shen.extract_vars" kl_shen_extract_vars) + insertFunction "shen.extract_free_vars" (wrapNamed "shen.extract_free_vars" kl_shen_extract_free_vars) + insertFunction "shen.free_variable_warnings" (wrapNamed "shen.free_variable_warnings" kl_shen_free_variable_warnings) + insertFunction "shen.list_variables" (wrapNamed "shen.list_variables" kl_shen_list_variables) + insertFunction "shen.strip-protect" (wrapNamed "shen.strip-protect" kl_shen_strip_protect) + insertFunction "shen.linearise" (wrapNamed "shen.linearise" kl_shen_linearise) + insertFunction "shen.flatten" (wrapNamed "shen.flatten" kl_shen_flatten) + insertFunction "shen.linearise_help" (wrapNamed "shen.linearise_help" kl_shen_linearise_help) + insertFunction "shen.linearise_X" (wrapNamed "shen.linearise_X" kl_shen_linearise_X) + insertFunction "shen.aritycheck" (wrapNamed "shen.aritycheck" kl_shen_aritycheck) + insertFunction "shen.aritycheck-name" (wrapNamed "shen.aritycheck-name" kl_shen_aritycheck_name) + insertFunction "shen.aritycheck-action" (wrapNamed "shen.aritycheck-action" kl_shen_aritycheck_action) + insertFunction "shen.aah" (wrapNamed "shen.aah" kl_shen_aah) + insertFunction "shen.abstract_rule" (wrapNamed "shen.abstract_rule" kl_shen_abstract_rule) + insertFunction "shen.abstraction_build" (wrapNamed "shen.abstraction_build" kl_shen_abstraction_build) + insertFunction "shen.parameters" (wrapNamed "shen.parameters" kl_shen_parameters) + insertFunction "shen.application_build" (wrapNamed "shen.application_build" kl_shen_application_build) + insertFunction "shen.compile_to_kl" (wrapNamed "shen.compile_to_kl" kl_shen_compile_to_kl) + insertFunction "shen.get-type" (wrapNamed "shen.get-type" kl_shen_get_type) + insertFunction "shen.typextable" (wrapNamed "shen.typextable" kl_shen_typextable) + insertFunction "shen.assign-types" (wrapNamed "shen.assign-types" kl_shen_assign_types) + insertFunction "shen.atom-type" (wrapNamed "shen.atom-type" kl_shen_atom_type) + insertFunction "shen.store-arity" (wrapNamed "shen.store-arity" kl_shen_store_arity) + insertFunction "shen.reduce" (wrapNamed "shen.reduce" kl_shen_reduce) + insertFunction "shen.reduce_help" (wrapNamed "shen.reduce_help" kl_shen_reduce_help) + insertFunction "shen.+string?" (wrapNamed "shen.+string?" kl_shen_PlusstringP) + insertFunction "shen.+vector?" (wrapNamed "shen.+vector?" kl_shen_PlusvectorP) + insertFunction "shen.ebr" (wrapNamed "shen.ebr" kl_shen_ebr) + insertFunction "shen.add_test" (wrapNamed "shen.add_test" kl_shen_add_test) + insertFunction "shen.cond-expression" (wrapNamed "shen.cond-expression" kl_shen_cond_expression) + insertFunction "shen.cond-form" (wrapNamed "shen.cond-form" kl_shen_cond_form) + insertFunction "shen.encode-choices" (wrapNamed "shen.encode-choices" kl_shen_encode_choices) + insertFunction "shen.case-form" (wrapNamed "shen.case-form" kl_shen_case_form) + insertFunction "shen.embed-and" (wrapNamed "shen.embed-and" kl_shen_embed_and) + insertFunction "shen.err-condition" (wrapNamed "shen.err-condition" kl_shen_err_condition) + insertFunction "shen.sys-error" (wrapNamed "shen.sys-error" kl_shen_sys_error) + insertFunction "thaw" (wrapNamed "thaw" kl_thaw) + insertFunction "eval" (wrapNamed "eval" kl_eval) + insertFunction "shen.eval-without-macros" (wrapNamed "shen.eval-without-macros" kl_shen_eval_without_macros) + insertFunction "shen.proc-input+" (wrapNamed "shen.proc-input+" kl_shen_proc_inputPlus) + insertFunction "shen.elim-def" (wrapNamed "shen.elim-def" kl_shen_elim_def) + insertFunction "shen.add-macro" (wrapNamed "shen.add-macro" kl_shen_add_macro) + insertFunction "shen.packaged?" (wrapNamed "shen.packaged?" kl_shen_packagedP) + insertFunction "external" (wrapNamed "external" kl_external) + insertFunction "internal" (wrapNamed "internal" kl_internal) + insertFunction "shen.package-contents" (wrapNamed "shen.package-contents" kl_shen_package_contents) + insertFunction "shen.walk" (wrapNamed "shen.walk" kl_shen_walk) + insertFunction "compile" (wrapNamed "compile" kl_compile) + insertFunction "fail-if" (wrapNamed "fail-if" kl_fail_if) + insertFunction "@s" (wrapNamed "@s" kl_Ats) + insertFunction "tc?" (PL "tc?" kl_tcP) + insertFunction "ps" (wrapNamed "ps" kl_ps) + insertFunction "stinput" (PL "stinput" kl_stinput) + insertFunction "<-address/or" (wrapNamed "<-address/or" kl_LB_addressDivor) + insertFunction "value/or" (wrapNamed "value/or" kl_valueDivor) + insertFunction "vector" (wrapNamed "vector" kl_vector) + insertFunction "shen.fillvector" (wrapNamed "shen.fillvector" kl_shen_fillvector) + insertFunction "vector?" (wrapNamed "vector?" kl_vectorP) + insertFunction "vector->" (wrapNamed "vector->" kl_vector_RB) + insertFunction "<-vector" (wrapNamed "<-vector" kl_LB_vector) + insertFunction "<-vector/or" (wrapNamed "<-vector/or" kl_LB_vectorDivor) + insertFunction "shen.posint?" (wrapNamed "shen.posint?" kl_shen_posintP) + insertFunction "limit" (wrapNamed "limit" kl_limit) + insertFunction "symbol?" (wrapNamed "symbol?" kl_symbolP) + insertFunction "shen.analyse-symbol?" (wrapNamed "shen.analyse-symbol?" kl_shen_analyse_symbolP) + insertFunction "shen.alpha?" (wrapNamed "shen.alpha?" kl_shen_alphaP) + insertFunction "shen.alphanums?" (wrapNamed "shen.alphanums?" kl_shen_alphanumsP) + insertFunction "shen.alphanum?" (wrapNamed "shen.alphanum?" kl_shen_alphanumP) + insertFunction "shen.digit?" (wrapNamed "shen.digit?" kl_shen_digitP) + insertFunction "variable?" (wrapNamed "variable?" kl_variableP) + insertFunction "shen.analyse-variable?" (wrapNamed "shen.analyse-variable?" kl_shen_analyse_variableP) + insertFunction "shen.uppercase?" (wrapNamed "shen.uppercase?" kl_shen_uppercaseP) + insertFunction "gensym" (wrapNamed "gensym" kl_gensym) + insertFunction "concat" (wrapNamed "concat" kl_concat) + insertFunction "@p" (wrapNamed "@p" kl_Atp) + insertFunction "fst" (wrapNamed "fst" kl_fst) + insertFunction "snd" (wrapNamed "snd" kl_snd) + insertFunction "tuple?" (wrapNamed "tuple?" kl_tupleP) + insertFunction "append" (wrapNamed "append" kl_append) + insertFunction "@v" (wrapNamed "@v" kl_Atv) + insertFunction "shen.@v-help" (wrapNamed "shen.@v-help" kl_shen_Atv_help) + insertFunction "shen.copyfromvector" (wrapNamed "shen.copyfromvector" kl_shen_copyfromvector) + insertFunction "hdv" (wrapNamed "hdv" kl_hdv) + insertFunction "tlv" (wrapNamed "tlv" kl_tlv) + insertFunction "shen.tlv-help" (wrapNamed "shen.tlv-help" kl_shen_tlv_help) + insertFunction "assoc" (wrapNamed "assoc" kl_assoc) + insertFunction "boolean?" (wrapNamed "boolean?" kl_booleanP) + insertFunction "nl" (wrapNamed "nl" kl_nl) + insertFunction "difference" (wrapNamed "difference" kl_difference) + insertFunction "do" (wrapNamed "do" kl_do) + insertFunction "element?" (wrapNamed "element?" kl_elementP) + insertFunction "empty?" (wrapNamed "empty?" kl_emptyP) + insertFunction "fix" (wrapNamed "fix" kl_fix) + insertFunction "shen.fix-help" (wrapNamed "shen.fix-help" kl_shen_fix_help) + insertFunction "dict" (wrapNamed "dict" kl_dict) + insertFunction "dict?" (wrapNamed "dict?" kl_dictP) + insertFunction "shen.dict-capacity" (wrapNamed "shen.dict-capacity" kl_shen_dict_capacity) + insertFunction "dict-count" (wrapNamed "dict-count" kl_dict_count) + insertFunction "shen.dict-count->" (wrapNamed "shen.dict-count->" kl_shen_dict_count_RB) + insertFunction "shen.<-dict-bucket" (wrapNamed "shen.<-dict-bucket" kl_shen_LB_dict_bucket) + insertFunction "shen.dict-bucket->" (wrapNamed "shen.dict-bucket->" kl_shen_dict_bucket_RB) + insertFunction "shen.set-key-entry-value" (wrapNamed "shen.set-key-entry-value" kl_shen_set_key_entry_value) + insertFunction "shen.remove-key-entry-value" (wrapNamed "shen.remove-key-entry-value" kl_shen_remove_key_entry_value) + insertFunction "shen.dict-update-count" (wrapNamed "shen.dict-update-count" kl_shen_dict_update_count) + insertFunction "dict->" (wrapNamed "dict->" kl_dict_RB) + insertFunction "<-dict/or" (wrapNamed "<-dict/or" kl_LB_dictDivor) + insertFunction "<-dict" (wrapNamed "<-dict" kl_LB_dict) + insertFunction "dict-rm" (wrapNamed "dict-rm" kl_dict_rm) + insertFunction "dict-fold" (wrapNamed "dict-fold" kl_dict_fold) + insertFunction "shen.dict-fold-h" (wrapNamed "shen.dict-fold-h" kl_shen_dict_fold_h) + insertFunction "shen.bucket-fold" (wrapNamed "shen.bucket-fold" kl_shen_bucket_fold) + insertFunction "dict-keys" (wrapNamed "dict-keys" kl_dict_keys) + insertFunction "dict-values" (wrapNamed "dict-values" kl_dict_values) + insertFunction "put" (wrapNamed "put" kl_put) + insertFunction "unput" (wrapNamed "unput" kl_unput) + insertFunction "get/or" (wrapNamed "get/or" kl_getDivor) + insertFunction "get" (wrapNamed "get" kl_get) + insertFunction "hash" (wrapNamed "hash" kl_hash) + insertFunction "shen.mod" (wrapNamed "shen.mod" kl_shen_mod) + insertFunction "shen.multiples" (wrapNamed "shen.multiples" kl_shen_multiples) + insertFunction "shen.modh" (wrapNamed "shen.modh" kl_shen_modh) + insertFunction "sum" (wrapNamed "sum" kl_sum) + insertFunction "head" (wrapNamed "head" kl_head) + insertFunction "tail" (wrapNamed "tail" kl_tail) + insertFunction "hdstr" (wrapNamed "hdstr" kl_hdstr) + insertFunction "intersection" (wrapNamed "intersection" kl_intersection) + insertFunction "reverse" (wrapNamed "reverse" kl_reverse) + insertFunction "shen.reverse_help" (wrapNamed "shen.reverse_help" kl_shen_reverse_help) + insertFunction "union" (wrapNamed "union" kl_union) + insertFunction "y-or-n?" (wrapNamed "y-or-n?" kl_y_or_nP) + insertFunction "not" (wrapNamed "not" kl_not) + insertFunction "subst" (wrapNamed "subst" kl_subst) + insertFunction "explode" (wrapNamed "explode" kl_explode) + insertFunction "shen.explode-h" (wrapNamed "shen.explode-h" kl_shen_explode_h) + insertFunction "cd" (wrapNamed "cd" kl_cd) + insertFunction "for-each" (wrapNamed "for-each" kl_for_each) + insertFunction "fold-right" (wrapNamed "fold-right" kl_fold_right) + insertFunction "fold-left" (wrapNamed "fold-left" kl_fold_left) + insertFunction "filter" (wrapNamed "filter" kl_filter) + insertFunction "shen.filter-h" (wrapNamed "shen.filter-h" kl_shen_filter_h) + insertFunction "map" (wrapNamed "map" kl_map) + insertFunction "shen.map-h" (wrapNamed "shen.map-h" kl_shen_map_h) + insertFunction "length" (wrapNamed "length" kl_length) + insertFunction "shen.length-h" (wrapNamed "shen.length-h" kl_shen_length_h) + insertFunction "occurrences" (wrapNamed "occurrences" kl_occurrences) + insertFunction "nth" (wrapNamed "nth" kl_nth) + insertFunction "integer?" (wrapNamed "integer?" kl_integerP) + insertFunction "shen.abs" (wrapNamed "shen.abs" kl_shen_abs) + insertFunction "shen.magless" (wrapNamed "shen.magless" kl_shen_magless) + insertFunction "shen.integer-test?" (wrapNamed "shen.integer-test?" kl_shen_integer_testP) + insertFunction "mapcan" (wrapNamed "mapcan" kl_mapcan) + insertFunction "==" (wrapNamed "==" kl_EqEq) + insertFunction "abort" (PL "abort" kl_abort) + insertFunction "bound?" (wrapNamed "bound?" kl_boundP) + insertFunction "shen.string->bytes" (wrapNamed "shen.string->bytes" kl_shen_string_RBbytes) + insertFunction "maxinferences" (wrapNamed "maxinferences" kl_maxinferences) + insertFunction "inferences" (PL "inferences" kl_inferences) + insertFunction "protect" (wrapNamed "protect" kl_protect) + insertFunction "stoutput" (PL "stoutput" kl_stoutput) + insertFunction "sterror" (PL "sterror" kl_sterror) + insertFunction "string->symbol" (wrapNamed "string->symbol" kl_string_RBsymbol) + insertFunction "optimise" (wrapNamed "optimise" kl_optimise) + insertFunction "os" (PL "os" kl_os) + insertFunction "language" (PL "language" kl_language) + insertFunction "version" (PL "version" kl_version) + insertFunction "port" (PL "port" kl_port) + insertFunction "porters" (PL "porters" kl_porters) + insertFunction "implementation" (PL "implementation" kl_implementation) + insertFunction "release" (PL "release" kl_release) + insertFunction "package?" (wrapNamed "package?" kl_packageP) + insertFunction "function" (wrapNamed "function" kl_function) + insertFunction "shen.lookup-func" (wrapNamed "shen.lookup-func" kl_shen_lookup_func) + insertFunction "shen.datatype-error" (wrapNamed "shen.datatype-error" kl_shen_datatype_error) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBdatatype_rulesRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBdatatype_ruleRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBside_conditionsRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBside_conditionRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBvariablePRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBexprRB) + insertFunction "shen.remove-bar" (wrapNamed "shen.remove-bar" kl_shen_remove_bar) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBpremisesRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBsemicolon_symbolRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBpremiseRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBconclusionRB) + insertFunction "shen.sequent" (wrapNamed "shen.sequent" kl_shen_sequent) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBformulaeRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBcomma_symbolRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBformulaRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBtypeRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBdoubleunderlineRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBsingleunderlineRB) + insertFunction "shen.singleunderline?" (wrapNamed "shen.singleunderline?" kl_shen_singleunderlineP) + insertFunction "shen.sh?" (wrapNamed "shen.sh?" kl_shen_shP) + insertFunction "shen.doubleunderline?" (wrapNamed "shen.doubleunderline?" kl_shen_doubleunderlineP) + insertFunction "shen.dh?" (wrapNamed "shen.dh?" kl_shen_dhP) + insertFunction "shen.process-datatype" (wrapNamed "shen.process-datatype" kl_shen_process_datatype) + insertFunction "shen.remember-datatype" (wrapNamed "shen.remember-datatype" kl_shen_remember_datatype) + insertFunction "shen.rules->horn-clauses" (wrapNamed "shen.rules->horn-clauses" kl_shen_rules_RBhorn_clauses) + insertFunction "shen.double->singles" (wrapNamed "shen.double->singles" kl_shen_double_RBsingles) + insertFunction "shen.right-rule" (wrapNamed "shen.right-rule" kl_shen_right_rule) + insertFunction "shen.left-rule" (wrapNamed "shen.left-rule" kl_shen_left_rule) + insertFunction "shen.right->left" (wrapNamed "shen.right->left" kl_shen_right_RBleft) + insertFunction "shen.rule->horn-clause" (wrapNamed "shen.rule->horn-clause" kl_shen_rule_RBhorn_clause) + insertFunction "shen.rule->horn-clause-head" (wrapNamed "shen.rule->horn-clause-head" kl_shen_rule_RBhorn_clause_head) + insertFunction "shen.mode-ify" (wrapNamed "shen.mode-ify" kl_shen_mode_ify) + insertFunction "shen.rule->horn-clause-body" (wrapNamed "shen.rule->horn-clause-body" kl_shen_rule_RBhorn_clause_body) + insertFunction "shen.construct-search-literals" (wrapNamed "shen.construct-search-literals" kl_shen_construct_search_literals) + insertFunction "shen.csl-help" (wrapNamed "shen.csl-help" kl_shen_csl_help) + insertFunction "shen.construct-search-clauses" (wrapNamed "shen.construct-search-clauses" kl_shen_construct_search_clauses) + insertFunction "shen.construct-search-clause" (wrapNamed "shen.construct-search-clause" kl_shen_construct_search_clause) + insertFunction "shen.construct-base-search-clause" (wrapNamed "shen.construct-base-search-clause" kl_shen_construct_base_search_clause) + insertFunction "shen.construct-recursive-search-clause" (wrapNamed "shen.construct-recursive-search-clause" kl_shen_construct_recursive_search_clause) + insertFunction "shen.construct-side-literals" (wrapNamed "shen.construct-side-literals" kl_shen_construct_side_literals) + insertFunction "shen.construct-premiss-literal" (wrapNamed "shen.construct-premiss-literal" kl_shen_construct_premiss_literal) + insertFunction "shen.construct-context" (wrapNamed "shen.construct-context" kl_shen_construct_context) + insertFunction "shen.recursive_cons_form" (wrapNamed "shen.recursive_cons_form" kl_shen_recursive_cons_form) + insertFunction "preclude" (wrapNamed "preclude" kl_preclude) + insertFunction "shen.preclude-h" (wrapNamed "shen.preclude-h" kl_shen_preclude_h) + insertFunction "include" (wrapNamed "include" kl_include) + insertFunction "shen.include-h" (wrapNamed "shen.include-h" kl_shen_include_h) + insertFunction "preclude-all-but" (wrapNamed "preclude-all-but" kl_preclude_all_but) + insertFunction "include-all-but" (wrapNamed "include-all-but" kl_include_all_but) + insertFunction "shen.synonyms-help" (wrapNamed "shen.synonyms-help" kl_shen_synonyms_help) + insertFunction "shen.pushnew" (wrapNamed "shen.pushnew" kl_shen_pushnew) + insertFunction "shen.demod-rule" (wrapNamed "shen.demod-rule" kl_shen_demod_rule) + insertFunction "shen.lambda-of-defun" (wrapNamed "shen.lambda-of-defun" kl_shen_lambda_of_defun) + insertFunction "shen.update-demodulation-function" (wrapNamed "shen.update-demodulation-function" kl_shen_update_demodulation_function) + insertFunction "shen.default-rule" (PL "shen.default-rule" kl_shen_default_rule) + insertFunction "shen.yacc" (wrapNamed "shen.yacc" kl_shen_yacc) + insertFunction "shen.yacc->shen" (wrapNamed "shen.yacc->shen" kl_shen_yacc_RBshen) + insertFunction "shen.kill-code" (wrapNamed "shen.kill-code" kl_shen_kill_code) + insertFunction "kill" (PL "kill" kl_kill) + insertFunction "shen.analyse-kill" (wrapNamed "shen.analyse-kill" kl_shen_analyse_kill) + insertFunction "shen.split_cc_rules" (wrapNamed "shen.split_cc_rules" kl_shen_split_cc_rules) + insertFunction "shen.split_cc_rule" (wrapNamed "shen.split_cc_rule" kl_shen_split_cc_rule) + insertFunction "shen.semantic-completion-warning" (wrapNamed "shen.semantic-completion-warning" kl_shen_semantic_completion_warning) + insertFunction "shen.default_semantics" (wrapNamed "shen.default_semantics" kl_shen_default_semantics) + insertFunction "shen.grammar_symbol?" (wrapNamed "shen.grammar_symbol?" kl_shen_grammar_symbolP) + insertFunction "shen.yacc_cases" (wrapNamed "shen.yacc_cases" kl_shen_yacc_cases) + insertFunction "shen.cc_body" (wrapNamed "shen.cc_body" kl_shen_cc_body) + insertFunction "shen.syntax" (wrapNamed "shen.syntax" kl_shen_syntax) + insertFunction "shen.list-stream" (wrapNamed "shen.list-stream" kl_shen_list_stream) + insertFunction "shen.decons" (wrapNamed "shen.decons" kl_shen_decons) + insertFunction "shen.insert-runon" (wrapNamed "shen.insert-runon" kl_shen_insert_runon) + insertFunction "shen.strip-pathname" (wrapNamed "shen.strip-pathname" kl_shen_strip_pathname) + insertFunction "shen.recursive_descent" (wrapNamed "shen.recursive_descent" kl_shen_recursive_descent) + insertFunction "shen.variable-match" (wrapNamed "shen.variable-match" kl_shen_variable_match) + insertFunction "shen.terminal?" (wrapNamed "shen.terminal?" kl_shen_terminalP) + insertFunction "shen.jump_stream?" (wrapNamed "shen.jump_stream?" kl_shen_jump_streamP) + insertFunction "shen.check_stream" (wrapNamed "shen.check_stream" kl_shen_check_stream) + insertFunction "shen.jump_stream" (wrapNamed "shen.jump_stream" kl_shen_jump_stream) + insertFunction "shen.semantics" (wrapNamed "shen.semantics" kl_shen_semantics) + insertFunction "shen.snd-or-fail" (wrapNamed "shen.snd-or-fail" kl_shen_snd_or_fail) + insertFunction "fail" (PL "fail" kl_fail) + insertFunction "shen.pair" (wrapNamed "shen.pair" kl_shen_pair) + insertFunction "shen.hdtl" (wrapNamed "shen.hdtl" kl_shen_hdtl) + insertFunction "" (wrapNamed "" kl_LBExclRB) + insertFunction "" (wrapNamed "" kl_LBeRB) + insertFunction "read-char-code" (wrapNamed "read-char-code" kl_read_char_code) + insertFunction "read-file-as-bytelist" (wrapNamed "read-file-as-bytelist" kl_read_file_as_bytelist) + insertFunction "read-file-as-charlist" (wrapNamed "read-file-as-charlist" kl_read_file_as_charlist) + insertFunction "shen.read-file-as-Xlist" (wrapNamed "shen.read-file-as-Xlist" kl_shen_read_file_as_Xlist) + insertFunction "shen.read-file-as-Xlist-help" (wrapNamed "shen.read-file-as-Xlist-help" kl_shen_read_file_as_Xlist_help) + insertFunction "read-file-as-string" (wrapNamed "read-file-as-string" kl_read_file_as_string) + insertFunction "shen.rfas-h" (wrapNamed "shen.rfas-h" kl_shen_rfas_h) + insertFunction "input" (wrapNamed "input" kl_input) + insertFunction "input+" (wrapNamed "input+" kl_inputPlus) + insertFunction "shen.monotype" (wrapNamed "shen.monotype" kl_shen_monotype) + insertFunction "read" (wrapNamed "read" kl_read) + insertFunction "it" (PL "it" kl_it) + insertFunction "shen.read-loop" (wrapNamed "shen.read-loop" kl_shen_read_loop) + insertFunction "shen.terminator?" (wrapNamed "shen.terminator?" kl_shen_terminatorP) + insertFunction "lineread" (wrapNamed "lineread" kl_lineread) + insertFunction "shen.lineread-loop" (wrapNamed "shen.lineread-loop" kl_shen_lineread_loop) + insertFunction "shen.record-it" (wrapNamed "shen.record-it" kl_shen_record_it) + insertFunction "shen.trim-whitespace" (wrapNamed "shen.trim-whitespace" kl_shen_trim_whitespace) + insertFunction "shen.record-it-h" (wrapNamed "shen.record-it-h" kl_shen_record_it_h) + insertFunction "shen.cn-all" (wrapNamed "shen.cn-all" kl_shen_cn_all) + insertFunction "read-file" (wrapNamed "read-file" kl_read_file) + insertFunction "read-from-string" (wrapNamed "read-from-string" kl_read_from_string) + insertFunction "shen.read-error" (wrapNamed "shen.read-error" kl_shen_read_error) + insertFunction "shen.compress-50" (wrapNamed "shen.compress-50" kl_shen_compress_50) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBst_inputRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBlsbRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBrsbRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBlcurlyRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBrcurlyRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBbarRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBsemicolonRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBcolonRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBcommaRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBequalRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBminusRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBlrbRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBrrbRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBatomRB) + insertFunction "shen.control-chars" (wrapNamed "shen.control-chars" kl_shen_control_chars) + insertFunction "shen.code-point" (wrapNamed "shen.code-point" kl_shen_code_point) + insertFunction "shen.after-codepoint" (wrapNamed "shen.after-codepoint" kl_shen_after_codepoint) + insertFunction "shen.decimalise" (wrapNamed "shen.decimalise" kl_shen_decimalise) + insertFunction "shen.digits->integers" (wrapNamed "shen.digits->integers" kl_shen_digits_RBintegers) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBsymRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBalphanumsRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBalphanumRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBnumRB) + insertFunction "shen.numbyte?" (wrapNamed "shen.numbyte?" kl_shen_numbyteP) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBalphaRB) + insertFunction "shen.symbol-code?" (wrapNamed "shen.symbol-code?" kl_shen_symbol_codeP) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBstrRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBdbqRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBstrcontentsRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBbyteRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBstrcRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBnumberRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBERB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBlog10RB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBplusRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBstopRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBpredigitsRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBpostdigitsRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBdigitsRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBdigitRB) + insertFunction "shen.byte->digit" (wrapNamed "shen.byte->digit" kl_shen_byte_RBdigit) + insertFunction "shen.pre" (wrapNamed "shen.pre" kl_shen_pre) + insertFunction "shen.post" (wrapNamed "shen.post" kl_shen_post) + insertFunction "shen.expt" (wrapNamed "shen.expt" kl_shen_expt) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBst_input1RB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBst_input2RB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBcommentRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBsinglelineRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBbackslashRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBanysingleRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBnon_returnRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBreturnRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBmultilineRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBtimesRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBanymultiRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBwhitespacesRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBwhitespaceRB) + insertFunction "shen.cons_form" (wrapNamed "shen.cons_form" kl_shen_cons_form) + insertFunction "shen.package-macro" (wrapNamed "shen.package-macro" kl_shen_package_macro) + insertFunction "shen.record-exceptions" (wrapNamed "shen.record-exceptions" kl_shen_record_exceptions) + insertFunction "shen.record-internal" (wrapNamed "shen.record-internal" kl_shen_record_internal) + insertFunction "shen.internal-symbols" (wrapNamed "shen.internal-symbols" kl_shen_internal_symbols) + insertFunction "shen.packageh" (wrapNamed "shen.packageh" kl_shen_packageh) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBdefprologRB) + insertFunction "shen.prolog-error" (wrapNamed "shen.prolog-error" kl_shen_prolog_error) + insertFunction "shen.next-50" (wrapNamed "shen.next-50" kl_shen_next_50) + insertFunction "shen.decons-string" (wrapNamed "shen.decons-string" kl_shen_decons_string) + insertFunction "shen.insert-predicate" (wrapNamed "shen.insert-predicate" kl_shen_insert_predicate) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBpredicateMultRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBclausesMultRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBclauseMultRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBheadMultRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBtermMultRB) + insertFunction "shen.legitimate-term?" (wrapNamed "shen.legitimate-term?" kl_shen_legitimate_termP) + insertFunction "shen.eval-cons" (wrapNamed "shen.eval-cons" kl_shen_eval_cons) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBbodyMultRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBliteralMultRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBendMultRB) + insertFunction "cut" (wrapNamed "cut" kl_cut) + insertFunction "shen.insert_modes" (wrapNamed "shen.insert_modes" kl_shen_insert_modes) + insertFunction "shen.s-prolog" (wrapNamed "shen.s-prolog" kl_shen_s_prolog) + insertFunction "shen.prolog->shen" (wrapNamed "shen.prolog->shen" kl_shen_prolog_RBshen) + insertFunction "shen.s-prolog_clause" (wrapNamed "shen.s-prolog_clause" kl_shen_s_prolog_clause) + insertFunction "shen.head_abstraction" (wrapNamed "shen.head_abstraction" kl_shen_head_abstraction) + insertFunction "shen.complexity_head" (wrapNamed "shen.complexity_head" kl_shen_complexity_head) + insertFunction "shen.complexity" (wrapNamed "shen.complexity" kl_shen_complexity) + insertFunction "shen.product" (wrapNamed "shen.product" kl_shen_product) + insertFunction "shen.s-prolog_literal" (wrapNamed "shen.s-prolog_literal" kl_shen_s_prolog_literal) + insertFunction "shen.insert_deref" (wrapNamed "shen.insert_deref" kl_shen_insert_deref) + insertFunction "shen.insert_lazyderef" (wrapNamed "shen.insert_lazyderef" kl_shen_insert_lazyderef) + insertFunction "shen.group_clauses" (wrapNamed "shen.group_clauses" kl_shen_group_clauses) + insertFunction "shen.collect" (wrapNamed "shen.collect" kl_shen_collect) + insertFunction "shen.same_predicate?" (wrapNamed "shen.same_predicate?" kl_shen_same_predicateP) + insertFunction "shen.compile_prolog_procedure" (wrapNamed "shen.compile_prolog_procedure" kl_shen_compile_prolog_procedure) + insertFunction "shen.procedure_name" (wrapNamed "shen.procedure_name" kl_shen_procedure_name) + insertFunction "shen.clauses-to-shen" (wrapNamed "shen.clauses-to-shen" kl_shen_clauses_to_shen) + insertFunction "shen.catch-cut" (wrapNamed "shen.catch-cut" kl_shen_catch_cut) + insertFunction "shen.catchpoint" (PL "shen.catchpoint" kl_shen_catchpoint) + insertFunction "shen.cutpoint" (wrapNamed "shen.cutpoint" kl_shen_cutpoint) + insertFunction "shen.nest-disjunct" (wrapNamed "shen.nest-disjunct" kl_shen_nest_disjunct) + insertFunction "shen.lisp-or" (wrapNamed "shen.lisp-or" kl_shen_lisp_or) + insertFunction "shen.prolog-aritycheck" (wrapNamed "shen.prolog-aritycheck" kl_shen_prolog_aritycheck) + insertFunction "shen.linearise-clause" (wrapNamed "shen.linearise-clause" kl_shen_linearise_clause) + insertFunction "shen.clause_form" (wrapNamed "shen.clause_form" kl_shen_clause_form) + insertFunction "shen.explicit_modes" (wrapNamed "shen.explicit_modes" kl_shen_explicit_modes) + insertFunction "shen.em_help" (wrapNamed "shen.em_help" kl_shen_em_help) + insertFunction "shen.cf_help" (wrapNamed "shen.cf_help" kl_shen_cf_help) + insertFunction "occurs-check" (wrapNamed "occurs-check" kl_occurs_check) + insertFunction "shen.aum" (wrapNamed "shen.aum" kl_shen_aum) + insertFunction "shen.continuation_call" (wrapNamed "shen.continuation_call" kl_shen_continuation_call) + insertFunction "remove" (wrapNamed "remove" kl_remove) + insertFunction "shen.remove-h" (wrapNamed "shen.remove-h" kl_shen_remove_h) + insertFunction "shen.cc_help" (wrapNamed "shen.cc_help" kl_shen_cc_help) + insertFunction "shen.make_mu_application" (wrapNamed "shen.make_mu_application" kl_shen_make_mu_application) + insertFunction "shen.mu_reduction" (wrapNamed "shen.mu_reduction" kl_shen_mu_reduction) + insertFunction "shen.rcons_form" (wrapNamed "shen.rcons_form" kl_shen_rcons_form) + insertFunction "shen.remove_modes" (wrapNamed "shen.remove_modes" kl_shen_remove_modes) + insertFunction "shen.ephemeral_variable?" (wrapNamed "shen.ephemeral_variable?" kl_shen_ephemeral_variableP) + insertFunction "shen.prolog_constant?" (wrapNamed "shen.prolog_constant?" kl_shen_prolog_constantP) + insertFunction "shen.aum_to_shen" (wrapNamed "shen.aum_to_shen" kl_shen_aum_to_shen) + insertFunction "shen.chwild" (wrapNamed "shen.chwild" kl_shen_chwild) + insertFunction "shen.newpv" (wrapNamed "shen.newpv" kl_shen_newpv) + insertFunction "shen.resizeprocessvector" (wrapNamed "shen.resizeprocessvector" kl_shen_resizeprocessvector) + insertFunction "shen.resize-vector" (wrapNamed "shen.resize-vector" kl_shen_resize_vector) + insertFunction "shen.copy-vector" (wrapNamed "shen.copy-vector" kl_shen_copy_vector) + insertFunction "shen.copy-vector-stage-1" (wrapNamed "shen.copy-vector-stage-1" kl_shen_copy_vector_stage_1) + insertFunction "shen.copy-vector-stage-2" (wrapNamed "shen.copy-vector-stage-2" kl_shen_copy_vector_stage_2) + insertFunction "shen.mk-pvar" (wrapNamed "shen.mk-pvar" kl_shen_mk_pvar) + insertFunction "shen.pvar?" (wrapNamed "shen.pvar?" kl_shen_pvarP) + insertFunction "shen.bindv" (wrapNamed "shen.bindv" kl_shen_bindv) + insertFunction "shen.unbindv" (wrapNamed "shen.unbindv" kl_shen_unbindv) + insertFunction "shen.incinfs" (PL "shen.incinfs" kl_shen_incinfs) + insertFunction "shen.call_the_continuation" (wrapNamed "shen.call_the_continuation" kl_shen_call_the_continuation) + insertFunction "shen.newcontinuation" (wrapNamed "shen.newcontinuation" kl_shen_newcontinuation) + insertFunction "return" (wrapNamed "return" kl_return) + insertFunction "shen.measure&return" (wrapNamed "shen.measure&return" kl_shen_measureAndreturn) + insertFunction "unify" (wrapNamed "unify" kl_unify) + insertFunction "shen.lzy=" (wrapNamed "shen.lzy=" kl_shen_lzyEq) + insertFunction "shen.deref" (wrapNamed "shen.deref" kl_shen_deref) + insertFunction "shen.lazyderef" (wrapNamed "shen.lazyderef" kl_shen_lazyderef) + insertFunction "shen.valvector" (wrapNamed "shen.valvector" kl_shen_valvector) + insertFunction "unify!" (wrapNamed "unify!" kl_unifyExcl) + insertFunction "shen.lzy=!" (wrapNamed "shen.lzy=!" kl_shen_lzyEqExcl) + insertFunction "shen.occurs?" (wrapNamed "shen.occurs?" kl_shen_occursP) + insertFunction "identical" (wrapNamed "identical" kl_identical) + insertFunction "shen.lzy==" (wrapNamed "shen.lzy==" kl_shen_lzyEqEq) + insertFunction "shen.pvar" (wrapNamed "shen.pvar" kl_shen_pvar) + insertFunction "bind" (wrapNamed "bind" kl_bind) + insertFunction "fwhen" (wrapNamed "fwhen" kl_fwhen) + insertFunction "call" (wrapNamed "call" kl_call) + insertFunction "shen.call-help" (wrapNamed "shen.call-help" kl_shen_call_help) + insertFunction "shen.intprolog" (wrapNamed "shen.intprolog" kl_shen_intprolog) + insertFunction "shen.intprolog-help" (wrapNamed "shen.intprolog-help" kl_shen_intprolog_help) + insertFunction "shen.intprolog-help-help" (wrapNamed "shen.intprolog-help-help" kl_shen_intprolog_help_help) + insertFunction "shen.call-rest" (wrapNamed "shen.call-rest" kl_shen_call_rest) + insertFunction "shen.start-new-prolog-process" (PL "shen.start-new-prolog-process" kl_shen_start_new_prolog_process) + insertFunction "shen.insert-prolog-variables" (wrapNamed "shen.insert-prolog-variables" kl_shen_insert_prolog_variables) + insertFunction "shen.insert-prolog-variables-help" (wrapNamed "shen.insert-prolog-variables-help" kl_shen_insert_prolog_variables_help) + insertFunction "shen.initialise-prolog" (wrapNamed "shen.initialise-prolog" kl_shen_initialise_prolog) + insertFunction "shen.f_error" (wrapNamed "shen.f_error" kl_shen_f_error) + insertFunction "shen.tracked?" (wrapNamed "shen.tracked?" kl_shen_trackedP) + insertFunction "track" (wrapNamed "track" kl_track) + insertFunction "shen.track-function" (wrapNamed "shen.track-function" kl_shen_track_function) + insertFunction "shen.insert-tracking-code" (wrapNamed "shen.insert-tracking-code" kl_shen_insert_tracking_code) + insertFunction "step" (wrapNamed "step" kl_step) + insertFunction "spy" (wrapNamed "spy" kl_spy) + insertFunction "shen.terpri-or-read-char" (PL "shen.terpri-or-read-char" kl_shen_terpri_or_read_char) + insertFunction "shen.check-byte" (wrapNamed "shen.check-byte" kl_shen_check_byte) + insertFunction "shen.input-track" (wrapNamed "shen.input-track" kl_shen_input_track) + insertFunction "shen.recursively-print" (wrapNamed "shen.recursively-print" kl_shen_recursively_print) + insertFunction "shen.spaces" (wrapNamed "shen.spaces" kl_shen_spaces) + insertFunction "shen.output-track" (wrapNamed "shen.output-track" kl_shen_output_track) + insertFunction "untrack" (wrapNamed "untrack" kl_untrack) + insertFunction "profile" (wrapNamed "profile" kl_profile) + insertFunction "shen.profile-help" (wrapNamed "shen.profile-help" kl_shen_profile_help) + insertFunction "unprofile" (wrapNamed "unprofile" kl_unprofile) + insertFunction "shen.profile-func" (wrapNamed "shen.profile-func" kl_shen_profile_func) + insertFunction "profile-results" (wrapNamed "profile-results" kl_profile_results) + insertFunction "shen.get-profile" (wrapNamed "shen.get-profile" kl_shen_get_profile) + insertFunction "shen.put-profile" (wrapNamed "shen.put-profile" kl_shen_put_profile) + insertFunction "load" (wrapNamed "load" kl_load) + insertFunction "shen.load-help" (wrapNamed "shen.load-help" kl_shen_load_help) + insertFunction "shen.remove-synonyms" (wrapNamed "shen.remove-synonyms" kl_shen_remove_synonyms) + insertFunction "shen.typecheck-and-load" (wrapNamed "shen.typecheck-and-load" kl_shen_typecheck_and_load) + insertFunction "shen.typetable" (wrapNamed "shen.typetable" kl_shen_typetable) + insertFunction "shen.assumetype" (wrapNamed "shen.assumetype" kl_shen_assumetype) + insertFunction "shen.unwind-types" (wrapNamed "shen.unwind-types" kl_shen_unwind_types) + insertFunction "shen.remtype" (wrapNamed "shen.remtype" kl_shen_remtype) + insertFunction "shen.removetype" (wrapNamed "shen.removetype" kl_shen_removetype) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBsigPlusrestRB) + insertFunction "write-to-file" (wrapNamed "write-to-file" kl_write_to_file) + insertFunction "pr" (wrapNamed "pr" kl_pr) + insertFunction "shen.prh" (wrapNamed "shen.prh" kl_shen_prh) + insertFunction "shen.write-char-and-inc" (wrapNamed "shen.write-char-and-inc" kl_shen_write_char_and_inc) + insertFunction "print" (wrapNamed "print" kl_print) + insertFunction "shen.prhush" (wrapNamed "shen.prhush" kl_shen_prhush) + insertFunction "shen.mkstr" (wrapNamed "shen.mkstr" kl_shen_mkstr) + insertFunction "shen.mkstr-l" (wrapNamed "shen.mkstr-l" kl_shen_mkstr_l) + insertFunction "shen.insert-l" (wrapNamed "shen.insert-l" kl_shen_insert_l) + insertFunction "shen.factor-cn" (wrapNamed "shen.factor-cn" kl_shen_factor_cn) + insertFunction "shen.proc-nl" (wrapNamed "shen.proc-nl" kl_shen_proc_nl) + insertFunction "shen.mkstr-r" (wrapNamed "shen.mkstr-r" kl_shen_mkstr_r) + insertFunction "shen.insert" (wrapNamed "shen.insert" kl_shen_insert) + insertFunction "shen.insert-h" (wrapNamed "shen.insert-h" kl_shen_insert_h) + insertFunction "shen.app" (wrapNamed "shen.app" kl_shen_app) + insertFunction "shen.arg->str" (wrapNamed "shen.arg->str" kl_shen_arg_RBstr) + insertFunction "shen.list->str" (wrapNamed "shen.list->str" kl_shen_list_RBstr) + insertFunction "shen.maxseq" (PL "shen.maxseq" kl_shen_maxseq) + insertFunction "shen.iter-list" (wrapNamed "shen.iter-list" kl_shen_iter_list) + insertFunction "shen.str->str" (wrapNamed "shen.str->str" kl_shen_str_RBstr) + insertFunction "shen.vector->str" (wrapNamed "shen.vector->str" kl_shen_vector_RBstr) + insertFunction "shen.print-vector?" (wrapNamed "shen.print-vector?" kl_shen_print_vectorP) + insertFunction "shen.fbound?" (wrapNamed "shen.fbound?" kl_shen_fboundP) + insertFunction "shen.tuple" (wrapNamed "shen.tuple" kl_shen_tuple) + insertFunction "shen.dictionary" (wrapNamed "shen.dictionary" kl_shen_dictionary) + insertFunction "shen.iter-vector" (wrapNamed "shen.iter-vector" kl_shen_iter_vector) + insertFunction "shen.atom->str" (wrapNamed "shen.atom->str" kl_shen_atom_RBstr) + insertFunction "shen.funexstring" (PL "shen.funexstring" kl_shen_funexstring) + insertFunction "shen.list?" (wrapNamed "shen.list?" kl_shen_listP) + insertFunction "macroexpand" (wrapNamed "macroexpand" kl_macroexpand) + insertFunction "shen.error-macro" (wrapNamed "shen.error-macro" kl_shen_error_macro) + insertFunction "shen.output-macro" (wrapNamed "shen.output-macro" kl_shen_output_macro) + insertFunction "shen.make-string-macro" (wrapNamed "shen.make-string-macro" kl_shen_make_string_macro) + insertFunction "shen.input-macro" (wrapNamed "shen.input-macro" kl_shen_input_macro) + insertFunction "shen.compose" (wrapNamed "shen.compose" kl_shen_compose) + insertFunction "shen.compile-macro" (wrapNamed "shen.compile-macro" kl_shen_compile_macro) + insertFunction "shen.prolog-macro" (wrapNamed "shen.prolog-macro" kl_shen_prolog_macro) + insertFunction "shen.receive-terms" (wrapNamed "shen.receive-terms" kl_shen_receive_terms) + insertFunction "shen.pass-literals" (wrapNamed "shen.pass-literals" kl_shen_pass_literals) + insertFunction "shen.defprolog-macro" (wrapNamed "shen.defprolog-macro" kl_shen_defprolog_macro) + insertFunction "shen.datatype-macro" (wrapNamed "shen.datatype-macro" kl_shen_datatype_macro) + insertFunction "shen.intern-type" (wrapNamed "shen.intern-type" kl_shen_intern_type) + insertFunction "shen.@s-macro" (wrapNamed "shen.@s-macro" kl_shen_Ats_macro) + insertFunction "shen.synonyms-macro" (wrapNamed "shen.synonyms-macro" kl_shen_synonyms_macro) + insertFunction "shen.curry-synonyms" (wrapNamed "shen.curry-synonyms" kl_shen_curry_synonyms) + insertFunction "shen.nl-macro" (wrapNamed "shen.nl-macro" kl_shen_nl_macro) + insertFunction "shen.assoc-macro" (wrapNamed "shen.assoc-macro" kl_shen_assoc_macro) + insertFunction "shen.let-macro" (wrapNamed "shen.let-macro" kl_shen_let_macro) + insertFunction "shen.abs-macro" (wrapNamed "shen.abs-macro" kl_shen_abs_macro) + insertFunction "shen.cases-macro" (wrapNamed "shen.cases-macro" kl_shen_cases_macro) + insertFunction "shen.timer-macro" (wrapNamed "shen.timer-macro" kl_shen_timer_macro) + insertFunction "shen.tuple-up" (wrapNamed "shen.tuple-up" kl_shen_tuple_up) + insertFunction "shen.put/get-macro" (wrapNamed "shen.put/get-macro" kl_shen_putDivget_macro) + insertFunction "shen.function-macro" (wrapNamed "shen.function-macro" kl_shen_function_macro) + insertFunction "shen.function-abstraction" (wrapNamed "shen.function-abstraction" kl_shen_function_abstraction) + insertFunction "shen.function-abstraction-help" (wrapNamed "shen.function-abstraction-help" kl_shen_function_abstraction_help) + insertFunction "undefmacro" (wrapNamed "undefmacro" kl_undefmacro) + insertFunction "shen.findpos" (wrapNamed "shen.findpos" kl_shen_findpos) + insertFunction "shen.remove-nth" (wrapNamed "shen.remove-nth" kl_shen_remove_nth) + insertFunction "shen.initialise_arity_table" (wrapNamed "shen.initialise_arity_table" kl_shen_initialise_arity_table) + insertFunction "arity" (wrapNamed "arity" kl_arity) + insertFunction "systemf" (wrapNamed "systemf" kl_systemf) + insertFunction "adjoin" (wrapNamed "adjoin" kl_adjoin) + insertFunction "shen.lambda-form-entry" (wrapNamed "shen.lambda-form-entry" kl_shen_lambda_form_entry) + insertFunction "shen.lambda-form" (wrapNamed "shen.lambda-form" kl_shen_lambda_form) + insertFunction "shen.add-end" (wrapNamed "shen.add-end" kl_shen_add_end) + insertFunction "shen.set-lambda-form-entry" (wrapNamed "shen.set-lambda-form-entry" kl_shen_set_lambda_form_entry) + insertFunction "specialise" (wrapNamed "specialise" kl_specialise) + insertFunction "unspecialise" (wrapNamed "unspecialise" kl_unspecialise) + insertFunction "declare" (wrapNamed "declare" kl_declare) + insertFunction "shen.demodulate" (wrapNamed "shen.demodulate" kl_shen_demodulate) + insertFunction "shen.variancy-test" (wrapNamed "shen.variancy-test" kl_shen_variancy_test) + insertFunction "shen.variant?" (wrapNamed "shen.variant?" kl_shen_variantP) + insertFunction "shen.typecheck" (wrapNamed "shen.typecheck" kl_shen_typecheck) + insertFunction "shen.curry" (wrapNamed "shen.curry" kl_shen_curry) + insertFunction "shen.special?" (wrapNamed "shen.special?" kl_shen_specialP) + insertFunction "shen.extraspecial?" (wrapNamed "shen.extraspecial?" kl_shen_extraspecialP) + insertFunction "shen.t*" (wrapNamed "shen.t*" kl_shen_tMult) + insertFunction "shen.type-theory-enabled?" (PL "shen.type-theory-enabled?" kl_shen_type_theory_enabledP) + insertFunction "enable-type-theory" (wrapNamed "enable-type-theory" kl_enable_type_theory) + insertFunction "shen.prolog-failure" (wrapNamed "shen.prolog-failure" kl_shen_prolog_failure) + insertFunction "shen.maxinfexceeded?" (PL "shen.maxinfexceeded?" kl_shen_maxinfexceededP) + insertFunction "shen.errormaxinfs" (PL "shen.errormaxinfs" kl_shen_errormaxinfs) + insertFunction "shen.udefs*" (wrapNamed "shen.udefs*" kl_shen_udefsMult) + insertFunction "shen.th*" (wrapNamed "shen.th*" kl_shen_thMult) + insertFunction "shen.t*-hyps" (wrapNamed "shen.t*-hyps" kl_shen_tMult_hyps) + insertFunction "shen.show" (wrapNamed "shen.show" kl_shen_show) + insertFunction "shen.line" (PL "shen.line" kl_shen_line) + insertFunction "shen.show-p" (wrapNamed "shen.show-p" kl_shen_show_p) + insertFunction "shen.show-assumptions" (wrapNamed "shen.show-assumptions" kl_shen_show_assumptions) + insertFunction "shen.pause-for-user" (PL "shen.pause-for-user" kl_shen_pause_for_user) + insertFunction "shen.typedf?" (wrapNamed "shen.typedf?" kl_shen_typedfP) + insertFunction "shen.sigf" (wrapNamed "shen.sigf" kl_shen_sigf) + insertFunction "shen.placeholder" (PL "shen.placeholder" kl_shen_placeholder) + insertFunction "shen.base" (wrapNamed "shen.base" kl_shen_base) + insertFunction "shen.by_hypothesis" (wrapNamed "shen.by_hypothesis" kl_shen_by_hypothesis) + insertFunction "shen.t*-def" (wrapNamed "shen.t*-def" kl_shen_tMult_def) + insertFunction "shen.t*-defh" (wrapNamed "shen.t*-defh" kl_shen_tMult_defh) + insertFunction "shen.t*-defhh" (wrapNamed "shen.t*-defhh" kl_shen_tMult_defhh) + insertFunction "shen.memo" (wrapNamed "shen.memo" kl_shen_memo) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBsigPlusrulesRB) + insertFunction "shen." (wrapNamed "shen." kl_shen_LBnon_ll_rulesRB) + insertFunction "shen.ue" (wrapNamed "shen.ue" kl_shen_ue) + insertFunction "shen.ue-sig" (wrapNamed "shen.ue-sig" kl_shen_ue_sig) + insertFunction "shen.ues" (wrapNamed "shen.ues" kl_shen_ues) + insertFunction "shen.ue?" (wrapNamed "shen.ue?" kl_shen_ueP) + insertFunction "shen.ue-h?" (wrapNamed "shen.ue-h?" kl_shen_ue_hP) + insertFunction "shen.t*-rules" (wrapNamed "shen.t*-rules" kl_shen_tMult_rules) + insertFunction "shen.t*-rule" (wrapNamed "shen.t*-rule" kl_shen_tMult_rule) + insertFunction "shen.placeholders" (wrapNamed "shen.placeholders" kl_shen_placeholders) + insertFunction "shen.newhyps" (wrapNamed "shen.newhyps" kl_shen_newhyps) + insertFunction "shen.patthyps" (wrapNamed "shen.patthyps" kl_shen_patthyps) + insertFunction "shen.result-type" (wrapNamed "shen.result-type" kl_shen_result_type) + insertFunction "shen.t*-patterns" (wrapNamed "shen.t*-patterns" kl_shen_tMult_patterns) + insertFunction "shen.t*-action" (wrapNamed "shen.t*-action" kl_shen_tMult_action) + insertFunction "findall" (wrapNamed "findall" kl_findall) + insertFunction "shen.findallhelp" (wrapNamed "shen.findallhelp" kl_shen_findallhelp) + insertFunction "shen.remember" (wrapNamed "shen.remember" kl_shen_remember) diff --git a/Shentong/Backend/Load.hs b/Shentong/Backend/Load.hs --- a/Shentong/Backend/Load.hs +++ b/Shentong/Backend/Load.hs @@ -1,235 +1,276 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} - -module Backend.Load where - -import Control.Monad.Except -import Control.Parallel -import Environment -import Primitives as Primitives -import Backend.Utils -import Types -import Utils -import Wrap -import Backend.Toplevel -import Backend.Core -import Backend.Sys -import Backend.Sequent -import Backend.Yacc -import Backend.Reader -import Backend.Prolog -import Backend.Track - -kl_load :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_load (!kl_V1480) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Load) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Infs) -> do return (Types.Atom (Types.UnboundSym "loaded"))))) - !kl_if_2 <- value (Types.Atom (Types.UnboundSym "shen.*tc*")) - !appl_3 <- case kl_if_2 of - Atom (B (True)) -> do !appl_4 <- kl_inferences - let !aw_5 = Types.Atom (Types.UnboundSym "shen.app") - !appl_6 <- appl_4 `pseq` applyWrapper aw_5 [appl_4, - Types.Atom (Types.Str " inferences\n"), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_7 <- appl_6 `pseq` cn (Types.Atom (Types.Str "\ntypechecked in ")) appl_6 - !appl_8 <- kl_stoutput - let !aw_9 = Types.Atom (Types.UnboundSym "shen.prhush") - appl_7 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_7, - appl_8]) - Atom (B (False)) -> do do return (Types.Atom (Types.UnboundSym "shen.skip")) - _ -> throwError "if: expected boolean" - appl_3 `pseq` applyWrapper appl_1 [appl_3]))) - let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Start) -> do let !appl_11 = ApplC (Func "lambda" (Context (\(!kl_Result) -> do let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_Finish) -> do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_Time) -> do let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_Message) -> do return kl_Result))) - !appl_15 <- kl_Time `pseq` str kl_Time - !appl_16 <- appl_15 `pseq` cn appl_15 (Types.Atom (Types.Str " secs\n")) - !appl_17 <- appl_16 `pseq` cn (Types.Atom (Types.Str "\nrun time: ")) appl_16 - !appl_18 <- kl_stoutput - let !aw_19 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_20 <- appl_17 `pseq` (appl_18 `pseq` applyWrapper aw_19 [appl_17, - appl_18]) - appl_20 `pseq` applyWrapper appl_14 [appl_20]))) - !appl_21 <- kl_Finish `pseq` (kl_Start `pseq` Primitives.subtract kl_Finish kl_Start) - appl_21 `pseq` applyWrapper appl_13 [appl_21]))) - !appl_22 <- getTime (Types.Atom (Types.UnboundSym "run")) - appl_22 `pseq` applyWrapper appl_12 [appl_22]))) - !appl_23 <- value (Types.Atom (Types.UnboundSym "shen.*tc*")) - !appl_24 <- kl_V1480 `pseq` kl_read_file kl_V1480 - !appl_25 <- appl_23 `pseq` (appl_24 `pseq` kl_shen_load_help appl_23 appl_24) - appl_25 `pseq` applyWrapper appl_11 [appl_25]))) - !appl_26 <- getTime (Types.Atom (Types.UnboundSym "run")) - !appl_27 <- appl_26 `pseq` applyWrapper appl_10 [appl_26] - appl_27 `pseq` applyWrapper appl_0 [appl_27] - -kl_shen_load_help :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_load_help (!kl_V1487) (!kl_V1488) = do let pat_cond_0 = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_2 <- kl_X `pseq` kl_shen_eval_without_macros kl_X - let !aw_3 = Types.Atom (Types.UnboundSym "shen.app") - !appl_4 <- appl_2 `pseq` applyWrapper aw_3 [appl_2, - Types.Atom (Types.Str "\n"), - Types.Atom (Types.UnboundSym "shen.s")] - !appl_5 <- kl_stoutput - let !aw_6 = Types.Atom (Types.UnboundSym "shen.prhush") - appl_4 `pseq` (appl_5 `pseq` applyWrapper aw_6 [appl_4, - appl_5])))) - appl_1 `pseq` (kl_V1488 `pseq` kl_map appl_1 kl_V1488) - pat_cond_7 = do do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_RemoveSynonyms) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Table) -> do let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Assume) -> do (do let !appl_11 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_typecheck_and_load kl_X))) - appl_11 `pseq` (kl_RemoveSynonyms `pseq` kl_map appl_11 kl_RemoveSynonyms)) `catchError` (\(!kl_E) -> do kl_E `pseq` (kl_Table `pseq` kl_shen_unwind_types (Excep kl_E) kl_Table))))) - let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_assumetype kl_X))) - !appl_13 <- appl_12 `pseq` (kl_Table `pseq` kl_map appl_12 kl_Table) - appl_13 `pseq` applyWrapper appl_10 [appl_13]))) - let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_typetable kl_X))) - !appl_15 <- appl_14 `pseq` (kl_RemoveSynonyms `pseq` kl_mapcan appl_14 kl_RemoveSynonyms) - appl_15 `pseq` applyWrapper appl_9 [appl_15]))) - let !appl_16 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_remove_synonyms kl_X))) - !appl_17 <- appl_16 `pseq` (kl_V1488 `pseq` kl_mapcan appl_16 kl_V1488) - appl_17 `pseq` applyWrapper appl_8 [appl_17] - in case kl_V1487 of - kl_V1487@(Atom (UnboundSym "false")) -> pat_cond_0 - kl_V1487@(Atom (B (False))) -> pat_cond_0 - _ -> pat_cond_7 - -kl_shen_remove_synonyms :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_remove_synonyms (!kl_V1490) = do let pat_cond_0 kl_V1490 kl_V1490t = do !appl_1 <- kl_V1490 `pseq` kl_eval kl_V1490 - appl_1 `pseq` kl_do appl_1 (Types.Atom Types.Nil) - pat_cond_2 = do do kl_V1490 `pseq` klCons kl_V1490 (Types.Atom Types.Nil) - in case kl_V1490 of - !(kl_V1490@(Cons (Atom (UnboundSym "shen.synonyms-help")) - (!kl_V1490t))) -> pat_cond_0 kl_V1490 kl_V1490t - !(kl_V1490@(Cons (ApplC (PL "shen.synonyms-help" - _)) - (!kl_V1490t))) -> pat_cond_0 kl_V1490 kl_V1490t - !(kl_V1490@(Cons (ApplC (Func "shen.synonyms-help" - _)) - (!kl_V1490t))) -> pat_cond_0 kl_V1490 kl_V1490t - _ -> pat_cond_2 - -kl_shen_typecheck_and_load :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_typecheck_and_load (!kl_V1492) = do !appl_0 <- kl_nl (Types.Atom (Types.N (Types.KI 1))) - !appl_1 <- kl_gensym (Types.Atom (Types.UnboundSym "A")) - !appl_2 <- kl_V1492 `pseq` (appl_1 `pseq` kl_shen_typecheck_and_evaluate kl_V1492 appl_1) - appl_0 `pseq` (appl_2 `pseq` kl_do appl_0 appl_2) - -kl_shen_typetable :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_typetable (!kl_V1498) = do let pat_cond_0 kl_V1498 kl_V1498t kl_V1498th kl_V1498tt = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Sig) -> do !appl_2 <- kl_V1498th `pseq` (kl_Sig `pseq` klCons kl_V1498th kl_Sig) - appl_2 `pseq` klCons appl_2 (Types.Atom Types.Nil)))) - let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do kl_Y `pseq` kl_shen_LBsigPlusrestRB kl_Y))) - let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_E) -> do let !aw_5 = Types.Atom (Types.UnboundSym "shen.app") - !appl_6 <- kl_V1498th `pseq` applyWrapper aw_5 [kl_V1498th, - Types.Atom (Types.Str " lacks a proper signature.\n"), - Types.Atom (Types.UnboundSym "shen.a")] - appl_6 `pseq` simpleError appl_6))) - !appl_7 <- appl_3 `pseq` (kl_V1498tt `pseq` (appl_4 `pseq` kl_compile appl_3 kl_V1498tt appl_4)) - appl_7 `pseq` applyWrapper appl_1 [appl_7] - pat_cond_8 = do do return (Types.Atom Types.Nil) - in case kl_V1498 of - !(kl_V1498@(Cons (Atom (UnboundSym "define")) - (!(kl_V1498t@(Cons (!kl_V1498th) - (!kl_V1498tt)))))) -> pat_cond_0 kl_V1498 kl_V1498t kl_V1498th kl_V1498tt - !(kl_V1498@(Cons (ApplC (PL "define" _)) - (!(kl_V1498t@(Cons (!kl_V1498th) - (!kl_V1498tt)))))) -> pat_cond_0 kl_V1498 kl_V1498t kl_V1498th kl_V1498tt - !(kl_V1498@(Cons (ApplC (Func "define" _)) - (!(kl_V1498t@(Cons (!kl_V1498th) - (!kl_V1498tt)))))) -> pat_cond_0 kl_V1498 kl_V1498t kl_V1498th kl_V1498tt - _ -> pat_cond_8 - -kl_shen_assumetype :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_assumetype (!kl_V1500) = do let pat_cond_0 kl_V1500 kl_V1500h kl_V1500t = do let !aw_1 = Types.Atom (Types.UnboundSym "declare") - kl_V1500h `pseq` (kl_V1500t `pseq` applyWrapper aw_1 [kl_V1500h, - kl_V1500t]) - pat_cond_2 = do do kl_shen_f_error (ApplC (wrapNamed "shen.assumetype" kl_shen_assumetype)) - in case kl_V1500 of - !(kl_V1500@(Cons (!kl_V1500h) - (!kl_V1500t))) -> pat_cond_0 kl_V1500 kl_V1500h kl_V1500t - _ -> pat_cond_2 - -kl_shen_unwind_types :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_unwind_types (!kl_V1507) (!kl_V1508) = do let pat_cond_0 = do !appl_1 <- kl_V1507 `pseq` errorToString kl_V1507 - appl_1 `pseq` simpleError appl_1 - pat_cond_2 kl_V1508 kl_V1508h kl_V1508hh kl_V1508ht kl_V1508t = do !appl_3 <- kl_V1508hh `pseq` kl_shen_remtype kl_V1508hh - !appl_4 <- kl_V1507 `pseq` (kl_V1508t `pseq` kl_shen_unwind_types kl_V1507 kl_V1508t) - appl_3 `pseq` (appl_4 `pseq` kl_do appl_3 appl_4) - pat_cond_5 = do do kl_shen_f_error (ApplC (wrapNamed "shen.unwind-types" kl_shen_unwind_types)) - in case kl_V1508 of - kl_V1508@(Atom (Nil)) -> pat_cond_0 - !(kl_V1508@(Cons (!(kl_V1508h@(Cons (!kl_V1508hh) - (!kl_V1508ht)))) - (!kl_V1508t))) -> pat_cond_2 kl_V1508 kl_V1508h kl_V1508hh kl_V1508ht kl_V1508t - _ -> pat_cond_5 - -kl_shen_remtype :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_remtype (!kl_V1510) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*signedfuncs*")) - !appl_1 <- kl_V1510 `pseq` (appl_0 `pseq` kl_shen_removetype kl_V1510 appl_0) - appl_1 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*signedfuncs*")) appl_1 - -kl_shen_removetype :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_removetype (!kl_V1518) (!kl_V1519) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V1519 kl_V1519h kl_V1519hh kl_V1519ht kl_V1519t = do kl_V1519hh `pseq` (kl_V1519t `pseq` kl_shen_removetype kl_V1519hh kl_V1519t) - pat_cond_2 kl_V1519 kl_V1519h kl_V1519t = do !appl_3 <- kl_V1518 `pseq` (kl_V1519t `pseq` kl_shen_removetype kl_V1518 kl_V1519t) - kl_V1519h `pseq` (appl_3 `pseq` klCons kl_V1519h appl_3) - pat_cond_4 = do do kl_shen_f_error (ApplC (wrapNamed "shen.removetype" kl_shen_removetype)) - in case kl_V1519 of - kl_V1519@(Atom (Nil)) -> pat_cond_0 - !(kl_V1519@(Cons (!(kl_V1519h@(Cons (!kl_V1519hh) - (!kl_V1519ht)))) - (!kl_V1519t))) | eqCore kl_V1519hh kl_V1518 -> pat_cond_1 kl_V1519 kl_V1519h kl_V1519hh kl_V1519ht kl_V1519t - !(kl_V1519@(Cons (!kl_V1519h) - (!kl_V1519t))) -> pat_cond_2 kl_V1519 kl_V1519h kl_V1519t - _ -> pat_cond_4 - -kl_shen_LBsigPlusrestRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBsigPlusrestRB (!kl_V1521) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsignatureRB) -> do !appl_1 <- kl_fail - !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBsignatureRB `pseq` eq appl_1 kl_Parse_shen_LBsignatureRB) - !kl_if_3 <- appl_2 `pseq` kl_not appl_2 - case kl_if_3 of - Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBExclRB) -> do !appl_5 <- kl_fail - !appl_6 <- appl_5 `pseq` (kl_Parse_shen_LBExclRB `pseq` eq appl_5 kl_Parse_shen_LBExclRB) - !kl_if_7 <- appl_6 `pseq` kl_not appl_6 - case kl_if_7 of - Atom (B (True)) -> do !appl_8 <- kl_Parse_shen_LBExclRB `pseq` hd kl_Parse_shen_LBExclRB - !appl_9 <- kl_Parse_shen_LBsignatureRB `pseq` kl_shen_hdtl kl_Parse_shen_LBsignatureRB - appl_8 `pseq` (appl_9 `pseq` kl_shen_pair appl_8 appl_9) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_10 <- kl_Parse_shen_LBsignatureRB `pseq` kl_shen_LBExclRB kl_Parse_shen_LBsignatureRB - appl_10 `pseq` applyWrapper appl_4 [appl_10] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_11 <- kl_V1521 `pseq` kl_shen_LBsignatureRB kl_V1521 - appl_11 `pseq` applyWrapper appl_0 [appl_11] - -kl_write_to_file :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_write_to_file (!kl_V1524) (!kl_V1525) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Stream) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_String) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Write) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Close) -> do return kl_V1525))) - !appl_4 <- kl_Stream `pseq` closeStream kl_Stream - appl_4 `pseq` applyWrapper appl_3 [appl_4]))) - let !aw_5 = Types.Atom (Types.UnboundSym "pr") - !appl_6 <- kl_String `pseq` (kl_Stream `pseq` applyWrapper aw_5 [kl_String, - kl_Stream]) - appl_6 `pseq` applyWrapper appl_2 [appl_6]))) - !kl_if_7 <- kl_V1525 `pseq` stringP kl_V1525 - !appl_8 <- case kl_if_7 of - Atom (B (True)) -> do let !aw_9 = Types.Atom (Types.UnboundSym "shen.app") - kl_V1525 `pseq` applyWrapper aw_9 [kl_V1525, - Types.Atom (Types.Str "\n\n"), - Types.Atom (Types.UnboundSym "shen.a")] - Atom (B (False)) -> do do let !aw_10 = Types.Atom (Types.UnboundSym "shen.app") - kl_V1525 `pseq` applyWrapper aw_10 [kl_V1525, - Types.Atom (Types.Str "\n\n"), - Types.Atom (Types.UnboundSym "shen.s")] - _ -> throwError "if: expected boolean" - appl_8 `pseq` applyWrapper appl_1 [appl_8]))) - !appl_11 <- kl_V1524 `pseq` openStream kl_V1524 (Types.Atom (Types.UnboundSym "out")) - appl_11 `pseq` applyWrapper appl_0 [appl_11] - -expr8 :: Types.KLContext Types.Env Types.KLValue -expr8 = 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"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Load where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel +import Backend.Core +import Backend.Sys +import Backend.Sequent +import Backend.Yacc +import Backend.Reader +import Backend.Prolog +import Backend.Track + +{- +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_load :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_load (!kl_V1482) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Load) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Infs) -> do return (Core.Types.Atom (Core.Types.UnboundSym "loaded"))))) + !kl_if_2 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*tc*")) + !appl_3 <- case kl_if_2 of + Atom (B (True)) -> do !appl_4 <- kl_inferences + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_6 <- appl_4 `pseq` applyWrapper aw_5 [appl_4, + Core.Types.Atom (Core.Types.Str " inferences\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_7 <- appl_6 `pseq` cn (Core.Types.Atom (Core.Types.Str "\ntypechecked in ")) appl_6 + !appl_8 <- kl_stoutput + let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + appl_7 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_7, + appl_8]) + Atom (B (False)) -> do do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + _ -> throwError "if: expected boolean" + appl_3 `pseq` applyWrapper appl_1 [appl_3]))) + let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Start) -> do let !appl_11 = ApplC (Func "lambda" (Context (\(!kl_Result) -> do let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_Finish) -> do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_Time) -> do let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_Message) -> do return kl_Result))) + !appl_15 <- kl_Time `pseq` str kl_Time + !appl_16 <- appl_15 `pseq` cn appl_15 (Core.Types.Atom (Core.Types.Str " secs\n")) + !appl_17 <- appl_16 `pseq` cn (Core.Types.Atom (Core.Types.Str "\nrun time: ")) appl_16 + !appl_18 <- kl_stoutput + let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_20 <- appl_17 `pseq` (appl_18 `pseq` applyWrapper aw_19 [appl_17, + appl_18]) + appl_20 `pseq` applyWrapper appl_14 [appl_20]))) + !appl_21 <- kl_Finish `pseq` (kl_Start `pseq` Primitives.subtract kl_Finish kl_Start) + appl_21 `pseq` applyWrapper appl_13 [appl_21]))) + !appl_22 <- getTime (Core.Types.Atom (Core.Types.UnboundSym "run")) + appl_22 `pseq` applyWrapper appl_12 [appl_22]))) + !appl_23 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*tc*")) + !appl_24 <- kl_V1482 `pseq` kl_read_file kl_V1482 + !appl_25 <- appl_23 `pseq` (appl_24 `pseq` kl_shen_load_help appl_23 appl_24) + appl_25 `pseq` applyWrapper appl_11 [appl_25]))) + !appl_26 <- getTime (Core.Types.Atom (Core.Types.UnboundSym "run")) + !appl_27 <- appl_26 `pseq` applyWrapper appl_10 [appl_26] + appl_27 `pseq` applyWrapper appl_0 [appl_27] + +kl_shen_load_help :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_load_help (!kl_V1489) (!kl_V1490) = do let pat_cond_0 = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_2 <- kl_X `pseq` kl_shen_eval_without_macros kl_X + let !aw_3 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_4 <- appl_2 `pseq` applyWrapper aw_3 [appl_2, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.s")] + !appl_5 <- kl_stoutput + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + appl_4 `pseq` (appl_5 `pseq` applyWrapper aw_6 [appl_4, + appl_5])))) + appl_1 `pseq` (kl_V1490 `pseq` kl_for_each appl_1 kl_V1490) + pat_cond_7 = do do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_RemoveSynonyms) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Table) -> do let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Assume) -> do (do let !appl_11 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_typecheck_and_load kl_X))) + appl_11 `pseq` (kl_RemoveSynonyms `pseq` kl_for_each appl_11 kl_RemoveSynonyms)) `catchError` (\(!kl_E) -> do kl_E `pseq` (kl_Table `pseq` kl_shen_unwind_types (Excep kl_E) kl_Table))))) + let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_assumetype kl_X))) + !appl_13 <- appl_12 `pseq` (kl_Table `pseq` kl_for_each appl_12 kl_Table) + appl_13 `pseq` applyWrapper appl_10 [appl_13]))) + let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_typetable kl_X))) + !appl_15 <- appl_14 `pseq` (kl_RemoveSynonyms `pseq` kl_mapcan appl_14 kl_RemoveSynonyms) + appl_15 `pseq` applyWrapper appl_9 [appl_15]))) + let !appl_16 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_remove_synonyms kl_X))) + !appl_17 <- appl_16 `pseq` (kl_V1490 `pseq` kl_mapcan appl_16 kl_V1490) + appl_17 `pseq` applyWrapper appl_8 [appl_17] + in case kl_V1489 of + kl_V1489@(Atom (UnboundSym "false")) -> pat_cond_0 + kl_V1489@(Atom (B (False))) -> pat_cond_0 + _ -> pat_cond_7 + +kl_shen_remove_synonyms :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_remove_synonyms (!kl_V1492) = do let pat_cond_0 kl_V1492 kl_V1492t = do !appl_1 <- kl_V1492 `pseq` kl_eval kl_V1492 + let !appl_2 = Atom Nil + appl_1 `pseq` (appl_2 `pseq` kl_do appl_1 appl_2) + pat_cond_3 = do do let !appl_4 = Atom Nil + kl_V1492 `pseq` (appl_4 `pseq` klCons kl_V1492 appl_4) + in case kl_V1492 of + !(kl_V1492@(Cons (Atom (UnboundSym "shen.synonyms-help")) + (!kl_V1492t))) -> pat_cond_0 kl_V1492 kl_V1492t + !(kl_V1492@(Cons (ApplC (PL "shen.synonyms-help" + _)) + (!kl_V1492t))) -> pat_cond_0 kl_V1492 kl_V1492t + !(kl_V1492@(Cons (ApplC (Func "shen.synonyms-help" + _)) + (!kl_V1492t))) -> pat_cond_0 kl_V1492 kl_V1492t + _ -> pat_cond_3 + +kl_shen_typecheck_and_load :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_typecheck_and_load (!kl_V1494) = do !appl_0 <- kl_nl (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_1 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "A")) + !appl_2 <- kl_V1494 `pseq` (appl_1 `pseq` kl_shen_typecheck_and_evaluate kl_V1494 appl_1) + appl_0 `pseq` (appl_2 `pseq` kl_do appl_0 appl_2) + +kl_shen_typetable :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_typetable (!kl_V1500) = do let pat_cond_0 kl_V1500 kl_V1500t kl_V1500th kl_V1500tt = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Sig) -> do !appl_2 <- kl_V1500th `pseq` (kl_Sig `pseq` klCons kl_V1500th kl_Sig) + let !appl_3 = Atom Nil + appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3)))) + let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do kl_Y `pseq` kl_shen_LBsigPlusrestRB kl_Y))) + let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_E) -> do let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_7 <- kl_V1500th `pseq` applyWrapper aw_6 [kl_V1500th, + Core.Types.Atom (Core.Types.Str " lacks a proper signature.\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + appl_7 `pseq` simpleError appl_7))) + !appl_8 <- appl_4 `pseq` (kl_V1500tt `pseq` (appl_5 `pseq` kl_compile appl_4 kl_V1500tt appl_5)) + appl_8 `pseq` applyWrapper appl_1 [appl_8] + pat_cond_9 = do do return (Atom Nil) + in case kl_V1500 of + !(kl_V1500@(Cons (Atom (UnboundSym "define")) + (!(kl_V1500t@(Cons (!kl_V1500th) + (!kl_V1500tt)))))) -> pat_cond_0 kl_V1500 kl_V1500t kl_V1500th kl_V1500tt + !(kl_V1500@(Cons (ApplC (PL "define" _)) + (!(kl_V1500t@(Cons (!kl_V1500th) + (!kl_V1500tt)))))) -> pat_cond_0 kl_V1500 kl_V1500t kl_V1500th kl_V1500tt + !(kl_V1500@(Cons (ApplC (Func "define" _)) + (!(kl_V1500t@(Cons (!kl_V1500th) + (!kl_V1500tt)))))) -> pat_cond_0 kl_V1500 kl_V1500t kl_V1500th kl_V1500tt + _ -> pat_cond_9 + +kl_shen_assumetype :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_assumetype (!kl_V1502) = do let pat_cond_0 kl_V1502 kl_V1502h kl_V1502t = do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "declare") + kl_V1502h `pseq` (kl_V1502t `pseq` applyWrapper aw_1 [kl_V1502h, + kl_V1502t]) + pat_cond_2 = do do kl_shen_f_error (ApplC (wrapNamed "shen.assumetype" kl_shen_assumetype)) + in case kl_V1502 of + !(kl_V1502@(Cons (!kl_V1502h) + (!kl_V1502t))) -> pat_cond_0 kl_V1502 kl_V1502h kl_V1502t + _ -> pat_cond_2 + +kl_shen_unwind_types :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_unwind_types (!kl_V1509) (!kl_V1510) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1510 `pseq` eq appl_0 kl_V1510) + case kl_if_1 of + Atom (B (True)) -> do !appl_2 <- kl_V1509 `pseq` errorToString kl_V1509 + appl_2 `pseq` simpleError appl_2 + Atom (B (False)) -> do let pat_cond_3 kl_V1510 kl_V1510h kl_V1510hh kl_V1510ht kl_V1510t = do !appl_4 <- kl_V1510hh `pseq` kl_shen_remtype kl_V1510hh + !appl_5 <- kl_V1509 `pseq` (kl_V1510t `pseq` kl_shen_unwind_types kl_V1509 kl_V1510t) + appl_4 `pseq` (appl_5 `pseq` kl_do appl_4 appl_5) + pat_cond_6 = do do kl_shen_f_error (ApplC (wrapNamed "shen.unwind-types" kl_shen_unwind_types)) + in case kl_V1510 of + !(kl_V1510@(Cons (!(kl_V1510h@(Cons (!kl_V1510hh) + (!kl_V1510ht)))) + (!kl_V1510t))) -> pat_cond_3 kl_V1510 kl_V1510h kl_V1510hh kl_V1510ht kl_V1510t + _ -> pat_cond_6 + _ -> throwError "if: expected boolean" + +kl_shen_remtype :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_remtype (!kl_V1512) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*signedfuncs*")) + !appl_1 <- kl_V1512 `pseq` (appl_0 `pseq` kl_shen_removetype kl_V1512 appl_0) + appl_1 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*signedfuncs*")) appl_1 + +kl_shen_removetype :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_removetype (!kl_V1520) (!kl_V1521) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1521 `pseq` eq appl_0 kl_V1521) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let pat_cond_2 kl_V1521 kl_V1521h kl_V1521hh kl_V1521ht kl_V1521t = do kl_V1521hh `pseq` (kl_V1521t `pseq` kl_shen_removetype kl_V1521hh kl_V1521t) + pat_cond_3 kl_V1521 kl_V1521h kl_V1521t = do !appl_4 <- kl_V1520 `pseq` (kl_V1521t `pseq` kl_shen_removetype kl_V1520 kl_V1521t) + kl_V1521h `pseq` (appl_4 `pseq` klCons kl_V1521h appl_4) + pat_cond_5 = do do kl_shen_f_error (ApplC (wrapNamed "shen.removetype" kl_shen_removetype)) + in case kl_V1521 of + !(kl_V1521@(Cons (!(kl_V1521h@(Cons (!kl_V1521hh) + (!kl_V1521ht)))) + (!kl_V1521t))) | eqCore kl_V1521hh kl_V1520 -> pat_cond_2 kl_V1521 kl_V1521h kl_V1521hh kl_V1521ht kl_V1521t + !(kl_V1521@(Cons (!kl_V1521h) + (!kl_V1521t))) -> pat_cond_3 kl_V1521 kl_V1521h kl_V1521t + _ -> pat_cond_5 + _ -> throwError "if: expected boolean" + +kl_shen_LBsigPlusrestRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBsigPlusrestRB (!kl_V1523) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsignatureRB) -> do !appl_1 <- kl_fail + !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBsignatureRB `pseq` eq appl_1 kl_Parse_shen_LBsignatureRB) + !kl_if_3 <- appl_2 `pseq` kl_not appl_2 + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBExclRB) -> do !appl_5 <- kl_fail + !appl_6 <- appl_5 `pseq` (kl_Parse_LBExclRB `pseq` eq appl_5 kl_Parse_LBExclRB) + !kl_if_7 <- appl_6 `pseq` kl_not appl_6 + case kl_if_7 of + Atom (B (True)) -> do !appl_8 <- kl_Parse_LBExclRB `pseq` hd kl_Parse_LBExclRB + !appl_9 <- kl_Parse_shen_LBsignatureRB `pseq` kl_shen_hdtl kl_Parse_shen_LBsignatureRB + appl_8 `pseq` (appl_9 `pseq` kl_shen_pair appl_8 appl_9) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_10 <- kl_Parse_shen_LBsignatureRB `pseq` kl_LBExclRB kl_Parse_shen_LBsignatureRB + appl_10 `pseq` applyWrapper appl_4 [appl_10] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_11 <- kl_V1523 `pseq` kl_shen_LBsignatureRB kl_V1523 + appl_11 `pseq` applyWrapper appl_0 [appl_11] + +kl_write_to_file :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_write_to_file (!kl_V1526) (!kl_V1527) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Stream) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_String) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Write) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Close) -> do return kl_V1527))) + !appl_4 <- kl_Stream `pseq` closeStream kl_Stream + appl_4 `pseq` applyWrapper appl_3 [appl_4]))) + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "pr") + !appl_6 <- kl_String `pseq` (kl_Stream `pseq` applyWrapper aw_5 [kl_String, + kl_Stream]) + appl_6 `pseq` applyWrapper appl_2 [appl_6]))) + !kl_if_7 <- kl_V1527 `pseq` stringP kl_V1527 + !appl_8 <- case kl_if_7 of + Atom (B (True)) -> do let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + kl_V1527 `pseq` applyWrapper aw_9 [kl_V1527, + Core.Types.Atom (Core.Types.Str "\n\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + Atom (B (False)) -> do do let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + kl_V1527 `pseq` applyWrapper aw_10 [kl_V1527, + Core.Types.Atom (Core.Types.Str "\n\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.s")] + _ -> throwError "if: expected boolean" + appl_8 `pseq` applyWrapper appl_1 [appl_8]))) + !appl_11 <- kl_V1526 `pseq` openStream kl_V1526 (Core.Types.Atom (Core.Types.UnboundSym "out")) + appl_11 `pseq` applyWrapper appl_0 [appl_11] + +expr8 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr8 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Backend/LoadShen.hs b/Shentong/Backend/LoadShen.hs --- a/Shentong/Backend/LoadShen.hs +++ b/Shentong/Backend/LoadShen.hs @@ -9,10 +9,10 @@ import Control.Monad.Except import Control.Parallel import Environment -import Primitives as Primitives +import Core.Primitives as Primitives import Backend.Utils -import Types as Types -import Utils +import Core.Types as Types +import Core.Utils import Wrap import Backend.Toplevel import Backend.Core diff --git a/Shentong/Backend/Macros.hs b/Shentong/Backend/Macros.hs --- a/Shentong/Backend/Macros.hs +++ b/Shentong/Backend/Macros.hs @@ -1,941 +1,1628 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} - -module Backend.Macros 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 -import Backend.Core -import Backend.Sys -import Backend.Sequent -import Backend.Yacc -import Backend.Reader -import Backend.Prolog -import Backend.Track -import Backend.Load -import Backend.Writer - -{- -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_macroexpand :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_macroexpand (!kl_V1527) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do !kl_if_1 <- kl_V1527 `pseq` (kl_Y `pseq` eq kl_V1527 kl_Y) - case kl_if_1 of - Atom (B (True)) -> do return kl_V1527 - Atom (B (False)) -> do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_macroexpand kl_Z))) - appl_2 `pseq` (kl_Y `pseq` kl_shen_walk appl_2 kl_Y) - _ -> throwError "if: expected boolean"))) - !appl_3 <- value (Types.Atom (Types.UnboundSym "*macros*")) - !appl_4 <- appl_3 `pseq` (kl_V1527 `pseq` kl_shen_compose appl_3 kl_V1527) - appl_4 `pseq` applyWrapper appl_0 [appl_4] - -kl_shen_error_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_error_macro (!kl_V1529) = do let pat_cond_0 kl_V1529 kl_V1529t kl_V1529th kl_V1529tt = do !appl_1 <- kl_V1529th `pseq` (kl_V1529tt `pseq` kl_shen_mkstr kl_V1529th kl_V1529tt) - !appl_2 <- appl_1 `pseq` klCons appl_1 (Types.Atom Types.Nil) - appl_2 `pseq` klCons (ApplC (wrapNamed "simple-error" simpleError)) appl_2 - pat_cond_3 = do do return kl_V1529 - in case kl_V1529 of - !(kl_V1529@(Cons (Atom (UnboundSym "error")) - (!(kl_V1529t@(Cons (!kl_V1529th) - (!kl_V1529tt)))))) -> pat_cond_0 kl_V1529 kl_V1529t kl_V1529th kl_V1529tt - !(kl_V1529@(Cons (ApplC (PL "error" _)) - (!(kl_V1529t@(Cons (!kl_V1529th) - (!kl_V1529tt)))))) -> pat_cond_0 kl_V1529 kl_V1529t kl_V1529th kl_V1529tt - !(kl_V1529@(Cons (ApplC (Func "error" _)) - (!(kl_V1529t@(Cons (!kl_V1529th) - (!kl_V1529tt)))))) -> pat_cond_0 kl_V1529 kl_V1529t kl_V1529th kl_V1529tt - _ -> pat_cond_3 - -kl_shen_output_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_output_macro (!kl_V1531) = do let pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt = do !appl_1 <- kl_V1531th `pseq` (kl_V1531tt `pseq` kl_shen_mkstr kl_V1531th kl_V1531tt) - !appl_2 <- klCons (ApplC (PL "stoutput" kl_stoutput)) (Types.Atom Types.Nil) - !appl_3 <- appl_2 `pseq` klCons appl_2 (Types.Atom Types.Nil) - !appl_4 <- appl_1 `pseq` (appl_3 `pseq` klCons appl_1 appl_3) - appl_4 `pseq` klCons (ApplC (wrapNamed "shen.prhush" kl_shen_prhush)) appl_4 - pat_cond_5 kl_V1531 kl_V1531t kl_V1531th = do !appl_6 <- klCons (ApplC (PL "stoutput" kl_stoutput)) (Types.Atom Types.Nil) - !appl_7 <- appl_6 `pseq` klCons appl_6 (Types.Atom Types.Nil) - !appl_8 <- kl_V1531th `pseq` (appl_7 `pseq` klCons kl_V1531th appl_7) - appl_8 `pseq` klCons (ApplC (wrapNamed "pr" kl_pr)) appl_8 - pat_cond_9 = do do return kl_V1531 - in case kl_V1531 of - !(kl_V1531@(Cons (Atom (UnboundSym "output")) - (!(kl_V1531t@(Cons (!kl_V1531th) - (!kl_V1531tt)))))) -> pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt - !(kl_V1531@(Cons (ApplC (PL "output" _)) - (!(kl_V1531t@(Cons (!kl_V1531th) - (!kl_V1531tt)))))) -> pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt - !(kl_V1531@(Cons (ApplC (Func "output" _)) - (!(kl_V1531t@(Cons (!kl_V1531th) - (!kl_V1531tt)))))) -> pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt - !(kl_V1531@(Cons (Atom (UnboundSym "pr")) - (!(kl_V1531t@(Cons (!kl_V1531th) - (Atom (Nil))))))) -> pat_cond_5 kl_V1531 kl_V1531t kl_V1531th - !(kl_V1531@(Cons (ApplC (PL "pr" _)) - (!(kl_V1531t@(Cons (!kl_V1531th) - (Atom (Nil))))))) -> pat_cond_5 kl_V1531 kl_V1531t kl_V1531th - !(kl_V1531@(Cons (ApplC (Func "pr" _)) - (!(kl_V1531t@(Cons (!kl_V1531th) - (Atom (Nil))))))) -> pat_cond_5 kl_V1531 kl_V1531t kl_V1531th - _ -> pat_cond_9 - -kl_shen_make_string_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_make_string_macro (!kl_V1533) = do let pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt = do kl_V1533th `pseq` (kl_V1533tt `pseq` kl_shen_mkstr kl_V1533th kl_V1533tt) - pat_cond_1 = do do return kl_V1533 - in case kl_V1533 of - !(kl_V1533@(Cons (Atom (UnboundSym "make-string")) - (!(kl_V1533t@(Cons (!kl_V1533th) - (!kl_V1533tt)))))) -> pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt - !(kl_V1533@(Cons (ApplC (PL "make-string" _)) - (!(kl_V1533t@(Cons (!kl_V1533th) - (!kl_V1533tt)))))) -> pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt - !(kl_V1533@(Cons (ApplC (Func "make-string" _)) - (!(kl_V1533t@(Cons (!kl_V1533th) - (!kl_V1533tt)))))) -> pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt - _ -> pat_cond_1 - -kl_shen_input_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_input_macro (!kl_V1535) = do let pat_cond_0 kl_V1535 = do !appl_1 <- klCons (ApplC (PL "stinput" kl_stinput)) (Types.Atom Types.Nil) - !appl_2 <- appl_1 `pseq` klCons appl_1 (Types.Atom Types.Nil) - appl_2 `pseq` klCons (ApplC (wrapNamed "lineread" kl_lineread)) appl_2 - pat_cond_3 kl_V1535 = do !appl_4 <- klCons (ApplC (PL "stinput" kl_stinput)) (Types.Atom Types.Nil) - !appl_5 <- appl_4 `pseq` klCons appl_4 (Types.Atom Types.Nil) - appl_5 `pseq` klCons (ApplC (wrapNamed "input" kl_input)) appl_5 - pat_cond_6 kl_V1535 = do !appl_7 <- klCons (ApplC (PL "stinput" kl_stinput)) (Types.Atom Types.Nil) - !appl_8 <- appl_7 `pseq` klCons appl_7 (Types.Atom Types.Nil) - appl_8 `pseq` klCons (ApplC (wrapNamed "read" kl_read)) appl_8 - pat_cond_9 kl_V1535 kl_V1535t kl_V1535th = do !appl_10 <- klCons (ApplC (PL "stinput" kl_stinput)) (Types.Atom Types.Nil) - !appl_11 <- appl_10 `pseq` klCons appl_10 (Types.Atom Types.Nil) - !appl_12 <- kl_V1535th `pseq` (appl_11 `pseq` klCons kl_V1535th appl_11) - appl_12 `pseq` klCons (ApplC (wrapNamed "input+" kl_inputPlus)) appl_12 - pat_cond_13 kl_V1535 = do !appl_14 <- klCons (ApplC (PL "stinput" kl_stinput)) (Types.Atom Types.Nil) - !appl_15 <- appl_14 `pseq` klCons appl_14 (Types.Atom Types.Nil) - appl_15 `pseq` klCons (ApplC (wrapNamed "read-byte" readByte)) appl_15 - pat_cond_16 = do do return kl_V1535 - in case kl_V1535 of - !(kl_V1535@(Cons (Atom (UnboundSym "lineread")) - (Atom (Nil)))) -> pat_cond_0 kl_V1535 - !(kl_V1535@(Cons (ApplC (PL "lineread" _)) - (Atom (Nil)))) -> pat_cond_0 kl_V1535 - !(kl_V1535@(Cons (ApplC (Func "lineread" _)) - (Atom (Nil)))) -> pat_cond_0 kl_V1535 - !(kl_V1535@(Cons (Atom (UnboundSym "input")) - (Atom (Nil)))) -> pat_cond_3 kl_V1535 - !(kl_V1535@(Cons (ApplC (PL "input" _)) - (Atom (Nil)))) -> pat_cond_3 kl_V1535 - !(kl_V1535@(Cons (ApplC (Func "input" _)) - (Atom (Nil)))) -> pat_cond_3 kl_V1535 - !(kl_V1535@(Cons (Atom (UnboundSym "read")) - (Atom (Nil)))) -> pat_cond_6 kl_V1535 - !(kl_V1535@(Cons (ApplC (PL "read" _)) - (Atom (Nil)))) -> pat_cond_6 kl_V1535 - !(kl_V1535@(Cons (ApplC (Func "read" _)) - (Atom (Nil)))) -> pat_cond_6 kl_V1535 - !(kl_V1535@(Cons (Atom (UnboundSym "input+")) - (!(kl_V1535t@(Cons (!kl_V1535th) - (Atom (Nil))))))) -> pat_cond_9 kl_V1535 kl_V1535t kl_V1535th - !(kl_V1535@(Cons (ApplC (PL "input+" _)) - (!(kl_V1535t@(Cons (!kl_V1535th) - (Atom (Nil))))))) -> pat_cond_9 kl_V1535 kl_V1535t kl_V1535th - !(kl_V1535@(Cons (ApplC (Func "input+" _)) - (!(kl_V1535t@(Cons (!kl_V1535th) - (Atom (Nil))))))) -> pat_cond_9 kl_V1535 kl_V1535t kl_V1535th - !(kl_V1535@(Cons (Atom (UnboundSym "read-byte")) - (Atom (Nil)))) -> pat_cond_13 kl_V1535 - !(kl_V1535@(Cons (ApplC (PL "read-byte" _)) - (Atom (Nil)))) -> pat_cond_13 kl_V1535 - !(kl_V1535@(Cons (ApplC (Func "read-byte" _)) - (Atom (Nil)))) -> pat_cond_13 kl_V1535 - _ -> pat_cond_16 - -kl_shen_compose :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_compose (!kl_V1538) (!kl_V1539) = do let pat_cond_0 = do return kl_V1539 - pat_cond_1 kl_V1538 kl_V1538h kl_V1538t = do !appl_2 <- kl_V1539 `pseq` applyWrapper kl_V1538h [kl_V1539] - kl_V1538t `pseq` (appl_2 `pseq` kl_shen_compose kl_V1538t appl_2) - pat_cond_3 = do do kl_shen_f_error (ApplC (wrapNamed "shen.compose" kl_shen_compose)) - in case kl_V1538 of - kl_V1538@(Atom (Nil)) -> pat_cond_0 - !(kl_V1538@(Cons (!kl_V1538h) - (!kl_V1538t))) -> pat_cond_1 kl_V1538 kl_V1538h kl_V1538t - _ -> pat_cond_3 - -kl_shen_compile_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_compile_macro (!kl_V1541) = do let pat_cond_0 kl_V1541 kl_V1541t kl_V1541th kl_V1541tt kl_V1541tth = do !appl_1 <- klCons (Types.Atom (Types.UnboundSym "E")) (Types.Atom Types.Nil) - !appl_2 <- appl_1 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_1 - !appl_3 <- klCons (Types.Atom (Types.UnboundSym "E")) (Types.Atom Types.Nil) - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.Str "parse error here: ~S~%")) appl_3 - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.UnboundSym "error")) appl_4 - !appl_6 <- klCons (Types.Atom (Types.Str "parse error~%")) (Types.Atom Types.Nil) - !appl_7 <- appl_6 `pseq` klCons (Types.Atom (Types.UnboundSym "error")) appl_6 - !appl_8 <- appl_7 `pseq` klCons appl_7 (Types.Atom Types.Nil) - !appl_9 <- appl_5 `pseq` (appl_8 `pseq` klCons appl_5 appl_8) - !appl_10 <- appl_2 `pseq` (appl_9 `pseq` klCons appl_2 appl_9) - !appl_11 <- appl_10 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_10 - !appl_12 <- appl_11 `pseq` klCons appl_11 (Types.Atom Types.Nil) - !appl_13 <- appl_12 `pseq` klCons (Types.Atom (Types.UnboundSym "E")) appl_12 - !appl_14 <- appl_13 `pseq` klCons (Types.Atom (Types.UnboundSym "lambda")) appl_13 - !appl_15 <- appl_14 `pseq` klCons appl_14 (Types.Atom Types.Nil) - !appl_16 <- kl_V1541tth `pseq` (appl_15 `pseq` klCons kl_V1541tth appl_15) - !appl_17 <- kl_V1541th `pseq` (appl_16 `pseq` klCons kl_V1541th appl_16) - appl_17 `pseq` klCons (ApplC (wrapNamed "compile" kl_compile)) appl_17 - pat_cond_18 = do do return kl_V1541 - in case kl_V1541 of - !(kl_V1541@(Cons (Atom (UnboundSym "compile")) - (!(kl_V1541t@(Cons (!kl_V1541th) - (!(kl_V1541tt@(Cons (!kl_V1541tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V1541 kl_V1541t kl_V1541th kl_V1541tt kl_V1541tth - !(kl_V1541@(Cons (ApplC (PL "compile" _)) - (!(kl_V1541t@(Cons (!kl_V1541th) - (!(kl_V1541tt@(Cons (!kl_V1541tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V1541 kl_V1541t kl_V1541th kl_V1541tt kl_V1541tth - !(kl_V1541@(Cons (ApplC (Func "compile" _)) - (!(kl_V1541t@(Cons (!kl_V1541th) - (!(kl_V1541tt@(Cons (!kl_V1541tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V1541 kl_V1541t kl_V1541th kl_V1541tt kl_V1541tth - _ -> pat_cond_18 - -kl_shen_prolog_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_prolog_macro (!kl_V1543) = do let pat_cond_0 kl_V1543 kl_V1543t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_F) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Receive) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_PrologDef) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Query) -> do return kl_Query))) - !appl_5 <- klCons (ApplC (PL "shen.start-new-prolog-process" kl_shen_start_new_prolog_process)) (Types.Atom Types.Nil) - !appl_6 <- klCons (Atom (B True)) (Types.Atom Types.Nil) - !appl_7 <- appl_6 `pseq` klCons (Types.Atom (Types.UnboundSym "freeze")) appl_6 - !appl_8 <- appl_7 `pseq` klCons appl_7 (Types.Atom Types.Nil) - !appl_9 <- appl_5 `pseq` (appl_8 `pseq` klCons appl_5 appl_8) - !appl_10 <- kl_Receive `pseq` (appl_9 `pseq` kl_append kl_Receive appl_9) - !appl_11 <- kl_F `pseq` (appl_10 `pseq` klCons kl_F appl_10) - appl_11 `pseq` applyWrapper appl_4 [appl_11]))) - !appl_12 <- kl_F `pseq` klCons kl_F (Types.Atom Types.Nil) - !appl_13 <- appl_12 `pseq` klCons (Types.Atom (Types.UnboundSym "defprolog")) appl_12 - !appl_14 <- klCons (Types.Atom (Types.UnboundSym "<--")) (Types.Atom Types.Nil) - !appl_15 <- kl_V1543t `pseq` kl_shen_pass_literals kl_V1543t - !appl_16 <- klCons (Types.Atom (Types.UnboundSym ";")) (Types.Atom Types.Nil) - !appl_17 <- appl_15 `pseq` (appl_16 `pseq` kl_append appl_15 appl_16) - !appl_18 <- appl_14 `pseq` (appl_17 `pseq` kl_append appl_14 appl_17) - !appl_19 <- kl_Receive `pseq` (appl_18 `pseq` kl_append kl_Receive appl_18) - !appl_20 <- appl_13 `pseq` (appl_19 `pseq` kl_append appl_13 appl_19) - !appl_21 <- appl_20 `pseq` kl_eval appl_20 - appl_21 `pseq` applyWrapper appl_3 [appl_21]))) - !appl_22 <- kl_V1543t `pseq` kl_shen_receive_terms kl_V1543t - appl_22 `pseq` applyWrapper appl_2 [appl_22]))) - !appl_23 <- kl_gensym (Types.Atom (Types.UnboundSym "shen.f")) - appl_23 `pseq` applyWrapper appl_1 [appl_23] - pat_cond_24 = do do return kl_V1543 - in case kl_V1543 of - !(kl_V1543@(Cons (Atom (UnboundSym "prolog?")) - (!kl_V1543t))) -> pat_cond_0 kl_V1543 kl_V1543t - !(kl_V1543@(Cons (ApplC (PL "prolog?" _)) - (!kl_V1543t))) -> pat_cond_0 kl_V1543 kl_V1543t - !(kl_V1543@(Cons (ApplC (Func "prolog?" _)) - (!kl_V1543t))) -> pat_cond_0 kl_V1543 kl_V1543t - _ -> pat_cond_24 - -kl_shen_receive_terms :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_receive_terms (!kl_V1549) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V1549 kl_V1549h kl_V1549ht kl_V1549hth kl_V1549t = do !appl_2 <- kl_V1549t `pseq` kl_shen_receive_terms kl_V1549t - kl_V1549hth `pseq` (appl_2 `pseq` klCons kl_V1549hth appl_2) - pat_cond_3 kl_V1549 kl_V1549h kl_V1549t = do kl_V1549t `pseq` kl_shen_receive_terms kl_V1549t - pat_cond_4 = do do kl_shen_f_error (ApplC (wrapNamed "shen.receive-terms" kl_shen_receive_terms)) - in case kl_V1549 of - kl_V1549@(Atom (Nil)) -> pat_cond_0 - !(kl_V1549@(Cons (!(kl_V1549h@(Cons (Atom (UnboundSym "shen.receive")) - (!(kl_V1549ht@(Cons (!kl_V1549hth) - (Atom (Nil)))))))) - (!kl_V1549t))) -> pat_cond_1 kl_V1549 kl_V1549h kl_V1549ht kl_V1549hth kl_V1549t - !(kl_V1549@(Cons (!(kl_V1549h@(Cons (ApplC (PL "shen.receive" - _)) - (!(kl_V1549ht@(Cons (!kl_V1549hth) - (Atom (Nil)))))))) - (!kl_V1549t))) -> pat_cond_1 kl_V1549 kl_V1549h kl_V1549ht kl_V1549hth kl_V1549t - !(kl_V1549@(Cons (!(kl_V1549h@(Cons (ApplC (Func "shen.receive" - _)) - (!(kl_V1549ht@(Cons (!kl_V1549hth) - (Atom (Nil)))))))) - (!kl_V1549t))) -> pat_cond_1 kl_V1549 kl_V1549h kl_V1549ht kl_V1549hth kl_V1549t - !(kl_V1549@(Cons (!kl_V1549h) - (!kl_V1549t))) -> pat_cond_3 kl_V1549 kl_V1549h kl_V1549t - _ -> pat_cond_4 - -kl_shen_pass_literals :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_pass_literals (!kl_V1553) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V1553 kl_V1553h kl_V1553ht kl_V1553hth kl_V1553t = do kl_V1553t `pseq` kl_shen_pass_literals kl_V1553t - pat_cond_2 kl_V1553 kl_V1553h kl_V1553t = do !appl_3 <- kl_V1553t `pseq` kl_shen_pass_literals kl_V1553t - kl_V1553h `pseq` (appl_3 `pseq` klCons kl_V1553h appl_3) - pat_cond_4 = do do kl_shen_f_error (ApplC (wrapNamed "shen.pass-literals" kl_shen_pass_literals)) - in case kl_V1553 of - kl_V1553@(Atom (Nil)) -> pat_cond_0 - !(kl_V1553@(Cons (!(kl_V1553h@(Cons (Atom (UnboundSym "shen.receive")) - (!(kl_V1553ht@(Cons (!kl_V1553hth) - (Atom (Nil)))))))) - (!kl_V1553t))) -> pat_cond_1 kl_V1553 kl_V1553h kl_V1553ht kl_V1553hth kl_V1553t - !(kl_V1553@(Cons (!(kl_V1553h@(Cons (ApplC (PL "shen.receive" - _)) - (!(kl_V1553ht@(Cons (!kl_V1553hth) - (Atom (Nil)))))))) - (!kl_V1553t))) -> pat_cond_1 kl_V1553 kl_V1553h kl_V1553ht kl_V1553hth kl_V1553t - !(kl_V1553@(Cons (!(kl_V1553h@(Cons (ApplC (Func "shen.receive" - _)) - (!(kl_V1553ht@(Cons (!kl_V1553hth) - (Atom (Nil)))))))) - (!kl_V1553t))) -> pat_cond_1 kl_V1553 kl_V1553h kl_V1553ht kl_V1553hth kl_V1553t - !(kl_V1553@(Cons (!kl_V1553h) - (!kl_V1553t))) -> pat_cond_2 kl_V1553 kl_V1553h kl_V1553t - _ -> pat_cond_4 - -kl_shen_defprolog_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_defprolog_macro (!kl_V1555) = do let pat_cond_0 kl_V1555 kl_V1555t kl_V1555th kl_V1555tt = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do kl_Y `pseq` kl_shen_LBdefprologRB kl_Y))) - let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do kl_V1555th `pseq` (kl_Y `pseq` kl_shen_prolog_error kl_V1555th kl_Y)))) - appl_1 `pseq` (kl_V1555t `pseq` (appl_2 `pseq` kl_compile appl_1 kl_V1555t appl_2)) - pat_cond_3 = do do return kl_V1555 - in case kl_V1555 of - !(kl_V1555@(Cons (Atom (UnboundSym "defprolog")) - (!(kl_V1555t@(Cons (!kl_V1555th) - (!kl_V1555tt)))))) -> pat_cond_0 kl_V1555 kl_V1555t kl_V1555th kl_V1555tt - !(kl_V1555@(Cons (ApplC (PL "defprolog" _)) - (!(kl_V1555t@(Cons (!kl_V1555th) - (!kl_V1555tt)))))) -> pat_cond_0 kl_V1555 kl_V1555t kl_V1555th kl_V1555tt - !(kl_V1555@(Cons (ApplC (Func "defprolog" _)) - (!(kl_V1555t@(Cons (!kl_V1555th) - (!kl_V1555tt)))))) -> pat_cond_0 kl_V1555 kl_V1555t kl_V1555th kl_V1555tt - _ -> pat_cond_3 - -kl_shen_datatype_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_datatype_macro (!kl_V1557) = do let pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt = do !appl_1 <- kl_V1557th `pseq` kl_shen_intern_type kl_V1557th - !appl_2 <- klCons (Types.Atom (Types.UnboundSym "X")) (Types.Atom Types.Nil) - !appl_3 <- appl_2 `pseq` klCons (ApplC (wrapNamed "shen." kl_shen_LBdatatype_rulesRB)) appl_2 - !appl_4 <- appl_3 `pseq` klCons appl_3 (Types.Atom Types.Nil) - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.UnboundSym "X")) appl_4 - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym "lambda")) appl_5 - !appl_7 <- kl_V1557tt `pseq` kl_shen_rcons_form kl_V1557tt - !appl_8 <- klCons (ApplC (wrapNamed "shen.datatype-error" kl_shen_datatype_error)) (Types.Atom Types.Nil) - !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "function" kl_function)) appl_8 - !appl_10 <- appl_9 `pseq` klCons appl_9 (Types.Atom Types.Nil) - !appl_11 <- appl_7 `pseq` (appl_10 `pseq` klCons appl_7 appl_10) - !appl_12 <- appl_6 `pseq` (appl_11 `pseq` klCons appl_6 appl_11) - !appl_13 <- appl_12 `pseq` klCons (ApplC (wrapNamed "compile" kl_compile)) appl_12 - !appl_14 <- appl_13 `pseq` klCons appl_13 (Types.Atom Types.Nil) - !appl_15 <- appl_1 `pseq` (appl_14 `pseq` klCons appl_1 appl_14) - appl_15 `pseq` klCons (ApplC (wrapNamed "shen.process-datatype" kl_shen_process_datatype)) appl_15 - pat_cond_16 = do do return kl_V1557 - in case kl_V1557 of - !(kl_V1557@(Cons (Atom (UnboundSym "datatype")) - (!(kl_V1557t@(Cons (!kl_V1557th) - (!kl_V1557tt)))))) -> pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt - !(kl_V1557@(Cons (ApplC (PL "datatype" _)) - (!(kl_V1557t@(Cons (!kl_V1557th) - (!kl_V1557tt)))))) -> pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt - !(kl_V1557@(Cons (ApplC (Func "datatype" _)) - (!(kl_V1557t@(Cons (!kl_V1557th) - (!kl_V1557tt)))))) -> pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt - _ -> pat_cond_16 - -kl_shen_intern_type :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_intern_type (!kl_V1559) = do !appl_0 <- kl_V1559 `pseq` str kl_V1559 - !appl_1 <- appl_0 `pseq` cn (Types.Atom (Types.Str "type#")) appl_0 - appl_1 `pseq` intern appl_1 - -kl_shen_Ats_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_Ats_macro (!kl_V1561) = do let pat_cond_0 kl_V1561 kl_V1561t kl_V1561th kl_V1561tt kl_V1561tth kl_V1561ttt kl_V1561ttth kl_V1561tttt = do !appl_1 <- kl_V1561tt `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) kl_V1561tt - !appl_2 <- appl_1 `pseq` kl_shen_Ats_macro appl_1 - !appl_3 <- appl_2 `pseq` klCons appl_2 (Types.Atom Types.Nil) - !appl_4 <- kl_V1561th `pseq` (appl_3 `pseq` klCons kl_V1561th appl_3) - appl_4 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_4 - pat_cond_5 = do !kl_if_6 <- let pat_cond_7 kl_V1561 kl_V1561h kl_V1561t = do !kl_if_8 <- let pat_cond_9 = do !kl_if_10 <- let pat_cond_11 kl_V1561t kl_V1561th kl_V1561tt = do !kl_if_12 <- let pat_cond_13 kl_V1561tt kl_V1561tth kl_V1561ttt = do !kl_if_14 <- let pat_cond_15 = do !kl_if_16 <- kl_V1561th `pseq` stringP kl_V1561th - case kl_if_16 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_17 = do do return (Atom (B False)) - in case kl_V1561ttt of - kl_V1561ttt@(Atom (Nil)) -> pat_cond_15 - _ -> pat_cond_17 - case kl_if_14 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_V1561tt of - !(kl_V1561tt@(Cons (!kl_V1561tth) - (!kl_V1561ttt))) -> pat_cond_13 kl_V1561tt kl_V1561tth kl_V1561ttt - _ -> pat_cond_18 - case kl_if_12 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_19 = do do return (Atom (B False)) - in case kl_V1561t of - !(kl_V1561t@(Cons (!kl_V1561th) - (!kl_V1561tt))) -> pat_cond_11 kl_V1561t kl_V1561th kl_V1561tt - _ -> pat_cond_19 - case kl_if_10 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_20 = do do return (Atom (B False)) - in case kl_V1561h of - kl_V1561h@(Atom (UnboundSym "@s")) -> pat_cond_9 - kl_V1561h@(ApplC (PL "@s" - _)) -> pat_cond_9 - kl_V1561h@(ApplC (Func "@s" - _)) -> pat_cond_9 - _ -> pat_cond_20 - 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_21 = do do return (Atom (B False)) - in case kl_V1561 of - !(kl_V1561@(Cons (!kl_V1561h) - (!kl_V1561t))) -> pat_cond_7 kl_V1561 kl_V1561h kl_V1561t - _ -> pat_cond_21 - case kl_if_6 of - Atom (B (True)) -> do let !appl_22 = ApplC (Func "lambda" (Context (\(!kl_E) -> do !appl_23 <- kl_E `pseq` kl_length kl_E - !kl_if_24 <- appl_23 `pseq` greaterThan appl_23 (Types.Atom (Types.N (Types.KI 1))) - case kl_if_24 of - Atom (B (True)) -> do !appl_25 <- kl_V1561 `pseq` tl kl_V1561 - !appl_26 <- appl_25 `pseq` tl appl_25 - !appl_27 <- kl_E `pseq` (appl_26 `pseq` kl_append kl_E appl_26) - !appl_28 <- appl_27 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_27 - appl_28 `pseq` kl_shen_Ats_macro appl_28 - Atom (B (False)) -> do do return kl_V1561 - _ -> throwError "if: expected boolean"))) - !appl_29 <- kl_V1561 `pseq` tl kl_V1561 - !appl_30 <- appl_29 `pseq` hd appl_29 - !appl_31 <- appl_30 `pseq` kl_explode appl_30 - appl_31 `pseq` applyWrapper appl_22 [appl_31] - Atom (B (False)) -> do do return kl_V1561 - _ -> throwError "if: expected boolean" - in case kl_V1561 of - !(kl_V1561@(Cons (Atom (UnboundSym "@s")) - (!(kl_V1561t@(Cons (!kl_V1561th) - (!(kl_V1561tt@(Cons (!kl_V1561tth) - (!(kl_V1561ttt@(Cons (!kl_V1561ttth) - (!kl_V1561tttt)))))))))))) -> pat_cond_0 kl_V1561 kl_V1561t kl_V1561th kl_V1561tt kl_V1561tth kl_V1561ttt kl_V1561ttth kl_V1561tttt - !(kl_V1561@(Cons (ApplC (PL "@s" _)) - (!(kl_V1561t@(Cons (!kl_V1561th) - (!(kl_V1561tt@(Cons (!kl_V1561tth) - (!(kl_V1561ttt@(Cons (!kl_V1561ttth) - (!kl_V1561tttt)))))))))))) -> pat_cond_0 kl_V1561 kl_V1561t kl_V1561th kl_V1561tt kl_V1561tth kl_V1561ttt kl_V1561ttth kl_V1561tttt - !(kl_V1561@(Cons (ApplC (Func "@s" _)) - (!(kl_V1561t@(Cons (!kl_V1561th) - (!(kl_V1561tt@(Cons (!kl_V1561tth) - (!(kl_V1561ttt@(Cons (!kl_V1561ttth) - (!kl_V1561tttt)))))))))))) -> pat_cond_0 kl_V1561 kl_V1561t kl_V1561th kl_V1561tt kl_V1561tth kl_V1561ttt kl_V1561ttth kl_V1561tttt - _ -> pat_cond_5 - -kl_shen_synonyms_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_synonyms_macro (!kl_V1563) = do let pat_cond_0 kl_V1563 kl_V1563t = do !appl_1 <- kl_V1563t `pseq` kl_shen_curry_synonyms kl_V1563t - !appl_2 <- appl_1 `pseq` kl_shen_rcons_form appl_1 - !appl_3 <- appl_2 `pseq` klCons appl_2 (Types.Atom Types.Nil) - appl_3 `pseq` klCons (ApplC (wrapNamed "shen.synonyms-help" kl_shen_synonyms_help)) appl_3 - pat_cond_4 = do do return kl_V1563 - in case kl_V1563 of - !(kl_V1563@(Cons (Atom (UnboundSym "synonyms")) - (!kl_V1563t))) -> pat_cond_0 kl_V1563 kl_V1563t - !(kl_V1563@(Cons (ApplC (PL "synonyms" _)) - (!kl_V1563t))) -> pat_cond_0 kl_V1563 kl_V1563t - !(kl_V1563@(Cons (ApplC (Func "synonyms" _)) - (!kl_V1563t))) -> pat_cond_0 kl_V1563 kl_V1563t - _ -> pat_cond_4 - -kl_shen_curry_synonyms :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_curry_synonyms (!kl_V1565) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_curry_type kl_X))) - appl_0 `pseq` (kl_V1565 `pseq` kl_map appl_0 kl_V1565) - -kl_shen_nl_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_nl_macro (!kl_V1567) = do let pat_cond_0 kl_V1567 = do !appl_1 <- klCons (Types.Atom (Types.N (Types.KI 1))) (Types.Atom Types.Nil) - appl_1 `pseq` klCons (ApplC (wrapNamed "nl" kl_nl)) appl_1 - pat_cond_2 = do do return kl_V1567 - in case kl_V1567 of - !(kl_V1567@(Cons (Atom (UnboundSym "nl")) - (Atom (Nil)))) -> pat_cond_0 kl_V1567 - !(kl_V1567@(Cons (ApplC (PL "nl" _)) - (Atom (Nil)))) -> pat_cond_0 kl_V1567 - !(kl_V1567@(Cons (ApplC (Func "nl" _)) - (Atom (Nil)))) -> pat_cond_0 kl_V1567 - _ -> pat_cond_2 - -kl_shen_assoc_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_assoc_macro (!kl_V1569) = do !kl_if_0 <- let pat_cond_1 kl_V1569 kl_V1569h kl_V1569t = do !kl_if_2 <- let pat_cond_3 kl_V1569t kl_V1569th kl_V1569tt = do !kl_if_4 <- let pat_cond_5 kl_V1569tt kl_V1569tth kl_V1569ttt = do !kl_if_6 <- let pat_cond_7 kl_V1569ttt kl_V1569ttth kl_V1569tttt = do !appl_8 <- klCons (ApplC (wrapNamed "do" kl_do)) (Types.Atom Types.Nil) - !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_8 - !appl_10 <- appl_9 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_9 - !appl_11 <- appl_10 `pseq` klCons (Types.Atom (Types.UnboundSym "or")) appl_10 - !appl_12 <- appl_11 `pseq` klCons (Types.Atom (Types.UnboundSym "and")) appl_11 - !appl_13 <- appl_12 `pseq` klCons (ApplC (wrapNamed "append" kl_append)) appl_12 - !appl_14 <- appl_13 `pseq` klCons (ApplC (wrapNamed "@v" kl_Atv)) appl_13 - !appl_15 <- appl_14 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_14 - !kl_if_16 <- kl_V1569h `pseq` (appl_15 `pseq` kl_elementP kl_V1569h appl_15) - case kl_if_16 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_17 = do do return (Atom (B False)) - in case kl_V1569ttt of - !(kl_V1569ttt@(Cons (!kl_V1569ttth) - (!kl_V1569tttt))) -> pat_cond_7 kl_V1569ttt kl_V1569ttth kl_V1569tttt - _ -> pat_cond_17 - 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_18 = do do return (Atom (B False)) - in case kl_V1569tt of - !(kl_V1569tt@(Cons (!kl_V1569tth) - (!kl_V1569ttt))) -> pat_cond_5 kl_V1569tt kl_V1569tth kl_V1569ttt - _ -> pat_cond_18 - 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_19 = do do return (Atom (B False)) - in case kl_V1569t of - !(kl_V1569t@(Cons (!kl_V1569th) - (!kl_V1569tt))) -> pat_cond_3 kl_V1569t kl_V1569th kl_V1569tt - _ -> pat_cond_19 - 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_20 = do do return (Atom (B False)) - in case kl_V1569 of - !(kl_V1569@(Cons (!kl_V1569h) - (!kl_V1569t))) -> pat_cond_1 kl_V1569 kl_V1569h kl_V1569t - _ -> pat_cond_20 - case kl_if_0 of - Atom (B (True)) -> do !appl_21 <- kl_V1569 `pseq` hd kl_V1569 - !appl_22 <- kl_V1569 `pseq` tl kl_V1569 - !appl_23 <- appl_22 `pseq` hd appl_22 - !appl_24 <- kl_V1569 `pseq` hd kl_V1569 - !appl_25 <- kl_V1569 `pseq` tl kl_V1569 - !appl_26 <- appl_25 `pseq` tl appl_25 - !appl_27 <- appl_24 `pseq` (appl_26 `pseq` klCons appl_24 appl_26) - !appl_28 <- appl_27 `pseq` kl_shen_assoc_macro appl_27 - !appl_29 <- appl_28 `pseq` klCons appl_28 (Types.Atom Types.Nil) - !appl_30 <- appl_23 `pseq` (appl_29 `pseq` klCons appl_23 appl_29) - appl_21 `pseq` (appl_30 `pseq` klCons appl_21 appl_30) - Atom (B (False)) -> do do return kl_V1569 - _ -> throwError "if: expected boolean" - -kl_shen_let_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_let_macro (!kl_V1571) = do let pat_cond_0 kl_V1571 kl_V1571t kl_V1571th kl_V1571tt kl_V1571tth kl_V1571ttt kl_V1571ttth kl_V1571tttt kl_V1571tttth kl_V1571ttttt = do !appl_1 <- kl_V1571ttt `pseq` klCons (Types.Atom (Types.UnboundSym "let")) kl_V1571ttt - !appl_2 <- appl_1 `pseq` kl_shen_let_macro appl_1 - !appl_3 <- appl_2 `pseq` klCons appl_2 (Types.Atom Types.Nil) - !appl_4 <- kl_V1571tth `pseq` (appl_3 `pseq` klCons kl_V1571tth appl_3) - !appl_5 <- kl_V1571th `pseq` (appl_4 `pseq` klCons kl_V1571th appl_4) - appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_5 - pat_cond_6 = do do return kl_V1571 - in case kl_V1571 of - !(kl_V1571@(Cons (Atom (UnboundSym "let")) - (!(kl_V1571t@(Cons (!kl_V1571th) - (!(kl_V1571tt@(Cons (!kl_V1571tth) - (!(kl_V1571ttt@(Cons (!kl_V1571ttth) - (!(kl_V1571tttt@(Cons (!kl_V1571tttth) - (!kl_V1571ttttt))))))))))))))) -> pat_cond_0 kl_V1571 kl_V1571t kl_V1571th kl_V1571tt kl_V1571tth kl_V1571ttt kl_V1571ttth kl_V1571tttt kl_V1571tttth kl_V1571ttttt - !(kl_V1571@(Cons (ApplC (PL "let" _)) - (!(kl_V1571t@(Cons (!kl_V1571th) - (!(kl_V1571tt@(Cons (!kl_V1571tth) - (!(kl_V1571ttt@(Cons (!kl_V1571ttth) - (!(kl_V1571tttt@(Cons (!kl_V1571tttth) - (!kl_V1571ttttt))))))))))))))) -> pat_cond_0 kl_V1571 kl_V1571t kl_V1571th kl_V1571tt kl_V1571tth kl_V1571ttt kl_V1571ttth kl_V1571tttt kl_V1571tttth kl_V1571ttttt - !(kl_V1571@(Cons (ApplC (Func "let" _)) - (!(kl_V1571t@(Cons (!kl_V1571th) - (!(kl_V1571tt@(Cons (!kl_V1571tth) - (!(kl_V1571ttt@(Cons (!kl_V1571ttth) - (!(kl_V1571tttt@(Cons (!kl_V1571tttth) - (!kl_V1571ttttt))))))))))))))) -> pat_cond_0 kl_V1571 kl_V1571t kl_V1571th kl_V1571tt kl_V1571tth kl_V1571ttt kl_V1571ttth kl_V1571tttt kl_V1571tttth kl_V1571ttttt - _ -> pat_cond_6 - -kl_shen_abs_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_abs_macro (!kl_V1573) = do let pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt = do !appl_1 <- kl_V1573tt `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) kl_V1573tt - !appl_2 <- appl_1 `pseq` kl_shen_abs_macro appl_1 - !appl_3 <- appl_2 `pseq` klCons appl_2 (Types.Atom Types.Nil) - !appl_4 <- kl_V1573th `pseq` (appl_3 `pseq` klCons kl_V1573th appl_3) - appl_4 `pseq` klCons (Types.Atom (Types.UnboundSym "lambda")) appl_4 - pat_cond_5 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth = do kl_V1573t `pseq` klCons (Types.Atom (Types.UnboundSym "lambda")) kl_V1573t - pat_cond_6 = do do return kl_V1573 - in case kl_V1573 of - !(kl_V1573@(Cons (Atom (UnboundSym "/.")) - (!(kl_V1573t@(Cons (!kl_V1573th) - (!(kl_V1573tt@(Cons (!kl_V1573tth) - (!(kl_V1573ttt@(Cons (!kl_V1573ttth) - (!kl_V1573tttt)))))))))))) -> pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt - !(kl_V1573@(Cons (ApplC (PL "/." _)) - (!(kl_V1573t@(Cons (!kl_V1573th) - (!(kl_V1573tt@(Cons (!kl_V1573tth) - (!(kl_V1573ttt@(Cons (!kl_V1573ttth) - (!kl_V1573tttt)))))))))))) -> pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt - !(kl_V1573@(Cons (ApplC (Func "/." _)) - (!(kl_V1573t@(Cons (!kl_V1573th) - (!(kl_V1573tt@(Cons (!kl_V1573tth) - (!(kl_V1573ttt@(Cons (!kl_V1573ttth) - (!kl_V1573tttt)))))))))))) -> pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt - !(kl_V1573@(Cons (Atom (UnboundSym "/.")) - (!(kl_V1573t@(Cons (!kl_V1573th) - (!(kl_V1573tt@(Cons (!kl_V1573tth) - (Atom (Nil)))))))))) -> pat_cond_5 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth - !(kl_V1573@(Cons (ApplC (PL "/." _)) - (!(kl_V1573t@(Cons (!kl_V1573th) - (!(kl_V1573tt@(Cons (!kl_V1573tth) - (Atom (Nil)))))))))) -> pat_cond_5 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth - !(kl_V1573@(Cons (ApplC (Func "/." _)) - (!(kl_V1573t@(Cons (!kl_V1573th) - (!(kl_V1573tt@(Cons (!kl_V1573tth) - (Atom (Nil)))))))))) -> pat_cond_5 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth - _ -> pat_cond_6 - -kl_shen_cases_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_cases_macro (!kl_V1577) = do let pat_cond_0 kl_V1577 kl_V1577t kl_V1577tt kl_V1577tth kl_V1577ttt = do return kl_V1577tth - pat_cond_1 kl_V1577 kl_V1577t kl_V1577th kl_V1577tt kl_V1577tth = do !appl_2 <- klCons (Types.Atom (Types.Str "error: cases exhausted")) (Types.Atom Types.Nil) - !appl_3 <- appl_2 `pseq` klCons (ApplC (wrapNamed "simple-error" simpleError)) appl_2 - !appl_4 <- appl_3 `pseq` klCons appl_3 (Types.Atom Types.Nil) - !appl_5 <- kl_V1577tth `pseq` (appl_4 `pseq` klCons kl_V1577tth appl_4) - !appl_6 <- kl_V1577th `pseq` (appl_5 `pseq` klCons kl_V1577th appl_5) - appl_6 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_6 - pat_cond_7 kl_V1577 kl_V1577t kl_V1577th kl_V1577tt kl_V1577tth kl_V1577ttt = do !appl_8 <- kl_V1577ttt `pseq` klCons (Types.Atom (Types.UnboundSym "cases")) kl_V1577ttt - !appl_9 <- appl_8 `pseq` kl_shen_cases_macro appl_8 - !appl_10 <- appl_9 `pseq` klCons appl_9 (Types.Atom Types.Nil) - !appl_11 <- kl_V1577tth `pseq` (appl_10 `pseq` klCons kl_V1577tth appl_10) - !appl_12 <- kl_V1577th `pseq` (appl_11 `pseq` klCons kl_V1577th appl_11) - appl_12 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_12 - pat_cond_13 kl_V1577 kl_V1577t kl_V1577th = do simpleError (Types.Atom (Types.Str "error: odd number of case elements\n")) - pat_cond_14 = do do return kl_V1577 - in case kl_V1577 of - !(kl_V1577@(Cons (Atom (UnboundSym "cases")) - (!(kl_V1577t@(Cons (Atom (UnboundSym "true")) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (!kl_V1577ttt))))))))) -> pat_cond_0 kl_V1577 kl_V1577t kl_V1577tt kl_V1577tth kl_V1577ttt - !(kl_V1577@(Cons (Atom (UnboundSym "cases")) - (!(kl_V1577t@(Cons (Atom (B (True))) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (!kl_V1577ttt))))))))) -> pat_cond_0 kl_V1577 kl_V1577t kl_V1577tt kl_V1577tth kl_V1577ttt - !(kl_V1577@(Cons (ApplC (PL "cases" _)) - (!(kl_V1577t@(Cons (Atom (UnboundSym "true")) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (!kl_V1577ttt))))))))) -> pat_cond_0 kl_V1577 kl_V1577t kl_V1577tt kl_V1577tth kl_V1577ttt - !(kl_V1577@(Cons (ApplC (PL "cases" _)) - (!(kl_V1577t@(Cons (Atom (B (True))) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (!kl_V1577ttt))))))))) -> pat_cond_0 kl_V1577 kl_V1577t kl_V1577tt kl_V1577tth kl_V1577ttt - !(kl_V1577@(Cons (ApplC (Func "cases" _)) - (!(kl_V1577t@(Cons (Atom (UnboundSym "true")) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (!kl_V1577ttt))))))))) -> pat_cond_0 kl_V1577 kl_V1577t kl_V1577tt kl_V1577tth kl_V1577ttt - !(kl_V1577@(Cons (ApplC (Func "cases" _)) - (!(kl_V1577t@(Cons (Atom (B (True))) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (!kl_V1577ttt))))))))) -> pat_cond_0 kl_V1577 kl_V1577t kl_V1577tt kl_V1577tth kl_V1577ttt - !(kl_V1577@(Cons (Atom (UnboundSym "cases")) - (!(kl_V1577t@(Cons (!kl_V1577th) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (Atom (Nil)))))))))) -> pat_cond_1 kl_V1577 kl_V1577t kl_V1577th kl_V1577tt kl_V1577tth - !(kl_V1577@(Cons (ApplC (PL "cases" _)) - (!(kl_V1577t@(Cons (!kl_V1577th) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (Atom (Nil)))))))))) -> pat_cond_1 kl_V1577 kl_V1577t kl_V1577th kl_V1577tt kl_V1577tth - !(kl_V1577@(Cons (ApplC (Func "cases" _)) - (!(kl_V1577t@(Cons (!kl_V1577th) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (Atom (Nil)))))))))) -> pat_cond_1 kl_V1577 kl_V1577t kl_V1577th kl_V1577tt kl_V1577tth - !(kl_V1577@(Cons (Atom (UnboundSym "cases")) - (!(kl_V1577t@(Cons (!kl_V1577th) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (!kl_V1577ttt))))))))) -> pat_cond_7 kl_V1577 kl_V1577t kl_V1577th kl_V1577tt kl_V1577tth kl_V1577ttt - !(kl_V1577@(Cons (ApplC (PL "cases" _)) - (!(kl_V1577t@(Cons (!kl_V1577th) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (!kl_V1577ttt))))))))) -> pat_cond_7 kl_V1577 kl_V1577t kl_V1577th kl_V1577tt kl_V1577tth kl_V1577ttt - !(kl_V1577@(Cons (ApplC (Func "cases" _)) - (!(kl_V1577t@(Cons (!kl_V1577th) - (!(kl_V1577tt@(Cons (!kl_V1577tth) - (!kl_V1577ttt))))))))) -> pat_cond_7 kl_V1577 kl_V1577t kl_V1577th kl_V1577tt kl_V1577tth kl_V1577ttt - !(kl_V1577@(Cons (Atom (UnboundSym "cases")) - (!(kl_V1577t@(Cons (!kl_V1577th) - (Atom (Nil))))))) -> pat_cond_13 kl_V1577 kl_V1577t kl_V1577th - !(kl_V1577@(Cons (ApplC (PL "cases" _)) - (!(kl_V1577t@(Cons (!kl_V1577th) - (Atom (Nil))))))) -> pat_cond_13 kl_V1577 kl_V1577t kl_V1577th - !(kl_V1577@(Cons (ApplC (Func "cases" _)) - (!(kl_V1577t@(Cons (!kl_V1577th) - (Atom (Nil))))))) -> pat_cond_13 kl_V1577 kl_V1577t kl_V1577th - _ -> pat_cond_14 - -kl_shen_timer_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_timer_macro (!kl_V1579) = do let pat_cond_0 kl_V1579 kl_V1579t kl_V1579th = do !appl_1 <- klCons (Types.Atom (Types.UnboundSym "run")) (Types.Atom Types.Nil) - !appl_2 <- appl_1 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_1 - !appl_3 <- klCons (Types.Atom (Types.UnboundSym "run")) (Types.Atom Types.Nil) - !appl_4 <- appl_3 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_3 - !appl_5 <- klCons (Types.Atom (Types.UnboundSym "Start")) (Types.Atom Types.Nil) - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym "Finish")) appl_5 - !appl_7 <- appl_6 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_6 - !appl_8 <- klCons (Types.Atom (Types.UnboundSym "Time")) (Types.Atom Types.Nil) - !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "str" str)) appl_8 - !appl_10 <- klCons (Types.Atom (Types.Str " secs\n")) (Types.Atom Types.Nil) - !appl_11 <- appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) - !appl_12 <- appl_11 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_11 - !appl_13 <- appl_12 `pseq` klCons appl_12 (Types.Atom Types.Nil) - !appl_14 <- appl_13 `pseq` klCons (Types.Atom (Types.Str "\nrun time: ")) appl_13 - !appl_15 <- appl_14 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_14 - !appl_16 <- klCons (ApplC (PL "stoutput" kl_stoutput)) (Types.Atom Types.Nil) - !appl_17 <- appl_16 `pseq` klCons appl_16 (Types.Atom Types.Nil) - !appl_18 <- appl_15 `pseq` (appl_17 `pseq` klCons appl_15 appl_17) - !appl_19 <- appl_18 `pseq` klCons (ApplC (wrapNamed "shen.prhush" kl_shen_prhush)) appl_18 - !appl_20 <- klCons (Types.Atom (Types.UnboundSym "Result")) (Types.Atom Types.Nil) - !appl_21 <- appl_19 `pseq` (appl_20 `pseq` klCons appl_19 appl_20) - !appl_22 <- appl_21 `pseq` klCons (Types.Atom (Types.UnboundSym "Message")) appl_21 - !appl_23 <- appl_7 `pseq` (appl_22 `pseq` klCons appl_7 appl_22) - !appl_24 <- appl_23 `pseq` klCons (Types.Atom (Types.UnboundSym "Time")) appl_23 - !appl_25 <- appl_4 `pseq` (appl_24 `pseq` klCons appl_4 appl_24) - !appl_26 <- appl_25 `pseq` klCons (Types.Atom (Types.UnboundSym "Finish")) appl_25 - !appl_27 <- kl_V1579th `pseq` (appl_26 `pseq` klCons kl_V1579th appl_26) - !appl_28 <- appl_27 `pseq` klCons (Types.Atom (Types.UnboundSym "Result")) appl_27 - !appl_29 <- appl_2 `pseq` (appl_28 `pseq` klCons appl_2 appl_28) - !appl_30 <- appl_29 `pseq` klCons (Types.Atom (Types.UnboundSym "Start")) appl_29 - !appl_31 <- appl_30 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_30 - appl_31 `pseq` kl_shen_let_macro appl_31 - pat_cond_32 = do do return kl_V1579 - in case kl_V1579 of - !(kl_V1579@(Cons (Atom (UnboundSym "time")) - (!(kl_V1579t@(Cons (!kl_V1579th) - (Atom (Nil))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579th - !(kl_V1579@(Cons (ApplC (PL "time" _)) - (!(kl_V1579t@(Cons (!kl_V1579th) - (Atom (Nil))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579th - !(kl_V1579@(Cons (ApplC (Func "time" _)) - (!(kl_V1579t@(Cons (!kl_V1579th) - (Atom (Nil))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579th - _ -> pat_cond_32 - -kl_shen_tuple_up :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_tuple_up (!kl_V1581) = do let pat_cond_0 kl_V1581 kl_V1581h kl_V1581t = do !appl_1 <- kl_V1581t `pseq` kl_shen_tuple_up kl_V1581t - !appl_2 <- appl_1 `pseq` klCons appl_1 (Types.Atom Types.Nil) - !appl_3 <- kl_V1581h `pseq` (appl_2 `pseq` klCons kl_V1581h appl_2) - appl_3 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_3 - pat_cond_4 = do do return kl_V1581 - in case kl_V1581 of - !(kl_V1581@(Cons (!kl_V1581h) - (!kl_V1581t))) -> pat_cond_0 kl_V1581 kl_V1581h kl_V1581t - _ -> pat_cond_4 - -kl_shen_putDivget_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_putDivget_macro (!kl_V1583) = do let pat_cond_0 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth kl_V1583ttt kl_V1583ttth = do !appl_1 <- klCons (Types.Atom (Types.UnboundSym "*property-vector*")) (Types.Atom Types.Nil) - !appl_2 <- appl_1 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_1 - !appl_3 <- appl_2 `pseq` klCons appl_2 (Types.Atom Types.Nil) - !appl_4 <- kl_V1583ttth `pseq` (appl_3 `pseq` klCons kl_V1583ttth appl_3) - !appl_5 <- kl_V1583tth `pseq` (appl_4 `pseq` klCons kl_V1583tth appl_4) - !appl_6 <- kl_V1583th `pseq` (appl_5 `pseq` klCons kl_V1583th appl_5) - appl_6 `pseq` klCons (ApplC (wrapNamed "put" kl_put)) appl_6 - pat_cond_7 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth = do !appl_8 <- klCons (Types.Atom (Types.UnboundSym "*property-vector*")) (Types.Atom Types.Nil) - !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_8 - !appl_10 <- appl_9 `pseq` klCons appl_9 (Types.Atom Types.Nil) - !appl_11 <- kl_V1583tth `pseq` (appl_10 `pseq` klCons kl_V1583tth appl_10) - !appl_12 <- kl_V1583th `pseq` (appl_11 `pseq` klCons kl_V1583th appl_11) - appl_12 `pseq` klCons (ApplC (wrapNamed "get" kl_get)) appl_12 - pat_cond_13 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth = do !appl_14 <- klCons (Types.Atom (Types.UnboundSym "*property-vector*")) (Types.Atom Types.Nil) - !appl_15 <- appl_14 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_14 - !appl_16 <- appl_15 `pseq` klCons appl_15 (Types.Atom Types.Nil) - !appl_17 <- kl_V1583tth `pseq` (appl_16 `pseq` klCons kl_V1583tth appl_16) - !appl_18 <- kl_V1583th `pseq` (appl_17 `pseq` klCons kl_V1583th appl_17) - appl_18 `pseq` klCons (ApplC (wrapNamed "unput" kl_unput)) appl_18 - pat_cond_19 = do do return kl_V1583 - in case kl_V1583 of - !(kl_V1583@(Cons (Atom (UnboundSym "put")) - (!(kl_V1583t@(Cons (!kl_V1583th) - (!(kl_V1583tt@(Cons (!kl_V1583tth) - (!(kl_V1583ttt@(Cons (!kl_V1583ttth) - (Atom (Nil))))))))))))) -> pat_cond_0 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth kl_V1583ttt kl_V1583ttth - !(kl_V1583@(Cons (ApplC (PL "put" _)) - (!(kl_V1583t@(Cons (!kl_V1583th) - (!(kl_V1583tt@(Cons (!kl_V1583tth) - (!(kl_V1583ttt@(Cons (!kl_V1583ttth) - (Atom (Nil))))))))))))) -> pat_cond_0 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth kl_V1583ttt kl_V1583ttth - !(kl_V1583@(Cons (ApplC (Func "put" _)) - (!(kl_V1583t@(Cons (!kl_V1583th) - (!(kl_V1583tt@(Cons (!kl_V1583tth) - (!(kl_V1583ttt@(Cons (!kl_V1583ttth) - (Atom (Nil))))))))))))) -> pat_cond_0 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth kl_V1583ttt kl_V1583ttth - !(kl_V1583@(Cons (Atom (UnboundSym "get")) - (!(kl_V1583t@(Cons (!kl_V1583th) - (!(kl_V1583tt@(Cons (!kl_V1583tth) - (Atom (Nil)))))))))) -> pat_cond_7 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth - !(kl_V1583@(Cons (ApplC (PL "get" _)) - (!(kl_V1583t@(Cons (!kl_V1583th) - (!(kl_V1583tt@(Cons (!kl_V1583tth) - (Atom (Nil)))))))))) -> pat_cond_7 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth - !(kl_V1583@(Cons (ApplC (Func "get" _)) - (!(kl_V1583t@(Cons (!kl_V1583th) - (!(kl_V1583tt@(Cons (!kl_V1583tth) - (Atom (Nil)))))))))) -> pat_cond_7 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth - !(kl_V1583@(Cons (Atom (UnboundSym "unput")) - (!(kl_V1583t@(Cons (!kl_V1583th) - (!(kl_V1583tt@(Cons (!kl_V1583tth) - (Atom (Nil)))))))))) -> pat_cond_13 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth - !(kl_V1583@(Cons (ApplC (PL "unput" _)) - (!(kl_V1583t@(Cons (!kl_V1583th) - (!(kl_V1583tt@(Cons (!kl_V1583tth) - (Atom (Nil)))))))))) -> pat_cond_13 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth - !(kl_V1583@(Cons (ApplC (Func "unput" _)) - (!(kl_V1583t@(Cons (!kl_V1583th) - (!(kl_V1583tt@(Cons (!kl_V1583tth) - (Atom (Nil)))))))))) -> pat_cond_13 kl_V1583 kl_V1583t kl_V1583th kl_V1583tt kl_V1583tth - _ -> pat_cond_19 - -kl_shen_function_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_function_macro (!kl_V1585) = do let pat_cond_0 kl_V1585 kl_V1585t kl_V1585th = do let !aw_1 = Types.Atom (Types.UnboundSym "arity") - !appl_2 <- kl_V1585th `pseq` applyWrapper aw_1 [kl_V1585th] - kl_V1585th `pseq` (appl_2 `pseq` kl_shen_function_abstraction kl_V1585th appl_2) - pat_cond_3 = do do return kl_V1585 - in case kl_V1585 of - !(kl_V1585@(Cons (Atom (UnboundSym "function")) - (!(kl_V1585t@(Cons (!kl_V1585th) - (Atom (Nil))))))) -> pat_cond_0 kl_V1585 kl_V1585t kl_V1585th - !(kl_V1585@(Cons (ApplC (PL "function" _)) - (!(kl_V1585t@(Cons (!kl_V1585th) - (Atom (Nil))))))) -> pat_cond_0 kl_V1585 kl_V1585t kl_V1585th - !(kl_V1585@(Cons (ApplC (Func "function" _)) - (!(kl_V1585t@(Cons (!kl_V1585th) - (Atom (Nil))))))) -> pat_cond_0 kl_V1585 kl_V1585t kl_V1585th - _ -> pat_cond_3 - -kl_shen_function_abstraction :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_function_abstraction (!kl_V1588) (!kl_V1589) = do let pat_cond_0 = do !appl_1 <- kl_V1588 `pseq` kl_shen_app kl_V1588 (Types.Atom (Types.Str " has no lambda form\n")) (Types.Atom (Types.UnboundSym "shen.a")) - appl_1 `pseq` simpleError appl_1 - pat_cond_2 = do !appl_3 <- kl_V1588 `pseq` klCons kl_V1588 (Types.Atom Types.Nil) - appl_3 `pseq` klCons (ApplC (wrapNamed "function" kl_function)) appl_3 - pat_cond_4 = do do kl_V1588 `pseq` (kl_V1589 `pseq` kl_shen_function_abstraction_help kl_V1588 kl_V1589 (Types.Atom Types.Nil)) - in case kl_V1589 of - kl_V1589@(Atom (N (KI 0))) -> pat_cond_0 - kl_V1589@(Atom (N (KI (-1)))) -> pat_cond_2 - _ -> pat_cond_4 - -kl_shen_function_abstraction_help :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_function_abstraction_help (!kl_V1593) (!kl_V1594) (!kl_V1595) = do let pat_cond_0 = do kl_V1593 `pseq` (kl_V1595 `pseq` klCons kl_V1593 kl_V1595) - pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_3 <- kl_V1594 `pseq` Primitives.subtract kl_V1594 (Types.Atom (Types.N (Types.KI 1))) - !appl_4 <- kl_X `pseq` klCons kl_X (Types.Atom Types.Nil) - !appl_5 <- kl_V1595 `pseq` (appl_4 `pseq` kl_append kl_V1595 appl_4) - !appl_6 <- kl_V1593 `pseq` (appl_3 `pseq` (appl_5 `pseq` kl_shen_function_abstraction_help kl_V1593 appl_3 appl_5)) - !appl_7 <- appl_6 `pseq` klCons appl_6 (Types.Atom Types.Nil) - !appl_8 <- kl_X `pseq` (appl_7 `pseq` klCons kl_X appl_7) - appl_8 `pseq` klCons (Types.Atom (Types.UnboundSym "/.")) appl_8))) - !appl_9 <- kl_gensym (Types.Atom (Types.UnboundSym "V")) - appl_9 `pseq` applyWrapper appl_2 [appl_9] - in case kl_V1594 of - kl_V1594@(Atom (N (KI 0))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_undefmacro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_undefmacro (!kl_V1597) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_MacroReg) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Pos) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Remove1) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Remove2) -> do return kl_V1597))) - !appl_4 <- value (Types.Atom (Types.UnboundSym "*macros*")) - !appl_5 <- kl_Pos `pseq` (appl_4 `pseq` kl_shen_remove_nth kl_Pos appl_4) - !appl_6 <- appl_5 `pseq` klSet (Types.Atom (Types.UnboundSym "*macros*")) appl_5 - appl_6 `pseq` applyWrapper appl_3 [appl_6]))) - !appl_7 <- kl_V1597 `pseq` (kl_MacroReg `pseq` kl_remove kl_V1597 kl_MacroReg) - !appl_8 <- appl_7 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*macroreg*")) appl_7 - appl_8 `pseq` applyWrapper appl_2 [appl_8]))) - !appl_9 <- kl_V1597 `pseq` (kl_MacroReg `pseq` kl_shen_findpos kl_V1597 kl_MacroReg) - appl_9 `pseq` applyWrapper appl_1 [appl_9]))) - !appl_10 <- value (Types.Atom (Types.UnboundSym "shen.*macroreg*")) - appl_10 `pseq` applyWrapper appl_0 [appl_10] - -kl_shen_findpos :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_findpos (!kl_V1607) (!kl_V1608) = do let pat_cond_0 = do !appl_1 <- kl_V1607 `pseq` kl_shen_app kl_V1607 (Types.Atom (Types.Str " is not a macro\n")) (Types.Atom (Types.UnboundSym "shen.a")) - appl_1 `pseq` simpleError appl_1 - pat_cond_2 kl_V1608 kl_V1608h kl_V1608t = do return (Types.Atom (Types.N (Types.KI 1))) - pat_cond_3 kl_V1608 kl_V1608h kl_V1608t = do !appl_4 <- kl_V1607 `pseq` (kl_V1608t `pseq` kl_shen_findpos kl_V1607 kl_V1608t) - appl_4 `pseq` add (Types.Atom (Types.N (Types.KI 1))) appl_4 - pat_cond_5 = do do kl_shen_f_error (ApplC (wrapNamed "shen.findpos" kl_shen_findpos)) - in case kl_V1608 of - kl_V1608@(Atom (Nil)) -> pat_cond_0 - !(kl_V1608@(Cons (!kl_V1608h) - (!kl_V1608t))) | eqCore kl_V1608h kl_V1607 -> pat_cond_2 kl_V1608 kl_V1608h kl_V1608t - !(kl_V1608@(Cons (!kl_V1608h) - (!kl_V1608t))) -> pat_cond_3 kl_V1608 kl_V1608h kl_V1608t - _ -> pat_cond_5 - -kl_shen_remove_nth :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_remove_nth (!kl_V1613) (!kl_V1614) = do !kl_if_0 <- let pat_cond_1 = do let pat_cond_2 kl_V1614 kl_V1614h kl_V1614t = do return (Atom (B True)) - pat_cond_3 = do do return (Atom (B False)) - in case kl_V1614 of - !(kl_V1614@(Cons (!kl_V1614h) - (!kl_V1614t))) -> pat_cond_2 kl_V1614 kl_V1614h kl_V1614t - _ -> pat_cond_3 - pat_cond_4 = do do return (Atom (B False)) - in case kl_V1613 of - kl_V1613@(Atom (N (KI 1))) -> pat_cond_1 - _ -> pat_cond_4 - case kl_if_0 of - Atom (B (True)) -> do kl_V1614 `pseq` tl kl_V1614 - Atom (B (False)) -> do let pat_cond_5 kl_V1614 kl_V1614h kl_V1614t = do !appl_6 <- kl_V1613 `pseq` Primitives.subtract kl_V1613 (Types.Atom (Types.N (Types.KI 1))) - !appl_7 <- appl_6 `pseq` (kl_V1614t `pseq` kl_shen_remove_nth appl_6 kl_V1614t) - kl_V1614h `pseq` (appl_7 `pseq` klCons kl_V1614h appl_7) - pat_cond_8 = do do kl_shen_f_error (ApplC (wrapNamed "shen.remove-nth" kl_shen_remove_nth)) - in case kl_V1614 of - !(kl_V1614@(Cons (!kl_V1614h) - (!kl_V1614t))) -> pat_cond_5 kl_V1614 kl_V1614h kl_V1614t - _ -> pat_cond_8 - _ -> throwError "if: expected boolean" - -expr10 :: Types.KLContext Types.Env Types.KLValue -expr10 = 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"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Macros where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel +import Backend.Core +import Backend.Sys +import Backend.Sequent +import Backend.Yacc +import Backend.Reader +import Backend.Prolog +import Backend.Track +import Backend.Load +import Backend.Writer + +{- +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_macroexpand :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_macroexpand (!kl_V1529) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do !kl_if_1 <- kl_V1529 `pseq` (kl_Y `pseq` eq kl_V1529 kl_Y) + case kl_if_1 of + Atom (B (True)) -> do return kl_V1529 + Atom (B (False)) -> do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_macroexpand kl_Z))) + appl_2 `pseq` (kl_Y `pseq` kl_shen_walk appl_2 kl_Y) + _ -> throwError "if: expected boolean"))) + !appl_3 <- value (Core.Types.Atom (Core.Types.UnboundSym "*macros*")) + !appl_4 <- appl_3 `pseq` (kl_V1529 `pseq` kl_shen_compose appl_3 kl_V1529) + appl_4 `pseq` applyWrapper appl_0 [appl_4] + +kl_shen_error_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_error_macro (!kl_V1531) = do let pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt = do !appl_1 <- kl_V1531th `pseq` (kl_V1531tt `pseq` kl_shen_mkstr kl_V1531th kl_V1531tt) + let !appl_2 = Atom Nil + !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) + appl_3 `pseq` klCons (ApplC (wrapNamed "simple-error" simpleError)) appl_3 + pat_cond_4 = do do return kl_V1531 + in case kl_V1531 of + !(kl_V1531@(Cons (Atom (UnboundSym "error")) + (!(kl_V1531t@(Cons (!kl_V1531th) + (!kl_V1531tt)))))) -> pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt + !(kl_V1531@(Cons (ApplC (PL "error" _)) + (!(kl_V1531t@(Cons (!kl_V1531th) + (!kl_V1531tt)))))) -> pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt + !(kl_V1531@(Cons (ApplC (Func "error" _)) + (!(kl_V1531t@(Cons (!kl_V1531th) + (!kl_V1531tt)))))) -> pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt + _ -> pat_cond_4 + +kl_shen_output_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_output_macro (!kl_V1533) = do let pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt = do !appl_1 <- kl_V1533th `pseq` (kl_V1533tt `pseq` kl_shen_mkstr kl_V1533th kl_V1533tt) + let !appl_2 = Atom Nil + !appl_3 <- appl_2 `pseq` klCons (ApplC (PL "stoutput" kl_stoutput)) appl_2 + let !appl_4 = Atom Nil + !appl_5 <- appl_3 `pseq` (appl_4 `pseq` klCons appl_3 appl_4) + !appl_6 <- appl_1 `pseq` (appl_5 `pseq` klCons appl_1 appl_5) + appl_6 `pseq` klCons (ApplC (wrapNamed "shen.prhush" kl_shen_prhush)) appl_6 + pat_cond_7 = do !kl_if_8 <- let pat_cond_9 kl_V1533 kl_V1533h kl_V1533t = do !kl_if_10 <- let pat_cond_11 = do !kl_if_12 <- let pat_cond_13 kl_V1533t kl_V1533th kl_V1533tt = do let !appl_14 = Atom Nil + !kl_if_15 <- appl_14 `pseq` (kl_V1533tt `pseq` eq appl_14 kl_V1533tt) + 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" + pat_cond_16 = do do return (Atom (B False)) + in case kl_V1533t of + !(kl_V1533t@(Cons (!kl_V1533th) + (!kl_V1533tt))) -> pat_cond_13 kl_V1533t kl_V1533th kl_V1533tt + _ -> pat_cond_16 + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_17 = do do return (Atom (B False)) + in case kl_V1533h of + kl_V1533h@(Atom (UnboundSym "pr")) -> pat_cond_11 + kl_V1533h@(ApplC (PL "pr" + _)) -> pat_cond_11 + kl_V1533h@(ApplC (Func "pr" + _)) -> pat_cond_11 + _ -> pat_cond_17 + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_18 = do do return (Atom (B False)) + in case kl_V1533 of + !(kl_V1533@(Cons (!kl_V1533h) + (!kl_V1533t))) -> pat_cond_9 kl_V1533 kl_V1533h kl_V1533t + _ -> pat_cond_18 + case kl_if_8 of + Atom (B (True)) -> do !appl_19 <- kl_V1533 `pseq` tl kl_V1533 + !appl_20 <- appl_19 `pseq` hd appl_19 + let !appl_21 = Atom Nil + !appl_22 <- appl_21 `pseq` klCons (ApplC (PL "stoutput" kl_stoutput)) appl_21 + let !appl_23 = Atom Nil + !appl_24 <- appl_22 `pseq` (appl_23 `pseq` klCons appl_22 appl_23) + !appl_25 <- appl_20 `pseq` (appl_24 `pseq` klCons appl_20 appl_24) + appl_25 `pseq` klCons (ApplC (wrapNamed "pr" kl_pr)) appl_25 + Atom (B (False)) -> do do return kl_V1533 + _ -> throwError "if: expected boolean" + in case kl_V1533 of + !(kl_V1533@(Cons (Atom (UnboundSym "output")) + (!(kl_V1533t@(Cons (!kl_V1533th) + (!kl_V1533tt)))))) -> pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt + !(kl_V1533@(Cons (ApplC (PL "output" _)) + (!(kl_V1533t@(Cons (!kl_V1533th) + (!kl_V1533tt)))))) -> pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt + !(kl_V1533@(Cons (ApplC (Func "output" _)) + (!(kl_V1533t@(Cons (!kl_V1533th) + (!kl_V1533tt)))))) -> pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt + _ -> pat_cond_7 + +kl_shen_make_string_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_make_string_macro (!kl_V1535) = do let pat_cond_0 kl_V1535 kl_V1535t kl_V1535th kl_V1535tt = do kl_V1535th `pseq` (kl_V1535tt `pseq` kl_shen_mkstr kl_V1535th kl_V1535tt) + pat_cond_1 = do do return kl_V1535 + in case kl_V1535 of + !(kl_V1535@(Cons (Atom (UnboundSym "make-string")) + (!(kl_V1535t@(Cons (!kl_V1535th) + (!kl_V1535tt)))))) -> pat_cond_0 kl_V1535 kl_V1535t kl_V1535th kl_V1535tt + !(kl_V1535@(Cons (ApplC (PL "make-string" _)) + (!(kl_V1535t@(Cons (!kl_V1535th) + (!kl_V1535tt)))))) -> pat_cond_0 kl_V1535 kl_V1535t kl_V1535th kl_V1535tt + !(kl_V1535@(Cons (ApplC (Func "make-string" _)) + (!(kl_V1535t@(Cons (!kl_V1535th) + (!kl_V1535tt)))))) -> pat_cond_0 kl_V1535 kl_V1535t kl_V1535th kl_V1535tt + _ -> pat_cond_1 + +kl_shen_input_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_input_macro (!kl_V1537) = do !kl_if_0 <- let pat_cond_1 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_2 <- let pat_cond_3 = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V1537t `pseq` eq appl_4 kl_V1537t) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V1537h of + kl_V1537h@(Atom (UnboundSym "lineread")) -> pat_cond_3 + kl_V1537h@(ApplC (PL "lineread" + _)) -> pat_cond_3 + kl_V1537h@(ApplC (Func "lineread" + _)) -> pat_cond_3 + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V1537 of + !(kl_V1537@(Cons (!kl_V1537h) + (!kl_V1537t))) -> pat_cond_1 kl_V1537 kl_V1537h kl_V1537t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do let !appl_8 = Atom Nil + !appl_9 <- appl_8 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_8 + let !appl_10 = Atom Nil + !appl_11 <- appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) + appl_11 `pseq` klCons (ApplC (wrapNamed "lineread" kl_lineread)) appl_11 + Atom (B (False)) -> do !kl_if_12 <- let pat_cond_13 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_14 <- let pat_cond_15 = do let !appl_16 = Atom Nil + !kl_if_17 <- appl_16 `pseq` (kl_V1537t `pseq` eq appl_16 kl_V1537t) + case kl_if_17 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_18 = do do return (Atom (B False)) + in case kl_V1537h of + kl_V1537h@(Atom (UnboundSym "input")) -> pat_cond_15 + kl_V1537h@(ApplC (PL "input" + _)) -> pat_cond_15 + kl_V1537h@(ApplC (Func "input" + _)) -> pat_cond_15 + _ -> pat_cond_18 + case kl_if_14 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_19 = do do return (Atom (B False)) + in case kl_V1537 of + !(kl_V1537@(Cons (!kl_V1537h) + (!kl_V1537t))) -> pat_cond_13 kl_V1537 kl_V1537h kl_V1537t + _ -> pat_cond_19 + case kl_if_12 of + Atom (B (True)) -> do let !appl_20 = Atom Nil + !appl_21 <- appl_20 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_20 + let !appl_22 = Atom Nil + !appl_23 <- appl_21 `pseq` (appl_22 `pseq` klCons appl_21 appl_22) + appl_23 `pseq` klCons (ApplC (wrapNamed "input" kl_input)) appl_23 + Atom (B (False)) -> do !kl_if_24 <- let pat_cond_25 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_26 <- let pat_cond_27 = do let !appl_28 = Atom Nil + !kl_if_29 <- appl_28 `pseq` (kl_V1537t `pseq` eq appl_28 kl_V1537t) + case kl_if_29 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_30 = do do return (Atom (B False)) + in case kl_V1537h of + kl_V1537h@(Atom (UnboundSym "read")) -> pat_cond_27 + kl_V1537h@(ApplC (PL "read" + _)) -> pat_cond_27 + kl_V1537h@(ApplC (Func "read" + _)) -> pat_cond_27 + _ -> pat_cond_30 + case kl_if_26 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_31 = do do return (Atom (B False)) + in case kl_V1537 of + !(kl_V1537@(Cons (!kl_V1537h) + (!kl_V1537t))) -> pat_cond_25 kl_V1537 kl_V1537h kl_V1537t + _ -> pat_cond_31 + case kl_if_24 of + Atom (B (True)) -> do let !appl_32 = Atom Nil + !appl_33 <- appl_32 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_32 + let !appl_34 = Atom Nil + !appl_35 <- appl_33 `pseq` (appl_34 `pseq` klCons appl_33 appl_34) + appl_35 `pseq` klCons (ApplC (wrapNamed "read" kl_read)) appl_35 + Atom (B (False)) -> do !kl_if_36 <- let pat_cond_37 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_38 <- let pat_cond_39 = do !kl_if_40 <- let pat_cond_41 kl_V1537t kl_V1537th kl_V1537tt = do let !appl_42 = Atom Nil + !kl_if_43 <- appl_42 `pseq` (kl_V1537tt `pseq` eq appl_42 kl_V1537tt) + case kl_if_43 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_44 = do do return (Atom (B False)) + in case kl_V1537t of + !(kl_V1537t@(Cons (!kl_V1537th) + (!kl_V1537tt))) -> pat_cond_41 kl_V1537t kl_V1537th kl_V1537tt + _ -> pat_cond_44 + case kl_if_40 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_45 = do do return (Atom (B False)) + in case kl_V1537h of + kl_V1537h@(Atom (UnboundSym "input+")) -> pat_cond_39 + kl_V1537h@(ApplC (PL "input+" + _)) -> pat_cond_39 + kl_V1537h@(ApplC (Func "input+" + _)) -> pat_cond_39 + _ -> pat_cond_45 + case kl_if_38 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_46 = do do return (Atom (B False)) + in case kl_V1537 of + !(kl_V1537@(Cons (!kl_V1537h) + (!kl_V1537t))) -> pat_cond_37 kl_V1537 kl_V1537h kl_V1537t + _ -> pat_cond_46 + case kl_if_36 of + Atom (B (True)) -> do !appl_47 <- kl_V1537 `pseq` tl kl_V1537 + !appl_48 <- appl_47 `pseq` hd appl_47 + let !appl_49 = Atom Nil + !appl_50 <- appl_49 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_49 + let !appl_51 = Atom Nil + !appl_52 <- appl_50 `pseq` (appl_51 `pseq` klCons appl_50 appl_51) + !appl_53 <- appl_48 `pseq` (appl_52 `pseq` klCons appl_48 appl_52) + appl_53 `pseq` klCons (ApplC (wrapNamed "input+" kl_inputPlus)) appl_53 + Atom (B (False)) -> do !kl_if_54 <- let pat_cond_55 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_56 <- let pat_cond_57 = do let !appl_58 = Atom Nil + !kl_if_59 <- appl_58 `pseq` (kl_V1537t `pseq` eq appl_58 kl_V1537t) + case kl_if_59 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_60 = do do return (Atom (B False)) + in case kl_V1537h of + kl_V1537h@(Atom (UnboundSym "read-byte")) -> pat_cond_57 + kl_V1537h@(ApplC (PL "read-byte" + _)) -> pat_cond_57 + kl_V1537h@(ApplC (Func "read-byte" + _)) -> pat_cond_57 + _ -> pat_cond_60 + case kl_if_56 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_61 = do do return (Atom (B False)) + in case kl_V1537 of + !(kl_V1537@(Cons (!kl_V1537h) + (!kl_V1537t))) -> pat_cond_55 kl_V1537 kl_V1537h kl_V1537t + _ -> pat_cond_61 + case kl_if_54 of + Atom (B (True)) -> do let !appl_62 = Atom Nil + !appl_63 <- appl_62 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_62 + let !appl_64 = Atom Nil + !appl_65 <- appl_63 `pseq` (appl_64 `pseq` klCons appl_63 appl_64) + appl_65 `pseq` klCons (ApplC (wrapNamed "read-byte" readByte)) appl_65 + Atom (B (False)) -> do !kl_if_66 <- let pat_cond_67 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_68 <- let pat_cond_69 = do let !appl_70 = Atom Nil + !kl_if_71 <- appl_70 `pseq` (kl_V1537t `pseq` eq appl_70 kl_V1537t) + case kl_if_71 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_72 = do do return (Atom (B False)) + in case kl_V1537h of + kl_V1537h@(Atom (UnboundSym "read-char-code")) -> pat_cond_69 + kl_V1537h@(ApplC (PL "read-char-code" + _)) -> pat_cond_69 + kl_V1537h@(ApplC (Func "read-char-code" + _)) -> pat_cond_69 + _ -> pat_cond_72 + case kl_if_68 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_73 = do do return (Atom (B False)) + in case kl_V1537 of + !(kl_V1537@(Cons (!kl_V1537h) + (!kl_V1537t))) -> pat_cond_67 kl_V1537 kl_V1537h kl_V1537t + _ -> pat_cond_73 + case kl_if_66 of + Atom (B (True)) -> do let !appl_74 = Atom Nil + !appl_75 <- appl_74 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_74 + let !appl_76 = Atom Nil + !appl_77 <- appl_75 `pseq` (appl_76 `pseq` klCons appl_75 appl_76) + appl_77 `pseq` klCons (ApplC (wrapNamed "read-char-code" kl_read_char_code)) appl_77 + Atom (B (False)) -> do do return kl_V1537 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_compose :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_compose (!kl_V1540) (!kl_V1541) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1540 `pseq` eq appl_0 kl_V1540) + case kl_if_1 of + Atom (B (True)) -> do return kl_V1541 + Atom (B (False)) -> do let pat_cond_2 kl_V1540 kl_V1540h kl_V1540t = do !appl_3 <- kl_V1541 `pseq` applyWrapper kl_V1540h [kl_V1541] + kl_V1540t `pseq` (appl_3 `pseq` kl_shen_compose kl_V1540t appl_3) + pat_cond_4 = do do kl_shen_f_error (ApplC (wrapNamed "shen.compose" kl_shen_compose)) + in case kl_V1540 of + !(kl_V1540@(Cons (!kl_V1540h) + (!kl_V1540t))) -> pat_cond_2 kl_V1540 kl_V1540h kl_V1540t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_shen_compile_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_compile_macro (!kl_V1543) = do !kl_if_0 <- let pat_cond_1 kl_V1543 kl_V1543h kl_V1543t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V1543t kl_V1543th kl_V1543tt = do !kl_if_6 <- let pat_cond_7 kl_V1543tt kl_V1543tth kl_V1543ttt = do let !appl_8 = Atom Nil + !kl_if_9 <- appl_8 `pseq` (kl_V1543ttt `pseq` eq appl_8 kl_V1543ttt) + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_10 = do do return (Atom (B False)) + in case kl_V1543tt of + !(kl_V1543tt@(Cons (!kl_V1543tth) + (!kl_V1543ttt))) -> pat_cond_7 kl_V1543tt kl_V1543tth kl_V1543ttt + _ -> pat_cond_10 + case kl_if_6 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_11 = do do return (Atom (B False)) + in case kl_V1543t of + !(kl_V1543t@(Cons (!kl_V1543th) + (!kl_V1543tt))) -> pat_cond_5 kl_V1543t kl_V1543th kl_V1543tt + _ -> pat_cond_11 + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V1543h of + kl_V1543h@(Atom (UnboundSym "compile")) -> pat_cond_3 + kl_V1543h@(ApplC (PL "compile" + _)) -> pat_cond_3 + kl_V1543h@(ApplC (Func "compile" + _)) -> pat_cond_3 + _ -> pat_cond_12 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_13 = do do return (Atom (B False)) + in case kl_V1543 of + !(kl_V1543@(Cons (!kl_V1543h) + (!kl_V1543t))) -> pat_cond_1 kl_V1543 kl_V1543h kl_V1543t + _ -> pat_cond_13 + case kl_if_0 of + Atom (B (True)) -> do !appl_14 <- kl_V1543 `pseq` tl kl_V1543 + !appl_15 <- appl_14 `pseq` hd appl_14 + !appl_16 <- kl_V1543 `pseq` tl kl_V1543 + !appl_17 <- appl_16 `pseq` tl appl_16 + !appl_18 <- appl_17 `pseq` hd appl_17 + let !appl_19 = Atom Nil + !appl_20 <- appl_19 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "E")) appl_19 + !appl_21 <- appl_20 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_20 + let !appl_22 = Atom Nil + !appl_23 <- appl_22 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "E")) appl_22 + !appl_24 <- appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.Str "parse error here: ~S~%")) appl_23 + !appl_25 <- appl_24 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "error")) appl_24 + let !appl_26 = Atom Nil + !appl_27 <- appl_26 `pseq` klCons (Core.Types.Atom (Core.Types.Str "parse error~%")) appl_26 + !appl_28 <- appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "error")) appl_27 + let !appl_29 = Atom Nil + !appl_30 <- appl_28 `pseq` (appl_29 `pseq` klCons appl_28 appl_29) + !appl_31 <- appl_25 `pseq` (appl_30 `pseq` klCons appl_25 appl_30) + !appl_32 <- appl_21 `pseq` (appl_31 `pseq` klCons appl_21 appl_31) + !appl_33 <- appl_32 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_32 + let !appl_34 = Atom Nil + !appl_35 <- appl_33 `pseq` (appl_34 `pseq` klCons appl_33 appl_34) + !appl_36 <- appl_35 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "E")) appl_35 + !appl_37 <- appl_36 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_36 + let !appl_38 = Atom Nil + !appl_39 <- appl_37 `pseq` (appl_38 `pseq` klCons appl_37 appl_38) + !appl_40 <- appl_18 `pseq` (appl_39 `pseq` klCons appl_18 appl_39) + !appl_41 <- appl_15 `pseq` (appl_40 `pseq` klCons appl_15 appl_40) + appl_41 `pseq` klCons (ApplC (wrapNamed "compile" kl_compile)) appl_41 + Atom (B (False)) -> do do return kl_V1543 + _ -> throwError "if: expected boolean" + +kl_shen_prolog_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_prolog_macro (!kl_V1545) = do let pat_cond_0 kl_V1545 kl_V1545t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_F) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Receive) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_PrologDef) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Query) -> do return kl_Query))) + let !appl_5 = Atom Nil + !appl_6 <- appl_5 `pseq` klCons (ApplC (PL "shen.start-new-prolog-process" kl_shen_start_new_prolog_process)) appl_5 + let !appl_7 = Atom Nil + !appl_8 <- appl_7 `pseq` klCons (Atom (B True)) appl_7 + !appl_9 <- appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "freeze")) appl_8 + let !appl_10 = Atom Nil + !appl_11 <- appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) + !appl_12 <- appl_6 `pseq` (appl_11 `pseq` klCons appl_6 appl_11) + !appl_13 <- kl_Receive `pseq` (appl_12 `pseq` kl_append kl_Receive appl_12) + !appl_14 <- kl_F `pseq` (appl_13 `pseq` klCons kl_F appl_13) + appl_14 `pseq` applyWrapper appl_4 [appl_14]))) + let !appl_15 = Atom Nil + !appl_16 <- kl_F `pseq` (appl_15 `pseq` klCons kl_F appl_15) + !appl_17 <- appl_16 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defprolog")) appl_16 + let !appl_18 = Atom Nil + !appl_19 <- appl_18 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "<--")) appl_18 + !appl_20 <- kl_V1545t `pseq` kl_shen_pass_literals kl_V1545t + let !appl_21 = Atom Nil + !appl_22 <- appl_21 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ";")) appl_21 + !appl_23 <- appl_20 `pseq` (appl_22 `pseq` kl_append appl_20 appl_22) + !appl_24 <- appl_19 `pseq` (appl_23 `pseq` kl_append appl_19 appl_23) + !appl_25 <- kl_Receive `pseq` (appl_24 `pseq` kl_append kl_Receive appl_24) + !appl_26 <- appl_17 `pseq` (appl_25 `pseq` kl_append appl_17 appl_25) + !appl_27 <- appl_26 `pseq` kl_eval appl_26 + appl_27 `pseq` applyWrapper appl_3 [appl_27]))) + !appl_28 <- kl_V1545t `pseq` kl_shen_receive_terms kl_V1545t + appl_28 `pseq` applyWrapper appl_2 [appl_28]))) + !appl_29 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "shen.f")) + appl_29 `pseq` applyWrapper appl_1 [appl_29] + pat_cond_30 = do do return kl_V1545 + in case kl_V1545 of + !(kl_V1545@(Cons (Atom (UnboundSym "prolog?")) + (!kl_V1545t))) -> pat_cond_0 kl_V1545 kl_V1545t + !(kl_V1545@(Cons (ApplC (PL "prolog?" _)) + (!kl_V1545t))) -> pat_cond_0 kl_V1545 kl_V1545t + !(kl_V1545@(Cons (ApplC (Func "prolog?" _)) + (!kl_V1545t))) -> pat_cond_0 kl_V1545 kl_V1545t + _ -> pat_cond_30 + +kl_shen_receive_terms :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_receive_terms (!kl_V1551) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1551 `pseq` eq appl_0 kl_V1551) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V1551 kl_V1551h kl_V1551t = do !kl_if_4 <- let pat_cond_5 kl_V1551h kl_V1551hh kl_V1551ht = do !kl_if_6 <- let pat_cond_7 = do !kl_if_8 <- let pat_cond_9 kl_V1551ht kl_V1551hth kl_V1551htt = do let !appl_10 = Atom Nil + !kl_if_11 <- appl_10 `pseq` (kl_V1551htt `pseq` eq appl_10 kl_V1551htt) + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V1551ht of + !(kl_V1551ht@(Cons (!kl_V1551hth) + (!kl_V1551htt))) -> pat_cond_9 kl_V1551ht kl_V1551hth kl_V1551htt + _ -> 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_V1551hh of + kl_V1551hh@(Atom (UnboundSym "receive")) -> pat_cond_7 + kl_V1551hh@(ApplC (PL "receive" + _)) -> pat_cond_7 + kl_V1551hh@(ApplC (Func "receive" + _)) -> pat_cond_7 + _ -> pat_cond_13 + case kl_if_6 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_14 = do do return (Atom (B False)) + in case kl_V1551h of + !(kl_V1551h@(Cons (!kl_V1551hh) + (!kl_V1551ht))) -> pat_cond_5 kl_V1551h kl_V1551hh kl_V1551ht + _ -> 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_V1551 of + !(kl_V1551@(Cons (!kl_V1551h) + (!kl_V1551t))) -> pat_cond_3 kl_V1551 kl_V1551h kl_V1551t + _ -> pat_cond_15 + case kl_if_2 of + Atom (B (True)) -> do !appl_16 <- kl_V1551 `pseq` hd kl_V1551 + !appl_17 <- appl_16 `pseq` tl appl_16 + !appl_18 <- appl_17 `pseq` hd appl_17 + !appl_19 <- kl_V1551 `pseq` tl kl_V1551 + !appl_20 <- appl_19 `pseq` kl_shen_receive_terms appl_19 + appl_18 `pseq` (appl_20 `pseq` klCons appl_18 appl_20) + Atom (B (False)) -> do let pat_cond_21 kl_V1551 kl_V1551h kl_V1551t = do kl_V1551t `pseq` kl_shen_receive_terms kl_V1551t + pat_cond_22 = do do kl_shen_f_error (ApplC (wrapNamed "shen.receive-terms" kl_shen_receive_terms)) + in case kl_V1551 of + !(kl_V1551@(Cons (!kl_V1551h) + (!kl_V1551t))) -> pat_cond_21 kl_V1551 kl_V1551h kl_V1551t + _ -> pat_cond_22 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_pass_literals :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_pass_literals (!kl_V1555) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1555 `pseq` eq appl_0 kl_V1555) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V1555 kl_V1555h kl_V1555t = do !kl_if_4 <- let pat_cond_5 kl_V1555h kl_V1555hh kl_V1555ht = do !kl_if_6 <- let pat_cond_7 = do !kl_if_8 <- let pat_cond_9 kl_V1555ht kl_V1555hth kl_V1555htt = do let !appl_10 = Atom Nil + !kl_if_11 <- appl_10 `pseq` (kl_V1555htt `pseq` eq appl_10 kl_V1555htt) + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V1555ht of + !(kl_V1555ht@(Cons (!kl_V1555hth) + (!kl_V1555htt))) -> pat_cond_9 kl_V1555ht kl_V1555hth kl_V1555htt + _ -> 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_V1555hh of + kl_V1555hh@(Atom (UnboundSym "receive")) -> pat_cond_7 + kl_V1555hh@(ApplC (PL "receive" + _)) -> pat_cond_7 + kl_V1555hh@(ApplC (Func "receive" + _)) -> pat_cond_7 + _ -> pat_cond_13 + case kl_if_6 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_14 = do do return (Atom (B False)) + in case kl_V1555h of + !(kl_V1555h@(Cons (!kl_V1555hh) + (!kl_V1555ht))) -> pat_cond_5 kl_V1555h kl_V1555hh kl_V1555ht + _ -> 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_V1555 of + !(kl_V1555@(Cons (!kl_V1555h) + (!kl_V1555t))) -> pat_cond_3 kl_V1555 kl_V1555h kl_V1555t + _ -> pat_cond_15 + case kl_if_2 of + Atom (B (True)) -> do !appl_16 <- kl_V1555 `pseq` tl kl_V1555 + appl_16 `pseq` kl_shen_pass_literals appl_16 + Atom (B (False)) -> do let pat_cond_17 kl_V1555 kl_V1555h kl_V1555t = do !appl_18 <- kl_V1555t `pseq` kl_shen_pass_literals kl_V1555t + kl_V1555h `pseq` (appl_18 `pseq` klCons kl_V1555h appl_18) + pat_cond_19 = do do kl_shen_f_error (ApplC (wrapNamed "shen.pass-literals" kl_shen_pass_literals)) + in case kl_V1555 of + !(kl_V1555@(Cons (!kl_V1555h) + (!kl_V1555t))) -> pat_cond_17 kl_V1555 kl_V1555h kl_V1555t + _ -> pat_cond_19 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_defprolog_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_defprolog_macro (!kl_V1557) = do let pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do kl_Y `pseq` kl_shen_LBdefprologRB kl_Y))) + let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do kl_V1557th `pseq` (kl_Y `pseq` kl_shen_prolog_error kl_V1557th kl_Y)))) + appl_1 `pseq` (kl_V1557t `pseq` (appl_2 `pseq` kl_compile appl_1 kl_V1557t appl_2)) + pat_cond_3 = do do return kl_V1557 + in case kl_V1557 of + !(kl_V1557@(Cons (Atom (UnboundSym "defprolog")) + (!(kl_V1557t@(Cons (!kl_V1557th) + (!kl_V1557tt)))))) -> pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt + !(kl_V1557@(Cons (ApplC (PL "defprolog" _)) + (!(kl_V1557t@(Cons (!kl_V1557th) + (!kl_V1557tt)))))) -> pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt + !(kl_V1557@(Cons (ApplC (Func "defprolog" _)) + (!(kl_V1557t@(Cons (!kl_V1557th) + (!kl_V1557tt)))))) -> pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt + _ -> pat_cond_3 + +kl_shen_datatype_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_datatype_macro (!kl_V1559) = do let pat_cond_0 kl_V1559 kl_V1559t kl_V1559th kl_V1559tt = do !appl_1 <- kl_V1559th `pseq` kl_shen_intern_type kl_V1559th + let !appl_2 = Atom Nil + !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_2 + !appl_4 <- appl_3 `pseq` klCons (ApplC (wrapNamed "shen." kl_shen_LBdatatype_rulesRB)) appl_3 + let !appl_5 = Atom Nil + !appl_6 <- appl_4 `pseq` (appl_5 `pseq` klCons appl_4 appl_5) + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_6 + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_7 + !appl_9 <- kl_V1559tt `pseq` kl_shen_rcons_form kl_V1559tt + let !appl_10 = Atom Nil + !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "shen.datatype-error" kl_shen_datatype_error)) appl_10 + !appl_12 <- appl_11 `pseq` klCons (ApplC (wrapNamed "function" kl_function)) appl_11 + let !appl_13 = Atom Nil + !appl_14 <- appl_12 `pseq` (appl_13 `pseq` klCons appl_12 appl_13) + !appl_15 <- appl_9 `pseq` (appl_14 `pseq` klCons appl_9 appl_14) + !appl_16 <- appl_8 `pseq` (appl_15 `pseq` klCons appl_8 appl_15) + !appl_17 <- appl_16 `pseq` klCons (ApplC (wrapNamed "compile" kl_compile)) appl_16 + let !appl_18 = Atom Nil + !appl_19 <- appl_17 `pseq` (appl_18 `pseq` klCons appl_17 appl_18) + !appl_20 <- appl_1 `pseq` (appl_19 `pseq` klCons appl_1 appl_19) + appl_20 `pseq` klCons (ApplC (wrapNamed "shen.process-datatype" kl_shen_process_datatype)) appl_20 + pat_cond_21 = do do return kl_V1559 + in case kl_V1559 of + !(kl_V1559@(Cons (Atom (UnboundSym "datatype")) + (!(kl_V1559t@(Cons (!kl_V1559th) + (!kl_V1559tt)))))) -> pat_cond_0 kl_V1559 kl_V1559t kl_V1559th kl_V1559tt + !(kl_V1559@(Cons (ApplC (PL "datatype" _)) + (!(kl_V1559t@(Cons (!kl_V1559th) + (!kl_V1559tt)))))) -> pat_cond_0 kl_V1559 kl_V1559t kl_V1559th kl_V1559tt + !(kl_V1559@(Cons (ApplC (Func "datatype" _)) + (!(kl_V1559t@(Cons (!kl_V1559th) + (!kl_V1559tt)))))) -> pat_cond_0 kl_V1559 kl_V1559t kl_V1559th kl_V1559tt + _ -> pat_cond_21 + +kl_shen_intern_type :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_intern_type (!kl_V1561) = do !appl_0 <- kl_V1561 `pseq` str kl_V1561 + !appl_1 <- appl_0 `pseq` cn (Core.Types.Atom (Core.Types.Str "type#")) appl_0 + appl_1 `pseq` intern appl_1 + +kl_shen_Ats_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_Ats_macro (!kl_V1563) = do let pat_cond_0 kl_V1563 kl_V1563t kl_V1563th kl_V1563tt kl_V1563tth kl_V1563ttt kl_V1563ttth kl_V1563tttt = do !appl_1 <- kl_V1563tt `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) kl_V1563tt + !appl_2 <- appl_1 `pseq` kl_shen_Ats_macro appl_1 + let !appl_3 = Atom Nil + !appl_4 <- appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) + !appl_5 <- kl_V1563th `pseq` (appl_4 `pseq` klCons kl_V1563th appl_4) + appl_5 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_5 + pat_cond_6 = do !kl_if_7 <- let pat_cond_8 kl_V1563 kl_V1563h kl_V1563t = do !kl_if_9 <- let pat_cond_10 = do !kl_if_11 <- let pat_cond_12 kl_V1563t kl_V1563th kl_V1563tt = do !kl_if_13 <- let pat_cond_14 kl_V1563tt kl_V1563tth kl_V1563ttt = do let !appl_15 = Atom Nil + !kl_if_16 <- appl_15 `pseq` (kl_V1563ttt `pseq` eq appl_15 kl_V1563ttt) + !kl_if_17 <- case kl_if_16 of + Atom (B (True)) -> do !kl_if_18 <- kl_V1563th `pseq` stringP kl_V1563th + case kl_if_18 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_17 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_19 = do do return (Atom (B False)) + in case kl_V1563tt of + !(kl_V1563tt@(Cons (!kl_V1563tth) + (!kl_V1563ttt))) -> pat_cond_14 kl_V1563tt kl_V1563tth kl_V1563ttt + _ -> pat_cond_19 + 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_20 = do do return (Atom (B False)) + in case kl_V1563t of + !(kl_V1563t@(Cons (!kl_V1563th) + (!kl_V1563tt))) -> pat_cond_12 kl_V1563t kl_V1563th kl_V1563tt + _ -> pat_cond_20 + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_21 = do do return (Atom (B False)) + in case kl_V1563h of + kl_V1563h@(Atom (UnboundSym "@s")) -> pat_cond_10 + kl_V1563h@(ApplC (PL "@s" + _)) -> pat_cond_10 + kl_V1563h@(ApplC (Func "@s" + _)) -> pat_cond_10 + _ -> pat_cond_21 + 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_22 = do do return (Atom (B False)) + in case kl_V1563 of + !(kl_V1563@(Cons (!kl_V1563h) + (!kl_V1563t))) -> pat_cond_8 kl_V1563 kl_V1563h kl_V1563t + _ -> pat_cond_22 + case kl_if_7 of + Atom (B (True)) -> do let !appl_23 = ApplC (Func "lambda" (Context (\(!kl_E) -> do !appl_24 <- kl_E `pseq` kl_length kl_E + !kl_if_25 <- appl_24 `pseq` greaterThan appl_24 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + case kl_if_25 of + Atom (B (True)) -> do !appl_26 <- kl_V1563 `pseq` tl kl_V1563 + !appl_27 <- appl_26 `pseq` tl appl_26 + !appl_28 <- kl_E `pseq` (appl_27 `pseq` kl_append kl_E appl_27) + !appl_29 <- appl_28 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_28 + appl_29 `pseq` kl_shen_Ats_macro appl_29 + Atom (B (False)) -> do do return kl_V1563 + _ -> throwError "if: expected boolean"))) + !appl_30 <- kl_V1563 `pseq` tl kl_V1563 + !appl_31 <- appl_30 `pseq` hd appl_30 + !appl_32 <- appl_31 `pseq` kl_explode appl_31 + appl_32 `pseq` applyWrapper appl_23 [appl_32] + Atom (B (False)) -> do do return kl_V1563 + _ -> throwError "if: expected boolean" + in case kl_V1563 of + !(kl_V1563@(Cons (Atom (UnboundSym "@s")) + (!(kl_V1563t@(Cons (!kl_V1563th) + (!(kl_V1563tt@(Cons (!kl_V1563tth) + (!(kl_V1563ttt@(Cons (!kl_V1563ttth) + (!kl_V1563tttt)))))))))))) -> pat_cond_0 kl_V1563 kl_V1563t kl_V1563th kl_V1563tt kl_V1563tth kl_V1563ttt kl_V1563ttth kl_V1563tttt + !(kl_V1563@(Cons (ApplC (PL "@s" _)) + (!(kl_V1563t@(Cons (!kl_V1563th) + (!(kl_V1563tt@(Cons (!kl_V1563tth) + (!(kl_V1563ttt@(Cons (!kl_V1563ttth) + (!kl_V1563tttt)))))))))))) -> pat_cond_0 kl_V1563 kl_V1563t kl_V1563th kl_V1563tt kl_V1563tth kl_V1563ttt kl_V1563ttth kl_V1563tttt + !(kl_V1563@(Cons (ApplC (Func "@s" _)) + (!(kl_V1563t@(Cons (!kl_V1563th) + (!(kl_V1563tt@(Cons (!kl_V1563tth) + (!(kl_V1563ttt@(Cons (!kl_V1563ttth) + (!kl_V1563tttt)))))))))))) -> pat_cond_0 kl_V1563 kl_V1563t kl_V1563th kl_V1563tt kl_V1563tth kl_V1563ttt kl_V1563ttth kl_V1563tttt + _ -> pat_cond_6 + +kl_shen_synonyms_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_synonyms_macro (!kl_V1565) = do let pat_cond_0 kl_V1565 kl_V1565t = do !appl_1 <- kl_V1565t `pseq` kl_shen_curry_synonyms kl_V1565t + !appl_2 <- appl_1 `pseq` kl_shen_rcons_form appl_1 + let !appl_3 = Atom Nil + !appl_4 <- appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) + appl_4 `pseq` klCons (ApplC (wrapNamed "shen.synonyms-help" kl_shen_synonyms_help)) appl_4 + pat_cond_5 = do do return kl_V1565 + in case kl_V1565 of + !(kl_V1565@(Cons (Atom (UnboundSym "synonyms")) + (!kl_V1565t))) -> pat_cond_0 kl_V1565 kl_V1565t + !(kl_V1565@(Cons (ApplC (PL "synonyms" _)) + (!kl_V1565t))) -> pat_cond_0 kl_V1565 kl_V1565t + !(kl_V1565@(Cons (ApplC (Func "synonyms" _)) + (!kl_V1565t))) -> pat_cond_0 kl_V1565 kl_V1565t + _ -> pat_cond_5 + +kl_shen_curry_synonyms :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_curry_synonyms (!kl_V1567) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_curry_type kl_X))) + appl_0 `pseq` (kl_V1567 `pseq` kl_map appl_0 kl_V1567) + +kl_shen_nl_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_nl_macro (!kl_V1569) = do !kl_if_0 <- let pat_cond_1 kl_V1569 kl_V1569h kl_V1569t = do !kl_if_2 <- let pat_cond_3 = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V1569t `pseq` eq appl_4 kl_V1569t) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V1569h of + kl_V1569h@(Atom (UnboundSym "nl")) -> pat_cond_3 + kl_V1569h@(ApplC (PL "nl" + _)) -> pat_cond_3 + kl_V1569h@(ApplC (Func "nl" + _)) -> pat_cond_3 + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V1569 of + !(kl_V1569@(Cons (!kl_V1569h) + (!kl_V1569t))) -> pat_cond_1 kl_V1569 kl_V1569h kl_V1569t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do let !appl_8 = Atom Nil + !appl_9 <- appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_8 + appl_9 `pseq` klCons (ApplC (wrapNamed "nl" kl_nl)) appl_9 + Atom (B (False)) -> do do return kl_V1569 + _ -> throwError "if: expected boolean" + +kl_shen_assoc_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_assoc_macro (!kl_V1571) = do !kl_if_0 <- let pat_cond_1 kl_V1571 kl_V1571h kl_V1571t = do !kl_if_2 <- let pat_cond_3 kl_V1571t kl_V1571th kl_V1571tt = do !kl_if_4 <- let pat_cond_5 kl_V1571tt kl_V1571tth kl_V1571ttt = do !kl_if_6 <- let pat_cond_7 kl_V1571ttt kl_V1571ttth kl_V1571tttt = do let !appl_8 = Atom Nil + !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_8 + !appl_10 <- appl_9 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_9 + !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_10 + !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "or")) appl_11 + !appl_13 <- appl_12 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "and")) appl_12 + !appl_14 <- appl_13 `pseq` klCons (ApplC (wrapNamed "append" kl_append)) appl_13 + !appl_15 <- appl_14 `pseq` klCons (ApplC (wrapNamed "@v" kl_Atv)) appl_14 + !appl_16 <- appl_15 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_15 + !kl_if_17 <- kl_V1571h `pseq` (appl_16 `pseq` kl_elementP kl_V1571h 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" + pat_cond_18 = do do return (Atom (B False)) + in case kl_V1571ttt of + !(kl_V1571ttt@(Cons (!kl_V1571ttth) + (!kl_V1571tttt))) -> pat_cond_7 kl_V1571ttt kl_V1571ttth kl_V1571tttt + _ -> pat_cond_18 + 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_19 = do do return (Atom (B False)) + in case kl_V1571tt of + !(kl_V1571tt@(Cons (!kl_V1571tth) + (!kl_V1571ttt))) -> pat_cond_5 kl_V1571tt kl_V1571tth kl_V1571ttt + _ -> pat_cond_19 + 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_20 = do do return (Atom (B False)) + in case kl_V1571t of + !(kl_V1571t@(Cons (!kl_V1571th) + (!kl_V1571tt))) -> pat_cond_3 kl_V1571t kl_V1571th kl_V1571tt + _ -> pat_cond_20 + 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_21 = do do return (Atom (B False)) + in case kl_V1571 of + !(kl_V1571@(Cons (!kl_V1571h) + (!kl_V1571t))) -> pat_cond_1 kl_V1571 kl_V1571h kl_V1571t + _ -> pat_cond_21 + case kl_if_0 of + Atom (B (True)) -> do !appl_22 <- kl_V1571 `pseq` hd kl_V1571 + !appl_23 <- kl_V1571 `pseq` tl kl_V1571 + !appl_24 <- appl_23 `pseq` hd appl_23 + !appl_25 <- kl_V1571 `pseq` hd kl_V1571 + !appl_26 <- kl_V1571 `pseq` tl kl_V1571 + !appl_27 <- appl_26 `pseq` tl appl_26 + !appl_28 <- appl_25 `pseq` (appl_27 `pseq` klCons appl_25 appl_27) + !appl_29 <- appl_28 `pseq` kl_shen_assoc_macro appl_28 + let !appl_30 = Atom Nil + !appl_31 <- appl_29 `pseq` (appl_30 `pseq` klCons appl_29 appl_30) + !appl_32 <- appl_24 `pseq` (appl_31 `pseq` klCons appl_24 appl_31) + appl_22 `pseq` (appl_32 `pseq` klCons appl_22 appl_32) + Atom (B (False)) -> do do return kl_V1571 + _ -> throwError "if: expected boolean" + +kl_shen_let_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_let_macro (!kl_V1573) = do let pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt kl_V1573tttth kl_V1573ttttt = do !appl_1 <- kl_V1573ttt `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) kl_V1573ttt + !appl_2 <- appl_1 `pseq` kl_shen_let_macro appl_1 + let !appl_3 = Atom Nil + !appl_4 <- appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) + !appl_5 <- kl_V1573tth `pseq` (appl_4 `pseq` klCons kl_V1573tth appl_4) + !appl_6 <- kl_V1573th `pseq` (appl_5 `pseq` klCons kl_V1573th appl_5) + appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_6 + pat_cond_7 = do do return kl_V1573 + in case kl_V1573 of + !(kl_V1573@(Cons (Atom (UnboundSym "let")) + (!(kl_V1573t@(Cons (!kl_V1573th) + (!(kl_V1573tt@(Cons (!kl_V1573tth) + (!(kl_V1573ttt@(Cons (!kl_V1573ttth) + (!(kl_V1573tttt@(Cons (!kl_V1573tttth) + (!kl_V1573ttttt))))))))))))))) -> pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt kl_V1573tttth kl_V1573ttttt + !(kl_V1573@(Cons (ApplC (PL "let" _)) + (!(kl_V1573t@(Cons (!kl_V1573th) + (!(kl_V1573tt@(Cons (!kl_V1573tth) + (!(kl_V1573ttt@(Cons (!kl_V1573ttth) + (!(kl_V1573tttt@(Cons (!kl_V1573tttth) + (!kl_V1573ttttt))))))))))))))) -> pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt kl_V1573tttth kl_V1573ttttt + !(kl_V1573@(Cons (ApplC (Func "let" _)) + (!(kl_V1573t@(Cons (!kl_V1573th) + (!(kl_V1573tt@(Cons (!kl_V1573tth) + (!(kl_V1573ttt@(Cons (!kl_V1573ttth) + (!(kl_V1573tttt@(Cons (!kl_V1573tttth) + (!kl_V1573ttttt))))))))))))))) -> pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt kl_V1573tttth kl_V1573ttttt + _ -> pat_cond_7 + +kl_shen_abs_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_abs_macro (!kl_V1575) = do let pat_cond_0 kl_V1575 kl_V1575t kl_V1575th kl_V1575tt kl_V1575tth kl_V1575ttt kl_V1575ttth kl_V1575tttt = do !appl_1 <- kl_V1575tt `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) kl_V1575tt + !appl_2 <- appl_1 `pseq` kl_shen_abs_macro appl_1 + let !appl_3 = Atom Nil + !appl_4 <- appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) + !appl_5 <- kl_V1575th `pseq` (appl_4 `pseq` klCons kl_V1575th appl_4) + appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_5 + pat_cond_6 = do !kl_if_7 <- let pat_cond_8 kl_V1575 kl_V1575h kl_V1575t = do !kl_if_9 <- let pat_cond_10 = do !kl_if_11 <- let pat_cond_12 kl_V1575t kl_V1575th kl_V1575tt = do !kl_if_13 <- let pat_cond_14 kl_V1575tt kl_V1575tth kl_V1575ttt = do let !appl_15 = Atom Nil + !kl_if_16 <- appl_15 `pseq` (kl_V1575ttt `pseq` eq appl_15 kl_V1575ttt) + case kl_if_16 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_17 = do do return (Atom (B False)) + in case kl_V1575tt of + !(kl_V1575tt@(Cons (!kl_V1575tth) + (!kl_V1575ttt))) -> pat_cond_14 kl_V1575tt kl_V1575tth kl_V1575ttt + _ -> pat_cond_17 + case kl_if_13 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_18 = do do return (Atom (B False)) + in case kl_V1575t of + !(kl_V1575t@(Cons (!kl_V1575th) + (!kl_V1575tt))) -> pat_cond_12 kl_V1575t kl_V1575th kl_V1575tt + _ -> pat_cond_18 + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_19 = do do return (Atom (B False)) + in case kl_V1575h of + kl_V1575h@(Atom (UnboundSym "/.")) -> pat_cond_10 + kl_V1575h@(ApplC (PL "/." + _)) -> pat_cond_10 + kl_V1575h@(ApplC (Func "/." + _)) -> pat_cond_10 + _ -> pat_cond_19 + 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_20 = do do return (Atom (B False)) + in case kl_V1575 of + !(kl_V1575@(Cons (!kl_V1575h) + (!kl_V1575t))) -> pat_cond_8 kl_V1575 kl_V1575h kl_V1575t + _ -> pat_cond_20 + case kl_if_7 of + Atom (B (True)) -> do !appl_21 <- kl_V1575 `pseq` tl kl_V1575 + appl_21 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_21 + Atom (B (False)) -> do do return kl_V1575 + _ -> throwError "if: expected boolean" + in case kl_V1575 of + !(kl_V1575@(Cons (Atom (UnboundSym "/.")) + (!(kl_V1575t@(Cons (!kl_V1575th) + (!(kl_V1575tt@(Cons (!kl_V1575tth) + (!(kl_V1575ttt@(Cons (!kl_V1575ttth) + (!kl_V1575tttt)))))))))))) -> pat_cond_0 kl_V1575 kl_V1575t kl_V1575th kl_V1575tt kl_V1575tth kl_V1575ttt kl_V1575ttth kl_V1575tttt + !(kl_V1575@(Cons (ApplC (PL "/." _)) + (!(kl_V1575t@(Cons (!kl_V1575th) + (!(kl_V1575tt@(Cons (!kl_V1575tth) + (!(kl_V1575ttt@(Cons (!kl_V1575ttth) + (!kl_V1575tttt)))))))))))) -> pat_cond_0 kl_V1575 kl_V1575t kl_V1575th kl_V1575tt kl_V1575tth kl_V1575ttt kl_V1575ttth kl_V1575tttt + !(kl_V1575@(Cons (ApplC (Func "/." _)) + (!(kl_V1575t@(Cons (!kl_V1575th) + (!(kl_V1575tt@(Cons (!kl_V1575tth) + (!(kl_V1575ttt@(Cons (!kl_V1575ttth) + (!kl_V1575tttt)))))))))))) -> pat_cond_0 kl_V1575 kl_V1575t kl_V1575th kl_V1575tt kl_V1575tth kl_V1575ttt kl_V1575ttth kl_V1575tttt + _ -> pat_cond_6 + +kl_shen_cases_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_cases_macro (!kl_V1579) = do let pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt = do return kl_V1579tth + pat_cond_1 = do !kl_if_2 <- let pat_cond_3 kl_V1579 kl_V1579h kl_V1579t = do !kl_if_4 <- let pat_cond_5 = do !kl_if_6 <- let pat_cond_7 kl_V1579t kl_V1579th kl_V1579tt = do !kl_if_8 <- let pat_cond_9 kl_V1579tt kl_V1579tth kl_V1579ttt = do let !appl_10 = Atom Nil + !kl_if_11 <- appl_10 `pseq` (kl_V1579ttt `pseq` eq appl_10 kl_V1579ttt) + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V1579tt of + !(kl_V1579tt@(Cons (!kl_V1579tth) + (!kl_V1579ttt))) -> pat_cond_9 kl_V1579tt kl_V1579tth kl_V1579ttt + _ -> 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_V1579t of + !(kl_V1579t@(Cons (!kl_V1579th) + (!kl_V1579tt))) -> pat_cond_7 kl_V1579t kl_V1579th kl_V1579tt + _ -> 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_V1579h of + kl_V1579h@(Atom (UnboundSym "cases")) -> pat_cond_5 + kl_V1579h@(ApplC (PL "cases" + _)) -> pat_cond_5 + kl_V1579h@(ApplC (Func "cases" + _)) -> 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_V1579 of + !(kl_V1579@(Cons (!kl_V1579h) + (!kl_V1579t))) -> pat_cond_3 kl_V1579 kl_V1579h kl_V1579t + _ -> pat_cond_15 + case kl_if_2 of + Atom (B (True)) -> do !appl_16 <- kl_V1579 `pseq` tl kl_V1579 + !appl_17 <- appl_16 `pseq` hd appl_16 + !appl_18 <- kl_V1579 `pseq` tl kl_V1579 + !appl_19 <- appl_18 `pseq` tl appl_18 + !appl_20 <- appl_19 `pseq` hd appl_19 + let !appl_21 = Atom Nil + !appl_22 <- appl_21 `pseq` klCons (Core.Types.Atom (Core.Types.Str "error: cases exhausted")) appl_21 + !appl_23 <- appl_22 `pseq` klCons (ApplC (wrapNamed "simple-error" simpleError)) appl_22 + let !appl_24 = Atom Nil + !appl_25 <- appl_23 `pseq` (appl_24 `pseq` klCons appl_23 appl_24) + !appl_26 <- appl_20 `pseq` (appl_25 `pseq` klCons appl_20 appl_25) + !appl_27 <- appl_17 `pseq` (appl_26 `pseq` klCons appl_17 appl_26) + appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_27 + Atom (B (False)) -> do let pat_cond_28 kl_V1579 kl_V1579t kl_V1579th kl_V1579tt kl_V1579tth kl_V1579ttt = do !appl_29 <- kl_V1579ttt `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "cases")) kl_V1579ttt + !appl_30 <- appl_29 `pseq` kl_shen_cases_macro appl_29 + let !appl_31 = Atom Nil + !appl_32 <- appl_30 `pseq` (appl_31 `pseq` klCons appl_30 appl_31) + !appl_33 <- kl_V1579tth `pseq` (appl_32 `pseq` klCons kl_V1579tth appl_32) + !appl_34 <- kl_V1579th `pseq` (appl_33 `pseq` klCons kl_V1579th appl_33) + appl_34 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_34 + pat_cond_35 = do !kl_if_36 <- let pat_cond_37 kl_V1579 kl_V1579h kl_V1579t = do !kl_if_38 <- let pat_cond_39 = do !kl_if_40 <- let pat_cond_41 kl_V1579t kl_V1579th kl_V1579tt = do let !appl_42 = Atom Nil + !kl_if_43 <- appl_42 `pseq` (kl_V1579tt `pseq` eq appl_42 kl_V1579tt) + case kl_if_43 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_44 = do do return (Atom (B False)) + in case kl_V1579t of + !(kl_V1579t@(Cons (!kl_V1579th) + (!kl_V1579tt))) -> pat_cond_41 kl_V1579t kl_V1579th kl_V1579tt + _ -> pat_cond_44 + case kl_if_40 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_45 = do do return (Atom (B False)) + in case kl_V1579h of + kl_V1579h@(Atom (UnboundSym "cases")) -> pat_cond_39 + kl_V1579h@(ApplC (PL "cases" + _)) -> pat_cond_39 + kl_V1579h@(ApplC (Func "cases" + _)) -> pat_cond_39 + _ -> pat_cond_45 + case kl_if_38 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_46 = do do return (Atom (B False)) + in case kl_V1579 of + !(kl_V1579@(Cons (!kl_V1579h) + (!kl_V1579t))) -> pat_cond_37 kl_V1579 kl_V1579h kl_V1579t + _ -> pat_cond_46 + case kl_if_36 of + Atom (B (True)) -> do simpleError (Core.Types.Atom (Core.Types.Str "error: odd number of case elements\n")) + Atom (B (False)) -> do do return kl_V1579 + _ -> throwError "if: expected boolean" + in case kl_V1579 of + !(kl_V1579@(Cons (Atom (UnboundSym "cases")) + (!(kl_V1579t@(Cons (!kl_V1579th) + (!(kl_V1579tt@(Cons (!kl_V1579tth) + (!kl_V1579ttt))))))))) -> pat_cond_28 kl_V1579 kl_V1579t kl_V1579th kl_V1579tt kl_V1579tth kl_V1579ttt + !(kl_V1579@(Cons (ApplC (PL "cases" + _)) + (!(kl_V1579t@(Cons (!kl_V1579th) + (!(kl_V1579tt@(Cons (!kl_V1579tth) + (!kl_V1579ttt))))))))) -> pat_cond_28 kl_V1579 kl_V1579t kl_V1579th kl_V1579tt kl_V1579tth kl_V1579ttt + !(kl_V1579@(Cons (ApplC (Func "cases" + _)) + (!(kl_V1579t@(Cons (!kl_V1579th) + (!(kl_V1579tt@(Cons (!kl_V1579tth) + (!kl_V1579ttt))))))))) -> pat_cond_28 kl_V1579 kl_V1579t kl_V1579th kl_V1579tt kl_V1579tth kl_V1579ttt + _ -> pat_cond_35 + _ -> throwError "if: expected boolean" + in case kl_V1579 of + !(kl_V1579@(Cons (Atom (UnboundSym "cases")) + (!(kl_V1579t@(Cons (Atom (UnboundSym "true")) + (!(kl_V1579tt@(Cons (!kl_V1579tth) + (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt + !(kl_V1579@(Cons (Atom (UnboundSym "cases")) + (!(kl_V1579t@(Cons (Atom (B (True))) + (!(kl_V1579tt@(Cons (!kl_V1579tth) + (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt + !(kl_V1579@(Cons (ApplC (PL "cases" _)) + (!(kl_V1579t@(Cons (Atom (UnboundSym "true")) + (!(kl_V1579tt@(Cons (!kl_V1579tth) + (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt + !(kl_V1579@(Cons (ApplC (PL "cases" _)) + (!(kl_V1579t@(Cons (Atom (B (True))) + (!(kl_V1579tt@(Cons (!kl_V1579tth) + (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt + !(kl_V1579@(Cons (ApplC (Func "cases" _)) + (!(kl_V1579t@(Cons (Atom (UnboundSym "true")) + (!(kl_V1579tt@(Cons (!kl_V1579tth) + (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt + !(kl_V1579@(Cons (ApplC (Func "cases" _)) + (!(kl_V1579t@(Cons (Atom (B (True))) + (!(kl_V1579tt@(Cons (!kl_V1579tth) + (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt + _ -> pat_cond_1 + +kl_shen_timer_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_timer_macro (!kl_V1581) = do !kl_if_0 <- let pat_cond_1 kl_V1581 kl_V1581h kl_V1581t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V1581t kl_V1581th kl_V1581tt = do let !appl_6 = Atom Nil + !kl_if_7 <- appl_6 `pseq` (kl_V1581tt `pseq` eq appl_6 kl_V1581tt) + 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_8 = do do return (Atom (B False)) + in case kl_V1581t of + !(kl_V1581t@(Cons (!kl_V1581th) + (!kl_V1581tt))) -> pat_cond_5 kl_V1581t kl_V1581th kl_V1581tt + _ -> pat_cond_8 + 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_9 = do do return (Atom (B False)) + in case kl_V1581h of + kl_V1581h@(Atom (UnboundSym "time")) -> pat_cond_3 + kl_V1581h@(ApplC (PL "time" + _)) -> pat_cond_3 + kl_V1581h@(ApplC (Func "time" + _)) -> pat_cond_3 + _ -> pat_cond_9 + 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_10 = do do return (Atom (B False)) + in case kl_V1581 of + !(kl_V1581@(Cons (!kl_V1581h) + (!kl_V1581t))) -> pat_cond_1 kl_V1581 kl_V1581h kl_V1581t + _ -> pat_cond_10 + case kl_if_0 of + Atom (B (True)) -> do let !appl_11 = Atom Nil + !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "run")) appl_11 + !appl_13 <- appl_12 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_12 + !appl_14 <- kl_V1581 `pseq` tl kl_V1581 + !appl_15 <- appl_14 `pseq` hd appl_14 + let !appl_16 = Atom Nil + !appl_17 <- appl_16 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "run")) appl_16 + !appl_18 <- appl_17 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_17 + let !appl_19 = Atom Nil + !appl_20 <- appl_19 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Start")) appl_19 + !appl_21 <- appl_20 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Finish")) appl_20 + !appl_22 <- appl_21 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_21 + let !appl_23 = Atom Nil + !appl_24 <- appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Time")) appl_23 + !appl_25 <- appl_24 `pseq` klCons (ApplC (wrapNamed "str" str)) appl_24 + let !appl_26 = Atom Nil + !appl_27 <- appl_26 `pseq` klCons (Core.Types.Atom (Core.Types.Str " secs\n")) appl_26 + !appl_28 <- appl_25 `pseq` (appl_27 `pseq` klCons appl_25 appl_27) + !appl_29 <- appl_28 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_28 + let !appl_30 = Atom Nil + !appl_31 <- appl_29 `pseq` (appl_30 `pseq` klCons appl_29 appl_30) + !appl_32 <- appl_31 `pseq` klCons (Core.Types.Atom (Core.Types.Str "\nrun time: ")) appl_31 + !appl_33 <- appl_32 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_32 + let !appl_34 = Atom Nil + !appl_35 <- appl_34 `pseq` klCons (ApplC (PL "stoutput" kl_stoutput)) appl_34 + let !appl_36 = Atom Nil + !appl_37 <- appl_35 `pseq` (appl_36 `pseq` klCons appl_35 appl_36) + !appl_38 <- appl_33 `pseq` (appl_37 `pseq` klCons appl_33 appl_37) + !appl_39 <- appl_38 `pseq` klCons (ApplC (wrapNamed "shen.prhush" kl_shen_prhush)) appl_38 + let !appl_40 = Atom Nil + !appl_41 <- appl_40 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_40 + !appl_42 <- appl_39 `pseq` (appl_41 `pseq` klCons appl_39 appl_41) + !appl_43 <- appl_42 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Message")) appl_42 + !appl_44 <- appl_22 `pseq` (appl_43 `pseq` klCons appl_22 appl_43) + !appl_45 <- appl_44 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Time")) appl_44 + !appl_46 <- appl_18 `pseq` (appl_45 `pseq` klCons appl_18 appl_45) + !appl_47 <- appl_46 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Finish")) appl_46 + !appl_48 <- appl_15 `pseq` (appl_47 `pseq` klCons appl_15 appl_47) + !appl_49 <- appl_48 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_48 + !appl_50 <- appl_13 `pseq` (appl_49 `pseq` klCons appl_13 appl_49) + !appl_51 <- appl_50 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Start")) appl_50 + !appl_52 <- appl_51 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_51 + appl_52 `pseq` kl_shen_let_macro appl_52 + Atom (B (False)) -> do do return kl_V1581 + _ -> throwError "if: expected boolean" + +kl_shen_tuple_up :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_tuple_up (!kl_V1583) = do let pat_cond_0 kl_V1583 kl_V1583h kl_V1583t = do !appl_1 <- kl_V1583t `pseq` kl_shen_tuple_up kl_V1583t + let !appl_2 = Atom Nil + !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) + !appl_4 <- kl_V1583h `pseq` (appl_3 `pseq` klCons kl_V1583h appl_3) + appl_4 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_4 + pat_cond_5 = do do return kl_V1583 + in case kl_V1583 of + !(kl_V1583@(Cons (!kl_V1583h) + (!kl_V1583t))) -> pat_cond_0 kl_V1583 kl_V1583h kl_V1583t + _ -> pat_cond_5 + +kl_shen_putDivget_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_putDivget_macro (!kl_V1585) = do !kl_if_0 <- let pat_cond_1 kl_V1585 kl_V1585h kl_V1585t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V1585t kl_V1585th kl_V1585tt = do !kl_if_6 <- let pat_cond_7 kl_V1585tt kl_V1585tth kl_V1585ttt = do !kl_if_8 <- let pat_cond_9 kl_V1585ttt kl_V1585ttth kl_V1585tttt = do let !appl_10 = Atom Nil + !kl_if_11 <- appl_10 `pseq` (kl_V1585tttt `pseq` eq appl_10 kl_V1585tttt) + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V1585ttt of + !(kl_V1585ttt@(Cons (!kl_V1585ttth) + (!kl_V1585tttt))) -> pat_cond_9 kl_V1585ttt kl_V1585ttth kl_V1585tttt + _ -> 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_V1585tt of + !(kl_V1585tt@(Cons (!kl_V1585tth) + (!kl_V1585ttt))) -> pat_cond_7 kl_V1585tt kl_V1585tth kl_V1585ttt + _ -> 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_V1585t of + !(kl_V1585t@(Cons (!kl_V1585th) + (!kl_V1585tt))) -> pat_cond_5 kl_V1585t kl_V1585th kl_V1585tt + _ -> 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_V1585h of + kl_V1585h@(Atom (UnboundSym "put")) -> pat_cond_3 + kl_V1585h@(ApplC (PL "put" + _)) -> pat_cond_3 + kl_V1585h@(ApplC (Func "put" + _)) -> pat_cond_3 + _ -> 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_V1585 of + !(kl_V1585@(Cons (!kl_V1585h) + (!kl_V1585t))) -> pat_cond_1 kl_V1585 kl_V1585h kl_V1585t + _ -> pat_cond_16 + case kl_if_0 of + Atom (B (True)) -> do !appl_17 <- kl_V1585 `pseq` tl kl_V1585 + !appl_18 <- appl_17 `pseq` hd appl_17 + !appl_19 <- kl_V1585 `pseq` tl kl_V1585 + !appl_20 <- appl_19 `pseq` tl appl_19 + !appl_21 <- appl_20 `pseq` hd appl_20 + !appl_22 <- kl_V1585 `pseq` tl kl_V1585 + !appl_23 <- appl_22 `pseq` tl appl_22 + !appl_24 <- appl_23 `pseq` tl appl_23 + !appl_25 <- appl_24 `pseq` hd appl_24 + let !appl_26 = Atom Nil + !appl_27 <- appl_26 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) appl_26 + !appl_28 <- appl_27 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_27 + let !appl_29 = Atom Nil + !appl_30 <- appl_28 `pseq` (appl_29 `pseq` klCons appl_28 appl_29) + !appl_31 <- appl_25 `pseq` (appl_30 `pseq` klCons appl_25 appl_30) + !appl_32 <- appl_21 `pseq` (appl_31 `pseq` klCons appl_21 appl_31) + !appl_33 <- appl_18 `pseq` (appl_32 `pseq` klCons appl_18 appl_32) + appl_33 `pseq` klCons (ApplC (wrapNamed "put" kl_put)) appl_33 + Atom (B (False)) -> do !kl_if_34 <- let pat_cond_35 kl_V1585 kl_V1585h kl_V1585t = do !kl_if_36 <- let pat_cond_37 = do !kl_if_38 <- let pat_cond_39 kl_V1585t kl_V1585th kl_V1585tt = do !kl_if_40 <- let pat_cond_41 kl_V1585tt kl_V1585tth kl_V1585ttt = do let !appl_42 = Atom Nil + !kl_if_43 <- appl_42 `pseq` (kl_V1585ttt `pseq` eq appl_42 kl_V1585ttt) + case kl_if_43 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_44 = do do return (Atom (B False)) + in case kl_V1585tt of + !(kl_V1585tt@(Cons (!kl_V1585tth) + (!kl_V1585ttt))) -> pat_cond_41 kl_V1585tt kl_V1585tth kl_V1585ttt + _ -> pat_cond_44 + case kl_if_40 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_45 = do do return (Atom (B False)) + in case kl_V1585t of + !(kl_V1585t@(Cons (!kl_V1585th) + (!kl_V1585tt))) -> pat_cond_39 kl_V1585t kl_V1585th kl_V1585tt + _ -> pat_cond_45 + case kl_if_38 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_46 = do do return (Atom (B False)) + in case kl_V1585h of + kl_V1585h@(Atom (UnboundSym "get")) -> pat_cond_37 + kl_V1585h@(ApplC (PL "get" + _)) -> pat_cond_37 + kl_V1585h@(ApplC (Func "get" + _)) -> pat_cond_37 + _ -> pat_cond_46 + case kl_if_36 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_47 = do do return (Atom (B False)) + in case kl_V1585 of + !(kl_V1585@(Cons (!kl_V1585h) + (!kl_V1585t))) -> pat_cond_35 kl_V1585 kl_V1585h kl_V1585t + _ -> pat_cond_47 + case kl_if_34 of + Atom (B (True)) -> do !appl_48 <- kl_V1585 `pseq` tl kl_V1585 + !appl_49 <- appl_48 `pseq` hd appl_48 + !appl_50 <- kl_V1585 `pseq` tl kl_V1585 + !appl_51 <- appl_50 `pseq` tl appl_50 + !appl_52 <- appl_51 `pseq` hd appl_51 + let !appl_53 = Atom Nil + !appl_54 <- appl_53 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) appl_53 + !appl_55 <- appl_54 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_54 + let !appl_56 = Atom Nil + !appl_57 <- appl_55 `pseq` (appl_56 `pseq` klCons appl_55 appl_56) + !appl_58 <- appl_52 `pseq` (appl_57 `pseq` klCons appl_52 appl_57) + !appl_59 <- appl_49 `pseq` (appl_58 `pseq` klCons appl_49 appl_58) + appl_59 `pseq` klCons (ApplC (wrapNamed "get" kl_get)) appl_59 + Atom (B (False)) -> do !kl_if_60 <- let pat_cond_61 kl_V1585 kl_V1585h kl_V1585t = do !kl_if_62 <- let pat_cond_63 = do !kl_if_64 <- let pat_cond_65 kl_V1585t kl_V1585th kl_V1585tt = do !kl_if_66 <- let pat_cond_67 kl_V1585tt kl_V1585tth kl_V1585ttt = do !kl_if_68 <- let pat_cond_69 kl_V1585ttt kl_V1585ttth kl_V1585tttt = do let !appl_70 = Atom Nil + !kl_if_71 <- appl_70 `pseq` (kl_V1585tttt `pseq` eq appl_70 kl_V1585tttt) + case kl_if_71 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_72 = do do return (Atom (B False)) + in case kl_V1585ttt of + !(kl_V1585ttt@(Cons (!kl_V1585ttth) + (!kl_V1585tttt))) -> pat_cond_69 kl_V1585ttt kl_V1585ttth kl_V1585tttt + _ -> pat_cond_72 + case kl_if_68 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_73 = do do return (Atom (B False)) + in case kl_V1585tt of + !(kl_V1585tt@(Cons (!kl_V1585tth) + (!kl_V1585ttt))) -> pat_cond_67 kl_V1585tt kl_V1585tth kl_V1585ttt + _ -> pat_cond_73 + case kl_if_66 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_74 = do do return (Atom (B False)) + in case kl_V1585t of + !(kl_V1585t@(Cons (!kl_V1585th) + (!kl_V1585tt))) -> pat_cond_65 kl_V1585t kl_V1585th kl_V1585tt + _ -> pat_cond_74 + case kl_if_64 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_75 = do do return (Atom (B False)) + in case kl_V1585h of + kl_V1585h@(Atom (UnboundSym "get/or")) -> pat_cond_63 + kl_V1585h@(ApplC (PL "get/or" + _)) -> pat_cond_63 + kl_V1585h@(ApplC (Func "get/or" + _)) -> pat_cond_63 + _ -> pat_cond_75 + 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" + pat_cond_76 = do do return (Atom (B False)) + in case kl_V1585 of + !(kl_V1585@(Cons (!kl_V1585h) + (!kl_V1585t))) -> pat_cond_61 kl_V1585 kl_V1585h kl_V1585t + _ -> pat_cond_76 + case kl_if_60 of + Atom (B (True)) -> do !appl_77 <- kl_V1585 `pseq` tl kl_V1585 + !appl_78 <- appl_77 `pseq` hd appl_77 + !appl_79 <- kl_V1585 `pseq` tl kl_V1585 + !appl_80 <- appl_79 `pseq` tl appl_79 + !appl_81 <- appl_80 `pseq` hd appl_80 + !appl_82 <- kl_V1585 `pseq` tl kl_V1585 + !appl_83 <- appl_82 `pseq` tl appl_82 + !appl_84 <- appl_83 `pseq` tl appl_83 + !appl_85 <- appl_84 `pseq` hd appl_84 + let !appl_86 = Atom Nil + !appl_87 <- appl_86 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) appl_86 + !appl_88 <- appl_87 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_87 + let !appl_89 = Atom Nil + !appl_90 <- appl_88 `pseq` (appl_89 `pseq` klCons appl_88 appl_89) + !appl_91 <- appl_85 `pseq` (appl_90 `pseq` klCons appl_85 appl_90) + !appl_92 <- appl_81 `pseq` (appl_91 `pseq` klCons appl_81 appl_91) + !appl_93 <- appl_78 `pseq` (appl_92 `pseq` klCons appl_78 appl_92) + appl_93 `pseq` klCons (ApplC (wrapNamed "get/or" kl_getDivor)) appl_93 + Atom (B (False)) -> do !kl_if_94 <- let pat_cond_95 kl_V1585 kl_V1585h kl_V1585t = do !kl_if_96 <- let pat_cond_97 = do !kl_if_98 <- let pat_cond_99 kl_V1585t kl_V1585th kl_V1585tt = do !kl_if_100 <- let pat_cond_101 kl_V1585tt kl_V1585tth kl_V1585ttt = do let !appl_102 = Atom Nil + !kl_if_103 <- appl_102 `pseq` (kl_V1585ttt `pseq` eq appl_102 kl_V1585ttt) + case kl_if_103 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_V1585tt of + !(kl_V1585tt@(Cons (!kl_V1585tth) + (!kl_V1585ttt))) -> pat_cond_101 kl_V1585tt kl_V1585tth kl_V1585ttt + _ -> pat_cond_104 + case kl_if_100 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_V1585t of + !(kl_V1585t@(Cons (!kl_V1585th) + (!kl_V1585tt))) -> pat_cond_99 kl_V1585t kl_V1585th kl_V1585tt + _ -> pat_cond_105 + case kl_if_98 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_V1585h of + kl_V1585h@(Atom (UnboundSym "unput")) -> pat_cond_97 + kl_V1585h@(ApplC (PL "unput" + _)) -> pat_cond_97 + kl_V1585h@(ApplC (Func "unput" + _)) -> pat_cond_97 + _ -> pat_cond_106 + case kl_if_96 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_V1585 of + !(kl_V1585@(Cons (!kl_V1585h) + (!kl_V1585t))) -> pat_cond_95 kl_V1585 kl_V1585h kl_V1585t + _ -> pat_cond_107 + case kl_if_94 of + Atom (B (True)) -> do !appl_108 <- kl_V1585 `pseq` tl kl_V1585 + !appl_109 <- appl_108 `pseq` hd appl_108 + !appl_110 <- kl_V1585 `pseq` tl kl_V1585 + !appl_111 <- appl_110 `pseq` tl appl_110 + !appl_112 <- appl_111 `pseq` hd appl_111 + let !appl_113 = Atom Nil + !appl_114 <- appl_113 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) appl_113 + !appl_115 <- appl_114 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_114 + let !appl_116 = Atom Nil + !appl_117 <- appl_115 `pseq` (appl_116 `pseq` klCons appl_115 appl_116) + !appl_118 <- appl_112 `pseq` (appl_117 `pseq` klCons appl_112 appl_117) + !appl_119 <- appl_109 `pseq` (appl_118 `pseq` klCons appl_109 appl_118) + appl_119 `pseq` klCons (ApplC (wrapNamed "unput" kl_unput)) appl_119 + Atom (B (False)) -> do do return kl_V1585 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_function_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_function_macro (!kl_V1587) = do !kl_if_0 <- let pat_cond_1 kl_V1587 kl_V1587h kl_V1587t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V1587t kl_V1587th kl_V1587tt = do let !appl_6 = Atom Nil + !kl_if_7 <- appl_6 `pseq` (kl_V1587tt `pseq` eq appl_6 kl_V1587tt) + 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_8 = do do return (Atom (B False)) + in case kl_V1587t of + !(kl_V1587t@(Cons (!kl_V1587th) + (!kl_V1587tt))) -> pat_cond_5 kl_V1587t kl_V1587th kl_V1587tt + _ -> pat_cond_8 + 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_9 = do do return (Atom (B False)) + in case kl_V1587h of + kl_V1587h@(Atom (UnboundSym "function")) -> pat_cond_3 + kl_V1587h@(ApplC (PL "function" + _)) -> pat_cond_3 + kl_V1587h@(ApplC (Func "function" + _)) -> pat_cond_3 + _ -> pat_cond_9 + 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_10 = do do return (Atom (B False)) + in case kl_V1587 of + !(kl_V1587@(Cons (!kl_V1587h) + (!kl_V1587t))) -> pat_cond_1 kl_V1587 kl_V1587h kl_V1587t + _ -> pat_cond_10 + case kl_if_0 of + Atom (B (True)) -> do !appl_11 <- kl_V1587 `pseq` tl kl_V1587 + !appl_12 <- appl_11 `pseq` hd appl_11 + !appl_13 <- kl_V1587 `pseq` tl kl_V1587 + !appl_14 <- appl_13 `pseq` hd appl_13 + let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "arity") + !appl_16 <- appl_14 `pseq` applyWrapper aw_15 [appl_14] + appl_12 `pseq` (appl_16 `pseq` kl_shen_function_abstraction appl_12 appl_16) + Atom (B (False)) -> do do return kl_V1587 + _ -> throwError "if: expected boolean" + +kl_shen_function_abstraction :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_function_abstraction (!kl_V1590) (!kl_V1591) = do let pat_cond_0 = do !appl_1 <- kl_V1590 `pseq` kl_shen_app kl_V1590 (Core.Types.Atom (Core.Types.Str " has no lambda form\n")) (Core.Types.Atom (Core.Types.UnboundSym "shen.a")) + appl_1 `pseq` simpleError appl_1 + pat_cond_2 = do let !appl_3 = Atom Nil + !appl_4 <- kl_V1590 `pseq` (appl_3 `pseq` klCons kl_V1590 appl_3) + appl_4 `pseq` klCons (ApplC (wrapNamed "function" kl_function)) appl_4 + pat_cond_5 = do do let !appl_6 = Atom Nil + kl_V1590 `pseq` (kl_V1591 `pseq` (appl_6 `pseq` kl_shen_function_abstraction_help kl_V1590 kl_V1591 appl_6)) + in case kl_V1591 of + kl_V1591@(Atom (N (KI 0))) -> pat_cond_0 + kl_V1591@(Atom (N (KI (-1)))) -> pat_cond_2 + _ -> pat_cond_5 + +kl_shen_function_abstraction_help :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_function_abstraction_help (!kl_V1595) (!kl_V1596) (!kl_V1597) = do let pat_cond_0 = do kl_V1595 `pseq` (kl_V1597 `pseq` klCons kl_V1595 kl_V1597) + pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_3 <- kl_V1596 `pseq` Primitives.subtract kl_V1596 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + let !appl_4 = Atom Nil + !appl_5 <- kl_X `pseq` (appl_4 `pseq` klCons kl_X appl_4) + !appl_6 <- kl_V1597 `pseq` (appl_5 `pseq` kl_append kl_V1597 appl_5) + !appl_7 <- kl_V1595 `pseq` (appl_3 `pseq` (appl_6 `pseq` kl_shen_function_abstraction_help kl_V1595 appl_3 appl_6)) + let !appl_8 = Atom Nil + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` klCons appl_7 appl_8) + !appl_10 <- kl_X `pseq` (appl_9 `pseq` klCons kl_X appl_9) + appl_10 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_10))) + !appl_11 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "V")) + appl_11 `pseq` applyWrapper appl_2 [appl_11] + in case kl_V1596 of + kl_V1596@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_undefmacro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_undefmacro (!kl_V1599) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_MacroReg) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Pos) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Remove1) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Remove2) -> do return kl_V1599))) + !appl_4 <- value (Core.Types.Atom (Core.Types.UnboundSym "*macros*")) + !appl_5 <- kl_Pos `pseq` (appl_4 `pseq` kl_shen_remove_nth kl_Pos appl_4) + !appl_6 <- appl_5 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "*macros*")) appl_5 + appl_6 `pseq` applyWrapper appl_3 [appl_6]))) + !appl_7 <- kl_V1599 `pseq` (kl_MacroReg `pseq` kl_remove kl_V1599 kl_MacroReg) + !appl_8 <- appl_7 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*macroreg*")) appl_7 + appl_8 `pseq` applyWrapper appl_2 [appl_8]))) + !appl_9 <- kl_V1599 `pseq` (kl_MacroReg `pseq` kl_shen_findpos kl_V1599 kl_MacroReg) + appl_9 `pseq` applyWrapper appl_1 [appl_9]))) + !appl_10 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*macroreg*")) + appl_10 `pseq` applyWrapper appl_0 [appl_10] + +kl_shen_findpos :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_findpos (!kl_V1609) (!kl_V1610) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V1610 `pseq` eq appl_0 kl_V1610) + case kl_if_1 of + Atom (B (True)) -> do !appl_2 <- kl_V1609 `pseq` kl_shen_app kl_V1609 (Core.Types.Atom (Core.Types.Str " is not a macro\n")) (Core.Types.Atom (Core.Types.UnboundSym "shen.a")) + appl_2 `pseq` simpleError appl_2 + Atom (B (False)) -> do let pat_cond_3 kl_V1610 kl_V1610h kl_V1610t = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + pat_cond_4 kl_V1610 kl_V1610h kl_V1610t = do !appl_5 <- kl_V1609 `pseq` (kl_V1610t `pseq` kl_shen_findpos kl_V1609 kl_V1610t) + appl_5 `pseq` add (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_5 + pat_cond_6 = do do kl_shen_f_error (ApplC (wrapNamed "shen.findpos" kl_shen_findpos)) + in case kl_V1610 of + !(kl_V1610@(Cons (!kl_V1610h) + (!kl_V1610t))) | eqCore kl_V1610h kl_V1609 -> pat_cond_3 kl_V1610 kl_V1610h kl_V1610t + !(kl_V1610@(Cons (!kl_V1610h) + (!kl_V1610t))) -> pat_cond_4 kl_V1610 kl_V1610h kl_V1610t + _ -> pat_cond_6 + _ -> throwError "if: expected boolean" + +kl_shen_remove_nth :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_remove_nth (!kl_V1615) (!kl_V1616) = do !kl_if_0 <- let pat_cond_1 = do let pat_cond_2 kl_V1616 kl_V1616h kl_V1616t = do return (Atom (B True)) + pat_cond_3 = do do return (Atom (B False)) + in case kl_V1616 of + !(kl_V1616@(Cons (!kl_V1616h) + (!kl_V1616t))) -> pat_cond_2 kl_V1616 kl_V1616h kl_V1616t + _ -> pat_cond_3 + pat_cond_4 = do do return (Atom (B False)) + in case kl_V1615 of + kl_V1615@(Atom (N (KI 1))) -> pat_cond_1 + _ -> pat_cond_4 + case kl_if_0 of + Atom (B (True)) -> do kl_V1616 `pseq` tl kl_V1616 + Atom (B (False)) -> do let pat_cond_5 kl_V1616 kl_V1616h kl_V1616t = do !appl_6 <- kl_V1615 `pseq` Primitives.subtract kl_V1615 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_7 <- appl_6 `pseq` (kl_V1616t `pseq` kl_shen_remove_nth appl_6 kl_V1616t) + kl_V1616h `pseq` (appl_7 `pseq` klCons kl_V1616h appl_7) + pat_cond_8 = do do kl_shen_f_error (ApplC (wrapNamed "shen.remove-nth" kl_shen_remove_nth)) + in case kl_V1616 of + !(kl_V1616@(Cons (!kl_V1616h) + (!kl_V1616t))) -> pat_cond_5 kl_V1616 kl_V1616h kl_V1616t + _ -> pat_cond_8 + _ -> throwError "if: expected boolean" + +expr10 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr10 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Backend/PortInfo.hs b/Shentong/Backend/PortInfo.hs --- a/Shentong/Backend/PortInfo.hs +++ b/Shentong/Backend/PortInfo.hs @@ -9,10 +9,10 @@ import Control.Monad.Except import Control.Parallel import Environment -import Primitives as Primitives +import Core.Primitives as Primitives import Backend.Utils -import Types as Types -import Utils +import Core.Types as Types +import Core.Utils import Wrap import Backend.Toplevel import Backend.Core @@ -57,10 +57,10 @@ -} expr14 :: Types.KLContext Types.Env Types.KLValue -expr14 = do (do klSet (Types.Atom (Types.UnboundSym "*os*")) (Types.Atom (Types.Str "Windows 7"))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) +expr14 = do (do klSet (Types.Atom (Types.UnboundSym "*os*")) (Types.Atom (Types.Str "Arch Linux 4.10"))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) (do klSet (Types.Atom (Types.UnboundSym "*language*")) (Types.Atom (Types.Str "Haskell 2010"))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "*version*")) (Types.Atom (Types.Str "version 19.1"))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do klSet (Types.Atom (Types.UnboundSym "*port*")) (Types.Atom (Types.Str "0.3.1"))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) + (do klSet (Types.Atom (Types.UnboundSym "*version*")) (Types.Atom (Types.Str "version 20.0"))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) + (do klSet (Types.Atom (Types.UnboundSym "*port*")) (Types.Atom (Types.Str "0.3.2"))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) (do klSet (Types.Atom (Types.UnboundSym "*porters*")) (Types.Atom (Types.Str "Mark Thom"))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) (do klSet (Types.Atom (Types.UnboundSym "*implementation*")) (Types.Atom (Types.Str "GHC 8.0.1"))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) (do klSet (Types.Atom (Types.UnboundSym "*release*")) (Types.Atom (Types.Str "0.1"))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) diff --git a/Shentong/Backend/Prolog.hs b/Shentong/Backend/Prolog.hs # file too large to diff: Shentong/Backend/Prolog.hs diff --git a/Shentong/Backend/Reader.hs b/Shentong/Backend/Reader.hs --- a/Shentong/Backend/Reader.hs +++ b/Shentong/Backend/Reader.hs @@ -1,2799 +1,2962 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} - -module Backend.Reader 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 -import Backend.Core -import Backend.Sys -import Backend.Sequent -import Backend.Yacc - -{- -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_read_file_as_bytelist :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_read_file_as_bytelist (!kl_V2161) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Stream) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Byte) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Bytes) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Close) -> do kl_Bytes `pseq` kl_reverse kl_Bytes))) - !appl_4 <- kl_Stream `pseq` closeStream kl_Stream - appl_4 `pseq` applyWrapper appl_3 [appl_4]))) - !appl_5 <- kl_Stream `pseq` (kl_Byte `pseq` kl_shen_read_file_as_bytelist_help kl_Stream kl_Byte (Types.Atom Types.Nil)) - appl_5 `pseq` applyWrapper appl_2 [appl_5]))) - !appl_6 <- kl_Stream `pseq` readByte kl_Stream - appl_6 `pseq` applyWrapper appl_1 [appl_6]))) - !appl_7 <- kl_V2161 `pseq` openStream kl_V2161 (Types.Atom (Types.UnboundSym "in")) - appl_7 `pseq` applyWrapper appl_0 [appl_7] - -kl_shen_read_file_as_bytelist_help :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_read_file_as_bytelist_help (!kl_V2165) (!kl_V2166) (!kl_V2167) = do let pat_cond_0 = do return kl_V2167 - pat_cond_1 = do do !appl_2 <- kl_V2165 `pseq` readByte kl_V2165 - !appl_3 <- kl_V2166 `pseq` (kl_V2167 `pseq` klCons kl_V2166 kl_V2167) - kl_V2165 `pseq` (appl_2 `pseq` (appl_3 `pseq` kl_shen_read_file_as_bytelist_help kl_V2165 appl_2 appl_3)) - in case kl_V2166 of - kl_V2166@(Atom (N (KI (-1)))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_read_file_as_string :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_read_file_as_string (!kl_V2169) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Stream) -> do !appl_1 <- kl_Stream `pseq` readByte kl_Stream - kl_Stream `pseq` (appl_1 `pseq` kl_shen_rfas_h kl_Stream appl_1 (Types.Atom (Types.Str "")))))) - !appl_2 <- kl_V2169 `pseq` openStream kl_V2169 (Types.Atom (Types.UnboundSym "in")) - appl_2 `pseq` applyWrapper appl_0 [appl_2] - -kl_shen_rfas_h :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_rfas_h (!kl_V2173) (!kl_V2174) (!kl_V2175) = do let pat_cond_0 = do !appl_1 <- kl_V2173 `pseq` closeStream kl_V2173 - appl_1 `pseq` (kl_V2175 `pseq` kl_do appl_1 kl_V2175) - pat_cond_2 = do do !appl_3 <- kl_V2173 `pseq` readByte kl_V2173 - !appl_4 <- kl_V2174 `pseq` nToString kl_V2174 - !appl_5 <- kl_V2175 `pseq` (appl_4 `pseq` cn kl_V2175 appl_4) - kl_V2173 `pseq` (appl_3 `pseq` (appl_5 `pseq` kl_shen_rfas_h kl_V2173 appl_3 appl_5)) - in case kl_V2174 of - kl_V2174@(Atom (N (KI (-1)))) -> pat_cond_0 - _ -> pat_cond_2 - -kl_input :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_input (!kl_V2177) = do !appl_0 <- kl_V2177 `pseq` kl_read kl_V2177 - appl_0 `pseq` evalKL appl_0 - -kl_inputPlus :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_inputPlus (!kl_V2180) (!kl_V2181) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_MonoP) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Input) -> do let !aw_2 = Types.Atom (Types.UnboundSym "shen.demodulate") - !appl_3 <- kl_V2180 `pseq` applyWrapper aw_2 [kl_V2180] - let !aw_4 = Types.Atom (Types.UnboundSym "shen.typecheck") - !appl_5 <- kl_Input `pseq` (appl_3 `pseq` applyWrapper aw_4 [kl_Input, - appl_3]) - !kl_if_6 <- appl_5 `pseq` eq (Atom (B False)) appl_5 - case kl_if_6 of - Atom (B (True)) -> do let !aw_7 = Types.Atom (Types.UnboundSym "shen.app") - !appl_8 <- kl_V2180 `pseq` applyWrapper aw_7 [kl_V2180, - Types.Atom (Types.Str "\n"), - Types.Atom (Types.UnboundSym "shen.r")] - !appl_9 <- appl_8 `pseq` cn (Types.Atom (Types.Str " is not of type ")) appl_8 - let !aw_10 = Types.Atom (Types.UnboundSym "shen.app") - !appl_11 <- kl_Input `pseq` (appl_9 `pseq` applyWrapper aw_10 [kl_Input, - appl_9, - Types.Atom (Types.UnboundSym "shen.r")]) - !appl_12 <- appl_11 `pseq` cn (Types.Atom (Types.Str "type error: ")) appl_11 - appl_12 `pseq` simpleError appl_12 - Atom (B (False)) -> do do kl_Input `pseq` evalKL kl_Input - _ -> throwError "if: expected boolean"))) - !appl_13 <- kl_V2181 `pseq` kl_read kl_V2181 - appl_13 `pseq` applyWrapper appl_1 [appl_13]))) - !appl_14 <- kl_V2180 `pseq` kl_shen_monotype kl_V2180 - appl_14 `pseq` applyWrapper appl_0 [appl_14] - -kl_shen_monotype :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_monotype (!kl_V2183) = do let pat_cond_0 kl_V2183 kl_V2183h kl_V2183t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_monotype kl_Z))) - appl_1 `pseq` (kl_V2183 `pseq` kl_map appl_1 kl_V2183) - pat_cond_2 = do do !kl_if_3 <- kl_V2183 `pseq` kl_variableP kl_V2183 - case kl_if_3 of - Atom (B (True)) -> do let !aw_4 = Types.Atom (Types.UnboundSym "shen.app") - !appl_5 <- kl_V2183 `pseq` applyWrapper aw_4 [kl_V2183, - Types.Atom (Types.Str "\n"), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_6 <- appl_5 `pseq` cn (Types.Atom (Types.Str "input+ expects a monotype: not ")) appl_5 - appl_6 `pseq` simpleError appl_6 - Atom (B (False)) -> do do return kl_V2183 - _ -> throwError "if: expected boolean" - in case kl_V2183 of - !(kl_V2183@(Cons (!kl_V2183h) - (!kl_V2183t))) -> pat_cond_0 kl_V2183 kl_V2183h kl_V2183t - _ -> pat_cond_2 - -kl_read :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_read (!kl_V2185) = do !appl_0 <- kl_V2185 `pseq` readByte kl_V2185 - !appl_1 <- kl_V2185 `pseq` (appl_0 `pseq` kl_shen_read_loop kl_V2185 appl_0 (Types.Atom Types.Nil)) - appl_1 `pseq` hd appl_1 - -kl_it :: Types.KLContext Types.Env Types.KLValue -kl_it = do value (Types.Atom (Types.UnboundSym "shen.*it*")) - -kl_shen_read_loop :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_read_loop (!kl_V2193) (!kl_V2194) (!kl_V2195) = do let pat_cond_0 = do simpleError (Types.Atom (Types.Str "read aborted")) - pat_cond_1 = do !kl_if_2 <- kl_V2195 `pseq` kl_emptyP kl_V2195 - case kl_if_2 of - Atom (B (True)) -> do simpleError (Types.Atom (Types.Str "error: empty stream")) - Atom (B (False)) -> do do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) - let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_E) -> do return kl_E))) - appl_3 `pseq` (kl_V2195 `pseq` (appl_4 `pseq` kl_compile appl_3 kl_V2195 appl_4)) - _ -> throwError "if: expected boolean" - pat_cond_5 = do !kl_if_6 <- kl_V2194 `pseq` kl_shen_terminatorP kl_V2194 - case kl_if_6 of - Atom (B (True)) -> do let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_AllBytes) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_It) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Read) -> do !kl_if_10 <- let pat_cond_11 = do return (Atom (B True)) - pat_cond_12 = do do !kl_if_13 <- kl_Read `pseq` kl_emptyP kl_Read - 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" - in case kl_Read of - kl_Read@(Atom (UnboundSym "shen.nextbyte")) -> pat_cond_11 - kl_Read@(ApplC (PL "shen.nextbyte" - _)) -> pat_cond_11 - kl_Read@(ApplC (Func "shen.nextbyte" - _)) -> pat_cond_11 - _ -> pat_cond_12 - case kl_if_10 of - Atom (B (True)) -> do !appl_14 <- kl_V2193 `pseq` readByte kl_V2193 - kl_V2193 `pseq` (appl_14 `pseq` (kl_AllBytes `pseq` kl_shen_read_loop kl_V2193 appl_14 kl_AllBytes)) - Atom (B (False)) -> do do return kl_Read - _ -> throwError "if: expected boolean"))) - let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) - let !appl_16 = ApplC (Func "lambda" (Context (\(!kl_E) -> do return (Types.Atom (Types.UnboundSym "shen.nextbyte"))))) - !appl_17 <- appl_15 `pseq` (kl_AllBytes `pseq` (appl_16 `pseq` kl_compile appl_15 kl_AllBytes appl_16)) - appl_17 `pseq` applyWrapper appl_9 [appl_17]))) - !appl_18 <- kl_AllBytes `pseq` kl_shen_record_it kl_AllBytes - appl_18 `pseq` applyWrapper appl_8 [appl_18]))) - !appl_19 <- kl_V2194 `pseq` klCons kl_V2194 (Types.Atom Types.Nil) - !appl_20 <- kl_V2195 `pseq` (appl_19 `pseq` kl_append kl_V2195 appl_19) - appl_20 `pseq` applyWrapper appl_7 [appl_20] - Atom (B (False)) -> do do !appl_21 <- kl_V2193 `pseq` readByte kl_V2193 - !appl_22 <- kl_V2194 `pseq` klCons kl_V2194 (Types.Atom Types.Nil) - !appl_23 <- kl_V2195 `pseq` (appl_22 `pseq` kl_append kl_V2195 appl_22) - kl_V2193 `pseq` (appl_21 `pseq` (appl_23 `pseq` kl_shen_read_loop kl_V2193 appl_21 appl_23)) - _ -> throwError "if: expected boolean" - in case kl_V2194 of - kl_V2194@(Atom (N (KI 94))) -> pat_cond_0 - kl_V2194@(Atom (N (KI (-1)))) -> pat_cond_1 - _ -> pat_cond_5 - -kl_shen_terminatorP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_terminatorP (!kl_V2197) = do !appl_0 <- klCons (Types.Atom (Types.N (Types.KI 93))) (Types.Atom Types.Nil) - !appl_1 <- appl_0 `pseq` klCons (Types.Atom (Types.N (Types.KI 41))) appl_0 - !appl_2 <- appl_1 `pseq` klCons (Types.Atom (Types.N (Types.KI 34))) appl_1 - !appl_3 <- appl_2 `pseq` klCons (Types.Atom (Types.N (Types.KI 32))) appl_2 - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.N (Types.KI 13))) appl_3 - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.N (Types.KI 10))) appl_4 - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.N (Types.KI 9))) appl_5 - kl_V2197 `pseq` (appl_6 `pseq` kl_elementP kl_V2197 appl_6) - -kl_lineread :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_lineread (!kl_V2199) = do !appl_0 <- kl_V2199 `pseq` readByte kl_V2199 - appl_0 `pseq` (kl_V2199 `pseq` kl_shen_lineread_loop appl_0 (Types.Atom Types.Nil) kl_V2199) - -kl_shen_lineread_loop :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_lineread_loop (!kl_V2204) (!kl_V2205) (!kl_V2206) = do let pat_cond_0 = do !kl_if_1 <- kl_V2205 `pseq` kl_emptyP kl_V2205 - case kl_if_1 of - Atom (B (True)) -> do simpleError (Types.Atom (Types.Str "empty stream")) - Atom (B (False)) -> do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) - let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_E) -> do return kl_E))) - appl_2 `pseq` (kl_V2205 `pseq` (appl_3 `pseq` kl_compile appl_2 kl_V2205 appl_3)) - _ -> throwError "if: expected boolean" - pat_cond_4 = do !appl_5 <- kl_shen_hat - !kl_if_6 <- kl_V2204 `pseq` (appl_5 `pseq` eq kl_V2204 appl_5) - case kl_if_6 of - Atom (B (True)) -> do simpleError (Types.Atom (Types.Str "line read aborted")) - Atom (B (False)) -> do !appl_7 <- kl_shen_newline - !appl_8 <- kl_shen_carriage_return - !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) - !kl_if_11 <- kl_V2204 `pseq` (appl_10 `pseq` kl_elementP kl_V2204 appl_10) - case kl_if_11 of - Atom (B (True)) -> do let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_Line) -> do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_It) -> do !kl_if_14 <- let pat_cond_15 = do return (Atom (B True)) - pat_cond_16 = do do !kl_if_17 <- kl_Line `pseq` kl_emptyP kl_Line - 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" - in case kl_Line of - kl_Line@(Atom (UnboundSym "shen.nextline")) -> pat_cond_15 - kl_Line@(ApplC (PL "shen.nextline" - _)) -> pat_cond_15 - kl_Line@(ApplC (Func "shen.nextline" - _)) -> pat_cond_15 - _ -> pat_cond_16 - case kl_if_14 of - Atom (B (True)) -> do !appl_18 <- kl_V2206 `pseq` readByte kl_V2206 - !appl_19 <- kl_V2204 `pseq` klCons kl_V2204 (Types.Atom Types.Nil) - !appl_20 <- kl_V2205 `pseq` (appl_19 `pseq` kl_append kl_V2205 appl_19) - appl_18 `pseq` (appl_20 `pseq` (kl_V2206 `pseq` kl_shen_lineread_loop appl_18 appl_20 kl_V2206)) - Atom (B (False)) -> do do return kl_Line - _ -> throwError "if: expected boolean"))) - !appl_21 <- kl_V2205 `pseq` kl_shen_record_it kl_V2205 - appl_21 `pseq` applyWrapper appl_13 [appl_21]))) - let !appl_22 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) - let !appl_23 = ApplC (Func "lambda" (Context (\(!kl_E) -> do return (Types.Atom (Types.UnboundSym "shen.nextline"))))) - !appl_24 <- appl_22 `pseq` (kl_V2205 `pseq` (appl_23 `pseq` kl_compile appl_22 kl_V2205 appl_23)) - appl_24 `pseq` applyWrapper appl_12 [appl_24] - Atom (B (False)) -> do do !appl_25 <- kl_V2206 `pseq` readByte kl_V2206 - !appl_26 <- kl_V2204 `pseq` klCons kl_V2204 (Types.Atom Types.Nil) - !appl_27 <- kl_V2205 `pseq` (appl_26 `pseq` kl_append kl_V2205 appl_26) - appl_25 `pseq` (appl_27 `pseq` (kl_V2206 `pseq` kl_shen_lineread_loop appl_25 appl_27 kl_V2206)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - in case kl_V2204 of - kl_V2204@(Atom (N (KI (-1)))) -> pat_cond_0 - _ -> pat_cond_4 - -kl_shen_record_it :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_record_it (!kl_V2208) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_TrimLeft) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_TrimRight) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Trimmed) -> do kl_Trimmed `pseq` kl_shen_record_it_h kl_Trimmed))) - !appl_3 <- kl_TrimRight `pseq` kl_reverse kl_TrimRight - appl_3 `pseq` applyWrapper appl_2 [appl_3]))) - !appl_4 <- kl_TrimLeft `pseq` kl_reverse kl_TrimLeft - !appl_5 <- appl_4 `pseq` kl_shen_trim_whitespace appl_4 - appl_5 `pseq` applyWrapper appl_1 [appl_5]))) - !appl_6 <- kl_V2208 `pseq` kl_shen_trim_whitespace kl_V2208 - appl_6 `pseq` applyWrapper appl_0 [appl_6] - -kl_shen_trim_whitespace :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_trim_whitespace (!kl_V2210) = do !kl_if_0 <- let pat_cond_1 kl_V2210 kl_V2210h kl_V2210t = do !appl_2 <- klCons (Types.Atom (Types.N (Types.KI 32))) (Types.Atom Types.Nil) - !appl_3 <- appl_2 `pseq` klCons (Types.Atom (Types.N (Types.KI 13))) appl_2 - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.N (Types.KI 10))) appl_3 - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.N (Types.KI 9))) appl_4 - !kl_if_6 <- kl_V2210h `pseq` (appl_5 `pseq` kl_elementP kl_V2210h appl_5) - 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_7 = do do return (Atom (B False)) - in case kl_V2210 of - !(kl_V2210@(Cons (!kl_V2210h) - (!kl_V2210t))) -> pat_cond_1 kl_V2210 kl_V2210h kl_V2210t - _ -> pat_cond_7 - case kl_if_0 of - Atom (B (True)) -> do !appl_8 <- kl_V2210 `pseq` tl kl_V2210 - appl_8 `pseq` kl_shen_trim_whitespace appl_8 - Atom (B (False)) -> do do return kl_V2210 - _ -> throwError "if: expected boolean" - -kl_shen_record_it_h :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_record_it_h (!kl_V2212) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` nToString kl_X))) - !appl_1 <- appl_0 `pseq` (kl_V2212 `pseq` kl_map appl_0 kl_V2212) - !appl_2 <- appl_1 `pseq` kl_shen_cn_all appl_1 - !appl_3 <- appl_2 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*it*")) appl_2 - appl_3 `pseq` (kl_V2212 `pseq` kl_do appl_3 kl_V2212) - -kl_shen_cn_all :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_cn_all (!kl_V2214) = do let pat_cond_0 = do return (Types.Atom (Types.Str "")) - pat_cond_1 kl_V2214 kl_V2214h kl_V2214t = do !appl_2 <- kl_V2214t `pseq` kl_shen_cn_all kl_V2214t - kl_V2214h `pseq` (appl_2 `pseq` cn kl_V2214h appl_2) - pat_cond_3 = do do let !aw_4 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_4 [ApplC (wrapNamed "shen.cn-all" kl_shen_cn_all)] - in case kl_V2214 of - kl_V2214@(Atom (Nil)) -> pat_cond_0 - !(kl_V2214@(Cons (!kl_V2214h) - (!kl_V2214t))) -> pat_cond_1 kl_V2214 kl_V2214h kl_V2214t - _ -> pat_cond_3 - -kl_read_file :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_read_file (!kl_V2216) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Bytelist) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) - let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_read_error kl_X))) - appl_1 `pseq` (kl_Bytelist `pseq` (appl_2 `pseq` kl_compile appl_1 kl_Bytelist appl_2))))) - !appl_3 <- kl_V2216 `pseq` kl_read_file_as_bytelist kl_V2216 - appl_3 `pseq` applyWrapper appl_0 [appl_3] - -kl_read_from_string :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_read_from_string (!kl_V2218) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Ns) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) - let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_read_error kl_X))) - appl_1 `pseq` (kl_Ns `pseq` (appl_2 `pseq` kl_compile appl_1 kl_Ns appl_2))))) - let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` stringToN kl_X))) - !appl_4 <- kl_V2218 `pseq` kl_explode kl_V2218 - !appl_5 <- appl_3 `pseq` (appl_4 `pseq` kl_map appl_3 appl_4) - appl_5 `pseq` applyWrapper appl_0 [appl_5] - -kl_shen_read_error :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_read_error (!kl_V2226) = do let pat_cond_0 kl_V2226 kl_V2226h kl_V2226hh kl_V2226ht kl_V2226t kl_V2226th = do !appl_1 <- kl_V2226h `pseq` kl_shen_compress_50 (Types.Atom (Types.N (Types.KI 50))) kl_V2226h - 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 "read error here:\n\n ")) appl_3 - appl_4 `pseq` simpleError appl_4 - pat_cond_5 = do do simpleError (Types.Atom (Types.Str "read error\n")) - in case kl_V2226 of - !(kl_V2226@(Cons (!(kl_V2226h@(Cons (!kl_V2226hh) - (!kl_V2226ht)))) - (!(kl_V2226t@(Cons (!kl_V2226th) - (Atom (Nil))))))) -> pat_cond_0 kl_V2226 kl_V2226h kl_V2226hh kl_V2226ht kl_V2226t kl_V2226th - _ -> pat_cond_5 - -kl_shen_compress_50 :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_compress_50 (!kl_V2233) (!kl_V2234) = do let pat_cond_0 = do return (Types.Atom (Types.Str "")) - pat_cond_1 = do let pat_cond_2 = do return (Types.Atom (Types.Str "")) - pat_cond_3 = do let pat_cond_4 kl_V2234 kl_V2234h kl_V2234t = do !appl_5 <- kl_V2234h `pseq` nToString kl_V2234h - !appl_6 <- kl_V2233 `pseq` Primitives.subtract kl_V2233 (Types.Atom (Types.N (Types.KI 1))) - !appl_7 <- appl_6 `pseq` (kl_V2234t `pseq` kl_shen_compress_50 appl_6 kl_V2234t) - appl_5 `pseq` (appl_7 `pseq` cn appl_5 appl_7) - pat_cond_8 = do do let !aw_9 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_9 [ApplC (wrapNamed "shen.compress-50" kl_shen_compress_50)] - in case kl_V2234 of - !(kl_V2234@(Cons (!kl_V2234h) - (!kl_V2234t))) -> pat_cond_4 kl_V2234 kl_V2234h kl_V2234t - _ -> pat_cond_8 - in case kl_V2233 of - kl_V2233@(Atom (N (KI 0))) -> pat_cond_2 - _ -> pat_cond_3 - in case kl_V2234 of - kl_V2234@(Atom (Nil)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_LBst_inputRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBst_inputRB (!kl_V2236) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_4 <- kl_fail - !kl_if_5 <- kl_YaccParse `pseq` (appl_4 `pseq` eq kl_YaccParse appl_4) - case kl_if_5 of - Atom (B (True)) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_7 <- kl_fail - !kl_if_8 <- kl_YaccParse `pseq` (appl_7 `pseq` eq kl_YaccParse appl_7) - case kl_if_8 of - Atom (B (True)) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_10 <- kl_fail - !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 !appl_13 <- kl_fail - !kl_if_14 <- kl_YaccParse `pseq` (appl_13 `pseq` eq kl_YaccParse appl_13) - case kl_if_14 of - Atom (B (True)) -> do let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_16 <- kl_fail - !kl_if_17 <- kl_YaccParse `pseq` (appl_16 `pseq` eq kl_YaccParse appl_16) - case kl_if_17 of - Atom (B (True)) -> do let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_19 <- kl_fail - !kl_if_20 <- kl_YaccParse `pseq` (appl_19 `pseq` eq kl_YaccParse appl_19) - case kl_if_20 of - Atom (B (True)) -> do let !appl_21 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_22 <- kl_fail - !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_YaccParse) -> do !appl_25 <- kl_fail - !kl_if_26 <- kl_YaccParse `pseq` (appl_25 `pseq` eq kl_YaccParse appl_25) - case kl_if_26 of - Atom (B (True)) -> do let !appl_27 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_28 <- kl_fail - !kl_if_29 <- kl_YaccParse `pseq` (appl_28 `pseq` eq kl_YaccParse appl_28) - case kl_if_29 of - Atom (B (True)) -> do let !appl_30 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_31 <- kl_fail - !kl_if_32 <- kl_YaccParse `pseq` (appl_31 `pseq` eq kl_YaccParse appl_31) - case kl_if_32 of - Atom (B (True)) -> do let !appl_33 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_34 <- kl_fail - !kl_if_35 <- kl_YaccParse `pseq` (appl_34 `pseq` eq kl_YaccParse appl_34) - case kl_if_35 of - Atom (B (True)) -> do let !appl_36 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_37 <- kl_fail - !kl_if_38 <- kl_YaccParse `pseq` (appl_37 `pseq` eq kl_YaccParse appl_37) - case kl_if_38 of - Atom (B (True)) -> do let !appl_39 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do !appl_40 <- kl_fail - !appl_41 <- appl_40 `pseq` (kl_Parse_LBeRB `pseq` eq appl_40 kl_Parse_LBeRB) - !kl_if_42 <- appl_41 `pseq` kl_not appl_41 - case kl_if_42 of - Atom (B (True)) -> do !appl_43 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB - appl_43 `pseq` kl_shen_pair appl_43 (Types.Atom Types.Nil) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_44 <- kl_V2236 `pseq` kl_LBeRB kl_V2236 - appl_44 `pseq` applyWrapper appl_39 [appl_44] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_45 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBwhitespacesRB) -> do !appl_46 <- kl_fail - !appl_47 <- appl_46 `pseq` (kl_Parse_shen_LBwhitespacesRB `pseq` eq appl_46 kl_Parse_shen_LBwhitespacesRB) - !kl_if_48 <- appl_47 `pseq` kl_not appl_47 - case kl_if_48 of - Atom (B (True)) -> do let !appl_49 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_50 <- kl_fail - !appl_51 <- appl_50 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_50 kl_Parse_shen_LBst_inputRB) - !kl_if_52 <- appl_51 `pseq` kl_not appl_51 - case kl_if_52 of - Atom (B (True)) -> do !appl_53 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_54 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - appl_53 `pseq` (appl_54 `pseq` kl_shen_pair appl_53 appl_54) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_55 <- kl_Parse_shen_LBwhitespacesRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBwhitespacesRB - appl_55 `pseq` applyWrapper appl_49 [appl_55] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_56 <- kl_V2236 `pseq` kl_shen_LBwhitespacesRB kl_V2236 - !appl_57 <- appl_56 `pseq` applyWrapper appl_45 [appl_56] - appl_57 `pseq` applyWrapper appl_36 [appl_57] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_58 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBatomRB) -> do !appl_59 <- kl_fail - !appl_60 <- appl_59 `pseq` (kl_Parse_shen_LBatomRB `pseq` eq appl_59 kl_Parse_shen_LBatomRB) - !kl_if_61 <- appl_60 `pseq` kl_not appl_60 - case kl_if_61 of - Atom (B (True)) -> do let !appl_62 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_63 <- kl_fail - !appl_64 <- appl_63 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_63 kl_Parse_shen_LBst_inputRB) - !kl_if_65 <- appl_64 `pseq` kl_not appl_64 - case kl_if_65 of - Atom (B (True)) -> do !appl_66 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_67 <- kl_Parse_shen_LBatomRB `pseq` kl_shen_hdtl kl_Parse_shen_LBatomRB - let !aw_68 = Types.Atom (Types.UnboundSym "macroexpand") - !appl_69 <- appl_67 `pseq` applyWrapper aw_68 [appl_67] - !appl_70 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - !appl_71 <- appl_69 `pseq` (appl_70 `pseq` klCons appl_69 appl_70) - appl_66 `pseq` (appl_71 `pseq` kl_shen_pair appl_66 appl_71) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_72 <- kl_Parse_shen_LBatomRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBatomRB - appl_72 `pseq` applyWrapper appl_62 [appl_72] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_73 <- kl_V2236 `pseq` kl_shen_LBatomRB kl_V2236 - !appl_74 <- appl_73 `pseq` applyWrapper appl_58 [appl_73] - appl_74 `pseq` applyWrapper appl_33 [appl_74] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_75 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcommentRB) -> do !appl_76 <- kl_fail - !appl_77 <- appl_76 `pseq` (kl_Parse_shen_LBcommentRB `pseq` eq appl_76 kl_Parse_shen_LBcommentRB) - !kl_if_78 <- appl_77 `pseq` kl_not appl_77 - case kl_if_78 of - Atom (B (True)) -> do let !appl_79 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_80 <- kl_fail - !appl_81 <- appl_80 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_80 kl_Parse_shen_LBst_inputRB) - !kl_if_82 <- appl_81 `pseq` kl_not appl_81 - case kl_if_82 of - Atom (B (True)) -> do !appl_83 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_84 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - appl_83 `pseq` (appl_84 `pseq` kl_shen_pair appl_83 appl_84) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_85 <- kl_Parse_shen_LBcommentRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBcommentRB - appl_85 `pseq` applyWrapper appl_79 [appl_85] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_86 <- kl_V2236 `pseq` kl_shen_LBcommentRB kl_V2236 - !appl_87 <- appl_86 `pseq` applyWrapper appl_75 [appl_86] - appl_87 `pseq` applyWrapper appl_30 [appl_87] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_88 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcommaRB) -> do !appl_89 <- kl_fail - !appl_90 <- appl_89 `pseq` (kl_Parse_shen_LBcommaRB `pseq` eq appl_89 kl_Parse_shen_LBcommaRB) - !kl_if_91 <- appl_90 `pseq` kl_not appl_90 - case kl_if_91 of - Atom (B (True)) -> do let !appl_92 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_93 <- kl_fail - !appl_94 <- appl_93 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_93 kl_Parse_shen_LBst_inputRB) - !kl_if_95 <- appl_94 `pseq` kl_not appl_94 - case kl_if_95 of - Atom (B (True)) -> do !appl_96 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_97 <- intern (Types.Atom (Types.Str ",")) - !appl_98 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - !appl_99 <- appl_97 `pseq` (appl_98 `pseq` klCons appl_97 appl_98) - appl_96 `pseq` (appl_99 `pseq` kl_shen_pair appl_96 appl_99) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_100 <- kl_Parse_shen_LBcommaRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBcommaRB - appl_100 `pseq` applyWrapper appl_92 [appl_100] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_101 <- kl_V2236 `pseq` kl_shen_LBcommaRB kl_V2236 - !appl_102 <- appl_101 `pseq` applyWrapper appl_88 [appl_101] - appl_102 `pseq` applyWrapper appl_27 [appl_102] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_103 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcolonRB) -> do !appl_104 <- kl_fail - !appl_105 <- appl_104 `pseq` (kl_Parse_shen_LBcolonRB `pseq` eq appl_104 kl_Parse_shen_LBcolonRB) - !kl_if_106 <- appl_105 `pseq` kl_not appl_105 - case kl_if_106 of - Atom (B (True)) -> do let !appl_107 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_108 <- kl_fail - !appl_109 <- appl_108 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_108 kl_Parse_shen_LBst_inputRB) - !kl_if_110 <- appl_109 `pseq` kl_not appl_109 - case kl_if_110 of - Atom (B (True)) -> do !appl_111 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_112 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - !appl_113 <- appl_112 `pseq` klCons (Types.Atom (Types.UnboundSym ":")) appl_112 - appl_111 `pseq` (appl_113 `pseq` kl_shen_pair appl_111 appl_113) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_114 <- kl_Parse_shen_LBcolonRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBcolonRB - appl_114 `pseq` applyWrapper appl_107 [appl_114] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_115 <- kl_V2236 `pseq` kl_shen_LBcolonRB kl_V2236 - !appl_116 <- appl_115 `pseq` applyWrapper appl_103 [appl_115] - appl_116 `pseq` applyWrapper appl_24 [appl_116] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_117 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcolonRB) -> do !appl_118 <- kl_fail - !appl_119 <- appl_118 `pseq` (kl_Parse_shen_LBcolonRB `pseq` eq appl_118 kl_Parse_shen_LBcolonRB) - !kl_if_120 <- appl_119 `pseq` kl_not appl_119 - case kl_if_120 of - Atom (B (True)) -> do let !appl_121 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBminusRB) -> do !appl_122 <- kl_fail - !appl_123 <- appl_122 `pseq` (kl_Parse_shen_LBminusRB `pseq` eq appl_122 kl_Parse_shen_LBminusRB) - !kl_if_124 <- appl_123 `pseq` kl_not appl_123 - case kl_if_124 of - Atom (B (True)) -> do let !appl_125 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_126 <- kl_fail - !appl_127 <- appl_126 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_126 kl_Parse_shen_LBst_inputRB) - !kl_if_128 <- appl_127 `pseq` kl_not appl_127 - case kl_if_128 of - Atom (B (True)) -> do !appl_129 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_130 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - !appl_131 <- appl_130 `pseq` klCons (Types.Atom (Types.UnboundSym ":-")) appl_130 - appl_129 `pseq` (appl_131 `pseq` kl_shen_pair appl_129 appl_131) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_132 <- kl_Parse_shen_LBminusRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBminusRB - appl_132 `pseq` applyWrapper appl_125 [appl_132] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_133 <- kl_Parse_shen_LBcolonRB `pseq` kl_shen_LBminusRB kl_Parse_shen_LBcolonRB - appl_133 `pseq` applyWrapper appl_121 [appl_133] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_134 <- kl_V2236 `pseq` kl_shen_LBcolonRB kl_V2236 - !appl_135 <- appl_134 `pseq` applyWrapper appl_117 [appl_134] - appl_135 `pseq` applyWrapper appl_21 [appl_135] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_136 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcolonRB) -> do !appl_137 <- kl_fail - !appl_138 <- appl_137 `pseq` (kl_Parse_shen_LBcolonRB `pseq` eq appl_137 kl_Parse_shen_LBcolonRB) - !kl_if_139 <- appl_138 `pseq` kl_not appl_138 - case kl_if_139 of - Atom (B (True)) -> do let !appl_140 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBequalRB) -> do !appl_141 <- kl_fail - !appl_142 <- appl_141 `pseq` (kl_Parse_shen_LBequalRB `pseq` eq appl_141 kl_Parse_shen_LBequalRB) - !kl_if_143 <- appl_142 `pseq` kl_not appl_142 - case kl_if_143 of - Atom (B (True)) -> do let !appl_144 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_145 <- kl_fail - !appl_146 <- appl_145 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_145 kl_Parse_shen_LBst_inputRB) - !kl_if_147 <- appl_146 `pseq` kl_not appl_146 - case kl_if_147 of - Atom (B (True)) -> do !appl_148 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_149 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - !appl_150 <- appl_149 `pseq` klCons (Types.Atom (Types.UnboundSym ":=")) appl_149 - appl_148 `pseq` (appl_150 `pseq` kl_shen_pair appl_148 appl_150) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_151 <- kl_Parse_shen_LBequalRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBequalRB - appl_151 `pseq` applyWrapper appl_144 [appl_151] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_152 <- kl_Parse_shen_LBcolonRB `pseq` kl_shen_LBequalRB kl_Parse_shen_LBcolonRB - appl_152 `pseq` applyWrapper appl_140 [appl_152] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_153 <- kl_V2236 `pseq` kl_shen_LBcolonRB kl_V2236 - !appl_154 <- appl_153 `pseq` applyWrapper appl_136 [appl_153] - appl_154 `pseq` applyWrapper appl_18 [appl_154] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_155 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsemicolonRB) -> do !appl_156 <- kl_fail - !appl_157 <- appl_156 `pseq` (kl_Parse_shen_LBsemicolonRB `pseq` eq appl_156 kl_Parse_shen_LBsemicolonRB) - !kl_if_158 <- appl_157 `pseq` kl_not appl_157 - case kl_if_158 of - Atom (B (True)) -> do let !appl_159 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_160 <- kl_fail - !appl_161 <- appl_160 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_160 kl_Parse_shen_LBst_inputRB) - !kl_if_162 <- appl_161 `pseq` kl_not appl_161 - case kl_if_162 of - Atom (B (True)) -> do !appl_163 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_164 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - !appl_165 <- appl_164 `pseq` klCons (Types.Atom (Types.UnboundSym ";")) appl_164 - appl_163 `pseq` (appl_165 `pseq` kl_shen_pair appl_163 appl_165) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_166 <- kl_Parse_shen_LBsemicolonRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBsemicolonRB - appl_166 `pseq` applyWrapper appl_159 [appl_166] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_167 <- kl_V2236 `pseq` kl_shen_LBsemicolonRB kl_V2236 - !appl_168 <- appl_167 `pseq` applyWrapper appl_155 [appl_167] - appl_168 `pseq` applyWrapper appl_15 [appl_168] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_169 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBbarRB) -> do !appl_170 <- kl_fail - !appl_171 <- appl_170 `pseq` (kl_Parse_shen_LBbarRB `pseq` eq appl_170 kl_Parse_shen_LBbarRB) - !kl_if_172 <- appl_171 `pseq` kl_not appl_171 - case kl_if_172 of - Atom (B (True)) -> do let !appl_173 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_174 <- kl_fail - !appl_175 <- appl_174 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_174 kl_Parse_shen_LBst_inputRB) - !kl_if_176 <- appl_175 `pseq` kl_not appl_175 - case kl_if_176 of - Atom (B (True)) -> do !appl_177 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_178 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - !appl_179 <- appl_178 `pseq` klCons (Types.Atom (Types.UnboundSym "bar!")) appl_178 - appl_177 `pseq` (appl_179 `pseq` kl_shen_pair appl_177 appl_179) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_180 <- kl_Parse_shen_LBbarRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBbarRB - appl_180 `pseq` applyWrapper appl_173 [appl_180] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_181 <- kl_V2236 `pseq` kl_shen_LBbarRB kl_V2236 - !appl_182 <- appl_181 `pseq` applyWrapper appl_169 [appl_181] - appl_182 `pseq` applyWrapper appl_12 [appl_182] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_183 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBrcurlyRB) -> do !appl_184 <- kl_fail - !appl_185 <- appl_184 `pseq` (kl_Parse_shen_LBrcurlyRB `pseq` eq appl_184 kl_Parse_shen_LBrcurlyRB) - !kl_if_186 <- appl_185 `pseq` kl_not appl_185 - case kl_if_186 of - Atom (B (True)) -> do let !appl_187 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_188 <- kl_fail - !appl_189 <- appl_188 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_188 kl_Parse_shen_LBst_inputRB) - !kl_if_190 <- appl_189 `pseq` kl_not appl_189 - case kl_if_190 of - Atom (B (True)) -> do !appl_191 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_192 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - !appl_193 <- appl_192 `pseq` klCons (Types.Atom (Types.UnboundSym "}")) appl_192 - appl_191 `pseq` (appl_193 `pseq` kl_shen_pair appl_191 appl_193) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_194 <- kl_Parse_shen_LBrcurlyRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBrcurlyRB - appl_194 `pseq` applyWrapper appl_187 [appl_194] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_195 <- kl_V2236 `pseq` kl_shen_LBrcurlyRB kl_V2236 - !appl_196 <- appl_195 `pseq` applyWrapper appl_183 [appl_195] - appl_196 `pseq` applyWrapper appl_9 [appl_196] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_197 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBlcurlyRB) -> do !appl_198 <- kl_fail - !appl_199 <- appl_198 `pseq` (kl_Parse_shen_LBlcurlyRB `pseq` eq appl_198 kl_Parse_shen_LBlcurlyRB) - !kl_if_200 <- appl_199 `pseq` kl_not appl_199 - case kl_if_200 of - Atom (B (True)) -> do let !appl_201 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_202 <- kl_fail - !appl_203 <- appl_202 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_202 kl_Parse_shen_LBst_inputRB) - !kl_if_204 <- appl_203 `pseq` kl_not appl_203 - case kl_if_204 of - Atom (B (True)) -> do !appl_205 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_206 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - !appl_207 <- appl_206 `pseq` klCons (Types.Atom (Types.UnboundSym "{")) appl_206 - appl_205 `pseq` (appl_207 `pseq` kl_shen_pair appl_205 appl_207) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_208 <- kl_Parse_shen_LBlcurlyRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBlcurlyRB - appl_208 `pseq` applyWrapper appl_201 [appl_208] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_209 <- kl_V2236 `pseq` kl_shen_LBlcurlyRB kl_V2236 - !appl_210 <- appl_209 `pseq` applyWrapper appl_197 [appl_209] - appl_210 `pseq` applyWrapper appl_6 [appl_210] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_211 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBlrbRB) -> do !appl_212 <- kl_fail - !appl_213 <- appl_212 `pseq` (kl_Parse_shen_LBlrbRB `pseq` eq appl_212 kl_Parse_shen_LBlrbRB) - !kl_if_214 <- appl_213 `pseq` kl_not appl_213 - case kl_if_214 of - Atom (B (True)) -> do let !appl_215 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_input1RB) -> do !appl_216 <- kl_fail - !appl_217 <- appl_216 `pseq` (kl_Parse_shen_LBst_input1RB `pseq` eq appl_216 kl_Parse_shen_LBst_input1RB) - !kl_if_218 <- appl_217 `pseq` kl_not appl_217 - case kl_if_218 of - Atom (B (True)) -> do let !appl_219 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBrrbRB) -> do !appl_220 <- kl_fail - !appl_221 <- appl_220 `pseq` (kl_Parse_shen_LBrrbRB `pseq` eq appl_220 kl_Parse_shen_LBrrbRB) - !kl_if_222 <- appl_221 `pseq` kl_not appl_221 - case kl_if_222 of - Atom (B (True)) -> do let !appl_223 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_input2RB) -> do !appl_224 <- kl_fail - !appl_225 <- appl_224 `pseq` (kl_Parse_shen_LBst_input2RB `pseq` eq appl_224 kl_Parse_shen_LBst_input2RB) - !kl_if_226 <- appl_225 `pseq` kl_not appl_225 - case kl_if_226 of - Atom (B (True)) -> do !appl_227 <- kl_Parse_shen_LBst_input2RB `pseq` hd kl_Parse_shen_LBst_input2RB - !appl_228 <- kl_Parse_shen_LBst_input1RB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_input1RB - let !aw_229 = Types.Atom (Types.UnboundSym "macroexpand") - !appl_230 <- appl_228 `pseq` applyWrapper aw_229 [appl_228] - !appl_231 <- kl_Parse_shen_LBst_input2RB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_input2RB - !appl_232 <- appl_230 `pseq` (appl_231 `pseq` kl_shen_package_macro appl_230 appl_231) - appl_227 `pseq` (appl_232 `pseq` kl_shen_pair appl_227 appl_232) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_233 <- kl_Parse_shen_LBrrbRB `pseq` kl_shen_LBst_input2RB kl_Parse_shen_LBrrbRB - appl_233 `pseq` applyWrapper appl_223 [appl_233] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_234 <- kl_Parse_shen_LBst_input1RB `pseq` kl_shen_LBrrbRB kl_Parse_shen_LBst_input1RB - appl_234 `pseq` applyWrapper appl_219 [appl_234] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_235 <- kl_Parse_shen_LBlrbRB `pseq` kl_shen_LBst_input1RB kl_Parse_shen_LBlrbRB - appl_235 `pseq` applyWrapper appl_215 [appl_235] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_236 <- kl_V2236 `pseq` kl_shen_LBlrbRB kl_V2236 - !appl_237 <- appl_236 `pseq` applyWrapper appl_211 [appl_236] - appl_237 `pseq` applyWrapper appl_3 [appl_237] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_238 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBlsbRB) -> do !appl_239 <- kl_fail - !appl_240 <- appl_239 `pseq` (kl_Parse_shen_LBlsbRB `pseq` eq appl_239 kl_Parse_shen_LBlsbRB) - !kl_if_241 <- appl_240 `pseq` kl_not appl_240 - case kl_if_241 of - Atom (B (True)) -> do let !appl_242 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_input1RB) -> do !appl_243 <- kl_fail - !appl_244 <- appl_243 `pseq` (kl_Parse_shen_LBst_input1RB `pseq` eq appl_243 kl_Parse_shen_LBst_input1RB) - !kl_if_245 <- appl_244 `pseq` kl_not appl_244 - case kl_if_245 of - Atom (B (True)) -> do let !appl_246 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBrsbRB) -> do !appl_247 <- kl_fail - !appl_248 <- appl_247 `pseq` (kl_Parse_shen_LBrsbRB `pseq` eq appl_247 kl_Parse_shen_LBrsbRB) - !kl_if_249 <- appl_248 `pseq` kl_not appl_248 - case kl_if_249 of - Atom (B (True)) -> do let !appl_250 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_input2RB) -> do !appl_251 <- kl_fail - !appl_252 <- appl_251 `pseq` (kl_Parse_shen_LBst_input2RB `pseq` eq appl_251 kl_Parse_shen_LBst_input2RB) - !kl_if_253 <- appl_252 `pseq` kl_not appl_252 - case kl_if_253 of - Atom (B (True)) -> do !appl_254 <- kl_Parse_shen_LBst_input2RB `pseq` hd kl_Parse_shen_LBst_input2RB - !appl_255 <- kl_Parse_shen_LBst_input1RB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_input1RB - !appl_256 <- appl_255 `pseq` kl_shen_cons_form appl_255 - let !aw_257 = Types.Atom (Types.UnboundSym "macroexpand") - !appl_258 <- appl_256 `pseq` applyWrapper aw_257 [appl_256] - !appl_259 <- kl_Parse_shen_LBst_input2RB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_input2RB - !appl_260 <- appl_258 `pseq` (appl_259 `pseq` klCons appl_258 appl_259) - appl_254 `pseq` (appl_260 `pseq` kl_shen_pair appl_254 appl_260) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_261 <- kl_Parse_shen_LBrsbRB `pseq` kl_shen_LBst_input2RB kl_Parse_shen_LBrsbRB - appl_261 `pseq` applyWrapper appl_250 [appl_261] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_262 <- kl_Parse_shen_LBst_input1RB `pseq` kl_shen_LBrsbRB kl_Parse_shen_LBst_input1RB - appl_262 `pseq` applyWrapper appl_246 [appl_262] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_263 <- kl_Parse_shen_LBlsbRB `pseq` kl_shen_LBst_input1RB kl_Parse_shen_LBlsbRB - appl_263 `pseq` applyWrapper appl_242 [appl_263] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_264 <- kl_V2236 `pseq` kl_shen_LBlsbRB kl_V2236 - !appl_265 <- appl_264 `pseq` applyWrapper appl_238 [appl_264] - appl_265 `pseq` applyWrapper appl_0 [appl_265] - -kl_shen_LBlsbRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBlsbRB (!kl_V2238) = do !appl_0 <- kl_V2238 `pseq` hd kl_V2238 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2238 `pseq` hd kl_V2238 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 91))) 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 !appl_6 <- kl_V2238 `pseq` hd kl_V2238 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2238 `pseq` kl_shen_hdtl kl_V2238 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBrsbRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBrsbRB (!kl_V2240) = do !appl_0 <- kl_V2240 `pseq` hd kl_V2240 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2240 `pseq` hd kl_V2240 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 93))) 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 !appl_6 <- kl_V2240 `pseq` hd kl_V2240 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2240 `pseq` kl_shen_hdtl kl_V2240 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBlcurlyRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBlcurlyRB (!kl_V2242) = do !appl_0 <- kl_V2242 `pseq` hd kl_V2242 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2242 `pseq` hd kl_V2242 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 123))) 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 !appl_6 <- kl_V2242 `pseq` hd kl_V2242 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2242 `pseq` kl_shen_hdtl kl_V2242 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBrcurlyRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBrcurlyRB (!kl_V2244) = do !appl_0 <- kl_V2244 `pseq` hd kl_V2244 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2244 `pseq` hd kl_V2244 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 125))) 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 !appl_6 <- kl_V2244 `pseq` hd kl_V2244 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2244 `pseq` kl_shen_hdtl kl_V2244 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBbarRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBbarRB (!kl_V2246) = do !appl_0 <- kl_V2246 `pseq` hd kl_V2246 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2246 `pseq` hd kl_V2246 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 124))) 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 !appl_6 <- kl_V2246 `pseq` hd kl_V2246 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2246 `pseq` kl_shen_hdtl kl_V2246 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBsemicolonRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBsemicolonRB (!kl_V2248) = do !appl_0 <- kl_V2248 `pseq` hd kl_V2248 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2248 `pseq` hd kl_V2248 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 59))) 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 !appl_6 <- kl_V2248 `pseq` hd kl_V2248 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2248 `pseq` kl_shen_hdtl kl_V2248 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBcolonRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBcolonRB (!kl_V2250) = do !appl_0 <- kl_V2250 `pseq` hd kl_V2250 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2250 `pseq` hd kl_V2250 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 58))) 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 !appl_6 <- kl_V2250 `pseq` hd kl_V2250 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2250 `pseq` kl_shen_hdtl kl_V2250 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBcommaRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBcommaRB (!kl_V2252) = do !appl_0 <- kl_V2252 `pseq` hd kl_V2252 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2252 `pseq` hd kl_V2252 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 44))) 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 !appl_6 <- kl_V2252 `pseq` hd kl_V2252 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2252 `pseq` kl_shen_hdtl kl_V2252 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBequalRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBequalRB (!kl_V2254) = do !appl_0 <- kl_V2254 `pseq` hd kl_V2254 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2254 `pseq` hd kl_V2254 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 61))) 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 !appl_6 <- kl_V2254 `pseq` hd kl_V2254 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2254 `pseq` kl_shen_hdtl kl_V2254 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBminusRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBminusRB (!kl_V2256) = do !appl_0 <- kl_V2256 `pseq` hd kl_V2256 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2256 `pseq` hd kl_V2256 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 45))) 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 !appl_6 <- kl_V2256 `pseq` hd kl_V2256 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2256 `pseq` kl_shen_hdtl kl_V2256 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBlrbRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBlrbRB (!kl_V2258) = do !appl_0 <- kl_V2258 `pseq` hd kl_V2258 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2258 `pseq` hd kl_V2258 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 40))) 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 !appl_6 <- kl_V2258 `pseq` hd kl_V2258 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2258 `pseq` kl_shen_hdtl kl_V2258 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBrrbRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBrrbRB (!kl_V2260) = do !appl_0 <- kl_V2260 `pseq` hd kl_V2260 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2260 `pseq` hd kl_V2260 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 41))) 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 !appl_6 <- kl_V2260 `pseq` hd kl_V2260 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2260 `pseq` kl_shen_hdtl kl_V2260 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBatomRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBatomRB (!kl_V2262) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_4 <- kl_fail - !kl_if_5 <- kl_YaccParse `pseq` (appl_4 `pseq` eq kl_YaccParse appl_4) - case kl_if_5 of - Atom (B (True)) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsymRB) -> do !appl_7 <- kl_fail - !appl_8 <- appl_7 `pseq` (kl_Parse_shen_LBsymRB `pseq` eq appl_7 kl_Parse_shen_LBsymRB) - !kl_if_9 <- appl_8 `pseq` kl_not appl_8 - case kl_if_9 of - Atom (B (True)) -> do !appl_10 <- kl_Parse_shen_LBsymRB `pseq` hd kl_Parse_shen_LBsymRB - !appl_11 <- kl_Parse_shen_LBsymRB `pseq` kl_shen_hdtl kl_Parse_shen_LBsymRB - !kl_if_12 <- appl_11 `pseq` eq appl_11 (Types.Atom (Types.Str "<>")) - !appl_13 <- case kl_if_12 of - Atom (B (True)) -> do !appl_14 <- klCons (Types.Atom (Types.N (Types.KI 0))) (Types.Atom Types.Nil) - appl_14 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_14 - Atom (B (False)) -> do do !appl_15 <- kl_Parse_shen_LBsymRB `pseq` kl_shen_hdtl kl_Parse_shen_LBsymRB - appl_15 `pseq` intern appl_15 - _ -> throwError "if: expected boolean" - appl_10 `pseq` (appl_13 `pseq` kl_shen_pair appl_10 appl_13) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_16 <- kl_V2262 `pseq` kl_shen_LBsymRB kl_V2262 - appl_16 `pseq` applyWrapper appl_6 [appl_16] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_17 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnumberRB) -> do !appl_18 <- kl_fail - !appl_19 <- appl_18 `pseq` (kl_Parse_shen_LBnumberRB `pseq` eq appl_18 kl_Parse_shen_LBnumberRB) - !kl_if_20 <- appl_19 `pseq` kl_not appl_19 - case kl_if_20 of - Atom (B (True)) -> do !appl_21 <- kl_Parse_shen_LBnumberRB `pseq` hd kl_Parse_shen_LBnumberRB - !appl_22 <- kl_Parse_shen_LBnumberRB `pseq` kl_shen_hdtl kl_Parse_shen_LBnumberRB - appl_21 `pseq` (appl_22 `pseq` kl_shen_pair appl_21 appl_22) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_23 <- kl_V2262 `pseq` kl_shen_LBnumberRB kl_V2262 - !appl_24 <- appl_23 `pseq` applyWrapper appl_17 [appl_23] - appl_24 `pseq` applyWrapper appl_3 [appl_24] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_25 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstrRB) -> do !appl_26 <- kl_fail - !appl_27 <- appl_26 `pseq` (kl_Parse_shen_LBstrRB `pseq` eq appl_26 kl_Parse_shen_LBstrRB) - !kl_if_28 <- appl_27 `pseq` kl_not appl_27 - case kl_if_28 of - Atom (B (True)) -> do !appl_29 <- kl_Parse_shen_LBstrRB `pseq` hd kl_Parse_shen_LBstrRB - !appl_30 <- kl_Parse_shen_LBstrRB `pseq` kl_shen_hdtl kl_Parse_shen_LBstrRB - !appl_31 <- appl_30 `pseq` kl_shen_control_chars appl_30 - appl_29 `pseq` (appl_31 `pseq` kl_shen_pair appl_29 appl_31) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_32 <- kl_V2262 `pseq` kl_shen_LBstrRB kl_V2262 - !appl_33 <- appl_32 `pseq` applyWrapper appl_25 [appl_32] - appl_33 `pseq` applyWrapper appl_0 [appl_33] - -kl_shen_control_chars :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_control_chars (!kl_V2264) = do let pat_cond_0 = do return (Types.Atom (Types.Str "")) - pat_cond_1 kl_V2264 kl_V2264t kl_V2264tt = do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_CodePoint) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_AfterCodePoint) -> do !appl_4 <- kl_CodePoint `pseq` kl_shen_decimalise kl_CodePoint - !appl_5 <- appl_4 `pseq` nToString appl_4 - !appl_6 <- kl_AfterCodePoint `pseq` kl_shen_control_chars kl_AfterCodePoint - appl_5 `pseq` (appl_6 `pseq` kl_Ats appl_5 appl_6)))) - !appl_7 <- kl_V2264tt `pseq` kl_shen_after_codepoint kl_V2264tt - appl_7 `pseq` applyWrapper appl_3 [appl_7]))) - !appl_8 <- kl_V2264tt `pseq` kl_shen_code_point kl_V2264tt - appl_8 `pseq` applyWrapper appl_2 [appl_8] - pat_cond_9 kl_V2264 kl_V2264h kl_V2264t = do !appl_10 <- kl_V2264t `pseq` kl_shen_control_chars kl_V2264t - kl_V2264h `pseq` (appl_10 `pseq` kl_Ats kl_V2264h appl_10) - pat_cond_11 = do do let !aw_12 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_12 [ApplC (wrapNamed "shen.control-chars" kl_shen_control_chars)] - in case kl_V2264 of - kl_V2264@(Atom (Nil)) -> pat_cond_0 - !(kl_V2264@(Cons (Atom (Str "c")) - (!(kl_V2264t@(Cons (Atom (Str "#")) - (!kl_V2264tt)))))) -> pat_cond_1 kl_V2264 kl_V2264t kl_V2264tt - !(kl_V2264@(Cons (!kl_V2264h) - (!kl_V2264t))) -> pat_cond_9 kl_V2264 kl_V2264h kl_V2264t - _ -> pat_cond_11 - -kl_shen_code_point :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_code_point (!kl_V2268) = do let pat_cond_0 kl_V2268 kl_V2268t = do return (Types.Atom (Types.Str "")) - pat_cond_1 = do !kl_if_2 <- let pat_cond_3 kl_V2268 kl_V2268h kl_V2268t = do !appl_4 <- klCons (Types.Atom (Types.Str "0")) (Types.Atom Types.Nil) - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.Str "9")) appl_4 - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.Str "8")) appl_5 - !appl_7 <- appl_6 `pseq` klCons (Types.Atom (Types.Str "7")) appl_6 - !appl_8 <- appl_7 `pseq` klCons (Types.Atom (Types.Str "6")) appl_7 - !appl_9 <- appl_8 `pseq` klCons (Types.Atom (Types.Str "5")) appl_8 - !appl_10 <- appl_9 `pseq` klCons (Types.Atom (Types.Str "4")) appl_9 - !appl_11 <- appl_10 `pseq` klCons (Types.Atom (Types.Str "3")) appl_10 - !appl_12 <- appl_11 `pseq` klCons (Types.Atom (Types.Str "2")) appl_11 - !appl_13 <- appl_12 `pseq` klCons (Types.Atom (Types.Str "1")) appl_12 - !appl_14 <- appl_13 `pseq` klCons (Types.Atom (Types.Str "0")) appl_13 - !kl_if_15 <- kl_V2268h `pseq` (appl_14 `pseq` kl_elementP kl_V2268h appl_14) - 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" - pat_cond_16 = do do return (Atom (B False)) - in case kl_V2268 of - !(kl_V2268@(Cons (!kl_V2268h) - (!kl_V2268t))) -> pat_cond_3 kl_V2268 kl_V2268h kl_V2268t - _ -> pat_cond_16 - case kl_if_2 of - Atom (B (True)) -> do !appl_17 <- kl_V2268 `pseq` hd kl_V2268 - !appl_18 <- kl_V2268 `pseq` tl kl_V2268 - !appl_19 <- appl_18 `pseq` kl_shen_code_point appl_18 - appl_17 `pseq` (appl_19 `pseq` klCons appl_17 appl_19) - Atom (B (False)) -> do do let !aw_20 = Types.Atom (Types.UnboundSym "shen.app") - !appl_21 <- kl_V2268 `pseq` applyWrapper aw_20 [kl_V2268, - Types.Atom (Types.Str "\n"), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_22 <- appl_21 `pseq` cn (Types.Atom (Types.Str "code point parse error ")) appl_21 - appl_22 `pseq` simpleError appl_22 - _ -> throwError "if: expected boolean" - in case kl_V2268 of - !(kl_V2268@(Cons (Atom (Str ";")) - (!kl_V2268t))) -> pat_cond_0 kl_V2268 kl_V2268t - _ -> pat_cond_1 - -kl_shen_after_codepoint :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_after_codepoint (!kl_V2274) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V2274 kl_V2274t = do return kl_V2274t - pat_cond_2 kl_V2274 kl_V2274h kl_V2274t = do kl_V2274t `pseq` kl_shen_after_codepoint kl_V2274t - pat_cond_3 = do do let !aw_4 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_4 [ApplC (wrapNamed "shen.after-codepoint" kl_shen_after_codepoint)] - in case kl_V2274 of - kl_V2274@(Atom (Nil)) -> pat_cond_0 - !(kl_V2274@(Cons (Atom (Str ";")) - (!kl_V2274t))) -> pat_cond_1 kl_V2274 kl_V2274t - !(kl_V2274@(Cons (!kl_V2274h) - (!kl_V2274t))) -> pat_cond_2 kl_V2274 kl_V2274h kl_V2274t - _ -> pat_cond_3 - -kl_shen_decimalise :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_decimalise (!kl_V2276) = do !appl_0 <- kl_V2276 `pseq` kl_shen_digits_RBintegers kl_V2276 - !appl_1 <- appl_0 `pseq` kl_reverse appl_0 - appl_1 `pseq` kl_shen_pre appl_1 (Types.Atom (Types.N (Types.KI 0))) - -kl_shen_digits_RBintegers :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_digits_RBintegers (!kl_V2282) = do let pat_cond_0 kl_V2282 kl_V2282t = do !appl_1 <- kl_V2282t `pseq` kl_shen_digits_RBintegers kl_V2282t - appl_1 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_1 - pat_cond_2 kl_V2282 kl_V2282t = do !appl_3 <- kl_V2282t `pseq` kl_shen_digits_RBintegers kl_V2282t - appl_3 `pseq` klCons (Types.Atom (Types.N (Types.KI 1))) appl_3 - pat_cond_4 kl_V2282 kl_V2282t = do !appl_5 <- kl_V2282t `pseq` kl_shen_digits_RBintegers kl_V2282t - appl_5 `pseq` klCons (Types.Atom (Types.N (Types.KI 2))) appl_5 - pat_cond_6 kl_V2282 kl_V2282t = do !appl_7 <- kl_V2282t `pseq` kl_shen_digits_RBintegers kl_V2282t - appl_7 `pseq` klCons (Types.Atom (Types.N (Types.KI 3))) appl_7 - pat_cond_8 kl_V2282 kl_V2282t = do !appl_9 <- kl_V2282t `pseq` kl_shen_digits_RBintegers kl_V2282t - appl_9 `pseq` klCons (Types.Atom (Types.N (Types.KI 4))) appl_9 - pat_cond_10 kl_V2282 kl_V2282t = do !appl_11 <- kl_V2282t `pseq` kl_shen_digits_RBintegers kl_V2282t - appl_11 `pseq` klCons (Types.Atom (Types.N (Types.KI 5))) appl_11 - pat_cond_12 kl_V2282 kl_V2282t = do !appl_13 <- kl_V2282t `pseq` kl_shen_digits_RBintegers kl_V2282t - appl_13 `pseq` klCons (Types.Atom (Types.N (Types.KI 6))) appl_13 - pat_cond_14 kl_V2282 kl_V2282t = do !appl_15 <- kl_V2282t `pseq` kl_shen_digits_RBintegers kl_V2282t - appl_15 `pseq` klCons (Types.Atom (Types.N (Types.KI 7))) appl_15 - pat_cond_16 kl_V2282 kl_V2282t = do !appl_17 <- kl_V2282t `pseq` kl_shen_digits_RBintegers kl_V2282t - appl_17 `pseq` klCons (Types.Atom (Types.N (Types.KI 8))) appl_17 - pat_cond_18 kl_V2282 kl_V2282t = do !appl_19 <- kl_V2282t `pseq` kl_shen_digits_RBintegers kl_V2282t - appl_19 `pseq` klCons (Types.Atom (Types.N (Types.KI 9))) appl_19 - pat_cond_20 = do do return (Types.Atom Types.Nil) - in case kl_V2282 of - !(kl_V2282@(Cons (Atom (Str "0")) - (!kl_V2282t))) -> pat_cond_0 kl_V2282 kl_V2282t - !(kl_V2282@(Cons (Atom (Str "1")) - (!kl_V2282t))) -> pat_cond_2 kl_V2282 kl_V2282t - !(kl_V2282@(Cons (Atom (Str "2")) - (!kl_V2282t))) -> pat_cond_4 kl_V2282 kl_V2282t - !(kl_V2282@(Cons (Atom (Str "3")) - (!kl_V2282t))) -> pat_cond_6 kl_V2282 kl_V2282t - !(kl_V2282@(Cons (Atom (Str "4")) - (!kl_V2282t))) -> pat_cond_8 kl_V2282 kl_V2282t - !(kl_V2282@(Cons (Atom (Str "5")) - (!kl_V2282t))) -> pat_cond_10 kl_V2282 kl_V2282t - !(kl_V2282@(Cons (Atom (Str "6")) - (!kl_V2282t))) -> pat_cond_12 kl_V2282 kl_V2282t - !(kl_V2282@(Cons (Atom (Str "7")) - (!kl_V2282t))) -> pat_cond_14 kl_V2282 kl_V2282t - !(kl_V2282@(Cons (Atom (Str "8")) - (!kl_V2282t))) -> pat_cond_16 kl_V2282 kl_V2282t - !(kl_V2282@(Cons (Atom (Str "9")) - (!kl_V2282t))) -> pat_cond_18 kl_V2282 kl_V2282t - _ -> pat_cond_20 - -kl_shen_LBsymRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBsymRB (!kl_V2284) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBalphaRB) -> do !appl_1 <- kl_fail - !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBalphaRB `pseq` eq appl_1 kl_Parse_shen_LBalphaRB) - !kl_if_3 <- appl_2 `pseq` kl_not appl_2 - case kl_if_3 of - Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBalphanumsRB) -> do !appl_5 <- kl_fail - !appl_6 <- appl_5 `pseq` (kl_Parse_shen_LBalphanumsRB `pseq` eq appl_5 kl_Parse_shen_LBalphanumsRB) - !kl_if_7 <- appl_6 `pseq` kl_not appl_6 - case kl_if_7 of - Atom (B (True)) -> do !appl_8 <- kl_Parse_shen_LBalphanumsRB `pseq` hd kl_Parse_shen_LBalphanumsRB - !appl_9 <- kl_Parse_shen_LBalphaRB `pseq` kl_shen_hdtl kl_Parse_shen_LBalphaRB - !appl_10 <- kl_Parse_shen_LBalphanumsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBalphanumsRB - !appl_11 <- appl_9 `pseq` (appl_10 `pseq` kl_Ats appl_9 appl_10) - appl_8 `pseq` (appl_11 `pseq` kl_shen_pair appl_8 appl_11) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_12 <- kl_Parse_shen_LBalphaRB `pseq` kl_shen_LBalphanumsRB kl_Parse_shen_LBalphaRB - appl_12 `pseq` applyWrapper appl_4 [appl_12] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_13 <- kl_V2284 `pseq` kl_shen_LBalphaRB kl_V2284 - appl_13 `pseq` applyWrapper appl_0 [appl_13] - -kl_shen_LBalphanumsRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBalphanumsRB (!kl_V2286) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do !appl_4 <- kl_fail - !appl_5 <- appl_4 `pseq` (kl_Parse_LBeRB `pseq` eq appl_4 kl_Parse_LBeRB) - !kl_if_6 <- appl_5 `pseq` kl_not appl_5 - case kl_if_6 of - Atom (B (True)) -> do !appl_7 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB - appl_7 `pseq` kl_shen_pair appl_7 (Types.Atom (Types.Str "")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_8 <- kl_V2286 `pseq` kl_LBeRB kl_V2286 - appl_8 `pseq` applyWrapper appl_3 [appl_8] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBalphanumRB) -> do !appl_10 <- kl_fail - !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBalphanumRB `pseq` eq appl_10 kl_Parse_shen_LBalphanumRB) - !kl_if_12 <- appl_11 `pseq` kl_not appl_11 - case kl_if_12 of - Atom (B (True)) -> do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBalphanumsRB) -> do !appl_14 <- kl_fail - !appl_15 <- appl_14 `pseq` (kl_Parse_shen_LBalphanumsRB `pseq` eq appl_14 kl_Parse_shen_LBalphanumsRB) - !kl_if_16 <- appl_15 `pseq` kl_not appl_15 - case kl_if_16 of - Atom (B (True)) -> do !appl_17 <- kl_Parse_shen_LBalphanumsRB `pseq` hd kl_Parse_shen_LBalphanumsRB - !appl_18 <- kl_Parse_shen_LBalphanumRB `pseq` kl_shen_hdtl kl_Parse_shen_LBalphanumRB - !appl_19 <- kl_Parse_shen_LBalphanumsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBalphanumsRB - !appl_20 <- appl_18 `pseq` (appl_19 `pseq` kl_Ats appl_18 appl_19) - appl_17 `pseq` (appl_20 `pseq` kl_shen_pair appl_17 appl_20) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_21 <- kl_Parse_shen_LBalphanumRB `pseq` kl_shen_LBalphanumsRB kl_Parse_shen_LBalphanumRB - appl_21 `pseq` applyWrapper appl_13 [appl_21] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_22 <- kl_V2286 `pseq` kl_shen_LBalphanumRB kl_V2286 - !appl_23 <- appl_22 `pseq` applyWrapper appl_9 [appl_22] - appl_23 `pseq` applyWrapper appl_0 [appl_23] - -kl_shen_LBalphanumRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBalphanumRB (!kl_V2288) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnumRB) -> do !appl_4 <- kl_fail - !appl_5 <- appl_4 `pseq` (kl_Parse_shen_LBnumRB `pseq` eq appl_4 kl_Parse_shen_LBnumRB) - !kl_if_6 <- appl_5 `pseq` kl_not appl_5 - case kl_if_6 of - Atom (B (True)) -> do !appl_7 <- kl_Parse_shen_LBnumRB `pseq` hd kl_Parse_shen_LBnumRB - !appl_8 <- kl_Parse_shen_LBnumRB `pseq` kl_shen_hdtl kl_Parse_shen_LBnumRB - appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_9 <- kl_V2288 `pseq` kl_shen_LBnumRB kl_V2288 - appl_9 `pseq` applyWrapper appl_3 [appl_9] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBalphaRB) -> do !appl_11 <- kl_fail - !appl_12 <- appl_11 `pseq` (kl_Parse_shen_LBalphaRB `pseq` eq appl_11 kl_Parse_shen_LBalphaRB) - !kl_if_13 <- appl_12 `pseq` kl_not appl_12 - case kl_if_13 of - Atom (B (True)) -> do !appl_14 <- kl_Parse_shen_LBalphaRB `pseq` hd kl_Parse_shen_LBalphaRB - !appl_15 <- kl_Parse_shen_LBalphaRB `pseq` kl_shen_hdtl kl_Parse_shen_LBalphaRB - appl_14 `pseq` (appl_15 `pseq` kl_shen_pair appl_14 appl_15) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_16 <- kl_V2288 `pseq` kl_shen_LBalphaRB kl_V2288 - !appl_17 <- appl_16 `pseq` applyWrapper appl_10 [appl_16] - appl_17 `pseq` applyWrapper appl_0 [appl_17] - -kl_shen_LBnumRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBnumRB (!kl_V2290) = do !appl_0 <- kl_V2290 `pseq` hd kl_V2290 - !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_Byte) -> do !kl_if_3 <- kl_Parse_Byte `pseq` kl_shen_numbyteP kl_Parse_Byte - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_V2290 `pseq` hd kl_V2290 - !appl_5 <- appl_4 `pseq` tl appl_4 - !appl_6 <- kl_V2290 `pseq` kl_shen_hdtl kl_V2290 - !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) - !appl_8 <- appl_7 `pseq` hd appl_7 - !appl_9 <- kl_Parse_Byte `pseq` nToString kl_Parse_Byte - appl_8 `pseq` (appl_9 `pseq` kl_shen_pair appl_8 appl_9) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_10 <- kl_V2290 `pseq` hd kl_V2290 - !appl_11 <- appl_10 `pseq` hd appl_10 - appl_11 `pseq` applyWrapper appl_2 [appl_11] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_numbyteP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_numbyteP (!kl_V2296) = do let pat_cond_0 = do return (Atom (B True)) - pat_cond_1 = do return (Atom (B True)) - pat_cond_2 = do return (Atom (B True)) - pat_cond_3 = do return (Atom (B True)) - pat_cond_4 = do return (Atom (B True)) - pat_cond_5 = do return (Atom (B True)) - pat_cond_6 = do return (Atom (B True)) - pat_cond_7 = do return (Atom (B True)) - pat_cond_8 = do return (Atom (B True)) - pat_cond_9 = do return (Atom (B True)) - pat_cond_10 = do do return (Atom (B False)) - in case kl_V2296 of - kl_V2296@(Atom (N (KI 48))) -> pat_cond_0 - kl_V2296@(Atom (N (KI 49))) -> pat_cond_1 - kl_V2296@(Atom (N (KI 50))) -> pat_cond_2 - kl_V2296@(Atom (N (KI 51))) -> pat_cond_3 - kl_V2296@(Atom (N (KI 52))) -> pat_cond_4 - kl_V2296@(Atom (N (KI 53))) -> pat_cond_5 - kl_V2296@(Atom (N (KI 54))) -> pat_cond_6 - kl_V2296@(Atom (N (KI 55))) -> pat_cond_7 - kl_V2296@(Atom (N (KI 56))) -> pat_cond_8 - kl_V2296@(Atom (N (KI 57))) -> pat_cond_9 - _ -> pat_cond_10 - -kl_shen_LBalphaRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBalphaRB (!kl_V2298) = do !appl_0 <- kl_V2298 `pseq` hd kl_V2298 - !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_Byte) -> do !kl_if_3 <- kl_Parse_Byte `pseq` kl_shen_symbol_codeP kl_Parse_Byte - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_V2298 `pseq` hd kl_V2298 - !appl_5 <- appl_4 `pseq` tl appl_4 - !appl_6 <- kl_V2298 `pseq` kl_shen_hdtl kl_V2298 - !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) - !appl_8 <- appl_7 `pseq` hd appl_7 - !appl_9 <- kl_Parse_Byte `pseq` nToString kl_Parse_Byte - appl_8 `pseq` (appl_9 `pseq` kl_shen_pair appl_8 appl_9) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_10 <- kl_V2298 `pseq` hd kl_V2298 - !appl_11 <- appl_10 `pseq` hd appl_10 - appl_11 `pseq` applyWrapper appl_2 [appl_11] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_symbol_codeP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_symbol_codeP (!kl_V2300) = do let pat_cond_0 = do return (Atom (B True)) - pat_cond_1 = do do !kl_if_2 <- kl_V2300 `pseq` greaterThan kl_V2300 (Types.Atom (Types.N (Types.KI 94))) - !kl_if_3 <- case kl_if_2 of - Atom (B (True)) -> do !kl_if_4 <- kl_V2300 `pseq` lessThan kl_V2300 (Types.Atom (Types.N (Types.KI 123))) - 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" - !kl_if_5 <- case kl_if_3 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_6 <- kl_V2300 `pseq` greaterThan kl_V2300 (Types.Atom (Types.N (Types.KI 59))) - !kl_if_7 <- case kl_if_6 of - Atom (B (True)) -> do !kl_if_8 <- kl_V2300 `pseq` lessThan kl_V2300 (Types.Atom (Types.N (Types.KI 91))) - 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" - !kl_if_9 <- case kl_if_7 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_10 <- kl_V2300 `pseq` greaterThan kl_V2300 (Types.Atom (Types.N (Types.KI 41))) - !kl_if_11 <- case kl_if_10 of - Atom (B (True)) -> do !kl_if_12 <- kl_V2300 `pseq` lessThan kl_V2300 (Types.Atom (Types.N (Types.KI 58))) - !kl_if_13 <- case kl_if_12 of - Atom (B (True)) -> do !appl_14 <- kl_V2300 `pseq` eq kl_V2300 (Types.Atom (Types.N (Types.KI 44))) - !kl_if_15 <- appl_14 `pseq` kl_not appl_14 - 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" - case kl_if_13 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - !kl_if_16 <- case kl_if_11 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_17 <- kl_V2300 `pseq` greaterThan kl_V2300 (Types.Atom (Types.N (Types.KI 34))) - !kl_if_18 <- case kl_if_17 of - Atom (B (True)) -> do !kl_if_19 <- kl_V2300 `pseq` lessThan kl_V2300 (Types.Atom (Types.N (Types.KI 40))) - case kl_if_19 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - !kl_if_20 <- case kl_if_18 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do let pat_cond_21 = do return (Atom (B True)) - pat_cond_22 = do do return (Atom (B False)) - in case kl_V2300 of - kl_V2300@(Atom (N (KI 33))) -> pat_cond_21 - _ -> pat_cond_22 - _ -> throwError "if: expected boolean" - case kl_if_20 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - case kl_if_16 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - case kl_if_9 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - 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" - in case kl_V2300 of - kl_V2300@(Atom (N (KI 126))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_LBstrRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBstrRB (!kl_V2302) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdbqRB) -> do !appl_1 <- kl_fail - !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBdbqRB `pseq` eq appl_1 kl_Parse_shen_LBdbqRB) - !kl_if_3 <- appl_2 `pseq` kl_not appl_2 - case kl_if_3 of - Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstrcontentsRB) -> do !appl_5 <- kl_fail - !appl_6 <- appl_5 `pseq` (kl_Parse_shen_LBstrcontentsRB `pseq` eq appl_5 kl_Parse_shen_LBstrcontentsRB) - !kl_if_7 <- appl_6 `pseq` kl_not appl_6 - case kl_if_7 of - Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdbqRB) -> do !appl_9 <- kl_fail - !appl_10 <- appl_9 `pseq` (kl_Parse_shen_LBdbqRB `pseq` eq appl_9 kl_Parse_shen_LBdbqRB) - !kl_if_11 <- appl_10 `pseq` kl_not appl_10 - case kl_if_11 of - Atom (B (True)) -> do !appl_12 <- kl_Parse_shen_LBdbqRB `pseq` hd kl_Parse_shen_LBdbqRB - !appl_13 <- kl_Parse_shen_LBstrcontentsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBstrcontentsRB - appl_12 `pseq` (appl_13 `pseq` kl_shen_pair appl_12 appl_13) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_14 <- kl_Parse_shen_LBstrcontentsRB `pseq` kl_shen_LBdbqRB kl_Parse_shen_LBstrcontentsRB - appl_14 `pseq` applyWrapper appl_8 [appl_14] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_15 <- kl_Parse_shen_LBdbqRB `pseq` kl_shen_LBstrcontentsRB kl_Parse_shen_LBdbqRB - appl_15 `pseq` applyWrapper appl_4 [appl_15] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_16 <- kl_V2302 `pseq` kl_shen_LBdbqRB kl_V2302 - appl_16 `pseq` applyWrapper appl_0 [appl_16] - -kl_shen_LBdbqRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBdbqRB (!kl_V2304) = do !appl_0 <- kl_V2304 `pseq` hd kl_V2304 - !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_Byte) -> do let pat_cond_3 = do !appl_4 <- kl_V2304 `pseq` hd kl_V2304 - !appl_5 <- appl_4 `pseq` tl appl_4 - !appl_6 <- kl_V2304 `pseq` kl_shen_hdtl kl_V2304 - !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) - !appl_8 <- appl_7 `pseq` hd appl_7 - appl_8 `pseq` (kl_Parse_Byte `pseq` kl_shen_pair appl_8 kl_Parse_Byte) - pat_cond_9 = do do kl_fail - in case kl_Parse_Byte of - kl_Parse_Byte@(Atom (N (KI 34))) -> pat_cond_3 - _ -> pat_cond_9))) - !appl_10 <- kl_V2304 `pseq` hd kl_V2304 - !appl_11 <- appl_10 `pseq` hd appl_10 - appl_11 `pseq` applyWrapper appl_2 [appl_11] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBstrcontentsRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBstrcontentsRB (!kl_V2306) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do !appl_4 <- kl_fail - !appl_5 <- appl_4 `pseq` (kl_Parse_LBeRB `pseq` eq appl_4 kl_Parse_LBeRB) - !kl_if_6 <- appl_5 `pseq` kl_not appl_5 - case kl_if_6 of - Atom (B (True)) -> do !appl_7 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB - appl_7 `pseq` kl_shen_pair appl_7 (Types.Atom Types.Nil) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_8 <- kl_V2306 `pseq` kl_LBeRB kl_V2306 - appl_8 `pseq` applyWrapper appl_3 [appl_8] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstrcRB) -> do !appl_10 <- kl_fail - !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBstrcRB `pseq` eq appl_10 kl_Parse_shen_LBstrcRB) - !kl_if_12 <- appl_11 `pseq` kl_not appl_11 - case kl_if_12 of - Atom (B (True)) -> do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstrcontentsRB) -> do !appl_14 <- kl_fail - !appl_15 <- appl_14 `pseq` (kl_Parse_shen_LBstrcontentsRB `pseq` eq appl_14 kl_Parse_shen_LBstrcontentsRB) - !kl_if_16 <- appl_15 `pseq` kl_not appl_15 - case kl_if_16 of - Atom (B (True)) -> do !appl_17 <- kl_Parse_shen_LBstrcontentsRB `pseq` hd kl_Parse_shen_LBstrcontentsRB - !appl_18 <- kl_Parse_shen_LBstrcRB `pseq` kl_shen_hdtl kl_Parse_shen_LBstrcRB - !appl_19 <- kl_Parse_shen_LBstrcontentsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBstrcontentsRB - !appl_20 <- appl_18 `pseq` (appl_19 `pseq` klCons appl_18 appl_19) - appl_17 `pseq` (appl_20 `pseq` kl_shen_pair appl_17 appl_20) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_21 <- kl_Parse_shen_LBstrcRB `pseq` kl_shen_LBstrcontentsRB kl_Parse_shen_LBstrcRB - appl_21 `pseq` applyWrapper appl_13 [appl_21] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_22 <- kl_V2306 `pseq` kl_shen_LBstrcRB kl_V2306 - !appl_23 <- appl_22 `pseq` applyWrapper appl_9 [appl_22] - appl_23 `pseq` applyWrapper appl_0 [appl_23] - -kl_shen_LBbyteRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBbyteRB (!kl_V2308) = do !appl_0 <- kl_V2308 `pseq` hd kl_V2308 - !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_Byte) -> do !appl_3 <- kl_V2308 `pseq` hd kl_V2308 - !appl_4 <- appl_3 `pseq` tl appl_3 - !appl_5 <- kl_V2308 `pseq` kl_shen_hdtl kl_V2308 - !appl_6 <- appl_4 `pseq` (appl_5 `pseq` kl_shen_pair appl_4 appl_5) - !appl_7 <- appl_6 `pseq` hd appl_6 - !appl_8 <- kl_Parse_Byte `pseq` nToString kl_Parse_Byte - appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8)))) - !appl_9 <- kl_V2308 `pseq` hd kl_V2308 - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` applyWrapper appl_2 [appl_10] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBstrcRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBstrcRB (!kl_V2310) = do !appl_0 <- kl_V2310 `pseq` hd kl_V2310 - !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_Byte) -> do !appl_3 <- kl_Parse_Byte `pseq` eq kl_Parse_Byte (Types.Atom (Types.N (Types.KI 34))) - !kl_if_4 <- appl_3 `pseq` kl_not appl_3 - case kl_if_4 of - Atom (B (True)) -> do !appl_5 <- kl_V2310 `pseq` hd kl_V2310 - !appl_6 <- appl_5 `pseq` tl appl_5 - !appl_7 <- kl_V2310 `pseq` kl_shen_hdtl kl_V2310 - !appl_8 <- appl_6 `pseq` (appl_7 `pseq` kl_shen_pair appl_6 appl_7) - !appl_9 <- appl_8 `pseq` hd appl_8 - !appl_10 <- kl_Parse_Byte `pseq` nToString kl_Parse_Byte - appl_9 `pseq` (appl_10 `pseq` kl_shen_pair appl_9 appl_10) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_11 <- kl_V2310 `pseq` hd kl_V2310 - !appl_12 <- appl_11 `pseq` hd appl_11 - appl_12 `pseq` applyWrapper appl_2 [appl_12] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBnumberRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBnumberRB (!kl_V2312) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_4 <- kl_fail - !kl_if_5 <- kl_YaccParse `pseq` (appl_4 `pseq` eq kl_YaccParse appl_4) - case kl_if_5 of - Atom (B (True)) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_7 <- kl_fail - !kl_if_8 <- kl_YaccParse `pseq` (appl_7 `pseq` eq kl_YaccParse appl_7) - case kl_if_8 of - Atom (B (True)) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_10 <- kl_fail - !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 !appl_13 <- kl_fail - !kl_if_14 <- kl_YaccParse `pseq` (appl_13 `pseq` eq kl_YaccParse appl_13) - case kl_if_14 of - Atom (B (True)) -> do let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_16 <- kl_fail - !appl_17 <- appl_16 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_16 kl_Parse_shen_LBdigitsRB) - !kl_if_18 <- appl_17 `pseq` kl_not appl_17 - case kl_if_18 of - Atom (B (True)) -> do !appl_19 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB - !appl_20 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB - !appl_21 <- appl_20 `pseq` kl_reverse appl_20 - !appl_22 <- appl_21 `pseq` kl_shen_pre appl_21 (Types.Atom (Types.N (Types.KI 0))) - appl_19 `pseq` (appl_22 `pseq` kl_shen_pair appl_19 appl_22) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_23 <- kl_V2312 `pseq` kl_shen_LBdigitsRB kl_V2312 - appl_23 `pseq` applyWrapper appl_15 [appl_23] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpredigitsRB) -> do !appl_25 <- kl_fail - !appl_26 <- appl_25 `pseq` (kl_Parse_shen_LBpredigitsRB `pseq` eq appl_25 kl_Parse_shen_LBpredigitsRB) - !kl_if_27 <- appl_26 `pseq` kl_not appl_26 - case kl_if_27 of - Atom (B (True)) -> do let !appl_28 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstopRB) -> do !appl_29 <- kl_fail - !appl_30 <- appl_29 `pseq` (kl_Parse_shen_LBstopRB `pseq` eq appl_29 kl_Parse_shen_LBstopRB) - !kl_if_31 <- appl_30 `pseq` kl_not appl_30 - case kl_if_31 of - Atom (B (True)) -> do let !appl_32 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpostdigitsRB) -> do !appl_33 <- kl_fail - !appl_34 <- appl_33 `pseq` (kl_Parse_shen_LBpostdigitsRB `pseq` eq appl_33 kl_Parse_shen_LBpostdigitsRB) - !kl_if_35 <- appl_34 `pseq` kl_not appl_34 - case kl_if_35 of - Atom (B (True)) -> do !appl_36 <- kl_Parse_shen_LBpostdigitsRB `pseq` hd kl_Parse_shen_LBpostdigitsRB - !appl_37 <- kl_Parse_shen_LBpredigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBpredigitsRB - !appl_38 <- appl_37 `pseq` kl_reverse appl_37 - !appl_39 <- appl_38 `pseq` kl_shen_pre appl_38 (Types.Atom (Types.N (Types.KI 0))) - !appl_40 <- kl_Parse_shen_LBpostdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBpostdigitsRB - !appl_41 <- appl_40 `pseq` kl_shen_post appl_40 (Types.Atom (Types.N (Types.KI 1))) - !appl_42 <- appl_39 `pseq` (appl_41 `pseq` add appl_39 appl_41) - appl_36 `pseq` (appl_42 `pseq` kl_shen_pair appl_36 appl_42) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_43 <- kl_Parse_shen_LBstopRB `pseq` kl_shen_LBpostdigitsRB kl_Parse_shen_LBstopRB - appl_43 `pseq` applyWrapper appl_32 [appl_43] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_44 <- kl_Parse_shen_LBpredigitsRB `pseq` kl_shen_LBstopRB kl_Parse_shen_LBpredigitsRB - appl_44 `pseq` applyWrapper appl_28 [appl_44] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_45 <- kl_V2312 `pseq` kl_shen_LBpredigitsRB kl_V2312 - !appl_46 <- appl_45 `pseq` applyWrapper appl_24 [appl_45] - appl_46 `pseq` applyWrapper appl_12 [appl_46] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_47 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_48 <- kl_fail - !appl_49 <- appl_48 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_48 kl_Parse_shen_LBdigitsRB) - !kl_if_50 <- appl_49 `pseq` kl_not appl_49 - case kl_if_50 of - Atom (B (True)) -> do let !appl_51 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBERB) -> do !appl_52 <- kl_fail - !appl_53 <- appl_52 `pseq` (kl_Parse_shen_LBERB `pseq` eq appl_52 kl_Parse_shen_LBERB) - !kl_if_54 <- appl_53 `pseq` kl_not appl_53 - case kl_if_54 of - Atom (B (True)) -> do let !appl_55 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBlog10RB) -> do !appl_56 <- kl_fail - !appl_57 <- appl_56 `pseq` (kl_Parse_shen_LBlog10RB `pseq` eq appl_56 kl_Parse_shen_LBlog10RB) - !kl_if_58 <- appl_57 `pseq` kl_not appl_57 - case kl_if_58 of - Atom (B (True)) -> do !appl_59 <- kl_Parse_shen_LBlog10RB `pseq` hd kl_Parse_shen_LBlog10RB - !appl_60 <- kl_Parse_shen_LBlog10RB `pseq` kl_shen_hdtl kl_Parse_shen_LBlog10RB - !appl_61 <- appl_60 `pseq` kl_shen_expt (Types.Atom (Types.N (Types.KI 10))) appl_60 - !appl_62 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB - !appl_63 <- appl_62 `pseq` kl_reverse appl_62 - !appl_64 <- appl_63 `pseq` kl_shen_pre appl_63 (Types.Atom (Types.N (Types.KI 0))) - !appl_65 <- appl_61 `pseq` (appl_64 `pseq` multiply appl_61 appl_64) - appl_59 `pseq` (appl_65 `pseq` kl_shen_pair appl_59 appl_65) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_66 <- kl_Parse_shen_LBERB `pseq` kl_shen_LBlog10RB kl_Parse_shen_LBERB - appl_66 `pseq` applyWrapper appl_55 [appl_66] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_67 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_LBERB kl_Parse_shen_LBdigitsRB - appl_67 `pseq` applyWrapper appl_51 [appl_67] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_68 <- kl_V2312 `pseq` kl_shen_LBdigitsRB kl_V2312 - !appl_69 <- appl_68 `pseq` applyWrapper appl_47 [appl_68] - appl_69 `pseq` applyWrapper appl_9 [appl_69] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_70 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpredigitsRB) -> do !appl_71 <- kl_fail - !appl_72 <- appl_71 `pseq` (kl_Parse_shen_LBpredigitsRB `pseq` eq appl_71 kl_Parse_shen_LBpredigitsRB) - !kl_if_73 <- appl_72 `pseq` kl_not appl_72 - case kl_if_73 of - Atom (B (True)) -> do let !appl_74 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstopRB) -> do !appl_75 <- kl_fail - !appl_76 <- appl_75 `pseq` (kl_Parse_shen_LBstopRB `pseq` eq appl_75 kl_Parse_shen_LBstopRB) - !kl_if_77 <- appl_76 `pseq` kl_not appl_76 - case kl_if_77 of - Atom (B (True)) -> do let !appl_78 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpostdigitsRB) -> do !appl_79 <- kl_fail - !appl_80 <- appl_79 `pseq` (kl_Parse_shen_LBpostdigitsRB `pseq` eq appl_79 kl_Parse_shen_LBpostdigitsRB) - !kl_if_81 <- appl_80 `pseq` kl_not appl_80 - case kl_if_81 of - Atom (B (True)) -> do let !appl_82 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBERB) -> do !appl_83 <- kl_fail - !appl_84 <- appl_83 `pseq` (kl_Parse_shen_LBERB `pseq` eq appl_83 kl_Parse_shen_LBERB) - !kl_if_85 <- appl_84 `pseq` kl_not appl_84 - case kl_if_85 of - Atom (B (True)) -> do let !appl_86 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBlog10RB) -> do !appl_87 <- kl_fail - !appl_88 <- appl_87 `pseq` (kl_Parse_shen_LBlog10RB `pseq` eq appl_87 kl_Parse_shen_LBlog10RB) - !kl_if_89 <- appl_88 `pseq` kl_not appl_88 - case kl_if_89 of - Atom (B (True)) -> do !appl_90 <- kl_Parse_shen_LBlog10RB `pseq` hd kl_Parse_shen_LBlog10RB - !appl_91 <- kl_Parse_shen_LBlog10RB `pseq` kl_shen_hdtl kl_Parse_shen_LBlog10RB - !appl_92 <- appl_91 `pseq` kl_shen_expt (Types.Atom (Types.N (Types.KI 10))) appl_91 - !appl_93 <- kl_Parse_shen_LBpredigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBpredigitsRB - !appl_94 <- appl_93 `pseq` kl_reverse appl_93 - !appl_95 <- appl_94 `pseq` kl_shen_pre appl_94 (Types.Atom (Types.N (Types.KI 0))) - !appl_96 <- kl_Parse_shen_LBpostdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBpostdigitsRB - !appl_97 <- appl_96 `pseq` kl_shen_post appl_96 (Types.Atom (Types.N (Types.KI 1))) - !appl_98 <- appl_95 `pseq` (appl_97 `pseq` add appl_95 appl_97) - !appl_99 <- appl_92 `pseq` (appl_98 `pseq` multiply appl_92 appl_98) - appl_90 `pseq` (appl_99 `pseq` kl_shen_pair appl_90 appl_99) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_100 <- kl_Parse_shen_LBERB `pseq` kl_shen_LBlog10RB kl_Parse_shen_LBERB - appl_100 `pseq` applyWrapper appl_86 [appl_100] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_101 <- kl_Parse_shen_LBpostdigitsRB `pseq` kl_shen_LBERB kl_Parse_shen_LBpostdigitsRB - appl_101 `pseq` applyWrapper appl_82 [appl_101] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_102 <- kl_Parse_shen_LBstopRB `pseq` kl_shen_LBpostdigitsRB kl_Parse_shen_LBstopRB - appl_102 `pseq` applyWrapper appl_78 [appl_102] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_103 <- kl_Parse_shen_LBpredigitsRB `pseq` kl_shen_LBstopRB kl_Parse_shen_LBpredigitsRB - appl_103 `pseq` applyWrapper appl_74 [appl_103] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_104 <- kl_V2312 `pseq` kl_shen_LBpredigitsRB kl_V2312 - !appl_105 <- appl_104 `pseq` applyWrapper appl_70 [appl_104] - appl_105 `pseq` applyWrapper appl_6 [appl_105] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_106 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBplusRB) -> do !appl_107 <- kl_fail - !appl_108 <- appl_107 `pseq` (kl_Parse_shen_LBplusRB `pseq` eq appl_107 kl_Parse_shen_LBplusRB) - !kl_if_109 <- appl_108 `pseq` kl_not appl_108 - case kl_if_109 of - Atom (B (True)) -> do let !appl_110 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnumberRB) -> do !appl_111 <- kl_fail - !appl_112 <- appl_111 `pseq` (kl_Parse_shen_LBnumberRB `pseq` eq appl_111 kl_Parse_shen_LBnumberRB) - !kl_if_113 <- appl_112 `pseq` kl_not appl_112 - case kl_if_113 of - Atom (B (True)) -> do !appl_114 <- kl_Parse_shen_LBnumberRB `pseq` hd kl_Parse_shen_LBnumberRB - !appl_115 <- kl_Parse_shen_LBnumberRB `pseq` kl_shen_hdtl kl_Parse_shen_LBnumberRB - appl_114 `pseq` (appl_115 `pseq` kl_shen_pair appl_114 appl_115) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_116 <- kl_Parse_shen_LBplusRB `pseq` kl_shen_LBnumberRB kl_Parse_shen_LBplusRB - appl_116 `pseq` applyWrapper appl_110 [appl_116] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_117 <- kl_V2312 `pseq` kl_shen_LBplusRB kl_V2312 - !appl_118 <- appl_117 `pseq` applyWrapper appl_106 [appl_117] - appl_118 `pseq` applyWrapper appl_3 [appl_118] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_119 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBminusRB) -> do !appl_120 <- kl_fail - !appl_121 <- appl_120 `pseq` (kl_Parse_shen_LBminusRB `pseq` eq appl_120 kl_Parse_shen_LBminusRB) - !kl_if_122 <- appl_121 `pseq` kl_not appl_121 - case kl_if_122 of - Atom (B (True)) -> do let !appl_123 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnumberRB) -> do !appl_124 <- kl_fail - !appl_125 <- appl_124 `pseq` (kl_Parse_shen_LBnumberRB `pseq` eq appl_124 kl_Parse_shen_LBnumberRB) - !kl_if_126 <- appl_125 `pseq` kl_not appl_125 - case kl_if_126 of - Atom (B (True)) -> do !appl_127 <- kl_Parse_shen_LBnumberRB `pseq` hd kl_Parse_shen_LBnumberRB - !appl_128 <- kl_Parse_shen_LBnumberRB `pseq` kl_shen_hdtl kl_Parse_shen_LBnumberRB - !appl_129 <- appl_128 `pseq` Primitives.subtract (Types.Atom (Types.N (Types.KI 0))) appl_128 - appl_127 `pseq` (appl_129 `pseq` kl_shen_pair appl_127 appl_129) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_130 <- kl_Parse_shen_LBminusRB `pseq` kl_shen_LBnumberRB kl_Parse_shen_LBminusRB - appl_130 `pseq` applyWrapper appl_123 [appl_130] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_131 <- kl_V2312 `pseq` kl_shen_LBminusRB kl_V2312 - !appl_132 <- appl_131 `pseq` applyWrapper appl_119 [appl_131] - appl_132 `pseq` applyWrapper appl_0 [appl_132] - -kl_shen_LBERB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBERB (!kl_V2314) = do !appl_0 <- kl_V2314 `pseq` hd kl_V2314 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2314 `pseq` hd kl_V2314 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 101))) 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 !appl_6 <- kl_V2314 `pseq` hd kl_V2314 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2314 `pseq` kl_shen_hdtl kl_V2314 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBlog10RB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBlog10RB (!kl_V2316) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_4 <- kl_fail - !appl_5 <- appl_4 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_4 kl_Parse_shen_LBdigitsRB) - !kl_if_6 <- appl_5 `pseq` kl_not appl_5 - case kl_if_6 of - Atom (B (True)) -> do !appl_7 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB - !appl_8 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB - !appl_9 <- appl_8 `pseq` kl_reverse appl_8 - !appl_10 <- appl_9 `pseq` kl_shen_pre appl_9 (Types.Atom (Types.N (Types.KI 0))) - appl_7 `pseq` (appl_10 `pseq` kl_shen_pair appl_7 appl_10) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_11 <- kl_V2316 `pseq` kl_shen_LBdigitsRB kl_V2316 - appl_11 `pseq` applyWrapper appl_3 [appl_11] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBminusRB) -> do !appl_13 <- kl_fail - !appl_14 <- appl_13 `pseq` (kl_Parse_shen_LBminusRB `pseq` eq appl_13 kl_Parse_shen_LBminusRB) - !kl_if_15 <- appl_14 `pseq` kl_not appl_14 - case kl_if_15 of - Atom (B (True)) -> do let !appl_16 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_17 <- kl_fail - !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_17 kl_Parse_shen_LBdigitsRB) - !kl_if_19 <- appl_18 `pseq` kl_not appl_18 - case kl_if_19 of - Atom (B (True)) -> do !appl_20 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB - !appl_21 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB - !appl_22 <- appl_21 `pseq` kl_reverse appl_21 - !appl_23 <- appl_22 `pseq` kl_shen_pre appl_22 (Types.Atom (Types.N (Types.KI 0))) - !appl_24 <- appl_23 `pseq` Primitives.subtract (Types.Atom (Types.N (Types.KI 0))) appl_23 - appl_20 `pseq` (appl_24 `pseq` kl_shen_pair appl_20 appl_24) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_25 <- kl_Parse_shen_LBminusRB `pseq` kl_shen_LBdigitsRB kl_Parse_shen_LBminusRB - appl_25 `pseq` applyWrapper appl_16 [appl_25] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_26 <- kl_V2316 `pseq` kl_shen_LBminusRB kl_V2316 - !appl_27 <- appl_26 `pseq` applyWrapper appl_12 [appl_26] - appl_27 `pseq` applyWrapper appl_0 [appl_27] - -kl_shen_LBplusRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBplusRB (!kl_V2318) = do !appl_0 <- kl_V2318 `pseq` hd kl_V2318 - !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_Byte) -> do let pat_cond_3 = do !appl_4 <- kl_V2318 `pseq` hd kl_V2318 - !appl_5 <- appl_4 `pseq` tl appl_4 - !appl_6 <- kl_V2318 `pseq` kl_shen_hdtl kl_V2318 - !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) - !appl_8 <- appl_7 `pseq` hd appl_7 - appl_8 `pseq` (kl_Parse_Byte `pseq` kl_shen_pair appl_8 kl_Parse_Byte) - pat_cond_9 = do do kl_fail - in case kl_Parse_Byte of - kl_Parse_Byte@(Atom (N (KI 43))) -> pat_cond_3 - _ -> pat_cond_9))) - !appl_10 <- kl_V2318 `pseq` hd kl_V2318 - !appl_11 <- appl_10 `pseq` hd appl_10 - appl_11 `pseq` applyWrapper appl_2 [appl_11] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBstopRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBstopRB (!kl_V2320) = do !appl_0 <- kl_V2320 `pseq` hd kl_V2320 - !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_Byte) -> do let pat_cond_3 = do !appl_4 <- kl_V2320 `pseq` hd kl_V2320 - !appl_5 <- appl_4 `pseq` tl appl_4 - !appl_6 <- kl_V2320 `pseq` kl_shen_hdtl kl_V2320 - !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) - !appl_8 <- appl_7 `pseq` hd appl_7 - appl_8 `pseq` (kl_Parse_Byte `pseq` kl_shen_pair appl_8 kl_Parse_Byte) - pat_cond_9 = do do kl_fail - in case kl_Parse_Byte of - kl_Parse_Byte@(Atom (N (KI 46))) -> pat_cond_3 - _ -> pat_cond_9))) - !appl_10 <- kl_V2320 `pseq` hd kl_V2320 - !appl_11 <- appl_10 `pseq` hd appl_10 - appl_11 `pseq` applyWrapper appl_2 [appl_11] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBpredigitsRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBpredigitsRB (!kl_V2322) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do !appl_4 <- kl_fail - !appl_5 <- appl_4 `pseq` (kl_Parse_LBeRB `pseq` eq appl_4 kl_Parse_LBeRB) - !kl_if_6 <- appl_5 `pseq` kl_not appl_5 - case kl_if_6 of - Atom (B (True)) -> do !appl_7 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB - appl_7 `pseq` kl_shen_pair appl_7 (Types.Atom Types.Nil) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_8 <- kl_V2322 `pseq` kl_LBeRB kl_V2322 - appl_8 `pseq` applyWrapper appl_3 [appl_8] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_10 <- kl_fail - !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_10 kl_Parse_shen_LBdigitsRB) - !kl_if_12 <- appl_11 `pseq` kl_not appl_11 - case kl_if_12 of - Atom (B (True)) -> do !appl_13 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB - !appl_14 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB - appl_13 `pseq` (appl_14 `pseq` kl_shen_pair appl_13 appl_14) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_15 <- kl_V2322 `pseq` kl_shen_LBdigitsRB kl_V2322 - !appl_16 <- appl_15 `pseq` applyWrapper appl_9 [appl_15] - appl_16 `pseq` applyWrapper appl_0 [appl_16] - -kl_shen_LBpostdigitsRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBpostdigitsRB (!kl_V2324) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_1 <- kl_fail - !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_1 kl_Parse_shen_LBdigitsRB) - !kl_if_3 <- appl_2 `pseq` kl_not appl_2 - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB - !appl_5 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB - appl_4 `pseq` (appl_5 `pseq` kl_shen_pair appl_4 appl_5) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_6 <- kl_V2324 `pseq` kl_shen_LBdigitsRB kl_V2324 - appl_6 `pseq` applyWrapper appl_0 [appl_6] - -kl_shen_LBdigitsRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBdigitsRB (!kl_V2326) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitRB) -> do !appl_4 <- kl_fail - !appl_5 <- appl_4 `pseq` (kl_Parse_shen_LBdigitRB `pseq` eq appl_4 kl_Parse_shen_LBdigitRB) - !kl_if_6 <- appl_5 `pseq` kl_not appl_5 - case kl_if_6 of - Atom (B (True)) -> do !appl_7 <- kl_Parse_shen_LBdigitRB `pseq` hd kl_Parse_shen_LBdigitRB - !appl_8 <- kl_Parse_shen_LBdigitRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitRB - !appl_9 <- appl_8 `pseq` klCons appl_8 (Types.Atom Types.Nil) - appl_7 `pseq` (appl_9 `pseq` kl_shen_pair appl_7 appl_9) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_10 <- kl_V2326 `pseq` kl_shen_LBdigitRB kl_V2326 - appl_10 `pseq` applyWrapper appl_3 [appl_10] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_11 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitRB) -> do !appl_12 <- kl_fail - !appl_13 <- appl_12 `pseq` (kl_Parse_shen_LBdigitRB `pseq` eq appl_12 kl_Parse_shen_LBdigitRB) - !kl_if_14 <- appl_13 `pseq` kl_not appl_13 - case kl_if_14 of - Atom (B (True)) -> do let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_16 <- kl_fail - !appl_17 <- appl_16 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_16 kl_Parse_shen_LBdigitsRB) - !kl_if_18 <- appl_17 `pseq` kl_not appl_17 - case kl_if_18 of - Atom (B (True)) -> do !appl_19 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB - !appl_20 <- kl_Parse_shen_LBdigitRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitRB - !appl_21 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB - !appl_22 <- appl_20 `pseq` (appl_21 `pseq` klCons appl_20 appl_21) - appl_19 `pseq` (appl_22 `pseq` kl_shen_pair appl_19 appl_22) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_23 <- kl_Parse_shen_LBdigitRB `pseq` kl_shen_LBdigitsRB kl_Parse_shen_LBdigitRB - appl_23 `pseq` applyWrapper appl_15 [appl_23] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_24 <- kl_V2326 `pseq` kl_shen_LBdigitRB kl_V2326 - !appl_25 <- appl_24 `pseq` applyWrapper appl_11 [appl_24] - appl_25 `pseq` applyWrapper appl_0 [appl_25] - -kl_shen_LBdigitRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBdigitRB (!kl_V2328) = do !appl_0 <- kl_V2328 `pseq` hd kl_V2328 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - case kl_if_1 of - Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !kl_if_3 <- kl_Parse_X `pseq` kl_shen_numbyteP kl_Parse_X - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_V2328 `pseq` hd kl_V2328 - !appl_5 <- appl_4 `pseq` tl appl_4 - !appl_6 <- kl_V2328 `pseq` kl_shen_hdtl kl_V2328 - !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) - !appl_8 <- appl_7 `pseq` hd appl_7 - !appl_9 <- kl_Parse_X `pseq` kl_shen_byte_RBdigit kl_Parse_X - appl_8 `pseq` (appl_9 `pseq` kl_shen_pair appl_8 appl_9) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_10 <- kl_V2328 `pseq` hd kl_V2328 - !appl_11 <- appl_10 `pseq` hd appl_10 - appl_11 `pseq` applyWrapper appl_2 [appl_11] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_byte_RBdigit :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_byte_RBdigit (!kl_V2330) = do let pat_cond_0 = do return (Types.Atom (Types.N (Types.KI 0))) - pat_cond_1 = do return (Types.Atom (Types.N (Types.KI 1))) - pat_cond_2 = do return (Types.Atom (Types.N (Types.KI 2))) - pat_cond_3 = do return (Types.Atom (Types.N (Types.KI 3))) - pat_cond_4 = do return (Types.Atom (Types.N (Types.KI 4))) - pat_cond_5 = do return (Types.Atom (Types.N (Types.KI 5))) - pat_cond_6 = do return (Types.Atom (Types.N (Types.KI 6))) - pat_cond_7 = do return (Types.Atom (Types.N (Types.KI 7))) - pat_cond_8 = do return (Types.Atom (Types.N (Types.KI 8))) - pat_cond_9 = do return (Types.Atom (Types.N (Types.KI 9))) - pat_cond_10 = do do let !aw_11 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_11 [ApplC (wrapNamed "shen.byte->digit" kl_shen_byte_RBdigit)] - in case kl_V2330 of - kl_V2330@(Atom (N (KI 48))) -> pat_cond_0 - kl_V2330@(Atom (N (KI 49))) -> pat_cond_1 - kl_V2330@(Atom (N (KI 50))) -> pat_cond_2 - kl_V2330@(Atom (N (KI 51))) -> pat_cond_3 - kl_V2330@(Atom (N (KI 52))) -> pat_cond_4 - kl_V2330@(Atom (N (KI 53))) -> pat_cond_5 - kl_V2330@(Atom (N (KI 54))) -> pat_cond_6 - kl_V2330@(Atom (N (KI 55))) -> pat_cond_7 - kl_V2330@(Atom (N (KI 56))) -> pat_cond_8 - kl_V2330@(Atom (N (KI 57))) -> pat_cond_9 - _ -> pat_cond_10 - -kl_shen_pre :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_pre (!kl_V2335) (!kl_V2336) = do let pat_cond_0 = do return (Types.Atom (Types.N (Types.KI 0))) - pat_cond_1 kl_V2335 kl_V2335h kl_V2335t = do !appl_2 <- kl_V2336 `pseq` kl_shen_expt (Types.Atom (Types.N (Types.KI 10))) kl_V2336 - !appl_3 <- appl_2 `pseq` (kl_V2335h `pseq` multiply appl_2 kl_V2335h) - !appl_4 <- kl_V2336 `pseq` add kl_V2336 (Types.Atom (Types.N (Types.KI 1))) - !appl_5 <- kl_V2335t `pseq` (appl_4 `pseq` kl_shen_pre kl_V2335t appl_4) - appl_3 `pseq` (appl_5 `pseq` add 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.pre" kl_shen_pre)] - in case kl_V2335 of - kl_V2335@(Atom (Nil)) -> pat_cond_0 - !(kl_V2335@(Cons (!kl_V2335h) - (!kl_V2335t))) -> pat_cond_1 kl_V2335 kl_V2335h kl_V2335t - _ -> pat_cond_6 - -kl_shen_post :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_post (!kl_V2341) (!kl_V2342) = do let pat_cond_0 = do return (Types.Atom (Types.N (Types.KI 0))) - pat_cond_1 kl_V2341 kl_V2341h kl_V2341t = do !appl_2 <- kl_V2342 `pseq` Primitives.subtract (Types.Atom (Types.N (Types.KI 0))) kl_V2342 - !appl_3 <- appl_2 `pseq` kl_shen_expt (Types.Atom (Types.N (Types.KI 10))) appl_2 - !appl_4 <- appl_3 `pseq` (kl_V2341h `pseq` multiply appl_3 kl_V2341h) - !appl_5 <- kl_V2342 `pseq` add kl_V2342 (Types.Atom (Types.N (Types.KI 1))) - !appl_6 <- kl_V2341t `pseq` (appl_5 `pseq` kl_shen_post kl_V2341t appl_5) - appl_4 `pseq` (appl_6 `pseq` add appl_4 appl_6) - pat_cond_7 = do do let !aw_8 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_8 [ApplC (wrapNamed "shen.post" kl_shen_post)] - in case kl_V2341 of - kl_V2341@(Atom (Nil)) -> pat_cond_0 - !(kl_V2341@(Cons (!kl_V2341h) - (!kl_V2341t))) -> pat_cond_1 kl_V2341 kl_V2341h kl_V2341t - _ -> pat_cond_7 - -kl_shen_expt :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_expt (!kl_V2347) (!kl_V2348) = do let pat_cond_0 = do return (Types.Atom (Types.N (Types.KI 1))) - pat_cond_1 = do !kl_if_2 <- kl_V2348 `pseq` greaterThan kl_V2348 (Types.Atom (Types.N (Types.KI 0))) - case kl_if_2 of - Atom (B (True)) -> do !appl_3 <- kl_V2348 `pseq` Primitives.subtract kl_V2348 (Types.Atom (Types.N (Types.KI 1))) - !appl_4 <- kl_V2347 `pseq` (appl_3 `pseq` kl_shen_expt kl_V2347 appl_3) - kl_V2347 `pseq` (appl_4 `pseq` multiply kl_V2347 appl_4) - Atom (B (False)) -> do do !appl_5 <- kl_V2348 `pseq` add kl_V2348 (Types.Atom (Types.N (Types.KI 1))) - !appl_6 <- kl_V2347 `pseq` (appl_5 `pseq` kl_shen_expt kl_V2347 appl_5) - !appl_7 <- appl_6 `pseq` (kl_V2347 `pseq` divide appl_6 kl_V2347) - appl_7 `pseq` multiply (Types.Atom (Types.N (Types.KI 1))) appl_7 - _ -> throwError "if: expected boolean" - in case kl_V2348 of - kl_V2348@(Atom (N (KI 0))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_LBst_input1RB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBst_input1RB (!kl_V2350) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_1 <- kl_fail - !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_1 kl_Parse_shen_LBst_inputRB) - !kl_if_3 <- appl_2 `pseq` kl_not appl_2 - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_5 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - appl_4 `pseq` (appl_5 `pseq` kl_shen_pair appl_4 appl_5) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_6 <- kl_V2350 `pseq` kl_shen_LBst_inputRB kl_V2350 - appl_6 `pseq` applyWrapper appl_0 [appl_6] - -kl_shen_LBst_input2RB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBst_input2RB (!kl_V2352) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_1 <- kl_fail - !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_1 kl_Parse_shen_LBst_inputRB) - !kl_if_3 <- appl_2 `pseq` kl_not appl_2 - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB - !appl_5 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB - appl_4 `pseq` (appl_5 `pseq` kl_shen_pair appl_4 appl_5) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_6 <- kl_V2352 `pseq` kl_shen_LBst_inputRB kl_V2352 - appl_6 `pseq` applyWrapper appl_0 [appl_6] - -kl_shen_LBcommentRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBcommentRB (!kl_V2354) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBmultilineRB) -> do !appl_4 <- kl_fail - !appl_5 <- appl_4 `pseq` (kl_Parse_shen_LBmultilineRB `pseq` eq appl_4 kl_Parse_shen_LBmultilineRB) - !kl_if_6 <- appl_5 `pseq` kl_not appl_5 - case kl_if_6 of - Atom (B (True)) -> do !appl_7 <- kl_Parse_shen_LBmultilineRB `pseq` hd kl_Parse_shen_LBmultilineRB - appl_7 `pseq` kl_shen_pair appl_7 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_8 <- kl_V2354 `pseq` kl_shen_LBmultilineRB kl_V2354 - appl_8 `pseq` applyWrapper appl_3 [appl_8] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsinglelineRB) -> do !appl_10 <- kl_fail - !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBsinglelineRB `pseq` eq appl_10 kl_Parse_shen_LBsinglelineRB) - !kl_if_12 <- appl_11 `pseq` kl_not appl_11 - case kl_if_12 of - Atom (B (True)) -> do !appl_13 <- kl_Parse_shen_LBsinglelineRB `pseq` hd kl_Parse_shen_LBsinglelineRB - appl_13 `pseq` kl_shen_pair appl_13 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_14 <- kl_V2354 `pseq` kl_shen_LBsinglelineRB kl_V2354 - !appl_15 <- appl_14 `pseq` applyWrapper appl_9 [appl_14] - appl_15 `pseq` applyWrapper appl_0 [appl_15] - -kl_shen_LBsinglelineRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBsinglelineRB (!kl_V2356) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBbackslashRB) -> do !appl_1 <- kl_fail - !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBbackslashRB `pseq` eq appl_1 kl_Parse_shen_LBbackslashRB) - !kl_if_3 <- appl_2 `pseq` kl_not appl_2 - case kl_if_3 of - Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBbackslashRB) -> do !appl_5 <- kl_fail - !appl_6 <- appl_5 `pseq` (kl_Parse_shen_LBbackslashRB `pseq` eq appl_5 kl_Parse_shen_LBbackslashRB) - !kl_if_7 <- appl_6 `pseq` kl_not appl_6 - case kl_if_7 of - Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBanysingleRB) -> do !appl_9 <- kl_fail - !appl_10 <- appl_9 `pseq` (kl_Parse_shen_LBanysingleRB `pseq` eq appl_9 kl_Parse_shen_LBanysingleRB) - !kl_if_11 <- appl_10 `pseq` kl_not appl_10 - case kl_if_11 of - Atom (B (True)) -> do let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBreturnRB) -> do !appl_13 <- kl_fail - !appl_14 <- appl_13 `pseq` (kl_Parse_shen_LBreturnRB `pseq` eq appl_13 kl_Parse_shen_LBreturnRB) - !kl_if_15 <- appl_14 `pseq` kl_not appl_14 - case kl_if_15 of - Atom (B (True)) -> do !appl_16 <- kl_Parse_shen_LBreturnRB `pseq` hd kl_Parse_shen_LBreturnRB - appl_16 `pseq` kl_shen_pair appl_16 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_17 <- kl_Parse_shen_LBanysingleRB `pseq` kl_shen_LBreturnRB kl_Parse_shen_LBanysingleRB - appl_17 `pseq` applyWrapper appl_12 [appl_17] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_18 <- kl_Parse_shen_LBbackslashRB `pseq` kl_shen_LBanysingleRB kl_Parse_shen_LBbackslashRB - appl_18 `pseq` applyWrapper appl_8 [appl_18] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_19 <- kl_Parse_shen_LBbackslashRB `pseq` kl_shen_LBbackslashRB kl_Parse_shen_LBbackslashRB - appl_19 `pseq` applyWrapper appl_4 [appl_19] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_20 <- kl_V2356 `pseq` kl_shen_LBbackslashRB kl_V2356 - appl_20 `pseq` applyWrapper appl_0 [appl_20] - -kl_shen_LBbackslashRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBbackslashRB (!kl_V2358) = do !appl_0 <- kl_V2358 `pseq` hd kl_V2358 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2358 `pseq` hd kl_V2358 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 92))) 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 !appl_6 <- kl_V2358 `pseq` hd kl_V2358 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2358 `pseq` kl_shen_hdtl kl_V2358 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBanysingleRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBanysingleRB (!kl_V2360) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do !appl_4 <- kl_fail - !appl_5 <- appl_4 `pseq` (kl_Parse_LBeRB `pseq` eq appl_4 kl_Parse_LBeRB) - !kl_if_6 <- appl_5 `pseq` kl_not appl_5 - case kl_if_6 of - Atom (B (True)) -> do !appl_7 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB - appl_7 `pseq` kl_shen_pair appl_7 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_8 <- kl_V2360 `pseq` kl_LBeRB kl_V2360 - appl_8 `pseq` applyWrapper appl_3 [appl_8] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnon_returnRB) -> do !appl_10 <- kl_fail - !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBnon_returnRB `pseq` eq appl_10 kl_Parse_shen_LBnon_returnRB) - !kl_if_12 <- appl_11 `pseq` kl_not appl_11 - case kl_if_12 of - Atom (B (True)) -> do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBanysingleRB) -> do !appl_14 <- kl_fail - !appl_15 <- appl_14 `pseq` (kl_Parse_shen_LBanysingleRB `pseq` eq appl_14 kl_Parse_shen_LBanysingleRB) - !kl_if_16 <- appl_15 `pseq` kl_not appl_15 - case kl_if_16 of - Atom (B (True)) -> do !appl_17 <- kl_Parse_shen_LBanysingleRB `pseq` hd kl_Parse_shen_LBanysingleRB - appl_17 `pseq` kl_shen_pair appl_17 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_18 <- kl_Parse_shen_LBnon_returnRB `pseq` kl_shen_LBanysingleRB kl_Parse_shen_LBnon_returnRB - appl_18 `pseq` applyWrapper appl_13 [appl_18] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_19 <- kl_V2360 `pseq` kl_shen_LBnon_returnRB kl_V2360 - !appl_20 <- appl_19 `pseq` applyWrapper appl_9 [appl_19] - appl_20 `pseq` applyWrapper appl_0 [appl_20] - -kl_shen_LBnon_returnRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBnon_returnRB (!kl_V2362) = do !appl_0 <- kl_V2362 `pseq` hd kl_V2362 - !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 <- klCons (Types.Atom (Types.N (Types.KI 13))) (Types.Atom Types.Nil) - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.N (Types.KI 10))) appl_3 - !appl_5 <- kl_Parse_X `pseq` (appl_4 `pseq` kl_elementP kl_Parse_X appl_4) - !kl_if_6 <- appl_5 `pseq` kl_not appl_5 - case kl_if_6 of - Atom (B (True)) -> do !appl_7 <- kl_V2362 `pseq` hd kl_V2362 - !appl_8 <- appl_7 `pseq` tl appl_7 - !appl_9 <- kl_V2362 `pseq` kl_shen_hdtl kl_V2362 - !appl_10 <- appl_8 `pseq` (appl_9 `pseq` kl_shen_pair appl_8 appl_9) - !appl_11 <- appl_10 `pseq` hd appl_10 - appl_11 `pseq` kl_shen_pair appl_11 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_12 <- kl_V2362 `pseq` hd kl_V2362 - !appl_13 <- appl_12 `pseq` hd appl_12 - appl_13 `pseq` applyWrapper appl_2 [appl_13] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBreturnRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBreturnRB (!kl_V2364) = do !appl_0 <- kl_V2364 `pseq` hd kl_V2364 - !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 <- klCons (Types.Atom (Types.N (Types.KI 13))) (Types.Atom Types.Nil) - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.N (Types.KI 10))) appl_3 - !kl_if_5 <- kl_Parse_X `pseq` (appl_4 `pseq` kl_elementP kl_Parse_X appl_4) - case kl_if_5 of - Atom (B (True)) -> do !appl_6 <- kl_V2364 `pseq` hd kl_V2364 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2364 `pseq` kl_shen_hdtl kl_V2364 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_11 <- kl_V2364 `pseq` hd kl_V2364 - !appl_12 <- appl_11 `pseq` hd appl_11 - appl_12 `pseq` applyWrapper appl_2 [appl_12] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBmultilineRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBmultilineRB (!kl_V2366) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBbackslashRB) -> do !appl_1 <- kl_fail - !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBbackslashRB `pseq` eq appl_1 kl_Parse_shen_LBbackslashRB) - !kl_if_3 <- appl_2 `pseq` kl_not appl_2 - case kl_if_3 of - Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBtimesRB) -> do !appl_5 <- kl_fail - !appl_6 <- appl_5 `pseq` (kl_Parse_shen_LBtimesRB `pseq` eq appl_5 kl_Parse_shen_LBtimesRB) - !kl_if_7 <- appl_6 `pseq` kl_not appl_6 - case kl_if_7 of - Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBanymultiRB) -> do !appl_9 <- kl_fail - !appl_10 <- appl_9 `pseq` (kl_Parse_shen_LBanymultiRB `pseq` eq appl_9 kl_Parse_shen_LBanymultiRB) - !kl_if_11 <- appl_10 `pseq` kl_not appl_10 - case kl_if_11 of - Atom (B (True)) -> do !appl_12 <- kl_Parse_shen_LBanymultiRB `pseq` hd kl_Parse_shen_LBanymultiRB - appl_12 `pseq` kl_shen_pair appl_12 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_13 <- kl_Parse_shen_LBtimesRB `pseq` kl_shen_LBanymultiRB kl_Parse_shen_LBtimesRB - appl_13 `pseq` applyWrapper appl_8 [appl_13] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_14 <- kl_Parse_shen_LBbackslashRB `pseq` kl_shen_LBtimesRB kl_Parse_shen_LBbackslashRB - appl_14 `pseq` applyWrapper appl_4 [appl_14] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_15 <- kl_V2366 `pseq` kl_shen_LBbackslashRB kl_V2366 - appl_15 `pseq` applyWrapper appl_0 [appl_15] - -kl_shen_LBtimesRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBtimesRB (!kl_V2368) = do !appl_0 <- kl_V2368 `pseq` hd kl_V2368 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do !appl_3 <- kl_V2368 `pseq` hd kl_V2368 - !appl_4 <- appl_3 `pseq` hd appl_3 - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.N (Types.KI 42))) 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 !appl_6 <- kl_V2368 `pseq` hd kl_V2368 - !appl_7 <- appl_6 `pseq` tl appl_6 - !appl_8 <- kl_V2368 `pseq` kl_shen_hdtl kl_V2368 - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) - !appl_10 <- appl_9 `pseq` hd appl_9 - appl_10 `pseq` kl_shen_pair appl_10 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_LBanymultiRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBanymultiRB (!kl_V2370) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_4 <- kl_fail - !kl_if_5 <- kl_YaccParse `pseq` (appl_4 `pseq` eq kl_YaccParse appl_4) - case kl_if_5 of - Atom (B (True)) -> do !appl_6 <- kl_V2370 `pseq` hd kl_V2370 - !kl_if_7 <- appl_6 `pseq` consP appl_6 - case kl_if_7 of - Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBanymultiRB) -> do !appl_10 <- kl_fail - !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBanymultiRB `pseq` eq appl_10 kl_Parse_shen_LBanymultiRB) - !kl_if_12 <- appl_11 `pseq` kl_not appl_11 - case kl_if_12 of - Atom (B (True)) -> do !appl_13 <- kl_Parse_shen_LBanymultiRB `pseq` hd kl_Parse_shen_LBanymultiRB - appl_13 `pseq` kl_shen_pair appl_13 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_14 <- kl_V2370 `pseq` hd kl_V2370 - !appl_15 <- appl_14 `pseq` tl appl_14 - !appl_16 <- kl_V2370 `pseq` kl_shen_hdtl kl_V2370 - !appl_17 <- appl_15 `pseq` (appl_16 `pseq` kl_shen_pair appl_15 appl_16) - !appl_18 <- appl_17 `pseq` kl_shen_LBanymultiRB appl_17 - appl_18 `pseq` applyWrapper appl_9 [appl_18]))) - !appl_19 <- kl_V2370 `pseq` hd kl_V2370 - !appl_20 <- appl_19 `pseq` hd appl_19 - appl_20 `pseq` applyWrapper appl_8 [appl_20] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_21 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBtimesRB) -> do !appl_22 <- kl_fail - !appl_23 <- appl_22 `pseq` (kl_Parse_shen_LBtimesRB `pseq` eq appl_22 kl_Parse_shen_LBtimesRB) - !kl_if_24 <- appl_23 `pseq` kl_not appl_23 - case kl_if_24 of - Atom (B (True)) -> do let !appl_25 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBbackslashRB) -> do !appl_26 <- kl_fail - !appl_27 <- appl_26 `pseq` (kl_Parse_shen_LBbackslashRB `pseq` eq appl_26 kl_Parse_shen_LBbackslashRB) - !kl_if_28 <- appl_27 `pseq` kl_not appl_27 - case kl_if_28 of - Atom (B (True)) -> do !appl_29 <- kl_Parse_shen_LBbackslashRB `pseq` hd kl_Parse_shen_LBbackslashRB - appl_29 `pseq` kl_shen_pair appl_29 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_30 <- kl_Parse_shen_LBtimesRB `pseq` kl_shen_LBbackslashRB kl_Parse_shen_LBtimesRB - appl_30 `pseq` applyWrapper appl_25 [appl_30] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_31 <- kl_V2370 `pseq` kl_shen_LBtimesRB kl_V2370 - !appl_32 <- appl_31 `pseq` applyWrapper appl_21 [appl_31] - appl_32 `pseq` applyWrapper appl_3 [appl_32] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_33 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcommentRB) -> do !appl_34 <- kl_fail - !appl_35 <- appl_34 `pseq` (kl_Parse_shen_LBcommentRB `pseq` eq appl_34 kl_Parse_shen_LBcommentRB) - !kl_if_36 <- appl_35 `pseq` kl_not appl_35 - case kl_if_36 of - Atom (B (True)) -> do let !appl_37 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBanymultiRB) -> do !appl_38 <- kl_fail - !appl_39 <- appl_38 `pseq` (kl_Parse_shen_LBanymultiRB `pseq` eq appl_38 kl_Parse_shen_LBanymultiRB) - !kl_if_40 <- appl_39 `pseq` kl_not appl_39 - case kl_if_40 of - Atom (B (True)) -> do !appl_41 <- kl_Parse_shen_LBanymultiRB `pseq` hd kl_Parse_shen_LBanymultiRB - appl_41 `pseq` kl_shen_pair appl_41 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_42 <- kl_Parse_shen_LBcommentRB `pseq` kl_shen_LBanymultiRB kl_Parse_shen_LBcommentRB - appl_42 `pseq` applyWrapper appl_37 [appl_42] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_43 <- kl_V2370 `pseq` kl_shen_LBcommentRB kl_V2370 - !appl_44 <- appl_43 `pseq` applyWrapper appl_33 [appl_43] - appl_44 `pseq` applyWrapper appl_0 [appl_44] - -kl_shen_LBwhitespacesRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBwhitespacesRB (!kl_V2372) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail - !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) - case kl_if_2 of - Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBwhitespaceRB) -> do !appl_4 <- kl_fail - !appl_5 <- appl_4 `pseq` (kl_Parse_shen_LBwhitespaceRB `pseq` eq appl_4 kl_Parse_shen_LBwhitespaceRB) - !kl_if_6 <- appl_5 `pseq` kl_not appl_5 - case kl_if_6 of - Atom (B (True)) -> do !appl_7 <- kl_Parse_shen_LBwhitespaceRB `pseq` hd kl_Parse_shen_LBwhitespaceRB - appl_7 `pseq` kl_shen_pair appl_7 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_8 <- kl_V2372 `pseq` kl_shen_LBwhitespaceRB kl_V2372 - appl_8 `pseq` applyWrapper appl_3 [appl_8] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBwhitespaceRB) -> do !appl_10 <- kl_fail - !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBwhitespaceRB `pseq` eq appl_10 kl_Parse_shen_LBwhitespaceRB) - !kl_if_12 <- appl_11 `pseq` kl_not appl_11 - case kl_if_12 of - Atom (B (True)) -> do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBwhitespacesRB) -> do !appl_14 <- kl_fail - !appl_15 <- appl_14 `pseq` (kl_Parse_shen_LBwhitespacesRB `pseq` eq appl_14 kl_Parse_shen_LBwhitespacesRB) - !kl_if_16 <- appl_15 `pseq` kl_not appl_15 - case kl_if_16 of - Atom (B (True)) -> do !appl_17 <- kl_Parse_shen_LBwhitespacesRB `pseq` hd kl_Parse_shen_LBwhitespacesRB - appl_17 `pseq` kl_shen_pair appl_17 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_18 <- kl_Parse_shen_LBwhitespaceRB `pseq` kl_shen_LBwhitespacesRB kl_Parse_shen_LBwhitespaceRB - appl_18 `pseq` applyWrapper appl_13 [appl_18] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_19 <- kl_V2372 `pseq` kl_shen_LBwhitespaceRB kl_V2372 - !appl_20 <- appl_19 `pseq` applyWrapper appl_9 [appl_19] - appl_20 `pseq` applyWrapper appl_0 [appl_20] - -kl_shen_LBwhitespaceRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBwhitespaceRB (!kl_V2374) = do !appl_0 <- kl_V2374 `pseq` hd kl_V2374 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - case kl_if_1 of - Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_Case) -> do let pat_cond_4 = do return (Atom (B True)) - pat_cond_5 = do do !kl_if_6 <- let pat_cond_7 = do return (Atom (B True)) - pat_cond_8 = do do !kl_if_9 <- let pat_cond_10 = do return (Atom (B True)) - pat_cond_11 = do do let pat_cond_12 = do return (Atom (B True)) - pat_cond_13 = do do return (Atom (B False)) - in case kl_Parse_Case of - kl_Parse_Case@(Atom (N (KI 9))) -> pat_cond_12 - _ -> pat_cond_13 - in case kl_Parse_Case of - kl_Parse_Case@(Atom (N (KI 10))) -> pat_cond_10 - _ -> pat_cond_11 - 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" - in case kl_Parse_Case of - kl_Parse_Case@(Atom (N (KI 13))) -> pat_cond_7 - _ -> pat_cond_8 - 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" - in case kl_Parse_Case of - kl_Parse_Case@(Atom (N (KI 32))) -> pat_cond_4 - _ -> pat_cond_5))) - !kl_if_14 <- kl_Parse_X `pseq` applyWrapper appl_3 [kl_Parse_X] - case kl_if_14 of - Atom (B (True)) -> do !appl_15 <- kl_V2374 `pseq` hd kl_V2374 - !appl_16 <- appl_15 `pseq` tl appl_15 - !appl_17 <- kl_V2374 `pseq` kl_shen_hdtl kl_V2374 - !appl_18 <- appl_16 `pseq` (appl_17 `pseq` kl_shen_pair appl_16 appl_17) - !appl_19 <- appl_18 `pseq` hd appl_18 - appl_19 `pseq` kl_shen_pair appl_19 (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean"))) - !appl_20 <- kl_V2374 `pseq` hd kl_V2374 - !appl_21 <- appl_20 `pseq` hd appl_20 - appl_21 `pseq` applyWrapper appl_2 [appl_21] - Atom (B (False)) -> do do kl_fail - _ -> throwError "if: expected boolean" - -kl_shen_cons_form :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_cons_form (!kl_V2376) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V2376 kl_V2376h kl_V2376t kl_V2376tt kl_V2376tth = do !appl_2 <- kl_V2376h `pseq` (kl_V2376tt `pseq` klCons kl_V2376h kl_V2376tt) - appl_2 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_2 - pat_cond_3 kl_V2376 kl_V2376h kl_V2376t = do !appl_4 <- kl_V2376t `pseq` kl_shen_cons_form kl_V2376t - !appl_5 <- appl_4 `pseq` klCons appl_4 (Types.Atom Types.Nil) - !appl_6 <- kl_V2376h `pseq` (appl_5 `pseq` klCons kl_V2376h appl_5) - appl_6 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_6 - pat_cond_7 = do do let !aw_8 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_8 [ApplC (wrapNamed "shen.cons_form" kl_shen_cons_form)] - in case kl_V2376 of - kl_V2376@(Atom (Nil)) -> pat_cond_0 - !(kl_V2376@(Cons (!kl_V2376h) - (!(kl_V2376t@(Cons (Atom (UnboundSym "bar!")) - (!(kl_V2376tt@(Cons (!kl_V2376tth) - (Atom (Nil)))))))))) -> pat_cond_1 kl_V2376 kl_V2376h kl_V2376t kl_V2376tt kl_V2376tth - !(kl_V2376@(Cons (!kl_V2376h) - (!(kl_V2376t@(Cons (ApplC (PL "bar!" _)) - (!(kl_V2376tt@(Cons (!kl_V2376tth) - (Atom (Nil)))))))))) -> pat_cond_1 kl_V2376 kl_V2376h kl_V2376t kl_V2376tt kl_V2376tth - !(kl_V2376@(Cons (!kl_V2376h) - (!(kl_V2376t@(Cons (ApplC (Func "bar!" - _)) - (!(kl_V2376tt@(Cons (!kl_V2376tth) - (Atom (Nil)))))))))) -> pat_cond_1 kl_V2376 kl_V2376h kl_V2376t kl_V2376tt kl_V2376tth - !(kl_V2376@(Cons (!kl_V2376h) - (!kl_V2376t))) -> pat_cond_3 kl_V2376 kl_V2376h kl_V2376t - _ -> pat_cond_7 - -kl_shen_package_macro :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_package_macro (!kl_V2381) (!kl_V2382) = do let pat_cond_0 kl_V2381 kl_V2381t kl_V2381th = do !appl_1 <- kl_V2381th `pseq` kl_explode kl_V2381th - appl_1 `pseq` (kl_V2382 `pseq` kl_append appl_1 kl_V2382) - pat_cond_2 kl_V2381 kl_V2381t kl_V2381tt kl_V2381tth kl_V2381ttt = do kl_V2381ttt `pseq` (kl_V2382 `pseq` kl_append kl_V2381ttt kl_V2382) - pat_cond_3 kl_V2381 kl_V2381t kl_V2381th kl_V2381tt kl_V2381tth kl_V2381ttt = do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_ListofExceptions) -> do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_External) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_PackageNameDot) -> do let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_ExpPackageName) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Packaged) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Internal) -> do kl_Packaged `pseq` (kl_V2382 `pseq` kl_append kl_Packaged kl_V2382)))) - !appl_10 <- kl_ExpPackageName `pseq` (kl_Packaged `pseq` kl_shen_internal_symbols kl_ExpPackageName kl_Packaged) - !appl_11 <- kl_V2381th `pseq` (appl_10 `pseq` kl_shen_record_internal kl_V2381th appl_10) - appl_11 `pseq` applyWrapper appl_9 [appl_11]))) - !appl_12 <- kl_PackageNameDot `pseq` (kl_ListofExceptions `pseq` (kl_V2381ttt `pseq` (kl_ExpPackageName `pseq` kl_shen_packageh kl_PackageNameDot kl_ListofExceptions kl_V2381ttt kl_ExpPackageName))) - appl_12 `pseq` applyWrapper appl_8 [appl_12]))) - !appl_13 <- kl_V2381th `pseq` kl_explode kl_V2381th - appl_13 `pseq` applyWrapper appl_7 [appl_13]))) - !appl_14 <- kl_V2381th `pseq` str kl_V2381th - !appl_15 <- appl_14 `pseq` cn appl_14 (Types.Atom (Types.Str ".")) - !appl_16 <- appl_15 `pseq` intern appl_15 - appl_16 `pseq` applyWrapper appl_6 [appl_16]))) - !appl_17 <- kl_ListofExceptions `pseq` (kl_V2381th `pseq` kl_shen_record_exceptions kl_ListofExceptions kl_V2381th) - appl_17 `pseq` applyWrapper appl_5 [appl_17]))) - !appl_18 <- kl_V2381tth `pseq` kl_shen_eval_without_macros kl_V2381tth - appl_18 `pseq` applyWrapper appl_4 [appl_18] - pat_cond_19 = do do kl_V2381 `pseq` (kl_V2382 `pseq` klCons kl_V2381 kl_V2382) - in case kl_V2381 of - !(kl_V2381@(Cons (Atom (UnboundSym "$")) - (!(kl_V2381t@(Cons (!kl_V2381th) - (Atom (Nil))))))) -> pat_cond_0 kl_V2381 kl_V2381t kl_V2381th - !(kl_V2381@(Cons (ApplC (PL "$" _)) - (!(kl_V2381t@(Cons (!kl_V2381th) - (Atom (Nil))))))) -> pat_cond_0 kl_V2381 kl_V2381t kl_V2381th - !(kl_V2381@(Cons (ApplC (Func "$" _)) - (!(kl_V2381t@(Cons (!kl_V2381th) - (Atom (Nil))))))) -> pat_cond_0 kl_V2381 kl_V2381t kl_V2381th - !(kl_V2381@(Cons (Atom (UnboundSym "package")) - (!(kl_V2381t@(Cons (Atom (UnboundSym "null")) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_2 kl_V2381 kl_V2381t kl_V2381tt kl_V2381tth kl_V2381ttt - !(kl_V2381@(Cons (Atom (UnboundSym "package")) - (!(kl_V2381t@(Cons (ApplC (PL "null" - _)) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_2 kl_V2381 kl_V2381t kl_V2381tt kl_V2381tth kl_V2381ttt - !(kl_V2381@(Cons (Atom (UnboundSym "package")) - (!(kl_V2381t@(Cons (ApplC (Func "null" - _)) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_2 kl_V2381 kl_V2381t kl_V2381tt kl_V2381tth kl_V2381ttt - !(kl_V2381@(Cons (ApplC (PL "package" _)) - (!(kl_V2381t@(Cons (Atom (UnboundSym "null")) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_2 kl_V2381 kl_V2381t kl_V2381tt kl_V2381tth kl_V2381ttt - !(kl_V2381@(Cons (ApplC (PL "package" _)) - (!(kl_V2381t@(Cons (ApplC (PL "null" - _)) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_2 kl_V2381 kl_V2381t kl_V2381tt kl_V2381tth kl_V2381ttt - !(kl_V2381@(Cons (ApplC (PL "package" _)) - (!(kl_V2381t@(Cons (ApplC (Func "null" - _)) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_2 kl_V2381 kl_V2381t kl_V2381tt kl_V2381tth kl_V2381ttt - !(kl_V2381@(Cons (ApplC (Func "package" - _)) - (!(kl_V2381t@(Cons (Atom (UnboundSym "null")) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_2 kl_V2381 kl_V2381t kl_V2381tt kl_V2381tth kl_V2381ttt - !(kl_V2381@(Cons (ApplC (Func "package" - _)) - (!(kl_V2381t@(Cons (ApplC (PL "null" - _)) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_2 kl_V2381 kl_V2381t kl_V2381tt kl_V2381tth kl_V2381ttt - !(kl_V2381@(Cons (ApplC (Func "package" - _)) - (!(kl_V2381t@(Cons (ApplC (Func "null" - _)) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_2 kl_V2381 kl_V2381t kl_V2381tt kl_V2381tth kl_V2381ttt - !(kl_V2381@(Cons (Atom (UnboundSym "package")) - (!(kl_V2381t@(Cons (!kl_V2381th) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_3 kl_V2381 kl_V2381t kl_V2381th kl_V2381tt kl_V2381tth kl_V2381ttt - !(kl_V2381@(Cons (ApplC (PL "package" _)) - (!(kl_V2381t@(Cons (!kl_V2381th) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_3 kl_V2381 kl_V2381t kl_V2381th kl_V2381tt kl_V2381tth kl_V2381ttt - !(kl_V2381@(Cons (ApplC (Func "package" - _)) - (!(kl_V2381t@(Cons (!kl_V2381th) - (!(kl_V2381tt@(Cons (!kl_V2381tth) - (!kl_V2381ttt))))))))) -> pat_cond_3 kl_V2381 kl_V2381t kl_V2381th kl_V2381tt kl_V2381tth kl_V2381ttt - _ -> pat_cond_19 - -kl_shen_record_exceptions :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_record_exceptions (!kl_V2385) (!kl_V2386) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_CurrExceptions) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_AllExceptions) -> do !appl_2 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - kl_V2386 `pseq` (kl_AllExceptions `pseq` (appl_2 `pseq` kl_put kl_V2386 (Types.Atom (Types.UnboundSym "shen.external-symbols")) kl_AllExceptions appl_2))))) - !appl_3 <- kl_V2385 `pseq` (kl_CurrExceptions `pseq` kl_union kl_V2385 kl_CurrExceptions) - appl_3 `pseq` applyWrapper appl_1 [appl_3]))) - !appl_4 <- (do !appl_5 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - kl_V2386 `pseq` (appl_5 `pseq` kl_get kl_V2386 (Types.Atom (Types.UnboundSym "shen.external-symbols")) appl_5)) `catchError` (\(!kl_E) -> do return (Types.Atom Types.Nil)) - appl_4 `pseq` applyWrapper appl_0 [appl_4] - -kl_shen_record_internal :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_record_internal (!kl_V2389) (!kl_V2390) = do !appl_0 <- (do !appl_1 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - kl_V2389 `pseq` (appl_1 `pseq` kl_get kl_V2389 (ApplC (wrapNamed "shen.internal-symbols" kl_shen_internal_symbols)) appl_1)) `catchError` (\(!kl_E) -> do return (Types.Atom Types.Nil)) - !appl_2 <- kl_V2390 `pseq` (appl_0 `pseq` kl_union kl_V2390 appl_0) - !appl_3 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - kl_V2389 `pseq` (appl_2 `pseq` (appl_3 `pseq` kl_put kl_V2389 (ApplC (wrapNamed "shen.internal-symbols" kl_shen_internal_symbols)) appl_2 appl_3)) - -kl_shen_internal_symbols :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_internal_symbols (!kl_V2401) (!kl_V2402) = do !kl_if_0 <- kl_V2402 `pseq` kl_symbolP kl_V2402 - !kl_if_1 <- case kl_if_0 of - Atom (B (True)) -> do !appl_2 <- kl_V2402 `pseq` kl_explode kl_V2402 - !kl_if_3 <- kl_V2401 `pseq` (appl_2 `pseq` kl_shen_prefixP kl_V2401 appl_2) - 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" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_1 of - Atom (B (True)) -> do kl_V2402 `pseq` klCons kl_V2402 (Types.Atom Types.Nil) - Atom (B (False)) -> do let pat_cond_4 kl_V2402 kl_V2402h kl_V2402t = do !appl_5 <- kl_V2401 `pseq` (kl_V2402h `pseq` kl_shen_internal_symbols kl_V2401 kl_V2402h) - !appl_6 <- kl_V2401 `pseq` (kl_V2402t `pseq` kl_shen_internal_symbols kl_V2401 kl_V2402t) - appl_5 `pseq` (appl_6 `pseq` kl_union appl_5 appl_6) - pat_cond_7 = do do return (Types.Atom Types.Nil) - in case kl_V2402 of - !(kl_V2402@(Cons (!kl_V2402h) - (!kl_V2402t))) -> pat_cond_4 kl_V2402 kl_V2402h kl_V2402t - _ -> pat_cond_7 - _ -> throwError "if: expected boolean" - -kl_shen_packageh :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_packageh (!kl_V2419) (!kl_V2420) (!kl_V2421) (!kl_V2422) = do let pat_cond_0 kl_V2421 kl_V2421h kl_V2421t = do !appl_1 <- kl_V2419 `pseq` (kl_V2420 `pseq` (kl_V2421h `pseq` (kl_V2422 `pseq` kl_shen_packageh kl_V2419 kl_V2420 kl_V2421h kl_V2422))) - !appl_2 <- kl_V2419 `pseq` (kl_V2420 `pseq` (kl_V2421t `pseq` (kl_V2422 `pseq` kl_shen_packageh kl_V2419 kl_V2420 kl_V2421t kl_V2422))) - appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) - pat_cond_3 = do !kl_if_4 <- kl_V2421 `pseq` kl_shen_sysfuncP kl_V2421 - !kl_if_5 <- case kl_if_4 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_6 <- kl_V2421 `pseq` kl_variableP kl_V2421 - !kl_if_7 <- case kl_if_6 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_8 <- kl_V2421 `pseq` (kl_V2420 `pseq` kl_elementP kl_V2421 kl_V2420) - !kl_if_9 <- case kl_if_8 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_10 <- kl_V2421 `pseq` kl_shen_doubleunderlineP kl_V2421 - !kl_if_11 <- case kl_if_10 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_12 <- kl_V2421 `pseq` kl_shen_singleunderlineP kl_V2421 - case kl_if_12 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - case kl_if_11 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - case kl_if_9 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - 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" - _ -> throwError "if: expected boolean" - case kl_if_5 of - Atom (B (True)) -> do return kl_V2421 - Atom (B (False)) -> do !kl_if_13 <- kl_V2421 `pseq` kl_symbolP kl_V2421 - !kl_if_14 <- case kl_if_13 of - Atom (B (True)) -> do let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_ExplodeX) -> do !appl_16 <- klCons (Types.Atom (Types.Str ".")) (Types.Atom Types.Nil) - !appl_17 <- appl_16 `pseq` klCons (Types.Atom (Types.Str "n")) appl_16 - !appl_18 <- appl_17 `pseq` klCons (Types.Atom (Types.Str "e")) appl_17 - !appl_19 <- appl_18 `pseq` klCons (Types.Atom (Types.Str "h")) appl_18 - !appl_20 <- appl_19 `pseq` klCons (Types.Atom (Types.Str "s")) appl_19 - !appl_21 <- appl_20 `pseq` (kl_ExplodeX `pseq` kl_shen_prefixP appl_20 kl_ExplodeX) - !kl_if_22 <- appl_21 `pseq` kl_not appl_21 - case kl_if_22 of - Atom (B (True)) -> do !appl_23 <- kl_V2422 `pseq` (kl_ExplodeX `pseq` kl_shen_prefixP kl_V2422 kl_ExplodeX) - !kl_if_24 <- appl_23 `pseq` kl_not appl_23 - case kl_if_24 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_25 <- kl_V2421 `pseq` kl_explode kl_V2421 - !kl_if_26 <- appl_25 `pseq` applyWrapper appl_15 [appl_25] - case kl_if_26 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 kl_V2419 `pseq` (kl_V2421 `pseq` kl_concat kl_V2419 kl_V2421) - Atom (B (False)) -> do do return kl_V2421 - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - in case kl_V2421 of - !(kl_V2421@(Cons (!kl_V2421h) - (!kl_V2421t))) -> pat_cond_0 kl_V2421 kl_V2421h kl_V2421t - _ -> pat_cond_3 - -expr5 :: Types.KLContext Types.Env Types.KLValue -expr5 = 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"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Reader where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel +import Backend.Core +import Backend.Sys +import Backend.Sequent +import Backend.Yacc + +{- +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_read_char_code :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_read_char_code (!kl_V2163) = do kl_V2163 `pseq` readByte kl_V2163 + +kl_read_file_as_bytelist :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_read_file_as_bytelist (!kl_V2165) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_S) -> do kl_S `pseq` readByte kl_S))) + kl_V2165 `pseq` (appl_0 `pseq` kl_shen_read_file_as_Xlist kl_V2165 appl_0) + +kl_read_file_as_charlist :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_read_file_as_charlist (!kl_V2167) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_S) -> do kl_S `pseq` kl_read_char_code kl_S))) + kl_V2167 `pseq` (appl_0 `pseq` kl_shen_read_file_as_Xlist kl_V2167 appl_0) + +kl_shen_read_file_as_Xlist :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_read_file_as_Xlist (!kl_V2170) (!kl_V2171) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Stream) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Xs) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Close) -> do kl_Xs `pseq` kl_reverse kl_Xs))) + !appl_4 <- kl_Stream `pseq` closeStream kl_Stream + appl_4 `pseq` applyWrapper appl_3 [appl_4]))) + let !appl_5 = Atom Nil + !appl_6 <- kl_Stream `pseq` (kl_V2171 `pseq` (kl_X `pseq` (appl_5 `pseq` kl_shen_read_file_as_Xlist_help kl_Stream kl_V2171 kl_X appl_5))) + appl_6 `pseq` applyWrapper appl_2 [appl_6]))) + !appl_7 <- kl_Stream `pseq` applyWrapper kl_V2171 [kl_Stream] + appl_7 `pseq` applyWrapper appl_1 [appl_7]))) + !appl_8 <- kl_V2170 `pseq` openStream kl_V2170 (Core.Types.Atom (Core.Types.UnboundSym "in")) + appl_8 `pseq` applyWrapper appl_0 [appl_8] + +kl_shen_read_file_as_Xlist_help :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_read_file_as_Xlist_help (!kl_V2176) (!kl_V2177) (!kl_V2178) (!kl_V2179) = do let pat_cond_0 = do return kl_V2179 + pat_cond_1 = do do !appl_2 <- kl_V2176 `pseq` applyWrapper kl_V2177 [kl_V2176] + !appl_3 <- kl_V2178 `pseq` (kl_V2179 `pseq` klCons kl_V2178 kl_V2179) + kl_V2176 `pseq` (kl_V2177 `pseq` (appl_2 `pseq` (appl_3 `pseq` kl_shen_read_file_as_Xlist_help kl_V2176 kl_V2177 appl_2 appl_3))) + in case kl_V2178 of + kl_V2178@(Atom (N (KI (-1)))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_read_file_as_string :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_read_file_as_string (!kl_V2181) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Stream) -> do !appl_1 <- kl_Stream `pseq` kl_read_char_code kl_Stream + kl_Stream `pseq` (appl_1 `pseq` kl_shen_rfas_h kl_Stream appl_1 (Core.Types.Atom (Core.Types.Str "")))))) + !appl_2 <- kl_V2181 `pseq` openStream kl_V2181 (Core.Types.Atom (Core.Types.UnboundSym "in")) + appl_2 `pseq` applyWrapper appl_0 [appl_2] + +kl_shen_rfas_h :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_rfas_h (!kl_V2185) (!kl_V2186) (!kl_V2187) = do let pat_cond_0 = do !appl_1 <- kl_V2185 `pseq` closeStream kl_V2185 + appl_1 `pseq` (kl_V2187 `pseq` kl_do appl_1 kl_V2187) + pat_cond_2 = do do !appl_3 <- kl_V2185 `pseq` kl_read_char_code kl_V2185 + !appl_4 <- kl_V2186 `pseq` nToString kl_V2186 + !appl_5 <- kl_V2187 `pseq` (appl_4 `pseq` cn kl_V2187 appl_4) + kl_V2185 `pseq` (appl_3 `pseq` (appl_5 `pseq` kl_shen_rfas_h kl_V2185 appl_3 appl_5)) + in case kl_V2186 of + kl_V2186@(Atom (N (KI (-1)))) -> pat_cond_0 + _ -> pat_cond_2 + +kl_input :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_input (!kl_V2189) = do !appl_0 <- kl_V2189 `pseq` kl_read kl_V2189 + appl_0 `pseq` evalKL appl_0 + +kl_inputPlus :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_inputPlus (!kl_V2192) (!kl_V2193) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_MonoP) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Input) -> do let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.demodulate") + !appl_3 <- kl_V2192 `pseq` applyWrapper aw_2 [kl_V2192] + let !aw_4 = Core.Types.Atom (Core.Types.UnboundSym "shen.typecheck") + !appl_5 <- kl_Input `pseq` (appl_3 `pseq` applyWrapper aw_4 [kl_Input, + appl_3]) + !kl_if_6 <- appl_5 `pseq` eq (Atom (B False)) appl_5 + case kl_if_6 of + Atom (B (True)) -> do let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_8 <- kl_V2192 `pseq` applyWrapper aw_7 [kl_V2192, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.r")] + !appl_9 <- appl_8 `pseq` cn (Core.Types.Atom (Core.Types.Str " is not of type ")) appl_8 + let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_11 <- kl_Input `pseq` (appl_9 `pseq` applyWrapper aw_10 [kl_Input, + appl_9, + Core.Types.Atom (Core.Types.UnboundSym "shen.r")]) + !appl_12 <- appl_11 `pseq` cn (Core.Types.Atom (Core.Types.Str "type error: ")) appl_11 + appl_12 `pseq` simpleError appl_12 + Atom (B (False)) -> do do kl_Input `pseq` evalKL kl_Input + _ -> throwError "if: expected boolean"))) + !appl_13 <- kl_V2193 `pseq` kl_read kl_V2193 + appl_13 `pseq` applyWrapper appl_1 [appl_13]))) + !appl_14 <- kl_V2192 `pseq` kl_shen_monotype kl_V2192 + appl_14 `pseq` applyWrapper appl_0 [appl_14] + +kl_shen_monotype :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_monotype (!kl_V2195) = do let pat_cond_0 kl_V2195 kl_V2195h kl_V2195t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_monotype kl_Z))) + appl_1 `pseq` (kl_V2195 `pseq` kl_map appl_1 kl_V2195) + pat_cond_2 = do do !kl_if_3 <- kl_V2195 `pseq` kl_variableP kl_V2195 + case kl_if_3 of + Atom (B (True)) -> do let !aw_4 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_5 <- kl_V2195 `pseq` applyWrapper aw_4 [kl_V2195, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_6 <- appl_5 `pseq` cn (Core.Types.Atom (Core.Types.Str "input+ expects a monotype: not ")) appl_5 + appl_6 `pseq` simpleError appl_6 + Atom (B (False)) -> do do return kl_V2195 + _ -> throwError "if: expected boolean" + in case kl_V2195 of + !(kl_V2195@(Cons (!kl_V2195h) + (!kl_V2195t))) -> pat_cond_0 kl_V2195 kl_V2195h kl_V2195t + _ -> pat_cond_2 + +kl_read :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_read (!kl_V2197) = do !appl_0 <- kl_V2197 `pseq` kl_read_char_code kl_V2197 + let !appl_1 = Atom Nil + !appl_2 <- kl_V2197 `pseq` (appl_0 `pseq` (appl_1 `pseq` kl_shen_read_loop kl_V2197 appl_0 appl_1)) + appl_2 `pseq` hd appl_2 + +kl_it :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_it = do value (Core.Types.Atom (Core.Types.UnboundSym "shen.*it*")) + +kl_shen_read_loop :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_read_loop (!kl_V2205) (!kl_V2206) (!kl_V2207) = do let pat_cond_0 = do simpleError (Core.Types.Atom (Core.Types.Str "read aborted")) + pat_cond_1 = do !kl_if_2 <- kl_V2207 `pseq` kl_emptyP kl_V2207 + case kl_if_2 of + Atom (B (True)) -> do simpleError (Core.Types.Atom (Core.Types.Str "error: empty stream")) + Atom (B (False)) -> do do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) + let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_E) -> do return kl_E))) + appl_3 `pseq` (kl_V2207 `pseq` (appl_4 `pseq` kl_compile appl_3 kl_V2207 appl_4)) + _ -> throwError "if: expected boolean" + pat_cond_5 = do !kl_if_6 <- kl_V2206 `pseq` kl_shen_terminatorP kl_V2206 + case kl_if_6 of + Atom (B (True)) -> do let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_AllChars) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_It) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Read) -> do !kl_if_10 <- let pat_cond_11 = do return (Atom (B True)) + pat_cond_12 = do do !kl_if_13 <- kl_Read `pseq` kl_emptyP kl_Read + 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" + in case kl_Read of + kl_Read@(Atom (UnboundSym "shen.nextbyte")) -> pat_cond_11 + kl_Read@(ApplC (PL "shen.nextbyte" + _)) -> pat_cond_11 + kl_Read@(ApplC (Func "shen.nextbyte" + _)) -> pat_cond_11 + _ -> pat_cond_12 + case kl_if_10 of + Atom (B (True)) -> do !appl_14 <- kl_V2205 `pseq` kl_read_char_code kl_V2205 + kl_V2205 `pseq` (appl_14 `pseq` (kl_AllChars `pseq` kl_shen_read_loop kl_V2205 appl_14 kl_AllChars)) + Atom (B (False)) -> do do return kl_Read + _ -> throwError "if: expected boolean"))) + let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) + let !appl_16 = ApplC (Func "lambda" (Context (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.nextbyte"))))) + !appl_17 <- appl_15 `pseq` (kl_AllChars `pseq` (appl_16 `pseq` kl_compile appl_15 kl_AllChars appl_16)) + appl_17 `pseq` applyWrapper appl_9 [appl_17]))) + !appl_18 <- kl_AllChars `pseq` kl_shen_record_it kl_AllChars + appl_18 `pseq` applyWrapper appl_8 [appl_18]))) + let !appl_19 = Atom Nil + !appl_20 <- kl_V2206 `pseq` (appl_19 `pseq` klCons kl_V2206 appl_19) + !appl_21 <- kl_V2207 `pseq` (appl_20 `pseq` kl_append kl_V2207 appl_20) + appl_21 `pseq` applyWrapper appl_7 [appl_21] + Atom (B (False)) -> do do !appl_22 <- kl_V2205 `pseq` kl_read_char_code kl_V2205 + let !appl_23 = Atom Nil + !appl_24 <- kl_V2206 `pseq` (appl_23 `pseq` klCons kl_V2206 appl_23) + !appl_25 <- kl_V2207 `pseq` (appl_24 `pseq` kl_append kl_V2207 appl_24) + kl_V2205 `pseq` (appl_22 `pseq` (appl_25 `pseq` kl_shen_read_loop kl_V2205 appl_22 appl_25)) + _ -> throwError "if: expected boolean" + in case kl_V2206 of + kl_V2206@(Atom (N (KI 94))) -> pat_cond_0 + kl_V2206@(Atom (N (KI (-1)))) -> pat_cond_1 + _ -> pat_cond_5 + +kl_shen_terminatorP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_terminatorP (!kl_V2209) = do let !appl_0 = Atom Nil + !appl_1 <- appl_0 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 93))) appl_0 + !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 41))) appl_1 + !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 34))) appl_2 + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 32))) appl_3 + !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 13))) appl_4 + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 10))) appl_5 + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 9))) appl_6 + kl_V2209 `pseq` (appl_7 `pseq` kl_elementP kl_V2209 appl_7) + +kl_lineread :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_lineread (!kl_V2211) = do !appl_0 <- kl_V2211 `pseq` kl_read_char_code kl_V2211 + let !appl_1 = Atom Nil + appl_0 `pseq` (appl_1 `pseq` (kl_V2211 `pseq` kl_shen_lineread_loop appl_0 appl_1 kl_V2211)) + +kl_shen_lineread_loop :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_lineread_loop (!kl_V2216) (!kl_V2217) (!kl_V2218) = do let pat_cond_0 = do !kl_if_1 <- kl_V2217 `pseq` kl_emptyP kl_V2217 + case kl_if_1 of + Atom (B (True)) -> do simpleError (Core.Types.Atom (Core.Types.Str "empty stream")) + Atom (B (False)) -> do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) + let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_E) -> do return kl_E))) + appl_2 `pseq` (kl_V2217 `pseq` (appl_3 `pseq` kl_compile appl_2 kl_V2217 appl_3)) + _ -> throwError "if: expected boolean" + pat_cond_4 = do !appl_5 <- kl_shen_hat + !kl_if_6 <- kl_V2216 `pseq` (appl_5 `pseq` eq kl_V2216 appl_5) + case kl_if_6 of + Atom (B (True)) -> do simpleError (Core.Types.Atom (Core.Types.Str "line read aborted")) + Atom (B (False)) -> do !appl_7 <- kl_shen_newline + !appl_8 <- kl_shen_carriage_return + let !appl_9 = Atom Nil + !appl_10 <- appl_8 `pseq` (appl_9 `pseq` klCons appl_8 appl_9) + !appl_11 <- appl_7 `pseq` (appl_10 `pseq` klCons appl_7 appl_10) + !kl_if_12 <- kl_V2216 `pseq` (appl_11 `pseq` kl_elementP kl_V2216 appl_11) + case kl_if_12 of + Atom (B (True)) -> do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_Line) -> do let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_It) -> do !kl_if_15 <- let pat_cond_16 = do return (Atom (B True)) + pat_cond_17 = do do !kl_if_18 <- kl_Line `pseq` kl_emptyP kl_Line + case kl_if_18 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + in case kl_Line of + kl_Line@(Atom (UnboundSym "shen.nextline")) -> pat_cond_16 + kl_Line@(ApplC (PL "shen.nextline" + _)) -> pat_cond_16 + kl_Line@(ApplC (Func "shen.nextline" + _)) -> pat_cond_16 + _ -> pat_cond_17 + case kl_if_15 of + Atom (B (True)) -> do !appl_19 <- kl_V2218 `pseq` kl_read_char_code kl_V2218 + let !appl_20 = Atom Nil + !appl_21 <- kl_V2216 `pseq` (appl_20 `pseq` klCons kl_V2216 appl_20) + !appl_22 <- kl_V2217 `pseq` (appl_21 `pseq` kl_append kl_V2217 appl_21) + appl_19 `pseq` (appl_22 `pseq` (kl_V2218 `pseq` kl_shen_lineread_loop appl_19 appl_22 kl_V2218)) + Atom (B (False)) -> do do return kl_Line + _ -> throwError "if: expected boolean"))) + !appl_23 <- kl_V2217 `pseq` kl_shen_record_it kl_V2217 + appl_23 `pseq` applyWrapper appl_14 [appl_23]))) + let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) + let !appl_25 = ApplC (Func "lambda" (Context (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.nextline"))))) + !appl_26 <- appl_24 `pseq` (kl_V2217 `pseq` (appl_25 `pseq` kl_compile appl_24 kl_V2217 appl_25)) + appl_26 `pseq` applyWrapper appl_13 [appl_26] + Atom (B (False)) -> do do !appl_27 <- kl_V2218 `pseq` kl_read_char_code kl_V2218 + let !appl_28 = Atom Nil + !appl_29 <- kl_V2216 `pseq` (appl_28 `pseq` klCons kl_V2216 appl_28) + !appl_30 <- kl_V2217 `pseq` (appl_29 `pseq` kl_append kl_V2217 appl_29) + appl_27 `pseq` (appl_30 `pseq` (kl_V2218 `pseq` kl_shen_lineread_loop appl_27 appl_30 kl_V2218)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + in case kl_V2216 of + kl_V2216@(Atom (N (KI (-1)))) -> pat_cond_0 + _ -> pat_cond_4 + +kl_shen_record_it :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_record_it (!kl_V2220) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_TrimLeft) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_TrimRight) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Trimmed) -> do kl_Trimmed `pseq` kl_shen_record_it_h kl_Trimmed))) + !appl_3 <- kl_TrimRight `pseq` kl_reverse kl_TrimRight + appl_3 `pseq` applyWrapper appl_2 [appl_3]))) + !appl_4 <- kl_TrimLeft `pseq` kl_reverse kl_TrimLeft + !appl_5 <- appl_4 `pseq` kl_shen_trim_whitespace appl_4 + appl_5 `pseq` applyWrapper appl_1 [appl_5]))) + !appl_6 <- kl_V2220 `pseq` kl_shen_trim_whitespace kl_V2220 + appl_6 `pseq` applyWrapper appl_0 [appl_6] + +kl_shen_trim_whitespace :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_trim_whitespace (!kl_V2222) = do !kl_if_0 <- let pat_cond_1 kl_V2222 kl_V2222h kl_V2222t = do let !appl_2 = Atom Nil + !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 32))) appl_2 + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 13))) appl_3 + !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 10))) appl_4 + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 9))) appl_5 + !kl_if_7 <- kl_V2222h `pseq` (appl_6 `pseq` kl_elementP kl_V2222h appl_6) + case kl_if_7 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_8 = do do return (Atom (B False)) + in case kl_V2222 of + !(kl_V2222@(Cons (!kl_V2222h) + (!kl_V2222t))) -> pat_cond_1 kl_V2222 kl_V2222h kl_V2222t + _ -> pat_cond_8 + case kl_if_0 of + Atom (B (True)) -> do !appl_9 <- kl_V2222 `pseq` tl kl_V2222 + appl_9 `pseq` kl_shen_trim_whitespace appl_9 + Atom (B (False)) -> do do return kl_V2222 + _ -> throwError "if: expected boolean" + +kl_shen_record_it_h :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_record_it_h (!kl_V2224) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` nToString kl_X))) + !appl_1 <- appl_0 `pseq` (kl_V2224 `pseq` kl_map appl_0 kl_V2224) + !appl_2 <- appl_1 `pseq` kl_shen_cn_all appl_1 + !appl_3 <- appl_2 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*it*")) appl_2 + appl_3 `pseq` (kl_V2224 `pseq` kl_do appl_3 kl_V2224) + +kl_shen_cn_all :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_cn_all (!kl_V2226) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2226 `pseq` eq appl_0 kl_V2226) + case kl_if_1 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.Str "")) + Atom (B (False)) -> do let pat_cond_2 kl_V2226 kl_V2226h kl_V2226t = do !appl_3 <- kl_V2226t `pseq` kl_shen_cn_all kl_V2226t + kl_V2226h `pseq` (appl_3 `pseq` cn kl_V2226h appl_3) + pat_cond_4 = do do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_5 [ApplC (wrapNamed "shen.cn-all" kl_shen_cn_all)] + in case kl_V2226 of + !(kl_V2226@(Cons (!kl_V2226h) + (!kl_V2226t))) -> pat_cond_2 kl_V2226 kl_V2226h kl_V2226t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_read_file :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_read_file (!kl_V2228) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Charlist) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) + let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_read_error kl_X))) + appl_1 `pseq` (kl_Charlist `pseq` (appl_2 `pseq` kl_compile appl_1 kl_Charlist appl_2))))) + !appl_3 <- kl_V2228 `pseq` kl_read_file_as_charlist kl_V2228 + appl_3 `pseq` applyWrapper appl_0 [appl_3] + +kl_read_from_string :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_read_from_string (!kl_V2230) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Ns) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_LBst_inputRB kl_X))) + let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_read_error kl_X))) + appl_1 `pseq` (kl_Ns `pseq` (appl_2 `pseq` kl_compile appl_1 kl_Ns appl_2))))) + let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` stringToN kl_X))) + !appl_4 <- kl_V2230 `pseq` kl_explode kl_V2230 + !appl_5 <- appl_3 `pseq` (appl_4 `pseq` kl_map appl_3 appl_4) + appl_5 `pseq` applyWrapper appl_0 [appl_5] + +kl_shen_read_error :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_read_error (!kl_V2238) = do !kl_if_0 <- let pat_cond_1 kl_V2238 kl_V2238h kl_V2238t = do !kl_if_2 <- let pat_cond_3 kl_V2238h kl_V2238hh kl_V2238ht = do !kl_if_4 <- let pat_cond_5 kl_V2238t kl_V2238th kl_V2238tt = do let !appl_6 = Atom Nil + !kl_if_7 <- appl_6 `pseq` (kl_V2238tt `pseq` eq appl_6 kl_V2238tt) + 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_8 = do do return (Atom (B False)) + in case kl_V2238t of + !(kl_V2238t@(Cons (!kl_V2238th) + (!kl_V2238tt))) -> pat_cond_5 kl_V2238t kl_V2238th kl_V2238tt + _ -> pat_cond_8 + 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_9 = do do return (Atom (B False)) + in case kl_V2238h of + !(kl_V2238h@(Cons (!kl_V2238hh) + (!kl_V2238ht))) -> pat_cond_3 kl_V2238h kl_V2238hh kl_V2238ht + _ -> pat_cond_9 + 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_10 = do do return (Atom (B False)) + in case kl_V2238 of + !(kl_V2238@(Cons (!kl_V2238h) + (!kl_V2238t))) -> pat_cond_1 kl_V2238 kl_V2238h kl_V2238t + _ -> pat_cond_10 + case kl_if_0 of + Atom (B (True)) -> do !appl_11 <- kl_V2238 `pseq` hd kl_V2238 + !appl_12 <- appl_11 `pseq` kl_shen_compress_50 (Core.Types.Atom (Core.Types.N (Core.Types.KI 50))) appl_11 + let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_14 <- appl_12 `pseq` applyWrapper aw_13 [appl_12, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_15 <- appl_14 `pseq` cn (Core.Types.Atom (Core.Types.Str "read error here:\n\n ")) appl_14 + appl_15 `pseq` simpleError appl_15 + Atom (B (False)) -> do do simpleError (Core.Types.Atom (Core.Types.Str "read error\n")) + _ -> throwError "if: expected boolean" + +kl_shen_compress_50 :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_compress_50 (!kl_V2245) (!kl_V2246) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2246 `pseq` eq appl_0 kl_V2246) + case kl_if_1 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.Str "")) + Atom (B (False)) -> do let pat_cond_2 = do return (Core.Types.Atom (Core.Types.Str "")) + pat_cond_3 = do let pat_cond_4 kl_V2246 kl_V2246h kl_V2246t = do !appl_5 <- kl_V2246h `pseq` nToString kl_V2246h + !appl_6 <- kl_V2245 `pseq` Primitives.subtract kl_V2245 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_7 <- appl_6 `pseq` (kl_V2246t `pseq` kl_shen_compress_50 appl_6 kl_V2246t) + appl_5 `pseq` (appl_7 `pseq` cn appl_5 appl_7) + pat_cond_8 = do do let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_9 [ApplC (wrapNamed "shen.compress-50" kl_shen_compress_50)] + in case kl_V2246 of + !(kl_V2246@(Cons (!kl_V2246h) + (!kl_V2246t))) -> pat_cond_4 kl_V2246 kl_V2246h kl_V2246t + _ -> pat_cond_8 + in case kl_V2245 of + kl_V2245@(Atom (N (KI 0))) -> pat_cond_2 + _ -> pat_cond_3 + _ -> throwError "if: expected boolean" + +kl_shen_LBst_inputRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBst_inputRB (!kl_V2248) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_4 <- kl_fail + !kl_if_5 <- kl_YaccParse `pseq` (appl_4 `pseq` eq kl_YaccParse appl_4) + case kl_if_5 of + Atom (B (True)) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_7 <- kl_fail + !kl_if_8 <- kl_YaccParse `pseq` (appl_7 `pseq` eq kl_YaccParse appl_7) + case kl_if_8 of + Atom (B (True)) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_10 <- kl_fail + !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 !appl_13 <- kl_fail + !kl_if_14 <- kl_YaccParse `pseq` (appl_13 `pseq` eq kl_YaccParse appl_13) + case kl_if_14 of + Atom (B (True)) -> do let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_16 <- kl_fail + !kl_if_17 <- kl_YaccParse `pseq` (appl_16 `pseq` eq kl_YaccParse appl_16) + case kl_if_17 of + Atom (B (True)) -> do let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_19 <- kl_fail + !kl_if_20 <- kl_YaccParse `pseq` (appl_19 `pseq` eq kl_YaccParse appl_19) + case kl_if_20 of + Atom (B (True)) -> do let !appl_21 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_22 <- kl_fail + !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_YaccParse) -> do !appl_25 <- kl_fail + !kl_if_26 <- kl_YaccParse `pseq` (appl_25 `pseq` eq kl_YaccParse appl_25) + case kl_if_26 of + Atom (B (True)) -> do let !appl_27 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_28 <- kl_fail + !kl_if_29 <- kl_YaccParse `pseq` (appl_28 `pseq` eq kl_YaccParse appl_28) + case kl_if_29 of + Atom (B (True)) -> do let !appl_30 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_31 <- kl_fail + !kl_if_32 <- kl_YaccParse `pseq` (appl_31 `pseq` eq kl_YaccParse appl_31) + case kl_if_32 of + Atom (B (True)) -> do let !appl_33 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_34 <- kl_fail + !kl_if_35 <- kl_YaccParse `pseq` (appl_34 `pseq` eq kl_YaccParse appl_34) + case kl_if_35 of + Atom (B (True)) -> do let !appl_36 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_37 <- kl_fail + !kl_if_38 <- kl_YaccParse `pseq` (appl_37 `pseq` eq kl_YaccParse appl_37) + case kl_if_38 of + Atom (B (True)) -> do let !appl_39 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do !appl_40 <- kl_fail + !appl_41 <- appl_40 `pseq` (kl_Parse_LBeRB `pseq` eq appl_40 kl_Parse_LBeRB) + !kl_if_42 <- appl_41 `pseq` kl_not appl_41 + case kl_if_42 of + Atom (B (True)) -> do !appl_43 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB + let !appl_44 = Atom Nil + appl_43 `pseq` (appl_44 `pseq` kl_shen_pair appl_43 appl_44) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_45 <- kl_V2248 `pseq` kl_LBeRB kl_V2248 + appl_45 `pseq` applyWrapper appl_39 [appl_45] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_46 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBwhitespacesRB) -> do !appl_47 <- kl_fail + !appl_48 <- appl_47 `pseq` (kl_Parse_shen_LBwhitespacesRB `pseq` eq appl_47 kl_Parse_shen_LBwhitespacesRB) + !kl_if_49 <- appl_48 `pseq` kl_not appl_48 + case kl_if_49 of + Atom (B (True)) -> do let !appl_50 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_51 <- kl_fail + !appl_52 <- appl_51 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_51 kl_Parse_shen_LBst_inputRB) + !kl_if_53 <- appl_52 `pseq` kl_not appl_52 + case kl_if_53 of + Atom (B (True)) -> do !appl_54 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_55 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + appl_54 `pseq` (appl_55 `pseq` kl_shen_pair appl_54 appl_55) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_56 <- kl_Parse_shen_LBwhitespacesRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBwhitespacesRB + appl_56 `pseq` applyWrapper appl_50 [appl_56] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_57 <- kl_V2248 `pseq` kl_shen_LBwhitespacesRB kl_V2248 + !appl_58 <- appl_57 `pseq` applyWrapper appl_46 [appl_57] + appl_58 `pseq` applyWrapper appl_36 [appl_58] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_59 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBatomRB) -> do !appl_60 <- kl_fail + !appl_61 <- appl_60 `pseq` (kl_Parse_shen_LBatomRB `pseq` eq appl_60 kl_Parse_shen_LBatomRB) + !kl_if_62 <- appl_61 `pseq` kl_not appl_61 + case kl_if_62 of + Atom (B (True)) -> do let !appl_63 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_64 <- kl_fail + !appl_65 <- appl_64 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_64 kl_Parse_shen_LBst_inputRB) + !kl_if_66 <- appl_65 `pseq` kl_not appl_65 + case kl_if_66 of + Atom (B (True)) -> do !appl_67 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_68 <- kl_Parse_shen_LBatomRB `pseq` kl_shen_hdtl kl_Parse_shen_LBatomRB + let !aw_69 = Core.Types.Atom (Core.Types.UnboundSym "macroexpand") + !appl_70 <- appl_68 `pseq` applyWrapper aw_69 [appl_68] + !appl_71 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + !appl_72 <- appl_70 `pseq` (appl_71 `pseq` klCons appl_70 appl_71) + appl_67 `pseq` (appl_72 `pseq` kl_shen_pair appl_67 appl_72) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_73 <- kl_Parse_shen_LBatomRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBatomRB + appl_73 `pseq` applyWrapper appl_63 [appl_73] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_74 <- kl_V2248 `pseq` kl_shen_LBatomRB kl_V2248 + !appl_75 <- appl_74 `pseq` applyWrapper appl_59 [appl_74] + appl_75 `pseq` applyWrapper appl_33 [appl_75] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_76 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcommentRB) -> do !appl_77 <- kl_fail + !appl_78 <- appl_77 `pseq` (kl_Parse_shen_LBcommentRB `pseq` eq appl_77 kl_Parse_shen_LBcommentRB) + !kl_if_79 <- appl_78 `pseq` kl_not appl_78 + case kl_if_79 of + Atom (B (True)) -> do let !appl_80 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_81 <- kl_fail + !appl_82 <- appl_81 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_81 kl_Parse_shen_LBst_inputRB) + !kl_if_83 <- appl_82 `pseq` kl_not appl_82 + case kl_if_83 of + Atom (B (True)) -> do !appl_84 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_85 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + appl_84 `pseq` (appl_85 `pseq` kl_shen_pair appl_84 appl_85) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_86 <- kl_Parse_shen_LBcommentRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBcommentRB + appl_86 `pseq` applyWrapper appl_80 [appl_86] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_87 <- kl_V2248 `pseq` kl_shen_LBcommentRB kl_V2248 + !appl_88 <- appl_87 `pseq` applyWrapper appl_76 [appl_87] + appl_88 `pseq` applyWrapper appl_30 [appl_88] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_89 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcommaRB) -> do !appl_90 <- kl_fail + !appl_91 <- appl_90 `pseq` (kl_Parse_shen_LBcommaRB `pseq` eq appl_90 kl_Parse_shen_LBcommaRB) + !kl_if_92 <- appl_91 `pseq` kl_not appl_91 + case kl_if_92 of + Atom (B (True)) -> do let !appl_93 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_94 <- kl_fail + !appl_95 <- appl_94 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_94 kl_Parse_shen_LBst_inputRB) + !kl_if_96 <- appl_95 `pseq` kl_not appl_95 + case kl_if_96 of + Atom (B (True)) -> do !appl_97 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_98 <- intern (Core.Types.Atom (Core.Types.Str ",")) + !appl_99 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + !appl_100 <- appl_98 `pseq` (appl_99 `pseq` klCons appl_98 appl_99) + appl_97 `pseq` (appl_100 `pseq` kl_shen_pair appl_97 appl_100) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_101 <- kl_Parse_shen_LBcommaRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBcommaRB + appl_101 `pseq` applyWrapper appl_93 [appl_101] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_102 <- kl_V2248 `pseq` kl_shen_LBcommaRB kl_V2248 + !appl_103 <- appl_102 `pseq` applyWrapper appl_89 [appl_102] + appl_103 `pseq` applyWrapper appl_27 [appl_103] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_104 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcolonRB) -> do !appl_105 <- kl_fail + !appl_106 <- appl_105 `pseq` (kl_Parse_shen_LBcolonRB `pseq` eq appl_105 kl_Parse_shen_LBcolonRB) + !kl_if_107 <- appl_106 `pseq` kl_not appl_106 + case kl_if_107 of + Atom (B (True)) -> do let !appl_108 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_109 <- kl_fail + !appl_110 <- appl_109 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_109 kl_Parse_shen_LBst_inputRB) + !kl_if_111 <- appl_110 `pseq` kl_not appl_110 + case kl_if_111 of + Atom (B (True)) -> do !appl_112 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_113 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + !appl_114 <- appl_113 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":")) appl_113 + appl_112 `pseq` (appl_114 `pseq` kl_shen_pair appl_112 appl_114) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_115 <- kl_Parse_shen_LBcolonRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBcolonRB + appl_115 `pseq` applyWrapper appl_108 [appl_115] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_116 <- kl_V2248 `pseq` kl_shen_LBcolonRB kl_V2248 + !appl_117 <- appl_116 `pseq` applyWrapper appl_104 [appl_116] + appl_117 `pseq` applyWrapper appl_24 [appl_117] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_118 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcolonRB) -> do !appl_119 <- kl_fail + !appl_120 <- appl_119 `pseq` (kl_Parse_shen_LBcolonRB `pseq` eq appl_119 kl_Parse_shen_LBcolonRB) + !kl_if_121 <- appl_120 `pseq` kl_not appl_120 + case kl_if_121 of + Atom (B (True)) -> do let !appl_122 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBminusRB) -> do !appl_123 <- kl_fail + !appl_124 <- appl_123 `pseq` (kl_Parse_shen_LBminusRB `pseq` eq appl_123 kl_Parse_shen_LBminusRB) + !kl_if_125 <- appl_124 `pseq` kl_not appl_124 + case kl_if_125 of + Atom (B (True)) -> do let !appl_126 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_127 <- kl_fail + !appl_128 <- appl_127 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_127 kl_Parse_shen_LBst_inputRB) + !kl_if_129 <- appl_128 `pseq` kl_not appl_128 + case kl_if_129 of + Atom (B (True)) -> do !appl_130 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_131 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + !appl_132 <- appl_131 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":-")) appl_131 + appl_130 `pseq` (appl_132 `pseq` kl_shen_pair appl_130 appl_132) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_133 <- kl_Parse_shen_LBminusRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBminusRB + appl_133 `pseq` applyWrapper appl_126 [appl_133] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_134 <- kl_Parse_shen_LBcolonRB `pseq` kl_shen_LBminusRB kl_Parse_shen_LBcolonRB + appl_134 `pseq` applyWrapper appl_122 [appl_134] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_135 <- kl_V2248 `pseq` kl_shen_LBcolonRB kl_V2248 + !appl_136 <- appl_135 `pseq` applyWrapper appl_118 [appl_135] + appl_136 `pseq` applyWrapper appl_21 [appl_136] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_137 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcolonRB) -> do !appl_138 <- kl_fail + !appl_139 <- appl_138 `pseq` (kl_Parse_shen_LBcolonRB `pseq` eq appl_138 kl_Parse_shen_LBcolonRB) + !kl_if_140 <- appl_139 `pseq` kl_not appl_139 + case kl_if_140 of + Atom (B (True)) -> do let !appl_141 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBequalRB) -> do !appl_142 <- kl_fail + !appl_143 <- appl_142 `pseq` (kl_Parse_shen_LBequalRB `pseq` eq appl_142 kl_Parse_shen_LBequalRB) + !kl_if_144 <- appl_143 `pseq` kl_not appl_143 + case kl_if_144 of + Atom (B (True)) -> do let !appl_145 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_146 <- kl_fail + !appl_147 <- appl_146 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_146 kl_Parse_shen_LBst_inputRB) + !kl_if_148 <- appl_147 `pseq` kl_not appl_147 + case kl_if_148 of + Atom (B (True)) -> do !appl_149 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_150 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + !appl_151 <- appl_150 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":=")) appl_150 + appl_149 `pseq` (appl_151 `pseq` kl_shen_pair appl_149 appl_151) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_152 <- kl_Parse_shen_LBequalRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBequalRB + appl_152 `pseq` applyWrapper appl_145 [appl_152] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_153 <- kl_Parse_shen_LBcolonRB `pseq` kl_shen_LBequalRB kl_Parse_shen_LBcolonRB + appl_153 `pseq` applyWrapper appl_141 [appl_153] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_154 <- kl_V2248 `pseq` kl_shen_LBcolonRB kl_V2248 + !appl_155 <- appl_154 `pseq` applyWrapper appl_137 [appl_154] + appl_155 `pseq` applyWrapper appl_18 [appl_155] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_156 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsemicolonRB) -> do !appl_157 <- kl_fail + !appl_158 <- appl_157 `pseq` (kl_Parse_shen_LBsemicolonRB `pseq` eq appl_157 kl_Parse_shen_LBsemicolonRB) + !kl_if_159 <- appl_158 `pseq` kl_not appl_158 + case kl_if_159 of + Atom (B (True)) -> do let !appl_160 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_161 <- kl_fail + !appl_162 <- appl_161 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_161 kl_Parse_shen_LBst_inputRB) + !kl_if_163 <- appl_162 `pseq` kl_not appl_162 + case kl_if_163 of + Atom (B (True)) -> do !appl_164 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_165 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + !appl_166 <- appl_165 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ";")) appl_165 + appl_164 `pseq` (appl_166 `pseq` kl_shen_pair appl_164 appl_166) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_167 <- kl_Parse_shen_LBsemicolonRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBsemicolonRB + appl_167 `pseq` applyWrapper appl_160 [appl_167] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_168 <- kl_V2248 `pseq` kl_shen_LBsemicolonRB kl_V2248 + !appl_169 <- appl_168 `pseq` applyWrapper appl_156 [appl_168] + appl_169 `pseq` applyWrapper appl_15 [appl_169] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_170 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBbarRB) -> do !appl_171 <- kl_fail + !appl_172 <- appl_171 `pseq` (kl_Parse_shen_LBbarRB `pseq` eq appl_171 kl_Parse_shen_LBbarRB) + !kl_if_173 <- appl_172 `pseq` kl_not appl_172 + case kl_if_173 of + Atom (B (True)) -> do let !appl_174 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_175 <- kl_fail + !appl_176 <- appl_175 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_175 kl_Parse_shen_LBst_inputRB) + !kl_if_177 <- appl_176 `pseq` kl_not appl_176 + case kl_if_177 of + Atom (B (True)) -> do !appl_178 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_179 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + !appl_180 <- appl_179 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "bar!")) appl_179 + appl_178 `pseq` (appl_180 `pseq` kl_shen_pair appl_178 appl_180) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_181 <- kl_Parse_shen_LBbarRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBbarRB + appl_181 `pseq` applyWrapper appl_174 [appl_181] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_182 <- kl_V2248 `pseq` kl_shen_LBbarRB kl_V2248 + !appl_183 <- appl_182 `pseq` applyWrapper appl_170 [appl_182] + appl_183 `pseq` applyWrapper appl_12 [appl_183] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_184 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBrcurlyRB) -> do !appl_185 <- kl_fail + !appl_186 <- appl_185 `pseq` (kl_Parse_shen_LBrcurlyRB `pseq` eq appl_185 kl_Parse_shen_LBrcurlyRB) + !kl_if_187 <- appl_186 `pseq` kl_not appl_186 + case kl_if_187 of + Atom (B (True)) -> do let !appl_188 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_189 <- kl_fail + !appl_190 <- appl_189 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_189 kl_Parse_shen_LBst_inputRB) + !kl_if_191 <- appl_190 `pseq` kl_not appl_190 + case kl_if_191 of + Atom (B (True)) -> do !appl_192 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_193 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + !appl_194 <- appl_193 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "}")) appl_193 + appl_192 `pseq` (appl_194 `pseq` kl_shen_pair appl_192 appl_194) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_195 <- kl_Parse_shen_LBrcurlyRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBrcurlyRB + appl_195 `pseq` applyWrapper appl_188 [appl_195] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_196 <- kl_V2248 `pseq` kl_shen_LBrcurlyRB kl_V2248 + !appl_197 <- appl_196 `pseq` applyWrapper appl_184 [appl_196] + appl_197 `pseq` applyWrapper appl_9 [appl_197] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_198 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBlcurlyRB) -> do !appl_199 <- kl_fail + !appl_200 <- appl_199 `pseq` (kl_Parse_shen_LBlcurlyRB `pseq` eq appl_199 kl_Parse_shen_LBlcurlyRB) + !kl_if_201 <- appl_200 `pseq` kl_not appl_200 + case kl_if_201 of + Atom (B (True)) -> do let !appl_202 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_203 <- kl_fail + !appl_204 <- appl_203 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_203 kl_Parse_shen_LBst_inputRB) + !kl_if_205 <- appl_204 `pseq` kl_not appl_204 + case kl_if_205 of + Atom (B (True)) -> do !appl_206 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_207 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + !appl_208 <- appl_207 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "{")) appl_207 + appl_206 `pseq` (appl_208 `pseq` kl_shen_pair appl_206 appl_208) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_209 <- kl_Parse_shen_LBlcurlyRB `pseq` kl_shen_LBst_inputRB kl_Parse_shen_LBlcurlyRB + appl_209 `pseq` applyWrapper appl_202 [appl_209] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_210 <- kl_V2248 `pseq` kl_shen_LBlcurlyRB kl_V2248 + !appl_211 <- appl_210 `pseq` applyWrapper appl_198 [appl_210] + appl_211 `pseq` applyWrapper appl_6 [appl_211] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_212 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBlrbRB) -> do !appl_213 <- kl_fail + !appl_214 <- appl_213 `pseq` (kl_Parse_shen_LBlrbRB `pseq` eq appl_213 kl_Parse_shen_LBlrbRB) + !kl_if_215 <- appl_214 `pseq` kl_not appl_214 + case kl_if_215 of + Atom (B (True)) -> do let !appl_216 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_input1RB) -> do !appl_217 <- kl_fail + !appl_218 <- appl_217 `pseq` (kl_Parse_shen_LBst_input1RB `pseq` eq appl_217 kl_Parse_shen_LBst_input1RB) + !kl_if_219 <- appl_218 `pseq` kl_not appl_218 + case kl_if_219 of + Atom (B (True)) -> do let !appl_220 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBrrbRB) -> do !appl_221 <- kl_fail + !appl_222 <- appl_221 `pseq` (kl_Parse_shen_LBrrbRB `pseq` eq appl_221 kl_Parse_shen_LBrrbRB) + !kl_if_223 <- appl_222 `pseq` kl_not appl_222 + case kl_if_223 of + Atom (B (True)) -> do let !appl_224 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_input2RB) -> do !appl_225 <- kl_fail + !appl_226 <- appl_225 `pseq` (kl_Parse_shen_LBst_input2RB `pseq` eq appl_225 kl_Parse_shen_LBst_input2RB) + !kl_if_227 <- appl_226 `pseq` kl_not appl_226 + case kl_if_227 of + Atom (B (True)) -> do !appl_228 <- kl_Parse_shen_LBst_input2RB `pseq` hd kl_Parse_shen_LBst_input2RB + !appl_229 <- kl_Parse_shen_LBst_input1RB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_input1RB + let !aw_230 = Core.Types.Atom (Core.Types.UnboundSym "macroexpand") + !appl_231 <- appl_229 `pseq` applyWrapper aw_230 [appl_229] + !appl_232 <- kl_Parse_shen_LBst_input2RB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_input2RB + !appl_233 <- appl_231 `pseq` (appl_232 `pseq` kl_shen_package_macro appl_231 appl_232) + appl_228 `pseq` (appl_233 `pseq` kl_shen_pair appl_228 appl_233) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_234 <- kl_Parse_shen_LBrrbRB `pseq` kl_shen_LBst_input2RB kl_Parse_shen_LBrrbRB + appl_234 `pseq` applyWrapper appl_224 [appl_234] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_235 <- kl_Parse_shen_LBst_input1RB `pseq` kl_shen_LBrrbRB kl_Parse_shen_LBst_input1RB + appl_235 `pseq` applyWrapper appl_220 [appl_235] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_236 <- kl_Parse_shen_LBlrbRB `pseq` kl_shen_LBst_input1RB kl_Parse_shen_LBlrbRB + appl_236 `pseq` applyWrapper appl_216 [appl_236] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_237 <- kl_V2248 `pseq` kl_shen_LBlrbRB kl_V2248 + !appl_238 <- appl_237 `pseq` applyWrapper appl_212 [appl_237] + appl_238 `pseq` applyWrapper appl_3 [appl_238] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_239 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBlsbRB) -> do !appl_240 <- kl_fail + !appl_241 <- appl_240 `pseq` (kl_Parse_shen_LBlsbRB `pseq` eq appl_240 kl_Parse_shen_LBlsbRB) + !kl_if_242 <- appl_241 `pseq` kl_not appl_241 + case kl_if_242 of + Atom (B (True)) -> do let !appl_243 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_input1RB) -> do !appl_244 <- kl_fail + !appl_245 <- appl_244 `pseq` (kl_Parse_shen_LBst_input1RB `pseq` eq appl_244 kl_Parse_shen_LBst_input1RB) + !kl_if_246 <- appl_245 `pseq` kl_not appl_245 + case kl_if_246 of + Atom (B (True)) -> do let !appl_247 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBrsbRB) -> do !appl_248 <- kl_fail + !appl_249 <- appl_248 `pseq` (kl_Parse_shen_LBrsbRB `pseq` eq appl_248 kl_Parse_shen_LBrsbRB) + !kl_if_250 <- appl_249 `pseq` kl_not appl_249 + case kl_if_250 of + Atom (B (True)) -> do let !appl_251 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_input2RB) -> do !appl_252 <- kl_fail + !appl_253 <- appl_252 `pseq` (kl_Parse_shen_LBst_input2RB `pseq` eq appl_252 kl_Parse_shen_LBst_input2RB) + !kl_if_254 <- appl_253 `pseq` kl_not appl_253 + case kl_if_254 of + Atom (B (True)) -> do !appl_255 <- kl_Parse_shen_LBst_input2RB `pseq` hd kl_Parse_shen_LBst_input2RB + !appl_256 <- kl_Parse_shen_LBst_input1RB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_input1RB + !appl_257 <- appl_256 `pseq` kl_shen_cons_form appl_256 + let !aw_258 = Core.Types.Atom (Core.Types.UnboundSym "macroexpand") + !appl_259 <- appl_257 `pseq` applyWrapper aw_258 [appl_257] + !appl_260 <- kl_Parse_shen_LBst_input2RB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_input2RB + !appl_261 <- appl_259 `pseq` (appl_260 `pseq` klCons appl_259 appl_260) + appl_255 `pseq` (appl_261 `pseq` kl_shen_pair appl_255 appl_261) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_262 <- kl_Parse_shen_LBrsbRB `pseq` kl_shen_LBst_input2RB kl_Parse_shen_LBrsbRB + appl_262 `pseq` applyWrapper appl_251 [appl_262] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_263 <- kl_Parse_shen_LBst_input1RB `pseq` kl_shen_LBrsbRB kl_Parse_shen_LBst_input1RB + appl_263 `pseq` applyWrapper appl_247 [appl_263] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_264 <- kl_Parse_shen_LBlsbRB `pseq` kl_shen_LBst_input1RB kl_Parse_shen_LBlsbRB + appl_264 `pseq` applyWrapper appl_243 [appl_264] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_265 <- kl_V2248 `pseq` kl_shen_LBlsbRB kl_V2248 + !appl_266 <- appl_265 `pseq` applyWrapper appl_239 [appl_265] + appl_266 `pseq` applyWrapper appl_0 [appl_266] + +kl_shen_LBlsbRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBlsbRB (!kl_V2250) = do !appl_0 <- kl_V2250 `pseq` hd kl_V2250 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2250 `pseq` hd kl_V2250 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 91))) 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 !appl_6 <- kl_V2250 `pseq` hd kl_V2250 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2250 `pseq` kl_shen_hdtl kl_V2250 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBrsbRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBrsbRB (!kl_V2252) = do !appl_0 <- kl_V2252 `pseq` hd kl_V2252 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2252 `pseq` hd kl_V2252 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 93))) 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 !appl_6 <- kl_V2252 `pseq` hd kl_V2252 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2252 `pseq` kl_shen_hdtl kl_V2252 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBlcurlyRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBlcurlyRB (!kl_V2254) = do !appl_0 <- kl_V2254 `pseq` hd kl_V2254 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2254 `pseq` hd kl_V2254 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 123))) 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 !appl_6 <- kl_V2254 `pseq` hd kl_V2254 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2254 `pseq` kl_shen_hdtl kl_V2254 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBrcurlyRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBrcurlyRB (!kl_V2256) = do !appl_0 <- kl_V2256 `pseq` hd kl_V2256 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2256 `pseq` hd kl_V2256 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 125))) 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 !appl_6 <- kl_V2256 `pseq` hd kl_V2256 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2256 `pseq` kl_shen_hdtl kl_V2256 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBbarRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBbarRB (!kl_V2258) = do !appl_0 <- kl_V2258 `pseq` hd kl_V2258 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2258 `pseq` hd kl_V2258 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 124))) 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 !appl_6 <- kl_V2258 `pseq` hd kl_V2258 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2258 `pseq` kl_shen_hdtl kl_V2258 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBsemicolonRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBsemicolonRB (!kl_V2260) = do !appl_0 <- kl_V2260 `pseq` hd kl_V2260 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2260 `pseq` hd kl_V2260 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 59))) 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 !appl_6 <- kl_V2260 `pseq` hd kl_V2260 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2260 `pseq` kl_shen_hdtl kl_V2260 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBcolonRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBcolonRB (!kl_V2262) = do !appl_0 <- kl_V2262 `pseq` hd kl_V2262 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2262 `pseq` hd kl_V2262 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 58))) 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 !appl_6 <- kl_V2262 `pseq` hd kl_V2262 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2262 `pseq` kl_shen_hdtl kl_V2262 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBcommaRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBcommaRB (!kl_V2264) = do !appl_0 <- kl_V2264 `pseq` hd kl_V2264 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2264 `pseq` hd kl_V2264 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 44))) 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 !appl_6 <- kl_V2264 `pseq` hd kl_V2264 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2264 `pseq` kl_shen_hdtl kl_V2264 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBequalRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBequalRB (!kl_V2266) = do !appl_0 <- kl_V2266 `pseq` hd kl_V2266 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2266 `pseq` hd kl_V2266 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 61))) 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 !appl_6 <- kl_V2266 `pseq` hd kl_V2266 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2266 `pseq` kl_shen_hdtl kl_V2266 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBminusRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBminusRB (!kl_V2268) = do !appl_0 <- kl_V2268 `pseq` hd kl_V2268 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2268 `pseq` hd kl_V2268 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 45))) 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 !appl_6 <- kl_V2268 `pseq` hd kl_V2268 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2268 `pseq` kl_shen_hdtl kl_V2268 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBlrbRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBlrbRB (!kl_V2270) = do !appl_0 <- kl_V2270 `pseq` hd kl_V2270 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2270 `pseq` hd kl_V2270 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 40))) 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 !appl_6 <- kl_V2270 `pseq` hd kl_V2270 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2270 `pseq` kl_shen_hdtl kl_V2270 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBrrbRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBrrbRB (!kl_V2272) = do !appl_0 <- kl_V2272 `pseq` hd kl_V2272 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2272 `pseq` hd kl_V2272 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 41))) 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 !appl_6 <- kl_V2272 `pseq` hd kl_V2272 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2272 `pseq` kl_shen_hdtl kl_V2272 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBatomRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBatomRB (!kl_V2274) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_4 <- kl_fail + !kl_if_5 <- kl_YaccParse `pseq` (appl_4 `pseq` eq kl_YaccParse appl_4) + case kl_if_5 of + Atom (B (True)) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsymRB) -> do !appl_7 <- kl_fail + !appl_8 <- appl_7 `pseq` (kl_Parse_shen_LBsymRB `pseq` eq appl_7 kl_Parse_shen_LBsymRB) + !kl_if_9 <- appl_8 `pseq` kl_not appl_8 + case kl_if_9 of + Atom (B (True)) -> do !appl_10 <- kl_Parse_shen_LBsymRB `pseq` hd kl_Parse_shen_LBsymRB + !appl_11 <- kl_Parse_shen_LBsymRB `pseq` kl_shen_hdtl kl_Parse_shen_LBsymRB + !kl_if_12 <- appl_11 `pseq` eq appl_11 (Core.Types.Atom (Core.Types.Str "<>")) + !appl_13 <- case kl_if_12 of + Atom (B (True)) -> do let !appl_14 = Atom Nil + !appl_15 <- appl_14 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_14 + appl_15 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_15 + Atom (B (False)) -> do do !appl_16 <- kl_Parse_shen_LBsymRB `pseq` kl_shen_hdtl kl_Parse_shen_LBsymRB + appl_16 `pseq` intern appl_16 + _ -> throwError "if: expected boolean" + appl_10 `pseq` (appl_13 `pseq` kl_shen_pair appl_10 appl_13) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_17 <- kl_V2274 `pseq` kl_shen_LBsymRB kl_V2274 + appl_17 `pseq` applyWrapper appl_6 [appl_17] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnumberRB) -> do !appl_19 <- kl_fail + !appl_20 <- appl_19 `pseq` (kl_Parse_shen_LBnumberRB `pseq` eq appl_19 kl_Parse_shen_LBnumberRB) + !kl_if_21 <- appl_20 `pseq` kl_not appl_20 + case kl_if_21 of + Atom (B (True)) -> do !appl_22 <- kl_Parse_shen_LBnumberRB `pseq` hd kl_Parse_shen_LBnumberRB + !appl_23 <- kl_Parse_shen_LBnumberRB `pseq` kl_shen_hdtl kl_Parse_shen_LBnumberRB + appl_22 `pseq` (appl_23 `pseq` kl_shen_pair appl_22 appl_23) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_24 <- kl_V2274 `pseq` kl_shen_LBnumberRB kl_V2274 + !appl_25 <- appl_24 `pseq` applyWrapper appl_18 [appl_24] + appl_25 `pseq` applyWrapper appl_3 [appl_25] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_26 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstrRB) -> do !appl_27 <- kl_fail + !appl_28 <- appl_27 `pseq` (kl_Parse_shen_LBstrRB `pseq` eq appl_27 kl_Parse_shen_LBstrRB) + !kl_if_29 <- appl_28 `pseq` kl_not appl_28 + case kl_if_29 of + Atom (B (True)) -> do !appl_30 <- kl_Parse_shen_LBstrRB `pseq` hd kl_Parse_shen_LBstrRB + !appl_31 <- kl_Parse_shen_LBstrRB `pseq` kl_shen_hdtl kl_Parse_shen_LBstrRB + !appl_32 <- appl_31 `pseq` kl_shen_control_chars appl_31 + appl_30 `pseq` (appl_32 `pseq` kl_shen_pair appl_30 appl_32) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_33 <- kl_V2274 `pseq` kl_shen_LBstrRB kl_V2274 + !appl_34 <- appl_33 `pseq` applyWrapper appl_26 [appl_33] + appl_34 `pseq` applyWrapper appl_0 [appl_34] + +kl_shen_control_chars :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_control_chars (!kl_V2276) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2276 `pseq` eq appl_0 kl_V2276) + case kl_if_1 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.Str "")) + Atom (B (False)) -> do let pat_cond_2 kl_V2276 kl_V2276t kl_V2276tt = do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_CodePoint) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_AfterCodePoint) -> do !appl_5 <- kl_CodePoint `pseq` kl_shen_decimalise kl_CodePoint + !appl_6 <- appl_5 `pseq` nToString appl_5 + !appl_7 <- kl_AfterCodePoint `pseq` kl_shen_control_chars kl_AfterCodePoint + appl_6 `pseq` (appl_7 `pseq` kl_Ats appl_6 appl_7)))) + !appl_8 <- kl_V2276tt `pseq` kl_shen_after_codepoint kl_V2276tt + appl_8 `pseq` applyWrapper appl_4 [appl_8]))) + !appl_9 <- kl_V2276tt `pseq` kl_shen_code_point kl_V2276tt + appl_9 `pseq` applyWrapper appl_3 [appl_9] + pat_cond_10 kl_V2276 kl_V2276h kl_V2276t = do !appl_11 <- kl_V2276t `pseq` kl_shen_control_chars kl_V2276t + kl_V2276h `pseq` (appl_11 `pseq` kl_Ats kl_V2276h appl_11) + pat_cond_12 = do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_13 [ApplC (wrapNamed "shen.control-chars" kl_shen_control_chars)] + in case kl_V2276 of + !(kl_V2276@(Cons (Atom (Str "c")) + (!(kl_V2276t@(Cons (Atom (Str "#")) + (!kl_V2276tt)))))) -> pat_cond_2 kl_V2276 kl_V2276t kl_V2276tt + !(kl_V2276@(Cons (!kl_V2276h) + (!kl_V2276t))) -> pat_cond_10 kl_V2276 kl_V2276h kl_V2276t + _ -> pat_cond_12 + _ -> throwError "if: expected boolean" + +kl_shen_code_point :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_code_point (!kl_V2280) = do let pat_cond_0 kl_V2280 kl_V2280t = do return (Core.Types.Atom (Core.Types.Str "")) + pat_cond_1 = do !kl_if_2 <- let pat_cond_3 kl_V2280 kl_V2280h kl_V2280t = do let !appl_4 = Atom Nil + !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.Str "0")) appl_4 + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.Str "9")) appl_5 + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.Str "8")) appl_6 + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.Str "7")) appl_7 + !appl_9 <- appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.Str "6")) appl_8 + !appl_10 <- appl_9 `pseq` klCons (Core.Types.Atom (Core.Types.Str "5")) appl_9 + !appl_11 <- appl_10 `pseq` klCons (Core.Types.Atom (Core.Types.Str "4")) appl_10 + !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.Str "3")) appl_11 + !appl_13 <- appl_12 `pseq` klCons (Core.Types.Atom (Core.Types.Str "2")) appl_12 + !appl_14 <- appl_13 `pseq` klCons (Core.Types.Atom (Core.Types.Str "1")) appl_13 + !appl_15 <- appl_14 `pseq` klCons (Core.Types.Atom (Core.Types.Str "0")) appl_14 + !kl_if_16 <- kl_V2280h `pseq` (appl_15 `pseq` kl_elementP kl_V2280h appl_15) + case kl_if_16 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_17 = do do return (Atom (B False)) + in case kl_V2280 of + !(kl_V2280@(Cons (!kl_V2280h) + (!kl_V2280t))) -> pat_cond_3 kl_V2280 kl_V2280h kl_V2280t + _ -> pat_cond_17 + case kl_if_2 of + Atom (B (True)) -> do !appl_18 <- kl_V2280 `pseq` hd kl_V2280 + !appl_19 <- kl_V2280 `pseq` tl kl_V2280 + !appl_20 <- appl_19 `pseq` kl_shen_code_point appl_19 + appl_18 `pseq` (appl_20 `pseq` klCons appl_18 appl_20) + Atom (B (False)) -> do do let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_22 <- kl_V2280 `pseq` applyWrapper aw_21 [kl_V2280, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_23 <- appl_22 `pseq` cn (Core.Types.Atom (Core.Types.Str "code point parse error ")) appl_22 + appl_23 `pseq` simpleError appl_23 + _ -> throwError "if: expected boolean" + in case kl_V2280 of + !(kl_V2280@(Cons (Atom (Str ";")) + (!kl_V2280t))) -> pat_cond_0 kl_V2280 kl_V2280t + _ -> pat_cond_1 + +kl_shen_after_codepoint :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_after_codepoint (!kl_V2286) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2286 `pseq` eq appl_0 kl_V2286) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let pat_cond_2 kl_V2286 kl_V2286t = do return kl_V2286t + pat_cond_3 kl_V2286 kl_V2286h kl_V2286t = do kl_V2286t `pseq` kl_shen_after_codepoint kl_V2286t + pat_cond_4 = do do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_5 [ApplC (wrapNamed "shen.after-codepoint" kl_shen_after_codepoint)] + in case kl_V2286 of + !(kl_V2286@(Cons (Atom (Str ";")) + (!kl_V2286t))) -> pat_cond_2 kl_V2286 kl_V2286t + !(kl_V2286@(Cons (!kl_V2286h) + (!kl_V2286t))) -> pat_cond_3 kl_V2286 kl_V2286h kl_V2286t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_shen_decimalise :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_decimalise (!kl_V2288) = do !appl_0 <- kl_V2288 `pseq` kl_shen_digits_RBintegers kl_V2288 + !appl_1 <- appl_0 `pseq` kl_reverse appl_0 + appl_1 `pseq` kl_shen_pre appl_1 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + +kl_shen_digits_RBintegers :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_digits_RBintegers (!kl_V2294) = do let pat_cond_0 kl_V2294 kl_V2294t = do !appl_1 <- kl_V2294t `pseq` kl_shen_digits_RBintegers kl_V2294t + appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_1 + pat_cond_2 kl_V2294 kl_V2294t = do !appl_3 <- kl_V2294t `pseq` kl_shen_digits_RBintegers kl_V2294t + appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_3 + pat_cond_4 kl_V2294 kl_V2294t = do !appl_5 <- kl_V2294t `pseq` kl_shen_digits_RBintegers kl_V2294t + appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) appl_5 + pat_cond_6 kl_V2294 kl_V2294t = do !appl_7 <- kl_V2294t `pseq` kl_shen_digits_RBintegers kl_V2294t + appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_7 + pat_cond_8 kl_V2294 kl_V2294t = do !appl_9 <- kl_V2294t `pseq` kl_shen_digits_RBintegers kl_V2294t + appl_9 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 4))) appl_9 + pat_cond_10 kl_V2294 kl_V2294t = do !appl_11 <- kl_V2294t `pseq` kl_shen_digits_RBintegers kl_V2294t + appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 5))) appl_11 + pat_cond_12 kl_V2294 kl_V2294t = do !appl_13 <- kl_V2294t `pseq` kl_shen_digits_RBintegers kl_V2294t + appl_13 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 6))) appl_13 + pat_cond_14 kl_V2294 kl_V2294t = do !appl_15 <- kl_V2294t `pseq` kl_shen_digits_RBintegers kl_V2294t + appl_15 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 7))) appl_15 + pat_cond_16 kl_V2294 kl_V2294t = do !appl_17 <- kl_V2294t `pseq` kl_shen_digits_RBintegers kl_V2294t + appl_17 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 8))) appl_17 + pat_cond_18 kl_V2294 kl_V2294t = do !appl_19 <- kl_V2294t `pseq` kl_shen_digits_RBintegers kl_V2294t + appl_19 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 9))) appl_19 + pat_cond_20 = do do return (Atom Nil) + in case kl_V2294 of + !(kl_V2294@(Cons (Atom (Str "0")) + (!kl_V2294t))) -> pat_cond_0 kl_V2294 kl_V2294t + !(kl_V2294@(Cons (Atom (Str "1")) + (!kl_V2294t))) -> pat_cond_2 kl_V2294 kl_V2294t + !(kl_V2294@(Cons (Atom (Str "2")) + (!kl_V2294t))) -> pat_cond_4 kl_V2294 kl_V2294t + !(kl_V2294@(Cons (Atom (Str "3")) + (!kl_V2294t))) -> pat_cond_6 kl_V2294 kl_V2294t + !(kl_V2294@(Cons (Atom (Str "4")) + (!kl_V2294t))) -> pat_cond_8 kl_V2294 kl_V2294t + !(kl_V2294@(Cons (Atom (Str "5")) + (!kl_V2294t))) -> pat_cond_10 kl_V2294 kl_V2294t + !(kl_V2294@(Cons (Atom (Str "6")) + (!kl_V2294t))) -> pat_cond_12 kl_V2294 kl_V2294t + !(kl_V2294@(Cons (Atom (Str "7")) + (!kl_V2294t))) -> pat_cond_14 kl_V2294 kl_V2294t + !(kl_V2294@(Cons (Atom (Str "8")) + (!kl_V2294t))) -> pat_cond_16 kl_V2294 kl_V2294t + !(kl_V2294@(Cons (Atom (Str "9")) + (!kl_V2294t))) -> pat_cond_18 kl_V2294 kl_V2294t + _ -> pat_cond_20 + +kl_shen_LBsymRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBsymRB (!kl_V2296) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBalphaRB) -> do !appl_1 <- kl_fail + !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBalphaRB `pseq` eq appl_1 kl_Parse_shen_LBalphaRB) + !kl_if_3 <- appl_2 `pseq` kl_not appl_2 + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBalphanumsRB) -> do !appl_5 <- kl_fail + !appl_6 <- appl_5 `pseq` (kl_Parse_shen_LBalphanumsRB `pseq` eq appl_5 kl_Parse_shen_LBalphanumsRB) + !kl_if_7 <- appl_6 `pseq` kl_not appl_6 + case kl_if_7 of + Atom (B (True)) -> do !appl_8 <- kl_Parse_shen_LBalphanumsRB `pseq` hd kl_Parse_shen_LBalphanumsRB + !appl_9 <- kl_Parse_shen_LBalphaRB `pseq` kl_shen_hdtl kl_Parse_shen_LBalphaRB + !appl_10 <- kl_Parse_shen_LBalphanumsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBalphanumsRB + !appl_11 <- appl_9 `pseq` (appl_10 `pseq` kl_Ats appl_9 appl_10) + appl_8 `pseq` (appl_11 `pseq` kl_shen_pair appl_8 appl_11) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_12 <- kl_Parse_shen_LBalphaRB `pseq` kl_shen_LBalphanumsRB kl_Parse_shen_LBalphaRB + appl_12 `pseq` applyWrapper appl_4 [appl_12] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_13 <- kl_V2296 `pseq` kl_shen_LBalphaRB kl_V2296 + appl_13 `pseq` applyWrapper appl_0 [appl_13] + +kl_shen_LBalphanumsRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBalphanumsRB (!kl_V2298) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do !appl_4 <- kl_fail + !appl_5 <- appl_4 `pseq` (kl_Parse_LBeRB `pseq` eq appl_4 kl_Parse_LBeRB) + !kl_if_6 <- appl_5 `pseq` kl_not appl_5 + case kl_if_6 of + Atom (B (True)) -> do !appl_7 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB + appl_7 `pseq` kl_shen_pair appl_7 (Core.Types.Atom (Core.Types.Str "")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_8 <- kl_V2298 `pseq` kl_LBeRB kl_V2298 + appl_8 `pseq` applyWrapper appl_3 [appl_8] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBalphanumRB) -> do !appl_10 <- kl_fail + !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBalphanumRB `pseq` eq appl_10 kl_Parse_shen_LBalphanumRB) + !kl_if_12 <- appl_11 `pseq` kl_not appl_11 + case kl_if_12 of + Atom (B (True)) -> do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBalphanumsRB) -> do !appl_14 <- kl_fail + !appl_15 <- appl_14 `pseq` (kl_Parse_shen_LBalphanumsRB `pseq` eq appl_14 kl_Parse_shen_LBalphanumsRB) + !kl_if_16 <- appl_15 `pseq` kl_not appl_15 + case kl_if_16 of + Atom (B (True)) -> do !appl_17 <- kl_Parse_shen_LBalphanumsRB `pseq` hd kl_Parse_shen_LBalphanumsRB + !appl_18 <- kl_Parse_shen_LBalphanumRB `pseq` kl_shen_hdtl kl_Parse_shen_LBalphanumRB + !appl_19 <- kl_Parse_shen_LBalphanumsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBalphanumsRB + !appl_20 <- appl_18 `pseq` (appl_19 `pseq` kl_Ats appl_18 appl_19) + appl_17 `pseq` (appl_20 `pseq` kl_shen_pair appl_17 appl_20) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_21 <- kl_Parse_shen_LBalphanumRB `pseq` kl_shen_LBalphanumsRB kl_Parse_shen_LBalphanumRB + appl_21 `pseq` applyWrapper appl_13 [appl_21] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_22 <- kl_V2298 `pseq` kl_shen_LBalphanumRB kl_V2298 + !appl_23 <- appl_22 `pseq` applyWrapper appl_9 [appl_22] + appl_23 `pseq` applyWrapper appl_0 [appl_23] + +kl_shen_LBalphanumRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBalphanumRB (!kl_V2300) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnumRB) -> do !appl_4 <- kl_fail + !appl_5 <- appl_4 `pseq` (kl_Parse_shen_LBnumRB `pseq` eq appl_4 kl_Parse_shen_LBnumRB) + !kl_if_6 <- appl_5 `pseq` kl_not appl_5 + case kl_if_6 of + Atom (B (True)) -> do !appl_7 <- kl_Parse_shen_LBnumRB `pseq` hd kl_Parse_shen_LBnumRB + !appl_8 <- kl_Parse_shen_LBnumRB `pseq` kl_shen_hdtl kl_Parse_shen_LBnumRB + appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_9 <- kl_V2300 `pseq` kl_shen_LBnumRB kl_V2300 + appl_9 `pseq` applyWrapper appl_3 [appl_9] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBalphaRB) -> do !appl_11 <- kl_fail + !appl_12 <- appl_11 `pseq` (kl_Parse_shen_LBalphaRB `pseq` eq appl_11 kl_Parse_shen_LBalphaRB) + !kl_if_13 <- appl_12 `pseq` kl_not appl_12 + case kl_if_13 of + Atom (B (True)) -> do !appl_14 <- kl_Parse_shen_LBalphaRB `pseq` hd kl_Parse_shen_LBalphaRB + !appl_15 <- kl_Parse_shen_LBalphaRB `pseq` kl_shen_hdtl kl_Parse_shen_LBalphaRB + appl_14 `pseq` (appl_15 `pseq` kl_shen_pair appl_14 appl_15) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_16 <- kl_V2300 `pseq` kl_shen_LBalphaRB kl_V2300 + !appl_17 <- appl_16 `pseq` applyWrapper appl_10 [appl_16] + appl_17 `pseq` applyWrapper appl_0 [appl_17] + +kl_shen_LBnumRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBnumRB (!kl_V2302) = do !appl_0 <- kl_V2302 `pseq` hd kl_V2302 + !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_Char) -> do !kl_if_3 <- kl_Parse_Char `pseq` kl_shen_numbyteP kl_Parse_Char + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_V2302 `pseq` hd kl_V2302 + !appl_5 <- appl_4 `pseq` tl appl_4 + !appl_6 <- kl_V2302 `pseq` kl_shen_hdtl kl_V2302 + !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) + !appl_8 <- appl_7 `pseq` hd appl_7 + !appl_9 <- kl_Parse_Char `pseq` nToString kl_Parse_Char + appl_8 `pseq` (appl_9 `pseq` kl_shen_pair appl_8 appl_9) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_10 <- kl_V2302 `pseq` hd kl_V2302 + !appl_11 <- appl_10 `pseq` hd appl_10 + appl_11 `pseq` applyWrapper appl_2 [appl_11] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_numbyteP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_numbyteP (!kl_V2308) = do let pat_cond_0 = do return (Atom (B True)) + pat_cond_1 = do return (Atom (B True)) + pat_cond_2 = do return (Atom (B True)) + pat_cond_3 = do return (Atom (B True)) + pat_cond_4 = do return (Atom (B True)) + pat_cond_5 = do return (Atom (B True)) + pat_cond_6 = do return (Atom (B True)) + pat_cond_7 = do return (Atom (B True)) + pat_cond_8 = do return (Atom (B True)) + pat_cond_9 = do return (Atom (B True)) + pat_cond_10 = do do return (Atom (B False)) + in case kl_V2308 of + kl_V2308@(Atom (N (KI 48))) -> pat_cond_0 + kl_V2308@(Atom (N (KI 49))) -> pat_cond_1 + kl_V2308@(Atom (N (KI 50))) -> pat_cond_2 + kl_V2308@(Atom (N (KI 51))) -> pat_cond_3 + kl_V2308@(Atom (N (KI 52))) -> pat_cond_4 + kl_V2308@(Atom (N (KI 53))) -> pat_cond_5 + kl_V2308@(Atom (N (KI 54))) -> pat_cond_6 + kl_V2308@(Atom (N (KI 55))) -> pat_cond_7 + kl_V2308@(Atom (N (KI 56))) -> pat_cond_8 + kl_V2308@(Atom (N (KI 57))) -> pat_cond_9 + _ -> pat_cond_10 + +kl_shen_LBalphaRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBalphaRB (!kl_V2310) = do !appl_0 <- kl_V2310 `pseq` hd kl_V2310 + !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_Char) -> do !kl_if_3 <- kl_Parse_Char `pseq` kl_shen_symbol_codeP kl_Parse_Char + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_V2310 `pseq` hd kl_V2310 + !appl_5 <- appl_4 `pseq` tl appl_4 + !appl_6 <- kl_V2310 `pseq` kl_shen_hdtl kl_V2310 + !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) + !appl_8 <- appl_7 `pseq` hd appl_7 + !appl_9 <- kl_Parse_Char `pseq` nToString kl_Parse_Char + appl_8 `pseq` (appl_9 `pseq` kl_shen_pair appl_8 appl_9) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_10 <- kl_V2310 `pseq` hd kl_V2310 + !appl_11 <- appl_10 `pseq` hd appl_10 + appl_11 `pseq` applyWrapper appl_2 [appl_11] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_symbol_codeP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_symbol_codeP (!kl_V2312) = do let pat_cond_0 = do return (Atom (B True)) + pat_cond_1 = do do !kl_if_2 <- kl_V2312 `pseq` greaterThan kl_V2312 (Core.Types.Atom (Core.Types.N (Core.Types.KI 94))) + !kl_if_3 <- case kl_if_2 of + Atom (B (True)) -> do !kl_if_4 <- kl_V2312 `pseq` lessThan kl_V2312 (Core.Types.Atom (Core.Types.N (Core.Types.KI 123))) + 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" + !kl_if_5 <- case kl_if_3 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_6 <- kl_V2312 `pseq` greaterThan kl_V2312 (Core.Types.Atom (Core.Types.N (Core.Types.KI 59))) + !kl_if_7 <- case kl_if_6 of + Atom (B (True)) -> do !kl_if_8 <- kl_V2312 `pseq` lessThan kl_V2312 (Core.Types.Atom (Core.Types.N (Core.Types.KI 91))) + 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" + !kl_if_9 <- case kl_if_7 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_10 <- kl_V2312 `pseq` greaterThan kl_V2312 (Core.Types.Atom (Core.Types.N (Core.Types.KI 41))) + !kl_if_11 <- case kl_if_10 of + Atom (B (True)) -> do !kl_if_12 <- kl_V2312 `pseq` lessThan kl_V2312 (Core.Types.Atom (Core.Types.N (Core.Types.KI 58))) + !kl_if_13 <- case kl_if_12 of + Atom (B (True)) -> do !appl_14 <- kl_V2312 `pseq` eq kl_V2312 (Core.Types.Atom (Core.Types.N (Core.Types.KI 44))) + !kl_if_15 <- appl_14 `pseq` kl_not appl_14 + 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" + case kl_if_13 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + !kl_if_16 <- case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_17 <- kl_V2312 `pseq` greaterThan kl_V2312 (Core.Types.Atom (Core.Types.N (Core.Types.KI 34))) + !kl_if_18 <- case kl_if_17 of + Atom (B (True)) -> do !kl_if_19 <- kl_V2312 `pseq` lessThan kl_V2312 (Core.Types.Atom (Core.Types.N (Core.Types.KI 40))) + case kl_if_19 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + !kl_if_20 <- case kl_if_18 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do let pat_cond_21 = do return (Atom (B True)) + pat_cond_22 = do do return (Atom (B False)) + in case kl_V2312 of + kl_V2312@(Atom (N (KI 33))) -> pat_cond_21 + _ -> pat_cond_22 + _ -> throwError "if: expected boolean" + case kl_if_20 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + case kl_if_16 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + 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" + in case kl_V2312 of + kl_V2312@(Atom (N (KI 126))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_LBstrRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBstrRB (!kl_V2314) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdbqRB) -> do !appl_1 <- kl_fail + !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBdbqRB `pseq` eq appl_1 kl_Parse_shen_LBdbqRB) + !kl_if_3 <- appl_2 `pseq` kl_not appl_2 + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstrcontentsRB) -> do !appl_5 <- kl_fail + !appl_6 <- appl_5 `pseq` (kl_Parse_shen_LBstrcontentsRB `pseq` eq appl_5 kl_Parse_shen_LBstrcontentsRB) + !kl_if_7 <- appl_6 `pseq` kl_not appl_6 + case kl_if_7 of + Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdbqRB) -> do !appl_9 <- kl_fail + !appl_10 <- appl_9 `pseq` (kl_Parse_shen_LBdbqRB `pseq` eq appl_9 kl_Parse_shen_LBdbqRB) + !kl_if_11 <- appl_10 `pseq` kl_not appl_10 + case kl_if_11 of + Atom (B (True)) -> do !appl_12 <- kl_Parse_shen_LBdbqRB `pseq` hd kl_Parse_shen_LBdbqRB + !appl_13 <- kl_Parse_shen_LBstrcontentsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBstrcontentsRB + appl_12 `pseq` (appl_13 `pseq` kl_shen_pair appl_12 appl_13) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_14 <- kl_Parse_shen_LBstrcontentsRB `pseq` kl_shen_LBdbqRB kl_Parse_shen_LBstrcontentsRB + appl_14 `pseq` applyWrapper appl_8 [appl_14] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_15 <- kl_Parse_shen_LBdbqRB `pseq` kl_shen_LBstrcontentsRB kl_Parse_shen_LBdbqRB + appl_15 `pseq` applyWrapper appl_4 [appl_15] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_16 <- kl_V2314 `pseq` kl_shen_LBdbqRB kl_V2314 + appl_16 `pseq` applyWrapper appl_0 [appl_16] + +kl_shen_LBdbqRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBdbqRB (!kl_V2316) = do !appl_0 <- kl_V2316 `pseq` hd kl_V2316 + !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_Char) -> do let pat_cond_3 = do !appl_4 <- kl_V2316 `pseq` hd kl_V2316 + !appl_5 <- appl_4 `pseq` tl appl_4 + !appl_6 <- kl_V2316 `pseq` kl_shen_hdtl kl_V2316 + !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) + !appl_8 <- appl_7 `pseq` hd appl_7 + appl_8 `pseq` (kl_Parse_Char `pseq` kl_shen_pair appl_8 kl_Parse_Char) + pat_cond_9 = do do kl_fail + in case kl_Parse_Char of + kl_Parse_Char@(Atom (N (KI 34))) -> pat_cond_3 + _ -> pat_cond_9))) + !appl_10 <- kl_V2316 `pseq` hd kl_V2316 + !appl_11 <- appl_10 `pseq` hd appl_10 + appl_11 `pseq` applyWrapper appl_2 [appl_11] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBstrcontentsRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBstrcontentsRB (!kl_V2318) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do !appl_4 <- kl_fail + !appl_5 <- appl_4 `pseq` (kl_Parse_LBeRB `pseq` eq appl_4 kl_Parse_LBeRB) + !kl_if_6 <- appl_5 `pseq` kl_not appl_5 + case kl_if_6 of + Atom (B (True)) -> do !appl_7 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB + let !appl_8 = Atom Nil + appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_9 <- kl_V2318 `pseq` kl_LBeRB kl_V2318 + appl_9 `pseq` applyWrapper appl_3 [appl_9] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstrcRB) -> do !appl_11 <- kl_fail + !appl_12 <- appl_11 `pseq` (kl_Parse_shen_LBstrcRB `pseq` eq appl_11 kl_Parse_shen_LBstrcRB) + !kl_if_13 <- appl_12 `pseq` kl_not appl_12 + case kl_if_13 of + Atom (B (True)) -> do let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstrcontentsRB) -> do !appl_15 <- kl_fail + !appl_16 <- appl_15 `pseq` (kl_Parse_shen_LBstrcontentsRB `pseq` eq appl_15 kl_Parse_shen_LBstrcontentsRB) + !kl_if_17 <- appl_16 `pseq` kl_not appl_16 + case kl_if_17 of + Atom (B (True)) -> do !appl_18 <- kl_Parse_shen_LBstrcontentsRB `pseq` hd kl_Parse_shen_LBstrcontentsRB + !appl_19 <- kl_Parse_shen_LBstrcRB `pseq` kl_shen_hdtl kl_Parse_shen_LBstrcRB + !appl_20 <- kl_Parse_shen_LBstrcontentsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBstrcontentsRB + !appl_21 <- appl_19 `pseq` (appl_20 `pseq` klCons appl_19 appl_20) + appl_18 `pseq` (appl_21 `pseq` kl_shen_pair appl_18 appl_21) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_22 <- kl_Parse_shen_LBstrcRB `pseq` kl_shen_LBstrcontentsRB kl_Parse_shen_LBstrcRB + appl_22 `pseq` applyWrapper appl_14 [appl_22] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_23 <- kl_V2318 `pseq` kl_shen_LBstrcRB kl_V2318 + !appl_24 <- appl_23 `pseq` applyWrapper appl_10 [appl_23] + appl_24 `pseq` applyWrapper appl_0 [appl_24] + +kl_shen_LBbyteRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBbyteRB (!kl_V2320) = do !appl_0 <- kl_V2320 `pseq` hd kl_V2320 + !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_Char) -> do !appl_3 <- kl_V2320 `pseq` hd kl_V2320 + !appl_4 <- appl_3 `pseq` tl appl_3 + !appl_5 <- kl_V2320 `pseq` kl_shen_hdtl kl_V2320 + !appl_6 <- appl_4 `pseq` (appl_5 `pseq` kl_shen_pair appl_4 appl_5) + !appl_7 <- appl_6 `pseq` hd appl_6 + !appl_8 <- kl_Parse_Char `pseq` nToString kl_Parse_Char + appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8)))) + !appl_9 <- kl_V2320 `pseq` hd kl_V2320 + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` applyWrapper appl_2 [appl_10] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBstrcRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBstrcRB (!kl_V2322) = do !appl_0 <- kl_V2322 `pseq` hd kl_V2322 + !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_Char) -> do !appl_3 <- kl_Parse_Char `pseq` eq kl_Parse_Char (Core.Types.Atom (Core.Types.N (Core.Types.KI 34))) + !kl_if_4 <- appl_3 `pseq` kl_not appl_3 + case kl_if_4 of + Atom (B (True)) -> do !appl_5 <- kl_V2322 `pseq` hd kl_V2322 + !appl_6 <- appl_5 `pseq` tl appl_5 + !appl_7 <- kl_V2322 `pseq` kl_shen_hdtl kl_V2322 + !appl_8 <- appl_6 `pseq` (appl_7 `pseq` kl_shen_pair appl_6 appl_7) + !appl_9 <- appl_8 `pseq` hd appl_8 + !appl_10 <- kl_Parse_Char `pseq` nToString kl_Parse_Char + appl_9 `pseq` (appl_10 `pseq` kl_shen_pair appl_9 appl_10) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_11 <- kl_V2322 `pseq` hd kl_V2322 + !appl_12 <- appl_11 `pseq` hd appl_11 + appl_12 `pseq` applyWrapper appl_2 [appl_12] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBnumberRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBnumberRB (!kl_V2324) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_4 <- kl_fail + !kl_if_5 <- kl_YaccParse `pseq` (appl_4 `pseq` eq kl_YaccParse appl_4) + case kl_if_5 of + Atom (B (True)) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_7 <- kl_fail + !kl_if_8 <- kl_YaccParse `pseq` (appl_7 `pseq` eq kl_YaccParse appl_7) + case kl_if_8 of + Atom (B (True)) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_10 <- kl_fail + !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 !appl_13 <- kl_fail + !kl_if_14 <- kl_YaccParse `pseq` (appl_13 `pseq` eq kl_YaccParse appl_13) + case kl_if_14 of + Atom (B (True)) -> do let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_16 <- kl_fail + !appl_17 <- appl_16 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_16 kl_Parse_shen_LBdigitsRB) + !kl_if_18 <- appl_17 `pseq` kl_not appl_17 + case kl_if_18 of + Atom (B (True)) -> do !appl_19 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB + !appl_20 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB + !appl_21 <- appl_20 `pseq` kl_reverse appl_20 + !appl_22 <- appl_21 `pseq` kl_shen_pre appl_21 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + appl_19 `pseq` (appl_22 `pseq` kl_shen_pair appl_19 appl_22) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_23 <- kl_V2324 `pseq` kl_shen_LBdigitsRB kl_V2324 + appl_23 `pseq` applyWrapper appl_15 [appl_23] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpredigitsRB) -> do !appl_25 <- kl_fail + !appl_26 <- appl_25 `pseq` (kl_Parse_shen_LBpredigitsRB `pseq` eq appl_25 kl_Parse_shen_LBpredigitsRB) + !kl_if_27 <- appl_26 `pseq` kl_not appl_26 + case kl_if_27 of + Atom (B (True)) -> do let !appl_28 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstopRB) -> do !appl_29 <- kl_fail + !appl_30 <- appl_29 `pseq` (kl_Parse_shen_LBstopRB `pseq` eq appl_29 kl_Parse_shen_LBstopRB) + !kl_if_31 <- appl_30 `pseq` kl_not appl_30 + case kl_if_31 of + Atom (B (True)) -> do let !appl_32 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpostdigitsRB) -> do !appl_33 <- kl_fail + !appl_34 <- appl_33 `pseq` (kl_Parse_shen_LBpostdigitsRB `pseq` eq appl_33 kl_Parse_shen_LBpostdigitsRB) + !kl_if_35 <- appl_34 `pseq` kl_not appl_34 + case kl_if_35 of + Atom (B (True)) -> do !appl_36 <- kl_Parse_shen_LBpostdigitsRB `pseq` hd kl_Parse_shen_LBpostdigitsRB + !appl_37 <- kl_Parse_shen_LBpredigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBpredigitsRB + !appl_38 <- appl_37 `pseq` kl_reverse appl_37 + !appl_39 <- appl_38 `pseq` kl_shen_pre appl_38 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !appl_40 <- kl_Parse_shen_LBpostdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBpostdigitsRB + !appl_41 <- appl_40 `pseq` kl_shen_post appl_40 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_42 <- appl_39 `pseq` (appl_41 `pseq` add appl_39 appl_41) + appl_36 `pseq` (appl_42 `pseq` kl_shen_pair appl_36 appl_42) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_43 <- kl_Parse_shen_LBstopRB `pseq` kl_shen_LBpostdigitsRB kl_Parse_shen_LBstopRB + appl_43 `pseq` applyWrapper appl_32 [appl_43] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_44 <- kl_Parse_shen_LBpredigitsRB `pseq` kl_shen_LBstopRB kl_Parse_shen_LBpredigitsRB + appl_44 `pseq` applyWrapper appl_28 [appl_44] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_45 <- kl_V2324 `pseq` kl_shen_LBpredigitsRB kl_V2324 + !appl_46 <- appl_45 `pseq` applyWrapper appl_24 [appl_45] + appl_46 `pseq` applyWrapper appl_12 [appl_46] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_47 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_48 <- kl_fail + !appl_49 <- appl_48 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_48 kl_Parse_shen_LBdigitsRB) + !kl_if_50 <- appl_49 `pseq` kl_not appl_49 + case kl_if_50 of + Atom (B (True)) -> do let !appl_51 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBERB) -> do !appl_52 <- kl_fail + !appl_53 <- appl_52 `pseq` (kl_Parse_shen_LBERB `pseq` eq appl_52 kl_Parse_shen_LBERB) + !kl_if_54 <- appl_53 `pseq` kl_not appl_53 + case kl_if_54 of + Atom (B (True)) -> do let !appl_55 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBlog10RB) -> do !appl_56 <- kl_fail + !appl_57 <- appl_56 `pseq` (kl_Parse_shen_LBlog10RB `pseq` eq appl_56 kl_Parse_shen_LBlog10RB) + !kl_if_58 <- appl_57 `pseq` kl_not appl_57 + case kl_if_58 of + Atom (B (True)) -> do !appl_59 <- kl_Parse_shen_LBlog10RB `pseq` hd kl_Parse_shen_LBlog10RB + !appl_60 <- kl_Parse_shen_LBlog10RB `pseq` kl_shen_hdtl kl_Parse_shen_LBlog10RB + !appl_61 <- appl_60 `pseq` kl_shen_expt (Core.Types.Atom (Core.Types.N (Core.Types.KI 10))) appl_60 + !appl_62 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB + !appl_63 <- appl_62 `pseq` kl_reverse appl_62 + !appl_64 <- appl_63 `pseq` kl_shen_pre appl_63 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !appl_65 <- appl_61 `pseq` (appl_64 `pseq` multiply appl_61 appl_64) + appl_59 `pseq` (appl_65 `pseq` kl_shen_pair appl_59 appl_65) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_66 <- kl_Parse_shen_LBERB `pseq` kl_shen_LBlog10RB kl_Parse_shen_LBERB + appl_66 `pseq` applyWrapper appl_55 [appl_66] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_67 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_LBERB kl_Parse_shen_LBdigitsRB + appl_67 `pseq` applyWrapper appl_51 [appl_67] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_68 <- kl_V2324 `pseq` kl_shen_LBdigitsRB kl_V2324 + !appl_69 <- appl_68 `pseq` applyWrapper appl_47 [appl_68] + appl_69 `pseq` applyWrapper appl_9 [appl_69] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_70 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpredigitsRB) -> do !appl_71 <- kl_fail + !appl_72 <- appl_71 `pseq` (kl_Parse_shen_LBpredigitsRB `pseq` eq appl_71 kl_Parse_shen_LBpredigitsRB) + !kl_if_73 <- appl_72 `pseq` kl_not appl_72 + case kl_if_73 of + Atom (B (True)) -> do let !appl_74 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBstopRB) -> do !appl_75 <- kl_fail + !appl_76 <- appl_75 `pseq` (kl_Parse_shen_LBstopRB `pseq` eq appl_75 kl_Parse_shen_LBstopRB) + !kl_if_77 <- appl_76 `pseq` kl_not appl_76 + case kl_if_77 of + Atom (B (True)) -> do let !appl_78 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpostdigitsRB) -> do !appl_79 <- kl_fail + !appl_80 <- appl_79 `pseq` (kl_Parse_shen_LBpostdigitsRB `pseq` eq appl_79 kl_Parse_shen_LBpostdigitsRB) + !kl_if_81 <- appl_80 `pseq` kl_not appl_80 + case kl_if_81 of + Atom (B (True)) -> do let !appl_82 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBERB) -> do !appl_83 <- kl_fail + !appl_84 <- appl_83 `pseq` (kl_Parse_shen_LBERB `pseq` eq appl_83 kl_Parse_shen_LBERB) + !kl_if_85 <- appl_84 `pseq` kl_not appl_84 + case kl_if_85 of + Atom (B (True)) -> do let !appl_86 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBlog10RB) -> do !appl_87 <- kl_fail + !appl_88 <- appl_87 `pseq` (kl_Parse_shen_LBlog10RB `pseq` eq appl_87 kl_Parse_shen_LBlog10RB) + !kl_if_89 <- appl_88 `pseq` kl_not appl_88 + case kl_if_89 of + Atom (B (True)) -> do !appl_90 <- kl_Parse_shen_LBlog10RB `pseq` hd kl_Parse_shen_LBlog10RB + !appl_91 <- kl_Parse_shen_LBlog10RB `pseq` kl_shen_hdtl kl_Parse_shen_LBlog10RB + !appl_92 <- appl_91 `pseq` kl_shen_expt (Core.Types.Atom (Core.Types.N (Core.Types.KI 10))) appl_91 + !appl_93 <- kl_Parse_shen_LBpredigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBpredigitsRB + !appl_94 <- appl_93 `pseq` kl_reverse appl_93 + !appl_95 <- appl_94 `pseq` kl_shen_pre appl_94 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !appl_96 <- kl_Parse_shen_LBpostdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBpostdigitsRB + !appl_97 <- appl_96 `pseq` kl_shen_post appl_96 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_98 <- appl_95 `pseq` (appl_97 `pseq` add appl_95 appl_97) + !appl_99 <- appl_92 `pseq` (appl_98 `pseq` multiply appl_92 appl_98) + appl_90 `pseq` (appl_99 `pseq` kl_shen_pair appl_90 appl_99) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_100 <- kl_Parse_shen_LBERB `pseq` kl_shen_LBlog10RB kl_Parse_shen_LBERB + appl_100 `pseq` applyWrapper appl_86 [appl_100] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_101 <- kl_Parse_shen_LBpostdigitsRB `pseq` kl_shen_LBERB kl_Parse_shen_LBpostdigitsRB + appl_101 `pseq` applyWrapper appl_82 [appl_101] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_102 <- kl_Parse_shen_LBstopRB `pseq` kl_shen_LBpostdigitsRB kl_Parse_shen_LBstopRB + appl_102 `pseq` applyWrapper appl_78 [appl_102] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_103 <- kl_Parse_shen_LBpredigitsRB `pseq` kl_shen_LBstopRB kl_Parse_shen_LBpredigitsRB + appl_103 `pseq` applyWrapper appl_74 [appl_103] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_104 <- kl_V2324 `pseq` kl_shen_LBpredigitsRB kl_V2324 + !appl_105 <- appl_104 `pseq` applyWrapper appl_70 [appl_104] + appl_105 `pseq` applyWrapper appl_6 [appl_105] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_106 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBplusRB) -> do !appl_107 <- kl_fail + !appl_108 <- appl_107 `pseq` (kl_Parse_shen_LBplusRB `pseq` eq appl_107 kl_Parse_shen_LBplusRB) + !kl_if_109 <- appl_108 `pseq` kl_not appl_108 + case kl_if_109 of + Atom (B (True)) -> do let !appl_110 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnumberRB) -> do !appl_111 <- kl_fail + !appl_112 <- appl_111 `pseq` (kl_Parse_shen_LBnumberRB `pseq` eq appl_111 kl_Parse_shen_LBnumberRB) + !kl_if_113 <- appl_112 `pseq` kl_not appl_112 + case kl_if_113 of + Atom (B (True)) -> do !appl_114 <- kl_Parse_shen_LBnumberRB `pseq` hd kl_Parse_shen_LBnumberRB + !appl_115 <- kl_Parse_shen_LBnumberRB `pseq` kl_shen_hdtl kl_Parse_shen_LBnumberRB + appl_114 `pseq` (appl_115 `pseq` kl_shen_pair appl_114 appl_115) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_116 <- kl_Parse_shen_LBplusRB `pseq` kl_shen_LBnumberRB kl_Parse_shen_LBplusRB + appl_116 `pseq` applyWrapper appl_110 [appl_116] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_117 <- kl_V2324 `pseq` kl_shen_LBplusRB kl_V2324 + !appl_118 <- appl_117 `pseq` applyWrapper appl_106 [appl_117] + appl_118 `pseq` applyWrapper appl_3 [appl_118] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_119 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBminusRB) -> do !appl_120 <- kl_fail + !appl_121 <- appl_120 `pseq` (kl_Parse_shen_LBminusRB `pseq` eq appl_120 kl_Parse_shen_LBminusRB) + !kl_if_122 <- appl_121 `pseq` kl_not appl_121 + case kl_if_122 of + Atom (B (True)) -> do let !appl_123 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnumberRB) -> do !appl_124 <- kl_fail + !appl_125 <- appl_124 `pseq` (kl_Parse_shen_LBnumberRB `pseq` eq appl_124 kl_Parse_shen_LBnumberRB) + !kl_if_126 <- appl_125 `pseq` kl_not appl_125 + case kl_if_126 of + Atom (B (True)) -> do !appl_127 <- kl_Parse_shen_LBnumberRB `pseq` hd kl_Parse_shen_LBnumberRB + !appl_128 <- kl_Parse_shen_LBnumberRB `pseq` kl_shen_hdtl kl_Parse_shen_LBnumberRB + !appl_129 <- appl_128 `pseq` Primitives.subtract (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_128 + appl_127 `pseq` (appl_129 `pseq` kl_shen_pair appl_127 appl_129) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_130 <- kl_Parse_shen_LBminusRB `pseq` kl_shen_LBnumberRB kl_Parse_shen_LBminusRB + appl_130 `pseq` applyWrapper appl_123 [appl_130] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_131 <- kl_V2324 `pseq` kl_shen_LBminusRB kl_V2324 + !appl_132 <- appl_131 `pseq` applyWrapper appl_119 [appl_131] + appl_132 `pseq` applyWrapper appl_0 [appl_132] + +kl_shen_LBERB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBERB (!kl_V2326) = do !appl_0 <- kl_V2326 `pseq` hd kl_V2326 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2326 `pseq` hd kl_V2326 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 101))) 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 !appl_6 <- kl_V2326 `pseq` hd kl_V2326 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2326 `pseq` kl_shen_hdtl kl_V2326 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBlog10RB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBlog10RB (!kl_V2328) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_4 <- kl_fail + !appl_5 <- appl_4 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_4 kl_Parse_shen_LBdigitsRB) + !kl_if_6 <- appl_5 `pseq` kl_not appl_5 + case kl_if_6 of + Atom (B (True)) -> do !appl_7 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB + !appl_8 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB + !appl_9 <- appl_8 `pseq` kl_reverse appl_8 + !appl_10 <- appl_9 `pseq` kl_shen_pre appl_9 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + appl_7 `pseq` (appl_10 `pseq` kl_shen_pair appl_7 appl_10) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_11 <- kl_V2328 `pseq` kl_shen_LBdigitsRB kl_V2328 + appl_11 `pseq` applyWrapper appl_3 [appl_11] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBminusRB) -> do !appl_13 <- kl_fail + !appl_14 <- appl_13 `pseq` (kl_Parse_shen_LBminusRB `pseq` eq appl_13 kl_Parse_shen_LBminusRB) + !kl_if_15 <- appl_14 `pseq` kl_not appl_14 + case kl_if_15 of + Atom (B (True)) -> do let !appl_16 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_17 <- kl_fail + !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_17 kl_Parse_shen_LBdigitsRB) + !kl_if_19 <- appl_18 `pseq` kl_not appl_18 + case kl_if_19 of + Atom (B (True)) -> do !appl_20 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB + !appl_21 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB + !appl_22 <- appl_21 `pseq` kl_reverse appl_21 + !appl_23 <- appl_22 `pseq` kl_shen_pre appl_22 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !appl_24 <- appl_23 `pseq` Primitives.subtract (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_23 + appl_20 `pseq` (appl_24 `pseq` kl_shen_pair appl_20 appl_24) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_25 <- kl_Parse_shen_LBminusRB `pseq` kl_shen_LBdigitsRB kl_Parse_shen_LBminusRB + appl_25 `pseq` applyWrapper appl_16 [appl_25] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_26 <- kl_V2328 `pseq` kl_shen_LBminusRB kl_V2328 + !appl_27 <- appl_26 `pseq` applyWrapper appl_12 [appl_26] + appl_27 `pseq` applyWrapper appl_0 [appl_27] + +kl_shen_LBplusRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBplusRB (!kl_V2330) = do !appl_0 <- kl_V2330 `pseq` hd kl_V2330 + !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_Char) -> do let pat_cond_3 = do !appl_4 <- kl_V2330 `pseq` hd kl_V2330 + !appl_5 <- appl_4 `pseq` tl appl_4 + !appl_6 <- kl_V2330 `pseq` kl_shen_hdtl kl_V2330 + !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) + !appl_8 <- appl_7 `pseq` hd appl_7 + appl_8 `pseq` (kl_Parse_Char `pseq` kl_shen_pair appl_8 kl_Parse_Char) + pat_cond_9 = do do kl_fail + in case kl_Parse_Char of + kl_Parse_Char@(Atom (N (KI 43))) -> pat_cond_3 + _ -> pat_cond_9))) + !appl_10 <- kl_V2330 `pseq` hd kl_V2330 + !appl_11 <- appl_10 `pseq` hd appl_10 + appl_11 `pseq` applyWrapper appl_2 [appl_11] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBstopRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBstopRB (!kl_V2332) = do !appl_0 <- kl_V2332 `pseq` hd kl_V2332 + !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_Char) -> do let pat_cond_3 = do !appl_4 <- kl_V2332 `pseq` hd kl_V2332 + !appl_5 <- appl_4 `pseq` tl appl_4 + !appl_6 <- kl_V2332 `pseq` kl_shen_hdtl kl_V2332 + !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) + !appl_8 <- appl_7 `pseq` hd appl_7 + appl_8 `pseq` (kl_Parse_Char `pseq` kl_shen_pair appl_8 kl_Parse_Char) + pat_cond_9 = do do kl_fail + in case kl_Parse_Char of + kl_Parse_Char@(Atom (N (KI 46))) -> pat_cond_3 + _ -> pat_cond_9))) + !appl_10 <- kl_V2332 `pseq` hd kl_V2332 + !appl_11 <- appl_10 `pseq` hd appl_10 + appl_11 `pseq` applyWrapper appl_2 [appl_11] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBpredigitsRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBpredigitsRB (!kl_V2334) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do !appl_4 <- kl_fail + !appl_5 <- appl_4 `pseq` (kl_Parse_LBeRB `pseq` eq appl_4 kl_Parse_LBeRB) + !kl_if_6 <- appl_5 `pseq` kl_not appl_5 + case kl_if_6 of + Atom (B (True)) -> do !appl_7 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB + let !appl_8 = Atom Nil + appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_9 <- kl_V2334 `pseq` kl_LBeRB kl_V2334 + appl_9 `pseq` applyWrapper appl_3 [appl_9] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_11 <- kl_fail + !appl_12 <- appl_11 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_11 kl_Parse_shen_LBdigitsRB) + !kl_if_13 <- appl_12 `pseq` kl_not appl_12 + case kl_if_13 of + Atom (B (True)) -> do !appl_14 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB + !appl_15 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB + appl_14 `pseq` (appl_15 `pseq` kl_shen_pair appl_14 appl_15) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_16 <- kl_V2334 `pseq` kl_shen_LBdigitsRB kl_V2334 + !appl_17 <- appl_16 `pseq` applyWrapper appl_10 [appl_16] + appl_17 `pseq` applyWrapper appl_0 [appl_17] + +kl_shen_LBpostdigitsRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBpostdigitsRB (!kl_V2336) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_1 <- kl_fail + !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_1 kl_Parse_shen_LBdigitsRB) + !kl_if_3 <- appl_2 `pseq` kl_not appl_2 + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB + !appl_5 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB + appl_4 `pseq` (appl_5 `pseq` kl_shen_pair appl_4 appl_5) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_6 <- kl_V2336 `pseq` kl_shen_LBdigitsRB kl_V2336 + appl_6 `pseq` applyWrapper appl_0 [appl_6] + +kl_shen_LBdigitsRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBdigitsRB (!kl_V2338) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitRB) -> do !appl_4 <- kl_fail + !appl_5 <- appl_4 `pseq` (kl_Parse_shen_LBdigitRB `pseq` eq appl_4 kl_Parse_shen_LBdigitRB) + !kl_if_6 <- appl_5 `pseq` kl_not appl_5 + case kl_if_6 of + Atom (B (True)) -> do !appl_7 <- kl_Parse_shen_LBdigitRB `pseq` hd kl_Parse_shen_LBdigitRB + !appl_8 <- kl_Parse_shen_LBdigitRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitRB + let !appl_9 = Atom Nil + !appl_10 <- appl_8 `pseq` (appl_9 `pseq` klCons appl_8 appl_9) + appl_7 `pseq` (appl_10 `pseq` kl_shen_pair appl_7 appl_10) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_11 <- kl_V2338 `pseq` kl_shen_LBdigitRB kl_V2338 + appl_11 `pseq` applyWrapper appl_3 [appl_11] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitRB) -> do !appl_13 <- kl_fail + !appl_14 <- appl_13 `pseq` (kl_Parse_shen_LBdigitRB `pseq` eq appl_13 kl_Parse_shen_LBdigitRB) + !kl_if_15 <- appl_14 `pseq` kl_not appl_14 + case kl_if_15 of + Atom (B (True)) -> do let !appl_16 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdigitsRB) -> do !appl_17 <- kl_fail + !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBdigitsRB `pseq` eq appl_17 kl_Parse_shen_LBdigitsRB) + !kl_if_19 <- appl_18 `pseq` kl_not appl_18 + case kl_if_19 of + Atom (B (True)) -> do !appl_20 <- kl_Parse_shen_LBdigitsRB `pseq` hd kl_Parse_shen_LBdigitsRB + !appl_21 <- kl_Parse_shen_LBdigitRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitRB + !appl_22 <- kl_Parse_shen_LBdigitsRB `pseq` kl_shen_hdtl kl_Parse_shen_LBdigitsRB + !appl_23 <- appl_21 `pseq` (appl_22 `pseq` klCons appl_21 appl_22) + appl_20 `pseq` (appl_23 `pseq` kl_shen_pair appl_20 appl_23) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_24 <- kl_Parse_shen_LBdigitRB `pseq` kl_shen_LBdigitsRB kl_Parse_shen_LBdigitRB + appl_24 `pseq` applyWrapper appl_16 [appl_24] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_25 <- kl_V2338 `pseq` kl_shen_LBdigitRB kl_V2338 + !appl_26 <- appl_25 `pseq` applyWrapper appl_12 [appl_25] + appl_26 `pseq` applyWrapper appl_0 [appl_26] + +kl_shen_LBdigitRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBdigitRB (!kl_V2340) = do !appl_0 <- kl_V2340 `pseq` hd kl_V2340 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !kl_if_3 <- kl_Parse_X `pseq` kl_shen_numbyteP kl_Parse_X + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_V2340 `pseq` hd kl_V2340 + !appl_5 <- appl_4 `pseq` tl appl_4 + !appl_6 <- kl_V2340 `pseq` kl_shen_hdtl kl_V2340 + !appl_7 <- appl_5 `pseq` (appl_6 `pseq` kl_shen_pair appl_5 appl_6) + !appl_8 <- appl_7 `pseq` hd appl_7 + !appl_9 <- kl_Parse_X `pseq` kl_shen_byte_RBdigit kl_Parse_X + appl_8 `pseq` (appl_9 `pseq` kl_shen_pair appl_8 appl_9) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_10 <- kl_V2340 `pseq` hd kl_V2340 + !appl_11 <- appl_10 `pseq` hd appl_10 + appl_11 `pseq` applyWrapper appl_2 [appl_11] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_byte_RBdigit :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_byte_RBdigit (!kl_V2342) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + pat_cond_1 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + pat_cond_2 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) + pat_cond_3 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) + pat_cond_4 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 4))) + pat_cond_5 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 5))) + pat_cond_6 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 6))) + pat_cond_7 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 7))) + pat_cond_8 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 8))) + pat_cond_9 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 9))) + pat_cond_10 = do do let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_11 [ApplC (wrapNamed "shen.byte->digit" kl_shen_byte_RBdigit)] + in case kl_V2342 of + kl_V2342@(Atom (N (KI 48))) -> pat_cond_0 + kl_V2342@(Atom (N (KI 49))) -> pat_cond_1 + kl_V2342@(Atom (N (KI 50))) -> pat_cond_2 + kl_V2342@(Atom (N (KI 51))) -> pat_cond_3 + kl_V2342@(Atom (N (KI 52))) -> pat_cond_4 + kl_V2342@(Atom (N (KI 53))) -> pat_cond_5 + kl_V2342@(Atom (N (KI 54))) -> pat_cond_6 + kl_V2342@(Atom (N (KI 55))) -> pat_cond_7 + kl_V2342@(Atom (N (KI 56))) -> pat_cond_8 + kl_V2342@(Atom (N (KI 57))) -> pat_cond_9 + _ -> pat_cond_10 + +kl_shen_pre :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_pre (!kl_V2347) (!kl_V2348) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2347 `pseq` eq appl_0 kl_V2347) + case kl_if_1 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + Atom (B (False)) -> do let pat_cond_2 kl_V2347 kl_V2347h kl_V2347t = do !appl_3 <- kl_V2348 `pseq` kl_shen_expt (Core.Types.Atom (Core.Types.N (Core.Types.KI 10))) kl_V2348 + !appl_4 <- appl_3 `pseq` (kl_V2347h `pseq` multiply appl_3 kl_V2347h) + !appl_5 <- kl_V2348 `pseq` add kl_V2348 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_6 <- kl_V2347t `pseq` (appl_5 `pseq` kl_shen_pre kl_V2347t appl_5) + appl_4 `pseq` (appl_6 `pseq` add appl_4 appl_6) + pat_cond_7 = do do let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_8 [ApplC (wrapNamed "shen.pre" kl_shen_pre)] + in case kl_V2347 of + !(kl_V2347@(Cons (!kl_V2347h) + (!kl_V2347t))) -> pat_cond_2 kl_V2347 kl_V2347h kl_V2347t + _ -> pat_cond_7 + _ -> throwError "if: expected boolean" + +kl_shen_post :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_post (!kl_V2353) (!kl_V2354) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2353 `pseq` eq appl_0 kl_V2353) + case kl_if_1 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + Atom (B (False)) -> do let pat_cond_2 kl_V2353 kl_V2353h kl_V2353t = do !appl_3 <- kl_V2354 `pseq` Primitives.subtract (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) kl_V2354 + !appl_4 <- appl_3 `pseq` kl_shen_expt (Core.Types.Atom (Core.Types.N (Core.Types.KI 10))) appl_3 + !appl_5 <- appl_4 `pseq` (kl_V2353h `pseq` multiply appl_4 kl_V2353h) + !appl_6 <- kl_V2354 `pseq` add kl_V2354 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_7 <- kl_V2353t `pseq` (appl_6 `pseq` kl_shen_post kl_V2353t appl_6) + appl_5 `pseq` (appl_7 `pseq` add appl_5 appl_7) + pat_cond_8 = do do let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_9 [ApplC (wrapNamed "shen.post" kl_shen_post)] + in case kl_V2353 of + !(kl_V2353@(Cons (!kl_V2353h) + (!kl_V2353t))) -> pat_cond_2 kl_V2353 kl_V2353h kl_V2353t + _ -> pat_cond_8 + _ -> throwError "if: expected boolean" + +kl_shen_expt :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_expt (!kl_V2359) (!kl_V2360) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + pat_cond_1 = do !kl_if_2 <- kl_V2360 `pseq` greaterThan kl_V2360 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + case kl_if_2 of + Atom (B (True)) -> do !appl_3 <- kl_V2360 `pseq` Primitives.subtract kl_V2360 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_4 <- kl_V2359 `pseq` (appl_3 `pseq` kl_shen_expt kl_V2359 appl_3) + kl_V2359 `pseq` (appl_4 `pseq` multiply kl_V2359 appl_4) + Atom (B (False)) -> do do !appl_5 <- kl_V2360 `pseq` add kl_V2360 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_6 <- kl_V2359 `pseq` (appl_5 `pseq` kl_shen_expt kl_V2359 appl_5) + !appl_7 <- appl_6 `pseq` (kl_V2359 `pseq` divide appl_6 kl_V2359) + appl_7 `pseq` multiply (Core.Types.Atom (Core.Types.N (Core.Types.KD 1.0))) appl_7 + _ -> throwError "if: expected boolean" + in case kl_V2360 of + kl_V2360@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_LBst_input1RB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBst_input1RB (!kl_V2362) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_1 <- kl_fail + !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_1 kl_Parse_shen_LBst_inputRB) + !kl_if_3 <- appl_2 `pseq` kl_not appl_2 + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_5 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + appl_4 `pseq` (appl_5 `pseq` kl_shen_pair appl_4 appl_5) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_6 <- kl_V2362 `pseq` kl_shen_LBst_inputRB kl_V2362 + appl_6 `pseq` applyWrapper appl_0 [appl_6] + +kl_shen_LBst_input2RB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBst_input2RB (!kl_V2364) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBst_inputRB) -> do !appl_1 <- kl_fail + !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBst_inputRB `pseq` eq appl_1 kl_Parse_shen_LBst_inputRB) + !kl_if_3 <- appl_2 `pseq` kl_not appl_2 + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_Parse_shen_LBst_inputRB `pseq` hd kl_Parse_shen_LBst_inputRB + !appl_5 <- kl_Parse_shen_LBst_inputRB `pseq` kl_shen_hdtl kl_Parse_shen_LBst_inputRB + appl_4 `pseq` (appl_5 `pseq` kl_shen_pair appl_4 appl_5) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_6 <- kl_V2364 `pseq` kl_shen_LBst_inputRB kl_V2364 + appl_6 `pseq` applyWrapper appl_0 [appl_6] + +kl_shen_LBcommentRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBcommentRB (!kl_V2366) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBmultilineRB) -> do !appl_4 <- kl_fail + !appl_5 <- appl_4 `pseq` (kl_Parse_shen_LBmultilineRB `pseq` eq appl_4 kl_Parse_shen_LBmultilineRB) + !kl_if_6 <- appl_5 `pseq` kl_not appl_5 + case kl_if_6 of + Atom (B (True)) -> do !appl_7 <- kl_Parse_shen_LBmultilineRB `pseq` hd kl_Parse_shen_LBmultilineRB + appl_7 `pseq` kl_shen_pair appl_7 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_8 <- kl_V2366 `pseq` kl_shen_LBmultilineRB kl_V2366 + appl_8 `pseq` applyWrapper appl_3 [appl_8] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsinglelineRB) -> do !appl_10 <- kl_fail + !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBsinglelineRB `pseq` eq appl_10 kl_Parse_shen_LBsinglelineRB) + !kl_if_12 <- appl_11 `pseq` kl_not appl_11 + case kl_if_12 of + Atom (B (True)) -> do !appl_13 <- kl_Parse_shen_LBsinglelineRB `pseq` hd kl_Parse_shen_LBsinglelineRB + appl_13 `pseq` kl_shen_pair appl_13 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_14 <- kl_V2366 `pseq` kl_shen_LBsinglelineRB kl_V2366 + !appl_15 <- appl_14 `pseq` applyWrapper appl_9 [appl_14] + appl_15 `pseq` applyWrapper appl_0 [appl_15] + +kl_shen_LBsinglelineRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBsinglelineRB (!kl_V2368) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBbackslashRB) -> do !appl_1 <- kl_fail + !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBbackslashRB `pseq` eq appl_1 kl_Parse_shen_LBbackslashRB) + !kl_if_3 <- appl_2 `pseq` kl_not appl_2 + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBbackslashRB) -> do !appl_5 <- kl_fail + !appl_6 <- appl_5 `pseq` (kl_Parse_shen_LBbackslashRB `pseq` eq appl_5 kl_Parse_shen_LBbackslashRB) + !kl_if_7 <- appl_6 `pseq` kl_not appl_6 + case kl_if_7 of + Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBanysingleRB) -> do !appl_9 <- kl_fail + !appl_10 <- appl_9 `pseq` (kl_Parse_shen_LBanysingleRB `pseq` eq appl_9 kl_Parse_shen_LBanysingleRB) + !kl_if_11 <- appl_10 `pseq` kl_not appl_10 + case kl_if_11 of + Atom (B (True)) -> do let !appl_12 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBreturnRB) -> do !appl_13 <- kl_fail + !appl_14 <- appl_13 `pseq` (kl_Parse_shen_LBreturnRB `pseq` eq appl_13 kl_Parse_shen_LBreturnRB) + !kl_if_15 <- appl_14 `pseq` kl_not appl_14 + case kl_if_15 of + Atom (B (True)) -> do !appl_16 <- kl_Parse_shen_LBreturnRB `pseq` hd kl_Parse_shen_LBreturnRB + appl_16 `pseq` kl_shen_pair appl_16 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_17 <- kl_Parse_shen_LBanysingleRB `pseq` kl_shen_LBreturnRB kl_Parse_shen_LBanysingleRB + appl_17 `pseq` applyWrapper appl_12 [appl_17] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_18 <- kl_Parse_shen_LBbackslashRB `pseq` kl_shen_LBanysingleRB kl_Parse_shen_LBbackslashRB + appl_18 `pseq` applyWrapper appl_8 [appl_18] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_19 <- kl_Parse_shen_LBbackslashRB `pseq` kl_shen_LBbackslashRB kl_Parse_shen_LBbackslashRB + appl_19 `pseq` applyWrapper appl_4 [appl_19] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_20 <- kl_V2368 `pseq` kl_shen_LBbackslashRB kl_V2368 + appl_20 `pseq` applyWrapper appl_0 [appl_20] + +kl_shen_LBbackslashRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBbackslashRB (!kl_V2370) = do !appl_0 <- kl_V2370 `pseq` hd kl_V2370 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2370 `pseq` hd kl_V2370 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 92))) 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 !appl_6 <- kl_V2370 `pseq` hd kl_V2370 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2370 `pseq` kl_shen_hdtl kl_V2370 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBanysingleRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBanysingleRB (!kl_V2372) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do !appl_4 <- kl_fail + !appl_5 <- appl_4 `pseq` (kl_Parse_LBeRB `pseq` eq appl_4 kl_Parse_LBeRB) + !kl_if_6 <- appl_5 `pseq` kl_not appl_5 + case kl_if_6 of + Atom (B (True)) -> do !appl_7 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB + appl_7 `pseq` kl_shen_pair appl_7 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_8 <- kl_V2372 `pseq` kl_LBeRB kl_V2372 + appl_8 `pseq` applyWrapper appl_3 [appl_8] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBnon_returnRB) -> do !appl_10 <- kl_fail + !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBnon_returnRB `pseq` eq appl_10 kl_Parse_shen_LBnon_returnRB) + !kl_if_12 <- appl_11 `pseq` kl_not appl_11 + case kl_if_12 of + Atom (B (True)) -> do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBanysingleRB) -> do !appl_14 <- kl_fail + !appl_15 <- appl_14 `pseq` (kl_Parse_shen_LBanysingleRB `pseq` eq appl_14 kl_Parse_shen_LBanysingleRB) + !kl_if_16 <- appl_15 `pseq` kl_not appl_15 + case kl_if_16 of + Atom (B (True)) -> do !appl_17 <- kl_Parse_shen_LBanysingleRB `pseq` hd kl_Parse_shen_LBanysingleRB + appl_17 `pseq` kl_shen_pair appl_17 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_18 <- kl_Parse_shen_LBnon_returnRB `pseq` kl_shen_LBanysingleRB kl_Parse_shen_LBnon_returnRB + appl_18 `pseq` applyWrapper appl_13 [appl_18] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_19 <- kl_V2372 `pseq` kl_shen_LBnon_returnRB kl_V2372 + !appl_20 <- appl_19 `pseq` applyWrapper appl_9 [appl_19] + appl_20 `pseq` applyWrapper appl_0 [appl_20] + +kl_shen_LBnon_returnRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBnon_returnRB (!kl_V2374) = do !appl_0 <- kl_V2374 `pseq` hd kl_V2374 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let !appl_3 = Atom Nil + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 13))) appl_3 + !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 10))) appl_4 + !appl_6 <- kl_Parse_X `pseq` (appl_5 `pseq` kl_elementP kl_Parse_X appl_5) + !kl_if_7 <- appl_6 `pseq` kl_not appl_6 + case kl_if_7 of + Atom (B (True)) -> do !appl_8 <- kl_V2374 `pseq` hd kl_V2374 + !appl_9 <- appl_8 `pseq` tl appl_8 + !appl_10 <- kl_V2374 `pseq` kl_shen_hdtl kl_V2374 + !appl_11 <- appl_9 `pseq` (appl_10 `pseq` kl_shen_pair appl_9 appl_10) + !appl_12 <- appl_11 `pseq` hd appl_11 + appl_12 `pseq` kl_shen_pair appl_12 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_13 <- kl_V2374 `pseq` hd kl_V2374 + !appl_14 <- appl_13 `pseq` hd appl_13 + appl_14 `pseq` applyWrapper appl_2 [appl_14] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBreturnRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBreturnRB (!kl_V2376) = do !appl_0 <- kl_V2376 `pseq` hd kl_V2376 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let !appl_3 = Atom Nil + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 13))) appl_3 + !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 10))) appl_4 + !kl_if_6 <- kl_Parse_X `pseq` (appl_5 `pseq` kl_elementP kl_Parse_X appl_5) + case kl_if_6 of + Atom (B (True)) -> do !appl_7 <- kl_V2376 `pseq` hd kl_V2376 + !appl_8 <- appl_7 `pseq` tl appl_7 + !appl_9 <- kl_V2376 `pseq` kl_shen_hdtl kl_V2376 + !appl_10 <- appl_8 `pseq` (appl_9 `pseq` kl_shen_pair appl_8 appl_9) + !appl_11 <- appl_10 `pseq` hd appl_10 + appl_11 `pseq` kl_shen_pair appl_11 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_12 <- kl_V2376 `pseq` hd kl_V2376 + !appl_13 <- appl_12 `pseq` hd appl_12 + appl_13 `pseq` applyWrapper appl_2 [appl_13] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBmultilineRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBmultilineRB (!kl_V2378) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBbackslashRB) -> do !appl_1 <- kl_fail + !appl_2 <- appl_1 `pseq` (kl_Parse_shen_LBbackslashRB `pseq` eq appl_1 kl_Parse_shen_LBbackslashRB) + !kl_if_3 <- appl_2 `pseq` kl_not appl_2 + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBtimesRB) -> do !appl_5 <- kl_fail + !appl_6 <- appl_5 `pseq` (kl_Parse_shen_LBtimesRB `pseq` eq appl_5 kl_Parse_shen_LBtimesRB) + !kl_if_7 <- appl_6 `pseq` kl_not appl_6 + case kl_if_7 of + Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBanymultiRB) -> do !appl_9 <- kl_fail + !appl_10 <- appl_9 `pseq` (kl_Parse_shen_LBanymultiRB `pseq` eq appl_9 kl_Parse_shen_LBanymultiRB) + !kl_if_11 <- appl_10 `pseq` kl_not appl_10 + case kl_if_11 of + Atom (B (True)) -> do !appl_12 <- kl_Parse_shen_LBanymultiRB `pseq` hd kl_Parse_shen_LBanymultiRB + appl_12 `pseq` kl_shen_pair appl_12 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_13 <- kl_Parse_shen_LBtimesRB `pseq` kl_shen_LBanymultiRB kl_Parse_shen_LBtimesRB + appl_13 `pseq` applyWrapper appl_8 [appl_13] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_14 <- kl_Parse_shen_LBbackslashRB `pseq` kl_shen_LBtimesRB kl_Parse_shen_LBbackslashRB + appl_14 `pseq` applyWrapper appl_4 [appl_14] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_15 <- kl_V2378 `pseq` kl_shen_LBbackslashRB kl_V2378 + appl_15 `pseq` applyWrapper appl_0 [appl_15] + +kl_shen_LBtimesRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBtimesRB (!kl_V2380) = do !appl_0 <- kl_V2380 `pseq` hd kl_V2380 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !appl_3 <- kl_V2380 `pseq` hd kl_V2380 + !appl_4 <- appl_3 `pseq` hd appl_3 + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.N (Core.Types.KI 42))) 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 !appl_6 <- kl_V2380 `pseq` hd kl_V2380 + !appl_7 <- appl_6 `pseq` tl appl_6 + !appl_8 <- kl_V2380 `pseq` kl_shen_hdtl kl_V2380 + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` kl_shen_pair appl_7 appl_8) + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_10 `pseq` kl_shen_pair appl_10 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_LBanymultiRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBanymultiRB (!kl_V2382) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_4 <- kl_fail + !kl_if_5 <- kl_YaccParse `pseq` (appl_4 `pseq` eq kl_YaccParse appl_4) + case kl_if_5 of + Atom (B (True)) -> do !appl_6 <- kl_V2382 `pseq` hd kl_V2382 + !kl_if_7 <- appl_6 `pseq` consP appl_6 + case kl_if_7 of + Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBanymultiRB) -> do !appl_10 <- kl_fail + !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBanymultiRB `pseq` eq appl_10 kl_Parse_shen_LBanymultiRB) + !kl_if_12 <- appl_11 `pseq` kl_not appl_11 + case kl_if_12 of + Atom (B (True)) -> do !appl_13 <- kl_Parse_shen_LBanymultiRB `pseq` hd kl_Parse_shen_LBanymultiRB + appl_13 `pseq` kl_shen_pair appl_13 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_14 <- kl_V2382 `pseq` hd kl_V2382 + !appl_15 <- appl_14 `pseq` tl appl_14 + !appl_16 <- kl_V2382 `pseq` kl_shen_hdtl kl_V2382 + !appl_17 <- appl_15 `pseq` (appl_16 `pseq` kl_shen_pair appl_15 appl_16) + !appl_18 <- appl_17 `pseq` kl_shen_LBanymultiRB appl_17 + appl_18 `pseq` applyWrapper appl_9 [appl_18]))) + !appl_19 <- kl_V2382 `pseq` hd kl_V2382 + !appl_20 <- appl_19 `pseq` hd appl_19 + appl_20 `pseq` applyWrapper appl_8 [appl_20] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_21 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBtimesRB) -> do !appl_22 <- kl_fail + !appl_23 <- appl_22 `pseq` (kl_Parse_shen_LBtimesRB `pseq` eq appl_22 kl_Parse_shen_LBtimesRB) + !kl_if_24 <- appl_23 `pseq` kl_not appl_23 + case kl_if_24 of + Atom (B (True)) -> do let !appl_25 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBbackslashRB) -> do !appl_26 <- kl_fail + !appl_27 <- appl_26 `pseq` (kl_Parse_shen_LBbackslashRB `pseq` eq appl_26 kl_Parse_shen_LBbackslashRB) + !kl_if_28 <- appl_27 `pseq` kl_not appl_27 + case kl_if_28 of + Atom (B (True)) -> do !appl_29 <- kl_Parse_shen_LBbackslashRB `pseq` hd kl_Parse_shen_LBbackslashRB + appl_29 `pseq` kl_shen_pair appl_29 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_30 <- kl_Parse_shen_LBtimesRB `pseq` kl_shen_LBbackslashRB kl_Parse_shen_LBtimesRB + appl_30 `pseq` applyWrapper appl_25 [appl_30] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_31 <- kl_V2382 `pseq` kl_shen_LBtimesRB kl_V2382 + !appl_32 <- appl_31 `pseq` applyWrapper appl_21 [appl_31] + appl_32 `pseq` applyWrapper appl_3 [appl_32] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_33 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcommentRB) -> do !appl_34 <- kl_fail + !appl_35 <- appl_34 `pseq` (kl_Parse_shen_LBcommentRB `pseq` eq appl_34 kl_Parse_shen_LBcommentRB) + !kl_if_36 <- appl_35 `pseq` kl_not appl_35 + case kl_if_36 of + Atom (B (True)) -> do let !appl_37 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBanymultiRB) -> do !appl_38 <- kl_fail + !appl_39 <- appl_38 `pseq` (kl_Parse_shen_LBanymultiRB `pseq` eq appl_38 kl_Parse_shen_LBanymultiRB) + !kl_if_40 <- appl_39 `pseq` kl_not appl_39 + case kl_if_40 of + Atom (B (True)) -> do !appl_41 <- kl_Parse_shen_LBanymultiRB `pseq` hd kl_Parse_shen_LBanymultiRB + appl_41 `pseq` kl_shen_pair appl_41 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_42 <- kl_Parse_shen_LBcommentRB `pseq` kl_shen_LBanymultiRB kl_Parse_shen_LBcommentRB + appl_42 `pseq` applyWrapper appl_37 [appl_42] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_43 <- kl_V2382 `pseq` kl_shen_LBcommentRB kl_V2382 + !appl_44 <- appl_43 `pseq` applyWrapper appl_33 [appl_43] + appl_44 `pseq` applyWrapper appl_0 [appl_44] + +kl_shen_LBwhitespacesRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBwhitespacesRB (!kl_V2384) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do !appl_1 <- kl_fail + !kl_if_2 <- kl_YaccParse `pseq` (appl_1 `pseq` eq kl_YaccParse appl_1) + case kl_if_2 of + Atom (B (True)) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBwhitespaceRB) -> do !appl_4 <- kl_fail + !appl_5 <- appl_4 `pseq` (kl_Parse_shen_LBwhitespaceRB `pseq` eq appl_4 kl_Parse_shen_LBwhitespaceRB) + !kl_if_6 <- appl_5 `pseq` kl_not appl_5 + case kl_if_6 of + Atom (B (True)) -> do !appl_7 <- kl_Parse_shen_LBwhitespaceRB `pseq` hd kl_Parse_shen_LBwhitespaceRB + appl_7 `pseq` kl_shen_pair appl_7 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_8 <- kl_V2384 `pseq` kl_shen_LBwhitespaceRB kl_V2384 + appl_8 `pseq` applyWrapper appl_3 [appl_8] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBwhitespaceRB) -> do !appl_10 <- kl_fail + !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBwhitespaceRB `pseq` eq appl_10 kl_Parse_shen_LBwhitespaceRB) + !kl_if_12 <- appl_11 `pseq` kl_not appl_11 + case kl_if_12 of + Atom (B (True)) -> do let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBwhitespacesRB) -> do !appl_14 <- kl_fail + !appl_15 <- appl_14 `pseq` (kl_Parse_shen_LBwhitespacesRB `pseq` eq appl_14 kl_Parse_shen_LBwhitespacesRB) + !kl_if_16 <- appl_15 `pseq` kl_not appl_15 + case kl_if_16 of + Atom (B (True)) -> do !appl_17 <- kl_Parse_shen_LBwhitespacesRB `pseq` hd kl_Parse_shen_LBwhitespacesRB + appl_17 `pseq` kl_shen_pair appl_17 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_18 <- kl_Parse_shen_LBwhitespaceRB `pseq` kl_shen_LBwhitespacesRB kl_Parse_shen_LBwhitespaceRB + appl_18 `pseq` applyWrapper appl_13 [appl_18] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_19 <- kl_V2384 `pseq` kl_shen_LBwhitespaceRB kl_V2384 + !appl_20 <- appl_19 `pseq` applyWrapper appl_9 [appl_19] + appl_20 `pseq` applyWrapper appl_0 [appl_20] + +kl_shen_LBwhitespaceRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBwhitespaceRB (!kl_V2386) = do !appl_0 <- kl_V2386 `pseq` hd kl_V2386 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Parse_Case) -> do let pat_cond_4 = do return (Atom (B True)) + pat_cond_5 = do do !kl_if_6 <- let pat_cond_7 = do return (Atom (B True)) + pat_cond_8 = do do !kl_if_9 <- let pat_cond_10 = do return (Atom (B True)) + pat_cond_11 = do do let pat_cond_12 = do return (Atom (B True)) + pat_cond_13 = do do return (Atom (B False)) + in case kl_Parse_Case of + kl_Parse_Case@(Atom (N (KI 9))) -> pat_cond_12 + _ -> pat_cond_13 + in case kl_Parse_Case of + kl_Parse_Case@(Atom (N (KI 10))) -> pat_cond_10 + _ -> pat_cond_11 + 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" + in case kl_Parse_Case of + kl_Parse_Case@(Atom (N (KI 13))) -> pat_cond_7 + _ -> pat_cond_8 + 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" + in case kl_Parse_Case of + kl_Parse_Case@(Atom (N (KI 32))) -> pat_cond_4 + _ -> pat_cond_5))) + !kl_if_14 <- kl_Parse_X `pseq` applyWrapper appl_3 [kl_Parse_X] + case kl_if_14 of + Atom (B (True)) -> do !appl_15 <- kl_V2386 `pseq` hd kl_V2386 + !appl_16 <- appl_15 `pseq` tl appl_15 + !appl_17 <- kl_V2386 `pseq` kl_shen_hdtl kl_V2386 + !appl_18 <- appl_16 `pseq` (appl_17 `pseq` kl_shen_pair appl_16 appl_17) + !appl_19 <- appl_18 `pseq` hd appl_18 + appl_19 `pseq` kl_shen_pair appl_19 (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean"))) + !appl_20 <- kl_V2386 `pseq` hd kl_V2386 + !appl_21 <- appl_20 `pseq` hd appl_20 + appl_21 `pseq` applyWrapper appl_2 [appl_21] + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_shen_cons_form :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_cons_form (!kl_V2388) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2388 `pseq` eq appl_0 kl_V2388) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V2388 kl_V2388h kl_V2388t = do !kl_if_4 <- let pat_cond_5 kl_V2388t kl_V2388th kl_V2388tt = do !kl_if_6 <- let pat_cond_7 kl_V2388tt kl_V2388tth kl_V2388ttt = do let !appl_8 = Atom Nil + !kl_if_9 <- appl_8 `pseq` (kl_V2388ttt `pseq` eq appl_8 kl_V2388ttt) + !kl_if_10 <- case kl_if_9 of + Atom (B (True)) -> do let pat_cond_11 = do return (Atom (B True)) + pat_cond_12 = do do return (Atom (B False)) + in case kl_V2388th of + kl_V2388th@(Atom (UnboundSym "bar!")) -> pat_cond_11 + kl_V2388th@(ApplC (PL "bar!" + _)) -> pat_cond_11 + kl_V2388th@(ApplC (Func "bar!" + _)) -> pat_cond_11 + _ -> pat_cond_12 + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_13 = do do return (Atom (B False)) + in case kl_V2388tt of + !(kl_V2388tt@(Cons (!kl_V2388tth) + (!kl_V2388ttt))) -> pat_cond_7 kl_V2388tt kl_V2388tth kl_V2388ttt + _ -> 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_V2388t of + !(kl_V2388t@(Cons (!kl_V2388th) + (!kl_V2388tt))) -> pat_cond_5 kl_V2388t kl_V2388th kl_V2388tt + _ -> 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_V2388 of + !(kl_V2388@(Cons (!kl_V2388h) + (!kl_V2388t))) -> pat_cond_3 kl_V2388 kl_V2388h kl_V2388t + _ -> pat_cond_15 + case kl_if_2 of + Atom (B (True)) -> do !appl_16 <- kl_V2388 `pseq` hd kl_V2388 + !appl_17 <- kl_V2388 `pseq` tl kl_V2388 + !appl_18 <- appl_17 `pseq` tl appl_17 + !appl_19 <- appl_16 `pseq` (appl_18 `pseq` klCons appl_16 appl_18) + appl_19 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_19 + Atom (B (False)) -> do let pat_cond_20 kl_V2388 kl_V2388h kl_V2388t = do !appl_21 <- kl_V2388t `pseq` kl_shen_cons_form kl_V2388t + let !appl_22 = Atom Nil + !appl_23 <- appl_21 `pseq` (appl_22 `pseq` klCons appl_21 appl_22) + !appl_24 <- kl_V2388h `pseq` (appl_23 `pseq` klCons kl_V2388h appl_23) + appl_24 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_24 + pat_cond_25 = do do let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_26 [ApplC (wrapNamed "shen.cons_form" kl_shen_cons_form)] + in case kl_V2388 of + !(kl_V2388@(Cons (!kl_V2388h) + (!kl_V2388t))) -> pat_cond_20 kl_V2388 kl_V2388h kl_V2388t + _ -> pat_cond_25 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_package_macro :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_package_macro (!kl_V2393) (!kl_V2394) = do !kl_if_0 <- let pat_cond_1 kl_V2393 kl_V2393h kl_V2393t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V2393t kl_V2393th kl_V2393tt = do let !appl_6 = Atom Nil + !kl_if_7 <- appl_6 `pseq` (kl_V2393tt `pseq` eq appl_6 kl_V2393tt) + 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_8 = do do return (Atom (B False)) + in case kl_V2393t of + !(kl_V2393t@(Cons (!kl_V2393th) + (!kl_V2393tt))) -> pat_cond_5 kl_V2393t kl_V2393th kl_V2393tt + _ -> pat_cond_8 + 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_9 = do do return (Atom (B False)) + in case kl_V2393h of + kl_V2393h@(Atom (UnboundSym "$")) -> pat_cond_3 + kl_V2393h@(ApplC (PL "$" + _)) -> pat_cond_3 + kl_V2393h@(ApplC (Func "$" + _)) -> pat_cond_3 + _ -> pat_cond_9 + 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_10 = do do return (Atom (B False)) + in case kl_V2393 of + !(kl_V2393@(Cons (!kl_V2393h) + (!kl_V2393t))) -> pat_cond_1 kl_V2393 kl_V2393h kl_V2393t + _ -> pat_cond_10 + case kl_if_0 of + Atom (B (True)) -> do !appl_11 <- kl_V2393 `pseq` tl kl_V2393 + !appl_12 <- appl_11 `pseq` hd appl_11 + !appl_13 <- appl_12 `pseq` kl_explode appl_12 + appl_13 `pseq` (kl_V2394 `pseq` kl_append appl_13 kl_V2394) + Atom (B (False)) -> do let pat_cond_14 kl_V2393 kl_V2393t kl_V2393tt kl_V2393tth kl_V2393ttt = do kl_V2393ttt `pseq` (kl_V2394 `pseq` kl_append kl_V2393ttt kl_V2394) + pat_cond_15 kl_V2393 kl_V2393t kl_V2393th kl_V2393tt kl_V2393tth kl_V2393ttt = do let !appl_16 = ApplC (Func "lambda" (Context (\(!kl_ListofExceptions) -> do let !appl_17 = ApplC (Func "lambda" (Context (\(!kl_External) -> do let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_PackageNameDot) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_ExpPackageNameDot) -> do let !appl_20 = ApplC (Func "lambda" (Context (\(!kl_Packaged) -> do let !appl_21 = ApplC (Func "lambda" (Context (\(!kl_Internal) -> do kl_Packaged `pseq` (kl_V2394 `pseq` kl_append kl_Packaged kl_V2394)))) + !appl_22 <- kl_ExpPackageNameDot `pseq` (kl_Packaged `pseq` kl_shen_internal_symbols kl_ExpPackageNameDot kl_Packaged) + !appl_23 <- kl_V2393th `pseq` (appl_22 `pseq` kl_shen_record_internal kl_V2393th appl_22) + appl_23 `pseq` applyWrapper appl_21 [appl_23]))) + !appl_24 <- kl_PackageNameDot `pseq` (kl_ListofExceptions `pseq` (kl_V2393ttt `pseq` (kl_ExpPackageNameDot `pseq` kl_shen_packageh kl_PackageNameDot kl_ListofExceptions kl_V2393ttt kl_ExpPackageNameDot))) + appl_24 `pseq` applyWrapper appl_20 [appl_24]))) + !appl_25 <- kl_PackageNameDot `pseq` kl_explode kl_PackageNameDot + appl_25 `pseq` applyWrapper appl_19 [appl_25]))) + !appl_26 <- kl_V2393th `pseq` str kl_V2393th + !appl_27 <- appl_26 `pseq` cn appl_26 (Core.Types.Atom (Core.Types.Str ".")) + !appl_28 <- appl_27 `pseq` intern appl_27 + appl_28 `pseq` applyWrapper appl_18 [appl_28]))) + !appl_29 <- kl_ListofExceptions `pseq` (kl_V2393th `pseq` kl_shen_record_exceptions kl_ListofExceptions kl_V2393th) + appl_29 `pseq` applyWrapper appl_17 [appl_29]))) + !appl_30 <- kl_V2393tth `pseq` kl_shen_eval_without_macros kl_V2393tth + appl_30 `pseq` applyWrapper appl_16 [appl_30] + pat_cond_31 = do do kl_V2393 `pseq` (kl_V2394 `pseq` klCons kl_V2393 kl_V2394) + in case kl_V2393 of + !(kl_V2393@(Cons (Atom (UnboundSym "package")) + (!(kl_V2393t@(Cons (Atom (UnboundSym "null")) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_14 kl_V2393 kl_V2393t kl_V2393tt kl_V2393tth kl_V2393ttt + !(kl_V2393@(Cons (Atom (UnboundSym "package")) + (!(kl_V2393t@(Cons (ApplC (PL "null" + _)) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_14 kl_V2393 kl_V2393t kl_V2393tt kl_V2393tth kl_V2393ttt + !(kl_V2393@(Cons (Atom (UnboundSym "package")) + (!(kl_V2393t@(Cons (ApplC (Func "null" + _)) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_14 kl_V2393 kl_V2393t kl_V2393tt kl_V2393tth kl_V2393ttt + !(kl_V2393@(Cons (ApplC (PL "package" + _)) + (!(kl_V2393t@(Cons (Atom (UnboundSym "null")) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_14 kl_V2393 kl_V2393t kl_V2393tt kl_V2393tth kl_V2393ttt + !(kl_V2393@(Cons (ApplC (PL "package" + _)) + (!(kl_V2393t@(Cons (ApplC (PL "null" + _)) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_14 kl_V2393 kl_V2393t kl_V2393tt kl_V2393tth kl_V2393ttt + !(kl_V2393@(Cons (ApplC (PL "package" + _)) + (!(kl_V2393t@(Cons (ApplC (Func "null" + _)) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_14 kl_V2393 kl_V2393t kl_V2393tt kl_V2393tth kl_V2393ttt + !(kl_V2393@(Cons (ApplC (Func "package" + _)) + (!(kl_V2393t@(Cons (Atom (UnboundSym "null")) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_14 kl_V2393 kl_V2393t kl_V2393tt kl_V2393tth kl_V2393ttt + !(kl_V2393@(Cons (ApplC (Func "package" + _)) + (!(kl_V2393t@(Cons (ApplC (PL "null" + _)) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_14 kl_V2393 kl_V2393t kl_V2393tt kl_V2393tth kl_V2393ttt + !(kl_V2393@(Cons (ApplC (Func "package" + _)) + (!(kl_V2393t@(Cons (ApplC (Func "null" + _)) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_14 kl_V2393 kl_V2393t kl_V2393tt kl_V2393tth kl_V2393ttt + !(kl_V2393@(Cons (Atom (UnboundSym "package")) + (!(kl_V2393t@(Cons (!kl_V2393th) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_15 kl_V2393 kl_V2393t kl_V2393th kl_V2393tt kl_V2393tth kl_V2393ttt + !(kl_V2393@(Cons (ApplC (PL "package" + _)) + (!(kl_V2393t@(Cons (!kl_V2393th) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_15 kl_V2393 kl_V2393t kl_V2393th kl_V2393tt kl_V2393tth kl_V2393ttt + !(kl_V2393@(Cons (ApplC (Func "package" + _)) + (!(kl_V2393t@(Cons (!kl_V2393th) + (!(kl_V2393tt@(Cons (!kl_V2393tth) + (!kl_V2393ttt))))))))) -> pat_cond_15 kl_V2393 kl_V2393t kl_V2393th kl_V2393tt kl_V2393tth kl_V2393ttt + _ -> pat_cond_31 + _ -> throwError "if: expected boolean" + +kl_shen_record_exceptions :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_record_exceptions (!kl_V2397) (!kl_V2398) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_CurrExceptions) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_AllExceptions) -> do !appl_2 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + kl_V2398 `pseq` (kl_AllExceptions `pseq` (appl_2 `pseq` kl_put kl_V2398 (Core.Types.Atom (Core.Types.UnboundSym "shen.external-symbols")) kl_AllExceptions appl_2))))) + !appl_3 <- kl_V2397 `pseq` (kl_CurrExceptions `pseq` kl_union kl_V2397 kl_CurrExceptions) + appl_3 `pseq` applyWrapper appl_1 [appl_3]))) + let !appl_4 = ApplC (PL "thunk" (do return (Atom Nil))) + !appl_5 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + !appl_6 <- kl_V2398 `pseq` (appl_4 `pseq` (appl_5 `pseq` kl_getDivor kl_V2398 (Core.Types.Atom (Core.Types.UnboundSym "shen.external-symbols")) appl_4 appl_5)) + appl_6 `pseq` applyWrapper appl_0 [appl_6] + +kl_shen_record_internal :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_record_internal (!kl_V2401) (!kl_V2402) = do let !appl_0 = ApplC (PL "thunk" (do return (Atom Nil))) + !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + !appl_2 <- kl_V2401 `pseq` (appl_0 `pseq` (appl_1 `pseq` kl_getDivor kl_V2401 (ApplC (wrapNamed "shen.internal-symbols" kl_shen_internal_symbols)) appl_0 appl_1)) + !appl_3 <- kl_V2402 `pseq` (appl_2 `pseq` kl_union kl_V2402 appl_2) + !appl_4 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + kl_V2401 `pseq` (appl_3 `pseq` (appl_4 `pseq` kl_put kl_V2401 (ApplC (wrapNamed "shen.internal-symbols" kl_shen_internal_symbols)) appl_3 appl_4)) + +kl_shen_internal_symbols :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_internal_symbols (!kl_V2413) (!kl_V2414) = do !kl_if_0 <- kl_V2414 `pseq` kl_symbolP kl_V2414 + !kl_if_1 <- case kl_if_0 of + Atom (B (True)) -> do !appl_2 <- kl_V2414 `pseq` kl_explode kl_V2414 + !kl_if_3 <- kl_V2413 `pseq` (appl_2 `pseq` kl_shen_prefixP kl_V2413 appl_2) + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_1 of + Atom (B (True)) -> do let !appl_4 = Atom Nil + kl_V2414 `pseq` (appl_4 `pseq` klCons kl_V2414 appl_4) + Atom (B (False)) -> do let pat_cond_5 kl_V2414 kl_V2414h kl_V2414t = do !appl_6 <- kl_V2413 `pseq` (kl_V2414h `pseq` kl_shen_internal_symbols kl_V2413 kl_V2414h) + !appl_7 <- kl_V2413 `pseq` (kl_V2414t `pseq` kl_shen_internal_symbols kl_V2413 kl_V2414t) + appl_6 `pseq` (appl_7 `pseq` kl_union appl_6 appl_7) + pat_cond_8 = do do return (Atom Nil) + in case kl_V2414 of + !(kl_V2414@(Cons (!kl_V2414h) + (!kl_V2414t))) -> pat_cond_5 kl_V2414 kl_V2414h kl_V2414t + _ -> pat_cond_8 + _ -> throwError "if: expected boolean" + +kl_shen_packageh :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_packageh (!kl_V2431) (!kl_V2432) (!kl_V2433) (!kl_V2434) = do let pat_cond_0 kl_V2433 kl_V2433h kl_V2433t = do !appl_1 <- kl_V2431 `pseq` (kl_V2432 `pseq` (kl_V2433h `pseq` (kl_V2434 `pseq` kl_shen_packageh kl_V2431 kl_V2432 kl_V2433h kl_V2434))) + !appl_2 <- kl_V2431 `pseq` (kl_V2432 `pseq` (kl_V2433t `pseq` (kl_V2434 `pseq` kl_shen_packageh kl_V2431 kl_V2432 kl_V2433t kl_V2434))) + appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) + pat_cond_3 = do !kl_if_4 <- kl_V2433 `pseq` kl_shen_sysfuncP kl_V2433 + !kl_if_5 <- case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_6 <- kl_V2433 `pseq` kl_variableP kl_V2433 + !kl_if_7 <- case kl_if_6 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_8 <- kl_V2433 `pseq` (kl_V2432 `pseq` kl_elementP kl_V2433 kl_V2432) + !kl_if_9 <- case kl_if_8 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_10 <- kl_V2433 `pseq` kl_shen_doubleunderlineP kl_V2433 + !kl_if_11 <- case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_12 <- kl_V2433 `pseq` kl_shen_singleunderlineP kl_V2433 + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + 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" + _ -> throwError "if: expected boolean" + case kl_if_5 of + Atom (B (True)) -> do return kl_V2433 + Atom (B (False)) -> do !kl_if_13 <- kl_V2433 `pseq` kl_symbolP kl_V2433 + !kl_if_14 <- case kl_if_13 of + Atom (B (True)) -> do let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_ExplodeX) -> do let !appl_16 = Atom Nil + !appl_17 <- appl_16 `pseq` klCons (Core.Types.Atom (Core.Types.Str ".")) appl_16 + !appl_18 <- appl_17 `pseq` klCons (Core.Types.Atom (Core.Types.Str "n")) appl_17 + !appl_19 <- appl_18 `pseq` klCons (Core.Types.Atom (Core.Types.Str "e")) appl_18 + !appl_20 <- appl_19 `pseq` klCons (Core.Types.Atom (Core.Types.Str "h")) appl_19 + !appl_21 <- appl_20 `pseq` klCons (Core.Types.Atom (Core.Types.Str "s")) appl_20 + !appl_22 <- appl_21 `pseq` (kl_ExplodeX `pseq` kl_shen_prefixP appl_21 kl_ExplodeX) + !kl_if_23 <- appl_22 `pseq` kl_not appl_22 + case kl_if_23 of + Atom (B (True)) -> do !appl_24 <- kl_V2434 `pseq` (kl_ExplodeX `pseq` kl_shen_prefixP kl_V2434 kl_ExplodeX) + !kl_if_25 <- appl_24 `pseq` kl_not appl_24 + case kl_if_25 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean"))) + !appl_26 <- kl_V2433 `pseq` kl_explode kl_V2433 + !kl_if_27 <- appl_26 `pseq` applyWrapper appl_15 [appl_26] + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_14 of + Atom (B (True)) -> do kl_V2431 `pseq` (kl_V2433 `pseq` kl_concat kl_V2431 kl_V2433) + Atom (B (False)) -> do do return kl_V2433 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + in case kl_V2433 of + !(kl_V2433@(Cons (!kl_V2433h) + (!kl_V2433t))) -> pat_cond_0 kl_V2433 kl_V2433h kl_V2433t + _ -> pat_cond_3 + +expr5 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr5 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Backend/Sequent.hs b/Shentong/Backend/Sequent.hs --- a/Shentong/Backend/Sequent.hs +++ b/Shentong/Backend/Sequent.hs @@ -1,1872 +1,2205 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} - -module Backend.Sequent 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 -import Backend.Core -import Backend.Sys - -{- -Copyright (c) 2015, Mark Tarver -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. -3. The name of Mark Tarver may not be used to endorse or promote products - derived from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY -EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY -DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES -(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND -ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. --} - -kl_shen_datatype_error :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_datatype_error (!kl_V2428) = do let pat_cond_0 kl_V2428 kl_V2428h kl_V2428t kl_V2428th = do let !aw_1 = Types.Atom (Types.UnboundSym "shen.next-50") - !appl_2 <- kl_V2428h `pseq` applyWrapper aw_1 [Types.Atom (Types.N (Types.KI 50)), - kl_V2428h] - let !aw_3 = Types.Atom (Types.UnboundSym "shen.app") - !appl_4 <- appl_2 `pseq` applyWrapper aw_3 [appl_2, - Types.Atom (Types.Str "\n"), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_5 <- appl_4 `pseq` cn (Types.Atom (Types.Str "datatype syntax error here:\n\n ")) appl_4 - appl_5 `pseq` simpleError appl_5 - pat_cond_6 = do do let !aw_7 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_7 [ApplC (wrapNamed "shen.datatype-error" kl_shen_datatype_error)] - in case kl_V2428 of - !(kl_V2428@(Cons (!kl_V2428h) - (!(kl_V2428t@(Cons (!kl_V2428th) - (Atom (Nil))))))) -> pat_cond_0 kl_V2428 kl_V2428h kl_V2428t kl_V2428th - _ -> pat_cond_6 - -kl_shen_LBdatatype_rulesRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBdatatype_rulesRB (!kl_V2430) = 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) - !kl_if_8 <- appl_7 `pseq` kl_not appl_7 - case kl_if_8 of - Atom (B (True)) -> do !appl_9 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB - let !aw_10 = Types.Atom (Types.UnboundSym "shen.pair") - appl_9 `pseq` applyWrapper aw_10 [appl_9, - Types.Atom Types.Nil] - Atom (B (False)) -> do do let !aw_11 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_11 [] - _ -> throwError "if: expected boolean"))) - let !aw_12 = Types.Atom (Types.UnboundSym "") - !appl_13 <- kl_V2430 `pseq` applyWrapper aw_12 [kl_V2430] - appl_13 `pseq` applyWrapper appl_4 [appl_13] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdatatype_ruleRB) -> do let !aw_15 = Types.Atom (Types.UnboundSym "fail") - !appl_16 <- applyWrapper aw_15 [] - !appl_17 <- appl_16 `pseq` (kl_Parse_shen_LBdatatype_ruleRB `pseq` eq appl_16 kl_Parse_shen_LBdatatype_ruleRB) - !kl_if_18 <- appl_17 `pseq` kl_not appl_17 - case kl_if_18 of - Atom (B (True)) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdatatype_rulesRB) -> do let !aw_20 = Types.Atom (Types.UnboundSym "fail") - !appl_21 <- applyWrapper aw_20 [] - !appl_22 <- appl_21 `pseq` (kl_Parse_shen_LBdatatype_rulesRB `pseq` eq appl_21 kl_Parse_shen_LBdatatype_rulesRB) - !kl_if_23 <- appl_22 `pseq` kl_not appl_22 - case kl_if_23 of - Atom (B (True)) -> do !appl_24 <- kl_Parse_shen_LBdatatype_rulesRB `pseq` hd kl_Parse_shen_LBdatatype_rulesRB - let !aw_25 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_26 <- kl_Parse_shen_LBdatatype_ruleRB `pseq` applyWrapper aw_25 [kl_Parse_shen_LBdatatype_ruleRB] - let !aw_27 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_28 <- kl_Parse_shen_LBdatatype_rulesRB `pseq` applyWrapper aw_27 [kl_Parse_shen_LBdatatype_rulesRB] - !appl_29 <- appl_26 `pseq` (appl_28 `pseq` klCons appl_26 appl_28) - 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"))) - !appl_32 <- kl_Parse_shen_LBdatatype_ruleRB `pseq` kl_shen_LBdatatype_rulesRB kl_Parse_shen_LBdatatype_ruleRB - appl_32 `pseq` applyWrapper appl_19 [appl_32] - Atom (B (False)) -> do do let !aw_33 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_33 [] - _ -> throwError "if: expected boolean"))) - !appl_34 <- kl_V2430 `pseq` kl_shen_LBdatatype_ruleRB kl_V2430 - !appl_35 <- appl_34 `pseq` applyWrapper appl_14 [appl_34] - appl_35 `pseq` applyWrapper appl_0 [appl_35] - -kl_shen_LBdatatype_ruleRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBdatatype_ruleRB (!kl_V2432) = 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_LBside_conditionsRB) -> do let !aw_5 = Types.Atom (Types.UnboundSym "fail") - !appl_6 <- applyWrapper aw_5 [] - !appl_7 <- appl_6 `pseq` (kl_Parse_shen_LBside_conditionsRB `pseq` eq appl_6 kl_Parse_shen_LBside_conditionsRB) - !kl_if_8 <- appl_7 `pseq` kl_not appl_7 - case kl_if_8 of - Atom (B (True)) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremisesRB) -> do let !aw_10 = Types.Atom (Types.UnboundSym "fail") - !appl_11 <- applyWrapper aw_10 [] - !appl_12 <- appl_11 `pseq` (kl_Parse_shen_LBpremisesRB `pseq` eq appl_11 kl_Parse_shen_LBpremisesRB) - !kl_if_13 <- appl_12 `pseq` kl_not appl_12 - case kl_if_13 of - Atom (B (True)) -> do let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdoubleunderlineRB) -> do let !aw_15 = Types.Atom (Types.UnboundSym "fail") - !appl_16 <- applyWrapper aw_15 [] - !appl_17 <- appl_16 `pseq` (kl_Parse_shen_LBdoubleunderlineRB `pseq` eq appl_16 kl_Parse_shen_LBdoubleunderlineRB) - !kl_if_18 <- appl_17 `pseq` kl_not appl_17 - case kl_if_18 of - Atom (B (True)) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBconclusionRB) -> do let !aw_20 = Types.Atom (Types.UnboundSym "fail") - !appl_21 <- applyWrapper aw_20 [] - !appl_22 <- appl_21 `pseq` (kl_Parse_shen_LBconclusionRB `pseq` eq appl_21 kl_Parse_shen_LBconclusionRB) - !kl_if_23 <- appl_22 `pseq` kl_not appl_22 - case kl_if_23 of - Atom (B (True)) -> do !appl_24 <- kl_Parse_shen_LBconclusionRB `pseq` hd kl_Parse_shen_LBconclusionRB - let !aw_25 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_26 <- kl_Parse_shen_LBside_conditionsRB `pseq` applyWrapper aw_25 [kl_Parse_shen_LBside_conditionsRB] - let !aw_27 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_28 <- kl_Parse_shen_LBpremisesRB `pseq` applyWrapper aw_27 [kl_Parse_shen_LBpremisesRB] - let !aw_29 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_30 <- kl_Parse_shen_LBconclusionRB `pseq` applyWrapper aw_29 [kl_Parse_shen_LBconclusionRB] - !appl_31 <- appl_30 `pseq` klCons appl_30 (Types.Atom Types.Nil) - !appl_32 <- appl_28 `pseq` (appl_31 `pseq` klCons appl_28 appl_31) - !appl_33 <- appl_26 `pseq` (appl_32 `pseq` klCons appl_26 appl_32) - !appl_34 <- appl_33 `pseq` kl_shen_sequent (Types.Atom (Types.UnboundSym "shen.double")) appl_33 - let !aw_35 = Types.Atom (Types.UnboundSym "shen.pair") - appl_24 `pseq` (appl_34 `pseq` applyWrapper aw_35 [appl_24, - appl_34]) - Atom (B (False)) -> do do let !aw_36 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_36 [] - _ -> throwError "if: expected boolean"))) - !appl_37 <- kl_Parse_shen_LBdoubleunderlineRB `pseq` kl_shen_LBconclusionRB kl_Parse_shen_LBdoubleunderlineRB - appl_37 `pseq` applyWrapper appl_19 [appl_37] - 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_LBpremisesRB `pseq` kl_shen_LBdoubleunderlineRB kl_Parse_shen_LBpremisesRB - appl_39 `pseq` applyWrapper appl_14 [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_Parse_shen_LBside_conditionsRB `pseq` kl_shen_LBpremisesRB kl_Parse_shen_LBside_conditionsRB - appl_41 `pseq` applyWrapper appl_9 [appl_41] - Atom (B (False)) -> do do let !aw_42 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_42 [] - _ -> throwError "if: expected boolean"))) - !appl_43 <- kl_V2432 `pseq` kl_shen_LBside_conditionsRB kl_V2432 - appl_43 `pseq` applyWrapper appl_4 [appl_43] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_44 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBside_conditionsRB) -> do let !aw_45 = Types.Atom (Types.UnboundSym "fail") - !appl_46 <- applyWrapper aw_45 [] - !appl_47 <- appl_46 `pseq` (kl_Parse_shen_LBside_conditionsRB `pseq` eq appl_46 kl_Parse_shen_LBside_conditionsRB) - !kl_if_48 <- appl_47 `pseq` kl_not appl_47 - case kl_if_48 of - Atom (B (True)) -> do let !appl_49 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremisesRB) -> do let !aw_50 = Types.Atom (Types.UnboundSym "fail") - !appl_51 <- applyWrapper aw_50 [] - !appl_52 <- appl_51 `pseq` (kl_Parse_shen_LBpremisesRB `pseq` eq appl_51 kl_Parse_shen_LBpremisesRB) - !kl_if_53 <- appl_52 `pseq` kl_not appl_52 - case kl_if_53 of - Atom (B (True)) -> do let !appl_54 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsingleunderlineRB) -> do let !aw_55 = Types.Atom (Types.UnboundSym "fail") - !appl_56 <- applyWrapper aw_55 [] - !appl_57 <- appl_56 `pseq` (kl_Parse_shen_LBsingleunderlineRB `pseq` eq appl_56 kl_Parse_shen_LBsingleunderlineRB) - !kl_if_58 <- appl_57 `pseq` kl_not appl_57 - case kl_if_58 of - Atom (B (True)) -> do let !appl_59 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBconclusionRB) -> do let !aw_60 = Types.Atom (Types.UnboundSym "fail") - !appl_61 <- applyWrapper aw_60 [] - !appl_62 <- appl_61 `pseq` (kl_Parse_shen_LBconclusionRB `pseq` eq appl_61 kl_Parse_shen_LBconclusionRB) - !kl_if_63 <- appl_62 `pseq` kl_not appl_62 - case kl_if_63 of - Atom (B (True)) -> do !appl_64 <- kl_Parse_shen_LBconclusionRB `pseq` hd kl_Parse_shen_LBconclusionRB - let !aw_65 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_66 <- kl_Parse_shen_LBside_conditionsRB `pseq` applyWrapper aw_65 [kl_Parse_shen_LBside_conditionsRB] - let !aw_67 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_68 <- kl_Parse_shen_LBpremisesRB `pseq` applyWrapper aw_67 [kl_Parse_shen_LBpremisesRB] - let !aw_69 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_70 <- kl_Parse_shen_LBconclusionRB `pseq` applyWrapper aw_69 [kl_Parse_shen_LBconclusionRB] - !appl_71 <- appl_70 `pseq` klCons appl_70 (Types.Atom Types.Nil) - !appl_72 <- appl_68 `pseq` (appl_71 `pseq` klCons appl_68 appl_71) - !appl_73 <- appl_66 `pseq` (appl_72 `pseq` klCons appl_66 appl_72) - !appl_74 <- appl_73 `pseq` kl_shen_sequent (Types.Atom (Types.UnboundSym "shen.single")) appl_73 - let !aw_75 = Types.Atom (Types.UnboundSym "shen.pair") - appl_64 `pseq` (appl_74 `pseq` applyWrapper aw_75 [appl_64, - appl_74]) - Atom (B (False)) -> do do let !aw_76 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_76 [] - _ -> throwError "if: expected boolean"))) - !appl_77 <- kl_Parse_shen_LBsingleunderlineRB `pseq` kl_shen_LBconclusionRB kl_Parse_shen_LBsingleunderlineRB - appl_77 `pseq` applyWrapper appl_59 [appl_77] - Atom (B (False)) -> do do let !aw_78 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_78 [] - _ -> throwError "if: expected boolean"))) - !appl_79 <- kl_Parse_shen_LBpremisesRB `pseq` kl_shen_LBsingleunderlineRB kl_Parse_shen_LBpremisesRB - appl_79 `pseq` applyWrapper appl_54 [appl_79] - Atom (B (False)) -> do do let !aw_80 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_80 [] - _ -> throwError "if: expected boolean"))) - !appl_81 <- kl_Parse_shen_LBside_conditionsRB `pseq` kl_shen_LBpremisesRB kl_Parse_shen_LBside_conditionsRB - appl_81 `pseq` applyWrapper appl_49 [appl_81] - Atom (B (False)) -> do do let !aw_82 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_82 [] - _ -> throwError "if: expected boolean"))) - !appl_83 <- kl_V2432 `pseq` kl_shen_LBside_conditionsRB kl_V2432 - !appl_84 <- appl_83 `pseq` applyWrapper appl_44 [appl_83] - appl_84 `pseq` applyWrapper appl_0 [appl_84] - -kl_shen_LBside_conditionsRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBside_conditionsRB (!kl_V2434) = 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) - !kl_if_8 <- appl_7 `pseq` kl_not appl_7 - case kl_if_8 of - Atom (B (True)) -> do !appl_9 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB - let !aw_10 = Types.Atom (Types.UnboundSym "shen.pair") - appl_9 `pseq` applyWrapper aw_10 [appl_9, - Types.Atom Types.Nil] - Atom (B (False)) -> do do let !aw_11 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_11 [] - _ -> throwError "if: expected boolean"))) - let !aw_12 = Types.Atom (Types.UnboundSym "") - !appl_13 <- kl_V2434 `pseq` applyWrapper aw_12 [kl_V2434] - appl_13 `pseq` applyWrapper appl_4 [appl_13] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBside_conditionRB) -> do let !aw_15 = Types.Atom (Types.UnboundSym "fail") - !appl_16 <- applyWrapper aw_15 [] - !appl_17 <- appl_16 `pseq` (kl_Parse_shen_LBside_conditionRB `pseq` eq appl_16 kl_Parse_shen_LBside_conditionRB) - !kl_if_18 <- appl_17 `pseq` kl_not appl_17 - case kl_if_18 of - Atom (B (True)) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBside_conditionsRB) -> do let !aw_20 = Types.Atom (Types.UnboundSym "fail") - !appl_21 <- applyWrapper aw_20 [] - !appl_22 <- appl_21 `pseq` (kl_Parse_shen_LBside_conditionsRB `pseq` eq appl_21 kl_Parse_shen_LBside_conditionsRB) - !kl_if_23 <- appl_22 `pseq` kl_not appl_22 - case kl_if_23 of - Atom (B (True)) -> do !appl_24 <- kl_Parse_shen_LBside_conditionsRB `pseq` hd kl_Parse_shen_LBside_conditionsRB - let !aw_25 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_26 <- kl_Parse_shen_LBside_conditionRB `pseq` applyWrapper aw_25 [kl_Parse_shen_LBside_conditionRB] - let !aw_27 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_28 <- kl_Parse_shen_LBside_conditionsRB `pseq` applyWrapper aw_27 [kl_Parse_shen_LBside_conditionsRB] - !appl_29 <- appl_26 `pseq` (appl_28 `pseq` klCons appl_26 appl_28) - 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"))) - !appl_32 <- kl_Parse_shen_LBside_conditionRB `pseq` kl_shen_LBside_conditionsRB kl_Parse_shen_LBside_conditionRB - appl_32 `pseq` applyWrapper appl_19 [appl_32] - Atom (B (False)) -> do do let !aw_33 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_33 [] - _ -> throwError "if: expected boolean"))) - !appl_34 <- kl_V2434 `pseq` kl_shen_LBside_conditionRB kl_V2434 - !appl_35 <- appl_34 `pseq` applyWrapper appl_14 [appl_34] - appl_35 `pseq` applyWrapper appl_0 [appl_35] - -kl_shen_LBside_conditionRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBside_conditionRB (!kl_V2436) = 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_V2436 `pseq` hd kl_V2436 - !kl_if_5 <- appl_4 `pseq` consP appl_4 - !kl_if_6 <- case kl_if_5 of - Atom (B (True)) -> do !appl_7 <- kl_V2436 `pseq` hd kl_V2436 - !appl_8 <- appl_7 `pseq` hd appl_7 - !kl_if_9 <- appl_8 `pseq` eq (Types.Atom (Types.UnboundSym "let")) appl_8 - case kl_if_9 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_6 of - Atom (B (True)) -> do let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBvariablePRB) -> do let !aw_11 = Types.Atom (Types.UnboundSym "fail") - !appl_12 <- applyWrapper aw_11 [] - !appl_13 <- appl_12 `pseq` (kl_Parse_shen_LBvariablePRB `pseq` eq appl_12 kl_Parse_shen_LBvariablePRB) - !kl_if_14 <- appl_13 `pseq` kl_not appl_13 - case kl_if_14 of - Atom (B (True)) -> do let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_16 = Types.Atom (Types.UnboundSym "fail") - !appl_17 <- applyWrapper aw_16 [] - !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_17 kl_Parse_shen_LBexprRB) - !kl_if_19 <- appl_18 `pseq` kl_not appl_18 - case kl_if_19 of - Atom (B (True)) -> do !appl_20 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB - let !aw_21 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_22 <- kl_Parse_shen_LBvariablePRB `pseq` applyWrapper aw_21 [kl_Parse_shen_LBvariablePRB] - let !aw_23 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_24 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_23 [kl_Parse_shen_LBexprRB] - !appl_25 <- appl_24 `pseq` klCons appl_24 (Types.Atom Types.Nil) - !appl_26 <- appl_22 `pseq` (appl_25 `pseq` klCons appl_22 appl_25) - !appl_27 <- appl_26 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_26 - let !aw_28 = Types.Atom (Types.UnboundSym "shen.pair") - appl_20 `pseq` (appl_27 `pseq` applyWrapper aw_28 [appl_20, - appl_27]) - Atom (B (False)) -> do do let !aw_29 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_29 [] - _ -> throwError "if: expected boolean"))) - !appl_30 <- kl_Parse_shen_LBvariablePRB `pseq` kl_shen_LBexprRB kl_Parse_shen_LBvariablePRB - appl_30 `pseq` applyWrapper appl_15 [appl_30] - Atom (B (False)) -> do do let !aw_31 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_31 [] - _ -> throwError "if: expected boolean"))) - !appl_32 <- kl_V2436 `pseq` hd kl_V2436 - !appl_33 <- appl_32 `pseq` tl appl_32 - let !aw_34 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_35 <- kl_V2436 `pseq` applyWrapper aw_34 [kl_V2436] - let !aw_36 = Types.Atom (Types.UnboundSym "shen.pair") - !appl_37 <- appl_33 `pseq` (appl_35 `pseq` applyWrapper aw_36 [appl_33, - appl_35]) - !appl_38 <- appl_37 `pseq` kl_shen_LBvariablePRB appl_37 - appl_38 `pseq` applyWrapper appl_10 [appl_38] - Atom (B (False)) -> do do let !aw_39 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_39 [] - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - !appl_40 <- kl_V2436 `pseq` hd kl_V2436 - !kl_if_41 <- appl_40 `pseq` consP appl_40 - !kl_if_42 <- case kl_if_41 of - Atom (B (True)) -> do !appl_43 <- kl_V2436 `pseq` hd kl_V2436 - !appl_44 <- appl_43 `pseq` hd appl_43 - !kl_if_45 <- appl_44 `pseq` eq (Types.Atom (Types.UnboundSym "if")) appl_44 - case kl_if_45 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_46 <- case kl_if_42 of - Atom (B (True)) -> do let !appl_47 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_48 = Types.Atom (Types.UnboundSym "fail") - !appl_49 <- applyWrapper aw_48 [] - !appl_50 <- appl_49 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_49 kl_Parse_shen_LBexprRB) - !kl_if_51 <- appl_50 `pseq` kl_not appl_50 - case kl_if_51 of - Atom (B (True)) -> do !appl_52 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB - let !aw_53 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_54 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_53 [kl_Parse_shen_LBexprRB] - !appl_55 <- appl_54 `pseq` klCons appl_54 (Types.Atom Types.Nil) - !appl_56 <- appl_55 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_55 - let !aw_57 = Types.Atom (Types.UnboundSym "shen.pair") - appl_52 `pseq` (appl_56 `pseq` applyWrapper aw_57 [appl_52, - appl_56]) - Atom (B (False)) -> do do let !aw_58 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_58 [] - _ -> throwError "if: expected boolean"))) - !appl_59 <- kl_V2436 `pseq` hd kl_V2436 - !appl_60 <- appl_59 `pseq` tl appl_59 - let !aw_61 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_62 <- kl_V2436 `pseq` applyWrapper aw_61 [kl_V2436] - let !aw_63 = Types.Atom (Types.UnboundSym "shen.pair") - !appl_64 <- appl_60 `pseq` (appl_62 `pseq` applyWrapper aw_63 [appl_60, - appl_62]) - !appl_65 <- appl_64 `pseq` kl_shen_LBexprRB appl_64 - appl_65 `pseq` applyWrapper appl_47 [appl_65] - Atom (B (False)) -> do do let !aw_66 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_66 [] - _ -> throwError "if: expected boolean" - appl_46 `pseq` applyWrapper appl_0 [appl_46] - -kl_shen_LBvariablePRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBvariablePRB (!kl_V2438) = do !appl_0 <- kl_V2438 `pseq` hd kl_V2438 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - case kl_if_1 of - Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !kl_if_3 <- kl_Parse_X `pseq` kl_variableP kl_Parse_X - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_V2438 `pseq` hd kl_V2438 - !appl_5 <- appl_4 `pseq` tl appl_4 - let !aw_6 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_7 <- kl_V2438 `pseq` applyWrapper aw_6 [kl_V2438] - let !aw_8 = Types.Atom (Types.UnboundSym "shen.pair") - !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, - appl_7]) - !appl_10 <- appl_9 `pseq` hd appl_9 - let !aw_11 = Types.Atom (Types.UnboundSym "shen.pair") - appl_10 `pseq` (kl_Parse_X `pseq` applyWrapper aw_11 [appl_10, - kl_Parse_X]) - Atom (B (False)) -> do do let !aw_12 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_12 [] - _ -> throwError "if: expected boolean"))) - !appl_13 <- kl_V2438 `pseq` hd kl_V2438 - !appl_14 <- appl_13 `pseq` hd appl_13 - appl_14 `pseq` applyWrapper appl_2 [appl_14] - Atom (B (False)) -> do do let !aw_15 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_15 [] - _ -> throwError "if: expected boolean" - -kl_shen_LBexprRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBexprRB (!kl_V2440) = do !appl_0 <- kl_V2440 `pseq` hd kl_V2440 - !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 <- klCons (Types.Atom (Types.UnboundSym ";")) (Types.Atom Types.Nil) - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.UnboundSym ">>")) appl_3 - !kl_if_5 <- kl_Parse_X `pseq` (appl_4 `pseq` kl_elementP kl_Parse_X appl_4) - !appl_6 <- case kl_if_5 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_7 <- kl_Parse_X `pseq` kl_shen_singleunderlineP kl_Parse_X - !kl_if_8 <- case kl_if_7 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_9 <- kl_Parse_X `pseq` kl_shen_doubleunderlineP kl_Parse_X - case kl_if_9 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - 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" - _ -> throwError "if: expected boolean" - !kl_if_10 <- appl_6 `pseq` kl_not appl_6 - case kl_if_10 of - Atom (B (True)) -> do !appl_11 <- kl_V2440 `pseq` hd kl_V2440 - !appl_12 <- appl_11 `pseq` tl appl_11 - let !aw_13 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_14 <- kl_V2440 `pseq` applyWrapper aw_13 [kl_V2440] - let !aw_15 = Types.Atom (Types.UnboundSym "shen.pair") - !appl_16 <- appl_12 `pseq` (appl_14 `pseq` applyWrapper aw_15 [appl_12, - appl_14]) - !appl_17 <- appl_16 `pseq` hd appl_16 - !appl_18 <- kl_Parse_X `pseq` kl_shen_remove_bar kl_Parse_X - let !aw_19 = Types.Atom (Types.UnboundSym "shen.pair") - appl_17 `pseq` (appl_18 `pseq` applyWrapper aw_19 [appl_17, - appl_18]) - Atom (B (False)) -> do do let !aw_20 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_20 [] - _ -> throwError "if: expected boolean"))) - !appl_21 <- kl_V2440 `pseq` hd kl_V2440 - !appl_22 <- appl_21 `pseq` hd appl_21 - appl_22 `pseq` applyWrapper appl_2 [appl_22] - Atom (B (False)) -> do do let !aw_23 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_23 [] - _ -> throwError "if: expected boolean" - -kl_shen_remove_bar :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_remove_bar (!kl_V2442) = do let pat_cond_0 kl_V2442 kl_V2442h kl_V2442t kl_V2442tt kl_V2442tth = do kl_V2442h `pseq` (kl_V2442tth `pseq` klCons kl_V2442h kl_V2442tth) - pat_cond_1 kl_V2442 kl_V2442h kl_V2442t = do !appl_2 <- kl_V2442h `pseq` kl_shen_remove_bar kl_V2442h - !appl_3 <- kl_V2442t `pseq` kl_shen_remove_bar kl_V2442t - appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) - pat_cond_4 = do do return kl_V2442 - in case kl_V2442 of - !(kl_V2442@(Cons (!kl_V2442h) - (!(kl_V2442t@(Cons (Atom (UnboundSym "bar!")) - (!(kl_V2442tt@(Cons (!kl_V2442tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V2442 kl_V2442h kl_V2442t kl_V2442tt kl_V2442tth - !(kl_V2442@(Cons (!kl_V2442h) - (!(kl_V2442t@(Cons (ApplC (PL "bar!" - _)) - (!(kl_V2442tt@(Cons (!kl_V2442tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V2442 kl_V2442h kl_V2442t kl_V2442tt kl_V2442tth - !(kl_V2442@(Cons (!kl_V2442h) - (!(kl_V2442t@(Cons (ApplC (Func "bar!" - _)) - (!(kl_V2442tt@(Cons (!kl_V2442tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V2442 kl_V2442h kl_V2442t kl_V2442tt kl_V2442tth - !(kl_V2442@(Cons (!kl_V2442h) - (!kl_V2442t))) -> pat_cond_1 kl_V2442 kl_V2442h kl_V2442t - _ -> pat_cond_4 - -kl_shen_LBpremisesRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBpremisesRB (!kl_V2444) = 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) - !kl_if_8 <- appl_7 `pseq` kl_not appl_7 - case kl_if_8 of - Atom (B (True)) -> do !appl_9 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB - let !aw_10 = Types.Atom (Types.UnboundSym "shen.pair") - appl_9 `pseq` applyWrapper aw_10 [appl_9, - Types.Atom Types.Nil] - Atom (B (False)) -> do do let !aw_11 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_11 [] - _ -> throwError "if: expected boolean"))) - let !aw_12 = Types.Atom (Types.UnboundSym "") - !appl_13 <- kl_V2444 `pseq` applyWrapper aw_12 [kl_V2444] - appl_13 `pseq` applyWrapper appl_4 [appl_13] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremiseRB) -> do let !aw_15 = Types.Atom (Types.UnboundSym "fail") - !appl_16 <- applyWrapper aw_15 [] - !appl_17 <- appl_16 `pseq` (kl_Parse_shen_LBpremiseRB `pseq` eq appl_16 kl_Parse_shen_LBpremiseRB) - !kl_if_18 <- appl_17 `pseq` kl_not appl_17 - case kl_if_18 of - Atom (B (True)) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsemicolon_symbolRB) -> do let !aw_20 = Types.Atom (Types.UnboundSym "fail") - !appl_21 <- applyWrapper aw_20 [] - !appl_22 <- appl_21 `pseq` (kl_Parse_shen_LBsemicolon_symbolRB `pseq` eq appl_21 kl_Parse_shen_LBsemicolon_symbolRB) - !kl_if_23 <- appl_22 `pseq` kl_not appl_22 - case kl_if_23 of - Atom (B (True)) -> do let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremisesRB) -> do let !aw_25 = Types.Atom (Types.UnboundSym "fail") - !appl_26 <- applyWrapper aw_25 [] - !appl_27 <- appl_26 `pseq` (kl_Parse_shen_LBpremisesRB `pseq` eq appl_26 kl_Parse_shen_LBpremisesRB) - !kl_if_28 <- appl_27 `pseq` kl_not appl_27 - case kl_if_28 of - Atom (B (True)) -> do !appl_29 <- kl_Parse_shen_LBpremisesRB `pseq` hd kl_Parse_shen_LBpremisesRB - let !aw_30 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_31 <- kl_Parse_shen_LBpremiseRB `pseq` applyWrapper aw_30 [kl_Parse_shen_LBpremiseRB] - let !aw_32 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_33 <- kl_Parse_shen_LBpremisesRB `pseq` applyWrapper aw_32 [kl_Parse_shen_LBpremisesRB] - !appl_34 <- appl_31 `pseq` (appl_33 `pseq` klCons appl_31 appl_33) - let !aw_35 = Types.Atom (Types.UnboundSym "shen.pair") - appl_29 `pseq` (appl_34 `pseq` applyWrapper aw_35 [appl_29, - appl_34]) - Atom (B (False)) -> do do let !aw_36 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_36 [] - _ -> throwError "if: expected boolean"))) - !appl_37 <- kl_Parse_shen_LBsemicolon_symbolRB `pseq` kl_shen_LBpremisesRB kl_Parse_shen_LBsemicolon_symbolRB - appl_37 `pseq` applyWrapper appl_24 [appl_37] - 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_LBpremiseRB `pseq` kl_shen_LBsemicolon_symbolRB kl_Parse_shen_LBpremiseRB - appl_39 `pseq` applyWrapper appl_19 [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_V2444 `pseq` kl_shen_LBpremiseRB kl_V2444 - !appl_42 <- appl_41 `pseq` applyWrapper appl_14 [appl_41] - appl_42 `pseq` applyWrapper appl_0 [appl_42] - -kl_shen_LBsemicolon_symbolRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBsemicolon_symbolRB (!kl_V2446) = do !appl_0 <- kl_V2446 `pseq` hd kl_V2446 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - case kl_if_1 of - Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let pat_cond_3 = do !appl_4 <- kl_V2446 `pseq` hd kl_V2446 - !appl_5 <- appl_4 `pseq` tl appl_4 - let !aw_6 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_7 <- kl_V2446 `pseq` applyWrapper aw_6 [kl_V2446] - let !aw_8 = Types.Atom (Types.UnboundSym "shen.pair") - !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, - appl_7]) - !appl_10 <- appl_9 `pseq` hd appl_9 - let !aw_11 = Types.Atom (Types.UnboundSym "shen.pair") - appl_10 `pseq` applyWrapper aw_11 [appl_10, - Types.Atom (Types.UnboundSym "shen.skip")] - pat_cond_12 = do do let !aw_13 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_13 [] - in case kl_Parse_X of - kl_Parse_X@(Atom (UnboundSym ";")) -> pat_cond_3 - kl_Parse_X@(ApplC (PL ";" - _)) -> pat_cond_3 - kl_Parse_X@(ApplC (Func ";" - _)) -> pat_cond_3 - _ -> pat_cond_12))) - !appl_14 <- kl_V2446 `pseq` hd kl_V2446 - !appl_15 <- appl_14 `pseq` hd appl_14 - appl_15 `pseq` applyWrapper appl_2 [appl_15] - Atom (B (False)) -> do do let !aw_16 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_16 [] - _ -> throwError "if: expected boolean" - -kl_shen_LBpremiseRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBpremiseRB (!kl_V2448) = 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_Parse_shen_LBformulaRB) -> do let !aw_9 = Types.Atom (Types.UnboundSym "fail") - !appl_10 <- applyWrapper aw_9 [] - !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_10 kl_Parse_shen_LBformulaRB) - !kl_if_12 <- appl_11 `pseq` kl_not appl_11 - case kl_if_12 of - Atom (B (True)) -> do !appl_13 <- kl_Parse_shen_LBformulaRB `pseq` hd kl_Parse_shen_LBformulaRB - let !aw_14 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_15 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_14 [kl_Parse_shen_LBformulaRB] - !appl_16 <- appl_15 `pseq` kl_shen_sequent (Types.Atom Types.Nil) appl_15 - let !aw_17 = Types.Atom (Types.UnboundSym "shen.pair") - appl_13 `pseq` (appl_16 `pseq` applyWrapper aw_17 [appl_13, - appl_16]) - Atom (B (False)) -> do do let !aw_18 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_18 [] - _ -> throwError "if: expected boolean"))) - !appl_19 <- kl_V2448 `pseq` kl_shen_LBformulaRB kl_V2448 - appl_19 `pseq` applyWrapper appl_8 [appl_19] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_20 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaeRB) -> do let !aw_21 = Types.Atom (Types.UnboundSym "fail") - !appl_22 <- applyWrapper aw_21 [] - !appl_23 <- appl_22 `pseq` (kl_Parse_shen_LBformulaeRB `pseq` eq appl_22 kl_Parse_shen_LBformulaeRB) - !kl_if_24 <- appl_23 `pseq` kl_not appl_23 - case kl_if_24 of - Atom (B (True)) -> do !appl_25 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB - !kl_if_26 <- appl_25 `pseq` consP appl_25 - !kl_if_27 <- case kl_if_26 of - Atom (B (True)) -> do !appl_28 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB - !appl_29 <- appl_28 `pseq` hd appl_28 - !kl_if_30 <- appl_29 `pseq` eq (Types.Atom (Types.UnboundSym ">>")) appl_29 - case kl_if_30 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_27 of - Atom (B (True)) -> do let !appl_31 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_32 = Types.Atom (Types.UnboundSym "fail") - !appl_33 <- applyWrapper aw_32 [] - !appl_34 <- appl_33 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_33 kl_Parse_shen_LBformulaRB) - !kl_if_35 <- appl_34 `pseq` kl_not appl_34 - case kl_if_35 of - Atom (B (True)) -> do !appl_36 <- kl_Parse_shen_LBformulaRB `pseq` hd kl_Parse_shen_LBformulaRB - let !aw_37 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_38 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_37 [kl_Parse_shen_LBformulaeRB] - let !aw_39 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_40 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_39 [kl_Parse_shen_LBformulaRB] - !appl_41 <- appl_38 `pseq` (appl_40 `pseq` kl_shen_sequent appl_38 appl_40) - let !aw_42 = Types.Atom (Types.UnboundSym "shen.pair") - appl_36 `pseq` (appl_41 `pseq` applyWrapper aw_42 [appl_36, - appl_41]) - Atom (B (False)) -> do do let !aw_43 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_43 [] - _ -> throwError "if: expected boolean"))) - !appl_44 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB - !appl_45 <- appl_44 `pseq` tl appl_44 - let !aw_46 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_47 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_46 [kl_Parse_shen_LBformulaeRB] - let !aw_48 = Types.Atom (Types.UnboundSym "shen.pair") - !appl_49 <- appl_45 `pseq` (appl_47 `pseq` applyWrapper aw_48 [appl_45, - appl_47]) - !appl_50 <- appl_49 `pseq` kl_shen_LBformulaRB appl_49 - appl_50 `pseq` applyWrapper appl_31 [appl_50] - Atom (B (False)) -> do do let !aw_51 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_51 [] - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do let !aw_52 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_52 [] - _ -> throwError "if: expected boolean"))) - !appl_53 <- kl_V2448 `pseq` kl_shen_LBformulaeRB kl_V2448 - !appl_54 <- appl_53 `pseq` applyWrapper appl_20 [appl_53] - appl_54 `pseq` applyWrapper appl_4 [appl_54] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - !appl_55 <- kl_V2448 `pseq` hd kl_V2448 - !kl_if_56 <- appl_55 `pseq` consP appl_55 - !kl_if_57 <- case kl_if_56 of - Atom (B (True)) -> do !appl_58 <- kl_V2448 `pseq` hd kl_V2448 - !appl_59 <- appl_58 `pseq` hd appl_58 - !kl_if_60 <- appl_59 `pseq` eq (Types.Atom (Types.UnboundSym "!")) 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_V2448 `pseq` hd kl_V2448 - !appl_63 <- appl_62 `pseq` tl appl_62 - let !aw_64 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_65 <- kl_V2448 `pseq` applyWrapper aw_64 [kl_V2448] - 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 - let !aw_69 = Types.Atom (Types.UnboundSym "shen.pair") - appl_68 `pseq` applyWrapper aw_69 [appl_68, - Types.Atom (Types.UnboundSym "!")] - Atom (B (False)) -> do do let !aw_70 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_70 [] - _ -> throwError "if: expected boolean" - appl_61 `pseq` applyWrapper appl_0 [appl_61] - -kl_shen_LBconclusionRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBconclusionRB (!kl_V2450) = 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_LBformulaRB) -> do let !aw_5 = Types.Atom (Types.UnboundSym "fail") - !appl_6 <- applyWrapper aw_5 [] - !appl_7 <- appl_6 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_6 kl_Parse_shen_LBformulaRB) - !kl_if_8 <- appl_7 `pseq` kl_not appl_7 - case kl_if_8 of - Atom (B (True)) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsemicolon_symbolRB) -> do let !aw_10 = Types.Atom (Types.UnboundSym "fail") - !appl_11 <- applyWrapper aw_10 [] - !appl_12 <- appl_11 `pseq` (kl_Parse_shen_LBsemicolon_symbolRB `pseq` eq appl_11 kl_Parse_shen_LBsemicolon_symbolRB) - !kl_if_13 <- appl_12 `pseq` kl_not appl_12 - case kl_if_13 of - Atom (B (True)) -> do !appl_14 <- kl_Parse_shen_LBsemicolon_symbolRB `pseq` hd kl_Parse_shen_LBsemicolon_symbolRB - let !aw_15 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_16 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_15 [kl_Parse_shen_LBformulaRB] - !appl_17 <- appl_16 `pseq` kl_shen_sequent (Types.Atom Types.Nil) appl_16 - let !aw_18 = Types.Atom (Types.UnboundSym "shen.pair") - appl_14 `pseq` (appl_17 `pseq` applyWrapper aw_18 [appl_14, - appl_17]) - Atom (B (False)) -> do do let !aw_19 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_19 [] - _ -> throwError "if: expected boolean"))) - !appl_20 <- kl_Parse_shen_LBformulaRB `pseq` kl_shen_LBsemicolon_symbolRB kl_Parse_shen_LBformulaRB - appl_20 `pseq` applyWrapper appl_9 [appl_20] - Atom (B (False)) -> do do let !aw_21 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_21 [] - _ -> throwError "if: expected boolean"))) - !appl_22 <- kl_V2450 `pseq` kl_shen_LBformulaRB kl_V2450 - appl_22 `pseq` applyWrapper appl_4 [appl_22] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_23 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaeRB) -> do let !aw_24 = Types.Atom (Types.UnboundSym "fail") - !appl_25 <- applyWrapper aw_24 [] - !appl_26 <- appl_25 `pseq` (kl_Parse_shen_LBformulaeRB `pseq` eq appl_25 kl_Parse_shen_LBformulaeRB) - !kl_if_27 <- appl_26 `pseq` kl_not appl_26 - case kl_if_27 of - Atom (B (True)) -> do !appl_28 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB - !kl_if_29 <- appl_28 `pseq` consP appl_28 - !kl_if_30 <- case kl_if_29 of - Atom (B (True)) -> do !appl_31 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB - !appl_32 <- appl_31 `pseq` hd appl_31 - !kl_if_33 <- appl_32 `pseq` eq (Types.Atom (Types.UnboundSym ">>")) appl_32 - case kl_if_33 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_30 of - Atom (B (True)) -> do let !appl_34 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_35 = Types.Atom (Types.UnboundSym "fail") - !appl_36 <- applyWrapper aw_35 [] - !appl_37 <- appl_36 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_36 kl_Parse_shen_LBformulaRB) - !kl_if_38 <- appl_37 `pseq` kl_not appl_37 - case kl_if_38 of - Atom (B (True)) -> do let !appl_39 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsemicolon_symbolRB) -> do let !aw_40 = Types.Atom (Types.UnboundSym "fail") - !appl_41 <- applyWrapper aw_40 [] - !appl_42 <- appl_41 `pseq` (kl_Parse_shen_LBsemicolon_symbolRB `pseq` eq appl_41 kl_Parse_shen_LBsemicolon_symbolRB) - !kl_if_43 <- appl_42 `pseq` kl_not appl_42 - case kl_if_43 of - Atom (B (True)) -> do !appl_44 <- kl_Parse_shen_LBsemicolon_symbolRB `pseq` hd kl_Parse_shen_LBsemicolon_symbolRB - let !aw_45 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_46 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_45 [kl_Parse_shen_LBformulaeRB] - let !aw_47 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_48 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_47 [kl_Parse_shen_LBformulaRB] - !appl_49 <- appl_46 `pseq` (appl_48 `pseq` kl_shen_sequent appl_46 appl_48) - let !aw_50 = Types.Atom (Types.UnboundSym "shen.pair") - appl_44 `pseq` (appl_49 `pseq` applyWrapper aw_50 [appl_44, - appl_49]) - Atom (B (False)) -> do do let !aw_51 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_51 [] - _ -> throwError "if: expected boolean"))) - !appl_52 <- kl_Parse_shen_LBformulaRB `pseq` kl_shen_LBsemicolon_symbolRB kl_Parse_shen_LBformulaRB - appl_52 `pseq` applyWrapper appl_39 [appl_52] - Atom (B (False)) -> do do let !aw_53 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_53 [] - _ -> throwError "if: expected boolean"))) - !appl_54 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB - !appl_55 <- appl_54 `pseq` tl appl_54 - let !aw_56 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_57 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_56 [kl_Parse_shen_LBformulaeRB] - let !aw_58 = Types.Atom (Types.UnboundSym "shen.pair") - !appl_59 <- appl_55 `pseq` (appl_57 `pseq` applyWrapper aw_58 [appl_55, - appl_57]) - !appl_60 <- appl_59 `pseq` kl_shen_LBformulaRB appl_59 - appl_60 `pseq` applyWrapper appl_34 [appl_60] - Atom (B (False)) -> do do let !aw_61 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_61 [] - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do let !aw_62 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_62 [] - _ -> throwError "if: expected boolean"))) - !appl_63 <- kl_V2450 `pseq` kl_shen_LBformulaeRB kl_V2450 - !appl_64 <- appl_63 `pseq` applyWrapper appl_23 [appl_63] - appl_64 `pseq` applyWrapper appl_0 [appl_64] - -kl_shen_sequent :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_sequent (!kl_V2453) (!kl_V2454) = do kl_V2453 `pseq` (kl_V2454 `pseq` kl_Atp kl_V2453 kl_V2454) - -kl_shen_LBformulaeRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBformulaeRB (!kl_V2456) = 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_Parse_LBeRB) -> do let !aw_9 = Types.Atom (Types.UnboundSym "fail") - !appl_10 <- applyWrapper aw_9 [] - !appl_11 <- appl_10 `pseq` (kl_Parse_LBeRB `pseq` eq appl_10 kl_Parse_LBeRB) - !kl_if_12 <- appl_11 `pseq` kl_not appl_11 - case kl_if_12 of - Atom (B (True)) -> do !appl_13 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB - let !aw_14 = Types.Atom (Types.UnboundSym "shen.pair") - appl_13 `pseq` applyWrapper aw_14 [appl_13, - Types.Atom Types.Nil] - Atom (B (False)) -> do do let !aw_15 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_15 [] - _ -> throwError "if: expected boolean"))) - let !aw_16 = Types.Atom (Types.UnboundSym "") - !appl_17 <- kl_V2456 `pseq` applyWrapper aw_16 [kl_V2456] - appl_17 `pseq` applyWrapper appl_8 [appl_17] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_19 = Types.Atom (Types.UnboundSym "fail") - !appl_20 <- applyWrapper aw_19 [] - !appl_21 <- appl_20 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_20 kl_Parse_shen_LBformulaRB) - !kl_if_22 <- appl_21 `pseq` kl_not appl_21 - case kl_if_22 of - Atom (B (True)) -> do !appl_23 <- kl_Parse_shen_LBformulaRB `pseq` hd kl_Parse_shen_LBformulaRB - let !aw_24 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_25 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_24 [kl_Parse_shen_LBformulaRB] - !appl_26 <- appl_25 `pseq` klCons appl_25 (Types.Atom Types.Nil) - let !aw_27 = Types.Atom (Types.UnboundSym "shen.pair") - appl_23 `pseq` (appl_26 `pseq` applyWrapper aw_27 [appl_23, - appl_26]) - Atom (B (False)) -> do do let !aw_28 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_28 [] - _ -> throwError "if: expected boolean"))) - !appl_29 <- kl_V2456 `pseq` kl_shen_LBformulaRB kl_V2456 - !appl_30 <- appl_29 `pseq` applyWrapper appl_18 [appl_29] - appl_30 `pseq` applyWrapper appl_4 [appl_30] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_31 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_32 = Types.Atom (Types.UnboundSym "fail") - !appl_33 <- applyWrapper aw_32 [] - !appl_34 <- appl_33 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_33 kl_Parse_shen_LBformulaRB) - !kl_if_35 <- appl_34 `pseq` kl_not appl_34 - case kl_if_35 of - Atom (B (True)) -> do let !appl_36 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcomma_symbolRB) -> do let !aw_37 = Types.Atom (Types.UnboundSym "fail") - !appl_38 <- applyWrapper aw_37 [] - !appl_39 <- appl_38 `pseq` (kl_Parse_shen_LBcomma_symbolRB `pseq` eq appl_38 kl_Parse_shen_LBcomma_symbolRB) - !kl_if_40 <- appl_39 `pseq` kl_not appl_39 - case kl_if_40 of - Atom (B (True)) -> do let !appl_41 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaeRB) -> do let !aw_42 = Types.Atom (Types.UnboundSym "fail") - !appl_43 <- applyWrapper aw_42 [] - !appl_44 <- appl_43 `pseq` (kl_Parse_shen_LBformulaeRB `pseq` eq appl_43 kl_Parse_shen_LBformulaeRB) - !kl_if_45 <- appl_44 `pseq` kl_not appl_44 - case kl_if_45 of - Atom (B (True)) -> do !appl_46 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB - let !aw_47 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_48 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_47 [kl_Parse_shen_LBformulaRB] - let !aw_49 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_50 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_49 [kl_Parse_shen_LBformulaeRB] - !appl_51 <- appl_48 `pseq` (appl_50 `pseq` klCons appl_48 appl_50) - let !aw_52 = Types.Atom (Types.UnboundSym "shen.pair") - appl_46 `pseq` (appl_51 `pseq` applyWrapper aw_52 [appl_46, - appl_51]) - Atom (B (False)) -> do do let !aw_53 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_53 [] - _ -> throwError "if: expected boolean"))) - !appl_54 <- kl_Parse_shen_LBcomma_symbolRB `pseq` kl_shen_LBformulaeRB kl_Parse_shen_LBcomma_symbolRB - appl_54 `pseq` applyWrapper appl_41 [appl_54] - Atom (B (False)) -> do do let !aw_55 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_55 [] - _ -> throwError "if: expected boolean"))) - !appl_56 <- kl_Parse_shen_LBformulaRB `pseq` kl_shen_LBcomma_symbolRB kl_Parse_shen_LBformulaRB - appl_56 `pseq` applyWrapper appl_36 [appl_56] - Atom (B (False)) -> do do let !aw_57 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_57 [] - _ -> throwError "if: expected boolean"))) - !appl_58 <- kl_V2456 `pseq` kl_shen_LBformulaRB kl_V2456 - !appl_59 <- appl_58 `pseq` applyWrapper appl_31 [appl_58] - appl_59 `pseq` applyWrapper appl_0 [appl_59] - -kl_shen_LBcomma_symbolRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBcomma_symbolRB (!kl_V2458) = do !appl_0 <- kl_V2458 `pseq` hd kl_V2458 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - case kl_if_1 of - Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !appl_3 <- intern (Types.Atom (Types.Str ",")) - !kl_if_4 <- kl_Parse_X `pseq` (appl_3 `pseq` eq kl_Parse_X appl_3) - case kl_if_4 of - Atom (B (True)) -> do !appl_5 <- kl_V2458 `pseq` hd kl_V2458 - !appl_6 <- appl_5 `pseq` tl appl_5 - let !aw_7 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_8 <- kl_V2458 `pseq` applyWrapper aw_7 [kl_V2458] - let !aw_9 = Types.Atom (Types.UnboundSym "shen.pair") - !appl_10 <- appl_6 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_6, - appl_8]) - !appl_11 <- appl_10 `pseq` hd appl_10 - let !aw_12 = Types.Atom (Types.UnboundSym "shen.pair") - appl_11 `pseq` applyWrapper aw_12 [appl_11, - Types.Atom (Types.UnboundSym "shen.skip")] - Atom (B (False)) -> do do let !aw_13 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_13 [] - _ -> throwError "if: expected boolean"))) - !appl_14 <- kl_V2458 `pseq` hd kl_V2458 - !appl_15 <- appl_14 `pseq` hd appl_14 - appl_15 `pseq` applyWrapper appl_2 [appl_15] - Atom (B (False)) -> do do let !aw_16 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_16 [] - _ -> throwError "if: expected boolean" - -kl_shen_LBformulaRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBformulaRB (!kl_V2460) = 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_LBexprRB) -> do let !aw_5 = Types.Atom (Types.UnboundSym "fail") - !appl_6 <- applyWrapper aw_5 [] - !appl_7 <- appl_6 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_6 kl_Parse_shen_LBexprRB) - !kl_if_8 <- appl_7 `pseq` kl_not appl_7 - case kl_if_8 of - Atom (B (True)) -> do !appl_9 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB - let !aw_10 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_11 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_10 [kl_Parse_shen_LBexprRB] - let !aw_12 = Types.Atom (Types.UnboundSym "shen.pair") - appl_9 `pseq` (appl_11 `pseq` applyWrapper aw_12 [appl_9, - appl_11]) - Atom (B (False)) -> do do let !aw_13 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_13 [] - _ -> throwError "if: expected boolean"))) - !appl_14 <- kl_V2460 `pseq` kl_shen_LBexprRB kl_V2460 - appl_14 `pseq` applyWrapper appl_4 [appl_14] - Atom (B (False)) -> do do return kl_YaccParse - _ -> throwError "if: expected boolean"))) - let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_16 = Types.Atom (Types.UnboundSym "fail") - !appl_17 <- applyWrapper aw_16 [] - !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_17 kl_Parse_shen_LBexprRB) - !kl_if_19 <- appl_18 `pseq` kl_not appl_18 - case kl_if_19 of - Atom (B (True)) -> do !appl_20 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB - !kl_if_21 <- appl_20 `pseq` consP appl_20 - !kl_if_22 <- case kl_if_21 of - Atom (B (True)) -> do !appl_23 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB - !appl_24 <- appl_23 `pseq` hd appl_23 - !kl_if_25 <- appl_24 `pseq` eq (Types.Atom (Types.UnboundSym ":")) appl_24 - case kl_if_25 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_22 of - Atom (B (True)) -> do let !appl_26 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBtypeRB) -> do let !aw_27 = Types.Atom (Types.UnboundSym "fail") - !appl_28 <- applyWrapper aw_27 [] - !appl_29 <- appl_28 `pseq` (kl_Parse_shen_LBtypeRB `pseq` eq appl_28 kl_Parse_shen_LBtypeRB) - !kl_if_30 <- appl_29 `pseq` kl_not appl_29 - case kl_if_30 of - Atom (B (True)) -> do !appl_31 <- kl_Parse_shen_LBtypeRB `pseq` hd kl_Parse_shen_LBtypeRB - let !aw_32 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_33 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_32 [kl_Parse_shen_LBexprRB] - let !aw_34 = Types.Atom (Types.UnboundSym "shen.curry") - !appl_35 <- appl_33 `pseq` applyWrapper aw_34 [appl_33] - let !aw_36 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_37 <- kl_Parse_shen_LBtypeRB `pseq` applyWrapper aw_36 [kl_Parse_shen_LBtypeRB] - let !aw_38 = Types.Atom (Types.UnboundSym "shen.demodulate") - !appl_39 <- appl_37 `pseq` applyWrapper aw_38 [appl_37] - !appl_40 <- appl_39 `pseq` klCons appl_39 (Types.Atom Types.Nil) - !appl_41 <- appl_40 `pseq` klCons (Types.Atom (Types.UnboundSym ":")) appl_40 - !appl_42 <- appl_35 `pseq` (appl_41 `pseq` klCons appl_35 appl_41) - let !aw_43 = Types.Atom (Types.UnboundSym "shen.pair") - appl_31 `pseq` (appl_42 `pseq` applyWrapper aw_43 [appl_31, - appl_42]) - Atom (B (False)) -> do do let !aw_44 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_44 [] - _ -> throwError "if: expected boolean"))) - !appl_45 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB - !appl_46 <- appl_45 `pseq` tl appl_45 - let !aw_47 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_48 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_47 [kl_Parse_shen_LBexprRB] - let !aw_49 = Types.Atom (Types.UnboundSym "shen.pair") - !appl_50 <- appl_46 `pseq` (appl_48 `pseq` applyWrapper aw_49 [appl_46, - appl_48]) - !appl_51 <- appl_50 `pseq` kl_shen_LBtypeRB appl_50 - appl_51 `pseq` applyWrapper appl_26 [appl_51] - Atom (B (False)) -> do do let !aw_52 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_52 [] - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do let !aw_53 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_53 [] - _ -> throwError "if: expected boolean"))) - !appl_54 <- kl_V2460 `pseq` kl_shen_LBexprRB kl_V2460 - !appl_55 <- appl_54 `pseq` applyWrapper appl_15 [appl_54] - appl_55 `pseq` applyWrapper appl_0 [appl_55] - -kl_shen_LBtypeRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBtypeRB (!kl_V2462) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_1 = Types.Atom (Types.UnboundSym "fail") - !appl_2 <- applyWrapper aw_1 [] - !appl_3 <- appl_2 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_2 kl_Parse_shen_LBexprRB) - !kl_if_4 <- appl_3 `pseq` kl_not appl_3 - case kl_if_4 of - Atom (B (True)) -> do !appl_5 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB - let !aw_6 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_7 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_6 [kl_Parse_shen_LBexprRB] - !appl_8 <- appl_7 `pseq` kl_shen_curry_type appl_7 - let !aw_9 = Types.Atom (Types.UnboundSym "shen.pair") - appl_5 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_5, - appl_8]) - Atom (B (False)) -> do do let !aw_10 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_10 [] - _ -> throwError "if: expected boolean"))) - !appl_11 <- kl_V2462 `pseq` kl_shen_LBexprRB kl_V2462 - appl_11 `pseq` applyWrapper appl_0 [appl_11] - -kl_shen_LBdoubleunderlineRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBdoubleunderlineRB (!kl_V2464) = do !appl_0 <- kl_V2464 `pseq` hd kl_V2464 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - case kl_if_1 of - Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !kl_if_3 <- kl_Parse_X `pseq` kl_shen_doubleunderlineP kl_Parse_X - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_V2464 `pseq` hd kl_V2464 - !appl_5 <- appl_4 `pseq` tl appl_4 - let !aw_6 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_7 <- kl_V2464 `pseq` applyWrapper aw_6 [kl_V2464] - let !aw_8 = Types.Atom (Types.UnboundSym "shen.pair") - !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, - appl_7]) - !appl_10 <- appl_9 `pseq` hd appl_9 - let !aw_11 = Types.Atom (Types.UnboundSym "shen.pair") - appl_10 `pseq` (kl_Parse_X `pseq` applyWrapper aw_11 [appl_10, - kl_Parse_X]) - Atom (B (False)) -> do do let !aw_12 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_12 [] - _ -> throwError "if: expected boolean"))) - !appl_13 <- kl_V2464 `pseq` hd kl_V2464 - !appl_14 <- appl_13 `pseq` hd appl_13 - appl_14 `pseq` applyWrapper appl_2 [appl_14] - Atom (B (False)) -> do do let !aw_15 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_15 [] - _ -> throwError "if: expected boolean" - -kl_shen_LBsingleunderlineRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBsingleunderlineRB (!kl_V2466) = do !appl_0 <- kl_V2466 `pseq` hd kl_V2466 - !kl_if_1 <- appl_0 `pseq` consP appl_0 - case kl_if_1 of - Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !kl_if_3 <- kl_Parse_X `pseq` kl_shen_singleunderlineP kl_Parse_X - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_V2466 `pseq` hd kl_V2466 - !appl_5 <- appl_4 `pseq` tl appl_4 - let !aw_6 = Types.Atom (Types.UnboundSym "shen.hdtl") - !appl_7 <- kl_V2466 `pseq` applyWrapper aw_6 [kl_V2466] - let !aw_8 = Types.Atom (Types.UnboundSym "shen.pair") - !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, - appl_7]) - !appl_10 <- appl_9 `pseq` hd appl_9 - let !aw_11 = Types.Atom (Types.UnboundSym "shen.pair") - appl_10 `pseq` (kl_Parse_X `pseq` applyWrapper aw_11 [appl_10, - kl_Parse_X]) - Atom (B (False)) -> do do let !aw_12 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_12 [] - _ -> throwError "if: expected boolean"))) - !appl_13 <- kl_V2466 `pseq` hd kl_V2466 - !appl_14 <- appl_13 `pseq` hd appl_13 - appl_14 `pseq` applyWrapper appl_2 [appl_14] - Atom (B (False)) -> do do let !aw_15 = Types.Atom (Types.UnboundSym "fail") - applyWrapper aw_15 [] - _ -> throwError "if: expected boolean" - -kl_shen_singleunderlineP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_singleunderlineP (!kl_V2468) = do !kl_if_0 <- kl_V2468 `pseq` kl_symbolP kl_V2468 - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- kl_V2468 `pseq` str kl_V2468 - !kl_if_2 <- appl_1 `pseq` kl_shen_shP appl_1 - case kl_if_2 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - -kl_shen_shP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_shP (!kl_V2470) = do let pat_cond_0 = do return (Atom (B True)) - pat_cond_1 = do do !appl_2 <- kl_V2470 `pseq` pos kl_V2470 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_3 <- appl_2 `pseq` eq appl_2 (Types.Atom (Types.Str "_")) - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_V2470 `pseq` tlstr kl_V2470 - !kl_if_5 <- appl_4 `pseq` kl_shen_shP appl_4 - case kl_if_5 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - in case kl_V2470 of - kl_V2470@(Atom (Str "_")) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_doubleunderlineP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_doubleunderlineP (!kl_V2472) = do !kl_if_0 <- kl_V2472 `pseq` kl_symbolP kl_V2472 - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- kl_V2472 `pseq` str kl_V2472 - !kl_if_2 <- appl_1 `pseq` kl_shen_dhP appl_1 - case kl_if_2 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - -kl_shen_dhP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_dhP (!kl_V2474) = do let pat_cond_0 = do return (Atom (B True)) - pat_cond_1 = do do !appl_2 <- kl_V2474 `pseq` pos kl_V2474 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_3 <- appl_2 `pseq` eq appl_2 (Types.Atom (Types.Str "=")) - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_V2474 `pseq` tlstr kl_V2474 - !kl_if_5 <- appl_4 `pseq` kl_shen_dhP appl_4 - case kl_if_5 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - in case kl_V2474 of - kl_V2474@(Atom (Str "=")) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_process_datatype :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_process_datatype (!kl_V2477) (!kl_V2478) = do !appl_0 <- kl_V2477 `pseq` (kl_V2478 `pseq` kl_shen_rules_RBhorn_clauses kl_V2477 kl_V2478) - let !aw_1 = Types.Atom (Types.UnboundSym "shen.s-prolog") - !appl_2 <- appl_0 `pseq` applyWrapper aw_1 [appl_0] - appl_2 `pseq` kl_shen_remember_datatype appl_2 - -kl_shen_remember_datatype :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_remember_datatype (!kl_V2484) = do let pat_cond_0 kl_V2484 kl_V2484h kl_V2484t = do !appl_1 <- value (Types.Atom (Types.UnboundSym "shen.*datatypes*")) - let !aw_2 = Types.Atom (Types.UnboundSym "adjoin") - !appl_3 <- kl_V2484h `pseq` (appl_1 `pseq` applyWrapper aw_2 [kl_V2484h, - appl_1]) - !appl_4 <- appl_3 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*datatypes*")) appl_3 - !appl_5 <- value (Types.Atom (Types.UnboundSym "shen.*alldatatypes*")) - let !aw_6 = Types.Atom (Types.UnboundSym "adjoin") - !appl_7 <- kl_V2484h `pseq` (appl_5 `pseq` applyWrapper aw_6 [kl_V2484h, - appl_5]) - !appl_8 <- appl_7 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*alldatatypes*")) appl_7 - !appl_9 <- appl_8 `pseq` (kl_V2484h `pseq` kl_do appl_8 kl_V2484h) - appl_4 `pseq` (appl_9 `pseq` kl_do appl_4 appl_9) - pat_cond_10 = do do let !aw_11 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_11 [ApplC (wrapNamed "shen.remember-datatype" kl_shen_remember_datatype)] - in case kl_V2484 of - !(kl_V2484@(Cons (!kl_V2484h) - (!kl_V2484t))) -> pat_cond_0 kl_V2484 kl_V2484h kl_V2484t - _ -> pat_cond_10 - -kl_shen_rules_RBhorn_clauses :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_rules_RBhorn_clauses (!kl_V2489) (!kl_V2490) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 = do !kl_if_2 <- let pat_cond_3 kl_V2490 kl_V2490h kl_V2490t = do !kl_if_4 <- kl_V2490h `pseq` kl_tupleP kl_V2490h - !kl_if_5 <- case kl_if_4 of - Atom (B (True)) -> do !appl_6 <- kl_V2490h `pseq` kl_fst kl_V2490h - !kl_if_7 <- appl_6 `pseq` eq (Types.Atom (Types.UnboundSym "shen.single")) appl_6 - case kl_if_7 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_5 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_8 = do do return (Atom (B False)) - in case kl_V2490 of - !(kl_V2490@(Cons (!kl_V2490h) - (!kl_V2490t))) -> pat_cond_3 kl_V2490 kl_V2490h kl_V2490t - _ -> pat_cond_8 - case kl_if_2 of - Atom (B (True)) -> do !appl_9 <- kl_V2490 `pseq` hd kl_V2490 - !appl_10 <- appl_9 `pseq` kl_snd appl_9 - !appl_11 <- kl_V2489 `pseq` (appl_10 `pseq` kl_shen_rule_RBhorn_clause kl_V2489 appl_10) - !appl_12 <- kl_V2490 `pseq` tl kl_V2490 - !appl_13 <- kl_V2489 `pseq` (appl_12 `pseq` kl_shen_rules_RBhorn_clauses kl_V2489 appl_12) - appl_11 `pseq` (appl_13 `pseq` klCons appl_11 appl_13) - Atom (B (False)) -> do !kl_if_14 <- let pat_cond_15 kl_V2490 kl_V2490h kl_V2490t = do !kl_if_16 <- kl_V2490h `pseq` kl_tupleP kl_V2490h - !kl_if_17 <- case kl_if_16 of - Atom (B (True)) -> do !appl_18 <- kl_V2490h `pseq` kl_fst kl_V2490h - !kl_if_19 <- appl_18 `pseq` eq (Types.Atom (Types.UnboundSym "shen.double")) appl_18 - case kl_if_19 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_17 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_20 = do do return (Atom (B False)) - in case kl_V2490 of - !(kl_V2490@(Cons (!kl_V2490h) - (!kl_V2490t))) -> pat_cond_15 kl_V2490 kl_V2490h kl_V2490t - _ -> pat_cond_20 - case kl_if_14 of - Atom (B (True)) -> do !appl_21 <- kl_V2490 `pseq` hd kl_V2490 - !appl_22 <- appl_21 `pseq` kl_snd appl_21 - !appl_23 <- appl_22 `pseq` kl_shen_double_RBsingles appl_22 - !appl_24 <- kl_V2490 `pseq` tl kl_V2490 - !appl_25 <- appl_23 `pseq` (appl_24 `pseq` kl_append appl_23 appl_24) - kl_V2489 `pseq` (appl_25 `pseq` kl_shen_rules_RBhorn_clauses kl_V2489 appl_25) - Atom (B (False)) -> do do let !aw_26 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_26 [ApplC (wrapNamed "shen.rules->horn-clauses" kl_shen_rules_RBhorn_clauses)] - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - in case kl_V2490 of - kl_V2490@(Atom (Nil)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_double_RBsingles :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_double_RBsingles (!kl_V2492) = do !appl_0 <- kl_V2492 `pseq` kl_shen_right_rule kl_V2492 - !appl_1 <- kl_V2492 `pseq` kl_shen_left_rule kl_V2492 - !appl_2 <- appl_1 `pseq` klCons appl_1 (Types.Atom Types.Nil) - appl_0 `pseq` (appl_2 `pseq` klCons appl_0 appl_2) - -kl_shen_right_rule :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_right_rule (!kl_V2494) = do kl_V2494 `pseq` kl_Atp (Types.Atom (Types.UnboundSym "shen.single")) kl_V2494 - -kl_shen_left_rule :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_left_rule (!kl_V2496) = do !kl_if_0 <- let pat_cond_1 kl_V2496 kl_V2496h kl_V2496t = do !kl_if_2 <- let pat_cond_3 kl_V2496t kl_V2496th kl_V2496tt = do !kl_if_4 <- let pat_cond_5 kl_V2496tt kl_V2496tth kl_V2496ttt = do !kl_if_6 <- kl_V2496tth `pseq` kl_tupleP kl_V2496tth - !kl_if_7 <- case kl_if_6 of - Atom (B (True)) -> do !appl_8 <- kl_V2496tth `pseq` kl_fst kl_V2496tth - !kl_if_9 <- appl_8 `pseq` eq (Types.Atom Types.Nil) appl_8 - !kl_if_10 <- case kl_if_9 of - Atom (B (True)) -> do let pat_cond_11 = do return (Atom (B True)) - pat_cond_12 = do do return (Atom (B False)) - in case kl_V2496ttt of - kl_V2496ttt@(Atom (Nil)) -> pat_cond_11 - _ -> pat_cond_12 - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_10 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_7 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_13 = do do return (Atom (B False)) - in case kl_V2496tt of - !(kl_V2496tt@(Cons (!kl_V2496tth) - (!kl_V2496ttt))) -> pat_cond_5 kl_V2496tt kl_V2496tth kl_V2496ttt - _ -> pat_cond_13 - 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_14 = do do return (Atom (B False)) - in case kl_V2496t of - !(kl_V2496t@(Cons (!kl_V2496th) - (!kl_V2496tt))) -> pat_cond_3 kl_V2496t kl_V2496th kl_V2496tt - _ -> pat_cond_14 - 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_15 = do do return (Atom (B False)) - in case kl_V2496 of - !(kl_V2496@(Cons (!kl_V2496h) - (!kl_V2496t))) -> pat_cond_1 kl_V2496 kl_V2496h kl_V2496t - _ -> pat_cond_15 - case kl_if_0 of - Atom (B (True)) -> do let !appl_16 = ApplC (Func "lambda" (Context (\(!kl_Q) -> do let !appl_17 = ApplC (Func "lambda" (Context (\(!kl_NewConclusion) -> do let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_NewPremises) -> do !appl_19 <- kl_V2496 `pseq` hd kl_V2496 - !appl_20 <- kl_NewConclusion `pseq` klCons kl_NewConclusion (Types.Atom Types.Nil) - !appl_21 <- kl_NewPremises `pseq` (appl_20 `pseq` klCons kl_NewPremises appl_20) - !appl_22 <- appl_19 `pseq` (appl_21 `pseq` klCons appl_19 appl_21) - appl_22 `pseq` kl_Atp (Types.Atom (Types.UnboundSym "shen.single")) appl_22))) - let !appl_23 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_right_RBleft kl_X))) - !appl_24 <- kl_V2496 `pseq` tl kl_V2496 - !appl_25 <- appl_24 `pseq` hd appl_24 - !appl_26 <- appl_23 `pseq` (appl_25 `pseq` kl_map appl_23 appl_25) - !appl_27 <- appl_26 `pseq` (kl_Q `pseq` kl_Atp appl_26 kl_Q) - !appl_28 <- appl_27 `pseq` klCons appl_27 (Types.Atom Types.Nil) - appl_28 `pseq` applyWrapper appl_18 [appl_28]))) - !appl_29 <- kl_V2496 `pseq` tl kl_V2496 - !appl_30 <- appl_29 `pseq` tl appl_29 - !appl_31 <- appl_30 `pseq` hd appl_30 - !appl_32 <- appl_31 `pseq` kl_snd appl_31 - !appl_33 <- appl_32 `pseq` klCons appl_32 (Types.Atom Types.Nil) - !appl_34 <- appl_33 `pseq` (kl_Q `pseq` kl_Atp appl_33 kl_Q) - appl_34 `pseq` applyWrapper appl_17 [appl_34]))) - !appl_35 <- kl_gensym (Types.Atom (Types.UnboundSym "Qv")) - appl_35 `pseq` applyWrapper appl_16 [appl_35] - Atom (B (False)) -> do do let !aw_36 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_36 [ApplC (wrapNamed "shen.left-rule" kl_shen_left_rule)] - _ -> throwError "if: expected boolean" - -kl_shen_right_RBleft :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_right_RBleft (!kl_V2502) = do !kl_if_0 <- kl_V2502 `pseq` kl_tupleP kl_V2502 - !kl_if_1 <- case kl_if_0 of - Atom (B (True)) -> do !appl_2 <- kl_V2502 `pseq` kl_fst kl_V2502 - !kl_if_3 <- appl_2 `pseq` eq (Types.Atom Types.Nil) appl_2 - 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" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_1 of - Atom (B (True)) -> do kl_V2502 `pseq` kl_snd kl_V2502 - Atom (B (False)) -> do do simpleError (Types.Atom (Types.Str "syntax error with ==========\n")) - _ -> throwError "if: expected boolean" - -kl_shen_rule_RBhorn_clause :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_rule_RBhorn_clause (!kl_V2505) (!kl_V2506) = do !kl_if_0 <- let pat_cond_1 kl_V2506 kl_V2506h kl_V2506t = do !kl_if_2 <- let pat_cond_3 kl_V2506t kl_V2506th kl_V2506tt = do !kl_if_4 <- let pat_cond_5 kl_V2506tt kl_V2506tth kl_V2506ttt = do !kl_if_6 <- kl_V2506tth `pseq` kl_tupleP kl_V2506tth - !kl_if_7 <- case kl_if_6 of - Atom (B (True)) -> do let pat_cond_8 = do return (Atom (B True)) - pat_cond_9 = do do return (Atom (B False)) - in case kl_V2506ttt of - kl_V2506ttt@(Atom (Nil)) -> pat_cond_8 - _ -> pat_cond_9 - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_7 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_10 = do do return (Atom (B False)) - in case kl_V2506tt of - !(kl_V2506tt@(Cons (!kl_V2506tth) - (!kl_V2506ttt))) -> pat_cond_5 kl_V2506tt kl_V2506tth kl_V2506ttt - _ -> pat_cond_10 - case kl_if_4 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_11 = do do return (Atom (B False)) - in case kl_V2506t of - !(kl_V2506t@(Cons (!kl_V2506th) - (!kl_V2506tt))) -> pat_cond_3 kl_V2506t kl_V2506th kl_V2506tt - _ -> pat_cond_11 - case kl_if_2 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_12 = do do return (Atom (B False)) - in case kl_V2506 of - !(kl_V2506@(Cons (!kl_V2506h) - (!kl_V2506t))) -> pat_cond_1 kl_V2506 kl_V2506h kl_V2506t - _ -> pat_cond_12 - case kl_if_0 of - Atom (B (True)) -> do !appl_13 <- kl_V2506 `pseq` tl kl_V2506 - !appl_14 <- appl_13 `pseq` tl appl_13 - !appl_15 <- appl_14 `pseq` hd appl_14 - !appl_16 <- appl_15 `pseq` kl_snd appl_15 - !appl_17 <- kl_V2505 `pseq` (appl_16 `pseq` kl_shen_rule_RBhorn_clause_head kl_V2505 appl_16) - !appl_18 <- kl_V2506 `pseq` hd kl_V2506 - !appl_19 <- kl_V2506 `pseq` tl kl_V2506 - !appl_20 <- appl_19 `pseq` hd appl_19 - !appl_21 <- kl_V2506 `pseq` tl kl_V2506 - !appl_22 <- appl_21 `pseq` tl appl_21 - !appl_23 <- appl_22 `pseq` hd appl_22 - !appl_24 <- appl_23 `pseq` kl_fst appl_23 - !appl_25 <- appl_18 `pseq` (appl_20 `pseq` (appl_24 `pseq` kl_shen_rule_RBhorn_clause_body appl_18 appl_20 appl_24)) - !appl_26 <- appl_25 `pseq` klCons appl_25 (Types.Atom Types.Nil) - !appl_27 <- appl_26 `pseq` klCons (Types.Atom (Types.UnboundSym ":-")) appl_26 - appl_17 `pseq` (appl_27 `pseq` klCons appl_17 appl_27) - Atom (B (False)) -> do do let !aw_28 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_28 [ApplC (wrapNamed "shen.rule->horn-clause" kl_shen_rule_RBhorn_clause)] - _ -> throwError "if: expected boolean" - -kl_shen_rule_RBhorn_clause_head :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_rule_RBhorn_clause_head (!kl_V2509) (!kl_V2510) = do !appl_0 <- kl_V2510 `pseq` kl_shen_mode_ify kl_V2510 - !appl_1 <- klCons (Types.Atom (Types.UnboundSym "Context_1957")) (Types.Atom Types.Nil) - !appl_2 <- appl_0 `pseq` (appl_1 `pseq` klCons appl_0 appl_1) - kl_V2509 `pseq` (appl_2 `pseq` klCons kl_V2509 appl_2) - -kl_shen_mode_ify :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_mode_ify (!kl_V2512) = do let pat_cond_0 kl_V2512 kl_V2512h kl_V2512t kl_V2512tt kl_V2512tth = do !appl_1 <- klCons (ApplC (wrapNamed "+" add)) (Types.Atom Types.Nil) - !appl_2 <- kl_V2512tth `pseq` (appl_1 `pseq` klCons kl_V2512tth appl_1) - !appl_3 <- appl_2 `pseq` klCons (Types.Atom (Types.UnboundSym "mode")) appl_2 - !appl_4 <- appl_3 `pseq` klCons appl_3 (Types.Atom Types.Nil) - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.UnboundSym ":")) appl_4 - !appl_6 <- kl_V2512h `pseq` (appl_5 `pseq` klCons kl_V2512h appl_5) - !appl_7 <- klCons (ApplC (wrapNamed "-" Primitives.subtract)) (Types.Atom Types.Nil) - !appl_8 <- appl_6 `pseq` (appl_7 `pseq` klCons appl_6 appl_7) - appl_8 `pseq` klCons (Types.Atom (Types.UnboundSym "mode")) appl_8 - pat_cond_9 = do do return kl_V2512 - in case kl_V2512 of - !(kl_V2512@(Cons (!kl_V2512h) - (!(kl_V2512t@(Cons (Atom (UnboundSym ":")) - (!(kl_V2512tt@(Cons (!kl_V2512tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V2512 kl_V2512h kl_V2512t kl_V2512tt kl_V2512tth - !(kl_V2512@(Cons (!kl_V2512h) - (!(kl_V2512t@(Cons (ApplC (PL ":" _)) - (!(kl_V2512tt@(Cons (!kl_V2512tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V2512 kl_V2512h kl_V2512t kl_V2512tt kl_V2512tth - !(kl_V2512@(Cons (!kl_V2512h) - (!(kl_V2512t@(Cons (ApplC (Func ":" _)) - (!(kl_V2512tt@(Cons (!kl_V2512tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V2512 kl_V2512h kl_V2512t kl_V2512tt kl_V2512tth - _ -> pat_cond_9 - -kl_shen_rule_RBhorn_clause_body :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_rule_RBhorn_clause_body (!kl_V2516) (!kl_V2517) (!kl_V2518) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Variables) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Predicates) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_SearchLiterals) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_SearchClauses) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_SideLiterals) -> do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_PremissLiterals) -> do !appl_6 <- kl_SideLiterals `pseq` (kl_PremissLiterals `pseq` kl_append kl_SideLiterals kl_PremissLiterals) - kl_SearchLiterals `pseq` (appl_6 `pseq` kl_append kl_SearchLiterals appl_6)))) - let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_8 <- kl_V2518 `pseq` kl_emptyP kl_V2518 - kl_X `pseq` (appl_8 `pseq` kl_shen_construct_premiss_literal kl_X appl_8)))) - !appl_9 <- appl_7 `pseq` (kl_V2517 `pseq` kl_map appl_7 kl_V2517) - appl_9 `pseq` applyWrapper appl_5 [appl_9]))) - !appl_10 <- kl_V2516 `pseq` kl_shen_construct_side_literals kl_V2516 - appl_10 `pseq` applyWrapper appl_4 [appl_10]))) - !appl_11 <- kl_Predicates `pseq` (kl_V2518 `pseq` (kl_Variables `pseq` kl_shen_construct_search_clauses kl_Predicates kl_V2518 kl_Variables)) - appl_11 `pseq` applyWrapper appl_3 [appl_11]))) - !appl_12 <- kl_Predicates `pseq` (kl_Variables `pseq` kl_shen_construct_search_literals kl_Predicates kl_Variables (Types.Atom (Types.UnboundSym "Context_1957")) (Types.Atom (Types.UnboundSym "Context1_1957"))) - appl_12 `pseq` applyWrapper appl_2 [appl_12]))) - let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_gensym (Types.Atom (Types.UnboundSym "shen.cl"))))) - !appl_14 <- appl_13 `pseq` (kl_V2518 `pseq` kl_map appl_13 kl_V2518) - appl_14 `pseq` applyWrapper appl_1 [appl_14]))) - let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_extract_vars kl_X))) - !appl_16 <- appl_15 `pseq` (kl_V2518 `pseq` kl_map appl_15 kl_V2518) - appl_16 `pseq` applyWrapper appl_0 [appl_16] - -kl_shen_construct_search_literals :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_construct_search_literals (!kl_V2527) (!kl_V2528) (!kl_V2529) (!kl_V2530) = do !kl_if_0 <- let pat_cond_1 = do let pat_cond_2 = do return (Atom (B True)) - pat_cond_3 = do do return (Atom (B False)) - in case kl_V2528 of - kl_V2528@(Atom (Nil)) -> pat_cond_2 - _ -> pat_cond_3 - pat_cond_4 = do do return (Atom (B False)) - in case kl_V2527 of - kl_V2527@(Atom (Nil)) -> pat_cond_1 - _ -> pat_cond_4 - case kl_if_0 of - Atom (B (True)) -> do return (Types.Atom Types.Nil) - Atom (B (False)) -> do do kl_V2527 `pseq` (kl_V2528 `pseq` (kl_V2529 `pseq` (kl_V2530 `pseq` kl_shen_csl_help kl_V2527 kl_V2528 kl_V2529 kl_V2530))) - _ -> throwError "if: expected boolean" - -kl_shen_csl_help :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_csl_help (!kl_V2537) (!kl_V2538) (!kl_V2539) (!kl_V2540) = do !kl_if_0 <- let pat_cond_1 = do let pat_cond_2 = do return (Atom (B True)) - pat_cond_3 = do do return (Atom (B False)) - in case kl_V2538 of - kl_V2538@(Atom (Nil)) -> pat_cond_2 - _ -> pat_cond_3 - pat_cond_4 = do do return (Atom (B False)) - in case kl_V2537 of - kl_V2537@(Atom (Nil)) -> pat_cond_1 - _ -> pat_cond_4 - case kl_if_0 of - Atom (B (True)) -> do !appl_5 <- kl_V2539 `pseq` klCons kl_V2539 (Types.Atom Types.Nil) - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym "ContextOut_1957")) appl_5 - !appl_7 <- appl_6 `pseq` klCons (Types.Atom (Types.UnboundSym "bind")) appl_6 - appl_7 `pseq` klCons appl_7 (Types.Atom Types.Nil) - Atom (B (False)) -> do !kl_if_8 <- let pat_cond_9 kl_V2537 kl_V2537h kl_V2537t = do let pat_cond_10 kl_V2538 kl_V2538h kl_V2538t = do return (Atom (B True)) - pat_cond_11 = do do return (Atom (B False)) - in case kl_V2538 of - !(kl_V2538@(Cons (!kl_V2538h) - (!kl_V2538t))) -> pat_cond_10 kl_V2538 kl_V2538h kl_V2538t - _ -> pat_cond_11 - pat_cond_12 = do do return (Atom (B False)) - in case kl_V2537 of - !(kl_V2537@(Cons (!kl_V2537h) - (!kl_V2537t))) -> pat_cond_9 kl_V2537 kl_V2537h kl_V2537t - _ -> pat_cond_12 - case kl_if_8 of - Atom (B (True)) -> do !appl_13 <- kl_V2537 `pseq` hd kl_V2537 - !appl_14 <- kl_V2538 `pseq` hd kl_V2538 - !appl_15 <- kl_V2540 `pseq` (appl_14 `pseq` klCons kl_V2540 appl_14) - !appl_16 <- kl_V2539 `pseq` (appl_15 `pseq` klCons kl_V2539 appl_15) - !appl_17 <- appl_13 `pseq` (appl_16 `pseq` klCons appl_13 appl_16) - !appl_18 <- kl_V2537 `pseq` tl kl_V2537 - !appl_19 <- kl_V2538 `pseq` tl kl_V2538 - !appl_20 <- kl_gensym (Types.Atom (Types.UnboundSym "Context")) - !appl_21 <- appl_18 `pseq` (appl_19 `pseq` (kl_V2540 `pseq` (appl_20 `pseq` kl_shen_csl_help appl_18 appl_19 kl_V2540 appl_20))) - appl_17 `pseq` (appl_21 `pseq` klCons appl_17 appl_21) - Atom (B (False)) -> do do let !aw_22 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_22 [ApplC (wrapNamed "shen.csl-help" kl_shen_csl_help)] - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - -kl_shen_construct_search_clauses :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_construct_search_clauses (!kl_V2544) (!kl_V2545) (!kl_V2546) = do !kl_if_0 <- let pat_cond_1 = do !kl_if_2 <- let pat_cond_3 = do let pat_cond_4 = do return (Atom (B True)) - pat_cond_5 = do do return (Atom (B False)) - in case kl_V2546 of - kl_V2546@(Atom (Nil)) -> pat_cond_4 - _ -> pat_cond_5 - pat_cond_6 = do do return (Atom (B False)) - in case kl_V2545 of - kl_V2545@(Atom (Nil)) -> pat_cond_3 - _ -> pat_cond_6 - case kl_if_2 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_7 = do do return (Atom (B False)) - in case kl_V2544 of - kl_V2544@(Atom (Nil)) -> pat_cond_1 - _ -> pat_cond_7 - case kl_if_0 of - Atom (B (True)) -> do return (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do !kl_if_8 <- let pat_cond_9 kl_V2544 kl_V2544h kl_V2544t = do !kl_if_10 <- let pat_cond_11 kl_V2545 kl_V2545h kl_V2545t = do let pat_cond_12 kl_V2546 kl_V2546h kl_V2546t = do return (Atom (B True)) - pat_cond_13 = do do return (Atom (B False)) - in case kl_V2546 of - !(kl_V2546@(Cons (!kl_V2546h) - (!kl_V2546t))) -> pat_cond_12 kl_V2546 kl_V2546h kl_V2546t - _ -> pat_cond_13 - pat_cond_14 = do do return (Atom (B False)) - in case kl_V2545 of - !(kl_V2545@(Cons (!kl_V2545h) - (!kl_V2545t))) -> pat_cond_11 kl_V2545 kl_V2545h kl_V2545t - _ -> pat_cond_14 - case kl_if_10 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_15 = do do return (Atom (B False)) - in case kl_V2544 of - !(kl_V2544@(Cons (!kl_V2544h) - (!kl_V2544t))) -> pat_cond_9 kl_V2544 kl_V2544h kl_V2544t - _ -> pat_cond_15 - case kl_if_8 of - Atom (B (True)) -> do !appl_16 <- kl_V2544 `pseq` hd kl_V2544 - !appl_17 <- kl_V2545 `pseq` hd kl_V2545 - !appl_18 <- kl_V2546 `pseq` hd kl_V2546 - !appl_19 <- appl_16 `pseq` (appl_17 `pseq` (appl_18 `pseq` kl_shen_construct_search_clause appl_16 appl_17 appl_18)) - !appl_20 <- kl_V2544 `pseq` tl kl_V2544 - !appl_21 <- kl_V2545 `pseq` tl kl_V2545 - !appl_22 <- kl_V2546 `pseq` tl kl_V2546 - !appl_23 <- appl_20 `pseq` (appl_21 `pseq` (appl_22 `pseq` kl_shen_construct_search_clauses appl_20 appl_21 appl_22)) - appl_19 `pseq` (appl_23 `pseq` kl_do appl_19 appl_23) - Atom (B (False)) -> do do let !aw_24 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_24 [ApplC (wrapNamed "shen.construct-search-clauses" kl_shen_construct_search_clauses)] - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - -kl_shen_construct_search_clause :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_construct_search_clause (!kl_V2550) (!kl_V2551) (!kl_V2552) = do !appl_0 <- kl_V2550 `pseq` (kl_V2551 `pseq` (kl_V2552 `pseq` kl_shen_construct_base_search_clause kl_V2550 kl_V2551 kl_V2552)) - !appl_1 <- kl_V2550 `pseq` (kl_V2551 `pseq` (kl_V2552 `pseq` kl_shen_construct_recursive_search_clause kl_V2550 kl_V2551 kl_V2552)) - !appl_2 <- appl_1 `pseq` klCons appl_1 (Types.Atom Types.Nil) - !appl_3 <- appl_0 `pseq` (appl_2 `pseq` klCons appl_0 appl_2) - let !aw_4 = Types.Atom (Types.UnboundSym "shen.s-prolog") - appl_3 `pseq` applyWrapper aw_4 [appl_3] - -kl_shen_construct_base_search_clause :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_construct_base_search_clause (!kl_V2556) (!kl_V2557) (!kl_V2558) = do !appl_0 <- kl_V2557 `pseq` kl_shen_mode_ify kl_V2557 - !appl_1 <- appl_0 `pseq` klCons appl_0 (Types.Atom (Types.UnboundSym "In_1957")) - !appl_2 <- kl_V2558 `pseq` klCons (Types.Atom (Types.UnboundSym "In_1957")) kl_V2558 - !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) - !appl_4 <- kl_V2556 `pseq` (appl_3 `pseq` klCons kl_V2556 appl_3) - !appl_5 <- klCons (Types.Atom Types.Nil) (Types.Atom Types.Nil) - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym ":-")) appl_5 - appl_4 `pseq` (appl_6 `pseq` klCons appl_4 appl_6) - -kl_shen_construct_recursive_search_clause :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_construct_recursive_search_clause (!kl_V2562) (!kl_V2563) (!kl_V2564) = do !appl_0 <- klCons (Types.Atom (Types.UnboundSym "Assumption_1957")) (Types.Atom (Types.UnboundSym "Assumptions_1957")) - !appl_1 <- klCons (Types.Atom (Types.UnboundSym "Assumption_1957")) (Types.Atom (Types.UnboundSym "Out_1957")) - !appl_2 <- appl_1 `pseq` (kl_V2564 `pseq` klCons appl_1 kl_V2564) - !appl_3 <- appl_0 `pseq` (appl_2 `pseq` klCons appl_0 appl_2) - !appl_4 <- kl_V2562 `pseq` (appl_3 `pseq` klCons kl_V2562 appl_3) - !appl_5 <- kl_V2564 `pseq` klCons (Types.Atom (Types.UnboundSym "Out_1957")) kl_V2564 - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym "Assumptions_1957")) appl_5 - !appl_7 <- kl_V2562 `pseq` (appl_6 `pseq` klCons kl_V2562 appl_6) - !appl_8 <- appl_7 `pseq` klCons appl_7 (Types.Atom Types.Nil) - !appl_9 <- appl_8 `pseq` klCons appl_8 (Types.Atom Types.Nil) - !appl_10 <- appl_9 `pseq` klCons (Types.Atom (Types.UnboundSym ":-")) appl_9 - appl_4 `pseq` (appl_10 `pseq` klCons appl_4 appl_10) - -kl_shen_construct_side_literals :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_construct_side_literals (!kl_V2570) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V2570 kl_V2570h kl_V2570ht kl_V2570hth kl_V2570t = do !appl_2 <- kl_V2570ht `pseq` klCons (Types.Atom (Types.UnboundSym "when")) kl_V2570ht - !appl_3 <- kl_V2570t `pseq` kl_shen_construct_side_literals kl_V2570t - appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) - pat_cond_4 kl_V2570 kl_V2570h kl_V2570ht kl_V2570hth kl_V2570htt kl_V2570htth kl_V2570t = do !appl_5 <- kl_V2570ht `pseq` klCons (Types.Atom (Types.UnboundSym "is")) kl_V2570ht - !appl_6 <- kl_V2570t `pseq` kl_shen_construct_side_literals kl_V2570t - appl_5 `pseq` (appl_6 `pseq` klCons appl_5 appl_6) - pat_cond_7 kl_V2570 kl_V2570h kl_V2570t = do kl_V2570t `pseq` kl_shen_construct_side_literals kl_V2570t - pat_cond_8 = do do let !aw_9 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_9 [ApplC (wrapNamed "shen.construct-side-literals" kl_shen_construct_side_literals)] - in case kl_V2570 of - kl_V2570@(Atom (Nil)) -> pat_cond_0 - !(kl_V2570@(Cons (!(kl_V2570h@(Cons (Atom (UnboundSym "if")) - (!(kl_V2570ht@(Cons (!kl_V2570hth) - (Atom (Nil)))))))) - (!kl_V2570t))) -> pat_cond_1 kl_V2570 kl_V2570h kl_V2570ht kl_V2570hth kl_V2570t - !(kl_V2570@(Cons (!(kl_V2570h@(Cons (ApplC (PL "if" - _)) - (!(kl_V2570ht@(Cons (!kl_V2570hth) - (Atom (Nil)))))))) - (!kl_V2570t))) -> pat_cond_1 kl_V2570 kl_V2570h kl_V2570ht kl_V2570hth kl_V2570t - !(kl_V2570@(Cons (!(kl_V2570h@(Cons (ApplC (Func "if" - _)) - (!(kl_V2570ht@(Cons (!kl_V2570hth) - (Atom (Nil)))))))) - (!kl_V2570t))) -> pat_cond_1 kl_V2570 kl_V2570h kl_V2570ht kl_V2570hth kl_V2570t - !(kl_V2570@(Cons (!(kl_V2570h@(Cons (Atom (UnboundSym "let")) - (!(kl_V2570ht@(Cons (!kl_V2570hth) - (!(kl_V2570htt@(Cons (!kl_V2570htth) - (Atom (Nil))))))))))) - (!kl_V2570t))) -> pat_cond_4 kl_V2570 kl_V2570h kl_V2570ht kl_V2570hth kl_V2570htt kl_V2570htth kl_V2570t - !(kl_V2570@(Cons (!(kl_V2570h@(Cons (ApplC (PL "let" - _)) - (!(kl_V2570ht@(Cons (!kl_V2570hth) - (!(kl_V2570htt@(Cons (!kl_V2570htth) - (Atom (Nil))))))))))) - (!kl_V2570t))) -> pat_cond_4 kl_V2570 kl_V2570h kl_V2570ht kl_V2570hth kl_V2570htt kl_V2570htth kl_V2570t - !(kl_V2570@(Cons (!(kl_V2570h@(Cons (ApplC (Func "let" - _)) - (!(kl_V2570ht@(Cons (!kl_V2570hth) - (!(kl_V2570htt@(Cons (!kl_V2570htth) - (Atom (Nil))))))))))) - (!kl_V2570t))) -> pat_cond_4 kl_V2570 kl_V2570h kl_V2570ht kl_V2570hth kl_V2570htt kl_V2570htth kl_V2570t - !(kl_V2570@(Cons (!kl_V2570h) - (!kl_V2570t))) -> pat_cond_7 kl_V2570 kl_V2570h kl_V2570t - _ -> pat_cond_8 - -kl_shen_construct_premiss_literal :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_construct_premiss_literal (!kl_V2577) (!kl_V2578) = do !kl_if_0 <- kl_V2577 `pseq` kl_tupleP kl_V2577 - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- kl_V2577 `pseq` kl_snd kl_V2577 - !appl_2 <- appl_1 `pseq` kl_shen_recursive_cons_form appl_1 - !appl_3 <- kl_V2577 `pseq` kl_fst kl_V2577 - !appl_4 <- kl_V2578 `pseq` (appl_3 `pseq` kl_shen_construct_context kl_V2578 appl_3) - !appl_5 <- appl_4 `pseq` klCons appl_4 (Types.Atom Types.Nil) - !appl_6 <- appl_2 `pseq` (appl_5 `pseq` klCons appl_2 appl_5) - appl_6 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.t*")) appl_6 - Atom (B (False)) -> do let pat_cond_7 = do !appl_8 <- klCons (Types.Atom (Types.UnboundSym "Throwcontrol")) (Types.Atom Types.Nil) - appl_8 `pseq` klCons (Types.Atom (Types.UnboundSym "cut")) appl_8 - pat_cond_9 = do do let !aw_10 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_10 [ApplC (wrapNamed "shen.construct-premiss-literal" kl_shen_construct_premiss_literal)] - in case kl_V2577 of - kl_V2577@(Atom (UnboundSym "!")) -> pat_cond_7 - kl_V2577@(ApplC (PL "!" - _)) -> pat_cond_7 - kl_V2577@(ApplC (Func "!" - _)) -> pat_cond_7 - _ -> pat_cond_9 - _ -> throwError "if: expected boolean" - -kl_shen_construct_context :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_construct_context (!kl_V2581) (!kl_V2582) = do !kl_if_0 <- let pat_cond_1 = do let pat_cond_2 = do return (Atom (B True)) - pat_cond_3 = do do return (Atom (B False)) - in case kl_V2582 of - kl_V2582@(Atom (Nil)) -> pat_cond_2 - _ -> pat_cond_3 - pat_cond_4 = do do return (Atom (B False)) - in case kl_V2581 of - kl_V2581@(Atom (UnboundSym "true")) -> pat_cond_1 - kl_V2581@(Atom (B (True))) -> pat_cond_1 - _ -> pat_cond_4 - case kl_if_0 of - Atom (B (True)) -> do return (Types.Atom (Types.UnboundSym "Context_1957")) - Atom (B (False)) -> do !kl_if_5 <- let pat_cond_6 = do let pat_cond_7 = do return (Atom (B True)) - pat_cond_8 = do do return (Atom (B False)) - in case kl_V2582 of - kl_V2582@(Atom (Nil)) -> pat_cond_7 - _ -> pat_cond_8 - pat_cond_9 = do do return (Atom (B False)) - in case kl_V2581 of - kl_V2581@(Atom (UnboundSym "false")) -> pat_cond_6 - kl_V2581@(Atom (B (False))) -> pat_cond_6 - _ -> pat_cond_9 - case kl_if_5 of - Atom (B (True)) -> do return (Types.Atom (Types.UnboundSym "ContextOut_1957")) - Atom (B (False)) -> do let pat_cond_10 kl_V2582 kl_V2582h kl_V2582t = do !appl_11 <- kl_V2582h `pseq` kl_shen_recursive_cons_form kl_V2582h - !appl_12 <- kl_V2581 `pseq` (kl_V2582t `pseq` kl_shen_construct_context kl_V2581 kl_V2582t) - !appl_13 <- appl_12 `pseq` klCons appl_12 (Types.Atom Types.Nil) - !appl_14 <- appl_11 `pseq` (appl_13 `pseq` klCons appl_11 appl_13) - appl_14 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_14 - pat_cond_15 = do do let !aw_16 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_16 [ApplC (wrapNamed "shen.construct-context" kl_shen_construct_context)] - in case kl_V2582 of - !(kl_V2582@(Cons (!kl_V2582h) - (!kl_V2582t))) -> pat_cond_10 kl_V2582 kl_V2582h kl_V2582t - _ -> pat_cond_15 - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - -kl_shen_recursive_cons_form :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_recursive_cons_form (!kl_V2584) = do let pat_cond_0 kl_V2584 kl_V2584h kl_V2584t = do !appl_1 <- kl_V2584h `pseq` kl_shen_recursive_cons_form kl_V2584h - !appl_2 <- kl_V2584t `pseq` kl_shen_recursive_cons_form kl_V2584t - !appl_3 <- appl_2 `pseq` klCons appl_2 (Types.Atom Types.Nil) - !appl_4 <- appl_1 `pseq` (appl_3 `pseq` klCons appl_1 appl_3) - appl_4 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_4 - pat_cond_5 = do do return kl_V2584 - in case kl_V2584 of - !(kl_V2584@(Cons (!kl_V2584h) - (!kl_V2584t))) -> pat_cond_0 kl_V2584 kl_V2584h kl_V2584t - _ -> pat_cond_5 - -kl_preclude :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_preclude (!kl_V2586) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_1 = Types.Atom (Types.UnboundSym "shen.intern-type") - kl_X `pseq` applyWrapper aw_1 [kl_X]))) - !appl_2 <- appl_0 `pseq` (kl_V2586 `pseq` kl_map appl_0 kl_V2586) - appl_2 `pseq` kl_shen_preclude_h appl_2 - -kl_shen_preclude_h :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_preclude_h (!kl_V2588) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_FilterDatatypes) -> do value (Types.Atom (Types.UnboundSym "shen.*datatypes*"))))) - !appl_1 <- value (Types.Atom (Types.UnboundSym "shen.*datatypes*")) - !appl_2 <- appl_1 `pseq` (kl_V2588 `pseq` kl_difference appl_1 kl_V2588) - !appl_3 <- appl_2 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*datatypes*")) appl_2 - appl_3 `pseq` applyWrapper appl_0 [appl_3] - -kl_include :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_include (!kl_V2590) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_1 = Types.Atom (Types.UnboundSym "shen.intern-type") - kl_X `pseq` applyWrapper aw_1 [kl_X]))) - !appl_2 <- appl_0 `pseq` (kl_V2590 `pseq` kl_map appl_0 kl_V2590) - appl_2 `pseq` kl_shen_include_h appl_2 - -kl_shen_include_h :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_include_h (!kl_V2592) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_ValidTypes) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_NewDatatypes) -> do value (Types.Atom (Types.UnboundSym "shen.*datatypes*"))))) - !appl_2 <- value (Types.Atom (Types.UnboundSym "shen.*datatypes*")) - !appl_3 <- kl_ValidTypes `pseq` (appl_2 `pseq` kl_union kl_ValidTypes appl_2) - !appl_4 <- appl_3 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*datatypes*")) appl_3 - appl_4 `pseq` applyWrapper appl_1 [appl_4]))) - !appl_5 <- value (Types.Atom (Types.UnboundSym "shen.*alldatatypes*")) - !appl_6 <- kl_V2592 `pseq` (appl_5 `pseq` kl_intersection kl_V2592 appl_5) - appl_6 `pseq` applyWrapper appl_0 [appl_6] - -kl_preclude_all_but :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_preclude_all_but (!kl_V2594) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*alldatatypes*")) - let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_2 = Types.Atom (Types.UnboundSym "shen.intern-type") - kl_X `pseq` applyWrapper aw_2 [kl_X]))) - !appl_3 <- appl_1 `pseq` (kl_V2594 `pseq` kl_map appl_1 kl_V2594) - !appl_4 <- appl_0 `pseq` (appl_3 `pseq` kl_difference appl_0 appl_3) - appl_4 `pseq` kl_shen_preclude_h appl_4 - -kl_include_all_but :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_include_all_but (!kl_V2596) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*alldatatypes*")) - let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_2 = Types.Atom (Types.UnboundSym "shen.intern-type") - kl_X `pseq` applyWrapper aw_2 [kl_X]))) - !appl_3 <- appl_1 `pseq` (kl_V2596 `pseq` kl_map appl_1 kl_V2596) - !appl_4 <- appl_0 `pseq` (appl_3 `pseq` kl_difference appl_0 appl_3) - appl_4 `pseq` kl_shen_include_h appl_4 - -kl_shen_synonyms_help :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_synonyms_help (!kl_V2602) = do let pat_cond_0 = do !appl_1 <- value (Types.Atom (Types.UnboundSym "shen.*tc*")) - let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_demod_rule kl_X))) - !appl_3 <- value (Types.Atom (Types.UnboundSym "shen.*synonyms*")) - !appl_4 <- appl_2 `pseq` (appl_3 `pseq` kl_mapcan appl_2 appl_3) - appl_1 `pseq` (appl_4 `pseq` kl_shen_demodulation_function appl_1 appl_4) - pat_cond_5 kl_V2602 kl_V2602h kl_V2602t kl_V2602th kl_V2602tt = do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_Vs) -> do !kl_if_7 <- kl_Vs `pseq` kl_emptyP kl_Vs - case kl_if_7 of - Atom (B (True)) -> do !appl_8 <- kl_V2602th `pseq` klCons kl_V2602th (Types.Atom Types.Nil) - !appl_9 <- kl_V2602h `pseq` (appl_8 `pseq` klCons kl_V2602h appl_8) - !appl_10 <- appl_9 `pseq` kl_shen_pushnew appl_9 (Types.Atom (Types.UnboundSym "shen.*synonyms*")) - !appl_11 <- kl_V2602tt `pseq` kl_shen_synonyms_help kl_V2602tt - appl_10 `pseq` (appl_11 `pseq` kl_do appl_10 appl_11) - Atom (B (False)) -> do do kl_V2602th `pseq` (kl_Vs `pseq` kl_shen_free_variable_warnings kl_V2602th kl_Vs) - _ -> throwError "if: expected boolean"))) - !appl_12 <- kl_V2602th `pseq` kl_shen_extract_vars kl_V2602th - !appl_13 <- kl_V2602h `pseq` kl_shen_extract_vars kl_V2602h - !appl_14 <- appl_12 `pseq` (appl_13 `pseq` kl_difference appl_12 appl_13) - appl_14 `pseq` applyWrapper appl_6 [appl_14] - pat_cond_15 = do do simpleError (Types.Atom (Types.Str "odd number of synonyms\n")) - in case kl_V2602 of - kl_V2602@(Atom (Nil)) -> pat_cond_0 - !(kl_V2602@(Cons (!kl_V2602h) - (!(kl_V2602t@(Cons (!kl_V2602th) - (!kl_V2602tt)))))) -> pat_cond_5 kl_V2602 kl_V2602h kl_V2602t kl_V2602th kl_V2602tt - _ -> pat_cond_15 - -kl_shen_pushnew :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_pushnew (!kl_V2605) (!kl_V2606) = do !appl_0 <- kl_V2606 `pseq` value kl_V2606 - !kl_if_1 <- kl_V2605 `pseq` (appl_0 `pseq` kl_elementP kl_V2605 appl_0) - case kl_if_1 of - Atom (B (True)) -> do kl_V2606 `pseq` value kl_V2606 - Atom (B (False)) -> do do !appl_2 <- kl_V2606 `pseq` value kl_V2606 - !appl_3 <- kl_V2605 `pseq` (appl_2 `pseq` klCons kl_V2605 appl_2) - kl_V2606 `pseq` (appl_3 `pseq` klSet kl_V2606 appl_3) - _ -> throwError "if: expected boolean" - -kl_shen_demod_rule :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_demod_rule (!kl_V2608) = do let pat_cond_0 kl_V2608 kl_V2608h kl_V2608t kl_V2608th = do let !aw_1 = Types.Atom (Types.UnboundSym "shen.rcons_form") - !appl_2 <- kl_V2608h `pseq` applyWrapper aw_1 [kl_V2608h] - let !aw_3 = Types.Atom (Types.UnboundSym "shen.rcons_form") - !appl_4 <- kl_V2608th `pseq` applyWrapper aw_3 [kl_V2608th] - !appl_5 <- appl_4 `pseq` klCons appl_4 (Types.Atom Types.Nil) - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym "->")) appl_5 - appl_2 `pseq` (appl_6 `pseq` klCons appl_2 appl_6) - pat_cond_7 = do do let !aw_8 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_8 [ApplC (wrapNamed "shen.demod-rule" kl_shen_demod_rule)] - in case kl_V2608 of - !(kl_V2608@(Cons (!kl_V2608h) - (!(kl_V2608t@(Cons (!kl_V2608th) - (Atom (Nil))))))) -> pat_cond_0 kl_V2608 kl_V2608h kl_V2608t kl_V2608th - _ -> pat_cond_7 - -kl_shen_demodulation_function :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_demodulation_function (!kl_V2611) (!kl_V2612) = do !appl_0 <- kl_tc (ApplC (wrapNamed "-" Primitives.subtract)) - !appl_1 <- kl_shen_default_rule - !appl_2 <- kl_V2612 `pseq` (appl_1 `pseq` kl_append kl_V2612 appl_1) - !appl_3 <- appl_2 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.demod")) appl_2 - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.UnboundSym "define")) appl_3 - !appl_5 <- appl_4 `pseq` kl_eval appl_4 - !appl_6 <- case kl_V2611 of - Atom (B (True)) -> do kl_tc (ApplC (wrapNamed "+" add)) - Atom (B (False)) -> do do return (Types.Atom (Types.UnboundSym "shen.skip")) - _ -> throwError "if: expected boolean" - !appl_7 <- appl_6 `pseq` kl_do appl_6 (Types.Atom (Types.UnboundSym "synonyms")) - !appl_8 <- appl_5 `pseq` (appl_7 `pseq` kl_do appl_5 appl_7) - appl_0 `pseq` (appl_8 `pseq` kl_do appl_0 appl_8) - -kl_shen_default_rule :: Types.KLContext Types.Env Types.KLValue -kl_shen_default_rule = do !appl_0 <- klCons (Types.Atom (Types.UnboundSym "X")) (Types.Atom Types.Nil) - !appl_1 <- appl_0 `pseq` klCons (Types.Atom (Types.UnboundSym "->")) appl_0 - appl_1 `pseq` klCons (Types.Atom (Types.UnboundSym "X")) appl_1 - -expr3 :: Types.KLContext Types.Env Types.KLValue -expr3 = 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"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Sequent where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel +import Backend.Core +import Backend.Sys + +{- +Copyright (c) 2015, Mark Tarver +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of Mark Tarver may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY +EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +-} + +kl_shen_datatype_error :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_datatype_error (!kl_V2440) = do !kl_if_0 <- let pat_cond_1 kl_V2440 kl_V2440h kl_V2440t = do !kl_if_2 <- let pat_cond_3 kl_V2440t kl_V2440th kl_V2440tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V2440tt `pseq` eq appl_4 kl_V2440tt) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V2440t of + !(kl_V2440t@(Cons (!kl_V2440th) + (!kl_V2440tt))) -> pat_cond_3 kl_V2440t kl_V2440th kl_V2440tt + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V2440 of + !(kl_V2440@(Cons (!kl_V2440h) + (!kl_V2440t))) -> pat_cond_1 kl_V2440 kl_V2440h kl_V2440t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do !appl_8 <- kl_V2440 `pseq` hd kl_V2440 + let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.next-50") + !appl_10 <- appl_8 `pseq` applyWrapper aw_9 [Core.Types.Atom (Core.Types.N (Core.Types.KI 50)), + appl_8] + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_12 <- appl_10 `pseq` applyWrapper aw_11 [appl_10, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_13 <- appl_12 `pseq` cn (Core.Types.Atom (Core.Types.Str "datatype syntax error here:\n\n ")) appl_12 + appl_13 `pseq` simpleError appl_13 + Atom (B (False)) -> do do let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_14 [ApplC (wrapNamed "shen.datatype-error" kl_shen_datatype_error)] + _ -> throwError "if: expected boolean" + +kl_shen_LBdatatype_rulesRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBdatatype_rulesRB (!kl_V2442) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !appl_7 <- appl_6 `pseq` (kl_Parse_LBeRB `pseq` eq appl_6 kl_Parse_LBeRB) + !kl_if_8 <- appl_7 `pseq` kl_not appl_7 + case kl_if_8 of + Atom (B (True)) -> do !appl_9 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB + let !appl_10 = Atom Nil + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_9 `pseq` (appl_10 `pseq` applyWrapper aw_11 [appl_9, + appl_10]) + Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_12 [] + _ -> throwError "if: expected boolean"))) + let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "") + !appl_14 <- kl_V2442 `pseq` applyWrapper aw_13 [kl_V2442] + appl_14 `pseq` applyWrapper appl_4 [appl_14] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdatatype_ruleRB) -> do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_17 <- applyWrapper aw_16 [] + !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBdatatype_ruleRB `pseq` eq appl_17 kl_Parse_shen_LBdatatype_ruleRB) + !kl_if_19 <- appl_18 `pseq` kl_not appl_18 + case kl_if_19 of + Atom (B (True)) -> do let !appl_20 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdatatype_rulesRB) -> do let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_22 <- applyWrapper aw_21 [] + !appl_23 <- appl_22 `pseq` (kl_Parse_shen_LBdatatype_rulesRB `pseq` eq appl_22 kl_Parse_shen_LBdatatype_rulesRB) + !kl_if_24 <- appl_23 `pseq` kl_not appl_23 + case kl_if_24 of + Atom (B (True)) -> do !appl_25 <- kl_Parse_shen_LBdatatype_rulesRB `pseq` hd kl_Parse_shen_LBdatatype_rulesRB + let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_27 <- kl_Parse_shen_LBdatatype_ruleRB `pseq` applyWrapper aw_26 [kl_Parse_shen_LBdatatype_ruleRB] + let !aw_28 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_29 <- kl_Parse_shen_LBdatatype_rulesRB `pseq` applyWrapper aw_28 [kl_Parse_shen_LBdatatype_rulesRB] + !appl_30 <- appl_27 `pseq` (appl_29 `pseq` klCons appl_27 appl_29) + let !aw_31 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_25 `pseq` (appl_30 `pseq` applyWrapper aw_31 [appl_25, + appl_30]) + Atom (B (False)) -> do do let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_32 [] + _ -> throwError "if: expected boolean"))) + !appl_33 <- kl_Parse_shen_LBdatatype_ruleRB `pseq` kl_shen_LBdatatype_rulesRB kl_Parse_shen_LBdatatype_ruleRB + appl_33 `pseq` applyWrapper appl_20 [appl_33] + Atom (B (False)) -> do do let !aw_34 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_34 [] + _ -> throwError "if: expected boolean"))) + !appl_35 <- kl_V2442 `pseq` kl_shen_LBdatatype_ruleRB kl_V2442 + !appl_36 <- appl_35 `pseq` applyWrapper appl_15 [appl_35] + appl_36 `pseq` applyWrapper appl_0 [appl_36] + +kl_shen_LBdatatype_ruleRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBdatatype_ruleRB (!kl_V2444) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBside_conditionsRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !appl_7 <- appl_6 `pseq` (kl_Parse_shen_LBside_conditionsRB `pseq` eq appl_6 kl_Parse_shen_LBside_conditionsRB) + !kl_if_8 <- appl_7 `pseq` kl_not appl_7 + case kl_if_8 of + Atom (B (True)) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremisesRB) -> do let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_11 <- applyWrapper aw_10 [] + !appl_12 <- appl_11 `pseq` (kl_Parse_shen_LBpremisesRB `pseq` eq appl_11 kl_Parse_shen_LBpremisesRB) + !kl_if_13 <- appl_12 `pseq` kl_not appl_12 + case kl_if_13 of + Atom (B (True)) -> do let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBdoubleunderlineRB) -> do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_16 <- applyWrapper aw_15 [] + !appl_17 <- appl_16 `pseq` (kl_Parse_shen_LBdoubleunderlineRB `pseq` eq appl_16 kl_Parse_shen_LBdoubleunderlineRB) + !kl_if_18 <- appl_17 `pseq` kl_not appl_17 + case kl_if_18 of + Atom (B (True)) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBconclusionRB) -> do let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_21 <- applyWrapper aw_20 [] + !appl_22 <- appl_21 `pseq` (kl_Parse_shen_LBconclusionRB `pseq` eq appl_21 kl_Parse_shen_LBconclusionRB) + !kl_if_23 <- appl_22 `pseq` kl_not appl_22 + case kl_if_23 of + Atom (B (True)) -> do !appl_24 <- kl_Parse_shen_LBconclusionRB `pseq` hd kl_Parse_shen_LBconclusionRB + let !aw_25 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_26 <- kl_Parse_shen_LBside_conditionsRB `pseq` applyWrapper aw_25 [kl_Parse_shen_LBside_conditionsRB] + let !aw_27 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_28 <- kl_Parse_shen_LBpremisesRB `pseq` applyWrapper aw_27 [kl_Parse_shen_LBpremisesRB] + let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_30 <- kl_Parse_shen_LBconclusionRB `pseq` applyWrapper aw_29 [kl_Parse_shen_LBconclusionRB] + let !appl_31 = Atom Nil + !appl_32 <- appl_30 `pseq` (appl_31 `pseq` klCons appl_30 appl_31) + !appl_33 <- appl_28 `pseq` (appl_32 `pseq` klCons appl_28 appl_32) + !appl_34 <- appl_26 `pseq` (appl_33 `pseq` klCons appl_26 appl_33) + !appl_35 <- appl_34 `pseq` kl_shen_sequent (Core.Types.Atom (Core.Types.UnboundSym "shen.double")) appl_34 + let !aw_36 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_24 `pseq` (appl_35 `pseq` applyWrapper aw_36 [appl_24, + appl_35]) + Atom (B (False)) -> do do let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_37 [] + _ -> throwError "if: expected boolean"))) + !appl_38 <- kl_Parse_shen_LBdoubleunderlineRB `pseq` kl_shen_LBconclusionRB kl_Parse_shen_LBdoubleunderlineRB + appl_38 `pseq` applyWrapper appl_19 [appl_38] + Atom (B (False)) -> do do let !aw_39 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_39 [] + _ -> throwError "if: expected boolean"))) + !appl_40 <- kl_Parse_shen_LBpremisesRB `pseq` kl_shen_LBdoubleunderlineRB kl_Parse_shen_LBpremisesRB + appl_40 `pseq` applyWrapper appl_14 [appl_40] + Atom (B (False)) -> do do let !aw_41 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_41 [] + _ -> throwError "if: expected boolean"))) + !appl_42 <- kl_Parse_shen_LBside_conditionsRB `pseq` kl_shen_LBpremisesRB kl_Parse_shen_LBside_conditionsRB + appl_42 `pseq` applyWrapper appl_9 [appl_42] + Atom (B (False)) -> do do let !aw_43 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_43 [] + _ -> throwError "if: expected boolean"))) + !appl_44 <- kl_V2444 `pseq` kl_shen_LBside_conditionsRB kl_V2444 + appl_44 `pseq` applyWrapper appl_4 [appl_44] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_45 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBside_conditionsRB) -> do let !aw_46 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_47 <- applyWrapper aw_46 [] + !appl_48 <- appl_47 `pseq` (kl_Parse_shen_LBside_conditionsRB `pseq` eq appl_47 kl_Parse_shen_LBside_conditionsRB) + !kl_if_49 <- appl_48 `pseq` kl_not appl_48 + case kl_if_49 of + Atom (B (True)) -> do let !appl_50 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremisesRB) -> do let !aw_51 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_52 <- applyWrapper aw_51 [] + !appl_53 <- appl_52 `pseq` (kl_Parse_shen_LBpremisesRB `pseq` eq appl_52 kl_Parse_shen_LBpremisesRB) + !kl_if_54 <- appl_53 `pseq` kl_not appl_53 + case kl_if_54 of + Atom (B (True)) -> do let !appl_55 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsingleunderlineRB) -> do let !aw_56 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_57 <- applyWrapper aw_56 [] + !appl_58 <- appl_57 `pseq` (kl_Parse_shen_LBsingleunderlineRB `pseq` eq appl_57 kl_Parse_shen_LBsingleunderlineRB) + !kl_if_59 <- appl_58 `pseq` kl_not appl_58 + case kl_if_59 of + Atom (B (True)) -> do let !appl_60 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBconclusionRB) -> do let !aw_61 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_62 <- applyWrapper aw_61 [] + !appl_63 <- appl_62 `pseq` (kl_Parse_shen_LBconclusionRB `pseq` eq appl_62 kl_Parse_shen_LBconclusionRB) + !kl_if_64 <- appl_63 `pseq` kl_not appl_63 + case kl_if_64 of + Atom (B (True)) -> do !appl_65 <- kl_Parse_shen_LBconclusionRB `pseq` hd kl_Parse_shen_LBconclusionRB + let !aw_66 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_67 <- kl_Parse_shen_LBside_conditionsRB `pseq` applyWrapper aw_66 [kl_Parse_shen_LBside_conditionsRB] + let !aw_68 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_69 <- kl_Parse_shen_LBpremisesRB `pseq` applyWrapper aw_68 [kl_Parse_shen_LBpremisesRB] + let !aw_70 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_71 <- kl_Parse_shen_LBconclusionRB `pseq` applyWrapper aw_70 [kl_Parse_shen_LBconclusionRB] + let !appl_72 = Atom Nil + !appl_73 <- appl_71 `pseq` (appl_72 `pseq` klCons appl_71 appl_72) + !appl_74 <- appl_69 `pseq` (appl_73 `pseq` klCons appl_69 appl_73) + !appl_75 <- appl_67 `pseq` (appl_74 `pseq` klCons appl_67 appl_74) + !appl_76 <- appl_75 `pseq` kl_shen_sequent (Core.Types.Atom (Core.Types.UnboundSym "shen.single")) appl_75 + let !aw_77 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_65 `pseq` (appl_76 `pseq` applyWrapper aw_77 [appl_65, + appl_76]) + Atom (B (False)) -> do do let !aw_78 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_78 [] + _ -> throwError "if: expected boolean"))) + !appl_79 <- kl_Parse_shen_LBsingleunderlineRB `pseq` kl_shen_LBconclusionRB kl_Parse_shen_LBsingleunderlineRB + appl_79 `pseq` applyWrapper appl_60 [appl_79] + Atom (B (False)) -> do do let !aw_80 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_80 [] + _ -> throwError "if: expected boolean"))) + !appl_81 <- kl_Parse_shen_LBpremisesRB `pseq` kl_shen_LBsingleunderlineRB kl_Parse_shen_LBpremisesRB + appl_81 `pseq` applyWrapper appl_55 [appl_81] + Atom (B (False)) -> do do let !aw_82 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_82 [] + _ -> throwError "if: expected boolean"))) + !appl_83 <- kl_Parse_shen_LBside_conditionsRB `pseq` kl_shen_LBpremisesRB kl_Parse_shen_LBside_conditionsRB + appl_83 `pseq` applyWrapper appl_50 [appl_83] + Atom (B (False)) -> do do let !aw_84 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_84 [] + _ -> throwError "if: expected boolean"))) + !appl_85 <- kl_V2444 `pseq` kl_shen_LBside_conditionsRB kl_V2444 + !appl_86 <- appl_85 `pseq` applyWrapper appl_45 [appl_85] + appl_86 `pseq` applyWrapper appl_0 [appl_86] + +kl_shen_LBside_conditionsRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBside_conditionsRB (!kl_V2446) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !appl_7 <- appl_6 `pseq` (kl_Parse_LBeRB `pseq` eq appl_6 kl_Parse_LBeRB) + !kl_if_8 <- appl_7 `pseq` kl_not appl_7 + case kl_if_8 of + Atom (B (True)) -> do !appl_9 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB + let !appl_10 = Atom Nil + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_9 `pseq` (appl_10 `pseq` applyWrapper aw_11 [appl_9, + appl_10]) + Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_12 [] + _ -> throwError "if: expected boolean"))) + let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "") + !appl_14 <- kl_V2446 `pseq` applyWrapper aw_13 [kl_V2446] + appl_14 `pseq` applyWrapper appl_4 [appl_14] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBside_conditionRB) -> do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_17 <- applyWrapper aw_16 [] + !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBside_conditionRB `pseq` eq appl_17 kl_Parse_shen_LBside_conditionRB) + !kl_if_19 <- appl_18 `pseq` kl_not appl_18 + case kl_if_19 of + Atom (B (True)) -> do let !appl_20 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBside_conditionsRB) -> do let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_22 <- applyWrapper aw_21 [] + !appl_23 <- appl_22 `pseq` (kl_Parse_shen_LBside_conditionsRB `pseq` eq appl_22 kl_Parse_shen_LBside_conditionsRB) + !kl_if_24 <- appl_23 `pseq` kl_not appl_23 + case kl_if_24 of + Atom (B (True)) -> do !appl_25 <- kl_Parse_shen_LBside_conditionsRB `pseq` hd kl_Parse_shen_LBside_conditionsRB + let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_27 <- kl_Parse_shen_LBside_conditionRB `pseq` applyWrapper aw_26 [kl_Parse_shen_LBside_conditionRB] + let !aw_28 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_29 <- kl_Parse_shen_LBside_conditionsRB `pseq` applyWrapper aw_28 [kl_Parse_shen_LBside_conditionsRB] + !appl_30 <- appl_27 `pseq` (appl_29 `pseq` klCons appl_27 appl_29) + let !aw_31 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_25 `pseq` (appl_30 `pseq` applyWrapper aw_31 [appl_25, + appl_30]) + Atom (B (False)) -> do do let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_32 [] + _ -> throwError "if: expected boolean"))) + !appl_33 <- kl_Parse_shen_LBside_conditionRB `pseq` kl_shen_LBside_conditionsRB kl_Parse_shen_LBside_conditionRB + appl_33 `pseq` applyWrapper appl_20 [appl_33] + Atom (B (False)) -> do do let !aw_34 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_34 [] + _ -> throwError "if: expected boolean"))) + !appl_35 <- kl_V2446 `pseq` kl_shen_LBside_conditionRB kl_V2446 + !appl_36 <- appl_35 `pseq` applyWrapper appl_15 [appl_35] + appl_36 `pseq` applyWrapper appl_0 [appl_36] + +kl_shen_LBside_conditionRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBside_conditionRB (!kl_V2448) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_V2448 `pseq` hd kl_V2448 + !kl_if_5 <- appl_4 `pseq` consP appl_4 + !kl_if_6 <- case kl_if_5 of + Atom (B (True)) -> do !appl_7 <- kl_V2448 `pseq` hd kl_V2448 + !appl_8 <- appl_7 `pseq` hd appl_7 + !kl_if_9 <- appl_8 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_8 + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_6 of + Atom (B (True)) -> do let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBvariablePRB) -> do let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_12 <- applyWrapper aw_11 [] + !appl_13 <- appl_12 `pseq` (kl_Parse_shen_LBvariablePRB `pseq` eq appl_12 kl_Parse_shen_LBvariablePRB) + !kl_if_14 <- appl_13 `pseq` kl_not appl_13 + case kl_if_14 of + Atom (B (True)) -> do let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_17 <- applyWrapper aw_16 [] + !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_17 kl_Parse_shen_LBexprRB) + !kl_if_19 <- appl_18 `pseq` kl_not appl_18 + case kl_if_19 of + Atom (B (True)) -> do !appl_20 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB + let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_22 <- kl_Parse_shen_LBvariablePRB `pseq` applyWrapper aw_21 [kl_Parse_shen_LBvariablePRB] + let !aw_23 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_24 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_23 [kl_Parse_shen_LBexprRB] + let !appl_25 = Atom Nil + !appl_26 <- appl_24 `pseq` (appl_25 `pseq` klCons appl_24 appl_25) + !appl_27 <- appl_22 `pseq` (appl_26 `pseq` klCons appl_22 appl_26) + !appl_28 <- appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_27 + let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_20 `pseq` (appl_28 `pseq` applyWrapper aw_29 [appl_20, + appl_28]) + Atom (B (False)) -> do do let !aw_30 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_30 [] + _ -> throwError "if: expected boolean"))) + !appl_31 <- kl_Parse_shen_LBvariablePRB `pseq` kl_shen_LBexprRB kl_Parse_shen_LBvariablePRB + appl_31 `pseq` applyWrapper appl_15 [appl_31] + Atom (B (False)) -> do do let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_32 [] + _ -> throwError "if: expected boolean"))) + !appl_33 <- kl_V2448 `pseq` hd kl_V2448 + !appl_34 <- appl_33 `pseq` tl appl_33 + let !aw_35 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_36 <- kl_V2448 `pseq` applyWrapper aw_35 [kl_V2448] + let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_38 <- appl_34 `pseq` (appl_36 `pseq` applyWrapper aw_37 [appl_34, + appl_36]) + !appl_39 <- appl_38 `pseq` kl_shen_LBvariablePRB appl_38 + appl_39 `pseq` applyWrapper appl_10 [appl_39] + Atom (B (False)) -> do do let !aw_40 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_40 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + !appl_41 <- kl_V2448 `pseq` hd kl_V2448 + !kl_if_42 <- appl_41 `pseq` consP appl_41 + !kl_if_43 <- case kl_if_42 of + Atom (B (True)) -> do !appl_44 <- kl_V2448 `pseq` hd kl_V2448 + !appl_45 <- appl_44 `pseq` hd appl_44 + !kl_if_46 <- appl_45 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_45 + case kl_if_46 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + !appl_47 <- case kl_if_43 of + Atom (B (True)) -> do let !appl_48 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_49 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_50 <- applyWrapper aw_49 [] + !appl_51 <- appl_50 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_50 kl_Parse_shen_LBexprRB) + !kl_if_52 <- appl_51 `pseq` kl_not appl_51 + case kl_if_52 of + Atom (B (True)) -> do !appl_53 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB + let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_55 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_54 [kl_Parse_shen_LBexprRB] + let !appl_56 = Atom Nil + !appl_57 <- appl_55 `pseq` (appl_56 `pseq` klCons appl_55 appl_56) + !appl_58 <- appl_57 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_57 + let !aw_59 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_53 `pseq` (appl_58 `pseq` applyWrapper aw_59 [appl_53, + appl_58]) + Atom (B (False)) -> do do let !aw_60 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_60 [] + _ -> throwError "if: expected boolean"))) + !appl_61 <- kl_V2448 `pseq` hd kl_V2448 + !appl_62 <- appl_61 `pseq` tl appl_61 + let !aw_63 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_64 <- kl_V2448 `pseq` applyWrapper aw_63 [kl_V2448] + let !aw_65 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_66 <- appl_62 `pseq` (appl_64 `pseq` applyWrapper aw_65 [appl_62, + appl_64]) + !appl_67 <- appl_66 `pseq` kl_shen_LBexprRB appl_66 + appl_67 `pseq` applyWrapper appl_48 [appl_67] + Atom (B (False)) -> do do let !aw_68 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_68 [] + _ -> throwError "if: expected boolean" + appl_47 `pseq` applyWrapper appl_0 [appl_47] + +kl_shen_LBvariablePRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBvariablePRB (!kl_V2450) = do !appl_0 <- kl_V2450 `pseq` hd kl_V2450 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !kl_if_3 <- kl_Parse_X `pseq` kl_variableP kl_Parse_X + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_V2450 `pseq` hd kl_V2450 + !appl_5 <- appl_4 `pseq` tl appl_4 + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_7 <- kl_V2450 `pseq` applyWrapper aw_6 [kl_V2450] + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, + appl_7]) + !appl_10 <- appl_9 `pseq` hd appl_9 + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_10 `pseq` (kl_Parse_X `pseq` applyWrapper aw_11 [appl_10, + kl_Parse_X]) + Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_12 [] + _ -> throwError "if: expected boolean"))) + !appl_13 <- kl_V2450 `pseq` hd kl_V2450 + !appl_14 <- appl_13 `pseq` hd appl_13 + appl_14 `pseq` applyWrapper appl_2 [appl_14] + Atom (B (False)) -> do do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_15 [] + _ -> throwError "if: expected boolean" + +kl_shen_LBexprRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBexprRB (!kl_V2452) = do !appl_0 <- kl_V2452 `pseq` hd kl_V2452 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let !appl_3 = Atom Nil + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ";")) appl_3 + !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ">>")) appl_4 + !kl_if_6 <- kl_Parse_X `pseq` (appl_5 `pseq` kl_elementP kl_Parse_X appl_5) + !appl_7 <- case kl_if_6 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_8 <- kl_Parse_X `pseq` kl_shen_singleunderlineP kl_Parse_X + !kl_if_9 <- case kl_if_8 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_10 <- kl_Parse_X `pseq` kl_shen_doubleunderlineP kl_Parse_X + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + !kl_if_11 <- appl_7 `pseq` kl_not appl_7 + case kl_if_11 of + Atom (B (True)) -> do !appl_12 <- kl_V2452 `pseq` hd kl_V2452 + !appl_13 <- appl_12 `pseq` tl appl_12 + let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_15 <- kl_V2452 `pseq` applyWrapper aw_14 [kl_V2452] + let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_17 <- appl_13 `pseq` (appl_15 `pseq` applyWrapper aw_16 [appl_13, + appl_15]) + !appl_18 <- appl_17 `pseq` hd appl_17 + !appl_19 <- kl_Parse_X `pseq` kl_shen_remove_bar kl_Parse_X + let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_18 `pseq` (appl_19 `pseq` applyWrapper aw_20 [appl_18, + appl_19]) + Atom (B (False)) -> do do let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_21 [] + _ -> throwError "if: expected boolean"))) + !appl_22 <- kl_V2452 `pseq` hd kl_V2452 + !appl_23 <- appl_22 `pseq` hd appl_22 + appl_23 `pseq` applyWrapper appl_2 [appl_23] + Atom (B (False)) -> do do let !aw_24 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_24 [] + _ -> throwError "if: expected boolean" + +kl_shen_remove_bar :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_remove_bar (!kl_V2454) = do !kl_if_0 <- let pat_cond_1 kl_V2454 kl_V2454h kl_V2454t = do !kl_if_2 <- let pat_cond_3 kl_V2454t kl_V2454th kl_V2454tt = do !kl_if_4 <- let pat_cond_5 kl_V2454tt kl_V2454tth kl_V2454ttt = do let !appl_6 = Atom Nil + !kl_if_7 <- appl_6 `pseq` (kl_V2454ttt `pseq` eq appl_6 kl_V2454ttt) + !kl_if_8 <- case kl_if_7 of + Atom (B (True)) -> do let pat_cond_9 = do return (Atom (B True)) + pat_cond_10 = do do return (Atom (B False)) + in case kl_V2454th of + kl_V2454th@(Atom (UnboundSym "bar!")) -> pat_cond_9 + kl_V2454th@(ApplC (PL "bar!" + _)) -> pat_cond_9 + kl_V2454th@(ApplC (Func "bar!" + _)) -> pat_cond_9 + _ -> pat_cond_10 + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_8 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_11 = do do return (Atom (B False)) + in case kl_V2454tt of + !(kl_V2454tt@(Cons (!kl_V2454tth) + (!kl_V2454ttt))) -> pat_cond_5 kl_V2454tt kl_V2454tth kl_V2454ttt + _ -> pat_cond_11 + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V2454t of + !(kl_V2454t@(Cons (!kl_V2454th) + (!kl_V2454tt))) -> pat_cond_3 kl_V2454t kl_V2454th kl_V2454tt + _ -> pat_cond_12 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_13 = do do return (Atom (B False)) + in case kl_V2454 of + !(kl_V2454@(Cons (!kl_V2454h) + (!kl_V2454t))) -> pat_cond_1 kl_V2454 kl_V2454h kl_V2454t + _ -> pat_cond_13 + case kl_if_0 of + Atom (B (True)) -> do !appl_14 <- kl_V2454 `pseq` hd kl_V2454 + !appl_15 <- kl_V2454 `pseq` tl kl_V2454 + !appl_16 <- appl_15 `pseq` tl appl_15 + !appl_17 <- appl_16 `pseq` hd appl_16 + appl_14 `pseq` (appl_17 `pseq` klCons appl_14 appl_17) + Atom (B (False)) -> do let pat_cond_18 kl_V2454 kl_V2454h kl_V2454t = do !appl_19 <- kl_V2454h `pseq` kl_shen_remove_bar kl_V2454h + !appl_20 <- kl_V2454t `pseq` kl_shen_remove_bar kl_V2454t + appl_19 `pseq` (appl_20 `pseq` klCons appl_19 appl_20) + pat_cond_21 = do do return kl_V2454 + in case kl_V2454 of + !(kl_V2454@(Cons (!kl_V2454h) + (!kl_V2454t))) -> pat_cond_18 kl_V2454 kl_V2454h kl_V2454t + _ -> pat_cond_21 + _ -> throwError "if: expected boolean" + +kl_shen_LBpremisesRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBpremisesRB (!kl_V2456) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !appl_7 <- appl_6 `pseq` (kl_Parse_LBeRB `pseq` eq appl_6 kl_Parse_LBeRB) + !kl_if_8 <- appl_7 `pseq` kl_not appl_7 + case kl_if_8 of + Atom (B (True)) -> do !appl_9 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB + let !appl_10 = Atom Nil + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_9 `pseq` (appl_10 `pseq` applyWrapper aw_11 [appl_9, + appl_10]) + Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_12 [] + _ -> throwError "if: expected boolean"))) + let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "") + !appl_14 <- kl_V2456 `pseq` applyWrapper aw_13 [kl_V2456] + appl_14 `pseq` applyWrapper appl_4 [appl_14] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremiseRB) -> do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_17 <- applyWrapper aw_16 [] + !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBpremiseRB `pseq` eq appl_17 kl_Parse_shen_LBpremiseRB) + !kl_if_19 <- appl_18 `pseq` kl_not appl_18 + case kl_if_19 of + Atom (B (True)) -> do let !appl_20 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsemicolon_symbolRB) -> do let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_22 <- applyWrapper aw_21 [] + !appl_23 <- appl_22 `pseq` (kl_Parse_shen_LBsemicolon_symbolRB `pseq` eq appl_22 kl_Parse_shen_LBsemicolon_symbolRB) + !kl_if_24 <- appl_23 `pseq` kl_not appl_23 + case kl_if_24 of + Atom (B (True)) -> do let !appl_25 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBpremisesRB) -> do let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_27 <- applyWrapper aw_26 [] + !appl_28 <- appl_27 `pseq` (kl_Parse_shen_LBpremisesRB `pseq` eq appl_27 kl_Parse_shen_LBpremisesRB) + !kl_if_29 <- appl_28 `pseq` kl_not appl_28 + case kl_if_29 of + Atom (B (True)) -> do !appl_30 <- kl_Parse_shen_LBpremisesRB `pseq` hd kl_Parse_shen_LBpremisesRB + let !aw_31 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_32 <- kl_Parse_shen_LBpremiseRB `pseq` applyWrapper aw_31 [kl_Parse_shen_LBpremiseRB] + let !aw_33 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_34 <- kl_Parse_shen_LBpremisesRB `pseq` applyWrapper aw_33 [kl_Parse_shen_LBpremisesRB] + !appl_35 <- appl_32 `pseq` (appl_34 `pseq` klCons appl_32 appl_34) + let !aw_36 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_30 `pseq` (appl_35 `pseq` applyWrapper aw_36 [appl_30, + appl_35]) + Atom (B (False)) -> do do let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_37 [] + _ -> throwError "if: expected boolean"))) + !appl_38 <- kl_Parse_shen_LBsemicolon_symbolRB `pseq` kl_shen_LBpremisesRB kl_Parse_shen_LBsemicolon_symbolRB + appl_38 `pseq` applyWrapper appl_25 [appl_38] + Atom (B (False)) -> do do let !aw_39 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_39 [] + _ -> throwError "if: expected boolean"))) + !appl_40 <- kl_Parse_shen_LBpremiseRB `pseq` kl_shen_LBsemicolon_symbolRB kl_Parse_shen_LBpremiseRB + appl_40 `pseq` applyWrapper appl_20 [appl_40] + Atom (B (False)) -> do do let !aw_41 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_41 [] + _ -> throwError "if: expected boolean"))) + !appl_42 <- kl_V2456 `pseq` kl_shen_LBpremiseRB kl_V2456 + !appl_43 <- appl_42 `pseq` applyWrapper appl_15 [appl_42] + appl_43 `pseq` applyWrapper appl_0 [appl_43] + +kl_shen_LBsemicolon_symbolRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBsemicolon_symbolRB (!kl_V2458) = do !appl_0 <- kl_V2458 `pseq` hd kl_V2458 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do let pat_cond_3 = do !appl_4 <- kl_V2458 `pseq` hd kl_V2458 + !appl_5 <- appl_4 `pseq` tl appl_4 + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_7 <- kl_V2458 `pseq` applyWrapper aw_6 [kl_V2458] + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, + appl_7]) + !appl_10 <- appl_9 `pseq` hd appl_9 + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_10 `pseq` applyWrapper aw_11 [appl_10, + Core.Types.Atom (Core.Types.UnboundSym "shen.skip")] + pat_cond_12 = do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_13 [] + in case kl_Parse_X of + kl_Parse_X@(Atom (UnboundSym ";")) -> pat_cond_3 + kl_Parse_X@(ApplC (PL ";" + _)) -> pat_cond_3 + kl_Parse_X@(ApplC (Func ";" + _)) -> pat_cond_3 + _ -> pat_cond_12))) + !appl_14 <- kl_V2458 `pseq` hd kl_V2458 + !appl_15 <- appl_14 `pseq` hd appl_14 + appl_15 `pseq` applyWrapper appl_2 [appl_15] + Atom (B (False)) -> do do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_16 [] + _ -> throwError "if: expected boolean" + +kl_shen_LBpremiseRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBpremiseRB (!kl_V2460) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !kl_if_7 <- kl_YaccParse `pseq` (appl_6 `pseq` eq kl_YaccParse appl_6) + case kl_if_7 of + Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_10 <- applyWrapper aw_9 [] + !appl_11 <- appl_10 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_10 kl_Parse_shen_LBformulaRB) + !kl_if_12 <- appl_11 `pseq` kl_not appl_11 + case kl_if_12 of + Atom (B (True)) -> do !appl_13 <- kl_Parse_shen_LBformulaRB `pseq` hd kl_Parse_shen_LBformulaRB + let !appl_14 = Atom Nil + let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_16 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_15 [kl_Parse_shen_LBformulaRB] + !appl_17 <- appl_14 `pseq` (appl_16 `pseq` kl_shen_sequent appl_14 appl_16) + let !aw_18 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_13 `pseq` (appl_17 `pseq` applyWrapper aw_18 [appl_13, + appl_17]) + Atom (B (False)) -> do do let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_19 [] + _ -> throwError "if: expected boolean"))) + !appl_20 <- kl_V2460 `pseq` kl_shen_LBformulaRB kl_V2460 + appl_20 `pseq` applyWrapper appl_8 [appl_20] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_21 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaeRB) -> do let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_23 <- applyWrapper aw_22 [] + !appl_24 <- appl_23 `pseq` (kl_Parse_shen_LBformulaeRB `pseq` eq appl_23 kl_Parse_shen_LBformulaeRB) + !kl_if_25 <- appl_24 `pseq` kl_not appl_24 + case kl_if_25 of + Atom (B (True)) -> do !appl_26 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB + !kl_if_27 <- appl_26 `pseq` consP appl_26 + !kl_if_28 <- case kl_if_27 of + Atom (B (True)) -> do !appl_29 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB + !appl_30 <- appl_29 `pseq` hd appl_29 + !kl_if_31 <- appl_30 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym ">>")) appl_30 + case kl_if_31 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_28 of + Atom (B (True)) -> do let !appl_32 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_33 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_34 <- applyWrapper aw_33 [] + !appl_35 <- appl_34 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_34 kl_Parse_shen_LBformulaRB) + !kl_if_36 <- appl_35 `pseq` kl_not appl_35 + case kl_if_36 of + Atom (B (True)) -> do !appl_37 <- kl_Parse_shen_LBformulaRB `pseq` hd kl_Parse_shen_LBformulaRB + let !aw_38 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_39 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_38 [kl_Parse_shen_LBformulaeRB] + let !aw_40 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_41 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_40 [kl_Parse_shen_LBformulaRB] + !appl_42 <- appl_39 `pseq` (appl_41 `pseq` kl_shen_sequent appl_39 appl_41) + let !aw_43 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_37 `pseq` (appl_42 `pseq` applyWrapper aw_43 [appl_37, + appl_42]) + Atom (B (False)) -> do do let !aw_44 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_44 [] + _ -> throwError "if: expected boolean"))) + !appl_45 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB + !appl_46 <- appl_45 `pseq` tl appl_45 + let !aw_47 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_48 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_47 [kl_Parse_shen_LBformulaeRB] + let !aw_49 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_50 <- appl_46 `pseq` (appl_48 `pseq` applyWrapper aw_49 [appl_46, + appl_48]) + !appl_51 <- appl_50 `pseq` kl_shen_LBformulaRB appl_50 + appl_51 `pseq` applyWrapper appl_32 [appl_51] + Atom (B (False)) -> do do let !aw_52 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_52 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_53 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_53 [] + _ -> throwError "if: expected boolean"))) + !appl_54 <- kl_V2460 `pseq` kl_shen_LBformulaeRB kl_V2460 + !appl_55 <- appl_54 `pseq` applyWrapper appl_21 [appl_54] + appl_55 `pseq` applyWrapper appl_4 [appl_55] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + !appl_56 <- kl_V2460 `pseq` hd kl_V2460 + !kl_if_57 <- appl_56 `pseq` consP appl_56 + !kl_if_58 <- case kl_if_57 of + Atom (B (True)) -> do !appl_59 <- kl_V2460 `pseq` hd kl_V2460 + !appl_60 <- appl_59 `pseq` hd appl_59 + !kl_if_61 <- appl_60 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "!")) appl_60 + case kl_if_61 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + !appl_62 <- case kl_if_58 of + Atom (B (True)) -> do !appl_63 <- kl_V2460 `pseq` hd kl_V2460 + !appl_64 <- appl_63 `pseq` tl appl_63 + let !aw_65 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_66 <- kl_V2460 `pseq` applyWrapper aw_65 [kl_V2460] + let !aw_67 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_68 <- appl_64 `pseq` (appl_66 `pseq` applyWrapper aw_67 [appl_64, + appl_66]) + !appl_69 <- appl_68 `pseq` hd appl_68 + let !aw_70 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_69 `pseq` applyWrapper aw_70 [appl_69, + Core.Types.Atom (Core.Types.UnboundSym "!")] + Atom (B (False)) -> do do let !aw_71 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_71 [] + _ -> throwError "if: expected boolean" + appl_62 `pseq` applyWrapper appl_0 [appl_62] + +kl_shen_LBconclusionRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBconclusionRB (!kl_V2462) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !appl_7 <- appl_6 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_6 kl_Parse_shen_LBformulaRB) + !kl_if_8 <- appl_7 `pseq` kl_not appl_7 + case kl_if_8 of + Atom (B (True)) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsemicolon_symbolRB) -> do let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_11 <- applyWrapper aw_10 [] + !appl_12 <- appl_11 `pseq` (kl_Parse_shen_LBsemicolon_symbolRB `pseq` eq appl_11 kl_Parse_shen_LBsemicolon_symbolRB) + !kl_if_13 <- appl_12 `pseq` kl_not appl_12 + case kl_if_13 of + Atom (B (True)) -> do !appl_14 <- kl_Parse_shen_LBsemicolon_symbolRB `pseq` hd kl_Parse_shen_LBsemicolon_symbolRB + let !appl_15 = Atom Nil + let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_17 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_16 [kl_Parse_shen_LBformulaRB] + !appl_18 <- appl_15 `pseq` (appl_17 `pseq` kl_shen_sequent appl_15 appl_17) + let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_14 `pseq` (appl_18 `pseq` applyWrapper aw_19 [appl_14, + appl_18]) + Atom (B (False)) -> do do let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_20 [] + _ -> throwError "if: expected boolean"))) + !appl_21 <- kl_Parse_shen_LBformulaRB `pseq` kl_shen_LBsemicolon_symbolRB kl_Parse_shen_LBformulaRB + appl_21 `pseq` applyWrapper appl_9 [appl_21] + Atom (B (False)) -> do do let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_22 [] + _ -> throwError "if: expected boolean"))) + !appl_23 <- kl_V2462 `pseq` kl_shen_LBformulaRB kl_V2462 + appl_23 `pseq` applyWrapper appl_4 [appl_23] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaeRB) -> do let !aw_25 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_26 <- applyWrapper aw_25 [] + !appl_27 <- appl_26 `pseq` (kl_Parse_shen_LBformulaeRB `pseq` eq appl_26 kl_Parse_shen_LBformulaeRB) + !kl_if_28 <- appl_27 `pseq` kl_not appl_27 + case kl_if_28 of + Atom (B (True)) -> do !appl_29 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB + !kl_if_30 <- appl_29 `pseq` consP appl_29 + !kl_if_31 <- case kl_if_30 of + Atom (B (True)) -> do !appl_32 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB + !appl_33 <- appl_32 `pseq` hd appl_32 + !kl_if_34 <- appl_33 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym ">>")) appl_33 + case kl_if_34 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_31 of + Atom (B (True)) -> do let !appl_35 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_36 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_37 <- applyWrapper aw_36 [] + !appl_38 <- appl_37 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_37 kl_Parse_shen_LBformulaRB) + !kl_if_39 <- appl_38 `pseq` kl_not appl_38 + case kl_if_39 of + Atom (B (True)) -> do let !appl_40 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBsemicolon_symbolRB) -> do let !aw_41 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_42 <- applyWrapper aw_41 [] + !appl_43 <- appl_42 `pseq` (kl_Parse_shen_LBsemicolon_symbolRB `pseq` eq appl_42 kl_Parse_shen_LBsemicolon_symbolRB) + !kl_if_44 <- appl_43 `pseq` kl_not appl_43 + case kl_if_44 of + Atom (B (True)) -> do !appl_45 <- kl_Parse_shen_LBsemicolon_symbolRB `pseq` hd kl_Parse_shen_LBsemicolon_symbolRB + let !aw_46 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_47 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_46 [kl_Parse_shen_LBformulaeRB] + let !aw_48 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_49 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_48 [kl_Parse_shen_LBformulaRB] + !appl_50 <- appl_47 `pseq` (appl_49 `pseq` kl_shen_sequent appl_47 appl_49) + let !aw_51 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_45 `pseq` (appl_50 `pseq` applyWrapper aw_51 [appl_45, + appl_50]) + Atom (B (False)) -> do do let !aw_52 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_52 [] + _ -> throwError "if: expected boolean"))) + !appl_53 <- kl_Parse_shen_LBformulaRB `pseq` kl_shen_LBsemicolon_symbolRB kl_Parse_shen_LBformulaRB + appl_53 `pseq` applyWrapper appl_40 [appl_53] + Atom (B (False)) -> do do let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_54 [] + _ -> throwError "if: expected boolean"))) + !appl_55 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB + !appl_56 <- appl_55 `pseq` tl appl_55 + let !aw_57 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_58 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_57 [kl_Parse_shen_LBformulaeRB] + let !aw_59 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_60 <- appl_56 `pseq` (appl_58 `pseq` applyWrapper aw_59 [appl_56, + appl_58]) + !appl_61 <- appl_60 `pseq` kl_shen_LBformulaRB appl_60 + appl_61 `pseq` applyWrapper appl_35 [appl_61] + Atom (B (False)) -> do do let !aw_62 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_62 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_63 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_63 [] + _ -> throwError "if: expected boolean"))) + !appl_64 <- kl_V2462 `pseq` kl_shen_LBformulaeRB kl_V2462 + !appl_65 <- appl_64 `pseq` applyWrapper appl_24 [appl_64] + appl_65 `pseq` applyWrapper appl_0 [appl_65] + +kl_shen_sequent :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_sequent (!kl_V2465) (!kl_V2466) = do kl_V2465 `pseq` (kl_V2466 `pseq` kl_Atp kl_V2465 kl_V2466) + +kl_shen_LBformulaeRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBformulaeRB (!kl_V2468) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !kl_if_7 <- kl_YaccParse `pseq` (appl_6 `pseq` eq kl_YaccParse appl_6) + case kl_if_7 of + Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Parse_LBeRB) -> do let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_10 <- applyWrapper aw_9 [] + !appl_11 <- appl_10 `pseq` (kl_Parse_LBeRB `pseq` eq appl_10 kl_Parse_LBeRB) + !kl_if_12 <- appl_11 `pseq` kl_not appl_11 + case kl_if_12 of + Atom (B (True)) -> do !appl_13 <- kl_Parse_LBeRB `pseq` hd kl_Parse_LBeRB + let !appl_14 = Atom Nil + let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_13 `pseq` (appl_14 `pseq` applyWrapper aw_15 [appl_13, + appl_14]) + Atom (B (False)) -> do do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_16 [] + _ -> throwError "if: expected boolean"))) + let !aw_17 = Core.Types.Atom (Core.Types.UnboundSym "") + !appl_18 <- kl_V2468 `pseq` applyWrapper aw_17 [kl_V2468] + appl_18 `pseq` applyWrapper appl_8 [appl_18] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_21 <- applyWrapper aw_20 [] + !appl_22 <- appl_21 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_21 kl_Parse_shen_LBformulaRB) + !kl_if_23 <- appl_22 `pseq` kl_not appl_22 + case kl_if_23 of + Atom (B (True)) -> do !appl_24 <- kl_Parse_shen_LBformulaRB `pseq` hd kl_Parse_shen_LBformulaRB + let !aw_25 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_26 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_25 [kl_Parse_shen_LBformulaRB] + let !appl_27 = Atom Nil + !appl_28 <- appl_26 `pseq` (appl_27 `pseq` klCons appl_26 appl_27) + let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_24 `pseq` (appl_28 `pseq` applyWrapper aw_29 [appl_24, + appl_28]) + Atom (B (False)) -> do do let !aw_30 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_30 [] + _ -> throwError "if: expected boolean"))) + !appl_31 <- kl_V2468 `pseq` kl_shen_LBformulaRB kl_V2468 + !appl_32 <- appl_31 `pseq` applyWrapper appl_19 [appl_31] + appl_32 `pseq` applyWrapper appl_4 [appl_32] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_33 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaRB) -> do let !aw_34 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_35 <- applyWrapper aw_34 [] + !appl_36 <- appl_35 `pseq` (kl_Parse_shen_LBformulaRB `pseq` eq appl_35 kl_Parse_shen_LBformulaRB) + !kl_if_37 <- appl_36 `pseq` kl_not appl_36 + case kl_if_37 of + Atom (B (True)) -> do let !appl_38 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBcomma_symbolRB) -> do let !aw_39 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_40 <- applyWrapper aw_39 [] + !appl_41 <- appl_40 `pseq` (kl_Parse_shen_LBcomma_symbolRB `pseq` eq appl_40 kl_Parse_shen_LBcomma_symbolRB) + !kl_if_42 <- appl_41 `pseq` kl_not appl_41 + case kl_if_42 of + Atom (B (True)) -> do let !appl_43 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBformulaeRB) -> do let !aw_44 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_45 <- applyWrapper aw_44 [] + !appl_46 <- appl_45 `pseq` (kl_Parse_shen_LBformulaeRB `pseq` eq appl_45 kl_Parse_shen_LBformulaeRB) + !kl_if_47 <- appl_46 `pseq` kl_not appl_46 + case kl_if_47 of + Atom (B (True)) -> do !appl_48 <- kl_Parse_shen_LBformulaeRB `pseq` hd kl_Parse_shen_LBformulaeRB + let !aw_49 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_50 <- kl_Parse_shen_LBformulaRB `pseq` applyWrapper aw_49 [kl_Parse_shen_LBformulaRB] + let !aw_51 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_52 <- kl_Parse_shen_LBformulaeRB `pseq` applyWrapper aw_51 [kl_Parse_shen_LBformulaeRB] + !appl_53 <- appl_50 `pseq` (appl_52 `pseq` klCons appl_50 appl_52) + let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_48 `pseq` (appl_53 `pseq` applyWrapper aw_54 [appl_48, + appl_53]) + Atom (B (False)) -> do do let !aw_55 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_55 [] + _ -> throwError "if: expected boolean"))) + !appl_56 <- kl_Parse_shen_LBcomma_symbolRB `pseq` kl_shen_LBformulaeRB kl_Parse_shen_LBcomma_symbolRB + appl_56 `pseq` applyWrapper appl_43 [appl_56] + Atom (B (False)) -> do do let !aw_57 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_57 [] + _ -> throwError "if: expected boolean"))) + !appl_58 <- kl_Parse_shen_LBformulaRB `pseq` kl_shen_LBcomma_symbolRB kl_Parse_shen_LBformulaRB + appl_58 `pseq` applyWrapper appl_38 [appl_58] + Atom (B (False)) -> do do let !aw_59 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_59 [] + _ -> throwError "if: expected boolean"))) + !appl_60 <- kl_V2468 `pseq` kl_shen_LBformulaRB kl_V2468 + !appl_61 <- appl_60 `pseq` applyWrapper appl_33 [appl_60] + appl_61 `pseq` applyWrapper appl_0 [appl_61] + +kl_shen_LBcomma_symbolRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBcomma_symbolRB (!kl_V2470) = do !appl_0 <- kl_V2470 `pseq` hd kl_V2470 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !appl_3 <- intern (Core.Types.Atom (Core.Types.Str ",")) + !kl_if_4 <- kl_Parse_X `pseq` (appl_3 `pseq` eq kl_Parse_X appl_3) + case kl_if_4 of + Atom (B (True)) -> do !appl_5 <- kl_V2470 `pseq` hd kl_V2470 + !appl_6 <- appl_5 `pseq` tl appl_5 + let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_8 <- kl_V2470 `pseq` applyWrapper aw_7 [kl_V2470] + let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_10 <- appl_6 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_6, + appl_8]) + !appl_11 <- appl_10 `pseq` hd appl_10 + let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_11 `pseq` applyWrapper aw_12 [appl_11, + Core.Types.Atom (Core.Types.UnboundSym "shen.skip")] + Atom (B (False)) -> do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_13 [] + _ -> throwError "if: expected boolean"))) + !appl_14 <- kl_V2470 `pseq` hd kl_V2470 + !appl_15 <- appl_14 `pseq` hd appl_14 + appl_15 `pseq` applyWrapper appl_2 [appl_15] + Atom (B (False)) -> do do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_16 [] + _ -> throwError "if: expected boolean" + +kl_shen_LBformulaRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBformulaRB (!kl_V2472) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_YaccParse) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- kl_YaccParse `pseq` (appl_2 `pseq` eq kl_YaccParse appl_2) + case kl_if_3 of + Atom (B (True)) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_6 <- applyWrapper aw_5 [] + !appl_7 <- appl_6 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_6 kl_Parse_shen_LBexprRB) + !kl_if_8 <- appl_7 `pseq` kl_not appl_7 + case kl_if_8 of + Atom (B (True)) -> do !appl_9 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB + let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_11 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_10 [kl_Parse_shen_LBexprRB] + let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_9 `pseq` (appl_11 `pseq` applyWrapper aw_12 [appl_9, + appl_11]) + Atom (B (False)) -> do do let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_13 [] + _ -> throwError "if: expected boolean"))) + !appl_14 <- kl_V2472 `pseq` kl_shen_LBexprRB kl_V2472 + appl_14 `pseq` applyWrapper appl_4 [appl_14] + Atom (B (False)) -> do do return kl_YaccParse + _ -> throwError "if: expected boolean"))) + let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_17 <- applyWrapper aw_16 [] + !appl_18 <- appl_17 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_17 kl_Parse_shen_LBexprRB) + !kl_if_19 <- appl_18 `pseq` kl_not appl_18 + case kl_if_19 of + Atom (B (True)) -> do !appl_20 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB + !kl_if_21 <- appl_20 `pseq` consP appl_20 + !kl_if_22 <- case kl_if_21 of + Atom (B (True)) -> do !appl_23 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB + !appl_24 <- appl_23 `pseq` hd appl_23 + !kl_if_25 <- appl_24 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym ":")) appl_24 + case kl_if_25 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_22 of + Atom (B (True)) -> do let !appl_26 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBtypeRB) -> do let !aw_27 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_28 <- applyWrapper aw_27 [] + !appl_29 <- appl_28 `pseq` (kl_Parse_shen_LBtypeRB `pseq` eq appl_28 kl_Parse_shen_LBtypeRB) + !kl_if_30 <- appl_29 `pseq` kl_not appl_29 + case kl_if_30 of + Atom (B (True)) -> do !appl_31 <- kl_Parse_shen_LBtypeRB `pseq` hd kl_Parse_shen_LBtypeRB + let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_33 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_32 [kl_Parse_shen_LBexprRB] + let !aw_34 = Core.Types.Atom (Core.Types.UnboundSym "shen.curry") + !appl_35 <- appl_33 `pseq` applyWrapper aw_34 [appl_33] + let !aw_36 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_37 <- kl_Parse_shen_LBtypeRB `pseq` applyWrapper aw_36 [kl_Parse_shen_LBtypeRB] + let !aw_38 = Core.Types.Atom (Core.Types.UnboundSym "shen.demodulate") + !appl_39 <- appl_37 `pseq` applyWrapper aw_38 [appl_37] + let !appl_40 = Atom Nil + !appl_41 <- appl_39 `pseq` (appl_40 `pseq` klCons appl_39 appl_40) + !appl_42 <- appl_41 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":")) appl_41 + !appl_43 <- appl_35 `pseq` (appl_42 `pseq` klCons appl_35 appl_42) + let !aw_44 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_31 `pseq` (appl_43 `pseq` applyWrapper aw_44 [appl_31, + appl_43]) + Atom (B (False)) -> do do let !aw_45 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_45 [] + _ -> throwError "if: expected boolean"))) + !appl_46 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB + !appl_47 <- appl_46 `pseq` tl appl_46 + let !aw_48 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_49 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_48 [kl_Parse_shen_LBexprRB] + let !aw_50 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_51 <- appl_47 `pseq` (appl_49 `pseq` applyWrapper aw_50 [appl_47, + appl_49]) + !appl_52 <- appl_51 `pseq` kl_shen_LBtypeRB appl_51 + appl_52 `pseq` applyWrapper appl_26 [appl_52] + Atom (B (False)) -> do do let !aw_53 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_53 [] + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_54 [] + _ -> throwError "if: expected boolean"))) + !appl_55 <- kl_V2472 `pseq` kl_shen_LBexprRB kl_V2472 + !appl_56 <- appl_55 `pseq` applyWrapper appl_15 [appl_55] + appl_56 `pseq` applyWrapper appl_0 [appl_56] + +kl_shen_LBtypeRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBtypeRB (!kl_V2474) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Parse_shen_LBexprRB) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !appl_3 <- appl_2 `pseq` (kl_Parse_shen_LBexprRB `pseq` eq appl_2 kl_Parse_shen_LBexprRB) + !kl_if_4 <- appl_3 `pseq` kl_not appl_3 + case kl_if_4 of + Atom (B (True)) -> do !appl_5 <- kl_Parse_shen_LBexprRB `pseq` hd kl_Parse_shen_LBexprRB + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_7 <- kl_Parse_shen_LBexprRB `pseq` applyWrapper aw_6 [kl_Parse_shen_LBexprRB] + !appl_8 <- appl_7 `pseq` kl_shen_curry_type appl_7 + let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_5 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_5, + appl_8]) + Atom (B (False)) -> do do let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_10 [] + _ -> throwError "if: expected boolean"))) + !appl_11 <- kl_V2474 `pseq` kl_shen_LBexprRB kl_V2474 + appl_11 `pseq` applyWrapper appl_0 [appl_11] + +kl_shen_LBdoubleunderlineRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBdoubleunderlineRB (!kl_V2476) = do !appl_0 <- kl_V2476 `pseq` hd kl_V2476 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !kl_if_3 <- kl_Parse_X `pseq` kl_shen_doubleunderlineP kl_Parse_X + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_V2476 `pseq` hd kl_V2476 + !appl_5 <- appl_4 `pseq` tl appl_4 + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_7 <- kl_V2476 `pseq` applyWrapper aw_6 [kl_V2476] + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, + appl_7]) + !appl_10 <- appl_9 `pseq` hd appl_9 + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_10 `pseq` (kl_Parse_X `pseq` applyWrapper aw_11 [appl_10, + kl_Parse_X]) + Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_12 [] + _ -> throwError "if: expected boolean"))) + !appl_13 <- kl_V2476 `pseq` hd kl_V2476 + !appl_14 <- appl_13 `pseq` hd appl_13 + appl_14 `pseq` applyWrapper appl_2 [appl_14] + Atom (B (False)) -> do do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_15 [] + _ -> throwError "if: expected boolean" + +kl_shen_LBsingleunderlineRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LBsingleunderlineRB (!kl_V2478) = do !appl_0 <- kl_V2478 `pseq` hd kl_V2478 + !kl_if_1 <- appl_0 `pseq` consP appl_0 + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Parse_X) -> do !kl_if_3 <- kl_Parse_X `pseq` kl_shen_singleunderlineP kl_Parse_X + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_V2478 `pseq` hd kl_V2478 + !appl_5 <- appl_4 `pseq` tl appl_4 + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + !appl_7 <- kl_V2478 `pseq` applyWrapper aw_6 [kl_V2478] + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + !appl_9 <- appl_5 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_5, + appl_7]) + !appl_10 <- appl_9 `pseq` hd appl_9 + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.pair") + appl_10 `pseq` (kl_Parse_X `pseq` applyWrapper aw_11 [appl_10, + kl_Parse_X]) + Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_12 [] + _ -> throwError "if: expected boolean"))) + !appl_13 <- kl_V2478 `pseq` hd kl_V2478 + !appl_14 <- appl_13 `pseq` hd appl_13 + appl_14 `pseq` applyWrapper appl_2 [appl_14] + Atom (B (False)) -> do do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_15 [] + _ -> throwError "if: expected boolean" + +kl_shen_singleunderlineP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_singleunderlineP (!kl_V2480) = do !kl_if_0 <- kl_V2480 `pseq` kl_symbolP kl_V2480 + case kl_if_0 of + Atom (B (True)) -> do !appl_1 <- kl_V2480 `pseq` str kl_V2480 + !kl_if_2 <- appl_1 `pseq` kl_shen_shP appl_1 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + +kl_shen_shP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_shP (!kl_V2482) = do let pat_cond_0 = do return (Atom (B True)) + pat_cond_1 = do do !appl_2 <- kl_V2482 `pseq` pos kl_V2482 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_3 <- appl_2 `pseq` eq appl_2 (Core.Types.Atom (Core.Types.Str "_")) + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_V2482 `pseq` tlstr kl_V2482 + !kl_if_5 <- appl_4 `pseq` kl_shen_shP appl_4 + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + in case kl_V2482 of + kl_V2482@(Atom (Str "_")) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_doubleunderlineP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_doubleunderlineP (!kl_V2484) = do !kl_if_0 <- kl_V2484 `pseq` kl_symbolP kl_V2484 + case kl_if_0 of + Atom (B (True)) -> do !appl_1 <- kl_V2484 `pseq` str kl_V2484 + !kl_if_2 <- appl_1 `pseq` kl_shen_dhP appl_1 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + +kl_shen_dhP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_dhP (!kl_V2486) = do let pat_cond_0 = do return (Atom (B True)) + pat_cond_1 = do do !appl_2 <- kl_V2486 `pseq` pos kl_V2486 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_3 <- appl_2 `pseq` eq appl_2 (Core.Types.Atom (Core.Types.Str "=")) + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_V2486 `pseq` tlstr kl_V2486 + !kl_if_5 <- appl_4 `pseq` kl_shen_dhP appl_4 + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + in case kl_V2486 of + kl_V2486@(Atom (Str "=")) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_process_datatype :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_process_datatype (!kl_V2489) (!kl_V2490) = do !appl_0 <- kl_V2489 `pseq` (kl_V2490 `pseq` kl_shen_rules_RBhorn_clauses kl_V2489 kl_V2490) + let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.s-prolog") + !appl_2 <- appl_0 `pseq` applyWrapper aw_1 [appl_0] + appl_2 `pseq` kl_shen_remember_datatype appl_2 + +kl_shen_remember_datatype :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_remember_datatype (!kl_V2496) = do let pat_cond_0 kl_V2496 kl_V2496h kl_V2496t = do !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "adjoin") + !appl_3 <- kl_V2496h `pseq` (appl_1 `pseq` applyWrapper aw_2 [kl_V2496h, + appl_1]) + !appl_4 <- appl_3 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) appl_3 + !appl_5 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*alldatatypes*")) + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "adjoin") + !appl_7 <- kl_V2496h `pseq` (appl_5 `pseq` applyWrapper aw_6 [kl_V2496h, + appl_5]) + !appl_8 <- appl_7 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*alldatatypes*")) appl_7 + !appl_9 <- appl_8 `pseq` (kl_V2496h `pseq` kl_do appl_8 kl_V2496h) + appl_4 `pseq` (appl_9 `pseq` kl_do appl_4 appl_9) + pat_cond_10 = do do let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_11 [ApplC (wrapNamed "shen.remember-datatype" kl_shen_remember_datatype)] + in case kl_V2496 of + !(kl_V2496@(Cons (!kl_V2496h) + (!kl_V2496t))) -> pat_cond_0 kl_V2496 kl_V2496h kl_V2496t + _ -> pat_cond_10 + +kl_shen_rules_RBhorn_clauses :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_rules_RBhorn_clauses (!kl_V2501) (!kl_V2502) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2502 `pseq` eq appl_0 kl_V2502) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V2502 kl_V2502h kl_V2502t = do !kl_if_4 <- kl_V2502h `pseq` kl_tupleP kl_V2502h + !kl_if_5 <- case kl_if_4 of + Atom (B (True)) -> do !appl_6 <- kl_V2502h `pseq` kl_fst kl_V2502h + !kl_if_7 <- appl_6 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "shen.single")) appl_6 + case kl_if_7 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_8 = do do return (Atom (B False)) + in case kl_V2502 of + !(kl_V2502@(Cons (!kl_V2502h) + (!kl_V2502t))) -> pat_cond_3 kl_V2502 kl_V2502h kl_V2502t + _ -> pat_cond_8 + case kl_if_2 of + Atom (B (True)) -> do !appl_9 <- kl_V2502 `pseq` hd kl_V2502 + !appl_10 <- appl_9 `pseq` kl_snd appl_9 + !appl_11 <- kl_V2501 `pseq` (appl_10 `pseq` kl_shen_rule_RBhorn_clause kl_V2501 appl_10) + !appl_12 <- kl_V2502 `pseq` tl kl_V2502 + !appl_13 <- kl_V2501 `pseq` (appl_12 `pseq` kl_shen_rules_RBhorn_clauses kl_V2501 appl_12) + appl_11 `pseq` (appl_13 `pseq` klCons appl_11 appl_13) + Atom (B (False)) -> do !kl_if_14 <- let pat_cond_15 kl_V2502 kl_V2502h kl_V2502t = do !kl_if_16 <- kl_V2502h `pseq` kl_tupleP kl_V2502h + !kl_if_17 <- case kl_if_16 of + Atom (B (True)) -> do !appl_18 <- kl_V2502h `pseq` kl_fst kl_V2502h + !kl_if_19 <- appl_18 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "shen.double")) appl_18 + case kl_if_19 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_17 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_20 = do do return (Atom (B False)) + in case kl_V2502 of + !(kl_V2502@(Cons (!kl_V2502h) + (!kl_V2502t))) -> pat_cond_15 kl_V2502 kl_V2502h kl_V2502t + _ -> pat_cond_20 + case kl_if_14 of + Atom (B (True)) -> do !appl_21 <- kl_V2502 `pseq` hd kl_V2502 + !appl_22 <- appl_21 `pseq` kl_snd appl_21 + !appl_23 <- appl_22 `pseq` kl_shen_double_RBsingles appl_22 + !appl_24 <- kl_V2502 `pseq` tl kl_V2502 + !appl_25 <- appl_23 `pseq` (appl_24 `pseq` kl_append appl_23 appl_24) + kl_V2501 `pseq` (appl_25 `pseq` kl_shen_rules_RBhorn_clauses kl_V2501 appl_25) + Atom (B (False)) -> do do let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_26 [ApplC (wrapNamed "shen.rules->horn-clauses" kl_shen_rules_RBhorn_clauses)] + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_double_RBsingles :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_double_RBsingles (!kl_V2504) = do !appl_0 <- kl_V2504 `pseq` kl_shen_right_rule kl_V2504 + !appl_1 <- kl_V2504 `pseq` kl_shen_left_rule kl_V2504 + let !appl_2 = Atom Nil + !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) + appl_0 `pseq` (appl_3 `pseq` klCons appl_0 appl_3) + +kl_shen_right_rule :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_right_rule (!kl_V2506) = do kl_V2506 `pseq` kl_Atp (Core.Types.Atom (Core.Types.UnboundSym "shen.single")) kl_V2506 + +kl_shen_left_rule :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_left_rule (!kl_V2508) = do !kl_if_0 <- let pat_cond_1 kl_V2508 kl_V2508h kl_V2508t = do !kl_if_2 <- let pat_cond_3 kl_V2508t kl_V2508th kl_V2508tt = do !kl_if_4 <- let pat_cond_5 kl_V2508tt kl_V2508tth kl_V2508ttt = do !kl_if_6 <- kl_V2508tth `pseq` kl_tupleP kl_V2508tth + !kl_if_7 <- case kl_if_6 of + Atom (B (True)) -> do let !appl_8 = Atom Nil + !appl_9 <- kl_V2508tth `pseq` kl_fst kl_V2508tth + !kl_if_10 <- appl_8 `pseq` (appl_9 `pseq` eq appl_8 appl_9) + !kl_if_11 <- case kl_if_10 of + Atom (B (True)) -> do let !appl_12 = Atom Nil + !kl_if_13 <- appl_12 `pseq` (kl_V2508ttt `pseq` eq appl_12 kl_V2508ttt) + case kl_if_13 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_7 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_14 = do do return (Atom (B False)) + in case kl_V2508tt of + !(kl_V2508tt@(Cons (!kl_V2508tth) + (!kl_V2508ttt))) -> pat_cond_5 kl_V2508tt kl_V2508tth kl_V2508ttt + _ -> pat_cond_14 + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_15 = do do return (Atom (B False)) + in case kl_V2508t of + !(kl_V2508t@(Cons (!kl_V2508th) + (!kl_V2508tt))) -> pat_cond_3 kl_V2508t kl_V2508th kl_V2508tt + _ -> pat_cond_15 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_16 = do do return (Atom (B False)) + in case kl_V2508 of + !(kl_V2508@(Cons (!kl_V2508h) + (!kl_V2508t))) -> pat_cond_1 kl_V2508 kl_V2508h kl_V2508t + _ -> pat_cond_16 + case kl_if_0 of + Atom (B (True)) -> do let !appl_17 = ApplC (Func "lambda" (Context (\(!kl_Q) -> do let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_NewConclusion) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_NewPremises) -> do !appl_20 <- kl_V2508 `pseq` hd kl_V2508 + let !appl_21 = Atom Nil + !appl_22 <- kl_NewConclusion `pseq` (appl_21 `pseq` klCons kl_NewConclusion appl_21) + !appl_23 <- kl_NewPremises `pseq` (appl_22 `pseq` klCons kl_NewPremises appl_22) + !appl_24 <- appl_20 `pseq` (appl_23 `pseq` klCons appl_20 appl_23) + appl_24 `pseq` kl_Atp (Core.Types.Atom (Core.Types.UnboundSym "shen.single")) appl_24))) + let !appl_25 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_right_RBleft kl_X))) + !appl_26 <- kl_V2508 `pseq` tl kl_V2508 + !appl_27 <- appl_26 `pseq` hd appl_26 + !appl_28 <- appl_25 `pseq` (appl_27 `pseq` kl_map appl_25 appl_27) + !appl_29 <- appl_28 `pseq` (kl_Q `pseq` kl_Atp appl_28 kl_Q) + let !appl_30 = Atom Nil + !appl_31 <- appl_29 `pseq` (appl_30 `pseq` klCons appl_29 appl_30) + appl_31 `pseq` applyWrapper appl_19 [appl_31]))) + !appl_32 <- kl_V2508 `pseq` tl kl_V2508 + !appl_33 <- appl_32 `pseq` tl appl_32 + !appl_34 <- appl_33 `pseq` hd appl_33 + !appl_35 <- appl_34 `pseq` kl_snd appl_34 + let !appl_36 = Atom Nil + !appl_37 <- appl_35 `pseq` (appl_36 `pseq` klCons appl_35 appl_36) + !appl_38 <- appl_37 `pseq` (kl_Q `pseq` kl_Atp appl_37 kl_Q) + appl_38 `pseq` applyWrapper appl_18 [appl_38]))) + !appl_39 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "Qv")) + appl_39 `pseq` applyWrapper appl_17 [appl_39] + Atom (B (False)) -> do do let !aw_40 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_40 [ApplC (wrapNamed "shen.left-rule" kl_shen_left_rule)] + _ -> throwError "if: expected boolean" + +kl_shen_right_RBleft :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_right_RBleft (!kl_V2514) = do !kl_if_0 <- kl_V2514 `pseq` kl_tupleP kl_V2514 + !kl_if_1 <- case kl_if_0 of + Atom (B (True)) -> do let !appl_2 = Atom Nil + !appl_3 <- kl_V2514 `pseq` kl_fst kl_V2514 + !kl_if_4 <- appl_2 `pseq` (appl_3 `pseq` eq appl_2 appl_3) + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_1 of + Atom (B (True)) -> do kl_V2514 `pseq` kl_snd kl_V2514 + Atom (B (False)) -> do do simpleError (Core.Types.Atom (Core.Types.Str "syntax error with ==========\n")) + _ -> throwError "if: expected boolean" + +kl_shen_rule_RBhorn_clause :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_rule_RBhorn_clause (!kl_V2517) (!kl_V2518) = do !kl_if_0 <- let pat_cond_1 kl_V2518 kl_V2518h kl_V2518t = do !kl_if_2 <- let pat_cond_3 kl_V2518t kl_V2518th kl_V2518tt = do !kl_if_4 <- let pat_cond_5 kl_V2518tt kl_V2518tth kl_V2518ttt = do !kl_if_6 <- kl_V2518tth `pseq` kl_tupleP kl_V2518tth + !kl_if_7 <- case kl_if_6 of + Atom (B (True)) -> do let !appl_8 = Atom Nil + !kl_if_9 <- appl_8 `pseq` (kl_V2518ttt `pseq` eq appl_8 kl_V2518ttt) + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_7 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_10 = do do return (Atom (B False)) + in case kl_V2518tt of + !(kl_V2518tt@(Cons (!kl_V2518tth) + (!kl_V2518ttt))) -> pat_cond_5 kl_V2518tt kl_V2518tth kl_V2518ttt + _ -> pat_cond_10 + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_11 = do do return (Atom (B False)) + in case kl_V2518t of + !(kl_V2518t@(Cons (!kl_V2518th) + (!kl_V2518tt))) -> pat_cond_3 kl_V2518t kl_V2518th kl_V2518tt + _ -> pat_cond_11 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V2518 of + !(kl_V2518@(Cons (!kl_V2518h) + (!kl_V2518t))) -> pat_cond_1 kl_V2518 kl_V2518h kl_V2518t + _ -> pat_cond_12 + case kl_if_0 of + Atom (B (True)) -> do !appl_13 <- kl_V2518 `pseq` tl kl_V2518 + !appl_14 <- appl_13 `pseq` tl appl_13 + !appl_15 <- appl_14 `pseq` hd appl_14 + !appl_16 <- appl_15 `pseq` kl_snd appl_15 + !appl_17 <- kl_V2517 `pseq` (appl_16 `pseq` kl_shen_rule_RBhorn_clause_head kl_V2517 appl_16) + !appl_18 <- kl_V2518 `pseq` hd kl_V2518 + !appl_19 <- kl_V2518 `pseq` tl kl_V2518 + !appl_20 <- appl_19 `pseq` hd appl_19 + !appl_21 <- kl_V2518 `pseq` tl kl_V2518 + !appl_22 <- appl_21 `pseq` tl appl_21 + !appl_23 <- appl_22 `pseq` hd appl_22 + !appl_24 <- appl_23 `pseq` kl_fst appl_23 + !appl_25 <- appl_18 `pseq` (appl_20 `pseq` (appl_24 `pseq` kl_shen_rule_RBhorn_clause_body appl_18 appl_20 appl_24)) + let !appl_26 = Atom Nil + !appl_27 <- appl_25 `pseq` (appl_26 `pseq` klCons appl_25 appl_26) + !appl_28 <- appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":-")) appl_27 + appl_17 `pseq` (appl_28 `pseq` klCons appl_17 appl_28) + Atom (B (False)) -> do do let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_29 [ApplC (wrapNamed "shen.rule->horn-clause" kl_shen_rule_RBhorn_clause)] + _ -> throwError "if: expected boolean" + +kl_shen_rule_RBhorn_clause_head :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_rule_RBhorn_clause_head (!kl_V2521) (!kl_V2522) = do !appl_0 <- kl_V2522 `pseq` kl_shen_mode_ify kl_V2522 + let !appl_1 = Atom Nil + !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Context_1957")) appl_1 + !appl_3 <- appl_0 `pseq` (appl_2 `pseq` klCons appl_0 appl_2) + kl_V2521 `pseq` (appl_3 `pseq` klCons kl_V2521 appl_3) + +kl_shen_mode_ify :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_mode_ify (!kl_V2524) = do !kl_if_0 <- let pat_cond_1 kl_V2524 kl_V2524h kl_V2524t = do !kl_if_2 <- let pat_cond_3 kl_V2524t kl_V2524th kl_V2524tt = do !kl_if_4 <- let pat_cond_5 = do !kl_if_6 <- let pat_cond_7 kl_V2524tt kl_V2524tth kl_V2524ttt = do let !appl_8 = Atom Nil + !kl_if_9 <- appl_8 `pseq` (kl_V2524ttt `pseq` eq appl_8 kl_V2524ttt) + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_10 = do do return (Atom (B False)) + in case kl_V2524tt of + !(kl_V2524tt@(Cons (!kl_V2524tth) + (!kl_V2524ttt))) -> pat_cond_7 kl_V2524tt kl_V2524tth kl_V2524ttt + _ -> pat_cond_10 + case kl_if_6 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_11 = do do return (Atom (B False)) + in case kl_V2524th of + kl_V2524th@(Atom (UnboundSym ":")) -> pat_cond_5 + kl_V2524th@(ApplC (PL ":" + _)) -> pat_cond_5 + kl_V2524th@(ApplC (Func ":" + _)) -> pat_cond_5 + _ -> pat_cond_11 + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V2524t of + !(kl_V2524t@(Cons (!kl_V2524th) + (!kl_V2524tt))) -> pat_cond_3 kl_V2524t kl_V2524th kl_V2524tt + _ -> pat_cond_12 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_13 = do do return (Atom (B False)) + in case kl_V2524 of + !(kl_V2524@(Cons (!kl_V2524h) + (!kl_V2524t))) -> pat_cond_1 kl_V2524 kl_V2524h kl_V2524t + _ -> pat_cond_13 + case kl_if_0 of + Atom (B (True)) -> do !appl_14 <- kl_V2524 `pseq` hd kl_V2524 + !appl_15 <- kl_V2524 `pseq` tl kl_V2524 + !appl_16 <- appl_15 `pseq` tl appl_15 + !appl_17 <- appl_16 `pseq` hd appl_16 + let !appl_18 = Atom Nil + !appl_19 <- appl_18 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_18 + !appl_20 <- appl_17 `pseq` (appl_19 `pseq` klCons appl_17 appl_19) + !appl_21 <- appl_20 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "mode")) appl_20 + let !appl_22 = Atom Nil + !appl_23 <- appl_21 `pseq` (appl_22 `pseq` klCons appl_21 appl_22) + !appl_24 <- appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":")) appl_23 + !appl_25 <- appl_14 `pseq` (appl_24 `pseq` klCons appl_14 appl_24) + let !appl_26 = Atom Nil + !appl_27 <- appl_26 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_26 + !appl_28 <- appl_25 `pseq` (appl_27 `pseq` klCons appl_25 appl_27) + appl_28 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "mode")) appl_28 + Atom (B (False)) -> do do return kl_V2524 + _ -> throwError "if: expected boolean" + +kl_shen_rule_RBhorn_clause_body :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_rule_RBhorn_clause_body (!kl_V2528) (!kl_V2529) (!kl_V2530) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Variables) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Predicates) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_SearchLiterals) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_SearchClauses) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_SideLiterals) -> do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_PremissLiterals) -> do !appl_6 <- kl_SideLiterals `pseq` (kl_PremissLiterals `pseq` kl_append kl_SideLiterals kl_PremissLiterals) + kl_SearchLiterals `pseq` (appl_6 `pseq` kl_append kl_SearchLiterals appl_6)))) + let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_8 <- kl_V2530 `pseq` kl_emptyP kl_V2530 + kl_X `pseq` (appl_8 `pseq` kl_shen_construct_premiss_literal kl_X appl_8)))) + !appl_9 <- appl_7 `pseq` (kl_V2529 `pseq` kl_map appl_7 kl_V2529) + appl_9 `pseq` applyWrapper appl_5 [appl_9]))) + !appl_10 <- kl_V2528 `pseq` kl_shen_construct_side_literals kl_V2528 + appl_10 `pseq` applyWrapper appl_4 [appl_10]))) + !appl_11 <- kl_Predicates `pseq` (kl_V2530 `pseq` (kl_Variables `pseq` kl_shen_construct_search_clauses kl_Predicates kl_V2530 kl_Variables)) + appl_11 `pseq` applyWrapper appl_3 [appl_11]))) + !appl_12 <- kl_Predicates `pseq` (kl_Variables `pseq` kl_shen_construct_search_literals kl_Predicates kl_Variables (Core.Types.Atom (Core.Types.UnboundSym "Context_1957")) (Core.Types.Atom (Core.Types.UnboundSym "Context1_1957"))) + appl_12 `pseq` applyWrapper appl_2 [appl_12]))) + let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "shen.cl"))))) + !appl_14 <- appl_13 `pseq` (kl_V2530 `pseq` kl_map appl_13 kl_V2530) + appl_14 `pseq` applyWrapper appl_1 [appl_14]))) + let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_extract_vars kl_X))) + !appl_16 <- appl_15 `pseq` (kl_V2530 `pseq` kl_map appl_15 kl_V2530) + appl_16 `pseq` applyWrapper appl_0 [appl_16] + +kl_shen_construct_search_literals :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_construct_search_literals (!kl_V2539) (!kl_V2540) (!kl_V2541) (!kl_V2542) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2539 `pseq` eq appl_0 kl_V2539) + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do let !appl_3 = Atom Nil + !kl_if_4 <- appl_3 `pseq` (kl_V2540 `pseq` eq appl_3 kl_V2540) + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_2 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do do kl_V2539 `pseq` (kl_V2540 `pseq` (kl_V2541 `pseq` (kl_V2542 `pseq` kl_shen_csl_help kl_V2539 kl_V2540 kl_V2541 kl_V2542))) + _ -> throwError "if: expected boolean" + +kl_shen_csl_help :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_csl_help (!kl_V2549) (!kl_V2550) (!kl_V2551) (!kl_V2552) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2549 `pseq` eq appl_0 kl_V2549) + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do let !appl_3 = Atom Nil + !kl_if_4 <- appl_3 `pseq` (kl_V2550 `pseq` eq appl_3 kl_V2550) + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_2 of + Atom (B (True)) -> do let !appl_5 = Atom Nil + !appl_6 <- kl_V2551 `pseq` (appl_5 `pseq` klCons kl_V2551 appl_5) + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "ContextOut_1957")) appl_6 + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "bind")) appl_7 + let !appl_9 = Atom Nil + appl_8 `pseq` (appl_9 `pseq` klCons appl_8 appl_9) + Atom (B (False)) -> do !kl_if_10 <- let pat_cond_11 kl_V2549 kl_V2549h kl_V2549t = do let pat_cond_12 kl_V2550 kl_V2550h kl_V2550t = do return (Atom (B True)) + pat_cond_13 = do do return (Atom (B False)) + in case kl_V2550 of + !(kl_V2550@(Cons (!kl_V2550h) + (!kl_V2550t))) -> pat_cond_12 kl_V2550 kl_V2550h kl_V2550t + _ -> pat_cond_13 + pat_cond_14 = do do return (Atom (B False)) + in case kl_V2549 of + !(kl_V2549@(Cons (!kl_V2549h) + (!kl_V2549t))) -> pat_cond_11 kl_V2549 kl_V2549h kl_V2549t + _ -> pat_cond_14 + case kl_if_10 of + Atom (B (True)) -> do !appl_15 <- kl_V2549 `pseq` hd kl_V2549 + !appl_16 <- kl_V2550 `pseq` hd kl_V2550 + !appl_17 <- kl_V2552 `pseq` (appl_16 `pseq` klCons kl_V2552 appl_16) + !appl_18 <- kl_V2551 `pseq` (appl_17 `pseq` klCons kl_V2551 appl_17) + !appl_19 <- appl_15 `pseq` (appl_18 `pseq` klCons appl_15 appl_18) + !appl_20 <- kl_V2549 `pseq` tl kl_V2549 + !appl_21 <- kl_V2550 `pseq` tl kl_V2550 + !appl_22 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "Context")) + !appl_23 <- appl_20 `pseq` (appl_21 `pseq` (kl_V2552 `pseq` (appl_22 `pseq` kl_shen_csl_help appl_20 appl_21 kl_V2552 appl_22))) + appl_19 `pseq` (appl_23 `pseq` klCons appl_19 appl_23) + Atom (B (False)) -> do do let !aw_24 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_24 [ApplC (wrapNamed "shen.csl-help" kl_shen_csl_help)] + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_construct_search_clauses :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_construct_search_clauses (!kl_V2556) (!kl_V2557) (!kl_V2558) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2556 `pseq` eq appl_0 kl_V2556) + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do let !appl_3 = Atom Nil + !kl_if_4 <- appl_3 `pseq` (kl_V2557 `pseq` eq appl_3 kl_V2557) + !kl_if_5 <- case kl_if_4 of + Atom (B (True)) -> do let !appl_6 = Atom Nil + !kl_if_7 <- appl_6 `pseq` (kl_V2558 `pseq` eq appl_6 kl_V2558) + case kl_if_7 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_2 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do !kl_if_8 <- let pat_cond_9 kl_V2556 kl_V2556h kl_V2556t = do !kl_if_10 <- let pat_cond_11 kl_V2557 kl_V2557h kl_V2557t = do let pat_cond_12 kl_V2558 kl_V2558h kl_V2558t = do return (Atom (B True)) + pat_cond_13 = do do return (Atom (B False)) + in case kl_V2558 of + !(kl_V2558@(Cons (!kl_V2558h) + (!kl_V2558t))) -> pat_cond_12 kl_V2558 kl_V2558h kl_V2558t + _ -> pat_cond_13 + pat_cond_14 = do do return (Atom (B False)) + in case kl_V2557 of + !(kl_V2557@(Cons (!kl_V2557h) + (!kl_V2557t))) -> pat_cond_11 kl_V2557 kl_V2557h kl_V2557t + _ -> pat_cond_14 + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_15 = do do return (Atom (B False)) + in case kl_V2556 of + !(kl_V2556@(Cons (!kl_V2556h) + (!kl_V2556t))) -> pat_cond_9 kl_V2556 kl_V2556h kl_V2556t + _ -> pat_cond_15 + case kl_if_8 of + Atom (B (True)) -> do !appl_16 <- kl_V2556 `pseq` hd kl_V2556 + !appl_17 <- kl_V2557 `pseq` hd kl_V2557 + !appl_18 <- kl_V2558 `pseq` hd kl_V2558 + !appl_19 <- appl_16 `pseq` (appl_17 `pseq` (appl_18 `pseq` kl_shen_construct_search_clause appl_16 appl_17 appl_18)) + !appl_20 <- kl_V2556 `pseq` tl kl_V2556 + !appl_21 <- kl_V2557 `pseq` tl kl_V2557 + !appl_22 <- kl_V2558 `pseq` tl kl_V2558 + !appl_23 <- appl_20 `pseq` (appl_21 `pseq` (appl_22 `pseq` kl_shen_construct_search_clauses appl_20 appl_21 appl_22)) + appl_19 `pseq` (appl_23 `pseq` kl_do appl_19 appl_23) + Atom (B (False)) -> do do let !aw_24 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_24 [ApplC (wrapNamed "shen.construct-search-clauses" kl_shen_construct_search_clauses)] + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_construct_search_clause :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_construct_search_clause (!kl_V2562) (!kl_V2563) (!kl_V2564) = do !appl_0 <- kl_V2562 `pseq` (kl_V2563 `pseq` (kl_V2564 `pseq` kl_shen_construct_base_search_clause kl_V2562 kl_V2563 kl_V2564)) + !appl_1 <- kl_V2562 `pseq` (kl_V2563 `pseq` (kl_V2564 `pseq` kl_shen_construct_recursive_search_clause kl_V2562 kl_V2563 kl_V2564)) + let !appl_2 = Atom Nil + !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) + !appl_4 <- appl_0 `pseq` (appl_3 `pseq` klCons appl_0 appl_3) + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.s-prolog") + appl_4 `pseq` applyWrapper aw_5 [appl_4] + +kl_shen_construct_base_search_clause :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_construct_base_search_clause (!kl_V2568) (!kl_V2569) (!kl_V2570) = do !appl_0 <- kl_V2569 `pseq` kl_shen_mode_ify kl_V2569 + !appl_1 <- appl_0 `pseq` klCons appl_0 (Core.Types.Atom (Core.Types.UnboundSym "In_1957")) + !appl_2 <- kl_V2570 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "In_1957")) kl_V2570 + !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) + !appl_4 <- kl_V2568 `pseq` (appl_3 `pseq` klCons kl_V2568 appl_3) + let !appl_5 = Atom Nil + let !appl_6 = Atom Nil + !appl_7 <- appl_5 `pseq` (appl_6 `pseq` klCons appl_5 appl_6) + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":-")) appl_7 + appl_4 `pseq` (appl_8 `pseq` klCons appl_4 appl_8) + +kl_shen_construct_recursive_search_clause :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_construct_recursive_search_clause (!kl_V2574) (!kl_V2575) (!kl_V2576) = do !appl_0 <- klCons (Core.Types.Atom (Core.Types.UnboundSym "Assumption_1957")) (Core.Types.Atom (Core.Types.UnboundSym "Assumptions_1957")) + !appl_1 <- klCons (Core.Types.Atom (Core.Types.UnboundSym "Assumption_1957")) (Core.Types.Atom (Core.Types.UnboundSym "Out_1957")) + !appl_2 <- appl_1 `pseq` (kl_V2576 `pseq` klCons appl_1 kl_V2576) + !appl_3 <- appl_0 `pseq` (appl_2 `pseq` klCons appl_0 appl_2) + !appl_4 <- kl_V2574 `pseq` (appl_3 `pseq` klCons kl_V2574 appl_3) + !appl_5 <- kl_V2576 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Out_1957")) kl_V2576 + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Assumptions_1957")) appl_5 + !appl_7 <- kl_V2574 `pseq` (appl_6 `pseq` klCons kl_V2574 appl_6) + let !appl_8 = Atom Nil + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` klCons appl_7 appl_8) + let !appl_10 = Atom Nil + !appl_11 <- appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) + !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":-")) appl_11 + appl_4 `pseq` (appl_12 `pseq` klCons appl_4 appl_12) + +kl_shen_construct_side_literals :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_construct_side_literals (!kl_V2582) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2582 `pseq` eq appl_0 kl_V2582) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V2582 kl_V2582h kl_V2582t = do !kl_if_4 <- let pat_cond_5 kl_V2582h kl_V2582hh kl_V2582ht = do !kl_if_6 <- let pat_cond_7 = do !kl_if_8 <- let pat_cond_9 kl_V2582ht kl_V2582hth kl_V2582htt = do let !appl_10 = Atom Nil + !kl_if_11 <- appl_10 `pseq` (kl_V2582htt `pseq` eq appl_10 kl_V2582htt) + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V2582ht of + !(kl_V2582ht@(Cons (!kl_V2582hth) + (!kl_V2582htt))) -> pat_cond_9 kl_V2582ht kl_V2582hth kl_V2582htt + _ -> pat_cond_12 + case kl_if_8 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_13 = do do return (Atom (B False)) + in case kl_V2582hh of + kl_V2582hh@(Atom (UnboundSym "if")) -> pat_cond_7 + kl_V2582hh@(ApplC (PL "if" + _)) -> pat_cond_7 + kl_V2582hh@(ApplC (Func "if" + _)) -> pat_cond_7 + _ -> pat_cond_13 + case kl_if_6 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_14 = do do return (Atom (B False)) + in case kl_V2582h of + !(kl_V2582h@(Cons (!kl_V2582hh) + (!kl_V2582ht))) -> pat_cond_5 kl_V2582h kl_V2582hh kl_V2582ht + _ -> pat_cond_14 + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_15 = do do return (Atom (B False)) + in case kl_V2582 of + !(kl_V2582@(Cons (!kl_V2582h) + (!kl_V2582t))) -> pat_cond_3 kl_V2582 kl_V2582h kl_V2582t + _ -> pat_cond_15 + case kl_if_2 of + Atom (B (True)) -> do !appl_16 <- kl_V2582 `pseq` hd kl_V2582 + !appl_17 <- appl_16 `pseq` tl appl_16 + !appl_18 <- appl_17 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "when")) appl_17 + !appl_19 <- kl_V2582 `pseq` tl kl_V2582 + !appl_20 <- appl_19 `pseq` kl_shen_construct_side_literals appl_19 + appl_18 `pseq` (appl_20 `pseq` klCons appl_18 appl_20) + Atom (B (False)) -> do !kl_if_21 <- let pat_cond_22 kl_V2582 kl_V2582h kl_V2582t = do !kl_if_23 <- let pat_cond_24 kl_V2582h kl_V2582hh kl_V2582ht = do !kl_if_25 <- let pat_cond_26 = do !kl_if_27 <- let pat_cond_28 kl_V2582ht kl_V2582hth kl_V2582htt = do !kl_if_29 <- let pat_cond_30 kl_V2582htt kl_V2582htth kl_V2582httt = do let !appl_31 = Atom Nil + !kl_if_32 <- appl_31 `pseq` (kl_V2582httt `pseq` eq appl_31 kl_V2582httt) + case kl_if_32 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_33 = do do return (Atom (B False)) + in case kl_V2582htt of + !(kl_V2582htt@(Cons (!kl_V2582htth) + (!kl_V2582httt))) -> pat_cond_30 kl_V2582htt kl_V2582htth kl_V2582httt + _ -> pat_cond_33 + case kl_if_29 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_34 = do do return (Atom (B False)) + in case kl_V2582ht of + !(kl_V2582ht@(Cons (!kl_V2582hth) + (!kl_V2582htt))) -> pat_cond_28 kl_V2582ht kl_V2582hth kl_V2582htt + _ -> pat_cond_34 + case kl_if_27 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_35 = do do return (Atom (B False)) + in case kl_V2582hh of + kl_V2582hh@(Atom (UnboundSym "let")) -> pat_cond_26 + kl_V2582hh@(ApplC (PL "let" + _)) -> pat_cond_26 + kl_V2582hh@(ApplC (Func "let" + _)) -> pat_cond_26 + _ -> pat_cond_35 + case kl_if_25 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_36 = do do return (Atom (B False)) + in case kl_V2582h of + !(kl_V2582h@(Cons (!kl_V2582hh) + (!kl_V2582ht))) -> pat_cond_24 kl_V2582h kl_V2582hh kl_V2582ht + _ -> pat_cond_36 + case kl_if_23 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_37 = do do return (Atom (B False)) + in case kl_V2582 of + !(kl_V2582@(Cons (!kl_V2582h) + (!kl_V2582t))) -> pat_cond_22 kl_V2582 kl_V2582h kl_V2582t + _ -> pat_cond_37 + case kl_if_21 of + Atom (B (True)) -> do !appl_38 <- kl_V2582 `pseq` hd kl_V2582 + !appl_39 <- appl_38 `pseq` tl appl_38 + !appl_40 <- appl_39 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "is")) appl_39 + !appl_41 <- kl_V2582 `pseq` tl kl_V2582 + !appl_42 <- appl_41 `pseq` kl_shen_construct_side_literals appl_41 + appl_40 `pseq` (appl_42 `pseq` klCons appl_40 appl_42) + Atom (B (False)) -> do let pat_cond_43 kl_V2582 kl_V2582h kl_V2582t = do kl_V2582t `pseq` kl_shen_construct_side_literals kl_V2582t + pat_cond_44 = do do let !aw_45 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_45 [ApplC (wrapNamed "shen.construct-side-literals" kl_shen_construct_side_literals)] + in case kl_V2582 of + !(kl_V2582@(Cons (!kl_V2582h) + (!kl_V2582t))) -> pat_cond_43 kl_V2582 kl_V2582h kl_V2582t + _ -> pat_cond_44 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_construct_premiss_literal :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_construct_premiss_literal (!kl_V2589) (!kl_V2590) = do !kl_if_0 <- kl_V2589 `pseq` kl_tupleP kl_V2589 + case kl_if_0 of + Atom (B (True)) -> do !appl_1 <- kl_V2589 `pseq` kl_snd kl_V2589 + !appl_2 <- appl_1 `pseq` kl_shen_recursive_cons_form appl_1 + !appl_3 <- kl_V2589 `pseq` kl_fst kl_V2589 + !appl_4 <- kl_V2590 `pseq` (appl_3 `pseq` kl_shen_construct_context kl_V2590 appl_3) + let !appl_5 = Atom Nil + !appl_6 <- appl_4 `pseq` (appl_5 `pseq` klCons appl_4 appl_5) + !appl_7 <- appl_2 `pseq` (appl_6 `pseq` klCons appl_2 appl_6) + appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.t*")) appl_7 + Atom (B (False)) -> do let pat_cond_8 = do let !appl_9 = Atom Nil + !appl_10 <- appl_9 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Throwcontrol")) appl_9 + appl_10 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "cut")) appl_10 + pat_cond_11 = do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_12 [ApplC (wrapNamed "shen.construct-premiss-literal" kl_shen_construct_premiss_literal)] + in case kl_V2589 of + kl_V2589@(Atom (UnboundSym "!")) -> pat_cond_8 + kl_V2589@(ApplC (PL "!" + _)) -> pat_cond_8 + kl_V2589@(ApplC (Func "!" + _)) -> pat_cond_8 + _ -> pat_cond_11 + _ -> throwError "if: expected boolean" + +kl_shen_construct_context :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_construct_context (!kl_V2593) (!kl_V2594) = do !kl_if_0 <- let pat_cond_1 = do let !appl_2 = Atom Nil + !kl_if_3 <- appl_2 `pseq` (kl_V2594 `pseq` eq appl_2 kl_V2594) + case kl_if_3 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_4 = do do return (Atom (B False)) + in case kl_V2593 of + kl_V2593@(Atom (UnboundSym "true")) -> pat_cond_1 + kl_V2593@(Atom (B (True))) -> pat_cond_1 + _ -> pat_cond_4 + case kl_if_0 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "Context_1957")) + Atom (B (False)) -> do !kl_if_5 <- let pat_cond_6 = do let !appl_7 = Atom Nil + !kl_if_8 <- appl_7 `pseq` (kl_V2594 `pseq` eq appl_7 kl_V2594) + case kl_if_8 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_9 = do do return (Atom (B False)) + in case kl_V2593 of + kl_V2593@(Atom (UnboundSym "false")) -> pat_cond_6 + kl_V2593@(Atom (B (False))) -> pat_cond_6 + _ -> pat_cond_9 + case kl_if_5 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "ContextOut_1957")) + Atom (B (False)) -> do let pat_cond_10 kl_V2594 kl_V2594h kl_V2594t = do !appl_11 <- kl_V2594h `pseq` kl_shen_recursive_cons_form kl_V2594h + !appl_12 <- kl_V2593 `pseq` (kl_V2594t `pseq` kl_shen_construct_context kl_V2593 kl_V2594t) + let !appl_13 = Atom Nil + !appl_14 <- appl_12 `pseq` (appl_13 `pseq` klCons appl_12 appl_13) + !appl_15 <- appl_11 `pseq` (appl_14 `pseq` klCons appl_11 appl_14) + appl_15 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_15 + pat_cond_16 = do do let !aw_17 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_17 [ApplC (wrapNamed "shen.construct-context" kl_shen_construct_context)] + in case kl_V2594 of + !(kl_V2594@(Cons (!kl_V2594h) + (!kl_V2594t))) -> pat_cond_10 kl_V2594 kl_V2594h kl_V2594t + _ -> pat_cond_16 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_recursive_cons_form :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_recursive_cons_form (!kl_V2596) = do let pat_cond_0 kl_V2596 kl_V2596h kl_V2596t = do !appl_1 <- kl_V2596h `pseq` kl_shen_recursive_cons_form kl_V2596h + !appl_2 <- kl_V2596t `pseq` kl_shen_recursive_cons_form kl_V2596t + let !appl_3 = Atom Nil + !appl_4 <- appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) + !appl_5 <- appl_1 `pseq` (appl_4 `pseq` klCons appl_1 appl_4) + appl_5 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_5 + pat_cond_6 = do do return kl_V2596 + in case kl_V2596 of + !(kl_V2596@(Cons (!kl_V2596h) + (!kl_V2596t))) -> pat_cond_0 kl_V2596 kl_V2596h kl_V2596t + _ -> pat_cond_6 + +kl_preclude :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_preclude (!kl_V2598) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.intern-type") + kl_X `pseq` applyWrapper aw_1 [kl_X]))) + !appl_2 <- appl_0 `pseq` (kl_V2598 `pseq` kl_map appl_0 kl_V2598) + appl_2 `pseq` kl_shen_preclude_h appl_2 + +kl_shen_preclude_h :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_preclude_h (!kl_V2600) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_FilterDatatypes) -> do value (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*"))))) + !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) + !appl_2 <- appl_1 `pseq` (kl_V2600 `pseq` kl_difference appl_1 kl_V2600) + !appl_3 <- appl_2 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) appl_2 + appl_3 `pseq` applyWrapper appl_0 [appl_3] + +kl_include :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_include (!kl_V2602) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.intern-type") + kl_X `pseq` applyWrapper aw_1 [kl_X]))) + !appl_2 <- appl_0 `pseq` (kl_V2602 `pseq` kl_map appl_0 kl_V2602) + appl_2 `pseq` kl_shen_include_h appl_2 + +kl_shen_include_h :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_include_h (!kl_V2604) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_ValidTypes) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_NewDatatypes) -> do value (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*"))))) + !appl_2 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) + !appl_3 <- kl_ValidTypes `pseq` (appl_2 `pseq` kl_union kl_ValidTypes appl_2) + !appl_4 <- appl_3 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*datatypes*")) appl_3 + appl_4 `pseq` applyWrapper appl_1 [appl_4]))) + !appl_5 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*alldatatypes*")) + !appl_6 <- kl_V2604 `pseq` (appl_5 `pseq` kl_intersection kl_V2604 appl_5) + appl_6 `pseq` applyWrapper appl_0 [appl_6] + +kl_preclude_all_but :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_preclude_all_but (!kl_V2606) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*alldatatypes*")) + let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.intern-type") + kl_X `pseq` applyWrapper aw_2 [kl_X]))) + !appl_3 <- appl_1 `pseq` (kl_V2606 `pseq` kl_map appl_1 kl_V2606) + !appl_4 <- appl_0 `pseq` (appl_3 `pseq` kl_difference appl_0 appl_3) + appl_4 `pseq` kl_shen_preclude_h appl_4 + +kl_include_all_but :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_include_all_but (!kl_V2608) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*alldatatypes*")) + let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.intern-type") + kl_X `pseq` applyWrapper aw_2 [kl_X]))) + !appl_3 <- appl_1 `pseq` (kl_V2608 `pseq` kl_map appl_1 kl_V2608) + !appl_4 <- appl_0 `pseq` (appl_3 `pseq` kl_difference appl_0 appl_3) + appl_4 `pseq` kl_shen_include_h appl_4 + +kl_shen_synonyms_help :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_synonyms_help (!kl_V2614) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2614 `pseq` eq appl_0 kl_V2614) + case kl_if_1 of + Atom (B (True)) -> do !appl_2 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*tc*")) + let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_demod_rule kl_X))) + !appl_4 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*synonyms*")) + !appl_5 <- appl_3 `pseq` (appl_4 `pseq` kl_mapcan appl_3 appl_4) + appl_2 `pseq` (appl_5 `pseq` kl_shen_update_demodulation_function appl_2 appl_5) + Atom (B (False)) -> do let pat_cond_6 kl_V2614 kl_V2614h kl_V2614t kl_V2614th kl_V2614tt = do let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_Vs) -> do !kl_if_8 <- kl_Vs `pseq` kl_emptyP kl_Vs + case kl_if_8 of + Atom (B (True)) -> do let !appl_9 = Atom Nil + !appl_10 <- kl_V2614th `pseq` (appl_9 `pseq` klCons kl_V2614th appl_9) + !appl_11 <- kl_V2614h `pseq` (appl_10 `pseq` klCons kl_V2614h appl_10) + !appl_12 <- appl_11 `pseq` kl_shen_pushnew appl_11 (Core.Types.Atom (Core.Types.UnboundSym "shen.*synonyms*")) + !appl_13 <- kl_V2614tt `pseq` kl_shen_synonyms_help kl_V2614tt + appl_12 `pseq` (appl_13 `pseq` kl_do appl_12 appl_13) + Atom (B (False)) -> do do kl_V2614th `pseq` (kl_Vs `pseq` kl_shen_free_variable_warnings kl_V2614th kl_Vs) + _ -> throwError "if: expected boolean"))) + !appl_14 <- kl_V2614th `pseq` kl_shen_extract_vars kl_V2614th + !appl_15 <- kl_V2614h `pseq` kl_shen_extract_vars kl_V2614h + !appl_16 <- appl_14 `pseq` (appl_15 `pseq` kl_difference appl_14 appl_15) + appl_16 `pseq` applyWrapper appl_7 [appl_16] + pat_cond_17 = do do simpleError (Core.Types.Atom (Core.Types.Str "odd number of synonyms\n")) + in case kl_V2614 of + !(kl_V2614@(Cons (!kl_V2614h) + (!(kl_V2614t@(Cons (!kl_V2614th) + (!kl_V2614tt)))))) -> pat_cond_6 kl_V2614 kl_V2614h kl_V2614t kl_V2614th kl_V2614tt + _ -> pat_cond_17 + _ -> throwError "if: expected boolean" + +kl_shen_pushnew :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_pushnew (!kl_V2617) (!kl_V2618) = do !appl_0 <- kl_V2618 `pseq` value kl_V2618 + !kl_if_1 <- kl_V2617 `pseq` (appl_0 `pseq` kl_elementP kl_V2617 appl_0) + case kl_if_1 of + Atom (B (True)) -> do kl_V2618 `pseq` value kl_V2618 + Atom (B (False)) -> do do !appl_2 <- kl_V2618 `pseq` value kl_V2618 + !appl_3 <- kl_V2617 `pseq` (appl_2 `pseq` klCons kl_V2617 appl_2) + kl_V2618 `pseq` (appl_3 `pseq` klSet kl_V2618 appl_3) + _ -> throwError "if: expected boolean" + +kl_shen_demod_rule :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_demod_rule (!kl_V2620) = do !kl_if_0 <- let pat_cond_1 kl_V2620 kl_V2620h kl_V2620t = do !kl_if_2 <- let pat_cond_3 kl_V2620t kl_V2620th kl_V2620tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V2620tt `pseq` eq appl_4 kl_V2620tt) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V2620t of + !(kl_V2620t@(Cons (!kl_V2620th) + (!kl_V2620tt))) -> pat_cond_3 kl_V2620t kl_V2620th kl_V2620tt + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V2620 of + !(kl_V2620@(Cons (!kl_V2620h) + (!kl_V2620t))) -> pat_cond_1 kl_V2620 kl_V2620h kl_V2620t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do !appl_8 <- kl_V2620 `pseq` hd kl_V2620 + let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.rcons_form") + !appl_10 <- appl_8 `pseq` applyWrapper aw_9 [appl_8] + !appl_11 <- kl_V2620 `pseq` tl kl_V2620 + !appl_12 <- appl_11 `pseq` hd appl_11 + let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "shen.rcons_form") + !appl_14 <- appl_12 `pseq` applyWrapper aw_13 [appl_12] + let !appl_15 = Atom Nil + !appl_16 <- appl_14 `pseq` (appl_15 `pseq` klCons appl_14 appl_15) + !appl_17 <- appl_16 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "->")) appl_16 + appl_10 `pseq` (appl_17 `pseq` klCons appl_10 appl_17) + Atom (B (False)) -> do do let !aw_18 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_18 [ApplC (wrapNamed "shen.demod-rule" kl_shen_demod_rule)] + _ -> throwError "if: expected boolean" + +kl_shen_lambda_of_defun :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_lambda_of_defun (!kl_V2626) = do !kl_if_0 <- let pat_cond_1 kl_V2626 kl_V2626h kl_V2626t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V2626t kl_V2626th kl_V2626tt = do !kl_if_6 <- let pat_cond_7 kl_V2626tt kl_V2626tth kl_V2626ttt = do !kl_if_8 <- let pat_cond_9 kl_V2626tth kl_V2626tthh kl_V2626ttht = do let !appl_10 = Atom Nil + !kl_if_11 <- appl_10 `pseq` (kl_V2626ttht `pseq` eq appl_10 kl_V2626ttht) + !kl_if_12 <- case kl_if_11 of + Atom (B (True)) -> do !kl_if_13 <- let pat_cond_14 kl_V2626ttt kl_V2626ttth kl_V2626tttt = do let !appl_15 = Atom Nil + !kl_if_16 <- appl_15 `pseq` (kl_V2626tttt `pseq` eq appl_15 kl_V2626tttt) + case kl_if_16 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_17 = do do return (Atom (B False)) + in case kl_V2626ttt of + !(kl_V2626ttt@(Cons (!kl_V2626ttth) + (!kl_V2626tttt))) -> pat_cond_14 kl_V2626ttt kl_V2626ttth kl_V2626tttt + _ -> pat_cond_17 + case kl_if_13 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_18 = do do return (Atom (B False)) + in case kl_V2626tth of + !(kl_V2626tth@(Cons (!kl_V2626tthh) + (!kl_V2626ttht))) -> pat_cond_9 kl_V2626tth kl_V2626tthh kl_V2626ttht + _ -> pat_cond_18 + case kl_if_8 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_19 = do do return (Atom (B False)) + in case kl_V2626tt of + !(kl_V2626tt@(Cons (!kl_V2626tth) + (!kl_V2626ttt))) -> pat_cond_7 kl_V2626tt kl_V2626tth kl_V2626ttt + _ -> pat_cond_19 + case kl_if_6 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_20 = do do return (Atom (B False)) + in case kl_V2626t of + !(kl_V2626t@(Cons (!kl_V2626th) + (!kl_V2626tt))) -> pat_cond_5 kl_V2626t kl_V2626th kl_V2626tt + _ -> pat_cond_20 + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_21 = do do return (Atom (B False)) + in case kl_V2626h of + kl_V2626h@(Atom (UnboundSym "defun")) -> pat_cond_3 + kl_V2626h@(ApplC (PL "defun" + _)) -> pat_cond_3 + kl_V2626h@(ApplC (Func "defun" + _)) -> pat_cond_3 + _ -> pat_cond_21 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_22 = do do return (Atom (B False)) + in case kl_V2626 of + !(kl_V2626@(Cons (!kl_V2626h) + (!kl_V2626t))) -> pat_cond_1 kl_V2626 kl_V2626h kl_V2626t + _ -> pat_cond_22 + case kl_if_0 of + Atom (B (True)) -> do !appl_23 <- kl_V2626 `pseq` tl kl_V2626 + !appl_24 <- appl_23 `pseq` tl appl_23 + !appl_25 <- appl_24 `pseq` hd appl_24 + !appl_26 <- appl_25 `pseq` hd appl_25 + !appl_27 <- kl_V2626 `pseq` tl kl_V2626 + !appl_28 <- appl_27 `pseq` tl appl_27 + !appl_29 <- appl_28 `pseq` tl appl_28 + !appl_30 <- appl_26 `pseq` (appl_29 `pseq` klCons appl_26 appl_29) + !appl_31 <- appl_30 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_30 + appl_31 `pseq` kl_eval appl_31 + Atom (B (False)) -> do do let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_32 [ApplC (wrapNamed "shen.lambda-of-defun" kl_shen_lambda_of_defun)] + _ -> throwError "if: expected boolean" + +kl_shen_update_demodulation_function :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_update_demodulation_function (!kl_V2629) (!kl_V2630) = do !appl_0 <- kl_tc (ApplC (wrapNamed "-" Primitives.subtract)) + !appl_1 <- kl_shen_default_rule + !appl_2 <- kl_V2630 `pseq` (appl_1 `pseq` kl_append kl_V2630 appl_1) + !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.demod")) appl_2 + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "define")) appl_3 + !appl_5 <- appl_4 `pseq` kl_shen_elim_def appl_4 + !appl_6 <- appl_5 `pseq` kl_shen_lambda_of_defun appl_5 + !appl_7 <- appl_6 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*demodulation-function*")) appl_6 + !appl_8 <- case kl_V2629 of + Atom (B (True)) -> do kl_tc (ApplC (wrapNamed "+" add)) + Atom (B (False)) -> do do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + _ -> throwError "if: expected boolean" + !appl_9 <- appl_8 `pseq` kl_do appl_8 (Core.Types.Atom (Core.Types.UnboundSym "synonyms")) + !appl_10 <- appl_7 `pseq` (appl_9 `pseq` kl_do appl_7 appl_9) + appl_0 `pseq` (appl_10 `pseq` kl_do appl_0 appl_10) + +kl_shen_default_rule :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_default_rule = do let !appl_0 = Atom Nil + !appl_1 <- appl_0 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_0 + !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "->")) appl_1 + appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_2 + +expr3 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr3 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Backend/Sys.hs b/Shentong/Backend/Sys.hs --- a/Shentong/Backend/Sys.hs +++ b/Shentong/Backend/Sys.hs @@ -1,1572 +1,2021 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} - -module Backend.Sys where - -import Control.Monad.Except -import Control.Parallel -import Environment -import Primitives -import Backend.Utils -import Types -import Utils -import Wrap -import Backend.Toplevel -import Backend.Core - -{- -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_thaw :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_thaw (!kl_V2614) = do applyWrapper kl_V2614 [] - -kl_eval :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_eval (!kl_V2616) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Macroexpand) -> do !kl_if_1 <- kl_Macroexpand `pseq` kl_shen_packagedP kl_Macroexpand - case kl_if_1 of - Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_eval_without_macros kl_Z))) - !appl_3 <- kl_Macroexpand `pseq` kl_shen_package_contents kl_Macroexpand - appl_2 `pseq` (appl_3 `pseq` kl_map appl_2 appl_3) - Atom (B (False)) -> do do kl_Macroexpand `pseq` kl_shen_eval_without_macros kl_Macroexpand - _ -> throwError "if: expected boolean"))) - let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do let !aw_5 = Types.Atom (Types.UnboundSym "macroexpand") - kl_Y `pseq` applyWrapper aw_5 [kl_Y]))) - !appl_6 <- appl_4 `pseq` (kl_V2616 `pseq` kl_shen_walk appl_4 kl_V2616) - appl_6 `pseq` applyWrapper appl_0 [appl_6] - -kl_shen_eval_without_macros :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_eval_without_macros (!kl_V2618) = do !appl_0 <- kl_V2618 `pseq` kl_shen_proc_inputPlus kl_V2618 - !appl_1 <- appl_0 `pseq` kl_shen_elim_def appl_0 - appl_1 `pseq` evalKL appl_1 - -kl_shen_proc_inputPlus :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_proc_inputPlus (!kl_V2620) = do let pat_cond_0 kl_V2620 kl_V2620t kl_V2620th kl_V2620tt kl_V2620tth = do let !aw_1 = Types.Atom (Types.UnboundSym "shen.rcons_form") - !appl_2 <- kl_V2620th `pseq` applyWrapper aw_1 [kl_V2620th] - !appl_3 <- appl_2 `pseq` (kl_V2620tt `pseq` klCons appl_2 kl_V2620tt) - appl_3 `pseq` klCons (Types.Atom (Types.UnboundSym "input+")) appl_3 - pat_cond_4 kl_V2620 kl_V2620t kl_V2620th kl_V2620tt kl_V2620tth = do let !aw_5 = Types.Atom (Types.UnboundSym "shen.rcons_form") - !appl_6 <- kl_V2620th `pseq` applyWrapper aw_5 [kl_V2620th] - !appl_7 <- appl_6 `pseq` (kl_V2620tt `pseq` klCons appl_6 kl_V2620tt) - appl_7 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.read+")) appl_7 - pat_cond_8 kl_V2620 kl_V2620h kl_V2620t = do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_proc_inputPlus kl_Z))) - appl_9 `pseq` (kl_V2620 `pseq` kl_map appl_9 kl_V2620) - pat_cond_10 = do do return kl_V2620 - in case kl_V2620 of - !(kl_V2620@(Cons (Atom (UnboundSym "input+")) - (!(kl_V2620t@(Cons (!kl_V2620th) - (!(kl_V2620tt@(Cons (!kl_V2620tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V2620 kl_V2620t kl_V2620th kl_V2620tt kl_V2620tth - !(kl_V2620@(Cons (ApplC (PL "input+" _)) - (!(kl_V2620t@(Cons (!kl_V2620th) - (!(kl_V2620tt@(Cons (!kl_V2620tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V2620 kl_V2620t kl_V2620th kl_V2620tt kl_V2620tth - !(kl_V2620@(Cons (ApplC (Func "input+" _)) - (!(kl_V2620t@(Cons (!kl_V2620th) - (!(kl_V2620tt@(Cons (!kl_V2620tth) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V2620 kl_V2620t kl_V2620th kl_V2620tt kl_V2620tth - !(kl_V2620@(Cons (Atom (UnboundSym "shen.read+")) - (!(kl_V2620t@(Cons (!kl_V2620th) - (!(kl_V2620tt@(Cons (!kl_V2620tth) - (Atom (Nil)))))))))) -> pat_cond_4 kl_V2620 kl_V2620t kl_V2620th kl_V2620tt kl_V2620tth - !(kl_V2620@(Cons (ApplC (PL "shen.read+" _)) - (!(kl_V2620t@(Cons (!kl_V2620th) - (!(kl_V2620tt@(Cons (!kl_V2620tth) - (Atom (Nil)))))))))) -> pat_cond_4 kl_V2620 kl_V2620t kl_V2620th kl_V2620tt kl_V2620tth - !(kl_V2620@(Cons (ApplC (Func "shen.read+" _)) - (!(kl_V2620t@(Cons (!kl_V2620th) - (!(kl_V2620tt@(Cons (!kl_V2620tth) - (Atom (Nil)))))))))) -> pat_cond_4 kl_V2620 kl_V2620t kl_V2620th kl_V2620tt kl_V2620tth - !(kl_V2620@(Cons (!kl_V2620h) - (!kl_V2620t))) -> pat_cond_8 kl_V2620 kl_V2620h kl_V2620t - _ -> pat_cond_10 - -kl_shen_elim_def :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_elim_def (!kl_V2622) = do let pat_cond_0 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt = do kl_V2622th `pseq` (kl_V2622tt `pseq` kl_shen_shen_RBkl kl_V2622th kl_V2622tt) - pat_cond_1 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt = do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Default) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Def) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_MacroAdd) -> do return kl_Def))) - !appl_5 <- kl_V2622th `pseq` kl_shen_add_macro kl_V2622th - appl_5 `pseq` applyWrapper appl_4 [appl_5]))) - !appl_6 <- kl_V2622tt `pseq` (kl_Default `pseq` kl_append kl_V2622tt kl_Default) - !appl_7 <- kl_V2622th `pseq` (appl_6 `pseq` klCons kl_V2622th appl_6) - !appl_8 <- appl_7 `pseq` klCons (Types.Atom (Types.UnboundSym "define")) appl_7 - !appl_9 <- appl_8 `pseq` kl_shen_elim_def appl_8 - appl_9 `pseq` applyWrapper appl_3 [appl_9]))) - !appl_10 <- klCons (Types.Atom (Types.UnboundSym "X")) (Types.Atom Types.Nil) - !appl_11 <- appl_10 `pseq` klCons (Types.Atom (Types.UnboundSym "->")) appl_10 - !appl_12 <- appl_11 `pseq` klCons (Types.Atom (Types.UnboundSym "X")) appl_11 - appl_12 `pseq` applyWrapper appl_2 [appl_12] - pat_cond_13 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt = do let !aw_14 = Types.Atom (Types.UnboundSym "shen.yacc") - !appl_15 <- kl_V2622 `pseq` applyWrapper aw_14 [kl_V2622] - appl_15 `pseq` kl_shen_elim_def appl_15 - pat_cond_16 kl_V2622 kl_V2622h kl_V2622t = do let !appl_17 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_elim_def kl_Z))) - appl_17 `pseq` (kl_V2622 `pseq` kl_map appl_17 kl_V2622) - pat_cond_18 = do do return kl_V2622 - in case kl_V2622 of - !(kl_V2622@(Cons (Atom (UnboundSym "define")) - (!(kl_V2622t@(Cons (!kl_V2622th) - (!kl_V2622tt)))))) -> pat_cond_0 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt - !(kl_V2622@(Cons (ApplC (PL "define" _)) - (!(kl_V2622t@(Cons (!kl_V2622th) - (!kl_V2622tt)))))) -> pat_cond_0 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt - !(kl_V2622@(Cons (ApplC (Func "define" _)) - (!(kl_V2622t@(Cons (!kl_V2622th) - (!kl_V2622tt)))))) -> pat_cond_0 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt - !(kl_V2622@(Cons (Atom (UnboundSym "defmacro")) - (!(kl_V2622t@(Cons (!kl_V2622th) - (!kl_V2622tt)))))) -> pat_cond_1 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt - !(kl_V2622@(Cons (ApplC (PL "defmacro" _)) - (!(kl_V2622t@(Cons (!kl_V2622th) - (!kl_V2622tt)))))) -> pat_cond_1 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt - !(kl_V2622@(Cons (ApplC (Func "defmacro" _)) - (!(kl_V2622t@(Cons (!kl_V2622th) - (!kl_V2622tt)))))) -> pat_cond_1 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt - !(kl_V2622@(Cons (Atom (UnboundSym "defcc")) - (!(kl_V2622t@(Cons (!kl_V2622th) - (!kl_V2622tt)))))) -> pat_cond_13 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt - !(kl_V2622@(Cons (ApplC (PL "defcc" _)) - (!(kl_V2622t@(Cons (!kl_V2622th) - (!kl_V2622tt)))))) -> pat_cond_13 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt - !(kl_V2622@(Cons (ApplC (Func "defcc" _)) - (!(kl_V2622t@(Cons (!kl_V2622th) - (!kl_V2622tt)))))) -> pat_cond_13 kl_V2622 kl_V2622t kl_V2622th kl_V2622tt - !(kl_V2622@(Cons (!kl_V2622h) - (!kl_V2622t))) -> pat_cond_16 kl_V2622 kl_V2622h kl_V2622t - _ -> pat_cond_18 - -kl_shen_add_macro :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_add_macro (!kl_V2624) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_MacroReg) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_NewMacroReg) -> do !kl_if_2 <- kl_MacroReg `pseq` (kl_NewMacroReg `pseq` eq kl_MacroReg kl_NewMacroReg) - case kl_if_2 of - Atom (B (True)) -> do return (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do !appl_3 <- kl_V2624 `pseq` kl_function kl_V2624 - !appl_4 <- value (Types.Atom (Types.UnboundSym "*macros*")) - !appl_5 <- appl_3 `pseq` (appl_4 `pseq` klCons appl_3 appl_4) - appl_5 `pseq` klSet (Types.Atom (Types.UnboundSym "*macros*")) appl_5 - _ -> throwError "if: expected boolean"))) - !appl_6 <- value (Types.Atom (Types.UnboundSym "shen.*macroreg*")) - let !aw_7 = Types.Atom (Types.UnboundSym "adjoin") - !appl_8 <- kl_V2624 `pseq` (appl_6 `pseq` applyWrapper aw_7 [kl_V2624, - appl_6]) - !appl_9 <- appl_8 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*macroreg*")) appl_8 - appl_9 `pseq` applyWrapper appl_1 [appl_9]))) - !appl_10 <- value (Types.Atom (Types.UnboundSym "shen.*macroreg*")) - appl_10 `pseq` applyWrapper appl_0 [appl_10] - -kl_shen_packagedP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_packagedP (!kl_V2632) = do let pat_cond_0 kl_V2632 kl_V2632t kl_V2632th kl_V2632tt kl_V2632tth kl_V2632ttt = do return (Atom (B True)) - pat_cond_1 = do do return (Atom (B False)) - in case kl_V2632 of - !(kl_V2632@(Cons (Atom (UnboundSym "package")) - (!(kl_V2632t@(Cons (!kl_V2632th) - (!(kl_V2632tt@(Cons (!kl_V2632tth) - (!kl_V2632ttt))))))))) -> pat_cond_0 kl_V2632 kl_V2632t kl_V2632th kl_V2632tt kl_V2632tth kl_V2632ttt - !(kl_V2632@(Cons (ApplC (PL "package" _)) - (!(kl_V2632t@(Cons (!kl_V2632th) - (!(kl_V2632tt@(Cons (!kl_V2632tth) - (!kl_V2632ttt))))))))) -> pat_cond_0 kl_V2632 kl_V2632t kl_V2632th kl_V2632tt kl_V2632tth kl_V2632ttt - !(kl_V2632@(Cons (ApplC (Func "package" _)) - (!(kl_V2632t@(Cons (!kl_V2632th) - (!(kl_V2632tt@(Cons (!kl_V2632tth) - (!kl_V2632ttt))))))))) -> pat_cond_0 kl_V2632 kl_V2632t kl_V2632th kl_V2632tt kl_V2632tth kl_V2632ttt - _ -> pat_cond_1 - -kl_external :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_external (!kl_V2634) = do (do !appl_0 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - kl_V2634 `pseq` (appl_0 `pseq` kl_get kl_V2634 (Types.Atom (Types.UnboundSym "shen.external-symbols")) appl_0)) `catchError` (\(!kl_E) -> do let !aw_1 = Types.Atom (Types.UnboundSym "shen.app") - !appl_2 <- kl_V2634 `pseq` applyWrapper aw_1 [kl_V2634, - Types.Atom (Types.Str " has not been used.\n"), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_3 <- appl_2 `pseq` cn (Types.Atom (Types.Str "package ")) appl_2 - appl_3 `pseq` simpleError appl_3) - -kl_internal :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_internal (!kl_V2636) = do (do !appl_0 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - kl_V2636 `pseq` (appl_0 `pseq` kl_get kl_V2636 (Types.Atom (Types.UnboundSym "shen.internal-symbols")) appl_0)) `catchError` (\(!kl_E) -> do let !aw_1 = Types.Atom (Types.UnboundSym "shen.app") - !appl_2 <- kl_V2636 `pseq` applyWrapper aw_1 [kl_V2636, - Types.Atom (Types.Str " has not been used.\n"), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_3 <- appl_2 `pseq` cn (Types.Atom (Types.Str "package ")) appl_2 - appl_3 `pseq` simpleError appl_3) - -kl_shen_package_contents :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_package_contents (!kl_V2640) = do let pat_cond_0 kl_V2640 kl_V2640t kl_V2640tt kl_V2640tth kl_V2640ttt = do return kl_V2640ttt - pat_cond_1 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt kl_V2640tth kl_V2640ttt = do let !aw_2 = Types.Atom (Types.UnboundSym "shen.packageh") - kl_V2640th `pseq` (kl_V2640tth `pseq` (kl_V2640ttt `pseq` applyWrapper aw_2 [kl_V2640th, - kl_V2640tth, - kl_V2640ttt])) - pat_cond_3 = do do let !aw_4 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_4 [ApplC (wrapNamed "shen.package-contents" kl_shen_package_contents)] - in case kl_V2640 of - !(kl_V2640@(Cons (Atom (UnboundSym "package")) - (!(kl_V2640t@(Cons (Atom (UnboundSym "null")) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640tt kl_V2640tth kl_V2640ttt - !(kl_V2640@(Cons (Atom (UnboundSym "package")) - (!(kl_V2640t@(Cons (ApplC (PL "null" - _)) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640tt kl_V2640tth kl_V2640ttt - !(kl_V2640@(Cons (Atom (UnboundSym "package")) - (!(kl_V2640t@(Cons (ApplC (Func "null" - _)) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640tt kl_V2640tth kl_V2640ttt - !(kl_V2640@(Cons (ApplC (PL "package" _)) - (!(kl_V2640t@(Cons (Atom (UnboundSym "null")) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640tt kl_V2640tth kl_V2640ttt - !(kl_V2640@(Cons (ApplC (PL "package" _)) - (!(kl_V2640t@(Cons (ApplC (PL "null" - _)) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640tt kl_V2640tth kl_V2640ttt - !(kl_V2640@(Cons (ApplC (PL "package" _)) - (!(kl_V2640t@(Cons (ApplC (Func "null" - _)) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640tt kl_V2640tth kl_V2640ttt - !(kl_V2640@(Cons (ApplC (Func "package" _)) - (!(kl_V2640t@(Cons (Atom (UnboundSym "null")) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640tt kl_V2640tth kl_V2640ttt - !(kl_V2640@(Cons (ApplC (Func "package" _)) - (!(kl_V2640t@(Cons (ApplC (PL "null" - _)) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640tt kl_V2640tth kl_V2640ttt - !(kl_V2640@(Cons (ApplC (Func "package" _)) - (!(kl_V2640t@(Cons (ApplC (Func "null" - _)) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640tt kl_V2640tth kl_V2640ttt - !(kl_V2640@(Cons (Atom (UnboundSym "package")) - (!(kl_V2640t@(Cons (!kl_V2640th) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_1 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt kl_V2640tth kl_V2640ttt - !(kl_V2640@(Cons (ApplC (PL "package" _)) - (!(kl_V2640t@(Cons (!kl_V2640th) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_1 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt kl_V2640tth kl_V2640ttt - !(kl_V2640@(Cons (ApplC (Func "package" _)) - (!(kl_V2640t@(Cons (!kl_V2640th) - (!(kl_V2640tt@(Cons (!kl_V2640tth) - (!kl_V2640ttt))))))))) -> pat_cond_1 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt kl_V2640tth kl_V2640ttt - _ -> pat_cond_3 - -kl_shen_walk :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_walk (!kl_V2643) (!kl_V2644) = do let pat_cond_0 kl_V2644 kl_V2644h kl_V2644t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_V2643 `pseq` (kl_Z `pseq` kl_shen_walk kl_V2643 kl_Z)))) - !appl_2 <- appl_1 `pseq` (kl_V2644 `pseq` kl_map appl_1 kl_V2644) - appl_2 `pseq` applyWrapper kl_V2643 [appl_2] - pat_cond_3 = do do kl_V2644 `pseq` applyWrapper kl_V2643 [kl_V2644] - in case kl_V2644 of - !(kl_V2644@(Cons (!kl_V2644h) - (!kl_V2644t))) -> pat_cond_0 kl_V2644 kl_V2644h kl_V2644t - _ -> pat_cond_3 - -kl_compile :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_compile (!kl_V2648) (!kl_V2649) (!kl_V2650) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_O) -> do let !aw_1 = Types.Atom (Types.UnboundSym "fail") - !appl_2 <- applyWrapper aw_1 [] - !kl_if_3 <- appl_2 `pseq` (kl_O `pseq` eq appl_2 kl_O) - !kl_if_4 <- case kl_if_3 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !appl_5 <- kl_O `pseq` hd kl_O - !appl_6 <- appl_5 `pseq` kl_emptyP appl_5 - !kl_if_7 <- appl_6 `pseq` kl_not appl_6 - case kl_if_7 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - case kl_if_4 of - Atom (B (True)) -> do kl_O `pseq` applyWrapper kl_V2650 [kl_O] - Atom (B (False)) -> do do let !aw_8 = Types.Atom (Types.UnboundSym "shen.hdtl") - kl_O `pseq` applyWrapper aw_8 [kl_O] - _ -> throwError "if: expected boolean"))) - !appl_9 <- klCons (Types.Atom Types.Nil) (Types.Atom Types.Nil) - !appl_10 <- kl_V2649 `pseq` (appl_9 `pseq` klCons kl_V2649 appl_9) - !appl_11 <- appl_10 `pseq` applyWrapper kl_V2648 [appl_10] - appl_11 `pseq` applyWrapper appl_0 [appl_11] - -kl_fail_if :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_fail_if (!kl_V2653) (!kl_V2654) = do !kl_if_0 <- kl_V2654 `pseq` applyWrapper kl_V2653 [kl_V2654] - 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_V2654 - _ -> throwError "if: expected boolean" - -kl_Ats :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_Ats (!kl_V2657) (!kl_V2658) = do kl_V2657 `pseq` (kl_V2658 `pseq` cn kl_V2657 kl_V2658) - -kl_tcP :: Types.KLContext Types.Env Types.KLValue -kl_tcP = do value (Types.Atom (Types.UnboundSym "shen.*tc*")) - -kl_ps :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_ps (!kl_V2660) = do (do !appl_0 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - kl_V2660 `pseq` (appl_0 `pseq` kl_get kl_V2660 (Types.Atom (Types.UnboundSym "shen.source")) appl_0)) `catchError` (\(!kl_E) -> do let !aw_1 = Types.Atom (Types.UnboundSym "shen.app") - !appl_2 <- kl_V2660 `pseq` applyWrapper aw_1 [kl_V2660, - Types.Atom (Types.Str " not found.\n"), - Types.Atom (Types.UnboundSym "shen.a")] - appl_2 `pseq` simpleError appl_2) - -kl_stinput :: Types.KLContext Types.Env Types.KLValue -kl_stinput = do value (Types.Atom (Types.UnboundSym "*stinput*")) - -kl_shen_PlusvectorP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_PlusvectorP (!kl_V2662) = do !kl_if_0 <- kl_V2662 `pseq` absvectorP kl_V2662 - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- kl_V2662 `pseq` addressFrom kl_V2662 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_2 <- appl_1 `pseq` greaterThan appl_1 (Types.Atom (Types.N (Types.KI 0))) - case kl_if_2 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - -kl_vector :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_vector (!kl_V2664) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Vector) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_ZeroStamp) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Standard) -> do return kl_Standard))) - !appl_3 <- let pat_cond_4 = do return kl_ZeroStamp - pat_cond_5 = do do let !aw_6 = Types.Atom (Types.UnboundSym "fail") - !appl_7 <- applyWrapper aw_6 [] - kl_ZeroStamp `pseq` (kl_V2664 `pseq` (appl_7 `pseq` kl_shen_fillvector kl_ZeroStamp (Types.Atom (Types.N (Types.KI 1))) kl_V2664 appl_7)) - in case kl_V2664 of - kl_V2664@(Atom (N (KI 0))) -> pat_cond_4 - _ -> pat_cond_5 - appl_3 `pseq` applyWrapper appl_2 [appl_3]))) - !appl_8 <- kl_Vector `pseq` (kl_V2664 `pseq` addressTo kl_Vector (Types.Atom (Types.N (Types.KI 0))) kl_V2664) - appl_8 `pseq` applyWrapper appl_1 [appl_8]))) - !appl_9 <- kl_V2664 `pseq` add kl_V2664 (Types.Atom (Types.N (Types.KI 1))) - !appl_10 <- appl_9 `pseq` absvector appl_9 - appl_10 `pseq` applyWrapper appl_0 [appl_10] - -kl_shen_fillvector :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_fillvector (!kl_V2670) (!kl_V2671) (!kl_V2672) (!kl_V2673) = do !kl_if_0 <- kl_V2672 `pseq` (kl_V2671 `pseq` eq kl_V2672 kl_V2671) - case kl_if_0 of - Atom (B (True)) -> do kl_V2670 `pseq` (kl_V2672 `pseq` (kl_V2673 `pseq` addressTo kl_V2670 kl_V2672 kl_V2673)) - Atom (B (False)) -> do do !appl_1 <- kl_V2670 `pseq` (kl_V2671 `pseq` (kl_V2673 `pseq` addressTo kl_V2670 kl_V2671 kl_V2673)) - !appl_2 <- kl_V2671 `pseq` add (Types.Atom (Types.N (Types.KI 1))) kl_V2671 - appl_1 `pseq` (appl_2 `pseq` (kl_V2672 `pseq` (kl_V2673 `pseq` kl_shen_fillvector appl_1 appl_2 kl_V2672 kl_V2673))) - _ -> throwError "if: expected boolean" - -kl_vectorP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_vectorP (!kl_V2675) = do !kl_if_0 <- kl_V2675 `pseq` absvectorP kl_V2675 - case kl_if_0 of - Atom (B (True)) -> do !kl_if_1 <- (do !appl_2 <- kl_V2675 `pseq` addressFrom kl_V2675 (Types.Atom (Types.N (Types.KI 0))) - appl_2 `pseq` greaterThanOrEqualTo appl_2 (Types.Atom (Types.N (Types.KI 0)))) `catchError` (\(!kl_E) -> do return (Atom (B False))) - case kl_if_1 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - -kl_vector_RB :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_vector_RB (!kl_V2679) (!kl_V2680) (!kl_V2681) = do let pat_cond_0 = do simpleError (Types.Atom (Types.Str "cannot access 0th element of a vector\n")) - pat_cond_1 = do do kl_V2679 `pseq` (kl_V2680 `pseq` (kl_V2681 `pseq` addressTo kl_V2679 kl_V2680 kl_V2681)) - in case kl_V2680 of - kl_V2680@(Atom (N (KI 0))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_LB_vector :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_LB_vector (!kl_V2684) (!kl_V2685) = do let pat_cond_0 = do simpleError (Types.Atom (Types.Str "cannot access 0th element of a vector\n")) - pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_VectorElement) -> do let !aw_3 = Types.Atom (Types.UnboundSym "fail") - !appl_4 <- applyWrapper aw_3 [] - !kl_if_5 <- kl_VectorElement `pseq` (appl_4 `pseq` eq kl_VectorElement appl_4) - case kl_if_5 of - Atom (B (True)) -> do simpleError (Types.Atom (Types.Str "vector element not found\n")) - Atom (B (False)) -> do do return kl_VectorElement - _ -> throwError "if: expected boolean"))) - !appl_6 <- kl_V2684 `pseq` (kl_V2685 `pseq` addressFrom kl_V2684 kl_V2685) - appl_6 `pseq` applyWrapper appl_2 [appl_6] - in case kl_V2685 of - kl_V2685@(Atom (N (KI 0))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_posintP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_posintP (!kl_V2687) = do !kl_if_0 <- kl_V2687 `pseq` kl_integerP kl_V2687 - case kl_if_0 of - Atom (B (True)) -> do !kl_if_1 <- kl_V2687 `pseq` greaterThanOrEqualTo kl_V2687 (Types.Atom (Types.N (Types.KI 0))) - case kl_if_1 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - -kl_limit :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_limit (!kl_V2689) = do kl_V2689 `pseq` addressFrom kl_V2689 (Types.Atom (Types.N (Types.KI 0))) - -kl_symbolP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_symbolP (!kl_V2691) = do !kl_if_0 <- kl_V2691 `pseq` kl_booleanP kl_V2691 - !kl_if_1 <- case kl_if_0 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_2 <- kl_V2691 `pseq` numberP kl_V2691 - !kl_if_3 <- case kl_if_2 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_4 <- kl_V2691 `pseq` stringP kl_V2691 - 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" - _ -> throwError "if: expected boolean" - 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" - _ -> throwError "if: expected boolean" - case kl_if_1 of - Atom (B (True)) -> do return (Atom (B False)) - Atom (B (False)) -> do do (do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_String) -> do kl_String `pseq` kl_shen_analyse_symbolP kl_String))) - !appl_6 <- kl_V2691 `pseq` str kl_V2691 - appl_6 `pseq` applyWrapper appl_5 [appl_6]) `catchError` (\(!kl_E) -> do return (Atom (B False))) - _ -> throwError "if: expected boolean" - -kl_shen_analyse_symbolP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_analyse_symbolP (!kl_V2693) = do !kl_if_0 <- kl_V2693 `pseq` kl_shen_PlusstringP kl_V2693 - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- kl_V2693 `pseq` pos kl_V2693 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_2 <- appl_1 `pseq` kl_shen_alphaP appl_1 - case kl_if_2 of - Atom (B (True)) -> do !appl_3 <- kl_V2693 `pseq` tlstr kl_V2693 - !kl_if_4 <- appl_3 `pseq` kl_shen_alphanumsP appl_3 - case kl_if_4 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do let !aw_5 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_5 [ApplC (wrapNamed "shen.analyse-symbol?" kl_shen_analyse_symbolP)] - _ -> throwError "if: expected boolean" - -kl_shen_alphaP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_alphaP (!kl_V2695) = do !appl_0 <- klCons (Types.Atom (Types.Str ".")) (Types.Atom Types.Nil) - !appl_1 <- appl_0 `pseq` klCons (Types.Atom (Types.Str "'")) appl_0 - !appl_2 <- appl_1 `pseq` klCons (Types.Atom (Types.Str "#")) appl_1 - !appl_3 <- appl_2 `pseq` klCons (Types.Atom (Types.Str "`")) appl_2 - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.Str ";")) appl_3 - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.Str ":")) appl_4 - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.Str "}")) appl_5 - !appl_7 <- appl_6 `pseq` klCons (Types.Atom (Types.Str "{")) appl_6 - !appl_8 <- appl_7 `pseq` klCons (Types.Atom (Types.Str "%")) appl_7 - !appl_9 <- appl_8 `pseq` klCons (Types.Atom (Types.Str "&")) appl_8 - !appl_10 <- appl_9 `pseq` klCons (Types.Atom (Types.Str "<")) appl_9 - !appl_11 <- appl_10 `pseq` klCons (Types.Atom (Types.Str ">")) appl_10 - !appl_12 <- appl_11 `pseq` klCons (Types.Atom (Types.Str "~")) appl_11 - !appl_13 <- appl_12 `pseq` klCons (Types.Atom (Types.Str "@")) appl_12 - !appl_14 <- appl_13 `pseq` klCons (Types.Atom (Types.Str "!")) appl_13 - !appl_15 <- appl_14 `pseq` klCons (Types.Atom (Types.Str "$")) appl_14 - !appl_16 <- appl_15 `pseq` klCons (Types.Atom (Types.Str "?")) appl_15 - !appl_17 <- appl_16 `pseq` klCons (Types.Atom (Types.Str "_")) appl_16 - !appl_18 <- appl_17 `pseq` klCons (Types.Atom (Types.Str "-")) appl_17 - !appl_19 <- appl_18 `pseq` klCons (Types.Atom (Types.Str "+")) appl_18 - !appl_20 <- appl_19 `pseq` klCons (Types.Atom (Types.Str "/")) appl_19 - !appl_21 <- appl_20 `pseq` klCons (Types.Atom (Types.Str "*")) appl_20 - !appl_22 <- appl_21 `pseq` klCons (Types.Atom (Types.Str "=")) appl_21 - !appl_23 <- appl_22 `pseq` klCons (Types.Atom (Types.Str "z")) appl_22 - !appl_24 <- appl_23 `pseq` klCons (Types.Atom (Types.Str "y")) appl_23 - !appl_25 <- appl_24 `pseq` klCons (Types.Atom (Types.Str "x")) appl_24 - !appl_26 <- appl_25 `pseq` klCons (Types.Atom (Types.Str "w")) appl_25 - !appl_27 <- appl_26 `pseq` klCons (Types.Atom (Types.Str "v")) appl_26 - !appl_28 <- appl_27 `pseq` klCons (Types.Atom (Types.Str "u")) appl_27 - !appl_29 <- appl_28 `pseq` klCons (Types.Atom (Types.Str "t")) appl_28 - !appl_30 <- appl_29 `pseq` klCons (Types.Atom (Types.Str "s")) appl_29 - !appl_31 <- appl_30 `pseq` klCons (Types.Atom (Types.Str "r")) appl_30 - !appl_32 <- appl_31 `pseq` klCons (Types.Atom (Types.Str "q")) appl_31 - !appl_33 <- appl_32 `pseq` klCons (Types.Atom (Types.Str "p")) appl_32 - !appl_34 <- appl_33 `pseq` klCons (Types.Atom (Types.Str "o")) appl_33 - !appl_35 <- appl_34 `pseq` klCons (Types.Atom (Types.Str "n")) appl_34 - !appl_36 <- appl_35 `pseq` klCons (Types.Atom (Types.Str "m")) appl_35 - !appl_37 <- appl_36 `pseq` klCons (Types.Atom (Types.Str "l")) appl_36 - !appl_38 <- appl_37 `pseq` klCons (Types.Atom (Types.Str "k")) appl_37 - !appl_39 <- appl_38 `pseq` klCons (Types.Atom (Types.Str "j")) appl_38 - !appl_40 <- appl_39 `pseq` klCons (Types.Atom (Types.Str "i")) appl_39 - !appl_41 <- appl_40 `pseq` klCons (Types.Atom (Types.Str "h")) appl_40 - !appl_42 <- appl_41 `pseq` klCons (Types.Atom (Types.Str "g")) appl_41 - !appl_43 <- appl_42 `pseq` klCons (Types.Atom (Types.Str "f")) appl_42 - !appl_44 <- appl_43 `pseq` klCons (Types.Atom (Types.Str "e")) appl_43 - !appl_45 <- appl_44 `pseq` klCons (Types.Atom (Types.Str "d")) appl_44 - !appl_46 <- appl_45 `pseq` klCons (Types.Atom (Types.Str "c")) appl_45 - !appl_47 <- appl_46 `pseq` klCons (Types.Atom (Types.Str "b")) appl_46 - !appl_48 <- appl_47 `pseq` klCons (Types.Atom (Types.Str "a")) appl_47 - !appl_49 <- appl_48 `pseq` klCons (Types.Atom (Types.Str "Z")) appl_48 - !appl_50 <- appl_49 `pseq` klCons (Types.Atom (Types.Str "Y")) appl_49 - !appl_51 <- appl_50 `pseq` klCons (Types.Atom (Types.Str "X")) appl_50 - !appl_52 <- appl_51 `pseq` klCons (Types.Atom (Types.Str "W")) appl_51 - !appl_53 <- appl_52 `pseq` klCons (Types.Atom (Types.Str "V")) appl_52 - !appl_54 <- appl_53 `pseq` klCons (Types.Atom (Types.Str "U")) appl_53 - !appl_55 <- appl_54 `pseq` klCons (Types.Atom (Types.Str "T")) appl_54 - !appl_56 <- appl_55 `pseq` klCons (Types.Atom (Types.Str "S")) appl_55 - !appl_57 <- appl_56 `pseq` klCons (Types.Atom (Types.Str "R")) appl_56 - !appl_58 <- appl_57 `pseq` klCons (Types.Atom (Types.Str "Q")) appl_57 - !appl_59 <- appl_58 `pseq` klCons (Types.Atom (Types.Str "P")) appl_58 - !appl_60 <- appl_59 `pseq` klCons (Types.Atom (Types.Str "O")) appl_59 - !appl_61 <- appl_60 `pseq` klCons (Types.Atom (Types.Str "N")) appl_60 - !appl_62 <- appl_61 `pseq` klCons (Types.Atom (Types.Str "M")) appl_61 - !appl_63 <- appl_62 `pseq` klCons (Types.Atom (Types.Str "L")) appl_62 - !appl_64 <- appl_63 `pseq` klCons (Types.Atom (Types.Str "K")) appl_63 - !appl_65 <- appl_64 `pseq` klCons (Types.Atom (Types.Str "J")) appl_64 - !appl_66 <- appl_65 `pseq` klCons (Types.Atom (Types.Str "I")) appl_65 - !appl_67 <- appl_66 `pseq` klCons (Types.Atom (Types.Str "H")) appl_66 - !appl_68 <- appl_67 `pseq` klCons (Types.Atom (Types.Str "G")) appl_67 - !appl_69 <- appl_68 `pseq` klCons (Types.Atom (Types.Str "F")) appl_68 - !appl_70 <- appl_69 `pseq` klCons (Types.Atom (Types.Str "E")) appl_69 - !appl_71 <- appl_70 `pseq` klCons (Types.Atom (Types.Str "D")) appl_70 - !appl_72 <- appl_71 `pseq` klCons (Types.Atom (Types.Str "C")) appl_71 - !appl_73 <- appl_72 `pseq` klCons (Types.Atom (Types.Str "B")) appl_72 - !appl_74 <- appl_73 `pseq` klCons (Types.Atom (Types.Str "A")) appl_73 - kl_V2695 `pseq` (appl_74 `pseq` kl_elementP kl_V2695 appl_74) - -kl_shen_alphanumsP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_alphanumsP (!kl_V2697) = do let pat_cond_0 = do return (Atom (B True)) - pat_cond_1 = do !kl_if_2 <- kl_V2697 `pseq` kl_shen_PlusstringP kl_V2697 - case kl_if_2 of - Atom (B (True)) -> do !appl_3 <- kl_V2697 `pseq` pos kl_V2697 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_4 <- appl_3 `pseq` kl_shen_alphanumP appl_3 - case kl_if_4 of - Atom (B (True)) -> do !appl_5 <- kl_V2697 `pseq` tlstr kl_V2697 - !kl_if_6 <- appl_5 `pseq` kl_shen_alphanumsP appl_5 - 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" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do let !aw_7 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_7 [ApplC (wrapNamed "shen.alphanums?" kl_shen_alphanumsP)] - _ -> throwError "if: expected boolean" - in case kl_V2697 of - kl_V2697@(Atom (Str "")) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_alphanumP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_alphanumP (!kl_V2699) = do !kl_if_0 <- kl_V2699 `pseq` kl_shen_alphaP kl_V2699 - case kl_if_0 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_1 <- kl_V2699 `pseq` kl_shen_digitP kl_V2699 - case kl_if_1 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - -kl_shen_digitP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_digitP (!kl_V2701) = do !appl_0 <- klCons (Types.Atom (Types.Str "0")) (Types.Atom Types.Nil) - !appl_1 <- appl_0 `pseq` klCons (Types.Atom (Types.Str "9")) appl_0 - !appl_2 <- appl_1 `pseq` klCons (Types.Atom (Types.Str "8")) appl_1 - !appl_3 <- appl_2 `pseq` klCons (Types.Atom (Types.Str "7")) appl_2 - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.Str "6")) appl_3 - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.Str "5")) appl_4 - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.Str "4")) appl_5 - !appl_7 <- appl_6 `pseq` klCons (Types.Atom (Types.Str "3")) appl_6 - !appl_8 <- appl_7 `pseq` klCons (Types.Atom (Types.Str "2")) appl_7 - !appl_9 <- appl_8 `pseq` klCons (Types.Atom (Types.Str "1")) appl_8 - kl_V2701 `pseq` (appl_9 `pseq` kl_elementP kl_V2701 appl_9) - -kl_variableP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_variableP (!kl_V2703) = do !kl_if_0 <- kl_V2703 `pseq` kl_booleanP kl_V2703 - !kl_if_1 <- case kl_if_0 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_2 <- kl_V2703 `pseq` numberP kl_V2703 - !kl_if_3 <- case kl_if_2 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do !kl_if_4 <- kl_V2703 `pseq` stringP kl_V2703 - 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" - _ -> throwError "if: expected boolean" - 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" - _ -> throwError "if: expected boolean" - case kl_if_1 of - Atom (B (True)) -> do return (Atom (B False)) - Atom (B (False)) -> do do (do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_String) -> do kl_String `pseq` kl_shen_analyse_variableP kl_String))) - !appl_6 <- kl_V2703 `pseq` str kl_V2703 - appl_6 `pseq` applyWrapper appl_5 [appl_6]) `catchError` (\(!kl_E) -> do return (Atom (B False))) - _ -> throwError "if: expected boolean" - -kl_shen_analyse_variableP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_analyse_variableP (!kl_V2705) = do !kl_if_0 <- kl_V2705 `pseq` kl_shen_PlusstringP kl_V2705 - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- kl_V2705 `pseq` pos kl_V2705 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_2 <- appl_1 `pseq` kl_shen_uppercaseP appl_1 - case kl_if_2 of - Atom (B (True)) -> do !appl_3 <- kl_V2705 `pseq` tlstr kl_V2705 - !kl_if_4 <- appl_3 `pseq` kl_shen_alphanumsP appl_3 - case kl_if_4 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do let !aw_5 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_5 [ApplC (wrapNamed "shen.analyse-variable?" kl_shen_analyse_variableP)] - _ -> throwError "if: expected boolean" - -kl_shen_uppercaseP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_uppercaseP (!kl_V2707) = do !appl_0 <- klCons (Types.Atom (Types.Str "Z")) (Types.Atom Types.Nil) - !appl_1 <- appl_0 `pseq` klCons (Types.Atom (Types.Str "Y")) appl_0 - !appl_2 <- appl_1 `pseq` klCons (Types.Atom (Types.Str "X")) appl_1 - !appl_3 <- appl_2 `pseq` klCons (Types.Atom (Types.Str "W")) appl_2 - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.Str "V")) appl_3 - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.Str "U")) appl_4 - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.Str "T")) appl_5 - !appl_7 <- appl_6 `pseq` klCons (Types.Atom (Types.Str "S")) appl_6 - !appl_8 <- appl_7 `pseq` klCons (Types.Atom (Types.Str "R")) appl_7 - !appl_9 <- appl_8 `pseq` klCons (Types.Atom (Types.Str "Q")) appl_8 - !appl_10 <- appl_9 `pseq` klCons (Types.Atom (Types.Str "P")) appl_9 - !appl_11 <- appl_10 `pseq` klCons (Types.Atom (Types.Str "O")) appl_10 - !appl_12 <- appl_11 `pseq` klCons (Types.Atom (Types.Str "N")) appl_11 - !appl_13 <- appl_12 `pseq` klCons (Types.Atom (Types.Str "M")) appl_12 - !appl_14 <- appl_13 `pseq` klCons (Types.Atom (Types.Str "L")) appl_13 - !appl_15 <- appl_14 `pseq` klCons (Types.Atom (Types.Str "K")) appl_14 - !appl_16 <- appl_15 `pseq` klCons (Types.Atom (Types.Str "J")) appl_15 - !appl_17 <- appl_16 `pseq` klCons (Types.Atom (Types.Str "I")) appl_16 - !appl_18 <- appl_17 `pseq` klCons (Types.Atom (Types.Str "H")) appl_17 - !appl_19 <- appl_18 `pseq` klCons (Types.Atom (Types.Str "G")) appl_18 - !appl_20 <- appl_19 `pseq` klCons (Types.Atom (Types.Str "F")) appl_19 - !appl_21 <- appl_20 `pseq` klCons (Types.Atom (Types.Str "E")) appl_20 - !appl_22 <- appl_21 `pseq` klCons (Types.Atom (Types.Str "D")) appl_21 - !appl_23 <- appl_22 `pseq` klCons (Types.Atom (Types.Str "C")) appl_22 - !appl_24 <- appl_23 `pseq` klCons (Types.Atom (Types.Str "B")) appl_23 - !appl_25 <- appl_24 `pseq` klCons (Types.Atom (Types.Str "A")) appl_24 - kl_V2707 `pseq` (appl_25 `pseq` kl_elementP kl_V2707 appl_25) - -kl_gensym :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_gensym (!kl_V2709) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*gensym*")) - !appl_1 <- appl_0 `pseq` add (Types.Atom (Types.N (Types.KI 1))) appl_0 - !appl_2 <- appl_1 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*gensym*")) appl_1 - kl_V2709 `pseq` (appl_2 `pseq` kl_concat kl_V2709 appl_2) - -kl_concat :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_concat (!kl_V2712) (!kl_V2713) = do !appl_0 <- kl_V2712 `pseq` str kl_V2712 - !appl_1 <- kl_V2713 `pseq` str kl_V2713 - !appl_2 <- appl_0 `pseq` (appl_1 `pseq` cn appl_0 appl_1) - appl_2 `pseq` intern appl_2 - -kl_Atp :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_Atp (!kl_V2716) (!kl_V2717) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Vector) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Tag) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Fst) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Snd) -> do return kl_Vector))) - !appl_4 <- kl_Vector `pseq` (kl_V2717 `pseq` addressTo kl_Vector (Types.Atom (Types.N (Types.KI 2))) kl_V2717) - appl_4 `pseq` applyWrapper appl_3 [appl_4]))) - !appl_5 <- kl_Vector `pseq` (kl_V2716 `pseq` addressTo kl_Vector (Types.Atom (Types.N (Types.KI 1))) kl_V2716) - appl_5 `pseq` applyWrapper appl_2 [appl_5]))) - !appl_6 <- kl_Vector `pseq` addressTo kl_Vector (Types.Atom (Types.N (Types.KI 0))) (Types.Atom (Types.UnboundSym "shen.tuple")) - appl_6 `pseq` applyWrapper appl_1 [appl_6]))) - !appl_7 <- absvector (Types.Atom (Types.N (Types.KI 3))) - appl_7 `pseq` applyWrapper appl_0 [appl_7] - -kl_fst :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_fst (!kl_V2719) = do kl_V2719 `pseq` addressFrom kl_V2719 (Types.Atom (Types.N (Types.KI 1))) - -kl_snd :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_snd (!kl_V2721) = do kl_V2721 `pseq` addressFrom kl_V2721 (Types.Atom (Types.N (Types.KI 2))) - -kl_tupleP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_tupleP (!kl_V2723) = do (do !kl_if_0 <- kl_V2723 `pseq` absvectorP kl_V2723 - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- kl_V2723 `pseq` addressFrom kl_V2723 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_2 <- appl_1 `pseq` eq (Types.Atom (Types.UnboundSym "shen.tuple")) appl_1 - case kl_if_2 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean") `catchError` (\(!kl_E) -> do return (Atom (B False))) - -kl_append :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_append (!kl_V2726) (!kl_V2727) = do let pat_cond_0 = do return kl_V2727 - pat_cond_1 kl_V2726 kl_V2726h kl_V2726t = do !appl_2 <- kl_V2726t `pseq` (kl_V2727 `pseq` kl_append kl_V2726t kl_V2727) - kl_V2726h `pseq` (appl_2 `pseq` klCons kl_V2726h appl_2) - pat_cond_3 = do do let !aw_4 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_4 [ApplC (wrapNamed "append" kl_append)] - in case kl_V2726 of - kl_V2726@(Atom (Nil)) -> pat_cond_0 - !(kl_V2726@(Cons (!kl_V2726h) - (!kl_V2726t))) -> pat_cond_1 kl_V2726 kl_V2726h kl_V2726t - _ -> pat_cond_3 - -kl_Atv :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_Atv (!kl_V2730) (!kl_V2731) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Limit) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_NewVector) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_XPlusNewVector) -> do let pat_cond_3 = do return kl_XPlusNewVector - pat_cond_4 = do do kl_V2731 `pseq` (kl_Limit `pseq` (kl_XPlusNewVector `pseq` kl_shen_Atv_help kl_V2731 (Types.Atom (Types.N (Types.KI 1))) kl_Limit kl_XPlusNewVector)) - in case kl_Limit of - kl_Limit@(Atom (N (KI 0))) -> pat_cond_3 - _ -> pat_cond_4))) - !appl_5 <- kl_NewVector `pseq` (kl_V2730 `pseq` kl_vector_RB kl_NewVector (Types.Atom (Types.N (Types.KI 1))) kl_V2730) - appl_5 `pseq` applyWrapper appl_2 [appl_5]))) - !appl_6 <- kl_Limit `pseq` add kl_Limit (Types.Atom (Types.N (Types.KI 1))) - !appl_7 <- appl_6 `pseq` kl_vector appl_6 - appl_7 `pseq` applyWrapper appl_1 [appl_7]))) - !appl_8 <- kl_V2731 `pseq` kl_limit kl_V2731 - appl_8 `pseq` applyWrapper appl_0 [appl_8] - -kl_shen_Atv_help :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_Atv_help (!kl_V2737) (!kl_V2738) (!kl_V2739) (!kl_V2740) = do !kl_if_0 <- kl_V2739 `pseq` (kl_V2738 `pseq` eq kl_V2739 kl_V2738) - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- kl_V2739 `pseq` add kl_V2739 (Types.Atom (Types.N (Types.KI 1))) - kl_V2737 `pseq` (kl_V2740 `pseq` (kl_V2739 `pseq` (appl_1 `pseq` kl_shen_copyfromvector kl_V2737 kl_V2740 kl_V2739 appl_1))) - Atom (B (False)) -> do do !appl_2 <- kl_V2738 `pseq` add kl_V2738 (Types.Atom (Types.N (Types.KI 1))) - !appl_3 <- kl_V2738 `pseq` add kl_V2738 (Types.Atom (Types.N (Types.KI 1))) - !appl_4 <- kl_V2737 `pseq` (kl_V2740 `pseq` (kl_V2738 `pseq` (appl_3 `pseq` kl_shen_copyfromvector kl_V2737 kl_V2740 kl_V2738 appl_3))) - kl_V2737 `pseq` (appl_2 `pseq` (kl_V2739 `pseq` (appl_4 `pseq` kl_shen_Atv_help kl_V2737 appl_2 kl_V2739 appl_4))) - _ -> throwError "if: expected boolean" - -kl_shen_copyfromvector :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_copyfromvector (!kl_V2745) (!kl_V2746) (!kl_V2747) (!kl_V2748) = do (do !appl_0 <- kl_V2745 `pseq` (kl_V2747 `pseq` kl_LB_vector kl_V2745 kl_V2747) - kl_V2746 `pseq` (kl_V2748 `pseq` (appl_0 `pseq` kl_vector_RB kl_V2746 kl_V2748 appl_0))) `catchError` (\(!kl_E) -> do return kl_V2746) - -kl_hdv :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_hdv (!kl_V2750) = do (do kl_V2750 `pseq` kl_LB_vector kl_V2750 (Types.Atom (Types.N (Types.KI 1)))) `catchError` (\(!kl_E) -> do let !aw_0 = Types.Atom (Types.UnboundSym "shen.app") - !appl_1 <- kl_V2750 `pseq` applyWrapper aw_0 [kl_V2750, - Types.Atom (Types.Str "\n"), - Types.Atom (Types.UnboundSym "shen.s")] - !appl_2 <- appl_1 `pseq` cn (Types.Atom (Types.Str "hdv needs a non-empty vector as an argument; not ")) appl_1 - appl_2 `pseq` simpleError appl_2) - -kl_tlv :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_tlv (!kl_V2752) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Limit) -> do let pat_cond_1 = do simpleError (Types.Atom (Types.Str "cannot take the tail of the empty vector\n")) - pat_cond_2 = do do let pat_cond_3 = do kl_vector (Types.Atom (Types.N (Types.KI 0))) - pat_cond_4 = do do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_NewVector) -> do !appl_6 <- kl_Limit `pseq` Primitives.subtract kl_Limit (Types.Atom (Types.N (Types.KI 1))) - !appl_7 <- appl_6 `pseq` kl_vector appl_6 - kl_V2752 `pseq` (kl_Limit `pseq` (appl_7 `pseq` kl_shen_tlv_help kl_V2752 (Types.Atom (Types.N (Types.KI 2))) kl_Limit appl_7))))) - !appl_8 <- kl_Limit `pseq` Primitives.subtract kl_Limit (Types.Atom (Types.N (Types.KI 1))) - !appl_9 <- appl_8 `pseq` kl_vector appl_8 - appl_9 `pseq` applyWrapper appl_5 [appl_9] - in case kl_Limit of - kl_Limit@(Atom (N (KI 1))) -> pat_cond_3 - _ -> pat_cond_4 - in case kl_Limit of - kl_Limit@(Atom (N (KI 0))) -> pat_cond_1 - _ -> pat_cond_2))) - !appl_10 <- kl_V2752 `pseq` kl_limit kl_V2752 - appl_10 `pseq` applyWrapper appl_0 [appl_10] - -kl_shen_tlv_help :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_tlv_help (!kl_V2758) (!kl_V2759) (!kl_V2760) (!kl_V2761) = do !kl_if_0 <- kl_V2760 `pseq` (kl_V2759 `pseq` eq kl_V2760 kl_V2759) - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- kl_V2760 `pseq` Primitives.subtract kl_V2760 (Types.Atom (Types.N (Types.KI 1))) - kl_V2758 `pseq` (kl_V2761 `pseq` (kl_V2760 `pseq` (appl_1 `pseq` kl_shen_copyfromvector kl_V2758 kl_V2761 kl_V2760 appl_1))) - Atom (B (False)) -> do do !appl_2 <- kl_V2759 `pseq` add kl_V2759 (Types.Atom (Types.N (Types.KI 1))) - !appl_3 <- kl_V2759 `pseq` Primitives.subtract kl_V2759 (Types.Atom (Types.N (Types.KI 1))) - !appl_4 <- kl_V2758 `pseq` (kl_V2761 `pseq` (kl_V2759 `pseq` (appl_3 `pseq` kl_shen_copyfromvector kl_V2758 kl_V2761 kl_V2759 appl_3))) - kl_V2758 `pseq` (appl_2 `pseq` (kl_V2760 `pseq` (appl_4 `pseq` kl_shen_tlv_help kl_V2758 appl_2 kl_V2760 appl_4))) - _ -> throwError "if: expected boolean" - -kl_assoc :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_assoc (!kl_V2773) (!kl_V2774) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V2774 kl_V2774h kl_V2774hh kl_V2774ht kl_V2774t = do return kl_V2774h - pat_cond_2 kl_V2774 kl_V2774h kl_V2774t = do kl_V2773 `pseq` (kl_V2774t `pseq` kl_assoc kl_V2773 kl_V2774t) - pat_cond_3 = do do let !aw_4 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_4 [ApplC (wrapNamed "assoc" kl_assoc)] - in case kl_V2774 of - kl_V2774@(Atom (Nil)) -> pat_cond_0 - !(kl_V2774@(Cons (!(kl_V2774h@(Cons (!kl_V2774hh) - (!kl_V2774ht)))) - (!kl_V2774t))) | eqCore kl_V2774hh kl_V2773 -> pat_cond_1 kl_V2774 kl_V2774h kl_V2774hh kl_V2774ht kl_V2774t - !(kl_V2774@(Cons (!kl_V2774h) - (!kl_V2774t))) -> pat_cond_2 kl_V2774 kl_V2774h kl_V2774t - _ -> pat_cond_3 - -kl_booleanP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_booleanP (!kl_V2780) = do let pat_cond_0 = do return (Atom (B True)) - pat_cond_1 = do return (Atom (B True)) - pat_cond_2 = do do return (Atom (B False)) - in case kl_V2780 of - kl_V2780@(Atom (UnboundSym "true")) -> pat_cond_0 - kl_V2780@(Atom (B (True))) -> pat_cond_0 - kl_V2780@(Atom (UnboundSym "false")) -> pat_cond_1 - kl_V2780@(Atom (B (False))) -> pat_cond_1 - _ -> pat_cond_2 - -kl_nl :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_nl (!kl_V2782) = do let pat_cond_0 = do return (Types.Atom (Types.N (Types.KI 0))) - pat_cond_1 = do do !appl_2 <- kl_stoutput - let !aw_3 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_4 <- appl_2 `pseq` applyWrapper aw_3 [Types.Atom (Types.Str "\n"), - appl_2] - !appl_5 <- kl_V2782 `pseq` Primitives.subtract kl_V2782 (Types.Atom (Types.N (Types.KI 1))) - !appl_6 <- appl_5 `pseq` kl_nl appl_5 - appl_4 `pseq` (appl_6 `pseq` kl_do appl_4 appl_6) - in case kl_V2782 of - kl_V2782@(Atom (N (KI 0))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_difference :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_difference (!kl_V2787) (!kl_V2788) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V2787 kl_V2787h kl_V2787t = do !kl_if_2 <- kl_V2787h `pseq` (kl_V2788 `pseq` kl_elementP kl_V2787h kl_V2788) - case kl_if_2 of - Atom (B (True)) -> do kl_V2787t `pseq` (kl_V2788 `pseq` kl_difference kl_V2787t kl_V2788) - Atom (B (False)) -> do do !appl_3 <- kl_V2787t `pseq` (kl_V2788 `pseq` kl_difference kl_V2787t kl_V2788) - kl_V2787h `pseq` (appl_3 `pseq` klCons kl_V2787h appl_3) - _ -> throwError "if: expected boolean" - pat_cond_4 = do do let !aw_5 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_5 [ApplC (wrapNamed "difference" kl_difference)] - in case kl_V2787 of - kl_V2787@(Atom (Nil)) -> pat_cond_0 - !(kl_V2787@(Cons (!kl_V2787h) - (!kl_V2787t))) -> pat_cond_1 kl_V2787 kl_V2787h kl_V2787t - _ -> pat_cond_4 - -kl_do :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_do (!kl_V2791) (!kl_V2792) = do return kl_V2792 - -{- -kl_elementP :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_elementP (!kl_V1594) (!kl_V1595) = do let !appl_0 = List [] - !kl_if_1 <- appl_0 `pseq` (kl_V1595 `pseq` eq appl_0 kl_V1595) - klIf kl_if_1 (do return (Atom (B False))) (do !kl_if_2 <- kl_V1595 `pseq` consP kl_V1595 - !kl_if_3 <- klIf kl_if_2 (do !appl_4 <- kl_V1595 `pseq` hd kl_V1595 - appl_4 `pseq` (kl_V1594 `pseq` eq appl_4 kl_V1594)) (do return (Atom (B False))) - klIf kl_if_3 (do return (Atom (B True))) (do !kl_if_5 <- kl_V1595 `pseq` consP kl_V1595 - klIf kl_if_5 (do !appl_6 <- kl_V1595 `pseq` tl kl_V1595 - kl_V1594 `pseq` (appl_6 `pseq` kl_elementP kl_V1594 appl_6)) (do klIf (Atom (B True)) (do let !aw_7 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_7 [ApplC (wrapNamed "element?" kl_elementP)]) (do return (List []))))) --} - -kl_elementP :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_elementP !v (Atom Nil) = return (Atom (B False)) -kl_elementP !v (Cons h hs) = do - case eqCore h v of - True -> return (Atom (B True)) - False -> kl_elementP v hs -kl_elementP _ _ = applyWrapper (Atom (UnboundSym "shen.f_error")) [ApplC (wrapNamed "element?" kl_elementP)] - -kl_emptyP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_emptyP (!kl_V2811) = do let pat_cond_0 = do return (Atom (B True)) - pat_cond_1 = do do return (Atom (B False)) - in case kl_V2811 of - kl_V2811@(Atom (Nil)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_fix :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_fix (!kl_V2814) (!kl_V2815) = do !appl_0 <- kl_V2815 `pseq` applyWrapper kl_V2814 [kl_V2815] - kl_V2814 `pseq` (kl_V2815 `pseq` (appl_0 `pseq` kl_shen_fix_help kl_V2814 kl_V2815 appl_0)) - -kl_shen_fix_help :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_fix_help (!kl_V2826) (!kl_V2827) (!kl_V2828) = do !kl_if_0 <- kl_V2828 `pseq` (kl_V2827 `pseq` eq kl_V2828 kl_V2827) - case kl_if_0 of - Atom (B (True)) -> do return kl_V2828 - Atom (B (False)) -> do do !appl_1 <- kl_V2828 `pseq` applyWrapper kl_V2826 [kl_V2828] - kl_V2826 `pseq` (kl_V2828 `pseq` (appl_1 `pseq` kl_shen_fix_help kl_V2826 kl_V2828 appl_1)) - _ -> throwError "if: expected boolean" - -kl_put :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_put (!kl_V2833) (!kl_V2834) (!kl_V2835) (!kl_V2836) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_N) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Entry) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Change) -> do return kl_V2835))) - !appl_3 <- kl_V2833 `pseq` (kl_V2834 `pseq` (kl_V2835 `pseq` (kl_Entry `pseq` kl_shen_change_pointer_value kl_V2833 kl_V2834 kl_V2835 kl_Entry))) - !appl_4 <- kl_V2836 `pseq` (kl_N `pseq` (appl_3 `pseq` kl_vector_RB kl_V2836 kl_N appl_3)) - appl_4 `pseq` applyWrapper appl_2 [appl_4]))) - !appl_5 <- (do kl_V2836 `pseq` (kl_N `pseq` kl_LB_vector kl_V2836 kl_N)) `catchError` (\(!kl_E) -> do return (Types.Atom Types.Nil)) - appl_5 `pseq` applyWrapper appl_1 [appl_5]))) - !appl_6 <- kl_V2836 `pseq` kl_limit kl_V2836 - !appl_7 <- kl_V2833 `pseq` (appl_6 `pseq` kl_hash kl_V2833 appl_6) - appl_7 `pseq` applyWrapper appl_0 [appl_7] - -kl_unput :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_unput (!kl_V2840) (!kl_V2841) (!kl_V2842) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_N) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Entry) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Change) -> do return kl_V2840))) - !appl_3 <- kl_V2840 `pseq` (kl_V2841 `pseq` (kl_Entry `pseq` kl_shen_remove_pointer kl_V2840 kl_V2841 kl_Entry)) - !appl_4 <- kl_V2842 `pseq` (kl_N `pseq` (appl_3 `pseq` kl_vector_RB kl_V2842 kl_N appl_3)) - appl_4 `pseq` applyWrapper appl_2 [appl_4]))) - !appl_5 <- (do kl_V2842 `pseq` (kl_N `pseq` kl_LB_vector kl_V2842 kl_N)) `catchError` (\(!kl_E) -> do return (Types.Atom Types.Nil)) - appl_5 `pseq` applyWrapper appl_1 [appl_5]))) - !appl_6 <- kl_V2842 `pseq` kl_limit kl_V2842 - !appl_7 <- kl_V2840 `pseq` (appl_6 `pseq` kl_hash kl_V2840 appl_6) - appl_7 `pseq` applyWrapper appl_0 [appl_7] - -kl_shen_remove_pointer :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_remove_pointer (!kl_V2850) (!kl_V2851) (!kl_V2852) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V2852 kl_V2852h kl_V2852hh kl_V2852hhh kl_V2852hht kl_V2852hhth kl_V2852ht kl_V2852t = do return kl_V2852t - pat_cond_2 kl_V2852 kl_V2852h kl_V2852t = do !appl_3 <- kl_V2850 `pseq` (kl_V2851 `pseq` (kl_V2852t `pseq` kl_shen_remove_pointer kl_V2850 kl_V2851 kl_V2852t)) - kl_V2852h `pseq` (appl_3 `pseq` klCons kl_V2852h appl_3) - pat_cond_4 = do do let !aw_5 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_5 [ApplC (wrapNamed "shen.remove-pointer" kl_shen_remove_pointer)] - in case kl_V2852 of - kl_V2852@(Atom (Nil)) -> pat_cond_0 - !(kl_V2852@(Cons (!(kl_V2852h@(Cons (!(kl_V2852hh@(Cons (!kl_V2852hhh) - (!(kl_V2852hht@(Cons (!kl_V2852hhth) - (Atom (Nil)))))))) - (!kl_V2852ht)))) - (!kl_V2852t))) | eqCore kl_V2852hhth kl_V2851 && eqCore kl_V2852hhh kl_V2850 -> pat_cond_1 kl_V2852 kl_V2852h kl_V2852hh kl_V2852hhh kl_V2852hht kl_V2852hhth kl_V2852ht kl_V2852t - !(kl_V2852@(Cons (!kl_V2852h) - (!kl_V2852t))) -> pat_cond_2 kl_V2852 kl_V2852h kl_V2852t - _ -> pat_cond_4 - -kl_shen_change_pointer_value :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_change_pointer_value (!kl_V2861) (!kl_V2862) (!kl_V2863) (!kl_V2864) = do let pat_cond_0 = do !appl_1 <- kl_V2862 `pseq` klCons kl_V2862 (Types.Atom Types.Nil) - !appl_2 <- kl_V2861 `pseq` (appl_1 `pseq` klCons kl_V2861 appl_1) - !appl_3 <- appl_2 `pseq` (kl_V2863 `pseq` klCons appl_2 kl_V2863) - appl_3 `pseq` klCons appl_3 (Types.Atom Types.Nil) - pat_cond_4 kl_V2864 kl_V2864h kl_V2864hh kl_V2864hhh kl_V2864hht kl_V2864hhth kl_V2864ht kl_V2864t = do !appl_5 <- kl_V2864hh `pseq` (kl_V2863 `pseq` klCons kl_V2864hh kl_V2863) - appl_5 `pseq` (kl_V2864t `pseq` klCons appl_5 kl_V2864t) - pat_cond_6 kl_V2864 kl_V2864h kl_V2864t = do !appl_7 <- kl_V2861 `pseq` (kl_V2862 `pseq` (kl_V2863 `pseq` (kl_V2864t `pseq` kl_shen_change_pointer_value kl_V2861 kl_V2862 kl_V2863 kl_V2864t))) - kl_V2864h `pseq` (appl_7 `pseq` klCons kl_V2864h appl_7) - pat_cond_8 = do do let !aw_9 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_9 [ApplC (wrapNamed "shen.change-pointer-value" kl_shen_change_pointer_value)] - in case kl_V2864 of - kl_V2864@(Atom (Nil)) -> pat_cond_0 - !(kl_V2864@(Cons (!(kl_V2864h@(Cons (!(kl_V2864hh@(Cons (!kl_V2864hhh) - (!(kl_V2864hht@(Cons (!kl_V2864hhth) - (Atom (Nil)))))))) - (!kl_V2864ht)))) - (!kl_V2864t))) | eqCore kl_V2864hhth kl_V2862 && eqCore kl_V2864hhh kl_V2861 -> pat_cond_4 kl_V2864 kl_V2864h kl_V2864hh kl_V2864hhh kl_V2864hht kl_V2864hhth kl_V2864ht kl_V2864t - !(kl_V2864@(Cons (!kl_V2864h) - (!kl_V2864t))) -> pat_cond_6 kl_V2864 kl_V2864h kl_V2864t - _ -> pat_cond_8 - -kl_get :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_get (!kl_V2868) (!kl_V2869) (!kl_V2870) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_N) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Entry) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Result) -> do !kl_if_3 <- kl_Result `pseq` kl_emptyP kl_Result - case kl_if_3 of - Atom (B (True)) -> do simpleError (Types.Atom (Types.Str "value not found\n")) - Atom (B (False)) -> do do kl_Result `pseq` tl kl_Result - _ -> throwError "if: expected boolean"))) - !appl_4 <- kl_V2869 `pseq` klCons kl_V2869 (Types.Atom Types.Nil) - !appl_5 <- kl_V2868 `pseq` (appl_4 `pseq` klCons kl_V2868 appl_4) - !appl_6 <- appl_5 `pseq` (kl_Entry `pseq` kl_assoc appl_5 kl_Entry) - appl_6 `pseq` applyWrapper appl_2 [appl_6]))) - !appl_7 <- (do kl_V2870 `pseq` (kl_N `pseq` kl_LB_vector kl_V2870 kl_N)) `catchError` (\(!kl_E) -> do simpleError (Types.Atom (Types.Str "pointer not found\n"))) - appl_7 `pseq` applyWrapper appl_1 [appl_7]))) - !appl_8 <- kl_V2870 `pseq` kl_limit kl_V2870 - !appl_9 <- kl_V2868 `pseq` (appl_8 `pseq` kl_hash kl_V2868 appl_8) - appl_9 `pseq` applyWrapper appl_0 [appl_9] - -kl_hash :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_hash (!kl_V2873) (!kl_V2874) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Hash) -> do let pat_cond_1 = do return (Types.Atom (Types.N (Types.KI 1))) - pat_cond_2 = do do return kl_Hash - in case kl_Hash of - kl_Hash@(Atom (N (KI 0))) -> pat_cond_1 - _ -> pat_cond_2))) - let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` stringToN kl_X))) - !appl_4 <- kl_V2873 `pseq` kl_explode kl_V2873 - !appl_5 <- appl_3 `pseq` (appl_4 `pseq` kl_map appl_3 appl_4) - !appl_6 <- appl_5 `pseq` kl_sum appl_5 - !appl_7 <- appl_6 `pseq` (kl_V2874 `pseq` kl_shen_mod appl_6 kl_V2874) - appl_7 `pseq` applyWrapper appl_0 [appl_7] - -kl_shen_mod :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_mod (!kl_V2877) (!kl_V2878) = do !appl_0 <- kl_V2878 `pseq` klCons kl_V2878 (Types.Atom Types.Nil) - !appl_1 <- kl_V2877 `pseq` (appl_0 `pseq` kl_shen_multiples kl_V2877 appl_0) - kl_V2877 `pseq` (appl_1 `pseq` kl_shen_modh kl_V2877 appl_1) - -kl_shen_multiples :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_multiples (!kl_V2881) (!kl_V2882) = do !kl_if_0 <- let pat_cond_1 kl_V2882 kl_V2882h kl_V2882t = do !kl_if_2 <- kl_V2882h `pseq` (kl_V2881 `pseq` greaterThan kl_V2882h kl_V2881) - 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_3 = do do return (Atom (B False)) - in case kl_V2882 of - !(kl_V2882@(Cons (!kl_V2882h) - (!kl_V2882t))) -> pat_cond_1 kl_V2882 kl_V2882h kl_V2882t - _ -> pat_cond_3 - case kl_if_0 of - Atom (B (True)) -> do kl_V2882 `pseq` tl kl_V2882 - Atom (B (False)) -> do let pat_cond_4 kl_V2882 kl_V2882h kl_V2882t = do !appl_5 <- kl_V2882h `pseq` multiply (Types.Atom (Types.N (Types.KI 2))) kl_V2882h - !appl_6 <- appl_5 `pseq` (kl_V2882 `pseq` klCons appl_5 kl_V2882) - kl_V2881 `pseq` (appl_6 `pseq` kl_shen_multiples kl_V2881 appl_6) - pat_cond_7 = do do let !aw_8 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_8 [ApplC (wrapNamed "shen.multiples" kl_shen_multiples)] - in case kl_V2882 of - !(kl_V2882@(Cons (!kl_V2882h) - (!kl_V2882t))) -> pat_cond_4 kl_V2882 kl_V2882h kl_V2882t - _ -> pat_cond_7 - _ -> throwError "if: expected boolean" - -kl_shen_modh :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_modh (!kl_V2887) (!kl_V2888) = do let pat_cond_0 = do return (Types.Atom (Types.N (Types.KI 0))) - pat_cond_1 = do let pat_cond_2 = do return kl_V2887 - pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V2888 kl_V2888h kl_V2888t = do !kl_if_6 <- kl_V2888h `pseq` (kl_V2887 `pseq` greaterThan kl_V2888h kl_V2887) - 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_7 = do do return (Atom (B False)) - in case kl_V2888 of - !(kl_V2888@(Cons (!kl_V2888h) - (!kl_V2888t))) -> pat_cond_5 kl_V2888 kl_V2888h kl_V2888t - _ -> pat_cond_7 - case kl_if_4 of - Atom (B (True)) -> do !appl_8 <- kl_V2888 `pseq` tl kl_V2888 - !kl_if_9 <- appl_8 `pseq` kl_emptyP appl_8 - case kl_if_9 of - Atom (B (True)) -> do return kl_V2887 - Atom (B (False)) -> do do !appl_10 <- kl_V2888 `pseq` tl kl_V2888 - kl_V2887 `pseq` (appl_10 `pseq` kl_shen_modh kl_V2887 appl_10) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do let pat_cond_11 kl_V2888 kl_V2888h kl_V2888t = do !appl_12 <- kl_V2887 `pseq` (kl_V2888h `pseq` Primitives.subtract kl_V2887 kl_V2888h) - appl_12 `pseq` (kl_V2888 `pseq` kl_shen_modh appl_12 kl_V2888) - pat_cond_13 = do do let !aw_14 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_14 [ApplC (wrapNamed "shen.modh" kl_shen_modh)] - in case kl_V2888 of - !(kl_V2888@(Cons (!kl_V2888h) - (!kl_V2888t))) -> pat_cond_11 kl_V2888 kl_V2888h kl_V2888t - _ -> pat_cond_13 - _ -> throwError "if: expected boolean" - in case kl_V2888 of - kl_V2888@(Atom (Nil)) -> pat_cond_2 - _ -> pat_cond_3 - in case kl_V2887 of - kl_V2887@(Atom (N (KI 0))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_sum :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_sum (!kl_V2890) = do let pat_cond_0 = do return (Types.Atom (Types.N (Types.KI 0))) - pat_cond_1 kl_V2890 kl_V2890h kl_V2890t = do !appl_2 <- kl_V2890t `pseq` kl_sum kl_V2890t - kl_V2890h `pseq` (appl_2 `pseq` add kl_V2890h appl_2) - pat_cond_3 = do do let !aw_4 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_4 [ApplC (wrapNamed "sum" kl_sum)] - in case kl_V2890 of - kl_V2890@(Atom (Nil)) -> pat_cond_0 - !(kl_V2890@(Cons (!kl_V2890h) - (!kl_V2890t))) -> pat_cond_1 kl_V2890 kl_V2890h kl_V2890t - _ -> pat_cond_3 - -kl_head :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_head (!kl_V2898) = do let pat_cond_0 kl_V2898 kl_V2898h kl_V2898t = do return kl_V2898h - pat_cond_1 = do do simpleError (Types.Atom (Types.Str "head expects a non-empty list")) - in case kl_V2898 of - !(kl_V2898@(Cons (!kl_V2898h) - (!kl_V2898t))) -> pat_cond_0 kl_V2898 kl_V2898h kl_V2898t - _ -> pat_cond_1 - -kl_tail :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_tail (!kl_V2906) = do let pat_cond_0 kl_V2906 kl_V2906h kl_V2906t = do return kl_V2906t - pat_cond_1 = do do simpleError (Types.Atom (Types.Str "tail expects a non-empty list")) - in case kl_V2906 of - !(kl_V2906@(Cons (!kl_V2906h) - (!kl_V2906t))) -> pat_cond_0 kl_V2906 kl_V2906h kl_V2906t - _ -> pat_cond_1 - -kl_hdstr :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_hdstr (!kl_V2908) = do kl_V2908 `pseq` pos kl_V2908 (Types.Atom (Types.N (Types.KI 0))) - -kl_intersection :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_intersection (!kl_V2913) (!kl_V2914) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V2913 kl_V2913h kl_V2913t = do !kl_if_2 <- kl_V2913h `pseq` (kl_V2914 `pseq` kl_elementP kl_V2913h kl_V2914) - case kl_if_2 of - Atom (B (True)) -> do !appl_3 <- kl_V2913t `pseq` (kl_V2914 `pseq` kl_intersection kl_V2913t kl_V2914) - kl_V2913h `pseq` (appl_3 `pseq` klCons kl_V2913h appl_3) - Atom (B (False)) -> do do kl_V2913t `pseq` (kl_V2914 `pseq` kl_intersection kl_V2913t kl_V2914) - _ -> throwError "if: expected boolean" - pat_cond_4 = do do let !aw_5 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_5 [ApplC (wrapNamed "intersection" kl_intersection)] - in case kl_V2913 of - kl_V2913@(Atom (Nil)) -> pat_cond_0 - !(kl_V2913@(Cons (!kl_V2913h) - (!kl_V2913t))) -> pat_cond_1 kl_V2913 kl_V2913h kl_V2913t - _ -> pat_cond_4 - -kl_reverse :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_reverse (!kl_V2916) = do kl_V2916 `pseq` kl_shen_reverse_help kl_V2916 (Types.Atom Types.Nil) - -kl_shen_reverse_help :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_reverse_help (!kl_V2919) (!kl_V2920) = do let pat_cond_0 = do return kl_V2920 - pat_cond_1 kl_V2919 kl_V2919h kl_V2919t = do !appl_2 <- kl_V2919h `pseq` (kl_V2920 `pseq` klCons kl_V2919h kl_V2920) - kl_V2919t `pseq` (appl_2 `pseq` kl_shen_reverse_help kl_V2919t appl_2) - pat_cond_3 = do do let !aw_4 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_4 [ApplC (wrapNamed "shen.reverse_help" kl_shen_reverse_help)] - in case kl_V2919 of - kl_V2919@(Atom (Nil)) -> pat_cond_0 - !(kl_V2919@(Cons (!kl_V2919h) - (!kl_V2919t))) -> pat_cond_1 kl_V2919 kl_V2919h kl_V2919t - _ -> pat_cond_3 - -kl_union :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_union (!kl_V2923) (!kl_V2924) = do let pat_cond_0 = do return kl_V2924 - pat_cond_1 kl_V2923 kl_V2923h kl_V2923t = do !kl_if_2 <- kl_V2923h `pseq` (kl_V2924 `pseq` kl_elementP kl_V2923h kl_V2924) - case kl_if_2 of - Atom (B (True)) -> do kl_V2923t `pseq` (kl_V2924 `pseq` kl_union kl_V2923t kl_V2924) - Atom (B (False)) -> do do !appl_3 <- kl_V2923t `pseq` (kl_V2924 `pseq` kl_union kl_V2923t kl_V2924) - kl_V2923h `pseq` (appl_3 `pseq` klCons kl_V2923h appl_3) - _ -> throwError "if: expected boolean" - pat_cond_4 = do do let !aw_5 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_5 [ApplC (wrapNamed "union" kl_union)] - in case kl_V2923 of - kl_V2923@(Atom (Nil)) -> pat_cond_0 - !(kl_V2923@(Cons (!kl_V2923h) - (!kl_V2923t))) -> pat_cond_1 kl_V2923 kl_V2923h kl_V2923t - _ -> pat_cond_4 - -kl_y_or_nP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_y_or_nP (!kl_V2926) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Message) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Y_or_N) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Input) -> do let pat_cond_3 = do return (Atom (B True)) - pat_cond_4 = do do let pat_cond_5 = do return (Atom (B False)) - pat_cond_6 = do do !appl_7 <- kl_stoutput - let !aw_8 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_9 <- appl_7 `pseq` applyWrapper aw_8 [Types.Atom (Types.Str "please answer y or n\n"), - appl_7] - !appl_10 <- kl_V2926 `pseq` kl_y_or_nP kl_V2926 - appl_9 `pseq` (appl_10 `pseq` kl_do appl_9 appl_10) - in case kl_Input of - kl_Input@(Atom (Str "n")) -> pat_cond_5 - _ -> pat_cond_6 - in case kl_Input of - kl_Input@(Atom (Str "y")) -> pat_cond_3 - _ -> pat_cond_4))) - !appl_11 <- kl_stinput - let !aw_12 = Types.Atom (Types.UnboundSym "read") - !appl_13 <- appl_11 `pseq` applyWrapper aw_12 [appl_11] - let !aw_14 = Types.Atom (Types.UnboundSym "shen.app") - !appl_15 <- appl_13 `pseq` applyWrapper aw_14 [appl_13, - Types.Atom (Types.Str ""), - Types.Atom (Types.UnboundSym "shen.s")] - appl_15 `pseq` applyWrapper appl_2 [appl_15]))) - !appl_16 <- kl_stoutput - let !aw_17 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_18 <- appl_16 `pseq` applyWrapper aw_17 [Types.Atom (Types.Str " (y/n) "), - appl_16] - appl_18 `pseq` applyWrapper appl_1 [appl_18]))) - let !aw_19 = Types.Atom (Types.UnboundSym "shen.proc-nl") - !appl_20 <- kl_V2926 `pseq` applyWrapper aw_19 [kl_V2926] - !appl_21 <- kl_stoutput - let !aw_22 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_23 <- appl_20 `pseq` (appl_21 `pseq` applyWrapper aw_22 [appl_20, - appl_21]) - appl_23 `pseq` applyWrapper appl_0 [appl_23] - -kl_not :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_not (!kl_V2928) = do case kl_V2928 of - Atom (B (True)) -> do return (Atom (B False)) - Atom (B (False)) -> do do return (Atom (B True)) - _ -> throwError "if: expected boolean" - -kl_subst :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_subst (!kl_V2941) (!kl_V2942) (!kl_V2943) = do !kl_if_0 <- kl_V2943 `pseq` (kl_V2942 `pseq` eq kl_V2943 kl_V2942) - case kl_if_0 of - Atom (B (True)) -> do return kl_V2941 - Atom (B (False)) -> do let pat_cond_1 kl_V2943 kl_V2943h kl_V2943t = do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_W) -> do kl_V2941 `pseq` (kl_V2942 `pseq` (kl_W `pseq` kl_subst kl_V2941 kl_V2942 kl_W))))) - appl_2 `pseq` (kl_V2943 `pseq` kl_map appl_2 kl_V2943) - pat_cond_3 = do do return kl_V2943 - in case kl_V2943 of - !(kl_V2943@(Cons (!kl_V2943h) - (!kl_V2943t))) -> pat_cond_1 kl_V2943 kl_V2943h kl_V2943t - _ -> pat_cond_3 - _ -> throwError "if: expected boolean" - -kl_explode :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_explode (!kl_V2945) = do let !aw_0 = Types.Atom (Types.UnboundSym "shen.app") - !appl_1 <- kl_V2945 `pseq` applyWrapper aw_0 [kl_V2945, - Types.Atom (Types.Str ""), - Types.Atom (Types.UnboundSym "shen.a")] - appl_1 `pseq` kl_shen_explode_h appl_1 - -kl_shen_explode_h :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_explode_h (!kl_V2947) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 = do !kl_if_2 <- kl_V2947 `pseq` kl_shen_PlusstringP kl_V2947 - case kl_if_2 of - Atom (B (True)) -> do !appl_3 <- kl_V2947 `pseq` pos kl_V2947 (Types.Atom (Types.N (Types.KI 0))) - !appl_4 <- kl_V2947 `pseq` tlstr kl_V2947 - !appl_5 <- appl_4 `pseq` kl_shen_explode_h appl_4 - appl_3 `pseq` (appl_5 `pseq` klCons appl_3 appl_5) - Atom (B (False)) -> do do let !aw_6 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_6 [ApplC (wrapNamed "shen.explode-h" kl_shen_explode_h)] - _ -> throwError "if: expected boolean" - in case kl_V2947 of - kl_V2947@(Atom (Str "")) -> pat_cond_0 - _ -> pat_cond_1 - -kl_cd :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_cd (!kl_V2949) = do !appl_0 <- let pat_cond_1 = do return (Types.Atom (Types.Str "")) - pat_cond_2 = do do let !aw_3 = Types.Atom (Types.UnboundSym "shen.app") - kl_V2949 `pseq` applyWrapper aw_3 [kl_V2949, - Types.Atom (Types.Str "/"), - Types.Atom (Types.UnboundSym "shen.a")] - in case kl_V2949 of - kl_V2949@(Atom (Str "")) -> pat_cond_1 - _ -> pat_cond_2 - appl_0 `pseq` klSet (Types.Atom (Types.UnboundSym "*home-directory*")) appl_0 - -kl_map :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_map (!kl_V2952) (!kl_V2953) = do kl_V2952 `pseq` (kl_V2953 `pseq` kl_shen_map_h kl_V2952 kl_V2953 (Types.Atom Types.Nil)) - -kl_shen_map_h :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_map_h (!kl_V2959) (!kl_V2960) (!kl_V2961) = do let pat_cond_0 = do kl_V2961 `pseq` kl_reverse kl_V2961 - pat_cond_1 kl_V2960 kl_V2960h kl_V2960t = do !appl_2 <- kl_V2960h `pseq` applyWrapper kl_V2959 [kl_V2960h] - !appl_3 <- appl_2 `pseq` (kl_V2961 `pseq` klCons appl_2 kl_V2961) - kl_V2959 `pseq` (kl_V2960t `pseq` (appl_3 `pseq` kl_shen_map_h kl_V2959 kl_V2960t appl_3)) - pat_cond_4 = do do let !aw_5 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_5 [ApplC (wrapNamed "shen.map-h" kl_shen_map_h)] - in case kl_V2960 of - kl_V2960@(Atom (Nil)) -> pat_cond_0 - !(kl_V2960@(Cons (!kl_V2960h) - (!kl_V2960t))) -> pat_cond_1 kl_V2960 kl_V2960h kl_V2960t - _ -> pat_cond_4 - -kl_length :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_length (!kl_V2963) = do kl_V2963 `pseq` kl_shen_length_h kl_V2963 (Types.Atom (Types.N (Types.KI 0))) - -kl_shen_length_h :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_length_h (!kl_V2966) (!kl_V2967) = do let pat_cond_0 = do return kl_V2967 - pat_cond_1 = do do !appl_2 <- kl_V2966 `pseq` tl kl_V2966 - !appl_3 <- kl_V2967 `pseq` add kl_V2967 (Types.Atom (Types.N (Types.KI 1))) - appl_2 `pseq` (appl_3 `pseq` kl_shen_length_h appl_2 appl_3) - in case kl_V2966 of - kl_V2966@(Atom (Nil)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_occurrences :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_occurrences (!kl_V2979) (!kl_V2980) = do !kl_if_0 <- kl_V2980 `pseq` (kl_V2979 `pseq` eq kl_V2980 kl_V2979) - case kl_if_0 of - Atom (B (True)) -> do return (Types.Atom (Types.N (Types.KI 1))) - Atom (B (False)) -> do let pat_cond_1 kl_V2980 kl_V2980h kl_V2980t = do !appl_2 <- kl_V2979 `pseq` (kl_V2980h `pseq` kl_occurrences kl_V2979 kl_V2980h) - !appl_3 <- kl_V2979 `pseq` (kl_V2980t `pseq` kl_occurrences kl_V2979 kl_V2980t) - appl_2 `pseq` (appl_3 `pseq` add appl_2 appl_3) - pat_cond_4 = do do return (Types.Atom (Types.N (Types.KI 0))) - in case kl_V2980 of - !(kl_V2980@(Cons (!kl_V2980h) - (!kl_V2980t))) -> pat_cond_1 kl_V2980 kl_V2980h kl_V2980t - _ -> pat_cond_4 - _ -> throwError "if: expected boolean" - -kl_nth :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_nth (!kl_V2989) (!kl_V2990) = do !kl_if_0 <- let pat_cond_1 = do let pat_cond_2 kl_V2990 kl_V2990h kl_V2990t = do return (Atom (B True)) - pat_cond_3 = do do return (Atom (B False)) - in case kl_V2990 of - !(kl_V2990@(Cons (!kl_V2990h) - (!kl_V2990t))) -> pat_cond_2 kl_V2990 kl_V2990h kl_V2990t - _ -> pat_cond_3 - pat_cond_4 = do do return (Atom (B False)) - in case kl_V2989 of - kl_V2989@(Atom (N (KI 1))) -> pat_cond_1 - _ -> pat_cond_4 - case kl_if_0 of - Atom (B (True)) -> do kl_V2990 `pseq` hd kl_V2990 - Atom (B (False)) -> do let pat_cond_5 kl_V2990 kl_V2990h kl_V2990t = do !appl_6 <- kl_V2989 `pseq` Primitives.subtract kl_V2989 (Types.Atom (Types.N (Types.KI 1))) - appl_6 `pseq` (kl_V2990t `pseq` kl_nth appl_6 kl_V2990t) - pat_cond_7 = do do let !aw_8 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_8 [ApplC (wrapNamed "nth" kl_nth)] - in case kl_V2990 of - !(kl_V2990@(Cons (!kl_V2990h) - (!kl_V2990t))) -> pat_cond_5 kl_V2990 kl_V2990h kl_V2990t - _ -> pat_cond_7 - _ -> throwError "if: expected boolean" - -{- -kl_integerP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_integerP (!kl_V2992) = do !kl_if_0 <- kl_V2992 `pseq` numberP kl_V2992 - case kl_if_0 of - Atom (B (True)) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Abs) -> do !appl_2 <- kl_Abs `pseq` kl_shen_magless kl_Abs (Types.Atom (Types.N (Types.KI 1))) - kl_Abs `pseq` (appl_2 `pseq` kl_shen_integer_testP kl_Abs appl_2)))) - !appl_3 <- kl_V2992 `pseq` kl_shen_abs kl_V2992 - !kl_if_4 <- appl_3 `pseq` applyWrapper appl_1 [appl_3] - case kl_if_4 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" --} - -kl_integerP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_integerP (Atom (N (KI _))) = return (Atom (B True)) -kl_integerP (Atom (N (KD d))) = return (Atom (B (fromInteger (round d) == d))) -kl_integerP !v = return (Atom (B False)) - -kl_shen_abs :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_abs (!kl_V2994) = do !kl_if_0 <- kl_V2994 `pseq` greaterThan kl_V2994 (Types.Atom (Types.N (Types.KI 0))) - case kl_if_0 of - Atom (B (True)) -> do return kl_V2994 - Atom (B (False)) -> do do kl_V2994 `pseq` Primitives.subtract (Types.Atom (Types.N (Types.KI 0))) kl_V2994 - _ -> throwError "if: expected boolean" - -kl_shen_magless :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_magless (!kl_V2997) (!kl_V2998) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Nx2) -> do !kl_if_1 <- kl_Nx2 `pseq` (kl_V2997 `pseq` greaterThan kl_Nx2 kl_V2997) - case kl_if_1 of - Atom (B (True)) -> do return kl_V2998 - Atom (B (False)) -> do do kl_V2997 `pseq` (kl_Nx2 `pseq` kl_shen_magless kl_V2997 kl_Nx2) - _ -> throwError "if: expected boolean"))) - !appl_2 <- kl_V2998 `pseq` multiply kl_V2998 (Types.Atom (Types.N (Types.KI 2))) - appl_2 `pseq` applyWrapper appl_0 [appl_2] - -kl_shen_integer_testP :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_integer_testP (!kl_V3004) (!kl_V3005) = do let pat_cond_0 = do return (Atom (B True)) - pat_cond_1 = do !kl_if_2 <- kl_V3004 `pseq` greaterThan (Types.Atom (Types.N (Types.KI 1))) kl_V3004 - case kl_if_2 of - Atom (B (True)) -> do return (Atom (B False)) - Atom (B (False)) -> do do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Abs_N) -> do !kl_if_4 <- kl_Abs_N `pseq` greaterThan (Types.Atom (Types.N (Types.KI 0))) kl_Abs_N - case kl_if_4 of - Atom (B (True)) -> do kl_V3004 `pseq` kl_integerP kl_V3004 - Atom (B (False)) -> do do kl_Abs_N `pseq` (kl_V3005 `pseq` kl_shen_integer_testP kl_Abs_N kl_V3005) - _ -> throwError "if: expected boolean"))) - !appl_5 <- kl_V3004 `pseq` (kl_V3005 `pseq` Primitives.subtract kl_V3004 kl_V3005) - appl_5 `pseq` applyWrapper appl_3 [appl_5] - _ -> throwError "if: expected boolean" - in case kl_V3004 of - kl_V3004@(Atom (N (KI 0))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_mapcan :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_mapcan (!kl_V3010) (!kl_V3011) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V3011 kl_V3011h kl_V3011t = do !appl_2 <- kl_V3011h `pseq` applyWrapper kl_V3010 [kl_V3011h] - !appl_3 <- kl_V3010 `pseq` (kl_V3011t `pseq` kl_mapcan kl_V3010 kl_V3011t) - appl_2 `pseq` (appl_3 `pseq` kl_append appl_2 appl_3) - pat_cond_4 = do do let !aw_5 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_5 [ApplC (wrapNamed "mapcan" kl_mapcan)] - in case kl_V3011 of - kl_V3011@(Atom (Nil)) -> pat_cond_0 - !(kl_V3011@(Cons (!kl_V3011h) - (!kl_V3011t))) -> pat_cond_1 kl_V3011 kl_V3011h kl_V3011t - _ -> pat_cond_4 - -kl_EqEq :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_EqEq (!kl_V3023) (!kl_V3024) = do !kl_if_0 <- kl_V3024 `pseq` (kl_V3023 `pseq` eq kl_V3024 kl_V3023) - case kl_if_0 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - -kl_abort :: Types.KLContext Types.Env Types.KLValue -kl_abort = do simpleError (Types.Atom (Types.Str "")) - -kl_boundP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_boundP (!kl_V3026) = do !kl_if_0 <- kl_V3026 `pseq` kl_symbolP kl_V3026 - case kl_if_0 of - Atom (B (True)) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Val) -> do let pat_cond_2 = do return (Atom (B False)) - pat_cond_3 = do do return (Atom (B True)) - in case kl_Val of - kl_Val@(Atom (UnboundSym "shen.this-symbol-is-unbound")) -> pat_cond_2 - kl_Val@(ApplC (PL "shen.this-symbol-is-unbound" - _)) -> pat_cond_2 - kl_Val@(ApplC (Func "shen.this-symbol-is-unbound" - _)) -> pat_cond_2 - _ -> pat_cond_3))) - !appl_4 <- (do kl_V3026 `pseq` value kl_V3026) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.UnboundSym "shen.this-symbol-is-unbound"))) - !kl_if_5 <- appl_4 `pseq` applyWrapper appl_1 [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" - -kl_shen_string_RBbytes :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_string_RBbytes (!kl_V3028) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 = do do !appl_2 <- kl_V3028 `pseq` pos kl_V3028 (Types.Atom (Types.N (Types.KI 0))) - !appl_3 <- appl_2 `pseq` stringToN appl_2 - !appl_4 <- kl_V3028 `pseq` tlstr kl_V3028 - !appl_5 <- appl_4 `pseq` kl_shen_string_RBbytes appl_4 - appl_3 `pseq` (appl_5 `pseq` klCons appl_3 appl_5) - in case kl_V3028 of - kl_V3028@(Atom (Str "")) -> pat_cond_0 - _ -> pat_cond_1 - -kl_maxinferences :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_maxinferences (!kl_V3030) = do kl_V3030 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*maxinferences*")) kl_V3030 - -kl_inferences :: Types.KLContext Types.Env Types.KLValue -kl_inferences = do value (Types.Atom (Types.UnboundSym "shen.*infs*")) - -kl_protect :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_protect (!kl_V3032) = do return kl_V3032 - -kl_stoutput :: Types.KLContext Types.Env Types.KLValue -kl_stoutput = do value (Types.Atom (Types.UnboundSym "*stoutput*")) - -kl_string_RBsymbol :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_string_RBsymbol (!kl_V3034) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Symbol) -> do !kl_if_1 <- kl_Symbol `pseq` kl_symbolP kl_Symbol - case kl_if_1 of - Atom (B (True)) -> do return kl_Symbol - Atom (B (False)) -> do do let !aw_2 = Types.Atom (Types.UnboundSym "shen.app") - !appl_3 <- kl_V3034 `pseq` applyWrapper aw_2 [kl_V3034, - Types.Atom (Types.Str " to a symbol"), - Types.Atom (Types.UnboundSym "shen.s")] - !appl_4 <- appl_3 `pseq` cn (Types.Atom (Types.Str "cannot intern ")) appl_3 - appl_4 `pseq` simpleError appl_4 - _ -> throwError "if: expected boolean"))) - !appl_5 <- kl_V3034 `pseq` intern kl_V3034 - appl_5 `pseq` applyWrapper appl_0 [appl_5] - -kl_optimise :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_optimise (!kl_V3040) = do let pat_cond_0 = do klSet (Types.Atom (Types.UnboundSym "shen.*optimise*")) (Atom (B True)) - pat_cond_1 = do klSet (Types.Atom (Types.UnboundSym "shen.*optimise*")) (Atom (B False)) - pat_cond_2 = do do simpleError (Types.Atom (Types.Str "optimise expects a + or a -.\n")) - in case kl_V3040 of - kl_V3040@(Atom (UnboundSym "+")) -> pat_cond_0 - kl_V3040@(ApplC (PL "+" _)) -> pat_cond_0 - kl_V3040@(ApplC (Func "+" _)) -> pat_cond_0 - kl_V3040@(Atom (UnboundSym "-")) -> pat_cond_1 - kl_V3040@(ApplC (PL "-" _)) -> pat_cond_1 - kl_V3040@(ApplC (Func "-" _)) -> pat_cond_1 - _ -> pat_cond_2 - -kl_os :: Types.KLContext Types.Env Types.KLValue -kl_os = do value (Types.Atom (Types.UnboundSym "*os*")) - -kl_language :: Types.KLContext Types.Env Types.KLValue -kl_language = do value (Types.Atom (Types.UnboundSym "*language*")) - -kl_version :: Types.KLContext Types.Env Types.KLValue -kl_version = do value (Types.Atom (Types.UnboundSym "*version*")) - -kl_port :: Types.KLContext Types.Env Types.KLValue -kl_port = do value (Types.Atom (Types.UnboundSym "*port*")) - -kl_porters :: Types.KLContext Types.Env Types.KLValue -kl_porters = do value (Types.Atom (Types.UnboundSym "*porters*")) - -kl_implementation :: Types.KLContext Types.Env Types.KLValue -kl_implementation = do value (Types.Atom (Types.UnboundSym "*implementation*")) - -kl_release :: Types.KLContext Types.Env Types.KLValue -kl_release = do value (Types.Atom (Types.UnboundSym "*release*")) - -kl_packageP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_packageP (!kl_V3042) = do (do !appl_0 <- kl_V3042 `pseq` kl_external kl_V3042 - appl_0 `pseq` kl_do appl_0 (Atom (B True))) `catchError` (\(!kl_E) -> do return (Atom (B False))) - -kl_function :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_function (!kl_V3044) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*symbol-table*")) - kl_V3044 `pseq` (appl_0 `pseq` kl_shen_lookup_func kl_V3044 appl_0) - -kl_shen_lookup_func :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_lookup_func (!kl_V3054) (!kl_V3055) = do let pat_cond_0 = do let !aw_1 = Types.Atom (Types.UnboundSym "shen.app") - !appl_2 <- kl_V3054 `pseq` applyWrapper aw_1 [kl_V3054, - Types.Atom (Types.Str " has no lambda expansion\n"), - Types.Atom (Types.UnboundSym "shen.a")] - appl_2 `pseq` simpleError appl_2 - pat_cond_3 kl_V3055 kl_V3055h kl_V3055hh kl_V3055ht kl_V3055t = do return kl_V3055ht - pat_cond_4 kl_V3055 kl_V3055h kl_V3055t = do kl_V3054 `pseq` (kl_V3055t `pseq` kl_shen_lookup_func kl_V3054 kl_V3055t) - pat_cond_5 = do do let !aw_6 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_6 [ApplC (wrapNamed "shen.lookup-func" kl_shen_lookup_func)] - in case kl_V3055 of - kl_V3055@(Atom (Nil)) -> pat_cond_0 - !(kl_V3055@(Cons (!(kl_V3055h@(Cons (!kl_V3055hh) - (!kl_V3055ht)))) - (!kl_V3055t))) | eqCore kl_V3055hh kl_V3054 -> pat_cond_3 kl_V3055 kl_V3055h kl_V3055hh kl_V3055ht kl_V3055t - !(kl_V3055@(Cons (!kl_V3055h) - (!kl_V3055t))) -> pat_cond_4 kl_V3055 kl_V3055h kl_V3055t - _ -> pat_cond_5 - -expr2 :: Types.KLContext Types.Env Types.KLValue -expr2 = 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"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Sys where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel +import Backend.Core + +{- +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_thaw :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_thaw (!kl_V2632) = do applyWrapper kl_V2632 [] + +kl_eval :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_eval (!kl_V2634) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Macroexpand) -> do !kl_if_1 <- kl_Macroexpand `pseq` kl_shen_packagedP kl_Macroexpand + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_eval_without_macros kl_Z))) + !appl_3 <- kl_Macroexpand `pseq` kl_shen_package_contents kl_Macroexpand + appl_2 `pseq` (appl_3 `pseq` kl_map appl_2 appl_3) + Atom (B (False)) -> do do kl_Macroexpand `pseq` kl_shen_eval_without_macros kl_Macroexpand + _ -> throwError "if: expected boolean"))) + let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "macroexpand") + kl_Y `pseq` applyWrapper aw_5 [kl_Y]))) + !appl_6 <- appl_4 `pseq` (kl_V2634 `pseq` kl_shen_walk appl_4 kl_V2634) + appl_6 `pseq` applyWrapper appl_0 [appl_6] + +kl_shen_eval_without_macros :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_eval_without_macros (!kl_V2636) = do !appl_0 <- kl_V2636 `pseq` kl_shen_proc_inputPlus kl_V2636 + !appl_1 <- appl_0 `pseq` kl_shen_elim_def appl_0 + appl_1 `pseq` evalKL appl_1 + +kl_shen_proc_inputPlus :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_proc_inputPlus (!kl_V2638) = do !kl_if_0 <- let pat_cond_1 kl_V2638 kl_V2638h kl_V2638t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V2638t kl_V2638th kl_V2638tt = do !kl_if_6 <- let pat_cond_7 kl_V2638tt kl_V2638tth kl_V2638ttt = do let !appl_8 = Atom Nil + !kl_if_9 <- appl_8 `pseq` (kl_V2638ttt `pseq` eq appl_8 kl_V2638ttt) + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_10 = do do return (Atom (B False)) + in case kl_V2638tt of + !(kl_V2638tt@(Cons (!kl_V2638tth) + (!kl_V2638ttt))) -> pat_cond_7 kl_V2638tt kl_V2638tth kl_V2638ttt + _ -> pat_cond_10 + case kl_if_6 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_11 = do do return (Atom (B False)) + in case kl_V2638t of + !(kl_V2638t@(Cons (!kl_V2638th) + (!kl_V2638tt))) -> pat_cond_5 kl_V2638t kl_V2638th kl_V2638tt + _ -> pat_cond_11 + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V2638h of + kl_V2638h@(Atom (UnboundSym "input+")) -> pat_cond_3 + kl_V2638h@(ApplC (PL "input+" + _)) -> pat_cond_3 + kl_V2638h@(ApplC (Func "input+" + _)) -> pat_cond_3 + _ -> pat_cond_12 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_13 = do do return (Atom (B False)) + in case kl_V2638 of + !(kl_V2638@(Cons (!kl_V2638h) + (!kl_V2638t))) -> pat_cond_1 kl_V2638 kl_V2638h kl_V2638t + _ -> pat_cond_13 + case kl_if_0 of + Atom (B (True)) -> do !appl_14 <- kl_V2638 `pseq` tl kl_V2638 + !appl_15 <- appl_14 `pseq` hd appl_14 + let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "shen.rcons_form") + !appl_17 <- appl_15 `pseq` applyWrapper aw_16 [appl_15] + !appl_18 <- kl_V2638 `pseq` tl kl_V2638 + !appl_19 <- appl_18 `pseq` tl appl_18 + !appl_20 <- appl_17 `pseq` (appl_19 `pseq` klCons appl_17 appl_19) + appl_20 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "input+")) appl_20 + Atom (B (False)) -> do !kl_if_21 <- let pat_cond_22 kl_V2638 kl_V2638h kl_V2638t = do !kl_if_23 <- let pat_cond_24 = do !kl_if_25 <- let pat_cond_26 kl_V2638t kl_V2638th kl_V2638tt = do !kl_if_27 <- let pat_cond_28 kl_V2638tt kl_V2638tth kl_V2638ttt = do let !appl_29 = Atom Nil + !kl_if_30 <- appl_29 `pseq` (kl_V2638ttt `pseq` eq appl_29 kl_V2638ttt) + case kl_if_30 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_31 = do do return (Atom (B False)) + in case kl_V2638tt of + !(kl_V2638tt@(Cons (!kl_V2638tth) + (!kl_V2638ttt))) -> pat_cond_28 kl_V2638tt kl_V2638tth kl_V2638ttt + _ -> pat_cond_31 + 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_32 = do do return (Atom (B False)) + in case kl_V2638t of + !(kl_V2638t@(Cons (!kl_V2638th) + (!kl_V2638tt))) -> pat_cond_26 kl_V2638t kl_V2638th kl_V2638tt + _ -> pat_cond_32 + 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_33 = do do return (Atom (B False)) + in case kl_V2638h of + kl_V2638h@(Atom (UnboundSym "shen.read+")) -> pat_cond_24 + kl_V2638h@(ApplC (PL "shen.read+" + _)) -> pat_cond_24 + kl_V2638h@(ApplC (Func "shen.read+" + _)) -> pat_cond_24 + _ -> pat_cond_33 + 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_34 = do do return (Atom (B False)) + in case kl_V2638 of + !(kl_V2638@(Cons (!kl_V2638h) + (!kl_V2638t))) -> pat_cond_22 kl_V2638 kl_V2638h kl_V2638t + _ -> pat_cond_34 + case kl_if_21 of + Atom (B (True)) -> do !appl_35 <- kl_V2638 `pseq` tl kl_V2638 + !appl_36 <- appl_35 `pseq` hd appl_35 + let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "shen.rcons_form") + !appl_38 <- appl_36 `pseq` applyWrapper aw_37 [appl_36] + !appl_39 <- kl_V2638 `pseq` tl kl_V2638 + !appl_40 <- appl_39 `pseq` tl appl_39 + !appl_41 <- appl_38 `pseq` (appl_40 `pseq` klCons appl_38 appl_40) + appl_41 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.read+")) appl_41 + Atom (B (False)) -> do let pat_cond_42 kl_V2638 kl_V2638h kl_V2638t = do let !appl_43 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_proc_inputPlus kl_Z))) + appl_43 `pseq` (kl_V2638 `pseq` kl_map appl_43 kl_V2638) + pat_cond_44 = do do return kl_V2638 + in case kl_V2638 of + !(kl_V2638@(Cons (!kl_V2638h) + (!kl_V2638t))) -> pat_cond_42 kl_V2638 kl_V2638h kl_V2638t + _ -> pat_cond_44 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_elim_def :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_elim_def (!kl_V2640) = do let pat_cond_0 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt = do kl_V2640th `pseq` (kl_V2640tt `pseq` kl_shen_RBkl kl_V2640th kl_V2640tt) + pat_cond_1 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt = do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Default) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Def) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_MacroAdd) -> do return kl_Def))) + !appl_5 <- kl_V2640th `pseq` kl_shen_add_macro kl_V2640th + appl_5 `pseq` applyWrapper appl_4 [appl_5]))) + !appl_6 <- kl_V2640tt `pseq` (kl_Default `pseq` kl_append kl_V2640tt kl_Default) + !appl_7 <- kl_V2640th `pseq` (appl_6 `pseq` klCons kl_V2640th appl_6) + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "define")) appl_7 + !appl_9 <- appl_8 `pseq` kl_shen_elim_def appl_8 + appl_9 `pseq` applyWrapper appl_3 [appl_9]))) + let !appl_10 = Atom Nil + !appl_11 <- appl_10 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_10 + !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "->")) appl_11 + !appl_13 <- appl_12 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_12 + appl_13 `pseq` applyWrapper appl_2 [appl_13] + pat_cond_14 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt = do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "shen.yacc") + !appl_16 <- kl_V2640 `pseq` applyWrapper aw_15 [kl_V2640] + appl_16 `pseq` kl_shen_elim_def appl_16 + pat_cond_17 kl_V2640 kl_V2640h kl_V2640t = do let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_elim_def kl_Z))) + appl_18 `pseq` (kl_V2640 `pseq` kl_map appl_18 kl_V2640) + pat_cond_19 = do do return kl_V2640 + in case kl_V2640 of + !(kl_V2640@(Cons (Atom (UnboundSym "define")) + (!(kl_V2640t@(Cons (!kl_V2640th) + (!kl_V2640tt)))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt + !(kl_V2640@(Cons (ApplC (PL "define" _)) + (!(kl_V2640t@(Cons (!kl_V2640th) + (!kl_V2640tt)))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt + !(kl_V2640@(Cons (ApplC (Func "define" _)) + (!(kl_V2640t@(Cons (!kl_V2640th) + (!kl_V2640tt)))))) -> pat_cond_0 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt + !(kl_V2640@(Cons (Atom (UnboundSym "defmacro")) + (!(kl_V2640t@(Cons (!kl_V2640th) + (!kl_V2640tt)))))) -> pat_cond_1 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt + !(kl_V2640@(Cons (ApplC (PL "defmacro" _)) + (!(kl_V2640t@(Cons (!kl_V2640th) + (!kl_V2640tt)))))) -> pat_cond_1 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt + !(kl_V2640@(Cons (ApplC (Func "defmacro" _)) + (!(kl_V2640t@(Cons (!kl_V2640th) + (!kl_V2640tt)))))) -> pat_cond_1 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt + !(kl_V2640@(Cons (Atom (UnboundSym "defcc")) + (!(kl_V2640t@(Cons (!kl_V2640th) + (!kl_V2640tt)))))) -> pat_cond_14 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt + !(kl_V2640@(Cons (ApplC (PL "defcc" _)) + (!(kl_V2640t@(Cons (!kl_V2640th) + (!kl_V2640tt)))))) -> pat_cond_14 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt + !(kl_V2640@(Cons (ApplC (Func "defcc" _)) + (!(kl_V2640t@(Cons (!kl_V2640th) + (!kl_V2640tt)))))) -> pat_cond_14 kl_V2640 kl_V2640t kl_V2640th kl_V2640tt + !(kl_V2640@(Cons (!kl_V2640h) + (!kl_V2640t))) -> pat_cond_17 kl_V2640 kl_V2640h kl_V2640t + _ -> pat_cond_19 + +kl_shen_add_macro :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_add_macro (!kl_V2642) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_MacroReg) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_NewMacroReg) -> do !kl_if_2 <- kl_MacroReg `pseq` (kl_NewMacroReg `pseq` eq kl_MacroReg kl_NewMacroReg) + case kl_if_2 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do !appl_3 <- kl_V2642 `pseq` kl_function kl_V2642 + !appl_4 <- value (Core.Types.Atom (Core.Types.UnboundSym "*macros*")) + !appl_5 <- appl_3 `pseq` (appl_4 `pseq` klCons appl_3 appl_4) + appl_5 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "*macros*")) appl_5 + _ -> throwError "if: expected boolean"))) + !appl_6 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*macroreg*")) + let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "adjoin") + !appl_8 <- kl_V2642 `pseq` (appl_6 `pseq` applyWrapper aw_7 [kl_V2642, + appl_6]) + !appl_9 <- appl_8 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*macroreg*")) appl_8 + appl_9 `pseq` applyWrapper appl_1 [appl_9]))) + !appl_10 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*macroreg*")) + appl_10 `pseq` applyWrapper appl_0 [appl_10] + +kl_shen_packagedP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_packagedP (!kl_V2650) = do let pat_cond_0 kl_V2650 kl_V2650t kl_V2650th kl_V2650tt kl_V2650tth kl_V2650ttt = do return (Atom (B True)) + pat_cond_1 = do do return (Atom (B False)) + in case kl_V2650 of + !(kl_V2650@(Cons (Atom (UnboundSym "package")) + (!(kl_V2650t@(Cons (!kl_V2650th) + (!(kl_V2650tt@(Cons (!kl_V2650tth) + (!kl_V2650ttt))))))))) -> pat_cond_0 kl_V2650 kl_V2650t kl_V2650th kl_V2650tt kl_V2650tth kl_V2650ttt + !(kl_V2650@(Cons (ApplC (PL "package" _)) + (!(kl_V2650t@(Cons (!kl_V2650th) + (!(kl_V2650tt@(Cons (!kl_V2650tth) + (!kl_V2650ttt))))))))) -> pat_cond_0 kl_V2650 kl_V2650t kl_V2650th kl_V2650tt kl_V2650tth kl_V2650ttt + !(kl_V2650@(Cons (ApplC (Func "package" _)) + (!(kl_V2650t@(Cons (!kl_V2650th) + (!(kl_V2650tt@(Cons (!kl_V2650tth) + (!kl_V2650ttt))))))))) -> pat_cond_0 kl_V2650 kl_V2650t kl_V2650th kl_V2650tt kl_V2650tth kl_V2650ttt + _ -> pat_cond_1 + +kl_external :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_external (!kl_V2652) = do let !appl_0 = ApplC (PL "thunk" (do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_2 <- kl_V2652 `pseq` applyWrapper aw_1 [kl_V2652, + Core.Types.Atom (Core.Types.Str " has not been used.\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_3 <- appl_2 `pseq` cn (Core.Types.Atom (Core.Types.Str "package ")) appl_2 + appl_3 `pseq` simpleError appl_3)) + !appl_4 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + kl_V2652 `pseq` (appl_0 `pseq` (appl_4 `pseq` kl_getDivor kl_V2652 (Core.Types.Atom (Core.Types.UnboundSym "shen.external-symbols")) appl_0 appl_4)) + +kl_internal :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_internal (!kl_V2654) = do let !appl_0 = ApplC (PL "thunk" (do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_2 <- kl_V2654 `pseq` applyWrapper aw_1 [kl_V2654, + Core.Types.Atom (Core.Types.Str " has not been used.\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_3 <- appl_2 `pseq` cn (Core.Types.Atom (Core.Types.Str "package ")) appl_2 + appl_3 `pseq` simpleError appl_3)) + !appl_4 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + kl_V2654 `pseq` (appl_0 `pseq` (appl_4 `pseq` kl_getDivor kl_V2654 (Core.Types.Atom (Core.Types.UnboundSym "shen.internal-symbols")) appl_0 appl_4)) + +kl_shen_package_contents :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_package_contents (!kl_V2658) = do let pat_cond_0 kl_V2658 kl_V2658t kl_V2658tt kl_V2658tth kl_V2658ttt = do return kl_V2658ttt + pat_cond_1 kl_V2658 kl_V2658t kl_V2658th kl_V2658tt kl_V2658tth kl_V2658ttt = do let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.packageh") + kl_V2658th `pseq` (kl_V2658tth `pseq` (kl_V2658ttt `pseq` applyWrapper aw_2 [kl_V2658th, + kl_V2658tth, + kl_V2658ttt])) + pat_cond_3 = do do let !aw_4 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_4 [ApplC (wrapNamed "shen.package-contents" kl_shen_package_contents)] + in case kl_V2658 of + !(kl_V2658@(Cons (Atom (UnboundSym "package")) + (!(kl_V2658t@(Cons (Atom (UnboundSym "null")) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_0 kl_V2658 kl_V2658t kl_V2658tt kl_V2658tth kl_V2658ttt + !(kl_V2658@(Cons (Atom (UnboundSym "package")) + (!(kl_V2658t@(Cons (ApplC (PL "null" + _)) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_0 kl_V2658 kl_V2658t kl_V2658tt kl_V2658tth kl_V2658ttt + !(kl_V2658@(Cons (Atom (UnboundSym "package")) + (!(kl_V2658t@(Cons (ApplC (Func "null" + _)) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_0 kl_V2658 kl_V2658t kl_V2658tt kl_V2658tth kl_V2658ttt + !(kl_V2658@(Cons (ApplC (PL "package" _)) + (!(kl_V2658t@(Cons (Atom (UnboundSym "null")) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_0 kl_V2658 kl_V2658t kl_V2658tt kl_V2658tth kl_V2658ttt + !(kl_V2658@(Cons (ApplC (PL "package" _)) + (!(kl_V2658t@(Cons (ApplC (PL "null" + _)) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_0 kl_V2658 kl_V2658t kl_V2658tt kl_V2658tth kl_V2658ttt + !(kl_V2658@(Cons (ApplC (PL "package" _)) + (!(kl_V2658t@(Cons (ApplC (Func "null" + _)) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_0 kl_V2658 kl_V2658t kl_V2658tt kl_V2658tth kl_V2658ttt + !(kl_V2658@(Cons (ApplC (Func "package" _)) + (!(kl_V2658t@(Cons (Atom (UnboundSym "null")) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_0 kl_V2658 kl_V2658t kl_V2658tt kl_V2658tth kl_V2658ttt + !(kl_V2658@(Cons (ApplC (Func "package" _)) + (!(kl_V2658t@(Cons (ApplC (PL "null" + _)) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_0 kl_V2658 kl_V2658t kl_V2658tt kl_V2658tth kl_V2658ttt + !(kl_V2658@(Cons (ApplC (Func "package" _)) + (!(kl_V2658t@(Cons (ApplC (Func "null" + _)) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_0 kl_V2658 kl_V2658t kl_V2658tt kl_V2658tth kl_V2658ttt + !(kl_V2658@(Cons (Atom (UnboundSym "package")) + (!(kl_V2658t@(Cons (!kl_V2658th) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_1 kl_V2658 kl_V2658t kl_V2658th kl_V2658tt kl_V2658tth kl_V2658ttt + !(kl_V2658@(Cons (ApplC (PL "package" _)) + (!(kl_V2658t@(Cons (!kl_V2658th) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_1 kl_V2658 kl_V2658t kl_V2658th kl_V2658tt kl_V2658tth kl_V2658ttt + !(kl_V2658@(Cons (ApplC (Func "package" _)) + (!(kl_V2658t@(Cons (!kl_V2658th) + (!(kl_V2658tt@(Cons (!kl_V2658tth) + (!kl_V2658ttt))))))))) -> pat_cond_1 kl_V2658 kl_V2658t kl_V2658th kl_V2658tt kl_V2658tth kl_V2658ttt + _ -> pat_cond_3 + +kl_shen_walk :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_walk (!kl_V2661) (!kl_V2662) = do let pat_cond_0 kl_V2662 kl_V2662h kl_V2662t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_V2661 `pseq` (kl_Z `pseq` kl_shen_walk kl_V2661 kl_Z)))) + !appl_2 <- appl_1 `pseq` (kl_V2662 `pseq` kl_map appl_1 kl_V2662) + appl_2 `pseq` applyWrapper kl_V2661 [appl_2] + pat_cond_3 = do do kl_V2662 `pseq` applyWrapper kl_V2661 [kl_V2662] + in case kl_V2662 of + !(kl_V2662@(Cons (!kl_V2662h) + (!kl_V2662t))) -> pat_cond_0 kl_V2662 kl_V2662h kl_V2662t + _ -> pat_cond_3 + +kl_compile :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_compile (!kl_V2666) (!kl_V2667) (!kl_V2668) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_O) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_2 <- applyWrapper aw_1 [] + !kl_if_3 <- appl_2 `pseq` (kl_O `pseq` eq appl_2 kl_O) + !kl_if_4 <- case kl_if_3 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !appl_5 <- kl_O `pseq` hd kl_O + !appl_6 <- appl_5 `pseq` kl_emptyP appl_5 + !kl_if_7 <- appl_6 `pseq` kl_not appl_6 + case kl_if_7 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + case kl_if_4 of + Atom (B (True)) -> do kl_O `pseq` applyWrapper kl_V2668 [kl_O] + Atom (B (False)) -> do do let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.hdtl") + kl_O `pseq` applyWrapper aw_8 [kl_O] + _ -> throwError "if: expected boolean"))) + let !appl_9 = Atom Nil + let !appl_10 = Atom Nil + !appl_11 <- appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) + !appl_12 <- kl_V2667 `pseq` (appl_11 `pseq` klCons kl_V2667 appl_11) + !appl_13 <- appl_12 `pseq` applyWrapper kl_V2666 [appl_12] + appl_13 `pseq` applyWrapper appl_0 [appl_13] + +kl_fail_if :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_fail_if (!kl_V2671) (!kl_V2672) = do !kl_if_0 <- kl_V2672 `pseq` applyWrapper kl_V2671 [kl_V2672] + case kl_if_0 of + Atom (B (True)) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "fail") + applyWrapper aw_1 [] + Atom (B (False)) -> do do return kl_V2672 + _ -> throwError "if: expected boolean" + +kl_Ats :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_Ats (!kl_V2675) (!kl_V2676) = do kl_V2675 `pseq` (kl_V2676 `pseq` cn kl_V2675 kl_V2676) + +kl_tcP :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_tcP = do value (Core.Types.Atom (Core.Types.UnboundSym "shen.*tc*")) + +kl_ps :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_ps (!kl_V2678) = do let !appl_0 = ApplC (PL "thunk" (do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_2 <- kl_V2678 `pseq` applyWrapper aw_1 [kl_V2678, + Core.Types.Atom (Core.Types.Str " not found.\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + appl_2 `pseq` simpleError appl_2)) + !appl_3 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + kl_V2678 `pseq` (appl_0 `pseq` (appl_3 `pseq` kl_getDivor kl_V2678 (Core.Types.Atom (Core.Types.UnboundSym "shen.source")) appl_0 appl_3)) + +kl_stinput :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_stinput = do value (Core.Types.Atom (Core.Types.UnboundSym "*stinput*")) + +kl_LB_addressDivor :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_LB_addressDivor (!kl_V2682) (!kl_V2683) (!kl_V2684) = do (do kl_V2682 `pseq` (kl_V2683 `pseq` addressFrom kl_V2682 kl_V2683)) `catchError` (\(!kl_E) -> do kl_V2684 `pseq` kl_thaw kl_V2684) + +kl_valueDivor :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_valueDivor (!kl_V2687) (!kl_V2688) = do (do kl_V2687 `pseq` value kl_V2687) `catchError` (\(!kl_E) -> do kl_V2688 `pseq` kl_thaw kl_V2688) + +kl_vector :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_vector (!kl_V2690) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Vector) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_ZeroStamp) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Standard) -> do return kl_Standard))) + !appl_3 <- let pat_cond_4 = do return kl_ZeroStamp + pat_cond_5 = do do let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_7 <- applyWrapper aw_6 [] + kl_ZeroStamp `pseq` (kl_V2690 `pseq` (appl_7 `pseq` kl_shen_fillvector kl_ZeroStamp (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) kl_V2690 appl_7)) + in case kl_V2690 of + kl_V2690@(Atom (N (KI 0))) -> pat_cond_4 + _ -> pat_cond_5 + appl_3 `pseq` applyWrapper appl_2 [appl_3]))) + !appl_8 <- kl_Vector `pseq` (kl_V2690 `pseq` addressTo kl_Vector (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) kl_V2690) + appl_8 `pseq` applyWrapper appl_1 [appl_8]))) + !appl_9 <- kl_V2690 `pseq` add kl_V2690 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_10 <- appl_9 `pseq` absvector appl_9 + appl_10 `pseq` applyWrapper appl_0 [appl_10] + +kl_shen_fillvector :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_fillvector (!kl_V2696) (!kl_V2697) (!kl_V2698) (!kl_V2699) = do !kl_if_0 <- kl_V2698 `pseq` (kl_V2697 `pseq` eq kl_V2698 kl_V2697) + case kl_if_0 of + Atom (B (True)) -> do kl_V2696 `pseq` (kl_V2698 `pseq` (kl_V2699 `pseq` addressTo kl_V2696 kl_V2698 kl_V2699)) + Atom (B (False)) -> do do !appl_1 <- kl_V2696 `pseq` (kl_V2697 `pseq` (kl_V2699 `pseq` addressTo kl_V2696 kl_V2697 kl_V2699)) + !appl_2 <- kl_V2697 `pseq` add (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) kl_V2697 + appl_1 `pseq` (appl_2 `pseq` (kl_V2698 `pseq` (kl_V2699 `pseq` kl_shen_fillvector appl_1 appl_2 kl_V2698 kl_V2699))) + _ -> throwError "if: expected boolean" + +kl_vectorP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_vectorP (!kl_V2701) = do !kl_if_0 <- kl_V2701 `pseq` absvectorP kl_V2701 + case kl_if_0 of + Atom (B (True)) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_X) -> do !kl_if_2 <- kl_X `pseq` numberP kl_X + case kl_if_2 of + Atom (B (True)) -> do !kl_if_3 <- kl_X `pseq` greaterThanOrEqualTo kl_X (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean"))) + let !appl_4 = ApplC (PL "thunk" (do return (Core.Types.Atom (Core.Types.N (Core.Types.KI (-1)))))) + !appl_5 <- kl_V2701 `pseq` (appl_4 `pseq` kl_LB_addressDivor kl_V2701 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_4) + !kl_if_6 <- appl_5 `pseq` applyWrapper appl_1 [appl_5] + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + +kl_vector_RB :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_vector_RB (!kl_V2705) (!kl_V2706) (!kl_V2707) = do let pat_cond_0 = do simpleError (Core.Types.Atom (Core.Types.Str "cannot access 0th element of a vector\n")) + pat_cond_1 = do do kl_V2705 `pseq` (kl_V2706 `pseq` (kl_V2707 `pseq` addressTo kl_V2705 kl_V2706 kl_V2707)) + in case kl_V2706 of + kl_V2706@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_LB_vector :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_LB_vector (!kl_V2710) (!kl_V2711) = do let pat_cond_0 = do simpleError (Core.Types.Atom (Core.Types.Str "cannot access 0th element of a vector\n")) + pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_VectorElement) -> do let !aw_3 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_4 <- applyWrapper aw_3 [] + !kl_if_5 <- kl_VectorElement `pseq` (appl_4 `pseq` eq kl_VectorElement appl_4) + case kl_if_5 of + Atom (B (True)) -> do simpleError (Core.Types.Atom (Core.Types.Str "vector element not found\n")) + Atom (B (False)) -> do do return kl_VectorElement + _ -> throwError "if: expected boolean"))) + !appl_6 <- kl_V2710 `pseq` (kl_V2711 `pseq` addressFrom kl_V2710 kl_V2711) + appl_6 `pseq` applyWrapper appl_2 [appl_6] + in case kl_V2711 of + kl_V2711@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_LB_vectorDivor :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_LB_vectorDivor (!kl_V2715) (!kl_V2716) (!kl_V2717) = do let pat_cond_0 = do simpleError (Core.Types.Atom (Core.Types.Str "cannot access 0th element of a vector\n")) + pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_VectorElement) -> do let !aw_3 = Core.Types.Atom (Core.Types.UnboundSym "fail") + !appl_4 <- applyWrapper aw_3 [] + !kl_if_5 <- kl_VectorElement `pseq` (appl_4 `pseq` eq kl_VectorElement appl_4) + case kl_if_5 of + Atom (B (True)) -> do kl_V2717 `pseq` kl_thaw kl_V2717 + Atom (B (False)) -> do do return kl_VectorElement + _ -> throwError "if: expected boolean"))) + !appl_6 <- kl_V2715 `pseq` (kl_V2716 `pseq` (kl_V2717 `pseq` kl_LB_addressDivor kl_V2715 kl_V2716 kl_V2717)) + appl_6 `pseq` applyWrapper appl_2 [appl_6] + in case kl_V2716 of + kl_V2716@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_posintP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_posintP (!kl_V2719) = do !kl_if_0 <- kl_V2719 `pseq` kl_integerP kl_V2719 + case kl_if_0 of + Atom (B (True)) -> do !kl_if_1 <- kl_V2719 `pseq` greaterThanOrEqualTo kl_V2719 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + case kl_if_1 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + +kl_limit :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_limit (!kl_V2721) = do kl_V2721 `pseq` addressFrom kl_V2721 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + +kl_symbolP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_symbolP (!kl_V2723) = do !kl_if_0 <- kl_V2723 `pseq` kl_booleanP kl_V2723 + !kl_if_1 <- case kl_if_0 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_2 <- kl_V2723 `pseq` numberP kl_V2723 + !kl_if_3 <- case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_4 <- kl_V2723 `pseq` stringP kl_V2723 + 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" + _ -> throwError "if: expected boolean" + 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" + _ -> throwError "if: expected boolean" + case kl_if_1 of + Atom (B (True)) -> do return (Atom (B False)) + Atom (B (False)) -> do do (do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_String) -> do kl_String `pseq` kl_shen_analyse_symbolP kl_String))) + !appl_6 <- kl_V2723 `pseq` str kl_V2723 + appl_6 `pseq` applyWrapper appl_5 [appl_6]) `catchError` (\(!kl_E) -> do return (Atom (B False))) + _ -> throwError "if: expected boolean" + +kl_shen_analyse_symbolP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_analyse_symbolP (!kl_V2725) = do let pat_cond_0 = do return (Atom (B False)) + pat_cond_1 = do !kl_if_2 <- kl_V2725 `pseq` kl_shen_PlusstringP kl_V2725 + case kl_if_2 of + Atom (B (True)) -> do !appl_3 <- kl_V2725 `pseq` pos kl_V2725 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_4 <- appl_3 `pseq` kl_shen_alphaP appl_3 + case kl_if_4 of + Atom (B (True)) -> do !appl_5 <- kl_V2725 `pseq` tlstr kl_V2725 + !kl_if_6 <- appl_5 `pseq` kl_shen_alphanumsP appl_5 + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_7 [ApplC (wrapNamed "shen.analyse-symbol?" kl_shen_analyse_symbolP)] + _ -> throwError "if: expected boolean" + in case kl_V2725 of + kl_V2725@(Atom (Str "")) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_alphaP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_alphaP (!kl_V2727) = do let !appl_0 = Atom Nil + !appl_1 <- appl_0 `pseq` klCons (Core.Types.Atom (Core.Types.Str ".")) appl_0 + !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.Str "'")) appl_1 + !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.Str "#")) appl_2 + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.Str "`")) appl_3 + !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.Str ";")) appl_4 + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.Str ":")) appl_5 + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.Str "}")) appl_6 + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.Str "{")) appl_7 + !appl_9 <- appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.Str "%")) appl_8 + !appl_10 <- appl_9 `pseq` klCons (Core.Types.Atom (Core.Types.Str "&")) appl_9 + !appl_11 <- appl_10 `pseq` klCons (Core.Types.Atom (Core.Types.Str "<")) appl_10 + !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.Str ">")) appl_11 + !appl_13 <- appl_12 `pseq` klCons (Core.Types.Atom (Core.Types.Str "~")) appl_12 + !appl_14 <- appl_13 `pseq` klCons (Core.Types.Atom (Core.Types.Str "@")) appl_13 + !appl_15 <- appl_14 `pseq` klCons (Core.Types.Atom (Core.Types.Str "!")) appl_14 + !appl_16 <- appl_15 `pseq` klCons (Core.Types.Atom (Core.Types.Str "$")) appl_15 + !appl_17 <- appl_16 `pseq` klCons (Core.Types.Atom (Core.Types.Str "?")) appl_16 + !appl_18 <- appl_17 `pseq` klCons (Core.Types.Atom (Core.Types.Str "_")) appl_17 + !appl_19 <- appl_18 `pseq` klCons (Core.Types.Atom (Core.Types.Str "-")) appl_18 + !appl_20 <- appl_19 `pseq` klCons (Core.Types.Atom (Core.Types.Str "+")) appl_19 + !appl_21 <- appl_20 `pseq` klCons (Core.Types.Atom (Core.Types.Str "/")) appl_20 + !appl_22 <- appl_21 `pseq` klCons (Core.Types.Atom (Core.Types.Str "*")) appl_21 + !appl_23 <- appl_22 `pseq` klCons (Core.Types.Atom (Core.Types.Str "=")) appl_22 + !appl_24 <- appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.Str "z")) appl_23 + !appl_25 <- appl_24 `pseq` klCons (Core.Types.Atom (Core.Types.Str "y")) appl_24 + !appl_26 <- appl_25 `pseq` klCons (Core.Types.Atom (Core.Types.Str "x")) appl_25 + !appl_27 <- appl_26 `pseq` klCons (Core.Types.Atom (Core.Types.Str "w")) appl_26 + !appl_28 <- appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.Str "v")) appl_27 + !appl_29 <- appl_28 `pseq` klCons (Core.Types.Atom (Core.Types.Str "u")) appl_28 + !appl_30 <- appl_29 `pseq` klCons (Core.Types.Atom (Core.Types.Str "t")) appl_29 + !appl_31 <- appl_30 `pseq` klCons (Core.Types.Atom (Core.Types.Str "s")) appl_30 + !appl_32 <- appl_31 `pseq` klCons (Core.Types.Atom (Core.Types.Str "r")) appl_31 + !appl_33 <- appl_32 `pseq` klCons (Core.Types.Atom (Core.Types.Str "q")) appl_32 + !appl_34 <- appl_33 `pseq` klCons (Core.Types.Atom (Core.Types.Str "p")) appl_33 + !appl_35 <- appl_34 `pseq` klCons (Core.Types.Atom (Core.Types.Str "o")) appl_34 + !appl_36 <- appl_35 `pseq` klCons (Core.Types.Atom (Core.Types.Str "n")) appl_35 + !appl_37 <- appl_36 `pseq` klCons (Core.Types.Atom (Core.Types.Str "m")) appl_36 + !appl_38 <- appl_37 `pseq` klCons (Core.Types.Atom (Core.Types.Str "l")) appl_37 + !appl_39 <- appl_38 `pseq` klCons (Core.Types.Atom (Core.Types.Str "k")) appl_38 + !appl_40 <- appl_39 `pseq` klCons (Core.Types.Atom (Core.Types.Str "j")) appl_39 + !appl_41 <- appl_40 `pseq` klCons (Core.Types.Atom (Core.Types.Str "i")) appl_40 + !appl_42 <- appl_41 `pseq` klCons (Core.Types.Atom (Core.Types.Str "h")) appl_41 + !appl_43 <- appl_42 `pseq` klCons (Core.Types.Atom (Core.Types.Str "g")) appl_42 + !appl_44 <- appl_43 `pseq` klCons (Core.Types.Atom (Core.Types.Str "f")) appl_43 + !appl_45 <- appl_44 `pseq` klCons (Core.Types.Atom (Core.Types.Str "e")) appl_44 + !appl_46 <- appl_45 `pseq` klCons (Core.Types.Atom (Core.Types.Str "d")) appl_45 + !appl_47 <- appl_46 `pseq` klCons (Core.Types.Atom (Core.Types.Str "c")) appl_46 + !appl_48 <- appl_47 `pseq` klCons (Core.Types.Atom (Core.Types.Str "b")) appl_47 + !appl_49 <- appl_48 `pseq` klCons (Core.Types.Atom (Core.Types.Str "a")) appl_48 + !appl_50 <- appl_49 `pseq` klCons (Core.Types.Atom (Core.Types.Str "Z")) appl_49 + !appl_51 <- appl_50 `pseq` klCons (Core.Types.Atom (Core.Types.Str "Y")) appl_50 + !appl_52 <- appl_51 `pseq` klCons (Core.Types.Atom (Core.Types.Str "X")) appl_51 + !appl_53 <- appl_52 `pseq` klCons (Core.Types.Atom (Core.Types.Str "W")) appl_52 + !appl_54 <- appl_53 `pseq` klCons (Core.Types.Atom (Core.Types.Str "V")) appl_53 + !appl_55 <- appl_54 `pseq` klCons (Core.Types.Atom (Core.Types.Str "U")) appl_54 + !appl_56 <- appl_55 `pseq` klCons (Core.Types.Atom (Core.Types.Str "T")) appl_55 + !appl_57 <- appl_56 `pseq` klCons (Core.Types.Atom (Core.Types.Str "S")) appl_56 + !appl_58 <- appl_57 `pseq` klCons (Core.Types.Atom (Core.Types.Str "R")) appl_57 + !appl_59 <- appl_58 `pseq` klCons (Core.Types.Atom (Core.Types.Str "Q")) appl_58 + !appl_60 <- appl_59 `pseq` klCons (Core.Types.Atom (Core.Types.Str "P")) appl_59 + !appl_61 <- appl_60 `pseq` klCons (Core.Types.Atom (Core.Types.Str "O")) appl_60 + !appl_62 <- appl_61 `pseq` klCons (Core.Types.Atom (Core.Types.Str "N")) appl_61 + !appl_63 <- appl_62 `pseq` klCons (Core.Types.Atom (Core.Types.Str "M")) appl_62 + !appl_64 <- appl_63 `pseq` klCons (Core.Types.Atom (Core.Types.Str "L")) appl_63 + !appl_65 <- appl_64 `pseq` klCons (Core.Types.Atom (Core.Types.Str "K")) appl_64 + !appl_66 <- appl_65 `pseq` klCons (Core.Types.Atom (Core.Types.Str "J")) appl_65 + !appl_67 <- appl_66 `pseq` klCons (Core.Types.Atom (Core.Types.Str "I")) appl_66 + !appl_68 <- appl_67 `pseq` klCons (Core.Types.Atom (Core.Types.Str "H")) appl_67 + !appl_69 <- appl_68 `pseq` klCons (Core.Types.Atom (Core.Types.Str "G")) appl_68 + !appl_70 <- appl_69 `pseq` klCons (Core.Types.Atom (Core.Types.Str "F")) appl_69 + !appl_71 <- appl_70 `pseq` klCons (Core.Types.Atom (Core.Types.Str "E")) appl_70 + !appl_72 <- appl_71 `pseq` klCons (Core.Types.Atom (Core.Types.Str "D")) appl_71 + !appl_73 <- appl_72 `pseq` klCons (Core.Types.Atom (Core.Types.Str "C")) appl_72 + !appl_74 <- appl_73 `pseq` klCons (Core.Types.Atom (Core.Types.Str "B")) appl_73 + !appl_75 <- appl_74 `pseq` klCons (Core.Types.Atom (Core.Types.Str "A")) appl_74 + kl_V2727 `pseq` (appl_75 `pseq` kl_elementP kl_V2727 appl_75) + +kl_shen_alphanumsP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_alphanumsP (!kl_V2729) = do let pat_cond_0 = do return (Atom (B True)) + pat_cond_1 = do !kl_if_2 <- kl_V2729 `pseq` kl_shen_PlusstringP kl_V2729 + case kl_if_2 of + Atom (B (True)) -> do !appl_3 <- kl_V2729 `pseq` pos kl_V2729 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_4 <- appl_3 `pseq` kl_shen_alphanumP appl_3 + case kl_if_4 of + Atom (B (True)) -> do !appl_5 <- kl_V2729 `pseq` tlstr kl_V2729 + !kl_if_6 <- appl_5 `pseq` kl_shen_alphanumsP appl_5 + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_7 [ApplC (wrapNamed "shen.alphanums?" kl_shen_alphanumsP)] + _ -> throwError "if: expected boolean" + in case kl_V2729 of + kl_V2729@(Atom (Str "")) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_alphanumP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_alphanumP (!kl_V2731) = do !kl_if_0 <- kl_V2731 `pseq` kl_shen_alphaP kl_V2731 + case kl_if_0 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_1 <- kl_V2731 `pseq` kl_shen_digitP kl_V2731 + case kl_if_1 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_digitP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_digitP (!kl_V2733) = do let !appl_0 = Atom Nil + !appl_1 <- appl_0 `pseq` klCons (Core.Types.Atom (Core.Types.Str "0")) appl_0 + !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.Str "9")) appl_1 + !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.Str "8")) appl_2 + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.Str "7")) appl_3 + !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.Str "6")) appl_4 + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.Str "5")) appl_5 + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.Str "4")) appl_6 + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.Str "3")) appl_7 + !appl_9 <- appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.Str "2")) appl_8 + !appl_10 <- appl_9 `pseq` klCons (Core.Types.Atom (Core.Types.Str "1")) appl_9 + kl_V2733 `pseq` (appl_10 `pseq` kl_elementP kl_V2733 appl_10) + +kl_variableP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_variableP (!kl_V2735) = do !kl_if_0 <- kl_V2735 `pseq` kl_booleanP kl_V2735 + !kl_if_1 <- case kl_if_0 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_2 <- kl_V2735 `pseq` numberP kl_V2735 + !kl_if_3 <- case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do !kl_if_4 <- kl_V2735 `pseq` stringP kl_V2735 + 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" + _ -> throwError "if: expected boolean" + 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" + _ -> throwError "if: expected boolean" + case kl_if_1 of + Atom (B (True)) -> do return (Atom (B False)) + Atom (B (False)) -> do do (do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_String) -> do kl_String `pseq` kl_shen_analyse_variableP kl_String))) + !appl_6 <- kl_V2735 `pseq` str kl_V2735 + appl_6 `pseq` applyWrapper appl_5 [appl_6]) `catchError` (\(!kl_E) -> do return (Atom (B False))) + _ -> throwError "if: expected boolean" + +kl_shen_analyse_variableP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_analyse_variableP (!kl_V2737) = do !kl_if_0 <- kl_V2737 `pseq` kl_shen_PlusstringP kl_V2737 + case kl_if_0 of + Atom (B (True)) -> do !appl_1 <- kl_V2737 `pseq` pos kl_V2737 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_2 <- appl_1 `pseq` kl_shen_uppercaseP appl_1 + case kl_if_2 of + Atom (B (True)) -> do !appl_3 <- kl_V2737 `pseq` tlstr kl_V2737 + !kl_if_4 <- appl_3 `pseq` kl_shen_alphanumsP appl_3 + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_5 [ApplC (wrapNamed "shen.analyse-variable?" kl_shen_analyse_variableP)] + _ -> throwError "if: expected boolean" + +kl_shen_uppercaseP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_uppercaseP (!kl_V2739) = do let !appl_0 = Atom Nil + !appl_1 <- appl_0 `pseq` klCons (Core.Types.Atom (Core.Types.Str "Z")) appl_0 + !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.Str "Y")) appl_1 + !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.Str "X")) appl_2 + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.Str "W")) appl_3 + !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.Str "V")) appl_4 + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.Str "U")) appl_5 + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.Str "T")) appl_6 + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.Str "S")) appl_7 + !appl_9 <- appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.Str "R")) appl_8 + !appl_10 <- appl_9 `pseq` klCons (Core.Types.Atom (Core.Types.Str "Q")) appl_9 + !appl_11 <- appl_10 `pseq` klCons (Core.Types.Atom (Core.Types.Str "P")) appl_10 + !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.Str "O")) appl_11 + !appl_13 <- appl_12 `pseq` klCons (Core.Types.Atom (Core.Types.Str "N")) appl_12 + !appl_14 <- appl_13 `pseq` klCons (Core.Types.Atom (Core.Types.Str "M")) appl_13 + !appl_15 <- appl_14 `pseq` klCons (Core.Types.Atom (Core.Types.Str "L")) appl_14 + !appl_16 <- appl_15 `pseq` klCons (Core.Types.Atom (Core.Types.Str "K")) appl_15 + !appl_17 <- appl_16 `pseq` klCons (Core.Types.Atom (Core.Types.Str "J")) appl_16 + !appl_18 <- appl_17 `pseq` klCons (Core.Types.Atom (Core.Types.Str "I")) appl_17 + !appl_19 <- appl_18 `pseq` klCons (Core.Types.Atom (Core.Types.Str "H")) appl_18 + !appl_20 <- appl_19 `pseq` klCons (Core.Types.Atom (Core.Types.Str "G")) appl_19 + !appl_21 <- appl_20 `pseq` klCons (Core.Types.Atom (Core.Types.Str "F")) appl_20 + !appl_22 <- appl_21 `pseq` klCons (Core.Types.Atom (Core.Types.Str "E")) appl_21 + !appl_23 <- appl_22 `pseq` klCons (Core.Types.Atom (Core.Types.Str "D")) appl_22 + !appl_24 <- appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.Str "C")) appl_23 + !appl_25 <- appl_24 `pseq` klCons (Core.Types.Atom (Core.Types.Str "B")) appl_24 + !appl_26 <- appl_25 `pseq` klCons (Core.Types.Atom (Core.Types.Str "A")) appl_25 + kl_V2739 `pseq` (appl_26 `pseq` kl_elementP kl_V2739 appl_26) + +kl_gensym :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_gensym (!kl_V2741) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*gensym*")) + !appl_1 <- appl_0 `pseq` add (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_0 + !appl_2 <- appl_1 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*gensym*")) appl_1 + kl_V2741 `pseq` (appl_2 `pseq` kl_concat kl_V2741 appl_2) + +kl_concat :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_concat (!kl_V2744) (!kl_V2745) = do !appl_0 <- kl_V2744 `pseq` str kl_V2744 + !appl_1 <- kl_V2745 `pseq` str kl_V2745 + !appl_2 <- appl_0 `pseq` (appl_1 `pseq` cn appl_0 appl_1) + appl_2 `pseq` intern appl_2 + +kl_Atp :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_Atp (!kl_V2748) (!kl_V2749) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Vector) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Tag) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Fst) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Snd) -> do return kl_Vector))) + !appl_4 <- kl_Vector `pseq` (kl_V2749 `pseq` addressTo kl_Vector (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) kl_V2749) + appl_4 `pseq` applyWrapper appl_3 [appl_4]))) + !appl_5 <- kl_Vector `pseq` (kl_V2748 `pseq` addressTo kl_Vector (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) kl_V2748) + appl_5 `pseq` applyWrapper appl_2 [appl_5]))) + !appl_6 <- kl_Vector `pseq` addressTo kl_Vector (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) (Core.Types.Atom (Core.Types.UnboundSym "shen.tuple")) + appl_6 `pseq` applyWrapper appl_1 [appl_6]))) + !appl_7 <- absvector (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) + appl_7 `pseq` applyWrapper appl_0 [appl_7] + +kl_fst :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_fst (!kl_V2751) = do kl_V2751 `pseq` addressFrom kl_V2751 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + +kl_snd :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_snd (!kl_V2753) = do kl_V2753 `pseq` addressFrom kl_V2753 (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) + +kl_tupleP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_tupleP (!kl_V2755) = do !kl_if_0 <- kl_V2755 `pseq` absvectorP kl_V2755 + case kl_if_0 of + Atom (B (True)) -> do let !appl_1 = ApplC (PL "thunk" (do return (Core.Types.Atom (Core.Types.UnboundSym "shen.not-tuple")))) + !appl_2 <- kl_V2755 `pseq` (appl_1 `pseq` kl_LB_addressDivor kl_V2755 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_1) + !kl_if_3 <- appl_2 `pseq` eq (Core.Types.Atom (Core.Types.UnboundSym "shen.tuple")) appl_2 + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + +kl_append :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_append (!kl_V2758) (!kl_V2759) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2758 `pseq` eq appl_0 kl_V2758) + case kl_if_1 of + Atom (B (True)) -> do return kl_V2759 + Atom (B (False)) -> do let pat_cond_2 kl_V2758 kl_V2758h kl_V2758t = do !appl_3 <- kl_V2758t `pseq` (kl_V2759 `pseq` kl_append kl_V2758t kl_V2759) + kl_V2758h `pseq` (appl_3 `pseq` klCons kl_V2758h appl_3) + pat_cond_4 = do do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_5 [ApplC (wrapNamed "append" kl_append)] + in case kl_V2758 of + !(kl_V2758@(Cons (!kl_V2758h) + (!kl_V2758t))) -> pat_cond_2 kl_V2758 kl_V2758h kl_V2758t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_Atv :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_Atv (!kl_V2762) (!kl_V2763) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Limit) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_NewVector) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_XPlusNewVector) -> do let pat_cond_3 = do return kl_XPlusNewVector + pat_cond_4 = do do kl_V2763 `pseq` (kl_Limit `pseq` (kl_XPlusNewVector `pseq` kl_shen_Atv_help kl_V2763 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) kl_Limit kl_XPlusNewVector)) + in case kl_Limit of + kl_Limit@(Atom (N (KI 0))) -> pat_cond_3 + _ -> pat_cond_4))) + !appl_5 <- kl_NewVector `pseq` (kl_V2762 `pseq` kl_vector_RB kl_NewVector (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) kl_V2762) + appl_5 `pseq` applyWrapper appl_2 [appl_5]))) + !appl_6 <- kl_Limit `pseq` add kl_Limit (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_7 <- appl_6 `pseq` kl_vector appl_6 + appl_7 `pseq` applyWrapper appl_1 [appl_7]))) + !appl_8 <- kl_V2763 `pseq` kl_limit kl_V2763 + appl_8 `pseq` applyWrapper appl_0 [appl_8] + +kl_shen_Atv_help :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_Atv_help (!kl_V2769) (!kl_V2770) (!kl_V2771) (!kl_V2772) = do !kl_if_0 <- kl_V2771 `pseq` (kl_V2770 `pseq` eq kl_V2771 kl_V2770) + case kl_if_0 of + Atom (B (True)) -> do !appl_1 <- kl_V2771 `pseq` add kl_V2771 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + kl_V2769 `pseq` (kl_V2772 `pseq` (kl_V2771 `pseq` (appl_1 `pseq` kl_shen_copyfromvector kl_V2769 kl_V2772 kl_V2771 appl_1))) + Atom (B (False)) -> do do !appl_2 <- kl_V2770 `pseq` add kl_V2770 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_3 <- kl_V2770 `pseq` add kl_V2770 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_4 <- kl_V2769 `pseq` (kl_V2772 `pseq` (kl_V2770 `pseq` (appl_3 `pseq` kl_shen_copyfromvector kl_V2769 kl_V2772 kl_V2770 appl_3))) + kl_V2769 `pseq` (appl_2 `pseq` (kl_V2771 `pseq` (appl_4 `pseq` kl_shen_Atv_help kl_V2769 appl_2 kl_V2771 appl_4))) + _ -> throwError "if: expected boolean" + +kl_shen_copyfromvector :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_copyfromvector (!kl_V2777) (!kl_V2778) (!kl_V2779) (!kl_V2780) = do (do !appl_0 <- kl_V2777 `pseq` (kl_V2779 `pseq` kl_LB_vector kl_V2777 kl_V2779) + kl_V2778 `pseq` (kl_V2780 `pseq` (appl_0 `pseq` kl_vector_RB kl_V2778 kl_V2780 appl_0))) `catchError` (\(!kl_E) -> do return kl_V2778) + +kl_hdv :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_hdv (!kl_V2782) = do let !appl_0 = ApplC (PL "thunk" (do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_2 <- kl_V2782 `pseq` applyWrapper aw_1 [kl_V2782, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.s")] + !appl_3 <- appl_2 `pseq` cn (Core.Types.Atom (Core.Types.Str "hdv needs a non-empty vector as an argument; not ")) appl_2 + appl_3 `pseq` simpleError appl_3)) + kl_V2782 `pseq` (appl_0 `pseq` kl_LB_vectorDivor kl_V2782 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_0) + +kl_tlv :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_tlv (!kl_V2784) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Limit) -> do let pat_cond_1 = do simpleError (Core.Types.Atom (Core.Types.Str "cannot take the tail of the empty vector\n")) + pat_cond_2 = do do let pat_cond_3 = do kl_vector (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + pat_cond_4 = do do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_NewVector) -> do !appl_6 <- kl_Limit `pseq` Primitives.subtract kl_Limit (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_7 <- appl_6 `pseq` kl_vector appl_6 + kl_V2784 `pseq` (kl_Limit `pseq` (appl_7 `pseq` kl_shen_tlv_help kl_V2784 (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) kl_Limit appl_7))))) + !appl_8 <- kl_Limit `pseq` Primitives.subtract kl_Limit (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_9 <- appl_8 `pseq` kl_vector appl_8 + appl_9 `pseq` applyWrapper appl_5 [appl_9] + in case kl_Limit of + kl_Limit@(Atom (N (KI 1))) -> pat_cond_3 + _ -> pat_cond_4 + in case kl_Limit of + kl_Limit@(Atom (N (KI 0))) -> pat_cond_1 + _ -> pat_cond_2))) + !appl_10 <- kl_V2784 `pseq` kl_limit kl_V2784 + appl_10 `pseq` applyWrapper appl_0 [appl_10] + +kl_shen_tlv_help :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_tlv_help (!kl_V2790) (!kl_V2791) (!kl_V2792) (!kl_V2793) = do !kl_if_0 <- kl_V2792 `pseq` (kl_V2791 `pseq` eq kl_V2792 kl_V2791) + case kl_if_0 of + Atom (B (True)) -> do !appl_1 <- kl_V2792 `pseq` Primitives.subtract kl_V2792 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + kl_V2790 `pseq` (kl_V2793 `pseq` (kl_V2792 `pseq` (appl_1 `pseq` kl_shen_copyfromvector kl_V2790 kl_V2793 kl_V2792 appl_1))) + Atom (B (False)) -> do do !appl_2 <- kl_V2791 `pseq` add kl_V2791 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_3 <- kl_V2791 `pseq` Primitives.subtract kl_V2791 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_4 <- kl_V2790 `pseq` (kl_V2793 `pseq` (kl_V2791 `pseq` (appl_3 `pseq` kl_shen_copyfromvector kl_V2790 kl_V2793 kl_V2791 appl_3))) + kl_V2790 `pseq` (appl_2 `pseq` (kl_V2792 `pseq` (appl_4 `pseq` kl_shen_tlv_help kl_V2790 appl_2 kl_V2792 appl_4))) + _ -> throwError "if: expected boolean" + +kl_assoc :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_assoc (!kl_V2805) (!kl_V2806) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2806 `pseq` eq appl_0 kl_V2806) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let pat_cond_2 kl_V2806 kl_V2806h kl_V2806hh kl_V2806ht kl_V2806t = do return kl_V2806h + pat_cond_3 kl_V2806 kl_V2806h kl_V2806t = do kl_V2805 `pseq` (kl_V2806t `pseq` kl_assoc kl_V2805 kl_V2806t) + pat_cond_4 = do do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_5 [ApplC (wrapNamed "assoc" kl_assoc)] + in case kl_V2806 of + !(kl_V2806@(Cons (!(kl_V2806h@(Cons (!kl_V2806hh) + (!kl_V2806ht)))) + (!kl_V2806t))) | eqCore kl_V2806hh kl_V2805 -> pat_cond_2 kl_V2806 kl_V2806h kl_V2806hh kl_V2806ht kl_V2806t + !(kl_V2806@(Cons (!kl_V2806h) + (!kl_V2806t))) -> pat_cond_3 kl_V2806 kl_V2806h kl_V2806t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_booleanP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_booleanP (!kl_V2812) = do let pat_cond_0 = do return (Atom (B True)) + pat_cond_1 = do return (Atom (B True)) + pat_cond_2 = do do return (Atom (B False)) + in case kl_V2812 of + kl_V2812@(Atom (UnboundSym "true")) -> pat_cond_0 + kl_V2812@(Atom (B (True))) -> pat_cond_0 + kl_V2812@(Atom (UnboundSym "false")) -> pat_cond_1 + kl_V2812@(Atom (B (False))) -> pat_cond_1 + _ -> pat_cond_2 + +kl_nl :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_nl (!kl_V2814) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + pat_cond_1 = do do !appl_2 <- kl_stoutput + let !aw_3 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_4 <- appl_2 `pseq` applyWrapper aw_3 [Core.Types.Atom (Core.Types.Str "\n"), + appl_2] + !appl_5 <- kl_V2814 `pseq` Primitives.subtract kl_V2814 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_6 <- appl_5 `pseq` kl_nl appl_5 + appl_4 `pseq` (appl_6 `pseq` kl_do appl_4 appl_6) + in case kl_V2814 of + kl_V2814@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_difference :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_difference (!kl_V2819) (!kl_V2820) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2819 `pseq` eq appl_0 kl_V2819) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let pat_cond_2 kl_V2819 kl_V2819h kl_V2819t = do !kl_if_3 <- kl_V2819h `pseq` (kl_V2820 `pseq` kl_elementP kl_V2819h kl_V2820) + case kl_if_3 of + Atom (B (True)) -> do kl_V2819t `pseq` (kl_V2820 `pseq` kl_difference kl_V2819t kl_V2820) + Atom (B (False)) -> do do !appl_4 <- kl_V2819t `pseq` (kl_V2820 `pseq` kl_difference kl_V2819t kl_V2820) + kl_V2819h `pseq` (appl_4 `pseq` klCons kl_V2819h appl_4) + _ -> throwError "if: expected boolean" + pat_cond_5 = do do let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_6 [ApplC (wrapNamed "difference" kl_difference)] + in case kl_V2819 of + !(kl_V2819@(Cons (!kl_V2819h) + (!kl_V2819t))) -> pat_cond_2 kl_V2819 kl_V2819h kl_V2819t + _ -> pat_cond_5 + _ -> throwError "if: expected boolean" + +kl_do :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_do (!kl_V2823) (!kl_V2824) = do return kl_V2824 + +kl_elementP :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_elementP (!kl_V2836) (!kl_V2837) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2837 `pseq` eq appl_0 kl_V2837) + case kl_if_1 of + Atom (B (True)) -> do return (Atom (B False)) + Atom (B (False)) -> do let pat_cond_2 kl_V2837 kl_V2837h kl_V2837t = do return (Atom (B True)) + pat_cond_3 kl_V2837 kl_V2837h kl_V2837t = do kl_V2836 `pseq` (kl_V2837t `pseq` kl_elementP kl_V2836 kl_V2837t) + pat_cond_4 = do do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_5 [ApplC (wrapNamed "element?" kl_elementP)] + in case kl_V2837 of + !(kl_V2837@(Cons (!kl_V2837h) + (!kl_V2837t))) | eqCore kl_V2837h kl_V2836 -> pat_cond_2 kl_V2837 kl_V2837h kl_V2837t + !(kl_V2837@(Cons (!kl_V2837h) + (!kl_V2837t))) -> pat_cond_3 kl_V2837 kl_V2837h kl_V2837t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_emptyP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_emptyP (!kl_V2843) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2843 `pseq` eq appl_0 kl_V2843) + case kl_if_1 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + +kl_fix :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_fix (!kl_V2846) (!kl_V2847) = do !appl_0 <- kl_V2847 `pseq` applyWrapper kl_V2846 [kl_V2847] + kl_V2846 `pseq` (kl_V2847 `pseq` (appl_0 `pseq` kl_shen_fix_help kl_V2846 kl_V2847 appl_0)) + +kl_shen_fix_help :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_fix_help (!kl_V2858) (!kl_V2859) (!kl_V2860) = do !kl_if_0 <- kl_V2860 `pseq` (kl_V2859 `pseq` eq kl_V2860 kl_V2859) + case kl_if_0 of + Atom (B (True)) -> do return kl_V2860 + Atom (B (False)) -> do do !appl_1 <- kl_V2860 `pseq` applyWrapper kl_V2858 [kl_V2860] + kl_V2858 `pseq` (kl_V2860 `pseq` (appl_1 `pseq` kl_shen_fix_help kl_V2858 kl_V2860 appl_1)) + _ -> throwError "if: expected boolean" + +kl_dict :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_dict (!kl_V2862) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_D) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Tag) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Capacity) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Count) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Fill) -> do return kl_D))) + !appl_5 <- kl_V2862 `pseq` add (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) kl_V2862 + let !appl_6 = Atom Nil + !appl_7 <- kl_D `pseq` (appl_5 `pseq` (appl_6 `pseq` kl_shen_fillvector kl_D (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) appl_5 appl_6)) + appl_7 `pseq` applyWrapper appl_4 [appl_7]))) + !appl_8 <- kl_D `pseq` addressTo kl_D (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + appl_8 `pseq` applyWrapper appl_3 [appl_8]))) + !appl_9 <- kl_D `pseq` (kl_V2862 `pseq` addressTo kl_D (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) kl_V2862) + appl_9 `pseq` applyWrapper appl_2 [appl_9]))) + !appl_10 <- kl_D `pseq` addressTo kl_D (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) (Core.Types.Atom (Core.Types.UnboundSym "shen.dictionary")) + appl_10 `pseq` applyWrapper appl_1 [appl_10]))) + !appl_11 <- kl_V2862 `pseq` add (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) kl_V2862 + !appl_12 <- appl_11 `pseq` absvector appl_11 + appl_12 `pseq` applyWrapper appl_0 [appl_12] + +kl_dictP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_dictP (!kl_V2864) = do !kl_if_0 <- kl_V2864 `pseq` absvectorP kl_V2864 + case kl_if_0 of + Atom (B (True)) -> do let !appl_1 = ApplC (PL "thunk" (do return (Core.Types.Atom (Core.Types.UnboundSym "shen.not-dictionary")))) + !appl_2 <- kl_V2864 `pseq` (appl_1 `pseq` kl_LB_addressDivor kl_V2864 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_1) + !kl_if_3 <- appl_2 `pseq` eq appl_2 (Core.Types.Atom (Core.Types.UnboundSym "shen.dictionary")) + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + +kl_shen_dict_capacity :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_dict_capacity (!kl_V2866) = do kl_V2866 `pseq` addressFrom kl_V2866 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + +kl_dict_count :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_dict_count (!kl_V2868) = do kl_V2868 `pseq` addressFrom kl_V2868 (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) + +kl_shen_dict_count_RB :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_dict_count_RB (!kl_V2871) (!kl_V2872) = do kl_V2871 `pseq` (kl_V2872 `pseq` addressTo kl_V2871 (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) kl_V2872) + +kl_shen_LB_dict_bucket :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_LB_dict_bucket (!kl_V2875) (!kl_V2876) = do !appl_0 <- kl_V2876 `pseq` add (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) kl_V2876 + kl_V2875 `pseq` (appl_0 `pseq` addressFrom kl_V2875 appl_0) + +kl_shen_dict_bucket_RB :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_dict_bucket_RB (!kl_V2880) (!kl_V2881) (!kl_V2882) = do !appl_0 <- kl_V2881 `pseq` add (Core.Types.Atom (Core.Types.N (Core.Types.KI 3))) kl_V2881 + kl_V2880 `pseq` (appl_0 `pseq` (kl_V2882 `pseq` addressTo kl_V2880 appl_0 kl_V2882)) + +kl_shen_set_key_entry_value :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_set_key_entry_value (!kl_V2889) (!kl_V2890) (!kl_V2891) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2891 `pseq` eq appl_0 kl_V2891) + case kl_if_1 of + Atom (B (True)) -> do !appl_2 <- kl_V2889 `pseq` (kl_V2890 `pseq` klCons kl_V2889 kl_V2890) + let !appl_3 = Atom Nil + appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) + Atom (B (False)) -> do let pat_cond_4 kl_V2891 kl_V2891h kl_V2891hh kl_V2891ht kl_V2891t = do !appl_5 <- kl_V2891hh `pseq` (kl_V2890 `pseq` klCons kl_V2891hh kl_V2890) + appl_5 `pseq` (kl_V2891t `pseq` klCons appl_5 kl_V2891t) + pat_cond_6 kl_V2891 kl_V2891h kl_V2891t = do !appl_7 <- kl_V2889 `pseq` (kl_V2890 `pseq` (kl_V2891t `pseq` kl_shen_set_key_entry_value kl_V2889 kl_V2890 kl_V2891t)) + kl_V2891h `pseq` (appl_7 `pseq` klCons kl_V2891h appl_7) + pat_cond_8 = do do let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_9 [ApplC (wrapNamed "shen.set-key-entry-value" kl_shen_set_key_entry_value)] + in case kl_V2891 of + !(kl_V2891@(Cons (!(kl_V2891h@(Cons (!kl_V2891hh) + (!kl_V2891ht)))) + (!kl_V2891t))) | eqCore kl_V2891hh kl_V2889 -> pat_cond_4 kl_V2891 kl_V2891h kl_V2891hh kl_V2891ht kl_V2891t + !(kl_V2891@(Cons (!kl_V2891h) + (!kl_V2891t))) -> pat_cond_6 kl_V2891 kl_V2891h kl_V2891t + _ -> pat_cond_8 + _ -> throwError "if: expected boolean" + +kl_shen_remove_key_entry_value :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_remove_key_entry_value (!kl_V2897) (!kl_V2898) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2898 `pseq` eq appl_0 kl_V2898) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let pat_cond_2 kl_V2898 kl_V2898h kl_V2898hh kl_V2898ht kl_V2898t = do return kl_V2898t + pat_cond_3 kl_V2898 kl_V2898h kl_V2898t = do !appl_4 <- kl_V2897 `pseq` (kl_V2898t `pseq` kl_shen_remove_key_entry_value kl_V2897 kl_V2898t) + kl_V2898h `pseq` (appl_4 `pseq` klCons kl_V2898h appl_4) + pat_cond_5 = do do let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_6 [ApplC (wrapNamed "shen.remove-key-entry-value" kl_shen_remove_key_entry_value)] + in case kl_V2898 of + !(kl_V2898@(Cons (!(kl_V2898h@(Cons (!kl_V2898hh) + (!kl_V2898ht)))) + (!kl_V2898t))) | eqCore kl_V2898hh kl_V2897 -> pat_cond_2 kl_V2898 kl_V2898h kl_V2898hh kl_V2898ht kl_V2898t + !(kl_V2898@(Cons (!kl_V2898h) + (!kl_V2898t))) -> pat_cond_3 kl_V2898 kl_V2898h kl_V2898t + _ -> pat_cond_5 + _ -> throwError "if: expected boolean" + +kl_shen_dict_update_count :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_dict_update_count (!kl_V2902) (!kl_V2903) (!kl_V2904) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Diff) -> do !appl_1 <- kl_V2902 `pseq` kl_dict_count kl_V2902 + !appl_2 <- kl_Diff `pseq` (appl_1 `pseq` add kl_Diff appl_1) + kl_V2902 `pseq` (appl_2 `pseq` kl_shen_dict_count_RB kl_V2902 appl_2)))) + !appl_3 <- kl_V2904 `pseq` kl_length kl_V2904 + !appl_4 <- kl_V2903 `pseq` kl_length kl_V2903 + !appl_5 <- appl_3 `pseq` (appl_4 `pseq` Primitives.subtract appl_3 appl_4) + appl_5 `pseq` applyWrapper appl_0 [appl_5] + +kl_dict_RB :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_dict_RB (!kl_V2908) (!kl_V2909) (!kl_V2910) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_N) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Bucket) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_NewBucket) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Change) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Count) -> do return kl_V2910))) + !appl_5 <- kl_V2908 `pseq` (kl_Bucket `pseq` (kl_NewBucket `pseq` kl_shen_dict_update_count kl_V2908 kl_Bucket kl_NewBucket)) + appl_5 `pseq` applyWrapper appl_4 [appl_5]))) + !appl_6 <- kl_V2908 `pseq` (kl_N `pseq` (kl_NewBucket `pseq` kl_shen_dict_bucket_RB kl_V2908 kl_N kl_NewBucket)) + appl_6 `pseq` applyWrapper appl_3 [appl_6]))) + !appl_7 <- kl_V2909 `pseq` (kl_V2910 `pseq` (kl_Bucket `pseq` kl_shen_set_key_entry_value kl_V2909 kl_V2910 kl_Bucket)) + appl_7 `pseq` applyWrapper appl_2 [appl_7]))) + !appl_8 <- kl_V2908 `pseq` (kl_N `pseq` kl_shen_LB_dict_bucket kl_V2908 kl_N) + appl_8 `pseq` applyWrapper appl_1 [appl_8]))) + !appl_9 <- kl_V2908 `pseq` kl_shen_dict_capacity kl_V2908 + !appl_10 <- kl_V2909 `pseq` (appl_9 `pseq` kl_hash kl_V2909 appl_9) + appl_10 `pseq` applyWrapper appl_0 [appl_10] + +kl_LB_dictDivor :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_LB_dictDivor (!kl_V2914) (!kl_V2915) (!kl_V2916) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_N) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Bucket) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Result) -> do !kl_if_3 <- kl_Result `pseq` kl_emptyP kl_Result + case kl_if_3 of + Atom (B (True)) -> do kl_V2916 `pseq` kl_thaw kl_V2916 + Atom (B (False)) -> do do kl_Result `pseq` tl kl_Result + _ -> throwError "if: expected boolean"))) + !appl_4 <- kl_V2915 `pseq` (kl_Bucket `pseq` kl_assoc kl_V2915 kl_Bucket) + appl_4 `pseq` applyWrapper appl_2 [appl_4]))) + !appl_5 <- kl_V2914 `pseq` (kl_N `pseq` kl_shen_LB_dict_bucket kl_V2914 kl_N) + appl_5 `pseq` applyWrapper appl_1 [appl_5]))) + !appl_6 <- kl_V2914 `pseq` kl_shen_dict_capacity kl_V2914 + !appl_7 <- kl_V2915 `pseq` (appl_6 `pseq` kl_hash kl_V2915 appl_6) + appl_7 `pseq` applyWrapper appl_0 [appl_7] + +kl_LB_dict :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_LB_dict (!kl_V2919) (!kl_V2920) = do let !appl_0 = ApplC (PL "thunk" (do simpleError (Core.Types.Atom (Core.Types.Str "value not found\n")))) + kl_V2919 `pseq` (kl_V2920 `pseq` (appl_0 `pseq` kl_LB_dictDivor kl_V2919 kl_V2920 appl_0)) + +kl_dict_rm :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_dict_rm (!kl_V2923) (!kl_V2924) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_N) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Bucket) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_NewBucket) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Change) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Count) -> do return kl_V2924))) + !appl_5 <- kl_V2923 `pseq` (kl_Bucket `pseq` (kl_NewBucket `pseq` kl_shen_dict_update_count kl_V2923 kl_Bucket kl_NewBucket)) + appl_5 `pseq` applyWrapper appl_4 [appl_5]))) + !appl_6 <- kl_V2923 `pseq` (kl_N `pseq` (kl_NewBucket `pseq` kl_shen_dict_bucket_RB kl_V2923 kl_N kl_NewBucket)) + appl_6 `pseq` applyWrapper appl_3 [appl_6]))) + !appl_7 <- kl_V2924 `pseq` (kl_Bucket `pseq` kl_shen_remove_key_entry_value kl_V2924 kl_Bucket) + appl_7 `pseq` applyWrapper appl_2 [appl_7]))) + !appl_8 <- kl_V2923 `pseq` (kl_N `pseq` kl_shen_LB_dict_bucket kl_V2923 kl_N) + appl_8 `pseq` applyWrapper appl_1 [appl_8]))) + !appl_9 <- kl_V2923 `pseq` kl_shen_dict_capacity kl_V2923 + !appl_10 <- kl_V2924 `pseq` (appl_9 `pseq` kl_hash kl_V2924 appl_9) + appl_10 `pseq` applyWrapper appl_0 [appl_10] + +kl_dict_fold :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_dict_fold (!kl_V2928) (!kl_V2929) (!kl_V2930) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Limit) -> do kl_V2928 `pseq` (kl_V2929 `pseq` (kl_V2930 `pseq` (kl_Limit `pseq` kl_shen_dict_fold_h kl_V2928 kl_V2929 kl_V2930 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) kl_Limit)))))) + !appl_1 <- kl_V2929 `pseq` kl_shen_dict_capacity kl_V2929 + appl_1 `pseq` applyWrapper appl_0 [appl_1] + +kl_shen_dict_fold_h :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_dict_fold_h (!kl_V2937) (!kl_V2938) (!kl_V2939) (!kl_V2940) (!kl_V2941) = do !kl_if_0 <- kl_V2941 `pseq` (kl_V2940 `pseq` eq kl_V2941 kl_V2940) + case kl_if_0 of + Atom (B (True)) -> do return kl_V2939 + Atom (B (False)) -> do do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_B) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Acc) -> do !appl_3 <- kl_V2940 `pseq` add (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) kl_V2940 + kl_V2937 `pseq` (kl_V2938 `pseq` (kl_Acc `pseq` (appl_3 `pseq` (kl_V2941 `pseq` kl_shen_dict_fold_h kl_V2937 kl_V2938 kl_Acc appl_3 kl_V2941))))))) + !appl_4 <- kl_V2937 `pseq` (kl_B `pseq` (kl_V2939 `pseq` kl_shen_bucket_fold kl_V2937 kl_B kl_V2939)) + appl_4 `pseq` applyWrapper appl_2 [appl_4]))) + !appl_5 <- kl_V2938 `pseq` (kl_V2940 `pseq` kl_shen_LB_dict_bucket kl_V2938 kl_V2940) + appl_5 `pseq` applyWrapper appl_1 [appl_5] + _ -> throwError "if: expected boolean" + +kl_shen_bucket_fold :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_bucket_fold (!kl_V2945) (!kl_V2946) (!kl_V2947) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2946 `pseq` eq appl_0 kl_V2946) + case kl_if_1 of + Atom (B (True)) -> do return kl_V2947 + Atom (B (False)) -> do let pat_cond_2 kl_V2946 kl_V2946h kl_V2946hh kl_V2946ht kl_V2946t = do !appl_3 <- kl_V2945 `pseq` (kl_V2946t `pseq` (kl_V2947 `pseq` kl_fold_right kl_V2945 kl_V2946t kl_V2947)) + kl_V2946hh `pseq` (kl_V2946ht `pseq` (appl_3 `pseq` applyWrapper kl_V2945 [kl_V2946hh, + kl_V2946ht, + appl_3])) + pat_cond_4 = do do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_5 [ApplC (wrapNamed "shen.bucket-fold" kl_shen_bucket_fold)] + in case kl_V2946 of + !(kl_V2946@(Cons (!(kl_V2946h@(Cons (!kl_V2946hh) + (!kl_V2946ht)))) + (!kl_V2946t))) -> pat_cond_2 kl_V2946 kl_V2946h kl_V2946hh kl_V2946ht kl_V2946t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_dict_keys :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_dict_keys (!kl_V2949) = kl_dict_fold (ApplC (wrapNamed "lambda" (\k (_ :: Core.Types.KLValue) (acc :: Core.Types.KLValue) -> klCons k acc))) kl_V2949 (Atom Nil) + +kl_dict_values :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_dict_values (!kl_V2951) = kl_dict_fold (ApplC (wrapNamed "lambda" (\(_ :: Core.Types.KLValue) v (acc :: Core.Types.KLValue) -> klCons v acc))) kl_V2951 (Atom Nil) + +kl_put :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_put (!kl_V2956) (!kl_V2957) (!kl_V2958) (!kl_V2959) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Curr) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Added) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Update) -> do return kl_V2958))) + !appl_3 <- kl_V2959 `pseq` (kl_V2956 `pseq` (kl_Added `pseq` kl_dict_RB kl_V2959 kl_V2956 kl_Added)) + appl_3 `pseq` applyWrapper appl_2 [appl_3]))) + !appl_4 <- kl_V2957 `pseq` (kl_V2958 `pseq` (kl_Curr `pseq` kl_shen_set_key_entry_value kl_V2957 kl_V2958 kl_Curr)) + appl_4 `pseq` applyWrapper appl_1 [appl_4]))) + let !appl_5 = ApplC (PL "thunk" (do return (Atom Nil))) + !appl_6 <- kl_V2959 `pseq` (kl_V2956 `pseq` (appl_5 `pseq` kl_LB_dictDivor kl_V2959 kl_V2956 appl_5)) + appl_6 `pseq` applyWrapper appl_0 [appl_6] + +kl_unput :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_unput (!kl_V2963) (!kl_V2964) (!kl_V2965) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Curr) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Removed) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Update) -> do return kl_V2963))) + !appl_3 <- kl_V2965 `pseq` (kl_V2963 `pseq` (kl_Removed `pseq` kl_dict_RB kl_V2965 kl_V2963 kl_Removed)) + appl_3 `pseq` applyWrapper appl_2 [appl_3]))) + !appl_4 <- kl_V2964 `pseq` (kl_Curr `pseq` kl_shen_remove_key_entry_value kl_V2964 kl_Curr) + appl_4 `pseq` applyWrapper appl_1 [appl_4]))) + let !appl_5 = ApplC (PL "thunk" (do return (Atom Nil))) + !appl_6 <- kl_V2965 `pseq` (kl_V2963 `pseq` (appl_5 `pseq` kl_LB_dictDivor kl_V2965 kl_V2963 appl_5)) + appl_6 `pseq` applyWrapper appl_0 [appl_6] + +kl_getDivor :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_getDivor (!kl_V2970) (!kl_V2971) (!kl_V2972) (!kl_V2973) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Entry) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Result) -> do !kl_if_2 <- kl_Result `pseq` kl_emptyP kl_Result + case kl_if_2 of + Atom (B (True)) -> do kl_V2972 `pseq` kl_thaw kl_V2972 + Atom (B (False)) -> do do kl_Result `pseq` tl kl_Result + _ -> throwError "if: expected boolean"))) + !appl_3 <- kl_V2971 `pseq` (kl_Entry `pseq` kl_assoc kl_V2971 kl_Entry) + appl_3 `pseq` applyWrapper appl_1 [appl_3]))) + let !appl_4 = ApplC (PL "thunk" (do return (Atom Nil))) + !appl_5 <- kl_V2973 `pseq` (kl_V2970 `pseq` (appl_4 `pseq` kl_LB_dictDivor kl_V2973 kl_V2970 appl_4)) + appl_5 `pseq` applyWrapper appl_0 [appl_5] + +kl_get :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_get (!kl_V2977) (!kl_V2978) (!kl_V2979) = do let !appl_0 = ApplC (PL "thunk" (do simpleError (Core.Types.Atom (Core.Types.Str "value not found\n")))) + kl_V2977 `pseq` (kl_V2978 `pseq` (appl_0 `pseq` (kl_V2979 `pseq` kl_getDivor kl_V2977 kl_V2978 appl_0 kl_V2979))) + +kl_hash :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_hash (!kl_V2982) (!kl_V2983) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` stringToN kl_X))) + !appl_1 <- kl_V2982 `pseq` kl_explode kl_V2982 + !appl_2 <- appl_0 `pseq` (appl_1 `pseq` kl_map appl_0 appl_1) + !appl_3 <- appl_2 `pseq` kl_sum appl_2 + appl_3 `pseq` (kl_V2983 `pseq` kl_shen_mod appl_3 kl_V2983) + +kl_shen_mod :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_mod (!kl_V2986) (!kl_V2987) = do let !appl_0 = Atom Nil + !appl_1 <- kl_V2987 `pseq` (appl_0 `pseq` klCons kl_V2987 appl_0) + !appl_2 <- kl_V2986 `pseq` (appl_1 `pseq` kl_shen_multiples kl_V2986 appl_1) + kl_V2986 `pseq` (appl_2 `pseq` kl_shen_modh kl_V2986 appl_2) + +kl_shen_multiples :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_multiples (!kl_V2990) (!kl_V2991) = do !kl_if_0 <- let pat_cond_1 kl_V2991 kl_V2991h kl_V2991t = do !kl_if_2 <- kl_V2991h `pseq` (kl_V2990 `pseq` greaterThan kl_V2991h kl_V2990) + 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_3 = do do return (Atom (B False)) + in case kl_V2991 of + !(kl_V2991@(Cons (!kl_V2991h) + (!kl_V2991t))) -> pat_cond_1 kl_V2991 kl_V2991h kl_V2991t + _ -> pat_cond_3 + case kl_if_0 of + Atom (B (True)) -> do kl_V2991 `pseq` tl kl_V2991 + Atom (B (False)) -> do let pat_cond_4 kl_V2991 kl_V2991h kl_V2991t = do !appl_5 <- kl_V2991h `pseq` multiply (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) kl_V2991h + !appl_6 <- appl_5 `pseq` (kl_V2991 `pseq` klCons appl_5 kl_V2991) + kl_V2990 `pseq` (appl_6 `pseq` kl_shen_multiples kl_V2990 appl_6) + pat_cond_7 = do do let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_8 [ApplC (wrapNamed "shen.multiples" kl_shen_multiples)] + in case kl_V2991 of + !(kl_V2991@(Cons (!kl_V2991h) + (!kl_V2991t))) -> pat_cond_4 kl_V2991 kl_V2991h kl_V2991t + _ -> pat_cond_7 + _ -> throwError "if: expected boolean" + +kl_shen_modh :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_modh (!kl_V2996) (!kl_V2997) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + pat_cond_1 = do let !appl_2 = Atom Nil + !kl_if_3 <- appl_2 `pseq` (kl_V2997 `pseq` eq appl_2 kl_V2997) + case kl_if_3 of + Atom (B (True)) -> do return kl_V2996 + Atom (B (False)) -> do !kl_if_4 <- let pat_cond_5 kl_V2997 kl_V2997h kl_V2997t = do !kl_if_6 <- kl_V2997h `pseq` (kl_V2996 `pseq` greaterThan kl_V2997h kl_V2996) + 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_7 = do do return (Atom (B False)) + in case kl_V2997 of + !(kl_V2997@(Cons (!kl_V2997h) + (!kl_V2997t))) -> pat_cond_5 kl_V2997 kl_V2997h kl_V2997t + _ -> pat_cond_7 + case kl_if_4 of + Atom (B (True)) -> do !appl_8 <- kl_V2997 `pseq` tl kl_V2997 + !kl_if_9 <- appl_8 `pseq` kl_emptyP appl_8 + case kl_if_9 of + Atom (B (True)) -> do return kl_V2996 + Atom (B (False)) -> do do !appl_10 <- kl_V2997 `pseq` tl kl_V2997 + kl_V2996 `pseq` (appl_10 `pseq` kl_shen_modh kl_V2996 appl_10) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do let pat_cond_11 kl_V2997 kl_V2997h kl_V2997t = do !appl_12 <- kl_V2996 `pseq` (kl_V2997h `pseq` Primitives.subtract kl_V2996 kl_V2997h) + appl_12 `pseq` (kl_V2997 `pseq` kl_shen_modh appl_12 kl_V2997) + pat_cond_13 = do do let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_14 [ApplC (wrapNamed "shen.modh" kl_shen_modh)] + in case kl_V2997 of + !(kl_V2997@(Cons (!kl_V2997h) + (!kl_V2997t))) -> pat_cond_11 kl_V2997 kl_V2997h kl_V2997t + _ -> pat_cond_13 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + in case kl_V2996 of + kl_V2996@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_sum :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_sum (!kl_V2999) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V2999 `pseq` eq appl_0 kl_V2999) + case kl_if_1 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + Atom (B (False)) -> do let pat_cond_2 kl_V2999 kl_V2999h kl_V2999t = do !appl_3 <- kl_V2999t `pseq` kl_sum kl_V2999t + kl_V2999h `pseq` (appl_3 `pseq` add kl_V2999h appl_3) + pat_cond_4 = do do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_5 [ApplC (wrapNamed "sum" kl_sum)] + in case kl_V2999 of + !(kl_V2999@(Cons (!kl_V2999h) + (!kl_V2999t))) -> pat_cond_2 kl_V2999 kl_V2999h kl_V2999t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_head :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_head (!kl_V3007) = do let pat_cond_0 kl_V3007 kl_V3007h kl_V3007t = do return kl_V3007h + pat_cond_1 = do do simpleError (Core.Types.Atom (Core.Types.Str "head expects a non-empty list")) + in case kl_V3007 of + !(kl_V3007@(Cons (!kl_V3007h) + (!kl_V3007t))) -> pat_cond_0 kl_V3007 kl_V3007h kl_V3007t + _ -> pat_cond_1 + +kl_tail :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_tail (!kl_V3015) = do let pat_cond_0 kl_V3015 kl_V3015h kl_V3015t = do return kl_V3015t + pat_cond_1 = do do simpleError (Core.Types.Atom (Core.Types.Str "tail expects a non-empty list")) + in case kl_V3015 of + !(kl_V3015@(Cons (!kl_V3015h) + (!kl_V3015t))) -> pat_cond_0 kl_V3015 kl_V3015h kl_V3015t + _ -> pat_cond_1 + +kl_hdstr :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_hdstr (!kl_V3017) = do kl_V3017 `pseq` pos kl_V3017 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + +kl_intersection :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_intersection (!kl_V3022) (!kl_V3023) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3022 `pseq` eq appl_0 kl_V3022) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let pat_cond_2 kl_V3022 kl_V3022h kl_V3022t = do !kl_if_3 <- kl_V3022h `pseq` (kl_V3023 `pseq` kl_elementP kl_V3022h kl_V3023) + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_V3022t `pseq` (kl_V3023 `pseq` kl_intersection kl_V3022t kl_V3023) + kl_V3022h `pseq` (appl_4 `pseq` klCons kl_V3022h appl_4) + Atom (B (False)) -> do do kl_V3022t `pseq` (kl_V3023 `pseq` kl_intersection kl_V3022t kl_V3023) + _ -> throwError "if: expected boolean" + pat_cond_5 = do do let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_6 [ApplC (wrapNamed "intersection" kl_intersection)] + in case kl_V3022 of + !(kl_V3022@(Cons (!kl_V3022h) + (!kl_V3022t))) -> pat_cond_2 kl_V3022 kl_V3022h kl_V3022t + _ -> pat_cond_5 + _ -> throwError "if: expected boolean" + +kl_reverse :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_reverse (!kl_V3025) = do let !appl_0 = Atom Nil + kl_V3025 `pseq` (appl_0 `pseq` kl_shen_reverse_help kl_V3025 appl_0) + +kl_shen_reverse_help :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_reverse_help (!kl_V3028) (!kl_V3029) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3028 `pseq` eq appl_0 kl_V3028) + case kl_if_1 of + Atom (B (True)) -> do return kl_V3029 + Atom (B (False)) -> do let pat_cond_2 kl_V3028 kl_V3028h kl_V3028t = do !appl_3 <- kl_V3028h `pseq` (kl_V3029 `pseq` klCons kl_V3028h kl_V3029) + kl_V3028t `pseq` (appl_3 `pseq` kl_shen_reverse_help kl_V3028t appl_3) + pat_cond_4 = do do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_5 [ApplC (wrapNamed "shen.reverse_help" kl_shen_reverse_help)] + in case kl_V3028 of + !(kl_V3028@(Cons (!kl_V3028h) + (!kl_V3028t))) -> pat_cond_2 kl_V3028 kl_V3028h kl_V3028t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_union :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_union (!kl_V3032) (!kl_V3033) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3032 `pseq` eq appl_0 kl_V3032) + case kl_if_1 of + Atom (B (True)) -> do return kl_V3033 + Atom (B (False)) -> do let pat_cond_2 kl_V3032 kl_V3032h kl_V3032t = do !kl_if_3 <- kl_V3032h `pseq` (kl_V3033 `pseq` kl_elementP kl_V3032h kl_V3033) + case kl_if_3 of + Atom (B (True)) -> do kl_V3032t `pseq` (kl_V3033 `pseq` kl_union kl_V3032t kl_V3033) + Atom (B (False)) -> do do !appl_4 <- kl_V3032t `pseq` (kl_V3033 `pseq` kl_union kl_V3032t kl_V3033) + kl_V3032h `pseq` (appl_4 `pseq` klCons kl_V3032h appl_4) + _ -> throwError "if: expected boolean" + pat_cond_5 = do do let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_6 [ApplC (wrapNamed "union" kl_union)] + in case kl_V3032 of + !(kl_V3032@(Cons (!kl_V3032h) + (!kl_V3032t))) -> pat_cond_2 kl_V3032 kl_V3032h kl_V3032t + _ -> pat_cond_5 + _ -> throwError "if: expected boolean" + +kl_y_or_nP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_y_or_nP (!kl_V3035) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Message) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Y_or_N) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Input) -> do let pat_cond_3 = do return (Atom (B True)) + pat_cond_4 = do do let pat_cond_5 = do return (Atom (B False)) + pat_cond_6 = do do !appl_7 <- kl_stoutput + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_9 <- appl_7 `pseq` applyWrapper aw_8 [Core.Types.Atom (Core.Types.Str "please answer y or n\n"), + appl_7] + !appl_10 <- kl_V3035 `pseq` kl_y_or_nP kl_V3035 + appl_9 `pseq` (appl_10 `pseq` kl_do appl_9 appl_10) + in case kl_Input of + kl_Input@(Atom (Str "n")) -> pat_cond_5 + _ -> pat_cond_6 + in case kl_Input of + kl_Input@(Atom (Str "y")) -> pat_cond_3 + _ -> pat_cond_4))) + !appl_11 <- kl_stinput + let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "read") + !appl_13 <- appl_11 `pseq` applyWrapper aw_12 [appl_11] + let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_15 <- appl_13 `pseq` applyWrapper aw_14 [appl_13, + Core.Types.Atom (Core.Types.Str ""), + Core.Types.Atom (Core.Types.UnboundSym "shen.s")] + appl_15 `pseq` applyWrapper appl_2 [appl_15]))) + !appl_16 <- kl_stoutput + let !aw_17 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_18 <- appl_16 `pseq` applyWrapper aw_17 [Core.Types.Atom (Core.Types.Str " (y/n) "), + appl_16] + appl_18 `pseq` applyWrapper appl_1 [appl_18]))) + let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "shen.proc-nl") + !appl_20 <- kl_V3035 `pseq` applyWrapper aw_19 [kl_V3035] + !appl_21 <- kl_stoutput + let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_23 <- appl_20 `pseq` (appl_21 `pseq` applyWrapper aw_22 [appl_20, + appl_21]) + appl_23 `pseq` applyWrapper appl_0 [appl_23] + +kl_not :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_not (!kl_V3037) = do case kl_V3037 of + Atom (B (True)) -> do return (Atom (B False)) + Atom (B (False)) -> do do return (Atom (B True)) + _ -> throwError "if: expected boolean" + +kl_subst :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_subst (!kl_V3050) (!kl_V3051) (!kl_V3052) = do !kl_if_0 <- kl_V3052 `pseq` (kl_V3051 `pseq` eq kl_V3052 kl_V3051) + case kl_if_0 of + Atom (B (True)) -> do return kl_V3050 + Atom (B (False)) -> do let pat_cond_1 kl_V3052 kl_V3052h kl_V3052t = do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_W) -> do kl_V3050 `pseq` (kl_V3051 `pseq` (kl_W `pseq` kl_subst kl_V3050 kl_V3051 kl_W))))) + appl_2 `pseq` (kl_V3052 `pseq` kl_map appl_2 kl_V3052) + pat_cond_3 = do do return kl_V3052 + in case kl_V3052 of + !(kl_V3052@(Cons (!kl_V3052h) + (!kl_V3052t))) -> pat_cond_1 kl_V3052 kl_V3052h kl_V3052t + _ -> pat_cond_3 + _ -> throwError "if: expected boolean" + +kl_explode :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_explode (!kl_V3054) = do let !aw_0 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_1 <- kl_V3054 `pseq` applyWrapper aw_0 [kl_V3054, + Core.Types.Atom (Core.Types.Str ""), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + appl_1 `pseq` kl_shen_explode_h appl_1 + +kl_shen_explode_h :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_explode_h (!kl_V3056) = do let pat_cond_0 = do return (Atom Nil) + pat_cond_1 = do !kl_if_2 <- kl_V3056 `pseq` kl_shen_PlusstringP kl_V3056 + case kl_if_2 of + Atom (B (True)) -> do !appl_3 <- kl_V3056 `pseq` pos kl_V3056 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !appl_4 <- kl_V3056 `pseq` tlstr kl_V3056 + !appl_5 <- appl_4 `pseq` kl_shen_explode_h appl_4 + appl_3 `pseq` (appl_5 `pseq` klCons appl_3 appl_5) + Atom (B (False)) -> do do let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_6 [ApplC (wrapNamed "shen.explode-h" kl_shen_explode_h)] + _ -> throwError "if: expected boolean" + in case kl_V3056 of + kl_V3056@(Atom (Str "")) -> pat_cond_0 + _ -> pat_cond_1 + +kl_cd :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_cd (!kl_V3058) = do !appl_0 <- let pat_cond_1 = do return (Core.Types.Atom (Core.Types.Str "")) + pat_cond_2 = do do let !aw_3 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + kl_V3058 `pseq` applyWrapper aw_3 [kl_V3058, + Core.Types.Atom (Core.Types.Str "/"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + in case kl_V3058 of + kl_V3058@(Atom (Str "")) -> pat_cond_1 + _ -> pat_cond_2 + appl_0 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "*home-directory*")) appl_0 + +kl_for_each :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_for_each (!kl_V3061) (!kl_V3062) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3062 `pseq` eq appl_0 kl_V3062) + case kl_if_1 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do let pat_cond_2 kl_V3062 kl_V3062h kl_V3062t = do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl__) -> do kl_V3061 `pseq` (kl_V3062t `pseq` kl_for_each kl_V3061 kl_V3062t)))) + !appl_4 <- kl_V3062h `pseq` applyWrapper kl_V3061 [kl_V3062h] + appl_4 `pseq` applyWrapper appl_3 [appl_4] + pat_cond_5 = do do let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_6 [ApplC (wrapNamed "for-each" kl_for_each)] + in case kl_V3062 of + !(kl_V3062@(Cons (!kl_V3062h) + (!kl_V3062t))) -> pat_cond_2 kl_V3062 kl_V3062h kl_V3062t + _ -> pat_cond_5 + _ -> throwError "if: expected boolean" + +kl_fold_right :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_fold_right (!kl_V3066) (!kl_V3067) (!kl_V3068) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3067 `pseq` eq appl_0 kl_V3067) + case kl_if_1 of + Atom (B (True)) -> do return kl_V3068 + Atom (B (False)) -> do let pat_cond_2 kl_V3067 kl_V3067h kl_V3067t = do !appl_3 <- kl_V3066 `pseq` (kl_V3067t `pseq` (kl_V3068 `pseq` kl_fold_right kl_V3066 kl_V3067t kl_V3068)) + kl_V3067h `pseq` (appl_3 `pseq` applyWrapper kl_V3066 [kl_V3067h, + appl_3]) + pat_cond_4 = do do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_5 [ApplC (wrapNamed "fold-right" kl_fold_right)] + in case kl_V3067 of + !(kl_V3067@(Cons (!kl_V3067h) + (!kl_V3067t))) -> pat_cond_2 kl_V3067 kl_V3067h kl_V3067t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_fold_left :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_fold_left (!kl_V3072) (!kl_V3073) (!kl_V3074) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3074 `pseq` eq appl_0 kl_V3074) + case kl_if_1 of + Atom (B (True)) -> do return kl_V3073 + Atom (B (False)) -> do let pat_cond_2 kl_V3074 kl_V3074h kl_V3074t = do !appl_3 <- kl_V3073 `pseq` (kl_V3074h `pseq` applyWrapper kl_V3072 [kl_V3073, + kl_V3074h]) + kl_V3072 `pseq` (appl_3 `pseq` (kl_V3074t `pseq` kl_fold_left kl_V3072 appl_3 kl_V3074t)) + pat_cond_4 = do do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_5 [ApplC (wrapNamed "fold-left" kl_fold_left)] + in case kl_V3074 of + !(kl_V3074@(Cons (!kl_V3074h) + (!kl_V3074t))) -> pat_cond_2 kl_V3074 kl_V3074h kl_V3074t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_filter :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_filter (!kl_V3077) (!kl_V3078) = do let !appl_0 = Atom Nil + kl_V3077 `pseq` (appl_0 `pseq` (kl_V3078 `pseq` kl_shen_filter_h kl_V3077 appl_0 kl_V3078)) + +kl_shen_filter_h :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_filter_h (!kl_V3088) (!kl_V3089) (!kl_V3090) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3090 `pseq` eq appl_0 kl_V3090) + case kl_if_1 of + Atom (B (True)) -> do kl_V3089 `pseq` kl_reverse kl_V3089 + Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V3090 kl_V3090h kl_V3090t = do !kl_if_4 <- kl_V3090h `pseq` applyWrapper kl_V3088 [kl_V3090h] + 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_5 = do do return (Atom (B False)) + in case kl_V3090 of + !(kl_V3090@(Cons (!kl_V3090h) + (!kl_V3090t))) -> pat_cond_3 kl_V3090 kl_V3090h kl_V3090t + _ -> pat_cond_5 + case kl_if_2 of + Atom (B (True)) -> do !appl_6 <- kl_V3090 `pseq` hd kl_V3090 + !appl_7 <- appl_6 `pseq` (kl_V3089 `pseq` klCons appl_6 kl_V3089) + !appl_8 <- kl_V3090 `pseq` tl kl_V3090 + kl_V3088 `pseq` (appl_7 `pseq` (appl_8 `pseq` kl_shen_filter_h kl_V3088 appl_7 appl_8)) + Atom (B (False)) -> do let pat_cond_9 kl_V3090 kl_V3090h kl_V3090t = do kl_V3088 `pseq` (kl_V3089 `pseq` (kl_V3090t `pseq` kl_shen_filter_h kl_V3088 kl_V3089 kl_V3090t)) + pat_cond_10 = do do let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_11 [ApplC (wrapNamed "shen.filter-h" kl_shen_filter_h)] + in case kl_V3090 of + !(kl_V3090@(Cons (!kl_V3090h) + (!kl_V3090t))) -> pat_cond_9 kl_V3090 kl_V3090h kl_V3090t + _ -> pat_cond_10 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_map :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_map (!kl_V3093) (!kl_V3094) = do let !appl_0 = Atom Nil + kl_V3093 `pseq` (kl_V3094 `pseq` (appl_0 `pseq` kl_shen_map_h kl_V3093 kl_V3094 appl_0)) + +kl_shen_map_h :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_map_h (!kl_V3100) (!kl_V3101) (!kl_V3102) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3101 `pseq` eq appl_0 kl_V3101) + case kl_if_1 of + Atom (B (True)) -> do kl_V3102 `pseq` kl_reverse kl_V3102 + Atom (B (False)) -> do let pat_cond_2 kl_V3101 kl_V3101h kl_V3101t = do !appl_3 <- kl_V3101h `pseq` applyWrapper kl_V3100 [kl_V3101h] + !appl_4 <- appl_3 `pseq` (kl_V3102 `pseq` klCons appl_3 kl_V3102) + kl_V3100 `pseq` (kl_V3101t `pseq` (appl_4 `pseq` kl_shen_map_h kl_V3100 kl_V3101t appl_4)) + pat_cond_5 = do do let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_6 [ApplC (wrapNamed "shen.map-h" kl_shen_map_h)] + in case kl_V3101 of + !(kl_V3101@(Cons (!kl_V3101h) + (!kl_V3101t))) -> pat_cond_2 kl_V3101 kl_V3101h kl_V3101t + _ -> pat_cond_5 + _ -> throwError "if: expected boolean" + +kl_length :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_length (!kl_V3104) = do kl_V3104 `pseq` kl_shen_length_h kl_V3104 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + +kl_shen_length_h :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_length_h (!kl_V3107) (!kl_V3108) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3107 `pseq` eq appl_0 kl_V3107) + case kl_if_1 of + Atom (B (True)) -> do return kl_V3108 + Atom (B (False)) -> do do !appl_2 <- kl_V3107 `pseq` tl kl_V3107 + !appl_3 <- kl_V3108 `pseq` add kl_V3108 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + appl_2 `pseq` (appl_3 `pseq` kl_shen_length_h appl_2 appl_3) + _ -> throwError "if: expected boolean" + +kl_occurrences :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_occurrences (!kl_V3120) (!kl_V3121) = do !kl_if_0 <- kl_V3121 `pseq` (kl_V3120 `pseq` eq kl_V3121 kl_V3120) + case kl_if_0 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + Atom (B (False)) -> do let pat_cond_1 kl_V3121 kl_V3121h kl_V3121t = do !appl_2 <- kl_V3120 `pseq` (kl_V3121h `pseq` kl_occurrences kl_V3120 kl_V3121h) + !appl_3 <- kl_V3120 `pseq` (kl_V3121t `pseq` kl_occurrences kl_V3120 kl_V3121t) + appl_2 `pseq` (appl_3 `pseq` add appl_2 appl_3) + pat_cond_4 = do do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + in case kl_V3121 of + !(kl_V3121@(Cons (!kl_V3121h) + (!kl_V3121t))) -> pat_cond_1 kl_V3121 kl_V3121h kl_V3121t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_nth :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_nth (!kl_V3130) (!kl_V3131) = do !kl_if_0 <- let pat_cond_1 = do let pat_cond_2 kl_V3131 kl_V3131h kl_V3131t = do return (Atom (B True)) + pat_cond_3 = do do return (Atom (B False)) + in case kl_V3131 of + !(kl_V3131@(Cons (!kl_V3131h) + (!kl_V3131t))) -> pat_cond_2 kl_V3131 kl_V3131h kl_V3131t + _ -> pat_cond_3 + pat_cond_4 = do do return (Atom (B False)) + in case kl_V3130 of + kl_V3130@(Atom (N (KI 1))) -> pat_cond_1 + _ -> pat_cond_4 + case kl_if_0 of + Atom (B (True)) -> do kl_V3131 `pseq` hd kl_V3131 + Atom (B (False)) -> do let pat_cond_5 kl_V3131 kl_V3131h kl_V3131t = do !appl_6 <- kl_V3130 `pseq` Primitives.subtract kl_V3130 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + appl_6 `pseq` (kl_V3131t `pseq` kl_nth appl_6 kl_V3131t) + pat_cond_7 = do do let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_8 [ApplC (wrapNamed "nth" kl_nth)] + in case kl_V3131 of + !(kl_V3131@(Cons (!kl_V3131h) + (!kl_V3131t))) -> pat_cond_5 kl_V3131 kl_V3131h kl_V3131t + _ -> pat_cond_7 + _ -> throwError "if: expected boolean" + +kl_integerP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_integerP (Atom (N (KI _))) = return (Atom (B True)) +kl_integerP (Atom (N (KD d))) = return (Atom (B (fromInteger (round d) == d))) +kl_integerP !v = return (Atom (B False)) + +kl_shen_abs :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_abs (!kl_V3135) = do !kl_if_0 <- kl_V3135 `pseq` greaterThan kl_V3135 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + case kl_if_0 of + Atom (B (True)) -> do return kl_V3135 + Atom (B (False)) -> do do kl_V3135 `pseq` Primitives.subtract (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) kl_V3135 + _ -> throwError "if: expected boolean" + +kl_shen_magless :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_magless (!kl_V3138) (!kl_V3139) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Nx2) -> do !kl_if_1 <- kl_Nx2 `pseq` (kl_V3138 `pseq` greaterThan kl_Nx2 kl_V3138) + case kl_if_1 of + Atom (B (True)) -> do return kl_V3139 + Atom (B (False)) -> do do kl_V3138 `pseq` (kl_Nx2 `pseq` kl_shen_magless kl_V3138 kl_Nx2) + _ -> throwError "if: expected boolean"))) + !appl_2 <- kl_V3139 `pseq` multiply kl_V3139 (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) + appl_2 `pseq` applyWrapper appl_0 [appl_2] + +kl_shen_integer_testP :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_integer_testP (!kl_V3145) (!kl_V3146) = do let pat_cond_0 = do return (Atom (B True)) + pat_cond_1 = do !kl_if_2 <- kl_V3145 `pseq` greaterThan (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) kl_V3145 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B False)) + Atom (B (False)) -> do do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Abs_N) -> do !kl_if_4 <- kl_Abs_N `pseq` greaterThan (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) kl_Abs_N + case kl_if_4 of + Atom (B (True)) -> do kl_V3145 `pseq` kl_integerP kl_V3145 + Atom (B (False)) -> do do kl_Abs_N `pseq` (kl_V3146 `pseq` kl_shen_integer_testP kl_Abs_N kl_V3146) + _ -> throwError "if: expected boolean"))) + !appl_5 <- kl_V3145 `pseq` (kl_V3146 `pseq` Primitives.subtract kl_V3145 kl_V3146) + appl_5 `pseq` applyWrapper appl_3 [appl_5] + _ -> throwError "if: expected boolean" + in case kl_V3145 of + kl_V3145@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_mapcan :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_mapcan (!kl_V3151) (!kl_V3152) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3152 `pseq` eq appl_0 kl_V3152) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let pat_cond_2 kl_V3152 kl_V3152h kl_V3152t = do !appl_3 <- kl_V3152h `pseq` applyWrapper kl_V3151 [kl_V3152h] + !appl_4 <- kl_V3151 `pseq` (kl_V3152t `pseq` kl_mapcan kl_V3151 kl_V3152t) + appl_3 `pseq` (appl_4 `pseq` kl_append appl_3 appl_4) + pat_cond_5 = do do let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_6 [ApplC (wrapNamed "mapcan" kl_mapcan)] + in case kl_V3152 of + !(kl_V3152@(Cons (!kl_V3152h) + (!kl_V3152t))) -> pat_cond_2 kl_V3152 kl_V3152h kl_V3152t + _ -> pat_cond_5 + _ -> throwError "if: expected boolean" + +kl_EqEq :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_EqEq (!kl_V3164) (!kl_V3165) = do !kl_if_0 <- kl_V3165 `pseq` (kl_V3164 `pseq` eq kl_V3165 kl_V3164) + case kl_if_0 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + +kl_abort :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_abort = do simpleError (Core.Types.Atom (Core.Types.Str "")) + +kl_boundP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_boundP (!kl_V3167) = do !kl_if_0 <- kl_V3167 `pseq` kl_symbolP kl_V3167 + case kl_if_0 of + Atom (B (True)) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Val) -> do let pat_cond_2 = do return (Atom (B False)) + pat_cond_3 = do do return (Atom (B True)) + in case kl_Val of + kl_Val@(Atom (UnboundSym "shen.this-symbol-is-unbound")) -> pat_cond_2 + kl_Val@(ApplC (PL "shen.this-symbol-is-unbound" + _)) -> pat_cond_2 + kl_Val@(ApplC (Func "shen.this-symbol-is-unbound" + _)) -> pat_cond_2 + _ -> pat_cond_3))) + let !appl_4 = ApplC (PL "thunk" (do return (Core.Types.Atom (Core.Types.UnboundSym "shen.this-symbol-is-unbound")))) + !appl_5 <- kl_V3167 `pseq` (appl_4 `pseq` kl_valueDivor kl_V3167 appl_4) + !kl_if_6 <- appl_5 `pseq` applyWrapper appl_1 [appl_5] + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + +kl_shen_string_RBbytes :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_string_RBbytes (!kl_V3169) = do let pat_cond_0 = do return (Atom Nil) + pat_cond_1 = do do !appl_2 <- kl_V3169 `pseq` pos kl_V3169 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !appl_3 <- appl_2 `pseq` stringToN appl_2 + !appl_4 <- kl_V3169 `pseq` tlstr kl_V3169 + !appl_5 <- appl_4 `pseq` kl_shen_string_RBbytes appl_4 + appl_3 `pseq` (appl_5 `pseq` klCons appl_3 appl_5) + in case kl_V3169 of + kl_V3169@(Atom (Str "")) -> pat_cond_0 + _ -> pat_cond_1 + +kl_maxinferences :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_maxinferences (!kl_V3171) = do kl_V3171 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*maxinferences*")) kl_V3171 + +kl_inferences :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_inferences = do value (Core.Types.Atom (Core.Types.UnboundSym "shen.*infs*")) + +kl_protect :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_protect (!kl_V3173) = do return kl_V3173 + +kl_stoutput :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_stoutput = do value (Core.Types.Atom (Core.Types.UnboundSym "*stoutput*")) + +kl_sterror :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_sterror = do value (Core.Types.Atom (Core.Types.UnboundSym "shen.*sterror*")) + +kl_string_RBsymbol :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_string_RBsymbol (!kl_V3175) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Symbol) -> do !kl_if_1 <- kl_Symbol `pseq` kl_symbolP kl_Symbol + case kl_if_1 of + Atom (B (True)) -> do return kl_Symbol + Atom (B (False)) -> do do let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_3 <- kl_V3175 `pseq` applyWrapper aw_2 [kl_V3175, + Core.Types.Atom (Core.Types.Str " to a symbol"), + Core.Types.Atom (Core.Types.UnboundSym "shen.s")] + !appl_4 <- appl_3 `pseq` cn (Core.Types.Atom (Core.Types.Str "cannot intern ")) appl_3 + appl_4 `pseq` simpleError appl_4 + _ -> throwError "if: expected boolean"))) + !appl_5 <- kl_V3175 `pseq` intern kl_V3175 + appl_5 `pseq` applyWrapper appl_0 [appl_5] + +kl_optimise :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_optimise (!kl_V3181) = do let pat_cond_0 = do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*optimise*")) (Atom (B True)) + pat_cond_1 = do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*optimise*")) (Atom (B False)) + pat_cond_2 = do do simpleError (Core.Types.Atom (Core.Types.Str "optimise expects a + or a -.\n")) + in case kl_V3181 of + kl_V3181@(Atom (UnboundSym "+")) -> pat_cond_0 + kl_V3181@(ApplC (PL "+" _)) -> pat_cond_0 + kl_V3181@(ApplC (Func "+" _)) -> pat_cond_0 + kl_V3181@(Atom (UnboundSym "-")) -> pat_cond_1 + kl_V3181@(ApplC (PL "-" _)) -> pat_cond_1 + kl_V3181@(ApplC (Func "-" _)) -> pat_cond_1 + _ -> pat_cond_2 + +kl_os :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_os = do value (Core.Types.Atom (Core.Types.UnboundSym "*os*")) + +kl_language :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_language = do value (Core.Types.Atom (Core.Types.UnboundSym "*language*")) + +kl_version :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_version = do value (Core.Types.Atom (Core.Types.UnboundSym "*version*")) + +kl_port :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_port = do value (Core.Types.Atom (Core.Types.UnboundSym "*port*")) + +kl_porters :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_porters = do value (Core.Types.Atom (Core.Types.UnboundSym "*porters*")) + +kl_implementation :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_implementation = do value (Core.Types.Atom (Core.Types.UnboundSym "*implementation*")) + +kl_release :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_release = do value (Core.Types.Atom (Core.Types.UnboundSym "*release*")) + +kl_packageP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_packageP (!kl_V3183) = do (do !appl_0 <- kl_V3183 `pseq` kl_external kl_V3183 + appl_0 `pseq` kl_do appl_0 (Atom (B True))) `catchError` (\(!kl_E) -> do return (Atom (B False))) + +kl_function :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_function (!kl_V3185) = do kl_V3185 `pseq` kl_shen_lookup_func kl_V3185 + +kl_shen_lookup_func :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_lookup_func (!kl_V3187) = do let !appl_0 = ApplC (PL "thunk" (do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_2 <- kl_V3187 `pseq` applyWrapper aw_1 [kl_V3187, + Core.Types.Atom (Core.Types.Str " has no lambda expansion\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + appl_2 `pseq` simpleError appl_2)) + !appl_3 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + kl_V3187 `pseq` (appl_0 `pseq` (appl_3 `pseq` kl_getDivor kl_V3187 (Core.Types.Atom (Core.Types.UnboundSym "shen.lambda-form")) appl_0 appl_3)) + +expr2 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr2 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Backend/TStar.hs b/Shentong/Backend/TStar.hs # file too large to diff: Shentong/Backend/TStar.hs diff --git a/Shentong/Backend/Toplevel.hs b/Shentong/Backend/Toplevel.hs --- a/Shentong/Backend/Toplevel.hs +++ b/Shentong/Backend/Toplevel.hs @@ -1,1052 +1,1128 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} - -module Backend.Toplevel where - -import Control.Monad.Except -import Control.Parallel -import Environment -import Primitives -import Backend.Utils -import Types -import Utils -import Wrap - -{- -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 :: Types.KLContext Types.Env Types.KLValue -kl_shen_shen = do !appl_0 <- kl_shen_credits - !appl_1 <- kl_shen_loop - let !aw_2 = Types.Atom (Types.UnboundSym "do") - appl_0 `pseq` (appl_1 `pseq` applyWrapper aw_2 [appl_0, appl_1]) - -kl_shen_loop :: Types.KLContext Types.Env Types.KLValue -kl_shen_loop = do !appl_0 <- kl_shen_initialise_environment - !appl_1 <- kl_shen_prompt - !appl_2 <- (do kl_shen_read_evaluate_print) `catchError` (\(!kl_E) -> do !appl_3 <- kl_E `pseq` errorToString (Excep kl_E) - let !aw_4 = Types.Atom (Types.UnboundSym "stoutput") - !appl_5 <- applyWrapper aw_4 [] - let !aw_6 = Types.Atom (Types.UnboundSym "pr") - appl_3 `pseq` (appl_5 `pseq` applyWrapper aw_6 [appl_3, - appl_5])) - !appl_7 <- kl_shen_loop - let !aw_8 = Types.Atom (Types.UnboundSym "do") - !appl_9 <- appl_2 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_2, - appl_7]) - let !aw_10 = Types.Atom (Types.UnboundSym "do") - !appl_11 <- appl_1 `pseq` (appl_9 `pseq` applyWrapper aw_10 [appl_1, - appl_9]) - let !aw_12 = Types.Atom (Types.UnboundSym "do") - appl_0 `pseq` (appl_11 `pseq` applyWrapper aw_12 [appl_0, appl_11]) - -kl_shen_credits :: Types.KLContext Types.Env Types.KLValue -kl_shen_credits = do let !aw_0 = Types.Atom (Types.UnboundSym "stoutput") - !appl_1 <- applyWrapper aw_0 [] - let !aw_2 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_3 <- appl_1 `pseq` applyWrapper aw_2 [Types.Atom (Types.Str "\nShen, copyright (C) 2010-2015 Mark Tarver\n"), - appl_1] - !appl_4 <- value (Types.Atom (Types.UnboundSym "*version*")) - let !aw_5 = Types.Atom (Types.UnboundSym "shen.app") - !appl_6 <- appl_4 `pseq` applyWrapper aw_5 [appl_4, - Types.Atom (Types.Str "\n"), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_7 <- appl_6 `pseq` cn (Types.Atom (Types.Str "www.shenlanguage.org, ")) appl_6 - let !aw_8 = Types.Atom (Types.UnboundSym "stoutput") - !appl_9 <- applyWrapper aw_8 [] - let !aw_10 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_11 <- appl_7 `pseq` (appl_9 `pseq` applyWrapper aw_10 [appl_7, - appl_9]) - !appl_12 <- value (Types.Atom (Types.UnboundSym "*language*")) - !appl_13 <- value (Types.Atom (Types.UnboundSym "*implementation*")) - let !aw_14 = Types.Atom (Types.UnboundSym "shen.app") - !appl_15 <- appl_13 `pseq` applyWrapper aw_14 [appl_13, - Types.Atom (Types.Str ""), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_16 <- appl_15 `pseq` cn (Types.Atom (Types.Str ", implementation: ")) appl_15 - let !aw_17 = Types.Atom (Types.UnboundSym "shen.app") - !appl_18 <- appl_12 `pseq` (appl_16 `pseq` applyWrapper aw_17 [appl_12, - appl_16, - Types.Atom (Types.UnboundSym "shen.a")]) - !appl_19 <- appl_18 `pseq` cn (Types.Atom (Types.Str "running under ")) appl_18 - let !aw_20 = Types.Atom (Types.UnboundSym "stoutput") - !appl_21 <- applyWrapper aw_20 [] - let !aw_22 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_23 <- appl_19 `pseq` (appl_21 `pseq` applyWrapper aw_22 [appl_19, - appl_21]) - !appl_24 <- value (Types.Atom (Types.UnboundSym "*port*")) - !appl_25 <- value (Types.Atom (Types.UnboundSym "*porters*")) - let !aw_26 = Types.Atom (Types.UnboundSym "shen.app") - !appl_27 <- appl_25 `pseq` applyWrapper aw_26 [appl_25, - Types.Atom (Types.Str "\n"), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_28 <- appl_27 `pseq` cn (Types.Atom (Types.Str " ported by ")) appl_27 - let !aw_29 = Types.Atom (Types.UnboundSym "shen.app") - !appl_30 <- appl_24 `pseq` (appl_28 `pseq` applyWrapper aw_29 [appl_24, - appl_28, - Types.Atom (Types.UnboundSym "shen.a")]) - !appl_31 <- appl_30 `pseq` cn (Types.Atom (Types.Str "\nport ")) appl_30 - let !aw_32 = Types.Atom (Types.UnboundSym "stoutput") - !appl_33 <- applyWrapper aw_32 [] - let !aw_34 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_35 <- appl_31 `pseq` (appl_33 `pseq` applyWrapper aw_34 [appl_31, - appl_33]) - let !aw_36 = Types.Atom (Types.UnboundSym "do") - !appl_37 <- appl_23 `pseq` (appl_35 `pseq` applyWrapper aw_36 [appl_23, - appl_35]) - let !aw_38 = Types.Atom (Types.UnboundSym "do") - !appl_39 <- appl_11 `pseq` (appl_37 `pseq` applyWrapper aw_38 [appl_11, - appl_37]) - let !aw_40 = Types.Atom (Types.UnboundSym "do") - appl_3 `pseq` (appl_39 `pseq` applyWrapper aw_40 [appl_3, appl_39]) - -kl_shen_initialise_environment :: Types.KLContext Types.Env - Types.KLValue -kl_shen_initialise_environment = do !appl_0 <- klCons (Types.Atom (Types.N (Types.KI 0))) (Types.Atom Types.Nil) - !appl_1 <- appl_0 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.*catch*")) appl_0 - !appl_2 <- appl_1 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_1 - !appl_3 <- appl_2 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.*process-counter*")) appl_2 - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_3 - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.*infs*")) appl_4 - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.N (Types.KI 0))) appl_5 - !appl_7 <- appl_6 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.*call*")) appl_6 - appl_7 `pseq` kl_shen_multiple_set appl_7 - -kl_shen_multiple_set :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_multiple_set (!kl_V3668) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 kl_V3668 kl_V3668h kl_V3668t kl_V3668th kl_V3668tt = do !appl_2 <- kl_V3668h `pseq` (kl_V3668th `pseq` klSet kl_V3668h kl_V3668th) - !appl_3 <- kl_V3668tt `pseq` kl_shen_multiple_set kl_V3668tt - let !aw_4 = Types.Atom (Types.UnboundSym "do") - appl_2 `pseq` (appl_3 `pseq` applyWrapper aw_4 [appl_2, - appl_3]) - pat_cond_5 = do do let !aw_6 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_6 [ApplC (wrapNamed "shen.multiple-set" kl_shen_multiple_set)] - in case kl_V3668 of - kl_V3668@(Atom (Nil)) -> pat_cond_0 - !(kl_V3668@(Cons (!kl_V3668h) - (!(kl_V3668t@(Cons (!kl_V3668th) - (!kl_V3668tt)))))) -> pat_cond_1 kl_V3668 kl_V3668h kl_V3668t kl_V3668th kl_V3668tt - _ -> pat_cond_5 - -kl_destroy :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_destroy (!kl_V3670) = do let !aw_0 = Types.Atom (Types.UnboundSym "declare") - kl_V3670 `pseq` applyWrapper aw_0 [kl_V3670, - Types.Atom (Types.UnboundSym "symbol")] - -kl_shen_read_evaluate_print :: Types.KLContext Types.Env - Types.KLValue -kl_shen_read_evaluate_print = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Lineread) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_History) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_NewLineread) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_NewHistory) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parsed) -> do kl_Parsed `pseq` kl_shen_toplevel kl_Parsed))) - let !aw_5 = Types.Atom (Types.UnboundSym "fst") - !appl_6 <- kl_NewLineread `pseq` applyWrapper aw_5 [kl_NewLineread] - appl_6 `pseq` applyWrapper appl_4 [appl_6]))) - !appl_7 <- kl_NewLineread `pseq` (kl_History `pseq` kl_shen_update_history kl_NewLineread kl_History) - appl_7 `pseq` applyWrapper appl_3 [appl_7]))) - !appl_8 <- kl_Lineread `pseq` (kl_History `pseq` kl_shen_retrieve_from_history_if_needed kl_Lineread kl_History) - appl_8 `pseq` applyWrapper appl_2 [appl_8]))) - !appl_9 <- value (Types.Atom (Types.UnboundSym "shen.*history*")) - appl_9 `pseq` applyWrapper appl_1 [appl_9]))) - !appl_10 <- kl_shen_toplineread - appl_10 `pseq` applyWrapper appl_0 [appl_10] - -kl_shen_retrieve_from_history_if_needed :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_retrieve_from_history_if_needed (!kl_V3682) (!kl_V3683) = do let !aw_0 = Types.Atom (Types.UnboundSym "tuple?") - !kl_if_1 <- kl_V3682 `pseq` applyWrapper aw_0 [kl_V3682] - !kl_if_2 <- case kl_if_1 of - Atom (B (True)) -> do let !aw_3 = Types.Atom (Types.UnboundSym "snd") - !appl_4 <- kl_V3682 `pseq` applyWrapper aw_3 [kl_V3682] - !kl_if_5 <- appl_4 `pseq` consP appl_4 - !kl_if_6 <- case kl_if_5 of - Atom (B (True)) -> do let !aw_7 = Types.Atom (Types.UnboundSym "snd") - !appl_8 <- kl_V3682 `pseq` applyWrapper aw_7 [kl_V3682] - !appl_9 <- appl_8 `pseq` hd appl_8 - !appl_10 <- kl_shen_space - !appl_11 <- kl_shen_newline - !appl_12 <- appl_11 `pseq` klCons appl_11 (Types.Atom Types.Nil) - !appl_13 <- appl_10 `pseq` (appl_12 `pseq` klCons appl_10 appl_12) - let !aw_14 = Types.Atom (Types.UnboundSym "element?") - !kl_if_15 <- appl_9 `pseq` (appl_13 `pseq` applyWrapper aw_14 [appl_9, - 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" - 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" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_2 of - Atom (B (True)) -> do let !aw_16 = Types.Atom (Types.UnboundSym "fst") - !appl_17 <- kl_V3682 `pseq` applyWrapper aw_16 [kl_V3682] - let !aw_18 = Types.Atom (Types.UnboundSym "snd") - !appl_19 <- kl_V3682 `pseq` applyWrapper aw_18 [kl_V3682] - !appl_20 <- appl_19 `pseq` tl appl_19 - let !aw_21 = Types.Atom (Types.UnboundSym "@p") - !appl_22 <- appl_17 `pseq` (appl_20 `pseq` applyWrapper aw_21 [appl_17, - appl_20]) - appl_22 `pseq` (kl_V3683 `pseq` kl_shen_retrieve_from_history_if_needed appl_22 kl_V3683) - Atom (B (False)) -> do let !aw_23 = Types.Atom (Types.UnboundSym "tuple?") - !kl_if_24 <- kl_V3682 `pseq` applyWrapper aw_23 [kl_V3682] - !kl_if_25 <- case kl_if_24 of - Atom (B (True)) -> do let !aw_26 = Types.Atom (Types.UnboundSym "snd") - !appl_27 <- kl_V3682 `pseq` applyWrapper aw_26 [kl_V3682] - !kl_if_28 <- appl_27 `pseq` consP appl_27 - !kl_if_29 <- case kl_if_28 of - Atom (B (True)) -> do let !aw_30 = Types.Atom (Types.UnboundSym "snd") - !appl_31 <- kl_V3682 `pseq` applyWrapper aw_30 [kl_V3682] - !appl_32 <- appl_31 `pseq` tl appl_31 - !kl_if_33 <- appl_32 `pseq` consP appl_32 - !kl_if_34 <- case kl_if_33 of - Atom (B (True)) -> do let !aw_35 = Types.Atom (Types.UnboundSym "snd") - !appl_36 <- kl_V3682 `pseq` applyWrapper aw_35 [kl_V3682] - !appl_37 <- appl_36 `pseq` tl appl_36 - !appl_38 <- appl_37 `pseq` tl appl_37 - !kl_if_39 <- appl_38 `pseq` eq (Types.Atom Types.Nil) appl_38 - !kl_if_40 <- case kl_if_39 of - Atom (B (True)) -> do !kl_if_41 <- let pat_cond_42 kl_V3683 kl_V3683h kl_V3683t = do let !aw_43 = Types.Atom (Types.UnboundSym "snd") - !appl_44 <- kl_V3682 `pseq` applyWrapper aw_43 [kl_V3682] - !appl_45 <- appl_44 `pseq` hd appl_44 - !appl_46 <- kl_shen_exclamation - !kl_if_47 <- appl_45 `pseq` (appl_46 `pseq` eq appl_45 appl_46) - !kl_if_48 <- case kl_if_47 of - Atom (B (True)) -> do let !aw_49 = Types.Atom (Types.UnboundSym "snd") - !appl_50 <- kl_V3682 `pseq` applyWrapper aw_49 [kl_V3682] - !appl_51 <- appl_50 `pseq` tl appl_50 - !appl_52 <- appl_51 `pseq` hd appl_51 - !appl_53 <- kl_shen_exclamation - !kl_if_54 <- appl_52 `pseq` (appl_53 `pseq` eq appl_52 appl_53) - case kl_if_54 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_48 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_55 = do do return (Atom (B False)) - in case kl_V3683 of - !(kl_V3683@(Cons (!kl_V3683h) - (!kl_V3683t))) -> pat_cond_42 kl_V3683 kl_V3683h kl_V3683t - _ -> pat_cond_55 - case kl_if_41 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_40 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_34 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_29 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_25 of - Atom (B (True)) -> do let !appl_56 = ApplC (Func "lambda" (Context (\(!kl_PastPrint) -> do kl_V3683 `pseq` hd kl_V3683))) - !appl_57 <- kl_V3683 `pseq` hd kl_V3683 - let !aw_58 = Types.Atom (Types.UnboundSym "snd") - !appl_59 <- appl_57 `pseq` applyWrapper aw_58 [appl_57] - !appl_60 <- appl_59 `pseq` kl_shen_prbytes appl_59 - appl_60 `pseq` applyWrapper appl_56 [appl_60] - Atom (B (False)) -> do let !aw_61 = Types.Atom (Types.UnboundSym "tuple?") - !kl_if_62 <- kl_V3682 `pseq` applyWrapper aw_61 [kl_V3682] - !kl_if_63 <- case kl_if_62 of - Atom (B (True)) -> do let !aw_64 = Types.Atom (Types.UnboundSym "snd") - !appl_65 <- kl_V3682 `pseq` applyWrapper aw_64 [kl_V3682] - !kl_if_66 <- appl_65 `pseq` consP appl_65 - !kl_if_67 <- case kl_if_66 of - Atom (B (True)) -> do let !aw_68 = Types.Atom (Types.UnboundSym "snd") - !appl_69 <- kl_V3682 `pseq` applyWrapper aw_68 [kl_V3682] - !appl_70 <- appl_69 `pseq` hd appl_69 - !appl_71 <- kl_shen_exclamation - !kl_if_72 <- appl_70 `pseq` (appl_71 `pseq` eq appl_70 appl_71) - case kl_if_72 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_67 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_63 of - Atom (B (True)) -> do let !appl_73 = ApplC (Func "lambda" (Context (\(!kl_KeyP) -> do let !appl_74 = ApplC (Func "lambda" (Context (\(!kl_Find) -> do let !appl_75 = ApplC (Func "lambda" (Context (\(!kl_PastPrint) -> do return kl_Find))) - let !aw_76 = Types.Atom (Types.UnboundSym "snd") - !appl_77 <- kl_Find `pseq` applyWrapper aw_76 [kl_Find] - !appl_78 <- appl_77 `pseq` kl_shen_prbytes appl_77 - appl_78 `pseq` applyWrapper appl_75 [appl_78]))) - !appl_79 <- kl_KeyP `pseq` (kl_V3683 `pseq` kl_shen_find_past_inputs kl_KeyP kl_V3683) - let !aw_80 = Types.Atom (Types.UnboundSym "head") - !appl_81 <- appl_79 `pseq` applyWrapper aw_80 [appl_79] - appl_81 `pseq` applyWrapper appl_74 [appl_81]))) - let !aw_82 = Types.Atom (Types.UnboundSym "snd") - !appl_83 <- kl_V3682 `pseq` applyWrapper aw_82 [kl_V3682] - !appl_84 <- appl_83 `pseq` tl appl_83 - !appl_85 <- appl_84 `pseq` (kl_V3683 `pseq` kl_shen_make_key appl_84 kl_V3683) - appl_85 `pseq` applyWrapper appl_73 [appl_85] - Atom (B (False)) -> do let !aw_86 = Types.Atom (Types.UnboundSym "tuple?") - !kl_if_87 <- kl_V3682 `pseq` applyWrapper aw_86 [kl_V3682] - !kl_if_88 <- case kl_if_87 of - Atom (B (True)) -> do let !aw_89 = Types.Atom (Types.UnboundSym "snd") - !appl_90 <- kl_V3682 `pseq` applyWrapper aw_89 [kl_V3682] - !kl_if_91 <- appl_90 `pseq` consP appl_90 - !kl_if_92 <- case kl_if_91 of - Atom (B (True)) -> do let !aw_93 = Types.Atom (Types.UnboundSym "snd") - !appl_94 <- kl_V3682 `pseq` applyWrapper aw_93 [kl_V3682] - !appl_95 <- appl_94 `pseq` tl appl_94 - !kl_if_96 <- appl_95 `pseq` eq (Types.Atom Types.Nil) appl_95 - !kl_if_97 <- case kl_if_96 of - Atom (B (True)) -> do let !aw_98 = Types.Atom (Types.UnboundSym "snd") - !appl_99 <- kl_V3682 `pseq` applyWrapper aw_98 [kl_V3682] - !appl_100 <- appl_99 `pseq` hd appl_99 - !appl_101 <- kl_shen_percent - !kl_if_102 <- appl_100 `pseq` (appl_101 `pseq` eq appl_100 appl_101) - 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" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - 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" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_92 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_88 of - Atom (B (True)) -> do let !appl_103 = ApplC (Func "lambda" (Context (\(!kl_X) -> do return (Atom (B True))))) - let !aw_104 = Types.Atom (Types.UnboundSym "reverse") - !appl_105 <- kl_V3683 `pseq` applyWrapper aw_104 [kl_V3683] - !appl_106 <- appl_103 `pseq` (appl_105 `pseq` kl_shen_print_past_inputs appl_103 appl_105 (Types.Atom (Types.N (Types.KI 0)))) - let !aw_107 = Types.Atom (Types.UnboundSym "abort") - !appl_108 <- applyWrapper aw_107 [] - let !aw_109 = Types.Atom (Types.UnboundSym "do") - appl_106 `pseq` (appl_108 `pseq` applyWrapper aw_109 [appl_106, - appl_108]) - Atom (B (False)) -> do let !aw_110 = Types.Atom (Types.UnboundSym "tuple?") - !kl_if_111 <- kl_V3682 `pseq` applyWrapper aw_110 [kl_V3682] - !kl_if_112 <- case kl_if_111 of - Atom (B (True)) -> do let !aw_113 = Types.Atom (Types.UnboundSym "snd") - !appl_114 <- kl_V3682 `pseq` applyWrapper aw_113 [kl_V3682] - !kl_if_115 <- appl_114 `pseq` consP appl_114 - !kl_if_116 <- case kl_if_115 of - Atom (B (True)) -> do let !aw_117 = Types.Atom (Types.UnboundSym "snd") - !appl_118 <- kl_V3682 `pseq` applyWrapper aw_117 [kl_V3682] - !appl_119 <- appl_118 `pseq` hd appl_118 - !appl_120 <- kl_shen_percent - !kl_if_121 <- appl_119 `pseq` (appl_120 `pseq` eq appl_119 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_116 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_112 of - Atom (B (True)) -> do let !appl_122 = ApplC (Func "lambda" (Context (\(!kl_KeyP) -> do let !appl_123 = ApplC (Func "lambda" (Context (\(!kl_Pastprint) -> do let !aw_124 = Types.Atom (Types.UnboundSym "abort") - applyWrapper aw_124 []))) - let !aw_125 = Types.Atom (Types.UnboundSym "reverse") - !appl_126 <- kl_V3683 `pseq` applyWrapper aw_125 [kl_V3683] - !appl_127 <- kl_KeyP `pseq` (appl_126 `pseq` kl_shen_print_past_inputs kl_KeyP appl_126 (Types.Atom (Types.N (Types.KI 0)))) - appl_127 `pseq` applyWrapper appl_123 [appl_127]))) - let !aw_128 = Types.Atom (Types.UnboundSym "snd") - !appl_129 <- kl_V3682 `pseq` applyWrapper aw_128 [kl_V3682] - !appl_130 <- appl_129 `pseq` tl appl_129 - !appl_131 <- appl_130 `pseq` (kl_V3683 `pseq` kl_shen_make_key appl_130 kl_V3683) - appl_131 `pseq` applyWrapper appl_122 [appl_131] - Atom (B (False)) -> do do return kl_V3682 - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - -kl_shen_percent :: Types.KLContext Types.Env Types.KLValue -kl_shen_percent = do return (Types.Atom (Types.N (Types.KI 37))) - -kl_shen_exclamation :: Types.KLContext Types.Env Types.KLValue -kl_shen_exclamation = do return (Types.Atom (Types.N (Types.KI 33))) - -kl_shen_prbytes :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_prbytes (!kl_V3685) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Byte) -> do !appl_1 <- kl_Byte `pseq` nToString kl_Byte - let !aw_2 = Types.Atom (Types.UnboundSym "stoutput") - !appl_3 <- applyWrapper aw_2 [] - let !aw_4 = Types.Atom (Types.UnboundSym "pr") - appl_1 `pseq` (appl_3 `pseq` applyWrapper aw_4 [appl_1, - appl_3])))) - let !aw_5 = Types.Atom (Types.UnboundSym "map") - !appl_6 <- appl_0 `pseq` (kl_V3685 `pseq` applyWrapper aw_5 [appl_0, - kl_V3685]) - let !aw_7 = Types.Atom (Types.UnboundSym "nl") - !appl_8 <- applyWrapper aw_7 [Types.Atom (Types.N (Types.KI 1))] - let !aw_9 = Types.Atom (Types.UnboundSym "do") - appl_6 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_6, appl_8]) - -kl_shen_update_history :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_update_history (!kl_V3688) (!kl_V3689) = do !appl_0 <- kl_V3688 `pseq` (kl_V3689 `pseq` klCons kl_V3688 kl_V3689) - appl_0 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*history*")) appl_0 - -kl_shen_toplineread :: Types.KLContext Types.Env Types.KLValue -kl_shen_toplineread = do let !aw_0 = Types.Atom (Types.UnboundSym "stinput") - !appl_1 <- applyWrapper aw_0 [] - !appl_2 <- appl_1 `pseq` readByte appl_1 - appl_2 `pseq` kl_shen_toplineread_loop appl_2 (Types.Atom Types.Nil) - -kl_shen_toplineread_loop :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_toplineread_loop (!kl_V3693) (!kl_V3694) = do !appl_0 <- kl_shen_hat - !kl_if_1 <- kl_V3693 `pseq` (appl_0 `pseq` eq kl_V3693 appl_0) - case kl_if_1 of - Atom (B (True)) -> do simpleError (Types.Atom (Types.Str "line read aborted")) - Atom (B (False)) -> do !appl_2 <- kl_shen_newline - !appl_3 <- kl_shen_carriage_return - !appl_4 <- appl_3 `pseq` klCons appl_3 (Types.Atom Types.Nil) - !appl_5 <- appl_2 `pseq` (appl_4 `pseq` klCons appl_2 appl_4) - let !aw_6 = Types.Atom (Types.UnboundSym "element?") - !kl_if_7 <- kl_V3693 `pseq` (appl_5 `pseq` applyWrapper aw_6 [kl_V3693, - appl_5]) - case kl_if_7 of - Atom (B (True)) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Line) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_It) -> do !kl_if_10 <- let pat_cond_11 = do return (Atom (B True)) - pat_cond_12 = do do let !aw_13 = Types.Atom (Types.UnboundSym "empty?") - !kl_if_14 <- kl_Line `pseq` applyWrapper aw_13 [kl_Line] - case kl_if_14 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - in case kl_Line of - kl_Line@(Atom (UnboundSym "shen.nextline")) -> pat_cond_11 - kl_Line@(ApplC (PL "shen.nextline" - _)) -> pat_cond_11 - kl_Line@(ApplC (Func "shen.nextline" - _)) -> pat_cond_11 - _ -> pat_cond_12 - case kl_if_10 of - Atom (B (True)) -> do let !aw_15 = Types.Atom (Types.UnboundSym "stinput") - !appl_16 <- applyWrapper aw_15 [] - !appl_17 <- appl_16 `pseq` readByte appl_16 - !appl_18 <- kl_V3693 `pseq` klCons kl_V3693 (Types.Atom Types.Nil) - let !aw_19 = Types.Atom (Types.UnboundSym "append") - !appl_20 <- kl_V3694 `pseq` (appl_18 `pseq` applyWrapper aw_19 [kl_V3694, - appl_18]) - appl_17 `pseq` (appl_20 `pseq` kl_shen_toplineread_loop appl_17 appl_20) - Atom (B (False)) -> do do let !aw_21 = Types.Atom (Types.UnboundSym "@p") - kl_Line `pseq` (kl_V3694 `pseq` applyWrapper aw_21 [kl_Line, - kl_V3694]) - _ -> throwError "if: expected boolean"))) - let !aw_22 = Types.Atom (Types.UnboundSym "shen.record-it") - !appl_23 <- kl_V3694 `pseq` applyWrapper aw_22 [kl_V3694] - appl_23 `pseq` applyWrapper appl_9 [appl_23]))) - let !appl_24 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_25 = Types.Atom (Types.UnboundSym "shen.") - kl_X `pseq` applyWrapper aw_25 [kl_X]))) - let !appl_26 = ApplC (Func "lambda" (Context (\(!kl_E) -> do return (Types.Atom (Types.UnboundSym "shen.nextline"))))) - let !aw_27 = Types.Atom (Types.UnboundSym "compile") - !appl_28 <- appl_24 `pseq` (kl_V3694 `pseq` (appl_26 `pseq` applyWrapper aw_27 [appl_24, - kl_V3694, - appl_26])) - appl_28 `pseq` applyWrapper appl_8 [appl_28] - Atom (B (False)) -> do do let !aw_29 = Types.Atom (Types.UnboundSym "stinput") - !appl_30 <- applyWrapper aw_29 [] - !appl_31 <- appl_30 `pseq` readByte appl_30 - !appl_32 <- kl_V3693 `pseq` klCons kl_V3693 (Types.Atom Types.Nil) - let !aw_33 = Types.Atom (Types.UnboundSym "append") - !appl_34 <- kl_V3694 `pseq` (appl_32 `pseq` applyWrapper aw_33 [kl_V3694, - appl_32]) - appl_31 `pseq` (appl_34 `pseq` kl_shen_toplineread_loop appl_31 appl_34) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - -kl_shen_hat :: Types.KLContext Types.Env Types.KLValue -kl_shen_hat = do return (Types.Atom (Types.N (Types.KI 94))) - -kl_shen_newline :: Types.KLContext Types.Env Types.KLValue -kl_shen_newline = do return (Types.Atom (Types.N (Types.KI 10))) - -kl_shen_carriage_return :: Types.KLContext Types.Env Types.KLValue -kl_shen_carriage_return = do return (Types.Atom (Types.N (Types.KI 13))) - -kl_tc :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_tc (!kl_V3700) = do let pat_cond_0 = do klSet (Types.Atom (Types.UnboundSym "shen.*tc*")) (Atom (B True)) - pat_cond_1 = do klSet (Types.Atom (Types.UnboundSym "shen.*tc*")) (Atom (B False)) - pat_cond_2 = do do simpleError (Types.Atom (Types.Str "tc expects a + or -")) - in case kl_V3700 of - kl_V3700@(Atom (UnboundSym "+")) -> pat_cond_0 - kl_V3700@(ApplC (PL "+" _)) -> pat_cond_0 - kl_V3700@(ApplC (Func "+" _)) -> pat_cond_0 - kl_V3700@(Atom (UnboundSym "-")) -> pat_cond_1 - kl_V3700@(ApplC (PL "-" _)) -> pat_cond_1 - kl_V3700@(ApplC (Func "-" _)) -> pat_cond_1 - _ -> pat_cond_2 - -kl_shen_prompt :: Types.KLContext Types.Env Types.KLValue -kl_shen_prompt = do !kl_if_0 <- value (Types.Atom (Types.UnboundSym "shen.*tc*")) - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- value (Types.Atom (Types.UnboundSym "shen.*history*")) - let !aw_2 = Types.Atom (Types.UnboundSym "length") - !appl_3 <- appl_1 `pseq` applyWrapper aw_2 [appl_1] - let !aw_4 = Types.Atom (Types.UnboundSym "shen.app") - !appl_5 <- appl_3 `pseq` applyWrapper aw_4 [appl_3, - Types.Atom (Types.Str "+) "), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_6 <- appl_5 `pseq` cn (Types.Atom (Types.Str "\n\n(")) appl_5 - let !aw_7 = Types.Atom (Types.UnboundSym "stoutput") - !appl_8 <- applyWrapper aw_7 [] - let !aw_9 = Types.Atom (Types.UnboundSym "shen.prhush") - appl_6 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_6, - appl_8]) - Atom (B (False)) -> do do !appl_10 <- value (Types.Atom (Types.UnboundSym "shen.*history*")) - let !aw_11 = Types.Atom (Types.UnboundSym "length") - !appl_12 <- appl_10 `pseq` applyWrapper aw_11 [appl_10] - let !aw_13 = Types.Atom (Types.UnboundSym "shen.app") - !appl_14 <- appl_12 `pseq` applyWrapper aw_13 [appl_12, - Types.Atom (Types.Str "-) "), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_15 <- appl_14 `pseq` cn (Types.Atom (Types.Str "\n\n(")) 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]) - _ -> throwError "if: expected boolean" - -kl_shen_toplevel :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_toplevel (!kl_V3702) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*tc*")) - kl_V3702 `pseq` (appl_0 `pseq` kl_shen_toplevel_evaluate kl_V3702 appl_0) - -kl_shen_find_past_inputs :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_find_past_inputs (!kl_V3705) (!kl_V3706) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_F) -> do let !aw_1 = Types.Atom (Types.UnboundSym "empty?") - !kl_if_2 <- kl_F `pseq` applyWrapper aw_1 [kl_F] - case kl_if_2 of - Atom (B (True)) -> do simpleError (Types.Atom (Types.Str "input not found\n")) - Atom (B (False)) -> do do return kl_F - _ -> throwError "if: expected boolean"))) - !appl_3 <- kl_V3705 `pseq` (kl_V3706 `pseq` kl_shen_find kl_V3705 kl_V3706) - appl_3 `pseq` applyWrapper appl_0 [appl_3] - -kl_shen_make_key :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_make_key (!kl_V3709) (!kl_V3710) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Atom) -> do let !aw_1 = Types.Atom (Types.UnboundSym "integer?") - !kl_if_2 <- kl_Atom `pseq` applyWrapper aw_1 [kl_Atom] - case kl_if_2 of - Atom (B (True)) -> do return (ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_3 <- kl_Atom `pseq` add kl_Atom (Types.Atom (Types.N (Types.KI 1))) - let !aw_4 = Types.Atom (Types.UnboundSym "reverse") - !appl_5 <- kl_V3710 `pseq` applyWrapper aw_4 [kl_V3710] - let !aw_6 = Types.Atom (Types.UnboundSym "nth") - !appl_7 <- appl_3 `pseq` (appl_5 `pseq` applyWrapper aw_6 [appl_3, - appl_5]) - kl_X `pseq` (appl_7 `pseq` eq kl_X appl_7))))) - Atom (B (False)) -> do do return (ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_8 = Types.Atom (Types.UnboundSym "snd") - !appl_9 <- kl_X `pseq` applyWrapper aw_8 [kl_X] - !appl_10 <- appl_9 `pseq` kl_shen_trim_gubbins appl_9 - kl_V3709 `pseq` (appl_10 `pseq` kl_shen_prefixP kl_V3709 appl_10))))) - _ -> throwError "if: expected boolean"))) - let !appl_11 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_12 = Types.Atom (Types.UnboundSym "shen.") - kl_X `pseq` applyWrapper aw_12 [kl_X]))) - let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_E) -> do let pat_cond_14 kl_E kl_Eh kl_Et = do let !aw_15 = Types.Atom (Types.UnboundSym "shen.app") - !appl_16 <- kl_E `pseq` applyWrapper aw_15 [kl_E, - Types.Atom (Types.Str "\n"), - Types.Atom (Types.UnboundSym "shen.s")] - !appl_17 <- appl_16 `pseq` cn (Types.Atom (Types.Str "parse error here: ")) appl_16 - appl_17 `pseq` simpleError appl_17 - pat_cond_18 = do do simpleError (Types.Atom (Types.Str "parse error\n")) - in case kl_E of - !(kl_E@(Cons (!kl_Eh) - (!kl_Et))) -> pat_cond_14 kl_E kl_Eh kl_Et - _ -> pat_cond_18))) - let !aw_19 = Types.Atom (Types.UnboundSym "compile") - !appl_20 <- appl_11 `pseq` (kl_V3709 `pseq` (appl_13 `pseq` applyWrapper aw_19 [appl_11, - kl_V3709, - appl_13])) - !appl_21 <- appl_20 `pseq` hd appl_20 - appl_21 `pseq` applyWrapper appl_0 [appl_21] - -kl_shen_trim_gubbins :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_trim_gubbins (!kl_V3712) = do !kl_if_0 <- let pat_cond_1 kl_V3712 kl_V3712h kl_V3712t = do !appl_2 <- kl_shen_space - !kl_if_3 <- kl_V3712h `pseq` (appl_2 `pseq` eq kl_V3712h appl_2) - case kl_if_3 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_4 = do do return (Atom (B False)) - in case kl_V3712 of - !(kl_V3712@(Cons (!kl_V3712h) - (!kl_V3712t))) -> pat_cond_1 kl_V3712 kl_V3712h kl_V3712t - _ -> pat_cond_4 - case kl_if_0 of - Atom (B (True)) -> do !appl_5 <- kl_V3712 `pseq` tl kl_V3712 - appl_5 `pseq` kl_shen_trim_gubbins appl_5 - Atom (B (False)) -> do !kl_if_6 <- let pat_cond_7 kl_V3712 kl_V3712h kl_V3712t = do !appl_8 <- kl_shen_newline - !kl_if_9 <- kl_V3712h `pseq` (appl_8 `pseq` eq kl_V3712h appl_8) - case kl_if_9 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_10 = do do return (Atom (B False)) - in case kl_V3712 of - !(kl_V3712@(Cons (!kl_V3712h) - (!kl_V3712t))) -> pat_cond_7 kl_V3712 kl_V3712h kl_V3712t - _ -> pat_cond_10 - case kl_if_6 of - Atom (B (True)) -> do !appl_11 <- kl_V3712 `pseq` tl kl_V3712 - appl_11 `pseq` kl_shen_trim_gubbins appl_11 - Atom (B (False)) -> do !kl_if_12 <- let pat_cond_13 kl_V3712 kl_V3712h kl_V3712t = do !appl_14 <- kl_shen_carriage_return - !kl_if_15 <- kl_V3712h `pseq` (appl_14 `pseq` eq kl_V3712h appl_14) - 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" - pat_cond_16 = do do return (Atom (B False)) - in case kl_V3712 of - !(kl_V3712@(Cons (!kl_V3712h) - (!kl_V3712t))) -> pat_cond_13 kl_V3712 kl_V3712h kl_V3712t - _ -> pat_cond_16 - case kl_if_12 of - Atom (B (True)) -> do !appl_17 <- kl_V3712 `pseq` tl kl_V3712 - appl_17 `pseq` kl_shen_trim_gubbins appl_17 - Atom (B (False)) -> do !kl_if_18 <- let pat_cond_19 kl_V3712 kl_V3712h kl_V3712t = do !appl_20 <- kl_shen_tab - !kl_if_21 <- kl_V3712h `pseq` (appl_20 `pseq` eq kl_V3712h appl_20) - 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_22 = do do return (Atom (B False)) - in case kl_V3712 of - !(kl_V3712@(Cons (!kl_V3712h) - (!kl_V3712t))) -> pat_cond_19 kl_V3712 kl_V3712h kl_V3712t - _ -> pat_cond_22 - case kl_if_18 of - Atom (B (True)) -> do !appl_23 <- kl_V3712 `pseq` tl kl_V3712 - appl_23 `pseq` kl_shen_trim_gubbins appl_23 - Atom (B (False)) -> do !kl_if_24 <- let pat_cond_25 kl_V3712 kl_V3712h kl_V3712t = do !appl_26 <- kl_shen_left_round - !kl_if_27 <- kl_V3712h `pseq` (appl_26 `pseq` eq kl_V3712h appl_26) - 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_28 = do do return (Atom (B False)) - in case kl_V3712 of - !(kl_V3712@(Cons (!kl_V3712h) - (!kl_V3712t))) -> pat_cond_25 kl_V3712 kl_V3712h kl_V3712t - _ -> pat_cond_28 - case kl_if_24 of - Atom (B (True)) -> do !appl_29 <- kl_V3712 `pseq` tl kl_V3712 - appl_29 `pseq` kl_shen_trim_gubbins appl_29 - Atom (B (False)) -> do do return kl_V3712 - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - -kl_shen_space :: Types.KLContext Types.Env Types.KLValue -kl_shen_space = do return (Types.Atom (Types.N (Types.KI 32))) - -kl_shen_tab :: Types.KLContext Types.Env Types.KLValue -kl_shen_tab = do return (Types.Atom (Types.N (Types.KI 9))) - -kl_shen_left_round :: Types.KLContext Types.Env Types.KLValue -kl_shen_left_round = do return (Types.Atom (Types.N (Types.KI 40))) - -kl_shen_find :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_find (!kl_V3721) (!kl_V3722) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 = do !kl_if_2 <- let pat_cond_3 kl_V3722 kl_V3722h kl_V3722t = do !kl_if_4 <- kl_V3722h `pseq` applyWrapper kl_V3721 [kl_V3722h] - 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_5 = do do return (Atom (B False)) - in case kl_V3722 of - !(kl_V3722@(Cons (!kl_V3722h) - (!kl_V3722t))) -> pat_cond_3 kl_V3722 kl_V3722h kl_V3722t - _ -> pat_cond_5 - case kl_if_2 of - Atom (B (True)) -> do !appl_6 <- kl_V3722 `pseq` hd kl_V3722 - !appl_7 <- kl_V3722 `pseq` tl kl_V3722 - !appl_8 <- kl_V3721 `pseq` (appl_7 `pseq` kl_shen_find kl_V3721 appl_7) - appl_6 `pseq` (appl_8 `pseq` klCons appl_6 appl_8) - Atom (B (False)) -> do let pat_cond_9 kl_V3722 kl_V3722h kl_V3722t = do kl_V3721 `pseq` (kl_V3722t `pseq` kl_shen_find kl_V3721 kl_V3722t) - pat_cond_10 = do do let !aw_11 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_11 [ApplC (wrapNamed "shen.find" kl_shen_find)] - in case kl_V3722 of - !(kl_V3722@(Cons (!kl_V3722h) - (!kl_V3722t))) -> pat_cond_9 kl_V3722 kl_V3722h kl_V3722t - _ -> pat_cond_10 - _ -> throwError "if: expected boolean" - in case kl_V3722 of - kl_V3722@(Atom (Nil)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_prefixP :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_prefixP (!kl_V3736) (!kl_V3737) = do let pat_cond_0 = do return (Atom (B True)) - pat_cond_1 = do !kl_if_2 <- let pat_cond_3 kl_V3736 kl_V3736h kl_V3736t = do let pat_cond_4 kl_V3737 kl_V3737h kl_V3737t = do return (Atom (B True)) - pat_cond_5 = do do return (Atom (B False)) - in case kl_V3737 of - !(kl_V3737@(Cons (!kl_V3737h) - (!kl_V3737t))) | eqCore kl_V3737h kl_V3736h -> pat_cond_4 kl_V3737 kl_V3737h kl_V3737t - _ -> pat_cond_5 - pat_cond_6 = do do return (Atom (B False)) - in case kl_V3736 of - !(kl_V3736@(Cons (!kl_V3736h) - (!kl_V3736t))) -> pat_cond_3 kl_V3736 kl_V3736h kl_V3736t - _ -> pat_cond_6 - case kl_if_2 of - Atom (B (True)) -> do !appl_7 <- kl_V3736 `pseq` tl kl_V3736 - !appl_8 <- kl_V3737 `pseq` tl kl_V3737 - appl_7 `pseq` (appl_8 `pseq` kl_shen_prefixP appl_7 appl_8) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - in case kl_V3736 of - kl_V3736@(Atom (Nil)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_print_past_inputs :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_print_past_inputs (!kl_V3749) (!kl_V3750) (!kl_V3751) = do let pat_cond_0 = do return (Types.Atom (Types.UnboundSym "_")) - pat_cond_1 = do !kl_if_2 <- let pat_cond_3 kl_V3750 kl_V3750h kl_V3750t = do !appl_4 <- kl_V3750h `pseq` applyWrapper kl_V3749 [kl_V3750h] - let !aw_5 = Types.Atom (Types.UnboundSym "not") - !kl_if_6 <- appl_4 `pseq` applyWrapper aw_5 [appl_4] - 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_7 = do do return (Atom (B False)) - in case kl_V3750 of - !(kl_V3750@(Cons (!kl_V3750h) - (!kl_V3750t))) -> pat_cond_3 kl_V3750 kl_V3750h kl_V3750t - _ -> pat_cond_7 - case kl_if_2 of - Atom (B (True)) -> do !appl_8 <- kl_V3750 `pseq` tl kl_V3750 - !appl_9 <- kl_V3751 `pseq` add kl_V3751 (Types.Atom (Types.N (Types.KI 1))) - kl_V3749 `pseq` (appl_8 `pseq` (appl_9 `pseq` kl_shen_print_past_inputs kl_V3749 appl_8 appl_9)) - Atom (B (False)) -> do !kl_if_10 <- let pat_cond_11 kl_V3750 kl_V3750h kl_V3750t = do let !aw_12 = Types.Atom (Types.UnboundSym "tuple?") - !kl_if_13 <- kl_V3750h `pseq` applyWrapper aw_12 [kl_V3750h] - 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_V3750 of - !(kl_V3750@(Cons (!kl_V3750h) - (!kl_V3750t))) -> pat_cond_11 kl_V3750 kl_V3750h kl_V3750t - _ -> pat_cond_14 - case kl_if_10 of - Atom (B (True)) -> do let !aw_15 = Types.Atom (Types.UnboundSym "shen.app") - !appl_16 <- kl_V3751 `pseq` applyWrapper aw_15 [kl_V3751, - Types.Atom (Types.Str ". "), - Types.Atom (Types.UnboundSym "shen.a")] - let !aw_17 = Types.Atom (Types.UnboundSym "stoutput") - !appl_18 <- applyWrapper aw_17 [] - let !aw_19 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_20 <- appl_16 `pseq` (appl_18 `pseq` applyWrapper aw_19 [appl_16, - appl_18]) - !appl_21 <- kl_V3750 `pseq` hd kl_V3750 - let !aw_22 = Types.Atom (Types.UnboundSym "snd") - !appl_23 <- appl_21 `pseq` applyWrapper aw_22 [appl_21] - !appl_24 <- appl_23 `pseq` kl_shen_prbytes appl_23 - !appl_25 <- kl_V3750 `pseq` tl kl_V3750 - !appl_26 <- kl_V3751 `pseq` add kl_V3751 (Types.Atom (Types.N (Types.KI 1))) - !appl_27 <- kl_V3749 `pseq` (appl_25 `pseq` (appl_26 `pseq` kl_shen_print_past_inputs kl_V3749 appl_25 appl_26)) - let !aw_28 = Types.Atom (Types.UnboundSym "do") - !appl_29 <- appl_24 `pseq` (appl_27 `pseq` applyWrapper aw_28 [appl_24, - appl_27]) - let !aw_30 = Types.Atom (Types.UnboundSym "do") - appl_20 `pseq` (appl_29 `pseq` applyWrapper aw_30 [appl_20, - appl_29]) - Atom (B (False)) -> do do let !aw_31 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_31 [ApplC (wrapNamed "shen.print-past-inputs" kl_shen_print_past_inputs)] - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - in case kl_V3750 of - kl_V3750@(Atom (Nil)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_toplevel_evaluate :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_toplevel_evaluate (!kl_V3754) (!kl_V3755) = do !kl_if_0 <- let pat_cond_1 kl_V3754 kl_V3754h kl_V3754t = do !kl_if_2 <- let pat_cond_3 kl_V3754t kl_V3754th kl_V3754tt = do !kl_if_4 <- let pat_cond_5 = do !kl_if_6 <- let pat_cond_7 kl_V3754tt kl_V3754tth kl_V3754ttt = do !kl_if_8 <- let pat_cond_9 = do let pat_cond_10 = do return (Atom (B True)) - pat_cond_11 = do do return (Atom (B False)) - in case kl_V3755 of - kl_V3755@(Atom (UnboundSym "true")) -> pat_cond_10 - kl_V3755@(Atom (B (True))) -> pat_cond_10 - _ -> pat_cond_11 - pat_cond_12 = do do return (Atom (B False)) - in case kl_V3754ttt of - kl_V3754ttt@(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_V3754tt of - !(kl_V3754tt@(Cons (!kl_V3754tth) - (!kl_V3754ttt))) -> pat_cond_7 kl_V3754tt kl_V3754tth kl_V3754ttt - _ -> 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_V3754th of - kl_V3754th@(Atom (UnboundSym ":")) -> pat_cond_5 - kl_V3754th@(ApplC (PL ":" - _)) -> pat_cond_5 - kl_V3754th@(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_V3754t of - !(kl_V3754t@(Cons (!kl_V3754th) - (!kl_V3754tt))) -> pat_cond_3 kl_V3754t kl_V3754th kl_V3754tt - _ -> 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_V3754 of - !(kl_V3754@(Cons (!kl_V3754h) - (!kl_V3754t))) -> pat_cond_1 kl_V3754 kl_V3754h kl_V3754t - _ -> pat_cond_16 - case kl_if_0 of - Atom (B (True)) -> do !appl_17 <- kl_V3754 `pseq` hd kl_V3754 - !appl_18 <- kl_V3754 `pseq` tl kl_V3754 - !appl_19 <- appl_18 `pseq` tl appl_18 - !appl_20 <- appl_19 `pseq` hd appl_19 - appl_17 `pseq` (appl_20 `pseq` kl_shen_typecheck_and_evaluate appl_17 appl_20) - Atom (B (False)) -> do let pat_cond_21 kl_V3754 kl_V3754h kl_V3754t kl_V3754th kl_V3754tt = do !appl_22 <- kl_V3754h `pseq` klCons kl_V3754h (Types.Atom Types.Nil) - !appl_23 <- appl_22 `pseq` (kl_V3755 `pseq` kl_shen_toplevel_evaluate appl_22 kl_V3755) - let !aw_24 = Types.Atom (Types.UnboundSym "nl") - !appl_25 <- applyWrapper aw_24 [Types.Atom (Types.N (Types.KI 1))] - !appl_26 <- kl_V3754t `pseq` (kl_V3755 `pseq` kl_shen_toplevel_evaluate kl_V3754t kl_V3755) - let !aw_27 = Types.Atom (Types.UnboundSym "do") - !appl_28 <- appl_25 `pseq` (appl_26 `pseq` applyWrapper aw_27 [appl_25, - appl_26]) - let !aw_29 = Types.Atom (Types.UnboundSym "do") - appl_23 `pseq` (appl_28 `pseq` applyWrapper aw_29 [appl_23, - appl_28]) - pat_cond_30 = do !kl_if_31 <- let pat_cond_32 kl_V3754 kl_V3754h kl_V3754t = do !kl_if_33 <- let pat_cond_34 = do let pat_cond_35 = do return (Atom (B True)) - pat_cond_36 = do do return (Atom (B False)) - in case kl_V3755 of - kl_V3755@(Atom (UnboundSym "true")) -> pat_cond_35 - kl_V3755@(Atom (B (True))) -> pat_cond_35 - _ -> pat_cond_36 - pat_cond_37 = do do return (Atom (B False)) - in case kl_V3754t of - kl_V3754t@(Atom (Nil)) -> pat_cond_34 - _ -> pat_cond_37 - case kl_if_33 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_38 = do do return (Atom (B False)) - in case kl_V3754 of - !(kl_V3754@(Cons (!kl_V3754h) - (!kl_V3754t))) -> pat_cond_32 kl_V3754 kl_V3754h kl_V3754t - _ -> pat_cond_38 - case kl_if_31 of - Atom (B (True)) -> do !appl_39 <- kl_V3754 `pseq` hd kl_V3754 - let !aw_40 = Types.Atom (Types.UnboundSym "gensym") - !appl_41 <- applyWrapper aw_40 [Types.Atom (Types.UnboundSym "A")] - appl_39 `pseq` (appl_41 `pseq` kl_shen_typecheck_and_evaluate appl_39 appl_41) - Atom (B (False)) -> do !kl_if_42 <- let pat_cond_43 kl_V3754 kl_V3754h kl_V3754t = do !kl_if_44 <- let pat_cond_45 = do let pat_cond_46 = do return (Atom (B True)) - pat_cond_47 = do do return (Atom (B False)) - in case kl_V3755 of - kl_V3755@(Atom (UnboundSym "false")) -> pat_cond_46 - kl_V3755@(Atom (B (False))) -> pat_cond_46 - _ -> pat_cond_47 - pat_cond_48 = do do return (Atom (B False)) - in case kl_V3754t of - kl_V3754t@(Atom (Nil)) -> pat_cond_45 - _ -> pat_cond_48 - case kl_if_44 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_49 = do do return (Atom (B False)) - in case kl_V3754 of - !(kl_V3754@(Cons (!kl_V3754h) - (!kl_V3754t))) -> pat_cond_43 kl_V3754 kl_V3754h kl_V3754t - _ -> pat_cond_49 - case kl_if_42 of - Atom (B (True)) -> do let !appl_50 = ApplC (Func "lambda" (Context (\(!kl_Eval) -> do let !aw_51 = Types.Atom (Types.UnboundSym "print") - kl_Eval `pseq` applyWrapper aw_51 [kl_Eval]))) - !appl_52 <- kl_V3754 `pseq` hd kl_V3754 - let !aw_53 = Types.Atom (Types.UnboundSym "shen.eval-without-macros") - !appl_54 <- appl_52 `pseq` applyWrapper aw_53 [appl_52] - appl_54 `pseq` applyWrapper appl_50 [appl_54] - Atom (B (False)) -> do do let !aw_55 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_55 [ApplC (wrapNamed "shen.toplevel_evaluate" kl_shen_toplevel_evaluate)] - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - in case kl_V3754 of - !(kl_V3754@(Cons (!kl_V3754h) - (!(kl_V3754t@(Cons (!kl_V3754th) - (!kl_V3754tt)))))) -> pat_cond_21 kl_V3754 kl_V3754h kl_V3754t kl_V3754th kl_V3754tt - _ -> pat_cond_30 - _ -> throwError "if: expected boolean" - -kl_shen_typecheck_and_evaluate :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_typecheck_and_evaluate (!kl_V3758) (!kl_V3759) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Typecheck) -> do let pat_cond_1 = do simpleError (Types.Atom (Types.Str "type error\n")) - pat_cond_2 = do do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Eval) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Type) -> do let !aw_5 = Types.Atom (Types.UnboundSym "shen.app") - !appl_6 <- kl_Type `pseq` applyWrapper aw_5 [kl_Type, - Types.Atom (Types.Str ""), - Types.Atom (Types.UnboundSym "shen.r")] - !appl_7 <- appl_6 `pseq` cn (Types.Atom (Types.Str " : ")) appl_6 - let !aw_8 = Types.Atom (Types.UnboundSym "shen.app") - !appl_9 <- kl_Eval `pseq` (appl_7 `pseq` applyWrapper aw_8 [kl_Eval, - appl_7, - Types.Atom (Types.UnboundSym "shen.s")]) - let !aw_10 = Types.Atom (Types.UnboundSym "stoutput") - !appl_11 <- applyWrapper aw_10 [] - let !aw_12 = Types.Atom (Types.UnboundSym "shen.prhush") - appl_9 `pseq` (appl_11 `pseq` applyWrapper aw_12 [appl_9, - appl_11])))) - !appl_13 <- kl_Typecheck `pseq` kl_shen_pretty_type kl_Typecheck - appl_13 `pseq` applyWrapper appl_4 [appl_13]))) - let !aw_14 = Types.Atom (Types.UnboundSym "shen.eval-without-macros") - !appl_15 <- kl_V3758 `pseq` applyWrapper aw_14 [kl_V3758] - appl_15 `pseq` applyWrapper appl_3 [appl_15] - in case kl_Typecheck of - kl_Typecheck@(Atom (UnboundSym "false")) -> pat_cond_1 - kl_Typecheck@(Atom (B (False))) -> pat_cond_1 - _ -> pat_cond_2))) - let !aw_16 = Types.Atom (Types.UnboundSym "shen.typecheck") - !appl_17 <- kl_V3758 `pseq` (kl_V3759 `pseq` applyWrapper aw_16 [kl_V3758, - kl_V3759]) - appl_17 `pseq` applyWrapper appl_0 [appl_17] - -kl_shen_pretty_type :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_pretty_type (!kl_V3761) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*alphabet*")) - !appl_1 <- kl_V3761 `pseq` kl_shen_extract_pvars kl_V3761 - appl_0 `pseq` (appl_1 `pseq` (kl_V3761 `pseq` kl_shen_mult_subst appl_0 appl_1 kl_V3761)) - -kl_shen_extract_pvars :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_extract_pvars (!kl_V3767) = do let !aw_0 = Types.Atom (Types.UnboundSym "shen.pvar?") - !kl_if_1 <- kl_V3767 `pseq` applyWrapper aw_0 [kl_V3767] - case kl_if_1 of - Atom (B (True)) -> do kl_V3767 `pseq` klCons kl_V3767 (Types.Atom Types.Nil) - Atom (B (False)) -> do let pat_cond_2 kl_V3767 kl_V3767h kl_V3767t = do !appl_3 <- kl_V3767h `pseq` kl_shen_extract_pvars kl_V3767h - !appl_4 <- kl_V3767t `pseq` kl_shen_extract_pvars kl_V3767t - 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_V3767 of - !(kl_V3767@(Cons (!kl_V3767h) - (!kl_V3767t))) -> pat_cond_2 kl_V3767 kl_V3767h kl_V3767t - _ -> pat_cond_6 - _ -> throwError "if: expected boolean" - -kl_shen_mult_subst :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_mult_subst (!kl_V3775) (!kl_V3776) (!kl_V3777) = do let pat_cond_0 = do return kl_V3777 - pat_cond_1 = do let pat_cond_2 = do return kl_V3777 - pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V3775 kl_V3775h kl_V3775t = do let pat_cond_6 kl_V3776 kl_V3776h kl_V3776t = do return (Atom (B True)) - pat_cond_7 = do do return (Atom (B False)) - in case kl_V3776 of - !(kl_V3776@(Cons (!kl_V3776h) - (!kl_V3776t))) -> pat_cond_6 kl_V3776 kl_V3776h kl_V3776t - _ -> pat_cond_7 - pat_cond_8 = do do return (Atom (B False)) - in case kl_V3775 of - !(kl_V3775@(Cons (!kl_V3775h) - (!kl_V3775t))) -> pat_cond_5 kl_V3775 kl_V3775h kl_V3775t - _ -> pat_cond_8 - case kl_if_4 of - Atom (B (True)) -> do !appl_9 <- kl_V3775 `pseq` tl kl_V3775 - !appl_10 <- kl_V3776 `pseq` tl kl_V3776 - !appl_11 <- kl_V3775 `pseq` hd kl_V3775 - !appl_12 <- kl_V3776 `pseq` hd kl_V3776 - let !aw_13 = Types.Atom (Types.UnboundSym "subst") - !appl_14 <- appl_11 `pseq` (appl_12 `pseq` (kl_V3777 `pseq` applyWrapper aw_13 [appl_11, - appl_12, - kl_V3777])) - appl_9 `pseq` (appl_10 `pseq` (appl_14 `pseq` kl_shen_mult_subst appl_9 appl_10 appl_14)) - Atom (B (False)) -> do do let !aw_15 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_15 [ApplC (wrapNamed "shen.mult_subst" kl_shen_mult_subst)] - _ -> throwError "if: expected boolean" - in case kl_V3776 of - kl_V3776@(Atom (Nil)) -> pat_cond_2 - _ -> pat_cond_3 - in case kl_V3775 of - kl_V3775@(Atom (Nil)) -> pat_cond_0 - _ -> pat_cond_1 - -expr0 :: Types.KLContext Types.Env Types.KLValue -expr0 = 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"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*history*")) (Types.Atom Types.Nil)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Toplevel where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap + +{- +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 :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_shen = do !appl_0 <- kl_shen_credits + !appl_1 <- kl_shen_loop + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_0 `pseq` (appl_1 `pseq` applyWrapper aw_2 [appl_0, appl_1]) + +kl_exit :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_exit (!kl_V3800) = do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*continue-repl-loop*")) (Atom (B False)) + +kl_shen_loop :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_loop = do !appl_0 <- kl_shen_initialise_environment + !appl_1 <- kl_shen_prompt + !appl_2 <- (do kl_shen_read_evaluate_print) `catchError` (\(!kl_E) -> do !appl_3 <- kl_E `pseq` errorToString (Excep kl_E) + let !aw_4 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_5 <- applyWrapper aw_4 [] + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "pr") + appl_3 `pseq` (appl_5 `pseq` applyWrapper aw_6 [appl_3, + appl_5])) + !kl_if_7 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*continue-repl-loop*")) + !appl_8 <- case kl_if_7 of + Atom (B (True)) -> do kl_shen_loop + Atom (B (False)) -> do do return (ApplC (wrapNamed "exit" kl_exit)) + _ -> throwError "if: expected boolean" + let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "do") + !appl_10 <- appl_2 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_2, + appl_8]) + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "do") + !appl_12 <- appl_1 `pseq` (appl_10 `pseq` applyWrapper aw_11 [appl_1, + appl_10]) + let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_0 `pseq` (appl_12 `pseq` applyWrapper aw_13 [appl_0, appl_12]) + +kl_shen_credits :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_credits = do let !aw_0 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_1 <- applyWrapper aw_0 [] + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_3 <- appl_1 `pseq` applyWrapper aw_2 [Core.Types.Atom (Core.Types.Str "\nShen, copyright (C) 2010-2015 Mark Tarver\n"), + appl_1] + !appl_4 <- value (Core.Types.Atom (Core.Types.UnboundSym "*version*")) + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_6 <- appl_4 `pseq` applyWrapper aw_5 [appl_4, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_7 <- appl_6 `pseq` cn (Core.Types.Atom (Core.Types.Str "www.shenlanguage.org, ")) appl_6 + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_9 <- applyWrapper aw_8 [] + let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_11 <- appl_7 `pseq` (appl_9 `pseq` applyWrapper aw_10 [appl_7, + appl_9]) + !appl_12 <- value (Core.Types.Atom (Core.Types.UnboundSym "*language*")) + !appl_13 <- value (Core.Types.Atom (Core.Types.UnboundSym "*implementation*")) + let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_15 <- appl_13 `pseq` applyWrapper aw_14 [appl_13, + Core.Types.Atom (Core.Types.Str ""), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_16 <- appl_15 `pseq` cn (Core.Types.Atom (Core.Types.Str ", implementation: ")) appl_15 + let !aw_17 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_18 <- appl_12 `pseq` (appl_16 `pseq` applyWrapper aw_17 [appl_12, + appl_16, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_19 <- appl_18 `pseq` cn (Core.Types.Atom (Core.Types.Str "running under ")) appl_18 + let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_21 <- applyWrapper aw_20 [] + let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_23 <- appl_19 `pseq` (appl_21 `pseq` applyWrapper aw_22 [appl_19, + appl_21]) + !appl_24 <- value (Core.Types.Atom (Core.Types.UnboundSym "*port*")) + !appl_25 <- value (Core.Types.Atom (Core.Types.UnboundSym "*porters*")) + let !aw_26 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_27 <- appl_25 `pseq` applyWrapper aw_26 [appl_25, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_28 <- appl_27 `pseq` cn (Core.Types.Atom (Core.Types.Str " ported by ")) appl_27 + let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_30 <- appl_24 `pseq` (appl_28 `pseq` applyWrapper aw_29 [appl_24, + appl_28, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_31 <- appl_30 `pseq` cn (Core.Types.Atom (Core.Types.Str "\nport ")) appl_30 + let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_33 <- applyWrapper aw_32 [] + let !aw_34 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_35 <- appl_31 `pseq` (appl_33 `pseq` applyWrapper aw_34 [appl_31, + appl_33]) + let !aw_36 = Core.Types.Atom (Core.Types.UnboundSym "do") + !appl_37 <- appl_23 `pseq` (appl_35 `pseq` applyWrapper aw_36 [appl_23, + appl_35]) + let !aw_38 = Core.Types.Atom (Core.Types.UnboundSym "do") + !appl_39 <- appl_11 `pseq` (appl_37 `pseq` applyWrapper aw_38 [appl_11, + appl_37]) + let !aw_40 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_3 `pseq` (appl_39 `pseq` applyWrapper aw_40 [appl_3, appl_39]) + +kl_shen_initialise_environment :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_initialise_environment = do let !appl_0 = Atom Nil + !appl_1 <- appl_0 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_0 + !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.*catch*")) appl_1 + !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_2 + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.*process-counter*")) appl_3 + !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_4 + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.*infs*")) appl_5 + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) appl_6 + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.*call*")) appl_7 + appl_8 `pseq` kl_shen_multiple_set appl_8 + +kl_shen_multiple_set :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_multiple_set (!kl_V3802) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3802 `pseq` eq appl_0 kl_V3802) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let pat_cond_2 kl_V3802 kl_V3802h kl_V3802t kl_V3802th kl_V3802tt = do !appl_3 <- kl_V3802h `pseq` (kl_V3802th `pseq` klSet kl_V3802h kl_V3802th) + !appl_4 <- kl_V3802tt `pseq` kl_shen_multiple_set kl_V3802tt + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_3 `pseq` (appl_4 `pseq` applyWrapper aw_5 [appl_3, + appl_4]) + pat_cond_6 = do do let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_7 [ApplC (wrapNamed "shen.multiple-set" kl_shen_multiple_set)] + in case kl_V3802 of + !(kl_V3802@(Cons (!kl_V3802h) + (!(kl_V3802t@(Cons (!kl_V3802th) + (!kl_V3802tt)))))) -> pat_cond_2 kl_V3802 kl_V3802h kl_V3802t kl_V3802th kl_V3802tt + _ -> pat_cond_6 + _ -> throwError "if: expected boolean" + +kl_destroy :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_destroy (!kl_V3804) = do let !aw_0 = Core.Types.Atom (Core.Types.UnboundSym "declare") + kl_V3804 `pseq` applyWrapper aw_0 [kl_V3804, + Core.Types.Atom (Core.Types.UnboundSym "symbol")] + +kl_shen_read_evaluate_print :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_read_evaluate_print = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Lineread) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_History) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_NewLineread) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_NewHistory) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parsed) -> do kl_Parsed `pseq` kl_shen_toplevel kl_Parsed))) + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "fst") + !appl_6 <- kl_NewLineread `pseq` applyWrapper aw_5 [kl_NewLineread] + appl_6 `pseq` applyWrapper appl_4 [appl_6]))) + !appl_7 <- kl_NewLineread `pseq` (kl_History `pseq` kl_shen_update_history kl_NewLineread kl_History) + appl_7 `pseq` applyWrapper appl_3 [appl_7]))) + !appl_8 <- kl_Lineread `pseq` (kl_History `pseq` kl_shen_retrieve_from_history_if_needed kl_Lineread kl_History) + appl_8 `pseq` applyWrapper appl_2 [appl_8]))) + !appl_9 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*history*")) + appl_9 `pseq` applyWrapper appl_1 [appl_9]))) + !appl_10 <- kl_shen_toplineread + appl_10 `pseq` applyWrapper appl_0 [appl_10] + +kl_shen_retrieve_from_history_if_needed :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_retrieve_from_history_if_needed (!kl_V3816) (!kl_V3817) = do let !aw_0 = Core.Types.Atom (Core.Types.UnboundSym "tuple?") + !kl_if_1 <- kl_V3816 `pseq` applyWrapper aw_0 [kl_V3816] + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do let !aw_3 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_4 <- kl_V3816 `pseq` applyWrapper aw_3 [kl_V3816] + !kl_if_5 <- appl_4 `pseq` consP appl_4 + !kl_if_6 <- case kl_if_5 of + Atom (B (True)) -> do let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_8 <- kl_V3816 `pseq` applyWrapper aw_7 [kl_V3816] + !appl_9 <- appl_8 `pseq` hd appl_8 + !appl_10 <- kl_shen_space + !appl_11 <- kl_shen_newline + let !appl_12 = Atom Nil + !appl_13 <- appl_11 `pseq` (appl_12 `pseq` klCons appl_11 appl_12) + !appl_14 <- appl_10 `pseq` (appl_13 `pseq` klCons appl_10 appl_13) + let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "element?") + !kl_if_16 <- appl_9 `pseq` (appl_14 `pseq` applyWrapper aw_15 [appl_9, + appl_14]) + case kl_if_16 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_2 of + Atom (B (True)) -> do let !aw_17 = Core.Types.Atom (Core.Types.UnboundSym "fst") + !appl_18 <- kl_V3816 `pseq` applyWrapper aw_17 [kl_V3816] + let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_20 <- kl_V3816 `pseq` applyWrapper aw_19 [kl_V3816] + !appl_21 <- appl_20 `pseq` tl appl_20 + let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "@p") + !appl_23 <- appl_18 `pseq` (appl_21 `pseq` applyWrapper aw_22 [appl_18, + appl_21]) + appl_23 `pseq` (kl_V3817 `pseq` kl_shen_retrieve_from_history_if_needed appl_23 kl_V3817) + Atom (B (False)) -> do let !aw_24 = Core.Types.Atom (Core.Types.UnboundSym "tuple?") + !kl_if_25 <- kl_V3816 `pseq` applyWrapper aw_24 [kl_V3816] + !kl_if_26 <- case kl_if_25 of + Atom (B (True)) -> do let !aw_27 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_28 <- kl_V3816 `pseq` applyWrapper aw_27 [kl_V3816] + !kl_if_29 <- appl_28 `pseq` consP appl_28 + !kl_if_30 <- case kl_if_29 of + Atom (B (True)) -> do let !aw_31 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_32 <- kl_V3816 `pseq` applyWrapper aw_31 [kl_V3816] + !appl_33 <- appl_32 `pseq` tl appl_32 + !kl_if_34 <- appl_33 `pseq` consP appl_33 + !kl_if_35 <- case kl_if_34 of + Atom (B (True)) -> do let !appl_36 = Atom Nil + let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_38 <- kl_V3816 `pseq` applyWrapper aw_37 [kl_V3816] + !appl_39 <- appl_38 `pseq` tl appl_38 + !appl_40 <- appl_39 `pseq` tl appl_39 + !kl_if_41 <- appl_36 `pseq` (appl_40 `pseq` eq appl_36 appl_40) + !kl_if_42 <- case kl_if_41 of + Atom (B (True)) -> do !kl_if_43 <- let pat_cond_44 kl_V3817 kl_V3817h kl_V3817t = do let !aw_45 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_46 <- kl_V3816 `pseq` applyWrapper aw_45 [kl_V3816] + !appl_47 <- appl_46 `pseq` hd appl_46 + !appl_48 <- kl_shen_exclamation + !kl_if_49 <- appl_47 `pseq` (appl_48 `pseq` eq appl_47 appl_48) + !kl_if_50 <- case kl_if_49 of + Atom (B (True)) -> do let !aw_51 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_52 <- kl_V3816 `pseq` applyWrapper aw_51 [kl_V3816] + !appl_53 <- appl_52 `pseq` tl appl_52 + !appl_54 <- appl_53 `pseq` hd appl_53 + !appl_55 <- kl_shen_exclamation + !kl_if_56 <- appl_54 `pseq` (appl_55 `pseq` eq appl_54 appl_55) + case kl_if_56 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_50 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_57 = do do return (Atom (B False)) + in case kl_V3817 of + !(kl_V3817@(Cons (!kl_V3817h) + (!kl_V3817t))) -> pat_cond_44 kl_V3817 kl_V3817h kl_V3817t + _ -> pat_cond_57 + case kl_if_43 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_42 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_35 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_30 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_26 of + Atom (B (True)) -> do let !appl_58 = ApplC (Func "lambda" (Context (\(!kl_PastPrint) -> do kl_V3817 `pseq` hd kl_V3817))) + !appl_59 <- kl_V3817 `pseq` hd kl_V3817 + let !aw_60 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_61 <- appl_59 `pseq` applyWrapper aw_60 [appl_59] + !appl_62 <- appl_61 `pseq` kl_shen_prbytes appl_61 + appl_62 `pseq` applyWrapper appl_58 [appl_62] + Atom (B (False)) -> do let !aw_63 = Core.Types.Atom (Core.Types.UnboundSym "tuple?") + !kl_if_64 <- kl_V3816 `pseq` applyWrapper aw_63 [kl_V3816] + !kl_if_65 <- case kl_if_64 of + Atom (B (True)) -> do let !aw_66 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_67 <- kl_V3816 `pseq` applyWrapper aw_66 [kl_V3816] + !kl_if_68 <- appl_67 `pseq` consP appl_67 + !kl_if_69 <- case kl_if_68 of + Atom (B (True)) -> do let !aw_70 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_71 <- kl_V3816 `pseq` applyWrapper aw_70 [kl_V3816] + !appl_72 <- appl_71 `pseq` hd appl_71 + !appl_73 <- kl_shen_exclamation + !kl_if_74 <- appl_72 `pseq` (appl_73 `pseq` eq appl_72 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_69 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_65 of + Atom (B (True)) -> do let !appl_75 = ApplC (Func "lambda" (Context (\(!kl_KeyP) -> do let !appl_76 = ApplC (Func "lambda" (Context (\(!kl_Find) -> do let !appl_77 = ApplC (Func "lambda" (Context (\(!kl_PastPrint) -> do return kl_Find))) + let !aw_78 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_79 <- kl_Find `pseq` applyWrapper aw_78 [kl_Find] + !appl_80 <- appl_79 `pseq` kl_shen_prbytes appl_79 + appl_80 `pseq` applyWrapper appl_77 [appl_80]))) + !appl_81 <- kl_KeyP `pseq` (kl_V3817 `pseq` kl_shen_find_past_inputs kl_KeyP kl_V3817) + let !aw_82 = Core.Types.Atom (Core.Types.UnboundSym "head") + !appl_83 <- appl_81 `pseq` applyWrapper aw_82 [appl_81] + appl_83 `pseq` applyWrapper appl_76 [appl_83]))) + let !aw_84 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_85 <- kl_V3816 `pseq` applyWrapper aw_84 [kl_V3816] + !appl_86 <- appl_85 `pseq` tl appl_85 + !appl_87 <- appl_86 `pseq` (kl_V3817 `pseq` kl_shen_make_key appl_86 kl_V3817) + appl_87 `pseq` applyWrapper appl_75 [appl_87] + Atom (B (False)) -> do let !aw_88 = Core.Types.Atom (Core.Types.UnboundSym "tuple?") + !kl_if_89 <- kl_V3816 `pseq` applyWrapper aw_88 [kl_V3816] + !kl_if_90 <- case kl_if_89 of + Atom (B (True)) -> do let !aw_91 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_92 <- kl_V3816 `pseq` applyWrapper aw_91 [kl_V3816] + !kl_if_93 <- appl_92 `pseq` consP appl_92 + !kl_if_94 <- case kl_if_93 of + Atom (B (True)) -> do let !appl_95 = Atom Nil + let !aw_96 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_97 <- kl_V3816 `pseq` applyWrapper aw_96 [kl_V3816] + !appl_98 <- appl_97 `pseq` tl appl_97 + !kl_if_99 <- appl_95 `pseq` (appl_98 `pseq` eq appl_95 appl_98) + !kl_if_100 <- case kl_if_99 of + Atom (B (True)) -> do let !aw_101 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_102 <- kl_V3816 `pseq` applyWrapper aw_101 [kl_V3816] + !appl_103 <- appl_102 `pseq` hd appl_102 + !appl_104 <- kl_shen_percent + !kl_if_105 <- appl_103 `pseq` (appl_104 `pseq` eq appl_103 appl_104) + case kl_if_105 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 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_94 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_90 of + Atom (B (True)) -> do let !appl_106 = ApplC (Func "lambda" (Context (\(!kl_X) -> do return (Atom (B True))))) + let !aw_107 = Core.Types.Atom (Core.Types.UnboundSym "reverse") + !appl_108 <- kl_V3817 `pseq` applyWrapper aw_107 [kl_V3817] + !appl_109 <- appl_106 `pseq` (appl_108 `pseq` kl_shen_print_past_inputs appl_106 appl_108 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))) + let !aw_110 = Core.Types.Atom (Core.Types.UnboundSym "abort") + !appl_111 <- applyWrapper aw_110 [] + let !aw_112 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_109 `pseq` (appl_111 `pseq` applyWrapper aw_112 [appl_109, + appl_111]) + Atom (B (False)) -> do let !aw_113 = Core.Types.Atom (Core.Types.UnboundSym "tuple?") + !kl_if_114 <- kl_V3816 `pseq` applyWrapper aw_113 [kl_V3816] + !kl_if_115 <- case kl_if_114 of + Atom (B (True)) -> do let !aw_116 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_117 <- kl_V3816 `pseq` applyWrapper aw_116 [kl_V3816] + !kl_if_118 <- appl_117 `pseq` consP appl_117 + !kl_if_119 <- case kl_if_118 of + Atom (B (True)) -> do let !aw_120 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_121 <- kl_V3816 `pseq` applyWrapper aw_120 [kl_V3816] + !appl_122 <- appl_121 `pseq` hd appl_121 + !appl_123 <- kl_shen_percent + !kl_if_124 <- appl_122 `pseq` (appl_123 `pseq` eq appl_122 appl_123) + case kl_if_124 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_119 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_115 of + Atom (B (True)) -> do let !appl_125 = ApplC (Func "lambda" (Context (\(!kl_KeyP) -> do let !appl_126 = ApplC (Func "lambda" (Context (\(!kl_Pastprint) -> do let !aw_127 = Core.Types.Atom (Core.Types.UnboundSym "abort") + applyWrapper aw_127 []))) + let !aw_128 = Core.Types.Atom (Core.Types.UnboundSym "reverse") + !appl_129 <- kl_V3817 `pseq` applyWrapper aw_128 [kl_V3817] + !appl_130 <- kl_KeyP `pseq` (appl_129 `pseq` kl_shen_print_past_inputs kl_KeyP appl_129 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))) + appl_130 `pseq` applyWrapper appl_126 [appl_130]))) + let !aw_131 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_132 <- kl_V3816 `pseq` applyWrapper aw_131 [kl_V3816] + !appl_133 <- appl_132 `pseq` tl appl_132 + !appl_134 <- appl_133 `pseq` (kl_V3817 `pseq` kl_shen_make_key appl_133 kl_V3817) + appl_134 `pseq` applyWrapper appl_125 [appl_134] + Atom (B (False)) -> do do return kl_V3816 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_percent :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_percent = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 37))) + +kl_shen_exclamation :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_exclamation = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 33))) + +kl_shen_prbytes :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_prbytes (!kl_V3819) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Byte) -> do !appl_1 <- kl_Byte `pseq` nToString kl_Byte + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_3 <- applyWrapper aw_2 [] + let !aw_4 = Core.Types.Atom (Core.Types.UnboundSym "pr") + appl_1 `pseq` (appl_3 `pseq` applyWrapper aw_4 [appl_1, + appl_3])))) + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "for-each") + !appl_6 <- appl_0 `pseq` (kl_V3819 `pseq` applyWrapper aw_5 [appl_0, + kl_V3819]) + let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "nl") + !appl_8 <- applyWrapper aw_7 [Core.Types.Atom (Core.Types.N (Core.Types.KI 1))] + let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_6 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_6, appl_8]) + +kl_shen_update_history :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_update_history (!kl_V3822) (!kl_V3823) = do !appl_0 <- kl_V3822 `pseq` (kl_V3823 `pseq` klCons kl_V3822 kl_V3823) + appl_0 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*history*")) appl_0 + +kl_shen_toplineread :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_toplineread = do let !aw_0 = Core.Types.Atom (Core.Types.UnboundSym "stinput") + !appl_1 <- applyWrapper aw_0 [] + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "read-char-code") + !appl_3 <- appl_1 `pseq` applyWrapper aw_2 [appl_1] + let !appl_4 = Atom Nil + appl_3 `pseq` (appl_4 `pseq` kl_shen_toplineread_loop appl_3 appl_4) + +kl_shen_toplineread_loop :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_toplineread_loop (!kl_V3827) (!kl_V3828) = do !kl_if_0 <- let pat_cond_1 = do let !appl_2 = Atom Nil + !kl_if_3 <- appl_2 `pseq` (kl_V3828 `pseq` eq appl_2 kl_V3828) + case kl_if_3 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_4 = do do return (Atom (B False)) + in case kl_V3827 of + kl_V3827@(Atom (N (KI (-1)))) -> pat_cond_1 + _ -> pat_cond_4 + case kl_if_0 of + Atom (B (True)) -> do kl_exit (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + Atom (B (False)) -> do !appl_5 <- kl_shen_hat + !kl_if_6 <- kl_V3827 `pseq` (appl_5 `pseq` eq kl_V3827 appl_5) + case kl_if_6 of + Atom (B (True)) -> do simpleError (Core.Types.Atom (Core.Types.Str "line read aborted")) + Atom (B (False)) -> do !appl_7 <- kl_shen_newline + !appl_8 <- kl_shen_carriage_return + let !appl_9 = Atom Nil + !appl_10 <- appl_8 `pseq` (appl_9 `pseq` klCons appl_8 appl_9) + !appl_11 <- appl_7 `pseq` (appl_10 `pseq` klCons appl_7 appl_10) + let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "element?") + !kl_if_13 <- kl_V3827 `pseq` (appl_11 `pseq` applyWrapper aw_12 [kl_V3827, + appl_11]) + case kl_if_13 of + Atom (B (True)) -> do let !appl_14 = ApplC (Func "lambda" (Context (\(!kl_Line) -> do let !appl_15 = ApplC (Func "lambda" (Context (\(!kl_It) -> do !kl_if_16 <- let pat_cond_17 = do return (Atom (B True)) + pat_cond_18 = do do let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "empty?") + !kl_if_20 <- kl_Line `pseq` applyWrapper aw_19 [kl_Line] + case kl_if_20 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + in case kl_Line of + kl_Line@(Atom (UnboundSym "shen.nextline")) -> pat_cond_17 + kl_Line@(ApplC (PL "shen.nextline" + _)) -> pat_cond_17 + kl_Line@(ApplC (Func "shen.nextline" + _)) -> pat_cond_17 + _ -> pat_cond_18 + case kl_if_16 of + Atom (B (True)) -> do let !aw_21 = Core.Types.Atom (Core.Types.UnboundSym "stinput") + !appl_22 <- applyWrapper aw_21 [] + let !aw_23 = Core.Types.Atom (Core.Types.UnboundSym "read-char-code") + !appl_24 <- appl_22 `pseq` applyWrapper aw_23 [appl_22] + let !appl_25 = Atom Nil + !appl_26 <- kl_V3827 `pseq` (appl_25 `pseq` klCons kl_V3827 appl_25) + let !aw_27 = Core.Types.Atom (Core.Types.UnboundSym "append") + !appl_28 <- kl_V3828 `pseq` (appl_26 `pseq` applyWrapper aw_27 [kl_V3828, + appl_26]) + appl_24 `pseq` (appl_28 `pseq` kl_shen_toplineread_loop appl_24 appl_28) + Atom (B (False)) -> do do let !aw_29 = Core.Types.Atom (Core.Types.UnboundSym "@p") + kl_Line `pseq` (kl_V3828 `pseq` applyWrapper aw_29 [kl_Line, + kl_V3828]) + _ -> throwError "if: expected boolean"))) + let !aw_30 = Core.Types.Atom (Core.Types.UnboundSym "shen.record-it") + !appl_31 <- kl_V3828 `pseq` applyWrapper aw_30 [kl_V3828] + appl_31 `pseq` applyWrapper appl_15 [appl_31]))) + let !appl_32 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_33 = Core.Types.Atom (Core.Types.UnboundSym "shen.") + kl_X `pseq` applyWrapper aw_33 [kl_X]))) + let !appl_34 = ApplC (Func "lambda" (Context (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.nextline"))))) + let !aw_35 = Core.Types.Atom (Core.Types.UnboundSym "compile") + !appl_36 <- appl_32 `pseq` (kl_V3828 `pseq` (appl_34 `pseq` applyWrapper aw_35 [appl_32, + kl_V3828, + appl_34])) + appl_36 `pseq` applyWrapper appl_14 [appl_36] + Atom (B (False)) -> do do let !aw_37 = Core.Types.Atom (Core.Types.UnboundSym "stinput") + !appl_38 <- applyWrapper aw_37 [] + let !aw_39 = Core.Types.Atom (Core.Types.UnboundSym "read-char-code") + !appl_40 <- appl_38 `pseq` applyWrapper aw_39 [appl_38] + !appl_41 <- let pat_cond_42 = do return kl_V3828 + pat_cond_43 = do do let !appl_44 = Atom Nil + !appl_45 <- kl_V3827 `pseq` (appl_44 `pseq` klCons kl_V3827 appl_44) + let !aw_46 = Core.Types.Atom (Core.Types.UnboundSym "append") + kl_V3828 `pseq` (appl_45 `pseq` applyWrapper aw_46 [kl_V3828, + appl_45]) + in case kl_V3827 of + kl_V3827@(Atom (N (KI (-1)))) -> pat_cond_42 + _ -> pat_cond_43 + appl_40 `pseq` (appl_41 `pseq` kl_shen_toplineread_loop appl_40 appl_41) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_hat :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_hat = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 94))) + +kl_shen_newline :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_newline = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 10))) + +kl_shen_carriage_return :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_carriage_return = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 13))) + +kl_tc :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_tc (!kl_V3834) = do let pat_cond_0 = do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*tc*")) (Atom (B True)) + pat_cond_1 = do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*tc*")) (Atom (B False)) + pat_cond_2 = do do simpleError (Core.Types.Atom (Core.Types.Str "tc expects a + or -")) + in case kl_V3834 of + kl_V3834@(Atom (UnboundSym "+")) -> pat_cond_0 + kl_V3834@(ApplC (PL "+" _)) -> pat_cond_0 + kl_V3834@(ApplC (Func "+" _)) -> pat_cond_0 + kl_V3834@(Atom (UnboundSym "-")) -> pat_cond_1 + kl_V3834@(ApplC (PL "-" _)) -> pat_cond_1 + kl_V3834@(ApplC (Func "-" _)) -> pat_cond_1 + _ -> pat_cond_2 + +kl_shen_prompt :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_prompt = do !kl_if_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*tc*")) + case kl_if_0 of + Atom (B (True)) -> do !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*history*")) + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "length") + !appl_3 <- appl_1 `pseq` applyWrapper aw_2 [appl_1] + let !aw_4 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_5 <- appl_3 `pseq` applyWrapper aw_4 [appl_3, + Core.Types.Atom (Core.Types.Str "+) "), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_6 <- appl_5 `pseq` cn (Core.Types.Atom (Core.Types.Str "\n\n(")) appl_5 + let !aw_7 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_8 <- applyWrapper aw_7 [] + let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + appl_6 `pseq` (appl_8 `pseq` applyWrapper aw_9 [appl_6, + appl_8]) + Atom (B (False)) -> do do !appl_10 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*history*")) + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "length") + !appl_12 <- appl_10 `pseq` applyWrapper aw_11 [appl_10] + let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_14 <- appl_12 `pseq` applyWrapper aw_13 [appl_12, + Core.Types.Atom (Core.Types.Str "-) "), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_15 <- appl_14 `pseq` cn (Core.Types.Atom (Core.Types.Str "\n\n(")) appl_14 + let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_17 <- applyWrapper aw_16 [] + let !aw_18 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + appl_15 `pseq` (appl_17 `pseq` applyWrapper aw_18 [appl_15, + appl_17]) + _ -> throwError "if: expected boolean" + +kl_shen_toplevel :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_toplevel (!kl_V3836) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*tc*")) + kl_V3836 `pseq` (appl_0 `pseq` kl_shen_toplevel_evaluate kl_V3836 appl_0) + +kl_shen_find_past_inputs :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_find_past_inputs (!kl_V3839) (!kl_V3840) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_F) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "empty?") + !kl_if_2 <- kl_F `pseq` applyWrapper aw_1 [kl_F] + case kl_if_2 of + Atom (B (True)) -> do simpleError (Core.Types.Atom (Core.Types.Str "input not found\n")) + Atom (B (False)) -> do do return kl_F + _ -> throwError "if: expected boolean"))) + !appl_3 <- kl_V3839 `pseq` (kl_V3840 `pseq` kl_shen_find kl_V3839 kl_V3840) + appl_3 `pseq` applyWrapper appl_0 [appl_3] + +kl_shen_make_key :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_make_key (!kl_V3843) (!kl_V3844) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Atom) -> do let !aw_1 = Core.Types.Atom (Core.Types.UnboundSym "integer?") + !kl_if_2 <- kl_Atom `pseq` applyWrapper aw_1 [kl_Atom] + case kl_if_2 of + Atom (B (True)) -> do return (ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_3 <- kl_Atom `pseq` add kl_Atom (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + let !aw_4 = Core.Types.Atom (Core.Types.UnboundSym "reverse") + !appl_5 <- kl_V3844 `pseq` applyWrapper aw_4 [kl_V3844] + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "nth") + !appl_7 <- appl_3 `pseq` (appl_5 `pseq` applyWrapper aw_6 [appl_3, + appl_5]) + kl_X `pseq` (appl_7 `pseq` eq kl_X appl_7))))) + Atom (B (False)) -> do do return (ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_9 <- kl_X `pseq` applyWrapper aw_8 [kl_X] + !appl_10 <- appl_9 `pseq` kl_shen_trim_gubbins appl_9 + kl_V3843 `pseq` (appl_10 `pseq` kl_shen_prefixP kl_V3843 appl_10))))) + _ -> throwError "if: expected boolean"))) + let !appl_11 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.") + kl_X `pseq` applyWrapper aw_12 [kl_X]))) + let !appl_13 = ApplC (Func "lambda" (Context (\(!kl_E) -> do let pat_cond_14 kl_E kl_Eh kl_Et = do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_16 <- kl_E `pseq` applyWrapper aw_15 [kl_E, + Core.Types.Atom (Core.Types.Str "\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.s")] + !appl_17 <- appl_16 `pseq` cn (Core.Types.Atom (Core.Types.Str "parse error here: ")) appl_16 + appl_17 `pseq` simpleError appl_17 + pat_cond_18 = do do simpleError (Core.Types.Atom (Core.Types.Str "parse error\n")) + in case kl_E of + !(kl_E@(Cons (!kl_Eh) + (!kl_Et))) -> pat_cond_14 kl_E kl_Eh kl_Et + _ -> pat_cond_18))) + let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "compile") + !appl_20 <- appl_11 `pseq` (kl_V3843 `pseq` (appl_13 `pseq` applyWrapper aw_19 [appl_11, + kl_V3843, + appl_13])) + !appl_21 <- appl_20 `pseq` hd appl_20 + appl_21 `pseq` applyWrapper appl_0 [appl_21] + +kl_shen_trim_gubbins :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_trim_gubbins (!kl_V3846) = do !kl_if_0 <- let pat_cond_1 kl_V3846 kl_V3846h kl_V3846t = do !appl_2 <- kl_shen_space + !kl_if_3 <- kl_V3846h `pseq` (appl_2 `pseq` eq kl_V3846h appl_2) + case kl_if_3 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_4 = do do return (Atom (B False)) + in case kl_V3846 of + !(kl_V3846@(Cons (!kl_V3846h) + (!kl_V3846t))) -> pat_cond_1 kl_V3846 kl_V3846h kl_V3846t + _ -> pat_cond_4 + case kl_if_0 of + Atom (B (True)) -> do !appl_5 <- kl_V3846 `pseq` tl kl_V3846 + appl_5 `pseq` kl_shen_trim_gubbins appl_5 + Atom (B (False)) -> do !kl_if_6 <- let pat_cond_7 kl_V3846 kl_V3846h kl_V3846t = do !appl_8 <- kl_shen_newline + !kl_if_9 <- kl_V3846h `pseq` (appl_8 `pseq` eq kl_V3846h appl_8) + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_10 = do do return (Atom (B False)) + in case kl_V3846 of + !(kl_V3846@(Cons (!kl_V3846h) + (!kl_V3846t))) -> pat_cond_7 kl_V3846 kl_V3846h kl_V3846t + _ -> pat_cond_10 + case kl_if_6 of + Atom (B (True)) -> do !appl_11 <- kl_V3846 `pseq` tl kl_V3846 + appl_11 `pseq` kl_shen_trim_gubbins appl_11 + Atom (B (False)) -> do !kl_if_12 <- let pat_cond_13 kl_V3846 kl_V3846h kl_V3846t = do !appl_14 <- kl_shen_carriage_return + !kl_if_15 <- kl_V3846h `pseq` (appl_14 `pseq` eq kl_V3846h appl_14) + 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" + pat_cond_16 = do do return (Atom (B False)) + in case kl_V3846 of + !(kl_V3846@(Cons (!kl_V3846h) + (!kl_V3846t))) -> pat_cond_13 kl_V3846 kl_V3846h kl_V3846t + _ -> pat_cond_16 + case kl_if_12 of + Atom (B (True)) -> do !appl_17 <- kl_V3846 `pseq` tl kl_V3846 + appl_17 `pseq` kl_shen_trim_gubbins appl_17 + Atom (B (False)) -> do !kl_if_18 <- let pat_cond_19 kl_V3846 kl_V3846h kl_V3846t = do !appl_20 <- kl_shen_tab + !kl_if_21 <- kl_V3846h `pseq` (appl_20 `pseq` eq kl_V3846h appl_20) + 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_22 = do do return (Atom (B False)) + in case kl_V3846 of + !(kl_V3846@(Cons (!kl_V3846h) + (!kl_V3846t))) -> pat_cond_19 kl_V3846 kl_V3846h kl_V3846t + _ -> pat_cond_22 + case kl_if_18 of + Atom (B (True)) -> do !appl_23 <- kl_V3846 `pseq` tl kl_V3846 + appl_23 `pseq` kl_shen_trim_gubbins appl_23 + Atom (B (False)) -> do !kl_if_24 <- let pat_cond_25 kl_V3846 kl_V3846h kl_V3846t = do !appl_26 <- kl_shen_left_round + !kl_if_27 <- kl_V3846h `pseq` (appl_26 `pseq` eq kl_V3846h appl_26) + 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_28 = do do return (Atom (B False)) + in case kl_V3846 of + !(kl_V3846@(Cons (!kl_V3846h) + (!kl_V3846t))) -> pat_cond_25 kl_V3846 kl_V3846h kl_V3846t + _ -> pat_cond_28 + case kl_if_24 of + Atom (B (True)) -> do !appl_29 <- kl_V3846 `pseq` tl kl_V3846 + appl_29 `pseq` kl_shen_trim_gubbins appl_29 + Atom (B (False)) -> do do return kl_V3846 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_space :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_space = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 32))) + +kl_shen_tab :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_tab = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 9))) + +kl_shen_left_round :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_left_round = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 40))) + +kl_shen_find :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_find (!kl_V3855) (!kl_V3856) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3856 `pseq` eq appl_0 kl_V3856) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V3856 kl_V3856h kl_V3856t = do !kl_if_4 <- kl_V3856h `pseq` applyWrapper kl_V3855 [kl_V3856h] + 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_5 = do do return (Atom (B False)) + in case kl_V3856 of + !(kl_V3856@(Cons (!kl_V3856h) + (!kl_V3856t))) -> pat_cond_3 kl_V3856 kl_V3856h kl_V3856t + _ -> pat_cond_5 + case kl_if_2 of + Atom (B (True)) -> do !appl_6 <- kl_V3856 `pseq` hd kl_V3856 + !appl_7 <- kl_V3856 `pseq` tl kl_V3856 + !appl_8 <- kl_V3855 `pseq` (appl_7 `pseq` kl_shen_find kl_V3855 appl_7) + appl_6 `pseq` (appl_8 `pseq` klCons appl_6 appl_8) + Atom (B (False)) -> do let pat_cond_9 kl_V3856 kl_V3856h kl_V3856t = do kl_V3855 `pseq` (kl_V3856t `pseq` kl_shen_find kl_V3855 kl_V3856t) + pat_cond_10 = do do let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_11 [ApplC (wrapNamed "shen.find" kl_shen_find)] + in case kl_V3856 of + !(kl_V3856@(Cons (!kl_V3856h) + (!kl_V3856t))) -> pat_cond_9 kl_V3856 kl_V3856h kl_V3856t + _ -> pat_cond_10 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_prefixP :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_prefixP (!kl_V3870) (!kl_V3871) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3870 `pseq` eq appl_0 kl_V3870) + case kl_if_1 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V3870 kl_V3870h kl_V3870t = do let pat_cond_4 kl_V3871 kl_V3871h kl_V3871t = do return (Atom (B True)) + pat_cond_5 = do do return (Atom (B False)) + in case kl_V3871 of + !(kl_V3871@(Cons (!kl_V3871h) + (!kl_V3871t))) | eqCore kl_V3871h kl_V3870h -> pat_cond_4 kl_V3871 kl_V3871h kl_V3871t + _ -> pat_cond_5 + pat_cond_6 = do do return (Atom (B False)) + in case kl_V3870 of + !(kl_V3870@(Cons (!kl_V3870h) + (!kl_V3870t))) -> pat_cond_3 kl_V3870 kl_V3870h kl_V3870t + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do !appl_7 <- kl_V3870 `pseq` tl kl_V3870 + !appl_8 <- kl_V3871 `pseq` tl kl_V3871 + appl_7 `pseq` (appl_8 `pseq` kl_shen_prefixP appl_7 appl_8) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_print_past_inputs :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_print_past_inputs (!kl_V3883) (!kl_V3884) (!kl_V3885) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3884 `pseq` eq appl_0 kl_V3884) + case kl_if_1 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "_")) + Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V3884 kl_V3884h kl_V3884t = do !appl_4 <- kl_V3884h `pseq` applyWrapper kl_V3883 [kl_V3884h] + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "not") + !kl_if_6 <- appl_4 `pseq` applyWrapper aw_5 [appl_4] + 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_7 = do do return (Atom (B False)) + in case kl_V3884 of + !(kl_V3884@(Cons (!kl_V3884h) + (!kl_V3884t))) -> pat_cond_3 kl_V3884 kl_V3884h kl_V3884t + _ -> pat_cond_7 + case kl_if_2 of + Atom (B (True)) -> do !appl_8 <- kl_V3884 `pseq` tl kl_V3884 + !appl_9 <- kl_V3885 `pseq` add kl_V3885 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + kl_V3883 `pseq` (appl_8 `pseq` (appl_9 `pseq` kl_shen_print_past_inputs kl_V3883 appl_8 appl_9)) + Atom (B (False)) -> do !kl_if_10 <- let pat_cond_11 kl_V3884 kl_V3884h kl_V3884t = do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "tuple?") + !kl_if_13 <- kl_V3884h `pseq` applyWrapper aw_12 [kl_V3884h] + 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_V3884 of + !(kl_V3884@(Cons (!kl_V3884h) + (!kl_V3884t))) -> pat_cond_11 kl_V3884 kl_V3884h kl_V3884t + _ -> pat_cond_14 + case kl_if_10 of + Atom (B (True)) -> do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_16 <- kl_V3885 `pseq` applyWrapper aw_15 [kl_V3885, + Core.Types.Atom (Core.Types.Str ". "), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + let !aw_17 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_18 <- applyWrapper aw_17 [] + let !aw_19 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_20 <- appl_16 `pseq` (appl_18 `pseq` applyWrapper aw_19 [appl_16, + appl_18]) + !appl_21 <- kl_V3884 `pseq` hd kl_V3884 + let !aw_22 = Core.Types.Atom (Core.Types.UnboundSym "snd") + !appl_23 <- appl_21 `pseq` applyWrapper aw_22 [appl_21] + !appl_24 <- appl_23 `pseq` kl_shen_prbytes appl_23 + !appl_25 <- kl_V3884 `pseq` tl kl_V3884 + !appl_26 <- kl_V3885 `pseq` add kl_V3885 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_27 <- kl_V3883 `pseq` (appl_25 `pseq` (appl_26 `pseq` kl_shen_print_past_inputs kl_V3883 appl_25 appl_26)) + let !aw_28 = Core.Types.Atom (Core.Types.UnboundSym "do") + !appl_29 <- appl_24 `pseq` (appl_27 `pseq` applyWrapper aw_28 [appl_24, + appl_27]) + let !aw_30 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_20 `pseq` (appl_29 `pseq` applyWrapper aw_30 [appl_20, + appl_29]) + Atom (B (False)) -> do do let !aw_31 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_31 [ApplC (wrapNamed "shen.print-past-inputs" kl_shen_print_past_inputs)] + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_toplevel_evaluate :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_toplevel_evaluate (!kl_V3888) (!kl_V3889) = do !kl_if_0 <- let pat_cond_1 kl_V3888 kl_V3888h kl_V3888t = do !kl_if_2 <- let pat_cond_3 kl_V3888t kl_V3888th kl_V3888tt = do !kl_if_4 <- let pat_cond_5 = do !kl_if_6 <- let pat_cond_7 kl_V3888tt kl_V3888tth kl_V3888ttt = do let !appl_8 = Atom Nil + !kl_if_9 <- appl_8 `pseq` (kl_V3888ttt `pseq` eq appl_8 kl_V3888ttt) + !kl_if_10 <- case kl_if_9 of + Atom (B (True)) -> do let pat_cond_11 = do return (Atom (B True)) + pat_cond_12 = do do return (Atom (B False)) + in case kl_V3889 of + kl_V3889@(Atom (UnboundSym "true")) -> pat_cond_11 + kl_V3889@(Atom (B (True))) -> pat_cond_11 + _ -> pat_cond_12 + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_13 = do do return (Atom (B False)) + in case kl_V3888tt of + !(kl_V3888tt@(Cons (!kl_V3888tth) + (!kl_V3888ttt))) -> pat_cond_7 kl_V3888tt kl_V3888tth kl_V3888ttt + _ -> 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_V3888th of + kl_V3888th@(Atom (UnboundSym ":")) -> pat_cond_5 + kl_V3888th@(ApplC (PL ":" + _)) -> pat_cond_5 + kl_V3888th@(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_V3888t of + !(kl_V3888t@(Cons (!kl_V3888th) + (!kl_V3888tt))) -> pat_cond_3 kl_V3888t kl_V3888th kl_V3888tt + _ -> 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_V3888 of + !(kl_V3888@(Cons (!kl_V3888h) + (!kl_V3888t))) -> pat_cond_1 kl_V3888 kl_V3888h kl_V3888t + _ -> pat_cond_16 + case kl_if_0 of + Atom (B (True)) -> do !appl_17 <- kl_V3888 `pseq` hd kl_V3888 + !appl_18 <- kl_V3888 `pseq` tl kl_V3888 + !appl_19 <- appl_18 `pseq` tl appl_18 + !appl_20 <- appl_19 `pseq` hd appl_19 + appl_17 `pseq` (appl_20 `pseq` kl_shen_typecheck_and_evaluate appl_17 appl_20) + Atom (B (False)) -> do let pat_cond_21 kl_V3888 kl_V3888h kl_V3888t kl_V3888th kl_V3888tt = do let !appl_22 = Atom Nil + !appl_23 <- kl_V3888h `pseq` (appl_22 `pseq` klCons kl_V3888h appl_22) + !appl_24 <- appl_23 `pseq` (kl_V3889 `pseq` kl_shen_toplevel_evaluate appl_23 kl_V3889) + let !aw_25 = Core.Types.Atom (Core.Types.UnboundSym "nl") + !appl_26 <- applyWrapper aw_25 [Core.Types.Atom (Core.Types.N (Core.Types.KI 1))] + !appl_27 <- kl_V3888t `pseq` (kl_V3889 `pseq` kl_shen_toplevel_evaluate kl_V3888t kl_V3889) + let !aw_28 = Core.Types.Atom (Core.Types.UnboundSym "do") + !appl_29 <- appl_26 `pseq` (appl_27 `pseq` applyWrapper aw_28 [appl_26, + appl_27]) + let !aw_30 = Core.Types.Atom (Core.Types.UnboundSym "do") + appl_24 `pseq` (appl_29 `pseq` applyWrapper aw_30 [appl_24, + appl_29]) + pat_cond_31 = do !kl_if_32 <- let pat_cond_33 kl_V3888 kl_V3888h kl_V3888t = do let !appl_34 = Atom Nil + !kl_if_35 <- appl_34 `pseq` (kl_V3888t `pseq` eq appl_34 kl_V3888t) + !kl_if_36 <- case kl_if_35 of + Atom (B (True)) -> do let pat_cond_37 = do return (Atom (B True)) + pat_cond_38 = do do return (Atom (B False)) + in case kl_V3889 of + kl_V3889@(Atom (UnboundSym "true")) -> pat_cond_37 + kl_V3889@(Atom (B (True))) -> pat_cond_37 + _ -> pat_cond_38 + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_36 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_39 = do do return (Atom (B False)) + in case kl_V3888 of + !(kl_V3888@(Cons (!kl_V3888h) + (!kl_V3888t))) -> pat_cond_33 kl_V3888 kl_V3888h kl_V3888t + _ -> pat_cond_39 + case kl_if_32 of + Atom (B (True)) -> do !appl_40 <- kl_V3888 `pseq` hd kl_V3888 + let !aw_41 = Core.Types.Atom (Core.Types.UnboundSym "gensym") + !appl_42 <- applyWrapper aw_41 [Core.Types.Atom (Core.Types.UnboundSym "A")] + appl_40 `pseq` (appl_42 `pseq` kl_shen_typecheck_and_evaluate appl_40 appl_42) + Atom (B (False)) -> do !kl_if_43 <- let pat_cond_44 kl_V3888 kl_V3888h kl_V3888t = do let !appl_45 = Atom Nil + !kl_if_46 <- appl_45 `pseq` (kl_V3888t `pseq` eq appl_45 kl_V3888t) + !kl_if_47 <- case kl_if_46 of + Atom (B (True)) -> do let pat_cond_48 = do return (Atom (B True)) + pat_cond_49 = do do return (Atom (B False)) + in case kl_V3889 of + kl_V3889@(Atom (UnboundSym "false")) -> pat_cond_48 + kl_V3889@(Atom (B (False))) -> pat_cond_48 + _ -> pat_cond_49 + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_47 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_50 = do do return (Atom (B False)) + in case kl_V3888 of + !(kl_V3888@(Cons (!kl_V3888h) + (!kl_V3888t))) -> pat_cond_44 kl_V3888 kl_V3888h kl_V3888t + _ -> pat_cond_50 + case kl_if_43 of + Atom (B (True)) -> do let !appl_51 = ApplC (Func "lambda" (Context (\(!kl_Eval) -> do let !aw_52 = Core.Types.Atom (Core.Types.UnboundSym "print") + kl_Eval `pseq` applyWrapper aw_52 [kl_Eval]))) + !appl_53 <- kl_V3888 `pseq` hd kl_V3888 + let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "shen.eval-without-macros") + !appl_55 <- appl_53 `pseq` applyWrapper aw_54 [appl_53] + appl_55 `pseq` applyWrapper appl_51 [appl_55] + Atom (B (False)) -> do do let !aw_56 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_56 [ApplC (wrapNamed "shen.toplevel_evaluate" kl_shen_toplevel_evaluate)] + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + in case kl_V3888 of + !(kl_V3888@(Cons (!kl_V3888h) + (!(kl_V3888t@(Cons (!kl_V3888th) + (!kl_V3888tt)))))) -> pat_cond_21 kl_V3888 kl_V3888h kl_V3888t kl_V3888th kl_V3888tt + _ -> pat_cond_31 + _ -> throwError "if: expected boolean" + +kl_shen_typecheck_and_evaluate :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_typecheck_and_evaluate (!kl_V3892) (!kl_V3893) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Typecheck) -> do let pat_cond_1 = do simpleError (Core.Types.Atom (Core.Types.Str "type error\n")) + pat_cond_2 = do do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Eval) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Type) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_6 <- kl_Type `pseq` applyWrapper aw_5 [kl_Type, + Core.Types.Atom (Core.Types.Str ""), + Core.Types.Atom (Core.Types.UnboundSym "shen.r")] + !appl_7 <- appl_6 `pseq` cn (Core.Types.Atom (Core.Types.Str " : ")) appl_6 + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_9 <- kl_Eval `pseq` (appl_7 `pseq` applyWrapper aw_8 [kl_Eval, + appl_7, + Core.Types.Atom (Core.Types.UnboundSym "shen.s")]) + let !aw_10 = Core.Types.Atom (Core.Types.UnboundSym "stoutput") + !appl_11 <- applyWrapper aw_10 [] + let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + appl_9 `pseq` (appl_11 `pseq` applyWrapper aw_12 [appl_9, + appl_11])))) + !appl_13 <- kl_Typecheck `pseq` kl_shen_pretty_type kl_Typecheck + appl_13 `pseq` applyWrapper appl_4 [appl_13]))) + let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "shen.eval-without-macros") + !appl_15 <- kl_V3892 `pseq` applyWrapper aw_14 [kl_V3892] + appl_15 `pseq` applyWrapper appl_3 [appl_15] + in case kl_Typecheck of + kl_Typecheck@(Atom (UnboundSym "false")) -> pat_cond_1 + kl_Typecheck@(Atom (B (False))) -> pat_cond_1 + _ -> pat_cond_2))) + let !aw_16 = Core.Types.Atom (Core.Types.UnboundSym "shen.typecheck") + !appl_17 <- kl_V3892 `pseq` (kl_V3893 `pseq` applyWrapper aw_16 [kl_V3892, + kl_V3893]) + appl_17 `pseq` applyWrapper appl_0 [appl_17] + +kl_shen_pretty_type :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_pretty_type (!kl_V3895) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*alphabet*")) + !appl_1 <- kl_V3895 `pseq` kl_shen_extract_pvars kl_V3895 + appl_0 `pseq` (appl_1 `pseq` (kl_V3895 `pseq` kl_shen_mult_subst appl_0 appl_1 kl_V3895)) + +kl_shen_extract_pvars :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_extract_pvars (!kl_V3901) = do let !aw_0 = Core.Types.Atom (Core.Types.UnboundSym "shen.pvar?") + !kl_if_1 <- kl_V3901 `pseq` applyWrapper aw_0 [kl_V3901] + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = Atom Nil + kl_V3901 `pseq` (appl_2 `pseq` klCons kl_V3901 appl_2) + Atom (B (False)) -> do let pat_cond_3 kl_V3901 kl_V3901h kl_V3901t = do !appl_4 <- kl_V3901h `pseq` kl_shen_extract_pvars kl_V3901h + !appl_5 <- kl_V3901t `pseq` kl_shen_extract_pvars kl_V3901t + let !aw_6 = Core.Types.Atom (Core.Types.UnboundSym "union") + appl_4 `pseq` (appl_5 `pseq` applyWrapper aw_6 [appl_4, + appl_5]) + pat_cond_7 = do do return (Atom Nil) + in case kl_V3901 of + !(kl_V3901@(Cons (!kl_V3901h) + (!kl_V3901t))) -> pat_cond_3 kl_V3901 kl_V3901h kl_V3901t + _ -> pat_cond_7 + _ -> throwError "if: expected boolean" + +kl_shen_mult_subst :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_mult_subst (!kl_V3909) (!kl_V3910) (!kl_V3911) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3909 `pseq` eq appl_0 kl_V3909) + case kl_if_1 of + Atom (B (True)) -> do return kl_V3911 + Atom (B (False)) -> do let !appl_2 = Atom Nil + !kl_if_3 <- appl_2 `pseq` (kl_V3910 `pseq` eq appl_2 kl_V3910) + case kl_if_3 of + Atom (B (True)) -> do return kl_V3911 + Atom (B (False)) -> do !kl_if_4 <- let pat_cond_5 kl_V3909 kl_V3909h kl_V3909t = do let pat_cond_6 kl_V3910 kl_V3910h kl_V3910t = do return (Atom (B True)) + pat_cond_7 = do do return (Atom (B False)) + in case kl_V3910 of + !(kl_V3910@(Cons (!kl_V3910h) + (!kl_V3910t))) -> pat_cond_6 kl_V3910 kl_V3910h kl_V3910t + _ -> pat_cond_7 + pat_cond_8 = do do return (Atom (B False)) + in case kl_V3909 of + !(kl_V3909@(Cons (!kl_V3909h) + (!kl_V3909t))) -> pat_cond_5 kl_V3909 kl_V3909h kl_V3909t + _ -> pat_cond_8 + case kl_if_4 of + Atom (B (True)) -> do !appl_9 <- kl_V3909 `pseq` tl kl_V3909 + !appl_10 <- kl_V3910 `pseq` tl kl_V3910 + !appl_11 <- kl_V3909 `pseq` hd kl_V3909 + !appl_12 <- kl_V3910 `pseq` hd kl_V3910 + let !aw_13 = Core.Types.Atom (Core.Types.UnboundSym "subst") + !appl_14 <- appl_11 `pseq` (appl_12 `pseq` (kl_V3911 `pseq` applyWrapper aw_13 [appl_11, + appl_12, + kl_V3911])) + appl_9 `pseq` (appl_10 `pseq` (appl_14 `pseq` kl_shen_mult_subst appl_9 appl_10 appl_14)) + Atom (B (False)) -> do do let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_15 [ApplC (wrapNamed "shen.mult_subst" kl_shen_mult_subst)] + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +expr0 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr0 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*continue-repl-loop*")) (Atom (B True))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_0 = Atom Nil + appl_0 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*history*")) appl_0) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Backend/Track.hs b/Shentong/Backend/Track.hs --- a/Shentong/Backend/Track.hs +++ b/Shentong/Backend/Track.hs @@ -1,443 +1,598 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} - -module Backend.Track 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 -import Backend.Core -import Backend.Sys -import Backend.Sequent -import Backend.Yacc -import Backend.Reader -import Backend.Prolog - -{- -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_f_error :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_f_error (!kl_V3779) = do let !aw_0 = Types.Atom (Types.UnboundSym "shen.app") - !appl_1 <- kl_V3779 `pseq` applyWrapper aw_0 [kl_V3779, - Types.Atom (Types.Str ";\n"), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_2 <- appl_1 `pseq` cn (Types.Atom (Types.Str "partial function ")) appl_1 - !appl_3 <- kl_stoutput - let !aw_4 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_5 <- appl_2 `pseq` (appl_3 `pseq` applyWrapper aw_4 [appl_2, - appl_3]) - !appl_6 <- kl_V3779 `pseq` kl_shen_trackedP kl_V3779 - !kl_if_7 <- appl_6 `pseq` kl_not appl_6 - !kl_if_8 <- case kl_if_7 of - Atom (B (True)) -> do let !aw_9 = Types.Atom (Types.UnboundSym "shen.app") - !appl_10 <- kl_V3779 `pseq` applyWrapper aw_9 [kl_V3779, - Types.Atom (Types.Str "? "), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_11 <- appl_10 `pseq` cn (Types.Atom (Types.Str "track ")) appl_10 - !kl_if_12 <- appl_11 `pseq` kl_y_or_nP appl_11 - case kl_if_12 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - !appl_13 <- case kl_if_8 of - Atom (B (True)) -> do !appl_14 <- kl_V3779 `pseq` kl_ps kl_V3779 - appl_14 `pseq` kl_shen_track_function appl_14 - Atom (B (False)) -> do do return (Types.Atom (Types.UnboundSym "shen.ok")) - _ -> throwError "if: expected boolean" - !appl_15 <- simpleError (Types.Atom (Types.Str "aborted")) - !appl_16 <- appl_13 `pseq` (appl_15 `pseq` kl_do appl_13 appl_15) - appl_5 `pseq` (appl_16 `pseq` kl_do appl_5 appl_16) - -kl_shen_trackedP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_trackedP (!kl_V3781) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "shen.*tracking*")) - kl_V3781 `pseq` (appl_0 `pseq` kl_elementP kl_V3781 appl_0) - -kl_track :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_track (!kl_V3783) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Source) -> do kl_Source `pseq` kl_shen_track_function kl_Source))) - !appl_1 <- kl_V3783 `pseq` kl_ps kl_V3783 - appl_1 `pseq` applyWrapper appl_0 [appl_1] - -kl_shen_track_function :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_track_function (!kl_V3785) = do let pat_cond_0 kl_V3785 kl_V3785t kl_V3785th kl_V3785tt kl_V3785tth kl_V3785ttt kl_V3785ttth = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_KL) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Ob) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Tr) -> do return kl_Ob))) - !appl_4 <- value (Types.Atom (Types.UnboundSym "shen.*tracking*")) - !appl_5 <- kl_Ob `pseq` (appl_4 `pseq` klCons kl_Ob appl_4) - !appl_6 <- appl_5 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*tracking*")) appl_5 - appl_6 `pseq` applyWrapper appl_3 [appl_6]))) - !appl_7 <- kl_KL `pseq` evalKL kl_KL - appl_7 `pseq` applyWrapper appl_2 [appl_7]))) - !appl_8 <- kl_V3785th `pseq` (kl_V3785tth `pseq` (kl_V3785ttth `pseq` kl_shen_insert_tracking_code kl_V3785th kl_V3785tth kl_V3785ttth)) - !appl_9 <- appl_8 `pseq` klCons appl_8 (Types.Atom Types.Nil) - !appl_10 <- kl_V3785tth `pseq` (appl_9 `pseq` klCons kl_V3785tth appl_9) - !appl_11 <- kl_V3785th `pseq` (appl_10 `pseq` klCons kl_V3785th appl_10) - !appl_12 <- appl_11 `pseq` klCons (Types.Atom (Types.UnboundSym "defun")) appl_11 - appl_12 `pseq` applyWrapper appl_1 [appl_12] - pat_cond_13 = do do kl_shen_f_error (ApplC (wrapNamed "shen.track-function" kl_shen_track_function)) - in case kl_V3785 of - !(kl_V3785@(Cons (Atom (UnboundSym "defun")) - (!(kl_V3785t@(Cons (!kl_V3785th) - (!(kl_V3785tt@(Cons (!kl_V3785tth) - (!(kl_V3785ttt@(Cons (!kl_V3785ttth) - (Atom (Nil))))))))))))) -> pat_cond_0 kl_V3785 kl_V3785t kl_V3785th kl_V3785tt kl_V3785tth kl_V3785ttt kl_V3785ttth - !(kl_V3785@(Cons (ApplC (PL "defun" _)) - (!(kl_V3785t@(Cons (!kl_V3785th) - (!(kl_V3785tt@(Cons (!kl_V3785tth) - (!(kl_V3785ttt@(Cons (!kl_V3785ttth) - (Atom (Nil))))))))))))) -> pat_cond_0 kl_V3785 kl_V3785t kl_V3785th kl_V3785tt kl_V3785tth kl_V3785ttt kl_V3785ttth - !(kl_V3785@(Cons (ApplC (Func "defun" _)) - (!(kl_V3785t@(Cons (!kl_V3785th) - (!(kl_V3785tt@(Cons (!kl_V3785tth) - (!(kl_V3785ttt@(Cons (!kl_V3785ttth) - (Atom (Nil))))))))))))) -> pat_cond_0 kl_V3785 kl_V3785t kl_V3785th kl_V3785tt kl_V3785tth kl_V3785ttt kl_V3785ttth - _ -> pat_cond_13 - -kl_shen_insert_tracking_code :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_insert_tracking_code (!kl_V3789) (!kl_V3790) (!kl_V3791) = do !appl_0 <- klCons (Types.Atom (Types.UnboundSym "shen.*call*")) (Types.Atom Types.Nil) - !appl_1 <- appl_0 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_0 - !appl_2 <- klCons (Types.Atom (Types.N (Types.KI 1))) (Types.Atom Types.Nil) - !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) - !appl_4 <- appl_3 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_3 - !appl_5 <- appl_4 `pseq` klCons appl_4 (Types.Atom Types.Nil) - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.*call*")) appl_5 - !appl_7 <- appl_6 `pseq` klCons (ApplC (wrapNamed "set" klSet)) appl_6 - !appl_8 <- klCons (Types.Atom (Types.UnboundSym "shen.*call*")) (Types.Atom Types.Nil) - !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_8 - !appl_10 <- kl_V3790 `pseq` kl_shen_cons_form kl_V3790 - !appl_11 <- appl_10 `pseq` klCons appl_10 (Types.Atom Types.Nil) - !appl_12 <- kl_V3789 `pseq` (appl_11 `pseq` klCons kl_V3789 appl_11) - !appl_13 <- appl_9 `pseq` (appl_12 `pseq` klCons appl_9 appl_12) - !appl_14 <- appl_13 `pseq` klCons (ApplC (wrapNamed "shen.input-track" kl_shen_input_track)) appl_13 - !appl_15 <- klCons (ApplC (PL "shen.terpri-or-read-char" kl_shen_terpri_or_read_char)) (Types.Atom Types.Nil) - !appl_16 <- klCons (Types.Atom (Types.UnboundSym "shen.*call*")) (Types.Atom Types.Nil) - !appl_17 <- appl_16 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_16 - !appl_18 <- klCons (Types.Atom (Types.UnboundSym "Result")) (Types.Atom Types.Nil) - !appl_19 <- kl_V3789 `pseq` (appl_18 `pseq` klCons kl_V3789 appl_18) - !appl_20 <- appl_17 `pseq` (appl_19 `pseq` klCons appl_17 appl_19) - !appl_21 <- appl_20 `pseq` klCons (ApplC (wrapNamed "shen.output-track" kl_shen_output_track)) appl_20 - !appl_22 <- klCons (Types.Atom (Types.UnboundSym "shen.*call*")) (Types.Atom Types.Nil) - !appl_23 <- appl_22 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_22 - !appl_24 <- klCons (Types.Atom (Types.N (Types.KI 1))) (Types.Atom Types.Nil) - !appl_25 <- appl_23 `pseq` (appl_24 `pseq` klCons appl_23 appl_24) - !appl_26 <- appl_25 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_25 - !appl_27 <- appl_26 `pseq` klCons appl_26 (Types.Atom Types.Nil) - !appl_28 <- appl_27 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.*call*")) appl_27 - !appl_29 <- appl_28 `pseq` klCons (ApplC (wrapNamed "set" klSet)) appl_28 - !appl_30 <- klCons (ApplC (PL "shen.terpri-or-read-char" kl_shen_terpri_or_read_char)) (Types.Atom Types.Nil) - !appl_31 <- klCons (Types.Atom (Types.UnboundSym "Result")) (Types.Atom Types.Nil) - !appl_32 <- appl_30 `pseq` (appl_31 `pseq` klCons appl_30 appl_31) - !appl_33 <- appl_32 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_32 - !appl_34 <- appl_33 `pseq` klCons appl_33 (Types.Atom Types.Nil) - !appl_35 <- appl_29 `pseq` (appl_34 `pseq` klCons appl_29 appl_34) - !appl_36 <- appl_35 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_35 - !appl_37 <- appl_36 `pseq` klCons appl_36 (Types.Atom Types.Nil) - !appl_38 <- appl_21 `pseq` (appl_37 `pseq` klCons appl_21 appl_37) - !appl_39 <- appl_38 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_38 - !appl_40 <- appl_39 `pseq` klCons appl_39 (Types.Atom Types.Nil) - !appl_41 <- kl_V3791 `pseq` (appl_40 `pseq` klCons kl_V3791 appl_40) - !appl_42 <- appl_41 `pseq` klCons (Types.Atom (Types.UnboundSym "Result")) appl_41 - !appl_43 <- appl_42 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_42 - !appl_44 <- appl_43 `pseq` klCons appl_43 (Types.Atom Types.Nil) - !appl_45 <- appl_15 `pseq` (appl_44 `pseq` klCons appl_15 appl_44) - !appl_46 <- appl_45 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_45 - !appl_47 <- appl_46 `pseq` klCons appl_46 (Types.Atom Types.Nil) - !appl_48 <- appl_14 `pseq` (appl_47 `pseq` klCons appl_14 appl_47) - !appl_49 <- appl_48 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_48 - !appl_50 <- appl_49 `pseq` klCons appl_49 (Types.Atom Types.Nil) - !appl_51 <- appl_7 `pseq` (appl_50 `pseq` klCons appl_7 appl_50) - appl_51 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_51 - -kl_step :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_step (!kl_V3797) = do let pat_cond_0 = do klSet (Types.Atom (Types.UnboundSym "shen.*step*")) (Atom (B True)) - pat_cond_1 = do klSet (Types.Atom (Types.UnboundSym "shen.*step*")) (Atom (B False)) - pat_cond_2 = do do simpleError (Types.Atom (Types.Str "step expects a + or a -.\n")) - in case kl_V3797 of - kl_V3797@(Atom (UnboundSym "+")) -> pat_cond_0 - kl_V3797@(ApplC (PL "+" _)) -> pat_cond_0 - kl_V3797@(ApplC (Func "+" _)) -> pat_cond_0 - kl_V3797@(Atom (UnboundSym "-")) -> pat_cond_1 - kl_V3797@(ApplC (PL "-" _)) -> pat_cond_1 - kl_V3797@(ApplC (Func "-" _)) -> pat_cond_1 - _ -> pat_cond_2 - -kl_spy :: Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_spy (!kl_V3803) = do let pat_cond_0 = do klSet (Types.Atom (Types.UnboundSym "shen.*spy*")) (Atom (B True)) - pat_cond_1 = do klSet (Types.Atom (Types.UnboundSym "shen.*spy*")) (Atom (B False)) - pat_cond_2 = do do simpleError (Types.Atom (Types.Str "spy expects a + or a -.\n")) - in case kl_V3803 of - kl_V3803@(Atom (UnboundSym "+")) -> pat_cond_0 - kl_V3803@(ApplC (PL "+" _)) -> pat_cond_0 - kl_V3803@(ApplC (Func "+" _)) -> pat_cond_0 - kl_V3803@(Atom (UnboundSym "-")) -> pat_cond_1 - kl_V3803@(ApplC (PL "-" _)) -> pat_cond_1 - kl_V3803@(ApplC (Func "-" _)) -> pat_cond_1 - _ -> pat_cond_2 - -kl_shen_terpri_or_read_char :: Types.KLContext Types.Env - Types.KLValue -kl_shen_terpri_or_read_char = do !kl_if_0 <- value (Types.Atom (Types.UnboundSym "shen.*step*")) - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- value (Types.Atom (Types.UnboundSym "*stinput*")) - !appl_2 <- appl_1 `pseq` readByte appl_1 - appl_2 `pseq` kl_shen_check_byte appl_2 - Atom (B (False)) -> do do kl_nl (Types.Atom (Types.N (Types.KI 1))) - _ -> throwError "if: expected boolean" - -kl_shen_check_byte :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_check_byte (!kl_V3809) = do !appl_0 <- kl_shen_hat - !kl_if_1 <- kl_V3809 `pseq` (appl_0 `pseq` eq kl_V3809 appl_0) - case kl_if_1 of - Atom (B (True)) -> do simpleError (Types.Atom (Types.Str "aborted")) - Atom (B (False)) -> do do return (Atom (B True)) - _ -> throwError "if: expected boolean" - -kl_shen_input_track :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_input_track (!kl_V3813) (!kl_V3814) (!kl_V3815) = do !appl_0 <- kl_V3813 `pseq` kl_shen_spaces kl_V3813 - !appl_1 <- kl_V3813 `pseq` kl_shen_spaces kl_V3813 - let !aw_2 = Types.Atom (Types.UnboundSym "shen.app") - !appl_3 <- appl_1 `pseq` applyWrapper aw_2 [appl_1, - Types.Atom (Types.Str ""), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_4 <- appl_3 `pseq` cn (Types.Atom (Types.Str " \n")) appl_3 - let !aw_5 = Types.Atom (Types.UnboundSym "shen.app") - !appl_6 <- kl_V3814 `pseq` (appl_4 `pseq` applyWrapper aw_5 [kl_V3814, - appl_4, - Types.Atom (Types.UnboundSym "shen.a")]) - !appl_7 <- appl_6 `pseq` cn (Types.Atom (Types.Str "> Inputs to ")) appl_6 - let !aw_8 = Types.Atom (Types.UnboundSym "shen.app") - !appl_9 <- kl_V3813 `pseq` (appl_7 `pseq` applyWrapper aw_8 [kl_V3813, - appl_7, - Types.Atom (Types.UnboundSym "shen.a")]) - !appl_10 <- appl_9 `pseq` cn (Types.Atom (Types.Str "<")) appl_9 - let !aw_11 = Types.Atom (Types.UnboundSym "shen.app") - !appl_12 <- appl_0 `pseq` (appl_10 `pseq` applyWrapper aw_11 [appl_0, - appl_10, - Types.Atom (Types.UnboundSym "shen.a")]) - !appl_13 <- appl_12 `pseq` cn (Types.Atom (Types.Str "\n")) appl_12 - !appl_14 <- kl_stoutput - let !aw_15 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_16 <- appl_13 `pseq` (appl_14 `pseq` applyWrapper aw_15 [appl_13, - appl_14]) - !appl_17 <- kl_V3815 `pseq` kl_shen_recursively_print kl_V3815 - appl_16 `pseq` (appl_17 `pseq` kl_do appl_16 appl_17) - -kl_shen_recursively_print :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_recursively_print (!kl_V3817) = do let pat_cond_0 = do !appl_1 <- kl_stoutput - let !aw_2 = Types.Atom (Types.UnboundSym "shen.prhush") - appl_1 `pseq` applyWrapper aw_2 [Types.Atom (Types.Str " ==>"), - appl_1] - pat_cond_3 kl_V3817 kl_V3817h kl_V3817t = do let !aw_4 = Types.Atom (Types.UnboundSym "print") - !appl_5 <- kl_V3817h `pseq` applyWrapper aw_4 [kl_V3817h] - !appl_6 <- kl_stoutput - let !aw_7 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_8 <- appl_6 `pseq` applyWrapper aw_7 [Types.Atom (Types.Str ", "), - appl_6] - !appl_9 <- kl_V3817t `pseq` kl_shen_recursively_print kl_V3817t - !appl_10 <- appl_8 `pseq` (appl_9 `pseq` kl_do appl_8 appl_9) - appl_5 `pseq` (appl_10 `pseq` kl_do appl_5 appl_10) - pat_cond_11 = do do kl_shen_f_error (ApplC (wrapNamed "shen.recursively-print" kl_shen_recursively_print)) - in case kl_V3817 of - kl_V3817@(Atom (Nil)) -> pat_cond_0 - !(kl_V3817@(Cons (!kl_V3817h) - (!kl_V3817t))) -> pat_cond_3 kl_V3817 kl_V3817h kl_V3817t - _ -> pat_cond_11 - -kl_shen_spaces :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_spaces (!kl_V3819) = do let pat_cond_0 = do return (Types.Atom (Types.Str "")) - pat_cond_1 = do do !appl_2 <- kl_V3819 `pseq` Primitives.subtract kl_V3819 (Types.Atom (Types.N (Types.KI 1))) - !appl_3 <- appl_2 `pseq` kl_shen_spaces appl_2 - appl_3 `pseq` cn (Types.Atom (Types.Str " ")) appl_3 - in case kl_V3819 of - kl_V3819@(Atom (N (KI 0))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_output_track :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_output_track (!kl_V3823) (!kl_V3824) (!kl_V3825) = do !appl_0 <- kl_V3823 `pseq` kl_shen_spaces kl_V3823 - !appl_1 <- kl_V3823 `pseq` kl_shen_spaces kl_V3823 - let !aw_2 = Types.Atom (Types.UnboundSym "shen.app") - !appl_3 <- kl_V3825 `pseq` applyWrapper aw_2 [kl_V3825, - Types.Atom (Types.Str ""), - Types.Atom (Types.UnboundSym "shen.s")] - !appl_4 <- appl_3 `pseq` cn (Types.Atom (Types.Str "==> ")) appl_3 - let !aw_5 = Types.Atom (Types.UnboundSym "shen.app") - !appl_6 <- appl_1 `pseq` (appl_4 `pseq` applyWrapper aw_5 [appl_1, - appl_4, - Types.Atom (Types.UnboundSym "shen.a")]) - !appl_7 <- appl_6 `pseq` cn (Types.Atom (Types.Str " \n")) appl_6 - let !aw_8 = Types.Atom (Types.UnboundSym "shen.app") - !appl_9 <- kl_V3824 `pseq` (appl_7 `pseq` applyWrapper aw_8 [kl_V3824, - appl_7, - Types.Atom (Types.UnboundSym "shen.a")]) - !appl_10 <- appl_9 `pseq` cn (Types.Atom (Types.Str "> Output from ")) appl_9 - let !aw_11 = Types.Atom (Types.UnboundSym "shen.app") - !appl_12 <- kl_V3823 `pseq` (appl_10 `pseq` applyWrapper aw_11 [kl_V3823, - appl_10, - Types.Atom (Types.UnboundSym "shen.a")]) - !appl_13 <- appl_12 `pseq` cn (Types.Atom (Types.Str "<")) appl_12 - let !aw_14 = Types.Atom (Types.UnboundSym "shen.app") - !appl_15 <- appl_0 `pseq` (appl_13 `pseq` applyWrapper aw_14 [appl_0, - appl_13, - Types.Atom (Types.UnboundSym "shen.a")]) - !appl_16 <- appl_15 `pseq` cn (Types.Atom (Types.Str "\n")) appl_15 - !appl_17 <- kl_stoutput - let !aw_18 = Types.Atom (Types.UnboundSym "shen.prhush") - appl_16 `pseq` (appl_17 `pseq` applyWrapper aw_18 [appl_16, - appl_17]) - -kl_untrack :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_untrack (!kl_V3827) = do !appl_0 <- kl_V3827 `pseq` kl_ps kl_V3827 - appl_0 `pseq` kl_eval appl_0 - -kl_profile :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_profile (!kl_V3829) = do !appl_0 <- kl_V3829 `pseq` kl_ps kl_V3829 - appl_0 `pseq` kl_shen_profile_help appl_0 - -kl_shen_profile_help :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_profile_help (!kl_V3835) = do let pat_cond_0 kl_V3835 kl_V3835t kl_V3835th kl_V3835tt kl_V3835tth kl_V3835ttt kl_V3835ttth = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_G) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Profile) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Def) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_CompileProfile) -> do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_CompileG) -> do return kl_V3835th))) - !appl_6 <- kl_Def `pseq` kl_shen_eval_without_macros kl_Def - appl_6 `pseq` applyWrapper appl_5 [appl_6]))) - !appl_7 <- kl_Profile `pseq` kl_shen_eval_without_macros kl_Profile - appl_7 `pseq` applyWrapper appl_4 [appl_7]))) - !appl_8 <- kl_G `pseq` (kl_V3835th `pseq` (kl_V3835ttth `pseq` kl_subst kl_G kl_V3835th kl_V3835ttth)) - !appl_9 <- appl_8 `pseq` klCons appl_8 (Types.Atom Types.Nil) - !appl_10 <- kl_V3835tth `pseq` (appl_9 `pseq` klCons kl_V3835tth appl_9) - !appl_11 <- kl_G `pseq` (appl_10 `pseq` klCons kl_G appl_10) - !appl_12 <- appl_11 `pseq` klCons (Types.Atom (Types.UnboundSym "defun")) appl_11 - appl_12 `pseq` applyWrapper appl_3 [appl_12]))) - !appl_13 <- kl_G `pseq` (kl_V3835tth `pseq` klCons kl_G kl_V3835tth) - !appl_14 <- kl_V3835th `pseq` (kl_V3835tth `pseq` (appl_13 `pseq` kl_shen_profile_func kl_V3835th kl_V3835tth appl_13)) - !appl_15 <- appl_14 `pseq` klCons appl_14 (Types.Atom Types.Nil) - !appl_16 <- kl_V3835tth `pseq` (appl_15 `pseq` klCons kl_V3835tth appl_15) - !appl_17 <- kl_V3835th `pseq` (appl_16 `pseq` klCons kl_V3835th appl_16) - !appl_18 <- appl_17 `pseq` klCons (Types.Atom (Types.UnboundSym "defun")) appl_17 - appl_18 `pseq` applyWrapper appl_2 [appl_18]))) - !appl_19 <- kl_gensym (Types.Atom (Types.UnboundSym "shen.f")) - appl_19 `pseq` applyWrapper appl_1 [appl_19] - pat_cond_20 = do do simpleError (Types.Atom (Types.Str "Cannot profile.\n")) - in case kl_V3835 of - !(kl_V3835@(Cons (Atom (UnboundSym "defun")) - (!(kl_V3835t@(Cons (!kl_V3835th) - (!(kl_V3835tt@(Cons (!kl_V3835tth) - (!(kl_V3835ttt@(Cons (!kl_V3835ttth) - (Atom (Nil))))))))))))) -> pat_cond_0 kl_V3835 kl_V3835t kl_V3835th kl_V3835tt kl_V3835tth kl_V3835ttt kl_V3835ttth - !(kl_V3835@(Cons (ApplC (PL "defun" _)) - (!(kl_V3835t@(Cons (!kl_V3835th) - (!(kl_V3835tt@(Cons (!kl_V3835tth) - (!(kl_V3835ttt@(Cons (!kl_V3835ttth) - (Atom (Nil))))))))))))) -> pat_cond_0 kl_V3835 kl_V3835t kl_V3835th kl_V3835tt kl_V3835tth kl_V3835ttt kl_V3835ttth - !(kl_V3835@(Cons (ApplC (Func "defun" _)) - (!(kl_V3835t@(Cons (!kl_V3835th) - (!(kl_V3835tt@(Cons (!kl_V3835tth) - (!(kl_V3835ttt@(Cons (!kl_V3835ttth) - (Atom (Nil))))))))))))) -> pat_cond_0 kl_V3835 kl_V3835t kl_V3835th kl_V3835tt kl_V3835tth kl_V3835ttt kl_V3835ttth - _ -> pat_cond_20 - -kl_unprofile :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_unprofile (!kl_V3837) = do kl_V3837 `pseq` kl_untrack kl_V3837 - -kl_shen_profile_func :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_profile_func (!kl_V3841) (!kl_V3842) (!kl_V3843) = do !appl_0 <- klCons (Types.Atom (Types.UnboundSym "run")) (Types.Atom Types.Nil) - !appl_1 <- appl_0 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_0 - !appl_2 <- klCons (Types.Atom (Types.UnboundSym "run")) (Types.Atom Types.Nil) - !appl_3 <- appl_2 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_2 - !appl_4 <- klCons (Types.Atom (Types.UnboundSym "Start")) (Types.Atom Types.Nil) - !appl_5 <- appl_3 `pseq` (appl_4 `pseq` klCons appl_3 appl_4) - !appl_6 <- appl_5 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_5 - !appl_7 <- kl_V3841 `pseq` klCons kl_V3841 (Types.Atom Types.Nil) - !appl_8 <- appl_7 `pseq` klCons (ApplC (wrapNamed "shen.get-profile" kl_shen_get_profile)) appl_7 - !appl_9 <- klCons (Types.Atom (Types.UnboundSym "Finish")) (Types.Atom Types.Nil) - !appl_10 <- appl_8 `pseq` (appl_9 `pseq` klCons appl_8 appl_9) - !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_10 - !appl_12 <- appl_11 `pseq` klCons appl_11 (Types.Atom Types.Nil) - !appl_13 <- kl_V3841 `pseq` (appl_12 `pseq` klCons kl_V3841 appl_12) - !appl_14 <- appl_13 `pseq` klCons (ApplC (wrapNamed "shen.put-profile" kl_shen_put_profile)) appl_13 - !appl_15 <- klCons (Types.Atom (Types.UnboundSym "Result")) (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 "Record")) appl_16 - !appl_18 <- appl_17 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_17 - !appl_19 <- appl_18 `pseq` klCons appl_18 (Types.Atom Types.Nil) - !appl_20 <- appl_6 `pseq` (appl_19 `pseq` klCons appl_6 appl_19) - !appl_21 <- appl_20 `pseq` klCons (Types.Atom (Types.UnboundSym "Finish")) appl_20 - !appl_22 <- appl_21 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_21 - !appl_23 <- appl_22 `pseq` klCons appl_22 (Types.Atom Types.Nil) - !appl_24 <- kl_V3843 `pseq` (appl_23 `pseq` klCons kl_V3843 appl_23) - !appl_25 <- appl_24 `pseq` klCons (Types.Atom (Types.UnboundSym "Result")) appl_24 - !appl_26 <- appl_25 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_25 - !appl_27 <- appl_26 `pseq` klCons appl_26 (Types.Atom Types.Nil) - !appl_28 <- appl_1 `pseq` (appl_27 `pseq` klCons appl_1 appl_27) - !appl_29 <- appl_28 `pseq` klCons (Types.Atom (Types.UnboundSym "Start")) appl_28 - appl_29 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_29 - -kl_profile_results :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_profile_results (!kl_V3845) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Results) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Initialise) -> do kl_V3845 `pseq` (kl_Results `pseq` kl_Atp kl_V3845 kl_Results)))) - !appl_2 <- kl_V3845 `pseq` kl_shen_put_profile kl_V3845 (Types.Atom (Types.N (Types.KI 0))) - appl_2 `pseq` applyWrapper appl_1 [appl_2]))) - !appl_3 <- kl_V3845 `pseq` kl_shen_get_profile kl_V3845 - appl_3 `pseq` applyWrapper appl_0 [appl_3] - -kl_shen_get_profile :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_get_profile (!kl_V3847) = do (do !appl_0 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - kl_V3847 `pseq` (appl_0 `pseq` kl_get kl_V3847 (ApplC (wrapNamed "profile" kl_profile)) appl_0)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.N (Types.KI 0)))) - -kl_shen_put_profile :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_put_profile (!kl_V3850) (!kl_V3851) = do !appl_0 <- value (Types.Atom (Types.UnboundSym "*property-vector*")) - kl_V3850 `pseq` (kl_V3851 `pseq` (appl_0 `pseq` kl_put kl_V3850 (ApplC (wrapNamed "profile" kl_profile)) kl_V3851 appl_0)) - -expr7 :: Types.KLContext Types.Env Types.KLValue -expr7 = 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"))) - (do klSet (Types.Atom (Types.UnboundSym "shen.*step*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Track where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel +import Backend.Core +import Backend.Sys +import Backend.Sequent +import Backend.Yacc +import Backend.Reader +import Backend.Prolog + +{- +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_f_error :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_f_error (!kl_V3913) = do let !aw_0 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_1 <- kl_V3913 `pseq` applyWrapper aw_0 [kl_V3913, + Core.Types.Atom (Core.Types.Str ";\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_2 <- appl_1 `pseq` cn (Core.Types.Atom (Core.Types.Str "partial function ")) appl_1 + !appl_3 <- kl_stoutput + let !aw_4 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_5 <- appl_2 `pseq` (appl_3 `pseq` applyWrapper aw_4 [appl_2, + appl_3]) + !appl_6 <- kl_V3913 `pseq` kl_shen_trackedP kl_V3913 + !kl_if_7 <- appl_6 `pseq` kl_not appl_6 + !kl_if_8 <- case kl_if_7 of + Atom (B (True)) -> do let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_10 <- kl_V3913 `pseq` applyWrapper aw_9 [kl_V3913, + Core.Types.Atom (Core.Types.Str "? "), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_11 <- appl_10 `pseq` cn (Core.Types.Atom (Core.Types.Str "track ")) appl_10 + !kl_if_12 <- appl_11 `pseq` kl_y_or_nP appl_11 + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + !appl_13 <- case kl_if_8 of + Atom (B (True)) -> do !appl_14 <- kl_V3913 `pseq` kl_ps kl_V3913 + appl_14 `pseq` kl_shen_track_function appl_14 + Atom (B (False)) -> do do return (Core.Types.Atom (Core.Types.UnboundSym "shen.ok")) + _ -> throwError "if: expected boolean" + !appl_15 <- simpleError (Core.Types.Atom (Core.Types.Str "aborted")) + !appl_16 <- appl_13 `pseq` (appl_15 `pseq` kl_do appl_13 appl_15) + appl_5 `pseq` (appl_16 `pseq` kl_do appl_5 appl_16) + +kl_shen_trackedP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_trackedP (!kl_V3915) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*tracking*")) + kl_V3915 `pseq` (appl_0 `pseq` kl_elementP kl_V3915 appl_0) + +kl_track :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_track (!kl_V3917) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Source) -> do kl_Source `pseq` kl_shen_track_function kl_Source))) + !appl_1 <- kl_V3917 `pseq` kl_ps kl_V3917 + appl_1 `pseq` applyWrapper appl_0 [appl_1] + +kl_shen_track_function :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_track_function (!kl_V3919) = do !kl_if_0 <- let pat_cond_1 kl_V3919 kl_V3919h kl_V3919t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V3919t kl_V3919th kl_V3919tt = do !kl_if_6 <- let pat_cond_7 kl_V3919tt kl_V3919tth kl_V3919ttt = do !kl_if_8 <- let pat_cond_9 kl_V3919ttt kl_V3919ttth kl_V3919tttt = do let !appl_10 = Atom Nil + !kl_if_11 <- appl_10 `pseq` (kl_V3919tttt `pseq` eq appl_10 kl_V3919tttt) + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V3919ttt of + !(kl_V3919ttt@(Cons (!kl_V3919ttth) + (!kl_V3919tttt))) -> pat_cond_9 kl_V3919ttt kl_V3919ttth kl_V3919tttt + _ -> 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_V3919tt of + !(kl_V3919tt@(Cons (!kl_V3919tth) + (!kl_V3919ttt))) -> pat_cond_7 kl_V3919tt kl_V3919tth kl_V3919ttt + _ -> 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_V3919t of + !(kl_V3919t@(Cons (!kl_V3919th) + (!kl_V3919tt))) -> pat_cond_5 kl_V3919t kl_V3919th kl_V3919tt + _ -> 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_V3919h of + kl_V3919h@(Atom (UnboundSym "defun")) -> pat_cond_3 + kl_V3919h@(ApplC (PL "defun" + _)) -> pat_cond_3 + kl_V3919h@(ApplC (Func "defun" + _)) -> pat_cond_3 + _ -> 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_V3919 of + !(kl_V3919@(Cons (!kl_V3919h) + (!kl_V3919t))) -> pat_cond_1 kl_V3919 kl_V3919h kl_V3919t + _ -> pat_cond_16 + case kl_if_0 of + Atom (B (True)) -> do let !appl_17 = ApplC (Func "lambda" (Context (\(!kl_KL) -> do let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_Ob) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Tr) -> do return kl_Ob))) + !appl_20 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*tracking*")) + !appl_21 <- kl_Ob `pseq` (appl_20 `pseq` klCons kl_Ob appl_20) + !appl_22 <- appl_21 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*tracking*")) appl_21 + appl_22 `pseq` applyWrapper appl_19 [appl_22]))) + !appl_23 <- kl_KL `pseq` evalKL kl_KL + appl_23 `pseq` applyWrapper appl_18 [appl_23]))) + !appl_24 <- kl_V3919 `pseq` tl kl_V3919 + !appl_25 <- appl_24 `pseq` hd appl_24 + !appl_26 <- kl_V3919 `pseq` tl kl_V3919 + !appl_27 <- appl_26 `pseq` tl appl_26 + !appl_28 <- appl_27 `pseq` hd appl_27 + !appl_29 <- kl_V3919 `pseq` tl kl_V3919 + !appl_30 <- appl_29 `pseq` hd appl_29 + !appl_31 <- kl_V3919 `pseq` tl kl_V3919 + !appl_32 <- appl_31 `pseq` tl appl_31 + !appl_33 <- appl_32 `pseq` hd appl_32 + !appl_34 <- kl_V3919 `pseq` tl kl_V3919 + !appl_35 <- appl_34 `pseq` tl appl_34 + !appl_36 <- appl_35 `pseq` tl appl_35 + !appl_37 <- appl_36 `pseq` hd appl_36 + !appl_38 <- appl_30 `pseq` (appl_33 `pseq` (appl_37 `pseq` kl_shen_insert_tracking_code appl_30 appl_33 appl_37)) + let !appl_39 = Atom Nil + !appl_40 <- appl_38 `pseq` (appl_39 `pseq` klCons appl_38 appl_39) + !appl_41 <- appl_28 `pseq` (appl_40 `pseq` klCons appl_28 appl_40) + !appl_42 <- appl_25 `pseq` (appl_41 `pseq` klCons appl_25 appl_41) + !appl_43 <- appl_42 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defun")) appl_42 + appl_43 `pseq` applyWrapper appl_17 [appl_43] + Atom (B (False)) -> do do kl_shen_f_error (ApplC (wrapNamed "shen.track-function" kl_shen_track_function)) + _ -> throwError "if: expected boolean" + +kl_shen_insert_tracking_code :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_insert_tracking_code (!kl_V3923) (!kl_V3924) (!kl_V3925) = do let !appl_0 = Atom Nil + !appl_1 <- appl_0 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.*call*")) appl_0 + !appl_2 <- appl_1 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_1 + let !appl_3 = Atom Nil + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_3 + !appl_5 <- appl_2 `pseq` (appl_4 `pseq` klCons appl_2 appl_4) + !appl_6 <- appl_5 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_5 + let !appl_7 = Atom Nil + !appl_8 <- appl_6 `pseq` (appl_7 `pseq` klCons appl_6 appl_7) + !appl_9 <- appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.*call*")) appl_8 + !appl_10 <- appl_9 `pseq` klCons (ApplC (wrapNamed "set" klSet)) appl_9 + let !appl_11 = Atom Nil + !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.*call*")) appl_11 + !appl_13 <- appl_12 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_12 + !appl_14 <- kl_V3924 `pseq` kl_shen_cons_form kl_V3924 + let !appl_15 = Atom Nil + !appl_16 <- appl_14 `pseq` (appl_15 `pseq` klCons appl_14 appl_15) + !appl_17 <- kl_V3923 `pseq` (appl_16 `pseq` klCons kl_V3923 appl_16) + !appl_18 <- appl_13 `pseq` (appl_17 `pseq` klCons appl_13 appl_17) + !appl_19 <- appl_18 `pseq` klCons (ApplC (wrapNamed "shen.input-track" kl_shen_input_track)) appl_18 + let !appl_20 = Atom Nil + !appl_21 <- appl_20 `pseq` klCons (ApplC (PL "shen.terpri-or-read-char" kl_shen_terpri_or_read_char)) appl_20 + let !appl_22 = Atom Nil + !appl_23 <- appl_22 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.*call*")) appl_22 + !appl_24 <- appl_23 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_23 + let !appl_25 = Atom Nil + !appl_26 <- appl_25 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_25 + !appl_27 <- kl_V3923 `pseq` (appl_26 `pseq` klCons kl_V3923 appl_26) + !appl_28 <- appl_24 `pseq` (appl_27 `pseq` klCons appl_24 appl_27) + !appl_29 <- appl_28 `pseq` klCons (ApplC (wrapNamed "shen.output-track" kl_shen_output_track)) appl_28 + let !appl_30 = Atom Nil + !appl_31 <- appl_30 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.*call*")) appl_30 + !appl_32 <- appl_31 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_31 + let !appl_33 = Atom Nil + !appl_34 <- appl_33 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_33 + !appl_35 <- appl_32 `pseq` (appl_34 `pseq` klCons appl_32 appl_34) + !appl_36 <- appl_35 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_35 + let !appl_37 = Atom Nil + !appl_38 <- appl_36 `pseq` (appl_37 `pseq` klCons appl_36 appl_37) + !appl_39 <- appl_38 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.*call*")) appl_38 + !appl_40 <- appl_39 `pseq` klCons (ApplC (wrapNamed "set" klSet)) appl_39 + let !appl_41 = Atom Nil + !appl_42 <- appl_41 `pseq` klCons (ApplC (PL "shen.terpri-or-read-char" kl_shen_terpri_or_read_char)) appl_41 + let !appl_43 = Atom Nil + !appl_44 <- appl_43 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_43 + !appl_45 <- appl_42 `pseq` (appl_44 `pseq` klCons appl_42 appl_44) + !appl_46 <- appl_45 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_45 + let !appl_47 = Atom Nil + !appl_48 <- appl_46 `pseq` (appl_47 `pseq` klCons appl_46 appl_47) + !appl_49 <- appl_40 `pseq` (appl_48 `pseq` klCons appl_40 appl_48) + !appl_50 <- appl_49 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_49 + let !appl_51 = Atom Nil + !appl_52 <- appl_50 `pseq` (appl_51 `pseq` klCons appl_50 appl_51) + !appl_53 <- appl_29 `pseq` (appl_52 `pseq` klCons appl_29 appl_52) + !appl_54 <- appl_53 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_53 + let !appl_55 = Atom Nil + !appl_56 <- appl_54 `pseq` (appl_55 `pseq` klCons appl_54 appl_55) + !appl_57 <- kl_V3925 `pseq` (appl_56 `pseq` klCons kl_V3925 appl_56) + !appl_58 <- appl_57 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_57 + !appl_59 <- appl_58 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_58 + let !appl_60 = Atom Nil + !appl_61 <- appl_59 `pseq` (appl_60 `pseq` klCons appl_59 appl_60) + !appl_62 <- appl_21 `pseq` (appl_61 `pseq` klCons appl_21 appl_61) + !appl_63 <- appl_62 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_62 + let !appl_64 = Atom Nil + !appl_65 <- appl_63 `pseq` (appl_64 `pseq` klCons appl_63 appl_64) + !appl_66 <- appl_19 `pseq` (appl_65 `pseq` klCons appl_19 appl_65) + !appl_67 <- appl_66 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_66 + let !appl_68 = Atom Nil + !appl_69 <- appl_67 `pseq` (appl_68 `pseq` klCons appl_67 appl_68) + !appl_70 <- appl_10 `pseq` (appl_69 `pseq` klCons appl_10 appl_69) + appl_70 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_70 + +kl_step :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_step (!kl_V3931) = do let pat_cond_0 = do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*step*")) (Atom (B True)) + pat_cond_1 = do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*step*")) (Atom (B False)) + pat_cond_2 = do do simpleError (Core.Types.Atom (Core.Types.Str "step expects a + or a -.\n")) + in case kl_V3931 of + kl_V3931@(Atom (UnboundSym "+")) -> pat_cond_0 + kl_V3931@(ApplC (PL "+" _)) -> pat_cond_0 + kl_V3931@(ApplC (Func "+" _)) -> pat_cond_0 + kl_V3931@(Atom (UnboundSym "-")) -> pat_cond_1 + kl_V3931@(ApplC (PL "-" _)) -> pat_cond_1 + kl_V3931@(ApplC (Func "-" _)) -> pat_cond_1 + _ -> pat_cond_2 + +kl_spy :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_spy (!kl_V3937) = do let pat_cond_0 = do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*spy*")) (Atom (B True)) + pat_cond_1 = do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*spy*")) (Atom (B False)) + pat_cond_2 = do do simpleError (Core.Types.Atom (Core.Types.Str "spy expects a + or a -.\n")) + in case kl_V3937 of + kl_V3937@(Atom (UnboundSym "+")) -> pat_cond_0 + kl_V3937@(ApplC (PL "+" _)) -> pat_cond_0 + kl_V3937@(ApplC (Func "+" _)) -> pat_cond_0 + kl_V3937@(Atom (UnboundSym "-")) -> pat_cond_1 + kl_V3937@(ApplC (PL "-" _)) -> pat_cond_1 + kl_V3937@(ApplC (Func "-" _)) -> pat_cond_1 + _ -> pat_cond_2 + +kl_shen_terpri_or_read_char :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_terpri_or_read_char = do !kl_if_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*step*")) + case kl_if_0 of + Atom (B (True)) -> do !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "*stinput*")) + !appl_2 <- appl_1 `pseq` readByte appl_1 + appl_2 `pseq` kl_shen_check_byte appl_2 + Atom (B (False)) -> do do kl_nl (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + _ -> throwError "if: expected boolean" + +kl_shen_check_byte :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_check_byte (!kl_V3943) = do !appl_0 <- kl_shen_hat + !kl_if_1 <- kl_V3943 `pseq` (appl_0 `pseq` eq kl_V3943 appl_0) + case kl_if_1 of + Atom (B (True)) -> do simpleError (Core.Types.Atom (Core.Types.Str "aborted")) + Atom (B (False)) -> do do return (Atom (B True)) + _ -> throwError "if: expected boolean" + +kl_shen_input_track :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_input_track (!kl_V3947) (!kl_V3948) (!kl_V3949) = do !appl_0 <- kl_V3947 `pseq` kl_shen_spaces kl_V3947 + !appl_1 <- kl_V3947 `pseq` kl_shen_spaces kl_V3947 + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_3 <- appl_1 `pseq` applyWrapper aw_2 [appl_1, + Core.Types.Atom (Core.Types.Str ""), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_4 <- appl_3 `pseq` cn (Core.Types.Atom (Core.Types.Str " \n")) appl_3 + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_6 <- kl_V3948 `pseq` (appl_4 `pseq` applyWrapper aw_5 [kl_V3948, + appl_4, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_7 <- appl_6 `pseq` cn (Core.Types.Atom (Core.Types.Str "> Inputs to ")) appl_6 + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_9 <- kl_V3947 `pseq` (appl_7 `pseq` applyWrapper aw_8 [kl_V3947, + appl_7, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_10 <- appl_9 `pseq` cn (Core.Types.Atom (Core.Types.Str "<")) appl_9 + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_12 <- appl_0 `pseq` (appl_10 `pseq` applyWrapper aw_11 [appl_0, + appl_10, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_13 <- appl_12 `pseq` cn (Core.Types.Atom (Core.Types.Str "\n")) appl_12 + !appl_14 <- kl_stoutput + let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_16 <- appl_13 `pseq` (appl_14 `pseq` applyWrapper aw_15 [appl_13, + appl_14]) + !appl_17 <- kl_V3949 `pseq` kl_shen_recursively_print kl_V3949 + appl_16 `pseq` (appl_17 `pseq` kl_do appl_16 appl_17) + +kl_shen_recursively_print :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_recursively_print (!kl_V3951) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V3951 `pseq` eq appl_0 kl_V3951) + case kl_if_1 of + Atom (B (True)) -> do !appl_2 <- kl_stoutput + let !aw_3 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + appl_2 `pseq` applyWrapper aw_3 [Core.Types.Atom (Core.Types.Str " ==>"), + appl_2] + Atom (B (False)) -> do let pat_cond_4 kl_V3951 kl_V3951h kl_V3951t = do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "print") + !appl_6 <- kl_V3951h `pseq` applyWrapper aw_5 [kl_V3951h] + !appl_7 <- kl_stoutput + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_9 <- appl_7 `pseq` applyWrapper aw_8 [Core.Types.Atom (Core.Types.Str ", "), + appl_7] + !appl_10 <- kl_V3951t `pseq` kl_shen_recursively_print kl_V3951t + !appl_11 <- appl_9 `pseq` (appl_10 `pseq` kl_do appl_9 appl_10) + appl_6 `pseq` (appl_11 `pseq` kl_do appl_6 appl_11) + pat_cond_12 = do do kl_shen_f_error (ApplC (wrapNamed "shen.recursively-print" kl_shen_recursively_print)) + in case kl_V3951 of + !(kl_V3951@(Cons (!kl_V3951h) + (!kl_V3951t))) -> pat_cond_4 kl_V3951 kl_V3951h kl_V3951t + _ -> pat_cond_12 + _ -> throwError "if: expected boolean" + +kl_shen_spaces :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_spaces (!kl_V3953) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.Str "")) + pat_cond_1 = do do !appl_2 <- kl_V3953 `pseq` Primitives.subtract kl_V3953 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_3 <- appl_2 `pseq` kl_shen_spaces appl_2 + appl_3 `pseq` cn (Core.Types.Atom (Core.Types.Str " ")) appl_3 + in case kl_V3953 of + kl_V3953@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_output_track :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_output_track (!kl_V3957) (!kl_V3958) (!kl_V3959) = do !appl_0 <- kl_V3957 `pseq` kl_shen_spaces kl_V3957 + !appl_1 <- kl_V3957 `pseq` kl_shen_spaces kl_V3957 + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_3 <- kl_V3959 `pseq` applyWrapper aw_2 [kl_V3959, + Core.Types.Atom (Core.Types.Str ""), + Core.Types.Atom (Core.Types.UnboundSym "shen.s")] + !appl_4 <- appl_3 `pseq` cn (Core.Types.Atom (Core.Types.Str "==> ")) appl_3 + let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_6 <- appl_1 `pseq` (appl_4 `pseq` applyWrapper aw_5 [appl_1, + appl_4, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_7 <- appl_6 `pseq` cn (Core.Types.Atom (Core.Types.Str " \n")) appl_6 + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_9 <- kl_V3958 `pseq` (appl_7 `pseq` applyWrapper aw_8 [kl_V3958, + appl_7, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_10 <- appl_9 `pseq` cn (Core.Types.Atom (Core.Types.Str "> Output from ")) appl_9 + let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_12 <- kl_V3957 `pseq` (appl_10 `pseq` applyWrapper aw_11 [kl_V3957, + appl_10, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_13 <- appl_12 `pseq` cn (Core.Types.Atom (Core.Types.Str "<")) appl_12 + let !aw_14 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_15 <- appl_0 `pseq` (appl_13 `pseq` applyWrapper aw_14 [appl_0, + appl_13, + Core.Types.Atom (Core.Types.UnboundSym "shen.a")]) + !appl_16 <- appl_15 `pseq` cn (Core.Types.Atom (Core.Types.Str "\n")) appl_15 + !appl_17 <- kl_stoutput + let !aw_18 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + appl_16 `pseq` (appl_17 `pseq` applyWrapper aw_18 [appl_16, + appl_17]) + +kl_untrack :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_untrack (!kl_V3961) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Tracking) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Tracking) -> do !appl_2 <- kl_V3961 `pseq` kl_ps kl_V3961 + appl_2 `pseq` kl_eval appl_2))) + !appl_3 <- kl_V3961 `pseq` (kl_Tracking `pseq` kl_remove kl_V3961 kl_Tracking) + !appl_4 <- appl_3 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*tracking*")) appl_3 + appl_4 `pseq` applyWrapper appl_1 [appl_4]))) + !appl_5 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*tracking*")) + appl_5 `pseq` applyWrapper appl_0 [appl_5] + +kl_profile :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_profile (!kl_V3963) = do !appl_0 <- kl_V3963 `pseq` kl_ps kl_V3963 + appl_0 `pseq` kl_shen_profile_help appl_0 + +kl_shen_profile_help :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_profile_help (!kl_V3969) = do !kl_if_0 <- let pat_cond_1 kl_V3969 kl_V3969h kl_V3969t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V3969t kl_V3969th kl_V3969tt = do !kl_if_6 <- let pat_cond_7 kl_V3969tt kl_V3969tth kl_V3969ttt = do !kl_if_8 <- let pat_cond_9 kl_V3969ttt kl_V3969ttth kl_V3969tttt = do let !appl_10 = Atom Nil + !kl_if_11 <- appl_10 `pseq` (kl_V3969tttt `pseq` eq appl_10 kl_V3969tttt) + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V3969ttt of + !(kl_V3969ttt@(Cons (!kl_V3969ttth) + (!kl_V3969tttt))) -> pat_cond_9 kl_V3969ttt kl_V3969ttth kl_V3969tttt + _ -> 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_V3969tt of + !(kl_V3969tt@(Cons (!kl_V3969tth) + (!kl_V3969ttt))) -> pat_cond_7 kl_V3969tt kl_V3969tth kl_V3969ttt + _ -> 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_V3969t of + !(kl_V3969t@(Cons (!kl_V3969th) + (!kl_V3969tt))) -> pat_cond_5 kl_V3969t kl_V3969th kl_V3969tt + _ -> 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_V3969h of + kl_V3969h@(Atom (UnboundSym "defun")) -> pat_cond_3 + kl_V3969h@(ApplC (PL "defun" + _)) -> pat_cond_3 + kl_V3969h@(ApplC (Func "defun" + _)) -> pat_cond_3 + _ -> 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_V3969 of + !(kl_V3969@(Cons (!kl_V3969h) + (!kl_V3969t))) -> pat_cond_1 kl_V3969 kl_V3969h kl_V3969t + _ -> pat_cond_16 + case kl_if_0 of + Atom (B (True)) -> do let !appl_17 = ApplC (Func "lambda" (Context (\(!kl_G) -> do let !appl_18 = ApplC (Func "lambda" (Context (\(!kl_Profile) -> do let !appl_19 = ApplC (Func "lambda" (Context (\(!kl_Def) -> do let !appl_20 = ApplC (Func "lambda" (Context (\(!kl_CompileProfile) -> do let !appl_21 = ApplC (Func "lambda" (Context (\(!kl_CompileG) -> do !appl_22 <- kl_V3969 `pseq` tl kl_V3969 + appl_22 `pseq` hd appl_22))) + !appl_23 <- kl_Def `pseq` kl_shen_eval_without_macros kl_Def + appl_23 `pseq` applyWrapper appl_21 [appl_23]))) + !appl_24 <- kl_Profile `pseq` kl_shen_eval_without_macros kl_Profile + appl_24 `pseq` applyWrapper appl_20 [appl_24]))) + !appl_25 <- kl_V3969 `pseq` tl kl_V3969 + !appl_26 <- appl_25 `pseq` tl appl_25 + !appl_27 <- appl_26 `pseq` hd appl_26 + !appl_28 <- kl_V3969 `pseq` tl kl_V3969 + !appl_29 <- appl_28 `pseq` hd appl_28 + !appl_30 <- kl_V3969 `pseq` tl kl_V3969 + !appl_31 <- appl_30 `pseq` tl appl_30 + !appl_32 <- appl_31 `pseq` tl appl_31 + !appl_33 <- appl_32 `pseq` hd appl_32 + !appl_34 <- kl_G `pseq` (appl_29 `pseq` (appl_33 `pseq` kl_subst kl_G appl_29 appl_33)) + let !appl_35 = Atom Nil + !appl_36 <- appl_34 `pseq` (appl_35 `pseq` klCons appl_34 appl_35) + !appl_37 <- appl_27 `pseq` (appl_36 `pseq` klCons appl_27 appl_36) + !appl_38 <- kl_G `pseq` (appl_37 `pseq` klCons kl_G appl_37) + !appl_39 <- appl_38 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defun")) appl_38 + appl_39 `pseq` applyWrapper appl_19 [appl_39]))) + !appl_40 <- kl_V3969 `pseq` tl kl_V3969 + !appl_41 <- appl_40 `pseq` hd appl_40 + !appl_42 <- kl_V3969 `pseq` tl kl_V3969 + !appl_43 <- appl_42 `pseq` tl appl_42 + !appl_44 <- appl_43 `pseq` hd appl_43 + !appl_45 <- kl_V3969 `pseq` tl kl_V3969 + !appl_46 <- appl_45 `pseq` hd appl_45 + !appl_47 <- kl_V3969 `pseq` tl kl_V3969 + !appl_48 <- appl_47 `pseq` tl appl_47 + !appl_49 <- appl_48 `pseq` hd appl_48 + !appl_50 <- kl_V3969 `pseq` tl kl_V3969 + !appl_51 <- appl_50 `pseq` tl appl_50 + !appl_52 <- appl_51 `pseq` hd appl_51 + !appl_53 <- kl_G `pseq` (appl_52 `pseq` klCons kl_G appl_52) + !appl_54 <- appl_46 `pseq` (appl_49 `pseq` (appl_53 `pseq` kl_shen_profile_func appl_46 appl_49 appl_53)) + let !appl_55 = Atom Nil + !appl_56 <- appl_54 `pseq` (appl_55 `pseq` klCons appl_54 appl_55) + !appl_57 <- appl_44 `pseq` (appl_56 `pseq` klCons appl_44 appl_56) + !appl_58 <- appl_41 `pseq` (appl_57 `pseq` klCons appl_41 appl_57) + !appl_59 <- appl_58 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defun")) appl_58 + appl_59 `pseq` applyWrapper appl_18 [appl_59]))) + !appl_60 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "shen.f")) + appl_60 `pseq` applyWrapper appl_17 [appl_60] + Atom (B (False)) -> do do simpleError (Core.Types.Atom (Core.Types.Str "Cannot profile.\n")) + _ -> throwError "if: expected boolean" + +kl_unprofile :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_unprofile (!kl_V3971) = do kl_V3971 `pseq` kl_untrack kl_V3971 + +kl_shen_profile_func :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_profile_func (!kl_V3975) (!kl_V3976) (!kl_V3977) = do let !appl_0 = Atom Nil + !appl_1 <- appl_0 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "run")) appl_0 + !appl_2 <- appl_1 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_1 + let !appl_3 = Atom Nil + !appl_4 <- appl_3 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "run")) appl_3 + !appl_5 <- appl_4 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_4 + let !appl_6 = Atom Nil + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Start")) appl_6 + !appl_8 <- appl_5 `pseq` (appl_7 `pseq` klCons appl_5 appl_7) + !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_8 + let !appl_10 = Atom Nil + !appl_11 <- kl_V3975 `pseq` (appl_10 `pseq` klCons kl_V3975 appl_10) + !appl_12 <- appl_11 `pseq` klCons (ApplC (wrapNamed "shen.get-profile" kl_shen_get_profile)) appl_11 + let !appl_13 = Atom Nil + !appl_14 <- appl_13 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Finish")) appl_13 + !appl_15 <- appl_12 `pseq` (appl_14 `pseq` klCons appl_12 appl_14) + !appl_16 <- appl_15 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_15 + let !appl_17 = Atom Nil + !appl_18 <- appl_16 `pseq` (appl_17 `pseq` klCons appl_16 appl_17) + !appl_19 <- kl_V3975 `pseq` (appl_18 `pseq` klCons kl_V3975 appl_18) + !appl_20 <- appl_19 `pseq` klCons (ApplC (wrapNamed "shen.put-profile" kl_shen_put_profile)) appl_19 + let !appl_21 = Atom Nil + !appl_22 <- appl_21 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_21 + !appl_23 <- appl_20 `pseq` (appl_22 `pseq` klCons appl_20 appl_22) + !appl_24 <- appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Record")) appl_23 + !appl_25 <- appl_24 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_24 + let !appl_26 = Atom Nil + !appl_27 <- appl_25 `pseq` (appl_26 `pseq` klCons appl_25 appl_26) + !appl_28 <- appl_9 `pseq` (appl_27 `pseq` klCons appl_9 appl_27) + !appl_29 <- appl_28 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Finish")) appl_28 + !appl_30 <- appl_29 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_29 + let !appl_31 = Atom Nil + !appl_32 <- appl_30 `pseq` (appl_31 `pseq` klCons appl_30 appl_31) + !appl_33 <- kl_V3977 `pseq` (appl_32 `pseq` klCons kl_V3977 appl_32) + !appl_34 <- appl_33 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_33 + !appl_35 <- appl_34 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_34 + let !appl_36 = Atom Nil + !appl_37 <- appl_35 `pseq` (appl_36 `pseq` klCons appl_35 appl_36) + !appl_38 <- appl_2 `pseq` (appl_37 `pseq` klCons appl_2 appl_37) + !appl_39 <- appl_38 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Start")) appl_38 + appl_39 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_39 + +kl_profile_results :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_profile_results (!kl_V3979) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Results) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Initialise) -> do kl_V3979 `pseq` (kl_Results `pseq` kl_Atp kl_V3979 kl_Results)))) + !appl_2 <- kl_V3979 `pseq` kl_shen_put_profile kl_V3979 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + appl_2 `pseq` applyWrapper appl_1 [appl_2]))) + !appl_3 <- kl_V3979 `pseq` kl_shen_get_profile kl_V3979 + appl_3 `pseq` applyWrapper appl_0 [appl_3] + +kl_shen_get_profile :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_get_profile (!kl_V3981) = do let !appl_0 = ApplC (PL "thunk" (do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))))) + !appl_1 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + kl_V3981 `pseq` (appl_0 `pseq` (appl_1 `pseq` kl_getDivor kl_V3981 (ApplC (wrapNamed "profile" kl_profile)) appl_0 appl_1)) + +kl_shen_put_profile :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_put_profile (!kl_V3984) (!kl_V3985) = do !appl_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) + kl_V3984 `pseq` (kl_V3985 `pseq` (appl_0 `pseq` kl_put kl_V3984 (ApplC (wrapNamed "profile" kl_profile)) kl_V3985 appl_0)) + +expr7 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr7 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*step*")) (Atom (B False))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Backend/Types.hs b/Shentong/Backend/Types.hs --- a/Shentong/Backend/Types.hs +++ b/Shentong/Backend/Types.hs @@ -1,1088 +1,1635 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} - -module Backend.Types 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 -import Backend.Core -import Backend.Sys -import Backend.Sequent -import Backend.Yacc -import Backend.Reader -import Backend.Prolog -import Backend.Track -import Backend.Load -import Backend.Writer -import Backend.Macros -import Backend.Declarations - -{- -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_declare :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_declare (!kl_V3854) (!kl_V3855) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Record) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Variancy) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Type) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_FMult) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parameters) -> do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_Clause) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_AUM_instruction) -> do let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_Code) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_ShenDef) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Eval) -> do return kl_V3854))) - !appl_10 <- kl_ShenDef `pseq` kl_shen_eval_without_macros kl_ShenDef - appl_10 `pseq` applyWrapper appl_9 [appl_10]))) - !appl_11 <- klCons (Types.Atom (Types.UnboundSym "Continuation")) (Types.Atom Types.Nil) - !appl_12 <- appl_11 `pseq` klCons (Types.Atom (Types.UnboundSym "ProcessN")) appl_11 - !appl_13 <- kl_Code `pseq` klCons kl_Code (Types.Atom Types.Nil) - !appl_14 <- appl_13 `pseq` klCons (Types.Atom (Types.UnboundSym "->")) appl_13 - !appl_15 <- appl_12 `pseq` (appl_14 `pseq` kl_append appl_12 appl_14) - !appl_16 <- kl_Parameters `pseq` (appl_15 `pseq` kl_append kl_Parameters appl_15) - !appl_17 <- kl_FMult `pseq` (appl_16 `pseq` klCons kl_FMult appl_16) - !appl_18 <- appl_17 `pseq` klCons (Types.Atom (Types.UnboundSym "define")) appl_17 - appl_18 `pseq` applyWrapper appl_8 [appl_18]))) - !appl_19 <- kl_AUM_instruction `pseq` kl_shen_aum_to_shen kl_AUM_instruction - appl_19 `pseq` applyWrapper appl_7 [appl_19]))) - !appl_20 <- kl_Clause `pseq` (kl_Parameters `pseq` kl_shen_aum kl_Clause kl_Parameters) - appl_20 `pseq` applyWrapper appl_6 [appl_20]))) - !appl_21 <- klCons (Types.Atom (Types.UnboundSym "X")) (Types.Atom Types.Nil) - !appl_22 <- kl_FMult `pseq` (appl_21 `pseq` klCons kl_FMult appl_21) - !appl_23 <- kl_Type `pseq` klCons kl_Type (Types.Atom Types.Nil) - !appl_24 <- appl_23 `pseq` klCons (Types.Atom (Types.UnboundSym "X")) appl_23 - !appl_25 <- appl_24 `pseq` klCons (ApplC (wrapNamed "unify!" kl_unifyExcl)) appl_24 - !appl_26 <- appl_25 `pseq` klCons appl_25 (Types.Atom Types.Nil) - !appl_27 <- appl_26 `pseq` klCons appl_26 (Types.Atom Types.Nil) - !appl_28 <- appl_27 `pseq` klCons (Types.Atom (Types.UnboundSym ":-")) appl_27 - !appl_29 <- appl_22 `pseq` (appl_28 `pseq` klCons appl_22 appl_28) - appl_29 `pseq` applyWrapper appl_5 [appl_29]))) - !appl_30 <- kl_shen_parameters (Types.Atom (Types.N (Types.KI 1))) - appl_30 `pseq` applyWrapper appl_4 [appl_30]))) - !appl_31 <- kl_V3854 `pseq` kl_concat (Types.Atom (Types.UnboundSym "shen.type-signature-of-")) kl_V3854 - appl_31 `pseq` applyWrapper appl_3 [appl_31]))) - !appl_32 <- kl_V3855 `pseq` kl_shen_demodulate kl_V3855 - !appl_33 <- appl_32 `pseq` kl_shen_rcons_form appl_32 - appl_33 `pseq` applyWrapper appl_2 [appl_33]))) - !appl_34 <- (do kl_V3854 `pseq` (kl_V3855 `pseq` kl_shen_variancy_test kl_V3854 kl_V3855)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.UnboundSym "shen.skip"))) - appl_34 `pseq` applyWrapper appl_1 [appl_34]))) - !appl_35 <- kl_V3854 `pseq` (kl_V3855 `pseq` klCons kl_V3854 kl_V3855) - !appl_36 <- value (Types.Atom (Types.UnboundSym "shen.*signedfuncs*")) - !appl_37 <- appl_35 `pseq` (appl_36 `pseq` klCons appl_35 appl_36) - !appl_38 <- appl_37 `pseq` klSet (Types.Atom (Types.UnboundSym "shen.*signedfuncs*")) appl_37 - appl_38 `pseq` applyWrapper appl_0 [appl_38] - -kl_shen_demodulate :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_demodulate (!kl_V3857) = do (do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Demod) -> do !kl_if_1 <- kl_Demod `pseq` (kl_V3857 `pseq` eq kl_Demod kl_V3857) - case kl_if_1 of - Atom (B (True)) -> do return kl_V3857 - Atom (B (False)) -> do do kl_Demod `pseq` kl_shen_demodulate kl_Demod - _ -> throwError "if: expected boolean"))) - let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do let !aw_3 = Types.Atom (Types.UnboundSym "shen.demod") - kl_Y `pseq` applyWrapper aw_3 [kl_Y]))) - !appl_4 <- appl_2 `pseq` (kl_V3857 `pseq` kl_shen_walk appl_2 kl_V3857) - appl_4 `pseq` applyWrapper appl_0 [appl_4]) `catchError` (\(!kl_E) -> do return kl_V3857) - -kl_shen_variancy_test :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_variancy_test (!kl_V3860) (!kl_V3861) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_TypeF) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Check) -> do return (Types.Atom (Types.UnboundSym "shen.skip"))))) - !appl_2 <- let pat_cond_3 = do return (Types.Atom (Types.UnboundSym "shen.skip")) - pat_cond_4 = do do !kl_if_5 <- kl_TypeF `pseq` (kl_V3861 `pseq` kl_shen_variantP kl_TypeF kl_V3861) - case kl_if_5 of - Atom (B (True)) -> do return (Types.Atom (Types.UnboundSym "shen.skip")) - Atom (B (False)) -> do do !appl_6 <- kl_V3860 `pseq` kl_shen_app kl_V3860 (Types.Atom (Types.Str " may create errors\n")) (Types.Atom (Types.UnboundSym "shen.a")) - !appl_7 <- appl_6 `pseq` cn (Types.Atom (Types.Str "warning: changing the type of ")) appl_6 - !appl_8 <- kl_stoutput - appl_7 `pseq` (appl_8 `pseq` kl_shen_prhush appl_7 appl_8) - _ -> throwError "if: expected boolean" - in case kl_TypeF of - kl_TypeF@(Atom (UnboundSym "symbol")) -> pat_cond_3 - kl_TypeF@(ApplC (PL "symbol" - _)) -> pat_cond_3 - kl_TypeF@(ApplC (Func "symbol" - _)) -> pat_cond_3 - _ -> pat_cond_4 - appl_2 `pseq` applyWrapper appl_1 [appl_2]))) - let !aw_9 = Types.Atom (Types.UnboundSym "shen.typecheck") - !appl_10 <- kl_V3860 `pseq` applyWrapper aw_9 [kl_V3860, - Types.Atom (Types.UnboundSym "B")] - appl_10 `pseq` applyWrapper appl_0 [appl_10] - -kl_shen_variantP :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_variantP (!kl_V3874) (!kl_V3875) = do !kl_if_0 <- kl_V3875 `pseq` (kl_V3874 `pseq` eq kl_V3875 kl_V3874) - case kl_if_0 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do !kl_if_1 <- let pat_cond_2 kl_V3874 kl_V3874h kl_V3874t = do let pat_cond_3 kl_V3875 kl_V3875h kl_V3875t = do return (Atom (B True)) - pat_cond_4 = do do return (Atom (B False)) - in case kl_V3875 of - !(kl_V3875@(Cons (!kl_V3875h) - (!kl_V3875t))) | eqCore kl_V3875h kl_V3874h -> pat_cond_3 kl_V3875 kl_V3875h kl_V3875t - _ -> pat_cond_4 - pat_cond_5 = do do return (Atom (B False)) - in case kl_V3874 of - !(kl_V3874@(Cons (!kl_V3874h) - (!kl_V3874t))) -> pat_cond_2 kl_V3874 kl_V3874h kl_V3874t - _ -> pat_cond_5 - case kl_if_1 of - Atom (B (True)) -> do !appl_6 <- kl_V3874 `pseq` tl kl_V3874 - !appl_7 <- kl_V3875 `pseq` tl kl_V3875 - appl_6 `pseq` (appl_7 `pseq` kl_shen_variantP appl_6 appl_7) - Atom (B (False)) -> do !kl_if_8 <- let pat_cond_9 kl_V3874 kl_V3874h kl_V3874t = do !kl_if_10 <- let pat_cond_11 kl_V3875 kl_V3875h kl_V3875t = do !kl_if_12 <- kl_V3874h `pseq` kl_shen_pvarP kl_V3874h - !kl_if_13 <- case kl_if_12 of - Atom (B (True)) -> do !kl_if_14 <- kl_V3875h `pseq` kl_variableP kl_V3875h - case kl_if_14 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_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_15 = do do return (Atom (B False)) - in case kl_V3875 of - !(kl_V3875@(Cons (!kl_V3875h) - (!kl_V3875t))) -> pat_cond_11 kl_V3875 kl_V3875h kl_V3875t - _ -> pat_cond_15 - case kl_if_10 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_16 = do do return (Atom (B False)) - in case kl_V3874 of - !(kl_V3874@(Cons (!kl_V3874h) - (!kl_V3874t))) -> pat_cond_9 kl_V3874 kl_V3874h kl_V3874t - _ -> pat_cond_16 - case kl_if_8 of - Atom (B (True)) -> do !appl_17 <- kl_V3874 `pseq` hd kl_V3874 - !appl_18 <- kl_V3874 `pseq` tl kl_V3874 - !appl_19 <- appl_17 `pseq` (appl_18 `pseq` kl_subst (Types.Atom (Types.UnboundSym "shen.a")) appl_17 appl_18) - !appl_20 <- kl_V3875 `pseq` hd kl_V3875 - !appl_21 <- kl_V3875 `pseq` tl kl_V3875 - !appl_22 <- appl_20 `pseq` (appl_21 `pseq` kl_subst (Types.Atom (Types.UnboundSym "shen.a")) appl_20 appl_21) - appl_19 `pseq` (appl_22 `pseq` kl_shen_variantP appl_19 appl_22) - Atom (B (False)) -> do !kl_if_23 <- let pat_cond_24 kl_V3874 kl_V3874h kl_V3874t = do !kl_if_25 <- let pat_cond_26 kl_V3874h kl_V3874hh kl_V3874ht = do let pat_cond_27 kl_V3875 kl_V3875h kl_V3875hh kl_V3875ht kl_V3875t = do return (Atom (B True)) - pat_cond_28 = do do return (Atom (B False)) - in case kl_V3875 of - !(kl_V3875@(Cons (!(kl_V3875h@(Cons (!kl_V3875hh) - (!kl_V3875ht)))) - (!kl_V3875t))) -> pat_cond_27 kl_V3875 kl_V3875h kl_V3875hh kl_V3875ht kl_V3875t - _ -> pat_cond_28 - pat_cond_29 = do do return (Atom (B False)) - in case kl_V3874h of - !(kl_V3874h@(Cons (!kl_V3874hh) - (!kl_V3874ht))) -> pat_cond_26 kl_V3874h kl_V3874hh kl_V3874ht - _ -> pat_cond_29 - 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_30 = do do return (Atom (B False)) - in case kl_V3874 of - !(kl_V3874@(Cons (!kl_V3874h) - (!kl_V3874t))) -> pat_cond_24 kl_V3874 kl_V3874h kl_V3874t - _ -> pat_cond_30 - case kl_if_23 of - Atom (B (True)) -> do !appl_31 <- kl_V3874 `pseq` hd kl_V3874 - !appl_32 <- kl_V3874 `pseq` tl kl_V3874 - !appl_33 <- appl_31 `pseq` (appl_32 `pseq` kl_append appl_31 appl_32) - !appl_34 <- kl_V3875 `pseq` hd kl_V3875 - !appl_35 <- kl_V3875 `pseq` tl kl_V3875 - !appl_36 <- appl_34 `pseq` (appl_35 `pseq` kl_append appl_34 appl_35) - appl_33 `pseq` (appl_36 `pseq` kl_shen_variantP appl_33 appl_36) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - -expr12 :: Types.KLContext Types.Env Types.KLValue -expr12 = 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"))) - (do !appl_0 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_1 <- appl_0 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_0 - !appl_2 <- appl_1 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_1 - appl_2 `pseq` kl_declare (ApplC (wrapNamed "absvector?" absvectorP)) appl_2) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_3 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_4 <- appl_3 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_3 - !appl_5 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_5 - !appl_7 <- appl_6 `pseq` klCons appl_6 (Types.Atom Types.Nil) - !appl_8 <- appl_7 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_7 - !appl_9 <- appl_4 `pseq` (appl_8 `pseq` klCons appl_4 appl_8) - !appl_10 <- appl_9 `pseq` klCons appl_9 (Types.Atom Types.Nil) - !appl_11 <- appl_10 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_10 - !appl_12 <- appl_11 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_11 - appl_12 `pseq` kl_declare (ApplC (wrapNamed "adjoin" kl_adjoin)) appl_12) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_13 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_14 <- appl_13 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_13 - !appl_15 <- appl_14 `pseq` klCons (Types.Atom (Types.UnboundSym "boolean")) appl_14 - !appl_16 <- appl_15 `pseq` klCons appl_15 (Types.Atom Types.Nil) - !appl_17 <- appl_16 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_16 - !appl_18 <- appl_17 `pseq` klCons (Types.Atom (Types.UnboundSym "boolean")) appl_17 - appl_18 `pseq` kl_declare (Types.Atom (Types.UnboundSym "and")) appl_18) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_19 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_20 <- appl_19 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_19 - !appl_21 <- appl_20 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_20 - !appl_22 <- appl_21 `pseq` klCons appl_21 (Types.Atom Types.Nil) - !appl_23 <- appl_22 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_22 - !appl_24 <- appl_23 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_23 - !appl_25 <- appl_24 `pseq` klCons appl_24 (Types.Atom Types.Nil) - !appl_26 <- appl_25 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_25 - !appl_27 <- appl_26 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_26 - appl_27 `pseq` kl_declare (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_27) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_28 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_29 <- appl_28 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_28 - !appl_30 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_31 <- appl_30 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_30 - !appl_32 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_33 <- appl_32 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_32 - !appl_34 <- appl_33 `pseq` klCons appl_33 (Types.Atom Types.Nil) - !appl_35 <- appl_34 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_34 - !appl_36 <- appl_31 `pseq` (appl_35 `pseq` klCons appl_31 appl_35) - !appl_37 <- appl_36 `pseq` klCons appl_36 (Types.Atom Types.Nil) - !appl_38 <- appl_37 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_37 - !appl_39 <- appl_29 `pseq` (appl_38 `pseq` klCons appl_29 appl_38) - appl_39 `pseq` kl_declare (ApplC (wrapNamed "append" kl_append)) appl_39) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_40 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_41 <- appl_40 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_40 - !appl_42 <- appl_41 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_41 - appl_42 `pseq` kl_declare (ApplC (wrapNamed "arity" kl_arity)) appl_42) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_43 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_44 <- appl_43 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_43 - !appl_45 <- appl_44 `pseq` klCons appl_44 (Types.Atom Types.Nil) - !appl_46 <- appl_45 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_45 - !appl_47 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_48 <- appl_47 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_47 - !appl_49 <- appl_48 `pseq` klCons appl_48 (Types.Atom Types.Nil) - !appl_50 <- appl_49 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_49 - !appl_51 <- appl_46 `pseq` (appl_50 `pseq` klCons appl_46 appl_50) - !appl_52 <- appl_51 `pseq` klCons appl_51 (Types.Atom Types.Nil) - !appl_53 <- appl_52 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_52 - !appl_54 <- appl_53 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_53 - appl_54 `pseq` kl_declare (ApplC (wrapNamed "assoc" kl_assoc)) appl_54) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_55 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_56 <- appl_55 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_55 - !appl_57 <- appl_56 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_56 - appl_57 `pseq` kl_declare (ApplC (wrapNamed "boolean?" kl_booleanP)) appl_57) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_58 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_59 <- appl_58 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_58 - !appl_60 <- appl_59 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_59 - appl_60 `pseq` kl_declare (ApplC (wrapNamed "bound?" kl_boundP)) appl_60) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_61 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_62 <- appl_61 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_61 - !appl_63 <- appl_62 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_62 - appl_63 `pseq` kl_declare (ApplC (wrapNamed "cd" kl_cd)) appl_63) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_64 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_65 <- appl_64 `pseq` klCons (Types.Atom (Types.UnboundSym "stream")) appl_64 - !appl_66 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_67 <- appl_66 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_66 - !appl_68 <- appl_67 `pseq` klCons appl_67 (Types.Atom Types.Nil) - !appl_69 <- appl_68 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_68 - !appl_70 <- appl_65 `pseq` (appl_69 `pseq` klCons appl_65 appl_69) - appl_70 `pseq` kl_declare (ApplC (wrapNamed "close" closeStream)) appl_70) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_71 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_72 <- appl_71 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_71 - !appl_73 <- appl_72 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_72 - !appl_74 <- appl_73 `pseq` klCons appl_73 (Types.Atom Types.Nil) - !appl_75 <- appl_74 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_74 - !appl_76 <- appl_75 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_75 - appl_76 `pseq` kl_declare (ApplC (wrapNamed "cn" cn)) appl_76) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_77 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_78 <- appl_77 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.==>")) appl_77 - !appl_79 <- appl_78 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_78 - !appl_80 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_81 <- appl_80 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_80 - !appl_82 <- appl_81 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_81 - !appl_83 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_84 <- appl_83 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_83 - !appl_85 <- appl_82 `pseq` (appl_84 `pseq` klCons appl_82 appl_84) - !appl_86 <- appl_85 `pseq` klCons appl_85 (Types.Atom Types.Nil) - !appl_87 <- appl_86 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_86 - !appl_88 <- appl_87 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_87 - !appl_89 <- appl_88 `pseq` klCons appl_88 (Types.Atom Types.Nil) - !appl_90 <- appl_89 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_89 - !appl_91 <- appl_79 `pseq` (appl_90 `pseq` klCons appl_79 appl_90) - appl_91 `pseq` kl_declare (ApplC (wrapNamed "compile" kl_compile)) appl_91) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_92 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_93 <- appl_92 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_92 - !appl_94 <- appl_93 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_93 - appl_94 `pseq` kl_declare (ApplC (wrapNamed "cons?" consP)) appl_94) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_95 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_96 <- appl_95 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_95 - !appl_97 <- appl_96 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_96 - !appl_98 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_99 <- appl_98 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_98 - !appl_100 <- appl_97 `pseq` (appl_99 `pseq` klCons appl_97 appl_99) - appl_100 `pseq` kl_declare (ApplC (wrapNamed "destroy" kl_destroy)) appl_100) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_101 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_102 <- appl_101 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_101 - !appl_103 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_104 <- appl_103 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_103 - !appl_105 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_106 <- appl_105 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_105 - !appl_107 <- appl_106 `pseq` klCons appl_106 (Types.Atom Types.Nil) - !appl_108 <- appl_107 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_107 - !appl_109 <- appl_104 `pseq` (appl_108 `pseq` klCons appl_104 appl_108) - !appl_110 <- appl_109 `pseq` klCons appl_109 (Types.Atom Types.Nil) - !appl_111 <- appl_110 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_110 - !appl_112 <- appl_102 `pseq` (appl_111 `pseq` klCons appl_102 appl_111) - appl_112 `pseq` kl_declare (ApplC (wrapNamed "difference" kl_difference)) appl_112) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_113 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_114 <- appl_113 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_113 - !appl_115 <- appl_114 `pseq` klCons (Types.Atom (Types.UnboundSym "B")) appl_114 - !appl_116 <- appl_115 `pseq` klCons appl_115 (Types.Atom Types.Nil) - !appl_117 <- appl_116 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_116 - !appl_118 <- appl_117 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_117 - appl_118 `pseq` kl_declare (ApplC (wrapNamed "do" kl_do)) appl_118) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_119 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_120 <- appl_119 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_119 - !appl_121 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_122 <- appl_121 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_121 - !appl_123 <- appl_122 `pseq` klCons appl_122 (Types.Atom Types.Nil) - !appl_124 <- appl_123 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.==>")) appl_123 - !appl_125 <- appl_120 `pseq` (appl_124 `pseq` klCons appl_120 appl_124) - appl_125 `pseq` kl_declare (ApplC (wrapNamed "" kl_LBeRB)) appl_125) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_126 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_127 <- appl_126 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_126 - !appl_128 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_129 <- appl_128 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_128 - !appl_130 <- appl_129 `pseq` klCons appl_129 (Types.Atom Types.Nil) - !appl_131 <- appl_130 `pseq` klCons (Types.Atom (Types.UnboundSym "shen.==>")) appl_130 - !appl_132 <- appl_127 `pseq` (appl_131 `pseq` klCons appl_127 appl_131) - appl_132 `pseq` kl_declare (ApplC (wrapNamed "shen." kl_shen_LBExclRB)) appl_132) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_133 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_134 <- appl_133 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_133 - !appl_135 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_136 <- appl_135 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_135 - !appl_137 <- appl_134 `pseq` (appl_136 `pseq` klCons appl_134 appl_136) - !appl_138 <- appl_137 `pseq` klCons appl_137 (Types.Atom Types.Nil) - !appl_139 <- appl_138 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_138 - !appl_140 <- appl_139 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_139 - appl_140 `pseq` kl_declare (ApplC (wrapNamed "element?" kl_elementP)) appl_140) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_141 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_142 <- appl_141 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_141 - !appl_143 <- appl_142 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_142 - appl_143 `pseq` kl_declare (ApplC (wrapNamed "empty?" kl_emptyP)) appl_143) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_144 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_145 <- appl_144 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_144 - !appl_146 <- appl_145 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_145 - appl_146 `pseq` kl_declare (Types.Atom (Types.UnboundSym "enable-type-theory")) appl_146) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_147 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_148 <- appl_147 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_147 - !appl_149 <- appl_148 `pseq` klCons appl_148 (Types.Atom Types.Nil) - !appl_150 <- appl_149 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_149 - !appl_151 <- appl_150 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_150 - appl_151 `pseq` kl_declare (ApplC (wrapNamed "external" kl_external)) appl_151) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_152 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_153 <- appl_152 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_152 - !appl_154 <- appl_153 `pseq` klCons (Types.Atom (Types.UnboundSym "exception")) appl_153 - appl_154 `pseq` kl_declare (ApplC (wrapNamed "error-to-string" errorToString)) appl_154) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_155 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_156 <- appl_155 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_155 - !appl_157 <- appl_156 `pseq` klCons appl_156 (Types.Atom Types.Nil) - !appl_158 <- appl_157 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_157 - !appl_159 <- appl_158 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_158 - appl_159 `pseq` kl_declare (ApplC (wrapNamed "explode" kl_explode)) appl_159) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_160 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_161 <- appl_160 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_160 - appl_161 `pseq` kl_declare (ApplC (PL "fail" kl_fail)) appl_161) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_162 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_163 <- appl_162 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_162 - !appl_164 <- appl_163 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_163 - !appl_165 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_166 <- appl_165 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_165 - !appl_167 <- appl_166 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_166 - !appl_168 <- appl_167 `pseq` klCons appl_167 (Types.Atom Types.Nil) - !appl_169 <- appl_168 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_168 - !appl_170 <- appl_164 `pseq` (appl_169 `pseq` klCons appl_164 appl_169) - appl_170 `pseq` kl_declare (ApplC (wrapNamed "fail-if" kl_fail_if)) appl_170) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_171 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_172 <- appl_171 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_171 - !appl_173 <- appl_172 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_172 - !appl_174 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_175 <- appl_174 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_174 - !appl_176 <- appl_175 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_175 - !appl_177 <- appl_176 `pseq` klCons appl_176 (Types.Atom Types.Nil) - !appl_178 <- appl_177 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_177 - !appl_179 <- appl_173 `pseq` (appl_178 `pseq` klCons appl_173 appl_178) - appl_179 `pseq` kl_declare (ApplC (wrapNamed "fix" kl_fix)) appl_179) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_180 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_181 <- appl_180 `pseq` klCons (Types.Atom (Types.UnboundSym "lazy")) appl_180 - !appl_182 <- appl_181 `pseq` klCons appl_181 (Types.Atom Types.Nil) - !appl_183 <- appl_182 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_182 - !appl_184 <- appl_183 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_183 - appl_184 `pseq` kl_declare (Types.Atom (Types.UnboundSym "freeze")) appl_184) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_185 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_186 <- appl_185 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_185 - !appl_187 <- appl_186 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_186 - !appl_188 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_189 <- appl_188 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_188 - !appl_190 <- appl_187 `pseq` (appl_189 `pseq` klCons appl_187 appl_189) - appl_190 `pseq` kl_declare (ApplC (wrapNamed "fst" kl_fst)) appl_190) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_191 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_192 <- appl_191 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_191 - !appl_193 <- appl_192 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_192 - !appl_194 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_195 <- appl_194 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_194 - !appl_196 <- appl_195 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_195 - !appl_197 <- appl_196 `pseq` klCons appl_196 (Types.Atom Types.Nil) - !appl_198 <- appl_197 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_197 - !appl_199 <- appl_193 `pseq` (appl_198 `pseq` klCons appl_193 appl_198) - appl_199 `pseq` kl_declare (ApplC (wrapNamed "function" kl_function)) appl_199) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_200 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_201 <- appl_200 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_200 - !appl_202 <- appl_201 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_201 - appl_202 `pseq` kl_declare (ApplC (wrapNamed "gensym" kl_gensym)) appl_202) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_203 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_204 <- appl_203 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_203 - !appl_205 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_206 <- appl_205 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_205 - !appl_207 <- appl_206 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_206 - !appl_208 <- appl_207 `pseq` klCons appl_207 (Types.Atom Types.Nil) - !appl_209 <- appl_208 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_208 - !appl_210 <- appl_204 `pseq` (appl_209 `pseq` klCons appl_204 appl_209) - appl_210 `pseq` kl_declare (ApplC (wrapNamed "<-vector" kl_LB_vector)) appl_210) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_211 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_212 <- appl_211 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_211 - !appl_213 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_214 <- appl_213 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_213 - !appl_215 <- appl_214 `pseq` klCons appl_214 (Types.Atom Types.Nil) - !appl_216 <- appl_215 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_215 - !appl_217 <- appl_216 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_216 - !appl_218 <- appl_217 `pseq` klCons appl_217 (Types.Atom Types.Nil) - !appl_219 <- appl_218 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_218 - !appl_220 <- appl_219 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_219 - !appl_221 <- appl_220 `pseq` klCons appl_220 (Types.Atom Types.Nil) - !appl_222 <- appl_221 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_221 - !appl_223 <- appl_212 `pseq` (appl_222 `pseq` klCons appl_212 appl_222) - appl_223 `pseq` kl_declare (ApplC (wrapNamed "vector->" kl_vector_RB)) appl_223) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_224 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_225 <- appl_224 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_224 - !appl_226 <- appl_225 `pseq` klCons appl_225 (Types.Atom Types.Nil) - !appl_227 <- appl_226 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_226 - !appl_228 <- appl_227 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_227 - appl_228 `pseq` kl_declare (ApplC (wrapNamed "vector" kl_vector)) appl_228) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_229 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_230 <- appl_229 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_229 - !appl_231 <- appl_230 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_230 - appl_231 `pseq` kl_declare (ApplC (wrapNamed "get-time" getTime)) appl_231) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_232 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_233 <- appl_232 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_232 - !appl_234 <- appl_233 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_233 - !appl_235 <- appl_234 `pseq` klCons appl_234 (Types.Atom Types.Nil) - !appl_236 <- appl_235 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_235 - !appl_237 <- appl_236 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_236 - appl_237 `pseq` kl_declare (ApplC (wrapNamed "hash" kl_hash)) appl_237) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_238 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_239 <- appl_238 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_238 - !appl_240 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_241 <- appl_240 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_240 - !appl_242 <- appl_239 `pseq` (appl_241 `pseq` klCons appl_239 appl_241) - appl_242 `pseq` kl_declare (ApplC (wrapNamed "head" kl_head)) appl_242) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_243 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_244 <- appl_243 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_243 - !appl_245 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_246 <- appl_245 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_245 - !appl_247 <- appl_244 `pseq` (appl_246 `pseq` klCons appl_244 appl_246) - appl_247 `pseq` kl_declare (ApplC (wrapNamed "hdv" kl_hdv)) appl_247) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_248 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_249 <- appl_248 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_248 - !appl_250 <- appl_249 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_249 - appl_250 `pseq` kl_declare (ApplC (wrapNamed "hdstr" kl_hdstr)) appl_250) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_251 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_252 <- appl_251 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_251 - !appl_253 <- appl_252 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_252 - !appl_254 <- appl_253 `pseq` klCons appl_253 (Types.Atom Types.Nil) - !appl_255 <- appl_254 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_254 - !appl_256 <- appl_255 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_255 - !appl_257 <- appl_256 `pseq` klCons appl_256 (Types.Atom Types.Nil) - !appl_258 <- appl_257 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_257 - !appl_259 <- appl_258 `pseq` klCons (Types.Atom (Types.UnboundSym "boolean")) appl_258 - appl_259 `pseq` kl_declare (Types.Atom (Types.UnboundSym "if")) appl_259) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_260 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_261 <- appl_260 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_260 - appl_261 `pseq` kl_declare (ApplC (PL "it" kl_it)) appl_261) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_262 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_263 <- appl_262 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_262 - appl_263 `pseq` kl_declare (ApplC (PL "implementation" kl_implementation)) appl_263) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_264 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_265 <- appl_264 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_264 - !appl_266 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_267 <- appl_266 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_266 - !appl_268 <- appl_267 `pseq` klCons appl_267 (Types.Atom Types.Nil) - !appl_269 <- appl_268 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_268 - !appl_270 <- appl_265 `pseq` (appl_269 `pseq` klCons appl_265 appl_269) - appl_270 `pseq` kl_declare (ApplC (wrapNamed "include" kl_include)) appl_270) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_271 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_272 <- appl_271 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_271 - !appl_273 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_274 <- appl_273 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_273 - !appl_275 <- appl_274 `pseq` klCons appl_274 (Types.Atom Types.Nil) - !appl_276 <- appl_275 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_275 - !appl_277 <- appl_272 `pseq` (appl_276 `pseq` klCons appl_272 appl_276) - appl_277 `pseq` kl_declare (ApplC (wrapNamed "include-all-but" kl_include_all_but)) appl_277) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_278 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_279 <- appl_278 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_278 - appl_279 `pseq` kl_declare (ApplC (PL "inferences" kl_inferences)) appl_279) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_280 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_281 <- appl_280 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_280 - !appl_282 <- appl_281 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_281 - !appl_283 <- appl_282 `pseq` klCons appl_282 (Types.Atom Types.Nil) - !appl_284 <- appl_283 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_283 - !appl_285 <- appl_284 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_284 - appl_285 `pseq` kl_declare (ApplC (wrapNamed "shen.insert" kl_shen_insert)) appl_285) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_286 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_287 <- appl_286 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_286 - !appl_288 <- appl_287 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_287 - appl_288 `pseq` kl_declare (ApplC (wrapNamed "integer?" kl_integerP)) appl_288) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_289 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_290 <- appl_289 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_289 - !appl_291 <- appl_290 `pseq` klCons appl_290 (Types.Atom Types.Nil) - !appl_292 <- appl_291 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_291 - !appl_293 <- appl_292 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_292 - appl_293 `pseq` kl_declare (ApplC (wrapNamed "internal" kl_internal)) appl_293) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_294 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_295 <- appl_294 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_294 - !appl_296 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_297 <- appl_296 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_296 - !appl_298 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_299 <- appl_298 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_298 - !appl_300 <- appl_299 `pseq` klCons appl_299 (Types.Atom Types.Nil) - !appl_301 <- appl_300 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_300 - !appl_302 <- appl_297 `pseq` (appl_301 `pseq` klCons appl_297 appl_301) - !appl_303 <- appl_302 `pseq` klCons appl_302 (Types.Atom Types.Nil) - !appl_304 <- appl_303 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_303 - !appl_305 <- appl_295 `pseq` (appl_304 `pseq` klCons appl_295 appl_304) - appl_305 `pseq` kl_declare (ApplC (wrapNamed "intersection" kl_intersection)) appl_305) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_306 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_307 <- appl_306 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_306 - appl_307 `pseq` kl_declare (ApplC (PL "kill" kl_kill)) appl_307) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_308 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_309 <- appl_308 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_308 - appl_309 `pseq` kl_declare (ApplC (PL "language" kl_language)) appl_309) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_310 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_311 <- appl_310 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_310 - !appl_312 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_313 <- appl_312 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_312 - !appl_314 <- appl_311 `pseq` (appl_313 `pseq` klCons appl_311 appl_313) - appl_314 `pseq` kl_declare (ApplC (wrapNamed "length" kl_length)) appl_314) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_315 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_316 <- appl_315 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_315 - !appl_317 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_318 <- appl_317 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_317 - !appl_319 <- appl_316 `pseq` (appl_318 `pseq` klCons appl_316 appl_318) - appl_319 `pseq` kl_declare (ApplC (wrapNamed "limit" kl_limit)) appl_319) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_320 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_321 <- appl_320 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_320 - !appl_322 <- appl_321 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_321 - appl_322 `pseq` kl_declare (ApplC (wrapNamed "load" kl_load)) appl_322) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_323 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_324 <- appl_323 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_323 - !appl_325 <- appl_324 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_324 - !appl_326 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_327 <- appl_326 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_326 - !appl_328 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_329 <- appl_328 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_328 - !appl_330 <- appl_329 `pseq` klCons appl_329 (Types.Atom Types.Nil) - !appl_331 <- appl_330 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_330 - !appl_332 <- appl_327 `pseq` (appl_331 `pseq` klCons appl_327 appl_331) - !appl_333 <- appl_332 `pseq` klCons appl_332 (Types.Atom Types.Nil) - !appl_334 <- appl_333 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_333 - !appl_335 <- appl_325 `pseq` (appl_334 `pseq` klCons appl_325 appl_334) - appl_335 `pseq` kl_declare (ApplC (wrapNamed "map" kl_map)) appl_335) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_336 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_337 <- appl_336 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_336 - !appl_338 <- appl_337 `pseq` klCons appl_337 (Types.Atom Types.Nil) - !appl_339 <- appl_338 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_338 - !appl_340 <- appl_339 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_339 - !appl_341 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_342 <- appl_341 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_341 - !appl_343 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_344 <- appl_343 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_343 - !appl_345 <- appl_344 `pseq` klCons appl_344 (Types.Atom Types.Nil) - !appl_346 <- appl_345 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_345 - !appl_347 <- appl_342 `pseq` (appl_346 `pseq` klCons appl_342 appl_346) - !appl_348 <- appl_347 `pseq` klCons appl_347 (Types.Atom Types.Nil) - !appl_349 <- appl_348 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_348 - !appl_350 <- appl_340 `pseq` (appl_349 `pseq` klCons appl_340 appl_349) - appl_350 `pseq` kl_declare (ApplC (wrapNamed "mapcan" kl_mapcan)) appl_350) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_351 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_352 <- appl_351 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_351 - !appl_353 <- appl_352 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_352 - appl_353 `pseq` kl_declare (ApplC (wrapNamed "maxinferences" kl_maxinferences)) appl_353) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_354 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_355 <- appl_354 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_354 - !appl_356 <- appl_355 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_355 - appl_356 `pseq` kl_declare (ApplC (wrapNamed "n->string" nToString)) appl_356) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_357 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_358 <- appl_357 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_357 - !appl_359 <- appl_358 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_358 - appl_359 `pseq` kl_declare (ApplC (wrapNamed "nl" kl_nl)) appl_359) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_360 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_361 <- appl_360 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_360 - !appl_362 <- appl_361 `pseq` klCons (Types.Atom (Types.UnboundSym "boolean")) appl_361 - appl_362 `pseq` kl_declare (ApplC (wrapNamed "not" kl_not)) appl_362) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_363 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_364 <- appl_363 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_363 - !appl_365 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_366 <- appl_365 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_365 - !appl_367 <- appl_364 `pseq` (appl_366 `pseq` klCons appl_364 appl_366) - !appl_368 <- appl_367 `pseq` klCons appl_367 (Types.Atom Types.Nil) - !appl_369 <- appl_368 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_368 - !appl_370 <- appl_369 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_369 - appl_370 `pseq` kl_declare (ApplC (wrapNamed "nth" kl_nth)) appl_370) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_371 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_372 <- appl_371 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_371 - !appl_373 <- appl_372 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_372 - appl_373 `pseq` kl_declare (ApplC (wrapNamed "number?" numberP)) appl_373) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_374 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_375 <- appl_374 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_374 - !appl_376 <- appl_375 `pseq` klCons (Types.Atom (Types.UnboundSym "B")) appl_375 - !appl_377 <- appl_376 `pseq` klCons appl_376 (Types.Atom Types.Nil) - !appl_378 <- appl_377 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_377 - !appl_379 <- appl_378 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_378 - appl_379 `pseq` kl_declare (ApplC (wrapNamed "occurrences" kl_occurrences)) appl_379) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_380 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_381 <- appl_380 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_380 - !appl_382 <- appl_381 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_381 - appl_382 `pseq` kl_declare (ApplC (wrapNamed "occurs-check" kl_occurs_check)) appl_382) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_383 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_384 <- appl_383 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_383 - !appl_385 <- appl_384 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_384 - appl_385 `pseq` kl_declare (ApplC (wrapNamed "optimise" kl_optimise)) appl_385) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_386 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_387 <- appl_386 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_386 - !appl_388 <- appl_387 `pseq` klCons (Types.Atom (Types.UnboundSym "boolean")) appl_387 - !appl_389 <- appl_388 `pseq` klCons appl_388 (Types.Atom Types.Nil) - !appl_390 <- appl_389 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_389 - !appl_391 <- appl_390 `pseq` klCons (Types.Atom (Types.UnboundSym "boolean")) appl_390 - appl_391 `pseq` kl_declare (Types.Atom (Types.UnboundSym "or")) appl_391) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_392 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_393 <- appl_392 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_392 - appl_393 `pseq` kl_declare (ApplC (PL "os" kl_os)) appl_393) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_394 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_395 <- appl_394 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_394 - !appl_396 <- appl_395 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_395 - appl_396 `pseq` kl_declare (ApplC (wrapNamed "package?" kl_packageP)) appl_396) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_397 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_398 <- appl_397 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_397 - appl_398 `pseq` kl_declare (ApplC (PL "port" kl_port)) appl_398) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_399 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_400 <- appl_399 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_399 - appl_400 `pseq` kl_declare (ApplC (PL "porters" kl_porters)) appl_400) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_401 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_402 <- appl_401 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_401 - !appl_403 <- appl_402 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_402 - !appl_404 <- appl_403 `pseq` klCons appl_403 (Types.Atom Types.Nil) - !appl_405 <- appl_404 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_404 - !appl_406 <- appl_405 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_405 - appl_406 `pseq` kl_declare (ApplC (wrapNamed "pos" pos)) appl_406) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_407 <- klCons (Types.Atom (Types.UnboundSym "out")) (Types.Atom Types.Nil) - !appl_408 <- appl_407 `pseq` klCons (Types.Atom (Types.UnboundSym "stream")) appl_407 - !appl_409 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_410 <- appl_409 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_409 - !appl_411 <- appl_408 `pseq` (appl_410 `pseq` klCons appl_408 appl_410) - !appl_412 <- appl_411 `pseq` klCons appl_411 (Types.Atom Types.Nil) - !appl_413 <- appl_412 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_412 - !appl_414 <- appl_413 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_413 - appl_414 `pseq` kl_declare (ApplC (wrapNamed "pr" kl_pr)) appl_414) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_415 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_416 <- appl_415 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_415 - !appl_417 <- appl_416 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_416 - appl_417 `pseq` kl_declare (ApplC (wrapNamed "print" kl_print)) appl_417) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_418 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_419 <- appl_418 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_418 - !appl_420 <- appl_419 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_419 - !appl_421 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_422 <- appl_421 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_421 - !appl_423 <- appl_422 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_422 - !appl_424 <- appl_423 `pseq` klCons appl_423 (Types.Atom Types.Nil) - !appl_425 <- appl_424 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_424 - !appl_426 <- appl_420 `pseq` (appl_425 `pseq` klCons appl_420 appl_425) - appl_426 `pseq` kl_declare (ApplC (wrapNamed "profile" kl_profile)) appl_426) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_427 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_428 <- appl_427 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_427 - !appl_429 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_430 <- appl_429 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_429 - !appl_431 <- appl_430 `pseq` klCons appl_430 (Types.Atom Types.Nil) - !appl_432 <- appl_431 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_431 - !appl_433 <- appl_428 `pseq` (appl_432 `pseq` klCons appl_428 appl_432) - appl_433 `pseq` kl_declare (ApplC (wrapNamed "preclude" kl_preclude)) appl_433) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_434 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_435 <- appl_434 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_434 - !appl_436 <- appl_435 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_435 - appl_436 `pseq` kl_declare (ApplC (wrapNamed "shen.proc-nl" kl_shen_proc_nl)) appl_436) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_437 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_438 <- appl_437 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_437 - !appl_439 <- appl_438 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_438 - !appl_440 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_441 <- appl_440 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_440 - !appl_442 <- appl_441 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_441 - !appl_443 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_444 <- appl_443 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_443 - !appl_445 <- appl_442 `pseq` (appl_444 `pseq` klCons appl_442 appl_444) - !appl_446 <- appl_445 `pseq` klCons appl_445 (Types.Atom Types.Nil) - !appl_447 <- appl_446 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_446 - !appl_448 <- appl_439 `pseq` (appl_447 `pseq` klCons appl_439 appl_447) - appl_448 `pseq` kl_declare (ApplC (wrapNamed "profile-results" kl_profile_results)) appl_448) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_449 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_450 <- appl_449 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_449 - !appl_451 <- appl_450 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_450 - appl_451 `pseq` kl_declare (ApplC (wrapNamed "protect" kl_protect)) appl_451) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_452 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_453 <- appl_452 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_452 - !appl_454 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_455 <- appl_454 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_454 - !appl_456 <- appl_455 `pseq` klCons appl_455 (Types.Atom Types.Nil) - !appl_457 <- appl_456 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_456 - !appl_458 <- appl_453 `pseq` (appl_457 `pseq` klCons appl_453 appl_457) - appl_458 `pseq` kl_declare (ApplC (wrapNamed "preclude-all-but" kl_preclude_all_but)) appl_458) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_459 <- klCons (Types.Atom (Types.UnboundSym "out")) (Types.Atom Types.Nil) - !appl_460 <- appl_459 `pseq` klCons (Types.Atom (Types.UnboundSym "stream")) appl_459 - !appl_461 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_462 <- appl_461 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_461 - !appl_463 <- appl_460 `pseq` (appl_462 `pseq` klCons appl_460 appl_462) - !appl_464 <- appl_463 `pseq` klCons appl_463 (Types.Atom Types.Nil) - !appl_465 <- appl_464 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_464 - !appl_466 <- appl_465 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_465 - appl_466 `pseq` kl_declare (ApplC (wrapNamed "shen.prhush" kl_shen_prhush)) appl_466) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_467 <- klCons (Types.Atom (Types.UnboundSym "unit")) (Types.Atom Types.Nil) - !appl_468 <- appl_467 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_467 - !appl_469 <- appl_468 `pseq` klCons appl_468 (Types.Atom Types.Nil) - !appl_470 <- appl_469 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_469 - !appl_471 <- appl_470 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_470 - appl_471 `pseq` kl_declare (ApplC (wrapNamed "ps" kl_ps)) appl_471) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_472 <- klCons (Types.Atom (Types.UnboundSym "in")) (Types.Atom Types.Nil) - !appl_473 <- appl_472 `pseq` klCons (Types.Atom (Types.UnboundSym "stream")) appl_472 - !appl_474 <- klCons (Types.Atom (Types.UnboundSym "unit")) (Types.Atom Types.Nil) - !appl_475 <- appl_474 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_474 - !appl_476 <- appl_473 `pseq` (appl_475 `pseq` klCons appl_473 appl_475) - appl_476 `pseq` kl_declare (ApplC (wrapNamed "read" kl_read)) appl_476) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_477 <- klCons (Types.Atom (Types.UnboundSym "in")) (Types.Atom Types.Nil) - !appl_478 <- appl_477 `pseq` klCons (Types.Atom (Types.UnboundSym "stream")) appl_477 - !appl_479 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_480 <- appl_479 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_479 - !appl_481 <- appl_478 `pseq` (appl_480 `pseq` klCons appl_478 appl_480) - appl_481 `pseq` kl_declare (ApplC (wrapNamed "read-byte" readByte)) appl_481) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_482 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_483 <- appl_482 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_482 - !appl_484 <- appl_483 `pseq` klCons appl_483 (Types.Atom Types.Nil) - !appl_485 <- appl_484 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_484 - !appl_486 <- appl_485 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_485 - appl_486 `pseq` kl_declare (ApplC (wrapNamed "read-file-as-bytelist" kl_read_file_as_bytelist)) appl_486) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_487 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_488 <- appl_487 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_487 - !appl_489 <- appl_488 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_488 - appl_489 `pseq` kl_declare (ApplC (wrapNamed "read-file-as-string" kl_read_file_as_string)) appl_489) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_490 <- klCons (Types.Atom (Types.UnboundSym "unit")) (Types.Atom Types.Nil) - !appl_491 <- appl_490 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_490 - !appl_492 <- appl_491 `pseq` klCons appl_491 (Types.Atom Types.Nil) - !appl_493 <- appl_492 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_492 - !appl_494 <- appl_493 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_493 - appl_494 `pseq` kl_declare (ApplC (wrapNamed "read-file" kl_read_file)) appl_494) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_495 <- klCons (Types.Atom (Types.UnboundSym "unit")) (Types.Atom Types.Nil) - !appl_496 <- appl_495 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_495 - !appl_497 <- appl_496 `pseq` klCons appl_496 (Types.Atom Types.Nil) - !appl_498 <- appl_497 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_497 - !appl_499 <- appl_498 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_498 - appl_499 `pseq` kl_declare (ApplC (wrapNamed "read-from-string" kl_read_from_string)) appl_499) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_500 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_501 <- appl_500 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_500 - appl_501 `pseq` kl_declare (ApplC (PL "release" kl_release)) appl_501) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_502 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_503 <- appl_502 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_502 - !appl_504 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_505 <- appl_504 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_504 - !appl_506 <- appl_505 `pseq` klCons appl_505 (Types.Atom Types.Nil) - !appl_507 <- appl_506 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_506 - !appl_508 <- appl_503 `pseq` (appl_507 `pseq` klCons appl_503 appl_507) - !appl_509 <- appl_508 `pseq` klCons appl_508 (Types.Atom Types.Nil) - !appl_510 <- appl_509 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_509 - !appl_511 <- appl_510 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_510 - appl_511 `pseq` kl_declare (ApplC (wrapNamed "remove" kl_remove)) appl_511) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_512 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_513 <- appl_512 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_512 - !appl_514 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_515 <- appl_514 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_514 - !appl_516 <- appl_515 `pseq` klCons appl_515 (Types.Atom Types.Nil) - !appl_517 <- appl_516 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_516 - !appl_518 <- appl_513 `pseq` (appl_517 `pseq` klCons appl_513 appl_517) - appl_518 `pseq` kl_declare (ApplC (wrapNamed "reverse" kl_reverse)) appl_518) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_519 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_520 <- appl_519 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_519 - !appl_521 <- appl_520 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_520 - appl_521 `pseq` kl_declare (ApplC (wrapNamed "simple-error" simpleError)) appl_521) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_522 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_523 <- appl_522 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_522 - !appl_524 <- appl_523 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_523 - !appl_525 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_526 <- appl_525 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_525 - !appl_527 <- appl_524 `pseq` (appl_526 `pseq` klCons appl_524 appl_526) - appl_527 `pseq` kl_declare (ApplC (wrapNamed "snd" kl_snd)) appl_527) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_528 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_529 <- appl_528 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_528 - !appl_530 <- appl_529 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_529 - appl_530 `pseq` kl_declare (ApplC (wrapNamed "specialise" kl_specialise)) appl_530) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_531 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_532 <- appl_531 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_531 - !appl_533 <- appl_532 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_532 - appl_533 `pseq` kl_declare (ApplC (wrapNamed "spy" kl_spy)) appl_533) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_534 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_535 <- appl_534 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_534 - !appl_536 <- appl_535 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_535 - appl_536 `pseq` kl_declare (ApplC (wrapNamed "step" kl_step)) appl_536) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_537 <- klCons (Types.Atom (Types.UnboundSym "in")) (Types.Atom Types.Nil) - !appl_538 <- appl_537 `pseq` klCons (Types.Atom (Types.UnboundSym "stream")) appl_537 - !appl_539 <- appl_538 `pseq` klCons appl_538 (Types.Atom Types.Nil) - !appl_540 <- appl_539 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_539 - appl_540 `pseq` kl_declare (ApplC (PL "stinput" kl_stinput)) appl_540) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_541 <- klCons (Types.Atom (Types.UnboundSym "out")) (Types.Atom Types.Nil) - !appl_542 <- appl_541 `pseq` klCons (Types.Atom (Types.UnboundSym "stream")) appl_541 - !appl_543 <- appl_542 `pseq` klCons appl_542 (Types.Atom Types.Nil) - !appl_544 <- appl_543 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_543 - appl_544 `pseq` kl_declare (ApplC (PL "stoutput" kl_stoutput)) appl_544) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_545 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_546 <- appl_545 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_545 - !appl_547 <- appl_546 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_546 - appl_547 `pseq` kl_declare (ApplC (wrapNamed "string?" stringP)) appl_547) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_548 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_549 <- appl_548 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_548 - !appl_550 <- appl_549 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_549 - appl_550 `pseq` kl_declare (ApplC (wrapNamed "str" str)) appl_550) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_551 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_552 <- appl_551 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_551 - !appl_553 <- appl_552 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_552 - appl_553 `pseq` kl_declare (ApplC (wrapNamed "string->n" stringToN)) appl_553) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_554 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_555 <- appl_554 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_554 - !appl_556 <- appl_555 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_555 - appl_556 `pseq` kl_declare (ApplC (wrapNamed "string->symbol" kl_string_RBsymbol)) appl_556) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_557 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_558 <- appl_557 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_557 - !appl_559 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_560 <- appl_559 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_559 - !appl_561 <- appl_558 `pseq` (appl_560 `pseq` klCons appl_558 appl_560) - appl_561 `pseq` kl_declare (ApplC (wrapNamed "sum" kl_sum)) appl_561) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_562 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_563 <- appl_562 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_562 - !appl_564 <- appl_563 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_563 - appl_564 `pseq` kl_declare (ApplC (wrapNamed "symbol?" kl_symbolP)) appl_564) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_565 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_566 <- appl_565 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_565 - !appl_567 <- appl_566 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_566 - appl_567 `pseq` kl_declare (ApplC (wrapNamed "systemf" kl_systemf)) appl_567) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_568 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_569 <- appl_568 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_568 - !appl_570 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_571 <- appl_570 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_570 - !appl_572 <- appl_571 `pseq` klCons appl_571 (Types.Atom Types.Nil) - !appl_573 <- appl_572 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_572 - !appl_574 <- appl_569 `pseq` (appl_573 `pseq` klCons appl_569 appl_573) - appl_574 `pseq` kl_declare (ApplC (wrapNamed "tail" kl_tail)) appl_574) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_575 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_576 <- appl_575 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_575 - !appl_577 <- appl_576 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_576 - appl_577 `pseq` kl_declare (ApplC (wrapNamed "tlstr" tlstr)) appl_577) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_578 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_579 <- appl_578 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_578 - !appl_580 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_581 <- appl_580 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_580 - !appl_582 <- appl_581 `pseq` klCons appl_581 (Types.Atom Types.Nil) - !appl_583 <- appl_582 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_582 - !appl_584 <- appl_579 `pseq` (appl_583 `pseq` klCons appl_579 appl_583) - appl_584 `pseq` kl_declare (ApplC (wrapNamed "tlv" kl_tlv)) appl_584) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_585 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_586 <- appl_585 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_585 - !appl_587 <- appl_586 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_586 - appl_587 `pseq` kl_declare (ApplC (wrapNamed "tc" kl_tc)) appl_587) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_588 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_589 <- appl_588 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_588 - appl_589 `pseq` kl_declare (ApplC (PL "tc?" kl_tcP)) appl_589) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_590 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_591 <- appl_590 `pseq` klCons (Types.Atom (Types.UnboundSym "lazy")) appl_590 - !appl_592 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_593 <- appl_592 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_592 - !appl_594 <- appl_591 `pseq` (appl_593 `pseq` klCons appl_591 appl_593) - appl_594 `pseq` kl_declare (ApplC (wrapNamed "thaw" kl_thaw)) appl_594) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_595 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_596 <- appl_595 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_595 - !appl_597 <- appl_596 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_596 - appl_597 `pseq` kl_declare (ApplC (wrapNamed "track" kl_track)) appl_597) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_598 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_599 <- appl_598 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_598 - !appl_600 <- appl_599 `pseq` klCons (Types.Atom (Types.UnboundSym "exception")) appl_599 - !appl_601 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_602 <- appl_601 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_601 - !appl_603 <- appl_600 `pseq` (appl_602 `pseq` klCons appl_600 appl_602) - !appl_604 <- appl_603 `pseq` klCons appl_603 (Types.Atom Types.Nil) - !appl_605 <- appl_604 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_604 - !appl_606 <- appl_605 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_605 - appl_606 `pseq` kl_declare (Types.Atom (Types.UnboundSym "trap-error")) appl_606) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_607 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_608 <- appl_607 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_607 - !appl_609 <- appl_608 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_608 - appl_609 `pseq` kl_declare (ApplC (wrapNamed "tuple?" kl_tupleP)) appl_609) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_610 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_611 <- appl_610 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_610 - !appl_612 <- appl_611 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_611 - appl_612 `pseq` kl_declare (ApplC (wrapNamed "undefmacro" kl_undefmacro)) appl_612) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_613 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_614 <- appl_613 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_613 - !appl_615 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_616 <- appl_615 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_615 - !appl_617 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_618 <- appl_617 `pseq` klCons (Types.Atom (Types.UnboundSym "list")) appl_617 - !appl_619 <- appl_618 `pseq` klCons appl_618 (Types.Atom Types.Nil) - !appl_620 <- appl_619 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_619 - !appl_621 <- appl_616 `pseq` (appl_620 `pseq` klCons appl_616 appl_620) - !appl_622 <- appl_621 `pseq` klCons appl_621 (Types.Atom Types.Nil) - !appl_623 <- appl_622 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_622 - !appl_624 <- appl_614 `pseq` (appl_623 `pseq` klCons appl_614 appl_623) - appl_624 `pseq` kl_declare (ApplC (wrapNamed "union" kl_union)) appl_624) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_625 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_626 <- appl_625 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_625 - !appl_627 <- appl_626 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_626 - !appl_628 <- klCons (Types.Atom (Types.UnboundSym "B")) (Types.Atom Types.Nil) - !appl_629 <- appl_628 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_628 - !appl_630 <- appl_629 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_629 - !appl_631 <- appl_630 `pseq` klCons appl_630 (Types.Atom Types.Nil) - !appl_632 <- appl_631 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_631 - !appl_633 <- appl_627 `pseq` (appl_632 `pseq` klCons appl_627 appl_632) - appl_633 `pseq` kl_declare (ApplC (wrapNamed "unprofile" kl_unprofile)) appl_633) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_634 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_635 <- appl_634 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_634 - !appl_636 <- appl_635 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_635 - appl_636 `pseq` kl_declare (ApplC (wrapNamed "untrack" kl_untrack)) appl_636) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_637 <- klCons (Types.Atom (Types.UnboundSym "symbol")) (Types.Atom Types.Nil) - !appl_638 <- appl_637 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_637 - !appl_639 <- appl_638 `pseq` klCons (Types.Atom (Types.UnboundSym "symbol")) appl_638 - appl_639 `pseq` kl_declare (ApplC (wrapNamed "unspecialise" kl_unspecialise)) appl_639) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_640 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_641 <- appl_640 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_640 - !appl_642 <- appl_641 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_641 - appl_642 `pseq` kl_declare (ApplC (wrapNamed "variable?" kl_variableP)) appl_642) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_643 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_644 <- appl_643 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_643 - !appl_645 <- appl_644 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_644 - appl_645 `pseq` kl_declare (ApplC (wrapNamed "vector?" kl_vectorP)) appl_645) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_646 <- klCons (Types.Atom (Types.UnboundSym "string")) (Types.Atom Types.Nil) - !appl_647 <- appl_646 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_646 - appl_647 `pseq` kl_declare (ApplC (PL "version" kl_version)) appl_647) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_648 <- klCons (Types.Atom (Types.UnboundSym "A")) (Types.Atom Types.Nil) - !appl_649 <- appl_648 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_648 - !appl_650 <- appl_649 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_649 - !appl_651 <- appl_650 `pseq` klCons appl_650 (Types.Atom Types.Nil) - !appl_652 <- appl_651 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_651 - !appl_653 <- appl_652 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_652 - appl_653 `pseq` kl_declare (ApplC (wrapNamed "write-to-file" kl_write_to_file)) appl_653) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_654 <- klCons (Types.Atom (Types.UnboundSym "out")) (Types.Atom Types.Nil) - !appl_655 <- appl_654 `pseq` klCons (Types.Atom (Types.UnboundSym "stream")) appl_654 - !appl_656 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_657 <- appl_656 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_656 - !appl_658 <- appl_655 `pseq` (appl_657 `pseq` klCons appl_655 appl_657) - !appl_659 <- appl_658 `pseq` klCons appl_658 (Types.Atom Types.Nil) - !appl_660 <- appl_659 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_659 - !appl_661 <- appl_660 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_660 - appl_661 `pseq` kl_declare (ApplC (wrapNamed "write-byte" writeByte)) appl_661) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_662 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_663 <- appl_662 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_662 - !appl_664 <- appl_663 `pseq` klCons (Types.Atom (Types.UnboundSym "string")) appl_663 - appl_664 `pseq` kl_declare (ApplC (wrapNamed "y-or-n?" kl_y_or_nP)) appl_664) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_665 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_666 <- appl_665 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_665 - !appl_667 <- appl_666 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_666 - !appl_668 <- appl_667 `pseq` klCons appl_667 (Types.Atom Types.Nil) - !appl_669 <- appl_668 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_668 - !appl_670 <- appl_669 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_669 - appl_670 `pseq` kl_declare (ApplC (wrapNamed ">" greaterThan)) appl_670) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_671 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_672 <- appl_671 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_671 - !appl_673 <- appl_672 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_672 - !appl_674 <- appl_673 `pseq` klCons appl_673 (Types.Atom Types.Nil) - !appl_675 <- appl_674 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_674 - !appl_676 <- appl_675 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_675 - appl_676 `pseq` kl_declare (ApplC (wrapNamed "<" lessThan)) appl_676) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_677 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_678 <- appl_677 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_677 - !appl_679 <- appl_678 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_678 - !appl_680 <- appl_679 `pseq` klCons appl_679 (Types.Atom Types.Nil) - !appl_681 <- appl_680 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_680 - !appl_682 <- appl_681 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_681 - appl_682 `pseq` kl_declare (ApplC (wrapNamed ">=" greaterThanOrEqualTo)) appl_682) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_683 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_684 <- appl_683 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_683 - !appl_685 <- appl_684 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_684 - !appl_686 <- appl_685 `pseq` klCons appl_685 (Types.Atom Types.Nil) - !appl_687 <- appl_686 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_686 - !appl_688 <- appl_687 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_687 - appl_688 `pseq` kl_declare (ApplC (wrapNamed "<=" lessThanOrEqualTo)) appl_688) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_689 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_690 <- appl_689 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_689 - !appl_691 <- appl_690 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_690 - !appl_692 <- appl_691 `pseq` klCons appl_691 (Types.Atom Types.Nil) - !appl_693 <- appl_692 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_692 - !appl_694 <- appl_693 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_693 - appl_694 `pseq` kl_declare (ApplC (wrapNamed "=" eq)) appl_694) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_695 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_696 <- appl_695 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_695 - !appl_697 <- appl_696 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_696 - !appl_698 <- appl_697 `pseq` klCons appl_697 (Types.Atom Types.Nil) - !appl_699 <- appl_698 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_698 - !appl_700 <- appl_699 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_699 - appl_700 `pseq` kl_declare (ApplC (wrapNamed "+" add)) appl_700) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_701 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_702 <- appl_701 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_701 - !appl_703 <- appl_702 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_702 - !appl_704 <- appl_703 `pseq` klCons appl_703 (Types.Atom Types.Nil) - !appl_705 <- appl_704 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_704 - !appl_706 <- appl_705 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_705 - appl_706 `pseq` kl_declare (ApplC (wrapNamed "/" divide)) appl_706) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_707 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_708 <- appl_707 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_707 - !appl_709 <- appl_708 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_708 - !appl_710 <- appl_709 `pseq` klCons appl_709 (Types.Atom Types.Nil) - !appl_711 <- appl_710 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_710 - !appl_712 <- appl_711 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_711 - appl_712 `pseq` kl_declare (ApplC (wrapNamed "-" Primitives.subtract)) appl_712) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_713 <- klCons (Types.Atom (Types.UnboundSym "number")) (Types.Atom Types.Nil) - !appl_714 <- appl_713 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_713 - !appl_715 <- appl_714 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_714 - !appl_716 <- appl_715 `pseq` klCons appl_715 (Types.Atom Types.Nil) - !appl_717 <- appl_716 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_716 - !appl_718 <- appl_717 `pseq` klCons (Types.Atom (Types.UnboundSym "number")) appl_717 - appl_718 `pseq` kl_declare (ApplC (wrapNamed "*" multiply)) appl_718) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) - (do !appl_719 <- klCons (Types.Atom (Types.UnboundSym "boolean")) (Types.Atom Types.Nil) - !appl_720 <- appl_719 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_719 - !appl_721 <- appl_720 `pseq` klCons (Types.Atom (Types.UnboundSym "B")) appl_720 - !appl_722 <- appl_721 `pseq` klCons appl_721 (Types.Atom Types.Nil) - !appl_723 <- appl_722 `pseq` klCons (Types.Atom (Types.UnboundSym "-->")) appl_722 - !appl_724 <- appl_723 `pseq` klCons (Types.Atom (Types.UnboundSym "A")) appl_723 - appl_724 `pseq` kl_declare (ApplC (wrapNamed "==" kl_EqEq)) appl_724) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Types where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel +import Backend.Core +import Backend.Sys +import Backend.Sequent +import Backend.Yacc +import Backend.Reader +import Backend.Prolog +import Backend.Track +import Backend.Load +import Backend.Writer +import Backend.Macros +import Backend.Declarations + +{- +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_declare :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_declare (!kl_V3988) (!kl_V3989) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Record) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Variancy) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Type) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_FMult) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Parameters) -> do let !appl_5 = ApplC (Func "lambda" (Context (\(!kl_Clause) -> do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_AUM_instruction) -> do let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_Code) -> do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_ShenDef) -> do let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_Eval) -> do return kl_V3988))) + !appl_10 <- kl_ShenDef `pseq` kl_shen_eval_without_macros kl_ShenDef + appl_10 `pseq` applyWrapper appl_9 [appl_10]))) + let !appl_11 = Atom Nil + !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Continuation")) appl_11 + !appl_13 <- appl_12 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "ProcessN")) appl_12 + let !appl_14 = Atom Nil + !appl_15 <- kl_Code `pseq` (appl_14 `pseq` klCons kl_Code appl_14) + !appl_16 <- appl_15 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "->")) appl_15 + !appl_17 <- appl_13 `pseq` (appl_16 `pseq` kl_append appl_13 appl_16) + !appl_18 <- kl_Parameters `pseq` (appl_17 `pseq` kl_append kl_Parameters appl_17) + !appl_19 <- kl_FMult `pseq` (appl_18 `pseq` klCons kl_FMult appl_18) + !appl_20 <- appl_19 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "define")) appl_19 + appl_20 `pseq` applyWrapper appl_8 [appl_20]))) + !appl_21 <- kl_AUM_instruction `pseq` kl_shen_aum_to_shen kl_AUM_instruction + appl_21 `pseq` applyWrapper appl_7 [appl_21]))) + !appl_22 <- kl_Clause `pseq` (kl_Parameters `pseq` kl_shen_aum kl_Clause kl_Parameters) + appl_22 `pseq` applyWrapper appl_6 [appl_22]))) + let !appl_23 = Atom Nil + !appl_24 <- appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_23 + !appl_25 <- kl_FMult `pseq` (appl_24 `pseq` klCons kl_FMult appl_24) + let !appl_26 = Atom Nil + !appl_27 <- kl_Type `pseq` (appl_26 `pseq` klCons kl_Type appl_26) + !appl_28 <- appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_27 + !appl_29 <- appl_28 `pseq` klCons (ApplC (wrapNamed "unify!" kl_unifyExcl)) appl_28 + let !appl_30 = Atom Nil + !appl_31 <- appl_29 `pseq` (appl_30 `pseq` klCons appl_29 appl_30) + let !appl_32 = Atom Nil + !appl_33 <- appl_31 `pseq` (appl_32 `pseq` klCons appl_31 appl_32) + !appl_34 <- appl_33 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":-")) appl_33 + !appl_35 <- appl_25 `pseq` (appl_34 `pseq` klCons appl_25 appl_34) + appl_35 `pseq` applyWrapper appl_5 [appl_35]))) + !appl_36 <- kl_shen_parameters (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + appl_36 `pseq` applyWrapper appl_4 [appl_36]))) + !appl_37 <- kl_V3988 `pseq` kl_concat (Core.Types.Atom (Core.Types.UnboundSym "shen.type-signature-of-")) kl_V3988 + appl_37 `pseq` applyWrapper appl_3 [appl_37]))) + !appl_38 <- kl_V3989 `pseq` kl_shen_demodulate kl_V3989 + !appl_39 <- appl_38 `pseq` kl_shen_rcons_form appl_38 + appl_39 `pseq` applyWrapper appl_2 [appl_39]))) + !appl_40 <- (do kl_V3988 `pseq` (kl_V3989 `pseq` kl_shen_variancy_test kl_V3988 kl_V3989)) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip"))) + appl_40 `pseq` applyWrapper appl_1 [appl_40]))) + !appl_41 <- kl_V3988 `pseq` (kl_V3989 `pseq` klCons kl_V3988 kl_V3989) + !appl_42 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*signedfuncs*")) + !appl_43 <- appl_41 `pseq` (appl_42 `pseq` klCons appl_41 appl_42) + !appl_44 <- appl_43 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*signedfuncs*")) appl_43 + appl_44 `pseq` applyWrapper appl_0 [appl_44] + +kl_shen_demodulate :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_demodulate (!kl_V3991) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Demod) -> do !kl_if_1 <- kl_Demod `pseq` (kl_V3991 `pseq` eq kl_Demod kl_V3991) + case kl_if_1 of + Atom (B (True)) -> do return kl_V3991 + Atom (B (False)) -> do do kl_Demod `pseq` kl_shen_demodulate kl_Demod + _ -> throwError "if: expected boolean"))) + !appl_2 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*demodulation-function*")) + !appl_3 <- appl_2 `pseq` (kl_V3991 `pseq` kl_shen_walk appl_2 kl_V3991) + appl_3 `pseq` applyWrapper appl_0 [appl_3] + +kl_shen_variancy_test :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_variancy_test (!kl_V3994) (!kl_V3995) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_TypeF) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Check) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip"))))) + !appl_2 <- let pat_cond_3 = do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + pat_cond_4 = do do !kl_if_5 <- kl_TypeF `pseq` (kl_V3995 `pseq` kl_shen_variantP kl_TypeF kl_V3995) + case kl_if_5 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + Atom (B (False)) -> do do !appl_6 <- kl_V3994 `pseq` kl_shen_app kl_V3994 (Core.Types.Atom (Core.Types.Str " may create errors\n")) (Core.Types.Atom (Core.Types.UnboundSym "shen.a")) + !appl_7 <- appl_6 `pseq` cn (Core.Types.Atom (Core.Types.Str "warning: changing the type of ")) appl_6 + !appl_8 <- kl_stoutput + appl_7 `pseq` (appl_8 `pseq` kl_shen_prhush appl_7 appl_8) + _ -> throwError "if: expected boolean" + in case kl_TypeF of + kl_TypeF@(Atom (UnboundSym "symbol")) -> pat_cond_3 + kl_TypeF@(ApplC (PL "symbol" + _)) -> pat_cond_3 + kl_TypeF@(ApplC (Func "symbol" + _)) -> pat_cond_3 + _ -> pat_cond_4 + appl_2 `pseq` applyWrapper appl_1 [appl_2]))) + let !aw_9 = Core.Types.Atom (Core.Types.UnboundSym "shen.typecheck") + !appl_10 <- kl_V3994 `pseq` applyWrapper aw_9 [kl_V3994, + Core.Types.Atom (Core.Types.UnboundSym "B")] + appl_10 `pseq` applyWrapper appl_0 [appl_10] + +kl_shen_variantP :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_variantP (!kl_V4008) (!kl_V4009) = do !kl_if_0 <- kl_V4009 `pseq` (kl_V4008 `pseq` eq kl_V4009 kl_V4008) + case kl_if_0 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do !kl_if_1 <- let pat_cond_2 kl_V4008 kl_V4008h kl_V4008t = do let pat_cond_3 kl_V4009 kl_V4009h kl_V4009t = do return (Atom (B True)) + pat_cond_4 = do do return (Atom (B False)) + in case kl_V4009 of + !(kl_V4009@(Cons (!kl_V4009h) + (!kl_V4009t))) | eqCore kl_V4009h kl_V4008h -> pat_cond_3 kl_V4009 kl_V4009h kl_V4009t + _ -> pat_cond_4 + pat_cond_5 = do do return (Atom (B False)) + in case kl_V4008 of + !(kl_V4008@(Cons (!kl_V4008h) + (!kl_V4008t))) -> pat_cond_2 kl_V4008 kl_V4008h kl_V4008t + _ -> pat_cond_5 + case kl_if_1 of + Atom (B (True)) -> do !appl_6 <- kl_V4008 `pseq` tl kl_V4008 + !appl_7 <- kl_V4009 `pseq` tl kl_V4009 + appl_6 `pseq` (appl_7 `pseq` kl_shen_variantP appl_6 appl_7) + Atom (B (False)) -> do !kl_if_8 <- let pat_cond_9 kl_V4008 kl_V4008h kl_V4008t = do !kl_if_10 <- let pat_cond_11 kl_V4009 kl_V4009h kl_V4009t = do !kl_if_12 <- kl_V4008h `pseq` kl_shen_pvarP kl_V4008h + !kl_if_13 <- case kl_if_12 of + Atom (B (True)) -> do !kl_if_14 <- kl_V4009h `pseq` kl_variableP kl_V4009h + case kl_if_14 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_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_15 = do do return (Atom (B False)) + in case kl_V4009 of + !(kl_V4009@(Cons (!kl_V4009h) + (!kl_V4009t))) -> pat_cond_11 kl_V4009 kl_V4009h kl_V4009t + _ -> pat_cond_15 + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_16 = do do return (Atom (B False)) + in case kl_V4008 of + !(kl_V4008@(Cons (!kl_V4008h) + (!kl_V4008t))) -> pat_cond_9 kl_V4008 kl_V4008h kl_V4008t + _ -> pat_cond_16 + case kl_if_8 of + Atom (B (True)) -> do !appl_17 <- kl_V4008 `pseq` hd kl_V4008 + !appl_18 <- kl_V4008 `pseq` tl kl_V4008 + !appl_19 <- appl_17 `pseq` (appl_18 `pseq` kl_subst (Core.Types.Atom (Core.Types.UnboundSym "shen.a")) appl_17 appl_18) + !appl_20 <- kl_V4009 `pseq` hd kl_V4009 + !appl_21 <- kl_V4009 `pseq` tl kl_V4009 + !appl_22 <- appl_20 `pseq` (appl_21 `pseq` kl_subst (Core.Types.Atom (Core.Types.UnboundSym "shen.a")) appl_20 appl_21) + appl_19 `pseq` (appl_22 `pseq` kl_shen_variantP appl_19 appl_22) + Atom (B (False)) -> do !kl_if_23 <- let pat_cond_24 kl_V4008 kl_V4008h kl_V4008t = do !kl_if_25 <- let pat_cond_26 kl_V4008h kl_V4008hh kl_V4008ht = do let pat_cond_27 kl_V4009 kl_V4009h kl_V4009hh kl_V4009ht kl_V4009t = do return (Atom (B True)) + pat_cond_28 = do do return (Atom (B False)) + in case kl_V4009 of + !(kl_V4009@(Cons (!(kl_V4009h@(Cons (!kl_V4009hh) + (!kl_V4009ht)))) + (!kl_V4009t))) -> pat_cond_27 kl_V4009 kl_V4009h kl_V4009hh kl_V4009ht kl_V4009t + _ -> pat_cond_28 + pat_cond_29 = do do return (Atom (B False)) + in case kl_V4008h of + !(kl_V4008h@(Cons (!kl_V4008hh) + (!kl_V4008ht))) -> pat_cond_26 kl_V4008h kl_V4008hh kl_V4008ht + _ -> pat_cond_29 + 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_30 = do do return (Atom (B False)) + in case kl_V4008 of + !(kl_V4008@(Cons (!kl_V4008h) + (!kl_V4008t))) -> pat_cond_24 kl_V4008 kl_V4008h kl_V4008t + _ -> pat_cond_30 + case kl_if_23 of + Atom (B (True)) -> do !appl_31 <- kl_V4008 `pseq` hd kl_V4008 + !appl_32 <- kl_V4008 `pseq` tl kl_V4008 + !appl_33 <- appl_31 `pseq` (appl_32 `pseq` kl_append appl_31 appl_32) + !appl_34 <- kl_V4009 `pseq` hd kl_V4009 + !appl_35 <- kl_V4009 `pseq` tl kl_V4009 + !appl_36 <- appl_34 `pseq` (appl_35 `pseq` kl_append appl_34 appl_35) + appl_33 `pseq` (appl_36 `pseq` kl_shen_variantP appl_33 appl_36) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +expr12 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr12 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_0 = Atom Nil + !appl_1 <- appl_0 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_0 + !appl_2 <- appl_1 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1 + !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_2 + appl_3 `pseq` kl_declare (ApplC (wrapNamed "absvector?" absvectorP)) appl_3) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_4 = Atom Nil + !appl_5 <- appl_4 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_4 + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_5 + let !appl_7 = Atom Nil + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_7 + !appl_9 <- appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_8 + let !appl_10 = Atom Nil + !appl_11 <- appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) + !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_11 + !appl_13 <- appl_6 `pseq` (appl_12 `pseq` klCons appl_6 appl_12) + let !appl_14 = Atom Nil + !appl_15 <- appl_13 `pseq` (appl_14 `pseq` klCons appl_13 appl_14) + !appl_16 <- appl_15 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_15 + !appl_17 <- appl_16 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_16 + appl_17 `pseq` kl_declare (ApplC (wrapNamed "adjoin" kl_adjoin)) appl_17) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_18 = Atom Nil + !appl_19 <- appl_18 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_18 + !appl_20 <- appl_19 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_19 + !appl_21 <- appl_20 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_20 + let !appl_22 = Atom Nil + !appl_23 <- appl_21 `pseq` (appl_22 `pseq` klCons appl_21 appl_22) + !appl_24 <- appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_23 + !appl_25 <- appl_24 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_24 + appl_25 `pseq` kl_declare (Core.Types.Atom (Core.Types.UnboundSym "and")) appl_25) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_26 = Atom Nil + !appl_27 <- appl_26 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_26 + !appl_28 <- appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_27 + !appl_29 <- appl_28 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_28 + let !appl_30 = Atom Nil + !appl_31 <- appl_29 `pseq` (appl_30 `pseq` klCons appl_29 appl_30) + !appl_32 <- appl_31 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_31 + !appl_33 <- appl_32 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_32 + let !appl_34 = Atom Nil + !appl_35 <- appl_33 `pseq` (appl_34 `pseq` klCons appl_33 appl_34) + !appl_36 <- appl_35 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_35 + !appl_37 <- appl_36 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_36 + appl_37 `pseq` kl_declare (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_37) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_38 = Atom Nil + !appl_39 <- appl_38 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_38 + !appl_40 <- appl_39 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_39 + let !appl_41 = Atom Nil + !appl_42 <- appl_41 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_41 + !appl_43 <- appl_42 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_42 + let !appl_44 = Atom Nil + !appl_45 <- appl_44 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_44 + !appl_46 <- appl_45 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_45 + let !appl_47 = Atom Nil + !appl_48 <- appl_46 `pseq` (appl_47 `pseq` klCons appl_46 appl_47) + !appl_49 <- appl_48 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_48 + !appl_50 <- appl_43 `pseq` (appl_49 `pseq` klCons appl_43 appl_49) + let !appl_51 = Atom Nil + !appl_52 <- appl_50 `pseq` (appl_51 `pseq` klCons appl_50 appl_51) + !appl_53 <- appl_52 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_52 + !appl_54 <- appl_40 `pseq` (appl_53 `pseq` klCons appl_40 appl_53) + appl_54 `pseq` kl_declare (ApplC (wrapNamed "append" kl_append)) appl_54) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_55 = Atom Nil + !appl_56 <- appl_55 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_55 + !appl_57 <- appl_56 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_56 + !appl_58 <- appl_57 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_57 + appl_58 `pseq` kl_declare (ApplC (wrapNamed "arity" kl_arity)) appl_58) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_59 = Atom Nil + !appl_60 <- appl_59 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_59 + !appl_61 <- appl_60 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_60 + let !appl_62 = Atom Nil + !appl_63 <- appl_61 `pseq` (appl_62 `pseq` klCons appl_61 appl_62) + !appl_64 <- appl_63 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_63 + let !appl_65 = Atom Nil + !appl_66 <- appl_65 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_65 + !appl_67 <- appl_66 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_66 + let !appl_68 = Atom Nil + !appl_69 <- appl_67 `pseq` (appl_68 `pseq` klCons appl_67 appl_68) + !appl_70 <- appl_69 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_69 + !appl_71 <- appl_64 `pseq` (appl_70 `pseq` klCons appl_64 appl_70) + let !appl_72 = Atom Nil + !appl_73 <- appl_71 `pseq` (appl_72 `pseq` klCons appl_71 appl_72) + !appl_74 <- appl_73 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_73 + !appl_75 <- appl_74 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_74 + appl_75 `pseq` kl_declare (ApplC (wrapNamed "assoc" kl_assoc)) appl_75) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_76 = Atom Nil + !appl_77 <- appl_76 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_76 + !appl_78 <- appl_77 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_77 + !appl_79 <- appl_78 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_78 + appl_79 `pseq` kl_declare (ApplC (wrapNamed "boolean?" kl_booleanP)) appl_79) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_80 = Atom Nil + !appl_81 <- appl_80 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_80 + !appl_82 <- appl_81 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_81 + !appl_83 <- appl_82 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_82 + appl_83 `pseq` kl_declare (ApplC (wrapNamed "bound?" kl_boundP)) appl_83) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_84 = Atom Nil + !appl_85 <- appl_84 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_84 + !appl_86 <- appl_85 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_85 + !appl_87 <- appl_86 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_86 + appl_87 `pseq` kl_declare (ApplC (wrapNamed "cd" kl_cd)) appl_87) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_88 = Atom Nil + !appl_89 <- appl_88 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_88 + !appl_90 <- appl_89 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "stream")) appl_89 + let !appl_91 = Atom Nil + !appl_92 <- appl_91 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_91 + !appl_93 <- appl_92 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_92 + let !appl_94 = Atom Nil + !appl_95 <- appl_93 `pseq` (appl_94 `pseq` klCons appl_93 appl_94) + !appl_96 <- appl_95 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_95 + !appl_97 <- appl_90 `pseq` (appl_96 `pseq` klCons appl_90 appl_96) + appl_97 `pseq` kl_declare (ApplC (wrapNamed "close" closeStream)) appl_97) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_98 = Atom Nil + !appl_99 <- appl_98 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_98 + !appl_100 <- appl_99 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_99 + !appl_101 <- appl_100 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_100 + let !appl_102 = Atom Nil + !appl_103 <- appl_101 `pseq` (appl_102 `pseq` klCons appl_101 appl_102) + !appl_104 <- appl_103 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_103 + !appl_105 <- appl_104 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_104 + appl_105 `pseq` kl_declare (ApplC (wrapNamed "cn" cn)) appl_105) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_106 = Atom Nil + !appl_107 <- appl_106 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_106 + !appl_108 <- appl_107 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.==>")) appl_107 + !appl_109 <- appl_108 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_108 + let !appl_110 = Atom Nil + !appl_111 <- appl_110 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_110 + !appl_112 <- appl_111 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_111 + !appl_113 <- appl_112 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_112 + let !appl_114 = Atom Nil + !appl_115 <- appl_114 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_114 + !appl_116 <- appl_115 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_115 + !appl_117 <- appl_113 `pseq` (appl_116 `pseq` klCons appl_113 appl_116) + let !appl_118 = Atom Nil + !appl_119 <- appl_117 `pseq` (appl_118 `pseq` klCons appl_117 appl_118) + !appl_120 <- appl_119 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_119 + !appl_121 <- appl_120 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_120 + let !appl_122 = Atom Nil + !appl_123 <- appl_121 `pseq` (appl_122 `pseq` klCons appl_121 appl_122) + !appl_124 <- appl_123 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_123 + !appl_125 <- appl_109 `pseq` (appl_124 `pseq` klCons appl_109 appl_124) + appl_125 `pseq` kl_declare (ApplC (wrapNamed "compile" kl_compile)) appl_125) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_126 = Atom Nil + !appl_127 <- appl_126 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_126 + !appl_128 <- appl_127 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_127 + !appl_129 <- appl_128 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_128 + appl_129 `pseq` kl_declare (ApplC (wrapNamed "cons?" consP)) appl_129) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_130 = Atom Nil + !appl_131 <- appl_130 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_130 + !appl_132 <- appl_131 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_131 + !appl_133 <- appl_132 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_132 + let !appl_134 = Atom Nil + !appl_135 <- appl_134 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_134 + !appl_136 <- appl_135 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_135 + !appl_137 <- appl_133 `pseq` (appl_136 `pseq` klCons appl_133 appl_136) + appl_137 `pseq` kl_declare (ApplC (wrapNamed "destroy" kl_destroy)) appl_137) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_138 = Atom Nil + !appl_139 <- appl_138 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_138 + !appl_140 <- appl_139 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_139 + let !appl_141 = Atom Nil + !appl_142 <- appl_141 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_141 + !appl_143 <- appl_142 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_142 + let !appl_144 = Atom Nil + !appl_145 <- appl_144 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_144 + !appl_146 <- appl_145 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_145 + let !appl_147 = Atom Nil + !appl_148 <- appl_146 `pseq` (appl_147 `pseq` klCons appl_146 appl_147) + !appl_149 <- appl_148 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_148 + !appl_150 <- appl_143 `pseq` (appl_149 `pseq` klCons appl_143 appl_149) + let !appl_151 = Atom Nil + !appl_152 <- appl_150 `pseq` (appl_151 `pseq` klCons appl_150 appl_151) + !appl_153 <- appl_152 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_152 + !appl_154 <- appl_140 `pseq` (appl_153 `pseq` klCons appl_140 appl_153) + appl_154 `pseq` kl_declare (ApplC (wrapNamed "difference" kl_difference)) appl_154) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_155 = Atom Nil + !appl_156 <- appl_155 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_155 + !appl_157 <- appl_156 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_156 + !appl_158 <- appl_157 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_157 + let !appl_159 = Atom Nil + !appl_160 <- appl_158 `pseq` (appl_159 `pseq` klCons appl_158 appl_159) + !appl_161 <- appl_160 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_160 + !appl_162 <- appl_161 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_161 + appl_162 `pseq` kl_declare (ApplC (wrapNamed "do" kl_do)) appl_162) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_163 = Atom Nil + !appl_164 <- appl_163 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_163 + !appl_165 <- appl_164 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_164 + let !appl_166 = Atom Nil + !appl_167 <- appl_166 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_166 + !appl_168 <- appl_167 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_167 + let !appl_169 = Atom Nil + !appl_170 <- appl_168 `pseq` (appl_169 `pseq` klCons appl_168 appl_169) + !appl_171 <- appl_170 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.==>")) appl_170 + !appl_172 <- appl_165 `pseq` (appl_171 `pseq` klCons appl_165 appl_171) + appl_172 `pseq` kl_declare (ApplC (wrapNamed "" kl_LBeRB)) appl_172) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_173 = Atom Nil + !appl_174 <- appl_173 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_173 + !appl_175 <- appl_174 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_174 + let !appl_176 = Atom Nil + !appl_177 <- appl_176 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_176 + !appl_178 <- appl_177 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_177 + let !appl_179 = Atom Nil + !appl_180 <- appl_178 `pseq` (appl_179 `pseq` klCons appl_178 appl_179) + !appl_181 <- appl_180 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.==>")) appl_180 + !appl_182 <- appl_175 `pseq` (appl_181 `pseq` klCons appl_175 appl_181) + appl_182 `pseq` kl_declare (ApplC (wrapNamed "" kl_LBExclRB)) appl_182) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_183 = Atom Nil + !appl_184 <- appl_183 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_183 + !appl_185 <- appl_184 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_184 + let !appl_186 = Atom Nil + !appl_187 <- appl_186 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_186 + !appl_188 <- appl_187 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_187 + !appl_189 <- appl_185 `pseq` (appl_188 `pseq` klCons appl_185 appl_188) + let !appl_190 = Atom Nil + !appl_191 <- appl_189 `pseq` (appl_190 `pseq` klCons appl_189 appl_190) + !appl_192 <- appl_191 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_191 + !appl_193 <- appl_192 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_192 + appl_193 `pseq` kl_declare (ApplC (wrapNamed "element?" kl_elementP)) appl_193) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_194 = Atom Nil + !appl_195 <- appl_194 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_194 + !appl_196 <- appl_195 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_195 + !appl_197 <- appl_196 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_196 + appl_197 `pseq` kl_declare (ApplC (wrapNamed "empty?" kl_emptyP)) appl_197) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_198 = Atom Nil + !appl_199 <- appl_198 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_198 + !appl_200 <- appl_199 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_199 + !appl_201 <- appl_200 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_200 + appl_201 `pseq` kl_declare (Core.Types.Atom (Core.Types.UnboundSym "enable-type-theory")) appl_201) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_202 = Atom Nil + !appl_203 <- appl_202 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_202 + !appl_204 <- appl_203 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_203 + let !appl_205 = Atom Nil + !appl_206 <- appl_204 `pseq` (appl_205 `pseq` klCons appl_204 appl_205) + !appl_207 <- appl_206 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_206 + !appl_208 <- appl_207 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_207 + appl_208 `pseq` kl_declare (ApplC (wrapNamed "external" kl_external)) appl_208) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_209 = Atom Nil + !appl_210 <- appl_209 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_209 + !appl_211 <- appl_210 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_210 + !appl_212 <- appl_211 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "exception")) appl_211 + appl_212 `pseq` kl_declare (ApplC (wrapNamed "error-to-string" errorToString)) appl_212) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_213 = Atom Nil + !appl_214 <- appl_213 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_213 + !appl_215 <- appl_214 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_214 + let !appl_216 = Atom Nil + !appl_217 <- appl_215 `pseq` (appl_216 `pseq` klCons appl_215 appl_216) + !appl_218 <- appl_217 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_217 + !appl_219 <- appl_218 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_218 + appl_219 `pseq` kl_declare (ApplC (wrapNamed "explode" kl_explode)) appl_219) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_220 = Atom Nil + !appl_221 <- appl_220 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_220 + !appl_222 <- appl_221 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_221 + appl_222 `pseq` kl_declare (ApplC (PL "fail" kl_fail)) appl_222) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_223 = Atom Nil + !appl_224 <- appl_223 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_223 + !appl_225 <- appl_224 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_224 + !appl_226 <- appl_225 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_225 + let !appl_227 = Atom Nil + !appl_228 <- appl_227 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_227 + !appl_229 <- appl_228 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_228 + !appl_230 <- appl_229 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_229 + let !appl_231 = Atom Nil + !appl_232 <- appl_230 `pseq` (appl_231 `pseq` klCons appl_230 appl_231) + !appl_233 <- appl_232 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_232 + !appl_234 <- appl_226 `pseq` (appl_233 `pseq` klCons appl_226 appl_233) + appl_234 `pseq` kl_declare (ApplC (wrapNamed "fail-if" kl_fail_if)) appl_234) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_235 = Atom Nil + !appl_236 <- appl_235 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_235 + !appl_237 <- appl_236 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_236 + !appl_238 <- appl_237 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_237 + let !appl_239 = Atom Nil + !appl_240 <- appl_239 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_239 + !appl_241 <- appl_240 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_240 + !appl_242 <- appl_241 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_241 + let !appl_243 = Atom Nil + !appl_244 <- appl_242 `pseq` (appl_243 `pseq` klCons appl_242 appl_243) + !appl_245 <- appl_244 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_244 + !appl_246 <- appl_238 `pseq` (appl_245 `pseq` klCons appl_238 appl_245) + appl_246 `pseq` kl_declare (ApplC (wrapNamed "fix" kl_fix)) appl_246) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_247 = Atom Nil + !appl_248 <- appl_247 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_247 + !appl_249 <- appl_248 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lazy")) appl_248 + let !appl_250 = Atom Nil + !appl_251 <- appl_249 `pseq` (appl_250 `pseq` klCons appl_249 appl_250) + !appl_252 <- appl_251 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_251 + !appl_253 <- appl_252 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_252 + appl_253 `pseq` kl_declare (Core.Types.Atom (Core.Types.UnboundSym "freeze")) appl_253) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_254 = Atom Nil + !appl_255 <- appl_254 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_254 + !appl_256 <- appl_255 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_255 + !appl_257 <- appl_256 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_256 + let !appl_258 = Atom Nil + !appl_259 <- appl_258 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_258 + !appl_260 <- appl_259 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_259 + !appl_261 <- appl_257 `pseq` (appl_260 `pseq` klCons appl_257 appl_260) + appl_261 `pseq` kl_declare (ApplC (wrapNamed "fst" kl_fst)) appl_261) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_262 = Atom Nil + !appl_263 <- appl_262 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_262 + !appl_264 <- appl_263 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_263 + !appl_265 <- appl_264 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_264 + let !appl_266 = Atom Nil + !appl_267 <- appl_266 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_266 + !appl_268 <- appl_267 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_267 + !appl_269 <- appl_268 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_268 + let !appl_270 = Atom Nil + !appl_271 <- appl_269 `pseq` (appl_270 `pseq` klCons appl_269 appl_270) + !appl_272 <- appl_271 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_271 + !appl_273 <- appl_265 `pseq` (appl_272 `pseq` klCons appl_265 appl_272) + appl_273 `pseq` kl_declare (ApplC (wrapNamed "function" kl_function)) appl_273) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_274 = Atom Nil + !appl_275 <- appl_274 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_274 + !appl_276 <- appl_275 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_275 + !appl_277 <- appl_276 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_276 + appl_277 `pseq` kl_declare (ApplC (wrapNamed "gensym" kl_gensym)) appl_277) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_278 = Atom Nil + !appl_279 <- appl_278 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_278 + !appl_280 <- appl_279 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_279 + let !appl_281 = Atom Nil + !appl_282 <- appl_281 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_281 + !appl_283 <- appl_282 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_282 + !appl_284 <- appl_283 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_283 + let !appl_285 = Atom Nil + !appl_286 <- appl_284 `pseq` (appl_285 `pseq` klCons appl_284 appl_285) + !appl_287 <- appl_286 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_286 + !appl_288 <- appl_280 `pseq` (appl_287 `pseq` klCons appl_280 appl_287) + appl_288 `pseq` kl_declare (ApplC (wrapNamed "<-vector" kl_LB_vector)) appl_288) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_289 = Atom Nil + !appl_290 <- appl_289 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_289 + !appl_291 <- appl_290 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_290 + let !appl_292 = Atom Nil + !appl_293 <- appl_292 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_292 + !appl_294 <- appl_293 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lazy")) appl_293 + let !appl_295 = Atom Nil + !appl_296 <- appl_295 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_295 + !appl_297 <- appl_296 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_296 + !appl_298 <- appl_294 `pseq` (appl_297 `pseq` klCons appl_294 appl_297) + let !appl_299 = Atom Nil + !appl_300 <- appl_298 `pseq` (appl_299 `pseq` klCons appl_298 appl_299) + !appl_301 <- appl_300 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_300 + !appl_302 <- appl_301 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_301 + let !appl_303 = Atom Nil + !appl_304 <- appl_302 `pseq` (appl_303 `pseq` klCons appl_302 appl_303) + !appl_305 <- appl_304 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_304 + !appl_306 <- appl_291 `pseq` (appl_305 `pseq` klCons appl_291 appl_305) + appl_306 `pseq` kl_declare (ApplC (wrapNamed "<-vector/or" kl_LB_vectorDivor)) appl_306) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_307 = Atom Nil + !appl_308 <- appl_307 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_307 + !appl_309 <- appl_308 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_308 + let !appl_310 = Atom Nil + !appl_311 <- appl_310 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_310 + !appl_312 <- appl_311 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_311 + let !appl_313 = Atom Nil + !appl_314 <- appl_312 `pseq` (appl_313 `pseq` klCons appl_312 appl_313) + !appl_315 <- appl_314 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_314 + !appl_316 <- appl_315 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_315 + let !appl_317 = Atom Nil + !appl_318 <- appl_316 `pseq` (appl_317 `pseq` klCons appl_316 appl_317) + !appl_319 <- appl_318 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_318 + !appl_320 <- appl_319 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_319 + let !appl_321 = Atom Nil + !appl_322 <- appl_320 `pseq` (appl_321 `pseq` klCons appl_320 appl_321) + !appl_323 <- appl_322 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_322 + !appl_324 <- appl_309 `pseq` (appl_323 `pseq` klCons appl_309 appl_323) + appl_324 `pseq` kl_declare (ApplC (wrapNamed "vector->" kl_vector_RB)) appl_324) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_325 = Atom Nil + !appl_326 <- appl_325 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_325 + !appl_327 <- appl_326 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_326 + let !appl_328 = Atom Nil + !appl_329 <- appl_327 `pseq` (appl_328 `pseq` klCons appl_327 appl_328) + !appl_330 <- appl_329 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_329 + !appl_331 <- appl_330 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_330 + appl_331 `pseq` kl_declare (ApplC (wrapNamed "vector" kl_vector)) appl_331) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_332 = Atom Nil + !appl_333 <- appl_332 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_332 + !appl_334 <- appl_333 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_333 + !appl_335 <- appl_334 `pseq` klCons (ApplC (wrapNamed "dict" kl_dict)) appl_334 + let !appl_336 = Atom Nil + !appl_337 <- appl_335 `pseq` (appl_336 `pseq` klCons appl_335 appl_336) + !appl_338 <- appl_337 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_337 + !appl_339 <- appl_338 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_338 + appl_339 `pseq` kl_declare (ApplC (wrapNamed "dict" kl_dict)) appl_339) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_340 = Atom Nil + !appl_341 <- appl_340 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_340 + !appl_342 <- appl_341 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_341 + !appl_343 <- appl_342 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_342 + appl_343 `pseq` kl_declare (ApplC (wrapNamed "dict?" kl_dictP)) appl_343) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_344 = Atom Nil + !appl_345 <- appl_344 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_344 + !appl_346 <- appl_345 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_345 + !appl_347 <- appl_346 `pseq` klCons (ApplC (wrapNamed "dict" kl_dict)) appl_346 + let !appl_348 = Atom Nil + !appl_349 <- appl_348 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_348 + !appl_350 <- appl_349 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_349 + !appl_351 <- appl_347 `pseq` (appl_350 `pseq` klCons appl_347 appl_350) + appl_351 `pseq` kl_declare (ApplC (wrapNamed "dict-count" kl_dict_count)) appl_351) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_352 = Atom Nil + !appl_353 <- appl_352 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_352 + !appl_354 <- appl_353 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_353 + !appl_355 <- appl_354 `pseq` klCons (ApplC (wrapNamed "dict" kl_dict)) appl_354 + let !appl_356 = Atom Nil + !appl_357 <- appl_356 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_356 + !appl_358 <- appl_357 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_357 + !appl_359 <- appl_358 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_358 + let !appl_360 = Atom Nil + !appl_361 <- appl_359 `pseq` (appl_360 `pseq` klCons appl_359 appl_360) + !appl_362 <- appl_361 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_361 + !appl_363 <- appl_355 `pseq` (appl_362 `pseq` klCons appl_355 appl_362) + appl_363 `pseq` kl_declare (ApplC (wrapNamed "<-dict" kl_LB_dict)) appl_363) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_364 = Atom Nil + !appl_365 <- appl_364 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_364 + !appl_366 <- appl_365 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_365 + !appl_367 <- appl_366 `pseq` klCons (ApplC (wrapNamed "dict" kl_dict)) appl_366 + let !appl_368 = Atom Nil + !appl_369 <- appl_368 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_368 + !appl_370 <- appl_369 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lazy")) appl_369 + let !appl_371 = Atom Nil + !appl_372 <- appl_371 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_371 + !appl_373 <- appl_372 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_372 + !appl_374 <- appl_370 `pseq` (appl_373 `pseq` klCons appl_370 appl_373) + let !appl_375 = Atom Nil + !appl_376 <- appl_374 `pseq` (appl_375 `pseq` klCons appl_374 appl_375) + !appl_377 <- appl_376 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_376 + !appl_378 <- appl_377 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_377 + let !appl_379 = Atom Nil + !appl_380 <- appl_378 `pseq` (appl_379 `pseq` klCons appl_378 appl_379) + !appl_381 <- appl_380 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_380 + !appl_382 <- appl_367 `pseq` (appl_381 `pseq` klCons appl_367 appl_381) + appl_382 `pseq` kl_declare (ApplC (wrapNamed "<-dict/or" kl_LB_dictDivor)) appl_382) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_383 = Atom Nil + !appl_384 <- appl_383 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_383 + !appl_385 <- appl_384 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_384 + !appl_386 <- appl_385 `pseq` klCons (ApplC (wrapNamed "dict" kl_dict)) appl_385 + let !appl_387 = Atom Nil + !appl_388 <- appl_387 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_387 + !appl_389 <- appl_388 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_388 + !appl_390 <- appl_389 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_389 + let !appl_391 = Atom Nil + !appl_392 <- appl_390 `pseq` (appl_391 `pseq` klCons appl_390 appl_391) + !appl_393 <- appl_392 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_392 + !appl_394 <- appl_393 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_393 + let !appl_395 = Atom Nil + !appl_396 <- appl_394 `pseq` (appl_395 `pseq` klCons appl_394 appl_395) + !appl_397 <- appl_396 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_396 + !appl_398 <- appl_386 `pseq` (appl_397 `pseq` klCons appl_386 appl_397) + appl_398 `pseq` kl_declare (ApplC (wrapNamed "dict->" kl_dict_RB)) appl_398) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_399 = Atom Nil + !appl_400 <- appl_399 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_399 + !appl_401 <- appl_400 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_400 + !appl_402 <- appl_401 `pseq` klCons (ApplC (wrapNamed "dict" kl_dict)) appl_401 + let !appl_403 = Atom Nil + !appl_404 <- appl_403 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_403 + !appl_405 <- appl_404 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_404 + !appl_406 <- appl_405 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_405 + let !appl_407 = Atom Nil + !appl_408 <- appl_406 `pseq` (appl_407 `pseq` klCons appl_406 appl_407) + !appl_409 <- appl_408 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_408 + !appl_410 <- appl_402 `pseq` (appl_409 `pseq` klCons appl_402 appl_409) + appl_410 `pseq` kl_declare (ApplC (wrapNamed "dict-rm" kl_dict_rm)) appl_410) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_411 = Atom Nil + !appl_412 <- appl_411 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_411 + !appl_413 <- appl_412 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_412 + !appl_414 <- appl_413 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_413 + let !appl_415 = Atom Nil + !appl_416 <- appl_414 `pseq` (appl_415 `pseq` klCons appl_414 appl_415) + !appl_417 <- appl_416 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_416 + !appl_418 <- appl_417 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_417 + let !appl_419 = Atom Nil + !appl_420 <- appl_418 `pseq` (appl_419 `pseq` klCons appl_418 appl_419) + !appl_421 <- appl_420 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_420 + !appl_422 <- appl_421 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_421 + let !appl_423 = Atom Nil + !appl_424 <- appl_423 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_423 + !appl_425 <- appl_424 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_424 + !appl_426 <- appl_425 `pseq` klCons (ApplC (wrapNamed "dict" kl_dict)) appl_425 + let !appl_427 = Atom Nil + !appl_428 <- appl_427 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_427 + !appl_429 <- appl_428 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_428 + !appl_430 <- appl_429 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_429 + let !appl_431 = Atom Nil + !appl_432 <- appl_430 `pseq` (appl_431 `pseq` klCons appl_430 appl_431) + !appl_433 <- appl_432 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_432 + !appl_434 <- appl_426 `pseq` (appl_433 `pseq` klCons appl_426 appl_433) + let !appl_435 = Atom Nil + !appl_436 <- appl_434 `pseq` (appl_435 `pseq` klCons appl_434 appl_435) + !appl_437 <- appl_436 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_436 + !appl_438 <- appl_422 `pseq` (appl_437 `pseq` klCons appl_422 appl_437) + appl_438 `pseq` kl_declare (ApplC (wrapNamed "dict-fold" kl_dict_fold)) appl_438) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_439 = Atom Nil + !appl_440 <- appl_439 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_439 + !appl_441 <- appl_440 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_440 + !appl_442 <- appl_441 `pseq` klCons (ApplC (wrapNamed "dict" kl_dict)) appl_441 + let !appl_443 = Atom Nil + !appl_444 <- appl_443 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_443 + !appl_445 <- appl_444 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_444 + let !appl_446 = Atom Nil + !appl_447 <- appl_445 `pseq` (appl_446 `pseq` klCons appl_445 appl_446) + !appl_448 <- appl_447 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_447 + !appl_449 <- appl_442 `pseq` (appl_448 `pseq` klCons appl_442 appl_448) + appl_449 `pseq` kl_declare (ApplC (wrapNamed "dict-keys" kl_dict_keys)) appl_449) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_450 = Atom Nil + !appl_451 <- appl_450 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_450 + !appl_452 <- appl_451 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "K")) appl_451 + !appl_453 <- appl_452 `pseq` klCons (ApplC (wrapNamed "dict" kl_dict)) appl_452 + let !appl_454 = Atom Nil + !appl_455 <- appl_454 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_454 + !appl_456 <- appl_455 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_455 + let !appl_457 = Atom Nil + !appl_458 <- appl_456 `pseq` (appl_457 `pseq` klCons appl_456 appl_457) + !appl_459 <- appl_458 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_458 + !appl_460 <- appl_453 `pseq` (appl_459 `pseq` klCons appl_453 appl_459) + appl_460 `pseq` kl_declare (ApplC (wrapNamed "dict-values" kl_dict_values)) appl_460) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_461 = Atom Nil + !appl_462 <- appl_461 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "unit")) appl_461 + !appl_463 <- appl_462 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_462 + !appl_464 <- appl_463 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_463 + appl_464 `pseq` kl_declare (ApplC (wrapNamed "exit" kl_exit)) appl_464) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_465 = Atom Nil + !appl_466 <- appl_465 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_465 + !appl_467 <- appl_466 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_466 + !appl_468 <- appl_467 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_467 + appl_468 `pseq` kl_declare (ApplC (wrapNamed "get-time" getTime)) appl_468) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_469 = Atom Nil + !appl_470 <- appl_469 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_469 + !appl_471 <- appl_470 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_470 + !appl_472 <- appl_471 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_471 + let !appl_473 = Atom Nil + !appl_474 <- appl_472 `pseq` (appl_473 `pseq` klCons appl_472 appl_473) + !appl_475 <- appl_474 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_474 + !appl_476 <- appl_475 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_475 + appl_476 `pseq` kl_declare (ApplC (wrapNamed "hash" kl_hash)) appl_476) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_477 = Atom Nil + !appl_478 <- appl_477 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_477 + !appl_479 <- appl_478 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_478 + let !appl_480 = Atom Nil + !appl_481 <- appl_480 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_480 + !appl_482 <- appl_481 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_481 + !appl_483 <- appl_479 `pseq` (appl_482 `pseq` klCons appl_479 appl_482) + appl_483 `pseq` kl_declare (ApplC (wrapNamed "head" kl_head)) appl_483) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_484 = Atom Nil + !appl_485 <- appl_484 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_484 + !appl_486 <- appl_485 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_485 + let !appl_487 = Atom Nil + !appl_488 <- appl_487 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_487 + !appl_489 <- appl_488 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_488 + !appl_490 <- appl_486 `pseq` (appl_489 `pseq` klCons appl_486 appl_489) + appl_490 `pseq` kl_declare (ApplC (wrapNamed "hdv" kl_hdv)) appl_490) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_491 = Atom Nil + !appl_492 <- appl_491 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_491 + !appl_493 <- appl_492 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_492 + !appl_494 <- appl_493 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_493 + appl_494 `pseq` kl_declare (ApplC (wrapNamed "hdstr" kl_hdstr)) appl_494) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_495 = Atom Nil + !appl_496 <- appl_495 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_495 + !appl_497 <- appl_496 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_496 + !appl_498 <- appl_497 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_497 + let !appl_499 = Atom Nil + !appl_500 <- appl_498 `pseq` (appl_499 `pseq` klCons appl_498 appl_499) + !appl_501 <- appl_500 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_500 + !appl_502 <- appl_501 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_501 + let !appl_503 = Atom Nil + !appl_504 <- appl_502 `pseq` (appl_503 `pseq` klCons appl_502 appl_503) + !appl_505 <- appl_504 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_504 + !appl_506 <- appl_505 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_505 + appl_506 `pseq` kl_declare (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_506) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_507 = Atom Nil + !appl_508 <- appl_507 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_507 + !appl_509 <- appl_508 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_508 + appl_509 `pseq` kl_declare (ApplC (PL "it" kl_it)) appl_509) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_510 = Atom Nil + !appl_511 <- appl_510 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_510 + !appl_512 <- appl_511 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_511 + appl_512 `pseq` kl_declare (ApplC (PL "implementation" kl_implementation)) appl_512) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_513 = Atom Nil + !appl_514 <- appl_513 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_513 + !appl_515 <- appl_514 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_514 + let !appl_516 = Atom Nil + !appl_517 <- appl_516 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_516 + !appl_518 <- appl_517 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_517 + let !appl_519 = Atom Nil + !appl_520 <- appl_518 `pseq` (appl_519 `pseq` klCons appl_518 appl_519) + !appl_521 <- appl_520 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_520 + !appl_522 <- appl_515 `pseq` (appl_521 `pseq` klCons appl_515 appl_521) + appl_522 `pseq` kl_declare (ApplC (wrapNamed "include" kl_include)) appl_522) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_523 = Atom Nil + !appl_524 <- appl_523 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_523 + !appl_525 <- appl_524 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_524 + let !appl_526 = Atom Nil + !appl_527 <- appl_526 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_526 + !appl_528 <- appl_527 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_527 + let !appl_529 = Atom Nil + !appl_530 <- appl_528 `pseq` (appl_529 `pseq` klCons appl_528 appl_529) + !appl_531 <- appl_530 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_530 + !appl_532 <- appl_525 `pseq` (appl_531 `pseq` klCons appl_525 appl_531) + appl_532 `pseq` kl_declare (ApplC (wrapNamed "include-all-but" kl_include_all_but)) appl_532) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_533 = Atom Nil + !appl_534 <- appl_533 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_533 + !appl_535 <- appl_534 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_534 + appl_535 `pseq` kl_declare (ApplC (PL "inferences" kl_inferences)) appl_535) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_536 = Atom Nil + !appl_537 <- appl_536 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_536 + !appl_538 <- appl_537 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_537 + !appl_539 <- appl_538 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_538 + let !appl_540 = Atom Nil + !appl_541 <- appl_539 `pseq` (appl_540 `pseq` klCons appl_539 appl_540) + !appl_542 <- appl_541 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_541 + !appl_543 <- appl_542 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_542 + appl_543 `pseq` kl_declare (ApplC (wrapNamed "shen.insert" kl_shen_insert)) appl_543) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_544 = Atom Nil + !appl_545 <- appl_544 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_544 + !appl_546 <- appl_545 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_545 + !appl_547 <- appl_546 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_546 + appl_547 `pseq` kl_declare (ApplC (wrapNamed "integer?" kl_integerP)) appl_547) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_548 = Atom Nil + !appl_549 <- appl_548 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_548 + !appl_550 <- appl_549 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_549 + let !appl_551 = Atom Nil + !appl_552 <- appl_550 `pseq` (appl_551 `pseq` klCons appl_550 appl_551) + !appl_553 <- appl_552 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_552 + !appl_554 <- appl_553 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_553 + appl_554 `pseq` kl_declare (ApplC (wrapNamed "internal" kl_internal)) appl_554) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_555 = Atom Nil + !appl_556 <- appl_555 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_555 + !appl_557 <- appl_556 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_556 + let !appl_558 = Atom Nil + !appl_559 <- appl_558 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_558 + !appl_560 <- appl_559 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_559 + let !appl_561 = Atom Nil + !appl_562 <- appl_561 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_561 + !appl_563 <- appl_562 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_562 + let !appl_564 = Atom Nil + !appl_565 <- appl_563 `pseq` (appl_564 `pseq` klCons appl_563 appl_564) + !appl_566 <- appl_565 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_565 + !appl_567 <- appl_560 `pseq` (appl_566 `pseq` klCons appl_560 appl_566) + let !appl_568 = Atom Nil + !appl_569 <- appl_567 `pseq` (appl_568 `pseq` klCons appl_567 appl_568) + !appl_570 <- appl_569 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_569 + !appl_571 <- appl_557 `pseq` (appl_570 `pseq` klCons appl_557 appl_570) + appl_571 `pseq` kl_declare (ApplC (wrapNamed "intersection" kl_intersection)) appl_571) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_572 = Atom Nil + !appl_573 <- appl_572 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_572 + !appl_574 <- appl_573 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_573 + appl_574 `pseq` kl_declare (ApplC (PL "kill" kl_kill)) appl_574) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_575 = Atom Nil + !appl_576 <- appl_575 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_575 + !appl_577 <- appl_576 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_576 + appl_577 `pseq` kl_declare (ApplC (PL "language" kl_language)) appl_577) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_578 = Atom Nil + !appl_579 <- appl_578 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_578 + !appl_580 <- appl_579 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_579 + let !appl_581 = Atom Nil + !appl_582 <- appl_581 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_581 + !appl_583 <- appl_582 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_582 + !appl_584 <- appl_580 `pseq` (appl_583 `pseq` klCons appl_580 appl_583) + appl_584 `pseq` kl_declare (ApplC (wrapNamed "length" kl_length)) appl_584) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_585 = Atom Nil + !appl_586 <- appl_585 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_585 + !appl_587 <- appl_586 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_586 + let !appl_588 = Atom Nil + !appl_589 <- appl_588 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_588 + !appl_590 <- appl_589 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_589 + !appl_591 <- appl_587 `pseq` (appl_590 `pseq` klCons appl_587 appl_590) + appl_591 `pseq` kl_declare (ApplC (wrapNamed "limit" kl_limit)) appl_591) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_592 = Atom Nil + !appl_593 <- appl_592 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_592 + !appl_594 <- appl_593 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_593 + !appl_595 <- appl_594 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_594 + appl_595 `pseq` kl_declare (ApplC (wrapNamed "load" kl_load)) appl_595) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_596 = Atom Nil + !appl_597 <- appl_596 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_596 + !appl_598 <- appl_597 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_597 + !appl_599 <- appl_598 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_598 + let !appl_600 = Atom Nil + !appl_601 <- appl_599 `pseq` (appl_600 `pseq` klCons appl_599 appl_600) + !appl_602 <- appl_601 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_601 + !appl_603 <- appl_602 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_602 + let !appl_604 = Atom Nil + !appl_605 <- appl_604 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_604 + !appl_606 <- appl_605 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_605 + let !appl_607 = Atom Nil + !appl_608 <- appl_607 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_607 + !appl_609 <- appl_608 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_608 + !appl_610 <- appl_606 `pseq` (appl_609 `pseq` klCons appl_606 appl_609) + let !appl_611 = Atom Nil + !appl_612 <- appl_610 `pseq` (appl_611 `pseq` klCons appl_610 appl_611) + !appl_613 <- appl_612 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_612 + !appl_614 <- appl_613 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_613 + let !appl_615 = Atom Nil + !appl_616 <- appl_614 `pseq` (appl_615 `pseq` klCons appl_614 appl_615) + !appl_617 <- appl_616 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_616 + !appl_618 <- appl_603 `pseq` (appl_617 `pseq` klCons appl_603 appl_617) + appl_618 `pseq` kl_declare (ApplC (wrapNamed "fold-left" kl_fold_left)) appl_618) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_619 = Atom Nil + !appl_620 <- appl_619 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_619 + !appl_621 <- appl_620 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_620 + !appl_622 <- appl_621 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_621 + let !appl_623 = Atom Nil + !appl_624 <- appl_622 `pseq` (appl_623 `pseq` klCons appl_622 appl_623) + !appl_625 <- appl_624 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_624 + !appl_626 <- appl_625 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_625 + let !appl_627 = Atom Nil + !appl_628 <- appl_627 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_627 + !appl_629 <- appl_628 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_628 + let !appl_630 = Atom Nil + !appl_631 <- appl_630 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_630 + !appl_632 <- appl_631 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_631 + !appl_633 <- appl_632 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_632 + let !appl_634 = Atom Nil + !appl_635 <- appl_633 `pseq` (appl_634 `pseq` klCons appl_633 appl_634) + !appl_636 <- appl_635 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_635 + !appl_637 <- appl_629 `pseq` (appl_636 `pseq` klCons appl_629 appl_636) + let !appl_638 = Atom Nil + !appl_639 <- appl_637 `pseq` (appl_638 `pseq` klCons appl_637 appl_638) + !appl_640 <- appl_639 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_639 + !appl_641 <- appl_626 `pseq` (appl_640 `pseq` klCons appl_626 appl_640) + appl_641 `pseq` kl_declare (ApplC (wrapNamed "fold-right" kl_fold_right)) appl_641) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_642 = Atom Nil + !appl_643 <- appl_642 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_642 + !appl_644 <- appl_643 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_643 + !appl_645 <- appl_644 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_644 + let !appl_646 = Atom Nil + !appl_647 <- appl_646 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_646 + !appl_648 <- appl_647 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_647 + let !appl_649 = Atom Nil + !appl_650 <- appl_649 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "unit")) appl_649 + !appl_651 <- appl_650 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_650 + !appl_652 <- appl_648 `pseq` (appl_651 `pseq` klCons appl_648 appl_651) + let !appl_653 = Atom Nil + !appl_654 <- appl_652 `pseq` (appl_653 `pseq` klCons appl_652 appl_653) + !appl_655 <- appl_654 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_654 + !appl_656 <- appl_645 `pseq` (appl_655 `pseq` klCons appl_645 appl_655) + appl_656 `pseq` kl_declare (ApplC (wrapNamed "for-each" kl_for_each)) appl_656) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_657 = Atom Nil + !appl_658 <- appl_657 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_657 + !appl_659 <- appl_658 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_658 + !appl_660 <- appl_659 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_659 + let !appl_661 = Atom Nil + !appl_662 <- appl_661 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_661 + !appl_663 <- appl_662 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_662 + let !appl_664 = Atom Nil + !appl_665 <- appl_664 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_664 + !appl_666 <- appl_665 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_665 + let !appl_667 = Atom Nil + !appl_668 <- appl_666 `pseq` (appl_667 `pseq` klCons appl_666 appl_667) + !appl_669 <- appl_668 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_668 + !appl_670 <- appl_663 `pseq` (appl_669 `pseq` klCons appl_663 appl_669) + let !appl_671 = Atom Nil + !appl_672 <- appl_670 `pseq` (appl_671 `pseq` klCons appl_670 appl_671) + !appl_673 <- appl_672 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_672 + !appl_674 <- appl_660 `pseq` (appl_673 `pseq` klCons appl_660 appl_673) + appl_674 `pseq` kl_declare (ApplC (wrapNamed "map" kl_map)) appl_674) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_675 = Atom Nil + !appl_676 <- appl_675 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_675 + !appl_677 <- appl_676 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_676 + let !appl_678 = Atom Nil + !appl_679 <- appl_677 `pseq` (appl_678 `pseq` klCons appl_677 appl_678) + !appl_680 <- appl_679 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_679 + !appl_681 <- appl_680 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_680 + let !appl_682 = Atom Nil + !appl_683 <- appl_682 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_682 + !appl_684 <- appl_683 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_683 + let !appl_685 = Atom Nil + !appl_686 <- appl_685 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_685 + !appl_687 <- appl_686 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_686 + let !appl_688 = Atom Nil + !appl_689 <- appl_687 `pseq` (appl_688 `pseq` klCons appl_687 appl_688) + !appl_690 <- appl_689 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_689 + !appl_691 <- appl_684 `pseq` (appl_690 `pseq` klCons appl_684 appl_690) + let !appl_692 = Atom Nil + !appl_693 <- appl_691 `pseq` (appl_692 `pseq` klCons appl_691 appl_692) + !appl_694 <- appl_693 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_693 + !appl_695 <- appl_681 `pseq` (appl_694 `pseq` klCons appl_681 appl_694) + appl_695 `pseq` kl_declare (ApplC (wrapNamed "mapcan" kl_mapcan)) appl_695) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_696 = Atom Nil + !appl_697 <- appl_696 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_696 + !appl_698 <- appl_697 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_697 + !appl_699 <- appl_698 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_698 + let !appl_700 = Atom Nil + !appl_701 <- appl_700 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_700 + !appl_702 <- appl_701 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_701 + let !appl_703 = Atom Nil + !appl_704 <- appl_703 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_703 + !appl_705 <- appl_704 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_704 + let !appl_706 = Atom Nil + !appl_707 <- appl_705 `pseq` (appl_706 `pseq` klCons appl_705 appl_706) + !appl_708 <- appl_707 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_707 + !appl_709 <- appl_702 `pseq` (appl_708 `pseq` klCons appl_702 appl_708) + let !appl_710 = Atom Nil + !appl_711 <- appl_709 `pseq` (appl_710 `pseq` klCons appl_709 appl_710) + !appl_712 <- appl_711 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_711 + !appl_713 <- appl_699 `pseq` (appl_712 `pseq` klCons appl_699 appl_712) + appl_713 `pseq` kl_declare (ApplC (wrapNamed "filter" kl_filter)) appl_713) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_714 = Atom Nil + !appl_715 <- appl_714 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_714 + !appl_716 <- appl_715 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_715 + !appl_717 <- appl_716 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_716 + appl_717 `pseq` kl_declare (ApplC (wrapNamed "maxinferences" kl_maxinferences)) appl_717) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_718 = Atom Nil + !appl_719 <- appl_718 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_718 + !appl_720 <- appl_719 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_719 + !appl_721 <- appl_720 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_720 + appl_721 `pseq` kl_declare (ApplC (wrapNamed "n->string" nToString)) appl_721) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_722 = Atom Nil + !appl_723 <- appl_722 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_722 + !appl_724 <- appl_723 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_723 + !appl_725 <- appl_724 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_724 + appl_725 `pseq` kl_declare (ApplC (wrapNamed "nl" kl_nl)) appl_725) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_726 = Atom Nil + !appl_727 <- appl_726 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_726 + !appl_728 <- appl_727 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_727 + !appl_729 <- appl_728 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_728 + appl_729 `pseq` kl_declare (ApplC (wrapNamed "not" kl_not)) appl_729) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_730 = Atom Nil + !appl_731 <- appl_730 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_730 + !appl_732 <- appl_731 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_731 + let !appl_733 = Atom Nil + !appl_734 <- appl_733 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_733 + !appl_735 <- appl_734 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_734 + !appl_736 <- appl_732 `pseq` (appl_735 `pseq` klCons appl_732 appl_735) + let !appl_737 = Atom Nil + !appl_738 <- appl_736 `pseq` (appl_737 `pseq` klCons appl_736 appl_737) + !appl_739 <- appl_738 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_738 + !appl_740 <- appl_739 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_739 + appl_740 `pseq` kl_declare (ApplC (wrapNamed "nth" kl_nth)) appl_740) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_741 = Atom Nil + !appl_742 <- appl_741 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_741 + !appl_743 <- appl_742 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_742 + !appl_744 <- appl_743 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_743 + appl_744 `pseq` kl_declare (ApplC (wrapNamed "number?" numberP)) appl_744) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_745 = Atom Nil + !appl_746 <- appl_745 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_745 + !appl_747 <- appl_746 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_746 + !appl_748 <- appl_747 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_747 + let !appl_749 = Atom Nil + !appl_750 <- appl_748 `pseq` (appl_749 `pseq` klCons appl_748 appl_749) + !appl_751 <- appl_750 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_750 + !appl_752 <- appl_751 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_751 + appl_752 `pseq` kl_declare (ApplC (wrapNamed "occurrences" kl_occurrences)) appl_752) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_753 = Atom Nil + !appl_754 <- appl_753 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_753 + !appl_755 <- appl_754 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_754 + !appl_756 <- appl_755 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_755 + appl_756 `pseq` kl_declare (ApplC (wrapNamed "occurs-check" kl_occurs_check)) appl_756) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_757 = Atom Nil + !appl_758 <- appl_757 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_757 + !appl_759 <- appl_758 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_758 + !appl_760 <- appl_759 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_759 + appl_760 `pseq` kl_declare (ApplC (wrapNamed "optimise" kl_optimise)) appl_760) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_761 = Atom Nil + !appl_762 <- appl_761 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_761 + !appl_763 <- appl_762 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_762 + !appl_764 <- appl_763 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_763 + let !appl_765 = Atom Nil + !appl_766 <- appl_764 `pseq` (appl_765 `pseq` klCons appl_764 appl_765) + !appl_767 <- appl_766 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_766 + !appl_768 <- appl_767 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_767 + appl_768 `pseq` kl_declare (Core.Types.Atom (Core.Types.UnboundSym "or")) appl_768) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_769 = Atom Nil + !appl_770 <- appl_769 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_769 + !appl_771 <- appl_770 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_770 + appl_771 `pseq` kl_declare (ApplC (PL "os" kl_os)) appl_771) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_772 = Atom Nil + !appl_773 <- appl_772 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_772 + !appl_774 <- appl_773 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_773 + !appl_775 <- appl_774 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_774 + appl_775 `pseq` kl_declare (ApplC (wrapNamed "package?" kl_packageP)) appl_775) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_776 = Atom Nil + !appl_777 <- appl_776 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_776 + !appl_778 <- appl_777 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_777 + appl_778 `pseq` kl_declare (ApplC (PL "port" kl_port)) appl_778) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_779 = Atom Nil + !appl_780 <- appl_779 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_779 + !appl_781 <- appl_780 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_780 + appl_781 `pseq` kl_declare (ApplC (PL "porters" kl_porters)) appl_781) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_782 = Atom Nil + !appl_783 <- appl_782 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_782 + !appl_784 <- appl_783 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_783 + !appl_785 <- appl_784 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_784 + let !appl_786 = Atom Nil + !appl_787 <- appl_785 `pseq` (appl_786 `pseq` klCons appl_785 appl_786) + !appl_788 <- appl_787 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_787 + !appl_789 <- appl_788 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_788 + appl_789 `pseq` kl_declare (ApplC (wrapNamed "pos" pos)) appl_789) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_790 = Atom Nil + !appl_791 <- appl_790 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "out")) appl_790 + !appl_792 <- appl_791 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "stream")) appl_791 + let !appl_793 = Atom Nil + !appl_794 <- appl_793 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_793 + !appl_795 <- appl_794 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_794 + !appl_796 <- appl_792 `pseq` (appl_795 `pseq` klCons appl_792 appl_795) + let !appl_797 = Atom Nil + !appl_798 <- appl_796 `pseq` (appl_797 `pseq` klCons appl_796 appl_797) + !appl_799 <- appl_798 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_798 + !appl_800 <- appl_799 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_799 + appl_800 `pseq` kl_declare (ApplC (wrapNamed "pr" kl_pr)) appl_800) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_801 = Atom Nil + !appl_802 <- appl_801 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_801 + !appl_803 <- appl_802 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_802 + !appl_804 <- appl_803 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_803 + appl_804 `pseq` kl_declare (ApplC (wrapNamed "print" kl_print)) appl_804) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_805 = Atom Nil + !appl_806 <- appl_805 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_805 + !appl_807 <- appl_806 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_806 + !appl_808 <- appl_807 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_807 + let !appl_809 = Atom Nil + !appl_810 <- appl_809 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_809 + !appl_811 <- appl_810 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_810 + !appl_812 <- appl_811 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_811 + let !appl_813 = Atom Nil + !appl_814 <- appl_812 `pseq` (appl_813 `pseq` klCons appl_812 appl_813) + !appl_815 <- appl_814 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_814 + !appl_816 <- appl_808 `pseq` (appl_815 `pseq` klCons appl_808 appl_815) + appl_816 `pseq` kl_declare (ApplC (wrapNamed "profile" kl_profile)) appl_816) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_817 = Atom Nil + !appl_818 <- appl_817 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_817 + !appl_819 <- appl_818 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_818 + let !appl_820 = Atom Nil + !appl_821 <- appl_820 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_820 + !appl_822 <- appl_821 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_821 + let !appl_823 = Atom Nil + !appl_824 <- appl_822 `pseq` (appl_823 `pseq` klCons appl_822 appl_823) + !appl_825 <- appl_824 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_824 + !appl_826 <- appl_819 `pseq` (appl_825 `pseq` klCons appl_819 appl_825) + appl_826 `pseq` kl_declare (ApplC (wrapNamed "preclude" kl_preclude)) appl_826) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_827 = Atom Nil + !appl_828 <- appl_827 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_827 + !appl_829 <- appl_828 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_828 + !appl_830 <- appl_829 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_829 + appl_830 `pseq` kl_declare (ApplC (wrapNamed "shen.proc-nl" kl_shen_proc_nl)) appl_830) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_831 = Atom Nil + !appl_832 <- appl_831 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_831 + !appl_833 <- appl_832 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_832 + !appl_834 <- appl_833 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_833 + let !appl_835 = Atom Nil + !appl_836 <- appl_835 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_835 + !appl_837 <- appl_836 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_836 + !appl_838 <- appl_837 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_837 + let !appl_839 = Atom Nil + !appl_840 <- appl_839 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_839 + !appl_841 <- appl_840 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_840 + !appl_842 <- appl_838 `pseq` (appl_841 `pseq` klCons appl_838 appl_841) + let !appl_843 = Atom Nil + !appl_844 <- appl_842 `pseq` (appl_843 `pseq` klCons appl_842 appl_843) + !appl_845 <- appl_844 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_844 + !appl_846 <- appl_834 `pseq` (appl_845 `pseq` klCons appl_834 appl_845) + appl_846 `pseq` kl_declare (ApplC (wrapNamed "profile-results" kl_profile_results)) appl_846) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_847 = Atom Nil + !appl_848 <- appl_847 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_847 + !appl_849 <- appl_848 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_848 + !appl_850 <- appl_849 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_849 + appl_850 `pseq` kl_declare (ApplC (wrapNamed "protect" kl_protect)) appl_850) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_851 = Atom Nil + !appl_852 <- appl_851 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_851 + !appl_853 <- appl_852 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_852 + let !appl_854 = Atom Nil + !appl_855 <- appl_854 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_854 + !appl_856 <- appl_855 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_855 + let !appl_857 = Atom Nil + !appl_858 <- appl_856 `pseq` (appl_857 `pseq` klCons appl_856 appl_857) + !appl_859 <- appl_858 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_858 + !appl_860 <- appl_853 `pseq` (appl_859 `pseq` klCons appl_853 appl_859) + appl_860 `pseq` kl_declare (ApplC (wrapNamed "preclude-all-but" kl_preclude_all_but)) appl_860) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_861 = Atom Nil + !appl_862 <- appl_861 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "out")) appl_861 + !appl_863 <- appl_862 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "stream")) appl_862 + let !appl_864 = Atom Nil + !appl_865 <- appl_864 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_864 + !appl_866 <- appl_865 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_865 + !appl_867 <- appl_863 `pseq` (appl_866 `pseq` klCons appl_863 appl_866) + let !appl_868 = Atom Nil + !appl_869 <- appl_867 `pseq` (appl_868 `pseq` klCons appl_867 appl_868) + !appl_870 <- appl_869 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_869 + !appl_871 <- appl_870 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_870 + appl_871 `pseq` kl_declare (ApplC (wrapNamed "shen.prhush" kl_shen_prhush)) appl_871) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_872 = Atom Nil + !appl_873 <- appl_872 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "unit")) appl_872 + !appl_874 <- appl_873 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_873 + let !appl_875 = Atom Nil + !appl_876 <- appl_874 `pseq` (appl_875 `pseq` klCons appl_874 appl_875) + !appl_877 <- appl_876 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_876 + !appl_878 <- appl_877 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_877 + appl_878 `pseq` kl_declare (ApplC (wrapNamed "ps" kl_ps)) appl_878) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_879 = Atom Nil + !appl_880 <- appl_879 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "in")) appl_879 + !appl_881 <- appl_880 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "stream")) appl_880 + let !appl_882 = Atom Nil + !appl_883 <- appl_882 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "unit")) appl_882 + !appl_884 <- appl_883 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_883 + !appl_885 <- appl_881 `pseq` (appl_884 `pseq` klCons appl_881 appl_884) + appl_885 `pseq` kl_declare (ApplC (wrapNamed "read" kl_read)) appl_885) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_886 = Atom Nil + !appl_887 <- appl_886 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "in")) appl_886 + !appl_888 <- appl_887 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "stream")) appl_887 + let !appl_889 = Atom Nil + !appl_890 <- appl_889 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_889 + !appl_891 <- appl_890 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_890 + !appl_892 <- appl_888 `pseq` (appl_891 `pseq` klCons appl_888 appl_891) + appl_892 `pseq` kl_declare (ApplC (wrapNamed "read-byte" readByte)) appl_892) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_893 = Atom Nil + !appl_894 <- appl_893 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "in")) appl_893 + !appl_895 <- appl_894 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "stream")) appl_894 + let !appl_896 = Atom Nil + !appl_897 <- appl_896 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_896 + !appl_898 <- appl_897 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_897 + !appl_899 <- appl_895 `pseq` (appl_898 `pseq` klCons appl_895 appl_898) + appl_899 `pseq` kl_declare (ApplC (wrapNamed "read-char-code" kl_read_char_code)) appl_899) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_900 = Atom Nil + !appl_901 <- appl_900 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_900 + !appl_902 <- appl_901 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_901 + let !appl_903 = Atom Nil + !appl_904 <- appl_902 `pseq` (appl_903 `pseq` klCons appl_902 appl_903) + !appl_905 <- appl_904 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_904 + !appl_906 <- appl_905 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_905 + appl_906 `pseq` kl_declare (ApplC (wrapNamed "read-file-as-bytelist" kl_read_file_as_bytelist)) appl_906) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_907 = Atom Nil + !appl_908 <- appl_907 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_907 + !appl_909 <- appl_908 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_908 + let !appl_910 = Atom Nil + !appl_911 <- appl_909 `pseq` (appl_910 `pseq` klCons appl_909 appl_910) + !appl_912 <- appl_911 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_911 + !appl_913 <- appl_912 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_912 + appl_913 `pseq` kl_declare (ApplC (wrapNamed "read-file-as-charlist" kl_read_file_as_charlist)) appl_913) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_914 = Atom Nil + !appl_915 <- appl_914 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_914 + !appl_916 <- appl_915 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_915 + !appl_917 <- appl_916 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_916 + appl_917 `pseq` kl_declare (ApplC (wrapNamed "read-file-as-string" kl_read_file_as_string)) appl_917) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_918 = Atom Nil + !appl_919 <- appl_918 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "unit")) appl_918 + !appl_920 <- appl_919 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_919 + let !appl_921 = Atom Nil + !appl_922 <- appl_920 `pseq` (appl_921 `pseq` klCons appl_920 appl_921) + !appl_923 <- appl_922 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_922 + !appl_924 <- appl_923 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_923 + appl_924 `pseq` kl_declare (ApplC (wrapNamed "read-file" kl_read_file)) appl_924) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_925 = Atom Nil + !appl_926 <- appl_925 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "unit")) appl_925 + !appl_927 <- appl_926 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_926 + let !appl_928 = Atom Nil + !appl_929 <- appl_927 `pseq` (appl_928 `pseq` klCons appl_927 appl_928) + !appl_930 <- appl_929 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_929 + !appl_931 <- appl_930 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_930 + appl_931 `pseq` kl_declare (ApplC (wrapNamed "read-from-string" kl_read_from_string)) appl_931) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_932 = Atom Nil + !appl_933 <- appl_932 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_932 + !appl_934 <- appl_933 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_933 + appl_934 `pseq` kl_declare (ApplC (PL "release" kl_release)) appl_934) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_935 = Atom Nil + !appl_936 <- appl_935 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_935 + !appl_937 <- appl_936 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_936 + let !appl_938 = Atom Nil + !appl_939 <- appl_938 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_938 + !appl_940 <- appl_939 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_939 + let !appl_941 = Atom Nil + !appl_942 <- appl_940 `pseq` (appl_941 `pseq` klCons appl_940 appl_941) + !appl_943 <- appl_942 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_942 + !appl_944 <- appl_937 `pseq` (appl_943 `pseq` klCons appl_937 appl_943) + let !appl_945 = Atom Nil + !appl_946 <- appl_944 `pseq` (appl_945 `pseq` klCons appl_944 appl_945) + !appl_947 <- appl_946 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_946 + !appl_948 <- appl_947 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_947 + appl_948 `pseq` kl_declare (ApplC (wrapNamed "remove" kl_remove)) appl_948) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_949 = Atom Nil + !appl_950 <- appl_949 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_949 + !appl_951 <- appl_950 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_950 + let !appl_952 = Atom Nil + !appl_953 <- appl_952 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_952 + !appl_954 <- appl_953 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_953 + let !appl_955 = Atom Nil + !appl_956 <- appl_954 `pseq` (appl_955 `pseq` klCons appl_954 appl_955) + !appl_957 <- appl_956 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_956 + !appl_958 <- appl_951 `pseq` (appl_957 `pseq` klCons appl_951 appl_957) + appl_958 `pseq` kl_declare (ApplC (wrapNamed "reverse" kl_reverse)) appl_958) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_959 = Atom Nil + !appl_960 <- appl_959 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_959 + !appl_961 <- appl_960 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_960 + !appl_962 <- appl_961 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_961 + appl_962 `pseq` kl_declare (ApplC (wrapNamed "simple-error" simpleError)) appl_962) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_963 = Atom Nil + !appl_964 <- appl_963 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_963 + !appl_965 <- appl_964 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_964 + !appl_966 <- appl_965 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_965 + let !appl_967 = Atom Nil + !appl_968 <- appl_967 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_967 + !appl_969 <- appl_968 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_968 + !appl_970 <- appl_966 `pseq` (appl_969 `pseq` klCons appl_966 appl_969) + appl_970 `pseq` kl_declare (ApplC (wrapNamed "snd" kl_snd)) appl_970) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_971 = Atom Nil + !appl_972 <- appl_971 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_971 + !appl_973 <- appl_972 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_972 + !appl_974 <- appl_973 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_973 + appl_974 `pseq` kl_declare (ApplC (wrapNamed "specialise" kl_specialise)) appl_974) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_975 = Atom Nil + !appl_976 <- appl_975 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_975 + !appl_977 <- appl_976 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_976 + !appl_978 <- appl_977 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_977 + appl_978 `pseq` kl_declare (ApplC (wrapNamed "spy" kl_spy)) appl_978) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_979 = Atom Nil + !appl_980 <- appl_979 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_979 + !appl_981 <- appl_980 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_980 + !appl_982 <- appl_981 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_981 + appl_982 `pseq` kl_declare (ApplC (wrapNamed "step" kl_step)) appl_982) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_983 = Atom Nil + !appl_984 <- appl_983 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "in")) appl_983 + !appl_985 <- appl_984 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "stream")) appl_984 + let !appl_986 = Atom Nil + !appl_987 <- appl_985 `pseq` (appl_986 `pseq` klCons appl_985 appl_986) + !appl_988 <- appl_987 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_987 + appl_988 `pseq` kl_declare (ApplC (PL "stinput" kl_stinput)) appl_988) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_989 = Atom Nil + !appl_990 <- appl_989 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "out")) appl_989 + !appl_991 <- appl_990 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "stream")) appl_990 + let !appl_992 = Atom Nil + !appl_993 <- appl_991 `pseq` (appl_992 `pseq` klCons appl_991 appl_992) + !appl_994 <- appl_993 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_993 + appl_994 `pseq` kl_declare (ApplC (PL "sterror" kl_sterror)) appl_994) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_995 = Atom Nil + !appl_996 <- appl_995 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "out")) appl_995 + !appl_997 <- appl_996 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "stream")) appl_996 + let !appl_998 = Atom Nil + !appl_999 <- appl_997 `pseq` (appl_998 `pseq` klCons appl_997 appl_998) + !appl_1000 <- appl_999 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_999 + appl_1000 `pseq` kl_declare (ApplC (PL "stoutput" kl_stoutput)) appl_1000) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1001 = Atom Nil + !appl_1002 <- appl_1001 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1001 + !appl_1003 <- appl_1002 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1002 + !appl_1004 <- appl_1003 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1003 + appl_1004 `pseq` kl_declare (ApplC (wrapNamed "string?" stringP)) appl_1004) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1005 = Atom Nil + !appl_1006 <- appl_1005 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_1005 + !appl_1007 <- appl_1006 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1006 + !appl_1008 <- appl_1007 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1007 + appl_1008 `pseq` kl_declare (ApplC (wrapNamed "str" str)) appl_1008) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1009 = Atom Nil + !appl_1010 <- appl_1009 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1009 + !appl_1011 <- appl_1010 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1010 + !appl_1012 <- appl_1011 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_1011 + appl_1012 `pseq` kl_declare (ApplC (wrapNamed "string->n" stringToN)) appl_1012) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1013 = Atom Nil + !appl_1014 <- appl_1013 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1013 + !appl_1015 <- appl_1014 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1014 + !appl_1016 <- appl_1015 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_1015 + appl_1016 `pseq` kl_declare (ApplC (wrapNamed "string->symbol" kl_string_RBsymbol)) appl_1016) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1017 = Atom Nil + !appl_1018 <- appl_1017 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1017 + !appl_1019 <- appl_1018 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_1018 + let !appl_1020 = Atom Nil + !appl_1021 <- appl_1020 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1020 + !appl_1022 <- appl_1021 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1021 + !appl_1023 <- appl_1019 `pseq` (appl_1022 `pseq` klCons appl_1019 appl_1022) + appl_1023 `pseq` kl_declare (ApplC (wrapNamed "sum" kl_sum)) appl_1023) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1024 = Atom Nil + !appl_1025 <- appl_1024 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1024 + !appl_1026 <- appl_1025 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1025 + !appl_1027 <- appl_1026 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1026 + appl_1027 `pseq` kl_declare (ApplC (wrapNamed "symbol?" kl_symbolP)) appl_1027) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1028 = Atom Nil + !appl_1029 <- appl_1028 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1028 + !appl_1030 <- appl_1029 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1029 + !appl_1031 <- appl_1030 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1030 + appl_1031 `pseq` kl_declare (ApplC (wrapNamed "systemf" kl_systemf)) appl_1031) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1032 = Atom Nil + !appl_1033 <- appl_1032 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1032 + !appl_1034 <- appl_1033 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_1033 + let !appl_1035 = Atom Nil + !appl_1036 <- appl_1035 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1035 + !appl_1037 <- appl_1036 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_1036 + let !appl_1038 = Atom Nil + !appl_1039 <- appl_1037 `pseq` (appl_1038 `pseq` klCons appl_1037 appl_1038) + !appl_1040 <- appl_1039 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1039 + !appl_1041 <- appl_1034 `pseq` (appl_1040 `pseq` klCons appl_1034 appl_1040) + appl_1041 `pseq` kl_declare (ApplC (wrapNamed "tail" kl_tail)) appl_1041) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1042 = Atom Nil + !appl_1043 <- appl_1042 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_1042 + !appl_1044 <- appl_1043 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1043 + !appl_1045 <- appl_1044 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_1044 + appl_1045 `pseq` kl_declare (ApplC (wrapNamed "tlstr" tlstr)) appl_1045) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1046 = Atom Nil + !appl_1047 <- appl_1046 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1046 + !appl_1048 <- appl_1047 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_1047 + let !appl_1049 = Atom Nil + !appl_1050 <- appl_1049 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1049 + !appl_1051 <- appl_1050 `pseq` klCons (ApplC (wrapNamed "vector" kl_vector)) appl_1050 + let !appl_1052 = Atom Nil + !appl_1053 <- appl_1051 `pseq` (appl_1052 `pseq` klCons appl_1051 appl_1052) + !appl_1054 <- appl_1053 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1053 + !appl_1055 <- appl_1048 `pseq` (appl_1054 `pseq` klCons appl_1048 appl_1054) + appl_1055 `pseq` kl_declare (ApplC (wrapNamed "tlv" kl_tlv)) appl_1055) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1056 = Atom Nil + !appl_1057 <- appl_1056 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1056 + !appl_1058 <- appl_1057 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1057 + !appl_1059 <- appl_1058 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1058 + appl_1059 `pseq` kl_declare (ApplC (wrapNamed "tc" kl_tc)) appl_1059) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1060 = Atom Nil + !appl_1061 <- appl_1060 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1060 + !appl_1062 <- appl_1061 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1061 + appl_1062 `pseq` kl_declare (ApplC (PL "tc?" kl_tcP)) appl_1062) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1063 = Atom Nil + !appl_1064 <- appl_1063 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1063 + !appl_1065 <- appl_1064 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lazy")) appl_1064 + let !appl_1066 = Atom Nil + !appl_1067 <- appl_1066 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1066 + !appl_1068 <- appl_1067 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1067 + !appl_1069 <- appl_1065 `pseq` (appl_1068 `pseq` klCons appl_1065 appl_1068) + appl_1069 `pseq` kl_declare (ApplC (wrapNamed "thaw" kl_thaw)) appl_1069) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1070 = Atom Nil + !appl_1071 <- appl_1070 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1070 + !appl_1072 <- appl_1071 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1071 + !appl_1073 <- appl_1072 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1072 + appl_1073 `pseq` kl_declare (ApplC (wrapNamed "track" kl_track)) appl_1073) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1074 = Atom Nil + !appl_1075 <- appl_1074 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1074 + !appl_1076 <- appl_1075 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1075 + !appl_1077 <- appl_1076 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "exception")) appl_1076 + let !appl_1078 = Atom Nil + !appl_1079 <- appl_1078 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1078 + !appl_1080 <- appl_1079 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1079 + !appl_1081 <- appl_1077 `pseq` (appl_1080 `pseq` klCons appl_1077 appl_1080) + let !appl_1082 = Atom Nil + !appl_1083 <- appl_1081 `pseq` (appl_1082 `pseq` klCons appl_1081 appl_1082) + !appl_1084 <- appl_1083 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1083 + !appl_1085 <- appl_1084 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1084 + appl_1085 `pseq` kl_declare (Core.Types.Atom (Core.Types.UnboundSym "trap-error")) appl_1085) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1086 = Atom Nil + !appl_1087 <- appl_1086 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1086 + !appl_1088 <- appl_1087 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1087 + !appl_1089 <- appl_1088 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1088 + appl_1089 `pseq` kl_declare (ApplC (wrapNamed "tuple?" kl_tupleP)) appl_1089) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1090 = Atom Nil + !appl_1091 <- appl_1090 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1090 + !appl_1092 <- appl_1091 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1091 + !appl_1093 <- appl_1092 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1092 + appl_1093 `pseq` kl_declare (ApplC (wrapNamed "undefmacro" kl_undefmacro)) appl_1093) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1094 = Atom Nil + !appl_1095 <- appl_1094 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1094 + !appl_1096 <- appl_1095 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_1095 + let !appl_1097 = Atom Nil + !appl_1098 <- appl_1097 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1097 + !appl_1099 <- appl_1098 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_1098 + let !appl_1100 = Atom Nil + !appl_1101 <- appl_1100 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1100 + !appl_1102 <- appl_1101 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "list")) appl_1101 + let !appl_1103 = Atom Nil + !appl_1104 <- appl_1102 `pseq` (appl_1103 `pseq` klCons appl_1102 appl_1103) + !appl_1105 <- appl_1104 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1104 + !appl_1106 <- appl_1099 `pseq` (appl_1105 `pseq` klCons appl_1099 appl_1105) + let !appl_1107 = Atom Nil + !appl_1108 <- appl_1106 `pseq` (appl_1107 `pseq` klCons appl_1106 appl_1107) + !appl_1109 <- appl_1108 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1108 + !appl_1110 <- appl_1096 `pseq` (appl_1109 `pseq` klCons appl_1096 appl_1109) + appl_1110 `pseq` kl_declare (ApplC (wrapNamed "union" kl_union)) appl_1110) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1111 = Atom Nil + !appl_1112 <- appl_1111 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_1111 + !appl_1113 <- appl_1112 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1112 + !appl_1114 <- appl_1113 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1113 + let !appl_1115 = Atom Nil + !appl_1116 <- appl_1115 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_1115 + !appl_1117 <- appl_1116 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1116 + !appl_1118 <- appl_1117 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1117 + let !appl_1119 = Atom Nil + !appl_1120 <- appl_1118 `pseq` (appl_1119 `pseq` klCons appl_1118 appl_1119) + !appl_1121 <- appl_1120 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1120 + !appl_1122 <- appl_1114 `pseq` (appl_1121 `pseq` klCons appl_1114 appl_1121) + appl_1122 `pseq` kl_declare (ApplC (wrapNamed "unprofile" kl_unprofile)) appl_1122) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1123 = Atom Nil + !appl_1124 <- appl_1123 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1123 + !appl_1125 <- appl_1124 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1124 + !appl_1126 <- appl_1125 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1125 + appl_1126 `pseq` kl_declare (ApplC (wrapNamed "untrack" kl_untrack)) appl_1126) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1127 = Atom Nil + !appl_1128 <- appl_1127 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1127 + !appl_1129 <- appl_1128 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1128 + !appl_1130 <- appl_1129 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "symbol")) appl_1129 + appl_1130 `pseq` kl_declare (ApplC (wrapNamed "unspecialise" kl_unspecialise)) appl_1130) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1131 = Atom Nil + !appl_1132 <- appl_1131 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1131 + !appl_1133 <- appl_1132 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1132 + !appl_1134 <- appl_1133 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1133 + appl_1134 `pseq` kl_declare (ApplC (wrapNamed "variable?" kl_variableP)) appl_1134) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1135 = Atom Nil + !appl_1136 <- appl_1135 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1135 + !appl_1137 <- appl_1136 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1136 + !appl_1138 <- appl_1137 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1137 + appl_1138 `pseq` kl_declare (ApplC (wrapNamed "vector?" kl_vectorP)) appl_1138) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1139 = Atom Nil + !appl_1140 <- appl_1139 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_1139 + !appl_1141 <- appl_1140 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1140 + appl_1141 `pseq` kl_declare (ApplC (PL "version" kl_version)) appl_1141) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1142 = Atom Nil + !appl_1143 <- appl_1142 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1142 + !appl_1144 <- appl_1143 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1143 + !appl_1145 <- appl_1144 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1144 + let !appl_1146 = Atom Nil + !appl_1147 <- appl_1145 `pseq` (appl_1146 `pseq` klCons appl_1145 appl_1146) + !appl_1148 <- appl_1147 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1147 + !appl_1149 <- appl_1148 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_1148 + appl_1149 `pseq` kl_declare (ApplC (wrapNamed "write-to-file" kl_write_to_file)) appl_1149) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1150 = Atom Nil + !appl_1151 <- appl_1150 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "out")) appl_1150 + !appl_1152 <- appl_1151 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "stream")) appl_1151 + let !appl_1153 = Atom Nil + !appl_1154 <- appl_1153 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1153 + !appl_1155 <- appl_1154 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1154 + !appl_1156 <- appl_1152 `pseq` (appl_1155 `pseq` klCons appl_1152 appl_1155) + let !appl_1157 = Atom Nil + !appl_1158 <- appl_1156 `pseq` (appl_1157 `pseq` klCons appl_1156 appl_1157) + !appl_1159 <- appl_1158 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1158 + !appl_1160 <- appl_1159 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1159 + appl_1160 `pseq` kl_declare (ApplC (wrapNamed "write-byte" writeByte)) appl_1160) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1161 = Atom Nil + !appl_1162 <- appl_1161 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1161 + !appl_1163 <- appl_1162 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1162 + !appl_1164 <- appl_1163 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "string")) appl_1163 + appl_1164 `pseq` kl_declare (ApplC (wrapNamed "y-or-n?" kl_y_or_nP)) appl_1164) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1165 = Atom Nil + !appl_1166 <- appl_1165 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1165 + !appl_1167 <- appl_1166 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1166 + !appl_1168 <- appl_1167 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1167 + let !appl_1169 = Atom Nil + !appl_1170 <- appl_1168 `pseq` (appl_1169 `pseq` klCons appl_1168 appl_1169) + !appl_1171 <- appl_1170 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1170 + !appl_1172 <- appl_1171 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1171 + appl_1172 `pseq` kl_declare (ApplC (wrapNamed ">" greaterThan)) appl_1172) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1173 = Atom Nil + !appl_1174 <- appl_1173 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1173 + !appl_1175 <- appl_1174 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1174 + !appl_1176 <- appl_1175 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1175 + let !appl_1177 = Atom Nil + !appl_1178 <- appl_1176 `pseq` (appl_1177 `pseq` klCons appl_1176 appl_1177) + !appl_1179 <- appl_1178 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1178 + !appl_1180 <- appl_1179 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1179 + appl_1180 `pseq` kl_declare (ApplC (wrapNamed "<" lessThan)) appl_1180) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1181 = Atom Nil + !appl_1182 <- appl_1181 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1181 + !appl_1183 <- appl_1182 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1182 + !appl_1184 <- appl_1183 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1183 + let !appl_1185 = Atom Nil + !appl_1186 <- appl_1184 `pseq` (appl_1185 `pseq` klCons appl_1184 appl_1185) + !appl_1187 <- appl_1186 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1186 + !appl_1188 <- appl_1187 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1187 + appl_1188 `pseq` kl_declare (ApplC (wrapNamed ">=" greaterThanOrEqualTo)) appl_1188) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1189 = Atom Nil + !appl_1190 <- appl_1189 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1189 + !appl_1191 <- appl_1190 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1190 + !appl_1192 <- appl_1191 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1191 + let !appl_1193 = Atom Nil + !appl_1194 <- appl_1192 `pseq` (appl_1193 `pseq` klCons appl_1192 appl_1193) + !appl_1195 <- appl_1194 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1194 + !appl_1196 <- appl_1195 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1195 + appl_1196 `pseq` kl_declare (ApplC (wrapNamed "<=" lessThanOrEqualTo)) appl_1196) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1197 = Atom Nil + !appl_1198 <- appl_1197 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1197 + !appl_1199 <- appl_1198 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1198 + !appl_1200 <- appl_1199 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1199 + let !appl_1201 = Atom Nil + !appl_1202 <- appl_1200 `pseq` (appl_1201 `pseq` klCons appl_1200 appl_1201) + !appl_1203 <- appl_1202 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1202 + !appl_1204 <- appl_1203 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1203 + appl_1204 `pseq` kl_declare (ApplC (wrapNamed "=" eq)) appl_1204) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1205 = Atom Nil + !appl_1206 <- appl_1205 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1205 + !appl_1207 <- appl_1206 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1206 + !appl_1208 <- appl_1207 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1207 + let !appl_1209 = Atom Nil + !appl_1210 <- appl_1208 `pseq` (appl_1209 `pseq` klCons appl_1208 appl_1209) + !appl_1211 <- appl_1210 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1210 + !appl_1212 <- appl_1211 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1211 + appl_1212 `pseq` kl_declare (ApplC (wrapNamed "+" add)) appl_1212) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1213 = Atom Nil + !appl_1214 <- appl_1213 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1213 + !appl_1215 <- appl_1214 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1214 + !appl_1216 <- appl_1215 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1215 + let !appl_1217 = Atom Nil + !appl_1218 <- appl_1216 `pseq` (appl_1217 `pseq` klCons appl_1216 appl_1217) + !appl_1219 <- appl_1218 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1218 + !appl_1220 <- appl_1219 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1219 + appl_1220 `pseq` kl_declare (ApplC (wrapNamed "/" divide)) appl_1220) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1221 = Atom Nil + !appl_1222 <- appl_1221 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1221 + !appl_1223 <- appl_1222 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1222 + !appl_1224 <- appl_1223 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1223 + let !appl_1225 = Atom Nil + !appl_1226 <- appl_1224 `pseq` (appl_1225 `pseq` klCons appl_1224 appl_1225) + !appl_1227 <- appl_1226 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1226 + !appl_1228 <- appl_1227 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1227 + appl_1228 `pseq` kl_declare (ApplC (wrapNamed "-" Primitives.subtract)) appl_1228) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1229 = Atom Nil + !appl_1230 <- appl_1229 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1229 + !appl_1231 <- appl_1230 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1230 + !appl_1232 <- appl_1231 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1231 + let !appl_1233 = Atom Nil + !appl_1234 <- appl_1232 `pseq` (appl_1233 `pseq` klCons appl_1232 appl_1233) + !appl_1235 <- appl_1234 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1234 + !appl_1236 <- appl_1235 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "number")) appl_1235 + appl_1236 `pseq` kl_declare (ApplC (wrapNamed "*" multiply)) appl_1236) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) + (do let !appl_1237 = Atom Nil + !appl_1238 <- appl_1237 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "boolean")) appl_1237 + !appl_1239 <- appl_1238 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1238 + !appl_1240 <- appl_1239 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "B")) appl_1239 + let !appl_1241 = Atom Nil + !appl_1242 <- appl_1240 `pseq` (appl_1241 `pseq` klCons appl_1240 appl_1241) + !appl_1243 <- appl_1242 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "-->")) appl_1242 + !appl_1244 <- appl_1243 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "A")) appl_1243 + appl_1244 `pseq` kl_declare (ApplC (wrapNamed "==" kl_EqEq)) appl_1244) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Backend/Utils.hs b/Shentong/Backend/Utils.hs --- a/Shentong/Backend/Utils.hs +++ b/Shentong/Backend/Utils.hs @@ -9,9 +9,9 @@ import Control.Parallel import qualified Data.Text as T import Data.Monoid -import Primitives -import Types -import Utils +import Core.Primitives +import Core.Types +import Core.Utils applyWrapper :: KLValue -> [KLValue] -> KLContext Env KLValue applyWrapper (ApplC ac) vs = ac `pseq` vs `pseq` foldr pseq (apply ac vs) vs diff --git a/Shentong/Backend/Writer.hs b/Shentong/Backend/Writer.hs --- a/Shentong/Backend/Writer.hs +++ b/Shentong/Backend/Writer.hs @@ -1,814 +1,950 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} - -module Backend.Writer 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 -import Backend.Core -import Backend.Sys -import Backend.Sequent -import Backend.Yacc -import Backend.Reader -import Backend.Prolog -import Backend.Track -import Backend.Load - -{- -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_pr :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_pr (!kl_V3878) (!kl_V3879) = do (do kl_V3878 `pseq` (kl_V3879 `pseq` kl_shen_prh kl_V3878 kl_V3879 (Types.Atom (Types.N (Types.KI 0))))) `catchError` (\(!kl_E) -> do return kl_V3878) - -kl_shen_prh :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_prh (!kl_V3883) (!kl_V3884) (!kl_V3885) = do !appl_0 <- kl_V3883 `pseq` (kl_V3884 `pseq` (kl_V3885 `pseq` kl_shen_write_char_and_inc kl_V3883 kl_V3884 kl_V3885)) - kl_V3883 `pseq` (kl_V3884 `pseq` (appl_0 `pseq` kl_shen_prh kl_V3883 kl_V3884 appl_0)) - -kl_shen_write_char_and_inc :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_write_char_and_inc (!kl_V3889) (!kl_V3890) (!kl_V3891) = do !appl_0 <- kl_V3889 `pseq` (kl_V3891 `pseq` pos kl_V3889 kl_V3891) - !appl_1 <- appl_0 `pseq` stringToN appl_0 - !appl_2 <- appl_1 `pseq` (kl_V3890 `pseq` writeByte appl_1 kl_V3890) - !appl_3 <- kl_V3891 `pseq` add kl_V3891 (Types.Atom (Types.N (Types.KI 1))) - appl_2 `pseq` (appl_3 `pseq` kl_do appl_2 appl_3) - -kl_print :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_print (!kl_V3893) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_String) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Print) -> do return kl_V3893))) - !appl_2 <- kl_stoutput - !appl_3 <- kl_String `pseq` (appl_2 `pseq` kl_shen_prhush kl_String appl_2) - appl_3 `pseq` applyWrapper appl_1 [appl_3]))) - !appl_4 <- kl_V3893 `pseq` kl_shen_insert kl_V3893 (Types.Atom (Types.Str "~S")) - appl_4 `pseq` applyWrapper appl_0 [appl_4] - -kl_shen_prhush :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_prhush (!kl_V3896) (!kl_V3897) = do !kl_if_0 <- value (Types.Atom (Types.UnboundSym "*hush*")) - case kl_if_0 of - Atom (B (True)) -> do return kl_V3896 - Atom (B (False)) -> do do kl_V3896 `pseq` (kl_V3897 `pseq` kl_pr kl_V3896 kl_V3897) - _ -> throwError "if: expected boolean" - -kl_shen_mkstr :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_mkstr (!kl_V3900) (!kl_V3901) = do !kl_if_0 <- kl_V3900 `pseq` stringP kl_V3900 - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- kl_V3900 `pseq` kl_shen_proc_nl kl_V3900 - appl_1 `pseq` (kl_V3901 `pseq` kl_shen_mkstr_l appl_1 kl_V3901) - Atom (B (False)) -> do do !appl_2 <- kl_V3900 `pseq` klCons kl_V3900 (Types.Atom Types.Nil) - !appl_3 <- appl_2 `pseq` klCons (ApplC (wrapNamed "shen.proc-nl" kl_shen_proc_nl)) appl_2 - appl_3 `pseq` (kl_V3901 `pseq` kl_shen_mkstr_r appl_3 kl_V3901) - _ -> throwError "if: expected boolean" - -kl_shen_mkstr_l :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_mkstr_l (!kl_V3904) (!kl_V3905) = do let pat_cond_0 = do return kl_V3904 - pat_cond_1 kl_V3905 kl_V3905h kl_V3905t = do !appl_2 <- kl_V3905h `pseq` (kl_V3904 `pseq` kl_shen_insert_l kl_V3905h kl_V3904) - appl_2 `pseq` (kl_V3905t `pseq` kl_shen_mkstr_l appl_2 kl_V3905t) - pat_cond_3 = do do kl_shen_f_error (ApplC (wrapNamed "shen.mkstr-l" kl_shen_mkstr_l)) - in case kl_V3905 of - kl_V3905@(Atom (Nil)) -> pat_cond_0 - !(kl_V3905@(Cons (!kl_V3905h) - (!kl_V3905t))) -> pat_cond_1 kl_V3905 kl_V3905h kl_V3905t - _ -> pat_cond_3 - -kl_shen_insert_l :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_insert_l (!kl_V3910) (!kl_V3911) = do let pat_cond_0 = do return (Types.Atom (Types.Str "")) - pat_cond_1 = do !kl_if_2 <- kl_V3911 `pseq` kl_shen_PlusstringP kl_V3911 - !kl_if_3 <- case kl_if_2 of - Atom (B (True)) -> do !appl_4 <- kl_V3911 `pseq` pos kl_V3911 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.Str "~")) appl_4 - !kl_if_6 <- case kl_if_5 of - Atom (B (True)) -> do !appl_7 <- kl_V3911 `pseq` tlstr kl_V3911 - !kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7 - !kl_if_9 <- case kl_if_8 of - Atom (B (True)) -> do !appl_10 <- kl_V3911 `pseq` tlstr kl_V3911 - !appl_11 <- appl_10 `pseq` pos appl_10 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_12 <- appl_11 `pseq` eq (Types.Atom (Types.Str "A")) appl_11 - case kl_if_12 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_9 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - 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" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_3 of - Atom (B (True)) -> do !appl_13 <- kl_V3911 `pseq` tlstr kl_V3911 - !appl_14 <- appl_13 `pseq` tlstr appl_13 - !appl_15 <- klCons (Types.Atom (Types.UnboundSym "shen.a")) (Types.Atom Types.Nil) - !appl_16 <- appl_14 `pseq` (appl_15 `pseq` klCons appl_14 appl_15) - !appl_17 <- kl_V3910 `pseq` (appl_16 `pseq` klCons kl_V3910 appl_16) - appl_17 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_17 - Atom (B (False)) -> do !kl_if_18 <- kl_V3911 `pseq` kl_shen_PlusstringP kl_V3911 - !kl_if_19 <- case kl_if_18 of - Atom (B (True)) -> do !appl_20 <- kl_V3911 `pseq` pos kl_V3911 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_21 <- appl_20 `pseq` eq (Types.Atom (Types.Str "~")) appl_20 - !kl_if_22 <- case kl_if_21 of - Atom (B (True)) -> do !appl_23 <- kl_V3911 `pseq` tlstr kl_V3911 - !kl_if_24 <- appl_23 `pseq` kl_shen_PlusstringP appl_23 - !kl_if_25 <- case kl_if_24 of - Atom (B (True)) -> do !appl_26 <- kl_V3911 `pseq` tlstr kl_V3911 - !appl_27 <- appl_26 `pseq` pos appl_26 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_28 <- appl_27 `pseq` eq (Types.Atom (Types.Str "R")) appl_27 - case kl_if_28 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_25 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_22 of - Atom (B (True)) -> do 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_19 of - Atom (B (True)) -> do !appl_29 <- kl_V3911 `pseq` tlstr kl_V3911 - !appl_30 <- appl_29 `pseq` tlstr appl_29 - !appl_31 <- klCons (Types.Atom (Types.UnboundSym "shen.r")) (Types.Atom Types.Nil) - !appl_32 <- appl_30 `pseq` (appl_31 `pseq` klCons appl_30 appl_31) - !appl_33 <- kl_V3910 `pseq` (appl_32 `pseq` klCons kl_V3910 appl_32) - appl_33 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_33 - Atom (B (False)) -> do !kl_if_34 <- kl_V3911 `pseq` kl_shen_PlusstringP kl_V3911 - !kl_if_35 <- case kl_if_34 of - Atom (B (True)) -> do !appl_36 <- kl_V3911 `pseq` pos kl_V3911 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_37 <- appl_36 `pseq` eq (Types.Atom (Types.Str "~")) appl_36 - !kl_if_38 <- case kl_if_37 of - Atom (B (True)) -> do !appl_39 <- kl_V3911 `pseq` tlstr kl_V3911 - !kl_if_40 <- appl_39 `pseq` kl_shen_PlusstringP appl_39 - !kl_if_41 <- case kl_if_40 of - Atom (B (True)) -> do !appl_42 <- kl_V3911 `pseq` tlstr kl_V3911 - !appl_43 <- appl_42 `pseq` pos appl_42 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_44 <- appl_43 `pseq` eq (Types.Atom (Types.Str "S")) appl_43 - case kl_if_44 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_41 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_38 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_35 of - Atom (B (True)) -> do !appl_45 <- kl_V3911 `pseq` tlstr kl_V3911 - !appl_46 <- appl_45 `pseq` tlstr appl_45 - !appl_47 <- klCons (Types.Atom (Types.UnboundSym "shen.s")) (Types.Atom Types.Nil) - !appl_48 <- appl_46 `pseq` (appl_47 `pseq` klCons appl_46 appl_47) - !appl_49 <- kl_V3910 `pseq` (appl_48 `pseq` klCons kl_V3910 appl_48) - appl_49 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_49 - Atom (B (False)) -> do !kl_if_50 <- kl_V3911 `pseq` kl_shen_PlusstringP kl_V3911 - case kl_if_50 of - Atom (B (True)) -> do !appl_51 <- kl_V3911 `pseq` pos kl_V3911 (Types.Atom (Types.N (Types.KI 0))) - !appl_52 <- kl_V3911 `pseq` tlstr kl_V3911 - !appl_53 <- kl_V3910 `pseq` (appl_52 `pseq` kl_shen_insert_l kl_V3910 appl_52) - !appl_54 <- appl_53 `pseq` klCons appl_53 (Types.Atom Types.Nil) - !appl_55 <- appl_51 `pseq` (appl_54 `pseq` klCons appl_51 appl_54) - !appl_56 <- appl_55 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_55 - appl_56 `pseq` kl_shen_factor_cn appl_56 - Atom (B (False)) -> do let pat_cond_57 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth = do !appl_58 <- kl_V3910 `pseq` (kl_V3911tth `pseq` kl_shen_insert_l kl_V3910 kl_V3911tth) - !appl_59 <- appl_58 `pseq` klCons appl_58 (Types.Atom Types.Nil) - !appl_60 <- kl_V3911th `pseq` (appl_59 `pseq` klCons kl_V3911th appl_59) - appl_60 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_60 - pat_cond_61 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth kl_V3911ttt kl_V3911ttth = do !appl_62 <- kl_V3910 `pseq` (kl_V3911tth `pseq` kl_shen_insert_l kl_V3910 kl_V3911tth) - !appl_63 <- appl_62 `pseq` (kl_V3911ttt `pseq` klCons appl_62 kl_V3911ttt) - !appl_64 <- kl_V3911th `pseq` (appl_63 `pseq` klCons kl_V3911th appl_63) - appl_64 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_64 - pat_cond_65 = do do kl_shen_f_error (ApplC (wrapNamed "shen.insert-l" kl_shen_insert_l)) - in case kl_V3911 of - !(kl_V3911@(Cons (Atom (UnboundSym "cn")) - (!(kl_V3911t@(Cons (!kl_V3911th) - (!(kl_V3911tt@(Cons (!kl_V3911tth) - (Atom (Nil)))))))))) -> pat_cond_57 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth - !(kl_V3911@(Cons (ApplC (PL "cn" - _)) - (!(kl_V3911t@(Cons (!kl_V3911th) - (!(kl_V3911tt@(Cons (!kl_V3911tth) - (Atom (Nil)))))))))) -> pat_cond_57 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth - !(kl_V3911@(Cons (ApplC (Func "cn" - _)) - (!(kl_V3911t@(Cons (!kl_V3911th) - (!(kl_V3911tt@(Cons (!kl_V3911tth) - (Atom (Nil)))))))))) -> pat_cond_57 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth - !(kl_V3911@(Cons (Atom (UnboundSym "shen.app")) - (!(kl_V3911t@(Cons (!kl_V3911th) - (!(kl_V3911tt@(Cons (!kl_V3911tth) - (!(kl_V3911ttt@(Cons (!kl_V3911ttth) - (Atom (Nil))))))))))))) -> pat_cond_61 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth kl_V3911ttt kl_V3911ttth - !(kl_V3911@(Cons (ApplC (PL "shen.app" - _)) - (!(kl_V3911t@(Cons (!kl_V3911th) - (!(kl_V3911tt@(Cons (!kl_V3911tth) - (!(kl_V3911ttt@(Cons (!kl_V3911ttth) - (Atom (Nil))))))))))))) -> pat_cond_61 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth kl_V3911ttt kl_V3911ttth - !(kl_V3911@(Cons (ApplC (Func "shen.app" - _)) - (!(kl_V3911t@(Cons (!kl_V3911th) - (!(kl_V3911tt@(Cons (!kl_V3911tth) - (!(kl_V3911ttt@(Cons (!kl_V3911ttth) - (Atom (Nil))))))))))))) -> pat_cond_61 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth kl_V3911ttt kl_V3911ttth - _ -> pat_cond_65 - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - in case kl_V3911 of - kl_V3911@(Atom (Str "")) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_factor_cn :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_factor_cn (!kl_V3913) = do !kl_if_0 <- let pat_cond_1 kl_V3913 kl_V3913h kl_V3913t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V3913t kl_V3913th kl_V3913tt = do !kl_if_6 <- let pat_cond_7 kl_V3913tt kl_V3913tth kl_V3913ttt = do !kl_if_8 <- let pat_cond_9 kl_V3913tth kl_V3913tthh kl_V3913ttht = do !kl_if_10 <- let pat_cond_11 = do !kl_if_12 <- let pat_cond_13 kl_V3913ttht kl_V3913tthth kl_V3913tthtt = do !kl_if_14 <- let pat_cond_15 kl_V3913tthtt kl_V3913tthtth kl_V3913tthttt = do !kl_if_16 <- let pat_cond_17 = do !kl_if_18 <- let pat_cond_19 = do !kl_if_20 <- kl_V3913th `pseq` stringP kl_V3913th - !kl_if_21 <- case kl_if_20 of - Atom (B (True)) -> do !kl_if_22 <- kl_V3913tthth `pseq` stringP kl_V3913tthth - case kl_if_22 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_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_23 = do do return (Atom (B False)) - in case kl_V3913ttt of - kl_V3913ttt@(Atom (Nil)) -> pat_cond_19 - _ -> pat_cond_23 - case kl_if_18 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_24 = do do return (Atom (B False)) - in case kl_V3913tthttt of - kl_V3913tthttt@(Atom (Nil)) -> pat_cond_17 - _ -> pat_cond_24 - case kl_if_16 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_25 = do do return (Atom (B False)) - in case kl_V3913tthtt of - !(kl_V3913tthtt@(Cons (!kl_V3913tthtth) - (!kl_V3913tthttt))) -> pat_cond_15 kl_V3913tthtt kl_V3913tthtth kl_V3913tthttt - _ -> pat_cond_25 - case kl_if_14 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_26 = do do return (Atom (B False)) - in case kl_V3913ttht of - !(kl_V3913ttht@(Cons (!kl_V3913tthth) - (!kl_V3913tthtt))) -> pat_cond_13 kl_V3913ttht kl_V3913tthth kl_V3913tthtt - _ -> pat_cond_26 - case kl_if_12 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_27 = do do return (Atom (B False)) - in case kl_V3913tthh of - kl_V3913tthh@(Atom (UnboundSym "cn")) -> pat_cond_11 - kl_V3913tthh@(ApplC (PL "cn" - _)) -> pat_cond_11 - kl_V3913tthh@(ApplC (Func "cn" - _)) -> pat_cond_11 - _ -> pat_cond_27 - case kl_if_10 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_28 = do do return (Atom (B False)) - in case kl_V3913tth of - !(kl_V3913tth@(Cons (!kl_V3913tthh) - (!kl_V3913ttht))) -> pat_cond_9 kl_V3913tth kl_V3913tthh kl_V3913ttht - _ -> pat_cond_28 - 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_29 = do do return (Atom (B False)) - in case kl_V3913tt of - !(kl_V3913tt@(Cons (!kl_V3913tth) - (!kl_V3913ttt))) -> pat_cond_7 kl_V3913tt kl_V3913tth kl_V3913ttt - _ -> pat_cond_29 - 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_30 = do do return (Atom (B False)) - in case kl_V3913t of - !(kl_V3913t@(Cons (!kl_V3913th) - (!kl_V3913tt))) -> pat_cond_5 kl_V3913t kl_V3913th kl_V3913tt - _ -> pat_cond_30 - 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_31 = do do return (Atom (B False)) - in case kl_V3913h of - kl_V3913h@(Atom (UnboundSym "cn")) -> pat_cond_3 - kl_V3913h@(ApplC (PL "cn" - _)) -> pat_cond_3 - kl_V3913h@(ApplC (Func "cn" - _)) -> pat_cond_3 - _ -> pat_cond_31 - 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_32 = do do return (Atom (B False)) - in case kl_V3913 of - !(kl_V3913@(Cons (!kl_V3913h) - (!kl_V3913t))) -> pat_cond_1 kl_V3913 kl_V3913h kl_V3913t - _ -> pat_cond_32 - case kl_if_0 of - Atom (B (True)) -> do !appl_33 <- kl_V3913 `pseq` tl kl_V3913 - !appl_34 <- appl_33 `pseq` hd appl_33 - !appl_35 <- kl_V3913 `pseq` tl kl_V3913 - !appl_36 <- appl_35 `pseq` tl appl_35 - !appl_37 <- appl_36 `pseq` hd appl_36 - !appl_38 <- appl_37 `pseq` tl appl_37 - !appl_39 <- appl_38 `pseq` hd appl_38 - !appl_40 <- appl_34 `pseq` (appl_39 `pseq` cn appl_34 appl_39) - !appl_41 <- kl_V3913 `pseq` tl kl_V3913 - !appl_42 <- appl_41 `pseq` tl appl_41 - !appl_43 <- appl_42 `pseq` hd appl_42 - !appl_44 <- appl_43 `pseq` tl appl_43 - !appl_45 <- appl_44 `pseq` tl appl_44 - !appl_46 <- appl_40 `pseq` (appl_45 `pseq` klCons appl_40 appl_45) - appl_46 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_46 - Atom (B (False)) -> do do return kl_V3913 - _ -> throwError "if: expected boolean" - -kl_shen_proc_nl :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_proc_nl (!kl_V3915) = do let pat_cond_0 = do return (Types.Atom (Types.Str "")) - pat_cond_1 = do !kl_if_2 <- kl_V3915 `pseq` kl_shen_PlusstringP kl_V3915 - !kl_if_3 <- case kl_if_2 of - Atom (B (True)) -> do !appl_4 <- kl_V3915 `pseq` pos kl_V3915 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.Str "~")) appl_4 - !kl_if_6 <- case kl_if_5 of - Atom (B (True)) -> do !appl_7 <- kl_V3915 `pseq` tlstr kl_V3915 - !kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7 - !kl_if_9 <- case kl_if_8 of - Atom (B (True)) -> do !appl_10 <- kl_V3915 `pseq` tlstr kl_V3915 - !appl_11 <- appl_10 `pseq` pos appl_10 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_12 <- appl_11 `pseq` eq (Types.Atom (Types.Str "%")) appl_11 - case kl_if_12 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_9 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - 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" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_3 of - Atom (B (True)) -> do !appl_13 <- nToString (Types.Atom (Types.N (Types.KI 10))) - !appl_14 <- kl_V3915 `pseq` tlstr kl_V3915 - !appl_15 <- appl_14 `pseq` tlstr appl_14 - !appl_16 <- appl_15 `pseq` kl_shen_proc_nl appl_15 - appl_13 `pseq` (appl_16 `pseq` cn appl_13 appl_16) - Atom (B (False)) -> do !kl_if_17 <- kl_V3915 `pseq` kl_shen_PlusstringP kl_V3915 - case kl_if_17 of - Atom (B (True)) -> do !appl_18 <- kl_V3915 `pseq` pos kl_V3915 (Types.Atom (Types.N (Types.KI 0))) - !appl_19 <- kl_V3915 `pseq` tlstr kl_V3915 - !appl_20 <- appl_19 `pseq` kl_shen_proc_nl appl_19 - appl_18 `pseq` (appl_20 `pseq` cn appl_18 appl_20) - Atom (B (False)) -> do do kl_shen_f_error (ApplC (wrapNamed "shen.proc-nl" kl_shen_proc_nl)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - in case kl_V3915 of - kl_V3915@(Atom (Str "")) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_mkstr_r :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_mkstr_r (!kl_V3918) (!kl_V3919) = do let pat_cond_0 = do return kl_V3918 - pat_cond_1 kl_V3919 kl_V3919h kl_V3919t = do !appl_2 <- kl_V3918 `pseq` klCons kl_V3918 (Types.Atom Types.Nil) - !appl_3 <- kl_V3919h `pseq` (appl_2 `pseq` klCons kl_V3919h appl_2) - !appl_4 <- appl_3 `pseq` klCons (ApplC (wrapNamed "shen.insert" kl_shen_insert)) appl_3 - appl_4 `pseq` (kl_V3919t `pseq` kl_shen_mkstr_r appl_4 kl_V3919t) - pat_cond_5 = do do kl_shen_f_error (ApplC (wrapNamed "shen.mkstr-r" kl_shen_mkstr_r)) - in case kl_V3919 of - kl_V3919@(Atom (Nil)) -> pat_cond_0 - !(kl_V3919@(Cons (!kl_V3919h) - (!kl_V3919t))) -> pat_cond_1 kl_V3919 kl_V3919h kl_V3919t - _ -> pat_cond_5 - -kl_shen_insert :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_insert (!kl_V3922) (!kl_V3923) = do kl_V3922 `pseq` (kl_V3923 `pseq` kl_shen_insert_h kl_V3922 kl_V3923 (Types.Atom (Types.Str ""))) - -kl_shen_insert_h :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_insert_h (!kl_V3929) (!kl_V3930) (!kl_V3931) = do let pat_cond_0 = do return kl_V3931 - pat_cond_1 = do !kl_if_2 <- kl_V3930 `pseq` kl_shen_PlusstringP kl_V3930 - !kl_if_3 <- case kl_if_2 of - Atom (B (True)) -> do !appl_4 <- kl_V3930 `pseq` pos kl_V3930 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.Str "~")) appl_4 - !kl_if_6 <- case kl_if_5 of - Atom (B (True)) -> do !appl_7 <- kl_V3930 `pseq` tlstr kl_V3930 - !kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7 - !kl_if_9 <- case kl_if_8 of - Atom (B (True)) -> do !appl_10 <- kl_V3930 `pseq` tlstr kl_V3930 - !appl_11 <- appl_10 `pseq` pos appl_10 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_12 <- appl_11 `pseq` eq (Types.Atom (Types.Str "A")) appl_11 - case kl_if_12 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_9 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - 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" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_3 of - Atom (B (True)) -> do !appl_13 <- kl_V3930 `pseq` tlstr kl_V3930 - !appl_14 <- appl_13 `pseq` tlstr appl_13 - !appl_15 <- kl_V3929 `pseq` (appl_14 `pseq` kl_shen_app kl_V3929 appl_14 (Types.Atom (Types.UnboundSym "shen.a"))) - kl_V3931 `pseq` (appl_15 `pseq` cn kl_V3931 appl_15) - Atom (B (False)) -> do !kl_if_16 <- kl_V3930 `pseq` kl_shen_PlusstringP kl_V3930 - !kl_if_17 <- case kl_if_16 of - Atom (B (True)) -> do !appl_18 <- kl_V3930 `pseq` pos kl_V3930 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_19 <- appl_18 `pseq` eq (Types.Atom (Types.Str "~")) appl_18 - !kl_if_20 <- case kl_if_19 of - Atom (B (True)) -> do !appl_21 <- kl_V3930 `pseq` tlstr kl_V3930 - !kl_if_22 <- appl_21 `pseq` kl_shen_PlusstringP appl_21 - !kl_if_23 <- case kl_if_22 of - Atom (B (True)) -> do !appl_24 <- kl_V3930 `pseq` tlstr kl_V3930 - !appl_25 <- appl_24 `pseq` pos appl_24 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_26 <- appl_25 `pseq` eq (Types.Atom (Types.Str "R")) appl_25 - case kl_if_26 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_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 return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_17 of - Atom (B (True)) -> do !appl_27 <- kl_V3930 `pseq` tlstr kl_V3930 - !appl_28 <- appl_27 `pseq` tlstr appl_27 - !appl_29 <- kl_V3929 `pseq` (appl_28 `pseq` kl_shen_app kl_V3929 appl_28 (Types.Atom (Types.UnboundSym "shen.r"))) - kl_V3931 `pseq` (appl_29 `pseq` cn kl_V3931 appl_29) - Atom (B (False)) -> do !kl_if_30 <- kl_V3930 `pseq` kl_shen_PlusstringP kl_V3930 - !kl_if_31 <- case kl_if_30 of - Atom (B (True)) -> do !appl_32 <- kl_V3930 `pseq` pos kl_V3930 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_33 <- appl_32 `pseq` eq (Types.Atom (Types.Str "~")) appl_32 - !kl_if_34 <- case kl_if_33 of - Atom (B (True)) -> do !appl_35 <- kl_V3930 `pseq` tlstr kl_V3930 - !kl_if_36 <- appl_35 `pseq` kl_shen_PlusstringP appl_35 - !kl_if_37 <- case kl_if_36 of - Atom (B (True)) -> do !appl_38 <- kl_V3930 `pseq` tlstr kl_V3930 - !appl_39 <- appl_38 `pseq` pos appl_38 (Types.Atom (Types.N (Types.KI 0))) - !kl_if_40 <- appl_39 `pseq` eq (Types.Atom (Types.Str "S")) appl_39 - case kl_if_40 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_37 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_34 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - case kl_if_31 of - Atom (B (True)) -> do !appl_41 <- kl_V3930 `pseq` tlstr kl_V3930 - !appl_42 <- appl_41 `pseq` tlstr appl_41 - !appl_43 <- kl_V3929 `pseq` (appl_42 `pseq` kl_shen_app kl_V3929 appl_42 (Types.Atom (Types.UnboundSym "shen.s"))) - kl_V3931 `pseq` (appl_43 `pseq` cn kl_V3931 appl_43) - Atom (B (False)) -> do !kl_if_44 <- kl_V3930 `pseq` kl_shen_PlusstringP kl_V3930 - case kl_if_44 of - Atom (B (True)) -> do !appl_45 <- kl_V3930 `pseq` tlstr kl_V3930 - !appl_46 <- kl_V3930 `pseq` pos kl_V3930 (Types.Atom (Types.N (Types.KI 0))) - !appl_47 <- kl_V3931 `pseq` (appl_46 `pseq` cn kl_V3931 appl_46) - kl_V3929 `pseq` (appl_45 `pseq` (appl_47 `pseq` kl_shen_insert_h kl_V3929 appl_45 appl_47)) - Atom (B (False)) -> do do kl_shen_f_error (ApplC (wrapNamed "shen.insert-h" kl_shen_insert_h)) - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - in case kl_V3930 of - kl_V3930@(Atom (Str "")) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_app :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_app (!kl_V3935) (!kl_V3936) (!kl_V3937) = do !appl_0 <- kl_V3935 `pseq` (kl_V3937 `pseq` kl_shen_arg_RBstr kl_V3935 kl_V3937) - appl_0 `pseq` (kl_V3936 `pseq` cn appl_0 kl_V3936) - -kl_shen_arg_RBstr :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_arg_RBstr (!kl_V3945) (!kl_V3946) = do !appl_0 <- kl_fail - !kl_if_1 <- kl_V3945 `pseq` (appl_0 `pseq` eq kl_V3945 appl_0) - case kl_if_1 of - Atom (B (True)) -> do return (Types.Atom (Types.Str "...")) - Atom (B (False)) -> do !kl_if_2 <- kl_V3945 `pseq` kl_shen_listP kl_V3945 - case kl_if_2 of - Atom (B (True)) -> do kl_V3945 `pseq` (kl_V3946 `pseq` kl_shen_list_RBstr kl_V3945 kl_V3946) - Atom (B (False)) -> do !kl_if_3 <- kl_V3945 `pseq` stringP kl_V3945 - case kl_if_3 of - Atom (B (True)) -> do kl_V3945 `pseq` (kl_V3946 `pseq` kl_shen_str_RBstr kl_V3945 kl_V3946) - Atom (B (False)) -> do !kl_if_4 <- kl_V3945 `pseq` absvectorP kl_V3945 - case kl_if_4 of - Atom (B (True)) -> do kl_V3945 `pseq` (kl_V3946 `pseq` kl_shen_vector_RBstr kl_V3945 kl_V3946) - Atom (B (False)) -> do do kl_V3945 `pseq` kl_shen_atom_RBstr kl_V3945 - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - -kl_shen_list_RBstr :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_list_RBstr (!kl_V3949) (!kl_V3950) = do let pat_cond_0 = do !appl_1 <- kl_shen_maxseq - !appl_2 <- kl_V3949 `pseq` (appl_1 `pseq` kl_shen_iter_list kl_V3949 (Types.Atom (Types.UnboundSym "shen.r")) appl_1) - !appl_3 <- appl_2 `pseq` kl_Ats appl_2 (Types.Atom (Types.Str ")")) - appl_3 `pseq` kl_Ats (Types.Atom (Types.Str "(")) appl_3 - pat_cond_4 = do do !appl_5 <- kl_shen_maxseq - !appl_6 <- kl_V3949 `pseq` (kl_V3950 `pseq` (appl_5 `pseq` kl_shen_iter_list kl_V3949 kl_V3950 appl_5)) - !appl_7 <- appl_6 `pseq` kl_Ats appl_6 (Types.Atom (Types.Str "]")) - appl_7 `pseq` kl_Ats (Types.Atom (Types.Str "[")) appl_7 - in case kl_V3950 of - kl_V3950@(Atom (UnboundSym "shen.r")) -> pat_cond_0 - kl_V3950@(ApplC (PL "shen.r" - _)) -> pat_cond_0 - kl_V3950@(ApplC (Func "shen.r" - _)) -> pat_cond_0 - _ -> pat_cond_4 - -kl_shen_maxseq :: Types.KLContext Types.Env Types.KLValue -kl_shen_maxseq = do value (Types.Atom (Types.UnboundSym "*maximum-print-sequence-size*")) - -kl_shen_iter_list :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_iter_list (!kl_V3964) (!kl_V3965) (!kl_V3966) = do let pat_cond_0 = do return (Types.Atom (Types.Str "")) - pat_cond_1 = do let pat_cond_2 = do return (Types.Atom (Types.Str "... etc")) - pat_cond_3 = do let pat_cond_4 kl_V3964 kl_V3964h = do kl_V3964h `pseq` (kl_V3965 `pseq` kl_shen_arg_RBstr kl_V3964h kl_V3965) - pat_cond_5 kl_V3964 kl_V3964h kl_V3964t = do !appl_6 <- kl_V3964h `pseq` (kl_V3965 `pseq` kl_shen_arg_RBstr kl_V3964h kl_V3965) - !appl_7 <- kl_V3966 `pseq` Primitives.subtract kl_V3966 (Types.Atom (Types.N (Types.KI 1))) - !appl_8 <- kl_V3964t `pseq` (kl_V3965 `pseq` (appl_7 `pseq` kl_shen_iter_list kl_V3964t kl_V3965 appl_7)) - !appl_9 <- appl_8 `pseq` kl_Ats (Types.Atom (Types.Str " ")) appl_8 - appl_6 `pseq` (appl_9 `pseq` kl_Ats appl_6 appl_9) - pat_cond_10 = do do !appl_11 <- kl_V3964 `pseq` (kl_V3965 `pseq` kl_shen_arg_RBstr kl_V3964 kl_V3965) - !appl_12 <- appl_11 `pseq` kl_Ats (Types.Atom (Types.Str " ")) appl_11 - appl_12 `pseq` kl_Ats (Types.Atom (Types.Str "|")) appl_12 - in case kl_V3964 of - !(kl_V3964@(Cons (!kl_V3964h) - (Atom (Nil)))) -> pat_cond_4 kl_V3964 kl_V3964h - !(kl_V3964@(Cons (!kl_V3964h) - (!kl_V3964t))) -> pat_cond_5 kl_V3964 kl_V3964h kl_V3964t - _ -> pat_cond_10 - in case kl_V3966 of - kl_V3966@(Atom (N (KI 0))) -> pat_cond_2 - _ -> pat_cond_3 - in case kl_V3964 of - kl_V3964@(Atom (Nil)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_str_RBstr :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_str_RBstr (!kl_V3973) (!kl_V3974) = do let pat_cond_0 = do return kl_V3973 - pat_cond_1 = do do !appl_2 <- nToString (Types.Atom (Types.N (Types.KI 34))) - !appl_3 <- nToString (Types.Atom (Types.N (Types.KI 34))) - !appl_4 <- kl_V3973 `pseq` (appl_3 `pseq` kl_Ats kl_V3973 appl_3) - appl_2 `pseq` (appl_4 `pseq` kl_Ats appl_2 appl_4) - in case kl_V3974 of - kl_V3974@(Atom (UnboundSym "shen.a")) -> pat_cond_0 - kl_V3974@(ApplC (PL "shen.a" - _)) -> pat_cond_0 - kl_V3974@(ApplC (Func "shen.a" - _)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_vector_RBstr :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_vector_RBstr (!kl_V3977) (!kl_V3978) = do !kl_if_0 <- kl_V3977 `pseq` kl_shen_print_vectorP kl_V3977 - case kl_if_0 of - Atom (B (True)) -> do !appl_1 <- kl_V3977 `pseq` addressFrom kl_V3977 (Types.Atom (Types.N (Types.KI 0))) - !appl_2 <- appl_1 `pseq` kl_function appl_1 - kl_V3977 `pseq` applyWrapper appl_2 [kl_V3977] - Atom (B (False)) -> do do !kl_if_3 <- kl_V3977 `pseq` kl_vectorP kl_V3977 - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_shen_maxseq - !appl_5 <- kl_V3977 `pseq` (kl_V3978 `pseq` (appl_4 `pseq` kl_shen_iter_vector kl_V3977 (Types.Atom (Types.N (Types.KI 1))) kl_V3978 appl_4)) - !appl_6 <- appl_5 `pseq` kl_Ats appl_5 (Types.Atom (Types.Str ">")) - appl_6 `pseq` kl_Ats (Types.Atom (Types.Str "<")) appl_6 - Atom (B (False)) -> do do !appl_7 <- kl_shen_maxseq - !appl_8 <- kl_V3977 `pseq` (kl_V3978 `pseq` (appl_7 `pseq` kl_shen_iter_vector kl_V3977 (Types.Atom (Types.N (Types.KI 0))) kl_V3978 appl_7)) - !appl_9 <- appl_8 `pseq` kl_Ats appl_8 (Types.Atom (Types.Str ">>")) - !appl_10 <- appl_9 `pseq` kl_Ats (Types.Atom (Types.Str "<")) appl_9 - appl_10 `pseq` kl_Ats (Types.Atom (Types.Str "<")) appl_10 - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - -kl_shen_print_vectorP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_print_vectorP (!kl_V3980) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Zero) -> do let pat_cond_1 = do return (Atom (B True)) - pat_cond_2 = do do let pat_cond_3 = do return (Atom (B True)) - pat_cond_4 = do do !appl_5 <- kl_Zero `pseq` numberP kl_Zero - !kl_if_6 <- appl_5 `pseq` kl_not appl_5 - case kl_if_6 of - Atom (B (True)) -> do kl_Zero `pseq` kl_shen_fboundP kl_Zero - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - in case kl_Zero of - kl_Zero@(Atom (UnboundSym "shen.pvar")) -> pat_cond_3 - kl_Zero@(ApplC (PL "shen.pvar" - _)) -> pat_cond_3 - kl_Zero@(ApplC (Func "shen.pvar" - _)) -> pat_cond_3 - _ -> pat_cond_4 - in case kl_Zero of - kl_Zero@(Atom (UnboundSym "shen.tuple")) -> pat_cond_1 - kl_Zero@(ApplC (PL "shen.tuple" - _)) -> pat_cond_1 - kl_Zero@(ApplC (Func "shen.tuple" - _)) -> pat_cond_1 - _ -> pat_cond_2))) - !appl_7 <- kl_V3980 `pseq` addressFrom kl_V3980 (Types.Atom (Types.N (Types.KI 0))) - appl_7 `pseq` applyWrapper appl_0 [appl_7] - -kl_shen_fboundP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_fboundP (!kl_V3982) = do (do !appl_0 <- kl_V3982 `pseq` kl_ps kl_V3982 - appl_0 `pseq` kl_do appl_0 (Atom (B True))) `catchError` (\(!kl_E) -> do return (Atom (B False))) - -kl_shen_tuple :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_tuple (!kl_V3984) = do !appl_0 <- kl_V3984 `pseq` addressFrom kl_V3984 (Types.Atom (Types.N (Types.KI 1))) - !appl_1 <- kl_V3984 `pseq` addressFrom kl_V3984 (Types.Atom (Types.N (Types.KI 2))) - !appl_2 <- appl_1 `pseq` kl_shen_app appl_1 (Types.Atom (Types.Str ")")) (Types.Atom (Types.UnboundSym "shen.s")) - !appl_3 <- appl_2 `pseq` cn (Types.Atom (Types.Str " ")) appl_2 - !appl_4 <- appl_0 `pseq` (appl_3 `pseq` kl_shen_app appl_0 appl_3 (Types.Atom (Types.UnboundSym "shen.s"))) - appl_4 `pseq` cn (Types.Atom (Types.Str "(@p ")) appl_4 - -kl_shen_iter_vector :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_iter_vector (!kl_V3995) (!kl_V3996) (!kl_V3997) (!kl_V3998) = do let pat_cond_0 = do return (Types.Atom (Types.Str "... etc")) - pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Item) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Next) -> do let pat_cond_4 = do return (Types.Atom (Types.Str "")) - pat_cond_5 = do do let pat_cond_6 = do kl_Item `pseq` (kl_V3997 `pseq` kl_shen_arg_RBstr kl_Item kl_V3997) - pat_cond_7 = do do !appl_8 <- kl_Item `pseq` (kl_V3997 `pseq` kl_shen_arg_RBstr kl_Item kl_V3997) - !appl_9 <- kl_V3996 `pseq` add kl_V3996 (Types.Atom (Types.N (Types.KI 1))) - !appl_10 <- kl_V3998 `pseq` Primitives.subtract kl_V3998 (Types.Atom (Types.N (Types.KI 1))) - !appl_11 <- kl_V3995 `pseq` (appl_9 `pseq` (kl_V3997 `pseq` (appl_10 `pseq` kl_shen_iter_vector kl_V3995 appl_9 kl_V3997 appl_10))) - !appl_12 <- appl_11 `pseq` kl_Ats (Types.Atom (Types.Str " ")) appl_11 - appl_8 `pseq` (appl_12 `pseq` kl_Ats appl_8 appl_12) - in case kl_Next of - kl_Next@(Atom (UnboundSym "shen.out-of-bounds")) -> pat_cond_6 - kl_Next@(ApplC (PL "shen.out-of-bounds" - _)) -> pat_cond_6 - kl_Next@(ApplC (Func "shen.out-of-bounds" - _)) -> pat_cond_6 - _ -> pat_cond_7 - in case kl_Item of - kl_Item@(Atom (UnboundSym "shen.out-of-bounds")) -> pat_cond_4 - kl_Item@(ApplC (PL "shen.out-of-bounds" - _)) -> pat_cond_4 - kl_Item@(ApplC (Func "shen.out-of-bounds" - _)) -> pat_cond_4 - _ -> pat_cond_5))) - !appl_13 <- (do !appl_14 <- kl_V3996 `pseq` add kl_V3996 (Types.Atom (Types.N (Types.KI 1))) - kl_V3995 `pseq` (appl_14 `pseq` addressFrom kl_V3995 appl_14)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.UnboundSym "shen.out-of-bounds"))) - appl_13 `pseq` applyWrapper appl_3 [appl_13]))) - !appl_15 <- (do kl_V3995 `pseq` (kl_V3996 `pseq` addressFrom kl_V3995 kl_V3996)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.UnboundSym "shen.out-of-bounds"))) - appl_15 `pseq` applyWrapper appl_2 [appl_15] - in case kl_V3998 of - kl_V3998@(Atom (N (KI 0))) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_atom_RBstr :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_atom_RBstr (!kl_V4000) = do (do kl_V4000 `pseq` str kl_V4000) `catchError` (\(!kl_E) -> do kl_shen_funexstring) - -kl_shen_funexstring :: Types.KLContext Types.Env Types.KLValue -kl_shen_funexstring = do !appl_0 <- intern (Types.Atom (Types.Str "x")) - !appl_1 <- appl_0 `pseq` kl_gensym appl_0 - !appl_2 <- appl_1 `pseq` kl_shen_arg_RBstr appl_1 (Types.Atom (Types.UnboundSym "shen.a")) - !appl_3 <- appl_2 `pseq` kl_Ats appl_2 (Types.Atom (Types.Str "\\DC1")) - !appl_4 <- appl_3 `pseq` kl_Ats (Types.Atom (Types.Str "e")) appl_3 - !appl_5 <- appl_4 `pseq` kl_Ats (Types.Atom (Types.Str "n")) appl_4 - !appl_6 <- appl_5 `pseq` kl_Ats (Types.Atom (Types.Str "u")) appl_5 - !appl_7 <- appl_6 `pseq` kl_Ats (Types.Atom (Types.Str "f")) appl_6 - appl_7 `pseq` kl_Ats (Types.Atom (Types.Str "\\DLE")) appl_7 - -kl_shen_listP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_listP (!kl_V4002) = do !kl_if_0 <- kl_V4002 `pseq` kl_emptyP kl_V4002 - case kl_if_0 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do let pat_cond_1 kl_V4002 kl_V4002h kl_V4002t = do return (Atom (B True)) - pat_cond_2 = do do return (Atom (B False)) - in case kl_V4002 of - !(kl_V4002@(Cons (!kl_V4002h) - (!kl_V4002t))) -> pat_cond_1 kl_V4002 kl_V4002h kl_V4002t - _ -> pat_cond_2 - _ -> throwError "if: expected boolean" - -expr9 :: Types.KLContext Types.Env Types.KLValue -expr9 = 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"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Writer where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel +import Backend.Core +import Backend.Sys +import Backend.Sequent +import Backend.Yacc +import Backend.Reader +import Backend.Prolog +import Backend.Track +import Backend.Load + +{- +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_pr :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_pr (!kl_V4012) (!kl_V4013) = do (do kl_V4012 `pseq` (kl_V4013 `pseq` kl_shen_prh kl_V4012 kl_V4013 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))))) `catchError` (\(!kl_E) -> do return kl_V4012) + +kl_shen_prh :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_prh (!kl_V4017) (!kl_V4018) (!kl_V4019) = do !appl_0 <- kl_V4017 `pseq` (kl_V4018 `pseq` (kl_V4019 `pseq` kl_shen_write_char_and_inc kl_V4017 kl_V4018 kl_V4019)) + kl_V4017 `pseq` (kl_V4018 `pseq` (appl_0 `pseq` kl_shen_prh kl_V4017 kl_V4018 appl_0)) + +kl_shen_write_char_and_inc :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_write_char_and_inc (!kl_V4023) (!kl_V4024) (!kl_V4025) = do !appl_0 <- kl_V4023 `pseq` (kl_V4025 `pseq` pos kl_V4023 kl_V4025) + !appl_1 <- appl_0 `pseq` stringToN appl_0 + !appl_2 <- appl_1 `pseq` (kl_V4024 `pseq` writeByte appl_1 kl_V4024) + !appl_3 <- kl_V4025 `pseq` add kl_V4025 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + appl_2 `pseq` (appl_3 `pseq` kl_do appl_2 appl_3) + +kl_print :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_print (!kl_V4027) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_String) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Print) -> do return kl_V4027))) + !appl_2 <- kl_stoutput + !appl_3 <- kl_String `pseq` (appl_2 `pseq` kl_shen_prhush kl_String appl_2) + appl_3 `pseq` applyWrapper appl_1 [appl_3]))) + !appl_4 <- kl_V4027 `pseq` kl_shen_insert kl_V4027 (Core.Types.Atom (Core.Types.Str "~S")) + appl_4 `pseq` applyWrapper appl_0 [appl_4] + +kl_shen_prhush :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_prhush (!kl_V4030) (!kl_V4031) = do !kl_if_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "*hush*")) + case kl_if_0 of + Atom (B (True)) -> do return kl_V4030 + Atom (B (False)) -> do do kl_V4030 `pseq` (kl_V4031 `pseq` kl_pr kl_V4030 kl_V4031) + _ -> throwError "if: expected boolean" + +kl_shen_mkstr :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_mkstr (!kl_V4034) (!kl_V4035) = do !kl_if_0 <- kl_V4034 `pseq` stringP kl_V4034 + case kl_if_0 of + Atom (B (True)) -> do !appl_1 <- kl_V4034 `pseq` kl_shen_proc_nl kl_V4034 + appl_1 `pseq` (kl_V4035 `pseq` kl_shen_mkstr_l appl_1 kl_V4035) + Atom (B (False)) -> do do let !appl_2 = Atom Nil + !appl_3 <- kl_V4034 `pseq` (appl_2 `pseq` klCons kl_V4034 appl_2) + !appl_4 <- appl_3 `pseq` klCons (ApplC (wrapNamed "shen.proc-nl" kl_shen_proc_nl)) appl_3 + appl_4 `pseq` (kl_V4035 `pseq` kl_shen_mkstr_r appl_4 kl_V4035) + _ -> throwError "if: expected boolean" + +kl_shen_mkstr_l :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_mkstr_l (!kl_V4038) (!kl_V4039) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V4039 `pseq` eq appl_0 kl_V4039) + case kl_if_1 of + Atom (B (True)) -> do return kl_V4038 + Atom (B (False)) -> do let pat_cond_2 kl_V4039 kl_V4039h kl_V4039t = do !appl_3 <- kl_V4039h `pseq` (kl_V4038 `pseq` kl_shen_insert_l kl_V4039h kl_V4038) + appl_3 `pseq` (kl_V4039t `pseq` kl_shen_mkstr_l appl_3 kl_V4039t) + pat_cond_4 = do do kl_shen_f_error (ApplC (wrapNamed "shen.mkstr-l" kl_shen_mkstr_l)) + in case kl_V4039 of + !(kl_V4039@(Cons (!kl_V4039h) + (!kl_V4039t))) -> pat_cond_2 kl_V4039 kl_V4039h kl_V4039t + _ -> pat_cond_4 + _ -> throwError "if: expected boolean" + +kl_shen_insert_l :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_insert_l (!kl_V4044) (!kl_V4045) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.Str "")) + pat_cond_1 = do !kl_if_2 <- kl_V4045 `pseq` kl_shen_PlusstringP kl_V4045 + !kl_if_3 <- case kl_if_2 of + Atom (B (True)) -> do !appl_4 <- kl_V4045 `pseq` pos kl_V4045 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_4 + !kl_if_6 <- case kl_if_5 of + Atom (B (True)) -> do !appl_7 <- kl_V4045 `pseq` tlstr kl_V4045 + !kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7 + !kl_if_9 <- case kl_if_8 of + Atom (B (True)) -> do !appl_10 <- kl_V4045 `pseq` tlstr kl_V4045 + !appl_11 <- appl_10 `pseq` pos appl_10 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_12 <- appl_11 `pseq` eq (Core.Types.Atom (Core.Types.Str "A")) appl_11 + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_3 of + Atom (B (True)) -> do !appl_13 <- kl_V4045 `pseq` tlstr kl_V4045 + !appl_14 <- appl_13 `pseq` tlstr appl_13 + let !appl_15 = Atom Nil + !appl_16 <- appl_15 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.a")) appl_15 + !appl_17 <- appl_14 `pseq` (appl_16 `pseq` klCons appl_14 appl_16) + !appl_18 <- kl_V4044 `pseq` (appl_17 `pseq` klCons kl_V4044 appl_17) + appl_18 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_18 + Atom (B (False)) -> do !kl_if_19 <- kl_V4045 `pseq` kl_shen_PlusstringP kl_V4045 + !kl_if_20 <- case kl_if_19 of + Atom (B (True)) -> do !appl_21 <- kl_V4045 `pseq` pos kl_V4045 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_22 <- appl_21 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_21 + !kl_if_23 <- case kl_if_22 of + Atom (B (True)) -> do !appl_24 <- kl_V4045 `pseq` tlstr kl_V4045 + !kl_if_25 <- appl_24 `pseq` kl_shen_PlusstringP appl_24 + !kl_if_26 <- case kl_if_25 of + Atom (B (True)) -> do !appl_27 <- kl_V4045 `pseq` tlstr kl_V4045 + !appl_28 <- appl_27 `pseq` pos appl_27 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_29 <- appl_28 `pseq` eq (Core.Types.Atom (Core.Types.Str "R")) appl_28 + case kl_if_29 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_26 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_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 !appl_30 <- kl_V4045 `pseq` tlstr kl_V4045 + !appl_31 <- appl_30 `pseq` tlstr appl_30 + let !appl_32 = Atom Nil + !appl_33 <- appl_32 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.r")) appl_32 + !appl_34 <- appl_31 `pseq` (appl_33 `pseq` klCons appl_31 appl_33) + !appl_35 <- kl_V4044 `pseq` (appl_34 `pseq` klCons kl_V4044 appl_34) + appl_35 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_35 + Atom (B (False)) -> do !kl_if_36 <- kl_V4045 `pseq` kl_shen_PlusstringP kl_V4045 + !kl_if_37 <- case kl_if_36 of + Atom (B (True)) -> do !appl_38 <- kl_V4045 `pseq` pos kl_V4045 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_39 <- appl_38 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_38 + !kl_if_40 <- case kl_if_39 of + Atom (B (True)) -> do !appl_41 <- kl_V4045 `pseq` tlstr kl_V4045 + !kl_if_42 <- appl_41 `pseq` kl_shen_PlusstringP appl_41 + !kl_if_43 <- case kl_if_42 of + Atom (B (True)) -> do !appl_44 <- kl_V4045 `pseq` tlstr kl_V4045 + !appl_45 <- appl_44 `pseq` pos appl_44 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_46 <- appl_45 `pseq` eq (Core.Types.Atom (Core.Types.Str "S")) appl_45 + case kl_if_46 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_43 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_40 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_37 of + Atom (B (True)) -> do !appl_47 <- kl_V4045 `pseq` tlstr kl_V4045 + !appl_48 <- appl_47 `pseq` tlstr appl_47 + let !appl_49 = Atom Nil + !appl_50 <- appl_49 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.s")) appl_49 + !appl_51 <- appl_48 `pseq` (appl_50 `pseq` klCons appl_48 appl_50) + !appl_52 <- kl_V4044 `pseq` (appl_51 `pseq` klCons kl_V4044 appl_51) + appl_52 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_52 + Atom (B (False)) -> do !kl_if_53 <- kl_V4045 `pseq` kl_shen_PlusstringP kl_V4045 + case kl_if_53 of + Atom (B (True)) -> do !appl_54 <- kl_V4045 `pseq` pos kl_V4045 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !appl_55 <- kl_V4045 `pseq` tlstr kl_V4045 + !appl_56 <- kl_V4044 `pseq` (appl_55 `pseq` kl_shen_insert_l kl_V4044 appl_55) + let !appl_57 = Atom Nil + !appl_58 <- appl_56 `pseq` (appl_57 `pseq` klCons appl_56 appl_57) + !appl_59 <- appl_54 `pseq` (appl_58 `pseq` klCons appl_54 appl_58) + !appl_60 <- appl_59 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_59 + appl_60 `pseq` kl_shen_factor_cn appl_60 + Atom (B (False)) -> do !kl_if_61 <- let pat_cond_62 kl_V4045 kl_V4045h kl_V4045t = do !kl_if_63 <- let pat_cond_64 = do !kl_if_65 <- let pat_cond_66 kl_V4045t kl_V4045th kl_V4045tt = do !kl_if_67 <- let pat_cond_68 kl_V4045tt kl_V4045tth kl_V4045ttt = do let !appl_69 = Atom Nil + !kl_if_70 <- appl_69 `pseq` (kl_V4045ttt `pseq` eq appl_69 kl_V4045ttt) + case kl_if_70 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_71 = do do return (Atom (B False)) + in case kl_V4045tt of + !(kl_V4045tt@(Cons (!kl_V4045tth) + (!kl_V4045ttt))) -> pat_cond_68 kl_V4045tt kl_V4045tth kl_V4045ttt + _ -> pat_cond_71 + case kl_if_67 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_72 = do do return (Atom (B False)) + in case kl_V4045t of + !(kl_V4045t@(Cons (!kl_V4045th) + (!kl_V4045tt))) -> pat_cond_66 kl_V4045t kl_V4045th kl_V4045tt + _ -> pat_cond_72 + case kl_if_65 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_73 = do do return (Atom (B False)) + in case kl_V4045h of + kl_V4045h@(Atom (UnboundSym "cn")) -> pat_cond_64 + kl_V4045h@(ApplC (PL "cn" + _)) -> pat_cond_64 + kl_V4045h@(ApplC (Func "cn" + _)) -> pat_cond_64 + _ -> pat_cond_73 + case kl_if_63 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_74 = do do return (Atom (B False)) + in case kl_V4045 of + !(kl_V4045@(Cons (!kl_V4045h) + (!kl_V4045t))) -> pat_cond_62 kl_V4045 kl_V4045h kl_V4045t + _ -> pat_cond_74 + case kl_if_61 of + Atom (B (True)) -> do !appl_75 <- kl_V4045 `pseq` tl kl_V4045 + !appl_76 <- appl_75 `pseq` hd appl_75 + !appl_77 <- kl_V4045 `pseq` tl kl_V4045 + !appl_78 <- appl_77 `pseq` tl appl_77 + !appl_79 <- appl_78 `pseq` hd appl_78 + !appl_80 <- kl_V4044 `pseq` (appl_79 `pseq` kl_shen_insert_l kl_V4044 appl_79) + let !appl_81 = Atom Nil + !appl_82 <- appl_80 `pseq` (appl_81 `pseq` klCons appl_80 appl_81) + !appl_83 <- appl_76 `pseq` (appl_82 `pseq` klCons appl_76 appl_82) + appl_83 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_83 + Atom (B (False)) -> do !kl_if_84 <- let pat_cond_85 kl_V4045 kl_V4045h kl_V4045t = do !kl_if_86 <- let pat_cond_87 = do !kl_if_88 <- let pat_cond_89 kl_V4045t kl_V4045th kl_V4045tt = do !kl_if_90 <- let pat_cond_91 kl_V4045tt kl_V4045tth kl_V4045ttt = do !kl_if_92 <- let pat_cond_93 kl_V4045ttt kl_V4045ttth kl_V4045tttt = do let !appl_94 = Atom Nil + !kl_if_95 <- appl_94 `pseq` (kl_V4045tttt `pseq` eq appl_94 kl_V4045tttt) + 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_96 = do do return (Atom (B False)) + in case kl_V4045ttt of + !(kl_V4045ttt@(Cons (!kl_V4045ttth) + (!kl_V4045tttt))) -> pat_cond_93 kl_V4045ttt kl_V4045ttth kl_V4045tttt + _ -> pat_cond_96 + case kl_if_92 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_97 = do do return (Atom (B False)) + in case kl_V4045tt of + !(kl_V4045tt@(Cons (!kl_V4045tth) + (!kl_V4045ttt))) -> pat_cond_91 kl_V4045tt kl_V4045tth kl_V4045ttt + _ -> pat_cond_97 + case kl_if_90 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_98 = do do return (Atom (B False)) + in case kl_V4045t of + !(kl_V4045t@(Cons (!kl_V4045th) + (!kl_V4045tt))) -> pat_cond_89 kl_V4045t kl_V4045th kl_V4045tt + _ -> pat_cond_98 + case kl_if_88 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_99 = do do return (Atom (B False)) + in case kl_V4045h of + kl_V4045h@(Atom (UnboundSym "shen.app")) -> pat_cond_87 + kl_V4045h@(ApplC (PL "shen.app" + _)) -> pat_cond_87 + kl_V4045h@(ApplC (Func "shen.app" + _)) -> pat_cond_87 + _ -> pat_cond_99 + case kl_if_86 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_100 = do do return (Atom (B False)) + in case kl_V4045 of + !(kl_V4045@(Cons (!kl_V4045h) + (!kl_V4045t))) -> pat_cond_85 kl_V4045 kl_V4045h kl_V4045t + _ -> pat_cond_100 + case kl_if_84 of + Atom (B (True)) -> do !appl_101 <- kl_V4045 `pseq` tl kl_V4045 + !appl_102 <- appl_101 `pseq` hd appl_101 + !appl_103 <- kl_V4045 `pseq` tl kl_V4045 + !appl_104 <- appl_103 `pseq` tl appl_103 + !appl_105 <- appl_104 `pseq` hd appl_104 + !appl_106 <- kl_V4044 `pseq` (appl_105 `pseq` kl_shen_insert_l kl_V4044 appl_105) + !appl_107 <- kl_V4045 `pseq` tl kl_V4045 + !appl_108 <- appl_107 `pseq` tl appl_107 + !appl_109 <- appl_108 `pseq` tl appl_108 + !appl_110 <- appl_106 `pseq` (appl_109 `pseq` klCons appl_106 appl_109) + !appl_111 <- appl_102 `pseq` (appl_110 `pseq` klCons appl_102 appl_110) + appl_111 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_111 + Atom (B (False)) -> do do kl_shen_f_error (ApplC (wrapNamed "shen.insert-l" kl_shen_insert_l)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + in case kl_V4045 of + kl_V4045@(Atom (Str "")) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_factor_cn :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_factor_cn (!kl_V4047) = do !kl_if_0 <- let pat_cond_1 kl_V4047 kl_V4047h kl_V4047t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V4047t kl_V4047th kl_V4047tt = do !kl_if_6 <- let pat_cond_7 kl_V4047tt kl_V4047tth kl_V4047ttt = do !kl_if_8 <- let pat_cond_9 kl_V4047tth kl_V4047tthh kl_V4047ttht = do !kl_if_10 <- let pat_cond_11 = do !kl_if_12 <- let pat_cond_13 kl_V4047ttht kl_V4047tthth kl_V4047tthtt = do !kl_if_14 <- let pat_cond_15 kl_V4047tthtt kl_V4047tthtth kl_V4047tthttt = do let !appl_16 = Atom Nil + !kl_if_17 <- appl_16 `pseq` (kl_V4047tthttt `pseq` eq appl_16 kl_V4047tthttt) + !kl_if_18 <- case kl_if_17 of + Atom (B (True)) -> do let !appl_19 = Atom Nil + !kl_if_20 <- appl_19 `pseq` (kl_V4047ttt `pseq` eq appl_19 kl_V4047ttt) + !kl_if_21 <- case kl_if_20 of + Atom (B (True)) -> do !kl_if_22 <- kl_V4047th `pseq` stringP kl_V4047th + !kl_if_23 <- case kl_if_22 of + Atom (B (True)) -> do !kl_if_24 <- kl_V4047tthth `pseq` stringP kl_V4047tthth + case kl_if_24 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_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_21 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_18 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_25 = do do return (Atom (B False)) + in case kl_V4047tthtt of + !(kl_V4047tthtt@(Cons (!kl_V4047tthtth) + (!kl_V4047tthttt))) -> pat_cond_15 kl_V4047tthtt kl_V4047tthtth kl_V4047tthttt + _ -> pat_cond_25 + case kl_if_14 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_26 = do do return (Atom (B False)) + in case kl_V4047ttht of + !(kl_V4047ttht@(Cons (!kl_V4047tthth) + (!kl_V4047tthtt))) -> pat_cond_13 kl_V4047ttht kl_V4047tthth kl_V4047tthtt + _ -> pat_cond_26 + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_27 = do do return (Atom (B False)) + in case kl_V4047tthh of + kl_V4047tthh@(Atom (UnboundSym "cn")) -> pat_cond_11 + kl_V4047tthh@(ApplC (PL "cn" + _)) -> pat_cond_11 + kl_V4047tthh@(ApplC (Func "cn" + _)) -> pat_cond_11 + _ -> pat_cond_27 + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_28 = do do return (Atom (B False)) + in case kl_V4047tth of + !(kl_V4047tth@(Cons (!kl_V4047tthh) + (!kl_V4047ttht))) -> pat_cond_9 kl_V4047tth kl_V4047tthh kl_V4047ttht + _ -> pat_cond_28 + 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_29 = do do return (Atom (B False)) + in case kl_V4047tt of + !(kl_V4047tt@(Cons (!kl_V4047tth) + (!kl_V4047ttt))) -> pat_cond_7 kl_V4047tt kl_V4047tth kl_V4047ttt + _ -> pat_cond_29 + 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_30 = do do return (Atom (B False)) + in case kl_V4047t of + !(kl_V4047t@(Cons (!kl_V4047th) + (!kl_V4047tt))) -> pat_cond_5 kl_V4047t kl_V4047th kl_V4047tt + _ -> pat_cond_30 + 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_31 = do do return (Atom (B False)) + in case kl_V4047h of + kl_V4047h@(Atom (UnboundSym "cn")) -> pat_cond_3 + kl_V4047h@(ApplC (PL "cn" + _)) -> pat_cond_3 + kl_V4047h@(ApplC (Func "cn" + _)) -> pat_cond_3 + _ -> pat_cond_31 + 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_32 = do do return (Atom (B False)) + in case kl_V4047 of + !(kl_V4047@(Cons (!kl_V4047h) + (!kl_V4047t))) -> pat_cond_1 kl_V4047 kl_V4047h kl_V4047t + _ -> pat_cond_32 + case kl_if_0 of + Atom (B (True)) -> do !appl_33 <- kl_V4047 `pseq` tl kl_V4047 + !appl_34 <- appl_33 `pseq` hd appl_33 + !appl_35 <- kl_V4047 `pseq` tl kl_V4047 + !appl_36 <- appl_35 `pseq` tl appl_35 + !appl_37 <- appl_36 `pseq` hd appl_36 + !appl_38 <- appl_37 `pseq` tl appl_37 + !appl_39 <- appl_38 `pseq` hd appl_38 + !appl_40 <- appl_34 `pseq` (appl_39 `pseq` cn appl_34 appl_39) + !appl_41 <- kl_V4047 `pseq` tl kl_V4047 + !appl_42 <- appl_41 `pseq` tl appl_41 + !appl_43 <- appl_42 `pseq` hd appl_42 + !appl_44 <- appl_43 `pseq` tl appl_43 + !appl_45 <- appl_44 `pseq` tl appl_44 + !appl_46 <- appl_40 `pseq` (appl_45 `pseq` klCons appl_40 appl_45) + appl_46 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_46 + Atom (B (False)) -> do do return kl_V4047 + _ -> throwError "if: expected boolean" + +kl_shen_proc_nl :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_proc_nl (!kl_V4049) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.Str "")) + pat_cond_1 = do !kl_if_2 <- kl_V4049 `pseq` kl_shen_PlusstringP kl_V4049 + !kl_if_3 <- case kl_if_2 of + Atom (B (True)) -> do !appl_4 <- kl_V4049 `pseq` pos kl_V4049 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_4 + !kl_if_6 <- case kl_if_5 of + Atom (B (True)) -> do !appl_7 <- kl_V4049 `pseq` tlstr kl_V4049 + !kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7 + !kl_if_9 <- case kl_if_8 of + Atom (B (True)) -> do !appl_10 <- kl_V4049 `pseq` tlstr kl_V4049 + !appl_11 <- appl_10 `pseq` pos appl_10 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_12 <- appl_11 `pseq` eq (Core.Types.Atom (Core.Types.Str "%")) appl_11 + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_3 of + Atom (B (True)) -> do !appl_13 <- nToString (Core.Types.Atom (Core.Types.N (Core.Types.KI 10))) + !appl_14 <- kl_V4049 `pseq` tlstr kl_V4049 + !appl_15 <- appl_14 `pseq` tlstr appl_14 + !appl_16 <- appl_15 `pseq` kl_shen_proc_nl appl_15 + appl_13 `pseq` (appl_16 `pseq` cn appl_13 appl_16) + Atom (B (False)) -> do !kl_if_17 <- kl_V4049 `pseq` kl_shen_PlusstringP kl_V4049 + case kl_if_17 of + Atom (B (True)) -> do !appl_18 <- kl_V4049 `pseq` pos kl_V4049 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !appl_19 <- kl_V4049 `pseq` tlstr kl_V4049 + !appl_20 <- appl_19 `pseq` kl_shen_proc_nl appl_19 + appl_18 `pseq` (appl_20 `pseq` cn appl_18 appl_20) + Atom (B (False)) -> do do kl_shen_f_error (ApplC (wrapNamed "shen.proc-nl" kl_shen_proc_nl)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + in case kl_V4049 of + kl_V4049@(Atom (Str "")) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_mkstr_r :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_mkstr_r (!kl_V4052) (!kl_V4053) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V4053 `pseq` eq appl_0 kl_V4053) + case kl_if_1 of + Atom (B (True)) -> do return kl_V4052 + Atom (B (False)) -> do let pat_cond_2 kl_V4053 kl_V4053h kl_V4053t = do let !appl_3 = Atom Nil + !appl_4 <- kl_V4052 `pseq` (appl_3 `pseq` klCons kl_V4052 appl_3) + !appl_5 <- kl_V4053h `pseq` (appl_4 `pseq` klCons kl_V4053h appl_4) + !appl_6 <- appl_5 `pseq` klCons (ApplC (wrapNamed "shen.insert" kl_shen_insert)) appl_5 + appl_6 `pseq` (kl_V4053t `pseq` kl_shen_mkstr_r appl_6 kl_V4053t) + pat_cond_7 = do do kl_shen_f_error (ApplC (wrapNamed "shen.mkstr-r" kl_shen_mkstr_r)) + in case kl_V4053 of + !(kl_V4053@(Cons (!kl_V4053h) + (!kl_V4053t))) -> pat_cond_2 kl_V4053 kl_V4053h kl_V4053t + _ -> pat_cond_7 + _ -> throwError "if: expected boolean" + +kl_shen_insert :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_insert (!kl_V4056) (!kl_V4057) = do kl_V4056 `pseq` (kl_V4057 `pseq` kl_shen_insert_h kl_V4056 kl_V4057 (Core.Types.Atom (Core.Types.Str ""))) + +kl_shen_insert_h :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_insert_h (!kl_V4063) (!kl_V4064) (!kl_V4065) = do let pat_cond_0 = do return kl_V4065 + pat_cond_1 = do !kl_if_2 <- kl_V4064 `pseq` kl_shen_PlusstringP kl_V4064 + !kl_if_3 <- case kl_if_2 of + Atom (B (True)) -> do !appl_4 <- kl_V4064 `pseq` pos kl_V4064 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_4 + !kl_if_6 <- case kl_if_5 of + Atom (B (True)) -> do !appl_7 <- kl_V4064 `pseq` tlstr kl_V4064 + !kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7 + !kl_if_9 <- case kl_if_8 of + Atom (B (True)) -> do !appl_10 <- kl_V4064 `pseq` tlstr kl_V4064 + !appl_11 <- appl_10 `pseq` pos appl_10 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_12 <- appl_11 `pseq` eq (Core.Types.Atom (Core.Types.Str "A")) appl_11 + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_3 of + Atom (B (True)) -> do !appl_13 <- kl_V4064 `pseq` tlstr kl_V4064 + !appl_14 <- appl_13 `pseq` tlstr appl_13 + !appl_15 <- kl_V4063 `pseq` (appl_14 `pseq` kl_shen_app kl_V4063 appl_14 (Core.Types.Atom (Core.Types.UnboundSym "shen.a"))) + kl_V4065 `pseq` (appl_15 `pseq` cn kl_V4065 appl_15) + Atom (B (False)) -> do !kl_if_16 <- kl_V4064 `pseq` kl_shen_PlusstringP kl_V4064 + !kl_if_17 <- case kl_if_16 of + Atom (B (True)) -> do !appl_18 <- kl_V4064 `pseq` pos kl_V4064 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_19 <- appl_18 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_18 + !kl_if_20 <- case kl_if_19 of + Atom (B (True)) -> do !appl_21 <- kl_V4064 `pseq` tlstr kl_V4064 + !kl_if_22 <- appl_21 `pseq` kl_shen_PlusstringP appl_21 + !kl_if_23 <- case kl_if_22 of + Atom (B (True)) -> do !appl_24 <- kl_V4064 `pseq` tlstr kl_V4064 + !appl_25 <- appl_24 `pseq` pos appl_24 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_26 <- appl_25 `pseq` eq (Core.Types.Atom (Core.Types.Str "R")) appl_25 + case kl_if_26 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_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 return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_17 of + Atom (B (True)) -> do !appl_27 <- kl_V4064 `pseq` tlstr kl_V4064 + !appl_28 <- appl_27 `pseq` tlstr appl_27 + !appl_29 <- kl_V4063 `pseq` (appl_28 `pseq` kl_shen_app kl_V4063 appl_28 (Core.Types.Atom (Core.Types.UnboundSym "shen.r"))) + kl_V4065 `pseq` (appl_29 `pseq` cn kl_V4065 appl_29) + Atom (B (False)) -> do !kl_if_30 <- kl_V4064 `pseq` kl_shen_PlusstringP kl_V4064 + !kl_if_31 <- case kl_if_30 of + Atom (B (True)) -> do !appl_32 <- kl_V4064 `pseq` pos kl_V4064 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_33 <- appl_32 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_32 + !kl_if_34 <- case kl_if_33 of + Atom (B (True)) -> do !appl_35 <- kl_V4064 `pseq` tlstr kl_V4064 + !kl_if_36 <- appl_35 `pseq` kl_shen_PlusstringP appl_35 + !kl_if_37 <- case kl_if_36 of + Atom (B (True)) -> do !appl_38 <- kl_V4064 `pseq` tlstr kl_V4064 + !appl_39 <- appl_38 `pseq` pos appl_38 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !kl_if_40 <- appl_39 `pseq` eq (Core.Types.Atom (Core.Types.Str "S")) appl_39 + case kl_if_40 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_37 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_34 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_31 of + Atom (B (True)) -> do !appl_41 <- kl_V4064 `pseq` tlstr kl_V4064 + !appl_42 <- appl_41 `pseq` tlstr appl_41 + !appl_43 <- kl_V4063 `pseq` (appl_42 `pseq` kl_shen_app kl_V4063 appl_42 (Core.Types.Atom (Core.Types.UnboundSym "shen.s"))) + kl_V4065 `pseq` (appl_43 `pseq` cn kl_V4065 appl_43) + Atom (B (False)) -> do !kl_if_44 <- kl_V4064 `pseq` kl_shen_PlusstringP kl_V4064 + case kl_if_44 of + Atom (B (True)) -> do !appl_45 <- kl_V4064 `pseq` tlstr kl_V4064 + !appl_46 <- kl_V4064 `pseq` pos kl_V4064 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !appl_47 <- kl_V4065 `pseq` (appl_46 `pseq` cn kl_V4065 appl_46) + kl_V4063 `pseq` (appl_45 `pseq` (appl_47 `pseq` kl_shen_insert_h kl_V4063 appl_45 appl_47)) + Atom (B (False)) -> do do kl_shen_f_error (ApplC (wrapNamed "shen.insert-h" kl_shen_insert_h)) + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + in case kl_V4064 of + kl_V4064@(Atom (Str "")) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_app :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_app (!kl_V4069) (!kl_V4070) (!kl_V4071) = do !appl_0 <- kl_V4069 `pseq` (kl_V4071 `pseq` kl_shen_arg_RBstr kl_V4069 kl_V4071) + appl_0 `pseq` (kl_V4070 `pseq` cn appl_0 kl_V4070) + +kl_shen_arg_RBstr :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_arg_RBstr (!kl_V4079) (!kl_V4080) = do !appl_0 <- kl_fail + !kl_if_1 <- kl_V4079 `pseq` (appl_0 `pseq` eq kl_V4079 appl_0) + case kl_if_1 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.Str "...")) + Atom (B (False)) -> do !kl_if_2 <- kl_V4079 `pseq` kl_shen_listP kl_V4079 + case kl_if_2 of + Atom (B (True)) -> do kl_V4079 `pseq` (kl_V4080 `pseq` kl_shen_list_RBstr kl_V4079 kl_V4080) + Atom (B (False)) -> do !kl_if_3 <- kl_V4079 `pseq` stringP kl_V4079 + case kl_if_3 of + Atom (B (True)) -> do kl_V4079 `pseq` (kl_V4080 `pseq` kl_shen_str_RBstr kl_V4079 kl_V4080) + Atom (B (False)) -> do !kl_if_4 <- kl_V4079 `pseq` absvectorP kl_V4079 + case kl_if_4 of + Atom (B (True)) -> do kl_V4079 `pseq` (kl_V4080 `pseq` kl_shen_vector_RBstr kl_V4079 kl_V4080) + Atom (B (False)) -> do do kl_V4079 `pseq` kl_shen_atom_RBstr kl_V4079 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_list_RBstr :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_list_RBstr (!kl_V4083) (!kl_V4084) = do let pat_cond_0 = do !appl_1 <- kl_shen_maxseq + !appl_2 <- kl_V4083 `pseq` (appl_1 `pseq` kl_shen_iter_list kl_V4083 (Core.Types.Atom (Core.Types.UnboundSym "shen.r")) appl_1) + !appl_3 <- appl_2 `pseq` kl_Ats appl_2 (Core.Types.Atom (Core.Types.Str ")")) + appl_3 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "(")) appl_3 + pat_cond_4 = do do !appl_5 <- kl_shen_maxseq + !appl_6 <- kl_V4083 `pseq` (kl_V4084 `pseq` (appl_5 `pseq` kl_shen_iter_list kl_V4083 kl_V4084 appl_5)) + !appl_7 <- appl_6 `pseq` kl_Ats appl_6 (Core.Types.Atom (Core.Types.Str "]")) + appl_7 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "[")) appl_7 + in case kl_V4084 of + kl_V4084@(Atom (UnboundSym "shen.r")) -> pat_cond_0 + kl_V4084@(ApplC (PL "shen.r" + _)) -> pat_cond_0 + kl_V4084@(ApplC (Func "shen.r" + _)) -> pat_cond_0 + _ -> pat_cond_4 + +kl_shen_maxseq :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_maxseq = do value (Core.Types.Atom (Core.Types.UnboundSym "*maximum-print-sequence-size*")) + +kl_shen_iter_list :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_iter_list (!kl_V4098) (!kl_V4099) (!kl_V4100) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V4098 `pseq` eq appl_0 kl_V4098) + case kl_if_1 of + Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.Str "")) + Atom (B (False)) -> do let pat_cond_2 = do return (Core.Types.Atom (Core.Types.Str "... etc")) + pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V4098 kl_V4098h kl_V4098t = do let !appl_6 = Atom Nil + !kl_if_7 <- appl_6 `pseq` (kl_V4098t `pseq` eq appl_6 kl_V4098t) + 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_8 = do do return (Atom (B False)) + in case kl_V4098 of + !(kl_V4098@(Cons (!kl_V4098h) + (!kl_V4098t))) -> pat_cond_5 kl_V4098 kl_V4098h kl_V4098t + _ -> pat_cond_8 + case kl_if_4 of + Atom (B (True)) -> do !appl_9 <- kl_V4098 `pseq` hd kl_V4098 + appl_9 `pseq` (kl_V4099 `pseq` kl_shen_arg_RBstr appl_9 kl_V4099) + Atom (B (False)) -> do let pat_cond_10 kl_V4098 kl_V4098h kl_V4098t = do !appl_11 <- kl_V4098h `pseq` (kl_V4099 `pseq` kl_shen_arg_RBstr kl_V4098h kl_V4099) + !appl_12 <- kl_V4100 `pseq` Primitives.subtract kl_V4100 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_13 <- kl_V4098t `pseq` (kl_V4099 `pseq` (appl_12 `pseq` kl_shen_iter_list kl_V4098t kl_V4099 appl_12)) + !appl_14 <- appl_13 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str " ")) appl_13 + appl_11 `pseq` (appl_14 `pseq` kl_Ats appl_11 appl_14) + pat_cond_15 = do do !appl_16 <- kl_V4098 `pseq` (kl_V4099 `pseq` kl_shen_arg_RBstr kl_V4098 kl_V4099) + !appl_17 <- appl_16 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str " ")) appl_16 + appl_17 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "|")) appl_17 + in case kl_V4098 of + !(kl_V4098@(Cons (!kl_V4098h) + (!kl_V4098t))) -> pat_cond_10 kl_V4098 kl_V4098h kl_V4098t + _ -> pat_cond_15 + _ -> throwError "if: expected boolean" + in case kl_V4100 of + kl_V4100@(Atom (N (KI 0))) -> pat_cond_2 + _ -> pat_cond_3 + _ -> throwError "if: expected boolean" + +kl_shen_str_RBstr :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_str_RBstr (!kl_V4107) (!kl_V4108) = do let pat_cond_0 = do return kl_V4107 + pat_cond_1 = do do !appl_2 <- nToString (Core.Types.Atom (Core.Types.N (Core.Types.KI 34))) + !appl_3 <- nToString (Core.Types.Atom (Core.Types.N (Core.Types.KI 34))) + !appl_4 <- kl_V4107 `pseq` (appl_3 `pseq` kl_Ats kl_V4107 appl_3) + appl_2 `pseq` (appl_4 `pseq` kl_Ats appl_2 appl_4) + in case kl_V4108 of + kl_V4108@(Atom (UnboundSym "shen.a")) -> pat_cond_0 + kl_V4108@(ApplC (PL "shen.a" + _)) -> pat_cond_0 + kl_V4108@(ApplC (Func "shen.a" + _)) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_vector_RBstr :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_vector_RBstr (!kl_V4111) (!kl_V4112) = do !kl_if_0 <- kl_V4111 `pseq` kl_shen_print_vectorP kl_V4111 + case kl_if_0 of + Atom (B (True)) -> do !appl_1 <- kl_V4111 `pseq` addressFrom kl_V4111 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + !appl_2 <- appl_1 `pseq` kl_function appl_1 + kl_V4111 `pseq` applyWrapper appl_2 [kl_V4111] + Atom (B (False)) -> do do !kl_if_3 <- kl_V4111 `pseq` kl_vectorP kl_V4111 + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_shen_maxseq + !appl_5 <- kl_V4111 `pseq` (kl_V4112 `pseq` (appl_4 `pseq` kl_shen_iter_vector kl_V4111 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) kl_V4112 appl_4)) + !appl_6 <- appl_5 `pseq` kl_Ats appl_5 (Core.Types.Atom (Core.Types.Str ">")) + appl_6 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "<")) appl_6 + Atom (B (False)) -> do do !appl_7 <- kl_shen_maxseq + !appl_8 <- kl_V4111 `pseq` (kl_V4112 `pseq` (appl_7 `pseq` kl_shen_iter_vector kl_V4111 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) kl_V4112 appl_7)) + !appl_9 <- appl_8 `pseq` kl_Ats appl_8 (Core.Types.Atom (Core.Types.Str ">>")) + !appl_10 <- appl_9 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "<")) appl_9 + appl_10 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "<")) appl_10 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_print_vectorP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_print_vectorP (!kl_V4114) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Zero) -> do let pat_cond_1 = do return (Atom (B True)) + pat_cond_2 = do do let pat_cond_3 = do return (Atom (B True)) + pat_cond_4 = do do let pat_cond_5 = do return (Atom (B True)) + pat_cond_6 = do do !appl_7 <- kl_Zero `pseq` numberP kl_Zero + !kl_if_8 <- appl_7 `pseq` kl_not appl_7 + case kl_if_8 of + Atom (B (True)) -> do kl_Zero `pseq` kl_shen_fboundP kl_Zero + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + in case kl_Zero of + kl_Zero@(Atom (UnboundSym "shen.dictionary")) -> pat_cond_5 + kl_Zero@(ApplC (PL "shen.dictionary" + _)) -> pat_cond_5 + kl_Zero@(ApplC (Func "shen.dictionary" + _)) -> pat_cond_5 + _ -> pat_cond_6 + in case kl_Zero of + kl_Zero@(Atom (UnboundSym "shen.pvar")) -> pat_cond_3 + kl_Zero@(ApplC (PL "shen.pvar" + _)) -> pat_cond_3 + kl_Zero@(ApplC (Func "shen.pvar" + _)) -> pat_cond_3 + _ -> pat_cond_4 + in case kl_Zero of + kl_Zero@(Atom (UnboundSym "shen.tuple")) -> pat_cond_1 + kl_Zero@(ApplC (PL "shen.tuple" + _)) -> pat_cond_1 + kl_Zero@(ApplC (Func "shen.tuple" + _)) -> pat_cond_1 + _ -> pat_cond_2))) + !appl_9 <- kl_V4114 `pseq` addressFrom kl_V4114 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + appl_9 `pseq` applyWrapper appl_0 [appl_9] + +kl_shen_fboundP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_fboundP (!kl_V4116) = do (do !appl_0 <- kl_V4116 `pseq` kl_shen_lookup_func kl_V4116 + appl_0 `pseq` kl_do appl_0 (Atom (B True))) `catchError` (\(!kl_E) -> do return (Atom (B False))) + +kl_shen_tuple :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_tuple (!kl_V4118) = do !appl_0 <- kl_V4118 `pseq` addressFrom kl_V4118 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_1 <- kl_V4118 `pseq` addressFrom kl_V4118 (Core.Types.Atom (Core.Types.N (Core.Types.KI 2))) + !appl_2 <- appl_1 `pseq` kl_shen_app appl_1 (Core.Types.Atom (Core.Types.Str ")")) (Core.Types.Atom (Core.Types.UnboundSym "shen.s")) + !appl_3 <- appl_2 `pseq` cn (Core.Types.Atom (Core.Types.Str " ")) appl_2 + !appl_4 <- appl_0 `pseq` (appl_3 `pseq` kl_shen_app appl_0 appl_3 (Core.Types.Atom (Core.Types.UnboundSym "shen.s"))) + appl_4 `pseq` cn (Core.Types.Atom (Core.Types.Str "(@p ")) appl_4 + +kl_shen_dictionary :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_dictionary (!kl_V4120) = do return (Core.Types.Atom (Core.Types.Str "(dict ...)")) + +kl_shen_iter_vector :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_iter_vector (!kl_V4131) (!kl_V4132) (!kl_V4133) (!kl_V4134) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.Str "... etc")) + pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Item) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Next) -> do let pat_cond_4 = do return (Core.Types.Atom (Core.Types.Str "")) + pat_cond_5 = do do let pat_cond_6 = do kl_Item `pseq` (kl_V4133 `pseq` kl_shen_arg_RBstr kl_Item kl_V4133) + pat_cond_7 = do do !appl_8 <- kl_Item `pseq` (kl_V4133 `pseq` kl_shen_arg_RBstr kl_Item kl_V4133) + !appl_9 <- kl_V4132 `pseq` add kl_V4132 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_10 <- kl_V4134 `pseq` Primitives.subtract kl_V4134 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + !appl_11 <- kl_V4131 `pseq` (appl_9 `pseq` (kl_V4133 `pseq` (appl_10 `pseq` kl_shen_iter_vector kl_V4131 appl_9 kl_V4133 appl_10))) + !appl_12 <- appl_11 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str " ")) appl_11 + appl_8 `pseq` (appl_12 `pseq` kl_Ats appl_8 appl_12) + in case kl_Next of + kl_Next@(Atom (UnboundSym "shen.out-of-bounds")) -> pat_cond_6 + kl_Next@(ApplC (PL "shen.out-of-bounds" + _)) -> pat_cond_6 + kl_Next@(ApplC (Func "shen.out-of-bounds" + _)) -> pat_cond_6 + _ -> pat_cond_7 + in case kl_Item of + kl_Item@(Atom (UnboundSym "shen.out-of-bounds")) -> pat_cond_4 + kl_Item@(ApplC (PL "shen.out-of-bounds" + _)) -> pat_cond_4 + kl_Item@(ApplC (Func "shen.out-of-bounds" + _)) -> pat_cond_4 + _ -> pat_cond_5))) + !appl_13 <- kl_V4132 `pseq` add kl_V4132 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) + let !appl_14 = ApplC (PL "thunk" (do return (Core.Types.Atom (Core.Types.UnboundSym "shen.out-of-bounds")))) + !appl_15 <- kl_V4131 `pseq` (appl_13 `pseq` (appl_14 `pseq` kl_LB_addressDivor kl_V4131 appl_13 appl_14)) + appl_15 `pseq` applyWrapper appl_3 [appl_15]))) + let !appl_16 = ApplC (PL "thunk" (do return (Core.Types.Atom (Core.Types.UnboundSym "shen.out-of-bounds")))) + !appl_17 <- kl_V4131 `pseq` (kl_V4132 `pseq` (appl_16 `pseq` kl_LB_addressDivor kl_V4131 kl_V4132 appl_16)) + appl_17 `pseq` applyWrapper appl_2 [appl_17] + in case kl_V4134 of + kl_V4134@(Atom (N (KI 0))) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_atom_RBstr :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_atom_RBstr (!kl_V4136) = do (do kl_V4136 `pseq` str kl_V4136) `catchError` (\(!kl_E) -> do kl_shen_funexstring) + +kl_shen_funexstring :: Core.Types.KLContext Core.Types.Env + Core.Types.KLValue +kl_shen_funexstring = do !appl_0 <- intern (Core.Types.Atom (Core.Types.Str "x")) + !appl_1 <- appl_0 `pseq` kl_gensym appl_0 + !appl_2 <- appl_1 `pseq` kl_shen_arg_RBstr appl_1 (Core.Types.Atom (Core.Types.UnboundSym "shen.a")) + !appl_3 <- appl_2 `pseq` kl_Ats appl_2 (Core.Types.Atom (Core.Types.Str "\\DC1")) + !appl_4 <- appl_3 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "e")) appl_3 + !appl_5 <- appl_4 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "n")) appl_4 + !appl_6 <- appl_5 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "u")) appl_5 + !appl_7 <- appl_6 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "f")) appl_6 + appl_7 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "\\DLE")) appl_7 + +kl_shen_listP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_listP (!kl_V4138) = do !kl_if_0 <- kl_V4138 `pseq` kl_emptyP kl_V4138 + case kl_if_0 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do let pat_cond_1 kl_V4138 kl_V4138h kl_V4138t = do return (Atom (B True)) + pat_cond_2 = do do return (Atom (B False)) + in case kl_V4138 of + !(kl_V4138@(Cons (!kl_V4138h) + (!kl_V4138t))) -> pat_cond_1 kl_V4138 kl_V4138h kl_V4138t + _ -> pat_cond_2 + _ -> throwError "if: expected boolean" + +expr9 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr9 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Backend/Yacc.hs b/Shentong/Backend/Yacc.hs --- a/Shentong/Backend/Yacc.hs +++ b/Shentong/Backend/Yacc.hs @@ -1,849 +1,1225 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE ViewPatterns #-} - -module Backend.Yacc 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 -import Backend.Core -import Backend.Sys -import Backend.Sequent - -{- -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_yacc :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_yacc (!kl_V4004) = do let pat_cond_0 kl_V4004 kl_V4004t kl_V4004th kl_V4004tt = do kl_V4004th `pseq` (kl_V4004tt `pseq` kl_shen_yacc_RBshen kl_V4004th kl_V4004tt) - pat_cond_1 = do do let !aw_2 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_2 [ApplC (wrapNamed "shen.yacc" kl_shen_yacc)] - in case kl_V4004 of - !(kl_V4004@(Cons (Atom (UnboundSym "defcc")) - (!(kl_V4004t@(Cons (!kl_V4004th) - (!kl_V4004tt)))))) -> pat_cond_0 kl_V4004 kl_V4004t kl_V4004th kl_V4004tt - !(kl_V4004@(Cons (ApplC (PL "defcc" _)) - (!(kl_V4004t@(Cons (!kl_V4004th) - (!kl_V4004tt)))))) -> pat_cond_0 kl_V4004 kl_V4004t kl_V4004th kl_V4004tt - !(kl_V4004@(Cons (ApplC (Func "defcc" _)) - (!(kl_V4004t@(Cons (!kl_V4004th) - (!kl_V4004tt)))))) -> pat_cond_0 kl_V4004 kl_V4004t kl_V4004th kl_V4004tt - _ -> pat_cond_1 - -kl_shen_yacc_RBshen :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_yacc_RBshen (!kl_V4007) (!kl_V4008) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_CCRules) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_CCBody) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_YaccCases) -> do !appl_3 <- kl_YaccCases `pseq` kl_shen_kill_code kl_YaccCases - !appl_4 <- appl_3 `pseq` klCons appl_3 (Types.Atom Types.Nil) - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.UnboundSym "->")) appl_4 - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym "Stream")) appl_5 - !appl_7 <- kl_V4007 `pseq` (appl_6 `pseq` klCons kl_V4007 appl_6) - appl_7 `pseq` klCons (Types.Atom (Types.UnboundSym "define")) appl_7))) - !appl_8 <- kl_CCBody `pseq` kl_shen_yacc_cases kl_CCBody - appl_8 `pseq` applyWrapper appl_2 [appl_8]))) - let !appl_9 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_cc_body kl_X))) - !appl_10 <- appl_9 `pseq` (kl_CCRules `pseq` kl_map appl_9 kl_CCRules) - appl_10 `pseq` applyWrapper appl_1 [appl_10]))) - !appl_11 <- kl_V4008 `pseq` kl_shen_split_cc_rules (Atom (B True)) kl_V4008 (Types.Atom Types.Nil) - appl_11 `pseq` applyWrapper appl_0 [appl_11] - -kl_shen_kill_code :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_kill_code (!kl_V4010) = do !appl_0 <- kl_V4010 `pseq` kl_occurrences (ApplC (PL "kill" kl_kill)) kl_V4010 - !kl_if_1 <- appl_0 `pseq` greaterThan appl_0 (Types.Atom (Types.N (Types.KI 0))) - case kl_if_1 of - Atom (B (True)) -> do !appl_2 <- klCons (Types.Atom (Types.UnboundSym "E")) (Types.Atom Types.Nil) - !appl_3 <- appl_2 `pseq` klCons (ApplC (wrapNamed "shen.analyse-kill" kl_shen_analyse_kill)) appl_2 - !appl_4 <- appl_3 `pseq` klCons appl_3 (Types.Atom Types.Nil) - !appl_5 <- appl_4 `pseq` klCons (Types.Atom (Types.UnboundSym "E")) appl_4 - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym "lambda")) appl_5 - !appl_7 <- appl_6 `pseq` klCons appl_6 (Types.Atom Types.Nil) - !appl_8 <- kl_V4010 `pseq` (appl_7 `pseq` klCons kl_V4010 appl_7) - appl_8 `pseq` klCons (Types.Atom (Types.UnboundSym "trap-error")) appl_8 - Atom (B (False)) -> do do return kl_V4010 - _ -> throwError "if: expected boolean" - -kl_kill :: Types.KLContext Types.Env Types.KLValue -kl_kill = do simpleError (Types.Atom (Types.Str "yacc kill")) - -kl_shen_analyse_kill :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_analyse_kill (!kl_V4012) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_String) -> do let pat_cond_1 = do kl_fail - pat_cond_2 = do do return kl_V4012 - in case kl_String of - kl_String@(Atom (Str "yacc kill")) -> pat_cond_1 - _ -> pat_cond_2))) - !appl_3 <- kl_V4012 `pseq` errorToString kl_V4012 - appl_3 `pseq` applyWrapper appl_0 [appl_3] - -kl_shen_split_cc_rules :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_split_cc_rules (!kl_V4018) (!kl_V4019) (!kl_V4020) = do !kl_if_0 <- let pat_cond_1 = do let pat_cond_2 = do return (Atom (B True)) - pat_cond_3 = do do return (Atom (B False)) - in case kl_V4020 of - kl_V4020@(Atom (Nil)) -> pat_cond_2 - _ -> pat_cond_3 - pat_cond_4 = do do return (Atom (B False)) - in case kl_V4019 of - kl_V4019@(Atom (Nil)) -> pat_cond_1 - _ -> pat_cond_4 - case kl_if_0 of - Atom (B (True)) -> do return (Types.Atom Types.Nil) - Atom (B (False)) -> do let pat_cond_5 = do !appl_6 <- kl_V4020 `pseq` kl_reverse kl_V4020 - !appl_7 <- kl_V4018 `pseq` (appl_6 `pseq` kl_shen_split_cc_rule kl_V4018 appl_6 (Types.Atom Types.Nil)) - appl_7 `pseq` klCons appl_7 (Types.Atom Types.Nil) - pat_cond_8 kl_V4019 kl_V4019t = do !appl_9 <- kl_V4020 `pseq` kl_reverse kl_V4020 - !appl_10 <- kl_V4018 `pseq` (appl_9 `pseq` kl_shen_split_cc_rule kl_V4018 appl_9 (Types.Atom Types.Nil)) - !appl_11 <- kl_V4018 `pseq` (kl_V4019t `pseq` kl_shen_split_cc_rules kl_V4018 kl_V4019t (Types.Atom Types.Nil)) - appl_10 `pseq` (appl_11 `pseq` klCons appl_10 appl_11) - pat_cond_12 kl_V4019 kl_V4019h kl_V4019t = do !appl_13 <- kl_V4019h `pseq` (kl_V4020 `pseq` klCons kl_V4019h kl_V4020) - kl_V4018 `pseq` (kl_V4019t `pseq` (appl_13 `pseq` kl_shen_split_cc_rules kl_V4018 kl_V4019t appl_13)) - pat_cond_14 = do do let !aw_15 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_15 [ApplC (wrapNamed "shen.split_cc_rules" kl_shen_split_cc_rules)] - in case kl_V4019 of - kl_V4019@(Atom (Nil)) -> pat_cond_5 - !(kl_V4019@(Cons (Atom (UnboundSym ";")) - (!kl_V4019t))) -> pat_cond_8 kl_V4019 kl_V4019t - !(kl_V4019@(Cons (ApplC (PL ";" - _)) - (!kl_V4019t))) -> pat_cond_8 kl_V4019 kl_V4019t - !(kl_V4019@(Cons (ApplC (Func ";" - _)) - (!kl_V4019t))) -> pat_cond_8 kl_V4019 kl_V4019t - !(kl_V4019@(Cons (!kl_V4019h) - (!kl_V4019t))) -> pat_cond_12 kl_V4019 kl_V4019h kl_V4019t - _ -> pat_cond_14 - _ -> throwError "if: expected boolean" - -kl_shen_split_cc_rule :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_split_cc_rule (!kl_V4028) (!kl_V4029) (!kl_V4030) = do let pat_cond_0 kl_V4029 kl_V4029t kl_V4029th = do !appl_1 <- kl_V4030 `pseq` kl_reverse kl_V4030 - appl_1 `pseq` (kl_V4029t `pseq` klCons appl_1 kl_V4029t) - pat_cond_2 kl_V4029 kl_V4029t kl_V4029th kl_V4029tt kl_V4029ttt kl_V4029ttth = do !appl_3 <- kl_V4030 `pseq` kl_reverse kl_V4030 - !appl_4 <- kl_V4029th `pseq` klCons kl_V4029th (Types.Atom Types.Nil) - !appl_5 <- kl_V4029ttth `pseq` (appl_4 `pseq` klCons kl_V4029ttth appl_4) - !appl_6 <- appl_5 `pseq` klCons (Types.Atom (Types.UnboundSym "where")) appl_5 - !appl_7 <- appl_6 `pseq` klCons appl_6 (Types.Atom Types.Nil) - appl_3 `pseq` (appl_7 `pseq` klCons appl_3 appl_7) - pat_cond_8 = do !appl_9 <- kl_V4028 `pseq` (kl_V4030 `pseq` kl_shen_semantic_completion_warning kl_V4028 kl_V4030) - !appl_10 <- kl_V4030 `pseq` kl_reverse kl_V4030 - !appl_11 <- appl_10 `pseq` kl_shen_default_semantics appl_10 - !appl_12 <- appl_11 `pseq` klCons appl_11 (Types.Atom Types.Nil) - !appl_13 <- appl_12 `pseq` klCons (Types.Atom (Types.UnboundSym ":=")) appl_12 - !appl_14 <- kl_V4028 `pseq` (appl_13 `pseq` (kl_V4030 `pseq` kl_shen_split_cc_rule kl_V4028 appl_13 kl_V4030)) - appl_9 `pseq` (appl_14 `pseq` kl_do appl_9 appl_14) - pat_cond_15 kl_V4029 kl_V4029h kl_V4029t = do !appl_16 <- kl_V4029h `pseq` (kl_V4030 `pseq` klCons kl_V4029h kl_V4030) - kl_V4028 `pseq` (kl_V4029t `pseq` (appl_16 `pseq` kl_shen_split_cc_rule kl_V4028 kl_V4029t appl_16)) - pat_cond_17 = do do let !aw_18 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_18 [ApplC (wrapNamed "shen.split_cc_rule" kl_shen_split_cc_rule)] - in case kl_V4029 of - !(kl_V4029@(Cons (Atom (UnboundSym ":=")) - (!(kl_V4029t@(Cons (!kl_V4029th) - (Atom (Nil))))))) -> pat_cond_0 kl_V4029 kl_V4029t kl_V4029th - !(kl_V4029@(Cons (ApplC (PL ":=" - _)) - (!(kl_V4029t@(Cons (!kl_V4029th) - (Atom (Nil))))))) -> pat_cond_0 kl_V4029 kl_V4029t kl_V4029th - !(kl_V4029@(Cons (ApplC (Func ":=" - _)) - (!(kl_V4029t@(Cons (!kl_V4029th) - (Atom (Nil))))))) -> pat_cond_0 kl_V4029 kl_V4029t kl_V4029th - !(kl_V4029@(Cons (Atom (UnboundSym ":=")) - (!(kl_V4029t@(Cons (!kl_V4029th) - (!(kl_V4029tt@(Cons (Atom (UnboundSym "where")) - (!(kl_V4029ttt@(Cons (!kl_V4029ttth) - (Atom (Nil))))))))))))) -> pat_cond_2 kl_V4029 kl_V4029t kl_V4029th kl_V4029tt kl_V4029ttt kl_V4029ttth - !(kl_V4029@(Cons (Atom (UnboundSym ":=")) - (!(kl_V4029t@(Cons (!kl_V4029th) - (!(kl_V4029tt@(Cons (ApplC (PL "where" - _)) - (!(kl_V4029ttt@(Cons (!kl_V4029ttth) - (Atom (Nil))))))))))))) -> pat_cond_2 kl_V4029 kl_V4029t kl_V4029th kl_V4029tt kl_V4029ttt kl_V4029ttth - !(kl_V4029@(Cons (Atom (UnboundSym ":=")) - (!(kl_V4029t@(Cons (!kl_V4029th) - (!(kl_V4029tt@(Cons (ApplC (Func "where" - _)) - (!(kl_V4029ttt@(Cons (!kl_V4029ttth) - (Atom (Nil))))))))))))) -> pat_cond_2 kl_V4029 kl_V4029t kl_V4029th kl_V4029tt kl_V4029ttt kl_V4029ttth - !(kl_V4029@(Cons (ApplC (PL ":=" - _)) - (!(kl_V4029t@(Cons (!kl_V4029th) - (!(kl_V4029tt@(Cons (Atom (UnboundSym "where")) - (!(kl_V4029ttt@(Cons (!kl_V4029ttth) - (Atom (Nil))))))))))))) -> pat_cond_2 kl_V4029 kl_V4029t kl_V4029th kl_V4029tt kl_V4029ttt kl_V4029ttth - !(kl_V4029@(Cons (ApplC (PL ":=" - _)) - (!(kl_V4029t@(Cons (!kl_V4029th) - (!(kl_V4029tt@(Cons (ApplC (PL "where" - _)) - (!(kl_V4029ttt@(Cons (!kl_V4029ttth) - (Atom (Nil))))))))))))) -> pat_cond_2 kl_V4029 kl_V4029t kl_V4029th kl_V4029tt kl_V4029ttt kl_V4029ttth - !(kl_V4029@(Cons (ApplC (PL ":=" - _)) - (!(kl_V4029t@(Cons (!kl_V4029th) - (!(kl_V4029tt@(Cons (ApplC (Func "where" - _)) - (!(kl_V4029ttt@(Cons (!kl_V4029ttth) - (Atom (Nil))))))))))))) -> pat_cond_2 kl_V4029 kl_V4029t kl_V4029th kl_V4029tt kl_V4029ttt kl_V4029ttth - !(kl_V4029@(Cons (ApplC (Func ":=" - _)) - (!(kl_V4029t@(Cons (!kl_V4029th) - (!(kl_V4029tt@(Cons (Atom (UnboundSym "where")) - (!(kl_V4029ttt@(Cons (!kl_V4029ttth) - (Atom (Nil))))))))))))) -> pat_cond_2 kl_V4029 kl_V4029t kl_V4029th kl_V4029tt kl_V4029ttt kl_V4029ttth - !(kl_V4029@(Cons (ApplC (Func ":=" - _)) - (!(kl_V4029t@(Cons (!kl_V4029th) - (!(kl_V4029tt@(Cons (ApplC (PL "where" - _)) - (!(kl_V4029ttt@(Cons (!kl_V4029ttth) - (Atom (Nil))))))))))))) -> pat_cond_2 kl_V4029 kl_V4029t kl_V4029th kl_V4029tt kl_V4029ttt kl_V4029ttth - !(kl_V4029@(Cons (ApplC (Func ":=" - _)) - (!(kl_V4029t@(Cons (!kl_V4029th) - (!(kl_V4029tt@(Cons (ApplC (Func "where" - _)) - (!(kl_V4029ttt@(Cons (!kl_V4029ttth) - (Atom (Nil))))))))))))) -> pat_cond_2 kl_V4029 kl_V4029t kl_V4029th kl_V4029tt kl_V4029ttt kl_V4029ttth - kl_V4029@(Atom (Nil)) -> pat_cond_8 - !(kl_V4029@(Cons (!kl_V4029h) - (!kl_V4029t))) -> pat_cond_15 kl_V4029 kl_V4029h kl_V4029t - _ -> pat_cond_17 - -kl_shen_semantic_completion_warning :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_semantic_completion_warning (!kl_V4041) (!kl_V4042) = do let pat_cond_0 = do !appl_1 <- kl_stoutput - let !aw_2 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_3 <- appl_1 `pseq` applyWrapper aw_2 [Types.Atom (Types.Str "warning: "), - appl_1] - let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_5 = Types.Atom (Types.UnboundSym "shen.app") - !appl_6 <- kl_X `pseq` applyWrapper aw_5 [kl_X, - Types.Atom (Types.Str " "), - Types.Atom (Types.UnboundSym "shen.a")] - !appl_7 <- kl_stoutput - let !aw_8 = Types.Atom (Types.UnboundSym "shen.prhush") - appl_6 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_6, - appl_7])))) - !appl_9 <- kl_V4042 `pseq` kl_reverse kl_V4042 - !appl_10 <- appl_4 `pseq` (appl_9 `pseq` kl_map appl_4 appl_9) - !appl_11 <- kl_stoutput - let !aw_12 = Types.Atom (Types.UnboundSym "shen.prhush") - !appl_13 <- appl_11 `pseq` applyWrapper aw_12 [Types.Atom (Types.Str "has no semantics.\n"), - appl_11] - !appl_14 <- appl_10 `pseq` (appl_13 `pseq` kl_do appl_10 appl_13) - appl_3 `pseq` (appl_14 `pseq` kl_do appl_3 appl_14) - pat_cond_15 = do do return (Types.Atom (Types.UnboundSym "shen.skip")) - in case kl_V4041 of - kl_V4041@(Atom (UnboundSym "true")) -> pat_cond_0 - kl_V4041@(Atom (B (True))) -> pat_cond_0 - _ -> pat_cond_15 - -kl_shen_default_semantics :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_default_semantics (!kl_V4044) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 = do !kl_if_2 <- let pat_cond_3 kl_V4044 kl_V4044h kl_V4044t = do !kl_if_4 <- let pat_cond_5 = do !kl_if_6 <- kl_V4044h `pseq` kl_shen_grammar_symbolP kl_V4044h - 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_7 = do do return (Atom (B False)) - in case kl_V4044t of - kl_V4044t@(Atom (Nil)) -> pat_cond_5 - _ -> pat_cond_7 - 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_8 = do do return (Atom (B False)) - in case kl_V4044 of - !(kl_V4044@(Cons (!kl_V4044h) - (!kl_V4044t))) -> pat_cond_3 kl_V4044 kl_V4044h kl_V4044t - _ -> pat_cond_8 - case kl_if_2 of - Atom (B (True)) -> do kl_V4044 `pseq` hd kl_V4044 - Atom (B (False)) -> do !kl_if_9 <- let pat_cond_10 kl_V4044 kl_V4044h kl_V4044t = do !kl_if_11 <- kl_V4044h `pseq` kl_shen_grammar_symbolP kl_V4044h - case kl_if_11 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - pat_cond_12 = do do return (Atom (B False)) - in case kl_V4044 of - !(kl_V4044@(Cons (!kl_V4044h) - (!kl_V4044t))) -> pat_cond_10 kl_V4044 kl_V4044h kl_V4044t - _ -> pat_cond_12 - case kl_if_9 of - Atom (B (True)) -> do !appl_13 <- kl_V4044 `pseq` hd kl_V4044 - !appl_14 <- kl_V4044 `pseq` tl kl_V4044 - !appl_15 <- appl_14 `pseq` kl_shen_default_semantics appl_14 - !appl_16 <- appl_15 `pseq` klCons appl_15 (Types.Atom Types.Nil) - !appl_17 <- appl_13 `pseq` (appl_16 `pseq` klCons appl_13 appl_16) - appl_17 `pseq` klCons (ApplC (wrapNamed "append" kl_append)) appl_17 - Atom (B (False)) -> do let pat_cond_18 kl_V4044 kl_V4044h kl_V4044t = do !appl_19 <- kl_V4044t `pseq` kl_shen_default_semantics kl_V4044t - !appl_20 <- appl_19 `pseq` klCons appl_19 (Types.Atom Types.Nil) - !appl_21 <- kl_V4044h `pseq` (appl_20 `pseq` klCons kl_V4044h appl_20) - appl_21 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_21 - pat_cond_22 = do do let !aw_23 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_23 [ApplC (wrapNamed "shen.default_semantics" kl_shen_default_semantics)] - in case kl_V4044 of - !(kl_V4044@(Cons (!kl_V4044h) - (!kl_V4044t))) -> pat_cond_18 kl_V4044 kl_V4044h kl_V4044t - _ -> pat_cond_22 - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - in case kl_V4044 of - kl_V4044@(Atom (Nil)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_grammar_symbolP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_grammar_symbolP (!kl_V4046) = do !kl_if_0 <- kl_V4046 `pseq` kl_symbolP kl_V4046 - case kl_if_0 of - Atom (B (True)) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Cs) -> do !appl_2 <- kl_Cs `pseq` hd kl_Cs - !kl_if_3 <- appl_2 `pseq` eq appl_2 (Types.Atom (Types.Str "<")) - case kl_if_3 of - Atom (B (True)) -> do !appl_4 <- kl_Cs `pseq` kl_reverse kl_Cs - !appl_5 <- appl_4 `pseq` hd appl_4 - !kl_if_6 <- appl_5 `pseq` eq appl_5 (Types.Atom (Types.Str ">")) - 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" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean"))) - !appl_7 <- kl_V4046 `pseq` kl_explode kl_V4046 - !appl_8 <- appl_7 `pseq` kl_shen_strip_pathname appl_7 - !kl_if_9 <- appl_8 `pseq` applyWrapper appl_1 [appl_8] - case kl_if_9 of - Atom (B (True)) -> do return (Atom (B True)) - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - Atom (B (False)) -> do do return (Atom (B False)) - _ -> throwError "if: expected boolean" - -kl_shen_yacc_cases :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_yacc_cases (!kl_V4048) = do let pat_cond_0 kl_V4048 kl_V4048h = do return kl_V4048h - pat_cond_1 kl_V4048 kl_V4048h kl_V4048t = do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_P) -> do !appl_3 <- klCons (ApplC (PL "fail" kl_fail)) (Types.Atom Types.Nil) - !appl_4 <- appl_3 `pseq` klCons appl_3 (Types.Atom Types.Nil) - !appl_5 <- kl_P `pseq` (appl_4 `pseq` klCons kl_P appl_4) - !appl_6 <- appl_5 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_5 - !appl_7 <- kl_V4048t `pseq` kl_shen_yacc_cases kl_V4048t - !appl_8 <- kl_P `pseq` klCons kl_P (Types.Atom Types.Nil) - !appl_9 <- appl_7 `pseq` (appl_8 `pseq` klCons appl_7 appl_8) - !appl_10 <- appl_6 `pseq` (appl_9 `pseq` klCons appl_6 appl_9) - !appl_11 <- appl_10 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_10 - !appl_12 <- appl_11 `pseq` klCons appl_11 (Types.Atom Types.Nil) - !appl_13 <- kl_V4048h `pseq` (appl_12 `pseq` klCons kl_V4048h appl_12) - !appl_14 <- kl_P `pseq` (appl_13 `pseq` klCons kl_P appl_13) - appl_14 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_14))) - applyWrapper appl_2 [Types.Atom (Types.UnboundSym "YaccParse")] - pat_cond_15 = do do let !aw_16 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_16 [ApplC (wrapNamed "shen.yacc_cases" kl_shen_yacc_cases)] - in case kl_V4048 of - !(kl_V4048@(Cons (!kl_V4048h) - (Atom (Nil)))) -> pat_cond_0 kl_V4048 kl_V4048h - !(kl_V4048@(Cons (!kl_V4048h) - (!kl_V4048t))) -> pat_cond_1 kl_V4048 kl_V4048h kl_V4048t - _ -> pat_cond_15 - -kl_shen_cc_body :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_cc_body (!kl_V4050) = do let pat_cond_0 kl_V4050 kl_V4050h kl_V4050t kl_V4050th = do kl_V4050h `pseq` (kl_V4050th `pseq` kl_shen_syntax kl_V4050h (Types.Atom (Types.UnboundSym "Stream")) kl_V4050th) - pat_cond_1 = do do let !aw_2 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_2 [ApplC (wrapNamed "shen.cc_body" kl_shen_cc_body)] - in case kl_V4050 of - !(kl_V4050@(Cons (!kl_V4050h) - (!(kl_V4050t@(Cons (!kl_V4050th) - (Atom (Nil))))))) -> pat_cond_0 kl_V4050 kl_V4050h kl_V4050t kl_V4050th - _ -> pat_cond_1 - -kl_shen_syntax :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_syntax (!kl_V4054) (!kl_V4055) (!kl_V4056) = do !kl_if_0 <- let pat_cond_1 = do let pat_cond_2 kl_V4056 kl_V4056t kl_V4056th kl_V4056tt kl_V4056tth = do return (Atom (B True)) - pat_cond_3 = do do return (Atom (B False)) - in case kl_V4056 of - !(kl_V4056@(Cons (Atom (UnboundSym "where")) - (!(kl_V4056t@(Cons (!kl_V4056th) - (!(kl_V4056tt@(Cons (!kl_V4056tth) - (Atom (Nil)))))))))) -> pat_cond_2 kl_V4056 kl_V4056t kl_V4056th kl_V4056tt kl_V4056tth - !(kl_V4056@(Cons (ApplC (PL "where" - _)) - (!(kl_V4056t@(Cons (!kl_V4056th) - (!(kl_V4056tt@(Cons (!kl_V4056tth) - (Atom (Nil)))))))))) -> pat_cond_2 kl_V4056 kl_V4056t kl_V4056th kl_V4056tt kl_V4056tth - !(kl_V4056@(Cons (ApplC (Func "where" - _)) - (!(kl_V4056t@(Cons (!kl_V4056th) - (!(kl_V4056tt@(Cons (!kl_V4056tth) - (Atom (Nil)))))))))) -> pat_cond_2 kl_V4056 kl_V4056t kl_V4056th kl_V4056tt kl_V4056tth - _ -> pat_cond_3 - pat_cond_4 = do do return (Atom (B False)) - in case kl_V4054 of - kl_V4054@(Atom (Nil)) -> pat_cond_1 - _ -> pat_cond_4 - case kl_if_0 of - Atom (B (True)) -> do !appl_5 <- kl_V4056 `pseq` tl kl_V4056 - !appl_6 <- appl_5 `pseq` hd appl_5 - !appl_7 <- appl_6 `pseq` kl_shen_semantics appl_6 - !appl_8 <- kl_V4055 `pseq` klCons kl_V4055 (Types.Atom Types.Nil) - !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_8 - !appl_10 <- kl_V4056 `pseq` tl kl_V4056 - !appl_11 <- appl_10 `pseq` tl appl_10 - !appl_12 <- appl_11 `pseq` hd appl_11 - !appl_13 <- appl_12 `pseq` kl_shen_semantics appl_12 - !appl_14 <- appl_13 `pseq` klCons appl_13 (Types.Atom Types.Nil) - !appl_15 <- appl_9 `pseq` (appl_14 `pseq` klCons appl_9 appl_14) - !appl_16 <- appl_15 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_15 - !appl_17 <- klCons (ApplC (PL "fail" kl_fail)) (Types.Atom Types.Nil) - !appl_18 <- appl_17 `pseq` klCons appl_17 (Types.Atom Types.Nil) - !appl_19 <- appl_16 `pseq` (appl_18 `pseq` klCons appl_16 appl_18) - !appl_20 <- appl_7 `pseq` (appl_19 `pseq` klCons appl_7 appl_19) - appl_20 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_20 - Atom (B (False)) -> do let pat_cond_21 = do !appl_22 <- kl_V4055 `pseq` klCons kl_V4055 (Types.Atom Types.Nil) - !appl_23 <- appl_22 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_22 - !appl_24 <- kl_V4056 `pseq` kl_shen_semantics kl_V4056 - !appl_25 <- appl_24 `pseq` klCons appl_24 (Types.Atom Types.Nil) - !appl_26 <- appl_23 `pseq` (appl_25 `pseq` klCons appl_23 appl_25) - appl_26 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_26 - pat_cond_27 kl_V4054 kl_V4054h kl_V4054t = do !kl_if_28 <- kl_V4054h `pseq` kl_shen_grammar_symbolP kl_V4054h - case kl_if_28 of - Atom (B (True)) -> do kl_V4054 `pseq` (kl_V4055 `pseq` (kl_V4056 `pseq` kl_shen_recursive_descent kl_V4054 kl_V4055 kl_V4056)) - Atom (B (False)) -> do do !kl_if_29 <- kl_V4054h `pseq` kl_variableP kl_V4054h - case kl_if_29 of - Atom (B (True)) -> do kl_V4054 `pseq` (kl_V4055 `pseq` (kl_V4056 `pseq` kl_shen_variable_match kl_V4054 kl_V4055 kl_V4056)) - Atom (B (False)) -> do do !kl_if_30 <- kl_V4054h `pseq` kl_shen_jump_streamP kl_V4054h - case kl_if_30 of - Atom (B (True)) -> do kl_V4054 `pseq` (kl_V4055 `pseq` (kl_V4056 `pseq` kl_shen_jump_stream kl_V4054 kl_V4055 kl_V4056)) - Atom (B (False)) -> do do !kl_if_31 <- kl_V4054h `pseq` kl_shen_terminalP kl_V4054h - case kl_if_31 of - Atom (B (True)) -> do kl_V4054 `pseq` (kl_V4055 `pseq` (kl_V4056 `pseq` kl_shen_check_stream kl_V4054 kl_V4055 kl_V4056)) - Atom (B (False)) -> do do let pat_cond_32 kl_V4054h kl_V4054hh kl_V4054ht = do !appl_33 <- kl_V4054h `pseq` kl_shen_decons kl_V4054h - appl_33 `pseq` (kl_V4054t `pseq` (kl_V4055 `pseq` (kl_V4056 `pseq` kl_shen_list_stream appl_33 kl_V4054t kl_V4055 kl_V4056))) - pat_cond_34 = do do let !aw_35 = Types.Atom (Types.UnboundSym "shen.app") - !appl_36 <- kl_V4054h `pseq` applyWrapper aw_35 [kl_V4054h, - Types.Atom (Types.Str " is not legal syntax\n"), - Types.Atom (Types.UnboundSym "shen.a")] - appl_36 `pseq` simpleError appl_36 - in case kl_V4054h of - !(kl_V4054h@(Cons (!kl_V4054hh) - (!kl_V4054ht))) -> pat_cond_32 kl_V4054h kl_V4054hh kl_V4054ht - _ -> pat_cond_34 - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - pat_cond_37 = do do let !aw_38 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_38 [ApplC (wrapNamed "shen.syntax" kl_shen_syntax)] - in case kl_V4054 of - kl_V4054@(Atom (Nil)) -> pat_cond_21 - !(kl_V4054@(Cons (!kl_V4054h) - (!kl_V4054t))) -> pat_cond_27 kl_V4054 kl_V4054h kl_V4054t - _ -> pat_cond_37 - _ -> throwError "if: expected boolean" - -kl_shen_list_stream :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_list_stream (!kl_V4061) (!kl_V4062) (!kl_V4063) (!kl_V4064) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Test) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Placeholder) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_RunOn) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Action) -> do !appl_4 <- klCons (ApplC (PL "fail" kl_fail)) (Types.Atom Types.Nil) - !appl_5 <- appl_4 `pseq` klCons appl_4 (Types.Atom Types.Nil) - !appl_6 <- kl_Action `pseq` (appl_5 `pseq` klCons kl_Action appl_5) - !appl_7 <- kl_Test `pseq` (appl_6 `pseq` klCons kl_Test appl_6) - appl_7 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_7))) - !appl_8 <- kl_V4063 `pseq` klCons kl_V4063 (Types.Atom Types.Nil) - !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_8 - !appl_10 <- appl_9 `pseq` klCons appl_9 (Types.Atom Types.Nil) - !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_10 - !appl_12 <- kl_V4063 `pseq` klCons kl_V4063 (Types.Atom Types.Nil) - !appl_13 <- appl_12 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_12 - !appl_14 <- appl_13 `pseq` klCons appl_13 (Types.Atom Types.Nil) - !appl_15 <- appl_14 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_14 - !appl_16 <- appl_15 `pseq` klCons appl_15 (Types.Atom Types.Nil) - !appl_17 <- appl_11 `pseq` (appl_16 `pseq` klCons appl_11 appl_16) - !appl_18 <- appl_17 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_17 - !appl_19 <- kl_V4061 `pseq` (appl_18 `pseq` (kl_Placeholder `pseq` kl_shen_syntax kl_V4061 appl_18 kl_Placeholder)) - !appl_20 <- kl_RunOn `pseq` (kl_Placeholder `pseq` (appl_19 `pseq` kl_shen_insert_runon kl_RunOn kl_Placeholder appl_19)) - appl_20 `pseq` applyWrapper appl_3 [appl_20]))) - !appl_21 <- kl_V4063 `pseq` klCons kl_V4063 (Types.Atom Types.Nil) - !appl_22 <- appl_21 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_21 - !appl_23 <- appl_22 `pseq` klCons appl_22 (Types.Atom Types.Nil) - !appl_24 <- appl_23 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_23 - !appl_25 <- kl_V4063 `pseq` klCons kl_V4063 (Types.Atom Types.Nil) - !appl_26 <- appl_25 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_25 - !appl_27 <- appl_26 `pseq` klCons appl_26 (Types.Atom Types.Nil) - !appl_28 <- appl_27 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_27 - !appl_29 <- appl_28 `pseq` klCons appl_28 (Types.Atom Types.Nil) - !appl_30 <- appl_24 `pseq` (appl_29 `pseq` klCons appl_24 appl_29) - !appl_31 <- appl_30 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_30 - !appl_32 <- kl_V4062 `pseq` (appl_31 `pseq` (kl_V4064 `pseq` kl_shen_syntax kl_V4062 appl_31 kl_V4064)) - appl_32 `pseq` applyWrapper appl_2 [appl_32]))) - !appl_33 <- kl_gensym (Types.Atom (Types.UnboundSym "shen.place")) - appl_33 `pseq` applyWrapper appl_1 [appl_33]))) - !appl_34 <- kl_V4063 `pseq` klCons kl_V4063 (Types.Atom Types.Nil) - !appl_35 <- appl_34 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_34 - !appl_36 <- appl_35 `pseq` klCons appl_35 (Types.Atom Types.Nil) - !appl_37 <- appl_36 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_36 - !appl_38 <- kl_V4063 `pseq` klCons kl_V4063 (Types.Atom Types.Nil) - !appl_39 <- appl_38 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_38 - !appl_40 <- appl_39 `pseq` klCons appl_39 (Types.Atom Types.Nil) - !appl_41 <- appl_40 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_40 - !appl_42 <- appl_41 `pseq` klCons appl_41 (Types.Atom Types.Nil) - !appl_43 <- appl_42 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_42 - !appl_44 <- appl_43 `pseq` klCons appl_43 (Types.Atom Types.Nil) - !appl_45 <- appl_37 `pseq` (appl_44 `pseq` klCons appl_37 appl_44) - !appl_46 <- appl_45 `pseq` klCons (Types.Atom (Types.UnboundSym "and")) appl_45 - appl_46 `pseq` applyWrapper appl_0 [appl_46] - -kl_shen_decons :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_decons (!kl_V4066) = do let pat_cond_0 kl_V4066 kl_V4066t kl_V4066th kl_V4066tt = do kl_V4066th `pseq` klCons kl_V4066th (Types.Atom Types.Nil) - pat_cond_1 kl_V4066 kl_V4066t kl_V4066th kl_V4066tt kl_V4066tth = do !appl_2 <- kl_V4066tth `pseq` kl_shen_decons kl_V4066tth - kl_V4066th `pseq` (appl_2 `pseq` klCons kl_V4066th appl_2) - pat_cond_3 = do do return kl_V4066 - in case kl_V4066 of - !(kl_V4066@(Cons (Atom (UnboundSym "cons")) - (!(kl_V4066t@(Cons (!kl_V4066th) - (!(kl_V4066tt@(Cons (Atom (Nil)) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V4066 kl_V4066t kl_V4066th kl_V4066tt - !(kl_V4066@(Cons (ApplC (PL "cons" _)) - (!(kl_V4066t@(Cons (!kl_V4066th) - (!(kl_V4066tt@(Cons (Atom (Nil)) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V4066 kl_V4066t kl_V4066th kl_V4066tt - !(kl_V4066@(Cons (ApplC (Func "cons" _)) - (!(kl_V4066t@(Cons (!kl_V4066th) - (!(kl_V4066tt@(Cons (Atom (Nil)) - (Atom (Nil)))))))))) -> pat_cond_0 kl_V4066 kl_V4066t kl_V4066th kl_V4066tt - !(kl_V4066@(Cons (Atom (UnboundSym "cons")) - (!(kl_V4066t@(Cons (!kl_V4066th) - (!(kl_V4066tt@(Cons (!kl_V4066tth) - (Atom (Nil)))))))))) -> pat_cond_1 kl_V4066 kl_V4066t kl_V4066th kl_V4066tt kl_V4066tth - !(kl_V4066@(Cons (ApplC (PL "cons" _)) - (!(kl_V4066t@(Cons (!kl_V4066th) - (!(kl_V4066tt@(Cons (!kl_V4066tth) - (Atom (Nil)))))))))) -> pat_cond_1 kl_V4066 kl_V4066t kl_V4066th kl_V4066tt kl_V4066tth - !(kl_V4066@(Cons (ApplC (Func "cons" _)) - (!(kl_V4066t@(Cons (!kl_V4066th) - (!(kl_V4066tt@(Cons (!kl_V4066tth) - (Atom (Nil)))))))))) -> pat_cond_1 kl_V4066 kl_V4066t kl_V4066th kl_V4066tt kl_V4066tth - _ -> pat_cond_3 - -kl_shen_insert_runon :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_insert_runon (!kl_V4081) (!kl_V4082) (!kl_V4083) = do let pat_cond_0 kl_V4083 kl_V4083t kl_V4083th kl_V4083tt kl_V4083tth = do return kl_V4081 - pat_cond_1 kl_V4083 kl_V4083h kl_V4083t = do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_V4081 `pseq` (kl_V4082 `pseq` (kl_Z `pseq` kl_shen_insert_runon kl_V4081 kl_V4082 kl_Z))))) - appl_2 `pseq` (kl_V4083 `pseq` kl_map appl_2 kl_V4083) - pat_cond_3 = do do return kl_V4083 - in case kl_V4083 of - !(kl_V4083@(Cons (Atom (UnboundSym "shen.pair")) - (!(kl_V4083t@(Cons (!kl_V4083th) - (!(kl_V4083tt@(Cons (!kl_V4083tth) - (Atom (Nil)))))))))) | eqCore kl_V4083tth kl_V4082 -> pat_cond_0 kl_V4083 kl_V4083t kl_V4083th kl_V4083tt kl_V4083tth - !(kl_V4083@(Cons (ApplC (PL "shen.pair" - _)) - (!(kl_V4083t@(Cons (!kl_V4083th) - (!(kl_V4083tt@(Cons (!kl_V4083tth) - (Atom (Nil)))))))))) | eqCore kl_V4083tth kl_V4082 -> pat_cond_0 kl_V4083 kl_V4083t kl_V4083th kl_V4083tt kl_V4083tth - !(kl_V4083@(Cons (ApplC (Func "shen.pair" - _)) - (!(kl_V4083t@(Cons (!kl_V4083th) - (!(kl_V4083tt@(Cons (!kl_V4083tth) - (Atom (Nil)))))))))) | eqCore kl_V4083tth kl_V4082 -> pat_cond_0 kl_V4083 kl_V4083t kl_V4083th kl_V4083tt kl_V4083tth - !(kl_V4083@(Cons (!kl_V4083h) - (!kl_V4083t))) -> pat_cond_1 kl_V4083 kl_V4083h kl_V4083t - _ -> pat_cond_3 - -kl_shen_strip_pathname :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_strip_pathname (!kl_V4089) = do !appl_0 <- kl_V4089 `pseq` kl_elementP (Types.Atom (Types.Str ".")) kl_V4089 - !kl_if_1 <- appl_0 `pseq` kl_not appl_0 - case kl_if_1 of - Atom (B (True)) -> do return kl_V4089 - Atom (B (False)) -> do let pat_cond_2 kl_V4089 kl_V4089h kl_V4089t = do kl_V4089t `pseq` kl_shen_strip_pathname kl_V4089t - pat_cond_3 = do do let !aw_4 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_4 [ApplC (wrapNamed "shen.strip-pathname" kl_shen_strip_pathname)] - in case kl_V4089 of - !(kl_V4089@(Cons (!kl_V4089h) - (!kl_V4089t))) -> pat_cond_2 kl_V4089 kl_V4089h kl_V4089t - _ -> pat_cond_3 - _ -> throwError "if: expected boolean" - -kl_shen_recursive_descent :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_recursive_descent (!kl_V4093) (!kl_V4094) (!kl_V4095) = do let pat_cond_0 kl_V4093 kl_V4093h kl_V4093t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Test) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Action) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Else) -> do !appl_4 <- kl_V4093h `pseq` kl_concat (Types.Atom (Types.UnboundSym "Parse_")) kl_V4093h - !appl_5 <- klCons (ApplC (PL "fail" kl_fail)) (Types.Atom Types.Nil) - !appl_6 <- kl_V4093h `pseq` kl_concat (Types.Atom (Types.UnboundSym "Parse_")) kl_V4093h - !appl_7 <- appl_6 `pseq` klCons appl_6 (Types.Atom Types.Nil) - !appl_8 <- appl_5 `pseq` (appl_7 `pseq` klCons appl_5 appl_7) - !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_8 - !appl_10 <- appl_9 `pseq` klCons appl_9 (Types.Atom Types.Nil) - !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "not" kl_not)) appl_10 - !appl_12 <- kl_Else `pseq` klCons kl_Else (Types.Atom Types.Nil) - !appl_13 <- kl_Action `pseq` (appl_12 `pseq` klCons kl_Action appl_12) - !appl_14 <- appl_11 `pseq` (appl_13 `pseq` klCons appl_11 appl_13) - !appl_15 <- appl_14 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_14 - !appl_16 <- appl_15 `pseq` klCons appl_15 (Types.Atom Types.Nil) - !appl_17 <- kl_Test `pseq` (appl_16 `pseq` klCons kl_Test appl_16) - !appl_18 <- appl_4 `pseq` (appl_17 `pseq` klCons appl_4 appl_17) - appl_18 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_18))) - !appl_19 <- klCons (ApplC (PL "fail" kl_fail)) (Types.Atom Types.Nil) - appl_19 `pseq` applyWrapper appl_3 [appl_19]))) - !appl_20 <- kl_V4093h `pseq` kl_concat (Types.Atom (Types.UnboundSym "Parse_")) kl_V4093h - !appl_21 <- kl_V4093t `pseq` (appl_20 `pseq` (kl_V4095 `pseq` kl_shen_syntax kl_V4093t appl_20 kl_V4095)) - appl_21 `pseq` applyWrapper appl_2 [appl_21]))) - !appl_22 <- kl_V4094 `pseq` klCons kl_V4094 (Types.Atom Types.Nil) - !appl_23 <- kl_V4093h `pseq` (appl_22 `pseq` klCons kl_V4093h appl_22) - appl_23 `pseq` applyWrapper appl_1 [appl_23] - pat_cond_24 = do do let !aw_25 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_25 [ApplC (wrapNamed "shen.recursive_descent" kl_shen_recursive_descent)] - in case kl_V4093 of - !(kl_V4093@(Cons (!kl_V4093h) - (!kl_V4093t))) -> pat_cond_0 kl_V4093 kl_V4093h kl_V4093t - _ -> pat_cond_24 - -kl_shen_variable_match :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_variable_match (!kl_V4099) (!kl_V4100) (!kl_V4101) = do let pat_cond_0 kl_V4099 kl_V4099h kl_V4099t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Test) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Action) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Else) -> do !appl_4 <- kl_Else `pseq` klCons kl_Else (Types.Atom Types.Nil) - !appl_5 <- kl_Action `pseq` (appl_4 `pseq` klCons kl_Action appl_4) - !appl_6 <- kl_Test `pseq` (appl_5 `pseq` klCons kl_Test appl_5) - appl_6 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_6))) - !appl_7 <- klCons (ApplC (PL "fail" kl_fail)) (Types.Atom Types.Nil) - appl_7 `pseq` applyWrapper appl_3 [appl_7]))) - !appl_8 <- kl_V4099h `pseq` kl_concat (Types.Atom (Types.UnboundSym "Parse_")) kl_V4099h - !appl_9 <- kl_V4100 `pseq` klCons kl_V4100 (Types.Atom Types.Nil) - !appl_10 <- appl_9 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_9 - !appl_11 <- appl_10 `pseq` klCons appl_10 (Types.Atom Types.Nil) - !appl_12 <- appl_11 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_11 - !appl_13 <- kl_V4100 `pseq` klCons kl_V4100 (Types.Atom Types.Nil) - !appl_14 <- appl_13 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_13 - !appl_15 <- appl_14 `pseq` klCons appl_14 (Types.Atom Types.Nil) - !appl_16 <- appl_15 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_15 - !appl_17 <- kl_V4100 `pseq` klCons kl_V4100 (Types.Atom Types.Nil) - !appl_18 <- appl_17 `pseq` klCons (ApplC (wrapNamed "shen.hdtl" kl_shen_hdtl)) appl_17 - !appl_19 <- appl_18 `pseq` klCons appl_18 (Types.Atom Types.Nil) - !appl_20 <- appl_16 `pseq` (appl_19 `pseq` klCons appl_16 appl_19) - !appl_21 <- appl_20 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_20 - !appl_22 <- kl_V4099t `pseq` (appl_21 `pseq` (kl_V4101 `pseq` kl_shen_syntax kl_V4099t appl_21 kl_V4101)) - !appl_23 <- appl_22 `pseq` klCons appl_22 (Types.Atom Types.Nil) - !appl_24 <- appl_12 `pseq` (appl_23 `pseq` klCons appl_12 appl_23) - !appl_25 <- appl_8 `pseq` (appl_24 `pseq` klCons appl_8 appl_24) - !appl_26 <- appl_25 `pseq` klCons (Types.Atom (Types.UnboundSym "let")) appl_25 - appl_26 `pseq` applyWrapper appl_2 [appl_26]))) - !appl_27 <- kl_V4100 `pseq` klCons kl_V4100 (Types.Atom Types.Nil) - !appl_28 <- appl_27 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_27 - !appl_29 <- appl_28 `pseq` klCons appl_28 (Types.Atom Types.Nil) - !appl_30 <- appl_29 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_29 - appl_30 `pseq` applyWrapper appl_1 [appl_30] - pat_cond_31 = do do let !aw_32 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_32 [ApplC (wrapNamed "shen.variable-match" kl_shen_variable_match)] - in case kl_V4099 of - !(kl_V4099@(Cons (!kl_V4099h) - (!kl_V4099t))) -> pat_cond_0 kl_V4099 kl_V4099h kl_V4099t - _ -> pat_cond_31 - -kl_shen_terminalP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_terminalP (!kl_V4111) = do let pat_cond_0 kl_V4111 kl_V4111h kl_V4111t = do return (Atom (B False)) - pat_cond_1 = do !kl_if_2 <- kl_V4111 `pseq` kl_variableP kl_V4111 - 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" - in case kl_V4111 of - !(kl_V4111@(Cons (!kl_V4111h) - (!kl_V4111t))) -> pat_cond_0 kl_V4111 kl_V4111h kl_V4111t - _ -> pat_cond_1 - -kl_shen_jump_streamP :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_jump_streamP (!kl_V4117) = do let pat_cond_0 = do return (Atom (B True)) - pat_cond_1 = do do return (Atom (B False)) - in case kl_V4117 of - kl_V4117@(Atom (UnboundSym "_")) -> pat_cond_0 - kl_V4117@(ApplC (PL "_" _)) -> pat_cond_0 - kl_V4117@(ApplC (Func "_" _)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_check_stream :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_check_stream (!kl_V4121) (!kl_V4122) (!kl_V4123) = do let pat_cond_0 kl_V4121 kl_V4121h kl_V4121t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Test) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Action) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Else) -> do !appl_4 <- kl_Else `pseq` klCons kl_Else (Types.Atom Types.Nil) - !appl_5 <- kl_Action `pseq` (appl_4 `pseq` klCons kl_Action appl_4) - !appl_6 <- kl_Test `pseq` (appl_5 `pseq` klCons kl_Test appl_5) - appl_6 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_6))) - !appl_7 <- klCons (ApplC (PL "fail" kl_fail)) (Types.Atom Types.Nil) - appl_7 `pseq` applyWrapper appl_3 [appl_7]))) - !appl_8 <- kl_V4122 `pseq` klCons kl_V4122 (Types.Atom Types.Nil) - !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_8 - !appl_10 <- appl_9 `pseq` klCons appl_9 (Types.Atom Types.Nil) - !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_10 - !appl_12 <- kl_V4122 `pseq` klCons kl_V4122 (Types.Atom Types.Nil) - !appl_13 <- appl_12 `pseq` klCons (ApplC (wrapNamed "shen.hdtl" kl_shen_hdtl)) appl_12 - !appl_14 <- appl_13 `pseq` klCons appl_13 (Types.Atom Types.Nil) - !appl_15 <- appl_11 `pseq` (appl_14 `pseq` klCons appl_11 appl_14) - !appl_16 <- appl_15 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_15 - !appl_17 <- kl_V4121t `pseq` (appl_16 `pseq` (kl_V4123 `pseq` kl_shen_syntax kl_V4121t appl_16 kl_V4123)) - appl_17 `pseq` applyWrapper appl_2 [appl_17]))) - !appl_18 <- kl_V4122 `pseq` klCons kl_V4122 (Types.Atom Types.Nil) - !appl_19 <- appl_18 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_18 - !appl_20 <- appl_19 `pseq` klCons appl_19 (Types.Atom Types.Nil) - !appl_21 <- appl_20 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_20 - !appl_22 <- kl_V4122 `pseq` klCons kl_V4122 (Types.Atom Types.Nil) - !appl_23 <- appl_22 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_22 - !appl_24 <- appl_23 `pseq` klCons appl_23 (Types.Atom Types.Nil) - !appl_25 <- appl_24 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_24 - !appl_26 <- appl_25 `pseq` klCons appl_25 (Types.Atom Types.Nil) - !appl_27 <- kl_V4121h `pseq` (appl_26 `pseq` klCons kl_V4121h appl_26) - !appl_28 <- appl_27 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_27 - !appl_29 <- appl_28 `pseq` klCons appl_28 (Types.Atom Types.Nil) - !appl_30 <- appl_21 `pseq` (appl_29 `pseq` klCons appl_21 appl_29) - !appl_31 <- appl_30 `pseq` klCons (Types.Atom (Types.UnboundSym "and")) appl_30 - appl_31 `pseq` applyWrapper appl_1 [appl_31] - pat_cond_32 = do do let !aw_33 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_33 [ApplC (wrapNamed "shen.check_stream" kl_shen_check_stream)] - in case kl_V4121 of - !(kl_V4121@(Cons (!kl_V4121h) - (!kl_V4121t))) -> pat_cond_0 kl_V4121 kl_V4121h kl_V4121t - _ -> pat_cond_32 - -kl_shen_jump_stream :: Types.KLValue -> - Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_jump_stream (!kl_V4127) (!kl_V4128) (!kl_V4129) = do let pat_cond_0 kl_V4127 kl_V4127h kl_V4127t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Test) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Action) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Else) -> do !appl_4 <- kl_Else `pseq` klCons kl_Else (Types.Atom Types.Nil) - !appl_5 <- kl_Action `pseq` (appl_4 `pseq` klCons kl_Action appl_4) - !appl_6 <- kl_Test `pseq` (appl_5 `pseq` klCons kl_Test appl_5) - appl_6 `pseq` klCons (Types.Atom (Types.UnboundSym "if")) appl_6))) - !appl_7 <- klCons (ApplC (PL "fail" kl_fail)) (Types.Atom Types.Nil) - appl_7 `pseq` applyWrapper appl_3 [appl_7]))) - !appl_8 <- kl_V4128 `pseq` klCons kl_V4128 (Types.Atom Types.Nil) - !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_8 - !appl_10 <- appl_9 `pseq` klCons appl_9 (Types.Atom Types.Nil) - !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_10 - !appl_12 <- kl_V4128 `pseq` klCons kl_V4128 (Types.Atom Types.Nil) - !appl_13 <- appl_12 `pseq` klCons (ApplC (wrapNamed "shen.hdtl" kl_shen_hdtl)) appl_12 - !appl_14 <- appl_13 `pseq` klCons appl_13 (Types.Atom Types.Nil) - !appl_15 <- appl_11 `pseq` (appl_14 `pseq` klCons appl_11 appl_14) - !appl_16 <- appl_15 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_15 - !appl_17 <- kl_V4127t `pseq` (appl_16 `pseq` (kl_V4129 `pseq` kl_shen_syntax kl_V4127t appl_16 kl_V4129)) - appl_17 `pseq` applyWrapper appl_2 [appl_17]))) - !appl_18 <- kl_V4128 `pseq` klCons kl_V4128 (Types.Atom Types.Nil) - !appl_19 <- appl_18 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_18 - !appl_20 <- appl_19 `pseq` klCons appl_19 (Types.Atom Types.Nil) - !appl_21 <- appl_20 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_20 - appl_21 `pseq` applyWrapper appl_1 [appl_21] - pat_cond_22 = do do let !aw_23 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_23 [ApplC (wrapNamed "shen.jump_stream" kl_shen_jump_stream)] - in case kl_V4127 of - !(kl_V4127@(Cons (!kl_V4127h) - (!kl_V4127t))) -> pat_cond_0 kl_V4127 kl_V4127h kl_V4127t - _ -> pat_cond_22 - -kl_shen_semantics :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_semantics (!kl_V4131) = do let pat_cond_0 = do return (Types.Atom Types.Nil) - pat_cond_1 = do !kl_if_2 <- kl_V4131 `pseq` kl_shen_grammar_symbolP kl_V4131 - case kl_if_2 of - Atom (B (True)) -> do !appl_3 <- kl_V4131 `pseq` kl_concat (Types.Atom (Types.UnboundSym "Parse_")) kl_V4131 - !appl_4 <- appl_3 `pseq` klCons appl_3 (Types.Atom Types.Nil) - appl_4 `pseq` klCons (ApplC (wrapNamed "shen.hdtl" kl_shen_hdtl)) appl_4 - Atom (B (False)) -> do !kl_if_5 <- kl_V4131 `pseq` kl_variableP kl_V4131 - case kl_if_5 of - Atom (B (True)) -> do kl_V4131 `pseq` kl_concat (Types.Atom (Types.UnboundSym "Parse_")) kl_V4131 - Atom (B (False)) -> do let pat_cond_6 kl_V4131 kl_V4131h kl_V4131t = do let !appl_7 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_semantics kl_Z))) - appl_7 `pseq` (kl_V4131 `pseq` kl_map appl_7 kl_V4131) - pat_cond_8 = do do return kl_V4131 - in case kl_V4131 of - !(kl_V4131@(Cons (!kl_V4131h) - (!kl_V4131t))) -> pat_cond_6 kl_V4131 kl_V4131h kl_V4131t - _ -> pat_cond_8 - _ -> throwError "if: expected boolean" - _ -> throwError "if: expected boolean" - in case kl_V4131 of - kl_V4131@(Atom (Nil)) -> pat_cond_0 - _ -> pat_cond_1 - -kl_shen_snd_or_fail :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_snd_or_fail (!kl_V4139) = do let pat_cond_0 kl_V4139 kl_V4139h kl_V4139t kl_V4139th = do return kl_V4139th - pat_cond_1 = do do kl_fail - in case kl_V4139 of - !(kl_V4139@(Cons (!kl_V4139h) - (!(kl_V4139t@(Cons (!kl_V4139th) - (Atom (Nil))))))) -> pat_cond_0 kl_V4139 kl_V4139h kl_V4139t kl_V4139th - _ -> pat_cond_1 - -kl_fail :: Types.KLContext Types.Env Types.KLValue -kl_fail = do return (Types.Atom (Types.UnboundSym "shen.fail!")) - -kl_shen_pair :: Types.KLValue -> - Types.KLValue -> Types.KLContext Types.Env Types.KLValue -kl_shen_pair (!kl_V4142) (!kl_V4143) = do !appl_0 <- kl_V4143 `pseq` klCons kl_V4143 (Types.Atom Types.Nil) - kl_V4142 `pseq` (appl_0 `pseq` klCons kl_V4142 appl_0) - -kl_shen_hdtl :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_hdtl (!kl_V4145) = do !appl_0 <- kl_V4145 `pseq` tl kl_V4145 - appl_0 `pseq` hd appl_0 - -kl_shen_LBExclRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_shen_LBExclRB (!kl_V4153) = do let pat_cond_0 kl_V4153 kl_V4153h kl_V4153t kl_V4153th = do !appl_1 <- kl_V4153h `pseq` klCons kl_V4153h (Types.Atom Types.Nil) - appl_1 `pseq` klCons (Types.Atom Types.Nil) appl_1 - pat_cond_2 = do do kl_fail - in case kl_V4153 of - !(kl_V4153@(Cons (!kl_V4153h) - (!(kl_V4153t@(Cons (!kl_V4153th) - (Atom (Nil))))))) -> pat_cond_0 kl_V4153 kl_V4153h kl_V4153t kl_V4153th - _ -> pat_cond_2 - -kl_LBeRB :: Types.KLValue -> - Types.KLContext Types.Env Types.KLValue -kl_LBeRB (!kl_V4159) = do let pat_cond_0 kl_V4159 kl_V4159h kl_V4159t kl_V4159th = do !appl_1 <- klCons (Types.Atom Types.Nil) (Types.Atom Types.Nil) - kl_V4159h `pseq` (appl_1 `pseq` klCons kl_V4159h appl_1) - pat_cond_2 = do do let !aw_3 = Types.Atom (Types.UnboundSym "shen.f_error") - applyWrapper aw_3 [ApplC (wrapNamed "" kl_LBeRB)] - in case kl_V4159 of - !(kl_V4159@(Cons (!kl_V4159h) - (!(kl_V4159t@(Cons (!kl_V4159th) - (Atom (Nil))))))) -> pat_cond_0 kl_V4159 kl_V4159h kl_V4159t kl_V4159th - _ -> pat_cond_2 - -expr4 :: Types.KLContext Types.Env Types.KLValue -expr4 = 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"))) +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.Yacc where + +import Control.Monad.Except +import Control.Parallel +import Environment +import Core.Primitives as Primitives +import Backend.Utils +import Core.Types +import Core.Utils +import Wrap +import Backend.Toplevel +import Backend.Core +import Backend.Sys +import Backend.Sequent + +{- +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_yacc :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_yacc (!kl_V4140) = do let pat_cond_0 kl_V4140 kl_V4140t kl_V4140th kl_V4140tt = do kl_V4140th `pseq` (kl_V4140tt `pseq` kl_shen_yacc_RBshen kl_V4140th kl_V4140tt) + pat_cond_1 = do do let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_2 [ApplC (wrapNamed "shen.yacc" kl_shen_yacc)] + in case kl_V4140 of + !(kl_V4140@(Cons (Atom (UnboundSym "defcc")) + (!(kl_V4140t@(Cons (!kl_V4140th) + (!kl_V4140tt)))))) -> pat_cond_0 kl_V4140 kl_V4140t kl_V4140th kl_V4140tt + !(kl_V4140@(Cons (ApplC (PL "defcc" _)) + (!(kl_V4140t@(Cons (!kl_V4140th) + (!kl_V4140tt)))))) -> pat_cond_0 kl_V4140 kl_V4140t kl_V4140th kl_V4140tt + !(kl_V4140@(Cons (ApplC (Func "defcc" _)) + (!(kl_V4140t@(Cons (!kl_V4140th) + (!kl_V4140tt)))))) -> pat_cond_0 kl_V4140 kl_V4140t kl_V4140th kl_V4140tt + _ -> pat_cond_1 + +kl_shen_yacc_RBshen :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_yacc_RBshen (!kl_V4143) (!kl_V4144) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_CCRules) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_CCBody) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_YaccCases) -> do !appl_3 <- kl_YaccCases `pseq` kl_shen_kill_code kl_YaccCases + let !appl_4 = Atom Nil + !appl_5 <- appl_3 `pseq` (appl_4 `pseq` klCons appl_3 appl_4) + !appl_6 <- appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "->")) appl_5 + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Stream")) appl_6 + !appl_8 <- kl_V4143 `pseq` (appl_7 `pseq` klCons kl_V4143 appl_7) + appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "define")) appl_8))) + !appl_9 <- kl_CCBody `pseq` kl_shen_yacc_cases kl_CCBody + appl_9 `pseq` applyWrapper appl_2 [appl_9]))) + let !appl_10 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_cc_body kl_X))) + !appl_11 <- appl_10 `pseq` (kl_CCRules `pseq` kl_map appl_10 kl_CCRules) + appl_11 `pseq` applyWrapper appl_1 [appl_11]))) + let !appl_12 = Atom Nil + !appl_13 <- kl_V4144 `pseq` (appl_12 `pseq` kl_shen_split_cc_rules (Atom (B True)) kl_V4144 appl_12) + appl_13 `pseq` applyWrapper appl_0 [appl_13] + +kl_shen_kill_code :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_kill_code (!kl_V4146) = do !appl_0 <- kl_V4146 `pseq` kl_occurrences (ApplC (PL "kill" kl_kill)) kl_V4146 + !kl_if_1 <- appl_0 `pseq` greaterThan appl_0 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) + case kl_if_1 of + Atom (B (True)) -> do let !appl_2 = Atom Nil + !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "E")) appl_2 + !appl_4 <- appl_3 `pseq` klCons (ApplC (wrapNamed "shen.analyse-kill" kl_shen_analyse_kill)) appl_3 + let !appl_5 = Atom Nil + !appl_6 <- appl_4 `pseq` (appl_5 `pseq` klCons appl_4 appl_5) + !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "E")) appl_6 + !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_7 + let !appl_9 = Atom Nil + !appl_10 <- appl_8 `pseq` (appl_9 `pseq` klCons appl_8 appl_9) + !appl_11 <- kl_V4146 `pseq` (appl_10 `pseq` klCons kl_V4146 appl_10) + appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "trap-error")) appl_11 + Atom (B (False)) -> do do return kl_V4146 + _ -> throwError "if: expected boolean" + +kl_kill :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_kill = do simpleError (Core.Types.Atom (Core.Types.Str "yacc kill")) + +kl_shen_analyse_kill :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_analyse_kill (!kl_V4148) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_String) -> do let pat_cond_1 = do kl_fail + pat_cond_2 = do do return kl_V4148 + in case kl_String of + kl_String@(Atom (Str "yacc kill")) -> pat_cond_1 + _ -> pat_cond_2))) + !appl_3 <- kl_V4148 `pseq` errorToString kl_V4148 + appl_3 `pseq` applyWrapper appl_0 [appl_3] + +kl_shen_split_cc_rules :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_split_cc_rules (!kl_V4154) (!kl_V4155) (!kl_V4156) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V4155 `pseq` eq appl_0 kl_V4155) + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do let !appl_3 = Atom Nil + !kl_if_4 <- appl_3 `pseq` (kl_V4156 `pseq` eq appl_3 kl_V4156) + case kl_if_4 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_2 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do let !appl_5 = Atom Nil + !kl_if_6 <- appl_5 `pseq` (kl_V4155 `pseq` eq appl_5 kl_V4155) + case kl_if_6 of + Atom (B (True)) -> do !appl_7 <- kl_V4156 `pseq` kl_reverse kl_V4156 + let !appl_8 = Atom Nil + !appl_9 <- kl_V4154 `pseq` (appl_7 `pseq` (appl_8 `pseq` kl_shen_split_cc_rule kl_V4154 appl_7 appl_8)) + let !appl_10 = Atom Nil + appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) + Atom (B (False)) -> do let pat_cond_11 kl_V4155 kl_V4155t = do !appl_12 <- kl_V4156 `pseq` kl_reverse kl_V4156 + let !appl_13 = Atom Nil + !appl_14 <- kl_V4154 `pseq` (appl_12 `pseq` (appl_13 `pseq` kl_shen_split_cc_rule kl_V4154 appl_12 appl_13)) + let !appl_15 = Atom Nil + !appl_16 <- kl_V4154 `pseq` (kl_V4155t `pseq` (appl_15 `pseq` kl_shen_split_cc_rules kl_V4154 kl_V4155t appl_15)) + appl_14 `pseq` (appl_16 `pseq` klCons appl_14 appl_16) + pat_cond_17 kl_V4155 kl_V4155h kl_V4155t = do !appl_18 <- kl_V4155h `pseq` (kl_V4156 `pseq` klCons kl_V4155h kl_V4156) + kl_V4154 `pseq` (kl_V4155t `pseq` (appl_18 `pseq` kl_shen_split_cc_rules kl_V4154 kl_V4155t appl_18)) + pat_cond_19 = do do let !aw_20 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_20 [ApplC (wrapNamed "shen.split_cc_rules" kl_shen_split_cc_rules)] + in case kl_V4155 of + !(kl_V4155@(Cons (Atom (UnboundSym ";")) + (!kl_V4155t))) -> pat_cond_11 kl_V4155 kl_V4155t + !(kl_V4155@(Cons (ApplC (PL ";" + _)) + (!kl_V4155t))) -> pat_cond_11 kl_V4155 kl_V4155t + !(kl_V4155@(Cons (ApplC (Func ";" + _)) + (!kl_V4155t))) -> pat_cond_11 kl_V4155 kl_V4155t + !(kl_V4155@(Cons (!kl_V4155h) + (!kl_V4155t))) -> pat_cond_17 kl_V4155 kl_V4155h kl_V4155t + _ -> pat_cond_19 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_split_cc_rule :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_split_cc_rule (!kl_V4164) (!kl_V4165) (!kl_V4166) = do !kl_if_0 <- let pat_cond_1 kl_V4165 kl_V4165h kl_V4165t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V4165t kl_V4165th kl_V4165tt = do let !appl_6 = Atom Nil + !kl_if_7 <- appl_6 `pseq` (kl_V4165tt `pseq` eq appl_6 kl_V4165tt) + 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_8 = do do return (Atom (B False)) + in case kl_V4165t of + !(kl_V4165t@(Cons (!kl_V4165th) + (!kl_V4165tt))) -> pat_cond_5 kl_V4165t kl_V4165th kl_V4165tt + _ -> pat_cond_8 + 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_9 = do do return (Atom (B False)) + in case kl_V4165h of + kl_V4165h@(Atom (UnboundSym ":=")) -> pat_cond_3 + kl_V4165h@(ApplC (PL ":=" + _)) -> pat_cond_3 + kl_V4165h@(ApplC (Func ":=" + _)) -> pat_cond_3 + _ -> pat_cond_9 + 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_10 = do do return (Atom (B False)) + in case kl_V4165 of + !(kl_V4165@(Cons (!kl_V4165h) + (!kl_V4165t))) -> pat_cond_1 kl_V4165 kl_V4165h kl_V4165t + _ -> pat_cond_10 + case kl_if_0 of + Atom (B (True)) -> do !appl_11 <- kl_V4166 `pseq` kl_reverse kl_V4166 + !appl_12 <- kl_V4165 `pseq` tl kl_V4165 + appl_11 `pseq` (appl_12 `pseq` klCons appl_11 appl_12) + Atom (B (False)) -> do !kl_if_13 <- let pat_cond_14 kl_V4165 kl_V4165h kl_V4165t = do !kl_if_15 <- let pat_cond_16 = do !kl_if_17 <- let pat_cond_18 kl_V4165t kl_V4165th kl_V4165tt = do !kl_if_19 <- let pat_cond_20 kl_V4165tt kl_V4165tth kl_V4165ttt = do !kl_if_21 <- let pat_cond_22 = do !kl_if_23 <- let pat_cond_24 kl_V4165ttt kl_V4165ttth kl_V4165tttt = do let !appl_25 = Atom Nil + !kl_if_26 <- appl_25 `pseq` (kl_V4165tttt `pseq` eq appl_25 kl_V4165tttt) + case kl_if_26 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_27 = do do return (Atom (B False)) + in case kl_V4165ttt of + !(kl_V4165ttt@(Cons (!kl_V4165ttth) + (!kl_V4165tttt))) -> pat_cond_24 kl_V4165ttt kl_V4165ttth kl_V4165tttt + _ -> pat_cond_27 + 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_28 = do do return (Atom (B False)) + in case kl_V4165tth of + kl_V4165tth@(Atom (UnboundSym "where")) -> pat_cond_22 + kl_V4165tth@(ApplC (PL "where" + _)) -> pat_cond_22 + kl_V4165tth@(ApplC (Func "where" + _)) -> pat_cond_22 + _ -> pat_cond_28 + 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_29 = do do return (Atom (B False)) + in case kl_V4165tt of + !(kl_V4165tt@(Cons (!kl_V4165tth) + (!kl_V4165ttt))) -> pat_cond_20 kl_V4165tt kl_V4165tth kl_V4165ttt + _ -> pat_cond_29 + case kl_if_19 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_30 = do do return (Atom (B False)) + in case kl_V4165t of + !(kl_V4165t@(Cons (!kl_V4165th) + (!kl_V4165tt))) -> pat_cond_18 kl_V4165t kl_V4165th kl_V4165tt + _ -> pat_cond_30 + case kl_if_17 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_31 = do do return (Atom (B False)) + in case kl_V4165h of + kl_V4165h@(Atom (UnboundSym ":=")) -> pat_cond_16 + kl_V4165h@(ApplC (PL ":=" + _)) -> pat_cond_16 + kl_V4165h@(ApplC (Func ":=" + _)) -> pat_cond_16 + _ -> pat_cond_31 + 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" + pat_cond_32 = do do return (Atom (B False)) + in case kl_V4165 of + !(kl_V4165@(Cons (!kl_V4165h) + (!kl_V4165t))) -> pat_cond_14 kl_V4165 kl_V4165h kl_V4165t + _ -> pat_cond_32 + case kl_if_13 of + Atom (B (True)) -> do !appl_33 <- kl_V4166 `pseq` kl_reverse kl_V4166 + !appl_34 <- kl_V4165 `pseq` tl kl_V4165 + !appl_35 <- appl_34 `pseq` tl appl_34 + !appl_36 <- appl_35 `pseq` tl appl_35 + !appl_37 <- appl_36 `pseq` hd appl_36 + !appl_38 <- kl_V4165 `pseq` tl kl_V4165 + !appl_39 <- appl_38 `pseq` hd appl_38 + let !appl_40 = Atom Nil + !appl_41 <- appl_39 `pseq` (appl_40 `pseq` klCons appl_39 appl_40) + !appl_42 <- appl_37 `pseq` (appl_41 `pseq` klCons appl_37 appl_41) + !appl_43 <- appl_42 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "where")) appl_42 + let !appl_44 = Atom Nil + !appl_45 <- appl_43 `pseq` (appl_44 `pseq` klCons appl_43 appl_44) + appl_33 `pseq` (appl_45 `pseq` klCons appl_33 appl_45) + Atom (B (False)) -> do let !appl_46 = Atom Nil + !kl_if_47 <- appl_46 `pseq` (kl_V4165 `pseq` eq appl_46 kl_V4165) + case kl_if_47 of + Atom (B (True)) -> do !appl_48 <- kl_V4164 `pseq` (kl_V4166 `pseq` kl_shen_semantic_completion_warning kl_V4164 kl_V4166) + !appl_49 <- kl_V4166 `pseq` kl_reverse kl_V4166 + !appl_50 <- appl_49 `pseq` kl_shen_default_semantics appl_49 + let !appl_51 = Atom Nil + !appl_52 <- appl_50 `pseq` (appl_51 `pseq` klCons appl_50 appl_51) + !appl_53 <- appl_52 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ":=")) appl_52 + !appl_54 <- kl_V4164 `pseq` (appl_53 `pseq` (kl_V4166 `pseq` kl_shen_split_cc_rule kl_V4164 appl_53 kl_V4166)) + appl_48 `pseq` (appl_54 `pseq` kl_do appl_48 appl_54) + Atom (B (False)) -> do let pat_cond_55 kl_V4165 kl_V4165h kl_V4165t = do !appl_56 <- kl_V4165h `pseq` (kl_V4166 `pseq` klCons kl_V4165h kl_V4166) + kl_V4164 `pseq` (kl_V4165t `pseq` (appl_56 `pseq` kl_shen_split_cc_rule kl_V4164 kl_V4165t appl_56)) + pat_cond_57 = do do let !aw_58 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_58 [ApplC (wrapNamed "shen.split_cc_rule" kl_shen_split_cc_rule)] + in case kl_V4165 of + !(kl_V4165@(Cons (!kl_V4165h) + (!kl_V4165t))) -> pat_cond_55 kl_V4165 kl_V4165h kl_V4165t + _ -> pat_cond_57 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_semantic_completion_warning :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_semantic_completion_warning (!kl_V4177) (!kl_V4178) = do let pat_cond_0 = do !appl_1 <- kl_stoutput + let !aw_2 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_3 <- appl_1 `pseq` applyWrapper aw_2 [Core.Types.Atom (Core.Types.Str "warning: "), + appl_1] + let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_X) -> do let !aw_5 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_6 <- kl_X `pseq` applyWrapper aw_5 [kl_X, + Core.Types.Atom (Core.Types.Str " "), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + !appl_7 <- kl_stoutput + let !aw_8 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + appl_6 `pseq` (appl_7 `pseq` applyWrapper aw_8 [appl_6, + appl_7])))) + !appl_9 <- kl_V4178 `pseq` kl_reverse kl_V4178 + !appl_10 <- appl_4 `pseq` (appl_9 `pseq` kl_for_each appl_4 appl_9) + !appl_11 <- kl_stoutput + let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.prhush") + !appl_13 <- appl_11 `pseq` applyWrapper aw_12 [Core.Types.Atom (Core.Types.Str "has no semantics.\n"), + appl_11] + !appl_14 <- appl_10 `pseq` (appl_13 `pseq` kl_do appl_10 appl_13) + appl_3 `pseq` (appl_14 `pseq` kl_do appl_3 appl_14) + pat_cond_15 = do do return (Core.Types.Atom (Core.Types.UnboundSym "shen.skip")) + in case kl_V4177 of + kl_V4177@(Atom (UnboundSym "true")) -> pat_cond_0 + kl_V4177@(Atom (B (True))) -> pat_cond_0 + _ -> pat_cond_15 + +kl_shen_default_semantics :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_default_semantics (!kl_V4180) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V4180 `pseq` eq appl_0 kl_V4180) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V4180 kl_V4180h kl_V4180t = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V4180t `pseq` eq appl_4 kl_V4180t) + !kl_if_6 <- case kl_if_5 of + Atom (B (True)) -> do !kl_if_7 <- kl_V4180h `pseq` kl_shen_grammar_symbolP kl_V4180h + 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_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_8 = do do return (Atom (B False)) + in case kl_V4180 of + !(kl_V4180@(Cons (!kl_V4180h) + (!kl_V4180t))) -> pat_cond_3 kl_V4180 kl_V4180h kl_V4180t + _ -> pat_cond_8 + case kl_if_2 of + Atom (B (True)) -> do kl_V4180 `pseq` hd kl_V4180 + Atom (B (False)) -> do !kl_if_9 <- let pat_cond_10 kl_V4180 kl_V4180h kl_V4180t = do !kl_if_11 <- kl_V4180h `pseq` kl_shen_grammar_symbolP kl_V4180h + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V4180 of + !(kl_V4180@(Cons (!kl_V4180h) + (!kl_V4180t))) -> pat_cond_10 kl_V4180 kl_V4180h kl_V4180t + _ -> pat_cond_12 + case kl_if_9 of + Atom (B (True)) -> do !appl_13 <- kl_V4180 `pseq` hd kl_V4180 + !appl_14 <- kl_V4180 `pseq` tl kl_V4180 + !appl_15 <- appl_14 `pseq` kl_shen_default_semantics appl_14 + let !appl_16 = Atom Nil + !appl_17 <- appl_15 `pseq` (appl_16 `pseq` klCons appl_15 appl_16) + !appl_18 <- appl_13 `pseq` (appl_17 `pseq` klCons appl_13 appl_17) + appl_18 `pseq` klCons (ApplC (wrapNamed "append" kl_append)) appl_18 + Atom (B (False)) -> do let pat_cond_19 kl_V4180 kl_V4180h kl_V4180t = do !appl_20 <- kl_V4180t `pseq` kl_shen_default_semantics kl_V4180t + let !appl_21 = Atom Nil + !appl_22 <- appl_20 `pseq` (appl_21 `pseq` klCons appl_20 appl_21) + !appl_23 <- kl_V4180h `pseq` (appl_22 `pseq` klCons kl_V4180h appl_22) + appl_23 `pseq` klCons (ApplC (wrapNamed "cons" klCons)) appl_23 + pat_cond_24 = do do let !aw_25 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_25 [ApplC (wrapNamed "shen.default_semantics" kl_shen_default_semantics)] + in case kl_V4180 of + !(kl_V4180@(Cons (!kl_V4180h) + (!kl_V4180t))) -> pat_cond_19 kl_V4180 kl_V4180h kl_V4180t + _ -> pat_cond_24 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_grammar_symbolP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_grammar_symbolP (!kl_V4182) = do !kl_if_0 <- kl_V4182 `pseq` kl_symbolP kl_V4182 + case kl_if_0 of + Atom (B (True)) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Cs) -> do !appl_2 <- kl_Cs `pseq` hd kl_Cs + !kl_if_3 <- appl_2 `pseq` eq appl_2 (Core.Types.Atom (Core.Types.Str "<")) + case kl_if_3 of + Atom (B (True)) -> do !appl_4 <- kl_Cs `pseq` kl_reverse kl_Cs + !appl_5 <- appl_4 `pseq` hd appl_4 + !kl_if_6 <- appl_5 `pseq` eq appl_5 (Core.Types.Atom (Core.Types.Str ">")) + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean"))) + !appl_7 <- kl_V4182 `pseq` kl_explode kl_V4182 + !appl_8 <- appl_7 `pseq` kl_shen_strip_pathname appl_7 + !kl_if_9 <- appl_8 `pseq` applyWrapper appl_1 [appl_8] + case kl_if_9 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + +kl_shen_yacc_cases :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_yacc_cases (!kl_V4184) = do !kl_if_0 <- let pat_cond_1 kl_V4184 kl_V4184h kl_V4184t = do let !appl_2 = Atom Nil + !kl_if_3 <- appl_2 `pseq` (kl_V4184t `pseq` eq appl_2 kl_V4184t) + case kl_if_3 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_4 = do do return (Atom (B False)) + in case kl_V4184 of + !(kl_V4184@(Cons (!kl_V4184h) + (!kl_V4184t))) -> pat_cond_1 kl_V4184 kl_V4184h kl_V4184t + _ -> pat_cond_4 + case kl_if_0 of + Atom (B (True)) -> do kl_V4184 `pseq` hd kl_V4184 + Atom (B (False)) -> do let pat_cond_5 kl_V4184 kl_V4184h kl_V4184t = do let !appl_6 = ApplC (Func "lambda" (Context (\(!kl_P) -> do let !appl_7 = Atom Nil + !appl_8 <- appl_7 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_7 + let !appl_9 = Atom Nil + !appl_10 <- appl_8 `pseq` (appl_9 `pseq` klCons appl_8 appl_9) + !appl_11 <- kl_P `pseq` (appl_10 `pseq` klCons kl_P appl_10) + !appl_12 <- appl_11 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_11 + !appl_13 <- kl_V4184t `pseq` kl_shen_yacc_cases kl_V4184t + let !appl_14 = Atom Nil + !appl_15 <- kl_P `pseq` (appl_14 `pseq` klCons kl_P appl_14) + !appl_16 <- appl_13 `pseq` (appl_15 `pseq` klCons appl_13 appl_15) + !appl_17 <- appl_12 `pseq` (appl_16 `pseq` klCons appl_12 appl_16) + !appl_18 <- appl_17 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_17 + let !appl_19 = Atom Nil + !appl_20 <- appl_18 `pseq` (appl_19 `pseq` klCons appl_18 appl_19) + !appl_21 <- kl_V4184h `pseq` (appl_20 `pseq` klCons kl_V4184h appl_20) + !appl_22 <- kl_P `pseq` (appl_21 `pseq` klCons kl_P appl_21) + appl_22 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_22))) + applyWrapper appl_6 [Core.Types.Atom (Core.Types.UnboundSym "YaccParse")] + pat_cond_23 = do do let !aw_24 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_24 [ApplC (wrapNamed "shen.yacc_cases" kl_shen_yacc_cases)] + in case kl_V4184 of + !(kl_V4184@(Cons (!kl_V4184h) + (!kl_V4184t))) -> pat_cond_5 kl_V4184 kl_V4184h kl_V4184t + _ -> pat_cond_23 + _ -> throwError "if: expected boolean" + +kl_shen_cc_body :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_cc_body (!kl_V4186) = do !kl_if_0 <- let pat_cond_1 kl_V4186 kl_V4186h kl_V4186t = do !kl_if_2 <- let pat_cond_3 kl_V4186t kl_V4186th kl_V4186tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V4186tt `pseq` eq appl_4 kl_V4186tt) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V4186t of + !(kl_V4186t@(Cons (!kl_V4186th) + (!kl_V4186tt))) -> pat_cond_3 kl_V4186t kl_V4186th kl_V4186tt + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V4186 of + !(kl_V4186@(Cons (!kl_V4186h) + (!kl_V4186t))) -> pat_cond_1 kl_V4186 kl_V4186h kl_V4186t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do !appl_8 <- kl_V4186 `pseq` hd kl_V4186 + !appl_9 <- kl_V4186 `pseq` tl kl_V4186 + !appl_10 <- appl_9 `pseq` hd appl_9 + appl_8 `pseq` (appl_10 `pseq` kl_shen_syntax appl_8 (Core.Types.Atom (Core.Types.UnboundSym "Stream")) appl_10) + Atom (B (False)) -> do do let !aw_11 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_11 [ApplC (wrapNamed "shen.cc_body" kl_shen_cc_body)] + _ -> throwError "if: expected boolean" + +kl_shen_syntax :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_syntax (!kl_V4190) (!kl_V4191) (!kl_V4192) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V4190 `pseq` eq appl_0 kl_V4190) + !kl_if_2 <- case kl_if_1 of + Atom (B (True)) -> do !kl_if_3 <- let pat_cond_4 kl_V4192 kl_V4192h kl_V4192t = do !kl_if_5 <- let pat_cond_6 = do !kl_if_7 <- let pat_cond_8 kl_V4192t kl_V4192th kl_V4192tt = do !kl_if_9 <- let pat_cond_10 kl_V4192tt kl_V4192tth kl_V4192ttt = do let !appl_11 = Atom Nil + !kl_if_12 <- appl_11 `pseq` (kl_V4192ttt `pseq` eq appl_11 kl_V4192ttt) + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_13 = do do return (Atom (B False)) + in case kl_V4192tt of + !(kl_V4192tt@(Cons (!kl_V4192tth) + (!kl_V4192ttt))) -> pat_cond_10 kl_V4192tt kl_V4192tth kl_V4192ttt + _ -> pat_cond_13 + 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_14 = do do return (Atom (B False)) + in case kl_V4192t of + !(kl_V4192t@(Cons (!kl_V4192th) + (!kl_V4192tt))) -> pat_cond_8 kl_V4192t kl_V4192th kl_V4192tt + _ -> pat_cond_14 + 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_15 = do do return (Atom (B False)) + in case kl_V4192h of + kl_V4192h@(Atom (UnboundSym "where")) -> pat_cond_6 + kl_V4192h@(ApplC (PL "where" + _)) -> pat_cond_6 + kl_V4192h@(ApplC (Func "where" + _)) -> pat_cond_6 + _ -> pat_cond_15 + 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_16 = do do return (Atom (B False)) + in case kl_V4192 of + !(kl_V4192@(Cons (!kl_V4192h) + (!kl_V4192t))) -> pat_cond_4 kl_V4192 kl_V4192h kl_V4192t + _ -> pat_cond_16 + 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" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_2 of + Atom (B (True)) -> do !appl_17 <- kl_V4192 `pseq` tl kl_V4192 + !appl_18 <- appl_17 `pseq` hd appl_17 + !appl_19 <- appl_18 `pseq` kl_shen_semantics appl_18 + let !appl_20 = Atom Nil + !appl_21 <- kl_V4191 `pseq` (appl_20 `pseq` klCons kl_V4191 appl_20) + !appl_22 <- appl_21 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_21 + !appl_23 <- kl_V4192 `pseq` tl kl_V4192 + !appl_24 <- appl_23 `pseq` tl appl_23 + !appl_25 <- appl_24 `pseq` hd appl_24 + !appl_26 <- appl_25 `pseq` kl_shen_semantics appl_25 + let !appl_27 = Atom Nil + !appl_28 <- appl_26 `pseq` (appl_27 `pseq` klCons appl_26 appl_27) + !appl_29 <- appl_22 `pseq` (appl_28 `pseq` klCons appl_22 appl_28) + !appl_30 <- appl_29 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_29 + let !appl_31 = Atom Nil + !appl_32 <- appl_31 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_31 + let !appl_33 = Atom Nil + !appl_34 <- appl_32 `pseq` (appl_33 `pseq` klCons appl_32 appl_33) + !appl_35 <- appl_30 `pseq` (appl_34 `pseq` klCons appl_30 appl_34) + !appl_36 <- appl_19 `pseq` (appl_35 `pseq` klCons appl_19 appl_35) + appl_36 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_36 + Atom (B (False)) -> do let !appl_37 = Atom Nil + !kl_if_38 <- appl_37 `pseq` (kl_V4190 `pseq` eq appl_37 kl_V4190) + case kl_if_38 of + Atom (B (True)) -> do let !appl_39 = Atom Nil + !appl_40 <- kl_V4191 `pseq` (appl_39 `pseq` klCons kl_V4191 appl_39) + !appl_41 <- appl_40 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_40 + !appl_42 <- kl_V4192 `pseq` kl_shen_semantics kl_V4192 + let !appl_43 = Atom Nil + !appl_44 <- appl_42 `pseq` (appl_43 `pseq` klCons appl_42 appl_43) + !appl_45 <- appl_41 `pseq` (appl_44 `pseq` klCons appl_41 appl_44) + appl_45 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_45 + Atom (B (False)) -> do let pat_cond_46 kl_V4190 kl_V4190h kl_V4190t = do !kl_if_47 <- kl_V4190h `pseq` kl_shen_grammar_symbolP kl_V4190h + case kl_if_47 of + Atom (B (True)) -> do kl_V4190 `pseq` (kl_V4191 `pseq` (kl_V4192 `pseq` kl_shen_recursive_descent kl_V4190 kl_V4191 kl_V4192)) + Atom (B (False)) -> do do !kl_if_48 <- kl_V4190h `pseq` kl_variableP kl_V4190h + case kl_if_48 of + Atom (B (True)) -> do kl_V4190 `pseq` (kl_V4191 `pseq` (kl_V4192 `pseq` kl_shen_variable_match kl_V4190 kl_V4191 kl_V4192)) + Atom (B (False)) -> do do !kl_if_49 <- kl_V4190h `pseq` kl_shen_jump_streamP kl_V4190h + case kl_if_49 of + Atom (B (True)) -> do kl_V4190 `pseq` (kl_V4191 `pseq` (kl_V4192 `pseq` kl_shen_jump_stream kl_V4190 kl_V4191 kl_V4192)) + Atom (B (False)) -> do do !kl_if_50 <- kl_V4190h `pseq` kl_shen_terminalP kl_V4190h + case kl_if_50 of + Atom (B (True)) -> do kl_V4190 `pseq` (kl_V4191 `pseq` (kl_V4192 `pseq` kl_shen_check_stream kl_V4190 kl_V4191 kl_V4192)) + Atom (B (False)) -> do do let pat_cond_51 kl_V4190h kl_V4190hh kl_V4190ht = do !appl_52 <- kl_V4190h `pseq` kl_shen_decons kl_V4190h + appl_52 `pseq` (kl_V4190t `pseq` (kl_V4191 `pseq` (kl_V4192 `pseq` kl_shen_list_stream appl_52 kl_V4190t kl_V4191 kl_V4192))) + pat_cond_53 = do do let !aw_54 = Core.Types.Atom (Core.Types.UnboundSym "shen.app") + !appl_55 <- kl_V4190h `pseq` applyWrapper aw_54 [kl_V4190h, + Core.Types.Atom (Core.Types.Str " is not legal syntax\n"), + Core.Types.Atom (Core.Types.UnboundSym "shen.a")] + appl_55 `pseq` simpleError appl_55 + in case kl_V4190h of + !(kl_V4190h@(Cons (!kl_V4190hh) + (!kl_V4190ht))) -> pat_cond_51 kl_V4190h kl_V4190hh kl_V4190ht + _ -> pat_cond_53 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + pat_cond_56 = do do let !aw_57 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_57 [ApplC (wrapNamed "shen.syntax" kl_shen_syntax)] + in case kl_V4190 of + !(kl_V4190@(Cons (!kl_V4190h) + (!kl_V4190t))) -> pat_cond_46 kl_V4190 kl_V4190h kl_V4190t + _ -> pat_cond_56 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_list_stream :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_list_stream (!kl_V4197) (!kl_V4198) (!kl_V4199) (!kl_V4200) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Test) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Placeholder) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_RunOn) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Action) -> do let !appl_4 = Atom Nil + !appl_5 <- appl_4 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_4 + let !appl_6 = Atom Nil + !appl_7 <- appl_5 `pseq` (appl_6 `pseq` klCons appl_5 appl_6) + !appl_8 <- kl_Action `pseq` (appl_7 `pseq` klCons kl_Action appl_7) + !appl_9 <- kl_Test `pseq` (appl_8 `pseq` klCons kl_Test appl_8) + appl_9 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_9))) + let !appl_10 = Atom Nil + !appl_11 <- kl_V4199 `pseq` (appl_10 `pseq` klCons kl_V4199 appl_10) + !appl_12 <- appl_11 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_11 + let !appl_13 = Atom Nil + !appl_14 <- appl_12 `pseq` (appl_13 `pseq` klCons appl_12 appl_13) + !appl_15 <- appl_14 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_14 + let !appl_16 = Atom Nil + !appl_17 <- kl_V4199 `pseq` (appl_16 `pseq` klCons kl_V4199 appl_16) + !appl_18 <- appl_17 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_17 + let !appl_19 = Atom Nil + !appl_20 <- appl_18 `pseq` (appl_19 `pseq` klCons appl_18 appl_19) + !appl_21 <- appl_20 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_20 + let !appl_22 = Atom Nil + !appl_23 <- appl_21 `pseq` (appl_22 `pseq` klCons appl_21 appl_22) + !appl_24 <- appl_15 `pseq` (appl_23 `pseq` klCons appl_15 appl_23) + !appl_25 <- appl_24 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_24 + !appl_26 <- kl_V4197 `pseq` (appl_25 `pseq` (kl_Placeholder `pseq` kl_shen_syntax kl_V4197 appl_25 kl_Placeholder)) + !appl_27 <- kl_RunOn `pseq` (kl_Placeholder `pseq` (appl_26 `pseq` kl_shen_insert_runon kl_RunOn kl_Placeholder appl_26)) + appl_27 `pseq` applyWrapper appl_3 [appl_27]))) + let !appl_28 = Atom Nil + !appl_29 <- kl_V4199 `pseq` (appl_28 `pseq` klCons kl_V4199 appl_28) + !appl_30 <- appl_29 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_29 + let !appl_31 = Atom Nil + !appl_32 <- appl_30 `pseq` (appl_31 `pseq` klCons appl_30 appl_31) + !appl_33 <- appl_32 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_32 + let !appl_34 = Atom Nil + !appl_35 <- kl_V4199 `pseq` (appl_34 `pseq` klCons kl_V4199 appl_34) + !appl_36 <- appl_35 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_35 + let !appl_37 = Atom Nil + !appl_38 <- appl_36 `pseq` (appl_37 `pseq` klCons appl_36 appl_37) + !appl_39 <- appl_38 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_38 + let !appl_40 = Atom Nil + !appl_41 <- appl_39 `pseq` (appl_40 `pseq` klCons appl_39 appl_40) + !appl_42 <- appl_33 `pseq` (appl_41 `pseq` klCons appl_33 appl_41) + !appl_43 <- appl_42 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_42 + !appl_44 <- kl_V4198 `pseq` (appl_43 `pseq` (kl_V4200 `pseq` kl_shen_syntax kl_V4198 appl_43 kl_V4200)) + appl_44 `pseq` applyWrapper appl_2 [appl_44]))) + !appl_45 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "shen.place")) + appl_45 `pseq` applyWrapper appl_1 [appl_45]))) + let !appl_46 = Atom Nil + !appl_47 <- kl_V4199 `pseq` (appl_46 `pseq` klCons kl_V4199 appl_46) + !appl_48 <- appl_47 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_47 + let !appl_49 = Atom Nil + !appl_50 <- appl_48 `pseq` (appl_49 `pseq` klCons appl_48 appl_49) + !appl_51 <- appl_50 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_50 + let !appl_52 = Atom Nil + !appl_53 <- kl_V4199 `pseq` (appl_52 `pseq` klCons kl_V4199 appl_52) + !appl_54 <- appl_53 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_53 + let !appl_55 = Atom Nil + !appl_56 <- appl_54 `pseq` (appl_55 `pseq` klCons appl_54 appl_55) + !appl_57 <- appl_56 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_56 + let !appl_58 = Atom Nil + !appl_59 <- appl_57 `pseq` (appl_58 `pseq` klCons appl_57 appl_58) + !appl_60 <- appl_59 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_59 + let !appl_61 = Atom Nil + !appl_62 <- appl_60 `pseq` (appl_61 `pseq` klCons appl_60 appl_61) + !appl_63 <- appl_51 `pseq` (appl_62 `pseq` klCons appl_51 appl_62) + !appl_64 <- appl_63 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "and")) appl_63 + appl_64 `pseq` applyWrapper appl_0 [appl_64] + +kl_shen_decons :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_decons (!kl_V4202) = do !kl_if_0 <- let pat_cond_1 kl_V4202 kl_V4202h kl_V4202t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V4202t kl_V4202th kl_V4202tt = do !kl_if_6 <- let pat_cond_7 kl_V4202tt kl_V4202tth kl_V4202ttt = do let !appl_8 = Atom Nil + !kl_if_9 <- appl_8 `pseq` (kl_V4202tth `pseq` eq appl_8 kl_V4202tth) + !kl_if_10 <- case kl_if_9 of + Atom (B (True)) -> do let !appl_11 = Atom Nil + !kl_if_12 <- appl_11 `pseq` (kl_V4202ttt `pseq` eq appl_11 kl_V4202ttt) + case kl_if_12 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_13 = do do return (Atom (B False)) + in case kl_V4202tt of + !(kl_V4202tt@(Cons (!kl_V4202tth) + (!kl_V4202ttt))) -> pat_cond_7 kl_V4202tt kl_V4202tth kl_V4202ttt + _ -> 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_V4202t of + !(kl_V4202t@(Cons (!kl_V4202th) + (!kl_V4202tt))) -> pat_cond_5 kl_V4202t kl_V4202th kl_V4202tt + _ -> 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_V4202h of + kl_V4202h@(Atom (UnboundSym "cons")) -> pat_cond_3 + kl_V4202h@(ApplC (PL "cons" + _)) -> pat_cond_3 + kl_V4202h@(ApplC (Func "cons" + _)) -> pat_cond_3 + _ -> 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_V4202 of + !(kl_V4202@(Cons (!kl_V4202h) + (!kl_V4202t))) -> pat_cond_1 kl_V4202 kl_V4202h kl_V4202t + _ -> pat_cond_16 + case kl_if_0 of + Atom (B (True)) -> do !appl_17 <- kl_V4202 `pseq` tl kl_V4202 + !appl_18 <- appl_17 `pseq` hd appl_17 + let !appl_19 = Atom Nil + appl_18 `pseq` (appl_19 `pseq` klCons appl_18 appl_19) + Atom (B (False)) -> do !kl_if_20 <- let pat_cond_21 kl_V4202 kl_V4202h kl_V4202t = do !kl_if_22 <- let pat_cond_23 = do !kl_if_24 <- let pat_cond_25 kl_V4202t kl_V4202th kl_V4202tt = do !kl_if_26 <- let pat_cond_27 kl_V4202tt kl_V4202tth kl_V4202ttt = do let !appl_28 = Atom Nil + !kl_if_29 <- appl_28 `pseq` (kl_V4202ttt `pseq` eq appl_28 kl_V4202ttt) + case kl_if_29 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_30 = do do return (Atom (B False)) + in case kl_V4202tt of + !(kl_V4202tt@(Cons (!kl_V4202tth) + (!kl_V4202ttt))) -> pat_cond_27 kl_V4202tt kl_V4202tth kl_V4202ttt + _ -> pat_cond_30 + case kl_if_26 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_31 = do do return (Atom (B False)) + in case kl_V4202t of + !(kl_V4202t@(Cons (!kl_V4202th) + (!kl_V4202tt))) -> pat_cond_25 kl_V4202t kl_V4202th kl_V4202tt + _ -> pat_cond_31 + case kl_if_24 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_V4202h of + kl_V4202h@(Atom (UnboundSym "cons")) -> pat_cond_23 + kl_V4202h@(ApplC (PL "cons" + _)) -> pat_cond_23 + kl_V4202h@(ApplC (Func "cons" + _)) -> pat_cond_23 + _ -> pat_cond_32 + case kl_if_22 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_V4202 of + !(kl_V4202@(Cons (!kl_V4202h) + (!kl_V4202t))) -> pat_cond_21 kl_V4202 kl_V4202h kl_V4202t + _ -> pat_cond_33 + case kl_if_20 of + Atom (B (True)) -> do !appl_34 <- kl_V4202 `pseq` tl kl_V4202 + !appl_35 <- appl_34 `pseq` hd appl_34 + !appl_36 <- kl_V4202 `pseq` tl kl_V4202 + !appl_37 <- appl_36 `pseq` tl appl_36 + !appl_38 <- appl_37 `pseq` hd appl_37 + !appl_39 <- appl_38 `pseq` kl_shen_decons appl_38 + appl_35 `pseq` (appl_39 `pseq` klCons appl_35 appl_39) + Atom (B (False)) -> do do return kl_V4202 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_insert_runon :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_insert_runon (!kl_V4217) (!kl_V4218) (!kl_V4219) = do !kl_if_0 <- let pat_cond_1 kl_V4219 kl_V4219h kl_V4219t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V4219t kl_V4219th kl_V4219tt = do !kl_if_6 <- let pat_cond_7 kl_V4219tt kl_V4219tth kl_V4219ttt = do let !appl_8 = Atom Nil + !kl_if_9 <- appl_8 `pseq` (kl_V4219ttt `pseq` eq appl_8 kl_V4219ttt) + !kl_if_10 <- case kl_if_9 of + Atom (B (True)) -> do !kl_if_11 <- kl_V4219tth `pseq` (kl_V4218 `pseq` eq kl_V4219tth kl_V4218) + case kl_if_11 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + case kl_if_10 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_12 = do do return (Atom (B False)) + in case kl_V4219tt of + !(kl_V4219tt@(Cons (!kl_V4219tth) + (!kl_V4219ttt))) -> pat_cond_7 kl_V4219tt kl_V4219tth kl_V4219ttt + _ -> pat_cond_12 + 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_13 = do do return (Atom (B False)) + in case kl_V4219t of + !(kl_V4219t@(Cons (!kl_V4219th) + (!kl_V4219tt))) -> pat_cond_5 kl_V4219t kl_V4219th kl_V4219tt + _ -> pat_cond_13 + 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_14 = do do return (Atom (B False)) + in case kl_V4219h of + kl_V4219h@(Atom (UnboundSym "shen.pair")) -> pat_cond_3 + kl_V4219h@(ApplC (PL "shen.pair" + _)) -> pat_cond_3 + kl_V4219h@(ApplC (Func "shen.pair" + _)) -> pat_cond_3 + _ -> pat_cond_14 + 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_15 = do do return (Atom (B False)) + in case kl_V4219 of + !(kl_V4219@(Cons (!kl_V4219h) + (!kl_V4219t))) -> pat_cond_1 kl_V4219 kl_V4219h kl_V4219t + _ -> pat_cond_15 + case kl_if_0 of + Atom (B (True)) -> do return kl_V4217 + Atom (B (False)) -> do let pat_cond_16 kl_V4219 kl_V4219h kl_V4219t = do let !appl_17 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_V4217 `pseq` (kl_V4218 `pseq` (kl_Z `pseq` kl_shen_insert_runon kl_V4217 kl_V4218 kl_Z))))) + appl_17 `pseq` (kl_V4219 `pseq` kl_map appl_17 kl_V4219) + pat_cond_18 = do do return kl_V4219 + in case kl_V4219 of + !(kl_V4219@(Cons (!kl_V4219h) + (!kl_V4219t))) -> pat_cond_16 kl_V4219 kl_V4219h kl_V4219t + _ -> pat_cond_18 + _ -> throwError "if: expected boolean" + +kl_shen_strip_pathname :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_strip_pathname (!kl_V4225) = do !appl_0 <- kl_V4225 `pseq` kl_elementP (Core.Types.Atom (Core.Types.Str ".")) kl_V4225 + !kl_if_1 <- appl_0 `pseq` kl_not appl_0 + case kl_if_1 of + Atom (B (True)) -> do return kl_V4225 + Atom (B (False)) -> do let pat_cond_2 kl_V4225 kl_V4225h kl_V4225t = do kl_V4225t `pseq` kl_shen_strip_pathname kl_V4225t + pat_cond_3 = do do let !aw_4 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_4 [ApplC (wrapNamed "shen.strip-pathname" kl_shen_strip_pathname)] + in case kl_V4225 of + !(kl_V4225@(Cons (!kl_V4225h) + (!kl_V4225t))) -> pat_cond_2 kl_V4225 kl_V4225h kl_V4225t + _ -> pat_cond_3 + _ -> throwError "if: expected boolean" + +kl_shen_recursive_descent :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_recursive_descent (!kl_V4229) (!kl_V4230) (!kl_V4231) = do let pat_cond_0 kl_V4229 kl_V4229h kl_V4229t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Test) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Action) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Else) -> do !appl_4 <- kl_V4229h `pseq` kl_concat (Core.Types.Atom (Core.Types.UnboundSym "Parse_")) kl_V4229h + let !appl_5 = Atom Nil + !appl_6 <- appl_5 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_5 + !appl_7 <- kl_V4229h `pseq` kl_concat (Core.Types.Atom (Core.Types.UnboundSym "Parse_")) kl_V4229h + let !appl_8 = Atom Nil + !appl_9 <- appl_7 `pseq` (appl_8 `pseq` klCons appl_7 appl_8) + !appl_10 <- appl_6 `pseq` (appl_9 `pseq` klCons appl_6 appl_9) + !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_10 + let !appl_12 = Atom Nil + !appl_13 <- appl_11 `pseq` (appl_12 `pseq` klCons appl_11 appl_12) + !appl_14 <- appl_13 `pseq` klCons (ApplC (wrapNamed "not" kl_not)) appl_13 + let !appl_15 = Atom Nil + !appl_16 <- kl_Else `pseq` (appl_15 `pseq` klCons kl_Else appl_15) + !appl_17 <- kl_Action `pseq` (appl_16 `pseq` klCons kl_Action appl_16) + !appl_18 <- appl_14 `pseq` (appl_17 `pseq` klCons appl_14 appl_17) + !appl_19 <- appl_18 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_18 + let !appl_20 = Atom Nil + !appl_21 <- appl_19 `pseq` (appl_20 `pseq` klCons appl_19 appl_20) + !appl_22 <- kl_Test `pseq` (appl_21 `pseq` klCons kl_Test appl_21) + !appl_23 <- appl_4 `pseq` (appl_22 `pseq` klCons appl_4 appl_22) + appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_23))) + let !appl_24 = Atom Nil + !appl_25 <- appl_24 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_24 + appl_25 `pseq` applyWrapper appl_3 [appl_25]))) + !appl_26 <- kl_V4229h `pseq` kl_concat (Core.Types.Atom (Core.Types.UnboundSym "Parse_")) kl_V4229h + !appl_27 <- kl_V4229t `pseq` (appl_26 `pseq` (kl_V4231 `pseq` kl_shen_syntax kl_V4229t appl_26 kl_V4231)) + appl_27 `pseq` applyWrapper appl_2 [appl_27]))) + let !appl_28 = Atom Nil + !appl_29 <- kl_V4230 `pseq` (appl_28 `pseq` klCons kl_V4230 appl_28) + !appl_30 <- kl_V4229h `pseq` (appl_29 `pseq` klCons kl_V4229h appl_29) + appl_30 `pseq` applyWrapper appl_1 [appl_30] + pat_cond_31 = do do let !aw_32 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_32 [ApplC (wrapNamed "shen.recursive_descent" kl_shen_recursive_descent)] + in case kl_V4229 of + !(kl_V4229@(Cons (!kl_V4229h) + (!kl_V4229t))) -> pat_cond_0 kl_V4229 kl_V4229h kl_V4229t + _ -> pat_cond_31 + +kl_shen_variable_match :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_variable_match (!kl_V4235) (!kl_V4236) (!kl_V4237) = do let pat_cond_0 kl_V4235 kl_V4235h kl_V4235t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Test) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Action) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Else) -> do let !appl_4 = Atom Nil + !appl_5 <- kl_Else `pseq` (appl_4 `pseq` klCons kl_Else appl_4) + !appl_6 <- kl_Action `pseq` (appl_5 `pseq` klCons kl_Action appl_5) + !appl_7 <- kl_Test `pseq` (appl_6 `pseq` klCons kl_Test appl_6) + appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_7))) + let !appl_8 = Atom Nil + !appl_9 <- appl_8 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_8 + appl_9 `pseq` applyWrapper appl_3 [appl_9]))) + !appl_10 <- kl_V4235h `pseq` kl_concat (Core.Types.Atom (Core.Types.UnboundSym "Parse_")) kl_V4235h + let !appl_11 = Atom Nil + !appl_12 <- kl_V4236 `pseq` (appl_11 `pseq` klCons kl_V4236 appl_11) + !appl_13 <- appl_12 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_12 + let !appl_14 = Atom Nil + !appl_15 <- appl_13 `pseq` (appl_14 `pseq` klCons appl_13 appl_14) + !appl_16 <- appl_15 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_15 + let !appl_17 = Atom Nil + !appl_18 <- kl_V4236 `pseq` (appl_17 `pseq` klCons kl_V4236 appl_17) + !appl_19 <- appl_18 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_18 + let !appl_20 = Atom Nil + !appl_21 <- appl_19 `pseq` (appl_20 `pseq` klCons appl_19 appl_20) + !appl_22 <- appl_21 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_21 + let !appl_23 = Atom Nil + !appl_24 <- kl_V4236 `pseq` (appl_23 `pseq` klCons kl_V4236 appl_23) + !appl_25 <- appl_24 `pseq` klCons (ApplC (wrapNamed "shen.hdtl" kl_shen_hdtl)) appl_24 + let !appl_26 = Atom Nil + !appl_27 <- appl_25 `pseq` (appl_26 `pseq` klCons appl_25 appl_26) + !appl_28 <- appl_22 `pseq` (appl_27 `pseq` klCons appl_22 appl_27) + !appl_29 <- appl_28 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_28 + !appl_30 <- kl_V4235t `pseq` (appl_29 `pseq` (kl_V4237 `pseq` kl_shen_syntax kl_V4235t appl_29 kl_V4237)) + let !appl_31 = Atom Nil + !appl_32 <- appl_30 `pseq` (appl_31 `pseq` klCons appl_30 appl_31) + !appl_33 <- appl_16 `pseq` (appl_32 `pseq` klCons appl_16 appl_32) + !appl_34 <- appl_10 `pseq` (appl_33 `pseq` klCons appl_10 appl_33) + !appl_35 <- appl_34 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_34 + appl_35 `pseq` applyWrapper appl_2 [appl_35]))) + let !appl_36 = Atom Nil + !appl_37 <- kl_V4236 `pseq` (appl_36 `pseq` klCons kl_V4236 appl_36) + !appl_38 <- appl_37 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_37 + let !appl_39 = Atom Nil + !appl_40 <- appl_38 `pseq` (appl_39 `pseq` klCons appl_38 appl_39) + !appl_41 <- appl_40 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_40 + appl_41 `pseq` applyWrapper appl_1 [appl_41] + pat_cond_42 = do do let !aw_43 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_43 [ApplC (wrapNamed "shen.variable-match" kl_shen_variable_match)] + in case kl_V4235 of + !(kl_V4235@(Cons (!kl_V4235h) + (!kl_V4235t))) -> pat_cond_0 kl_V4235 kl_V4235h kl_V4235t + _ -> pat_cond_42 + +kl_shen_terminalP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_terminalP (!kl_V4247) = do let pat_cond_0 kl_V4247 kl_V4247h kl_V4247t = do return (Atom (B False)) + pat_cond_1 = do !kl_if_2 <- kl_V4247 `pseq` kl_variableP kl_V4247 + 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" + in case kl_V4247 of + !(kl_V4247@(Cons (!kl_V4247h) + (!kl_V4247t))) -> pat_cond_0 kl_V4247 kl_V4247h kl_V4247t + _ -> pat_cond_1 + +kl_shen_jump_streamP :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_jump_streamP (!kl_V4253) = do let pat_cond_0 = do return (Atom (B True)) + pat_cond_1 = do do return (Atom (B False)) + in case kl_V4253 of + kl_V4253@(Atom (UnboundSym "_")) -> pat_cond_0 + kl_V4253@(ApplC (PL "_" _)) -> pat_cond_0 + kl_V4253@(ApplC (Func "_" _)) -> pat_cond_0 + _ -> pat_cond_1 + +kl_shen_check_stream :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_check_stream (!kl_V4257) (!kl_V4258) (!kl_V4259) = do let pat_cond_0 kl_V4257 kl_V4257h kl_V4257t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Test) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Action) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Else) -> do let !appl_4 = Atom Nil + !appl_5 <- kl_Else `pseq` (appl_4 `pseq` klCons kl_Else appl_4) + !appl_6 <- kl_Action `pseq` (appl_5 `pseq` klCons kl_Action appl_5) + !appl_7 <- kl_Test `pseq` (appl_6 `pseq` klCons kl_Test appl_6) + appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_7))) + let !appl_8 = Atom Nil + !appl_9 <- appl_8 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_8 + appl_9 `pseq` applyWrapper appl_3 [appl_9]))) + let !appl_10 = Atom Nil + !appl_11 <- kl_V4258 `pseq` (appl_10 `pseq` klCons kl_V4258 appl_10) + !appl_12 <- appl_11 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_11 + let !appl_13 = Atom Nil + !appl_14 <- appl_12 `pseq` (appl_13 `pseq` klCons appl_12 appl_13) + !appl_15 <- appl_14 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_14 + let !appl_16 = Atom Nil + !appl_17 <- kl_V4258 `pseq` (appl_16 `pseq` klCons kl_V4258 appl_16) + !appl_18 <- appl_17 `pseq` klCons (ApplC (wrapNamed "shen.hdtl" kl_shen_hdtl)) appl_17 + let !appl_19 = Atom Nil + !appl_20 <- appl_18 `pseq` (appl_19 `pseq` klCons appl_18 appl_19) + !appl_21 <- appl_15 `pseq` (appl_20 `pseq` klCons appl_15 appl_20) + !appl_22 <- appl_21 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_21 + !appl_23 <- kl_V4257t `pseq` (appl_22 `pseq` (kl_V4259 `pseq` kl_shen_syntax kl_V4257t appl_22 kl_V4259)) + appl_23 `pseq` applyWrapper appl_2 [appl_23]))) + let !appl_24 = Atom Nil + !appl_25 <- kl_V4258 `pseq` (appl_24 `pseq` klCons kl_V4258 appl_24) + !appl_26 <- appl_25 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_25 + let !appl_27 = Atom Nil + !appl_28 <- appl_26 `pseq` (appl_27 `pseq` klCons appl_26 appl_27) + !appl_29 <- appl_28 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_28 + let !appl_30 = Atom Nil + !appl_31 <- kl_V4258 `pseq` (appl_30 `pseq` klCons kl_V4258 appl_30) + !appl_32 <- appl_31 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_31 + let !appl_33 = Atom Nil + !appl_34 <- appl_32 `pseq` (appl_33 `pseq` klCons appl_32 appl_33) + !appl_35 <- appl_34 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_34 + let !appl_36 = Atom Nil + !appl_37 <- appl_35 `pseq` (appl_36 `pseq` klCons appl_35 appl_36) + !appl_38 <- kl_V4257h `pseq` (appl_37 `pseq` klCons kl_V4257h appl_37) + !appl_39 <- appl_38 `pseq` klCons (ApplC (wrapNamed "=" eq)) appl_38 + let !appl_40 = Atom Nil + !appl_41 <- appl_39 `pseq` (appl_40 `pseq` klCons appl_39 appl_40) + !appl_42 <- appl_29 `pseq` (appl_41 `pseq` klCons appl_29 appl_41) + !appl_43 <- appl_42 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "and")) appl_42 + appl_43 `pseq` applyWrapper appl_1 [appl_43] + pat_cond_44 = do do let !aw_45 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_45 [ApplC (wrapNamed "shen.check_stream" kl_shen_check_stream)] + in case kl_V4257 of + !(kl_V4257@(Cons (!kl_V4257h) + (!kl_V4257t))) -> pat_cond_0 kl_V4257 kl_V4257h kl_V4257t + _ -> pat_cond_44 + +kl_shen_jump_stream :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_jump_stream (!kl_V4263) (!kl_V4264) (!kl_V4265) = do let pat_cond_0 kl_V4263 kl_V4263h kl_V4263t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Test) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Action) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Else) -> do let !appl_4 = Atom Nil + !appl_5 <- kl_Else `pseq` (appl_4 `pseq` klCons kl_Else appl_4) + !appl_6 <- kl_Action `pseq` (appl_5 `pseq` klCons kl_Action appl_5) + !appl_7 <- kl_Test `pseq` (appl_6 `pseq` klCons kl_Test appl_6) + appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_7))) + let !appl_8 = Atom Nil + !appl_9 <- appl_8 `pseq` klCons (ApplC (PL "fail" kl_fail)) appl_8 + appl_9 `pseq` applyWrapper appl_3 [appl_9]))) + let !appl_10 = Atom Nil + !appl_11 <- kl_V4264 `pseq` (appl_10 `pseq` klCons kl_V4264 appl_10) + !appl_12 <- appl_11 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_11 + let !appl_13 = Atom Nil + !appl_14 <- appl_12 `pseq` (appl_13 `pseq` klCons appl_12 appl_13) + !appl_15 <- appl_14 `pseq` klCons (ApplC (wrapNamed "tl" tl)) appl_14 + let !appl_16 = Atom Nil + !appl_17 <- kl_V4264 `pseq` (appl_16 `pseq` klCons kl_V4264 appl_16) + !appl_18 <- appl_17 `pseq` klCons (ApplC (wrapNamed "shen.hdtl" kl_shen_hdtl)) appl_17 + let !appl_19 = Atom Nil + !appl_20 <- appl_18 `pseq` (appl_19 `pseq` klCons appl_18 appl_19) + !appl_21 <- appl_15 `pseq` (appl_20 `pseq` klCons appl_15 appl_20) + !appl_22 <- appl_21 `pseq` klCons (ApplC (wrapNamed "shen.pair" kl_shen_pair)) appl_21 + !appl_23 <- kl_V4263t `pseq` (appl_22 `pseq` (kl_V4265 `pseq` kl_shen_syntax kl_V4263t appl_22 kl_V4265)) + appl_23 `pseq` applyWrapper appl_2 [appl_23]))) + let !appl_24 = Atom Nil + !appl_25 <- kl_V4264 `pseq` (appl_24 `pseq` klCons kl_V4264 appl_24) + !appl_26 <- appl_25 `pseq` klCons (ApplC (wrapNamed "hd" hd)) appl_25 + let !appl_27 = Atom Nil + !appl_28 <- appl_26 `pseq` (appl_27 `pseq` klCons appl_26 appl_27) + !appl_29 <- appl_28 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_28 + appl_29 `pseq` applyWrapper appl_1 [appl_29] + pat_cond_30 = do do let !aw_31 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_31 [ApplC (wrapNamed "shen.jump_stream" kl_shen_jump_stream)] + in case kl_V4263 of + !(kl_V4263@(Cons (!kl_V4263h) + (!kl_V4263t))) -> pat_cond_0 kl_V4263 kl_V4263h kl_V4263t + _ -> pat_cond_30 + +kl_shen_semantics :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_semantics (!kl_V4267) = do let !appl_0 = Atom Nil + !kl_if_1 <- appl_0 `pseq` (kl_V4267 `pseq` eq appl_0 kl_V4267) + case kl_if_1 of + Atom (B (True)) -> do return (Atom Nil) + Atom (B (False)) -> do !kl_if_2 <- kl_V4267 `pseq` kl_shen_grammar_symbolP kl_V4267 + case kl_if_2 of + Atom (B (True)) -> do !appl_3 <- kl_V4267 `pseq` kl_concat (Core.Types.Atom (Core.Types.UnboundSym "Parse_")) kl_V4267 + let !appl_4 = Atom Nil + !appl_5 <- appl_3 `pseq` (appl_4 `pseq` klCons appl_3 appl_4) + appl_5 `pseq` klCons (ApplC (wrapNamed "shen.hdtl" kl_shen_hdtl)) appl_5 + Atom (B (False)) -> do !kl_if_6 <- kl_V4267 `pseq` kl_variableP kl_V4267 + case kl_if_6 of + Atom (B (True)) -> do kl_V4267 `pseq` kl_concat (Core.Types.Atom (Core.Types.UnboundSym "Parse_")) kl_V4267 + Atom (B (False)) -> do let pat_cond_7 kl_V4267 kl_V4267h kl_V4267t = do let !appl_8 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_shen_semantics kl_Z))) + appl_8 `pseq` (kl_V4267 `pseq` kl_map appl_8 kl_V4267) + pat_cond_9 = do do return kl_V4267 + in case kl_V4267 of + !(kl_V4267@(Cons (!kl_V4267h) + (!kl_V4267t))) -> pat_cond_7 kl_V4267 kl_V4267h kl_V4267t + _ -> pat_cond_9 + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + _ -> throwError "if: expected boolean" + +kl_shen_snd_or_fail :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_snd_or_fail (!kl_V4275) = do !kl_if_0 <- let pat_cond_1 kl_V4275 kl_V4275h kl_V4275t = do !kl_if_2 <- let pat_cond_3 kl_V4275t kl_V4275th kl_V4275tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V4275tt `pseq` eq appl_4 kl_V4275tt) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V4275t of + !(kl_V4275t@(Cons (!kl_V4275th) + (!kl_V4275tt))) -> pat_cond_3 kl_V4275t kl_V4275th kl_V4275tt + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V4275 of + !(kl_V4275@(Cons (!kl_V4275h) + (!kl_V4275t))) -> pat_cond_1 kl_V4275 kl_V4275h kl_V4275t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do !appl_8 <- kl_V4275 `pseq` tl kl_V4275 + appl_8 `pseq` hd appl_8 + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_fail :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_fail = do return (Core.Types.Atom (Core.Types.UnboundSym "shen.fail!")) + +kl_shen_pair :: Core.Types.KLValue -> + Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_pair (!kl_V4278) (!kl_V4279) = do let !appl_0 = Atom Nil + !appl_1 <- kl_V4279 `pseq` (appl_0 `pseq` klCons kl_V4279 appl_0) + kl_V4278 `pseq` (appl_1 `pseq` klCons kl_V4278 appl_1) + +kl_shen_hdtl :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_shen_hdtl (!kl_V4281) = do !appl_0 <- kl_V4281 `pseq` tl kl_V4281 + appl_0 `pseq` hd appl_0 + +kl_LBExclRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_LBExclRB (!kl_V4289) = do !kl_if_0 <- let pat_cond_1 kl_V4289 kl_V4289h kl_V4289t = do !kl_if_2 <- let pat_cond_3 kl_V4289t kl_V4289th kl_V4289tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V4289tt `pseq` eq appl_4 kl_V4289tt) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V4289t of + !(kl_V4289t@(Cons (!kl_V4289th) + (!kl_V4289tt))) -> pat_cond_3 kl_V4289t kl_V4289th kl_V4289tt + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V4289 of + !(kl_V4289@(Cons (!kl_V4289h) + (!kl_V4289t))) -> pat_cond_1 kl_V4289 kl_V4289h kl_V4289t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do let !appl_8 = Atom Nil + !appl_9 <- kl_V4289 `pseq` hd kl_V4289 + let !appl_10 = Atom Nil + !appl_11 <- appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) + appl_8 `pseq` (appl_11 `pseq` klCons appl_8 appl_11) + Atom (B (False)) -> do do kl_fail + _ -> throwError "if: expected boolean" + +kl_LBeRB :: Core.Types.KLValue -> + Core.Types.KLContext Core.Types.Env Core.Types.KLValue +kl_LBeRB (!kl_V4295) = do !kl_if_0 <- let pat_cond_1 kl_V4295 kl_V4295h kl_V4295t = do !kl_if_2 <- let pat_cond_3 kl_V4295t kl_V4295th kl_V4295tt = do let !appl_4 = Atom Nil + !kl_if_5 <- appl_4 `pseq` (kl_V4295tt `pseq` eq appl_4 kl_V4295tt) + case kl_if_5 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_6 = do do return (Atom (B False)) + in case kl_V4295t of + !(kl_V4295t@(Cons (!kl_V4295th) + (!kl_V4295tt))) -> pat_cond_3 kl_V4295t kl_V4295th kl_V4295tt + _ -> pat_cond_6 + case kl_if_2 of + Atom (B (True)) -> do return (Atom (B True)) + Atom (B (False)) -> do do return (Atom (B False)) + _ -> throwError "if: expected boolean" + pat_cond_7 = do do return (Atom (B False)) + in case kl_V4295 of + !(kl_V4295@(Cons (!kl_V4295h) + (!kl_V4295t))) -> pat_cond_1 kl_V4295 kl_V4295h kl_V4295t + _ -> pat_cond_7 + case kl_if_0 of + Atom (B (True)) -> do !appl_8 <- kl_V4295 `pseq` hd kl_V4295 + let !appl_9 = Atom Nil + let !appl_10 = Atom Nil + !appl_11 <- appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) + appl_8 `pseq` (appl_11 `pseq` klCons appl_8 appl_11) + Atom (B (False)) -> do do let !aw_12 = Core.Types.Atom (Core.Types.UnboundSym "shen.f_error") + applyWrapper aw_12 [ApplC (wrapNamed "" kl_LBeRB)] + _ -> throwError "if: expected boolean" + +expr4 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue +expr4 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E"))) diff --git a/Shentong/Bootstrap.hs b/Shentong/Bootstrap.hs --- a/Shentong/Bootstrap.hs +++ b/Shentong/Bootstrap.hs @@ -4,10 +4,10 @@ module Bootstrap where import Environment -import Primitives +import Core.Primitives import Backend.Utils -import Types -import Utils +import Core.Types +import Core.Utils import Wrap import Backend.FunctionTable import Backend.Toplevel diff --git a/Shentong/Core/Primitives.hs b/Shentong/Core/Primitives.hs new file mode 100644 --- /dev/null +++ b/Shentong/Core/Primitives.hs @@ -0,0 +1,444 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} + +module Core.Primitives where + +import Control.Applicative +import Control.Exception +import Control.Monad.Except +import Control.Monad.ST +import Control.Monad.Trans +import qualified Data.ByteString.Lazy as BL +import Data.Char hiding (isSymbol) +import Data.List +import Data.Monoid +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Data.Time.Clock.POSIX +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV +import System.CPUTime +import System.IO +import Core.Types +import Core.Utils + +{- +intern: maps a string containing a symbol to a symbol +intern : string --> symbol +-} +intern :: KLValue -> KLContext s KLValue +intern = internFn + where internFn (Atom (Str s)) = return (Atom (UnboundSym s)) + internFn _ = throwError "intern: requires a string argument." + +{- +pos: given a natural number 0...n and a string S returns the nth unit string in S +pos : string --> number --> string +-} +pos :: KLValue -> KLValue -> KLContext s KLValue +pos = posFn + where posFn (Atom (Str s)) (Atom (N (KI n))) = st s (fromIntegral n) + posFn _ _ = throwError "pos s n: s must be a string, n an integer" + st s n + | 0 <= n && n < T.length s = + return $ Atom . Str . T.singleton $ T.index s n + | otherwise = + throwError $ "pos s n: must have n < length s, n: " + <> (T.pack (show n)) <> ", s: " <> s + +{- +tlstr: returns all but the first unit string of a string +tlstr : string --> string +-} +tlstr :: KLValue -> KLContext s KLValue +tlstr = tlstrFn + where tlstrFn (Atom (Str s)) = return (Atom . Str $ T.tail s) + tlstrFn _ = throwError "tlstr: first parameter must be a string." + +{- +cn:concatenate two strings +cn : string --> string --> string +-} +cn :: KLValue -> KLValue -> KLContext s KLValue +cn = cnFn + where cnFn (Atom (Str s1)) (Atom (Str s2)) = return (Atom . Str $ s1 <> s2) + cnFn v1 v2 = throwError "cn: both parameters must be a string." + +{- +str: maps any atom to a string +str : Atom --> string +-} +str :: KLValue -> KLContext s KLValue +str = strFn + where strFn s@(Atom (Str _)) = return s + strFn (Atom (UnboundSym s)) = return (Atom (Str s)) + strFn (Atom (B b)) = return (Atom (Str bs)) + where bs | b = "true" + | otherwise = "false" + strFn (Atom (N n)) = return (Atom (Str s)) + where s = case n of + KI i -> T.pack $ show i + KD d -> T.pack $ show d + strFn (ApplC (Func name _)) = return $ (Atom (Str name)) + strFn (ApplC (PL name _)) = return $ (Atom (Str name)) + strFn v = throwError "str : first parameter must be an atom." + +{- +string?: test for strings +string? : Lit --> boolean +-} +stringP :: KLValue -> KLContext s KLValue +stringP = stringPFn + where stringPFn (Atom (Str _)) = return (Atom (B True)) + stringPFn _ = return (Atom (B False)) + +{- +n->string: maps a code point in decimal to the corresponding unit string +n->string : number --> string +-} +nToString :: KLValue -> KLContext s KLValue +nToString = nToStringFn + where nToStringFn (Atom (N (KI (fromIntegral -> n)))) + | 0 <= n && n <= 127 = return (Atom (Str . T.singleton $ chr n)) + | otherwise = throwError "n->string: needs an ASCII code point" + nToStringFn _ = throwError "n->string: needs an ASCII code point" + +{- +string->n: maps a unit string to the corresponding decimal +string->n : string --> number +-} +stringToN :: KLValue -> KLContext s KLValue +stringToN = stringToNFn + where stringToNFn (Atom (Str str)) = + return (Atom (N (KI . toInteger $ ord (T.head str)))) + stringToNFn v = throwError "string->n: first parameter must be an ASCII code point." + +{- +set: assigns a value to a symbol +-} +klSet :: KLValue -> KLValue -> KLContext Env KLValue +klSet = setFn + where setFn (Atom (UnboundSym sym)) klv = do + insertSymbol sym klv + return klv + setFn _ _ = throwError "set: first parameter must be a symbol" + +{- +value: retrieves the value of a symbol +-} +value :: KLValue -> KLContext Env KLValue +value = valueFn + where valueFn (Atom (UnboundSym sym)) = symbolRef sym + valueFn _ = throwError "value: first parameter must be a symbol." + +{- +simple-error: calls an throwError +simple-error : string --> throwError +-} +simpleError :: KLValue -> KLContext s KLValue +simpleError = simpleErrorFn + where simpleErrorFn (Atom (Str str)) = + throwError str + simpleErrorFn v1 = + throwError "simple-error: first parameter must be a string." + +{- +error-to-string: maps an throwError to a string +error-to-string : throwError --> string +-} +errorToString :: KLValue -> KLContext s KLValue +errorToString = errorToStringFn + where errorToStringFn (Excep e) = return (Atom (Str e)) + errorToStringFn _ = + throwError "error-to-string: first parameter must be an throwError." + +{- +cons: add an element to the front of a list +cons : A --> (list A) --> (list A) +-} +klCons :: KLValue -> KLValue -> KLContext s KLValue +klCons = consFn + where consFn v1 v2 = return (Cons v1 v2) + +{- +hd: take the head of a list +hd : (list A) --> A +-} +hd :: KLValue -> KLContext s KLValue +hd = hdFn + where hdFn (Cons v _) = return v + hdFn v = throwError "hd: first parameter must be a list." + +{- +tl: return the tail of a list +tl : (list A) --> (list A) +-} +tl :: KLValue -> KLContext s KLValue +tl = tlFn + where tlFn (Cons _ v) = return v + tlFn v = throwError "tl: first parameter must be a list." + +{- +cons?: test for non-empty list +cons? : A --> boolean +-} +consP :: KLValue -> KLContext s KLValue +consP = consPFn + where consPFn (Cons _ _) = return (Atom (B True)) + consPFn _ = return (Atom (B False)) + +eqCore :: KLValue -> KLValue -> Bool +eqCore (ApplC (Func n _)) (Atom (UnboundSym n')) = n == n' +eqCore (ApplC (Func n _)) (ApplC (Func n' _)) = n == n' +eqCore (ApplC (PL n _)) (ApplC (PL n' _)) = n == n' +eqCore (ApplC (PL n _)) (Atom (UnboundSym n')) = n == n' +eqCore (Atom (UnboundSym n')) (ApplC (Func n _)) = n == n' +eqCore (Atom (UnboundSym n')) (ApplC (PL n _)) = n == n' +eqCore (Atom (UnboundSym "true")) (Atom (B True)) = True +eqCore (Atom (UnboundSym "false")) (Atom (B False)) = True +eqCore (Atom (B True)) (Atom (UnboundSym "true")) = True +eqCore (Atom (B False)) (Atom (UnboundSym "false")) = True +eqCore (Atom a1) (Atom a2) = a1 == a2 +eqCore (Cons v1 v2) (Cons v3 v4) = eqCore v1 v3 && eqCore v2 v4 +eqCore (Vec v1) (Vec v2) = V.length v1 == V.length v2 && + V.foldl' (\acc (x,y) -> acc && eqCore x y) True (V.zip v1 v2) +eqCore _ _ = False + +{- +=: equality +A --> A --> boolean +-} +eq :: KLValue -> KLValue -> KLContext s KLValue +eq v1 v2 = return $ Atom (B (eqCore v1 v2)) + +{- +type: labels the type of an expression +(type X A) : A +-} +typeA :: KLValue -> KLValue -> KLContext s KLValue +typeA v _ = return v + +{- +absvector: a vector in the native platform, indexed from 0 to n inclusive +absvector : integer --> vector +-} +absvector :: KLValue -> KLContext s KLValue +absvector = absvectorFn + where absvectorFn (Atom (N (KI (fromIntegral -> n)))) + | n >= 0 = return (Vec $ V.replicate n (Atom (N (KI 0)))) -- 0 was Atom Nil + | otherwise = throwError "absvector n: must have n >= 0." + absvectorFn v = + throwError "absvector: first parameter must be a positive integer" + +{- +address->: destructively assign a value to a vector address +address-> : E -> integer -> vector -> vector +-} +addressTo :: KLValue -> KLValue -> KLValue -> KLContext s KLValue +addressTo = addressToFn + where addressToFn (Vec vec) (Atom (N (KI (fromIntegral -> n)))) val + | n >= 0 && n < V.length vec = return (Vec v') + | otherwise = + throwError "address-> n e v : n must be within range of v." + where v' = runST $ do + mv <- V.unsafeThaw vec + MV.unsafeWrite mv n val + V.unsafeFreeze mv + addressToFn _ _ _ = + throwError "address->: requires a vector, positive integer, and element" + {-# INLINE addressToFn #-} +{-# INLINE addressTo #-} + +{- +<-address: retrieve a value from a vector address +<-address: vector -> integer -> value +-} +addressFrom :: KLValue -> KLValue -> KLContext s KLValue +addressFrom = addressFromFn + where addressFromFn (Vec v) (Atom (N (KI (fromIntegral -> n)))) + | n >= 0 && n < V.length v = return ((V.!) v n) + | otherwise = throwError "address<- n v: n must be within range of v." + addressFromFn v n = + throwError "<-address: requires a positive integer and vector" + +{- +absvector? : Atom --> boolean +-} +absvectorP :: KLValue -> KLContext s KLValue +absvectorP = absvectorPFn + where absvectorPFn (Vec v) = return (Atom (B True)) + absvectorPFn _ = return (Atom (B False)) + +{- +write-byte: write an unsigned 8 bit byte to a stream +write-byte : number --> (stream out) --> number +-} +writeByte :: KLValue -> KLValue -> KLContext s KLValue +writeByte = writeByteFn + where writeByteFn num@(Atom (N (KI n))) (OutStream h) + | 0 <= n && n <= 255 = liftIO $ do + BL.hPut h (BL.singleton (fromInteger n)) + hFlush h + return num + | otherwise = throwError "write-byte n: must have 0 <= n <= 255." + writeByteFn v1 v2 = + throwError "write-byte: takes an integer and a (stream out)." + +{- +read-byte: read an unsigned 8 bit byte from a stream +read-byte : (stream in) --> number +-} +readByte :: KLValue -> KLContext s KLValue +readByte = readByteFn + where readByteFn (InStream stream) = do + byte <- liftIO $ BL.hGet stream 1 + if BL.null byte then + return (Atom (N (KI (-1)))) + else + return (Atom (N (KI (toInteger (BL.head byte))))) + readByteFn _ = throwError "read-byte: takes a (stream in)." + +{- +open: open a stream +open : path --> direction (D) --> stream D +-} +openStream :: KLValue -> KLValue -> KLContext Env KLValue +openStream = openStreamFn + where openStreamFn (Atom (Str path)) (Atom (UnboundSym "in")) = + symbolRef "*home-directory*" >>= dir path ReadMode . getPath + openStreamFn (Atom (Str path)) (Atom (UnboundSym "out")) = + symbolRef "*home-directory*" >>= dir path WriteMode . getPath + openStreamFn _ _ = throwError "open: requires filepath, in/out" + + getPath (Atom (Str p)) = p + getPath _ = "." + + toggleMode ReadMode = InStream + toggleMode WriteMode = OutStream + + tryToOpenFile path mode = try $ openBinaryFile (T.unpack path) mode + + dir path mode homeDir = do + h <- liftIO $ tryToOpenFile (homeDir <> path) mode + case h of + Left (err :: IOException) -> throwError (T.pack $ show err) + Right h -> return (toggleMode mode h) + +{- +close: close a stream +close : (stream D) --> (list B) +-} +closeStream :: KLValue -> KLContext s KLValue +closeStream = closeStreamFn + where closeStreamFn (OutStream h) = do + liftIO $ hClose h + return (Atom Nil) + closeStreamFn (InStream h) = do + liftIO $ hClose h + return (Atom Nil) + closeStreamFn _ = throwError "close: takes a (stream D) as input." + +{- +get-time: get the run/real time +get-time : symbol --> number +-} +getTime :: KLValue -> KLContext s KLValue +getTime = getTimeFn + where seconds t = fromInteger (round t) + picoseconds t = fromInteger t * 1e-12 + + getTimeFn (Atom (UnboundSym "unix")) = do + t <- liftIO getPOSIXTime + return (Atom (N (KI (seconds t)))) + getTimeFn (Atom (UnboundSym "run")) = do + t <- liftIO getCPUTime + return (Atom (N (KD (picoseconds t)))) + getTimeFn _ = + throwError "get-time: expects symbol 'real' or 'unix' as input." + +binopTemplate :: ErrorMsg -> (forall a. (Num a, Fractional a) => a -> a -> a) -> + KLValue -> KLValue -> KLContext s KLValue +binopTemplate _ fn (Atom (N n1)) (Atom (N n2)) = return $ Atom (N (n1 `fn` n2)) +binopTemplate e _ _ _ = throwError e + +{- ++: addition ++ : number --> number --> number +-} +add :: KLValue -> KLValue -> KLContext s KLValue +add = addFn + where addFn = binopTemplate "+: expects two numbers as input" (+) + +{- +-: subtraction +- : number --> number --> number +-} +subtract :: KLValue -> KLValue -> KLContext s KLValue +subtract = subtractFn + where subtractFn = binopTemplate "-: expects two numbers as input" (-) + +{- +*: subtraction +* : number --> number --> number +-} +multiply :: KLValue -> KLValue -> KLContext s KLValue +multiply = multiplyFn + where multiplyFn = binopTemplate "*: expects two numbers as input" (*) + +{- +/: division +/ : number --> number --> number +-} +divide :: KLValue -> KLValue -> KLContext s KLValue +divide = divideFn + where divideFn = binopTemplate "/: expects two numbers as input" (/) + +compareTemplate :: ErrorMsg -> (forall a. (Ord a) => a -> a -> Bool) -> + KLValue -> KLValue -> KLContext s KLValue +compareTemplate _ fn (Atom (N n1)) (Atom (N n2)) = return (Atom (B (n1 `fn` n2))) +compareTemplate errorMsg _ v1 v2 = throwError errorMsg + +{- +>: greater than +> : number --> number --> boolean +-} +greaterThan :: KLValue -> KLValue -> KLContext s KLValue +greaterThan = greaterThanFn + where greaterThanFn = compareTemplate ">: expects two numbers." (>) + +{- +<: less than +< : number --> number --> boolean +-} +lessThan :: KLValue -> KLValue -> KLContext s KLValue +lessThan = lessThanFn + where lessThanFn = compareTemplate "<: expects two numbers" (<) + +{- +>=: greater than or equal to +>= : number --> number --> boolean +-} +greaterThanOrEqualTo :: KLValue -> KLValue -> KLContext s KLValue +greaterThanOrEqualTo = greaterThanOrEqualToFn + where greaterThanOrEqualToFn = compareTemplate ">=: expects two numbers" (>=) + +{- +<=: less than or equal to +<= : number --> number --> boolean +-} +lessThanOrEqualTo :: KLValue -> KLValue -> KLContext s KLValue +lessThanOrEqualTo = lessThanOrEqualToFn + where lessThanOrEqualToFn = compareTemplate "<=: expects two numbers" (<=) + +{- +number? number test +A --> boolean +-} +numberP :: KLValue -> KLContext s KLValue +numberP = numberPFn + where numberPFn (Atom (N _)) = return (Atom (B True)) + numberPFn _ = return (Atom (B False)) diff --git a/Shentong/Core/Types.hs b/Shentong/Core/Types.hs new file mode 100644 --- /dev/null +++ b/Shentong/Core/Types.hs @@ -0,0 +1,176 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} + +module Core.Types where + +import Control.Applicative +import Control.Monad.Except +import Control.Monad.State +import Data.Data +import Data.Generics.Uniplate.Data +import Data.HashMap as HM +import Data.IORef +import qualified Data.Text as T +import Data.Vector as V hiding ((++)) +import System.IO + +type Symbol = T.Text +type ErrorMsg = T.Text +type ParamList = [Symbol] + +data SExpr = Lit !Atom + | Sym {-# UNPACK #-} !Symbol + | Freeze !SExpr + | Let !Symbol !SExpr !SExpr + | Lambda {-# UNPACK #-} !Symbol !SExpr + | If !SExpr !SExpr !SExpr + | And !SExpr !SExpr + | Or !SExpr !SExpr + | Cond ![(SExpr,SExpr)] + | Appl ![SExpr] + | TrapError !SExpr !SExpr + | EmptyList + deriving (Data, Show, Typeable) + +type DeBruijn = Int +type Bindings = [(DeBruijn, KLValue)] + +data RSExpr = RLit !Atom + | RDeBruijn {-# UNPACK #-} !DeBruijn + | RFreeze !RSExpr + | RLambda {-# UNPACK #-} !DeBruijn !RSExpr + | RIf !RSExpr !RSExpr !RSExpr + | RApplDir !(IORef ApplContext) ![RSExpr] + | RApplForm !RSExpr ![RSExpr] + | RTrapError !RSExpr !RSExpr + | REmptyList + +data KLNumber = KI !Integer + | KD {-# UNPACK #-} !Double + deriving (Data, Show, Typeable) + +instance Eq KLNumber where + (KI n1) == (KI n2) = n1 == n2 + (KI n1) == (KD n2) = realToFrac n1 == n2 + (KD n1) == (KI n2) = n1 == realToFrac n2 + (KD n1) == (KD n2) = n1 == n2 + +instance Ord KLNumber where + compare (KI n1) (KI n2) = compare n1 n2 + compare (KI n1) (KD n2) = compare (realToFrac n1) n2 + compare (KD n1) (KI n2) = compare n1 (realToFrac n2) + compare (KD n1) (KD n2) = compare n1 n2 + +instance Num KLNumber where + (KI n1) + (KI n2) = KI $ n1 + n2 + (KD n1) + (KD n2) = KD $ n1 + n2 + (KD n1) + (KI n2) = KD $ n1 + realToFrac n2 + (KI n1) + (KD n2) = KD $ realToFrac n1 + n2 + + (KI n1) * (KI n2) = KI $ n1 * n2 + (KD n1) * (KD n2) = KD $ n1 * n2 + (KD n1) * (KI n2) = KD $ n1 * realToFrac n2 + (KI n1) * (KD n2) = KD $ realToFrac n1 * n2 + + (KI n1) - (KI n2) = KI $ n1 - n2 + (KD n1) - (KD n2) = KD $ n1 - n2 + (KD n1) - (KI n2) = KD $ n1 - realToFrac n2 + (KI n1) - (KD n2) = KD $ realToFrac n1 - n2 + + abs (KI n) = KI $ abs n + abs (KD n) = KD $ abs n + + signum (KI n) = KI $ signum n + signum (KD n) = KD $ signum n + + fromInteger = KI + +instance Fractional KLNumber where + (KI n1) / (KI n2) = KD $ realToFrac n1 / realToFrac n2 + (KD n1) / (KD n2) = KD $ n1 / n2 + (KD n1) / (KI n2) = KD $ n1 / realToFrac n2 + (KI n1) / (KD n2) = KD $ realToFrac n1 / n2 + + fromRational r = KD $ fromRational r + +data Atom = UnboundSym {-# UNPACK #-} !Symbol + | B !Bool + | Nil + | N !KLNumber + | Str {-# UNPACK #-} !T.Text + deriving (Data, Eq, Show, Typeable) + +data TopLevel = Defun {-# UNPACK #-} !Symbol !ParamList !SExpr + | SE !SExpr + deriving Show + +data KLValue = Atom !Atom + | Cons !KLValue !KLValue + | Excep {-# UNPACK #-} !ErrorMsg + | ApplC !ApplContext + | InStream !Handle + | OutStream !Handle + | Vec {-# UNPACK #-} !(Vector KLValue) + deriving (Show) + +data ApplContext = Func Symbol Function + | PL Symbol (KLContext Env KLValue) + | Malformed ErrorMsg + +instance Show ApplContext where + show (Func name _) = "" + show (PL name _) = "" + show (Malformed e) = "" + +data Function = Context (KLValue -> KLContext Env KLValue) + | PartialApp (KLValue -> Function) + +data Env = Env { symbolTable :: Map Symbol KLValue + , functionTable :: Map Symbol (IORef ApplContext) } + +newtype KLContext s a = KLContext { + runKLC :: forall r. (a -> s -> IO r) + -> (ErrorMsg -> s -> IO r) + -> s + -> IO r + } + +instance Monad (KLContext s) where + (>>=) = klcBind + return = klcReturn + +klcBind :: KLContext s a -> (a -> KLContext s b) -> KLContext s b +klcBind m f = KLContext go + where go sk fk s = runKLC m (\a s' -> runKLC (f a) sk fk s') fk s + +klcReturn :: a -> KLContext s a +klcReturn a = KLContext go + where go sk _ s = sk a s + +instance Applicative (KLContext s) where + pure = return + (<*>) = ap + +instance Functor (KLContext s) where + fmap f (KLContext m) = KLContext (\sk fk s -> m (sk . f) fk s) + +instance MonadState s (KLContext s) where + get = KLContext (\sk _ s -> sk s s) + put s = KLContext (\sk _ _ -> sk () s) + +liftIO' m = KLContext $ \sk fk s -> do + x <- m + sk x s +{-# INLINE liftIO' #-} + +instance MonadIO (KLContext s) where + liftIO = liftIO' + +instance MonadError ErrorMsg (KLContext s) where + throwError e = KLContext (\_ fk s -> fk e s) + catchError m h = KLContext (\sk fk s -> runKLC m sk (h' sk fk) s) + where h' sk fk e s = let KLContext m = h e in m sk fk s diff --git a/Shentong/Core/Utils.hs b/Shentong/Core/Utils.hs new file mode 100644 --- /dev/null +++ b/Shentong/Core/Utils.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +module Core.Utils where + +import Control.Applicative +import Control.Monad.Except +import Control.Monad.State +import Data.HashMap as HM +import Data.IORef +import Data.Maybe +import Data.Monoid +import qualified Data.Vector as V +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Prelude as P +import Core.Types + +exceptionV :: ErrorMsg -> KLValue -> KLContext s a +exceptionV e v = throwError e' + where e' = e <> " " <> (T.pack $ show v) + +stubFunction :: Symbol -> KLContext s ApplContext +stubFunction name = return (Malformed msg) + where msg = "function " <> name <> " is not defined" + +functionRef :: Symbol -> KLContext Env (IORef ApplContext) +functionRef name = do + st <- get + case HM.lookup name (functionTable st) of + Just ref -> return ref + Nothing -> do + stubFunction name >>= insertFunction name + functionRef name + +symbolRef :: Symbol -> KLContext Env KLValue +symbolRef name = do + st <- get + case HM.lookup name (symbolTable st) of + Just v -> return v + Nothing -> throwError "name not found in symbol table." + +insertFunction :: Symbol -> ApplContext -> KLContext Env () +insertFunction name f = do + st <- get + case HM.lookup name (functionTable st) of + Just ref -> liftIO $ writeIORef ref $! f + Nothing -> do + ref <- liftIO $ newIORef $! f + put $ st { functionTable = HM.insert name ref (functionTable st) } + +insertSymbol :: Symbol -> KLValue -> KLContext Env () +insertSymbol name v = do + st <- get + put $ st { symbolTable = HM.insert name v (symbolTable st) } + +addVal :: Int -> Bindings -> KLValue -> Bindings +addVal i vals v = replace vals + where replace (p@(i',_) : is') + | i == i' = (i,v) : is' + | otherwise = p : replace is' + replace [] = [(i,v)] + +lookupVal :: DeBruijn -> Bindings -> KLContext Env KLValue +lookupVal i vals = maybe err return (P.lookup i vals) + where err = throwError "value not found in bindings list" + +fromIORef :: MonadIO m => IORef a -> m a +fromIORef = liftIO . readIORef + +{-# SPECIALISE fromIORef :: IORef ApplContext -> KLContext Env ApplContext #-} + +applyStep :: Function -> KLValue -> ApplContext +applyStep (PartialApp f) v = Func "curried" (f v) +applyStep (Context f) v = PL "thunk" (f v) + +mapM' :: Monad m => (a -> m b) -> [a] -> m [b] +mapM' _ [] = return [] +mapM' f (x:xs) = do + y <- f x + ys <- y `seq` mapM' f xs + return (y:ys) + +{-# SPECIALISE mapM' :: (RSExpr -> KLContext Env KLValue) -> [RSExpr] -> KLContext Env [KLValue] #-} + +checkForBooleans :: Atom -> KLValue +checkForBooleans (UnboundSym "true") = Atom (B True) +checkForBooleans (UnboundSym "false") = Atom (B False) +checkForBooleans a = Atom a + +apply :: ApplContext -> [KLValue] -> KLContext Env KLValue +apply (Malformed e) _ = throwError e +apply (PL _ c) [] = c +apply f [] = return (ApplC f) +apply (Func _ f) (v:vs) = apply (applyStep f v) vs +apply f _ + | Func name _ <- f = throwError $ name <> ": too many arguments" + | PL name _ <- f = throwError $ name <> ": too many arguments" + diff --git a/Shentong/Environment.hs b/Shentong/Environment.hs --- a/Shentong/Environment.hs +++ b/Shentong/Environment.hs @@ -10,10 +10,10 @@ import Data.Traversable hiding (mapM) import qualified Data.Vector as V import Interpreter.Interpreter -import Primitives +import Core.Primitives import System.IO -import Types -import Utils +import Core.Types +import Core.Utils import Wrap valueToTopLevel :: KLValue -> KLContext Env TopLevel @@ -105,7 +105,7 @@ ("close", wrap closeStream), ("get-time", wrap getTime), ("+", wrap add), - ("-", wrap Primitives.subtract), + ("-", wrap Core.Primitives.subtract), ("*", wrap multiply), ("/", wrap divide), (">", wrap greaterThan), diff --git a/Shentong/Interpreter/AST.hs b/Shentong/Interpreter/AST.hs --- a/Shentong/Interpreter/AST.hs +++ b/Shentong/Interpreter/AST.hs @@ -8,8 +8,8 @@ import Control.Monad.State import Data.Generics.Uniplate.Operations import Data.Traversable -import Types -import Utils +import Core.Types +import Core.Utils reduceSExpr :: ParamList -> SExpr -> KLContext Env RSExpr reduceSExpr args body = markBoundVars args (bakeFreeVars args body) diff --git a/Shentong/Interpreter/Interpreter.hs b/Shentong/Interpreter/Interpreter.hs --- a/Shentong/Interpreter/Interpreter.hs +++ b/Shentong/Interpreter/Interpreter.hs @@ -6,8 +6,8 @@ import Interpreter.AST import Control.Monad.Except import Data.IORef -import Types -import Utils +import Core.Types +import Core.Utils evalTopLevel :: TopLevel -> KLContext Env KLValue evalTopLevel (SE se) = reduceSExpr [] se >>= eval [] diff --git a/Shentong/Primitives.hs b/Shentong/Primitives.hs deleted file mode 100644 --- a/Shentong/Primitives.hs +++ /dev/null @@ -1,444 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} - -module Primitives where - -import Control.Applicative -import Control.Exception -import Control.Monad.Except -import Control.Monad.ST -import Control.Monad.Trans -import qualified Data.ByteString.Lazy as BL -import Data.Char hiding (isSymbol) -import Data.List -import Data.Monoid -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Data.Time.Clock.POSIX -import qualified Data.Vector as V -import qualified Data.Vector.Mutable as MV -import System.CPUTime -import System.IO -import Types -import Utils - -{- -intern: maps a string containing a symbol to a symbol -intern : string --> symbol --} -intern :: KLValue -> KLContext s KLValue -intern = internFn - where internFn (Atom (Str s)) = return (Atom (UnboundSym s)) - internFn _ = throwError "intern: requires a string argument." - -{- -pos: given a natural number 0...n and a string S returns the nth unit string in S -pos : string --> number --> string --} -pos :: KLValue -> KLValue -> KLContext s KLValue -pos = posFn - where posFn (Atom (Str s)) (Atom (N (KI n))) = st s (fromIntegral n) - posFn _ _ = throwError "pos s n: s must be a string, n an integer" - st s n - | 0 <= n && n < T.length s = - return $ Atom . Str . T.singleton $ T.index s n - | otherwise = - throwError $ "pos s n: must have n < length s, n: " - <> (T.pack (show n)) <> ", s: " <> s - -{- -tlstr: returns all but the first unit string of a string -tlstr : string --> string --} -tlstr :: KLValue -> KLContext s KLValue -tlstr = tlstrFn - where tlstrFn (Atom (Str s)) = return (Atom . Str $ T.tail s) - tlstrFn _ = throwError "tlstr: first parameter must be a string." - -{- -cn:concatenate two strings -cn : string --> string --> string --} -cn :: KLValue -> KLValue -> KLContext s KLValue -cn = cnFn - where cnFn (Atom (Str s1)) (Atom (Str s2)) = return (Atom . Str $ s1 <> s2) - cnFn v1 v2 = throwError "cn: both parameters must be a string." - -{- -str: maps any atom to a string -str : Atom --> string --} -str :: KLValue -> KLContext s KLValue -str = strFn - where strFn s@(Atom (Str _)) = return s - strFn (Atom (UnboundSym s)) = return (Atom (Str s)) - strFn (Atom (B b)) = return (Atom (Str bs)) - where bs | b = "true" - | otherwise = "false" - strFn (Atom (N n)) = return (Atom (Str s)) - where s = case n of - KI i -> T.pack $ show i - KD d -> T.pack $ show d - strFn (ApplC (Func name _)) = return $ (Atom (Str name)) - strFn (ApplC (PL name _)) = return $ (Atom (Str name)) - strFn v = throwError "str : first parameter must be an atom." - -{- -string?: test for strings -string? : Lit --> boolean --} -stringP :: KLValue -> KLContext s KLValue -stringP = stringPFn - where stringPFn (Atom (Str _)) = return (Atom (B True)) - stringPFn _ = return (Atom (B False)) - -{- -n->string: maps a code point in decimal to the corresponding unit string -n->string : number --> string --} -nToString :: KLValue -> KLContext s KLValue -nToString = nToStringFn - where nToStringFn (Atom (N (KI (fromIntegral -> n)))) - | 0 <= n && n <= 127 = return (Atom (Str . T.singleton $ chr n)) - | otherwise = throwError "n->string: needs an ASCII code point" - nToStringFn _ = throwError "n->string: needs an ASCII code point" - -{- -string->n: maps a unit string to the corresponding decimal -string->n : string --> number --} -stringToN :: KLValue -> KLContext s KLValue -stringToN = stringToNFn - where stringToNFn (Atom (Str str)) = - return (Atom (N (KI . toInteger $ ord (T.head str)))) - stringToNFn v = throwError "string->n: first parameter must be an ASCII code point." - -{- -set: assigns a value to a symbol --} -klSet :: KLValue -> KLValue -> KLContext Env KLValue -klSet = setFn - where setFn (Atom (UnboundSym sym)) klv = do - insertSymbol sym klv - return klv - setFn _ _ = throwError "set: first parameter must be a symbol" - -{- -value: retrieves the value of a symbol --} -value :: KLValue -> KLContext Env KLValue -value = valueFn - where valueFn (Atom (UnboundSym sym)) = symbolRef sym - valueFn _ = throwError "value: first parameter must be a symbol." - -{- -simple-error: calls an throwError -simple-error : string --> throwError --} -simpleError :: KLValue -> KLContext s KLValue -simpleError = simpleErrorFn - where simpleErrorFn (Atom (Str str)) = - throwError str - simpleErrorFn v1 = - throwError "simple-error: first parameter must be a string." - -{- -error-to-string: maps an throwError to a string -error-to-string : throwError --> string --} -errorToString :: KLValue -> KLContext s KLValue -errorToString = errorToStringFn - where errorToStringFn (Excep e) = return (Atom (Str e)) - errorToStringFn _ = - throwError "error-to-string: first parameter must be an throwError." - -{- -cons: add an element to the front of a list -cons : A --> (list A) --> (list A) --} -klCons :: KLValue -> KLValue -> KLContext s KLValue -klCons = consFn - where consFn v1 v2 = return (Cons v1 v2) - -{- -hd: take the head of a list -hd : (list A) --> A --} -hd :: KLValue -> KLContext s KLValue -hd = hdFn - where hdFn (Cons v _) = return v - hdFn v = throwError "hd: first parameter must be a list." - -{- -tl: return the tail of a list -tl : (list A) --> (list A) --} -tl :: KLValue -> KLContext s KLValue -tl = tlFn - where tlFn (Cons _ v) = return v - tlFn v = throwError "tl: first parameter must be a list." - -{- -cons?: test for non-empty list -cons? : A --> boolean --} -consP :: KLValue -> KLContext s KLValue -consP = consPFn - where consPFn (Cons _ _) = return (Atom (B True)) - consPFn _ = return (Atom (B False)) - -eqCore :: KLValue -> KLValue -> Bool -eqCore (ApplC (Func n _)) (Atom (UnboundSym n')) = n == n' -eqCore (ApplC (Func n _)) (ApplC (Func n' _)) = n == n' -eqCore (ApplC (PL n _)) (ApplC (PL n' _)) = n == n' -eqCore (ApplC (PL n _)) (Atom (UnboundSym n')) = n == n' -eqCore (Atom (UnboundSym n')) (ApplC (Func n _)) = n == n' -eqCore (Atom (UnboundSym n')) (ApplC (PL n _)) = n == n' -eqCore (Atom (UnboundSym "true")) (Atom (B True)) = True -eqCore (Atom (UnboundSym "false")) (Atom (B False)) = True -eqCore (Atom (B True)) (Atom (UnboundSym "true")) = True -eqCore (Atom (B False)) (Atom (UnboundSym "false")) = True -eqCore (Atom a1) (Atom a2) = a1 == a2 -eqCore (Cons v1 v2) (Cons v3 v4) = eqCore v1 v3 && eqCore v2 v4 -eqCore (Vec v1) (Vec v2) = V.length v1 == V.length v2 && - V.foldl' (\acc (x,y) -> acc && eqCore x y) True (V.zip v1 v2) -eqCore _ _ = False - -{- -=: equality -A --> A --> boolean --} -eq :: KLValue -> KLValue -> KLContext s KLValue -eq v1 v2 = return $ Atom (B (eqCore v1 v2)) - -{- -type: labels the type of an expression -(type X A) : A --} -typeA :: KLValue -> KLValue -> KLContext s KLValue -typeA v _ = return v - -{- -absvector: a vector in the native platform, indexed from 0 to n inclusive -absvector : integer --> vector --} -absvector :: KLValue -> KLContext s KLValue -absvector = absvectorFn - where absvectorFn (Atom (N (KI (fromIntegral -> n)))) - | n >= 0 = return (Vec $ V.replicate n (Atom (N (KI 0)))) -- 0 was Atom Nil - | otherwise = throwError "absvector n: must have n >= 0." - absvectorFn v = - throwError "absvector: first parameter must be a positive integer" - -{- -address->: destructively assign a value to a vector address -address-> : E -> integer -> vector -> vector --} -addressTo :: KLValue -> KLValue -> KLValue -> KLContext s KLValue -addressTo = addressToFn - where addressToFn (Vec vec) (Atom (N (KI (fromIntegral -> n)))) val - | n >= 0 && n < V.length vec = return (Vec v') - | otherwise = - throwError "address-> n e v : n must be within range of v." - where v' = runST $ do - mv <- V.unsafeThaw vec - MV.unsafeWrite mv n val - V.unsafeFreeze mv - addressToFn _ _ _ = - throwError "address->: requires a vector, positive integer, and element" - {-# INLINE addressToFn #-} -{-# INLINE addressTo #-} - -{- -<-address: retrieve a value from a vector address -<-address: vector -> integer -> value --} -addressFrom :: KLValue -> KLValue -> KLContext s KLValue -addressFrom = addressFromFn - where addressFromFn (Vec v) (Atom (N (KI (fromIntegral -> n)))) - | n >= 0 && n < V.length v = return ((V.!) v n) - | otherwise = throwError "address<- n v: n must be within range of v." - addressFromFn v n = - throwError "<-address: requires a positive integer and vector" - -{- -absvector? : Atom --> boolean --} -absvectorP :: KLValue -> KLContext s KLValue -absvectorP = absvectorPFn - where absvectorPFn (Vec v) = return (Atom (B True)) - absvectorPFn _ = return (Atom (B False)) - -{- -write-byte: write an unsigned 8 bit byte to a stream -write-byte : number --> (stream out) --> number --} -writeByte :: KLValue -> KLValue -> KLContext s KLValue -writeByte = writeByteFn - where writeByteFn num@(Atom (N (KI n))) (OutStream h) - | 0 <= n && n <= 255 = liftIO $ do - BL.hPut h (BL.singleton (fromInteger n)) - hFlush h - return num - | otherwise = throwError "write-byte n: must have 0 <= n <= 255." - writeByteFn v1 v2 = - throwError "write-byte: takes an integer and a (stream out)." - -{- -read-byte: read an unsigned 8 bit byte from a stream -read-byte : (stream in) --> number --} -readByte :: KLValue -> KLContext s KLValue -readByte = readByteFn - where readByteFn (InStream stream) = do - byte <- liftIO $ BL.hGet stream 1 - if BL.null byte then - return (Atom (N (KI (-1)))) - else - return (Atom (N (KI (toInteger (BL.head byte))))) - readByteFn _ = throwError "read-byte: takes a (stream in)." - -{- -open: open a stream -open : path --> direction (D) --> stream D --} -openStream :: KLValue -> KLValue -> KLContext Env KLValue -openStream = openStreamFn - where openStreamFn (Atom (Str path)) (Atom (UnboundSym "in")) = - symbolRef "*home-directory*" >>= dir path ReadMode . getPath - openStreamFn (Atom (Str path)) (Atom (UnboundSym "out")) = - symbolRef "*home-directory*" >>= dir path WriteMode . getPath - openStreamFn _ _ = throwError "open: requires filepath, in/out" - - getPath (Atom (Str p)) = p - getPath _ = "." - - toggleMode ReadMode = InStream - toggleMode WriteMode = OutStream - - tryToOpenFile path mode = try $ openBinaryFile (T.unpack path) mode - - dir path mode homeDir = do - h <- liftIO $ tryToOpenFile (homeDir <> path) mode - case h of - Left (err :: IOException) -> throwError (T.pack $ show err) - Right h -> return (toggleMode mode h) - -{- -close: close a stream -close : (stream D) --> (list B) --} -closeStream :: KLValue -> KLContext s KLValue -closeStream = closeStreamFn - where closeStreamFn (OutStream h) = do - liftIO $ hClose h - return (Atom Nil) - closeStreamFn (InStream h) = do - liftIO $ hClose h - return (Atom Nil) - closeStreamFn _ = throwError "close: takes a (stream D) as input." - -{- -get-time: get the run/real time -get-time : symbol --> number --} -getTime :: KLValue -> KLContext s KLValue -getTime = getTimeFn - where seconds t = fromInteger (round t) - picoseconds t = fromInteger t * 1e-12 - - getTimeFn (Atom (UnboundSym "unix")) = do - t <- liftIO getPOSIXTime - return (Atom (N (KI (seconds t)))) - getTimeFn (Atom (UnboundSym "run")) = do - t <- liftIO getCPUTime - return (Atom (N (KD (picoseconds t)))) - getTimeFn _ = - throwError "get-time: expects symbol 'real' or 'unix' as input." - -binopTemplate :: ErrorMsg -> (forall a. (Num a, Fractional a) => a -> a -> a) -> - KLValue -> KLValue -> KLContext s KLValue -binopTemplate _ fn (Atom (N n1)) (Atom (N n2)) = return $ Atom (N (n1 `fn` n2)) -binopTemplate e _ _ _ = throwError e - -{- -+: addition -+ : number --> number --> number --} -add :: KLValue -> KLValue -> KLContext s KLValue -add = addFn - where addFn = binopTemplate "+: expects two numbers as input" (+) - -{- --: subtraction -- : number --> number --> number --} -subtract :: KLValue -> KLValue -> KLContext s KLValue -subtract = subtractFn - where subtractFn = binopTemplate "-: expects two numbers as input" (-) - -{- -*: subtraction -* : number --> number --> number --} -multiply :: KLValue -> KLValue -> KLContext s KLValue -multiply = multiplyFn - where multiplyFn = binopTemplate "*: expects two numbers as input" (*) - -{- -/: division -/ : number --> number --> number --} -divide :: KLValue -> KLValue -> KLContext s KLValue -divide = divideFn - where divideFn = binopTemplate "/: expects two numbers as input" (/) - -compareTemplate :: ErrorMsg -> (forall a. (Ord a) => a -> a -> Bool) -> - KLValue -> KLValue -> KLContext s KLValue -compareTemplate _ fn (Atom (N n1)) (Atom (N n2)) = return (Atom (B (n1 `fn` n2))) -compareTemplate errorMsg _ v1 v2 = throwError errorMsg - -{- ->: greater than -> : number --> number --> boolean --} -greaterThan :: KLValue -> KLValue -> KLContext s KLValue -greaterThan = greaterThanFn - where greaterThanFn = compareTemplate ">: expects two numbers." (>) - -{- -<: less than -< : number --> number --> boolean --} -lessThan :: KLValue -> KLValue -> KLContext s KLValue -lessThan = lessThanFn - where lessThanFn = compareTemplate "<: expects two numbers" (<) - -{- ->=: greater than or equal to ->= : number --> number --> boolean --} -greaterThanOrEqualTo :: KLValue -> KLValue -> KLContext s KLValue -greaterThanOrEqualTo = greaterThanOrEqualToFn - where greaterThanOrEqualToFn = compareTemplate ">=: expects two numbers" (>=) - -{- -<=: less than or equal to -<= : number --> number --> boolean --} -lessThanOrEqualTo :: KLValue -> KLValue -> KLContext s KLValue -lessThanOrEqualTo = lessThanOrEqualToFn - where lessThanOrEqualToFn = compareTemplate "<=: expects two numbers" (<=) - -{- -number? number test -A --> boolean --} -numberP :: KLValue -> KLContext s KLValue -numberP = numberPFn - where numberPFn (Atom (N _)) = return (Atom (B True)) - numberPFn _ = return (Atom (B False)) diff --git a/Shentong/Shen.hs b/Shentong/Shen.hs --- a/Shentong/Shen.hs +++ b/Shentong/Shen.hs @@ -1,6 +1,6 @@ import Bootstrap import Environment -import Types +import Core.Types main :: IO () main = do diff --git a/Shentong/Types.hs b/Shentong/Types.hs deleted file mode 100644 --- a/Shentong/Types.hs +++ /dev/null @@ -1,176 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Rank2Types #-} - -module Types where - -import Control.Applicative -import Control.Monad.Except -import Control.Monad.State -import Data.Data -import Data.Generics.Uniplate.Data -import Data.HashMap as HM -import Data.IORef -import qualified Data.Text as T -import Data.Vector as V hiding ((++)) -import System.IO - -type Symbol = T.Text -type ErrorMsg = T.Text -type ParamList = [Symbol] - -data SExpr = Lit !Atom - | Sym {-# UNPACK #-} !Symbol - | Freeze !SExpr - | Let !Symbol !SExpr !SExpr - | Lambda {-# UNPACK #-} !Symbol !SExpr - | If !SExpr !SExpr !SExpr - | And !SExpr !SExpr - | Or !SExpr !SExpr - | Cond ![(SExpr,SExpr)] - | Appl ![SExpr] - | TrapError !SExpr !SExpr - | EmptyList - deriving (Data, Show, Typeable) - -type DeBruijn = Int -type Bindings = [(DeBruijn, KLValue)] - -data RSExpr = RLit !Atom - | RDeBruijn {-# UNPACK #-} !DeBruijn - | RFreeze !RSExpr - | RLambda {-# UNPACK #-} !DeBruijn !RSExpr - | RIf !RSExpr !RSExpr !RSExpr - | RApplDir !(IORef ApplContext) ![RSExpr] - | RApplForm !RSExpr ![RSExpr] - | RTrapError !RSExpr !RSExpr - | REmptyList - -data KLNumber = KI !Integer - | KD {-# UNPACK #-} !Double - deriving (Data, Show, Typeable) - -instance Eq KLNumber where - (KI n1) == (KI n2) = n1 == n2 - (KI n1) == (KD n2) = realToFrac n1 == n2 - (KD n1) == (KI n2) = n1 == realToFrac n2 - (KD n1) == (KD n2) = n1 == n2 - -instance Ord KLNumber where - compare (KI n1) (KI n2) = compare n1 n2 - compare (KI n1) (KD n2) = compare (realToFrac n1) n2 - compare (KD n1) (KI n2) = compare n1 (realToFrac n2) - compare (KD n1) (KD n2) = compare n1 n2 - -instance Num KLNumber where - (KI n1) + (KI n2) = KI $ n1 + n2 - (KD n1) + (KD n2) = KD $ n1 + n2 - (KD n1) + (KI n2) = KD $ n1 + realToFrac n2 - (KI n1) + (KD n2) = KD $ realToFrac n1 + n2 - - (KI n1) * (KI n2) = KI $ n1 * n2 - (KD n1) * (KD n2) = KD $ n1 * n2 - (KD n1) * (KI n2) = KD $ n1 * realToFrac n2 - (KI n1) * (KD n2) = KD $ realToFrac n1 * n2 - - (KI n1) - (KI n2) = KI $ n1 - n2 - (KD n1) - (KD n2) = KD $ n1 - n2 - (KD n1) - (KI n2) = KD $ n1 - realToFrac n2 - (KI n1) - (KD n2) = KD $ realToFrac n1 - n2 - - abs (KI n) = KI $ abs n - abs (KD n) = KD $ abs n - - signum (KI n) = KI $ signum n - signum (KD n) = KD $ signum n - - fromInteger = KI - -instance Fractional KLNumber where - (KI n1) / (KI n2) = KD $ realToFrac n1 / realToFrac n2 - (KD n1) / (KD n2) = KD $ n1 / n2 - (KD n1) / (KI n2) = KD $ n1 / realToFrac n2 - (KI n1) / (KD n2) = KD $ realToFrac n1 / n2 - - fromRational r = KD $ fromRational r - -data Atom = UnboundSym {-# UNPACK #-} !Symbol - | B !Bool - | Nil - | N !KLNumber - | Str {-# UNPACK #-} !T.Text - deriving (Data, Eq, Show, Typeable) - -data TopLevel = Defun {-# UNPACK #-} !Symbol !ParamList !SExpr - | SE !SExpr - deriving Show - -data KLValue = Atom !Atom - | Cons !KLValue !KLValue - | Excep {-# UNPACK #-} !ErrorMsg - | ApplC !ApplContext - | InStream !Handle - | OutStream !Handle - | Vec {-# UNPACK #-} !(Vector KLValue) - deriving (Show) - -data ApplContext = Func Symbol Function - | PL Symbol (KLContext Env KLValue) - | Malformed ErrorMsg - -instance Show ApplContext where - show (Func name _) = "" - show (PL name _) = "" - show (Malformed e) = "" - -data Function = Context (KLValue -> KLContext Env KLValue) - | PartialApp (KLValue -> Function) - -data Env = Env { symbolTable :: Map Symbol KLValue - , functionTable :: Map Symbol (IORef ApplContext) } - -newtype KLContext s a = KLContext { - runKLC :: forall r. (a -> s -> IO r) - -> (ErrorMsg -> s -> IO r) - -> s - -> IO r - } - -instance Monad (KLContext s) where - (>>=) = klcBind - return = klcReturn - -klcBind :: KLContext s a -> (a -> KLContext s b) -> KLContext s b -klcBind m f = KLContext go - where go sk fk s = runKLC m (\a s' -> runKLC (f a) sk fk s') fk s - -klcReturn :: a -> KLContext s a -klcReturn a = KLContext go - where go sk _ s = sk a s - -instance Applicative (KLContext s) where - pure = return - (<*>) = ap - -instance Functor (KLContext s) where - fmap f (KLContext m) = KLContext (\sk fk s -> m (sk . f) fk s) - -instance MonadState s (KLContext s) where - get = KLContext (\sk _ s -> sk s s) - put s = KLContext (\sk _ _ -> sk () s) - -liftIO' m = KLContext $ \sk fk s -> do - x <- m - sk x s -{-# INLINE liftIO' #-} - -instance MonadIO (KLContext s) where - liftIO = liftIO' - -instance MonadError ErrorMsg (KLContext s) where - throwError e = KLContext (\_ fk s -> fk e s) - catchError m h = KLContext (\sk fk s -> runKLC m sk (h' sk fk) s) - where h' sk fk e s = let KLContext m = h e in m sk fk s diff --git a/Shentong/Utils.hs b/Shentong/Utils.hs deleted file mode 100644 --- a/Shentong/Utils.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} - -module Utils where - -import Control.Applicative -import Control.Monad.Except -import Control.Monad.State -import Data.HashMap as HM -import Data.IORef -import Data.Maybe -import Data.Monoid -import qualified Data.Vector as V -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Prelude as P -import Types - -exceptionV :: ErrorMsg -> KLValue -> KLContext s a -exceptionV e v = throwError e' - where e' = e <> " " <> (T.pack $ show v) - -stubFunction :: Symbol -> KLContext s ApplContext -stubFunction name = return (Malformed msg) - where msg = "function " <> name <> " is not defined" - -functionRef :: Symbol -> KLContext Env (IORef ApplContext) -functionRef name = do - st <- get - case HM.lookup name (functionTable st) of - Just ref -> return ref - Nothing -> do - stubFunction name >>= insertFunction name - functionRef name - -symbolRef :: Symbol -> KLContext Env KLValue -symbolRef name = do - st <- get - case HM.lookup name (symbolTable st) of - Just v -> return v - Nothing -> throwError "name not found in symbol table." - -insertFunction :: Symbol -> ApplContext -> KLContext Env () -insertFunction name f = do - st <- get - case HM.lookup name (functionTable st) of - Just ref -> liftIO $ writeIORef ref $! f - Nothing -> do - ref <- liftIO $ newIORef $! f - put $ st { functionTable = HM.insert name ref (functionTable st) } - -insertSymbol :: Symbol -> KLValue -> KLContext Env () -insertSymbol name v = do - st <- get - put $ st { symbolTable = HM.insert name v (symbolTable st) } - -addVal :: Int -> Bindings -> KLValue -> Bindings -addVal i vals v = replace vals - where replace (p@(i',_) : is') - | i == i' = (i,v) : is' - | otherwise = p : replace is' - replace [] = [(i,v)] - -lookupVal :: DeBruijn -> Bindings -> KLContext Env KLValue -lookupVal i vals = maybe err return (P.lookup i vals) - where err = throwError "value not found in bindings list" - -fromIORef :: MonadIO m => IORef a -> m a -fromIORef = liftIO . readIORef - -{-# SPECIALISE fromIORef :: IORef ApplContext -> KLContext Env ApplContext #-} - -applyStep :: Function -> KLValue -> ApplContext -applyStep (PartialApp f) v = Func "curried" (f v) -applyStep (Context f) v = PL "thunk" (f v) - -mapM' :: Monad m => (a -> m b) -> [a] -> m [b] -mapM' _ [] = return [] -mapM' f (x:xs) = do - y <- f x - ys <- y `seq` mapM' f xs - return (y:ys) - -{-# SPECIALISE mapM' :: (RSExpr -> KLContext Env KLValue) -> [RSExpr] -> KLContext Env [KLValue] #-} - -checkForBooleans :: Atom -> KLValue -checkForBooleans (UnboundSym "true") = Atom (B True) -checkForBooleans (UnboundSym "false") = Atom (B False) -checkForBooleans a = Atom a - -apply :: ApplContext -> [KLValue] -> KLContext Env KLValue -apply (Malformed e) _ = throwError e -apply (PL _ c) [] = c -apply f [] = return (ApplC f) -apply (Func _ f) (v:vs) = apply (applyStep f v) vs -apply f _ - | Func name _ <- f = throwError $ name <> ": too many arguments" - | PL name _ <- f = throwError $ name <> ": too many arguments" - diff --git a/Shentong/Wrap.hs b/Shentong/Wrap.hs --- a/Shentong/Wrap.hs +++ b/Shentong/Wrap.hs @@ -4,7 +4,7 @@ module Wrap where -import Types +import Core.Types class Wrappable a where wrap :: a -> Function diff --git a/shentong.cabal b/shentong.cabal --- a/shentong.cabal +++ b/shentong.cabal @@ -1,5 +1,5 @@ name: shentong -version: 0.3.1 +version: 0.3.2 author: Mark Thom license: BSD3 license-file: LICENSE @@ -34,8 +34,13 @@ -fno-warn-name-shadowing -fno-full-laziness hs-source-dirs: Shentong - other-modules: Bootstrap, Environment, Primitives, Types, Utils, Wrap, Interpreter.Interpreter, - Interpreter.AST, Backend.Core, Backend.Declarations, Backend.FunctionTable, - Backend.Load, Backend.LoadShen, Backend.Macros, Backend.PortInfo, Backend.Prolog, - Backend.Reader, Backend.Sequent, Backend.Sys, Backend.TStar, Backend.Toplevel, - Backend.Track, Backend.Types, Backend.Utils, Backend.Writer, Backend.Yacc + other-modules: Bootstrap, Environment, Core.Primitives, + Core.Types, Core.Utils, Wrap, + Interpreter.Interpreter, Interpreter.AST, + Backend.Core, Backend.Declarations, + Backend.FunctionTable, Backend.Load, + Backend.LoadShen, Backend.Macros, Backend.PortInfo, + Backend.Prolog, Backend.Reader, Backend.Sequent, + Backend.Sys, Backend.TStar, Backend.Toplevel, + Backend.Track, Backend.Types, Backend.Utils, + Backend.Writer, Backend.Yacc