From a4eea165bbab6d13f89b59707e835d58b7014a66 Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Tue, 18 Sep 2012 17:44:43 +0100 Subject: [PATCH] Move everything around - delete old Haskell code, clean up build. --- .gitignore | 8 +- JQ.hs | 157 --------------------- Lexer.x | 101 ------------- Main.hs | 22 --- c/Makefile => Makefile | 20 +-- Parser.y | 78 ---------- c/builtin.c => builtin.c | 0 c/builtin.h => builtin.h | 0 c/bytecode.c => bytecode.c | 0 c/bytecode.h => bytecode.h | 0 c/compile.c => compile.c | 0 c/compile.h => compile.h | 0 c/execute.c => execute.c | 0 c/forkable_stack.h => forkable_stack.h | 0 c/frame_layout.h => frame_layout.h | 0 c/gen_utf8_tables.py => gen_utf8_tables.py | 0 c/jv.c => jv.c | 0 c/jv.h => jv.h | 0 c/jv_dtoa.c => jv_dtoa.c | 0 c/jv_dtoa.h => jv_dtoa.h | 0 c/jv_parse.c => jv_parse.c | 0 c/jv_parse.h => jv_parse.h | 0 c/jv_print.c => jv_print.c | 0 c/jv_test.c => jv_test.c | 0 c/jv_unicode.c => jv_unicode.c | 2 +- c/jv_unicode.h => jv_unicode.h | 0 c/lexer.l => lexer.l | 2 +- c/locfile.h => locfile.h | 0 c/main.c => main.c | 0 c/opcode.c => opcode.c | 0 c/opcode.h => opcode.h | 0 c/opcode_list.h => opcode_list.h | 0 c/parser.h => parser.h | 0 c/parser.y => parser.y | 2 +- c/testdata => testdata | 0 35 files changed, 16 insertions(+), 376 deletions(-) delete mode 100644 JQ.hs delete mode 100644 Lexer.x delete mode 100644 Main.hs rename c/Makefile => Makefile (50%) delete mode 100644 Parser.y rename c/builtin.c => builtin.c (100%) rename c/builtin.h => builtin.h (100%) rename c/bytecode.c => bytecode.c (100%) rename c/bytecode.h => bytecode.h (100%) rename c/compile.c => compile.c (100%) rename c/compile.h => compile.h (100%) rename c/execute.c => execute.c (100%) rename c/forkable_stack.h => forkable_stack.h (100%) rename c/frame_layout.h => frame_layout.h (100%) rename c/gen_utf8_tables.py => gen_utf8_tables.py (100%) rename c/jv.c => jv.c (100%) rename c/jv.h => jv.h (100%) rename c/jv_dtoa.c => jv_dtoa.c (100%) rename c/jv_dtoa.h => jv_dtoa.h (100%) rename c/jv_parse.c => jv_parse.c (100%) rename c/jv_parse.h => jv_parse.h (100%) rename c/jv_print.c => jv_print.c (100%) rename c/jv_test.c => jv_test.c (100%) rename c/jv_unicode.c => jv_unicode.c (98%) rename c/jv_unicode.h => jv_unicode.h (100%) rename c/lexer.l => lexer.l (98%) rename c/locfile.h => locfile.h (100%) rename c/main.c => main.c (100%) rename c/opcode.c => opcode.c (100%) rename c/opcode.h => opcode.h (100%) rename c/opcode_list.h => opcode_list.h (100%) rename c/parser.h => parser.h (100%) rename c/parser.y => parser.y (99%) rename c/testdata => testdata (100%) diff --git a/.gitignore b/.gitignore index 130e618..50e45cc 100644 --- a/.gitignore +++ b/.gitignore @@ -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*~ diff --git a/JQ.hs b/JQ.hs deleted file mode 100644 index ca8df79..0000000 --- a/JQ.hs +++ /dev/null @@ -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 700c69e..0000000 --- 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 } - \" { leaveString } - ($printable # [\"\\]) { pushString id } - \\ [\"\\\/] { pushString (drop 1) } - \\ [nrt] { pushString (escape . drop 1) } --- \\ '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 695520c..0000000 --- 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 diff --git a/c/Makefile b/Makefile similarity index 50% rename from c/Makefile rename to Makefile index 7f58c61..db63b77 100644 --- a/c/Makefile +++ b/Makefile @@ -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 544fe5b..0000000 --- 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/builtin.c b/builtin.c similarity index 100% rename from c/builtin.c rename to builtin.c diff --git a/c/builtin.h b/builtin.h similarity index 100% rename from c/builtin.h rename to builtin.h diff --git a/c/bytecode.c b/bytecode.c similarity index 100% rename from c/bytecode.c rename to bytecode.c diff --git a/c/bytecode.h b/bytecode.h similarity index 100% rename from c/bytecode.h rename to bytecode.h diff --git a/c/compile.c b/compile.c similarity index 100% rename from c/compile.c rename to compile.c diff --git a/c/compile.h b/compile.h similarity index 100% rename from c/compile.h rename to compile.h diff --git a/c/execute.c b/execute.c similarity index 100% rename from c/execute.c rename to execute.c diff --git a/c/forkable_stack.h b/forkable_stack.h similarity index 100% rename from c/forkable_stack.h rename to forkable_stack.h diff --git a/c/frame_layout.h b/frame_layout.h similarity index 100% rename from c/frame_layout.h rename to frame_layout.h diff --git a/c/gen_utf8_tables.py b/gen_utf8_tables.py similarity index 100% rename from c/gen_utf8_tables.py rename to gen_utf8_tables.py diff --git a/c/jv.c b/jv.c similarity index 100% rename from c/jv.c rename to jv.c diff --git a/c/jv.h b/jv.h similarity index 100% rename from c/jv.h rename to jv.h diff --git a/c/jv_dtoa.c b/jv_dtoa.c similarity index 100% rename from c/jv_dtoa.c rename to jv_dtoa.c diff --git a/c/jv_dtoa.h b/jv_dtoa.h similarity index 100% rename from c/jv_dtoa.h rename to jv_dtoa.h diff --git a/c/jv_parse.c b/jv_parse.c similarity index 100% rename from c/jv_parse.c rename to jv_parse.c diff --git a/c/jv_parse.h b/jv_parse.h similarity index 100% rename from c/jv_parse.h rename to jv_parse.h diff --git a/c/jv_print.c b/jv_print.c similarity index 100% rename from c/jv_print.c rename to jv_print.c diff --git a/c/jv_test.c b/jv_test.c similarity index 100% rename from c/jv_test.c rename to jv_test.c diff --git a/c/jv_unicode.c b/jv_unicode.c similarity index 98% rename from c/jv_unicode.c rename to jv_unicode.c index 375ad36..b1417a2 100644 --- a/c/jv_unicode.c +++ b/jv_unicode.c @@ -1,7 +1,7 @@ #include #include #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 similarity index 100% rename from c/jv_unicode.h rename to jv_unicode.h diff --git a/c/lexer.l b/lexer.l similarity index 98% rename from c/lexer.l rename to lexer.l index 07cba83..e604ada 100644 --- a/c/lexer.l +++ b/lexer.l @@ -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/locfile.h b/locfile.h similarity index 100% rename from c/locfile.h rename to locfile.h diff --git a/c/main.c b/main.c similarity index 100% rename from c/main.c rename to main.c diff --git a/c/opcode.c b/opcode.c similarity index 100% rename from c/opcode.c rename to opcode.c diff --git a/c/opcode.h b/opcode.h similarity index 100% rename from c/opcode.h rename to opcode.h diff --git a/c/opcode_list.h b/opcode_list.h similarity index 100% rename from c/opcode_list.h rename to opcode_list.h diff --git a/c/parser.h b/parser.h similarity index 100% rename from c/parser.h rename to parser.h diff --git a/c/parser.y b/parser.y similarity index 99% rename from c/parser.y rename to parser.y index b47c357..0fda65b 100644 --- a/c/parser.y +++ b/parser.y @@ -81,7 +81,7 @@ %type 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; \ diff --git a/c/testdata b/testdata similarity index 100% rename from c/testdata rename to testdata -- 2.40.0