{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright (C) 2014-2019 , Julia Longtin (julial@turinglace.com)
-- Copyright (C) 2016, Kelvin Cookshaw (kelvin@cookshaw.com)
-- Released under the GNU AGPLV3+, see LICENSE

-- Allow us to use shorter forms of Var and Name.
{-# LANGUAGE PatternSynonyms #-}

-- Allow us to use string literals for Text
{-# LANGUAGE OverloadedStrings #-}

-- A parser for a numeric expressions.
module Graphics.Implicit.ExtOpenScad.Parser.Expr(expr0) where

import Prelude (Char, Maybe(Nothing, Just), ($), (<>), id, foldl, foldr, (==), length, head, (&&), (<$>), (<*>), (*>), (<*), flip, (.), pure)

import Graphics.Implicit.ExtOpenScad.Definitions (Expr(LamE, LitE, ListE, (:$)), OVal(ONum, OUndefined), Symbol(Symbol))

import qualified Graphics.Implicit.ExtOpenScad.Definitions as GIED (Expr(Var), Pattern(Name))

import Graphics.Implicit.ExtOpenScad.Parser.Util ((?:), (*<|>), number, boolean, scadString, scadUndefined, variable)

-- The lexer.
import Graphics.Implicit.ExtOpenScad.Parser.Lexer (whiteSpace, matchLet, matchTok, matchColon, matchComma, surroundedBy, matchIdentifier, matchEQ, matchNE, matchLE, matchLT, matchGE, matchGT, matchCAT, matchAND, matchOR, matchEXP, matchComma)

-- The parsec parsing library.
import Text.Parsec (oneOf, many, sepBy, optionMaybe, option, (<|>), chainl1, chainr1)

import Text.Parsec.String (GenParser)

import Data.Text.Lazy (Text, pack, singleton)

import Control.Monad.Fix (fix)

-- Let us use the old syntax when defining Vars and Names.
pattern Var :: Text -> Expr
pattern $bVar :: Text -> Expr
$mVar :: forall r. Expr -> (Text -> r) -> (Void# -> r) -> r
Var  s = GIED.Var  (Symbol s)
pattern Name :: Text -> GIED.Pattern
pattern $bName :: Text -> Pattern
$mName :: forall r. Pattern -> (Text -> r) -> (Void# -> r) -> r
Name n = GIED.Name (Symbol n)

-- Borrowed the pattern from http://compgroups.net/comp.lang.functional/parsing-ternary-operator-with-parsec/1052460
-- In the levels list, the first element is the lowest precedent, and the last is the highest.
-- "higher" represents the higher precedence parser, ie. the next one in the levels list.
-- "fix $ \self ->..." is used to consume all expressions in the same level, "self" being the current level.
expr0 :: GenParser Char st Expr
expr0 :: GenParser Char st Expr
expr0 = ((GenParser Char st Expr -> GenParser Char st Expr)
 -> GenParser Char st Expr -> GenParser Char st Expr)
-> GenParser Char st Expr
-> [GenParser Char st Expr -> GenParser Char st Expr]
-> GenParser Char st Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (GenParser Char st Expr -> GenParser Char st Expr)
-> GenParser Char st Expr -> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
($) GenParser Char st Expr
forall st. GenParser Char st Expr
nonAssociativeExpr [GenParser Char st Expr -> GenParser Char st Expr]
forall st. [GenParser Char st Expr -> GenParser Char st Expr]
levels
  where
    levels :: [GenParser Char st Expr -> GenParser Char st Expr]
    levels :: [GenParser Char st Expr -> GenParser Char st Expr]
levels =
      [ GenParser Char st Expr -> GenParser Char st Expr
forall a. a -> a
id
      , \GenParser Char st Expr
higher -> (GenParser Char st Expr -> GenParser Char st Expr)
-> GenParser Char st Expr
forall a. (a -> a) -> a
fix ((GenParser Char st Expr -> GenParser Char st Expr)
 -> GenParser Char st Expr)
-> (GenParser Char st Expr -> GenParser Char st Expr)
-> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ \GenParser Char st Expr
self -> do -- ?: ternary operator.
          Expr
condition <- GenParser Char st Expr
higher
          do
            Expr
trueExpr  <- Char -> GenParser Char st Char
forall st. Char -> GenParser Char st Char
matchTok Char
'?' GenParser Char st Char
-> GenParser Char st Expr -> GenParser Char st Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char st Expr
self
            Expr
falseExpr <- GenParser Char st Text
forall st. GenParser Char st Text
matchColon   GenParser Char st Text
-> GenParser Char st Expr -> GenParser Char st Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char st Expr
self
            Expr -> GenParser Char st Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> GenParser Char st Expr) -> Expr -> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr
Var Text
"?" Expr -> [Expr] -> Expr
:$ [Expr
condition, Expr
trueExpr, Expr
falseExpr]
           GenParser Char st Expr
-> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            Expr -> GenParser Char st Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
condition
      , \GenParser Char st Expr
higher -> -- boolean OR operator (||)
          GenParser Char st Expr
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 GenParser Char st Expr
higher (ParsecT [Char] st Identity (Expr -> Expr -> Expr)
 -> GenParser Char st Expr)
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr -> Expr -> Expr
binaryOperation (Text -> Expr -> Expr -> Expr)
-> GenParser Char st Text
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char st Text
forall st. GenParser Char st Text
matchOR
      , \GenParser Char st Expr
higher -> -- boolean AND operator (&&)
          GenParser Char st Expr
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 GenParser Char st Expr
higher (ParsecT [Char] st Identity (Expr -> Expr -> Expr)
 -> GenParser Char st Expr)
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr -> Expr -> Expr
binaryOperation (Text -> Expr -> Expr -> Expr)
-> GenParser Char st Text
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char st Text
forall st. GenParser Char st Text
matchAND
      , \GenParser Char st Expr
higher -> -- == and != operators
          GenParser Char st Expr
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 GenParser Char st Expr
higher (ParsecT [Char] st Identity (Expr -> Expr -> Expr)
 -> GenParser Char st Expr)
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr -> Expr -> Expr
binaryOperation (Text -> Expr -> Expr -> Expr)
-> GenParser Char st Text
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenParser Char st Text
forall st. GenParser Char st Text
matchEQ GenParser Char st Text
-> GenParser Char st Text -> GenParser Char st Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st Text
forall st. GenParser Char st Text
matchNE)
      , \GenParser Char st Expr
higher -> -- <, <=, >= and > operators
          GenParser Char st Expr
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 GenParser Char st Expr
higher (ParsecT [Char] st Identity (Expr -> Expr -> Expr)
 -> GenParser Char st Expr)
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr -> Expr -> Expr
binaryOperation (Text -> Expr -> Expr -> Expr)
-> GenParser Char st Text
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GenParser Char st Text
forall st. GenParser Char st Text
matchLE GenParser Char st Text
-> GenParser Char st Text -> GenParser Char st Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st Text
forall st. GenParser Char st Text
matchLT GenParser Char st Text
-> GenParser Char st Text -> GenParser Char st Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st Text
forall st. GenParser Char st Text
matchGE GenParser Char st Text
-> GenParser Char st Text -> GenParser Char st Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st Text
forall st. GenParser Char st Text
matchGT)
      , \GenParser Char st Expr
higher -> -- + and - operators
          GenParser Char st Expr
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 GenParser Char st Expr
higher (ParsecT [Char] st Identity (Expr -> Expr -> Expr)
 -> GenParser Char st Expr)
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr -> Expr -> Expr
binaryOperation (Text -> Expr -> Expr -> Expr)
-> (Char -> Text) -> Char -> Expr -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
singleton (Char -> Expr -> Expr -> Expr)
-> GenParser Char st Char
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"+-" ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> ParsecT [Char] st Identity ()
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Char] st Identity ()
forall st. GenParser Char st ()
whiteSpace
      , \GenParser Char st Expr
higher -> -- string/list concatenation operator (++). This is not available in OpenSCAD.
          GenParser Char st Expr
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 GenParser Char st Expr
higher (ParsecT [Char] st Identity (Expr -> Expr -> Expr)
 -> GenParser Char st Expr)
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr -> Expr -> Expr
binaryOperation (Text -> Expr -> Expr -> Expr)
-> GenParser Char st Text
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char st Text
forall st. GenParser Char st Text
matchCAT
      , \GenParser Char st Expr
higher -> -- exponent operator (^). This is not available in OpenSCAD.
          GenParser Char st Expr
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainr1 GenParser Char st Expr
higher (ParsecT [Char] st Identity (Expr -> Expr -> Expr)
 -> GenParser Char st Expr)
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr -> Expr -> Expr
binaryOperation (Text -> Expr -> Expr -> Expr)
-> (Char -> Text) -> Char -> Expr -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
singleton (Char -> Expr -> Expr -> Expr)
-> GenParser Char st Char
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char st Char
forall st. GenParser Char st Char
matchEXP
      , \GenParser Char st Expr
higher -> -- multiplication (*), division (/), and modulus (%) operators
          GenParser Char st Expr
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
chainl1 GenParser Char st Expr
higher (ParsecT [Char] st Identity (Expr -> Expr -> Expr)
 -> GenParser Char st Expr)
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr -> Expr -> Expr
binaryOperation (Text -> Expr -> Expr -> Expr)
-> (Char -> Text) -> Char -> Expr -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
singleton (Char -> Expr -> Expr -> Expr)
-> GenParser Char st Char
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> GenParser Char st Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"*/%" ParsecT [Char] st Identity (Expr -> Expr -> Expr)
-> ParsecT [Char] st Identity ()
-> ParsecT [Char] st Identity (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Char] st Identity ()
forall st. GenParser Char st ()
whiteSpace
      , \GenParser Char st Expr
higher ->
          (GenParser Char st Expr -> GenParser Char st Expr)
-> GenParser Char st Expr
forall a. (a -> a) -> a
fix ((GenParser Char st Expr -> GenParser Char st Expr)
 -> GenParser Char st Expr)
-> (GenParser Char st Expr -> GenParser Char st Expr)
-> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ \GenParser Char st Expr
self -> -- unary ! operator. OpenSCAD's YACC parser puts '!' at the same level of precedence as '-' and '+'.
                  do
                    Char
op <- Char -> GenParser Char st Char
forall st. Char -> GenParser Char st Char
matchTok Char
'!'
                    Expr
right <- GenParser Char st Expr
self
                    -- when noting a not, just skip both of them.
                    Expr -> GenParser Char st Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> GenParser Char st Expr) -> Expr -> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ case Expr
right of
                      Var Text
"!" :$ [Expr
deepright] -> Expr
deepright
                      Expr
_                      -> Text -> Expr
Var (Char -> Text
singleton Char
op) Expr -> [Expr] -> Expr
:$ [Expr
right]
        GenParser Char st Expr
-> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          GenParser Char st Expr
higher
      , \GenParser Char st Expr
higher -> -- leading positive or negative sign.
          (GenParser Char st Expr -> GenParser Char st Expr)
-> GenParser Char st Expr
forall a. (a -> a) -> a
fix ((GenParser Char st Expr -> GenParser Char st Expr)
 -> GenParser Char st Expr)
-> (GenParser Char st Expr -> GenParser Char st Expr)
-> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ \GenParser Char st Expr
self ->
              do -- Unary -. applied to strings is undefined, but handle that in the interpreter.
                Expr
right <- Char -> GenParser Char st Char
forall st. Char -> GenParser Char st Char
matchTok Char
'-' GenParser Char st Char
-> GenParser Char st Expr -> GenParser Char st Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char st Expr
self
                Expr -> GenParser Char st Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> GenParser Char st Expr) -> Expr -> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr
Var Text
"negate" Expr -> [Expr] -> Expr
:$ [Expr
right]
          GenParser Char st Expr
-> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do -- Unary +. Handle this by ignoring the +.
                Char -> GenParser Char st Char
forall st. Char -> GenParser Char st Char
matchTok Char
'+' GenParser Char st Char
-> GenParser Char st Expr -> GenParser Char st Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char st Expr
self
        GenParser Char st Expr
-> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          GenParser Char st Expr
higher
      , \GenParser Char st Expr
higher -> -- "let" expression
          (Expr -> [Expr] -> Expr) -> [Expr] -> Expr -> Expr
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Expr -> Expr -> Expr) -> Expr -> [Expr] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Expr -> Expr -> Expr
bindLets) ([Expr] -> Expr -> Expr)
-> ParsecT [Char] st Identity [Expr]
-> ParsecT [Char] st Identity (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Char] st Identity ()
forall st. GenParser Char st ()
matchLet ParsecT [Char] st Identity ()
-> ParsecT [Char] st Identity [Expr]
-> ParsecT [Char] st Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char
-> ParsecT [Char] st Identity [Expr]
-> Char
-> ParsecT [Char] st Identity [Expr]
forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'(' (GenParser Char st Expr
forall st. GenParser Char st Expr
assignment GenParser Char st Expr
-> GenParser Char st Text -> ParsecT [Char] st Identity [Expr]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` GenParser Char st Text
forall st. GenParser Char st Text
matchComma) Char
')') ParsecT [Char] st Identity (Expr -> Expr)
-> GenParser Char st Expr -> GenParser Char st Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenParser Char st Expr
forall st. GenParser Char st Expr
expr0
        GenParser Char st Expr
-> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
          GenParser Char st Expr
higher
      ]

-- | parse expressions that don't associate, either because they are not operators or because they are operators
--   that contain the expressions they operate on in start and end tokens, like parentheses, and no other operator can associate with their expressions.
nonAssociativeExpr :: GenParser Char st Expr
nonAssociativeExpr :: GenParser Char st Expr
nonAssociativeExpr =
       GenParser Char st Expr
forall st. GenParser Char st Expr
number
   GenParser Char st Expr
-> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st Expr
forall st. GenParser Char st Expr
vectorListParentheses
   GenParser Char st Expr
-> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st Expr
forall st. GenParser Char st Expr
variableish
   GenParser Char st Expr
-> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st Expr
forall st. GenParser Char st Expr
scadString
   GenParser Char st Expr
-> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st Expr
forall st. GenParser Char st Expr
boolean
   GenParser Char st Expr
-> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char st Expr
forall st. GenParser Char st Expr
scadUndefined

-- | parse operations that start with a variable name,
-- including variable reference, function calling, variable list indexing, and variable list splicing.
variableish :: GenParser Char st Expr
variableish :: GenParser Char st Expr
variableish = [Char]
"variable" [Char] -> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
[Char] -> ParsecT s u m a -> ParsecT s u m a
?:
    do
        Expr
obj <- GenParser Char st Expr
forall st. GenParser Char st Expr
variable
        [Expr -> Expr]
args <- [Expr -> Expr]
-> ParsecT [Char] st Identity [Expr -> Expr]
-> ParsecT [Char] st Identity [Expr -> Expr]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (
          [Char]
"function application" [Char]
-> ParsecT [Char] st Identity [Expr -> Expr]
-> ParsecT [Char] st Identity [Expr -> Expr]
forall s u (m :: * -> *) a.
[Char] -> ParsecT s u m a -> ParsecT s u m a
?: do
              [Expr]
args <- Char
-> GenParser Char st [Expr] -> Char -> GenParser Char st [Expr]
forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'(' (GenParser Char st Expr
-> ParsecT [Char] st Identity Text -> GenParser Char st [Expr]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy GenParser Char st Expr
forall st. GenParser Char st Expr
expr0 ParsecT [Char] st Identity Text
forall st. GenParser Char st Text
matchComma) Char
')'
              [Expr -> Expr] -> ParsecT [Char] st Identity [Expr -> Expr]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Expr -> [Expr] -> Expr
:$ [Expr]
args)]
          )
        [Expr -> Expr]
mods <- ParsecT [Char] st Identity (Expr -> Expr)
-> ParsecT [Char] st Identity [Expr -> Expr]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (
               [Char]
"list indexing" [Char]
-> ParsecT [Char] st Identity (Expr -> Expr)
-> ParsecT [Char] st Identity (Expr -> Expr)
forall s u (m :: * -> *) a.
[Char] -> ParsecT s u m a -> ParsecT s u m a
?: do
                   Expr
i <- Char -> GenParser Char st Expr -> Char -> GenParser Char st Expr
forall st a.
Char -> GenParser Char st a -> Char -> GenParser Char st a
surroundedBy Char
'[' GenParser Char st Expr
forall st. GenParser Char st Expr
expr0 Char
']'
                   (Expr -> Expr) -> ParsecT [Char] st Identity (Expr -> Expr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Expr -> Expr) -> ParsecT [Char] st Identity (Expr -> Expr))
-> (Expr -> Expr) -> ParsecT [Char] st Identity (Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
l -> Text -> Expr
Var Text
"index" Expr -> [Expr] -> Expr
:$ [Expr
l, Expr
i]
          ParsecT [Char] st Identity (Expr -> Expr)
-> ParsecT [Char] st Identity (Expr -> Expr)
-> ParsecT [Char] st Identity (Expr -> Expr)
forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|> [Char]
"list splicing" [Char]
-> ParsecT [Char] st Identity (Expr -> Expr)
-> ParsecT [Char] st Identity (Expr -> Expr)
forall s u (m :: * -> *) a.
[Char] -> ParsecT s u m a -> ParsecT s u m a
?: do
                   Maybe Expr
start <- Char -> GenParser Char st Char
forall st. Char -> GenParser Char st Char
matchTok Char
'[' GenParser Char st Char
-> ParsecT [Char] st Identity (Maybe Expr)
-> ParsecT [Char] st Identity (Maybe Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char st Expr -> ParsecT [Char] st Identity (Maybe Expr)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe GenParser Char st Expr
forall st. GenParser Char st Expr
expr0
                   Maybe Expr
end   <- ParsecT [Char] st Identity Text
forall st. GenParser Char st Text
matchColon ParsecT [Char] st Identity Text
-> ParsecT [Char] st Identity (Maybe Expr)
-> ParsecT [Char] st Identity (Maybe Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char st Expr -> ParsecT [Char] st Identity (Maybe Expr)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe GenParser Char st Expr
forall st. GenParser Char st Expr
expr0 ParsecT [Char] st Identity (Maybe Expr)
-> GenParser Char st Char
-> ParsecT [Char] st Identity (Maybe Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> GenParser Char st Char
forall st. Char -> GenParser Char st Char
matchTok Char
']'
                   (Expr -> Expr) -> ParsecT [Char] st Identity (Expr -> Expr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Expr -> Expr) -> ParsecT [Char] st Identity (Expr -> Expr))
-> (Expr -> Expr) -> ParsecT [Char] st Identity (Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ case (Maybe Expr
start, Maybe Expr
end) of
                              (Maybe Expr
Nothing, Maybe Expr
Nothing) -> Expr -> Expr
forall a. a -> a
id
                              (Just Expr
s,  Maybe Expr
Nothing)  -> \Expr
l -> Text -> Expr
Var Text
"splice" Expr -> [Expr] -> Expr
:$ [Expr
l, Expr
s, OVal -> Expr
LitE OVal
OUndefined]
                              (Maybe Expr
Nothing, Just Expr
e )  -> \Expr
l -> Text -> Expr
Var Text
"splice" Expr -> [Expr] -> Expr
:$ [Expr
l, OVal -> Expr
LitE (OVal -> Expr) -> OVal -> Expr
forall a b. (a -> b) -> a -> b
$ ℝ -> OVal
ONum ℝ
0, Expr
e]
                              (Just Expr
s,  Just Expr
e )  -> \Expr
l -> Text -> Expr
Var Text
"splice" Expr -> [Expr] -> Expr
:$ [Expr
l, Expr
s, Expr
e]
                 )
        Expr -> GenParser Char st Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> GenParser Char st Expr) -> Expr -> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> (Expr -> Expr) -> Expr) -> Expr -> [Expr -> Expr] -> Expr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Expr
a Expr -> Expr
b -> Expr -> Expr
b Expr
a) Expr
obj ([Expr -> Expr]
args [Expr -> Expr] -> [Expr -> Expr] -> [Expr -> Expr]
forall a. Semigroup a => a -> a -> a
<> [Expr -> Expr]
mods)

-- | Parse parentheses, lists, vectors, and vector/list generators.
vectorListParentheses :: GenParser Char st Expr
vectorListParentheses :: GenParser Char st Expr
vectorListParentheses =
         [Char]
"vector/list/parentheses" [Char] -> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
[Char] -> ParsecT s u m a -> ParsecT s u m a
?: do
            -- eg. [ 3, a, a+1, b, a*b] - list
            --     ( 1, 2, 3) - list
            --     (a+1) - parenthesized expression.
            Char
o <- [Char] -> ParsecT [Char] st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"[(" ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity () -> ParsecT [Char] st Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Char] st Identity ()
forall st. GenParser Char st ()
whiteSpace
            [Expr]
exprs <- GenParser Char st Expr
-> ParsecT [Char] st Identity Text
-> ParsecT [Char] st Identity [Expr]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy GenParser Char st Expr
forall st. GenParser Char st Expr
expr0 ParsecT [Char] st Identity Text
forall st. GenParser Char st Text
matchComma
              ParsecT [Char] st Identity [Expr]
-> ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* if Char
o Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'['
                 then Char -> ParsecT [Char] st Identity Char
forall st. Char -> GenParser Char st Char
matchTok Char
']'
                 else Char -> ParsecT [Char] st Identity Char
forall st. Char -> GenParser Char st Char
matchTok Char
')'
            Expr -> GenParser Char st Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> GenParser Char st Expr) -> Expr -> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ if Char
o Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
exprs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                     then [Expr] -> Expr
forall a. [a] -> a
head [Expr]
exprs
                     else [Expr] -> Expr
ListE [Expr]
exprs
    GenParser Char st Expr
-> GenParser Char st Expr -> GenParser Char st Expr
forall tok u a.
GenParser tok u a -> GenParser tok u a -> GenParser tok u a
*<|> [Char]
"vector/list generator" [Char] -> GenParser Char st Expr -> GenParser Char st Expr
forall s u (m :: * -> *) a.
[Char] -> ParsecT s u m a -> ParsecT s u m a
?: do
        -- eg.  [ a : 1 : a + 10 ]
        --      [ a : a + 10 ]
        -- FIXME: clearly, these have a numeric context, and should fail to parse for non-numeric contents.
        Expr
expr1 <- Char -> ParsecT [Char] st Identity Char
forall st. Char -> GenParser Char st Char
matchTok Char
'[' ParsecT [Char] st Identity Char
-> GenParser Char st Expr -> GenParser Char st Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char st Expr
forall st. GenParser Char st Expr
expr0 GenParser Char st Expr
-> ParsecT [Char] st Identity Text -> GenParser Char st Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Char] st Identity Text
forall st. GenParser Char st Text
matchColon
        [Expr]
exprs <- do
                   Expr
expr2 <- GenParser Char st Expr
forall st. GenParser Char st Expr
expr0
                   Maybe Expr
expr3 <- GenParser Char st Expr -> ParsecT [Char] st Identity (Maybe Expr)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT [Char] st Identity Text
forall st. GenParser Char st Text
matchColon ParsecT [Char] st Identity Text
-> GenParser Char st Expr -> GenParser Char st Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char st Expr
forall st. GenParser Char st Expr
expr0)
                   [Expr] -> ParsecT [Char] st Identity [Expr]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expr] -> ParsecT [Char] st Identity [Expr])
-> [Expr] -> ParsecT [Char] st Identity [Expr]
forall a b. (a -> b) -> a -> b
$ case Maybe Expr
expr3 of
                      Just Expr
n  -> [Expr
expr1, Expr
expr2, Expr
n]
                      Maybe Expr
Nothing -> [Expr
expr1, OVal -> Expr
LitE (OVal -> Expr) -> OVal -> Expr
forall a b. (a -> b) -> a -> b
$ ℝ -> OVal
ONum ℝ
1.0, Expr
expr2]
          ParsecT [Char] st Identity [Expr]
-> ParsecT [Char] st Identity Char
-> ParsecT [Char] st Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT [Char] st Identity Char
forall st. Char -> GenParser Char st Char
matchTok Char
']'
        Expr -> GenParser Char st Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> GenParser Char st Expr) -> Expr -> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ Text -> [Expr] -> Expr
collector Text
"list_gen" [Expr]
exprs

-- | Apply a symbolic operator to a list of expressions, pureing one big expression.
--   Accepts a string for the operator, to simplify callers.
collector :: Text -> [Expr] -> Expr
collector :: Text -> [Expr] -> Expr
collector Text
_ [Expr
x] = Expr
x
collector Text
s  [Expr]
l  = Text -> Expr
Var Text
s Expr -> [Expr] -> Expr
:$ [[Expr] -> Expr
ListE [Expr]
l]

-- | Apply a symbolic operator to two expressions, combining left and right operands with an binary operator
binaryOperation :: Text -> Expr -> Expr -> Expr
binaryOperation :: Text -> Expr -> Expr -> Expr
binaryOperation Text
symbol Expr
left Expr
right = Text -> Expr
Var Text
symbol Expr -> [Expr] -> Expr
:$ [Expr
left, Expr
right]

-- | An assignment expression within a let's bindings list
assignment :: GenParser Char st Expr
assignment :: GenParser Char st Expr
assignment = do
    [Char]
ident       <- GenParser Char st [Char]
forall st. GenParser Char st [Char]
matchIdentifier
    Expr
expression  <- Char -> GenParser Char st Char
forall st. Char -> GenParser Char st Char
matchTok Char
'=' GenParser Char st Char
-> GenParser Char st Expr -> GenParser Char st Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenParser Char st Expr
forall st. GenParser Char st Expr
expr0
    Expr -> GenParser Char st Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> GenParser Char st Expr) -> Expr -> GenParser Char st Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
ListE [Text -> Expr
Var ([Char] -> Text
pack [Char]
ident), Expr
expression]

-- | build nested let statements when foldr'd.
bindLets :: Expr -> Expr -> Expr
bindLets :: Expr -> Expr -> Expr
bindLets (ListE [Var Text
boundName, Expr
boundExpr]) Expr
nestedExpr = [Pattern] -> Expr -> Expr
LamE [Text -> Pattern
Name Text
boundName] Expr
nestedExpr Expr -> [Expr] -> Expr
:$ [Expr
boundExpr]
bindLets Expr
_ Expr
e = Expr
e