funcons-lambda-cbv-mp (empty) → 0.1.0.0
raw patch · 6 files changed
+245/−0 lines, 6 filesdep +basedep +containersdep +funcons-toolssetup-changed
Dependencies added: base, containers, funcons-tools, gll, text
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- funcons-lambda-cbv-mp.cabal +28/−0
- src/LambdaCBV/Parser.hs +120/−0
- src/Main.hs +60/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for lambda-cbv++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, L. Thomas van Binsbergen++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of L. Thomas van Binsbergen nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ funcons-lambda-cbv-mp.cabal view
@@ -0,0 +1,28 @@+-- Initial lambda-cbv.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: funcons-lambda-cbv-mp+version: 0.1.0.0+synopsis: Basic call-by-value lambda-calculus with operational semantics based on Funcons+-- description: +license: BSD3+license-file: LICENSE+author: L. Thomas van Binsbergen+maintainer: ltvanbinsbergen@acm.org+-- copyright: +category: Language+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10++executable lambda-cbv+ main-is: Main.hs+ other-modules: LambdaCBV.Parser + -- other-extensions: + build-depends: base >=4.9 && <= 5.0+ , gll >= 0.4.0.3+ , funcons-tools >= 0.2.0.1+ , containers >= 0.5.7+ , text >= 1.2.2+ hs-source-dirs: src+ default-language: Haskell2010
+ src/LambdaCBV/Parser.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE OverloadedStrings #-}++module LambdaCBV.Parser where++import GLL.Combinators+import Funcons.EDSL+import Funcons.Core hiding (string_, tuple_)+import Funcons.Core.Manual+import Funcons.MetaProgramming++import qualified Data.Map as M+import Data.Text (Text)++lexerSettings = emptyLanguage {+ keywords = ["this", "let", "letdown", "in", "<=", "if", "then", "else", "+"+ ,"[|", "|]", "$(", "lift", "output"]+ , keychars = ['=', '\\', '.', '(', ')', '$', '!']+ }++type Parser a = BNF Token a++parser :: [Token] -> [Either String Funcons]+parser = parseWithParseOptions [] [maximumErrors 1, throwErrors] + (Right . sem_program <$$> pExpr)++pExpr :: Parser Funcons+pExpr = "expr" + <::= sem_id <$$> pId + <||> sem_id (string_ "this") <$$ keyword "this"+ <||> sem_lam <$$ keychar '\\' <**> pId <** keychar '.' <**> pExpr+ <||> sem_let <$$ keyword "let" <**> pId <** keychar '=' <**> pExpr + <** keyword "in" <**> pExpr+ <||> sem_letdown <$$ keyword "letdown" <**> pId <** keychar '=' <**> pExpr+ <** keyword "in" <**> pExpr+ <||> sem_ite <$$ keyword "if" <**> pExpr <** keyword "then" <**> pExpr+ <** keyword "else" <**> pExpr+ <||> sem_binary_infix "plus" <$$> pExpr <** keyword "+" <**>>> pExpr+ <||> sem_leq <$$> pExpr <** keyword "<=" <**>>> pExpr+ <||> sem_app <$$> pExpr <**>>> pExpr + <||> sem_lift <$$ keyword "lift" <**> pExpr -- exactly like application, syntactically+ <||> sem_output <$$ keyword "output" <**> pExpr -- exactly like application, syntactically++ <||> int_ <$$> int_lit+ <||> parens pExpr+ <||> sem_upML <$$ keyword "[|" <**> pExpr <** keyword "|]"+ <||> sem_downML <$$ keyword "$(" <**> pExpr <** keychar ')'+ <||> sem_splice_id <$$ keychar '!' <**> pId + <||> string_ <$$> string_lit++pId :: Parser Funcons+pId = "identifiers" <:=> string_ <$$> id_lit <||> string_ <$$> alt_id_lit++sem_binary_infix name p q = sem_app (sem_app (sem_id (string_ name)) p) q+sem_id x = current_value_ [bound_ [x]]+sem_let x m n = + scope_ [bind_ [x, allocate_initialised_variable_ [values_,m]],n]+sem_letdown x m n = meta_let_ [x, m, n]+sem_app m n = give_ [m, apply_ [given_, tuple_ [n, given_]]]+sem_lam x m =+ function_ [closure_ [scope_ [bind_ [x+ ,allocate_initialised_variable_ [values_,given1_]+ ]+ ,scope_[bind_[string_ "this" ,given2_],m]+ ]+ ]+ ]+sem_output m = give_ [m, seq_ [print_ [given_], given_]]+sem_ite g m n = if_true_else_ [g,m,n]+sem_plus m n = integer_add_ [m,n]+sem_leq m n = is_less_or_equal_ [m,n]+sem_upML m = meta_up_ [m]+sem_downML m = meta_down_ [m]+sem_lift m = give_ [m, ast_ [type_of_ [given_], given_ ]]+sem_splice_id x = give_ [eval_ [sem_id x]+ ,seq_ [assign_ [bound_ [x]+ ,ast_ [type_of_ [given_], given_]+ ] + ,given_+ ]+ ]+sem_program main = finalise_abrupting_ [initialise_binding_ [initialise_storing_ [scope_ [builtins, main]]]]++builtins = env_fromlist_ + [("Output", fun_ [applyFuncon "ast-output" [given1_]])+ ,("Bind", fun_ [applyFuncon "ast-bind" [sem_lift given1_]])+ ,("Bound", fun_ [applyFuncon "ast-bound" [sem_lift given1_]])+ ,("Lam", curry_ [fun_ [applyFuncon "ast-lam" [fst_ [given1_], fst_[given2_]]]])+ ,("App", curry_ [fun_ [applyFuncon "ast-app" [fst_[given1_], fst_[given2_]]]])+ ,("Plus", curry_ [fun_ [applyFuncon "ast-plus" [fst_[given1_], fst_[given2_]]]])+ ,("plus", curry_ [fun_ [integer_add_ [fst_ [given1_], fst_[given2_]]]])+ ,("eval", fun_ [eval_ [given1_]])+ ]++translation :: [(Text, [Funcons] -> Funcons)]+translation = [+ ("ast-this", nullary (sem_id (string_ "this")))+ , ("ast-output", unary sem_output)+ , ("ast-bind", unary id)+ , ("ast-bound", unary sem_id)+ , ("ast-lam", binary sem_lam)+ , ("ast-let", ternary sem_let)+ , ("ast-app", binary sem_app)+ , ("ast-plus", binary sem_plus)+ ]++astLib :: FunconLibrary+astLib = M.fromList $ map (uncurry mkLibEntry) translation+ where mkLibEntry key f = (key, StrictFuncon (translationStep f))++nullary f [] = f+unary f [x] = f x +binary f [x,y] = f x y+ternary f [x,y,z] = f x y z++given1_ = fst_ [given_] +given2_ = snd_ [given_]+fst_ xs = first_ [tuple_elements_ xs]+snd_ xs = second_ [tuple_elements_ xs]+fun_ abs = function_ [abstraction_ abs]+
+ src/Main.hs view
@@ -0,0 +1,60 @@++module Main where++import GLL.Combinators+import Funcons.EDSL+import Funcons.Core.Manual+import Funcons.Core+import Funcons.Tools hiding (mkMain)+import qualified Funcons.MetaProgramming as MP++import LambdaCBV.Parser (parser, builtins, lexerSettings, astLib)++import qualified Data.Map as M+import Data.Text (unpack)++import System.Environment+import Control.Monad++cbv_library = libUnions [astLib,MP.library]+cmp_library = libUnions + [Funcons.Core.funcons, cbv_library, Funcons.EDSL.library, Funcons.Core.Manual.library]++main :: IO ()+main = mkMain (lexer lexerSettings) parser id pipeline++pipeline args f = + fct_evaluator args (Just (MP.compile cmp_library Funcons.Core.types builtins f))++fct_evaluator = runWithExtensions cbv_library noEntityDefaults emptyTypeRelation++mkMain :: (Show ast) =>+ (String -> [token]) -- lexer+ -> ([token] -> [ast]) -- parser+ -> (ast -> Either String Funcons) -- translator+ -> ([String] -> Funcons -> IO ()) -- evaluator (with args)+ -> IO () -- behaviour+mkMain lexer parser translator evaluator = do+ args <- getArgs+ case args of + [] -> putStrLn "Please provide me with an input file"+ f:opts -> go f opts+ where+ go :: FilePath -> [String] -> IO ()+ go f opts = do + str <- readFile f+ let tokens = lexer str+ mast = parser tokens+ multiple = length mast > 1+ forM_ (zip [1..] mast) $ \(i, ast) -> do+ when multiple (putStrLn ("=== Interpretation "++ show i ++ "\n"))+ when debug $ do print "AST:"+ print $ ast + case translator ast of+ Left err -> putStrLn ("Translation error: \n" ++ err)+ Right f0 -> do+ when debug $ do print "FCT:"+ putStrLn (showFuncons f0) + evaluator opts f0+ where use_funcons = all ((/=) "--ags") opts+ debug = any ((==) "--debug") opts