cstml · cstml · May 20, 2022
diff --git a/examples/1-add-two-numbers.sp b/examples/1-add-two-numbers.sp
@@ -7,4 +7,4 @@
 +;       -- add    -> stack: 6
 <x>;     -- bind x -> stack: *
          --        -> x : 6
-@Ou[x];  -- push to output x ~> 6
+[x]@O;  -- push to output x ~> 6
diff --git a/examples/3-read-two-numbers-and-add.sp b/examples/3-read-two-numbers-and-add.sp
@@ -1,7 +1,7 @@
-@In<y>;  -- read y
+<y>@I;  -- read y
 y;       -- evaluate it
-@In<y>;  -- read y
+<y>@I;  -- read y
 y;       -- evaluate
 +;       -- do the sum 
 <x>;     -- bind the result
-@Ou[x];  -- push to output
+[x]@O;  -- push to output
diff --git a/examples/4-compare-2-terms.sp b/examples/4-compare-2-terms.sp
@@ -1,7 +1,7 @@
-@In<y>;  -- read y
+<y>@I;  -- read y
 y;       -- evaluate it
-@In<y>;  -- read y
+<y>@I;  -- read y
 y;       -- evaluate
 ==;      -- compare
 <x>;     -- bind the result
-@Ou[x];  -- push to output
+[x]@O;  -- push to output
diff --git a/examples/6-fibo.sp b/examples/6-fibo.sp
@@ -7,10 +7,10 @@
 [10];<y>;
 -- y := 10
 
-[@Ou[x]; x; <i> ; x; xx ; +; !; <x>; i ; !; <xx>;];<a>;
+[[x]@O; x; <i> ; x; xx ; +; !; <x>; i ; !; <xx>;];<a>;
 -- a := print x . i = x . x = xx + x . xx = i . evaluate z 
 
-[@Ou[x]];<b>;
+[[x]@O];<b>;
 -- b := print x
 
 [ [a;z];

diff --git a/src/Space/Evaluator/Implementation.hs b/src/Space/Evaluator/Implementation.hs
@@ -58,15 +58,15 @@ evaluate = \case
           SInteger _ _ -> pushGamma x >> evaluate con
           SChar _ _ -> pushGamma x >> evaluate con
           SPop v l _ -> case l of
-            Location "In" -> do
+            Location "I" -> do
               i <- input
               case parseTerm i of
                 Left e -> error $ show e
                 Right t -> bind1 v t
               evaluate con
             _ -> (bind1 v =<< pop1 l) >> evaluate con
           SPush t l _ -> case l of
-            Location "Ou" -> do
+            Location "O" -> do
               case t of
                 -- if it is a variable, then get its bound value;
                 SVariable v SEmpty -> do

diff --git a/src/Space/Language/Term.hs b/src/Space/Language/Term.hs
@@ -47,22 +47,22 @@ instance Pretty Term where
               SEmpty -> brackets (pretty t)
               _ -> brackets (pretty t) <++> pretty con
             _ -> case con of
-              SEmpty -> pretty l <> brackets (pretty t)
-              _ -> pretty l <> brackets (pretty t) <++> pretty con
+              SEmpty -> brackets (pretty t) <> pretty l
+              _ -> brackets (pretty t) <> pretty l <++> pretty con
           SPop v l con -> case l of
             DLocation -> case con of
               SEmpty -> angles (pretty v)
               _ -> angles (pretty v) <++> pretty con
             _ -> case con of
-              SEmpty -> pretty l <> angles (pretty v)
-              _ -> pretty l <> angles (pretty v) <++> pretty con
+              SEmpty -> angles (pretty v) <> pretty l
+              _ -> angles (pretty v) <> pretty l <++> pretty con
           SPopT v l ty con -> case l of
             DLocation -> case con of
               SEmpty -> angles (pretty v <> colon <> pretty ty)
               _ -> angles (pretty v <> colon <> pretty ty) <++> pretty con
             _ -> case con of
-              SEmpty -> pretty l <> angles (pretty v <> colon <> pretty ty)
-              _ -> pretty l <> angles (pretty v <> colon <> pretty ty) <++> pretty con
+              SEmpty -> angles (pretty v <> colon <> pretty ty) <> pretty l
+              _ -> angles (pretty v <> colon <> pretty ty) <> pretty l <++> pretty con
           SEmpty -> pretty "{}"
 
 instance Semigroup Term where

diff --git a/src/Space/Parser/Term.hs b/src/Space/Parser/Term.hs
@@ -113,13 +113,13 @@ pPushDef :: Parser (Term -> Term)
 pPushDef = (`SPush` DLocation) <$> P.between (lex_ $ P.char '[') (lex_ $ P.char ']') pTerm
 
 pPush :: Parser (Term -> Term)
-pPush = flip SPush <$> pLocation <*> P.between (lex_ $ P.char '[') (lex_ $ P.char ']') pTerm
+pPush = SPush <$> P.between (lex_ $ P.char '[') (lex_ $ P.char ']') pTerm <*> pLocation
 
 pPopDef :: Parser (Term -> Term)
 pPopDef = flip SPop DLocation <$> P.between (lex_ $ P.char '<') (lex_ $ P.char '>') pVar
 
 pPop :: Parser (Term -> Term)
-pPop = flip SPop <$> pLocation <*> P.between (lex_ $ P.char '<') (lex_ $ P.char '>') pVar
+pPop = SPop <$> P.between (lex_ $ P.char '<') (lex_ $ P.char '>') pVar <*> pLocation
 
 pSeparator :: Parser ()
 pSeparator = lex_ . void $ P.choice $ P.try <$> [P.char ';']

diff --git a/test/Test/Space/Evaluator/Machine.hs b/test/Test/Space/Evaluator/Machine.hs
@@ -24,7 +24,7 @@ test1 =
           "Working Push Int 3s."
           ( ok
               ( mempty @MachineMemory
-                  & stacks .~ M.fromList [(home, mempty & stack .~ S.fromList [int 3, int 3])]
+                  & spine .~ mconcat [int 3, int 3]
               )
           )
           (evaluate' . mconcat $ [int 3, int 3])
@@ -35,7 +35,7 @@ test1 =
           "Working Push Chars."
           ( ok
               ( mempty @MachineMemory
-                  & stacks .~ M.fromList [(home, mempty & stack .~ S.fromList [char, char])]
+                  & spine .~ mconcat [char, char]
               )
           )
           (evaluate' . mconcat $ [char, char])
@@ -54,7 +54,7 @@ test1 =
                   & binds . at (var "x") ?~ char
               )
           )
-          (evaluate' . mconcat $ [char, popX])
+          (evaluate' . mconcat $ [SPush char DLocation SEmpty, popX])
 
         assertEqual
           "Working Pop 1 term and put it back."
@@ -64,7 +64,13 @@ test1 =
                   & stacks . at home ?~ review stack (S.fromList [char])
               )
           )
-          (evaluate' . mconcat $ [char, popX, varX])
+          ( evaluate' . mconcat $
+              [ SPush char DLocation SEmpty
+              , popX
+              , varX
+              , SVariable (Variable "!") SEmpty
+              ]
+          )
 
         assertEqual
           "Pop 1 term and bind it to another variable."
@@ -75,7 +81,16 @@ test1 =
                   & stacks . at home ?~ review stack (S.fromList [char])
               )
           )
-          (evaluate' . mconcat $ [char, popX, varX, popY, varY])
+          ( evaluate' . mconcat $
+              [ SPush char DLocation SEmpty
+              , popX
+              , varX
+              , SVariable (Variable "!") SEmpty
+              , popY
+              , varY
+              , SVariable (Variable "!") SEmpty
+              ]
+          )
 
         assertEqual
           "Pop 1 term from stack of 2."
@@ -85,7 +100,12 @@ test1 =
                   & stacks . at home ?~ review stack (S.fromList [char])
               )
           )
-          (evaluate' . mconcat $ [char, char, popX])
+          ( evaluate' . mconcat $
+              [ SPush char DLocation SEmpty
+              , SPush char DLocation SEmpty
+              , popX
+              ]
+          )
 
         assertEqual
           "Working Pop 1 term from stack of 0."
@@ -104,7 +124,7 @@ test1 =
                   & stacks .~ M.fromList [(home, mempty & stack .~ S.fromList [int 6])]
               )
           )
-          (evaluate' . mconcat $ [int 3, int 3, op "+"])
+          (evaluate' . mconcat $ [int 3, int 3, op "+", SVariable (Variable "!") SEmpty])
 
         assertEqual
           "Division."
@@ -113,7 +133,7 @@ test1 =
                   & stacks .~ M.fromList [(home, mempty & stack .~ S.fromList [int 1])]
               )
           )
-          (evaluate' . mconcat $ [int 3, int 3, op "/"])
+          (evaluate' . mconcat $ [int 3, int 3, op "/", SVariable (Variable "!") SEmpty])
 
         assertEqual
           "Comparison True."
@@ -122,7 +142,7 @@ test1 =
                   & stacks .~ M.fromList [(home, mempty & stack .~ S.fromList [int 1])]
               )
           )
-          (evaluate' . mconcat $ [int 3, int 3, op "=="])
+          (evaluate' . mconcat $ [int 3, int 3, op "==", SVariable (Variable "!") SEmpty])
 
         assertEqual
           "Comparison False."
@@ -131,7 +151,7 @@ test1 =
                   & stacks .~ M.fromList [(home, mempty & stack .~ S.fromList [int 0])]
               )
           )
-          (evaluate' . mconcat $ [int 3, int 2, op "=="])
+          (evaluate' . mconcat $ [int 3, int 2, op "==", SVariable (Variable "!") SEmpty])
 
         assertEqual
           "Inequality True."
@@ -140,7 +160,7 @@ test1 =
                   & stacks .~ M.fromList [(home, mempty & stack .~ S.fromList [int 0])]
               )
           )
-          (evaluate' . mconcat $ [int 3, int 3, op "/="])
+          (evaluate' . mconcat $ [int 3, int 3, op "/=", SVariable (Variable "!") SEmpty])
 
         assertEqual
           "Inequality False."
@@ -149,7 +169,7 @@ test1 =
                   & stacks .~ M.fromList [(home, mempty & stack .~ S.fromList [int 1])]
               )
           )
-          (evaluate' . mconcat $ [int 3, int 2, op "/="])
+          (evaluate' . mconcat $ [int 3, int 2, op "/=", SVariable (Variable "!") SEmpty])
 
         assertEqual
           "Working error."
@@ -160,7 +180,7 @@ test1 =
           "Self evaluation"
           ( ok
               ( mempty @MachineMemory
-                  & stacks .~ M.fromList [(home, mempty & stack .~ S.fromList [varT "x"])]
+                  & spine .~ varT "x"
               )
           )
           (evaluate' . mconcat $ [varT "x"])
@@ -179,10 +199,8 @@ test1 =
           "Self evaluation 3"
           ( ok
               ( Memory
-                  { _spine = SEmpty
-                  , _stacks =
-                      M.fromList
-                        [(DLocation, Stack {_stack = S.fromList [SVariable (Variable "x") SEmpty]})]
+                  { _spine = SVariable (Variable "x") SEmpty
+                  , _stacks = mempty
                   , _binds = M.fromList [(Variable "y", SVariable (Variable "x") SEmpty)]
                   }
               )

diff --git a/test/Test/Space/Language.hs b/test/Test/Space/Language.hs
@@ -28,7 +28,7 @@ test =
     "Language Unit Tests."
     [ testGroup
         "Pretty Show Terms."
-        [ testCase "Empty." $ sPretty SEmpty @?= "*"
+        [ testCase "Empty." $ sPretty SEmpty @?= "{}"
         , testCase "Variable." $ sPretty (SVariable "x" SEmpty) @?= "x"
         , testCase "Integer." $ sPretty (SInteger 3 SEmpty) @?= "3"
         , testCase "Char." $ sPretty (SChar 's' SEmpty) @?= "'s'"

diff --git a/test/Test/Space/Parser.hs b/test/Test/Space/Parser.hs
@@ -24,7 +24,7 @@ tParseTerm = P.parse pTerm "Test Input" . fromString
 
 unit =
   let stdTest r1 t1 r2 t2 = do
-        let str = r1 <> ";*"
+        let str = r1 <> ";{}"
         assertEqual str (Right $ t1 SEmpty) (tParseTerm str)
 
         let str = r1
@@ -33,25 +33,25 @@ unit =
         let str = r1 <> ";"
         assertEqual str (Right $ t1 SEmpty) (tParseTerm str)
 
-        let str = r1 <> "    ;    *"
+        let str = r1 <> "    ;    {}"
         assertEqual str (Right $ t1 SEmpty) (tParseTerm str)
 
-        let str = r1 <> " ; " <> r2 <> " ; *"
+        let str = r1 <> " ; " <> r2 <> " ; {}"
         assertEqual str (Right $ t1 $ t2 SEmpty) (tParseTerm str)
 
         let str = r1 <> " ; " <> r2 <> ";"
         assertEqual str (Right $ t1 $ t2 SEmpty) (tParseTerm str)
 
-        let str = r1 <> " {-; " <> r2 <> " -}; *"
+        let str = r1 <> " {-; " <> r2 <> " -}; {}"
         assertEqual str (Right $ t1 SEmpty) (tParseTerm str)
    in testGroup
         "Parser Unit Tests"
-        [ testCase "Parse empty Term" $ assertEqual "*" (Right SEmpty) (tParseTerm "*")
+        [ testCase "Parse empty Term" $ let t = "{}" in assertEqual t (Right SEmpty) (tParseTerm t)
         , testCase "Parse Push empty." $
-            let p = "[*];*"
+            let p = "[{}];{}"
              in assertEqual p (Right $ SPush SEmpty DLocation SEmpty) (tParseTerm p)
         , testCase "Parse Push Variable." $
-            let p = "[x;*];*"
+            let p = "[x;{}];{}"
              in assertEqual p (Right $ SPush (SVariable (Variable "x") SEmpty) DLocation SEmpty) (tParseTerm p)
         , testCase "Parse Push Variable." $
             stdTest
@@ -62,23 +62,23 @@ unit =
         , testCase "Parse Char." $ stdTest "'x'" (SChar 'x') "'y'" (SChar 'y')
         , testCase "Parse Int." $ stdTest "1" (SInteger 1) "20" (SInteger 20)
         , let t x = SPush (SVariable (Variable x) SEmpty) DLocation
-           in testCase "Parse Push Default Location." $ stdTest "[ x ; * ]" (t "x") "[y;*]" (t "y")
+           in testCase "Parse Push Default Location." $ stdTest "[ x ; {} ]" (t "x") "[y;{}]" (t "y")
         , let t x = SPush (SVariable (Variable x) SEmpty) DLocation
            in testCase "Parse Push Default Location." $ stdTest "[ x ]" (t "x") "[ y ]" (t "y")
         , let t x = SPush (SVariable (Variable x) SEmpty) DLocation
-           in testCase "Parse Push Default Locataion." $ stdTest "[ x;* ]" (t "x") "[y;*]" (t "y")
+           in testCase "Parse Push Default Locataion." $ stdTest "[ x;{} ]" (t "x") "[y;{}]" (t "y")
         , let t x = SPush (SVariable (Variable x) SEmpty) DLocation
-           in testCase "Parse Push Default Locataion." $ stdTest "[x;*]" (t "x") "[ y;*   ]" (t "y")
+           in testCase "Parse Push Default Locataion." $ stdTest "[x;{}]" (t "x") "[ y;{}   ]" (t "y")
         , let t x = SPush (SInteger x SEmpty) DLocation
-           in testCase "Parse Push Default Locataion." $ stdTest "[1;*]" (t 1) "[ 2;*   ]" (t 2)
+           in testCase "Parse Push Default Locataion." $ stdTest "[1;{}]" (t 1) "[ 2;{}   ]" (t 2)
         , let t x l = SPush (SVariable (Variable x) SEmpty) (Location l)
-           in testCase "Parse Push arbitrary." $ stdTest "@In[ x ; * ]" (t "x" "In") "@Ou[y;*]" (t "y" "Ou")
+           in testCase "Parse Push arbitrary." $ stdTest "[ x ; {} ]@In" (t "x" "In") "[y;{}]@Ou" (t "y" "Ou")
         , let t x l = SPush (SVariable (Variable x) SEmpty) (Location l)
-           in testCase "Parse Push arbitrary." $ stdTest "@In[ x;* ]" (t "x" "In") "@Ou[y;*]" (t "y" "Ou")
+           in testCase "Parse Push arbitrary." $ stdTest "[ x;{} ]@In" (t "x" "In") "[y;{}]@Ou" (t "y" "Ou")
         , let t x = SPop (Variable x) DLocation
            in testCase "Parse Pop Ho." $ stdTest "<x>" (t "x") "<y>" (t "y")
         , let t x l = SPop (Variable x) (Location l)
-           in testCase "Parse Pop arbitrary." $ stdTest "@In<x>" (t "x" "In") "@Yo<y>" (t "y" "Yo")
+           in testCase "Parse Pop arbitrary." $ stdTest "<x>@In" (t "x" "In") "<y>@Yo" (t "y" "Yo")
         , testCase "Parse Equal (Variable)." $
             stdTest "==" (SVariable (Variable "==")) "/=" (SVariable (Variable "/="))
         ]