{-# 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")))