egison 2.3.0 → 2.3.1
raw patch · 10 files changed
+101/−41 lines, 10 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- egison.cabal +1/−1
- elisp/egison-mode.el +1/−1
- hs-src/Language/Egison/Core.hs +1/−0
- lib/core/array.egi +58/−7
- lib/core/base.egi +1/−1
- lib/core/collection.egi +6/−0
- lib/core/number.egi +13/−1
- lib/poker-hands.egi +1/−13
- sample/collection-test.egi +18/−16
- sample/io/char-test.egi +1/−1
egison.cabal view
@@ -1,5 +1,5 @@ Name: egison-Version: 2.3.0+Version: 2.3.1 Synopsis: An Interpreter for the Programming Language Egison Description: An interpreter for the programming language Egison. A feature of Egison is the strong pattern match facility.
elisp/egison-mode.el view
@@ -106,10 +106,10 @@ ((equal "macro" name) 2) ((equal "let" name) 2) ((equal "letrec" name) 2)+ ((equal "do" name) 2) ((equal "match" name) 2) ((equal "match-all" name) 2) ((equal "type" name) 2)- ((equal "destructor" name) 2) ((equal "generate-array" name) 2) ))
hs-src/Language/Egison/Core.hs view
@@ -583,6 +583,7 @@ case mRetRest of Nothing -> return Nothing Just (retRestPatObjRefs, retRestFrame) -> return $ Just (retPatObjRefs ++ retRestPatObjRefs, retFrame ++ retRestFrame)+primitivePatPatternMatchList pppats _ = throwError $ Default $ "primitivePatPatternMatch: number of pppat and pat are different: " ++ show pppats primitivePatternMatch :: PrimitivePattern -> ObjectRef -> IOThrowsError (Maybe FrameList) primitivePatternMatch (PPatBool bool) objRef = do
lib/core/array.egi view
@@ -5,13 +5,18 @@ (define $Array (lambda [$a] (type- {[$var-match (lambda [$tgt] {tgt})]- [$inductive-match- (destructor- {[<cons ,$key _ _> [a (Array a)]- {[$arr (if (array-range? key arr)- {[(array-ref key arr) arr]}- {})]}]})]})))+ {[<cons ,$key ,$val _> [(Array a)]+ {[$arr (if (and (array-range? key arr)+ ((= a) (array-ref key arr) val))+ {[arr]}+ {})]}]+ [<cons ,$key _ _> [a (Array a)]+ {[$arr (if (array-range? key arr)+ {[(array-ref key arr) arr]}+ {})]}]+ [_ [Something]+ {[$tgt {[tgt]}]}]+ }))) (define $range-to-keys (lambda $ms@@ -35,3 +40,49 @@ (map (lambda [$x] [x y]) xs)) ys))))++(define $find-from-value+ (lambda [$a]+ (lambda [$val $arr]+ (let {[$keys (array-keys arr)]}+ (letrec {[$helper (lambda [$keys]+ (if ((= a) (array-ref (car keys) arr) val)+ (car key)+ (helper (cdr keys))))]}+ (helper keys))))))++(define $find-all-from-value+ (lambda [$a]+ (lambda [$val $arr]+ (let {[$keys (array-keys arr)]}+ (letrec {[$helper (lambda [$keys $ret]+ (match keys (List Something)+ {[<nil> ret]+ [<cons $key $rest>+ (if ((= a) (array-ref key arr) val)+ (helper rest {@ret val})+ (helper rest ret))]}))]}+ (helper keys {}))))))++(define $find-from-value-with-pattern+ (lambda [$a]+ (lambda [$pat $arr]+ (let {[$keys (array-keys arr)]}+ (letrec {[$helper (lambda [$keys]+ (match (array-ref (car keys) arr) a+ {[pat (car keys)]+ [_ (helper (cdr keys))]}))]}+ (helper keys))))))++(define $find-all-from-value-with-pattern+ (lambda [$a]+ (lambda [$pat $arr]+ (let {[$keys (array-keys arr)]}+ (letrec {[$helper (lambda [$keys $ret]+ (match keys (List Something)+ {[<nil> ret]+ [<cons $key $rest>+ (match (array-ref key arr) a+ {[pat (helper rest {@ret val})]+ [_ (helper rest ret)]})]}))]}+ (helper keys {}))))))
lib/core/base.egi view
@@ -87,4 +87,4 @@ (define $= (lambda [$a] (lambda [$x $y]- (and (match? x y) (match? y x)))))+ (and ((match? a) x y) ((match? a) y x)))))
lib/core/collection.egi view
@@ -150,6 +150,12 @@ (match xs (List Something) {[<snoc _ $ys> ys]}))) +(define $nth+ (lambda [$n $ls]+ (if (eq-n? n 1)+ (car ls)+ (nth (- n 1) (cdr ls)))))+ (define $reverse (lambda [$xs] (match xs (List Something)
lib/core/number.egi view
@@ -43,7 +43,7 @@ [<o> [] {[0 {[]}] [_ {}]}]- [<s> Nat+ [<s _> Nat {[$tgt (match (compare-integer tgt 0) Order {[<greater> {(- tgt 1)}] [_ {}]})]}]@@ -100,3 +100,15 @@ (map (lambda [$r] (mod r m)) rs) 0)})]})))++(define $Mod+ (lambda [$m]+ (type+ {[,$n []+ {[$tgt (if (eq-n (mod tgt m) (mod n m))+ {[]}+ {})]}]+ [_ [Something]+ {[$tgt {(mod tgt m)}]}]+ })))+
lib/poker-hands.egi view
@@ -20,21 +20,9 @@ {[$tgt {tgt}]}] })) -(define $Mod- (lambda [$m]- (type- {[$var-match (lambda [$tgt] {(mod tgt m)})]- [$inductive-match- (destructor- {[,$n []- {[$tgt (if (= tgt n)- {[]}- {})]}]})]- [$= (lambda [$val $tgt] (eq-n? (mod val m) (mod tgt m)))]})))- (define $Card (type- {[,$card []+ {[,$val [] {[$tgt (match [val tgt] [Card Card] {[[<card $s $n> <card ,s ,n>] {[]}] [[_ _] {}]})]}]
sample/collection-test.egi view
@@ -103,28 +103,30 @@ <ok>] [_ <ko>]})) -(test (let {[$f (lambda [$x] (+ (g x) 10))]- [$g (lambda [$x] (+ x 1))]}+(test (letrec {[$f (lambda [$x] (+ (g x) 10))]+ [$g (lambda [$x] (+ x 1))]} (f 0))) (define $Stick (lambda [$a] (type- {[$var-match (lambda [$tgt] {tgt})]- [$inductive-match- (destructor- {[nil []- {[$tgt (match-all tgt (List a) [<nil> []])]}]- [cons [a (List a)]- {[$tgt {@(match-all tgt (List a) [<cons $x $xs> [x xs]])- @(match-all (reverse tgt) (List a) [<cons $x $xs> [x xs]])}]}]- [join [(List a) (List a)]- {[$tgt {@(match-all tgt (List a) [<join $xs $ys> [xs ys]])- @(match-all (reverse tgt) (List a) [<join $xs $ys> [xs ys]])}]}]})]- [$equal? (lambda [$val $tgt]- (or ((type-ref (List a) equal?) val tgt)- ((type-ref (List a) equal?) val (reverse tgt))))]})))+ {[,$val []+ {[$tgt (if (or ((= (List a)) val tgt)+ ((= (List a)) val (reverse tgt)))+ {[]}+ {})]}]+ [<nil> []+ {[$tgt (match-all tgt (List a) [<nil> []])]}]+ [<cons _ _> [a (List a)]+ {[$tgt {@(match-all tgt (List a) [<cons $x $xs> [x xs]])+ @(match-all (reverse tgt) (List a) [<cons $x $xs> [x xs]])}]}]+ [<join _ _> [(List a) (List a)]+ {[$tgt {@(match-all tgt (List a) [<join $xs $ys> [xs ys]])+ @(match-all (reverse tgt) (List a) [<join $xs $ys> [xs ys]])}]}]+ [_ [Something]+ {[$tgt {tgt}]}]+ }))) (test (match-all {1 2 3} (Stick Integer) [<cons $x $xs> [x xs]])) (test (match-all {1 2 3} (Stick Integer) [<join $xs $ys> [xs ys]]))
sample/io/char-test.egi view
@@ -3,7 +3,7 @@ (do {[$: (write-string : "input char : ")] [$: (flush :)] [[$: $c] (read-char :)]- [$: (write-char : '\n')]}+ [$: (write-char : '\n')] [$: (write-string : "output : ")] [$: (write-char : c)] [$: (write-char : '\n')]}