mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
Convenience function for reading / parsing a whole file, also spotted needless attempt in effect pattern parser
This commit is contained in:
parent
82453d1b8c
commit
80b30b7ec1
@ -1,24 +1,31 @@
|
||||
module Unison.FileParser where
|
||||
|
||||
import qualified Text.Parsec.Layout as L
|
||||
-- import Text.Parsec.Prim (ParsecT)
|
||||
import Unison.Parser
|
||||
-- import qualified Unison.TypeParser as TypeParser
|
||||
import Prelude hiding (readFile)
|
||||
import Unison.Parser
|
||||
import Control.Applicative
|
||||
import Data.Either (partitionEithers)
|
||||
import Unison.Parsers (unsafeGetRight)
|
||||
import Data.Map (Map)
|
||||
import Unison.DataDeclaration (DataDeclaration(..))
|
||||
import Unison.EffectDeclaration (EffectDeclaration(..))
|
||||
import Unison.Parser (PEnv)
|
||||
import Unison.Parser (PEnv, penv0)
|
||||
import Unison.Parsers (unsafeGetRight)
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Term (Term)
|
||||
import Unison.TypeParser (S)
|
||||
import Unison.Var (Var)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Text.Parsec.Layout as L
|
||||
import qualified Unison.Parser
|
||||
import qualified Unison.Parsers as Parsers
|
||||
import qualified Unison.Term as Term
|
||||
import qualified Unison.TermParser as TermParser
|
||||
import qualified Unison.TypeParser as TypeParser
|
||||
import Unison.Var (Var)
|
||||
import Unison.Symbol (Symbol)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Unison.TypeParser (S)
|
||||
import Control.Monad.Reader
|
||||
import Data.Text.IO (readFile)
|
||||
import System.IO (FilePath)
|
||||
import qualified Data.Text as Text
|
||||
|
||||
data UnisonFile v = UnisonFile {
|
||||
dataDeclarations :: Map v (DataDeclaration v),
|
||||
@ -27,16 +34,32 @@ data UnisonFile v = UnisonFile {
|
||||
} deriving (Show)
|
||||
|
||||
unsafeParseFile :: String -> PEnv -> UnisonFile Symbol
|
||||
unsafeParseFile s env = unsafeGetRight $ parseFile s env
|
||||
unsafeParseFile s env = unsafeGetRight $ parseFile "" s env
|
||||
|
||||
parseFile :: String -> PEnv -> Either String (UnisonFile Symbol)
|
||||
parseFile = error ""
|
||||
parseFile :: FilePath -> String -> PEnv -> Either String (UnisonFile Symbol)
|
||||
parseFile filename s = Unison.Parser.run' (Unison.Parser.root file) s Parsers.s0 filename
|
||||
|
||||
parseFile' :: FilePath -> String -> Either String (UnisonFile Symbol)
|
||||
parseFile' filename s = parseFile filename s penv0
|
||||
|
||||
unsafeReadAndParseFile' :: String -> IO (UnisonFile Symbol)
|
||||
unsafeReadAndParseFile' = unsafeReadAndParseFile penv0
|
||||
|
||||
unsafeReadAndParseFile :: PEnv -> String -> IO (UnisonFile Symbol)
|
||||
unsafeReadAndParseFile env filename = do
|
||||
txt <- readFile filename
|
||||
let str = Text.unpack txt
|
||||
pure $ unsafeGetRight (parseFile filename str env)
|
||||
|
||||
file :: Var v => Parser (S v) (UnisonFile v)
|
||||
file = traced "file" $ do
|
||||
(dataDecls, effectDecls) <- traced "declarations" declarations
|
||||
term <- TermParser.block
|
||||
pure $ UnisonFile dataDecls effectDecls term
|
||||
local (`Map.union` environmentFor dataDecls effectDecls) $ do
|
||||
term <- TermParser.block
|
||||
pure $ UnisonFile dataDecls effectDecls term
|
||||
|
||||
environmentFor :: Map v (DataDeclaration v) -> Map v (EffectDeclaration v) -> PEnv
|
||||
environmentFor ds es = Map.empty -- todo
|
||||
|
||||
declarations :: Var v => Parser (S v)
|
||||
(Map v (DataDeclaration v),
|
||||
|
@ -87,33 +87,34 @@ pattern :: Var v => Parser (S v) (Pattern, [v])
|
||||
pattern = traced "pattern" $ constructor <|> leaf
|
||||
where
|
||||
leaf = literal <|> var <|> unbound <|> parenthesized pattern <|> effect
|
||||
literal = (,[]) <$> asum [true, false, number]
|
||||
literal = traced "pattern.literal" $ (,[]) <$> asum [true, false, number]
|
||||
true = Pattern.Boolean True <$ token (string "true")
|
||||
false = Pattern.Boolean False <$ token (string "false")
|
||||
number = number' Pattern.Int64 Pattern.UInt64 Pattern.Float
|
||||
number = traced "pattern.number" $ number' Pattern.Int64 Pattern.UInt64 Pattern.Float
|
||||
var = traced "var" $ (\v -> (Pattern.Var, [v])) <$> prefixVar
|
||||
unbound = (Pattern.Unbound, []) <$ token (char '_')
|
||||
ctorName = token $ do
|
||||
unbound = traced "unbound" $ (Pattern.Unbound, []) <$ token (char '_')
|
||||
ctorName = traced "ctorName" . token $ do
|
||||
s <- wordyId keywords
|
||||
guard . isUpper . head $ s
|
||||
pure s
|
||||
|
||||
effectBind0 = traced "effectBind0" $ do
|
||||
name <- ctorName
|
||||
leaves <- many leaf
|
||||
token_ (string "->")
|
||||
pure (name, leaves)
|
||||
|
||||
effectBind = do
|
||||
(name, leaves) <- attempt effectBind0
|
||||
(cont, vsp) <- pattern
|
||||
env <- ask
|
||||
(ref,cid) <- case Map.lookup name env of
|
||||
Just (ref, cid) -> pure (ref, cid)
|
||||
Nothing -> fail $ "unknown data constructor " ++ name
|
||||
leaves <- many leaf
|
||||
token_ (string "->")
|
||||
pure (ref, cid, leaves)
|
||||
|
||||
effectBind = do
|
||||
(ref, cid, leaves) <- attempt effectBind0
|
||||
(cont, vsp) <- pattern
|
||||
pure $ case unzip leaves of
|
||||
(patterns, vs) ->
|
||||
(Pattern.EffectBind ref cid patterns cont, join vs ++ vsp)
|
||||
|
||||
effectPure = go <$> pattern where
|
||||
go (p, vs) = (Pattern.EffectPure p, vs)
|
||||
|
||||
@ -125,11 +126,11 @@ pattern = traced "pattern" $ constructor <|> leaf
|
||||
name <- ctorName
|
||||
env <- ask
|
||||
case Map.lookup name env of
|
||||
Just (ref, cid) -> go <$> many leaf
|
||||
Just (ref, cid) -> go <$> traced "pattern.manyleaf" (many leaf)
|
||||
where
|
||||
go pairs = case unzip pairs of
|
||||
(patterns, vs) -> (Pattern.Constructor ref cid patterns, join vs)
|
||||
Nothing -> fail $ "unknown data constructor " ++ name
|
||||
Nothing -> traced ("failing " ++ name) . fail $ "unknown data constructor " ++ name
|
||||
|
||||
|
||||
-- where literal = boolean
|
||||
@ -232,7 +233,7 @@ vector p = Term.vector <$> (lbracket *> elements <* rbracket)
|
||||
|
||||
binding :: Var v => Parser (S v) (v, Term v)
|
||||
binding = traced "binding" . label "binding" $ do
|
||||
typ <- optional typedecl <* optional semicolon
|
||||
typ <- optional typedecl
|
||||
let lhs = attempt ((\arg1 op arg2 -> (op,[arg1,arg2]))
|
||||
<$> prefixVar <*> infixVar <*> prefixVar)
|
||||
<|> ((,) <$> prefixVar <*> many prefixVar)
|
||||
|
@ -3,6 +3,7 @@
|
||||
module Unison.Test.FileParser where
|
||||
|
||||
import EasyTest
|
||||
import Control.Applicative
|
||||
import Unison.FileParser
|
||||
import Unison.Parser
|
||||
import Unison.DataDeclaration
|
||||
@ -15,7 +16,7 @@ module Unison.Test.FileParser where
|
||||
import qualified Unison.Reference as R
|
||||
import Unison.Symbol (Symbol)
|
||||
|
||||
test = scope "fileparser" . tests . map parses $
|
||||
test1 = scope "fileparser" . tests . map parses $
|
||||
[
|
||||
"type Pair a b = Pair a b\n()"
|
||||
, "type Optional a = Just a | Nothing\n()"
|
||||
@ -45,6 +46,14 @@ module Unison.Test.FileParser where
|
||||
,"ping"]
|
||||
]
|
||||
|
||||
test2 = scope "fileparser.test1" $ do
|
||||
file <- io $ unsafeReadAndParseFile' "unison-src/test1.u"
|
||||
io $ putStrLn (show (file :: UnisonFile Symbol))
|
||||
ok
|
||||
|
||||
test = test2
|
||||
-- test1 <|> test2
|
||||
|
||||
builtins = Map.fromList
|
||||
[("Pair", (R.Builtin "Pair", 0)),
|
||||
("State.set", (R.Builtin "State", 0))]
|
||||
|
9
unison-src/test1.u
Normal file
9
unison-src/test1.u
Normal file
@ -0,0 +1,9 @@
|
||||
|
||||
type Optional a = None | Some a
|
||||
|
||||
Optional.isEmpty : ∀ a . Optional a -> Boolean
|
||||
Optional.isEmpty o = case o of
|
||||
None -> True
|
||||
_ -> False
|
||||
|
||||
()
|
Loading…
Reference in New Issue
Block a user