ba99edd · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Merge remote-tracking branch 'idris-lang/master'

commitba99edda96a604b5db29b0139e485ca3ef7f250b authorOling Cat <olingcat@gmail.com> dateTue 3 Apr 2018, 14:38 (9 years ago) parented93603 4c5c430

30 files changed+961−1317

compare with master

unifiedsplit

.hlint.yamlnew file+61

@@ -0,0 +1,61 @@

1+# HLint configuration file

2+# https://github.com/ndmitchell/hlint

3+##########################

5+# This file contains a template configuration file, which is typically

6+# placed as .hlint.yaml in the root of your project

9+# Specify additional command line arguments

10+#

11+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]

12+

13+

14+# Control which extensions/flags/modules/functions can be used

15+#

16+# - extensions:

17+# - default: false # all extension are banned by default

18+# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used

19+# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module

20+#

21+# - flags:

22+# - {name: -w, within: []} # -w is allowed nowhere

23+#

24+# - modules:

25+# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'

26+# - {name: Control.Arrow, within: []} # Certain modules are banned entirely

27+#

28+# - functions:

29+# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules

30+

31+

32+# Add custom hints for this project

33+#

34+# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"

35+# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}

36+

37+

38+# Turn on hints that are off by default

39+#

40+# Ban "module X(module X) where", to require a real export list

41+# - warn: {name: Use explicit module export list}

42+#

43+# Replace a $ b $ c with a . b $ c

44+# - group: {name: dollar, enabled: true}

45+#

46+# Generalise map to fmap, ++ to <>

47+# - group: {name: generalise, enabled: true}

48+

49+

50+# Ignore some builtin hints

51+# - ignore: {name: Use let}

52+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules

53+- ignore: {name: Use camelCase}

54+- ignore: {name: Reduce duplication}

55+

56+# Define some custom infix operators

57+# - fixity: infixr 3 ~^#^~

58+

59+

60+# To generate a suitable file for HLint do:

61+# $ hlint --default > .hlint.yaml

CHANGELOG.md+2

@@ -18,6 +18,8 @@

1818+ Added a switch `--allow-capitalized-pattern-variables` to optionally allow capitalized pattern variables after they were prohibited in 1.2.0.

1919+ REPL now prints an error message if program compiled by `:exec` terminates

2020 abnormally.

21++ Idris now builds with GHC 8.4.

22++ In the C backend, the representation of Idris values at runtime has been reworked.

2123

2224# New in 1.2.0

2325

CONTRIBUTORS+1

@@ -126,6 +126,7 @@ Jonas De Vuyst

126126Jonas Westerlund

127127Jonathan Sterling

128128Joomy Korkut

129+Jorge Acereda

129130Joseph Huang

130131Josh Vera

131132JP Smith

HLint.hsdeleted−34

@@ -1,34 +0,0 @@

1−{-# LANGUAGE TemplateHaskell #-}

2−-- --------------------------------------------------------------- [ HLint.hs ]

3−-- HLint suggestions we like.

4−--

5−-- This is a work in progress and the list of

6−-- suggestions/warnings/errors will vary.

7−--

8−-- -------------------------------------------------------------------- [ EOH ]

9−

10−-- import "hint" HLint.HLint -- In case we want to use all of them.

11−

12−-- ------------------------------------------------------------ [ Suggestions ]

13−-- Styling that are good Suggestions but are okay if found.

14−

15−suggest "Use exitSuccess"

16−suggest "Use concatMap"

17−suggest "Use unwords"

18−suggest "Use null"

19−suggest "Redundant $"

20−suggest "Use list literal pattern"

21−suggest "Use list literal"

22−

23−-- ------------------------------------------------------------------- [ Warn ]

24−-- Styling that we think a programmer should be warned about using.

25−

26−

27−-- ------------------------------------------------------------------ [ Error ]

28−-- Styling that we think a programmer should not use at all.

29−

30−

31−-- ----------------------------------------------------------------- [ Ignore ]

32−-- Suggestions we want to ignore.

33−

34−-- -------------------------------------------------------------------- [ EOF ]

Setup.hs+19−9

@@ -14,7 +14,7 @@ import Distribution.Simple.InstallDirs as I

1414import Distribution.Simple.LocalBuildInfo as L

1515import qualified Distribution.Simple.Setup as S

1616import qualified Distribution.Simple.Program as P

17−import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, rewriteFile, notice, installOrdinaryFiles)

17+import Distribution.Simple.Utils

1818import Distribution.Compiler

1919import Distribution.PackageDescription

2020import Distribution.Text

@@ -66,28 +66,28 @@ windres verbosity = P.runProgramInvocation verbosity . P.simpleProgramInvocation

6666

6767usesGMP :: S.ConfigFlags -> Bool

6868usesGMP flags =

69− case lookup (mkFlagName "gmp") (S.configConfigurationsFlags flags) of

69+ case lookupFlagAssignment (mkFlagName "gmp") (S.configConfigurationsFlags flags) of

7070 Just True -> True

7171 Just False -> False

7272 Nothing -> False

7373

7474execOnly :: S.ConfigFlags -> Bool

7575execOnly flags =

76− case lookup (mkFlagName "execonly") (S.configConfigurationsFlags flags) of

76+ case lookupFlagAssignment (mkFlagName "execonly") (S.configConfigurationsFlags flags) of

7777 Just True -> True

7878 Just False -> False

7979 Nothing -> False

8080

8181isRelease :: S.ConfigFlags -> Bool

8282isRelease flags =

83− case lookup (mkFlagName "release") (S.configConfigurationsFlags flags) of

83+ case lookupFlagAssignment (mkFlagName "release") (S.configConfigurationsFlags flags) of

8484 Just True -> True

8585 Just False -> False

8686 Nothing -> False

8787

8888isFreestanding :: S.ConfigFlags -> Bool

8989isFreestanding flags =

90− case lookup (mkFlagName "freestanding") (S.configConfigurationsFlags flags) of

90+ case lookupFlagAssignment (mkFlagName "freestanding") (S.configConfigurationsFlags flags) of

9191 Just True -> True

9292 Just False -> False

9393 Nothing -> False

@@ -97,6 +97,11 @@ mkFlagName :: String -> FlagName

9797mkFlagName = FlagName

9898#endif

9999

100+#if !(MIN_VERSION_Cabal(2,2,0))

101+lookupFlagAssignment :: FlagName -> FlagAssignment -> Maybe Bool

102+lookupFlagAssignment = lookup

103+#endif

104+

100105-- -----------------------------------------------------------------------------

101106-- Clean

102107

@@ -123,7 +128,7 @@ generateBuildFlagsModule verbosity dir libdirs = do

123128 let buildFlagsModulePath = dir </> "BuildFlags_idris" Px.<.> "hs"

124129 putStrLn $ "Generating " ++ buildFlagsModulePath

125130 createDirectoryIfMissingVerbose verbosity True dir

126− rewriteFile buildFlagsModulePath contents

131+ rewriteFileEx verbosity buildFlagsModulePath contents

127132 where contents = "module BuildFlags_idris where \n\n" ++

128133 "extraLibDirs :: [String]\n" ++

129134 "extraLibDirs = " ++ show libdirs

@@ -136,7 +141,7 @@ generateVersionModule verbosity dir release = do

136141 putStrLn $ "Generating " ++ versionModulePath ++

137142 if release then " for release" else " for prerelease " ++ hash

138143 createDirectoryIfMissingVerbose verbosity True dir

139− rewriteFile versionModulePath (versionModuleContents hash)

144+ rewriteFileEx verbosity versionModulePath (versionModuleContents hash)

140145

141146 where versionModuleContents h = "module Version_idris where\n\n" ++

142147 "gitHash :: String\n" ++

@@ -150,7 +155,7 @@ generateTargetModule verbosity dir targetDir = do

150155 let targetModulePath = dir </> "Target_idris" Px.<.> "hs"

151156 putStrLn $ "Generating " ++ targetModulePath

152157 createDirectoryIfMissingVerbose verbosity True dir

153− rewriteFile targetModulePath (versionModuleContents absPath targetDir)

158+ rewriteFileEx verbosity targetModulePath (versionModuleContents absPath targetDir)

154159 where versionModuleContents absolute td = "module Target_idris where\n\n" ++

155160 "import System.FilePath\n" ++

156161 "import System.Environment\n" ++

@@ -176,7 +181,7 @@ generateToolchainModule verbosity srcDir toolDir = do

176181 "getToolchainDir = \"\""

177182 let toolPath = srcDir </> "Tools_idris" Px.<.> "hs"

178183 createDirectoryIfMissingVerbose verbosity True srcDir

179− rewriteFile toolPath (commonContent ++ toolContent)

184+ rewriteFileEx verbosity toolPath (commonContent ++ toolContent)

180185

181186idrisConfigure _ flags pkgdesc local = do

182187 configureRTS

@@ -240,6 +245,11 @@ idrisPostSDist args flags desc lbi = do

240245 (\e -> let e' = (e :: SomeException) in return ())

241246 postSDist simpleUserHooks args flags desc lbi

242247

248+#if !(MIN_VERSION_Cabal(2,0,0))

249+rewriteFileEx :: Verbosity -> FilePath -> String -> IO ()

250+rewriteFileEx _ = rewriteFile

251+#endif

252+

243253-- -----------------------------------------------------------------------------

244254-- Build

245255

benchmarks/build.pl+3−2

@@ -2,13 +2,14 @@

33$bmarks = `cat ALL`;

44@bm = split(/\n/, $bmarks);

5+$idris = $ENV{'IDRIS'} || "idris";

67foreach $b (@bm) {

78 if ($b =~ /([a-zA-Z0-9]+)\/([a-zA-Z0-9]+)\s+(.*)/) {

89 print "Building $1 / $2\n";

910 chdir $1;

10− system("idris --clean $2.ipkg");

11− system("idris --build $2.ipkg") == 0 or die "Unable to build $2: $?";

11+ system("$idris --clean $2.ipkg");

12+ system("$idris --build $2.ipkg") == 0 or die "Unable to build $2: $?";

1213 chdir "..";

1314 }

1415}

idris.cabal+2−2

@@ -100,7 +100,7 @@ source-repository head

100100

101101custom-setup

102102 setup-depends:

103− Cabal >= 1.10 && <2.1,

103+ Cabal >= 1.10 && <2.3,

104104 base >= 4 && <5,

105105 directory,

106106 filepath,

@@ -309,7 +309,7 @@ Library

309309 , vector-binary-instances < 0.3

310310 , zip-archive > 0.2.3.5 && < 0.4

311311 , fsnotify >= 0.2 && < 2.2

312− , async < 2.2

312+ , async < 2.3

313313

314314 if !impl(ghc >= 8.0)

315315 Build-Depends: semigroups == 0.18.*

libs/base/Makefile+1−1

@@ -1,4 +1,4 @@

1−IDRIS := idris

1+IDRIS ?= idris

22PKG := base

44build:

libs/contrib/CFFI/Types.idr+2−2

@@ -70,9 +70,9 @@ mutual

7070 alignOfCT I8 = 1

7171 alignOfCT I16 = 2

7272 alignOfCT I32 = 4

73− alignOfCT I64 = 8

73+ alignOfCT I64 = min prim__sizeofPtr 8

7474 alignOfCT FLOAT = 4

75− alignOfCT DOUBLE = 8

75+ alignOfCT DOUBLE = min prim__sizeofPtr 8

7676 alignOfCT PTR = prim__sizeofPtr

7777

7878 ||| Alignment requirement of the type

libs/contrib/Makefile+1−1

@@ -1,4 +1,4 @@

1−IDRIS := idris

1+IDRIS ?= idris

22PKG := contrib

44build:

libs/contrib/Network/Socket.idr+20−1

@@ -133,7 +133,7 @@ send sock dat = do

133133||| + `ResultCode` :: The result of the underlying function.

134134|||

135135||| @sock The socket on which to receive the message.

136−||| @len How much of the data to send.

136+||| @len How much of the data to receive.

137137recv : (sock : Socket)

138138 -> (len : ByteLength)

139139 -> IO (Either SocketError (String, ResultCode))

@@ -164,6 +164,25 @@ recv sock len = do

164164 freeRecvStruct (RSPtr recv_struct_ptr)

165165 pure $ Right (payload, recv_res)

166166

167+||| Receive all the remaining data on the specified socket.

168+|||

169+||| Returns on failure a `SocketError`

170+||| Returns on success the payload `String`

171+|||

172+||| @sock The socket on which to receive the message.

173+partial

174+recvAll : (sock : Socket) -> IO (Either SocketError String)

175+recvAll sock = recvRec sock [] 64

176+ where

177+ partial

178+ recvRec : Socket -> List String -> ByteLength -> IO (Either SocketError String)

179+ recvRec sock acc n = do res <- recv sock n

180+ case res of

181+ Left 0 => pure (Right $ concat $ reverse acc)

182+ Left c => pure (Left c)

183+ Right (str, _) => let n' = min (n * 2) 65536 in

184+ recvRec sock (str :: acc) n'

185+

167186||| Send a message.

168187|||

169188||| Returns on failure a `SocketError`

libs/effects/Makefile+1−1

@@ -1,4 +1,4 @@

1−IDRIS := idris

1+IDRIS ?= idris

22PKG := effects

44build:

libs/prelude/Makefile+1−1

@@ -1,4 +1,4 @@

1−IDRIS := idris

1+IDRIS ?= idris

22PKG := prelude

44build:

libs/pruviloj/Makefile+1−1

@@ -1,4 +1,4 @@

1−IDRIS := idris

1+IDRIS ?= idris

22PKG := pruviloj

44build:

rts/Makefile+1−1

@@ -40,6 +40,6 @@ install :

4040clean :

4141 rm -f $(OBJS) $(LIBTARGET) $(DYLIBTARGET)

4242

43−idris_rts.o: idris_rts.h

43+$(OBJS): $(HDRS)

4444

4545.PHONY: build install clean

rts/idris_bitstring.c+251−511

@@ -2,824 +2,564 @@

33#include "idris_rts.h"

5−VAL idris_b8CopyForGC(VM *vm, VAL a) {

6− uint8_t A = a->info.bits8;

7− VAL cl = allocate(sizeof(Closure), 1);

5+VAL idris_b8const(VM *vm, uint8_t a) {

6+ Bits8 * cl = iallocate(vm, sizeof(*cl), 0);

87 SETTY(cl, CT_BITS8);

9− cl->info.bits8 = A;

10− return cl;

8+ cl->bits8 = a;

9+ return (VAL)cl;

1110}

1211

13−VAL idris_b16CopyForGC(VM *vm, VAL a) {

14− uint16_t A = a->info.bits16;

15− VAL cl = allocate(sizeof(Closure), 1);

12+VAL idris_b16const(VM *vm, uint16_t a) {

13+ Bits16 * cl = iallocate(vm, sizeof(*cl), 0);

1614 SETTY(cl, CT_BITS16);

17− cl->info.bits16 = A;

18− return cl;

15+ cl->bits16 = a;

16+ return (VAL)cl;

1917}

2018

21−VAL idris_b32CopyForGC(VM *vm, VAL a) {

22− uint32_t A = a->info.bits32;

23− VAL cl = allocate(sizeof(Closure), 1);

19+VAL idris_b32const(VM *vm, uint32_t a) {

20+ Bits32 * cl = iallocate(vm, sizeof(*cl), 0);

2421 SETTY(cl, CT_BITS32);

25− cl->info.bits32 = A;

26− return cl;

22+ cl->bits32 = a;

23+ return (VAL)cl;

2724}

2825

29−VAL idris_b64CopyForGC(VM *vm, VAL a) {

30− uint64_t A = a->info.bits64;

31− VAL cl = allocate(sizeof(Closure), 1);

26+VAL idris_b64const(VM *vm, uint64_t a) {

27+ Bits64 * cl = iallocate(vm, sizeof(*cl), 0);

3228 SETTY(cl, CT_BITS64);

33− cl->info.bits64 = A;

34− return cl;

29+ cl->bits64 = a;

30+ return (VAL)cl;

3531}

3632

3733VAL idris_b8(VM *vm, VAL a) {

38− uint8_t A = GETINT(a);

39− VAL cl = allocate(sizeof(Closure), 0);

40− SETTY(cl, CT_BITS8);

41− cl->info.bits8 = (uint8_t) A;

42− return cl;

34+ return idris_b8const(vm, GETINT(a));

4335}

4436

4537VAL idris_b16(VM *vm, VAL a) {

46− uint16_t A = GETINT(a);

47− VAL cl = allocate(sizeof(Closure), 0);

48− SETTY(cl, CT_BITS16);

49− cl->info.bits16 = (uint16_t) A;

50− return cl;

38+ return idris_b16const(vm, GETINT(a));

5139}

5240

5341VAL idris_b32(VM *vm, VAL a) {

54− uint32_t A = GETINT(a);

55− VAL cl = allocate(sizeof(Closure), 0);

56− SETTY(cl, CT_BITS32);

57− cl->info.bits32 = (uint32_t) A;

58− return cl;

42+ return idris_b32const(vm, GETINT(a));

5943}

6044

6145VAL idris_b64(VM *vm, VAL a) {

62− uint64_t A = GETINT(a);

63− VAL cl = allocate(sizeof(Closure), 0);

64− SETTY(cl, CT_BITS64);

65− cl->info.bits64 = (uint64_t) A;

66− return cl;

46+ return idris_b64const(vm, GETINT(a));

6747}

6848

6949VAL idris_castB32Int(VM *vm, VAL a) {

70− return MKINT((i_int)a->info.bits32);

71−}

72−

73−VAL idris_b8const(VM *vm, uint8_t a) {

74− VAL cl = allocate(sizeof(Closure), 0);

75− SETTY(cl, CT_BITS8);

76− cl->info.bits8 = a;

77− return cl;

78−}

79−

80−VAL idris_b16const(VM *vm, uint16_t a) {

81− VAL cl = allocate(sizeof(Closure), 0);

82− SETTY(cl, CT_BITS16);

83− cl->info.bits16 = a;

84− return cl;

85−}

86−

87−VAL idris_b32const(VM *vm, uint32_t a) {

88− VAL cl = allocate(sizeof(Closure), 0);

89− SETTY(cl, CT_BITS32);

90− cl->info.bits32 = a;

91− return cl;

92−}

93−

94−VAL idris_b64const(VM *vm, uint64_t a) {

95− VAL cl = allocate(sizeof(Closure), 0);

96− SETTY(cl, CT_BITS64);

97− cl->info.bits64 = a;

98− return cl;

50+ return MKINT(GETBITS32(a));

9951}

10052

10153VAL idris_b8Plus(VM *vm, VAL a, VAL b) {

102− uint8_t A = a->info.bits8;

103− uint8_t B = b->info.bits8;

104− VAL cl = allocate(sizeof(Closure), 0);

105− SETTY(cl, CT_BITS8);

106− cl->info.bits8 = A + B;

107− return cl;

54+ uint8_t A = GETBITS8(a);

55+ uint8_t B = GETBITS8(b);

56+ return idris_b8const(vm, A + B);

10857}

10958

11059VAL idris_b8Minus(VM *vm, VAL a, VAL b) {

111− uint8_t A = a->info.bits8;

112− uint8_t B = b->info.bits8;

113− VAL cl = allocate(sizeof(Closure), 0);

114− SETTY(cl, CT_BITS8);

115− cl->info.bits8 = A - B;

116− return cl;

60+ uint8_t A = GETBITS8(a);

61+ uint8_t B = GETBITS8(b);

62+ return idris_b8const(vm, A - B);

11763}

11864

11965VAL idris_b8Times(VM *vm, VAL a, VAL b) {

120− uint8_t A = a->info.bits8;

121− uint8_t B = b->info.bits8;

122− VAL cl = allocate(sizeof(Closure), 0);

123− SETTY(cl, CT_BITS8);

124− cl->info.bits8 = A * B;

125− return cl;

66+ uint8_t A = GETBITS8(a);

67+ uint8_t B = GETBITS8(b);

68+ return idris_b8const(vm, A * B);

12669}

12770

12871VAL idris_b8UDiv(VM *vm, VAL a, VAL b) {

129− uint8_t A = a->info.bits8;

130− uint8_t B = b->info.bits8;

131− VAL cl = allocate(sizeof(Closure), 0);

132− SETTY(cl, CT_BITS8);

133− cl->info.bits8 = A / B;

134− return cl;

72+ uint8_t A = GETBITS8(a);

73+ uint8_t B = GETBITS8(b);

74+ return idris_b8const(vm, A / B);

13575}

13676

13777VAL idris_b8SDiv(VM *vm, VAL a, VAL b) {

138− uint8_t A = a->info.bits8;

139− uint8_t B = b->info.bits8;

140− VAL cl = allocate(sizeof(Closure), 0);

141− SETTY(cl, CT_BITS8);

142− cl->info.bits8 = (uint8_t) (((int8_t) A) / ((int8_t) B));

143− return cl;

78+ int8_t A = GETBITS8(a);

79+ int8_t B = GETBITS8(b);

80+ return idris_b8const(vm, A / B);

14481}

14582

14683VAL idris_b8URem(VM *vm, VAL a, VAL b) {

147− uint8_t A = a->info.bits8;

148− uint8_t B = b->info.bits8;

149− VAL cl = allocate(sizeof(Closure), 0);

150− SETTY(cl, CT_BITS8);

151− cl->info.bits8 = A % B;

152− return cl;

84+ uint8_t A = GETBITS8(a);

85+ uint8_t B = GETBITS8(b);

86+ return idris_b8const(vm, A % B);

15387}

15488

15589VAL idris_b8SRem(VM *vm, VAL a, VAL b) {

156− uint8_t A = a->info.bits8;

157− uint8_t B = b->info.bits8;

158− VAL cl = allocate(sizeof(Closure), 0);

159− SETTY(cl, CT_BITS8);

160− cl->info.bits8 = (uint8_t) (((int8_t) A) % ((int8_t) B));

161− return cl;

90+ int8_t A = GETBITS8(a);

91+ int8_t B = GETBITS8(b);

92+ return idris_b8const(vm, A % B);

16293}

16394

16495VAL idris_b8Lt(VM *vm, VAL a, VAL b) {

165− return MKINT((i_int) (a->info.bits8 < b->info.bits8));

96+ return MKINT((i_int) (GETBITS8(a) < GETBITS8(b)));

16697}

16798

16899VAL idris_b8Gt(VM *vm, VAL a, VAL b) {

169− return MKINT((i_int) (a->info.bits8 > b->info.bits8));

100+ return MKINT((i_int) (GETBITS8(a) > GETBITS8(b)));

170101}

171102

172103VAL idris_b8Eq(VM *vm, VAL a, VAL b) {

173− return MKINT((i_int) (a->info.bits8 == b->info.bits8));

104+ return MKINT((i_int) (GETBITS8(a) == GETBITS8(b)));

174105}

175106

176107VAL idris_b8Lte(VM *vm, VAL a, VAL b) {

177− return MKINT((i_int) (a->info.bits8 <= b->info.bits8));

108+ return MKINT((i_int) (GETBITS8(a) <= GETBITS8(b)));

178109}

179110

180111VAL idris_b8Gte(VM *vm, VAL a, VAL b) {

181− return MKINT((i_int) (a->info.bits8 >= b->info.bits8));

112+ return MKINT((i_int) (GETBITS8(a) >= GETBITS8(b)));

182113}

183114

184115VAL idris_b8Compl(VM *vm, VAL a) {

185− uint8_t A = a->info.bits8;

186− VAL cl = allocate(sizeof(Closure), 0);

187− SETTY(cl, CT_BITS8);

188− cl->info.bits8 = ~ A;

189− return cl;

116+ uint8_t A = GETBITS8(a);

117+ return idris_b8const(vm, ~ A);

190118}

191119

192120VAL idris_b8And(VM *vm, VAL a, VAL b) {

193− uint8_t A = a->info.bits8;

194− uint8_t B = b->info.bits8;

195− VAL cl = allocate(sizeof(Closure), 0);

196− SETTY(cl, CT_BITS8);

197− cl->info.bits8 = A & B;

198− return cl;

121+ uint8_t A = GETBITS8(a);

122+ uint8_t B = GETBITS8(b);

123+ return idris_b8const(vm, A & B);

199124}

200125

201126VAL idris_b8Or(VM *vm, VAL a, VAL b) {

202− uint8_t A = a->info.bits8;

203− uint8_t B = b->info.bits8;

204− VAL cl = allocate(sizeof(Closure), 0);

205− SETTY(cl, CT_BITS8);

206− cl->info.bits8 = A | B;

207− return cl;

127+ uint8_t A = GETBITS8(a);

128+ uint8_t B = GETBITS8(b);

129+ return idris_b8const(vm, A | B);

208130}

209131

210132VAL idris_b8Xor(VM *vm, VAL a, VAL b) {

211− uint8_t A = a->info.bits8;

212− uint8_t B = b->info.bits8;

213− VAL cl = allocate(sizeof(Closure), 0);

214− SETTY(cl, CT_BITS8);

215− cl->info.bits8 = A ^ B;

216− return cl;

133+ uint8_t A = GETBITS8(a);

134+ uint8_t B = GETBITS8(b);

135+ return idris_b8const(vm, A ^ B);

217136}

218137

219138VAL idris_b8Shl(VM *vm, VAL a, VAL b) {

220− uint8_t A = a->info.bits8;

221− uint8_t B = b->info.bits8;

222− VAL cl = allocate(sizeof(Closure), 0);

223− SETTY(cl, CT_BITS8);

224− cl->info.bits8 = A << B;

225− return cl;

139+ uint8_t A = GETBITS8(a);

140+ uint8_t B = GETBITS8(b);

141+ return idris_b8const(vm, A << B);

226142}

227143

228144VAL idris_b8LShr(VM *vm, VAL a, VAL b) {

229− uint8_t A = a->info.bits8;

230− uint8_t B = b->info.bits8;

231− VAL cl = allocate(sizeof(Closure), 0);

232− SETTY(cl, CT_BITS8);

233− cl->info.bits8 = A >> B;

234− return cl;

145+ uint8_t A = GETBITS8(a);

146+ uint8_t B = GETBITS8(b);

147+ return idris_b8const(vm, A >> B);

235148}

236149

237150VAL idris_b8AShr(VM *vm, VAL a, VAL b) {

238− uint8_t A = a->info.bits8;

239− uint8_t B = b->info.bits8;

240− VAL cl = allocate(sizeof(Closure), 0);

241− SETTY(cl, CT_BITS8);

242− cl->info.bits8 = (uint8_t) (((int8_t) A) >> ((int8_t) B));

243− return cl;

151+ int8_t A = GETBITS8(a);

152+ int8_t B = GETBITS8(b);

153+ return idris_b8const(vm, A >> B);

244154}

245155

246156VAL idris_b16Plus(VM *vm, VAL a, VAL b) {

247− uint16_t A = a->info.bits16;

248− uint16_t B = b->info.bits16;

249− VAL cl = allocate(sizeof(Closure), 0);

250− SETTY(cl, CT_BITS16);

251− cl->info.bits16 = A + B;

252− return cl;

157+ uint16_t A = GETBITS16(a);

158+ uint16_t B = GETBITS16(b);

159+ return idris_b16const(vm, A + B);

253160}

254161

255162VAL idris_b16Minus(VM *vm, VAL a, VAL b) {

256− uint16_t A = a->info.bits16;

257− uint16_t B = b->info.bits16;

258− VAL cl = allocate(sizeof(Closure), 0);

259− SETTY(cl, CT_BITS16);

260− cl->info.bits16 = A - B;

261− return cl;

163+ uint16_t A = GETBITS16(a);

164+ uint16_t B = GETBITS16(b);

165+ return idris_b16const(vm, A - B);

262166}

263167

264168VAL idris_b16Times(VM *vm, VAL a, VAL b) {

265− uint16_t A = a->info.bits16;

266− uint16_t B = b->info.bits16;

267− VAL cl = allocate(sizeof(Closure), 0);

268− SETTY(cl, CT_BITS16);

269− cl->info.bits16 = A * B;

270− return cl;

169+ uint16_t A = GETBITS16(a);

170+ uint16_t B = GETBITS16(b);

171+ return idris_b16const(vm, A * B);

271172}

272173

273174VAL idris_b16UDiv(VM *vm, VAL a, VAL b) {

274− uint16_t A = a->info.bits16;

275− uint16_t B = b->info.bits16;

276− VAL cl = allocate(sizeof(Closure), 0);

277− SETTY(cl, CT_BITS16);

278− cl->info.bits16 = A / B;

279− return cl;

175+ uint16_t A = GETBITS16(a);

176+ uint16_t B = GETBITS16(b);

177+ return idris_b16const(vm, A / B);

280178}

281179

282180VAL idris_b16SDiv(VM *vm, VAL a, VAL b) {

283− uint16_t A = a->info.bits16;

284− uint16_t B = b->info.bits16;

285− VAL cl = allocate(sizeof(Closure), 0);

286− SETTY(cl, CT_BITS16);

287− cl->info.bits16 = (uint16_t) (((int16_t) A) / ((int16_t) B));

288− return cl;

181+ int16_t A = GETBITS16(a);

182+ int16_t B = GETBITS16(b);

183+ return idris_b16const(vm, A / B);

289184}

290185

291186VAL idris_b16URem(VM *vm, VAL a, VAL b) {

292− uint16_t A = a->info.bits16;

293− uint16_t B = b->info.bits16;

294− VAL cl = allocate(sizeof(Closure), 0);

295− SETTY(cl, CT_BITS16);

296− cl->info.bits16 = A % B;

297− return cl;

187+ uint16_t A = GETBITS16(a);

188+ uint16_t B = GETBITS16(b);

189+ return idris_b16const(vm, A % B);

298190}

299191

300192VAL idris_b16SRem(VM *vm, VAL a, VAL b) {

301− uint16_t A = a->info.bits16;

302− uint16_t B = b->info.bits16;

303− VAL cl = allocate(sizeof(Closure), 0);

304− SETTY(cl, CT_BITS16);

305− cl->info.bits16 = (uint16_t) (((int16_t) A) % ((int16_t) B));

306− return cl;

193+ int16_t A = GETBITS16(a);

194+ int16_t B = GETBITS16(b);

195+ return idris_b16const(vm, A % B);

307196}

308197

309198VAL idris_b16Lt(VM *vm, VAL a, VAL b) {

310− return MKINT((i_int) (a->info.bits16 < b->info.bits16));

199+ return MKINT((i_int) (GETBITS16(a) < GETBITS16(b)));

311200}

312201

313202VAL idris_b16Gt(VM *vm, VAL a, VAL b) {

314− return MKINT((i_int) (a->info.bits16 > b->info.bits16));

203+ return MKINT((i_int) (GETBITS16(a) > GETBITS16(b)));

315204}

316205

317206VAL idris_b16Eq(VM *vm, VAL a, VAL b) {

318− return MKINT((i_int) (a->info.bits16 == b->info.bits16));

207+ return MKINT((i_int) (GETBITS16(a) == GETBITS16(b)));

319208}

320209

321210VAL idris_b16Lte(VM *vm, VAL a, VAL b) {

322− return MKINT((i_int) (a->info.bits16 <= b->info.bits16));

211+ return MKINT((i_int) (GETBITS16(a) <= GETBITS16(b)));

323212}

324213

325214VAL idris_b16Gte(VM *vm, VAL a, VAL b) {

326− return MKINT((i_int) (a->info.bits16 >= b->info.bits16));

215+ return MKINT((i_int) (GETBITS16(a) >= GETBITS16(b)));

327216}

328217

329218VAL idris_b16Compl(VM *vm, VAL a) {

330− uint16_t A = a->info.bits16;

331− VAL cl = allocate(sizeof(Closure), 0);

332− SETTY(cl, CT_BITS16);

333− cl->info.bits16 = ~ A;

334− return cl;

219+ uint16_t A = GETBITS16(a);

220+ return idris_b16const(vm, ~ A);

335221}

336222

337223VAL idris_b16And(VM *vm, VAL a, VAL b) {

338− uint16_t A = a->info.bits16;

339− uint16_t B = b->info.bits16;

340− VAL cl = allocate(sizeof(Closure), 0);

341− SETTY(cl, CT_BITS16);

342− cl->info.bits16 = A & B;

343− return cl;

224+ uint16_t A = GETBITS16(a);

225+ uint16_t B = GETBITS16(b);

226+ return idris_b16const(vm, A & B);

344227}

345228

346229VAL idris_b16Or(VM *vm, VAL a, VAL b) {

347− uint16_t A = a->info.bits16;

348− uint16_t B = b->info.bits16;

349− VAL cl = allocate(sizeof(Closure), 0);

350− SETTY(cl, CT_BITS16);

351− cl->info.bits16 = A | B;

352− return cl;

230+ uint16_t A = GETBITS16(a);

231+ uint16_t B = GETBITS16(b);

232+ return idris_b16const(vm, A | B);

353233}

354234

355235VAL idris_b16Xor(VM *vm, VAL a, VAL b) {

356− uint16_t A = a->info.bits16;

357− uint16_t B = b->info.bits16;

358− VAL cl = allocate(sizeof(Closure), 0);

359− SETTY(cl, CT_BITS16);

360− cl->info.bits16 = A ^ B;

361− return cl;

236+ uint16_t A = GETBITS16(a);

237+ uint16_t B = GETBITS16(b);

238+ return idris_b16const(vm, A ^ B);

362239}

363240

364241VAL idris_b16Shl(VM *vm, VAL a, VAL b) {

365− uint16_t A = a->info.bits16;

366− uint16_t B = b->info.bits16;

367− VAL cl = allocate(sizeof(Closure), 0);

368− SETTY(cl, CT_BITS16);

369− cl->info.bits16 = A << B;

370− return cl;

242+ uint16_t A = GETBITS16(a);

243+ uint16_t B = GETBITS16(b);

244+ return idris_b16const(vm, A << B);

371245}

372246

373247VAL idris_b16LShr(VM *vm, VAL a, VAL b) {

374− uint16_t A = a->info.bits16;

375− uint16_t B = b->info.bits16;

376− VAL cl = allocate(sizeof(Closure), 0);

377− SETTY(cl, CT_BITS16);

378− cl->info.bits16 = A >> B;

379− return cl;

248+ uint16_t A = GETBITS16(a);

249+ uint16_t B = GETBITS16(b);

250+ return idris_b16const(vm, A >> B);

380251}

381252

382253VAL idris_b16AShr(VM *vm, VAL a, VAL b) {

383− uint16_t A = a->info.bits16;

384− uint16_t B = b->info.bits16;

385− VAL cl = allocate(sizeof(Closure), 0);

386− SETTY(cl, CT_BITS16);

387− cl->info.bits16 = (uint16_t) (((int16_t) A) >> ((int16_t) B));

388− return cl;

254+ int16_t A = GETBITS16(a);

255+ int16_t B = GETBITS16(b);

256+ return idris_b16const(vm, A >> B);

389257}

390258

391259VAL idris_b32Plus(VM *vm, VAL a, VAL b) {

392− uint32_t A = a->info.bits32;

393− uint32_t B = b->info.bits32;

394− VAL cl = allocate(sizeof(Closure), 0);

395− SETTY(cl, CT_BITS32);

396− cl->info.bits32 = A + B;

397− return cl;

260+ uint32_t A = GETBITS32(a);

261+ uint32_t B = GETBITS32(b);

262+ return idris_b32const(vm, A + B);

398263}

399264

400265VAL idris_b32Minus(VM *vm, VAL a, VAL b) {

401− uint32_t A = a->info.bits32;

402− uint32_t B = b->info.bits32;

403− VAL cl = allocate(sizeof(Closure), 0);

404− SETTY(cl, CT_BITS32);

405− cl->info.bits32 = A - B;

406− return cl;

266+ uint32_t A = GETBITS32(a);

267+ uint32_t B = GETBITS32(b);

268+ return idris_b32const(vm, A - B);

407269}

408270

409271VAL idris_b32Times(VM *vm, VAL a, VAL b) {

410− uint32_t A = a->info.bits32;

411− uint32_t B = b->info.bits32;

412− VAL cl = allocate(sizeof(Closure), 0);

413− SETTY(cl, CT_BITS32);

414− cl->info.bits32 = A * B;

415− return cl;

272+ uint32_t A = GETBITS32(a);

273+ uint32_t B = GETBITS32(b);

274+ return idris_b32const(vm, A * B);

416275}

417276

418277VAL idris_b32UDiv(VM *vm, VAL a, VAL b) {

419− uint32_t A = a->info.bits32;

420− uint32_t B = b->info.bits32;

421− VAL cl = allocate(sizeof(Closure), 0);

422− SETTY(cl, CT_BITS32);

423− cl->info.bits32 = A / B;

424− return cl;

278+ uint32_t A = GETBITS32(a);

279+ uint32_t B = GETBITS32(b);

280+ return idris_b32const(vm, A / B);

425281}

426282

427283VAL idris_b32SDiv(VM *vm, VAL a, VAL b) {

428− uint32_t A = a->info.bits32;

429− uint32_t B = b->info.bits32;

430− VAL cl = allocate(sizeof(Closure), 0);

431− SETTY(cl, CT_BITS32);

432− cl->info.bits32 = (uint32_t) (((int32_t) A) / ((int32_t) B));

433− return cl;

284+ int32_t A = GETBITS32(a);

285+ int32_t B = GETBITS32(b);

286+ return idris_b32const(vm, A / B);

434287}

435288

436289VAL idris_b32URem(VM *vm, VAL a, VAL b) {

437− uint32_t A = a->info.bits32;

438− uint32_t B = b->info.bits32;

439− VAL cl = allocate(sizeof(Closure), 0);

440− SETTY(cl, CT_BITS32);

441− cl->info.bits32 = A % B;

442− return cl;

290+ uint32_t A = GETBITS32(a);

291+ uint32_t B = GETBITS32(b);

292+ return idris_b32const(vm, A % B);

443293}

444294

445295VAL idris_b32SRem(VM *vm, VAL a, VAL b) {

446− uint32_t A = a->info.bits32;

447− uint32_t B = b->info.bits32;

448− VAL cl = allocate(sizeof(Closure), 0);

449− SETTY(cl, CT_BITS32);

450− cl->info.bits32 = (uint32_t) (((int32_t) A) % ((int32_t) B));

451− return cl;

296+ int32_t A = GETBITS32(a);

297+ int32_t B = GETBITS32(b);

298+ return idris_b32const(vm, A % B);

452299}

453300

454301VAL idris_b32Lt(VM *vm, VAL a, VAL b) {

455− return MKINT((i_int) (a->info.bits32 < b->info.bits32));

302+ return MKINT((i_int) (GETBITS32(a) < GETBITS32(b)));

456303}

457304

458305VAL idris_b32Gt(VM *vm, VAL a, VAL b) {

459− return MKINT((i_int) (a->info.bits32 > b->info.bits32));

306+ return MKINT((i_int) (GETBITS32(a) > GETBITS32(b)));

460307}

461308

462309VAL idris_b32Eq(VM *vm, VAL a, VAL b) {

463− return MKINT((i_int) (a->info.bits32 == b->info.bits32));

310+ return MKINT((i_int) (GETBITS32(a) == GETBITS32(b)));

464311}

465312

466313VAL idris_b32Lte(VM *vm, VAL a, VAL b) {

467− return MKINT((i_int) (a->info.bits32 <= b->info.bits32));

314+ return MKINT((i_int) (GETBITS32(a) <= GETBITS32(b)));

468315}

469316

470317VAL idris_b32Gte(VM *vm, VAL a, VAL b) {

471− return MKINT((i_int) (a->info.bits32 >= b->info.bits32));

318+ return MKINT((i_int) (GETBITS32(a) >= GETBITS32(b)));

472319}

473320

474321VAL idris_b32Compl(VM *vm, VAL a) {

475− uint32_t A = a->info.bits32;

476− VAL cl = allocate(sizeof(Closure), 0);

477− SETTY(cl, CT_BITS32);

478− cl->info.bits32 = ~ A;

479− return cl;

322+ uint32_t A = GETBITS32(a);

323+ return idris_b32const(vm, ~ A);

480324}

481325

482326VAL idris_b32And(VM *vm, VAL a, VAL b) {

483− uint32_t A = a->info.bits32;

484− uint32_t B = b->info.bits32;

485− VAL cl = allocate(sizeof(Closure), 0);

486− SETTY(cl, CT_BITS32);

487− cl->info.bits32 = A & B;

488− return cl;

327+ uint32_t A = GETBITS32(a);

328+ uint32_t B = GETBITS32(b);

329+ return idris_b32const(vm, A & B);

489330}

490331

491332VAL idris_b32Or(VM *vm, VAL a, VAL b) {

492− uint32_t A = a->info.bits32;

493− uint32_t B = b->info.bits32;

494− VAL cl = allocate(sizeof(Closure), 0);

495− SETTY(cl, CT_BITS32);

496− cl->info.bits32 = A | B;

497− return cl;

333+ uint32_t A = GETBITS32(a);

334+ uint32_t B = GETBITS32(b);

335+ return idris_b32const(vm, A | B);

498336}

499337

500338VAL idris_b32Xor(VM *vm, VAL a, VAL b) {

501− uint32_t A = a->info.bits32;

502− uint32_t B = b->info.bits32;

503− VAL cl = allocate(sizeof(Closure), 0);

504− SETTY(cl, CT_BITS32);

505− cl->info.bits32 = A ^ B;

506− return cl;

339+ uint32_t A = GETBITS32(a);

340+ uint32_t B = GETBITS32(b);

341+ return idris_b32const(vm, A ^ B);

507342}

508343

509344VAL idris_b32Shl(VM *vm, VAL a, VAL b) {

510− uint32_t A = a->info.bits32;

511− uint32_t B = b->info.bits32;

512− VAL cl = allocate(sizeof(Closure), 0);

513− SETTY(cl, CT_BITS32);

514− cl->info.bits32 = A << B;

515− return cl;

345+ uint32_t A = GETBITS32(a);

346+ uint32_t B = GETBITS32(b);

347+ return idris_b32const(vm, A << B);

516348}

517349

518350VAL idris_b32LShr(VM *vm, VAL a, VAL b) {

519− uint32_t A = a->info.bits32;

520− uint32_t B = b->info.bits32;

521− VAL cl = allocate(sizeof(Closure), 0);

522− SETTY(cl, CT_BITS32);

523− cl->info.bits32 = A >> B;

524− return cl;

351+ uint32_t A = GETBITS32(a);

352+ uint32_t B = GETBITS32(b);

353+ return idris_b32const(vm, A >> B);

525354}

526355

527356VAL idris_b32AShr(VM *vm, VAL a, VAL b) {

528− uint32_t A = a->info.bits32;

529− uint32_t B = b->info.bits32;

530− VAL cl = allocate(sizeof(Closure), 0);

531− SETTY(cl, CT_BITS32);

532− cl->info.bits32 = (uint32_t) (((int32_t)A) >> ((int32_t)B));

533− return cl;

357+ int32_t A = GETBITS32(a);

358+ int32_t B = GETBITS32(b);

359+ return idris_b32const(vm, A >> B);

534360}

535361

536362VAL idris_b64Plus(VM *vm, VAL a, VAL b) {

537− uint64_t A = a->info.bits64;

538− uint64_t B = b->info.bits64;

539− VAL cl = allocate(sizeof(Closure), 0);

540− SETTY(cl, CT_BITS64);

541− cl->info.bits64 = A + B;

542− return cl;

363+ uint64_t A = GETBITS64(a);

364+ uint64_t B = GETBITS64(b);

365+ return idris_b64const(vm, A + B);

543366}

544367

545368VAL idris_b64Minus(VM *vm, VAL a, VAL b) {

546− uint64_t A = a->info.bits64;

547− uint64_t B = b->info.bits64;

548− VAL cl = allocate(sizeof(Closure), 0);

549− SETTY(cl, CT_BITS64);

550− cl->info.bits64 = A - B;

551− return cl;

369+ uint64_t A = GETBITS64(a);

370+ uint64_t B = GETBITS64(b);

371+ return idris_b64const(vm, A - B);

552372}

553373

554374VAL idris_b64Times(VM *vm, VAL a, VAL b) {

555− uint64_t A = a->info.bits64;

556− uint64_t B = b->info.bits64;

557− VAL cl = allocate(sizeof(Closure), 0);

558− SETTY(cl, CT_BITS64);

559− cl->info.bits64 = A * B;

560− return cl;

375+ uint64_t A = GETBITS64(a);

376+ uint64_t B = GETBITS64(b);

377+ return idris_b64const(vm, A * B);

561378}

562379

563380VAL idris_b64UDiv(VM *vm, VAL a, VAL b) {

564− uint64_t A = a->info.bits64;

565− uint64_t B = b->info.bits64;

566− VAL cl = allocate(sizeof(Closure), 0);

567− SETTY(cl, CT_BITS64);

568− cl->info.bits64 = A / B;

569− return cl;

381+ uint64_t A = GETBITS64(a);

382+ uint64_t B = GETBITS64(b);

383+ return idris_b64const(vm, A / B);

570384}

571385

572386VAL idris_b64SDiv(VM *vm, VAL a, VAL b) {

573− uint64_t A = a->info.bits64;

574− uint64_t B = b->info.bits64;

575− VAL cl = allocate(sizeof(Closure), 0);

576− SETTY(cl, CT_BITS64);

577− cl->info.bits64 = (uint64_t) (((int64_t) A) / ((int64_t) B));

578− return cl;

387+ int64_t A = GETBITS64(a);

388+ int64_t B = GETBITS64(b);

389+ return idris_b64const(vm, A / B);

579390}

580391

581392VAL idris_b64URem(VM *vm, VAL a, VAL b) {

582− uint64_t A = a->info.bits64;

583− uint64_t B = b->info.bits64;

584− VAL cl = allocate(sizeof(Closure), 0);

585− SETTY(cl, CT_BITS64);

586− cl->info.bits64 = A % B;

587− return cl;

393+ uint64_t A = GETBITS64(a);

394+ uint64_t B = GETBITS64(b);

395+ return idris_b64const(vm, A % B);

588396}

589397

590398VAL idris_b64SRem(VM *vm, VAL a, VAL b) {

591− uint64_t A = a->info.bits64;

592− uint64_t B = b->info.bits64;

593− VAL cl = allocate(sizeof(Closure), 0);

594− SETTY(cl, CT_BITS64);

595− cl->info.bits64 = (uint64_t) (((int64_t) A) % ((int64_t) B));

596− return cl;

399+ int64_t A = GETBITS64(a);

400+ int64_t B = GETBITS64(b);

401+ return idris_b64const(vm, A % B);

597402}

598403

599404VAL idris_b64Lt(VM *vm, VAL a, VAL b) {

600− return MKINT((i_int) (a->info.bits64 < b->info.bits64));

405+ uint64_t A = GETBITS64(a);

406+ uint64_t B = GETBITS64(b);

407+ return MKINT((i_int) (A < B));

601408}

602409

603410VAL idris_b64Gt(VM *vm, VAL a, VAL b) {

604− return MKINT((i_int) (a->info.bits64 > b->info.bits64));

411+ uint64_t A = GETBITS64(a);

412+ uint64_t B = GETBITS64(b);

413+ return MKINT((i_int) (A > B));

605414}

606415

607416VAL idris_b64Eq(VM *vm, VAL a, VAL b) {

608− return MKINT((i_int) (a->info.bits64 == b->info.bits64));

417+ uint64_t A = GETBITS64(a);

418+ uint64_t B = GETBITS64(b);

419+ return MKINT((i_int) (A == B));

609420}

610421

611422VAL idris_b64Lte(VM *vm, VAL a, VAL b) {

612− return MKINT((i_int) (a->info.bits64 <= b->info.bits64));

423+ uint64_t A = GETBITS64(a);

424+ uint64_t B = GETBITS64(b);

425+ return MKINT((i_int) (A <= B));

613426}

614427

615428VAL idris_b64Gte(VM *vm, VAL a, VAL b) {

616− return MKINT((i_int) (a->info.bits64 >= b->info.bits64));

429+ uint64_t A = GETBITS64(a);

430+ uint64_t B = GETBITS64(b);

431+ return MKINT((i_int) (A >= B));

617432}

618433

619434VAL idris_b64Compl(VM *vm, VAL a) {

620− uint64_t A = a->info.bits64;

621− VAL cl = allocate(sizeof(Closure), 0);

622− SETTY(cl, CT_BITS64);

623− cl->info.bits64 = ~ A;

624− return cl;

435+ uint64_t A = GETBITS64(a);

436+ return idris_b64const(vm, ~ A);

625437}

626438

627439VAL idris_b64And(VM *vm, VAL a, VAL b) {

628− uint64_t A = a->info.bits64;

629− uint64_t B = b->info.bits64;

630− VAL cl = allocate(sizeof(Closure), 0);

631− SETTY(cl, CT_BITS64);

632− cl->info.bits64 = A & B;

633− return cl;

440+ uint64_t A = GETBITS64(a);

441+ uint64_t B = GETBITS64(b);

442+ return idris_b64const(vm, A & B);

634443}

635444

636445VAL idris_b64Or(VM *vm, VAL a, VAL b) {

637− uint64_t A = a->info.bits64;

638− uint64_t B = b->info.bits64;

639− VAL cl = allocate(sizeof(Closure), 0);

640− SETTY(cl, CT_BITS64);

641− cl->info.bits64 = A | B;

642− return cl;

446+ uint64_t A = GETBITS64(a);

447+ uint64_t B = GETBITS64(b);

448+ return idris_b64const(vm, A | B);

643449}

644450

645451VAL idris_b64Xor(VM *vm, VAL a, VAL b) {

646− uint64_t A = a->info.bits64;

647− uint64_t B = b->info.bits64;

648− VAL cl = allocate(sizeof(Closure), 0);

649− SETTY(cl, CT_BITS64);

650− cl->info.bits64 = A ^ B;

651− return cl;

452+ uint64_t A = GETBITS64(a);

453+ uint64_t B = GETBITS64(b);

454+ return idris_b64const(vm, A ^ B);

652455}

653456

654457VAL idris_b64Shl(VM *vm, VAL a, VAL b) {

655− uint64_t A = a->info.bits64;

656− uint64_t B = b->info.bits64;

657− VAL cl = allocate(sizeof(Closure), 0);

658− SETTY(cl, CT_BITS64);

659− cl->info.bits64 = A << B;

660− return cl;

458+ uint64_t A = GETBITS64(a);

459+ uint64_t B = GETBITS64(b);

460+ return idris_b64const(vm, A << B);

661461}

662462

663463VAL idris_b64LShr(VM *vm, VAL a, VAL b) {

664− uint64_t A = a->info.bits64;

665− uint64_t B = b->info.bits64;

666− VAL cl = allocate(sizeof(Closure), 0);

667− SETTY(cl, CT_BITS64);

668− cl->info.bits64 = A >> B;

669− return cl;

464+ uint64_t A = GETBITS64(a);

465+ uint64_t B = GETBITS64(b);

466+ return idris_b64const(vm, A >> B);

670467}

671468

672469VAL idris_b64AShr(VM *vm, VAL a, VAL b) {

673− uint64_t A = a->info.bits64;

674− uint64_t B = b->info.bits64;

675− VAL cl = allocate(sizeof(Closure), 0);

676− SETTY(cl, CT_BITS64);

677− cl->info.bits64 = (uint64_t) (((int64_t) A) >> ((int64_t) B));

678− return cl;

470+ int64_t A = GETBITS64(a);

471+ int64_t B = GETBITS64(b);

472+ return idris_b64const(vm, A >> B);

679473}

680474

681475VAL idris_b8Z16(VM *vm, VAL a) {

682− uint8_t A = a->info.bits8;

683− VAL cl = allocate(sizeof(Closure), 0);

684− SETTY(cl, CT_BITS16);

685− cl->info.bits16 = (uint16_t) A;

686− return cl;

476+ uint8_t A = GETBITS8(a);

477+ return idris_b16const(vm, A);

687478}

688479

689480VAL idris_b8Z32(VM *vm, VAL a) {

690− uint8_t A = a->info.bits8;

691− VAL cl = allocate(sizeof(Closure), 0);

692− SETTY(cl, CT_BITS32);

693− cl->info.bits32 = (uint32_t) A;

694− return cl;

481+ uint8_t A = GETBITS8(a);

482+ return idris_b32const(vm, A);

695483}

696484

697485VAL idris_b8Z64(VM *vm, VAL a) {

698− uint8_t A = a->info.bits8;

699− VAL cl = allocate(sizeof(Closure), 0);

700− SETTY(cl, CT_BITS64);

701− cl->info.bits64 = (uint64_t) A;

702− return cl;

486+ uint8_t A = GETBITS8(a);

487+ return idris_b64const(vm, A);

703488}

704489

705490VAL idris_b8S16(VM *vm, VAL a) {

706− uint8_t A = a->info.bits8;

707− VAL cl = allocate(sizeof(Closure), 0);

708− SETTY(cl, CT_BITS16);

709− cl->info.bits16 = (uint16_t) (int16_t) (int8_t) A;

710− return cl;

491+ int8_t A = GETBITS8(a);

492+ return idris_b16const(vm, (int16_t) A);

711493}

712494

713495VAL idris_b8S32(VM *vm, VAL a) {

714− uint8_t A = a->info.bits8;

715− VAL cl = allocate(sizeof(Closure), 0);

716− SETTY(cl, CT_BITS32);

717− cl->info.bits32 = (uint32_t) (int32_t) (int8_t) A;

718− return cl;

496+ int8_t A = GETBITS8(a);

497+ return idris_b32const(vm, (int32_t) A);

719498}

720499

721500VAL idris_b8S64(VM *vm, VAL a) {

722− uint8_t A = a->info.bits8;

723− VAL cl = allocate(sizeof(Closure), 0);

724− SETTY(cl, CT_BITS64);

725− cl->info.bits64 = (uint64_t) (int64_t) (int8_t) A;

726− return cl;

501+ int8_t A = GETBITS8(a);

502+ return idris_b64const(vm, (int64_t) A);

727503}

728504

729505VAL idris_b16Z32(VM *vm, VAL a) {

730− uint16_t A = a->info.bits16;

731− VAL cl = allocate(sizeof(Closure), 0);

732− SETTY(cl, CT_BITS32);

733− cl->info.bits32 = (uint32_t) A;

734− return cl;

506+ uint16_t A = GETBITS16(a);

507+ return idris_b32const(vm, (uint32_t) A);

735508}

736509

737510VAL idris_b16Z64(VM *vm, VAL a) {

738− uint16_t A = a->info.bits16;

739− VAL cl = allocate(sizeof(Closure), 0);

740− SETTY(cl, CT_BITS64);

741− cl->info.bits64 = (uint64_t) A;

742− return cl;

511+ uint16_t A = GETBITS16(a);

512+ return idris_b64const(vm, (uint64_t) A);

743513}

744514

745515VAL idris_b16S32(VM *vm, VAL a) {

746− uint16_t A = a->info.bits16;

747− VAL cl = allocate(sizeof(Closure), 0);

748− SETTY(cl, CT_BITS32);

749− cl->info.bits32 = (uint32_t) (int32_t) (int16_t) A;

750− return cl;

516+ int16_t A = GETBITS16(a);

517+ return idris_b32const(vm, (int32_t) A);

751518}

752519

753520VAL idris_b16S64(VM *vm, VAL a) {

754− uint16_t A = a->info.bits16;

755− VAL cl = allocate(sizeof(Closure), 0);

756− SETTY(cl, CT_BITS64);

757− cl->info.bits64 = (uint64_t) (int64_t) (int16_t) A;

758− return cl;

521+ int16_t A = GETBITS16(a);

522+ return idris_b64const(vm, (int64_t) A);

759523}

760524

761525VAL idris_b16T8(VM *vm, VAL a) {

762− uint16_t A = a->info.bits16;

763− VAL cl = allocate(sizeof(Closure), 0);

764− SETTY(cl, CT_BITS8);

765− cl->info.bits8 = (uint8_t) A;

766− return cl;

526+ uint16_t A = GETBITS16(a);

527+ return idris_b8const(vm, (uint8_t) A);

767528}

768529

769530VAL idris_b32Z64(VM *vm, VAL a) {

770− uint32_t A = a->info.bits32;

771− VAL cl = allocate(sizeof(Closure), 0);

772− SETTY(cl, CT_BITS64);

773− cl->info.bits64 = (uint64_t) A;

774− return cl;

531+ uint32_t A = GETBITS32(a);

532+ return idris_b64const(vm, (uint64_t) A);

775533}

776534

777535VAL idris_b32S64(VM *vm, VAL a) {

778− uint32_t A = a->info.bits32;

779− VAL cl = allocate(sizeof(Closure), 0);

780− SETTY(cl, CT_BITS64);

781− cl->info.bits64 = (uint64_t) (int64_t) (int32_t) A;

782− return cl;

536+ int32_t A = GETBITS32(a);

537+ return idris_b64const(vm, (int64_t) A);

783538}

784539

785540VAL idris_b32T8(VM *vm, VAL a) {

786− uint32_t A = a->info.bits32;

787− VAL cl = allocate(sizeof(Closure), 0);

788− SETTY(cl, CT_BITS8);

789− cl->info.bits8 = (uint8_t) A;

790− return cl;

541+ uint32_t A = GETBITS32(a);

542+ return idris_b8const(vm, (uint8_t) A);

791543}

792544

793545VAL idris_b32T16(VM *vm, VAL a) {

794− uint32_t A = a->info.bits32;

795− VAL cl = allocate(sizeof(Closure), 0);

796− SETTY(cl, CT_BITS16);

797− cl->info.bits16 = (uint16_t) A;

798− return cl;

546+ uint32_t A = GETBITS32(a);

547+ return idris_b16const(vm, (uint16_t) A);

799548}

800549

801550VAL idris_b64T8(VM *vm, VAL a) {

802− uint64_t A = a->info.bits64;

803− VAL cl = allocate(sizeof(Closure), 0);

804− SETTY(cl, CT_BITS8);

805− cl->info.bits8 = (uint8_t) A;

806− return cl;

551+ uint64_t A = GETBITS64(a);

552+ return idris_b8const(vm, (uint8_t) A);

807553}

808554

809555VAL idris_b64T16(VM *vm, VAL a) {

810− uint64_t A = a->info.bits64;

811− VAL cl = allocate(sizeof(Closure), 0);

812− SETTY(cl, CT_BITS16);

813− cl->info.bits16 = (uint16_t) A;

814− return cl;

556+ uint64_t A = GETBITS64(a);

557+ return idris_b16const(vm, (uint16_t) A);

815558}

816559

817560VAL idris_b64T32(VM *vm, VAL a) {

818− uint64_t A = a->info.bits64;

819− VAL cl = allocate(sizeof(Closure), 0);

820− SETTY(cl, CT_BITS32);

821− cl->info.bits32 = (uint32_t) A;

822− return cl;

561+ uint64_t A = GETBITS64(a);

562+ return idris_b32const(vm, (uint32_t) A);

823563}

824564

825565VAL idris_peekB8(VM* vm, VAL ptr, VAL offset) {

rts/idris_bitstring.h−5

@@ -1,11 +1,6 @@

11#ifndef _IDRISBITSTRING_H

22#define _IDRISBITSTRING_H

4−VAL idris_b8CopyForGC(VM *vm, VAL a);

5−VAL idris_b16CopyForGC(VM *vm, VAL a);

6−VAL idris_b32CopyForGC(VM *vm, VAL a);

7−VAL idris_b64CopyForGC(VM *vm, VAL a);

8−

94VAL idris_b8(VM *vm, VAL a);

105VAL idris_b16(VM *vm, VAL a);

116VAL idris_b32(VM *vm, VAL a);

rts/idris_buffer.c+5−19

@@ -82,9 +82,9 @@ uint8_t idris_getBufferByte(void* buffer, int loc) {

8282int idris_getBufferInt(void* buffer, int loc) {

8383 Buffer* b = buffer;

8484 if (loc >= 0 && loc+3 < b->size) {

85− return b->data[loc] +

85+ return b->data[loc] +

8686 (b->data[loc+1] << 8) +

87− (b->data[loc+2] << 16) +

87+ (b->data[loc+2] << 16) +

8888 (b->data[loc+3] << 24);

8989 } else {

9090 return 0;

@@ -110,22 +110,9 @@ double idris_getBufferDouble(void* buffer, int loc) {

110110

111111VAL idris_getBufferString(void* buffer, int loc, int len) {

112112 Buffer* b = buffer;

113−

114− Closure* cl = allocate(sizeof(Closure) + // Type) + sizeof(char*) +

115− sizeof(char)*(len+1), 0);

116− SETTY(cl, CT_STRING);

117− cl->info.str.str = (char*)cl + sizeof(Closure);

118−

119− if (loc >= 0 && loc+len <= b->size) {

120− memcpy(cl->info.str.str, (b->data)+loc, len);

121− cl->info.str.str[len]='\0';

122− cl->info.str.len = len;

123− } else {

124− cl->info.str.str[0] = '\0';

125− cl->info.str.len = 0;

126− }

127−

128− return cl;

113+ char * s = (char*)(b->data + loc);

114+ size_t sz = loc >= 0 && loc+len <= b->size? len : 0;

115+ return MKSTRlen(get_vm(), s, sz);

129116}

130117

131118int idris_readBuffer(FILE* h, void* buffer, int loc, int max) {

@@ -153,4 +140,3 @@ void idris_writeBuffer(FILE* h, void* buffer, int loc, int len) {

153140 fwrite((b->data)+loc, sizeof(uint8_t), len, h);

154141 }

155142}

156−

rts/idris_gc.c+38−63

@@ -5,115 +5,90 @@

55#include <assert.h>

77VAL copy(VM* vm, VAL x) {

8− int ar, len;

9− Closure* cl = NULL;

8+ int ar;

9+ VAL cl;

1010 if (x==NULL || ISINT(x)) {

1111 return x;

1212 }

1313 switch(GETTY(x)) {

14+ case CT_FWD:

15+ return GETPTR(x);

16+ case CT_CDATA:

17+ cl = MKCDATAc(vm, GETCDATA(x));

18+ c_heap_mark_item(GETCDATA(x));

19+ break;

20+ case CT_BIGINT:

21+ cl = MKBIGMc(vm, GETMPZ(x));

22+ break;

1423 case CT_CON:

1524 ar = CARITY(x);

1625 if (ar == 0 && CTAG(x) < 256) {

1726 return x;

18− } else {

19− allocCon(cl, vm, CTAG(x), ar, 1);

20− memcpy(&(cl->info.c.args), &(x->info.c.args), sizeof(VAL)*ar);

2127 }

22− break;

28+ // FALLTHROUGH

2329 case CT_ARRAY:

24− len = x->info.arr.length;

25− allocArray(cl, vm, len, 1);

26− memcpy(&(cl->info.arr.content), &(x->info.arr.content), sizeof(VAL)*len);

27− break;

28− case CT_FLOAT:

29− cl = MKFLOATc(vm, x->info.f);

30− break;

3130 case CT_STRING:

32− cl = MKSTRclen(vm, x->info.str.str, x->info.str.len);

33− break;

31+ case CT_REF:

32+ case CT_FLOAT:

3433 case CT_STROFFSET:

35− cl = MKSTROFFc(vm, x->info.str_offset);

36− break;

37− case CT_BIGINT:

38− cl = MKBIGMc(vm, x->info.ptr);

39− break;

4034 case CT_PTR:

41− cl = MKPTRc(vm, x->info.ptr);

42− break;

4335 case CT_MANAGEDPTR:

44− cl = MKMPTRc(vm, x->info.mptr->data, x->info.mptr->size);

45− break;

4636 case CT_BITS8:

47− cl = idris_b8CopyForGC(vm, x);

48− break;

4937 case CT_BITS16:

50− cl = idris_b16CopyForGC(vm, x);

51− break;

5238 case CT_BITS32:

53− cl = idris_b32CopyForGC(vm, x);

54− break;

5539 case CT_BITS64:

56− cl = idris_b64CopyForGC(vm, x);

57− break;

58− case CT_REF:

59− cl = idris_newRefLock((VAL)(x->info.ptr), 1);

60− break;

61− case CT_FWD:

62− return x->info.ptr;

6340 case CT_RAWDATA:

64− {

65− size_t size = x->info.size + sizeof(Closure);

66− cl = allocate(size, 1);

67− memcpy(cl, x, size);

68− }

69− break;

70− case CT_CDATA:

71− cl = MKCDATAc(vm, x->info.c_heap_item);

72− c_heap_mark_item(x->info.c_heap_item);

41+ cl = iallocate(vm, x->hdr.sz, 1);

42+ memcpy(cl, x, x->hdr.sz);

7343 break;

7444 default:

45+ cl = NULL;

7546 break;

7647 }

7748 SETTY(x, CT_FWD);

78− x->info.ptr = cl;

49+ ((Fwd*)x)->fwd = cl;

7950 return cl;

8051}

8152

8253void cheney(VM *vm) {

83− int i;

84− int ar, len;

8554 char* scan = aligned_heap_pointer(vm->heap.heap);

8655

8756 while(scan < vm->heap.next) {

88− size_t inc = *((size_t*)scan);

89− VAL heap_item = (VAL)(scan+sizeof(size_t));

57+ VAL heap_item = (VAL)scan;

9058 // If it's a CT_CON, CT_REF or CT_STROFFSET, copy its arguments

9159 switch(GETTY(heap_item)) {

9260 case CT_CON:

93− ar = ARITY(heap_item);

94− for(i = 0; i < ar; ++i) {

95− VAL newptr = copy(vm, heap_item->info.c.args[i]);

96− heap_item->info.c.args[i] = newptr;

61+ {

62+ Con * c = (Con*)heap_item;

63+ size_t len = CARITY(c);

64+ for(size_t i = 0; i < len; ++i)

65+ c->args[i] = copy(vm, c->args[i]);

9766 }

9867 break;

9968 case CT_ARRAY:

100− len = heap_item->info.arr.length;

101− for(i = 0; i < len; ++i) {

102− VAL newptr = copy(vm, heap_item->info.arr.content[i]);

103− heap_item->info.arr.content[i] = newptr;

69+ {

70+ Array * a = (Array*)heap_item;

71+ size_t len = CELEM(a);

72+ for(size_t i = 0; i < len; ++i)

73+ a->array[i] = copy(vm, a->array[i]);

10474 }

10575 break;

10676 case CT_REF:

107− heap_item->info.ptr = copy(vm, (VAL)(heap_item->info.ptr));

77+ {

78+ Ref * r = (Ref*)heap_item;

79+ r->ref = copy(vm, r->ref);

80+ }

10881 break;

10982 case CT_STROFFSET:

110− heap_item->info.str_offset->str

111− = copy(vm, heap_item->info.str_offset->str);

83+ {

84+ StrOffset * s = (StrOffset*)heap_item;

85+ s->base = (String*)copy(vm, (VAL)s->base);

86+ }

11287 break;

11388 default: // Nothing to copy

11489 break;

11590 }

116− scan += inc;

91+ scan += aligned(valSize(heap_item));

11792 }

11893 assert(scan == vm->heap.next);

11994}

rts/idris_gmp.c+79−210

@@ -22,249 +22,126 @@ VAL MKBIGI(int val) {

2222 return MKINT((i_int)val);

2323}

2424

25+static BigInt * allocBig(VM * vm) {

26+ idris_requireAlloc(vm, IDRIS_MAXGMP);

27+ BigInt * cl = iallocate(vm, sizeof(*cl) + sizeof(mpz_t), 0);

28+ idris_doneAlloc(vm);

29+ SETTY(cl, CT_BIGINT);

30+ mpz_init(*getmpz(cl));

31+ return cl;

32+}

33+

2534VAL MKBIGC(VM* vm, char* val) {

2635 if (*val == '\0') {

2736 return MKBIGI(0);

2837 }

2938 else {

30− idris_requireAlloc(IDRIS_MAXGMP);

31− mpz_t* bigint;

32−

33− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

34− idris_doneAlloc();

35− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

36−

37− mpz_init(*bigint);

38− mpz_set_str(*bigint, val, 10);

39−

40− SETTY(cl, CT_BIGINT);

41− cl -> info.ptr = (void*)bigint;

42−

43− return cl;

39+ BigInt * cl = allocBig(vm);

40+ mpz_set_str(*getmpz(cl), val, 10);

41+ return (VAL)cl;

4442 }

4543}

4644

47−VAL MKBIGM(VM* vm, void* big) {

48− idris_requireAlloc(IDRIS_MAXGMP);

49−

50− mpz_t* bigint;

51− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

52− idris_doneAlloc();

53− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

54−

55− mpz_init(*bigint);

56− mpz_set(*bigint, *((mpz_t*)big));

57−

58− SETTY(cl, CT_BIGINT);

59− cl -> info.ptr = (void*)bigint;

60−

61− return cl;

45+VAL MKBIGM(VM* vm, void* ibig) {

46+ BigInt * cl = allocBig(vm);

47+ mpz_set(*getmpz(cl), *((mpz_t*)ibig));

48+ return (VAL)cl;

6249}

6350

64−VAL MKBIGMc(VM* vm, void* big) {

65− idris_requireAlloc(IDRIS_MAXGMP);

66−

67− mpz_t* bigint;

68− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

69− idris_doneAlloc();

70− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

71−

72− mpz_init_set(*bigint, *((mpz_t*)big));

73−

74− SETTY(cl, CT_BIGINT);

75− cl -> info.ptr = (void*)bigint;

76−

77− return cl;

51+VAL MKBIGMc(VM* vm, void* ibig) {

52+ BigInt * cl = allocBig(vm);

53+ mpz_init_set(*getmpz(cl), *((mpz_t*)ibig));

54+ return (VAL)cl;

7855}

7956

8057VAL MKBIGUI(VM* vm, unsigned long val) {

81− idris_requireAlloc(IDRIS_MAXGMP);

82−

83− mpz_t* bigint;

84− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

85− idris_doneAlloc();

86− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

87−

88− mpz_init_set_ui(*bigint, val);

89−

90− SETTY(cl, CT_BIGINT);

91− cl -> info.ptr = (void*)bigint;

92−

93− return cl;

58+ BigInt * cl = allocBig(vm);

59+ mpz_init_set_ui(*getmpz(cl), val);

60+ return (VAL)cl;

9461}

9562

9663VAL MKBIGSI(VM* vm, signed long val) {

97− idris_requireAlloc(IDRIS_MAXGMP);

98−

99− mpz_t* bigint;

100− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

101− idris_doneAlloc();

102− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

103−

104− mpz_init_set_si(*bigint, val);

105−

106− SETTY(cl, CT_BIGINT);

107− cl -> info.ptr = (void*)bigint;

108−

109− return cl;

64+ BigInt * cl = allocBig(vm);

65+ mpz_init_set_si(*getmpz(cl), val);

66+ return (VAL)cl;

11067}

11168

112−VAL GETBIG(VM * vm, VAL x) {

113− idris_requireAlloc(IDRIS_MAXGMP);

114−

69+static BigInt * getbig(VM * vm, VAL x) {

11570 if (ISINT(x)) {

116− mpz_t* bigint;

117− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

118− idris_doneAlloc();

119− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

120−

121− mpz_init(*bigint);

122− mpz_set_si(*bigint, GETINT(x));

123−

124− SETTY(cl, CT_BIGINT);

125− cl -> info.ptr = (void*)bigint;

126−

71+ BigInt * cl = allocBig(vm);

72+ mpz_set_si(*getmpz(cl), GETINT(x));

12773 return cl;

12874 } else {

129− idris_doneAlloc();

13075 switch(GETTY(x)) {

13176 case CT_FWD:

132− return GETBIG(vm, x->info.ptr);

77+ return getbig(vm, ((Fwd*)x)->fwd);

13378 default:

134− return x;

79+ return (BigInt*)x;

13580 }

13681 }

13782}

13883

139−VAL bigAdd(VM* vm, VAL x, VAL y) {

140− idris_requireAlloc(IDRIS_MAXGMP);

84+#define GETBIG (VAL)getbig

14185

142− mpz_t* bigint;

143− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

144− idris_doneAlloc();

145− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

146− mpz_add(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

147− SETTY(cl, CT_BIGINT);

148− cl -> info.ptr = (void*)bigint;

149− return cl;

86+VAL bigAdd(VM* vm, VAL x, VAL y) {

87+ BigInt * cl = allocBig(vm);

88+ mpz_add(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

89+ return (VAL)cl;

15090}

15191

15292VAL bigSub(VM* vm, VAL x, VAL y) {

153− idris_requireAlloc(IDRIS_MAXGMP);

154−

155− mpz_t* bigint;

156− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

157− idris_doneAlloc();

158− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

159− mpz_sub(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

160− SETTY(cl, CT_BIGINT);

161− cl -> info.ptr = (void*)bigint;

162− return cl;

93+ BigInt * cl = allocBig(vm);

94+ mpz_sub(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

95+ return (VAL)cl;

16396}

16497

16598VAL bigMul(VM* vm, VAL x, VAL y) {

166− idris_requireAlloc(IDRIS_MAXGMP);

167−

168− mpz_t* bigint;

169− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

170− idris_doneAlloc();

171− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

172− mpz_mul(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

173− SETTY(cl, CT_BIGINT);

174− cl -> info.ptr = (void*)bigint;

175− return cl;

99+ BigInt * cl = allocBig(vm);

100+ mpz_mul(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

101+ return (VAL)cl;

176102}

177103

178104VAL bigDiv(VM* vm, VAL x, VAL y) {

179− idris_requireAlloc(IDRIS_MAXGMP);

180−

181− mpz_t* bigint;

182− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

183− idris_doneAlloc();

184− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

185− mpz_tdiv_q(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

186− SETTY(cl, CT_BIGINT);

187− cl -> info.ptr = (void*)bigint;

188− return cl;

105+ BigInt * cl = allocBig(vm);

106+ mpz_tdiv_q(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

107+ return (VAL)cl;

189108}

190109

191110VAL bigMod(VM* vm, VAL x, VAL y) {

192− idris_requireAlloc(IDRIS_MAXGMP);

193−

194− mpz_t* bigint;

195− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

196− idris_doneAlloc();

197− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

198− mpz_tdiv_r(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

199− SETTY(cl, CT_BIGINT);

200− cl -> info.ptr = (void*)bigint;

201− return cl;

111+ BigInt * cl = allocBig(vm);

112+ mpz_tdiv_r(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

113+ return (VAL)cl;

202114}

203115

204116VAL bigAnd(VM* vm, VAL x, VAL y) {

205− idris_requireAlloc(IDRIS_MAXGMP);

206−

207− mpz_t* bigint;

208− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

209− idris_doneAlloc();

210− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

211− mpz_and(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

212− SETTY(cl, CT_BIGINT);

213− cl -> info.ptr = (void*)bigint;

214− return cl;

117+ BigInt * cl = allocBig(vm);

118+ mpz_and(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

119+ return (VAL)cl;

215120}

216121

217122VAL bigOr(VM* vm, VAL x, VAL y) {

218− idris_requireAlloc(IDRIS_MAXGMP);

219−

220− mpz_t* bigint;

221− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

222− idris_doneAlloc();

223− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

224− mpz_ior(*bigint, GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));

225− SETTY(cl, CT_BIGINT);

226− cl -> info.ptr = (void*)bigint;

227− return cl;

123+ BigInt * cl = allocBig(vm);

124+ mpz_ior(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));

125+ return (VAL)cl;

228126}

229127

230128VAL bigShiftLeft(VM* vm, VAL x, VAL y) {

231− idris_requireAlloc(IDRIS_MAXGMP);

232−

233− mpz_t* bigint;

234− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

235− idris_doneAlloc();

236− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

237− mpz_mul_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));

238− SETTY(cl, CT_BIGINT);

239− cl -> info.ptr = (void*)bigint;

240− return cl;

129+ BigInt * cl = allocBig(vm);

130+ mpz_mul_2exp(*getmpz(cl), *getmpz(getbig(vm,x)), GETINT(y));

131+ return (VAL)cl;

241132}

242133

243134

244135VAL bigLShiftRight(VM* vm, VAL x, VAL y) {

245− idris_requireAlloc(IDRIS_MAXGMP);

246−

247− mpz_t* bigint;

248− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

249− idris_doneAlloc();

250− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

251− mpz_fdiv_q_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));

252− SETTY(cl, CT_BIGINT);

253− cl -> info.ptr = (void*)bigint;

254− return cl;

136+ BigInt * cl = allocBig(vm);

137+ mpz_fdiv_q_2exp(*getmpz(cl), *getmpz(getbig(vm,x)), GETINT(y));

138+ return (VAL)cl;

255139}

256140

257141VAL bigAShiftRight(VM* vm, VAL x, VAL y) {

258− idris_requireAlloc(IDRIS_MAXGMP);

259−

260− mpz_t* bigint;

261− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

262− idris_doneAlloc();

263− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

264− mpz_fdiv_q_2exp(*bigint, GETMPZ(GETBIG(vm,x)), GETINT(y));

265− SETTY(cl, CT_BIGINT);

266− cl -> info.ptr = (void*)bigint;

267− return cl;

142+ BigInt * cl = allocBig(vm);

143+ mpz_fdiv_q_2exp(*getmpz(cl), *getmpz(getbig(vm,x)), GETINT(y));

144+ return (VAL)cl;

268145}

269146

270147VAL idris_bigAnd(VM* vm, VAL x, VAL y) {

@@ -323,15 +200,15 @@ VAL idris_bigTimes(VM* vm, VAL x, VAL y) {

323200 if (ISINT(x) && ISINT(y)) {

324201 i_int vx = GETINT(x);

325202 i_int vy = GETINT(y);

326− // we could work out likelihood of overflow by checking the number

327− // of necessary bits. Here's a quick conservative hack instead.

328− if ((vx < (1<<15) && vy < (1<16)) ||

329− (vx < (1<<16) && vy < (1<15)) ||

330− (vx < (1<<20) && vy < (1<11)) ||

331− (vx < (1<<11) && vy < (1<20)) ||

332− (vx < (1<<23) && vy < (1<<8)) ||

333− (vx < (1<<8) && vy < (1<<23))) { // ultra-conservative!

334− return INTOP(*,x,y);

203+ // we could work out likelihood of overflow by checking the number

204+ // of necessary bits. Here's a quick conservative hack instead.

205+ if ((vx < (1<<15) && vy < (1<16)) ||

206+ (vx < (1<<16) && vy < (1<15)) ||

207+ (vx < (1<<20) && vy < (1<11)) ||

208+ (vx < (1<<11) && vy < (1<20)) ||

209+ (vx < (1<<23) && vy < (1<<8)) ||

210+ (vx < (1<<8) && vy < (1<<23))) { // ultra-conservative!

211+ return INTOP(*,x,y);

335212 } else {

336213 return bigMul(vm, GETBIG(vm, x), GETBIG(vm, y));

337214 }

@@ -382,8 +259,8 @@ VAL idris_bigMod(VM* vm, VAL x, VAL y) {

382259

383260int bigEqConst(VAL x, int c) {

384261 if (ISINT(x)) { return (GETINT(x) == c); }

385− else {

386− int rv = mpz_cmp_si(GETMPZ(x), c);

262+ else {

263+ int rv = mpz_cmp_si(GETMPZ(x), c);

387264 return (rv == 0);

388265 }

389266}

@@ -471,17 +348,9 @@ VAL idris_castBigFloat(VM* vm, VAL i) {

471348

472349VAL idris_castFloatBig(VM* vm, VAL f) {

473350 double val = GETFLOAT(f);

474−

475− mpz_t* bigint;

476− VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);

477− bigint = (mpz_t*)(((char*)cl) + sizeof(Closure));

478−

479− mpz_init_set_d(*bigint, val);

480−

481− SETTY(cl, CT_BIGINT);

482− cl -> info.ptr = (void*)bigint;

483−

484− return cl;

351+ BigInt * cl = allocBig(vm);

352+ mpz_init_set_d(*getmpz(cl), val);

353+ return (VAL)cl;

485354}

486355

487356VAL idris_castStrBig(VM* vm, VAL i) {

@@ -489,7 +358,7 @@ VAL idris_castStrBig(VM* vm, VAL i) {

489358}

490359

491360VAL idris_castBigStr(VM* vm, VAL i) {

492− char* str = mpz_get_str(NULL, 10, GETMPZ(GETBIG(vm, i)));

361+ char* str = mpz_get_str(NULL, 10, *getmpz(getbig(vm, i)));

493362 return MKSTR(vm, str);

494363}

495364

@@ -502,7 +371,7 @@ uint64_t idris_truncBigB64(const mpz_t bi) {

502371 }

503372 int64_t out = mpz_get_ui(bi);

504373 if (mpz_size(bi) > 1) {

505− out |= mpz_getlimbn(bi, 1) << 32;

374+ out |= ((int64_t)mpz_getlimbn(bi, 1)) << 32;

506375 }

507376 return out;

508377}

rts/idris_gmp.h+5−1

@@ -48,6 +48,10 @@ VAL idris_bigLShiftRight(VM* vm, VAL x, VAL y);

4848

4949uint64_t idris_truncBigB64(const mpz_t bi);

5050

51−#define GETMPZ(x) *((mpz_t*)((x)->info.ptr))

51+static inline mpz_t * getmpz(BigInt * v) {

52+ return (mpz_t*)(v->big);

53+}

54+

55+#define GETMPZ(x) *getmpz((BigInt*)x)

5256

5357#endif

rts/idris_heap.c+7−6

@@ -55,7 +55,7 @@ void c_heap_insert_if_needed(VM * vm, CHeap * heap, CHeapItem * item)

5555 heap->first = item;

5656

5757 // at this point, links are done; let's calculate sizes

58−

58+

5959 heap->size += item->size;

6060 if (heap->size >= heap->gc_trigger_size)

6161 {

@@ -186,16 +186,17 @@ void heap_check_pointers(Heap * heap) {

186186

187187 size_t item_size = 0;

188188 for(scan = heap->heap; scan < heap->next; scan += item_size) {

189− item_size = *((size_t*)scan);

190− VAL heap_item = (VAL)(scan + sizeof(size_t));

189+ VAL heap_item = (VAL)scan;

190+ item_size = aligned(valSize(heap_item));

191191

192192 switch(GETTY(heap_item)) {

193193 case CT_CON:

194194 {

195− int ar = ARITY(heap_item);

196− int i = 0;

195+ Con * c = (Con*)heap_item;

196+ size_t ar = CARITY(c);

197+ size_t i;

197198 for(i = 0; i < ar; ++i) {

198− VAL ptr = heap_item->info.c.args[i];

199+ VAL ptr = c->args[i];

199200

200201 if (is_valid_ref(ptr)) {

201202 // Check for closure.

rts/idris_main.c+1−2

@@ -33,7 +33,7 @@ int win32_get_argv_utf8(int *argc_ptr, char ***argv_ptr)

3333#endif

3434

3535// The default options should give satisfactory results under many circumstances.

36−RTSOpts opts = {

36+RTSOpts opts = {

3737 .init_heap_size = 16384000,

3838 .max_stack_size = 4096000,

3939 .show_summary = 0

@@ -74,6 +74,5 @@ int main(int argc, char **argv) {

7474 print_stats(&stats);

7575 }

7676

77− free_nullaries();

7877 return EXIT_SUCCESS;

7978}

rts/idris_rts.c+246−325

@@ -7,13 +7,22 @@

77#include "idris_bitstring.h"

88#include "getline.h"

10+#define STATIC_ASSERT(COND,MSG) typedef char static_assertion_##MSG[(COND)?1:-1]

11+

12+STATIC_ASSERT(sizeof(Hdr) == 8, condSizeOfHdr);

13+

14+#if defined(__linux__) || defined(__APPLE__) || defined(__FreeBSD__) || defined(__DragonFly__)

15+#include <signal.h>

16+#endif

17+

18+

1019#ifdef HAS_PTHREAD

1120static pthread_key_t vm_key;

1221#else

1322static VM* global_vm;

1423#endif

1524

16−void free_key(VM *vm) {

25+void free_key(void *vvm) {

1726 // nothing to free, we just used the VM pointer which is freed elsewhere

1827}

1928

@@ -83,7 +92,6 @@ VM* idris_vm(void) {

8392

8493VM* get_vm(void) {

8594#ifdef HAS_PTHREAD

86− init_threadkeys();

8795 return pthread_getspecific(vm_key);

8896#else

8997 return global_vm;

@@ -96,7 +104,7 @@ void close_vm(VM* vm) {

96104

97105#ifdef HAS_PTHREAD

98106void create_key(void) {

99− pthread_key_create(&vm_key, (void*)free_key);

107+ pthread_key_create(&vm_key, free_key);

100108}

101109#endif

102110

@@ -155,13 +163,7 @@ CData cdata_manage(void * data, size_t size, CDataFinalizer finalizer)

155163 return c_heap_create_item(data, size, finalizer);

156164}

157165

158−void idris_requireAlloc(size_t size) {

159−#ifdef HAS_PTHREAD

160− VM* vm = pthread_getspecific(vm_key);

161−#else

162− VM* vm = global_vm;

163−#endif

164−

166+void idris_requireAlloc(VM * vm, size_t size) {

165167 if (!(vm->heap.next + size < vm->heap.end)) {

166168 idris_gc(vm);

167169 }

@@ -173,9 +175,8 @@ void idris_requireAlloc(size_t size) {

173175#endif

174176}

175177

176−void idris_doneAlloc(void) {

178+void idris_doneAlloc(VM * vm) {

177179#ifdef HAS_PTHREAD

178− VM* vm = pthread_getspecific(vm_key);

179180 int lock = vm->processes > 0;

180181 if (lock) { // We only need to lock if we're in concurrent mode

181182 pthread_mutex_unlock(&vm->alloc_lock);

@@ -184,14 +185,13 @@ void idris_doneAlloc(void) {

184185}

185186

186187int space(VM* vm, size_t size) {

187− return (vm->heap.next + size + sizeof(size_t) < vm->heap.end);

188+ return (vm->heap.next + size) < vm->heap.end;

188189}

189190

190191void* idris_alloc(size_t size) {

191− Closure* cl = (Closure*) allocate(sizeof(Closure)+size, 0);

192+ RawData * cl = (RawData*) allocate(sizeof(*cl)+size, 0);

192193 SETTY(cl, CT_RAWDATA);

193− cl->info.size = size;

194− return (void*)((char *)cl+sizeof(Closure));

194+ return (void*)cl->raw;

195195}

196196

197197void* idris_realloc(void* old, size_t old_size, size_t size) {

@@ -203,41 +203,36 @@ void* idris_realloc(void* old, size_t old_size, size_t size) {

203203void idris_free(void* ptr, size_t size) {

204204}

205205

206−void* allocate(size_t size, int outerlock) {

206+void * allocate(size_t sz, int lock) {

207+ return iallocate(get_vm(), sz, lock);

208+}

209+

210+void* iallocate(VM * vm, size_t isize, int outerlock) {

207211// return malloc(size);

212+ size_t size = aligned(isize);

208213

209214#ifdef HAS_PTHREAD

210− VM* vm = pthread_getspecific(vm_key);

211215 int lock = vm->processes > 0 && !outerlock;

212216

213217 if (lock) { // not message passing

214218 pthread_mutex_lock(&vm->alloc_lock);

215219 }

216−#else

217− VM* vm = global_vm;

218220#endif

219221

220− if ((size & 7)!=0) {

221− size = 8 + ((size >> 3) << 3);

222− }

223−

224− size_t chunk_size = size + sizeof(size_t);

225−

226− if (vm->heap.next + chunk_size < vm->heap.end) {

227− STATS_ALLOC(vm->stats, chunk_size)

228− void* ptr = (void*)(vm->heap.next + sizeof(size_t));

229− *((size_t*)(vm->heap.next)) = chunk_size;

230− vm->heap.next += chunk_size;

231−

222+ if (vm->heap.next + size < vm->heap.end) {

223+ STATS_ALLOC(vm->stats, size)

224+ char* ptr = vm->heap.next;

225+ vm->heap.next += size;

232226 assert(vm->heap.next <= vm->heap.end);

233−

234227 memset(ptr, 0, size);

228+ ((Hdr*)ptr)->sz = isize;

229+

235230#ifdef HAS_PTHREAD

236231 if (lock) { // not message passing

237232 pthread_mutex_unlock(&vm->alloc_lock);

238233 }

239234#endif

240− return ptr;

235+ return (void*)ptr;

241236 } else {

242237 // If we're trying to allocate something bigger than the heap,

243238 // grow the heap here so that the new heap is big enough.

@@ -250,173 +245,148 @@ void* allocate(size_t size, int outerlock) {

250245 pthread_mutex_unlock(&vm->alloc_lock);

251246 }

252247#endif

253− return allocate(size, 0);

248+ return iallocate(vm, size, outerlock);

254249 }

255250

256251}

257252

258−/* Now a macro

259−void* allocCon(VM* vm, int arity, int outer) {

260− Closure* cl = allocate(vm, sizeof(Closure) + sizeof(VAL)*arity,

261− outer);

262− SETTY(cl, CT_CON);

253+static String * allocStr(VM * vm, size_t len, int outer) {

254+ String * cl = iallocate(vm, sizeof(*cl) + len + 1, outer);

255+ SETTY(cl, CT_STRING);

256+ cl->slen = len;

257+ return cl;

258+}

263259

264− cl -> info.c.arity = arity;

265−// cl -> info.c.tag = 42424242;

266−// printf("%p\n", cl);

267− return (void*)cl;

260+static VAL mkfloat(VM* vm, double val, int outer) {

261+ Float * cl = iallocate(vm, sizeof(*cl), outer);

262+ SETTY(cl, CT_FLOAT);

263+ cl->f = val;

264+ return (VAL)cl;

268265}

269−*/

270266

271267VAL MKFLOAT(VM* vm, double val) {

272− Closure* cl = allocate(sizeof(Closure), 0);

273− SETTY(cl, CT_FLOAT);

274− cl -> info.f = val;

275− return cl;

268+ return mkfloat(vm, val, 0);

269+}

270+

271+VAL MKFLOATc(VM* vm, double val) {

272+ return mkfloat(vm, val, 1);

273+}

274+

275+static VAL mkstrlen(VM* vm, const char * str, size_t len, int outer) {

276+ String * cl = allocStr(vm, len, outer);

277+ // hdr.u8 used to mark a null string

278+ cl->hdr.u8 = str == NULL;

279+ memcpy(cl->str, str, len);

280+ return (VAL)cl;

281+}

282+

283+VAL MKSTRlen(VM* vm, const char * str, size_t len) {

284+ return mkstrlen(vm, str, len, 0);

285+}

286+

287+VAL MKSTRclen(VM* vm, char* str, size_t len) {

288+ return mkstrlen(vm, str, len, 1);

276289}

277290

278291VAL MKSTR(VM* vm, const char* str) {

279− int len;

280− if (str == NULL) {

281− len = 0;

282− } else {

283− len = strlen(str)+1;

284− }

285− Closure* cl = allocate(sizeof(Closure) + // Type) + sizeof(char*) +

286− sizeof(char)*len, 0);

287− SETTY(cl, CT_STRING);

288− cl->info.str.str = (char*)cl + sizeof(Closure);

289− if (str == NULL) {

290− cl->info.str.str = NULL;

291− } else {

292− strcpy(cl->info.str.str, str);

293− }

294− cl->info.str.len = len > 0 ? len : 0;

295− return cl;

292+ return mkstrlen(vm, str, str? strlen(str) : 0, 0);

293+}

294+

295+VAL MKSTRc(VM* vm, char* str) {

296+ return mkstrlen(vm, str, strlen(str), 1);

297+}

298+

299+static char * getstroff(StrOffset * stroff) {

300+ return stroff->base->str + stroff->offset;

296301}

297302

298303char* GETSTROFF(VAL stroff) {

299304 // Assume STROFF

300− StrOffset* root = stroff->info.str_offset;

301− return (root->str->info.str.str + root->offset);

305+ return getstroff((StrOffset*)stroff);

306+}

307+

308+static size_t getstrofflen(StrOffset * stroff) {

309+ return stroff->base->slen - stroff->offset;

302310}

303311

304312size_t GETSTROFFLEN(VAL stroff) {

305313 // Assume STROFF

306314 // we're working in char* here so no worries about utf8 char length

307− StrOffset* root = stroff->info.str_offset;

308− return (root->str->info.str.len - root->offset);

315+ return getstrofflen((StrOffset*)stroff);

309316}

310317

311−VAL MKCDATA(VM* vm, CHeapItem * item) {

318+static VAL mkcdata(VM * vm, CHeapItem * item, int outer) {

312319 c_heap_insert_if_needed(vm, &vm->c_heap, item);

313− Closure* cl = allocate(sizeof(Closure), 0);

320+ CDataC * cl = iallocate(vm, sizeof(*cl), outer);

314321 SETTY(cl, CT_CDATA);

315− cl->info.c_heap_item = item;

316− return cl;

322+ cl->item = item;

323+ return (VAL)cl;

317324}

318325

319−VAL MKCDATAc(VM* vm, CHeapItem * item) {

320− c_heap_insert_if_needed(vm, &vm->c_heap, item);

321− Closure* cl = allocate(sizeof(Closure), 1);

322− SETTY(cl, CT_CDATA);

323− cl->info.c_heap_item = item;

324− return cl;

326+VAL MKCDATA(VM* vm, CHeapItem * item) {

327+ return mkcdata(vm, item, 0);

325328}

326329

327−VAL MKPTR(VM* vm, void* ptr) {

328− Closure* cl = allocate(sizeof(Closure), 0);

329− SETTY(cl, CT_PTR);

330− cl -> info.ptr = ptr;

331− return cl;

330+VAL MKCDATAc(VM* vm, CHeapItem * item) {

331+ return mkcdata(vm, item, 1);

332332}

333333

334−VAL MKMPTR(VM* vm, void* ptr, size_t size) {

335− Closure* cl = allocate(sizeof(Closure) +

336− sizeof(ManagedPtr) + size, 0);

337− SETTY(cl, CT_MANAGEDPTR);

338− cl->info.mptr = (ManagedPtr*)((char*)cl + sizeof(Closure));

339− cl->info.mptr->data = (char*)cl + sizeof(Closure) + sizeof(ManagedPtr);

340− memcpy(cl->info.mptr->data, ptr, size);

341− cl->info.mptr->size = size;

342− return cl;

334+static VAL mkptr(VM* vm, void* ptr, int outer) {

335+ Ptr * cl = iallocate(vm, sizeof(*cl), outer);

336+ SETTY(cl, CT_PTR);

337+ cl->ptr = ptr;

338+ return (VAL)cl;

343339}

344340

345−VAL MKFLOATc(VM* vm, double val) {

346− Closure* cl = allocate(sizeof(Closure), 1);

347− SETTY(cl, CT_FLOAT);

348− cl -> info.f = val;

349− return cl;

341+VAL MKPTR(VM* vm, void* ptr) {

342+ return mkptr(vm, ptr, 0);

350343}

351344

352−VAL MKSTRc(VM* vm, char* str) {

353− int len = strlen(str);

354−

355− Closure* cl = allocate(sizeof(Closure) + // Type) + sizeof(char*) +

356− sizeof(char)*len+1, 1);

357− SETTY(cl, CT_STRING);

358− cl -> info.str.str = (char*)cl + sizeof(Closure);

359−

360− strcpy(cl->info.str.str, str);

361− cl->info.str.len = len;

362− return cl;

345+VAL MKPTRc(VM* vm, void* ptr) {

346+ return mkptr(vm, ptr, 1);

363347}

364348

365−VAL MKSTRclen(VM* vm, char* str, int len) {

366− Closure* cl = allocate(sizeof(Closure) + // Type) + sizeof(char*) +

367− sizeof(char)*len+1, 1);

368− SETTY(cl, CT_STRING);

369− cl -> info.str.str = (char*)cl + sizeof(Closure);

370−

371− strcpy(cl->info.str.str, str);

372− cl->info.str.len = len;

373− return cl;

349+VAL mkmptr(VM* vm, void* ptr, size_t size, int outer) {

350+ ManagedPtr * cl = iallocate(vm, sizeof(*cl) + size, outer);

351+ SETTY(cl, CT_MANAGEDPTR);

352+ memcpy(cl->mptr, ptr, size);

353+ return (VAL)cl;

374354}

375355

376−VAL MKPTRc(VM* vm, void* ptr) {

377− Closure* cl = allocate(sizeof(Closure), 1);

378− SETTY(cl, CT_PTR);

379− cl -> info.ptr = ptr;

380− return cl;

356+VAL MKMPTR(VM* vm, void* ptr, size_t size) {

357+ return mkmptr(vm, ptr, size, 0);

381358}

382359

383360VAL MKMPTRc(VM* vm, void* ptr, size_t size) {

384− Closure* cl = allocate(sizeof(Closure) +

385− sizeof(ManagedPtr) + size, 1);

386− SETTY(cl, CT_MANAGEDPTR);

387− cl->info.mptr = (ManagedPtr*)((char*)cl + sizeof(Closure));

388− cl->info.mptr->data = (char*)cl + sizeof(Closure) + sizeof(ManagedPtr);

389− memcpy(cl->info.mptr->data, ptr, size);

390− cl->info.mptr->size = size;

391− return cl;

361+ return mkmptr(vm, ptr, size, 1);

392362}

393363

394364VAL MKB8(VM* vm, uint8_t bits8) {

395− Closure* cl = allocate(sizeof(Closure), 1);

365+ Bits8 * cl = iallocate(vm, sizeof(*cl), 1);

396366 SETTY(cl, CT_BITS8);

397− cl -> info.bits8 = bits8;

398− return cl;

367+ cl->bits8 = bits8;

368+ return (VAL)cl;

399369}

400370

401371VAL MKB16(VM* vm, uint16_t bits16) {

402− Closure* cl = allocate(sizeof(Closure), 1);

372+ Bits16 * cl = iallocate(vm, sizeof(*cl), 1);

403373 SETTY(cl, CT_BITS16);

404− cl -> info.bits16 = bits16;

405− return cl;

374+ cl->bits16 = bits16;

375+ return (VAL)cl;

406376}

407377

408378VAL MKB32(VM* vm, uint32_t bits32) {

409− Closure* cl = allocate(sizeof(Closure), 1);

379+ Bits32 * cl = iallocate(vm, sizeof(*cl), 1);

410380 SETTY(cl, CT_BITS32);

411− cl -> info.bits32 = bits32;

412− return cl;

381+ cl->bits32 = bits32;

382+ return (VAL)cl;

413383}

414384

415385VAL MKB64(VM* vm, uint64_t bits64) {

416− Closure* cl = allocate(sizeof(Closure), 1);

386+ Bits64 * cl = iallocate(vm, sizeof(*cl), 1);

417387 SETTY(cl, CT_BITS64);

418− cl -> info.bits64 = bits64;

419− return cl;

388+ cl->bits64 = bits64;

389+ return (VAL)cl;

420390}

421391

422392void idris_trace(VM* vm, const char* func, int line) {

@@ -451,23 +421,35 @@ void dumpVal(VAL v) {

451421 }

452422 switch(GETTY(v)) {

453423 case CT_CON:

454− printf("%d[", TAG(v));

455− for(i = 0; i < ARITY(v); ++i) {

456− dumpVal(v->info.c.args[i]);

424+ {

425+ Con * cl = (Con*)v;

426+ printf("%d[", (int)TAG(cl));

427+ for(i = 0; i < CARITY(cl); ++i) {

428+ dumpVal(cl->args[i]);

429+ }

430+ printf("] ");

457431 }

458− printf("] ");

459432 break;

460433 case CT_STRING:

461− printf("STR[%s]", v->info.str.str);

434+ {

435+ String * cl = (String*)v;

436+ printf("STR[%s]", cl->str);

437+ }

462438 break;

463439 case CT_STROFFSET:

464− printf("OFFSET[");

465− dumpVal((VAL)(v->info.str_offset->str));

466− printf("]");

440+ {

441+ StrOffset * cl = (StrOffset*)v;

442+ printf("OFFSET[");

443+ dumpVal((VAL)cl->base);

444+ printf("]");

445+ }

467446 break;

468447 case CT_FWD:

469− printf("CT_FWD ");

470− dumpVal((VAL)(v->info.ptr));

448+ {

449+ Fwd * cl = (Fwd*)v;

450+ printf("CT_FWD ");

451+ dumpVal((VAL)cl->fwd);

452+ }

471453 break;

472454 default:

473455 printf("val");

@@ -489,7 +471,7 @@ void idris_poke(void* ptr, i_int offset, uint8_t data) {

489471

490472

491473VAL idris_peekPtr(VM* vm, VAL ptr, VAL offset) {

492− void** addr = (void **)((char *)GETPTR(ptr) + GETINT(offset));

474+ void** addr = (void **)(((char *)GETPTR(ptr)) + GETINT(offset));

493475 return MKPTR(vm, *addr);

494476}

495477

@@ -523,51 +505,41 @@ void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i

523505

524506VAL idris_castIntStr(VM* vm, VAL i) {

525507 int x = (int) GETINT(i);

526− Closure* cl = allocate(sizeof(Closure) + sizeof(char)*16, 0);

527− SETTY(cl, CT_STRING);

528− cl->info.str.str = (char*)cl + sizeof(Closure);

529− sprintf(cl->info.str.str, "%d", x);

530− cl->info.str.len = strlen(cl->info.str.str);

531− return cl;

508+ String * cl = allocStr(vm, 16, 0);

509+ cl->slen = sprintf(cl->str, "%d", x);

510+ return (VAL)cl;

532511}

533512

534513VAL idris_castBitsStr(VM* vm, VAL i) {

535− Closure* cl;

536− ClosureType ty = i->ty;

514+ String * cl;

515+ ClosureType ty = GETTY(i);

537516

538517 switch (ty) {

539518 case CT_BITS8:

540519 // max length 8 bit unsigned int str 3 chars (256)

541− cl = allocate(sizeof(Closure) + sizeof(char)*4, 0);

542− cl->info.str.str = (char*)cl + sizeof(Closure);

543− sprintf(cl->info.str.str, "%" PRIu8, (uint8_t)i->info.bits8);

520+ cl = allocStr(vm, 4, 0);

521+ cl->slen = sprintf(cl->str, "%" PRIu8, GETBITS8(i));

544522 break;

545523 case CT_BITS16:

546524 // max length 16 bit unsigned int str 5 chars (65,535)

547− cl = allocate(sizeof(Closure) + sizeof(char)*6, 0);

548− cl->info.str.str = (char*)cl + sizeof(Closure);

549− sprintf(cl->info.str.str, "%" PRIu16, (uint16_t)i->info.bits16);

525+ cl = allocStr(vm, 6, 0);

526+ cl->slen = sprintf(cl->str, "%" PRIu16, GETBITS16(i));

550527 break;

551528 case CT_BITS32:

552529 // max length 32 bit unsigned int str 10 chars (4,294,967,295)

553− cl = allocate(sizeof(Closure) + sizeof(char)*11, 0);

554− cl->info.str.str = (char*)cl + sizeof(Closure);

555− sprintf(cl->info.str.str, "%" PRIu32, (uint32_t)i->info.bits32);

530+ cl = allocStr(vm, 11, 0);

531+ cl->slen = sprintf(cl->str, "%" PRIu32, GETBITS32(i));

556532 break;

557533 case CT_BITS64:

558534 // max length 64 bit unsigned int str 20 chars (18,446,744,073,709,551,615)

559− cl = allocate(sizeof(Closure) + sizeof(char)*21, 0);

560− cl->info.str.str = (char*)cl + sizeof(Closure);

561− sprintf(cl->info.str.str, "%" PRIu64, (uint64_t)i->info.bits64);

535+ cl = allocStr(vm, 21, 0);

536+ cl->slen = sprintf(cl->str, "%" PRIu64, GETBITS64(i));

562537 break;

563538 default:

564539 fprintf(stderr, "Fatal Error: ClosureType %d, not an integer type", ty);

565540 exit(EXIT_FAILURE);

566541 }

567−

568− cl->info.str.len = strlen(cl->info.str.str);

569− SETTY(cl, CT_STRING);

570− return cl;

542+ return (VAL)cl;

571543}

572544

573545VAL idris_castStrInt(VM* vm, VAL i) {

@@ -580,13 +552,9 @@ VAL idris_castStrInt(VM* vm, VAL i) {

580552}

581553

582554VAL idris_castFloatStr(VM* vm, VAL i) {

583− Closure* cl = allocate(sizeof(Closure) + sizeof(char)*32, 0);

584− SETTY(cl, CT_STRING);

585− cl->info.str.str = (char*)cl + sizeof(Closure);

586− snprintf(cl->info.str.str, 32, "%.16g", GETFLOAT(i));

587−

588− cl->info.str.len = strlen(cl->info.str.str);

589− return cl;

555+ String * cl = allocStr(vm, 32, 0);

556+ cl->slen = snprintf(cl->str, 32, "%.16g", GETFLOAT(i));

557+ return (VAL)cl;

590558}

591559

592560VAL idris_castStrFloat(VM* vm, VAL i) {

@@ -596,17 +564,13 @@ VAL idris_castStrFloat(VM* vm, VAL i) {

596564VAL idris_concat(VM* vm, VAL l, VAL r) {

597565 char *rs = GETSTR(r);

598566 char *ls = GETSTR(l);

599− int llen = GETSTRLEN(l);

600− int rlen = GETSTRLEN(r);

567+ size_t llen = GETSTRLEN(l);

568+ size_t rlen = GETSTRLEN(r);

601569

602− Closure* cl = allocate(sizeof(Closure) + llen + rlen + 1, 0);

603− SETTY(cl, CT_STRING);

604− cl->info.str.str = (char*)cl + sizeof(Closure);

605− strcpy(cl->info.str.str, ls);

606− strcat(cl->info.str.str, rs);

607−

608− cl->info.str.len = llen + rlen;

609− return cl;

570+ String * cl = allocStr(vm, llen + rlen, 0);

571+ memcpy(cl->str, ls, llen);

572+ memcpy(cl->str + llen, rs, rlen);

573+ return (VAL)cl;

610574}

611575

612576VAL idris_strlt(VM* vm, VAL l, VAL r) {

@@ -667,38 +631,32 @@ VAL idris_strHead(VM* vm, VAL str) {

667631 return idris_strIndex(vm, str, 0);

668632}

669633

670−VAL MKSTROFFc(VM* vm, StrOffset* off) {

671− Closure* cl = allocate(sizeof(Closure) + sizeof(StrOffset), 1);

634+VAL MKSTROFFc(VM* vm, VAL basestr) {

635+ StrOffset * cl = iallocate(vm, sizeof(*cl), 1);

672636 SETTY(cl, CT_STROFFSET);

673− cl->info.str_offset = (StrOffset*)((char*)cl + sizeof(Closure));

674−

675− cl->info.str_offset->str = off->str;

676− cl->info.str_offset->offset = off->offset;

677−

678− return cl;

637+ cl->base = (String*)basestr;

638+ return (VAL)cl;

679639}

680640

681641VAL idris_strShift(VM* vm, VAL str, int num) {

642+ size_t sz = sizeof(StrOffset);

682643 // If there's no room, just copy the string, or we'll have a problem after

683644 // gc moves str

684− if (space(vm, sizeof(Closure) + sizeof(StrOffset))) {

685− Closure* cl = allocate(sizeof(Closure) + sizeof(StrOffset), 0);

686− SETTY(cl, CT_STROFFSET);

687− cl->info.str_offset = (StrOffset*)((char*)cl + sizeof(Closure));

688−

645+ if (space(vm, sz)) {

689646 int offset = 0;

690− VAL root = str;

647+ StrOffset * root = (StrOffset*)str;

648+ StrOffset * cl = iallocate(vm, sz, 0);

649+ SETTY(cl, CT_STROFFSET);

691650

692651 while(root!=NULL && !ISSTR(root)) { // find the root, carry on.

693652 // In theory, at most one step here!

694− offset += root->info.str_offset->offset;

695− root = root->info.str_offset->str;

653+ offset += root->offset;

654+ root = (StrOffset*)root->base;

696655 }

697656

698− cl->info.str_offset->str = root;

699− cl->info.str_offset->offset = offset+idris_utf8_findOffset(GETSTR(str), num);

700−

701− return cl;

657+ cl->base = (String*)root;

658+ cl->offset = offset+idris_utf8_findOffset(GETSTR(str), num);

659+ return (VAL)cl;

702660 } else {

703661 char* nstr = GETSTR(str);

704662 return MKSTR(vm, nstr+idris_utf8_charlen(nstr));

@@ -712,29 +670,23 @@ VAL idris_strTail(VM* vm, VAL str) {

712670VAL idris_strCons(VM* vm, VAL x, VAL xs) {

713671 char *xstr = GETSTR(xs);

714672 int xval = GETINT(x);

715− int xlen = GETSTRLEN(xs);

673+ size_t xlen = GETSTRLEN(xs);

674+ String * cl;

716675

717676 if (xval < 0x80) { // ASCII char

718− Closure* cl = allocate(sizeof(Closure) +

719− xlen + 2, 0);

720− SETTY(cl, CT_STRING);

721− cl->info.str.str = (char*)cl + sizeof(Closure);

722− cl->info.str.str[0] = (char)(GETINT(x));

723− strcpy(cl->info.str.str+1, xstr);

724− cl->info.str.len = xlen + 1;

725− return cl;

677+ cl = allocStr(vm, xlen + 1, 0);

678+ cl->str[0] = (char)(GETINT(x));

679+ memcpy(cl->str+1, xstr, xlen);

726680 } else {

727681 char *init = idris_utf8_fromChar(xval);

728− int newlen = strlen(init) + xlen;

729− Closure* cl = allocate(sizeof(Closure) + newlen + 1, 0);

730− SETTY(cl, CT_STRING);

731− cl->info.str.str = (char*)cl + sizeof(Closure);

732− strcpy(cl->info.str.str, init);

733− strcat(cl->info.str.str, xstr);

734− cl->info.str.len = newlen;

682+ size_t ilen = strlen(init);

683+ int newlen = ilen + xlen;

684+ cl = allocStr(vm, newlen, 0);

685+ memcpy(cl->str, init, ilen);

686+ memcpy(cl->str + ilen, xstr, xlen);

735687 free(init);

736− return cl;

737688 }

689+ return (VAL)cl;

738690}

739691

740692VAL idris_strIndex(VM* vm, VAL str, VAL i) {

@@ -743,8 +695,8 @@ VAL idris_strIndex(VM* vm, VAL str, VAL i) {

743695}

744696

745697VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str) {

746− int offset_val = GETINT(offset);

747− int length_val = GETINT(length);

698+ size_t offset_val = GETINT(offset);

699+ size_t length_val = GETINT(length);

748700 char* str_val = GETSTR(str);

749701

750702 // If the substring is a suffix, use idris_strShift to avoid reallocating

@@ -754,33 +706,28 @@ VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str) {

754706 else {

755707 char *start = idris_utf8_advance(str_val, offset_val);

756708 char *end = idris_utf8_advance(start, length_val);

757− Closure* newstr = allocate(sizeof(Closure) + (end - start) +1, 0);

758− SETTY(newstr, CT_STRING);

759− newstr->info.str.str = (char*)newstr + sizeof(Closure);

760− memcpy(newstr->info.str.str, start, end - start);

761− *(newstr->info.str.str + (end - start) + 1) = '\0';

762− newstr->info.str.len = strlen(newstr->info.str.str);

763− return newstr;

709+ size_t sz = end - start;

710+ String * newstr = allocStr(vm, sz, 0);

711+ memcpy(newstr->str, start, sz);

712+ newstr->str[sz] = '\0';

713+ return (VAL)newstr;

764714 }

765715}

766716

767717VAL idris_strRev(VM* vm, VAL str) {

768718 char *xstr = GETSTR(str);

769− int xlen = GETSTRLEN(str);

719+ size_t xlen = GETSTRLEN(str);

770720

771− Closure* cl = allocate(sizeof(Closure) + xlen + 1, 0);

772− SETTY(cl, CT_STRING);

773− cl->info.str.str = (char*)cl + sizeof(Closure);

774− cl->info.str.len = xlen;

775− idris_utf8_rev(xstr, cl->info.str.str);

776− return cl;

721+ String * cl = allocStr(vm, xlen, 0);

722+ idris_utf8_rev(xstr, cl->str);

723+ return (VAL)cl;

777724}

778725

779726VAL idris_newRefLock(VAL x, int outerlock) {

780− Closure* cl = allocate(sizeof(Closure), outerlock);

727+ Ref * cl = allocate(sizeof(*cl), outerlock);

781728 SETTY(cl, CT_REF);

782− cl->info.ptr = (void*)x;

783− return cl;

729+ cl->ref = x;

730+ return (VAL)cl;

784731}

785732

786733VAL idris_newRef(VAL x) {

@@ -788,30 +735,34 @@ VAL idris_newRef(VAL x) {

788735}

789736

790737void idris_writeRef(VAL ref, VAL x) {

791− ref->info.ptr = (void*)x;

738+ Ref * r = (Ref*)ref;

739+ r->ref = x;

792740 SETTY(ref, CT_REF);

793741}

794742

795743VAL idris_readRef(VAL ref) {

796− return (VAL)(ref->info.ptr);

744+ Ref * r = (Ref*)ref;

745+ return r->ref;

797746}

798747

799748VAL idris_newArray(VM* vm, int size, VAL def) {

800− Closure* cl;

749+ Array * cl;

801750 int i;

802− allocArray(cl, vm, size, 0);

751+ cl = allocArrayF(vm, size, 0);

803752 for(i=0; i<size; ++i) {

804− cl->info.arr.content[i] = def;

753+ cl->array[i] = def;

805754 }

806− return cl;

755+ return (VAL)cl;

807756}

808757

809758void idris_arraySet(VAL arr, int index, VAL newval) {

810− arr->info.arr.content[index] = newval;

759+ Array * cl = (Array*)arr;

760+ cl->array[index] = newval;

811761}

812762

813763VAL idris_arrayGet(VAL arr, int index) {

814− return arr->info.arr.content[index];

764+ Array * cl = (Array*)arr;

765+ return cl->array[index];

815766}

816767

817768VAL idris_systemInfo(VM* vm, VAL index) {

@@ -892,75 +843,58 @@ void* idris_stopThread(VM* vm) {

892843 return NULL;

893844}

894845

846+static VAL doCopyTo(VM* vm, VAL x);

847+

848+static void copyArray(VM* vm, VAL * dst, VAL * src, size_t len) {

849+ size_t i;

850+ for(i = 0; i < len; ++i)

851+ dst[i] = doCopyTo(vm, src[i]);

852+}

853+

854+

895855// VM is assumed to be a different vm from the one x lives on

896856

897−VAL doCopyTo(VM* vm, VAL x) {

898− int i, ar, len;

899− VAL* argptr;

900− Closure* cl;

857+static VAL doCopyTo(VM* vm, VAL x) {

858+ int ar;

859+ VAL cl;

901860 if (x==NULL || ISINT(x)) {

902861 return x;

903862 }

904863 switch(GETTY(x)) {

864+ case CT_CDATA:

865+ cl = MKCDATAc(vm, GETCDATA(x));

866+ break;

867+ case CT_BIGINT:

868+ cl = MKBIGMc(vm, GETMPZ(x));

869+ break;

905870 case CT_CON:

906871 ar = CARITY(x);

907872 if (ar == 0 && CTAG(x) < 256) { // globally allocated

908873 cl = x;

909874 } else {

910− allocCon(cl, vm, CTAG(x), ar, 1);

911−

912− argptr = (VAL*)(cl->info.c.args);

913− for(i = 0; i < ar; ++i) {

914− *argptr = doCopyTo(vm, *((VAL*)(x->info.c.args)+i)); // recursive version

915− argptr++;

916− }

875+ Con * c = allocConF(vm, CTAG(x), ar, 1);

876+ copyArray(vm, c->args, ((Con*)x)->args, ar);

877+ cl = (VAL)c;

917878 }

918879 break;

919− case CT_ARRAY:

920− len = x->info.arr.length;

921− allocArray(cl, vm, len, 1);

922−

923− argptr = (VAL*)(cl->info.arr.content);

924− for(i = 0; i < len; ++i) {

925− *argptr = doCopyTo(vm, *((VAL*)(x->info.arr.content)+i)); // recursive version

926− argptr++;

927− }

928− break;

929− case CT_FLOAT:

930− cl = MKFLOATc(vm, x->info.f);

931− break;

880+ case CT_ARRAY: {

881+ size_t len = CELEM(x);

882+ Array * a = allocArrayF(vm, len, 1);

883+ copyArray(vm, a->array, ((Array*)x)->array, len);

884+ cl = (VAL)a;

885+ } break;

932886 case CT_STRING:

933− cl = MKSTRc(vm, x->info.str.str);

934− break;

935− case CT_BIGINT:

936− cl = MKBIGMc(vm, x->info.ptr);

937− break;

887+ case CT_FLOAT:

938888 case CT_PTR:

939− cl = MKPTRc(vm, x->info.ptr);

940− break;

941889 case CT_MANAGEDPTR:

942− cl = MKMPTRc(vm, x->info.mptr->data, x->info.mptr->size);

943− break;

944− case CT_CDATA:

945− cl = MKCDATAc(vm, x->info.c_heap_item);

946− break;

947890 case CT_BITS8:

948− cl = idris_b8CopyForGC(vm, x);

949− break;

950891 case CT_BITS16:

951− cl = idris_b16CopyForGC(vm, x);

952− break;

953892 case CT_BITS32:

954− cl = idris_b32CopyForGC(vm, x);

955− break;

956893 case CT_BITS64:

957− cl = idris_b64CopyForGC(vm, x);

958− break;

959894 case CT_RAWDATA:

960895 {

961− size_t size = x->info.size + sizeof(Closure);

962− cl = allocate(size, 0);

963− memcpy(cl, x, size);

896+ cl = iallocate(vm, x->hdr.sz, 0);

897+ memcpy(cl, x, x->hdr.sz);

964898 }

965899 break;

966900 default:

@@ -970,10 +904,7 @@ VAL doCopyTo(VM* vm, VAL x) {

970904}

971905

972906VAL copyTo(VM* vm, VAL x) {

973− VM* current = pthread_getspecific(vm_key);

974− pthread_setspecific(vm_key, vm);

975907 VAL ret = doCopyTo(vm, x);

976− pthread_setspecific(vm_key, current);

977908 return ret;

978909}

979910

@@ -1112,7 +1043,7 @@ Msg* idris_recvMessageFrom(VM* vm, int channel_id, VM* sender) {

11121043

11131044 struct timespec timeout;

11141045 int status;

1115−

1046+

11161047 if (sender && sender->active == 0) { return NULL; } // No VM to receive from

11171048

11181049 pthread_mutex_lock(&vm->inbox_block);

@@ -1187,26 +1118,16 @@ char* idris_showerror(int err) {

11871118 return strerror(err);

11881119}

11891120

1190−VAL* nullary_cons;

1121+Con nullary_cons[256];

11911122

11921123void init_nullaries(void) {

11931124 int i;

1194− VAL cl;

1195− nullary_cons = malloc(256 * sizeof(VAL));

11961125 for(i = 0; i < 256; ++i) {

1197− cl = malloc(sizeof(Closure));

1126+ Con * cl = nullary_cons + i;

1127+ cl->hdr.sz = sizeof(*cl);

11981128 SETTY(cl, CT_CON);

1199− cl->info.c.tag_arity = i << 8;

1200− nullary_cons[i] = cl;

1201− }

1202−}

1203−

1204−void free_nullaries(void) {

1205− int i;

1206− for(i = 0; i < 256; ++i) {

1207− free(nullary_cons[i]);

1129+ cl->tag = i;

12081130 }

1209− free(nullary_cons);

12101131}

12111132

12121133int __idris_argc;

rts/idris_rts.h+196−106

@@ -1,21 +1,19 @@

11#ifndef _IDRISRTS_H

22#define _IDRISRTS_H

4+#include <assert.h>

45#include <stdlib.h>

56#include <stdio.h>

7+#ifdef HAS_PTHREAD

68#include <string.h>

79#include <stdarg.h>

8−#ifdef HAS_PTHREAD

910#include <pthread.h>

1011#endif

11−#include <stdint.h>

12−#if defined(__linux__) || defined(__APPLE__) || defined(__FreeBSD__) || defined(__DragonFly__)

13−#include <signal.h>

14−#endif

1512

1613#include "idris_heap.h"

1714#include "idris_stats.h"

1815

16+

1917#ifndef EXIT_SUCCESS

2018#define EXIT_SUCCESS 0

2119#endif

@@ -25,68 +23,113 @@

2523

2624// Closures

2725typedef enum {

28− CT_CON, CT_ARRAY, CT_INT, CT_BIGINT, CT_FLOAT, CT_STRING, CT_STROFFSET,

29− CT_BITS8, CT_BITS16, CT_BITS32, CT_BITS64, CT_UNIT, CT_PTR, CT_REF,

30− CT_FWD, CT_MANAGEDPTR, CT_RAWDATA, CT_CDATA

26+ CT_CON, CT_ARRAY, CT_INT, CT_BIGINT,

27+ CT_FLOAT, CT_STRING, CT_STROFFSET, CT_BITS8,

28+ CT_BITS16, CT_BITS32, CT_BITS64, CT_PTR,

29+ CT_REF, CT_FWD, CT_MANAGEDPTR, CT_RAWDATA,

30+ CT_CDATA

3131} ClosureType;

3232

33−typedef struct Closure *VAL;

34−

35−// A constructor, consisting of a tag, an arity (16 bits each of the

36−// tag_arity field) and arguments

37−typedef struct {

38− uint32_t tag_arity;

39− VAL args[];

40−} con;

41−

42−// An array; similar to a constructor but with a length, and contents

43−// initialised to NULL (high level Idris programs are responsible for

44−// initialising them properly)

45−typedef struct {

46− uint32_t length;

47− VAL content[];

48−} array;

49−

50−typedef struct {

51− VAL str;

33+typedef struct Hdr {

34+ uint8_t ty;

35+ uint8_t u8;

36+ uint16_t u16;

37+ uint32_t sz;

38+} Hdr;

39+

40+typedef struct Val {

41+ Hdr hdr;

42+} Val;

43+

44+typedef struct Val * VAL;

45+

46+typedef struct Con {

47+ Hdr hdr;

48+ uint32_t tag;

49+ VAL args[0];

50+} Con;

51+

52+typedef struct Array {

53+ Hdr hdr;

54+ VAL array[0];

55+} Array;

56+

57+typedef struct Int {

58+ Hdr hdr;

59+ int i;

60+} Int;

61+

62+typedef struct BigInt {

63+ Hdr hdr;

64+ char big[0];

65+} BigInt;

66+

67+typedef struct Float {

68+ Hdr hdr;

69+ double f;

70+} Float;

71+

72+typedef struct String {

73+ Hdr hdr;

74+ size_t slen;

75+ char str[0];

76+} String;

77+

78+typedef struct StrOffset {

79+ Hdr hdr;

80+ String * base;

5281 size_t offset;

5382} StrOffset;

5483

55−typedef struct {

56− char* str;

57− size_t len; // Cached strlen (we do 'strlen' a lot)

58−} String;

59−

60−// A foreign pointer, managed by the idris GC

61−typedef struct {

62− size_t size;

63− void* data;

84+typedef struct Bits8 {

85+ Hdr hdr;

86+ uint8_t bits8;

87+} Bits8;

88+

89+typedef struct Bits16 {

90+ Hdr hdr;

91+ uint16_t bits16;

92+} Bits16;

93+

94+typedef struct Bits32 {

95+ Hdr hdr;

96+ uint32_t bits32;

97+} Bits32;

98+

99+typedef struct Bits64 {

100+ Hdr hdr;

101+ uint64_t bits64;

102+} Bits64;

103+

104+typedef struct Ptr {

105+ Hdr hdr;

106+ void * ptr;

107+} Ptr;

108+

109+typedef struct Ref {

110+ Hdr hdr;

111+ VAL ref;

112+} Ref;

113+

114+typedef struct Fwd {

115+ Hdr hdr;

116+ VAL fwd;

117+} Fwd;

118+

119+typedef struct ManagedPtr {

120+ Hdr hdr;

121+ char mptr[0];

64122} ManagedPtr;

65123

66−typedef struct Closure {

67−// Use top 16 bits of ty for saying which heap value is in

68−// Bottom 16 bits for closure type

69−//

70−// NOTE: ty can not have type ClosureType because ty must be a

71−// uint32_t but enum is platform dependent

72− uint32_t ty;

73− union {

74− con c;

75− array arr;

76− int i;

77− double f;

78− String str;

79− StrOffset* str_offset;

80− void* ptr;

81− uint8_t bits8;

82− uint16_t bits16;

83− uint32_t bits32;

84− uint64_t bits64;

85− ManagedPtr* mptr;

86− CHeapItem* c_heap_item;

87− size_t size;

88− } info;

89−} Closure;

124+typedef struct RawData {

125+ Hdr hdr;

126+ char raw[0];

127+} RawData;

128+

129+typedef struct CDataC {

130+ Hdr hdr;

131+ CHeapItem * item;

132+} CDataC;

90133

91134struct VM;

92135

@@ -190,33 +233,43 @@ typedef void(*func)(VM*, VAL*);

190233// Register access

191234

192235#define RVAL (vm->ret)

193−#define LOC(x) (*(vm->valstack_base + (x)))

194−#define TOP(x) (*(vm->valstack_top + (x)))

236+#define LOC(x) (vm->valstack_base[x])

237+#define TOP(x) (vm->valstack_top[x])

195238#define REG1 (vm->reg1)

196239

197240// Retrieving values

198−#define GETSTR(x) (ISSTR(x) ? (((VAL)(x))->info.str.str) : GETSTROFF(x))

199−#define GETSTRLEN(x) (ISSTR(x) ? (((VAL)(x))->info.str.len) : GETSTROFFLEN(x))

200−#define GETPTR(x) (((VAL)(x))->info.ptr)

201−#define GETMPTR(x) (((VAL)(x))->info.mptr->data)

202−#define GETFLOAT(x) (((VAL)(x))->info.f)

203−#define GETCDATA(x) (((VAL)(x))->info.c_heap_item)

204−

205−#define GETBITS8(x) (((VAL)(x))->info.bits8)

206−#define GETBITS16(x) (((VAL)(x))->info.bits16)

207−#define GETBITS32(x) (((VAL)(x))->info.bits32)

208−#define GETBITS64(x) (((VAL)(x))->info.bits64)

209−

210−#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? (x)->info.c.tag_arity >> 8 : (-1)) )

211−#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? (x)->info.c.tag_arity & 0x000000ff : (-1)) )

241+static inline char * getstr(String * x) {

242+ // hdr.u8 used to mark a null string

243+ return x->hdr.u8? NULL : x->str;

244+}

245+

246+static inline size_t getstrlen(String * x) {

247+ return x->slen;

248+}

249+

250+#define GETSTR(x) (ISSTR(x) ? getstr((String*)(x)) : GETSTROFF(x))

251+#define GETSTRLEN(x) (ISSTR(x) ? getstrlen((String*)(x)) : GETSTROFFLEN(x))

252+#define GETPTR(x) (((Ptr*)(x))->ptr)

253+#define GETMPTR(x) (((ManagedPtr*)(x))->mptr)

254+#define GETFLOAT(x) (((Float*)(x))->f)

255+#define GETCDATA(x) (((CDataC*)(x))->item)

256+

257+#define GETBITS8(x) (((Bits8*)(x))->bits8)

258+#define GETBITS16(x) (((Bits16*)(x))->bits16)

259+#define GETBITS32(x) (((Bits32*)(x))->bits32)

260+#define GETBITS64(x) (((Bits64*)(x))->bits64)

212261

213262// Already checked it's a CT_CON

214−#define CTAG(x) (((x)->info.c.tag_arity) >> 8)

215−#define CARITY(x) ((x)->info.c.tag_arity & 0x000000ff)

263+#define CTAG(x) (((Con*)(x))->tag)

264+#define CARITY(x) (((Con*)(x))->hdr.u16) // hdr.u16 used to store arity

216265

266+#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CTAG((Con*)x) : (-1)) )

267+#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CARITY((Con*)x) : (-1)) )

217268

218−#define GETTY(x) ((x)->ty)

219−#define SETTY(x,t) ((x)->ty = t)

269+#define CELEM(x) (((x)->hdr.sz - sizeof(Array)) / sizeof(VAL))

270+

271+#define GETTY(x) ((ClosureType)((x)->hdr.ty))

272+#define SETTY(x,t) ((x)->hdr.ty = t)

220273

221274// Integers, floats and operators

222275

@@ -241,15 +294,17 @@ typedef intptr_t i_int;

241294#ifdef IDRIS_TRACE

242295#define TRACE idris_trace(vm, __FUNCTION__, __LINE__);

243296#else

244−#define TRACE

297+#define TRACE

245298#endif

246299

247300#define INITFRAME TRACE\

248301 __attribute__((unused)) VAL* myoldbase

249302

250303#define REBASE vm->valstack_base = oldbase

251−#define RESERVE(x) if (vm->valstack_top+(x) > vm->stack_max) { stackOverflow(); } \

252− else { memset(vm->valstack_top, 0, (x)*sizeof(VAL)); }

304+#define RESERVE(x) do { \

305+ if (vm->valstack_top+(x) > vm->stack_max) { stackOverflow(); } \

306+ else { memset(vm->valstack_top, 0, (x)*sizeof(VAL)); } \

307+ } while(0)

253308#define ADDTOP(x) vm->valstack_top += (x)

254309#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (x)

255310#define BASETOP(x) vm->valstack_base = vm->valstack_top + (x)

@@ -260,6 +315,7 @@ typedef intptr_t i_int;

260315// Creating new values (each value placed at the top of the stack)

261316VAL MKFLOAT(VM* vm, double val);

262317VAL MKSTR(VM* vm, const char* str);

318+VAL MKSTRlen(VM* vm, const char* str, size_t size);

263319VAL MKPTR(VM* vm, void* ptr);

264320VAL MKMPTR(VM* vm, void* ptr, size_t size);

265321VAL MKB8(VM* vm, uint8_t b);

@@ -270,9 +326,9 @@ VAL MKCDATA(VM* vm, CHeapItem * item);

270326

271327// following versions don't take a lock when allocating

272328VAL MKFLOATc(VM* vm, double val);

273−VAL MKSTROFFc(VM* vm, StrOffset* off);

329+VAL MKSTROFFc(VM* vm, VAL basestr);

274330VAL MKSTRc(VM* vm, char* str);

275−VAL MKSTRclen(VM* vm, char* str, int len);

331+VAL MKSTRclen(VM* vm, char* str, size_t len);

276332VAL MKPTRc(VM* vm, void* ptr);

277333VAL MKMPTRc(VM* vm, void* ptr, size_t size);

278334VAL MKCDATAc(VM* vm, CHeapItem * item);

@@ -280,15 +336,16 @@ VAL MKCDATAc(VM* vm, CHeapItem * item);

280336char* GETSTROFF(VAL stroff);

281337size_t GETSTROFFLEN(VAL stroff);

282338

283−// #define SETTAG(x, a) (x)->info.c.tag = (a)

284−#define SETARG(x, i, a) ((x)->info.c.args)[i] = ((VAL)(a))

285−#define GETARG(x, i) ((x)->info.c.args)[i]

339+#define SETARG(x, i, a) (((Con*)(x))->args)[i] = ((VAL)(a))

340+#define GETARG(x, i) (((Con*)(x))->args[i])

286341

287342#define PROJECT(vm,r,loc,num) \

288− memcpy(&(LOC(loc)), &((r)->info.c.args), sizeof(VAL)*num)

343+ memcpy(&(LOC(loc)), ((Con*)(r))->args, sizeof(VAL)*num)

289344#define SLIDE(vm, args) \

290345 memcpy(&(LOC(0)), &(TOP(0)), sizeof(VAL)*args)

291346

347+void* iallocate(VM *, size_t, int);

348+

292349void* allocate(size_t size, int outerlock);

293350// void* allocCon(VM* vm, int arity, int outerlock);

294351

@@ -298,8 +355,8 @@ void* allocate(size_t size, int outerlock);

298355// idris_doneAlloc *must* be called when allocation from C is done (as it

299356// may take a lock if other threads are running).

300357

301−void idris_requireAlloc(size_t size);

302−void idris_doneAlloc(void);

358+void idris_requireAlloc(VM *, size_t size);

359+void idris_doneAlloc(VM *);

303360

304361// public interface to allocation (note that this may move other pointers

305362// if allocating beyond the limits given by idris_requireAlloc!)

@@ -308,29 +365,44 @@ void* idris_alloc(size_t size);

308365void* idris_realloc(void* old, size_t old_size, size_t size);

309366void idris_free(void* ptr, size_t size);

310367

311−#define allocCon(cl, vm, t, a, o) \

312− cl = allocate(sizeof(Closure) + sizeof(VAL)*a, o); \

313− SETTY(cl, CT_CON); \

314− cl->info.c.tag_arity = ((t) << 8) | (a);

368+static inline void updateConF(Con * cl, unsigned tag, unsigned arity) {

369+ SETTY(cl, CT_CON);

370+ cl->tag = tag;

371+ // hdr.u16 used to store arity

372+ cl->hdr.u16 = arity;

373+ assert(cl->hdr.sz == sizeof(*cl) + sizeof(VAL) * arity);

374+ // cl->hdr.sz = sizeof(*cl) + sizeof(VAL) * arity;

375+}

376+

377+static inline Con * allocConF(VM * vm, unsigned tag, unsigned arity, int outer) {

378+ Con * cl = iallocate(vm, sizeof(*cl) + sizeof(VAL) * arity, outer);

379+ SETTY(cl, CT_CON);

380+ cl->tag = tag;

381+ // hdr.u16 used to store arity

382+ cl->hdr.u16 = arity;

383+ return cl;

384+}

385+

386+static inline Array * allocArrayF(VM * vm, size_t len, int outer) {

387+ Array * cl = iallocate(vm, sizeof(*cl) + sizeof(VAL) * len, outer);

388+ SETTY(cl, CT_ARRAY);

389+ return cl;

390+}

391+

392+

393+#define allocCon(cl, vm, t, a, o) (cl) = (VAL)allocConF(vm, t, a, o)

315394

316−#define updateCon(cl, old, t, a) \

317− cl = old; \

318− SETTY(cl, CT_CON); \

319− cl->info.c.tag_arity = ((t) << 8) | (a);

395+#define updateCon(cl, old, tag, arity) (cl) = (old); updateConF(cl, tag, arity)

320396

321−#define NULL_CON(x) nullary_cons[x]

397+#define NULL_CON(x) ((VAL)(nullary_cons + x))

322398

323−#define allocArray(cl, vm, len, o) \

324− cl = allocate(sizeof(Closure) + sizeof(VAL)*len, o); \

325− SETTY(cl, CT_ARRAY); \

326− cl->info.arr.length = len;

399+#define allocArray(cl, vm, len, o) (cl) = (VAL)allocArrayF(vm, len, o)

327400

328401int idris_errno(void);

329402char* idris_showerror(int err);

330403

331−extern VAL* nullary_cons;

404+extern Con nullary_cons[];

332405void init_nullaries(void);

333−void free_nullaries(void);

334406

335407void init_signals(void);

336408

@@ -460,4 +532,22 @@ void stackOverflow(void);

460532

461533#include "idris_gmp.h"

462534

535+static inline size_t valSize(VAL v) {

536+ return v->hdr.sz;

537+}

538+

539+static inline size_t aligned(size_t sz) {

540+ return (sz + sizeof(void*) - 1) & ~(sizeof(void*)-1);

541+}

542+

543+VM* get_vm(void);

544+

463545#endif

546+

547+/*

548+ Local variables: **

549+ c-file-style: "bsd" **

550+ c-basic-offset: 4 **

551+ indent-tabs-mode: nil **

552+ End: **

553+*/

rts/idris_stdfgn.c+1−3

@@ -6,7 +6,6 @@

66#include <fcntl.h>

77#include <errno.h>

88#include <sys/stat.h>

9−#include <stdio.h>

109#include <time.h>

1110#include <dirent.h>

1211#include <unistd.h>

@@ -116,7 +115,7 @@ void* idris_dirOpen(char* dname) {

116115

117116void idris_dirClose(void* h) {

118117 DirInfo* di = (DirInfo*)h;

119−

118+

120119 closedir(di->dirptr);

121120 free(di);

122121}

@@ -260,4 +259,3 @@ VAL idris_getString(VM* vm, void* buffer) {

260259 free(sb);

261260 return str;

262261}

263−

src/IRTS/CodegenC.hs+6−6

@@ -396,7 +396,7 @@ c_irts FFunctionIO l x = error "Return of function from foreign call is not supp

396396irts_c (FArith (ATInt ITNative)) x = "GETINT(" ++ x ++ ")"

397397irts_c (FArith (ATInt ITChar)) x = irts_c (FArith (ATInt ITNative)) x

398398irts_c (FArith (ATInt (ITFixed ity))) x

399− = "(" ++ x ++ "->info.bits" ++ show (nativeTyWidth ity) ++ ")"

399+ = "GETBITS" ++ show (nativeTyWidth ity) ++ "(" ++ x ++ ")"

400400irts_c FString x = "GETSTR(" ++ x ++ ")"

401401irts_c FUnit x = x

402402irts_c FPtr x = "GETPTR(" ++ x ++ ")"

@@ -536,13 +536,13 @@ doOp v (LURem (ITFixed ty)) [x, y] = bitOp v "URem" ty [x, y]

536536doOp v (LSRem (ATInt (ITFixed ty))) [x, y] = bitOp v "SRem" ty [x, y]

537537

538538doOp v (LSExt (ITFixed from) ITBig) [x]

539− = v ++ "MKBIGSI(vm, (" ++ signedTy from ++ ")" ++ creg x ++ "->info.bits" ++ show (nativeTyWidth from) ++ ")"

539+ = v ++ "MKBIGSI(vm, (" ++ signedTy from ++ ") GETBITS" ++ show (nativeTyWidth from) ++ "(" ++ creg x ++ "))"

540540doOp v (LSExt ITNative (ITFixed to)) [x]

541541 = v ++ "idris_b" ++ show (nativeTyWidth to) ++ "const(vm, GETINT(" ++ creg x ++ "))"

542542doOp v (LSExt ITChar (ITFixed to)) [x]

543543 = doOp v (LSExt ITNative (ITFixed to)) [x]

544544doOp v (LSExt (ITFixed from) ITNative) [x]

545− = v ++ "MKINT((i_int)((" ++ signedTy from ++ ")" ++ creg x ++ "->info.bits" ++ show (nativeTyWidth from) ++ "))"

545+ = v ++ "MKINT((i_int)((" ++ signedTy from ++ ") GETBITS" ++ show (nativeTyWidth from) ++ "(" ++ creg x ++ ")))"

546546doOp v (LSExt (ITFixed from) ITChar) [x]

547547 = doOp v (LSExt (ITFixed from) ITNative) [x]

548548doOp v (LSExt (ITFixed from) (ITFixed to)) [x]

@@ -552,11 +552,11 @@ doOp v (LZExt ITNative (ITFixed to)) [x]

552552doOp v (LZExt ITChar (ITFixed to)) [x]

553553 = doOp v (LZExt ITNative (ITFixed to)) [x]

554554doOp v (LZExt (ITFixed from) ITNative) [x]

555− = v ++ "MKINT((i_int)" ++ creg x ++ "->info.bits" ++ show (nativeTyWidth from) ++ ")"

555+ = v ++ "MKINT((i_int)GETBITS" ++ show (nativeTyWidth from) ++ "(" ++ creg x ++ "))"

556556doOp v (LZExt (ITFixed from) ITChar) [x]

557557 = doOp v (LZExt (ITFixed from) ITNative) [x]

558558doOp v (LZExt (ITFixed from) ITBig) [x]

559− = v ++ "MKBIGUI(vm, " ++ creg x ++ "->info.bits" ++ show (nativeTyWidth from) ++ ")"

559+ = v ++ "MKBIGUI(vm, GETBITS" ++ show (nativeTyWidth from) ++ "(" ++ creg x ++ "))"

560560doOp v (LZExt ITNative ITBig) [x]

561561 = v ++ "MKBIGUI(vm, (uintptr_t)GETINT(" ++ creg x ++ "))"

562562doOp v (LZExt (ITFixed from) (ITFixed to)) [x]

@@ -566,7 +566,7 @@ doOp v (LTrunc ITNative (ITFixed to)) [x]

566566doOp v (LTrunc ITChar (ITFixed to)) [x]

567567 = doOp v (LTrunc ITNative (ITFixed to)) [x]

568568doOp v (LTrunc (ITFixed from) ITNative) [x]

569− = v ++ "MKINT((i_int)" ++ creg x ++ "->info.bits" ++ show (nativeTyWidth from) ++ ")"

569+ = v ++ "MKINT((i_int)GETBITS" ++ show (nativeTyWidth from) ++ "(" ++ creg x ++ "))"

570570doOp v (LTrunc (ITFixed from) ITChar) [x]

571571 = doOp v (LTrunc (ITFixed from) ITNative) [x]

572572doOp v (LTrunc ITBig (ITFixed IT64)) [x]

src/IRTS/System.hs+7−1

@@ -61,7 +61,13 @@ overrideIdrisSubDirWith fp envVar = do

6161 Just ddir -> return ddir

6262

6363getCC :: IO String

64−getCC = fromMaybe "gcc" <$> lookupEnv "IDRIS_CC"

64+getCC = fromMaybe cc <$> lookupEnv "IDRIS_CC"

65+ where

66+#ifdef mingw32_HOST_OS

67+ cc = "gcc"

68+#else

69+ cc = "cc"

70+#endif

6571

6672getEnvFlags :: IO [String]

6773getEnvFlags = maybe [] (splitOn " ") <$> lookupEnv "IDRIS_CFLAGS"

stack-shell.nix+1−1

@@ -18,5 +18,5 @@ in haskell.lib.buildStackProject {

1818 nativeBuildInputs = native_libs;

1919 buildInputs = libs;

2020 name = "idrisBuildEnv";

21− src = ./.;

21+ src = if lib.inNixShell then null else ./.;

2222}

test/base001/Makefile+2−2

@@ -2,10 +2,10 @@

22all: exit1 sys.o

44exit1:

5− @gcc -Wall -o exit1 exit1.c

5+ @$(CC) -Wall -o exit1 exit1.c

77sys.o:

8− @gcc -Wall -c sys.c

8+ @$(CC) -Wall -c sys.c

1010clean:

1111 -@rm exit1 sys.o