on master help sign in
Merge branch 'master' of https://github.com/idris-lang/Idris-dev
commit58fc44e2f6a7cdfc2d7131319fba0551ca216adc authorSaurabh Rawat <saurabh.rawat90@gmail.com> dateTue 13 Dec 2016, 19:06 (10 years ago) parentdcd18642e7a841
86 files changed+541−240
.travis.yml+2 CHANGELOG.md+26 CONTRIBUTORS+1 docs/conf.py+1−1 docs/reference/misc.rst+1−1 docs/reference/packages.rst+8−1 docs/tutorial/index.rst−1 docs/tutorial/packages.rst+101−15 docs/tutorial/syntax.rst+1−1 docs/tutorial/testing.rst−85 idris.cabal+8−1 libs/base/Data/String/Views.idr+2 libs/base/Debug/Error.idr+3−6 libs/base/System.idr+33−4 libs/contrib/CFFI/Types.idr+3−1 libs/effects/Effect/Exception.idr+1−2 libs/prelude/Builtins.idr+7 libs/prelude/Prelude.idr+11−3 libs/prelude/Prelude/Nat.idr+13−8 libs/prelude/Prelude/Strings.idr+19−14 rts/idris_rts.c+5 rts/idris_rts.h+3 src/IRTS/CodegenC.hs+1 src/IRTS/Compiler.hs+9−3 src/IRTS/Lang.hs+2 src/IRTS/System.hs+6−1 src/Idris/AbsSyntax.hs+4−8 src/Idris/AbsSyntaxTree.hs+6−2 src/Idris/Core/Elaborate.hs+6−7 src/Idris/Core/Evaluate.hs+18−6 src/Idris/Core/ProofState.hs+20−13 src/Idris/Core/ProofTerm.hs+4−4 src/Idris/Elab/Clause.hs+8−1 src/Idris/Elab/Term.hs+13−5 src/Idris/ElabDecls.hs+6−1 src/Idris/IBC.hs+3−2 src/Idris/IdrisDoc.hs+2−2 src/Idris/Info.hs+5 src/Idris/Package.hs+3−2 src/Idris/Parser.hs+6−2 test/TestData.hs+4−2 test/basic019/basic019.idr+10 test/basic019/expected+12 test/basic019/run+4 test/dsl001/expected+4−4 test/dsl001/input+1−1 test/dsl001/test001.idr+2 test/dsl002/Resimp.idr+1 test/dsl003/DSLPi.idr+2 test/dsl004/Door0.idr+3−1 test/dsl004/Door1.idr+2 test/dsl004/Door2.idr+2 test/dsl004/Door3.idr+2 test/dsl004/IOu.idr+2 test/interactive010/expected+2−2 test/meta001/Finite.idr+2 test/meta002/AgdaStyleReflection.idr+1−1 test/meta002/DataDef.idr+2 test/meta002/Deriving.idr+2 test/meta002/Tacs.idr+1 test/meta002/expected+2−2 test/meta003/BadDef.idr+2 test/meta003/expected+1−1 test/meta004/expected+1−1 test/meta004/meta004.idr+2 test/pkg008/expected+13 test/pkg008/maths.ipkg+9 test/pkg008/run+9 test/pkg008/src/NumOps.idr+9 test/pkg008/src/Test.idr+21 test/proof002/Reflect.idr+1 test/proof002/expected+3−3 test/pruviloj001/pruviloj001.idr+1 test/sourceLocation001/SourceLoc.idr+1 test/sourceLocation001/expected+8−8 test/tactics001/Tactics.idr+1−1 test/unique001/unique001.idr+2 test/unique004/expected+10−10 test/unique004/unique001a.idr+2 test/unique004/unique001b.idr+2 test/unique004/unique001c.idr+1 test/unique004/unique001d.idr+1 test/unique004/unique001e.idr+1 test/unique004/unique002.idr+2 test/unique004/unique002a.idr+2 test/unique004/unique003.idr+2
.travis.yml+2
@@ -66,6 +66,8 @@ before_install:
6666 fi
6767
6868install:
69+ - which cabal
70+ - which ghc
6971 - cabal --version
7072 - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
7173 - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
CHANGELOG.md+26
@@ -1,3 +1,29 @@
1+# New in 0.99.1:
2+
3+## Language updates
4+
5+* New language extensions, in addition to the existing `TypeProviders` and
6+ `ErrorReflection`:
7+ + `ElabReflection`, which must be enabled to use `%runElab`
8+ + `UniquenessTypes`, which must be enabled to use `UniqueType`
9+ + `DSLNotation`, which must be enabled to define a `dsl` block
10+ + `FirstClassReflection`, which must be enabled to define a `%reflection`
11+ function
12+
13+## Tool Updates
14+
15++ Idris' logging output has been updated to more accurately reflect
16+ its progress through the compiler. Idris, when verbose, will report
17+ explicitly: Type Checking; Totality Checking; IBC Generation;
18+ Compiling; and Code Generation.
19+
20+
21+## Library Updates
22+
23++ Terminating programs has been improved with more appropriate
24+ functions (`exitWith`, `exitFailure`, and `exitSuccess`) and a data
25+ structure (`ExitCode`) to capture a program's return code.
26+
127# New in 0.99:
228
329## Language updates
CONTRIBUTORS+1
@@ -206,6 +206,7 @@ TorosFanny
206206Trevor Elliott
207207uwap
208208Vitaly Bragilevsky
209+Vyacheslav Shebanov
209210xged
210211XIE Yuheng
211212Yacine Hmito
docs/conf.py+1−1
@@ -33,7 +33,7 @@ on_rtd = os.environ.get('READTHEDOCS', None) == 'True'
3333# ones.
3434extensions = [
3535 'sphinx.ext.todo',
36− 'sphinx.ext.pngmath',
36+ 'sphinx.ext.imgmath',
3737 'sphinx.ext.ifconfig',
3838]
3939
docs/reference/misc.rst+1−1
@@ -273,7 +273,7 @@ That is, ``{x}`` behaves like ``{x=x}``.
273273
274274
275275Existence of an implementation
276−========================
276+==============================
277277
278278In order to show that an implementation of some interface is defined for some
279279type, one could use the ``%implementation`` keyword:
docs/reference/packages.rst+8−1
@@ -97,7 +97,7 @@ external ``C`` libraries, the following options are available:
9797 which must be present for the package to be usable.
9898
9999+ ``objs = <objs>``, which takes a comma separated list of additional
100− files to be installed (object files, headers), perhaps generated
100+ files to be installed (object files, headers), perhaps generated
101101 by the ``Makefile``.
102102
103103Testing
@@ -112,6 +112,11 @@ The following option is available:
112112.. IMPORTANT::
113113 The modules containing the test functions must also be added to the list of modules.
114114
115+Comments
116+---------
117+
118+Package files support comments using the standard Idris singleline ``--`` and multiline ``{- -}`` format.
119+
115120Using Package files
116121===================
117122
@@ -127,6 +132,8 @@ Given an Idris package file ``text.ipkg`` it can be used with the Idris compiler
127132
128133+ ``idris --mkdoc test.ipkg`` will build HTML documentation for your package in the folder ``test_doc`` in your project's root directory.
129134
135++ ``idris --installdoc test.ipkg`` will install the packages documentation into Idris' central documentation folder located at ``idris --docdir``.
136+
130137+ ``idris --checkpkg test.ipkg`` will type check all modules in the package only. This differs from build that type checks **and** generates code.
131138
132139+ ``idris --testpkg test.ipkg`` will compile and run any embedded tests you have specified in the ``tests`` parameter.
docs/tutorial/index.rst−1
@@ -24,7 +24,6 @@ This is the Idris Tutorial. It will teach you about programming in the Idris Lan
2424 interfaces
2525 modules
2626 packages
27− testing
2827 interp
2928 views
3029 theorems
docs/tutorial/packages.rst+101−15
@@ -31,14 +31,18 @@ package file would be::
3131
3232
3333Other examples of package files can be found in the ``libs`` directory
34−of the main Idris repository, and in `third-party libraries <https://github.com/idris-lang/Idris-dev/wiki/Libraries>`_.
35−More details including a complete listing of available fields can be found in :ref:`ref-sect-packages`.
34+of the main Idris repository, and in `third-party libraries
35+<https://github.com/idris-lang/Idris-dev/wiki/Libraries>`_.
3636
3737
3838Using Package files
3939===================
4040
41−Given an Idris package file ``maths.ipkg`` it can be used with the Idris compiler as follows:
41+
42+Idris itself is aware about packages, and special commands are
43+available to help with, for example, building packages, installing
44+packages, and cleaning packages. For instance, given the ``maths``
45+package from earlier we can use Idris as follows:
4246
4347+ ``idris --build maths.ipkg`` will build all modules in the package
4448
@@ -48,20 +52,102 @@ Given an Idris package file ``maths.ipkg`` it can be used with the Idris compile
4852+ ``idris --clean maths.ipkg`` will delete all intermediate code and
4953 executable files generated when building.
5054
51−+ ``idris --mkdoc maths.ipkg`` will build HTML documentation for your
52− package in the folder ``maths_doc`` in your project's root
53− directory.
54−
55−+ ``idris --checkpkg maths.ipkg`` will type check all modules in the
56− package only. This differs from build that type checks **and**
57− generates code.
58−
59−+ ``idris --testpkg maths.ipkg`` will compile and run any embedded
60− tests you have specified in the ``tests`` parameter. More
61− information about testing is given in the next section.
62−
6355Once the maths package has been installed, the command line option
6456``--package maths`` makes it accessible (abbreviated to ``-p maths``).
6557For example::
6658
6759 idris -p maths Main.idr
60+
61+
62+Testing Idris Packages
63+======================
64+
65+The integrated build system includes a simple testing framework.
66+This framework collects functions listed in the ``ipkg`` file under ``tests``.
67+All test functions must return ``IO ()``.
68+
69+
70+When you enter ``idris --testpkg yourmodule.ipkg``,
71+the build system creates a temporary file in a fresh environment on your machine
72+by listing the ``tests`` functions under a single ``main`` function.
73+It compiles this temporary file to an executable and then executes it.
74+
75+
76+The tests themselves are responsible for reporting their success or failure.
77+Test functions commonly use ``putStrLn`` to report test results.
78+The test framework does not impose any standards for reporting and consequently
79+does not aggregate test results.
80+
81+
82+For example, lets take the following list of functions that are defined in a module called ``NumOps`` for a sample package ``maths``.
83+
84+.. name: Math/NumOps.idr
85+.. code-block:: idris
86+
87+ module Maths.NumOps
88+
89+ %access export -- to make functions under test visible
90+
91+ double : Num a => a -> a
92+ double a = a + a
93+
94+ triple : Num a => a -> a
95+ triple a = a + double a
96+
97+A simple test module, with a qualified name of ``Test.NumOps`` can be declared as
98+
99+.. name: Math/TestOps.idr
100+.. code-block:: idris
101+
102+ module Test.NumOps
103+
104+ import Maths.NumOps
105+
106+ %access export -- to make the test functions visible
107+
108+ assertEq : Eq a => (given : a) -> (expected : a) -> IO ()
109+ assertEq g e = if g == e
110+ then putStrLn "Test Passed"
111+ else putStrLn "Test Failed"
112+
113+ assertNotEq : Eq a => (given : a) -> (expected : a) -> IO ()
114+ assertNotEq g e = if not (g == e)
115+ then putStrLn "Test Passed"
116+ else putStrLn "Test Failed"
117+
118+ testDouble : IO ()
119+ testDouble = assertEq (double 2) 4
120+
121+ testTriple : IO ()
122+ testTriple = assertNotEq (triple 2) 5
123+
124+
125+The functions ``assertEq`` and ``assertNotEq`` are used to run expected passing, and failing, equality tests.
126+The actual tests are ``testDouble`` and ``testTriple``, and are declared in the ``maths.ipkg`` file as follows::
127+
128+ package maths
129+
130+ modules = Maths.NumOps
131+ , Test.NumOps
132+
133+ tests = Test.NumOps.testDouble
134+ , Test.NumOps.testTriple
135+
136+
137+The testing framework can then be invoked using ``idris --testpkg maths.ipkg``::
138+
139+ > idris --testpkg maths.ipkg
140+ Type checking ./Maths/NumOps.idr
141+ Type checking ./Test/NumOps.idr
142+ Type checking /var/folders/63/np5g0d5j54x1s0z12rf41wxm0000gp/T/idristests144128232716531729.idr
143+ Test Passed
144+ Test Passed
145+
146+Note how both tests have reported success by printing ``Test Passed``
147+as we arranged for with the ``assertEq`` and ``assertNoEq`` functions.
148+
149+More information
150+================
151+
152+More details, including a complete listing of available fields, can be
153+found in the reference manual in :ref:`ref-sect-packages`.
docs/tutorial/syntax.rst+1−1
@@ -92,7 +92,7 @@ forms. For example, a ``for`` loop binds a variable on each iteration:
9292
9393.. code-block:: idris
9494
95− syntax for {x} in [xs] ":" [body] = forLoop xs (\x => body)
95+ syntax for {x} "in" [xs] ":" [body] = forLoop xs (\x => body)
9696
9797 main : IO ()
9898 main = do for x in [1..10]:
docs/tutorial/testing.rstdeleted−85
@@ -1,85 +0,0 @@
1−.. _tut-sect-testing:
2−
3−**********************
4−Testing Idris Packages
5−**********************
6−
7−The integrated build system includes a simple testing framework.
8−This framework collects functions listed in the ``ipkg`` file under ``tests``.
9−All test functions must return ``IO ()``.
10−
11−
12−When you enter ``idris --testpkg yourmodule.ipkg``,
13−the build system creates a temporary file in a fresh environment on your machine
14−by listing the ``tests`` functions under a single ``main`` function.
15−It compiles this temporary file to an executable and then executes it.
16−
17−
18−The tests themselves are responsible for reporting their success or failure.
19−Test functions commonly use ``putStrLn`` to report test results.
20−The test framework does not impose any standards for reporting and consequently
21−does not aggregate test results.
22−
23−
24−For example, lets take the following list of functions that are defined in a module called ``NumOps`` for a sample package ``maths``.
25−
26−.. name: Math/NumOps.idr
27−.. code-block:: idris
28−
29− module Maths.NumOps
30−
31− double : Num a => a -> a
32− double a = a + a
33−
34− triple : Num a => a -> a
35− triple a = a + double a
36−
37−A simple test module, with a qualified name of ``Test.NumOps`` can be declared as
38−
39−.. name: Math/TestOps.idr
40−.. code-block:: idris
41−
42− module Test.NumOps
43−
44− import Maths.NumOps
45−
46− assertEq : Eq a => (given : a) -> (expected : a) -> IO ()
47− assertEq g e = if g == e
48− then putStrLn "Test Passed"
49− else putStrLn "Test Failed"
50−
51− assertNotEq : Eq a => (given : a) -> (expected : a) -> IO ()
52− assertNotEq g e = if not (g == e)
53− then putStrLn "Test Passed"
54− else putStrLn "Test Failed"
55−
56− testDouble : IO ()
57− testDouble = assertEq (double 2) 4
58−
59− testTriple : IO ()
60− testTriple = assertNotEq (triple 2) 5
61−
62−
63−The functions ``assertEq`` and ``assertNotEq`` are used to run expected passing, and failing, equality tests.
64−The actual tests are ``testDouble`` and ``testTriple``, and are declared in the ``maths.ipkg`` file as follows::
65−
66− package maths
67−
68− modules = Maths.NumOps
69− , Test.NumOps
70−
71− tests = Test.NumOps.testDouble
72− , Test.NumOps.testTriple
73−
74−
75−The testing framework can then be invoked using ``idris --testpkg maths.ipkg``::
76−
77− > idris --testpkg maths.ipkg
78− Type checking ./Maths/NumOps.idr
79− Type checking ./Test/NumOps.idr
80− Type checking /var/folders/63/np5g0d5j54x1s0z12rf41wxm0000gp/T/idristests144128232716531729.idr
81− Test Passed
82− Test Passed
83−
84−Note how both tests have reported success by printing ``Test Passed``
85−as we arranged for with the ``assertEq`` and ``assertNoEq`` functions.
idris.cabal+8−1
@@ -289,7 +289,6 @@ Library
289289 , vector < 0.12
290290 , vector-binary-instances < 0.3
291291 , zip-archive > 0.2.3.5 && < 0.4
292− , safe == 0.3.9
293292 , fsnotify >= 0.2 && < 2.2
294293 , async < 2.2
295294
@@ -302,6 +301,14 @@ Library
302301 else
303302 build-depends: process < 1.5
304303
304+ -- safe 0.3.10 is having issues with cabal 1.20 and ghc 7.6.3, the
305+ -- hvr ghc ppa doesn't provide a new enough cabal library. Temporary
306+ -- fix until hvr ghc ppa is fixed or we deprecate support for 7.6.3.
307+ if impl(ghc < 7.8.4)
308+ build-depends: safe == 0.3.9
309+ else
310+ build-depends: safe >= 0.3.9
311+
305312 Extensions: MultiParamTypeClasses
306313 , DeriveFoldable
307314 , DeriveTraversable
libs/base/Data/String/Views.idr+2
@@ -1,5 +1,7 @@
11module Data.String.Views
22
3+%access public export
4+
35||| View for traversing a String one character at a time
46data StrList : String -> Type where
57 SNil : StrList ""
libs/base/Debug/Error.idr+3−6
@@ -12,9 +12,6 @@ error : {default (%runElab sourceLocation) loc : SourceLocation} ->
1212 (message : String) ->
1313 a
1414error {loc = FileLoc filename (line, col) _} message =
15− believe_me . unsafePerformIO $
16− do let place = filename ++ " line " ++ show line ++ " column " ++ show col
17− let message' = place ++ ": " ++ message
18− putStrLn message'
19− exit 1
20−
15+ let place = filename ++ " line " ++ show line ++ " column " ++ show col
16+ message' = place ++ ": " ++ message in
17+ idris_crash message'
libs/base/System.idr+33−4
@@ -54,11 +54,41 @@ getEnvironment = getAllPairs 0 []
5454 then pure $ reverse $ map splitEq acc
5555 else getAllPairs (n + 1) (envPair :: acc)
5656
57+||| Programs can either terminate successfully, or end in a caught
58+||| failure.
59+data ExitCode : Type where
60+ ||| Terminate successfully.
61+ ExitSuccess : ExitCode
62+ ||| Program terminated for some prescribed reason.
63+ |||
64+ ||| @errNo A non-zero numerical value indicating failure.
65+ ||| @prf Proof that the int value is non-zero.
66+ ExitFailure : (errNo : Int)
67+ -> {auto prf : So (not $ errNo == 0)}
68+ -> ExitCode
69+
5770||| Quit with a particular exit code
58−exit : Int -> IO ()
59−exit code = foreign FFI_C "exit" (Int -> IO ()) code
71+exit : Int -> IO a
72+exit code = believe_me $ foreign FFI_C "exit" (Int -> IO ()) code
73+
74+||| Terminate the program with an `ExitCode`. This code indicates the
75+||| success of the program's execution, and returns the success code
76+||| to the program's caller.
77+|||
78+||| @code The `ExitCode` for program.
79+exitWith : (code : ExitCode) -> IO a
80+exitWith ExitSuccess = exit 0
81+exitWith (ExitFailure errNo) = exit errNo
82+
83+||| Exit the program indicating failure.
84+exitFailure : IO a
85+exitFailure = exitWith (ExitFailure 1)
6086
61−||| Get the numbers of seconds since 1st January 1970, 00:00 UTC
87+||| Exit the program after a successful run.
88+exitSuccess : IO a
89+exitSuccess = exitWith ExitSuccess
90+
91+||| Get the numbers of seconds since 1st January 1970, 00:00 UTC
6292time : IO Integer
6393time = do MkRaw t <- foreign FFI_C "idris_time" (IO (Raw Integer))
6494 pure t
@@ -69,4 +99,3 @@ usleep i = foreign FFI_C "usleep" (Int -> IO ()) i
6999
70100system : String -> IO Int
71101system cmd = foreign FFI_C "system" (String -> IO Int) cmd
72−
libs/contrib/CFFI/Types.idr+3−1
@@ -126,13 +126,15 @@ offsetsPacked xs = offsets' xs [] 0
126126 offsets' [] acc _ = reverse acc
127127 offsets' (x::xs) acc pos = offsets' xs (pos::acc) (sizeOf x)
128128
129+%language ElabReflection -- needed for 'error', which finds a line number
130+
129131private
130132indexOrFail : Nat -> List a -> a
131133indexOrFail i xs = case index' i xs of
132134 Just x => x
133135 Nothing => error "Out of bounds access"
134136
135−||| The offset of a firld in a composite type
137+||| The offset of a field in a composite type
136138export
137139offset : Composite -> Nat -> Int
138140offset (STRUCT xs) i = indexOrFail i (offsetsStruct xs)
libs/effects/Effect/Exception.idr+1−2
@@ -17,7 +17,7 @@ implementation Handler (Exception a) List where
1717
1818implementation Show a => Handler (Exception a) IO where
1919 handle _ (Raise e) k = do printLn e
20− believe_me (exit 1)
20+ (exit 1)
2121
2222implementation Handler (Exception a) (IOExcept a) where
2323 handle _ (Raise e) k = ioe_fail e
@@ -30,4 +30,3 @@ EXCEPTION t = MkEff () (Exception t)
3030
3131raise : a -> Eff b [EXCEPTION a]
3232raise err = call $ Raise err
33−
libs/prelude/Builtins.idr+7
@@ -2,6 +2,7 @@
22
33%access public export
44%default total
5+%language UniquenessTypes
56
67||| The canonical single-element type, also known as the trivially
78||| true proposition.
@@ -177,6 +178,12 @@ assert_total x = x
177178assert_unreachable : a
178179-- compiled as primitive
179180
181+||| Abort immediately with an error message
182+idris_crash : (msg : String) -> a
183+-- compiled as primitive
184+
185+%used idris_crash msg
186+
180187||| Subvert the type checker. This function is abstract, so it will not reduce in
181188||| the type checker. Use it with care - it can result in segfaults or worse!
182189export
libs/prelude/Prelude.idr+11−3
@@ -37,6 +37,8 @@ import public Language.Reflection.Errors
3737%access public export
3838%default total
3939
40+%language ElabReflection
41+
4042-- Things that can't be elsewhere for import cycle reasons
4143-- See comment after declaration of void in Builtins.idr
4244-- for explanation of this definition's location
@@ -144,9 +146,14 @@ natRange n = List.reverse (go n)
144146 where go Z = []
145147 go (S n) = n :: go n
146148
149+
147150-- predefine Nat versions of Enum, so we can use them in the default impls
151+countFrom : Num n => n -> n -> Stream n
152+countFrom start diff = start :: countFrom (start + diff) diff
153+
148154total natEnumFromThen : Nat -> Nat -> Stream Nat
149−natEnumFromThen n next = n :: natEnumFromThen next (minus next n)
155+natEnumFromThen n next = countFrom n (minus next n)
156+
150157total natEnumFromTo : Nat -> Nat -> List Nat
151158natEnumFromTo n m = if n <= m
152159 then go n m
@@ -195,7 +202,7 @@ Enum Integer where
195202 succ n = n + 1
196203 toNat n = cast n
197204 fromNat n = cast n
198− enumFromThen n inc = n :: enumFromThen (inc + n) inc
205+ enumFromThen n inc = countFrom n (inc - n)
199206 enumFromTo n m = if n <= m
200207 then go n m
201208 else List.reverse $ go m n
@@ -224,7 +231,8 @@ Enum Int where
224231 go' acc (S k) m = go' (m :: acc) k (m - 1)
225232 go : Int -> Int -> List Int
226233 go n m = go' [] (cast {to = Nat} (m - n)) m
227− enumFromThen n inc = n :: enumFromThen (inc + n) inc
234+ enumFromThen n inc = countFrom n (inc - n)
235+
228236 enumFromThenTo n next m = if n == m then [n]
229237 else if next - n == 0 || next - n < 0 /= m - n < 0 then []
230238 else go (natRange (S (divNatNZ (cast {to=Nat} (abs (m - n))) (S (cast {to=Nat} ((abs (next - n)) - 1))) SIsNotZ)))
libs/prelude/Prelude/Nat.idr+13−8
@@ -91,6 +91,12 @@ hyper (S pn) a (S pb) = hyper pn a (hyper (S pn) a pb)
9191-- Comparisons
9292--------------------------------------------------------------------------------
9393
94+||| Proofs that `n` or `m` is not equal to Z
95+data NotBothZero : (n, m : Nat) -> Type where
96+ LeftIsNotZero : NotBothZero (S n) m
97+ RightIsNotZero : NotBothZero n (S m)
98+
99+
94100||| Proofs that `n` is less than or equal to `m`
95101||| @ n the smaller number
96102||| @ m the larger number
@@ -386,16 +392,15 @@ log2 (S n) = log2NZ (S n) SIsNotZ
386392--------------------------------------------------------------------------------
387393-- GCD and LCM
388394--------------------------------------------------------------------------------
389−partial
390−gcd : Nat -> Nat -> Nat
391−gcd a Z = a
392−gcd a b = assert_total (gcd b (a `modNat` b))
395+gcd : (a: Nat) -> (b: Nat) -> .{auto ok: NotBothZero a b} -> Nat
396+gcd a Z = a
397+gcd Z b = b
398+gcd a (S b) = assert_total $ gcd (S b) (modNatNZ a (S b) SIsNotZ)
393399
394−partial
395400lcm : Nat -> Nat -> Nat
396−lcm _ Z = Z
397−lcm Z _ = Z
398−lcm x y = divNat (x * y) (gcd x y)
401+lcm _ Z = Z
402+lcm Z _ = Z
403+lcm a (S b) = assert_total $ divNat (a * (S b)) (gcd a (S b))
399404
400405
401406--------------------------------------------------------------------------------
libs/prelude/Prelude/Strings.idr+19−14
@@ -45,7 +45,8 @@ foldl1 f (x::xs) = foldl f x xs
4545||| ```
4646partial
4747strHead : String -> Char
48−strHead = prim__strHead
48+strHead "" = idris_crash "Prelude.Strings: attempt to take the head of an empty string"
49+strHead x = prim__strHead x
4950
5051||| Returns the characters specified after the head of the string.
5152|||
@@ -59,7 +60,8 @@ strHead = prim__strHead
5960||| ```
6061partial
6162strTail : String -> String
62−strTail = prim__strTail
63+strTail "" = idris_crash "Prelude.Strings: attempt to take the tail of an empty string"
64+strTail xs = prim__strTail xs
6365
6466||| Adds a character to the front of the specified string.
6567|||
@@ -72,6 +74,18 @@ strTail = prim__strTail
7274strCons : Char -> String -> String
7375strCons = prim__strCons
7476
77+||| Returns the length of the string.
78+|||
79+||| ```idris example
80+||| length ""
81+||| ```
82+||| ```idris example
83+||| length "ABC"
84+||| ```
85+length : String -> Nat
86+length = fromInteger . prim__zextInt_BigInt . prim_lenString
87+
88+
7589||| Returns the nth character (starting from 0) of the specified string.
7690|||
7791||| Precondition: '0 < i < length s' for 'strIndex s i'.
@@ -81,7 +95,9 @@ strCons = prim__strCons
8195||| ```
8296partial
8397strIndex : String -> Int -> Char
84−strIndex = prim__strIndex
98+strIndex x i = if (i < 0 || i >= cast (length x))
99+ then idris_crash "Prelude.Strings: String index out of bounds"
100+ else prim__strIndex x i
85101
86102||| Reverses the elements within a String.
87103|||
@@ -297,17 +313,6 @@ unlines' (l::ls) = l ++ '\n' :: unlines' ls
297313unlines : List String -> String
298314unlines = pack . unlines' . map unpack
299315
300−||| Returns the length of the string.
301−|||
302−||| ```idris example
303−||| length ""
304−||| ```
305−||| ```idris example
306−||| length "ABC"
307−||| ```
308−length : String -> Nat
309−length = fromInteger . prim__zextInt_BigInt . prim_lenString
310−
311316||| Returns a substring of a given string
312317|||
313318||| @ index The (zero based) index of the string to extract. If this is
rts/idris_rts.c+5
@@ -595,6 +595,11 @@ VAL idris_readStr(VM* vm, FILE* h) {
595595 return ret;
596596}
597597
598+void idris_crash(char* msg) {
599+ fprintf(stderr, "%s\n", msg);
600+ exit(1);
601+}
602+
598603VAL idris_strHead(VM* vm, VAL str) {
599604 return idris_strIndex(vm, str, 0);
600605}
rts/idris_rts.h+3
@@ -364,6 +364,9 @@ VAL idris_pokeDouble(VAL ptr, VAL offset, VAL data);
364364VAL idris_peekSingle(VM* vm, VAL ptr, VAL offset);
365365VAL idris_pokeSingle(VAL ptr, VAL offset, VAL data);
366366
367+// Crash with a message (used for partial primitives)
368+void idris_crash(char* msg);
369+
367370// String primitives
368371VAL idris_concat(VM* vm, VAL l, VAL r);
369372VAL idris_strlt(VM* vm, VAL l, VAL r);
src/IRTS/CodegenC.hs+1
@@ -617,6 +617,7 @@ doOp v (LIntCh ITNative) args = v ++ creg (last args)
617617doOp v (LIntCh ITChar) args = doOp v (LIntCh ITNative) args
618618
619619doOp v LSystemInfo [x] = v ++ "idris_systemInfo(vm, " ++ creg x ++ ")"
620+doOp v LCrash [x] = "idris_crash(GETSTR(" ++ creg x ++ "))"
620621doOp v LNoOp args = v ++ creg (last args)
621622
622623-- Pointer primitives (declared as %extern in Builtins.idr)
src/IRTS/Compiler.hs+9−3
@@ -52,8 +52,9 @@ import System.Process
5252
5353-- | Compile to simplified forms and return CodegenInfo
5454compile :: Codegen -> FilePath -> Maybe Term -> Idris CodegenInfo
55−compile codegen f mtm
56− = do checkMVs -- check for undefined metavariables
55+compile codegen f mtm = do
56+ logCodeGen 1 "Compiling Output."
57+ checkMVs -- check for undefined metavariables
5758 checkTotality -- refuse to compile if there are totality problems
5859 exports <- findExports
5960 let rootNames = case mtm of
@@ -108,7 +109,7 @@ compile codegen f mtm
108109 Just f -> runIO $ writeFile f (dumpDefuns defuns)
109110 triple <- Idris.AbsSyntax.targetTriple
110111 cpu <- Idris.AbsSyntax.targetCPU
111− logCodeGen 1 "Building output"
112+ logCodeGen 1 "Generating Code."
112113 case checked of
113114 OK c -> do return $ CodegenInfo f outty triple cpu
114115 hdrs impdirs objs libs flags
@@ -258,6 +259,11 @@ irTerm top vs env tm@(App _ f a) = do
258259 | u == txt "assert_unreachable"
259260 -> return $ LError $ "ABORT: Reached an unreachable case in " ++ show top
260261
262+ (P _ (UN u) _, [_, msg])
263+ | u == txt "idris_crash"
264+ -> do msg' <- irTerm top vs env msg
265+ return $ LOp LCrash [msg']
266+
261267 -- TMP HACK - until we get inlining.
262268 (P _ (UN r) _, [_, _, _, _, _, arg])
263269 | r == txt "replace"
src/IRTS/Lang.hs+2
@@ -92,6 +92,8 @@ data PrimFn = LPlus ArithTy | LMinus ArithTy | LTimes ArithTy
9292 | LPar -- evaluate argument anywhere, possibly on another
9393 -- core or another machine. 'id' is a valid implementation
9494 | LExternal Name
95+ | LCrash
96+
9597 | LNoOp
9698 deriving (Show, Eq, Generic)
9799
src/IRTS/System.hs+6−1
@@ -6,7 +6,7 @@ License : BSD3
66Maintainer : The Idris Community.
77-}
88{-# LANGUAGE CPP #-}
9−module IRTS.System( getDataFileName
9+module IRTS.System( getIdrisDataFileByName
1010 , getCC
1111 , getLibFlags
1212 , getIdrisDataDir
@@ -42,6 +42,11 @@ getIdrisDataDir = do
4242 return ddir
4343 Just ddir -> return ddir
4444
45+getIdrisDataFileByName :: String -> IO FilePath
46+getIdrisDataFileByName fn = do
47+ dir <- getIdrisDataDir
48+ return $ dir </> fn
49+
4550overrideIdrisSubDirWith :: String -- ^ Sub directory in `getDataDir` location.
4651 -> String -- ^ Environment variable to get new location from.
4752 -> IO FilePath
src/Idris/AbsSyntax.hs+4−8
@@ -142,14 +142,10 @@ addImported pub f
142142 putIState $ i { idris_imported = nub $ (f, pub) : idris_imported i }
143143
144144addLangExt :: LanguageExt -> Idris ()
145−addLangExt TypeProviders = do i <- getIState
146− putIState $ i {
147− idris_language_extensions = TypeProviders : idris_language_extensions i
148− }
149−addLangExt ErrorReflection = do i <- getIState
150− putIState $ i {
151− idris_language_extensions = ErrorReflection : idris_language_extensions i
152− }
145+addLangExt e = do i <- getIState
146+ putIState $ i {
147+ idris_language_extensions = e : idris_language_extensions i
148+ }
153149
154150-- | Transforms are organised by the function being applied on the lhs
155151-- of the transform, to make looking up appropriate transforms quicker
src/Idris/AbsSyntaxTree.hs+6−2
@@ -120,7 +120,7 @@ defaultOpts = IOption { opt_logLevel = 0
120120 , opt_showimp = False
121121 , opt_errContext = False
122122 , opt_repl = True
123− , opt_verbose = True
123+ , opt_verbose = False
124124 , opt_nobanner = False
125125 , opt_quiet = False
126126 , opt_codegen = Via IBCFormat "c"
@@ -184,7 +184,8 @@ ppOption opt = PPOption {
184184ppOptionIst :: IState -> PPOption
185185ppOptionIst = ppOption . idris_options
186186
187−data LanguageExt = TypeProviders | ErrorReflection
187+data LanguageExt = TypeProviders | ErrorReflection | UniquenessTypes
188+ | DSLNotation | ElabReflection | FCReflection
188189 deriving (Show, Eq, Read, Ord, Generic)
189190
190191-- | The output mode in use
@@ -335,6 +336,7 @@ primDefs = [ sUN "unsafePerformPrimIO"
335336 , sUN "mkForeignPrim"
336337 , sUN "void"
337338 , sUN "assert_unreachable"
339+ , sUN "idris_crash"
338340 ]
339341
340342-- information that needs writing for the current module's .ibc file
@@ -2470,6 +2472,8 @@ implicitNamesIn uvars ist tm
24702472 ni 0 env (PIfThenElse _ c t f) = mapM_ (ni 0 env) [c, t, f]
24712473 ni 0 env (PLam fc n _ ty sc) = do ni 0 env ty; ni 0 (n:env) sc
24722474 ni 0 env (PPi p n _ ty sc) = do ni 0 env ty; ni 0 (n:env) sc
2475+ ni 0 env (PLet fc n _ ty val sc) = do ni 0 env ty;
2476+ ni 0 env val; ni 0 (n:env) sc
24732477 ni 0 env (PRewrite _ _ l r _) = do ni 0 env l; ni 0 env r
24742478 ni 0 env (PTyped l r) = do ni 0 env l; ni 0 env r
24752479 ni 0 env (PPair _ _ _ l r) = do ni 0 env l; ni 0 env r
src/Idris/Core/Elaborate.hs+6−7
@@ -463,18 +463,17 @@ equiv :: Raw -> Elab' aux ()
463463equiv tm = processTactic' (Equiv tm)
464464
465465-- | Turn the current hole into a pattern variable with the provided
466−-- name, made unique if MN
466+-- name, made unique if not the same as the head of the hole queue
467467patvar :: Name -> Elab' aux ()
468468patvar n@(SN _) = do apply (Var n) []; solve
469469patvar n = do env <- get_env
470470 hs <- get_holes
471471 if (n `elem` map fst env) then do apply (Var n) []; solve
472− else do n' <- case n of
473− UN _ -> return $! n
474− MN _ _ -> unique_hole n
475− NS _ _ -> return $! n
476− x -> return $! n
477− processTactic' (PatVar n')
472+ else do n' <- case hs of
473+ (h : hs) -> if n == h then return n
474+ else unique_hole n
475+ _ -> unique_hole n
476+ processTactic' (PatVar n)
478477
479478-- | Turn the current hole into a pattern variable with the provided
480479-- name, but don't make MNs unique.
src/Idris/Core/Evaluate.hs+18−6
@@ -72,6 +72,16 @@ data Value = VP NameType Name Value
7272-- | VLazy Env [Value] Term
7373 | VTmp Int
7474
75+canonical :: Value -> Bool
76+canonical (VP (DCon _ _ _) _ _) = True
77+canonical (VApp f a) = canonical f
78+canonical (VConstant _) = True
79+canonical (VType _) = True
80+canonical (VUType _) = True
81+canonical VErased = True
82+canonical _ = False
83+
84+
7585instance Show Value where
7686 show x = show $ evalState (quote 100 x) initEval
7787
@@ -254,6 +264,8 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where
254264 atRepl = AtREPL `elem` opts
255265 unfold = Unfold `elem` opts
256266
267+ noFree = all canonical . map snd
268+
257269 -- returns 'True' if the function should block
258270 -- normal evaluation should return false
259271 blockSimplify (CaseInfo inl always dict) n stk
@@ -274,11 +286,11 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where
274286 ev ntimes_in stk top env (P Ref n ty)
275287 = do let limit = if simpl then 100 else 10000
276288 (u, ntimes) <- usable spec unfold limit n ntimes_in
277− let red = u && (tcReducible n ctxt || spec || atRepl
289+ let red = u && (tcReducible n ctxt || spec || (atRepl && noFree env)
278290 || runtime || unfold
279291 || sUN "assert_total" `elem` stk)
280292 if red then
281− do let val = lookupDefAccExact n (spec || unfold || atRepl || runtime) ctxt
293+ do let val = lookupDefAccExact n (spec || unfold || (atRepl && noFree env) || runtime) ctxt
282294 case val of
283295 Just (Function _ tm, Public) ->
284296 ev ntimes (n:stk) True env tm
@@ -347,7 +359,7 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where
347359 evApply ntimes' stk top env [l',t',arg'] d'
348360 -- Treat "assert_total" specially, as long as it's defined!
349361 ev ntimes stk top env (App _ (App _ (P _ n@(UN at) _) _) arg)
350− | Just (CaseOp _ _ _ _ _ _, _) <- lookupDefAccExact n (spec || atRepl || runtime) ctxt,
362+ | Just (CaseOp _ _ _ _ _ _, _) <- lookupDefAccExact n (spec || (atRepl && noFree env)|| runtime) ctxt,
351363 at == txt "assert_total" && not (simpl || unfold)
352364 = ev ntimes (n : stk) top env arg
353365 ev ntimes stk top env (App _ f a)
@@ -376,7 +388,7 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where
376388 = apply ntimes stk top env f args
377389
378390 reapply ntimes stk top env f@(VP Ref n ty) args
379− = let val = lookupDefAccExact n (spec || atRepl || runtime) ctxt in
391+ = let val = lookupDefAccExact n (spec || (atRepl && noFree env) || runtime) ctxt in
380392 case val of
381393 Just (CaseOp ci _ _ _ _ cd, acc) ->
382394 let (ns, tree) = getCases cd in
@@ -398,11 +410,11 @@ eval traceon ctxt ntimes genv tm opts = ev ntimes [] True [] tm where
398410 apply ntimes_in stk top env f@(VP Ref n ty) args
399411 = do let limit = if simpl then 100 else 10000
400412 (u, ntimes) <- usable spec unfold limit n ntimes_in
401− let red = u && (tcReducible n ctxt || spec || atRepl
413+ let red = u && (tcReducible n ctxt || spec || (atRepl && noFree env)
402414 || unfold || runtime
403415 || sUN "assert_total" `elem` stk)
404416 if red then
405− do let val = lookupDefAccExact n (spec || unfold || atRepl || runtime) ctxt
417+ do let val = lookupDefAccExact n (spec || unfold || (atRepl && noFree env) || runtime) ctxt
406418 case val of
407419 Just (CaseOp ci _ _ _ _ cd, acc)
408420 | acc == Public || acc == Hidden ->
src/Idris/Core/ProofState.hs+20−13
@@ -1002,6 +1002,18 @@ updateProblems ps updates probs = rec 10 updates probs
10021002 (x', y', newx || newy,
10031003 updateEnv ns env, updateError ns err, fc, fa)
10041004
1005+orderUpdateSolved :: [(Name, Term)] -> ProofTerm -> (ProofTerm, [Name])
1006+orderUpdateSolved ns tm = update [] ns tm
1007+ where
1008+ update done [] t = (t, done)
1009+ update done ((n, P _ n' _) : ns) t | n == n' = update done ns t
1010+ update done (n : ns) t = update (fst n : done)
1011+ (map (updateMatch n) ns)
1012+ (updateSolved [n] t)
1013+
1014+ -- Update the later solutions too
1015+ updateMatch n (x, tm) = (x, updateSolvedTerm [n] tm)
1016+
10051017-- attempt to solve remaining problems with match_unify
10061018matchProblems :: Bool -> ProofState -> [(Name, TT Name)] -> Fails
10071019 -> ([(Name, TT Name)], Fails)
@@ -1065,30 +1077,25 @@ processTactic (ComputeLet n) ps
10651077 (getProofTerm (pterm ps)) }, "")
10661078processTactic UnifyProblems ps
10671079 = do let (ns', probs') = updateProblems ps [] (map setReady (problems ps))
1068− pterm' = orderUpdateSolved ns' (pterm ps)
1069− traceWhen (unifylog ps) ("(UnifyProblems) Dropping holes: " ++ show (map fst ns')) $
1080+ (pterm', dropped) = orderUpdateSolved ns' (pterm ps)
1081+ traceWhen (unifylog ps) ("(UnifyProblems) Dropping holes: " ++ show dropped) $
10701082 return (ps { pterm = pterm', solved = Nothing, problems = probs',
10711083 previous = Just ps, plog = "",
10721084 notunified = updateNotunified ns' (notunified ps),
1073− recents = recents ps ++ map fst ns',
1085+ recents = recents ps ++ dropped,
10741086 dotted = filter (notIn ns') (dotted ps),
1075− holes = holes ps \\ (map fst ns') }, plog ps)
1087+ holes = holes ps \\ dropped }, plog ps)
10761088 where notIn ns (h, _) = h `notElem` map fst ns
1077− orderUpdateSolved [] t = t
1078− orderUpdateSolved (n : ns) t = orderUpdateSolved ns (updateSolved [n] t)
10791089processTactic (MatchProblems all) ps
10801090 = do let (ns', probs') = matchProblems all ps [] (map setReady (problems ps))
10811091 (ns'', probs'') = matchProblems all ps ns' probs'
1082− pterm' = orderUpdateSolved ns'' (resetProofTerm (pterm ps))
1083− traceWhen (unifylog ps) ("(MatchProblems) Dropping holes: " ++ show ns'') $
1092+ (pterm', dropped) = orderUpdateSolved ns'' (resetProofTerm (pterm ps))
1093+ traceWhen (unifylog ps) ("(MatchProblems) Dropping holes: " ++ show dropped) $
10841094 return (ps { pterm = pterm', solved = Nothing, problems = probs'',
10851095 previous = Just ps, plog = "",
10861096 notunified = updateNotunified ns'' (notunified ps),
1087− recents = recents ps ++ map fst ns'',
1088− holes = holes ps \\ (map fst ns'') }, plog ps)
1089− where
1090− orderUpdateSolved [] t = t
1091− orderUpdateSolved (n : ns) t = orderUpdateSolved ns (updateSolved [n] t)
1097+ recents = recents ps ++ dropped,
1098+ holes = holes ps \\ dropped }, plog ps)
10921099processTactic t ps
10931100 = case holes ps of
10941101 [] -> case t of
src/Idris/Core/ProofTerm.hs+4−4
@@ -170,10 +170,10 @@ updateSolvedTerm' xs x = updateSolved' xs x where
170170 _ -> let (t', _) = updateSolved' xs t in
171171 (updsubst n v t', True)
172172 updateSolved' xs tm@(Bind n b t)
173− | otherwise = let (t', ut) = updateSolved' xs t
174− (b', ub) = updateSolvedB' xs b in
175− if ut || ub then (Bind n b' t', True)
176− else (tm, False)
173+ = let (t', ut) = updateSolved' xs t
174+ (b', ub) = updateSolvedB' xs b in
175+ if ut || ub then (Bind n b' t', True)
176+ else (tm, False)
177177 updateSolved' xs t@(App Complete f a) = (t, False)
178178 updateSolved' xs t@(App s f a)
179179 = let (f', uf) = updateSolved' xs f
src/Idris/Elab/Clause.hs+8−1
@@ -75,6 +75,8 @@ elabClauses info' fc opts n_in cs =
7575 -- Check n actually exists, with no definition yet
7676 let tys = lookupTy n ctxt
7777 let reflect = Reflection `elem` opts
78+ when (reflect && FCReflection `notElem` idris_language_extensions ist) $
79+ ierror $ At fc (Msg "You must turn on the FirstClassReflection extension to use %reflection")
7880 checkUndefined n ctxt
7981 unless (length tys > 1) $ do
8082 fty <- case tys of
@@ -1025,7 +1027,12 @@ elabClause info opts (_, PWith fc fname lhs_in withs wval_in pn_in withblock)
10251027
10261028 logElab 5 ("Checked " ++ show clhs)
10271029 let bargs = getPBtys (explicitNames (normalise ctxt [] lhs_tm))
1028− let wval = rhs_trans info $ addImplBound i (map fst bargs) wval_in
1030+ wval <- case wval_in of
1031+ Placeholder -> ierror $ At fc $
1032+ Msg "No expression for the with block to inspect.\nYou need to replace the _ with an expression."
1033+ _ -> return $
1034+ rhs_trans info $
1035+ addImplBound i (map fst bargs) wval_in
10291036 logElab 5 ("Checking " ++ showTmImpls wval)
10301037 -- Elaborate wval in this context
10311038 ((wvalElab, defer, is, ctxt', newDecls, highlights, newGName), _) <-
src/Idris/Elab/Term.hs+13−5
@@ -295,7 +295,7 @@ elab ist info emode opts fn tm
295295
296296 -- | elabE elaborates an expression, possibly wrapping implicit coercions
297297 -- and forces/delays. If you make a recursive call in elab', it is
298− -- normally correct to call elabE - the ones that don't are desugarings
298+ -- normally correct to call elabE - the ones that don't are `desugarings
299299 -- typically
300300 elabE :: ElabCtxt -> Maybe FC -> PTerm -> ElabD ()
301301 elabE ina fc' t =
@@ -372,7 +372,10 @@ elab ist info emode opts fn tm
372372 solve
373373 highlightSource fc' (AnnType "Type" "The type of types")
374374 elab' ina fc (PUniverse fc' u) =
375− do apply (RUType u) []
375+ do unless (UniquenessTypes `elem` idris_language_extensions ist
376+ || e_qq ina) $
377+ lift $ tfail $ At fc' (Msg "You must turn on the UniquenessTypes extension to use UniqueType or AnyType")
378+ apply (RUType u) []
376379 solve
377380 highlightSource fc' (AnnType (show u) "The type of unique types")
378381-- elab' (_,_,inty) (PConstant c)
@@ -702,14 +705,14 @@ elab ist info emode opts fn tm
702705 solve
703706 highlightSource nfc (AnnBoundName n False)
704707 elab' ina fc (PPi p n nfc Placeholder sc)
705− = do attack; arg n (is_scoped p) (sMN 0 "ty")
708+ = do attack; arg n (is_scoped p) (sMN 0 "phTy")
706709 addAutoBind p n
707710 addPSname n -- okay for proof search
708711 elabE (ina { e_inarg = True, e_intype = True }) fc sc
709712 solve
710713 highlightSource nfc (AnnBoundName n False)
711714 elab' ina fc (PPi p n nfc ty sc)
712− = do attack; tyn <- getNameFrom (sMN 0 "ty")
715+ = do attack; tyn <- getNameFrom (sMN 0 "piTy")
713716 claim tyn RType
714717 n' <- case n of
715718 MN _ _ -> unique_hole n
@@ -1036,6 +1039,9 @@ elab ist info emode opts fn tm
10361039 elab' ina fc (PElabError e) = lift $ tfail e
10371040 elab' ina mfc (PRewrite fc substfn rule sc newg)
10381041 = elabRewrite (elab' ina mfc) ist fc substfn rule sc newg
1042+ -- A common error case if trying to typecheck an autogenerated case block
1043+ elab' ina _ c@(PCase fc Placeholder opts)
1044+ = lift $ tfail (Msg "No expression for the case to inspect.\nYou need to replace the _ with an expression.")
10391045 elab' ina _ c@(PCase fc scr opts)
10401046 = do attack
10411047
@@ -1278,7 +1284,9 @@ elab ist info emode opts fn tm
12781284 dotterm
12791285 elab' ina fc t
12801286 elab' ina fc (PRunElab fc' tm ns) =
1281− do attack
1287+ do unless (ElabReflection `elem` idris_language_extensions ist) $
1288+ lift $ tfail $ At fc' (Msg "You must turn on the ElabReflection extension to use %runElab")
1289+ attack
12821290 n <- getNameFrom (sMN 0 "tacticScript")
12831291 let scriptTy = RApp (Var (sNS (sUN "Elab")
12841292 ["Elab", "Reflection", "Language"]))
src/Idris/ElabDecls.hs+6−1
@@ -284,6 +284,8 @@ elabDecl' what info (PRecord doc rsyn fc opts name nfc ps pdocs fs cname cdoc cs
284284-}
285285elabDecl' _ info (PDSL n dsl)
286286 = do i <- getIState
287+ unless (DSLNotation `elem` idris_language_extensions i) $
288+ ifail "You must turn on the DSLNotation extension to use a dsl block"
287289 putIState (i { idris_dsls = addDef n dsl (idris_dsls i) })
288290 addIBC (IBCDSL n)
289291elabDecl' what info (PDirective i)
@@ -296,6 +298,9 @@ elabDecl' what info (PTransform fc safety old new)
296298 = do elabTransform info fc safety old new
297299 return ()
298300elabDecl' what info (PRunElabDecl fc script ns)
299− = do elabRunElab info fc script ns
301+ = do i <- getIState
302+ unless (ElabReflection `elem` idris_language_extensions i) $
303+ ierror $ At fc (Msg "You must turn on the ElabReflection extension to use %runElab")
304+ elabRunElab info fc script ns
300305 return ()
301306elabDecl' _ _ _ = return () -- skipped this time
src/Idris/IBC.hs+3−2
@@ -220,7 +220,8 @@ writeArchive fp i = do let a = L.foldl (\x y -> addEntryToArchive y x) emptyArch
220220
221221writeIBC :: FilePath -> FilePath -> Idris ()
222222writeIBC src f
223− = do logIBC 1 $ "Writing ibc " ++ show f
223+ = do
224+ logIBC 1 $ "Writing IBC for: " ++ show f
224225 i <- getIState
225226-- case (Data.List.map fst (idris_metavars i)) \\ primDefs of
226227-- (_:_) -> ifail "Can't write ibc when there are unsolved metavariables"
@@ -313,7 +314,7 @@ ibc i (IBCCG n) f = case lookupCtxtExact n (idris_callgraph i) of
313314 _ -> ifail "IBC write failed"
314315ibc i (IBCCoercion n) f = return f { ibc_coercions = n : ibc_coercions f }
315316ibc i (IBCAccess n a) f = return f { ibc_access = (n,a) : ibc_access f }
316−ibc i (IBCFlags n) f
317+ibc i (IBCFlags n) f
317318 = case lookupCtxtExact n (idris_flags i) of
318319 Just a -> return f { ibc_flags = (n,a): ibc_flags f }
319320 _ -> ifail "IBC write failed"
src/Idris/IdrisDoc.hs+2−2
@@ -19,7 +19,7 @@ import Idris.Docs
1919import Idris.Docstrings (nullDocstring)
2020import qualified Idris.Docstrings as Docstrings
2121import Idris.Parser.Helpers (opChars)
22−import IRTS.System (getDataFileName)
22+import IRTS.System (getIdrisDataFileByName)
2323
2424import Control.Applicative ((<|>))
2525import Control.Monad (forM_)
@@ -708,5 +708,5 @@ copyDependencies :: FilePath -- ^ The base directory to which
708708 -- dependencies should be written
709709 -> IO ()
710710copyDependencies dir =
711− do styles <- getDataFileName $ "idrisdoc" </> "styles.css"
711+ do styles <- getIdrisDataFileByName $ "idrisdoc" </> "styles.css"
712712 copyFile styles (dir </> "styles.css")
src/Idris/Info.hs+5
@@ -22,6 +22,7 @@ module Idris.Info
2222 , getIdrisHistoryFile
2323 , getIdrisInstalledPackages
2424 , getIdrisLoggingCategories
25+ , getIdrisDataFileByName
2526 ) where
2627
2728import Idris.AbsSyntax (loggingCatsStr)
@@ -34,6 +35,7 @@ import Version_idris (gitHash)
3435import Data.Version
3536import System.Directory
3637import System.FilePath
38+
3739getIdrisDataDir :: IO String
3840getIdrisDataDir = S.getIdrisDataDir
3941
@@ -88,3 +90,6 @@ getIdrisInstalledPackages = installedPackages
8890
8991getIdrisLoggingCategories :: IO [String]
9092getIdrisLoggingCategories = return $ words loggingCatsStr
93+
94+getIdrisDataFileByName :: String -> IO FilePath
95+getIdrisDataFileByName = S.getIdrisDataFileByName
src/Idris/Package.hs+3−2
@@ -145,7 +145,7 @@ replPkg copts fp = do
145145 case mergeOptions copts (idris_opts pkgdesc) of
146146 Left emsg -> ifail emsg
147147 Right opts -> do
148−
148+
149149 putIState orig
150150 dir <- runIO getCurrentDirectory
151151 runIO $ setCurrentDirectory $ dir </> sourcedir pkgdesc
@@ -266,7 +266,8 @@ testPkg copts fp = do
266266 exitWith (ExitFailure 1)
267267 Right opts -> do
268268 m_ist <- idris opts
269− exitCode <- rawSystem tmpn' []
269+ let texe = if isWindows then addExtension tmpn' ".exe" else tmpn'
270+ exitCode <- rawSystem texe []
270271 return (m_ist, exitCode)
271272 case m_ist of
272273 Nothing -> exitWith (ExitFailure 1)
src/Idris/Parser.hs+6−2
@@ -1429,6 +1429,10 @@ directive syn = do try (lchar '%' *> reserved "lib")
14291429pLangExt :: IdrisParser LanguageExt
14301430pLangExt = (reserved "TypeProviders" >> return TypeProviders)
14311431 <|> (reserved "ErrorReflection" >> return ErrorReflection)
1432+ <|> (reserved "UniquenessTypes" >> return UniquenessTypes)
1433+ <|> (reserved "DSLNotation" >> return DSLNotation)
1434+ <|> (reserved "ElabReflection" >> return ElabReflection)
1435+ <|> (reserved "FirstClassReflection" >> return FCReflection)
14321436
14331437{-| Parses a totality
14341438
@@ -1799,7 +1803,7 @@ loadSource lidr f toline
17991803 setContext ctxt')
18001804 (map snd (idris_totcheck i))
18011805 -- build size change graph from simplified definitions
1802− logLvl 1 "Totality checking"
1806+ logLvl 1 $ "Totality checking " ++ f
18031807 i <- getIState
18041808 mapM_ buildSCG (idris_totcheck i)
18051809 mapM_ checkDeclTotality (idris_totcheck i)
@@ -1822,7 +1826,7 @@ loadSource lidr f toline
18221826
18231827 logLvl 1 ("Finished " ++ f)
18241828 ibcsd <- valIBCSubDir i
1825− logLvl 1 "Universe checking"
1829+ logLvl 1 $ "Universe checking " ++ f
18261830 iucheck
18271831 let ibc = ibcPathNoFallback ibcsd f
18281832 i <- getIState
test/TestData.hs+4−2
@@ -70,7 +70,8 @@ testFamiliesData = [
7070 ( 15, ANY ),
7171 ( 16, ANY ),
7272 ( 17, ANY ),
73− ( 18, ANY )]),
73+ ( 18, ANY ),
74+ ( 19, ANY )]),
7475 ("bignum", "Bignum",
7576 [ ( 1, ANY ),
7677 ( 2, ANY )]),
@@ -178,7 +179,8 @@ testFamiliesData = [
178179 ( 4, ANY ),
179180 ( 5, ANY ),
180181 ( 6, ANY ),
181− ( 7, ANY )]),
182+ ( 7, ANY ),
183+ ( 8, ANY )]),
182184 ("prelude", "Prelude",
183185 [ ( 1, ANY )]),
184186 ("primitives", "Primitive types",
test/basic019/basic019.idrnew file+10
@@ -0,0 +1,10 @@
1+printRange : (t : Type) -> (Show t, Num t, Enum t) => IO ()
2+printRange t = do printLn [(the t 1)..10]
3+ printLn [(the t 10),9..1]
4+ printLn (take 10 [(the t 1)..])
5+ printLn (take 10 [(the t 1),3..])
6+
7+main : IO ()
8+main = do printRange Nat
9+ printRange Int
10+ printRange Integer
test/basic019/expectednew file+12
@@ -0,0 +1,12 @@
1+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
2+[10, 9, 8, 7, 6, 5, 4, 3, 2, 1]
3+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
4+[1, 3, 5, 7, 9, 11, 13, 15, 17, 19]
5+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
6+[10, 9, 8, 7, 6, 5, 4, 3, 2, 1]
7+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
8+[1, 3, 5, 7, 9, 11, 13, 15, 17, 19]
9+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
10+[10, 9, 8, 7, 6, 5, 4, 3, 2, 1]
11+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
12+[1, 3, 5, 7, 9, 11, 13, 15, 17, 19]
test/basic019/runnew file+4
@@ -0,0 +1,4 @@
1+#!/usr/bin/env bash
2+${IDRIS:-idris} $@ basic019.idr -o basic019
3+./basic019
4+rm -f basic019 *.ibc
test/dsl001/expected+4−4
@@ -1,13 +1,13 @@
1124
2212
33testFac : Int
4−testFac = PE_interp_f79b3e31 [] (PE_fromInteger_d6648df 4)
5−PE_interp_f79b3e31 : Env G -> Int -> Int
6−PE_interp_f79b3e31 (3arg) = \x =>
4+testFac = PE_interp_e04a79ff [] (PE_fromInteger_d6648df 4)
5+PE_interp_e04a79ff : Env G -> Int -> Int
6+PE_interp_e04a79ff (3arg) = \x =>
77 ifThenElse (PE_==_ba2f651f x
88 (PE_fromInteger_d6648df 0))
99 (Delay (PE_fromInteger_d6648df 1))
10− (Delay (PE_*_ba2f651f (PE_interp_f79b3e31 (x ::
10+ (Delay (PE_*_ba2f651f (PE_interp_e04a79ff (x ::
1111 (3arg))
1212 (PE_-_ba2f651f x
1313 (PE_fromInteger_d6648df 1)))
test/dsl001/input+1−1
@@ -1,2 +1,2 @@
11:printdef testFac
2−:printdef PE_interp_f79b3e31
2+:printdef PE_interp_e04a79ff
test/dsl001/test001.idr+2
@@ -3,6 +3,8 @@ module Main
33import Data.Vect
44import Data.Fin
55
6+%language DSLNotation
7+
68data Ty = TyInt | TyBool| TyFun Ty Ty
79
810interpTy : Ty -> Type
test/dsl002/Resimp.idr+1
@@ -3,6 +3,7 @@ module Resimp
33import public Data.Vect
44import public Data.Fin
55
6+%language DSLNotation
67%access public export
78
89-- IO operations which read a resource
test/dsl003/DSLPi.idr+2
@@ -3,6 +3,8 @@ module DSLPi
33import Data.Fin
44import Data.Vect
55
6+%language DSLNotation
7+
68data Ty = BOOL | INT | UNIT | ARR Ty Ty
79
810arr_ : _ -> Ty -> Ty -> Ty
test/dsl004/Door0.idr+3−1
@@ -1,6 +1,8 @@
11import IOu
22
3−data Result : (a : Type) -> (a -> Type) -> Type* where
3+%language UniquenessTypes
4+
5+data Result : (a : Type) -> (a -> Type) -> AnyType where
46 Res : {k : a -> Type} -> (val : a) -> k val -> Result a k
57
68
test/dsl004/Door1.idr+2
@@ -2,6 +2,8 @@ import IOu
22
33import Data.Vect
44
5+%language UniquenessTypes
6+
57data Result : (a : AnyType) -> (a -> AnyType) -> AnyType where
68 Res : {k : a -> AnyType} -> (val : a) -> (h : k val) -> Result a k
79
test/dsl004/Door2.idr+2
@@ -1,5 +1,7 @@
11import IOu
22
3+%language UniquenessTypes
4+
35data DoorState = OPEN | CLOSED
46
57data DoorH : DoorState -> UniqueType where
test/dsl004/Door3.idr+2
@@ -1,5 +1,7 @@
11import IOu
22
3+%language UniquenessTypes
4+
35data DoorState = OPEN | CLOSED
46
57data DoorH : DoorState -> UniqueType where
test/dsl004/IOu.idr+2
@@ -1,5 +1,7 @@
11module IOu
22
3+%language UniquenessTypes
4+
35-------- An IO type supporting possibly unique values
46
57data IOu : AnyType -> AnyType where
test/interactive010/expected+2−2
@@ -4,9 +4,9 @@ a is not an implicit argument of Prelude.Interfaces./
44Usage is :doc <functionname>
55Usage is :wc <functionname>
66Usage is :printdef <functionname>
7−pat {ty504} : Type toplevel.u. pat {__interface505} : Prelude.Interfaces.Fractional {ty504}. Prelude.Interfaces./ {ty504} {__interface505}
7+pat {ty503} : Type toplevel.u. pat {__interface504} : Prelude.Interfaces.Fractional {ty503}. Prelude.Interfaces./ {ty503} {__interface504}
88
9− : pty {ty504} : Type toplevel.u. pty {__interface505} : Prelude.Interfaces.Fractional {ty504}. {ty504} -> {ty504} -> {ty504}
9+ : pty {ty503} : Type toplevel.u. pty {__interface504} : Prelude.Interfaces.Fractional {ty503}. {ty503} -> {ty503} -> {ty503}
1010(input):1:1: error: expected: ":",
1111 dependent type signature,
1212 end of input
test/meta001/Finite.idr+2
@@ -4,6 +4,8 @@ import Data.Fin
44import Language.Reflection.Elab
55import Language.Reflection.Utils
66
7+%language ElabReflection
8+
79-- Test various features of reflected elaboration, including looking
810-- up datatypes, defining functions, and totality checking
911
test/meta002/AgdaStyleReflection.idr+1−1
@@ -13,7 +13,7 @@ import Language.Reflection.Utils
1313import Pruviloj
1414
1515%default total
16−
16+%language ElabReflection
1717
1818
1919||| Function arguments as provided at the application site
test/meta002/DataDef.idr+2
@@ -1,5 +1,7 @@
11module DataDef
22
3+%language ElabReflection
4+
35foo : Elab ()
46foo = do declareDatatype $ Declare `{{DataDef.N}} [MkFunArg `{{n}} `(Nat) Explicit NotErased] `(Type)
57 defineDatatype $ DefineDatatype `{{DataDef.N}} [
test/meta002/Deriving.idr+2
@@ -1,6 +1,8 @@
11||| Test some deriving features
22module Deriving
33
4+%language ElabReflection
5+
46-- NB: test disabled due to excess memory consumption
57
68import Pruviloj
test/meta002/Tacs.idr+1
@@ -16,6 +16,7 @@ import Language.Reflection.Utils
1616import Pruviloj.Core
1717
1818%default total
19+%language ElabReflection
1920
2021-- Tactics can now query the elaborator and bind variables
2122
test/meta002/expected+2−2
@@ -1,7 +1,7 @@
1−DataDef.idr:72:1-9:
1+DataDef.idr:74:1-9:
22While running an elaboration script, the following error occurred:
33Prelude.Either.Either is already defined as a datatype.
4−Tacs.idr:298:15:
4+Tacs.idr:299:15:
55When checking right hand side of testElab3 with expected type
66 DPair Ty (Tm [])
77
test/meta003/BadDef.idr+2
@@ -2,6 +2,8 @@ module BadDef
22
33import Language.Reflection.Elab
44
5+%language ElabReflection
6+
57mkN : String -> TTName
68mkN n = NS (UN n) ["BadDef"]
79
test/meta003/expected+1−1
@@ -1,4 +1,4 @@
1−BadDef.idr:12:1-9:
1+BadDef.idr:14:1-9:
22While running an elaboration script, the following error occurred:
33Type mismatch between
44 ()
test/meta004/expected+1−1
@@ -1,3 +1,3 @@
1−meta004.idr:48:1-9:
1+meta004.idr:50:1-9:
22While running an elaboration script, the following error occurred:
33Not an impossible case
test/meta004/meta004.idr+2
@@ -2,6 +2,8 @@ import Data.Fin
22import Language.Reflection.Utils
33import Pruviloj.Core
44
5+%language ElabReflection
6+
57rename : TTName -> TTName -> Raw -> Raw
68rename old new (RBind name b body) = RBind name (map (rename old new) b) (rename old new body)
79rename old new (RApp f arg) = RApp (rename old new f) (rename old new arg)
test/pkg008/expectednew file+13
@@ -0,0 +1,13 @@
1+Entering directory `./src'
2+Type checking ./NumOps.idr
3+Type checking ./Test.idr
4+Leaving directory `./src'
5+Test Passed
6+Test Passed
7+Entering directory `./src'
8+Leaving directory `./src'
9+Entering directory `./src'
10+Removed: NumOps.ibc
11+Removed: Test.ibc
12+Removed: 00maths-idx.ibc
13+Leaving directory `./src'
test/pkg008/maths.ipkgnew file+9
@@ -0,0 +1,9 @@
1+package maths
2+
3+sourcedir = src
4+
5+modules = NumOps
6+ , Test
7+
8+tests = Test.testDouble
9+ , Test.testTriple
test/pkg008/runnew file+9
@@ -0,0 +1,9 @@
1+#!/usr/bin/env bash
2+
3+${IDRIS:-idris} $@ --build maths.ipkg
4+${IDRIS:-idris} $@ --testpkg maths.ipkg | grep -v -e "idris"
5+
6+# Idris only appears in the randomly generated name of test so we grep
7+# to remove it to make output consistent.
8+
9+${IDRIS:-idris} $@ --clean maths.ipkg
test/pkg008/src/NumOps.idrnew file+9
@@ -0,0 +1,9 @@
1+module NumOps
2+
3+%access export -- to make functions under test visible
4+
5+double : Num a => a -> a
6+double a = a + a
7+
8+triple : Num a => a -> a
9+triple a = a + double a
test/pkg008/src/Test.idrnew file+21
@@ -0,0 +1,21 @@
1+module Test
2+
3+import NumOps
4+
5+%access export -- to make the test functions visible
6+
7+assertEq : Eq a => (given : a) -> (expected : a) -> IO ()
8+assertEq g e = if g == e
9+ then putStrLn "Test Passed"
10+ else putStrLn "Test Failed"
11+
12+assertNotEq : Eq a => (given : a) -> (expected : a) -> IO ()
13+assertNotEq g e = if not (g == e)
14+ then putStrLn "Test Passed"
15+ else putStrLn "Test Failed"
16+
17+testDouble : IO ()
18+testDouble = assertEq (double 2) 4
19+
20+testTriple : IO ()
21+testTriple = assertNotEq (triple 2) 5
test/proof002/Reflect.idr+1
@@ -4,6 +4,7 @@ import Decidable.Equality
44
55%access public export
66%default total
7+%language FirstClassReflection
78
89using (xs : List a, ys : List a, G : List (List a))
910
test/proof002/expected+3−3
@@ -1,8 +1,8 @@
1−Reflect.idr:174:21-26:
1+Reflect.idr:175:21-26:
22This style of tactic proof is deprecated. See %runElab for the replacement.
3−Reflect.idr:183:21-26:
3+Reflect.idr:184:21-26:
44This style of tactic proof is deprecated. See %runElab for the replacement.
5−Reflect.idr:191:15-20:
5+Reflect.idr:192:15-20:
66This style of tactic proof is deprecated. See %runElab for the replacement.
77test030a.idr:12:26-14:1:
88When checking right hand side of testReflect1 with expected type
test/pruviloj001/pruviloj001.idr+1
@@ -5,6 +5,7 @@ import Pruviloj
55import Pruviloj.Induction
66
77%default total
8+%language ElabReflection
89
910||| Try some simplification and rewriting heuristics, then attempt to
1011||| solve the goal
test/sourceLocation001/SourceLoc.idr+1
@@ -6,6 +6,7 @@ import Language.Reflection
66import Language.Reflection.Utils
77
88%default total
9+%language DSLNotation
910
1011||| A "function" that returns where it is called in the source
1112getLoc : {default tactics { sourceLocation } x : SourceLocation} -> SourceLocation
test/sourceLocation001/expected+8−8
@@ -1,19 +1,19 @@
1−SourceLoc.idr:11:19-26:
1+SourceLoc.idr:12:19-26:
22This style of tactic proof is deprecated. See %runElab for the replacement.
3−SourceLoc.idr:20:19-24:
3+SourceLoc.idr:21:19-24:
44This style of tactic proof is deprecated. See %runElab for the replacement.
5−SourceLoc.idr:40:20-27:
5+SourceLoc.idr:41:20-27:
66This style of tactic proof is deprecated. See %runElab for the replacement.
7−SourceLoc.idr:98:18-23:
7+SourceLoc.idr:99:18-23:
88This style of tactic proof is deprecated. See %runElab for the replacement.
99Testing using definition
10−FileLoc "SourceLoc.idr" (16, 11) (16, 17)
10+FileLoc "SourceLoc.idr" (17, 11) (17, 17)
1111Testing using inline tactics
12−FileLoc "SourceLoc.idr" (20, 17) (20, 17)
12+FileLoc "SourceLoc.idr" (21, 17) (21, 17)
1313Testing using metavariable with later definition
14−FileLoc "SourceLoc.idr" (98, 16) (98, 16)
14+FileLoc "SourceLoc.idr" (99, 16) (99, 16)
1515-----------------------
1616Success!
17−Error at FileLoc "SourceLoc.idr" (72, 23) (72, 26)
17+Error at FileLoc "SourceLoc.idr" (73, 23) (73, 26)
1818Success!
1919Success!
test/tactics001/Tactics.idr+1−1
@@ -4,7 +4,7 @@ import Language.Reflection.Elab
44
55import Data.Vect
66
7−
7+%language ElabReflection
88%default total
99
1010-- Test that basic proofs with new-style tactics work
test/unique001/unique001.idr+2
@@ -1,5 +1,7 @@
11module Main
22
3+%language UniquenessTypes
4+
35data UList : Type -> UniqueType where
46 Nil : UList a
57 (::) : a -> UList a -> UList a
test/unique004/expected+10−10
@@ -1,26 +1,26 @@
1−unique001a.idr:33:11:Type mismatch between
1+unique001a.idr:35:11:Type mismatch between
22 Int -> String
33and
44 UniqueType (Int -> String)
5−unique001a.idr:44:12:Type mismatch between
5+unique001a.idr:46:12:Type mismatch between
66 Int -> String
77and
88 UniqueType (Int -> String)
9−unique001a.idr:55:12:Type mismatch between
9+unique001a.idr:57:12:Type mismatch between
1010 UniqueType (Int -> String)
1111and
1212 Int -> String
13−unique001b.idr:16:7:Borrowed name xs must not be used on RHS
14−unique001c.idr:46:6:Unique name f is used more than once
15−unique001d.idr:3:7:Borrowed name x must not be used on RHS
16−unique001e.idr:3:10:
13+unique001b.idr:18:7:Borrowed name xs must not be used on RHS
14+unique001c.idr:47:6:Unique name f is used more than once
15+unique001d.idr:4:7:Borrowed name x must not be used on RHS
16+unique001e.idr:4:10:
1717Constructor Main.Nil has a UniqueType, but the data type does not
18−unique002.idr:15:5:Unique name xs is used more than once
19−unique002a.idr:15:5:Type mismatch between
18+unique002.idr:17:5:Unique name xs is used more than once
19+unique002a.idr:17:5:Type mismatch between
2020 Int -> String
2121and
2222 UniqueType (Int -> String)
23−unique003.idr:18:5:Type mismatch between
23+unique003.idr:20:5:Type mismatch between
2424 Int -> String
2525and
2626 UniqueType (Int -> String)
test/unique004/unique001a.idr+2
@@ -1,5 +1,7 @@
11module Main
22
3+%language UniquenessTypes
4+
35data UList : Type -> UniqueType where
46 Nil : UList a
57 (::) : a -> UList a -> UList a
test/unique004/unique001b.idr+2
@@ -1,5 +1,7 @@
11module Main
22
3+%language UniquenessTypes
4+
35data UList : Type -> UniqueType where
46 Nil : UList a
57 (::) : a -> UList a -> UList a
test/unique004/unique001c.idr+1
@@ -1,3 +1,4 @@
1+%language UniquenessTypes
12
23data UList : Type -> UniqueType where
34 UNil : UList a
test/unique004/unique001d.idr+1
@@ -1,3 +1,4 @@
1+%language UniquenessTypes
12
23steal : {a : UniqueType} -> Borrowed a -> a
34steal (Read x) = x
test/unique004/unique001e.idr+1
@@ -1,3 +1,4 @@
1+%language UniquenessTypes
12
23data BadList : UniqueType -> Type where
34 Nil : {a : UniqueType} -> BadList a
test/unique004/unique002.idr+2
@@ -1,3 +1,5 @@
1+%language UniquenessTypes
2+
13data UList : Type -> UniqueType where
24 Nil : UList a
35 (::) : a -> UList a -> UList a
test/unique004/unique002a.idr+2
@@ -1,3 +1,5 @@
1+%language UniquenessTypes
2+
13data UList : Type -> UniqueType where
24 Nil : UList a
35 (::) : a -> UList a -> UList a
test/unique004/unique003.idr+2
@@ -1,5 +1,7 @@
11module Main
22
3+%language UniquenessTypes
4+
35data UList : Type -> UniqueType where
46 Nil : UList a
57 (::) : a -> UList a -> UList a