shentong-0.3.2: Shentong/Backend/Writer.hs
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE ViewPatterns #-}
module Backend.Writer where
import Control.Monad.Except
import Control.Parallel
import Environment
import Core.Primitives as Primitives
import Backend.Utils
import Core.Types
import Core.Utils
import Wrap
import Backend.Toplevel
import Backend.Core
import Backend.Sys
import Backend.Sequent
import Backend.Yacc
import Backend.Reader
import Backend.Prolog
import Backend.Track
import Backend.Load
{-
Copyright (c) 2015, Mark Tarver
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. The name of Mark Tarver may not be used to endorse or promote products
derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY
EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
kl_pr :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_pr (!kl_V4012) (!kl_V4013) = do (do kl_V4012 `pseq` (kl_V4013 `pseq` kl_shen_prh kl_V4012 kl_V4013 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))))) `catchError` (\(!kl_E) -> do return kl_V4012)
kl_shen_prh :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_prh (!kl_V4017) (!kl_V4018) (!kl_V4019) = do !appl_0 <- kl_V4017 `pseq` (kl_V4018 `pseq` (kl_V4019 `pseq` kl_shen_write_char_and_inc kl_V4017 kl_V4018 kl_V4019))
kl_V4017 `pseq` (kl_V4018 `pseq` (appl_0 `pseq` kl_shen_prh kl_V4017 kl_V4018 appl_0))
kl_shen_write_char_and_inc :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_write_char_and_inc (!kl_V4023) (!kl_V4024) (!kl_V4025) = do !appl_0 <- kl_V4023 `pseq` (kl_V4025 `pseq` pos kl_V4023 kl_V4025)
!appl_1 <- appl_0 `pseq` stringToN appl_0
!appl_2 <- appl_1 `pseq` (kl_V4024 `pseq` writeByte appl_1 kl_V4024)
!appl_3 <- kl_V4025 `pseq` add kl_V4025 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1)))
appl_2 `pseq` (appl_3 `pseq` kl_do appl_2 appl_3)
kl_print :: Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_print (!kl_V4027) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_String) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Print) -> do return kl_V4027)))
!appl_2 <- kl_stoutput
!appl_3 <- kl_String `pseq` (appl_2 `pseq` kl_shen_prhush kl_String appl_2)
appl_3 `pseq` applyWrapper appl_1 [appl_3])))
!appl_4 <- kl_V4027 `pseq` kl_shen_insert kl_V4027 (Core.Types.Atom (Core.Types.Str "~S"))
appl_4 `pseq` applyWrapper appl_0 [appl_4]
kl_shen_prhush :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_prhush (!kl_V4030) (!kl_V4031) = do !kl_if_0 <- value (Core.Types.Atom (Core.Types.UnboundSym "*hush*"))
case kl_if_0 of
Atom (B (True)) -> do return kl_V4030
Atom (B (False)) -> do do kl_V4030 `pseq` (kl_V4031 `pseq` kl_pr kl_V4030 kl_V4031)
_ -> throwError "if: expected boolean"
kl_shen_mkstr :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_mkstr (!kl_V4034) (!kl_V4035) = do !kl_if_0 <- kl_V4034 `pseq` stringP kl_V4034
case kl_if_0 of
Atom (B (True)) -> do !appl_1 <- kl_V4034 `pseq` kl_shen_proc_nl kl_V4034
appl_1 `pseq` (kl_V4035 `pseq` kl_shen_mkstr_l appl_1 kl_V4035)
Atom (B (False)) -> do do let !appl_2 = Atom Nil
!appl_3 <- kl_V4034 `pseq` (appl_2 `pseq` klCons kl_V4034 appl_2)
!appl_4 <- appl_3 `pseq` klCons (ApplC (wrapNamed "shen.proc-nl" kl_shen_proc_nl)) appl_3
appl_4 `pseq` (kl_V4035 `pseq` kl_shen_mkstr_r appl_4 kl_V4035)
_ -> throwError "if: expected boolean"
kl_shen_mkstr_l :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_mkstr_l (!kl_V4038) (!kl_V4039) = do let !appl_0 = Atom Nil
!kl_if_1 <- appl_0 `pseq` (kl_V4039 `pseq` eq appl_0 kl_V4039)
case kl_if_1 of
Atom (B (True)) -> do return kl_V4038
Atom (B (False)) -> do let pat_cond_2 kl_V4039 kl_V4039h kl_V4039t = do !appl_3 <- kl_V4039h `pseq` (kl_V4038 `pseq` kl_shen_insert_l kl_V4039h kl_V4038)
appl_3 `pseq` (kl_V4039t `pseq` kl_shen_mkstr_l appl_3 kl_V4039t)
pat_cond_4 = do do kl_shen_f_error (ApplC (wrapNamed "shen.mkstr-l" kl_shen_mkstr_l))
in case kl_V4039 of
!(kl_V4039@(Cons (!kl_V4039h)
(!kl_V4039t))) -> pat_cond_2 kl_V4039 kl_V4039h kl_V4039t
_ -> pat_cond_4
_ -> throwError "if: expected boolean"
kl_shen_insert_l :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_insert_l (!kl_V4044) (!kl_V4045) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.Str ""))
pat_cond_1 = do !kl_if_2 <- kl_V4045 `pseq` kl_shen_PlusstringP kl_V4045
!kl_if_3 <- case kl_if_2 of
Atom (B (True)) -> do !appl_4 <- kl_V4045 `pseq` pos kl_V4045 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_4
!kl_if_6 <- case kl_if_5 of
Atom (B (True)) -> do !appl_7 <- kl_V4045 `pseq` tlstr kl_V4045
!kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7
!kl_if_9 <- case kl_if_8 of
Atom (B (True)) -> do !appl_10 <- kl_V4045 `pseq` tlstr kl_V4045
!appl_11 <- appl_10 `pseq` pos appl_10 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_12 <- appl_11 `pseq` eq (Core.Types.Atom (Core.Types.Str "A")) appl_11
case kl_if_12 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_9 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_6 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_3 of
Atom (B (True)) -> do !appl_13 <- kl_V4045 `pseq` tlstr kl_V4045
!appl_14 <- appl_13 `pseq` tlstr appl_13
let !appl_15 = Atom Nil
!appl_16 <- appl_15 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.a")) appl_15
!appl_17 <- appl_14 `pseq` (appl_16 `pseq` klCons appl_14 appl_16)
!appl_18 <- kl_V4044 `pseq` (appl_17 `pseq` klCons kl_V4044 appl_17)
appl_18 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_18
Atom (B (False)) -> do !kl_if_19 <- kl_V4045 `pseq` kl_shen_PlusstringP kl_V4045
!kl_if_20 <- case kl_if_19 of
Atom (B (True)) -> do !appl_21 <- kl_V4045 `pseq` pos kl_V4045 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_22 <- appl_21 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_21
!kl_if_23 <- case kl_if_22 of
Atom (B (True)) -> do !appl_24 <- kl_V4045 `pseq` tlstr kl_V4045
!kl_if_25 <- appl_24 `pseq` kl_shen_PlusstringP appl_24
!kl_if_26 <- case kl_if_25 of
Atom (B (True)) -> do !appl_27 <- kl_V4045 `pseq` tlstr kl_V4045
!appl_28 <- appl_27 `pseq` pos appl_27 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_29 <- appl_28 `pseq` eq (Core.Types.Atom (Core.Types.Str "R")) appl_28
case kl_if_29 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_26 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_23 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_20 of
Atom (B (True)) -> do !appl_30 <- kl_V4045 `pseq` tlstr kl_V4045
!appl_31 <- appl_30 `pseq` tlstr appl_30
let !appl_32 = Atom Nil
!appl_33 <- appl_32 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.r")) appl_32
!appl_34 <- appl_31 `pseq` (appl_33 `pseq` klCons appl_31 appl_33)
!appl_35 <- kl_V4044 `pseq` (appl_34 `pseq` klCons kl_V4044 appl_34)
appl_35 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_35
Atom (B (False)) -> do !kl_if_36 <- kl_V4045 `pseq` kl_shen_PlusstringP kl_V4045
!kl_if_37 <- case kl_if_36 of
Atom (B (True)) -> do !appl_38 <- kl_V4045 `pseq` pos kl_V4045 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_39 <- appl_38 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_38
!kl_if_40 <- case kl_if_39 of
Atom (B (True)) -> do !appl_41 <- kl_V4045 `pseq` tlstr kl_V4045
!kl_if_42 <- appl_41 `pseq` kl_shen_PlusstringP appl_41
!kl_if_43 <- case kl_if_42 of
Atom (B (True)) -> do !appl_44 <- kl_V4045 `pseq` tlstr kl_V4045
!appl_45 <- appl_44 `pseq` pos appl_44 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_46 <- appl_45 `pseq` eq (Core.Types.Atom (Core.Types.Str "S")) appl_45
case kl_if_46 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_43 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_40 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_37 of
Atom (B (True)) -> do !appl_47 <- kl_V4045 `pseq` tlstr kl_V4045
!appl_48 <- appl_47 `pseq` tlstr appl_47
let !appl_49 = Atom Nil
!appl_50 <- appl_49 `pseq` klCons (Core.Types.Atom (Core.Types.UnboundSym "shen.s")) appl_49
!appl_51 <- appl_48 `pseq` (appl_50 `pseq` klCons appl_48 appl_50)
!appl_52 <- kl_V4044 `pseq` (appl_51 `pseq` klCons kl_V4044 appl_51)
appl_52 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_52
Atom (B (False)) -> do !kl_if_53 <- kl_V4045 `pseq` kl_shen_PlusstringP kl_V4045
case kl_if_53 of
Atom (B (True)) -> do !appl_54 <- kl_V4045 `pseq` pos kl_V4045 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!appl_55 <- kl_V4045 `pseq` tlstr kl_V4045
!appl_56 <- kl_V4044 `pseq` (appl_55 `pseq` kl_shen_insert_l kl_V4044 appl_55)
let !appl_57 = Atom Nil
!appl_58 <- appl_56 `pseq` (appl_57 `pseq` klCons appl_56 appl_57)
!appl_59 <- appl_54 `pseq` (appl_58 `pseq` klCons appl_54 appl_58)
!appl_60 <- appl_59 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_59
appl_60 `pseq` kl_shen_factor_cn appl_60
Atom (B (False)) -> do !kl_if_61 <- let pat_cond_62 kl_V4045 kl_V4045h kl_V4045t = do !kl_if_63 <- let pat_cond_64 = do !kl_if_65 <- let pat_cond_66 kl_V4045t kl_V4045th kl_V4045tt = do !kl_if_67 <- let pat_cond_68 kl_V4045tt kl_V4045tth kl_V4045ttt = do let !appl_69 = Atom Nil
!kl_if_70 <- appl_69 `pseq` (kl_V4045ttt `pseq` eq appl_69 kl_V4045ttt)
case kl_if_70 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_71 = do do return (Atom (B False))
in case kl_V4045tt of
!(kl_V4045tt@(Cons (!kl_V4045tth)
(!kl_V4045ttt))) -> pat_cond_68 kl_V4045tt kl_V4045tth kl_V4045ttt
_ -> pat_cond_71
case kl_if_67 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_72 = do do return (Atom (B False))
in case kl_V4045t of
!(kl_V4045t@(Cons (!kl_V4045th)
(!kl_V4045tt))) -> pat_cond_66 kl_V4045t kl_V4045th kl_V4045tt
_ -> pat_cond_72
case kl_if_65 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_73 = do do return (Atom (B False))
in case kl_V4045h of
kl_V4045h@(Atom (UnboundSym "cn")) -> pat_cond_64
kl_V4045h@(ApplC (PL "cn"
_)) -> pat_cond_64
kl_V4045h@(ApplC (Func "cn"
_)) -> pat_cond_64
_ -> pat_cond_73
case kl_if_63 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_74 = do do return (Atom (B False))
in case kl_V4045 of
!(kl_V4045@(Cons (!kl_V4045h)
(!kl_V4045t))) -> pat_cond_62 kl_V4045 kl_V4045h kl_V4045t
_ -> pat_cond_74
case kl_if_61 of
Atom (B (True)) -> do !appl_75 <- kl_V4045 `pseq` tl kl_V4045
!appl_76 <- appl_75 `pseq` hd appl_75
!appl_77 <- kl_V4045 `pseq` tl kl_V4045
!appl_78 <- appl_77 `pseq` tl appl_77
!appl_79 <- appl_78 `pseq` hd appl_78
!appl_80 <- kl_V4044 `pseq` (appl_79 `pseq` kl_shen_insert_l kl_V4044 appl_79)
let !appl_81 = Atom Nil
!appl_82 <- appl_80 `pseq` (appl_81 `pseq` klCons appl_80 appl_81)
!appl_83 <- appl_76 `pseq` (appl_82 `pseq` klCons appl_76 appl_82)
appl_83 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_83
Atom (B (False)) -> do !kl_if_84 <- let pat_cond_85 kl_V4045 kl_V4045h kl_V4045t = do !kl_if_86 <- let pat_cond_87 = do !kl_if_88 <- let pat_cond_89 kl_V4045t kl_V4045th kl_V4045tt = do !kl_if_90 <- let pat_cond_91 kl_V4045tt kl_V4045tth kl_V4045ttt = do !kl_if_92 <- let pat_cond_93 kl_V4045ttt kl_V4045ttth kl_V4045tttt = do let !appl_94 = Atom Nil
!kl_if_95 <- appl_94 `pseq` (kl_V4045tttt `pseq` eq appl_94 kl_V4045tttt)
case kl_if_95 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_96 = do do return (Atom (B False))
in case kl_V4045ttt of
!(kl_V4045ttt@(Cons (!kl_V4045ttth)
(!kl_V4045tttt))) -> pat_cond_93 kl_V4045ttt kl_V4045ttth kl_V4045tttt
_ -> pat_cond_96
case kl_if_92 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_97 = do do return (Atom (B False))
in case kl_V4045tt of
!(kl_V4045tt@(Cons (!kl_V4045tth)
(!kl_V4045ttt))) -> pat_cond_91 kl_V4045tt kl_V4045tth kl_V4045ttt
_ -> pat_cond_97
case kl_if_90 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_98 = do do return (Atom (B False))
in case kl_V4045t of
!(kl_V4045t@(Cons (!kl_V4045th)
(!kl_V4045tt))) -> pat_cond_89 kl_V4045t kl_V4045th kl_V4045tt
_ -> pat_cond_98
case kl_if_88 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_99 = do do return (Atom (B False))
in case kl_V4045h of
kl_V4045h@(Atom (UnboundSym "shen.app")) -> pat_cond_87
kl_V4045h@(ApplC (PL "shen.app"
_)) -> pat_cond_87
kl_V4045h@(ApplC (Func "shen.app"
_)) -> pat_cond_87
_ -> pat_cond_99
case kl_if_86 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_100 = do do return (Atom (B False))
in case kl_V4045 of
!(kl_V4045@(Cons (!kl_V4045h)
(!kl_V4045t))) -> pat_cond_85 kl_V4045 kl_V4045h kl_V4045t
_ -> pat_cond_100
case kl_if_84 of
Atom (B (True)) -> do !appl_101 <- kl_V4045 `pseq` tl kl_V4045
!appl_102 <- appl_101 `pseq` hd appl_101
!appl_103 <- kl_V4045 `pseq` tl kl_V4045
!appl_104 <- appl_103 `pseq` tl appl_103
!appl_105 <- appl_104 `pseq` hd appl_104
!appl_106 <- kl_V4044 `pseq` (appl_105 `pseq` kl_shen_insert_l kl_V4044 appl_105)
!appl_107 <- kl_V4045 `pseq` tl kl_V4045
!appl_108 <- appl_107 `pseq` tl appl_107
!appl_109 <- appl_108 `pseq` tl appl_108
!appl_110 <- appl_106 `pseq` (appl_109 `pseq` klCons appl_106 appl_109)
!appl_111 <- appl_102 `pseq` (appl_110 `pseq` klCons appl_102 appl_110)
appl_111 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_111
Atom (B (False)) -> do do kl_shen_f_error (ApplC (wrapNamed "shen.insert-l" kl_shen_insert_l))
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
in case kl_V4045 of
kl_V4045@(Atom (Str "")) -> pat_cond_0
_ -> pat_cond_1
kl_shen_factor_cn :: Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_factor_cn (!kl_V4047) = do !kl_if_0 <- let pat_cond_1 kl_V4047 kl_V4047h kl_V4047t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V4047t kl_V4047th kl_V4047tt = do !kl_if_6 <- let pat_cond_7 kl_V4047tt kl_V4047tth kl_V4047ttt = do !kl_if_8 <- let pat_cond_9 kl_V4047tth kl_V4047tthh kl_V4047ttht = do !kl_if_10 <- let pat_cond_11 = do !kl_if_12 <- let pat_cond_13 kl_V4047ttht kl_V4047tthth kl_V4047tthtt = do !kl_if_14 <- let pat_cond_15 kl_V4047tthtt kl_V4047tthtth kl_V4047tthttt = do let !appl_16 = Atom Nil
!kl_if_17 <- appl_16 `pseq` (kl_V4047tthttt `pseq` eq appl_16 kl_V4047tthttt)
!kl_if_18 <- case kl_if_17 of
Atom (B (True)) -> do let !appl_19 = Atom Nil
!kl_if_20 <- appl_19 `pseq` (kl_V4047ttt `pseq` eq appl_19 kl_V4047ttt)
!kl_if_21 <- case kl_if_20 of
Atom (B (True)) -> do !kl_if_22 <- kl_V4047th `pseq` stringP kl_V4047th
!kl_if_23 <- case kl_if_22 of
Atom (B (True)) -> do !kl_if_24 <- kl_V4047tthth `pseq` stringP kl_V4047tthth
case kl_if_24 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_23 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_21 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_18 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_25 = do do return (Atom (B False))
in case kl_V4047tthtt of
!(kl_V4047tthtt@(Cons (!kl_V4047tthtth)
(!kl_V4047tthttt))) -> pat_cond_15 kl_V4047tthtt kl_V4047tthtth kl_V4047tthttt
_ -> pat_cond_25
case kl_if_14 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_26 = do do return (Atom (B False))
in case kl_V4047ttht of
!(kl_V4047ttht@(Cons (!kl_V4047tthth)
(!kl_V4047tthtt))) -> pat_cond_13 kl_V4047ttht kl_V4047tthth kl_V4047tthtt
_ -> pat_cond_26
case kl_if_12 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_27 = do do return (Atom (B False))
in case kl_V4047tthh of
kl_V4047tthh@(Atom (UnboundSym "cn")) -> pat_cond_11
kl_V4047tthh@(ApplC (PL "cn"
_)) -> pat_cond_11
kl_V4047tthh@(ApplC (Func "cn"
_)) -> pat_cond_11
_ -> pat_cond_27
case kl_if_10 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_28 = do do return (Atom (B False))
in case kl_V4047tth of
!(kl_V4047tth@(Cons (!kl_V4047tthh)
(!kl_V4047ttht))) -> pat_cond_9 kl_V4047tth kl_V4047tthh kl_V4047ttht
_ -> pat_cond_28
case kl_if_8 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_29 = do do return (Atom (B False))
in case kl_V4047tt of
!(kl_V4047tt@(Cons (!kl_V4047tth)
(!kl_V4047ttt))) -> pat_cond_7 kl_V4047tt kl_V4047tth kl_V4047ttt
_ -> pat_cond_29
case kl_if_6 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_30 = do do return (Atom (B False))
in case kl_V4047t of
!(kl_V4047t@(Cons (!kl_V4047th)
(!kl_V4047tt))) -> pat_cond_5 kl_V4047t kl_V4047th kl_V4047tt
_ -> pat_cond_30
case kl_if_4 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_31 = do do return (Atom (B False))
in case kl_V4047h of
kl_V4047h@(Atom (UnboundSym "cn")) -> pat_cond_3
kl_V4047h@(ApplC (PL "cn"
_)) -> pat_cond_3
kl_V4047h@(ApplC (Func "cn"
_)) -> pat_cond_3
_ -> pat_cond_31
case kl_if_2 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_32 = do do return (Atom (B False))
in case kl_V4047 of
!(kl_V4047@(Cons (!kl_V4047h)
(!kl_V4047t))) -> pat_cond_1 kl_V4047 kl_V4047h kl_V4047t
_ -> pat_cond_32
case kl_if_0 of
Atom (B (True)) -> do !appl_33 <- kl_V4047 `pseq` tl kl_V4047
!appl_34 <- appl_33 `pseq` hd appl_33
!appl_35 <- kl_V4047 `pseq` tl kl_V4047
!appl_36 <- appl_35 `pseq` tl appl_35
!appl_37 <- appl_36 `pseq` hd appl_36
!appl_38 <- appl_37 `pseq` tl appl_37
!appl_39 <- appl_38 `pseq` hd appl_38
!appl_40 <- appl_34 `pseq` (appl_39 `pseq` cn appl_34 appl_39)
!appl_41 <- kl_V4047 `pseq` tl kl_V4047
!appl_42 <- appl_41 `pseq` tl appl_41
!appl_43 <- appl_42 `pseq` hd appl_42
!appl_44 <- appl_43 `pseq` tl appl_43
!appl_45 <- appl_44 `pseq` tl appl_44
!appl_46 <- appl_40 `pseq` (appl_45 `pseq` klCons appl_40 appl_45)
appl_46 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_46
Atom (B (False)) -> do do return kl_V4047
_ -> throwError "if: expected boolean"
kl_shen_proc_nl :: Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_proc_nl (!kl_V4049) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.Str ""))
pat_cond_1 = do !kl_if_2 <- kl_V4049 `pseq` kl_shen_PlusstringP kl_V4049
!kl_if_3 <- case kl_if_2 of
Atom (B (True)) -> do !appl_4 <- kl_V4049 `pseq` pos kl_V4049 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_4
!kl_if_6 <- case kl_if_5 of
Atom (B (True)) -> do !appl_7 <- kl_V4049 `pseq` tlstr kl_V4049
!kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7
!kl_if_9 <- case kl_if_8 of
Atom (B (True)) -> do !appl_10 <- kl_V4049 `pseq` tlstr kl_V4049
!appl_11 <- appl_10 `pseq` pos appl_10 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_12 <- appl_11 `pseq` eq (Core.Types.Atom (Core.Types.Str "%")) appl_11
case kl_if_12 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_9 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_6 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_3 of
Atom (B (True)) -> do !appl_13 <- nToString (Core.Types.Atom (Core.Types.N (Core.Types.KI 10)))
!appl_14 <- kl_V4049 `pseq` tlstr kl_V4049
!appl_15 <- appl_14 `pseq` tlstr appl_14
!appl_16 <- appl_15 `pseq` kl_shen_proc_nl appl_15
appl_13 `pseq` (appl_16 `pseq` cn appl_13 appl_16)
Atom (B (False)) -> do !kl_if_17 <- kl_V4049 `pseq` kl_shen_PlusstringP kl_V4049
case kl_if_17 of
Atom (B (True)) -> do !appl_18 <- kl_V4049 `pseq` pos kl_V4049 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!appl_19 <- kl_V4049 `pseq` tlstr kl_V4049
!appl_20 <- appl_19 `pseq` kl_shen_proc_nl appl_19
appl_18 `pseq` (appl_20 `pseq` cn appl_18 appl_20)
Atom (B (False)) -> do do kl_shen_f_error (ApplC (wrapNamed "shen.proc-nl" kl_shen_proc_nl))
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
in case kl_V4049 of
kl_V4049@(Atom (Str "")) -> pat_cond_0
_ -> pat_cond_1
kl_shen_mkstr_r :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_mkstr_r (!kl_V4052) (!kl_V4053) = do let !appl_0 = Atom Nil
!kl_if_1 <- appl_0 `pseq` (kl_V4053 `pseq` eq appl_0 kl_V4053)
case kl_if_1 of
Atom (B (True)) -> do return kl_V4052
Atom (B (False)) -> do let pat_cond_2 kl_V4053 kl_V4053h kl_V4053t = do let !appl_3 = Atom Nil
!appl_4 <- kl_V4052 `pseq` (appl_3 `pseq` klCons kl_V4052 appl_3)
!appl_5 <- kl_V4053h `pseq` (appl_4 `pseq` klCons kl_V4053h appl_4)
!appl_6 <- appl_5 `pseq` klCons (ApplC (wrapNamed "shen.insert" kl_shen_insert)) appl_5
appl_6 `pseq` (kl_V4053t `pseq` kl_shen_mkstr_r appl_6 kl_V4053t)
pat_cond_7 = do do kl_shen_f_error (ApplC (wrapNamed "shen.mkstr-r" kl_shen_mkstr_r))
in case kl_V4053 of
!(kl_V4053@(Cons (!kl_V4053h)
(!kl_V4053t))) -> pat_cond_2 kl_V4053 kl_V4053h kl_V4053t
_ -> pat_cond_7
_ -> throwError "if: expected boolean"
kl_shen_insert :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_insert (!kl_V4056) (!kl_V4057) = do kl_V4056 `pseq` (kl_V4057 `pseq` kl_shen_insert_h kl_V4056 kl_V4057 (Core.Types.Atom (Core.Types.Str "")))
kl_shen_insert_h :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_insert_h (!kl_V4063) (!kl_V4064) (!kl_V4065) = do let pat_cond_0 = do return kl_V4065
pat_cond_1 = do !kl_if_2 <- kl_V4064 `pseq` kl_shen_PlusstringP kl_V4064
!kl_if_3 <- case kl_if_2 of
Atom (B (True)) -> do !appl_4 <- kl_V4064 `pseq` pos kl_V4064 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_5 <- appl_4 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_4
!kl_if_6 <- case kl_if_5 of
Atom (B (True)) -> do !appl_7 <- kl_V4064 `pseq` tlstr kl_V4064
!kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7
!kl_if_9 <- case kl_if_8 of
Atom (B (True)) -> do !appl_10 <- kl_V4064 `pseq` tlstr kl_V4064
!appl_11 <- appl_10 `pseq` pos appl_10 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_12 <- appl_11 `pseq` eq (Core.Types.Atom (Core.Types.Str "A")) appl_11
case kl_if_12 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_9 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_6 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_3 of
Atom (B (True)) -> do !appl_13 <- kl_V4064 `pseq` tlstr kl_V4064
!appl_14 <- appl_13 `pseq` tlstr appl_13
!appl_15 <- kl_V4063 `pseq` (appl_14 `pseq` kl_shen_app kl_V4063 appl_14 (Core.Types.Atom (Core.Types.UnboundSym "shen.a")))
kl_V4065 `pseq` (appl_15 `pseq` cn kl_V4065 appl_15)
Atom (B (False)) -> do !kl_if_16 <- kl_V4064 `pseq` kl_shen_PlusstringP kl_V4064
!kl_if_17 <- case kl_if_16 of
Atom (B (True)) -> do !appl_18 <- kl_V4064 `pseq` pos kl_V4064 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_19 <- appl_18 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_18
!kl_if_20 <- case kl_if_19 of
Atom (B (True)) -> do !appl_21 <- kl_V4064 `pseq` tlstr kl_V4064
!kl_if_22 <- appl_21 `pseq` kl_shen_PlusstringP appl_21
!kl_if_23 <- case kl_if_22 of
Atom (B (True)) -> do !appl_24 <- kl_V4064 `pseq` tlstr kl_V4064
!appl_25 <- appl_24 `pseq` pos appl_24 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_26 <- appl_25 `pseq` eq (Core.Types.Atom (Core.Types.Str "R")) appl_25
case kl_if_26 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_23 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_20 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_17 of
Atom (B (True)) -> do !appl_27 <- kl_V4064 `pseq` tlstr kl_V4064
!appl_28 <- appl_27 `pseq` tlstr appl_27
!appl_29 <- kl_V4063 `pseq` (appl_28 `pseq` kl_shen_app kl_V4063 appl_28 (Core.Types.Atom (Core.Types.UnboundSym "shen.r")))
kl_V4065 `pseq` (appl_29 `pseq` cn kl_V4065 appl_29)
Atom (B (False)) -> do !kl_if_30 <- kl_V4064 `pseq` kl_shen_PlusstringP kl_V4064
!kl_if_31 <- case kl_if_30 of
Atom (B (True)) -> do !appl_32 <- kl_V4064 `pseq` pos kl_V4064 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_33 <- appl_32 `pseq` eq (Core.Types.Atom (Core.Types.Str "~")) appl_32
!kl_if_34 <- case kl_if_33 of
Atom (B (True)) -> do !appl_35 <- kl_V4064 `pseq` tlstr kl_V4064
!kl_if_36 <- appl_35 `pseq` kl_shen_PlusstringP appl_35
!kl_if_37 <- case kl_if_36 of
Atom (B (True)) -> do !appl_38 <- kl_V4064 `pseq` tlstr kl_V4064
!appl_39 <- appl_38 `pseq` pos appl_38 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!kl_if_40 <- appl_39 `pseq` eq (Core.Types.Atom (Core.Types.Str "S")) appl_39
case kl_if_40 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_37 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_34 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_31 of
Atom (B (True)) -> do !appl_41 <- kl_V4064 `pseq` tlstr kl_V4064
!appl_42 <- appl_41 `pseq` tlstr appl_41
!appl_43 <- kl_V4063 `pseq` (appl_42 `pseq` kl_shen_app kl_V4063 appl_42 (Core.Types.Atom (Core.Types.UnboundSym "shen.s")))
kl_V4065 `pseq` (appl_43 `pseq` cn kl_V4065 appl_43)
Atom (B (False)) -> do !kl_if_44 <- kl_V4064 `pseq` kl_shen_PlusstringP kl_V4064
case kl_if_44 of
Atom (B (True)) -> do !appl_45 <- kl_V4064 `pseq` tlstr kl_V4064
!appl_46 <- kl_V4064 `pseq` pos kl_V4064 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!appl_47 <- kl_V4065 `pseq` (appl_46 `pseq` cn kl_V4065 appl_46)
kl_V4063 `pseq` (appl_45 `pseq` (appl_47 `pseq` kl_shen_insert_h kl_V4063 appl_45 appl_47))
Atom (B (False)) -> do do kl_shen_f_error (ApplC (wrapNamed "shen.insert-h" kl_shen_insert_h))
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
in case kl_V4064 of
kl_V4064@(Atom (Str "")) -> pat_cond_0
_ -> pat_cond_1
kl_shen_app :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_app (!kl_V4069) (!kl_V4070) (!kl_V4071) = do !appl_0 <- kl_V4069 `pseq` (kl_V4071 `pseq` kl_shen_arg_RBstr kl_V4069 kl_V4071)
appl_0 `pseq` (kl_V4070 `pseq` cn appl_0 kl_V4070)
kl_shen_arg_RBstr :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_arg_RBstr (!kl_V4079) (!kl_V4080) = do !appl_0 <- kl_fail
!kl_if_1 <- kl_V4079 `pseq` (appl_0 `pseq` eq kl_V4079 appl_0)
case kl_if_1 of
Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.Str "..."))
Atom (B (False)) -> do !kl_if_2 <- kl_V4079 `pseq` kl_shen_listP kl_V4079
case kl_if_2 of
Atom (B (True)) -> do kl_V4079 `pseq` (kl_V4080 `pseq` kl_shen_list_RBstr kl_V4079 kl_V4080)
Atom (B (False)) -> do !kl_if_3 <- kl_V4079 `pseq` stringP kl_V4079
case kl_if_3 of
Atom (B (True)) -> do kl_V4079 `pseq` (kl_V4080 `pseq` kl_shen_str_RBstr kl_V4079 kl_V4080)
Atom (B (False)) -> do !kl_if_4 <- kl_V4079 `pseq` absvectorP kl_V4079
case kl_if_4 of
Atom (B (True)) -> do kl_V4079 `pseq` (kl_V4080 `pseq` kl_shen_vector_RBstr kl_V4079 kl_V4080)
Atom (B (False)) -> do do kl_V4079 `pseq` kl_shen_atom_RBstr kl_V4079
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
kl_shen_list_RBstr :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_list_RBstr (!kl_V4083) (!kl_V4084) = do let pat_cond_0 = do !appl_1 <- kl_shen_maxseq
!appl_2 <- kl_V4083 `pseq` (appl_1 `pseq` kl_shen_iter_list kl_V4083 (Core.Types.Atom (Core.Types.UnboundSym "shen.r")) appl_1)
!appl_3 <- appl_2 `pseq` kl_Ats appl_2 (Core.Types.Atom (Core.Types.Str ")"))
appl_3 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "(")) appl_3
pat_cond_4 = do do !appl_5 <- kl_shen_maxseq
!appl_6 <- kl_V4083 `pseq` (kl_V4084 `pseq` (appl_5 `pseq` kl_shen_iter_list kl_V4083 kl_V4084 appl_5))
!appl_7 <- appl_6 `pseq` kl_Ats appl_6 (Core.Types.Atom (Core.Types.Str "]"))
appl_7 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "[")) appl_7
in case kl_V4084 of
kl_V4084@(Atom (UnboundSym "shen.r")) -> pat_cond_0
kl_V4084@(ApplC (PL "shen.r"
_)) -> pat_cond_0
kl_V4084@(ApplC (Func "shen.r"
_)) -> pat_cond_0
_ -> pat_cond_4
kl_shen_maxseq :: Core.Types.KLContext Core.Types.Env
Core.Types.KLValue
kl_shen_maxseq = do value (Core.Types.Atom (Core.Types.UnboundSym "*maximum-print-sequence-size*"))
kl_shen_iter_list :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_iter_list (!kl_V4098) (!kl_V4099) (!kl_V4100) = do let !appl_0 = Atom Nil
!kl_if_1 <- appl_0 `pseq` (kl_V4098 `pseq` eq appl_0 kl_V4098)
case kl_if_1 of
Atom (B (True)) -> do return (Core.Types.Atom (Core.Types.Str ""))
Atom (B (False)) -> do let pat_cond_2 = do return (Core.Types.Atom (Core.Types.Str "... etc"))
pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V4098 kl_V4098h kl_V4098t = do let !appl_6 = Atom Nil
!kl_if_7 <- appl_6 `pseq` (kl_V4098t `pseq` eq appl_6 kl_V4098t)
case kl_if_7 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_8 = do do return (Atom (B False))
in case kl_V4098 of
!(kl_V4098@(Cons (!kl_V4098h)
(!kl_V4098t))) -> pat_cond_5 kl_V4098 kl_V4098h kl_V4098t
_ -> pat_cond_8
case kl_if_4 of
Atom (B (True)) -> do !appl_9 <- kl_V4098 `pseq` hd kl_V4098
appl_9 `pseq` (kl_V4099 `pseq` kl_shen_arg_RBstr appl_9 kl_V4099)
Atom (B (False)) -> do let pat_cond_10 kl_V4098 kl_V4098h kl_V4098t = do !appl_11 <- kl_V4098h `pseq` (kl_V4099 `pseq` kl_shen_arg_RBstr kl_V4098h kl_V4099)
!appl_12 <- kl_V4100 `pseq` Primitives.subtract kl_V4100 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1)))
!appl_13 <- kl_V4098t `pseq` (kl_V4099 `pseq` (appl_12 `pseq` kl_shen_iter_list kl_V4098t kl_V4099 appl_12))
!appl_14 <- appl_13 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str " ")) appl_13
appl_11 `pseq` (appl_14 `pseq` kl_Ats appl_11 appl_14)
pat_cond_15 = do do !appl_16 <- kl_V4098 `pseq` (kl_V4099 `pseq` kl_shen_arg_RBstr kl_V4098 kl_V4099)
!appl_17 <- appl_16 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str " ")) appl_16
appl_17 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "|")) appl_17
in case kl_V4098 of
!(kl_V4098@(Cons (!kl_V4098h)
(!kl_V4098t))) -> pat_cond_10 kl_V4098 kl_V4098h kl_V4098t
_ -> pat_cond_15
_ -> throwError "if: expected boolean"
in case kl_V4100 of
kl_V4100@(Atom (N (KI 0))) -> pat_cond_2
_ -> pat_cond_3
_ -> throwError "if: expected boolean"
kl_shen_str_RBstr :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_str_RBstr (!kl_V4107) (!kl_V4108) = do let pat_cond_0 = do return kl_V4107
pat_cond_1 = do do !appl_2 <- nToString (Core.Types.Atom (Core.Types.N (Core.Types.KI 34)))
!appl_3 <- nToString (Core.Types.Atom (Core.Types.N (Core.Types.KI 34)))
!appl_4 <- kl_V4107 `pseq` (appl_3 `pseq` kl_Ats kl_V4107 appl_3)
appl_2 `pseq` (appl_4 `pseq` kl_Ats appl_2 appl_4)
in case kl_V4108 of
kl_V4108@(Atom (UnboundSym "shen.a")) -> pat_cond_0
kl_V4108@(ApplC (PL "shen.a"
_)) -> pat_cond_0
kl_V4108@(ApplC (Func "shen.a"
_)) -> pat_cond_0
_ -> pat_cond_1
kl_shen_vector_RBstr :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_vector_RBstr (!kl_V4111) (!kl_V4112) = do !kl_if_0 <- kl_V4111 `pseq` kl_shen_print_vectorP kl_V4111
case kl_if_0 of
Atom (B (True)) -> do !appl_1 <- kl_V4111 `pseq` addressFrom kl_V4111 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
!appl_2 <- appl_1 `pseq` kl_function appl_1
kl_V4111 `pseq` applyWrapper appl_2 [kl_V4111]
Atom (B (False)) -> do do !kl_if_3 <- kl_V4111 `pseq` kl_vectorP kl_V4111
case kl_if_3 of
Atom (B (True)) -> do !appl_4 <- kl_shen_maxseq
!appl_5 <- kl_V4111 `pseq` (kl_V4112 `pseq` (appl_4 `pseq` kl_shen_iter_vector kl_V4111 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1))) kl_V4112 appl_4))
!appl_6 <- appl_5 `pseq` kl_Ats appl_5 (Core.Types.Atom (Core.Types.Str ">"))
appl_6 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "<")) appl_6
Atom (B (False)) -> do do !appl_7 <- kl_shen_maxseq
!appl_8 <- kl_V4111 `pseq` (kl_V4112 `pseq` (appl_7 `pseq` kl_shen_iter_vector kl_V4111 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0))) kl_V4112 appl_7))
!appl_9 <- appl_8 `pseq` kl_Ats appl_8 (Core.Types.Atom (Core.Types.Str ">>"))
!appl_10 <- appl_9 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "<")) appl_9
appl_10 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "<")) appl_10
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
kl_shen_print_vectorP :: Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_print_vectorP (!kl_V4114) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Zero) -> do let pat_cond_1 = do return (Atom (B True))
pat_cond_2 = do do let pat_cond_3 = do return (Atom (B True))
pat_cond_4 = do do let pat_cond_5 = do return (Atom (B True))
pat_cond_6 = do do !appl_7 <- kl_Zero `pseq` numberP kl_Zero
!kl_if_8 <- appl_7 `pseq` kl_not appl_7
case kl_if_8 of
Atom (B (True)) -> do kl_Zero `pseq` kl_shen_fboundP kl_Zero
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
in case kl_Zero of
kl_Zero@(Atom (UnboundSym "shen.dictionary")) -> pat_cond_5
kl_Zero@(ApplC (PL "shen.dictionary"
_)) -> pat_cond_5
kl_Zero@(ApplC (Func "shen.dictionary"
_)) -> pat_cond_5
_ -> pat_cond_6
in case kl_Zero of
kl_Zero@(Atom (UnboundSym "shen.pvar")) -> pat_cond_3
kl_Zero@(ApplC (PL "shen.pvar"
_)) -> pat_cond_3
kl_Zero@(ApplC (Func "shen.pvar"
_)) -> pat_cond_3
_ -> pat_cond_4
in case kl_Zero of
kl_Zero@(Atom (UnboundSym "shen.tuple")) -> pat_cond_1
kl_Zero@(ApplC (PL "shen.tuple"
_)) -> pat_cond_1
kl_Zero@(ApplC (Func "shen.tuple"
_)) -> pat_cond_1
_ -> pat_cond_2)))
!appl_9 <- kl_V4114 `pseq` addressFrom kl_V4114 (Core.Types.Atom (Core.Types.N (Core.Types.KI 0)))
appl_9 `pseq` applyWrapper appl_0 [appl_9]
kl_shen_fboundP :: Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_fboundP (!kl_V4116) = do (do !appl_0 <- kl_V4116 `pseq` kl_shen_lookup_func kl_V4116
appl_0 `pseq` kl_do appl_0 (Atom (B True))) `catchError` (\(!kl_E) -> do return (Atom (B False)))
kl_shen_tuple :: Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_tuple (!kl_V4118) = do !appl_0 <- kl_V4118 `pseq` addressFrom kl_V4118 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1)))
!appl_1 <- kl_V4118 `pseq` addressFrom kl_V4118 (Core.Types.Atom (Core.Types.N (Core.Types.KI 2)))
!appl_2 <- appl_1 `pseq` kl_shen_app appl_1 (Core.Types.Atom (Core.Types.Str ")")) (Core.Types.Atom (Core.Types.UnboundSym "shen.s"))
!appl_3 <- appl_2 `pseq` cn (Core.Types.Atom (Core.Types.Str " ")) appl_2
!appl_4 <- appl_0 `pseq` (appl_3 `pseq` kl_shen_app appl_0 appl_3 (Core.Types.Atom (Core.Types.UnboundSym "shen.s")))
appl_4 `pseq` cn (Core.Types.Atom (Core.Types.Str "(@p ")) appl_4
kl_shen_dictionary :: Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_dictionary (!kl_V4120) = do return (Core.Types.Atom (Core.Types.Str "(dict ...)"))
kl_shen_iter_vector :: Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_iter_vector (!kl_V4131) (!kl_V4132) (!kl_V4133) (!kl_V4134) = do let pat_cond_0 = do return (Core.Types.Atom (Core.Types.Str "... etc"))
pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Item) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Next) -> do let pat_cond_4 = do return (Core.Types.Atom (Core.Types.Str ""))
pat_cond_5 = do do let pat_cond_6 = do kl_Item `pseq` (kl_V4133 `pseq` kl_shen_arg_RBstr kl_Item kl_V4133)
pat_cond_7 = do do !appl_8 <- kl_Item `pseq` (kl_V4133 `pseq` kl_shen_arg_RBstr kl_Item kl_V4133)
!appl_9 <- kl_V4132 `pseq` add kl_V4132 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1)))
!appl_10 <- kl_V4134 `pseq` Primitives.subtract kl_V4134 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1)))
!appl_11 <- kl_V4131 `pseq` (appl_9 `pseq` (kl_V4133 `pseq` (appl_10 `pseq` kl_shen_iter_vector kl_V4131 appl_9 kl_V4133 appl_10)))
!appl_12 <- appl_11 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str " ")) appl_11
appl_8 `pseq` (appl_12 `pseq` kl_Ats appl_8 appl_12)
in case kl_Next of
kl_Next@(Atom (UnboundSym "shen.out-of-bounds")) -> pat_cond_6
kl_Next@(ApplC (PL "shen.out-of-bounds"
_)) -> pat_cond_6
kl_Next@(ApplC (Func "shen.out-of-bounds"
_)) -> pat_cond_6
_ -> pat_cond_7
in case kl_Item of
kl_Item@(Atom (UnboundSym "shen.out-of-bounds")) -> pat_cond_4
kl_Item@(ApplC (PL "shen.out-of-bounds"
_)) -> pat_cond_4
kl_Item@(ApplC (Func "shen.out-of-bounds"
_)) -> pat_cond_4
_ -> pat_cond_5)))
!appl_13 <- kl_V4132 `pseq` add kl_V4132 (Core.Types.Atom (Core.Types.N (Core.Types.KI 1)))
let !appl_14 = ApplC (PL "thunk" (do return (Core.Types.Atom (Core.Types.UnboundSym "shen.out-of-bounds"))))
!appl_15 <- kl_V4131 `pseq` (appl_13 `pseq` (appl_14 `pseq` kl_LB_addressDivor kl_V4131 appl_13 appl_14))
appl_15 `pseq` applyWrapper appl_3 [appl_15])))
let !appl_16 = ApplC (PL "thunk" (do return (Core.Types.Atom (Core.Types.UnboundSym "shen.out-of-bounds"))))
!appl_17 <- kl_V4131 `pseq` (kl_V4132 `pseq` (appl_16 `pseq` kl_LB_addressDivor kl_V4131 kl_V4132 appl_16))
appl_17 `pseq` applyWrapper appl_2 [appl_17]
in case kl_V4134 of
kl_V4134@(Atom (N (KI 0))) -> pat_cond_0
_ -> pat_cond_1
kl_shen_atom_RBstr :: Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_atom_RBstr (!kl_V4136) = do (do kl_V4136 `pseq` str kl_V4136) `catchError` (\(!kl_E) -> do kl_shen_funexstring)
kl_shen_funexstring :: Core.Types.KLContext Core.Types.Env
Core.Types.KLValue
kl_shen_funexstring = do !appl_0 <- intern (Core.Types.Atom (Core.Types.Str "x"))
!appl_1 <- appl_0 `pseq` kl_gensym appl_0
!appl_2 <- appl_1 `pseq` kl_shen_arg_RBstr appl_1 (Core.Types.Atom (Core.Types.UnboundSym "shen.a"))
!appl_3 <- appl_2 `pseq` kl_Ats appl_2 (Core.Types.Atom (Core.Types.Str "\\DC1"))
!appl_4 <- appl_3 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "e")) appl_3
!appl_5 <- appl_4 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "n")) appl_4
!appl_6 <- appl_5 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "u")) appl_5
!appl_7 <- appl_6 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "f")) appl_6
appl_7 `pseq` kl_Ats (Core.Types.Atom (Core.Types.Str "\\DLE")) appl_7
kl_shen_listP :: Core.Types.KLValue ->
Core.Types.KLContext Core.Types.Env Core.Types.KLValue
kl_shen_listP (!kl_V4138) = do !kl_if_0 <- kl_V4138 `pseq` kl_emptyP kl_V4138
case kl_if_0 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do let pat_cond_1 kl_V4138 kl_V4138h kl_V4138t = do return (Atom (B True))
pat_cond_2 = do do return (Atom (B False))
in case kl_V4138 of
!(kl_V4138@(Cons (!kl_V4138h)
(!kl_V4138t))) -> pat_cond_1 kl_V4138 kl_V4138h kl_V4138t
_ -> pat_cond_2
_ -> throwError "if: expected boolean"
expr9 :: Core.Types.KLContext Core.Types.Env Core.Types.KLValue
expr9 = do (do return (Core.Types.Atom (Core.Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Core.Types.Atom (Core.Types.Str "E")))