diff options
author | Stephen Dolan <mu@netsoc.tcd.ie> | 2012-09-18 17:44:43 +0100 |
---|---|---|
committer | Stephen Dolan <mu@netsoc.tcd.ie> | 2012-09-18 17:44:43 +0100 |
commit | a4eea165bbab6d13f89b59707e835d58b7014a66 (patch) | |
tree | b99ee5dde8540f8dbe5de3d87b99e04ac4dd2673 | |
parent | 25cbab056b1f73e96b636c88779a92400d92dc15 (diff) |
Move everything around - delete old Haskell code, clean up build.
-rw-r--r-- | .gitignore | 8 | ||||
-rw-r--r-- | JQ.hs | 157 | ||||
-rw-r--r-- | Lexer.x | 101 | ||||
-rw-r--r-- | Main.hs | 22 | ||||
-rw-r--r-- | Makefile (renamed from c/Makefile) | 20 | ||||
-rw-r--r-- | Parser.y | 78 | ||||
-rw-r--r-- | builtin.c (renamed from c/builtin.c) | 0 | ||||
-rw-r--r-- | builtin.h (renamed from c/builtin.h) | 0 | ||||
-rw-r--r-- | bytecode.c (renamed from c/bytecode.c) | 0 | ||||
-rw-r--r-- | bytecode.h (renamed from c/bytecode.h) | 0 | ||||
-rw-r--r-- | compile.c (renamed from c/compile.c) | 0 | ||||
-rw-r--r-- | compile.h (renamed from c/compile.h) | 0 | ||||
-rw-r--r-- | execute.c (renamed from c/execute.c) | 0 | ||||
-rw-r--r-- | forkable_stack.h (renamed from c/forkable_stack.h) | 0 | ||||
-rw-r--r-- | frame_layout.h (renamed from c/frame_layout.h) | 0 | ||||
-rw-r--r-- | gen_utf8_tables.py (renamed from c/gen_utf8_tables.py) | 0 | ||||
-rw-r--r-- | jv.c (renamed from c/jv.c) | 0 | ||||
-rw-r--r-- | jv.h (renamed from c/jv.h) | 0 | ||||
-rw-r--r-- | jv_dtoa.c (renamed from c/jv_dtoa.c) | 0 | ||||
-rw-r--r-- | jv_dtoa.h (renamed from c/jv_dtoa.h) | 0 | ||||
-rw-r--r-- | jv_parse.c (renamed from c/jv_parse.c) | 0 | ||||
-rw-r--r-- | jv_parse.h (renamed from c/jv_parse.h) | 0 | ||||
-rw-r--r-- | jv_print.c (renamed from c/jv_print.c) | 0 | ||||
-rw-r--r-- | jv_test.c (renamed from c/jv_test.c) | 0 | ||||
-rw-r--r-- | jv_unicode.c (renamed from c/jv_unicode.c) | 2 | ||||
-rw-r--r-- | jv_unicode.h (renamed from c/jv_unicode.h) | 0 | ||||
-rw-r--r-- | lexer.l (renamed from c/lexer.l) | 2 | ||||
-rw-r--r-- | locfile.h (renamed from c/locfile.h) | 0 | ||||
-rw-r--r-- | main.c (renamed from c/main.c) | 0 | ||||
-rw-r--r-- | opcode.c (renamed from c/opcode.c) | 0 | ||||
-rw-r--r-- | opcode.h (renamed from c/opcode.h) | 0 | ||||
-rw-r--r-- | opcode_list.h (renamed from c/opcode_list.h) | 0 | ||||
-rw-r--r-- | parser.h (renamed from c/parser.h) | 0 | ||||
-rw-r--r-- | parser.y (renamed from c/parser.y) | 2 | ||||
-rw-r--r-- | testdata (renamed from c/testdata) | 0 |
35 files changed, 16 insertions, 376 deletions
@@ -1,12 +1,10 @@ *.o *~ -# Autogenerated by flex/bison -lexer.yy.* -parser.tab.* -parser.info +# Autogenerated +*.gen.* # Test binaries jv_test jv_parse -parsertest
\ No newline at end of file +parsertest*~ @@ -1,157 +0,0 @@ -module JQ where -import Text.JSON -import Text.JSON.String -import Data.Maybe -import Data.List (sortBy,sort,groupBy) -import Data.Function (on) -import Data.Ord (comparing) -import Control.Monad -import Control.Monad.Writer -import Control.Monad.List -import Control.Monad.Reader - -type Path = [Either Int String] - -type Program = JSValue -> [(JSValue, Path)] - -type JQ = ReaderT JSValue (WriterT Path []) - -runJQ :: JQ a -> JSValue -> [a] -runJQ prog val = map fst $ runWriterT $ runReaderT prog val - -(>|) :: JQ JSValue -> JQ a -> JQ a -a >| b = do - val <- a - local (const val) b - -collect :: JQ a -> JQ [a] -collect prog = do - arg <- ask - return $ runJQ prog arg - -collectPaths :: JQ a -> JQ [(a,Path)] -collectPaths prog = do - arg <- ask - return $ runWriterT $ runReaderT prog arg - -insert :: JSValue -> (JSValue, Path) -> JSValue -insert base (replace, []) = replace -insert (JSArray values) (replace, ((Left n):rest)) = JSArray values' - where - (left, (_:right)) = splitAt n values - values' = left ++ [replace] ++ right -insert (JSObject obj) (replace, ((Right k):rest))= JSObject $ toJSObject obj' - where - withoutK = filter ((/= k) . fst) $ fromJSObject obj - obj' = (k, replace):withoutK - - -eqj a b = JSBool $ a == b - - -liftp :: (JSValue -> JSValue) -> JQ JSValue -liftp f = liftM f ask - -idp = undefined -failp t = [] - -constp :: JSValue -> Program -constp t t' = idp t - -anyj :: [JSValue] -> Bool -anyj values = any isTrue values - where - isTrue (JSBool False) = False - isTrue (JSNull) = False - isTrue _ = True - -selectp prog = do - match <- collect prog - guard $ anyj match - ask - -constStr :: String -> JQ JSValue -constStr = return . JSString . toJSString - -constInt :: Int -> JQ JSValue -constInt = return . JSRational False . toRational - -updatep p = do - t <- ask - liftM (foldl insert t) $ collectPaths p - -arrayp prog = liftM JSArray $ collect prog - - -childp' :: JSValue -> JQ JSValue -childp' (JSArray values) = msum [tell [Left i] >> return v | (v,i) <- zip values [0..]] -childp' (JSObject obj) = msum [tell [Right k] >> return v | (k,v) <- fromJSObject obj] -childp' _ = mzero - -childp = ask >>= childp' - ---findp :: Program -> Program -findp prog = do - found <- collect prog - if anyj found then ask else childp >| findp prog - -groupp prog = do - list <- ask - case list of - JSArray values -> do - marked <- forM values $ \v -> do - m <- collect (return v >| prog) - return (m,v) - msum $ - map (return . JSArray . map snd) $ - groupBy ((==) `on` fst) $ - sortBy (comparing fst) $ - marked - _ -> return JSNull - - - - -withArray f (JSArray values) = JSArray $ f values -withArray f x = x - -callp "select" [p] = selectp p -callp "find" [p] = findp p -callp "set" [p] = updatep p -callp "sort" [] = liftp (withArray sort) -callp "group" [p] = groupp p - -lookupj :: JSValue -> JSValue -> JQ JSValue -lookupj (JSArray values) (JSRational _ n) = do - let idx = round n - tell [Left idx] - if idx >= 0 && idx < length values - then return $ values !! idx - else return $ JSNull -lookupj (JSObject obj) (JSString s) = do - tell [Right (fromJSString s)] - case (lookup (fromJSString s) (fromJSObject obj)) of - Just x -> return x - Nothing -> return JSNull -lookupj _ _ = mzero - - -plusj (JSRational _ n1) (JSRational _ n2) = JSRational True (n1 + n2) -plusj (JSString s1) (JSString s2) = JSString $ toJSString (fromJSString s1 ++ fromJSString s2) -plusj (JSArray a1) (JSArray a2) = JSArray $ a1 ++ a2 - - -js :: JSON a => a -> JSValue -js = showJSON - -index s = do - v <- ask - lookupj v (js s) - - -dictp progs = do - liftM (JSObject . toJSObject) $ forM progs $ \(k,v) -> do - JSString k' <- k - v' <- v - return (fromJSString k', v') - diff --git a/Lexer.x b/Lexer.x deleted file mode 100644 index 700c69e6..00000000 --- a/Lexer.x +++ /dev/null @@ -1,101 +0,0 @@ -{ -module Lexer where -import Control.Monad.Error -} - -%wrapper "monadUserState" - -$digit = 0-9 -$alpha = [a-zA-Z_] -@reserved = "."|"["|"]"|","|":"|"("|")"|"{"|"}"|"|"|"=="|"+" -@ident = $alpha [$alpha $digit]* -@string = \" ($printable)* \" - - -tokens :- - -<0> $white+ ; -<0> @reserved { tok TRes } -<0> @ident { tok TIdent } -<0> $digit+ { tok $ TInt . read } - - -<0> \" { enterString } -<string> \" { leaveString } -<string> ($printable # [\"\\]) { pushString id } -<string> \\ [\"\\\/] { pushString (drop 1) } -<string> \\ [nrt] { pushString (escape . drop 1) } ---<string> \\ 'u' [0-9a-fA-F]{4} --- { pushString (parseUnicode . drop 2) } - --- @string { \s -> TString $ init $ tail s} - - -{ - -escape :: String -> String -escape "r" = "\r" -escape "n" = "\n" -escape "t" = "\t" - -getState :: Alex AlexState -getState = Alex $ \s -> Right (s, s) - -getUserState :: Alex AlexUserState -getUserState = liftM alex_ust getState - -setUserState :: AlexUserState -> Alex () -setUserState s' = Alex $ \s -> Right (s{alex_ust = s'}, ()) - -alexEOF = return $ Nothing - -enterString input len = do - setUserState [] - alexSetStartCode string - skip input len - -pushString f i@(p, _, s) len = do - buf <- getUserState - setUserState (buf ++ [f $ take len s]) - skip i len - -leaveString input len = do - s <- getUserState - alexSetStartCode 0 - return $ Just $ TString $ concat s - - -tok f (p,_,s) len = return $ Just $ f (take len s) -data Token = TRes String | TString String | TIdent String | TInt Int - -instance Show Token where - show (TRes t) = "token " ++ t - show (TString t) = "string " ++ t - show (TIdent t) = "identifier " ++ t - show (TInt t) = "integer " ++ show t - - -type AlexUserState = [String] - -alexInitUserState = undefined - -wrapError (Alex scanner) = Alex $ \s -> case scanner s of - Left message -> Left (message ++ " at " ++ showpos (alex_pos s)) - where - showpos (AlexPn off line col) = "line " ++ show line ++ ", column " ++ show col - x -> x - -scanner = do - tok <- wrapError alexMonadScan - case tok of - Nothing -> do - s <- getState - case alex_scd s of - 0 -> return [] - string -> alexError "Unterminated string literal" - Just tok -> liftM (tok:) scanner - -runLexer :: String -> Either String [Token] -runLexer input = runAlex input scanner - -}
\ No newline at end of file diff --git a/Main.hs b/Main.hs deleted file mode 100644 index 695520cb..00000000 --- a/Main.hs +++ /dev/null @@ -1,22 +0,0 @@ -import Parser -import Lexer -import JQ -import Text.JSON -import Text.JSON.String -import System.Environment -import Control.Monad -import System.IO - - -parseJS :: String -> JSValue -parseJS s = case runGetJSON readJSValue s of - Left err -> error err - Right val -> val - - -main = do - [program] <- getArgs - json <- liftM parseJS $ hGetContents stdin - case runLexer program >>= runParser of - Left err -> putStrLn err - Right program -> mapM_ (putStrLn . encode) (runJQ program json)
\ No newline at end of file @@ -8,23 +8,23 @@ clean: sed 's/.*`\(.*\)'\''.*/\1/' | grep -v '^all$$' | \ xargs rm -jv_utf8_tables.h: gen_utf8_tables.py +jv_utf8_tables.gen.h: gen_utf8_tables.py python $^ > $@ -lexer.yy.c: lexer.l - flex -o lexer.yy.c --header-file=lexer.yy.h lexer.l -lexer.yy.h: lexer.yy.c +lexer.gen.c: lexer.l + flex -o lexer.gen.c --header-file=lexer.gen.h lexer.l +lexer.gen.h: lexer.gen.c -parser.tab.c: parser.y lexer.yy.h - bison -W -d parser.y -v --report-file=parser.info -parser.tab.h: parser.tab.c +parser.gen.c: parser.y lexer.gen.h + bison -W -d parser.y -v --report-file=parser.gen.info -o $@ +parser.gen.h: parser.gen.c -jv_unicode.c: jv_utf8_tables.h +jv_unicode.c: jv_utf8_tables.gen.h -parsertest: parser.tab.c lexer.yy.c main.c opcode.c bytecode.c compile.c execute.c builtin.c jv.c jv_parse.c jv_print.c jv_dtoa.c jv_unicode.c +parsertest: parser.gen.c lexer.gen.c main.c opcode.c bytecode.c compile.c execute.c builtin.c jv.c jv_parse.c jv_print.c jv_dtoa.c jv_unicode.c $(CC) -DJQ_DEBUG=1 -o $@ $^ -jq: parser.tab.c lexer.yy.c main.c opcode.c bytecode.c compile.c execute.c builtin.c jv.c jv_parse.c jv_print.c jv_dtoa.c jv_unicode.c +jq: parser.gen.c lexer.gen.c main.c opcode.c bytecode.c compile.c execute.c builtin.c jv.c jv_parse.c jv_print.c jv_dtoa.c jv_unicode.c $(CC) -DJQ_DEBUG=0 -o $@ $^ jv_test: jv_test.c jv.c jv_print.c jv_dtoa.c jv_unicode.c diff --git a/Parser.y b/Parser.y deleted file mode 100644 index 544fe5b4..00000000 --- a/Parser.y +++ /dev/null @@ -1,78 +0,0 @@ -{ -module Parser where -import Lexer -import JQ -import Text.JSON -import Debug.Trace -import Data.List -import Control.Monad.Error -import Control.Monad.Reader -} - -%name runParser Exp -%tokentype { Token } - -%monad { Either String } -%error { \t -> fail $ "parse error: unexpected " ++ if null t then [] else (show $ head t) } - -%token - '|' { TRes "|" } - '.' { TRes "." } - '[' { TRes "[" } - ']' { TRes "]" } - '{' { TRes "{" } - '}' { TRes "}" } - '(' { TRes "(" } - ')' { TRes ")" } - ',' { TRes "," } - ':' { TRes ":" } - '==' { TRes "==" } - '+' { TRes "+" } - Ident { TIdent $$ } - String { TString $$ } - Int { TInt $$ } - -%left '|' -%left ',' -%nonassoc '==' -%left '+' - -%% - -Exp - : Exp '|' Exp { $1 >| $3 } - | Exp ',' Exp { $1 `mplus` $3 } - | Exp '==' Exp { liftM2 eqj $1 $3 } - | Exp '+' Exp { liftM2 plusj $1 $3 } - | Term { $1 } - -ExpD - : ExpD '|' ExpD { $1 >| $3 } - | ExpD '==' ExpD { liftM2 eqj $1 $3 } - | Term { $1 } - - -Term - : '.' { ask } - | Term '.' Ident { $1 >| index $3 } - | '.' Ident { index $2 } - | String { constStr $1 } - | Term '[' Exp ']' { do {t <- $1; i <- $3; lookupj t i} } - | Term '[' ']' { $1 >| childp } - | '(' Exp ')' { $2 } - | '[' Exp ']' { arrayp $2 } - | Int { constInt $1 } - | '{' MkDict '}' { dictp $2 } - | Ident '(' Exp ')' { callp $1 [$3] } - | Ident { callp $1 [] } - -MkDict - : { [] } - | MkDictPair { [$1] } - | MkDictPair ',' MkDict { $1:$3 } - -MkDictPair - : Ident ':' ExpD { (constStr $1, $3) } - | Ident { (constStr $1, index $1) } - | String ':' ExpD { (constStr $1, $3) } - | '(' Exp ')' ':' ExpD{ ($2, $5) } diff --git a/c/bytecode.c b/bytecode.c index bafd0474..bafd0474 100644 --- a/c/bytecode.c +++ b/bytecode.c diff --git a/c/bytecode.h b/bytecode.h index 5ffe80a6..5ffe80a6 100644 --- a/c/bytecode.h +++ b/bytecode.h diff --git a/c/forkable_stack.h b/forkable_stack.h index 5bfad8a9..5bfad8a9 100644 --- a/c/forkable_stack.h +++ b/forkable_stack.h diff --git a/c/frame_layout.h b/frame_layout.h index f098272e..f098272e 100644 --- a/c/frame_layout.h +++ b/frame_layout.h diff --git a/c/gen_utf8_tables.py b/gen_utf8_tables.py index 2179222d..2179222d 100644 --- a/c/gen_utf8_tables.py +++ b/gen_utf8_tables.py diff --git a/c/jv_parse.c b/jv_parse.c index e4565ef7..e4565ef7 100644 --- a/c/jv_parse.c +++ b/jv_parse.c diff --git a/c/jv_parse.h b/jv_parse.h index 5b8e7cdf..5b8e7cdf 100644 --- a/c/jv_parse.h +++ b/jv_parse.h diff --git a/c/jv_print.c b/jv_print.c index 64bf178a..64bf178a 100644 --- a/c/jv_print.c +++ b/jv_print.c diff --git a/c/jv_unicode.c b/jv_unicode.c index 375ad367..b1417a2a 100644 --- a/c/jv_unicode.c +++ b/jv_unicode.c @@ -1,7 +1,7 @@ #include <stdio.h> #include <assert.h> #include "jv_unicode.h" -#include "jv_utf8_tables.h" +#include "jv_utf8_tables.gen.h" const char* jvp_utf8_next(const char* in, const char* end, int* codepoint) { if (in == end) { diff --git a/c/jv_unicode.h b/jv_unicode.h index 78c7a40d..78c7a40d 100644 --- a/c/jv_unicode.h +++ b/jv_unicode.h @@ -1,6 +1,6 @@ %{ #include "compile.h" -#include "parser.tab.h" /* Generated by bison. */ +#include "parser.gen.h" /* Generated by bison. */ #define YY_USER_ACTION \ do { \ diff --git a/c/opcode_list.h b/opcode_list.h index 30e7203d..30e7203d 100644 --- a/c/opcode_list.h +++ b/opcode_list.h @@ -81,7 +81,7 @@ %type <blk> Exp Term MkDict MkDictPair ExpD ElseBody QQString FuncDef FuncDefs %{ -#include "lexer.yy.h" +#include "lexer.gen.h" #define FAIL(loc, msg) \ do { \ location l = loc; \ |