API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Nov 18th, 2019
142
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 45.56 KB | None | 0 0
raw download clone embed print report
  1. #lang plai
  2. ;; -----------------------------------------------------------------------------
  3. ;; First, some required additions for our racket code:
  4.  
  5. (require racket/sandbox
  6. ;Also, re-import some macros from plai:
  7. (only-in plai
  8. ;Rename plai's testX macros as plai-testX
  9. [test plai-test]
  10. [test/pred plai-test/pred]
  11. [test/exn plai-test/exn]))
  12.  
  13. ;; As usual, if you comment the print-only-errors call in the following
  14. ;; expression, you will see all the tests that also pass:
  15.  
  16. ;; -----------------------------------------------------------------------------
  17.  
  18. ;; Some macro definitions we require
  19. ;; Please do not remove these macros or your tests may fail!
  20.  
  21. ;; These macros wrap over the original test functionality from
  22. ;; plai, but they fail if actual running
  23. ;; takes more than 5 seconds or more than 256mb of memory.
  24. ;; We recommend you use this when working with infinite lists
  25. ;; and recursion in case things go wrong.
  26.  
  27. (define-syntax-rule (test actual expected)
  28. (plai-test (with-limits 5 256 actual) expected))
  29.  
  30. (define-syntax-rule (test/exn actual msg)
  31. (plai-test/exn (with-limits 5 256 actual) msg))
  32.  
  33. (define-syntax-rule (test/pred actual pred)
  34. (plai-test/pred (with-limits 5 256 actual) pred))
  35.  
  36. ;; We also include a macro that checks an expression times out.
  37. ;; In general we cannot check if a program "runs forever", but we
  38. ;; will use this macro as an approximation of that behaviour.
  39. (define-syntax-rule (test/must-timeout actual)
  40. (plai-test/exn
  41. ; We are wrapping the call to with-limits with a racket exception handler.
  42. ; You do not need to know the details of this implementation,
  43. ; but its behaviour is to throw the error only when with-limits fails
  44. ; (which happens when it runs out of resources)
  45. (with-handlers ([exn:fail:resource?
  46. (lambda (original-error)
  47. (error "timed out : ~s" original-error))])
  48. (with-limits 5 256 actual))
  49. "timed out"))
  50.  
  51. ;; A5L : The Assignment 5 Language
  52.  
  53. ;; Syntax specification:
  54. ;;
  55. ;; <A5L> ::= <num>
  56. ;; | <string>
  57. ;; | true | false
  58. ;; | {error <string>}
  59. ;; | {+ <A5L> <A5L>}
  60. ;; | {- <A5L> <A5L>}
  61. ;; | {* <A5L> <A5L>}
  62. ;; | {= <A5L> <A5L>}
  63. ;; | {if <A5L> <A5L> <A5L>}
  64. ;; | {withrec <defn> <A5L>}
  65. ;; | {withrecs {<defns>} <A5L>}
  66. ;; | {fun {<IDs>} <A5L>}
  67. ;; | {<A5L> <A5Ls>}
  68. ;; | <id>
  69. ;; | {OBJECT {<Fields>} {<Methods>}}
  70. ;; | {OBJECT-DEL <A5L> {<Fields>} {<Methods>}}
  71. ;; | {-> <A5L> <id> <A5Ls>}
  72.  
  73. ;; <IDs> ::=
  74. ;; | <id> <IDs>
  75.  
  76. ;; <A5Ls> ::=
  77. ;; | <A5L> <A5Ls>
  78.  
  79. ;; <defn> ::= {<id> <A5L>}
  80.  
  81. ;; <defns> ::=
  82. ;; | <defn> <defns>
  83.  
  84. ;; <Fields> ::=
  85. ;; | <Field> <Fields>
  86. ;; <Field> ::= {field <id> <A5L>}
  87.  
  88. ;; <Methods> ::=
  89. ;; | <Method> <Methods>
  90. ;; <Method> ::= {method <id> {<IDs>} <A5L>}
  91.  
  92. ;; In this assignment, desugaring is again an explicit step.
  93.  
  94. ; NOTE : YOU MUST NOT MAKE ANY CHANGES TO THIS DEFINE-TYPE!
  95. (define-type s-A5L
  96. ; Numeric expressions
  97. [s-num (n number?)]
  98. [s-bool (b boolean?)]
  99. [s-str (s string?)]
  100. [s-add (lhs s-A5L?) (rhs s-A5L?)]
  101. [s-sub (lhs s-A5L?) (rhs s-A5L?)]
  102. [s-mult (lhs s-A5L?) (rhs s-A5L?)]
  103. [s-= (lhs s-A5L?) (rhs s-A5L?)]
  104. [s-if (scrutinee s-A5L?) (thens s-A5L?) (elses s-A5L?)]
  105. ; Recursion expressions
  106. [s-withrec (name symbol?) (named-expr s-A5L?) (body s-A5L?)]
  107. [s-withrecs (decls (listof (list/c symbol? s-A5L?))) (body s-A5L?)]
  108. ; Function application and definition expressions
  109. [s-fun (params (lambda (x) (andmap symbol? x))) (body s-A5L?)]
  110. [s-app (fun-exp s-A5L?) (arg-expr (lambda (x) (andmap s-A5L? x)))]
  111. [s-id (name symbol?)]
  112. ; Object declaration
  113. [s-object (fields (listof s-field?)) (methods (listof s-method?))]
  114. [s-object-del (parent s-A5L?) (fields (listof s-field?)) (methods (listof s-method?))]
  115. ; Method call
  116. [s-call (object s-A5L?) (mname symbol?) (arg-expr (listof s-A5L?))]
  117.  
  118. [s-err (message string?) (args (listof s-A5L?))]
  119. )
  120.  
  121. (define-type s-A5L-field
  122. [s-field (name symbol?) (value s-A5L?)])
  123.  
  124. (define-type s-A5L-method
  125. [s-method (name symbol?) (params (listof symbol?)) (body s-A5L?)])
  126.  
  127. (define-type A5L
  128. [num (n number?)]
  129. [bool (b boolean?)]
  130. [str (s string?)]
  131. [binop (op procedure?) (l A5L?) (r A5L?)]
  132. [equal-e (l A5L?) (r A5L?)]
  133. [if-b (scrutinee A5L?) (then-expr A5L?) (else-expr A5L?)]
  134. [withrec (name symbol?) (named-expr A5L?) (body A5L?)]
  135. [withrecs (defns (listof (list/c symbol? A5L?))) (body A5L?)]
  136. [fun (param symbol?) (body A5L?)]
  137. [app (fun-expr A5L?) (arg-expr A5L?)]
  138. [id (name symbol?)]
  139.  
  140. [err (message string?) (args (listof A5L?))])
  141.  
  142. ;; -----------------------------------------------------------------------------
  143. ;; PARSING
  144. ;; DO NOT CHANGE THIS PART
  145.  
  146. (define *reserved-symbols*
  147. '(+ - * = withrec withrecs fun if OBJECT OBJECT-DEL -> error method field))
  148.  
  149. ;; valid-identifier? : any -> boolean
  150. ;; Determines whether the parameter is valid as an identifier name, i.e.,
  151. ;; a symbol that is not reserved.
  152. (define (valid-identifier? sym)
  153. (and (symbol? sym)
  154. (not (member sym *reserved-symbols*))))
  155.  
  156. ;; parse : any -> s-A5L
  157. (define (parse sexp)
  158. (match sexp
  159. [(? number?) (s-num sexp)]
  160. [(? string?) (s-str sexp)]
  161. ['true (s-bool true)]
  162. ['false (s-bool false)]
  163. [(list* 'error (? string? message) args) (s-err message (map parse args))]
  164. [(list '+ lhs rhs) (s-add (parse lhs) (parse rhs))]
  165. [(list '- lhs rhs) (s-sub (parse lhs) (parse rhs))]
  166. [(list '* lhs rhs) (s-mult (parse lhs) (parse rhs))]
  167. [(list '= lhs rhs) (s-= (parse lhs) (parse rhs))]
  168. [(list 'if scrutinee then-s else-s)
  169. (s-if (parse scrutinee) (parse then-s) (parse else-s))]
  170. [(list 'withrec (list (? valid-identifier? name) named-exp) body)
  171. (s-withrec name (parse named-exp) (parse body))]
  172. [(list 'withrecs (list (list (? valid-identifier? names) named-exps) ...)
  173. body)
  174. (s-withrecs (map (λ (name named-exp)
  175. (list name (parse named-exp))) names named-exps)
  176. (parse body))]
  177. [(list 'fun (list (? valid-identifier? names) ...) body)
  178. (s-fun names (parse body))]
  179. [(? valid-identifier?) (s-id sexp)]
  180. [(list 'OBJECT fields methods)
  181. (s-object (map parse-field fields) (map parse-method methods))]
  182. [(list 'OBJECT-DEL parent fields methods)
  183. (s-object-del (parse parent) (map parse-field fields) (map parse-method methods))]
  184. [(list '-> obj mname arg-exp ...)
  185. (s-call (parse obj) mname (map parse arg-exp))]
  186. ; For function calls to work they must be the last list expression matched.
  187. ; In this pattern `arg-exps' can be empty, which happens when we call a nullary function
  188. [(cons fun-exp arg-exps)
  189. (s-app (parse fun-exp) (map parse arg-exps))]
  190. [_ (error 'parse "unable to parse ~a" sexp)]))
  191.  
  192. (define (parse-field sexp)
  193. (match sexp
  194. [(list 'field (? valid-identifier? name) init-val)
  195. (s-field name (parse init-val))]
  196. [_ (error 'parse-field "unable to parse ~a" sexp)]))
  197.  
  198. (define (parse-method sexp)
  199. (match sexp
  200. [(list 'method
  201. (? valid-identifier? name)
  202. (list (? valid-identifier? arg-names) ...)
  203. body)
  204. (s-method name arg-names (parse body))]
  205. [_ (error 'parse-method "unable to parse ~a" sexp)]))
  206.  
  207.  
  208. ;; -----------------------------------------------------------------------------
  209. ;; DESUGARING
  210.  
  211. (define (desugar exp)
  212. (type-case s-A5L exp
  213. [s-num (n) (num n)]
  214. [s-str (s) (str s)]
  215. [s-bool (b) (bool b)]
  216. [s-add (l r) (binop + (desugar l) (desugar r))]
  217. [s-sub (l r) (binop - (desugar l) (desugar r))]
  218. [s-mult (l r) (binop * (desugar l) (desugar r))]
  219. [s-= (l r) (equal-e (desugar l) (desugar r))]
  220. [s-if (scr thn els) (if-b (desugar scr) (desugar thn) (desugar els))]
  221. [s-withrec (name expr body) (withrec name (desugar expr) (desugar body))]
  222. [s-withrecs (defns body)
  223. (withrecs (map (λ (defn)
  224. (list (first defn)
  225. (desugar (second defn))))
  226. defns)
  227. (desugar body))]
  228. [s-fun (ids b) (foldr (lambda (x acc) (fun x acc)) (desugar b) ids)]
  229. ;; If the list of arguments is empty, then we apply the function to `false'
  230. ;; Otherwise, perform normal unfolding.
  231. [s-app (f a) (if (empty? a)
  232. (app (desugar f) false)
  233. (foldl (lambda (x acc) (app acc (desugar x))) (desugar f) a))]
  234. [s-id (x) (id x)]
  235. [s-object (fields methods)
  236. (desugar-object fields methods)]
  237. [s-object-del (parent fields methods)
  238. (desugar-object-del parent fields methods)]
  239.  
  240.  
  241. ;; TODO-1: fix desugaring of s-call so that self is properly handled.
  242. [s-call (o n as) (desugar (s-app o (list* (s-str (symbol->string n)) o as)))]
  243.  
  244.  
  245. [s-err (m args) (err m (map desugar args))]
  246. ))
  247.  
  248. (define (desugar-object fields methods)
  249. (local ([define (desugar-method m)
  250. (s-fun (cons 'self (s-method-params m))
  251. (s-method-body m))]
  252. [define dynamic-dispatcher
  253. (s-fun (list 'method)
  254. (foldr (λ (method dispatcher-rest-acc)
  255. (s-if (s-= (s-id 'method)
  256. (s-str (symbol->string (s-method-name method))))
  257. (desugar-method method)
  258. dispatcher-rest-acc))
  259. (s-err "Message not understood" '())
  260. methods))])
  261. (desugar
  262. (foldr (λ (field desugared-object-acc)
  263. (s-withrec (s-field-name field)
  264. (s-field-value field)
  265. desugared-object-acc))
  266. dynamic-dispatcher
  267. fields))))
  268.  
  269. ;; TODO-2: Change desugar-object-del so that it properly implements the
  270. ;; delegation of methods, discussed in lecture 23, and on
  271. ;; https://users.dcc.uchile.cl/~etanter/ooplai/Forwarding_and_Delegation.html
  272.  
  273. (define (desugar-object-del parent fields methods)
  274. (local ([define (desugar-method m)
  275. (s-fun (cons 'self (s-method-params m))
  276. (s-method-body m))]
  277. [define dynamic-dispatcher
  278. (s-fun (list 'method)
  279. (foldr (λ (method dispatcher-rest-acc)
  280. (s-if (s-= (s-id 'method)
  281. (s-str (symbol->string (s-method-name method))))
  282. (desugar-method method)
  283. dispatcher-rest-acc))
  284. (s-app parent (list (s-id 'method)))
  285. methods))])
  286. (desugar
  287. (foldr (λ (field desugared-object-acc)
  288. (s-withrec (s-field-name field)
  289. (s-field-value field)
  290. desugared-object-acc))
  291. dynamic-dispatcher
  292. fields))))
  293.  
  294. ;; NOTE: YOU MUST NOT CHANGE THIS DEFINE-TYPE
  295. (define-type Value
  296. [numV (n number?)]
  297. [strV (s string?)]
  298. [boolV (b boolean?)]
  299. [closureV (param symbol?) (body A5L?) (env Env?)])
  300.  
  301. ; Note: YOU MUST NOT CHANGE THIS DEFINE-TYPE
  302. ;; If you want to attempt the bonus question, do so in a separate file and
  303. ;; in that file you may ONLY remove variants that become redundant.
  304. (define-type Env
  305. [mtEnv]
  306. [anEnv (name symbol?) (value Value?) (env Env?)]
  307. ;; Recursive environment allowing self-reference
  308. [aRecEnv (name symbol?)
  309. (value (box/c (or/c false? Value?)))
  310. (env Env?)])
  311.  
  312. ;; lookup : symbol Env -> Value
  313. ;; Find the value for a particular symbol.
  314. (define (lookup name env)
  315. (type-case Env env
  316. [mtEnv () (error 'lookup (format "No binding for identifier ~s" name))]
  317. [anEnv (bound-name bound-value rest-env)
  318. (if (symbol=? bound-name name)
  319. bound-value
  320. (lookup name rest-env))]
  321. [aRecEnv (bound-name bound-value rest-env)
  322. (if (symbol=? bound-name name)
  323. (local ([define box-contents (unbox bound-value)])
  324. (if box-contents ; equivalent to (not (false? box-contents))
  325. box-contents
  326. (error (string-append "aRecEnv: Attempted to access "
  327. "recursive value before it has "
  328. "been properly defined."))))
  329. (lookup name rest-env))]))
  330.  
  331. ;; interp : A5L -> Value
  332. ;; evaluate expr and produce the resulting Value
  333. (define (interp expr)
  334. (local [
  335. ;; is-a? : apply pred to value and return value if true
  336. (define (is-a? pred value)
  337. (if (pred value)
  338. value
  339. (error 'interp (string-append "Received a value of the "
  340. "wrong type: ~a; expected ~a")
  341. value pred)))
  342.  
  343. ;; binop : check v1 and v2 are numVs, apply op, and return a numV
  344. (define (interp-binop op v1 v2)
  345. (numV (op (numV-n (is-a? numV? v1))
  346. (numV-n (is-a? numV? v2)))))
  347.  
  348. ;; cyclically-bind-and-interp : symbol A5L Env -> Env
  349. ;; create the appropriate environment for evaluating a single
  350. ;; recursive function.
  351. ;; we have defined a special aRecEnv deferred substitution in Env
  352. ;; for recursion
  353. (define (cyclically-bind-and-interp name bound-expr env)
  354. (local ([define box-for-name (box #f)]
  355. [define new-env (aRecEnv name box-for-name env)]
  356. [define bound-val (helper bound-expr new-env)])
  357. (begin
  358. (set-box! box-for-name bound-val)
  359. new-env)))
  360.  
  361. ;; mutually-cyclically-bind-and-interp
  362. ;; : (listof (list/c symbol A5L)) Env -> Env
  363. ;; All definitions in decls may refer to any of the other recursive
  364. ;; definitions being simultaneously defined.
  365. (define (mutually-cyclically-bind-and-interp decls env)
  366. ; DONE : Implement this definition
  367. (local (; First, create all of the boxes
  368. [define env-boxes (map (λ (x) (box #f)) decls)]
  369. ; Create the environment that holds all of the boxes.
  370. [define new-env (foldr (λ (decl box-for-decl env)
  371. (aRecEnv (first decl) box-for-decl env))
  372. env
  373. decls
  374. env-boxes)]
  375. ; Then evaluate all of the expressions with the right env:
  376. [define env-values (map (λ (x) (helper (second x) new-env))
  377. decls)])
  378.  
  379. (begin
  380. ; Update the boxes so that they have the right contents:
  381. (map set-box! env-boxes env-values)
  382. ; Then return the new environment.
  383. new-env)))
  384.  
  385. ; helper : A5L Env -> Value
  386. (define (helper expr env)
  387. (type-case A5L expr
  388. [num (n) (numV n)]
  389. [str (s) (strV s)]
  390. [bool (b) (boolV b)]
  391. [binop (op l r) (interp-binop op
  392. (helper l env)
  393. (helper r env))]
  394. [equal-e (l r) (boolV (equal? (helper l env) (helper r env)))]
  395. [if-b (scr thn els)
  396. (local ([define scr-val (helper scr env)])
  397. (type-case Value scr-val
  398. [boolV (b) (if b
  399. (helper thn env)
  400. (helper els env))]
  401. [else (error 'interp
  402. "Expected a boolean value, but got ~s."
  403. scr-val)]))]
  404.  
  405. [withrec (name named-expr bound-body)
  406. (helper bound-body
  407. (cyclically-bind-and-interp name named-expr env))]
  408. [withrecs (decls bound-body)
  409. (helper bound-body
  410. (mutually-cyclically-bind-and-interp decls env))]
  411. [fun (x body) (closureV x body env)]
  412. [app (fun-expr arg-expr)
  413. (local ([define fun-val (helper fun-expr env)]
  414. [define arg-val (helper arg-expr env)])
  415. (type-case Value fun-val
  416. [closureV (arg body clo-env)
  417. (helper body (anEnv arg arg-val clo-env))]
  418. [else (error 'interp
  419. "Not a function in a function call: got ~s"
  420. fun-val)]))]
  421. [id (v) (lookup v env)]
  422.  
  423. ;; New in A5L: If we encounter an `error', we just raise an error in Racket
  424. ;; We will format the error message with the arguments supplied
  425. [err (m args) (apply error 'interp (format "The program raised an error: ~s" m)
  426. (map (λ (a) (type-case Value (helper a env)
  427. [numV (n) n]
  428. [strV (s) s]
  429. [boolV (b) b]
  430. [closureV (n c e) "<Closure>"]))
  431. args))]
  432. ))]
  433. (helper expr (mtEnv))))
  434.  
  435. (define (run sexp)
  436. (interp (desugar (parse sexp))))
  437.  
  438. ;; -----------------------------------------------------------------------------
  439. ;; OBJECT ORIENTED PROGRAMMING
  440.  
  441. ;; Calling the methods
  442.  
  443. ;; TODO-3:
  444. ;; Fix method calls in the following object definition.
  445. (define A5L-todo-3
  446. '{fun {f} {OBJECT
  447. {{field func f}}
  448. {{method twice {x} {func {func x}}}
  449. ;; Fix the following method:
  450. {method four-times {x} {-> self twice {-> self twice x}}}}}})
  451.  
  452. ;; -----
  453. ;; Lists
  454.  
  455. ;; Ok, we lied... In fact, there are lists in A5L!
  456. ;; We just have to write them by ourselves.
  457.  
  458. ;; We define a list in A5L to be an object with the following methods:
  459. ;; - is-empty?, which takes no arguments
  460. ;; and returns `true' if the list is empty, and `false' if it is not.
  461. ;; - head, which takes no arguments and returns the head.
  462. ;; - tail, which takes no arguments and returns the tail, which is another list.
  463.  
  464. ;; If a list is empty, than calling `head' or `tail' should cause an error.
  465.  
  466. ;; Here are the `cons' constructor and `empty', the empty list, defined as objects.
  467.  
  468. ;; TODO-4:
  469. ;; Add the `is-empty?' method to both `cons' and `empty'
  470. (define A5L-cons
  471. '{fun {h t} {OBJECT
  472. {{field hd h}
  473. {field tl t}}
  474. {{method head {} hd}
  475. {method tail {} tl}
  476. ;; Put `is-empty?' here!
  477. {method is-empty? {} false}
  478. }}})
  479.  
  480. (define A5L-empty
  481. '{OBJECT {} ;; No fields, because nothing in an empty list!
  482. ;; We show an error message if we try to get the head or tail of `empty'.
  483. {{method head {} {error "Trying to get the head of an empty list."}}
  484. {method tail {} {error "Trying to get the tail of an empty list."}}
  485. ;; Put `is-empty?' here!
  486. {method is-empty? {} true}
  487. }})
  488.  
  489. ;; TODO-5:
  490. ;; Write the `map' function for our list
  491. ;; You can use `cons' and `empty' in your code
  492. (define A5L-map
  493. '{fun {f l}
  494. {if {-> l is-empty?}
  495. empty
  496. {cons {f {-> l head}}
  497. {map f {-> l tail}}}}})
  498.  
  499. ;; TODO-6:
  500. ;; Write the `take' function for our list
  501. ;; You can use `cons' and `empty' in your code
  502. (define A5L-take
  503. '{fun {n l}
  504. {if = n 0
  505. })
  506.  
  507. ;; With the `map' function, we can map over a list by calling
  508. ;; {map some-function some-list}
  509.  
  510. ;; Alternatively, we can define another type of list,
  511. ;; with `map' as one of its methods,
  512. ;; so that we can call `map' in a more object-oriented way:
  513. ;; {-> some-list-with-the-map-method map some-function}
  514.  
  515. ;; We will call a list with the `map' method an `m-list'.
  516.  
  517. ;; TODO-7:
  518. ;; Finish the definitions of `m-cons' and `m-empty',
  519. ;; the constructor of lists with the `map' method,
  520. ;; and the empty list with the `map' method.
  521.  
  522. ;; The lists with the `map' method must adhere to our definition of a list,
  523. ;; that is, it must have the three list methods.
  524. ;; You should be able to use normal `map' and `take' on a list constructed using
  525. ;; `m-cons'es and `m-empty'.
  526.  
  527. ;; Make your definition as simple as possible.
  528. ;; Use delegation so you do not have to implement all list methods in the
  529. ;; objects constructed by the `s-cons' and `s-empty' constructors.
  530.  
  531. ;; You can use `m-cons' and `m-empty',
  532. ;; as well as the normal `cons' and `empty' in your code.
  533. (define A5L-m-cons
  534. '{fun {h t} 'TODO})
  535.  
  536. (define A5L-m-empty
  537. 'TODO)
  538.  
  539. ;; ----
  540. ;; Infinity (revisited)
  541.  
  542. ;; Did we say that there are no infinity in A5L?
  543. ;; Well, we lied again... In fact, infinite lists are quite possible in A5L,
  544. ;; but they are constructed in a way quite different from lists in A5L.
  545.  
  546. ;; TODO-8:
  547. ;; Define an infinite list of ones. Do not use `iterate' which is in the next question.
  548.  
  549. ;; HINT: `cons' and `empty' are not used here, but `self' is.
  550. (define A5L-ones
  551. 'TODO)
  552.  
  553. ;; TODO-9:
  554. ;; Define the `iterate' function, that takes a function and an initial value as arguments,
  555. ;; and returns an infinite list where the first element is the initial value,
  556. ;; the second element is the function applied to the initial value once,
  557. ;; the third element is the function applied twice, and so on.
  558.  
  559. ;; i.e. given a function `f', and an initial value `x', `{iterate f x}' should give a list like:
  560. ;; [x, f(x), f(f(x)), f(f(f(x))), ...]
  561.  
  562. ;; The idea of an `iterate' function comes from Haskell.
  563. ;; However, our implementation will be different from Haskell as we do not have lazy evaluation.
  564.  
  565. ;; HINT: If the initial value is f(x), then the head of its tail should be f(f(x)).
  566.  
  567. ;; You can use `iterate' in your code.
  568. (define A5L-iterate
  569. '{fun {f i} TODO})
  570.  
  571. ;; TODO-10:
  572. ;; The `map' we have defined previously is eager.
  573. ;; If we use `map' on an infinite list, we will run into an infinite loop
  574. ;; because it will try to evaluate until the end of the list.
  575.  
  576. ;; In order to map over an infinite list, we need to implement map in another way.
  577. ;; Remember that lists are just objects that have a certain set of methods,
  578. ;; and that map returns a list...
  579. ;; which means, lazy-map can just return an object with the three method required,
  580. ;; and it would be a list!
  581.  
  582. ;; Here is a partial implementation of `lazy-map',
  583. ;; which can run on infinite lists.
  584. ;; Fill in the TODOs in the function body so it works properly.
  585.  
  586. ;; You can use `lazy-map' in your code.
  587. (define A5L-lazy-map
  588. '{fun {f l}
  589. {if {-> l is-empty?}
  590. ;; If the list is empty, we have reached the base case
  591. ;; so we just return the normal empty list
  592. empty
  593. ;; If the list is not empty, create the object that will be the
  594. ;; first element in the list
  595. {OBJECT {} ;; Feel free to add fields if you think they are needed
  596. {{method is-empty? {} false}
  597. {method head {} TODO}
  598. {method tail {} TODO}}}}})
  599.  
  600. ;; -----------------------------------------------------------------------------
  601. ;; TESTS
  602.  
  603. ;; Just basic method calls
  604. (test (run `{withrec {foo {OBJECT {{field x 10}
  605. {field y 20}}
  606. {{method f {a} {+ a x}}
  607. {method g {a} {+ a y}}}}}
  608. {+ {-> foo f 10} {-> foo g 20}}})
  609. (numV 60))
  610.  
  611. (test (run `{withrec {foo {OBJECT {}
  612. {{method f {a} {if {= 0 a} 0 {-> self f {- a 1}}}}}}}
  613. {-> foo f 100}})
  614. (numV 0))
  615.  
  616. (test/must-timeout (run `{withrec {foo {OBJECT {}
  617. {{method f {a} {-> self f a}}}}}
  618. {-> foo f 100}}))
  619.  
  620. (test (run `{withrec {foo {OBJECT {}
  621. {{method f {a} {if {= 0 a}
  622. 0
  623. {if {= 1 a}
  624. 0
  625. {-> self g {- a 2}}}}}
  626. {method g {a} {-> self f {+ 1 a}}}}}}
  627. {-> foo f 100}})
  628. (numV 0))
  629.  
  630. (test/exn (run `{withrec {foo {OBJECT {}
  631. {{method f {} 100}}}}
  632. {-> foo g 100}})
  633. "Message not understood")
  634.  
  635. ;; One way forwarding
  636. (test (run `{withrec {foo {OBJECT {{field x 100}}
  637. {{method g {a} {+ x a}}}}}
  638. {withrec {bar {OBJECT-DEL foo
  639. {{field x 200}}
  640. {{method f {a} {+ x {+ x a}}}}}}
  641. {-> bar g 10}}})
  642. (numV 110))
  643.  
  644. (test (run `{withrec {foo {OBJECT {{field x 100}}
  645. {{method g {a} {+ x a}}}}}
  646. {withrec {bar {OBJECT-DEL foo
  647. {{field x 200}}
  648. {{method f {a} {+ x {+ x a}}}}}}
  649. {-> bar f 10}}})
  650. (numV 410))
  651.  
  652. (test (run `{withrec {foo {OBJECT {{field x 100}}
  653. {{method g {a} {+ x a}}}}}
  654. {withrec {bar {OBJECT-DEL foo
  655. {{field x 200}}
  656. {{method g {a} {+ x {+ x a}}}}}}
  657. {-> bar g 10}}})
  658. (numV 410))
  659.  
  660. (test/exn (run `{withrec {foo {OBJECT {{field x 100}}
  661. {{method g {a} {+ x a}}}}}
  662. {withrec {bar {OBJECT-DEL foo
  663. {{field x 200}}
  664. {{method f {a} {+ x {+ x a}}}}}}
  665. {-> bar h 10}}})
  666. "Message not understood")
  667.  
  668. ;; Delegation
  669. (test (run `{withrec {foo {OBJECT {}
  670. {{method f {a} {* a 2}}
  671. {method g {a} {+ a {-> self f a}}}}}}
  672. {withrec {bar {OBJECT-DEL foo
  673. {}
  674. {{method f {a} {* a 3}}}}}
  675. {-> bar g 10}}})
  676. (numV 40))
  677.  
  678. (test (run `{withrec {foo {OBJECT {}
  679. {{method f {a} 100}
  680. {method g {a} {-> self f {- a 1}}}}}}
  681. {withrec {bar {OBJECT-DEL foo
  682. {}
  683. {{method f {a} {if {= a 0}
  684. true
  685. {-> self g a}}}}}}
  686. {-> bar g 20}}})
  687. (boolV true))
  688.  
  689.  
  690. ;; Tests for four-times
  691. (test (run `{withrec {foo {,A5L-todo-3 {fun {x} {+ 1 x}}}}
  692. {-> foo four-times 100}})
  693. (numV 104))
  694.  
  695. (test (run `{withrec {id {fun {x} x}}
  696. {withrec {foo {,A5L-todo-3 id}}
  697. {-> foo four-times 123}}})
  698. (numV 123))
  699.  
  700. (test (run `{withrec {foo {,A5L-todo-3 {fun {x} {* 2 x}}}}
  701. {-> foo four-times 10}})
  702. (numV 160))
  703.  
  704. ;; Tests for list
  705. (define (with-list expr)
  706. `{withrecs {{cons ,A5L-cons}
  707. {empty, A5L-empty}}
  708. ,expr})
  709.  
  710. (define (with-m-list expr)
  711. `{withrecs {{cons ,A5L-cons}
  712. {empty, A5L-empty}
  713. {m-cons ,A5L-m-cons}
  714. {m-empty ,A5L-m-empty}}
  715. ,expr})
  716.  
  717. (test (run (with-list `{withrec {l {cons 1 {cons 2 {cons 3 empty}}}}
  718. {+ {* 1000000 {-> l head}}
  719. {+ {* 10000 {-> {-> l tail} head}}
  720. {+ {* 100 {-> {-> {-> l tail} tail} head}}
  721. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}))
  722. (numV 1020301))
  723.  
  724. (test (run (with-list `{withrec {l {cons 1 {cons 2 {cons 3 empty}}}}
  725. {+ {* 1000000 {if {-> l is-empty?} 1 0}}
  726. {+ {* 10000 {if {-> {-> l tail} is-empty?} 1 0}}
  727. {+ {* 100 {if {-> {-> {-> l tail} tail} is-empty?} 1 0}}
  728. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}))
  729. (numV 1))
  730.  
  731. (test (run (with-list `{withrec {l {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  732. {+ {* 100000 {-> l head}}
  733. {+ {* 1000 {-> {-> l tail} head}}
  734. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  735. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}))
  736. (numV 1234560))
  737.  
  738. (test (run (with-list `{withrecs {{l0 {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  739. {map ,A5L-map}}
  740. {withrec {l {map {fun {x} {- x 1}} l0}}
  741. {+ {* 100000 {-> l head}}
  742. {+ {* 1000 {-> {-> l tail} head}}
  743. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  744. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  745. (numV 1133550))
  746.  
  747. (test (run (with-list `{withrecs {{l0 {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  748. {map ,A5L-map}}
  749. {withrec {l {map {fun {x} {+ x 1}} l0}}
  750. {+ {* 100000 {-> l head}}
  751. {+ {* 1000 {-> {-> l tail} head}}
  752. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  753. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  754. (numV 1335570))
  755.  
  756. (test (run (with-list `{withrecs {{f {fun {x} {+ x {f x}}}}
  757. {map ,A5L-map}}
  758. {-> {map f empty} is-empty?}}))
  759. (boolV true))
  760.  
  761. ;; Map
  762. (test (run (with-list `{withrecs {{l0 {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  763. {map ,A5L-map}}
  764. {withrec {l {map {fun {x} {- x 1}} l0}}
  765. {+ {* 100000 {-> l head}}
  766. {+ {* 1000 {-> {-> l tail} head}}
  767. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  768. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  769. (numV 1133550))
  770.  
  771. (test (run (with-list `{withrecs {{l0 {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  772. {map ,A5L-map}}
  773. {withrec {l {map {fun {x} {+ x 1}} l0}}
  774. {+ {* 100000 {-> l head}}
  775. {+ {* 1000 {-> {-> l tail} head}}
  776. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  777. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  778. (numV 1335570))
  779.  
  780. (test (run (with-list `{withrecs {{f {fun {x} {+ x {f x}}}}
  781. {map ,A5L-map}}
  782. {-> {map f empty} is-empty?}}))
  783. (boolV true))
  784.  
  785.  
  786. ;; Take
  787. (test (run (with-list `{withrecs {{l0 {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  788. {take ,A5L-take}}
  789. {withrec {l {take 100 l0}}
  790. {+ {* 100000 {-> l head}}
  791. {+ {* 1000 {-> {-> l tail} head}}
  792. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  793. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  794. (numV 1234560))
  795.  
  796. (test (run (with-list `{withrecs {{l0 {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  797. {take ,A5L-take}}
  798. {withrec {l {take 4 l0}}
  799. {+ {* 100000 {-> l head}}
  800. {+ {* 1000 {-> {-> l tail} head}}
  801. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  802. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  803. (numV 1234560))
  804.  
  805. (test (run (with-list `{withrecs {{l0 {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  806. {take ,A5L-take}}
  807. {withrec {l {take 3 l0}}
  808. {+ {* 100000 {-> l head}}
  809. {+ {* 1000 {-> {-> l tail} head}}
  810. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  811. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  812. (numV 1234561))
  813.  
  814. (test (run (with-list `{withrecs {{l0 {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  815. {take ,A5L-take}}
  816. {withrec {l {take 2 l0}}
  817. {+ {* 100000 {-> l head}}
  818. {+ {* 1000 {-> {-> l tail} head}}
  819. {if {-> {-> {-> l tail} tail} is-empty?} 1 0}}}}}))
  820. (numV 1234001))
  821.  
  822. (test (run (with-list `{withrecs {{l0 {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  823. {take ,A5L-take}}
  824. {-> {take 0 l0} is-empty?}}))
  825. (boolV true))
  826.  
  827. ;; Tests for m-list
  828. (test (run (with-m-list `{withrec {l {m-cons 1 {m-cons 2 {m-cons 3 m-empty}}}}
  829. {+ {* 1000000 {-> l head}}
  830. {+ {* 10000 {-> {-> l tail} head}}
  831. {+ {* 100 {-> {-> {-> l tail} tail} head}}
  832. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}))
  833. (numV 1020301))
  834.  
  835. (test (run (with-m-list `{withrec {l {m-cons 1 {m-cons 2 {m-cons 3 m-empty}}}}
  836. {+ {* 1000000 {if {-> l is-empty?} 1 0}}
  837. {+ {* 10000 {if {-> {-> l tail} is-empty?} 1 0}}
  838. {+ {* 100 {if {-> {-> {-> l tail} tail} is-empty?} 1 0}}
  839. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}))
  840. (numV 1))
  841.  
  842. (test (run (with-m-list `{withrec {l {m-cons 12 {m-cons 34 {m-cons 56 {m-cons 78 m-empty}}}}}
  843. {+ {* 100000 {-> l head}}
  844. {+ {* 1000 {-> {-> l tail} head}}
  845. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  846. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}))
  847. (numV 1234560))
  848.  
  849.  
  850. ;; Map method of m-list
  851. (test (run (with-m-list `{withrec {l0 {m-cons 12 {m-cons 34 {m-cons 56 {m-cons 78 m-empty}}}}}
  852. {withrec {l {-> l0 map {fun {x} {- x 1}}}}
  853. {+ {* 100000 {-> l head}}
  854. {+ {* 1000 {-> {-> l tail} head}}
  855. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  856. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  857. (numV 1133550))
  858.  
  859. (test (run (with-m-list `{withrec {l0 {m-cons 12 {m-cons 34 {m-cons 56 {m-cons 78 m-empty}}}}}
  860. {withrec {l {-> l0 map {fun {x} {+ x 1}}}}
  861. {+ {* 100000 {-> l head}}
  862. {+ {* 1000 {-> {-> l tail} head}}
  863. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  864. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  865. (numV 1335570))
  866.  
  867. (test (run (with-m-list `{withrec {f {fun {x} {+ x {f x}}}}
  868. {-> {-> m-empty map f} is-empty?}}))
  869. (boolV true))
  870.  
  871. ;; m-list compatibility
  872.  
  873. (test (run (with-m-list `{withrecs {{l0 {m-cons 12 {m-cons 34 {m-cons 56 {m-cons 78 m-empty}}}}}
  874. {map ,A5L-map}}
  875. {withrec {l {map {fun {x} {- x 1}} l0}}
  876. {+ {* 100000 {-> l head}}
  877. {+ {* 1000 {-> {-> l tail} head}}
  878. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  879. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  880. (numV 1133550))
  881.  
  882. (test (run (with-m-list `{withrecs {{l0 {m-cons 12 {m-cons 34 {m-cons 56 {m-cons 78 m-empty}}}}}
  883. {map ,A5L-map}}
  884. {withrec {l {map {fun {x} {+ x 1}} l0}}
  885. {+ {* 100000 {-> l head}}
  886. {+ {* 1000 {-> {-> l tail} head}}
  887. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  888. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  889. (numV 1335570))
  890.  
  891. (test (run (with-m-list `{withrecs {{f {fun {x} {+ x {f x}}}}
  892. {map ,A5L-map}}
  893. {-> {map f m-empty} is-empty?}}))
  894. (boolV true))
  895.  
  896. (test (run (with-m-list `{withrecs {{l0 {m-cons 12 {m-cons 34 {m-cons 56 {m-cons 78 m-empty}}}}}
  897. {take ,A5L-take}}
  898. {withrec {l {take 3 l0}}
  899. {+ {* 100000 {-> l head}}
  900. {+ {* 1000 {-> {-> l tail} head}}
  901. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  902. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  903. (numV 1234561))
  904.  
  905. (test (run (with-m-list `{withrecs {{l0 {m-cons 12 {m-cons 34 {m-cons 56 {m-cons 78 m-empty}}}}}
  906. {take ,A5L-take}}
  907. {withrec {l {take 2 l0}}
  908. {+ {* 100000 {-> l head}}
  909. {+ {* 1000 {-> {-> l tail} head}}
  910. {if {-> {-> {-> l tail} tail} is-empty?} 1 0}}}}}))
  911. (numV 1234001))
  912.  
  913. (test (run (with-m-list `{withrecs {{l0 {m-cons 12 {m-cons 34 {m-cons 56 {m-cons 78 m-empty}}}}}
  914. {take ,A5L-take}}
  915. {-> {take 0 l0} is-empty?}}))
  916. (boolV true))
  917.  
  918. ;; Infinite lists
  919.  
  920. (test (run (with-list `{withrec {ones ,A5L-ones}
  921. {+ {if {-> ones is-empty?} 1 0}
  922. {if {-> {-> {-> ones tail} tail} is-empty?} 1 0}}}))
  923. (numV 0))
  924.  
  925. (test (run (with-list `{withrec {ones ,A5L-ones}
  926. {-> ones head}}))
  927. (numV 1))
  928.  
  929. (test (run (with-list `{withrec {ones ,A5L-ones}
  930. {-> {-> ones tail} head}}))
  931. (numV 1))
  932.  
  933. (test (run (with-list `{withrec {ones ,A5L-ones}
  934. {-> {-> {-> {-> {-> {-> {-> ones tail} tail} tail} tail} tail} tail} head}}))
  935. (numV 1))
  936.  
  937. (test (run (with-list `{withrec {iterate ,A5L-iterate}
  938. {withrec {naturals {iterate {fun {x} {+ 1 x}} 0}}
  939. {+ {if {-> naturals is-empty?} 1 0}
  940. {if {-> {-> {-> naturals tail} tail} is-empty?} 1 0}}}}))
  941. (numV 0))
  942.  
  943. (test (run (with-list `{withrec {iterate ,A5L-iterate}
  944. {withrec {naturals {iterate {fun {x} {+ 1 x}} 0}}
  945. {-> naturals head}}}))
  946. (numV 0))
  947.  
  948. (test (run (with-list `{withrec {iterate ,A5L-iterate}
  949. {withrec {naturals {iterate {fun {x} {+ 1 x}} 0}}
  950. {-> {-> {-> {-> {-> naturals tail} tail} tail} tail} head}}}))
  951. (numV 4))
  952.  
  953. (test (run (with-list `{withrec {iterate ,A5L-iterate}
  954. {withrec {naturals {iterate {fun {x} {+ 1 x}} 0}}
  955. {+ {* 1000000 {-> naturals head}}
  956. {+ {* 10000 {-> {-> naturals tail} head}}
  957. {+ {* 100 {-> {-> {-> naturals tail} tail} head}}
  958. {-> {-> {-> {-> naturals tail} tail} tail} head}}}}}}))
  959. (numV 10203))
  960.  
  961. (test (run (with-list `{withrec {iterate ,A5L-iterate}
  962. {withrec {doubles {iterate {fun {x} {* 2 x}} 1}}
  963. {+ {* 1000000 {-> doubles head}}
  964. {+ {* 10000 {-> {-> doubles tail} head}}
  965. {+ {* 100 {-> {-> {-> doubles tail} tail} head}}
  966. {-> {-> {-> {-> doubles tail} tail} tail} head}}}}}}))
  967. (numV 1020408))
  968.  
  969. (test (run (with-list `{withrec {iterate ,A5L-iterate}
  970. {withrec {ns {iterate {fun {x} {if {= x 0} x {- x 1}}} 2}}
  971. {+ {* 1000000 {-> ns head}}
  972. {+ {* 10000 {-> {-> ns tail} head}}
  973. {+ {* 100 {-> {-> {-> ns tail} tail} head}}
  974. {-> {-> {-> {-> ns tail} tail} tail} head}}}}}}))
  975. (numV 2010000))
  976.  
  977. (test (run (with-list `{withrecs {{iterate ,A5L-iterate}
  978. {lazy-map ,A5L-lazy-map}}
  979. {withrec {twos {lazy-map {fun {x} {* 2 x}}
  980. {iterate {fun {x} 1} 1}}}
  981. {-> twos head}}}))
  982. (numV 2))
  983.  
  984. (test (run (with-list `{withrecs {{iterate ,A5L-iterate}
  985. {lazy-map ,A5L-lazy-map}}
  986. {withrec {twos {lazy-map {fun {x} {* 2 x}}
  987. {iterate {fun {x} 1} 1}}}
  988. {-> {-> {-> {-> twos tail} tail} tail} head}}}))
  989. (numV 2))
  990.  
  991. (test (run (with-list `{withrecs {{iterate ,A5L-iterate}
  992. {lazy-map ,A5L-lazy-map}}
  993. {withrec {odds {lazy-map {fun {x} {+ x 1}}
  994. {iterate {fun {x} {+ 2 x}} 0}}}
  995. {-> {-> {-> {-> odds tail} tail} tail} head}}}))
  996. (numV 7))
  997.  
  998. ;; Also check that lazy-map works with finite list
  999.  
  1000. (test (run (with-list `{withrecs {{l0 {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  1001. {lazy-map ,A5L-lazy-map}}
  1002. {withrec {l {lazy-map {fun {x} {- x 1}} l0}}
  1003. {+ {* 100000 {-> l head}}
  1004. {+ {* 1000 {-> {-> l tail} head}}
  1005. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  1006. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  1007. (numV 1133550))
  1008.  
  1009. (test (run (with-list `{withrecs {{l0 {cons 12 {cons 34 {cons 56 {cons 78 empty}}}}}
  1010. {lazy-map ,A5L-lazy-map}}
  1011. {withrec {l {lazy-map {fun {x} {+ x 1}} l0}}
  1012. {+ {* 100000 {-> l head}}
  1013. {+ {* 1000 {-> {-> l tail} head}}
  1014. {+ {* 10 {-> {-> {-> l tail} tail} head}}
  1015. {if {-> {-> {-> {-> l tail} tail} tail} is-empty?} 1 0}}}}}}))
  1016. (numV 1335570))
  1017.  
  1018. (test (run (with-list `{withrecs {{f {fun {x} {+ x {f x}}}}
  1019. {lazy-map ,A5L-lazy-map}}
  1020. {-> {lazy-map f empty} is-empty?}}))
  1021. (boolV true))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!