shen-ruby 0.12.1 → 0.13.0

data/shen/release/test_programs/search.shen

@@ -1,56 +1,56 @@
-(define breadth-first
-   {state --> (state --> (list state)) --> (state --> boolean) --> boolean}
-    Start F Test -> (b* F Test (F Start))) 
-
-(define b*
-   {(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
-    F Test States -> true 	where (some Test States)
-    F Test States -> (let NewStates (mapcan F States)
-                              (if (empty? NewStates)
-                                  false
-                                  (b* F Test NewStates))))
-
-(define some
-  {(A --> boolean) --> (list A) --> boolean}
-   Test [] -> false
-   Test [X|Y] -> (or (Test X) (some Test Y)))
-
-(define depth
-  {state --> (state --> (list state)) --> (state --> boolean) --> boolean}
-    Start _ Test -> true 	where (Test Start)
-    Start F Test -> (d* F Test (F Start))) 
-
-(define d*
-   {(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
-    _ Test [State | _] -> true 	where (Test State)
-    F Test [State | States] <- (fail-if (= false) (d* F Test (F State)))
-    F Test [_ | States] -> (d* F Test States)
-    _ _ _ -> false)
-
-(define hill
-  {(state --> number) --> state --> (state --> (list state)) --> (state --> boolean) --> boolean}
-    _ Start _ Test -> true 	where (Test Start)
-    E Start F Test -> (h* E F Test (order_states E (F Start))))  
-
-(define h*
-   {(state --> number) --> (state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
-    _ _ Test [State | _] -> true 	where (Test State)
-    E F Test [State | States] 
-    <- (fail-if (/. X (= X false)) (h* E F Test (order_states E (F State))))
-    E F Test [_ | States] -> (h* E F Test States)
-    _ _ _ _ -> false)    
-    
-(define order_states
-  {(state --> number) --> (list state) --> (list state)}
-   E States -> (sort (/. S1 (/. S2 (> (E S1) (E S2)))) States))
-
-(define sort
-  {(A --> (A --> boolean)) --> (list A) --> (list A)}
-   R X -> (fix (/. Y (sort* R Y)) X))
-
-(define sort*
-   {(A --> A --> boolean) --> (list A) --> (list A)}
-    _ [] -> []
-    _ [X] -> [X]
-    R [X Y | Z] -> [Y | (sort* R [X | Z])]	where (R Y X)
+(define breadth-first
+   {state --> (state --> (list state)) --> (state --> boolean) --> boolean}
+    Start F Test -> (b* F Test (F Start))) 
+
+(define b*
+   {(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
+    F Test States -> true 	where (some Test States)
+    F Test States -> (let NewStates (mapcan F States)
+                              (if (empty? NewStates)
+                                  false
+                                  (b* F Test NewStates))))
+
+(define some
+  {(A --> boolean) --> (list A) --> boolean}
+   Test [] -> false
+   Test [X|Y] -> (or (Test X) (some Test Y)))
+
+(define depth
+  {state --> (state --> (list state)) --> (state --> boolean) --> boolean}
+    Start _ Test -> true 	where (Test Start)
+    Start F Test -> (d* F Test (F Start))) 
+
+(define d*
+   {(state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
+    _ Test [State | _] -> true 	where (Test State)
+    F Test [State | States] <- (fail-if (= false) (d* F Test (F State)))
+    F Test [_ | States] -> (d* F Test States)
+    _ _ _ -> false)
+
+(define hill
+  {(state --> number) --> state --> (state --> (list state)) --> (state --> boolean) --> boolean}
+    _ Start _ Test -> true 	where (Test Start)
+    E Start F Test -> (h* E F Test (order_states E (F Start))))  
+
+(define h*
+   {(state --> number) --> (state --> (list state)) --> (state --> boolean) --> (list state) --> boolean}
+    _ _ Test [State | _] -> true 	where (Test State)
+    E F Test [State | States] 
+    <- (fail-if (/. X (= X false)) (h* E F Test (order_states E (F State))))
+    E F Test [_ | States] -> (h* E F Test States)
+    _ _ _ _ -> false)    
+    
+(define order_states
+  {(state --> number) --> (list state) --> (list state)}
+   E States -> (sort (/. S1 (/. S2 (> (E S1) (E S2)))) States))
+
+(define sort
+  {(A --> (A --> boolean)) --> (list A) --> (list A)}
+   R X -> (fix (/. Y (sort* R Y)) X))
+
+(define sort*
+   {(A --> A --> boolean) --> (list A) --> (list A)}
+    _ [] -> []
+    _ [X] -> [X]
+    R [X Y | Z] -> [Y | (sort* R [X | Z])]	where (R Y X)
     R [X Y | Z] -> [X | (sort* R [Y | Z])])

data/shen/release/test_programs/semantic_net.shen

@@ -1,44 +1,44 @@
-(define query  
-  [is Object Concept] -> (if (belongs? Object Concept) yes no))
-
-(define belongs?  
-  Object Concept -> (element? Concept (fix spread-activation [Object])))
-
-(define spread-activation  
-  [] -> [] 
-  [Vertex | Vertices] -> (union (accessible-from Vertex)
-                                (spread-activation Vertices)))
-
-(define accessible-from  
-  Vertex -> [Vertex | (union (is_links Vertex) (type_links Vertex))])
-
-(define is_links  
-  Vertex -> (get-prop Vertex is_a []))
-
-(define type_links 
-  Vertex -> (get-prop Vertex type_of []))
-
-(define assert
-   [Object is_a Type] -> (put Object is_a [Type | (is_links Object)])
-   [Type1 type_of Type2] -> (put Type1 type_of [Type2 | (type_links Type1)]))
-
-(define get-prop
-  Ob Pointer Default -> (trap-error (get Ob Pointer) (/. E Default)))
-
-(define clear
-  Ob -> (put Ob is_a (put Ob type_of [])))
-
-
-
-
-
-
-
-
-
-
-
-
-
- 
-
+(define query  
+  [is Object Concept] -> (if (belongs? Object Concept) yes no))
+
+(define belongs?  
+  Object Concept -> (element? Concept (fix spread-activation [Object])))
+
+(define spread-activation  
+  [] -> [] 
+  [Vertex | Vertices] -> (union (accessible-from Vertex)
+                                (spread-activation Vertices)))
+
+(define accessible-from  
+  Vertex -> [Vertex | (union (is_links Vertex) (type_links Vertex))])
+
+(define is_links  
+  Vertex -> (get-prop Vertex is_a []))
+
+(define type_links 
+  Vertex -> (get-prop Vertex type_of []))
+
+(define assert
+   [Object is_a Type] -> (put Object is_a [Type | (is_links Object)])
+   [Type1 type_of Type2] -> (put Type1 type_of [Type2 | (type_links Type1)]))
+
+(define get-prop
+  Ob Pointer Default -> (trap-error (get Ob Pointer) (/. E Default)))
+
+(define clear
+  Ob -> (put Ob is_a (put Ob type_of [])))
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+

data/shen/release/test_programs/spreadsheet.shen

@@ -1,35 +1,35 @@
-(define assess-spreadsheet
-  Spreadsheet -> (map (/. Row (assign-fixed-values Row Spreadsheet))
-                      Spreadsheet))
-
-(define assign-fixed-values 
-   [Index | Cells] Spreadsheet 
-   -> [Index | (map (/. Cell (assign-cell-value Cell Spreadsheet)) Cells)]) 
-
-(define assign-cell-value 
-   [Attribute Value]  _ -> [Attribute Value] where (fixed-value? Value) 
-   [Attribute Value] Spreadsheet -> [Attribute (Value Spreadsheet)])
-
-(define fixed-value?
- \* number?, symbol? and string? are system functions - see appendix A *\
-  Value -> (or (number? Value) (or (symbol? Value) (string? Value))))
-
-(define get'
-  \* spreads the spreadsheet! *\
-  Index Attribute Spreadsheet
-   -> (get-row Index Attribute Spreadsheet Spreadsheet))
-
-(define get-row
-   \* looks for the right row using the index *\
-   Index Attribute [[Index | Cells] | _] Spreadsheet
-   -> (get-cell Attribute Cells Spreadsheet)
-   Index Attribute [_ | Rows] Spreadsheet
-   -> (get-row Index Attribute Rows Spreadsheet)
-   Index _ _ _ -> (error "Index ~A not found" Index))
-
-(define get-cell
-   Attribute [[Attribute Value] | _] Spreadsheet 
-   -> (if (fixed-value? Value) Value (Value Spreadsheet))
-   Attribute [_ | Cells] Spreadsheet
-   -> (get-cell Attribute Cells Spreadsheet)
+(define assess-spreadsheet
+  Spreadsheet -> (map (/. Row (assign-fixed-values Row Spreadsheet))
+                      Spreadsheet))
+
+(define assign-fixed-values 
+   [Index | Cells] Spreadsheet 
+   -> [Index | (map (/. Cell (assign-cell-value Cell Spreadsheet)) Cells)]) 
+
+(define assign-cell-value 
+   [Attribute Value]  _ -> [Attribute Value] where (fixed-value? Value) 
+   [Attribute Value] Spreadsheet -> [Attribute (Value Spreadsheet)])
+
+(define fixed-value?
+ \* number?, symbol? and string? are system functions - see appendix A *\
+  Value -> (or (number? Value) (or (symbol? Value) (string? Value))))
+
+(define get'
+  \* spreads the spreadsheet! *\
+  Index Attribute Spreadsheet
+   -> (get-row Index Attribute Spreadsheet Spreadsheet))
+
+(define get-row
+   \* looks for the right row using the index *\
+   Index Attribute [[Index | Cells] | _] Spreadsheet
+   -> (get-cell Attribute Cells Spreadsheet)
+   Index Attribute [_ | Rows] Spreadsheet
+   -> (get-row Index Attribute Rows Spreadsheet)
+   Index _ _ _ -> (error "Index ~A not found" Index))
+
+(define get-cell
+   Attribute [[Attribute Value] | _] Spreadsheet 
+   -> (if (fixed-value? Value) Value (Value Spreadsheet))
+   Attribute [_ | Cells] Spreadsheet
+   -> (get-cell Attribute Cells Spreadsheet)
    Attribute _ _ -> (error "Attribute ~A not found" Attribute))

data/shen/release/test_programs/stack.shen

@@ -1,27 +1,27 @@
-(declare empty-stack [A --> [stack B]])
-
-(declare push [A --> [stack A] --> [stack A]])
-
-(declare top [[stack A] --> A])
-
-(declare pop [[stack A] --> [stack A]])
-
-(define empty-stack
-   _ -> (/.  X (if (or (= X pop) (= X top))
-                        (error "this stack is empty~%")
-                        (error "~A is not an operation on stacks.~%" X))))
-                        
-(define push
-   X S -> (/. Y (if (= Y pop) 
-                    S 
-                   (if (= Y top) 
-                       X 
-                       (error "~A is not an operation on stacks.~%" Y)))))
-
-(define top
-   S -> (S top))
-
-(define pop
-   S -> (S pop))
-
-
+(declare empty-stack [A --> [stack B]])
+
+(declare push [A --> [stack A] --> [stack A]])
+
+(declare top [[stack A] --> A])
+
+(declare pop [[stack A] --> [stack A]])
+
+(define empty-stack
+   _ -> (/.  X (if (or (= X pop) (= X top))
+                        (error "this stack is empty~%")
+                        (error "~A is not an operation on stacks.~%" X))))
+                        
+(define push
+   X S -> (/. Y (if (= Y pop) 
+                    S 
+                   (if (= Y top) 
+                       X 
+                       (error "~A is not an operation on stacks.~%" Y)))))
+
+(define top
+   S -> (S top))
+
+(define pop
+   S -> (S pop))
+
+

data/shen/release/test_programs/streams.shen

@@ -1,20 +1,20 @@
-(datatype progression
-
-    X : (A * (A --> A) * (A --> boolean));
-    ======================================
-    X : (progression A);)    
-
-(define delay
-   {(progression A) --> (progression A)}
-   (@p X F E) -> (if (not (E X)) 
-                     (@p (F X) F E) 
-                     (error "progression exhausted!~%")))
-
-(define force
-    {(progression A) --> A}
-     (@p X F E) -> X)
-
-(define end?
-    {(progression A) --> boolean}
-     (@p X _ E) -> (E X))
-
+(datatype progression
+
+    X : (A * (A --> A) * (A --> boolean));
+    ======================================
+    X : (progression A);)    
+
+(define delay
+   {(progression A) --> (progression A)}
+   (@p X F E) -> (if (not (E X)) 
+                     (@p (F X) F E) 
+                     (error "progression exhausted!~%")))
+
+(define force
+    {(progression A) --> A}
+     (@p X F E) -> X)
+
+(define end?
+    {(progression A) --> boolean}
+     (@p X _ E) -> (E X))
+

data/shen/release/test_programs/strings.shen

@@ -1,58 +1,58 @@
-\* Replace the first occurrence of a string Rem by Rep *\
-(define subst-string
-  {string --> string --> string --> string}
-   _ _ "" -> ""
-  Rep (@s S Ss) (@s S Ss') <- (fail-if (= "failed!") (subst-string' Rep Ss Ss'))
-  Rep Rem (@s S Ss) -> (@s S (subst-string Rep Rem Ss)))
-  
-(define subst-string'
-  {string --> string --> string --> string}
-  Rep "" Ss -> (@s Rep Ss)
-  Rep (@s S Ss) (@s S Ss') -> (subst-string' Rep Ss Ss')
-   _ _ _ -> "failed!")
-      
-(define rwilli
-  {string --> string}
-  "" -> ""
-  (@s "Willi" Ss) -> (rwilli Ss)
-  (@s _ Ss) -> (rwilli Ss))
-  
-
-\* Length of a string. *\   
-(define strlen
-   {string --> number}
-    "" -> 0
-    (@s _ S) -> (+ 1 (strlen S)))
-    
-\* Trim characters from the front of a string. *\    
-(define trim-string-left
-   {(list string) --> string --> string}
-     _ "" -> ""
-     Trim (@s S Ss) -> (@s S Ss)  where (not (element? S Trim))
-     Trim (@s _ Ss) -> (trim-string-left Trim Ss)) 
-
-\* Trim characters from the end of a string. *\      
-(define trim-string-right
-   {(list string) --> string --> string}          
-     Trim S -> (reverse-string (trim-string-left Trim (reverse-string S))))
-     
-\* Trim characters from the front and end of a string *\
-(define trim-string
-   {(list string) --> string --> string}          
-     Trim S -> (reverse-string (trim-string-left Trim (reverse-string (trim-string-left Trim S)))))     
-
-\* Reverse a string. *\    
-(define reverse-string
-  {string --> string}
-   "" -> ""
-   (@s S Ss) -> (@s (reverse-string Ss) S))   
-
-\* A string of digits? *\ 
-(define alldigits?
-   {string --> boolean}
-   "" -> true
-   (@s S Ss) -> (and (digit? S) (alldigits? Ss)))
-   
-(define digit?
-  {string --> boolean}
+\* Replace the first occurrence of a string Rem by Rep *\
+(define subst-string
+  {string --> string --> string --> string}
+   _ _ "" -> ""
+  Rep (@s S Ss) (@s S Ss') <- (fail-if (= "failed!") (subst-string' Rep Ss Ss'))
+  Rep Rem (@s S Ss) -> (@s S (subst-string Rep Rem Ss)))
+  
+(define subst-string'
+  {string --> string --> string --> string}
+  Rep "" Ss -> (@s Rep Ss)
+  Rep (@s S Ss) (@s S Ss') -> (subst-string' Rep Ss Ss')
+   _ _ _ -> "failed!")
+      
+(define rwilli
+  {string --> string}
+  "" -> ""
+  (@s "Willi" Ss) -> (rwilli Ss)
+  (@s _ Ss) -> (rwilli Ss))
+  
+
+\* Length of a string. *\   
+(define strlen
+   {string --> number}
+    "" -> 0
+    (@s _ S) -> (+ 1 (strlen S)))
+    
+\* Trim characters from the front of a string. *\    
+(define trim-string-left
+   {(list string) --> string --> string}
+     _ "" -> ""
+     Trim (@s S Ss) -> (@s S Ss)  where (not (element? S Trim))
+     Trim (@s _ Ss) -> (trim-string-left Trim Ss)) 
+
+\* Trim characters from the end of a string. *\      
+(define trim-string-right
+   {(list string) --> string --> string}          
+     Trim S -> (reverse-string (trim-string-left Trim (reverse-string S))))
+     
+\* Trim characters from the front and end of a string *\
+(define trim-string
+   {(list string) --> string --> string}          
+     Trim S -> (reverse-string (trim-string-left Trim (reverse-string (trim-string-left Trim S)))))     
+
+\* Reverse a string. *\    
+(define reverse-string
+  {string --> string}
+   "" -> ""
+   (@s S Ss) -> (@s (reverse-string Ss) S))   
+
+\* A string of digits? *\ 
+(define alldigits?
+   {string --> boolean}
+   "" -> true
+   (@s S Ss) -> (and (digit? S) (alldigits? Ss)))
+   
+(define digit?
+  {string --> boolean}
    S -> (element? S ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9"]))