packages feed

purescript 0.2.7 → 0.2.9

raw patch · 9 files changed

+237/−63 lines, 9 files

Files

purescript.cabal view
@@ -1,5 +1,5 @@ name: purescript-version: 0.2.7+version: 0.2.9 cabal-version: >=1.8 build-type: Simple license: MIT@@ -17,9 +17,10 @@     build-depends: base >=4 && <5, cmdtheline -any, containers -any,                    directory -any, filepath -any, mtl -any, parsec -any, syb -any,                    transformers -any, utf8-string -any-    exposed-modules: Data.Generics.Extras Language.PureScript-                     Language.PureScript.CodeGen Language.PureScript.CodeGen.Externs-                     Language.PureScript.CodeGen.JS Language.PureScript.CodeGen.JS.AST+    exposed-modules: Language.PureScript.Options Data.Generics.Extras+                     Language.PureScript Language.PureScript.CodeGen+                     Language.PureScript.CodeGen.Externs Language.PureScript.CodeGen.JS+                     Language.PureScript.CodeGen.JS.AST                      Language.PureScript.CodeGen.Monad Language.PureScript.Declarations                      Language.PureScript.Kinds Language.PureScript.Names                      Language.PureScript.Operators Language.PureScript.Optimize@@ -36,11 +37,9 @@                      Language.PureScript.TypeChecker.Synonyms                      Language.PureScript.TypeChecker.Types Language.PureScript.Types                      Language.PureScript.Unknown Language.PureScript.Values Main-                     Language.PureScript.CaseDeclarations-                     Language.PureScript.DoNotation+                     Language.PureScript.CaseDeclarations Language.PureScript.DoNotation                      Language.PureScript.TypeDeclarations-                     Language.PureScript.BindingGroups-                     Language.PureScript.Scope+                     Language.PureScript.BindingGroups Language.PureScript.Scope     exposed: True     buildable: True     hs-source-dirs: src
src/Language/PureScript.hs view
@@ -29,12 +29,13 @@ import Language.PureScript.TypeDeclarations as P import Language.PureScript.BindingGroups as P import Language.PureScript.DoNotation as P+import Language.PureScript.Options as P  import Data.List (intercalate) import Control.Monad (forM_, (>=>)) -compile :: [Module] -> Either String (String, String, Environment)-compile ms = do+compile :: Options -> [Module] -> Either String (String, String, Environment)+compile opts ms = do   bracketted <- rebracket ms   desugared <- desugarDo                >=> desugarCasesModule@@ -42,6 +43,6 @@                >=> (return . createBindingGroupsModule)                $ bracketted   (_, env) <- runCheck $ forM_ desugared $ \(Module moduleName decls) -> typeCheckAll (ModuleName moduleName) decls-  let js = prettyPrintJS . map optimize . concatMap (flip moduleToJs env) $ desugared+  let js = prettyPrintJS . map (optimize opts) . concatMap (flip (moduleToJs opts) env) $ desugared   let exts = intercalate "\n" . map (flip moduleToPs env) $ desugared   return (js, exts, env)
src/Language/PureScript/CodeGen/JS.hs view
@@ -30,31 +30,33 @@ import Language.PureScript.Declarations import Language.PureScript.Pretty.Common import Language.PureScript.CodeGen.Monad+import Language.PureScript.Options import Language.PureScript.CodeGen.JS.AST as AST import Language.PureScript.TypeChecker.Monad (NameKind(..))+import Language.PureScript.Types -moduleToJs :: Module -> Environment -> [JS]-moduleToJs (Module pname@(ProperName name) decls) env =+moduleToJs :: Options -> Module -> Environment -> [JS]+moduleToJs opts (Module pname@(ProperName name) decls) env =   [ JSVariableIntroduction (Ident name) Nothing   , JSApp (JSFunction Nothing [Ident name]-                      (JSBlock (concat $ mapMaybe (\decl -> declToJs (ModuleName pname) decl env) decls)))+                      (JSBlock (concat $ mapMaybe (\decl -> declToJs opts (ModuleName pname) decl env) decls)))           [JSAssignment (JSAssignVariable (Ident name))                          (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]   ] -declToJs :: ModuleName -> Declaration -> Environment -> Maybe [JS]-declToJs mp (ValueDeclaration ident _ _ val) e =-  Just [ JSVariableIntroduction ident (Just (valueToJs mp e val)),+declToJs :: Options -> ModuleName -> Declaration -> Environment -> Maybe [JS]+declToJs opts mp (ValueDeclaration ident _ _ val) e =+  Just [ JSVariableIntroduction ident (Just (valueToJs opts mp e val)),          setProperty (identToJs ident) (JSVar ident) mp ]-declToJs mp (BindingGroupDeclaration vals) e =+declToJs opts mp (BindingGroupDeclaration vals) e =   Just $ concatMap (\(ident, val) ->-           [ JSVariableIntroduction ident (Just (valueToJs mp e val)),+           [ JSVariableIntroduction ident (Just (valueToJs opts mp e val)),              setProperty (identToJs ident) (JSVar ident) mp ]          ) vals-declToJs mp (ExternMemberDeclaration member ident _) _ =+declToJs _ mp (ExternMemberDeclaration member ident _) _ =   Just [ JSFunction (Just ident) [Ident "value"] (JSBlock [JSReturn (JSAccessor member (JSVar (Ident "value")))]),          setProperty (show ident) (JSVar ident) mp ]-declToJs mp (DataDeclaration _ _ ctors) _ =+declToJs _ mp (DataDeclaration _ _ ctors) _ =   Just $ flip concatMap ctors $ \(pn@(ProperName ctor), maybeTy) ->     let       ctorJs =@@ -65,32 +67,62 @@                         (JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn)))                                          , ("value", JSVar (Ident "value")) ])])     in [ ctorJs, setProperty ctor (JSVar (Ident ctor)) mp ]-declToJs _ _ _ = Nothing+declToJs _ _ _ _ = Nothing  setProperty :: String -> JS -> ModuleName -> JS setProperty prop val (ModuleName (ProperName moduleName)) = JSAssignment (JSAssignProperty prop (JSAssignVariable (Ident moduleName))) val -valueToJs :: ModuleName -> Environment -> Value -> JS-valueToJs _ _ (NumericLiteral n) = JSNumericLiteral n-valueToJs _ _ (StringLiteral s) = JSStringLiteral s-valueToJs _ _ (BooleanLiteral b) = JSBooleanLiteral b-valueToJs m e (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs m e) xs)-valueToJs m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs m e)) ps)-valueToJs m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar (Ident "Object"))) [ valueToJs m e o, JSObjectLiteral (map (second (valueToJs m e)) ps)]-valueToJs _ _ (Constructor name) = qualifiedToJS runProperName name-valueToJs m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs m e) sts))) []-valueToJs m e (Case values binders) = runGen (bindersToJs m e binders (map (valueToJs m e) values))-valueToJs m e (IfThenElse cond th el) = JSConditional (valueToJs m e cond) (valueToJs m e th) (valueToJs m e el)-valueToJs m e (Accessor prop val) = JSAccessor prop (valueToJs m e val)-valueToJs m e (Indexer index val) = JSIndexer (valueToJs m e index) (valueToJs m e val)-valueToJs m e (App val args) = JSApp (valueToJs m e val) (map (valueToJs m e) args)-valueToJs m e (Abs args val) = JSFunction Nothing args (JSBlock [JSReturn (valueToJs m e val)])-valueToJs m e (Unary op val) = JSUnary op (valueToJs m e val)-valueToJs m e (Binary op v1 v2) = JSBinary op (valueToJs m e v1) (valueToJs m e v2)-valueToJs m e (Var ident) = varToJs m e ident-valueToJs m e (TypedValue val _) = valueToJs m e val-valueToJs _ _ _ = error "Invalid argument to valueToJs"+valueToJs :: Options -> ModuleName -> Environment -> Value -> JS+valueToJs _ _ _ (NumericLiteral n) = JSNumericLiteral n+valueToJs _ _ _ (StringLiteral s) = JSStringLiteral s+valueToJs _ _ _ (BooleanLiteral b) = JSBooleanLiteral b+valueToJs opts m e (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs opts m e) xs)+valueToJs opts m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs opts m e)) ps)+valueToJs opts m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar (Ident "Object"))) [ valueToJs opts m e o, JSObjectLiteral (map (second (valueToJs opts m e)) ps)]+valueToJs _ _ _ (Constructor name) = qualifiedToJS runProperName name+valueToJs opts m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs opts m e) sts))) []+valueToJs opts m e (Case values binders) = runGen (bindersToJs opts m e binders (map (valueToJs opts m e) values))+valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)+valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)+valueToJs opts m e (Indexer index val) = JSIndexer (valueToJs opts m e index) (valueToJs opts m e val)+valueToJs opts m e (App val args) = JSApp (valueToJs opts m e val) (map (valueToJs opts m e) args)+valueToJs opts m e (Abs args val) = JSFunction Nothing args (JSBlock [JSReturn (valueToJs opts m e val)])+valueToJs opts m e (TypedValue (Abs args val) ty) | optionsPerformRuntimeTypeChecks opts = JSFunction Nothing args (JSBlock $ runtimeTypeChecks args ty ++ [JSReturn (valueToJs opts m e val)])+valueToJs opts m e (Unary op val) = JSUnary op (valueToJs opts m e val)+valueToJs opts m e (Binary op v1 v2) = JSBinary op (valueToJs opts m e v1) (valueToJs opts m e v2)+valueToJs _ m e (Var ident) = varToJs m e ident+valueToJs opts m e (TypedValue val _) = valueToJs opts m e val+valueToJs _ _ _ _ = error "Invalid argument to valueToJs" +runtimeTypeChecks :: [Ident] -> Type -> [JS]+runtimeTypeChecks args ty =+  let+    argTys = getFunctionArgumentTypes ty+  in+    concat $ zipWith argumentCheck (map JSVar args) argTys+  where+  getFunctionArgumentTypes :: Type -> [Type]+  getFunctionArgumentTypes (Function funArgs _) = funArgs+  getFunctionArgumentTypes (ForAll _ ty') = getFunctionArgumentTypes ty'+  getFunctionArgumentTypes _ = []+  argumentCheck :: JS -> Type -> [JS]+  argumentCheck val Number = [typeCheck val "number"]+  argumentCheck val String = [typeCheck val "string"]+  argumentCheck val Boolean = [typeCheck val "boolean"]+  argumentCheck val (Array _) = [arrayCheck val]+  argumentCheck val (Object row) =+    let+      (pairs, _) = rowToList row+    in+      typeCheck val "object" : concatMap (\(prop, ty') -> argumentCheck (JSAccessor prop val) ty') pairs+  argumentCheck val (Function _ _) = [typeCheck val "function"]+  argumentCheck val (ForAll _ ty') = argumentCheck val ty'+  argumentCheck _ _ = []+  typeCheck :: JS -> String -> JS+  typeCheck js ty' = JSIfElse (JSBinary NotEqualTo (JSTypeOf js) (JSStringLiteral ty')) (JSBlock [JSThrow (JSStringLiteral $ ty' ++ " expected")]) Nothing+  arrayCheck :: JS -> JS+  arrayCheck js = JSIfElse (JSUnary Not (JSApp (JSAccessor "isArray" (JSVar (Ident "Array"))) [js])) (JSBlock [JSThrow (JSStringLiteral "Array expected")]) Nothing+ varToJs :: ModuleName -> Environment -> Qualified Ident -> JS varToJs m e qual@(Qualified _ ident) = case M.lookup (qualify m qual) (names e) of   Just (_, ty) | isExtern ty -> JSVar ident@@ -107,17 +139,17 @@ qualifiedToJS f (Qualified (Just (ModuleName (ProperName m))) a) = JSAccessor (f a) (JSVar (Ident m)) qualifiedToJS f (Qualified Nothing a) = JSVar (Ident (f a)) -bindersToJs :: ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> Gen JS-bindersToJs m e binders vals = do+bindersToJs :: Options -> ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> Gen JS+bindersToJs opts m e binders vals = do   setNextName $ firstUnusedName (binders, vals)   valNames <- replicateM (length vals) fresh-  jss <- forM binders $ \(bs, grd, result) -> go valNames [JSReturn (valueToJs m e result)] bs grd+  jss <- forM binders $ \(bs, grd, result) -> go valNames [JSReturn (valueToJs opts m e result)] bs grd   return $ JSApp (JSFunction Nothing (map Ident valNames) (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))                  vals   where     go :: [String] -> [JS] -> [Binder] -> Maybe Guard -> Gen [JS]     go _ done [] Nothing = return done-    go _ done [] (Just cond) = return [JSIfElse (valueToJs m e cond) (JSBlock done) Nothing]+    go _ done [] (Just cond) = return [JSIfElse (valueToJs opts m e cond) (JSBlock done) Nothing]     go (v:vs) done' (b:bs) grd = do       done'' <- go vs done' bs grd       binderToJs m e v done'' b@@ -175,16 +207,16 @@   js <- binderToJs m e varName done binder   return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : js) -statementToJs :: ModuleName -> Environment -> Statement -> JS-statementToJs m e (VariableIntroduction ident value) = JSVariableIntroduction ident (Just (valueToJs m e value))-statementToJs m e (Assignment target value) = JSAssignment (JSAssignVariable target) (valueToJs m e value)-statementToJs m e (While cond sts) = JSWhile (valueToJs m e cond) (JSBlock (map (statementToJs m e) sts))-statementToJs m e (For ident start end sts) = JSFor ident (valueToJs m e start) (valueToJs m e end) (JSBlock (map (statementToJs m e) sts))-statementToJs m e (If ifst) = ifToJs ifst+statementToJs :: Options -> ModuleName -> Environment -> Statement -> JS+statementToJs opts m e (VariableIntroduction ident value) = JSVariableIntroduction ident (Just (valueToJs opts m e value))+statementToJs opts m e (Assignment target value) = JSAssignment (JSAssignVariable target) (valueToJs opts m e value)+statementToJs opts m e (While cond sts) = JSWhile (valueToJs opts m e cond) (JSBlock (map (statementToJs opts m e) sts))+statementToJs opts m e (For ident start end sts) = JSFor ident (valueToJs opts m e start) (valueToJs opts m e end) (JSBlock (map (statementToJs opts m e) sts))+statementToJs opts m e (If ifst) = ifToJs ifst   where   ifToJs :: IfStatement -> JS-  ifToJs (IfStatement cond thens elses) = JSIfElse (valueToJs m e cond) (JSBlock (map (statementToJs m e) thens)) (fmap elseToJs elses)+  ifToJs (IfStatement cond thens elses) = JSIfElse (valueToJs opts m e cond) (JSBlock (map (statementToJs opts m e) thens)) (fmap elseToJs elses)   elseToJs :: ElseStatement -> JS-  elseToJs (Else sts) = JSBlock (map (statementToJs m e) sts)+  elseToJs (Else sts) = JSBlock (map (statementToJs opts m e) sts)   elseToJs (ElseIf elif) = ifToJs elif-statementToJs m e (Return value) = JSReturn (valueToJs m e value)+statementToJs opts m e (Return value) = JSReturn (valueToJs opts m e value)
src/Language/PureScript/CodeGen/JS/AST.hs view
@@ -42,7 +42,11 @@   | JSFor Ident JS JS JS   | JSIfElse JS JS (Maybe JS)   | JSReturn JS-  | JSThrow JS deriving (Show, Data, Typeable)+  | JSThrow JS+  | JSTypeOf JS+  | JSLabel String JS+  | JSBreak String+  | JSContinue String deriving (Show, Data, Typeable)  data JSAssignment   = JSAssignVariable Ident
src/Language/PureScript/Optimize.hs view
@@ -22,9 +22,16 @@  import Language.PureScript.Names import Language.PureScript.CodeGen.JS.AST+import Language.PureScript.Options -optimize :: JS -> JS-optimize = removeUnusedVariables . unThunk . etaConvert . inlineVariables+optimize :: Options -> JS -> JS+optimize opts =+  collapseNestedBlocks+  . tco opts+  . removeUnusedVariables+  . unThunk+  . etaConvert+  . inlineVariables  replaceIdent :: (Data d) => Ident -> JS -> d -> d replaceIdent var1 js = everywhere (mkT replace)@@ -101,3 +108,87 @@   convert :: JS -> JS   convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) [])]) = JSBlock body   convert js = js++tco :: Options -> JS -> JS+tco opts | optionsTco opts = tco'+         | otherwise = id++tco' :: JS -> JS+tco' = everywhere (mkT convert)+  where+  tcoLabel :: String+  tcoLabel = "tco"+  tcoVar :: Ident -> Ident+  tcoVar (Ident arg) = Ident $ "__tco_" ++ arg+  tcoVar _ = error "Invalid name in tcoVar"+  convert :: JS -> JS+  convert js@(JSVariableIntroduction name (Just fn@(JSFunction Nothing _ _))) =+    let+      (argss, body', replace) = collectAllFunctionArgs [] id fn+    in case () of+      _ | isTailCall name body' ->+            let+              allArgs = reverse $ concat argss+            in+              JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))+        | otherwise -> js+  convert js = js+  collectAllFunctionArgs :: [[Ident]] -> (JS -> JS) -> JS -> ([[Ident]], JS, JS -> JS)+  collectAllFunctionArgs allArgs f (JSFunction Nothing args (JSBlock (body@(JSReturn _):_))) =+    collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction Nothing args (JSBlock [b]))) body+  collectAllFunctionArgs allArgs f (JSReturn (JSFunction Nothing args (JSBlock [body]))) =+    collectAllFunctionArgs (args : allArgs) (\b -> f (JSReturn (JSFunction Nothing args (JSBlock [b])))) body+  collectAllFunctionArgs allArgs f (JSReturn (JSFunction Nothing args body@(JSBlock _))) =+    (args : allArgs, body, \b -> f (JSReturn (JSFunction Nothing args b)))+  collectAllFunctionArgs allArgs f body = (allArgs, body, f)+  isTailCall :: Ident -> JS -> Bool+  isTailCall ident js =+    let+      numSelfCalls = everything (+) (mkQ 0 countSelfCalls) js+      numSelfCallsInTailPosition = everything (+) (mkQ 0 countSelfCallsInTailPosition) js+      numSelfCallsUnderFunctions = everything (+) (mkQ 0 countSelfCallsUnderFunctions) js+    in+      numSelfCalls > 0+      && numSelfCalls == numSelfCallsInTailPosition+      && numSelfCallsUnderFunctions == 0+    where+    countSelfCalls :: JS -> Int+    countSelfCalls (JSApp (JSVar ident') _) | ident == ident' = 1+    countSelfCalls _ = 0+    countSelfCallsInTailPosition :: JS -> Int+    countSelfCallsInTailPosition (JSReturn ret) | isSelfCall ident ret = 1+    countSelfCallsInTailPosition _ = 0+    countSelfCallsUnderFunctions (JSFunction _ _ js') = everything (+) (mkQ 0 countSelfCalls) js'+    countSelfCallsUnderFunctions _ = 0+  toLoop :: Ident -> [Ident] -> JS -> JS+  toLoop ident allArgs js = JSBlock+        [ JSLabel tcoLabel $ JSWhile (JSBooleanLiteral True) (JSBlock [ everywhere (mkT loopify) js ]) ]+    where+    loopify :: JS -> JS+    loopify (JSReturn ret) | isSelfCall ident ret =+      let+        allArgumentValues = concat $ collectSelfCallArgs [] ret+      in+        JSBlock $ zipWith (\val arg ->+                    JSVariableIntroduction (tcoVar arg) (Just val)) allArgumentValues allArgs+                  ++ map (\arg ->+                    JSAssignment (JSAssignVariable arg) (JSVar (tcoVar arg))) allArgs+                  ++ [ JSContinue tcoLabel ]+    loopify other = other+    collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]+    collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn+    collectSelfCallArgs allArgumentValues _ = allArgumentValues+  isSelfCall :: Ident -> JS -> Bool+  isSelfCall ident (JSApp (JSVar ident') _) | ident == ident' = True+  isSelfCall ident (JSApp fn _) = isSelfCall ident fn+  isSelfCall _ _ = False++collapseNestedBlocks :: JS -> JS+collapseNestedBlocks = everywhere (mkT collapse)+  where+  collapse :: JS -> JS+  collapse (JSBlock sts) = JSBlock (concatMap go sts)+  collapse js = js+  go :: JS -> [JS]+  go (JSBlock sts) = sts+  go s = [s]
+ src/Language/PureScript/Options.hs view
@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+--+-- Module      :  Language.PureScript.Options+-- Copyright   :  (c) Phil Freeman 2013+-- License     :  MIT+--+-- Maintainer  :  Phil Freeman <paf31@cantab.net>+-- Stability   :  experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module Language.PureScript.Options where++data Options = Options+  { optionsTco :: Bool+  , optionsPerformRuntimeTypeChecks :: Bool+  } deriving Show++defaultOptions :: Options+defaultOptions = Options False False
src/Language/PureScript/Pretty/JS.hs view
@@ -118,6 +118,12 @@     [ return "throw "     , prettyPrintJS' value     ]+  match (JSBreak lbl) = return $ "break " ++ lbl+  match (JSContinue lbl) = return $ "continue " ++ lbl+  match (JSLabel lbl js) = fmap concat $ sequence+    [ return $ lbl ++ ": "+    , prettyPrintJS' js+    ]   match _ = mzero  targetToJs :: JSAssignment -> String@@ -156,6 +162,12 @@     return (intercalate ", " jss, val)   match _ = mzero +typeOf :: Pattern PrinterState JS ((), JS)+typeOf = mkPattern match+  where+  match (JSTypeOf val) = Just ((), val)+  match _ = Nothing+ unary :: UnaryOperator -> String -> Operator PrinterState JS String unary op str = Wrap match (++)   where@@ -202,6 +214,7 @@                   , [ binary    LessThanOrEqualTo    "<=" ]                   , [ binary    GreaterThan          ">" ]                   , [ binary    GreaterThanOrEqualTo ">=" ]+                  , [ Wrap typeOf $ \_ s -> "typeof " ++ s ]                   , [ unary     Not                  "!" ]                   , [ unary     BitwiseNot           "~" ]                   , [ unary     Negate               "-" ]
src/Main.hs view
@@ -28,15 +28,15 @@   text <- U.readFile inputFile   return $ P.runIndentParser P.parseModules text -compile :: Maybe [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()-compile input output externs = do+compile :: P.Options -> Maybe [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()+compile opts input output externs = do   modules <- readInput input   case modules of     Left err -> do       U.print err       exitFailure     Right ms ->-      case P.compile ms of+      case P.compile opts ms of         Left err -> do           U.putStrLn err           exitFailure@@ -65,6 +65,17 @@ externsFile = value $ opt Nothing $ (optInfo [ "e", "externs" ])      { optDoc = "The output .e.ps file" } +tco :: Term Bool+tco = value $ flag $ (optInfo [ "tco" ])+     { optDoc = "Perform tail call optimizations" }++performRuntimeTypeChecks :: Term Bool+performRuntimeTypeChecks = value $ flag $ (optInfo [ "runtime-type-checks" ])+     { optDoc = "Generate runtime type checks" }++options :: Term P.Options+options = P.Options <$> tco <*> performRuntimeTypeChecks+ stdInOrInputFiles :: Term (Maybe [FilePath]) stdInOrInputFiles = combine <$> useStdIn <*> inputFiles   where@@ -72,7 +83,7 @@   combine True _ = Nothing  term :: Term (IO ())-term = compile <$> stdInOrInputFiles <*> outputFile <*> externsFile+term = compile <$> options <*> stdInOrInputFiles <*> outputFile <*> externsFile  termInfo :: TermInfo termInfo = defTI
tests/Main.hs view
@@ -32,7 +32,7 @@     Left parseError -> do       return (Left $ show parseError)     Right ms -> do-      case P.compile ms of+      case P.compile P.defaultOptions ms of         Left typeError -> do           return (Left typeError)         Right (_, _, env) -> do