mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
Added --compile-fast to compile with tcc.
This commit is contained in:
parent
850c1938ed
commit
59ef5bbf2b
52
app/Main.hs
52
app/Main.hs
@ -59,26 +59,30 @@ main = do setLocaleEncoding utf8
|
||||
noProfile = NoProfile `elem` otherOptions
|
||||
optimize = Optimize `elem` otherOptions
|
||||
generateOnly = GenerateOnly `elem` otherOptions
|
||||
projectWithFiles = defaultProject { projectCFlags = ["-D LOG_MEMORY" | logMemory] ++
|
||||
["-O3 -D NDEBUG" | optimize] ++
|
||||
projectCFlags defaultProject,
|
||||
projectCore = not noCore,
|
||||
projectGenerateOnly = generateOnly}
|
||||
compileFast = CompileFast `elem` otherOptions
|
||||
flagsSettings p = p { projectCFlags = ["-D LOG_MEMORY" | logMemory] ++
|
||||
["-O3 -D NDEBUG" | optimize] ++
|
||||
projectCFlags p
|
||||
, projectCore = not noCore
|
||||
, projectGenerateOnly = generateOnly
|
||||
, projectCarpDir = case lookup "CARP_DIR" sysEnv of
|
||||
Just carpDir -> carpDir
|
||||
Nothing -> projectCarpDir p
|
||||
, projectCompiler = if compileFast then "tcc -lm" else projectCompiler p
|
||||
}
|
||||
applySettings = flagsSettings . setCustomPromptFromOptions otherOptions
|
||||
project = applySettings defaultProject
|
||||
noArray = False
|
||||
coreModulesToLoad = if noCore then [] else coreModules (projectCarpDir projectWithCarpDir)
|
||||
projectWithCarpDir = case lookup "CARP_DIR" sysEnv of
|
||||
Just carpDir -> projectWithFiles { projectCarpDir = carpDir }
|
||||
Nothing -> projectWithFiles
|
||||
projectWithCustomPrompt = setCustomPromptFromOptions projectWithCarpDir otherOptions
|
||||
startingContext = Context
|
||||
(startingGlobalEnv noArray)
|
||||
Nothing
|
||||
(TypeEnv startingTypeEnv)
|
||||
[]
|
||||
projectWithCustomPrompt
|
||||
""
|
||||
execMode
|
||||
[]
|
||||
(startingGlobalEnv noArray)
|
||||
Nothing
|
||||
(TypeEnv startingTypeEnv)
|
||||
[]
|
||||
project
|
||||
""
|
||||
execMode
|
||||
[]
|
||||
coreModulesToLoad = if noCore then [] else coreModules (projectCarpDir project)
|
||||
context <- loadFilesOnce startingContext coreModulesToLoad
|
||||
carpProfile <- configPath "profile.carp"
|
||||
hasProfile <- doesFileExist carpProfile
|
||||
@ -110,6 +114,7 @@ data OtherOptions = NoCore
|
||||
| LogMemory
|
||||
| Optimize
|
||||
| GenerateOnly
|
||||
| CompileFast
|
||||
| SetPrompt String
|
||||
deriving (Show, Eq)
|
||||
|
||||
@ -130,6 +135,7 @@ parseArgs args = parseArgsInternal [] Repl [] args
|
||||
"--log-memory" -> parseArgsInternal filesToLoad execMode (LogMemory : otherOptions) restArgs
|
||||
"--optimize" -> parseArgsInternal filesToLoad execMode (Optimize : otherOptions) restArgs
|
||||
"--generate-only" -> parseArgsInternal filesToLoad execMode (GenerateOnly : otherOptions) restArgs
|
||||
"--compile-fast" -> parseArgsInternal filesToLoad execMode (CompileFast : otherOptions) restArgs
|
||||
"--prompt" -> case restArgs of
|
||||
newPrompt : restRestArgs ->
|
||||
parseArgsInternal filesToLoad execMode (SetPrompt newPrompt : otherOptions) restRestArgs
|
||||
@ -137,10 +143,10 @@ parseArgs args = parseArgsInternal [] Repl [] args
|
||||
error "No prompt given after --prompt"
|
||||
file -> parseArgsInternal (filesToLoad ++ [file]) execMode otherOptions restArgs
|
||||
|
||||
setCustomPromptFromOptions :: Project -> [OtherOptions] -> Project
|
||||
setCustomPromptFromOptions project (o:os) =
|
||||
setCustomPromptFromOptions :: [OtherOptions] -> Project -> Project
|
||||
setCustomPromptFromOptions (o:os) project =
|
||||
case o of
|
||||
SetPrompt newPrompt -> setCustomPromptFromOptions (project { projectPrompt = newPrompt }) os
|
||||
_ -> setCustomPromptFromOptions project os
|
||||
setCustomPromptFromOptions project _ =
|
||||
SetPrompt newPrompt -> setCustomPromptFromOptions os (project { projectPrompt = newPrompt })
|
||||
_ -> setCustomPromptFromOptions os project
|
||||
setCustomPromptFromOptions _ project =
|
||||
project
|
||||
|
2
carp.sh
2
carp.sh
@ -7,4 +7,4 @@ then
|
||||
CARP="cabal -v0 run carp"
|
||||
fi
|
||||
fi
|
||||
$CARP $BUILD_OPTS $"--" $*
|
||||
$CARP $BUILD_OPTS $"--" $CARP_OPTS $*
|
||||
|
@ -1,12 +1,10 @@
|
||||
(system-include "carp_safe_int.h")
|
||||
|
||||
(defmodule Int
|
||||
(not-on-windows ; this seems to generate invalid code on some windows machines
|
||||
(doc safe-add "Performs an addition and checks whether it overflowed.")
|
||||
(register safe-add (λ [Int Int (Ref Int)] Bool))
|
||||
(doc safe-sub "Performs an substraction and checks whether it overflowed.")
|
||||
(register safe-sub (λ [Int Int (Ref Int)] Bool))
|
||||
(doc safe-mul "Performs an multiplication and checks whether it overflowed.")
|
||||
(register safe-mul (λ [Int Int (Ref Int)] Bool))
|
||||
)
|
||||
(doc safe-add "Performs an addition and checks whether it overflowed.")
|
||||
(register safe-add (λ [Int Int (Ref Int)] Bool))
|
||||
(doc safe-sub "Performs an substraction and checks whether it overflowed.")
|
||||
(register safe-sub (λ [Int Int (Ref Int)] Bool))
|
||||
(doc safe-mul "Performs an multiplication and checks whether it overflowed.")
|
||||
(register safe-mul (λ [Int Int (Ref Int)] Bool))
|
||||
)
|
||||
|
@ -10,7 +10,23 @@ Long Long__MUL_(Long x, Long y) {
|
||||
Long Long__DIV_(Long x, Long y) {
|
||||
return x / y;
|
||||
}
|
||||
#ifndef _WIN32
|
||||
#if defined _WIN32 || defined __TINYC__
|
||||
bool Long_safe_MINUS_add(Long x, Long y, Long* res) {
|
||||
Long r = x + y;
|
||||
*res = r;
|
||||
return (y > 0) && (x > (INT64_MAX - y)) || (y < 0) && (x < (INT64_MIN - y));
|
||||
}
|
||||
bool Long_safe_MINUS_sub(Long x, Long y, Long* res) {
|
||||
Long r = x - y;
|
||||
*res = r;
|
||||
return (y > 0 && x < (INT64_MIN + y)) || (y < 0 && x > (INT64_MAX + y));
|
||||
}
|
||||
bool Long_safe_MINUS_mul(Long x, Long y, Long* res) {
|
||||
Long r = x * y;
|
||||
*res = r;
|
||||
return (r / y) != x;
|
||||
}
|
||||
#else
|
||||
bool Long_safe_MINUS_add(Long x, Long y, Long* res) {
|
||||
return __builtin_add_overflow(x, y, res);
|
||||
}
|
||||
|
@ -1,4 +1,22 @@
|
||||
#ifndef _WIN32
|
||||
#if defined _WIN32 || defined __TINYC__
|
||||
|
||||
bool Int_safe_MINUS_add(int x, int y, int* res) {
|
||||
int r = x + y;
|
||||
*res = r;
|
||||
return (y > 0) && (x > (INT_MAX - y)) || (y < 0) && (x < (INT_MIN - y));
|
||||
}
|
||||
bool Int_safe_MINUS_sub(int x, int y, int* res) {
|
||||
int r = x - y;
|
||||
*res = r;
|
||||
*res = x - y;
|
||||
return (y > 0 && x < (INT_MIN + y)) || (y < 0 && x > (INT_MAX + y));
|
||||
}
|
||||
bool Int_safe_MINUS_mul(int x, int y, int* res) {
|
||||
int r = x * y;
|
||||
*res = r;
|
||||
return (r / y) != x;
|
||||
}
|
||||
#else
|
||||
bool Int_safe_MINUS_add(int x, int y, int* res) {
|
||||
return __builtin_add_overflow(x, y, res);
|
||||
}
|
||||
|
@ -73,6 +73,6 @@ in
|
||||
if pkgs.lib.inNixShell
|
||||
then drv.env.overrideAttrs (o: {
|
||||
buildInputs = with pkgs; o.buildInputs ++ [ haskellPackages.cabal-install clang gdb ]
|
||||
++ linuxOnly [ flamegraph linuxPackages.perf ];
|
||||
++ linuxOnly [ flamegraph linuxPackages.perf tinycc ];
|
||||
})
|
||||
else drv
|
||||
|
@ -234,4 +234,5 @@
|
||||
(two-lengths-in-same-func)
|
||||
(changing-target-of-ref)
|
||||
(resolve-correctly)
|
||||
0
|
||||
))
|
||||
|
@ -701,10 +701,11 @@ memberToDecl indent (memberName, memberType) =
|
||||
|
||||
defStructToDeclaration :: Ty -> SymPath -> [XObj] -> String
|
||||
defStructToDeclaration structTy@(StructTy typeName typeVariables) path rest =
|
||||
let indent' = indentAmount
|
||||
let indent = indentAmount
|
||||
|
||||
typedefCaseToMemberDecl :: XObj -> State EmitterState [()]
|
||||
typedefCaseToMemberDecl (XObj (Arr members) _ _) = mapM (memberToDecl indent') (pairwise members)
|
||||
typedefCaseToMemberDecl (XObj (Arr []) _ _) = sequence $ pure $ appendToSrc (addIndent indent ++ "char __dummy;\n")
|
||||
typedefCaseToMemberDecl (XObj (Arr members) _ _) = mapM (memberToDecl indent) (pairwise members)
|
||||
typedefCaseToMemberDecl _ = error "Invalid case in typedef."
|
||||
|
||||
-- Note: the names of types are not namespaced
|
||||
|
@ -6,4 +6,6 @@
|
||||
|
||||
;; The one allocation left after 'carp_init_globals' should be 'g' itself:
|
||||
(defn main []
|
||||
(assert (= 1l (Debug.memory-balance))))
|
||||
(do
|
||||
(assert (= 1l (Debug.memory-balance)))
|
||||
0))
|
||||
|
Loading…
Reference in New Issue
Block a user