diff --git a/gibbon-compiler/examples/movie/Basics.hs b/gibbon-compiler/examples/movie/Basics.hs deleted file mode 100644 index eabf63455..000000000 --- a/gibbon-compiler/examples/movie/Basics.hs +++ /dev/null @@ -1,427 +0,0 @@ --- Same code from the blog management benchmark by Vidush, a few functions are reused in this benchmark. -module Basics where - -import Gibbon.Prelude -import Gibbon.PList -import Gibbon.Vector -import Gibbon.Maybe - -type Text = Vector Char - ---type Target = (Text, Text) ---type Attr = (Text, (PList Text), (PList (Text, Text))) ---type Format = Format Text - --- For simplicity, we are assuming for this benchmark that data Inline is tokenized at the "word" level. --- Therefore, The Base case where "Text" is used is going to be a single word, i.e, "Str Text". -data Inline = Str Text - | Emph (PList Inline) - -- | Underline (PList Inline) - -- | Strong (PList Inline) - -- | Strikeout (PList Inline) - -- | Superscript (PList Inline) - -- | Subscript (PList Inline) - -- | SmallCaps (PList Inline) - -- | Quoted QuoteType (PList Inline) - -- | Cite [Citation] (PList Inline) - -- | Code Attr Text - | Space - -- | SoftBreak - -- | LineBreak - -- | Math MathType Text - -- | RawInline Format Text - -- | Link Attr (PList Inline) Target - -- | Image Attr (PList Inline) Target - -- | Note (PList Block) - -- | Span Attr (PList Inline) - deriving (Show) - -data Block = Plain (PList Inline) - -- | Para (PList Inline) - -- | LineBlock (PList (PList Inline)) - -- | CodeBlock Attr Text - -- | RawBlock Format Text - -- | BlockQuote (PList Block) - -- | OrderedList ListAttributes [[Block]] - -- | BulletList (PList (PList Block)) - -- | DefinitionList PList ( PList Inline , PList (PList Block) ) ---> This is resulting in a compile time error (TODO: DEBUG) - -- | Header Int Attr (PList Inline) - -- | HorizontalRule - -- | Table Attr Caption [ColSpec] TableHead [TableBody] TableFoot - -- | Div Attr (PList Block) - | Null - deriving (Show) - --- Define Blog elements -data BlogHeader = Header Text -data BlogId = ID Int -data BlogAuthor = Author Text -data BlogDate = Date Text -data BlogContent = Content Block -data BlogTags = TagList (PList Text) - --- Define packed Blog data Type/s, we can arrange the fields here to change their relative ordering. -data Blog = End - | Layout1 (BlogHeader) (BlogId) (BlogAuthor) (BlogDate) (BlogContent) (BlogTags) (Blog) - | Layout2 (BlogContent) (BlogTags) (Blog) (BlogHeader) (BlogId) (BlogAuthor) (BlogDate) - | Layout3 (BlogTags) (Blog) (BlogContent) (BlogHeader) (BlogId) (BlogAuthor) (BlogDate) - | Layout4 (BlogTags) (BlogContent) (Blog) (BlogHeader) (BlogId) (BlogAuthor) (BlogDate) - | Layout5 (Blog) (BlogTags) (BlogContent) (BlogHeader) (BlogId) (BlogAuthor) (BlogDate) - | Layout6 (BlogHeader) (BlogId) (BlogAuthor) (BlogDate) (BlogContent) (Blog) (BlogTags) - | Layout7 (Blog) (BlogContent) (BlogHeader) (BlogId) (BlogAuthor) (BlogDate) (BlogTags) - | Layout8 (BlogContent) (Blog) (BlogId) (BlogAuthor) (BlogDate) (BlogHeader) (BlogTags) - deriving (Show) - - -getChar :: Int -> Char -getChar decimal = - if decimal == 0 then '!' - else if decimal == 1 then '#' - else if decimal == 2 then '$' - else if decimal == 3 then '%' - else if decimal == 4 then '&' - else if decimal == 5 then '(' - else if decimal == 6 then ')' - else if decimal == 7 then '*' - else if decimal == 8 then '+' - else if decimal == 9 then ',' - else if decimal == 10 then '-' - else if decimal == 11 then '.' - else if decimal == 12 then '/' - else if decimal == 13 then '0' - else if decimal == 14 then '1' - else if decimal == 15 then '2' - else if decimal == 16 then '3' - else if decimal == 17 then '4' - else if decimal == 18 then '5' - else if decimal == 19 then '6' - else if decimal == 20 then '7' - else if decimal == 21 then '8' - else if decimal == 22 then '9' - else if decimal == 23 then ':' - else if decimal == 24 then ';' - else if decimal == 25 then '<' - else if decimal == 26 then '=' - else if decimal == 27 then '>' - else if decimal == 28 then '?' - else if decimal == 29 then '@' - else if decimal == 30 then 'A' - else if decimal == 31 then 'B' - else if decimal == 32 then 'C' - else if decimal == 33 then 'D' - else if decimal == 34 then 'E' - else if decimal == 35 then 'F' - else if decimal == 36 then 'G' - else if decimal == 37 then 'H' - else if decimal == 38 then 'I' - else if decimal == 39 then 'J' - else if decimal == 40 then 'K' - else if decimal == 41 then 'L' - else if decimal == 42 then 'M' - else if decimal == 43 then 'N' - else if decimal == 44 then 'O' - else if decimal == 45 then 'P' - else if decimal == 46 then 'Q' - else if decimal == 47 then 'R' - else if decimal == 48 then 'S' - else if decimal == 49 then 'T' - else if decimal == 50 then 'U' - else if decimal == 51 then 'V' - else if decimal == 52 then 'W' - else if decimal == 53 then 'X' - else if decimal == 54 then 'Y' - else if decimal == 55 then 'Z' - else if decimal == 56 then '[' - else if decimal == 57 then ']' - else if decimal == 58 then '^' - else if decimal == 59 then '_' - else if decimal == 60 then '`' - else if decimal == 61 then 'a' - else if decimal == 62 then 'b' - else if decimal == 63 then 'c' - else if decimal == 64 then 'd' - else if decimal == 65 then 'e' - else if decimal == 66 then 'f' - else if decimal == 67 then 'g' - else if decimal == 68 then 'h' - else if decimal == 69 then 'i' - else if decimal == 70 then 'j' - else if decimal == 71 then 'k' - else if decimal == 72 then 'l' - else if decimal == 73 then 'm' - else if decimal == 74 then 'n' - else if decimal == 75 then 'o' - else if decimal == 76 then 'p' - else if decimal == 77 then 'q' - else if decimal == 78 then 'r' - else if decimal == 79 then 's' - else if decimal == 80 then 't' - else if decimal == 81 then 'u' - else if decimal == 82 then 'v' - else if decimal == 83 then 'w' - else if decimal == 84 then 'x' - else if decimal == 85 then 'y' - else if decimal == 86 then 'z' - else if decimal == 87 then '{' - else if decimal == 88 then '|' - else if decimal == 89 then '}' - else '~' - -mkChar :: Int -> Char -mkChar val = getChar (mod rand 91) - --- Get a random word, Int is the length of the string. --- Based on internet, average english word is 5 characters long -getRandomString :: Int -> Text -getRandomString length = generate length mkChar - --- Utility Functions to make Blogs and its Elements. -mkBlogHeader :: Text -> BlogHeader -mkBlogHeader text = Header text - -mkBlogID :: Int -> BlogId -mkBlogID val = ID val - -mkBlogAuthor :: Text -> BlogAuthor -mkBlogAuthor text = Author text - -mkBlogDate :: Text -> BlogDate -mkBlogDate text = Date text - -mkBlogContent :: Block -> BlogContent -mkBlogContent block = Content block - -mkBlogTags :: (PList Text) -> BlogTags -mkBlogTags taglist = TagList taglist - - -getFile :: Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Int -> Text -getFile f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 select = - if (select == 0) then f1 - else if (select == 1) then f2 - else if (select == 2) then f3 - else if (select == 3) then f4 - else if (select == 4) then f5 - else if (select == 5) then f6 - else if (select == 6) then f7 - else if (select == 7) then f8 - else if (select == 8) then f9 - else f10 - - -mkListFiles :: Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Int -> PList Text -mkListFiles f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 len = if len < 0 then Nil - else - let f = (getFile f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 len) - rst = (mkListFiles f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 (len - 1)) - in Cons f rst - - -checkBlogID :: BlogId -> Int -> Bool -checkBlogID id val = case id of - ID x -> if ( x == val ) then True - else False - --- Function to compare two words, each represented by Vector Char. -compareWord :: Text -> Text -> Bool -compareWord word1 word2 = - let len1 = length word1 - len2 = length word2 - compare_len = if (len1 == len2) then True else False - in if (compare_len) then (cmp 0 len1 word1 word2) else False - --- Compare 2 Vector Char (Text) or words for equality if their length is the same. -cmp :: Int -> Int -> Vector Char -> Vector Char -> Bool -cmp start end word1 word2 = - if (start < end) then - let a = nth word1 start - b = nth word2 start - eq = if (a *==* b) then True else False - recurse = cmp (start+1) end word1 word2 - in (eq && recurse) - else True - --- Search a TagList (PList Text) for some keyword -searchTagList :: Text -> PList Text -> Bool -searchTagList keyword taglist = case taglist of - Nil -> False - Cons word rst -> (compareWord keyword word) || (searchTagList keyword rst) - --- delete a keyword in a TagList -deleteTagList :: Text -> PList Text -> PList Text -deleteTagList keyword taglist = case taglist of - Nil -> Nil - Cons word rst -> if (compareWord keyword word) then (deleteTagList keyword rst) - else Cons word (deleteTagList keyword rst) - - -insertTagList :: Text -> PList Text -> PList Text -insertTagList keyword taglist = case taglist of - Nil -> (Cons keyword) Nil - Cons word rst -> insertTagList keyword rst - --- Tell if a particular keyword exists in a Block data type or not -isKeywordPresentInBlock :: Text -> Block -> Bool -isKeywordPresentInBlock keyword contentBlock = - case contentBlock of - Plain list_inline -> (searchInlineListForKeyword keyword list_inline) - --Para list_inline -> (searchInlineListForKeyword keyword list_inline) - --BlockQuote list_block -> (searchBlockListForKeyword keyword list_block) - --HorizontalRule -> False - Null -> False - --- Tell if a particular keyword exists in an inline data type or not. (search a Inline) -isKeywordPresentInline :: Text -> Inline -> Bool -isKeywordPresentInline keyword inline = - case inline of - Str text -> (compareWord keyword text) - Emph list_inline -> (searchInlineListForKeyword keyword list_inline) - --Underline list_inline -> (searchInlineListForKeyword keyword list_inline) - --Strong list_inline -> (searchInlineListForKeyword keyword list_inline) - --Strikeout list_inline -> (searchInlineListForKeyword keyword list_inline) - --Superscript list_inline -> (searchInlineListForKeyword keyword list_inline) - --Subscript list_inline -> (searchInlineListForKeyword keyword list_inline) - --SmallCaps list_inline -> (searchInlineListForKeyword keyword list_inline) - Space -> False - --SoftBreak -> False - --LineBreak -> False - --Note list_block -> (searchBlockListForKeyword keyword list_block) - --- Search a block list for a particular keyword -searchBlockListForKeyword :: Text -> PList Block -> Bool -searchBlockListForKeyword keyword block_list = - case block_list of - Nil -> False - Cons block rst -> (isKeywordPresentInBlock keyword block) || (searchBlockListForKeyword keyword rst) - --- Search an Inline list for a particular keyword -searchInlineListForKeyword :: Text -> PList Inline -> Bool -searchInlineListForKeyword keyword inline_list = - case inline_list of - Nil -> False - Cons inline rst -> (isKeywordPresentInline keyword inline) || (searchInlineListForKeyword keyword rst) - --- Emphasize a particular keyword in a Block type -emphasizeKeywordInBlock :: Text -> Block -> Block -emphasizeKeywordInBlock keyword contentBlock = - case contentBlock of - Plain list_inline -> Plain (emphasizeInlineListForKeyword keyword list_inline) - --Para list_inline -> Para (emphasizeInlineListForKeyword keyword list_inline) - --BlockQuote list_block -> BlockQuote (emphasizeKeywordInBlockList keyword list_block) - --HorizontalRule -> HorizontalRule - Null -> Null - --- Emphasize a particular keyword in an Inline data type -emphasizeKeywordInline :: Text -> Inline -> Inline -emphasizeKeywordInline keyword inline = - case inline of - Str text -> let isSame = compareWord keyword text - --_ = printsym (quote "NEWLINE") - --_ = printbool isSame - --_ = printsym (quote "NEWLINE") - in if (isSame) then let - newlist :: PList Inline - newlist = (Cons (copyPacked inline)) Nil -- ---> Here we had to use a call to copyPacked in order to copy over the inline to a new region, otherwise segfaults. - in (Emph newlist) - else inline - Emph list_inline -> Emph (emphasizeInlineListForKeyword keyword list_inline) - --Underline list_inline -> Underline (emphasizeInlineListForKeyword keyword list_inline) - --Strong list_inline -> Strong (emphasizeInlineListForKeyword keyword list_inline) - --Strikeout list_inline -> Strikeout (emphasizeInlineListForKeyword keyword list_inline) - --Superscript list_inline -> Superscript (emphasizeInlineListForKeyword keyword list_inline) - --Subscript list_inline -> Subscript (emphasizeInlineListForKeyword keyword list_inline) - --SmallCaps list_inline -> SmallCaps (emphasizeInlineListForKeyword keyword list_inline) - Space -> Space - --SoftBreak -> SoftBreak - --LineBreak -> LineBreak - --Note list_block -> Note (emphasizeKeywordInBlockList keyword list_block) - --- Emphasize a particular keyword in an Inline list -emphasizeInlineListForKeyword :: Text -> PList Inline -> PList Inline -emphasizeInlineListForKeyword keyword inline_list = - case inline_list of - Nil -> Nil - Cons inline rst -> let - newinline = emphasizeKeywordInline keyword inline - rst' = emphasizeInlineListForKeyword keyword rst - in Cons newinline rst' - --- Emphasize a particular keyword in a block list -emphasizeKeywordInBlockList :: Text -> PList Block -> PList Block -emphasizeKeywordInBlockList keyword block_list = - case block_list of - Nil -> Nil - Cons block rst -> let - newBlock = emphasizeKeywordInBlock keyword block - rst' = emphasizeKeywordInBlockList keyword rst - in Cons newBlock rst' - - -searchBlogTags :: Text -> BlogTags -> Bool -searchBlogTags keyword tags = case tags of - TagList list -> searchTagList keyword list - - -deleteBlogTags :: Text -> BlogTags -> BlogTags -deleteBlogTags keyword tags = case tags of - TagList list -> TagList (deleteTagList keyword list) - -insertBlogTags :: Text -> BlogTags -> BlogTags -insertBlogTags keyword tags = case tags of - TagList list -> TagList (insertTagList keyword list) - --- emphasize blog content, if present is True -emphasizeBlogContent' :: Text -> BlogContent -> BlogContent -emphasizeBlogContent' keyword oldContent = case oldContent of - Content block -> Content (emphasizeKeywordInBlock keyword block) - - -{- # INLINE # -} -emphasizeBlogContent :: Text -> BlogContent -> Bool -> BlogContent -emphasizeBlogContent keyword oldContent present = case oldContent of - Content block -> if (present) - then Content (emphasizeKeywordInBlock keyword block) - else Content block - -searchBlogContent :: Text -> BlogContent -> Bool -searchBlogContent keyword content = case content of - Content block -> (isKeywordPresentInBlock keyword block) - - -fileToContent :: Vector Char -> Vector Char -> PList Inline -> Int -> Int -> Block -fileToContent file word plist_inline index max_len = - if index >= max_len then (Plain plist_inline) - else let - character :: Char - character = nth file index - isSpace = if ( character *==* (head " ") ) then True else False - char_vec = (singleton character) - plist_space :: PList Inline - plist_space = (Cons (Space) plist_inline) - in if (isSpace) then (fileToContent file (singleton (nth file (index+1))) (Cons (Str word) plist_inline) (index+2) max_len) - else (fileToContent file (append word char_vec) (plist_inline) (index+1) max_len) - -fileToTags :: Vector Char -> Vector Char -> Int -> Int -> PList Text -fileToTags file word index max_len = - if index >= max_len then Nil - else let - character :: Char - character = nth file index - isSpace = if ( character *==* (head " ") ) then True else False - char_vec = (singleton character) - in if (isSpace) then Cons word (fileToTags file (singleton (nth file (index+1))) (index+2) max_len) - else (fileToTags file (append word char_vec) (index+1) max_len) - - -mkTagsFromText :: Text -> BlogTags -mkTagsFromText f' = - let tags = fileToTags f' (singleton (nth f' 0)) 1 (vlength f') - tags' = TagList tags - in tags' - - -mkContentFromText :: Text -> BlogContent -mkContentFromText f = - let block = fileToContent f (singleton (nth f 0)) Nil 1 (vlength f) - content = mkBlogContent block - in content \ No newline at end of file diff --git a/gibbon-compiler/examples/movie/GenerateMovieLayout.hs b/gibbon-compiler/examples/movie/GenerateMovieLayout.hs deleted file mode 100644 index c759b88bb..000000000 --- a/gibbon-compiler/examples/movie/GenerateMovieLayout.hs +++ /dev/null @@ -1,9 +0,0 @@ -module GenerateMovieLayout where -import Movies - - -gibbon_main = - let - test = mkMovieContent 'a' - _ = printPacked test - in () \ No newline at end of file diff --git a/gibbon-compiler/examples/movie/clean.py b/gibbon-compiler/examples/movie/clean.py deleted file mode 100644 index 62b767efc..000000000 --- a/gibbon-compiler/examples/movie/clean.py +++ /dev/null @@ -1,20 +0,0 @@ -# modified based on clean.py from blog management -import os -import subprocess - -gibbon_file_names = ["test","testInsertmovie", "testSearchMovie", "testDeleteMovie"] - -# layouts = ["layout1", "layout2", "layout3", "layout4", "layout5", "layout6", "layout7", "layout8"] - -print("Cleaning out the c files and binaries") - -#Compilation phase -for file_name in gibbon_file_names: - - filename_c = file_name + ".c" - filename_exe = file_name + ".exe" - gibbon_cmd_c = subprocess.run(["rm", filename_c]) - gibbon_cmd_bin = subprocess.run(["rm", filename_exe]) - gibbon_cmd_bin = subprocess.run(["rm", file_name]) - - diff --git a/gibbon-compiler/examples/movie/movies.hs b/gibbon-compiler/examples/movie/movies.hs deleted file mode 100644 index a147f8dc0..000000000 --- a/gibbon-compiler/examples/movie/movies.hs +++ /dev/null @@ -1,190 +0,0 @@ -module Movies where --- import Data.Map -import Gibbon.Prelude -import Gibbon.PList -import Gibbon.Vector -import Gibbon.Maybe -import Basics --- ​ -type Text = Vector Char --- ​ -type IsMovie = Bool -type MovieTitle = Text -type ReleaseDate = Text -type Director = Text -type Writers = PList Text -type CastInfo = PList Text -type MovieTags = PList Text -type Rating = Int - --- --if IsMovie == True, the maybe values will exist -data Movie = Empty - | Movie MovieTitle - ReleaseDate Director Writers CastInfo - MovieTags Rating - -data MovieTrie = Root - | MovieTrie (Maybe Char) (Maybe IsMovie) (Maybe Movie) (Maybe (PList MovieTrie)) deriving (Show) - --- intToVec :: Int -> (Vector Int) --- intToVec i = let --- remainder = mod i 10 --- quotient = div i 10 --- in if(quotient == 0) then singleton remainder --- else append (intToVec quotient) (singleton remainder) --- intToChar :: Int -> Char --- intToChar i = case i of --- 0 -> '0' --- 1 -> '1' --- 2 -> '2' --- 3 -> '3' --- 4 -> '4' --- 5 -> '5' --- 6 -> '6' --- 7 -> '7' --- 8 -> '8' --- 9 -> '9' --- intToText :: (Vector Int) -> Text --- intToText i = if (length i == 1) then --- movieToText :: Movie -> Text --- movieToText m = case m of --- Empty -> "empty Movie" --- Movie c title date director wrriters castinfo movietags rating -> -mkMovieContent :: Text -> Movie -mkMovieContent t = - let - movietitle = t - rdate = (getRandomString 5) - director = (getRandomString 6) - writer = Cons (getRandomString 5) Nil - cast = Cons (getRandomString 5) Nil - movietag = Cons (getRandomString 5) Nil - rating = 5 - in Movie movietitle rdate director writer cast movietag rating - ---insert a movie into movieTrie -insertMovie :: Text -> (Maybe Char) -> Movie -> MovieTrie -> MovieTrie -insertMovie t c m mt = - if (length t == 0) - then case mt of - Root -> MovieTrie c (Just True) (Just m) Nothing - MovieTrie c ismovie movie cmovieTrie -> MovieTrie c (Just True) (Just m) cmovieTrie - else - case mt of - Root -> MovieTrie c (Just False) Nothing (Just (Cons (insertMovie (tail t) (Just (head t)) m Root) Nil)) - MovieTrie c ismovie movie cmovieTrie -> MovieTrie c ismovie movie (Just (insert_Mhelper t m (fromMaybe Nil cmovieTrie))) - -movieGetChar :: MovieTrie -> Maybe Char -movieGetChar mt = case mt of - Root -> Nothing - -- let _ = printsym (quote "nothing") - -- in Nothing - MovieTrie c ismovie movie lmt -> c - -- let _ = printchar (fromMaybe ' ' c) - -- in c - -insert_Mhelper :: Text -> Movie -> (PList MovieTrie) -> (PList MovieTrie) -insert_Mhelper t m lmt = - case lmt of - Nil -> Cons (insertMovie (tail t) (Just (head t)) m Root) Nil - Cons x xs -> if (fromMaybe ' ' (movieGetChar x)) *==* head t then Cons (insertMovie (tail t) (Just (head t)) m x) xs - else Cons x (insert_Mhelper t m xs) - -deleteMovie :: Text -> MovieTrie -> MovieTrie -deleteMovie t mt = - if (length t == 0) - then case mt of - Root -> mt - MovieTrie c ismovie movie cmovieTrie -> if (fromMaybe False ismovie) then MovieTrie c (Just False) (Nothing) cmovieTrie - else MovieTrie c ismovie movie cmovieTrie - else - case mt of - Root -> Root - MovieTrie c ismovie movie cmovieTrie -> MovieTrie c ismovie movie (Just (delete_Mhelper t (fromMaybe Nil cmovieTrie))) - - -delete_Mhelper :: Text -> (PList MovieTrie) -> (PList MovieTrie) -delete_Mhelper t lmt = - case lmt of - Nil -> Nil - Cons x xs -> if(fromMaybe ' ' (movieGetChar x)) *==* head t then Cons (deleteMovie (tail t) x) xs - else Cons x (delete_Mhelper t xs) ---given movietitle, find movie return empty if not found -searchMovieTitle :: Text -> MovieTrie -> Movie -searchMovieTitle t mt = - if (length t == 0) then case mt of - Root -> Empty - MovieTrie c ismovie movie cmovieTrie -> if (fromMaybe False ismovie) then (fromMaybe Empty movie) else Empty - else - case mt of - Root -> Empty - MovieTrie c ismovie movie cmovieTrie -> if (isNothing cmovieTrie) then Empty - else - let - a = fromMaybe Nil cmovieTrie - in - case a of - Nil -> Empty - Cons x xs -> search_Mhelper t (Cons x xs) - -search_Mhelper :: Text -> (PList MovieTrie) -> Movie -search_Mhelper t lmt = - case lmt of - Nil -> Empty - Cons x xs -> if (fromMaybe ' ' (movieGetChar x)) *==* (head t) - then searchMovieTitle (tail t) x - else search_Mhelper t xs - --- searchMovieRating :: Int -> MovieTrie ->(PList Movie) -> (PList Movie) --- searchMovieTitle i mt lm = --- case mt of --- Root -> Nil --- MovieTrie c ismovie movie cmovieTrie -> --- let --- rating = getMovieRating (fromMaybe Empty movie) --- in if (rating > i) then Cons (fromMaybe Empty movie) (Search_MRhelper i cmovieTrie ) --- else Search_MRhelper i cmovieTrie - --- search_MRhelper :: Int -> (PList MovieTrie) -> (PList Movie) -> (PList Movie) - --- getMovieRating :: Movie -> Int --- getMovieRating m = case m of --- Empty -> 0 --- Movie movietitle releasedate director writers casinfo movitags rating -> rating - --- generateNode :: Char -> MovieTrie -> MovieTrie --- generateNode a mt = --- insertMovie :: Text -> MovieTrie -> MovieTrie --- insertMovie title mt = --- if isEmpty title then mt --- else if mt == End then --- let --- a = head title --- b = tail title --- curNode = MovieTrie Nothing (singleton a) insertMovie b End --- in curNode - -isEmptyM :: Movie -> Bool -isEmptyM m = case m of - Empty -> True - Movie _ _ _ _ _ _ _ ->False - -genMovieList :: Int -> (PList Text) -genMovieList i = - if (i == 0) - then Nil - else - let - a = mod rand 10 - t = getRandomString a - nt = genMovieList (i - 1) - in Cons t nt - -consMovieTrie :: (PList Text) -> MovieTrie ->MovieTrie -consMovieTrie lt mt = - case lt of - Nil -> mt - Cons x xs -> - let - movieContent = mkMovieContent x - in consMovieTrie xs (insertMovie x Nothing movieContent mt) \ No newline at end of file diff --git a/gibbon-compiler/examples/movie/searchMovie.ans b/gibbon-compiler/examples/movie/searchMovie.ans deleted file mode 100644 index 6bcf4b2e8..000000000 --- a/gibbon-compiler/examples/movie/searchMovie.ans +++ /dev/null @@ -1 +0,0 @@ -#t \ No newline at end of file diff --git a/gibbon-compiler/examples/movie/searchMovie.hs b/gibbon-compiler/examples/movie/searchMovie.hs deleted file mode 100644 index dd8d1705e..000000000 --- a/gibbon-compiler/examples/movie/searchMovie.hs +++ /dev/null @@ -1,19 +0,0 @@ -import Movies - -type Text = Vector Char - -getTitle :: Movie -> Text -getTitle m = case m of - Empty -> " " - Movie mt rd d w ci movietags rating -> mt - -gibbon_main = - let - movielist = genMovieList 100 - movie1 = fromMaybe " " (nth_plist movielist Nothing 10 ) - len1 = vlength movie1 - mt = consMovieTrie movielist Root - mv = searchMovieTitle movie1 mt - foundmovie = getTitle mv - len2 = vlength foundmovie - in len1 ==len2 diff --git a/gibbon-compiler/examples/movie/test.hs b/gibbon-compiler/examples/movie/test.hs deleted file mode 100644 index dbf495303..000000000 --- a/gibbon-compiler/examples/movie/test.hs +++ /dev/null @@ -1,69 +0,0 @@ -import Movies --- data Ttext = Ttext (Vector Char) -printMovieTrie :: MovieTrie -> () -printMovieTrie mt = case mt of - Root -> printsym (quote "nothing") - MovieTrie ch ismovie movie lmt -> if (isNothing ch) then - let - _ = printsym (quote "/") - in if (isNothing lmt) then () - else print_MThelper (fromMaybe Nil lmt) - else let - a = fromMaybe ' ' ch - _ = printchar a - in if (isNothing lmt) then () - else print_MThelper (fromMaybe Nil lmt) -print_MThelper :: (PList MovieTrie)->() -print_MThelper lmt = case lmt of - Nil -> () - Cons x xs -> case x of - Root -> print_MThelper xs - MovieTrie ch ismovie movie lmt -> let - _ = printchar (fromMaybe ' ' ch) - _ = print_MThelper (fromMaybe Nil lmt) - in print_MThelper xs - -gibbon_main = - -- let - -- -- testMovie = Movie 'a' "MovieTitle" "ReleaseDate" - -- -- testMovie = Empty - -- ttext = Ttext "fsaf" - -- -- testMovieTrie = MovieTrie (Just testMovie) (Just "Word") (Nothing) - -- -- testMovieTrie = MovieTrie testMovie - -- -- _ = printPacked testMovie - - -- _ = printsym (quote "NEWLINE") - -- _ = printPacked ttext - -- -- _ = printsym (quote "NEWLINE") - -- in () - -- putStrLn getRandomString 13 - let - ri = mod rand 10 - ri2 = mod rand 10 - _ = printint ri2 - _ = printint ri - -- smovie = mkMovieContent "titan" - -- movieT = insertMovie "titan" Nothing smovie Root - -- _ = printsym (quote " ") - -- _ = printMovieTrie movieT - -- movieT = insertMovie "titen" Nothing smovie movieT - -- _ = printsym (quote " ") - -- _ = printMovieTrie movieT - -- _ = printsym (quote "test") - -- mc = iterate (searchMovieTitle "tit" movieT) - -- movieT = deleteMovie "titan" movieT - -- _ = printsym (quote " ") - -- _ = printMovieTrie movieT - - -- _ = printPacked mc - -- _ = printPacked movieT - -- let - -- _ = case movieT of - -- Empty -> printsym (quote "empty") - -- MovieTrie _ _ _ _ _ _ ->printsym (quote "valid") - -- in ( - -- _ = printMovieTrie movieT - -- _ = if isEmptyM mc then printsym(quote "notfound") else printsym (quote "found") - -- _ = printPacked - -- _ = printsym (quote "a") - in () diff --git a/gibbon-compiler/examples/movie/testDeleteMovie.hs b/gibbon-compiler/examples/movie/testDeleteMovie.hs deleted file mode 100644 index 406e40ca2..000000000 --- a/gibbon-compiler/examples/movie/testDeleteMovie.hs +++ /dev/null @@ -1,16 +0,0 @@ -import Movies - -type Text = Vector Char - -testDelete :: (PList Text) -> MovieTrie -> MovieTrie -testDelete lt mt = - case lt of - Nil -> Root - Cons x xs -> testDelete xs (deleteMovie x mt) - -gibbon_main = - let - movielist = genMovieList 20 - mt = consMovieTrie movielist Root - mt2 = iterate (testDelete movielist mt) - in () \ No newline at end of file diff --git a/gibbon-compiler/examples/movie/testInsertmovie.hs b/gibbon-compiler/examples/movie/testInsertmovie.hs deleted file mode 100644 index 2b848d8ce..000000000 --- a/gibbon-compiler/examples/movie/testInsertmovie.hs +++ /dev/null @@ -1,13 +0,0 @@ -import Movies - -testInsert :: Int -> MovieTrie -> MovieTrie -testInsert i mt = if (i == 0) then mt - else - let - title = getRandomString (mod rand 10) - movieContent = mkMovieContent title - in testInsert (i-1) (insertMovie title Nothing movieContent mt) -gibbon_main = - let - mvt = iterate (testInsert 1000 Root) - in () \ No newline at end of file diff --git a/gibbon-compiler/examples/movie/testSearchMovie.hs b/gibbon-compiler/examples/movie/testSearchMovie.hs deleted file mode 100644 index 6d835fecb..000000000 --- a/gibbon-compiler/examples/movie/testSearchMovie.hs +++ /dev/null @@ -1,16 +0,0 @@ -import Movies - -type Text = Vector Char - -getTitle :: Movie -> Text -getTitle m = case m of - Empty -> " " - Movie mt rd d w ci movietags rating -> mt - -gibbon_main = - let - movielist = genMovieList 1000 - movie1 = fromMaybe " " (nth_plist movielist Nothing 100) - mt = consMovieTrie movielist Root - mv = iterate (searchMovieTitle movie1 mt) - in () diff --git a/gibbon-compiler/examples/movie/testvector.hs b/gibbon-compiler/examples/movie/testvector.hs deleted file mode 100644 index 47af00454..000000000 --- a/gibbon-compiler/examples/movie/testvector.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Tv where -import Gibbon.Vector -import Gibbon.Prelude -import Gibbon.Maybe -import Gibbon.Prim - -type Text = Vector Char - -testf :: Text -> Char -testf t = head t --- intToChar :: Int -> Char --- intToChar i = case i of --- -- 0 -> '0' --- 1 -> '1' --- 2 -> '2' --- 3 -> '3' --- 4 -> '4' --- 5 -> '5' --- 6 -> '6' --- 7 -> '7' --- 8 -> '8' --- 9 -> '9' -gibbon_main = - let - x = (quote "hello") - y = empty_hash - z = insert_hash y x (quote "world") - in if eqsym (lookup_hash z (quote "hello")) (quote "world") - then 42 - else 0 \ No newline at end of file diff --git a/gibbon-compiler/examples/movie/timings.py b/gibbon-compiler/examples/movie/timings.py deleted file mode 100644 index 5bfeb9ad1..000000000 --- a/gibbon-compiler/examples/movie/timings.py +++ /dev/null @@ -1,106 +0,0 @@ -# modified based on timings.py in blog management benchmark -import os -import subprocess -import re - -iterations = 9 - -rootdir = "/mnt/c/SURF/gibbon/gibbon-compiler/examples/layout_benchmarks/moviespointer" - -# ut_hash_include = "/local/scratch/a/singhav/Applications/src/uthash-2.3.0/include" - -# Passes = ["ContentSearch", "DeleteTag", "InsertTag", "TagSearch"] - -# layouts = ["layout1", "layout2", "layout3", "layout4", "layout5", "layout6", "layout7", "layout8"] -file_names = ["testInsertmovie","testDeleteMovie", "testSearchMovie"] -# file_names = ["testInsertmovie"] - -#Compilation phase -for filename in file_names: - - # gibbon_file_name = layout + myPass - - print() - print("Trying compilation for file " + filename + ".hs") - print() - - filename_haskell = filename + ".hs" - - haskell_cmd = "gibbon --packed --no-gc --toC " + filename_haskell - - print("The haskell command was: ") - print() - print(haskell_cmd) - print() - - gibbon_cmd_haskell = subprocess.run(["gibbon", "--pointer", "--no-gc", "--toC", filename_haskell]) - print("The exit code for the haskell command was %d" % gibbon_cmd_haskell.returncode) - print() - - filename_c = filename + ".c" - - gibbon_cmd = "gcc" + " -O3 " + " " + filename_c + " -o " + filename - print("The gcc command was: ") - print() - print(gibbon_cmd) - print() - - gibbon_cmd_c = subprocess.run(["gcc", "-O3" , filename_c, "-o", filename]) - print() - - print("The exit code for the gcc compilation was %d" % gibbon_cmd_c.returncode) - - - -Timings = {} - -#run the files and get the timings - -for filename in file_names: - - # gibbon_binary = layout + myPass - - print() - print("Running the binary " + str(filename)) - print() - - file_stats = filename + ".txt" - - cmd = "(" + "cd " + rootdir + " && " + "(" + "./" + filename + " --RUN " + str(iterations) + " > " + file_stats + ")" + ")" - - print(cmd) - - gibbon_binary_cmd = subprocess.call(cmd, shell=True) - - data = open(file_stats, 'r').read() - batch_time = re.findall("BATCHTIME: (.*)", data) - median_time = re.findall("SELFTIMED: (.*)", data) - - print() - print(batch_time) - print(median_time) - - print(float(batch_time[0])) - print(float(median_time[0])) - - batchTimes = float(batch_time[0]) - medianTimes = float(median_time[0]) - - averageTimes = float (batchTimes / iterations) - - tupleTimes = (averageTimes, medianTimes) - - print(tupleTimes) - - Timings[filename] = tupleTimes - - print() - -print(Timings) - -f = open("experiment_timings.txt", "w") - -for key, value in Timings.items(): - f.write('%s:(average:%s, median:%s)\n' % (key, value[0], value[1])) - -f.close() \ No newline at end of file diff --git a/gibbon-compiler/tests/test-gibbon-examples.yaml b/gibbon-compiler/tests/test-gibbon-examples.yaml index 024864512..bab20cba5 100644 --- a/gibbon-compiler/tests/test-gibbon-examples.yaml +++ b/gibbon-compiler/tests/test-gibbon-examples.yaml @@ -918,7 +918,7 @@ tests: - name: searchMovie.hs test-flags: ["--no-gc"] - dir: examples/movie - answer-file: examples/movie/searchMovie.ans + dir: examples/movie-micro-service + answer-file: examples/movie-micro-service/searchMovie.ans failing: [] runmodes: ["gibbon2", "pointer"] \ No newline at end of file