shen-ruby 0.12.1 → 0.13.0

data/shen/release/test_programs/proof_assistant.shen

@@ -1,81 +1,81 @@
-(synonyms
-
-    proof  (list step)
-    step ((list sequent) * tactic)
-    tactic ((list sequent) --> (list sequent))
-    sequent ((list wff) * wff))
-
-(datatype globals
-
-   _______________________
-   (value *proof*) : proof;)
-
-(define proof-assistant
-   {A --> symbol}
-    _ -> (let Assumptions (input-assumptions 1) 
-              Conclusion (input-conclusion _)
-              Sequents [(@p Assumptions Conclusion)]
-              Proof (time (proof-loop Sequents []))
-              (do (nl) proved)))
-
-(define input-assumptions
-   {number --> (list wff)}
-     N -> (let More? (y-or-n? "~%Input assumptions? ")
-                   (if More? 
-                       (do (output "~%~A. " N)
-                           [(input+ wff) | (input-assumptions (+ N 1))])
-                       [ ])))
-
-(define input-conclusion
-    {A --> wff}
-     _ -> (do (output "~%Enter conclusion: ") (input+ wff)))
-                                 
-(define proof-loop
-    {(list sequent) --> proof --> proof}
-     [ ] Proof -> (set *proof* (reverse Proof))       
-     S Proof -> (let Show (show-sequent S (+ 1 (length Proof)))
-                     D (user-directive _) 
-                     Step (@p S D)
-                     (if (= D back)
-                         (proof-loop (go-back Proof) (tail Proof))
-                         (proof-loop (D S) [Step | Proof]))))
-
-(define show-proof
-  {string --> symbol}
-   S -> (show-proof-help (value *proof*) 1))
-
-(define show-proof-help
-   {proof --> number --> symbol}
-    [ ] _ -> proved
-    [(@p Sequents Tactic) | Proof] N -> (do (show-sequent Sequents N) 
-                                            (output "~%Tactic: ~A~%" Tactic)
-                                            (show-proof-help Proof (+ N 1))))  
-
-(define show-sequent
-   {(list sequent) --> number --> symbol}
-     Sequents N -> (let Unsolved (length Sequents)
-                        Sequent (head Sequents)
-                        Wffs (fst Sequent)
-                        Wff (snd Sequent)
-                        (do (output "==============================~%")
-                            (output "Step ~A     	unsolved ~A~%~%" 
-                                           N Unsolved)
-                            (output "?- ~S~%~%" Wff)
-                            (enumerate Wffs 1))))
-
-(define enumerate
-    {(list A) --> number --> symbol}
-     [] _ -> _
-     [X | Y] N -> (do (output "~A. ~S~%" N X) (enumerate Y (+ N 1))))
-
-(define user-directive
-    {A --> tactic}
-     _ -> (do (output "~%Tactic: ") (input+ tactic)))
-
-(define back
-   {(list sequent) --> (list sequent)}
-     S -> S)
-
-(define go-back
-   {proof --> (list sequent)}
+(synonyms
+
+    proof  (list step)
+    step ((list sequent) * tactic)
+    tactic ((list sequent) --> (list sequent))
+    sequent ((list wff) * wff))
+
+(datatype globals
+
+   _______________________
+   (value *proof*) : proof;)
+
+(define proof-assistant
+   {A --> symbol}
+    _ -> (let Assumptions (input-assumptions 1) 
+              Conclusion (input-conclusion _)
+              Sequents [(@p Assumptions Conclusion)]
+              Proof (time (proof-loop Sequents []))
+              (do (nl) proved)))
+
+(define input-assumptions
+   {number --> (list wff)}
+     N -> (let More? (y-or-n? "~%Input assumptions? ")
+                   (if More? 
+                       (do (output "~%~A. " N)
+                           [(input+ wff) | (input-assumptions (+ N 1))])
+                       [ ])))
+
+(define input-conclusion
+    {A --> wff}
+     _ -> (do (output "~%Enter conclusion: ") (input+ wff)))
+                                 
+(define proof-loop
+    {(list sequent) --> proof --> proof}
+     [ ] Proof -> (set *proof* (reverse Proof))       
+     S Proof -> (let Show (show-sequent S (+ 1 (length Proof)))
+                     D (user-directive _) 
+                     Step (@p S D)
+                     (if (= D back)
+                         (proof-loop (go-back Proof) (tail Proof))
+                         (proof-loop (D S) [Step | Proof]))))
+
+(define show-proof
+  {string --> symbol}
+   S -> (show-proof-help (value *proof*) 1))
+
+(define show-proof-help
+   {proof --> number --> symbol}
+    [ ] _ -> proved
+    [(@p Sequents Tactic) | Proof] N -> (do (show-sequent Sequents N) 
+                                            (output "~%Tactic: ~A~%" Tactic)
+                                            (show-proof-help Proof (+ N 1))))  
+
+(define show-sequent
+   {(list sequent) --> number --> symbol}
+     Sequents N -> (let Unsolved (length Sequents)
+                        Sequent (head Sequents)
+                        Wffs (fst Sequent)
+                        Wff (snd Sequent)
+                        (do (output "==============================~%")
+                            (output "Step ~A     	unsolved ~A~%~%" 
+                                           N Unsolved)
+                            (output "?- ~S~%~%" Wff)
+                            (enumerate Wffs 1))))
+
+(define enumerate
+    {(list A) --> number --> symbol}
+     [] _ -> _
+     [X | Y] N -> (do (output "~A. ~S~%" N X) (enumerate Y (+ N 1))))
+
+(define user-directive
+    {A --> tactic}
+     _ -> (do (output "~%Tactic: ") (input+ tactic)))
+
+(define back
+   {(list sequent) --> (list sequent)}
+     S -> S)
+
+(define go-back
+   {proof --> (list sequent)}
     [(@p S _) | _] -> S)

data/shen/release/test_programs/proplog_version_1.shen

@@ -1,25 +1,25 @@
-(define backchain  
-   Conc Assumptions -> (backchain* [Conc] Assumptions Assumptions))
-
-(define backchain* 
-   [] _ _ -> proved 
-   [[P & Q] | Goals] _ Assumptions 
-   -> (backchain* [P Q | Goals] Assumptions Assumptions) 
-   [P | Goals] [[P <= | Subgoal] | _] Assumptions  
-   <- (backchain* (append Subgoal Goals) Assumptions Assumptions)  
-   Goals [_ | Rest] Assumptions -> (backchain* Goals Rest Assumptions)  
-   _ _ _ -> (fail)) 
-
-
-
-
-
-
-
-
-
-
-
-
- 
-
+(define backchain  
+   Conc Assumptions -> (backchain* [Conc] Assumptions Assumptions))
+
+(define backchain* 
+   [] _ _ -> proved 
+   [[P & Q] | Goals] _ Assumptions 
+   -> (backchain* [P Q | Goals] Assumptions Assumptions) 
+   [P | Goals] [[P <= | Subgoal] | _] Assumptions  
+   <- (backchain* (append Subgoal Goals) Assumptions Assumptions)  
+   Goals [_ | Rest] Assumptions -> (backchain* Goals Rest Assumptions)  
+   _ _ _ -> (fail)) 
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+

data/shen/release/test_programs/proplog_version_2.shen

@@ -1,27 +1,27 @@
-(define backchain  
-   Conc Assumptions -> (backchain* Conc Assumptions Assumptions))
-
-(define backchain*
-   P [P | _] _ -> true
-   [P & Q] _ Assumptions
-   -> (and (backchain* P Assumptions Assumptions)
-           (backchain* Q Assumptions Assumptions))
-   P [[P <= Q] | _] Assumptions
-   <- (fail-if (/. X (= X false)) (backchain* Q Assumptions Assumptions))
-   P [_ | Rest] Assumptions -> (backchain* P Rest Assumptions)
-   _ _ _ -> false)
-
-
-
-
-
-
-
-
-
-
-
-
-
- 
-
+(define backchain  
+   Conc Assumptions -> (backchain* Conc Assumptions Assumptions))
+
+(define backchain*
+   P [P | _] _ -> true
+   [P & Q] _ Assumptions
+   -> (and (backchain* P Assumptions Assumptions)
+           (backchain* Q Assumptions Assumptions))
+   P [[P <= Q] | _] Assumptions
+   <- (fail-if (/. X (= X false)) (backchain* Q Assumptions Assumptions))
+   P [_ | Rest] Assumptions -> (backchain* P Rest Assumptions)
+   _ _ _ -> false)
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+

data/shen/release/test_programs/qmachine.shen

@@ -1,67 +1,67 @@
-(datatype progression
-
-	X : A; S : (A --> A); E : (A --> boolean);
-	==========================================
-	[X S E] : (progression A);)
-
-(define force
- {(progression A) --> A}
-  [X S E] -> X)
-
-(define delay
-  {(progression A) --> (progression A)}
-    [X S E] -> [(S X) S E])
- 
-(define end?
-  {(progression A) --> boolean}
-   [X S E] -> (E X)) 
-
-(define push
-  {A --> (progression A) --> (progression A)}
-  X [Y S E] -> [X (/. Z (if (= Z X) Y (S Z))) E]) 
-
-(define forall
-  {(progression A) --> (A --> boolean) --> boolean}
-   [X S E] P -> (if (E X) true (and (P X) (forall [(S X) S E] P))))
-
-(define exists
-  {(progression A) --> (A --> boolean) --> boolean}
-  [X S E] P -> (if (E X) false (or (P X) (exists [(S X) S E] P))))
-
-(define super
-  {(progression A) --> (A --> B) --> (B --> C --> C) --> C --> C}
-   [X S E] P F Y -> (if (E X) Y (F (P X) (super [(S X) S E] P F Y))))
-
-(define forall
-  {(progression A) --> (A --> boolean) --> boolean}
-   Progression P -> (super Progression P (function and) true)) 
-
-(define exists
-  {(progression A) --> (A --> boolean) --> boolean}
-   Progression P -> (super Progression P (function or) false)) 
-
-(define for
-  {(progression A) --> (A --> B) --> number}
-   Progression P -> (super Progression P (function progn) 0))
-
-(define progn
-  {A --> B --> B}
-   X Y -> Y)
-
-(define filter
-  {(progression A) --> (A --> boolean) --> (list A)}
-  Progression P -> (super Progression (/. X (if (P X) [X] [])) append []))
-
-(define next-prime
-  {number --> number}
-  N -> (if (prime? (+ N 1)) (+ N 1) (next-prime (+ N 1))))
-
-(define prime?
-  {number --> boolean}
-  X -> (prime-help X (/ X 2) 2))
-
-(define prime-help
-  {number --> number --> number --> boolean}
-   X Max Div -> false 		where (integer? (/ X Div))
-   X Max Div -> true 		where (> Div Max)
+(datatype progression
+
+	X : A; S : (A --> A); E : (A --> boolean);
+	==========================================
+	[X S E] : (progression A);)
+
+(define force
+ {(progression A) --> A}
+  [X S E] -> X)
+
+(define delay
+  {(progression A) --> (progression A)}
+    [X S E] -> [(S X) S E])
+ 
+(define end?
+  {(progression A) --> boolean}
+   [X S E] -> (E X)) 
+
+(define push
+  {A --> (progression A) --> (progression A)}
+  X [Y S E] -> [X (/. Z (if (= Z X) Y (S Z))) E]) 
+
+(define forall
+  {(progression A) --> (A --> boolean) --> boolean}
+   [X S E] P -> (if (E X) true (and (P X) (forall [(S X) S E] P))))
+
+(define exists
+  {(progression A) --> (A --> boolean) --> boolean}
+  [X S E] P -> (if (E X) false (or (P X) (exists [(S X) S E] P))))
+
+(define super
+  {(progression A) --> (A --> B) --> (B --> C --> C) --> C --> C}
+   [X S E] P F Y -> (if (E X) Y (F (P X) (super [(S X) S E] P F Y))))
+
+(define forall
+  {(progression A) --> (A --> boolean) --> boolean}
+   Progression P -> (super Progression P (function and) true)) 
+
+(define exists
+  {(progression A) --> (A --> boolean) --> boolean}
+   Progression P -> (super Progression P (function or) false)) 
+
+(define for
+  {(progression A) --> (A --> B) --> number}
+   Progression P -> (super Progression P (function progn) 0))
+
+(define progn
+  {A --> B --> B}
+   X Y -> Y)
+
+(define filter
+  {(progression A) --> (A --> boolean) --> (list A)}
+  Progression P -> (super Progression (/. X (if (P X) [X] [])) append []))
+
+(define next-prime
+  {number --> number}
+  N -> (if (prime? (+ N 1)) (+ N 1) (next-prime (+ N 1))))
+
+(define prime?
+  {number --> boolean}
+  X -> (prime-help X (/ X 2) 2))
+
+(define prime-help
+  {number --> number --> number --> boolean}
+   X Max Div -> false 		where (integer? (/ X Div))
+   X Max Div -> true 		where (> Div Max)
    X Max Div -> (prime-help X Max (+ 1 Div)))

data/shen/release/test_programs/red-black.shen

@@ -1,55 +1,55 @@
-\**\ \* Copyright (c) 2011, Justin Grant <justin at imagine27 dot com> *\ \* All rights reserved. *\ \**\ \* Redistribution and use in source and binary forms, with or without modification,  *\ \* are permitted provided that the following conditions are met: *\ \**\ \* Redistributions of source code must retain the above copyright notice, this list  *\ \* of conditions and the following disclaimer. *\ \* Redistributions in binary form must reproduce the above copyright notice, this  *\ \* list of conditions and the following disclaimer in the documentation and/or  *\ \* other materials provided with the distribution. *\ \* Neither the name of the <ORGANIZATION> nor the names of its contributors may be  *\ \* used to endorse or promote products derived from this software without specific  *\ \* prior written permission. *\ \**\ \* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND  *\ \* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED *\ \* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE  *\ \* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR  *\ \* ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES  *\ \* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; *\ \* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  *\ \* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING  *\ \* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,  *\ \* EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *\ \**\  (datatype tree-node
-
-    Key : number; Val : B;
-    ======================
-    [Key Val] : tree-node;)
-
-(datatype color
-
-    if (element? Color [red black])
-    _______________________________
-    Color : color;)
-
-(datatype tree
-
-    if (empty? Tree)
-    ________________
-    Tree : tree;
-
-    Color : color; LTree : tree; TreeNode : tree-node; RTree : tree;
-    ================================================================
-    [Color LTree TreeNode RTree] : tree;)
-
-(define node-key
-    {tree-node --> number}
-    [Key Val] -> Key)
-
-(define make-tree-black
-    {tree --> tree}
-    [Color A X B] -> [black A X B])
-
-(define member
-    {tree-node --> tree --> boolean}
-    X [] -> false
-    X [Color A Y B] -> (cases (< (node-key X) (node-key Y)) (member X A)
-                              (< (node-key Y) (node-key X))  (member X B)
-                              true true))
-
-(define balance
-    {tree --> tree}
-    [black [red [red A X B] Y C] Z D] -> [red [black A X B] Y [black C Z D]]
-    [black [red A X [red B Y C]] Z D] -> [red [black A X B] Y [black C Z D]]
-    [black A X [red [red B Y C] Z D]] -> [red [black A X B] Y [black C Z D]]
-    [black A X [red B Y [red C Z D]]] -> [red [black A X B] Y [black C Z D]]
-    S -> S)
-
-(define insert-
-    {tree-node --> tree --> tree}
-    X [] -> [red [] X []]
-    X [Color A Y B] -> (cases (< (node-key X) (node-key Y)) (balance [Color (insert- X A) Y B])
-                              (< (node-key Y) (node-key X)) (balance [Color A Y (insert- X B)])
-                              true [Color A Y B]))
-
-(define insert
-  {tree-node --> tree --> tree}
+\**\ \* Copyright (c) 2011, Justin Grant <justin at imagine27 dot com> *\ \* All rights reserved. *\ \**\ \* Redistribution and use in source and binary forms, with or without modification,  *\ \* are permitted provided that the following conditions are met: *\ \**\ \* Redistributions of source code must retain the above copyright notice, this list  *\ \* of conditions and the following disclaimer. *\ \* Redistributions in binary form must reproduce the above copyright notice, this  *\ \* list of conditions and the following disclaimer in the documentation and/or  *\ \* other materials provided with the distribution. *\ \* Neither the name of the <ORGANIZATION> nor the names of its contributors may be  *\ \* used to endorse or promote products derived from this software without specific  *\ \* prior written permission. *\ \**\ \* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND  *\ \* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED *\ \* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE  *\ \* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR  *\ \* ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES  *\ \* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; *\ \* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  *\ \* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING  *\ \* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,  *\ \* EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *\ \**\  (datatype tree-node
+
+    Key : number; Val : B;
+    ======================
+    [Key Val] : tree-node;)
+
+(datatype color
+
+    if (element? Color [red black])
+    _______________________________
+    Color : color;)
+
+(datatype tree
+
+    if (empty? Tree)
+    ________________
+    Tree : tree;
+
+    Color : color; LTree : tree; TreeNode : tree-node; RTree : tree;
+    ================================================================
+    [Color LTree TreeNode RTree] : tree;)
+
+(define node-key
+    {tree-node --> number}
+    [Key Val] -> Key)
+
+(define make-tree-black
+    {tree --> tree}
+    [Color A X B] -> [black A X B])
+
+(define member
+    {tree-node --> tree --> boolean}
+    X [] -> false
+    X [Color A Y B] -> (cases (< (node-key X) (node-key Y)) (member X A)
+                              (< (node-key Y) (node-key X))  (member X B)
+                              true true))
+
+(define balance
+    {tree --> tree}
+    [black [red [red A X B] Y C] Z D] -> [red [black A X B] Y [black C Z D]]
+    [black [red A X [red B Y C]] Z D] -> [red [black A X B] Y [black C Z D]]
+    [black A X [red [red B Y C] Z D]] -> [red [black A X B] Y [black C Z D]]
+    [black A X [red B Y [red C Z D]]] -> [red [black A X B] Y [black C Z D]]
+    S -> S)
+
+(define insert-
+    {tree-node --> tree --> tree}
+    X [] -> [red [] X []]
+    X [Color A Y B] -> (cases (< (node-key X) (node-key Y)) (balance [Color (insert- X A) Y B])
+                              (< (node-key Y) (node-key X)) (balance [Color A Y (insert- X B)])
+                              true [Color A Y B]))
+
+(define insert
+  {tree-node --> tree --> tree}
   X S -> (make-tree-black (insert- X S)))