Move everything around - delete old Haskell code, clean up build.

.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
+parsertest*~

JQ.hs

@@ -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')
-

Lexer.x

@@ -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
-
-}

Main.hs

@@ -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)

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

Parser.y

@@ -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) }

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) {

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 {                                           \

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;                                    \