Updates for 35.0

CHANGELOG.md

@@ -6,6 +6,12 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/)
 
 ## [Unreleased]
 
+## [35.0] - 2024-01-10
+
+### Changed
+
+- Type `==>` simplified for YACC.
+
 ## [34.6] - 2024-01-10
 
 ### Changed
@@ -495,7 +501,8 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/)
 - y-or-n? fixed
 - compiler warnings suppressed in CLisp
 
-[Unreleased]: https://github.com/Shen-Language/shen-sources/compare/shen-34.6...HEAD
+[Unreleased]: https://github.com/Shen-Language/shen-sources/compare/shen-35.0...HEAD
+[35.0]: https://github.com/Shen-Language/shen-sources/compare/shen-34.6...shen-35.0
 [34.6]: https://github.com/Shen-Language/shen-sources/compare/shen-34.5...shen-34.6
 [34.5]: https://github.com/Shen-Language/shen-sources/compare/shen-34.4...shen-34.5
 [34.4]: https://github.com/Shen-Language/shen-sources/compare/shen-34.3...shen-34.4

README.md

@@ -1,4 +1,4 @@
-[![Current Release](https://img.shields.io/badge/release-34.4-blue.svg)](https://github.com/Shen-Language/shen-sources/releases)
+[![Current Release](https://img.shields.io/badge/release-35.0-blue.svg)](https://github.com/Shen-Language/shen-sources/releases)
 
 # Official Shen Sources
 
@@ -32,7 +32,7 @@ Packages can be created for any version, but when uploading to the releases page
 
 ```
 make pure
-git checkout shen-34.4
+git checkout shen-35.0
 make fetch
 make klambda
 make release

sources/declarations.shen

@@ -47,7 +47,7 @@
 (set *infs* 0)
 (set *hush* false)
 (set *optimise* false)
-(set *version* "34.6")
+(set *version* "35.0")
 (set *step* false)
 (set *it* "")
 (set *residue* [])

sources/load.shen

@@ -54,7 +54,7 @@
   _ -> (simple-error "implementation error in shen.work-through"))
 
 (define pretty-type
-  [[str [list A] B] --> [str [list A] C]] -> [[list A] ==> C]
+  [[list A] --> [str [list A] B]] -> [[list A] ==> B]
   [X | Y] -> (map (/. Z (pretty-type Z)) [X | Y])
   A -> A)
 

sources/t-star.shen

@@ -35,7 +35,7 @@
 
 (define curry-type
   [A --> B --> | C] -> (curry-type [A --> [B --> | C]])
-  [[list A] ==> B] -> (curry-type [[str [list A] (protect (gensym C))] --> [str [list A] B]])
+  [[list A] ==> B] -> (curry-type [[list A] --> [str [list A] B]])
   [A * B * | C] -> (curry-type [A * [B * | C]])
   [X | Y] -> (map (/. Z (curry-type Z)) [X | Y])
   X -> X)

sources/types.shen

@@ -2,7 +2,7 @@
 
 \\                  All rights reserved.
 
-(package shen [dynamic]
+(package shen []
 
 (define declare
   F A -> (let Rectify (rectify-type A)
@@ -46,28 +46,23 @@
 (declare boolean? [A --> boolean])
 (declare bootstrap [string --> string])
 (declare bound? [symbol --> boolean])
+(declare ccons? [[list A] --> boolean])
 (declare cd [string --> string])
 (declare close [[stream A] --> [list B]])
 (declare cn [string --> [string --> string]])
-(declare compile [[[str [list A] B] --> [str [list A] C]] --> [[list A] --> C]])
+(declare compile [[[list A] --> [str [list A] B]] --> [[list A] --> B]])
 (declare cons? [A --> boolean])
 (declare destroy [symbol --> symbol])
 (declare difference [[list A] --> [[list A] --> [list A]]])
 (declare do [A --> [B --> B]])
-(declare <e> [[str [list A] B] --> [str [list A] [list C]]])
-(declare <!> [[str [list A] B] --> [str [list A] [list A]]])
-(declare <end> [[str [list A] B] --> [str [list A] B]])
-(declare =hd? [[str [list A] B] --> [A --> boolean]])
-(declare hds [[str [list A] B] --> A])
-(declare tls [[str [list A] B] --> [str [list A] B]])
+(declare <e> [[list A] --> [str [list A] [list B]]])
+(declare <!> [[list A] --> [str [list B] [list A]]])
+(declare <end> [[list A] --> [str [list A] [list B]]])
 (declare parse-failure? [[str [list A] B] --> boolean])
 (declare parse-failure [--> [str [list A] B]])
 (declare <-out [[str [list A] B] --> B])
 (declare in-> [[str [list A] B] --> [list A]])
-(declare non-empty-stream? [[str [list A] B] --> boolean])
 (declare comb [[list A] --> [B --> [str [list A] B]]])
-(declare headstream [[str A B] --> [[str C D] --> [str A [str C D]]]])
-(declare tlstream [[str [list A] B] --> [str [list A] B]])
 (declare element? [A --> [[list A] --> boolean]])
 (declare empty? [A --> boolean])
 (declare enable-type-theory [symbol --> boolean])
@@ -80,6 +75,7 @@
 (declare freeze [A --> [lazy A]])
 (declare fst [[A * B] --> A])
 (declare gensym [symbol --> symbol])
+(declare hds=? [[list A] --> [A --> boolean]])
 (declare <-vector [[vector A] --> [number --> A]])
 (declare vector-> [[vector A] --> [number --> [A --> [vector A]]]])
 (declare vector [number --> [vector A]])

sources/yacc.shen

@@ -5,16 +5,10 @@
 (package shen []
 
 (define compile
-  F L -> (let Compile (F [L no-action])
-           (if (parsed? Compile)
-               (objectcode Compile)
-               (error "parse failure~%"))))
-
-(define parsed?
-  X -> false       where (parse-failure? X)
-  [[X | Y] | _] -> (do (set *residue* [X | Y])
-                       (error "syntax error here: ~R~% ..." [X | Y]))
-  _ -> true)
+  F L -> (let Compile (F L)
+           (cases (parse-failure? Compile) (error "parse failure~%")
+                  (cons? (in-> Compile))   (error "syntax error here: ~S ..." (hd (in-> Compile)))
+                  true                     (<-out Compile))))
 
 (define parse-failure?
   X -> (= X (fail)))
@@ -34,8 +28,7 @@
                                  Def);)
 
 (defcc <yaccsig>
-  LC [list A] ==> B RC := (let C (protect (gensym C))
-                            [{ [str [list A] C] --> [str [list A] B] }])
+  LC [list A] ==> B RC := [{ [list A] --> [str [list A] B] }]
                             where (and (= { LC) (= } RC));
   <e> := [];)
 
@@ -141,88 +134,81 @@
 
 (define non-terminalcode
   Type Stream NonTerminal Syntax Semantics
-    -> (let ApplyNonTerminal (concat (protect Parse) NonTerminal)
-        [let ApplyNonTerminal [NonTerminal Stream]
-            [if [parse-failure? ApplyNonTerminal]
-                [parse-failure]
-                (yacc-syntax Type ApplyNonTerminal Syntax Semantics)]]))
+    -> (let TryParse         (concat (protect Parse) NonTerminal)
+            Act              (concat (protect Action) NonTerminal)
+            Remainder        (concat (protect Remainder) NonTerminal)
+        [let TryParse [NonTerminal Stream]
+          [if [parse-failure? TryParse]
+              [parse-failure]
+              (let Continue [let Remainder [in-> TryParse]
+                                 (yacc-syntax Type Remainder Syntax Semantics)]
+                   (if (or (occurs? NonTerminal Semantics) (occurs? Act Semantics))
+                       [let Act [<-out TryParse] Continue]
+                       Continue))]]))
+
 
 (define variablecode
   Type Stream Variable Syntax Semantics
-    -> (let NewStream (gensym (protect News))
-            [if [non-empty-stream? Stream]
-                [let Variable [hds Stream]
-                     NewStream [tls Stream]
-                     (yacc-syntax Type NewStream Syntax Semantics)]
-            [parse-failure]]))
+    -> (let Remainder (gensym (protect Remainder))
+         [if [cons? Stream]
+             (let Continue [let Remainder [tail Stream]
+                             (yacc-syntax Type Remainder Syntax Semantics)]
+                  (if (occurs? Variable Semantics)
+                      [let Variable [head Stream] Continue]
+                      Continue))
+             [parse-failure]]))
 
 (define wildcardcode
   Type Stream Variable Syntax Semantics
-    -> (let NewStream (gensym (protect News))
-           [if [non-empty-stream? Stream]
-               [let NewStream [tls Stream]
-                    (yacc-syntax Type NewStream Syntax Semantics)]
-               [parse-failure]]))
+    -> (let Remainder (gensym (protect Remainder))
+         [if [cons? Stream]
+             [let Remainder [tail Stream]
+               (yacc-syntax Type Remainder Syntax Semantics)]
+             [parse-failure]]))
 
 (define terminalcode
   Type Stream Terminal Syntax Semantics
-    -> (let NewStream (gensym (protect News))
-            [if [=hd? Stream Terminal]
-                [let NewStream [tls Stream]
-                     (yacc-syntax Type NewStream Syntax Semantics)]
-                [parse-failure]]))
+    -> (let Remainder (gensym (protect Remainder))
+         [if [hds=? Stream Terminal]
+             [let Remainder [tail Stream]
+               (yacc-syntax Type Remainder Syntax Semantics)]
+             [parse-failure]]))
+
+(define hds=?
+  [X | _] X -> true
+  _ _ -> false)
 
 (define conscode
-  Type Str Cons Syn Sem -> [if [ccons? Str]
-                               [let (protect SynCons) [comb [hds Str] [<-out Str]]
-                                    (yacc-syntax Type
-                                            (protect SynCons)
-                                            (append (decons Cons) [<end>])
-                                            [pushsemantics [tlstream Str] Syn Sem])]
-                               [parse-failure]])
-
- (define decons
-   [cons X Y] -> [X | (decons Y)]
-   X -> X)
-
- (define ccons?
-   [[X | _] _] -> (cons? X)
-   _ -> false)
-
- (define non-empty-stream?
+  Type Stream Cons Syntax Semantics
+    -> (let Remainder (gensym (protect Remainder))
+            Head      (gensym (protect Hd))
+            Tail      (gensym (protect Tl))
+        [if [ccons? Stream]
+            [let Head [head Stream]
+                 Tail [tail Stream]
+              (yacc-syntax Type Head (append (decons Cons) [<end>])
+                  [processed (yacc-syntax Type Tail Syntax Semantics)])]
+            [parse-failure]]))
+
+(define ccons?
   [[_ | _] | _] -> true
   _ -> false)
 
-(define hds
-  Stream -> (hd (hd Stream)))
-
-(define hdstream
-  [[X | _] Y] -> [X Y]
-  _ -> (error "implementation error in shen.hdstream~%"))
+(define decons
+  [cons X Y] -> [X | (decons Y)]
+  X -> X)
 
- (define comb
+(define comb
   X Y -> [X Y])
 
-(define tlstream
-  [[_ | Y] Z] -> [Y Z]
-  _ -> (error "implementation error in shen.tlstream~%"))
-
-(define =hd?
-  [[X | _] | _] X -> true
-  _ _ -> false)
-
-(define tls
-  [[_ | Y] Z] -> [Y Z]
-  _ -> (error "implementation error in shen.tls~%"))
-
 (define yacc-semantics
-  Type _ [pushsemantics Stream Syntax Semantics] -> (yacc-syntax Type Stream Syntax Semantics)
+  _ _ [processed Semantics] -> Semantics
   Type Stream Semantics -> (let Process (process-yacc-semantics Semantics)
                                 Annotate (use-type-info Type Process)
-                                [comb [in-> Stream] Annotate]))
+                             [comb Stream Annotate]))
 
 (define use-type-info
-  [{ [str [list A] C] --> [str [list A] B] }] Semantics -> [type Semantics B]
+  [{ [list A] --> [str [list A] B] }] Semantics -> [type Semantics B]
       where (monomorphic? B)
   _ Semantics -> Semantics)
 
@@ -234,27 +220,24 @@
 (define process-yacc-semantics
   [protect NonTerminal] -> NonTerminal    where (non-terminal? NonTerminal)
   [X | Y] -> (map (/. Z (process-yacc-semantics Z)) [X | Y])
-  NonTerminal -> [<-out (concat (protect Parse) NonTerminal)]  where (non-terminal? NonTerminal)
+  NonTerminal -> (concat (protect Action) NonTerminal)  where (non-terminal? NonTerminal)
   X -> X)
 
 (define <-out
   [_ X] -> X
-  _ -> (error "implementation error in shen.<-out~%"))
+  X -> (hd (tl X)))
 
 (define in->
-  [X _] -> X
-  _ -> (error "implementation error in shen.in->~%"))
+  X -> (hd X))
 
 (define <!>
-  [X _] -> [[] X]
-  _ -> (error "implementation error in <!>~%"))
+  X -> [[] X])
 
 (define <e>
-  [X _] -> [X []]
-  _ -> (error "implementation error in <e>~%"))
+  X -> [X []])
 
 (define <end>
-  [[] X] -> [[] X]
+  [] -> [[] []]
   _ -> (parse-failure))
 
 )