shentong-0.3.1: 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 Primitives as Primitives
import Backend.Utils
import Types as Types
import Utils
import Wrap
import Backend.Toplevel
import Backend.Core
import Backend.Sys
import Backend.Sequent
import Backend.Yacc
import Backend.Reader
import Backend.Prolog
import Backend.Track
import Backend.Load
{-
Copyright (c) 2015, Mark Tarver
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. The name of Mark Tarver may not be used to endorse or promote products
derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY
EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
kl_pr :: Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_pr (!kl_V3878) (!kl_V3879) = do (do kl_V3878 `pseq` (kl_V3879 `pseq` kl_shen_prh kl_V3878 kl_V3879 (Types.Atom (Types.N (Types.KI 0))))) `catchError` (\(!kl_E) -> do return kl_V3878)
kl_shen_prh :: Types.KLValue ->
Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_prh (!kl_V3883) (!kl_V3884) (!kl_V3885) = do !appl_0 <- kl_V3883 `pseq` (kl_V3884 `pseq` (kl_V3885 `pseq` kl_shen_write_char_and_inc kl_V3883 kl_V3884 kl_V3885))
kl_V3883 `pseq` (kl_V3884 `pseq` (appl_0 `pseq` kl_shen_prh kl_V3883 kl_V3884 appl_0))
kl_shen_write_char_and_inc :: Types.KLValue ->
Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_write_char_and_inc (!kl_V3889) (!kl_V3890) (!kl_V3891) = do !appl_0 <- kl_V3889 `pseq` (kl_V3891 `pseq` pos kl_V3889 kl_V3891)
!appl_1 <- appl_0 `pseq` stringToN appl_0
!appl_2 <- appl_1 `pseq` (kl_V3890 `pseq` writeByte appl_1 kl_V3890)
!appl_3 <- kl_V3891 `pseq` add kl_V3891 (Types.Atom (Types.N (Types.KI 1)))
appl_2 `pseq` (appl_3 `pseq` kl_do appl_2 appl_3)
kl_print :: Types.KLValue ->
Types.KLContext Types.Env Types.KLValue
kl_print (!kl_V3893) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_String) -> do let !appl_1 = ApplC (Func "lambda" (Context (\(!kl_Print) -> do return kl_V3893)))
!appl_2 <- kl_stoutput
!appl_3 <- kl_String `pseq` (appl_2 `pseq` kl_shen_prhush kl_String appl_2)
appl_3 `pseq` applyWrapper appl_1 [appl_3])))
!appl_4 <- kl_V3893 `pseq` kl_shen_insert kl_V3893 (Types.Atom (Types.Str "~S"))
appl_4 `pseq` applyWrapper appl_0 [appl_4]
kl_shen_prhush :: Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_prhush (!kl_V3896) (!kl_V3897) = do !kl_if_0 <- value (Types.Atom (Types.UnboundSym "*hush*"))
case kl_if_0 of
Atom (B (True)) -> do return kl_V3896
Atom (B (False)) -> do do kl_V3896 `pseq` (kl_V3897 `pseq` kl_pr kl_V3896 kl_V3897)
_ -> throwError "if: expected boolean"
kl_shen_mkstr :: Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_mkstr (!kl_V3900) (!kl_V3901) = do !kl_if_0 <- kl_V3900 `pseq` stringP kl_V3900
case kl_if_0 of
Atom (B (True)) -> do !appl_1 <- kl_V3900 `pseq` kl_shen_proc_nl kl_V3900
appl_1 `pseq` (kl_V3901 `pseq` kl_shen_mkstr_l appl_1 kl_V3901)
Atom (B (False)) -> do do !appl_2 <- kl_V3900 `pseq` klCons kl_V3900 (Types.Atom Types.Nil)
!appl_3 <- appl_2 `pseq` klCons (ApplC (wrapNamed "shen.proc-nl" kl_shen_proc_nl)) appl_2
appl_3 `pseq` (kl_V3901 `pseq` kl_shen_mkstr_r appl_3 kl_V3901)
_ -> throwError "if: expected boolean"
kl_shen_mkstr_l :: Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_mkstr_l (!kl_V3904) (!kl_V3905) = do let pat_cond_0 = do return kl_V3904
pat_cond_1 kl_V3905 kl_V3905h kl_V3905t = do !appl_2 <- kl_V3905h `pseq` (kl_V3904 `pseq` kl_shen_insert_l kl_V3905h kl_V3904)
appl_2 `pseq` (kl_V3905t `pseq` kl_shen_mkstr_l appl_2 kl_V3905t)
pat_cond_3 = do do kl_shen_f_error (ApplC (wrapNamed "shen.mkstr-l" kl_shen_mkstr_l))
in case kl_V3905 of
kl_V3905@(Atom (Nil)) -> pat_cond_0
!(kl_V3905@(Cons (!kl_V3905h)
(!kl_V3905t))) -> pat_cond_1 kl_V3905 kl_V3905h kl_V3905t
_ -> pat_cond_3
kl_shen_insert_l :: Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_insert_l (!kl_V3910) (!kl_V3911) = do let pat_cond_0 = do return (Types.Atom (Types.Str ""))
pat_cond_1 = do !kl_if_2 <- kl_V3911 `pseq` kl_shen_PlusstringP kl_V3911
!kl_if_3 <- case kl_if_2 of
Atom (B (True)) -> do !appl_4 <- kl_V3911 `pseq` pos kl_V3911 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.Str "~")) appl_4
!kl_if_6 <- case kl_if_5 of
Atom (B (True)) -> do !appl_7 <- kl_V3911 `pseq` tlstr kl_V3911
!kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7
!kl_if_9 <- case kl_if_8 of
Atom (B (True)) -> do !appl_10 <- kl_V3911 `pseq` tlstr kl_V3911
!appl_11 <- appl_10 `pseq` pos appl_10 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_12 <- appl_11 `pseq` eq (Types.Atom (Types.Str "A")) appl_11
case kl_if_12 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_9 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_6 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_3 of
Atom (B (True)) -> do !appl_13 <- kl_V3911 `pseq` tlstr kl_V3911
!appl_14 <- appl_13 `pseq` tlstr appl_13
!appl_15 <- klCons (Types.Atom (Types.UnboundSym "shen.a")) (Types.Atom Types.Nil)
!appl_16 <- appl_14 `pseq` (appl_15 `pseq` klCons appl_14 appl_15)
!appl_17 <- kl_V3910 `pseq` (appl_16 `pseq` klCons kl_V3910 appl_16)
appl_17 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_17
Atom (B (False)) -> do !kl_if_18 <- kl_V3911 `pseq` kl_shen_PlusstringP kl_V3911
!kl_if_19 <- case kl_if_18 of
Atom (B (True)) -> do !appl_20 <- kl_V3911 `pseq` pos kl_V3911 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_21 <- appl_20 `pseq` eq (Types.Atom (Types.Str "~")) appl_20
!kl_if_22 <- case kl_if_21 of
Atom (B (True)) -> do !appl_23 <- kl_V3911 `pseq` tlstr kl_V3911
!kl_if_24 <- appl_23 `pseq` kl_shen_PlusstringP appl_23
!kl_if_25 <- case kl_if_24 of
Atom (B (True)) -> do !appl_26 <- kl_V3911 `pseq` tlstr kl_V3911
!appl_27 <- appl_26 `pseq` pos appl_26 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_28 <- appl_27 `pseq` eq (Types.Atom (Types.Str "R")) appl_27
case kl_if_28 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_25 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_22 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_19 of
Atom (B (True)) -> do !appl_29 <- kl_V3911 `pseq` tlstr kl_V3911
!appl_30 <- appl_29 `pseq` tlstr appl_29
!appl_31 <- klCons (Types.Atom (Types.UnboundSym "shen.r")) (Types.Atom Types.Nil)
!appl_32 <- appl_30 `pseq` (appl_31 `pseq` klCons appl_30 appl_31)
!appl_33 <- kl_V3910 `pseq` (appl_32 `pseq` klCons kl_V3910 appl_32)
appl_33 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_33
Atom (B (False)) -> do !kl_if_34 <- kl_V3911 `pseq` kl_shen_PlusstringP kl_V3911
!kl_if_35 <- case kl_if_34 of
Atom (B (True)) -> do !appl_36 <- kl_V3911 `pseq` pos kl_V3911 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_37 <- appl_36 `pseq` eq (Types.Atom (Types.Str "~")) appl_36
!kl_if_38 <- case kl_if_37 of
Atom (B (True)) -> do !appl_39 <- kl_V3911 `pseq` tlstr kl_V3911
!kl_if_40 <- appl_39 `pseq` kl_shen_PlusstringP appl_39
!kl_if_41 <- case kl_if_40 of
Atom (B (True)) -> do !appl_42 <- kl_V3911 `pseq` tlstr kl_V3911
!appl_43 <- appl_42 `pseq` pos appl_42 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_44 <- appl_43 `pseq` eq (Types.Atom (Types.Str "S")) appl_43
case kl_if_44 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_41 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_38 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_35 of
Atom (B (True)) -> do !appl_45 <- kl_V3911 `pseq` tlstr kl_V3911
!appl_46 <- appl_45 `pseq` tlstr appl_45
!appl_47 <- klCons (Types.Atom (Types.UnboundSym "shen.s")) (Types.Atom Types.Nil)
!appl_48 <- appl_46 `pseq` (appl_47 `pseq` klCons appl_46 appl_47)
!appl_49 <- kl_V3910 `pseq` (appl_48 `pseq` klCons kl_V3910 appl_48)
appl_49 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_49
Atom (B (False)) -> do !kl_if_50 <- kl_V3911 `pseq` kl_shen_PlusstringP kl_V3911
case kl_if_50 of
Atom (B (True)) -> do !appl_51 <- kl_V3911 `pseq` pos kl_V3911 (Types.Atom (Types.N (Types.KI 0)))
!appl_52 <- kl_V3911 `pseq` tlstr kl_V3911
!appl_53 <- kl_V3910 `pseq` (appl_52 `pseq` kl_shen_insert_l kl_V3910 appl_52)
!appl_54 <- appl_53 `pseq` klCons appl_53 (Types.Atom Types.Nil)
!appl_55 <- appl_51 `pseq` (appl_54 `pseq` klCons appl_51 appl_54)
!appl_56 <- appl_55 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_55
appl_56 `pseq` kl_shen_factor_cn appl_56
Atom (B (False)) -> do let pat_cond_57 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth = do !appl_58 <- kl_V3910 `pseq` (kl_V3911tth `pseq` kl_shen_insert_l kl_V3910 kl_V3911tth)
!appl_59 <- appl_58 `pseq` klCons appl_58 (Types.Atom Types.Nil)
!appl_60 <- kl_V3911th `pseq` (appl_59 `pseq` klCons kl_V3911th appl_59)
appl_60 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_60
pat_cond_61 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth kl_V3911ttt kl_V3911ttth = do !appl_62 <- kl_V3910 `pseq` (kl_V3911tth `pseq` kl_shen_insert_l kl_V3910 kl_V3911tth)
!appl_63 <- appl_62 `pseq` (kl_V3911ttt `pseq` klCons appl_62 kl_V3911ttt)
!appl_64 <- kl_V3911th `pseq` (appl_63 `pseq` klCons kl_V3911th appl_63)
appl_64 `pseq` klCons (ApplC (wrapNamed "shen.app" kl_shen_app)) appl_64
pat_cond_65 = do do kl_shen_f_error (ApplC (wrapNamed "shen.insert-l" kl_shen_insert_l))
in case kl_V3911 of
!(kl_V3911@(Cons (Atom (UnboundSym "cn"))
(!(kl_V3911t@(Cons (!kl_V3911th)
(!(kl_V3911tt@(Cons (!kl_V3911tth)
(Atom (Nil)))))))))) -> pat_cond_57 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth
!(kl_V3911@(Cons (ApplC (PL "cn"
_))
(!(kl_V3911t@(Cons (!kl_V3911th)
(!(kl_V3911tt@(Cons (!kl_V3911tth)
(Atom (Nil)))))))))) -> pat_cond_57 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth
!(kl_V3911@(Cons (ApplC (Func "cn"
_))
(!(kl_V3911t@(Cons (!kl_V3911th)
(!(kl_V3911tt@(Cons (!kl_V3911tth)
(Atom (Nil)))))))))) -> pat_cond_57 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth
!(kl_V3911@(Cons (Atom (UnboundSym "shen.app"))
(!(kl_V3911t@(Cons (!kl_V3911th)
(!(kl_V3911tt@(Cons (!kl_V3911tth)
(!(kl_V3911ttt@(Cons (!kl_V3911ttth)
(Atom (Nil))))))))))))) -> pat_cond_61 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth kl_V3911ttt kl_V3911ttth
!(kl_V3911@(Cons (ApplC (PL "shen.app"
_))
(!(kl_V3911t@(Cons (!kl_V3911th)
(!(kl_V3911tt@(Cons (!kl_V3911tth)
(!(kl_V3911ttt@(Cons (!kl_V3911ttth)
(Atom (Nil))))))))))))) -> pat_cond_61 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth kl_V3911ttt kl_V3911ttth
!(kl_V3911@(Cons (ApplC (Func "shen.app"
_))
(!(kl_V3911t@(Cons (!kl_V3911th)
(!(kl_V3911tt@(Cons (!kl_V3911tth)
(!(kl_V3911ttt@(Cons (!kl_V3911ttth)
(Atom (Nil))))))))))))) -> pat_cond_61 kl_V3911 kl_V3911t kl_V3911th kl_V3911tt kl_V3911tth kl_V3911ttt kl_V3911ttth
_ -> pat_cond_65
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
in case kl_V3911 of
kl_V3911@(Atom (Str "")) -> pat_cond_0
_ -> pat_cond_1
kl_shen_factor_cn :: Types.KLValue ->
Types.KLContext Types.Env Types.KLValue
kl_shen_factor_cn (!kl_V3913) = do !kl_if_0 <- let pat_cond_1 kl_V3913 kl_V3913h kl_V3913t = do !kl_if_2 <- let pat_cond_3 = do !kl_if_4 <- let pat_cond_5 kl_V3913t kl_V3913th kl_V3913tt = do !kl_if_6 <- let pat_cond_7 kl_V3913tt kl_V3913tth kl_V3913ttt = do !kl_if_8 <- let pat_cond_9 kl_V3913tth kl_V3913tthh kl_V3913ttht = do !kl_if_10 <- let pat_cond_11 = do !kl_if_12 <- let pat_cond_13 kl_V3913ttht kl_V3913tthth kl_V3913tthtt = do !kl_if_14 <- let pat_cond_15 kl_V3913tthtt kl_V3913tthtth kl_V3913tthttt = do !kl_if_16 <- let pat_cond_17 = do !kl_if_18 <- let pat_cond_19 = do !kl_if_20 <- kl_V3913th `pseq` stringP kl_V3913th
!kl_if_21 <- case kl_if_20 of
Atom (B (True)) -> do !kl_if_22 <- kl_V3913tthth `pseq` stringP kl_V3913tthth
case kl_if_22 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_21 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_23 = do do return (Atom (B False))
in case kl_V3913ttt of
kl_V3913ttt@(Atom (Nil)) -> pat_cond_19
_ -> pat_cond_23
case kl_if_18 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_24 = do do return (Atom (B False))
in case kl_V3913tthttt of
kl_V3913tthttt@(Atom (Nil)) -> pat_cond_17
_ -> pat_cond_24
case kl_if_16 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_25 = do do return (Atom (B False))
in case kl_V3913tthtt of
!(kl_V3913tthtt@(Cons (!kl_V3913tthtth)
(!kl_V3913tthttt))) -> pat_cond_15 kl_V3913tthtt kl_V3913tthtth kl_V3913tthttt
_ -> pat_cond_25
case kl_if_14 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_26 = do do return (Atom (B False))
in case kl_V3913ttht of
!(kl_V3913ttht@(Cons (!kl_V3913tthth)
(!kl_V3913tthtt))) -> pat_cond_13 kl_V3913ttht kl_V3913tthth kl_V3913tthtt
_ -> pat_cond_26
case kl_if_12 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_27 = do do return (Atom (B False))
in case kl_V3913tthh of
kl_V3913tthh@(Atom (UnboundSym "cn")) -> pat_cond_11
kl_V3913tthh@(ApplC (PL "cn"
_)) -> pat_cond_11
kl_V3913tthh@(ApplC (Func "cn"
_)) -> pat_cond_11
_ -> pat_cond_27
case kl_if_10 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_28 = do do return (Atom (B False))
in case kl_V3913tth of
!(kl_V3913tth@(Cons (!kl_V3913tthh)
(!kl_V3913ttht))) -> pat_cond_9 kl_V3913tth kl_V3913tthh kl_V3913ttht
_ -> pat_cond_28
case kl_if_8 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_29 = do do return (Atom (B False))
in case kl_V3913tt of
!(kl_V3913tt@(Cons (!kl_V3913tth)
(!kl_V3913ttt))) -> pat_cond_7 kl_V3913tt kl_V3913tth kl_V3913ttt
_ -> pat_cond_29
case kl_if_6 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_30 = do do return (Atom (B False))
in case kl_V3913t of
!(kl_V3913t@(Cons (!kl_V3913th)
(!kl_V3913tt))) -> pat_cond_5 kl_V3913t kl_V3913th kl_V3913tt
_ -> pat_cond_30
case kl_if_4 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_31 = do do return (Atom (B False))
in case kl_V3913h of
kl_V3913h@(Atom (UnboundSym "cn")) -> pat_cond_3
kl_V3913h@(ApplC (PL "cn"
_)) -> pat_cond_3
kl_V3913h@(ApplC (Func "cn"
_)) -> pat_cond_3
_ -> pat_cond_31
case kl_if_2 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
pat_cond_32 = do do return (Atom (B False))
in case kl_V3913 of
!(kl_V3913@(Cons (!kl_V3913h)
(!kl_V3913t))) -> pat_cond_1 kl_V3913 kl_V3913h kl_V3913t
_ -> pat_cond_32
case kl_if_0 of
Atom (B (True)) -> do !appl_33 <- kl_V3913 `pseq` tl kl_V3913
!appl_34 <- appl_33 `pseq` hd appl_33
!appl_35 <- kl_V3913 `pseq` tl kl_V3913
!appl_36 <- appl_35 `pseq` tl appl_35
!appl_37 <- appl_36 `pseq` hd appl_36
!appl_38 <- appl_37 `pseq` tl appl_37
!appl_39 <- appl_38 `pseq` hd appl_38
!appl_40 <- appl_34 `pseq` (appl_39 `pseq` cn appl_34 appl_39)
!appl_41 <- kl_V3913 `pseq` tl kl_V3913
!appl_42 <- appl_41 `pseq` tl appl_41
!appl_43 <- appl_42 `pseq` hd appl_42
!appl_44 <- appl_43 `pseq` tl appl_43
!appl_45 <- appl_44 `pseq` tl appl_44
!appl_46 <- appl_40 `pseq` (appl_45 `pseq` klCons appl_40 appl_45)
appl_46 `pseq` klCons (ApplC (wrapNamed "cn" cn)) appl_46
Atom (B (False)) -> do do return kl_V3913
_ -> throwError "if: expected boolean"
kl_shen_proc_nl :: Types.KLValue ->
Types.KLContext Types.Env Types.KLValue
kl_shen_proc_nl (!kl_V3915) = do let pat_cond_0 = do return (Types.Atom (Types.Str ""))
pat_cond_1 = do !kl_if_2 <- kl_V3915 `pseq` kl_shen_PlusstringP kl_V3915
!kl_if_3 <- case kl_if_2 of
Atom (B (True)) -> do !appl_4 <- kl_V3915 `pseq` pos kl_V3915 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.Str "~")) appl_4
!kl_if_6 <- case kl_if_5 of
Atom (B (True)) -> do !appl_7 <- kl_V3915 `pseq` tlstr kl_V3915
!kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7
!kl_if_9 <- case kl_if_8 of
Atom (B (True)) -> do !appl_10 <- kl_V3915 `pseq` tlstr kl_V3915
!appl_11 <- appl_10 `pseq` pos appl_10 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_12 <- appl_11 `pseq` eq (Types.Atom (Types.Str "%")) appl_11
case kl_if_12 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_9 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_6 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_3 of
Atom (B (True)) -> do !appl_13 <- nToString (Types.Atom (Types.N (Types.KI 10)))
!appl_14 <- kl_V3915 `pseq` tlstr kl_V3915
!appl_15 <- appl_14 `pseq` tlstr appl_14
!appl_16 <- appl_15 `pseq` kl_shen_proc_nl appl_15
appl_13 `pseq` (appl_16 `pseq` cn appl_13 appl_16)
Atom (B (False)) -> do !kl_if_17 <- kl_V3915 `pseq` kl_shen_PlusstringP kl_V3915
case kl_if_17 of
Atom (B (True)) -> do !appl_18 <- kl_V3915 `pseq` pos kl_V3915 (Types.Atom (Types.N (Types.KI 0)))
!appl_19 <- kl_V3915 `pseq` tlstr kl_V3915
!appl_20 <- appl_19 `pseq` kl_shen_proc_nl appl_19
appl_18 `pseq` (appl_20 `pseq` cn appl_18 appl_20)
Atom (B (False)) -> do do kl_shen_f_error (ApplC (wrapNamed "shen.proc-nl" kl_shen_proc_nl))
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
in case kl_V3915 of
kl_V3915@(Atom (Str "")) -> pat_cond_0
_ -> pat_cond_1
kl_shen_mkstr_r :: Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_mkstr_r (!kl_V3918) (!kl_V3919) = do let pat_cond_0 = do return kl_V3918
pat_cond_1 kl_V3919 kl_V3919h kl_V3919t = do !appl_2 <- kl_V3918 `pseq` klCons kl_V3918 (Types.Atom Types.Nil)
!appl_3 <- kl_V3919h `pseq` (appl_2 `pseq` klCons kl_V3919h appl_2)
!appl_4 <- appl_3 `pseq` klCons (ApplC (wrapNamed "shen.insert" kl_shen_insert)) appl_3
appl_4 `pseq` (kl_V3919t `pseq` kl_shen_mkstr_r appl_4 kl_V3919t)
pat_cond_5 = do do kl_shen_f_error (ApplC (wrapNamed "shen.mkstr-r" kl_shen_mkstr_r))
in case kl_V3919 of
kl_V3919@(Atom (Nil)) -> pat_cond_0
!(kl_V3919@(Cons (!kl_V3919h)
(!kl_V3919t))) -> pat_cond_1 kl_V3919 kl_V3919h kl_V3919t
_ -> pat_cond_5
kl_shen_insert :: Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_insert (!kl_V3922) (!kl_V3923) = do kl_V3922 `pseq` (kl_V3923 `pseq` kl_shen_insert_h kl_V3922 kl_V3923 (Types.Atom (Types.Str "")))
kl_shen_insert_h :: Types.KLValue ->
Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_insert_h (!kl_V3929) (!kl_V3930) (!kl_V3931) = do let pat_cond_0 = do return kl_V3931
pat_cond_1 = do !kl_if_2 <- kl_V3930 `pseq` kl_shen_PlusstringP kl_V3930
!kl_if_3 <- case kl_if_2 of
Atom (B (True)) -> do !appl_4 <- kl_V3930 `pseq` pos kl_V3930 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_5 <- appl_4 `pseq` eq (Types.Atom (Types.Str "~")) appl_4
!kl_if_6 <- case kl_if_5 of
Atom (B (True)) -> do !appl_7 <- kl_V3930 `pseq` tlstr kl_V3930
!kl_if_8 <- appl_7 `pseq` kl_shen_PlusstringP appl_7
!kl_if_9 <- case kl_if_8 of
Atom (B (True)) -> do !appl_10 <- kl_V3930 `pseq` tlstr kl_V3930
!appl_11 <- appl_10 `pseq` pos appl_10 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_12 <- appl_11 `pseq` eq (Types.Atom (Types.Str "A")) appl_11
case kl_if_12 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_9 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_6 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_3 of
Atom (B (True)) -> do !appl_13 <- kl_V3930 `pseq` tlstr kl_V3930
!appl_14 <- appl_13 `pseq` tlstr appl_13
!appl_15 <- kl_V3929 `pseq` (appl_14 `pseq` kl_shen_app kl_V3929 appl_14 (Types.Atom (Types.UnboundSym "shen.a")))
kl_V3931 `pseq` (appl_15 `pseq` cn kl_V3931 appl_15)
Atom (B (False)) -> do !kl_if_16 <- kl_V3930 `pseq` kl_shen_PlusstringP kl_V3930
!kl_if_17 <- case kl_if_16 of
Atom (B (True)) -> do !appl_18 <- kl_V3930 `pseq` pos kl_V3930 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_19 <- appl_18 `pseq` eq (Types.Atom (Types.Str "~")) appl_18
!kl_if_20 <- case kl_if_19 of
Atom (B (True)) -> do !appl_21 <- kl_V3930 `pseq` tlstr kl_V3930
!kl_if_22 <- appl_21 `pseq` kl_shen_PlusstringP appl_21
!kl_if_23 <- case kl_if_22 of
Atom (B (True)) -> do !appl_24 <- kl_V3930 `pseq` tlstr kl_V3930
!appl_25 <- appl_24 `pseq` pos appl_24 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_26 <- appl_25 `pseq` eq (Types.Atom (Types.Str "R")) appl_25
case kl_if_26 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_23 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_20 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_17 of
Atom (B (True)) -> do !appl_27 <- kl_V3930 `pseq` tlstr kl_V3930
!appl_28 <- appl_27 `pseq` tlstr appl_27
!appl_29 <- kl_V3929 `pseq` (appl_28 `pseq` kl_shen_app kl_V3929 appl_28 (Types.Atom (Types.UnboundSym "shen.r")))
kl_V3931 `pseq` (appl_29 `pseq` cn kl_V3931 appl_29)
Atom (B (False)) -> do !kl_if_30 <- kl_V3930 `pseq` kl_shen_PlusstringP kl_V3930
!kl_if_31 <- case kl_if_30 of
Atom (B (True)) -> do !appl_32 <- kl_V3930 `pseq` pos kl_V3930 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_33 <- appl_32 `pseq` eq (Types.Atom (Types.Str "~")) appl_32
!kl_if_34 <- case kl_if_33 of
Atom (B (True)) -> do !appl_35 <- kl_V3930 `pseq` tlstr kl_V3930
!kl_if_36 <- appl_35 `pseq` kl_shen_PlusstringP appl_35
!kl_if_37 <- case kl_if_36 of
Atom (B (True)) -> do !appl_38 <- kl_V3930 `pseq` tlstr kl_V3930
!appl_39 <- appl_38 `pseq` pos appl_38 (Types.Atom (Types.N (Types.KI 0)))
!kl_if_40 <- appl_39 `pseq` eq (Types.Atom (Types.Str "S")) appl_39
case kl_if_40 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_37 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_34 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
case kl_if_31 of
Atom (B (True)) -> do !appl_41 <- kl_V3930 `pseq` tlstr kl_V3930
!appl_42 <- appl_41 `pseq` tlstr appl_41
!appl_43 <- kl_V3929 `pseq` (appl_42 `pseq` kl_shen_app kl_V3929 appl_42 (Types.Atom (Types.UnboundSym "shen.s")))
kl_V3931 `pseq` (appl_43 `pseq` cn kl_V3931 appl_43)
Atom (B (False)) -> do !kl_if_44 <- kl_V3930 `pseq` kl_shen_PlusstringP kl_V3930
case kl_if_44 of
Atom (B (True)) -> do !appl_45 <- kl_V3930 `pseq` tlstr kl_V3930
!appl_46 <- kl_V3930 `pseq` pos kl_V3930 (Types.Atom (Types.N (Types.KI 0)))
!appl_47 <- kl_V3931 `pseq` (appl_46 `pseq` cn kl_V3931 appl_46)
kl_V3929 `pseq` (appl_45 `pseq` (appl_47 `pseq` kl_shen_insert_h kl_V3929 appl_45 appl_47))
Atom (B (False)) -> do do kl_shen_f_error (ApplC (wrapNamed "shen.insert-h" kl_shen_insert_h))
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
in case kl_V3930 of
kl_V3930@(Atom (Str "")) -> pat_cond_0
_ -> pat_cond_1
kl_shen_app :: Types.KLValue ->
Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_app (!kl_V3935) (!kl_V3936) (!kl_V3937) = do !appl_0 <- kl_V3935 `pseq` (kl_V3937 `pseq` kl_shen_arg_RBstr kl_V3935 kl_V3937)
appl_0 `pseq` (kl_V3936 `pseq` cn appl_0 kl_V3936)
kl_shen_arg_RBstr :: Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_arg_RBstr (!kl_V3945) (!kl_V3946) = do !appl_0 <- kl_fail
!kl_if_1 <- kl_V3945 `pseq` (appl_0 `pseq` eq kl_V3945 appl_0)
case kl_if_1 of
Atom (B (True)) -> do return (Types.Atom (Types.Str "..."))
Atom (B (False)) -> do !kl_if_2 <- kl_V3945 `pseq` kl_shen_listP kl_V3945
case kl_if_2 of
Atom (B (True)) -> do kl_V3945 `pseq` (kl_V3946 `pseq` kl_shen_list_RBstr kl_V3945 kl_V3946)
Atom (B (False)) -> do !kl_if_3 <- kl_V3945 `pseq` stringP kl_V3945
case kl_if_3 of
Atom (B (True)) -> do kl_V3945 `pseq` (kl_V3946 `pseq` kl_shen_str_RBstr kl_V3945 kl_V3946)
Atom (B (False)) -> do !kl_if_4 <- kl_V3945 `pseq` absvectorP kl_V3945
case kl_if_4 of
Atom (B (True)) -> do kl_V3945 `pseq` (kl_V3946 `pseq` kl_shen_vector_RBstr kl_V3945 kl_V3946)
Atom (B (False)) -> do do kl_V3945 `pseq` kl_shen_atom_RBstr kl_V3945
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
kl_shen_list_RBstr :: Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_list_RBstr (!kl_V3949) (!kl_V3950) = do let pat_cond_0 = do !appl_1 <- kl_shen_maxseq
!appl_2 <- kl_V3949 `pseq` (appl_1 `pseq` kl_shen_iter_list kl_V3949 (Types.Atom (Types.UnboundSym "shen.r")) appl_1)
!appl_3 <- appl_2 `pseq` kl_Ats appl_2 (Types.Atom (Types.Str ")"))
appl_3 `pseq` kl_Ats (Types.Atom (Types.Str "(")) appl_3
pat_cond_4 = do do !appl_5 <- kl_shen_maxseq
!appl_6 <- kl_V3949 `pseq` (kl_V3950 `pseq` (appl_5 `pseq` kl_shen_iter_list kl_V3949 kl_V3950 appl_5))
!appl_7 <- appl_6 `pseq` kl_Ats appl_6 (Types.Atom (Types.Str "]"))
appl_7 `pseq` kl_Ats (Types.Atom (Types.Str "[")) appl_7
in case kl_V3950 of
kl_V3950@(Atom (UnboundSym "shen.r")) -> pat_cond_0
kl_V3950@(ApplC (PL "shen.r"
_)) -> pat_cond_0
kl_V3950@(ApplC (Func "shen.r"
_)) -> pat_cond_0
_ -> pat_cond_4
kl_shen_maxseq :: Types.KLContext Types.Env Types.KLValue
kl_shen_maxseq = do value (Types.Atom (Types.UnboundSym "*maximum-print-sequence-size*"))
kl_shen_iter_list :: Types.KLValue ->
Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_iter_list (!kl_V3964) (!kl_V3965) (!kl_V3966) = do let pat_cond_0 = do return (Types.Atom (Types.Str ""))
pat_cond_1 = do let pat_cond_2 = do return (Types.Atom (Types.Str "... etc"))
pat_cond_3 = do let pat_cond_4 kl_V3964 kl_V3964h = do kl_V3964h `pseq` (kl_V3965 `pseq` kl_shen_arg_RBstr kl_V3964h kl_V3965)
pat_cond_5 kl_V3964 kl_V3964h kl_V3964t = do !appl_6 <- kl_V3964h `pseq` (kl_V3965 `pseq` kl_shen_arg_RBstr kl_V3964h kl_V3965)
!appl_7 <- kl_V3966 `pseq` Primitives.subtract kl_V3966 (Types.Atom (Types.N (Types.KI 1)))
!appl_8 <- kl_V3964t `pseq` (kl_V3965 `pseq` (appl_7 `pseq` kl_shen_iter_list kl_V3964t kl_V3965 appl_7))
!appl_9 <- appl_8 `pseq` kl_Ats (Types.Atom (Types.Str " ")) appl_8
appl_6 `pseq` (appl_9 `pseq` kl_Ats appl_6 appl_9)
pat_cond_10 = do do !appl_11 <- kl_V3964 `pseq` (kl_V3965 `pseq` kl_shen_arg_RBstr kl_V3964 kl_V3965)
!appl_12 <- appl_11 `pseq` kl_Ats (Types.Atom (Types.Str " ")) appl_11
appl_12 `pseq` kl_Ats (Types.Atom (Types.Str "|")) appl_12
in case kl_V3964 of
!(kl_V3964@(Cons (!kl_V3964h)
(Atom (Nil)))) -> pat_cond_4 kl_V3964 kl_V3964h
!(kl_V3964@(Cons (!kl_V3964h)
(!kl_V3964t))) -> pat_cond_5 kl_V3964 kl_V3964h kl_V3964t
_ -> pat_cond_10
in case kl_V3966 of
kl_V3966@(Atom (N (KI 0))) -> pat_cond_2
_ -> pat_cond_3
in case kl_V3964 of
kl_V3964@(Atom (Nil)) -> pat_cond_0
_ -> pat_cond_1
kl_shen_str_RBstr :: Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_str_RBstr (!kl_V3973) (!kl_V3974) = do let pat_cond_0 = do return kl_V3973
pat_cond_1 = do do !appl_2 <- nToString (Types.Atom (Types.N (Types.KI 34)))
!appl_3 <- nToString (Types.Atom (Types.N (Types.KI 34)))
!appl_4 <- kl_V3973 `pseq` (appl_3 `pseq` kl_Ats kl_V3973 appl_3)
appl_2 `pseq` (appl_4 `pseq` kl_Ats appl_2 appl_4)
in case kl_V3974 of
kl_V3974@(Atom (UnboundSym "shen.a")) -> pat_cond_0
kl_V3974@(ApplC (PL "shen.a"
_)) -> pat_cond_0
kl_V3974@(ApplC (Func "shen.a"
_)) -> pat_cond_0
_ -> pat_cond_1
kl_shen_vector_RBstr :: Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_vector_RBstr (!kl_V3977) (!kl_V3978) = do !kl_if_0 <- kl_V3977 `pseq` kl_shen_print_vectorP kl_V3977
case kl_if_0 of
Atom (B (True)) -> do !appl_1 <- kl_V3977 `pseq` addressFrom kl_V3977 (Types.Atom (Types.N (Types.KI 0)))
!appl_2 <- appl_1 `pseq` kl_function appl_1
kl_V3977 `pseq` applyWrapper appl_2 [kl_V3977]
Atom (B (False)) -> do do !kl_if_3 <- kl_V3977 `pseq` kl_vectorP kl_V3977
case kl_if_3 of
Atom (B (True)) -> do !appl_4 <- kl_shen_maxseq
!appl_5 <- kl_V3977 `pseq` (kl_V3978 `pseq` (appl_4 `pseq` kl_shen_iter_vector kl_V3977 (Types.Atom (Types.N (Types.KI 1))) kl_V3978 appl_4))
!appl_6 <- appl_5 `pseq` kl_Ats appl_5 (Types.Atom (Types.Str ">"))
appl_6 `pseq` kl_Ats (Types.Atom (Types.Str "<")) appl_6
Atom (B (False)) -> do do !appl_7 <- kl_shen_maxseq
!appl_8 <- kl_V3977 `pseq` (kl_V3978 `pseq` (appl_7 `pseq` kl_shen_iter_vector kl_V3977 (Types.Atom (Types.N (Types.KI 0))) kl_V3978 appl_7))
!appl_9 <- appl_8 `pseq` kl_Ats appl_8 (Types.Atom (Types.Str ">>"))
!appl_10 <- appl_9 `pseq` kl_Ats (Types.Atom (Types.Str "<")) appl_9
appl_10 `pseq` kl_Ats (Types.Atom (Types.Str "<")) appl_10
_ -> throwError "if: expected boolean"
_ -> throwError "if: expected boolean"
kl_shen_print_vectorP :: Types.KLValue ->
Types.KLContext Types.Env Types.KLValue
kl_shen_print_vectorP (!kl_V3980) = do let !appl_0 = ApplC (Func "lambda" (Context (\(!kl_Zero) -> do let pat_cond_1 = do return (Atom (B True))
pat_cond_2 = do do let pat_cond_3 = do return (Atom (B True))
pat_cond_4 = do do !appl_5 <- kl_Zero `pseq` numberP kl_Zero
!kl_if_6 <- appl_5 `pseq` kl_not appl_5
case kl_if_6 of
Atom (B (True)) -> do kl_Zero `pseq` kl_shen_fboundP kl_Zero
Atom (B (False)) -> do do return (Atom (B False))
_ -> throwError "if: expected boolean"
in case kl_Zero of
kl_Zero@(Atom (UnboundSym "shen.pvar")) -> pat_cond_3
kl_Zero@(ApplC (PL "shen.pvar"
_)) -> pat_cond_3
kl_Zero@(ApplC (Func "shen.pvar"
_)) -> pat_cond_3
_ -> pat_cond_4
in case kl_Zero of
kl_Zero@(Atom (UnboundSym "shen.tuple")) -> pat_cond_1
kl_Zero@(ApplC (PL "shen.tuple"
_)) -> pat_cond_1
kl_Zero@(ApplC (Func "shen.tuple"
_)) -> pat_cond_1
_ -> pat_cond_2)))
!appl_7 <- kl_V3980 `pseq` addressFrom kl_V3980 (Types.Atom (Types.N (Types.KI 0)))
appl_7 `pseq` applyWrapper appl_0 [appl_7]
kl_shen_fboundP :: Types.KLValue ->
Types.KLContext Types.Env Types.KLValue
kl_shen_fboundP (!kl_V3982) = do (do !appl_0 <- kl_V3982 `pseq` kl_ps kl_V3982
appl_0 `pseq` kl_do appl_0 (Atom (B True))) `catchError` (\(!kl_E) -> do return (Atom (B False)))
kl_shen_tuple :: Types.KLValue ->
Types.KLContext Types.Env Types.KLValue
kl_shen_tuple (!kl_V3984) = do !appl_0 <- kl_V3984 `pseq` addressFrom kl_V3984 (Types.Atom (Types.N (Types.KI 1)))
!appl_1 <- kl_V3984 `pseq` addressFrom kl_V3984 (Types.Atom (Types.N (Types.KI 2)))
!appl_2 <- appl_1 `pseq` kl_shen_app appl_1 (Types.Atom (Types.Str ")")) (Types.Atom (Types.UnboundSym "shen.s"))
!appl_3 <- appl_2 `pseq` cn (Types.Atom (Types.Str " ")) appl_2
!appl_4 <- appl_0 `pseq` (appl_3 `pseq` kl_shen_app appl_0 appl_3 (Types.Atom (Types.UnboundSym "shen.s")))
appl_4 `pseq` cn (Types.Atom (Types.Str "(@p ")) appl_4
kl_shen_iter_vector :: Types.KLValue ->
Types.KLValue ->
Types.KLValue ->
Types.KLValue -> Types.KLContext Types.Env Types.KLValue
kl_shen_iter_vector (!kl_V3995) (!kl_V3996) (!kl_V3997) (!kl_V3998) = do let pat_cond_0 = do return (Types.Atom (Types.Str "... etc"))
pat_cond_1 = do do let !appl_2 = ApplC (Func "lambda" (Context (\(!kl_Item) -> do let !appl_3 = ApplC (Func "lambda" (Context (\(!kl_Next) -> do let pat_cond_4 = do return (Types.Atom (Types.Str ""))
pat_cond_5 = do do let pat_cond_6 = do kl_Item `pseq` (kl_V3997 `pseq` kl_shen_arg_RBstr kl_Item kl_V3997)
pat_cond_7 = do do !appl_8 <- kl_Item `pseq` (kl_V3997 `pseq` kl_shen_arg_RBstr kl_Item kl_V3997)
!appl_9 <- kl_V3996 `pseq` add kl_V3996 (Types.Atom (Types.N (Types.KI 1)))
!appl_10 <- kl_V3998 `pseq` Primitives.subtract kl_V3998 (Types.Atom (Types.N (Types.KI 1)))
!appl_11 <- kl_V3995 `pseq` (appl_9 `pseq` (kl_V3997 `pseq` (appl_10 `pseq` kl_shen_iter_vector kl_V3995 appl_9 kl_V3997 appl_10)))
!appl_12 <- appl_11 `pseq` kl_Ats (Types.Atom (Types.Str " ")) appl_11
appl_8 `pseq` (appl_12 `pseq` kl_Ats appl_8 appl_12)
in case kl_Next of
kl_Next@(Atom (UnboundSym "shen.out-of-bounds")) -> pat_cond_6
kl_Next@(ApplC (PL "shen.out-of-bounds"
_)) -> pat_cond_6
kl_Next@(ApplC (Func "shen.out-of-bounds"
_)) -> pat_cond_6
_ -> pat_cond_7
in case kl_Item of
kl_Item@(Atom (UnboundSym "shen.out-of-bounds")) -> pat_cond_4
kl_Item@(ApplC (PL "shen.out-of-bounds"
_)) -> pat_cond_4
kl_Item@(ApplC (Func "shen.out-of-bounds"
_)) -> pat_cond_4
_ -> pat_cond_5)))
!appl_13 <- (do !appl_14 <- kl_V3996 `pseq` add kl_V3996 (Types.Atom (Types.N (Types.KI 1)))
kl_V3995 `pseq` (appl_14 `pseq` addressFrom kl_V3995 appl_14)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.UnboundSym "shen.out-of-bounds")))
appl_13 `pseq` applyWrapper appl_3 [appl_13])))
!appl_15 <- (do kl_V3995 `pseq` (kl_V3996 `pseq` addressFrom kl_V3995 kl_V3996)) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.UnboundSym "shen.out-of-bounds")))
appl_15 `pseq` applyWrapper appl_2 [appl_15]
in case kl_V3998 of
kl_V3998@(Atom (N (KI 0))) -> pat_cond_0
_ -> pat_cond_1
kl_shen_atom_RBstr :: Types.KLValue ->
Types.KLContext Types.Env Types.KLValue
kl_shen_atom_RBstr (!kl_V4000) = do (do kl_V4000 `pseq` str kl_V4000) `catchError` (\(!kl_E) -> do kl_shen_funexstring)
kl_shen_funexstring :: Types.KLContext Types.Env Types.KLValue
kl_shen_funexstring = do !appl_0 <- intern (Types.Atom (Types.Str "x"))
!appl_1 <- appl_0 `pseq` kl_gensym appl_0
!appl_2 <- appl_1 `pseq` kl_shen_arg_RBstr appl_1 (Types.Atom (Types.UnboundSym "shen.a"))
!appl_3 <- appl_2 `pseq` kl_Ats appl_2 (Types.Atom (Types.Str "\\DC1"))
!appl_4 <- appl_3 `pseq` kl_Ats (Types.Atom (Types.Str "e")) appl_3
!appl_5 <- appl_4 `pseq` kl_Ats (Types.Atom (Types.Str "n")) appl_4
!appl_6 <- appl_5 `pseq` kl_Ats (Types.Atom (Types.Str "u")) appl_5
!appl_7 <- appl_6 `pseq` kl_Ats (Types.Atom (Types.Str "f")) appl_6
appl_7 `pseq` kl_Ats (Types.Atom (Types.Str "\\DLE")) appl_7
kl_shen_listP :: Types.KLValue ->
Types.KLContext Types.Env Types.KLValue
kl_shen_listP (!kl_V4002) = do !kl_if_0 <- kl_V4002 `pseq` kl_emptyP kl_V4002
case kl_if_0 of
Atom (B (True)) -> do return (Atom (B True))
Atom (B (False)) -> do do let pat_cond_1 kl_V4002 kl_V4002h kl_V4002t = do return (Atom (B True))
pat_cond_2 = do do return (Atom (B False))
in case kl_V4002 of
!(kl_V4002@(Cons (!kl_V4002h)
(!kl_V4002t))) -> pat_cond_1 kl_V4002 kl_V4002h kl_V4002t
_ -> pat_cond_2
_ -> throwError "if: expected boolean"
expr9 :: Types.KLContext Types.Env Types.KLValue
expr9 = do (do return (Types.Atom (Types.Str "Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."))) `catchError` (\(!kl_E) -> do return (Types.Atom (Types.Str "E")))