API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jan 14th, 2018
62
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Racket 16.40 KB | None | 0 0
raw download clone embed print report
  1. #lang racket
  2. (struct int (n) #:transparent)
  3. (struct true () #:transparent)
  4. (struct false () #:transparent)
  5.  
  6. (struct complex (a b) #:transparent)
  7. (struct empty () #:transparent)
  8.  
  9. (struct :: (e1 e2) #:transparent)
  10. (struct if-then-else (condition e1 e2) #:transparent)
  11.  
  12. (struct is-int (e1) #:transparent)
  13. (struct is-bool (e1) #:transparent)
  14. (struct is-complex (e1) #:transparent)
  15. (struct is-list (e1) #:transparent)
  16. (struct add (e1 e2) #:transparent)
  17. (struct mul (e1 e2) #:transparent)
  18. (struct gt (e1 e2) #:transparent)
  19.  
  20. (struct both (e1 e2) #:transparent)
  21. (struct any (e1 e2) #:transparent)
  22. (struct ! (e1) #:transparent)
  23.  
  24. (struct hd (x) #:transparent)
  25. (struct tl (x) #:transparent)
  26. (struct is-empty (x) #:transparent)
  27. (struct @ (a b) #:transparent)
  28.  
  29. (struct real (e1) #:transparent)
  30. (struct imaginary (e1) #:transparent)
  31.  
  32. (struct var (s e1 e2) #:transparent)
  33. (struct valof (s) #:transparent)
  34.  
  35. (struct fun (name fargs body) #:transparent)
  36. (struct proc (name body) #:transparent)
  37. (struct envelope (env f) #:transparent)
  38. (struct call (e args) #:transparent)
  39. ;
  40.  
  41. (define (mi e okolje)
  42.   (letrec ([mi2 (lambda (e okolje)
  43.                   (cond
  44.                     #|Podatkovni tipi |#
  45.                     [(int? e) e]
  46.                     [(true? e) e]
  47.                     [(false? e) e]
  48.                     [(complex? e) (let
  49.                                       ([v1 (mi2 (complex-a e) okolje)]
  50.                                        [v2 (mi2 (complex-b e) okolje)])
  51.                                     (complex v1 v2))]
  52.                     [(::? e) (let
  53.                                  ([v1 (mi2(::-e1 e) okolje)]
  54.                                   [v2 (mi2(::-e2 e) okolje)])
  55.                                (:: v1 v2)
  56.                                )]  
  57.                     [(empty? e) e]
  58.                     #|Nadzor toka|#
  59.                     [(if-then-else? e) (let ([c (mi2(if-then-else-condition e) okolje)]
  60.                                              [e1 (if-then-else-e1 e)]
  61.                                              [e2 (if-then-else-e2 e)])
  62.                                          (if(true? c) (mi2 e1 okolje) (mi2 e2 okolje)))]
  63.                     [(is-int? e) (if(int? (mi2 (is-int-e1 e) okolje)) (true) (false))]
  64.    
  65.                     [(is-bool? e) (cond [(true? (mi2 (is-bool-e1 e) okolje)) (true)]
  66.                                         [(false? (mi2 (is-bool-e1 e) okolje)) (true)]
  67.                                         [else (false)])]
  68.    
  69.                     [(is-complex? e) (if(complex? (mi2 (is-complex-e1 e) okolje)) (true) (false))]
  70.    
  71.                     [(is-list? e) (cond [(empty? (mi2 (is-list-e1 e) okolje)) (true)]
  72.                                         [(::? (mi2 (is-list-e1 e) okolje)) (true)]
  73.                                         [else (false)])]
  74.  
  75.                     [(add? e) (cond
  76.                                 [(and (int? (mi2 (add-e1 e) okolje )) (int? (mi2 (add-e1 e) okolje)) ) (int (+ (int-n (mi2 (add-e1 e) okolje)) (int-n (mi2 (add-e2 e) okolje))))]
  77.                                 [(and (complex? (mi2 (add-e1 e) okolje)) (complex? (mi2 (add-e1 e) okolje))) (complex (int (+ (int-n (complex-a (mi2 (add-e1 e) okolje))) (int-n (complex-a (mi2 (add-e2 e) okolje)))))  (int(+ (int-n (complex-b (mi2 (add-e1 e) okolje))) (int-n (complex-b (mi2 (add-e2 e) okolje))))))])]
  78.  
  79.                     [(mul? e) (cond
  80.                                 [(and (int? (mi2 (mul-e1 e) okolje)) (int? (mi2 (mul-e1 e) okolje))) (int(* (int-n (mi2 (mul-e1 e) okolje)) (int-n (mi2 (mul-e2 e) okolje))))]
  81.                                 [(and (complex? (mi2 (mul-e1 e) okolje)) (complex? (mi2 (mul-e1 e) okolje))) (complex (int(* (int-n (complex-a (mi2 (mul-e1 e) okolje))) (int-n (complex-a (mi2 (mul-e2 e) okolje)))))  (int(* (int-n (complex-b (mi2 (mul-e1 e) okolje))) (int-n (complex-b (mi2 (mul-e2 e) okolje))))))])]
  82.  
  83.                     [(gt? e) (let ([v1 (mi2 (gt-e1 e) okolje)]
  84.                                    [v2 (mi2 (gt-e2 e) okolje)])
  85.                                (if(> (int-n v1) (int-n v2)) (true) (false)))]
  86.    
  87.                     [(both? e) (let ([v1 (mi2 (both-e1 e) okolje)]
  88.                                      [v2 (mi2 (both-e2 e) okolje)])
  89.                                  (cond [(and (true? (mi2 (is-bool v1) okolje)) (true? (mi2 (is-bool v2) okolje))) (if(and (true? v1) (true? v2)) (true) (false))]
  90.                                        [else (false)]))]
  91.    
  92.                     [(any? e) (let ([v1 (mi2 (any-e1 e) okolje)]
  93.                                     [v2 (mi2 (any-e2 e) okolje)])
  94.                                 (cond [(and (true? (mi2(is-bool v1) okolje)) (true? (mi2(is-bool v2) okolje))) (if(or (true? v1) (true? v2)) (true) (false))]
  95.                                       [else (false)]))]
  96.    
  97.                     [(!? e) (cond [(true? (mi2(is-bool (mi (!-e1 e) okolje))okolje )) (if(true? (mi2(!-e1 e) okolje)) (false) (true))]
  98.                                   [else (false)])]
  99.  
  100.                     [(hd? e) (let ([x (mi2 (hd-x e) okolje)])
  101.                                (::-e1 x))]
  102.  
  103.                     [(tl? e) (let ([x (mi2 (tl-x e) okolje)])
  104.                                (::-e2 x))]
  105.  
  106.                     [(is-empty? e) (if(empty? (mi2(is-empty-x e)okolje)) (true) (false))]
  107.  
  108.                     [(@? e) (let([v1 (mi2 (@-a e) okolje)]
  109.                                  [v2 (mi2 (@-b e) okolje)])
  110.  
  111.                               (define (preglej sez)
  112.                                 (if(::? sez) (append (list(mi2(hd sez)okolje)) (preglej (mi2 (tl sez) okolje))) (list(mi2 sez okolje))))
  113.  
  114.                               (define (kreiraj list1 v2)
  115.                                 (if(not(null? list1))  (mi2(:: (car list1) (kreiraj (cdr list1) v2)) okolje) v2))
  116.              
  117.                               (kreiraj (preglej v1) v2))]
  118.  
  119.                     [(real? e) (let([v1 (mi2 (real-e1 e) okolje)])
  120.                                  (complex-a v1))]
  121.    
  122.                     [(imaginary? e) (let([v1 (mi2 (imaginary-e1 e) okolje)])
  123.                                       (complex-b v1))]
  124.    
  125.                     [(var? e) (let ([s (var-s e)]
  126.                                     [e1 (mi2 (var-e1 e) okolje)]
  127.                                     [e2 (var-e2 e)])
  128.                                 (mi2 e2 (append (list(cons s e1)) okolje)))]
  129.                    
  130.                     [(valof? e) (let ([s (valof-s e)])
  131.                                    (cdr(assoc s okolje)))]
  132.                    
  133.                     [(fun? e) (envelope okolje e)]
  134.  
  135.                     [(proc? e) e]
  136.                    
  137.                     [(call? e) (let([o (mi2 (call-e e) okolje) ])
  138.                                  (cond [(envelope? o) (mi2 (fun-body (envelope-f o)) (let ([fargs (fun-fargs(envelope-f(mi2 (call-e e) okolje)))]
  139.                                                                                            [args (map (lambda(x) (mi2 x okolje)) (call-args e))])
  140.                                                                               (append  (list(cons (fun-name (envelope-f o))  o))       (map cons fargs args))       ))]
  141.                                        
  142.                                        [(proc? o) (mi2 (proc-body o) (append (list (cons (proc-name o) o))   okolje))]
  143.                                        [else (error "klic funkcije nima ustreznih argumentov")]))]
  144.                     ))])
  145.     (mi2 e okolje)))
  146.  
  147. #| V jeziku Racket lahko implementiramo funkcije, ki delujejo kot makri v jeziku mega,
  148. ter na ta način olepšajo sintakso ter razširijo jezik z novimi konstrukti.
  149. Makri naj podane izraze evalvirajo le enkrat! Definiramo naslednje makre: |#
  150.  
  151. ;(to-complex e1) iz rezultat izraza e1, ki je številska konstanta naredi kompleksno število
  152. (define-syntax to-complex
  153.   (syntax-rules()
  154.     [(to-complex e1)
  155.     (complex e1 (int 0))]))
  156.  
  157. ;(conj e1) predstavlja konjugirano kompleksno število, ki je rezultat izraza e1
  158. (define-syntax conj
  159.   (syntax-rules()
  160.     [(conj e1)
  161.     (let ([a (complex-a e1)]
  162.           [b (complex-b e1)])
  163.       (complex a (int (-(int-n b))))
  164.       )]))
  165.  
  166. ;(~ e1) predstavlja unarni minus. Definiran je za številske konstante.
  167. (define-syntax ~
  168.   (syntax-rules()
  169.     [(~ e1)
  170.     (int (-(int-n e1)))]))
  171.  
  172. ;(lt e1 e2), ki preveri, ali velja urejenost med parametroma. Definiran je za vse vrednosti, na katerih deluje gt.
  173. (define-syntax lt
  174.   (syntax-rules()
  175.     [(lt e1 e2)
  176.     (cond [(true) (gt e2 e1)]
  177.           [else "napacna cifra"])]))
  178.  
  179. ;(same e1 e2), ki preveri, ali sta vrednosti enaki. Definiran je za vse vrednosti, na katerih deluje gt.
  180. (define-syntax same
  181.   (syntax-rules()
  182.     [(same e1 e2)
  183.     (cond [(true) (if(= (int-n e1) (int-n e2)) (true) (false))]
  184.           [else "napacna cifra"])]))
  185. #|
  186. ;podatkovni tipi testi
  187. (mi (int 3) null)
  188. (mi (add (int 3) (int 5)) null)
  189. (mi (true) null)
  190. (mi (false) null)
  191. (mi (complex (int 3) (int 3)) null)
  192. (mi (complex (add (int 2) (int 2)) (add (int 1) (int 1))) null)
  193. (mi (empty) null)
  194. (mi (:: (int 3) (int 3)) null)
  195. (mi (:: (int 3) (:: (int 2) (int 2))) null)
  196. (mi (:: (complex (int 3) (int 3)) (complex (int 2) (int 2))) null)
  197. (mi (:: (add (complex (int 3) (int 2)) (complex (int 2) (int 2))) (complex (int 10) (int 10))) null)
  198.  
  199. ;nadzor toka
  200. (mi (if-then-else (true) (int 10) (int 15)) null)
  201. (mi (if-then-else (false) (int 10) (int 15)) null)
  202. (mi (if-then-else (is-int (int 3)) (int 10) (int 15)) null)
  203. (mi (if-then-else (is-list(empty)) (int 10) (int 15)) null)
  204.  
  205. (mi (is-int (int 3)) null)
  206. (mi (is-int (add (int 3) (int 5))) null)
  207. (mi (is-int (true)) null)
  208. (mi (is-int (false)) null)
  209. (mi (is-int (complex (int 3) (int 5))) null)
  210. (mi (is-int (:: (int 3) (int 5))) null)
  211. (mi (is-int (empty)) null)
  212.  
  213. (mi (is-bool (true)) null)
  214. (mi (is-bool (false)) null)
  215. (mi (is-bool (is-int (int 3))) null)
  216. (mi (is-bool (empty)) null)
  217. (mi (is-bool (complex (int 3) (int 3))) null)
  218. (mi (is-bool (add (complex (int 3) (int 3)) (complex (int 5) (int 2)))) null)
  219. (mi (is-bool (:: (int 3) (int 5))) null)
  220. (mi (is-bool (empty)) null)
  221.  
  222. (mi (is-complex (complex (int 2) (int 2))) null)
  223. (mi (is-complex (add (complex (int 1) (int 1)) (complex (int 2) (int 3)))) null)
  224. (mi (is-complex (complex (add (int 3) (int 5)) (int 11))) null)
  225. (mi (is-complex (true)) null)
  226. (mi (is-complex (false)) null)
  227. (mi (is-complex (:: (int 3) (int 5))) null)
  228. (mi (is-complex (empty)) null)
  229. (mi (is-complex (int 4)) null)
  230.  
  231. (mi (is-list (empty)) null)
  232. (mi (is-list (:: (int 3) (add (int 2) (int 5)))) null)
  233. (mi (is-list (:: (int 3) (:: (int 5) (int 7)))) null)
  234. (mi (is-list (true)) null)
  235. (mi (is-list (false)) null)
  236. (mi (is-list (int 0)) null)
  237. (mi (is-list (add (int 3) (int 5))) null)
  238. (mi (is-list (complex (int 3) (add (int 7) (int 3)))) null)
  239.  
  240. (mi (add (int 3) (int 4)) null)
  241. (mi (add (int 7) (add (int 9) (int 2))) null)
  242. (mi (add (complex (int 5) (int 5)) (complex (int 1) (int 20))) null)
  243.  
  244. (mi (mul (int 3) (int 4)) null)
  245. (mi (mul (int 7) (add (int 9) (int 2))) null)
  246. (mi (mul (complex (int 5) (int 5)) (complex (int 1) (int 20))) null)
  247.  
  248. (mi (gt (int 10) (int 3)) null)
  249. (mi (gt (add (int 5) (int 5)) (add (int 2) (int 3))) null)
  250. (mi (gt (int 10) (add (int 5) (int 5))) null)
  251. (mi (gt (int 3) (int 4)) null)
  252.  
  253. (mi (both (true) (true)) null)
  254. (mi (both (is-int (int 3)) (true)) null)
  255. (mi (both (true) (false)) null)
  256. (mi (both (false) (true)) null)
  257. (mi (both (false) (false)) null)
  258.  
  259. (mi (any (true) (true)) null)
  260. (mi (any (is-int (int 3)) (true)) null)
  261. (mi (any (true) (false)) null)
  262. (mi (any (false) (true)) null)
  263. (mi (any (false) (false)) null)
  264. (mi (any (is-int (int 3)) (is-int (int 3))) null)
  265. (mi (any (is-int (int 5)) (false)) null)
  266.  
  267. (mi (! (true)) null)
  268. (mi (! (is-bool (true))) null)
  269. (mi (! (false)) null)
  270. (mi (! (if-then-else (true) (false) (int 5))) null)
  271.  
  272. (mi (hd (:: (int 10) (:: (int 11) (:: (int 12) (int 13))))) null)
  273. (mi (tl (:: (int 10) (:: (int 11) (:: (int 12) (add (int 12) (int 1)))))) null)
  274. (mi (is-empty (:: (int 10) (:: (int 11) (:: (int 12) (add (int 12) (int 1)))))) null)
  275. (mi (is-empty (:: (complex (int 1) (int 1)) (complex (int 1) (int 2)))) null)
  276. (mi (is-empty (empty)) null)
  277. (mi (@ (:: (int 1) (:: (int 2) (add (int 2) (int 1)))) (:: (int 4) (:: (int 5) (int 6)))) null)
  278.  
  279. (mi (real (complex (add (int 1) (int 1)) (add (int 2) (int 2)))) null)
  280. (mi (imaginary (complex (add (int 1) (int 1)) (add (int 2) (int 2)))) null)
  281. (mi (real (add (complex (int 1) (int 2)) (complex (int 1) (int 2)))) null)
  282. (mi (imaginary (add (complex (int 1) (int 2)) (complex (int 1) (int 2)))) null)
  283.  
  284. ;spremenljivke
  285. (mi (var "i" (int 5) (valof "i")) null)
  286. (mi (var "i" (int 5) (var "j" (int 10) (var "g" (int 1) (mul (mul (valof "i") (valof "j")) (valof "g"))))) null)
  287. (mi (var "i" (int 5) (var "j" (int 10) (var "i" (int 1) (mul (mul (valof "i") (valof "j")) (valof "i"))))) null)
  288. (mi (var "i" (int 11) (is-int (valof "i"))) null)
  289. (mi (mul (valof "c") (valof "d")) (list (cons "c" (complex (int 2) (int 3))) (cons "d" (complex (int 5) (int 6)))))
  290. (mi (var "c" (complex (int 1) (int 2)) (mul (valof "c") (valof "d"))) (list (cons "c" (complex (int 2) (int 3))) (cons "d" (complex (int 5) (int 6)))))
  291.  
  292. ;procedure
  293. (mi (call (proc "mnoziComplex" (mul (complex (int 2) (int 3)) (complex (int 4) (int 5)))) null) null)
  294. (mi (call (proc "mnoziOk1" (mul (valof "i") (valof "j"))) null) (list (cons "i" (int 10)) (cons "j" (int 3))))
  295. (mi (var "i" (int 100) (call (proc "mnoziOk1" (mul (valof "i") (valof "j"))) null)) (list (cons "i" (int 10)) (cons "j" (int 3))))
  296.  
  297. ;procedure rekurzija
  298. (mi (var "x" (int 5)
  299.          (call (proc "pow2"
  300.                      (if-then-else (gt (valof "x") (int 0))
  301.                                    (var "x" (add (valof "x") (int -1)) (mul (int 2) (call (valof "pow2") null)))
  302.                                    (int 1))) null)) null)
  303. ;makri
  304. (mi (to-complex (int 3)) null)
  305. (mi (to-complex (add (int 3) (valof "i"))) (list (cons "i" (int 10))))
  306. (mi (conj (complex (int 3) (int 10))) null)
  307. (mi (conj (complex (int 3) (int -10))) null)
  308. (mi (conj (complex (valof "i") (int 10))) (list (cons "i" (int 20))))
  309. (mi (~ (int 30)) null)
  310. (mi (~ (int -30)) null)
  311. (mi (lt (int 3) (int 5)) null)
  312. (mi (lt (int 5) (int 5)) null)
  313. (mi (lt (int 10) (int 5)) null)
  314. (mi (same (int 3) (int 3)) null)
  315. (mi (same (int 3) (int 4)) null)
  316. (mi (same (int 4) (int 3)) null)
  317.  
  318. (mi (call (fun "nekaj" (list "n") (add (valof "n") (valof "n"))) (list (int 3))) null)
  319. (mi (var "n" (int 1000) (call (fun "nekaj" (list "n") (add (valof "n") (valof "n"))) (list (int 3)))) (list (cons "n" (int 100))))
  320.  
  321. (define fib (fun "fib" (list "n")
  322.                  (if-then-else (gt (int 3) (valof "n"))
  323.                                (int 1)
  324.                                (add (call (valof "fib") (list (add (valof "n") (int -1))))
  325.                                     (call (valof "fib") (list (add (valof "n") (int -2))))))))
  326. (mi (call fib (list (int 5))) null)
  327. (define reverse (fun "reverse" (list "xs")
  328.                      (if-then-else
  329.                       (is-empty (valof "xs"))
  330.                       (empty)
  331.                       (@ (call (valof "reverse") (list (tl (valof "xs"))))
  332.                                (:: (hd (valof "xs")) (empty))))))
  333.  
  334. (mi (call reverse (list (:: (int 5) (:: (int 4) (:: (int 3) (empty)))))) null)
  335. (define tail-reverse (fun "tail-reverse" (list "xs")
  336.                      (var "aux" (fun "aux" (list "xs" "acc")
  337.                                     (if-then-else
  338.                                      (is-empty (valof "xs"))
  339.                                      (valof "acc")
  340.                                      (call (valof "aux") (list (tl (valof "xs")) (:: (hd (valof "xs")) (valof "acc"))))))
  341.                      (call (valof "aux") (list (valof "xs") (empty))))))
  342.  
  343. (mi (call tail-reverse (list (:: (int 5) (:: (int 4) (:: (int 3) (empty)))))) null) |#
  344.  
  345. (define fib (fun "fib" (list "n")
  346.                  (if-then-else (gt (int 3) (valof "n"))
  347.                                (int 1)
  348.                                (add (call (valof "fib") (list (add (valof "n") (int -1))))
  349.                                     (call (valof "fib") (list (add (valof "n") (int -2))))))))
  350. (mi (call fib (list (int 11))) null)
  351. (define reverse (fun "reverse" (list "xs")
  352.                      (if-then-else
  353.                       (is-empty (valof "xs"))
  354.                       (empty)
  355.                       (@ (call (valof "reverse") (list (tl (valof "xs"))))
  356.                                (::  (empty) (hd (valof "xs")))))))
  357.  
  358. (mi (call reverse (list (:: (int 5) (:: (int 4) (:: (int 3) (empty)))))) null)
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!