mirror of
				https://github.com/janet-lang/janet
				synced 2025-10-31 15:43:01 +00:00 
			
		
		
		
	Fix compiler optimization for if.
Add pattern matching library.
This commit is contained in:
		
							
								
								
									
										49
									
								
								lib/match.janet
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										49
									
								
								lib/match.janet
									
									
									
									
									
										Normal file
									
								
							| @@ -0,0 +1,49 @@ | ||||
|  | ||||
| # Sentinel value bad matches | ||||
| (def- sentinel ~',(gensym)) | ||||
|  | ||||
| (defn- match-1 | ||||
|   [pattern expr onmatch seen] | ||||
|   (cond | ||||
|     (and (symbol? pattern) (not (keyword? pattern))) | ||||
|     (if (get seen pattern) | ||||
|       ~(if (= ,pattern ,expr) ,onmatch ,sentinel) | ||||
|       (do | ||||
|         (put seen pattern true) | ||||
|         ~(if (= nil (def ,pattern ,expr)) ,sentinel ,onmatch))) | ||||
|     (indexed? pattern)  | ||||
|     (do | ||||
|       (def len (length pattern)) | ||||
|       (def $arr (gensym)) | ||||
|       (defn aux [i] | ||||
|         (if (= i len) | ||||
|           onmatch | ||||
|           (match-1 pattern.i ~(get ,$arr ,i) (aux (+ i 1)) seen))) | ||||
|       ~(do (def ,$arr ,expr) ,(aux 0))) | ||||
|     (dictionary? pattern) | ||||
|     (do | ||||
|       (def $dict (gensym)) | ||||
|       (defn aux [key] | ||||
|         (if (= key nil) | ||||
|           onmatch | ||||
|           (match-1 (get pattern key) ~(get ,$dict ,key) (aux (next pattern key)) seen))) | ||||
|       ~(do (def ,$dict ,expr) ,(aux (next pattern nil)))) | ||||
|     :else ~(if (= ,pattern ,expr) ,onmatch ,sentinel))) | ||||
|  | ||||
| (defmacro match | ||||
|   "Pattern matching." | ||||
|   [x & cases] | ||||
|   (if (not (atomic? x)) | ||||
|     (do (def $x (gensym)) ~(do (def ,$x ,x) ,(match $x ;cases))) | ||||
|     (do | ||||
|       (def len (length cases)) | ||||
|       (def len-1 (dec len)) | ||||
|       (defn aux [i] | ||||
|         (cond | ||||
|           (= i len-1) (get cases i) | ||||
|           (< i len-1) (do | ||||
|                         (def $res (gensym)) | ||||
|                         ~(if (= ,sentinel (def ,$res ,(match-1 cases.i x (get cases (inc i)) @{}))) | ||||
|                            ,(aux (+ 2 i)) | ||||
|                            ,$res)))) | ||||
|       (aux 0)))) | ||||
| @@ -60,7 +60,7 @@ | ||||
| (defmacro def- | ||||
|   "Define a private value that will not be exported." | ||||
|   [name & more] | ||||
|   ~(def name :private ,;more)) | ||||
|   ~(def ,name :private ,;more)) | ||||
|  | ||||
| (defn defglobal | ||||
|   "Dynamically create a global def." | ||||
| @@ -614,6 +614,16 @@ | ||||
|       (array/push res item))) | ||||
|   res) | ||||
|  | ||||
| (defn count | ||||
|   "Count the number of items in ind for which (pred item) | ||||
|   is true." | ||||
|   [pred ind] | ||||
|   (var counter 0) | ||||
|   (loop [item :in ind] | ||||
|     (if (pred item) | ||||
|       (++ counter))) | ||||
|   counter) | ||||
|  | ||||
| (defn keep | ||||
|   "Given a predicate, take only elements from an array or tuple for | ||||
|   which (pred element) is truthy. Returns a new array of truthy predicate results." | ||||
|   | ||||
| @@ -359,8 +359,8 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) { | ||||
|         janetc_scope(&tempscope, c, 0, "if-body"); | ||||
|         target = janetc_value(bodyopts, truebody); | ||||
|         janetc_popscope(c); | ||||
|         janetc_popscope(c); | ||||
|         janetc_throwaway(bodyopts, falsebody); | ||||
|         janetc_popscope(c); | ||||
|         return target; | ||||
|     } | ||||
|  | ||||
|   | ||||
		Reference in New Issue
	
	Block a user
	 Calvin Rose
					Calvin Rose