6112570 · Idris-dev · git.iko.soy

.gitignore+1

compare with master

unifiedsplit

@@ -27,6 +27,7 @@ libs/contrib/contrib_doc/

27test/output

28test/*[0-9][0-9][0-9]/output

29test/*[0-9][0-9][0-9]/*.exe

30+test/runtest.exe

30tags

31tags

31TAGS

32TAGS

32src/Version_idris.hs

33src/Version_idris.hs

CHANGELOG+26−2

@@ -1,5 +1,29 @@

1−New in 0.9.21:

1+New in 0.11:

2−==============

2+============

3+

4+Updated export rules

5+--------------------

6+

7+* The export rules are:

8+ - 'private' means that the definition is not exported at all

9+ - 'export' means that the top level type is exported, but not the

10+ definition. In the case of 'data', this means the type constructor is

11+ exported but not the data constructors.

12+ - 'public export' means that the entire definition is exported.

13+* By default, names are 'private'. This can be altered with an %access

14+ directive as before.

15+* Exported types can only refer to other exported names

16+* Publicly exported definitions can only refer to publicly exported names

17+

18+Minor language changes

19+----------------------

20+

21+* The '[static]' annotation is changed to '%static' to be consistent with the

22+other annotations.

23+

24+

25+New in 0.10:

26+============

3

27

4* 'class' and 'instance' are now deprecated keywords. They have been

28* 'class' and 'instance' are now deprecated keywords. They have been

5 replaced by 'interface' and 'implementation' respectively. This is to

29 replaced by 'interface' and 'implementation' respectively. This is to

CONTRIBUTORS+1

@@ -11,6 +11,7 @@ Jakob Brünker

11Alyssa Carter

12David Raymond Christiansen

13Carter Charbonneau

14+Aaron Craelius

14Jason Dagit

15Jason Dagit

15Guglielmo Fachini

16Guglielmo Fachini

16Simon Fowler

17Simon Fowler

INSTALL.md+8−3

@@ -63,9 +63,9 @@ contribute.

63[Stack](https://github.com/commercialhaskell/stack) is a new

64cross-platform program for developing Haskell projects, that enhances

65the functionality provided by Cabal. There is experimental support for

66−building Idris from source using with stack, that uses the LTS 3.16

66+building Idris from source with stack.

67−resolver. This installation has been tested on Ubuntu 14.04.2 LTS,

67+This installation has been tested on Ubuntu 14.04.2 LTS, and the current

68−only.

68+NixOS unstable.

69

70To build Idris with stack the following commands are recommended:

71

@@ -77,6 +77,11 @@ haven't used stack before this will also setup the related

77infrastructure. For more information about Stack please visit the

78[Stack website](https://github.com/commercialhaskell/stack).

79

80+On NixOS, please use the following command instead, to make sure

81+the required libraries and header files are available:

82+

83+* `stack build --nix`

84+

80### System GHC

85### System GHC

81

86

82The flag `--system-ghc` can be added to enforce use of your system's

87The flag `--system-ghc` can be added to enforce use of your system's

Makefile+3−14

@@ -20,24 +20,13 @@ build: dist/setup-config

20test: doc test_c

21

22test_c:

23− $(MAKE) -C test IDRIS=../dist/build/idris

23+ $(MAKE) -C test IDRIS=../dist/build/idris/idris test

24−

25−test_java:

26− $(MAKE) -C test IDRIS=../dist/build/idris test_java

27−

28−test_llvm:

29− $(MAKE) -C test IDRIS=../dist/build/idris test_llvm

30

24

31test_js:

25test_js:

32− $(MAKE) -C test IDRIS=../dist/build/idris test_js

26+ $(MAKE) -C test IDRIS=../dist/build/idris/idris test_js

33−

34−test_all:

35− $(MAKE) test

36− $(MAKE) test_llvm

37− $(MAKE) test_java

38

27

39test_timed:

28test_timed:

40− $(MAKE) -C test IDRIS=../dist/build/idris time

29+ $(MAKE) -C test IDRIS=../dist/build/idris/idris time

41

30

42lib_clean:

31lib_clean:

43 $(MAKE) -C libs IDRIS=../../dist/build/idris/idris RTS=../../dist/build/rts/libidris_rts clean

32 $(MAKE) -C libs IDRIS=../../dist/build/idris/idris RTS=../../dist/build/rts/libidris_rts clean

Setup.hs+20−1

@@ -10,6 +10,7 @@ import Distribution.Simple.LocalBuildInfo as L

10import qualified Distribution.Simple.Setup as S

11import qualified Distribution.Simple.Program as P

12import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, rewriteFile)

13+import Distribution.Compiler

13import Distribution.PackageDescription

14import Distribution.PackageDescription

14import Distribution.Text

15import Distribution.Text

15

16

@@ -45,6 +46,9 @@ mymake = "make"

45make verbosity =

46make verbosity =

46 P.runProgramInvocation verbosity . P.simpleProgramInvocation mymake

47 P.runProgramInvocation verbosity . P.simpleProgramInvocation mymake

47

48

49+#ifdef mingw32_HOST_OS

50+windres verbosity = P.runProgramInvocation verbosity . P.simpleProgramInvocation "windres"

51+#endif

48-- -----------------------------------------------------------------------------

52-- -----------------------------------------------------------------------------

49-- Flags

53-- Flags

50

54

@@ -53,7 +57,7 @@ usesGMP flags =

53 case lookup (FlagName "gmp") (S.configConfigurationsFlags flags) of

57 case lookup (FlagName "gmp") (S.configConfigurationsFlags flags) of

54 Just True -> True

58 Just True -> True

55 Just False -> False

59 Just False -> False

56− Nothing -> True

60+ Nothing -> False

57

61

58execOnly :: S.ConfigFlags -> Bool

62execOnly :: S.ConfigFlags -> Bool

59execOnly flags =

63execOnly flags =

@@ -198,6 +202,20 @@ getVersion args flags = do

198 let buildinfo = (emptyBuildInfo { cppOptions = ["-DVERSION="++hash] }) :: BuildInfo

202 let buildinfo = (emptyBuildInfo { cppOptions = ["-DVERSION="++hash] }) :: BuildInfo

199 return (Just buildinfo, [])

203 return (Just buildinfo, [])

200

204

205+

206+

207+idrisPreBuild args flags = do

208+#ifdef mingw32_HOST_OS

209+ createDirectoryIfMissingVerbose verbosity True dir

210+ windres verbosity ["icons/idris_icon.rc","-o", dir++"idris_icon.o"]

211+ return (Nothing, [("idris", emptyBuildInfo { ldOptions = [dir ++ "idris_icon.o"] })])

212+ where

213+ verbosity = S.fromFlag $ S.buildVerbosity flags

214+ dir = S.fromFlagOrDefault "dist" $ S.buildDistPref flags

215+#else

216+ return (Nothing, [])

217+#endif

218+

201idrisBuild _ flags _ local = unless (execOnly (configFlags local)) $ do

219idrisBuild _ flags _ local = unless (execOnly (configFlags local)) $ do

202 buildStdLib

220 buildStdLib

203 buildRTS

221 buildRTS

@@ -247,6 +265,7 @@ idrisInstall verbosity copy pkg local = unless (execOnly (configFlags local)) $

247main = defaultMainWithHooks $ simpleUserHooks

265main = defaultMainWithHooks $ simpleUserHooks

248 { postClean = idrisClean

266 { postClean = idrisClean

249 , postConf = idrisConfigure

267 , postConf = idrisConfigure

268+ , preBuild = idrisPreBuild

250 , postBuild = idrisBuild

269 , postBuild = idrisBuild

251 , postCopy = \_ flags pkg local ->

270 , postCopy = \_ flags pkg local ->

252 idrisInstall (S.fromFlag $ S.copyVerbosity flags)

271 idrisInstall (S.fromFlag $ S.copyVerbosity flags)

config.mk+4−12

@@ -20,28 +20,20 @@ endif

20MACHINE := $(shell $(CC) -dumpmachine)

21ifneq (, $(findstring darwin, $(MACHINE)))

22 OS :=darwin

23−else

24−ifneq (, $(findstring cygwin, $(MACHINE)))

23+else ifneq (, $(findstring cygwin, $(MACHINE)))

25 OS :=windows

24 OS :=windows

26−else

27−ifneq (, $(findstring mingw, $(MACHINE)))

25+else ifneq (, $(findstring mingw, $(MACHINE)))

28 OS :=windows

26 OS :=windows

29−else

30−ifneq (, $(findstring windows, $(MACHINE)))

27+else ifneq (, $(findstring windows, $(MACHINE)))

31 OS :=windows

28 OS :=windows

32else

29else

33 OS :=unix

30 OS :=unix

34endif

31endif

35−endif

36−endif

37−endif

38

32

39ifeq ($(OS),darwin)

33ifeq ($(OS),darwin)

40 SHLIB_SUFFIX :=.dylib

34 SHLIB_SUFFIX :=.dylib

41−else

42−ifeq ($(OS),windows)

35+else ifeq ($(OS),windows)

43 SHLIB_SUFFIX :=.DLL

36 SHLIB_SUFFIX :=.DLL

44else

37else

45 SHLIB_SUFFIX :=.so

38 SHLIB_SUFFIX :=.so

46endif

39endif

47−endif

docs/conf.py+4−4

@@ -59,9 +59,9 @@ author = u'The Idris Community'

59# built documents.

60#

61# The short X.Y version.

62−version = '0.9.19'

62+version = '0.10.1'

63# The full version, including alpha/beta/rc tags.

64−release = '0.9.19.1'

64+release = '0.10.1'

65

66# The language for content autogenerated by Sphinx. Refer to documentation

67# for a list of supported languages.

@@ -234,9 +234,9 @@ latex_elements = {

234# (source start file, target name, title,

235# author, documentclass [howto, manual, or own class]).

236latex_documents = [

237− ('guides/index', 'idris-guides.tex', u'Idris Tutorial Series', u'The Idris Community', 'manual'),

238− ('reference/index', 'idris-reference.tex', u'The Idris Reference', u'The Idris Community', 'manual'),

239 ('tutorial/index', 'idris-tutorial.tex', u'The Idris Tutorial', u'The Idris Community', 'manual'),

237 ('tutorial/index', 'idris-tutorial.tex', u'The Idris Tutorial', u'The Idris Community', 'manual'),

238+ ('guides/index', 'idris-guides.tex', u'Idris Tutorial Series', u'The Idris Community', 'manual'),

239+# ('reference/index', 'idris-reference.tex', u'The Idris Reference', u'The Idris Community', 'manual'),

240 ('effects/index', 'eff-tutorial.tex', u'The Effects Tutorial', u'The Idris Community', 'manual')

241 ]

242

docs/effects/depeff.rst+1−1

@@ -183,7 +183,7 @@ to support random access files and better reporting of error conditions.

183 writeLine : String -> Eff () [FILE_IO (OpenFile Write)]

184 eof : Eff Bool [FILE_IO (OpenFile Read)]

185

186− instance Handler FileIO IO

186+ Handler FileIO IO where { ... }

187

188In particular, consider the type of ``open``:

189

docs/effects/hangman.rst+1−1

@@ -193,7 +193,7 @@ implementation for ``MysteryRules`` is surprisingly straightforward:

193

194.. code-block:: idris

195

196− instance Handler MysteryRules m where

196+ Handler MysteryRules m where

197 handle (MkG w g got []) Won k = k () (GameWon w)

198 handle (MkG w Z got m) Lost k = k () (GameLost w)

199

docs/effects/impleff.rst+13−13

@@ -93,16 +93,16 @@ Recall that to run an effectful program in ``Eff``, we use one of the

93``run`` family of functions to run the program in a particular

94computation context ``m``. For each effect, therefore, we must explain

95how it is executed in a particular computation context for ``run`` to

96−work in that context. This is achieved with the following type class:

96+work in that context. This is achieved with the following interface:

97

98.. code-block:: idris

99

100− class Handler (e : Effect) (m : Type -> Type) where

100+ interface Handler (e : Effect) (m : Type -> Type) where

101 handle : resource -> (eff : e t resource resource') ->

102 ((x : t) -> resource' x -> m a) -> m a

103

104−We have already seen some instance declarations in the effect

104+We have already seen some implementation declarations in the effect

105−summaries in Section :ref:`sect-simpleff`. An instance of ``Handler e

105+summaries in Section :ref:`sect-simpleff`. An implementation of ``Handler e

106m`` means that the effect declared with signature ``e`` can be run in

107computation context ``m``. The ``handle`` function takes:

108

@@ -123,7 +123,7 @@ in the case of ``Get``, or passes on a new state, in the case of

123

124.. code-block:: idris

125

126− instance Handler State m where

126+ Handler State m where

127 handle st Get k = k st st

128 handle st (Put n) k = k () n

129

@@ -176,7 +176,7 @@ The following listing summarises what is required to define the

176 STATE : Type -> EFFECT

177 STATE t = MkEff t State

178

179− instance Handler State m where

179+ Handler State m where

180 handle st Get k = k st st

181 handle st (Put n) k = k () n

182

@@ -211,13 +211,13 @@ directly.

211 PutCh : Char -> sig StdIO ()

212 GetCh : sig StdIO Char

213

214− instance Handler StdIO IO where

214+ Handler StdIO IO where

215 handle () (PutStr s) k = do putStr s; k () ()

216 handle () GetStr k = do x <- getLine; k x ()

217 handle () (PutCh c) k = do putChar c; k () ()

218 handle () GetCh k = do x <- getChar; k x ()

219

220− instance Handler StdIO (IOExcept a) where

220+ Handler StdIO (IOExcept a) where

221 handle () (PutStr s) k = do ioe_lift $ putStr s; k () ()

222 handle () GetStr k = do x <- ioe_lift $ getLine; k x ()

223 handle () (PutCh c) k = do ioe_lift $ putChar c; k () ()

@@ -241,10 +241,10 @@ error.

241 data Exception : Type -> Effect where

242 Raise : a -> sig (Exception a) b

243

244− instance Handler (Exception a) Maybe where

244+ Handler (Exception a) Maybe where

245 handle _ (Raise e) k = Nothing

246

247− instance Handler (Exception a) List where

247+ Handler (Exception a) List where

248 handle _ (Raise e) k = []

249

250 EXCEPTION : Type -> EFFECT

@@ -265,14 +265,14 @@ value.

265 data Selection : Effect where

266 Select : List a -> sig Selection a

267

268− instance Handler Selection Maybe where

268+ Handler Selection Maybe where

269 handle _ (Select xs) k = tryAll xs where

270 tryAll [] = Nothing

271 tryAll (x :: xs) = case k x () of

272 Nothing => tryAll xs

273 Just v => Just v

274

275− instance Handler Selection List where

275+ Handler Selection List where

276 handle r (Select xs) k = concatMap (\x => k x r) xs

277

278 SELECT : EFFECT

@@ -308,7 +308,7 @@ the equivalent ``Eff`` programs.

308 WriteLine : String -> sig FileIO () (OpenFile Write)

309 EOF : sig FileIO Bool (OpenFile Read)

310

311− instance Handler FileIO IO where

311+ Handler FileIO IO where

312 handle () (Open fname m) k = do h <- openFile fname m

313 if !(validFile h)

314 then k True (FH h)

docs/effects/simpleeff.rst+12−12

@@ -19,9 +19,9 @@ in a module ``Effect.State``

19 putM : y -> Eff () [STATE x] [STATE y]

20 update : (x -> x) -> Eff () [STATE x]

21

22− instance Handler State m

22+ Handler State m where { ... }

23

24−The last line, ``instance Handler State m``, means that the ``STATE``

24+The last line, ``Handler State m where { ... }``, means that the ``STATE``

25effect is usable in any computation context ``m``. That is, a program

26which uses this effect and returns something of type ``a`` can be

27evaluated to something of type ``m a`` using ``run``, for any

@@ -63,8 +63,8 @@ can perform (or at the very least simulate) console I/O:

63 getStr : Eff String [STDIO]

64 getChar : Eff Char [STDIO]

65

66− instance Handler StdIO IO

66+ Handler StdIO IO where { ... }

67− instance Handler StdIO (IOExcept a)

67+ Handler StdIO (IOExcept a) where { ... }

68

69Examples

70--------

@@ -148,11 +148,11 @@ generally:

148

149 raise : a -> Eff b [EXCEPTION a]

150

151− instance Handler (Exception a) Maybe

151+ Handler (Exception a) Maybe where { ... }

152− instance Handler (Exception a) List

152+ Handler (Exception a) List where { ... }

153− instance Handler (Exception a) (Either a)

153+ Handler (Exception a) (Either a) where { ... }

154− instance Handler (Exception a) (IOExcept a)

154+ Handler (Exception a) (IOExcept a) where { ... }

155− instance Show a => Handler (Exception a) IO

155+ Show a => Handler (Exception a) IO where { ... }

156

157Example

158-------

@@ -247,7 +247,7 @@ Random number generation is also implemented by the library, in module

247 rndInt : Integer -> Integer -> Eff Integer [RND]

248 rndFin : (k : Nat) -> Eff (Fin (S k)) [RND]

249

250− instance Handler Random m

250+ Handler Random m where { ... }

251

252Random number generation is considered side-effecting because its

253implementation generally relies on some external source of randomness.

@@ -333,8 +333,8 @@ succeeds:

333

334 select : List a -> Eff a [SELECT]

335

336− instance Handler Selection Maybe

336+ Handler Selection Maybe where { ... }

337− instance Handler Selection List

337+ Handler Selection List where { ... }

338

339Example

340-------

docs/effects/state.rst+6−6

@@ -189,7 +189,7 @@ shown in Listing [introprog].

189 data BTree a = Leaf

190 | Node (BTree a) a (BTree a)

191

192− instance Show a => Show (BTree a) where

192+ Show a => Show (BTree a) where

193 show Leaf = "[]"

194 show (Node l x r) = "[" ++ show l ++ " "

195 ++ show x ++ " "

@@ -231,19 +231,19 @@ here for illustrative purposes):

231 run : Applicative m => {env : Env m xs} -> Eff a xs -> m a

232

233The ``env`` argument is implicit, and initialised automatically where

234−possible using default values given by instances of the following type

234+possible using default values given by implementations of the following

235−class:

235+interface:

236

237.. code-block:: idris

238

239− class Default a where

239+ interface Default a where

240 default : a

241

242−Instances of ``Default`` are defined for all primitive types, and many

242+Implementations of ``Default`` are defined for all primitive types, and many

243library types such as ``List``, ``Vect``, ``Maybe``, pairs, etc.

244However, where no default value exists for a resource type (for

245example, you may want a ``STATE`` type for which there is no

246−``Default`` instance) the resource environment can be given explicitly

246+``Default`` implementation) the resource environment can be given explicitly

247using one of the following functions:

248

249.. code-block:: idris

docs/effects/summary.rst+14−14

@@ -22,11 +22,11 @@ EXCEPTION

22

23 raise : a -> Eff b [EXCEPTION a]

24

25− instance Handler (Exception a) Maybe

25+ Handler (Exception a) Maybe where { ... }

26− instance Handler (Exception a) List

26+ Handler (Exception a) List where { ... }

27− instance Handler (Exception a) (Either a)

27+ Handler (Exception a) (Either a) where { ... }

28− instance Handler (Exception a) (IOExcept a)

28+ Handler (Exception a) (IOExcept a) where { ... }

29− instance Show a => Handler (Exception a) IO

29+ Show a => Handler (Exception a) IO where { ... }

30

31FILE\_IO

32========

@@ -54,7 +54,7 @@ FILE\_IO

54 writeLine : String -> Eff () [FILE_IO (OpenFile Write)]

55 eof : Eff Bool [FILE_IO (OpenFile Read)]

56

57− instance Handler FileIO IO

57+ Handler FileIO IO where { ... }

58

59RND

60===

@@ -73,7 +73,7 @@ RND

73 rndInt : Integer -> Integer -> Eff m Integer [RND]

74 rndFin : (k : Nat) -> Eff m (Fin (S k)) [RND]

75

76− instance Handler Random m

76+ Handler Random m where { ... }

77

78SELECT

79======

@@ -88,8 +88,8 @@ SELECT

88

89 select : List a -> Eff m a [SELECT]

90

91− instance Handler Selection Maybe

91+ Handler Selection Maybe where { ... }

92− instance Handler Selection List

92+ Handler Selection List where { ... }

93

94STATE

95=====

@@ -107,7 +107,7 @@ STATE

107 putM : y -> Eff m () [STATE x] [STATE y]

108 update : (x -> x) -> Eff m () [STATE x]

109

110− instance Handler State m

110+ Handler State m where { ... }

111

112STDIO

113=====

@@ -128,8 +128,8 @@ STDIO

128 getStr : Handler StdIO m => Eff m String [STDIO]

129 getChar : Handler StdIO m => Eff m Char [STDIO]

130

131− instance Handler StdIO IO

131+ Handler StdIO IO where { ... }

132− instance Handler StdIO (IOExcept a)

132+ Handler StdIO (IOExcept a) where { ... }

133

134SYSTEM

135======

@@ -148,5 +148,5 @@ SYSTEM

148 time : Handler System e => Eff e Int [SYSTEM]

149 getEnv : Handler System e => String -> Eff e (Maybe String) [SYSTEM]

150

151− instance Handler System IO

151+ Handler System IO where { ... }

152− instance Handler System (IOExcept a)

152+ Handler System (IOExcept a) where { ... }

docs/faq/faq.rst+1−1

@@ -11,7 +11,7 @@ However, Idris has been designed from the start to emphasise general purpose

11programming rather than theorem proving. As such, it supports interoperability

12with systems libraries and C programs, and language constructs for

13domain specific language implementation. It also includes higher level

14−programming constructs such as type classes and do notation.

14+programming constructs such as interfaces (similar to type classes) and do notation.

15

16Idris supports multiple back ends (C and JavaScript by default, with the

17ability to add more via plugins) and has a reference run time system, written

docs/proofs/patterns.rst+2−2

@@ -181,8 +181,8 @@ For ``plus_commutes_Z_rhs_2``, we now see:

181 --------------------------------------

182 plus_commutes_Z_rhs_2 : S k = S (plus k 0)

183

184−Again, the ``fromInteger 0`` is merely due to ``Nat`` being an instance

184+Again, the ``fromInteger 0`` is merely due to ``Nat`` having an implementation

185−of the ``Num`` typeclass. So we know that ``k = plus k 0``, but how do

185+of the ``Num`` interface. So we know that ``k = plus k 0``, but how do

186we use this to update the goal to ``S k = S k``?

187

188To achieve this, Idris provides a ``replace`` function as part of the

docs/proofs/pluscomm.rst+1−1

@@ -177,7 +177,7 @@ given above as Idris type declarations:

177

178Both of these properties (and many others) are proved for natural number

179addition in the Idris standard library, using ``(+)`` from the ``Num``

180−type class rather than using ``plus`` directly. They have the names

180+interface rather than using ``plus`` directly. They have the names

181``plusCommutative`` and ``plusAssociative`` respectively.

182

183In the remainder of this tutorial, we will explore several different

docs/reference/language-features.rst+2−2

@@ -27,7 +27,7 @@ Core Language Features

27- Heterogeneous equality

28- ``do`` notation

29- Idiom brackets

30−- Type classes, supporting default methods and dependencies between

30+- Interfaces (like type classes), supporting default methods and dependencies between

31 methods

32- ``rewrite`` prf ``in`` expr

33- Metavariables

@@ -46,7 +46,7 @@ Core Language Features

46 using the ``UniqueType`` universe.

47- `Partial

48 evaluation <https://github.com/idris-lang/Idris-dev/wiki/Static-Arguments-and-Partial-Evaluation>`__

49− by ``[static]`` argument annotations.

49+ by ``%static`` argument annotations.

50- Error message reflection

51- Eliminators

52- Label types ``'name``

docs/reference/repl.rst+3

@@ -212,6 +212,9 @@ declarations as well, such as ``data``.

212 Idris> :let x : String; x = "hello"

213 Idris> x

214 "hello" : String

215+ Idris> :let y = 10

216+ Idris> y

217+ 10 : Integer

215 Idris> :let data Foo : Type where Bar : Foo

218 Idris> :let data Foo : Type where Bar : Foo

216 Idris> Bar

219 Idris> Bar

217 Bar : Foo

220 Bar : Foo

docs/tutorial/index.rst+1−1

@@ -21,7 +21,7 @@ The is the Idris Tutorial. It will teach you about programming in the Idris Lang

21 introduction

22 starting

23 typesfuns

24− classes

24+ interfaces

25 modules

26 packages

27 testing

docs/tutorial/classes.rst → docs/tutorial/interfaces.rstrenamed+154−92

@@ -1,8 +1,8 @@

1−.. _sect-classes:

1+.. _sect-interfaces:

2

3−************

3+**********

4−Type Classes

4+Interfaces

5−************

5+**********

6

7We often want to define functions which work across several different

8data types. For example, we would like arithmetic operators to work on

@@ -10,34 +10,33 @@ data types. For example, we would like arithmetic operators to work on

10``==`` to work on the majority of data types. We would like to be able

11to display different types in a uniform way.

12

13−To achieve this, we use a feature which has proved to be effective in

13+To achieve this, we use *interfaces*, which are similar to type classes in

14−Haskell, namely *type classes*. To define a type class, we provide a

14+Haskell or traits in Rust. To define an interface, we provide a collection of

15−collection of overloaded operations which describe the interface for

16−*instances* of that class. A simple example is the ``Show`` type

15+overloadable functions. A simple example is the ``Show``

17−class, which is defined in the prelude and provides an interface for

16+interface, which is defined in the prelude and provides an interface for

18converting values to ``String``:

17converting values to ``String``:

19

18

20.. code-block:: idris

19.. code-block:: idris

21

20

22− class Show a where

21+ interface Show a where

23 show : a -> String

22 show : a -> String

24

23

25This generates a function of the following type (which we call a

24This generates a function of the following type (which we call a

26−*method* of the ``Show`` class):

25+*method* of the ``Show`` interface):

27

26

28.. code-block:: idris

27.. code-block:: idris

29

28

30 show : Show a => a -> String

29 show : Show a => a -> String

31

30

32−We can read this as: “under the constraint that ``a`` is an instance

31+We can read this as: “under the constraint that ``a`` has an implementation

33−of ``Show``, take an input ``a`` and return a ``String``.” An instance

32+of ``Show``, take an input ``a`` and return a ``String``.” An implementation

34−of a class is defined with an ``instance`` declaration, which provides

33+of an interface is defined by giving definitions of the methods of the interface.

35−implementations of the function for a specific type. For example, the

34+For example, the

36−``Show`` instance for ``Nat`` could be defined as:

35+``Show`` implementation for ``Nat`` could be defined as:

37

36

38.. code-block:: idris

37.. code-block:: idris

39

38

40− instance Show Nat where

39+ Show Nat where

41 show Z = "Z"

40 show Z = "Z"

42 show (S k) = "s" ++ show k

41 show (S k) = "s" ++ show k

43

42

@@ -46,18 +45,18 @@ implementations of the function for a specific type. For example, the

46 Idris> show (S (S (S Z)))

45 Idris> show (S (S (S Z)))

47 "sssZ" : String

46 "sssZ" : String

48

47

49−Only one instance of a class can be given for a type — instances may

48+Only one implementation of an interface can be given for a type — implementations may

50−not overlap. Instance declarations can themselves have constraints.

49+not overlap. Implementation declarations can themselves have constraints.

51−To help with resolution, the arguments of an instance must be

50+To help with resolution, the arguments of an implementation must be

52constructors (either data or type constructors), variables or

51constructors (either data or type constructors), variables or

53−constants (i.e. you cannot give an instance for a function). For

52+constants (i.e. you cannot give an implementation for a function). For

54−example, to define a ``Show`` instance for vectors, we need to know

53+example, to define a ``Show`` implementation for vectors, we need to know

55−that there is a ``Show`` instance for the element type, because we are

54+that there is a ``Show`` implementation for the element type, because we are

56going to use it to convert each element to a ``String``:

55going to use it to convert each element to a ``String``:

57

56

58.. code-block:: idris

57.. code-block:: idris

59

58

60− instance Show a => Show (Vect n a) where

59+ Show a => Show (Vect n a) where

61 show xs = "[" ++ show' xs ++ "]" where

60 show xs = "[" ++ show' xs ++ "]" where

62 show' : Vect n a -> String

61 show' : Vect n a -> String

63 show' Nil = ""

62 show' Nil = ""

@@ -67,22 +66,22 @@ going to use it to convert each element to a ``String``:

67Default Definitions

66Default Definitions

68===================

67===================

69

68

70−The library defines an ``Eq`` class which provides an interface for

69+The library defines an ``Eq`` interface which provides methods for

71−comparing values for equality or inequality, with instances for all of

70+comparing values for equality or inequality, with implementations for all of

72the built-in types:

71the built-in types:

73

72

74.. code-block:: idris

73.. code-block:: idris

75

74

76− class Eq a where

75+ interface Eq a where

77 (==) : a -> a -> Bool

76 (==) : a -> a -> Bool

78 (/=) : a -> a -> Bool

77 (/=) : a -> a -> Bool

79

78

80−To declare an instance of a type, we have to give definitions of all

79+To declare an implementation for a type, we have to give definitions of all

81−of the methods. For example, for an instance of ``Eq`` for ``Nat``:

80+of the methods. For example, for an implementation of ``Eq`` for ``Nat``:

82

81

83.. code-block:: idris

82.. code-block:: idris

84

83

85− instance Eq Nat where

84+ Eq Nat where

86 Z == Z = True

85 Z == Z = True

87 (S x) == (S y) = x == y

86 (S x) == (S y) = x == y

88 Z == (S y) = False

87 Z == (S y) = False

@@ -93,28 +92,28 @@ of the methods. For example, for an instance of ``Eq`` for ``Nat``:

93It is hard to imagine many cases where the ``/=`` method will be

92It is hard to imagine many cases where the ``/=`` method will be

94anything other than the negation of the result of applying the ``==``

93anything other than the negation of the result of applying the ``==``

95method. It is therefore convenient to give a default definition for

94method. It is therefore convenient to give a default definition for

96−each method in the class declaration, in terms of the other method:

95+each method in the interface declaration, in terms of the other method:

97

96

98.. code-block:: idris

97.. code-block:: idris

99

98

100− class Eq a where

99+ interface Eq a where

101 (==) : a -> a -> Bool

100 (==) : a -> a -> Bool

102 (/=) : a -> a -> Bool

101 (/=) : a -> a -> Bool

103

102

104 x /= y = not (x == y)

103 x /= y = not (x == y)

105 x == y = not (x /= y)

104 x == y = not (x /= y)

106

105

107−A minimal complete definition of an ``Eq`` instance requires either

106+A minimal complete implementation of ``Eq`` requires either

108``==`` or ``/=`` to be defined, but does not require both. If a method

107``==`` or ``/=`` to be defined, but does not require both. If a method

109definition is missing, and there is a default definition for it, then

108definition is missing, and there is a default definition for it, then

110the default is used instead.

109the default is used instead.

111

110

112−Extending Classes

111+Extending Interfaces

113−=================

112+====================

114

113

115−Classes can also be extended. A logical next step from an equality

114+Interfaces can also be extended. A logical next step from an equality

116relation ``Eq`` is to define an ordering relation ``Ord``. We can

115relation ``Eq`` is to define an ordering relation ``Ord``. We can

117−define an ``Ord`` class which inherits methods from ``Eq`` as well as

116+define an ``Ord`` interface which inherits methods from ``Eq`` as well as

118defining some of its own:

117defining some of its own:

119

118

120.. code-block:: idris

119.. code-block:: idris

@@ -123,7 +122,7 @@ defining some of its own:

123

122

124.. code-block:: idris

123.. code-block:: idris

125

124

126− class Eq a => Ord a where

125+ interface Eq a => Ord a where

127 compare : a -> a -> Ordering

126 compare : a -> a -> Ordering

128

127

129 (<) : a -> a -> Bool

128 (<) : a -> a -> Bool

@@ -133,11 +132,11 @@ defining some of its own:

133 max : a -> a -> a

132 max : a -> a -> a

134 min : a -> a -> a

133 min : a -> a -> a

135

134

136−The ``Ord`` class allows us to compare two values and determine their

135+The ``Ord`` interface allows us to compare two values and determine their

137ordering. Only the ``compare`` method is required; every other method

136ordering. Only the ``compare`` method is required; every other method

138has a default definition. Using this we can write functions such as

137has a default definition. Using this we can write functions such as

139``sort``, a function which sorts a list into increasing order,

138``sort``, a function which sorts a list into increasing order,

140−provided that the element type of the list is in the ``Ord`` class. We

139+provided that the element type of the list is in the ``Ord`` interface. We

141give the constraints on the type variables left of the fat arrow

140give the constraints on the type variables left of the fat arrow

142``=>``, and the function type to the right of the fat arrow:

141``=>``, and the function type to the right of the fat arrow:

143

142

@@ -145,7 +144,7 @@ give the constraints on the type variables left of the fat arrow

145

144

146 sort : Ord a => List a -> List a

145 sort : Ord a => List a -> List a

147

146

148−Functions, classes and instances can have multiple

147+Functions, interfaces and implementations can have multiple

149constraints. Multiple constraints are written in brackets in a comma

148constraints. Multiple constraints are written in brackets in a comma

150separated list, for example:

149separated list, for example:

151

150

@@ -157,16 +156,16 @@ separated list, for example:

157Functors and Applicatives

156Functors and Applicatives

158=========================

157=========================

159

158

160−So far, we have seen single parameter type classes, where the parameter

159+So far, we have seen single parameter interfaces, where the parameter

161−is of type ``Type``. In general, there can be any number (greater than

160+is of type ``Type``. In general, there can be any number of parameters

162−0) of parameters, and the parameters can have *any* type. If the type

161+(even zero), and the parameters can have *any* type. If the type

163of the parameter is not ``Type``, we need to give an explicit type

162of the parameter is not ``Type``, we need to give an explicit type

164−declaration. For example, the ``Functor`` class is defined in the

163+declaration. For example, the ``Functor`` interface is defined in the

165−library:

164+prelude:

166

165

167.. code-block:: idris

166.. code-block:: idris

168

167

169− class Functor (f : Type -> Type) where

168+ interface Functor (f : Type -> Type) where

170 map : (m : a -> b) -> f a -> f b

169 map : (m : a -> b) -> f a -> f b

171

170

172A functor allows a function to be applied across a structure, for

171A functor allows a function to be applied across a structure, for

@@ -174,7 +173,7 @@ example to apply a function to every element in a ``List``:

174

173

175.. code-block:: idris

174.. code-block:: idris

176

175

177− instance Functor List where

176+ Functor List where

178 map f [] = []

177 map f [] = []

179 map f (x::xs) = f x :: map f xs

178 map f (x::xs) = f x :: map f xs

180

179

@@ -190,21 +189,21 @@ abstracts the notion of function application:

190

189

191 infixl 2 <*>

190 infixl 2 <*>

192

191

193− class Functor f => Applicative (f : Type -> Type) where

192+ interface Functor f => Applicative (f : Type -> Type) where

194 pure : a -> f a

193 pure : a -> f a

195 (<*>) : f (a -> b) -> f a -> f b

194 (<*>) : f (a -> b) -> f a -> f b

196

195

197Monads and ``do``-notation

196Monads and ``do``-notation

198==========================

197==========================

199

198

200−The ``Monad`` class allows us to encapsulate binding and computation,

199+The ``Monad`` interface allows us to encapsulate binding and computation,

201and is the basis of ``do``-notation introduced in Section

200and is the basis of ``do``-notation introduced in Section

202:ref:`sect-do`. It extends ``Applicative`` as defined above, and is

201:ref:`sect-do`. It extends ``Applicative`` as defined above, and is

203defined as follows:

202defined as follows:

204

203

205.. code-block:: idris

204.. code-block:: idris

206

205

207− class Applicative m => Monad (m : Type -> Type) where

206+ interface Applicative m => Monad (m : Type -> Type) where

208 (>>=) : m a -> (a -> m b) -> m b

207 (>>=) : m a -> (a -> m b) -> m b

209

208

210Inside a ``do`` block, the following syntactic transformations are

209Inside a ``do`` block, the following syntactic transformations are

@@ -216,12 +215,12 @@ applied:

216

215

217- ``let x = v; e`` becomes ``let x = v in e``

216- ``let x = v; e`` becomes ``let x = v in e``

218

217

219−``IO`` is an instance of ``Monad``, defined using primitive functions.

218+``IO`` has an implementation of ``Monad``, defined using primitive functions.

220−We can also define an instance for ``Maybe``, as follows:

219+We can also define an implementation for ``Maybe``, as follows:

221

220

222.. code-block:: idris

221.. code-block:: idris

223

222

224− instance Monad Maybe where

223+ Monad Maybe where

225 Nothing >>= k = Nothing

224 Nothing >>= k = Nothing

226 (Just x) >>= k = k x

225 (Just x) >>= k = k x

227

226

@@ -242,11 +241,75 @@ are both available, or return ``Nothing`` if one or both are not ("fail fast").

242

241

243::

242::

244

243

245− *classes> m_add (Just 20) (Just 22)

244+ *ifaces> m_add (Just 20) (Just 22)

246 Just 42 : Maybe Int

245 Just 42 : Maybe Int

247− *classes> m_add (Just 20) Nothing

246+ *ifaces> m_add (Just 20) Nothing

248 Nothing : Maybe Int

247 Nothing : Maybe Int

249

248

249+Pattern Matching Bind

250+---------------------

251+

252+Sometimes we want to pattern match immediately on the result of a function

253+in ``do`` notation. For example, let's say we have a function ``readNumber``

254+which reads a number from the console, returning a value of the form

255+``Just x`` if the number is valid, or ``Nothing`` otherwise:

256+

257+.. code-block:: idris

258+

259+ readNumber : IO (Maybe Nat)

260+ readNumber = do

261+ input <- getLine

262+ if all isDigit (unpack input)

263+ then pure (Just (cast input))

264+ else pure Nothing

265+

266+If we then use it to write a function to read two numbers, returning

267+``Nothing`` if neither are valid, then we would like to pattern match

268+on the result of ``readNumber``:

269+

270+.. code-block:: idris

271+

272+ readNumbers : IO (Maybe (Nat, Nat))

273+ readNumbers =

274+ do x <- readNumber

275+ case x of

276+ Nothing => pure Nothing

277+ Just x_ok => do y <- readNumber

278+ case y of

279+ Nothing => pure Nothing

280+ Just y_ok => pure (Just (x_ok, y_ok))

281+

282+If there's a lot of error handling, this could get deeply nested very quickly!

283+So instead, we can combine the bind and the pattern match in one line. For example,

284+we could try pattern matching on values of the form ``Just x_ok``:

285+

286+.. code-block:: idris

287+

288+ readNumbers : IO (Maybe (Nat, Nat))

289+ readNumbers =

290+ do Just x_ok <- readNumber

291+ Just y_ok <- readNumber

292+ pure (Just (x_ok, y_ok))

293+

294+There is still a problem, however, because we've now omitted the case for

295+``Nothing`` so ``readNumbers`` is no longer total! We can add the ``Nothing``

296+case back as follows:

297+

298+.. code-block:: idris

299+

300+ readNumbers : IO (Maybe (Nat, Nat))

301+ readNumbers =

302+ do Just x_ok <- readNumber | Nothing => pure Nothing

303+ Just y_ok <- readNumber | Nothing => pure Nothing

304+ pure (Just (x_ok, y_ok))

305+

306+The effect of this version of ``readNumbers`` is identical to the first (in

307+fact, it is syntactic sugar for it and directly translated back into that form).

308+The first part of each statement (``Just x_ok <-`` and ``Just y_ok <-``) gives

309+the preferred binding - if this matches, execution will continue with the rest

310+of the ``do`` block. The second part gives the alternative bindings, of which

311+there may be more than one.

312+

250``!``-notation

313``!``-notation

251--------------

314--------------

252

315

@@ -296,11 +359,11 @@ Monad comprehensions

296

359

297The list comprehension notation we saw in Section

360The list comprehension notation we saw in Section

298:ref:`sect-more-expr` is more general, and applies to anything which

361:ref:`sect-more-expr` is more general, and applies to anything which

299−is an instance of both ``Monad`` and ``Alternative``:

362+has an implementation of both ``Monad`` and ``Alternative``:

300

363

301.. code-block:: idris

364.. code-block:: idris

302

365

303− class Applicative f => Alternative (f : Type -> Type) where

366+ interface Applicative f => Alternative (f : Type -> Type) where

304 empty : f a

367 empty : f a

305 (<|>) : f a -> f a -> f a

368 (<|>) : f a -> f a -> f a

306

369

@@ -364,19 +427,19 @@ alternative notion of function application, with explicit calls to

364

427

365Rather than having to insert ``m_app`` everywhere there is an

428Rather than having to insert ``m_app`` everywhere there is an

366application, we can use idiom brackets to do the job for us.

429application, we can use idiom brackets to do the job for us.

367−To do this, we can make ``Maybe`` an instance of ``Applicative``

430+To do this, we can give ``Maybe`` an implementation of ``Applicative``

368as follows, where ``<*>`` is defined in the same way as ``m_app``

431as follows, where ``<*>`` is defined in the same way as ``m_app``

369above (this is defined in the Idris library):

432above (this is defined in the Idris library):

370

433

371.. code-block:: idris

434.. code-block:: idris

372

435

373− instance Applicative Maybe where

436+ Applicative Maybe where

374 pure = Just

437 pure = Just

375

438

376 (Just f) <*> (Just a) = Just (f a)

439 (Just f) <*> (Just a) = Just (f a)

377 _ <*> _ = Nothing

440 _ <*> _ = Nothing

378

441

379−Using ``<*>`` we can use this instance as follows, where a function

442+Using ``<*>`` we can use this implementation as follows, where a function

380application ``[| f a1 …an |]`` is translated into ``pure f <*> a1 <*>

443application ``[| f a1 …an |]`` is translated into ``pure f <*> a1 <*>

381… <*> an``:

444… <*> an``:

382

445

@@ -407,8 +470,8 @@ We define a data type ``Eval`` to wrap an evaluator:

407 data Eval : Type -> Type where

470 data Eval : Type -> Type where

408 MkEval : (List (String, Int) -> Maybe a) -> Eval a

471 MkEval : (List (String, Int) -> Maybe a) -> Eval a

409

472

410−Wrapping the evaluator in a data type means we will be able to make it

473+Wrapping the evaluator in a data type means we will be able to provide

411−an instance of a type class later. We begin by defining a function to

474+implementations of interfaces for it later. We begin by defining a function to

412retrieve values from the context during evaluation:

475retrieve values from the context during evaluation:

413

476

414.. code-block:: idris

477.. code-block:: idris

@@ -421,18 +484,18 @@ retrieve values from the context during evaluation:

421 then (Just val)

484 then (Just val)

422 else (fetchVal xs)

485 else (fetchVal xs)

423

486

424−When defining an evaluator for the language, we will be applying

487+When defining an evaluator for the language, we will be applying functions in

425−functions in the context of an ``Eval``, so it is natural to make

488+the context of an ``Eval``, so it is natural to give ``Eval`` an implementation

426−``Eval`` an instance of ``Applicative``. Before ``Eval`` can be an

489+of ``Applicative``. Before ``Eval`` can have an implementation of

427−instance of ``Applicative`` it is necessary to make ``Eval`` an

490+``Applicative`` it is necessary for ``Eval`` to have an implementation of

428−instance of ``Functor``:

491+``Functor``:

429

492

430.. code-block:: idris

493.. code-block:: idris

431

494

432− instance Functor Eval where

495+ Functor Eval where

433 map f (MkEval g) = MkEval (\e => map f (g e))

496 map f (MkEval g) = MkEval (\e => map f (g e))

434

497

435− instance Applicative Eval where

498+ Applicative Eval where

436 pure x = MkEval (\e => Just x)

499 pure x = MkEval (\e => Just x)

437

500

438 (<*>) (MkEval f) (MkEval g) = MkEval (\x => app (f x) (g x)) where

501 (<*>) (MkEval f) (MkEval g) = MkEval (\x => app (f x) (g x)) where

@@ -454,24 +517,24 @@ to handle errors:

454 runEval env e = case eval e of

517 runEval env e = case eval e of

455 MkEval envFn => envFn env

518 MkEval envFn => envFn env

456

519

457−Named Instances

520+Named Implementations

458−===============

521+=====================

459

522

460−It can be desirable to have multiple instances of a type class, for

523+It can be desirable to have multiple implementations of an interface for the

461−example to provide alternative methods for sorting or printing values.

524+same type, for example to provide alternative methods for sorting or printing

462−To achieve this, instances can be *named* as follows:

525+values. To achieve this, implementations can be *named* as follows:

463

526

464.. code-block:: idris

527.. code-block:: idris

465

528

466− instance [myord] Ord Nat where

529+ [myord] Ord Nat where

467 compare Z (S n) = GT

530 compare Z (S n) = GT

468 compare (S n) Z = LT

531 compare (S n) Z = LT

469 compare Z Z = EQ

532 compare Z Z = EQ

470 compare (S x) (S y) = compare @{myord} x y

533 compare (S x) (S y) = compare @{myord} x y

471

534

472−This declares an instance as normal, but with an explicit name,

535+This declares an implementation as normal, but with an explicit name,

473−``myord``. The syntax ``compare @{myord}`` gives an explicit instance to

536+``myord``. The syntax ``compare @{myord}`` gives an explicit implementation to

474−``compare``, otherwise it would use the default instance for ``Nat``. We

537+``compare``, otherwise it would use the default implementation for ``Nat``. We

475can use this, for example, to sort a list of ``Nat`` in reverse.

538can use this, for example, to sort a list of ``Nat`` in reverse.

476Given the following list:

539Given the following list:

477

540

@@ -480,35 +543,34 @@ Given the following list:

480 testList : List Nat

543 testList : List Nat

481 testList = [3,4,1]

544 testList = [3,4,1]

482

545

483−We can sort it using the default ``Ord`` instance, then the named

546+We can sort it using the default ``Ord`` implementation, then the named

484−instance ``myord`` as follows, at the Idris prompt:

547+implementation ``myord`` as follows, at the Idris prompt:

485

548

486::

549::

487

550

488− *named_instance> show (sort testList)

551+ *named_impl> show (sort testList)

489 "[sO, sssO, ssssO]" : String

552 "[sO, sssO, ssssO]" : String

490− *named_instance> show (sort @{myord} testList)

553+ *named_impl> show (sort @{myord} testList)

491 "[ssssO, sssO, sO]" : String

554 "[ssssO, sssO, sO]" : String

492

555

493

556

494Determining Parameters

557Determining Parameters

495======================

558======================

496

559

497−When a class has more than one parameter, it can help resolution if

560+When an interface has more than one parameter, it can help resolution if the

498−the parameters used to resolve the type class are restricted. For

561+parameters used to find an implementation are restricted. For example:

499−example:

500

562

501.. code-block:: idris

563.. code-block:: idris

502

564

503− class Monad m => MonadState s (m : Type -> Type) | m where

565+ interface Monad m => MonadState s (m : Type -> Type) | m where

504 get : m s

566 get : m s

505 put : s -> m ()

567 put : s -> m ()

506

568

507−In this class, only ``m`` needs to be known to resolve this class, and

569+In this interface, only ``m`` needs to be known to find an implementation of

508−``s`` can then be determined from the instance. This is declared with

570+this interface, and ``s`` can then be determined from the implementation. This

509−the ``| m`` after the class declaration. We call ``m`` a *determining

571+is declared with the ``| m`` after the interface declaration. We call ``m`` a

510−parameter* of the ``MonadState`` class, because it is the parameter

572+*determining parameter* of the ``MonadState`` interface, because it is the

511−used to resolve an instance.

573+parameter used to find an implementation.

512

574

513

575

514.. [1] Conor McBride and Ross Paterson. 2008. Applicative programming

576.. [1] Conor McBride and Ross Paterson. 2008. Applicative programming

docs/tutorial/interp.rst+3−3

@@ -285,15 +285,15 @@ program at the Idris interactive environment is:

285Aside: ``cast``

286---------------

287

288−The prelude defines a type class ``Cast`` which allows conversion

288+The prelude defines an interface ``Cast`` which allows conversion

289between types:

290

291.. code-block:: idris

292

293− class Cast from to where

293+ interface Cast from to where

294 cast : from -> to

295

296−It is a *multi-parameter* type class, defining the source type and

296+It is a *multi-parameter* interface, defining the source type and

297object type of the cast. It must be possible for the type checker to

298infer *both* parameters at the point where the cast is applied. There

299are casts defined between all of the primitive types, as far as they

docs/tutorial/modules.rst+4−4

@@ -8,7 +8,7 @@ An Idris program consists of a collection of modules. Each module

8includes an optional ``module`` declaration giving the name of the

9module, a list of ``import`` statements giving the other modules which

10are to be imported, and a collection of declarations and definitions of

11−types, classes and functions. For example, the listing below gives a

11+types, interfaces and functions. For example, the listing below gives a

12module which defines a binary tree type ``BTree`` (in a file

13``Btree.idr``):

14

@@ -78,19 +78,19 @@ Export Modifiers

78By default, all names defined in a module are exported for use by other

79modules. However, it is good practice only to export a minimal interface

80and keep internal details abstract. Idris allows functions, types,

81−and classes to be marked as: ``public``, ``abstract`` or ``private``:

81+and interfaces to be marked as: ``public``, ``abstract`` or ``private``:

82

83- ``public`` means that both the name and definition are exported. For

84 functions, this means that the implementation is exported (which

85 means, for example, it can be used in a dependent type). For data

86 types, this means that the type name and the constructors are

87− exported. For classes, this means that the class name and method

87+ exported. For interfaces, this means that the interface name and method

88 names are exported.

89

90- ``abstract`` means that only the name is exported. For functions,

91 this means that the implementation is not exported. For data types,

92 this means that the type name is exported but not the constructors.

93− For classes, this means that the class name is exported but not the

93+ For interfaces, this means that the interface name is exported but not the

94 method names.

95

96- ``private`` means that neither the name nor the definition is

docs/tutorial/provisional.rst+2−2

@@ -266,12 +266,12 @@ the user and outputs it in binary.

266 x <- getLine

267 print (natToBin (fromInteger (cast x)))

268

269−For this to work, of course, we need a ``Show`` instance for

269+For this to work, of course, we need a ``Show`` implementation for

270``Binary n``:

271

272.. code-block:: idris

273

274− instance Show (Binary n) where

274+ Show (Binary n) where

275 show (BO x) = show x ++ "0"

276 show (BI x) = show x ++ "1"

277 show BEnd = ""

docs/tutorial/syntax.rst+2−2

@@ -168,7 +168,7 @@ declaring:

168 pure : Expr G a -> Expr G a

169 pure = id

170

171−Note that there is no need for these to be part of an instance of

171+Note that there is no need for these to be part of an implementation of

172``Applicative``, since idiom bracket notation translates directly to

173the names ``<*>`` and ``pure``, and ad-hoc type-directed overloading

174is allowed. We can now say:

@@ -179,7 +179,7 @@ is allowed. We can now say:

179 fact = expr (\x => If (Op (==) x (Val 0))

180 (Val 1) (Op (*) [| fact (Op (-) x (Val 1)) |] x))

181

182−With some more ad-hoc overloading and type class instances, and a new

182+With some more ad-hoc overloading and use of interfaces, and a new

183syntax rule, we can even go as far as:

184

185.. code-block:: idris

docs/tutorial/typesfuns.rst+22−22

@@ -61,8 +61,8 @@ answer. For example:

61 True : Bool

62

63All of the usual arithmetic and comparison operators are defined for

64−the primitive types. They are overloaded using type classes, as we

64+the primitive types. They are overloaded using interfaces, as we

65−will discuss in Section :ref:`sect-classes` and can be extended to

65+will discuss in Section :ref:`sect-interfaces` and can be extended to

66work on user defined types. Boolean expressions can be tested with the

67``if...then...else`` construct, for example:

68

@@ -162,7 +162,7 @@ Idris prompt:

162 4 : Nat

163

164Like arithmetic operations, integer literals are also overloaded using

165−type classes, meaning that we can also test the functions as follows:

165+interfaces, meaning that we can also test the functions as follows:

166

167::

168

@@ -475,15 +475,16 @@ Sometimes it is useful to provide types of implicit arguments,

475particularly where there is a dependency ordering, or where the

476implicit arguments themselves have dependencies. For example, we may

477wish to state the types of the implicit arguments in the following

478−definition, which defines a predicate on vectors:

478+definition, which defines a predicate on vectors (this is also defined

479+in ``Data.Vect``, under the name ``Elem``):

479

480

480.. code-block:: idris

481.. code-block:: idris

481

482

482− data Elem : a -> Vect n a -> Type where

483+ data IsElem : a -> Vect n a -> Type where

483− Here : {x:a} -> {xs:Vect n a} -> Elem x (x :: xs)

484+ Here : {x:a} -> {xs:Vect n a} -> IsElem x (x :: xs)

484− There : {x,y:a} -> {xs:Vect n a} -> Elem x xs -> Elem x (y :: xs)

485+ There : {x,y:a} -> {xs:Vect n a} -> IsElem x xs -> IsElem x (y :: xs)

485

486

486−An instance of ``Elem x xs`` states that ``x`` is an element of

487+An instance of ``IsElem x xs`` states that ``x`` is an element of

487``xs``. We can construct such a predicate if the required element is

488``xs``. We can construct such a predicate if the required element is

488``Here``, at the head of the vector, or ``There``, in the tail of the

489``Here``, at the head of the vector, or ``There``, in the tail of the

489vector. For example:

490vector. For example:

@@ -493,7 +494,7 @@ vector. For example:

493 testVec : Vect 4 Int

494 testVec : Vect 4 Int

494 testVec = 3 :: 4 :: 5 :: 6 :: Nil

495 testVec = 3 :: 4 :: 5 :: 6 :: Nil

495

496

496− inVect : Elem 5 testVec

497+ inVect : IsElem 5 testVec

497 inVect = There (There Here)

498 inVect = There (There Here)

498

499

499If the same implicit arguments are being used a lot, it can make a

500If the same implicit arguments are being used a lot, it can make a

@@ -504,9 +505,9 @@ appear within the block:

504.. code-block:: idris

505.. code-block:: idris

505

506

506 using (x:a, y:a, xs:Vect n a)

507 using (x:a, y:a, xs:Vect n a)

507− data Elem : a -> Vect n a -> Type where

508+ data IsElem : a -> Vect n a -> Type where

508− Here : Elem x (x :: xs)

509+ Here : IsElem x (x :: xs)

509− There : Elem x xs -> Elem x (y :: xs)

510+ There : IsElem x xs -> IsElem x (y :: xs)

510

511

511Note: Declaration Order and ``mutual`` blocks

512Note: Declaration Order and ``mutual`` blocks

512~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

513~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

@@ -579,14 +580,14 @@ example for reading and writing files, including:

579 data File -- abstract

580 data File -- abstract

580 data Mode = Read | Write | ReadWrite

581 data Mode = Read | Write | ReadWrite

581

582

582− openFile : String -> Mode -> IO File

583+ openFile : (f : String) -> (m : Mode) -> IO (Either FileError File)

583 closeFile : File -> IO ()

584 closeFile : File -> IO ()

585+

586+ fGetLine : (h : File) -> IO (Either FileError String)

587+ fPutStr : (h : File) -> (str : String) -> IO (Either FileError ())

588+ fEOF : File -> IO Bool

584

589

585− fread : File -> IO String

590+Note that several of these return ``Either``, since they may fail.

586− fwrite : File -> String -> IO ()

587− feof : File -> IO Bool

588−

589− readFile : String -> IO String

590

591

591.. _sect-do:

592.. _sect-do:

592

593

@@ -724,8 +725,7 @@ the vector:

724 *usefultypes> show (map double intVec)

725 *usefultypes> show (map double intVec)

725 "[2, 4, 6, 8, 10]" : String

726 "[2, 4, 6, 8, 10]" : String

726

727

727−You’ll find these examples in ``usefultypes.idr`` in the ``examples/``

728−directory. For more details of the functions available on ``List`` and

728+For more details of the functions available on ``List`` and

729``Vect``, look in the library files:

730

731- ``libs/prelude/Prelude/List.idr``

@@ -997,7 +997,7 @@ syntax:

997 record { a->b->c = val } x

998

999This returns a new record, with the field accessed by the path

1000−``a->b->c`` set to ``x``. The syntax is first class, i.e. ``record {

1000+``a->b->c`` set to ``val``. The syntax is first class, i.e. ``record {

1001a->b->c = val }`` itself has a function type. Symmetrically, the field

1002can also be accessed with the following syntax:

1003

@@ -1045,7 +1045,7 @@ using natural numbers, the new value can be incremented using the

1045.. code-block:: idris

1046

1047 addStudent : Person -> SizedClass n -> SizedClass (S n)

1048− addStudent p c = record { students = p :: students c } c

1048+ addStudent p c = SizedClassInfo (p :: students c) (className c)

1049

1050.. _sect-more-expr:

1051

icons/idris_icon.rcnew file+1

@@ -0,0 +1 @@

1+0 ICON "idris.ico"

idris-tutorial.pdf

Binary file not shown.

idris.cabal+15−8

@@ -1,5 +1,5 @@

1Name: idris

2−Version: 0.9.20.2

2+Version: 0.10

3License: BSD3

4License-file: LICENSE

5Author: Edwin Brady

@@ -18,12 +18,12 @@ Description: Idris is a general purpose language with full dependent types.

18 <http://www.idris-lang.org/documentation>.

19 Features include:

20 .

21− * Full dependent types with dependent pattern matching

21+ * Full, first class, dependent types with dependent pattern matching

22 .

23− * where clauses, with rule, simple case expressions,

23+ * where clauses, with rule, case expressions,

24 pattern matching let and lambda bindings

25 .

26− * Type classes, monad comprehensions

26+ * Interfaces (similar to type classes), monad comprehensions

27 .

28 * do notation, idiom brackets, syntactic conveniences for lists,

29 tuples, dependent pairs

@@ -34,8 +34,6 @@ Description: Idris is a general purpose language with full dependent types.

34 .

35 * Indentation significant syntax, extensible syntax

36 .

37− * Tactic based theorem proving (influenced by Coq)

38− .

39 * Cumulative universes

37 * Cumulative universes

40 .

38 .

41 * Simple foreign function interface (to C)

39 * Simple foreign function interface (to C)

@@ -152,7 +150,7 @@ Extra-source-files:

152 libs/pruviloj/Pruviloj/Internals/*.idr

150 libs/pruviloj/Pruviloj/Internals/*.idr

153

151

154 test/Makefile

152 test/Makefile

155− test/runtest.pl

153+ test/runtest.hs

156 test/reg001/run

154 test/reg001/run

157 test/reg001/*.idr

155 test/reg001/*.idr

158 test/reg001/expected

156 test/reg001/expected

@@ -165,6 +163,9 @@ Extra-source-files:

165 test/reg004/run

163 test/reg004/run

166 test/reg004/*.idr

164 test/reg004/*.idr

167 test/reg004/expected

165 test/reg004/expected

166+ test/reg005/run

167+ test/reg005/*.idr

168+ test/reg005/expected

168 test/reg006/run

169 test/reg006/run

169 test/reg006/*.idr

170 test/reg006/*.idr

170 test/reg006/expected

171 test/reg006/expected

@@ -790,6 +791,9 @@ Extra-source-files:

790 benchmarks/trivial/sortvec.idr

791 benchmarks/trivial/sortvec.idr

791 benchmarks/trivial/sortvec.ipkg

792 benchmarks/trivial/sortvec.ipkg

792

793

794+ icons/idris_icon.rc

795+ icons/idris.ico

796+

793source-repository head

797source-repository head

794 type: git

798 type: git

795 location: git://github.com/idris-lang/Idris-dev.git

799 location: git://github.com/idris-lang/Idris-dev.git

@@ -962,7 +966,7 @@ Library

962 , haskeline >= 0.7 && < 0.8

966 , haskeline >= 0.7 && < 0.8

963 , mtl >= 2.1 && < 2.3

967 , mtl >= 2.1 && < 2.3

964 , network < 2.7

968 , network < 2.7

965− , optparse-applicative >= 0.11 && < 0.12

969+ , optparse-applicative >= 0.11 && < 0.13

966 , parsers >= 0.9 && < 0.13

970 , parsers >= 0.9 && < 0.13

967 , pretty < 1.2

971 , pretty < 1.2

968 , process < 1.3

972 , process < 1.3

@@ -979,6 +983,9 @@ Library

979 , vector-binary-instances < 0.3

983 , vector-binary-instances < 0.3

980 , zip-archive > 0.2.3.5 && < 0.2.4

984 , zip-archive > 0.2.3.5 && < 0.2.4

981 , safe

985 , safe

986+ , fsnotify < 2.2

987+ , async < 2.1

988+

982 -- zlib >= 0.6.1 is broken with GHC < 7.10.3

989 -- zlib >= 0.6.1 is broken with GHC < 7.10.3

983 if impl(ghc < 7.10.3)

990 if impl(ghc < 7.10.3)

984 build-depends: zlib < 0.6.1

991 build-depends: zlib < 0.6.1

libs/base/Control/Arrow.idr+1−1

@@ -3,7 +3,7 @@ module Control.Arrow

3import Data.Morphisms

4import Control.Category

5

6−%access public

6+%access public export

7

8infixr 5 <++>

9infixr 3 ***

libs/base/Control/Catchable.idr+2

@@ -2,6 +2,8 @@ module Control.Catchable

2

3import Control.IOExcept

4

5+%access public export

6+

5interface Catchable (m : Type -> Type) t where

7interface Catchable (m : Type -> Type) t where

6 throw : t -> m a

8 throw : t -> m a

7 catch : m a -> (t -> m a) -> m a

9 catch : m a -> (t -> m a) -> m a

libs/base/Control/Category.idr+1−1

@@ -2,7 +2,7 @@ module Control.Category

2

3import Data.Morphisms

4

5−%access public

5+%access public export

6

7interface Category (cat : Type -> Type -> Type) where

8 id : cat a a

libs/base/Control/IOExcept.idr+13−8

@@ -1,26 +1,31 @@

1module Control.IOExcept

2

3+%access public export

4+

3-- An IO monad with exception handling

5-- An IO monad with exception handling

4

6

5−record IOExcept err a where

7+record IOExcept' (f:FFI) err a where

6 constructor IOM

8 constructor IOM

7− runIOExcept : IO (Either err a)

9+ runIOExcept : IO' f (Either err a)

8

10

9−implementation Functor (IOExcept e) where

11+Functor (IOExcept' f e) where

10 map f (IOM fn) = IOM (map (map f) fn)

12 map f (IOM fn) = IOM (map (map f) fn)

11

13

12−implementation Applicative (IOExcept e) where

14+Applicative (IOExcept' f e) where

13 pure x = IOM (pure (pure x))

15 pure x = IOM (pure (pure x))

14 (IOM f) <*> (IOM a) = IOM [| f <*> a |]

16 (IOM f) <*> (IOM a) = IOM [| f <*> a |]

15

17

16−implementation Monad (IOExcept e) where

18+Monad (IOExcept' f e) where

17 (IOM x) >>= f = IOM $ x >>= either (pure . Left) (runIOExcept . f)

19 (IOM x) >>= f = IOM $ x >>= either (pure . Left) (runIOExcept . f)

18

20

19−ioe_lift : IO a -> IOExcept err a

21+ioe_lift : IO' f a -> IOExcept' f err a

20ioe_lift op = IOM $ map Right op

22ioe_lift op = IOM $ map Right op

21

23

22−ioe_fail : err -> IOExcept err a

24+ioe_fail : err -> IOExcept' f err a

23ioe_fail e = IOM $ pure (Left e)

25ioe_fail e = IOM $ pure (Left e)

24

26

25−ioe_run : IOExcept err a -> (err -> IO b) -> (a -> IO b) -> IO b

27+ioe_run : IOExcept' f err a -> (err -> IO' f b) -> (a -> IO' f b) -> IO' f b

26ioe_run (IOM act) err ok = either err ok !act

28ioe_run (IOM act) err ok = either err ok !act

29+

30+IOExcept : Type -> Type -> Type

31+IOExcept = IOExcept' FFI_C

libs/base/Control/Isomorphism.idr+1

@@ -4,6 +4,7 @@ import Syntax.PreorderReasoning

4import Data.Fin

5

6%default total

7+%access public export

7

8

8||| An isomorphism between two types

9||| An isomorphism between two types

9data Iso : Type -> Type -> Type where

10data Iso : Type -> Type -> Type where

libs/base/Control/Monad/Identity.idr+3−1

@@ -1,6 +1,8 @@

1module Control.Monad.Identity

2

3+%access public export

4+

3−public record Identity (a : Type) where

5+public export record Identity (a : Type) where

4 constructor Id

6 constructor Id

5 runIdentity : a

7 runIdentity : a

6

8

libs/base/Control/Monad/RWS.idr+1−1

@@ -5,7 +5,7 @@ import Control.Monad.State

5import Control.Monad.Writer

6import Control.Monad.Reader

7

8−%access public

8+%access public export

9

10||| A combination of the Reader, Writer, and State monads

11interface (Monoid w, MonadReader r m, MonadWriter w m, MonadState s m) => MonadRWS r w s (m : Type -> Type) where {}

libs/base/Control/Monad/Reader.idr+1−1

@@ -4,7 +4,7 @@ import Builtins

4import Control.Monad.Identity

5import Control.Monad.Trans

6

7−%access public

7+%access public export

8

9||| A monad representing a computation that runs in an immutable context

10interface Monad m => MonadReader r (m : Type -> Type) where

libs/base/Control/Monad/State.idr+1−1

@@ -3,7 +3,7 @@ module Control.Monad.State

3import public Control.Monad.Identity

4import public Control.Monad.Trans

5

6−%access public

6+%access public export

7

8||| A computation which runs in a context and produces an output

9interface Monad m => MonadState s (m : Type -> Type) | m where

libs/base/Control/Monad/Trans.idr+2

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

1module Control.Monad.Trans

2

3+%access public export

4+

3interface MonadTrans (t : (Type -> Type) -> Type -> Type) where

5interface MonadTrans (t : (Type -> Type) -> Type -> Type) where

4 lift : Monad m => m a -> t m a

6 lift : Monad m => m a -> t m a

libs/base/Control/Monad/Writer.idr+1−1

@@ -4,7 +4,7 @@ import Builtins

4import Control.Monad.Identity

5import Control.Monad.Trans

6

7−%access public

7+%access public export

8

9||| A monad representing a computation that produces a stream of output

10interface (Monoid w, Monad m) => MonadWriter w (m : Type -> Type) where

libs/base/Data/Bits.idr+51−29

@@ -4,6 +4,7 @@ import Data.Fin

4

5%default total

6

7+public export

7nextPow2 : Nat -> Nat

8nextPow2 : Nat -> Nat

8nextPow2 Z = Z

9nextPow2 Z = Z

9nextPow2 (S x) = if (S x) == (2 `power` l2x)

10nextPow2 (S x) = if (S x) == (2 `power` l2x)

@@ -12,9 +13,11 @@ nextPow2 (S x) = if (S x) == (2 `power` l2x)

12 where

13 where

13 l2x = log2NZ (S x) SIsNotZ

14 l2x = log2NZ (S x) SIsNotZ

14

15

16+public export

15nextBytes : Nat -> Nat

17nextBytes : Nat -> Nat

16nextBytes bits = (nextPow2 (divCeilNZ bits 8 SIsNotZ))

18nextBytes bits = (nextPow2 (divCeilNZ bits 8 SIsNotZ))

17

19

20+public export

18machineTy : Nat -> Type

21machineTy : Nat -> Type

19machineTy Z = Bits8

22machineTy Z = Bits8

20machineTy (S Z) = Bits16

23machineTy (S Z) = Bits16

@@ -44,7 +47,7 @@ natToBits {n=n} x with (n)

44getPad : Nat -> machineTy n

47getPad : Nat -> machineTy n

45getPad n = natToBits (minus (bitsUsed (nextBytes n)) n)

48getPad n = natToBits (minus (bitsUsed (nextBytes n)) n)

46

49

47−public

50+public export

48data Bits : Nat -> Type where

51data Bits : Nat -> Type where

49 MkBits : machineTy (nextBytes n) -> Bits n

52 MkBits : machineTy (nextBytes n) -> Bits n

50

53

@@ -89,6 +92,10 @@ pad64' n f x y = prim__lshrB64 (f (prim__shlB64 x pad) y) pad

89 where

92 where

90 pad = getPad {n=3} n

93 pad = getPad {n=3} n

91

94

95+-- TODO: This (and all the other functions along these lings) is public export

96+-- because it is used by public export things. Do they really need to be

97+-- public export, or is export good enough?

98+public export

92shiftLeft' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

99shiftLeft' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

93shiftLeft' {n=n} x c with (nextBytes n)

100shiftLeft' {n=n} x c with (nextBytes n)

94 | Z = pad8' n prim__shlB8 x c

101 | Z = pad8' n prim__shlB8 x c

@@ -96,10 +103,11 @@ shiftLeft' {n=n} x c with (nextBytes n)

96 | S (S Z) = pad32' n prim__shlB32 x c

103 | S (S Z) = pad32' n prim__shlB32 x c

97 | S (S (S _)) = pad64' n prim__shlB64 x c

104 | S (S (S _)) = pad64' n prim__shlB64 x c

98

105

99−public

106+public export

100shiftLeft : Bits n -> Bits n -> Bits n

107shiftLeft : Bits n -> Bits n -> Bits n

101shiftLeft (MkBits x) (MkBits y) = MkBits (shiftLeft' x y)

108shiftLeft (MkBits x) (MkBits y) = MkBits (shiftLeft' x y)

102

109

110+public export

103shiftRightLogical' : machineTy n -> machineTy n -> machineTy n

111shiftRightLogical' : machineTy n -> machineTy n -> machineTy n

104shiftRightLogical' {n=n} x c with (n)

112shiftRightLogical' {n=n} x c with (n)

105 | Z = prim__lshrB8 x c

113 | Z = prim__lshrB8 x c

@@ -107,11 +115,12 @@ shiftRightLogical' {n=n} x c with (n)

107 | S (S Z) = prim__lshrB32 x c

115 | S (S Z) = prim__lshrB32 x c

108 | S (S (S _)) = prim__lshrB64 x c

116 | S (S (S _)) = prim__lshrB64 x c

109

117

110−public

118+public export

111shiftRightLogical : Bits n -> Bits n -> Bits n

119shiftRightLogical : Bits n -> Bits n -> Bits n

112shiftRightLogical {n} (MkBits x) (MkBits y)

120shiftRightLogical {n} (MkBits x) (MkBits y)

113 = MkBits {n} (shiftRightLogical' {n=nextBytes n} x y)

121 = MkBits {n} (shiftRightLogical' {n=nextBytes n} x y)

114

122

123+public export

115shiftRightArithmetic' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

124shiftRightArithmetic' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

116shiftRightArithmetic' {n=n} x c with (nextBytes n)

125shiftRightArithmetic' {n=n} x c with (nextBytes n)

117 | Z = pad8' n prim__ashrB8 x c

126 | Z = pad8' n prim__ashrB8 x c

@@ -119,10 +128,11 @@ shiftRightArithmetic' {n=n} x c with (nextBytes n)

119 | S (S Z) = pad32' n prim__ashrB32 x c

128 | S (S Z) = pad32' n prim__ashrB32 x c

120 | S (S (S _)) = pad64' n prim__ashrB64 x c

129 | S (S (S _)) = pad64' n prim__ashrB64 x c

121

130

122−public

131+public export

123shiftRightArithmetic : Bits n -> Bits n -> Bits n

132shiftRightArithmetic : Bits n -> Bits n -> Bits n

124shiftRightArithmetic (MkBits x) (MkBits y) = MkBits (shiftRightArithmetic' x y)

133shiftRightArithmetic (MkBits x) (MkBits y) = MkBits (shiftRightArithmetic' x y)

125

134

135+public export

126and' : machineTy n -> machineTy n -> machineTy n

136and' : machineTy n -> machineTy n -> machineTy n

127and' {n=n} x y with (n)

137and' {n=n} x y with (n)

128 | Z = prim__andB8 x y

138 | Z = prim__andB8 x y

@@ -130,10 +140,11 @@ and' {n=n} x y with (n)

130 | S (S Z) = prim__andB32 x y

140 | S (S Z) = prim__andB32 x y

131 | S (S (S _)) = prim__andB64 x y

141 | S (S (S _)) = prim__andB64 x y

132

142

133−public

143+public export

134and : Bits n -> Bits n -> Bits n

144and : Bits n -> Bits n -> Bits n

135and {n} (MkBits x) (MkBits y) = MkBits (and' {n=nextBytes n} x y)

145and {n} (MkBits x) (MkBits y) = MkBits (and' {n=nextBytes n} x y)

136

146

147+public export

137or' : machineTy n -> machineTy n -> machineTy n

148or' : machineTy n -> machineTy n -> machineTy n

138or' {n=n} x y with (n)

149or' {n=n} x y with (n)

139 | Z = prim__orB8 x y

150 | Z = prim__orB8 x y

@@ -141,10 +152,11 @@ or' {n=n} x y with (n)

141 | S (S Z) = prim__orB32 x y

152 | S (S Z) = prim__orB32 x y

142 | S (S (S _)) = prim__orB64 x y

153 | S (S (S _)) = prim__orB64 x y

143

154

144−public

155+public export

145or : Bits n -> Bits n -> Bits n

156or : Bits n -> Bits n -> Bits n

146or {n} (MkBits x) (MkBits y) = MkBits (or' {n=nextBytes n} x y)

157or {n} (MkBits x) (MkBits y) = MkBits (or' {n=nextBytes n} x y)

147

158

159+public export

148xor' : machineTy n -> machineTy n -> machineTy n

160xor' : machineTy n -> machineTy n -> machineTy n

149xor' {n=n} x y with (n)

161xor' {n=n} x y with (n)

150 | Z = prim__xorB8 x y

162 | Z = prim__xorB8 x y

@@ -152,10 +164,11 @@ xor' {n=n} x y with (n)

152 | S (S Z) = prim__xorB32 x y

164 | S (S Z) = prim__xorB32 x y

153 | S (S (S _)) = prim__xorB64 x y

165 | S (S (S _)) = prim__xorB64 x y

154

166

155−public

167+public export

156xor : Bits n -> Bits n -> Bits n

168xor : Bits n -> Bits n -> Bits n

157xor {n} (MkBits x) (MkBits y) = MkBits {n} (xor' {n=nextBytes n} x y)

169xor {n} (MkBits x) (MkBits y) = MkBits {n} (xor' {n=nextBytes n} x y)

158

170

171+public export

159plus' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

172plus' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

160plus' {n=n} x y with (nextBytes n)

173plus' {n=n} x y with (nextBytes n)

161 | Z = pad8 n prim__addB8 x y

174 | Z = pad8 n prim__addB8 x y

@@ -163,10 +176,11 @@ plus' {n=n} x y with (nextBytes n)

163 | S (S Z) = pad32 n prim__addB32 x y

176 | S (S Z) = pad32 n prim__addB32 x y

164 | S (S (S _)) = pad64 n prim__addB64 x y

177 | S (S (S _)) = pad64 n prim__addB64 x y

165

178

166−public

179+public export

167plus : Bits n -> Bits n -> Bits n

180plus : Bits n -> Bits n -> Bits n

168plus (MkBits x) (MkBits y) = MkBits (plus' x y)

181plus (MkBits x) (MkBits y) = MkBits (plus' x y)

169

182

183+public export

170minus' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

184minus' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

171minus' {n=n} x y with (nextBytes n)

185minus' {n=n} x y with (nextBytes n)

172 | Z = pad8 n prim__subB8 x y

186 | Z = pad8 n prim__subB8 x y

@@ -174,10 +188,11 @@ minus' {n=n} x y with (nextBytes n)

174 | S (S Z) = pad32 n prim__subB32 x y

188 | S (S Z) = pad32 n prim__subB32 x y

175 | S (S (S _)) = pad64 n prim__subB64 x y

189 | S (S (S _)) = pad64 n prim__subB64 x y

176

190

177−public

191+public export

178minus : Bits n -> Bits n -> Bits n

192minus : Bits n -> Bits n -> Bits n

179minus (MkBits x) (MkBits y) = MkBits (minus' x y)

193minus (MkBits x) (MkBits y) = MkBits (minus' x y)

180

194

195+public export

181times' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

196times' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

182times' {n=n} x y with (nextBytes n)

197times' {n=n} x y with (nextBytes n)

183 | Z = pad8 n prim__mulB8 x y

198 | Z = pad8 n prim__mulB8 x y

@@ -185,11 +200,12 @@ times' {n=n} x y with (nextBytes n)

185 | S (S Z) = pad32 n prim__mulB32 x y

200 | S (S Z) = pad32 n prim__mulB32 x y

186 | S (S (S _)) = pad64 n prim__mulB64 x y

201 | S (S (S _)) = pad64 n prim__mulB64 x y

187

202

188−public

203+public export

189times : Bits n -> Bits n -> Bits n

204times : Bits n -> Bits n -> Bits n

190times (MkBits x) (MkBits y) = MkBits (times' x y)

205times (MkBits x) (MkBits y) = MkBits (times' x y)

191

206

192partial

207partial

208+public export

193sdiv' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

209sdiv' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

194sdiv' {n=n} x y with (nextBytes n)

210sdiv' {n=n} x y with (nextBytes n)

195 | Z = prim__sdivB8 x y

211 | Z = prim__sdivB8 x y

@@ -197,11 +213,12 @@ sdiv' {n=n} x y with (nextBytes n)

197 | S (S Z) = prim__sdivB32 x y

213 | S (S Z) = prim__sdivB32 x y

198 | S (S (S _)) = prim__sdivB64 x y

214 | S (S (S _)) = prim__sdivB64 x y

199

215

200−public partial

216+public export partial

201sdiv : Bits n -> Bits n -> Bits n

217sdiv : Bits n -> Bits n -> Bits n

202sdiv (MkBits x) (MkBits y) = MkBits (sdiv' x y)

218sdiv (MkBits x) (MkBits y) = MkBits (sdiv' x y)

203

219

204partial

220partial

221+public export

205udiv' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

222udiv' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

206udiv' {n=n} x y with (nextBytes n)

223udiv' {n=n} x y with (nextBytes n)

207 | Z = prim__udivB8 x y

224 | Z = prim__udivB8 x y

@@ -209,11 +226,11 @@ udiv' {n=n} x y with (nextBytes n)

209 | S (S Z) = prim__udivB32 x y

226 | S (S Z) = prim__udivB32 x y

210 | S (S (S _)) = prim__udivB64 x y

227 | S (S (S _)) = prim__udivB64 x y

211

228

212−public partial

229+public export partial

213udiv : Bits n -> Bits n -> Bits n

230udiv : Bits n -> Bits n -> Bits n

214udiv (MkBits x) (MkBits y) = MkBits (udiv' x y)

231udiv (MkBits x) (MkBits y) = MkBits (udiv' x y)

215

232

216−partial

233+public export partial

217srem' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

234srem' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

218srem' {n=n} x y with (nextBytes n)

235srem' {n=n} x y with (nextBytes n)

219 | Z = prim__sremB8 x y

236 | Z = prim__sremB8 x y

@@ -221,11 +238,11 @@ srem' {n=n} x y with (nextBytes n)

221 | S (S Z) = prim__sremB32 x y

238 | S (S Z) = prim__sremB32 x y

222 | S (S (S _)) = prim__sremB64 x y

239 | S (S (S _)) = prim__sremB64 x y

223

240

224−public partial

241+public export partial

225srem : Bits n -> Bits n -> Bits n

242srem : Bits n -> Bits n -> Bits n

226srem (MkBits x) (MkBits y) = MkBits (srem' x y)

243srem (MkBits x) (MkBits y) = MkBits (srem' x y)

227

244

228−partial

245+public export partial

229urem' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

246urem' : machineTy (nextBytes n) -> machineTy (nextBytes n) -> machineTy (nextBytes n)

230urem' {n=n} x y with (nextBytes n)

247urem' {n=n} x y with (nextBytes n)

231 | Z = prim__uremB8 x y

248 | Z = prim__uremB8 x y

@@ -233,7 +250,7 @@ urem' {n=n} x y with (nextBytes n)

233 | S (S Z) = prim__uremB32 x y

250 | S (S Z) = prim__uremB32 x y

234 | S (S (S _)) = prim__uremB64 x y

251 | S (S (S _)) = prim__uremB64 x y

235

252

236−public partial

253+public export partial

237urem : Bits n -> Bits n -> Bits n

254urem : Bits n -> Bits n -> Bits n

238urem (MkBits x) (MkBits y) = MkBits (urem' x y)

255urem (MkBits x) (MkBits y) = MkBits (urem' x y)

239

256

@@ -273,9 +290,11 @@ gt {n=n} x y with (nextBytes n)

273 | S (S Z) = prim__gtB32 x y

290 | S (S Z) = prim__gtB32 x y

274 | S (S (S _)) = prim__gtB64 x y

291 | S (S (S _)) = prim__gtB64 x y

275

292

293+public export

276implementation Eq (Bits n) where

294implementation Eq (Bits n) where

277 (MkBits x) == (MkBits y) = boolOp eq x y

295 (MkBits x) == (MkBits y) = boolOp eq x y

278

296

297+public export

279implementation Ord (Bits n) where

298implementation Ord (Bits n) where

280 (MkBits x) < (MkBits y) = boolOp lt x y

299 (MkBits x) < (MkBits y) = boolOp lt x y

281 (MkBits x) <= (MkBits y) = boolOp lte x y

300 (MkBits x) <= (MkBits y) = boolOp lte x y

@@ -288,6 +307,7 @@ implementation Ord (Bits n) where

288 then EQ

307 then EQ

289 else GT

308 else GT

290

309

310+public export

291complement' : machineTy (nextBytes n) -> machineTy (nextBytes n)

311complement' : machineTy (nextBytes n) -> machineTy (nextBytes n)

292complement' {n=n} x with (nextBytes n)

312complement' {n=n} x with (nextBytes n)

293 | Z = let pad = getPad {n=0} n in

313 | Z = let pad = getPad {n=0} n in

@@ -299,12 +319,12 @@ complement' {n=n} x with (nextBytes n)

299 | S (S (S _)) = let pad = getPad {n=3} n in

319 | S (S (S _)) = let pad = getPad {n=3} n in

300 prim__complB64 (x `prim__shlB64` pad) `prim__lshrB64` pad

320 prim__complB64 (x `prim__shlB64` pad) `prim__lshrB64` pad

301

321

302−public

322+public export

303complement : Bits n -> Bits n

323complement : Bits n -> Bits n

304complement (MkBits x) = MkBits (complement' x)

324complement (MkBits x) = MkBits (complement' x)

305

325

306-- TODO: Prove

326-- TODO: Prove

307−%assert_total -- can't verify coverage of with block

327+public export %assert_total -- can't verify coverage of with block

308zext' : machineTy (nextBytes n) -> machineTy (nextBytes (n+m))

328zext' : machineTy (nextBytes n) -> machineTy (nextBytes (n+m))

309zext' {n=n} {m=m} x with (nextBytes n, nextBytes (n+m))

329zext' {n=n} {m=m} x with (nextBytes n, nextBytes (n+m))

310 | (Z, Z) = believe_me x

330 | (Z, Z) = believe_me x

@@ -318,11 +338,11 @@ zext' {n=n} {m=m} x with (nextBytes n, nextBytes (n+m))

318 | (S (S Z), S (S (S _))) = believe_me (prim__zextB32_B64 (believe_me x))

338 | (S (S Z), S (S (S _))) = believe_me (prim__zextB32_B64 (believe_me x))

319 | (S (S (S _)), S (S (S _))) = believe_me x

339 | (S (S (S _)), S (S (S _))) = believe_me x

320

340

321−public

341+public export

322zeroExtend : Bits n -> Bits (n+m)

342zeroExtend : Bits n -> Bits (n+m)

323zeroExtend (MkBits x) = MkBits (zext' x)

343zeroExtend (MkBits x) = MkBits (zext' x)

324

344

325−%assert_total

345+public export %assert_total

326intToBits' : Integer -> machineTy (nextBytes n)

346intToBits' : Integer -> machineTy (nextBytes n)

327intToBits' {n=n} x with (nextBytes n)

347intToBits' {n=n} x with (nextBytes n)

328 | Z = let pad = getPad {n=0} n in

348 | Z = let pad = getPad {n=0} n in

@@ -334,13 +354,14 @@ intToBits' {n=n} x with (nextBytes n)

334 | S (S (S _)) = let pad = getPad {n=3} n in

354 | S (S (S _)) = let pad = getPad {n=3} n in

335 prim__lshrB64 (prim__shlB64 (prim__truncBigInt_B64 x) pad) pad

355 prim__lshrB64 (prim__shlB64 (prim__truncBigInt_B64 x) pad) pad

336

356

337−public

357+public export

338intToBits : Integer -> Bits n

358intToBits : Integer -> Bits n

339intToBits n = MkBits (intToBits' n)

359intToBits n = MkBits (intToBits' n)

340

360

341implementation Cast Integer (Bits n) where

361implementation Cast Integer (Bits n) where

342 cast = intToBits

362 cast = intToBits

343

363

364+public export

344bitsToInt' : machineTy (nextBytes n) -> Integer

365bitsToInt' : machineTy (nextBytes n) -> Integer

345bitsToInt' {n=n} x with (nextBytes n)

366bitsToInt' {n=n} x with (nextBytes n)

346 | Z = prim__zextB8_BigInt x

367 | Z = prim__zextB8_BigInt x

@@ -348,11 +369,12 @@ bitsToInt' {n=n} x with (nextBytes n)

348 | S (S Z) = prim__zextB32_BigInt x

369 | S (S Z) = prim__zextB32_BigInt x

349 | S (S (S _)) = prim__zextB64_BigInt x

370 | S (S (S _)) = prim__zextB64_BigInt x

350

371

351−public

372+public export

352bitsToInt : Bits n -> Integer

373bitsToInt : Bits n -> Integer

353bitsToInt (MkBits x) = bitsToInt' x

374bitsToInt (MkBits x) = bitsToInt' x

354

375

355-- Zero out the high bits of a truncated bitstring

376-- Zero out the high bits of a truncated bitstring

377+public export

356zeroUnused : machineTy (nextBytes n) -> machineTy (nextBytes n)

378zeroUnused : machineTy (nextBytes n) -> machineTy (nextBytes n)

357zeroUnused {n} x = x `and'` complement' (intToBits' {n=n} 0)

379zeroUnused {n} x = x `and'` complement' (intToBits' {n=n} 0)

358

380

@@ -390,12 +412,12 @@ sext' {n=n} {m=m} x with (nextBytes n, nextBytes (n+m))

390 | (S (S (S _)), S (S (S _))) = let pad = getPad {n=3} n in

412 | (S (S (S _)), S (S (S _))) = let pad = getPad {n=3} n in

391 believe_me (prim__ashrB64 (prim__shlB64 (believe_me x) pad) pad)

413 believe_me (prim__ashrB64 (prim__shlB64 (believe_me x) pad) pad)

392

414

393−--public

415+--public export

394--signExtend : Bits n -> Bits (n+m)

416--signExtend : Bits n -> Bits (n+m)

395--signExtend {m=m} (MkBits x) = MkBits (zeroUnused (sext' x))

417--signExtend {m=m} (MkBits x) = MkBits (zeroUnused (sext' x))

396

418

397-- TODO: Prove

419-- TODO: Prove

398−%assert_total -- can't verify coverage of with block

420+public export %assert_total -- can't verify coverage of with block

399trunc' : machineTy (nextBytes (m+n)) -> machineTy (nextBytes n)

421trunc' : machineTy (nextBytes (m+n)) -> machineTy (nextBytes n)

400trunc' {m=m} {n=n} x with (nextBytes n, nextBytes (m+n))

422trunc' {m=m} {n=n} x with (nextBytes n, nextBytes (m+n))

401 | (Z, Z) = believe_me x

423 | (Z, Z) = believe_me x

@@ -409,23 +431,23 @@ trunc' {m=m} {n=n} x with (nextBytes n, nextBytes (m+n))

409 | (S (S Z), S (S (S _))) = believe_me (prim__truncB64_B32 (believe_me x))

431 | (S (S Z), S (S (S _))) = believe_me (prim__truncB64_B32 (believe_me x))

410 | (S (S (S _)), S (S (S _))) = believe_me x

432 | (S (S (S _)), S (S (S _))) = believe_me x

411

433

412−public

434+public export

413truncate : Bits (m+n) -> Bits n

435truncate : Bits (m+n) -> Bits n

414truncate (MkBits x) = MkBits (zeroUnused (trunc' x))

436truncate (MkBits x) = MkBits (zeroUnused (trunc' x))

415

437

416−public

438+public export

417bitAt : Fin n -> Bits n

439bitAt : Fin n -> Bits n

418bitAt n = intToBits 1 `shiftLeft` intToBits (cast n)

440bitAt n = intToBits 1 `shiftLeft` intToBits (cast n)

419

441

420−public

442+public export

421getBit : Fin n -> Bits n -> Bool

443getBit : Fin n -> Bits n -> Bool

422getBit n x = (x `and` (bitAt n)) /= intToBits 0

444getBit n x = (x `and` (bitAt n)) /= intToBits 0

423

445

424−public

446+public export

425setBit : Fin n -> Bits n -> Bits n

447setBit : Fin n -> Bits n -> Bits n

426setBit n x = x `or` (bitAt n)

448setBit n x = x `or` (bitAt n)

427

449

428−public

450+public export

429unsetBit : Fin n -> Bits n -> Bits n

451unsetBit : Fin n -> Bits n -> Bits n

430unsetBit n x = x `and` complement (bitAt n)

452unsetBit n x = x `and` complement (bitAt n)

431

453

libs/base/Data/Complex.idr+2

@@ -5,6 +5,8 @@

5

6module Data.Complex

7

8+%access public export

9+

8------------------------------ Rectangular form

10------------------------------ Rectangular form

9

11

10infix 6 :+

12infix 6 :+

libs/base/Data/Erased.idr+1−1

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

1module Data.Erased

2

3−%access public

3+%access public export

4%default total

5

6||| The erasure monad.

libs/base/Data/Fin.idr+2−2

@@ -1,7 +1,7 @@

1module Data.Fin

2

3%default total

4−%access public

4+%access public export

5

6||| Numbers strictly less than some bound. The name comes from "finite sets".

7|||

@@ -149,7 +149,7 @@ mkFinIntegerErr lit finSize subErr

149 , TermPart `(Fin ~(getNat finSize))

150 , SubReport subErr

151 ]

152−total

152+total export

153finFromIntegerErrors : Err -> Maybe (List ErrorReportPart)

154finFromIntegerErrors (CantUnify x tm `(IsJust (integerToFin ~(TConst c) ~m)) err xs y)

155 = mkFinIntegerErr (TConst c) m

libs/base/Data/HVect.idr+1−1

@@ -2,7 +2,7 @@ module Data.HVect

2

3import public Data.Vect

4

5−%access public

5+%access public export

6%default total

7

8||| Heterogeneous vectors where the type index gives, element-wise,

libs/base/Data/List.idr+1−1

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

1module Data.List

2

3−%access public

3+%access public export

4

5||| A proof that some element is found in a list.

6|||

libs/base/Data/List/Quantifiers.idr+2

@@ -2,6 +2,8 @@ module Data.List.Quantifiers

2

3import Data.List

4

5+%access public export

6+

5||| A proof that some element of a list satisfies some property

7||| A proof that some element of a list satisfies some property

6|||

8|||

7||| @ P the property to be satsified

9||| @ P the property to be satsified

libs/base/Data/Mod2.idr+5−4

@@ -5,26 +5,27 @@ import Data.Bits

5%default total

6

7||| Integers modulo 2^n

8−public

8+public export

9data Mod2 : Nat -> Type where

10 MkMod2 : {n : Nat} -> Bits n -> Mod2 n

11

12+public export

12modBin : (Bits n -> Bits n -> Bits n) -> Mod2 n -> Mod2 n -> Mod2 n

13modBin : (Bits n -> Bits n -> Bits n) -> Mod2 n -> Mod2 n -> Mod2 n

13modBin f (MkMod2 x) (MkMod2 y) = MkMod2 (f x y)

14modBin f (MkMod2 x) (MkMod2 y) = MkMod2 (f x y)

14

15

15modComp : (Bits n -> Bits n -> a) -> Mod2 n -> Mod2 n -> a

16modComp : (Bits n -> Bits n -> a) -> Mod2 n -> Mod2 n -> a

16modComp f (MkMod2 x) (MkMod2 y) = f x y

17modComp f (MkMod2 x) (MkMod2 y) = f x y

17

18

18−public partial

19+public export partial

19div : Mod2 n -> Mod2 n -> Mod2 n

20div : Mod2 n -> Mod2 n -> Mod2 n

20div = modBin udiv

21div = modBin udiv

21

22

22−public partial

23+public export partial

23rem : Mod2 n -> Mod2 n -> Mod2 n

24rem : Mod2 n -> Mod2 n -> Mod2 n

24rem = modBin urem

25rem = modBin urem

25

26

26%assert_total

27%assert_total

27−public

28+public export

28intToMod : {n : Nat} -> Integer -> Mod2 n

29intToMod : {n : Nat} -> Integer -> Mod2 n

29intToMod {n=n} x = MkMod2 (intToBits x)

30intToMod {n=n} x = MkMod2 (intToBits x)

30

31

libs/base/Data/Morphisms.idr+1−1

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

1module Data.Morphisms

2

3−%access public

3+%access public export

4

5data Morphism : Type -> Type -> Type where

6 Mor : (a -> b) -> Morphism a b

libs/base/Data/So.idr+1

@@ -1,6 +1,7 @@

1module Data.So

2

3%default total

4+%access public export

4

5

5||| Ensure that some run-time Boolean test has been performed.

6||| Ensure that some run-time Boolean test has been performed.

6|||

7|||

libs/base/Data/String.idr+1−1

@@ -1,5 +1,5 @@

1module Data.String

2−%access public

2+%access public export

3

4private

5parseNumWithoutSign : List Char -> Integer -> Maybe Integer

libs/base/Data/Vect.idr+1−1

@@ -3,7 +3,7 @@ module Data.Vect

3import public Data.Fin

4import Language.Reflection

5

6−%access public

6+%access public export

7%default total

8

9infixr 7 ::

libs/base/Data/Vect/Quantifiers.idr+2

@@ -2,6 +2,8 @@ module Data.Vect.Quantifiers

2

3import Data.Vect

4

5+%access public export

6+

5||| A proof that some element of a vector satisfies some property

7||| A proof that some element of a vector satisfies some property

6|||

8|||

7||| @ P the property to be satsified

9||| @ P the property to be satsified

libs/base/Debug/Error.idr+1−1

@@ -7,7 +7,7 @@ import System

7|||

8||| @ loc The source location to display for the error

9||| @ message The error to print

10−partial

10+partial export

11error : {default (%runElab sourceLocation) loc : SourceLocation} ->

12 (message : String) ->

13 a

libs/base/Debug/Trace.idr+1

@@ -3,6 +3,7 @@ module Debug.Trace

3||| Print a message for debugging purposes as a side effect

4||| @ msg what to print

5||| @ result the final result

6+export

6trace : (msg : String) -> (result : a) -> a

7trace : (msg : String) -> (result : a) -> a

7trace x val = unsafePerformIO {ffi=FFI_C} (do putStrLn x; return val)

8trace x val = unsafePerformIO {ffi=FFI_C} (do putStrLn x; return val)

8

9

libs/base/Language/Reflection/Utils.idr+2

@@ -4,6 +4,8 @@ import Language.Reflection

4import Language.Reflection.Elab

5import Language.Reflection.Errors

6

7+%access public export

8+

7--------------------------------------------------------

9--------------------------------------------------------

8-- Tactic construction conveniences

10-- Tactic construction conveniences

9--------------------------------------------------------

11--------------------------------------------------------

libs/base/Syntax/PreorderReasoning.idr+2

@@ -1,5 +1,7 @@

1module Syntax.PreorderReasoning

2

3+%access public export

4+

3-- QED is first to get the precedence to work out. It's just Refl with an explicit argument.

5-- QED is first to get the precedence to work out. It's just Refl with an explicit argument.

4syntax [expr] "QED" = qed expr

6syntax [expr] "QED" = qed expr

5-- foo ={ prf }= bar ={ prf' }= fnord QED

7-- foo ={ prf }= bar ={ prf' }= fnord QED

libs/base/System.idr+1−1

@@ -2,7 +2,7 @@ module System

2

3%include C "unistd.h"

4%default partial

5−%access public

5+%access public export

6

7||| Retrieves a value from the environment if the given key is present,

8||| otherwise it returns Nothing.

libs/base/System/Concurrency/Raw.idr+2

@@ -6,6 +6,8 @@ module System.Concurrency.Raw

6

7import System

8

9+%access export

10+

9||| Send a message of any type to the thread with the given thread id

11||| Send a message of any type to the thread with the given thread id

10||| Returns 1 if the message was sent successfully, 0 otherwise

12||| Returns 1 if the message was sent successfully, 0 otherwise

11sendToThread : (thread_id : Ptr) -> a -> IO Int

13sendToThread : (thread_id : Ptr) -> a -> IO Int

libs/base/System/Info.idr+3

@@ -1,13 +1,16 @@

1module System.Info

2

3||| The Idris backend in use

4+export

4backend : String

5backend : String

5backend = prim__systemInfo 0

6backend = prim__systemInfo 0

6

7

7||| The operating system in use.

8||| The operating system in use.

9+export

8os : String

10os : String

9os = prim__systemInfo 1

11os = prim__systemInfo 1

10

12

11||| The triple this program was targeted for

13||| The triple this program was targeted for

14+export

12targetTriple : String

15targetTriple : String

13targetTriple = prim__systemInfo 2

16targetTriple = prim__systemInfo 2

libs/contrib/Classes/Verified.idr+9

@@ -4,6 +4,8 @@ import Control.Algebra

4import Control.Algebra.Lattice

5import Control.Algebra.VectorSpace

6

7+%access public export

8+

7-- Due to these being basically unused and difficult to implement,

9-- Due to these being basically unused and difficult to implement,

8-- they're in contrib for a bit. Once a design is found that lets them

10-- they're in contrib for a bit. Once a design is found that lets them

9-- be implemented for a number of implementations, and we get those

11-- be implemented for a number of implementations, and we get those

@@ -92,6 +94,11 @@ interface MeetSemilattice a => VerifiedMeetSemilattice a where

92 total meetSemilatticeMeetIsCommutative : (l, r : a) -> meet l r = meet r l

94 total meetSemilatticeMeetIsCommutative : (l, r : a) -> meet l r = meet r l

93 total meetSemilatticeMeetIsIdempotent : (e : a) -> meet e e = e

95 total meetSemilatticeMeetIsIdempotent : (e : a) -> meet e e = e

94

96

97+{- FIXME: Some maintenance required here.

98+ Algebra.top and Algebra.bottom don't exist!

99+-}

100+{-

101+

95interface (VerifiedJoinSemilattice a, BoundedJoinSemilattice a) => VerifiedBoundedJoinSemilattice a where

102interface (VerifiedJoinSemilattice a, BoundedJoinSemilattice a) => VerifiedBoundedJoinSemilattice a where

96 total boundedJoinSemilatticeBottomIsBottom : (e : a) -> join e Algebra.bottom = e

103 total boundedJoinSemilatticeBottomIsBottom : (e : a) -> join e Algebra.bottom = e

97

104

@@ -112,3 +119,5 @@ interface (VerifiedBoundedJoinSemilattice a, VerifiedBoundedMeetSemilattice a, V

112-- total moduleScalarMultDistributiveWRTModuleAddition : (s, t : a) -> (v : b) -> (s <+> t) <#> v = (s <#> v) <+> (t <#> v)

119-- total moduleScalarMultDistributiveWRTModuleAddition : (s, t : a) -> (v : b) -> (s <+> t) <#> v = (s <#> v) <+> (t <#> v)

113

120

114--interface (VerifiedField a, VerifiedModule a b) => VerifiedVectorSpace a b where {}

121--interface (VerifiedField a, VerifiedModule a b) => VerifiedVectorSpace a b where {}

122+

123+-}

libs/contrib/Control/Algebra.idr+1

@@ -3,6 +3,7 @@ module Control.Algebra

3infixl 6 <->

4infixl 7 <.>

5

6+%access public export

6

7

7||| Sets equipped with a single binary operation that is associative, along with

8||| Sets equipped with a single binary operation that is associative, along with

8||| a neutral element for that binary operation and inverses for all elements.

9||| a neutral element for that binary operation and inverses for all elements.

libs/contrib/Control/Algebra/Lattice.idr+1

@@ -3,6 +3,7 @@ module Control.Algebra.Lattice

3import Control.Algebra

4import Data.Heap

5

6+%access public export

6

7

7||| Sets equipped with a binary operation that is commutative, associative and

8||| Sets equipped with a binary operation that is commutative, associative and

8||| idempotent. Must satisfy the following laws:

9||| idempotent. Must satisfy the following laws:

libs/contrib/Control/Algebra/NumericInstances.idr+1

@@ -7,6 +7,7 @@ import Control.Algebra.VectorSpace

7import Data.Complex

8import Data.ZZ

9

10+%access public export

10

11

11Semigroup Integer where

12Semigroup Integer where

12 (<+>) = (+)

13 (<+>) = (+)

libs/contrib/Control/Algebra/VectorSpace.idr+2

@@ -2,6 +2,8 @@ module Control.Algebra.VectorSpace

2

3import Control.Algebra

4

5+%access public export

6+

5infixl 5 <#>

7infixl 5 <#>

6infixr 2 <||>

8infixr 2 <||>

7

9

libs/contrib/Control/Isomorphism/Primitives.idr+1−1

@@ -4,7 +4,7 @@ import Control.Isomorphism

4import Data.ZZ

5

6%default total

7−%access public

7+%access public export

8

9-- This module contains isomorphisms between convenient inductive types and

10-- Idris primitives. Because primitives lack a convenient structure, these

libs/contrib/Control/Partial.idr+1−1

@@ -7,7 +7,7 @@ module Control.Partial

7||| @ p the predicate to wait for

8||| @ f the function to repeatedly apply

9||| @ v the starting value

10−partial

10+partial export

11until : (p : a -> Bool) -> (f : a -> a) -> (v : a) -> a

12until p f v with (p v)

13 | False = until p f (f v)

libs/contrib/Control/WellFounded.idr+1−1

@@ -6,7 +6,7 @@

6module Control.WellFounded

7

8%default total

9−

9+%access public export

10

11||| Accessibility: some element `x` is accessible if all `y` such that

12||| `rel y x` are themselves accessible.

libs/contrib/Data/BoundedList.idr+1−1

@@ -2,7 +2,7 @@ module Data.BoundedList

2

3import Data.Fin

4

5−%access public

5+%access public export

6%default total

7

8||| A list with an upper bound on its length.

libs/contrib/Data/CoList.idr+1−1

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

1module Data.CoList

2

3−%access public

3+%access public export

4%default total

5

6||| Idris will know that it always can produce a new element in finite time

libs/contrib/Data/Fun.idr+1

@@ -3,6 +3,7 @@ module Data.Fun

3import public Data.Vect

4

5%default total

6+%access public export

6

7

7||| Build an n-ary function type from a Vect of Types and a result type

8||| Build an n-ary function type from a Vect of Types and a result type

8Fun : Vect n Type -> Type -> Type

9Fun : Vect n Type -> Type -> Type

libs/contrib/Data/Hash.idr+1−1

@@ -2,7 +2,7 @@ module Data.Hash

2

3import Data.Vect

4

5−%access public

5+%access public export

6%default total

7

8{- A general purpose Hashing library (not cryptographic)

libs/contrib/Data/Heap.idr+2−2

@@ -7,9 +7,9 @@ module Data.Heap

7

8

9%default total

10−%access public

10+%access export

11

12−abstract data MaxiphobicHeap : Type -> Type where

12+export data MaxiphobicHeap : Type -> Type where

13 Empty : MaxiphobicHeap a

14 Node : Nat -> MaxiphobicHeap a -> a -> MaxiphobicHeap a -> MaxiphobicHeap a

15

libs/contrib/Data/Matrix.idr+1

@@ -5,6 +5,7 @@ module Data.Matrix

5import public Data.Vect

6

7%default total

8+%access public export

8

9

9||| Matrix with n rows and m columns

10||| Matrix with n rows and m columns

10Matrix : Nat -> Nat -> Type -> Type

11Matrix : Nat -> Nat -> Type -> Type

libs/contrib/Data/Matrix/Algebraic.idr+1−1

@@ -9,7 +9,7 @@ import public Control.Algebra.NumericInstances

9

10import public Data.Matrix

11

12−

12+%access public export

13%default total

14

15infixr 2 <:> -- vector inner product

libs/contrib/Data/Matrix/Numeric.idr+1

@@ -5,6 +5,7 @@ module Data.Matrix.Numeric

5import public Data.Matrix

6

7%default total

8+%access public export

8

9

9infixr 2 <:> -- vector inner product

10infixr 2 <:> -- vector inner product

10infixr 2 >< -- vector outer product

11infixr 2 >< -- vector outer product

libs/contrib/Data/Nat/DivMod.idr+1

@@ -2,6 +2,7 @@

2module Data.Nat.DivMod

3

4%default total

5+%access public export

5

6

6||| The result of euclidean division of natural numbers

7||| The result of euclidean division of natural numbers

7|||

8|||

libs/contrib/Data/Nat/DivMod/IteratedSubtraction.idr+1−1

@@ -8,7 +8,7 @@ import Data.So

8import Control.WellFounded

9

10%default total

11−%access public

11+%access public export

12

13||| A strict less-than relation on `Nat`.

14|||

libs/contrib/Data/Rel.idr+1

@@ -2,6 +2,7 @@ module Data.Rel

2

3import Data.Fun

4

5+%access public export

5

6

6||| Build an n-ary relation type from a Vect of Types

7||| Build an n-ary relation type from a Vect of Types

7Rel : Vect n Type -> Type

8Rel : Vect n Type -> Type

libs/contrib/Data/Sign.idr+2

@@ -1,5 +1,7 @@

1module Data.Sign

2

3+%access public export

4+

3||| A representation of signs for signed datatypes such as `ZZ`

5||| A representation of signs for signed datatypes such as `ZZ`

4data Sign = Plus | Zero | Minus

6data Sign = Plus | Zero | Minus

5

7

libs/contrib/Data/SortedMap.idr+7−8

@@ -192,21 +192,21 @@ treeToList = treeToList' (:: [])

192 treeToList' cont (Branch2 t1 _ t2) = treeToList' (:: treeToList' cont t2) t1

193 treeToList' cont (Branch3 t1 _ t2 _ t3) = treeToList' (:: treeToList' (:: treeToList' cont t3) t2) t1

194

195−abstract

195+export

196data SortedMap : Type -> Type -> Type where

197 Empty : Ord k => SortedMap k v

198 M : (o : Ord k) => (n:Nat) -> Tree n k v o -> SortedMap k v

199

200−public

200+export

201empty : Ord k => SortedMap k v

202empty = Empty

203

204−public

204+export

205lookup : k -> SortedMap k v -> Maybe v

206lookup _ Empty = Nothing

207lookup k (M _ t) = treeLookup k t

208

209−public

209+export

210insert : k -> v -> SortedMap k v -> SortedMap k v

211insert k v Empty = M Z (Leaf k v)

212insert k v (M _ t) =

@@ -214,7 +214,7 @@ insert k v (M _ t) =

214 Left t' => (M _ t')

215 Right t' => (M _ t')

216

217−public

217+export

218delete : k -> SortedMap k v -> SortedMap k v

219delete _ Empty = Empty

220delete k (M Z t) =

@@ -226,16 +226,15 @@ delete k (M (S _) t) =

226 Left t' => (M _ t')

227 Right t' => (M _ t')

228

229−public

229+export

230fromList : Ord k => List (k, v) -> SortedMap k v

231fromList l = foldl (flip (uncurry insert)) empty l

232

233−public

233+export

234toList : SortedMap k v -> List (k, v)

235toList Empty = []

236toList (M _ t) = treeToList t

237

238−public

239treeMap : (a -> b) -> Tree n k a o -> Tree n k b o

238treeMap : (a -> b) -> Tree n k a o -> Tree n k b o

240treeMap f (Leaf k v) = Leaf k (f v)

239treeMap f (Leaf k v) = Leaf k (f v)

241treeMap f (Branch2 t1 k t2) = Branch2 (treeMap f t1) k (treeMap f t2)

240treeMap f (Branch2 t1 k t2) = Branch2 (treeMap f t1) k (treeMap f t2)

libs/contrib/Data/SortedSet.idr+7−7

@@ -4,30 +4,30 @@ import Data.SortedMap

4

5-- TODO: add intersection, union, difference

6

7−abstract

7+export

8data SortedSet k = SetWrapper (Data.SortedMap.SortedMap k ())

9

10−public

10+export

11empty : Ord k => SortedSet k

12empty = SetWrapper Data.SortedMap.empty

13

14−public

14+export

15insert : k -> SortedSet k -> SortedSet k

16insert k (SetWrapper m) = SetWrapper (Data.SortedMap.insert k () m)

17

18−public

18+export

19delete : k -> SortedSet k -> SortedSet k

20delete k (SetWrapper m) = SetWrapper (Data.SortedMap.delete k m)

21

22−public

22+export

23contains : k -> SortedSet k -> Bool

24contains k (SetWrapper m) = isJust (Data.SortedMap.lookup k m)

25

26−public

26+export

27fromList : Ord k => List k -> SortedSet k

28fromList l = SetWrapper (Data.SortedMap.fromList (map (\i => (i, ())) l))

29

30−public

30+export

31toList : SortedSet k -> List k

32toList (SetWrapper m) = map (\(i, _) => i) (Data.SortedMap.toList m)

33

libs/contrib/Data/ZZ.idr+1−1

@@ -4,7 +4,7 @@ import Decidable.Equality

4import Data.Sign

5

6%default total

7−%access public

7+%access public export

8

9

10||| An integer is either a positive `Nat` or the negated successor of a `Nat`.

libs/contrib/Decidable/Decidable.idr+1−1

@@ -3,7 +3,7 @@ module Decidable.Decidable

3import Data.Rel

4import Data.Fun

5

6−%access public

6+%access public export

7

8--------------------------------------------------------------------------------

9-- Interface for decidable n-ary Relations

libs/contrib/Decidable/Order.idr+1−1

@@ -6,7 +6,7 @@ import Data.Fin

6import Data.Fun

7import Data.Rel

8

9−%access public

9+%access public export

10

11--------------------------------------------------------------------------------

12-- Utility Lemmas

libs/contrib/Network/Cgi.idr+11−11

@@ -4,7 +4,7 @@ import System

4

5%default total

6

7−public

7+public export

8Vars : Type

9Vars = List (String, String)

10

@@ -23,7 +23,7 @@ add_Headers str st = record { Headers = Headers st ++ str } st

23add_Output : String -> CGIInfo -> CGIInfo

24add_Output str st = record { Output = Output st ++ str } st

25

26−abstract

26+export

27data CGI : Type -> Type where

28 MkCGI : (CGIInfo -> IO (a, CGIInfo)) -> CGI a

29

@@ -51,32 +51,32 @@ setInfo i = MkCGI (\s => return ((), i))

51getInfo : CGI CGIInfo

52getInfo = MkCGI (\s => return (s, s))

53

54−abstract

54+export

55lift : IO a -> CGI a

56lift op = MkCGI (\st => do { x <- op

57 return (x, st) } )

58

59−abstract

59+export

60output : String -> CGI ()

61output s = do i <- getInfo

62 setInfo (add_Output s i)

63

64−abstract

64+export

65queryVars : CGI Vars

66queryVars = do i <- getInfo

67 return (GET i)

68

69−abstract

69+export

70postVars : CGI Vars

71postVars = do i <- getInfo

72 return (POST i)

73

74−abstract

74+export

75cookieVars : CGI Vars

76cookieVars = do i <- getInfo

77 return (Cookies i)

78

79−abstract

79+export

80queryVar : String -> CGI (Maybe String)

81queryVar x = do vs <- queryVars

82 return (lookup x vs)

@@ -89,12 +89,12 @@ getHeaders : CGI String

89getHeaders = do i <- getInfo

90 return (Headers i)

91

92−abstract

92+export

93flushHeaders : CGI ()

94flushHeaders = do o <- getHeaders

95 lift (putStrLn o)

96

97−abstract

97+export

98flush : CGI ()

99flush = do o <- getOutput

100 lift (putStr o)

@@ -119,7 +119,7 @@ getCgiEnv key = do

119 val <- getEnv key

120 return $ maybe "" id val

121

122−abstract

122+export

123runCGI : CGI a -> IO a

124runCGI prog = do

125 clen_in <- getCgiEnv "CONTENT_LENGTH"

libs/contrib/Network/Socket.idr+7−8

@@ -8,9 +8,7 @@ module IdrisNet.Socket

8%include C "sys/socket.h"

9%include C "netdb.h"

10

11−%access public

12−

13−ByteLength : Type

11+public export ByteLength : Type

14ByteLength = Int

12ByteLength = Int

15

13

16interface ToCode a where

14interface ToCode a where

@@ -67,8 +65,9 @@ implementation ToCode SocketType where

67

65

68data RecvStructPtr = RSPtr Ptr

66data RecvStructPtr = RSPtr Ptr

69data RecvfromStructPtr = RFPtr Ptr

67data RecvfromStructPtr = RFPtr Ptr

68+

70−data BufPtr = BPtr Ptr

69+export data BufPtr = BPtr Ptr

71−data SockaddrPtr = SAPtr Ptr

70+export data SockaddrPtr = SAPtr Ptr

72

71

73||| Protocol Number.

72||| Protocol Number.

74|||

73|||

@@ -120,18 +119,18 @@ record UDPAddrInfo where

120 remote_port : Port

119 remote_port : Port

121

120

122||| Frees a given pointer

121||| Frees a given pointer

123−public

122+export

124sock_free : BufPtr -> IO ()

123sock_free : BufPtr -> IO ()

125sock_free (BPtr ptr) = foreign FFI_C "idrnet_free" (Ptr -> IO ()) ptr

124sock_free (BPtr ptr) = foreign FFI_C "idrnet_free" (Ptr -> IO ()) ptr

126

125

127−public

126+export

128sockaddr_free : SockaddrPtr -> IO ()

127sockaddr_free : SockaddrPtr -> IO ()

129sockaddr_free (SAPtr ptr) = foreign FFI_C "idrnet_free" (Ptr -> IO ()) ptr

128sockaddr_free (SAPtr ptr) = foreign FFI_C "idrnet_free" (Ptr -> IO ()) ptr

130

129

131||| Allocates an amount of memory given by the ByteLength parameter.

130||| Allocates an amount of memory given by the ByteLength parameter.

132|||

131|||

133||| Used to allocate a mutable pointer to be given to the Recv functions.

132||| Used to allocate a mutable pointer to be given to the Recv functions.

134−public

133+export

135sock_alloc : ByteLength -> IO BufPtr

134sock_alloc : ByteLength -> IO BufPtr

136sock_alloc bl = map BPtr $ foreign FFI_C "idrnet_malloc" (Int -> IO Ptr) bl

135sock_alloc bl = map BPtr $ foreign FFI_C "idrnet_malloc" (Int -> IO Ptr) bl

137

136

libs/contrib/System/Concurrency/Process.idr+10−2

@@ -4,9 +4,9 @@ module System.Concurrency.Process

4

5import System.Concurrency.Raw

6

7−%access public

7+%access public export

8

9−abstract

9+export

10data ProcID msg = MkPID Ptr

11

12||| Type safe message passing programs. Parameterised over the type of

@@ -30,24 +30,29 @@ run : Process msg x -> IO x

30run (Lift prog) = prog

31

32||| Get current process ID

33+export

33myID : Process msg (ProcID msg)

34myID : Process msg (ProcID msg)

34myID = Lift (return (MkPID prim__vm))

35myID = Lift (return (MkPID prim__vm))

35

36

36||| Send a message to another process

37||| Send a message to another process

37||| Returns whether the send was unsuccessful.

38||| Returns whether the send was unsuccessful.

39+export

38send : ProcID msg -> msg -> Process msg Bool

40send : ProcID msg -> msg -> Process msg Bool

39send (MkPID p) m = Lift (do x <- sendToThread p (prim__vm, m)

41send (MkPID p) m = Lift (do x <- sendToThread p (prim__vm, m)

40 return (x == 1))

42 return (x == 1))

41

43

42||| Return whether a message is waiting in the queue

44||| Return whether a message is waiting in the queue

45+export

43msgWaiting : Process msg Bool

46msgWaiting : Process msg Bool

44msgWaiting = Lift checkMsgs

47msgWaiting = Lift checkMsgs

45

48

46||| Return whether a message is waiting in the queue from a specific sender

49||| Return whether a message is waiting in the queue from a specific sender

50+export

47msgWaitingFrom : ProcID msg -> Process msg Bool

51msgWaitingFrom : ProcID msg -> Process msg Bool

48msgWaitingFrom (MkPID p) = Lift (checkMsgsFrom p)

52msgWaitingFrom (MkPID p) = Lift (checkMsgsFrom p)

49

53

50||| Receive a message - blocks if there is no message waiting

54||| Receive a message - blocks if there is no message waiting

55+export

51recv : Process msg msg

56recv : Process msg msg

52recv {msg} = do (senderid, m) <- Lift get

57recv {msg} = do (senderid, m) <- Lift get

53 return m

58 return m

@@ -55,6 +60,7 @@ recv {msg} = do (senderid, m) <- Lift get

55 get = getMsg

60 get = getMsg

56

61

57||| Receive a message from specific sender - blocks if there is no message waiting

62||| Receive a message from specific sender - blocks if there is no message waiting

63+export

58recvFrom : ProcID msg -> Process msg msg

64recvFrom : ProcID msg -> Process msg msg

59recvFrom (MkPID p) {msg} = do (senderid, m) <- Lift get

65recvFrom (MkPID p) {msg} = do (senderid, m) <- Lift get

60 return m

66 return m

@@ -62,6 +68,7 @@ recvFrom (MkPID p) {msg} = do (senderid, m) <- Lift get

62 get = getMsgFrom p

68 get = getMsgFrom p

63

69

64||| receive a message, and return with the sender's process ID.

70||| receive a message, and return with the sender's process ID.

71+export

65recvWithSender : Process msg (ProcID msg, msg)

72recvWithSender : Process msg (ProcID msg, msg)

66recvWithSender {msg}

73recvWithSender {msg}

67 = do (senderid, m) <- Lift get

74 = do (senderid, m) <- Lift get

@@ -69,6 +76,7 @@ recvWithSender {msg}

69 where get : IO (Ptr, msg)

76 where get : IO (Ptr, msg)

70 get = getMsg

77 get = getMsg

71

78

79+export

72create : Process msg () -> Process msg (ProcID msg)

80create : Process msg () -> Process msg (ProcID msg)

73create (Lift p) = do ptr <- Lift (fork p)

81create (Lift p) = do ptr <- Lift (fork p)

74 return (MkPID ptr)

82 return (MkPID ptr)

libs/contrib/contrib.ipkg+2

@@ -7,7 +7,9 @@ modules = Control.Algebra,

7 Control.Isomorphism.Primitives,

8 Control.Partial,

9 Control.WellFounded,

10+

10 Classes.Verified,

11 Classes.Verified,

12+

11 Data.Fun, Data.Rel,

13 Data.Fun, Data.Rel,

12 Data.Hash,

14 Data.Hash,

13 Data.Matrix, Data.Matrix.Algebraic, Data.Matrix.Numeric,

15 Data.Matrix, Data.Matrix.Algebraic, Data.Matrix.Numeric,

libs/effects/Effect/Default.idr+2

@@ -2,6 +2,8 @@ module Effect.Default

2

3import Data.Vect

4

5+%access public export

6+

5interface Default a where

7interface Default a where

6 default : a

8 default : a

7

9

libs/effects/Effect/Exception.idr+2

@@ -4,6 +4,8 @@ import Effects

4import System

5import Control.IOExcept

6

7+%access public export

8+

7data Exception : Type -> Effect where

9data Exception : Type -> Effect where

8 Raise : a -> sig (Exception a) b

10 Raise : a -> sig (Exception a) b

9

11

libs/effects/Effect/File.idr+1

@@ -4,6 +4,7 @@ module Effect.File

4import Effects

5import Control.IOExcept

6

7+%access public export

7

8

8||| A Dependent type to describe File Handles. File handles are

9||| A Dependent type to describe File Handles. File handles are

9||| parameterised with the current state of the file: Closed; Open for

10||| parameterised with the current state of the file: Closed; Open for

libs/effects/Effect/Logging/Category.idr+1−1

@@ -14,7 +14,7 @@ module Effect.Logging.Category

14import Effects

15import public Effect.Logging.Level

16

17−%access public

17+%access public export

18

19-- -------------------------------------------------------- [ Logging Resource ]

20

libs/effects/Effect/Logging/Default.idr+1−1

@@ -15,7 +15,7 @@ module Effect.Logging.Default

15import Effects

16import public Effect.Logging.Level

17

18−%access public

18+%access public export

19

20-- ------------------------------------------------------------ [ The Resource ]

21

libs/effects/Effect/Logging/Level.idr+1−1

@@ -14,7 +14,7 @@

14||| loggers.

15module Effect.Logging.Level

16

17−%access public

17+%access public export

18%default total

19

20-- ---------------------------------------------------- [ Log Level Definition ]

libs/effects/Effect/Memory.idr+9−3

@@ -5,13 +5,13 @@ import Control.IOExcept

5import Data.Vect

6import public Data.So

7

8−%access public

8+%access public export

9

10−abstract

10+export

11data MemoryChunk : Nat -> Nat -> Type where

12 CH : Ptr -> MemoryChunk size initialized

13

14−abstract

14+export

15data RawMemory : Effect where

16 Allocate : (n : Nat) ->

17 RawMemory () () (\v => MemoryChunk n 0)

@@ -102,10 +102,12 @@ implementation Handler RawMemory (IOExcept String) where

102RAW_MEMORY : Type -> EFFECT

103RAW_MEMORY t = MkEff t RawMemory

104

105+export

105allocate : (n : Nat) ->

106allocate : (n : Nat) ->

106 Eff () [RAW_MEMORY ()] (\v => [RAW_MEMORY (MemoryChunk n 0)])

107 Eff () [RAW_MEMORY ()] (\v => [RAW_MEMORY (MemoryChunk n 0)])

107allocate size = call $ Allocate size

108allocate size = call $ Allocate size

108

109

110+export

109initialize : {i : Nat} ->

111initialize : {i : Nat} ->

110 {n : Nat} ->

112 {n : Nat} ->

111 Bits8 ->

113 Bits8 ->

@@ -115,9 +117,11 @@ initialize : {i : Nat} ->

115 (\v => [RAW_MEMORY (MemoryChunk n (i + size))])

117 (\v => [RAW_MEMORY (MemoryChunk n (i + size))])

116initialize c size prf = call $ Initialize c size prf

118initialize c size prf = call $ Initialize c size prf

117

119

120+export

118free : Eff () [RAW_MEMORY (MemoryChunk n i)] (\v => [RAW_MEMORY ()])

121free : Eff () [RAW_MEMORY (MemoryChunk n i)] (\v => [RAW_MEMORY ()])

119free = call Free

122free = call Free

120

123

124+export

121peek : {i : Nat} ->

125peek : {i : Nat} ->

122 (offset : Nat) ->

126 (offset : Nat) ->

123 (size : Nat) ->

127 (size : Nat) ->

@@ -125,6 +129,7 @@ peek : {i : Nat} ->

125 { [RAW_MEMORY (MemoryChunk n i)] } Eff (Vect size Bits8)

129 { [RAW_MEMORY (MemoryChunk n i)] } Eff (Vect size Bits8)

126peek offset size prf = call $ Peek offset size prf

130peek offset size prf = call $ Peek offset size prf

127

131

132+export

128poke : {n : Nat} ->

133poke : {n : Nat} ->

129 {i : Nat} ->

134 {i : Nat} ->

130 (offset : Nat) ->

135 (offset : Nat) ->

@@ -155,6 +160,7 @@ move' src_ptr dst_offset src_offset size dst_bounds src_bounds

155

160

156data MoveDescriptor = Dst | Src

161data MoveDescriptor = Dst | Src

157

162

163+export

158move : {dst_size : Nat} ->

164move : {dst_size : Nat} ->

159 {dst_init : Nat} ->

165 {dst_init : Nat} ->

160 {src_size : Nat} ->

166 {src_size : Nat} ->

libs/effects/Effect/Monad.idr+2

@@ -2,6 +2,8 @@ module Effect.Monad

2

3import Effects

4

5+%access public export

6+

5data MonadEffT : List EFFECT -> (Type -> Type) -> Type -> Type where

7data MonadEffT : List EFFECT -> (Type -> Type) -> Type -> Type where

6 MkMonadEffT : EffM m a xs (\v => xs) -> MonadEffT xs m a

8 MkMonadEffT : EffM m a xs (\v => xs) -> MonadEffT xs m a

7

9

libs/effects/Effect/Perf.idr+1−1

@@ -12,7 +12,7 @@ import System

12import Effects

13import Effect.Default

14

15−%access public

15+%access public export

16

17-- ---------------------------------------------------- [ Timer Data Structure ]

18

libs/effects/Effect/Random.idr+2

@@ -3,6 +3,8 @@ module Effect.Random

3import Effects

4import Data.Vect

5

6+%access public export

7+

6data Random : Effect where

8data Random : Effect where

7 GetRandom : sig Random Integer Integer

9 GetRandom : sig Random Integer Integer

8 SetSeed : Integer -> sig Random () Integer

10 SetSeed : Integer -> sig Random () Integer

libs/effects/Effect/Select.idr+2

@@ -2,6 +2,8 @@ module Effect.Select

2

3import Effects

4

5+%access public export

6+

5data Selection : Effect where

7data Selection : Effect where

6 Select : List a -> sig Selection a ()

8 Select : List a -> sig Selection a ()

7

9

libs/effects/Effect/State.idr+1−1

@@ -2,7 +2,7 @@ module Effect.State

2

3import Effects

4

5−%access public

5+%access public export

6

7data State : Effect where

8 Get : sig State a a

libs/effects/Effect/StdIO.idr+2

@@ -3,6 +3,8 @@ module Effect.StdIO

3import Effects

4import Control.IOExcept

5

6+%access public export

7+

6-------------------------------------------------------------

8-------------------------------------------------------------

7-- IO effects internals

9-- IO effects internals

8-------------------------------------------------------------

10-------------------------------------------------------------

libs/effects/Effect/System.idr+2

@@ -7,6 +7,8 @@ import Effects

7import System

8import Control.IOExcept

9

10+%access public export

11+

10data System : Effect where

12data System : Effect where

11 Args : sig System (List String)

13 Args : sig System (List String)

12 Time : sig System Integer

14 Time : sig System Integer

libs/effects/Effect/Trans.idr+1−1

@@ -2,7 +2,7 @@ module Effect.Trans

2

3import Effects

4

5−%access public

5+%access public export

6

7data Trans : (Type -> Type) -> Effect where

8 Lift : m a -> sig (Trans m) a

libs/effects/Effects.idr+25−1

@@ -7,7 +7,7 @@ import Data.Vect

7--- Effectful computations are described as algebraic data types that

8--- explain how an effect is interpreted in some underlying context.

9

10−%access public

10+%access export

11-- ----------------------------------------------------------------- [ Effects ]

12||| The Effect type describes effectful computations.

13|||

@@ -15,11 +15,13 @@ import Data.Vect

15||| + The return type of the computation.

16||| + The input resource.

17||| + The computation to run on the resource given the return value.

18+public export

18Effect : Type

19Effect : Type

19Effect = (x : Type) -> Type -> (x -> Type) -> Type

20Effect = (x : Type) -> Type -> (x -> Type) -> Type

20

21

21||| The `EFFECT` Data type describes how to promote the Effect

22||| The `EFFECT` Data type describes how to promote the Effect

22||| description into a concrete effect.

23||| description into a concrete effect.

24+public export

23%error_reverse

25%error_reverse

24data EFFECT : Type where

26data EFFECT : Type where

25 MkEff : Type -> Effect -> EFFECT

27 MkEff : Type -> Effect -> EFFECT

@@ -30,24 +32,29 @@ data EFFECT : Type where

30-- or a dependent change. These are easily disambiguated by type.

32-- or a dependent change. These are easily disambiguated by type.

31

33

32namespace NoResourceEffect

34namespace NoResourceEffect

35+ public export

33 sig : Effect -> Type -> Type

36 sig : Effect -> Type -> Type

34 sig e r = e r () (\v => ())

37 sig e r = e r () (\v => ())

35

38

36namespace NoUpdateEffect

39namespace NoUpdateEffect

40+ public export

37 sig : Effect -> (ret : Type) -> (resource : Type) -> Type

41 sig : Effect -> (ret : Type) -> (resource : Type) -> Type

38 sig e r e_in = e r e_in (\v => e_in)

42 sig e r e_in = e r e_in (\v => e_in)

39

43

40namespace UpdateEffect

44namespace UpdateEffect

45+ public export

41 sig : Effect -> (ret : Type) -> (res_in : Type) -> (res_out : Type) -> Type

46 sig : Effect -> (ret : Type) -> (res_in : Type) -> (res_out : Type) -> Type

42 sig e r e_in e_out = e r e_in (\v => e_out)

47 sig e r e_in e_out = e r e_in (\v => e_out)

43

48

44namespace DepUpdateEffect

49namespace DepUpdateEffect

50+ public export

45 sig : Effect ->

51 sig : Effect ->

46 (ret : Type) -> (res_in : Type) -> (res_out : ret -> Type) -> Type

52 (ret : Type) -> (res_in : Type) -> (res_out : ret -> Type) -> Type

47 sig e r e_in e_out = e r e_in e_out

53 sig e r e_in e_out = e r e_in e_out

48

54

49||| Handler interfaces describe how an effect `e` is translated to the

55||| Handler interfaces describe how an effect `e` is translated to the

50||| underlying computation context `m` for execution.

56||| underlying computation context `m` for execution.

57+public export

51interface Handler (e : Effect) (m : Type -> Type) where

58interface Handler (e : Effect) (m : Type -> Type) where

52 ||| How to handle the effect.

59 ||| How to handle the effect.

53 |||

60 |||

@@ -77,6 +84,7 @@ syntax "{" [inst] "==>" "{" {b} "}" [outst] "}" [eff]

77syntax "{" [inst] "==>" [outst] "}" [eff] = eff inst (\result => outst)

84syntax "{" [inst] "==>" [outst] "}" [eff] = eff inst (\result => outst)

78

85

79-- --------------------------------------- [ Properties and Proof Construction ]

86-- --------------------------------------- [ Properties and Proof Construction ]

87+public export

80data SubList : List a -> List a -> Type where

88data SubList : List a -> List a -> Type where

81 SubNil : SubList [] []

89 SubNil : SubList [] []

82 Keep : SubList xs ys -> SubList (x :: xs) (x :: ys)

90 Keep : SubList xs ys -> SubList (x :: xs) (x :: ys)

@@ -88,21 +96,25 @@ subListId {xs = Nil} = SubNil

88subListId {xs = x :: xs} = Keep subListId

96subListId {xs = x :: xs} = Keep subListId

89

97

90namespace Env

98namespace Env

99+ public export

91 data Env : (m : Type -> Type) -> List EFFECT -> Type where

100 data Env : (m : Type -> Type) -> List EFFECT -> Type where

92 Nil : Env m Nil

101 Nil : Env m Nil

93 (::) : Handler eff m => a -> Env m xs -> Env m (MkEff a eff :: xs)

102 (::) : Handler eff m => a -> Env m xs -> Env m (MkEff a eff :: xs)

94

103

104+public export

95data EffElem : Effect -> Type ->

105data EffElem : Effect -> Type ->

96 List EFFECT -> Type where

106 List EFFECT -> Type where

97 Here : EffElem x a (MkEff a x :: xs)

107 Here : EffElem x a (MkEff a x :: xs)

98 There : EffElem x a xs -> EffElem x a (y :: xs)

108 There : EffElem x a xs -> EffElem x a (y :: xs)

99

109

100||| make an environment corresponding to a sub-list

110||| make an environment corresponding to a sub-list

111+private

101dropEnv : Env m ys -> SubList xs ys -> Env m xs

112dropEnv : Env m ys -> SubList xs ys -> Env m xs

102dropEnv [] SubNil = []

113dropEnv [] SubNil = []

103dropEnv (v :: vs) (Keep rest) = v :: dropEnv vs rest

114dropEnv (v :: vs) (Keep rest) = v :: dropEnv vs rest

104dropEnv (v :: vs) (Drop rest) = dropEnv vs rest

115dropEnv (v :: vs) (Drop rest) = dropEnv vs rest

105

116

117+public export

106updateWith : (ys' : List a) -> (xs : List a) ->

118updateWith : (ys' : List a) -> (xs : List a) ->

107 SubList ys xs -> List a

119 SubList ys xs -> List a

108updateWith (y :: ys) (x :: xs) (Keep rest) = y :: updateWith ys xs rest

120updateWith (y :: ys) (x :: xs) (Keep rest) = y :: updateWith ys xs rest

@@ -112,6 +124,7 @@ updateWith (y :: ys) [] SubNil = y :: ys

112updateWith [] (x :: xs) (Keep rest) = []

124updateWith [] (x :: xs) (Keep rest) = []

113

125

114||| Put things back, replacing old with new in the sub-environment

126||| Put things back, replacing old with new in the sub-environment

127+private

115rebuildEnv : Env m ys' -> (prf : SubList ys xs) ->

128rebuildEnv : Env m ys' -> (prf : SubList ys xs) ->

116 Env m xs -> Env m (updateWith ys' xs prf)

129 Env m xs -> Env m (updateWith ys' xs prf)

117rebuildEnv [] SubNil env = env

130rebuildEnv [] SubNil env = env

@@ -123,6 +136,7 @@ rebuildEnv xs (Drop rest) (y :: env) = y :: rebuildEnv xs rest env

123

136

124-- -------------------------------------------------- [ The Effect EDSL itself ]

137-- -------------------------------------------------- [ The Effect EDSL itself ]

125

138

139+public export

126updateResTy : (val : t) ->

140updateResTy : (val : t) ->

127 (xs : List EFFECT) -> EffElem e a xs -> e t a b ->

141 (xs : List EFFECT) -> EffElem e a xs -> e t a b ->

128 List EFFECT

142 List EFFECT

@@ -131,9 +145,11 @@ updateResTy val (x :: xs) (There p) n = x :: updateResTy val xs p n

131

145

132infix 5 :::, :-, :=

146infix 5 :::, :-, :=

133

147

148+public export

134data LRes : lbl -> Type -> Type where

149data LRes : lbl -> Type -> Type where

135 (:=) : (x : lbl) -> res -> LRes x res

150 (:=) : (x : lbl) -> res -> LRes x res

136

151

152+public export

137(:::) : lbl -> EFFECT -> EFFECT

153(:::) : lbl -> EFFECT -> EFFECT

138(:::) {lbl} x (MkEff r e) = MkEff (LRes x r) e

154(:::) {lbl} x (MkEff r e) = MkEff (LRes x r) e

139

155

@@ -156,6 +172,7 @@ relabel {xs = (MkEff a e :: xs)} l (v :: vs) = (l := v) :: relabel l vs

156||| @ x The return type of the result.

172||| @ x The return type of the result.

157||| @ es The list of allowed side-effects.

173||| @ es The list of allowed side-effects.

158||| @ ce Function to compute a new list of allowed side-effects.

174||| @ ce Function to compute a new list of allowed side-effects.

175+public export

159data EffM : (m : Type -> Type) -> (x : Type)

176data EffM : (m : Type -> Type) -> (x : Type)

160 -> (es : List EFFECT)

177 -> (es : List EFFECT)

161 -> (ce : x -> List EFFECT) -> Type where

178 -> (ce : x -> List EFFECT) -> Type where

@@ -182,27 +199,33 @@ data EffM : (m : Type -> Type) -> (x : Type)

182

199

183namespace SimpleEff

200namespace SimpleEff

184 -- Simple effects, no updates

201 -- Simple effects, no updates

202+ public export

185 Eff : (x : Type) -> (es : List EFFECT) -> Type

203 Eff : (x : Type) -> (es : List EFFECT) -> Type

186 Eff x es = {m : Type -> Type} -> EffM m x es (\v => es)

204 Eff x es = {m : Type -> Type} -> EffM m x es (\v => es)

187

205

206+ public export

188 EffT : (m : Type -> Type) -> (x : Type) -> (es : List EFFECT) -> Type

207 EffT : (m : Type -> Type) -> (x : Type) -> (es : List EFFECT) -> Type

189 EffT m x es = EffM m x es (\v => es)

208 EffT m x es = EffM m x es (\v => es)

190

209

191namespace TransEff

210namespace TransEff

192 -- Dependent effects, updates not dependent on result

211 -- Dependent effects, updates not dependent on result

212+ public export

193 Eff : (x : Type) -> (es : List EFFECT) -> (ce : List EFFECT) -> Type

213 Eff : (x : Type) -> (es : List EFFECT) -> (ce : List EFFECT) -> Type

194 Eff x es ce = {m : Type -> Type} -> EffM m x es (\_ => ce)

214 Eff x es ce = {m : Type -> Type} -> EffM m x es (\_ => ce)

195

215

216+ public export

196 EffT : (m : Type -> Type) ->

217 EffT : (m : Type -> Type) ->

197 (x : Type) -> (es : List EFFECT) -> (ce : List EFFECT) -> Type

218 (x : Type) -> (es : List EFFECT) -> (ce : List EFFECT) -> Type

198 EffT m x es ce = EffM m x es (\_ => ce)

219 EffT m x es ce = EffM m x es (\_ => ce)

199

220

200namespace DepEff

221namespace DepEff

201 -- Dependent effects, updates dependent on result

222 -- Dependent effects, updates dependent on result

223+ public export

202 Eff : (x : Type) -> (es : List EFFECT)

224 Eff : (x : Type) -> (es : List EFFECT)

203 -> (ce : x -> List EFFECT) -> Type

225 -> (ce : x -> List EFFECT) -> Type

204 Eff x es ce = {m : Type -> Type} -> EffM m x es ce

226 Eff x es ce = {m : Type -> Type} -> EffM m x es ce

205

227

228+ public export

206 EffT : (m : Type -> Type) -> (x : Type) -> (es : List EFFECT)

229 EffT : (m : Type -> Type) -> (x : Type) -> (es : List EFFECT)

207 -> (ce : x -> List EFFECT) -> Type

230 -> (ce : x -> List EFFECT) -> Type

208 EffT m x es ce = EffM m x es ce

231 EffT m x es ce = EffM m x es ce

@@ -271,6 +294,7 @@ execEff (val :: env) (There p) eff k

271-- Q: Instead of m b, implement as StateT (Env m xs') m b, so that state

294-- Q: Instead of m b, implement as StateT (Env m xs') m b, so that state

272-- updates can be propagated even through failing computations?

295-- updates can be propagated even through failing computations?

273

296

297+export

274eff : Env m xs -> EffM m a xs xs' -> ((x : a) -> Env m (xs' x) -> m b) -> m b

298eff : Env m xs -> EffM m a xs xs' -> ((x : a) -> Env m (xs' x) -> m b) -> m b

275eff env (Value x) k = k x env

299eff env (Value x) k = k x env

276eff env (prog `EBind` c) k

300eff env (prog `EBind` c) k

libs/prelude/Builtins.idr+5−5

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

1%unqualified

2

3−%access public

3+%access public export

4%default total

5

6||| The canonical single-element type, also known as the trivially

@@ -155,13 +155,13 @@ assert_total x = x

155

156||| Subvert the type checker. This function is abstract, so it will not reduce in

157||| the type checker. Use it with care - it can result in segfaults or worse!

158−abstract %assert_total -- need to pretend

158+export %assert_total -- need to pretend

159believe_me : a -> b

160believe_me x = prim__believe_me _ _ x

161

162||| Subvert the type checker. This function *will* reduce in the type checker.

163||| Use it with extreme care - it can result in segfaults or worse!

164−public %assert_total

164+public export %assert_total

165really_believe_me : a -> b

166really_believe_me x = prim__believe_me _ _ x

167

@@ -174,8 +174,8 @@ Float = Double

174-- Pointers as external primitive; there's no literals for these, so no

175-- need for them to be part of the compiler.

176

177−abstract data Ptr : Type

177+export data Ptr : Type

178−abstract data ManagedPtr : Type

178+export data ManagedPtr : Type

179

180%extern prim__readFile : prim__WorldType -> Ptr -> String

181%extern prim__writeFile : prim__WorldType -> Ptr -> String -> Int

libs/prelude/Decidable/Equality.idr+4−5

@@ -3,12 +3,14 @@ module Decidable.Equality

3import Builtins

4import Prelude.Basics

5import Prelude.Bool

6−import Prelude.Classes

6+import Prelude.Interfaces

7import Prelude.Either

8import Prelude.List

9import Prelude.Nat

10import Prelude.Maybe

11

12+%access public export

13+

12--------------------------------------------------------------------------------

14--------------------------------------------------------------------------------

13-- Utility lemmas

15-- Utility lemmas

14--------------------------------------------------------------------------------

16--------------------------------------------------------------------------------

@@ -141,7 +143,7 @@ implementation DecEq a => DecEq (List a) where

141 decEq [] (x :: xs) = No (negEqSym lemma_val_not_nil)

143 decEq [] (x :: xs) = No (negEqSym lemma_val_not_nil)

142 decEq (x :: xs) (y :: ys) with (decEq x y)

144 decEq (x :: xs) (y :: ys) with (decEq x y)

143 decEq (x :: xs) (x :: ys) | Yes Refl with (decEq xs ys)

145 decEq (x :: xs) (x :: ys) | Yes Refl with (decEq xs ys)

144− decEq (x :: xs) (x :: xs) | (Yes Refl) | (Yes Refl) = Yes Refl

146+ decEq (x :: xs) (x :: xs) | (Yes Refl) | (Yes Refl) = Yes Refl

145 decEq (x :: xs) (x :: ys) | (Yes Refl) | (No p) = No (\eq => lemma_x_eq_xs_neq Refl p eq)

147 decEq (x :: xs) (x :: ys) | (Yes Refl) | (No p) = No (\eq => lemma_x_eq_xs_neq Refl p eq)

146 decEq (x :: xs) (y :: ys) | No p with (decEq xs ys)

148 decEq (x :: xs) (y :: ys) | No p with (decEq xs ys)

147 decEq (x :: xs) (y :: xs) | (No p) | (Yes Refl) = No (\eq => lemma_x_neq_xs_eq p Refl eq)

149 decEq (x :: xs) (y :: xs) | (No p) | (Yes Refl) = No (\eq => lemma_x_neq_xs_eq p Refl eq)

@@ -211,6 +213,3 @@ implementation DecEq ManagedPtr where

211 where primitiveEq : x = y

213 where primitiveEq : x = y

212 primitiveEq = believe_me (Refl {x})

214 primitiveEq = believe_me (Refl {x})

213 postulate primitiveNotEq : x = y -> Void

215 postulate primitiveNotEq : x = y -> Void

214−

215−

216−

libs/prelude/IO.idr+22−9

@@ -3,25 +3,25 @@

3import Builtins

4import Prelude.List

5

6−%access public

6+%access export

7

8||| Idris's primitive IO, for building abstractions on top of

9−abstract

10data PrimIO : Type -> Type where

9data PrimIO : Type -> Type where

11 Prim__IO : a -> PrimIO a

10 Prim__IO : a -> PrimIO a

12

11

13||| A token representing the world, for use in `IO`

12||| A token representing the world, for use in `IO`

14−abstract data World = TheWorld prim__WorldType

13+data World = TheWorld prim__WorldType

15

14

16private

15private

17world : World -> prim__WorldType

16world : World -> prim__WorldType

18world (TheWorld w) = w

17world (TheWorld w) = w

19

18

20−abstract WorldRes : Type -> Type

19+WorldRes : Type -> Type

21WorldRes x = x

20WorldRes x = x

22

21

23||| An FFI specifier, which describes how a particular compiler

22||| An FFI specifier, which describes how a particular compiler

24||| backend handles foreign function calls.

23||| backend handles foreign function calls.

24+public export

25record FFI where

26 constructor MkFFI

27 ||| A family describing which types are available in the FFI

@@ -35,10 +35,10 @@ record FFI where

35

36||| The IO type, parameterised over the FFI that is available within

37||| it.

38−abstract

39data IO' : (lang : FFI) -> Type -> Type where

38data IO' : (lang : FFI) -> Type -> Type where

40 MkIO : (World -> PrimIO (WorldRes a)) -> IO' lang a

39 MkIO : (World -> PrimIO (WorldRes a)) -> IO' lang a

41

40

41+public export

42data FTy : FFI -> List Type -> Type -> Type where

43 FRet : ffi_types f t -> FTy f xs (IO' f t)

44 FFun : ffi_types f s -> FTy f (s :: xs) t -> FTy f xs (s -> t)

@@ -54,6 +54,7 @@ ForeignPrimType {ffi} (x :: xs) ((a, _) :: env) t

54 = (ffi_types ffi x, x) -> ForeignPrimType xs env t

55

56%inline

57+private

57applyEnv : (env : FEnv ffi xs) ->

58applyEnv : (env : FEnv ffi xs) ->

58 ForeignPrimType xs env t ->

59 ForeignPrimType xs env t ->

59 World -> ffi_fn ffi -> ffi_types ffi t -> PrimIO t

60 World -> ffi_fn ffi -> ffi_types ffi t -> PrimIO t

@@ -66,6 +67,7 @@ mkForeignPrim : {xs : _} -> {ffi : _} -> {env : FEnv ffi xs} -> {t : Type} ->

66-- explicit here.

67-- explicit here.

67

68

68%inline

69%inline

70+private

69foreign_prim : (f : FFI) ->

71foreign_prim : (f : FFI) ->

70 (fname : ffi_fn f) -> FTy f xs ty -> FEnv f xs -> ty

72 (fname : ffi_fn f) -> FTy f xs ty -> FEnv f xs -> ty

71foreign_prim f fname (FRet y) env

73foreign_prim f fname (FRet y) env

@@ -91,25 +93,21 @@ foreign : (f : FFI) -> (fname : ffi_fn f) -> (ty : Type) ->

91 {auto fty : FTy f [] ty} -> ty

93 {auto fty : FTy f [] ty} -> ty

92foreign ffi fname ty {fty} = foreign_prim ffi fname fty []

94foreign ffi fname ty {fty} = foreign_prim ffi fname fty []

93

95

94−abstract

95prim_io_bind : PrimIO a -> (a -> PrimIO b) -> PrimIO b

96prim_io_bind : PrimIO a -> (a -> PrimIO b) -> PrimIO b

96prim_io_bind (Prim__IO v) k = k v

97prim_io_bind (Prim__IO v) k = k v

97

98

98unsafePerformPrimIO : PrimIO a -> a

99unsafePerformPrimIO : PrimIO a -> a

99-- compiled as primitive

100-- compiled as primitive

100

101

101−abstract

102prim_io_return : a -> PrimIO a

103prim_io_return x = Prim__IO x

104

105−abstract

106io_bind : IO' l a -> (a -> IO' l b) -> IO' l b

105io_bind : IO' l a -> (a -> IO' l b) -> IO' l b

107io_bind (MkIO fn) k

106io_bind (MkIO fn) k

108 = MkIO (\w => prim_io_bind (fn w)

107 = MkIO (\w => prim_io_bind (fn w)

109 (\ b => case k b of

108 (\ b => case k b of

110 MkIO fkb => fkb w))

109 MkIO fkb => fkb w))

111

110

112−abstract

113io_return : a -> IO' l a

111io_return : a -> IO' l a

114io_return x = MkIO (\w => prim_io_return x)

112io_return x = MkIO (\w => prim_io_return x)

115

113

@@ -143,6 +141,7 @@ prim_fwrite h s

143

141

144--------- The C FFI

142--------- The C FFI

145namespace FFI_C

143namespace FFI_C

144+ public export

146 data Raw : Type -> Type where

145 data Raw : Type -> Type where

147 -- code generated can assume it's compiled just as 't'

146 -- code generated can assume it's compiled just as 't'

148 MkRaw : (x : t) -> Raw t

147 MkRaw : (x : t) -> Raw t

@@ -151,6 +150,7 @@ namespace FFI_C

151 %used MkRaw x

150 %used MkRaw x

152

151

153 ||| Supported C integer types

152 ||| Supported C integer types

153+ public export

154 data C_IntTypes : Type -> Type where

155 C_IntChar : C_IntTypes Char

156 C_IntNative : C_IntTypes Int

@@ -160,6 +160,7 @@ namespace FFI_C

160 C_IntBits64 : C_IntTypes Bits64

161

162 ||| Supported C foreign types

163+ public export

163 data C_Types : Type -> Type where

164 data C_Types : Type -> Type where

164 C_Str : C_Types String

165 C_Str : C_Types String

165 C_Float : C_Types Double

166 C_Float : C_Types Double

@@ -172,12 +173,14 @@ namespace FFI_C

172 ||| A descriptor for the C FFI. See the constructors of `C_Types`

173 ||| A descriptor for the C FFI. See the constructors of `C_Types`

173 ||| and `C_IntTypes` for the concrete types that are available.

174 ||| and `C_IntTypes` for the concrete types that are available.

174 %error_reverse

175 %error_reverse

176+ public export

175 FFI_C : FFI

177 FFI_C : FFI

176 FFI_C = MkFFI C_Types String String

178 FFI_C = MkFFI C_Types String String

177

179

178||| Interactive programs, describing I/O actions and returning a value.

180||| Interactive programs, describing I/O actions and returning a value.

179||| @res The result type of the program

181||| @res The result type of the program

180%error_reverse

182%error_reverse

183+public export

181IO : (res : Type) -> Type

184IO : (res : Type) -> Type

182IO = IO' FFI_C

185IO = IO' FFI_C

183

186

@@ -207,18 +210,22 @@ namespace IO

207

210

208-- Supported JS foreign types

211-- Supported JS foreign types

209mutual

212mutual

213+ public export

210 data JsFn : Type -> Type where

214 data JsFn : Type -> Type where

211 MkJsFn : (x : t) -> JsFn t

215 MkJsFn : (x : t) -> JsFn t

212

216

217+ public export

213 data JS_IntTypes : Type -> Type where

218 data JS_IntTypes : Type -> Type where

214 JS_IntChar : JS_IntTypes Char

219 JS_IntChar : JS_IntTypes Char

215 JS_IntNative : JS_IntTypes Int

220 JS_IntNative : JS_IntTypes Int

216

221

222+ public export

217 data JS_FnTypes : Type -> Type where

223 data JS_FnTypes : Type -> Type where

218 JS_Fn : JS_Types s -> JS_FnTypes t -> JS_FnTypes (s -> t)

224 JS_Fn : JS_Types s -> JS_FnTypes t -> JS_FnTypes (s -> t)

219 JS_FnIO : JS_Types t -> JS_FnTypes (IO' l t)

225 JS_FnIO : JS_Types t -> JS_FnTypes (IO' l t)

220 JS_FnBase : JS_Types t -> JS_FnTypes t

226 JS_FnBase : JS_Types t -> JS_FnTypes t

221

227

228+ public export

222 data JS_Types : Type -> Type where

229 data JS_Types : Type -> Type where

223 JS_Str : JS_Types String

230 JS_Str : JS_Types String

224 JS_Float : JS_Types Double

231 JS_Float : JS_Types Double

@@ -236,10 +243,12 @@ mutual

236||| JavaScript code snippets, into which the arguments are substituted

243||| JavaScript code snippets, into which the arguments are substituted

237||| for the placeholders `%0`, `%1`, etc.

244||| for the placeholders `%0`, `%1`, etc.

238%error_reverse

245%error_reverse

246+public export

239FFI_JS : FFI

247FFI_JS : FFI

240FFI_JS = MkFFI JS_Types String String

248FFI_JS = MkFFI JS_Types String String

241

249

242%error_reverse

250%error_reverse

251+public export

243JS_IO : Type -> Type

252JS_IO : Type -> Type

244JS_IO = IO' FFI_JS

253JS_IO = IO' FFI_JS

245

254

@@ -249,10 +258,12 @@ JS_IO = IO' FFI_JS

249namespace FFI_Export

258namespace FFI_Export

250-- It's just like Data.List.Elem, but we don't need all the other stuff

259-- It's just like Data.List.Elem, but we don't need all the other stuff

251-- that comes with it, just a proof that a data type is defined.

260-- that comes with it, just a proof that a data type is defined.

261+ public export

252 data DataDefined : Type -> List (Type, s) -> s -> Type where

262 data DataDefined : Type -> List (Type, s) -> s -> Type where

253 DHere : DataDefined x ((x, t) :: xs) t

263 DHere : DataDefined x ((x, t) :: xs) t

254 DThere : DataDefined x xs t -> DataDefined x (y :: xs) t

264 DThere : DataDefined x xs t -> DataDefined x (y :: xs) t

255

265

266+ public export

256 data FFI_Base : (f : FFI) -> List (Type, ffi_data f) -> Type -> Type where

267 data FFI_Base : (f : FFI) -> List (Type, ffi_data f) -> Type -> Type where

257 FFI_ExpType : {n : ffi_data f} -> (def : DataDefined t xs n) -> FFI_Base f xs t

268 FFI_ExpType : {n : ffi_data f} -> (def : DataDefined t xs n) -> FFI_Base f xs t

258 FFI_Prim : (prim : ffi_types f t) -> FFI_Base f xs t

269 FFI_Prim : (prim : ffi_types f t) -> FFI_Base f xs t

@@ -261,6 +272,7 @@ namespace FFI_Export

261 %used FFI_ExpType def

272 %used FFI_ExpType def

262 %used FFI_Prim prim

273 %used FFI_Prim prim

263

274

275+ public export

264 data FFI_Exportable : (f : FFI) -> List (Type, ffi_data f) -> Type -> Type where

276 data FFI_Exportable : (f : FFI) -> List (Type, ffi_data f) -> Type -> Type where

265 FFI_IO : (b : FFI_Base f xs t) -> FFI_Exportable f xs (IO' f t)

277 FFI_IO : (b : FFI_Base f xs t) -> FFI_Exportable f xs (IO' f t)

266 FFI_Fun : (b : FFI_Base f xs s) -> (a : FFI_Exportable f xs t) -> FFI_Exportable f xs (s -> t)

278 FFI_Fun : (b : FFI_Base f xs s) -> (a : FFI_Exportable f xs t) -> FFI_Exportable f xs (s -> t)

@@ -271,6 +283,7 @@ namespace FFI_Export

271 %used FFI_Fun a

283 %used FFI_Fun a

272 %used FFI_Ret b

284 %used FFI_Ret b

273

285

286+ public export

274 data FFI_Export : (f : FFI) -> String -> List (Type, ffi_data f) -> Type where

287 data FFI_Export : (f : FFI) -> String -> List (Type, ffi_data f) -> Type where

275 Data : (x : Type) -> (n : ffi_data f) ->

288 Data : (x : Type) -> (n : ffi_data f) ->

276 (es : FFI_Export f h ((x, n) :: xs)) -> FFI_Export f h xs

289 (es : FFI_Export f h ((x, n) :: xs)) -> FFI_Export f h xs

libs/prelude/Language/Reflection.idr+3−3

@@ -9,7 +9,7 @@ import Prelude.List

9import Prelude.Nat

10import Prelude.Traversable

11

12−%access public

12+%access public export

13

14||| A source location in an Idris file

15record SourceLocation where

@@ -80,7 +80,7 @@ data Const = I Int | BI Integer | Fl Double | Ch Char | Str String

80 | WorldType | TheWorld

81%name Const c, c'

82

83−abstract interface ReflConst (a : Type) where

83+export interface ReflConst (a : Type) where

84 toConst : a -> Const

85

86implementation ReflConst Int where

@@ -110,7 +110,7 @@ implementation ReflConst Bits32 where

110implementation ReflConst Bits64 where

111 toConst = B64

112

113−implicit

113+implicit export

114reflectConstant: (ReflConst a) => a -> Const

115reflectConstant = toConst

116

libs/prelude/Language/Reflection/Elab.idr+54−2

@@ -16,6 +16,8 @@ import Prelude.Monad

16import Prelude.Nat

17import Language.Reflection

18

19+%access public export

20+

19data Fixity = Infixl Nat | Infixr Nat | Infix Nat | Prefix Nat

21data Fixity = Infixl Nat | Infixr Nat | Infix Nat | Prefix Nat

20

22

21||| Erasure annotations reflect Idris's idea of what is intended to be

23||| Erasure annotations reflect Idris's idea of what is intended to be

@@ -100,7 +102,7 @@ record Datatype where

100 constructors : List (TTName, List CtorArg, Raw)

102 constructors : List (TTName, List CtorArg, Raw)

101

103

102||| A reflected elaboration script.

104||| A reflected elaboration script.

103−abstract

105+export

104data Elab : Type -> Type where

106data Elab : Type -> Type where

105 -- obligatory control stuff

107 -- obligatory control stuff

106 Prim__PureElab : a -> Elab a

108 Prim__PureElab : a -> Elab a

@@ -164,7 +166,7 @@ data Elab : Type -> Type where

164-------------

166-------------

165-- Public API

167-- Public API

166-------------

168-------------

167−%access public

169+%access public export

168namespace Tactics

170namespace Tactics

169 implementation Functor Elab where

171 implementation Functor Elab where

170 map f t = Prim__BindElab t (\x => Prim__PureElab (f x))

172 map f t = Prim__BindElab t (\x => Prim__PureElab (f x))

@@ -186,31 +188,38 @@ namespace Tactics

186 x >>= f = Prim__BindElab x f

188 x >>= f = Prim__BindElab x f

187

189

188 ||| Halt elaboration with an error

190 ||| Halt elaboration with an error

191+ export

189 fail : List ErrorReportPart -> Elab a

192 fail : List ErrorReportPart -> Elab a

190 fail err = Prim__Fail err

193 fail err = Prim__Fail err

191

194

192 ||| Look up the lexical binding at the focused hole. Fails if no holes are present.

195 ||| Look up the lexical binding at the focused hole. Fails if no holes are present.

196+ export

193 getEnv : Elab (List (TTName, Binder TT))

197 getEnv : Elab (List (TTName, Binder TT))

194 getEnv = Prim__Env

198 getEnv = Prim__Env

195

199

196 ||| Get the name and type of the focused hole. Fails if not holes are present.

200 ||| Get the name and type of the focused hole. Fails if not holes are present.

201+ export

197 getGoal : Elab (TTName, TT)

202 getGoal : Elab (TTName, TT)

198 getGoal = Prim__Goal

203 getGoal = Prim__Goal

199

204

200 ||| Get the hole queue, in order.

205 ||| Get the hole queue, in order.

206+ export

201 getHoles : Elab (List TTName)

207 getHoles : Elab (List TTName)

202 getHoles = Prim__Holes

208 getHoles = Prim__Holes

203

209

204 ||| If the current hole contains a guess, return it. Otherwise, fail.

210 ||| If the current hole contains a guess, return it. Otherwise, fail.

211+ export

205 getGuess : Elab TT

212 getGuess : Elab TT

206 getGuess = Prim__Guess

213 getGuess = Prim__Guess

207

214

208 ||| Look up the types of every overloading of a name.

215 ||| Look up the types of every overloading of a name.

216+ export

209 lookupTy : TTName -> Elab (List (TTName, NameType, TT))

217 lookupTy : TTName -> Elab (List (TTName, NameType, TT))

210 lookupTy n = Prim__LookupTy n

218 lookupTy n = Prim__LookupTy n

211

219

212 ||| Get the type of a fully-qualified name. Fail if it doesn not

220 ||| Get the type of a fully-qualified name. Fail if it doesn not

213 ||| resolve uniquely.

221 ||| resolve uniquely.

222+ export

214 lookupTyExact : TTName -> Elab (TTName, NameType, TT)

223 lookupTyExact : TTName -> Elab (TTName, NameType, TT)

215 lookupTyExact n = case !(lookupTy n) of

224 lookupTyExact n = case !(lookupTy n) of

216 [res] => return res

225 [res] => return res

@@ -219,12 +228,14 @@ namespace Tactics

219

228

220 ||| Find the reflected representation of all datatypes whose names

229 ||| Find the reflected representation of all datatypes whose names

221 ||| are overloadings of some name.

230 ||| are overloadings of some name.

231+ export

222 lookupDatatype : TTName -> Elab (List Datatype)

232 lookupDatatype : TTName -> Elab (List Datatype)

223 lookupDatatype n = Prim__LookupDatatype n

233 lookupDatatype n = Prim__LookupDatatype n

224

234

225 ||| Find the reflected representation of a datatype, given its

235 ||| Find the reflected representation of a datatype, given its

226 ||| fully-qualified name. Fail if the name does not uniquely resolve

236 ||| fully-qualified name. Fail if the name does not uniquely resolve

227 ||| to a datatype.

237 ||| to a datatype.

238+ export

228 lookupDatatypeExact : TTName -> Elab Datatype

239 lookupDatatypeExact : TTName -> Elab Datatype

229 lookupDatatypeExact n = case !(lookupDatatype n) of

240 lookupDatatypeExact n = case !(lookupDatatype n) of

230 [res] => return res

241 [res] => return res

@@ -233,12 +244,14 @@ namespace Tactics

233

244

234 ||| Find the reflected function definition of all functions whose names

245 ||| Find the reflected function definition of all functions whose names

235 ||| are overloadings of some name.

246 ||| are overloadings of some name.

247+ export

236 lookupFunDefn : TTName -> Elab (List (FunDefn TT))

248 lookupFunDefn : TTName -> Elab (List (FunDefn TT))

237 lookupFunDefn n = Prim__LookupFunDefn n

249 lookupFunDefn n = Prim__LookupFunDefn n

238

250

239 ||| Find the reflected function definition of a function, given its

251 ||| Find the reflected function definition of a function, given its

240 ||| fully-qualified name. Fail if the name does not uniquely resolve

252 ||| fully-qualified name. Fail if the name does not uniquely resolve

241 ||| to a function.

253 ||| to a function.

254+ export

242 lookupFunDefnExact : TTName -> Elab (FunDefn TT)

255 lookupFunDefnExact : TTName -> Elab (FunDefn TT)

243 lookupFunDefnExact n = case !(lookupFunDefn n) of

256 lookupFunDefnExact n = case !(lookupFunDefn n) of

244 [res] => return res

257 [res] => return res

@@ -246,11 +259,13 @@ namespace Tactics

246 xs => fail [TextPart "More than one function named", NamePart n]

259 xs => fail [TextPart "More than one function named", NamePart n]

247

260

248 ||| Get the argument specification for each overloading of a name.

261 ||| Get the argument specification for each overloading of a name.

262+ export

249 lookupArgs : TTName -> Elab (List (TTName, List FunArg, Raw))

263 lookupArgs : TTName -> Elab (List (TTName, List FunArg, Raw))

250 lookupArgs n = Prim__LookupArgs n

264 lookupArgs n = Prim__LookupArgs n

251

265

252 ||| Get the argument specification for a name. Fail if the name does

266 ||| Get the argument specification for a name. Fail if the name does

253 ||| not uniquely resolve.

267 ||| not uniquely resolve.

268+ export

254 lookupArgsExact : TTName -> Elab (TTName, List FunArg, Raw)

269 lookupArgsExact : TTName -> Elab (TTName, List FunArg, Raw)

255 lookupArgsExact n = case !(lookupArgs n) of

270 lookupArgsExact n = case !(lookupArgs n) of

256 [res] => return res

271 [res] => return res

@@ -261,6 +276,7 @@ namespace Tactics

261 |||

276 |||

262 ||| @ env the environment within which to check the type

277 ||| @ env the environment within which to check the type

263 ||| @ tm the term to check

278 ||| @ tm the term to check

279+ export

264 check : (env : List (TTName, Binder TT)) -> (tm : Raw) -> Elab (TT, TT)

280 check : (env : List (TTName, Binder TT)) -> (tm : Raw) -> Elab (TT, TT)

265 check env tm = Prim__Check env tm

281 check env tm = Prim__Check env tm

266

282

@@ -269,15 +285,18 @@ namespace Tactics

269 |||

285 |||

270 ||| **NB**: the generated name is unique _for this run of the

286 ||| **NB**: the generated name is unique _for this run of the

271 ||| elaborator_. Do not assume that they are globally unique.

287 ||| elaborator_. Do not assume that they are globally unique.

288+ export

272 gensym : (hint : String) -> Elab TTName

289 gensym : (hint : String) -> Elab TTName

273 gensym hint = Prim__Gensym hint

290 gensym hint = Prim__Gensym hint

274

291

275 ||| Substitute a guess into a hole.

292 ||| Substitute a guess into a hole.

293+ export

276 solve : Elab ()

294 solve : Elab ()

277 solve = Prim__Solve

295 solve = Prim__Solve

278

296

279 ||| Place a term into a hole, unifying its type. Fails if the focus

297 ||| Place a term into a hole, unifying its type. Fails if the focus

280 ||| is not a hole.

298 ||| is not a hole.

299+ export

281 fill : Raw -> Elab ()

300 fill : Raw -> Elab ()

282 fill tm = Prim__Fill tm

301 fill tm = Prim__Fill tm

283

302

@@ -295,6 +314,7 @@ namespace Tactics

295 ||| @ argSpec instructions for finding the arguments to the term,

314 ||| @ argSpec instructions for finding the arguments to the term,

296 ||| where the Boolean states whether or not to attempt to solve

315 ||| where the Boolean states whether or not to attempt to solve

297 ||| the argument by unification.

316 ||| the argument by unification.

317+ export

298 apply : (op : Raw) -> (argSpec : List Bool) -> Elab (List TTName)

318 apply : (op : Raw) -> (argSpec : List Bool) -> Elab (List TTName)

299 apply tm argSpec = map snd <$> Prim__Apply tm argSpec

319 apply tm argSpec = map snd <$> Prim__Apply tm argSpec

300

320

@@ -313,6 +333,7 @@ namespace Tactics

313 ||| where the Boolean states whether or not to attempt to solve

333 ||| where the Boolean states whether or not to attempt to solve

314 ||| the argument by matching.

334 ||| the argument by matching.

315

335

336+ export

316 matchApply : (op : Raw) -> (argSpec : List Bool) -> Elab (List TTName)

337 matchApply : (op : Raw) -> (argSpec : List Bool) -> Elab (List TTName)

317 matchApply tm argSpec = map snd <$> Prim__Apply tm argSpec

338 matchApply tm argSpec = map snd <$> Prim__Apply tm argSpec

318

339

@@ -320,11 +341,13 @@ namespace Tactics

320 ||| exist.

341 ||| exist.

321 |||

342 |||

322 ||| @ hole the hole to focus on

343 ||| @ hole the hole to focus on

344+ export

323 focus : (hole : TTName) -> Elab ()

345 focus : (hole : TTName) -> Elab ()

324 focus hole = Prim__Focus hole

346 focus hole = Prim__Focus hole

325

347

326 ||| Send the currently-focused hole to the end of the hole queue and

348 ||| Send the currently-focused hole to the end of the hole queue and

327 ||| focus on the next hole.

349 ||| focus on the next hole.

350+ export

328 unfocus : TTName -> Elab ()

351 unfocus : TTName -> Elab ()

329 unfocus hole = Prim__Unfocus hole

352 unfocus hole = Prim__Unfocus hole

330

353

@@ -336,6 +359,7 @@ namespace Tactics

336 ||| binding, or else the scopes of the generated terms won't make

359 ||| binding, or else the scopes of the generated terms won't make

337 ||| sense. This tactic creates a new hole of the proper form, and

360 ||| sense. This tactic creates a new hole of the proper form, and

338 ||| points the old hole at it.

361 ||| points the old hole at it.

362+ export

339 attack : Elab ()

363 attack : Elab ()

340 attack = Prim__Attack

364 attack = Prim__Attack

341

365

@@ -344,6 +368,7 @@ namespace Tactics

344 ||| The new hole will be focused, and the previously-focused hole

368 ||| The new hole will be focused, and the previously-focused hole

345 ||| will be immediately after it in the hole queue. Because this

369 ||| will be immediately after it in the hole queue. Because this

346 ||| tactic introduces a new binding, you may need to `attack` first.

370 ||| tactic introduces a new binding, you may need to `attack` first.

371+ export

347 claim : TTName -> Raw -> Elab ()

372 claim : TTName -> Raw -> Elab ()

348 claim n ty = Prim__Claim n ty

373 claim n ty = Prim__Claim n ty

349

374

@@ -352,6 +377,7 @@ namespace Tactics

352 ||| `attack`).

377 ||| `attack`).

353 |||

378 |||

354 ||| @ n the name to use for the argument

379 ||| @ n the name to use for the argument

380+ export

355 intro : (n : TTName) -> Elab ()

381 intro : (n : TTName) -> Elab ()

356 intro n = Prim__Intro (Just n)

382 intro n = Prim__Intro (Just n)

357

383

@@ -361,6 +387,7 @@ namespace Tactics

361 |||

387 |||

362 ||| Requires that the hole be immediately under its binder (use

388 ||| Requires that the hole be immediately under its binder (use

363 ||| `attack` if it might not be).

389 ||| `attack` if it might not be).

390+ export

364 intro' : Elab ()

391 intro' : Elab ()

365 intro' = Prim__Intro Nothing

392 intro' = Prim__Intro Nothing

366

393

@@ -369,10 +396,12 @@ namespace Tactics

369 |||

396 |||

370 ||| Requires that the hole be immediately under its binder (use

397 ||| Requires that the hole be immediately under its binder (use

371 ||| `attack` if it might not be).

398 ||| `attack` if it might not be).

399+ export

372 forall : TTName -> Raw -> Elab ()

400 forall : TTName -> Raw -> Elab ()

373 forall n ty = Prim__Forall n ty

401 forall n ty = Prim__Forall n ty

374

402

375 ||| Convert a hole into a pattern variable.

403 ||| Convert a hole into a pattern variable.

404+ export

376 patvar : TTName -> Elab ()

405 patvar : TTName -> Elab ()

377 patvar n = Prim__PatVar n

406 patvar n = Prim__PatVar n

378

407

@@ -380,6 +409,7 @@ namespace Tactics

380 |||

409 |||

381 ||| Requires that the hole be immediately under its binder (use

410 ||| Requires that the hole be immediately under its binder (use

382 ||| `attack` if it might not be).

411 ||| `attack` if it might not be).

412+ export

383 patbind : TTName -> Elab ()

413 patbind : TTName -> Elab ()

384 patbind n = Prim__PatBind n

414 patbind n = Prim__PatBind n

385

415

@@ -391,10 +421,12 @@ namespace Tactics

391 ||| @ n the name to let bind

421 ||| @ n the name to let bind

392 ||| @ ty the type of the term to be let-bound

422 ||| @ ty the type of the term to be let-bound

393 ||| @ tm the term to be bound

423 ||| @ tm the term to be bound

424+ export

394 letbind : (n : TTName) -> (ty, tm : Raw) -> Elab ()

425 letbind : (n : TTName) -> (ty, tm : Raw) -> Elab ()

395 letbind n ty tm = Prim__LetBind n ty tm

426 letbind n ty tm = Prim__LetBind n ty tm

396

427

397 ||| Normalise the goal.

428 ||| Normalise the goal.

429+ export

398 compute : Elab ()

430 compute : Elab ()

399 compute = Prim__Compute

431 compute = Prim__Compute

400

432

@@ -402,12 +434,14 @@ namespace Tactics

402 |||

434 |||

403 ||| @ env the environment in which to compute (get one of these from `getEnv`)

435 ||| @ env the environment in which to compute (get one of these from `getEnv`)

404 ||| @ term the term to normalise

436 ||| @ term the term to normalise

437+ export

405 normalise : (env : List (TTName, Binder TT)) -> (term : TT) -> Elab TT

438 normalise : (env : List (TTName, Binder TT)) -> (term : TT) -> Elab TT

406 normalise env term = Prim__Normalise env term

439 normalise env term = Prim__Normalise env term

407

440

408 ||| Reduce a closed term to weak-head normal form

441 ||| Reduce a closed term to weak-head normal form

409 |||

442 |||

410 ||| @ term the term to reduce

443 ||| @ term the term to reduce

444+ export

411 whnf : (term : TT) -> Elab TT

445 whnf : (term : TT) -> Elab TT

412 whnf term = Prim__Whnf term

446 whnf term = Prim__Whnf term

413

447

@@ -417,6 +451,7 @@ namespace Tactics

417 ||| @ env a lexical environment to compare the terms in (see `getEnv`)

451 ||| @ env a lexical environment to compare the terms in (see `getEnv`)

418 ||| @ term1 the first term to convert

452 ||| @ term1 the first term to convert

419 ||| @ term2 the second term to convert

453 ||| @ term2 the second term to convert

454+ export

420 convertsInEnv : (env : List (TTName, Binder TT)) -> (term1, term2 : TT) -> Elab ()

455 convertsInEnv : (env : List (TTName, Binder TT)) -> (term1, term2 : TT) -> Elab ()

421 convertsInEnv env term1 term2 = Prim__Converts env term1 term2

456 convertsInEnv env term1 term2 = Prim__Converts env term1 term2

422

457

@@ -424,14 +459,17 @@ namespace Tactics

424 |||

459 |||

425 ||| @ term1 the first term to convert

460 ||| @ term1 the first term to convert

426 ||| @ term2 the second term to convert

461 ||| @ term2 the second term to convert

462+ export

427 converts : (term1, term2 : TT) -> Elab ()

463 converts : (term1, term2 : TT) -> Elab ()

428 converts term1 term2 = convertsInEnv !getEnv term1 term2

464 converts term1 term2 = convertsInEnv !getEnv term1 term2

429

465

430 ||| Find the source context for the elaboration script

466 ||| Find the source context for the elaboration script

467+ export

431 getSourceLocation : Elab SourceLocation

468 getSourceLocation : Elab SourceLocation

432 getSourceLocation = Prim__SourceLocation

469 getSourceLocation = Prim__SourceLocation

433

470

434 ||| Attempt to solve the current goal with the source code location

471 ||| Attempt to solve the current goal with the source code location

472+ export

435 sourceLocation : Elab ()

473 sourceLocation : Elab ()

436 sourceLocation = do loc <- getSourceLocation

474 sourceLocation = do loc <- getSourceLocation

437 fill (quote loc)

475 fill (quote loc)

@@ -442,6 +480,7 @@ namespace Tactics

442 |||

480 |||

443 ||| The namespace is represented as a reverse-order list of strings,

481 ||| The namespace is represented as a reverse-order list of strings,

444 ||| just as in the representation of names.

482 ||| just as in the representation of names.

483+ export

445 currentNamespace : Elab (List String)

484 currentNamespace : Elab (List String)

446 currentNamespace = Prim__Namespace

485 currentNamespace = Prim__Namespace

447

486

@@ -455,16 +494,19 @@ namespace Tactics

455 ||| Because this tactic internally introduces a `let` binding, it

494 ||| Because this tactic internally introduces a `let` binding, it

456 ||| requires that the hole be immediately under its binder (use

495 ||| requires that the hole be immediately under its binder (use

457 ||| `attack` if it might not be).

496 ||| `attack` if it might not be).

497+ export

458 rewriteWith : Raw -> Elab ()

498 rewriteWith : Raw -> Elab ()

459 rewriteWith rule = Prim__Rewrite rule

499 rewriteWith rule = Prim__Rewrite rule

460

500

461 ||| Add a type declaration to the global context.

501 ||| Add a type declaration to the global context.

502+ export

462 declareType : TyDecl -> Elab ()

503 declareType : TyDecl -> Elab ()

463 declareType decl = Prim__DeclareType decl

504 declareType decl = Prim__DeclareType decl

464

505

465 ||| Define a function in the global context. The function must have

506 ||| Define a function in the global context. The function must have

466 ||| already been declared, either in ordinary Idris code or using

507 ||| already been declared, either in ordinary Idris code or using

467 ||| `declareType`.

508 ||| `declareType`.

509+ export

468 defineFunction : FunDefn Raw -> Elab ()

510 defineFunction : FunDefn Raw -> Elab ()

469 defineFunction defun = Prim__DefineFunction defun

511 defineFunction defun = Prim__DefineFunction defun

470

512

@@ -472,12 +514,14 @@ namespace Tactics

472 |||

514 |||

473 ||| @ ifaceName the name of the interface for which an implementation is being registered

515 ||| @ ifaceName the name of the interface for which an implementation is being registered

474 ||| @ instName the name of the definition to use in implementation search

516 ||| @ instName the name of the definition to use in implementation search

517+ export

475 addInstance : (ifaceName, instName : TTName) -> Elab ()

518 addInstance : (ifaceName, instName : TTName) -> Elab ()

476 addInstance ifaceName instName = Prim__AddInstance ifaceName instName

519 addInstance ifaceName instName = Prim__AddInstance ifaceName instName

477

520

478 ||| Determine whether a name denotes an interface.

521 ||| Determine whether a name denotes an interface.

479 |||

522 |||

480 ||| @ name a name that might denote an interface.

523 ||| @ name a name that might denote an interface.

524+ export

481 isTCName : (name : TTName) -> Elab Bool

525 isTCName : (name : TTName) -> Elab Bool

482 isTCName name = Prim__IsTCName name

526 isTCName name = Prim__IsTCName name

483

527

@@ -485,10 +529,12 @@ namespace Tactics

485 |||

529 |||

486 ||| @ fn the name of the definition being elaborated (to prevent Idris

530 ||| @ fn the name of the definition being elaborated (to prevent Idris

487 ||| from looping)

531 ||| from looping)

532+ export

488 resolveTC : (fn : TTName) -> Elab ()

533 resolveTC : (fn : TTName) -> Elab ()

489 resolveTC fn = Prim__ResolveTC fn

534 resolveTC fn = Prim__ResolveTC fn

490

535

491 ||| Use Idris's internal proof search.

536 ||| Use Idris's internal proof search.

537+ export

492 search : Elab ()

538 search : Elab ()

493 search = Prim__Search 100 []

539 search = Prim__Search 100 []

494

540

@@ -496,6 +542,7 @@ namespace Tactics

496 |||

542 |||

497 ||| @ depth the search depth

543 ||| @ depth the search depth

498 ||| @ hints additional names to try

544 ||| @ hints additional names to try

545+ export

499 search' : (depth : Int) -> (hints : List TTName) -> Elab ()

546 search' : (depth : Int) -> (hints : List TTName) -> Elab ()

500 search' depth hints = Prim__Search depth hints

547 search' depth hints = Prim__Search depth hints

501

548

@@ -505,6 +552,7 @@ namespace Tactics

505 ||| if the string is not a valid operator.

552 ||| if the string is not a valid operator.

506 |||

553 |||

507 ||| @ operator the operator string to look up

554 ||| @ operator the operator string to look up

555+ export

508 operatorFixity : (operator : String) -> Elab Fixity

556 operatorFixity : (operator : String) -> Elab Fixity

509 operatorFixity operator = Prim__Fixity operator

557 operatorFixity operator = Prim__Fixity operator

510

558

@@ -512,6 +560,7 @@ namespace Tactics

512 |||

560 |||

513 ||| This is intended for elaboration script developers, not for

561 ||| This is intended for elaboration script developers, not for

514 ||| end-users. Use `fail` for final scripts.

562 ||| end-users. Use `fail` for final scripts.

563+ export

515 debug : Elab a

564 debug : Elab a

516 debug = Prim__Debug []

565 debug = Prim__Debug []

517

566

@@ -522,18 +571,21 @@ namespace Tactics

522 ||| end-users. Use `fail` for final scripts.

571 ||| end-users. Use `fail` for final scripts.

523 |||

572 |||

524 ||| @ msg the message to display

573 ||| @ msg the message to display

574+ export

525 debugMessage : (msg : List ErrorReportPart) -> Elab a

575 debugMessage : (msg : List ErrorReportPart) -> Elab a

526 debugMessage msg = Prim__Debug msg

576 debugMessage msg = Prim__Debug msg

527

577

528 ||| Create a new top-level metavariable to solve the current hole.

578 ||| Create a new top-level metavariable to solve the current hole.

529 |||

579 |||

530 ||| @ name the name for the top-level variable

580 ||| @ name the name for the top-level variable

581+ export

531 metavar : (name : TTName) -> Elab ()

582 metavar : (name : TTName) -> Elab ()

532 metavar name = Prim__Metavar name

583 metavar name = Prim__Metavar name

533

584

534 ||| Recursively invoke the reflected elaborator with some goal.

585 ||| Recursively invoke the reflected elaborator with some goal.

535 |||

586 |||

536 ||| The result is the final term and its type.

587 ||| The result is the final term and its type.

588+ export

537 runElab : Raw -> Elab () -> Elab (TT, TT)

589 runElab : Raw -> Elab () -> Elab (TT, TT)

538 runElab goal script = Prim__RecursiveElab goal script

590 runElab goal script = Prim__RecursiveElab goal script

539

591

libs/prelude/Language/Reflection/Errors.idr+2

@@ -8,6 +8,8 @@ import Prelude.Bool

8import Prelude.List

9import Prelude.Maybe

10

11+%access public export

12+

11data Err = Msg String

13data Err = Msg String

12 | InternalMsg String

14 | InternalMsg String

13 | CantUnify Bool TT TT Err (List (TTName, TT)) Int

15 | CantUnify Bool TT TT Err (List (TTName, TT)) Int

libs/prelude/Prelude.idr+7−7

@@ -6,7 +6,7 @@ import public IO

6import public Prelude.Algebra

7import public Prelude.Basics

8import public Prelude.Bool

9−import public Prelude.Classes

9+import public Prelude.Interfaces

10import public Prelude.Cast

11import public Prelude.Nat

12import public Prelude.List

@@ -33,7 +33,7 @@ import public Language.Reflection

33import public Language.Reflection.Elab

34import public Language.Reflection.Errors

35

36−%access public

36+%access public export

37%default total

38

39-- Things that can't be elsewhere for import cycle reasons

@@ -210,7 +210,7 @@ Enum Int where

210Enum Char where

211 toNat c = toNat (ord c)

212 fromNat n = chr (fromNat n)

213−

213+

214 pred c = fromNat (pred (toNat c))

215

216syntax "[" [start] ".." [end] "]"

@@ -264,13 +264,13 @@ while t b = do v <- t

264------- Some error rewriting

265

266%language ErrorReflection

267−

267+

268private

269cast_part : TT -> ErrorReportPart

270cast_part (P Bound n t) = TextPart "unknown type"

271cast_part x = TermPart x

272−

272+

273−%error_handler

273+%error_handler export

274cast_error : Err -> Maybe (List ErrorReportPart)

275cast_error (CantResolve `(Cast ~x ~y))

276 = Just [TextPart "Can't cast from",

@@ -280,8 +280,8 @@ cast_error (CantResolve `(Cast ~x ~y))

280cast_error _ = Nothing

281

282%error_handler

283+export

283num_error : Err -> Maybe (List ErrorReportPart)

284num_error : Err -> Maybe (List ErrorReportPart)

284num_error (CantResolve `(Num ~x))

285num_error (CantResolve `(Num ~x))

285 = Just [TermPart x, TextPart "is not a numeric type"]

286 = Just [TermPart x, TextPart "is not a numeric type"]

286num_error _ = Nothing

287num_error _ = Nothing

287−

libs/prelude/Prelude/Algebra.idr+1−1

@@ -4,7 +4,7 @@ import Builtins

4

5infixl 6 <+>

6

7−%access public

7+%access public export

8

9--------------------------------------------------------------------------------

10-- A modest interface hierarchy

libs/prelude/Prelude/Applicative.idr+3−1

@@ -4,10 +4,12 @@ import Builtins

4

5import Prelude.Basics

6import Prelude.Bool

7−import Prelude.Classes

7+import Prelude.Interfaces

8import Prelude.Foldable

9import Prelude.Functor

10

11+%access public export

12+

11---- Applicative functors/Idioms

13---- Applicative functors/Idioms

12

14

13infixl 2 <*>

15infixl 2 <*>

libs/prelude/Prelude/Basics.idr+6−4

@@ -1,7 +1,9 @@

1module Prelude.Basics

2

3import Builtins

4−

4+

5+%access public export

6+

5Not : Type -> Type

7Not : Type -> Type

6Not a = a -> Void

8Not a = a -> Void

7

9

@@ -51,9 +53,9 @@ data Dec : Type -> Type where

51

53

52 ||| The case where the property holds

54 ||| The case where the property holds

53 ||| @ prf the proof

55 ||| @ prf the proof

54− Yes : {A : Type} -> (prf : A) -> Dec A

56+ Yes : (prf : prop) -> Dec prop

55

57

56 ||| The case where the property holding would be a contradiction

58 ||| The case where the property holding would be a contradiction

57− ||| @ contra a demonstration that A would be a contradiction

59+ ||| @ contra a demonstration that prop would be a contradiction

58− No : {A : Type} -> (contra : A -> Void) -> Dec A

60+ No : (contra : prop -> Void) -> Dec prop

59

61

libs/prelude/Prelude/Bits.idr+2−2

@@ -6,13 +6,13 @@ import Prelude.Basics

6import Prelude.Bool

7import Prelude.Cast

8import Prelude.Chars

9−import Prelude.Classes

9+import Prelude.Interfaces

10import Prelude.Foldable

11import Prelude.Nat

12import Prelude.List

13import Prelude.Strings

14

15−%access public

15+%access public export

16%default total

17

18b8ToString : Bits8 -> String

libs/prelude/Prelude/Bool.idr+2

@@ -4,6 +4,8 @@ import Builtins

4

5import Prelude.Uninhabited

6

7+%access public export

8+

7||| Boolean Data Type

9||| Boolean Data Type

8%case data Bool = False | True

10%case data Bool = False | True

9

11

libs/prelude/Prelude/Cast.idr+2

@@ -3,6 +3,8 @@ module Prelude.Cast

3import Prelude.Bool

4import public Builtins

5

6+%access public export

7+

6||| Interface for transforming an instance of a data type to another type.

8||| Interface for transforming an instance of a data type to another type.

7interface Cast from to where

9interface Cast from to where

8 ||| Perform a cast operation.

10 ||| Perform a cast operation.

libs/prelude/Prelude/Chars.idr+3−3

@@ -2,11 +2,13 @@ module Prelude.Chars

2-- Functions operating over Chars

3

4import Prelude.Bool

5−import Prelude.Classes

5+import Prelude.Interfaces

6import Prelude.List

7import Prelude.Cast

8import Builtins

9

10+%access public export

11+

10||| Convert the number to its ASCII equivalent.

12||| Convert the number to its ASCII equivalent.

11chr : Int -> Char

13chr : Int -> Char

12chr x = if (x >= 0 && x < 0x110000)

14chr x = if (x >= 0 && x < 0x110000)

@@ -74,5 +76,3 @@ isHexDigit x = elem (toUpper x) hexChars where

74||| Returns true if the character is an octal digit.

76||| Returns true if the character is an octal digit.

75isOctDigit : Char -> Bool

77isOctDigit : Char -> Bool

76isOctDigit x = (x >= '0' && x <= '7')

78isOctDigit x = (x >= '0' && x <= '7')

77−

78−

libs/prelude/Prelude/Doubles.idr+4−6

@@ -1,16 +1,16 @@

1−module Prelude.Doubles

1+module Prelude.Doubles

2

3import Builtins

4−import Prelude.Classes

4+import Prelude.Interfaces

5

6−%access public

6+%access public export

7%default total

8

9%include C "math.h"

10%lib C "m"

11

12pi : Double

13−pi = 3.14159265358979323846

13+pi = 3.14159265358979323846

14

15euler : Double

16euler = 2.7182818284590452354

@@ -59,5 +59,3 @@ floor x = prim__floatFloor x

59

60ceiling : Double -> Double

61ceiling x = prim__floatCeil x

62−

63−

libs/prelude/Prelude/Either.idr+3−1

@@ -4,10 +4,12 @@ import Builtins

4

5import Prelude.Basics

6import Prelude.Bool

7−import Prelude.Classes

7+import Prelude.Interfaces

8import Prelude.Maybe

9import Prelude.List

10

11+%access public export

12+

11||| A sum type

13||| A sum type

12%elim data Either : (a, b : Type) -> Type where

14%elim data Either : (a, b : Type) -> Type where

13 ||| One possibility of the sum, conventionally used to represent errors

15 ||| One possibility of the sum, conventionally used to represent errors

libs/prelude/Prelude/File.idr+35−8

@@ -9,15 +9,15 @@ import Prelude.Strings

9import Prelude.Cast

10import Prelude.Bool

11import Prelude.Basics

12−import Prelude.Classes

12+import Prelude.Interfaces

13import Prelude.Either

14import Prelude.Show

15import IO

16

17−%access public

17+%access public export

18

19||| A file handle

20−abstract

20+export

21data File : Type where

22 FHandle : (p : Ptr) -> File

23

@@ -39,7 +39,7 @@ strError err = unsafePerformIO -- yeah, yeah...

39 (foreign FFI_C "idris_showerror" (Int -> IO String) err)

40

41getFileError : IO FileError

42−getFileError = do MkRaw err <- foreign FFI_C "idris_mkFileError"

42+getFileError = do MkRaw err <- foreign FFI_C "idris_mkFileError"

43 (Ptr -> IO (Raw FileError)) prim__vm

44 return err

45

@@ -49,25 +49,31 @@ Show FileError where

49 show (GenericFileError errno) = strError errno

50

51||| Standard input

52+export

52stdin : File

53stdin : File

53stdin = FHandle prim__stdin

54stdin = FHandle prim__stdin

54

55

55||| Standard output

56||| Standard output

57+export

56stdout : File

58stdout : File

57stdout = FHandle prim__stdout

59stdout = FHandle prim__stdout

58

60

59||| Standard output

61||| Standard output

62+export

60stderr : File

63stderr : File

61stderr = FHandle prim__stderr

64stderr = FHandle prim__stderr

62

65

66+private

63do_ferror : Ptr -> IO Int

67do_ferror : Ptr -> IO Int

64do_ferror h = foreign FFI_C "fileError" (Ptr -> IO Int) h

68do_ferror h = foreign FFI_C "fileError" (Ptr -> IO Int) h

65

69

70+export

66ferror : File -> IO Bool

71ferror : File -> IO Bool

67ferror (FHandle h) = do err <- do_ferror h

72ferror (FHandle h) = do err <- do_ferror h

68 return (not (err == 0))

73 return (not (err == 0))

69

74

70||| Call the RTS's file opening function

75||| Call the RTS's file opening function

76+private

71do_fopen : String -> String -> IO Ptr

77do_fopen : String -> String -> IO Ptr

72do_fopen f m

78do_fopen f m

73 = foreign FFI_C "fileOpen" (String -> String -> IO Ptr) f m

79 = foreign FFI_C "fileOpen" (String -> String -> IO Ptr) f m

@@ -75,6 +81,7 @@ do_fopen f m

75||| Open a file

81||| Open a file

76||| @ f the filename

82||| @ f the filename

77||| @ m the mode as a String (`"r"`, `"w"`, or `"r+"`)

83||| @ m the mode as a String (`"r"`, `"w"`, or `"r+"`)

84+export

78fopen : (f : String) -> (m : String) -> IO (Either FileError File)

85fopen : (f : String) -> (m : String) -> IO (Either FileError File)

79fopen f m = do h <- do_fopen f m

86fopen f m = do h <- do_fopen f m

80 if !(nullPtr h)

87 if !(nullPtr h)

@@ -83,6 +90,7 @@ fopen f m = do h <- do_fopen f m

83 else return (Right (FHandle h))

90 else return (Right (FHandle h))

84

91

85||| Check whether a file handle is actually a null pointer

92||| Check whether a file handle is actually a null pointer

93+export

86validFile : File -> IO Bool

94validFile : File -> IO Bool

87validFile (FHandle h) = do x <- nullPtr h

95validFile (FHandle h) = do x <- nullPtr h

88 return (not x)

96 return (not x)

@@ -114,27 +122,34 @@ openFile f m = fopen f (modeStr m)

114openFileX : (f : String) -> (m : Mode) -> IO (Either FileError File)

122openFileX : (f : String) -> (m : Mode) -> IO (Either FileError File)

115openFileX f m = fopen f $ modeStr m ++ "x"

123openFileX f m = fopen f $ modeStr m ++ "x"

116

124

125+private

117do_fclose : Ptr -> IO ()

126do_fclose : Ptr -> IO ()

118do_fclose h = foreign FFI_C "fileClose" (Ptr -> IO ()) h

127do_fclose h = foreign FFI_C "fileClose" (Ptr -> IO ()) h

119

128

129+export

120closeFile : File -> IO ()

130closeFile : File -> IO ()

121closeFile (FHandle h) = do_fclose h

131closeFile (FHandle h) = do_fclose h

122

132

133+private

123do_fread : Ptr -> IO' l String

134do_fread : Ptr -> IO' l String

124do_fread h = prim_fread h

135do_fread h = prim_fread h

125

136

137+export

126fgetc : File -> IO (Either FileError Char)

138fgetc : File -> IO (Either FileError Char)

127fgetc (FHandle h) = do let c = cast !(foreign FFI_C "fgetc" (Ptr -> IO Int) h)

139fgetc (FHandle h) = do let c = cast !(foreign FFI_C "fgetc" (Ptr -> IO Int) h)

128 if !(ferror (FHandle h))

140 if !(ferror (FHandle h))

129 then return (Left FileReadError)

141 then return (Left FileReadError)

130 else return (Right c)

142 else return (Right c)

131

143

144+export

132fflush : File -> IO ()

145fflush : File -> IO ()

133fflush (FHandle h) = foreign FFI_C "fflush" (Ptr -> IO ()) h

146fflush (FHandle h) = foreign FFI_C "fflush" (Ptr -> IO ()) h

134

147

148+private

135do_popen : String -> String -> IO Ptr

149do_popen : String -> String -> IO Ptr

136do_popen f m = foreign FFI_C "do_popen" (String -> String -> IO Ptr) f m

150do_popen f m = foreign FFI_C "do_popen" (String -> String -> IO Ptr) f m

137

151

152+export

138popen : String -> Mode -> IO (Either FileError File)

153popen : String -> Mode -> IO (Either FileError File)

139popen f m = do ptr <- do_popen f (modeStr m)

154popen f m = do ptr <- do_popen f (modeStr m)

140 if !(nullPtr ptr)

155 if !(nullPtr ptr)

@@ -142,12 +157,14 @@ popen f m = do ptr <- do_popen f (modeStr m)

142 return (Left err)

157 return (Left err)

143 else return (Right (FHandle ptr))

158 else return (Right (FHandle ptr))

144

159

160+export

145pclose : File -> IO ()

161pclose : File -> IO ()

146pclose (FHandle h) = foreign FFI_C "pclose" (Ptr -> IO ()) h

162pclose (FHandle h) = foreign FFI_C "pclose" (Ptr -> IO ()) h

147

163

148-- mkForeign (FFun "idris_readStr" [FPtr, FPtr] (FAny String))

164-- mkForeign (FFun "idris_readStr" [FPtr, FPtr] (FAny String))

149-- prim__vm h

165-- prim__vm h

150

166

167+export

151fread : File -> IO (Either FileError String)

168fread : File -> IO (Either FileError String)

152fread (FHandle h) = do str <- do_fread h

169fread (FHandle h) = do str <- do_fread h

153 if !(ferror (FHandle h))

170 if !(ferror (FHandle h))

@@ -156,56 +173,65 @@ fread (FHandle h) = do str <- do_fread h

156

173

157||| Read a line from a file

174||| Read a line from a file

158||| @h a file handle which must be open for reading

175||| @h a file handle which must be open for reading

176+export

159fGetLine : (h : File) -> IO (Either FileError String)

177fGetLine : (h : File) -> IO (Either FileError String)

160fGetLine = fread

178fGetLine = fread

161

179

162%deprecate fread "Use fGetLine instead"

180%deprecate fread "Use fGetLine instead"

163

181

182+private

164do_fwrite : Ptr -> String -> IO (Either FileError ())

183do_fwrite : Ptr -> String -> IO (Either FileError ())

165do_fwrite h s = do res <- prim_fwrite h s

184do_fwrite h s = do res <- prim_fwrite h s

166 if (res /= 0)

185 if (res /= 0)

167 then do errno <- getErrno

186 then do errno <- getErrno

168− if errno == 0

187+ if errno == 0

169 then return (Left FileWriteError)

188 then return (Left FileWriteError)

170 else do err <- getFileError

189 else do err <- getFileError

171 return (Left err)

190 return (Left err)

172 else return (Right ())

191 else return (Right ())

173

192

193+export

174fwrite : File -> String -> IO (Either FileError ())

194fwrite : File -> String -> IO (Either FileError ())

175fwrite (FHandle h) s = do_fwrite h s

195fwrite (FHandle h) s = do_fwrite h s

176

196

177||| Write a line to a file

197||| Write a line to a file

178||| @h a file handle which must be open for writing

198||| @h a file handle which must be open for writing

179||| @str the line to write to the file

199||| @str the line to write to the file

200+export

180fPutStr : (h : File) -> (str : String) -> IO (Either FileError ())

201fPutStr : (h : File) -> (str : String) -> IO (Either FileError ())

181fPutStr (FHandle h) s = do_fwrite h s

202fPutStr (FHandle h) s = do_fwrite h s

182

203

204+export

183fPutStrLn : File -> String -> IO (Either FileError ())

205fPutStrLn : File -> String -> IO (Either FileError ())

184fPutStrLn (FHandle h) s = do_fwrite h (s ++ "\n")

206fPutStrLn (FHandle h) s = do_fwrite h (s ++ "\n")

185

207

186%deprecate fwrite "Use fPutStr instead"

208%deprecate fwrite "Use fPutStr instead"

187

209

210+private

188do_feof : Ptr -> IO Int

211do_feof : Ptr -> IO Int

189do_feof h = foreign FFI_C "fileEOF" (Ptr -> IO Int) h

212do_feof h = foreign FFI_C "fileEOF" (Ptr -> IO Int) h

190

213

191||| Check if a file handle has reached the end

214||| Check if a file handle has reached the end

215+export

192fEOF : File -> IO Bool

216fEOF : File -> IO Bool

193fEOF (FHandle h) = do eof <- do_feof h

217fEOF (FHandle h) = do eof <- do_feof h

194 return (not (eof == 0))

218 return (not (eof == 0))

195

219

196||| Check if a file handle has reached the end

220||| Check if a file handle has reached the end

221+export

197feof : File -> IO Bool

222feof : File -> IO Bool

198feof = fEOF

223feof = fEOF

199

224

200%deprecate feof "Use fEOF instead"

225%deprecate feof "Use fEOF instead"

201

226

227+export

202fpoll : File -> IO Bool

228fpoll : File -> IO Bool

203fpoll (FHandle h) = do p <- foreign FFI_C "fpoll" (Ptr -> IO Int) h

229fpoll (FHandle h) = do p <- foreign FFI_C "fpoll" (Ptr -> IO Int) h

204 return (p > 0)

230 return (p > 0)

205

231

206||| Read the contents of a file into a string

232||| Read the contents of a file into a string

207−partial -- might be reading something infinitely long like /dev/null ...

233+partial -- might be reading something infinitely long like /dev/null ...

208−covering

234+covering export

209readFile : String -> IO (Either FileError String)

235readFile : String -> IO (Either FileError String)

210readFile fn = do Right h <- openFile fn Read

236readFile fn = do Right h <- openFile fn Read

211 | Left err => return (Left err)

237 | Left err => return (Left err)

@@ -223,7 +249,8 @@ readFile fn = do Right h <- openFile fn Read

223 else return (Right contents)

249 else return (Right contents)

224

250

225||| Write a string to a file

251||| Write a string to a file

252+export

226−writeFile : (filepath : String) -> (contents : String) ->

253+writeFile : (filepath : String) -> (contents : String) ->

227 IO (Either FileError ())

254 IO (Either FileError ())

228writeFile fn contents = do

255writeFile fn contents = do

229 Right h <- openFile fn Write | Left err => return (Left err)

256 Right h <- openFile fn Write | Left err => return (Left err)

libs/prelude/Prelude/Foldable.idr+4−5

@@ -3,15 +3,15 @@ module Prelude.Foldable

3import Builtins

4import Prelude.Bool

5import Prelude.Basics

6−import Prelude.Classes

6+import Prelude.Interfaces

7import Prelude.Algebra

8

9−%access public

9+%access public export

10%default total

11

12interface Foldable (t : Type -> Type) where

13− foldr : (elt -> acc -> acc) -> acc -> t elt -> acc

13+ foldr : (elem -> acc -> acc) -> acc -> t elem -> acc

14− foldl : (acc -> elt -> acc) -> acc -> t elt -> acc

14+ foldl : (acc -> elem -> acc) -> acc -> t elem -> acc

15 foldl f z t = foldr (flip (.) . flip f) id t z

16

17||| Combine each element of a structure into a monoid

@@ -54,4 +54,3 @@ sum = foldr (+) 0

54||| Multiply together all elements of a structure

55product : (Foldable t, Num a) => t a -> a

56product = foldr (*) 1

57−

libs/prelude/Prelude/Functor.idr+7−5

@@ -2,21 +2,23 @@ module Prelude.Functor

2

3import Prelude.Basics

4

5+%access public export

6+

5||| Functors allow a uniform action over a parameterised type.

7||| Functors allow a uniform action over a parameterised type.

6||| @ f a parameterised type

8||| @ f a parameterised type

7interface Functor (f : Type -> Type) where

9interface Functor (f : Type -> Type) where

8 ||| Apply a function across everything of type 'a' in a

10 ||| Apply a function across everything of type 'a' in a

9 ||| parameterised type

11 ||| parameterised type

10 ||| @ f the parameterised type

12 ||| @ f the parameterised type

11− ||| @ m the function to apply

13+ ||| @ func the function to apply

12− map : (m : a -> b) -> f a -> f b

14+ map : (func : a -> b) -> f a -> f b

13

15

14infixl 4 <$>

16infixl 4 <$>

15

17

16||| An infix alias for `map`, applying a function across everything of

18||| An infix alias for `map`, applying a function across everything of

17||| type 'a' in a parameterised type

19||| type 'a' in a parameterised type

18||| @ f the parameterised type

20||| @ f the parameterised type

19−||| @ m the function to apply

21+||| @ func the function to apply

20−(<$>) : Functor f => (m : a -> b) -> f a -> f b

22+(<$>) : Functor f => (func : a -> b) -> f a -> f b

21−m <$> x = map m x

23+func <$> x = map func x

22

24

libs/prelude/Prelude/Interactive.idr+18−19

@@ -1,5 +1,5 @@

1||| Various helper functions for creating simple interactive systems.

2−|||

2+|||

3||| These are mostly intended for helping with teaching, in that they will allow

4||| the easy creation of interactive programs without needing to teach IO

5||| or Effects first, but they also capture some common patterns of interactive

@@ -10,7 +10,7 @@ import Builtins

10import Prelude.List

11import Prelude.File

12import Prelude.Bool

13−import Prelude.Classes

13+import Prelude.Interfaces

14import Prelude.Strings

15import Prelude.Chars

16import Prelude.Show

@@ -21,7 +21,7 @@ import Prelude.Either

21import Prelude.Monad

22import IO

23

24−%access public

24+%access public export

25

26---- some basic io

27

@@ -115,19 +115,19 @@ getArgs = do n <- numArgs

115||| @ onEOF the function to run on reaching end of file, returning a String

116||| to output

117partial

118−processHandle : File ->

118+processHandle : File ->

119 (state : a) ->

120− (onRead : a -> String -> (String, a)) ->

120+ (onRead : a -> String -> (String, a)) ->

121− (onEOF : a -> String) ->

121+ (onEOF : a -> String) ->

122 IO ()

123−processHandle h acc onRead onEOF

123+processHandle h acc onRead onEOF

124 = if !(fEOF h)

125 then putStr (onEOF acc)

126 else do Right x <- fGetLine h

127 | Left err => putStr (onEOF acc)

128 let (out, acc') = onRead acc x

129 putStr out

130− processHandle h acc' onRead onEOF

130+ processHandle h acc' onRead onEOF

131

132||| Process input from the standard input stream, while maintaining a state.

133||| @ state the input state

@@ -136,34 +136,33 @@ processHandle h acc onRead onEOF

136||| @ onEOI the function to run on reaching end of input, returning a String

137||| to output

138partial

139−processStdin : (state : a) ->

139+processStdin : (state : a) ->

140− (onRead : a -> String -> (String, a)) ->

140+ (onRead : a -> String -> (String, a)) ->

141 (onEOI : a -> String) -> IO ()

142processStdin = processHandle stdin

143

144||| A basic read-eval-print loop, maintaining a state

145||| @ state the input state

146−||| @ prompt the prompt to show

146+||| @ prompt the prompt to show

147||| @ onInput the function to run on reading input, returning a String to

148||| output and a new state. Returns Nothing if the repl should exit

149partial

150−replWith : (state : a) -> (prompt : String) ->

150+replWith : (state : a) -> (prompt : String) ->

151 (onInput : a -> String -> Maybe (String, a)) -> IO ()

152−replWith acc prompt fn

152+replWith acc prompt fn

153 = do putStr prompt

154 x <- getLine

155 case fn acc x of

156− Just (out, acc') => do putStr out

156+ Just (out, acc') => do putStr out

157 replWith acc' prompt fn

158 Nothing => return ()

159

160||| A basic read-eval-print loop

161−||| @ prompt the prompt to show

161+||| @ prompt the prompt to show

162||| @ onInput the function to run on reading input, returning a String to

163−||| output

163+||| output

164partial

165−repl : (prompt : String) ->

165+repl : (prompt : String) ->

166 (onInput : String -> String) -> IO ()

167−repl prompt fn

167+repl prompt fn

168 = replWith () prompt (\x, s => Just (fn s, ()))

169−

libs/prelude/Prelude/Classes.idr → libs/prelude/Prelude/Interfaces.idrrenamed+11−11

@@ -1,9 +1,11 @@

1−module Prelude.Classes

1+module Prelude.Interfaces

2

3import Builtins

4import Prelude.Basics

5import Prelude.Bool

6

7+%access public export

8+

7-- Numerical Operator Precedence

9-- Numerical Operator Precedence

8infixl 5 ==, /=

10infixl 5 ==, /=

9infixl 6 <, <=, >, >=

11infixl 6 <, <=, >, >=

@@ -57,7 +59,7 @@ Eq Bool where

57 True == False = False

59 True == False = False

58 False == True = False

60 False == True = False

59 False == False = True

61 False == False = True

60−

62+

61(Eq a, Eq b) => Eq (a, b) where

63(Eq a, Eq b) => Eq (a, b) where

62 (==) (a, c) (b, d) = (a == b) && (c == d)

64 (==) (a, c) (b, d) = (a == b) && (c == d)

63

65

@@ -357,7 +359,7 @@ divB8 x y = case y == 0 of

357modB8 : Bits8 -> Bits8 -> Bits8

359modB8 : Bits8 -> Bits8 -> Bits8

358modB8 x y = case y == 0 of

360modB8 x y = case y == 0 of

359 False => prim__sremB8 x y

361 False => prim__sremB8 x y

360−

362+

361Integral Bits8 where

363Integral Bits8 where

362 div = divB8

364 div = divB8

363 mod = modB8

365 mod = modB8

@@ -372,8 +374,8 @@ modB16 x y = case y == 0 of

372 False => prim__sremB16 x y

374 False => prim__sremB16 x y

373

375

374Integral Bits16 where

376Integral Bits16 where

375− div = divB16

377+ div = divB16

376− mod = modB16

378+ mod = modB16

377

379

378-- ------------------------------------------------------------------ [ Bits32 ]

380-- ------------------------------------------------------------------ [ Bits32 ]

379divB32 : Bits32 -> Bits32 -> Bits32

381divB32 : Bits32 -> Bits32 -> Bits32

@@ -385,8 +387,8 @@ modB32 x y = case y == 0 of

385 False => prim__sremB32 x y

387 False => prim__sremB32 x y

386

388

387Integral Bits32 where

389Integral Bits32 where

388− div = divB32

390+ div = divB32

389− mod = modB32

391+ mod = modB32

390

392

391-- ------------------------------------------------------------------ [ Bits64 ]

393-- ------------------------------------------------------------------ [ Bits64 ]

392divB64 : Bits64 -> Bits64 -> Bits64

394divB64 : Bits64 -> Bits64 -> Bits64

@@ -398,7 +400,5 @@ modB64 x y = case y == 0 of

398 False => prim__sremB64 x y

400 False => prim__sremB64 x y

399

401

400Integral Bits64 where

402Integral Bits64 where

401− div = divB64

403+ div = divB64

402− mod = modB64

404+ mod = modB64

403−

404−

libs/prelude/Prelude/List.idr+5−6

@@ -5,14 +5,14 @@ import Builtins

5import Prelude.Algebra

6import Prelude.Basics

7import Prelude.Bool

8−import Prelude.Classes

8+import Prelude.Interfaces

9import Prelude.Foldable

10import Prelude.Functor

11import Prelude.Maybe

12import Prelude.Uninhabited

13import Prelude.Nat

14

15−%access public

15+%access public export

16%default total

17

18infix 5 \\

@@ -174,7 +174,7 @@ init' [] = Nothing

174init' (x::xs) =

175 case xs of

176 [] => Just []

177− y::ys =>

177+ y::ys =>

178 case init' $ y::ys of

179 Nothing => Nothing

180 Just j => Just $ x :: j

@@ -305,7 +305,7 @@ zipWith f (x::xs) (y::ys) = f x y :: zipWith f xs ys

305||| @ z the third list

306zipWith3 : (f : a -> b -> c -> d) -> (x : List a) -> (y : List b) ->

307 (z : List c) -> List d

308−zipWith3 f _ [] (z::zs) = []

308+zipWith3 f _ [] (z::zs) = []

309zipWith3 f _ (y::ys) [] = []

310zipWith3 f [] (y::ys) _ = []

311zipWith3 f (x::xs) [] _ = []

@@ -761,7 +761,7 @@ mergeBy : (a -> a -> Ordering) -> List a -> List a -> List a

761mergeBy order [] right = right

762mergeBy order left [] = left

763mergeBy order (x::xs) (y::ys) =

764− if order x y == LT

764+ if order x y == LT

765 then x :: mergeBy order xs (y::ys)

766 else y :: mergeBy order (x::xs) ys

767

@@ -888,4 +888,3 @@ foldlAsFoldr f z t = foldr (flip (.) . flip f) id t z

888foldlMatchesFoldr : (f : b -> a -> b) -> (q : b) -> (xs : List a) -> foldl f q xs = foldlAsFoldr f q xs

889foldlMatchesFoldr f q [] = Refl

890foldlMatchesFoldr f q (x :: xs) = foldlMatchesFoldr f (f q x) xs

891−

libs/prelude/Prelude/Maybe.idr+2−2

@@ -5,10 +5,10 @@ import Prelude.Algebra

5import Prelude.Basics

6import Prelude.Bool

7import Prelude.Cast

8−import Prelude.Classes

8+import Prelude.Interfaces

9import Prelude.Foldable

10

11−%access public

11+%access public export

12%default total

13

14||| An optional value. This can be used to represent the possibility of

libs/prelude/Prelude/Monad.idr+1−1

@@ -8,7 +8,7 @@ import Prelude.Applicative

8import Prelude.Basics

9import IO

10

11−%access public

11+%access public export

12

13infixl 5 >>=

14

libs/prelude/Prelude/Nat.idr+18−19

@@ -6,10 +6,10 @@ import Prelude.Algebra

6import Prelude.Basics

7import Prelude.Bool

8import Prelude.Cast

9−import Prelude.Classes

9+import Prelude.Interfaces

10import Prelude.Uninhabited

11

12−%access public

12+%access public export

13%default total

14

15||| Natural numbers: unbounded, unsigned integers which can be pattern

@@ -224,9 +224,9 @@ record Multiplicative where

224

225||| A wrapper for Nat that specifies the semigroup and monad implementations that use (+)

226record Additive where

227− constructor GetAdditive

227+ constructor GetAdditive

228 _ : Nat

229−

229+

230Semigroup Multiplicative where

231 (<+>) left right = GetMultiplicative $ left' * right'

232 where

@@ -424,7 +424,7 @@ total plusCommutative : (left : Nat) -> (right : Nat) ->

424plusCommutative Z right = rewrite plusZeroRightNeutral right in Refl

425plusCommutative (S left) right =

426 let inductiveHypothesis = plusCommutative left right in

427− rewrite inductiveHypothesis in

427+ rewrite inductiveHypothesis in

428 rewrite plusSuccRightSucc right left in Refl

429

430total plusAssociative : (left : Nat) -> (centre : Nat) -> (right : Nat) ->

@@ -450,21 +450,21 @@ total plusLeftCancel : (left : Nat) -> (right : Nat) -> (right' : Nat) ->

450plusLeftCancel Z right right' p = p

451plusLeftCancel (S left) right right' p =

452 let inductiveHypothesis = plusLeftCancel left right right' in

453− inductiveHypothesis (succInjective _ _ p)

453+ inductiveHypothesis (succInjective _ _ p)

454

455total plusRightCancel : (left : Nat) -> (left' : Nat) -> (right : Nat) ->

456 (p : left + right = left' + right) -> left = left'

457plusRightCancel left left' Z p = rewrite sym (plusZeroRightNeutral left) in

458 rewrite sym (plusZeroRightNeutral left') in

459− p

459+ p

460plusRightCancel left left' (S right) p =

461− plusRightCancel left left' right

461+ plusRightCancel left left' right

462− (succInjective _ _ (rewrite plusSuccRightSucc left right in

462+ (succInjective _ _ (rewrite plusSuccRightSucc left right in

463 rewrite plusSuccRightSucc left' right in p))

464

465total plusLeftLeftRightZero : (left : Nat) -> (right : Nat) ->

466 (p : left + right = left) -> right = Z

467−plusLeftLeftRightZero Z right p = p

467+plusLeftLeftRightZero Z right p = p

468plusLeftLeftRightZero (S left) right p =

469 plusLeftLeftRightZero left right (succInjective _ _ p)

470

@@ -481,7 +481,7 @@ total multRightSuccPlus : (left : Nat) -> (right : Nat) ->

481multRightSuccPlus Z right = Refl

482multRightSuccPlus (S left) right =

483 let inductiveHypothesis = multRightSuccPlus left right in

484− rewrite inductiveHypothesis in

484+ rewrite inductiveHypothesis in

485 rewrite plusAssociative left right (mult left right) in

486 rewrite plusAssociative right left (mult left right) in

487 rewrite plusCommutative right left in

@@ -493,11 +493,11 @@ multLeftSuccPlus left right = Refl

493

494total multCommutative : (left : Nat) -> (right : Nat) ->

495 left * right = right * left

496−multCommutative Z right = rewrite multZeroRightZero right in Refl

496+multCommutative Z right = rewrite multZeroRightZero right in Refl

497multCommutative (S left) right =

498 let inductiveHypothesis = multCommutative left right in

499 rewrite inductiveHypothesis in

500− rewrite multRightSuccPlus right left in

500+ rewrite multRightSuccPlus right left in

501 Refl

502

503total multDistributesOverPlusRight : (left : Nat) -> (centre : Nat) -> (right : Nat) ->

@@ -505,7 +505,7 @@ total multDistributesOverPlusRight : (left : Nat) -> (centre : Nat) -> (right :

505multDistributesOverPlusRight Z centre right = Refl

506multDistributesOverPlusRight (S left) centre right =

507 let inductiveHypothesis = multDistributesOverPlusRight left centre right in

508− rewrite inductiveHypothesis in

508+ rewrite inductiveHypothesis in

509 rewrite plusAssociative (plus centre (mult left centre)) right (mult left right) in

510 rewrite sym (plusAssociative centre (mult left centre) right) in

511 rewrite plusCommutative (mult left centre) right in

@@ -527,7 +527,7 @@ total multAssociative : (left : Nat) -> (centre : Nat) -> (right : Nat) ->

527multAssociative Z centre right = Refl

528multAssociative (S left) centre right =

529 let inductiveHypothesis = multAssociative left centre right in

530− rewrite inductiveHypothesis in

530+ rewrite inductiveHypothesis in

531 rewrite multDistributesOverPlusLeft centre (mult left centre) right in

532 Refl

533

@@ -619,7 +619,7 @@ powerSuccPowerLeft base exp = Refl

619

620total multPowerPowerPlus : (base : Nat) -> (exp : Nat) -> (exp' : Nat) ->

621 (power base exp) * (power base exp') = power base (exp + exp')

622−multPowerPowerPlus base Z exp' =

622+multPowerPowerPlus base Z exp' =

623 rewrite sym (plusZeroRightNeutral (power base exp')) in Refl

624multPowerPowerPlus base (S exp) exp' =

625 let inductiveHypothesis = multPowerPowerPlus base exp exp' in

@@ -651,7 +651,7 @@ total powerPowerMultPower : (base : Nat) -> (exp : Nat) -> (exp' : Nat) ->

651powerPowerMultPower base exp Z = rewrite multZeroRightZero exp in Refl

652powerPowerMultPower base exp (S exp') =

653 let inductiveHypothesis = powerPowerMultPower base exp exp' in

654− rewrite inductiveHypothesis in

654+ rewrite inductiveHypothesis in

655 rewrite multRightSuccPlus exp exp' in

656 rewrite sym (multPowerPowerPlus base exp (mult exp exp')) in

657 Refl

@@ -664,7 +664,7 @@ total minusSuccPred : (left : Nat) -> (right : Nat) ->

664 minus left (S right) = pred (minus left right)

665minusSuccPred Z right = Refl

666minusSuccPred (S left) Z =

667− rewrite minusZeroRight left in Refl

667+ rewrite minusZeroRight left in Refl

668minusSuccPred (S left) (S right) =

669 let inductiveHypothesis = minusSuccPred left right in

670 rewrite inductiveHypothesis in Refl

@@ -782,4 +782,3 @@ sucMinL (S l) = cong (sucMinL l)

782total sucMinR : (l : Nat) -> minimum l (S l) = l

783sucMinR Z = Refl

784sucMinR (S l) = cong (sucMinR l)

785−

libs/prelude/Prelude/Pairs.idr+1−1

@@ -2,7 +2,7 @@ module Prelude.Pairs

2

3import Builtins

4

5−%access public

5+%access public export

6%default total

7

8swap : (a, b) -> (b, a)

libs/prelude/Prelude/Providers.idr+3−1

@@ -4,8 +4,10 @@ import Prelude.Functor

4import Prelude.Applicative

5import Prelude.Monad

6

7+%access public export

8+

7||| Type providers must build one of these in an IO computation.

9||| Type providers must build one of these in an IO computation.

8−public

10+public export

9data Provider : (a : Type) -> Type where

11data Provider : (a : Type) -> Type where

10 ||| Return a term to be spliced in

12 ||| Return a term to be spliced in

11 ||| @ x the term to be spliced (i.e. the proof)

13 ||| @ x the term to be spliced (i.e. the proof)

libs/prelude/Prelude/Show.idr+3−2

@@ -7,13 +7,15 @@ import Prelude.Bits

7import Prelude.Bool

8import Prelude.Cast

9import Prelude.Chars

10−import Prelude.Classes

10+import Prelude.Interfaces

11import Prelude.List

12import Prelude.Maybe

13import Prelude.Either

14import Prelude.Nat

15import Prelude.Strings

16

17+%access public export

18+

17%default total

19%default total

18

20

19||| The precedence of an Idris operator or syntactic context.

21||| The precedence of an Idris operator or syntactic context.

@@ -192,4 +194,3 @@ Show a => Show (Maybe a) where

192

194

193(Show a, {y : a} -> Show (p y)) => Show (Sigma a p) where

195(Show a, {y : a} -> Show (p y)) => Show (Sigma a p) where

194 show (y ** prf) = "(" ++ show y ++ " ** " ++ show prf ++ ")"

196 show (y ** prf) = "(" ++ show y ++ " ** " ++ show prf ++ ")"

195−

libs/prelude/Prelude/Stream.idr+1−1

@@ -9,7 +9,7 @@ import Prelude.Monad

9import Prelude.Nat

10import Prelude.List

11

12−%access public

12+%access public export

13%default total

14

15||| An infinite stream

libs/prelude/Prelude/Strings.idr+4−3

@@ -8,7 +8,7 @@ import Prelude.Basics

8import Prelude.Bool

9import Prelude.Chars

10import Prelude.Cast

11−import Prelude.Classes

11+import Prelude.Interfaces

12import Prelude.Either

13import Prelude.Foldable

14import Prelude.Functor

@@ -17,6 +17,8 @@ import Prelude.Nat

17import Prelude.Monad

18import Decidable.Equality

19

20+%access public export

21+

20partial

22partial

21foldr1 : (a -> a -> a) -> List a -> a

23foldr1 : (a -> a -> a) -> List a -> a

22foldr1 _ [x] = x

24foldr1 _ [x] = x

@@ -112,7 +114,7 @@ strTail' x p = assert_total $ prim__strTail x

112-- we need the 'believe_me' because the operations are primitives

114-- we need the 'believe_me' because the operations are primitives

113strM : (x : String) -> StrM x

115strM : (x : String) -> StrM x

114strM x with (decEq (not (x == "")) True)

116strM x with (decEq (not (x == "")) True)

115− strM x | (Yes p) = really_believe_me $

117+ strM x | (Yes p) = really_believe_me $

116 StrCons (assert_total (strHead' x p))

118 StrCons (assert_total (strHead' x p))

117 (assert_total (strTail' x p))

119 (assert_total (strTail' x p))

118 strM x | (No p) = really_believe_me StrNil

120 strM x | (No p) = really_believe_me StrNil

@@ -364,4 +366,3 @@ partial

364nullStr : String -> IO Bool

366nullStr : String -> IO Bool

365nullStr p = do ok <- foreign FFI_C "isNull" (String -> IO Int) p

367nullStr p = do ok <- foreign FFI_C "isNull" (String -> IO Int) p

366 return (ok /= 0)

368 return (ok /= 0)

367−

libs/prelude/Prelude/Traversable.idr+2

@@ -7,6 +7,8 @@ import Prelude.Applicative

7import Prelude.Foldable

8import Prelude.Functor

9

10+%access public export

11+

10traverse_ : (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()

12traverse_ : (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()

11traverse_ f = foldr ((*>) . f) (pure ())

13traverse_ f = foldr ((*>) . f) (pure ())

12

14

libs/prelude/Prelude/Uninhabited.idr+2

@@ -5,6 +5,8 @@ module Prelude.Uninhabited

5

6import Builtins

7

8+%access public export

9+

8||| A canonical proof that some type is empty

10||| A canonical proof that some type is empty

9interface Uninhabited t where

11interface Uninhabited t where

10 ||| If I have a t, I've had a contradiction

12 ||| If I have a t, I've had a contradiction

libs/prelude/prelude.ipkg+1−2

@@ -4,7 +4,7 @@ opts = "--nobuiltins --total --no-elim-deprecation-warnings"

4modules = Builtins, Prelude, IO,

5

6 Prelude.Algebra, Prelude.Basics, Prelude.Bool, Prelude.Cast,

7− Prelude.Classes, Prelude.Nat, Prelude.List,

7+ Prelude.Interfaces, Prelude.Nat, Prelude.List,

8 Prelude.Maybe, Prelude.Monad, Prelude.Applicative, Prelude.Either,

9 Prelude.Strings, Prelude.Chars, Prelude.Show, Prelude.Functor,

10 Prelude.Foldable, Prelude.Traversable, Prelude.Bits, Prelude.Stream,

@@ -14,4 +14,3 @@ modules = Builtins, Prelude, IO,

14 Language.Reflection, Language.Reflection.Errors, Language.Reflection.Elab,

15

16 Decidable.Equality

17−

libs/pruviloj/Pruviloj/Core.idr+2

@@ -5,6 +5,8 @@ module Pruviloj.Core

5

6import Language.Reflection.Utils

7

8+%access public export

9+

8||| Run something for effects, throwing away the return value

10||| Run something for effects, throwing away the return value

9ignore : Functor f => f a -> f ()

11ignore : Functor f => f a -> f ()

10ignore x = map (const ()) x

12ignore x = map (const ()) x

libs/pruviloj/Pruviloj/Derive/DecEq.idr+1−1

@@ -133,7 +133,7 @@ mkRhs fn fam k =

133||| equality.

134|||

135||| @ fn the name of the function whose type has been declared

136−abstract partial -- because of mkRhs

136+export partial -- because of mkRhs

137deriveDecEq : (fn : TTName) -> Elab ()

138deriveDecEq fn =

139 do (_, Ref, sig') <- lookupTyExact fn

libs/pruviloj/Pruviloj/Derive/Eliminators.idr+1−1

@@ -248,7 +248,7 @@ getElimClauses info elimn ctors =

248 in traverse (\(i, con) => getElimClause info elimn methodCount con i)

249 (enumerate ctors)

250

251−abstract

251+export

252deriveElim : (tyn, elimn : TTName) -> Elab ()

253deriveElim tyn elimn =

254 do -- Begin with some basic sanity checking: the type name uniquely

libs/pruviloj/Pruviloj/Disjoint.idr+1−1

@@ -67,7 +67,7 @@ getDisjointness l r = exists <|> declare

67

68||| Solve a goal of the form `(C1 x1 x2 ... xn = C2 x1 x2 ... xn) ->

69||| Void` for disjoint constructors `C1` and `C2`.

70−public covering

70+public export covering

71disjoint : Elab ()

72disjoint =

73 do compute

libs/pruviloj/Pruviloj/Induction.idr+1−1

@@ -125,7 +125,7 @@ makeMotive info sub subjTy goal =

125

126||| Perform induction on some expression to solve the current

127||| goal. Return a list of new holes to be solved.

128−public

128+public export

129induction : Raw -> Elab (List TTName)

130induction subj =

131 do g <- goalType

libs/pruviloj/Pruviloj/Injective.idr+1−1

@@ -92,7 +92,7 @@ countBinders _ = Z

92|||

93||| @ tm the equality to exploit injectivity on

94||| @ n the name at which to bind the result

95−covering public

95+covering public export

96injective : (tm : Raw) -> (n : TTName) -> Elab ()

97injective tm n =

98 do (_, ty) <- check !getEnv tm

libs/pruviloj/Pruviloj/Internals.idr+2

@@ -7,6 +7,8 @@ import Pruviloj.Renamers

7

8import Data.Vect

9

10+%access public export

11+

10||| Get the name of a reflected type constructor argument.

12||| Get the name of a reflected type constructor argument.

11tyConArgName : TyConArg -> TTName

13tyConArgName : TyConArg -> TTName

12tyConArgName (TyConParameter a) = name a

14tyConArgName (TyConParameter a) = name a

libs/pruviloj/Pruviloj/Internals/TyConInfo.idr+1−1

@@ -6,7 +6,7 @@ import Pruviloj.Renamers

6

7import Language.Reflection.Utils

8

9−

9+%access public export

10

11||| A representation of a type constructor in which all argument names

12||| are made unique and they are separated into params and then

libs/pruviloj/Pruviloj/Renamers.idr+2

@@ -2,6 +2,8 @@ module Pruviloj.Renamers

2

3import Language.Reflection.Utils

4

5+%access public export

6+

5||| A renamer keeps track of names to be substituted

7||| A renamer keeps track of names to be substituted

6Renamer : Type

8Renamer : Type

7Renamer = TTName -> Maybe TTName

9Renamer = TTName -> Maybe TTName

samples/tutorial/interp.idr+1−1

@@ -33,7 +33,7 @@ using (G : Vect n Ty)

33 Expr G c

34 If : Expr G TyBool -> Lazy (Expr G a) -> Lazy (Expr G a) -> Expr G a

35

36− interp : Env G -> [static] (e : Expr G t) -> interpTy t

36+ interp : Env G -> %static (e : Expr G t) -> interpTy t

37 interp env (Var i) = lookup i env

38 interp env (Val x) = x

39 interp env (Lam sc) = \x => interp (x :: env) sc

src/IRTS/Compiler.hs+1−1

@@ -462,7 +462,7 @@ doForeign vs env (ret : fname : world : args)

462 = do let l' = toFDesc l

463 r' <- irTerm vs env r

464 return (l', r')

465− splitArg _ = ifail "Badly formed foreign function call"

465+ splitArg _ = ifail $ "Badly formed foreign function call"

466

467 toFDesc (Constant (Str str)) = FStr str

468 toFDesc tm

src/IRTS/System.hs+3−7

@@ -21,10 +21,7 @@ getCC :: IO String

21getCC = fromMaybe "gcc" <$> environment "IDRIS_CC"

22

23getEnvFlags :: IO [String]

24−getEnvFlags = do flags <- environment "IDRIS_CFLAGS"

24+getEnvFlags = maybe [] (splitOn " ") <$> environment "IDRIS_CFLAGS"

25− case flags of

26− Nothing -> return $ []

27− Just s -> return $ splitOn " " s

28

25

29mvnCommand :: String

26mvnCommand :: String

30#ifdef mingw32_HOST_OS

27#ifdef mingw32_HOST_OS

@@ -37,9 +34,8 @@ getMvn :: IO String

37getMvn = fromMaybe mvnCommand <$> environment "IDRIS_MVN"

34getMvn = fromMaybe mvnCommand <$> environment "IDRIS_MVN"

38

35

39environment :: String -> IO (Maybe String)

36environment :: String -> IO (Maybe String)

40−environment x = catchIO (do e <- getEnv x

37+environment x = catchIO (Just <$> getEnv x)

41− return (Just e))

42− (\_ -> return Nothing)

38+ (\_ -> return Nothing)

43

39

44getTargetDir :: IO String

40getTargetDir :: IO String

45getTargetDir = environment "TARGET" >>= maybe getDataDir return

41getTargetDir = environment "TARGET" >>= maybe getDataDir return

src/Idris/ASTUtils.hs+1−4

@@ -118,17 +118,14 @@ opt_detaggable = Field detaggable (\v opt -> opt{ detaggable = v })

118ist_callgraph :: Name -> Field IState CGInfo

119ist_callgraph n =

120 maybe_default CGInfo

121− { argsdef = [], calls = [], scg = []

121+ { calls = [], scg = [], usedpos = []

122− , argsused = [], usedpos = []

123 }

122 }

124 . ctxt_lookup n

123 . ctxt_lookup n

125 . Field idris_callgraph (\v ist -> ist{ idris_callgraph = v })

124 . Field idris_callgraph (\v ist -> ist{ idris_callgraph = v })

126

125

127−-- some fields of the CGInfo record

128cg_usedpos :: Field CGInfo [(Int, [UsageReason])]

126cg_usedpos :: Field CGInfo [(Int, [UsageReason])]

129cg_usedpos = Field usedpos (\v cg -> cg{ usedpos = v })

127cg_usedpos = Field usedpos (\v cg -> cg{ usedpos = v })

130

128

131−

132-- Commandline flags

129-- Commandline flags

133--------------------

130--------------------

134

131

src/Idris/AbsSyntax.hs+47−11

@@ -96,6 +96,33 @@ addAutoImport fp = do i <- getIState

96 put (i { idris_options = opts { opt_autoImport =

97 fp : opt_autoImport opts } } )

98

99+addDefinedName :: Name -> Idris ()

100+addDefinedName n = do ist <- getIState

101+ putIState $ ist { idris_inmodule = S.insert n (idris_inmodule ist) }

102+

103+getDefinedNames :: Idris [Name]

104+getDefinedNames = do ist <- getIState

105+ return (S.toList (idris_inmodule ist))

106+

107+addTT :: Term -> Idris (Maybe Term)

108+addTT t = do ist <- getIState

109+ case M.lookup t (idris_ttstats ist) of

110+ Nothing -> do let tt' = M.insert t (1, t) (idris_ttstats ist)

111+ putIState $ ist { idris_ttstats = tt' }

112+ return Nothing

113+ Just (i, t') -> do let tt' = M.insert t' (i + 1, t') (idris_ttstats ist)

114+ putIState $ ist { idris_ttstats = tt' }

115+ return (Just t')

116+

117+dumpTT :: Idris ()

118+dumpTT = do ist <- get

119+ let sts = sortBy count (M.toList (idris_ttstats ist))

120+ mapM_ dump sts

121+ return ()

122+ where

123+ count (_,x) (_,y) = compare y x

124+ dump (tm, val) = runIO $ putStrLn (show val ++ ": " ++ show tm)

125+

99addHdr :: Codegen -> String -> Idris ()

126addHdr :: Codegen -> String -> Idris ()

100addHdr tgt f = do i <- getIState; putIState $ i { idris_hdrs = nub $ (tgt, f) : idris_hdrs i }

127addHdr tgt f = do i <- getIState; putIState $ i { idris_hdrs = nub $ (tgt, f) : idris_hdrs i }

101

128

@@ -180,6 +207,11 @@ setAccessibility n a

180 let ctxt = setAccess n a (tt_ctxt i)

207 let ctxt = setAccess n a (tt_ctxt i)

181 putIState $ i { tt_ctxt = ctxt }

208 putIState $ i { tt_ctxt = ctxt }

182

209

210+-- | get the accessibility of a name outside this module

211+getFromHideList :: Name -> Idris (Maybe Accessibility)

212+getFromHideList n = do i <- getIState

213+ return $ lookupCtxtExact n (hide_list i)

214+

183setTotality :: Name -> Totality -> Idris ()

215setTotality :: Name -> Totality -> Idris ()

184setTotality n a

216setTotality n a

185 = do i <- getIState

217 = do i <- getIState

@@ -213,6 +245,14 @@ addToCG n cg

213 = do i <- getIState

245 = do i <- getIState

214 putIState $ i { idris_callgraph = addDef n cg (idris_callgraph i) }

246 putIState $ i { idris_callgraph = addDef n cg (idris_callgraph i) }

215

247

248+addCalls :: Name -> [Name] -> Idris ()

249+addCalls n calls

250+ = do i <- getIState

251+ case lookupCtxtExact n (idris_callgraph i) of

252+ Nothing -> addToCG n (CGInfo calls [] [])

253+ Just (CGInfo cs scg used) ->

254+ addToCG n (CGInfo (nub (calls ++ cs)) scg used)

255+

216addTyInferred :: Name -> Idris ()

256addTyInferred :: Name -> Idris ()

217addTyInferred n

257addTyInferred n

218 = do i <- getIState

258 = do i <- getIState

@@ -309,7 +349,7 @@ allNames :: [Name] -> Name -> Idris [Name]

309allNames ns n | n `elem` ns = return []

349allNames ns n | n `elem` ns = return []

310allNames ns n = do i <- getIState

350allNames ns n = do i <- getIState

311 case lookupCtxtExact n (idris_callgraph i) of

351 case lookupCtxtExact n (idris_callgraph i) of

312− Just ns' -> do more <- mapM (allNames (n:ns)) (map fst (calls ns'))

352+ Just ns' -> do more <- mapM (allNames (n:ns)) (calls ns')

313 return (nub (n : concat more))

353 return (nub (n : concat more))

314 _ -> return [n]

354 _ -> return [n]

315

355

@@ -341,11 +381,6 @@ getNameHints i n =

341 [ns] -> ns

381 [ns] -> ns

342 _ -> []

382 _ -> []

343

383

344−-- Issue #1737 in the Issue Tracker.

345−-- https://github.com/idris-lang/Idris-dev/issues/1737

346−addToCalledG :: Name -> [Name] -> Idris ()

347−addToCalledG n ns = return () -- TODO

348−

349addDeprecated :: Name -> String -> Idris ()

384addDeprecated :: Name -> String -> Idris ()

350addDeprecated n reason = do i <- getIState

385addDeprecated n reason = do i <- getIState

351 putIState $ i { idris_deprecated = addDef n reason (idris_deprecated i) }

386 putIState $ i { idris_deprecated = addDef n reason (idris_deprecated i) }

@@ -439,7 +474,8 @@ addIBC ibc@(IBCDef n)

439addIBC ibc = do i <- getIState; putIState $ i { ibc_write = ibc : ibc_write i }

474addIBC ibc = do i <- getIState; putIState $ i { ibc_write = ibc : ibc_write i }

440

475

441clearIBC :: Idris ()

476clearIBC :: Idris ()

442−clearIBC = do i <- getIState; putIState $ i { ibc_write = [] }

477+clearIBC = do i <- getIState; putIState $ i { ibc_write = [],

478+ idris_inmodule = S.empty }

443

479

444resetNameIdx :: Idris ()

480resetNameIdx :: Idris ()

445resetNameIdx = do i <- getIState

481resetNameIdx = do i <- getIState

@@ -1227,10 +1263,10 @@ expandParamsD rhs ist dec ps ns (PClass doc info f cs n nfc params pDocs fds dec

1227 (map (expandParamsD rhs ist dec ps ns) decls)

1263 (map (expandParamsD rhs ist dec ps ns) decls)

1228 cn

1264 cn

1229 cd

1265 cd

1230−expandParamsD rhs ist dec ps ns (PInstance doc argDocs info f cs n nfc params ty cn decls)

1266+expandParamsD rhs ist dec ps ns (PInstance doc argDocs info f cs acc n nfc params ty cn decls)

1231 = PInstance doc argDocs info f

1267 = PInstance doc argDocs info f

1232 (map (\ (n, t) -> (n, expandParams dec ps ns [] t)) cs)

1268 (map (\ (n, t) -> (n, expandParams dec ps ns [] t)) cs)

1233− n

1269+ acc n

1234 nfc

1270 nfc

1235 (map (expandParams dec ps ns []) params)

1271 (map (expandParams dec ps ns []) params)

1236 (expandParams dec ps ns [] ty)

1272 (expandParams dec ps ns [] ty)

@@ -1537,9 +1573,9 @@ implicitise syn ignore ist tm = -- trace ("INCOMING " ++ showImp True tm) $

1537 implNamesIn uv (PApp fc f args) = concatMap (implNamesIn uv) (map getTm args)

1573 implNamesIn uv (PApp fc f args) = concatMap (implNamesIn uv) (map getTm args)

1538 implNamesIn uv t = namesIn uv ist t

1574 implNamesIn uv t = namesIn uv ist t

1539

1575

1540− imps top env (PApp _ f as)

1576+ imps top env ty@(PApp _ f as)

1541 = do (decls, ns) <- get

1577 = do (decls, ns) <- get

1542− let isn = concatMap (namesIn uvars ist) (map getTm as)

1578+ let isn = nub (implNamesIn uvars ty)

1543 put (decls, nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))

1579 put (decls, nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))

1544 imps top env (PPi (Imp l _ _ _) n _ ty sc)

1580 imps top env (PPi (Imp l _ _ _) n _ ty sc)

1545 = do let isn = nub (implNamesIn uvars ty) `dropAll` [n]

1581 = do let isn = nub (implNamesIn uvars ty) `dropAll` [n]

src/Idris/AbsSyntaxTree.hs+21−18

@@ -194,7 +194,6 @@ data IState = IState {

194 -- ^ list of lhs/rhs, and a list of missing clauses

195 idris_flags :: Ctxt [FnOpt],

196 idris_callgraph :: Ctxt CGInfo, -- name, args used in each pos

197− idris_calledgraph :: Ctxt [Name],

198 idris_docstrings :: Ctxt (Docstring DocTerm, [(Name, Docstring DocTerm)]),

197 idris_docstrings :: Ctxt (Docstring DocTerm, [(Name, Docstring DocTerm)]),

199 idris_moduledocs :: Ctxt (Docstring DocTerm),

198 idris_moduledocs :: Ctxt (Docstring DocTerm),

200 -- ^ module documentation is saved in a special MN so the context

199 -- ^ module documentation is saved in a special MN so the context

@@ -235,7 +234,7 @@ data IState = IState {

235 brace_stack :: [Maybe Int],

234 brace_stack :: [Maybe Int],

236 lastTokenSpan :: Maybe FC, -- ^ What was the span of the latest token parsed?

235 lastTokenSpan :: Maybe FC, -- ^ What was the span of the latest token parsed?

237 idris_parsedSpan :: Maybe FC,

236 idris_parsedSpan :: Maybe FC,

238− hide_list :: [(Name, Maybe Accessibility)],

237+ hide_list :: Ctxt Accessibility,

239 default_access :: Accessibility,

238 default_access :: Accessibility,

240 default_total :: Bool,

239 default_total :: Bool,

241 ibc_write :: [IBCWrite],

240 ibc_write :: [IBCWrite],

@@ -262,7 +261,9 @@ data IState = IState {

262 idris_exports :: [Name], -- ^ Functions with ExportList

261 idris_exports :: [Name], -- ^ Functions with ExportList

263 idris_highlightedRegions :: [(FC, OutputAnnotation)], -- ^ Highlighting information to output

262 idris_highlightedRegions :: [(FC, OutputAnnotation)], -- ^ Highlighting information to output

264 idris_parserHighlights :: [(FC, OutputAnnotation)], -- ^ Highlighting information from the parser

263 idris_parserHighlights :: [(FC, OutputAnnotation)], -- ^ Highlighting information from the parser

265− idris_deprecated :: Ctxt String -- ^ Deprecated names and explanation

264+ idris_deprecated :: Ctxt String, -- ^ Deprecated names and explanation

265+ idris_inmodule :: S.Set Name, -- ^ Names defined in current module

266+ idris_ttstats :: M.Map Term (Int, Term)

266 }

267 }

267

268

268-- Required for parsers library, and therefore trifecta

269-- Required for parsers library, and therefore trifecta

@@ -279,11 +280,10 @@ deriving instance NFData SizeChange

279type SCGEntry = (Name, [Maybe (Int, SizeChange)])

280type SCGEntry = (Name, [Maybe (Int, SizeChange)])

280type UsageReason = (Name, Int) -- fn_name, its_arg_number

281type UsageReason = (Name, Int) -- fn_name, its_arg_number

281

282

282−data CGInfo = CGInfo { argsdef :: [Name],

283+data CGInfo = CGInfo { calls :: [Name],

283− calls :: [(Name, [[Name]])],

284 scg :: [SCGEntry],

285− argsused :: [Name],

286− usedpos :: [(Int, [UsageReason])] }

285+ usedpos :: [(Int, [UsageReason])]

286+ }

287 deriving Show

288{-!

289deriving instance Binary CGInfo

@@ -348,12 +348,13 @@ idrisInit = IState initContext S.empty []

348 emptyContext emptyContext emptyContext emptyContext

349 emptyContext emptyContext emptyContext emptyContext

350 emptyContext emptyContext emptyContext emptyContext

351− emptyContext emptyContext

351+ emptyContext

352 [] [] [] defaultOpts 6 [] [] [] [] emptySyntaxRules [] [] [] [] [] [] []

353− [] [] Nothing [] Nothing [] [] Nothing Nothing [] Hidden False [] Nothing [] []

353+ [] [] Nothing [] Nothing [] [] Nothing Nothing emptyContext Hidden False [] Nothing [] []

354 (RawOutput stdout) True defaultTheme [] (0, emptyContext) emptyContext M.empty

355 AutomaticWidth S.empty S.empty [] Nothing Nothing [] [] M.empty [] [] []

356− emptyContext

356+ emptyContext S.empty M.empty

357+

357

358

358-- | The monad for the main REPL - reading and processing files and updating

359-- | The monad for the main REPL - reading and processing files and updating

359-- global state (hence the IO inner monad).

360-- global state (hence the IO inner monad).

@@ -393,6 +394,7 @@ data Command = Quit

393 | DocStr (Either Name Const) HowMuchDocs

394 | DocStr (Either Name Const) HowMuchDocs

394 | TotCheck Name

395 | TotCheck Name

395 | Reload

396 | Reload

397+ | Watch

396 | Load FilePath (Maybe Int) -- up to maximum line number

398 | Load FilePath (Maybe Int) -- up to maximum line number

397 | ChangeDirectory FilePath

399 | ChangeDirectory FilePath

398 | ModImport String

400 | ModImport String

@@ -716,6 +718,7 @@ data PDecl' t

716 [(Name, Docstring (Either Err t))] -- Parameter docs

718 [(Name, Docstring (Either Err t))] -- Parameter docs

717 SyntaxInfo

719 SyntaxInfo

718 FC [(Name, t)] -- constraints

720 FC [(Name, t)] -- constraints

721+ Accessibility

719 Name -- class

722 Name -- class

720 FC -- precise location of class

723 FC -- precise location of class

721 [t] -- parameters

724 [t] -- parameters

@@ -874,10 +877,10 @@ mapPDeclFC f g (PClass doc syn fc constrs n nfc params paramDocs det body ctor c

874 (map (mapPDeclFC f g) body)

877 (map (mapPDeclFC f g) body)

875 (fmap (\(n, nfc) -> (n, g nfc)) ctor)

878 (fmap (\(n, nfc) -> (n, g nfc)) ctor)

876 ctorDoc

879 ctorDoc

877−mapPDeclFC f g (PInstance doc paramDocs syn fc constrs cn cnfc params instTy instN body) =

880+mapPDeclFC f g (PInstance doc paramDocs syn fc constrs cn acc cnfc params instTy instN body) =

878 PInstance doc paramDocs syn (f fc)

881 PInstance doc paramDocs syn (f fc)

879 (map (\(constrN, constrT) -> (constrN, mapPTermFC f g constrT)) constrs)

882 (map (\(constrN, constrT) -> (constrN, mapPTermFC f g constrT)) constrs)

880− cn (g cnfc) (map (mapPTermFC f g) params)

883+ cn acc (g cnfc) (map (mapPTermFC f g) params)

881 (mapPTermFC f g instTy)

884 (mapPTermFC f g instTy)

882 instN

885 instN

883 (map (mapPDeclFC f g) body)

886 (map (mapPDeclFC f g) body)

@@ -917,7 +920,7 @@ declared (PParams _ _ ds) = concatMap declared ds

917declared (PNamespace _ _ ds) = concatMap declared ds

920declared (PNamespace _ _ ds) = concatMap declared ds

918declared (PRecord _ _ _ _ n _ _ _ _ cn _ _) = n : map fst (maybeToList cn)

921declared (PRecord _ _ _ _ n _ _ _ _ cn _ _) = n : map fst (maybeToList cn)

919declared (PClass _ _ _ _ n _ _ _ _ ms cn cd) = n : (map fst (maybeToList cn) ++ concatMap declared ms)

922declared (PClass _ _ _ _ n _ _ _ _ ms cn cd) = n : (map fst (maybeToList cn) ++ concatMap declared ms)

920−declared (PInstance _ _ _ _ _ _ _ _ _ _ _) = []

923+declared (PInstance _ _ _ _ _ _ _ _ _ _ _ _) = []

921declared (PDSL n _) = [n]

924declared (PDSL n _) = [n]

922declared (PSyntax _ _) = []

925declared (PSyntax _ _) = []

923declared (PMutual _ ds) = concatMap declared ds

926declared (PMutual _ ds) = concatMap declared ds

@@ -937,7 +940,7 @@ tldeclared (PParams _ _ ds) = []

937tldeclared (PMutual _ ds) = concatMap tldeclared ds

940tldeclared (PMutual _ ds) = concatMap tldeclared ds

938tldeclared (PNamespace _ _ ds) = concatMap tldeclared ds

941tldeclared (PNamespace _ _ ds) = concatMap tldeclared ds

939tldeclared (PClass _ _ _ _ n _ _ _ _ ms cn _) = n : (map fst (maybeToList cn) ++ concatMap tldeclared ms)

942tldeclared (PClass _ _ _ _ n _ _ _ _ ms cn _) = n : (map fst (maybeToList cn) ++ concatMap tldeclared ms)

940−tldeclared (PInstance _ _ _ _ _ _ _ _ _ _ _) = []

943+tldeclared (PInstance _ _ _ _ _ _ _ _ _ _ _ _) = []

941tldeclared _ = []

944tldeclared _ = []

942

945

943defined :: PDecl -> [Name]

946defined :: PDecl -> [Name]

@@ -953,7 +956,7 @@ defined (PParams _ _ ds) = concatMap defined ds

953defined (PNamespace _ _ ds) = concatMap defined ds

956defined (PNamespace _ _ ds) = concatMap defined ds

954defined (PRecord _ _ _ _ n _ _ _ _ cn _ _) = n : map fst (maybeToList cn)

957defined (PRecord _ _ _ _ n _ _ _ _ cn _ _) = n : map fst (maybeToList cn)

955defined (PClass _ _ _ _ n _ _ _ _ ms cn _) = n : (map fst (maybeToList cn) ++ concatMap defined ms)

958defined (PClass _ _ _ _ n _ _ _ _ ms cn _) = n : (map fst (maybeToList cn) ++ concatMap defined ms)

956−defined (PInstance _ _ _ _ _ _ _ _ _ _ _) = []

959+defined (PInstance _ _ _ _ _ _ _ _ _ _ _ _) = []

957defined (PDSL n _) = [n]

960defined (PDSL n _) = [n]

958defined (PSyntax _ _) = []

961defined (PSyntax _ _) = []

959defined (PMutual _ ds) = concatMap defined ds

962defined (PMutual _ ds) = concatMap defined ds

@@ -1737,7 +1740,7 @@ pprintPTerm ppo bnd docArgs infixes = prettySe (ppopt_depth ppo) startPrec bnd

1737

1740

1738 st =

1741 st =

1739 case s of

1742 case s of

1740− Static -> text "[static]" <> space

1743+ Static -> text "%static" <> space

1741 _ -> empty

1744 _ -> empty

1742 prettySe d p bnd (PPi (Imp l s _ fa) n _ ty sc)

1745 prettySe d p bnd (PPi (Imp l s _ fa) n _ ty sc)

1743 | ppopt_impl ppo =

1746 | ppopt_impl ppo =

@@ -1748,7 +1751,7 @@ pprintPTerm ppo bnd docArgs infixes = prettySe (ppopt_depth ppo) startPrec bnd

1748 where

1751 where

1749 st =

1752 st =

1750 case s of

1753 case s of

1751− Static -> text "[static]" <> space

1754+ Static -> text "%static" <> space

1752 _ -> empty

1755 _ -> empty

1753 prettySe d p bnd (PPi (Constraint _ _) n _ ty sc) =

1756 prettySe d p bnd (PPi (Constraint _ _) n _ ty sc) =

1754 depth d . bracket p startPrec $

1757 depth d . bracket p startPrec $

@@ -2108,7 +2111,7 @@ showDeclImp o (PNamespace n fc ps) = text "namespace" <+> text n <> braces (line

2108showDeclImp _ (PSyntax _ syn) = text "syntax" <+> text (show syn)

2111showDeclImp _ (PSyntax _ syn) = text "syntax" <+> text (show syn)

2109showDeclImp o (PClass _ _ _ cs n _ ps _ _ ds _ _)

2112showDeclImp o (PClass _ _ _ cs n _ ps _ _ ds _ _)

2110 = text "interface" <+> text (show cs) <+> text (show n) <+> text (show ps) <> line <> showDecls o ds

2113 = text "interface" <+> text (show cs) <+> text (show n) <+> text (show ps) <> line <> showDecls o ds

2111−showDeclImp o (PInstance _ _ _ _ cs n _ _ t _ ds)

2114+showDeclImp o (PInstance _ _ _ _ cs acc n _ _ t _ ds)

2112 = text "implementation" <+> text (show cs) <+> text (show n) <+> prettyImp o t <> line <> showDecls o ds

2115 = text "implementation" <+> text (show cs) <+> text (show n) <+> prettyImp o t <> line <> showDecls o ds

2113showDeclImp _ _ = text "..."

2116showDeclImp _ _ = text "..."

2114-- showDeclImp (PImport o) = "import " ++ o

2117-- showDeclImp (PImport o) = "import " ++ o

src/Idris/Core/CaseTree.hs+2−2

@@ -152,10 +152,10 @@ findCalls sc topargs = nub $ nu' topargs sc where

152 nua ps (SucCase _ sc) = nu' ps sc

153 nua ps (DefaultCase sc) = nu' ps sc

154

155− nut ps (P Ref n _) | n `elem` ps = []

155+ nut ps (P _ n _) | n `elem` ps = []

156 | otherwise = [(n, [])] -- tmp

157 nut ps fn@(App _ f a)

158− | (P Ref n _, args) <- unApply fn

158+ | (P _ n _, args) <- unApply fn

159 = if n `elem` ps then nut ps f ++ nut ps a

160 else [(n, map argNames args)] ++ concatMap (nut ps) args

161 | (P (TCon _ _) n _, _) <- unApply fn = []

src/Idris/Core/Evaluate.hs+13−10

@@ -12,7 +12,7 @@ module Idris.Core.Evaluate(normalise, normaliseTrace, normaliseC,

12 addDatatype, addCasedef, simplifyCasedef, addOperator,

13 lookupNames, lookupTyName, lookupTyNameExact, lookupTy, lookupTyExact,

14 lookupP, lookupP_all, lookupDef, lookupNameDef, lookupDefExact, lookupDefAcc, lookupDefAccExact, lookupVal,

15− mapDefCtxt,

15+ mapDefCtxt,

16 lookupTotal, lookupNameTotal, lookupMetaInformation, lookupTyEnv, isTCDict, isDConName, canBeDConName, isTConName, isConName, isFnName,

17 Value(..), Quote(..), initEval, uniqueNameCtxt, uniqueBindersCtxt, definitions,

18 isUniverse) where

@@ -247,18 +247,16 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where

247 | otherwise

248 = do (u, ntimes) <- usable spec n ntimes_in

249 if u then

250− do let val = lookupDefAcc n (spec || atRepl) ctxt

250+ do let val = lookupDefAcc n (spec || atRepl || runtime) ctxt

251 case val of

252 [(Function _ tm, _)] | sUN "assert_total" `elem` stk ->

253 ev ntimes (n:stk) True env tm

254 [(Function _ tm, Public)] ->

255 ev ntimes (n:stk) True env tm

256− [(Function _ tm, Hidden)] ->

257− ev ntimes (n:stk) True env tm

258 [(TyDecl nt ty, _)] -> do vty <- ev ntimes stk True env ty

256 [(TyDecl nt ty, _)] -> do vty <- ev ntimes stk True env ty

259 return $ VP nt n vty

257 return $ VP nt n vty

260 [(CaseOp ci _ _ _ _ cd, acc)]

258 [(CaseOp ci _ _ _ _ cd, acc)]

261− | (acc /= Frozen || sUN "assert_total" `elem` stk) &&

259+ | (acc == Public || sUN "assert_total" `elem` stk) &&

262 null (fst (cases_totcheck cd)) -> -- unoptimised version

260 null (fst (cases_totcheck cd)) -> -- unoptimised version

263 let (ns, tree) = getCases cd in

261 let (ns, tree) = getCases cd in

264 if blockSimplify ci n stk

262 if blockSimplify ci n stk

@@ -319,7 +317,7 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where

319 evApply ntimes' stk top env [l',t',arg'] d'

317 evApply ntimes' stk top env [l',t',arg'] d'

320 -- Treat "assert_total" specially, as long as it's defined!

318 -- Treat "assert_total" specially, as long as it's defined!

321 ev ntimes stk top env (App _ (App _ (P _ n@(UN at) _) _) arg)

319 ev ntimes stk top env (App _ (App _ (P _ n@(UN at) _) _) arg)

322− | [(CaseOp _ _ _ _ _ _, _)] <- lookupDefAcc n (spec || atRepl) ctxt,

320+ | [(CaseOp _ _ _ _ _ _, _)] <- lookupDefAcc n (spec || atRepl || runtime) ctxt,

323 at == txt "assert_total" && not simpl

321 at == txt "assert_total" && not simpl

324 = ev ntimes (n : stk) top env arg

322 = ev ntimes (n : stk) top env arg

325 ev ntimes stk top env (App _ f a)

323 ev ntimes stk top env (App _ f a)

@@ -347,7 +345,7 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where

347 = apply ntimes stk top env f args

345 = apply ntimes stk top env f args

348

346

349 reapply ntimes stk top env f@(VP Ref n ty) args

347 reapply ntimes stk top env f@(VP Ref n ty) args

350− = let val = lookupDefAcc n (spec || atRepl) ctxt in

348+ = let val = lookupDefAcc n (spec || atRepl || runtime) ctxt in

351 case val of

349 case val of

352 [(CaseOp ci _ _ _ _ cd, acc)] ->

350 [(CaseOp ci _ _ _ _ cd, acc)] ->

353 let (ns, tree) = getCases cd in

351 let (ns, tree) = getCases cd in

@@ -373,10 +371,10 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where

373 | otherwise

371 | otherwise

374 = do (u, ntimes) <- usable spec n ntimes_in

372 = do (u, ntimes) <- usable spec n ntimes_in

375 if u then

373 if u then

376− do let val = lookupDefAcc n (spec || atRepl) ctxt

374+ do let val = lookupDefAcc n (spec || atRepl || runtime) ctxt

377 case val of

375 case val of

378 [(CaseOp ci _ _ _ _ cd, acc)]

376 [(CaseOp ci _ _ _ _ cd, acc)]

379− | acc /= Frozen || sUN "assert_total" `elem` stk ->

377+ | acc == Public || sUN "assert_total" `elem` stk ->

380 -- unoptimised version

378 -- unoptimised version

381 let (ns, tree) = getCases cd in

379 let (ns, tree) = getCases cd in

382 if blockSimplify ci n stk

380 if blockSimplify ci n stk

@@ -746,11 +744,16 @@ instance Show Def where

746-- Hidden => doesn't reduce and invisible to type checker

744-- Hidden => doesn't reduce and invisible to type checker

747

745

748data Accessibility = Public | Frozen | Hidden

746data Accessibility = Public | Frozen | Hidden

749− deriving (Show, Eq)

747+ deriving (Eq, Ord)

750{-!

748{-!

751deriving instance NFData Accessibility

749deriving instance NFData Accessibility

752!-}

750!-}

753

751

752+instance Show Accessibility where

753+ show Public = "public export"

754+ show Frozen = "export"

755+ show Hidden = "private"

756+

754-- | The result of totality checking

757-- | The result of totality checking

755data Totality = Total [Int] -- ^ well-founded arguments

758data Totality = Total [Int] -- ^ well-founded arguments

756 | Productive -- ^ productive

759 | Productive -- ^ productive

src/Idris/Core/TT.hs+1−1

@@ -588,7 +588,7 @@ tcname (SN (MethodN _)) = True

588tcname (SN (ParentN _ _)) = True

589tcname _ = False

590

591−implicitable (NS n _) = implicitable n

591+implicitable (NS n _) = False

592implicitable (UN xs) | T.null xs = False

593 | otherwise = isLower (T.head xs) || T.head xs == '_'

594implicitable (MN _ x) = not (tnull x) && thead x /= '_'

src/Idris/Coverage.hs+3−1

@@ -135,6 +135,7 @@ validCoverageCase ctxt (CantUnify _ (topx, _) (topy, _) e _ _)

135 = case (unApply topx, unApply topy) of

136 ((P _ x _, _), (P _ y _, _)) -> x == y

137 _ -> False

138+validCoverageCase ctxt (InfiniteUnify _ _ _) = False

138validCoverageCase ctxt (CantConvert _ _ _) = False

139validCoverageCase ctxt (CantConvert _ _ _) = False

139validCoverageCase ctxt (At _ e) = validCoverageCase ctxt e

140validCoverageCase ctxt (At _ e) = validCoverageCase ctxt e

140validCoverageCase ctxt (Elaborating _ _ _ e) = validCoverageCase ctxt e

141validCoverageCase ctxt (Elaborating _ _ _ e) = validCoverageCase ctxt e

@@ -313,7 +314,7 @@ checkAllCovering fc done top n | not (n `elem` done)

313 [Partial _] ->

314 [Partial _] ->

314 case lookupCtxt n (idris_callgraph i) of

315 case lookupCtxt n (idris_callgraph i) of

315 [cg] -> mapM_ (checkAllCovering fc (n : done) top)

316 [cg] -> mapM_ (checkAllCovering fc (n : done) top)

316− (map fst (calls cg))

317+ (calls cg)

317 _ -> return ()

318 _ -> return ()

318 x -> return () -- stop if total

319 x -> return () -- stop if total

319checkAllCovering _ _ _ _ = return ()

320checkAllCovering _ _ _ _ = return ()

@@ -474,6 +475,7 @@ buildSCG (_, n) = do

474 let newscg = buildSCG' ist (rights pats) args

475 let newscg = buildSCG' ist (rights pats) args

475 logCoverage 5 $ "SCG is: " ++ show newscg

476 logCoverage 5 $ "SCG is: " ++ show newscg

476 addToCG n ( cg { scg = newscg } )

477 addToCG n ( cg { scg = newscg } )

478+ _ -> return () -- CG comes from a type declaration only

477 [] -> logCoverage 5 $ "Could not build SCG for " ++ show n ++ "\n"

479 [] -> logCoverage 5 $ "Could not build SCG for " ++ show n ++ "\n"

478 x -> error $ "buildSCG: " ++ show (n, x)

480 x -> error $ "buildSCG: " ++ show (n, x)

479

481

src/Idris/DeepSeq.hs+6−6

@@ -365,9 +365,9 @@ instance NFData LogCat where

365 rnf _ = ()

366

367instance NFData CGInfo where

368− rnf (CGInfo x1 x2 x3 x4 x5)

368+ rnf (CGInfo x1 x2 x3)

369 = rnf x1 `seq`

370− rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` ()

370+ rnf x2 `seq` rnf x3 `seq` ()

371

372instance NFData Fixity where

373 rnf (Infixl x1) = rnf x1 `seq` ()

@@ -466,7 +466,7 @@ instance (NFData t) => NFData (PDecl' t) where

466 rnf x9 `seq`

467 rnf x10 `seq`

468 rnf x11 `seq` rnf x12 `seq` ()

469− rnf (PInstance x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11)

469+ rnf (PInstance x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12)

470 = rnf x1 `seq`

471 rnf x2 `seq`

472 rnf x3 `seq`

@@ -475,7 +475,7 @@ instance (NFData t) => NFData (PDecl' t) where

475 rnf x6 `seq`

476 rnf x7 `seq`

477 rnf x8 `seq`

478− rnf x9 `seq` rnf x10 `seq` rnf x11 `seq` ()

478+ rnf x9 `seq` rnf x10 `seq` rnf x11 `seq` rnf x12 `seq` ()

479 rnf (PDSL x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

480 rnf (PSyntax x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

481 rnf (PMutual x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

@@ -696,8 +696,8 @@ instance NFData IState where

696 rnf (IState x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20

697 x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 x31 x32 x33 x34 x35 x36 x37 x38 x39 x40

698 x41 x42 x43 x44 x45 x46 x47 x48 x49 x50 x51 x52 x53 x54 x55 x56 x57 x58 x59 x60

699− x61 x62 x63 x64 x65 x66 x67 x68 x69 x70 x71 x72 x73 x74)

699+ x61 x62 x63 x64 x65 x66 x67 x68 x69 x70 x71 x72 x73 x74 x75)

700 = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` rnf x7 `seq` rnf x8 `seq` rnf x9 `seq` rnf x10 `seq` () `seq` rnf x11 `seq` rnf x12 `seq` rnf x13 `seq` rnf x14 `seq` rnf x15 `seq` rnf x16 `seq` rnf x17 `seq` rnf x18 `seq` rnf x19 `seq` rnf x20 `seq`

701 rnf x21 `seq` rnf x22 `seq` rnf x23 `seq` rnf x24 `seq` rnf x25 `seq` rnf x26 `seq` rnf x27 `seq` rnf x28 `seq` rnf x29 `seq` rnf x30 `seq` rnf x31 `seq` rnf x32 `seq` rnf x33 `seq` rnf x34 `seq` rnf x35 `seq` rnf x36 `seq` rnf x37 `seq` rnf x38 `seq` rnf x39 `seq` rnf x40 `seq`

702 rnf x41 `seq` rnf x42 `seq` rnf x43 `seq` rnf x44 `seq` rnf x45 `seq` rnf x46 `seq` rnf x47 `seq` rnf x48 `seq` rnf x49 `seq` rnf x50 `seq` rnf x51 `seq` rnf x52 `seq` rnf x53 `seq` rnf x54 `seq` rnf x55 `seq` rnf x56 `seq` rnf x57 `seq` rnf x58 `seq` rnf x59 `seq` rnf x60 `seq`

703− rnf x61 `seq` rnf x62 `seq` rnf x63 `seq` rnf x64 `seq` rnf x65 `seq` rnf x66 `seq` rnf x67 `seq` rnf x68 `seq` rnf x69 `seq` rnf x70 `seq` rnf x71 `seq` rnf x72 `seq` rnf x73 `seq` rnf x74 `seq` ()

703+ rnf x61 `seq` rnf x62 `seq` rnf x63 `seq` rnf x64 `seq` rnf x65 `seq` rnf x66 `seq` rnf x67 `seq` rnf x68 `seq` rnf x69 `seq` rnf x70 `seq` rnf x71 `seq` rnf x72 `seq` rnf x73 `seq` rnf x74 `seq` rnf x75 `seq` ()

src/Idris/Delaborate.hs+2−2

@@ -346,11 +346,11 @@ pprintErr' i (NotInjective p x y) =

346 text "Can't verify injectivity of" <+> annTm p (pprintTerm i (delabSugared i p)) <+>

347 text " when unifying" <+> annTm x (pprintTerm i (delabSugared i x)) <+> text "and" <+>

348 annTm y (pprintTerm i (delabSugared i y))

349−pprintErr' i (CantResolve _ c) = text "Can't resolve type class" <+> pprintTerm i (delabSugared i c)

349+pprintErr' i (CantResolve _ c) = text "Can't find implementation for" <+> pprintTerm i (delabSugared i c)

350pprintErr' i (InvalidTCArg n t)

351 = annTm t (pprintTerm i (delabSugared i t)) <+> text " cannot be a parameter of "

352 <> annName n <$>

353− text "(Type class arguments must be injective)"

353+ text "(Implementation arguments must be injective)"

354pprintErr' i (CantResolveAlts as) = text "Can't disambiguate name:" <+>

355 align (cat (punctuate (comma <> space) (map (fmap (fancifyAnnots i True) . annName) as)))

356pprintErr' i (NoValidAlts as) = text "Can't disambiguate since no name has a suitable type:" <+>

src/Idris/Docs.hs+3−3

@@ -19,7 +19,7 @@ import Data.Maybe

19import Data.List

20import qualified Data.Text as T

21

22−-- TODO: Only include names with public/abstract accessibility

22+-- TODO: Only include names with public/export accessibility

23--

24-- Issue #1573 on the Issue tracker.

25-- https://github.com/idris-lang/Idris-dev/issues/1573

@@ -319,8 +319,8 @@ docClass n ci

319 namedInst n@(UN _) = Just n

320 namedInst _ = Nothing

321

322− getDInst (PInstance _ _ _ _ _ _ _ _ t _ _) = Just t

322+ getDInst (PInstance _ _ _ _ _ _ _ _ _ t _ _) = Just t

323− getDInst _ = Nothing

323+ getDInst _ = Nothing

324

325 isSubclass (PPi (Constraint _ _) _ _ (PApp _ _ args) (PApp _ (PRef _ _ nm) args'))

326 = nm == n && map getTm args == map getTm args'

src/Idris/Elab/Class.hs+2−2

@@ -138,7 +138,7 @@ elabClass info syn_in doc fc constraints tn tnfc ps pDocs fds ds mcn cd

138

139 -- TODO: probably should normalise

140 checkDefaultSuperclassInstance :: PDecl -> Idris ()

141− checkDefaultSuperclassInstance (PInstance _ _ _ fc cs n _ ps _ _ _)

141+ checkDefaultSuperclassInstance (PInstance _ _ _ fc cs _ n _ ps _ _ _)

142 = do when (not $ null cs) . tclift

143 $ tfail (At fc (Msg $ "Default superclass instances can't have constraints."))

144 i <- getIState

@@ -184,7 +184,7 @@ elabClass info syn_in doc fc constraints tn tnfc ps pDocs fds ds mcn cd

184

185 tydecl (PTy _ _ _ _ _ _ _ _) = True

186 tydecl _ = False

187− instdecl (PInstance _ _ _ _ _ _ _ _ _ _ _) = True

187+ instdecl (PInstance _ _ _ _ _ _ _ _ _ _ _ _) = True

188 instdecl _ = False

189 clause (PClauses _ _ _ _) = True

190 clause _ = False

src/Idris/Elab/Clause.hs+32−18

@@ -80,10 +80,11 @@ elabClauses info' fc opts n_in cs =

80 let atys = map snd (getArgTys fty)

81 cs_elab <- mapM (elabClause info opts)

82 (zip [0..] cs)

83+ ctxt <- getContext

83 -- pats_raw is the version we'll work with at compile time:

84 -- pats_raw is the version we'll work with at compile time:

84 -- no simplification or PE

85 -- no simplification or PE

85 let (pats_in, cs_full) = unzip cs_elab

86 let (pats_in, cs_full) = unzip cs_elab

86− let pats_raw = map (simple_lhs (tt_ctxt ist)) pats_in

87+ let pats_raw = map (simple_lhs ctxt) pats_in

87 logElab 3 $ "Elaborated patterns:\n" ++ show pats_raw

88 logElab 3 $ "Elaborated patterns:\n" ++ show pats_raw

88

89

89 solveDeferred n

90 solveDeferred n

@@ -93,6 +94,7 @@ elabClauses info' fc opts n_in cs =

93 addIBC (IBCOpt n)

94 addIBC (IBCOpt n)

94

95

95 ist <- getIState

96 ist <- getIState

97+ ctxt <- getContext

96 -- Don't apply rules if this is a partial evaluation definition,

98 -- Don't apply rules if this is a partial evaluation definition,

97 -- or we'll make something that just runs itself!

99 -- or we'll make something that just runs itself!

98 let tpats = case specNames opts of

100 let tpats = case specNames opts of

@@ -103,7 +105,7 @@ elabClauses info' fc opts n_in cs =

103 -- RHS

105 -- RHS

104 pe_tm <- doPartialEval ist tpats

106 pe_tm <- doPartialEval ist tpats

105 let pats_pe = if petrans

107 let pats_pe = if petrans

106− then map (simple_lhs (tt_ctxt ist)) pe_tm

108+ then map (simple_lhs ctxt) pe_tm

107 else pats_raw

109 else pats_raw

108

110

109 let tcase = opt_typecase (idris_options ist)

111 let tcase = opt_typecase (idris_options ist)

@@ -183,7 +185,8 @@ elabClauses info' fc opts n_in cs =

183 -- pdef' is the version that gets compiled for run-time,

185 -- pdef' is the version that gets compiled for run-time,

184 -- so we start from the partially evaluated version

186 -- so we start from the partially evaluated version

185 pdef_in' <- applyOpts $ map (\(ns, lhs, rhs) -> (map fst ns, lhs, rhs)) pdef_pe

187 pdef_in' <- applyOpts $ map (\(ns, lhs, rhs) -> (map fst ns, lhs, rhs)) pdef_pe

188+ ctxt <- getContext

186− let pdef' = map (simple_rt (tt_ctxt ist)) pdef_in'

189+ let pdef' = map (simple_rt ctxt) pdef_in'

187

190

188 logElab 5 $ "After data structure transformations:\n" ++ show pdef'

191 logElab 5 $ "After data structure transformations:\n" ++ show pdef'

189

192

@@ -241,24 +244,28 @@ elabClauses info' fc opts n_in cs =

241 ctxt

244 ctxt

242 setContext ctxt'

245 setContext ctxt'

243 addIBC (IBCDef n)

246 addIBC (IBCDef n)

247+ addDefinedName n

244 setTotality n tot

248 setTotality n tot

245 when (not reflect && PEGenerated `notElem` opts) $

249 when (not reflect && PEGenerated `notElem` opts) $

246 do totcheck (fc, n)

250 do totcheck (fc, n)

247 defer_totcheck (fc, n)

251 defer_totcheck (fc, n)

248 when (tot /= Unchecked) $ addIBC (IBCTotal n tot)

252 when (tot /= Unchecked) $ addIBC (IBCTotal n tot)

249 i <- getIState

253 i <- getIState

254+ ctxt <- getContext

250− case lookupDef n (tt_ctxt i) of

255+ case lookupDef n ctxt of

251 (CaseOp _ _ _ _ _ cd : _) ->

256 (CaseOp _ _ _ _ _ cd : _) ->

252− let (scargs, sc) = cases_compiletime cd

257+ let (scargs, sc) = cases_compiletime cd in

253− (scargs', sc') = cases_runtime cd in

254− do let calls = findCalls sc' scargs'

258+ do let calls = map fst $ findCalls sc scargs

255− let used = findUsedArgs sc' scargs'

256 -- let scg = buildSCG i sc scargs

259 -- let scg = buildSCG i sc scargs

257 -- add SCG later, when checking totality

260 -- add SCG later, when checking totality

258− let cg = CGInfo scargs' calls [] used [] -- TODO: remove this, not needed anymore

259− logElab 2 $ "Called names: " ++ show cg

261+ logElab 2 $ "Called names: " ++ show calls

260− addToCG n cg

262+ -- if the definition is public, make sure

261− addToCalledG n (nub (map fst calls)) -- plus names in type!

263+ -- it only uses public names

264+ nvis <- getFromHideList n

265+ case nvis of

266+ Just Public -> mapM_ (checkVisibility fc n Public Public) calls

267+ _ -> return ()

268+ addCalls n calls

262 addIBC (IBCCG n)

269 addIBC (IBCCG n)

263 _ -> return ()

270 _ -> return ()

264 return ()

271 return ()

@@ -353,11 +360,12 @@ elabPE info fc caller r =

353 mkSpecialised :: (Name, [(PEArgType, Term)]) -> Idris [(Term, Term)]

360 mkSpecialised :: (Name, [(PEArgType, Term)]) -> Idris [(Term, Term)]

354 mkSpecialised specapp_in = do

361 mkSpecialised specapp_in = do

355 ist <- getIState

362 ist <- getIState

363+ ctxt <- getContext

356 let (specTy, specapp) = getSpecTy ist specapp_in

364 let (specTy, specapp) = getSpecTy ist specapp_in

357 let (n, newnm, specdecl) = getSpecClause ist specapp

365 let (n, newnm, specdecl) = getSpecClause ist specapp

358 let lhs = pe_app specdecl

366 let lhs = pe_app specdecl

359 let rhs = pe_def specdecl

367 let rhs = pe_def specdecl

360− let undef = case lookupDefExact newnm (tt_ctxt ist) of

368+ let undef = case lookupDefExact newnm ctxt of

361 Nothing -> True

369 Nothing -> True

362 _ -> False

370 _ -> False

363 logElab 5 $ show (newnm, undef, map (concreteArg ist) (snd specapp))

371 logElab 5 $ show (newnm, undef, map (concreteArg ist) (snd specapp))

@@ -370,7 +378,7 @@ elabPE info fc caller r =

370 let cgns' = filter (\x -> x /= n &&

378 let cgns' = filter (\x -> x /= n &&

371 notStatic ist x) cgns

379 notStatic ist x) cgns

372 -- set small reduction limit on partial/productive things

380 -- set small reduction limit on partial/productive things

373− let maxred = case lookupTotal n (tt_ctxt ist) of

381+ let maxred = case lookupTotal n ctxt of

374 [Total _] -> 65536

382 [Total _] -> 65536

375 [Productive] -> 16

383 [Productive] -> 16

376 _ -> 1

384 _ -> 1

@@ -485,7 +493,7 @@ checkPossible info fc tcgen fname lhs_in

485 processTacticDecls info newDecls

493 processTacticDecls info newDecls

486 sendHighlighting highlights

494 sendHighlighting highlights

487 let lhs_tm = orderPats (getInferTerm lhs')

495 let lhs_tm = orderPats (getInferTerm lhs')

488− case recheck ctxt [] (forget lhs_tm) lhs_tm of

496+ case recheck ctxt' [] (forget lhs_tm) lhs_tm of

489 OK _ -> return True

497 OK _ -> return True

490 err -> return False

498 err -> return False

491 -- if it's a recoverable error, the case may become possible

499 -- if it's a recoverable error, the case may become possible

@@ -558,7 +566,7 @@ elabClause info opts (cnum, PClause fc fname lhs_in_as withs rhs_in_as wherebloc

558 (Msg "unexpected patterns outside of \"with\" block")))

566 (Msg "unexpected patterns outside of \"with\" block")))

559

567

560 -- get the parameters first, to pass through to any where block

568 -- get the parameters first, to pass through to any where block

561− let fn_ty = case lookupTy fname (tt_ctxt i) of

569+ let fn_ty = case lookupTy fname ctxt of

562 [t] -> t

570 [t] -> t

563 _ -> error "Can't happen (elabClause function type)"

571 _ -> error "Can't happen (elabClause function type)"

564 let fn_is = case lookupCtxt fname (idris_implicits i) of

572 let fn_is = case lookupCtxt fname (idris_implicits i) of

@@ -602,6 +610,7 @@ elabClause info opts (cnum, PClause fc fname lhs_in_as withs rhs_in_as wherebloc

602

610

603 -- If we're inferring metavariables in the type, don't recheck,

611 -- If we're inferring metavariables in the type, don't recheck,

604 -- because we're only doing this to try to work out those metavariables

612 -- because we're only doing this to try to work out those metavariables

613+ ctxt <- getContext

605 (clhs_c, clhsty) <- if not inf

614 (clhs_c, clhsty) <- if not inf

606 then recheckC_borrowing False (PEGenerated `notElem` opts)

615 then recheckC_borrowing False (PEGenerated `notElem` opts)

607 [] fc id [] lhs_tm

616 [] fc id [] lhs_tm

@@ -627,6 +636,8 @@ elabClause info opts (cnum, PClause fc fname lhs_in_as withs rhs_in_as wherebloc

627 logElab 5 ("Checked " ++ show clhs ++ "\n" ++ show clhsty)

636 logElab 5 ("Checked " ++ show clhs ++ "\n" ++ show clhsty)

628 -- Elaborate where block

637 -- Elaborate where block

629 ist <- getIState

638 ist <- getIState

639+ ctxt <- getContext

640+

630 windex <- getName

641 windex <- getName

631 let decls = nub (concatMap declared whereblock)

642 let decls = nub (concatMap declared whereblock)

632 let defs = nub (decls ++ concatMap defined whereblock)

643 let defs = nub (decls ++ concatMap defined whereblock)

@@ -635,7 +646,7 @@ elabClause info opts (cnum, PClause fc fname lhs_in_as withs rhs_in_as wherebloc

635 -- Unique arguments must be passed to the where block explicitly

646 -- Unique arguments must be passed to the where block explicitly

636 -- (since we can't control "usage" easlily otherwise). Remove them

647 -- (since we can't control "usage" easlily otherwise). Remove them

637 -- from newargs here

648 -- from newargs here

638− let uniqargs = findUnique (tt_ctxt ist) [] lhs_tm

649+ let uniqargs = findUnique ctxt [] lhs_tm

639 let newargs = filter (\(n,_) -> n `notElem` uniqargs) newargs_all

650 let newargs = filter (\(n,_) -> n `notElem` uniqargs) newargs_all

640

651

641 let winfo = (pinfo info newargs defs windex) { elabFC = Just fc }

652 let winfo = (pinfo info newargs defs windex) { elabFC = Just fc }

@@ -798,7 +809,7 @@ elabClause info opts (_, PWith fc fname lhs_in withs wval_in pn_in withblock)

798 -- pattern bindings

809 -- pattern bindings

799 i <- getIState

810 i <- getIState

800 -- get the parameters first, to pass through to any where block

811 -- get the parameters first, to pass through to any where block

801− let fn_ty = case lookupTy fname (tt_ctxt i) of

812+ let fn_ty = case lookupTy fname ctxt of

802 [t] -> t

813 [t] -> t

803 _ -> error "Can't happen (elabClause function type)"

814 _ -> error "Can't happen (elabClause function type)"

804 let fn_is = case lookupCtxt fname (idris_implicits i) of

815 let fn_is = case lookupCtxt fname (idris_implicits i) of

@@ -819,6 +830,7 @@ elabClause info opts (_, PWith fc fname lhs_in withs wval_in pn_in withblock)

819 processTacticDecls info newDecls

830 processTacticDecls info newDecls

820 sendHighlighting highlights

831 sendHighlighting highlights

821

832

833+ ctxt <- getContext

822 let lhs_tm = orderPats (getInferTerm lhs')

834 let lhs_tm = orderPats (getInferTerm lhs')

823 let lhs_ty = getInferType lhs'

835 let lhs_ty = getInferType lhs'

824 let ret_ty = getRetTy (explicitNames (normalise ctxt [] lhs_ty))

836 let ret_ty = getRetTy (explicitNames (normalise ctxt [] lhs_ty))

@@ -852,6 +864,8 @@ elabClause info opts (_, PWith fc fname lhs_in withs wval_in pn_in withblock)

852 addDeferred def''

864 addDeferred def''

853 mapM_ (elabCaseBlock info opts) is

865 mapM_ (elabCaseBlock info opts) is

854 logElab 5 ("Checked wval " ++ show wval')

866 logElab 5 ("Checked wval " ++ show wval')

867+

868+ ctxt <- getContext

855 (cwval, cwvalty) <- recheckC fc id [] (getInferTerm wval')

869 (cwval, cwvalty) <- recheckC fc id [] (getInferTerm wval')

856 let cwvaltyN = explicitNames (normalise ctxt [] cwvalty)

870 let cwvaltyN = explicitNames (normalise ctxt [] cwvalty)

857 let cwvalN = explicitNames (normalise ctxt [] cwval)

871 let cwvalN = explicitNames (normalise ctxt [] cwval)

src/Idris/Elab/Instance.hs+8−4

@@ -55,13 +55,14 @@ elabInstance :: ElabInfo -> SyntaxInfo ->

55 [(Name, Docstring (Either Err PTerm))] ->

56 ElabWhat -> -- phase

57 FC -> [(Name, PTerm)] -> -- constraints

58+ Accessibility ->

58 Name -> -- the class

59 Name -> -- the class

59 FC -> -- precise location of class name

60 FC -> -- precise location of class name

60 [PTerm] -> -- class parameters (i.e. instance)

61 [PTerm] -> -- class parameters (i.e. instance)

61 PTerm -> -- full instance type

62 PTerm -> -- full instance type

62 Maybe Name -> -- explicit name

63 Maybe Name -> -- explicit name

63 [PDecl] -> Idris ()

64 [PDecl] -> Idris ()

64−elabInstance info syn doc argDocs what fc cs n nfc ps t expn ds = do

65+elabInstance info syn doc argDocs what fc cs acc n nfc ps t expn ds = do

65 i <- getIState

66 i <- getIState

66 (n, ci) <- case lookupCtxtName n (idris_classes i) of

67 (n, ci) <- case lookupCtxtName n (idris_classes i) of

67 [c] -> return c

68 [c] -> return c

@@ -70,6 +71,9 @@ elabInstance info syn doc argDocs what fc cs n nfc ps t expn ds = do

70 (CantResolveAlts (map fst cs))

71 (CantResolveAlts (map fst cs))

71 let constraint = PApp fc (PRef fc [] n) (map pexp ps)

72 let constraint = PApp fc (PRef fc [] n) (map pexp ps)

72 let iname = mkiname n (namespace info) ps expn

73 let iname = mkiname n (namespace info) ps expn

74+ putIState (i { hide_list = addDef iname acc (hide_list i) })

75+ i <- getIState

76+

73 let emptyclass = null (class_methods ci)

77 let emptyclass = null (class_methods ci)

74 when (what /= EDefns) $ do

78 when (what /= EDefns) $ do

75 nty <- elabType' True info syn doc argDocs fc [] iname NoFC t

79 nty <- elabType' True info syn doc argDocs fc [] iname NoFC t

@@ -159,10 +163,10 @@ elabInstance info syn doc argDocs what fc cs n nfc ps t expn ds = do

159 Just m -> sNS (SN (sInstanceN n' (map show ps'))) m

163 Just m -> sNS (SN (sInstanceN n' (map show ps'))) m

160 Just nm -> nm

164 Just nm -> nm

161

165

162− substInstance ips pnames (PInstance doc argDocs syn _ cs n nfc ps t expn ds)

166+ substInstance ips pnames (PInstance doc argDocs syn _ cs acc n nfc ps t expn ds)

163− = PInstance doc argDocs syn fc cs n nfc (map (substMatchesShadow ips pnames) ps) (substMatchesShadow ips pnames t) expn ds

167+ = PInstance doc argDocs syn fc cs acc n nfc (map (substMatchesShadow ips pnames) ps) (substMatchesShadow ips pnames t) expn ds

164

168

165− isOverlapping i (PInstance doc argDocs syn _ _ n nfc ps t expn _)

169+ isOverlapping i (PInstance doc argDocs syn _ _ _ n nfc ps t expn _)

166 = case lookupCtxtName n (idris_classes i) of

170 = case lookupCtxtName n (idris_classes i) of

167 [(n, ci)] -> let iname = (mkiname n (namespace info) ps expn) in

171 [(n, ci)] -> let iname = (mkiname n (namespace info) ps expn) in

168 case lookupTy iname (tt_ctxt i) of

172 case lookupTy iname (tt_ctxt i) of

src/Idris/Elab/Term.hs+6−8

@@ -2476,8 +2476,10 @@ withErrorReflection x = idrisCatch x (\ e -> handle e >>= ierror)

2476 OK hs -> return hs

2477

2478 -- Normalize error handler terms to produce the new messages

2479+ -- Need to use 'normaliseAll' since we have to reduce private

2480+ -- names in error handlers too

2479 ctxt <- getContext

2481 ctxt <- getContext

2480− let results = map (normalise ctxt []) (map fst handlers)

2482+ let results = map (normaliseAll ctxt []) (map fst handlers)

2481 logElab 3 $ "New error message info: " ++ concat (intersperse " and " (map show results))

2483 logElab 3 $ "New error message info: " ++ concat (intersperse " and " (map show results))

2482

2484

2483 -- For each handler term output, either discard it if it is Nothing or reify it the Haskell equivalent

2485 -- For each handler term output, either discard it if it is Nothing or reify it the Haskell equivalent

@@ -2549,13 +2551,9 @@ processTacticDecls info steps =

2549 -- we refer to, so that if they aren't total, the whole

2551 -- we refer to, so that if they aren't total, the whole

2550 -- thing won't be.

2552 -- thing won't be.

2551 let (scargs, sc) = cases_compiletime cd

2553 let (scargs, sc) = cases_compiletime cd

2552− (scargs', sc') = cases_runtime cd

2553− calls = findCalls sc' scargs

2554+ calls = map fst $ findCalls sc scargs

2554− used = findUsedArgs sc' scargs'

2555− cg = CGInfo scargs' calls [] used []

2556− in do logElab 2 $ "Called names in reflected elab: " ++ show cg

2555+ in do logElab 2 $ "Called names in reflected elab: " ++ show calls

2557− addToCG n cg

2556+ addCalls n calls

2558− addToCalledG n (nub (map fst calls))

2559 addIBC $ IBCCG n

2557 addIBC $ IBCCG n

2560 Just _ -> return () -- TODO throw internal error

2558 Just _ -> return () -- TODO throw internal error

2561 Nothing -> return ()

2559 Nothing -> return ()

src/Idris/Elab/Type.hs+13

@@ -102,6 +102,18 @@ buildType info syn fc opts n ty' = do

102 logElab 3 ("Implicit " ++ show n ++ " " ++ show impls)

103 addIBC (IBCImp n)

104

105+ -- Add the names referenced to the call graph, and check we're not

106+ -- referring to anything less visible

107+ -- In particular, a public/export type can not refer to anything

108+ -- private, but can refer to any public/export

109+ let refs = freeNames cty

110+ nvis <- getFromHideList n

111+ case nvis of

112+ Nothing -> return ()

113+ Just acc -> mapM_ (checkVisibility fc n (max Frozen acc) acc) refs

114+ addCalls n refs

115+ addIBC (IBCCG n)

116+

105 when (Constructor `notElem` opts) $ do

117 when (Constructor `notElem` opts) $ do

106 let pnames = getParamsInType i [] impls cty

118 let pnames = getParamsInType i [] impls cty

107 let fninfo = FnInfo (param_pos 0 pnames cty)

119 let fninfo = FnInfo (param_pos 0 pnames cty)

@@ -163,6 +175,7 @@ elabType' norm info syn doc argDocs fc opts n nfc ty' = {- let ty' = piBind (par

163 let usety = if norm then nty' else nty

175 let usety = if norm then nty' else nty

164 ds <- checkDef fc iderr [(n, (-1, Nothing, usety, []))]

176 ds <- checkDef fc iderr [(n, (-1, Nothing, usety, []))]

165 addIBC (IBCDef n)

177 addIBC (IBCDef n)

178+ addDefinedName n

166 let ds' = map (\(n, (i, top, fam, ns)) -> (n, (i, top, fam, ns, True))) ds

179 let ds' = map (\(n, (i, top, fam, ns)) -> (n, (i, top, fam, ns, True))) ds

167 addDeferred ds'

180 addDeferred ds'

168 setFlags n opts'

181 setFlags n opts'

src/Idris/Elab/Utils.hs+16

@@ -314,3 +314,19 @@ mkStaticTy ns (PPi p n fc ty sc)

314 | n `elem` ns = PPi (p { pstatic = Static }) n fc ty (mkStaticTy ns sc)

315 | otherwise = PPi p n fc ty (mkStaticTy ns sc)

316mkStaticTy ns t = t

317+

318+-- Check that a name has the minimum required accessibility

319+checkVisibility :: FC -> Name -> Accessibility -> Accessibility -> Name -> Idris ()

320+checkVisibility fc n minAcc acc ref

321+ = do nvis <- getFromHideList ref

322+ case nvis of

323+ Nothing -> return ()

324+ Just acc' -> if acc' > minAcc

325+ then tclift $ tfail (At fc

326+ (Msg $ show acc ++ " " ++ show n ++

327+ " can't refer to " ++

328+ show acc' ++ " " ++ show ref))

329+ else return ()

330+

331+

332+

src/Idris/ElabDecls.hs+2−2

@@ -242,9 +242,9 @@ elabDecl' what info (PClass doc s f cs n nfc ps pdocs fds ds cn cd)

242 | what /= EDefns

243 = do logElab 1 $ "Elaborating class " ++ show n

244 elabClass info (s { syn_params = [] }) doc f cs n nfc ps pdocs fds ds cn cd

245−elabDecl' what info (PInstance doc argDocs s f cs n nfc ps t expn ds)

245+elabDecl' what info (PInstance doc argDocs s f cs acc n nfc ps t expn ds)

246 = do logElab 1 $ "Elaborating instance " ++ show n

247− elabInstance info s doc argDocs what f cs n nfc ps t expn ds

247+ elabInstance info s doc argDocs what f cs acc n nfc ps t expn ds

248elabDecl' what info (PRecord doc rsyn fc opts name nfc ps pdocs fs cname cdoc csyn)

249 = do logElab 1 $ "Elaborating record " ++ show name

250 elabRecord info what doc rsyn fc opts name nfc ps pdocs fs cname cdoc csyn

src/Idris/IBC.hs+88−62

@@ -3,7 +3,7 @@

3

4module Idris.IBC (loadIBC, loadPkgIndex,

5 writeIBC, writePkgIndex,

6− hasValidIBCVersion) where

6+ hasValidIBCVersion, IBCPhase(..)) where

7

8import Idris.Core.Evaluate

9import Idris.Core.TT

@@ -40,10 +40,18 @@ import System.Directory

40import Codec.Archive.Zip

41

42ibcVersion :: Word16

43−ibcVersion = 128

43+ibcVersion = 132

44+

45+-- When IBC is being loaded - we'll load different things (and omit different

46+-- structures/definitions) depending on which phase we're in

47+data IBCPhase = IBC_Building -- ^ when building the module tree

48+ | IBC_REPL Bool -- ^ when loading modules for the REPL

49+ -- Bool = True for top level module

50+ deriving (Show, Eq)

44

51

45data IBCFile = IBCFile { ver :: Word16,

52data IBCFile = IBCFile { ver :: Word16,

46 sourcefile :: FilePath,

53 sourcefile :: FilePath,

54+ ibc_reachablenames :: ![Name],

47 ibc_imports :: ![(Bool, FilePath)],

55 ibc_imports :: ![(Bool, FilePath)],

48 ibc_importdirs :: ![FilePath],

56 ibc_importdirs :: ![FilePath],

49 ibc_implicits :: ![(Name, [PArg])],

57 ibc_implicits :: ![(Name, [PArg])],

@@ -62,13 +70,10 @@ data IBCFile = IBCFile { ver :: Word16,

62 ibc_cgflags :: ![(Codegen, String)],

70 ibc_cgflags :: ![(Codegen, String)],

63 ibc_dynamic_libs :: ![String],

71 ibc_dynamic_libs :: ![String],

64 ibc_hdrs :: ![(Codegen, String)],

72 ibc_hdrs :: ![(Codegen, String)],

65− ibc_access :: ![(Name, Accessibility)],

66− ibc_total :: ![(Name, Totality)],

67 ibc_totcheckfail :: ![(FC, String)],

73 ibc_totcheckfail :: ![(FC, String)],

68 ibc_flags :: ![(Name, [FnOpt])],

74 ibc_flags :: ![(Name, [FnOpt])],

69 ibc_fninfo :: ![(Name, FnInfo)],

75 ibc_fninfo :: ![(Name, FnInfo)],

70 ibc_cg :: ![(Name, CGInfo)],

76 ibc_cg :: ![(Name, CGInfo)],

71− ibc_defs :: ![(Name, Def)],

72 ibc_docstrings :: ![(Name, (Docstring D.DocTerm, [(Name, Docstring D.DocTerm)]))],

77 ibc_docstrings :: ![(Name, (Docstring D.DocTerm, [(Name, Docstring D.DocTerm)]))],

73 ibc_moduledocs :: ![(Name, Docstring D.DocTerm)],

78 ibc_moduledocs :: ![(Name, Docstring D.DocTerm)],

74 ibc_transforms :: ![(Name, (Term, Term))],

79 ibc_transforms :: ![(Name, (Term, Term))],

@@ -87,7 +92,10 @@ data IBCFile = IBCFile { ver :: Word16,

87 ibc_usage :: ![(Name, Int)],

92 ibc_usage :: ![(Name, Int)],

88 ibc_exports :: ![Name],

93 ibc_exports :: ![Name],

89 ibc_autohints :: ![(Name, Name)],

94 ibc_autohints :: ![(Name, Name)],

90− ibc_deprecated :: ![(Name, String)]

95+ ibc_deprecated :: ![(Name, String)],

96+ ibc_defs :: ![(Name, Def)],

97+ ibc_total :: ![(Name, Totality)],

98+ ibc_access :: ![(Name, Accessibility)]

91 }

99 }

92 deriving Show

100 deriving Show

93{-!

101{-!

@@ -95,7 +103,7 @@ deriving instance Binary IBCFile

95!-}

103!-}

96

104

97initIBC :: IBCFile

105initIBC :: IBCFile

98−initIBC = IBCFile ibcVersion "" [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] Nothing [] [] [] []

106+initIBC = IBCFile ibcVersion "" [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] Nothing [] [] [] [] [] [] []

99

107

100hasValidIBCVersion :: FilePath -> Idris Bool

108hasValidIBCVersion :: FilePath -> Idris Bool

101hasValidIBCVersion fp = do

109hasValidIBCVersion fp = do

@@ -106,8 +114,9 @@ hasValidIBCVersion fp = do

106 return (ver == ibcVersion)

114 return (ver == ibcVersion)

107

115

108loadIBC :: Bool -- ^ True = reexport, False = make everything private

116loadIBC :: Bool -- ^ True = reexport, False = make everything private

117+ -> IBCPhase

109 -> FilePath -> Idris ()

118 -> FilePath -> Idris ()

110−loadIBC reexport fp

119+loadIBC reexport phase fp

111 = do imps <- getImported

120 = do imps <- getImported

112 let redo = case lookup fp imps of

121 let redo = case lookup fp imps of

113 Nothing -> True

122 Nothing -> True

@@ -118,15 +127,16 @@ loadIBC reexport fp

118 case toArchiveOrFail archiveFile of

127 case toArchiveOrFail archiveFile of

119 Left _ -> ifail $ fp ++ " isn't loadable, it may have an old ibc format.\n"

128 Left _ -> ifail $ fp ++ " isn't loadable, it may have an old ibc format.\n"

120 ++ "Please clean and rebuild it."

129 ++ "Please clean and rebuild it."

121− Right archive -> do process reexport archive fp

130+ Right archive -> do process reexport phase archive fp

122 addImported reexport fp

131 addImported reexport fp

132+-- dumpTT

123

133

124-- | Load an entire package from its index file

134-- | Load an entire package from its index file

125loadPkgIndex :: String -> Idris ()

135loadPkgIndex :: String -> Idris ()

126loadPkgIndex pkg = do ddir <- runIO $ getIdrisLibDir

136loadPkgIndex pkg = do ddir <- runIO $ getIdrisLibDir

127 addImportDir (ddir </> pkg)

137 addImportDir (ddir </> pkg)

128 fp <- findPkgIndex pkg

138 fp <- findPkgIndex pkg

129− loadIBC True fp

139+ loadIBC True IBC_Building fp

130

140

131

141

132makeEntry :: (Binary b) => String -> [b] -> Maybe Entry

142makeEntry :: (Binary b) => String -> [b] -> Maybe Entry

@@ -156,13 +166,10 @@ entries i = catMaybes [Just $ toEntry "ver" 0 (encode $ ver i),

156 makeEntry "ibc_cgflags" (ibc_cgflags i),

166 makeEntry "ibc_cgflags" (ibc_cgflags i),

157 makeEntry "ibc_dynamic_libs" (ibc_dynamic_libs i),

167 makeEntry "ibc_dynamic_libs" (ibc_dynamic_libs i),

158 makeEntry "ibc_hdrs" (ibc_hdrs i),

168 makeEntry "ibc_hdrs" (ibc_hdrs i),

159− makeEntry "ibc_access" (ibc_access i),

160− makeEntry "ibc_total" (ibc_total i),

161 makeEntry "ibc_totcheckfail" (ibc_totcheckfail i),

169 makeEntry "ibc_totcheckfail" (ibc_totcheckfail i),

162 makeEntry "ibc_flags" (ibc_flags i),

170 makeEntry "ibc_flags" (ibc_flags i),

163 makeEntry "ibc_fninfo" (ibc_fninfo i),

171 makeEntry "ibc_fninfo" (ibc_fninfo i),

164 makeEntry "ibc_cg" (ibc_cg i),

172 makeEntry "ibc_cg" (ibc_cg i),

165− makeEntry "ibc_defs" (ibc_defs i),

166 makeEntry "ibc_docstrings" (ibc_docstrings i),

173 makeEntry "ibc_docstrings" (ibc_docstrings i),

167 makeEntry "ibc_moduledocs" (ibc_moduledocs i),

174 makeEntry "ibc_moduledocs" (ibc_moduledocs i),

168 makeEntry "ibc_transforms" (ibc_transforms i),

175 makeEntry "ibc_transforms" (ibc_transforms i),

@@ -181,7 +188,10 @@ entries i = catMaybes [Just $ toEntry "ver" 0 (encode $ ver i),

181 makeEntry "ibc_usage" (ibc_usage i),

188 makeEntry "ibc_usage" (ibc_usage i),

182 makeEntry "ibc_exports" (ibc_exports i),

189 makeEntry "ibc_exports" (ibc_exports i),

183 makeEntry "ibc_autohints" (ibc_autohints i),

190 makeEntry "ibc_autohints" (ibc_autohints i),

184− makeEntry "ibc_deprecated" (ibc_deprecated i)]

191+ makeEntry "ibc_deprecated" (ibc_deprecated i),

192+ makeEntry "ibc_defs" (ibc_defs i),

193+ makeEntry "ibc_total" (ibc_total i),

194+ makeEntry "ibc_access" (ibc_access i)]

185

195

186writeArchive :: FilePath -> IBCFile -> Idris ()

196writeArchive :: FilePath -> IBCFile -> Idris ()

187writeArchive fp i = do let a = L.foldl (\x y -> addEntryToArchive y x) emptyArchive (entries i)

197writeArchive fp i = do let a = L.foldl (\x y -> addEntryToArchive y x) emptyArchive (entries i)

@@ -315,8 +325,9 @@ getEntry alt f a = case findEntryByPath f a of

315 Just e -> return $! (force . decode . fromEntry) e

325 Just e -> return $! (force . decode . fromEntry) e

316

326

317process :: Bool -- ^ Reexporting

327process :: Bool -- ^ Reexporting

328+ -> IBCPhase

318 -> Archive -> FilePath -> Idris ()

329 -> Archive -> FilePath -> Idris ()

319−process reexp i fn = do

330+process reexp phase i fn = do

320 ver <- getEntry 0 "ver" i

331 ver <- getEntry 0 "ver" i

321 when (ver /= ibcVersion) $ do

332 when (ver /= ibcVersion) $ do

322 logIBC 1 "ibc out of date"

333 logIBC 1 "ibc out of date"

@@ -328,7 +339,7 @@ process reexp i fn = do

328 srcok <- runIO $ doesFileExist source

339 srcok <- runIO $ doesFileExist source

329 when srcok $ timestampOlder source fn

340 when srcok $ timestampOlder source fn

330 pImportDirs =<< getEntry [] "ibc_importdirs" i

341 pImportDirs =<< getEntry [] "ibc_importdirs" i

331− pImports reexp =<< getEntry [] "ibc_imports" i

342+ pImports reexp phase =<< getEntry [] "ibc_imports" i

332 pImps =<< getEntry [] "ibc_implicits" i

343 pImps =<< getEntry [] "ibc_implicits" i

333 pFixes =<< getEntry [] "ibc_fixes" i

344 pFixes =<< getEntry [] "ibc_fixes" i

334 pStatics =<< getEntry [] "ibc_statics" i

345 pStatics =<< getEntry [] "ibc_statics" i

@@ -345,12 +356,9 @@ process reexp i fn = do

345 pCGFlags =<< getEntry [] "ibc_cgflags" i

356 pCGFlags =<< getEntry [] "ibc_cgflags" i

346 pDyLibs =<< getEntry [] "ibc_dynamic_libs" i

357 pDyLibs =<< getEntry [] "ibc_dynamic_libs" i

347 pHdrs =<< getEntry [] "ibc_hdrs" i

358 pHdrs =<< getEntry [] "ibc_hdrs" i

348− pDefs reexp =<< getEntry [] "ibc_defs" i

349 pPatdefs =<< getEntry [] "ibc_patdefs" i

359 pPatdefs =<< getEntry [] "ibc_patdefs" i

350− pAccess reexp =<< getEntry [] "ibc_access" i

351 pFlags =<< getEntry [] "ibc_flags" i

360 pFlags =<< getEntry [] "ibc_flags" i

352 pFnInfo =<< getEntry [] "ibc_fninfo" i

361 pFnInfo =<< getEntry [] "ibc_fninfo" i

353− pTotal =<< getEntry [] "ibc_total" i

354 pTotCheckErr =<< getEntry [] "ibc_totcheckfail" i

362 pTotCheckErr =<< getEntry [] "ibc_totcheckfail" i

355 pCG =<< getEntry [] "ibc_cg" i

363 pCG =<< getEntry [] "ibc_cg" i

356 pDocs =<< getEntry [] "ibc_docstrings" i

364 pDocs =<< getEntry [] "ibc_docstrings" i

@@ -371,6 +379,9 @@ process reexp i fn = do

371 pExports =<< getEntry [] "ibc_exports" i

379 pExports =<< getEntry [] "ibc_exports" i

372 pAutoHints =<< getEntry [] "ibc_autohints" i

380 pAutoHints =<< getEntry [] "ibc_autohints" i

373 pDeprecate =<< getEntry [] "ibc_deprecated" i

381 pDeprecate =<< getEntry [] "ibc_deprecated" i

382+ pDefs reexp =<< getEntry [] "ibc_defs" i

383+ pTotal =<< getEntry [] "ibc_total" i

384+ pAccess reexp phase =<< getEntry [] "ibc_access" i

374

385

375timestampOlder :: FilePath -> FilePath -> Idris ()

386timestampOlder :: FilePath -> FilePath -> Idris ()

376timestampOlder src ibc = do srct <- runIO $ getModificationTime src

387timestampOlder src ibc = do srct <- runIO $ getModificationTime src

@@ -404,8 +415,8 @@ pDeprecate ns = mapM_ (\(n,reason) -> addDeprecated n reason) ns

404pImportDirs :: [FilePath] -> Idris ()

415pImportDirs :: [FilePath] -> Idris ()

405pImportDirs fs = mapM_ addImportDir fs

416pImportDirs fs = mapM_ addImportDir fs

406

417

407−pImports :: Bool -> [(Bool, FilePath)] -> Idris ()

418+pImports :: Bool -> IBCPhase -> [(Bool, FilePath)] -> Idris ()

408−pImports reexp fs

419+pImports reexp phase fs

409 = do mapM_ (\(re, f) ->

420 = do mapM_ (\(re, f) ->

410 do i <- getIState

421 do i <- getIState

411 ibcsd <- valIBCSubDir i

422 ibcsd <- valIBCSubDir i

@@ -414,6 +425,9 @@ pImports reexp fs

414-- if (f `elem` imported i)

425-- if (f `elem` imported i)

415-- then logLvl 1 $ "Already read " ++ f

426-- then logLvl 1 $ "Already read " ++ f

416 putIState (i { imported = f : imported i })

427 putIState (i { imported = f : imported i })

428+ let phase' = case phase of

429+ IBC_REPL _ -> IBC_REPL False

430+ p -> p

417 case fp of

431 case fp of

418 LIDR fn -> do

432 LIDR fn -> do

419 logIBC 1 $ "Failed at " ++ fn

433 logIBC 1 $ "Failed at " ++ fn

@@ -421,7 +435,7 @@ pImports reexp fs

421 IDR fn -> do

435 IDR fn -> do

422 logIBC 1 $ "Failed at " ++ fn

436 logIBC 1 $ "Failed at " ++ fn

423 ifail "Must be an ibc"

437 ifail "Must be an ibc"

424− IBC fn src -> loadIBC (reexp && re) fn)

438+ IBC fn src -> loadIBC (reexp && re) phase' fn)

425 fs

439 fs

426

440

427pImps :: [(Name, [PArg])] -> Idris ()

441pImps :: [(Name, [PArg])] -> Idris ()

@@ -520,10 +534,7 @@ pDefs reexp ds

520 _ -> do logIBC 1 $ "SOLVING " ++ show n

534 _ -> do logIBC 1 $ "SOLVING " ++ show n

521 solveDeferred n

535 solveDeferred n

522 updateIState (\i -> i { tt_ctxt = addCtxtDef n d' (tt_ctxt i) })

536 updateIState (\i -> i { tt_ctxt = addCtxtDef n d' (tt_ctxt i) })

523−-- logLvl 1 $ "Added " ++ show (n, d')

537+ ) ds

524− if (not reexp) then do logIBC 1 $ "Not exporting " ++ show n

525− setAccessibility n Hidden

526− else logIBC 1 $ "Exporting " ++ show n) ds

527 where

538 where

528 updateDef (CaseOp c t args o s cd)

539 updateDef (CaseOp c t args o s cd)

529 = do o' <- mapM updateOrig o

540 = do o' <- mapM updateOrig o

@@ -537,11 +548,9 @@ pDefs reexp ds

537 return $ Right (l', r')

548 return $ Right (l', r')

538

549

539 updateCD (CaseDefs (ts, t) (cs, c) (is, i) (rs, r))

550 updateCD (CaseDefs (ts, t) (cs, c) (is, i) (rs, r))

540− = do t' <- updateSC t

541− c' <- updateSC c

551+ = do c' <- updateSC c

542− i' <- updateSC i

543 r' <- updateSC r

552 r' <- updateSC r

544− return $ CaseDefs (ts, t') (cs, c') (is, i') (rs, r')

553+ return $ CaseDefs (cs, c') (cs, c') (cs, c') (rs, r')

545

554

546 updateSC (Case t n alts) = do alts' <- mapM updateAlt alts

555 updateSC (Case t n alts) = do alts' <- mapM updateAlt alts

547 return (Case t n alts')

556 return (Case t n alts')

@@ -562,19 +571,28 @@ pDefs reexp ds

562 updateAlt (DefaultCase t) = do t' <- updateSC t

571 updateAlt (DefaultCase t) = do t' <- updateSC t

563 return (DefaultCase t')

572 return (DefaultCase t')

564

573

574+ -- We get a lot of repetition in sub terms and can save a fair chunk

575+ -- of memory if we make sure they're shared. addTT looks for a term

576+ -- and returns it if it exists already, while also keeping stats of

577+ -- how many times a subterm is repeated.

578+ update t = do tm <- addTT t

579+ case tm of

580+ Nothing -> update' t

581+ Just t' -> return t'

582+

565− update (P t n ty) = do n' <- getSymbol n

583+ update' (P t n ty) = do n' <- getSymbol n

566− return $ P t n' ty

584+ return $ P t n' ty

567− update (App s f a) = liftM2 (App s) (update f) (update a)

585+ update' (App s f a) = liftM2 (App s) (update' f) (update' a)

568− update (Bind n b sc) = do b' <- updateB b

586+ update' (Bind n b sc) = do b' <- updateB b

569− sc' <- update sc

587+ sc' <- update sc

570− return $ Bind n b' sc'

588+ return $ Bind n b' sc'

571 where

589 where

572− updateB (Let t v) = liftM2 Let (update t) (update v)

590+ updateB (Let t v) = liftM2 Let (update' t) (update' v)

573− updateB b = do ty' <- update (binderTy b)

591+ updateB b = do ty' <- update' (binderTy b)

574 return (b { binderTy = ty' })

592 return (b { binderTy = ty' })

575− update (Proj t i) = do t' <- update t

593+ update' (Proj t i) = do t' <- update' t

576− return $ Proj t' i

594+ return $ Proj t' i

577− update t = return t

595+ update' t = return t

578

596

579pDocs :: [(Name, (Docstring D.DocTerm, [(Name, Docstring D.DocTerm)]))] -> Idris ()

597pDocs :: [(Name, (Docstring D.DocTerm, [(Name, Docstring D.DocTerm)]))] -> Idris ()

580pDocs ds = mapM_ (\(n, a) -> addDocStr n (fst a) (snd a)) ds

598pDocs ds = mapM_ (\(n, a) -> addDocStr n (fst a) (snd a)) ds

@@ -584,12 +602,22 @@ pMDocs ds = mapM_ (\ (n, d) -> updateIState (\i ->

584 i { idris_moduledocs = addDef n d (idris_moduledocs i) })) ds

602 i { idris_moduledocs = addDef n d (idris_moduledocs i) })) ds

585

603

586pAccess :: Bool -- ^ Reexporting?

604pAccess :: Bool -- ^ Reexporting?

605+ -> IBCPhase

587 -> [(Name, Accessibility)] -> Idris ()

606 -> [(Name, Accessibility)] -> Idris ()

588−pAccess reexp ds

607+pAccess reexp phase ds

589 = mapM_ (\ (n, a_in) ->

608 = mapM_ (\ (n, a_in) ->

590 do let a = if reexp then a_in else Hidden

609 do let a = if reexp then a_in else Hidden

591 logIBC 3 $ "Setting " ++ show (a, n) ++ " to " ++ show a

610 logIBC 3 $ "Setting " ++ show (a, n) ++ " to " ++ show a

592− updateIState (\i -> i { tt_ctxt = setAccess n a (tt_ctxt i) })) ds

611+ updateIState (\i -> i { tt_ctxt = setAccess n a (tt_ctxt i) })

612+

613+ if (not reexp) then do logIBC 1 $ "Not exporting " ++ show n

614+ setAccessibility n Hidden

615+ else logIBC 1 $ "Exporting " ++ show n

616+ -- Everything should be available at the REPL from

617+ -- things imported publicly

618+ when (phase == IBC_REPL True) $

619+ setAccessibility n Public

620+ ) ds

593

621

594pFlags :: [(Name, [FnOpt])] -> Idris ()

622pFlags :: [(Name, [FnOpt])] -> Idris ()

595pFlags ds = mapM_ (\ (n, a) -> setFlags n a) ds

623pFlags ds = mapM_ (\ (n, a) -> setFlags n a) ds

@@ -753,18 +781,14 @@ instance Binary SizeChange where

753 _ -> error "Corrupted binary data for SizeChange"

781 _ -> error "Corrupted binary data for SizeChange"

754

782

755instance Binary CGInfo where

783instance Binary CGInfo where

756− put (CGInfo x1 x2 x3 x4 x5)

784+ put (CGInfo x1 x2 x3)

757 = do put x1

785 = do put x1

758− put x2

759-- put x3 -- Already used SCG info for totality check

786-- put x3 -- Already used SCG info for totality check

760− put x4

787+ put x3

761− put x5

762 get

788 get

763 = do x1 <- get

789 = do x1 <- get

764− x2 <- get

765− x4 <- get

766− x5 <- get

790+ x3 <- get

767− return (CGInfo x1 x2 [] x4 x5)

791+ return (CGInfo x1 [] x3)

768

792

769instance Binary CaseType where

793instance Binary CaseType where

770 put x = case x of

794 put x = case x of

@@ -883,13 +907,13 @@ instance Binary Def where

883 put x2

907 put x2

884 -- all primitives just get added at the start, don't write

908 -- all primitives just get added at the start, don't write

885 Operator x1 x2 x3 -> do return ()

909 Operator x1 x2 x3 -> do return ()

910+ -- no need to add/load original patterns, because they're not

911+ -- used again after totality checking

886− CaseOp x1 x2 x2a x3 x3a x4 -> do putWord8 3

912+ CaseOp x1 x2 x3 _ _ x4 -> do putWord8 3

887− put x1

913+ put x1

888− put x2

914+ put x2

889− put x2a

890− put x3

915+ put x3

891− -- no x3a

892− put x4

916+ put x4

893 get

917 get

894 = do i <- getWord8

918 = do i <- getWord8

895 case i of

919 case i of

@@ -903,10 +927,10 @@ instance Binary Def where

903 3 -> do x1 <- get

927 3 -> do x1 <- get

904 x2 <- get

928 x2 <- get

905 x3 <- get

929 x3 <- get

906− x4 <- get

930+-- x4 <- get

907 -- x3 <- get always []

931 -- x3 <- get always []

908 x5 <- get

932 x5 <- get

909− return (CaseOp x1 x2 x3 x4 [] x5)

933+ return (CaseOp x1 x2 x3 [] [] x5)

910 _ -> error "Corrupted binary data for Def"

934 _ -> error "Corrupted binary data for Def"

911

935

912instance Binary Accessibility where

936instance Binary Accessibility where

@@ -1235,7 +1259,7 @@ instance (Binary t) => Binary (PDecl' t) where

1235 put x10

1259 put x10

1236 put x11

1260 put x11

1237 put x12

1261 put x12

1238− PInstance x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 ->

1262+ PInstance x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 ->

1239 do putWord8 8

1263 do putWord8 8

1240 put x1

1264 put x1

1241 put x2

1265 put x2

@@ -1248,6 +1272,7 @@ instance (Binary t) => Binary (PDecl' t) where

1248 put x9

1272 put x9

1249 put x10

1273 put x10

1250 put x11

1274 put x11

1275+ put x12

1251 PDSL x1 x2 -> do putWord8 9

1276 PDSL x1 x2 -> do putWord8 9

1252 put x1

1277 put x1

1253 put x2

1278 put x2

@@ -1362,7 +1387,8 @@ instance (Binary t) => Binary (PDecl' t) where

1362 x9 <- get

1387 x9 <- get

1363 x10 <- get

1388 x10 <- get

1364 x11 <- get

1389 x11 <- get

1390+ x12 <- get

1365− return (PInstance x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11)

1391+ return (PInstance x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12)

1366 9 -> do x1 <- get

1392 9 -> do x1 <- get

1367 x2 <- get

1393 x2 <- get

1368 return (PDSL x1 x2)

1394 return (PDSL x1 x2)

src/Idris/IdrisDoc.hs+1−1

@@ -581,7 +581,7 @@ createOtherDoc ist (FunDoc fd) = createFunDoc ist fd

581

582createOtherDoc ist (ClassDoc n docstring fds _ _ _ _ c) = do

583 H.dt ! (A.id $ toValue $ show n) $ do

584− H.span ! class_ "word" $ do "class"; nbsp

584+ H.span ! class_ "word" $ do "interface"; nbsp

585 H.span ! class_ "name type"

586 ! title (toValue $ show n)

587 $ toHtml $ name $ nsroot n

src/Idris/Interactive.hs+28−11

@@ -238,7 +238,7 @@ doProofSearch fn updatefile rec l n hints (Just depth)

238 let body t = PProof [Try (TSeq Intros (ProofSearch rec False depth t psnames hints))

239 (ProofSearch rec False depth t psnames hints)]

240 let def = PClause fc mn (PRef fc [] mn) [] (body top) []

241− newmv <- idrisCatch

241+ newmv_pre <- idrisCatch

242 (do elabDecl' EAll recinfo (PClauses fc [] mn [def])

243 (tm, ty) <- elabVal recinfo ERHS (PRef fc [] mn)

244 ctxt <- getContext

@@ -249,10 +249,11 @@ doProofSearch fn updatefile rec l n hints (Just depth)

249 (dropCtxt envlen

250 (delab i (fst (specialise ctxt [] [(mn, 1)] tm))))))

251 (\e -> return ("?" ++ show n))

252+ let newmv = guessBrackets False tyline (show n) newmv_pre

252 if updatefile then

253 if updatefile then

253 do let fb = fn ++ "~"

254 do let fb = fn ++ "~"

254 runIO $ writeSource fb (unlines before ++

255 runIO $ writeSource fb (unlines before ++

255− updateMeta False tyline (show n) newmv ++ "\n"

256+ updateMeta tyline (show n) newmv ++ "\n"

256 ++ unlines later)

257 ++ unlines later)

257 runIO $ copyFile fb fn

258 runIO $ copyFile fb fn

258 else iPrintResult newmv

259 else iPrintResult newmv

@@ -270,18 +271,34 @@ doProofSearch fn updatefile rec l n hints (Just depth)

270 nsroot (SN (WhereN _ _ n)) = nsroot n

271 nsroot (SN (WhereN _ _ n)) = nsroot n

271 nsroot n = n

272 nsroot n = n

272

273

273−updateMeta brack ('?':cs) n new

274+updateMeta ('?':cs) n new

274 | length cs >= length n

275 | length cs >= length n

275 = case splitAt (length n) cs of

276 = case splitAt (length n) cs of

276 (mv, c:cs) ->

277 (mv, c:cs) ->

277 if ((isSpace c || c == ')' || c == '}') && mv == n)

278 if ((isSpace c || c == ')' || c == '}') && mv == n)

279+ then new ++ (c : cs)

280+ else '?' : mv ++ c : updateMeta cs n new

281+ (mv, []) -> if (mv == n) then new else '?' : mv

282+updateMeta ('=':'>':cs) n new = '=':'>':updateMeta cs n new

283+updateMeta ('=':cs) n new = '=':updateMeta cs n new

284+updateMeta (c:cs) n new

285+ = c : updateMeta cs n new

286+updateMeta [] n new = ""

287+

288+guessBrackets brack ('?':cs) n new

289+ | length cs >= length n

290+ = case splitAt (length n) cs of

291+ (mv, c:cs) ->

292+ if ((isSpace c || c == ')' || c == '}') && mv == n)

278− then addBracket brack new ++ (c : cs)

293+ then addBracket brack new

279− else '?' : mv ++ c : updateMeta True cs n new

294+ else guessBrackets True cs n new

280 (mv, []) -> if (mv == n) then addBracket brack new else '?' : mv

295 (mv, []) -> if (mv == n) then addBracket brack new else '?' : mv

281−updateMeta brack ('=':cs) n new = '=':updateMeta False cs n new

296+guessBrackets brack ('=':'>':cs) n new = guessBrackets False cs n new

297+guessBrackets brack ('-':'>':cs) n new = guessBrackets False cs n new

298+guessBrackets brack ('=':cs) n new = guessBrackets False cs n new

282−updateMeta brack (c:cs) n new

299+guessBrackets brack (c:cs) n new

283− = c : updateMeta (brack || not (isSpace c)) cs n new

300+ = guessBrackets (brack || not (isSpace c)) cs n new

284−updateMeta brack [] n new = ""

301+guessBrackets brack [] n new = ""

285

302

286checkProv line n = isProv' False line n

303checkProv line n = isProv' False line n

287 where

304 where

@@ -326,7 +343,7 @@ makeLemma fn updatefile l n

326 constraints i classes mty ++

343 constraints i classes mty ++

327 showTmOpts (defaultPPOption { ppopt_pinames = True })

344 showTmOpts (defaultPPOption { ppopt_pinames = True })

328 (stripMNBind skip margs (delab i mty))

345 (stripMNBind skip margs (delab i mty))

329− let lem_app = show n ++ appArgs skip margs mty

346+ let lem_app = guessBrackets False tyline (show n) (show n ++ appArgs skip margs mty)

330

347

331 if updatefile then

348 if updatefile then

332 do let fb = fn ++ "~"

349 do let fb = fn ++ "~"

@@ -454,7 +471,7 @@ makeLemma fn updatefile l n

454 = case span (not . blank) (reverse before) of

471 = case span (not . blank) (reverse before) of

455 (bef, []) -> (bef, "" : [])

472 (bef, []) -> (bef, "" : [])

456 x -> x

473 x -> x

457− mvline = updateMeta False tyline (show n) lem_app in

474+ mvline = updateMeta tyline (show n) lem_app in

458 unlines $ reverse bef_start ++

475 unlines $ reverse bef_start ++

459 [blankline, lem, blankline] ++

476 [blankline, lem, blankline] ++

460 reverse bef_end ++ mvline : later

477 reverse bef_end ++ mvline : later

src/Idris/ParseData.hs+8−8

@@ -48,7 +48,7 @@ record syn = do (doc, paramDocs, acc, opts) <- try (do

48 let doc' = annotCode (tryFullExpr syn ist) doc

49 paramDocs' = [ (n, annotCode (tryFullExpr syn ist) d)

50 | (n, d) <- paramDocs ]

51− acc <- optional accessibility

51+ acc <- accessibility

52 opts <- dataOpts []

53 co <- recordI

54 return (doc', paramDocs', acc, opts ++ co))

@@ -59,8 +59,9 @@ record syn = do (doc, paramDocs, acc, opts) <- try (do

59 syn_namespace syn }

60 params <- manyTill (recordParameter rsyn) (reservedHL "where")

61 (fields, cname, cdoc) <- indentedBlockS $ recordBody rsyn tyn

62+ let fnames = map (expandNS rsyn) (mapMaybe getName fields)

62 case cname of

63 case cname of

63− Just cn' -> accData acc tyn [fst cn']

64+ Just cn' -> accData acc tyn (fst cn' : fnames)

64 Nothing -> return ()

65 Nothing -> return ()

65 return $ PRecord doc rsyn fc opts tyn nfc params paramDocs fields cname cdoc syn

66 return $ PRecord doc rsyn fc opts tyn nfc params paramDocs fields cname cdoc syn

66 <?> "record type declaration"

67 <?> "record type declaration"

@@ -70,6 +71,9 @@ record syn = do (doc, paramDocs, acc, opts) <- try (do

70 ++ getRecNames syn sc

71 ++ getRecNames syn sc

71 getRecNames _ _ = []

72 getRecNames _ _ = []

72

73

74+ getName (Just (n, _), _, _, _) = Just n

75+ getName _ = Nothing

76+

73 toFreeze :: Maybe Accessibility -> Maybe Accessibility

77 toFreeze :: Maybe Accessibility -> Maybe Accessibility

74 toFreeze (Just Frozen) = Just Hidden

78 toFreeze (Just Frozen) = Just Hidden

75 toFreeze x = x

79 toFreeze x = x

@@ -167,11 +171,7 @@ dataOpts opts

167 <|> return opts

171 <|> return opts

168 <?> "data options"

172 <?> "data options"

169 where warnElim fc =

173 where warnElim fc =

170− do ist <- get

174+ parserWarning fc (Just NoElimDeprecationWarnings) (Msg "The 'class' keyword is deprecated. Use 'interface' instead.")

171− let cmdline = opt_cmdline (idris_options ist)

172− unless (NoElimDeprecationWarnings `elem` cmdline) $

173− put ist { parserWarnings =

174− (fc, Msg "Eliminator generation is deprecated. Use an eliminator generator in a library instead.") : parserWarnings ist }

175

176{- | Parses a data type declaration

177Data ::= DocComment? Accessibility? DataI DefaultEliminator FnName TypeSig ExplicitTypeDataRest?

@@ -192,7 +192,7 @@ data_ :: SyntaxInfo -> IdrisParser PDecl

192data_ syn = do (doc, argDocs, acc, dataOpts) <- try (do

193 (doc, argDocs) <- option noDocs docComment

194 pushIndent

195− acc <- optional accessibility

195+ acc <- accessibility

196 elim <- dataOpts []

197 co <- dataI

198 ist <- get

src/Idris/ParseExpr.hs+6−6

@@ -333,11 +333,7 @@ caseOption syn = do lhs <- expr (syn { inPattern = True })

333

334warnTacticDeprecation :: FC -> IdrisParser ()

335warnTacticDeprecation fc =

336− do ist <- get

337− let cmdline = opt_cmdline (idris_options ist)

338− unless (NoOldTacticDeprecationWarnings `elem` cmdline) $

339− put ist { parserWarnings =

340− (fc, Msg "This style of tactic proof is deprecated. See %runElab for the replacement.") : parserWarnings ist }

336+ parserWarning fc (Just NoOldTacticDeprecationWarnings) (Msg "This style of tactic proof is deprecated. See %runElab for the replacement.")

341

337

342{- | Parses a proof block

338{- | Parses a proof block

343@

339@

@@ -1389,7 +1385,11 @@ Static ::=

1389@

1385@

1390-}

1386-}

1391static :: IdrisParser Static

1387static :: IdrisParser Static

1392−static = do reserved "[static]"; return Static

1388+static = do reserved "%static"; return Static

1389+ <|> do reserved "[static]"

1390+ fc <- getFC

1391+ parserWarning fc Nothing (Msg "The use of [static] is deprecated, use %static instead.")

1392+ return Static

1393 <|> return Dynamic

1394 <?> "static modifier"

1395

src/Idris/ParseHelpers.hs+45−12

@@ -7,7 +7,7 @@ module Idris.ParseHelpers where

7import Prelude hiding (pi)

8

9import Text.Trifecta.Delta

10−import Text.Trifecta hiding (span, stringLiteral, charLiteral, natural, symbol, char, string, whiteSpace)

10+import Text.Trifecta hiding (span, stringLiteral, charLiteral, natural, symbol, char, string, whiteSpace, Err)

11import Text.Parser.LookAhead

12import Text.Parser.Expression

13import qualified Text.Parser.Token as Tok

@@ -105,6 +105,14 @@ reportParserWarnings = do ist <- getIState

105 parserWarnings ist)

106 clearParserWarnings

107

108+

109+parserWarning :: FC -> Maybe Opt -> Err -> IdrisParser ()

110+parserWarning fc warnOpt warnErr = do

111+ ist <- get

112+ let cmdline = opt_cmdline (idris_options ist)

113+ unless (maybe False (`elem` cmdline) warnOpt) $

114+ put ist { parserWarnings = (fc, warnErr) : parserWarnings ist }

115+

108{- * Space, comments and literals (token/lexing like parsers) -}

116{- * Space, comments and literals (token/lexing like parsers) -}

109

117

110-- | Consumes any simple whitespace (any character which satisfies Char.isSpace)

118-- | Consumes any simple whitespace (any character which satisfies Char.isSpace)

@@ -248,7 +256,7 @@ idrisStyle = IdentifierStyle _styleName _styleStart _styleLetter _styleReserved

248 "where", "with", "syntax", "proof", "postulate",

256 "where", "with", "syntax", "proof", "postulate",

249 "using", "namespace", "class", "instance",

257 "using", "namespace", "class", "instance",

250 "interface", "implementation", "parameters",

258 "interface", "implementation", "parameters",

251− "public", "private", "abstract", "implicit",

259+ "public", "private", "export", "abstract", "implicit",

252 "quoteGoal", "constructor",

260 "quoteGoal", "constructor",

253 "if", "then", "else"]

261 "if", "then", "else"]

254

262

@@ -612,22 +620,47 @@ notOpenBraces = do ist <- get

612 hasNothing = any isNothing

620 hasNothing = any isNothing

613

621

614{- | Parses an accessibilty modifier (e.g. public, private) -}

622{- | Parses an accessibilty modifier (e.g. public, private) -}

615−accessibility :: IdrisParser Accessibility

623+accessibility' :: IdrisParser Accessibility

624+accessibility'

616−accessibility = do reserved "public"; return Public

625+ = do reserved "public";

626+ gotexp <- optional (reserved "export")

627+ case gotexp of

628+ Just _ -> return ()

629+ Nothing -> do

630+ ist <- get

631+ fc <- getFC

632+ put ist { parserWarnings =

633+ (fc, Msg "'public' is deprecated. Use 'public export' instead.")

634+ : parserWarnings ist }

635+ return Public

617− <|> do reserved "abstract"; return Frozen

636+ <|> do reserved "abstract";

637+ ist <- get

638+ fc <- getFC

639+ put ist { parserWarnings =

640+ (fc, Msg "The 'abstract' keyword is deprecated. Use 'export' instead.")

641+ : parserWarnings ist }

642+ return Frozen

643+ <|> do reserved "export"; return Frozen

618 <|> do reserved "private"; return Hidden

644 <|> do reserved "private"; return Hidden

619 <?> "accessibility modifier"

645 <?> "accessibility modifier"

620

646

647+accessibility :: IdrisParser Accessibility

648+accessibility = do acc <- optional accessibility'

649+ case acc of

650+ Just a -> return a

651+ Nothing -> do ist <- get

652+ return (default_access ist)

653+

621-- | Adds accessibility option for function

654-- | Adds accessibility option for function

622−addAcc :: Name -> Maybe Accessibility -> IdrisParser ()

655+addAcc :: Name -> Accessibility -> IdrisParser ()

623addAcc n a = do i <- get

656addAcc n a = do i <- get

624− put (i { hide_list = (n, a) : hide_list i })

657+ put (i { hide_list = addDef n a (hide_list i) })

625

658

626{- | Add accessbility option for data declarations

659{- | Add accessbility option for data declarations

627 (works for classes too - 'abstract' means the data/class is visible but members not) -}

660 (works for classes too - 'abstract' means the data/class is visible but members not) -}

628−accData :: Maybe Accessibility -> Name -> [Name] -> IdrisParser ()

661+accData :: Accessibility -> Name -> [Name] -> IdrisParser ()

629−accData (Just Frozen) n ns = do addAcc n (Just Frozen)

662+accData Frozen n ns = do addAcc n Public -- so that it can be used in public definitions

630− mapM_ (\n -> addAcc n (Just Hidden)) ns

663+ mapM_ (\n -> addAcc n Hidden) ns -- so that they are invisible

631accData a n ns = do addAcc n a

664accData a n ns = do addAcc n a

632 mapM_ (`addAcc` a) ns

665 mapM_ (`addAcc` a) ns

633

666

@@ -662,7 +695,7 @@ collect (PMutual f ms : ds) = PMutual f (collect ms) : collect ds

662collect (PNamespace ns fc ps : ds) = PNamespace ns fc (collect ps) : collect ds

695collect (PNamespace ns fc ps : ds) = PNamespace ns fc (collect ps) : collect ds

663collect (PClass doc f s cs n nfc ps pdocs fds ds cn cd : ds')

696collect (PClass doc f s cs n nfc ps pdocs fds ds cn cd : ds')

664 = PClass doc f s cs n nfc ps pdocs fds (collect ds) cn cd : collect ds'

697 = PClass doc f s cs n nfc ps pdocs fds (collect ds) cn cd : collect ds'

665−collect (PInstance doc argDocs f s cs n nfc ps t en ds : ds')

698+collect (PInstance doc argDocs f s cs acc n nfc ps t en ds : ds')

666− = PInstance doc argDocs f s cs n nfc ps t en (collect ds) : collect ds'

699+ = PInstance doc argDocs f s cs acc n nfc ps t en (collect ds) : collect ds'

667collect (d : ds) = d : collect ds

700collect (d : ds) = d : collect ds

668collect [] = []

701collect [] = []

src/Idris/Parser.hs+40−41

@@ -337,8 +337,8 @@ declExtension syn ns rules =

337 (map (updateNs ns) ds)

338 (updateRecCon ns cname)

339 cdocs

340− updateNs ns (PInstance docs pdocs s fc cs cn fc' ps ity ni ds)

340+ updateNs ns (PInstance docs pdocs s fc cs acc cn fc' ps ity ni ds)

341− = PInstance docs pdocs s fc cs (updateB ns cn) fc'

341+ = PInstance docs pdocs s fc cs acc (updateB ns cn) fc'

342 ps ity (fmap (updateB ns) ni)

343 (map (updateNs ns) ds)

344 updateNs ns (PMutual fc ds) = PMutual fc (map (updateNs ns) ds)

@@ -584,7 +584,7 @@ fnDecl' syn = checkFixity $

584 then [TotalFn]

585 else []

586 opts <- fnOpts initOpts

587− acc <- optional accessibility

587+ acc <- accessibility

588 opts' <- fnOpts opts

589 (n_in, nfc) <- fnName

590 let n = expandNS syn n_in

@@ -698,7 +698,7 @@ postulate syn = do (doc, ext)

698 then [TotalFn]

699 else []

700 opts <- fnOpts initOpts

701− acc <- optional accessibility

701+ acc <- accessibility

702 opts' <- fnOpts opts

703 (n_in, nfc) <- fnName

704 let n = expandNS syn n_in

@@ -856,7 +856,7 @@ Class ::=

856class_ :: SyntaxInfo -> IdrisParser [PDecl]

857class_ syn = do (doc, argDocs, acc)

858 <- try (do (doc, argDocs) <- docstring syn

859− acc <- optional accessibility

859+ acc <- accessibility

860 classKeyword

861 return (doc, argDocs, acc))

862 fc <- getFC

@@ -878,10 +878,7 @@ class_ syn = do (doc, argDocs, acc)

878 classKeyword = reservedHL "interface"

879 <|> do reservedHL "class"

880 fc <- getFC

881− ist <- get

882− put ist { parserWarnings =

883− (fc, Msg "The 'class' keyword is deprecated. Use 'interface' instead.")

881+ parserWarning fc Nothing (Msg "The 'class' keyword is deprecated. Use 'interface' instead.")

884− : parserWarnings ist }

885

882

886 carg :: IdrisParser (Name, FC, PTerm)

883 carg :: IdrisParser (Name, FC, PTerm)

887 carg = do lchar '('; (i, ifc) <- name; lchar ':'; ty <- expr syn; lchar ')'

884 carg = do lchar '('; (i, ifc) <- name; lchar ':'; ty <- expr syn; lchar ')'

@@ -904,7 +901,8 @@ InstanceName ::= '[' Name ']';

904-}

901-}

905instance_ :: Bool -> SyntaxInfo -> IdrisParser [PDecl]

902instance_ :: Bool -> SyntaxInfo -> IdrisParser [PDecl]

906instance_ kwopt syn

903instance_ kwopt syn

904+ = do acc <- accessibility

907− = do (doc, argDocs)

905+ (doc, argDocs)

908 <- try (docstring syn <* if kwopt then optional instanceKeyword

906 <- try (docstring syn <* if kwopt then optional instanceKeyword

909 else do instanceKeyword

907 else do instanceKeyword

910 return (Just ()))

908 return (Just ()))

@@ -917,7 +915,7 @@ instance_ kwopt syn

917 let sc = PApp fc (PRef cnfc [cnfc] cn) (map pexp args)

915 let sc = PApp fc (PRef cnfc [cnfc] cn) (map pexp args)

918 let t = bindList (PPi constraint) cs sc

916 let t = bindList (PPi constraint) cs sc

919 ds <- instanceBlock syn

917 ds <- instanceBlock syn

920− return [PInstance doc argDocs syn fc cs' cn cnfc args t en ds]

918+ return [PInstance doc argDocs syn fc cs' acc cn cnfc args t en ds]

921 <?> "implementation declaration"

919 <?> "implementation declaration"

922 where instanceName :: IdrisParser Name

920 where instanceName :: IdrisParser Name

923 instanceName = do lchar '['; n_in <- fst <$> fnName; lchar ']'

921 instanceName = do lchar '['; n_in <- fst <$> fnName; lchar ']'

@@ -928,11 +926,7 @@ instance_ kwopt syn

928 instanceKeyword = reservedHL "implementation"

926 instanceKeyword = reservedHL "implementation"

929 <|> do reservedHL "instance"

927 <|> do reservedHL "instance"

930 fc <- getFC

928 fc <- getFC

931− ist <- get

932− put ist { parserWarnings =

933− (fc, Msg "The 'instance' keyword is deprecated. Use 'implementation' instead.")

929+ parserWarning fc Nothing (Msg "The 'instance' keyword is deprecated. Use 'implementation' (or omit it) instead.")

934− : parserWarnings ist }

935−

936

930

937-- | Parse a docstring

931-- | Parse a docstring

938docstring :: SyntaxInfo

932docstring :: SyntaxInfo

@@ -1321,7 +1315,10 @@ directive syn = do try (lchar '%' *> reserved "lib")

1321 return [PDirective (DHide n)]

1315 return [PDirective (DHide n)]

1322 <|> do try (lchar '%' *> reserved "freeze"); n <- fst <$> iName []

1316 <|> do try (lchar '%' *> reserved "freeze"); n <- fst <$> iName []

1323 return [PDirective (DFreeze n)]

1317 return [PDirective (DFreeze n)]

1324− <|> do try (lchar '%' *> reserved "access"); acc <- accessibility

1318+ <|> do try (lchar '%' *> reserved "access")

1319+ acc <- accessibility

1320+ ist <- get

1321+ put ist { default_access = acc }

1325 return [PDirective (DAccess acc)]

1322 return [PDirective (DAccess acc)]

1326 <|> do try (lchar '%' *> reserved "default"); tot <- totality

1323 <|> do try (lchar '%' *> reserved "default"); tot <- totality

1327 i <- get

1324 i <- get

@@ -1491,14 +1488,23 @@ parseImports fname input

1491 [(FC, OutputAnnotation)], IState)

1488 [(FC, OutputAnnotation)], IState)

1492 imports = do whiteSpace

1489 imports = do whiteSpace

1493 (mdoc, mname, annots) <- moduleHeader

1490 (mdoc, mname, annots) <- moduleHeader

1494− ps <- many import_

1491+ ps_exp <- many import_

1495 mrk <- mark

1492 mrk <- mark

1496 isEof <- lookAheadMatches eof

1493 isEof <- lookAheadMatches eof

1497 let mrk' = if isEof

1494 let mrk' = if isEof

1498 then Nothing

1495 then Nothing

1499 else Just mrk

1496 else Just mrk

1500 i <- get

1497 i <- get

1498+ -- add Builtins and Prelude, unless options say

1499+ -- not to

1500+ let ps = ps_exp -- imp "Builtins" : imp "Prelude" : ps_exp

1501 return ((mdoc, mname, ps, mrk'), annots, i)

1502+

1503+ imp m = ImportInfo False (toPath m)

1504+ Nothing [] NoFC NoFC

1505+ ns = Spl.splitOn "."

1506+ toPath = foldl1' (</>) . ns

1507+

1502 addPath :: [(FC, OutputAnnotation)] -> FilePath -> [(FC, OutputAnnotation)]

1508 addPath :: [(FC, OutputAnnotation)] -> FilePath -> [(FC, OutputAnnotation)]

1503 addPath [] _ = []

1509 addPath [] _ = []

1504 addPath ((fc, AnnNamespace ns Nothing) : annots) path =

1510 addPath ((fc, AnnNamespace ns Nothing) : annots) path =

@@ -1556,17 +1562,17 @@ parseProg syn fname input mrk

1556 return (ds, i')

1562 return (ds, i')

1557

1563

1558{- | Load idris module and show error if something wrong happens -}

1564{- | Load idris module and show error if something wrong happens -}

1559−loadModule :: FilePath -> Idris (Maybe String)

1565+loadModule :: FilePath -> IBCPhase -> Idris (Maybe String)

1560−loadModule f

1566+loadModule f phase

1561− = idrisCatch (loadModule' f)

1567+ = idrisCatch (loadModule' f phase)

1562 (\e -> do setErrSpan (getErrSpan e)

1568 (\e -> do setErrSpan (getErrSpan e)

1563 ist <- getIState

1569 ist <- getIState

1564 iWarn (getErrSpan e) $ pprintErr ist e

1570 iWarn (getErrSpan e) $ pprintErr ist e

1565 return Nothing)

1571 return Nothing)

1566

1572

1567{- | Load idris module -}

1573{- | Load idris module -}

1568−loadModule' :: FilePath -> Idris (Maybe String)

1574+loadModule' :: FilePath -> IBCPhase -> Idris (Maybe String)

1569−loadModule' f

1575+loadModule' f phase

1570 = do i <- getIState

1576 = do i <- getIState

1571 let file = takeWhile (/= ' ') f

1577 let file = takeWhile (/= ' ') f

1572 ibcsd <- valIBCSubDir i

1578 ibcsd <- valIBCSubDir i

@@ -1580,7 +1586,7 @@ loadModule' f

1580 IDR fn -> loadSource False fn Nothing

1586 IDR fn -> loadSource False fn Nothing

1581 LIDR fn -> loadSource True fn Nothing

1587 LIDR fn -> loadSource True fn Nothing

1582 IBC fn src ->

1588 IBC fn src ->

1583− idrisCatch (loadIBC True fn)

1589+ idrisCatch (loadIBC True phase fn)

1584 (\c -> do logParser 1 $ fn ++ " failed " ++ pshow i c

1590 (\c -> do logParser 1 $ fn ++ " failed " ++ pshow i c

1585 case src of

1591 case src of

1586 IDR sfn -> loadSource False sfn Nothing

1592 IDR sfn -> loadSource False sfn Nothing

@@ -1588,18 +1594,18 @@ loadModule' f

1588 return $ Just file

1594 return $ Just file

1589

1595

1590{- | Load idris code from file -}

1596{- | Load idris code from file -}

1591−loadFromIFile :: Bool -> IFileType -> Maybe Int -> Idris ()

1597+loadFromIFile :: Bool -> IBCPhase -> IFileType -> Maybe Int -> Idris ()

1592−loadFromIFile reexp i@(IBC fn src) maxline

1598+loadFromIFile reexp phase i@(IBC fn src) maxline

1593 = do logParser 1 $ "Skipping " ++ getSrcFile i

1599 = do logParser 1 $ "Skipping " ++ getSrcFile i

1594− idrisCatch (loadIBC reexp fn)

1600+ idrisCatch (loadIBC reexp phase fn)

1595 (\err -> ierror $ LoadingFailed fn err)

1601 (\err -> ierror $ LoadingFailed fn err)

1596 where

1602 where

1597 getSrcFile (IDR fn) = fn

1603 getSrcFile (IDR fn) = fn

1598 getSrcFile (LIDR fn) = fn

1604 getSrcFile (LIDR fn) = fn

1599 getSrcFile (IBC f src) = getSrcFile src

1605 getSrcFile (IBC f src) = getSrcFile src

1600

1606

1601−loadFromIFile _ (IDR fn) maxline = loadSource' False fn maxline

1607+loadFromIFile _ _ (IDR fn) maxline = loadSource' False fn maxline

1602−loadFromIFile _ (LIDR fn) maxline = loadSource' True fn maxline

1608+loadFromIFile _ _ (LIDR fn) maxline = loadSource' True fn maxline

1603

1609

1604{-| Load idris source code and show error if something wrong happens -}

1610{-| Load idris source code and show error if something wrong happens -}

1605loadSource' :: Bool -> FilePath -> Maybe Int -> Idris ()

1611loadSource' :: Bool -> FilePath -> Maybe Int -> Idris ()

@@ -1630,7 +1636,7 @@ loadSource lidr f toline

1630 LIDR fn -> ifail $ "No ibc for " ++ f

1636 LIDR fn -> ifail $ "No ibc for " ++ f

1631 IDR fn -> ifail $ "No ibc for " ++ f

1637 IDR fn -> ifail $ "No ibc for " ++ f

1632 IBC fn src ->

1638 IBC fn src ->

1633− do loadIBC True fn

1639+ do loadIBC True IBC_Building fn

1634 let srcFn = case src of

1640 let srcFn = case src of

1635 IDR fn -> Just fn

1641 IDR fn -> Just fn

1636 LIDR fn -> Just fn

1642 LIDR fn -> Just fn

@@ -1760,7 +1766,7 @@ loadSource lidr f toline

1760 clearHighlights

1766 clearHighlights

1761 i <- getIState

1767 i <- getIState

1762 putIState (i { default_total = def_total,

1768 putIState (i { default_total = def_total,

1763− hide_list = [] })

1769+ hide_list = emptyContext })

1764 return ()

1770 return ()

1765 where

1771 where

1766 namespaces :: [String] -> [PDecl] -> [PDecl]

1772 namespaces :: [String] -> [PDecl] -> [PDecl]

@@ -1790,16 +1796,9 @@ loadSource lidr f toline

1790 parsedDocs ist = annotCode (tryFullExpr syn ist) docs

1796 parsedDocs ist = annotCode (tryFullExpr syn ist) docs

1791

1797

1792{- | Adds names to hide list -}

1798{- | Adds names to hide list -}

1793−addHides :: [(Name, Maybe Accessibility)] -> Idris ()

1799+addHides :: Ctxt Accessibility -> Idris ()

1794addHides xs = do i <- getIState

1800addHides xs = do i <- getIState

1795 let defh = default_access i

1801 let defh = default_access i

1796− let (hs, as) = partition isNothing xs

1797− unless (null as) $

1798− mapM_ doHide

1802+ mapM_ doHide (toAlist xs)

1799− (map (\ (n, _) -> (n, defh)) hs ++

1800− map (\ (n, Just a) -> (n, a)) as)

1801− where isNothing (_, Nothing) = True

1802− isNothing _ = False

1803−

1804− doHide (n, a) = do setAccessibility n a

1803+ where doHide (n, a) = do setAccessibility n a

1805 addIBC (IBCAccess n a)

1804 addIBC (IBCAccess n a)

src/Idris/ProofSearch.hs+32−35

@@ -48,13 +48,13 @@ trivialHoles psnames ok elab ist

48 then try' (elab (PRef (fileFC "prf") [] x))

49 (tryAll xs) True

50 else tryAll xs

51−

51+

52 holesOK hs ap@(App _ _ _)

53 | (P _ n _, args) <- unApply ap

54 = holeArgsOK hs n 0 args

55 holesOK hs (App _ f a) = holesOK hs f && holesOK hs a

56 holesOK hs (P _ n _) = not (n `elem` hs)

57− holesOK hs (Bind n b sc) = holesOK hs (binderTy b) &&

57+ holesOK hs (Bind n b sc) = holesOK hs (binderTy b) &&

58 holesOK hs sc

59 holesOK hs _ = True

60

@@ -85,8 +85,8 @@ trivialTCs ok elab ist

85 then try' (elab (PRef (fileFC "prf") [] x))

86 (tryAll xs) True

87 else tryAll xs

88−

88+

89− tcArg env ty

89+ tcArg env ty

90 | (P _ n _, args) <- unApply (getRetTy (normalise (tt_ctxt ist) env ty))

91 = case lookupCtxtExact n (idris_classes ist) of

92 Just _ -> True

@@ -98,7 +98,7 @@ trivialTCs ok elab ist

98 = holeArgsOK hs n 0 args

99 holesOK hs (App _ f a) = holesOK hs f && holesOK hs a

100 holesOK hs (P _ n _) = not (n `elem` hs)

101− holesOK hs (Bind n b sc) = holesOK hs (binderTy b) &&

101+ holesOK hs (Bind n b sc) = holesOK hs (binderTy b) &&

102 holesOK hs sc

103 holesOK hs _ = True

104

@@ -111,16 +111,16 @@ cantSolveGoal :: ElabD a

111cantSolveGoal = do g <- goal

112 env <- get_env

113 lift $ tfail $

114− CantSolveGoal g (map (\(n,b) -> (n, binderTy b)) env)

114+ CantSolveGoal g (map (\(n,b) -> (n, binderTy b)) env)

115

116−proofSearch :: Bool -> -- recursive search (False for 'refine')

116+proofSearch :: Bool -> -- recursive search (False for 'refine')

117 Bool -> -- invoked from a tactic proof. If so, making

118 -- new metavariables is meaningless, and there shoudl

119 -- be an error reported instead.

120 Bool -> -- ambiguity ok

121 Bool -> -- defer on failure

122 Int -> -- maximum depth

123− (PTerm -> ElabD ()) -> Maybe Name -> Name ->

123+ (PTerm -> ElabD ()) -> Maybe Name -> Name ->

124 [Name] ->

125 [Name] ->

126 IState -> ElabD ()

@@ -131,7 +131,7 @@ proofSearch False fromProver ambigok deferonfail depth elab _ nroot psnames [fn]

131 tryAllFns all_imps

132 where

133 -- if nothing worked, make a new metavariable

134− tryAllFns [] | fromProver = cantSolveGoal

134+ tryAllFns [] | fromProver = cantSolveGoal

135 tryAllFns [] = do attack; defer [] nroot; solve

136 tryAllFns (f : fs) = try' (tryFn f) (tryAllFns fs) True

137

@@ -142,20 +142,20 @@ proofSearch False fromProver ambigok deferonfail depth elab _ nroot psnames [fn]

142 (match_apply (Var f) imps) True

143 ps' <- get_probs

144-- when (length ps < length ps') $ fail "Can't apply constructor"

145− -- Make metavariables for new holes

145+ -- Make metavariables for new holes

146 hs' <- get_holes

147 ptm <- get_term

148 if fromProver then cantSolveGoal

149 else do

150 mapM_ (\ h -> do focus h

151− attack; defer [] nroot; solve)

151+ attack; defer [] nroot; solve)

152 (hs' \\ hs)

153-- (filter (\ (x, y) -> not x) (zip (map fst imps) args))

154 solve

155

156 isImp (PImp p _ _ _ _) = (True, p)

157 isImp arg = (True, priority arg) -- try to get all of them by unification

158−proofSearch rec fromProver ambigok deferonfail maxDepth elab fn nroot psnames hints ist

158+proofSearch rec fromProver ambigok deferonfail maxDepth elab fn nroot psnames hints ist

159 = do compute

160 ty <- goal

161 hs <- get_holes

@@ -172,7 +172,7 @@ proofSearch rec fromProver ambigok deferonfail maxDepth elab fn nroot psnames hi

172 (autoArg (sUN "auto"))

173 else autoArg (sUN "auto") -- not enough info in the type yet

174 where

175− findInferredTy (t : _) = elab (delab ist (toUN t))

175+ findInferredTy (t : _) = elab (delab ist (toUN t))

176

177 cantsolve (InternalMsg _) = True

178 cantsolve (CantSolveGoal _ _) = True

@@ -185,12 +185,12 @@ proofSearch rec fromProver ambigok deferonfail maxDepth elab fn nroot psnames hi

185 conArgsOK ty

186 = let (f, as) = unApply ty in

187 case f of

188− P _ n _ ->

188+ P _ n _ ->

189 let autohints = case lookupCtxtExact n (idris_autohints ist) of

190 Nothing -> []

191 Just hs -> hs in

192 case lookupCtxtExact n (idris_datatypes ist) of

193− Just t -> do rs <- mapM (conReady as)

193+ Just t -> do rs <- mapM (conReady as)

194 (autohints ++ con_names t)

195 return (and rs)

196 Nothing -> -- local variable, go for it

@@ -199,7 +199,7 @@ proofSearch rec fromProver ambigok deferonfail maxDepth elab fn nroot psnames hi

199 _ -> typeNotSearchable ty

200

201 conReady :: [Term] -> Name -> ElabD Bool

202− conReady as n

202+ conReady as n

203 = case lookupTyExact n (tt_ctxt ist) of

204 Just ty -> do let (_, cs) = unApply (getRetTy ty)

205 -- if any metavariables in 'as' correspond to

@@ -223,7 +223,7 @@ proofSearch rec fromProver ambigok deferonfail maxDepth elab fn nroot psnames hi

223 inHS hs (P _ n _) = n `elem` hs

224 isHS _ _ = False

225

226− toUN t@(P nt (MN i n) ty)

226+ toUN t@(P nt (MN i n) ty)

227 | ('_':xs) <- str n = t

228 | otherwise = P nt (UN n) ty

229 toUN (App s f a) = App s (toUN f) (toUN a)

@@ -239,7 +239,7 @@ proofSearch rec fromProver ambigok deferonfail maxDepth elab fn nroot psnames hi

239 psRec :: Bool -> Int -> [Name] -> S.Set Type -> ElabD ()

240 psRec _ 0 locs tys | fromProver = cantSolveGoal

241 psRec rec 0 locs tys = do attack; defer [] nroot; solve --fail "Maximum depth reached"

242− psRec False d locs tys = tryCons d locs tys hints

242+ psRec False d locs tys = tryCons d locs tys hints

243 psRec True d locs tys

244 = do compute

245 ty <- goal

@@ -248,11 +248,11 @@ proofSearch rec fromProver ambigok deferonfail maxDepth elab fn nroot psnames hi

248 try' (try' (trivialHoles psnames [] elab ist)

249 (resolveTC False False 20 ty nroot elab ist)

250 True)

251− (try' (try' (resolveByCon (d - 1) locs tys')

251+ (try' (try' (resolveByCon (d - 1) locs tys')

252 (resolveByLocals (d - 1) locs tys')

253 True)

254 -- if all else fails, make a new metavariable

255− (if fromProver

255+ (if fromProver

256 then fail "cantSolveGoal"

257 else do attack; defer [] nroot; solve) True) True

258

@@ -269,7 +269,7 @@ proofSearch rec fromProver ambigok deferonfail maxDepth elab fn nroot psnames hi

269 = do t <- goal

270 let (f, _) = unApply t

271 case f of

272− P _ n _ ->

272+ P _ n _ ->

273 do let autohints = case lookupCtxtExact n (idris_autohints ist) of

274 Nothing -> []

275 Just hs -> hs

@@ -292,26 +292,26 @@ proofSearch rec fromProver ambigok deferonfail maxDepth elab fn nroot psnames hi

292 tryLocals d locs tys env

293

294 tryLocals d locs tys [] = fail "Locals failed"

295− tryLocals d locs tys ((x, t) : xs)

295+ tryLocals d locs tys ((x, t) : xs)

296 | x `elem` locs || x `notElem` psnames = tryLocals d locs tys xs

297− | otherwise = try' (tryLocal d (x : locs) tys x t)

297+ | otherwise = try' (tryLocal d (x : locs) tys x t)

298 (tryLocals d locs tys xs) True

299

300 tryCons d locs tys [] = fail "Constructors failed"

301− tryCons d locs tys (c : cs)

301+ tryCons d locs tys (c : cs)

302 = try' (tryCon d locs tys c) (tryCons d locs tys cs) True

303

304− tryLocal d locs tys n t

304+ tryLocal d locs tys n t

305 = do let a = getPArity (delab ist (binderTy t))

306 tryLocalArg d locs tys n a

307

308 tryLocalArg d locs tys n 0 = elab (PRef (fileFC "prf") [] n)

309− tryLocalArg d locs tys n i

309+ tryLocalArg d locs tys n i

310 = simple_app False (tryLocalArg d locs tys n (i - 1))

311 (psRec True d locs tys) "proof search local apply"

312

313 -- Like type class resolution, but searching with constructors

314− tryCon d locs tys n =

314+ tryCon d locs tys n =

315 do ty <- goal

316 let imps = case lookupCtxtExact n (idris_implicits ist) of

317 Nothing -> []

@@ -341,7 +341,7 @@ proofSearch rec fromProver ambigok deferonfail maxDepth elab fn nroot psnames hi

341 (Bind _ (Pi _ _ _) _) -> [TextPart "In particular, function types are not supported."]

342 _ -> []

343

344−-- In interactive mode, only search for things if there is some

344+-- In interactive mode, only search for things if there is some

345-- index to help pick a relevant constructor

346checkConstructor :: IState -> [Name] -> ElabD ()

347checkConstructor ist [] = return ()

@@ -397,7 +397,7 @@ resTC' tcs defaultOn topholes depth topg fn elab ist

397 _ -> []

398

399 traceWhen ulog ("Resolving class " ++ show g ++ "\nin" ++ show env ++ "\n" ++ show okholes) $

400− try' (trivialTCs okholes elab ist)

400+ try' (trivialTCs okholes elab ist)

401 (do addDefault t tc ttypes

402 let stk = map fst (filter snd $ elab_stack ist)

403 let insts = findInstances ist t

@@ -432,7 +432,7 @@ resTC' tcs defaultOn topholes depth topg fn elab ist

432 tcDetArgsOK _ _ _ [] = Just []

433

434 isMeta :: [Name] -> Term -> Bool

435− isMeta ns (P _ n _) = n `elem` ns

435+ isMeta ns (P _ n _) = n `elem` ns

436 isMeta _ _ = False

437

438 notHole hs (P _ n _, c)

@@ -449,7 +449,7 @@ resTC' tcs defaultOn topholes depth topg fn elab ist

449 chaser (NS n _) = chaser n

450 chaser _ = False

451

452− numclass = sNS (sUN "Num") ["Classes","Prelude"]

452+ numclass = sNS (sUN "Num") ["Interfaces","Prelude"]

453

454 addDefault t num@(P _ nc _) [P Bound a _] | nc == numclass && defaultOn

455 = do focus a

@@ -478,8 +478,7 @@ resTC' tcs defaultOn topholes depth topg fn elab ist

478 return (num + 1)

479 _ -> return 0

480

481− solven 0 = return ()

481+ solven n = replicateM_ n solve

482− solven n = do solve; solven (n - 1)

483

482

484 resolve n depth

483 resolve n depth

485 | depth == 0 = fail $ "Can't resolve type class"

484 | depth == 0 = fail $ "Can't resolve type class"

@@ -531,5 +530,3 @@ findInstances ist t

531 where accessible n = case lookupDefAccExact n False (tt_ctxt ist) of

530 where accessible n = case lookupDefAccExact n False (tt_ctxt ist) of

532 Just (_, Hidden) -> False

531 Just (_, Hidden) -> False

533 _ -> True

532 _ -> True

534−

535−

src/Idris/REPL.hs+67−41

@@ -12,6 +12,7 @@ import Idris.REPLParser

12import Idris.ElabDecls

13import Idris.Erasure

14import Idris.Error

15+import Idris.IBC

15import Idris.ErrReverse

16import Idris.ErrReverse

16import Idris.Delaborate

17import Idris.Delaborate

17import Idris.Docstrings (Docstring, overview, renderDocstring, renderDocTerm)

18import Idris.Docstrings (Docstring, overview, renderDocstring, renderDocTerm)

@@ -94,6 +95,10 @@ import Data.Word (Word)

94import Data.Either (partitionEithers)

95import Data.Either (partitionEithers)

95import Control.DeepSeq

96import Control.DeepSeq

96

97

98+import Control.Concurrent.Async (race)

99+import System.FSNotify (withManager, watchDir)

100+import System.FSNotify.Devel (allEvents, doAllEvents)

101+

97import Numeric ( readHex )

102import Numeric ( readHex )

98

103

99import Debug.Trace

104import Debug.Trace

@@ -126,10 +131,8 @@ repl orig mods efile

126 do ms <- H.catch (lift $ processInput input orig mods efile)

131 do ms <- H.catch (lift $ processInput input orig mods efile)

127 (ctrlC (return (Just mods)))

132 (ctrlC (return (Just mods)))

128 case ms of

133 case ms of

129− Just mods -> let efile' = case mods of

134+ Just mods -> let efile' = fromMaybe efile (listToMaybe mods)

130− [] -> efile

131− (e:_) -> e in

132− repl orig mods efile'

135+ in repl orig mods efile'

133 Nothing -> return ()

136 Nothing -> return ()

134-- ctrlC)

137-- ctrlC)

135-- ctrlC

138-- ctrlC

@@ -154,15 +157,13 @@ repl orig mods efile

154

157

155-- | Run the REPL server

158-- | Run the REPL server

156startServer :: PortID -> IState -> [FilePath] -> Idris ()

159startServer :: PortID -> IState -> [FilePath] -> Idris ()

157−startServer port orig fn_in = do tid <- runIO $ forkOS (serverLoop port)

160+startServer port orig fn_in = do tid <- runIO $ forkIO (serverLoop port)

158 return ()

161 return ()

159 where serverLoop port = withSocketsDo $

162 where serverLoop port = withSocketsDo $

160 do sock <- listenOnLocalhost port

163 do sock <- listenOnLocalhost port

161 loop fn orig { idris_colourRepl = False } sock

164 loop fn orig { idris_colourRepl = False } sock

162

165

163− fn = case fn_in of

166+ fn = fromMaybe "" (listToMaybe fn_in)

164− (f:_) -> f

165− _ -> ""

166

167

167 loop fn ist sock

168 loop fn ist sock

168 = do (h,_,_) <- accept sock

169 = do (h,_,_) <- accept sock

@@ -276,9 +277,7 @@ idemode h orig mods

276 i <- getIState

277 i <- getIState

277 putIState $ i { idris_outputmode = (IdeMode id h) }

278 putIState $ i { idris_outputmode = (IdeMode id h) }

278 idrisCatch -- to report correct id back!

279 idrisCatch -- to report correct id back!

279− (do let fn = case mods of

280+ (do let fn = fromMaybe "" (listToMaybe mods)

280− (f:_) -> f

281− _ -> ""

282 case IdeMode.sexpToCommand sexp of

281 case IdeMode.sexpToCommand sexp of

283 Just cmd -> runIdeModeCommand h id orig fn mods cmd

282 Just cmd -> runIdeModeCommand h id orig fn mods cmd

284 Nothing -> iPrintError "did not understand" )

283 Nothing -> iPrintError "did not understand" )

@@ -677,30 +676,54 @@ lit f = case splitExtension f of

677 (_, ".lidr") -> True

676 (_, ".lidr") -> True

678 _ -> False

677 _ -> False

679

678

679+reload :: IState -> [FilePath] -> Idris (Maybe [FilePath])

680+reload orig inputs = do

681+ i <- getIState

682+ -- The $!! here prevents a space leak on reloading.

683+ -- This isn't a solution - but it's a temporary stopgap.

684+ -- See issue #2386

685+ putIState $!! orig { idris_options = idris_options i

686+ , idris_colourTheme = idris_colourTheme i

687+ , imported = imported i

688+ }

689+ clearErr

690+ fmap Just $ loadInputs inputs Nothing

691+

692+watch :: IState -> [FilePath] -> Idris (Maybe [FilePath])

693+watch orig inputs = do

694+ let inputSet = S.fromList inputs

695+ let dirs = nub $ map takeDirectory inputs

696+ resp <- runIO $ do

697+ signal <- newEmptyMVar

698+ withManager $ \mgr -> do

699+ forM_ dirs $ \dir ->

700+ watchDir mgr dir (allEvents $ flip S.member inputSet) (doAllEvents $ putMVar signal)

701+ race getLine (takeMVar signal)

702+ case resp of

703+ Left _ -> return (Just inputs) -- canceled, so nop

704+ Right _ -> reload orig inputs >> watch orig inputs

705+

680processInput :: String ->

706processInput :: String ->

681 IState -> [FilePath] -> FilePath -> Idris (Maybe [FilePath])

707 IState -> [FilePath] -> FilePath -> Idris (Maybe [FilePath])

682processInput cmd orig inputs efile

708processInput cmd orig inputs efile

683 = do i <- getIState

709 = do i <- getIState

684 let opts = idris_options i

710 let opts = idris_options i

685 let quiet = opt_quiet opts

711 let quiet = opt_quiet opts

686− let fn = case inputs of

712+ let fn = fromMaybe "" (listToMaybe inputs)

687− (f:_) -> f

688− _ -> ""

689 c <- colourise

713 c <- colourise

690 case parseCmd i "(input)" cmd of

714 case parseCmd i "(input)" cmd of

691 Failure err -> do iputStrLn $ show (fixColour c err)

715 Failure err -> do iputStrLn $ show (fixColour c err)

692 return (Just inputs)

716 return (Just inputs)

693 Success (Right Reload) ->

717 Success (Right Reload) ->

694− -- The $!! here prevents a space leak on reloading.

718+ reload orig inputs

695− -- This isn't a solution - but it's a temporary stopgap.

719+ Success (Right Watch) ->

696− -- See issue #2386

720+ if null inputs then

697− do putIState $!! orig { idris_options = idris_options i

721+ do iputStrLn "No loaded files to watch."

698− , idris_colourTheme = idris_colourTheme i

699− , imported = imported i

700− }

701− clearErr

702− mods <- loadInputs inputs Nothing

703− return (Just mods)

722+ return (Just inputs)

723+ else

724+ do iputStrLn efile

725+ iputStrLn $ "Watching for .idr changes in " ++ show inputs ++ ", press enter to cancel."

726+ watch orig inputs

704 Success (Right (Load f toline)) ->

727 Success (Right (Load f toline)) ->

705 -- The $!! here prevents a space leak on reloading.

728 -- The $!! here prevents a space leak on reloading.

706 -- This isn't a solution - but it's a temporary stopgap.

729 -- This isn't a solution - but it's a temporary stopgap.

@@ -713,7 +736,7 @@ processInput cmd orig inputs efile

713 return (Just mod)

736 return (Just mod)

714 Success (Right (ModImport f)) ->

737 Success (Right (ModImport f)) ->

715 do clearErr

738 do clearErr

716− fmod <- loadModule f

739+ fmod <- loadModule f (IBC_REPL True)

717 return (Just (inputs ++ maybe [] (:[]) fmod))

740 return (Just (inputs ++ maybe [] (:[]) fmod))

718 Success (Right Edit) -> do -- takeMVar stvar

741 Success (Right Edit) -> do -- takeMVar stvar

719 edit efile orig

742 edit efile orig

@@ -795,7 +818,7 @@ process fn Warranty = iPrintResult warranty

795process fn (ChangeDirectory f)

818process fn (ChangeDirectory f)

796 = do runIO $ setCurrentDirectory f

819 = do runIO $ setCurrentDirectory f

797 return ()

820 return ()

798−process fn (ModImport f) = do fmod <- loadModule f

821+process fn (ModImport f) = do fmod <- loadModule f (IBC_REPL True)

799 case fmod of

822 case fmod of

800 Just pr -> isetPrompt pr

823 Just pr -> isetPrompt pr

801 Nothing -> iPrintError $ "Can't find import " ++ f

824 Nothing -> iPrintError $ "Can't find import " ++ f

@@ -879,8 +902,8 @@ process fn (NewDefn decls) = do

879 fixClauses :: PDecl' t -> PDecl' t

902 fixClauses :: PDecl' t -> PDecl' t

880 fixClauses (PClauses fc opts _ css@(clause:cs)) =

903 fixClauses (PClauses fc opts _ css@(clause:cs)) =

881 PClauses fc opts (getClauseName clause) css

904 PClauses fc opts (getClauseName clause) css

882− fixClauses (PInstance doc argDocs syn fc constraints cls nfc parms ty instName decls) =

905+ fixClauses (PInstance doc argDocs syn fc constraints acc cls nfc parms ty instName decls) =

883− PInstance doc argDocs syn fc constraints cls nfc parms ty instName (map fixClauses decls)

906+ PInstance doc argDocs syn fc constraints acc cls nfc parms ty instName (map fixClauses decls)

884 fixClauses decl = decl

907 fixClauses decl = decl

885

908

886process fn (Undefine names) = undefine names

909process fn (Undefine names) = undefine names

@@ -1067,7 +1090,7 @@ process fn (DebugInfo n)

1067 when (not (null di)) $ iputStrLn (show di)

1090 when (not (null di)) $ iputStrLn (show di)

1068 let imps = lookupCtxt n (idris_implicits i)

1091 let imps = lookupCtxt n (idris_implicits i)

1069 when (not (null imps)) $ iputStrLn (show imps)

1092 when (not (null imps)) $ iputStrLn (show imps)

1070− let d = lookupDef n (tt_ctxt i)

1093+ let d = lookupDefAcc n False (tt_ctxt i)

1071 when (not (null d)) $ iputStrLn $ "Definition: " ++ (show (head d))

1094 when (not (null d)) $ iputStrLn $ "Definition: " ++ (show (head d))

1072 let cg = lookupCtxtName n (idris_callgraph i)

1095 let cg = lookupCtxtName n (idris_callgraph i)

1073 i <- getIState

1096 i <- getIState

@@ -1216,12 +1239,15 @@ process fn (Compile codegen f)

1216 iPrintError $ "Invalid filename for compiler output \"" ++ f ++"\""

1239 iPrintError $ "Invalid filename for compiler output \"" ++ f ++"\""

1217 | otherwise = do opts <- getCmdLine

1240 | otherwise = do opts <- getCmdLine

1218 let iface = Interface `elem` opts

1241 let iface = Interface `elem` opts

1242+ let mainname = sNS (sUN "main") ["Main"]

1243+

1219 m <- if iface then return Nothing else

1244 m <- if iface then return Nothing else

1220 do (m', _) <- elabVal recinfo ERHS

1245 do (m', _) <- elabVal recinfo ERHS

1221 (PApp fc (PRef fc [] (sUN "run__IO"))

1246 (PApp fc (PRef fc [] (sUN "run__IO"))

1222− [pexp $ PRef fc [] (sNS (sUN "main") ["Main"])])

1247+ [pexp $ PRef fc [] mainname])

1223 return (Just m')

1248 return (Just m')

1224 ir <- compile codegen f m

1249 ir <- compile codegen f m

1250+

1225 i <- getIState

1251 i <- getIState

1226 runIO $ generate codegen (fst (head (idris_imported i))) ir

1252 runIO $ generate codegen (fst (head (idris_imported i))) ir

1227 where fc = fileFC "main"

1253 where fc = fileFC "main"

@@ -1537,7 +1563,7 @@ loadInputs inputs toline -- furthest line to read in input source files

1537 logParser 1 ("MODULE TREE : " ++ show modTree)

1563 logParser 1 ("MODULE TREE : " ++ show modTree)

1538 logParser 1 ("RELOAD: " ++ show ifiles)

1564 logParser 1 ("RELOAD: " ++ show ifiles)

1539 when (not (all ibc ifiles) || loadCode) $

1565 when (not (all ibc ifiles) || loadCode) $

1540− tryLoad False (filter (not . ibc) ifiles)

1566+ tryLoad False IBC_Building (filter (not . ibc) ifiles)

1541 -- return the files that need rechecking

1567 -- return the files that need rechecking

1542 return (input, ifiles))

1568 return (input, ifiles))

1543 ninputs

1569 ninputs

@@ -1548,7 +1574,8 @@ loadInputs inputs toline -- furthest line to read in input source files

1548 Nothing ->

1574 Nothing ->

1549 do putIState $!! ist { idris_tyinfodata = tidata }

1575 do putIState $!! ist { idris_tyinfodata = tidata }

1550 ibcfiles <- mapM findNewIBC (nub (concat (map snd ifiles)))

1576 ibcfiles <- mapM findNewIBC (nub (concat (map snd ifiles)))

1577+-- logLvl 0 $ "Loading from " ++ show ibcfiles

1551− tryLoad True (mapMaybe id ibcfiles)

1578+ tryLoad True (IBC_REPL True) (mapMaybe id ibcfiles)

1552 _ -> return ()

1579 _ -> return ()

1553 exports <- findExports

1580 exports <- findExports

1554

1581

@@ -1568,9 +1595,9 @@ loadInputs inputs toline -- furthest line to read in input source files

1568 iWarn emptyFC $ pprintErr i e

1595 iWarn emptyFC $ pprintErr i e

1569 return [])

1596 return [])

1570 where -- load all files, stop if any fail

1597 where -- load all files, stop if any fail

1571− tryLoad :: Bool -> [IFileType] -> Idris ()

1598+ tryLoad :: Bool -> IBCPhase -> [IFileType] -> Idris ()

1572− tryLoad keepstate [] = warnTotality >> return ()

1599+ tryLoad keepstate phase [] = warnTotality >> return ()

1573− tryLoad keepstate (f : fs)

1600+ tryLoad keepstate phase (f : fs)

1574 = do ist <- getIState

1601 = do ist <- getIState

1575 let maxline

1602 let maxline

1576 = case toline of

1603 = case toline of

@@ -1583,7 +1610,7 @@ loadInputs inputs toline -- furthest line to read in input source files

1583 then Just l

1610 then Just l

1584 else Nothing

1611 else Nothing

1585 _ -> Nothing

1612 _ -> Nothing

1586− loadFromIFile True f maxline

1613+ loadFromIFile True phase f maxline

1587 inew <- getIState

1614 inew <- getIState

1588 -- FIXME: Save these in IBC to avoid this hack! Need to

1615 -- FIXME: Save these in IBC to avoid this hack! Need to

1589 -- preserve it all from source inputs

1616 -- preserve it all from source inputs

@@ -1601,7 +1628,7 @@ loadInputs inputs toline -- furthest line to read in input source files

1601 ist <- getIState

1628 ist <- getIState

1602 putIState $!! ist { idris_tyinfodata = tidata,

1629 putIState $!! ist { idris_tyinfodata = tidata,

1603 idris_patdefs = patdefs }

1630 idris_patdefs = patdefs }

1604− tryLoad keepstate fs

1631+ tryLoad keepstate phase fs

1605

1632

1606 ibc (IBC _ _) = True

1633 ibc (IBC _ _) = True

1607 ibc _ = False

1634 ibc _ = False

@@ -1705,13 +1732,12 @@ idrisMain opts =

1705 addPkgDir "base"

1732 addPkgDir "base"

1706 mapM_ addPkgDir pkgdirs

1733 mapM_ addPkgDir pkgdirs

1707 elabPrims

1734 elabPrims

1708− when (not (NoBuiltins `elem` opts)) $ do x <- loadModule "Builtins"

1735+ when (not (NoBuiltins `elem` opts)) $ do x <- loadModule "Builtins" (IBC_REPL True)

1709 addAutoImport "Builtins"

1736 addAutoImport "Builtins"

1710 return ()

1737 return ()

1711− when (not (NoPrelude `elem` opts)) $ do x <- loadModule "Prelude"

1738+ when (not (NoPrelude `elem` opts)) $ do x <- loadModule "Prelude" (IBC_REPL True)

1712 addAutoImport "Prelude"

1739 addAutoImport "Prelude"

1713 return ()

1740 return ()

1714−

1715 when (runrepl && not idesl) initScript

1741 when (runrepl && not idesl) initScript

1716

1742

1717 nobanner <- getNoBanner

1743 nobanner <- getNoBanner

@@ -1772,7 +1798,7 @@ idrisMain opts =

1772 when (runrepl && not idesl) $ do

1798 when (runrepl && not idesl) $ do

1773-- clearOrigPats

1799-- clearOrigPats

1774 startServer port orig mods

1800 startServer port orig mods

1775− runInputT (replSettings (Just historyFile)) $ repl orig mods efile

1801+ runInputT (replSettings (Just historyFile)) $ repl (force orig) mods efile

1776 let idesock = IdemodeSocket `elem` opts

1802 let idesock = IdemodeSocket `elem` opts

1777 when (idesl) $ idemodeStart idesock orig inputs

1803 when (idesl) $ idemodeStart idesock orig inputs

1778 ok <- noErrors

1804 ok <- noErrors

src/Idris/REPLParser.hs+2−1

@@ -67,6 +67,7 @@ parserCommandsForHelp =

67 , namespaceArgCmd ["browse"] Browse "List the contents of some namespace"

68 , nameArgCmd ["total"] TotCheck "Check the totality of a name"

69 , noArgCmd ["r", "reload"] Reload "Reload current file"

70+ , noArgCmd ["w", "watch"] Watch "Watch the current file for changes"

70 , (["l", "load"], FileArg, "Load a new file"

71 , (["l", "load"], FileArg, "Load a new file"

71 , strArg (\f -> Load f Nothing))

72 , strArg (\f -> Load f Nothing))

72 , (["cd"], FileArg, "Change working directory"

73 , (["cd"], FileArg, "Change working directory"

@@ -98,7 +99,7 @@ parserCommandsForHelp =

98 , (["consolewidth"], ConsoleWidthArg, "Set the width of the console", cmd_consolewidth)

99 , (["consolewidth"], ConsoleWidthArg, "Set the width of the console", cmd_consolewidth)

99 , (["printerdepth"], OptionalArg NumberArg, "Set the maximum pretty-printer depth (no arg for infinite)", cmd_printdepth)

100 , (["printerdepth"], OptionalArg NumberArg, "Set the maximum pretty-printer depth (no arg for infinite)", cmd_printdepth)

100 , noArgCmd ["q", "quit"] Quit "Exit the Idris system"

101 , noArgCmd ["q", "quit"] Quit "Exit the Idris system"

101− , noArgCmd ["w", "warranty"] Warranty "Displays warranty information"

102+ , noArgCmd ["warranty"] Warranty "Displays warranty information"

102 , (["let"], ManyArgs DeclArg

103 , (["let"], ManyArgs DeclArg

103 , "Evaluate a declaration, such as a function definition, instance implementation, or fixity declaration"

104 , "Evaluate a declaration, such as a function definition, instance implementation, or fixity declaration"

104 , cmd_let)

105 , cmd_let)

src/Idris/Reflection.hs+4−4

@@ -364,10 +364,10 @@ reifyArithTy (P _ n _) | n == reflm "ATDouble" = return ATFloat

364reifyArithTy x = fail ("Couldn't reify reflected ArithTy: " ++ show x)

365

366reifyNativeTy :: Term -> ElabD NativeTy

367−reifyNativeTy (P _ n _) | n == reflm "IT8" = return IT8

367+reifyNativeTy (P _ n _) | n == reflm "IT8" = return IT8

368−reifyNativeTy (P _ n _) | n == reflm "IT8" = return IT8

368+reifyNativeTy (P _ n _) | n == reflm "IT16" = return IT16

369−reifyNativeTy (P _ n _) | n == reflm "IT8" = return IT8

369+reifyNativeTy (P _ n _) | n == reflm "IT32" = return IT32

370−reifyNativeTy (P _ n _) | n == reflm "IT8" = return IT8

370+reifyNativeTy (P _ n _) | n == reflm "IT64" = return IT64

371reifyNativeTy x = fail $ "Couldn't reify reflected NativeTy " ++ show x

372

373reifyIntTy :: Term -> ElabD IntTy

src/Pkg/PParser.hs+2−2

@@ -5,7 +5,7 @@

5module Pkg.PParser where

6

7import Text.Trifecta hiding (span, charLiteral, natural, symbol, char, string, whiteSpace)

8−

8+import qualified Text.PrettyPrint.ANSI.Leijen as PP

9import Idris.Core.TT

10import Idris.REPL

11import Idris.AbsSyntaxTree

@@ -51,7 +51,7 @@ parseDesc :: FilePath -> IO PkgDesc

51parseDesc fp = do

52 p <- readFile fp

53 case runparser pPkg defaultPkg fp p of

54− Failure err -> fail (show err)

54+ Failure err -> fail (show $ PP.plain err)

55 Success x -> return x

56

57pPkg :: PParser PkgDesc

src/Pkg/Package.hs+1−1

@@ -142,7 +142,7 @@ documentPkg fp =

142 setCurrentDirectory pkgDir

143 let run l = runExceptT . execStateT l

144 load [] = return ()

145− load (f:fs) = do loadModule f; load fs

145+ load (f:fs) = do loadModule f IBC_Building; load fs

146 loader = do idrisMain opts; addImportDir (sourcedir pkgdesc); load fs

147 idrisInstance <- run loader idrisInit

148 setCurrentDirectory cd

stack.yaml+4−1

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

1−resolver: lts-3.16

1+resolver: lts-4.2

2packages:

3- '.'

4flags:

@@ -11,3 +11,6 @@ extra-deps:

11- cheapskate-0.1.0.4

12- hscurses-1.4.2.0

13- libffi-0.1

14+nix:

15+ enable: false

16+ packages: [ libffi, zlib, ncurses, gmp, pkgconfig ]

test/Makefile+22−13

@@ -1,24 +1,33 @@

1−.PHONY: test test_java test_js time update diff distclean $(TESTS)

1+.PHONY: test test_js time update diff distclean $(TESTS)

2+

3+runtest:

4+ @ghc --make runtest.hs

5+ @rm runtest.o runtest.hi

2

6

3TESTS = $(sort $(patsubst %/,%.test,$(wildcard */)))

7TESTS = $(sort $(patsubst %/,%.test,$(wildcard */)))

4

8

5test: $(TESTS)

9test: $(TESTS)

6

10

7−%.test:

8− @perl ./runtest.pl $(patsubst %.test,%,$@)

9

11

12+info: runtest

13+ @./runtest all

14+

15+%.test: runtest

16+ @./runtest $(patsubst %.test,%,$@) -q

17+

10−test_js:

18+test_js: runtest

11− @perl ./runtest.pl without sugar004 reg029 reg052 io001 dsl002 io003 effects001 effects002 basic007 basic011 ffi006 --codegen node

19+ @./runtest without sugar004 reg029 reg052 io001 dsl002 io003 effects001 effects002 basic007 basic011 ffi006 opts --codegen node

12

20

13−update:

21+update: runtest

14− /usr/bin/env perl ./runtest.pl all -u

22+ @./runtest all -u

15

23

16−diff:

24+diff: runtest

17− /usr/bin/env perl ./runtest.pl all -d

25+ @./runtest all -d

18

26

19−time:

27+time: runtest

20− /usr/bin/env perl ./runtest.pl all -t

28+ @./runtest all -t

21

29

22distclean:

30distclean:

31+ @rm runtest

23− rm -f *~

32+ @rm -f *~

24− rm -f */output

33+ @rm -f */output

test/basic001/run+2−2

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

1#!/usr/bin/env bash

2−idris $@ reg005.idr -o reg005

2+${IDRIS:-idris} $@ reg005.idr -o reg005

3−idris $@ basic001a.idr -o basic001a

3+${IDRIS:-idris} $@ basic001a.idr -o basic001a

4./reg005

5./basic001a

6rm -f reg005 basic001a *.ibc

test/basic002/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ --nocolour --consolewidth 80 test006.idr -o test006

2+${IDRIS:-idris} $@ --nocolour --consolewidth 80 test006.idr -o test006

3./test006

4rm -f test006 test006.ibc

test/basic003/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test027.idr -o test027

2+${IDRIS:-idris} $@ test027.idr -o test027

3./test027

4rm -f test027 *.ibc

test/basic004/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test016.idr -o test016

2+${IDRIS:-idris} $@ test016.idr -o test016

3./test016

4rm -f test016 *.ibc

test/basic005/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test019.lidr -o test019

2+${IDRIS:-idris} $@ test019.lidr -o test019

3./test019

4rm -f test019 *.ibc

test/basic006/run+2−2

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

1#!/usr/bin/env bash

2

3−idris --consolewidth 80 $@ test020.idr -o test020

3+${IDRIS:-idris} --consolewidth 80 $@ test020.idr -o test020

4−idris --consolewidth 80 $@ test020a.idr --check --nocolor

4+${IDRIS:-idris} --consolewidth 80 $@ test020a.idr --check --nocolor

5./test020

6rm -f test020 *.ibc

test/basic007/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ -o test033 test033.idr

2+${IDRIS:-idris} $@ -o test033 test033.idr

3./test033

4rm -f *.ibc test033

test/basic008/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test036.idr -o test036

2+${IDRIS:-idris} $@ test036.idr -o test036

3./test036

4rm -f test036 *.ibc

test/basic009/A.idr+1

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

1module A

2

3+public export

3num : Nat

4num : Nat

4num = 0

5num = 0

test/basic009/B/C.idr+1

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

1module B.C

2

3+public export

3num : Nat

4num : Nat

4num = 1

5num = 1

test/basic009/run+3−3

@@ -1,8 +1,8 @@

1#!/usr/bin/env bash

2

3−idris --consolewidth 80 $@ Main.idr --nocolour --check && echo MAIN-PASS

3+${IDRIS:-idris} --consolewidth 80 $@ Main.idr --nocolour --check && echo MAIN-PASS

4−idris --consolewidth 80 $@ Faulty.idr --nocolour --check && echo FAULTY-PASS

4+${IDRIS:-idris} --consolewidth 80 $@ Faulty.idr --nocolour --check && echo FAULTY-PASS

5−idris --consolewidth 80 $@ Multiple.idr --nocolour --check && echo MULTIPLE-PASS

5+${IDRIS:-idris} --consolewidth 80 $@ Multiple.idr --nocolour --check && echo MULTIPLE-PASS

6

7

8rm -f *.ibc B/*.ibc

test/basic011/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ basic011.idr -p contrib -o basic011

2+${IDRIS:-idris} $@ basic011.idr -p contrib -o basic011

3./basic011

4rm -f basic011 *.ibc

test/basic012/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ basic012.idr -o basic012

2+${IDRIS:-idris} $@ basic012.idr -o basic012

3./basic012

4rm -f basic012 *.ibc

test/basic013/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ basic013.idr -o basic013

2+${IDRIS:-idris} $@ basic013.idr -o basic013

3./basic013

4rm -f basic013 *.ibc

test/basic014/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ basic014.idr --check

2+${IDRIS:-idris} $@ basic014.idr --check

3rm -f *.ibc

test/basic015/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ basic015.idr -o basic015

2+${IDRIS:-idris} $@ basic015.idr -o basic015

3./basic015

4rm -f basic015 *.ibc

test/basic016/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ CycleA.idr --consolewidth 80 --nocolour --check

2+${IDRIS:-idris} $@ CycleA.idr --consolewidth 80 --nocolour --check

3rm -f *.ibc

test/bignum001/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ bignum001.idr -o bignum001

2+${IDRIS:-idris} $@ bignum001.idr -o bignum001

3./bignum001

4rm -f bignum001 *.ibc

test/bignum002/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ bignum002.idr -o bignum002

2+${IDRIS:-idris} $@ bignum002.idr -o bignum002

3./bignum002

4rm -f bignum002 *.ibc

test/bounded001/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ bounded001.idr -o bounded001

2+${IDRIS:-idris} $@ bounded001.idr -o bounded001

3./bounded001

4rm -f bounded001 *.ibc

test/classes001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --quiet --nocolour --consolewidth 70 ClassName.idr < input

2+${IDRIS:-idris} $@ --quiet --nocolour --consolewidth 70 ClassName.idr < input

3rm -f bounded001 *.ibc

test/corecords001/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ corecords001.idr -o corecords001

2+${IDRIS:-idris} $@ corecords001.idr -o corecords001

3./corecords001

4rm -f corecords001 corecords001.ibc

test/corecords002/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ corecords002.idr -o corecords002

2+${IDRIS:-idris} $@ corecords002.idr -o corecords002

3./corecords002

4rm -f corecords002 corecords002.ibc

test/delab001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --quiet --nocolor delab001.idr < input

2+${IDRIS:-idris} $@ --quiet --nocolor delab001.idr < input

3rm -f *.ibc

test/disambig002/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ disambig002.idr --check

2+${IDRIS:-idris} $@ disambig002.idr --check

3rm -f *.ibc

test/docs001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet --nocolor --consolewidth 80 docs001.idr < input

2+${IDRIS:-idris} --quiet --nocolor --consolewidth 80 docs001.idr < input

3rm *.ibc

test/docs002/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 --nobanner --nocolor --quiet docs002.idr < input

2+${IDRIS:-idris} --consolewidth 80 --nobanner --nocolor --quiet docs002.idr < input

3rm *.ibc

test/docs003/expected+1−1

@@ -5,7 +5,7 @@ Parameters:

5 f -- a parameterised type

6

7Methods:

8− map : Functor f => (m : a -> b) -> f a -> f b

8+ map : Functor f => (func : a -> b) -> f a -> f b

9 Apply a function across everything of type 'a' in a

10 parameterised type

11

test/docs003/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 --quiet --nocolor docs003.idr < input

2+${IDRIS:-idris} --consolewidth 80 --quiet --nocolor docs003.idr < input

3rm *.ibc

test/docs004/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet --nocolor --consolewidth 80 docs004.idr < input

2+${IDRIS:-idris} --quiet --nocolor --consolewidth 80 docs004.idr < input

3rm *.ibc

test/dsl001/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test001.idr -o test001

2+${IDRIS:-idris} $@ test001.idr -o test001

3./test001

4rm -f test001 test001.ibc

test/dsl001/test001.idr+1−1

@@ -45,7 +45,7 @@ using (G : Vect n Ty)

45 index_next = Pop

46

47 total

48− interp : Env G -> [static] (e : Expr G t) -> interpTy t

48+ interp : Env G -> %static (e : Expr G t) -> interpTy t

49 interp env (Var i) = lookup i env

50 interp env (Val x) = x

51 interp env (Lam sc) = \x => interp (x :: env) sc

test/dsl002/Resimp.idr+3−1

@@ -3,6 +3,8 @@ module Resimp

3import public Data.Vect

4import public Data.Fin

5

6+%access public export

7+

6-- IO operations which read a resource

8-- IO operations which read a resource

7data Reader : Type -> Type where

9data Reader : Type -> Type where

8 MkReader : IO a -> Reader a

10 MkReader : IO a -> Reader a

@@ -122,7 +124,7 @@ using (i: Fin n, gam : Vect n Ty, gam' : Vect n Ty, gam'' : Vect n Ty)

122 ioret : a -> IO a

124 ioret : a -> IO a

123 ioret = return

125 ioret = return

124

126

125− interp : Env gam -> [static] (e : Res gam gam' t) ->

127+ interp : Env gam -> %static (e : Res gam gam' t) ->

126 (Env gam' -> interpTy t -> IO u) -> IO u

128 (Env gam' -> interpTy t -> IO u) -> IO u

127

129

128 interp env (Let val scope) k

130 interp env (Let val scope) k

test/dsl002/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test014.idr -o test014

2+${IDRIS:-idris} $@ test014.idr -o test014

3./test014

4rm -f test014 Resimp.ibc test014.ibc

test/dsl003/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --nocolour --check DSLPi.idr -e test1 -e test2

2+${IDRIS:-idris} $@ --nocolour --check DSLPi.idr -e test1 -e test2

3rm -f *.ibc

test/dsl004/run+3−3

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris $@ Door0.idr --check

2+${IDRIS:-idris} $@ Door0.idr --check

3−idris $@ Door1.idr --check

3+${IDRIS:-idris} $@ Door1.idr --check

4−idris $@ Door2.idr --check

4+${IDRIS:-idris} $@ Door2.idr --check

5rm -f *.ibc

test/effects001/run+2−2

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

1#!/usr/bin/env bash

2−idris -p effects $@ test021.idr -o test021

2+${IDRIS:-idris} -p effects $@ test021.idr -o test021

3−idris -p effects $@ test021a.idr -o test021a

3+${IDRIS:-idris} -p effects $@ test021a.idr -o test021a

4./test021

5./test021a

6rm -f test021 test021a *.ibc

test/effects002/run+1−1

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

1#!/usr/bin/env bash

2−idris -p effects $@ test025.idr -o test025

2+${IDRIS:-idris} -p effects $@ test025.idr -o test025

3./test025

4rm -f test025 *.ibc

test/effects003/VectMissing.idr+1

@@ -6,6 +6,7 @@ import Data.Vect

6implementation Uninhabited (Elem x []) where

7 uninhabited Here impossible

8

9+export

9shrink : (xs : Vect (S n) a) -> Elem x xs -> Vect n a

10shrink : (xs : Vect (S n) a) -> Elem x xs -> Vect n a

10shrink (x :: ys) Here = ys

11shrink (x :: ys) Here = ys

11shrink (y :: []) (There p) = absurd p

12shrink (y :: []) (There p) = absurd p

test/effects003/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ hangman.idr --consolewidth 80 --nocolour -p effects -o hangman

2+${IDRIS:-idris} $@ hangman.idr --consolewidth 80 --nocolour -p effects -o hangman

3./hangman < input

4rm -f hangman *.ibc

test/effects004/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ effects004.idr -o effects004 -p effects

2+${IDRIS:-idris} $@ effects004.idr -o effects004 -p effects

3./effects004 < input

4rm -f effects004 *.ibc

test/effects005/run+2−2

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

1#!/usr/bin/env bash

2−idris $@ defaultLogger.idr -o default -p effects

2+${IDRIS:-idris} $@ defaultLogger.idr -o default -p effects

3./default

4−idris $@ categoryLogger.idr -o category -p effects

4+${IDRIS:-idris} $@ categoryLogger.idr -o category -p effects

5./category

6rm -f default category *.ibc

test/error001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ test002.idr --check --noprelude --consolewidth 70

2+${IDRIS:-idris} $@ test002.idr --check --noprelude --consolewidth 70

3rm -f *.ibc

test/error002/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test031.idr -o test031

2+${IDRIS:-idris} $@ test031.idr -o test031

3./test031

4rm -f test031 *.ibc

test/error003/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ ErrorReflection.idr --nocolour --check

2+${IDRIS:-idris} --consolewidth 80 $@ ErrorReflection.idr --nocolour --check

3rm -f *.ibc

test/error004/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ FunErrTest.idr --nocolour --check

2+${IDRIS:-idris} --consolewidth 80 $@ FunErrTest.idr --nocolour --check

3rm -f *.ibc

test/error005/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ --check --nocolour error005.idr

2+${IDRIS:-idris} --consolewidth 80 $@ --check --nocolour error005.idr

3rm -f *.ibc

test/error006/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ --check --nocolour WithPatsNoWith.idr

2+${IDRIS:-idris} --consolewidth 80 $@ --check --nocolour WithPatsNoWith.idr

3rm -f *.ibc

test/ffi001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet --nocolour test022.idr --exec main

2+${IDRIS:-idris} --quiet --nocolour test022.idr --exec main

3rm -f *.ibc

test/ffi002/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 --quiet test023.idr -o test023

2+${IDRIS:-idris} --consolewidth 80 --quiet test023.idr -o test023

3rm -f test023 *.ibc

test/ffi003/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet --nocolour test024.idr --exec main < input

2+${IDRIS:-idris} --quiet --nocolour test024.idr --exec main < input

3rm -f *.ibc

test/ffi004/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet --nocolour --check test026.idr

2+${IDRIS:-idris} --quiet --nocolour --check test026.idr

3rm -f *.ibc

test/ffi005/run+1−1

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2

3−idris $@ Postulate.idr -o postulate

3+${IDRIS:-idris} $@ Postulate.idr -o postulate

4./postulate

5rm -f postulate *.ibc

test/ffi006/run+1−1

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris $@ ffi006.idr --interface -o ffi006.o

2+${IDRIS:-idris} $@ ffi006.idr --interface -o ffi006.o

3${CC:=cc} ffi006.c ffi006.o `idris --include` `idris --link` -o ffi006

4./ffi006

5rm -f ffi006 *.ibc *.o *.h

test/folding001/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ folding001.idr -o folding001

2+${IDRIS:-idris} $@ folding001.idr -o folding001

3./folding001

4rm -f folding001 *.ibc

test/idrisdoc001/run+1−1

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

1#!/usr/bin/env bash

2# Tests that no documentation is built for empty and/or private-only namespaces

3−idris --mkdoc test_empty.ipkg

3+${IDRIS:-idris} --mkdoc test_empty.ipkg

4rm -rf *.ibc *_doc

test/idrisdoc002/TestFunctions.idr+2−1

@@ -1,5 +1,6 @@

1module TestFunctions

2

3||| Test function

4+public export

4test : ()

5test : ()

5−test = ()

6+test = ()

test/idrisdoc002/run+1−1

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2# Tests that documentation is generated for functions

3−idris --mkdoc test_functions.ipkg

3+${IDRIS:-idris} --mkdoc test_functions.ipkg

4[ -d test_functions_doc ] && echo "Functions are documented"

5rm -rf *.ibc *_doc

test/idrisdoc003/TestDatatypes.idr+2−1

@@ -1,6 +1,7 @@

1module TestDatatypes

2

3||| This is another test

4+public export

4data Test : Type where

5data Test : Type where

5 ||| Test constructor

6 ||| Test constructor

6− ATest : Test

7+ ATest : Test

test/idrisdoc003/run+1−1

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2# Tests that documentation is generated for data types

3−idris --mkdoc test_datatypes.ipkg

3+${IDRIS:-idris} --mkdoc test_datatypes.ipkg

4[ -d test_datatypes_doc ] && echo "Data types are documented"

5rm -rf *.ibc *_doc

test/idrisdoc004/TestTypeclasses.idr+1

@@ -3,6 +3,7 @@ module TestTypeclasses

3||| This is a test

4|||

5||| @ a Test arg

6+public export

6interface Test a where

7interface Test a where

7 ||| Test function

8 ||| Test function

8 test : a -> Int

9 test : a -> Int

test/idrisdoc004/run+1−1

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2# Tests that documentation is generated for typeclasses

3−idris --mkdoc test_typeclasses.ipkg

3+${IDRIS:-idris} --mkdoc test_typeclasses.ipkg

4[ -d test_typeclasses_doc ] && echo "Typeclasses are documented"

5rm -rf *.ibc *_doc

test/idrisdoc005/TestTracing.idr+2−1

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

1module TestTracing

2

3+public export

3test : Bool

4test : Bool

4−test = True

5+test = True

test/idrisdoc005/run+1−1

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

1#!/usr/bin/env bash

2# Tests that references to other namespaces are traced

3−idris --mkdoc test_tracing.ipkg

3+${IDRIS:-idris} --mkdoc test_tracing.ipkg

4[ -f test_tracing_doc/docs/TestTracing.html ] && echo "TestTracing: Check"

5[ -f test_tracing_doc/docs/Prelude.Bool.html ] && echo "Prelude.Bool: Check"

6rm -rf *.ibc *_doc

test/idrisdoc006/A/fully/Qualified/NAME.idr+2−2

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

1module A.fully.Qualified.NAME

2

3||| This is another test

4−data Test : Type where

4+public export data Test : Type where

5 ||| Test constructor

6− ATest : Test

6+ ATest : Test

test/idrisdoc006/B.idr+2−1

@@ -1,5 +1,6 @@

1module B

2

3||| Test function

4+public export

4test : ()

5test : ()

5−test = ()

6+test = ()

test/idrisdoc006/run+2−2

@@ -1,8 +1,8 @@

1#!/usr/bin/env bash

2# Tests that documentation properly is merged with existent.

3−idris --mkdoc package_a.ipkg

3+${IDRIS:-idris} --mkdoc package_a.ipkg

4[ -f test_merge_doc/IdrisDoc ] && echo "IdrisDoc file written"

5−idris --mkdoc package_b.ipkg

5+${IDRIS:-idris} --mkdoc package_b.ipkg

6ls -1p test_merge_doc/docs

7if grep -q "href\\=\"docs/A.fully.Qualified.NAME\\.html\"" test_merge_doc/index.html; then

8 echo A.fully.Qualified.NAME is in the index

test/idrisdoc007/run+1−1

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

1#!/usr/bin/env bash

2# Tests that documentation only is written when safe

3mkdir do_not_delete_doc

4−idris --mkdoc package.ipkg > nowhere

4+${IDRIS:-idris} --mkdoc package.ipkg > nowhere

5echo Exit status $expects 1$: $?

6rm -rf do_not_delete_doc *.ibc nowhere

test/idrisdoc008/Abstract.idr+2−2

@@ -1,5 +1,5 @@

1module Abstract

2

3−abstract

3+export

4frozen : ()

5−frozen = ()

5+frozen = ()

test/idrisdoc008/Visible.idr+2−2

@@ -1,5 +1,5 @@

1module Visible

2

3−public

3+public export

4visible : ()

5−visible = ()

5+visible = ()

test/idrisdoc008/run+1−1

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

1#!/usr/bin/env bash

2# Tests that documentation is generated for both public and abstract members.

3−idris --mkdoc visibility.ipkg

3+${IDRIS:-idris} --mkdoc visibility.ipkg

4[ -f visibility_doc/docs/Abstract.html ] && echo "Abstract members are documented"

5[ -f visibility_doc/docs/Visible.html ] && echo "Public members are documented"

6rm -rf *.ibc *_doc

test/idrisdoc009/Test.idr+2

@@ -23,6 +23,8 @@

23module Test

24import Data.Complex

25

26+%access public export

27+

26myplus : Nat -> Nat -> Nat

28myplus : Nat -> Nat -> Nat

27myplus Z j = j

29myplus Z j = j

28myplus (S k) j = S (myplus k j)

30myplus (S k) j = S (myplus k j)

test/idrisdoc009/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --nocolour --quiet Test.idr < input

2+${IDRIS:-idris} $@ --nocolour --quiet Test.idr < input

3rm -f *.ibc

test/interactive001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet test032.idr < input

2+${IDRIS:-idris} --quiet test032.idr < input

3rm -f *.ibc

test/interactive002/expected+1−1

@@ -5,6 +5,6 @@ Nat

5Vect (n + m) a

6Nat

7Nat

8−S n

8+(S n)

9String

10()

test/interactive002/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet interactive002.idr < input

2+${IDRIS:-idris} --quiet interactive002.idr < input

3rm -f *.ibc

test/interactive003/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet interactive003.idr < input

2+${IDRIS:-idris} --quiet interactive003.idr < input

3rm -f *.ibc

test/interactive004/expected+1−1

@@ -1,2 +1,2 @@

1plus ?foo_rhs2 ?foo_rhs3

2−append k m ?append_rhs2 ?append_rhs3

2+(append k m ?append_rhs2 ?append_rhs3)

test/interactive004/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet interactive004.idr < input

2+${IDRIS:-idris} --quiet interactive004.idr < input

3rm -f *.ibc

test/interactive005/run+1−1

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris --nocolour --quiet interactive005.idr --consolewidth 70 < input

2+${IDRIS:-idris} --nocolour --quiet interactive005.idr --consolewidth 70 < input

3rm -f *.ibc

4rm -f hello.bytecode

5rm -f hello

test/interactive006/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet --port 5000 interactive006.idr < input

2+${IDRIS:-idris} --quiet --port 5000 interactive006.idr < input

3rm -f *.ibc

test/interactive007/run+1−1

@@ -1,2 +1,2 @@

1#!/usr/bin/env bash

2−idris -p contrib --nobanner --nocolor < input

2+${IDRIS:-idris} -p contrib --nobanner --nocolor < input

test/interactive008/run+1−1

@@ -1,2 +1,2 @@

1#!/usr/bin/env bash

2−idris --nobanner --nocolor < input

2+${IDRIS:-idris} --nobanner --nocolor < input

test/interactive009/expected+1−1

@@ -1 +1 @@

1−IsSetCons pf prfRec

1+(IsSetCons pf prfRec)

test/interactive009/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet interactive009.idr < input

2+${IDRIS:-idris} --quiet interactive009.idr < input

3rm -f *.ibc

test/interactive010/expected+4−4

@@ -1,12 +1,12 @@

1Prelude.List.(++) : List a -> List a -> List a

2Prelude.Strings.(++) : String -> String -> String

3−a is not an implicit argument of Prelude.Classes./

3+a is not an implicit argument of Prelude.Interfaces./

4Usage is :doc <functionname>

5Usage is :wc <functionname>

6Usage is :printdef <functionname>

7−pat {ty504} : Type u. pat {__class505} : Prelude.Classes.Fractional {ty504}. Prelude.Classes./ {ty504} {__class505}

7+pat {ty504} : Type u. pat {__class505} : Prelude.Interfaces.Fractional {ty504}. Prelude.Interfaces./ {ty504} {__class505}

8

9− : pty {ty504} : Type u. pty {__class505} : Prelude.Classes.Fractional {ty504}. {ty504} -> {ty504} -> {ty504}

9+ : pty {ty504} : Type u. pty {__class505} : Prelude.Interfaces.Fractional {ty504}. {ty504} -> {ty504} -> {ty504}

10(input):1:1: error: expected: ":",

11 dependent type signature,

12 end of input

@@ -17,4 +17,4 @@ pat {ty504} : Type u. pat {__class505} : Prelude.Classes.Fractional {ty504}. Pre

17 end of input

18++<EOF>

19^

20−Can't resolve type class Fractional ty

20+Can't find implementation for Fractional ty

test/interactive010/run+1−1

@@ -1,2 +1,2 @@

1#!/usr/bin/env bash

2−idris --quiet --nobanner --nocolor --consolewidth 80 < input

2+${IDRIS:-idris} --quiet --nobanner --nocolor --consolewidth 80 < input

test/interactive011/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --quiet interactive011.idr < input

2+${IDRIS:-idris} --quiet interactive011.idr < input

3rm -f *.ibc

test/interactive012/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 70 --quiet interactive012.idr < input

2+${IDRIS:-idris} --nocolour --consolewidth 70 --quiet interactive012.idr < input

3rm -f *.ibc

test/io001/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test004.idr -o test004

2+${IDRIS:-idris} $@ test004.idr -o test004

3./test004

4rm -f test004 test004.ibc testfile

test/io002/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test008.idr -o test008

2+${IDRIS:-idris} $@ test008.idr -o test008

3./test008

4rm -f test008 test008.ibc

test/io003/run+2−2

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

1#!/usr/bin/env bash

2−idris $@ test018.idr -p contrib -o test018

2+${IDRIS:-idris} $@ test018.idr -p contrib -o test018

3−idris $@ test018a.idr -p contrib -o test018a

3+${IDRIS:-idris} $@ test018a.idr -p contrib -o test018a

4./test018

5#./test018a

6rm -f test018 test018a *.ibc

test/literate001/Lit.lidr+2−2

@@ -2,12 +2,12 @@

2

3Test some string primitives while we're at it

4

5−> st : String

5+> export st : String

6> st = "abcdefg"

7

8Literate main program

9

10−> main : IO ()

10+> export main : IO ()

11> main = do { putStrLn (show (strHead st))

12> putStrLn (show (strIndex st 3))

13> putStrLn (strCons 'z' st)

test/literate001/run+2−2

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ test003a.lidr --check

2+${IDRIS:-idris} --consolewidth 80 $@ test003a.lidr --check

3−idris --consolewidth 80 $@ test003.lidr -o test003

3+${IDRIS:-idris} --consolewidth 80 $@ test003.lidr -o test003

4./test003

5rm -f test003 test003.ibc Lit.ibc

test/meta001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --check --nocolour --consolewidth 70 Finite.idr

2+${IDRIS:-idris} $@ --check --nocolour --consolewidth 70 Finite.idr

3rm -f *.ibc

test/meta002/run+2−2

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

1#!/usr/bin/env bash

2−idris $@ -p pruviloj --nocolour --check --consolewidth 70 Tacs.idr

2+${IDRIS:-idris} $@ -p pruviloj --nocolour --check --consolewidth 70 Tacs.idr

3−idris $@ -p pruviloj --nocolour --check --consolewidth 70 AgdaStyleReflection.idr

3+${IDRIS:-idris} $@ -p pruviloj --nocolour --check --consolewidth 70 AgdaStyleReflection.idr

4# Disabled due to excess memory consumption

5# idris $@ -p pruviloj --nocolour --check --consolewidth 70 Deriving.idr

6rm -f *.ibc

test/meta003/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --nocolour --check --consolewidth 70 BadDef.idr

2+${IDRIS:-idris} $@ --nocolour --check --consolewidth 70 BadDef.idr

3rm -f *.ibc

test/meta004/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ -p pruviloj --nocolour --check --consolewidth 70 meta004.idr

2+${IDRIS:-idris} $@ -p pruviloj --nocolour --check --consolewidth 70 meta004.idr

3rm -f *.ibc

test/mktest.pl+1−1

@@ -13,7 +13,7 @@ chdir($test);

13open(FOO,">run");

14

15print FOO "#!/usr/bin/env bash\n";

16−print FOO "idris \$@ $test.idr -o $test\n";

16+print FOO "${IDRIS:-idris} \$@ $test.idr -o $test\n";

17print FOO "./$test\n";print FOO "rm -f $test *.ibc\n";

18

19close(FOO);

test/pkg001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --build test.ipkg

2+${IDRIS:-idris} $@ --build test.ipkg

3rm -f *.ibc

test/pkg002/run+1−1

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2### Test: IPKG executable names can be any namespaced identifier.

3−idris $@ --build test.ipkg

3+${IDRIS:-idris} $@ --build test.ipkg

4rm -f *.ibc

5rm -f some.namespaced.identifier

test/pkg003/run+1−1

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

1#!/usr/bin/env bash

2### Test: IPKG executable names can be a quoted string

3### containing a valid filename.

4−idris $@ --build test.ipkg

4+${IDRIS:-idris} $@ --build test.ipkg

5rm -f *.ibc

6rm -f 'quoting-allows-hyphens and spaces and fun stuff!'

test/pkg004/expected+3−3

@@ -1,5 +1,5 @@

1−Uncaught error: user error ([1mtest.ipkg[0m:[1m10[0m:[1m1[0m: [91merror[0m: filename

1+Uncaught error: user error (test.ipkg:9:1: error: filename

2 must contain no directory

3 component, expected: space

4−[1m[94m<EOF>[0;1m[0m

4+<EOF>

5−[92m^[0m )

5+^ )

test/pkg004/run+1−1

@@ -2,5 +2,5 @@

2### Test: IPKG executable names CANNOT include a directory separator.

3# TODO: Verify that a name like "a/b\c" is rejected by both *NIX and Windows

4# (assuming these tests get run on Windows).

5−idris $@ --consolewidth 80 --nobanner --nocolor --build test.ipkg

5+${IDRIS:-idris} $@ --build test.ipkg

6rm -f *.ibc

test/pkg004/test.ipkg−1

@@ -2,7 +2,6 @@ package test

2

3modules = Main

4

5−

6opts = "--warnpartial --warnreach --nocolour --quiet --consolewidth 80"

5opts = "--warnpartial --warnreach --nocolour --quiet --consolewidth 80"

7

6

8main = Main

7main = Main

test/primitives001/run+2−2

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

1#!/usr/bin/env bash

2−idris $@ test005.idr -o test005

2+${IDRIS:-idris} $@ test005.idr -o test005

3./test005

4−idris $@ substring.idr -o substring

4+${IDRIS:-idris} $@ substring.idr -o substring

5./substring < input

6rm -f test005 substring *.ibc

test/primitives003/run+1−1

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris $@ -o test038 test038.idr --nocolour

2+${IDRIS:-idris} $@ -o test038 test038.idr --nocolour

3./test038

4rm -f test038 *.ibc

5

test/primitives004-disabled/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ -o primitives004 primitives004.idr --nocolour

2+${IDRIS:-idris} $@ -o primitives004 primitives004.idr --nocolour

3./primitives004

4rm -f primitives004 *.ibc

test/proof001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ test029.idr --consolewidth 80 --nocolour --check test029

2+${IDRIS:-idris} $@ test029.idr --consolewidth 80 --nocolour --check test029

3rm -f *.ibc

test/proof002/Reflect.idr+1

@@ -2,6 +2,7 @@ module Reflect

2

3import Decidable.Equality

4

5+%access public export

5%default total

6%default total

6

7

7using (xs : List a, ys : List a, G : List (List a))

8using (xs : List a, ys : List a, G : List (List a))

test/proof002/expected+3−3

@@ -1,8 +1,8 @@

1−Reflect.idr:173:21-26:

1+Reflect.idr:174:21-26:

2This style of tactic proof is deprecated. See %runElab for the replacement.

3−Reflect.idr:182:21-26:

3+Reflect.idr:183:21-26:

4This style of tactic proof is deprecated. See %runElab for the replacement.

5−Reflect.idr:190:15-20:

5+Reflect.idr:191:15-20:

6This style of tactic proof is deprecated. See %runElab for the replacement.

7test030a.idr:12:26-14:1:

8When checking right hand side of testReflect1 with expected type

test/proof002/run+2−2

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

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ test030.idr --check --nocolour

2+${IDRIS:-idris} --consolewidth 80 $@ test030.idr --check --nocolour

3−idris --consolewidth 80 $@ test030a.idr --check --nocolour

3+${IDRIS:-idris} --consolewidth 80 $@ test030a.idr --check --nocolour

4rm -f *.ibc

test/proof003/Parity.idr+2

@@ -1,5 +1,7 @@

1module Parity

2

3+%access public export

4+

3data Parity : Nat -> Type where

5data Parity : Nat -> Type where

4 Even : {n : Nat} -> Parity (n + n)

6 Even : {n : Nat} -> Parity (n + n)

5 Odd : {n : Nat} -> Parity (S (n + n))

7 Odd : {n : Nat} -> Parity (S (n + n))

test/proof003/expected+2−2

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

1−Parity.idr:15:18-23:

1+Parity.idr:17:18-23:

2This style of tactic proof is deprecated. See %runElab for the replacement.

3−Parity.idr:22:18-23:

3+Parity.idr:24:18-23:

4This style of tactic proof is deprecated. See %runElab for the replacement.

5test015.idr:88:15-20:

6This style of tactic proof is deprecated. See %runElab for the replacement.

test/proof003/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test015.idr --nocolour --consolewidth 80 -o test015

2+${IDRIS:-idris} $@ test015.idr --nocolour --consolewidth 80 -o test015

3./test015

4rm -f test015 Parity.ibc test015.ibc

test/proof004/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --check $@ test035.idr

2+${IDRIS:-idris} --check $@ test035.idr

3rm -f *.ibc

test/proof005/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --check $@ DefaultArgSubstitutionSuccess.idr

2+${IDRIS:-idris} --check $@ DefaultArgSubstitutionSuccess.idr

3rm -f *.ibc

test/proof006/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --check $@ DefaultArgSubstitutionSyntax.idr

2+${IDRIS:-idris} --check $@ DefaultArgSubstitutionSyntax.idr

3rm -f *.ibc

test/proof007/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 --check $@ DefaultArgUnknownName.idr

2+${IDRIS:-idris} --nocolour --consolewidth 80 --check $@ DefaultArgUnknownName.idr

3rm -f *.ibc

test/proof008/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 --check $@ ClaimAndUnfocus.idr

2+${IDRIS:-idris} --nocolour --consolewidth 80 --check $@ ClaimAndUnfocus.idr

3rm -f *.ibc

test/proof009/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --consolewidth 70 --quiet proof009.idr < input

2+${IDRIS:-idris} $@ --consolewidth 70 --quiet proof009.idr < input

3rm -f *.ibc

test/proof010/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ proof010.idr -o proof010

2+${IDRIS:-idris} $@ proof010.idr -o proof010

3./proof010

4rm -f proof010 *.ibc

test/proofsearch001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --check proofsearch001.idr

2+${IDRIS:-idris} $@ --check proofsearch001.idr

3rm -f *.ibc

test/proofsearch002/Process.idr+1−1

@@ -3,7 +3,7 @@ module Process

3import System.Concurrency.Raw

4import public Data.List -- public, to get proof search machinery

5

6−%access public

6+%access public export

7

8-- Process IDs are parameterised by their interface. A request of type

9-- 'iface t' will get a response of type 't'

test/proofsearch002/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --check proofsearch002.idr

2+${IDRIS:-idris} $@ --check proofsearch002.idr

3rm -f *.ibc

test/proofsearch003/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --check proofsearch003.idr

2+${IDRIS:-idris} --check proofsearch003.idr

3rm -f *.ibc

test/pruviloj001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ -p pruviloj --check --nocolour --consolewidth 70 pruviloj001.idr

2+${IDRIS:-idris} $@ -p pruviloj --check --nocolour --consolewidth 70 pruviloj001.idr

3rm -f *.ibc

test/quasiquote001/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ QuasiquoteBasics.idr -o quasiquote001

2+${IDRIS:-idris} $@ QuasiquoteBasics.idr -o quasiquote001

3./quasiquote001

4rm -f quasiquote001 *.ibc

test/quasiquote002/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ GoalQQuote.idr -o quasiquote002

2+${IDRIS:-idris} $@ GoalQQuote.idr -o quasiquote002

3./quasiquote002

4rm -f quasiquote002 *.ibc

test/quasiquote003/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ --check NoInfer.idr

2+${IDRIS:-idris} --consolewidth 80 $@ --check NoInfer.idr

3rm -f *.ibc

test/quasiquote004/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ --check --nocolour Quasiquote004.idr

2+${IDRIS:-idris} --consolewidth 80 $@ --check --nocolour Quasiquote004.idr

3rm -f *.ibc

test/quasiquote005/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --check --nocolour Quasiquote005.idr

2+${IDRIS:-idris} $@ --check --nocolour Quasiquote005.idr

3rm -f *.ibc

test/quasiquote006/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --check --nocolour --quiet --consolewidth 70 quasiquote006.idr

2+${IDRIS:-idris} $@ --check --nocolour --quiet --consolewidth 70 quasiquote006.idr

3rm -f *.ibc

test/records001/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test011.idr -o test011

2+${IDRIS:-idris} $@ test011.idr -o test011

3./test011

4rm -f test011 test011.ibc

test/records002/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ record002.idr -o record002

2+${IDRIS:-idris} $@ record002.idr -o record002

3./record002

4rm -f record002 *.ibc

test/records003/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ records003.idr -o records003

2+${IDRIS:-idris} $@ records003.idr -o records003

3./records003

4rm -f records003 *.ibc

test/records004/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ records004.idr -o records004

2+${IDRIS:-idris} $@ records004.idr -o records004

3./records004

4rm -f records004 *.ibc

test/reg001/run+1−1

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

1#!/usr/bin/env bash

2−idris reg001.idr --check

2+${IDRIS:-idris} reg001.idr --check

3rm -rf reg001.ibc

4

test/reg002/run+1−1

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

1#!/usr/bin/env bash

2−idris reg012.idr -o reg012

2+${IDRIS:-idris} reg012.idr -o reg012

3./reg012

4rm -f reg012 *.ibc

test/reg003/run+2−2

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

1#!/usr/bin/env bash

2−idris --consolewidth 80 --check reg003.idr

2+${IDRIS:-idris} --consolewidth 80 --check reg003.idr

3−idris --consolewidth 80 --check reg003a.idr

3+${IDRIS:-idris} --consolewidth 80 --check reg003a.idr

4rm -f *.ibc

test/reg004/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ reg004.idr -o reg004

2+${IDRIS:-idris} $@ reg004.idr -o reg004

3./reg004

4rm -f reg004 *.ibc

test/reg005/expectednew file+3

@@ -0,0 +1,3 @@

1+hey

2+you

3+[(), ()]

test/reg005/reg005.idrnew file+9

@@ -0,0 +1,9 @@

1+module UPIO

2+

3+foo : List (IO ())

4+foo = [putStrLn "hey", putStrLn "you"]

5+

6+namespace Main

7+ main : IO ()

8+ main = let stuff = map unsafePerformIO foo in putStrLn (show stuff)

9+

test/reg005/runnew file+4

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

1+#!/usr/bin/env bash

2+${IDRIS:-idris} $@ reg005.idr -o reg005

3+./reg005

4+rm -f reg005 *.ibc

test/reg006/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ reg006.idr --check

2+${IDRIS:-idris} --consolewidth 80 $@ reg006.idr --check

3rm -f *.ibc

test/reg007/A.lidr+1−1

@@ -1,5 +1,5 @@

1> module A

2

3−> n : Nat

3+> public export n : Nat

4> n = ?lala

5

test/reg007/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 --nocolour --check $@ reg007.lidr

2+${IDRIS:-idris} --consolewidth 80 --nocolour --check $@ reg007.lidr

3rm -f *.ibc

test/reg010/run+1−1

@@ -1,2 +1,2 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ reg010.idr --check --nocolour

2+${IDRIS:-idris} --consolewidth 80 $@ reg010.idr --check --nocolour

test/reg013/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ reg013.idr -o reg013

2+${IDRIS:-idris} $@ reg013.idr -o reg013

3./reg013

4rm -f reg013 *.ibc

test/reg016/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ reg016.idr -o reg016

2+${IDRIS:-idris} $@ reg016.idr -o reg016

3./reg016

4rm -f reg016 *.ibc

test/reg017/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ --nocolour --consolewidth 80 reg017.idr -o reg017

2+${IDRIS:-idris} $@ --nocolour --consolewidth 80 reg017.idr -o reg017

3./reg017

4rm -f reg017 *.ibc

test/reg018/run+4−4

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

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ reg018a.idr --check

2+${IDRIS:-idris} --consolewidth 80 $@ reg018a.idr --check

3−idris --consolewidth 80 $@ reg018b.idr --check

3+${IDRIS:-idris} --consolewidth 80 $@ reg018b.idr --check

4−idris --consolewidth 80 $@ reg018c.idr --check

4+${IDRIS:-idris} --consolewidth 80 $@ reg018c.idr --check

5−idris --consolewidth 80 $@ reg018d.idr --check

5+${IDRIS:-idris} --consolewidth 80 $@ reg018d.idr --check

6rm *.ibc

test/reg020/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ reg020.idr -o reg020

2+${IDRIS:-idris} $@ reg020.idr -o reg020

3./reg020

4rm -f reg020 *.ibc

test/reg023/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 $@ reg023.idr --check

2+${IDRIS:-idris} --nocolour --consolewidth 80 $@ reg023.idr --check

3rm -f *.ibc

test/reg024/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ reg024.idr -o reg024

2+${IDRIS:-idris} $@ reg024.idr -o reg024

3./reg024

4rm -f reg024 *.ibc

test/reg025/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ reg025.idr -o reg025

2+${IDRIS:-idris} $@ reg025.idr -o reg025

3./reg025

4rm -f reg025 *.ibc

test/reg027/run+2−2

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ reg027.idr -o reg027

2+${IDRIS:-idris} --consolewidth 80 $@ reg027.idr -o reg027

3./reg027

4−idris --consolewidth 80 $@ reg027a.idr --check

4+${IDRIS:-idris} --consolewidth 80 $@ reg027a.idr --check

5rm -f reg027 *.ibc

test/reg028/run+2−2

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

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ reg028.idr --check

2+${IDRIS:-idris} --consolewidth 80 $@ reg028.idr --check

3−idris --consolewidth 80 $@ reg028a.idr --check

3+${IDRIS:-idris} --consolewidth 80 $@ reg028a.idr --check

4rm -f *.ibc

test/reg029/run+2−2

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

1#!/usr/bin/env bash

2

3−idris $@ reg029.idr -o reg029

3+${IDRIS:-idris} $@ reg029.idr -o reg029

4unset IDRIS_REG029_NONEXISTENT_VAR

5export IDRIS_REG029_EXISTENT_VAR='exists!'

6

@@ -12,6 +12,6 @@ else

12 javac -cp reg029:. Reg029Wrapper.java

13 java -cp reg029:. Reg029Wrapper

14fi

15−idris $@ reg029.idr --execute

15+${IDRIS:-idris} $@ reg029.idr --execute

16rm -f reg029 *.ibc *.class

17

test/reg031/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ reg031.idr -o reg031

2+${IDRIS:-idris} $@ reg031.idr -o reg031

3./reg031

4rm -f *.ibc reg031

test/reg032/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test028.idr -o test028

2+${IDRIS:-idris} $@ test028.idr -o test028

3./test028

4rm -f test028 test028.ibc

test/reg034/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 --check reg034.idr

2+${IDRIS:-idris} --nocolour --consolewidth 80 --check reg034.idr

3rm -f reg034 *.ibc

test/reg035/run+3−3

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 --check reg035.idr

2+${IDRIS:-idris} --nocolour --consolewidth 80 --check reg035.idr

3−idris --nocolour --consolewidth 80 --check reg035a.lidr

3+${IDRIS:-idris} --nocolour --consolewidth 80 --check reg035a.lidr

4−idris --nocolour --consolewidth 80 --check reg035b.idr

4+${IDRIS:-idris} --nocolour --consolewidth 80 --check reg035b.idr

5rm -f *.ibc

test/reg036/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --check reg036.idr

2+${IDRIS:-idris} --check reg036.idr

3rm -f reg036 *.ibc

test/reg037/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --check reg037.idr

2+${IDRIS:-idris} --check reg037.idr

3rm -f reg037 *.ibc

test/reg038/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --check reg038.idr

2+${IDRIS:-idris} --check reg038.idr

3rm -f *.ibc

test/reg040/run+1−1

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

1#!/usr/bin/env bash

2

3−idris --warnreach reg040.idr -o reg040

3+${IDRIS:-idris} --warnreach reg040.idr -o reg040

4./reg040

5

6rm -f reg040 *.ibc

test/reg041/run+2−2

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris $@ --quiet ott.idr -e example

2+${IDRIS:-idris} $@ --quiet ott.idr -e example

3−idris $@ showu.idr -o reg040

3+${IDRIS:-idris} $@ showu.idr -o reg040

4./reg040

5rm -f reg040 *.ibc

test/reg042/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ reg042 -o reg042 --warnreach

2+${IDRIS:-idris} $@ reg042 -o reg042 --warnreach

3./reg042

4rm -f reg042 *.ibc

test/reg044/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 reg044.idr --check

2+${IDRIS:-idris} --nocolour --consolewidth 80 reg044.idr --check

3rm -f *.ibc

test/reg045/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ reg045.idr -o reg045

2+${IDRIS:-idris} $@ reg045.idr -o reg045

3./reg045

4rm -f reg045 *.ibc

test/reg046/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ reg046.idr --check

2+${IDRIS:-idris} $@ reg046.idr --check

3rm -f reg046 *.ibc

test/reg047/run+2−2

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

1#!/usr/bin/env bash

2−idris $@ reg047.idr --check --nobuiltins

2+${IDRIS:-idris} $@ reg047.idr --check --nobuiltins

3−idris $@ reg047a.idr --check

3+${IDRIS:-idris} $@ reg047a.idr --check

4rm -f *.ibc

test/reg048/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ reg048.idr -p contrib -o reg048

2+${IDRIS:-idris} $@ reg048.idr -p contrib -o reg048

3./reg048

4rm -f reg048 *.ibc

test/reg049/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 --nocolour --check $@ reg049.idr

2+${IDRIS:-idris} --consolewidth 80 --nocolour --check $@ reg049.idr

3rm -f *.ibc

test/reg050/run+3−3

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris --nocolour --check $@ working.idr

2+${IDRIS:-idris} --nocolour --check $@ working.idr

3−idris --nocolour --check $@ badbangop.idr

3+${IDRIS:-idris} --nocolour --check $@ badbangop.idr

4−idris --nocolour --check $@ baddoublebang.idr

4+${IDRIS:-idris} --nocolour --check $@ baddoublebang.idr

5rm -f *.ibc

test/reg051-disabled/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ reg051.idr --check

2+${IDRIS:-idris} $@ reg051.idr --check

3rm -f *.ibc

test/reg052/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ -o reg052 reg052.idr

2+${IDRIS:-idris} $@ -o reg052 reg052.idr

3./reg052

4rm -f reg052 *.ibc

test/reg053/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --check four.idr

2+${IDRIS:-idris} $@ --check four.idr

3rm -f *.ibc

test/reg054/run+1−1

@@ -1,2 +1,2 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 $@ reg054.idr --check

2+${IDRIS:-idris} --nocolour --consolewidth 80 $@ reg054.idr --check

test/reg055/run+2−2

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 $@ reg055.idr --check

2+${IDRIS:-idris} --nocolour --consolewidth 80 $@ reg055.idr --check

3−idris --nocolour --consolewidth 80 $@ reg055a.idr --check

3+${IDRIS:-idris} --nocolour --consolewidth 80 $@ reg055a.idr --check

4rm -f *.ibc

5

test/reg056/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ reg056.idr -o reg056

2+${IDRIS:-idris} --consolewidth 80 $@ reg056.idr -o reg056

3rm -f *.ibc

test/reg057/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ reg057.idr --check

2+${IDRIS:-idris} $@ reg057.idr --check

3rm -f *.ibc

test/reg058/run+2−2

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris $@ implicits.idr --check

2+${IDRIS:-idris} $@ implicits.idr --check

3−idris $@ implicits2.idr --check

3+${IDRIS:-idris} $@ implicits2.idr --check

4

5rm -f *.ibc

test/reg059/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ reg059.idr --check

2+${IDRIS:-idris} $@ reg059.idr --check

3rm -f *.ibc

test/reg060/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ reg060.idr --check

2+${IDRIS:-idris} $@ reg060.idr --check

3rm -f *.ibc

test/reg061/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ Capture.idr --check

2+${IDRIS:-idris} $@ Capture.idr --check

3rm -f *.ibc

test/reg062/run+2−2

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

1#!/usr/bin/env bash

2−idris $@ reg062.idr --check --nocolour

2+${IDRIS:-idris} $@ reg062.idr --check --nocolour

3−idris $@ reg062.lidr --check --nocolour

3+${IDRIS:-idris} $@ reg062.lidr --check --nocolour

4rm -f *.ibc

test/reg063/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ Cmp.idr --check --nocolour --quiet

2+${IDRIS:-idris} $@ Cmp.idr --check --nocolour --quiet

3rm *.ibc

test/reg064/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ reg064.idr --check

2+${IDRIS:-idris} $@ reg064.idr --check

3rm -f *.ibc

test/reg065/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ reg065.idr --check

2+${IDRIS:-idris} $@ reg065.idr --check

3rm -f *.ibc

test/reg066/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ reg066.idr --check --nocolor

2+${IDRIS:-idris} $@ reg066.idr --check --nocolor

3rm -f *.ibc

test/reg067/run+1−1

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2rm -f *.ibc reg067

3−idris $@ reg067.idr -o reg067 --warnreach

3+${IDRIS:-idris} $@ reg067.idr -o reg067 --warnreach

4./reg067

5rm -f *.ibc reg067

test/runtest.hsnew file+218

@@ -0,0 +1,218 @@

1+{-# LANGUAGE CPP #-}

2+module Main where

3+

4+import Control.Monad

5+import Data.Char

6+import Data.List

7+import Data.Maybe

8+import qualified Data.Set as S

9+import Data.Time.Clock

10+import System.Directory

11+import System.Environment

12+import System.FilePath

13+import System.Exit

14+import System.Info

15+import System.IO

16+import System.Process

17+

18+-- Because GHC earlier than 7.8 lacks setEnv

19+-- Install the setenv package on Windows.

20+#if __GLASGOW_HASKELL__ < 708

21+#ifndef mingw32_HOST_OS

22+import qualified System.Posix.Env as PE(setEnv)

23+

24+setEnv k v = PE.setEnv k v True

25+#else

26+import System.SetEnv(setEnv)

27+#endif

28+#endif

29+

30+data Flag = Update | Diff | ShowOutput | Quiet | Time deriving (Eq, Show, Ord)

31+

32+type Flags = S.Set Flag

33+

34+data Status = Success | Failure | Updated deriving (Eq, Show)

35+

36+data Config = Config {

37+ flags :: Flags,

38+ idrOpts :: [String],

39+ tests :: [String]

40+} deriving (Show, Eq)

41+

42+isQuiet conf = Quiet `S.member` (flags conf)

43+showOutput conf = ShowOutput `S.member` (flags conf)

44+showTime conf = Time `S.member` (flags conf)

45+showDiff conf = Diff `S.member` (flags conf)

46+doUpdate conf = Update `S.member` (flags conf)

47+

48+checkTestName :: String -> Bool

49+checkTestName d = (all isDigit $ take 3 $ reverse d)

50+ && (not $ isInfixOf "disabled" d)

51+

52+enumTests :: IO [String]

53+enumTests = do

54+ cd <- getCurrentDirectory

55+ dirs <- getDirectoryContents cd

56+ return $ sort $ filter checkTestName dirs

57+

58+parseFlag :: String -> Maybe Flag

59+parseFlag s = case s of

60+ "-u" -> Just Update

61+ "-d" -> Just Diff

62+ "-s" -> Just ShowOutput

63+ "-t" -> Just Time

64+ "-q" -> Just Quiet

65+ _ -> Nothing

66+

67+parseFlags :: [String] -> (S.Set Flag, [String])

68+parseFlags xs = (S.fromList f, i)

69+ where

70+ f = catMaybes $ map parseFlag fl

71+ (fl, i) = partition (\s -> parseFlag s /= Nothing) xs

72+

73+parseArgs :: [String] -> IO Config

74+parseArgs args = do

75+ (tests, rest) <- case args of

76+ ("all":xs) -> do

77+ et <- enumTests

78+ return (et, xs)

79+ ("without":xs) -> do

80+ t <- enumTests

81+ (blacklist, ys) <- return $ break (== "opts") xs

82+ return (t \\ blacklist, ys \\ ["opts"])

83+ (x:xs) -> do

84+ exists <- doesDirectoryExist x

85+ return (if checkTestName x && exists then [x] else [], xs)

86+ [] -> do

87+ et <- enumTests

88+ return (et, [])

89+ let (testOpts, idOpts) = parseFlags rest

90+ return $ Config testOpts idOpts tests

91+

92+-- "bash" needed because Haskell has cmd as the default shell on windows, and

93+-- we also want to run the process with another current directory, so we get

94+-- this thing.

95+runInShell :: String -> [String] -> IO (ExitCode, String)

96+runInShell test opts = do

97+ (ec, output, _) <- readCreateProcessWithExitCode

98+ ((proc "bash" ("run":opts)) { cwd = Just test,

99+ std_out = CreatePipe })

100+ ""

101+ return (ec, output)

102+

103+runTest :: Config -> String -> IO Status

104+runTest conf test = do

105+ -- don't touch the current directory as we want to run these things

106+ -- in parallel in the future

107+ let inTest s = test ++ "/" ++ s

108+ t1 <- getCurrentTime

109+ (exitCode, output) <- runInShell test (idrOpts conf)

110+ t2 <- getCurrentTime

111+ expected <- readFile $ inTest "expected"

112+ writeFile (inTest "output") output

113+ res <- if (norm output == norm expected)

114+ then do putStrLn $ test ++ " finished...success"

115+ return Success

116+ else if doUpdate conf

117+ then do putStrLn $ test ++ " finished...UPDATE"

118+ writeFile (inTest "expected") output

119+ return Updated

120+ else do putStrLn $ test ++ " finished...FAILURE"

121+ _ <- rawSystem "diff" [inTest "output", inTest "expected"]

122+ return Failure

123+ when (showTime conf) $ do

124+ let dt = diffUTCTime t2 t1

125+ putStrLn $ "Duration of " ++ test ++ " was " ++ show dt

126+ return res

127+ where

128+ -- just pretend that backslashes are slashes for comparison

129+ -- purposes to avoid path problems, so don't write any tests

130+ -- that depend on that distinction in other contexts.

131+ -- Also rewrite newlines for consistency.

132+ norm ('\r':'\n':xs) = '\n' : norm xs

133+ norm ('\\':xs) = '/' : norm xs

134+ norm (x : xs) = x : norm xs

135+ norm [] = []

136+

137+printStats :: Config -> [Status] -> IO ()

138+printStats conf stats = do

139+ let total = length stats

140+ let successful = length $ filter (== Success) stats

141+ let failures = length $ filter (== Failure) stats

142+ let updates = length $ filter (== Updated) stats

143+ putStrLn "\n----"

144+ putStrLn $ show total ++ " tests run: " ++ show successful ++ " succesful, "

145+ ++ show failures ++ " failed, " ++ show updates ++ " updated."

146+ let failed = map fst $ filter ((== Failure) . snd) $ zip (tests conf) stats

147+ when (failed /= []) $ do

148+ putStrLn "\nFailed tests:"

149+ mapM_ putStrLn failed

150+ putStrLn ""

151+

152+runTests :: Config -> IO Bool

153+runTests conf = do

154+ stats <- mapM (runTest conf) (tests conf)

155+ unless (isQuiet conf) $ printStats conf stats

156+ return $ all (== Success) stats

157+

158+runShow :: Config -> IO Bool

159+runShow conf = do

160+ mapM_ (\t -> callProcess "cat" [t++"/output"]) (tests conf)

161+ return True

162+

163+runDiff :: Config -> IO Bool

164+runDiff conf = do

165+ mapM_ (\t -> do putStrLn $ "Differences in " ++ t ++ ":"

166+ ec <- rawSystem "diff" [t++"/output", t++"/expected"]

167+ when (ec == ExitSuccess) $ putStrLn "No differences found.")

168+ (tests conf)

169+ return True

170+

171+whisper :: Config -> String -> IO ()

172+whisper conf s = do unless (isQuiet conf) $ putStrLn s

173+

174+setPath :: Config -> IO ()

175+setPath conf = do

176+ maybeEnv <- lookupEnv "IDRIS"

177+ idrisEnv <- return $ fromMaybe "" maybeEnv

178+ if (idrisEnv /= "")

179+ then do

180+ idrisAbs <- makeAbsolute idrisEnv

181+ setEnv "IDRIS" idrisAbs

182+ whisper conf $ "Using " ++ idrisAbs

183+ else do

184+ path <- getEnv "PATH"

185+ let sandbox = "../.cabal-sandbox/bin"

186+ hasBox <- doesDirectoryExist sandbox

187+ bindir <- if hasBox

188+ then do

189+ whisper conf $ "Using Cabal sandbox at " ++ sandbox

190+ makeAbsolute sandbox

191+ else do

192+ stackExe <- findExecutable "stack"

193+ case stackExe of

194+ Just stack -> do

195+ out <- readProcess stack ["path", "--dist-dir"] []

196+ stackDistDir <- return $ takeWhile (/= '\n') out

197+ let stackDir = "../" ++ stackDistDir ++ "/build/idris"

198+ whisper conf $ "Using stack work dir at " ++ stackDir

199+ makeAbsolute stackDir

200+ Nothing -> return ""

201+ when (bindir /= "") $ setEnv "PATH" (bindir ++ [searchPathSeparator] ++ path)

202+

203+main = do

204+ hSetBuffering stdout LineBuffering

205+ args <- getArgs

206+ conf <- parseArgs args

207+ setPath conf

208+ t1 <- getCurrentTime

209+ res <- case tests conf of

210+ [] -> return True

211+ xs | showOutput conf -> runShow conf

212+ xs | showDiff conf -> runDiff conf

213+ xs -> runTests conf

214+ t2 <- getCurrentTime

215+ when (showTime conf) $ do

216+ let dt = diffUTCTime t2 t1

217+ putStrLn $ "Duration of Entire Test Suite was " ++ show dt

218+ unless res exitFailure

test/runtest.pldeleted−214

@@ -1,214 +0,0 @@

1−#!/usr/bin/env perl

2−

3−use strict;

4−use Cwd;

5−use Cwd 'abs_path';

6−use Env;

7−

8−my $exitstatus = 0;

9−my @idrOpts = ();

10−

11−

12−# Determines how idris was built locally, returning a PATH modifier.

13−#

14−# Order of checking is:

15−#

16−# 1. Cabal Sandboxing

17−# 2. Stack

18−# 3. Pure cabal.

19−#

20−sub sandbox_path {

21− my ($test_dir,) = @_;

22− my $sandbox = "$test_dir/../../.cabal-sandbox/bin";

23−

24− my $stack_bin_path = `stack path --dist-dir`;

25− $stack_bin_path =~ s/\n//g;

26− my $stack_work_dir = "$test_dir/../../$stack_bin_path/build/idris";

27−

28− if ( -d $sandbox ) {

29−

30− my $sandbox_abs = abs_path($sandbox);

31− print "Using Cabal Sandbox\n";

32− printf("Sandbox located at: %s\n", $sandbox_abs);

33− return "PATH=\"$sandbox_abs:$PATH\"";

34−

35− } elsif ( -d $stack_work_dir ) {

36−

37− my $stack_work_abs = abs_path($stack_work_dir);

38− print "Using Stack Work\n";

39− printf("Stack work located at: %s\n", $stack_work_abs);

40− return "PATH=\"$stack_work_abs:$PATH\"";

41−

42− } else {

43− print "Using Default Cabal.\n";

44− return "";

45− }

46−}

47−

48−# Run an individual test, and compare expected output with given

49−# output and report results.

50−#

51−sub runtest {

52− my ($test, $update, $showTime) = @_;

53−

54− my $sandbox = sandbox_path($test);

55−

56− chdir($test);

57−

58− my $startTime = time();

59− print "Running $test...\n";

60− my $got = `$sandbox ./run @idrOpts`;

61− my $exp = `cat expected`;

62−

63− my $endTime = time();

64− my $elapsedTime = $endTime - $startTime;

65−

66− if ($showTime == 1 ){

67− printf("Duration of $test was %d\n", $elapsedTime);

68− }

69−

70− # Allow for variant expected output for tests by overriding expected

71− # when there is an expected.<os> file in the test.

72− # This should be the exception but there are sometimes valid reasons

73− # for os-dependent output.

74− # The endings are msys for windows, darwin for osx and linux for linux

75− if ( -e "expected.$^O") {

76− $exp = `cat expected.$^O`;

77− }

78− open my $out, '>', 'output';

79− print $out $got;

80− close $out;

81−

82− # $ok = system("diff output expected &> /dev/null");

83− # Mangle newlines in $got and $exp

84− $got =~ s/\r\n/\n/g;

85− $exp =~ s/\r\n/\n/g;

86−

87− # Normalize paths in $got and $exp, so the expected outcomes don't

88− # change between platforms

89− while($got =~ /(^|.*?\n)(.*?)\\(.*?):(\d+):(.*)/ms) {

90− $got = "$1$2/$3:$4:$5";

91− }

92− while($exp =~ /(^|.*?\n)(.*?)\\(.*?):(\d+):(.*)/ms) {

93− $exp = "$1$2/$3:$4:$5";

94− }

95−

96− if ($got eq $exp) {

97− print "Ran $test...success\n";

98− }

99− else {

100− if ($update == 0) {

101− $exitstatus = 1;

102− print "Ran $test...FAILURE\n";

103− system "diff output expected";

104− } else {

105− system("cp output expected");

106− print "Ran $test...UPDATED\n";

107− }

108− }

109− chdir "..";

110−}

111−

112−# Main test running program to sort test input, and execute individual

113−# tests.

114−#

115−

116−my ( @without, @args, @tests, @opts );

117−

118−# Deal with the Args.

119−if ($#ARGV>=0) {

120− my $test = shift @ARGV;

121− if ($test eq "all") {

122− opendir my $dir, ".";

123− my @list = readdir $dir;

124− foreach my $file (@list) {

125− if ($file =~ /[0-9][0-9][0-9]$/) {

126− push @tests, $file;

127− }

128− }

129− @tests = sort @tests;

130−

131− } elsif ($test eq "without") {

132− @args = @ARGV;

133− foreach my $file (@args) {

134− last if ($file =~ /--/);

135− push @without, shift @ARGV;

136− }

137−

138− opendir my $dir, ".";

139− my @list = readdir $dir;

140− foreach my $file (@list) {

141− if ($file =~ /[0-9][0-9][0-9]$/) {

142− if (!(grep ($_ eq $file, @without))) {

143− push @tests, $file;

144− }

145− else {

146− print "Omitting $file\n";

147− }

148− }

149− }

150− @tests = sort @tests;

151− }

152− else {

153− if ($test =~ /[0-9][0-9][0-9]$/) {

154− push @tests, $test;

155− }

156− }

157− @opts = @ARGV;

158−}

159−else {

160− print "Give a test name, or 'all' to run all.\n";

161− exit;

162−}

163−

164−# Run the tests.

165−

166−my $update = 0;

167−my $diff = 0;

168−my $show = 0;

169−my $usejava = 0;

170−my $showTime = 0;

171−

172−while (my $opt = shift @opts) {

173− if ($opt eq "-u") { $update = 1; }

174− elsif ($opt eq "-d") { $diff = 1; }

175− elsif ($opt eq "-s") { $show = 1; }

176− elsif ($opt eq "-t") { $showTime = 1; }

177− else { push(@idrOpts, $opt); }

178−}

179−

180−my $idris = $ENV{IDRIS};

181−my $path = $ENV{PATH};

182−$ENV{PATH} = cwd() . "/" . $idris . ":" . $path;

183−

184−my $startTime = time();

185−

186−foreach my $test (@tests) {

187− if ($diff == 0 && $show == 0) {

188− runtest($test,$update,$showTime);

189− }

190− else {

191− chdir $test;

192−

193− if ($show == 1) {

194− system "cat output";

195− }

196− if ($diff == 1) {

197− print "Differences in $test:\n";

198− my $ok = system "diff output expected";

199− if ($ok == 0) {

200− print "No differences found.\n";

201− }

202− }

203− chdir "..";

204− }

205−}

206−

207−my $endTime = time();

208−my $elapsedTime = $endTime - $startTime;

209−

210−if ($showTime == 1) {

211− printf("Duration of Entire Test Suite was %d\n", $elapsedTime);

212−}

213−

214−exit $exitstatus;

test/sourceLocation001/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ --nocolour --consolewidth 80 SourceLoc.idr -o sourceLocation001

2+${IDRIS:-idris} $@ --nocolour --consolewidth 80 SourceLoc.idr -o sourceLocation001

3./sourceLocation001

4rm -f sourceLocation001 *.ibc

test/sugar001/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test007.idr -o test007

2+${IDRIS:-idris} $@ test007.idr -o test007

3./test007

4rm -f test007 test007.ibc

test/sugar002/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test009.idr -o test009

2+${IDRIS:-idris} $@ test009.idr -o test009

3./test009

4rm -f test009 test009.ibc

test/sugar003/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ test013.idr -o test013

2+${IDRIS:-idris} $@ test013.idr -o test013

3./test013

4rm -f test013 test013.ibc

test/sugar004/run+1−1

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris $@ sugar004.idr -o sugar004

2+${IDRIS:-idris} $@ sugar004.idr -o sugar004

3./sugar004

4./sugar004 42

5./sugar004 42 100

test/sugar005/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ As.idr -o sugar005

2+${IDRIS:-idris} $@ As.idr -o sugar005

3./sugar005

4rm -f sugar005 *.ibc

test/syntax001/expected+2−2

@@ -2,7 +2,7 @@ Syntax.idr:6:7-9:1:

2When checking right hand side of foo with expected type

3 Nat

4

5−When checking an application of function Prelude.Classes.+:

5+When checking an application of function Prelude.Interfaces.+:

6 Type mismatch between

7 String (Type of "argh")

8 and

@@ -11,7 +11,7 @@ SyntaxTest.idr:5:7-6:1:

11When checking right hand side of foo with expected type

12 Nat

13

14−When checking an application of function Prelude.Classes.+:

14+When checking an application of function Prelude.Interfaces.+:

15 Type mismatch between

16 String (Type of "argh")

17 and

test/syntax001/run+2−2

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

1#!/usr/bin/env bash

2−idris $@ Syntax.idr --nocolour --consolewidth 80 --check

2+${IDRIS:-idris} $@ Syntax.idr --nocolour --consolewidth 80 --check

3−idris $@ SyntaxTest.idr --nocolour --consolewidth 80 --check

3+${IDRIS:-idris} $@ SyntaxTest.idr --nocolour --consolewidth 80 --check

4rm -f *.ibc

test/syntax002/run+1−1

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

1#!/usr/bin/env bash

2−idris $@ syntax002.idr -o syntax002

2+${IDRIS:-idris} $@ syntax002.idr -o syntax002

3./syntax002

4rm -f syntax002 *.ibc

test/tactics001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --check Tactics.idr

2+${IDRIS:-idris} $@ --check Tactics.idr

3rm -f *.ibc

test/totality001/run+3−3

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

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ --check test010.idr

2+${IDRIS:-idris} --consolewidth 80 $@ --check test010.idr

3−idris --consolewidth 80 $@ --check test010a.idr

3+${IDRIS:-idris} --consolewidth 80 $@ --check test010a.idr

4−idris --consolewidth 80 $@ --check test010b.idr

4+${IDRIS:-idris} --consolewidth 80 $@ --check test010b.idr

5

6rm -f *.ibc

test/totality002/run+3−3

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ --check test017.idr

2+${IDRIS:-idris} --consolewidth 80 $@ --check test017.idr

3−idris --consolewidth 80 $@ --check test017a.idr

3+${IDRIS:-idris} --consolewidth 80 $@ --check test017a.idr

4−idris --consolewidth 80 $@ --check test017b.idr

4+${IDRIS:-idris} --consolewidth 80 $@ --check test017b.idr

5rm -f *.ibc

test/totality003/run+2−2

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

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 $@ totality003.idr --check

2+${IDRIS:-idris} --nocolour --consolewidth 80 $@ totality003.idr --check

3−idris --nocolour --consolewidth 80 $@ totality003a.idr --check

3+${IDRIS:-idris} --nocolour --consolewidth 80 $@ totality003a.idr --check

4rm -f *.ibc

test/totality004/run+2−2

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ totality004.idr -o totality004

2+${IDRIS:-idris} --consolewidth 80 $@ totality004.idr -o totality004

3./totality004

4−idris --consolewidth 80 $@ --check totality004a.idr

4+${IDRIS:-idris} --consolewidth 80 $@ --check totality004a.idr

5rm -f totality004 *.ibc

test/totality005/run+2−2

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris $@ totality005.idr --total --check

2+${IDRIS:-idris} $@ totality005.idr --total --check

3−idris $@ totality005.idr -o totality005

3+${IDRIS:-idris} $@ totality005.idr -o totality005

4./totality005

5rm -f totality005 *.ibc

test/totality006/run+3−3

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ totality006.idr --check

2+${IDRIS:-idris} --consolewidth 80 $@ totality006.idr --check

3−idris --consolewidth 80 $@ totality006a.idr --check

3+${IDRIS:-idris} --consolewidth 80 $@ totality006a.idr --check

4−idris --consolewidth 80 $@ totality006b.idr --check

4+${IDRIS:-idris} --consolewidth 80 $@ totality006b.idr --check

5rm -f *.ibc

test/totality007/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --build totality.ipkg

2+${IDRIS:-idris} $@ --build totality.ipkg

3rm -f src/*.ibc

test/totality008/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --consolewidth 80 $@ totality008.idr --check

2+${IDRIS:-idris} --consolewidth 80 $@ totality008.idr --check

3rm -f *.ibc

test/totality009/run+2−2

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2OPTS="--consolewidth infinite --nocolour"

3−idris "$@" $OPTS --check TestLambdaImpossible

3+${IDRIS:-idris} "$@" $OPTS --check TestLambdaImpossible

4−idris "$@" $OPTS --check --warnpartial TestLambdaPossible

4+${IDRIS:-idris} "$@" $OPTS --check --warnpartial TestLambdaPossible

5rm -f *.ibc

test/totality010/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ totality010.idr --nocolour --consolewidth 80 --check

2+${IDRIS:-idris} $@ totality010.idr --nocolour --consolewidth 80 --check

3rm -f *.ibc

test/tutorial001/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --check tutorial001.idr

2+${IDRIS:-idris} --check tutorial001.idr

3rm -f *.ibc

test/tutorial002/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ --nocolour --consolewidth 80 tutorial002.idr --check

2+${IDRIS:-idris} $@ --nocolour --consolewidth 80 tutorial002.idr --check

3rm -f *.ibc

test/tutorial003/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ tutorial003.idr --check

2+${IDRIS:-idris} $@ tutorial003.idr --check

3rm -f *.ibc

test/tutorial004/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ tutorial004.idr --check --nocolour --consolewidth 80

2+${IDRIS:-idris} $@ tutorial004.idr --check --nocolour --consolewidth 80

3rm -f *.ibc

test/tutorial005/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris $@ tutorial005.idr --check

2+${IDRIS:-idris} $@ tutorial005.idr --check

3rm -f *.ibc

test/tutorial006/run+3−3

@@ -1,5 +1,5 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 $@ tutorial006a.idr --check

2+${IDRIS:-idris} --nocolour --consolewidth 80 $@ tutorial006a.idr --check

3−idris --nocolour --consolewidth 80 $@ tutorial006b.idr --check

3+${IDRIS:-idris} --nocolour --consolewidth 80 $@ tutorial006b.idr --check

4−idris --nocolour --consolewidth 80 $@ tutorial006c.idr -p effects --check

4+${IDRIS:-idris} --nocolour --consolewidth 80 $@ tutorial006c.idr -p effects --check

5rm -f *.ibc

test/unique001/run+6−6

@@ -1,9 +1,9 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 $@ unique001.idr -o unique001

2+${IDRIS:-idris} --nocolour --consolewidth 80 $@ unique001.idr -o unique001

3./unique001

4−idris --nocolour --consolewidth 80 $@ unique001a.idr --check

4+${IDRIS:-idris} --nocolour --consolewidth 80 $@ unique001a.idr --check

5−idris --nocolour --consolewidth 80 $@ unique001b.idr --check

5+${IDRIS:-idris} --nocolour --consolewidth 80 $@ unique001b.idr --check

6−idris --nocolour --consolewidth 80 $@ unique001c.idr --check

6+${IDRIS:-idris} --nocolour --consolewidth 80 $@ unique001c.idr --check

7−idris --nocolour --consolewidth 80 $@ unique001d.idr --check

7+${IDRIS:-idris} --nocolour --consolewidth 80 $@ unique001d.idr --check

8−idris --nocolour --consolewidth 80 $@ unique001e.idr --check

8+${IDRIS:-idris} --nocolour --consolewidth 80 $@ unique001e.idr --check

9rm -f unique001 *.ibc

test/unique002/run+2−2

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

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 $@ unique002.idr --check

2+${IDRIS:-idris} --nocolour --consolewidth 80 $@ unique002.idr --check

3−idris --nocolour --consolewidth 80 $@ unique002a.idr --check

3+${IDRIS:-idris} --nocolour --consolewidth 80 $@ unique002a.idr --check

4rm -f *.ibc

test/unique003/run+1−1

@@ -1,3 +1,3 @@

1#!/usr/bin/env bash

2−idris --nocolour --consolewidth 80 $@ unique003.idr --check

2+${IDRIS:-idris} --nocolour --consolewidth 80 $@ unique003.idr --check

3rm -f *.ibc