[racket] please i need your help

From: FIRAS MOHAMMAD NIMER ABU HASAN (fhassan at science.alquds.edu)
Date: Mon Mar 7 14:49:28 EST 2011



please how can i edit this code in order to define a constant twopower 
function,which will look similar to the following definition:
(define twoplus ’{fun {n} {  n 2}})
Of course, twopower should not implement the function n   2, but 2n, for n a
non-negative integer.

for example if we use this test : the result will be 32

(test (interp-expr (parse ‘ {with {f ,twopowerg {f 5}})) 32)

this is the original code:

#lang plai
 
(define-type F1WAE
   [num (n number?)]
   [add (lhs F1WAE?)(rhs F1WAE?)]
   [sub (lhs F1WAE?)(rhs F1WAE?)]
   [with (name symbol?) (named-expr F1WAE?) (body F1WAE?)]
   [id (name symbol?)]
   [app (fun-name symbol?) (arg F1WAE?)])
 
 (define-type FunDef
   [fundef (fun-name symbol?)
           (arg-name symbol?)
           (body F1WAE?)])
 
 ;; newest form of parse, with apply added in.
 (define parse
   (lambda (sexp)
   (cond
    [(number? sexp) (num sexp)]
    [(symbol? sexp) (id sexp)]
    [(list? sexp)
     (case (first sexp)
       [(+)(add (parse (second sexp))
                (parse (third sexp)))]
       [(-) (sub (parse (second sexp))
                 (parse (third sexp)))]
       [(with) (with (first (second sexp))
                     (parse (second (second sexp)))
                     (parse (third sexp)))]
       [else (app (first sexp)
                   (parse (second sexp)))]
        )])))
 
 
 ;; interp: F1WAE listof(fundef) -> number
 ;; evaluates F1WAE expressions by reducing them to their corresponding 
values
 (define interp
   (lambda (expr fundefs)
     (type-case F1WAE expr
                [num (n) n]
                [add (l r) (+ (interp l fundefs) (interp r fundefs))]
                [sub (l r) (- (interp l fundefs) (interp r fundefs))]
                [with (bound-id named-expr bound-body)
                      (interp (subst bound-body
                                   bound-id
                                   (num (interp named-expr fundefs)))
                              fundefs)]
                [id (v) (error 'interp "Free identifier")]
                [app (fun-name arg-expr)
                     (local ([define the-fun-def (lookup-fundef fun-name 
fundefs)])
                            (interp (subst (fundef-body the-fun-def)
                                           (fundef-arg-name the-fun-def)
                                           (num (interp arg-expr fundefs)))
                                    fundefs))])))
 ;; helper functions
 (define lookup-fundef
   (lambda (fun-name fundefs)
     (cond
       [(empty? fundefs)
        (error 'lookup-fundef "Function does not exist")]
       [else (if (symbol=? fun-name (fundef-fun-name (first fundefs)))
                 (first fundefs)
                 (lookup-fundef fun-name (rest fundefs)))])))
 
 (define subst
   (lambda (expr sub-id val)
     (type-case F1WAE expr
                [num (n) expr]
                [add (l r) (add (subst l sub-id val)
                                (subst r sub-id val))]
                [sub (l r) (sub (subst l sub-id val)
                                (subst r sub-id val))]
                [with (bound-id named-expr bound-body)
                      (if (symbol=? bound-id sub-id)
                          (with bound-id
                                (subst named-expr sub-id val)
                                bound-body)
                          (with bound-id
                                (subst named-expr sub-id val) ;; added to 
take care of scope
                                (subst bound-body sub-id val)))]
                [id (v)(if (symbol=? v sub-id) val expr)]
                [app (fun-name arg-expr)
                     (app fun-name (subst arg-expr sub-id val))])))
 
 ;; test
 (print "{double {double 5}}")
 (interp (parse '{double {double 5}})
         (list (fundef 'double
                       'n
                       (add (id 'n) (id 'n)))))
 
 


---------------------------------------
Firas .M. Abu Hassan
Web Developer
SKITCE
Alquds University


-- 
This message has been scanned for viruses and
dangerous content by SKITCE MailScanner, and is
believed to be clean.



Posted on the users mailing list.