{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Strict #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE ViewPatterns #-} module Backend.Macros where import Control.Monad.Except import Control.Parallel import Environment import Core.Primitives as Primitives import Backend.Utils import Core.Types import Core.Utils import Wrap import Backend.Toplevel import Backend.Core import Backend.Sys import Backend.Sequent import Backend.Yacc import Backend.Reader import Backend.Prolog import Backend.Track import Backend.Load import Backend.Writer {- Copyright (c) 2015, Mark Tarver All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of Mark Tarver may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} kl_macroexpand :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_macroexpand (!kl_V1529) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do !kl_if_1 <- kl_V1529 `pseq` (kl_Y `pseq` eq kl_V1529 kl_Y) case kl_if_1 of Atom (B (True)) -> do return kl_V1529 Atom (B (False)) -> do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Z) -> do kl_Z `pseq` kl_macroexpand kl_Z))) appl_2 `pseq` (kl_Y `pseq` kl_shen_walk appl_2 kl_Y) _ -> throwError "if: expected boolean"))) !appl_3 <- value (Core.Types.Atom (Core.Types.UnboundSym "*macros*")) !appl_4 <- appl_3 `pseq` (kl_V1529 `pseq` kl_shen_compose appl_3 kl_V1529) appl_4 `pseq` applyWrapper appl_0 [appl_4] kl_shen_error_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_error_macro (!kl_V1531) = do let pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt = do !appl_1 <- kl_V1531th `pseq` (kl_V1531tt `pseq` kl_shen_mkstr kl_V1531th kl_V1531tt) let !appl_2 = Atom Nil !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) appl_3 `pseq` klCons (ApplC (wrapNamed "simple-error" simpleError)) appl_3 pat_cond_4 = do do return kl_V1531 in case kl_V1531 of !(kl_V1531@(Cons (Atom (UnboundSym "error")) (!(kl_V1531t@(Cons (!kl_V1531th) (!kl_V1531tt)))))) -> pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt !(kl_V1531@(Cons (ApplC (PL "error" _)) (!(kl_V1531t@(Cons (!kl_V1531th) (!kl_V1531tt)))))) -> pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt !(kl_V1531@(Cons (ApplC (Func "error" _)) (!(kl_V1531t@(Cons (!kl_V1531th) (!kl_V1531tt)))))) -> pat_cond_0 kl_V1531 kl_V1531t kl_V1531th kl_V1531tt _ -> pat_cond_4 kl_shen_output_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_output_macro (!kl_V1533) = do let pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt = do !appl_1 <- kl_V1533th `pseq` (kl_V1533tt `pseq` kl_shen_mkstr kl_V1533th kl_V1533tt) let !appl_2 = Atom Nil !appl_3 <- appl_2 `pseq` klCons (ApplC (PL "stoutput" kl_stoutput)) appl_2 let !appl_4 = Atom Nil !appl_5 <- appl_3 `pseq` (appl_4 `pseq` klCons appl_3 appl_4) !appl_6 <- appl_1 `pseq` (appl_5 `pseq` klCons appl_1 appl_5) appl_6 `pseq` klCons (ApplC (wrapNamed "shen.prhush" kl_shen_prhush)) appl_6 pat_cond_7 = do !kl_if_8 <- let pat_cond_9 kl_V1533 kl_V1533h kl_V1533t = do !kl_if_10 <- let pat_cond_11 = do !kl_if_12 <- let pat_cond_13 kl_V1533t kl_V1533th kl_V1533tt = do let !appl_14 = Atom Nil !kl_if_15 <- appl_14 `pseq` (kl_V1533tt `pseq` eq appl_14 kl_V1533tt) case kl_if_15 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_16 = do do return (Atom (B False)) in case kl_V1533t of !(kl_V1533t@(Cons (!kl_V1533th) (!kl_V1533tt))) -> pat_cond_13 kl_V1533t kl_V1533th kl_V1533tt _ -> pat_cond_16 case kl_if_12 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_17 = do do return (Atom (B False)) in case kl_V1533h of kl_V1533h@(Atom (UnboundSym "pr")) -> pat_cond_11 kl_V1533h@(ApplC (PL "pr" _)) -> pat_cond_11 kl_V1533h@(ApplC (Func "pr" _)) -> pat_cond_11 _ -> pat_cond_17 case kl_if_10 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_18 = do do return (Atom (B False)) in case kl_V1533 of !(kl_V1533@(Cons (!kl_V1533h) (!kl_V1533t))) -> pat_cond_9 kl_V1533 kl_V1533h kl_V1533t _ -> pat_cond_18 case kl_if_8 of Atom (B (True)) -> do !appl_19 <- kl_V1533 `pseq` tl kl_V1533 !appl_20 <- appl_19 `pseq` hd appl_19 let !appl_21 = Atom Nil !appl_22 <- appl_21 `pseq` klCons (ApplC (PL "stoutput" kl_stoutput)) appl_21 let !appl_23 = Atom Nil !appl_24 <- appl_22 `pseq` (appl_23 `pseq` klCons appl_22 appl_23) !appl_25 <- appl_20 `pseq` (appl_24 `pseq` klCons appl_20 appl_24) appl_25 `pseq` klCons (ApplC (wrapNamed "pr" kl_pr)) appl_25 Atom (B (False)) -> do do return kl_V1533 _ -> throwError "if: expected boolean" in case kl_V1533 of !(kl_V1533@(Cons (Atom (UnboundSym "output")) (!(kl_V1533t@(Cons (!kl_V1533th) (!kl_V1533tt)))))) -> pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt !(kl_V1533@(Cons (ApplC (PL "output" _)) (!(kl_V1533t@(Cons (!kl_V1533th) (!kl_V1533tt)))))) -> pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt !(kl_V1533@(Cons (ApplC (Func "output" _)) (!(kl_V1533t@(Cons (!kl_V1533th) (!kl_V1533tt)))))) -> pat_cond_0 kl_V1533 kl_V1533t kl_V1533th kl_V1533tt _ -> pat_cond_7 kl_shen_make_string_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_make_string_macro (!kl_V1535) = do let pat_cond_0 kl_V1535 kl_V1535t kl_V1535th kl_V1535tt = do kl_V1535th `pseq` (kl_V1535tt `pseq` kl_shen_mkstr kl_V1535th kl_V1535tt) pat_cond_1 = do do return kl_V1535 in case kl_V1535 of !(kl_V1535@(Cons (Atom (UnboundSym "make-string")) (!(kl_V1535t@(Cons (!kl_V1535th) (!kl_V1535tt)))))) -> pat_cond_0 kl_V1535 kl_V1535t kl_V1535th kl_V1535tt !(kl_V1535@(Cons (ApplC (PL "make-string" _)) (!(kl_V1535t@(Cons (!kl_V1535th) (!kl_V1535tt)))))) -> pat_cond_0 kl_V1535 kl_V1535t kl_V1535th kl_V1535tt !(kl_V1535@(Cons (ApplC (Func "make-string" _)) (!(kl_V1535t@(Cons (!kl_V1535th) (!kl_V1535tt)))))) -> pat_cond_0 kl_V1535 kl_V1535t kl_V1535th kl_V1535tt _ -> pat_cond_1 kl_shen_input_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_input_macro (!kl_V1537) = do !kl_if_0 <- let pat_cond_1 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_2 <- let pat_cond_3 = do let !appl_4 = Atom Nil !kl_if_5 <- appl_4 `pseq` (kl_V1537t `pseq` eq appl_4 kl_V1537t) case kl_if_5 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_6 = do do return (Atom (B False)) in case kl_V1537h of kl_V1537h@(Atom (UnboundSym "lineread")) -> pat_cond_3 kl_V1537h@(ApplC (PL "lineread" _)) -> pat_cond_3 kl_V1537h@(ApplC (Func "lineread" _)) -> pat_cond_3 _ -> pat_cond_6 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_7 = do do return (Atom (B False)) in case kl_V1537 of !(kl_V1537@(Cons (!kl_V1537h) (!kl_V1537t))) -> pat_cond_1 kl_V1537 kl_V1537h kl_V1537t _ -> pat_cond_7 case kl_if_0 of Atom (B (True)) -> do let !appl_8 = Atom Nil !appl_9 <- appl_8 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_8 let !appl_10 = Atom Nil !appl_11 <- appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) appl_11 `pseq` klCons (ApplC (wrapNamed "lineread" kl_lineread)) appl_11 Atom (B (False)) -> do !kl_if_12 <- let pat_cond_13 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_14 <- let pat_cond_15 = do let !appl_16 = Atom Nil !kl_if_17 <- appl_16 `pseq` (kl_V1537t `pseq` eq appl_16 kl_V1537t) case kl_if_17 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_18 = do do return (Atom (B False)) in case kl_V1537h of kl_V1537h@(Atom (UnboundSym "input")) -> pat_cond_15 kl_V1537h@(ApplC (PL "input" _)) -> pat_cond_15 kl_V1537h@(ApplC (Func "input" _)) -> pat_cond_15 _ -> pat_cond_18 case kl_if_14 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_19 = do do return (Atom (B False)) in case kl_V1537 of !(kl_V1537@(Cons (!kl_V1537h) (!kl_V1537t))) -> pat_cond_13 kl_V1537 kl_V1537h kl_V1537t _ -> pat_cond_19 case kl_if_12 of Atom (B (True)) -> do let !appl_20 = Atom Nil !appl_21 <- appl_20 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_20 let !appl_22 = Atom Nil !appl_23 <- appl_21 `pseq` (appl_22 `pseq` klCons appl_21 appl_22) appl_23 `pseq` klCons (ApplC (wrapNamed "input" kl_input)) appl_23 Atom (B (False)) -> do !kl_if_24 <- let pat_cond_25 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_26 <- let pat_cond_27 = do let !appl_28 = Atom Nil !kl_if_29 <- appl_28 `pseq` (kl_V1537t `pseq` eq appl_28 kl_V1537t) case kl_if_29 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_30 = do do return (Atom (B False)) in case kl_V1537h of kl_V1537h@(Atom (UnboundSym "read")) -> pat_cond_27 kl_V1537h@(ApplC (PL "read" _)) -> pat_cond_27 kl_V1537h@(ApplC (Func "read" _)) -> pat_cond_27 _ -> pat_cond_30 case kl_if_26 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_31 = do do return (Atom (B False)) in case kl_V1537 of !(kl_V1537@(Cons (!kl_V1537h) (!kl_V1537t))) -> pat_cond_25 kl_V1537 kl_V1537h kl_V1537t _ -> pat_cond_31 case kl_if_24 of Atom (B (True)) -> do let !appl_32 = Atom Nil !appl_33 <- appl_32 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_32 let !appl_34 = Atom Nil !appl_35 <- appl_33 `pseq` (appl_34 `pseq` klCons appl_33 appl_34) appl_35 `pseq` klCons (ApplC (wrapNamed "read" kl_read)) appl_35 Atom (B (False)) -> do !kl_if_36 <- let pat_cond_37 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_38 <- let pat_cond_39 = do !kl_if_40 <- let pat_cond_41 kl_V1537t kl_V1537th kl_V1537tt = do let !appl_42 = Atom Nil !kl_if_43 <- appl_42 `pseq` (kl_V1537tt `pseq` eq appl_42 kl_V1537tt) case kl_if_43 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_44 = do do return (Atom (B False)) in case kl_V1537t of !(kl_V1537t@(Cons (!kl_V1537th) (!kl_V1537tt))) -> pat_cond_41 kl_V1537t kl_V1537th kl_V1537tt _ -> pat_cond_44 case kl_if_40 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_45 = do do return (Atom (B False)) in case kl_V1537h of kl_V1537h@(Atom (UnboundSym "input+")) -> pat_cond_39 kl_V1537h@(ApplC (PL "input+" _)) -> pat_cond_39 kl_V1537h@(ApplC (Func "input+" _)) -> pat_cond_39 _ -> pat_cond_45 case kl_if_38 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_46 = do do return (Atom (B False)) in case kl_V1537 of !(kl_V1537@(Cons (!kl_V1537h) (!kl_V1537t))) -> pat_cond_37 kl_V1537 kl_V1537h kl_V1537t _ -> pat_cond_46 case kl_if_36 of Atom (B (True)) -> do !appl_47 <- kl_V1537 `pseq` tl kl_V1537 !appl_48 <- appl_47 `pseq` hd appl_47 let !appl_49 = Atom Nil !appl_50 <- appl_49 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_49 let !appl_51 = Atom Nil !appl_52 <- appl_50 `pseq` (appl_51 `pseq` klCons appl_50 appl_51) !appl_53 <- appl_48 `pseq` (appl_52 `pseq` klCons appl_48 appl_52) appl_53 `pseq` klCons (ApplC (wrapNamed "input+" kl_inputPlus)) appl_53 Atom (B (False)) -> do !kl_if_54 <- let pat_cond_55 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_56 <- let pat_cond_57 = do let !appl_58 = Atom Nil !kl_if_59 <- appl_58 `pseq` (kl_V1537t `pseq` eq appl_58 kl_V1537t) case kl_if_59 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_60 = do do return (Atom (B False)) in case kl_V1537h of kl_V1537h@(Atom (UnboundSym "read-byte")) -> pat_cond_57 kl_V1537h@(ApplC (PL "read-byte" _)) -> pat_cond_57 kl_V1537h@(ApplC (Func "read-byte" _)) -> pat_cond_57 _ -> pat_cond_60 case kl_if_56 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_61 = do do return (Atom (B False)) in case kl_V1537 of !(kl_V1537@(Cons (!kl_V1537h) (!kl_V1537t))) -> pat_cond_55 kl_V1537 kl_V1537h kl_V1537t _ -> pat_cond_61 case kl_if_54 of Atom (B (True)) -> do let !appl_62 = Atom Nil !appl_63 <- appl_62 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_62 let !appl_64 = Atom Nil !appl_65 <- appl_63 `pseq` (appl_64 `pseq` klCons appl_63 appl_64) appl_65 `pseq` klCons (ApplC (wrapNamed "read-byte" readByte)) appl_65 Atom (B (False)) -> do !kl_if_66 <- let pat_cond_67 kl_V1537 kl_V1537h kl_V1537t = do !kl_if_68 <- let pat_cond_69 = do let !appl_70 = Atom Nil !kl_if_71 <- appl_70 `pseq` (kl_V1537t `pseq` eq appl_70 kl_V1537t) case kl_if_71 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_72 = do do return (Atom (B False)) in case kl_V1537h of kl_V1537h@(Atom (UnboundSym "read-char-code")) -> pat_cond_69 kl_V1537h@(ApplC (PL "read-char-code" _)) -> pat_cond_69 kl_V1537h@(ApplC (Func "read-char-code" _)) -> pat_cond_69 _ -> pat_cond_72 case kl_if_68 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_73 = do do return (Atom (B False)) in case kl_V1537 of !(kl_V1537@(Cons (!kl_V1537h) (!kl_V1537t))) -> pat_cond_67 kl_V1537 kl_V1537h kl_V1537t _ -> pat_cond_73 case kl_if_66 of Atom (B (True)) -> do let !appl_74 = Atom Nil !appl_75 <- appl_74 `pseq` klCons (ApplC (PL "stinput" kl_stinput)) appl_74 let !appl_76 = Atom Nil !appl_77 <- appl_75 `pseq` (appl_76 `pseq` klCons appl_75 appl_76) appl_77 `pseq` klCons (ApplC (wrapNamed "read-char-code" kl_read_char_code)) appl_77 Atom (B (False)) -> do do return kl_V1537 _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" kl_shen_compose :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_compose (!kl_V1540) (!kl_V1541) = do let !appl_0 = Atom Nil !kl_if_1 <- appl_0 `pseq` (kl_V1540 `pseq` eq appl_0 kl_V1540) case kl_if_1 of Atom (B (True)) -> do return kl_V1541 Atom (B (False)) -> do let pat_cond_2 kl_V1540 kl_V1540h kl_V1540t = do !appl_3 <- kl_V1541 `pseq` applyWrapper kl_V1540h [kl_V1541] kl_V1540t `pseq` (appl_3 `pseq` kl_shen_compose kl_V1540t appl_3) pat_cond_4 = do do kl_shen_f_error (ApplC (wrapNamed "shen.compose" kl_shen_compose)) in case kl_V1540 of !(kl_V1540@(Cons (!kl_V1540h) (!kl_V1540t))) -> pat_cond_2 kl_V1540 kl_V1540h kl_V1540t _ -> pat_cond_4 _ -> throwError "if: expected boolean" kl_shen_compile_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_compile_macro (!kl_V1543) = do !kl_if_0 <- let pat_cond_1 kl_V1543 kl_V1543h kl_V1543t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V1543t kl_V1543th kl_V1543tt = do !kl_if_6 <- let pat_cond_7 kl_V1543tt kl_V1543tth kl_V1543ttt = do let !appl_8 = Atom Nil !kl_if_9 <- appl_8 `pseq` (kl_V1543ttt `pseq` eq appl_8 kl_V1543ttt) case kl_if_9 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_10 = do do return (Atom (B False)) in case kl_V1543tt of !(kl_V1543tt@(Cons (!kl_V1543tth) (!kl_V1543ttt))) -> pat_cond_7 kl_V1543tt kl_V1543tth kl_V1543ttt _ -> pat_cond_10 case kl_if_6 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_11 = do do return (Atom (B False)) in case kl_V1543t of !(kl_V1543t@(Cons (!kl_V1543th) (!kl_V1543tt))) -> pat_cond_5 kl_V1543t kl_V1543th kl_V1543tt _ -> pat_cond_11 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_12 = do do return (Atom (B False)) in case kl_V1543h of kl_V1543h@(Atom (UnboundSym "compile")) -> pat_cond_3 kl_V1543h@(ApplC (PL "compile" _)) -> pat_cond_3 kl_V1543h@(ApplC (Func "compile" _)) -> pat_cond_3 _ -> pat_cond_12 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_13 = do do return (Atom (B False)) in case kl_V1543 of !(kl_V1543@(Cons (!kl_V1543h) (!kl_V1543t))) -> pat_cond_1 kl_V1543 kl_V1543h kl_V1543t _ -> pat_cond_13 case kl_if_0 of Atom (B (True)) -> do !appl_14 <- kl_V1543 `pseq` tl kl_V1543 !appl_15 <- appl_14 `pseq` hd appl_14 !appl_16 <- kl_V1543 `pseq` tl kl_V1543 !appl_17 <- appl_16 `pseq` tl appl_16 !appl_18 <- appl_17 `pseq` hd appl_17 let !appl_19 = Atom Nil !appl_20 <- appl_19 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "E")) appl_19 !appl_21 <- appl_20 `pseq` klCons (ApplC (wrapNamed "cons?" consP)) appl_20 let !appl_22 = Atom Nil !appl_23 <- appl_22 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "E")) appl_22 !appl_24 <- appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.Str "parse error here: ~S~%")) appl_23 !appl_25 <- appl_24 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "error")) appl_24 let !appl_26 = Atom Nil !appl_27 <- appl_26 `pseq` klCons (Core.Types.Atom (Core.Types.Str "parse error~%")) appl_26 !appl_28 <- appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "error")) appl_27 let !appl_29 = Atom Nil !appl_30 <- appl_28 `pseq` (appl_29 `pseq` klCons appl_28 appl_29) !appl_31 <- appl_25 `pseq` (appl_30 `pseq` klCons appl_25 appl_30) !appl_32 <- appl_21 `pseq` (appl_31 `pseq` klCons appl_21 appl_31) !appl_33 <- appl_32 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_32 let !appl_34 = Atom Nil !appl_35 <- appl_33 `pseq` (appl_34 `pseq` klCons appl_33 appl_34) !appl_36 <- appl_35 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "E")) appl_35 !appl_37 <- appl_36 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_36 let !appl_38 = Atom Nil !appl_39 <- appl_37 `pseq` (appl_38 `pseq` klCons appl_37 appl_38) !appl_40 <- appl_18 `pseq` (appl_39 `pseq` klCons appl_18 appl_39) !appl_41 <- appl_15 `pseq` (appl_40 `pseq` klCons appl_15 appl_40) appl_41 `pseq` klCons (ApplC (wrapNamed "compile" kl_compile)) appl_41 Atom (B (False)) -> do do return kl_V1543 _ -> throwError "if: expected boolean" kl_shen_prolog_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_prolog_macro (!kl_V1545) = do let pat_cond_0 kl_V1545 kl_V1545t = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_F) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Receive) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_PrologDef) -> do let !appl_4 = ApplC (Func "lambda" (Context (\(!kl_Query) -> do return kl_Query))) let !appl_5 = Atom Nil !appl_6 <- appl_5 `pseq` klCons (ApplC (PL "shen.start-new-prolog-process" kl_shen_start_new_prolog_process)) appl_5 let !appl_7 = Atom Nil !appl_8 <- appl_7 `pseq` klCons (Atom (B True)) appl_7 !appl_9 <- appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "freeze")) appl_8 let !appl_10 = Atom Nil !appl_11 <- appl_9 `pseq` (appl_10 `pseq` klCons appl_9 appl_10) !appl_12 <- appl_6 `pseq` (appl_11 `pseq` klCons appl_6 appl_11) !appl_13 <- kl_Receive `pseq` (appl_12 `pseq` kl_append kl_Receive appl_12) !appl_14 <- kl_F `pseq` (appl_13 `pseq` klCons kl_F appl_13) appl_14 `pseq` applyWrapper appl_4 [appl_14]))) let !appl_15 = Atom Nil !appl_16 <- kl_F `pseq` (appl_15 `pseq` klCons kl_F appl_15) !appl_17 <- appl_16 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "defprolog")) appl_16 let !appl_18 = Atom Nil !appl_19 <- appl_18 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "<--")) appl_18 !appl_20 <- kl_V1545t `pseq` kl_shen_pass_literals kl_V1545t let !appl_21 = Atom Nil !appl_22 <- appl_21 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym ";")) appl_21 !appl_23 <- appl_20 `pseq` (appl_22 `pseq` kl_append appl_20 appl_22) !appl_24 <- appl_19 `pseq` (appl_23 `pseq` kl_append appl_19 appl_23) !appl_25 <- kl_Receive `pseq` (appl_24 `pseq` kl_append kl_Receive appl_24) !appl_26 <- appl_17 `pseq` (appl_25 `pseq` kl_append appl_17 appl_25) !appl_27 <- appl_26 `pseq` kl_eval appl_26 appl_27 `pseq` applyWrapper appl_3 [appl_27]))) !appl_28 <- kl_V1545t `pseq` kl_shen_receive_terms kl_V1545t appl_28 `pseq` applyWrapper appl_2 [appl_28]))) !appl_29 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "shen.f")) appl_29 `pseq` applyWrapper appl_1 [appl_29] pat_cond_30 = do do return kl_V1545 in case kl_V1545 of !(kl_V1545@(Cons (Atom (UnboundSym "prolog?")) (!kl_V1545t))) -> pat_cond_0 kl_V1545 kl_V1545t !(kl_V1545@(Cons (ApplC (PL "prolog?" _)) (!kl_V1545t))) -> pat_cond_0 kl_V1545 kl_V1545t !(kl_V1545@(Cons (ApplC (Func "prolog?" _)) (!kl_V1545t))) -> pat_cond_0 kl_V1545 kl_V1545t _ -> pat_cond_30 kl_shen_receive_terms :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_receive_terms (!kl_V1551) = do let !appl_0 = Atom Nil !kl_if_1 <- appl_0 `pseq` (kl_V1551 `pseq` eq appl_0 kl_V1551) case kl_if_1 of Atom (B (True)) -> do return (Atom Nil) Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V1551 kl_V1551h kl_V1551t = do !kl_if_4 <- let pat_cond_5 kl_V1551h kl_V1551hh kl_V1551ht = do !kl_if_6 <- let pat_cond_7 = do !kl_if_8 <- let pat_cond_9 kl_V1551ht kl_V1551hth kl_V1551htt = do let !appl_10 = Atom Nil !kl_if_11 <- appl_10 `pseq` (kl_V1551htt `pseq` eq appl_10 kl_V1551htt) case kl_if_11 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_12 = do do return (Atom (B False)) in case kl_V1551ht of !(kl_V1551ht@(Cons (!kl_V1551hth) (!kl_V1551htt))) -> pat_cond_9 kl_V1551ht kl_V1551hth kl_V1551htt _ -> pat_cond_12 case kl_if_8 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_13 = do do return (Atom (B False)) in case kl_V1551hh of kl_V1551hh@(Atom (UnboundSym "receive")) -> pat_cond_7 kl_V1551hh@(ApplC (PL "receive" _)) -> pat_cond_7 kl_V1551hh@(ApplC (Func "receive" _)) -> pat_cond_7 _ -> pat_cond_13 case kl_if_6 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_14 = do do return (Atom (B False)) in case kl_V1551h of !(kl_V1551h@(Cons (!kl_V1551hh) (!kl_V1551ht))) -> pat_cond_5 kl_V1551h kl_V1551hh kl_V1551ht _ -> pat_cond_14 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_15 = do do return (Atom (B False)) in case kl_V1551 of !(kl_V1551@(Cons (!kl_V1551h) (!kl_V1551t))) -> pat_cond_3 kl_V1551 kl_V1551h kl_V1551t _ -> pat_cond_15 case kl_if_2 of Atom (B (True)) -> do !appl_16 <- kl_V1551 `pseq` hd kl_V1551 !appl_17 <- appl_16 `pseq` tl appl_16 !appl_18 <- appl_17 `pseq` hd appl_17 !appl_19 <- kl_V1551 `pseq` tl kl_V1551 !appl_20 <- appl_19 `pseq` kl_shen_receive_terms appl_19 appl_18 `pseq` (appl_20 `pseq` klCons appl_18 appl_20) Atom (B (False)) -> do let pat_cond_21 kl_V1551 kl_V1551h kl_V1551t = do kl_V1551t `pseq` kl_shen_receive_terms kl_V1551t pat_cond_22 = do do kl_shen_f_error (ApplC (wrapNamed "shen.receive-terms" kl_shen_receive_terms)) in case kl_V1551 of !(kl_V1551@(Cons (!kl_V1551h) (!kl_V1551t))) -> pat_cond_21 kl_V1551 kl_V1551h kl_V1551t _ -> pat_cond_22 _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" kl_shen_pass_literals :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_pass_literals (!kl_V1555) = do let !appl_0 = Atom Nil !kl_if_1 <- appl_0 `pseq` (kl_V1555 `pseq` eq appl_0 kl_V1555) case kl_if_1 of Atom (B (True)) -> do return (Atom Nil) Atom (B (False)) -> do !kl_if_2 <- let pat_cond_3 kl_V1555 kl_V1555h kl_V1555t = do !kl_if_4 <- let pat_cond_5 kl_V1555h kl_V1555hh kl_V1555ht = do !kl_if_6 <- let pat_cond_7 = do !kl_if_8 <- let pat_cond_9 kl_V1555ht kl_V1555hth kl_V1555htt = do let !appl_10 = Atom Nil !kl_if_11 <- appl_10 `pseq` (kl_V1555htt `pseq` eq appl_10 kl_V1555htt) case kl_if_11 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_12 = do do return (Atom (B False)) in case kl_V1555ht of !(kl_V1555ht@(Cons (!kl_V1555hth) (!kl_V1555htt))) -> pat_cond_9 kl_V1555ht kl_V1555hth kl_V1555htt _ -> pat_cond_12 case kl_if_8 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_13 = do do return (Atom (B False)) in case kl_V1555hh of kl_V1555hh@(Atom (UnboundSym "receive")) -> pat_cond_7 kl_V1555hh@(ApplC (PL "receive" _)) -> pat_cond_7 kl_V1555hh@(ApplC (Func "receive" _)) -> pat_cond_7 _ -> pat_cond_13 case kl_if_6 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_14 = do do return (Atom (B False)) in case kl_V1555h of !(kl_V1555h@(Cons (!kl_V1555hh) (!kl_V1555ht))) -> pat_cond_5 kl_V1555h kl_V1555hh kl_V1555ht _ -> pat_cond_14 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_15 = do do return (Atom (B False)) in case kl_V1555 of !(kl_V1555@(Cons (!kl_V1555h) (!kl_V1555t))) -> pat_cond_3 kl_V1555 kl_V1555h kl_V1555t _ -> pat_cond_15 case kl_if_2 of Atom (B (True)) -> do !appl_16 <- kl_V1555 `pseq` tl kl_V1555 appl_16 `pseq` kl_shen_pass_literals appl_16 Atom (B (False)) -> do let pat_cond_17 kl_V1555 kl_V1555h kl_V1555t = do !appl_18 <- kl_V1555t `pseq` kl_shen_pass_literals kl_V1555t kl_V1555h `pseq` (appl_18 `pseq` klCons kl_V1555h appl_18) pat_cond_19 = do do kl_shen_f_error (ApplC (wrapNamed "shen.pass-literals" kl_shen_pass_literals)) in case kl_V1555 of !(kl_V1555@(Cons (!kl_V1555h) (!kl_V1555t))) -> pat_cond_17 kl_V1555 kl_V1555h kl_V1555t _ -> pat_cond_19 _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" kl_shen_defprolog_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_defprolog_macro (!kl_V1557) = do let pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt = do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do kl_Y `pseq` kl_shen_LBdefprologRB kl_Y))) let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Y) -> do kl_V1557th `pseq` (kl_Y `pseq` kl_shen_prolog_error kl_V1557th kl_Y)))) appl_1 `pseq` (kl_V1557t `pseq` (appl_2 `pseq` kl_compile appl_1 kl_V1557t appl_2)) pat_cond_3 = do do return kl_V1557 in case kl_V1557 of !(kl_V1557@(Cons (Atom (UnboundSym "defprolog")) (!(kl_V1557t@(Cons (!kl_V1557th) (!kl_V1557tt)))))) -> pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt !(kl_V1557@(Cons (ApplC (PL "defprolog" _)) (!(kl_V1557t@(Cons (!kl_V1557th) (!kl_V1557tt)))))) -> pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt !(kl_V1557@(Cons (ApplC (Func "defprolog" _)) (!(kl_V1557t@(Cons (!kl_V1557th) (!kl_V1557tt)))))) -> pat_cond_0 kl_V1557 kl_V1557t kl_V1557th kl_V1557tt _ -> pat_cond_3 kl_shen_datatype_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_datatype_macro (!kl_V1559) = do let pat_cond_0 kl_V1559 kl_V1559t kl_V1559th kl_V1559tt = do !appl_1 <- kl_V1559th `pseq` kl_shen_intern_type kl_V1559th let !appl_2 = Atom Nil !appl_3 <- appl_2 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_2 !appl_4 <- appl_3 `pseq` klCons (ApplC (wrapNamed "shen." kl_shen_LBdatatype_rulesRB)) appl_3 let !appl_5 = Atom Nil !appl_6 <- appl_4 `pseq` (appl_5 `pseq` klCons appl_4 appl_5) !appl_7 <- appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "X")) appl_6 !appl_8 <- appl_7 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_7 !appl_9 <- kl_V1559tt `pseq` kl_shen_rcons_form kl_V1559tt let !appl_10 = Atom Nil !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "shen.datatype-error" kl_shen_datatype_error)) appl_10 !appl_12 <- appl_11 `pseq` klCons (ApplC (wrapNamed "function" kl_function)) appl_11 let !appl_13 = Atom Nil !appl_14 <- appl_12 `pseq` (appl_13 `pseq` klCons appl_12 appl_13) !appl_15 <- appl_9 `pseq` (appl_14 `pseq` klCons appl_9 appl_14) !appl_16 <- appl_8 `pseq` (appl_15 `pseq` klCons appl_8 appl_15) !appl_17 <- appl_16 `pseq` klCons (ApplC (wrapNamed "compile" kl_compile)) appl_16 let !appl_18 = Atom Nil !appl_19 <- appl_17 `pseq` (appl_18 `pseq` klCons appl_17 appl_18) !appl_20 <- appl_1 `pseq` (appl_19 `pseq` klCons appl_1 appl_19) appl_20 `pseq` klCons (ApplC (wrapNamed "shen.process-datatype" kl_shen_process_datatype)) appl_20 pat_cond_21 = do do return kl_V1559 in case kl_V1559 of !(kl_V1559@(Cons (Atom (UnboundSym "datatype")) (!(kl_V1559t@(Cons (!kl_V1559th) (!kl_V1559tt)))))) -> pat_cond_0 kl_V1559 kl_V1559t kl_V1559th kl_V1559tt !(kl_V1559@(Cons (ApplC (PL "datatype" _)) (!(kl_V1559t@(Cons (!kl_V1559th) (!kl_V1559tt)))))) -> pat_cond_0 kl_V1559 kl_V1559t kl_V1559th kl_V1559tt !(kl_V1559@(Cons (ApplC (Func "datatype" _)) (!(kl_V1559t@(Cons (!kl_V1559th) (!kl_V1559tt)))))) -> pat_cond_0 kl_V1559 kl_V1559t kl_V1559th kl_V1559tt _ -> pat_cond_21 kl_shen_intern_type :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_intern_type (!kl_V1561) = do !appl_0 <- kl_V1561 `pseq` str kl_V1561 !appl_1 <- appl_0 `pseq` cn (Core.Types.Atom (Core.Types.Str "type#")) appl_0 appl_1 `pseq` intern appl_1 kl_shen_Ats_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_Ats_macro (!kl_V1563) = do let pat_cond_0 kl_V1563 kl_V1563t kl_V1563th kl_V1563tt kl_V1563tth kl_V1563ttt kl_V1563ttth kl_V1563tttt = do !appl_1 <- kl_V1563tt `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) kl_V1563tt !appl_2 <- appl_1 `pseq` kl_shen_Ats_macro appl_1 let !appl_3 = Atom Nil !appl_4 <- appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) !appl_5 <- kl_V1563th `pseq` (appl_4 `pseq` klCons kl_V1563th appl_4) appl_5 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_5 pat_cond_6 = do !kl_if_7 <- let pat_cond_8 kl_V1563 kl_V1563h kl_V1563t = do !kl_if_9 <- let pat_cond_10 = do !kl_if_11 <- let pat_cond_12 kl_V1563t kl_V1563th kl_V1563tt = do !kl_if_13 <- let pat_cond_14 kl_V1563tt kl_V1563tth kl_V1563ttt = do let !appl_15 = Atom Nil !kl_if_16 <- appl_15 `pseq` (kl_V1563ttt `pseq` eq appl_15 kl_V1563ttt) !kl_if_17 <- case kl_if_16 of Atom (B (True)) -> do !kl_if_18 <- kl_V1563th `pseq` stringP kl_V1563th case kl_if_18 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" case kl_if_17 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_19 = do do return (Atom (B False)) in case kl_V1563tt of !(kl_V1563tt@(Cons (!kl_V1563tth) (!kl_V1563ttt))) -> pat_cond_14 kl_V1563tt kl_V1563tth kl_V1563ttt _ -> pat_cond_19 case kl_if_13 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_20 = do do return (Atom (B False)) in case kl_V1563t of !(kl_V1563t@(Cons (!kl_V1563th) (!kl_V1563tt))) -> pat_cond_12 kl_V1563t kl_V1563th kl_V1563tt _ -> pat_cond_20 case kl_if_11 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_21 = do do return (Atom (B False)) in case kl_V1563h of kl_V1563h@(Atom (UnboundSym "@s")) -> pat_cond_10 kl_V1563h@(ApplC (PL "@s" _)) -> pat_cond_10 kl_V1563h@(ApplC (Func "@s" _)) -> pat_cond_10 _ -> pat_cond_21 case kl_if_9 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_22 = do do return (Atom (B False)) in case kl_V1563 of !(kl_V1563@(Cons (!kl_V1563h) (!kl_V1563t))) -> pat_cond_8 kl_V1563 kl_V1563h kl_V1563t _ -> pat_cond_22 case kl_if_7 of Atom (B (True)) -> do let !appl_23 = ApplC (Func "lambda" (Context (\(!kl_E) -> do !appl_24 <- kl_E `pseq` kl_length kl_E !kl_if_25 <- appl_24 `pseq` greaterThan appl_24 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) case kl_if_25 of Atom (B (True)) -> do !appl_26 <- kl_V1563 `pseq` tl kl_V1563 !appl_27 <- appl_26 `pseq` tl appl_26 !appl_28 <- kl_E `pseq` (appl_27 `pseq` kl_append kl_E appl_27) !appl_29 <- appl_28 `pseq` klCons (ApplC (wrapNamed "@s" kl_Ats)) appl_28 appl_29 `pseq` kl_shen_Ats_macro appl_29 Atom (B (False)) -> do do return kl_V1563 _ -> throwError "if: expected boolean"))) !appl_30 <- kl_V1563 `pseq` tl kl_V1563 !appl_31 <- appl_30 `pseq` hd appl_30 !appl_32 <- appl_31 `pseq` kl_explode appl_31 appl_32 `pseq` applyWrapper appl_23 [appl_32] Atom (B (False)) -> do do return kl_V1563 _ -> throwError "if: expected boolean" in case kl_V1563 of !(kl_V1563@(Cons (Atom (UnboundSym "@s")) (!(kl_V1563t@(Cons (!kl_V1563th) (!(kl_V1563tt@(Cons (!kl_V1563tth) (!(kl_V1563ttt@(Cons (!kl_V1563ttth) (!kl_V1563tttt)))))))))))) -> pat_cond_0 kl_V1563 kl_V1563t kl_V1563th kl_V1563tt kl_V1563tth kl_V1563ttt kl_V1563ttth kl_V1563tttt !(kl_V1563@(Cons (ApplC (PL "@s" _)) (!(kl_V1563t@(Cons (!kl_V1563th) (!(kl_V1563tt@(Cons (!kl_V1563tth) (!(kl_V1563ttt@(Cons (!kl_V1563ttth) (!kl_V1563tttt)))))))))))) -> pat_cond_0 kl_V1563 kl_V1563t kl_V1563th kl_V1563tt kl_V1563tth kl_V1563ttt kl_V1563ttth kl_V1563tttt !(kl_V1563@(Cons (ApplC (Func "@s" _)) (!(kl_V1563t@(Cons (!kl_V1563th) (!(kl_V1563tt@(Cons (!kl_V1563tth) (!(kl_V1563ttt@(Cons (!kl_V1563ttth) (!kl_V1563tttt)))))))))))) -> pat_cond_0 kl_V1563 kl_V1563t kl_V1563th kl_V1563tt kl_V1563tth kl_V1563ttt kl_V1563ttth kl_V1563tttt _ -> pat_cond_6 kl_shen_synonyms_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_synonyms_macro (!kl_V1565) = do let pat_cond_0 kl_V1565 kl_V1565t = do !appl_1 <- kl_V1565t `pseq` kl_shen_curry_synonyms kl_V1565t !appl_2 <- appl_1 `pseq` kl_shen_rcons_form appl_1 let !appl_3 = Atom Nil !appl_4 <- appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) appl_4 `pseq` klCons (ApplC (wrapNamed "shen.synonyms-help" kl_shen_synonyms_help)) appl_4 pat_cond_5 = do do return kl_V1565 in case kl_V1565 of !(kl_V1565@(Cons (Atom (UnboundSym "synonyms")) (!kl_V1565t))) -> pat_cond_0 kl_V1565 kl_V1565t !(kl_V1565@(Cons (ApplC (PL "synonyms" _)) (!kl_V1565t))) -> pat_cond_0 kl_V1565 kl_V1565t !(kl_V1565@(Cons (ApplC (Func "synonyms" _)) (!kl_V1565t))) -> pat_cond_0 kl_V1565 kl_V1565t _ -> pat_cond_5 kl_shen_curry_synonyms :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_curry_synonyms (!kl_V1567) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_X) -> do kl_X `pseq` kl_shen_curry_type kl_X))) appl_0 `pseq` (kl_V1567 `pseq` kl_map appl_0 kl_V1567) kl_shen_nl_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_nl_macro (!kl_V1569) = do !kl_if_0 <- let pat_cond_1 kl_V1569 kl_V1569h kl_V1569t = do !kl_if_2 <- let pat_cond_3 = do let !appl_4 = Atom Nil !kl_if_5 <- appl_4 `pseq` (kl_V1569t `pseq` eq appl_4 kl_V1569t) case kl_if_5 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_6 = do do return (Atom (B False)) in case kl_V1569h of kl_V1569h@(Atom (UnboundSym "nl")) -> pat_cond_3 kl_V1569h@(ApplC (PL "nl" _)) -> pat_cond_3 kl_V1569h@(ApplC (Func "nl" _)) -> pat_cond_3 _ -> pat_cond_6 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_7 = do do return (Atom (B False)) in case kl_V1569 of !(kl_V1569@(Cons (!kl_V1569h) (!kl_V1569t))) -> pat_cond_1 kl_V1569 kl_V1569h kl_V1569t _ -> pat_cond_7 case kl_if_0 of Atom (B (True)) -> do let !appl_8 = Atom Nil !appl_9 <- appl_8 `pseq` klCons (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_8 appl_9 `pseq` klCons (ApplC (wrapNamed "nl" kl_nl)) appl_9 Atom (B (False)) -> do do return kl_V1569 _ -> throwError "if: expected boolean" kl_shen_assoc_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_assoc_macro (!kl_V1571) = do !kl_if_0 <- let pat_cond_1 kl_V1571 kl_V1571h kl_V1571t = do !kl_if_2 <- let pat_cond_3 kl_V1571t kl_V1571th kl_V1571tt = do !kl_if_4 <- let pat_cond_5 kl_V1571tt kl_V1571tth kl_V1571ttt = do !kl_if_6 <- let pat_cond_7 kl_V1571ttt kl_V1571ttth kl_V1571tttt = do let !appl_8 = Atom Nil !appl_9 <- appl_8 `pseq` klCons (ApplC (wrapNamed "do" kl_do)) appl_8 !appl_10 <- appl_9 `pseq` klCons (ApplC (wrapNamed "*" multiply)) appl_9 !appl_11 <- appl_10 `pseq` klCons (ApplC (wrapNamed "+" add)) appl_10 !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "or")) appl_11 !appl_13 <- appl_12 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "and")) appl_12 !appl_14 <- appl_13 `pseq` klCons (ApplC (wrapNamed "append" kl_append)) appl_13 !appl_15 <- appl_14 `pseq` klCons (ApplC (wrapNamed "@v" kl_Atv)) appl_14 !appl_16 <- appl_15 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_15 !kl_if_17 <- kl_V1571h `pseq` (appl_16 `pseq` kl_elementP kl_V1571h appl_16) case kl_if_17 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_18 = do do return (Atom (B False)) in case kl_V1571ttt of !(kl_V1571ttt@(Cons (!kl_V1571ttth) (!kl_V1571tttt))) -> pat_cond_7 kl_V1571ttt kl_V1571ttth kl_V1571tttt _ -> pat_cond_18 case kl_if_6 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_19 = do do return (Atom (B False)) in case kl_V1571tt of !(kl_V1571tt@(Cons (!kl_V1571tth) (!kl_V1571ttt))) -> pat_cond_5 kl_V1571tt kl_V1571tth kl_V1571ttt _ -> pat_cond_19 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_20 = do do return (Atom (B False)) in case kl_V1571t of !(kl_V1571t@(Cons (!kl_V1571th) (!kl_V1571tt))) -> pat_cond_3 kl_V1571t kl_V1571th kl_V1571tt _ -> pat_cond_20 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_21 = do do return (Atom (B False)) in case kl_V1571 of !(kl_V1571@(Cons (!kl_V1571h) (!kl_V1571t))) -> pat_cond_1 kl_V1571 kl_V1571h kl_V1571t _ -> pat_cond_21 case kl_if_0 of Atom (B (True)) -> do !appl_22 <- kl_V1571 `pseq` hd kl_V1571 !appl_23 <- kl_V1571 `pseq` tl kl_V1571 !appl_24 <- appl_23 `pseq` hd appl_23 !appl_25 <- kl_V1571 `pseq` hd kl_V1571 !appl_26 <- kl_V1571 `pseq` tl kl_V1571 !appl_27 <- appl_26 `pseq` tl appl_26 !appl_28 <- appl_25 `pseq` (appl_27 `pseq` klCons appl_25 appl_27) !appl_29 <- appl_28 `pseq` kl_shen_assoc_macro appl_28 let !appl_30 = Atom Nil !appl_31 <- appl_29 `pseq` (appl_30 `pseq` klCons appl_29 appl_30) !appl_32 <- appl_24 `pseq` (appl_31 `pseq` klCons appl_24 appl_31) appl_22 `pseq` (appl_32 `pseq` klCons appl_22 appl_32) Atom (B (False)) -> do do return kl_V1571 _ -> throwError "if: expected boolean" kl_shen_let_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_let_macro (!kl_V1573) = do let pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt kl_V1573tttth kl_V1573ttttt = do !appl_1 <- kl_V1573ttt `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) kl_V1573ttt !appl_2 <- appl_1 `pseq` kl_shen_let_macro appl_1 let !appl_3 = Atom Nil !appl_4 <- appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) !appl_5 <- kl_V1573tth `pseq` (appl_4 `pseq` klCons kl_V1573tth appl_4) !appl_6 <- kl_V1573th `pseq` (appl_5 `pseq` klCons kl_V1573th appl_5) appl_6 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_6 pat_cond_7 = do do return kl_V1573 in case kl_V1573 of !(kl_V1573@(Cons (Atom (UnboundSym "let")) (!(kl_V1573t@(Cons (!kl_V1573th) (!(kl_V1573tt@(Cons (!kl_V1573tth) (!(kl_V1573ttt@(Cons (!kl_V1573ttth) (!(kl_V1573tttt@(Cons (!kl_V1573tttth) (!kl_V1573ttttt))))))))))))))) -> pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt kl_V1573tttth kl_V1573ttttt !(kl_V1573@(Cons (ApplC (PL "let" _)) (!(kl_V1573t@(Cons (!kl_V1573th) (!(kl_V1573tt@(Cons (!kl_V1573tth) (!(kl_V1573ttt@(Cons (!kl_V1573ttth) (!(kl_V1573tttt@(Cons (!kl_V1573tttth) (!kl_V1573ttttt))))))))))))))) -> pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt kl_V1573tttth kl_V1573ttttt !(kl_V1573@(Cons (ApplC (Func "let" _)) (!(kl_V1573t@(Cons (!kl_V1573th) (!(kl_V1573tt@(Cons (!kl_V1573tth) (!(kl_V1573ttt@(Cons (!kl_V1573ttth) (!(kl_V1573tttt@(Cons (!kl_V1573tttth) (!kl_V1573ttttt))))))))))))))) -> pat_cond_0 kl_V1573 kl_V1573t kl_V1573th kl_V1573tt kl_V1573tth kl_V1573ttt kl_V1573ttth kl_V1573tttt kl_V1573tttth kl_V1573ttttt _ -> pat_cond_7 kl_shen_abs_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_abs_macro (!kl_V1575) = do let pat_cond_0 kl_V1575 kl_V1575t kl_V1575th kl_V1575tt kl_V1575tth kl_V1575ttt kl_V1575ttth kl_V1575tttt = do !appl_1 <- kl_V1575tt `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) kl_V1575tt !appl_2 <- appl_1 `pseq` kl_shen_abs_macro appl_1 let !appl_3 = Atom Nil !appl_4 <- appl_2 `pseq` (appl_3 `pseq` klCons appl_2 appl_3) !appl_5 <- kl_V1575th `pseq` (appl_4 `pseq` klCons kl_V1575th appl_4) appl_5 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_5 pat_cond_6 = do !kl_if_7 <- let pat_cond_8 kl_V1575 kl_V1575h kl_V1575t = do !kl_if_9 <- let pat_cond_10 = do !kl_if_11 <- let pat_cond_12 kl_V1575t kl_V1575th kl_V1575tt = do !kl_if_13 <- let pat_cond_14 kl_V1575tt kl_V1575tth kl_V1575ttt = do let !appl_15 = Atom Nil !kl_if_16 <- appl_15 `pseq` (kl_V1575ttt `pseq` eq appl_15 kl_V1575ttt) case kl_if_16 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_17 = do do return (Atom (B False)) in case kl_V1575tt of !(kl_V1575tt@(Cons (!kl_V1575tth) (!kl_V1575ttt))) -> pat_cond_14 kl_V1575tt kl_V1575tth kl_V1575ttt _ -> pat_cond_17 case kl_if_13 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_18 = do do return (Atom (B False)) in case kl_V1575t of !(kl_V1575t@(Cons (!kl_V1575th) (!kl_V1575tt))) -> pat_cond_12 kl_V1575t kl_V1575th kl_V1575tt _ -> pat_cond_18 case kl_if_11 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_19 = do do return (Atom (B False)) in case kl_V1575h of kl_V1575h@(Atom (UnboundSym "/.")) -> pat_cond_10 kl_V1575h@(ApplC (PL "/." _)) -> pat_cond_10 kl_V1575h@(ApplC (Func "/." _)) -> pat_cond_10 _ -> pat_cond_19 case kl_if_9 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_20 = do do return (Atom (B False)) in case kl_V1575 of !(kl_V1575@(Cons (!kl_V1575h) (!kl_V1575t))) -> pat_cond_8 kl_V1575 kl_V1575h kl_V1575t _ -> pat_cond_20 case kl_if_7 of Atom (B (True)) -> do !appl_21 <- kl_V1575 `pseq` tl kl_V1575 appl_21 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "lambda")) appl_21 Atom (B (False)) -> do do return kl_V1575 _ -> throwError "if: expected boolean" in case kl_V1575 of !(kl_V1575@(Cons (Atom (UnboundSym "/.")) (!(kl_V1575t@(Cons (!kl_V1575th) (!(kl_V1575tt@(Cons (!kl_V1575tth) (!(kl_V1575ttt@(Cons (!kl_V1575ttth) (!kl_V1575tttt)))))))))))) -> pat_cond_0 kl_V1575 kl_V1575t kl_V1575th kl_V1575tt kl_V1575tth kl_V1575ttt kl_V1575ttth kl_V1575tttt !(kl_V1575@(Cons (ApplC (PL "/." _)) (!(kl_V1575t@(Cons (!kl_V1575th) (!(kl_V1575tt@(Cons (!kl_V1575tth) (!(kl_V1575ttt@(Cons (!kl_V1575ttth) (!kl_V1575tttt)))))))))))) -> pat_cond_0 kl_V1575 kl_V1575t kl_V1575th kl_V1575tt kl_V1575tth kl_V1575ttt kl_V1575ttth kl_V1575tttt !(kl_V1575@(Cons (ApplC (Func "/." _)) (!(kl_V1575t@(Cons (!kl_V1575th) (!(kl_V1575tt@(Cons (!kl_V1575tth) (!(kl_V1575ttt@(Cons (!kl_V1575ttth) (!kl_V1575tttt)))))))))))) -> pat_cond_0 kl_V1575 kl_V1575t kl_V1575th kl_V1575tt kl_V1575tth kl_V1575ttt kl_V1575ttth kl_V1575tttt _ -> pat_cond_6 kl_shen_cases_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_cases_macro (!kl_V1579) = do let pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt = do return kl_V1579tth pat_cond_1 = do !kl_if_2 <- let pat_cond_3 kl_V1579 kl_V1579h kl_V1579t = do !kl_if_4 <- let pat_cond_5 = do !kl_if_6 <- let pat_cond_7 kl_V1579t kl_V1579th kl_V1579tt = do !kl_if_8 <- let pat_cond_9 kl_V1579tt kl_V1579tth kl_V1579ttt = do let !appl_10 = Atom Nil !kl_if_11 <- appl_10 `pseq` (kl_V1579ttt `pseq` eq appl_10 kl_V1579ttt) case kl_if_11 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_12 = do do return (Atom (B False)) in case kl_V1579tt of !(kl_V1579tt@(Cons (!kl_V1579tth) (!kl_V1579ttt))) -> pat_cond_9 kl_V1579tt kl_V1579tth kl_V1579ttt _ -> pat_cond_12 case kl_if_8 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_13 = do do return (Atom (B False)) in case kl_V1579t of !(kl_V1579t@(Cons (!kl_V1579th) (!kl_V1579tt))) -> pat_cond_7 kl_V1579t kl_V1579th kl_V1579tt _ -> pat_cond_13 case kl_if_6 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_14 = do do return (Atom (B False)) in case kl_V1579h of kl_V1579h@(Atom (UnboundSym "cases")) -> pat_cond_5 kl_V1579h@(ApplC (PL "cases" _)) -> pat_cond_5 kl_V1579h@(ApplC (Func "cases" _)) -> pat_cond_5 _ -> pat_cond_14 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_15 = do do return (Atom (B False)) in case kl_V1579 of !(kl_V1579@(Cons (!kl_V1579h) (!kl_V1579t))) -> pat_cond_3 kl_V1579 kl_V1579h kl_V1579t _ -> pat_cond_15 case kl_if_2 of Atom (B (True)) -> do !appl_16 <- kl_V1579 `pseq` tl kl_V1579 !appl_17 <- appl_16 `pseq` hd appl_16 !appl_18 <- kl_V1579 `pseq` tl kl_V1579 !appl_19 <- appl_18 `pseq` tl appl_18 !appl_20 <- appl_19 `pseq` hd appl_19 let !appl_21 = Atom Nil !appl_22 <- appl_21 `pseq` klCons (Core.Types.Atom (Core.Types.Str "error: cases exhausted")) appl_21 !appl_23 <- appl_22 `pseq` klCons (ApplC (wrapNamed "simple-error" simpleError)) appl_22 let !appl_24 = Atom Nil !appl_25 <- appl_23 `pseq` (appl_24 `pseq` klCons appl_23 appl_24) !appl_26 <- appl_20 `pseq` (appl_25 `pseq` klCons appl_20 appl_25) !appl_27 <- appl_17 `pseq` (appl_26 `pseq` klCons appl_17 appl_26) appl_27 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_27 Atom (B (False)) -> do let pat_cond_28 kl_V1579 kl_V1579t kl_V1579th kl_V1579tt kl_V1579tth kl_V1579ttt = do !appl_29 <- kl_V1579ttt `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "cases")) kl_V1579ttt !appl_30 <- appl_29 `pseq` kl_shen_cases_macro appl_29 let !appl_31 = Atom Nil !appl_32 <- appl_30 `pseq` (appl_31 `pseq` klCons appl_30 appl_31) !appl_33 <- kl_V1579tth `pseq` (appl_32 `pseq` klCons kl_V1579tth appl_32) !appl_34 <- kl_V1579th `pseq` (appl_33 `pseq` klCons kl_V1579th appl_33) appl_34 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "if")) appl_34 pat_cond_35 = do !kl_if_36 <- let pat_cond_37 kl_V1579 kl_V1579h kl_V1579t = do !kl_if_38 <- let pat_cond_39 = do !kl_if_40 <- let pat_cond_41 kl_V1579t kl_V1579th kl_V1579tt = do let !appl_42 = Atom Nil !kl_if_43 <- appl_42 `pseq` (kl_V1579tt `pseq` eq appl_42 kl_V1579tt) case kl_if_43 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_44 = do do return (Atom (B False)) in case kl_V1579t of !(kl_V1579t@(Cons (!kl_V1579th) (!kl_V1579tt))) -> pat_cond_41 kl_V1579t kl_V1579th kl_V1579tt _ -> pat_cond_44 case kl_if_40 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_45 = do do return (Atom (B False)) in case kl_V1579h of kl_V1579h@(Atom (UnboundSym "cases")) -> pat_cond_39 kl_V1579h@(ApplC (PL "cases" _)) -> pat_cond_39 kl_V1579h@(ApplC (Func "cases" _)) -> pat_cond_39 _ -> pat_cond_45 case kl_if_38 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_46 = do do return (Atom (B False)) in case kl_V1579 of !(kl_V1579@(Cons (!kl_V1579h) (!kl_V1579t))) -> pat_cond_37 kl_V1579 kl_V1579h kl_V1579t _ -> pat_cond_46 case kl_if_36 of Atom (B (True)) -> do simpleError (Core.Types.Atom (Core.Types.Str "error: odd number of case elements\n")) Atom (B (False)) -> do do return kl_V1579 _ -> throwError "if: expected boolean" in case kl_V1579 of !(kl_V1579@(Cons (Atom (UnboundSym "cases")) (!(kl_V1579t@(Cons (!kl_V1579th) (!(kl_V1579tt@(Cons (!kl_V1579tth) (!kl_V1579ttt))))))))) -> pat_cond_28 kl_V1579 kl_V1579t kl_V1579th kl_V1579tt kl_V1579tth kl_V1579ttt !(kl_V1579@(Cons (ApplC (PL "cases" _)) (!(kl_V1579t@(Cons (!kl_V1579th) (!(kl_V1579tt@(Cons (!kl_V1579tth) (!kl_V1579ttt))))))))) -> pat_cond_28 kl_V1579 kl_V1579t kl_V1579th kl_V1579tt kl_V1579tth kl_V1579ttt !(kl_V1579@(Cons (ApplC (Func "cases" _)) (!(kl_V1579t@(Cons (!kl_V1579th) (!(kl_V1579tt@(Cons (!kl_V1579tth) (!kl_V1579ttt))))))))) -> pat_cond_28 kl_V1579 kl_V1579t kl_V1579th kl_V1579tt kl_V1579tth kl_V1579ttt _ -> pat_cond_35 _ -> throwError "if: expected boolean" in case kl_V1579 of !(kl_V1579@(Cons (Atom (UnboundSym "cases")) (!(kl_V1579t@(Cons (Atom (UnboundSym "true")) (!(kl_V1579tt@(Cons (!kl_V1579tth) (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt !(kl_V1579@(Cons (Atom (UnboundSym "cases")) (!(kl_V1579t@(Cons (Atom (B (True))) (!(kl_V1579tt@(Cons (!kl_V1579tth) (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt !(kl_V1579@(Cons (ApplC (PL "cases" _)) (!(kl_V1579t@(Cons (Atom (UnboundSym "true")) (!(kl_V1579tt@(Cons (!kl_V1579tth) (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt !(kl_V1579@(Cons (ApplC (PL "cases" _)) (!(kl_V1579t@(Cons (Atom (B (True))) (!(kl_V1579tt@(Cons (!kl_V1579tth) (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt !(kl_V1579@(Cons (ApplC (Func "cases" _)) (!(kl_V1579t@(Cons (Atom (UnboundSym "true")) (!(kl_V1579tt@(Cons (!kl_V1579tth) (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt !(kl_V1579@(Cons (ApplC (Func "cases" _)) (!(kl_V1579t@(Cons (Atom (B (True))) (!(kl_V1579tt@(Cons (!kl_V1579tth) (!kl_V1579ttt))))))))) -> pat_cond_0 kl_V1579 kl_V1579t kl_V1579tt kl_V1579tth kl_V1579ttt _ -> pat_cond_1 kl_shen_timer_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_timer_macro (!kl_V1581) = do !kl_if_0 <- let pat_cond_1 kl_V1581 kl_V1581h kl_V1581t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V1581t kl_V1581th kl_V1581tt = do let !appl_6 = Atom Nil !kl_if_7 <- appl_6 `pseq` (kl_V1581tt `pseq` eq appl_6 kl_V1581tt) case kl_if_7 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_8 = do do return (Atom (B False)) in case kl_V1581t of !(kl_V1581t@(Cons (!kl_V1581th) (!kl_V1581tt))) -> pat_cond_5 kl_V1581t kl_V1581th kl_V1581tt _ -> pat_cond_8 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_9 = do do return (Atom (B False)) in case kl_V1581h of kl_V1581h@(Atom (UnboundSym "time")) -> pat_cond_3 kl_V1581h@(ApplC (PL "time" _)) -> pat_cond_3 kl_V1581h@(ApplC (Func "time" _)) -> pat_cond_3 _ -> pat_cond_9 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_10 = do do return (Atom (B False)) in case kl_V1581 of !(kl_V1581@(Cons (!kl_V1581h) (!kl_V1581t))) -> pat_cond_1 kl_V1581 kl_V1581h kl_V1581t _ -> pat_cond_10 case kl_if_0 of Atom (B (True)) -> do let !appl_11 = Atom Nil !appl_12 <- appl_11 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "run")) appl_11 !appl_13 <- appl_12 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_12 !appl_14 <- kl_V1581 `pseq` tl kl_V1581 !appl_15 <- appl_14 `pseq` hd appl_14 let !appl_16 = Atom Nil !appl_17 <- appl_16 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "run")) appl_16 !appl_18 <- appl_17 `pseq` klCons (ApplC (wrapNamed "get-time" getTime)) appl_17 let !appl_19 = Atom Nil !appl_20 <- appl_19 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Start")) appl_19 !appl_21 <- appl_20 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Finish")) appl_20 !appl_22 <- appl_21 `pseq` klCons (ApplC (wrapNamed "-" Primitives.subtract)) appl_21 let !appl_23 = Atom Nil !appl_24 <- appl_23 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Time")) appl_23 !appl_25 <- appl_24 `pseq` klCons (ApplC (wrapNamed "str" str)) appl_24 let !appl_26 = Atom Nil !appl_27 <- appl_26 `pseq` klCons (Core.Types.Atom (Core.Types.Str " secs\n")) appl_26 !appl_28 <- appl_25 `pseq` (appl_27 `pseq` klCons appl_25 appl_27) !appl_29 <- appl_28 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_28 let !appl_30 = Atom Nil !appl_31 <- appl_29 `pseq` (appl_30 `pseq` klCons appl_29 appl_30) !appl_32 <- appl_31 `pseq` klCons (Core.Types.Atom (Core.Types.Str "\nrun time: ")) appl_31 !appl_33 <- appl_32 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_32 let !appl_34 = Atom Nil !appl_35 <- appl_34 `pseq` klCons (ApplC (PL "stoutput" kl_stoutput)) appl_34 let !appl_36 = Atom Nil !appl_37 <- appl_35 `pseq` (appl_36 `pseq` klCons appl_35 appl_36) !appl_38 <- appl_33 `pseq` (appl_37 `pseq` klCons appl_33 appl_37) !appl_39 <- appl_38 `pseq` klCons (ApplC (wrapNamed "shen.prhush" kl_shen_prhush)) appl_38 let !appl_40 = Atom Nil !appl_41 <- appl_40 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_40 !appl_42 <- appl_39 `pseq` (appl_41 `pseq` klCons appl_39 appl_41) !appl_43 <- appl_42 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Message")) appl_42 !appl_44 <- appl_22 `pseq` (appl_43 `pseq` klCons appl_22 appl_43) !appl_45 <- appl_44 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Time")) appl_44 !appl_46 <- appl_18 `pseq` (appl_45 `pseq` klCons appl_18 appl_45) !appl_47 <- appl_46 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Finish")) appl_46 !appl_48 <- appl_15 `pseq` (appl_47 `pseq` klCons appl_15 appl_47) !appl_49 <- appl_48 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Result")) appl_48 !appl_50 <- appl_13 `pseq` (appl_49 `pseq` klCons appl_13 appl_49) !appl_51 <- appl_50 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "Start")) appl_50 !appl_52 <- appl_51 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "let")) appl_51 appl_52 `pseq` kl_shen_let_macro appl_52 Atom (B (False)) -> do do return kl_V1581 _ -> throwError "if: expected boolean" kl_shen_tuple_up :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_tuple_up (!kl_V1583) = do let pat_cond_0 kl_V1583 kl_V1583h kl_V1583t = do !appl_1 <- kl_V1583t `pseq` kl_shen_tuple_up kl_V1583t let !appl_2 = Atom Nil !appl_3 <- appl_1 `pseq` (appl_2 `pseq` klCons appl_1 appl_2) !appl_4 <- kl_V1583h `pseq` (appl_3 `pseq` klCons kl_V1583h appl_3) appl_4 `pseq` klCons (ApplC (wrapNamed "@p" kl_Atp)) appl_4 pat_cond_5 = do do return kl_V1583 in case kl_V1583 of !(kl_V1583@(Cons (!kl_V1583h) (!kl_V1583t))) -> pat_cond_0 kl_V1583 kl_V1583h kl_V1583t _ -> pat_cond_5 kl_shen_putDivget_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_putDivget_macro (!kl_V1585) = do !kl_if_0 <- let pat_cond_1 kl_V1585 kl_V1585h kl_V1585t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V1585t kl_V1585th kl_V1585tt = do !kl_if_6 <- let pat_cond_7 kl_V1585tt kl_V1585tth kl_V1585ttt = do !kl_if_8 <- let pat_cond_9 kl_V1585ttt kl_V1585ttth kl_V1585tttt = do let !appl_10 = Atom Nil !kl_if_11 <- appl_10 `pseq` (kl_V1585tttt `pseq` eq appl_10 kl_V1585tttt) case kl_if_11 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_12 = do do return (Atom (B False)) in case kl_V1585ttt of !(kl_V1585ttt@(Cons (!kl_V1585ttth) (!kl_V1585tttt))) -> pat_cond_9 kl_V1585ttt kl_V1585ttth kl_V1585tttt _ -> pat_cond_12 case kl_if_8 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_13 = do do return (Atom (B False)) in case kl_V1585tt of !(kl_V1585tt@(Cons (!kl_V1585tth) (!kl_V1585ttt))) -> pat_cond_7 kl_V1585tt kl_V1585tth kl_V1585ttt _ -> pat_cond_13 case kl_if_6 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_14 = do do return (Atom (B False)) in case kl_V1585t of !(kl_V1585t@(Cons (!kl_V1585th) (!kl_V1585tt))) -> pat_cond_5 kl_V1585t kl_V1585th kl_V1585tt _ -> pat_cond_14 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_15 = do do return (Atom (B False)) in case kl_V1585h of kl_V1585h@(Atom (UnboundSym "put")) -> pat_cond_3 kl_V1585h@(ApplC (PL "put" _)) -> pat_cond_3 kl_V1585h@(ApplC (Func "put" _)) -> pat_cond_3 _ -> pat_cond_15 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_16 = do do return (Atom (B False)) in case kl_V1585 of !(kl_V1585@(Cons (!kl_V1585h) (!kl_V1585t))) -> pat_cond_1 kl_V1585 kl_V1585h kl_V1585t _ -> pat_cond_16 case kl_if_0 of Atom (B (True)) -> do !appl_17 <- kl_V1585 `pseq` tl kl_V1585 !appl_18 <- appl_17 `pseq` hd appl_17 !appl_19 <- kl_V1585 `pseq` tl kl_V1585 !appl_20 <- appl_19 `pseq` tl appl_19 !appl_21 <- appl_20 `pseq` hd appl_20 !appl_22 <- kl_V1585 `pseq` tl kl_V1585 !appl_23 <- appl_22 `pseq` tl appl_22 !appl_24 <- appl_23 `pseq` tl appl_23 !appl_25 <- appl_24 `pseq` hd appl_24 let !appl_26 = Atom Nil !appl_27 <- appl_26 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) appl_26 !appl_28 <- appl_27 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_27 let !appl_29 = Atom Nil !appl_30 <- appl_28 `pseq` (appl_29 `pseq` klCons appl_28 appl_29) !appl_31 <- appl_25 `pseq` (appl_30 `pseq` klCons appl_25 appl_30) !appl_32 <- appl_21 `pseq` (appl_31 `pseq` klCons appl_21 appl_31) !appl_33 <- appl_18 `pseq` (appl_32 `pseq` klCons appl_18 appl_32) appl_33 `pseq` klCons (ApplC (wrapNamed "put" kl_put)) appl_33 Atom (B (False)) -> do !kl_if_34 <- let pat_cond_35 kl_V1585 kl_V1585h kl_V1585t = do !kl_if_36 <- let pat_cond_37 = do !kl_if_38 <- let pat_cond_39 kl_V1585t kl_V1585th kl_V1585tt = do !kl_if_40 <- let pat_cond_41 kl_V1585tt kl_V1585tth kl_V1585ttt = do let !appl_42 = Atom Nil !kl_if_43 <- appl_42 `pseq` (kl_V1585ttt `pseq` eq appl_42 kl_V1585ttt) case kl_if_43 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_44 = do do return (Atom (B False)) in case kl_V1585tt of !(kl_V1585tt@(Cons (!kl_V1585tth) (!kl_V1585ttt))) -> pat_cond_41 kl_V1585tt kl_V1585tth kl_V1585ttt _ -> pat_cond_44 case kl_if_40 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_45 = do do return (Atom (B False)) in case kl_V1585t of !(kl_V1585t@(Cons (!kl_V1585th) (!kl_V1585tt))) -> pat_cond_39 kl_V1585t kl_V1585th kl_V1585tt _ -> pat_cond_45 case kl_if_38 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_46 = do do return (Atom (B False)) in case kl_V1585h of kl_V1585h@(Atom (UnboundSym "get")) -> pat_cond_37 kl_V1585h@(ApplC (PL "get" _)) -> pat_cond_37 kl_V1585h@(ApplC (Func "get" _)) -> pat_cond_37 _ -> pat_cond_46 case kl_if_36 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_47 = do do return (Atom (B False)) in case kl_V1585 of !(kl_V1585@(Cons (!kl_V1585h) (!kl_V1585t))) -> pat_cond_35 kl_V1585 kl_V1585h kl_V1585t _ -> pat_cond_47 case kl_if_34 of Atom (B (True)) -> do !appl_48 <- kl_V1585 `pseq` tl kl_V1585 !appl_49 <- appl_48 `pseq` hd appl_48 !appl_50 <- kl_V1585 `pseq` tl kl_V1585 !appl_51 <- appl_50 `pseq` tl appl_50 !appl_52 <- appl_51 `pseq` hd appl_51 let !appl_53 = Atom Nil !appl_54 <- appl_53 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) appl_53 !appl_55 <- appl_54 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_54 let !appl_56 = Atom Nil !appl_57 <- appl_55 `pseq` (appl_56 `pseq` klCons appl_55 appl_56) !appl_58 <- appl_52 `pseq` (appl_57 `pseq` klCons appl_52 appl_57) !appl_59 <- appl_49 `pseq` (appl_58 `pseq` klCons appl_49 appl_58) appl_59 `pseq` klCons (ApplC (wrapNamed "get" kl_get)) appl_59 Atom (B (False)) -> do !kl_if_60 <- let pat_cond_61 kl_V1585 kl_V1585h kl_V1585t = do !kl_if_62 <- let pat_cond_63 = do !kl_if_64 <- let pat_cond_65 kl_V1585t kl_V1585th kl_V1585tt = do !kl_if_66 <- let pat_cond_67 kl_V1585tt kl_V1585tth kl_V1585ttt = do !kl_if_68 <- let pat_cond_69 kl_V1585ttt kl_V1585ttth kl_V1585tttt = do let !appl_70 = Atom Nil !kl_if_71 <- appl_70 `pseq` (kl_V1585tttt `pseq` eq appl_70 kl_V1585tttt) case kl_if_71 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_72 = do do return (Atom (B False)) in case kl_V1585ttt of !(kl_V1585ttt@(Cons (!kl_V1585ttth) (!kl_V1585tttt))) -> pat_cond_69 kl_V1585ttt kl_V1585ttth kl_V1585tttt _ -> pat_cond_72 case kl_if_68 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_73 = do do return (Atom (B False)) in case kl_V1585tt of !(kl_V1585tt@(Cons (!kl_V1585tth) (!kl_V1585ttt))) -> pat_cond_67 kl_V1585tt kl_V1585tth kl_V1585ttt _ -> pat_cond_73 case kl_if_66 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_74 = do do return (Atom (B False)) in case kl_V1585t of !(kl_V1585t@(Cons (!kl_V1585th) (!kl_V1585tt))) -> pat_cond_65 kl_V1585t kl_V1585th kl_V1585tt _ -> pat_cond_74 case kl_if_64 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_75 = do do return (Atom (B False)) in case kl_V1585h of kl_V1585h@(Atom (UnboundSym "get/or")) -> pat_cond_63 kl_V1585h@(ApplC (PL "get/or" _)) -> pat_cond_63 kl_V1585h@(ApplC (Func "get/or" _)) -> pat_cond_63 _ -> pat_cond_75 case kl_if_62 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_76 = do do return (Atom (B False)) in case kl_V1585 of !(kl_V1585@(Cons (!kl_V1585h) (!kl_V1585t))) -> pat_cond_61 kl_V1585 kl_V1585h kl_V1585t _ -> pat_cond_76 case kl_if_60 of Atom (B (True)) -> do !appl_77 <- kl_V1585 `pseq` tl kl_V1585 !appl_78 <- appl_77 `pseq` hd appl_77 !appl_79 <- kl_V1585 `pseq` tl kl_V1585 !appl_80 <- appl_79 `pseq` tl appl_79 !appl_81 <- appl_80 `pseq` hd appl_80 !appl_82 <- kl_V1585 `pseq` tl kl_V1585 !appl_83 <- appl_82 `pseq` tl appl_82 !appl_84 <- appl_83 `pseq` tl appl_83 !appl_85 <- appl_84 `pseq` hd appl_84 let !appl_86 = Atom Nil !appl_87 <- appl_86 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) appl_86 !appl_88 <- appl_87 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_87 let !appl_89 = Atom Nil !appl_90 <- appl_88 `pseq` (appl_89 `pseq` klCons appl_88 appl_89) !appl_91 <- appl_85 `pseq` (appl_90 `pseq` klCons appl_85 appl_90) !appl_92 <- appl_81 `pseq` (appl_91 `pseq` klCons appl_81 appl_91) !appl_93 <- appl_78 `pseq` (appl_92 `pseq` klCons appl_78 appl_92) appl_93 `pseq` klCons (ApplC (wrapNamed "get/or" kl_getDivor)) appl_93 Atom (B (False)) -> do !kl_if_94 <- let pat_cond_95 kl_V1585 kl_V1585h kl_V1585t = do !kl_if_96 <- let pat_cond_97 = do !kl_if_98 <- let pat_cond_99 kl_V1585t kl_V1585th kl_V1585tt = do !kl_if_100 <- let pat_cond_101 kl_V1585tt kl_V1585tth kl_V1585ttt = do let !appl_102 = Atom Nil !kl_if_103 <- appl_102 `pseq` (kl_V1585ttt `pseq` eq appl_102 kl_V1585ttt) case kl_if_103 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_104 = do do return (Atom (B False)) in case kl_V1585tt of !(kl_V1585tt@(Cons (!kl_V1585tth) (!kl_V1585ttt))) -> pat_cond_101 kl_V1585tt kl_V1585tth kl_V1585ttt _ -> pat_cond_104 case kl_if_100 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_105 = do do return (Atom (B False)) in case kl_V1585t of !(kl_V1585t@(Cons (!kl_V1585th) (!kl_V1585tt))) -> pat_cond_99 kl_V1585t kl_V1585th kl_V1585tt _ -> pat_cond_105 case kl_if_98 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_106 = do do return (Atom (B False)) in case kl_V1585h of kl_V1585h@(Atom (UnboundSym "unput")) -> pat_cond_97 kl_V1585h@(ApplC (PL "unput" _)) -> pat_cond_97 kl_V1585h@(ApplC (Func "unput" _)) -> pat_cond_97 _ -> pat_cond_106 case kl_if_96 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_107 = do do return (Atom (B False)) in case kl_V1585 of !(kl_V1585@(Cons (!kl_V1585h) (!kl_V1585t))) -> pat_cond_95 kl_V1585 kl_V1585h kl_V1585t _ -> pat_cond_107 case kl_if_94 of Atom (B (True)) -> do !appl_108 <- kl_V1585 `pseq` tl kl_V1585 !appl_109 <- appl_108 `pseq` hd appl_108 !appl_110 <- kl_V1585 `pseq` tl kl_V1585 !appl_111 <- appl_110 `pseq` tl appl_110 !appl_112 <- appl_111 `pseq` hd appl_111 let !appl_113 = Atom Nil !appl_114 <- appl_113 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "*property-vector*")) appl_113 !appl_115 <- appl_114 `pseq` klCons (ApplC (wrapNamed "value" value)) appl_114 let !appl_116 = Atom Nil !appl_117 <- appl_115 `pseq` (appl_116 `pseq` klCons appl_115 appl_116) !appl_118 <- appl_112 `pseq` (appl_117 `pseq` klCons appl_112 appl_117) !appl_119 <- appl_109 `pseq` (appl_118 `pseq` klCons appl_109 appl_118) appl_119 `pseq` klCons (ApplC (wrapNamed "unput" kl_unput)) appl_119 Atom (B (False)) -> do do return kl_V1585 _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" _ -> throwError "if: expected boolean" kl_shen_function_macro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_function_macro (!kl_V1587) = do !kl_if_0 <- let pat_cond_1 kl_V1587 kl_V1587h kl_V1587t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V1587t kl_V1587th kl_V1587tt = do let !appl_6 = Atom Nil !kl_if_7 <- appl_6 `pseq` (kl_V1587tt `pseq` eq appl_6 kl_V1587tt) case kl_if_7 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_8 = do do return (Atom (B False)) in case kl_V1587t of !(kl_V1587t@(Cons (!kl_V1587th) (!kl_V1587tt))) -> pat_cond_5 kl_V1587t kl_V1587th kl_V1587tt _ -> pat_cond_8 case kl_if_4 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_9 = do do return (Atom (B False)) in case kl_V1587h of kl_V1587h@(Atom (UnboundSym "function")) -> pat_cond_3 kl_V1587h@(ApplC (PL "function" _)) -> pat_cond_3 kl_V1587h@(ApplC (Func "function" _)) -> pat_cond_3 _ -> pat_cond_9 case kl_if_2 of Atom (B (True)) -> do return (Atom (B True)) Atom (B (False)) -> do do return (Atom (B False)) _ -> throwError "if: expected boolean" pat_cond_10 = do do return (Atom (B False)) in case kl_V1587 of !(kl_V1587@(Cons (!kl_V1587h) (!kl_V1587t))) -> pat_cond_1 kl_V1587 kl_V1587h kl_V1587t _ -> pat_cond_10 case kl_if_0 of Atom (B (True)) -> do !appl_11 <- kl_V1587 `pseq` tl kl_V1587 !appl_12 <- appl_11 `pseq` hd appl_11 !appl_13 <- kl_V1587 `pseq` tl kl_V1587 !appl_14 <- appl_13 `pseq` hd appl_13 let !aw_15 = Core.Types.Atom (Core.Types.UnboundSym "arity") !appl_16 <- appl_14 `pseq` applyWrapper aw_15 [appl_14] appl_12 `pseq` (appl_16 `pseq` kl_shen_function_abstraction appl_12 appl_16) Atom (B (False)) -> do do return kl_V1587 _ -> throwError "if: expected boolean" kl_shen_function_abstraction :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_function_abstraction (!kl_V1590) (!kl_V1591) = do let pat_cond_0 = do !appl_1 <- kl_V1590 `pseq` kl_shen_app kl_V1590 (Core.Types.Atom (Core.Types.Str " has no lambda form\n")) (Core.Types.Atom (Core.Types.UnboundSym "shen.a")) appl_1 `pseq` simpleError appl_1 pat_cond_2 = do let !appl_3 = Atom Nil !appl_4 <- kl_V1590 `pseq` (appl_3 `pseq` klCons kl_V1590 appl_3) appl_4 `pseq` klCons (ApplC (wrapNamed "function" kl_function)) appl_4 pat_cond_5 = do do let !appl_6 = Atom Nil kl_V1590 `pseq` (kl_V1591 `pseq` (appl_6 `pseq` kl_shen_function_abstraction_help kl_V1590 kl_V1591 appl_6)) in case kl_V1591 of kl_V1591@(Atom (N (KI 0))) -> pat_cond_0 kl_V1591@(Atom (N (KI (-1)))) -> pat_cond_2 _ -> pat_cond_5 kl_shen_function_abstraction_help :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_function_abstraction_help (!kl_V1595) (!kl_V1596) (!kl_V1597) = do let pat_cond_0 = do kl_V1595 `pseq` (kl_V1597 `pseq` klCons kl_V1595 kl_V1597) pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_X) -> do !appl_3 <- kl_V1596 `pseq` Primitives.subtract kl_V1596 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) let !appl_4 = Atom Nil !appl_5 <- kl_X `pseq` (appl_4 `pseq` klCons kl_X appl_4) !appl_6 <- kl_V1597 `pseq` (appl_5 `pseq` kl_append kl_V1597 appl_5) !appl_7 <- kl_V1595 `pseq` (appl_3 `pseq` (appl_6 `pseq` kl_shen_function_abstraction_help kl_V1595 appl_3 appl_6)) let !appl_8 = Atom Nil !appl_9 <- appl_7 `pseq` (appl_8 `pseq` klCons appl_7 appl_8) !appl_10 <- kl_X `pseq` (appl_9 `pseq` klCons kl_X appl_9) appl_10 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "/.")) appl_10))) !appl_11 <- kl_gensym (Core.Types.Atom (Core.Types.UnboundSym "V")) appl_11 `pseq` applyWrapper appl_2 [appl_11] in case kl_V1596 of kl_V1596@(Atom (N (KI 0))) -> pat_cond_0 _ -> pat_cond_1 kl_undefmacro :: Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_undefmacro (!kl_V1599) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_MacroReg) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Pos) -> do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Remove1) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Remove2) -> do return kl_V1599))) !appl_4 <- value (Core.Types.Atom (Core.Types.UnboundSym "*macros*")) !appl_5 <- kl_Pos `pseq` (appl_4 `pseq` kl_shen_remove_nth kl_Pos appl_4) !appl_6 <- appl_5 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "*macros*")) appl_5 appl_6 `pseq` applyWrapper appl_3 [appl_6]))) !appl_7 <- kl_V1599 `pseq` (kl_MacroReg `pseq` kl_remove kl_V1599 kl_MacroReg) !appl_8 <- appl_7 `pseq` klSet (Core.Types.Atom (Core.Types.UnboundSym "shen.*macroreg*")) appl_7 appl_8 `pseq` applyWrapper appl_2 [appl_8]))) !appl_9 <- kl_V1599 `pseq` (kl_MacroReg `pseq` kl_shen_findpos kl_V1599 kl_MacroReg) appl_9 `pseq` applyWrapper appl_1 [appl_9]))) !appl_10 <- value (Core.Types.Atom (Core.Types.UnboundSym "shen.*macroreg*")) appl_10 `pseq` applyWrapper appl_0 [appl_10] kl_shen_findpos :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_findpos (!kl_V1609) (!kl_V1610) = do let !appl_0 = Atom Nil !kl_if_1 <- appl_0 `pseq` (kl_V1610 `pseq` eq appl_0 kl_V1610) case kl_if_1 of Atom (B (True)) -> do !appl_2 <- kl_V1609 `pseq` kl_shen_app kl_V1609 (Core.Types.Atom (Core.Types.Str " is not a macro\n")) (Core.Types.Atom (Core.Types.UnboundSym "shen.a")) appl_2 `pseq` simpleError appl_2 Atom (B (False)) -> do let pat_cond_3 kl_V1610 kl_V1610h kl_V1610t = do return (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) pat_cond_4 kl_V1610 kl_V1610h kl_V1610t = do !appl_5 <- kl_V1609 `pseq` (kl_V1610t `pseq` kl_shen_findpos kl_V1609 kl_V1610t) appl_5 `pseq` add (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) appl_5 pat_cond_6 = do do kl_shen_f_error (ApplC (wrapNamed "shen.findpos" kl_shen_findpos)) in case kl_V1610 of !(kl_V1610@(Cons (!kl_V1610h) (!kl_V1610t))) | eqCore kl_V1610h kl_V1609 -> pat_cond_3 kl_V1610 kl_V1610h kl_V1610t !(kl_V1610@(Cons (!kl_V1610h) (!kl_V1610t))) -> pat_cond_4 kl_V1610 kl_V1610h kl_V1610t _ -> pat_cond_6 _ -> throwError "if: expected boolean" kl_shen_remove_nth :: Core.Types.KLValue -> Core.Types.KLValue -> Core.Types.KLContext Core.Types.Env Core.Types.KLValue kl_shen_remove_nth (!kl_V1615) (!kl_V1616) = do !kl_if_0 <- let pat_cond_1 = do let pat_cond_2 kl_V1616 kl_V1616h kl_V1616t = do return (Atom (B True)) pat_cond_3 = do do return (Atom (B False)) in case kl_V1616 of !(kl_V1616@(Cons (!kl_V1616h) (!kl_V1616t))) -> pat_cond_2 kl_V1616 kl_V1616h kl_V1616t _ -> pat_cond_3 pat_cond_4 = do do return (Atom (B False)) in case kl_V1615 of kl_V1615@(Atom (N (KI 1))) -> pat_cond_1 _ -> pat_cond_4 case kl_if_0 of Atom (B (True)) -> do kl_V1616 `pseq` tl kl_V1616 Atom (B (False)) -> do let pat_cond_5 kl_V1616 kl_V1616h kl_V1616t = do !appl_6 <- kl_V1615 `pseq` Primitives.subtract kl_V1615 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) !appl_7 <- appl_6 `pseq` (kl_V1616t `pseq` kl_shen_remove_nth appl_6 kl_V1616t) kl_V1616h `pseq` (appl_7 `pseq` klCons kl_V1616h appl_7) pat_cond_8 = do do kl_shen_f_error (ApplC (wrapNamed "shen.remove-nth" kl_shen_remove_nth)) in case kl_V1616 of !(kl_V1616@(Cons (!kl_V1616h) (!kl_V1616t))) -> pat_cond_5 kl_V1616 kl_V1616h kl_V1616t _ -> pat_cond_8 _ -> throwError "if: expected boolean" expr10 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue expr10 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E")))