diff --git a/configure.ac b/configure.ac index d02a94a..3460926 100644 --- a/configure.ac +++ b/configure.ac @@ -4,7 +4,7 @@ # # sanity test -AC_INIT(src/plugins/Plugins.hs) +AC_INIT(src/plugins/System/Plugins.hs) # untested on earlier than 2.52, but it won't work anyway AC_PREREQ(2.53) diff --git a/src/Makefile b/src/Makefile index eba7346..5cdf520 100644 --- a/src/Makefile +++ b/src/Makefile @@ -2,10 +2,10 @@ # Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons # GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html) -.PHONY: all build altdata hi plugins eval printf -.PHONY: install i_altdata i_hi i_plugins i_eval i_printf +.PHONY: all build altdata hi plugins +.PHONY: install i_altdata i_hi i_plugins -build: altdata hi plugins eval printf +build: altdata hi plugins altdata: @cd altdata && $(MAKE) @@ -13,12 +13,8 @@ hi: @cd hi && $(MAKE) plugins: altdata hi @cd plugins && $(MAKE) -eval: plugins - @cd eval && $(MAKE) -printf: plugins - @cd printf && $(MAKE) -install: i_altdata i_hi i_plugins i_eval i_printf +install: i_altdata i_hi i_plugins @true i_altdata: @@ -27,10 +23,6 @@ i_hi: @cd hi && $(MAKE) install i_plugins: @cd plugins && $(MAKE) install -i_eval: - @cd eval && $(MAKE) install -i_printf: - @cd printf && $(MAKE) install all: build diff --git a/src/eval/Eval/Meta.hs b/src/eval/Eval/Meta.hs deleted file mode 100644 index 8f24510..0000000 --- a/src/eval/Eval/Meta.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# OPTIONS -cpp -fth #-} --- --- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons --- --- This library is free software; you can redistribute it and/or --- modify it under the terms of the GNU Lesser General Public --- License as published by the Free Software Foundation; either --- version 2.1 of the License, or (at your option) any later version. --- --- This library is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --- Lesser General Public License for more details. --- --- You should have received a copy of the GNU Lesser General Public --- License along with this library; if not, write to the Free Software --- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 --- USA --- - --- --- an implementation of the staged compilation primitives from --- "Dynamic Typing as Staged Type Inference" --- Shields, Sheard and Jones, 1998 --- http://doi.acm.org/10.1145/268946.268970 --- - -module Eval.Meta ( - - run, - defer, - splice, - - ) where - -import Eval.Haskell ( eval ) -import AltData.Typeable ( Typeable ) - -#if __GLASGOW_HASKELL__ > 602 -import Language.Haskell.TH ( ExpQ, pprint, runQ ) -#else -import Language.Haskell.THSyntax ( ExpQ, pprExp, runQ ) -import Text.PrettyPrint ( render ) -#endif - -import System.IO.Unsafe ( unsafePerformIO ) - -type ExpR = String -- hack for splicing - --- --- defer the evaluation of an expression by one stage. --- uses [| |] just for the nice syntax. --- --- defer [| 1 + 1 |] --> (1 + 1) --- -defer :: ExpQ -> ExpR -#if __GLASGOW_HASKELL__ > 602 -defer e = pprint (unsafePerformIO (runQ e)) -#else -defer e = render $ pprExp (unsafePerformIO (runQ e)) -#endif - --- --- evaluate 'e' to a deferred expression, and evaluate the result. --- --- run( defer [|1+1|] ) --> 2 --- -run :: (Show t, Typeable t) => ExpR -> t -run e = case unsafePerformIO (eval e imports) of - Nothing -> error "source failed to compile" - Just a -> a - --- --- evaluate 'e' to a deferred expression. then splice the result back in --- to the surrounding deferred expression. splice() is only legal within --- deferred expressions. --- --- let code = defer [| 1 + 1 |] in defer [| splice(code) + 2 |] --- --> --- defer [| 1 + 1 + 2 |] --- --- defer( "\x -> " ++ splice (v) ) --- -splice :: Show t => t -> ExpR -splice e = show e - --- --- libraries needed --- -imports = - [ - "GHC.Base", - "GHC.Num", - "GHC.List" - ] - diff --git a/src/eval/Makefile b/src/eval/Makefile deleted file mode 100644 index 46de68e..0000000 --- a/src/eval/Makefile +++ /dev/null @@ -1,18 +0,0 @@ -PKG = eval -UPKG = Eval - -ALL_SRCS=$(wildcard $(patsubst ./%, %, $(patsubst %, %/*.hs, . $(UPKG)))) - -STUBOBJS =Eval/Haskell_stub.$(way_)o - -TOP=../.. -include ../build.mk - -HC_OPTS += -package-conf $(TOP)/plugins.conf.inplace -HC_OPTS += -package plugins - -GHC6_3_HC_OPTS += -package template-haskell - -install: install-me - --include depend diff --git a/src/eval/eval.conf.in.cpp b/src/eval/eval.conf.in.cpp deleted file mode 100644 index eeb639e..0000000 --- a/src/eval/eval.conf.in.cpp +++ /dev/null @@ -1,60 +0,0 @@ -#if CABAL == 0 && GLASGOW_HASKELL < 604 -Package { - name = "eval", - auto = False, - hs_libraries = [ "HSeval" ], -#ifdef INSTALLING - import_dirs = [ "${LIBDIR}/imports" ], - library_dirs = [ "${LIBDIR}/" ], -#else - import_dirs = [ "${TOP}/src/eval" ], - library_dirs = [ "${TOP}/src/eval" ], -#endif - include_dirs = [], - c_includes = [], - source_dirs = [], - extra_libraries = [], - package_deps = [ "plugins" -#if GLASGOW_HASKELL >= 603 - , "template-haskell" -#endif - ], - extra_ghc_opts = [], - extra_cc_opts = [], - extra_ld_opts = [] -} -#else - -name: eval -version: 0.9.8 -license: LGPL -maintainer: dons@cse.unsw.edu.au -exposed: True -exposed-modules: - Eval.Haskell, - Eval.Meta, - Eval.Utils, - Eval - -hidden-modules: -#ifdef INSTALLING -import-dirs: LIBDIR/imports -library-dirs: LIBDIR -#else -import-dirs: TOP/src/eval -library-dirs: TOP/src/eval -#endif -hs-libraries: HSeval -extra-libraries: -include-dirs: -includes: -depends: plugins, template-haskell -hugs-options: -cc-options: -ld-options: -framework-dirs: -frameworks: -haddock-interfaces: -haddock-html: - -#endif diff --git a/src/hi/Hi.hs b/src/hi/Hi.hs deleted file mode 100644 index 9fe3069..0000000 --- a/src/hi/Hi.hs +++ /dev/null @@ -1,25 +0,0 @@ --- --- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons --- --- This library is free software; you can redistribute it and/or --- modify it under the terms of the GNU Lesser General Public --- License as published by the Free Software Foundation; either --- version 2.1 of the License, or (at your option) any later version. --- --- This library is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --- Lesser General Public License for more details. --- --- You should have received a copy of the GNU Lesser General Public --- License along with this library; if not, write to the Free Software --- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 --- USA --- - -module Hi ( - module Hi.Parser - ) where - -import Hi.Parser {-all-} - diff --git a/src/hi/Hi/Binary.hs b/src/hi/Language/Hi/Binary.hs similarity index 98% rename from src/hi/Hi/Binary.hs rename to src/hi/Language/Hi/Binary.hs index a265d7b..6b1edbf 100644 --- a/src/hi/Hi/Binary.hs +++ b/src/hi/Language/Hi/Binary.hs @@ -33,7 +33,7 @@ -- We never have to write stuff, so I've scrubbed all the put* code. -- -module Hi.Binary ( +module Language.Hi.Binary ( {-type-} Bin, {-class-} Binary(..), {-type-} BinHandle, @@ -69,8 +69,8 @@ module Hi.Binary ( -- import Hi.Utils -- ? -import Hi.FastMutInt -import Hi.FastString +import Language.Hi.FastMutInt +import Language.Hi.FastString #if __GLASGOW_HASKELL__ < 604 import Data.FiniteMap @@ -465,7 +465,7 @@ binaryInterfaceMagic = 0x1face :: Word32 getBinFileWithDict :: Binary a => FilePath -> IO a getBinFileWithDict file_path = do - bh <- Hi.Binary.readBinMem file_path + bh <- Language.Hi.Binary.readBinMem file_path -- Read the magic number to check that this really is a GHC .hi file -- (This magic number does not change when we change @@ -478,7 +478,7 @@ getBinFileWithDict file_path = do -- Read the dictionary -- The next word in the file is a pointer to where the dictionary is -- (probably at the end of the file) - dict_p <- Hi.Binary.get bh -- Get the dictionary ptr + dict_p <- Language.Hi.Binary.get bh -- Get the dictionary ptr data_p <- tellBin bh -- Remember where we are now seekBin bh dict_p dict <- getDictionary bh diff --git a/src/hi/Hi/FastMutInt.hs b/src/hi/Language/Hi/FastMutInt.hs similarity index 98% rename from src/hi/Hi/FastMutInt.hs rename to src/hi/Language/Hi/FastMutInt.hs index 4c3292e..39ea14d 100644 --- a/src/hi/Hi/FastMutInt.hs +++ b/src/hi/Language/Hi/FastMutInt.hs @@ -26,7 +26,7 @@ -- Unboxed mutable Ints -- -module Hi.FastMutInt ( +module Language.Hi.FastMutInt ( FastMutInt, newFastMutInt, readFastMutInt, diff --git a/src/hi/Hi/FastString.hs b/src/hi/Language/Hi/FastString.hs similarity index 99% rename from src/hi/Hi/FastString.hs rename to src/hi/Language/Hi/FastString.hs index 2eff02e..e156d9c 100644 --- a/src/hi/Hi/FastString.hs +++ b/src/hi/Language/Hi/FastString.hs @@ -31,7 +31,7 @@ -- unique identifiers (hash-cons'ish). -- -module Hi.FastString +module Language.Hi.FastString ( FastString(..), -- not abstract, for now. @@ -65,7 +65,7 @@ module Hi.FastString mkLitString# -- :: Addr# -> LitString ) where -import Hi.PrimPacked +import Language.Hi.PrimPacked import IO import Char ( chr, ord ) diff --git a/src/hi/Hi/Parser.hs b/src/hi/Language/Hi/Parser.hs similarity index 99% rename from src/hi/Hi/Parser.hs rename to src/hi/Language/Hi/Parser.hs index 6b1bb55..11c3ed4 100644 --- a/src/hi/Hi/Parser.hs +++ b/src/hi/Language/Hi/Parser.hs @@ -42,15 +42,15 @@ -module Hi.Parser ( readIface, module Hi.Syntax ) where +module Language.Hi.Parser ( readIface, module Language.Hi.Syntax ) where -import Hi.Syntax -import Hi.Binary -import Hi.FastString +import Language.Hi.Syntax +import Language.Hi.Binary +import Language.Hi.FastString import GHC.Word -#include "../../../config.h" +#include "../../../../config.h" -- --------------------------------------------------------------------------- -- how to get there from here diff --git a/src/hi/Hi/PrimPacked.hs b/src/hi/Language/Hi/PrimPacked.hs similarity index 99% rename from src/hi/Hi/PrimPacked.hs rename to src/hi/Language/Hi/PrimPacked.hs index ad8b87d..0b13c0b 100644 --- a/src/hi/Hi/PrimPacked.hs +++ b/src/hi/Language/Hi/PrimPacked.hs @@ -34,7 +34,7 @@ {-# OPTIONS -optc-DNON_POSIX_SOURCE #-} -module Hi.PrimPacked ( +module Language.Hi.PrimPacked ( Ptr(..), nullPtr, plusAddr#, BA(..), packString, -- :: String -> (Int, BA) diff --git a/src/hi/Hi/Syntax.hs b/src/hi/Language/Hi/Syntax.hs similarity index 99% rename from src/hi/Hi/Syntax.hs rename to src/hi/Language/Hi/Syntax.hs index e37f644..dbf64a6 100644 --- a/src/hi/Hi/Syntax.hs +++ b/src/hi/Language/Hi/Syntax.hs @@ -20,9 +20,9 @@ -- (c) The University of Glasgow 2002 -- -module Hi.Syntax where +module Language.Hi.Syntax where -import Hi.FastString +import Language.Hi.FastString import Data.List ( intersperse ) diff --git a/src/hi/Hi/hschooks.c b/src/hi/Language/Hi/hschooks.c similarity index 100% rename from src/hi/Hi/hschooks.c rename to src/hi/Language/Hi/hschooks.c diff --git a/src/hi/Hi/hschooks.h b/src/hi/Language/Hi/hschooks.h similarity index 100% rename from src/hi/Hi/hschooks.h rename to src/hi/Language/Hi/hschooks.h diff --git a/src/hi/Makefile b/src/hi/Makefile index f952dc0..d2438de 100644 --- a/src/hi/Makefile +++ b/src/hi/Makefile @@ -1,15 +1,15 @@ PKG = hi UPKG = Hi -CSRC = $(UPKG)/hschooks.c -COBJ = $(UPKG)/hschooks.o +CSRC = Language/$(UPKG)/hschooks.c +COBJ = Language/$(UPKG)/hschooks.o -ALL_SRCS=$(wildcard $(patsubst ./%, %, $(patsubst %, %/*.hs, . $(UPKG)))) +ALL_SRCS=$(wildcard $(patsubst ./%, %, $(patsubst %, %/*.hs, Language Language/$(UPKG)))) TOP=../.. include ../build.mk -HC_OPTS += -I$(UPKG) +HC_OPTS += -ILanguage/$(UPKG) install: install-me diff --git a/src/hi/hi.conf.in.cpp b/src/hi/hi.conf.in.cpp index bdea4b8..2c27b8e 100644 --- a/src/hi/hi.conf.in.cpp +++ b/src/hi/hi.conf.in.cpp @@ -26,15 +26,15 @@ license: BSD3 maintainer: libraries@haskell.org exposed: True exposed-modules: - Hi.Binary, - Hi.FastMutInt, - Hi.FastString, - Hi.Parser, - Hi.PrimPacked, - Hi.Syntax, - Hi + Language.Hi.Parser hidden-modules: + Language.Hi.Binary, + Language.Hi.FastString, + Language.Hi.Syntax, + Language.Hi.FastMutInt, + Language.Hi.PrimPacked + #ifdef INSTALLING import-dirs: LIBDIR/imports library-dirs: LIBDIR diff --git a/src/plugins/Makefile b/src/plugins/Makefile index b0e0c72..f063caf 100644 --- a/src/plugins/Makefile +++ b/src/plugins/Makefile @@ -5,18 +5,20 @@ TOP=../.. include $(TOP)/config.mk ifeq ($(CABAL),1) -YOBJ = $(UPKG)/ParsePkgConfCabal.hs -YSRC = $(UPKG)/ParsePkgConfCabal.y -OTHER = $(UPKG)/ParsePkgConfLite.hs +YOBJ = System/$(UPKG)/ParsePkgConfCabal.hs +YSRC = System/$(UPKG)/ParsePkgConfCabal.y +OTHER = System/$(UPKG)/ParsePkgConfLite.hs else -YOBJ = $(UPKG)/ParsePkgConfLite.hs -YSRC = $(UPKG)/ParsePkgConfLite.y -OTHER = $(UPKG)/ParsePkgConfCabal.hs +YOBJ = System/$(UPKG)/ParsePkgConfLite.hs +YSRC = System/$(UPKG)/ParsePkgConfLite.y +OTHER = System/$(UPKG)/ParsePkgConfCabal.hs endif +STUBOBJS =System/Eval/Haskell_stub.$(way_)o + ALL_SRCS= $(filter-out $(OTHER), \ $(wildcard $(patsubst ./%, %, \ - $(patsubst %, %/*.hs, . $(UPKG))))) + $(patsubst %, %/*.hs, System System/$(UPKG))))) include ../build.mk diff --git a/src/eval/Eval.hs b/src/plugins/System/Eval.hs similarity index 86% rename from src/eval/Eval.hs rename to src/plugins/System/Eval.hs index 9a6e9e7..2c5d6a3 100644 --- a/src/eval/Eval.hs +++ b/src/plugins/System/Eval.hs @@ -17,11 +17,9 @@ -- USA -- -module Eval ( - module Eval.Haskell, - module Eval.Meta, +module System.Eval ( + module System.Eval.Haskell, ) where -import Eval.Haskell {-all-} -import Eval.Meta {-all-} +import System.Eval.Haskell {-all-} diff --git a/src/eval/Eval/Haskell.hs b/src/plugins/System/Eval/Haskell.hs similarity index 98% rename from src/eval/Eval/Haskell.hs rename to src/plugins/System/Eval/Haskell.hs index 5719677..a9cfa20 100644 --- a/src/eval/Eval/Haskell.hs +++ b/src/plugins/System/Eval/Haskell.hs @@ -22,7 +22,7 @@ -- compile and run haskell strings at runtime. -- -module Eval.Haskell ( +module System.Eval.Haskell ( eval, eval_, unsafeEval, @@ -34,14 +34,13 @@ module Eval.Haskell ( hs_eval_i, -- return a CInt hs_eval_s, -- return a CString - module Eval.Utils, + module System.Eval.Utils, ) where -import Eval.Utils - -import Plugins.Make -import Plugins.Load +import System.Eval.Utils +import System.Plugins.Make +import System.Plugins.Load import AltData.Dynamic import AltData.Typeable ( Typeable ) diff --git a/src/eval/Eval/Utils.hs b/src/plugins/System/Eval/Utils.hs similarity index 95% rename from src/eval/Eval/Utils.hs rename to src/plugins/System/Eval/Utils.hs index 828e4c8..5a88263 100644 --- a/src/eval/Eval/Utils.hs +++ b/src/plugins/System/Eval/Utils.hs @@ -22,7 +22,7 @@ -- compile and run haskell strings at runtime. -- -module Eval.Utils ( +module System.Eval.Utils ( Import, symbol, @@ -38,9 +38,9 @@ module Eval.Utils ( ) where -import Plugins.Load ( Symbol ) -import Plugins.Utils -import Plugins.Consts ( top {- :{ -} ) +import System.Plugins.Load ( Symbol ) +import System.Plugins.Utils +import System.Plugins.Consts ( top {- :{ -} ) import System.IO import System.Directory diff --git a/src/plugins/Plugins/MkTemp.hs b/src/plugins/System/MkTemp.hs similarity index 99% rename from src/plugins/Plugins/MkTemp.hs rename to src/plugins/System/MkTemp.hs index 523147b..6613453 100644 --- a/src/plugins/Plugins/MkTemp.hs +++ b/src/plugins/System/MkTemp.hs @@ -27,7 +27,7 @@ -- which are available under the BSD license. -- -module Plugins.MkTemp ( +module System.MkTemp ( mktemp, -- :: FilePath -> IO Maybe FilePath mkstemp, -- :: FilePath -> IO Maybe (FilePath, Handle) diff --git a/src/plugins/Plugins.hs b/src/plugins/System/Plugins.hs similarity index 84% rename from src/plugins/Plugins.hs rename to src/plugins/System/Plugins.hs index 08d0617..2f4e603 100644 --- a/src/plugins/Plugins.hs +++ b/src/plugins/System/Plugins.hs @@ -17,17 +17,17 @@ -- USA -- -module Plugins ( +module System.Plugins ( -- $Description - module Plugins.Make, - module Plugins.Load, + module System.Plugins.Make, + module System.Plugins.Load, ) where -import Plugins.Make {-all-} -import Plugins.Load {-all-} +import System.Plugins.Make {-all-} +import System.Plugins.Load {-all-} -- -- $Description diff --git a/src/plugins/Plugins/Consts.hs b/src/plugins/System/Plugins/Consts.hs similarity index 97% rename from src/plugins/Plugins/Consts.hs rename to src/plugins/System/Plugins/Consts.hs index d539b4e..fbad2a1 100644 --- a/src/plugins/Plugins/Consts.hs +++ b/src/plugins/System/Plugins/Consts.hs @@ -18,9 +18,9 @@ -- USA -- -module Plugins.Consts where +module System.Plugins.Consts where -#include "../../../config.h" +#include "../../../../config.h" #if __GLASGOW_HASKELL__ >= 604 diff --git a/src/plugins/Plugins/Env.hs b/src/plugins/System/Plugins/Env.hs similarity index 97% rename from src/plugins/Plugins/Env.hs rename to src/plugins/System/Plugins/Env.hs index 74e4172..0fc75da 100644 --- a/src/plugins/Plugins/Env.hs +++ b/src/plugins/System/Plugins/Env.hs @@ -18,7 +18,7 @@ -- USA -- -module Plugins.Env ( +module System.Plugins.Env ( withModEnv, withPkgEnvs, withMerged, @@ -41,15 +41,15 @@ module Plugins.Env ( ) where -#include "../../../config.h" +#include "../../../../config.h" -import Plugins.PackageAPI {- everything -} +import System.Plugins.PackageAPI {- everything -} #if CABAL == 1 || __GLASGOW_HASKELL__ >= 604 -import Plugins.ParsePkgConfCabal( parsePkgConf ) +import System.Plugins.ParsePkgConfCabal( parsePkgConf ) #else -import Plugins.ParsePkgConfLite ( parsePkgConf ) +import System.Plugins.ParsePkgConfLite ( parsePkgConf ) #endif -import Plugins.Consts ( ghcLibraryPath, sysPkgConf, sysPkgSuffix, dllSuf ) +import System.Plugins.Consts ( ghcLibraryPath, sysPkgConf, sysPkgSuffix, dllSuf ) import Data.IORef ( writeIORef, readIORef, newIORef, IORef() ) import Data.Maybe ( isJust ) diff --git a/src/plugins/Plugins/Load.hs b/src/plugins/System/Plugins/Load.hs similarity index 98% rename from src/plugins/Plugins/Load.hs rename to src/plugins/System/Plugins/Load.hs index 0e0a580..e8554c1 100644 --- a/src/plugins/Plugins/Load.hs +++ b/src/plugins/System/Plugins/Load.hs @@ -19,7 +19,7 @@ -- USA -- -module Plugins.Load ( +module System.Plugins.Load ( -- high level interface load , load_ @@ -47,12 +47,12 @@ module Plugins.Load ( ) where -import Plugins.Make ( build ) -import Plugins.Env -import Plugins.Utils -import Plugins.Consts ( sysPkgSuffix, hiSuf, prefixUnderscore ) +import System.Plugins.Make ( build ) +import System.Plugins.Env +import System.Plugins.Utils +import System.Plugins.Consts ( sysPkgSuffix, hiSuf, prefixUnderscore ) -import Hi.Parser +import Language.Hi.Parser import AltData.Dynamic ( fromDyn, Dynamic ) import AltData.Typeable ( Typeable ) diff --git a/src/plugins/Plugins/Make.hs b/src/plugins/System/Plugins/Make.hs similarity index 97% rename from src/plugins/Plugins/Make.hs rename to src/plugins/System/Plugins/Make.hs index 981e8d5..278df39 100644 --- a/src/plugins/Plugins/Make.hs +++ b/src/plugins/System/Plugins/Make.hs @@ -18,7 +18,7 @@ -- USA -- -module Plugins.Make ( +module System.Plugins.Make ( make, makeAll, @@ -39,10 +39,10 @@ module Plugins.Make ( ) where -import Plugins.Utils -import Plugins.Parser -import Plugins.Consts ( ghc, hiSuf, objSuf, hsSuf ) -import Plugins.Env ( lookupMerged, addMerge ) +import System.Plugins.Utils +import System.Plugins.Parser +import System.Plugins.Consts ( ghc, hiSuf, objSuf, hsSuf ) +import System.Plugins.Env ( lookupMerged, addMerge ) import System.IO import System.Directory ( doesFileExist, removeFile ) diff --git a/src/plugins/Plugins/Package.hs b/src/plugins/System/Plugins/Package.hs similarity index 97% rename from src/plugins/Plugins/Package.hs rename to src/plugins/System/Plugins/Package.hs index 93647ac..815bd8d 100644 --- a/src/plugins/Plugins/Package.hs +++ b/src/plugins/System/Plugins/Package.hs @@ -20,7 +20,7 @@ -- Read information from a package.conf -- -module Plugins.Package {-everything-} where +module System.Plugins.Package {-everything-} where type PackageName = String diff --git a/src/plugins/Plugins/PackageAPI.hs b/src/plugins/System/Plugins/PackageAPI.hs similarity index 96% rename from src/plugins/Plugins/PackageAPI.hs rename to src/plugins/System/Plugins/PackageAPI.hs index aa821c7..6eb37f6 100644 --- a/src/plugins/Plugins/PackageAPI.hs +++ b/src/plugins/System/Plugins/PackageAPI.hs @@ -22,7 +22,7 @@ -- to handle either traditional or Cabal style package conf`s. -- -module Plugins.PackageAPI ( +module System.Plugins.PackageAPI ( PackageName , PackageConfig , packageName @@ -36,13 +36,13 @@ module Plugins.PackageAPI ( , updLibraryDirs ) where -#include "../../../config.h" +#include "../../../../config.h" #if CABAL == 1 || __GLASGOW_HASKELL__ >= 604 import Distribution.InstalledPackageInfo import Distribution.Package #else -import Plugins.Package +import System.Plugins.Package #endif packageName :: PackageConfig -> PackageName diff --git a/src/plugins/Plugins/ParsePkgConfCabal.hs b/src/plugins/System/Plugins/ParsePkgConfCabal.hs similarity index 99% rename from src/plugins/Plugins/ParsePkgConfCabal.hs rename to src/plugins/System/Plugins/ParsePkgConfCabal.hs index f9a7329..0ba1339 100644 --- a/src/plugins/Plugins/ParsePkgConfCabal.hs +++ b/src/plugins/System/Plugins/ParsePkgConfCabal.hs @@ -3,7 +3,7 @@ -module Plugins.ParsePkgConfCabal ( +module System.Plugins.ParsePkgConfCabal ( parsePkgConf, parseOnePkgConf ) where @@ -515,7 +515,7 @@ parseOnePkgConf = parseOne . lexer {-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "GenericTemplate.hs" #-} --- $Id: ParsePkgConfCabal.hs,v 1.1 2005/04/22 08:58:28 dons Exp $ +-- $Id$ {-# LINE 28 "GenericTemplate.hs" #-} diff --git a/src/plugins/Plugins/ParsePkgConfCabal.y b/src/plugins/System/Plugins/ParsePkgConfCabal.y similarity index 99% rename from src/plugins/Plugins/ParsePkgConfCabal.y rename to src/plugins/System/Plugins/ParsePkgConfCabal.y index 2c11a77..022cdb4 100644 --- a/src/plugins/Plugins/ParsePkgConfCabal.y +++ b/src/plugins/System/Plugins/ParsePkgConfCabal.y @@ -31,7 +31,7 @@ { {-# OPTIONS -w #-} -module Plugins.ParsePkgConfCabal ( +module System.Plugins.ParsePkgConfCabal ( parsePkgConf, parseOnePkgConf ) where diff --git a/src/plugins/Plugins/ParsePkgConfLite.hs b/src/plugins/System/Plugins/ParsePkgConfLite.hs similarity index 99% rename from src/plugins/Plugins/ParsePkgConfLite.hs rename to src/plugins/System/Plugins/ParsePkgConfLite.hs index 6f75df7..661d5d1 100644 --- a/src/plugins/Plugins/ParsePkgConfLite.hs +++ b/src/plugins/System/Plugins/ParsePkgConfLite.hs @@ -3,11 +3,11 @@ -module Plugins.ParsePkgConfLite ( +module System.Plugins.ParsePkgConfLite ( parsePkgConf, parseOnePkgConf ) where -import Plugins.Package ( PackageConfig(..), defaultPackageConfig ) +import System.Plugins.Package ( PackageConfig(..), defaultPackageConfig ) import Char ( isSpace, isAlpha, isAlphaNum, isUpper ) import List ( break ) diff --git a/src/plugins/Plugins/ParsePkgConfLite.y b/src/plugins/System/Plugins/ParsePkgConfLite.y similarity index 97% rename from src/plugins/Plugins/ParsePkgConfLite.y rename to src/plugins/System/Plugins/ParsePkgConfLite.y index 08b2e24..87bf207 100644 --- a/src/plugins/Plugins/ParsePkgConfLite.y +++ b/src/plugins/System/Plugins/ParsePkgConfLite.y @@ -28,11 +28,11 @@ {-# OPTIONS -w #-} -module Plugins.ParsePkgConfLite ( +module System.Plugins.ParsePkgConfLite ( parsePkgConf, parseOnePkgConf ) where -import Plugins.Package ( PackageConfig(..), defaultPackageConfig ) +import System.Plugins.Package ( PackageConfig(..), defaultPackageConfig ) import Char ( isSpace, isAlpha, isAlphaNum, isUpper ) import List ( break ) diff --git a/src/plugins/Plugins/Parser.hs b/src/plugins/System/Plugins/Parser.hs similarity index 99% rename from src/plugins/Plugins/Parser.hs rename to src/plugins/System/Plugins/Parser.hs index 6ba0830..40ebcea 100644 --- a/src/plugins/Plugins/Parser.hs +++ b/src/plugins/System/Plugins/Parser.hs @@ -18,7 +18,7 @@ -- 02111-1307, USA. -- -module Plugins.Parser ( +module System.Plugins.Parser ( parse, mergeModules, pretty, parsePragmas, HsModule(..) , replaceModName diff --git a/src/plugins/Plugins/Utils.hs b/src/plugins/System/Plugins/Utils.hs similarity index 97% rename from src/plugins/Plugins/Utils.hs rename to src/plugins/System/Plugins/Utils.hs index 446b101..09f3bf1 100644 --- a/src/plugins/Plugins/Utils.hs +++ b/src/plugins/System/Plugins/Utils.hs @@ -18,9 +18,9 @@ -- USA -- -#include "../../../config.h" +#include "../../../../config.h" -module Plugins.Utils ( +module System.Plugins.Utils ( Arg, hWrite, @@ -55,9 +55,9 @@ module Plugins.Utils ( ) where -import Plugins.Env ( isLoaded ) -import Plugins.Consts ( objSuf, hiSuf, tmpDir ) -import qualified Plugins.MkTemp ( mkstemps ) +import System.Plugins.Env ( isLoaded ) +import System.Plugins.Consts ( objSuf, hiSuf, tmpDir ) +import qualified System.MkTemp ( mkstemps ) import Data.Char import Data.List @@ -104,7 +104,7 @@ hWrite hdl src = hPutStr hdl src >> hClose hdl >> return () mkstemps :: String -> Int -> IO (String,Handle) mkstemps path slen = do - m_v <- Plugins.MkTemp.mkstemps path slen + m_v <- System.MkTemp.mkstemps path slen case m_v of Nothing -> error "mkstemps : couldn't create temp file" Just v' -> return v' diff --git a/src/plugins/plugins.conf.in.cpp b/src/plugins/plugins.conf.in.cpp index d35891a..dc1f728 100644 --- a/src/plugins/plugins.conf.in.cpp +++ b/src/plugins/plugins.conf.in.cpp @@ -28,18 +28,24 @@ license: LGPL maintainer: dons@cse.unsw.edu.au exposed: True exposed-modules: - Plugins.Consts, - Plugins.Env, - Plugins.Load, - Plugins.Make, - Plugins.MkTemp, - Plugins.PackageAPI, - Plugins.ParsePkgConfCabal, - Plugins.Parser, - Plugins.Utils, - Plugins + System.Plugins.Load, + System.Plugins.Make, + System.Plugins, + System.MkTemp, + System.Eval.Haskell, + System.Eval hidden-modules: + System.Plugins.Consts, + System.Plugins.Env, + System.Plugins.Package, + System.Plugins.PackageAPI, + System.Plugins.ParsePkgConfCabal, + System.Plugins.ParsePkgConfLite, + System.Plugins.Parser, + System.Plugins.Utils, + System.Eval.Utils + #ifdef INSTALLING import-dirs: LIBDIR/imports library-dirs: LIBDIR diff --git a/src/printf/Makefile b/src/printf/Makefile deleted file mode 100644 index 3eda98b..0000000 --- a/src/printf/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -PKG = printf -UPKG = Printf - -YOBJ = $(UPKG)/Parser.hs -YSRC = $(UPKG)/Parser.y - -XOBJ = $(UPKG)/Lexer.hs -XSRC = $(UPKG)/Lexer.x - -ALL_SRCS=$(wildcard $(patsubst ./%, %, $(patsubst %, %/*.hs, . $(UPKG)))) - -TOP=../.. -include ../build.mk - -HC_OPTS += -package-conf $(TOP)/plugins.conf.inplace -HC_OPTS += -package eval - -install: install-me - --include depend diff --git a/src/printf/Printf.hs b/src/printf/Printf.hs deleted file mode 100644 index d83d4a2..0000000 --- a/src/printf/Printf.hs +++ /dev/null @@ -1,25 +0,0 @@ --- --- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons --- --- This library is free software; you can redistribute it and/or --- modify it under the terms of the GNU Lesser General Public --- License as published by the Free Software Foundation; either --- version 2.1 of the License, or (at your option) any later version. --- --- This library is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --- Lesser General Public License for more details. --- --- You should have received a copy of the GNU Lesser General Public --- License along with this library; if not, write to the Free Software --- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 --- USA --- - -module Printf ( - module Printf.Compile - ) where - -import Printf.Compile {-all-} - diff --git a/src/printf/Printf/Compile.hs b/src/printf/Printf/Compile.hs deleted file mode 100644 index 42a1871..0000000 --- a/src/printf/Printf/Compile.hs +++ /dev/null @@ -1,390 +0,0 @@ -{-# OPTIONS -fglasgow-exts #-} --- --- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons --- --- This library is free software; you can redistribute it and/or --- modify it under the terms of the GNU Lesser General Public --- License as published by the Free Software Foundation; either --- version 2.1 of the License, or (at your option) any later version. --- --- This library is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --- Lesser General Public License for more details. --- --- You should have received a copy of the GNU Lesser General Public --- License along with this library; if not, write to the Free Software --- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 --- USA --- - --- --- compile and run haskell strings at runtime. --- --- Some of the backend code is based on Ian Lynagh's TH version of --- Printf. --- --- The specification of this implementation is taken from --- the OpenBSD 3.5 man page for printf(3) --- - -module Printf.Compile ( - printf, - (!), - ($>), ($<), - ) where - -import Printf.Lexer -import Printf.Parser - -import Eval.Haskell ( eval ) -import Eval.Utils ( escape ) -import Plugins.Utils ( (<>), (<+>) ) - -import AltData.Dynamic -import AltData.Typeable hiding ( typeOf ) - -import Data.List -import Data.Maybe ( isNothing, isJust ) - -import System.IO.Unsafe ( unsafePerformIO ) - -type Type = String -type Code = String - --- --------------------------------------------------------------------- --- --- Generate a new Haskell function, as compiled native-code, from a --- printf format string. It isn't applied to its arguments yet. --- The function will return a String, but we won't typecheck this till --- application. --- -printf :: String -> Dynamic -- ([Dynamic] -> String) -printf fmt = run src ["Data.Char","Numeric"] - where - src = compile . parse . scan' . escape $ fmt - scan' s = either (error "lexer failed") (id) (scan s) - - run e i = case unsafePerformIO (eval e i) of - Nothing -> error "source failed to compile" - Just a -> a - --- --- application shortcuts. these expect all arguments to be supplied, and --- if this is so, we can then give the result a type. --- partial application means type annotations, or retaining everything --- as a Dynamic --- - --- --- sprintf --- Apply a new fn to a arg list, returning a String --- -infixr 0 $< -($<) :: Dynamic -> [Dynamic] -> String -f $< as = fromDynamic $! f `dynAppHList` as - --- --- printf --- Apply a new fn to a arg list, printing out the result --- -infixr 0 $> -($>) :: Dynamic -> [Dynamic] -> IO () -f $> as = putStr (fromDynamic $! f `dynAppHList` as) - --- --------------------------------------------------------------------- --- a printf code generator --- --- ToDo handle all the different specifiers --- --- Compile a printf format syntax tree into a Haskell string --- representing a Haskell function to implement this printf. --- -compile :: [Format] -> String -compile fmt = - let (tys,src) = compile' fmt 0 - in "toDyn $ \\" <> - spacify (map (\(ty,i) -> parens('x':show i <+> "::" <+> ty)) - (zip tys [0..length src])) <+> "->" <+> consify src - - where spacify s = concat (intersperse " " s) - consify s = concat (intersperse "++" s) - --- --------------------------------------------------------------------- --- --- Compile an individual format or string literal - -compile' :: [Format] -> Int -> ([String],[String]) -compile' [] _ = ([],[]) - -compile' ((StrLit s):xs) i = ( ts, ( '"':s++"\"" ):ss ) - where (ts,ss) = compile' xs i - -compile' ((ConvSp _ _ _ _ Percent):xs) i = (ts, "\"%\"":ss) - where (ts,ss) = compile' xs $! i+1 - -compile' (c@(ConvSp _ _ _ _ t):xs) i = - (typeOf t:ts, parens( - (snd.plus.pad.alt.trunc.codeOf) c -- apply transformations - <+> ident i) : ss) - - where (ts, ss) = compile' xs $! i+1 - --- --------------------------------------------------------------------- --- --- What argument type does a conversion specifier generate? --- should be a FM --- -typeOf :: Conv -> Type -typeOf x = case x of - D -> "Int" - O -> "Int" - Xx -> "Int" - XX -> "Int" - U -> "Int" - C -> "Char" - S -> "String" - F -> "Double" - Ee -> "Double" - EE -> "Double" - Gg -> "Double" - GG -> "Double" - Percent -> error "typeOf %: conversion specifier has no argument type" - --- --------------------------------------------------------------------- --- --- Generate Haskell code for each particular format --- -codeOf :: Format -> (Format,Code) -codeOf c@(ConvSp _ _ p _ f) = case f of - --- diouxX The int (or appropriate variant) argument is converted to signed --- decimal (d and i), unsigned octal (o), unsigned decimal (u), or --- unsigned hexadecimal (x and X) notation. The letters abcdef are --- used for x conversions; the letters ABCDEF are used for X conver- --- sions. The precision, if any, gives the minimum number of digits --- that must appear; if the converted value requires fewer digits, --- it is padded on the left with zeros. - - D -> (c,"(show)") - U -> (c,"(show)") - O -> (c,"(\\v -> showOct v [])") - Xx -> (c,"(\\v -> showHex v [])") - XX -> (c,"(\\v -> map toUpper (showHex v []))") - --- eE The double argument is rounded and converted in the style --- [-]d.ddde+-dd where there is one digit before the decimal-point --- character and the number of digits after it is equal to the pre- --- cision; if the precision is missing, it is taken as 6; if the --- precision is zero, no decimal-point character appears. An E con- --- version uses the letter E (rather than e) to introduce the expo- --- nent. The exponent always contains at least two digits; if the --- value is zero, the exponent is 00. - --- TODO prints exponent differently to printf(3) - - Ee -> let prec = if isNothing p then "Just 6" else show p - in (c,"(\\v->(showEFloat("++prec++")v)[])") - - EE -> let prec = if isNothing p then "Just 6" else show p - in (c,"(\\v->map toUpper((showEFloat ("++prec++")v)[]))") - --- gG The double argument is converted in style f or e (or E for G con- --- versions). The precision specifies the number of significant --- digits. If the precision is missing, 6 digits are given; if the --- precision is zero, it is treated as 1. Style e is used if the --- exponent from its conversion is less than -4 or greater than or --- equal to the precision. Trailing zeros are removed from the --- fractional part of the result; a decimal point appears only if it --- is followed by at least one digit. - --- TODO unimplemented - - Gg -> let prec = if isNothing p then "Just 6" else show p - in (c,"(\\v->(showGFloat("++prec++")v)[])") - - GG -> let prec = if isNothing p then "Just 6" else show p - in (c,"(\\v->map toUpper((showGFloat ("++prec++")v)[]))") - --- f The double argument is rounded and converted to decimal notation --- in the style [-]ddd.ddd, where the number of digits after the --- decimal-point character is equal to the precision specification. --- If the precision is missing, it is taken as 6; if the precision --- is explicitly zero, no decimal-point character appears. If a --- decimal point appears, at least one digit appears before it. - - F -> let prec = if isNothing p then "Just 6" else show p - in (c, "(\\v -> (showFFloat ("++prec++") v) [])") - --- c The int argument is converted to an unsigned char, and the re- --- sulting character is written. - - C -> (c,"(\\c -> (showLitChar c) [])") - --- s The char * argument is expected to be a pointer to an array of --- character type (pointer to a string). Characters from the array --- are written up to (but not including) a terminating NUL charac- --- ter; if a precision is specified, no more than the number speci- --- fied are written. If a precision is given, no null character --- need be present; if the precision is not specified, or is greater --- than the size of the array, the array must contain a terminating --- NUL character. - - S -> (c,"(id)") - --- % A `%' is written. No argument is converted. The complete con- --- version specification is `%%'. - - Percent -> (c,"%") - -codeOf _ = error "codeOf: unknown conversion specifier" - --- --------------------------------------------------------------------- --- --- Do we need a leading + ? --- --- A `+' character specifying that a sign always be placed before a --- number produced by a signed conversion. A `+' overrides a space --- if both are used. --- -plus :: (Format, Code) -> (Format, Code) -plus p@(StrLit _,_) = p -plus a@(c@(ConvSp fs _w _ _ x), code) = case x of - D -> prefix - Ee-> prefix - EE-> prefix - Gg-> prefix - GG-> prefix - F -> prefix - _ -> a - - where prefix = let pref | Signed `elem` fs = "\"+\"" - | Space `elem` fs = "\" \"" - | otherwise = "[]" - in (c,parens("\\v ->"<+>pref<+>"++ v") <$> code) - - {- munge = case w of - Just w' | w' > 0 -> "tail" - _ -> "" -} - --- --------------------------------------------------------------------- --- Work out padding. --- --- A negative field width flag `-' indicates the converted value is --- to be left adjusted on the field boundary. Except for n conver- --- sions, the converted value is padded on the right with blanks, --- rather than on the left with blanks or zeros. A `-' overrides a --- `0' if both are given. --- --- A zero `0' character specifying zero padding. For all conver- --- sions except n, the converted value is padded on the left with --- zeros rather than blanks. If a precision is given with a numeric --- conversion (d, i, o, u, x, and X), the `0' flag is ignored. --- -pad :: (Format,Code) -> (Format,Code) -pad (c@(ConvSp fs (Just w) p _ x),code) - - | LeftAdjust `elem` fs - = (c, parens(parens("\\i c s -> if length s < i"<+> - "then s ++ take (i-length s) (repeat c) else s") - <+>show w<+>"' '")<$>code ) - - | otherwise - = (c, parens(parens("\\i c s -> if length s < i"<+> - "then take (i-length s) (repeat c) ++ s else s") - <+>show w<+>pad_chr)<$>code) - - where pad_chr | isNumeric x && isJust p = "' '" - | LeadZero `elem` fs = "'0'" - | otherwise = "' '" - -pad (c@(ConvSp _ Nothing _ _ _),code) = (c,code) - -pad ((StrLit _),_) = error "pad: can't pad str lit" - -isNumeric :: Conv -> Bool -isNumeric x = case x of - D -> True - O -> True - U -> True - Xx -> True - XX -> True - _ -> False - --- --------------------------------------------------------------------- --- --- Check the 'alternate' modifier --- --- A hash `#' character specifying that the value should be convert- --- ed to an ``alternate form''. For c, d, i, n, p, s, and u conver- --- sions, this option has no effect. For o conversions, the preci- --- sion of the number is increased to force the first character of --- the output string to a zero (except if a zero value is printed --- with an explicit precision of zero). For x and X conversions, a --- non-zero result has the string `0x' (or `0X' for X conversions) --- prepended to it. For e, E, f, g, and G conversions, the result --- will always contain a decimal point, even if no digits follow it --- (normally, a decimal point appears in the results of those con- --- versions only if a digit follows). For g and G conversions, --- trailing zeros are not removed from the result as they would oth- --- erwise be. --- - -alt :: (Format,Code) -> (Format,Code) -alt a@(c@(ConvSp fs _ _ _ x), code) | Alt `elem` fs = case x of - - Xx -> (c,parens("\\v->if fst (head (readHex v)) /= 0"<+> - "then \"0x\"++v else v")<$>code) - - XX -> (c,parens("\\v->if fst (head (readHex v)) /= 0"<+> - "then \"0X\"++v else v")<$>code) - - O -> (c,parens("\\v->if fst(head(readOct v)) /= 0"<+> - "then \"0\"++v else v")<$>code) - _ -> a - -alt a = a - --- --------------------------------------------------------------------- --- --- Handle precision. Involves truncating strings and decimal points --- --- An optional precision, in the form of a period `.' followed by an op- --- tional digit string. If the digit string is omitted, the precision --- is taken as zero. This gives the minimum number of digits to appear --- for d, i, o, u, x, and X conversions, the number of digits to appear --- after the decimal-point for e, E, and f conversions, the maximum num- --- ber of significant digits for g and G conversions, or the maximum --- number of characters to be printed from a string for s conversions. --- -trunc :: (Format,Code) -> (Format,Code) -trunc (c@(ConvSp _ _ (Just i) _ x), code) = case x of - S -> (c, parens("(\\i s -> if length s > i"<+> - "then take i s else s)"<+>show i)<$>code) - - _ | isNumeric x -> {-TODO-} (c, code) - | otherwise -> (c, code) - -trunc c = c - --- --------------------------------------------------------------------- --- make a new variable -ident i = 'x':show i - --- wrap in parens -parens p = "("++p++")" - --- lazy operator -infixr 6 <$> -(<$>) :: String -> String -> String -[] <$> a = a -a <$> b = a ++ " $ " ++ b - --- --------------------------------------------------------------------- --- --- This bit of syntax constructs a [Dynamic]. --- -infixr 6 ! -(!) :: Typeable a => a -> [Dynamic] -> [Dynamic] -a ! xs = toDyn a : xs - diff --git a/src/printf/Printf/Lexer.hs b/src/printf/Printf/Lexer.hs deleted file mode 100644 index 171fb53..0000000 --- a/src/printf/Printf/Lexer.hs +++ /dev/null @@ -1,407 +0,0 @@ -{-# OPTIONS -fglasgow-exts -cpp #-} -{-# LINE 25 "Printf/Lexer.x" #-} - -{-# OPTIONS -w #-} --- ^ don't want to see all the warns alex templates produce - -module Printf.Lexer ( scan, Token(..) ) where - - -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -import Data.Char (ord) -import Data.Array.Base (unsafeAt) -#else -import Array -import Char (ord) -#endif -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif -alex_base :: AlexAddr -alex_base = AlexA# "\xf7\xff\xe2\xff\xef\xff\xf9\xff\x04\x00\x00\x00\xe6\xff\xfa\xff\x00\x00\x00\x00\x00\x00"# - -alex_table :: AlexAddr -alex_table = AlexA# "\x00\x00\xff\xff\x06\x00\xff\xff\x00\x00\x06\x00\x06\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x06\x00\xff\xff\x06\x00\x00\x00\x06\x00\x06\x00\x06\x00\x0a\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x08\x00\xff\xff\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\xff\xff\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x07\x00\x0a\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x09\x00\x0a\x00\x00\x00\x00\x00\x09\x00\x00\x00\x0a\x00\x0a\x00\x0a\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -alex_check :: AlexAddr -alex_check = AlexA# "\xff\xff\x0a\x00\x20\x00\x0a\x00\xff\xff\x23\x00\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\x2b\x00\x0a\x00\x2d\x00\xff\xff\x2b\x00\x30\x00\x2d\x00\x25\x00\xff\xff\x30\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\x2e\x00\x25\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x25\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x45\x00\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\xff\xff\xff\xff\x6c\x00\xff\xff\x6e\x00\x6f\x00\x70\x00\xff\xff\xff\xff\x73\x00\xff\xff\x75\x00\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_deflt :: AlexAddr -alex_deflt = AlexA# "\x04\x00\xff\xff\xff\xff\x04\x00\x04\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_accept = listArray (0::Int,10) [[],[(AlexAcc (alex_action_2))],[],[],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))]] -{-# LINE 54 "Printf/Lexer.x" #-} - - -mkflags, mkconv, mklength, mkint, mkstr, mkdot :: AlexInput -> Int -> Alex Token - -mkflags (_,_,input) len = return (FlagT (take len input)) -mkconv (_,_,(c:_)) _ = return (ConvT c) -mklength (_,_,(c:_)) _ = return (LengthT c) -mkint (_,_,input) len = return (IntT (read (take len input))) -mkstr (_,_,input) len = return (StrT (take len input)) -mkdot _ _ = return DotT - -alexEOF = return EOFT - -data Token - = FlagT [Char] - | ConvT Char - | LengthT Char - | IntT Int - | StrT String - | DotT - | EOFT - deriving (Eq, Show) - -scan :: String -> Either String [Token] -scan str = runAlex str $ do - let loop tks = do - tok <- alexMonadScan; - if tok == EOFT then do return $! reverse tks - else loop $! (tok:tks) - loop [] - - - -flag,fmt :: Int -flag = 1 -fmt = 2 -alex_action_0 = mkstr -alex_action_1 = begin flag -alex_action_2 = mkflags `andBegin` fmt -alex_action_3 = mkint -alex_action_4 = mkdot -alex_action_5 = mklength -alex_action_6 = mkconv `andBegin` 0 -{-# LINE 1 "GenericTemplate.hs" #-} --- ----------------------------------------------------------------------------- --- ALEX TEMPLATE --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- INTERNALS and main scanner engine - - - - - - - - - - - - - -{-# LINE 34 "GenericTemplate.hs" #-} - - - - - - - - - - - - -data AlexAddr = AlexA# Addr# - -{-# INLINE alexIndexShortOffAddr #-} -alexIndexShortOffAddr (AlexA# arr) off = -#if __GLASGOW_HASKELL__ > 500 - narrow16Int# i -#elif __GLASGOW_HASKELL__ == 500 - intToInt16# i -#else - (i `iShiftL#` 16#) `iShiftRA#` 16# -#endif - where -#if __GLASGOW_HASKELL__ >= 503 - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) -#else - i = word2Int# ((high `shiftL#` 8#) `or#` low) -#endif - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# - - - - --- ----------------------------------------------------------------------------- --- Main lexing routines - -data AlexReturn a - = AlexEOF - | AlexError !AlexInput - | AlexSkip !AlexInput !Int - | AlexToken !AlexInput !Int a - --- alexScan :: AlexInput -> StartCode -> Maybe (AlexInput,Int,act) -alexScan input (I# (sc)) - = alexScanUser undefined input (I# (sc)) - -alexScanUser user input (I# (sc)) - = case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, input') -> - case alexGetChar input of - Nothing -> - - - - AlexEOF - Just _ -> - - - - AlexError input - - (AlexLastSkip input len, _) -> - - - - AlexSkip input len - - (AlexLastAcc k input len, _) -> - - - - AlexToken input len k - - --- Push the input through the DFA, remembering the most recent accepting --- state it encountered. - -alex_scan_tkn user orig_input len input s last_acc = - input `seq` -- strict in the input - case s of - -1# -> (last_acc, input) - _ -> alex_scan_tkn' user orig_input len input s last_acc - -alex_scan_tkn' user orig_input len input s last_acc = - let - new_acc = check_accs (alex_accept `unsafeAt` (I# (s))) - in - new_acc `seq` - case alexGetChar input of - Nothing -> (new_acc, input) - Just (c, new_input) -> - - - - let - base = alexIndexShortOffAddr alex_base s - (I# (ord_c)) = ord c - offset = (base +# ord_c) - check = alexIndexShortOffAddr alex_check offset - - new_s = if (offset >=# 0#) && (check ==# ord_c) - then alexIndexShortOffAddr alex_table offset - else alexIndexShortOffAddr alex_deflt s - in - alex_scan_tkn user orig_input (len +# 1#) new_input new_s new_acc - - where - check_accs [] = last_acc - check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len)) - check_accs (AlexAccPred a pred : rest) - | pred user orig_input (I# (len)) input - = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkipPred pred : rest) - | pred user orig_input (I# (len)) input - = AlexLastSkip input (I# (len)) - check_accs (_ : rest) = check_accs rest - -data AlexLastAcc a - = AlexNone - | AlexLastAcc a !AlexInput !Int - | AlexLastSkip !AlexInput !Int - -data AlexAcc a user - = AlexAcc a - | AlexAccSkip - | AlexAccPred a (AlexAccPred user) - | AlexAccSkipPred (AlexAccPred user) - -type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool - --- ----------------------------------------------------------------------------- --- Predicates on a rule - -alexAndPred p1 p2 user in1 len in2 - = p1 user in1 len in2 && p2 user in1 len in2 - ---alexPrevCharIsPred :: Char -> AlexAccPred _ -alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input - ---alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ -alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input - ---alexRightContext :: Int -> AlexAccPred _ -alexRightContext (I# (sc)) user _ _ input = - case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, _) -> False - _ -> True - -- TODO: there's no need to find the longest - -- match when checking the right context, just - -- the first match will do. - --- used by wrappers -iUnbox (I# (i)) = i -{-# LINE 1 "wrappers.hs" #-} --- ----------------------------------------------------------------------------- --- Alex wrapper code. --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- The input type - - -type AlexInput = (AlexPosn, -- current position, - Char, -- previous char - String) -- current input string - -alexInputPrevChar :: AlexInput -> Char -alexInputPrevChar (p,c,s) = c - -alexGetChar :: AlexInput -> Maybe (Char,AlexInput) -alexGetChar (p,c,[]) = Nothing -alexGetChar (p,_,(c:s)) = let p' = alexMove p c in p' `seq` - Just (c, (p', c, s)) - --- ----------------------------------------------------------------------------- --- Token positions - --- `Posn' records the location of a token in the input text. It has three --- fields: the address (number of chacaters preceding the token), line number --- and column of a token within the file. `start_pos' gives the position of the --- start of the file and `eof_pos' a standard encoding for the end of file. --- `move_pos' calculates the new position after traversing a given character, --- assuming the usual eight character tab stops. - -data AlexPosn = AlexPn !Int !Int !Int - deriving (Eq,Show) - -alexStartPos :: AlexPosn -alexStartPos = AlexPn 0 1 1 - -alexMove :: AlexPosn -> Char -> AlexPosn -alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1) -alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1 -alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1) - - --- ----------------------------------------------------------------------------- --- Default monad - - -data AlexState = AlexState { - alex_pos :: !AlexPosn, -- position at current input location - alex_inp :: String, -- the current input - alex_chr :: !Char, -- the character before the input - alex_scd :: !Int -- the current startcode - } - --- Compile with -funbox-strict-fields for best results! - -runAlex :: String -> Alex a -> Either String a -runAlex input (Alex f) - = case f (AlexState {alex_pos = alexStartPos, - alex_inp = input, - alex_chr = '\n', - alex_scd = 0}) of Left msg -> Left msg - Right ( _, a ) -> Right a - -newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) } - -instance Monad Alex where - m >>= k = Alex $ \s -> case unAlex m s of - Left msg -> Left msg - Right (s',a) -> unAlex (k a) s' - return a = Alex $ \s -> Right (s,a) - -alexGetInput :: Alex AlexInput -alexGetInput - = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_inp=inp} -> - Right (s, (pos,c,inp)) - -alexSetInput :: AlexInput -> Alex () -alexSetInput (pos,c,inp) - = Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_inp=inp} of - s@(AlexState{}) -> Right (s, ()) - -alexError :: String -> Alex a -alexError message = Alex $ \s -> Left message - -alexGetStartCode :: Alex Int -alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc) - -alexSetStartCode :: Int -> Alex () -alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ()) - -alexMonadScan = do - inp <- alexGetInput - sc <- alexGetStartCode - case alexScan inp sc of - AlexEOF -> alexEOF - AlexError inp' -> alexError "lexical error" - AlexSkip inp' len -> do - alexSetInput inp' - alexMonadScan - AlexToken inp' len action -> do - alexSetInput inp' - action inp len - --- ----------------------------------------------------------------------------- --- Useful token actions - -type AlexAction result = AlexInput -> Int -> result - --- just ignore this token and scan another one --- skip :: AlexAction result -skip input len = alexMonadScan - --- ignore this token, but set the start code to a new value --- begin :: Int -> AlexAction result -begin code input len = do alexSetStartCode code; alexMonadScan - --- perform an action for this token, and set the start code to a new value --- andBegin :: AlexAction result -> Int -> AlexAction result -(action `andBegin` code) input len = do alexSetStartCode code; action input len - --- token :: (String -> Int -> token) -> AlexAction token -token t input len = return (t input len) - - --- ----------------------------------------------------------------------------- --- Basic wrapper - -{-# LINE 146 "wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- Posn wrapper - --- Adds text positions to the basic model. - -{-# LINE 162 "wrappers.hs" #-} - - --- ----------------------------------------------------------------------------- --- GScan wrapper - --- For compatibility with previous versions of Alex, and because we can. - -{-# LINE 180 "wrappers.hs" #-} - diff --git a/src/printf/Printf/Lexer.x b/src/printf/Printf/Lexer.x deleted file mode 100644 index 2b9a310..0000000 --- a/src/printf/Printf/Lexer.x +++ /dev/null @@ -1,86 +0,0 @@ --- --- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons --- --- This program is free software; you can redistribute it and/or --- modify it under the terms of the GNU General Public License as --- published by the Free Software Foundation; either version 2 of --- the License, or (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --- General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program; if not, write to the Free Software --- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. --- - --- --- Lexer for printf format strings --- Based on B1.2 Formatted Output, from Kernighan and Ritchie. --- - -{ - -{-# OPTIONS -w #-} --- ^ don't want to see all the warns alex templates produce - -module Printf.Lexer ( scan, Token(..) ) where - -} - -%wrapper "monad" - -$digit = 0-9 -$conv = [dioxXucsfeEgGpn\%] -$len = [hlL] -$flag = [\-\+\ 0\#] -$str = [. # \%] - -printf :- - -<0> $str+ { mkstr } -<0> \% { begin flag } - - $flag* { mkflags `andBegin` fmt } - - $digit+ { mkint } - \. { mkdot } - $len { mklength } - $conv { mkconv `andBegin` 0 } - -{ - - -mkflags, mkconv, mklength, mkint, mkstr, mkdot :: AlexInput -> Int -> Alex Token - -mkflags (_,_,input) len = return (FlagT (take len input)) -mkconv (_,_,(c:_)) _ = return (ConvT c) -mklength (_,_,(c:_)) _ = return (LengthT c) -mkint (_,_,input) len = return (IntT (read (take len input))) -mkstr (_,_,input) len = return (StrT (take len input)) -mkdot _ _ = return DotT - -alexEOF = return EOFT - -data Token - = FlagT [Char] - | ConvT Char - | LengthT Char - | IntT Int - | StrT String - | DotT - | EOFT - deriving (Eq, Show) - -scan :: String -> Either String [Token] -scan str = runAlex str $ do - let loop tks = do - tok <- alexMonadScan; - if tok == EOFT then do return $! reverse tks - else loop $! (tok:tks) - loop [] - -} diff --git a/src/printf/Printf/Parser.hs b/src/printf/Printf/Parser.hs deleted file mode 100644 index 82cfb64..0000000 --- a/src/printf/Printf/Parser.hs +++ /dev/null @@ -1,719 +0,0 @@ -{-# OPTIONS -fglasgow-exts -cpp -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-unused-binds -fno-warn-unused-matches -fno-warn-incomplete-patterns #-} --- parser produced by Happy Version 1.14 - - --- ^ grr. happy needs them all on one line - -module Printf.Parser where - -import Printf.Lexer -import Array -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif - -newtype HappyAbsSyn = HappyAbsSyn (() -> ()) -happyIn4 :: ([Format]) -> (HappyAbsSyn ) -happyIn4 x = unsafeCoerce# x -{-# INLINE happyIn4 #-} -happyOut4 :: (HappyAbsSyn ) -> ([Format]) -happyOut4 x = unsafeCoerce# x -{-# INLINE happyOut4 #-} -happyIn5 :: (Format) -> (HappyAbsSyn ) -happyIn5 x = unsafeCoerce# x -{-# INLINE happyIn5 #-} -happyOut5 :: (HappyAbsSyn ) -> (Format) -happyOut5 x = unsafeCoerce# x -{-# INLINE happyOut5 #-} -happyIn6 :: (Format) -> (HappyAbsSyn ) -happyIn6 x = unsafeCoerce# x -{-# INLINE happyIn6 #-} -happyOut6 :: (HappyAbsSyn ) -> (Format) -happyOut6 x = unsafeCoerce# x -{-# INLINE happyOut6 #-} -happyIn7 :: (Format) -> (HappyAbsSyn ) -happyIn7 x = unsafeCoerce# x -{-# INLINE happyIn7 #-} -happyOut7 :: (HappyAbsSyn ) -> (Format) -happyOut7 x = unsafeCoerce# x -{-# INLINE happyOut7 #-} -happyIn8 :: ([Flag]) -> (HappyAbsSyn ) -happyIn8 x = unsafeCoerce# x -{-# INLINE happyIn8 #-} -happyOut8 :: (HappyAbsSyn ) -> ([Flag]) -happyOut8 x = unsafeCoerce# x -{-# INLINE happyOut8 #-} -happyIn9 :: (Maybe Prec) -> (HappyAbsSyn ) -happyIn9 x = unsafeCoerce# x -{-# INLINE happyIn9 #-} -happyOut9 :: (HappyAbsSyn ) -> (Maybe Prec) -happyOut9 x = unsafeCoerce# x -{-# INLINE happyOut9 #-} -happyIn10 :: (Maybe Width) -> (HappyAbsSyn ) -happyIn10 x = unsafeCoerce# x -{-# INLINE happyIn10 #-} -happyOut10 :: (HappyAbsSyn ) -> (Maybe Width) -happyOut10 x = unsafeCoerce# x -{-# INLINE happyOut10 #-} -happyIn11 :: (Length) -> (HappyAbsSyn ) -happyIn11 x = unsafeCoerce# x -{-# INLINE happyIn11 #-} -happyOut11 :: (HappyAbsSyn ) -> (Length) -happyOut11 x = unsafeCoerce# x -{-# INLINE happyOut11 #-} -happyIn12 :: (Conv) -> (HappyAbsSyn ) -happyIn12 x = unsafeCoerce# x -{-# INLINE happyIn12 #-} -happyOut12 :: (HappyAbsSyn ) -> (Conv) -happyOut12 x = unsafeCoerce# x -{-# INLINE happyOut12 #-} -happyInTok :: Token -> (HappyAbsSyn ) -happyInTok x = unsafeCoerce# x -{-# INLINE happyInTok #-} -happyOutTok :: (HappyAbsSyn ) -> Token -happyOutTok x = unsafeCoerce# x -{-# INLINE happyOutTok #-} - -happyActOffsets :: HappyAddr -happyActOffsets = HappyA# "\x0f\x00\x00\x00\x14\x00\x0f\x00\x00\x00\x00\x00\x16\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x15\x00\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00"# - -happyGotoOffsets :: HappyAddr -happyGotoOffsets = HappyA# "\x0a\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\xff\x00\x00\x00\x00"# - -happyDefActions :: HappyAddr -happyDefActions = HappyA# "\xfe\xff\x00\x00\x00\x00\xfe\xff\xfc\xff\xfb\xff\xf3\xff\xfa\xff\xf7\xff\xef\xff\xf4\xff\xfd\xff\x00\x00\xf2\xff\xf1\xff\xf0\xff\xf5\xff\xef\xff\xf6\xff\xf8\xff\xee\xff\xed\xff\xec\xff\xeb\xff\xea\xff\xe9\xff\xe8\xff\xe7\xff\xe6\xff\xe5\xff\xe4\xff\xe3\xff\xe2\xff\xe1\xff\x00\x00\xf9\xff"# - -happyCheck :: HappyAddr -happyCheck = HappyA# "\xff\xff\x08\x00\x01\x00\x02\x00\x03\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x01\x00\x02\x00\x03\x00\x07\x00\x12\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x05\x00\x14\x00\x15\x00\x06\x00\x08\x00\x07\x00\x13\x00\x13\x00\x16\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -happyTable :: HappyAddr -happyTable = HappyA# "\x00\x00\x23\x00\x0e\x00\x0f\x00\x10\x00\x0b\x00\x03\x00\x04\x00\x05\x00\x06\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x0e\x00\x0f\x00\x10\x00\x22\x00\x11\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x11\x00\x08\x00\x09\x00\x09\x00\x13\x00\x0c\x00\x13\x00\x0b\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyReduceArr = array (1, 30) [ - (1 , happyReduce_1), - (2 , happyReduce_2), - (3 , happyReduce_3), - (4 , happyReduce_4), - (5 , happyReduce_5), - (6 , happyReduce_6), - (7 , happyReduce_7), - (8 , happyReduce_8), - (9 , happyReduce_9), - (10 , happyReduce_10), - (11 , happyReduce_11), - (12 , happyReduce_12), - (13 , happyReduce_13), - (14 , happyReduce_14), - (15 , happyReduce_15), - (16 , happyReduce_16), - (17 , happyReduce_17), - (18 , happyReduce_18), - (19 , happyReduce_19), - (20 , happyReduce_20), - (21 , happyReduce_21), - (22 , happyReduce_22), - (23 , happyReduce_23), - (24 , happyReduce_24), - (25 , happyReduce_25), - (26 , happyReduce_26), - (27 , happyReduce_27), - (28 , happyReduce_28), - (29 , happyReduce_29), - (30 , happyReduce_30) - ] - -happy_n_terms = 23 :: Int -happy_n_nonterms = 9 :: Int - -happyReduce_1 = happySpecReduce_0 0# happyReduction_1 -happyReduction_1 = happyIn4 - ([] - ) - -happyReduce_2 = happySpecReduce_2 0# happyReduction_2 -happyReduction_2 happy_x_2 - happy_x_1 - = case happyOut5 happy_x_1 of { happy_var_1 -> - case happyOut4 happy_x_2 of { happy_var_2 -> - happyIn4 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_3 = happySpecReduce_1 1# happyReduction_3 -happyReduction_3 happy_x_1 - = case happyOut6 happy_x_1 of { happy_var_1 -> - happyIn5 - (happy_var_1 - )} - -happyReduce_4 = happySpecReduce_1 1# happyReduction_4 -happyReduction_4 happy_x_1 - = case happyOut7 happy_x_1 of { happy_var_1 -> - happyIn5 - (happy_var_1 - )} - -happyReduce_5 = happySpecReduce_1 2# happyReduction_5 -happyReduction_5 happy_x_1 - = case happyOutTok happy_x_1 of { (StrT happy_var_1) -> - happyIn6 - (StrLit happy_var_1 - )} - -happyReduce_6 = happyReduce 6# 3# happyReduction_6 -happyReduction_6 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut10 happy_x_2 of { happy_var_2 -> - case happyOut9 happy_x_4 of { happy_var_4 -> - case happyOut11 happy_x_5 of { happy_var_5 -> - case happyOut12 happy_x_6 of { happy_var_6 -> - happyIn7 - (ConvSp happy_var_1 happy_var_2 happy_var_4 happy_var_5 happy_var_6 - ) `HappyStk` happyRest}}}}} - -happyReduce_7 = happyReduce 4# 3# happyReduction_7 -happyReduction_7 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut8 happy_x_1 of { happy_var_1 -> - case happyOut10 happy_x_2 of { happy_var_2 -> - case happyOut11 happy_x_3 of { happy_var_3 -> - case happyOut12 happy_x_4 of { happy_var_4 -> - happyIn7 - (ConvSp happy_var_1 happy_var_2 Nothing happy_var_3 happy_var_4 - ) `HappyStk` happyRest}}}} - -happyReduce_8 = happySpecReduce_1 4# happyReduction_8 -happyReduction_8 happy_x_1 - = case happyOutTok happy_x_1 of { (FlagT happy_var_1) -> - happyIn8 - (mkFlags happy_var_1 - )} - -happyReduce_9 = happySpecReduce_1 5# happyReduction_9 -happyReduction_9 happy_x_1 - = case happyOutTok happy_x_1 of { (IntT happy_var_1) -> - happyIn9 - (Just happy_var_1 - )} - -happyReduce_10 = happySpecReduce_0 5# happyReduction_10 -happyReduction_10 = happyIn9 - (Nothing - ) - -happyReduce_11 = happySpecReduce_1 6# happyReduction_11 -happyReduction_11 happy_x_1 - = case happyOutTok happy_x_1 of { (IntT happy_var_1) -> - happyIn10 - (Just happy_var_1 - )} - -happyReduce_12 = happySpecReduce_0 6# happyReduction_12 -happyReduction_12 = happyIn10 - (Nothing - ) - -happyReduce_13 = happySpecReduce_1 7# happyReduction_13 -happyReduction_13 happy_x_1 - = happyIn11 - (Short - ) - -happyReduce_14 = happySpecReduce_1 7# happyReduction_14 -happyReduction_14 happy_x_1 - = happyIn11 - (Long - ) - -happyReduce_15 = happySpecReduce_1 7# happyReduction_15 -happyReduction_15 happy_x_1 - = happyIn11 - (Double - ) - -happyReduce_16 = happySpecReduce_0 7# happyReduction_16 -happyReduction_16 = happyIn11 - (Default - ) - -happyReduce_17 = happySpecReduce_1 8# happyReduction_17 -happyReduction_17 happy_x_1 - = happyIn12 - (D - ) - -happyReduce_18 = happySpecReduce_1 8# happyReduction_18 -happyReduction_18 happy_x_1 - = happyIn12 - (D - ) - -happyReduce_19 = happySpecReduce_1 8# happyReduction_19 -happyReduction_19 happy_x_1 - = happyIn12 - (O - ) - -happyReduce_20 = happySpecReduce_1 8# happyReduction_20 -happyReduction_20 happy_x_1 - = happyIn12 - (Xx - ) - -happyReduce_21 = happySpecReduce_1 8# happyReduction_21 -happyReduction_21 happy_x_1 - = happyIn12 - (XX - ) - -happyReduce_22 = happySpecReduce_1 8# happyReduction_22 -happyReduction_22 happy_x_1 - = happyIn12 - (U - ) - -happyReduce_23 = happySpecReduce_1 8# happyReduction_23 -happyReduction_23 happy_x_1 - = happyIn12 - (C - ) - -happyReduce_24 = happySpecReduce_1 8# happyReduction_24 -happyReduction_24 happy_x_1 - = happyIn12 - (S - ) - -happyReduce_25 = happySpecReduce_1 8# happyReduction_25 -happyReduction_25 happy_x_1 - = happyIn12 - (F - ) - -happyReduce_26 = happySpecReduce_1 8# happyReduction_26 -happyReduction_26 happy_x_1 - = happyIn12 - (Ee - ) - -happyReduce_27 = happySpecReduce_1 8# happyReduction_27 -happyReduction_27 happy_x_1 - = happyIn12 - (EE - ) - -happyReduce_28 = happySpecReduce_1 8# happyReduction_28 -happyReduction_28 happy_x_1 - = happyIn12 - (Gg - ) - -happyReduce_29 = happySpecReduce_1 8# happyReduction_29 -happyReduction_29 happy_x_1 - = happyIn12 - (GG - ) - -happyReduce_30 = happySpecReduce_1 8# happyReduction_30 -happyReduction_30 happy_x_1 - = happyIn12 - (Percent - ) - -happyNewToken action sts stk [] = - happyDoAction 22# (error "reading EOF!") action sts stk [] - -happyNewToken action sts stk (tk:tks) = - let cont i = happyDoAction i tk action sts stk tks in - case tk of { - LengthT 'h' -> cont 1#; - LengthT 'l' -> cont 2#; - LengthT 'L' -> cont 3#; - ConvT 'd' -> cont 4#; - ConvT 'i' -> cont 5#; - ConvT 'o' -> cont 6#; - ConvT 'x' -> cont 7#; - ConvT 'X' -> cont 8#; - ConvT 'u' -> cont 9#; - ConvT 'c' -> cont 10#; - ConvT 's' -> cont 11#; - ConvT 'f' -> cont 12#; - ConvT 'e' -> cont 13#; - ConvT 'E' -> cont 14#; - ConvT 'g' -> cont 15#; - ConvT 'G' -> cont 16#; - ConvT '%' -> cont 17#; - DotT -> cont 18#; - IntT happy_dollar_dollar -> cont 19#; - StrT happy_dollar_dollar -> cont 20#; - FlagT happy_dollar_dollar -> cont 21#; - _ -> happyError tks - } - -happyThen = \m k -> k m -happyReturn = \a -> a -happyThen1 = happyThen -happyReturn1 = \a tks -> a - -parse tks = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x)) - -happySeq = happyDontSeq - ------------------------------------------------------------------------- --- --- abstract syntax for printf format strings --- -data Format - = StrLit String - | ConvSp { flags :: [Flag], - width :: (Maybe Width), - precision :: (Maybe Prec ), - lenght :: Length, - conv :: Conv } - deriving (Show, Eq) - -type Width = Int -type Prec = Int - -data Flag - = LeftAdjust -- - - | Signed -- + - | Space -- ' ' - | LeadZero -- 0 - | Alt -- # - deriving (Show, Eq) - -data Length - = Short -- h - | Long -- l - | Double -- L - | Default - deriving (Show, Eq) - -data Conv - = D - | O - | Xx | XX - | U - | C - | S - | F - | Ee | EE - | Gg | GG - | Percent - deriving (Show, Eq) - -mkFlags :: [Char] -> [Flag] -mkFlags [] = [] -mkFlags (c:cs) = (case c of - '-' -> LeftAdjust - '+' -> Signed - ' ' -> Space - '0' -> LeadZero - '#' -> Alt) : mkFlags cs - -happyError :: [Token] -> a -happyError [] = error "Parser" "parse error" -happyError tks = error $ "Parser: " ++ show tks -{-# LINE 1 "GenericTemplate.hs" #-} --- $Id: Parser.hs,v 1.1 2004/06/28 03:56:01 dons Exp $ - - - - - - - - - - - - - -{-# LINE 27 "GenericTemplate.hs" #-} - - - -data Happy_IntList = HappyCons Int# Happy_IntList - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -infixr 9 `HappyStk` -data HappyStk a = HappyStk a (HappyStk a) - ------------------------------------------------------------------------------ --- starting the parse - -happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll - ------------------------------------------------------------------------------ --- Accepting the parse - -happyAccept j tk st sts (HappyStk ans _) = (happyTcHack j - (happyTcHack st)) - (happyReturn1 ans) - ------------------------------------------------------------------------------ --- Arrays only: do the next action - - - -happyDoAction i tk st - = {- nothing -} - - - case action of - 0# -> {- nothing -} - happyFail i tk st - -1# -> {- nothing -} - happyAccept i tk st - n | (n <# (0# :: Int#)) -> {- nothing -} - - (happyReduceArr ! rule) i tk st - where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) - n -> {- nothing -} - - - happyShift new_state i tk st - where new_state = (n -# (1# :: Int#)) - where off = indexShortOffAddr happyActOffsets st - off_i = (off +# i) - check = if (off_i >=# (0# :: Int#)) - then (indexShortOffAddr happyCheck off_i ==# i) - else False - action | check = indexShortOffAddr happyTable off_i - | otherwise = indexShortOffAddr happyDefActions st - - - - - - - - - - - -indexShortOffAddr (HappyA# arr) off = -#if __GLASGOW_HASKELL__ > 500 - narrow16Int# i -#elif __GLASGOW_HASKELL__ == 500 - intToInt16# i -#else - (i `iShiftL#` 16#) `iShiftRA#` 16# -#endif - where -#if __GLASGOW_HASKELL__ >= 503 - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) -#else - i = word2Int# ((high `shiftL#` 8#) `or#` low) -#endif - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# - - - - - -data HappyAddr = HappyA# Addr# - - - - ------------------------------------------------------------------------------ --- HappyState data type (not arrays) - -{-# LINE 165 "GenericTemplate.hs" #-} - - ------------------------------------------------------------------------------ --- Shifting a token - -happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = - let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in --- trace "shifting the error token" $ - happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) - -happyShift new_state i tk st sts stk = - happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) - --- happyReduce is specialised for the common cases. - -happySpecReduce_0 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_0 nt fn j tk st@((action)) sts stk - = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) - -happySpecReduce_1 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') - = let r = fn v1 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happySpecReduce_2 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') - = let r = fn v1 v2 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happySpecReduce_3 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') - = let r = fn v1 v2 v3 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happyReduce k i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyReduce k nt fn j tk st sts stk - = case happyDrop (k -# (1# :: Int#)) sts of - sts1@((HappyCons (st1@(action)) (_))) -> - let r = fn stk in -- it doesn't hurt to always seq here... - happyDoSeq r (happyGoto nt j tk st1 sts1 r) - -happyMonadReduce k nt fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyMonadReduce k nt fn j tk st sts stk = - happyThen1 (fn stk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k stk - -happyDrop 0# l = l -happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t - -happyDropStk 0# l = l -happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs - ------------------------------------------------------------------------------ --- Moving to a new state after a reduction - - -happyGoto nt j tk st = - {- nothing -} - happyDoAction j tk new_state - where off = indexShortOffAddr happyGotoOffsets st - off_i = (off +# nt) - new_state = indexShortOffAddr happyTable off_i - - - - ------------------------------------------------------------------------------ --- Error recovery (0# is the error token) - --- parse error if we are in recovery and we fail again -happyFail 0# tk old_st _ stk = --- trace "failing" $ - happyError - - -{- We don't need state discarding for our restricted implementation of - "error". In fact, it can cause some bogus parses, so I've disabled it - for now --SDM - --- discard a state -happyFail 0# tk old_st (HappyCons ((action)) (sts)) - (saved_tok `HappyStk` _ `HappyStk` stk) = --- trace ("discarding state, depth " ++ show (length stk)) $ - happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) --} - --- Enter error recovery: generate an error token, --- save the old token and carry on. -happyFail i tk (action) sts stk = --- trace "entering error recovery" $ - happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk) - --- Internal happy errors: - -notHappyAtAll = error "Internal Happy error\n" - ------------------------------------------------------------------------------ --- Hack to get the typechecker to accept our action functions - - -happyTcHack :: Int# -> a -> a -happyTcHack x y = y -{-# INLINE happyTcHack #-} - - ------------------------------------------------------------------------------ --- Seq-ing. If the --strict flag is given, then Happy emits --- happySeq = happyDoSeq --- otherwise it emits --- happySeq = happyDontSeq - -happyDoSeq, happyDontSeq :: a -> b -> b -happyDoSeq a b = a `seq` b -happyDontSeq a b = b - ------------------------------------------------------------------------------ --- Don't inline any functions from the template. GHC has a nasty habit --- of deciding to inline happyGoto everywhere, which increases the size of --- the generated parser quite a bit. - - -{-# NOINLINE happyDoAction #-} -{-# NOINLINE happyTable #-} -{-# NOINLINE happyCheck #-} -{-# NOINLINE happyActOffsets #-} -{-# NOINLINE happyGotoOffsets #-} -{-# NOINLINE happyDefActions #-} - -{-# NOINLINE happyShift #-} -{-# NOINLINE happySpecReduce_0 #-} -{-# NOINLINE happySpecReduce_1 #-} -{-# NOINLINE happySpecReduce_2 #-} -{-# NOINLINE happySpecReduce_3 #-} -{-# NOINLINE happyReduce #-} -{-# NOINLINE happyMonadReduce #-} -{-# NOINLINE happyGoto #-} -{-# NOINLINE happyFail #-} - --- end of Happy Template. diff --git a/src/printf/Printf/Parser.y b/src/printf/Printf/Parser.y deleted file mode 100644 index ca6fe13..0000000 --- a/src/printf/Printf/Parser.y +++ /dev/null @@ -1,174 +0,0 @@ --- --- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons --- --- This program is free software; you can redistribute it and/or --- modify it under the terms of the GNU General Public License as --- published by the Free Software Foundation; either version 2 of --- the License, or (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --- General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program; if not, write to the Free Software --- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. --- - --- --- Parser for printf format strings --- Based on B1.2 Formatted Output, from Kernighan and Ritchie. --- - -{ - -{-# OPTIONS -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-unused-binds -fno-warn-unused-matches -fno-warn-incomplete-patterns #-} --- ^ grr. happy needs them all on one line - -module Printf.Parser where - -import Printf.Lexer - -} - -%name parse -%tokentype { Token } -%token - - 'h' { LengthT 'h' } - 'l' { LengthT 'l' } - 'L' { LengthT 'L' } - - 'd' { ConvT 'd' } - 'i' { ConvT 'i' } - 'o' { ConvT 'o' } - 'x' { ConvT 'x' } - 'X' { ConvT 'X' } - 'u' { ConvT 'u' } - 'c' { ConvT 'c' } - 's' { ConvT 's' } - 'f' { ConvT 'f' } - 'e' { ConvT 'e' } - 'E' { ConvT 'E' } - 'g' { ConvT 'g' } - 'G' { ConvT 'G' } - '%' { ConvT '%' } - - '.' { DotT } - - INT { IntT $$ } - STRING { StrT $$ } - FLAGS { FlagT $$ } - -%% - -printf :: { [Format] } - : {- epsilon -} { [] } - | format0 printf { $1 : $2 } - -format0 :: { Format } - : string { $1 } - | format { $1 } - -string :: { Format } - : STRING { StrLit $1 } - -format :: { Format } - : flags width '.' precision length conv { ConvSp $1 $2 $4 $5 $6 } - | flags width length conv { ConvSp $1 $2 Nothing $3 $4 } - -flags :: { [Flag] } - : FLAGS { mkFlags $1 } - -precision :: { Maybe Prec } - : INT { Just $1 } - | {- epsilon -} { Nothing } - -width :: { Maybe Width } - : INT { Just $1 } - | {- epsilon -} { Nothing } - -length :: { Length } - : 'h' { Short } - | 'l' { Long } - | 'L' { Double } - | {- epsilon -} { Default} - -conv :: { Conv } - : 'd' { D } - | 'i' { D } -- n.b - | 'o' { O } - | 'x' { Xx } - | 'X' { XX } - | 'u' { U } - | 'c' { C } - | 's' { S } - | 'f' { F } - | 'e' { Ee } - | 'E' { EE } - | 'g' { Gg } - | 'G' { GG } - | '%' { Percent } - -{ - ------------------------------------------------------------------------- --- --- abstract syntax for printf format strings --- -data Format - = StrLit String - | ConvSp { flags :: [Flag], - width :: (Maybe Width), - precision :: (Maybe Prec ), - lenght :: Length, - conv :: Conv } - deriving (Show, Eq) - -type Width = Int -type Prec = Int - -data Flag - = LeftAdjust -- - - | Signed -- + - | Space -- ' ' - | LeadZero -- 0 - | Alt -- # - deriving (Show, Eq) - -data Length - = Short -- h - | Long -- l - | Double -- L - | Default - deriving (Show, Eq) - -data Conv - = D - | O - | Xx | XX - | U - | C - | S - | F - | Ee | EE - | Gg | GG - | Percent - deriving (Show, Eq) - -mkFlags :: [Char] -> [Flag] -mkFlags [] = [] -mkFlags (c:cs) = (case c of - '-' -> LeftAdjust - '+' -> Signed - ' ' -> Space - '0' -> LeadZero - '#' -> Alt) : mkFlags cs - -happyError :: [Token] -> a -happyError [] = error "Parser" "parse error" -happyError tks = error $ "Parser: " ++ show tks - -} diff --git a/src/printf/printf.conf.in.cpp b/src/printf/printf.conf.in.cpp deleted file mode 100644 index 9b5b563..0000000 --- a/src/printf/printf.conf.in.cpp +++ /dev/null @@ -1,54 +0,0 @@ -#if CABAL == 0 && GLASGOW_HASKELL < 604 -Package { - name = "printf", - auto = False, - hs_libraries = [ "HSprintf" ], -#ifdef INSTALLING - import_dirs = [ "${LIBDIR}/imports" ], - library_dirs = [ "${LIBDIR}/" ], -#else - import_dirs = [ "${TOP}/src/printf" ], - library_dirs = [ "${TOP}/src/printf" ], -#endif - include_dirs = [], - c_includes = [], - source_dirs = [], - extra_libraries = [], - package_deps = [ "eval" ], - extra_ghc_opts = [], - extra_cc_opts = [], - extra_ld_opts = [] -} -#else -name: printf -version: 0.9.8 -license: LGPL -maintainer: dons@cse.unsw.edu.au -exposed: False -exposed-modules: - Printf.Compile, - Printf.Lexer, - Printf.Parser, - Printf - -hidden-modules: -#ifdef INSTALLING -import-dirs: LIBDIR/imports -library-dirs: LIBDIR -#else -import-dirs: TOP/src/printf -library-dirs: TOP/src/printf -#endif -hs-libraries: HSprintf -extra-libraries: -include-dirs: -includes: -depends: eval -hugs-options: -cc-options: -ld-options: -framework-dirs: -frameworks: -haddock-interfaces: -haddock-html: -#endif