FParsec dilemma

all-in-one.fsx

#r "nuget: FParsec"
open System.Numerics

module AST =
    type Name = string

    type Expr =
        | VarCall of Name
        | Literal of PrimitiveT // Unit, Bool, Int, ...
        | Lambda of string * Expr
        | LetFunc of Name * Expr * Expr
        | LetRec of Name * Expr * Expr
        | Apply of Expr * Expr
        | IfElse of Expr * Expr * Expr
        | BinaryOp of (Expr * BinOp * Expr)
        | UnaryOp of (UnOp * Expr)

    and PrimitiveT =
        | UnitT
        | Str of string
        | Bool of bool
        | Num of NumericT

    and NumericT =
        | Int of int // 1
        | Float of float // 1.5
        | BigInt of BigInteger // 1I

    and BinOp =
        { Symbol: Name
          OpType: PrimitiveT
          Args: Expr * Expr }

    and UnOp =
        { Symbol: Name
          OpType: PrimitiveT
          Arg: Expr }


/// Error should be thrown
/// when parsing fails
exception MiniMLParsingError of string

/// Error should be thrown
/// when running of expression or statement fails
exception MiniMLRuntimeError of string

/// Extends functionality of BigInteger from System.Numerics
module BigIntegerExt =
    let parse (str: string) =
        match BigInteger.TryParse(str) with
        | true, parsed -> parsed
        | false, rem ->
            $"Error parsing: {str}, expected number literal (BigInt), collected: {rem};"
            |> MiniMLParsingError
            |> raise

    let equal (x: BigInteger) (y: BigInteger) = x = y
    let notEqual x y = not (equal x y)

    // Aliases for math operators
    let add x y = BigInteger.Add(x, y)
    let subtract x y = BigInteger.Subtract(x, y)
    let modulus x y = BigInteger.Remainder(x, y)
    let multiply x y = BigInteger.Multiply(x, y)

    let pow x (exp: BigInteger) =
        match System.Int32.TryParse(string exp) with
        | true, num -> BigInteger.Pow(x, num)
        | false, _rem ->
            $"Error while trying to raise {x} to power of {exp} - specified exponent is too large"
            |> MiniMLRuntimeError
            |> raise

    let divide x y = BigInteger.Divide(x, y)

open FParsec
open AST
module Parser =
    /// Parser for BigInt label 'I' e.g. "123I", "0I", "-42I"
    let bigIntLabel = pchar 'I'
    
    /// Returns parser which matches passed string,
    /// also consumes 0+ spaces after matched string
    let pWord str = pstring str .>> spaces
    
    /// Requiring that passed parser
    /// be wrapped in parentheses:
    /// '(' + <passedPrs something> + ')'
    let parens passedPrs =
        passedPrs
        |> between (pWord "(") (pWord ")")
    
    /// Parses UnitT literal (Unit Type - repr. void in C#, unit in F#) 
    let unitLiteral: Parser<_, Unit> = pWord "()"
    
    /// Parses Str literal (System.String)
    let strLiteral: Parser<PrimitiveT, Unit> =
        // This line returns a list of chars, which we have to
        // turn into a string before turning into a Str Value
        pchar '\"' >>. manyCharsTill anyChar (pchar '\"')
        |>> string |>> Str
        // Discard the spaces at the end
        .>> spaces
    
    /// Parses Bool literal (System.Boolean)
    let boolLiteral: Parser<PrimitiveT, Unit> =
        (pWord "true" <|> pWord "false")
        |>> function
            | "true" -> Bool true
            | "false" -> Bool false
            | unexpected ->
                "Expected 'true' or 'false' Bool literal; instead got: "
                + unexpected
                |> MiniMLParsingError
                |> raise
    
    /// Parses Int literal (System.Int32)
    let intNum: Parser<NumericT, Unit> = pint32 |>> int |>> Int
    
    /// Parses Float literal (System.Double)
    let floatNum: Parser<NumericT, Unit> = pfloat |>> Float
    
    /// Parses BigInt literal (BigInteger from System.Numerics)
    let bigIntNum: Parser<NumericT, Unit> =
        many1CharsTill (satisfy isDigit) bigIntLabel 
        |>> BigIntegerExt.parse
        |>> BigInt
    
    /// Parses different number literals (e.g. System.Int32, System.Double)
    let numberLiteral: Parser<NumericT, Unit> =
        floatNum <|> bigIntNum <|> intNum 

open Parser
let stringToParse = "12233I  "
// run parser on input
let runP () =
    match run numberLiteral stringToParse with
    | Failure (msg, _, _) as err ->
        failwith $"failure {msg}\n\tError => {err}"
    | Success (result, _, _) -> result

let res = runP ()

res |> printfn "%A"

fparsec-tests.ipynb

{
 "cells": [
  {
   "cell_type": "code",
   "execution_count": 1,
   "id": "70dbbd66-429f-4fa5-b8dc-5617ed497dd7",
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/html": [
       "\r\n",
       "<div>\r\n",
       "    <div id='dotnet-interactive-this-cell-3068.Microsoft.DotNet.Interactive.Http.HttpPort' style='display: none'>\r\n",
       "        The below script needs to be able to find the current output cell; this is an easy method to get it.\r\n",
       "    </div>\r\n",
       "    <script type='text/javascript'>\r\n",
       "async function probeAddresses(probingAddresses) {\r\n",
       "    function timeout(ms, promise) {\r\n",
       "        return new Promise(function (resolve, reject) {\r\n",
       "            setTimeout(function () {\r\n",
       "                reject(new Error('timeout'))\r\n",
       "            }, ms)\r\n",
       "            promise.then(resolve, reject)\r\n",
       "        })\r\n",
       "    }\r\n",
       "\r\n",
       "    if (Array.isArray(probingAddresses)) {\r\n",
       "        for (let i = 0; i < probingAddresses.length; i++) {\r\n",
       "\r\n",
       "            let rootUrl = probingAddresses[i];\r\n",
       "\r\n",
       "            if (!rootUrl.endsWith('/')) {\r\n",
       "                rootUrl = `${rootUrl}/`;\r\n",
       "            }\r\n",
       "\r\n",
       "            try {\r\n",
       "                let response = await timeout(1000, fetch(`${rootUrl}discovery`, {\r\n",
       "                    method: 'POST',\r\n",
       "                    cache: 'no-cache',\r\n",
       "                    mode: 'cors',\r\n",
       "                    timeout: 1000,\r\n",
       "                    headers: {\r\n",
       "                        'Content-Type': 'text/plain'\r\n",
       "                    },\r\n",
       "                    body: probingAddresses[i]\r\n",
       "                }));\r\n",
       "\r\n",
       "                if (response.status == 200) {\r\n",
       "                    return rootUrl;\r\n",
       "                }\r\n",
       "            }\r\n",
       "            catch (e) { }\r\n",
       "        }\r\n",
       "    }\r\n",
       "}\r\n",
       "\r\n",
       "function loadDotnetInteractiveApi() {\r\n",
       "    probeAddresses([\"http://192.168.1.196:1024/\", \"http://127.0.0.1:1024/\"])\r\n",
       "        .then((root) => {\r\n",
       "        // use probing to find host url and api resources\r\n",
       "        // load interactive helpers and language services\r\n",
       "        let dotnetInteractiveRequire = require.config({\r\n",
       "        context: '3068.Microsoft.DotNet.Interactive.Http.HttpPort',\r\n",
       "                paths:\r\n",
       "            {\r\n",
       "                'dotnet-interactive': `${root}resources`\r\n",
       "                }\r\n",
       "        }) || require;\r\n",
       "\r\n",
       "            window.dotnetInteractiveRequire = dotnetInteractiveRequire;\r\n",
       "\r\n",
       "            window.configureRequireFromExtension = function(extensionName, extensionCacheBuster) {\r\n",
       "                let paths = {};\r\n",
       "                paths[extensionName] = `${root}extensions/${extensionName}/resources/`;\r\n",
       "                \r\n",
       "                let internalRequire = require.config({\r\n",
       "                    context: extensionCacheBuster,\r\n",
       "                    paths: paths,\r\n",
       "                    urlArgs: `cacheBuster=${extensionCacheBuster}`\r\n",
       "                    }) || require;\r\n",
       "\r\n",
       "                return internalRequire\r\n",
       "            };\r\n",
       "        \r\n",
       "            dotnetInteractiveRequire([\r\n",
       "                    'dotnet-interactive/dotnet-interactive'\r\n",
       "                ],\r\n",
       "                function (dotnet) {\r\n",
       "                    dotnet.init(window);\r\n",
       "                },\r\n",
       "                function (error) {\r\n",
       "                    console.log(error);\r\n",
       "                }\r\n",
       "            );\r\n",
       "        })\r\n",
       "        .catch(error => {console.log(error);});\r\n",
       "    }\r\n",
       "\r\n",
       "// ensure `require` is available globally\r\n",
       "if ((typeof(require) !==  typeof(Function)) || (typeof(require.config) !== typeof(Function))) {\r\n",
       "    let require_script = document.createElement('script');\r\n",
       "    require_script.setAttribute('src', 'https://cdnjs.cloudflare.com/ajax/libs/require.js/2.3.6/require.min.js');\r\n",
       "    require_script.setAttribute('type', 'text/javascript');\r\n",
       "    \r\n",
       "    \r\n",
       "    require_script.onload = function() {\r\n",
       "        loadDotnetInteractiveApi();\r\n",
       "    };\r\n",
       "\r\n",
       "    document.getElementsByTagName('head')[0].appendChild(require_script);\r\n",
       "}\r\n",
       "else {\r\n",
       "    loadDotnetInteractiveApi();\r\n",
       "}\r\n",
       "\r\n",
       "    </script>\r\n",
       "</div>"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "#r \"nuget: FParsec\" // FParsec 1.1.1"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 2,
   "id": "ef6e87da",
   "metadata": {},
   "outputs": [],
   "source": [
    "open System.Numerics\n",
    "\n",
    "module AST =\n",
    "    type Name = string\n",
    "\n",
    "    type Expr =\n",
    "        | VarCall of Name\n",
    "        | Literal of PrimitiveT // Unit, Bool, Int, ...\n",
    "        | Lambda of string * Expr\n",
    "        | LetFunc of Name * Expr * Expr\n",
    "        | LetRec of Name * Expr * Expr\n",
    "        | Apply of Expr * Expr\n",
    "        | IfElse of Expr * Expr * Expr\n",
    "        | BinaryOp of (Expr * BinOp * Expr)\n",
    "        | UnaryOp of (UnOp * Expr)\n",
    "\n",
    "    and PrimitiveT =\n",
    "        | UnitT\n",
    "        | Str of string\n",
    "        | Bool of bool\n",
    "        | Num of NumericT\n",
    "\n",
    "    and NumericT =\n",
    "        | Int of int // 1\n",
    "        | Float of float // 1.5\n",
    "        | BigInt of BigInteger // 1I\n",
    "\n",
    "    and BinOp =\n",
    "        { Symbol: Name\n",
    "          OpType: PrimitiveT\n",
    "          Args: Expr * Expr }\n",
    "\n",
    "    and UnOp =\n",
    "        { Symbol: Name\n",
    "          OpType: PrimitiveT\n",
    "          Arg: Expr }"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 3,
   "id": "b6ec5062",
   "metadata": {},
   "outputs": [],
   "source": [
    "\n",
    "/// Error should be thrown\n",
    "/// when parsing fails\n",
    "exception MiniMLParsingError of string\n",
    "\n",
    "/// Error should be thrown\n",
    "/// when running of expression or statement fails\n",
    "exception MiniMLRuntimeError of string\n",
    "\n",
    "/// Extends functionality of BigInteger from System.Numerics\n",
    "module BigIntegerExt =\n",
    "    let parse (str: string) =\n",
    "        match BigInteger.TryParse(str) with\n",
    "        | true, parsed -> parsed\n",
    "        | false, rem ->\n",
    "            $\"Error parsing: {str}, expected number literal (BigInt), collected: {rem};\"\n",
    "            |> MiniMLParsingError\n",
    "            |> raise\n",
    "\n",
    "    let equal (x: BigInteger) (y: BigInteger) = x = y\n",
    "    let notEqual x y = not (equal x y)\n",
    "\n",
    "    // Aliases for math operators\n",
    "    let add x y = BigInteger.Add(x, y)\n",
    "    let subtract x y = BigInteger.Subtract(x, y)\n",
    "    let modulus x y = BigInteger.Remainder(x, y)\n",
    "    let multiply x y = BigInteger.Multiply(x, y)\n",
    "\n",
    "    let pow x (exp: BigInteger) =\n",
    "        match System.Int32.TryParse(string exp) with\n",
    "        | true, num -> BigInteger.Pow(x, num)\n",
    "        | false, _rem ->\n",
    "            $\"Error while trying to raise {x} to power of {exp} - specified exponent is too large\"\n",
    "            |> MiniMLRuntimeError\n",
    "            |> raise\n",
    "\n",
    "    let divide x y = BigInteger.Divide(x, y)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 10,
   "id": "fa3b3908",
   "metadata": {},
   "outputs": [],
   "source": [
    "open FParsec\n",
    "open AST\n",
    "module Parser =\n",
    "    /// Parser for BigInt label 'I' e.g. \"123I\", \"0I\", \"-42I\"\n",
    "    let bigIntLabel = pchar 'I'\n",
    "    \n",
    "    /// Returns parser which matches passed string,\n",
    "    /// also consumes 0+ spaces after matched string\n",
    "    let pWord str = pstring str .>> spaces\n",
    "    \n",
    "    /// Requiring that passed parser\n",
    "    /// be wrapped in parentheses:\n",
    "    /// '(' + <passedPrs something> + ')'\n",
    "    let parens passedPrs =\n",
    "        passedPrs\n",
    "        |> between (pWord \"(\") (pWord \")\")\n",
    "    \n",
    "    /// Parses UnitT literal (Unit Type - repr. void in C#, unit in F#) \n",
    "    let unitLiteral: Parser<_, Unit> = pWord \"()\"\n",
    "    \n",
    "    /// Parses Str literal (System.String)\n",
    "    let strLiteral: Parser<PrimitiveT, Unit> =\n",
    "        // This line returns a list of chars, which we have to\n",
    "        // turn into a string before turning into a Str Value\n",
    "        pchar '\\\"' >>. manyCharsTill anyChar (pchar '\\\"')\n",
    "        |>> string |>> Str\n",
    "        // Discard the spaces at the end\n",
    "        .>> spaces\n",
    "    \n",
    "    /// Parses Bool literal (System.Boolean)\n",
    "    let boolLiteral: Parser<PrimitiveT, Unit> =\n",
    "        (pWord \"true\" <|> pWord \"false\")\n",
    "        |>> function\n",
    "            | \"true\" -> Bool true\n",
    "            | \"false\" -> Bool false\n",
    "            | unexpected ->\n",
    "                \"Expected 'true' or 'false' Bool literal; instead got: \"\n",
    "                + unexpected\n",
    "                |> MiniMLParsingError\n",
    "                |> raise\n",
    "    \n",
    "    /// Parses Int literal (System.Int32)\n",
    "    let intNum: Parser<NumericT, Unit> = pint32 |>> int |>> Int\n",
    "    \n",
    "    /// Parses Float literal (System.Double)\n",
    "    let floatNum: Parser<NumericT, Unit> = pfloat |>> Float\n",
    "    \n",
    "    /// Parses BigInt literal (BigInteger from System.Numerics)\n",
    "    let bigIntNum: Parser<NumericT, Unit> =\n",
    "        many1CharsTill (satisfy isDigit) bigIntLabel \n",
    "        |>> BigIntegerExt.parse\n",
    "        |>> BigInt\n",
    "    \n",
    "    /// Parses different number literals (e.g. System.Int32, System.Double)\n",
    "    let numberLiteral: Parser<NumericT, Unit> =\n",
    "        floatNum <|> intNum <|> bigIntNum  \n",
    "\n",
    "    // let literal: Parser<NumericT, Unit> = \n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 18,
   "id": "648d274e",
   "metadata": {},
   "outputs": [
    {
     "name": "stdout",
     "output_type": "stream",
     "text": [
      "Float 12233.0\n"
     ]
    }
   ],
   "source": [
    "open Parser\n",
    "let stringToParse = \"12233I\"\n",
    "// run parser on input\n",
    "let runP () =\n",
    "    match run numberLiteral stringToParse with\n",
    "    | Failure (msg, _, _) as err ->\n",
    "        failwith $\"failure {msg}\\n\\tError => {err}\"\n",
    "    | Success (result, _, _) -> result\n",
    "\n",
    "let res = runP ()\n",
    "\n",
    "res |> printfn \"%A\"\n",
    "// res.GetType().Name|> printfn \"%A\"\n"
   ]
  }
 ],
 "metadata": {
  "kernelspec": {
   "display_name": ".NET (F#)",
   "language": "F#",
   "name": ".net-fsharp"
  },
  "language_info": {
   "file_extension": ".fs",
   "mimetype": "text/x-fsharp",
   "name": "F#",
   "pygments_lexer": "fsharp",
   "version": "5.0"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 5
}