ajhc 0.8.0.9 → 0.8.0.10
raw patch · 37 files changed
+562/−428 lines, 37 filesdep −derive
Dependencies removed: derive
Files
- COPYING +3/−0
- README.md +10/−29
- ajhc.cabal +2/−4
- lib/LICENSE +19/−0
- lib/jhc/Jhc/ForeignPtr.hs +7/−0
- library_deps.make +1/−1
- src/C/FFI.hs +2/−5
- src/C/FromGrin2.hs +10/−7
- src/C/Prims.hs +6/−9
- src/Cmm/Op.hs +10/−13
- src/DataConstructors.hs +5/−8
- src/E/CPR.hs +2/−5
- src/E/Demand.hs +6/−9
- src/E/SSimplify.hs +2/−5
- src/E/Type.hs +5/−13
- src/FlagDump.hs +94/−94
- src/FlagOpts.hs +47/−47
- src/FrontEnd/Class.hs +4/−7
- src/FrontEnd/HsSyn.hs +14/−23
- src/FrontEnd/KindInfer.hs +2/−5
- src/FrontEnd/Representation.hs +8/−10
- src/FrontEnd/SrcLoc.hs +4/−10
- src/FrontEnd/Tc/Kind.hs +3/−6
- src/FrontEnd/Tc/Monad.hs +2/−5
- src/Grin/Devolve.hs +9/−1
- src/Grin/SSimplify.hs +3/−6
- src/Ho/ReadSource.hs +3/−3
- src/Ho/Type.hs +5/−10
- src/Name/VConsts.hs +3/−7
- src/Options.hs +5/−50
- src/RawFiles.hs +257/−23
- src/StringTable/Atom.hsc +2/−1
- src/StringTable/StringTable_cbits.h +1/−1
- src/Util/FilterInput.hs +1/−6
- src/Util/Gen.hs +3/−3
- src/Version/Config.hs +1/−1
- src/data/targets.ini +1/−1
COPYING view
@@ -2,6 +2,9 @@ file for copyright and warranty information. This file should be included whenever those files are redistributed. +LICENSE files in subdirectories override this license when it comes to+redistributing parts of jhc.+ This software is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License, version 2, as published by the Free Software Foundation or any later version at your option.
README.md view
@@ -12,12 +12,13 @@ ## How to install - $ sudo apt-get install haskell-platform libncurses5-dev gcc m4+ $ sudo apt-get install haskell-platform libncurses5-dev gcc m4 patch+ $ cabal install drift $ cabal install ajhc ## How to build latest version - $ sudo apt-get install make locales autoconf haskell-derive-utils \+ $ sudo apt-get install make locales autoconf drift \ libconfig-yaml-perl graphviz haskell-platform cpphs pandoc hscolour po4a \ libghc-temporary-dev libghc-haskeline-dev libghc-utf8-string-dev libghc-hssyck-dev \ libghc-test-framework-th-dev libghc-test-framework-hunit-dev \@@ -52,35 +53,9 @@  -## Needing to install/build on Windows (experimental)--### Install msys--http://sourceforge.net/projects/mingw/files/Installer/mingw-get-inst/--Install below.--* C Compiler-* MSYS Basic System-* MinGW Developer ToolKit--You should run cabal install on msys console.--### Install Git for Windows--http://msysgit.github.com/--It's good choosing the below option.--* "Checkout as-is, commit as-is"-* "Run Git and included Unix tools from the Windows Command Prompt"--### Install Haskell Platform--http://www.haskell.org/platform/windows.html- ## Future plan +* Benchmark (speed, memory size, compare with eLua/mruby/.NET Micro Framework) * No more depend on Perl (LWP and YAML). * Port Haskell libraries on haskell-platform to Ajhc. * Understand jhc's region inference.@@ -88,3 +63,9 @@ * Write Linux kernel driver with Haskell. * Get smaller RTS. Benchmark the RTS for running on custom FPGA CPU. * Start rewritng NetBSD kernel with Ajhc.++## License++* Runtime: [MIT License](https://github.com/ajhc/ajhc/blob/master/rts/LICENSE)+* Haskell libraries: [MIT License](https://github.com/ajhc/ajhc/blob/master/lib/LICENSE)+* The others: [GPLv2 or Later](https://github.com/ajhc/ajhc/blob/arafura/COPYING)
ajhc.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.10 name: ajhc build-type: Custom-version: 0.8.0.9+version: 0.8.0.10 license: GPL-2 license-file: COPYING category: Compiler@@ -30,7 +30,7 @@ examples/*.hs rts/HsFFI.h Makefile.cabalinst library_deps.make src/data/targets.ini src/StringTable/StringTable_cbits.h src/cbits/config.h src/hs_src_config.h src/data/Typeable.h utils/build_extlibs.prl- lib/haskell-extras/Data/Bits.hs lib/haskell-extras/Data/Maybe.hs lib/haskell-extras/Data/Bits.m4 lib/haskell-extras/Data/IORef.hs lib/haskell-extras/Data/Monoid.hs lib/haskell-extras/Data/Int.hs lib/haskell-extras/Data/Typeable.hs lib/haskell-extras/Data/Functor.hs lib/haskell-extras/Data/Char.hs lib/haskell-extras/Data/Array/Unboxed.hs lib/haskell-extras/Data/Array/IO.hs lib/haskell-extras/Data/Complex.hs lib/haskell-extras/Data/Array.hs lib/haskell-extras/Data/Version.hs lib/haskell-extras/Data/Function.hs lib/haskell-extras/Data/List.hs lib/haskell-extras/Data/Unique.hs lib/haskell-extras/Data/Ix.hs lib/haskell-extras/Data/Dynamic.hs lib/haskell-extras/Data/Unicode.hs lib/haskell-extras/Data/Word.hs lib/haskell-extras/Prelude.hs lib/haskell-extras/haskell-extras.yaml.m4 lib/haskell-extras/Unsafe/Coerce.hs lib/haskell-extras/Foreign.hs lib/haskell-extras/Typeable.hs lib/haskell-extras/Debug/Trace.hs lib/haskell-extras/System/IO/Pipe.hs lib/haskell-extras/System/IO/Binary.hs lib/haskell-extras/System/IO/Error.hs lib/haskell-extras/System/IO/Continuation.hs lib/haskell-extras/System/Random.hs lib/haskell-extras/System/Exit.hs lib/haskell-extras/System/Console/GetOpt.hs lib/haskell-extras/System/Time.hs lib/haskell-extras/System/Directory.hs lib/haskell-extras/System/CPUTime.hs lib/haskell-extras/System/Cmd.hs lib/haskell-extras/System/Environment.hs lib/haskell-extras/System/Info.hs lib/haskell-extras/System/IO.hs lib/haskell-extras/System/Locale.hs lib/haskell-extras/Text/Show/Functions.hs lib/haskell-extras/Text/Printf.hs lib/haskell-extras/Control/Monad/Fix.hs lib/haskell-extras/Control/Monad/Instances.hs lib/haskell-extras/Control/Concurrent.hs lib/haskell-extras/Control/Exception.hs lib/haskell-extras/Control/Monad.hs lib/haskell-extras/Foreign/C.hs lib/haskell-extras/Foreign/ForeignPtr.hs lib/haskell-extras/Foreign/StablePtr.hs lib/haskell-extras/Foreign/Marshal/Pool.hs lib/haskell-extras/Foreign/Marshal/Error.hs lib/haskell-extras/Foreign/Marshal.hs lib/haskell98/Maybe.hs lib/haskell98/Random.hs lib/haskell98/Time.hs lib/haskell98/prologue.txt lib/haskell98/System.hs lib/haskell98/Ratio.hs lib/haskell98/Directory.hs lib/haskell98/CPUTime.hs lib/haskell98/haskell98.yaml lib/haskell98/Char.hs lib/haskell98/Complex.hs lib/haskell98/Array.hs lib/haskell98/List.hs lib/haskell98/IO.hs lib/haskell98/Ix.hs lib/haskell98/Monad.hs lib/haskell98/Locale.hs lib/haskell98/LICENSE lib/flat-foreign/Bits.hs lib/flat-foreign/Ptr.hs lib/flat-foreign/MarshalAlloc.hs lib/flat-foreign/MarshalError.hs lib/flat-foreign/Storable.hs lib/flat-foreign/CForeign.hs lib/flat-foreign/ForeignPtr.hs lib/flat-foreign/Int.hs lib/flat-foreign/StablePtr.hs lib/flat-foreign/MarshalArray.hs lib/flat-foreign/flat-foreign.yaml lib/flat-foreign/MarshalUtils.hs lib/flat-foreign/CTypes.hs lib/flat-foreign/Word.hs lib/flat-foreign/CError.hs lib/flat-foreign/CString.hs lib/applicative/Data/Foldable.hs lib/applicative/Data/Traversable.hs lib/applicative/Control/Applicative.hs lib/applicative/Control/Arrow.hs lib/applicative/Control/Category.hs lib/applicative/applicative.yaml lib/jhc/Numeric.hs lib/jhc/Data/Ratio.hs lib/jhc/Jhc/Order.hs lib/jhc/Jhc/Numeric.hs lib/jhc/Jhc/Maybe.hs lib/jhc/Jhc/Inst/Order.hs lib/jhc/Jhc/Inst/Storable.hs lib/jhc/Jhc/Inst/Show.hs lib/jhc/Jhc/Inst/PrimEnum.hs lib/jhc/Jhc/Inst/Enum.hs lib/jhc/Jhc/Inst/Num.hs lib/jhc/Jhc/Inst/Read.hs lib/jhc/Jhc/Enum.m4 lib/jhc/Jhc/Hole.hs lib/jhc/Jhc/String.hs lib/jhc/Jhc/Prim.hs lib/jhc/Jhc/Options.hs lib/jhc/Jhc/Show.hs lib/jhc/Jhc/Handle.hs lib/jhc/Jhc/ForeignPtr.hs lib/jhc/Jhc/Type/C.hs lib/jhc/Jhc/Type/Ptr.hs lib/jhc/Jhc/Type/Basic.hs lib/jhc/Jhc/Type/Handle.hs lib/jhc/Jhc/Type/Float.hs lib/jhc/Jhc/Type/Word.hs lib/jhc/Jhc/ACIO.hs lib/jhc/Jhc/JumpPoint.hs lib/jhc/Jhc/Int.hs lib/jhc/Jhc/Class/Real.hs lib/jhc/Jhc/Class/Ord.hs lib/jhc/Jhc/Class/Num.hs lib/jhc/Jhc/Float.hs lib/jhc/Jhc/Text/Read.hs lib/jhc/Jhc/Num.m4 lib/jhc/Jhc/List.hs lib/jhc/Jhc/Enum.hs lib/jhc/Jhc/IO.hs lib/jhc/Jhc/Order.m4 lib/jhc/Jhc/Monad.hs lib/jhc/Jhc/Addr.hs lib/jhc/Jhc/Basics.hs lib/jhc/Jhc/Num.hs lib/jhc/Jhc/Tuples.hs lib/jhc/System/IO/Unsafe.hs lib/jhc/System/Mem/StableName.hs lib/jhc/System/C/Stdio.hs lib/jhc/System/Mem.hs lib/jhc/Prelude/CType.hs lib/jhc/Prelude/Text.hs lib/jhc/Prelude/Float.hs lib/jhc/Prelude/IO.hs lib/jhc/Foreign/Ptr.hs lib/jhc/Foreign/Storable.hs lib/jhc/Foreign/C/String.hs lib/jhc/Foreign/C/Types.hs lib/jhc/Foreign/C/Error.hs lib/jhc/Foreign/Storable.m4 lib/jhc/Foreign/Marshal/Alloc.hs lib/jhc/Foreign/Marshal/Utils.hs lib/jhc/Foreign/Marshal/Array.hs lib/jhc/jhc.yaml lib/jhc-prim/jhc-prim.yaml lib/jhc-prim/Jhc/Prim/Bits.hs lib/jhc-prim/Jhc/Prim/Prim.hs lib/jhc-prim/Jhc/Prim/Rts.hs lib/jhc-prim/Jhc/Prim/Array.hs lib/jhc-prim/Jhc/Prim/IO.hs lib/jhc-prim/Jhc/Prim/Wrapper.hs lib/haskell2010/haskell2010.yaml.m4 lib/ext/bytestring.patch lib/ext/smallcheck.cabal lib/ext/parsec.cabal lib/ext/containers.cabal lib/ext/utility-ht.cabal lib/ext/html.cabal lib/ext/filepath.cabal lib/ext/bytestring.yaml lib/ext/pretty.cabal lib/ext/HUnit.cabal lib/ext/transformers.cabal lib/ext/deepseq.cabal lib/ext/xhtml.cabal lib/ext/Diff.cabal lib/ext/containers.patch lib/ext/QuickCheck.cabal lib/ext/safe.cabal + lib/haskell-extras/Data/Bits.hs lib/haskell-extras/Data/Maybe.hs lib/haskell-extras/Data/Bits.m4 lib/haskell-extras/Data/IORef.hs lib/haskell-extras/Data/Monoid.hs lib/haskell-extras/Data/Int.hs lib/haskell-extras/Data/Typeable.hs lib/haskell-extras/Data/Functor.hs lib/haskell-extras/Data/Char.hs lib/haskell-extras/Data/Array/Unboxed.hs lib/haskell-extras/Data/Array/IO.hs lib/haskell-extras/Data/Complex.hs lib/haskell-extras/Data/Array.hs lib/haskell-extras/Data/Version.hs lib/haskell-extras/Data/Function.hs lib/haskell-extras/Data/List.hs lib/haskell-extras/Data/Unique.hs lib/haskell-extras/Data/Ix.hs lib/haskell-extras/Data/Dynamic.hs lib/haskell-extras/Data/Unicode.hs lib/haskell-extras/Data/Word.hs lib/haskell-extras/Prelude.hs lib/haskell-extras/haskell-extras.yaml.m4 lib/haskell-extras/Unsafe/Coerce.hs lib/haskell-extras/Foreign.hs lib/haskell-extras/Typeable.hs lib/haskell-extras/Debug/Trace.hs lib/haskell-extras/System/IO/Pipe.hs lib/haskell-extras/System/IO/Binary.hs lib/haskell-extras/System/IO/Error.hs lib/haskell-extras/System/IO/Continuation.hs lib/haskell-extras/System/Random.hs lib/haskell-extras/System/Exit.hs lib/haskell-extras/System/Console/GetOpt.hs lib/haskell-extras/System/Time.hs lib/haskell-extras/System/Directory.hs lib/haskell-extras/System/CPUTime.hs lib/haskell-extras/System/Cmd.hs lib/haskell-extras/System/Environment.hs lib/haskell-extras/System/Info.hs lib/haskell-extras/System/IO.hs lib/haskell-extras/System/Locale.hs lib/haskell-extras/Text/Show/Functions.hs lib/haskell-extras/Text/Printf.hs lib/haskell-extras/Control/Monad/Fix.hs lib/haskell-extras/Control/Monad/Instances.hs lib/haskell-extras/Control/Concurrent.hs lib/haskell-extras/Control/Exception.hs lib/haskell-extras/Control/Monad.hs lib/haskell-extras/Foreign/C.hs lib/haskell-extras/Foreign/ForeignPtr.hs lib/haskell-extras/Foreign/StablePtr.hs lib/haskell-extras/Foreign/Marshal/Pool.hs lib/haskell-extras/Foreign/Marshal/Error.hs lib/haskell-extras/Foreign/Marshal.hs lib/haskell98/Maybe.hs lib/haskell98/Random.hs lib/haskell98/Time.hs lib/haskell98/prologue.txt lib/haskell98/System.hs lib/haskell98/Ratio.hs lib/haskell98/Directory.hs lib/haskell98/CPUTime.hs lib/haskell98/haskell98.yaml lib/haskell98/Char.hs lib/haskell98/Complex.hs lib/haskell98/Array.hs lib/haskell98/List.hs lib/haskell98/IO.hs lib/haskell98/Ix.hs lib/haskell98/Monad.hs lib/haskell98/Locale.hs lib/haskell98/LICENSE lib/flat-foreign/Bits.hs lib/flat-foreign/Ptr.hs lib/flat-foreign/MarshalAlloc.hs lib/flat-foreign/MarshalError.hs lib/flat-foreign/Storable.hs lib/flat-foreign/CForeign.hs lib/flat-foreign/ForeignPtr.hs lib/flat-foreign/Int.hs lib/flat-foreign/StablePtr.hs lib/flat-foreign/MarshalArray.hs lib/flat-foreign/flat-foreign.yaml lib/flat-foreign/MarshalUtils.hs lib/flat-foreign/CTypes.hs lib/flat-foreign/Word.hs lib/flat-foreign/CError.hs lib/flat-foreign/CString.hs lib/applicative/Data/Foldable.hs lib/applicative/Data/Traversable.hs lib/applicative/Control/Applicative.hs lib/applicative/Control/Arrow.hs lib/applicative/Control/Category.hs lib/applicative/applicative.yaml lib/jhc/Numeric.hs lib/jhc/Data/Ratio.hs lib/jhc/Jhc/Order.hs lib/jhc/Jhc/Numeric.hs lib/jhc/Jhc/Maybe.hs lib/jhc/Jhc/Inst/Order.hs lib/jhc/Jhc/Inst/Storable.hs lib/jhc/Jhc/Inst/Show.hs lib/jhc/Jhc/Inst/PrimEnum.hs lib/jhc/Jhc/Inst/Enum.hs lib/jhc/Jhc/Inst/Num.hs lib/jhc/Jhc/Inst/Read.hs lib/jhc/Jhc/Enum.m4 lib/jhc/Jhc/Hole.hs lib/jhc/Jhc/String.hs lib/jhc/Jhc/Prim.hs lib/jhc/Jhc/Options.hs lib/jhc/Jhc/Show.hs lib/jhc/Jhc/Handle.hs lib/jhc/Jhc/ForeignPtr.hs lib/jhc/Jhc/Type/C.hs lib/jhc/Jhc/Type/Ptr.hs lib/jhc/Jhc/Type/Basic.hs lib/jhc/Jhc/Type/Handle.hs lib/jhc/Jhc/Type/Float.hs lib/jhc/Jhc/Type/Word.hs lib/jhc/Jhc/ACIO.hs lib/jhc/Jhc/JumpPoint.hs lib/jhc/Jhc/Int.hs lib/jhc/Jhc/Class/Real.hs lib/jhc/Jhc/Class/Ord.hs lib/jhc/Jhc/Class/Num.hs lib/jhc/Jhc/Float.hs lib/jhc/Jhc/Text/Read.hs lib/jhc/Jhc/Num.m4 lib/jhc/Jhc/List.hs lib/jhc/Jhc/Enum.hs lib/jhc/Jhc/IO.hs lib/jhc/Jhc/Order.m4 lib/jhc/Jhc/Monad.hs lib/jhc/Jhc/Addr.hs lib/jhc/Jhc/Basics.hs lib/jhc/Jhc/Num.hs lib/jhc/Jhc/Tuples.hs lib/jhc/System/IO/Unsafe.hs lib/jhc/System/Mem/StableName.hs lib/jhc/System/C/Stdio.hs lib/jhc/System/Mem.hs lib/jhc/Prelude/CType.hs lib/jhc/Prelude/Text.hs lib/jhc/Prelude/Float.hs lib/jhc/Prelude/IO.hs lib/jhc/Foreign/Ptr.hs lib/jhc/Foreign/Storable.hs lib/jhc/Foreign/C/String.hs lib/jhc/Foreign/C/Types.hs lib/jhc/Foreign/C/Error.hs lib/jhc/Foreign/Storable.m4 lib/jhc/Foreign/Marshal/Alloc.hs lib/jhc/Foreign/Marshal/Utils.hs lib/jhc/Foreign/Marshal/Array.hs lib/jhc/jhc.yaml lib/jhc-prim/jhc-prim.yaml lib/jhc-prim/Jhc/Prim/Bits.hs lib/jhc-prim/Jhc/Prim/Prim.hs lib/jhc-prim/Jhc/Prim/Rts.hs lib/jhc-prim/Jhc/Prim/Array.hs lib/jhc-prim/Jhc/Prim/IO.hs lib/jhc-prim/Jhc/Prim/Wrapper.hs lib/haskell2010/haskell2010.yaml.m4 lib/ext/bytestring.patch lib/ext/smallcheck.cabal lib/ext/parsec.cabal lib/ext/containers.cabal lib/ext/utility-ht.cabal lib/ext/html.cabal lib/ext/filepath.cabal lib/ext/bytestring.yaml lib/ext/pretty.cabal lib/ext/HUnit.cabal lib/ext/transformers.cabal lib/ext/deepseq.cabal lib/ext/xhtml.cabal lib/ext/Diff.cabal lib/ext/containers.patch lib/ext/QuickCheck.cabal lib/ext/safe.cabal lib/LICENSE source-repository head type: git@@ -56,7 +56,6 @@ bytestring, containers, cpphs,- derive, directory, fgl, filepath,@@ -285,7 +284,6 @@ binary, bytestring, containers,- derive, directory, fgl, filepath,
+ lib/LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2013 John Meacham++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
lib/jhc/Jhc/ForeignPtr.hs view
@@ -15,6 +15,7 @@ import Jhc.Prim.Rts import Jhc.Type.Basic import Jhc.Basics+import Jhc.Order type FinalizerPtr a = FunPtr (Ptr a -> IO ()) @@ -22,6 +23,12 @@ -- location. The actual ForeignPtr heap location may contain more than the -- single BitsPtr_ argument. data ForeignPtr a = FP BitsPtr_++instance Eq (ForeignPtr a) where+ p == q = unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q++instance Ord (ForeignPtr a) where+ compare p q = compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q) -- | This function creates a plain ForeignPtr from a Ptr, a plain foreignptr -- may not have finalizers associated with it, hence this function may be pure.
library_deps.make view
@@ -76,4 +76,4 @@ $(BUILD_EXTLIBS) $< JHC_EXT_LIBS = containers-0.3.0.0.hl Diff-0.2.0.hl html-1.0.1.2.hl HUnit-1.2.5.1.hl parsec-2.1.0.1.hl \ pretty-1.0.1.2.hl QuickCheck-1.2.0.1.hl safe-0.3.3.hl smallcheck-0.6.1.hl xhtml-3000.2.1.hl \- transformers-0.2.1.0.hl filepath-1.3.0.1.hl deepseq-1.2.0.1.hl+ transformers-0.2.1.0.hl filepath-1.3.0.1.hl deepseq-1.2.0.1.hl bytestring-0.9.2.0.hl
src/C/FFI.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module C.FFI( CallConv(..), Safety(..),@@ -31,7 +31,4 @@ ffiExportRetType :: ExtType } deriving(Eq,Ord,Show,Typeable)--{-!-deriving instance Binary FfiExport-!-}+ {-! derive: Binary !-}
src/C/FromGrin2.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings, RecordWildCards, ViewPatterns #-}-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module C.FromGrin2(compileGrin) where import Control.Monad.Identity@@ -42,7 +42,7 @@ -- C Monad --------------- -data Todo = TodoReturn | TodoExp [Expression] | TodoDecl Name Type | TodoNothing+data Todo = TodoReturn | TodoReturnVoid | TodoExp [Expression] | TodoDecl Name Type | TodoNothing data Written = Written { wRequires :: Requires,@@ -52,6 +52,7 @@ wEnums :: Map.Map Name Int, wFunctions :: Map.Map Name Function }+ {-! derive: Monoid !-} -- special type representations when possible data TyRep@@ -194,7 +195,6 @@ convertFunc :: Maybe FfiExport -> (Atom,Lam) -> C [Function] convertFunc ffie (n,as :-> body) = do- s <- localTodo TodoReturn (convertBody body) let bt = getType body mmalloc [TyINode] = [a_MALLOC] mmalloc [TyNode] = [a_MALLOC]@@ -203,6 +203,8 @@ fnname = nodeFuncName n fr <- convertTypes bt+ s <- localTodo (if fr == voidType then TodoReturnVoid else TodoReturn) (convertBody body)+ as' <- flip mapM (zip [1 :: Int .. ] as) $ \ (ix,(Var v t)) -> do t' <- convertType t return $ if v == v0 then (name $ 'u':show ix,t') else (varName v,t')@@ -359,6 +361,7 @@ todo <- asks rTodo case todo of TodoReturn -> return (ss & mconcat rs);+ TodoReturnVoid -> return (ss & mconcat rs); _ -> return (ss & goto done & mconcat (intersperse (goto done) rs) & label done); convertBody (e :>>= [] :-> e') = do ss <- localTodo TodoNothing (convertBody e)@@ -460,6 +463,9 @@ TodoReturn -> do v <- g t return (jerr & creturn v)+ TodoReturnVoid -> do+ v <- g t+ return (jerr & v & creturn emptyExpression) convertBody (BaseOp (StoreNode b) [n@NodeC {}]) = newNode region_heap (bool b wptr_t sptr_t) n >>= \(x,y) -> simpleRet y >>= \v -> return (x & v) convertBody (BaseOp (StoreNode b) [n@NodeC {},region]) = newNode region (bool b wptr_t sptr_t) n >>= \(x,y) -> simpleRet y >>= \v -> return (x & v)@@ -540,6 +546,7 @@ x <- asks rTodo case x of TodoReturn -> return (creturn er)+ TodoReturnVoid -> return (er & creturn emptyExpression) _ | isEmptyExpression er -> return mempty TodoNothing -> return (toStatement er) TodoExp [v] -> return (v =* er)@@ -1022,7 +1029,3 @@ basicType' :: ExtType -> Type basicType' b = basicType (show b)--{-!-deriving instance Monoid Written-!-}
src/C/Prims.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module C.Prims where import Data.Binary@@ -17,8 +17,10 @@ data CallConv = CCall | StdCall | CApi | Primitive | DotNet deriving(Eq,Ord,Show)+ {-! derive: Binary !-} data Safety = Safe | Unsafe | JhcContext deriving(Eq,Ord,Show)+ {-! derive: Binary !-} newtype ExtType = ExtType PackedString deriving(Binary,IsString,Eq,Ord)@@ -34,6 +36,7 @@ data DotNetPrim = DotNetField | DotNetCtor | DotNetMethod deriving(Typeable, Eq, Ord, Show)+ {-! derive: Binary !-} primReqs p = f p where f CConst {} = primRequires p@@ -85,9 +88,11 @@ primRetTy :: Op.Ty } deriving(Typeable, Eq, Ord, Show)+ {-! derive: Binary !-} data PrimTypeInfo = PrimSizeOf | PrimMaxBound | PrimMinBound | PrimAlignmentOf | PrimUMaxBound deriving(Typeable, Eq, Ord, Show)+ {-! derive: Binary !-} primStaticTypeInfo :: Op.Ty -> PrimTypeInfo -> Maybe Integer primStaticTypeInfo (Op.TyBits (Op.Bits b) _) w = Just ans where@@ -176,11 +181,3 @@ g dn ['[':rs] | (as,']':nm) <- span (/= ']') rs = return dn { primAssembly = packString as, primDotNetName = packString nm } g dn [n] = return dn { primDotNetName = packString n } g _ _ = fail "invalid .NET ffi specification"--{-!-deriving instance Binary CallConv-deriving instance Binary Safety-deriving instance Binary DotNetPrim-deriving instance Binary Prim-deriving instance Binary PrimTypeInfo-!-}
src/Cmm/Op.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS -funbox-strict-fields #-}-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module Cmm.Op where import Data.Binary@@ -93,6 +93,7 @@ -- whether two values can be compared at all. | FOrdered deriving(Eq,Show,Ord,Read,Enum,Bounded)+ {-! derive: Binary !-} data UnOp = Neg -- ^ 2s compliment negation@@ -121,6 +122,7 @@ | Popcount -- ^ number of bits set to 1 in word | Parity -- ^ number of bits set to 1 mod 2 deriving(Eq,Show,Ord,Read,Enum,Bounded)+ {-! derive: Binary !-} -- conversion ops @@ -137,6 +139,7 @@ | U2U -- ^ perform a 'Lobits' or a 'Zx' depending on the sizes of the arguments | B2B -- ^ a nop, useful for coercing hints (bits 2 bits) deriving(Eq,Show,Ord,Read,Enum,Bounded)+ {-! derive: Binary !-} data ValOp = NaN@@ -145,12 +148,15 @@ | PZero | NZero deriving(Eq,Show,Ord,Read,Bounded)+ {-! derive: Binary !-} data ArchBits = BitsMax | BitsPtr | BitsUnknown deriving(Eq,Ord)+ {-! derive: Binary !-} data TyBits = Bits {-# UNPACK #-} !Int | BitsArch !ArchBits | BitsExt String deriving(Eq,Ord)+ {-! derive: Binary !-} data TyHint = HintSigned@@ -159,6 +165,7 @@ | HintCharacter -- a unicode character, implies unsigned | HintNone -- no hint deriving(Eq,Ord)+ {-! derive: Binary !-} data Ty = TyBits !TyBits !TyHint@@ -166,6 +173,7 @@ | TyComplex Ty | TyVector !Int Ty deriving(Eq,Ord)+ {-! derive: Binary !-} --runReadP :: ReadP a -> String -> Maybe a --runReadP rp s = case readP_to_S rp s of@@ -249,6 +257,7 @@ | ValOp ValOp | ConvOp ConvOp v deriving(Eq,Show,Ord)+ {-! derive: Binary !-} binopType :: BinOp -> Ty -> Ty -> Ty binopType Mulx (TyBits (Bits i) h) _ = TyBits (Bits (i*2)) h@@ -398,15 +407,3 @@ isEagerSafe (UnOp o _) = isEagerSafe o isEagerSafe (ConvOp o _) = isEagerSafe o isEagerSafe _ = False--{-!-deriving instance Binary BinOp-deriving instance Binary UnOp-deriving instance Binary ConvOp-deriving instance Binary ValOp-deriving instance Binary ArchBits-deriving instance Binary TyBits-deriving instance Binary TyHint-deriving instance Binary Ty-deriving instance Binary Op-!-}
src/DataConstructors.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module DataConstructors( AliasType(..), boxPrimitive,@@ -122,6 +122,7 @@ data AliasType = ErasedAlias | RecursiveAlias deriving(Eq,Ord,Show)+ {-! derive: Binary !-} -- these apply to types data DataFamily =@@ -132,6 +133,7 @@ | DataNormal [Name] -- child constructors | DataAlias !AliasType deriving(Eq,Ord,Show)+ {-! derive: Binary !-} -- | Record describing a data type. -- * is also a data type containing the type constructors, which are unlifted, yet boxed.@@ -146,12 +148,14 @@ conChildren :: DataFamily, conCTYPE :: Maybe ExtType -- external type } deriving(Show)+ {-! derive: Binary !-} data Slot = SlotNormal E | SlotUnpacked E !Name [E] | SlotExistential TVr deriving(Eq,Ord,Show)+ {-! derive: Binary !-} mapESlot f (SlotExistential t) = SlotExistential t { tvrType = f (tvrType t) } mapESlot f (SlotNormal e) = SlotNormal $ f e@@ -919,10 +923,3 @@ (rt_float80, "long double"), (rt_float128, "__float128") ]--{-!-deriving instance Binary AliasType-deriving instance Binary DataFamily-deriving instance Binary Constructor-deriving instance Binary Slot-!-}
src/E/CPR.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module E.CPR(Val(..), cprAnalyzeDs, cprAnalyzeProgram) where import Control.Monad.Writer(runWriter,tell,Monoid(..))@@ -32,6 +32,7 @@ | Tag [Name] -- A nullary constructor, like True, False | Bot -- the bottom deriving(Eq,Ord,Typeable)+ {-! derive: Binary !-} trimVal v = f (0::Int) v where f !n Tup {} | n > 5 = Top@@ -136,7 +137,3 @@ f (EError {}) = Bot f e = error $ "cprAnalyze'.f: " ++ show e g = snd . cprAnalyze' env--{-!-deriving instance Binary Val-!-}
src/E/Demand.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module E.Demand( Demand(..), DemandSignature(..),@@ -37,18 +37,23 @@ | Error !SubDemand -- diverges, might use arguments | Absent -- Not used deriving(Eq,Ord,Typeable)+ {-! derive: Binary !-} data SubDemand = None | Product ![Demand] deriving(Eq,Ord)+ {-! derive: Binary !-} data DemandEnv = DemandEnv !(IdMap Demand) !Demand deriving(Eq,Ord)+ {-! derive: Binary !-} data DemandType = (:=>) !DemandEnv ![Demand] deriving(Eq,Ord)+ {-! derive: Binary !-} data DemandSignature = DemandSignature {-# UNPACK #-} !Int !DemandType deriving(Eq,Ord,Typeable)+ {-! derive: Binary !-} idGlb = Absent @@ -401,11 +406,3 @@ instance Show DemandSignature where showsPrec _ (DemandSignature n dt) = showString "<" . shows n . showString "," . shows dt . showString ">"--{-!-deriving instance Binary Demand-deriving instance Binary SubDemand-deriving instance Binary DemandEnv-deriving instance Binary DemandType-deriving instance Binary DemandSignature-!-}
src/E/SSimplify.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module E.SSimplify( Occurance(..), cacheSimpOpts,@@ -370,6 +370,7 @@ envInScope :: IdMap Binding, envInScopeCache :: IdMap E }+ {-! derive: Monoid !-} envSubst_u f r@Env{envSubst = x} = r{envSubst = f x} envSubst_s v = envSubst_u (const v)@@ -1080,7 +1081,3 @@ do modifyIds (\ (used,bound) -> (nset `union` used, nset `union` bound) ) --smAddBoundNamesIdMap = smAddNamesIdSet . idMapToIdSet--{-!-deriving instance Monoid Env-!-}
src/E/Type.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} -- | The definitions related to jhc core module E.Type where@@ -111,6 +111,7 @@ data Lit e t = LitInt { litNumber :: Number, litType :: t } | LitCons { litName :: Name, litArgs :: [e], litType :: t, litAliasFor :: Maybe E } deriving(Eq,Ord,Functor,Foldable,Traversable)+ {-!derive: is !-} -------------------------------------- -- Lambda Cube (it's just fun to say.)@@ -129,6 +130,7 @@ | EStarStar -- ^ the supersort of boxed types | ESortNamed Name -- ^ user defined sorts deriving(Eq, Ord)+ {-! derive: is !-} data E = EAp E E | ELam TVr E@@ -149,6 +151,7 @@ eCaseAllFV :: IdSet } deriving(Eq, Ord)+ {-! derive: is, from !-} --instance Functor (Lit e) where -- fmap f x = runIdentity $ fmapM (return . f) x@@ -180,11 +183,7 @@ type TVr = TVr' E data TVr' e = TVr { tvrIdent :: !Id, tvrType :: e, tvrInfo :: Info.Info } deriving(Functor,Foldable,Traversable)--tvrInfo_u f r@TVr{tvrInfo = x} = r{tvrInfo = f x}-tvrType_u f r@TVr{tvrType = x} = r{tvrType = f x}-tvrInfo_s v = tvrInfo_u (const v)-tvrType_s v = tvrType_u (const v)+ {-!derive: update !-} data Alt e = Alt (Lit TVr e) e deriving(Eq,Ord)@@ -256,10 +255,3 @@ tvr = TVr { tvrIdent = emptyId, tvrType = Unknown, tvrInfo = Info.empty } -- Imported from other files :---{-!-deriving instance Is Lit-deriving instance Is ESort-deriving instance Is E-deriving instance From E-!-}
src/FlagDump.hs view
@@ -120,120 +120,120 @@ show Progress = "progress" show Stats = "stats" -one "kind" = Right $ Set.insert Kind-one "no-kind" = Right $ Set.delete Kind-one "types" = Right $ Set.insert Types-one "no-types" = Right $ Set.delete Types-one "grin" = Right $ Set.insert Grin-one "no-grin" = Right $ Set.delete Grin+one "steps" = Right $ Set.insert Steps+one "no-steps" = Right $ Set.delete Steps+one "boxy-steps" = Right $ Set.insert BoxySteps+one "no-boxy-steps" = Right $ Set.delete BoxySteps+one "progress" = Right $ Set.insert Progress+one "no-progress" = Right $ Set.delete Progress+one "veryverbose" = Right $ foldr (.) id [ f | Right f <- [ one "progress",one "stats"]] one "program" = Right $ Set.insert Program one "no-program" = Right $ Set.delete Program-one "all-types" = Right $ Set.insert AllTypes-one "no-all-types" = Right $ Set.delete AllTypes-one "scc-modules" = Right $ Set.insert SccModules-one "no-scc-modules" = Right $ Set.delete SccModules-one "core-mini" = Right $ Set.insert CoreMini-one "no-core-mini" = Right $ Set.delete CoreMini-one "defs" = Right $ Set.insert Defs-one "no-defs" = Right $ Set.delete Defs+one "parsed" = Right $ Set.insert Parsed+one "no-parsed" = Right $ Set.delete Parsed+one "atom" = Right $ Set.insert Atom+one "no-atom" = Right $ Set.delete Atom+one "the" = Right $ Set.insert The+one "no-the" = Right $ Set.delete The+one "e-alias" = Right $ Set.insert EAlias+one "no-e-alias" = Right $ Set.delete EAlias+one "grin-preeval" = Right $ Set.insert GrinPreeval+one "no-grin-preeval" = Right $ Set.delete GrinPreeval+one "datatable" = Right $ Set.insert Datatable+one "no-datatable" = Right $ Set.delete Datatable+one "e-verbose" = Right $ Set.insert EVerbose+one "no-e-verbose" = Right $ Set.delete EVerbose+one "datatable-builtin" = Right $ Set.insert DatatableBuiltin+one "no-datatable-builtin" = Right $ Set.delete DatatableBuiltin+one "core-afterlift" = Right $ Set.insert CoreAfterlift+one "no-core-afterlift" = Right $ Set.delete CoreAfterlift+one "grin-final" = Right $ Set.insert GrinFinal+one "no-grin-final" = Right $ Set.delete GrinFinal+one "decls" = Right $ Set.insert Decls+one "no-decls" = Right $ Set.delete Decls one "optimization-stats" = Right $ Set.insert OptimizationStats one "no-optimization-stats" = Right $ Set.delete OptimizationStats-one "bindgroups" = Right $ Set.insert Bindgroups-one "no-bindgroups" = Right $ Set.delete Bindgroups+one "core-beforelift" = Right $ Set.insert CoreBeforelift+one "no-core-beforelift" = Right $ Set.delete CoreBeforelift+one "verbose" = Right $ foldr (.) id [ f | Right f <- [ one "progress"]]+one "grin-graph" = Right $ Set.insert GrinGraph+one "no-grin-graph" = Right $ Set.delete GrinGraph+one "grin" = Right $ Set.insert Grin+one "no-grin" = Right $ Set.delete Grin+one "grin-posteval" = Right $ Set.insert GrinPosteval+one "no-grin-posteval" = Right $ Set.delete GrinPosteval+one "core-mini" = Right $ Set.insert CoreMini+one "no-core-mini" = Right $ Set.delete CoreMini one "stats" = Right $ Set.insert Stats one "no-stats" = Right $ Set.delete Stats-one "grin-datalog" = Right $ Set.insert GrinDatalog-one "no-grin-datalog" = Right $ Set.delete GrinDatalog-one "datatable-builtin" = Right $ Set.insert DatatableBuiltin-one "no-datatable-builtin" = Right $ Set.delete DatatableBuiltin-one "rules-spec" = Right $ Set.insert RulesSpec-one "no-rules-spec" = Right $ Set.delete RulesSpec-one "e-alias" = Right $ Set.insert EAlias-one "no-e-alias" = Right $ Set.delete EAlias-one "ini" = Right $ Set.insert Ini-one "no-ini" = Right $ Set.delete Ini-one "imports" = Right $ Set.insert Imports-one "no-imports" = Right $ Set.delete Imports-one "e-size" = Right $ Set.insert ESize-one "no-e-size" = Right $ Set.delete ESize+one "core" = Right $ Set.insert Core+one "no-core" = Right $ Set.delete Core+one "class-summary" = Right $ Set.insert ClassSummary+one "no-class-summary" = Right $ Set.delete ClassSummary+one "scc-modules" = Right $ Set.insert SccModules+one "no-scc-modules" = Right $ Set.delete SccModules one "core-steps" = Right $ Set.insert CoreSteps one "no-core-steps" = Right $ Set.delete CoreSteps-one "aspats" = Right $ Set.insert Aspats-one "no-aspats" = Right $ Set.delete Aspats-one "preprocessed" = Right $ Set.insert Preprocessed-one "no-preprocessed" = Right $ Set.delete Preprocessed-one "grin-final" = Right $ Set.insert GrinFinal-one "no-grin-final" = Right $ Set.delete GrinFinal-one "steps" = Right $ Set.insert Steps-one "no-steps" = Right $ Set.delete Steps-one "the" = Right $ Set.insert The-one "no-the" = Right $ Set.delete The+one "types" = Right $ Set.insert Types+one "no-types" = Right $ Set.delete Types+one "kind" = Right $ Set.insert Kind+one "no-kind" = Right $ Set.delete Kind+one "srcsigs" = Right $ Set.insert Srcsigs+one "no-srcsigs" = Right $ Set.delete Srcsigs+one "grin-datalog" = Right $ Set.insert GrinDatalog+one "no-grin-datalog" = Right $ Set.delete GrinDatalog one "e-info" = Right $ Set.insert EInfo one "no-e-info" = Right $ Set.delete EInfo-one "verbose" = Right $ foldr (.) id [ f | Right f <- [ one "progress"]]+one "renamed" = Right $ Set.insert Renamed+one "no-renamed" = Right $ Set.delete Renamed+one "e-size" = Right $ Set.insert ESize+one "no-e-size" = Right $ Set.delete ESize+one "core-initial" = Right $ Set.insert CoreInitial+one "no-core-initial" = Right $ Set.delete CoreInitial+one "grin-initial" = Right $ Set.insert GrinInitial+one "no-grin-initial" = Right $ Set.delete GrinInitial one "c" = Right $ Set.insert C one "no-c" = Right $ Set.delete C+one "tags" = Right $ Set.insert Tags+one "no-tags" = Right $ Set.delete Tags+one "rules" = Right $ Set.insert Rules+one "no-rules" = Right $ Set.delete Rules+one "bindgroups" = Right $ Set.insert Bindgroups+one "no-bindgroups" = Right $ Set.delete Bindgroups one "dcons" = Right $ Set.insert Dcons one "no-dcons" = Right $ Set.delete Dcons-one "core-mangled" = Right $ Set.insert CoreMangled-one "no-core-mangled" = Right $ Set.delete CoreMangled-one "core-beforelift" = Right $ Set.insert CoreBeforelift-one "no-core-beforelift" = Right $ Set.delete CoreBeforelift-one "kind-steps" = Right $ Set.insert KindSteps-one "no-kind-steps" = Right $ Set.delete KindSteps-one "boxy-steps" = Right $ Set.insert BoxySteps-one "no-boxy-steps" = Right $ Set.delete BoxySteps-one "e-verbose" = Right $ Set.insert EVerbose-one "no-e-verbose" = Right $ Set.delete EVerbose-one "exports" = Right $ Set.insert Exports-one "no-exports" = Right $ Set.delete Exports-one "veryverbose" = Right $ foldr (.) id [ f | Right f <- [ one "progress",one "stats"]]-one "renamed" = Right $ Set.insert Renamed-one "no-renamed" = Right $ Set.delete Renamed-one "atom" = Right $ Set.insert Atom-one "no-atom" = Right $ Set.delete Atom one "instance" = Right $ Set.insert Instance one "no-instance" = Right $ Set.delete Instance-one "derived" = Right $ Set.insert Derived-one "no-derived" = Right $ Set.delete Derived-one "parsed" = Right $ Set.insert Parsed-one "no-parsed" = Right $ Set.delete Parsed-one "core-pass" = Right $ Set.insert CorePass-one "no-core-pass" = Right $ Set.delete CorePass-one "decls" = Right $ Set.insert Decls-one "no-decls" = Right $ Set.delete Decls-one "srcsigs" = Right $ Set.insert Srcsigs-one "no-srcsigs" = Right $ Set.delete Srcsigs-one "progress" = Right $ Set.insert Progress-one "no-progress" = Right $ Set.delete Progress+one "kind-steps" = Right $ Set.insert KindSteps+one "no-kind-steps" = Right $ Set.delete KindSteps+one "all-types" = Right $ Set.insert AllTypes+one "no-all-types" = Right $ Set.delete AllTypes+one "imports" = Right $ Set.insert Imports+one "no-imports" = Right $ Set.delete Imports+one "ini" = Right $ Set.insert Ini+one "no-ini" = Right $ Set.delete Ini+one "preprocessed" = Right $ Set.insert Preprocessed+one "no-preprocessed" = Right $ Set.delete Preprocessed+one "rules-spec" = Right $ Set.insert RulesSpec+one "no-rules-spec" = Right $ Set.delete RulesSpec+one "sigenv" = Right $ Set.insert Sigenv+one "no-sigenv" = Right $ Set.delete Sigenv+one "aspats" = Right $ Set.insert Aspats+one "no-aspats" = Right $ Set.delete Aspats one "grin-normalized" = Right $ Set.insert GrinNormalized one "no-grin-normalized" = Right $ Set.delete GrinNormalized-one "core-afterlift" = Right $ Set.insert CoreAfterlift-one "no-core-afterlift" = Right $ Set.delete CoreAfterlift-one "rules" = Right $ Set.insert Rules-one "no-rules" = Right $ Set.delete Rules-one "grin-graph" = Right $ Set.insert GrinGraph-one "no-grin-graph" = Right $ Set.delete GrinGraph+one "core-mangled" = Right $ Set.insert CoreMangled+one "no-core-mangled" = Right $ Set.delete CoreMangled+one "derived" = Right $ Set.insert Derived+one "no-derived" = Right $ Set.delete Derived+one "defs" = Right $ Set.insert Defs+one "no-defs" = Right $ Set.delete Defs one "class" = Right $ Set.insert Class one "no-class" = Right $ Set.delete Class-one "grin-initial" = Right $ Set.insert GrinInitial-one "no-grin-initial" = Right $ Set.delete GrinInitial-one "core" = Right $ Set.insert Core-one "no-core" = Right $ Set.delete Core-one "tags" = Right $ Set.insert Tags-one "no-tags" = Right $ Set.delete Tags-one "core-initial" = Right $ Set.insert CoreInitial-one "no-core-initial" = Right $ Set.delete CoreInitial-one "datatable" = Right $ Set.insert Datatable-one "no-datatable" = Right $ Set.delete Datatable-one "grin-preeval" = Right $ Set.insert GrinPreeval-one "no-grin-preeval" = Right $ Set.delete GrinPreeval-one "grin-posteval" = Right $ Set.insert GrinPosteval-one "no-grin-posteval" = Right $ Set.delete GrinPosteval-one "sigenv" = Right $ Set.insert Sigenv-one "no-sigenv" = Right $ Set.delete Sigenv-one "class-summary" = Right $ Set.insert ClassSummary-one "no-class-summary" = Right $ Set.delete ClassSummary+one "exports" = Right $ Set.insert Exports+one "no-exports" = Right $ Set.delete Exports+one "core-pass" = Right $ Set.insert CorePass+one "no-core-pass" = Right $ Set.delete CorePass one x = Left x {-# NOINLINE process #-}
src/FlagOpts.hs view
@@ -70,70 +70,70 @@ show Pthread = "pthread" show Customthread = "customthread" -one "exists" = Right $ Set.insert Exists-one "no-exists" = Right $ Set.delete Exists-one "wrapper" = Right $ Set.insert Wrapper-one "no-wrapper" = Right $ Set.delete Wrapper-one "boehm" = Right $ Set.insert Boehm-one "no-boehm" = Right $ Set.delete Boehm-one "debug" = Right $ Set.insert Debug-one "no-debug" = Right $ Set.delete Debug-one "full-int" = Right $ Set.insert FullInt-one "no-full-int" = Right $ Set.delete FullInt+one "profile" = Right $ Set.insert Profile+one "no-profile" = Right $ Set.delete Profile one "jgc" = Right $ Set.insert Jgc one "no-jgc" = Right $ Set.delete Jgc+one "nothread" = Right $ Set.insert Nothread+one "no-nothread" = Right $ Set.delete Nothread+one "customthread" = Right $ Set.insert Customthread+one "no-customthread" = Right $ Set.delete Customthread+one "wrapper" = Right $ Set.insert Wrapper+one "no-wrapper" = Right $ Set.delete Wrapper+one "ffi" = Right $ Set.insert Ffi+one "no-ffi" = Right $ Set.delete Ffi one "glasgow-exts" = Right $ foldr (.) id [ f | Right f <- [ one "forall",one "ffi",one "unboxed-tuples"]]-one "monomorphism-restriction" = Right $ Set.insert MonomorphismRestriction-one "no-monomorphism-restriction" = Right $ Set.delete MonomorphismRestriction+one "inline-pragmas" = Right $ Set.insert InlinePragmas+one "no-inline-pragmas" = Right $ Set.delete InlinePragmas+one "pthread" = Right $ Set.insert Pthread+one "no-pthread" = Right $ Set.delete Pthread one "rules" = Right $ Set.insert Rules one "no-rules" = Right $ Set.delete Rules-one "prelude" = Right $ Set.insert Prelude-one "no-prelude" = Right $ Set.delete Prelude+one "type-families" = Right $ Set.insert TypeFamilies+one "no-type-families" = Right $ Set.delete TypeFamilies one "m4" = Right $ Set.insert M4 one "no-m4" = Right $ Set.delete M4 one "type-analysis" = Right $ Set.insert TypeAnalysis one "no-type-analysis" = Right $ Set.delete TypeAnalysis-one "bang-patterns" = Right $ Set.insert BangPatterns-one "no-bang-patterns" = Right $ Set.delete BangPatterns-one "customthread" = Right $ Set.insert Customthread-one "no-customthread" = Right $ Set.delete Customthread-one "raw" = Right $ Set.insert Raw-one "no-raw" = Right $ Set.delete Raw-one "standalone" = Right $ Set.insert Standalone-one "no-standalone" = Right $ Set.delete Standalone+one "prelude" = Right $ Set.insert Prelude+one "no-prelude" = Right $ Set.delete Prelude one "user-kinds" = Right $ Set.insert UserKinds one "no-user-kinds" = Right $ Set.delete UserKinds-one "defaulting" = Right $ Set.insert Defaulting-one "no-defaulting" = Right $ Set.delete Defaulting-one "negate" = Right $ Set.insert Negate-one "no-negate" = Right $ Set.delete Negate-one "type-families" = Right $ Set.insert TypeFamilies-one "no-type-families" = Right $ Set.delete TypeFamilies-one "default" = Right $ foldr (.) id [ f | Right f <- [ one "inline-pragmas",one "rules",one "wrapper",one "defaulting",one "type-analysis",one "monomorphism-restriction",one "global-optimize",one "full-int",one "prelude"]]-one "controlled" = Right $ Set.insert Controlled-one "no-controlled" = Right $ Set.delete Controlled-one "pthread" = Right $ Set.insert Pthread-one "no-pthread" = Right $ Set.delete Pthread+one "cpp" = Right $ Set.insert Cpp+one "no-cpp" = Right $ Set.delete Cpp+one "full-int" = Right $ Set.insert FullInt+one "no-full-int" = Right $ Set.delete FullInt+one "exists" = Right $ Set.insert Exists+one "no-exists" = Right $ Set.delete Exists+one "standalone" = Right $ Set.insert Standalone+one "no-standalone" = Right $ Set.delete Standalone one "forall" = Right $ Set.insert Forall one "no-forall" = Right $ Set.delete Forall one "unboxed-tuples" = Right $ Set.insert UnboxedTuples one "no-unboxed-tuples" = Right $ Set.delete UnboxedTuples-one "cpp" = Right $ Set.insert Cpp-one "no-cpp" = Right $ Set.delete Cpp-one "unboxed-values" = Right $ Set.insert UnboxedValues-one "no-unboxed-values" = Right $ Set.delete UnboxedValues-one "global-optimize" = Right $ Set.insert GlobalOptimize-one "no-global-optimize" = Right $ Set.delete GlobalOptimize-one "nothread" = Right $ Set.insert Nothread-one "no-nothread" = Right $ Set.delete Nothread+one "default" = Right $ foldr (.) id [ f | Right f <- [ one "inline-pragmas",one "rules",one "wrapper",one "defaulting",one "type-analysis",one "monomorphism-restriction",one "global-optimize",one "full-int",one "prelude"]]+one "controlled" = Right $ Set.insert Controlled+one "no-controlled" = Right $ Set.delete Controlled+one "negate" = Right $ Set.insert Negate+one "no-negate" = Right $ Set.delete Negate one "lint" = Right $ Set.insert Lint one "no-lint" = Right $ Set.delete Lint-one "profile" = Right $ Set.insert Profile-one "no-profile" = Right $ Set.delete Profile-one "inline-pragmas" = Right $ Set.insert InlinePragmas-one "no-inline-pragmas" = Right $ Set.delete InlinePragmas-one "ffi" = Right $ Set.insert Ffi-one "no-ffi" = Right $ Set.delete Ffi+one "raw" = Right $ Set.insert Raw+one "no-raw" = Right $ Set.delete Raw+one "monomorphism-restriction" = Right $ Set.insert MonomorphismRestriction+one "no-monomorphism-restriction" = Right $ Set.delete MonomorphismRestriction+one "boehm" = Right $ Set.insert Boehm+one "no-boehm" = Right $ Set.delete Boehm+one "bang-patterns" = Right $ Set.insert BangPatterns+one "no-bang-patterns" = Right $ Set.delete BangPatterns+one "debug" = Right $ Set.insert Debug+one "no-debug" = Right $ Set.delete Debug+one "global-optimize" = Right $ Set.insert GlobalOptimize+one "no-global-optimize" = Right $ Set.delete GlobalOptimize+one "defaulting" = Right $ Set.insert Defaulting+one "no-defaulting" = Right $ Set.delete Defaulting+one "unboxed-values" = Right $ Set.insert UnboxedValues+one "no-unboxed-values" = Right $ Set.delete UnboxedValues one x = Left x {-# NOINLINE process #-}
src/FrontEnd/Class.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE NoMonoLocalBinds, NamedFieldPuns #-}-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module FrontEnd.Class( printClassHierarchy, instanceToTopDecls,@@ -67,6 +67,7 @@ instHead :: Qual Pred, instAssocs :: [(Tycon,[Tyvar],[Tyvar],Sigma)] } deriving(Eq,Ord,Show)+ {-! derive: Binary !-} instance PPrint a (Qual Pred) => PPrint a Inst where pprint Inst { instHead = h, instAssocs = [], instDerived = d } = (if d then text "*" else text " ") <> pprint h@@ -86,6 +87,7 @@ -- Bool is true if data declaration instead of type declaration data AssociatedType = Assoc !Tycon !Bool [Tyvar] Kind deriving(Eq,Show)+ {-! derive: Binary !-} data ClassRecord = ClassRecord { className :: !Class, -- ^ can be a TypeConstructor if we are a type or data family@@ -96,6 +98,7 @@ classAssumps :: [(Name,Sigma)], -- ^ method signatures classAssocs :: [AssociatedType] } deriving (Show,Eq)+ {-! derive: Binary !-} newtype InstanceEnv = InstanceEnv { instanceEnv :: Map.Map (Name,Name) ([Tyvar],[Tyvar],Type) }@@ -533,9 +536,3 @@ class_Bounded ] -}--{-!-deriving instance Binary Inst-deriving instance Binary AssociatedType-deriving instance Binary ClassRecord-!-}
src/FrontEnd/HsSyn.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module FrontEnd.HsSyn where import Data.Binary@@ -45,6 +45,7 @@ hsModuleOptions :: [String], hsModuleOpt :: Opt }+ {-! derive: update !-} -- Export/Import Specifications @@ -71,6 +72,7 @@ data HsAssoc = HsAssocNone | HsAssocLeft | HsAssocRight deriving(Eq,Show)+ {-! derive: Binary !-} instance HasLocation HsDecl where srcLoc HsTypeDecl { hsDeclSrcLoc = sl } = sl@@ -208,6 +210,7 @@ hsDeclClassHead :: HsClassHead } deriving(Eq,Show)+ {-! derive: is !-} data HsRule = HsRule { hsRuleUniq :: (Module,Int),@@ -248,6 +251,7 @@ hsConDeclRecArg :: [([HsName],HsBangType)] } deriving(Eq,Show)+ {-! derive: is, update !-} hsConDeclArgs HsConDecl { hsConDeclConArg = as } = as hsConDeclArgs HsRecDecl { hsConDeclRecArg = as } = concat [ replicate (length ns) t | (ns,t) <- as]@@ -269,6 +273,7 @@ hsQualTypeContext :: HsContext, hsQualTypeType :: HsType } deriving(Data,Typeable,Eq,Ord,Show)+ {-! derive: Binary !-} type LHsType = Located HsType @@ -296,12 +301,14 @@ | HsTyAssoc | HsTyEq HsType HsType deriving(Data,Typeable,Eq,Ord,Show)+ {-! derive: Binary, is !-} data HsTyVarBind = HsTyVarBind { hsTyVarBindSrcLoc :: SrcLoc, hsTyVarBindName :: HsName, hsTyVarBindKind :: Maybe HsKind } deriving(Data,Typeable,Eq,Ord,Show)+ {-! derive: Binary, update !-} hsTyVarBind = HsTyVarBind { hsTyVarBindSrcLoc = bogusASrcLoc,@@ -316,6 +323,7 @@ data HsAsst = HsAsst HsName [HsName] | HsAsstEq HsType HsType deriving(Data,Typeable,Eq,Ord, Show)+ {-! derive: Binary !-} data HsLiteral = HsInt !Integer@@ -331,6 +339,7 @@ -- GHC extension: | HsLitLit String deriving(Eq,Ord, Show)+ {-! derive: is !-} hsParen x@HsVar {} = x hsParen x@HsCon {} = x@@ -384,12 +393,14 @@ | HsBangPat { hsExpLExp :: LHsExp } | HsLocatedExp LHsExp deriving(Eq,Show)+ {-! derive: is, update !-} data HsClassHead = HsClassHead { hsClassHeadContext :: HsContext, hsClassHead :: HsName, hsClassHeadArgs :: [HsType] } deriving(Eq,Show)+ {-! derive: update !-} type LHsPat = Located HsPat @@ -410,6 +421,7 @@ | HsPBangPat { hsPatLPat :: LHsPat } | HsPTypeSig SrcLoc HsPat HsQualType -- scoped type variable extension deriving(Eq,Ord,Show)+ {-! derive: is !-} data HsPatField = HsPFieldPat HsName HsPat deriving(Eq,Ord,Show)@@ -428,6 +440,7 @@ data HsKind = HsKind HsName | HsKindFn HsKind HsKind deriving(Data,Typeable,Eq,Ord,Show)+ {-! derive: Binary !-} hsKindStar = HsKind s_Star hsKindHash = HsKind s_Hash@@ -435,25 +448,3 @@ hsKindQuest = HsKind s_Quest hsKindQuestQuest = HsKind s_QuestQuest hsKindStarBang = HsKind s_StarBang----{-!-deriving instance Update HsModule-deriving instance Binary HsAssoc-deriving instance Is HsDecl-deriving instance Is HsConDecl-deriving instance Update HsConDecl-deriving instance Binary HsQualType-deriving instance Binary HsType-deriving instance Is HsType-deriving instance Binary HsTyVarBind-deriving instance Update HsTyVarBind-deriving instance Binary HsAsst-deriving instance Is HsLiteral-deriving instance Is HsExp-deriving instance Update HsExp-deriving instance Update HsClassHead-deriving instance Is HsPat-deriving instance Binary HsKind-!-}
src/FrontEnd/KindInfer.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} {-# OPTIONS -funbox-strict-fields #-} -- | -- This module implements the Kind Inference algorithm, and the routines which@@ -53,6 +53,7 @@ kindEnvAssocs :: Map.Map Name (Int,Int), kindEnvClasses :: Map.Map Name [Kind] } deriving(Typeable,Show)+ {-!derive: Monoid !-} instance Binary KindEnv where put KindEnv { kindEnv = a, kindEnvAssocs = b, kindEnvClasses = c } =@@ -623,7 +624,3 @@ fromHsTyVar (HsTyVar v) = return v fromHsTyVar (HsTyExpKind (Located _ t) _) = fromHsTyVar t fromHsTyVar _ = fail "fromHsTyVar"--{-!-deriving instance Monoid KindEnv-!-}
src/FrontEnd/Representation.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module FrontEnd.Representation( Type(..), Tyvar(..),@@ -41,6 +41,7 @@ data MetaVarType = Tau | Rho | Sigma deriving(Eq,Ord)+ {-! derive: Binary !-} data Type = TVar { typeVar :: !Tyvar } | TCon { typeCon :: !Tycon }@@ -51,6 +52,7 @@ | TMetaVar { metaVar :: MetaVar } | TAssoc { typeCon :: !Tycon, typeClassArgs :: [Type], typeExtraArgs :: [Type] } deriving(Ord,Show)+ {-! derive: Binary !-} -- | metavars are used in type checking data MetaVar = MetaVar {@@ -59,6 +61,7 @@ metaRef :: {-# UNPACK #-} !(IORef (Maybe Type)), metaType :: !MetaVarType }+ {-! derive: Binary !-} instance Eq MetaVar where a == b = metaUniq a == metaUniq b@@ -104,6 +107,7 @@ -- Unquantified type variables data Tyvar = Tyvar { tyvarName :: {-# UNPACK #-} !Name, tyvarKind :: Kind }+ {- derive: Binary -} instance Show Tyvar where showsPrec _ Tyvar { tyvarName = hn, tyvarKind = k } = shows hn . ("::" ++) . shows k@@ -133,6 +137,7 @@ data Tycon = Tycon { tyconName :: Name, tyconKind :: Kind } deriving(Eq, Show,Ord)+ {-! derive: Binary !-} instance ToTuple Tycon where toTuple n = Tycon (nameTuple TypeConstructor n) (foldr Kfun kindStar $ replicate n kindStar)@@ -151,10 +156,12 @@ -- Predicates data Pred = IsIn Class Type | IsEq Type Type deriving(Show, Eq,Ord)+ {-! derive: Binary !-} -- Qualified entities data Qual t = [Pred] :=> t deriving(Show, Eq,Ord)+ {-! derive: Binary !-} instance (DocLike d,PPrint d t) => PPrint d (Qual t) where pprint ([] :=> r) = pprint r@@ -310,12 +317,3 @@ tTTuple' ts = foldl TAp (TCon $ Tycon (unboxedNameTuple TypeConstructor n) (foldr Kfun kindUTuple $ replicate n kindStar)) ts where n = length ts--{-!-deriving instance Binary MetaVarType-deriving instance Binary Type-deriving instance Binary MetaVar-deriving instance Binary Tycon-deriving instance Binary Pred-deriving instance Binary Qual-!-}
src/FrontEnd/SrcLoc.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module FrontEnd.SrcLoc where import Control.Applicative@@ -17,9 +17,11 @@ srcLocColumn :: {-# UNPACK #-} !Int } deriving(Data,Typeable,Eq,Ord)+ {-! derive: update, Binary !-} data SrcSpan = SrcSpan { srcSpanBegin :: !SrcLoc, srcSpanEnd :: !SrcLoc } deriving(Data,Typeable,Eq,Ord)+ {-! derive: update, Binary !-} -- Useful bogus file names used to indicate where non file based errors are. fileNameCommandLine = packString "(command line)"@@ -62,6 +64,7 @@ data Located x = Located SrcSpan x deriving(Ord,Show,Data,Typeable,Eq)+ {-! derive: Binary !-} fromLocated :: Located x -> x fromLocated (Located _ x) = x@@ -119,12 +122,3 @@ show SrcSpan { srcSpanBegin = sl1, srcSpanEnd = sl2 } | sl1 == sl2 = show sl1 | otherwise = show sl1 ++ "-" ++ show sl2--{-!-deriving instance Update SrcLoc-deriving instance Binary SrcLoc-deriving instance Update SrcSpan-deriving instance Binary SrcSpan-deriving instance Binary Located-!-}-
src/FrontEnd/Tc/Kind.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module FrontEnd.Tc.Kind( Kind(..), KBase(..),@@ -54,6 +54,7 @@ | KQuest | KNamed Name deriving(Eq, Ord) -- but we need them for kind inference+ {-! derive: Binary !-} KNamed s1 `isSubsumedBy2` KNamed s2 = s1 == s2 _ `isSubsumedBy2` KQuest = True@@ -73,6 +74,7 @@ | Kfun Kind Kind | KVar Kindvar -- variables aren't really allowed in haskell in kinds deriving(Eq, Ord) -- but we need them for kind inference+ {-! derive: Binary !-} KBase kb `isSubsumedBy` KBase kb' = isSubsumedBy2 kb kb' Kfun k1 k2 `isSubsumedBy` Kfun k1' k2' = isSubsumedBy k1 k1' && isSubsumedBy k2 k2'@@ -164,8 +166,3 @@ unfoldKind :: Kind -> [Kind] unfoldKind (Kfun k1 k2) = k1 : unfoldKind k2 unfoldKind v = [v]--{-!-deriving instance Binary KBase-deriving instance Binary Kind-!-}
src/FrontEnd/Tc/Monad.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module FrontEnd.Tc.Monad( CoerceTerm(..), Tc(),@@ -122,6 +122,7 @@ tcWarnings :: !(Seq.Seq Warning), outKnots :: [(Name,Name)] }+ {-! derive: Monoid !-} newtype Tc a = Tc (ReaderT TcEnv (WriterT Output IO) a) deriving(MonadFix,MonadIO,MonadReader TcEnv,MonadWriter Output,Functor)@@ -560,7 +561,3 @@ taus <- mapM (newMetaVar Tau) ks varBind mv (sfunc taus) bsfunc taus--{-!-deriving instance Monoid Output-!-}
src/Grin/Devolve.hs view
@@ -104,7 +104,15 @@ f l@Let {} = do ds <- twiddle (expDefs l) b <- twiddle (expBody l)- return . updateLetProps $ l { expDefs = ds, expBody = b }+ roots <- asks envRoots+ let nroots = Set.fromList [ Var v t | (v,t) <- Set.toList (freeVars l), isNode t, v > v0] Set.\\ roots+ return $ gcRoots (Set.toList nroots) (updateLetProps $ l { expDefs = ds, expBody = b })+ f (App a vs t) | fopts FO.Jgc = do+ roots <- asks envRoots+ let nroots = Set.fromList [ Var v t | x <- vs, (v,t) <- Set.toList (freeVars x), isNode t, v > v0] Set.\\ roots+ local (\e -> e { envRoots = envRoots e `Set.union` nroots}) $ do+ ne <- return (App a) `ap` mapM twiddleVal vs `ap` return t+ return $ gcRoots (Set.toList nroots) ne f (Case v as) = return Case `ap` twiddle v `ap` twiddle as f x | fopts FO.Jgc && isUsing x && isAllocing x = do roots <- asks envRoots
src/Grin/SSimplify.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module Grin.SSimplify(simplify,explicitRecurse) where import Control.Monad.Identity@@ -41,6 +41,7 @@ envPapp :: IM.IntMap (Atom,[Val]) --envPush :: IM.IntMap Exp }+ {-! derive: Monoid !-} newtype SState = SState { usedVars :: IS.IntSet } @@ -48,6 +49,7 @@ colStats :: Stats.Stat, colFreeVars :: GSet Var }+ {-! derive: Monoid !-} {- data ExpInfo = ExpInfo {@@ -428,8 +430,3 @@ g (App n rs t) | n == name = App nname rs t g e = tickle g e return $ as :-> grinLet [createFuncDef True nname (as :-> g e) ] (App nname as (getType e))--{-!-deriving instance Monoid SCol-deriving instance Monoid SEnv-!-}
src/Ho/ReadSource.hs view
@@ -12,6 +12,7 @@ import Data.Maybe import System.FilePath as FP import System.Process+import System.Directory import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy.UTF8 as LBSU@@ -47,9 +48,8 @@ _ | fopts FO.Cpp -> readSystem "cpphs" $ incFlags ++ defFlags ++ [fn] | fopts FO.M4 -> do m4p <- m4Prelude- useGm4 <- existCommand "gm4"- let c = if useGm4 then "gm4" else "m4"- readSystem c $ ["-s", "-P"] ++ incFlags ++ defFlags ++ [m4p,fn]+ maygm4 <- findExecutable "gm4"+ readSystem (fromMaybe "m4" maygm4) $ ["-s", "-P"] ++ incFlags ++ defFlags ++ [m4p,fn] | otherwise -> return lbs m4Prelude :: IO FilePath
src/Ho/Type.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module Ho.Type where import Data.Monoid@@ -67,6 +67,7 @@ choHo :: Ho, -- ^ cache of combined and renamed ho choVarMap :: IdMap (Maybe E) -- ^ cache of variable substitution map }+ {-! derive: update !-} -- | The header contains basic information about the file, it should be enough to determine whether -- we can discard the file right away or consider it further.@@ -129,6 +130,7 @@ hoClassHierarchy :: ClassHierarchy, hoFieldMap :: FieldMap }+ {-! derive: update, Monoid !-} data HoBuild = HoBuild { -- | Filled in by E generation@@ -136,12 +138,14 @@ hoEs :: [(TVr,E)], hoRules :: Rules }+ {-! derive: update, Monoid !-} data Ho = Ho { hoModuleGroup :: ModuleGroup, hoTcInfo :: HoTcInfo, hoBuild :: HoBuild }+ {-! derive: update !-} instance Monoid Ho where mempty = Ho (error "unknown module group") mempty mempty@@ -181,12 +185,3 @@ } -}--{-!-deriving instance Update CollectedHo-deriving instance Update HoTcInfo-deriving instance Monoid HoTcInfo-deriving instance Update HoBuild-deriving instance Monoid HoBuild-deriving instance Update Ho-!-}
src/Name/VConsts.hs view
@@ -1,8 +1,9 @@-{-# OPTIONS_GHC -F -pgmFderive -optF-F #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module Name.VConsts where import Control.Applicative import Data.Foldable+import Data.Monoid import Data.Traversable -- This is much more verbose/complicated than it needs be.@@ -75,9 +76,4 @@ func_runNoWrapper :: a, func_runRaw :: a }--{-!-deriving instance Functor FuncNames-deriving instance Traversable FuncNames-deriving instance Foldable FuncNames-!-}+ {-! derive: Functor, Traversable, Foldable !-}
src/Options.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS -w -funbox-strict-fields #-}+{-# OPTIONS_GHC -pgmF drift-ghc -F #-} module Options( processOptions, Opt(..),@@ -213,53 +214,7 @@ optInis :: M.Map String String, -- ^ options read from ini files optDumpSet :: S.Set FlagDump.Flag, -- ^ Dump flags. optFOptsSet :: S.Set FlagOpts.Flag -- ^ Flag options (-f\<opt\>).- }---- Derive-optAnnotate_s v = optAnnotate_u (const v)-optAnnotate_u f r@Opt{optAnnotate = x} = r{optAnnotate = f x}-optArch_u f r@Opt{optArch = x} = r{optArch = f x}-optCCargs_u f r@Opt{optCCargs = x} = r{optCCargs = f x}-optColumns_s v = optColumns_u (const v)-optColumns_u f r@Opt{optColumns = x} = r{optColumns = f x}-optCross_s v = optCross_u (const v)-optCross_u f r@Opt{optCross = x} = r{optCross = f x}-optDefs_u f r@Opt{optDefs = x} = r{optDefs = f x}-optDeps_s v = optDeps_u (const v)-optDeps_u f r@Opt{optDeps = x} = r{optDeps = f x}-optDump_u f r@Opt{optDump = x} = r{optDump = f x}-optExtensions_u f r@Opt{optExtensions = x} = r{optExtensions = f x}-optFOptsSet_u f r@Opt{optFOptsSet = x} = r{optFOptsSet = f x}-optFOpts_u f r@Opt{optFOpts = x} = r{optFOpts = f x}-optHlPath_u f r@Opt{optHlPath = x} = r{optHlPath = f x}-optHls_u f r@Opt{optHls = x} = r{optHls = f x}-optHoCache_s v = optHoCache_u (const v)-optHoCache_u f r@Opt{optHoCache = x} = r{optHoCache = f x}-optIgnoreHo_s v = optIgnoreHo_u (const v)-optIgnoreHo_u f r@Opt{optIgnoreHo = x} = r{optIgnoreHo = f x}-optIncdirs_u f r@Opt{optIncdirs = x} = r{optIncdirs = f x}-optIncs_u f r@Opt{optIncs = x} = r{optIncs = f x}-optKeepGoing_s v = optKeepGoing_u (const v)-optKeepGoing_u f r@Opt{optKeepGoing = x} = r{optKeepGoing = f x}-optMainFunc_s v = optMainFunc_u (const v)-optMainFunc_u f r@Opt{optMainFunc = x} = r{optMainFunc = f x}-optMode_s v = optMode_u (const v)-optMode_u f r@Opt{optMode = x} = r{optMode = f x}-optNoAuto_s v = optNoAuto_u (const v)-optNoAuto_u f r@Opt{optNoAuto = x} = r{optNoAuto = f x}-optNoWriteHo_s v = optNoWriteHo_u (const v)-optNoWriteHo_u f r@Opt{optNoWriteHo = x} = r{optNoWriteHo = f x}-optOutName_s v = optOutName_u (const v)-optOutName_u f r@Opt{optOutName = x} = r{optOutName = f x}-optStale_u f r@Opt{optStale = x} = r{optStale = f x}-optStatLevel_u f r@Opt{optStatLevel = x} = r{optStatLevel = f x}-optStop_s v = optStop_u (const v)-optStop_u f r@Opt{optStop = x} = r{optStop = f x}-optVerbose_u f r@Opt{optVerbose = x} = r{optVerbose = f x}-optWorkDir_s v = optWorkDir_u (const v)-optWorkDir_u f r@Opt{optWorkDir = x} = r{optWorkDir = f x}-optTargetsIni_s v = optTargetsIni_u (const v)-optTargetsIni_u f r@Opt{optTargetsIni = x} = r{optTargetsIni = f x}+ } {-!derive: update !-} emptyOpt = Opt { optMode = CompileExe,@@ -422,7 +377,7 @@ _ -> return () -- read targets.ini file cabalEtc <- getDataFileNameMaybe "etc"- Just home <- fmap (`mplus` Just "/") $ lookupEnv "HOME"+ home <- fmap (++ "/") getHomeDirectory let fromMaybeToList Nothing = [] fromMaybeToList (Just s) = [s] oTarget = fromMaybeToList $ optTargetsIni o@@ -461,7 +416,7 @@ Just s -> do return (Just s) Just "-" -> do return Nothing Nothing | isNothing (optHoDir options) -> do- Just home <- fmap (`mplus` Just "/") $ lookupEnv "HOME"+ home <- fmap (++ "/") getHomeDirectory let cd = home ++ "/.ajhc/cache" createDirectoryIfMissing True cd return (Just cd)@@ -542,7 +497,7 @@ initialLibIncludes :: [String] initialLibIncludes = unsafePerformIO $ do ps <- lookupEnv "AJHC_LIBRARY_PATH"- h <- lookupEnv "HOME"+ h <- fmap return getHomeDirectory let paths = h ++ ["/usr/local","/usr"] bases = ["/lib","/share"] vers = ["/ajhc-" ++ shortVersion, "/ajhc"]
src/RawFiles.hs view
@@ -152,7 +152,7 @@ \; cross compilation entries\n\ \\n\ \[win32]\n\- \cc=i386-mingw32-gcc\n\+ \cc=i686-w64-mingw32-gcc\n\ \executable_extension=.exe\n\ \merge=i686\n\ \\n\@@ -1087,6 +1087,209 @@ {-# NOINLINE changelog #-} changelog :: ByteString changelog = unsafePerformIO $ unsafePackAddress "\+ \commit 66a602abc10dec74e2c0bb9289819a015bf21e4f\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Thu Dec 19 01:45:04 2013 +0900\n\+ \\n\+ \ Add release note for 0.8.0.10.\n\+ \\n\+ \commit 1960e4226a41c101b64db9677c2096344f5f70d6\n\+ \Merge: 5b4817d fe804fa\n\+ \Author: Kiwamu Okabe <kiwamu@gmail.com>\n\+ \Date: Wed Dec 18 00:59:43 2013 -0800\n\+ \\n\+ \ Merge pull request #63 from master-q/issues/62\n\+ \ \n\+ \ Add GC root Let loop. (fixed #62)\n\+ \\n\+ \commit 5b4817dd950f2ddc947f0796f27d41d625147c3a\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Mon Dec 9 02:02:10 2013 +0900\n\+ \\n\+ \ Need patch command.\n\+ \ \n\+ \ Someone may forget it on Windows.\n\+ \\n\+ \commit 6c053b940812689fe22d2dbe2b7ad835dab8a3c7\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Wed Dec 4 22:37:06 2013 +0900\n\+ \\n\+ \ Fix some warning on RTS.\n\+ \\n\+ \commit eb0004484ba85c06b8841d0c33f525ec4fbebaa5\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Fri Nov 22 19:43:24 2013 +0900\n\+ \\n\+ \ Double atom string size (fixed #65)\n\+ \\n\+ \commit ef04922345d3503235620c86405af838f0271347\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Fri Nov 22 19:24:20 2013 +0900\n\+ \\n\+ \ Show atom string to understand error.\n\+ \\n\+ \commit 9b812de402401eae607e12ccb297174df37f91a7\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Thu Nov 14 17:29:36 2013 +0900\n\+ \\n\+ \ A bucket to keep HCAR tex files.\n\+ \\n\+ \commit fe804fa3dc048b4bd26f39f09592afe9db389634\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Tue Nov 12 22:32:32 2013 +0900\n\+ \\n\+ \ Add GC root Let loop. (fixed #62)\n\+ \\n\+ \commit 740215995363a23f15c8a2b26a69949e64101187\n\+ \Author: Fumiaki Kinoshita <fumiexcel@gmail.com>\n\+ \Date: Sun Nov 10 19:33:59 2013 +0900\n\+ \\n\+ \ Make up a missing import\n\+ \\n\+ \commit d3c5dea4383f23a6ba3aa7d33aa18135ab89689f\n\+ \Merge: 4fd1d03 6dff035\n\+ \Author: Fumiaki Kinoshita <fumiexcel@gmail.com>\n\+ \Date: Sun Nov 10 16:29:19 2013 +0900\n\+ \\n\+ \ Merge branch 'arafura' of https://github.com/ajhc/ajhc into arafura\n\+ \\n\+ \commit 4fd1d03406305184a49caa667766508e44b41653\n\+ \Author: Fumiaki Kinoshita <fumiexcel@gmail.com>\n\+ \Date: Sat Nov 9 21:48:31 2013 +0900\n\+ \\n\+ \ use getHomeDirectory\n\+ \\n\+ \commit 6dff0357edf22fc9342346a432e457c92aaa6804\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Sat Nov 9 20:40:23 2013 +0900\n\+ \\n\+ \ Add TODO.\n\+ \\n\+ \commit 92bf7b4f43d19bf00d4520280f521915a66bb901\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Wed Nov 6 21:01:52 2013 +0900\n\+ \\n\+ \ Come back bytestring (fixed #46)\n\+ \\n\+ \commit 2b91497770dcd0def3b2efb2b2159b521295a4e2\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Wed Nov 6 21:01:04 2013 +0900\n\+ \\n\+ \ ForeignPtr is instance of Eq and Ord.\n\+ \\n\+ \commit 7854745b951b257ceb50638548f7edb9e622e8e4\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Wed Nov 6 19:16:46 2013 +0900\n\+ \\n\+ \ Need more stack for nofib.digits-of-e1. BAD... #orz\n\+ \\n\+ \commit f2019a08da5c6b214a12493b881cfd0da4eee900\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Wed Nov 6 19:11:12 2013 +0900\n\+ \\n\+ \ Merge mzp's patch. (fixed #51)\n\+ \\n\+ \commit 8c13cc98aa056e54e75670a91aecb8a2a093845c\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Wed Nov 6 19:08:57 2013 +0900\n\+ \\n\+ \ Better test code for issue/51.\n\+ \\n\+ \commit 7e4936f35890e204ac2d1d794e513cd457e6cd54\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Wed Nov 6 18:38:25 2013 +0900\n\+ \\n\+ \ Add a regress test. issue/51\n\+ \ \n\+ \ A pointer used by program is sweeped by GC\n\+ \ https://github.com/ajhc/ajhc/issues/51\n\+ \\n\+ \commit c3f8c68a30cc5d1a20611f8ab5c8fee8386f8c39\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Tue Nov 5 21:58:19 2013 +0900\n\+ \\n\+ \ Not support Windows platform officially.\n\+ \\n\+ \commit afae60939d4e47cdf3f5b745abdf70ccbc1d909d\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Tue Nov 5 00:10:24 2013 +0900\n\+ \\n\+ \ Derive Opt.\n\+ \\n\+ \commit a798a822a5a96fd7166f6e24f23fffd0c2b0a184\n\+ \Merge: 3bdff52 7de5e1e\n\+ \Author: MIZUNO Hiroki <mzpppp@gmail.com>\n\+ \Date: Mon Nov 4 06:40:04 2013 -0800\n\+ \\n\+ \ Merge pull request #58 from master-q/issues/52\n\+ \ \n\+ \ Fix Issues/52.\n\+ \\n\+ \commit 3bdff522b17f6a7d6f3d96e3232ecb832211fed9\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Sun Nov 3 22:11:14 2013 +0900\n\+ \\n\+ \ Use DrIFT again. Do not need derive. (fixed #47)\n\+ \\n\+ \commit 7de5e1eda25f14020640305ebae9dec587904018\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Sun Nov 3 20:09:54 2013 +0900\n\+ \\n\+ \ Fix issues/52.\n\+ \ \n\+ \ Out c code depends on gcc undefiend behavior\n\+ \ https://github.com/ajhc/ajhc/issues/52\n\+ \ void function could not return value as long as it is void function.\n\+ \\n\+ \commit e69923b7d4c53777dfe525a1047d25601f5b56ac\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Sun Nov 3 20:08:47 2013 +0900\n\+ \\n\+ \ Fix pointer mistake.\n\+ \\n\+ \commit a05f1dd55ec5b78fdd6580579cd6f3b665628701\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Sun Nov 3 20:00:11 2013 +0900\n\+ \\n\+ \ Add regress test for https://github.com/ajhc/ajhc/issues/52.\n\+ \\n\+ \commit bc4417a6eb366df1e10e8bd87c9253b6e5182d1c\n\+ \Merge: ccc1fae 8bf4880\n\+ \Author: Kiwamu Okabe <kiwamu@gmail.com>\n\+ \Date: Thu Oct 31 10:23:55 2013 -0700\n\+ \\n\+ \ Merge pull request #56 from fumieval/arafura\n\+ \ \n\+ \ Use findExecutable instead of the raw `which`\n\+ \\n\+ \commit 8bf48800a71c3bb6d5f4bd6887a9a11613c630ae\n\+ \Author: Fumiaki Kinoshita <fumiexcel@gmail.com>\n\+ \Date: Thu Oct 31 22:24:46 2013 +0900\n\+ \\n\+ \ use findExecutable instead of the raw `which`\n\+ \\n\+ \commit ccc1faea6410dc3d6f1e6cdcf1492cfb5e73e376\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Thu Oct 31 17:44:07 2013 +0900\n\+ \\n\+ \ Update License.\n\+ \\n\+ \commit 4afc13b4e3506a91497fa442636b2898cf0df958\n\+ \Merge: d499d96 eb1dafd\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Thu Oct 31 17:35:57 2013 +0900\n\+ \\n\+ \ Merge remote-tracking branch 'origin/master' into arafura\n\+ \ \n\+ \ Conflicts:\n\+ \ \x0009\&rts/rts/gc_jgc.c <= Take arafura branch's.\n\+ \\n\+ \commit d499d962f7164b19368e4bd57c5cd7eb36f5bdfa\n\+ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\+ \Date: Sat Oct 26 18:52:53 2013 +0900\n\+ \\n\+ \ Bump up version 0.8.0.10.\n\+ \\n\ \commit fdd05fe6aeec7d305a818b5a92c36fc2e1a5574c\n\ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\ \Date: Sat Oct 26 18:38:40 2013 +0900\n\@@ -1147,6 +1350,36 @@ \\n\ \ Split travis-ci scripts.\n\ \\n\+ \commit eb1dafdf0464a71da15b7b09e956c7a67a2c67ee\n\+ \Author: kiwamu <kiwamu@debian.or.jp>\n\+ \Date: Fri Sep 20 00:13:44 2013 +0900\n\+ \\n\+ \ Better NAIVEGC and new SAVING_MALLOC_HEAP flag.\n\+ \ \n\+ \ Ignore-this: 5f19fd33aa1f239b3d91c4dc587c022f\n\+ \ \n\+ \ darcs-hash:20130919151344-99646-6b9bcace2792bb440a9a6be27f294e055e1e15b1.gz\n\+ \\n\+ \commit b4681c21563a4d2bf49cf7d5ed1b50c426fd82cf\n\+ \Author: kiwamu <kiwamu@debian.or.jp>\n\+ \Date: Fri Sep 20 00:12:49 2013 +0900\n\+ \\n\+ \ Use cpphs, because gcc-4.8.1's cpp has error.\n\+ \ \n\+ \ Ignore-this: c4eda3e4cabfe4ec61288f9acc3916b4\n\+ \ \n\+ \ darcs-hash:20130919151249-99646-b3c366b55b398d83eaf158b74db1330c4ec8db99.gz\n\+ \\n\+ \commit d9c8f2e802b6703d196771603e10974baacfc553\n\+ \Author: John Meacham <john@repetae.net>\n\+ \Date: Mon Oct 21 13:14:21 2013 +0900\n\+ \\n\+ \ add explicit lib and rts/ license files\n\+ \ \n\+ \ Ignore-this: 780fc0a9acac2939da3f26f199ef64b4\n\+ \ \n\+ \ darcs-hash:20131021041421-1a7c6-b5ce5801bf7482a20dfddab9f3f894e8d837d110.gz\n\+ \\n\ \commit bb2db48f6c3cc9b00ef25f100630d47e5820bcdd\n\ \Author: Kiwamu Okabe <kiwamu@debian.or.jp>\n\ \Date: Sat Sep 7 12:38:58 2013 +0900\n\@@ -3002,7 +3235,7 @@ {-# NOINLINE shortchange_txt #-} shortchange_txt :: ByteString shortchange_txt = unsafePerformIO $ unsafePackAddress "\- \fdd05fe6aeec7d305a818b5a92c36fc2e1a5574c\+ \66a602abc10dec74e2c0bb9289819a015bf21e4f\ \"# -- | Generated from rts\/rts\/slub.c@@ -3411,20 +3644,22 @@ \static void s_cleanup_blocks(arena_t arena);\n\ \static struct s_block *get_free_block(gc_t gc, arena_t arena, bool retry);\n\ \static void *jhc_aligned_alloc(unsigned size);\n\+ \struct s_megablock *s_new_megablock(arena_t arena);\n\+ \void hs_foreignptr_env_helper(HsPtr env, HsPtr arg);\n\ \\n\ \static const void *nh_start, *nh_end;\n\ \\n\ \static bool\n\ \gc_check_heap(entry_t *s)\n\ \{\n\- \ return (s < (entry_t *)nh_start || s > (entry_t *)nh_end);\n\+ \ return (s < (const entry_t *)nh_start || s > (const entry_t *)nh_end);\n\ \}\n\ \\n\ \static void\n\ \stack_grow(struct stack *s, unsigned grow)\n\ \{\n\ \ s->size += grow;\n\- \ s->stack = realloc(s->stack, sizeof(s->stack[0])*s->size);\n\+ \ s->stack = (entry_t **) realloc(s->stack, sizeof(s->stack[0])*s->size);\n\ \ assert(s->stack);\n\ \ debugf(\"stack:\");\n\ \ for(unsigned i = 0; i < s->ptr; i++) {\n\@@ -3477,7 +3712,7 @@ \ if(1 && (P_LAZY == GET_PTYPE(e->ptrs[i]))) {\n\ \ VALGRIND_MAKE_MEM_DEFINED(FROM_SPTR(e->ptrs[i]), sizeof(uintptr_t));\n\ \ if(!IS_LAZY(GETHEAD(FROM_SPTR(e->ptrs[i])))) {\n\- \ *number_redirects++;\n\+ \ (*number_redirects)++;\n\ \ debugf(\" *\");\n\ \ e->ptrs[i] = (sptr_t)GETHEAD(FROM_SPTR(e->ptrs[i]));\n\ \ }\n\@@ -3639,7 +3874,6 @@ \ jhc_printf_stderr(\"arena: %p\\n\", arena);\n\ \ jhc_printf_stderr(\" block_used: %i\\n\", arena->block_used);\n\ \ jhc_printf_stderr(\" block_threshold: %i\\n\", arena->block_threshold);\n\- \ struct s_cache *sc;\n\ \ SLIST_FOREACH(sc,&arena->caches,next)\n\ \ print_cache(sc);\n\ \ }\n\@@ -3695,7 +3929,7 @@ \ b->u.m.num_ptrs = nptrs;\n\ \ SLIST_INSERT_HEAD(&arena->monolithic_blocks, b, link);\n\ \ b->used[0] = 1;\n\- \ return (void *)b + b->color*sizeof(uintptr_t);\n\+ \ return (void *)(b + b->color*sizeof(uintptr_t));\n\ \}\n\ \\n\ \// Allocate an array of count garbage collectable locations in the garbage\n\@@ -3825,7 +4059,7 @@ \ if(__predict_false(!arena->current_megablock))\n\ \ arena->current_megablock = s_new_megablock(arena);\n\ \ struct s_megablock *mb = arena->current_megablock;\n\- \ struct s_block *pg = mb->base + BLOCK_SIZE*mb->next_free;\n\+ \ struct s_block *pg = (struct s_block *)((char *)mb->base + BLOCK_SIZE*mb->next_free);\n\ \ mb->next_free++;\n\ \ if(mb->next_free == MEGABLOCK_SIZE / BLOCK_SIZE) {\n\ \ SLIST_INSERT_HEAD(&arena->megablocks,mb, next);\n\@@ -4651,14 +4885,14 @@ \char *jhc_progname;\n\ \\n\ \#ifdef __WIN32__\n\- \A_UNUSED char *jhc_options_os = \"mingw32\";\n\- \A_UNUSED char *jhc_options_arch = \"i386\";\n\+ \A_UNUSED const char *jhc_options_os = \"mingw32\";\n\+ \A_UNUSED const char *jhc_options_arch = \"i386\";\n\ \#elif defined(__ARM_EABI__)\n\- \A_UNUSED char *jhc_options_os = \"nds\";\n\- \A_UNUSED char *jhc_options_arch = \"ARM\";\n\+ \A_UNUSED const char *jhc_options_os = \"nds\";\n\+ \A_UNUSED const char *jhc_options_arch = \"ARM\";\n\ \#else\n\- \A_UNUSED char *jhc_options_os = \"(unknown os)\";\n\- \A_UNUSED char *jhc_options_arch = \"(unknown arch)\";\n\+ \A_UNUSED const char *jhc_options_os = \"(unknown os)\";\n\+ \A_UNUSED const char *jhc_options_arch = \"(unknown arch)\";\n\ \#endif\n\ \\n\ \void\n\@@ -4677,7 +4911,7 @@ \}\n\ \\n\ \void A_NORETURN A_UNUSED A_COLD\n\- \jhc_error(char *s) {\n\+ \jhc_error(const char *s) {\n\ \ jhc_fflush_stdout();\n\ \ jhc_fputs_stderr(s);\n\ \ jhc_fputs_stderr(\"\\n\");\n\@@ -4707,8 +4941,8 @@ \#if JHC_isPosix\n\ \ struct utsname jhc_utsname;\n\ \ if(!uname(&jhc_utsname)) {\n\- \ jhc_options_arch = jhc_utsname.machine;\n\- \ jhc_options_os = jhc_utsname.sysname;\n\+ \ jhc_options_arch = (const char *) jhc_utsname.machine;\n\+ \ jhc_options_os = (const char *) jhc_utsname.sysname;\n\ \ }\n\ \#endif\n\ \ setlocale(LC_ALL,\"\");\n\@@ -4739,8 +4973,8 @@ \#include \"rts/cdefs.h\"\n\ \\n\ \extern jmp_buf jhc_uncaught;\n\- \A_UNUSED extern char *jhc_options_os;\n\- \A_UNUSED extern char *jhc_options_arch;\n\+ \A_UNUSED extern const char *jhc_options_os;\n\+ \A_UNUSED extern const char *jhc_options_arch;\n\ \extern int jhc_argc;\n\ \extern char **jhc_argv;\n\ \extern char *jhc_progname;\n\@@ -4750,7 +4984,7 @@ \extern char jhc_version[];\n\ \\n\ \void A_NORETURN A_UNUSED A_COLD jhc_exit(int n);\n\- \void A_NORETURN A_UNUSED A_COLD jhc_error(char *s);\n\+ \void A_NORETURN A_UNUSED A_COLD jhc_error(const char *s);\n\ \void A_NORETURN A_UNUSED A_COLD jhc_case_fell_off(int n);\n\ \\n\ \#define jhc_setjmp(jb) setjmp(*(jb))\n\@@ -5512,19 +5746,19 @@ \static jhc_mutex_t jhc_rts_mutex;\n\ \\n\ \void\n\- \jhc_conc_init()\n\+ \jhc_conc_init(void)\n\ \{\n\ \ jhc_mutex_init(&jhc_rts_mutex);\n\ \}\n\ \\n\ \void\n\- \jhc_rts_lock()\n\+ \jhc_rts_lock(void)\n\ \{\n\ \ jhc_mutex_lock(&jhc_rts_mutex);\n\ \}\n\ \\n\ \void\n\- \jhc_rts_unlock()\n\+ \jhc_rts_unlock(void)\n\ \{\n\ \ jhc_mutex_unlock(&jhc_rts_mutex);\n\ \}\n\
src/StringTable/Atom.hsc view
@@ -83,7 +83,8 @@ instance ToAtom CStringLen where toAtomIO (cs,len) = do if (len > (#const MAX_ENTRY_SIZE))- then fail "StringTable: atom is too big"+ then do s <- peekCString cs+ fail $ "StringTable: atom is too big \"" ++ s ++ "\"" else stAdd cs (fromIntegral len) instance ToAtom CString where
src/StringTable/StringTable_cbits.h view
@@ -3,7 +3,7 @@ #include <stdint.h> -#define MAX_ENTRY_SIZE 256+#define MAX_ENTRY_SIZE 512 #define VALID_BITMASK 0x1 // always shift, then mask
src/Util/FilterInput.hs view
@@ -1,4 +1,4 @@-module Util.FilterInput (filterInput,readSystem,existCommand) where+module Util.FilterInput (filterInput,readSystem) where import Control.Monad (when) import Data.List@@ -24,8 +24,3 @@ when (rExit /= ExitSuccess) $ putErrDie (printf "'%s' exited abnormally (%s)" (intercalate " " (prog:args)) (show rExit)) return $ LBS.pack rStdout--existCommand :: String -> IO Bool-existCommand cmd = do- (rExit, _, _) <- readProcessWithExitCode "which" [cmd] ""- return $ if rExit == ExitSuccess then True else False
src/Util/Gen.hs view
@@ -6,6 +6,7 @@ import Data.List import Data.Maybe import System.Directory+import Control.Applicative import Text.ParserCombinators.ReadP import GenUtil hiding(replicateM, intercalate)@@ -36,12 +37,11 @@ shortenPath x@('/':_) = do cd <- getCurrentDirectory pwd <- lookupEnv "PWD"- h <- lookupEnv "HOME"+ h <- getHomeDirectory let f d = do- d <- d '/':rest <- getPrefix d x return rest- return $ fromJust $ f (return cd) `mplus` f pwd `mplus` liftM ("~/" ++) (f h) `mplus` return x+ return $ fromMaybe x $ f cd <|> (>>=f) pwd <|> liftM ("~/" ++) (f h) shortenPath x = return x maybeDo :: Monad m => Maybe (m a) -> (m ())
src/Version/Config.hs view
@@ -1,7 +1,7 @@ module Version.Config where shortVersion = "0.8"-version = "0.8.0.9"+version = "0.8.0.10" package = "ajhc" libdir = "/usr/local/lib" datadir = "/usr/local/share"
src/data/targets.ini view
@@ -26,7 +26,7 @@ ; cross compilation entries [win32]-cc=i386-mingw32-gcc+cc=i686-w64-mingw32-gcc executable_extension=.exe merge=i686