mirror of
https://github.com/grin-compiler/grin.git
synced 2024-09-11 15:37:54 +03:00
Merge pull request #25 from grin-tech/andorp/linker-2
Ability to create executable.
This commit is contained in:
commit
9bc5e51742
@ -109,7 +109,9 @@ pipelineOpts =
|
||||
<|> flg PureEval "eval" "Evaluate the grin program (pure)"
|
||||
<|> flg JITLLVM "llvm" "JIT with LLVM"
|
||||
<|> flg PrintAST "ast" "Print the Abstract Syntax Tree"
|
||||
<|> (SaveLLVM True <$> (strOption (mconcat [long "save-llvm", help "Save the generated llvm"])))
|
||||
<|> (SaveExecutable False . Abs <$> (strOption (mconcat [short 'o', long "save-elf", help "Save an executable ELF"])))
|
||||
<|> (SaveExecutable True . Abs <$> (strOption (mconcat [short 'o', long "save-elf-dbg", help "Save an executable ELF with debug symbols"])))
|
||||
<|> (SaveLLVM . Abs <$> (strOption (mconcat [long "save-llvm", help "Save the generated llvm"])))
|
||||
<|> (SaveGrin . Abs <$> (strOption (mconcat [long "save-grin", help "Save the generated grin"])))
|
||||
<|> (SaveBinary <$> (strOption (mconcat [long "save-binary", help "Save the generated grin in binary format"])))
|
||||
<|> (T <$> transformOpts)
|
||||
@ -171,7 +173,7 @@ main = do
|
||||
|
||||
postPipeline :: [PipelineStep]
|
||||
postPipeline =
|
||||
[ SaveLLVM True "high-level-opt-code"
|
||||
[ SaveLLVM $ Rel "high-level-opt-code"
|
||||
, JITLLVM -- TODO: Remove this.
|
||||
, PrintTypeEnv
|
||||
, PrintGrin ondullblack
|
||||
|
@ -215,6 +215,7 @@ test-suite grin-test
|
||||
, mtl
|
||||
, ansi-wl-pprint
|
||||
, directory
|
||||
, inline-c
|
||||
|
||||
other-modules:
|
||||
Transformations.Simplifying.RegisterIntroductionSpec
|
||||
@ -253,6 +254,7 @@ test-suite grin-test
|
||||
TestSpec
|
||||
PipelineSpec
|
||||
ParserSpec
|
||||
PrimOpsSpec
|
||||
NametableSpec
|
||||
AbstractInterpretation.HptSpec
|
||||
AbstractInterpretation.LiveVariableSpec
|
||||
|
243
grin/prim_ops.c
Normal file
243
grin/prim_ops.c
Normal file
@ -0,0 +1,243 @@
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <inttypes.h>
|
||||
#include <stdbool.h>
|
||||
#include <string.h>
|
||||
#include <unistd.h>
|
||||
#include "prim_ops.h"
|
||||
|
||||
#define BUFFER_SIZE 256
|
||||
|
||||
/*
|
||||
NOTES:
|
||||
|
||||
* In error cases we just simple exit as this part is still under active development.
|
||||
* _prim_ffi_file_eof is a placeholder implementation.
|
||||
|
||||
*/
|
||||
|
||||
|
||||
struct string* create_string_len(int64_t l) {
|
||||
struct string* r = (struct string*)malloc(sizeof(struct string));
|
||||
r->data = (char*)calloc(sizeof(char), l * sizeof(char));
|
||||
r->length = l;
|
||||
#ifdef DEBUG
|
||||
printf("create_string_len(%ld) = %d\n", l, (int)r);
|
||||
#endif
|
||||
return r;
|
||||
}
|
||||
|
||||
struct string* create_string_copy(char* str) {
|
||||
struct string* r = (struct string*)malloc(sizeof(struct string));
|
||||
int64_t l = strlen(str);
|
||||
r->data = (char*)malloc(l * sizeof(char));
|
||||
strncpy(r->data, str, l);
|
||||
r->length = l;
|
||||
#ifdef DEBUG
|
||||
printf("create_string_copy(\"%s\") = %d\n", str, (int)r);
|
||||
#endif
|
||||
return r;
|
||||
}
|
||||
|
||||
void cstring(char* buffer, struct string* s){
|
||||
memcpy(buffer, s->data, s->length);
|
||||
buffer[s->length] = 0;
|
||||
#ifdef DEBUG
|
||||
printf("cstring(%s, %d) = %d\n", buffer, (int)s, (int)buffer);
|
||||
#endif
|
||||
}
|
||||
|
||||
void _prim_string_print(struct string* p1){
|
||||
#ifdef DEBUG
|
||||
printf("_prim_string_print(%d)\n", (int)p1);
|
||||
#endif
|
||||
for(int i = 0; i < p1->length; i++) {
|
||||
putchar(p1->data[i]);
|
||||
}
|
||||
}
|
||||
|
||||
void _prim_int_print(int64_t p1) {
|
||||
#ifdef DEBUG
|
||||
printf("_prim_int_print(%d)\n", (int)p1);
|
||||
#endif
|
||||
printf("%ld", p1);
|
||||
}
|
||||
|
||||
struct string* _prim_read_string() {
|
||||
char *buffer = NULL;
|
||||
size_t len = 0;
|
||||
size_t read;
|
||||
read = getline(&buffer, &len, stdin);
|
||||
if (read == -1) {
|
||||
return create_string_len(0);
|
||||
} else {
|
||||
struct string* r = create_string_copy(buffer);
|
||||
free(buffer);
|
||||
#ifdef DEBUG
|
||||
printf("_prim_string_read() = %d\n", (int)r);
|
||||
#endif
|
||||
return r;
|
||||
}
|
||||
}
|
||||
|
||||
void _prim_usleep(int64_t p1) {
|
||||
#ifdef DEBUG
|
||||
printf("_prim_usleep(%ld)\n", p1);
|
||||
#endif
|
||||
usleep(p1); // p1 microseconds
|
||||
}
|
||||
|
||||
void _prim_error(struct string* p1) {
|
||||
#ifdef DEBUG
|
||||
printf("_prim_error(%d)\n", (int)p1);
|
||||
#endif
|
||||
_prim_string_print(p1);
|
||||
exit(-1);
|
||||
}
|
||||
|
||||
int64_t _prim_ffi_file_eof(int64_t p1) {
|
||||
// Currently this is a placeholder implementation for the idris frontend.
|
||||
// In the idris examples only the stdin gets tested for feof so p1 is ignored by now.
|
||||
// Appropiate file handling will be implemented later on.
|
||||
#ifdef DEBUG
|
||||
printf("_prim_ffi_file_eof(%ld)\n", p1);
|
||||
#endif
|
||||
return feof(stdin);
|
||||
}
|
||||
|
||||
struct string* _prim_string_concat(struct string* p1, struct string* p2) {
|
||||
struct string* r = create_string_len(p1->length + p2->length);
|
||||
memcpy(r->data, p1->data, p1->length);
|
||||
memcpy(r->data + p1->length, p2->data, p2-> length);
|
||||
#ifdef DEBUG
|
||||
printf("_prim_string_concat(%d,%d) = %d\n", (int)p1, (int)p2, (int)r);
|
||||
#endif
|
||||
return r;
|
||||
}
|
||||
|
||||
struct string* _prim_string_reverse(struct string* src){
|
||||
struct string* dst = create_string_len(src->length);
|
||||
for(size_t i = 0; i < src->length; i++) {
|
||||
dst->data[i] = src->data[src->length - i - 1];
|
||||
}
|
||||
#ifdef DEBUG
|
||||
printf("_prim_string_reverse(%d)\n", (int)src);
|
||||
#endif
|
||||
return dst;
|
||||
}
|
||||
|
||||
int64_t _prim_string_eq(struct string* p1, struct string* p2){
|
||||
#ifdef DEBUG
|
||||
printf("_prim_string_eq(%d,%d)\n", (int)p1, (int)p2);
|
||||
#endif
|
||||
if(p1->length != p2->length) {
|
||||
return 0;
|
||||
}
|
||||
return memcmp(p1->data, p2->data, p1->length) == 0;
|
||||
}
|
||||
|
||||
int64_t _prim_string_lt(struct string* p1, struct string* p2) {
|
||||
#ifdef DEBUG
|
||||
printf("_prim_string_lt(%d,%d)\n", (int)p1, (int)p2);
|
||||
#endif
|
||||
int len = (p1->length < p2->length)?(p1->length):(p2->length);
|
||||
int cmp = memcmp(p1->data,p2->data, len);
|
||||
if (p1->length < p2->length) {
|
||||
return (int64_t)(cmp <= 0);
|
||||
} else {
|
||||
return (int64_t)(cmp < 0);
|
||||
}
|
||||
}
|
||||
|
||||
int64_t _prim_string_head(struct string* p1) {
|
||||
#ifdef DEBUG
|
||||
printf("_prim_string_head(%d)\n", (int)p1);
|
||||
#endif
|
||||
if (p1->length == 0) {
|
||||
printf("_prim_string_head\n");
|
||||
exit(-1);
|
||||
}
|
||||
return (int64_t)p1->data[0];
|
||||
}
|
||||
|
||||
int64_t _prim_string_len(struct string* p1) {
|
||||
#ifdef DEBUG
|
||||
printf("_prim_string_len(%d) = %ld\n", (int)p1, p1 -> length);
|
||||
#endif
|
||||
return p1->length;
|
||||
}
|
||||
|
||||
struct string* _prim_string_tail(struct string* p1){
|
||||
if(p1->length == 0) {
|
||||
printf("_prim_string_tail\n");
|
||||
exit(-1);
|
||||
}
|
||||
struct string* r = create_string_len(p1->length - 1);
|
||||
memcpy(r->data, p1->data + 1, r->length);
|
||||
#ifdef DEBUG
|
||||
printf("_prim_string_tail(%d) = %d\n", (int)p1, (int)r);
|
||||
#endif
|
||||
return r;
|
||||
}
|
||||
|
||||
struct string* _prim_string_cons(int64_t p1, struct string* p2){
|
||||
struct string* r = create_string_len(p2->length + 1);
|
||||
r->data[0] = (char)p1;
|
||||
memcpy(r->data+1,p2->data,p2->length);
|
||||
#ifdef DEBUG
|
||||
printf("_prim_string_cons(%ld, %d) = %d\n", p1, (int)p2, (int)r);
|
||||
#endif
|
||||
return r;
|
||||
}
|
||||
|
||||
struct string* _prim_int_str(int64_t p1){
|
||||
#ifdef DEBUG
|
||||
printf("_prim_int_str(%ld)\n", p1);
|
||||
#endif
|
||||
char buffer[BUFFER_SIZE];
|
||||
int len = snprintf(buffer, BUFFER_SIZE, "%ld", p1);
|
||||
if (len >= 0 && len < BUFFER_SIZE) {
|
||||
return create_string_copy(buffer);
|
||||
} else {
|
||||
printf("_prim_int_str\n");
|
||||
exit(-1);
|
||||
}
|
||||
}
|
||||
|
||||
int64_t _prim_str_int(struct string* p1) {
|
||||
#ifdef DEBUG
|
||||
printf("_prim_str_int(%d)\n", (int)p1);
|
||||
#endif
|
||||
char buffer[p1->length+1];
|
||||
cstring(buffer, p1);
|
||||
int64_t r = strtoll(buffer, NULL, 10);
|
||||
return r;
|
||||
}
|
||||
|
||||
float _prim_int_float(int64_t p1) {
|
||||
#ifdef DEBUG
|
||||
printf("_prim_int_float(%ld)\n", p1);
|
||||
#endif
|
||||
return (float)p1;
|
||||
}
|
||||
|
||||
struct string* _prim_float_string(float p1) {
|
||||
#ifdef DEBUG
|
||||
printf("_prim_float_string(%f)\n", p1);
|
||||
#endif
|
||||
char buffer[BUFFER_SIZE];
|
||||
int len = snprintf(buffer, BUFFER_SIZE, "%.13g", p1);
|
||||
if (len >= 0 && len < BUFFER_SIZE) {
|
||||
return create_string_copy(buffer);
|
||||
} else {
|
||||
printf("_prim_float_string\n");
|
||||
exit(-1);
|
||||
}
|
||||
}
|
||||
|
||||
int64_t _prim_char_int(char p1) {
|
||||
#ifdef DEBUG
|
||||
printf("_prim_char_int(%c)\n", p1);
|
||||
#endif
|
||||
return (int64_t)p1;
|
||||
}
|
36
grin/prim_ops.h
Normal file
36
grin/prim_ops.h
Normal file
@ -0,0 +1,36 @@
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <inttypes.h>
|
||||
#include <stdbool.h>
|
||||
#include <string.h>
|
||||
|
||||
struct string {
|
||||
char* data;
|
||||
int64_t length;
|
||||
};
|
||||
|
||||
struct string* create_string_len(int64_t l);
|
||||
struct string* create_string_copy(char *str);
|
||||
|
||||
// ASSUMPTION: The buffer has enough memory allocated to store the string
|
||||
void cstring(char* buffer, struct string* s);
|
||||
|
||||
void _prim_string_print(struct string* p1);
|
||||
void _prim_int_print(int64_t p1);
|
||||
struct string* _prim_read_string();
|
||||
void _prim_usleep(int64_t p1);
|
||||
void _prim_error(struct string* p1);
|
||||
int64_t _prim_ffi_file_eof(int64_t p1);
|
||||
struct string* _prim_string_concat(struct string* p1, struct string* p2);
|
||||
struct string* _prim_string_reverse(struct string* p1);
|
||||
int64_t _prim_string_eq(struct string* p1, struct string* p2);
|
||||
int64_t _prim_string_head(struct string* p1);
|
||||
int64_t _prim_string_len(struct string* p1);
|
||||
struct string* _prim_string_tail(struct string* p1);
|
||||
struct string* _prim_string_cons(int64_t p1, struct string* p2);
|
||||
int64_t _prim_string_lt(struct string* p1, struct string* p2);
|
||||
struct string* _prim_int_str(int64_t p1);
|
||||
int64_t _prim_str_int(struct string* p1);
|
||||
float _prim_int_float(int64_t p1);
|
||||
struct string* _prim_float_string(float p1);
|
||||
int64_t _prim_char_int(char p1);
|
@ -78,6 +78,7 @@ external (External{..}) =
|
||||
<*> ty eRetType
|
||||
<*> mapM ty eArgsType
|
||||
<*> (pure eEffectful)
|
||||
<*> (pure eKind)
|
||||
|
||||
-- | Convert Names in the expression to Int identifiers and create
|
||||
-- an associated name table.
|
||||
@ -149,6 +150,7 @@ restore (exp, nt) = cata build exp where
|
||||
(rty eRetType)
|
||||
(map rty eArgsType)
|
||||
eEffectful
|
||||
eKind
|
||||
|
||||
rty :: Ty -> Ty
|
||||
rty = \case
|
||||
|
@ -108,13 +108,13 @@ satisfyM pred parser = do
|
||||
|
||||
externalBlock = do
|
||||
L.indentGuard sc EQ pos1
|
||||
kw "primop"
|
||||
ext <- const PrimOp <$> kw "primop" <|> const FFI <$> kw "ffi"
|
||||
eff <- const False <$> kw "pure" <|> const True <$> kw "effectful"
|
||||
i <- L.indentGuard sc GT pos1
|
||||
some $ try (external eff i)
|
||||
some $ try (external ext eff i)
|
||||
|
||||
external :: Bool -> Pos -> Parser External
|
||||
external eff i = do
|
||||
external :: ExternalKind -> Bool -> Pos -> Parser External
|
||||
external ext eff i = do
|
||||
L.indentGuard sc EQ i
|
||||
name <- var
|
||||
L.indentGuard sc GT i >> op "::"
|
||||
@ -125,6 +125,7 @@ external eff i = do
|
||||
, eRetType = retTy
|
||||
, eArgsType = reverse argTyRev
|
||||
, eEffectful = eff
|
||||
, eKind = ext
|
||||
}
|
||||
|
||||
tyP :: Parser Ty
|
||||
|
@ -188,7 +188,7 @@ instance Pretty EffectMap where
|
||||
prettyExternals :: [External] -> Doc
|
||||
prettyExternals exts = vcat (map prettyExtGroup $ groupBy (\a b -> eEffectful a == eEffectful b) exts) where
|
||||
prettyExtGroup [] = mempty
|
||||
prettyExtGroup l@(a : _) = keyword "primop" <+> (if eEffectful a then keyword "effectful" else keyword "pure") <$$> indent 2
|
||||
prettyExtGroup l@(a : _) = (keyword $ case eKind a of { PrimOp -> "primop"; FFI -> "ffi" }) <+> (if eEffectful a then keyword "effectful" else keyword "pure") <$$> indent 2
|
||||
(vsep [prettyFunction (eName, (eRetType, V.fromList eArgsType)) | External{..} <- l] <> line)
|
||||
|
||||
instance Pretty Ty where
|
||||
|
@ -13,27 +13,27 @@ import Grin.TH
|
||||
primPrelude :: Program
|
||||
primPrelude = [progConst|
|
||||
|
||||
primop effectful
|
||||
_prim_int_print :: T_Int64 -> T_Unit
|
||||
ffi effectful
|
||||
_prim_int_print :: T_Int64 -> T_Unit
|
||||
_prim_usleep :: T_Int64 -> T_Unit
|
||||
_prim_string_print :: T_String -> T_Unit
|
||||
_prim_read_string :: T_String
|
||||
_prim_usleep :: T_Int64 -> T_Unit
|
||||
_prim_error :: T_String -> T_Unit
|
||||
|
||||
-- FFI - TODO: Handle FFI appropiately
|
||||
_prim_ffi_file_eof :: T_Int64 -> T_Int64
|
||||
|
||||
primop pure
|
||||
-- Everything that handles Strings are FFI implemented now.
|
||||
ffi pure
|
||||
-- String
|
||||
_prim_string_concat :: T_String -> T_String -> T_String
|
||||
_prim_string_reverse :: T_String -> T_String
|
||||
_prim_string_lt :: T_String -> T_String -> T_Bool
|
||||
_prim_string_eq :: T_String -> T_String -> T_Bool
|
||||
_prim_string_head :: T_String -> T_Int64
|
||||
_prim_string_lt :: T_String -> T_String -> T_Int64
|
||||
_prim_string_eq :: T_String -> T_String -> T_Int64
|
||||
_prim_string_head :: T_String -> T_Int64 -- TODO: Change to Char
|
||||
_prim_string_tail :: T_String -> T_String
|
||||
_prim_string_cons :: T_Int64 -> T_String -> T_String
|
||||
_prim_string_len :: T_String -> T_Int64
|
||||
|
||||
ffi pure
|
||||
-- Conversion
|
||||
_prim_int_str :: T_Int64 -> T_String
|
||||
_prim_str_int :: T_String -> T_Int64
|
||||
@ -41,6 +41,7 @@ primPrelude = [progConst|
|
||||
_prim_float_string :: T_Float -> T_String
|
||||
_prim_char_int :: T_Char -> T_Int64
|
||||
|
||||
primop pure
|
||||
-- Int
|
||||
_prim_int_shr :: T_Int64 -> T_Int64
|
||||
_prim_int_add :: T_Int64 -> T_Int64 -> T_Int64
|
||||
|
@ -32,12 +32,18 @@ data Ty
|
||||
| TySimple SimpleType
|
||||
deriving (Generic, Data, NFData, Eq, Ord, Show)
|
||||
|
||||
data ExternalKind
|
||||
= PrimOp -- ^ Implemented in the internal code generator
|
||||
| FFI -- ^ Implemented in C and linked during the linker phase
|
||||
deriving (Generic, Data, NFData, Eq, Ord, Show)
|
||||
|
||||
data External
|
||||
= External
|
||||
{ eName :: Name
|
||||
, eRetType :: Ty
|
||||
, eArgsType :: [Ty]
|
||||
, eEffectful :: Bool
|
||||
, eKind :: ExternalKind
|
||||
}
|
||||
deriving (Generic, Data, NFData, Eq, Ord, Show)
|
||||
|
||||
@ -117,6 +123,7 @@ externals = \case
|
||||
-- * Binary instances
|
||||
|
||||
deriving instance Binary Name
|
||||
deriving instance Binary ExternalKind
|
||||
deriving instance Binary External
|
||||
deriving instance Binary Ty
|
||||
deriving instance Binary SimpleType
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveAnyClass, StandaloneDeriving #-}
|
||||
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveAnyClass, StandaloneDeriving, LambdaCase #-}
|
||||
module Grin.SyntaxDefs where
|
||||
|
||||
import Data.Text (Text, unpack)
|
||||
@ -31,6 +31,11 @@ instance IsString Name where
|
||||
instance PrintfArg Name where
|
||||
formatArg = formatString . unpack . unNM
|
||||
|
||||
nameString :: Name -> String
|
||||
nameString = \case
|
||||
NM n -> unpack n
|
||||
_ -> error "Name index found." -- This could have left in the AST after a problematic deserialisation.
|
||||
|
||||
-- * GRIN Tag
|
||||
|
||||
data TagType = C | F | P Int {-missing parameter count-}
|
||||
|
@ -75,7 +75,7 @@ import qualified AbstractInterpretation.Sharing.CodeGen as Sharing
|
||||
import qualified Reducer.LLVM.CodeGen as CGLLVM
|
||||
import qualified Reducer.LLVM.JIT as JITLLVM
|
||||
import System.Directory
|
||||
import System.Process
|
||||
import qualified System.Process
|
||||
import Data.Bifunctor
|
||||
|
||||
import qualified Data.Bimap as Bimap
|
||||
@ -188,7 +188,8 @@ data PipelineStep
|
||||
| PureEval
|
||||
| JITLLVM
|
||||
| PrintAST
|
||||
| SaveLLVM Bool FilePath
|
||||
| SaveLLVM Path
|
||||
| SaveExecutable Bool Path -- Debug, Outputfile
|
||||
| SaveGrin Path
|
||||
| SaveBinary String
|
||||
| DebugTransformationH (Hidden (Exp -> Exp))
|
||||
@ -425,7 +426,8 @@ pipelineStep p = do
|
||||
PrintGrin d -> printGrinM d
|
||||
PureEval -> pureEval
|
||||
JITLLVM -> jitLLVM
|
||||
SaveLLVM relPath path -> saveLLVM relPath path
|
||||
SaveLLVM path -> saveLLVM path
|
||||
SaveExecutable dbg path -> saveExecutable dbg path
|
||||
SaveGrin path -> saveGrin path
|
||||
SaveBinary name -> saveBinary name
|
||||
PrintAST -> printAST
|
||||
@ -653,23 +655,46 @@ saveBinary name = do
|
||||
let fname = printf "%03d.%s.binary" n name
|
||||
liftIO $ Binary.encodeFile (outputDir </> fname) ent
|
||||
|
||||
saveLLVM :: Bool -> FilePath -> PipelineM ()
|
||||
saveLLVM relPath fname' = do
|
||||
e <- use psExp
|
||||
relPath :: Path -> PipelineM String
|
||||
relPath path = do
|
||||
n <- use psSaveIdx
|
||||
Just typeEnv <- use psTypeEnv
|
||||
o <- view poOutputDir
|
||||
let fname = if relPath then o </> printf "%03d.%s" n fname' else fname'
|
||||
code = CGLLVM.codeGen typeEnv e
|
||||
llName = printf "%s.ll" fname
|
||||
sName = printf "%s.s" fname
|
||||
liftIO . void $ do
|
||||
Text.putStrLn $ ppllvm code
|
||||
putStrLn "* to LLVM *"
|
||||
_ <- CGLLVM.toLLVM llName code
|
||||
putStrLn "* LLVM X64 codegen *"
|
||||
callCommand $ printf "opt-7 -O3 %s | llc-7 -o %s" llName sName
|
||||
readFile sName >>= putStrLn
|
||||
pure $ case path of
|
||||
Abs fname -> fname
|
||||
Rel fname -> o </> printf "%03d.%s" n fname
|
||||
|
||||
callCommand :: String -> PipelineM ()
|
||||
callCommand cmd = do
|
||||
pipelineLog $ "Call command:" ++ cmd
|
||||
liftIO $ System.Process.callCommand cmd
|
||||
|
||||
saveLLVM :: Path -> PipelineM ()
|
||||
saveLLVM path = do
|
||||
e <- use psExp
|
||||
Just typeEnv <- use psTypeEnv
|
||||
fname <- relPath path
|
||||
let code = CGLLVM.codeGen typeEnv e
|
||||
let llName = printf "%s.ll" fname
|
||||
let sName = printf "%s.s" fname
|
||||
pipelineLog "* to LLVM *"
|
||||
void $ liftIO $ CGLLVM.toLLVM llName code
|
||||
pipelineLog"* LLVM X64 codegen *"
|
||||
callCommand $ printf "opt-7 -O3 %s | llc-7 -o %s" llName (sName :: String)
|
||||
|
||||
saveExecutable :: Bool -> Path -> PipelineM ()
|
||||
saveExecutable debugSymbols path = do
|
||||
pipelineLog "* generate llvm x64 optcode *"
|
||||
let grinOptCodePath = Rel "grin-opt-code"
|
||||
pipelineStep $ SaveLLVM grinOptCodePath
|
||||
grinOptCodeFile <- relPath grinOptCodePath
|
||||
fname <- relPath path
|
||||
pipelineLog "* generate executable *"
|
||||
callCommand $ printf
|
||||
("llc-7 -O3 -relocation-model=pic -filetype=obj %s.ll" ++ if debugSymbols then " -debugger-tune=gdb" else "")
|
||||
grinOptCodeFile
|
||||
callCommand $ printf
|
||||
("clang-7 -O3 prim_ops.c runtime.c %s.o -s -o %s" ++ if debugSymbols then " -g" else "")
|
||||
grinOptCodeFile fname
|
||||
|
||||
debugTransformation :: (Exp -> Exp) -> PipelineM ()
|
||||
debugTransformation t = do
|
||||
|
@ -11,6 +11,7 @@ import Lens.Micro.Platform
|
||||
import Data.Word
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Text (Text)
|
||||
import Data.Vector (Vector)
|
||||
|
||||
import Grin.Grin as Grin
|
||||
@ -55,6 +56,8 @@ data Env
|
||||
, _envTempCounter :: Int
|
||||
, _envTypeEnv :: TypeEnv.TypeEnv
|
||||
, _envTagMap :: Map Tag Constant
|
||||
, _envStringMap :: Map Text AST.Name -- Grin String Literal -> AST.Name
|
||||
, _envStringCounter :: Int
|
||||
}
|
||||
|
||||
emptyEnv = Env
|
||||
@ -68,6 +71,8 @@ emptyEnv = Env
|
||||
, _envTempCounter = 0
|
||||
, _envTypeEnv = TypeEnv.emptyTypeEnv
|
||||
, _envTagMap = mempty
|
||||
, _envStringMap = mempty
|
||||
, _envStringCounter = 0
|
||||
}
|
||||
|
||||
concat <$> mapM makeLenses [''Env]
|
||||
|
@ -18,8 +18,14 @@ import qualified Data.Set as Set
|
||||
import Data.Vector (Vector)
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.List as List
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.ByteString.Short as ShortByteString
|
||||
import Data.String (fromString)
|
||||
import Text.Printf (printf)
|
||||
import Lens.Micro.Mtl
|
||||
|
||||
import LLVM.AST hiding (callingConvention, functionAttributes)
|
||||
import LLVM.AST.AddrSpace
|
||||
import LLVM.AST.Type as LLVM
|
||||
import qualified LLVM.AST.Typed as LLVM
|
||||
import LLVM.AST.Constant as C hiding (Add, ICmp)
|
||||
@ -36,6 +42,7 @@ import LLVM.Module
|
||||
|
||||
import Control.Monad.Except
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.ByteString.Short as BSShort
|
||||
|
||||
import Grin.Grin as Grin
|
||||
import Grin.Pretty
|
||||
@ -46,6 +53,8 @@ import Reducer.LLVM.PrimOps
|
||||
import Reducer.LLVM.TypeGen
|
||||
import Reducer.LLVM.InferType
|
||||
|
||||
|
||||
|
||||
debugMode :: Bool
|
||||
debugMode = True
|
||||
|
||||
@ -55,12 +64,25 @@ toLLVM fname mod = withContext $ \ctx -> do
|
||||
BS.writeFile fname llvm
|
||||
pure llvm
|
||||
|
||||
codeGenLit :: Lit -> C.Constant
|
||||
codeGenLit :: Lit -> CG C.Constant
|
||||
codeGenLit = \case
|
||||
LInt64 v -> Int {integerBits=64, integerValue=fromIntegral v}
|
||||
LWord64 v -> Int {integerBits=64, integerValue=fromIntegral v}
|
||||
LFloat v -> C.Float {floatValue=F.Single v}
|
||||
LBool v -> Int {integerBits=1, integerValue=if v then 1 else 0}
|
||||
LInt64 v -> pure $ Int {integerBits=64, integerValue=fromIntegral v}
|
||||
LWord64 v -> pure $ Int {integerBits=64, integerValue=fromIntegral v}
|
||||
LFloat v -> pure $ C.Float {floatValue=F.Single v}
|
||||
LBool v -> pure $ Int {integerBits=1, integerValue=if v then 1 else 0}
|
||||
LChar v -> pure $ Int {integerBits=8, integerValue=fromIntegral $ fromEnum v}
|
||||
LString v -> C.GlobalReference stringType <$> strName v
|
||||
|
||||
strName :: Text.Text -> CG AST.Name
|
||||
strName str = do
|
||||
mName <- use $ envStringMap . at str
|
||||
case mName of
|
||||
Just n -> pure n
|
||||
Nothing -> do
|
||||
counter <- envStringCounter <<%= succ
|
||||
let n = Name $ fromString $ "str." ++ show counter
|
||||
envStringMap %= Map.insert str n
|
||||
pure n
|
||||
|
||||
codeGenVal :: Val -> CG Operand
|
||||
codeGenVal val = case val of
|
||||
@ -95,7 +117,7 @@ codeGenVal val = case val of
|
||||
|
||||
ValTag tag -> ConstantOperand <$> getTagId tag
|
||||
Unit -> pure unit
|
||||
Lit lit -> pure . ConstantOperand . codeGenLit $ lit
|
||||
Lit lit -> ConstantOperand <$> codeGenLit lit
|
||||
Var name -> do
|
||||
Map.lookup name <$> gets _constantMap >>= \case
|
||||
-- QUESTION: what is this?
|
||||
@ -111,7 +133,7 @@ codeGenVal val = case val of
|
||||
getCPatConstant :: CPat -> CG Constant
|
||||
getCPatConstant = \case
|
||||
TagPat tag -> getTagId tag
|
||||
LitPat lit -> pure $ codeGenLit lit
|
||||
LitPat lit -> codeGenLit lit
|
||||
NodePat tag args -> getTagId tag
|
||||
DefaultPat -> pure C.TokenNone
|
||||
|
||||
@ -122,7 +144,10 @@ getCPatName = \case
|
||||
LInt64 v -> "int_" <> showTS v
|
||||
LWord64 v -> "word_" <> showTS v
|
||||
LBool v -> "bool_" <> showTS v
|
||||
LChar v -> "char_" <> showTS v
|
||||
LString v -> error "pattern match on string is not supported"
|
||||
LFloat v -> error "pattern match on float is not supported"
|
||||
other -> error $ "pattern match not implemented: " ++ show other
|
||||
NodePat tag _ -> tagName tag
|
||||
DefaultPat -> "default"
|
||||
where
|
||||
@ -138,7 +163,7 @@ getCPatName = \case
|
||||
toModule :: Env -> AST.Module
|
||||
toModule Env{..} = defaultModule
|
||||
{ moduleName = "basic"
|
||||
, moduleDefinitions = heapPointerDef : reverse _envDefinitions
|
||||
, moduleDefinitions = heapPointerDef : (stringDefinitions) ++ (reverse _envDefinitions)
|
||||
}
|
||||
where
|
||||
heapPointerDef = GlobalDefinition globalVariableDefaults
|
||||
@ -147,6 +172,30 @@ toModule Env{..} = defaultModule
|
||||
, initializer = Just $ Int 64 0
|
||||
}
|
||||
|
||||
stringDefinitions = concat
|
||||
[ [ GlobalDefinition globalVariableDefaults
|
||||
{ name = valAstName
|
||||
, Global.type' = ArrayType (fromIntegral (length stringVal)) i8
|
||||
, initializer = Just $ C.Array i8 $ [Int 8 $ fromIntegral $ fromEnum v0 | v0 <- stringVal]
|
||||
}
|
||||
, GlobalDefinition globalVariableDefaults
|
||||
{ name = astName
|
||||
, Global.type' = stringStructType
|
||||
, initializer = Just $ C.Struct Nothing False -- TODO: Set struct name
|
||||
[ C.GetElementPtr
|
||||
{ inBounds = True
|
||||
, address = GlobalReference (PointerType (ArrayType (fromIntegral (length stringVal)) i8) (AddrSpace 0)) valAstName
|
||||
, indices = [Int {integerBits=64, integerValue=0}, Int {integerBits=64, integerValue=0}]
|
||||
}
|
||||
, Int 64 $ fromIntegral $ length stringVal
|
||||
]
|
||||
}
|
||||
]
|
||||
| (stringVal0, astName@(Name astNameBS)) <- Map.toList _envStringMap
|
||||
, let stringVal = Text.unpack stringVal0
|
||||
, let valAstName = Name $ BSShort.pack $ (BSShort.unpack astNameBS) ++ (BSShort.unpack ".val") -- Append ShortByteStrings
|
||||
]
|
||||
|
||||
{-
|
||||
type of:
|
||||
ok - SApp Name [SimpleVal]
|
||||
@ -194,12 +243,14 @@ codeGen typeEnv exp = toModule $ flip execState (emptyEnv {_envTypeEnv = typeEnv
|
||||
SAppF name args -> do
|
||||
(retType, argTypes) <- getFunctionType name
|
||||
operands <- mapM codeGenVal args
|
||||
operandsTypes <- mapM (\x -> toCGType <$> typeOfVal x) args
|
||||
operandsTypes <- mapM (fmap toCGType . typeOfVal) args
|
||||
-- convert values to function argument type
|
||||
convertedArgs <- sequence $ zipWith3 codeGenValueConversion operandsTypes operands argTypes
|
||||
if isExternalName (externals exp) name
|
||||
then codeGenPrimOp name args convertedArgs
|
||||
else do
|
||||
let findExternalName :: TypeEnv.Name -> Maybe External
|
||||
findExternalName n = List.find ((n ==) . eName) (externals exp)
|
||||
case findExternalName name of
|
||||
Just e -> codeExternal e convertedArgs
|
||||
Nothing -> do
|
||||
-- call to top level functions
|
||||
let functionType = FunctionType
|
||||
{ resultType = cgLLVMType retType
|
||||
@ -282,7 +333,7 @@ codeGen typeEnv exp = toModule $ flip execState (emptyEnv {_envTypeEnv = typeEnv
|
||||
|
||||
ProgramF exts defs -> do
|
||||
-- register prim fun lib
|
||||
registerPrimFunLib
|
||||
mapM registerPrimFunLib exts
|
||||
sequence_ (map snd defs) >> pure (O unitCGType unit)
|
||||
|
||||
SFetchIF name Nothing -> do
|
||||
@ -353,6 +404,15 @@ codeGenStoreNode val nodeLocation = do
|
||||
pure $ (unitCGType, unit)
|
||||
pure ()
|
||||
|
||||
convertStringOperand t o = case (cgType t,o) of
|
||||
(T_SimpleType T_String, ConstantOperand stringRef@(GlobalReference{}))
|
||||
-> ConstantOperand $ C.GetElementPtr
|
||||
{ inBounds = False
|
||||
, address = stringRef
|
||||
, indices = [Int {integerBits=64, integerValue=0}, Int {integerBits=64, integerValue=0}]
|
||||
}
|
||||
_ -> o
|
||||
|
||||
codeGenCase :: Operand -> [(Alt, CG Result)] -> (CPat -> CG ()) -> CG Result
|
||||
codeGenCase opVal alts bindingGen = do
|
||||
curBlockName <- gets _currentBlockName
|
||||
@ -435,6 +495,7 @@ codeGenTagSwitch tagVal nodeSet tagAltGen | Map.size nodeSet > 1 = do
|
||||
activeBlock lastAltBlock
|
||||
-- HINT: convert alt result to common type
|
||||
convertedAltOp <- codeGenValueConversion altCGTy altOp resultCGType
|
||||
|
||||
closeBlock $ Br
|
||||
{ dest = switchExit
|
||||
, metadata' = []
|
||||
@ -509,9 +570,16 @@ external retty label argtys = modify' (\env@Env{..} -> env {_envDefinitions = de
|
||||
}
|
||||
|
||||
-- available primitive functions
|
||||
registerPrimFunLib :: CG ()
|
||||
registerPrimFunLib = do
|
||||
external VoidType (mkName "_prim_int_print") [(i64, mkName "x")]
|
||||
registerPrimFunLib :: External -> CG ()
|
||||
registerPrimFunLib ext = do
|
||||
external
|
||||
(toLLVMType $ eRetType ext)
|
||||
(mkName $ Text.unpack $ unNM $ eName ext)
|
||||
[ (toLLVMType t, mkName ("x" ++ show n)) | (t,n) <- (eArgsType ext) `zip` [1..] ]
|
||||
where
|
||||
toLLVMType = \case
|
||||
TySimple t -> typeGenSimpleType t
|
||||
rest -> error $ "Unsupported type:" ++ show rest
|
||||
|
||||
errorBlock = do
|
||||
activeBlock $ mkName "error_block"
|
||||
|
@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Reducer.LLVM.PrimOps where
|
||||
|
||||
import Control.Monad (when)
|
||||
import LLVM.AST
|
||||
import qualified LLVM.AST.IntegerPredicate as I
|
||||
import qualified LLVM.AST.FloatingPointPredicate as F
|
||||
@ -13,66 +14,88 @@ import qualified Grin.Grin as Grin
|
||||
import Grin.TypeEnv hiding (function)
|
||||
import Reducer.LLVM.Base
|
||||
import Reducer.LLVM.TypeGen
|
||||
import Grin.PrimOpsPrelude
|
||||
|
||||
|
||||
cgUnit = toCGType $ T_SimpleType T_Unit :: CGType
|
||||
cgInt64 = toCGType $ T_SimpleType T_Int64 :: CGType
|
||||
cgWord64 = toCGType $ T_SimpleType T_Word64 :: CGType
|
||||
cgFloat = toCGType $ T_SimpleType T_Float :: CGType
|
||||
cgBool = toCGType $ T_SimpleType T_Bool :: CGType
|
||||
cgString = toCGType $ T_SimpleType T_String :: CGType
|
||||
cgChar = toCGType $ T_SimpleType T_Char :: CGType
|
||||
|
||||
codeGenPrimOp :: Grin.Name -> [Grin.Val] -> [Operand] -> CG Result
|
||||
codeGenPrimOp name _ [opA, opB] = case name of
|
||||
codeExternal :: Grin.External -> [Operand] -> CG Result
|
||||
codeExternal e ops = case Grin.eKind e of
|
||||
Grin.PrimOp -> codeGenPrimOp (Grin.eName e) ops
|
||||
Grin.FFI -> codeGenFFI e ops
|
||||
|
||||
codeGenPrimOp :: Grin.Name -> [Operand] -> CG Result
|
||||
codeGenPrimOp name [opA, opB] = pure $ case name of
|
||||
-- Int
|
||||
"_prim_int_add" -> pure . I cgInt64 $ Add {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_sub" -> pure . I cgInt64 $ Sub {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_mul" -> pure . I cgInt64 $ Mul {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_div" -> pure . I cgInt64 $ SDiv {exact=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_eq" -> pure . I cgBool $ ICmp {iPredicate=I.EQ, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_ne" -> pure . I cgBool $ ICmp {iPredicate=I.NE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_gt" -> pure . I cgBool $ ICmp {iPredicate=I.SGT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_ge" -> pure . I cgBool $ ICmp {iPredicate=I.SGE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_lt" -> pure . I cgBool $ ICmp {iPredicate=I.SLT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_le" -> pure . I cgBool $ ICmp {iPredicate=I.SLE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_add" -> I cgInt64 $ Add {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_sub" -> I cgInt64 $ Sub {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_mul" -> I cgInt64 $ Mul {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_div" -> I cgInt64 $ SDiv {exact=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_eq" -> I cgBool $ ICmp {iPredicate=I.EQ, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_ne" -> I cgBool $ ICmp {iPredicate=I.NE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_gt" -> I cgBool $ ICmp {iPredicate=I.SGT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_ge" -> I cgBool $ ICmp {iPredicate=I.SGE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_lt" -> I cgBool $ ICmp {iPredicate=I.SLT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_int_le" -> I cgBool $ ICmp {iPredicate=I.SLE, operand0=opA, operand1=opB, metadata=[]}
|
||||
|
||||
-- Word
|
||||
"_prim_word_add" -> pure . I cgWord64 $ Add {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_sub" -> pure . I cgWord64 $ Sub {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_mul" -> pure . I cgWord64 $ Mul {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_div" -> pure . I cgWord64 $ UDiv {exact=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_eq" -> pure . I cgBool $ ICmp {iPredicate=I.EQ, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_ne" -> pure . I cgBool $ ICmp {iPredicate=I.NE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_gt" -> pure . I cgBool $ ICmp {iPredicate=I.UGT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_ge" -> pure . I cgBool $ ICmp {iPredicate=I.UGE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_lt" -> pure . I cgBool $ ICmp {iPredicate=I.ULT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_le" -> pure . I cgBool $ ICmp {iPredicate=I.ULE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_add" -> I cgWord64 $ Add {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_sub" -> I cgWord64 $ Sub {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_mul" -> I cgWord64 $ Mul {nsw=False, nuw=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_div" -> I cgWord64 $ UDiv {exact=False, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_eq" -> I cgBool $ ICmp {iPredicate=I.EQ, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_ne" -> I cgBool $ ICmp {iPredicate=I.NE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_gt" -> I cgBool $ ICmp {iPredicate=I.UGT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_ge" -> I cgBool $ ICmp {iPredicate=I.UGE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_lt" -> I cgBool $ ICmp {iPredicate=I.ULT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_word_le" -> I cgBool $ ICmp {iPredicate=I.ULE, operand0=opA, operand1=opB, metadata=[]}
|
||||
|
||||
-- Float
|
||||
"_prim_float_add" -> pure . I cgFloat $ FAdd {fastMathFlags=noFastMathFlags, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_sub" -> pure . I cgFloat $ FSub {fastMathFlags=noFastMathFlags, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_mul" -> pure . I cgFloat $ FMul {fastMathFlags=noFastMathFlags, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_div" -> pure . I cgFloat $ FDiv {fastMathFlags=noFastMathFlags, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_eq" -> pure . I cgBool $ FCmp {fpPredicate=F.OEQ, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_ne" -> pure . I cgBool $ FCmp {fpPredicate=F.ONE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_gt" -> pure . I cgBool $ FCmp {fpPredicate=F.OGT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_ge" -> pure . I cgBool $ FCmp {fpPredicate=F.OGE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_lt" -> pure . I cgBool $ FCmp {fpPredicate=F.OLT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_le" -> pure . I cgBool $ FCmp {fpPredicate=F.OLE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_add" -> I cgFloat $ FAdd {fastMathFlags=noFastMathFlags, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_sub" -> I cgFloat $ FSub {fastMathFlags=noFastMathFlags, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_mul" -> I cgFloat $ FMul {fastMathFlags=noFastMathFlags, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_div" -> I cgFloat $ FDiv {fastMathFlags=noFastMathFlags, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_eq" -> I cgBool $ FCmp {fpPredicate=F.OEQ, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_ne" -> I cgBool $ FCmp {fpPredicate=F.ONE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_gt" -> I cgBool $ FCmp {fpPredicate=F.OGT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_ge" -> I cgBool $ FCmp {fpPredicate=F.OGE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_lt" -> I cgBool $ FCmp {fpPredicate=F.OLT, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_float_le" -> I cgBool $ FCmp {fpPredicate=F.OLE, operand0=opA, operand1=opB, metadata=[]}
|
||||
|
||||
-- Bool
|
||||
"_prim_bool_eq" -> pure . I cgBool $ ICmp {iPredicate=I.EQ, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_bool_ne" -> pure . I cgBool $ ICmp {iPredicate=I.NE, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_bool_eq" -> I cgBool $ ICmp {iPredicate=I.EQ, operand0=opA, operand1=opB, metadata=[]}
|
||||
"_prim_bool_ne" -> I cgBool $ ICmp {iPredicate=I.NE, operand0=opA, operand1=opB, metadata=[]}
|
||||
|
||||
codeGenPrimOp "_prim_int_print" _ [opA] = pure . I cgUnit $ Call
|
||||
{ tailCallKind = Nothing
|
||||
, callingConvention = CC.C
|
||||
, returnAttributes = []
|
||||
, function = Right $ ConstantOperand $ C.GlobalReference (fun void [i64]) (mkName "_prim_int_print")
|
||||
, arguments = [(opA, [])]
|
||||
, functionAttributes = []
|
||||
, metadata = []
|
||||
_ -> error $ "unknown primop: " ++ show name
|
||||
|
||||
codeGenFFI :: Grin.External -> [Operand] -> CG Result
|
||||
codeGenFFI e ops = do
|
||||
if (length ops /= length (Grin.eArgsType e))
|
||||
then error $ "Non saturated function call: " ++ show (e, ops)
|
||||
else mkFunction (Grin.nameString $ Grin.eName e) (ops `zip` (Grin.eArgsType e)) (Grin.eRetType e)
|
||||
|
||||
mkFunction name ops_params_ty ret_ty = pure . I (tyToCGType ret_ty) $ Call
|
||||
{ tailCallKind = Nothing
|
||||
, callingConvention = CC.C
|
||||
, returnAttributes = []
|
||||
, function = Right $ ConstantOperand $ C.GlobalReference (fun (tyToLLVMType ret_ty) (tyToLLVMType <$> params_ty)) (mkName name)
|
||||
, arguments = ops `zip` repeat []
|
||||
, functionAttributes = []
|
||||
, metadata = []
|
||||
}
|
||||
where
|
||||
ptr ty = PointerType { pointerReferent = ty, pointerAddrSpace = AddrSpace 0}
|
||||
fun ret args = ptr FunctionType {resultType = ret, argumentTypes = args, isVarArg = False}
|
||||
|
||||
codeGenPrimOp name args _ = error $ "unknown primitive operation: " ++ Grin.unpackName name ++ " arguments: " ++ show args
|
||||
(ops, params_ty) = unzip ops_params_ty
|
||||
tyToLLVMType t = case t of
|
||||
Grin.TySimple st -> typeGenSimpleType st
|
||||
_ -> error $ "Non simple type in: " ++ show (name, t)
|
||||
tyToCGType t = case t of
|
||||
Grin.TySimple st -> toCGType (T_SimpleType st)
|
||||
_ -> error $ "Non simple type in: " ++ show (name, t)
|
||||
fptr ty = PointerType { pointerReferent = ty, pointerAddrSpace = AddrSpace 0}
|
||||
fun ret args = fptr FunctionType {resultType = ret, argumentTypes = args, isVarArg = False}
|
||||
|
@ -7,6 +7,7 @@ import Text.Printf
|
||||
import Data.Word
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Vector (Vector)
|
||||
@ -27,16 +28,24 @@ import Grin.Grin as Grin
|
||||
import Grin.TypeEnv
|
||||
import Grin.Pretty
|
||||
|
||||
-- QUESTION: T_Dead case?
|
||||
stringStructType :: LLVM.Type
|
||||
stringStructType = LLVM.StructureType False [ptr i8, i64]
|
||||
|
||||
stringType :: LLVM.Type
|
||||
stringType = ptr stringStructType
|
||||
|
||||
typeGenSimpleType :: SimpleType -> LLVM.Type
|
||||
typeGenSimpleType = \case
|
||||
T_Int64 -> i64
|
||||
T_Word64 -> i64
|
||||
T_Float -> float
|
||||
T_Bool -> i1
|
||||
T_String -> stringType
|
||||
T_Char -> i8
|
||||
T_Unit -> LLVM.void
|
||||
T_Location _ -> locationLLVMType
|
||||
T_UnspecifiedLocation -> locationLLVMType
|
||||
T_Dead -> error $ "Dead/unused type was given."
|
||||
|
||||
locationCGType :: CGType
|
||||
locationCGType = toCGType $ T_SimpleType $ T_Location []
|
||||
@ -189,9 +198,8 @@ toCGType t = case t of
|
||||
getVarType :: Grin.Name -> CG CGType
|
||||
getVarType name = do
|
||||
TypeEnv{..} <- gets _envTypeEnv
|
||||
case Map.lookup name _variable of
|
||||
Nothing -> error ("unknown variable " ++ unpackName name)
|
||||
Just ty -> pure $ toCGType ty
|
||||
pure $ maybe (error ("unknown variable " ++ unpackName name)) toCGType
|
||||
$ Map.lookup name _variable
|
||||
|
||||
getFunctionType :: Grin.Name -> CG (CGType, [CGType])
|
||||
getFunctionType name = do
|
||||
|
@ -18,6 +18,7 @@ import Data.Char (chr, ord)
|
||||
import Grin.Grin
|
||||
import Data.Map.Strict as Map
|
||||
import Data.String (fromString)
|
||||
import Data.Functor.Infix ((<$$>))
|
||||
import Data.Text as Text
|
||||
import Control.Monad.IO.Class
|
||||
|
||||
@ -54,8 +55,8 @@ evalPrimOp name params args = case name of
|
||||
"_prim_string_tail" -> string_un_op string Text.tail
|
||||
"_prim_string_len" -> string_un_op int (fromIntegral . Text.length)
|
||||
"_prim_string_concat" -> string_bin_op string (\t1 t2 -> Text.concat [t1, t2])
|
||||
"_prim_string_lt" -> string_bin_op bool (<)
|
||||
"_prim_string_eq" -> string_bin_op bool (==)
|
||||
"_prim_string_lt" -> string_bin_op int (boolean 0 1 <$$> (<))
|
||||
"_prim_string_eq" -> string_bin_op int (boolean 0 1 <$$> (==))
|
||||
"_prim_string_cons" -> string_cons
|
||||
|
||||
-- Int
|
||||
@ -178,3 +179,5 @@ evalPrimOp name params args = case name of
|
||||
primError = case args of
|
||||
[RT_Lit (LString msg)] -> liftIO (ioError $ userError $ Text.unpack msg) >> pure RT_Unit
|
||||
_ -> error $ "invalid arguments:" ++ show params ++ " " ++ show args ++ " for " ++ unpackName name
|
||||
|
||||
boolean f t x = if x then t else f
|
||||
|
@ -323,6 +323,8 @@ spec = do
|
||||
|
||||
primop pure
|
||||
_prim_string_concat :: T_String -> T_String -> T_String
|
||||
|
||||
ffi pure
|
||||
newArrayArray :: {Int} -> {State %s} -> {GHC.Prim.Unit {MutableArrayArray %s}}
|
||||
|
||||
grinMain = pure ()
|
||||
@ -334,12 +336,14 @@ spec = do
|
||||
, eRetType = TySimple T_Unit
|
||||
, eArgsType = [ TySimple T_String ]
|
||||
, eEffectful = True
|
||||
, eKind = PrimOp
|
||||
}
|
||||
, External
|
||||
{ eName = "_prim_read_string"
|
||||
, eRetType = TySimple T_String
|
||||
, eArgsType = []
|
||||
, eEffectful = True
|
||||
, eKind = PrimOp
|
||||
}
|
||||
, External
|
||||
{ eName = "newArrayArray#"
|
||||
@ -350,6 +354,7 @@ spec = do
|
||||
, TyCon "State#" [ TyVar "s" ]
|
||||
]
|
||||
, eEffectful = True
|
||||
, eKind = PrimOp
|
||||
}
|
||||
, External
|
||||
{ eName = "_prim_string_concat"
|
||||
@ -359,6 +364,7 @@ spec = do
|
||||
, TySimple T_String
|
||||
]
|
||||
, eEffectful = False
|
||||
, eKind = PrimOp
|
||||
}
|
||||
, External
|
||||
{ eName = "newArrayArray"
|
||||
@ -369,6 +375,7 @@ spec = do
|
||||
, TyCon "State" [ TyVar "s" ]
|
||||
]
|
||||
, eEffectful = False
|
||||
, eKind = FFI
|
||||
}
|
||||
]
|
||||
[ Def "grinMain" [] ( SReturn Unit ) ]
|
||||
@ -403,12 +410,14 @@ spec = do
|
||||
, TySimple T_String
|
||||
]
|
||||
, eEffectful = False
|
||||
, eKind = PrimOp
|
||||
}
|
||||
, External
|
||||
{ eName = NM { unNM = "_primB" }
|
||||
, eRetType = TySimple T_String
|
||||
, eArgsType = [ TySimple T_String ]
|
||||
, eEffectful = False
|
||||
, eKind = PrimOp
|
||||
}
|
||||
] []
|
||||
|
||||
|
237
grin/test/PrimOpsSpec.hs
Normal file
237
grin/test/PrimOpsSpec.hs
Normal file
@ -0,0 +1,237 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module PrimOpsSpec where
|
||||
|
||||
import Test.Hspec
|
||||
|
||||
import qualified Language.C.Inline as C
|
||||
import qualified Language.C.Inline.Unsafe as CU
|
||||
import Foreign.C.String
|
||||
import Foreign.Marshal.Alloc
|
||||
import Test.QuickCheck.Arbitrary (arbitrary)
|
||||
import Test.QuickCheck.Gen
|
||||
import Test.QuickCheck.Monadic
|
||||
|
||||
|
||||
C.include "<stdio.h>"
|
||||
C.include "../prim_ops.c"
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
let randomString = listOf $ elements ['a' .. 'z']
|
||||
let randomNonEmptyString = listOf1 $ elements ['a' .. 'z']
|
||||
describe "_prim_string_len" $ do
|
||||
let primStringLen str = do
|
||||
cstr <- newCString str
|
||||
l <- [C.block|long {
|
||||
struct string* s1 = create_string_copy($(char* cstr));
|
||||
return _prim_string_len(s1);
|
||||
}|]
|
||||
l `shouldBe` (fromIntegral $ length str)
|
||||
|
||||
it "works for empty string" $ primStringLen ""
|
||||
it "works for one element string" $ primStringLen "a"
|
||||
it "works for a longer string" $ primStringLen "1234567890"
|
||||
it "works for a random string" $ monadicIO $ do
|
||||
str <- pick randomString
|
||||
run $ primStringLen str
|
||||
|
||||
describe "_prim_string_concat" $ do
|
||||
let primSringConcat str1 str2 = do
|
||||
cstr1 <- newCString str1
|
||||
cstr2 <- newCString str2
|
||||
let n = length str1 + length str2 + 1
|
||||
allocaBytes n $ \buffer -> do
|
||||
[C.block|void{
|
||||
struct string* s1 = create_string_copy($(char* cstr1));
|
||||
struct string* s2 = create_string_copy($(char* cstr2));
|
||||
struct string* s3 = _prim_string_concat(s1,s2);
|
||||
cstring($(char* buffer), s3);
|
||||
}|]
|
||||
res <- peekCString buffer
|
||||
res `shouldBe` (str1 ++ str2)
|
||||
pure ()
|
||||
it "works for empty strings" $ primSringConcat "" ""
|
||||
it "works for empty string left" $ primSringConcat "" "a"
|
||||
it "works for empty string right" $ primSringConcat "a" ""
|
||||
it "works for one length strings" $ primSringConcat "a" "a"
|
||||
it "works for longer strings" $ primSringConcat "abc" "def"
|
||||
it "works for random strings" $ monadicIO $ do
|
||||
str1 <- pick randomString
|
||||
str2 <- pick randomString
|
||||
run $ primSringConcat str1 str2
|
||||
|
||||
describe "_prim_string_reverse" $ do
|
||||
let primStringReverse str = do
|
||||
cstr <- newCString str
|
||||
let n = length str + 1
|
||||
allocaBytes n $ \buffer -> do
|
||||
[C.block|void{
|
||||
struct string* s1 = create_string_copy($(char* cstr));
|
||||
struct string* s2 = _prim_string_reverse(s1);
|
||||
cstring($(char* buffer), s2);
|
||||
}|]
|
||||
res <- peekCString buffer
|
||||
res `shouldBe` (reverse str)
|
||||
pure ()
|
||||
it "works for empty string" $ primStringReverse ""
|
||||
it "works for one length string" $ primStringReverse "a"
|
||||
it "works for a longer string" $ primStringReverse "abcdefg"
|
||||
it "works for a random string" $ monadicIO $ do
|
||||
str <- pick randomString
|
||||
run $ primStringReverse str
|
||||
|
||||
describe "_prim_string_eq" $ do
|
||||
let primStringEq str1 str2 = do
|
||||
cstr1 <- newCString str1
|
||||
cstr2 <- newCString str2
|
||||
r <- [C.block|long{
|
||||
struct string* s1 = create_string_copy($(char* cstr1));
|
||||
struct string* s2 = create_string_copy($(char* cstr2));
|
||||
return _prim_string_eq(s1, s2);
|
||||
}|]
|
||||
r `shouldBe` (if str1 == str2 then 1 else 0)
|
||||
it "works for empty strings" $ primStringEq "" ""
|
||||
it "works for empty string left" $ primStringEq "" "a"
|
||||
it "works for empty string right" $ primStringEq "a" ""
|
||||
it "works for same one length strings" $ primStringEq "a" "a"
|
||||
it "works for same strings" $ primStringEq "aa" "aa"
|
||||
it "works for different strings" $ primStringEq "abcd" "abce"
|
||||
it "works for random strings" $ monadicIO $ do
|
||||
str1 <- pick randomString
|
||||
str2 <- pick randomString
|
||||
run $ primStringEq str1 str2
|
||||
|
||||
describe "_prim_string_head" $ do
|
||||
let primStringHead str = do
|
||||
cstr <- newCString str
|
||||
r <- [C.block|long{
|
||||
struct string* s1 = create_string_copy($(char* cstr));
|
||||
return _prim_string_head(s1);
|
||||
}|]
|
||||
r `shouldBe` (fromIntegral $ fromEnum $ head str)
|
||||
it "works for one length string" $ primStringHead "a"
|
||||
it "works for a longer string" $ primStringHead "bfmdh"
|
||||
it "works for random non-empty strings" $ monadicIO $ do
|
||||
str1 <- pick randomNonEmptyString
|
||||
run $ primStringHead str1
|
||||
|
||||
describe "_prim_string_tail" $ do
|
||||
let primStringTail str = do
|
||||
cstr <- newCString str
|
||||
let n = length str
|
||||
allocaBytes n $ \buffer -> do
|
||||
[C.block|void{
|
||||
struct string* s1 = create_string_copy($(char* cstr));
|
||||
struct string* s2 = _prim_string_tail(s1);
|
||||
cstring($(char* buffer), s2);
|
||||
}|]
|
||||
res <- peekCString buffer
|
||||
res `shouldBe` (tail str)
|
||||
pure ()
|
||||
it "works for one element string" $ primStringTail "a"
|
||||
it "works for a longer string" $ primStringTail "lksdjfoa"
|
||||
it "works for a random non-empty strings" $ monadicIO $ do
|
||||
str1 <- pick randomNonEmptyString
|
||||
run $ primStringTail str1
|
||||
|
||||
describe "_prim_string_cons" $ do
|
||||
let primStringCons c0 str = do
|
||||
cstr <- newCString (str :: String)
|
||||
let n = length str + 1
|
||||
let c = C.CChar $ fromIntegral $ fromEnum c0
|
||||
allocaBytes n $ \buffer -> do
|
||||
[C.block|void{
|
||||
struct string* s1 = create_string_copy($(char* cstr));
|
||||
struct string* s2 = _prim_string_cons($(char c), s1);
|
||||
cstring($(char* buffer), s2);
|
||||
}|]
|
||||
res <- peekCString buffer
|
||||
res `shouldBe` (c0:str)
|
||||
pure ()
|
||||
it "works for empty string" $ primStringCons 'a' ""
|
||||
it "works for a one length string" $ primStringCons 'a' "b"
|
||||
it "works for a longer string" $ primStringCons 'a' "sdflkje"
|
||||
it "works for random string" $ monadicIO $ do
|
||||
c <- pick $ elements ['a' .. 'z']
|
||||
str <- pick $ randomString
|
||||
run $ primStringCons c str
|
||||
|
||||
describe "_prim_string_lt" $ do
|
||||
let primStringLt str1 str2 = do
|
||||
cstr1 <- newCString str1
|
||||
cstr2 <- newCString str2
|
||||
r <- [C.block|long{
|
||||
struct string* s1 = create_string_copy($(char* cstr1));
|
||||
struct string* s2 = create_string_copy($(char* cstr2));
|
||||
return _prim_string_lt(s1, s2);
|
||||
}|]
|
||||
r `shouldBe` (if str1 < str2 then 1 else 0)
|
||||
it "works for random strings" $ monadicIO $ do
|
||||
str1 <- pick randomString
|
||||
str2 <- pick randomString
|
||||
run $ primStringLt str1 str2
|
||||
|
||||
describe "_prim_int_str" $ do
|
||||
let primIntStr i0 = do
|
||||
let i = C.CLong i0
|
||||
allocaBytes 256 $ \buffer -> do
|
||||
[C.block|void{
|
||||
struct string* s1 = _prim_int_str($(long i));
|
||||
cstring($(char* buffer), s1);
|
||||
}|]
|
||||
res <- peekCString buffer
|
||||
res `shouldBe` (show i)
|
||||
pure ()
|
||||
it "works for random integers" $ monadicIO $ do
|
||||
i <- pick arbitrary
|
||||
run $ primIntStr i
|
||||
|
||||
describe "_prim_float_string" $ do
|
||||
let primIntStr f0 = do
|
||||
let f = C.CFloat f0
|
||||
allocaBytes 256 $ \buffer -> do
|
||||
[C.block|void{
|
||||
struct string* s1 = _prim_float_string($(float f));
|
||||
cstring($(char* buffer), s1);
|
||||
}|]
|
||||
res <- peekCString buffer
|
||||
res `shouldBe` (show f0)
|
||||
pure ()
|
||||
xit "works for random float" $ monadicIO $ do
|
||||
f <- pick arbitrary
|
||||
run $ primIntStr f
|
||||
|
||||
describe "_prim_str_int" $ do
|
||||
let primStrInt i = do
|
||||
cstr <- newCString (show i)
|
||||
r <- [C.block|long{
|
||||
struct string* s1 = create_string_copy($(char* cstr));
|
||||
return _prim_str_int(s1);
|
||||
}|]
|
||||
r `shouldBe` i
|
||||
it "works for random integers" $ monadicIO $ do
|
||||
i <- pick arbitrary
|
||||
run $ primStrInt i
|
||||
|
||||
describe "_prim_int_float" $ do
|
||||
let primIntFloat i0 = do
|
||||
let i = C.CLong i0
|
||||
r <- [C.block|float{
|
||||
return _prim_int_float($(long i));
|
||||
}|]
|
||||
r `shouldBe` (fromIntegral i)
|
||||
it "works for random integers" $ monadicIO $ do
|
||||
i <- pick arbitrary
|
||||
run $ primIntFloat i
|
||||
|
||||
describe "_prim_char_int" $ do
|
||||
let primCharInt c0 = do
|
||||
let c = C.CChar $ fromIntegral $ fromEnum c0
|
||||
r <- [C.block|long{
|
||||
return _prim_char_int($(char c));
|
||||
}|]
|
||||
r `shouldBe` (fromIntegral $ fromEnum c0)
|
||||
it "works for random chars" $ monadicIO $ do
|
||||
c <- pick $ elements ['a' .. 'z']
|
||||
run $ primCharInt c
|
102
grin/test_prim_ops.c
Normal file
102
grin/test_prim_ops.c
Normal file
@ -0,0 +1,102 @@
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include "prim_ops.h"
|
||||
|
||||
// Compile with
|
||||
// clang-7 prim_ops.c test_prim_ops.c -o test_prim_ops
|
||||
// This is a simple test file, the expected results are printed after the computed value.
|
||||
|
||||
int main() {
|
||||
|
||||
struct string* r = create_string_len(0);
|
||||
struct string* s1;
|
||||
struct string* s2;
|
||||
struct string* s3;
|
||||
struct string* s4;
|
||||
|
||||
s1 = create_string_copy("Hello.");
|
||||
s2 = create_string_copy("World");
|
||||
s3 = create_string_len(0);
|
||||
s4 = create_string_copy("");
|
||||
|
||||
_prim_string_print(_prim_string_concat(s1,s2));
|
||||
printf(" == Hello.World\n");
|
||||
_prim_string_print(_prim_string_concat(s1,s3));
|
||||
printf(" == Hello.\n");
|
||||
_prim_string_print(_prim_string_concat(s3,s2));
|
||||
printf(" == World\n");
|
||||
_prim_string_print(_prim_string_concat(s1,s4));
|
||||
printf(" == Hello.\n");
|
||||
_prim_string_print(_prim_string_concat(s4,s2));
|
||||
printf(" == World\n");
|
||||
_prim_string_print(_prim_string_concat(s3,s4));
|
||||
printf(" == \n");
|
||||
_prim_string_print(_prim_string_concat(s3,s4));
|
||||
printf(" == \n");
|
||||
|
||||
_prim_string_print(_prim_string_reverse(create_string_copy("")));
|
||||
printf(" == \n");
|
||||
_prim_string_print(_prim_string_reverse(create_string_copy("a")));
|
||||
printf(" == a\n");
|
||||
_prim_string_print(_prim_string_reverse(create_string_copy("ab")));
|
||||
printf(" == ba \n");
|
||||
_prim_string_print(_prim_string_reverse(create_string_copy("abc")));
|
||||
printf(" == cba\n");
|
||||
|
||||
printf("%ld == 1\n", _prim_string_eq(s1,s1));
|
||||
printf("%ld == 1\n", _prim_string_eq(s2,s2));
|
||||
printf("%ld == 1\n", _prim_string_eq(s3,s3));
|
||||
printf("%ld == 1\n", _prim_string_eq(s4,s4));
|
||||
printf("%ld == 1\n", _prim_string_eq(s3,s4));
|
||||
printf("%ld == 0\n", _prim_string_eq(s1,s2));
|
||||
printf("%ld == 0\n", _prim_string_eq(s3,s1));
|
||||
|
||||
printf("%c == H\n", (char)_prim_string_head(s1));
|
||||
|
||||
_prim_string_print(_prim_string_tail(create_string_copy("a")));
|
||||
printf(" == \n");
|
||||
_prim_string_print(_prim_string_tail(create_string_copy("ab")));
|
||||
printf(" == b\n");
|
||||
_prim_string_print(_prim_string_tail(create_string_copy("abc")));
|
||||
printf(" == bc\n");
|
||||
|
||||
_prim_string_print(_prim_string_cons(65, s3));
|
||||
printf(" == A\n");
|
||||
_prim_string_print(_prim_string_cons(65, create_string_copy("b")));
|
||||
printf(" == Ab\n");
|
||||
_prim_string_print(_prim_string_cons(65, create_string_copy("bc")));
|
||||
printf(" == Abc\n");
|
||||
|
||||
printf("%ld == 0\n", _prim_string_lt(create_string_copy(""), create_string_copy("")));
|
||||
printf("%ld == 1\n", _prim_string_lt(create_string_copy(""), create_string_copy("a")));
|
||||
printf("%ld == 0\n", _prim_string_lt(create_string_copy("a"), create_string_copy("a")));
|
||||
printf("%ld == 1\n", _prim_string_lt(create_string_copy("a"), create_string_copy("aa")));
|
||||
printf("%ld == 1\n", _prim_string_lt(create_string_copy("aa"), create_string_copy("ab")));
|
||||
printf("%ld == 1\n", _prim_string_lt(create_string_copy("aa"), create_string_copy("ab")));
|
||||
printf("%ld == 1\n", _prim_string_lt(create_string_copy("aaa"), create_string_copy("ab")));
|
||||
printf("%ld == 0\n", _prim_string_lt(create_string_copy("aaa"), create_string_copy("")));
|
||||
printf("%ld == 0\n", _prim_string_lt(create_string_copy("bbb"), create_string_copy("aaa")));
|
||||
|
||||
_prim_string_print(_prim_int_str(0));
|
||||
printf(" == 0\n");
|
||||
_prim_string_print(_prim_int_str(10));
|
||||
printf(" == 10\n");
|
||||
_prim_string_print(_prim_int_str(-10));
|
||||
printf(" == -10\n");
|
||||
|
||||
printf("%ld == 0\n", _prim_str_int(create_string_copy("0")));
|
||||
printf("%ld == 10\n", _prim_str_int(create_string_copy("10")));
|
||||
printf("%ld == +10\n", _prim_str_int(create_string_copy("+10")));
|
||||
printf("%ld == -10\n", _prim_str_int(create_string_copy("-10")));
|
||||
|
||||
_prim_string_print(_prim_float_string(0.0));
|
||||
printf(" == 0.0\n");
|
||||
_prim_string_print(_prim_float_string(10.123));
|
||||
printf(" == 10.123\n");
|
||||
_prim_string_print(_prim_float_string(-10.34));
|
||||
printf(" = -10.34\n");
|
||||
|
||||
printf("%d == 0\n", feof(stdin));
|
||||
|
||||
return 0;
|
||||
}
|
Loading…
Reference in New Issue
Block a user