(issue4) Support the FeatureModel format exported by FeatureIDE

An initial implementation of this feature. Note, it is not fully integrated into
Hephaestus, as well as the current implementation does not support constraints yet.

#4

.gitignore

@@ -1,3 +1,5 @@
+.DS_STORE
+*.bak
 *.hi
 *.o
 *.*~

asset-base/component-model/src/ComponentModel/Parsers/AbsComponentModel.hs

@@ -1,20 +1,25 @@
+
+
 module ComponentModel.Parsers.AbsComponentModel where
 
 -- Haskell module generated by the BNF converter
 
-newtype Ident = Ident String deriving (Eq,Ord,Show)
+
+
+
+newtype Ident = Ident String deriving (Eq,Ord,Show,Read)
 data ComponentModel =
    TComponentModel [ComponentMapping]
-  deriving (Eq,Ord,Show)
+  deriving (Eq,Ord,Show,Read)
 
 data ComponentMapping =
    TComponentMapping Ident RelativePath
-  deriving (Eq,Ord,Show)
+  deriving (Eq,Ord,Show,Read)
 
 data RelativePath =
    BasicFilePath Ident
  | BasicFilePathExt Ident Ident
  | BasicFileExt Ident
  | ComposedFilePath Ident RelativePath
-  deriving (Eq,Ord,Show)
+  deriving (Eq,Ord,Show,Read)
 

asset-base/component-model/src/ComponentModel/Parsers/DocComponentModel.log

@@ -1,22 +1,16 @@
-This is pdfTeXk, Version 3.1415926-1.40.9 (Web2C 7.5.7) (format=latex 2008.8.22)  14 JAN 2010 10:24
+This is pdfTeX, Version 3.14159265-2.6-1.40.15 (TeX Live 2014) (preloaded format=latex 2014.5.25)  23 NOV 2014 08:35
 entering extended mode
+ restricted \write18 enabled.
  %&-line parsing enabled.
 **DocComponentModel.tex
 (./DocComponentModel.tex
-LaTeX2e <2005/12/01>
-Babel <v3.8l> and hyphenation patterns for english, usenglishmax, dumylang, noh
-yphenation, german-x-2008-06-18, ngerman-x-2008-06-18, ancientgreek, ibycus, ar
-abic, basque, bulgarian, catalan, pinyin, coptic, croatian, czech, danish, dutc
-h, esperanto, estonian, farsi, finnish, french, galician, german, ngerman, mono
-greek, greek, hungarian, icelandic, indonesian, interlingua, irish, italian, la
-tin, mongolian, mongolian2a, bokmal, nynorsk, polish, portuguese, romanian, rus
-sian, sanskrit, serbian, slovak, slovenian, spanish, swedish, turkish, ukenglis
-h, ukrainian, uppersorbian, welsh, loaded.
-
-(/usr/local/texlive/2008/texmf-dist/tex/latex/base/article.cls
-Document Class: article 2005/09/16 v1.4f Standard LaTeX document class
-(/usr/local/texlive/2008/texmf-dist/tex/latex/base/size11.clo
-File: size11.clo 2005/09/16 v1.4f Standard LaTeX file (size option)
+LaTeX2e <2014/05/01>
+Babel <3.9k> and hyphenation patterns for 78 languages loaded.
+
+(/usr/local/texlive/2014/texmf-dist/tex/latex/base/article.cls
+Document Class: article 2007/10/19 v1.4h Standard LaTeX document class
+(/usr/local/texlive/2014/texmf-dist/tex/latex/base/size11.clo
+File: size11.clo 2007/10/19 v1.4h Standard LaTeX file (size option)
 )
 \c@part=\count79
 \c@section=\count80
@@ -29,8 +23,7 @@ File: size11.clo 2005/09/16 v1.4f Standard LaTeX file (size option)
 \abovecaptionskip=\skip41
 \belowcaptionskip=\skip42
 \bibindent=\dimen102
-)
-No file DocComponentModel.aux.
+) (./DocComponentModel.aux)
 \openout1 = `DocComponentModel.aux'.
 
 LaTeX Font Info:    Checking defaults for OML/cmm/m/it on input line 9.
@@ -107,12 +100,12 @@ Underfull \hbox (badness 10000) in paragraph at lines 72--77
 
 [2] (./DocComponentModel.aux) ) 
 Here is how much of TeX's memory you used:
- 243 strings out of 493887
- 2701 string characters out of 1151122
- 52889 words of memory out of 3000000
- 3592 multiletter control sequences out of 10000+50000
- 9370 words of font info for 33 fonts, out of 3000000 for 5000
- 714 hyphenation exceptions out of 8191
- 21i,9n,19p,386b,185s stack positions out of 5000i,500n,10000p,200000b,50000s
-
-Output written on DocComponentModel.dvi (2 pages, 3656 bytes).
+ 245 strings out of 493118
+ 2749 string characters out of 6135459
+ 56906 words of memory out of 5000000
+ 3782 multiletter control sequences out of 15000+600000
+ 9370 words of font info for 33 fonts, out of 8000000 for 9000
+ 1141 hyphenation exceptions out of 8191
+ 21i,9n,19p,386b,185s stack positions out of 5000i,500n,10000p,200000b,80000s
+
+Output written on DocComponentModel.dvi (2 pages, 3660 bytes).

asset-base/component-model/src/ComponentModel/Parsers/ErrM.hs

@@ -7,6 +7,7 @@ module ComponentModel.Parsers.ErrM where
 -- the Error monad: like Maybe type with error msgs
 
 import Control.Monad (MonadPlus(..), liftM)
+import Control.Applicative (Applicative(..), Alternative(..))
 
 data Err a = Ok a | Bad String
   deriving (Read, Show, Eq, Ord)
@@ -15,7 +16,13 @@ instance Monad Err where
   return      = Ok
   fail        = Bad
   Ok a  >>= f = f a
-  Bad s >>= f = Bad s
+  Bad s >>= _ = Bad s
+
+instance Applicative Err where
+  pure = Ok
+  (Bad s) <*> _ = Bad s
+  (Ok f) <*> o  = liftM f o
+
 
 instance Functor Err where
   fmap = liftM
@@ -24,3 +31,7 @@ instance MonadPlus Err where
   mzero = Bad "Err.mzero"
   mplus (Bad _) y = y
   mplus x       _ = x
+
+instance Alternative Err where
+  empty = mzero
+  (<|>) = mplus

asset-base/component-model/src/ComponentModel/Parsers/LexComponentModel.x

@@ -2,9 +2,13 @@
 -- This Alex file was machine-generated by the BNF converter
 {
 {-# OPTIONS -fno-warn-incomplete-patterns #-}
+{-# OPTIONS_GHC -w #-}
 module ComponentModel.Parsers.LexComponentModel where
 
 
+
+import qualified Data.Bits
+import Data.Word (Word8)
 }
 
 
@@ -21,7 +25,7 @@ $u = [\0-\255]          -- universal: any character
 :-
 
 $white+ ;
-@rsyms { tok (\p s -> PT p (TS $ share s)) }
+@rsyms { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
 
 $l $i*   { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
 
@@ -31,41 +35,54 @@ $l $i*   { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
 
 {
 
+tok :: (Posn -> String -> Token) -> (Posn -> String -> Token)
 tok f p s = f p s
 
 share :: String -> String
 share = id
 
 data Tok =
-   TS !String     -- reserved words and symbols
- | TL !String     -- string literals
- | TI !String     -- integer literals
- | TV !String     -- identifiers
- | TD !String     -- double precision float literals
- | TC !String     -- character literals
+   TS !String !Int    -- reserved words and symbols
+ | TL !String         -- string literals
+ | TI !String         -- integer literals
+ | TV !String         -- identifiers
+ | TD !String         -- double precision float literals
+ | TC !String         -- character literals
 
  deriving (Eq,Show,Ord)
 
-data Token = 
+data Token =
    PT  Posn Tok
  | Err Posn
   deriving (Eq,Show,Ord)
 
+tokenPos :: [Token] -> String
 tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
 tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
 tokenPos _ = "end of file"
 
+tokenPosn :: Token -> Posn
+tokenPosn (PT p _) = p
+tokenPosn (Err p) = p
+
+tokenLineCol :: Token -> (Int, Int)
+tokenLineCol = posLineCol . tokenPosn
+
+posLineCol :: Posn -> (Int, Int)
 posLineCol (Pn _ l c) = (l,c)
+
+mkPosToken :: Token -> ((Int, Int), String)
 mkPosToken t@(PT p _) = (posLineCol p, prToken t)
 
+prToken :: Token -> String
 prToken t = case t of
-  PT _ (TS s) -> s
-  PT _ (TI s) -> s
-  PT _ (TV s) -> s
-  PT _ (TD s) -> s
-  PT _ (TC s) -> s
+  PT _ (TS s _) -> s
+  PT _ (TL s)   -> s
+  PT _ (TI s)   -> s
+  PT _ (TV s)   -> s
+  PT _ (TD s)   -> s
+  PT _ (TC s)   -> s
 
-  _ -> show t
 
 data BTree = N | B String Tok BTree BTree deriving (Show)
 
@@ -77,11 +94,13 @@ eitherResIdent tv s = treeFind resWords
                               | s > a  = treeFind right
                               | s == a = t
 
-resWords = N
-   where b s = B s (TS s)
+resWords :: BTree
+resWords = b ";" 3 (b "/" 2 (b "." 1 N N) N) (b "=>" 4 N N)
+   where b s n = let bs = id s
+                  in B bs (TS bs n)
 
 unescapeInitTail :: String -> String
-unescapeInitTail = unesc . tail where
+unescapeInitTail = id . unesc . tail . id where
   unesc s = case s of
     '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
     '\\':'n':cs  -> '\n' : unesc cs
@@ -106,27 +125,55 @@ alexMove (Pn a l c) '\t' = Pn (a+1)  l     (((c+7) `div` 8)*8+1)
 alexMove (Pn a l c) '\n' = Pn (a+1) (l+1)   1
 alexMove (Pn a l c) _    = Pn (a+1)  l     (c+1)
 
-type AlexInput = (Posn, -- current position,
-               Char,     -- previous char
-               String)   -- current input string
+type Byte = Word8
+
+type AlexInput = (Posn,     -- current position,
+                  Char,     -- previous char
+                  [Byte],   -- pending bytes on the current char
+                  String)   -- current input string
 
 tokens :: String -> [Token]
-tokens str = go (alexStartPos, '\n', str)
+tokens str = go (alexStartPos, '\n', [], str)
     where
-      go :: (Posn, Char, String) -> [Token]
-      go inp@(pos, _, str) =
+      go :: AlexInput -> [Token]
+      go inp@(pos, _, _, str) =
                case alexScan inp 0 of
-                AlexEOF                -> []
-                AlexError (pos, _, _)  -> [Err pos]
-                AlexSkip  inp' len     -> go inp'
-                AlexToken inp' len act -> act pos (take len str) : (go inp')
-
-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))
+                AlexEOF                   -> []
+                AlexError (pos, _, _, _)  -> [Err pos]
+                AlexSkip  inp' len        -> go inp'
+                AlexToken inp' len act    -> act pos (take len str) : (go inp')
+
+alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)
+alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s))
+alexGetByte (p, _, [], s) =
+  case  s of
+    []  -> Nothing
+    (c:s) ->
+             let p'     = alexMove p c
+                 (b:bs) = utf8Encode c
+              in p' `seq` Just (b, (p', c, bs, s))
 
 alexInputPrevChar :: AlexInput -> Char
-alexInputPrevChar (p, c, s) = c
+alexInputPrevChar (p, c, bs, s) = c
+
+-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.
+utf8Encode :: Char -> [Word8]
+utf8Encode = map fromIntegral . go . ord
+ where
+  go oc
+   | oc <= 0x7f       = [oc]
+
+   | oc <= 0x7ff      = [ 0xc0 + (oc `Data.Bits.shiftR` 6)
+                        , 0x80 + oc Data.Bits..&. 0x3f
+                        ]
+
+   | oc <= 0xffff     = [ 0xe0 + (oc `Data.Bits.shiftR` 12)
+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)
+                        , 0x80 + oc Data.Bits..&. 0x3f
+                        ]
+   | otherwise        = [ 0xf0 + (oc `Data.Bits.shiftR` 18)
+                        , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)
+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)
+                        , 0x80 + oc Data.Bits..&. 0x3f
+                        ]
 }