summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStephen Dolan <mu@netsoc.tcd.ie>2012-09-18 17:44:43 +0100
committerStephen Dolan <mu@netsoc.tcd.ie>2012-09-18 17:44:43 +0100
commita4eea165bbab6d13f89b59707e835d58b7014a66 (patch)
treeb99ee5dde8540f8dbe5de3d87b99e04ac4dd2673
parent25cbab056b1f73e96b636c88779a92400d92dc15 (diff)
Move everything around - delete old Haskell code, clean up build.
-rw-r--r--.gitignore8
-rw-r--r--JQ.hs157
-rw-r--r--Lexer.x101
-rw-r--r--Main.hs22
-rw-r--r--Makefile (renamed from c/Makefile)20
-rw-r--r--Parser.y78
-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
diff --git a/.gitignore b/.gitignore
index 130e618d..50e45cc8 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 ca8df794..00000000
--- 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 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
diff --git a/c/Makefile b/Makefile
index 7f58c617..db63b777 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 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/builtin.c b/builtin.c
index f291a95e..f291a95e 100644
--- a/c/builtin.c
+++ b/builtin.c
diff --git a/c/builtin.h b/builtin.h
index fe2ac6ac..fe2ac6ac 100644
--- a/c/builtin.h
+++ b/builtin.h
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/compile.c b/compile.c
index 719a2706..719a2706 100644
--- a/c/compile.c
+++ b/compile.c
diff --git a/c/compile.h b/compile.h
index 5390420b..5390420b 100644
--- a/c/compile.h
+++ b/compile.h
diff --git a/c/execute.c b/execute.c
index 6b0948c5..6b0948c5 100644
--- a/c/execute.c
+++ b/execute.c
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.c b/jv.c
index 2d91366b..2d91366b 100644
--- a/c/jv.c
+++ b/jv.c
diff --git a/c/jv.h b/jv.h
index e67d614a..e67d614a 100644
--- a/c/jv.h
+++ b/jv.h
diff --git a/c/jv_dtoa.c b/jv_dtoa.c
index 2c27c880..2c27c880 100644
--- a/c/jv_dtoa.c
+++ b/jv_dtoa.c
diff --git a/c/jv_dtoa.h b/jv_dtoa.h
index 3bafcf47..3bafcf47 100644
--- a/c/jv_dtoa.h
+++ b/jv_dtoa.h
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_test.c b/jv_test.c
index 725e5aba..725e5aba 100644
--- a/c/jv_test.c
+++ b/jv_test.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
diff --git a/c/lexer.l b/lexer.l
index 07cba83c..e604adab 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
index 77b1aef1..77b1aef1 100644
--- a/c/locfile.h
+++ b/locfile.h
diff --git a/c/main.c b/main.c
index 0a9eefe8..0a9eefe8 100644
--- a/c/main.c
+++ b/main.c
diff --git a/c/opcode.c b/opcode.c
index bc259c22..bc259c22 100644
--- a/c/opcode.c
+++ b/opcode.c
diff --git a/c/opcode.h b/opcode.h
index 73948cd5..73948cd5 100644
--- a/c/opcode.h
+++ b/opcode.h
diff --git a/c/opcode_list.h b/opcode_list.h
index 30e7203d..30e7203d 100644
--- a/c/opcode_list.h
+++ b/opcode_list.h
diff --git a/c/parser.h b/parser.h
index 25eff019..25eff019 100644
--- a/c/parser.h
+++ b/parser.h
diff --git a/c/parser.y b/parser.y
index b47c3574..0fda65bd 100644
--- a/c/parser.y
+++ b/parser.y
@@ -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; \
diff --git a/c/testdata b/testdata
index 7357ccb2..7357ccb2 100644
--- a/c/testdata
+++ b/testdata