shentong (empty) → 0.3.1
raw patch · 30 files changed
+18491/−0 lines, 30 filesdep +basedep +bytestringdep +hashmapsetup-changed
Dependencies added: base, bytestring, hashmap, mtl, parallel, text, time, uniplate, unordered-containers, vector
Files
- LICENSE +24/−0
- Setup.hs +2/−0
- Shentong/Backend/Core.hs +4004/−0
- Shentong/Backend/Declarations.hs +866/−0
- Shentong/Backend/FunctionTable.hs +674/−0
- Shentong/Backend/Load.hs +235/−0
- Shentong/Backend/LoadShen.hs +61/−0
- Shentong/Backend/Macros.hs +941/−0
- Shentong/Backend/PortInfo.hs +66/−0
- Shentong/Backend/Prolog.hs too large to diff
- Shentong/Backend/Reader.hs +2799/−0
- Shentong/Backend/Sequent.hs +1872/−0
- Shentong/Backend/Sys.hs +1572/−0
- Shentong/Backend/TStar.hs too large to diff
- Shentong/Backend/Toplevel.hs +1052/−0
- Shentong/Backend/Track.hs +443/−0
- Shentong/Backend/Types.hs +1088/−0
- Shentong/Backend/Utils.hs +21/−0
- Shentong/Backend/Writer.hs +814/−0
- Shentong/Backend/Yacc.hs +849/−0
- Shentong/Bootstrap.hs +46/−0
- Shentong/Environment.hs +124/−0
- Shentong/Interpreter/AST.hs +63/−0
- Shentong/Interpreter/Interpreter.hs +84/−0
- Shentong/Primitives.hs +444/−0
- Shentong/Shen.hs +11/−0
- Shentong/Types.hs +176/−0
- Shentong/Utils.hs +100/−0
- Shentong/Wrap.hs +19/−0
- shentong.cabal +41/−0
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2015, Mark Thom++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 Thom may not be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY Mark Thom ''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 Thom 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Shentong/Backend/Core.hs view
@@ -0,0 +1,4004 @@+{-# 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 "<e>") + !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 "<e>") + !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")))
+ Shentong/Backend/Declarations.hs view
@@ -0,0 +1,866 @@+{-# 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 "<e>" 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 "<e>" 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")))
+ Shentong/Backend/FunctionTable.hs view
@@ -0,0 +1,674 @@+{-# 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.<define>" (wrapNamed "shen.<define>" kl_shen_LBdefineRB) + insertFunction "shen.<name>" (wrapNamed "shen.<name>" kl_shen_LBnameRB) + insertFunction "shen.sysfunc?" (wrapNamed "shen.sysfunc?" kl_shen_sysfuncP) + insertFunction "shen.<signature>" (wrapNamed "shen.<signature>" kl_shen_LBsignatureRB) + insertFunction "shen.curry-type" (wrapNamed "shen.curry-type" kl_shen_curry_type) + insertFunction "shen.<signature-help>" (wrapNamed "shen.<signature-help>" kl_shen_LBsignature_helpRB) + insertFunction "shen.<rules>" (wrapNamed "shen.<rules>" kl_shen_LBrulesRB) + insertFunction "shen.<rule>" (wrapNamed "shen.<rule>" 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.<patterns>" (wrapNamed "shen.<patterns>" kl_shen_LBpatternsRB) + insertFunction "shen.<pattern>" (wrapNamed "shen.<pattern>" kl_shen_LBpatternRB) + insertFunction "shen.constructor-error" (wrapNamed "shen.constructor-error" kl_shen_constructor_error) + insertFunction "shen.<simple_pattern>" (wrapNamed "shen.<simple_pattern>" kl_shen_LBsimple_patternRB) + insertFunction "shen.<pattern1>" (wrapNamed "shen.<pattern1>" kl_shen_LBpattern1RB) + insertFunction "shen.<pattern2>" (wrapNamed "shen.<pattern2>" kl_shen_LBpattern2RB) + insertFunction "shen.<action>" (wrapNamed "shen.<action>" kl_shen_LBactionRB) + insertFunction "shen.<guard>" (wrapNamed "shen.<guard>" 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.<datatype-rules>" (wrapNamed "shen.<datatype-rules>" kl_shen_LBdatatype_rulesRB) + insertFunction "shen.<datatype-rule>" (wrapNamed "shen.<datatype-rule>" kl_shen_LBdatatype_ruleRB) + insertFunction "shen.<side-conditions>" (wrapNamed "shen.<side-conditions>" kl_shen_LBside_conditionsRB) + insertFunction "shen.<side-condition>" (wrapNamed "shen.<side-condition>" kl_shen_LBside_conditionRB) + insertFunction "shen.<variable?>" (wrapNamed "shen.<variable?>" kl_shen_LBvariablePRB) + insertFunction "shen.<expr>" (wrapNamed "shen.<expr>" kl_shen_LBexprRB) + insertFunction "shen.remove-bar" (wrapNamed "shen.remove-bar" kl_shen_remove_bar) + insertFunction "shen.<premises>" (wrapNamed "shen.<premises>" kl_shen_LBpremisesRB) + insertFunction "shen.<semicolon-symbol>" (wrapNamed "shen.<semicolon-symbol>" kl_shen_LBsemicolon_symbolRB) + insertFunction "shen.<premise>" (wrapNamed "shen.<premise>" kl_shen_LBpremiseRB) + insertFunction "shen.<conclusion>" (wrapNamed "shen.<conclusion>" kl_shen_LBconclusionRB) + insertFunction "shen.sequent" (wrapNamed "shen.sequent" kl_shen_sequent) + insertFunction "shen.<formulae>" (wrapNamed "shen.<formulae>" kl_shen_LBformulaeRB) + insertFunction "shen.<comma-symbol>" (wrapNamed "shen.<comma-symbol>" kl_shen_LBcomma_symbolRB) + insertFunction "shen.<formula>" (wrapNamed "shen.<formula>" kl_shen_LBformulaRB) + insertFunction "shen.<type>" (wrapNamed "shen.<type>" kl_shen_LBtypeRB) + insertFunction "shen.<doubleunderline>" (wrapNamed "shen.<doubleunderline>" kl_shen_LBdoubleunderlineRB) + insertFunction "shen.<singleunderline>" (wrapNamed "shen.<singleunderline>" 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 "<e>" (wrapNamed "<e>" 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.<st_input>" (wrapNamed "shen.<st_input>" kl_shen_LBst_inputRB) + insertFunction "shen.<lsb>" (wrapNamed "shen.<lsb>" kl_shen_LBlsbRB) + insertFunction "shen.<rsb>" (wrapNamed "shen.<rsb>" kl_shen_LBrsbRB) + insertFunction "shen.<lcurly>" (wrapNamed "shen.<lcurly>" kl_shen_LBlcurlyRB) + insertFunction "shen.<rcurly>" (wrapNamed "shen.<rcurly>" kl_shen_LBrcurlyRB) + insertFunction "shen.<bar>" (wrapNamed "shen.<bar>" kl_shen_LBbarRB) + insertFunction "shen.<semicolon>" (wrapNamed "shen.<semicolon>" kl_shen_LBsemicolonRB) + insertFunction "shen.<colon>" (wrapNamed "shen.<colon>" kl_shen_LBcolonRB) + insertFunction "shen.<comma>" (wrapNamed "shen.<comma>" kl_shen_LBcommaRB) + insertFunction "shen.<equal>" (wrapNamed "shen.<equal>" kl_shen_LBequalRB) + insertFunction "shen.<minus>" (wrapNamed "shen.<minus>" kl_shen_LBminusRB) + insertFunction "shen.<lrb>" (wrapNamed "shen.<lrb>" kl_shen_LBlrbRB) + insertFunction "shen.<rrb>" (wrapNamed "shen.<rrb>" kl_shen_LBrrbRB) + insertFunction "shen.<atom>" (wrapNamed "shen.<atom>" 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.<sym>" (wrapNamed "shen.<sym>" kl_shen_LBsymRB) + insertFunction "shen.<alphanums>" (wrapNamed "shen.<alphanums>" kl_shen_LBalphanumsRB) + insertFunction "shen.<alphanum>" (wrapNamed "shen.<alphanum>" kl_shen_LBalphanumRB) + insertFunction "shen.<num>" (wrapNamed "shen.<num>" kl_shen_LBnumRB) + insertFunction "shen.numbyte?" (wrapNamed "shen.numbyte?" kl_shen_numbyteP) + insertFunction "shen.<alpha>" (wrapNamed "shen.<alpha>" kl_shen_LBalphaRB) + insertFunction "shen.symbol-code?" (wrapNamed "shen.symbol-code?" kl_shen_symbol_codeP) + insertFunction "shen.<str>" (wrapNamed "shen.<str>" kl_shen_LBstrRB) + insertFunction "shen.<dbq>" (wrapNamed "shen.<dbq>" kl_shen_LBdbqRB) + insertFunction "shen.<strcontents>" (wrapNamed "shen.<strcontents>" kl_shen_LBstrcontentsRB) + insertFunction "shen.<byte>" (wrapNamed "shen.<byte>" kl_shen_LBbyteRB) + insertFunction "shen.<strc>" (wrapNamed "shen.<strc>" kl_shen_LBstrcRB) + insertFunction "shen.<number>" (wrapNamed "shen.<number>" kl_shen_LBnumberRB) + insertFunction "shen.<E>" (wrapNamed "shen.<E>" kl_shen_LBERB) + insertFunction "shen.<log10>" (wrapNamed "shen.<log10>" kl_shen_LBlog10RB) + insertFunction "shen.<plus>" (wrapNamed "shen.<plus>" kl_shen_LBplusRB) + insertFunction "shen.<stop>" (wrapNamed "shen.<stop>" kl_shen_LBstopRB) + insertFunction "shen.<predigits>" (wrapNamed "shen.<predigits>" kl_shen_LBpredigitsRB) + insertFunction "shen.<postdigits>" (wrapNamed "shen.<postdigits>" kl_shen_LBpostdigitsRB) + insertFunction "shen.<digits>" (wrapNamed "shen.<digits>" kl_shen_LBdigitsRB) + insertFunction "shen.<digit>" (wrapNamed "shen.<digit>" 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.<st_input1>" (wrapNamed "shen.<st_input1>" kl_shen_LBst_input1RB) + insertFunction "shen.<st_input2>" (wrapNamed "shen.<st_input2>" kl_shen_LBst_input2RB) + insertFunction "shen.<comment>" (wrapNamed "shen.<comment>" kl_shen_LBcommentRB) + insertFunction "shen.<singleline>" (wrapNamed "shen.<singleline>" kl_shen_LBsinglelineRB) + insertFunction "shen.<backslash>" (wrapNamed "shen.<backslash>" kl_shen_LBbackslashRB) + insertFunction "shen.<anysingle>" (wrapNamed "shen.<anysingle>" kl_shen_LBanysingleRB) + insertFunction "shen.<non-return>" (wrapNamed "shen.<non-return>" kl_shen_LBnon_returnRB) + insertFunction "shen.<return>" (wrapNamed "shen.<return>" kl_shen_LBreturnRB) + insertFunction "shen.<multiline>" (wrapNamed "shen.<multiline>" kl_shen_LBmultilineRB) + insertFunction "shen.<times>" (wrapNamed "shen.<times>" kl_shen_LBtimesRB) + insertFunction "shen.<anymulti>" (wrapNamed "shen.<anymulti>" kl_shen_LBanymultiRB) + insertFunction "shen.<whitespaces>" (wrapNamed "shen.<whitespaces>" kl_shen_LBwhitespacesRB) + insertFunction "shen.<whitespace>" (wrapNamed "shen.<whitespace>" 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.<defprolog>" (wrapNamed "shen.<defprolog>" 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.<predicate*>" (wrapNamed "shen.<predicate*>" kl_shen_LBpredicateMultRB) + insertFunction "shen.<clauses*>" (wrapNamed "shen.<clauses*>" kl_shen_LBclausesMultRB) + insertFunction "shen.<clause*>" (wrapNamed "shen.<clause*>" kl_shen_LBclauseMultRB) + insertFunction "shen.<head*>" (wrapNamed "shen.<head*>" kl_shen_LBheadMultRB) + insertFunction "shen.<term*>" (wrapNamed "shen.<term*>" 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.<body*>" (wrapNamed "shen.<body*>" kl_shen_LBbodyMultRB) + insertFunction "shen.<literal*>" (wrapNamed "shen.<literal*>" kl_shen_LBliteralMultRB) + insertFunction "shen.<end*>" (wrapNamed "shen.<end*>" 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.<sig+rest>" (wrapNamed "shen.<sig+rest>" 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.<sig+rules>" (wrapNamed "shen.<sig+rules>" kl_shen_LBsigPlusrulesRB) + insertFunction "shen.<non-ll-rules>" (wrapNamed "shen.<non-ll-rules>" 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)
+ Shentong/Backend/Load.hs view
@@ -0,0 +1,235 @@+{-# 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")))
+ Shentong/Backend/LoadShen.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.LoadShen 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 + +{- +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. +-} + +expr15 :: Types.KLContext Types.Env Types.KLValue +expr15 = do (do kl_shen_shen) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E")))
+ Shentong/Backend/Macros.hs view
@@ -0,0 +1,941 @@+{-# 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.<datatype-rules>" 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")))
+ Shentong/Backend/PortInfo.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} + +module Backend.PortInfo 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 + +{- +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. +-} + +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"))) + (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 "*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")))
+ Shentong/Backend/Prolog.hs view
file too large to diff
+ Shentong/Backend/Reader.hs view
@@ -0,0 +1,2799 @@+{-# 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")))
+ Shentong/Backend/Sequent.hs view
@@ -0,0 +1,1872 @@+{-# 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 "<e>") + !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 "<e>") + !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 "<e>") + !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 "<e>") + !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")))
+ Shentong/Backend/Sys.hs view
@@ -0,0 +1,1572 @@+{-# 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")))
+ Shentong/Backend/TStar.hs view
file too large to diff
+ Shentong/Backend/Toplevel.hs view
@@ -0,0 +1,1052 @@+{-# 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.<st_input>") + 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.<st_input>") + 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")))
+ Shentong/Backend/Track.hs view
@@ -0,0 +1,443 @@+{-# 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")))
+ Shentong/Backend/Types.hs view
@@ -0,0 +1,1088 @@+{-# 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 "<e>" 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")))
+ Shentong/Backend/Utils.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE StrictData #-} + +module Backend.Utils where + +import Control.Monad.Except +import Control.Parallel +import qualified Data.Text as T +import Data.Monoid +import Primitives +import Types +import Utils + +applyWrapper :: KLValue -> [KLValue] -> KLContext Env KLValue +applyWrapper (ApplC ac) vs = ac `pseq` vs `pseq` foldr pseq (apply ac vs) vs +applyWrapper (Atom (UnboundSym fname)) vs = do + ac <- fromIORef =<< functionRef fname + ac `pseq` vs `pseq` foldr pseq (apply ac vs) vs +applyWrapper v _ = throwError $ "applyWrapper: expected fn in leading value, received" <> (T.pack $ show v)
+ Shentong/Backend/Writer.hs view
@@ -0,0 +1,814 @@+{-# 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")))
+ Shentong/Backend/Yacc.hs view
@@ -0,0 +1,849 @@+{-# 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 "<e>" 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")))
+ Shentong/Bootstrap.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++module Bootstrap where++import Environment+import Primitives+import Backend.Utils+import Types+import Utils+import Wrap+import Backend.FunctionTable+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++bootstrap = do functions+ expr0+ expr1+ expr2+ expr3+ expr4+ expr5+ expr6+ expr7+ expr8+ expr9+ expr10+ expr11+ expr12+ expr13+ expr14+ expr15
+ Shentong/Environment.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++module Environment ( initEnv, evalKL ) where++import Control.Applicative+import Control.Monad.Except+import qualified Data.HashMap as HM+import Data.IORef+import Data.Traversable hiding (mapM)+import qualified Data.Vector as V+import Interpreter.Interpreter+import Primitives+import System.IO+import Types+import Utils+import Wrap++valueToTopLevel :: KLValue -> KLContext Env TopLevel+valueToTopLevel (Cons (Atom (UnboundSym "defun"))+ (Cons (Atom (UnboundSym name))+ (Cons args (Cons e (Atom Nil))))) =+ Defun name <$> toParamList args <*> valueToSExpr e+ where toParamList (Cons (Atom (UnboundSym a)) as) = (a :) <$> toParamList as+ toParamList (Atom Nil) = pure []+ toParamList _ = throwError "defun form contains invalid lambda list"+valueToTopLevel se = SE <$> valueToSExpr se++valueToSExpr :: KLValue -> KLContext Env SExpr+valueToSExpr (ApplC (PL name _)) = return (Sym name)+valueToSExpr (ApplC (Func name _)) = return (Sym name)+valueToSExpr (Atom (UnboundSym sym)) = return (Sym sym)+valueToSExpr (Atom Nil) = return EmptyList+valueToSExpr (Atom a) = return (Lit a)+valueToSExpr (Cons v vs) = applToSExpr v (consToList vs)+ where consToList (Cons v vs) = v : consToList vs+ consToList (Atom Nil) = []+ consToList v = [v]+valueToSExpr (Vec v)+ | V.null v = pure emptyVec+ | otherwise = vecToSExprList (V.tail v)+ where emptyVec = Appl [Lit (UnboundSym "vector"), Lit (N (KI 0))]+ + vecToSExprList vec + | V.null vec = pure emptyVec+ | otherwise = do+ se <- valueToSExpr (V.head vec)+ ss <- vecToSExprList (V.tail vec)+ return (Appl [Lit (UnboundSym "@v"), se , ss])+valueToSExpr v = throwError "cannot evaluate list containing non-literal values"++applToSExpr :: KLValue -> [KLValue] -> KLContext Env SExpr+applToSExpr (Atom (UnboundSym "cond")) l = Cond <$> listOfConds l+ where listOfConds (Cons cond (Cons clause (Atom Nil)) : cs) =+ (:) <$> ((,) <$> valueToSExpr cond <*> valueToSExpr clause)+ <*> listOfConds cs+ listOfConds [] = pure []+ listOfConds _ = throwError "improperly formed cond clause list"+applToSExpr (Atom (UnboundSym "if")) [c,t,f] =+ If <$> valueToSExpr c <*> valueToSExpr t <*> valueToSExpr f+applToSExpr (Atom (UnboundSym "let")) [Atom (UnboundSym s),b,e] =+ Let s <$> valueToSExpr b <*> valueToSExpr e+applToSExpr (Atom (UnboundSym "lambda")) [Atom (UnboundSym s), e] =+ Lambda s <$> valueToSExpr e+applToSExpr (Atom (UnboundSym "and")) [c1,c2] =+ And <$> valueToSExpr c1 <*> valueToSExpr c2+applToSExpr (Atom (UnboundSym "or")) [c1,c2] =+ Or <$> valueToSExpr c1 <*> valueToSExpr c2+applToSExpr (Atom (UnboundSym "freeze")) [e] =+ Freeze <$> valueToSExpr e+applToSExpr (Atom (UnboundSym "trap-error")) [e, h] =+ TrapError <$> valueToSExpr e <*> valueToSExpr h+applToSExpr l ls =+ Appl <$> liftA2 (:) (valueToSExpr l) (traverse valueToSExpr ls)++evalKL :: KLValue -> KLContext Env KLValue+evalKL = valueToTopLevel >=> evalTopLevel++primitives :: [(Symbol, Function)]+primitives = [("intern", wrap intern),+ ("pos", wrap pos),+ ("tlstr", wrap tlstr),+ ("cn", wrap cn),+ ("str", wrap str),+ ("string?", wrap stringP),+ ("n->string", wrap nToString),+ ("string->n", wrap stringToN),+ ("set", wrap klSet),+ ("value", wrap value),+ ("simple-error", wrap simpleError),+ ("error-to-string", wrap errorToString),+ ("cons", wrap klCons),+ ("hd", wrap hd),+ ("tl", wrap tl),+ ("cons?", wrap consP),+ ("=", wrap eq),+ ("type", wrap typeA),+ ("absvector", wrap absvector),+ ("address->", wrap addressTo),+ ("<-address", wrap addressFrom),+ ("absvector?", wrap absvectorP),+ ("write-byte", wrap writeByte),+ ("read-byte", wrap readByte),+ ("open", wrap openStream),+ ("close", wrap closeStream),+ ("get-time", wrap getTime),+ ("+", wrap add),+ ("-", wrap Primitives.subtract),+ ("*", wrap multiply),+ ("/", wrap divide),+ (">", wrap greaterThan),+ ("<", wrap lessThan),+ (">=", wrap greaterThanOrEqualTo),+ ("<=", wrap lessThanOrEqualTo), + ("number?", wrap numberP),+ ("eval-kl", wrap evalKL)]++initEnv :: (Applicative m, MonadIO m) => m Env+initEnv = Env initSymbolTable <$> HM.fromList <$> mapM update primitives+ where update (n, f) = (n,) <$> liftIO (newIORef $! Func n f)++initSymbolTable :: HM.Map Symbol KLValue+initSymbolTable = HM.fromList [("*stoutput*", OutStream stdout),+ ("*stinput*", InStream stdin)]
+ Shentong/Interpreter/AST.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++module Interpreter.AST ( reduceSExpr, bakeFreeVars ) where++import Control.Applicative+import Control.Monad.Except+import Control.Monad.State+import Data.Generics.Uniplate.Operations+import Data.Traversable+import Types+import Utils++reduceSExpr :: ParamList -> SExpr -> KLContext Env RSExpr+reduceSExpr args body = markBoundVars args (bakeFreeVars args body)++markBoundVars :: ParamList -> SExpr -> KLContext Env RSExpr+markBoundVars args = bake (length args) (zip args [0..])+ where klTrue = Lit (B True)+ klFalse = Lit (B False)++ bake n args (Sym s)+ | Just i <- lookup s args = pure (RDeBruijn i)+ | otherwise = throwError "found bound symbol, should be a literal"+ bake n args (Lambda s e)+ | Just i <- lookup s args = RLambda i <$> bake n args e+ | otherwise = RLambda n <$> bake (n+1) ((s,n):args) e+ bake n args (Let v b e) = bake n args (Appl [Lambda v e, b])+ bake n args (Lit a) = pure (RLit a)+ bake n args (Freeze e) = RFreeze <$> bake n args e+ bake n args (TrapError e tr) =+ RTrapError <$> bake n args e <*> bake n args tr+ bake n args (If c t f) =+ RIf <$> bake n args c <*> bake n args t <*> bake n args f+ bake n args (And c1 c2) =+ bake n args (If c1 (If c2 klTrue klFalse) klFalse)+ bake n args (Or c1 c2) =+ bake n args (If c1 klTrue (If c2 klTrue klFalse))+ bake n args (Cond ((c,e):cs)) = bake n args (If c e (Cond cs))+ bake n args (Cond []) = pure REmptyList+ bake n args (Appl [Lit (UnboundSym "read-byte")]) =+ bake n args (Appl [Lit (UnboundSym "read-byte"),+ Appl [Lit (UnboundSym "stinput")]])+ bake n args (Appl [Lit (UnboundSym "write-byte"), b]) =+ bake n args (Appl [Lit (UnboundSym "write-byte"), b,+ Appl [Lit (UnboundSym "stoutput")]])+ bake n args (Appl (Lit (UnboundSym a):as)) =+ RApplDir <$> functionRef a <*> traverse (bake n args) as+ bake n args (Appl (a:as)) =+ RApplForm <$> bake n args a <*> traverse (bake n args) as+ bake n args (Appl []) = bake n args EmptyList+ bake n args EmptyList = pure REmptyList+ +bakeFreeVars :: ParamList -> SExpr -> SExpr+bakeFreeVars = bake'+ where bake' args (Lambda sym expr) =+ Lambda sym (bake' (sym:args) expr)+ bake' args (Let sym bind expr) =+ bake' args (Appl [Lambda sym expr, bind])+ bake' args (Sym sym)+ | sym `elem` args = Sym sym+ | otherwise = Lit (UnboundSym sym)+ bake' args expr = descend (bake' args) expr
+ Shentong/Interpreter/Interpreter.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Interpreter.Interpreter ( evalTopLevel ) where++import Interpreter.AST+import Control.Monad.Except+import Data.IORef+import Types+import Utils++evalTopLevel :: TopLevel -> KLContext Env KLValue+evalTopLevel (SE se) = reduceSExpr [] se >>= eval []+evalTopLevel (Defun name args body) = evalDefun name args body++evalDefun :: Symbol -> ParamList -> SExpr -> KLContext Env KLValue+evalDefun name args body = do+ body' <- reduceSExpr args body+ let f = topLevelContext name (length args) body'+ insertFunction name f + return (Atom (UnboundSym name))++topLevelContext :: Symbol -> Int -> RSExpr -> ApplContext+topLevelContext name 0 e = PL name (eval [] e)+topLevelContext name n e = Func name (buildContext n [])+ where buildContext 1 vals = Context (\x -> eval ((n-1,x):vals) e)+ buildContext m vals = PartialApp fn+ where fn x = buildContext (m-1) ((n-m,x):vals)++eval :: Bindings -> RSExpr -> KLContext Env KLValue+eval vals (RDeBruijn db) = lookupVal db vals+eval vals (RFreeze e) = evalFreeze vals e+eval vals (RTrapError e tr) = evalTrapError vals e tr+eval vals (RLambda i e) = evalLambda vals i e+eval vals (RIf c t f) = evalIf vals c t f+eval vals (RApplDir f as) = evalApplDir vals f as+eval vals (RApplForm a as) = evalApplForm vals a as+eval vals (RLit a) = return (checkForBooleans a)+eval vals REmptyList = return (Atom Nil)++evalTrapError :: Bindings -> RSExpr -> RSExpr -> KLContext Env KLValue+evalTrapError vals e tr = eval vals e `catchError` handleError+ where handleError e =+ eval vals tr >>= \case+ ApplC (Func name f) -> apply (Func name f) [Excep e]+ Atom (UnboundSym n) -> do+ f <- fromIORef =<< functionRef n+ apply f [Excep e] + _ -> throwError "exception handler must be a function"+ +evalFreeze :: Bindings -> RSExpr -> KLContext Env KLValue+evalFreeze vals e = return (ApplC (PL ": thunk" (eval vals e)))++evalLambda :: Monad m => Bindings -> DeBruijn -> RSExpr -> m KLValue+evalLambda vals i = return . ApplC . Func ": lambda" . evalLambda' vals i+ where evalLambda' vals i e+ | RLambda i' e' <- e = PartialApp (contLambda i' e')+ | otherwise = Context termLambda+ where termLambda x = eval (addVal i vals x) e+ contLambda i' e' x = evalLambda' (addVal i vals x) i' e'++evalApplDir' :: Bindings -> ApplContext -> [RSExpr] -> KLContext Env KLValue+evalApplDir' vals ac args = mapM' (eval vals) args >>= apply ac++evalApplDir :: Bindings -> IORef ApplContext -> [RSExpr] -> KLContext Env KLValue+evalApplDir vals ref args = do+ ac <- fromIORef ref+ mapM' (eval vals) args >>= apply ac++evalApplForm :: Bindings -> RSExpr -> [RSExpr] -> KLContext Env KLValue+evalApplForm vals (RLit (UnboundSym name)) args =+ functionRef name >>= \ac -> evalApplDir vals ac args +evalApplForm vals form args =+ eval vals form >>= \case+ ApplC ac -> evalApplDir' vals ac args+ Atom (UnboundSym n) -> evalApplForm vals (RLit (UnboundSym n)) args+ v -> exceptionV "(form . args): form evaluates to" v++evalIf :: Bindings -> RSExpr -> RSExpr -> RSExpr -> KLContext Env KLValue+evalIf vals c t f =+ eval vals c >>= \case+ Atom (B True) -> eval vals t+ Atom (B False) -> eval vals f+ _ -> throwError "(if c t f): c must evaluate to boolean"
+ Shentong/Primitives.hs view
@@ -0,0 +1,444 @@+{-# 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))
+ Shentong/Shen.hs view
@@ -0,0 +1,11 @@+import Bootstrap+import Environment+import Types++main :: IO ()+main = do+ env <- initEnv+ runKLC bootstrap+ (\_ _ -> return ())+ (\_ _ -> return ())+ env
+ Shentong/Types.hs view
@@ -0,0 +1,176 @@+{-# 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 _) = "<function " ++ T.unpack name ++ ">"+ show (PL name _) = "<function " ++ T.unpack name ++ ">"+ show (Malformed e) = "<function, malformed, message : " ++ T.unpack 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
+ Shentong/Utils.hs view
@@ -0,0 +1,100 @@+{-# 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"+
+ Shentong/Wrap.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++module Wrap where++import Types++class Wrappable a where+ wrap :: a -> Function++instance Wrappable (KLValue -> a) => Wrappable (KLValue -> KLValue -> a) where+ wrap f = PartialApp (wrap . f)+ +instance s ~ Env => Wrappable (KLValue -> KLContext s KLValue) where+ wrap = Context++wrapNamed :: Wrappable a => Symbol -> a -> ApplContext+wrapNamed name fn = Func name (wrap fn)
+ shentong.cabal view
@@ -0,0 +1,41 @@+name: shentong+version: 0.3.1+author: Mark Thom+license: BSD3+license-file: LICENSE+maintainer: markjordanthom@gmail.com+category: Language+build-type: Simple+cabal-version: >= 1.20+synopsis: A Haskell implementation of the Shen programming language+description: The Shen programming language is a Lisp that offers pattern matching, lambda calculus consistency, macros, optional lazy evaluation, static type checking, one of the most powerful systems for typing in functional programming, portability over many languages, an integrated fully functional Prolog, and an inbuilt compiler-compiler. Shentong is an implementation of Shen written in Haskell.+source-repository head+ type: git+ location: https://github.com/mthom/shentong++executable shen+ main-is:+ Shen.hs+ build-depends:+ base == 4.*+ , bytestring+ , hashmap+ , mtl >= 2.2.1+ , parallel >= 3.2.0.4+ , text+ , time+ , uniplate+ , unordered-containers+ , vector+ default-language:+ Haskell2010+ ghc-options:+ -O2+ -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