Commit 68e8eb150f334ec81eac813f76e80c9a8dd4cc7f - s-cargot

Merge branch 'master' of github.com:aisamanra/s-cargot Getty Ritter 6 years ago

3 changed file(s) with 88 addition(s) and 1 deletion(s). Collapse all Expand all

+27

-0

Data/SCargot/Common.hs less more

25	25	-- ** Numeric Literals for Arbitrary Bases
26	26	, commonLispNumberAnyBase
27	27	, gnuM4NumberAnyBase
	28	-- ** Source locations
	29	, Location(..), Located(..), located, dLocation
28	30	) where
29	31
30	32	#if !MIN_VERSION_base(4,8,0)

35	37	import Data.Text (Text)
36	38	import qualified Data.Text as T
37	39	import Text.Parsec
	40	import Text.Parsec.Pos (newPos)
38	41	import Text.Parsec.Text (Parser)
39	42
40	43	-- \| Parse an identifier according to the R5RS Scheme standard. This

332	335	signedHexNumber :: Parser Integer
333	336	signedHexNumber = ($) <$> sign <*> hexNumber
334	337
	338
	339	-- \|
	340	data Location = Span !SourcePos !SourcePos
	341	deriving (Eq, Ord, Show)
	342
	343	-- \| Add support for source locations while parsing S-expressions, as described in this
	344	-- <https://www.reddit.com/r/haskell/comments/4x22f9/labelling_ast_nodes_with_locations/d6cmdy9/ Reddit>
	345	-- thread.
	346	data Located a = At !Location a
	347	deriving (Eq, Ord, Show)
	348
	349	-- \| Adds a source span to a parser.
	350	located :: Parser a -> Parser (Located a)
	351	located parser = do
	352	begin <- getPosition
	353	result <- parser
	354	end <- getPosition
	355	return $ At (Span begin end) result
	356
	357	-- \| A default location value
	358	dLocation :: Location
	359	dLocation = Span dPos dPos
	360	where dPos = newPos "" 0 0
	361
335	362	{- $intro
336	363
337	364	This module contains a selection of parsers for different kinds of

+30

-1

Data/SCargot/Language/Basic.hs less more

5	5	-- $descr
6	6	basicParser
7	7	, basicPrinter
	8	, locatedBasicParser
	9	, locatedBasicPrinter
8	10	) where
9	11
10	12	import Control.Applicative ((<$>))
11	13	import Data.Char (isAlphaNum)
12	14	import Text.Parsec (many1, satisfy)
13	15	import Data.Text (Text, pack)
	16	import Data.Functor.Identity (Identity)
	17	import Text.Parsec.Prim (ParsecT)
14	18
	19	import Data.SCargot.Common (Located(..), located)
15	20	import Data.SCargot.Repr.Basic (SExpr)
16	21	import Data.SCargot ( SExprParser
17	22	, SExprPrinter

24	29	\|\| c == '-' \|\| c == '*' \|\| c == '/'
25	30	\|\| c == '+' \|\| c == '<' \|\| c == '>'
26	31	\|\| c == '=' \|\| c == '!' \|\| c == '?'
	32
	33	pToken :: ParsecT Text a Identity Text
	34	pToken = pack <$> many1 (satisfy isAtomChar)
27	35
28	36	-- $descr
29	37	-- The 'basicSpec' describes S-expressions whose atoms are simply

43	51	-- Right [SCons (SAtom "1") (SCons (SAtom "elephant") SNil)]
44	52	basicParser :: SExprParser Text (SExpr Text)
45	53	basicParser = mkParser pToken
46		where pToken = pack <$> many1 (satisfy isAtomChar)
	54
	55	-- \| A 'basicParser' which produces 'Located' values
	56	--
	57	-- >>> decode locatedBasicParser $ pack "(1 elephant)"
	58	-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) "1")) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) "elephant")) SNil)]
	59	--
	60	-- >>> decode locatedBasicParser $ pack "(let ((x 1))\n x)"
	61	-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 5)) "let")) (SCons (SCons (SCons (SAtom (At (Span (line 1, column 8) (line 1, column 9)) "x")) (SCons (SAtom (At (Span (line 1, column 10) (line 1, column 11)) "1")) SNil)) SNil) (SCons (SAtom (At (Span (line 2, column 3) (line 2, column 4)) "x")) SNil))]
	62	locatedBasicParser :: SExprParser (Located Text) (SExpr (Located Text))
	63	locatedBasicParser = mkParser $ located pToken
47	64
48	65	-- \| A 'SExprPrinter' that prints textual atoms directly (without quoting
49	66	-- or any other processing) onto a single line.

52	69	-- "(1 elephant)"
53	70	basicPrinter :: SExprPrinter Text (SExpr Text)
54	71	basicPrinter = flatPrint id
	72
	73	-- \| A 'SExprPrinter' for 'Located' values. Works exactly like 'basicPrinter'
	74	-- It ignores the location tags when printing the result.
	75	--
	76	-- >>> let (Right dec) = decode locatedBasicParser $ pack "(1 elephant)"
	77	-- [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) "1")) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) "elephant")) SNil)]
	78	--
	79	-- >>> encode locatedBasicPrinter dec
	80	-- "(1 elephant)"
	81	locatedBasicPrinter :: SExprPrinter (Located Text) (SExpr (Located Text))
	82	locatedBasicPrinter = flatPrint unLoc
	83	where unLoc (At _loc e) = e

+31

-0

Data/SCargot/Language/HaskLike.hs less more

	1	{-# LANGUAGE FlexibleInstances #-}
1	2	{-# LANGUAGE OverloadedStrings #-}
2	3
3	4	module Data.SCargot.Language.HaskLike

5	6	HaskLikeAtom(..)
6	7	, haskLikeParser
7	8	, haskLikePrinter
	9	, locatedHaskLikeParser
	10	, locatedHaskLikePrinter
8	11	-- * Individual Parsers
9	12	, parseHaskellString
10	13	, parseHaskellFloat

55	58
56	59	instance IsString HaskLikeAtom where
57	60	fromString = HSIdent . fromString
	61
	62	instance IsString (Located HaskLikeAtom) where
	63	fromString = (At dLocation) . HSIdent . fromString
58	64
59	65	-- \| Parse a Haskell string literal as defined by the Haskell 2010
60	66	-- language specification.

157	163	haskLikeParser :: SExprParser HaskLikeAtom (SExpr HaskLikeAtom)
158	164	haskLikeParser = mkParser pHaskLikeAtom
159	165
	166	-- \| A 'haskLikeParser' which produces 'Located' values
	167	--
	168	-- >>> decode locatedHaskLikeParser $ pack "(0x01 \"\\x65lephant\")"
	169	-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 6)) (HSInt 1))) (SCons (SAtom (At (Span (line 1, column 7) (line 1, column 20)) (HSString "elephant"))) SNil)]
	170	--
	171	-- >>> decode locatedHaskLikeParser $ pack "(1 elephant)"
	172	-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) (HSInt 1))) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) (HSIdent "elephant"))) SNil)]
	173	locatedHaskLikeParser :: SExprParser (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
	174	locatedHaskLikeParser = mkParser $ located pHaskLikeAtom
	175
160	176	-- \| This 'SExprPrinter' emits s-expressions that contain Scheme-like
161	177	-- tokens as well as string literals, integer literals, and floating-point
162	178	-- literals, which will be emitted as the literals produced by Haskell's

167	183	-- "(1 \"elephant\")"
168	184	haskLikePrinter :: SExprPrinter HaskLikeAtom (SExpr HaskLikeAtom)
169	185	haskLikePrinter = flatPrint sHaskLikeAtom
	186
	187	-- \| Ignore location tags when packing values into text
	188	sLocatedHasklikeAtom :: Located HaskLikeAtom -> Text
	189	sLocatedHasklikeAtom (At _loc e) = sHaskLikeAtom e
	190
	191	-- \| A 'SExprPrinter' for 'Located' values. Works exactly like 'haskLikePrinter'
	192	-- It ignores the location tags when printing the result.
	193	--
	194	-- >>> let (Right dec) = decode locatedHaskLikeParser $ pack "(1 elephant)"
	195	-- [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) (HSInt 1))) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) (HSIdent "elephant"))) SNil)]
	196	--
	197	-- >>> encode locatedHaskLikePrinter dec
	198	-- "(1 elephant)"
	199	locatedHaskLikePrinter :: SExprPrinter (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
	200	locatedHaskLikePrinter = flatPrint sLocatedHasklikeAtom