egison 3.7.9 → 3.7.10

raw patch · 16 files changed

+468/−23 lines, 16 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• egison.cabal +2/−1
• hs-src/Interpreter/egison.hs +23/−9
• hs-src/Language/Egison.hs +5/−0
• hs-src/Language/Egison/Core.hs +12/−0
• hs-src/Language/Egison/Desugar.hs +8/−0
• hs-src/Language/Egison/MathOutput.hs +278/−0
• hs-src/Language/Egison/Parser.hs +1/−0
• hs-src/Language/Egison/Primitives.hs +1/−1
• hs-src/Language/Egison/Types.hs +12/−0
• lib/core/base.egi +1/−1
• lib/math/analysis/derivative.egi +1/−1
• lib/math/normalize.egi +32/−0
• sample/math/geometry/chern-form-of-CP1.egi +22/−0
• sample/math/geometry/chern-form-of-CP2.egi +33/−0
• sample/math/geometry/k143.egi +27/−0
• sample/math/geometry/riemann-curvature-tensor-of-S2.egi +10/−10

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.7.9+Version:             3.7.10 Synopsis:            Programming language with non-linear pattern-matching against non-free data Description:   An interpreter for Egison, a **pattern-matching-oriented**, purely functional programming language.@@ -78,6 +78,7 @@                    Language.Egison.Parser                    Language.Egison.Primitives                    Language.Egison.Util+                   Language.Egison.MathOutput   Other-modules:   Paths_egison   ghc-options:  -O3 

@@ -20,6 +20,7 @@  import Language.Egison import Language.Egison.Util+import Language.Egison.MathOutput  main :: IO () main = do args <- getArgs@@ -28,7 +29,7 @@           case opts of             Options {optShowHelp = True} -> printHelp             Options {optShowVersion = True} -> printVersionNumber-            Options {optEvalString = mExpr, optExecuteString = mCmd, optSubstituteString = mSub, optFieldInfo = fieldInfo, optLoadLibs = loadLibs, optLoadFiles = loadFiles, optPrompt = prompt, optShowBanner = bannerFlag, optTsvOutput = tsvFlag, optNoIO = noIOFlag} -> do+            Options {optEvalString = mExpr, optExecuteString = mCmd, optSubstituteString = mSub, optFieldInfo = fieldInfo, optLoadLibs = loadLibs, optLoadFiles = loadFiles, optPrompt = prompt, optShowBanner = bannerFlag, optTsvOutput = tsvFlag, optNoIO = noIOFlag, optMathExpr = mathExprLang} -> do               coreEnv <- if noIOFlag then initialEnvNoIO else initialEnv               mEnv <- evalEgisonTopExprs coreEnv $ (map Load loadLibs) ++ (map LoadFile loadFiles)               case mEnv of@@ -60,7 +61,7 @@                             Nothing ->                               case nonOpts of                                 [] -> do-                                  when bannerFlag showBanner >> repl noIOFlag env prompt >> when bannerFlag showByebyeMessage >> exitWith ExitSuccess+                                  when bannerFlag showBanner >> repl noIOFlag mathExprLang env prompt >> when bannerFlag showByebyeMessage >> exitWith ExitSuccess                                 (file:args) -> do                                   case opts of                                     Options {optTestOnly = True} -> do@@ -86,7 +87,8 @@     optNoIO :: Bool,     optShowBanner :: Bool,     optTestOnly :: Bool,-    optPrompt :: String+    optPrompt :: String,+    optMathExpr :: Maybe String     }  defaultOptions :: Options@@ -103,7 +105,8 @@     optNoIO = False,     optShowBanner = True,     optTestOnly = False,-    optPrompt = "> "+    optPrompt = "> ",+    optMathExpr = Nothing     }  options :: [OptDescr (Options -> Options)]@@ -161,7 +164,11 @@   Option ['F'] ["--field"]     (ReqArg (\d opts -> opts {optFieldInfo = optFieldInfo opts ++ [(readFieldOption d)]})             "String")-    "field information"+    "field information",+  Option ['M'] ["math"]+    (ReqArg (\lang opts -> opts {optMathExpr = Just lang})+            "String")+    "output in LaTeX format"   ]  readFieldOption :: String -> (String, String)@@ -227,8 +234,8 @@ showByebyeMessage :: IO () showByebyeMessage = putStrLn $ "Leaving Egison Interpreter." -repl :: Bool -> Env -> String -> IO ()-repl noIOFlag env prompt = do+repl :: Bool -> (Maybe String) -> Env -> String -> IO ()+repl noIOFlag mathExprLang env prompt = do   loop env  where   settings :: MonadIO m => FilePath -> Settings m@@ -247,12 +254,19 @@         putStrLn "error: No IO support"         loop env       (_, Just (topExpr, _)) -> do-        result <- liftIO $ runEgisonTopExpr env topExpr+        result <- liftIO $ runEgisonTopExpr' env topExpr         case result of           Left err -> do             liftIO $ putStrLn $ show err             loop env-          Right env' -> loop env')+          Right (Nothing, env') -> loop env'+          Right (Just output, env') ->+            case mathExprLang of+              Nothing -> putStrLn output >> loop env'+              (Just "haskell") -> putStrLn (mathExprToHaskell output) >> loop env'+              (Just "asciimath") -> putStrLn (mathExprToAsciiMath output) >> loop env'+              (Just "latex") -> putStrLn (mathExprToLatex output) >> loop env'+             )     `catch`     (\e -> case e of              UserInterrupt -> putStrLn "" >> loop env

@@ -17,6 +17,7 @@        , evalEgisonTopExprsTestOnly        , runEgisonExpr        , runEgisonTopExpr+       , runEgisonTopExpr'        , runEgisonTopExprs        , runEgisonTopExprsNoIO        -- * Load Egison files@@ -64,6 +65,10 @@ -- |eval an Egison top expression. Input is a Haskell string. runEgisonTopExpr :: Env -> String -> IO (Either EgisonError Env) runEgisonTopExpr env input = fromEgisonM $ readTopExpr input >>= evalTopExpr env++-- |eval an Egison top expression. Input is a Haskell string.+runEgisonTopExpr' :: Env -> String -> IO (Either EgisonError (Maybe String, Env))+runEgisonTopExpr' env input = fromEgisonM $ readTopExpr input >>= evalTopExpr' env  -- |eval Egison top expressions. Input is a Haskell string. runEgisonTopExprs :: Env -> String -> IO (Either EgisonError Env)

@@ -15,6 +15,7 @@     , evalTopExprsTestOnly     , evalTopExprsNoIO     , evalTopExpr+    , evalTopExpr'     , evalExpr     , evalExprDeep     , evalRef@@ -416,6 +417,17 @@       return (Intermediate (ITensor t'))     (Value (TensorData t)) -> do       t' <- tTranspose' syms t+      return (Value (TensorData t'))+    _ -> return whnf++evalExpr env (FlipIndicesExpr expr) = do+  whnf <- evalExpr env expr+  case whnf of+    (Intermediate (ITensor t)) -> do+      t' <- tFlipIndices t+      return (Intermediate (ITensor t'))+    (Value (TensorData t)) -> do+      t' <- tFlipIndices t       return (Value (TensorData t'))     _ -> return whnf 

@@ -187,10 +187,14 @@ desugar (LambdaExpr names expr) = do   let (rtnames, rhnames) = span (\name -> case name of                                             TensorArg _ -> True+                                            InvertedScalarArg _ -> False                                             ScalarArg _ -> False) (reverse names)   case rhnames of     [] -> do expr' <- desugar expr              return $ LambdaExpr names expr'+    (InvertedScalarArg rhname:rhnames') -> do+      desugar $ LambdaExpr (reverse rhnames' ++ [TensorArg rhname] ++ reverse rtnames)+                  (TensorMapExpr (LambdaExpr [TensorArg rhname] expr) (FlipIndicesExpr (VarExpr rhname)))     (ScalarArg rhname:rhnames') -> do       let (rtnames2, rhnames2) = span (\name -> case name of                                                 TensorArg _ -> True@@ -313,6 +317,10 @@   vars' <- desugar vars   expr' <- desugar expr   return $ TransposeExpr vars' expr'++desugar (FlipIndicesExpr expr) = do+  expr' <- desugar expr+  return $ FlipIndicesExpr expr'  desugar (ParExpr expr1 expr2) = do   expr1' <- desugar expr1

@@ -0,0 +1,278 @@+{- |+Module      : Language.Egison.MathOutput+Copyright   : Satoshi Egi+Licence     : MIT++This module provides utility functions.+-}++module Language.Egison.MathOutput (mathExprToHaskell, mathExprToAsciiMath, mathExprToLatex) where++import Control.Monad+import System.Environment+import Text.ParserCombinators.Parsec hiding (spaces)++mathExprToHaskell :: String -> String+mathExprToHaskell input = case parse parseExpr "math-expr" input of+                            Left err -> input+                            Right val -> "#haskell\"" ++ show val ++ "\""++mathExprToAsciiMath :: String -> String+mathExprToAsciiMath input = case parse parseExpr "math-expr" input of+                              Left err -> input+                              Right val -> "#asciimath\"" ++ showMathExprAsciiMath val ++ "\""++mathExprToLatex :: String -> String+mathExprToLatex input = case parse parseExpr "math-expr" input of+                          Left err -> input+                          Right val -> "#latex|" ++ showMathExprLatex val ++ "|#"++data MathExpr = Atom String+              | NegativeAtom String+              | Plus [MathExpr]+              | Multiply [MathExpr]+              | Power MathExpr MathExpr+              | Func MathExpr [MathExpr]+              | Tensor [MathExpr] [MathIndex]+              | Tuple [MathExpr]+              | Collection [MathExpr]+              | Exp MathExpr+              | Quote MathExpr+              | Partial String [String]+              deriving (Eq, Show)++data MathIndex = Super MathExpr+              | Sub MathExpr+              deriving (Eq, Show)++--+-- Show (AsciiMath)+--++showMathIndexAsciiMath :: MathIndex -> String+showMathIndexAsciiMath (Super a) = showMathExprAsciiMath a+showMathIndexAsciiMath (Sub a) = showMathExprAsciiMath a++showMathExprAsciiMath :: MathExpr -> String+showMathExprAsciiMath (Atom func) = func+showMathExprAsciiMath (NegativeAtom func) = "-" ++ func+showMathExprAsciiMath (Plus []) = ""+showMathExprAsciiMath (Plus (x:xs)) = showMathExprAsciiMath x ++ showMathExprAsciiMathForPlus xs+ where+  showMathExprAsciiMathForPlus :: [MathExpr] -> String+  showMathExprAsciiMathForPlus [] = ""+  showMathExprAsciiMathForPlus ((NegativeAtom a):xs) = " - " ++ a ++ showMathExprAsciiMathForPlus xs+  showMathExprAsciiMathForPlus ((Multiply (NegativeAtom a:ys)):xs) = " - " ++ showMathExprAsciiMath (Multiply ((Atom a):ys)) ++ " " ++ showMathExprAsciiMathForPlus xs+  showMathExprAsciiMathForPlus (x:xs) = showMathExprAsciiMath x ++ " + " ++ showMathExprAsciiMathForPlus xs+showMathExprAsciiMath (Multiply []) = ""+showMathExprAsciiMath (Multiply [a]) = showMathExprAsciiMath a+showMathExprAsciiMath (Multiply (NegativeAtom "1":lvs)) = "-" ++ showMathExprAsciiMath (Multiply lvs)+showMathExprAsciiMath (Multiply lvs) = showMathExprAsciiMath' (head lvs) ++ " " ++ showMathExprAsciiMath (Multiply (tail lvs))+showMathExprAsciiMath (Power lv1 lv2) = showMathExprAsciiMath lv1 ++ "^" ++ showMathExprAsciiMath lv2+showMathExprAsciiMath (Func f lvs) = case f of+                                       Atom "/" -> if length lvs == 2 then "frac{" ++ showMathExprAsciiMath (head lvs) ++ "}{" ++ showMathExprAsciiMath (lvs !! 1) ++ "}"+                                                                        else showMathExprAsciiMath f ++ "(" ++ showMathExprAsciiMathArg lvs ++ ")"+                                       _ -> showMathExprAsciiMath f ++ "(" ++ showMathExprAsciiMathArg lvs ++ ")"+showMathExprAsciiMath (Tensor lvs mis)+  | null mis = "(" ++ showMathExprAsciiMathArg lvs ++ ")"+  | not (any isSub mis) = "(" ++ showMathExprAsciiMathArg lvs ++ ")^(" ++ showMathExprAsciiMathIndices mis ++ ")"+  | not (any (not . isSub) mis) = "(" ++ showMathExprAsciiMathArg lvs ++ ")_(" ++ showMathExprAsciiMathIndices mis ++ ")"+  | otherwise = "(" ++ showMathExprAsciiMathArg lvs ++ ")_(" ++ showMathExprAsciiMathIndices (filter isSub mis) ++ ")^(" ++ showMathExprAsciiMathIndices (filter (not . isSub) mis) ++ ")"+showMathExprAsciiMath (Tuple lvs) = "(" ++ showMathExprAsciiMathArg lvs ++ ")"+showMathExprAsciiMath (Collection lvs) = "{" ++ showMathExprAsciiMathArg lvs ++ "}"+showMathExprAsciiMath (Exp x) = "e^(" ++ showMathExprAsciiMath x ++ ")"++isSub :: MathIndex -> Bool+isSub x = case x of+            Sub _ -> True+            _ -> False++showMathExprAsciiMath' :: MathExpr -> String+showMathExprAsciiMath' (Plus lvs) = "(" ++ showMathExprAsciiMath (Plus lvs) ++ ")"+showMathExprAsciiMath' val = showMathExprAsciiMath val++showMathExprAsciiMathArg :: [MathExpr] -> String+showMathExprAsciiMathArg [] = ""+showMathExprAsciiMathArg [a] = showMathExprAsciiMath a+showMathExprAsciiMathArg lvs = showMathExprAsciiMath (head lvs) ++ ", " ++ (showMathExprAsciiMathArg (tail lvs))++showMathExprAsciiMathIndices :: [MathIndex] -> String+showMathExprAsciiMathIndices [a] = showMathIndexAsciiMath a+showMathExprAsciiMathIndices lvs = showMathIndexAsciiMath (head lvs) ++ showMathExprAsciiMathIndices (tail lvs)++--+-- Show (Latex)+--++showMathExprLatex :: MathExpr -> String+showMathExprLatex (Atom a) = a+showMathExprLatex (Partial a is) = a ++ "_{" ++ concat is ++ "}"+showMathExprLatex (NegativeAtom a) = "-" ++ a+showMathExprLatex (Plus []) = ""+showMathExprLatex (Plus (x:xs)) = showMathExprLatex x ++ showMathExprLatexForPlus xs+ where+  showMathExprLatexForPlus :: [MathExpr] -> String+  showMathExprLatexForPlus [] = ""+  showMathExprLatexForPlus ((NegativeAtom a):xs) = " - " ++ a ++ showMathExprLatexForPlus xs+  showMathExprLatexForPlus ((Multiply (NegativeAtom a:ys)):xs) = " - " ++ showMathExprLatex (Multiply ((Atom a):ys)) ++ showMathExprLatexForPlus xs+  showMathExprLatexForPlus (x:xs) = " + " ++  showMathExprLatex x ++ showMathExprLatexForPlus xs+showMathExprLatex (Multiply []) = ""+showMathExprLatex (Multiply [x]) = showMathExprLatex x+showMathExprLatex (Multiply (Atom "1":xs)) = showMathExprLatex (Multiply xs)+showMathExprLatex (Multiply (NegativeAtom "1":xs)) = "-" ++ showMathExprLatex (Multiply xs)+showMathExprLatex (Multiply (x:xs)) = showMathExprLatex' x ++ " " ++ showMathExprLatex (Multiply xs)+showMathExprLatex (Power lv1 lv2) = showMathExprLatex lv1 ++ "^" ++ showMathExprLatex lv2+showMathExprLatex (Func (Atom "sqrt") [x]) = "\\sqrt{" ++ showMathExprLatex x ++ "}"+showMathExprLatex (Func (Atom "rt") [x, y]) = "\\sqrt[" ++ showMathExprLatex x ++ "]{" ++ showMathExprLatex y ++ "}"+showMathExprLatex (Func (Atom "/") [x, y]) = "\\frac{" ++ showMathExprLatex x ++ "}{" ++ showMathExprLatex y ++ "}"+showMathExprLatex (Func f xs) = showMathExprLatex f ++ "(" ++ showMathExprLatexArg xs ", " ++ ")"+showMathExprLatex (Tensor xs mis) = case head xs of+                                       Tensor _ _ -> "\\begin{pmatrix} " ++ showMathExprLatexVectors xs ++ "\\end{pmatrix}" ++ showMathExprLatexScript mis+                                       _ -> "\\begin{pmatrix} " ++ showMathExprLatexVectors xs ++ "\\end{pmatrix}" ++ showMathExprLatexScript mis+showMathExprLatex (Tuple xs) = "(" ++ showMathExprLatexArg xs ", " ++ ")"+showMathExprLatex (Collection xs) = "\\{" ++ showMathExprLatexArg xs ", " ++ "\\}"+showMathExprLatex (Exp x) = "e^{" ++ showMathExprLatex x ++ "}"+showMathExprLatex (Quote x) = "(" ++ showMathExprLatex x ++ ")"++showMathExprLatex' :: MathExpr -> String+showMathExprLatex' (Plus xs) = "(" ++ showMathExprLatex (Plus xs) ++ ")"+showMathExprLatex' x = showMathExprLatex x++showMathExprLatexArg :: [MathExpr] -> String -> String+showMathExprLatexArg [] _ = ""+showMathExprLatexArg [a] _ = showMathExprLatex a+showMathExprLatexArg lvs s = showMathExprLatex (head lvs) ++ s ++ showMathExprLatexArg  (tail lvs) s++showMathExprLatexSuper :: MathIndex -> String+showMathExprLatexSuper (Super (Atom "#")) = "\\#"+showMathExprLatexSuper (Super x) = showMathExprLatex x+showMathExprLatexSuper (Sub x) = "\\;"++showMathExprLatexSub :: MathIndex -> String+showMathExprLatexSub (Sub (Atom "#")) = "\\#"+showMathExprLatexSub (Sub x) = showMathExprLatex x+showMathExprLatexSub (Super x) = "\\;"++showMathExprLatexScript :: [MathIndex] -> String+showMathExprLatexScript [] = ""+showMathExprLatexScript is = "_{" ++ concat (map showMathExprLatexSub is) ++ "}^{" ++ concat (map showMathExprLatexSuper is) ++ "}"++showMathExprLatexVectors :: [MathExpr] -> String+showMathExprLatexVectors [] = ""+showMathExprLatexVectors (Tensor lvs []:r) = showMathExprLatexArg lvs " & " ++ " \\\\ " ++ showMathExprLatexVectors r+showMathExprLatexVectors lvs = showMathExprLatexArg lvs " \\\\ " ++ "\\\\ "++--+-- Parser+--++spaces :: Parser ()+spaces = skipMany1 space++spaces0 :: Parser ()+spaces0 = skipMany space++symbol :: Parser Char+symbol = oneOf "!$%&*+-/:<=>?@#"++parseAtom :: Parser MathExpr+parseAtom = do +    first <- letter <|> symbol <|> digit+    rest <- many (letter <|> digit <|> symbol)+    let atom = first : rest+    option (Atom atom) $ do is <- many1 (char '|' >> many digit)+                            return $ Partial atom is+  +parseNegativeAtom :: Parser MathExpr+parseNegativeAtom = do+    char '-'+    first <- letter <|> symbol <|> digit+    rest <- many (letter <|> digit <|> symbol)+    let atom = first : rest+    return $ NegativeAtom atom++parseList :: Parser [MathExpr]+parseList = sepEndBy parseExpr spaces++parseScript :: Parser MathIndex+parseScript = (Sub <$> (char '_' >> parseExpr)) <|> (Super <$> (char '~' >> parseExpr))++parsePlus :: Parser MathExpr+parsePlus = do+    string "(+"+    spaces+    xs <- parseList+    char ')'+    return $ Plus xs++parseMultiply :: Parser MathExpr+parseMultiply = do+    string "(*"+    spaces+    xs <- parseList+    char ')'+    return $ Multiply xs++parseFunction :: Parser MathExpr+parseFunction = do+    char '('+    func <- parseAtom+    spaces+    xs <- parseList+    char ')'+    return $ Func func xs++parseTensor :: Parser MathExpr+parseTensor = do+    string "[|"+    spaces0+    xs <- parseList+    spaces0+    string "|]"+    ys <- many  parseScript+    return $ Tensor xs ys++parseTuple :: Parser MathExpr+parseTuple = do+    char '['+    xs <- parseList+    char ']'+    return $ Tuple xs++parseCollection :: Parser MathExpr+parseCollection = do+    char '{'+    xs <- parseList+    char '}'+    return $ Collection xs++parseExp :: Parser MathExpr+parseExp = do+    string "(exp"+    spaces+    x <- parseExpr+    char ')'+    return $ Exp x++parseQuote :: Parser MathExpr+parseQuote = do+    char '\''+    x <- parseExpr'+    return $ Quote x++parseExpr' :: Parser MathExpr+parseExpr' = parseNegativeAtom+         <|> parseAtom+         <|> parseQuote+         <|> try parseExp+         <|> try parsePlus+         <|> try parseMultiply+         <|> try parseFunction+         <|> try parseTensor+         <|> try parseTuple+         <|> try parseCollection++parseExpr :: Parser MathExpr+parseExpr = do+    x <- parseExpr'+    option x $ Power x <$> try (char '^' >> parseExpr')

@@ -474,6 +474,7 @@  argName :: Parser Arg argName = try (char '$' >> ident >>= return . ScalarArg)+      <|> try (string "*$" >> ident >>= return . InvertedScalarArg)       <|> try (char '%' >> ident >>= return . TensorArg)  ioExpr :: Parser EgisonExpr

@@ -427,7 +427,7 @@   numberUnaryOp' (ScalarData (Div (Plus []) _)) = return $ toEgison (0 :: Integer)   numberUnaryOp' (ScalarData (Div (Plus [(Term x [])]) (Plus [(Term y [])]))) = return $ toEgison (quot x y)   numberUnaryOp' (Float x _)           = return $ toEgison ((truncate x) :: Integer)-  numberUnaryOp' val                   = throwError $ TypeMismatch "ratinal or float" (Value val)+  numberUnaryOp' val                   = throwError $ TypeMismatch "rational or float" (Value val)  realPart :: PrimitiveFunc realPart =  oneArg $ realPart'

@@ -46,6 +46,7 @@     , enumTensorIndices     , tTranspose     , tTranspose'+    , tFlipIndices     , appendDFscripts     , removeDFscripts     , tMap@@ -273,6 +274,7 @@   | TensorMapExpr EgisonExpr EgisonExpr   | TensorMap2Expr EgisonExpr EgisonExpr EgisonExpr   | TransposeExpr EgisonExpr EgisonExpr+  | FlipIndicesExpr EgisonExpr    | SomethingExpr   | UndefinedExpr@@ -280,6 +282,7 @@  data Arg =     ScalarArg String+  | InvertedScalarArg String   | TensorArg String  deriving (Eq) @@ -851,6 +854,14 @@                   (Just j') -> do js' <- g is js                                   return $ j':js' +tFlipIndices :: HasTensor a => (Tensor a) -> EgisonM (Tensor a)+tFlipIndices (Tensor ns xs js) = do+  return $ Tensor ns xs (map flipIndex js)+ where+  flipIndex (Subscript i) = Superscript i+  flipIndex (Superscript i) = Subscript i+  flipIndex x = x+ appendDFscripts :: Integer -> WHNFData -> EgisonM WHNFData appendDFscripts id (Intermediate (ITensor (Tensor s xs is))) = do   let k = fromIntegral ((length s) - (length is))@@ -1186,6 +1197,7 @@  instance Show Arg where   show (ScalarArg name) = "$" ++ name+  show (InvertedScalarArg name) = "*$" ++ name   show (TensorArg name) = "%" ++ name  instance Show ScalarData where

@@ -38,7 +38,7 @@     (lambda $x       (foldl 2#(%2 %1) x fs)))) -(define $flip (lambda [$fn] (lambda [$x $y] (fn y x))))+(define $flip (lambda [$fn] (lambda [%x %y] (fn y x))))  (define $ref   (lambda [%xa $is]

@@ -5,7 +5,7 @@ ;;;;;  (define $∂/∂-  (lambda [$f $x]+  (lambda [$f *$x]     (match f math-expr       {; symbol        [,x 1]

@@ -17,6 +17,8 @@    [rewrite-rule-for-i 1#(contain-symbol? i %1)]    [rewrite-rule-for-w-term 1#(contain-symbol? w %1)]    [rewrite-rule-for-rtu-term 1#(contain-function? rtu %1)]+   [rewrite-rule-for-exp-term 1#(contain-function? exp %1)]+   [rewrite-rule-for-**-term 1#(contain-function? ** %1)]    [rewrite-rule-for-w-poly 1#(contain-symbol? w %1)]    [rewrite-rule-for-rtu-poly 1#(contain-function? rtu %1)]    [rewrite-rule-for-sqrt 1#(contain-function? sqrt %1)]@@ -135,6 +137,36 @@     (match term math-expr       {[(* $a (,rt $n $x)^(& ?(gte? $ n) $k) $r)         (*' a (**' x (quotient k n)) (**' (rt n x) (remainder k n)) r)]+       [_ term]})))++;;+;; exp+;;++(define $rewrite-rule-for-exp (map-terms rewrite-rule-for-exp-term $))++(define $rewrite-rule-for-exp-term+  (lambda [$term]+    (match term math-expr+      {[(* $a (,exp $x)^(& ?(gte? $ 2) $n) $r)+        (rewrite-rule-for-exp (*' a (exp (* x n)) r))]+       [(* $a (,exp $x) (,exp $y) $r)+        (rewrite-rule-for-exp (*' a (exp (+ x y)) r))]+       [_ term]})))++;;+;; exp+;;++(define $rewrite-rule-for-** (map-terms rewrite-rule-for-**-term $))++(define $rewrite-rule-for-**-term+  (lambda [$term]+    (match term math-expr+      {[(* $a (,** $x $y)^(& ?(gte? $ 2) $n) $r)+        (rewrite-rule-for-** (*' a (** x (* y n)) r))]+       [(* $a (,** $x $y) (,** ,x $z) $r)+        (rewrite-rule-for-** (*' a (** x (+ y z)) r))]        [_ term]})))  ;;

@@ -0,0 +1,22 @@+(define $params [| r θ |])++(define $u (* r (** e (* 2 π i θ))))+(define $ū (* r (** e (* -2 π i θ))))++(define $d+  (lambda [%X]+    !((flip ∂/∂) params X)))++(define $ω (/ (* ū (d u))+              (+ 1 (* u ū))))+ω;[| (/ r (+ 1 r^2)) (/ (* 2 r^2 π i) (+ 1 r^2)) |]++(define $Ω (df-normalize (d ω)))+Ω;[| [| 0 (/ (* 2 r π i) (+ 1 (* 2 r^2) r^4)) |] [| (/ (* -2 r π i) (+ 1 (* 2 r^2) r^4)) 0 |] |]++(define $c1 (/ Ω (* -2 π i)))+c1;[| [| 0 (/ r (+ -1 (* -2 r^2) (* -1 r^4))) |] [| (/ (* -1 r) (+ -1 (* -2 r^2) (* -1 r^4))) 0 |] |]++; ∫ dθ dr (/ (* -2 r) (+ 1 (* 2 r^2) r^4)) = ∫ dθ dr (/ (* -2 r) (+ 1 r^2)^2)+; = ∫ dr (/ (* -2 r) (+ 1 r^2)^2) = [ (/ 1 (+ 1 r^2)) ] 0-∞ = (- 0 1)+; = -1

@@ -0,0 +1,33 @@+(define $params [| z1 z2 z1' z2' |])+(define $params' [| z1 z2 # # |])+(define $params'' [| # # z1' z2' |])++(define $d+  (lambda [%X]+    !((flip ∂/∂) params X)))++(define $d'+  (lambda [%X]+    !((flip ∂/∂) params' X)))++(define $d''+  (lambda [%X]+    !((flip ∂/∂) params'' X)))++(define $h (+ 1 (* z1 z1') (* z2 z2')))++(define $ω (d' (log h)))+ω;[| (/ z1' (+ 1 (* z1 z1') (* z2 z2'))) (/ z2' (+ 1 (* z1 z1') (* z2 z2'))) 0 0 |]++(define $Ω (d'' ω))+Ω+;[|[| 0 0 0 0 |]+;  [| 0 0 0 0 |]+;  [| (/ (+ 1 (* z2 z2')) (+ 1 (* 2 z1 z1') (* 2 z2 z2') (* z1^2 z1'^2) (* 2 z1 z1' z2 z2') (* z2^2 z2'^2))) (/ (* -1 z1 z2') (+ 1 (* 2 z1 z1') (* 2 z2 z2') (* z1^2 z1'^2) (* 2 z1 z1' z2 z2') (* z2^2 z2'^2))) 0 0 |]+;  [| (/ (* -1 z2 z1') (+ 1 (* 2 z1 z1') (* 2 z2 z2') (* z1^2 z1'^2) (* 2 z1 z1' z2 z2') (* z2^2 z2'^2))) (/ (+ 1 (* z1 z1')) (+ 1 (* 2 z1 z1') (* 2 z2 z2') (* z1^2 z1'^2) (* 2 z1 z1' z2 z2') (* z2^2 z2'^2))) 0 0 |]|]++;(define $c1 (/ Ω (* -2 π i)))+;c1;[| [| 0 (/ r (+ -1 (* -2 r^2) (* -1 r^4))) |] [| (/ (* -1 r) (+ -1 (* -2 r^2) (* -1 r^4))) 0 |] |]+++

@@ -0,0 +1,27 @@+(define $params [| r θ |])++(define $d+  (lambda [%X]+    !((flip ∂/∂) params X)))++(define $wedge+  (lambda [%X %Y]+    !(. X Y)))++(define $u+  (lambda [$r $θ]+    (* r (** e (* 2 π i θ)))))++(define $ū+  (lambda [$r $θ]+    (* r (** e (* -2 π i θ)))))++(d (u r θ))+;[| (exp (* 2 π θ i)) (* 2 r (exp (* 2 π θ i)) π i) |]++(d (ū r θ))+;;[| (exp (* -2 π θ i)) (* -2 r (exp (* -2 π θ i)) π i) |]++(df-normalize (wedge (d (u r θ))+                     (d (ū r θ))))+;[| [| 0 (* -2 r π i) |] [| (* 2 r π i) 0 |] |]

@@ -13,17 +13,17 @@ ;; Local basis ;; -(define $e ((flip ∂/∂) x~# X_#))-e+(define $e_i_j (∂/∂ X_j x_i))+e_i_j ;[|[|(* r (cos θ) (cos φ)) (* r (cos θ) (sin φ)) (* -1 r (sin θ)) |] ;  [|(* -1 r (sin θ) (sin φ)) (* r (sin θ) (cos φ)) 0 |]-;  |]_#~#+;  |]_#_#  ;; ;; Metric tensor ;; -(define $g__ (generate-tensor 2#(V.* e_%1 e_%2) {2 2}))+(define $g__ (generate-tensor 2#(V.* e_%1_# e_%2_#) {2 2})) (define $g~~ (M.inverse g_#_#))  g_#_#;[| [| r^2 0 |] [| 0 (* r^2 (sin θ)^2) |] |]_#_#@@ -35,9 +35,9 @@  (define $Γ_j_k_l   (* (/ 1 2)-     (+ (∂/∂ g_j_l x_k)-        (∂/∂ g_j_k x_l)-        (* -1 (∂/∂ g_k_l x_j)))))+     (+ (∂/∂ g_j_l x~k)+        (∂/∂ g_j_k x~l)+        (* -1 (∂/∂ g_k_l x~j)))))  Γ_#_#_#;(tensor {2 2 2} {0 0 0 (* -1 r^2 (sin θ) (cos θ)) 0 (* r^2 (sin θ) (cos θ)) (* r^2 (sin θ) (cos θ)) 0} )_#_#_# Γ_1_#_#;[| [| 0 0 |] [| 0 (* -1 r^2 (sin θ) (cos θ)) |] |]_#_#@@ -58,7 +58,7 @@ ;; (define $∇g___   (with-symbols {i j m n}-    (- (∂/∂ g_i_j x_m)+    (- (∂/∂ g_i_j x~m)        (. Γ~n_m_i g_n_j)        (. Γ~n_m_j g_i_n)))) @@ -70,7 +70,7 @@  (define $R~i_j_k_l   (with-symbols {m}-    (+ (- (∂/∂ Γ~i_j_l x_k) (∂/∂ Γ~i_j_k x_l))+    (+ (- (∂/∂ Γ~i_j_l x~k) (∂/∂ Γ~i_j_k x~l))        (- (. Γ~m_j_l Γ~i_m_k) (. Γ~m_j_k Γ~i_m_l)))))  R~#_#_#_#;(tensor {2 2 2 2} {0 0 0 0 0 (sin θ)^2 (* -1 (sin θ)^2) 0 0 -1 1 0 0 0 0 0} )~#_#_#_#@@ -109,7 +109,7 @@  (define $∇R_____   (with-symbols {i j k l m n}-    (- (∂/∂ R_i_j_k_l x_m)+    (- (∂/∂ R_i_j_k_l x~m)        (. Γ~n_m_i R_n_j_k_l)        (. Γ~n_m_j R_i_n_k_l)        (. Γ~n_m_k R_i_j_n_l)