diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Dmitry Golubovsky 2008. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Dmitry Golubovsky nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMainWithHooks simpleUserHooks diff --git a/Yhc/Core/AnnotatePrims.hs b/Yhc/Core/AnnotatePrims.hs new file mode 100644 --- /dev/null +++ b/Yhc/Core/AnnotatePrims.hs @@ -0,0 +1,93 @@ +-- Annotation of normal primitives + +module Yhc.Core.AnnotatePrims ( + buildPrimSpecMap + ,normPrimSpecMap + ,CoreStrictness (..) + ,CoreTypeSig (..) + ,buildPrimAnno + ,buildNormPrimAnno + ) where + +import Data.Maybe +import Yhc.Core +import Yhc.Core.PrimAnnoRaw +import Yhc.Core.Annotation +import qualified Data.Map as M + +-- Annotation key for functions and primitives + +fparity (p@CorePrim {}) = corePrimArity p +fparity (f@CoreFunc {}) = length $ coreFuncArgs f + +instance CoreAnnotable CoreFunc where + toAnnotationKey (p@CorePrim {}) = "primitive_" ++ + coreFuncName p ++ "/" ++ + show (corePrimArity p) + + toAnnotationKey (f@CoreFunc {}) = "function_" ++ + coreFuncName f ++ "/" ++ + show (length $ coreFuncArgs f) + +-- |Build a map of primitive specifications given the list of +-- primitive description records. This as well may be used by frontends. + +buildPrimSpecMap :: [[String]] -> M.Map String [String] + +buildPrimSpecMap pspc = M.fromList $ map bpsm pspc where + bpsm (h:t) = (h, t) + +-- |Specifications map of normal primitives + +normPrimSpecMap :: M.Map String [String] + +normPrimSpecMap = buildPrimSpecMap rawPrimAnno + +-- Core function/primitive strictness is a list of Bools. True +-- at certain position means that a function or a primitive is strict +-- on the corresponding argument. + +newtype CoreStrictness = CoreStrictness [Bool] + +instance CoreProperty CoreStrictness where + toAnnString (CoreStrictness bsct) = map (\b -> if b then 'T' else 'F') bsct + fromAnnString s = mapM (\c -> case c of + 'F' -> return False + 'T' -> return True + _ -> fail $ "invalid strictness annotation: " ++ s) s + >>= return . CoreStrictness + +-- Core function/primitive type signature is a string containing Haskell +-- type expression. + +newtype CoreTypeSig = CoreTypeSig String + +instance CoreProperty CoreTypeSig where + toAnnString (CoreTypeSig s) = s + fromAnnString = return . CoreTypeSig + +-- |Given the linked Core, build annotations for all primitives defined +-- that belong to the given set of primitives, that is, their names +-- are member keys of the given primitives specification map. + +buildPrimAnno :: M.Map String [String] -> Core -> CoreAnnotations + +buildPrimAnno mps core = ba M.empty (coreFuncs core) mps where + ba am [] _ = am + ba am (p:ps) mps | coreFuncName p `M.member` mps = + ba am'' ps mps where + bsct art "All" = replicate art True + bsct art "None" = replicate art False + bsct art s = take art $ map ('T' ==) s ++ repeat False + (use:descr:impl:arity:strct:tsig:_) = fromJust $ M.lookup (coreFuncName p) mps + am' = addAnnotation p ("Strictness", CoreStrictness (bsct (read arity) strct)) am + am'' = addAnnotation p ("Type", CoreTypeSig tsig) am' + ba am (_:ps) mps = ba am ps mps + +-- |Given the linked Core, build annotations for all normal primitives +-- that is, belonging to the 'normPrimSpecMap'. + +buildNormPrimAnno :: Core -> CoreAnnotations + +buildNormPrimAnno = buildPrimAnno normPrimSpecMap + diff --git a/Yhc/Core/Annotation.hs b/Yhc/Core/Annotation.hs new file mode 100644 --- /dev/null +++ b/Yhc/Core/Annotation.hs @@ -0,0 +1,84 @@ +-- Annotation framework for Yhc Core + +module Yhc.Core.Annotation ( + CoreAnnotations, + CoreAnnotable (..), + CoreProperty (..), + addAnnotation, + getAnnotation, + combineAnnotations) where + +import Data.Maybe +import qualified Data.Map as M +import qualified Data.List as L +import Yhc.Core + +-- |Annotations database: a two-level map to hold property mappings +-- for each of annotated objects. + +type CoreAnnotations = M.Map String (M.Map String String) + +-- |For each annotable object, unique key should be generated, to be used +-- with the top level map in the annotations database. + +class CoreAnnotable a where + toAnnotationKey :: a -> String + +-- |For each property, an encoding (to String) and decoding (from String) +-- functions should be defined. + +class CoreProperty p where + toAnnString :: p -> String -- ^arbitrary property to a string to store + fromAnnString :: (Monad m) => String -> m p -- ^from stored string to property value or fail + +-- |Given an annotable object, append a property with given name and value +-- to the existing annotations database. + +addAnnotation :: (CoreAnnotable a, CoreProperty p) + => a -- ^annotable object + -> (String, p) -- ^pair of name and value + -> CoreAnnotations -- ^existing annotations database + -> CoreAnnotations -- ^updated annotations database + +addAnnotation a (n, p) b = + let ak = toAnnotationKey a -- annotation key to lookup at top level + aa = M.findWithDefault M.empty ak b -- second level map or empty map if new + ps = toAnnString p -- stringify the property value + aa' = M.insert n ps aa -- insert/replace property at the second level + in M.insert ak aa' b -- insert/replace properties at the top level + + +getAnnotation :: (CoreAnnotable a, CoreProperty p) + => a -- ^annotable object + -> String -- ^property name + -> CoreAnnotations -- ^annotations database + -> Maybe p -- ^returned value or nothing + +getAnnotation a n b = do -- as we are in a monad... + let ak = toAnnotationKey a -- annotation key to lookup at top level + aa <- M.lookup ak b -- second level map or fail right here + ps <- M.lookup n aa -- property value or fail right here + p <- fromAnnString ps -- decode property value or fail rught here + return p + + +-- |Given the two annotation sets, combine them into one. If the same object +-- is annotated in both sets, annotations are combines for such object, +-- and left annotations take precedence. + +combineAnnotations :: CoreAnnotations -> CoreAnnotations -> CoreAnnotations + +combineAnnotations l r = + let flkup = flip M.lookup + lkeys = M.keys l + rkeys = M.keys r + ikeys = L.intersect lkeys rkeys + lnodup = lkeys L.\\ ikeys + rnodup = rkeys L.\\ ikeys + lanno = concat $ map (maybeToList . flkup l) lnodup + ranno = concat $ map (maybeToList . flkup r) rnodup + ilanno = concat $ map (maybeToList . flkup l) ikeys + iranno = concat $ map (maybeToList . flkup r) ikeys + imps = zipWith M.union ilanno iranno + in M.fromList (zip lnodup lanno ++ zip rnodup ranno ++ zip ikeys imps) + diff --git a/Yhc/Core/Extra.hs b/Yhc/Core/Extra.hs new file mode 100644 --- /dev/null +++ b/Yhc/Core/Extra.hs @@ -0,0 +1,28 @@ +module Yhc.Core.Extra (module X, coreCtorMaybe, coreDataMaybe) where + +import Yhc.Core as X + +import Yhc.Core.MapNames as X +import Yhc.Core.Unreachable as X +import Yhc.Core.Annotation as X +import Yhc.Core.AnnotatePrims as X +import Yhc.Core.StrictAnno as X +import Yhc.Core.Selector as X + +import Data.Maybe + +-- |Non-crashing version of coreCtor + +coreCtorMaybe :: Core -> CoreCtorName -> Maybe CoreCtor + +coreCtorMaybe core name = listToMaybe + [ctr | dat <- coreDatas core, ctr <- coreDataCtors dat, coreCtorName ctr == name] + +-- |Non-crashing version of coreData + +coreDataMaybe :: Core -> CoreDataName -> Maybe CoreData +coreDataMaybe core name = listToMaybe + [dat | dat <- coreDatas core, coreDataName dat == name] + + + diff --git a/Yhc/Core/MapNames.hs b/Yhc/Core/MapNames.hs new file mode 100644 --- /dev/null +++ b/Yhc/Core/MapNames.hs @@ -0,0 +1,70 @@ +------------------------------------------------------------------ +-- | +-- Module : Yhc.Core.MapNames +-- Copyright : (c) Dmitry Golubovsky, 2007 +-- License : BSD-style +-- +-- Maintainer : golubovsky@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- +-- +-- Rename all functions and data constructors given a map of names +------------------------------------------------------------------ + +module Yhc.Core.MapNames ( + mapFunNames, + mapDataNames, + mapConNames) where + +import Yhc.Core +import Data.Maybe +import qualified Data.Map as M + +-- |Rename all functions in the Core given the map of old to new names. + +mapFunNames :: M.Map CoreFuncName CoreFuncName -> Core -> Core + +mapFunNames funmap core = mapFunDefs funmap $ mapUnderCore mapfun core where + mapfun (CoreFun s) = let ns = M.lookup s funmap in CoreFun $ fromMaybe s ns + mapfun z = z + +mapFunDefs dmap core = core {coreFuncs = mpfd} where + mpfd = map mpof $ coreFuncs core + mpof func = let old = coreFuncName func + new = fromMaybe old $ M.lookup old dmap + in func {coreFuncName = new} + + +-- |Rename all data objects (LHS of data XXX) given the map of old to new names. + +mapDataNames :: M.Map CoreDataName CoreDataName -> Core -> Core + +mapDataNames dmap core = core {coreDatas = mpdd} where + mpdd = map mpod $ coreDatas core + mpod dtdf = let old = coreDataName dtdf + new = fromMaybe old $ M.lookup old dmap + in dtdf {coreDataName = new} + +-- |Rename all data constructors in the Core given the map of old to new names. + +mapConNames :: M.Map CoreCtorName CoreCtorName -> Core -> Core + +mapConNames conmap core = mapConDefs conmap $ mapUnderCore mapcon core where + mapcon (CoreCon s) = let ns = M.lookup s conmap in CoreCon $ fromMaybe s ns + mapcon (CoreCase expr alts) = CoreCase (mapcon expr) (map (mapalt conmap) alts) where + mapalt conmap (altpat, altexpr) = (mappat conmap altpat, mapcon altexpr) where + mappat conmap (PatCon s cvs) = + let ns = M.lookup s conmap in PatCon (fromMaybe s ns) cvs + mappat _ x = x + mapcon z = z + +mapConDefs cmap core = core {coreDatas = mpcd} where + mpcd = map mapcons $ coreDatas core + mapcons cdata = cdata {coreDataCtors = map mpod $ coreDataCtors cdata} + mpod ctor = let old = coreCtorName ctor + new = fromMaybe old $ M.lookup old cmap + in ctor {coreCtorName = new} + + diff --git a/Yhc/Core/PrimAnnoRaw.hs b/Yhc/Core/PrimAnnoRaw.hs new file mode 100644 --- /dev/null +++ b/Yhc/Core/PrimAnnoRaw.hs @@ -0,0 +1,133 @@ +-- Raw annotations for Core Normal Primitives (autogenerated, do not edit!!!) +module Yhc.Core.PrimAnnoRaw(rawPrimAnno) where + +rawPrimAnno :: [[String]] +rawPrimAnno = [ + ["ADD_W","Y","Add two integer values","M","2","All","Int -> Int -> Int"], + ["ADD_L","Y","Add two long integer values","ADD_W","2","All","Integer -> Integer -> Integer"], + ["SUB_W","Y","Subtract two integer values","M","2","All","Int -> Int -> Int"], + ["SUB_L","Y","Subtract two long integer values","SUB_W","2","All","Integer -> Integer -> Integer"], + ["NEG_W","Y","Negate an integer value","M","1","All","Int -> Int"], + ["NEG_L","Y","Negate a long integer value","NEG_W","1","All","Integer -> Integer"], + ["EQ_W","Y","Compare two integer values for equality","M","2","All","Int -> Int -> Prelude;Bool"], + ["EQ_L","Y","Compare two long integer values for equality","EQ_W","2","All","Integer -> Integer -> Prelude;Bool"], + ["EQ_C","Y","Compare two characters for equality","M","2","All","Char -> Char -> Prelude;Bool"], + ["NE_W","Y","Compare two integer values for non-equality","M","2","All","Int -> Int -> Prelude;Bool"], + ["NE_L","Y","Compare two long integer values for non-equality","NE_W","2","All","Integer -> Integer -> Prelude;Bool"], + ["LE_W","Y","Compare two integer values for less or equal","M","2","All","Int -> Int -> Prelude;Bool"], + ["LE_L","Y","Compare two long integer values for less or equal","LE_W","2","All","Integer -> Integer -> Prelude;Bool"], + ["LT_W","Y","Compare two integer values for less","M","2","All","Int -> Int -> Prelude;Bool"], + ["LT_L","Y","Compare two long integer values for less","LT_W","2","All","Integer -> Integer -> Prelude;Bool"], + ["GE_W","Y","Compare two integer values for greater or equal","M","2","All","Int -> Int -> Prelude;Bool"], + ["GE_L","Y","Compare two long integer values for greater or equal","GE_W","2","All","Integer -> Integer -> Prelude;Bool"], + ["GT_W","Y","Compare two integer values for greater","M","2","All","Int -> Int -> Prelude;Bool"], + ["GT_L","Y","Compare two long integer values for greater","GT_W","2","All","Integer -> Integer -> Prelude;Bool"], + ["CMP_W","Y","Compare two integer values","M","2","All","Int -> Int -> Prelude;Ordering"], + ["CMP_L","Y","Compare two long integer values","CMP_W","2","All","Integer -> Integer -> Prelude;Ordering"], + ["CMP_C","Y","Compare two characters","M","2","All","Char -> Char -> Prelude;Ordering"], + ["CMP_T","Y","Compare two conctructor tags","M","2","All","a -> a -> Prelude;Ordering"], + ["MUL_W","Y","Multiply two integer values","M","2","All","Int -> Int -> Int"], + ["MUL_L","Y","Multiply two long integer values","MUL_W","2","All","Integer -> Integer -> Integer"], + ["MOD_W","Y","Remainder of flooring integer division","M","2","All","Int -> Int -> Int"], + ["MOD_L","Y","Remainder of flooring long integer division","MOD_W","2","All","Integer -> Integer -> Integer"], + ["DIV_W","Y","Quotient of flooring integer division","M","2","All","Int -> Int -> Int"], + ["DIV_L","Y","Quotient of flooring long integer division","DIV_W","2","All","Integer -> Integer -> Integer"], + ["REM_W","Y","Remainder of trunc to zero integer division","M","2","All","Int -> Int -> Int"], + ["REM_L","Y","Remainder of trunc to zero long integer division","REM_W","2","All","Integer -> Integer -> Integer"], + ["QUOT_W","Y","Quotient of trunc to zero integer division","M","2","All","Int -> Int -> Int"], + ["QUOT_L","Y","Quotient of trunc to zero long integer division","QUOT_W","2","All","Integer -> Integer -> Integer"], + ["ADD_D","Y","Add two double precision values","M","2","All","Double -> Double -> Double"], + ["ADD_F","Y","Add two floating point single precision values","ADD_D","2","All","Float -> Float -> Float"], + ["SUB_D","Y","Subtract two double precision values","M","2","All","Double -> Double -> Double"], + ["SUB_F","Y","Subtract two floating point single precision values","ADD_D","2","All","Float -> Float -> Float"], + ["MUL_D","Y","Multiply two double precision values","M","2","All","Double -> Double -> Double"], + ["MUL_F","Y","Multiply two floating point single precision values","ADD_D","2","All","Float -> Float -> Float"], + ["DIV_D","Y","Divide two double precision values","M","2","All","Double -> Double -> Double"], + ["DIV_F","Y","Divide two floating point single precision values","ADD_D","2","All","Float -> Float -> Float"], + ["NEG_D","Y","Negate a double precision value","M","1","All","Float -> Float"], + ["NEG_F","Y","Negate a floating point single precision value","NEG_D","1","All","Float -> Float"], + ["ABS_W","Y","Absolute value of an integer","M","1","All","Int -> Int"], + ["ABS_L","Y","Absolute value of a long integer","ABS_W","1","All","Integer -> Integer"], + ["ABS_D","Y","Absolute value of a double precision ","M","1","All","Double -> Double"], + ["ABS_F","Y","Absolute value of a floating","ABS_D","1","All","Float -> Float"], + ["SIGNUM_W","Y","Sign of an integer","M","1","All","Int -> Int"], + ["SIGNUM_L","Y","Sign of a long integer","SIGNUM_W","1","All","Integer -> Integer"], + ["SIGNUM_D","Y","Sign of a double","M","1","All","Double -> Double"], + ["SIGNUM_F","Y","Sign of a float","SIGNUM_D","1","All","Float -> Float"], + ["LE_D","Y","Compare two double values for less or equal","M","2","All","Double -> Double -> Prelude;Bool"], + ["LE_F","Y","Compare two floating values for less or equal","LE_D","2","All","Float -> Float -> Prelude;Bool"], + ["LT_D","Y","Compare two double values for less","M","2","All","Double -> Double -> Prelude;Bool"], + ["LT_F","Y","Compare two floating values for less","LT_D","2","All","Float -> Float -> Prelude;Bool"], + ["GE_D","Y","Compare two double values for greater or equal","M","2","All","Double -> Double -> Prelude;Bool"], + ["GE_F","Y","Compare two floating values for greater or equal","GE_D","2","All","Float -> Float -> Prelude;Bool"], + ["GT_D","Y","Compare two double values for greater","M","2","All","Double -> Double -> Prelude;Bool"], + ["GT_F","Y","Compare two floating values for greater","GT_D","2","All","Float -> Float -> Prelude;Bool"], + ["EQ_D","Y","Compare two double values for equality","E [2]","2","All","Double -> Double -> Prelude;Bool"], + ["EQ_F","Y","Compare two floating values for equality","E","2","All","Float -> Float -> Prelude;Bool"], + ["NE_D","Y","Compare two double values for non-equality","E","2","All","Double -> Double -> Prelude;Bool"], + ["NE_F","Y","Compare two floating values for non-equality","E","2","All","Float -> Float -> Prelude;Bool"], + ["CMP_D","Y","Compare two double values","M","2","All","Double -> Double -> Prelude;Ordering"], + ["CMP_F","Y","Compare two floating values","CMP_D","2","All","Float -> Float -> Prelude;Ordering"], + ["CAST_LW","Y","Cast long integer to integer","M","1","All","Integer -> Int"], + ["CAST_WL","Y","Cast integer to long integer","M","1","All","Int -> Integer"], + ["CAST_WD","Y","Cast integer to double","M","1","All","Int -> Double"], + ["CAST_WF","Y","Cast integer to float","CAST_WD","1","All","Int -> Float"], + ["CAST_LD","Y","Cast long integer to double","CAST_WD","1","All","Integer -> Double"], + ["CAST_LF","Y","Cast long integer to float","CAST_WD","1","All","Integer-> Float"], + ["CAST_DF","Y","Cast double to float","M","1","All","Double -> Float"], + ["CAST_RD","Y","Cast rational to double","M","1","All","Rational -> Double"], + ["CAST_RF","Y","Cast rational to float","CAST_RD","1","All","Rational -> Float"], + ["CAST_WC","Y","Cast integer to character","M","1","All","Int -> Char"], + ["CAST_CW","Y","Cast character to integer","M","1","All","Char -> Int"], + ["MAX_W","Y","Maximal value of an integer","M","0","None","Int"], + ["MIN_W","Y","Minimal value of an integer","M","0","None","Int"], + ["MAX_C","Y","Maximal value of a character","M","0","None","Char"], + ["ISUPR_C","Y","Character in Unicode categories: Lu | Lt","M","1","All","Char -> Prelude;Bool"], + ["ISLOW_C","Y","Character in Unicode categories: Ll","M","1","All","Char -> Prelude;Bool"], + ["ISALP_C","Y","Character in Unicode categories: Lu | Ll | Lt | Lm | Lo","M","1","All","Char -> Prelude;Bool"], + ["ISALN_C","Y","Character in Unicode categories: Lu through No","M","1","All","Char -> Prelude;Bool"], + ["ISPRT_C","Y","Character in Unicode catrgories: Lu through Zs","M","1","All","Char -> Prelude;Bool"], + ["TOUPR_C","Y","Change character case to upper","M","1","All","Char -> Char"], + ["TOLOW_C","Y","Change character case to lower","M","1","All","Char -> Char"], + ["TOTIT_C","Y","Change character case to title","TOUPR_C","1","All","Char -> Char"], + ["UCAT_C","Y","Character Unicode category","M","1","All","Char -> Int"], + ["SIN_F","Y","Sine of a float","M","1","All","Float -> Float"], + ["COS_F","Y","Cosine of a float","M","1","All","Float -> Float"], + ["TAN_F","Y","Tangent of a float","M","1","All","Float -> Float"], + ["ASIN_F","Y","Arcsine of a float","M","1","All","Float -> Float"], + ["ACOS_F","Y","Arccos. of a float","M","1","All","Float -> Float"], + ["ATAN_F","Y","Arctan. of a float","M","1","All","Float -> Float"], + ["EXP_F","Y","Exponent of a float","M","1","All","Float -> Float"], + ["LOG_F","Y","Nat. logarithm of a float","M","1","All","Float -> Float"], + ["SQRT_F","Y","Square root of a float","M","1","All","Float -> Float"], + ["SIN_D","Y","Sine of a double","M","1","All","Double -> Double"], + ["COS_D","Y","Cosine of a double","M","1","All","Double -> Double"], + ["TAN_D","Y","Tangent of a double","M","1","All","Double -> Double"], + ["ASIN_D","Y","Arcsine of a double","M","1","All","Double -> Double"], + ["ACOS_D","Y","Arccos. of a double","M","1","All","Double -> Double"], + ["ATAN_D","Y","Arctan. of a double","M","1","All","Double -> Double"], + ["EXP_D","Y","Exponent of a double","M","1","All","Double -> Double"], + ["LOG_D","Y","Nat. logarithm of a double","M","1","All","Double -> Double"], + ["SQRT_D","Y","Square root of a double","M","1","All","Double -> Double"], + ["RADIX_F","Y","Constant 2","M","0","","Int"], + ["DIGITS_F","Y","Significant digits in a float","M","0","","Int"], + ["MINEXP_F","Y","Minimal exponent of a float","M","0","","Int"], + ["MAXEXP_F","Y","Maximal exponent of a float","M","0","","Int"], + ["ENC_F","Y","Encode a float from significand and exponent","M","2","All","Integer -> Int -> Float"], + ["DEC_F","Y","Decode a float into significand and exponent","M","1","All","Float -> (Integer, Int)"], + ["DIGITS_D","Y","Significant digits in a double","M","0","","Int"], + ["MINEXP_D","Y","Minimal exponent of a double","M","0","","Int"], + ["MAXEXP_D","Y","Maximal exponent of a double","M","0","","Int"], + ["ENC_D","Y","Encode a double from significand and exponent","M","2","All","Integer -> Int -> Double"], + ["DEC_D","Y","Decode a double into significand and exponent","M","1","All","Double -> (Integer, Int)"], + ["THROW_E","Y","Throw an exception","M","1","None","Exception -> a"], + ["SEQ","Y","Evaluates its first argument to head normal form, and then returns its second argument as the result.","M","2","All","a -> b -> b"], + ["QRM_W","Y","Combination of QUOT_W and REM_W","M","2","All","Int -> Int -> (Int, Int)"], + ["QRM_L","Y","Combination of QUOT_L and REM_L","QRM_W","2","All","Integer -> Integer -> (Integer, Integer)"], + ["STRICT_APP","Y","Strict application: always forces its argument","M","2","FT","(a -> b) -> a -> b"], + ["SEL_ELEM","Y","Select an Nth element from a data structure","M","3","FTT","a -> b -> Int -> c"], + ["SHOWS_W","Y","Show an Int value","O","3","All","Int -> a -> String -> String"], + ["SHOWS_L","Y","Show and Integer value","SHOWS_W","3","All","Int -> a -> String -> String"], + ["SHOWS_D","Y","Show a double value","M","3","All","Double -> a -> String -> String"], + ["SHOWS_F","Y","Show a floating value","SHOWS_D","3","All","Float -> String -> String"]] + diff --git a/Yhc/Core/Selector.hs b/Yhc/Core/Selector.hs new file mode 100644 --- /dev/null +++ b/Yhc/Core/Selector.hs @@ -0,0 +1,35 @@ +module Yhc.Core.Selector ( + coreSelectorIndex) where + +import Data.List +import Data.Maybe +import Yhc.Core + +-- |Given an expr (normally a CoreApp) +-- tell if it is an application of a selector function +-- to a data object. Selector functions consist of a single +-- CoreCase statement with the only alternative. Application +-- must be exactly to one argument. The case alternative must +-- be a constructor application to field selectors, and +-- the return value must be one of the selectors. +-- If the analysis condition is satisfied, constructor name and +-- a field index are returned. Otherwise empty string and -1 are returned. +-- The index returned is zero-based. + +coreSelectorIndex :: Core -> CoreFuncName -> (CoreCtorName, Int) + +coreSelectorIndex core fn = x + where + nosel = ("", -1) + unpos (CorePos _ e) = unpos e + unpos e = e + x = case coreFuncMaybe core fn of + (Just func@CoreFunc {coreFuncArgs = (a:[])}) -> + case unpos (coreFuncBody func) of + CoreCase _ [(PatCon con sels, (CoreVar ce))] -> + case fromMaybe (-1) (elemIndex ce sels) of + (-1) -> nosel + n -> (con, n) + _ -> nosel + _ -> nosel + diff --git a/Yhc/Core/StrictAnno.hs b/Yhc/Core/StrictAnno.hs new file mode 100644 --- /dev/null +++ b/Yhc/Core/StrictAnno.hs @@ -0,0 +1,87 @@ +-- Version of the Yhc.Core.Strictness module, but based on +-- Core Annotations. + +module Yhc.Core.StrictAnno ( + coreStrictAnno) where + +import Yhc.Core.Type +import Yhc.Core.Prim +import Yhc.Core.Annotation +import Yhc.Core.AnnotatePrims + +import qualified Data.Map as Map +import Data.List(intersect, nub, partition) + +{- +ALGORITHM: + +SCC PARTIAL SORT: +First sort the functions so that they occur in the childmost order: +x1 < x2, if x1 doesn't transitive-call x2, and x2 does transitive-call x1 +Being wrong is fine, but being better gives better results + +PRIM STRICTNESS: +The strictness of the various primitive operations + +BASE STRICTNESS: +If all paths case on a particular value, then these are strict in that one +If call onwards, then strict based on the caller +-} + + +-- | Given a function, return a list of arguments. +-- True is strict in that argument, False is not. +-- [] is unknown strictness +-- + +coreStrictAnno :: CoreAnnotations -> Core -> (CoreFuncName -> [Bool]) + +coreStrictAnno anno core = \funcname -> Map.findWithDefault [] funcname mp + where mp = mapStrictAnno anno $ sccSort $ coreFuncs core + + +mapStrictAnno anno funcs = foldl f Map.empty funcs + where + f mp (prim@CorePrim{coreFuncName = name}) = + case getAnnotation prim "Strictness" anno of + Nothing -> mp + Just (CoreStrictness bs) -> Map.insert name bs mp + + f mp func@(CoreFunc name args body) = case getAnnotation func "Strictness" anno of + Just (CoreStrictness bs) -> Map.insert name bs mp + Nothing -> Map.insert name (map (`elem` strict) args) mp + where + strict = strictVars body + + -- which variables are strict + strictVars :: CoreExpr -> [String] + strictVars (CorePos _ x) = strictVars x + strictVars (CoreVar x) = [x] + + strictVars (CoreCase (CoreVar x) alts) = + nub $ x : intersectList (map (strictVars . snd) alts) + + strictVars (CoreCase x alts) = strictVars x + + strictVars (CoreApp (CoreFun x) xs) + | length xs == length res + = nub $ concatMap strictVars $ map snd $ filter fst $ zip res xs + where res = Map.findWithDefault [] x mp + + strictVars (CoreApp x xs) = strictVars x + + strictVars _ = [] + + + + +intersectList :: Eq a => [[a]] -> [a] +intersectList [] = [] +intersectList xs = foldr1 intersect xs + + +-- do a sort in approximate SCC order +sccSort :: [CoreFunc] -> [CoreFunc] +sccSort xs = prims ++ funcs + where (prims,funcs) = partition isCorePrim xs + diff --git a/Yhc/Core/Unreachable.hs b/Yhc/Core/Unreachable.hs new file mode 100644 --- /dev/null +++ b/Yhc/Core/Unreachable.hs @@ -0,0 +1,43 @@ +-- Unreachability + +module Yhc.Core.Unreachable ( +-- *Unreachability +-- $unreach + coreUnreachableFuncs + ,coreUnreachableDatas) where + +import Yhc.Core +import qualified Data.Set as S + +-- $unreach 'Yhc.Core.Reachable.coreReachable' fails if any of the +-- function\/constructor calls cannot be matched by a function defined in the +-- linked Core. The two functions provided in this module help detect +-- missing (in other words, unreachable) functions to give user alerts, +-- or to automatically create some missing items where possible. + +-- |Determine missing (unreachable) functions. +-- /All functions called/ except /All functions defined/ + + +coreUnreachableFuncs :: Core -> [CoreFuncName] + +coreUnreachableFuncs core = + let cfuns = coreFuncs core + calledBy fn = [f | CoreFun f <- universeExpr fn] + called = foldl (flip S.insert) S.empty (concat $ map calledBy cfuns) + defined = S.fromList (map coreFuncName cfuns) + in S.toList (called S.\\ defined) + +-- |Determine missing (unreachable) data constructors. +-- /All ctors called\/used in patterns/ except /All ctors defined/ + +coreUnreachableDatas :: Core -> [CoreCtorName] + +coreUnreachableDatas core = + let called = S.fromList $ [x | CoreCon x <- universeExpr core] ++ + [x | CoreCase _ alts <- universeExpr core, (PatCon x _,_) <- alts] + defined = S.fromList $ map coreCtorName $ + concat $ map coreDataCtors $ coreDatas core + in S.toList (called S.\\ defined) + + diff --git a/configure b/configure new file mode 100644 --- /dev/null +++ b/configure @@ -0,0 +1,10 @@ +#!/bin/sh + +# This shell script is not related to GNU Autoconf. +# It will be run by the Cabal Setup program during the configuration phase. +# Cabal Setup program for this package uses defaultMainWithHooks. + +exec runhugs csvprim/GenPrimTable.hs csvprim/20081121.csv \ + Yhc/Core/PrimAnnoRaw.hs \ + Yhc.Core.PrimAnnoRaw + diff --git a/csvprim/20080629.csv b/csvprim/20080629.csv new file mode 100644 --- /dev/null +++ b/csvprim/20080629.csv @@ -0,0 +1,111 @@ +Primitive Name,Use Row,Primitive Semantics,Status [1],Arity,Strictness,Type Signature,Front-End Mappings +,,,,,,,Yhc,Hugs,GHC +,,Arithmetic Primitives +ADD_W,Y,Add two integer values,M,2,All,Int -> Int -> Int,ADD_W,Prelude;primPlusInt +ADD_L,Y,Add two long integer values,ADD_W,2,All,Integer -> Integer -> Integer,YHC.Primitive;PrimIntegerAdd,Prelude;primPlusInteger +SUB_W,Y,Subtract two integer values,M,2,All,Int -> Int -> Int,SUB_W,Prelude;primMinusInt +SUB_L,Y,Subtract two long integer values,SUB_W,2,All,Integer -> Integer -> Integer,YHC.Primitive;PrimIntegerSub,Prelude;primMinusInteger +NEG_W,Y,Negate an integer value,M,1,All,Int -> Int,NEG_W,Prelude;primNegInt +NEG_L,Y,Negate a long integer value,NEG_W,1,All,Integer -> Integer,YHC.Primitive;PrimIntegerNeg,Prelude;primNegInteger +EQ_W,Y,Compare two integer values for equality,M,2,All,Int -> Int -> Bool,EQ_W,Prelude;primEqInt +EQ_L,Y,Compare two long integer values for equality,EQ_W,2,All,Integer -> Integer -> Bool,YHC.Primitive;primIntegerEq,Prelude;primEqInteger +NE_W,Y,Compare two integer values for non-equality,M,2,All,Int -> Int -> Bool,NE_W +NE_L,Y,Compare two long integer values for non-equality,NE_W,2,All,Integer -> Integer -> Bool,YHC.Primitive;primIntegerNe +LE_W,Y,Compare two integer values for less or equal,M,2,All,Int -> Int -> Bool,LE_W +LE_L,Y,Compare two long integer values for less or equal,LE_W,2,All,Integer -> Integer -> Bool,YHC.Primitive;primIntegerLe +LT_W,Y,Compare two integer values for less,M,2,All,Int -> Int -> Bool,LT_W +LT_L,Y,Compare two long integer values for less,LT_W,2,All,Integer -> Integer -> Bool,YHC.Primitive;primIntegerLt +GE_W,Y,Compare two integer values for greater or equal,M,2,All,Int -> Int -> Bool,GE_W +GE_L,Y,Compare two long integer values for greater or equal,GE_W,2,All,Integer -> Integer -> Bool,YHC.Primitive;primIntegerGe +GT_W,Y,Compare two integer values for greater,M,2,All,Int -> Int -> Bool,GT_W +GT_L,Y,Compare two long integer values for greater,GT_W,2,All,Integer -> Integer -> Bool,YHC.Primitive;primIntegerGt +CMP_W,Y,Compare two integer values,M,2,All,Int -> Int -> Ordering,,Prelude;primCmpInt +CMP_L,Y,Compare two long integer values,CMP_W,2,All,Integer -> Integer -> Ordering,,Prelude;primCmpInteger +MUL_W,Y,Multiply two integer values,M,2,All,Int -> Int -> Int,MUL_W,Prelude;primMulInt +MUL_L,Y,Multiply two long integer values,MUL_W,2,All,Integer -> Integer -> Integer,YHC.Primitive;PrimIntegerMul,Prelude;primMulInteger +MOD_W,Y,Remainder of flooring integer division,M,2,All,Int -> Int -> Int +MOD_L,Y,Remainder of flooring long integer division,MOD_W,2,All,Integer -> Integer -> Integer +DIV_W,Y,Quotient of flooring integer division,M,2,All,Int -> Int -> Int +DIV_L,Y,Quotient of flooring long integer division,DIV_W,2,All,Integer -> Integer -> Integer +REM_W,Y,Remainder of trunc to zero integer division,M,2,All,Int -> Int -> Int +REM_L,Y,Remainder of trunc to zero long integer division,REM_W,2,All,Integer -> Integer -> Integer +QUOT_W,Y,Quotient of trunc to zero integer division,M,2,All,Int -> Int -> Int +QUOT_L,Y,Quotient of trunc to zero long integer division,QUOT_W,2,All,Integer -> Integer -> Integer +ADD_D,Y,Add two double precision values,M,2,All,Double -> Double -> Double,ADD_D,Prelude;primPlusDouble +ADD_F,Y,Add two floating point single precision values,ADD_D,2,All,Float -> Float -> Float,ADD_F,Prelude;primPlusFloat +ADD_D,Y,Subtract two double precision values,M,2,All,Double -> Double -> Double,SUB_D,Prelude;primMinusDouble +SUB_F,Y,Subtract two floating point single precision values,ADD_D,2,All,Float -> Float -> Float,SUB_F,Prelude;primMinusFloat +MUL_D,Y,Multiply two double precision values,M,2,All,Double -> Double -> Double,MUL_D,Prelude;primMulDouble +MUL_F,Y,Multiply two floating point single precision values,ADD_D,2,All,Float -> Float -> Float,MUL_F,Prelude;primMulFloat +DIV_D,Y,Divide two double precision values,M,2,All,Double -> Double -> Double,SLASH_D,Prelude;primDivDouble +DIV_F,Y,Divide two floating point single precision values,ADD_D,2,All,Float -> Float -> Float,SLASH_F,Prelude;primDivFloat +NEG_D,Y,Negate a double precision value,M,1,All,Float -> Float,NEG_D,Prelude;primNegDouble +NEG_F,Y,Negate a floating point single precision value,NEG_D,1,All,Float -> Float,NEG_F,Prelude;primNegFloat +ABS_W,Y,Absolute value of an integer,M,1,All,Int -> Int,YHC.Primitive;primIntAbs +ABS_L,Y,Absolute value of a long integer,ABS_W,1,All,Integer -> Integer +ABS_D,Y,Absolute value of a double precision ,M,1,All,Double -> Double +ABS_F,Y,Absolute value of a floating,ABS_D,1,All,Float -> Float +SIGNUM_W,Y,Sign of an integer,M,1,All,Int -> Int,YHC.Primitive;primIntSignum +SIGNUM_L,Y,Sign of a long integer,SIGNUM_W,1,All,Integer -> Integer +SIGNUM_D,Y,Sign of a double,M,1,All,Double -> Double +SIGNUM_F,Y,Sign of a float,SIGNUM_D,1,All,Float -> Float +LE_D,Y,Compare two double values for less or equal,M,2,All,Double -> Double -> Bool,LE_D +LE_F,Y,Compare two floating values for less or equal,LE_D,2,All,Float -> Float -> Bool,LE_F +LT_D,Y,Compare two double values for less,M,2,All,Double -> Double -> Bool,LT_D +LT_F,Y,Compare two floating values for less,LT_D,2,All,Float -> Float -> Bool,LT_F +GE_D,Y,Compare two double values for greater or equal,M,2,All,Double -> Double -> Bool,GE_D +GE_F,Y,Compare two floating values for greater or equal,GE_D,2,All,Float -> Float -> Bool,GE_F +GT_D,Y,Compare two double values for greater,M,2,All,Double -> Double -> Bool,GT_D +GT_F,Y,Compare two floating values for greater,GT_D,2,All,Float -> Float -> Bool,GT_F +EQ_D,Y,Compare two double values for equality,E [2],2,All,Double -> Double -> Bool,EQ_D +EQ_F,Y,Compare two floating values for equality,E,2,All,Float -> Float -> Bool,EQ_F +NE_D,Y,Compare two double values for non-equality,E,2,All,Double -> Double -> Bool,EQ_D +NE_F,Y,Compare two floating values for non-equality,E,2,All,Float -> Float -> Bool,EQ_F +CMP_D,Y,Compare two double values,M,2,All,Double -> Double -> Ordering,,Prelude;primCmpDouble +CMP_F,Y,Compare two floating values,CMP_D,2,All,Float -> Float -> Ordering,,Prelude;primCmpFloat +CAST_LW,Y,Cast long integer to integer,M,1,All,Integer -> Int,YHC.Primitive;primIntFromInteger,Prelude;primIntegerToInt +CAST_WL,Y,Cast integer to long integer,M,1,All,Int -> Integer,YHC.Primitive;primIntegerFromInt,Prelude;primIntToInteger +CAST_LD,Y,Cast long integer to double,M,1,All,Integer -> Double,YHC.Primitive;primDoubleFromInteger,Prelude;primIntegerToDouble +,,Character/Unicode Primitives +MAX_C,Y,Maximal value of a character,M,0,None,Char,,Prelude;primMaxChar +ISUPR_C,Y,Character in Unicode categories: Lu | Lt,M,1,All,Char -> Bool,,Prelude;primIsUpper +ISLOW_C,Y,Character in Unicode categories: Ll,M,1,All,Char -> Bool,,Prelude;primIsLower +ISALP_C,Y,Character in Unicode categories: Lu | Ll | Lt | Lm | Lo,M,1,All,Char -> Bool,,Prelude;primIsAlpha +ISALN_C,Y,Character in Unicode categories: Lu through No,M,1,All,Char -> Bool,,Prelude;primIsAlphaNum +ISPRT_C,Y,Character in Unicode catrgories: Lu through Zs,M,1,All,Char -> Bool,,Prelude;isPrint +TOUPR_C,Y,Change character case to upper,M,1,All,Char -> Char,,Prelude;toUpper +TOLOW_C,Y,Change character case to lower,M,1,All,Char -> Char,,Prelude;toLower +TOTIT_C,Y,Change character case to title,TOUPR_C,1,All,Char -> Char,,Hugs.Char;toTitle +UCAT_C,Y,Character Unicode category,M,1,All,Char -> Int,,Hugs.Char;primUniGenCat +,,Math/Floating point Primitives +SIN_F,Y,Sine of a float,M,1,All,Float -> Float,,Prelude;primSinFloat +COS_F,Y,Cosine of a float,M,1,All,Float -> Float,,Prelude;primCosFloat +TAN_F,Y,Tangent of a float,M,1,All,Float -> Float,,Prelude;primTanFloat +ASIN_F,Y,Arcsine of a float,M,1,All,Float -> Float,,Prelude;primAsinFloat +ACOS_F,Y,Arccos. of a float,M,1,All,Float -> Float,,Prelude;primAcosFloat +ATAN_F,Y,Arctan. of a float,M,1,All,Float -> Float,,Prelude;primAtanFloat +EXP_F,Y,Exponent of a float,M,1,All,Float -> Float,,Prelude;primExpFloat +LOG_F,Y,Nat. logarithm of a float,M,1,All,Float -> Float,,Prelude;primLogFloat +SQRT_F,Y,Square root of a float,M,1,All,Float -> Float,,Prelude;primSqrtFloat +SIN_D,Y,Sine of a double,M,1,All,Double -> Double,,Prelude;primSinDouble +COS_D,Y,Cosine of a double,M,1,All,Double -> Double,,Prelude;primCosDouble +TAN_D,Y,Tangent of a double,M,1,All,Double -> Double,,Prelude;primTanDouble +ASIN_D,Y,Arcsine of a double,M,1,All,Double -> Double,,Prelude;primAsinDouble +ACOS_D,Y,Arccos. of a double,M,1,All,Double -> Double,,Prelude;primAcosDouble +ATAN_D,Y,Arctan. of a double,M,1,All,Double -> Double,,Prelude;primAtanDouble +EXP_D,Y,Exponent of a double,M,1,All,Double -> Double,,Prelude;primExpDouble +LOG_D,Y,Nat. logarithm of a double,M,1,All,Double -> Double,,Prelude;primLogDouble +SQRT_D,Y,Square root of a double,M,1,All,Double -> Double,,Prelude;primSqrtDouble +RADIX_F,Y,Constant 2,M,0,,Int,,"Prelude;primFloatRadix, Prelude;primDoubleRadix" +DIGITS_F,Y,Significant digits in a float,M,0,,Int,,Prelude;primFloatDigits +MINEXP_F,Y,Minimal exponent of a float,M,0,,Int,,Prelude;primFloatMinExp +MAXEXP_F,Y,Maximal exponent of a float,M,0,,Int,,Prelude;primFloatMaxExp +ENC_F,Y,Encode a float from significand and exponent,M,2,All,Integer -> Int -> Float,,Prelude;primFloatEncode +DEC_F,Y,Decode a float into significand and exponent,M,1,All,"Float -> (Integer, Int)",,Prelude;primFloatDecode +DIGITS_D,Y,Significant digits in a double,M,0,,Int,,Prelude;primDoubleDigits +MINEXP_D,Y,Minimal exponent of a double,M,0,,Int,,Prelude;primDoubleMinExp +MAXEXP_D,Y,Maximal exponent of a double,M,0,,Int,,Prelude;primDoubleMaxExp +ENC_D,Y,Encode a double from significand and exponent,M,2,All,Integer -> Int -> Double,,Prelude;primDoubleEncode +DEC_D,Y,Decode a double into significand and exponent,M,1,All,"Double -> (Integer, Int)",,Prelude;primDoubleDecode + + diff --git a/csvprim/GenPrimTable.hs b/csvprim/GenPrimTable.hs new file mode 100644 --- /dev/null +++ b/csvprim/GenPrimTable.hs @@ -0,0 +1,67 @@ +-- A configure-time tool to build annotations for normal +-- Core primitives from the CSV file obtained from the Google +-- Spreadsheet that is maintained by the Yhc Core Team +-- and contains the source of normal primitives annotation. +-- Whether runhugs or runghc runs this program, the `csv' +-- package should be properly installed and visible. + +-- CSV record format is (7 fields): +-- [0]: primitive name +-- [1]: "Y" if this record is usable +-- [2]: primitive description +-- [3]: implementation mandatory ("M") or can be substituted with +-- [4]: arity +-- [5]: strictness (All | [TF]* | "") +-- [6]: type signature + +module Main where + +import System.Environment +import System.Directory +import System.FilePath +import System.Exit +import System.IO +import Control.Monad +import Data.List +import Text.CSV + +main = do + args <- getArgs + prog <- getProgName + cd <- getCurrentDirectory + when (length args < 3) $ do + hPutStrLn stderr $ prog ++ ": three arguments needed" + exitWith (ExitFailure 1) + let [csv, outf] = map (cd ) (take 2 args) + outmod = head (drop 2 args) + putStrLn $ prog ++ ": converting \n from: " ++ csv ++ + "\n to: " ++ outf ++ + "\n as: " ++ outmod + csvrecs <- parseCSVFromFile csv >>= return . + map (take 7) . + filter usable . + either (\e -> error $ show e) id + hout <- openFile outf WriteMode + mapM (hPutStrLn hout) (modHeader outmod) + hPutStrLn hout "rawPrimAnno :: [[String]]" + hPutStrLn hout "rawPrimAnno = [" + let inddef = map ((" " ++) . show) csvrecs + catdef = concat $ intersperse ",\n" inddef + hPutStrLn hout $ catdef ++ "]\n" + hClose hout + putStrLn $ prog ++ ": done" + +-- Autogenerated module header (based on the module name provided) + +modHeader md = [ + "-- Raw annotations for Core Normal Primitives (autogenerated, do not edit!!!)" + ,"module " ++ md ++ "(rawPrimAnno) where\n"] + +-- Filter records based on the condition that number of elements in a record +-- is at least 7, and the second element is "Y". + +usable :: [Field] -> Bool + +usable rec@(_: "Y": _) = length rec >= 7 +usable _ = False + diff --git a/ycextra.cabal b/ycextra.cabal new file mode 100644 --- /dev/null +++ b/ycextra.cabal @@ -0,0 +1,37 @@ +Cabal-Version: >= 1.2 +Name: ycextra +Version: 0.1 +Copyright: 2008, Dmitry Golubovsky and The Yhc Team +Maintainer: golubovsky@gmail.com +Homepage: http://www.haskell.org/haskellwiki/Yhc +License: BSD3 +License-File: LICENSE +Build-Type: Simple +Data-Files: configure, csvprim/GenPrimTable.hs + csvprim/20080629.csv +Author: Dmitry Golubovsky +Synopsis: Additional utilities to work with Yhc Core. +Description: + Additional utilities for Yhc Core developed as by-products + of front- and back-ends, also for possible inclusion + to the Yhc Core package. +Category: Development + +Flag splitBase + Description: Choose the new smaller, split-up base package. + +Library + if flag(splitBase) + build-depends: base >= 3, mtl, containers + else + build-depends: base < 3, mtl + build-depends: mtl, uniplate, yhccore, csv + + Exposed-modules: + Yhc.Core.Extra, Yhc.Core.AnnotatePrims, Yhc.Core.StrictAnno + Yhc.Core.Unreachable, Yhc.Core.MapNames, Yhc.Core.Annotation, + Yhc.Core.Selector + Other-modules: + Yhc.Core.PrimAnnoRaw + +