implement parser for userscript

Author: kotapiku

hs-src/Language/Egison/Core.hs

@@ -277,6 +277,7 @@ evalExpr env (IndexedExpr bool expr indices) = do
                       Superscript n -> evalExprDeep env n >>= return . Superscript
                       Subscript n -> evalExprDeep env n >>= return . Subscript
                       SupSubscript n -> evalExprDeep env n >>= return . SupSubscript
+                      Userscript n -> evalExprDeep env n >>= return . Userscript
               ) indices
 
   ret <- case tensor of
@@ -285,6 +286,7 @@ evalExpr env (IndexedExpr bool expr indices) = do
                              Superscript n -> evalExprDeep env n >>= extractScalar >>= return . Superscript
                              Subscript n -> evalExprDeep env n >>= extractScalar >>= return . Subscript
                              SupSubscript n -> evalExprDeep env n >>= extractScalar >>= return . SupSubscript
+                             Userscript n -> evalExprDeep env n >>= extractScalar >>= return . Userscript
                     ) indices
         return $ Value (ScalarData (Div (Plus [(Term 1 [(Symbol id name js2, 1)])]) (Plus [(Term 1 [])])))
       (Value (ScalarData _)) -> do
@@ -300,11 +302,13 @@ evalExpr env (IndexedExpr bool expr indices) = do
                              Superscript n -> evalExprDeep env n >>= extractScalar >>= return . Superscript
                              Subscript n -> evalExprDeep env n >>= extractScalar >>= return . Subscript
                              SupSubscript n -> evalExprDeep env n >>= extractScalar >>= return . SupSubscript
+                             Userscript n -> evalExprDeep env n >>= extractScalar >>= return . Userscript
                     ) indices
         refArray tensor (map (\j -> case j of
                                       Superscript k -> ScalarData k
                                       Subscript k -> ScalarData k
                                       SupSubscript k -> ScalarData k
+                                      Userscript k -> ScalarData k
                               ) js2)
   let ret2 = case expr of
                (VarExpr var) -> do
@@ -321,6 +325,7 @@ evalExpr env (IndexedExpr bool expr indices) = do
   f (Superscript _) = Superscript ()
   f (Subscript _) = Subscript ()
   f (SupSubscript _) = SupSubscript ()
+  f (Userscript _) = Userscript ()
 
 evalExpr env (SubrefsExpr bool expr jsExpr) = do
   js <- evalExpr env jsExpr >>= collectionToList >>= return . (map Subscript)
@@ -347,6 +352,7 @@ evalExpr env (SubrefsExpr bool expr jsExpr) = do
   f (Superscript _) = Superscript ()
   f (Subscript _) = Subscript ()
   f (SupSubscript _) = SupSubscript ()
+  f (Userscript _) = Userscript ()
 
 evalExpr env (SuprefsExpr bool expr jsExpr) = do
   js <- evalExpr env jsExpr >>= collectionToList >>= return . (map Superscript)
@@ -373,6 +379,7 @@ evalExpr env (SuprefsExpr bool expr jsExpr) = do
   f (Superscript _) = Superscript ()
   f (Subscript _) = Subscript ()
   f (SupSubscript _) = SupSubscript ()
+  f (Userscript _) = Userscript ()
 
 evalExpr env (UserrefsExpr bool expr jsExpr) = do
   val <- evalExprDeep env expr
@@ -494,6 +501,9 @@ evalExpr env (WithSymbolsExpr vars expr) = do
   isTmpSymbol symId (SupSubscript (ScalarData (Div (Plus [Term 1 [(Symbol id name is,n)]]) (Plus [Term 1 []]))))
     | symId == id = True
     | otherwise = False
+  isTmpSymbol symId (Userscript (ScalarData (Div (Plus [Term 1 [(Symbol id name is,n)]]) (Plus [Term 1 []]))))
+    | symId == id = True
+    | otherwise = False
   removeTmpscripts :: String -> WHNFData -> EgisonM WHNFData
   removeTmpscripts symId (Intermediate (ITensor (Tensor s xs is))) = do
     let (ds, js) = partition (isTmpSymbol symId) is

hs-src/Language/Egison/Desugar.hs

@@ -425,6 +425,7 @@ desugarIndex :: Index EgisonExpr -> DesugarM (Index EgisonExpr)
 desugarIndex (Superscript expr) = desugar expr >>= return . Superscript
 desugarIndex (Subscript expr) = desugar expr >>= return . Subscript
 desugarIndex (SupSubscript expr) = desugar expr >>= return . SupSubscript
+desugarIndex (Userscript expr) = desugar expr >>= return . Userscript
 
 desugarPattern :: EgisonPattern -> DesugarM EgisonPattern
 desugarPattern pattern = LetPat (map makeBinding $ S.elems $ collectName pattern) <$> desugarPattern' pattern 

hs-src/Language/Egison/Parser.hs

@@ -191,7 +191,8 @@ expr = P.lexeme lexer (do expr0 <- expr' <|> quoteExpr'
                                                            return $ MultiSuperscript e1 e2)
                                                  <|> try (char '_' >> expr' >>= return . Subscript)
                                                  <|> try (char '~' >> expr' >>= return . Superscript)
-                                                 <|> try (string "~_" >> expr' >>= return . SupSubscript))
+                                                 <|> try (string "~_" >> expr' >>= return . SupSubscript)
+                                                 <|> try (char '|' >> expr' >>= return . Userscript))
 
 
 quoteExpr' :: Parser EgisonExpr
@@ -847,7 +848,6 @@ reservedOperators =
   , "_"
   , "^"
   , "&"
-  , "|"
   , "|*"
 --  , "'"
 --  , "~"
@@ -987,17 +987,17 @@ identVar = P.lexeme lexer (do
   is <- many indexType
   return $ Var (splitOn "." name) is)
 
+identVarWithoutIndex :: Parser Var
+identVarWithoutIndex = do
+    x <- ident
+    return $ stringToVar x
+
 identVarWithIndices :: Parser VarWithIndices
 identVarWithIndices = P.lexeme lexer (do
   name <- ident
   is <- many indexForVar
   return $ VarWithIndices (splitOn "." name) is)
 
-identVarWithoutIndex :: Parser Var
-identVarWithoutIndex = do
-    x <- ident
-    return $ stringToVar x
-
 indexForVar :: Parser (Index String)
 indexForVar = try (char '~' >> Superscript <$> ident)
         <|> try (char '_' >> Subscript <$> ident)

test/lib/math/tensor.egi

@@ -79,9 +79,6 @@
                     (match-lambda [integer integer]
                       {[[$n ,n] (function [x y z])]
                        [[_ _] 0]})
-                    {3 3})]
-           [$g [| [| g_1_1 0 0 |]
-                  [| 0 g_2_2 0 |]
-                  [| 0 0 g_3_3 |] |]]}
-     (show (d/d g x)))
+                    {3 3})]}
+     (show (with-symbols {i j} (d/d g_i_j x))))
   "[| [| g_1_1|x 0 0 |] [| 0 g_2_2|x 0 |] [| 0 0 g_3_3|x |] |]")