I am watching the video lectures of SICP. Currently I am on 4A Pattern Matching and Rule Based Substitution.
So far, I found the Matcher and the Instantiator is easy. But I can't get my head into The simplifier.
(define (simplifier the-rules)
(define (simplify-exp exp)
(try-rules (if (compound? exp)
(map simplify-exp exp)
exp)))
(define (try-rules exp)
(define (scan rules)
(if (null? rules)
exp
(let ((dict (match (pattern (car rules))
exp
(empty-dictionary))))
(if (eq? dict 'failed)
(scan (cdr rules))
(simplify-exp (instantiate (skeleton (car rules)) dict))))))
(scan the-rules))
simplify-exp)
I saw another question here on this topic which defined compound? in terms of pair?. But, Then what simplify-exp feeding to try-rules?
Figured it out. The rules are going to apply in every node as promised. You can vote to delete the question. But, I would add some explanation on how I made it working.
I changed some code. The original code seems written with some other semantic in mind. I added some commentary where I made some decision on my own.
#lang racket
;matcher
(define (match pat exp dict)
(cond ((eq? dict 'failed) 'failed)
;matched
((and (null? pat) (null? exp)) dict)
;so far matched, but no more
((or (null? pat) (null? exp)) 'failed)
((atom? pat)
(if (atom? exp)
(if (eq? pat exp)
dict
'failed)
'failed))
((pat-const? pat)
(if (constant? exp)
(extend-dict pat exp dict)
'failed))
((pat-variable? pat)
(if (variable? exp)
(extend-dict pat exp dict)
'failed))
((pat-exp? pat)
(extend-dict pat exp dict))
((atom? exp) 'failed)
(else
(match (cdr pat)
(cdr exp)
(match (car pat) (car exp) dict)))))
(define (pat-const? pat)
(eq? (car pat) '?c))
(define (pat-variable? pat)
(eq? (car pat) '?v))
(define (pat-exp? pat)
(eq? (car pat) '?))
(define constant? number?)
(define variable? symbol?)
;instantiator
(define (instantiate skeleton dict)
(define (loop s)
(cond ((atom? s) s)
;we cant run past the nil line
((null? s) '())
((skeleton-evaluation? s) (evaluate s dict))
(else
(cons (loop (car s)) (loop (cdr s))))))
(loop skeleton))
(define (skeleton-evaluation? s)
(eq? (car s) ':))
;made it simpler, no environment constant, sorry
(define (evaluate s dict)
(let ((data (lookup (cadr s) dict)))
(if (null? data)
(display "error in rules. mismatch")
(cadr data))))
;simplifier
(define (simplifier rules)
(define (simplify-exp exp)
(try-rules (if (list? exp)
(map simplify-exp exp)
exp)))
(define (try-rules exp)
(define (scan rule)
(if (null? rule)
exp
(let ((dict (match (pattern (car rule)) exp (empty-dict))))
(if (eq? dict 'failed)
(scan (cdr rule))
(simplify-exp (instantiate (skeleton (car rule)) dict))))))
(scan rules))
simplify-exp)
(define pattern car)
(define skeleton cadr)
;dictionary
(define (empty-dict)
'())
(define (extend-dict pat exp dict)
(let ((v (lookup (cadr pat) dict)))
(if (null? v)
(cons (list (cadr pat) exp) dict)
(if (eq? (cadr v) exp)
dict
'failed))))
(define (lookup s dict)
(cond ((null? dict) '())
((eq? (caar dict) s) (car dict))
(else (lookup s (cdr dict)))))
;extend racket
(define (atom? a)
(and (not (null? a)) (not (pair? a))))
And? you know what? It works :)
Related
I am stuck with this particular problem I was doing for fun:
Why does it cause a contract violation everytime car comes around? And are there any possible fixes?
(define (fv expr)
(cond ((eq? (car expr) 'lambda) (fv (cadr (cdr expr))))
((pair? (car expr)) (union (fv (car expr)) (fv (cdr expr))))
((symbol? (car expr)) (remove (car expr) (fv (cdr expr))))
(else '())))
(define (union set1 set2)
(cond ((null? set1) set2)
((member (car set1) set2) (union (cdr set1) set2))
(else (cons (car set1) (union (cdr set1) set2)))))
(define (remove item set)
(cond ((null? set) '())
((equal? item (car set)) (cdr set))
(else (cons (car set) (remove item (cdr set))))))
Input = (fv '(λ f (λ x (f ((t g) g)))))
Output =
car: contract violation expected: pair? given: '()
Output Should Be: (t g)
The error message:
car: contract violation expected: pair? given: '()
means that the function car was called with the argument '() (the empty list) and this gives an error.
Now you know that the problem is related to a call to car.
Since car is called multiple times in your program it is hard
to spot which car is the culprit. Presumably your Scheme implementation
displays a source locations that points to the offending expression.
But let's say you are not so lucky. In that case, you'll need to figure out which function has the problem. Inserting a few calls to display helps:
(define (fv expr)
(display (list 'fv: 'expr expr) (newline)
(cond ((eq? (car expr) 'lambda) (fv (cadr (cdr expr))))
((pair? (car expr)) (union (fv (car expr)) (fv (cdr expr))))
((symbol? (car expr)) (remove (car expr) (fv (cdr expr))))
(else '())))
(define (union set1 set2)
(display (list 'union: 'set1 set1 'set2 set2) (newline)
(cond ((null? set1) set2)
((member (car set1) set2) (union (cdr set1) set2))
(else (cons (car set1) (union (cdr set1) set2)))))
(define (remove item set)
(display (list 'remove: 'item item 'set set) (newline)
(cond ((null? set) '())
((equal? item (car set)) (cdr set))
(else (cons (car set) (remove item (cdr set))))))
If you try your example now, you'll see which function is called before the error occurs. In this case, I bet the problem is fv. Here car is called without a check that the argument is a non-empty list first.
I have the function getBoundedVars which uses the function boundsInLambda. In the end of it all the box bBox should contain all bounded variables in the expression exp.
I'm trying to debug this function and in order to do so I want to print the parameters of boundsInLambda every time the function is being activated but for some reason the values won't show up on the screen.
If I put the display operation in getBoundedVars it will print it but those are just the values in the first iteration.
If I run the following :
(getBoundedVars (lambda-simple (x) (lambda-simple (y) (const x))) bx)
when bx is an empty box,
'1 will be printed but the print commands in boundsInLambda will not
here's the code:
(define getBoundedVars
(lambda (exp bBox)
(if (atom? exp)
0 ;; don't put in box
(if (lambda? (car exp))
(begin
(display 1)
(newline)
(let ((pBox (make-pBox exp))
(lBox (box '()))
(bodyExp (make-body exp))
)
(boundsInLambda bodyExp lBox pBox bBox)))
(begin
(getBoundedVars (car exp) bBox)
(getBoundedVars (cdr exp) bBox))))))
(define boundsInLambda
(lambda (bodyExp lastBox paramBox boundsBox)
(newline)
(display `(bodyExp: ,bodyExp))
(newline)
(display `(lastBox: ,lastBox))
(newline)
(display `(paramBox: ,paramBox))
(newline)
(display `(boundsBox: ,boundsBox))
(newline)
(if (and (not (null? bodyExp))
(list bodyExp)
(equal? (car bodyExp) 'seq)
)
(map boundsInLambda (cadr bodyExp))
(let* ( (lists* (filter (lambda (el) (and (not (null? el)) (list? el) (not (equal? (car el) 'const)))) bodyExp))
(lists (map (lambda (el) (if (equal? (car el) 'set) (cddr el) el)) lists*))
(bounds (filter (lambda (el) (and (member el (unbox lastBox)) (not (member el (unbox paramBox))))) bodyExp))
(listsLeft? (> (length lists) 0))
(anyBounds? (> (length bounds) 0))
)
(if anyBounds?
(begin
(set-box! boundsBox (append (unbox boundsBox) bounds))))
(if listsLeft?
(map
(lambda (lst)
(if (lambda? (car lst))
(let* ((newBodyExp (make-body lst))
(newParamBox (make-pBox exp))
(newLastBox (box (append (unbox lastBox) (unbox paramBox))))
)
(boundsInLambda newBodyExp newLastBox newParamBox boundsBox))
(boundsInLambda lst lastBox paramBox boundsBox)))
lists)
0))
)))
(define make-pBox
(lambda (lamExp)
(if (equal? (car lamExp) 'lambda-simple)
(box (cadr lamExp))
(if (equal? (car lamExp) 'lambda-opt)
(box (cadr lamExp))
(box '())))))
(define make-body
(lambda (lamExp)
(if (equal? (car lamExp) 'lambda-opt)
(cdddr lamExp)
(cddr lamExp))))
any help would be very much appreciated.
I'm learning interpreter for quite a long time, after reading SICP chap 4.1~4.2, I tried to copy these code in my DrRacket in planet neil/sicp mode. I've carefully read these code but still cannot made the code running correctly.
during my copy, I made some changes:
eval function has been renamed to ewal;(because I want to avoid underlying scheme evaluating my code)
apply function has been renamed to epply (except that apply-in-underlying-scheme function);
rearranged the code structure for my better understanding
use #f and #t for my underlying implementation.
I have also disabled the driver-loop since I found the driver-loop never output a value for input.
the code failed to eval a compound procedure correctly, but can handle self-evaluating, define, and other special-form. I double checked the evaluate process, finding that if I change one point (I've marked with (*) in my code), so that the line
((compound-procedure? procedure) (eval-sequence (procedure-body procedure)
modified to
((compound-procedure? procedure) (ewal (procedure-body procedure)
the interpreter can finally eval compound procedure again. I don't know why but I think mine is correct. but SICP can't be wrong. My second question is how to make the driver-loop correctly output eval value.
the interpreter is also included in a gist because it's too long.
#lang planet neil/sicp
;; plot:
;; 1. env operation
;; 2. eval function
;; 3. test and eval for each special form and combination eval
;; 4. REPL
;; 5: test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; environment
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define the-empty-environment '())
(define (first-frame env) (car env))
(define (enclosing-environment env)(cdr env))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; env operation
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (extend-environment vars vals base-env)
(if (= (length vars) (length vals))
(cons (make-frame vars vals) base-env)
(if (< (length vars) (length vals))
(error "Too many args supplied" vars vals)
(error "Too few args supplied" vars vals))))
(define (lookup-variable-value var env)
(define(env-loop env)
(define (scan vars vals)
(cond ((null? vars) (env-loop (enclosing-environment env)))
((eq? var (car vars)) (car vals))
(else (scan (cdr vars) (cdr vals)))))
(if (eq? env the-empty-environment)
(error "Unbound variable" var)
(let ((frame (first-frame env)))
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
(define (set-variable-value! var val env)
(define (env-loop env)
(define (scan vars vals)
(cond ((null? vars) (env-loop (enclosing-environment env)))
((eq? var (car vars)) (set-car! vals val))
(else (scan (cdr vars) (cdr vals)))))
(if (eq? env the-empty-environment)
(error "Unbound variable -- SET!" var)
(let ((frame (first-frame env)))
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
(define (define-variable! var val env)
(let ((frame (first-frame env)))
(define (scan vars vals)
(cond ((null? vars) (add-binding-to-frame! var val frame))
((eq? var (car vars)) (set-car! vals val))
(else (scan (cdr vars) (cdr vals)))))
(scan (frame-variables frame)
(frame-values frame))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; frame operation
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-frame variables values)
(cons variables values))
(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))
(define (add-binding-to-frame! var val frame)
(set-car! frame (cons var (car frame)))
(set-cdr! frame (cons val (cdr frame))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; eval
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (ewal exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((quoted? exp) (text-of-quotation exp))
((assignment? exp) (eval-assignment exp env))
((definition? exp) (eval-definition exp env))
((if? exp) (eval-if exp env))
((lambda? exp) (make-procedure (lambda-parameters exp)
(lambda-body exp)
env))
((begin? exp) (eval-sequence (begin-actions exp) env))
((cond? exp) (ewal (cond->if exp) env))
((application? exp) (epply (ewal (operator exp) env)
(list-of-values (operands exp) env)))
(else (error "Unknown type -- EWAL" exp))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; self-eval test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (self-evaluating? exp)
(cond ((number? exp) #t)
((string? exp) #t)
(else #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; variable test an eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (variable? exp) (symbol? exp))
;; (lookup-variable-value exp env) see below
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; quote test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (quoted? exp)
(tagged-list? exp 'quote))
(define (text-of-quotation exp) (cadr exp))
(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
#f))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; assignment test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (assignment? exp)
(tagged-list? exp 'set!))
(define (assignment-variable exp) (cadr exp))
(define (assignment-value exp) (caddr exp))
(define (eval-assignment exp env)
(set-variable-value! (assignment-variable exp)
(ewal (assignment-value exp) env)
env)
'ok)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; definition test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (definition? exp)
(tagged-list? exp 'define))
(define (definition-variable exp)
(if (symbol? (cadr exp))
(cadr exp)
(caadr exp)))
(define (definition-value exp)
(if (symbol? (cadr exp))
(caddr exp)
(make-lambda (cdadr exp) ;;formal parameters
(cddr exp)))) ;;body
(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))
(define (eval-definition exp env)
(define-variable! (definition-variable exp)
(ewal (definition-value exp) env)
env)
'ok)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; lambda test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (lambda? exp) (tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
(define (lambda-body exp) (caddr exp))
(define (make-procedure parameters body env)
(list 'procedure parameters body env))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; if test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (if? exp) (tagged-list? exp 'if))
(define (if-predicate exp) (cadr exp))
(define (if-consequent exp) (caddr exp))
(define (if-alternative exp)
(if (not (null? (cadddr exp)))
(cadddr exp)
'false))
(define (eval-if exp env)
(if (true? (ewal (if-predicate exp) env))
(ewal (if-consequent exp) env)
(ewal (if-alternative exp) env)))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; begin test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (begin? exp) (tagged-list? exp 'begin))
(define (begin-actions exp) (cdr exp))
(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (eval-sequence exps env)
(cond ((last-exp? exps) (ewal (first-exp exps) env))
(else (ewal (first-exp exps) env)
(eval-sequence (rest-exps exps) env))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; application test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (application? exp) (pair? exp))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operands ops) (cdr ops))
(define (list-of-values exps env)
(if (no-operands? exps)
'()
(cons (ewal (first-operand exps) env)
(list-of-values (rest-operands exps) env))))
(define (epply procedure arguments)
(cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments))
((compound-procedure? procedure) (ewal (procedure-body procedure) ;; (*)
(extend-environment (procedure-parameters procedure)
arguments
(procedure-environment procedure))))
(else (error "Unkown procedure type -- EPPLY" procedure))))
(define (primitive-procedure? proc)
(tagged-list? proc 'primitive))
(define (primitive-implementation proc) (cadr proc))
(define (compound-procedure? p) (tagged-list? p 'procedure))
(define (procedure-parameters p) (cadr p))
(define (procedure-body p) (caddr p))
(define (procedure-environment p) (cadddr p))
(define (apply-primitive-procedure proc args)
(apply-in-underlying-scheme (primitive-implementation proc) args))
(define apply-in-underlying-scheme apply)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cond test and eval
;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cond? exp) (tagged-list? exp 'cond))
(define (cond-clauses exp) (cdr exp))
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
(define (cond-predicate clause) (car clause))
(define (cond-actions clause) (cdr clause))
(define (cond->if exp)
(expand-clauses (cond-clauses exp)))
(define (expand-clauses clauses)
(if (null? clauses)
'false
(let ((first (car clauses))
(rest (cdr clauses)))
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last -- COND->IF" clauses))
(make-if (cond-predicate first)
(sequence->exp(cond-actions first))
(expand-clauses rest))))))
(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))
(define (sequence->exp seq)
(cond ((null? seq) seq)
((last-exp? seq) (first-exp seq))
(else (make-begin seq))))
(define (make-begin seq) (cons 'begin seq))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; env setup
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (setup-environment)
(let ((initial-env
(extend-environment (primitive-procedure-names)
(primitive-procedure-objects)
the-empty-environment)))
(define-variable! '#t #t initial-env)
(define-variable! '#f #f initial-env)
initial-env))
(define primitive-procedures
(list(list 'car car)
(list 'cdr cdr)
(list 'null? null?)
(list 'cons cons)
(list '+ +)
(list '- -)
(list '* *)
(list '/ /)
(list '= =)))
(define (true? x)
(not (eq? x false)))
(define (false? x)
(eq? x false))
(define (primitive-procedure-names)
(map car primitive-procedures))
(define (primitive-procedure-objects)
(map (lambda (proc) (list 'primitive (cadr proc)))
primitive-procedures))
(define the-global-environment (setup-environment))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; REPL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define input-prompt "M-Eval input:")
(define output-prompt "M-Eval value:")
(define (driver-loop)
(prompt-for-input input-prompt)
(let ((input (read)))
(let ((output (ewal input the-global-environment)))
(announce-output output-prompt)
(user-print output)))
(driver-loop))
(define (prompt-for-input string)
(newline)
(newline)
(display string)
(newline))
(define (announce-output string)
(newline)
(display string)
(newline))
(define (user-print object)
(if (compound-procedure? object)
(display (list 'compound-procedure
(procedure-parameters object)
(procedure-body object)
'<procedure-env>))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define env0 the-global-environment)
(ewal '(define (p1 x) (+ x 1)) env0 )
(ewal '(p1 4) env0)
(ewal '(define (append x y)
(if (null? x)
y
(cons (car x)
(append (cdr x) y)))) env0)
(ewal '(define (factorial n)
(if (= 1 n)
1
(* n (factorial (- n 1))))) env0)
(ewal '(factorial 5) env0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; init main loop
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(driver-loop)
;; this is commented since I found it run incorrectly
update :
#Will Ness said:
about the eval-sequence, your procedure-body function is incorrect. it
should be cddr, not caddr, to match the eval-sequence's expectations.
I think my procedure-body def is right. consider I am interpreting this exp:
((lambda (n)
(if (= 1 n)
1
0))
5)
this is an application, and the operator can be evaluated by eval
(ewal (operator '((lambda (n)
(if (= 1 n)
1
0))
5)) env0)
so the value of operator is a list(closure) like this:
(procedure (n) (if (= 1 n) 1 0) #new-env)
if my procedure-body is caddr of the closure, the body will be (if (= 1 n) 1 0).
but if I change procedure-body into (cddr p), procedure-body will become like : ((if (= 1 n) 1 0) #new-env)
this means the #new-env will be a part of my procedure body. anyway this is not incorrect because procedure body should not include the closure's environment.
but indeed, this interpreter cannot handle a function whose body is composed by a list of expressions. In this case, I don't know how to extract the body(exp list) from the closure.
about the eval-sequence, your procedure-body function is incorrect. it should be cddr, not caddr, to match the eval-sequence's expectations.
about the driver-loop, it uses user-print to show the output, but user-print is incomplete. it only shows values which are compound procedures, not anything else.
in my interpreter, the case lambda cannot eval a function whose body is composed by a list of expressions, bacause lambda-bodyis defined as (caddr exp). I should modify it :
(define (lambda-body exp) (cddr exp))
and in my epply function, the condition compound-procedure should eval-sequence of procedure body, because now procedure body is a list of expressions, not a expression.
Using a Scheme-like language, I am converting
(quote (lambda (a b) (* a b) (+ a b))))
to:
(quote (lambda (a) (lambda (b) (+ a b) (* a b))))
but with my current implementation I am getting an extra pair of parenthesis around the expressions (+ a b) and (* a b):
(lambda (a) (lambda (b) ((+ a b) (* a b))))
I have spent a lot of time trying to fix this problem, but can't figure it out. I feel like the fix should be trivial.
Here is my code currently:
(define (conv lyst)
(define (helper args)
(cond
((null? args) (append (cddr lyst) args))
(else (cons (car lyst)
(cons (list (car args))
(list (helper (cdr args))))))))
(cond
((eq? 1 (length (car (cdr lyst)))) lyst)
(else (helper (car (cdr lyst))))))
I think your implementation can be simplified. This should work:
(define (conv lyst)
(define (helper args)
(if (null? (cdr args))
(cons 'lambda
(append (list (list (car args)))
(cddr lyst)))
(list 'lambda
(list (car args))
(helper (cdr args)))))
(helper (cadr lyst)))
Or even simpler, using quasiquoting and splicing:
(define (conv lyst)
(define (helper args)
(if (null? (cdr args))
`(lambda (,(car args)) ,#(cddr lyst))
`(lambda (,(car args)) ,(helper (cdr args)))))
(helper (cadr lyst)))
Either way, it works as expected:
(conv '(lambda (a b) (* a b) (+ a b)))
=> '(lambda (a) (lambda (b) (* a b) (+ a b)))
I'm trying to learn how to use match in scheme. I sort of understand how it works with really short problems (ie: defining length is just two lines) but not with problems where there's more than one input, and helper programs. For example, here's a popular way of defining union:
(define ele?
(lambda (ele ls)
(cond
[(null? ls) #f]
[(eq? ele (car ls)) #t]
[else (ele? ele (cdr ls))])))
(define union
(lambda (ls1 ls2)
(cond
[(null? ls2) ls1]
[(ele? (car ls2) ls1) (union ls1 (cdr ls2))]
[else (union (cons (car ls2) ls1) (cdr ls2))])))
How do you do this using match in both programs? (or would you even need two programs?)
the first one could be implemented like that:
(define ele?
(lambda (a b)
(let ((isa? (lambda (x) (eq? (car x) a))))
(match b [(? null?) #f]
[(? isa?) #t]
[_ (ele? a (cdr b))]))))
then the second is easy
(define uni
(lambda (ls1 ls2)
(let ((carinls2? (lambda (x) (ele? (car x) ls1))))
(match ls2 [(? null?) ls1]
[(? carinls2?) (uni ls1 (cdr ls2))]
[_ (uni (cons (car ls2) ls1) (cdr ls2))]))))
maybe there is a smarter way to avoid these one argument let lambdas but i'm still learning ;)