shen-ruby 0.1.0

data/shen/release/test_programs/minim.shen

@@ -0,0 +1,193 @@
+\* <program> := <statement> <program> | <statement>;
+<statement> := <assignment> | <conditional> | <goto> | <tag>;
+<assignment> := (<var> := <val>) | (++ <var>); (-- <var>);
+<var> := any symbol;
+<val> := any number 
+<conditional> := (if <test> <statement> <statement>);
+<test> := (<var> <comp> <var); (<test> and <test>); 
+          (<test> or <test>) | (not <test>);
+<comp> := > | < | =; *\
+
+(synonyms program (list statement) 
+          env     (list (symbol * number))) 
+
+(datatype statement 
+
+   Var : symbol; Val : val; 
+   ========================= 
+   [Var := Val] : statement; 
+
+   if (element? Op [++ --]) 
+   Var : symbol; 
+   ===================== 
+   [Op Var] : statement; 
+
+   Test : test; DoThis : statement; DoThat : statement; 
+   ==================================================== 
+   [if Test then DoThis else DoThat] : statement; 
+
+   Tag : symbol; 
+   ====================== 
+   [goto Tag] : statement; 
+
+   Message : string-or-val; 
+   ============================ 
+   [print Message] : statement; 
+
+   Message : string; 
+   _________________ 
+   Message : string-or-val; 
+
+   Message : val; 
+   _________________ 
+   Message : string-or-val; 
+
+   Var : symbol; 
+   ========================= 
+   [input Var] : statement; 
+
+   Tag : symbol; 
+   _____________ 
+   Tag : statement;) 
+
+(datatype test 
+
+   if (element? Comp [= > <]) 
+   Val1 : val; Val2: val; 
+   ====================== 
+   [Val1 Comp Val2] : test; 
+
+
+   if (element? LogOp [and or]) 
+   Test1 : test; 
+   Test2 : test; 
+   ============= 
+   [Test1 LogOp Test2] : test; 
+
+
+   Test : test; 
+   ================== 
+   [not Test] : test;) 
+
+
+(datatype val 
+
+
+   ______________________________________ 
+   (number? N) : verified >> N : number; 
+
+
+   _______________________________________ 
+   (symbol? S) : verified >> S : symbol; 
+
+
+   Val : symbol; 
+   _______________ 
+   Val : val; 
+
+
+   Val : number; 
+   _____________ 
+   Val : val;) 
+
+
+\* The program that runs Minim programs is 56 lines of Qi and is given here. *\ 
+
+
+(define run 
+   {program --> env} 
+    Program -> (run-loop Program Program [])) 
+
+
+(define run-loop 
+   {program --> program --> env --> env} 
+    [] _ Env -> Env 
+    [nl | Ss] Program Env -> (do (output "~%") (run-loop Ss Program Env)) 
+    [Tag | Ss] Program Env -> (run-loop Ss Program Env)      where (symbol? Tag) 
+    [[goto Tag] | _] Program Env -> (run-loop (go Tag Program) Program Env) 
+    [[Var := Val] | Ss] Program Env 
+    -> (run-loop Ss Program (change-env Var (compute-val Val Env) Env)) 
+    [[++ Var] | Ss] Program Env 
+    -> (run-loop Ss Program (change-env Var (+ 1 (look-up Var Env)) Env)) 
+    [[-- Var] | Ss] Program Env 
+    -> (run-loop Ss Program (change-env Var (- (look-up Var Env) 1) Env)) 
+    [[if Test then DoThis else DoThat] | Ss] Program Env 
+     -> (if (perform-test? Test Env) 
+            (run-loop [DoThis | Ss] Program Env) 
+            (run-loop [DoThat | Ss] Program Env)) 
+     [[print M] | Ss] Program Env -> (do (output "~A" (look-up M Env)) 
+                                        (run-loop Ss Program Env)) 
+                                                                                where (symbol? M) 
+    [[print M] | Ss] Program Env -> (do (output "~A" M) 
+                                        (run-loop Ss Program Env)) 
+    [[input Var] | Ss] Program Env 
+       -> (run-loop Ss Program (change-env Var (input+ : number) Env)) ) 
+
+(define compute-val 
+  {val --> env --> number} 
+   N _ -> N  where (number? N) 
+   Var Env -> (look-up Var Env)      where (symbol? Var)) 
+
+(define go 
+  {symbol --> program --> program} 
+   Tag [Tag | Program] -> Program 
+   Tag [_ | Program] -> (go Tag Program) 
+   Tag _ -> (error "cannot go to tag ~A~%" Tag)) 
+
+(define perform-test? 
+  {test --> env --> boolean} 
+   [Test1 and Test2] Env -> (and (perform-test? Test1 Env) 
+                                 (perform-test? Test2 Env)) 
+   [Test1 or Test2] Env -> (or (perform-test? Test1 Env) 
+                               (perform-test? Test2 Env)) 
+   [not Test] Env -> (not (perform-test? Test Env)) 
+   [V1 = V2] Env -> (= (compute-val V1 Env) (compute-val V2 Env)) 
+   [V1 > V2] Env -> (> (compute-val V1 Env) (compute-val V2 Env)) 
+   [V1 < V2] Env -> (< (compute-val V1 Env) (compute-val V2 Env))) 
+
+(define change-env 
+   {symbol --> number --> env --> env} 
+    Var Val [] -> [(@p Var Val)] 
+    Var Val [(@p Var _) | Env] -> [(@p Var Val) | Env] 
+    Var Val [Binding | Env] -> [Binding | (change-env Var Val Env)]) 
+
+(define look-up 
+  {symbol --> env --> number} 
+   Var [] -> (error "~A is unbound.~%" Var) 
+   Var [(@p Var Val) | _] -> Val 
+   Var [_ | Env] -> (look-up Var Env)) 
+
+\* (run [      [print "Add x and y"] 
+               nl 
+               [print "Input x: "] 
+               [input x] 
+               nl 
+               [print "Input y: "] 
+               [input y] 
+               main 
+               [if [x = 0] then [goto end] else [goto sub1x]] 
+
+
+      		 sub1x 
+       		[-- x] 
+       		[++ y] 
+       		[goto main] 
+
+
+       end 
+       nl 
+       [print "The total of x and y is "] 
+       [print y] 
+       nl] ) *\
+
+
+             
+    
+
+
+ 
+
+
+
+    
+    

data/shen/release/test_programs/mutual.shen

@@ -0,0 +1,11 @@
+(define even? 
+   1 -> false  
+   X -> (odd? (- X 1)))
+
+(define odd?  
+   1 -> true  
+   X -> (even? (- X 1)))
+
+
+ 
+

data/shen/release/test_programs/n_queens.shen

@@ -0,0 +1,45 @@
+(define n-queens
+  {number --> (list (list number))}
+  N -> (n-queens-loop N (initialise N)))
+
+(define initialise
+   {number --> (list number)}
+   0 -> []
+   N -> [1 | (initialise (- N 1))])
+ 
+(define n-queens-loop
+  {number --> (list number) --> (list (list number))}
+  N Config -> []    where (all_Ns? N Config)
+  N Config -> [Config | (n-queens-loop N (next_n N Config))] 
+                                       where (and (ok_row? Config) (ok_diag? Config))
+  N Config -> (n-queens-loop N (next_n N Config)))
+ 
+(define all_Ns?
+  {number --> (list number) --> boolean}
+   _ [] -> true
+  N [N | Ns] -> (all_Ns? N Ns)
+  _ _ -> false)
+ 
+(define next_n
+  {number --> (list number) --> (list number)}
+  N [N | Ns] -> [1 | (next_n N Ns)]
+  _ [N | Ns] -> [(+ 1 N) | Ns])
+ 
+(define ok_row?
+  {(list number) --> boolean}
+  [] -> true
+  [N | Ns] -> false     where (element? N Ns)
+  [_ | Ns] -> (ok_row? Ns))
+ 
+(define ok_diag?
+  {(list number) --> boolean} 
+  [] -> true
+  [N | Ns] -> (and (ok_diag_N? (+ N 1) (- N 1) Ns) 
+                                (ok_diag? Ns)))
+ 
+(define ok_diag_N?
+  {number --> number --> (list number) --> boolean}
+  _ _ [] -> true
+  Up Down [Up | _] -> false
+  Up Down [Down | _] -> false
+  Up Down [_ | Ns] -> (ok_diag_N? (+ 1 Up) (- Down 1) Ns)) 

data/shen/release/test_programs/newton_version_1.shen

@@ -0,0 +1,33 @@
+(define newtons-method 
+    N -> (let Guess (/ N 2.0)
+                    (run-newtons-method 
+                           N 
+                           (round-to-2-places (average Guess (/  N Guess)))
+                           Guess)))
+
+(define run-newtons-method  
+   _ Sqrt Sqrt -> Sqrt  
+   N Better_Guess _ 
+   -> (run-newtons-method
+        N
+        (round-to-2-places (average Better_Guess (/  N Better_Guess))) 
+        Better_Guess))
+
+(define round-to-2-places  
+  N -> (/ (round (* 100.0 N)) 100.0)) 
+
+(define average
+  M N -> (/ (+ M N) 2.0))
+
+
+
+
+
+
+
+
+
+
+
+ 
+

data/shen/release/test_programs/newton_version_2.shen

@@ -0,0 +1,24 @@
+(define newtons-method 
+   N -> (fix (/. M (specialised-run-newtons-method N M)) (/ N 2.0)))
+
+(define specialised-run-newtons-method  
+   M N -> (round-to-2-places (average N (/ M N)))) 
+
+(define round-to-2-places  
+   M -> (/ (round (* 100.0 M)) 100.0)) 
+
+(define average
+  M N -> (/ (+ M N) 2.0))
+
+
+
+
+
+
+
+
+
+
+
+ 
+

data/shen/release/test_programs/parse.prl

@@ -0,0 +1,14 @@
+(defprolog pparse
+  S Grammar <-- (parsing [[s + 0] = [S + 0]] Grammar);) 
+
+(defprolog parsing  
+  [X = X] _ <--;
+  [[X + Y] = [X + Z]] Grammar <-- ! (parsing [Y = Z] Grammar);
+  [[[X + Y] + Z] = W] Grammar <-- ! (parsing [[X + [Y + Z]] = W] Grammar);
+  [W = [[X + Y] + Z]] Grammar <-- ! (parsing [W = [X + [Y + Z]]] Grammar);
+  [[X + Y] = Z] Grammar <-- (member [X = W] Grammar) (parsing [[W + Y] = Z] Grammar);)
+
+(defprolog member
+   X [X | _] <--;
+   X [_ | Y] <-- (member X Y);)
+

data/shen/release/test_programs/parser.shen

@@ -0,0 +1,52 @@
+(define parse
+   Sentence -> (let Parse (sent [Sentence []])
+                  (if (parsed? Parse)
+                      (output_parse Parse)
+                      ungrammatical)))
+
+(define parsed?
+  [[] _] -> true
+  _ -> false)
+
+(define output_parse
+  [_ Parse_Rules] -> (reverse Parse_Rules))
+
+(define sent
+   [Input Output] <- (vp (np [Input [[sent --> np vp] | Output]]))
+   _ -> (fail))
+
+(define np
+   [Input Output] <- (n (det [Input [[np --> det n] | Output]]))
+   [Input Output] <- (name [Input [[np --> name] | Output]])
+   _ -> (fail))
+
+(define name
+  [["John" | Input] Output] -> [Input [[name --> "John"] | Output]]
+  [["Bill" | Input] Output] -> [Input [[name --> "Bill"] | Output]]
+   _ -> (fail))
+
+ (define det
+  [["the" | Input] Output] -> [Input [[det --> "the"] | Output]]
+  [["a" | Input] Output] -> [Input [[det --> "a"] | Output]]
+  [["that" | Input] Output] -> [Input [[det --> "that"] | Output]]
+  [["this" | Input] Output] -> [Input [[det --> "this"] | Output]]
+  _ -> (fail))
+ 
+(define n
+  [["boy" | Input] Output] -> [Input [[n --> "boy"] | Output]]
+  [["girl" | Input] Output] -> [Input [[n --> "girl"] | Output]]
+   _ -> (fail))
+
+(define vp
+   [Input Output] <- (np (vtrans [Input [[vp --> vtrans np] | Output]]))
+   [Input Output] <- (vp [Input [[vp --> vintrans] | Output]])
+   _ -> (fail))
+
+(define vtrans
+  [["kicks" | Input] Output] -> [Input [[vtrans --> "kicks"] | Output]]
+  [["likes" | Input] Output] -> [Input [[vtrans --> "likes"] | Output]]
+   _ -> (fail))
+
+(define vintrans
+  [["jumps" | Input] Output] -> [Input [[vintrans --> "jumps"] | Output]]
+  _ -> (fail))

data/shen/release/test_programs/powerset.shen

@@ -0,0 +1,10 @@
+(define powerset
+   [] -> [[]]
+   [X | Y] -> (let Powerset (powerset Y)
+                (append (cons-X-to-each-set X Powerset) Powerset)))
+
+(define cons-X-to-each-set  
+    _ [ ] -> [ ]  
+    X [Y | Z] -> [[X | Y] | (cons-X-to-each-set X Z)])
+
+

data/shen/release/test_programs/prime.shen

@@ -0,0 +1,10 @@
+(define prime? 
+  X -> (prime* X (/ X 2) 2))
+
+(define prime*
+  X Max Div -> false	where (integer? (/ X Div))				
+  X Max Div -> true	where (> Div Max)			
+  X Max Div -> (prime* X Max (+ 1 Div)))
+
+ 
+

data/shen/release/test_programs/proof_assistant.shen

@@ -0,0 +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)}
+    [(@p S _) | _] -> S)