sharkdp · sharkdp · Mar 4, 2021 · Mar 3, 2021
diff --git a/src/Insect/Environment.purs b/src/Insect/Environment.purs
@@ -2,6 +2,7 @@ module Insect.Environment
   ( StorageType(..)
   , StoredValue(..)
   , MathFunction
+  , FunctionDescription(..)
   , StoredFunction(..)
   , Environment
   , initialEnvironment
@@ -13,14 +14,15 @@ import Data.Bifunctor (lmap)
 import Data.Either (Either(..))
 import Data.List (List(..), (:))
 import Data.List.NonEmpty (NonEmptyList(..), head, length)
+import Data.Maybe (Maybe(..))
 import Data.NonEmpty (NonEmpty, (:|))
 import Data.Map (Map, fromFoldable)
 import Data.Tuple (Tuple(..))
 
 import Quantities (Quantity, ConversionError)
 import Quantities as Q
 
-import Insect.Language (EvalError(..), Identifier)
+import Insect.Language (EvalError(..), Identifier, Expression)
 import Insect.Functions as F
 
 -- | Values can be stored as constants, as constants that are not
@@ -35,8 +37,11 @@ data StoredValue = StoredValue StorageType Quantity
 -- | Mathematical functions on physical quantities.
 type MathFunction = NonEmpty List Quantity → Either EvalError Quantity
 
+-- | Meta information for a function, mostly for pretty printing
+data FunctionDescription = BuiltinFunction (Maybe Int) | UserFunction (NonEmpty List Identifier) Expression
+
 -- | A mathematical function with a given `StorageType`.
-data StoredFunction = StoredFunction StorageType MathFunction
+data StoredFunction = StoredFunction StorageType MathFunction FunctionDescription
 
 -- | The environment consists of identifiers that are mapped to specific
 -- | quantities.
@@ -135,9 +140,9 @@ initialEnvironment =
   where
     constVal identifier value = Tuple identifier (StoredValue Constant value)
     hiddenVal identifier value = Tuple identifier (StoredValue HiddenConstant value)
-    constFunc  identifier func = Tuple identifier (StoredFunction Constant (wrapSimple identifier func))
-    constFunc2 identifier func = Tuple identifier (StoredFunction Constant (wrapSimple2 identifier func))
-    constFuncN identifier func = Tuple identifier (StoredFunction Constant func)
+    constFunc  identifier func = Tuple identifier (StoredFunction Constant (wrapSimple identifier func) (BuiltinFunction (Just 1)))
+    constFunc2 identifier func = Tuple identifier (StoredFunction Constant (wrapSimple2 identifier func) (BuiltinFunction (Just 2)))
+    constFuncN identifier func = Tuple identifier (StoredFunction Constant func (BuiltinFunction Nothing))
 
     wrapSimple ∷ Identifier → (Quantity → Either ConversionError Quantity) → MathFunction
     wrapSimple name func qs =

diff --git a/src/Insect/Interpreter.purs b/src/Insect/Interpreter.purs
@@ -15,7 +15,7 @@ import Data.Int (round, toNumber)
 import Data.List (List(..), sortBy, filter, groupBy, (..))
 import Data.List.NonEmpty (NonEmptyList(..), head, length, zip)
 import Data.Maybe (Maybe(..))
-import Data.NonEmpty ((:|), foldl1)
+import Data.NonEmpty (NonEmpty, (:|), foldl1)
 import Data.Map (lookup, insert, delete, toUnfoldable)
 import Data.String (toLower)
 import Data.Traversable (traverse)
@@ -27,9 +27,9 @@ import Quantities as Q
 import Insect.Language (BinOp(..), Expression(..), Command(..), Identifier,
                         Statement(..), EvalError(..))
 import Insect.Environment (Environment, StorageType(..), StoredValue(..),
-                           StoredFunction(..), initialEnvironment,
-                           MathFunction)
-import Insect.Format (Markup)
+                           FunctionDescription(..), StoredFunction(..),
+                           initialEnvironment, MathFunction)
+import Insect.Format (FormattedString, Markup)
 import Insect.Format as F
 import Insect.PrettyPrint (pretty, prettyQuantity)
 
@@ -117,7 +117,7 @@ eval env (Apply name xs)        =
           Left (WrongArityError name 4 (length (NonEmptyList xs)))
     else
       case lookup name env.functions of
-        Just (StoredFunction _ fn) →
+        Just (StoredFunction _ fn _) →
           traverse (eval env) xs >>= fn >>= checkFinite
         Nothing → Left (LookupError name)
 eval env (BinOp op x y)         = do
@@ -242,10 +242,17 @@ isConstant env name = isConstantValue || isConstantFunction
         _ → false
     isConstantFunction =
       case lookup name env.functions of
-        Just (StoredFunction Constant _)       → true
-        Just (StoredFunction HiddenConstant _) → true
+        Just (StoredFunction Constant _ _)       → true
+        Just (StoredFunction HiddenConstant _ _) → true
         _ → false
 
+-- | Format a function definition
+prettyPrintFunction :: Identifier -> NonEmpty List Identifier -> Array FormattedString
+prettyPrintFunction name argNames =
+  [ F.function name, F.text "(" ] <> fArgs <> [ F.text ") = " ]
+  where
+    fArgs = intercalate [ F.text ", " ] ((\a → [ F.ident a ]) <$> argNames)
+
 -- | Run a single statement of an Insect program.
 runInsect ∷ Environment → Statement → Response
 runInsect env (Expression e) =
@@ -276,20 +283,17 @@ runInsect env (VariableAssignment name val) =
 runInsect env (FunctionAssignment name argNames expr) =
   if isConstant env name
     then
-      errorWithInput fAssign expr env (RedefinedConstantError name)
+      errorWithInput (prettyPrintFunction name argNames) expr env (RedefinedConstantError name)
     else
-      { msg: Message ValueSet $ (F.optional <$> (F.text "  " : fAssign)) <> pretty expr
-      , newEnv: env { functions = insert name (StoredFunction UserDefined userFunc) env.functions
+      { msg: Message ValueSet $ (F.optional <$> (F.text "  " : (prettyPrintFunction name argNames))) <> pretty expr
+      , newEnv: env { functions = insert name (StoredFunction UserDefined userFunc (UserFunction argNames expr)) env.functions
                     , values = delete name env.values
                     }
       }
   where
     argNames' = NonEmptyList argNames
     numExpected = length argNames'
 
-    fArgs = intercalate [ F.text ", " ] ((\a → [ F.ident a ]) <$> argNames)
-    fAssign = [ F.function name, F.text "(" ] <> fArgs <> [ F.text ") = " ]
-
     userFunc ∷ MathFunction
     userFunc argValues =
       if numGiven == numExpected
@@ -305,6 +309,29 @@ runInsect env (FunctionAssignment name argNames expr) =
                           , functions = delete name env.functions
                           }
 
+runInsect env (PrettyPrintFunction name) =
+  { msg: message,
+    newEnv: env
+  }
+  where
+    message =
+      case lookup name env.functions of
+        Just (StoredFunction _ fn (BuiltinFunction args)) →
+          Message Info [ F.optional (F.text "  "),
+                         F.ident name,
+                         F.text "(",
+                         F.text argText,
+                         F.text ") = builtin function" ]
+          where
+            argText = case args of
+                        Just 1 -> "x"
+                        Just 2 -> "x, y"
+                        Just _ -> "x, y, …"
+                        Nothing -> "x1, x2, …"
+        Just (StoredFunction _ fn (UserFunction args expr)) →
+          Message Info $ (F.optional <$> (F.text "  " : (prettyPrintFunction name args))) <> pretty expr
+        Nothing → Message Error [ F.text "Unknown function" ]
+
 runInsect env (Command Help) = { msg: Message Info
   [ F.emph "insect", F.text " evaluates mathematical expressions that can", F.nl
   , F.text "involve physical quantities. You can start by trying", F.nl

diff --git a/src/Insect/Language.purs b/src/Insect/Language.purs
@@ -83,11 +83,13 @@ data Statement
  = Expression Expression
  | VariableAssignment Identifier Expression
  | FunctionAssignment Identifier (NonEmpty List Identifier) Expression
+ | PrettyPrintFunction Identifier
  | Command Command
 
 derive instance eqStatement ∷ Eq Statement
 instance showStatement ∷ Show Statement where
   show (Expression e)              = "(Expression " <> show e <> ")"
   show (VariableAssignment i e)    = "(VariableAssignment " <> show i <> " " <> show e <> ")"
   show (FunctionAssignment f xs e) = "(FunctionAssignment " <> show f <> " " <> show xs <> " " <> show e <> ")"
+  show (PrettyPrintFunction f)     = "(PrettyPrintFunction " <> show f <> ")"
   show (Command c)                 = "(Command " <> show c <> ")"
diff --git a/src/Insect/Parser.purs b/src/Insect/Parser.purs
@@ -351,7 +351,7 @@ function env = do
       pure name
     else
       case lookup name env.functions of
-        Just (StoredFunction _ fn) → pure name
+        Just (StoredFunction _ fn _) → pure name
         Nothing → fail ("Unknown function '" <> name <> "'")
 
 -- | Parse a full mathematical expression.
@@ -515,6 +515,7 @@ statement ∷ Environment → P Statement
 statement env =
       (Command <$> command)
   <|> assignment env
+  <|> (try (whiteSpace *> (PrettyPrintFunction <$> function env) <* eof))
   <|> (Expression <$> fullExpression env)
 
 -- | Run the Insect-parser on a `String` input.

diff --git a/test/Main.purs b/test/Main.purs
@@ -740,6 +740,14 @@ main = runTest do
       shouldFail "meter(x)=2" -- 'meter' is a reserved unit
       shouldFail "list(x)=4" -- 'list' is a reserved keyword
 
+  suite "Parser - Pretty print function" do
+    test "Simple" do
+      allParseAs (PrettyPrintFunction "cos") $
+        [ "cos"
+        , "  cos"
+        , "cos  "
+        ]
+
   let pretty' str =
         case parseInsect initialEnvironment str of
           Right (Expression expr) → format fmtPlain (pretty expr)