egison 3.0.11 → 3.0.12

raw patch · 6 files changed

+98/−4 lines, 6 files

Files

• egison.cabal +2/−1
• elisp/egison-mode.el +1/−1
• hs-src/Language/Egison/Desugar.hs +2/−2
• lib/graph/graph.egi +54/−0
• lib/math/prime.egi +12/−0
• lib/tree/xml.egi +27/−0

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.0.11+Version:             3.0.12 Synopsis:            The world's first language with non-linear pattern-matching against unfree data Description:         An interpreter for Egison, the world's first programming langugage which realized non-linear pattern-matching with unfree data types.                      With Egison, you can represent pattern-matching with unfree data types intuitively,@@ -19,6 +19,7 @@   Data-files:          lib/core/base.egi lib/core/number.egi lib/core/collection.egi lib/core/pattern.egi+                     lib/graph/graph.egi lib/tree/xml.egi lib/math/prime.egi                      elisp/egison-mode.el  Library

@@ -4,7 +4,7 @@  ;;; Author: Satoshi Egi <egisatoshi@gmail.com> ;;; URL: https://github.com/egisatoshi/egison3/blob/master/elisp/egison-mode.el-;;; Version: 0.1.4+;;; Version: 0.1.5  ;; Code goes here 

@@ -104,7 +104,7 @@   name <- fresh   matcher' <- desugar matcher   clauses' <- desugarMatchClauses clauses-  desugar (LambdaExpr [name] (MatchExpr (VarExpr name) matcher' clauses'))+  return $ LambdaExpr [name] (MatchExpr (VarExpr name) matcher' clauses')  desugar (ArrayRefExpr (VarExpr name) (TupleExpr nums)) =   desugar $ IndexedExpr (VarExpr name) nums@@ -253,5 +253,5 @@ desugarMatchClauses (clause:rest) = do   clause' <- desugarMatchClause clause   rest'   <- desugarMatchClauses rest-  return $ clause : rest'+  return $ clause' : rest' desugarMatchClauses [] = return []

@@ -0,0 +1,54 @@+;;;+;;; graph.egi+;;;++(define $graph+  (lambda [$a]+    (multiset (nodeInfo a))))++(define $nodeInfo+  (lambda [$a]+    (algebraic-data-matcher+      {<node a (multiset a) (multiset a)>})))++(define $hamilton-cycle+  (pattern-function [$a]+    (& $g+       <cons <node (& a_1 $h_1) <cons (& a_2 $h_2) _> _>+             (loop $i (between 3 (size g))+               <cons <node ,h_(- i 1) <cons (& a_i $h_i) _> _>+                     ...>+               <cons <node ,h_(size g) <cons ,h_1 _> _>+                     <nil>>)>)))++(define $hamilton-path+  (pattern-function [$a]+    (& $g+       <cons <node (& a_1 $h_1) <cons (& a_2 $h_2) _> _>+             (loop $i (between 3 (size g))+               <cons <node ,h_(- i 1) <cons (& a_i $h_i) _> _>+                     ...>+               <cons <node ,h_(size g) _ _>+                     <nil>>)>)))++(define $hamilton-path2+  (pattern-function [$a]+    (& $g+       (let {[$n (size g)]}+         <cons <node (& a_1 $h_1) <cons (& a_2 $h_2) _> _>+               (loop $i (between 3 n)+                 <cons <node ,h_(- i 1) <cons (& a_i $h_i) _> _>+                       ...>+                 <cons <node ,h_n _ _>+                       <nil>>)>)+       )))++(define $all-paths+  (pattern-function [$s $e $p $rest]+    (| <cons <node (& s p_1) <cons (& e p_2) _> _> rest>+       <cons <node (& s p_1)  <cons (& p_2 $h_2) _> _>+          (loop $i (from 2) ;; TEMPORARY+            <cons <node ,h_(- i 1) <cons (& p_i $h_i) _> _>+                  ...>+            rest)>)))+

@@ -0,0 +1,12 @@+(define $eratosthenes+  (lambda [$n]+    (let {[$ls (between 2 n)]}+      (letrec {[$looper+                (lambda [$ps $ls]+                  (let {[$p (car ls)]+                        [$xs (cdr ls)]}+                    (if (gt? (* p p) (rac xs))+                        {@ps @ls}+                        (looper {@ps p} (filter (lambda [$l] (not (eq? (remainder l p) 0))) xs)))))+                ]}+        (looper {} ls)))))

@@ -0,0 +1,27 @@+(define $xml+  (matcher+    {[,$val []+      {[$tgt (match [val tgt] [xml xml]+               {[[<leaf $tag $text> <leaf ,tag ,text>] {[]}]+                [[<lnode $tag $xs> <lnode ,tag ,xs>] {[]}]+                [[_ _] {}]})]}]+     [<leaf $ $> [string string]+      {[<Leaf $tag $text> {[tag text]}]+       [_ {}]}]+     [<lnode $ $> [string (list xml)] ; Node whose children are seen as a list.+      {[<Node $tag $cs> {[tag cs]}]+       [_ {}]}]+     [<mnode $ $> [string (multiset xml)] ; Node whose children are seen as a multiset.+      {[<Node $tag $cs> {[tag cs]}]+       [_ {}]}]+     [<descendant $> xml+      {[$x {x @(all-descendants x)}]}]+     [$ [something]+      {[$tgt {tgt}]}]+     }))++(define $all-descendants+  (lambda [$x]+    (match x xml+      {[<leaf _ _> {}]+       [<lnode _ $cs> {@cs @(concat (map all-descendants cs))}]})))