carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-11-04 01:25:04 +03:00
Code Issues Projects Releases Wiki Activity

Added --compile-fast to compile with tcc.

Browse Source
This commit is contained in:
Jorge Acereda 2020-05-15 01:22:10 +02:00
parent 850c1938ed
commit 59ef5bbf2b
9 changed files with 80 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
app/Main.hs
View File

@ -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] ++
compileFast = CompileFast `elem` otherOptions
flagsSettings p = p { projectCFlags = ["-D LOG_MEMORY" | logMemory] ++
["-O3 -D NDEBUG" | optimize] ++
projectCFlags defaultProject,
projectCore = not noCore,
projectGenerateOnly = generateOnly}
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
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
View File

@ -7,4 +7,4 @@ then
CARP="cabal -v0 run carp"
fi
fi
$CARP $BUILD_OPTS $"--" $*
$CARP $BUILD_OPTS $"--" $CARP_OPTS $*

2
core/SafeInt.carp
View File

@ -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))
)
)

18
core/carp_long.h
View File

@ -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);
}

20
core/carp_safe_int.h
View File

@ -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);
}

2
default.nix
View File

@ -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

1
examples/basics.carp
View File

@ -234,4 +234,5 @@
(two-lengths-in-same-func)
(changing-target-of-ref)
(resolve-correctly)
0
))

5
src/Emit.hs
View File

@ -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

4
test/init_global.carp
View File

@ -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))