module Compiler.Scheme.Chicken import Compiler.Commonimport Compiler.CompileExprimport Compiler.Inlineimport Compiler.Scheme.Common import Core.Contextimport Core.Directoryimport Core.Nameimport Core.Optionsimport Core.TT import Utils.Hex import Data.NameMapimport Data.Vectimport Systemimport System.Info %default covering findCSI : IO StringfindCSI =  do env <- getEnv "CHICKEN_CSI"     pure $ fromMaybe "/usr/bin/env -S csi" env findCSC : IO StringfindCSC =  do env <- getEnv "CHICKEN_CSC"     pure $ fromMaybe "/usr/bin/env -S csc" env schHeader : List String -> StringschHeader ds  = "(use numbers)\n" ++ unlines ds ++ "\n" ++    "(let ()\n" schFooter : StringschFooter = ")" showChickenChar : Char -> String -> StringshowChickenChar '\\' = ("\\\\" ++)showChickenChar c   = if c < chr 32 || c > chr 126        then (("\\u" ++ pad (asHex (cast c))) ++)        else strCons c  where    pad : String -> String    pad str        = case isLTE (length str) 4 of               Yes _ => cast (List.replicate (4 - length str) '0') ++ str               No _ => str showChickenString : List Char -> String -> StringshowChickenString [] = idshowChickenString ('"'::cs) = ("\\\"" ++) . showChickenString csshowChickenString (c ::cs) = (showChickenChar c) . showChickenString cs chickenString : String -> StringchickenString cs = strCons '"' (showChickenString (unpack cs) "\"") mutual  chickenPrim : Int -> SVars vars -> ExtPrim -> List (CExp vars) -> Core String  chickenPrim i vs CCall [ret, fn, args, world]      = throw (InternalError ("Can't compile C FFI calls to Chicken Scheme yet"))  chickenPrim i vs SysCodegen []      = pure $ "\"chicken\""  chickenPrim i vs prim args      = schExtCommon chickenPrim chickenString i vs prim args compileToSCM : Ref Ctxt Defs ->               ClosedTerm -> (outfile : String) -> Core ()compileToSCM c tm outfile    = do ds <- getDirectives Chicken         (ns, tags) <- findUsedNames tm         defs <- get Ctxt         compdefs <- traverse (getScheme chickenPrim chickenString defs) ns         let code = concat compdefs         main <- schExp chickenPrim chickenString 0 [] !(compileExp tags tm)         support <- readDataFile "chicken/support.scm"         let scm = schHeader ds ++ support ++ code ++ main ++ schFooter         Right () <- coreLift $ writeFile outfile scm            | Left err => throw (FileErr outfile err)         coreLift $ chmod outfile 0o755         pure () compileExpr : Ref Ctxt Defs -> (execDir : String) ->              ClosedTerm -> (outfile : String) -> Core (Maybe String)compileExpr c execDir tm outfile    = do tmp <- coreLift $ tmpName         let outn = tmp ++ ".scm"         compileToSCM c tm outn         csc <- coreLift findCSC         ok <- coreLift $ system (csc ++ " " ++ outn ++ " -o " ++ outfile)         if ok == 0            then pure (Just outfile)            else pure Nothing executeExpr : Ref Ctxt Defs -> (execDir : String) -> ClosedTerm -> Core ()executeExpr c execDir tm    = do tmp <- coreLift $ tmpName         let outn = tmp ++ ".scm"         compileToSCM c tm outn         csi <- coreLift findCSI         coreLift $ system (csi ++ " -s " ++ outn)         pure () exportcodegenChicken : CodegencodegenChicken = MkCG compileExpr executeExpr